From gitlab at gitlab.haskell.org Thu Mar 19 10:46:30 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 19 Mar 2020 06:46:30 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Update "GHC differences to the FFI Chapter" in user guide. Message-ID: <5e734d8699f4f_488a3fc6a691ddac20763da@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 5cbf9934 by Andreas Klebinger at 2020-03-19T04:39:27Z 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-19T04:40:06Z 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. - - - - - fd526652 by Gert-Jan at 2020-03-19T10:46:13Z Squashed Explicit Specificity - - - - - 15d05710 by Sylvain Henry at 2020-03-19T10:46:18Z Refactoring: use Platform instead of DynFlags when possible Metric Decrease: ManyConstructors T12707 T13035 T1969 - - - - - 30 changed files: - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Graph.hs - compiler/GHC/Cmm/Info.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/Ppr.hs - compiler/GHC/Cmm/Ppr/Decl.hs - compiler/GHC/Cmm/Ppr/Expr.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Switch/Implement.hs - compiler/GHC/Cmm/Type.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen/Amode.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen/Base.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen/CondCode.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen/Gen32.hs - compiler/GHC/CmmToAsm/SPARC/Ppr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/336767f94b296377c59e73e8183e0d4934791485...15d057107600c4ad144ca4065455a8b70f0a109c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/336767f94b296377c59e73e8183e0d4934791485...15d057107600c4ad144ca4065455a8b70f0a109c You're receiving 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 Mar 21 00:43:47 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 20 Mar 2020 20:43:47 -0400 Subject: [Git][ghc/ghc][master] Hadrian: ignore in-tree GMP objects with ``--lint`` Message-ID: <5e756343ecc34_488a827fd6424091dd@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: faa36e5b by Sylvain Henry at 2020-03-21T00:43:41Z Hadrian: ignore in-tree GMP objects with ``--lint`` - - - - - 2 changed files: - hadrian/src/Main.hs - hadrian/src/Rules/Gmp.hs Changes: ===================================== hadrian/src/Main.hs ===================================== @@ -65,6 +65,9 @@ main = do -- Ignore access to autom4te.cache directories. -- They are managed externally by auto tools. , "//autom4te.cache/**" + + -- Ignore in-tree GMP objects + , buildRoot -/- "**/gmp/objs/**" ] } ===================================== hadrian/src/Rules/Gmp.hs ===================================== @@ -22,12 +22,10 @@ gmpObjects s = do integerGmpPath <- buildPath ctx need [integerGmpPath -/- "include/ghc-gmp.h"] - -- The line below causes a Shake Lint failure on Windows, which forced - -- us to disable Lint by default (we don't track the object files of the - -- in-tree GMP library). - -- See more details here: https://gitlab.haskell.org/ghc/ghc/issues/15971. gmpPath <- gmpIntreePath s map (unifyPath . (gmpPath -/-)) <$> + -- Note we don't track the object files of the in-tree GMP library (cf + -- #15971). liftIO (getDirectoryFilesIO gmpPath [gmpObjectsDir -/- "*.o"]) -- | Build directory for in-tree GMP library View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/faa36e5b3674a7b2cfc6b931eec27b3558fad33b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/faa36e5b3674a7b2cfc6b931eec27b3558fad33b You're receiving 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 Mar 18 15:58:04 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 18 Mar 2020 11:58:04 -0400 Subject: [Git][ghc/ghc][wip/test] users-guide: Fix :default: fields Message-ID: <5e72450c98401_488a3fc6a691ddac1965719@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/test at Glasgow Haskell Compiler / GHC Commits: 671ac3f6 by Ben Gamari at 2020-03-18T15:57:52Z users-guide: Fix :default: fields - - - - - 1 changed file: - docs/users_guide/using-warnings.rst Changes: ===================================== docs/users_guide/using-warnings.rst ===================================== @@ -221,9 +221,10 @@ of ``-W(no-)*``. encountered on the command line. :type: dynamic :reverse: -Wno-unrecognised-warning-flags - :default: on :category: + :default: on + Enables warnings when the compiler encounters a ``-W...`` flag that is not recognised. @@ -253,9 +254,10 @@ of ``-W(no-)*``. :ghc-flag:`-fdefer-typed-holes`. :type: dynamic :reverse: -Wno-typed-holes - :default: on :category: + :default: on + Determines whether the compiler reports typed holes warnings. Has no effect unless typed holes errors are deferred until runtime. See :ref:`typed-holes` and :ref:`defer-type-errors` View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/671ac3f68327ce7ed0181b5d38c677802085686c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/671ac3f68327ce7ed0181b5d38c677802085686c You're receiving 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 Mar 18 14:06:51 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 18 Mar 2020 10:06:51 -0400 Subject: [Git][ghc/ghc][master] Modules: Core operations (#13009) Message-ID: <5e722afb94a01_488a3fc6ca423d3c1910146@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 528df8ec by Sylvain Henry at 2020-03-18T14:06:43Z Modules: Core operations (#13009) - - - - - 30 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/simplCore/CSE.hs → compiler/GHC/Core/Op/CSE.hs - compiler/simplCore/CallArity.hs → compiler/GHC/Core/Op/CallArity.hs - compiler/prelude/PrelRules.hs → compiler/GHC/Core/Op/ConstantFold.hs - compiler/stranal/CprAnal.hs → compiler/GHC/Core/Op/CprAnal.hs - compiler/stranal/DmdAnal.hs → compiler/GHC/Core/Op/DmdAnal.hs - compiler/simplCore/Exitify.hs → compiler/GHC/Core/Op/Exitify.hs - compiler/simplCore/FloatIn.hs → compiler/GHC/Core/Op/FloatIn.hs - compiler/simplCore/FloatOut.hs → compiler/GHC/Core/Op/FloatOut.hs - compiler/simplCore/LiberateCase.hs → compiler/GHC/Core/Op/LiberateCase.hs - compiler/simplCore/CoreMonad.hs → compiler/GHC/Core/Op/Monad.hs - compiler/simplCore/CoreMonad.hs-boot → compiler/GHC/Core/Op/Monad.hs-boot - compiler/simplCore/OccurAnal.hs → compiler/GHC/Core/Op/OccurAnal.hs - compiler/simplCore/SetLevels.hs → compiler/GHC/Core/Op/SetLevels.hs - compiler/simplCore/Simplify.hs → compiler/GHC/Core/Op/Simplify.hs - compiler/simplCore/SimplCore.hs → compiler/GHC/Core/Op/Simplify/Driver.hs - compiler/simplCore/SimplEnv.hs → compiler/GHC/Core/Op/Simplify/Env.hs - compiler/simplCore/SimplMonad.hs → compiler/GHC/Core/Op/Simplify/Monad.hs - compiler/simplCore/SimplUtils.hs → compiler/GHC/Core/Op/Simplify/Utils.hs - compiler/specialise/SpecConstr.hs → compiler/GHC/Core/Op/SpecConstr.hs - compiler/specialise/Specialise.hs → compiler/GHC/Core/Op/Specialise.hs - compiler/simplCore/SAT.hs → compiler/GHC/Core/Op/StaticArgs.hs - compiler/GHC/Core/Op/Tidy.hs - compiler/stranal/WorkWrap.hs → compiler/GHC/Core/Op/WorkWrap.hs - compiler/stranal/WwLib.hs → compiler/GHC/Core/Op/WorkWrap/Lib.hs - compiler/simplCore/simplifier.tib → compiler/GHC/Core/Op/simplifier.tib The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/528df8ecb4e2f9c78b1ae4ab7ff8230644e9b643 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/528df8ecb4e2f9c78b1ae4ab7ff8230644e9b643 You're receiving 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 Mar 18 22:09:34 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 18 Mar 2020 18:09:34 -0400 Subject: [Git][ghc/ghc][wip/test] Drop compare-flags Message-ID: <5e729c1e84195_488a3fc6a691ddac2033116@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/test at Glasgow Haskell Compiler / GHC Commits: 8769077b by Ben Gamari at 2020-03-18T22:09:25Z Drop compare-flags - - - - - 2 changed files: - − docs/users_guide/compare-flags.py - hadrian/src/Rules/Documentation.hs Changes: ===================================== docs/users_guide/compare-flags.py deleted ===================================== @@ -1,93 +0,0 @@ -#!/usr/bin/env python -# -*- coding: utf-8 -*- - -""" -Linter to verify that all flags reported by GHC's --show-options mode -are documented in the user's guide. -""" - -import sys -import subprocess -from typing import Set -from pathlib import Path - -# A list of known-undocumented flags. This should be considered to be a to-do -# list of flags that need to be documented. -EXPECTED_UNDOCUMENTED_PATH = \ - Path(__file__).parent / 'expected-undocumented-flags.txt' - -EXPECTED_UNDOCUMENTED = \ - {line for line in open(EXPECTED_UNDOCUMENTED_PATH).read().split()} - -def expected_undocumented(flag: str) -> bool: - if flag in EXPECTED_UNDOCUMENTED: - return True - if flag.startswith('-Werror'): - return True - if flag.startswith('-Wno-') \ - or flag.startswith('-dno') \ - or flag.startswith('-fno') \ - or flag.startswith('-XNo'): - return True - if flag.startswith('-Wwarn=') \ - or flag.startswith('-Wno-warn='): - return True - - return False - -def read_documented_flags(doc_flags) -> Set[str]: - # Map characters that mark the end of a flag - # to whitespace. - trans = str.maketrans({ - '=': ' ', - '[': ' ', - '⟨': ' ', - }) - return {line.translate(trans).split()[0] - for line in doc_flags.read().split('\n') - if line != ''} - -def read_ghc_flags(ghc_path: str) -> Set[str]: - ghc_output = subprocess.check_output([ghc_path, '--show-options']) - return {flag - for flag in ghc_output.decode('UTF-8').split('\n') - if not expected_undocumented(flag) - if flag != ''} - -def error(s: str): - print(s, file=sys.stderr) - -def main() -> None: - import argparse - parser = argparse.ArgumentParser() - parser.add_argument('--ghc', type=argparse.FileType('r'), - help='path of GHC executable') - parser.add_argument('--doc-flags', type=argparse.FileType('r'), - help='path of ghc-flags.txt output from Sphinx') - args = parser.parse_args() - - doc_flags = read_documented_flags(args.doc_flags) - ghc_flags = read_ghc_flags(args.ghc.name) - - failed = False - - undocumented = ghc_flags - doc_flags - if len(undocumented) > 0: - error('Found {len_undoc} flags not documented in the users guide:'.format(len_undoc=len(undocumented)), ) - error('\n'.join(' {}'.format(flag) for flag in sorted(undocumented))) - error('') - failed = True - - now_documented = EXPECTED_UNDOCUMENTED.intersection(doc_flags) - if len(now_documented) > 0: - error('Found flags that are documented yet listed in {}:'.format(EXPECTED_UNDOCUMENTED_PATH)) - error('\n'.join(' {}'.format(flag) for flag in sorted(now_documented))) - error('') - failed = True - - if failed: - sys.exit(1) - - -if __name__ == '__main__': - main() ===================================== hadrian/src/Rules/Documentation.hs ===================================== @@ -111,11 +111,6 @@ documentationRules = do need $ map (root -/-) targets - when (SphinxPDFs `Set.member` doctargets) - $ checkUserGuideFlags $ pdfRoot -/- "users_guide" -/- "ghc-flags.txt" - when (SphinxHTML `Set.member` doctargets) - $ checkUserGuideFlags $ root -/- htmlRoot -/- "users_guide" -/- "ghc-flags.txt" - where archiveTarget "libraries" = Haddocks archiveTarget _ = SphinxHTML @@ -129,17 +124,6 @@ checkSphinxWarnings out = do when ("reference target not found" `isInfixOf` log) $ fail "Undefined reference targets found in Sphinx log." --- | Check that all GHC flags are documented in the users guide. -checkUserGuideFlags :: FilePath -> Action () -checkUserGuideFlags documentedFlagList = do - scriptPath <- ( "docs/users_guide/compare-flags.py") <$> topDirectory - ghcPath <- () <$> topDirectory <*> programPath (vanillaContext Stage1 ghc) - runBuilder Python - [ scriptPath - , "--doc-flags", documentedFlagList - , "--ghc", ghcPath - ] [documentedFlagList] [] - ------------------------------------- HTML ------------------------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/8769077b67cae02e09583bf99168da0cb646a08c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/8769077b67cae02e09583bf99168da0cb646a08c You're receiving 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 Mar 18 17:12:17 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Wed, 18 Mar 2020 13:12:17 -0400 Subject: [Git][ghc/ghc][wip/tycl-group] 2 commits: tcLookupTcTyCon for kinded decls Message-ID: <5e72567188585_488a3fc6cb49d8fc1980378@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/tycl-group at Glasgow Haskell Compiler / GHC Commits: f6ef692e by Vladislav Zavialov at 2020-03-18T17:11:56Z tcLookupTcTyCon for kinded decls - - - - - 117800fe by Vladislav Zavialov at 2020-03-18T17:11:56Z split_group test - - - - - 11 changed files: - compiler/GHC/Core/TyCon.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Extension.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Rename/Source.hs - compiler/typecheck/TcEnv.hs - compiler/typecheck/TcHsType.hs - compiler/typecheck/TcRnDriver.hs - compiler/typecheck/TcTyClsDecls.hs Changes: ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -7,6 +7,7 @@ The @TyCon@ datatype -} {-# LANGUAGE CPP, FlexibleInstances #-} +{-# LANGUAGE DeriveDataTypeable #-} module GHC.Core.TyCon( -- * Main TyCon data types @@ -2583,7 +2584,7 @@ data TyConFlavour | TypeSynonymFlavour | BuiltInTypeFlavour -- ^ e.g., the @(->)@ 'TyCon'. | PromotedDataConFlavour - deriving Eq + deriving (Eq, Data.Data) instance Outputable TyConFlavour where ppr = text . go ===================================== compiler/GHC/Driver/Plugins.hs ===================================== @@ -229,7 +229,7 @@ keepRenamedSource _ gbl_env group = update_exports Nothing = Just [] update_exports m = m - update Nothing = Just emptyRnGroup + update Nothing = Just (emptyRnGroup :: HsGroup GhcRn) update m = m ===================================== compiler/GHC/Hs/Decls.hs ===================================== @@ -3,6 +3,7 @@ (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 -} +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable, DeriveFunctor, DeriveFoldable, DeriveTraversable #-} {-# LANGUAGE StandaloneDeriving #-} @@ -30,6 +31,7 @@ module GHC.Hs.Decls ( -- ** Class or type declarations TyClDecl(..), LTyClDecl, DataDeclRn(..), + DeclHeaderRn(..), DeclSigRn(..), TyClGroup(..), tyClGroupTyClDecls, tyClGroupInstDecls, tyClGroupRoleDecls, tyClGroupKindSigs, @@ -43,7 +45,7 @@ module GHC.Hs.Decls ( FamilyDecl(..), LFamilyDecl, -- ** Instance declarations - InstDecl(..), LInstDecl, FamilyInfo(..), + InstDecl(..), LInstDecl, FamilyInfo(..), getFamFlav, TyFamInstDecl(..), LTyFamInstDecl, instDeclDataFamInsts, TyFamDefltDecl, LTyFamDefltDecl, DataFamInstDecl(..), LDataFamInstDecl, @@ -89,11 +91,14 @@ module GHC.Hs.Decls ( resultVariableName, familyDeclLName, familyDeclName, -- * Grouping + KindedDecls(..), isKindedDecl, HsGroup(..), emptyRdrGroup, emptyRnGroup, appendGroups, hsGroupTopLevelFixitySigs, ) where +#include "HsVersions.h" + -- friends: import GhcPrelude @@ -122,6 +127,7 @@ import Bag import Maybes import Data.Data hiding (TyCon,Fixity, Infix) import Data.Void +import qualified Data.Semigroup {- ************************************************************************ @@ -252,15 +258,28 @@ data HsGroup p } | XHsGroup (XXHsGroup p) -type instance XCHsGroup (GhcPass _) = NoExtField +type instance XCHsGroup GhcPs = NoExtField +type instance XCHsGroup GhcRn = KindedDecls +type instance XCHsGroup GhcTc = KindedDecls type instance XXHsGroup (GhcPass _) = NoExtCon +-- | Names of declarations that either have a CUSK or a SAKS. +newtype KindedDecls = KindedDecls NameSet + +instance Semigroup KindedDecls where + KindedDecls a <> KindedDecls b = KindedDecls (unionNameSet a b) + +instance Monoid KindedDecls where + mempty = KindedDecls emptyNameSet -emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup (GhcPass p) +isKindedDecl :: KindedDecls -> TyClDecl GhcRn -> Bool +isKindedDecl (KindedDecls nameSet) d = elemNameSet (tcdName d) nameSet + +emptyGroup, emptyRdrGroup, emptyRnGroup :: Monoid (XCHsGroup (GhcPass p)) => HsGroup (GhcPass p) emptyRdrGroup = emptyGroup { hs_valds = emptyValBindsIn } emptyRnGroup = emptyGroup { hs_valds = emptyValBindsOut } -emptyGroup = HsGroup { hs_ext = noExtField, +emptyGroup = HsGroup { hs_ext = mempty, hs_tyclds = [], hs_derivds = [], hs_fixds = [], hs_defds = [], hs_annds = [], @@ -282,10 +301,12 @@ hsGroupTopLevelFixitySigs (HsGroup{ hs_fixds = fixds, hs_tyclds = tyclds }) = ] hsGroupTopLevelFixitySigs (XHsGroup nec) = noExtCon nec -appendGroups :: HsGroup (GhcPass p) -> HsGroup (GhcPass p) +appendGroups :: Semigroup (XCHsGroup (GhcPass p)) + => HsGroup (GhcPass p) -> HsGroup (GhcPass p) -> HsGroup (GhcPass p) appendGroups HsGroup { + hs_ext = ext1, hs_valds = val_groups1, hs_splcds = spliceds1, hs_tyclds = tyclds1, @@ -298,6 +319,7 @@ appendGroups hs_ruleds = rulds1, hs_docs = docs1 } HsGroup { + hs_ext = ext2, hs_valds = val_groups2, hs_splcds = spliceds2, hs_tyclds = tyclds2, @@ -311,7 +333,7 @@ appendGroups hs_docs = docs2 } = HsGroup { - hs_ext = noExtField, + hs_ext = ext1 Data.Semigroup.<> ext2, hs_valds = val_groups1 `plusHsValBinds` val_groups2, hs_splcds = spliceds1 ++ spliceds2, hs_tyclds = tyclds1 ++ tyclds2, @@ -972,6 +994,28 @@ See Note [Dependency analysis of type, class, and instance decls] in GHC.Rename.Source for more info. -} +-- | Renamed declaration header (left-hand side of a declaration): +-- +-- 1. data T a b = MkT (a -> b) +-- ^^^^^^^^^^ +-- +-- 2. class C a where +-- ^^^^^^^^^ +-- +-- 3. type family F a b :: r where +-- ^^^^^^^^^^^^^^^^^^^^^^ +-- +-- Supplies arity and flavor information not covered by a standalone kind +-- signature. +-- +data DeclHeaderRn + = DeclHeaderRn + { decl_header_flav :: TyConFlavour, + decl_header_name :: Located (IdP GhcRn), + decl_header_bndrs :: LHsQTyVars GhcRn, + decl_header_res_sig :: Maybe (LHsType GhcRn) + } + -- | Type or Class Group data family TyClGroup pass @@ -981,11 +1025,23 @@ data instance TyClGroup GhcPs | TcgPsKiSig (LStandaloneKindSig GhcPs) | TcgPsInst (LInstDecl GhcPs) +-- | Declaration signature (CUSK or SAKS). +data DeclSigRn + = DeclSigRnCUSK + (Located DeclHeaderRn) -- Complete user-specified kind (CUSK) + | DeclSigRnSAKS + (Located DeclHeaderRn) -- Not necessarily a CUSK + (LStandaloneKindSig GhcRn) -- Standalone kind signature (SAKS) + +instance Outputable DeclSigRn where + ppr (DeclSigRnCUSK hdr) = text "CUSK:" <+> ppr (decl_header_name (unLoc hdr)) + ppr (DeclSigRnSAKS _ sig) = ppr sig + -- See Note [TyClGroups and dependency analysis] data instance TyClGroup GhcRn = TcgRn { tcg_rn_tyclds :: [LTyClDecl GhcRn] , tcg_rn_roles :: [LRoleAnnotDecl GhcRn] - , tcg_rn_kisigs :: [LStandaloneKindSig GhcRn] + , tcg_rn_kisigs :: [DeclSigRn] , tcg_rn_instds :: [LInstDecl GhcRn] } newtype instance TyClGroup GhcTc = TcgTc Void @@ -1018,7 +1074,7 @@ tyClGroupKindSigs :: forall p. IsPass p => TyClGroup (GhcPass p) -> [LStandalone tyClGroupKindSigs tcg = case ghcPass @p of GhcPs -> [a | TcgPsKiSig a <- [tcg] ] - GhcRn -> tcg_rn_kisigs tcg + GhcRn -> [a | DeclSigRnSAKS _ a <- tcg_rn_kisigs tcg ] GhcTc -> tcg_tc_absurd tcg {- ********************************************************************* @@ -1175,6 +1231,27 @@ data FamilyInfo pass -- said "type family Foo x where .." | ClosedTypeFamily (Maybe [LTyFamInstEqn pass]) +getFamFlav + :: Maybe TyCon -- ^ Just cls <=> this is an associated family of class cls + -> FamilyInfo pass + -> TyConFlavour +getFamFlav mb_parent_tycon info = + case info of + DataFamily -> DataFamilyFlavour mb_parent_tycon + OpenTypeFamily -> OpenTypeFamilyFlavour mb_parent_tycon + ClosedTypeFamily _ -> ASSERT( isNothing mb_parent_tycon ) -- See Note [Closed type family mb_parent_tycon] + ClosedTypeFamilyFlavour + +{- Note [Closed type family mb_parent_tycon] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +There's no way to write a closed type family inside a class declaration: + + class C a where + type family F a where -- error: parse error on input ‘where’ + +In fact, it is not clear what the meaning of such a declaration would be. +Therefore, 'mb_parent_tycon' of any closed type family has to be Nothing. +-} ------------- Functions over FamilyDecls ----------- ===================================== compiler/GHC/Hs/Extension.hs ===================================== @@ -28,6 +28,7 @@ module GHC.Hs.Extension where import GhcPrelude import Data.Data hiding ( Fixity ) +import Data.Semigroup import Name import RdrName import Var @@ -143,6 +144,12 @@ data NoExtField = NoExtField instance Outputable NoExtField where ppr _ = text "NoExtField" +instance Semigroup NoExtField where + _ <> _ = NoExtField + +instance Monoid NoExtField where + mempty = NoExtField + -- | Used when constructing a term with an unused extension point. noExtField :: NoExtField noExtField = NoExtField ===================================== compiler/GHC/Hs/Instances.hs ===================================== @@ -104,6 +104,8 @@ deriving instance Data (HsDecl GhcPs) deriving instance Data (HsDecl GhcRn) deriving instance Data (HsDecl GhcTc) +deriving instance Data KindedDecls + -- deriving instance (DataIdLR p p) => Data (HsGroup p) deriving instance Data (HsGroup GhcPs) deriving instance Data (HsGroup GhcRn) @@ -119,6 +121,9 @@ deriving instance Data (TyClDecl GhcPs) deriving instance Data (TyClDecl GhcRn) deriving instance Data (TyClDecl GhcTc) +deriving instance Data DeclHeaderRn +deriving instance Data DeclSigRn + -- deriving instance (DataIdLR p p) => Data (TyClGroup p) deriving instance Data (TyClGroup GhcPs) deriving instance Data (TyClGroup GhcRn) ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -1267,7 +1267,7 @@ instance ToHie (TyClGroup GhcRn) where , tcg_rn_instds = instances } = concatM [ toHie classes - , toHie sigs + , toHie [a | DeclSigRnSAKS _ a <- sigs ] , toHie roles , toHie instances ] ===================================== compiler/GHC/Rename/Source.hs ===================================== @@ -52,6 +52,7 @@ import PrelNames ( applicativeClassName, pureAName, thenAName import Name import NameSet import NameEnv +import GHC.Core.TyCon ( TyConFlavour(..) ) import Avail import Outputable import Bag @@ -59,7 +60,8 @@ import BasicTypes ( pprRuleName, TypeOrKind(..) ) import FastString import SrcLoc import GHC.Driver.Session -import Util ( debugIsOn, filterOut, lengthExceeds, partitionWith ) +import Util ( debugIsOn, filterOut, lengthExceeds, + partitionWith, (<&&>) ) import GHC.Driver.Types ( HscEnv, hsc_dflags ) import ListSetOps ( findDupsEq, removeDups, equivClasses ) import Digraph ( SCC, flattenSCC, flattenSCCs, Node(..) @@ -160,7 +162,7 @@ rnSrcDecls group@(HsGroup { hs_valds = val_decls, -- means we'll only report a declaration as unused if it isn't -- mentioned at all. Ah well. traceRn "Start rnTyClDecls" (ppr tycl_decls) ; - (rn_tycl_decls, src_fvs1) <- rnTyClDecls tycl_decls ; + (rn_tycl_decls, kinded_decls, src_fvs1) <- rnTyClDecls tycl_decls ; -- (F) Rename Value declarations right-hand sides traceRn "Start rnmono" empty ; @@ -202,7 +204,7 @@ rnSrcDecls group@(HsGroup { hs_valds = val_decls, last_tcg_env <- getGblEnv ; -- (I) Compute the results and return - let {rn_group = HsGroup { hs_ext = noExtField, + let {rn_group = HsGroup { hs_ext = kinded_decls, hs_valds = rn_val_decls, hs_splcds = rn_splice_decls, hs_tyclds = rn_tycl_decls, @@ -1287,7 +1289,7 @@ constructors] in TcEnv rnTyClDecls :: [TyClGroup GhcPs] - -> RnM ([TyClGroup GhcRn], FreeVars) + -> RnM ([TyClGroup GhcRn], KindedDecls, FreeVars) -- Rename the declarations and do dependency analysis on them rnTyClDecls tycl_ds = do { -- Rename the type/class, instance, and role declaraations @@ -1297,11 +1299,19 @@ rnTyClDecls tycl_ds ; instds_w_fvs <- mapM (wrapLocFstM rnSrcInstDecl) (concatMap tyClGroupInstDecls tycl_ds) ; role_annots <- rnRoleAnnots tc_names (concatMap tyClGroupRoleDecls tycl_ds) + ; cusks_enabled <- xoptM LangExt.CUSKs <&&> xoptM LangExt.PolyKinds + -- See Note [CUSKs and PolyKinds] in TcTyClsDecls + ; let (kisig_env, kisig_fv_env) = mkKindSig_fv_env kisigs_w_fvs + decl_sig_list = + mapMaybe (mkDeclSigRn cusks_enabled kisig_env . fst) $ + tycls_w_fvs + decl_sig_env = mkNameEnv decl_sig_list + kinded_decls = KindedDecls (mkNameSet (map fst decl_sig_list)) + -- Do SCC analysis on the type/class decls ; rdr_env <- getGlobalRdrEnv ; let tycl_sccs = depAnalTyClDecls rdr_env kisig_fv_env tycls_w_fvs role_annot_env = mkRoleAnnotEnv role_annots - (kisig_env, kisig_fv_env) = mkKindSig_fv_env kisigs_w_fvs inst_ds_map = mkInstDeclFreeVarsMap rdr_env tc_names instds_w_fvs (init_inst_ds, rest_inst_ds) = getInsts [] inst_ds_map @@ -1314,38 +1324,105 @@ rnTyClDecls tycl_ds , tcg_rn_instds = init_inst_ds }] (final_inst_ds, groups) - = mapAccumL (mk_group role_annot_env kisig_env) rest_inst_ds tycl_sccs + = mapAccumL (mk_group role_annot_env decl_sig_env) rest_inst_ds tycl_sccs all_fvs = foldr (plusFV . snd) emptyFVs tycls_w_fvs `plusFV` foldr (plusFV . snd) emptyFVs instds_w_fvs `plusFV` foldr (plusFV . snd) emptyFVs kisigs_w_fvs - all_groups = first_group ++ groups + all_groups = concatMap split_group (first_group ++ groups) ; MASSERT2( null final_inst_ds, ppr instds_w_fvs $$ ppr inst_ds_map $$ ppr (flattenSCCs tycl_sccs) $$ ppr final_inst_ds ) ; traceRn "rnTycl dependency analysis made groups" (ppr all_groups) - ; return (all_groups, all_fvs) } + ; return (all_groups, kinded_decls, all_fvs) } where mk_group :: RoleAnnotEnv - -> KindSigEnv + -> NameEnv DeclSigRn -> InstDeclFreeVarsMap -> SCC (LTyClDecl GhcRn) -> (InstDeclFreeVarsMap, TyClGroup GhcRn) - mk_group role_env kisig_env inst_map scc + mk_group role_env decl_sig_env inst_map scc = (inst_map', group) where tycl_ds = flattenSCC scc bndrs = map (tcdName . unLoc) tycl_ds roles = getRoleAnnots bndrs role_env - kisigs = getKindSigs bndrs kisig_env + decl_sigs = getDeclSigs bndrs decl_sig_env (inst_ds, inst_map') = getInsts bndrs inst_map group = TcgRn { tcg_rn_tyclds = tycl_ds - , tcg_rn_kisigs = kisigs + , tcg_rn_kisigs = decl_sigs , tcg_rn_roles = roles , tcg_rn_instds = inst_ds } + split_group :: TyClGroup GhcRn -> [TyClGroup GhcRn] + split_group (TcgRn tyclds [] kisigs []) = + [TcgRn [] [] kisigs [], TcgRn tyclds [] [] []] + split_group g = [g] + +mkDeclSigRn + :: Bool -- ^ CUSKs enabled + -> KindSigEnv + -> LTyClDecl GhcRn + -> Maybe (Name, DeclSigRn) +mkDeclSigRn cusks_enabled kisig_env tcd + -- Stanadlone kind signature + | Just ki <- lookupNameEnv kisig_env name + = Just (name, DeclSigRnSAKS decl_header ki) + -- Complete user-supplied kind + | cusks_enabled && has_cusk + = Just (name, DeclSigRnCUSK decl_header) + -- No signature: needs inference + | otherwise + = Nothing + where + has_cusk = hsDeclHasCusk (unLoc tcd) + name = tcdName (unLoc tcd) + decl_header = mapLoc mkDeclHeaderRn tcd + +mkDeclHeaderRn :: TyClDecl GhcRn -> DeclHeaderRn +mkDeclHeaderRn tcd = case tcd of + -- Class + ClassDecl { tcdLName = name, tcdTyVars = ktvs } + -> DeclHeaderRn + { decl_header_flav = ClassFlavour, + decl_header_name = name, + decl_header_bndrs = ktvs, + decl_header_res_sig = Nothing } + -- Data/Newtype + DataDecl { tcdLName = name + , tcdTyVars = ktvs + , tcdDataDefn = HsDataDefn { dd_kindSig = m_sig + , dd_ND = new_or_data } } + -> DeclHeaderRn + { decl_header_flav = newOrDataToFlavour new_or_data, + decl_header_name = name, + decl_header_bndrs = ktvs, + decl_header_res_sig = m_sig } + -- Type/data family + FamDecl { tcdFam = + FamilyDecl { fdLName = name + , fdTyVars = ktvs + , fdResultSig = L _ resultSig + , fdInfo = info } } + -> DeclHeaderRn + { decl_header_flav = getFamFlav Nothing info, + decl_header_name = name, + decl_header_bndrs = ktvs, + decl_header_res_sig = famResultKindSignature resultSig } + -- Type synonym + SynDecl { tcdLName = name, tcdTyVars = ktvs, tcdRhs = rhs } + -> DeclHeaderRn + { decl_header_flav = TypeSynonymFlavour, + decl_header_name = name, + decl_header_bndrs = ktvs, + decl_header_res_sig = hsTyKindSig rhs } + -- Impossible cases + DataDecl _ _ _ _ (XHsDataDefn nec) -> noExtCon nec + FamDecl {tcdFam = XFamilyDecl nec} -> noExtCon nec + XTyClDecl nec -> noExtCon nec + -- | Free variables of standalone kind signatures. newtype KindSig_FV_Env = KindSig_FV_Env (NameEnv FreeVars) @@ -1364,8 +1441,8 @@ mkKindSig_fv_env kisigs_w_fvs = (kisig_env, kisig_fv_env) compound_env :: NameEnv (LStandaloneKindSig GhcRn, FreeVars) = mkNameEnvWith (standaloneKindSigName . unLoc . fst) kisigs_w_fvs -getKindSigs :: [Name] -> KindSigEnv -> [LStandaloneKindSig GhcRn] -getKindSigs bndrs kisig_env = mapMaybe (lookupNameEnv kisig_env) bndrs +getDeclSigs :: [Name] -> NameEnv DeclSigRn -> [DeclSigRn] +getDeclSigs bndrs decl_sig_env = mapMaybe (lookupNameEnv decl_sig_env) bndrs rnStandaloneKindSignatures :: NameSet -- names of types and classes in the current TyClGroup ===================================== compiler/typecheck/TcEnv.hs ===================================== @@ -464,7 +464,7 @@ tcLookupTcTyCon name = do thing <- tcLookup name case thing of ATcTyCon tc -> return tc - _ -> pprPanic "tcLookupTcTyCon" (ppr name) + _ -> pprPanic "tcLookupTcTyCon" (ppr thing) getInLocalScope :: TcM (Name -> Bool) getInLocalScope = do { lcl_env <- getLclTypeEnv ===================================== compiler/typecheck/TcHsType.hs ===================================== @@ -251,8 +251,8 @@ tcHsSigType ctxt sig_ty skol_info = SigTypeSkol ctxt -- Does validity checking and zonking. -tcStandaloneKindSig :: LStandaloneKindSig GhcRn -> TcM (Name, Kind) -tcStandaloneKindSig (L _ kisig) = case kisig of +tcStandaloneKindSig :: StandaloneKindSig GhcRn -> TcM (Name, Kind) +tcStandaloneKindSig kisig = case kisig of StandaloneKindSig _ (L _ name) ksig -> let ctxt = StandaloneKindSigCtxt name in addSigCtxt ctxt (hsSigType ksig) $ ===================================== compiler/typecheck/TcRnDriver.hs ===================================== @@ -625,7 +625,8 @@ tcRnHsBootDecls hsc_src decls = do { (first_group, group_tail) <- findSplice decls -- Rename the declarations - ; (tcg_env, HsGroup { hs_tyclds = tycl_decls + ; (tcg_env, HsGroup { hs_ext = kinded_decls + , hs_tyclds = tycl_decls , hs_derivds = deriv_decls , hs_fords = for_decls , hs_defds = def_decls @@ -653,7 +654,7 @@ tcRnHsBootDecls hsc_src decls -- Typecheck type/class/instance decls ; traceTc "Tc2 (boot)" empty ; (tcg_env, inst_infos, _deriv_binds) - <- tcTyClsInstDecls tycl_decls deriv_decls val_binds + <- tcTyClsInstDecls kinded_decls tycl_decls deriv_decls val_binds ; setGblEnv tcg_env $ do { -- Emit Typeable bindings @@ -1396,7 +1397,8 @@ rnTopSrcDecls group } tcTopSrcDecls :: HsGroup GhcRn -> TcM (TcGblEnv, TcLclEnv) -tcTopSrcDecls (HsGroup { hs_tyclds = tycl_decls, +tcTopSrcDecls (HsGroup { hs_ext = kinded_decls, + hs_tyclds = tycl_decls, hs_derivds = deriv_decls, hs_fords = foreign_decls, hs_defds = default_decls, @@ -1412,7 +1414,7 @@ tcTopSrcDecls (HsGroup { hs_tyclds = tycl_decls, -- and import the supporting declarations traceTc "Tc3" empty ; (tcg_env, inst_infos, XValBindsLR (NValBinds deriv_binds deriv_sigs)) - <- tcTyClsInstDecls tycl_decls deriv_decls val_binds ; + <- tcTyClsInstDecls kinded_decls tycl_decls deriv_decls val_binds ; setGblEnv tcg_env $ do { @@ -1681,7 +1683,8 @@ tcMissingParentClassWarn warnFlag isName shouldName --------------------------- -tcTyClsInstDecls :: [TyClGroup GhcRn] +tcTyClsInstDecls :: KindedDecls + -> [TyClGroup GhcRn] -> [LDerivDecl GhcRn] -> [(RecFlag, LHsBinds GhcRn)] -> TcM (TcGblEnv, -- The full inst env @@ -1691,11 +1694,11 @@ tcTyClsInstDecls :: [TyClGroup GhcRn] HsValBinds GhcRn) -- Supporting bindings for derived -- instances -tcTyClsInstDecls tycl_decls deriv_decls binds +tcTyClsInstDecls kinded_decls tycl_decls deriv_decls binds = tcAddDataFamConPlaceholders (tycl_decls >>= tyClGroupInstDecls) $ tcAddPatSynPlaceholders (getPatSynBinds binds) $ do { (tcg_env, inst_info, deriv_info) - <- tcTyAndClassDecls tycl_decls ; + <- tcTyAndClassDecls kinded_decls tycl_decls ; ; setGblEnv tcg_env $ do { -- With the @TyClDecl at s and @InstDecl at s checked we're ready to -- process the deriving clauses, including data family deriving ===================================== compiler/typecheck/TcTyClsDecls.hs ===================================== @@ -123,7 +123,25 @@ Thus, we take two passes over the resulting tycons, first checking for general validity and then checking for valid role annotations. -} -tcTyAndClassDecls :: [TyClGroup GhcRn] -- Mutually-recursive groups in +-- | TcTyCons generated from SAKS/CUSKs, whose definitions occur in a later TyClGroup. +newtype InterGroupEnv = InterGroupEnv (NameEnv TcTyCon) + +emptyInterGroupEnv :: InterGroupEnv +emptyInterGroupEnv = InterGroupEnv emptyNameEnv + +extendInterGroupEnv :: [TcTyCon] -> InterGroupEnv -> InterGroupEnv +extendInterGroupEnv tcs (InterGroupEnv env) = InterGroupEnv (extendNameEnvList env named_tcs) + where named_tcs = map (\tc -> (tyConName tc, tc)) tcs + +purgeInterGroupEnv :: [TcTyCon] -> InterGroupEnv -> InterGroupEnv +purgeInterGroupEnv tcs (InterGroupEnv env) = InterGroupEnv (delListFromNameEnv env tcs_names) + where tcs_names = map tyConName tcs + +interGroupEnvTyCons :: InterGroupEnv -> [TcTyCon] +interGroupEnvTyCons (InterGroupEnv env )= nameEnvElts env + +tcTyAndClassDecls :: KindedDecls + -> [TyClGroup GhcRn] -- Mutually-recursive groups in -- dependency order -> TcM ( TcGblEnv -- Input env extended by types and -- classes @@ -132,32 +150,38 @@ tcTyAndClassDecls :: [TyClGroup GhcRn] -- Mutually-recursive groups in , [DerivInfo] -- Deriving info ) -- Fails if there are any errors -tcTyAndClassDecls tyclds_s +tcTyAndClassDecls kinded_decls tyclds_s -- The code recovers internally, but if anything gave rise to -- an error we'd better stop now, to avoid a cascade -- Type check each group in dependency order folding the global env - = checkNoErrs $ fold_env [] [] tyclds_s + = checkNoErrs $ fold_env emptyInterGroupEnv [] [] tyclds_s where - fold_env :: [InstInfo GhcRn] + fold_env :: InterGroupEnv + -> [InstInfo GhcRn] -> [DerivInfo] -> [TyClGroup GhcRn] -> TcM (TcGblEnv, [InstInfo GhcRn], [DerivInfo]) - fold_env inst_info deriv_info [] + fold_env _ inst_info deriv_info [] = do { gbl_env <- getGblEnv ; return (gbl_env, inst_info, deriv_info) } - fold_env inst_info deriv_info (tyclds:tyclds_s) - = do { (tcg_env, inst_info', deriv_info') <- tcTyClGroup tyclds + fold_env inter_group_env inst_info deriv_info (tyclds:tyclds_s) + = do { (tcg_env, inter_group_env', inst_info', deriv_info') <- + tcTyClGroup kinded_decls inter_group_env tyclds ; setGblEnv tcg_env $ -- remaining groups are typechecked in the extended global env. - fold_env (inst_info' ++ inst_info) + fold_env inter_group_env' + (inst_info' ++ inst_info) (deriv_info' ++ deriv_info) tyclds_s } -tcTyClGroup :: TyClGroup GhcRn - -> TcM (TcGblEnv, [InstInfo GhcRn], [DerivInfo]) +tcTyClGroup :: KindedDecls + -> InterGroupEnv + -> TyClGroup GhcRn + -> TcM (TcGblEnv, InterGroupEnv, [InstInfo GhcRn], [DerivInfo]) -- Typecheck one strongly-connected component of type, class, and instance decls -- See Note [TyClGroups and dependency analysis] in GHC.Hs.Decls -tcTyClGroup (TcgRn { tcg_rn_tyclds = tyclds +tcTyClGroup kinded_decls inter_group_env + (TcgRn { tcg_rn_tyclds = tyclds , tcg_rn_roles = roles , tcg_rn_kisigs = kisigs , tcg_rn_instds = instds }) @@ -166,10 +190,18 @@ tcTyClGroup (TcgRn { tcg_rn_tyclds = tyclds -- Step 1: Typecheck the standalone kind signatures and type/class declarations ; traceTc "---- tcTyClGroup ---- {" empty ; traceTc "Decls for" (ppr (map (tcdName . unLoc) tyclds)) - ; (tyclss, data_deriv_info) <- + ; (inter_group_env', tyclss, data_deriv_info) <- tcExtendKindEnv (mkPromotionErrorEnv tyclds) $ -- See Note [Type environment evolution] - do { kisig_env <- mkNameEnv <$> traverse tcStandaloneKindSig kisigs - ; tcTyClDecls tyclds kisig_env role_annots } + do { checked_tcs <- + tcExtendKindEnv (mkSigPromotionErrorEnv kisigs) $ + traverse tcDeclSig kisigs + ; let extended_inter_group_env = extendInterGroupEnv checked_tcs inter_group_env + ; (tyclss, data_deriv_info) <- + tcExtendKindEnvWithTyCons (interGroupEnvTyCons extended_inter_group_env) $ + tcTyClDecls tyclds kinded_decls role_annots + ; let purged_inter_group_env = purgeInterGroupEnv tyclss extended_inter_group_env + ; return (purged_inter_group_env, tyclss, data_deriv_info) + } -- Step 1.5: Make sure we don't have any type synonym cycles ; traceTc "Starting synonym cycle check" (ppr tyclss) @@ -200,21 +232,66 @@ tcTyClGroup (TcgRn { tcg_rn_tyclds = tyclds tcInstDecls1 instds ; let deriv_info = datafam_deriv_info ++ data_deriv_info - ; return (gbl_env', inst_info, deriv_info) } + ; return (gbl_env', inter_group_env', inst_info, deriv_info) } + +tcDeclSig :: DeclSigRn -> TcM TcTyCon +tcDeclSig (DeclSigRnCUSK (L l hdr)) = + setSrcSpan l $ check_decl_sig CUSK hdr +tcDeclSig (DeclSigRnSAKS (L l_hdr hdr) (L l_sig kisig)) = do + (_, ki) <- setSrcSpan l_sig $ tcStandaloneKindSig kisig + setSrcSpan l_hdr $ check_decl_sig (SAKS ki) hdr + +check_decl_sig :: SAKS_or_CUSK -> DeclHeaderRn -> TcM TcTyCon +check_decl_sig msig hdr = + kcDeclHeader (InitialKindCheck msig) name flav (decl_header_bndrs hdr) $ + if | flav == ClassFlavour + -> return (TheKind constraintKind) + + | flav == DataTypeFlavour + -> case res_sig of + Just ksig -> TheKind <$> tcLHsKindSig (DataKindCtxt name) ksig + Nothing -> return $ dataDeclDefaultResultKind DataType + + | flav == NewtypeFlavour + -> case res_sig of + Just ksig -> TheKind <$> tcLHsKindSig (DataKindCtxt name) ksig + Nothing -> return $ dataDeclDefaultResultKind NewType + + | is_fam_flav flav + -> case res_sig of + Just ksig -> TheKind <$> tcLHsKindSig (TyFamResKindCtxt name) ksig + Nothing -> + case msig of + CUSK -> return (TheKind liftedTypeKind) + SAKS _ -> return AnyKind + + | flav == TypeSynonymFlavour + -> case res_sig of + Just rhs_sig -> TheKind <$> tcLHsKindSig (TySynKindCtxt name) rhs_sig + Nothing -> return AnyKind + + | otherwise -> return AnyKind + where + L _ name = decl_header_name hdr + flav = decl_header_flav hdr + res_sig = decl_header_res_sig hdr --- Gives the kind for every TyCon that has a standalone kind signature -type KindSigEnv = NameEnv Kind +is_fam_flav :: TyConFlavour -> Bool +is_fam_flav DataFamilyFlavour{} = True +is_fam_flav OpenTypeFamilyFlavour{} = True +is_fam_flav ClosedTypeFamilyFlavour = True +is_fam_flav _ = False tcTyClDecls :: [LTyClDecl GhcRn] - -> KindSigEnv + -> KindedDecls -> RoleAnnotEnv -> TcM ([TyCon], [DerivInfo]) -tcTyClDecls tyclds kisig_env role_annots +tcTyClDecls tyclds kinded_decls role_annots = do { -- Step 1: kind-check this group and returns the final -- (possibly-polymorphic) kind of each TyCon and Class -- See Note [Kind checking for type and class decls] - tc_tycons <- kcTyClGroup kisig_env tyclds + tc_tycons <- kcTyClGroup kinded_decls tyclds ; traceTc "tcTyAndCl generalized kinds" (vcat (map ppr_tc_tycon tc_tycons)) -- Step 2: type-check all groups together, returning @@ -615,13 +692,13 @@ been generalized. -} -kcTyClGroup :: KindSigEnv -> [LTyClDecl GhcRn] -> TcM [TcTyCon] +kcTyClGroup :: KindedDecls -> [LTyClDecl GhcRn] -> TcM [TcTyCon] -- Kind check this group, kind generalize, and return the resulting local env -- This binds the TyCons and Classes of the group, but not the DataCons -- See Note [Kind checking for type and class decls] -- and Note [Inferring kinds for type declarations] -kcTyClGroup kisig_env decls +kcTyClGroup kd_set decls = do { mod <- getModule ; traceTc "---- kcTyClGroup ---- {" (text "module" <+> ppr mod $$ vcat (map ppr decls)) @@ -632,22 +709,16 @@ kcTyClGroup kisig_env decls -- 3. Generalise the inferred kinds -- See Note [Kind checking for type and class decls] - ; cusks_enabled <- xoptM LangExt.CUSKs <&&> xoptM LangExt.PolyKinds - -- See Note [CUSKs and PolyKinds] ; let (kindless_decls, kinded_decls) = partitionWith get_kind decls - get_kind d - | Just ki <- lookupNameEnv kisig_env (tcdName (unLoc d)) - = Right (d, SAKS ki) - - | cusks_enabled && hsDeclHasCusk (unLoc d) - = Right (d, CUSK) + get_kind (L l d) + | isKindedDecl kd_set d = Right d + | otherwise = Left (L l d) - | otherwise = Left d - - ; checked_tcs <- checkInitialKinds kinded_decls + ; (checked_tcs, concat -> checked_assoc_tcs) <- + mapAndUnzipM checkKindedDecl kinded_decls ; inferred_tcs - <- tcExtendKindEnvWithTyCons checked_tcs $ + <- tcExtendKindEnvWithTyCons checked_assoc_tcs $ pushTcLevelM_ $ -- We are going to kind-generalise, so -- unification variables in here must -- be one level in @@ -676,7 +747,7 @@ kcTyClGroup kisig_env decls ; generalized_tcs <- concatMapM (generaliseTyClDecl inferred_tc_env) kindless_decls - ; let poly_tcs = checked_tcs ++ generalized_tcs + ; let poly_tcs = checked_tcs ++ checked_assoc_tcs ++ generalized_tcs ; traceTc "---- kcTyClGroup end ---- }" (ppr_tc_kinds poly_tcs) ; return poly_tcs } where @@ -1251,6 +1322,21 @@ mk_prom_err_env decl = unitNameEnv (tcdName decl) (APromotionErr TyConPE) -- Works for family declarations too +mkSigPromotionErrorEnv :: [DeclSigRn] -> TcTypeEnv +mkSigPromotionErrorEnv = + foldr (plusNameEnv . mk_sig_prom_err_env) emptyNameEnv + +mk_sig_prom_err_env :: DeclSigRn -> TcTypeEnv +mk_sig_prom_err_env sig = + unitNameEnv (unLoc (decl_header_name hdr)) + (case decl_header_flav hdr of + ClassFlavour -> APromotionErr ClassPE + _ -> APromotionErr TyConPE) + where + hdr = case sig of + DeclSigRnCUSK (L _ h) -> h + DeclSigRnSAKS (L _ h) _ -> h + -------------- inferInitialKinds :: [LTyClDecl GhcRn] -> TcM [TcTyCon] -- Returns a TcTyCon for each TyCon bound by the decls, @@ -1258,27 +1344,24 @@ inferInitialKinds :: [LTyClDecl GhcRn] -> TcM [TcTyCon] inferInitialKinds decls = do { traceTc "inferInitialKinds {" $ ppr (map (tcdName . unLoc) decls) - ; tcs <- concatMapM infer_initial_kind decls + ; tcs <- concatMapM (addLocM inferInitialKind) decls ; traceTc "inferInitialKinds done }" empty ; return tcs } - where - infer_initial_kind = addLocM (getInitialKind InitialKindInfer) - --- Check type/class declarations against their standalone kind signatures or --- CUSKs, producing a generalized TcTyCon for each. -checkInitialKinds :: [(LTyClDecl GhcRn, SAKS_or_CUSK)] -> TcM [TcTyCon] -checkInitialKinds decls - = do { traceTc "checkInitialKinds {" $ ppr (mapFst (tcdName . unLoc) decls) - ; tcs <- concatMapM check_initial_kind decls - ; traceTc "checkInitialKinds done }" empty - ; return tcs } - where - check_initial_kind (ldecl, msig) = - addLocM (getInitialKind (InitialKindCheck msig)) ldecl --- | Get the initial kind of a TyClDecl, either generalized or non-generalized, --- depending on the 'InitialKindStrategy'. -getInitialKind :: InitialKindStrategy -> TyClDecl GhcRn -> TcM [TcTyCon] +checkKindedDecl :: TyClDecl GhcRn -> TcM (TcTyCon, [TcTyCon]) +checkKindedDecl (ClassDecl { tcdLName = L _ name , tcdATs = ats }) + = do { cls <- tcLookupTcTyCon name + ; let parent_tv_prs = tcTyConScopedTyVars cls + ; inner_tcs <- + tcExtendNameTyVarEnv parent_tv_prs $ + mapM (addLocM (check_initial_kind_assoc_fam cls)) ats + ; return (cls, inner_tcs) } +checkKindedDecl d + = do { tc <- tcLookupTcTyCon (tcdName d) + ; return (tc, []) } + +-- | Get the initial, non-generalized kind of a TyClDecl. +inferInitialKind :: TyClDecl GhcRn -> TcM [TcTyCon] -- Allocate a fresh kind variable for each TyCon and Class -- For each tycon, return a TcTyCon with kind k @@ -1293,71 +1376,49 @@ getInitialKind :: InitialKindStrategy -> TyClDecl GhcRn -> TcM [TcTyCon] -- * The result kinds signature on a TyClDecl -- -- No family instances are passed to checkInitialKinds/inferInitialKinds -getInitialKind strategy +inferInitialKind (ClassDecl { tcdLName = L _ name , tcdTyVars = ktvs , tcdATs = ats }) - = do { cls <- kcDeclHeader strategy name ClassFlavour ktvs $ + = do { cls <- kcDeclHeader InitialKindInfer name ClassFlavour ktvs $ return (TheKind constraintKind) ; let parent_tv_prs = tcTyConScopedTyVars cls -- See Note [Don't process associated types in getInitialKind] ; inner_tcs <- tcExtendNameTyVarEnv parent_tv_prs $ - mapM (addLocM (getAssocFamInitialKind cls)) ats + mapM (addLocM (get_fam_decl_initial_kind (Just cls))) ats ; return (cls : inner_tcs) } - where - getAssocFamInitialKind cls = - case strategy of - InitialKindInfer -> get_fam_decl_initial_kind (Just cls) - InitialKindCheck _ -> check_initial_kind_assoc_fam cls -getInitialKind strategy +inferInitialKind (DataDecl { tcdLName = L _ name , tcdTyVars = ktvs , tcdDataDefn = HsDataDefn { dd_kindSig = m_sig , dd_ND = new_or_data } }) = do { let flav = newOrDataToFlavour new_or_data ctxt = DataKindCtxt name - ; tc <- kcDeclHeader strategy name flav ktvs $ + ; tc <- kcDeclHeader InitialKindInfer name flav ktvs $ case m_sig of Just ksig -> TheKind <$> tcLHsKindSig ctxt ksig Nothing -> return $ dataDeclDefaultResultKind new_or_data ; return [tc] } -getInitialKind InitialKindInfer (FamDecl { tcdFam = decl }) +inferInitialKind (FamDecl { tcdFam = decl }) = do { tc <- get_fam_decl_initial_kind Nothing decl ; return [tc] } -getInitialKind (InitialKindCheck msig) (FamDecl { tcdFam = - FamilyDecl { fdLName = unLoc -> name - , fdTyVars = ktvs - , fdResultSig = unLoc -> resultSig - , fdInfo = info } } ) - = do { let flav = getFamFlav Nothing info - ctxt = TyFamResKindCtxt name - ; tc <- kcDeclHeader (InitialKindCheck msig) name flav ktvs $ - case famResultKindSignature resultSig of - Just ksig -> TheKind <$> tcLHsKindSig ctxt ksig - Nothing -> - case msig of - CUSK -> return (TheKind liftedTypeKind) - SAKS _ -> return AnyKind - ; return [tc] } - -getInitialKind strategy +inferInitialKind (SynDecl { tcdLName = L _ name , tcdTyVars = ktvs , tcdRhs = rhs }) = do { let ctxt = TySynKindCtxt name - ; tc <- kcDeclHeader strategy name TypeSynonymFlavour ktvs $ + ; tc <- kcDeclHeader InitialKindInfer name TypeSynonymFlavour ktvs $ case hsTyKindSig rhs of Just rhs_sig -> TheKind <$> tcLHsKindSig ctxt rhs_sig Nothing -> return AnyKind ; return [tc] } -getInitialKind _ (DataDecl _ _ _ _ (XHsDataDefn nec)) = noExtCon nec -getInitialKind _ (FamDecl {tcdFam = XFamilyDecl nec}) = noExtCon nec -getInitialKind _ (XTyClDecl nec) = noExtCon nec +inferInitialKind (DataDecl _ _ _ _ (XHsDataDefn nec)) = noExtCon nec +inferInitialKind (XTyClDecl nec) = noExtCon nec get_fam_decl_initial_kind :: Maybe TcTyCon -- ^ Just cls <=> this is an associated family of class cls @@ -1470,29 +1531,6 @@ See Note [Implementation of UnliftedNewtypes], STEP 1 and it's sub-note . -} ---------------------------------- -getFamFlav - :: Maybe TcTyCon -- ^ Just cls <=> this is an associated family of class cls - -> FamilyInfo pass - -> TyConFlavour -getFamFlav mb_parent_tycon info = - case info of - DataFamily -> DataFamilyFlavour mb_parent_tycon - OpenTypeFamily -> OpenTypeFamilyFlavour mb_parent_tycon - ClosedTypeFamily _ -> ASSERT( isNothing mb_parent_tycon ) -- See Note [Closed type family mb_parent_tycon] - ClosedTypeFamilyFlavour - -{- Note [Closed type family mb_parent_tycon] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -There's no way to write a closed type family inside a class declaration: - - class C a where - type family F a where -- error: parse error on input ‘where’ - -In fact, it is not clear what the meaning of such a declaration would be. -Therefore, 'mb_parent_tycon' of any closed type family has to be Nothing. --} - ------------------------------------------------------------------------ kcLTyClDecl :: LTyClDecl GhcRn -> TcM () -- See Note [Kind checking for type and class decls] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/75b41923593348964d40ccbcf27b864240fa0658...117800fe7631e454ac7e7db9976c2548bc79f349 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/75b41923593348964d40ccbcf27b864240fa0658...117800fe7631e454ac7e7db9976c2548bc79f349 You're receiving 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 Mar 18 13:35:02 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 18 Mar 2020 09:35:02 -0400 Subject: [Git][ghc/ghc][wip/dataToTag-opt] Use pointer tag in dataToTag# Message-ID: <5e72238662d55_488a3fc6f8fa0cb8189669b@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/dataToTag-opt at Glasgow Haskell Compiler / GHC Commits: 5fc521a0 by Ben Gamari at 2020-03-18T13:34:56Z Use pointer tag in dataToTag# While looking at !2873 I noticed that dataToTag# previously didn't look at a pointer's tag to determine its constructor. To be fair, there is a bit of a trade-off here: using the pointer tag requires a bit more code and another branch. On the other hand, it allows us to eliminate looking at the info table in many cases (especially now since we tag large constructor families; see #14373). - - - - - 1 changed file: - compiler/GHC/StgToCmm/Expr.hs Changes: ===================================== compiler/GHC/StgToCmm/Expr.hs ===================================== @@ -35,6 +35,7 @@ import GHC.Stg.Syntax import GHC.Cmm.Graph import GHC.Cmm.BlockId import GHC.Cmm hiding ( succ ) +import GHC.Cmm.Utils ( zeroExpr, cmmTagMask ) import GHC.Cmm.Info import GHC.Core import DataCon @@ -69,14 +70,39 @@ cgExpr (StgOpApp (StgPrimOp SeqOp) [StgVarArg a, _] _res_ty) = cgIdApp a [] -- dataToTag# :: a -> Int# --- See Note [dataToTag#] in primops.txt.pp +-- See Note [dataToTag# magic] in PrelRules. cgExpr (StgOpApp (StgPrimOp DataToTagOp) [StgVarArg a] _res_ty) = do dflags <- getDynFlags emitComment (mkFastString "dataToTag#") - tmp <- newTemp (bWord dflags) - _ <- withSequel (AssignTo [tmp] False) (cgIdApp a []) - -- TODO: For small types look at the tag bits instead of reading info table - emitReturn [getConstrTag dflags (cmmUntag dflags (CmmReg (CmmLocal tmp)))] + info <- getCgIdInfo a + tag_reg <- assignTemp $ cmmConstrTag1 dflags (idInfoToAmode info) + result_reg <- newTemp (bWord dflags) + let tag = CmmReg $ CmmLocal tag_reg + -- Here we will first check the tag bits of the pointer we were given; + -- if this doesn't work then enter the closure and use the info table + -- to determine the constructor. Note that all tag bits set means that + -- the constructor index is too large to fit in the pointer and therefore + -- we must look in the info table. See Note [Tagging big families]. + + slow_path <- getCode $ do + tmp <- newTemp (bWord dflags) + _ <- withSequel (AssignTo [tmp] False) (cgIdApp a []) + -- TODO: For small types look at the tag bits instead of reading info table + emitAssign (CmmLocal result_reg) + $ getConstrTag dflags (cmmUntag dflags (CmmReg (CmmLocal tmp))) + + fast_path <- getCode $ do + emitAssign (CmmLocal result_reg) + $ cmmSubWord dflags tag (CmmLit $ mkWordCLit dflags 1) + + let not_evald_tag = zeroExpr dflags + too_big_tag = cmmTagMask dflags + is_tagged = cmmOrWord dflags + (cmmEqWord dflags tag not_evald_tag) + (cmmEqWord dflags tag too_big_tag) + emit =<< mkCmmIfThenElse' is_tagged slow_path fast_path (Just False) + emitReturn [CmmReg $ CmmLocal result_reg] + cgExpr (StgOpApp op args ty) = cgOpApp op args ty cgExpr (StgConApp con args _)= cgConApp con args View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/5fc521a016aaf7385d77bde43bdaba8ec0e96c10 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/5fc521a016aaf7385d77bde43bdaba8ec0e96c10 You're receiving 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 Mar 19 13:37:14 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 19 Mar 2020 09:37:14 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/fix-win32-tarball-path Message-ID: <5e73758a55963_488a3fc6f87158a021160d8@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/fix-win32-tarball-path at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/fix-win32-tarball-path You're receiving 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 Mar 19 04:39:31 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 19 Mar 2020 00:39:31 -0400 Subject: [Git][ghc/ghc][master] Update "GHC differences to the FFI Chapter" in user guide. Message-ID: <5e72f783915b3_488a3fc6f8fa0cb82047210@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5cbf9934 by Andreas Klebinger at 2020-03-19T04:39:27Z 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] - - - - - 1 changed file: - docs/users_guide/exts/ffi.rst Changes: ===================================== docs/users_guide/exts/ffi.rst ===================================== @@ -37,31 +37,51 @@ Guaranteed call safety ~~~~~~~~~~~~~~~~~~~~~~ The Haskell 2010 Report specifies that ``safe`` FFI calls must allow foreign -calls to safely call into Haskell code. In practice, this means that the -garbage collector must be able to run while these calls are in progress, -moving heap-allocated Haskell values around arbitrarily. +calls to safely call into Haskell code. In practice, this means that called +functions also have to assume heap-allocated Haskell values may move around +arbitrarily in order to allow for GC. This greatly constrains library authors since it implies that it is not safe to pass any heap object reference to a ``safe`` foreign function call. For -instance, it is often desirable to pass an :ref:`unpinned ` +instance, it is often desirable to pass :ref:`unpinned ` ``ByteArray#``\s directly to native code to avoid making an otherwise-unnecessary -copy. However, this can only be done safely if the array is guaranteed not to be -moved by the garbage collector in the middle of the call. +copy. However, this can not be done safely for ``safe`` calls since the array might +be moved by the garbage collector in the middle of the call. -The Chapter does *not* require implementations to refrain from doing the -same for ``unsafe`` calls, so strictly Haskell 2010-conforming programs +The Chapter *does* allow for implementations to move objects around during +``unsafe`` calls as well. So strictly Haskell 2010-conforming programs cannot pass heap-allocated references to ``unsafe`` FFI calls either. +GHC, since version 8.4, **guarantees** that garbage collection will never occur +during an ``unsafe`` call, even in the bytecode interpreter, and further guarantees +that ``unsafe`` calls will be performed in the calling thread. Making it safe to +pass heap-allocated objects to unsafe functions. + In previous releases, GHC would take advantage of the freedom afforded by the Chapter by performing ``safe`` foreign calls in place of ``unsafe`` calls in the bytecode interpreter. This meant that some packages which worked when -compiled would fail under GHCi (e.g. :ghc-ticket:`13730`). +compiled would fail under GHCi (e.g. :ghc-ticket:`13730`). But this is no +longer the case in recent releases. + +Interactions between ``safe`` calls and bound threads +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +A ``safe`` call calling into haskell is run on a bound thread by +the RTS. This means any nesting of ``safe`` calls will be executed on +the same operating system thread. *Sequential* ``safe`` calls however +do not enjoy this luxury and may be run on arbitrary OS threads. -However, since version 8.4 this is no longer the case: GHC **guarantees** that -garbage collection will never occur during an ``unsafe`` call, even in the -bytecode interpreter, and further guarantees that ``unsafe`` calls will be -performed in the calling thread. +This behaviour is considered an implementation detail and code relying on +thread local state should instead use one of the interfaces provided +in :base-ref:`Control.Concurrent.` to make this explicit. +For information on what bound threads are, +see the documentation for the :base-ref:`Control.Concurrent.`. + +For more details on the implementation see the Paper: +"Extending the Haskell Foreign Function Interface with Concurrency". +Last known to be accessible `here +`_. .. _ffi-ghcexts: @@ -100,7 +120,7 @@ restrictions: of heap objects record writes for the purpose of garbage collection. An array of heap objects is passed to a foreign C function, the runtime does not record any writes. Consequently, it is not safe to - write to an array of heap objects in a foreign function. + write to an array of heap objects in a foreign function. Since the runtime has no facilities for tracking mutation of a ``MutableByteArray#``, these can be safely mutated in any foreign function. @@ -169,7 +189,7 @@ In other situations, the C function may need knowledge of the RTS closure types. The following example sums the first element of each ``ByteArray#`` (interpreting the bytes as an array of ``CInt``) element of an ``ArrayArray##`` [3]_:: - + // C source, must include the RTS to make the struct StgArrBytes // available along with its fields: ptrs and payload. #include "Rts.h" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/5cbf9934c59f7726781cc4cccf4748a5c09c4997 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/5cbf9934c59f7726781cc4cccf4748a5c09c4997 You're receiving 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 Mar 18 19:35:49 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 18 Mar 2020 15:35:49 -0400 Subject: [Git][ghc/ghc][wip/test] 3 commits: docs/compare-flags: Don't use python f-strings Message-ID: <5e72781553538_488a3fc6cb49d8fc2005296@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/test at Glasgow Haskell Compiler / GHC Commits: 544e24e1 by Ben Gamari at 2020-03-18T19:35:34Z docs/compare-flags: Don't use python f-strings - - - - - 24966161 by Ben Gamari at 2020-03-18T19:35:38Z compare-flags: Don't rely on encoding flag of subprocess.check_output Apparently it isn't supported by some slightly older Python versions. - - - - - 0fd7e009 by Ben Gamari at 2020-03-18T19:35:42Z compare-flags: Fix output - - - - - 1 changed file: - docs/users_guide/compare-flags.py Changes: ===================================== docs/users_guide/compare-flags.py ===================================== @@ -48,13 +48,15 @@ def read_documented_flags(doc_flags) -> Set[str]: if line != ''} def read_ghc_flags(ghc_path: str) -> Set[str]: - ghc_output = subprocess.check_output([ghc_path, '--show-options'], - encoding='UTF-8') + ghc_output = subprocess.check_output([ghc_path, '--show-options']) return {flag - for flag in ghc_output.split('\n') + for flag in ghc_output.decode('UTF-8').split('\n') if not expected_undocumented(flag) if flag != ''} +def error(s: str): + print(s, file=sys.stderr) + def main() -> None: import argparse parser = argparse.ArgumentParser() @@ -71,16 +73,16 @@ def main() -> None: undocumented = ghc_flags - doc_flags if len(undocumented) > 0: - print(f'Found {len(undocumented)} flags not documented in the users guide:') - print('\n'.join(f' {flag}' for flag in sorted(undocumented))) - print() + error('Found {len_undoc} flags not documented in the users guide:'.format(len_undoc=len(undocumented)), ) + error('\n'.join(' {}'.format(flag) for flag in sorted(undocumented))) + error('') failed = True now_documented = EXPECTED_UNDOCUMENTED.intersection(doc_flags) if len(now_documented) > 0: - print(f'Found flags that are documented yet listed in {EXPECTED_UNDOCUMENTED_PATH}:') - print('\n'.join(f' {flag}' for flag in sorted(now_documented))) - print() + error('Found flags that are documented yet listed in {}:'.format(EXPECTED_UNDOCUMENTED_PATH)) + error('\n'.join(' {}'.format(flag) for flag in sorted(now_documented))) + error('') failed = True if failed: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/5295fd5adc967f02ec8b0fa2f45e978e1f531295...0fd7e009024f76a4a245dc7c76e6cec28136e742 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/5295fd5adc967f02ec8b0fa2f45e978e1f531295...0fd7e009024f76a4a245dc7c76e6cec28136e742 You're receiving 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 Mar 19 04:40:14 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 19 Mar 2020 00:40:14 -0400 Subject: [Git][ghc/ghc][master] PmCheck: Use ConLikeSet to model negative info Message-ID: <5e72f7ae5e913_488a3fc6cb49d8fc2050793@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b03fd3bc by Sebastian Graf at 2020-03-19T04:40:06Z 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. - - - - - 2 changed files: - compiler/GHC/HsToCore/PmCheck/Oracle.hs - compiler/GHC/HsToCore/PmCheck/Types.hs Changes: ===================================== compiler/GHC/HsToCore/PmCheck/Oracle.hs ===================================== @@ -51,7 +51,6 @@ import GHC.Core.Make (mkListExpr, mkCharExpr) import UniqSupply import FastString import SrcLoc -import ListSetOps (unionLists) import Maybes import GHC.Core.ConLike import GHC.Core.DataCon @@ -613,9 +612,6 @@ Maintaining these invariants in 'addVarCt' (the core of the term oracle) and - (Refine) If we had @x /~ K zs@, unify each y with each z in turn. * Adding negative information. Example: Add the fact @x /~ Nothing@ (see 'addNotConCt') - (Refut) If we have @x ~ K ys@, refute. - - (Redundant) If we have @x ~ K2@ and @eqPmAltCon K K2 == Disjoint@ - (ex. Just and Nothing), the info is redundant and can be - discarded. - (COMPLETE) If K=Nothing and we had @x /~ Just@, then we get @x /~ [Just,Nothing]@. This is vacuous by matter of comparing to the built-in COMPLETE set, so should refute. @@ -655,7 +651,7 @@ tmIsSatisfiable new_tm_cs = SC $ \delta -> runMaybeT $ foldlM addTmCt delta new_ -- * Looking up VarInfo emptyVarInfo :: Id -> VarInfo -emptyVarInfo x = VI (idType x) [] [] NoPM +emptyVarInfo x = VI (idType x) [] emptyPmAltConSet NoPM lookupVarInfo :: TmState -> Id -> VarInfo -- (lookupVarInfo tms x) tells what we know about 'x' @@ -754,7 +750,7 @@ TyCon, so tc_rep = tc_fam afterwards. canDiverge :: Delta -> Id -> Bool canDiverge delta at MkDelta{ delta_tm_st = ts } x | VI _ pos neg _ <- lookupVarInfo ts x - = null neg && all pos_can_diverge pos + = isEmptyPmAltConSet neg && all pos_can_diverge pos where pos_can_diverge (PmAltConLike (RealDataCon dc), _, [y]) -- See Note [Divergence of Newtype matches] @@ -793,8 +789,8 @@ lookupRefuts :: Uniquable k => Delta -> k -> [PmAltCon] lookupRefuts MkDelta{ delta_tm_st = ts@(TmSt (SDIE env) _) } k = case lookupUDFM env k of Nothing -> [] - Just (Indirect y) -> vi_neg (lookupVarInfo ts y) - Just (Entry vi) -> vi_neg vi + Just (Indirect y) -> pmAltConSetElems (vi_neg (lookupVarInfo ts y)) + Just (Entry vi) -> pmAltConSetElems (vi_neg vi) isDataConSolution :: (PmAltCon, [TyVar], [Id]) -> Bool isDataConSolution (PmAltConLike (RealDataCon _), _, _) = True @@ -937,7 +933,7 @@ addNotConCt delta at MkDelta{ delta_tm_st = TmSt env reps } x nalt = do | any (implies nalt) pos = neg -- See Note [Completeness checking with required Thetas] | hasRequiredTheta nalt = neg - | otherwise = unionLists neg [nalt] + | otherwise = extendPmAltConSet neg nalt let vi_ext = vi{ vi_neg = neg' } -- 3. Make sure there's at least one other possible constructor vi' <- case nalt of @@ -1129,7 +1125,7 @@ equate delta at MkDelta{ delta_tm_st = TmSt env reps } x y delta_pos <- foldlM add_fact delta_refs (vi_pos vi_x) -- Do the same for negative info let add_refut delta nalt = addNotConCt delta y nalt - delta_neg <- foldlM add_refut delta_pos (vi_neg vi_x) + delta_neg <- foldlM add_refut delta_pos (pmAltConSetElems (vi_neg vi_x)) -- vi_cache will be updated in addNotConCt, so we are good to -- go! pure delta_neg @@ -1144,7 +1140,7 @@ addConCt :: Delta -> Id -> PmAltCon -> [TyVar] -> [Id] -> MaybeT DsM Delta addConCt delta at MkDelta{ delta_tm_st = TmSt env reps } x alt tvs args = do VI ty pos neg cache <- lift (initLookupVarInfo delta x) -- First try to refute with a negative fact - guard (all ((/= Equal) . eqPmAltCon alt) neg) + guard (not (elemPmAltConSet alt neg)) -- Then see if any of the other solutions (remember: each of them is an -- additional refinement of the possible values x could take) indicate a -- contradiction @@ -1160,11 +1156,8 @@ addConCt delta at MkDelta{ delta_tm_st = TmSt env reps } x alt tvs args = do let tm_cts = zipWithEqual "addConCt" PmVarCt args other_args MaybeT $ addPmCts delta (listToBag ty_cts `unionBags` listToBag tm_cts) Nothing -> do - -- Filter out redundant negative facts (those that compare Just False to - -- the new solution) - let neg' = filter ((== PossiblyOverlap) . eqPmAltCon alt) neg let pos' = (alt, tvs, args):pos - pure delta{ delta_tm_st = TmSt (setEntrySDIE env x (VI ty pos' neg' cache)) reps} + pure delta{ delta_tm_st = TmSt (setEntrySDIE env x (VI ty pos' neg cache)) reps} equateTys :: [Type] -> [Type] -> [PmCt] equateTys ts us = @@ -1553,7 +1546,7 @@ provideEvidence = go [] -- When there are literals involved, just print negative info -- instead of listing missed constructors - | notNull [ l | PmAltLit l <- neg ] + | notNull [ l | PmAltLit l <- pmAltConSetElems neg ] -> go xs n delta [] -> try_instantiate x xs n delta ===================================== compiler/GHC/HsToCore/PmCheck/Types.hs ===================================== @@ -24,6 +24,10 @@ module GHC.HsToCore.PmCheck.Types ( -- * Caching partially matched COMPLETE sets ConLikeSet, PossibleMatches(..), + -- * PmAltConSet + PmAltConSet, emptyPmAltConSet, isEmptyPmAltConSet, elemPmAltConSet, + extendPmAltConSet, pmAltConSetElems, + -- * A 'DIdEnv' where entries may be shared Shared(..), SharedDIdEnv(..), emptySDIE, lookupSDIE, sameRepresentativeSDIE, setIndirectSDIE, setEntrySDIE, traverseSDIE, @@ -49,6 +53,7 @@ import Name import GHC.Core.DataCon import GHC.Core.ConLike import Outputable +import ListSetOps (unionLists) import Maybes import GHC.Core.Type import GHC.Core.TyCon @@ -152,6 +157,33 @@ eqConLike _ _ = PossiblyOverlap data PmAltCon = PmAltConLike ConLike | PmAltLit PmLit +data PmAltConSet = PACS !ConLikeSet ![PmLit] + +emptyPmAltConSet :: PmAltConSet +emptyPmAltConSet = PACS emptyUniqDSet [] + +isEmptyPmAltConSet :: PmAltConSet -> Bool +isEmptyPmAltConSet (PACS cls lits) = isEmptyUniqDSet cls && null lits + +-- | Whether there is a 'PmAltCon' in the 'PmAltConSet' that compares 'Equal' to +-- the given 'PmAltCon' according to 'eqPmAltCon'. +elemPmAltConSet :: PmAltCon -> PmAltConSet -> Bool +elemPmAltConSet (PmAltConLike cl) (PACS cls _ ) = elementOfUniqDSet cl cls +elemPmAltConSet (PmAltLit lit) (PACS _ lits) = elem lit lits + +extendPmAltConSet :: PmAltConSet -> PmAltCon -> PmAltConSet +extendPmAltConSet (PACS cls lits) (PmAltConLike cl) + = PACS (addOneToUniqDSet cls cl) lits +extendPmAltConSet (PACS cls lits) (PmAltLit lit) + = PACS cls (unionLists lits [lit]) + +pmAltConSetElems :: PmAltConSet -> [PmAltCon] +pmAltConSetElems (PACS cls lits) + = map PmAltConLike (uniqDSetToList cls) ++ map PmAltLit lits + +instance Outputable PmAltConSet where + ppr = ppr . pmAltConSetElems + -- | We can't in general decide whether two 'PmAltCon's match the same set of -- values. In addition to the reasons in 'eqPmLit' and 'eqConLike', a -- 'PmAltConLike' might or might not represent the same value as a 'PmAltLit'. @@ -475,7 +507,7 @@ data VarInfo -- However, no more than one RealDataCon in the list, otherwise contradiction -- because of generativity. - , vi_neg :: ![PmAltCon] + , vi_neg :: !PmAltConSet -- ^ Negative info: A list of 'PmAltCon's that it cannot match. -- Example, assuming -- @@ -489,6 +521,9 @@ data VarInfo -- between 'vi_pos' and 'vi_neg'. -- See Note [Why record both positive and negative info?] + -- It's worth having an actual set rather than a simple association list, + -- because files like Cabal's `LicenseId` define relatively huge enums + -- that lead to quadratic or worse behavior. , vi_cache :: !PossibleMatches -- ^ A cache of the associated COMPLETE sets. At any time a superset of View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/b03fd3bcd4ff14aed2942275c3b0db5392dc913c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/b03fd3bcd4ff14aed2942275c3b0db5392dc913c You're receiving 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 Mar 18 13:27:30 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 18 Mar 2020 09:27:30 -0400 Subject: [Git][ghc/ghc][wip/test] gitlab-ci: Backport CI rework from master Message-ID: <5e7221c2493c8_488a3fc6ceaba9f8188872@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/test at Glasgow Haskell Compiler / GHC Commits: 944e5f9e by Ben Gamari at 2020-03-18T13:27:16Z gitlab-ci: Backport CI rework from master - - - - - 6 changed files: - .gitlab-ci.yml - + .gitlab/ci.sh - − .gitlab/prepare-system.sh - − .gitlab/win32-init.sh - + mk/get-win32-tarballs.py - − mk/get-win32-tarballs.sh Changes: ===================================== .gitlab-ci.yml ===================================== @@ -5,17 +5,16 @@ variables: DOCKER_REV: 408eff66aef6ca2b44446c694c5a56d6ca0460cc # Sequential version number capturing the versions of all tools fetched by - # .gitlab/win32-init.sh. + # .gitlab/ci.sh. WINDOWS_TOOLCHAIN_VERSION: 1 # Disable shallow clones; they break our linting rules GIT_DEPTH: 0 -before_script: - - git submodule sync --recursive - - git submodule update --init --recursive - - git checkout .gitmodules - - "git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/perf || true" + # Overridden by individual jobs + CONFIGURE_ARGS: "" + + GIT_SUBMODULE_STRATEGY: "recursive" stages: - lint # Source linting @@ -36,7 +35,18 @@ stages: - tags - web +.nightly: &nightly + only: + variables: + - $NIGHTLY + artifacts: + when: always + expire_in: 8 weeks + .release: &release + variables: + BUILD_FLAVOUR: "perf" + FLAVOUR: "perf" artifacts: when: always expire_in: 1 year @@ -125,8 +135,7 @@ typecheck-testsuite: - base="$(git merge-base FETCH_HEAD $CI_COMMIT_SHA)" - "echo Linting submodule changes between $base..$CI_COMMIT_SHA" - git submodule foreach git remote update - # TODO: Fix submodule linter - - submodchecker . $(git rev-list $base..$CI_COMMIT_SHA) || true + - submodchecker . $(git rev-list $base..$CI_COMMIT_SHA) dependencies: [] tags: - lint @@ -170,11 +179,7 @@ lint-submods-branch: tags: - lint script: - - | - grep TBA libraries/*/changelog.md && ( - echo "Error: Found \"TBA\"s in changelogs." - exit 1 - ) || exit 0 + - bash .gitlab/linters/check-changelogs.sh lint-changelogs: extends: .lint-changelogs @@ -200,25 +205,10 @@ lint-release-changelogs: variables: FLAVOUR: "validate" script: - - cabal update - - git clean -xdf && git submodule foreach git clean -xdf - - .gitlab/prepare-system.sh - - if [[ -d ./cabal-cache ]]; then cp -R ./.cabal-cache ~/.cabal-cache; fi - - ./boot - - ./configure $CONFIGURE_ARGS - - hadrian/build.cabal.sh --flavour=$FLAVOUR -j`mk/detect-cpu-count.sh` --docs=no-sphinx binary-dist - - mv _build/bindist/ghc*.tar.xz ghc.tar.xz - - export TOP=$(pwd) - - cd _build/bindist/ghc-*/ && ./configure --prefix=$TOP/_build/install && make install && cd ../../../ - - | - # Prepare to push git notes. - export METRICS_FILE=$CI_PROJECT_DIR/performance-metrics.tsv - git config user.email "ben+ghc-ci at smart-cactus.org" - git config user.name "GHC GitLab CI" - - hadrian/build.cabal.sh --flavour=$FLAVOUR -j`mk/detect-cpu-count.sh` --docs=no-sphinx test --summary-junit=./junit.xml --test-compiler=$TOP/_build/install/bin/ghc || (.gitlab/push-test-metrics.sh && false) - - | - # Push git notes. - .gitlab/push-test-metrics.sh + - .gitlab/ci.sh setup + - .gitlab/ci.sh configure + - .gitlab/ci.sh build_hadrian + - .gitlab/ci.sh test_hadrian cache: key: hadrian paths: @@ -243,6 +233,8 @@ lint-release-changelogs: - git submodule update --init --recursive - git checkout .gitmodules - "git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/perf || true" + after_script: + - .gitlab/ci.sh clean tags: - x86_64-linux @@ -275,7 +267,7 @@ hadrian-ghc-in-ghci: - cabal update - cd hadrian; cabal new-build --project-file=ci.project; cd .. - git clean -xdf && git submodule foreach git clean -xdf - - .gitlab/prepare-system.sh + - .gitlab/ci.sh setup - if [[ -d ./cabal-cache ]]; then cp -R ./.cabal-cache ~/.cabal-cache; fi - ./boot - ./configure $CONFIGURE_ARGS @@ -294,27 +286,12 @@ hadrian-ghc-in-ghci: <<: *only-default variables: TEST_TYPE: test - before_script: - - git clean -xdf && git submodule foreach git clean -xdf + MAKE_ARGS: "-Werror" script: - - ./boot - - ./configure $CONFIGURE_ARGS - - | - THREADS=`mk/detect-cpu-count.sh` - make V=0 -j$THREADS WERROR=-Werror - - make binary-dist-prep TAR_COMP_OPTS="-1" - - make test_bindist TEST_PREP=YES - - | - # Prepare to push git notes. - METRICS_FILE=$CI_PROJECT_DIR/performance-metrics.tsv - git config user.email "ben+ghc-ci at smart-cactus.org" - git config user.name "GHC GitLab CI" - - | - THREADS=`mk/detect-cpu-count.sh` - make $TEST_TYPE THREADS=$THREADS JUNIT_FILE=../../junit.xml METRICS_FILE=$METRICS_FILE || (METRICS_FILE=$METRICS_FILE .gitlab/push-test-metrics.sh && false) - - | - # Push git notes. - METRICS_FILE=$METRICS_FILE .gitlab/push-test-metrics.sh + - .gitlab/ci.sh setup + - .gitlab/ci.sh configure + - .gitlab/ci.sh build_make + - .gitlab/ci.sh test_make dependencies: [] artifacts: reports: @@ -325,6 +302,79 @@ hadrian-ghc-in-ghci: - junit.xml - performance-metrics.tsv +################################# +# x86_64-freebsd +################################# + +.build-x86_64-freebsd: + extends: .validate + tags: + - x86_64-freebsd + allow_failure: true + variables: + # N.B. we use iconv from ports as I see linker errors when we attempt + # to use the "native" iconv embedded in libc as suggested by the + # porting guide [1]. + # [1] https://www.freebsd.org/doc/en/books/porters-handbook/using-iconv.html) + CONFIGURE_ARGS: "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib" + GHC_VERSION: 8.6.3 + CABAL_INSTALL_VERSION: 3.0.0.0 + BIN_DIST_PREP_TAR_COMP: "ghc-x86_64-portbld-freebsd.tar.xz" + TEST_ENV: "x86_64-freebsd" + BUILD_FLAVOUR: "validate" + after_script: + - cp -Rf $HOME/.cabal cabal-cache + - .gitlab/ci.sh clean + artifacts: + when: always + expire_in: 2 week + cache: + key: "freebsd-$GHC_VERSION" + paths: + - cabal-cache + - toolchain + +# Disabled due to lack of builder capacity +.validate-x86_64-freebsd: + extends: .build-x86_64-freebsd + stage: full-build + +nightly-x86_64-freebsd: + <<: *nightly + extends: .build-x86_64-freebsd + stage: full-build + +.build-x86_64-freebsd-hadrian: + extends: .validate-hadrian + stage: full-build + tags: + - x86_64-freebsd + allow_failure: true + variables: + CONFIGURE_ARGS: "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib" + HADRIAN_ARGS: "--docs=no-sphinx" + GHC_VERSION: 8.6.3 + CABAL_INSTALL_VERSION: 3.0.0.0 + BIN_DIST_PREP_TAR_COMP: "ghc-x86_64-portbld-freebsd.tar.xz" + TEST_ENV: "x86_64-freebsd-hadrian" + FLAVOUR: "validate" + after_script: + - cp -Rf $HOME/.cabal cabal-cache + - .gitlab/ci.sh clean + artifacts: + when: always + expire_in: 2 week + cache: + key: "freebsd-$GHC_VERSION" + paths: + - cabal-cache + - toolchain + +# Disabled due to lack of builder capacity +.validate-x86_64-freebsd-hadrian: + extends: .build-x86_64-freebsd-hadrian + stage: full-build + ################################# # x86_64-darwin ################################# @@ -335,28 +385,19 @@ validate-x86_64-darwin: tags: - x86_64-darwin variables: - GHC_VERSION: 8.8.3 - CABAL_INSTALL_VERSION: 2.4.1.0 + GHC_VERSION: 8.6.5 + CABAL_INSTALL_VERSION: 3.0.0.0 BIN_DIST_PREP_TAR_COMP: "ghc-x86_64-apple-darwin.tar.xz" MACOSX_DEPLOYMENT_TARGET: "10.7" # Only Sierra and onwards supports clock_gettime. See #12858 ac_cv_func_clock_gettime: "no" - # Only Mojave and onwards supports utimensat. See #17895 - ac_cv_func_utimensat: "no" LANG: "en_US.UTF-8" - CONFIGURE_ARGS: --with-intree-gmp + CONFIGURE_ARGS: "--with-intree-gmp" TEST_ENV: "x86_64-darwin" - before_script: - - git clean -xdf && git submodule foreach git clean -xdf - - git submodule sync --recursive - - git submodule update --init --recursive - - git checkout .gitmodules - - "git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/perf || true" - - - bash .gitlab/darwin-init.sh - - PATH="`pwd`/toolchain/bin:$PATH" + BUILD_FLAVOUR: "perf" after_script: - cp -Rf $HOME/.cabal cabal-cache + - .gitlab/ci.sh clean artifacts: when: always expire_in: 2 week @@ -373,33 +414,21 @@ validate-x86_64-darwin: tags: - x86_64-darwin variables: - GHC_VERSION: 8.8.3 + GHC_VERSION: 8.6.3 MACOSX_DEPLOYMENT_TARGET: "10.7" ac_cv_func_clock_gettime: "no" LANG: "en_US.UTF-8" CONFIGURE_ARGS: --with-intree-gmp TEST_ENV: "x86_64-darwin-hadrian" FLAVOUR: "validate" - before_script: - - git clean -xdf && git submodule foreach git clean -xdf - - git submodule sync --recursive - - git submodule update --init --recursive - - git checkout .gitmodules - - "git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/perf || true" - - - bash .gitlab/darwin-init.sh - - PATH="`pwd`/toolchain/bin:$PATH" script: - - cabal update - - ./boot - - ./configure $CONFIGURE_ARGS - - hadrian/build.cabal.sh --flavour=$FLAVOUR -j`mk/detect-cpu-count.sh` --docs=no-sphinx binary-dist - - mv _build/bindist/ghc*.tar.xz ghc.tar.xz - - export TOP=$(pwd) - - cd _build/bindist/ghc-*/ && ./configure --prefix=$TOP/_build/install && make install && cd ../../../ - - hadrian/build.cabal.sh --flavour=$FLAVOUR -j`mk/detect-cpu-count.sh` --docs=no-sphinx test --summary-junit=./junit.xml --test-compiler=$TOP/_build/install/bin/ghc + - .gitlab/ci.sh setup + - .gitlab/ci.sh configure + - .gitlab/ci.sh build_hadrian + - .gitlab/ci.sh test_hadrian after_script: - cp -Rf $HOME/.cabal cabal-cache + - .gitlab/ci.sh clean artifacts: when: always expire_in: 2 week @@ -413,19 +442,15 @@ validate-x86_64-darwin: extends: .validate tags: - x86_64-linux + variables: + BUILD_FLAVOUR: "perf" before_script: - - git clean -xdf && git submodule foreach git clean -xdf - - git submodule sync --recursive - - git submodule update --init --recursive - - git checkout .gitmodules - - "git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/perf || true" # Build hyperlinked sources for documentation when building releases - | if [[ -n "$CI_COMMIT_TAG" ]]; then - echo "EXTRA_HADDOCK_OPTS += --hyperlinked-source --quickjump" >> mk/build.mk + HADDOCK_HYPERLINKED_SOURCES=1 fi - - .gitlab/prepare-system.sh # workaround for docker permissions - sudo chown ghc:ghc -R . after_script: @@ -460,14 +485,10 @@ validate-aarch64-linux-deb9: expire_in: 2 week nightly-aarch64-linux-deb9: + <<: *nightly extends: .build-aarch64-linux-deb9 - artifacts: - expire_in: 2 year variables: TEST_TYPE: slowtest - only: - variables: - - $NIGHTLY ################################# # armv7-linux-deb9 @@ -477,7 +498,6 @@ nightly-aarch64-linux-deb9: extends: .validate-linux stage: full-build image: "registry.gitlab.haskell.org/ghc/ci-images/armv7-linux-deb9:$DOCKER_REV" - allow_failure: true variables: TEST_ENV: "armv7-linux-deb9" BIN_DIST_PREP_TAR_COMP: "ghc-armv7-linux-deb9.tar.xz" @@ -494,14 +514,10 @@ validate-armv7-linux-deb9: expire_in: 2 week nightly-armv7-linux-deb9: + <<: *nightly extends: .build-armv7-linux-deb9 - artifacts: - expire_in: 2 year variables: TEST_TYPE: slowtest - only: - variables: - - $NIGHTLY ################################# # i386-linux-deb9 @@ -524,15 +540,10 @@ validate-i386-linux-deb9: expire_in: 2 week nightly-i386-linux-deb9: + <<: *nightly extends: .build-i386-linux-deb9 variables: TEST_TYPE: slowtest - artifacts: - when: always - expire_in: 2 week - only: - variables: - - $NIGHTLY ################################# # x86_64-linux-deb9 @@ -561,20 +572,16 @@ release-x86_64-linux-deb9: stage: full-build nightly-x86_64-linux-deb9: + <<: *nightly extends: .build-x86_64-linux-deb9 stage: full-build - artifacts: - expire_in: 2 year variables: TEST_TYPE: slowtest - only: - variables: - - $NIGHTLY # N.B. Has DEBUG assertions enabled in stage2 validate-x86_64-linux-deb9-debug: extends: .build-x86_64-linux-deb9 - stage: build + stage: full-build variables: BUILD_FLAVOUR: validate # Ensure that stage2 also has DEBUG enabled @@ -583,7 +590,7 @@ validate-x86_64-linux-deb9-debug: BUILD_SPHINX_PDF: "YES" TEST_TYPE: slowtest TEST_ENV: "x86_64-linux-deb9-debug" - BIN_DIST_PREP_COMP: "ghc-x86_64-deb9-linux-debug.tar.xz" + BIN_DIST_PREP_TAR_COMP: "ghc-x86_64-deb9-linux-debug.tar.xz" artifacts: when: always expire_in: 2 week @@ -597,39 +604,34 @@ validate-x86_64-linux-deb9-debug: TEST_ENV: "x86_64-linux-deb9-llvm" nightly-x86_64-linux-deb9-llvm: + <<: *nightly extends: .build-x86_64-linux-deb9 stage: full-build variables: BUILD_FLAVOUR: perf-llvm TEST_ENV: "x86_64-linux-deb9-llvm" - only: - variables: - - $NIGHTLY validate-x86_64-linux-deb9-integer-simple: extends: .build-x86_64-linux-deb9 stage: full-build variables: + BUILD_FLAVOUR: validate INTEGER_LIBRARY: integer-simple - TEST_ENV: "x86_64-linux-deb9-integer-simple" + TEST_ENV: "x86_64-linux-deb9-integer-simple-validate" BIN_DIST_PREP_TAR_COMP: "ghc-x86_64-deb9-linux-integer-simple.tar.xz" nightly-x86_64-linux-deb9-integer-simple: + <<: *nightly extends: .build-x86_64-linux-deb9 stage: full-build variables: INTEGER_LIBRARY: integer-simple TEST_ENV: "x86_64-linux-deb9-integer-simple" TEST_TYPE: slowtest - artifacts: - expire_in: 2 year - only: - variables: - - $NIGHTLY validate-x86_64-linux-deb9-dwarf: extends: .build-x86_64-linux-deb9 - stage: build + stage: full-build variables: CONFIGURE_ARGS: "--enable-dwarf-unwind" BUILD_FLAVOUR: dwarf @@ -656,14 +658,10 @@ validate-x86_64-linux-deb9-dwarf: stage: full-build nightly-x86_64-linux-deb10: + <<: *nightly extends: .build-x86_64-linux-deb10 - artifacts: - expire_in: 2 weeks variables: TEST_TYPE: slowtest - only: - variables: - - $NIGHTLY release-x86_64-linux-deb10: <<: *release @@ -698,19 +696,21 @@ release-x86_64-linux-deb8: # x86_64-linux-alpine ################################# -.build-x86_64-linux-alpine: - extends: .validate-linux +.build-x86_64-linux-alpine-hadrian: + extends: .validate-linux-hadrian stage: full-build image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine:$DOCKER_REV" # There are currently a few failing tests allow_failure: true variables: - BUILD_SPHINX_PDF: "NO" TEST_ENV: "x86_64-linux-alpine" BIN_DIST_PREP_TAR_COMP: "ghc-x86_64-alpine-linux.tar.xz" # Can't use ld.gold due to #13958. CONFIGURE_ARGS: "--disable-ld-override" - INTEGER_LIBRARY: "integer-simple" + HADRIAN_ARGS: "--docs=no-sphinx" + # encoding004 due to lack of locale support + # T10458 due to fact that dynamic linker tries to reload libAS + BROKEN_TESTS: "encoding004 T10458" cache: key: linux-x86_64-alpine artifacts: @@ -719,13 +719,11 @@ release-x86_64-linux-deb8: release-x86_64-linux-alpine: <<: *release - extends: .build-x86_64-linux-alpine + extends: .build-x86_64-linux-alpine-hadrian nightly-x86_64-linux-alpine: - extends: .build-x86_64-linux-alpine - only: - variables: - - $NIGHTLY + <<: *nightly + extends: .build-x86_64-linux-alpine-hadrian ################################# # x86_64-linux-centos7 @@ -775,58 +773,49 @@ validate-x86_64-linux-fedora27: .build-windows: <<: *only-default + # For the reasons given in #17777 this build isn't reliable. + allow_failure: true before_script: - git clean -xdf - - git submodule foreach git clean -xdf - - # Use a local temporary directory to ensure that concurrent builds don't - # interfere with one another - - | - mkdir tmp - set TMP=%cd%\tmp - set TEMP=%cd%\tmp - - set PATH=C:\msys64\usr\bin;%PATH% - - git submodule sync --recursive - - git submodule update --init --recursive - - git checkout .gitmodules - - "git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/perf || true" - - bash .gitlab/win32-init.sh + # Setup toolchain + - bash .gitlab/ci.sh setup after_script: - - rd /s /q tmp - - robocopy /np /nfl /ndl /e "%APPDATA%\cabal" cabal-cache - - bash -c 'make clean || true' + - | + Copy-Item -Recurse -Path $Env:APPDATA\cabal -Destination cabal-cache + - bash .gitlab/ci.sh clean dependencies: [] variables: - FORCE_SYMLINKS: 1 + #FORCE_SYMLINKS: 1 LANG: "en_US.UTF-8" SPHINXBUILD: "/mingw64/bin/sphinx-build.exe" + CABAL_INSTALL_VERSION: 3.0.0.0 + GHC_VERSION: "8.8.3" cache: paths: - cabal-cache - - ghc-8.6.5 + - toolchain - ghc-tarballs .build-windows-hadrian: extends: .build-windows stage: full-build variables: - GHC_VERSION: "8.8.3" FLAVOUR: "validate" + # skipping perf tests for now since we build a quick-flavoured GHC, + # which might result in some broken perf tests? + HADRIAN_ARGS: "--docs=no-sphinx --skip-perf" + # due to #16574 this currently fails allow_failure: true + script: - - | - python boot - bash -c './configure --enable-tarballs-autodownload GHC=`pwd`/toolchain/bin/ghc HAPPY=`pwd`/toolchain/bin/happy ALEX=`pwd`/toolchain/bin/alex' - - bash -c "PATH=`pwd`/toolchain/bin:$PATH hadrian/build.cabal.sh --flavour=$FLAVOUR -j`mk/detect-cpu-count.sh` --flavour=Quick --docs=no-sphinx binary-dist" - - mv _build/bindist/ghc*.tar.xz ghc.tar.xz - - bash -c "export TOP=$(pwd); cd _build/bindist/ghc-*/ && PATH=$TOP/toolchain/bin:$PATH ./configure --prefix=$TOP/_build/install && make install && cd ../../../" - - bash -c "export TOP=$(pwd); PATH=$TOP/toolchain/bin:$PATH hadrian/build.cabal.sh --flavour=$FLAVOUR -j`mk/detect-cpu-count.sh` --flavour=quick test --summary-junit=./junit.xml --skip-perf --test-compiler=$TOP/_build/install/bin/ghc" - # skipping perf tests for now since we build a quick-flavoured GHC, - # which might result in some broken perf tests? + - bash .gitlab/ci.sh configure + - bash .gitlab/ci.sh build_hadrian + - bash .gitlab/ci.sh test_hadrian tags: - - x86_64-windows + - new-x86_64-windows + - test artifacts: reports: junit: junit.xml @@ -845,34 +834,27 @@ validate-x86_64-windows-hadrian: key: "x86_64-windows-hadrian-$WINDOWS_TOOLCHAIN_VERSION" nightly-i386-windows-hadrian: + <<: *nightly extends: .build-windows-hadrian variables: MSYSTEM: MINGW32 TEST_ENV: "i386-windows-hadrian" - only: - variables: - - $NIGHTLY cache: key: "i386-windows-hadrian-$WINDOWS_TOOLCHAIN_VERSION" .build-windows-make: extends: .build-windows stage: full-build - allow_failure: true variables: BUILD_FLAVOUR: "quick" - GHC_VERSION: "8.8.3" BIN_DIST_PREP_TAR_COMP: "ghc-x86_64-mingw32.tar.xz" script: - - | - python boot - bash -c './configure --enable-tarballs-autodownload GHC=`pwd`/toolchain/bin/ghc HAPPY=`pwd`/toolchain/bin/happy ALEX=`pwd`/toolchain/bin/alex $CONFIGURE_ARGS' - - bash -c "PATH=`pwd`/toolchain/bin:$PATH make -j`mk/detect-cpu-count.sh`" - - bash -c "PATH=`pwd`/toolchain/bin:$PATH make binary-dist-prep TAR_COMP_OPTS=-1" - - bash -c "PATH=`pwd`/toolchain/bin:$PATH make test_bindist TEST_PREP=YES" - - bash -c 'make V=0 test PYTHON=/mingw64/bin/python3 THREADS=`mk/detect-cpu-count.sh` JUNIT_FILE=../../junit.xml' + - bash .gitlab/ci.sh configure + - bash .gitlab/ci.sh build_make + - bash .gitlab/ci.sh test_make tags: - - x86_64-windows + - new-x86_64-windows + - test artifacts: when: always expire_in: 2 week @@ -880,77 +862,69 @@ nightly-i386-windows-hadrian: junit: junit.xml paths: # N.B. variable interpolation apparently doesn't work on Windows so - # this can't be $BIN_DIST_TAR_COMP + # this can't be $BIN_DIST_PREP_TAR_COMP - "ghc-x86_64-mingw32.tar.xz" - junit.xml -validate-x86_64-windows: +.build-x86_64-windows-make: extends: .build-windows-make variables: MSYSTEM: MINGW64 - CONFIGURE_ARGS: "--target=x86_64-unknown-mingw32" TEST_ENV: "x86_64-windows" cache: key: "x86_64-windows-$WINDOWS_TOOLCHAIN_VERSION" +validate-x86_64-windows: + extends: .build-x86_64-windows-make + nightly-x86_64-windows: - extends: .build-windows-make + <<: *nightly + extends: .build-x86_64-windows-make stage: full-build variables: BUILD_FLAVOUR: "validate" - MSYSTEM: MINGW64 - CONFIGURE_ARGS: "--target=x86_64-unknown-mingw32" - only: - variables: - - $NIGHTLY - cache: - key: "x86_64-windows-$WINDOWS_TOOLCHAIN_VERSION" # Normal Windows validate builds are profiled; that won't do for releases. release-x86_64-windows: <<: *release extends: validate-x86_64-windows variables: - MSYSTEM: MINGW64 BUILD_FLAVOUR: "perf" - CONFIGURE_ARGS: "--target=x86_64-unknown-mingw32" - TEST_ENV: "x86_64-windows" - + # release-x86_64-windows-integer-simple: <<: *release extends: validate-x86_64-windows variables: INTEGER_LIBRARY: integer-simple BUILD_FLAVOUR: "perf" - CONFIGURE_ARGS: "--target=x86_64-unknown-mingw32" - TEST_ENV: "x86_64-windows" -release-i386-windows: - <<: *release + +.build-i386-windows-make: extends: .build-windows-make variables: MSYSTEM: MINGW32 - BUILD_FLAVOUR: "perf" - CONFIGURE_ARGS: "--target=i386-unknown-mingw32" # Due to #15934 BUILD_PROF_LIBS: "NO" TEST_ENV: "i386-windows" + # Due to #17736 + allow_failure: true cache: key: "i386-windows-$WINDOWS_TOOLCHAIN_VERSION" -nightly-i386-windows: - extends: .build-windows-make - only: - variables: - - $NIGHTLY +validate-i386-windows: + extends: .build-i386-windows-make variables: - MSYSTEM: MINGW32 - CONFIGURE_ARGS: "--target=i386-unknown-mingw32" - # Due to #15934 - BUILD_PROF_LIBS: "NO" - TEST_ENV: "i386-windows" - cache: - key: "i386-windows-$WINDOWS_TOOLCHAIN_VERSION" + BUILD_FLAVOUR: "perf" + +release-i386-windows: + <<: *release + extends: .build-i386-windows-make + variables: + BUILD_FLAVOUR: "perf" + +nightly-i386-windows: + <<: *nightly + extends: .build-i386-windows-make ############################################################ # Cleanup @@ -1006,7 +980,7 @@ doc-tarball: - validate-x86_64-linux-deb9-debug - validate-x86_64-windows variables: - LINUX_BINDIST: "ghc-x86_64-deb9-linux.tar.xz" + LINUX_BINDIST: "ghc-x86_64-deb9-linux-debug.tar.xz" WINDOWS_BINDIST: "ghc-x86_64-mingw32.tar.xz" # Due to Windows allow_failure allow_failure: true @@ -1046,7 +1020,7 @@ source-tarball: - ghc-*.tar.xz - version script: - - mk/get-win32-tarballs.sh download all + - python3 mk/get-win32-tarballs.py download all - ./boot - ./configure - make sdist @@ -1089,10 +1063,8 @@ hackage-label: - $CI_MERGE_REQUEST_LABELS =~ /.*user-facing.*/ nightly-hackage: + <<: *nightly extends: .hackage - only: - variables: - - $NIGHTLY ############################################################ # Nofib testing ===================================== .gitlab/ci.sh ===================================== @@ -0,0 +1,454 @@ +#!/usr/bin/env bash +# shellcheck disable=SC2230 + +# This is the primary driver of the GitLab CI infrastructure. + +set -e -o pipefail + +# Configuration: +hackage_index_state="@1579718451" + +# Colors +BLACK="0;30" +GRAY="1;30" +RED="0;31" +LT_RED="1;31" +BROWN="0;33" +LT_BROWN="1;33" +GREEN="0;32" +LT_GREEN="1;32" +BLUE="0;34" +LT_BLUE="1;34" +PURPLE="0;35" +LT_PURPLE="1;35" +CYAN="0;36" +LT_CYAN="1;36" +WHITE="1;37" +LT_GRAY="0;37" + +# GitLab Pipelines log section delimiters +# https://gitlab.com/gitlab-org/gitlab-foss/issues/14664 +start_section() { + name="$1" + echo -e "section_start:$(date +%s):$name\015\033[0K" +} + +end_section() { + name="$1" + echo -e "section_end:$(date +%s):$name\015\033[0K" +} + +echo_color() { + local color="$1" + local msg="$2" + echo -e "\033[${color}m${msg}\033[0m" +} + +error() { echo_color "${RED}" "$1"; } +warn() { echo_color "${LT_BROWN}" "$1"; } +info() { echo_color "${LT_BLUE}" "$1"; } + +fail() { error "error: $1"; exit 1; } + +function run() { + info "Running $*..." + "$@" || ( error "$* failed"; return 1; ) +} + +TOP="$(pwd)" + +function mingw_init() { + case "$MSYSTEM" in + MINGW32) + triple="i386-unknown-mingw32" + boot_triple="i386-unknown-mingw32" # triple of bootstrap GHC + ;; + MINGW64) + triple="x86_64-unknown-mingw32" + boot_triple="x86_64-unknown-mingw32" # triple of bootstrap GHC + ;; + *) + fail "win32-init: Unknown MSYSTEM $MSYSTEM" + ;; + esac + + # Bring mingw toolchain into PATH. + # This is extracted from /etc/profile since this script inexplicably fails to + # run under gitlab-runner. + # shellcheck disable=SC1091 + source /etc/msystem + MINGW_MOUNT_POINT="${MINGW_PREFIX}" + PATH="$MINGW_MOUNT_POINT/bin:$PATH" + + # We always use mingw64 Python to avoid path length issues like #17483. + export PYTHON="/mingw64/bin/python3" +} + +# This will contain GHC's local native toolchain +toolchain="$TOP/toolchain" +mkdir -p "$toolchain/bin" +PATH="$toolchain/bin:$PATH" + +export METRICS_FILE="$CI_PROJECT_DIR/performance-metrics.tsv" + +cores="$(mk/detect-cpu-count.sh)" + +# Use a local temporary directory to ensure that concurrent builds don't +# interfere with one another +mkdir -p "$TOP/tmp" +export TMP="$TOP/tmp" +export TEMP="$TOP/tmp" + +function darwin_setup() { + # It looks like we already have python2 here and just installing python3 + # does not work. + brew upgrade python + brew install ghc cabal-install ncurses gmp + + pip3 install sphinx + # PDF documentation disabled as MacTeX apparently doesn't include xelatex. + #brew cask install mactex +} + +function show_tool() { + local tool="$1" + info "$tool = ${!tool}" + ${!tool} --version +} + +function set_toolchain_paths() { + needs_toolchain=1 + case "$(uname)" in + Linux) needs_toolchain="" ;; + *) ;; + esac + + if [[ -n "$needs_toolchain" ]]; then + # These are populated by setup_toolchain + GHC="$toolchain/bin/ghc$exe" + CABAL="$toolchain/bin/cabal$exe" + HAPPY="$toolchain/bin/happy$exe" + ALEX="$toolchain/bin/alex$exe" + else + GHC="$(which ghc)" + CABAL="/usr/local/bin/cabal" + HAPPY="$HOME/.cabal/bin/happy" + ALEX="$HOME/.cabal/bin/alex" + fi + export GHC + export CABAL + export HAPPY + export ALEX + + # FIXME: Temporarily use ghc from ports + case "$(uname)" in + FreeBSD) GHC="/usr/local/bin/ghc" ;; + *) ;; + esac +} + +# Extract GHC toolchain +function setup() { + if [ -d "$TOP/cabal-cache" ]; then + info "Extracting cabal cache..." + mkdir -p "$cabal_dir" + cp -Rf cabal-cache/* "$cabal_dir" + fi + + if [[ -n "$needs_toolchain" ]]; then + setup_toolchain + fi + case "$(uname)" in + Darwin) darwin_setup ;; + *) ;; + esac + + # Make sure that git works + git config user.email "ghc-ci at gitlab-haskell.org" + git config user.name "GHC GitLab CI" + + info "=====================================================" + info "Toolchain versions" + info "=====================================================" + show_tool GHC + show_tool CABAL + show_tool HAPPY + show_tool ALEX +} + +function fetch_ghc() { + local v="$GHC_VERSION" + if [[ -z "$v" ]]; then + fail "GHC_VERSION is not set" + fi + + if [ ! -e "$GHC" ]; then + start_section "fetch GHC" + url="https://downloads.haskell.org/~ghc/${GHC_VERSION}/ghc-${GHC_VERSION}-${boot_triple}.tar.xz" + info "Fetching GHC binary distribution from $url..." + curl "$url" > ghc.tar.xz || fail "failed to fetch GHC binary distribution" + tar -xJf ghc.tar.xz || fail "failed to extract GHC binary distribution" + case "$(uname)" in + MSYS_*|MINGW*) + cp -r "ghc-${GHC_VERSION}"/* "$toolchain" + ;; + *) + pushd "ghc-${GHC_VERSION}" + ./configure --prefix="$toolchain" + "$MAKE" install + popd + ;; + esac + rm -Rf "ghc-${GHC_VERSION}" ghc.tar.xz + end_section "fetch GHC" + fi + +} + +function fetch_cabal() { + local v="$CABAL_INSTALL_VERSION" + if [[ -z "$v" ]]; then + fail "CABAL_INSTALL_VERSION is not set" + fi + + if [ ! -e "$CABAL" ]; then + start_section "fetch GHC" + case "$(uname)" in + # N.B. Windows uses zip whereas all others use .tar.xz + MSYS_*|MINGW*) + case "$MSYSTEM" in + MINGW32) cabal_arch="i386" ;; + MINGW64) cabal_arch="x86_64" ;; + *) fail "unknown MSYSTEM $MSYSTEM" ;; + esac + url="https://downloads.haskell.org/~cabal/cabal-install-$v/cabal-install-$v-$cabal_arch-unknown-mingw32.zip" + info "Fetching cabal binary distribution from $url..." + curl "$url" > "$TMP/cabal.zip" + unzip "$TMP/cabal.zip" + mv cabal.exe "$CABAL" + ;; + *) + local base_url="https://downloads.haskell.org/~cabal/cabal-install-$v/" + case "$(uname)" in + Darwin) cabal_url="$base_url/cabal-install-$v-x86_64-apple-darwin17.7.0.tar.xz" ;; + FreeBSD) + #cabal_url="$base_url/cabal-install-$v-x86_64-portbld-freebsd.tar.xz" ;; + cabal_url="http://home.smart-cactus.org/~ben/ghc/cabal-install-3.0.0.0-x86_64-portbld-freebsd.tar.xz" ;; + *) fail "don't know where to fetch cabal-install for $(uname)" + esac + echo "Fetching cabal-install from $cabal_url" + curl "$cabal_url" > cabal.tar.xz + tar -xJf cabal.tar.xz + mv cabal "$toolchain/bin" + ;; + esac + end_section "fetch GHC" + fi +} + +# For non-Docker platforms we prepare the bootstrap toolchain +# here. For Docker platforms this is done in the Docker image +# build. +function setup_toolchain() { + fetch_ghc + fetch_cabal + cabal_install="$CABAL v2-install --index-state=$hackage_index_state --installdir=$toolchain/bin" + # Avoid symlinks on Windows + case "$(uname)" in + MSYS_*|MINGW*) cabal_install="$cabal_install --install-method=copy" ;; + *) ;; + esac + + if [ ! -e "$HAPPY" ]; then + info "Building happy..." + cabal update + $cabal_install happy + fi + + if [ ! -e "$ALEX" ]; then + info "Building alex..." + cabal update + $cabal_install alex + fi +} + +function cleanup_submodules() { + start_section "clean submodules" + info "Cleaning submodules..." + # On Windows submodules can inexplicably get into funky states where git + # believes that the submodule is initialized yet its associated repository + # is not valid. Avoid failing in this case with the following insanity. + git submodule sync --recursive || git submodule deinit --force --all + git submodule update --init --recursive + git submodule foreach git clean -xdf + end_section "clean submodules" +} + +function prepare_build_mk() { + if [[ -z "$BUILD_FLAVOUR" ]]; then fail "BUILD_FLAVOUR is not set"; fi + if [[ -z ${BUILD_SPHINX_HTML:-} ]]; then BUILD_SPHINX_HTML=YES; fi + if [[ -z ${BUILD_SPHINX_PDF:-} ]]; then BUILD_SPHINX_PDF=YES; fi + if [[ -z ${INTEGER_LIBRARY:-} ]]; then INTEGER_LIBRARY=integer-gmp; fi + + cat > mk/build.mk <> mk/build.mk + fi + + case "$(uname)" in + Darwin) echo "libraries/integer-gmp_CONFIGURE_OPTS += --configure-option=--with-intree-gmp" >> mk/build.mk ;; + *) ;; + esac + + info "build.mk is:" + cat mk/build.mk +} + +function configure() { + start_section "booting" + run python3 boot + end_section "booting" + + local target_args="" + if [[ -n "$triple" ]]; then + target_args="--target=$triple" + fi + + start_section "configuring" + run ./configure \ + --enable-tarballs-autodownload \ + $target_args \ + $CONFIGURE_ARGS \ + GHC="$GHC" \ + HAPPY="$HAPPY" \ + ALEX="$ALEX" \ + || ( cat config.log; fail "configure failed" ) + end_section "configuring" +} + +function build_make() { + prepare_build_mk + if [[ -z "$BIN_DIST_PREP_TAR_COMP" ]]; then + fail "BIN_DIST_PREP_TAR_COMP is not set" + fi + + echo "include mk/flavours/${BUILD_FLAVOUR}.mk" > mk/build.mk + echo 'GhcLibHcOpts+=-haddock' >> mk/build.mk + run "$MAKE" -j"$cores" $MAKE_ARGS + run "$MAKE" -j"$cores" binary-dist-prep TAR_COMP_OPTS=-1 + ls -lh "$BIN_DIST_PREP_TAR_COMP" +} + +function fetch_perf_notes() { + info "Fetching perf notes..." + "$TOP/.gitlab/test-metrics.sh" pull +} + +function push_perf_notes() { + info "Pushing perf notes..." + "$TOP/.gitlab/test-metrics.sh" push +} + +function test_make() { + run "$MAKE" test_bindist TEST_PREP=YES + run "$MAKE" V=0 test \ + THREADS="$cores" \ + JUNIT_FILE=../../junit.xml +} + +function build_hadrian() { + if [ -z "$FLAVOUR" ]; then + fail "FLAVOUR not set" + fi + + run_hadrian binary-dist + + mv _build/bindist/ghc*.tar.xz ghc.tar.xz +} + +function test_hadrian() { + cd _build/bindist/ghc-*/ + run ./configure --prefix="$TOP"/_build/install + run "$MAKE" install + cd ../../../ + + run_hadrian \ + test \ + --summary-junit=./junit.xml \ + --test-compiler="$TOP"/_build/install/bin/ghc +} + +function clean() { + rm -R tmp + run "$MAKE" --quiet clean || true + run rm -Rf _build +} + +function run_hadrian() { + run hadrian/build.cabal.sh \ + --flavour="$FLAVOUR" \ + -j"$cores" \ + --broken-test="$BROKEN_TESTS" \ + $HADRIAN_ARGS \ + $@ +} + +# A convenience function to allow debugging in the CI environment. +function shell() { + local cmd=$@ + if [ -z "$cmd" ]; then + cmd="bash -i" + fi + run $cmd +} + +# Determine Cabal data directory +case "$(uname)" in + MSYS_*|MINGW*) exe=".exe"; cabal_dir="$APPDATA/cabal" ;; + *) cabal_dir="$HOME/.cabal"; exe="" ;; +esac + +# Platform-specific environment initialization +MAKE="make" +case "$(uname)" in + MSYS_*|MINGW*) mingw_init ;; + Darwin) boot_triple="x86_64-apple-darwin" ;; + FreeBSD) + boot_triple="x86_64-portbld-freebsd" + MAKE="gmake" + ;; + Linux) ;; + *) fail "uname $(uname) is not supported" ;; +esac + +set_toolchain_paths + +case $1 in + setup) setup && cleanup_submodules ;; + configure) configure ;; + build_make) build_make ;; + test_make) fetch_perf_notes; test_make; push_perf_notes ;; + build_hadrian) build_hadrian ;; + test_hadrian) fetch_perf_notes; test_hadrian; push_perf_notes ;; + run_hadrian) run_hadrian $@ ;; + clean) clean ;; + shell) shell $@ ;; + *) fail "unknown mode $1" ;; +esac ===================================== .gitlab/prepare-system.sh deleted ===================================== @@ -1,99 +0,0 @@ -#!/usr/bin/env bash -# vim: sw=2 et -set -euo pipefail - -fail() { - echo "ERROR: $*" >&2 - exit 1 -} - -hackage_index_state="@1522046735" - -if [[ -z ${BUILD_SPHINX_HTML:-} ]]; then BUILD_SPHINX_HTML=YES; fi -if [[ -z ${BUILD_SPHINX_PDF:-} ]]; then BUILD_SPHINX_PDF=YES; fi -if [[ -z ${INTEGER_LIBRARY:-} ]]; then INTEGER_LIBRARY=integer-gmp; fi -if [[ -z ${BUILD_FLAVOUR:-} ]]; then BUILD_FLAVOUR=perf; fi - -if [[ -z ${XZ:-} ]]; then - if which pxz; then - XZ="pxz" - elif which xz; then - # Check whether --threads is supported - if echo "hello" | xz --threads=$CORES >/dev/null; then - XZ="xz --threads=$CORES" - else - XZ="xz" - fi - else - echo "error: neither pxz nor xz were found" - exit 1 - fi -fi -echo "Using $XZ for compression..." - - -cat > mk/build.mk <> mk/build.mk -BuildFlavour=$BUILD_FLAVOUR -ifneq "\$(BuildFlavour)" "" -include mk/flavours/\$(BuildFlavour).mk -endif -GhcLibHcOpts+=-haddock -EOF - -case "$(uname)" in - Linux) - if [[ -n ${TARGET:-} ]]; then - if [[ $TARGET = FreeBSD ]]; then - # cross-compiling to FreeBSD - echo 'HADDOCK_DOCS = NO' >> mk/build.mk - echo 'WERROR=' >> mk/build.mk - # https://circleci.com/docs/2.0/env-vars/#interpolating-environment-variables-to-set-other-environment-variables - echo 'export PATH=/opt/ghc/bin:$PATH' >> $BASH_ENV - else - fail "TARGET=$target not supported" - fi - fi - ;; - - Darwin) - if [[ -n ${TARGET:-} ]]; then - fail "uname=$(uname) not supported for cross-compilation" - fi - # It looks like we already have python2 here and just installing python3 - # does not work. - brew upgrade python - brew install ghc cabal-install ncurses gmp - - pip3 install sphinx - # PDF documentation disabled as MacTeX apparently doesn't include xelatex. - #brew cask install mactex - - cabal update - cabal install --reinstall alex happy haddock hscolour --index-state=$hackage_index_state - # put them on the $PATH, don't fail if already installed - ln -s $HOME/.cabal/bin/alex /usr/local/bin/alex || true - ln -s $HOME/.cabal/bin/happy /usr/local/bin/happy || true - ln -s $HOME/.cabal/bin/HsColour /usr/local/bin/HsColour || true - echo "libraries/integer-gmp_CONFIGURE_OPTS += --configure-option=--with-intree-gmp" >> mk/build.mk - ;; - *) - fail "uname=$(uname) not supported" -esac - -echo "=================================================" -echo "Build.mk:" -echo "" -cat mk/build.mk -echo "=================================================" ===================================== .gitlab/win32-init.sh deleted ===================================== @@ -1,67 +0,0 @@ -#!/bin/bash - -set -e - -toolchain=`pwd`/toolchain -PATH="$toolchain/bin:/mingw64/bin:$PATH" - -if [ -d "`pwd`/cabal-cache" ]; then - cp -Rf cabal-cache $APPDATA/cabal -fi - -if [ ! -e $toolchain/bin/ghc ]; then - case $MSYSTEM in - MINGW32) - triple="i386-unknown-mingw32" - ;; - MINGW64) - triple="x86_64-unknown-mingw32" - ;; - *) - echo "win32-init: Unknown MSYSTEM $MSYSTEM" - exit 1 - ;; - esac - curl https://downloads.haskell.org/~ghc/$GHC_VERSION/ghc-$GHC_VERSION-$triple.tar.xz | tar -xJ - mv ghc-$GHC_VERSION toolchain -fi - -if [ ! -e $toolchain/bin/cabal ]; then - url="https://downloads.haskell.org/~cabal/cabal-install-2.4.1.0/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 - -if [ ! -e $toolchain/bin/happy ]; then - cabal update - cabal install happy - cp $APPDATA/cabal/bin/happy $toolchain/bin -fi - -if [ ! -e $toolchain/bin/alex ]; then - cabal update - cabal install alex - cp $APPDATA/cabal/bin/alex $toolchain/bin -fi - -if [[ -z ${INTEGER_LIBRARY:-} ]]; then INTEGER_LIBRARY=integer-gmp; fi -cat > mk/build.mk < str: + return "{base}/{arch}/{fname}".format( + base=BASE_URL, + arch=arch, + fname=fname) + +def fetch(url: str, dest: Path): + print('Fetching', url, '=>', dest) + urllib.request.urlretrieve(url, dest) + +def fetch_arch(arch: str): + req = urllib.request.urlopen(file_url(arch, 'MANIFEST')) + files = req.read().decode('UTF-8').split('\n') + d = DEST / arch + if not d.is_dir(): + d.mkdir(parents=True) + fetch(file_url(arch, 'SHA256SUMS'), d / 'SHA256SUMS') + for fname in files: + if not (d / fname).is_file(): + fetch(file_url(arch, fname), d / fname) + + verify(arch) + +def verify(arch: str): + cmd = ['sha256sum', '--quiet', '--check', '--ignore-missing', 'SHA256SUMS'] + subprocess.check_call(cmd, cwd=DEST / arch) + +def main() -> None: + parser = argparse.ArgumentParser() + parser.add_argument('mode', choices=['verify', 'download']) + parser.add_argument( + 'arch', + choices=ARCHS + ['all'], + help="Architecture to fetch (either i686, x86_64, sources, or all)") + args = parser.parse_args() + + action = fetch_arch if args.mode == 'download' else verify + if args.arch == 'all': + for arch in ARCHS: + action(arch) + else: + action(args.arch) + +if __name__ == '__main__': + main() ===================================== mk/get-win32-tarballs.sh deleted ===================================== @@ -1,326 +0,0 @@ -#!/usr/bin/env bash - -tarball_dir='ghc-tarballs' -missing_files=0 -pkg_variant="phyx" - -# see #12502 -if test -z "$FIND"; then FIND="find"; fi - -fail() { - echo >&2 - echo "$1" >&2 - exit 1 -} - -download_file() { - local file_url="$1" - local dest_file="$2" - local description="$3" - local extra_curl_opts="$4" - local backup_url="$5" - local dest_dir="$(dirname $dest_file)" - - if ! test -f "${dest_file}" - then - local curl_cmd="curl -f -L ${file_url} -o ${dest_file} --create-dirs -# ${extra_curl_opts}" - if test -n "${backup_url}"; then - local curl_cmd_bnk="curl -f -L ${backup_url} -o ${dest_file} --create-dirs -# ${extra_curl_opts}" - else - local curl_cmd_bnk="true" - fi - - if test "$download" = "0" - then - echo "ERROR: Missing ${description}" >&2 - echo "${file_url}" - missing_files=1 - return - else - echo "Downloading ${description} to ${dest_dir}..." - $curl_cmd || (echo "Checking repo.msys2.org instead of Haskell.org..." && $curl_cmd_bnk) || { - rm -f "${dest_file}" - fail "ERROR: Download failed." - exit 1 - } - fi - fi - - local sig_file="${dest_file}.sig" - if test "$sigs" = "1" -a ! -f "$sig_file" - then - echo "Downloading ${description} (signature) to ${dest_dir}..." - local curl_cmd="curl -f -L ${file_url}.sig -o ${sig_file} --create-dirs -# ${extra_curl_opts}" - if test -n "${backup_url}"; then - local curl_cmd_bnk="curl -f -L "${backup_url}.sig" -o ${sig_file} --create-dirs -# ${extra_curl_opts}" - else - local curl_cmd_bnk="true" - fi - $curl_cmd || (echo "Checking repo.msys2.org instead of Haskell.org..." && $curl_cmd_bnk) || { - rm -f "${dest_file}.sig" - fail "ERROR: Download failed." - exit 1 - } - fi - - if test "$verify" = "1" - then - grep "${dest_file}$" mk/win32-tarballs.md5sum | md5sum --quiet -c - || - fail "ERROR: ${description} appears to be corrupted, please delete it and try again." - fi -} - -download_mingw() { - local mingw_base_url_primary="https://downloads.haskell.org/~ghc/mingw" - local mingw_base_url_secondary="http://repo.msys2.org/mingw" - - if test "$mingw_arch" = "sources" - then - mingw_url_tmp=`echo "$1" | sed -e 's/-any\.pkg\.tar\.xz/\.src\.tar\.gz/' \ - -e 's/-sources-/-/' \ - -e 's/-libwinpthread-git-/-winpthreads-git-/' ` - local mingw_url="${mingw_base_url_primary}/${mingw_url_tmp}" - local mingw_url_backup="${mingw_base_url_secondary}/${mingw_url_tmp}" - else - local mingw_url="${mingw_base_url_primary}/$1" - local mingw_url_backup="${mingw_base_url_secondary}/$1" - fi - - local mingw_toolchain="$(basename $mingw_url)" - local mingw_w64="${tarball_dir}/${tarball_dest_dir}/${mingw_toolchain}" - - download_file "${mingw_url}" "${mingw_w64}" "${mingw_toolchain}" "" "${mingw_url_backup}" - - # Mark the tree as needing updates by deleting the folder - if test -d inplace/mingw && test inplace/mingw -ot "$mingw_w64" ; then - echo "In-tree MinGW-w64 tree requires updates..." - rm -rf inplace/mingw - fi -} - -download_tarballs() { - local package_prefix="mingw-w64" - local format_url="/${mingw_arch}/${package_prefix}-${mingw_arch}" - - download_mingw "${format_url}-crt-git-7.0.0.5491.fe45801e-1-any.pkg.tar.xz" - download_mingw "${format_url}-winpthreads-git-7.0.0.5480.e14d23be-1-any.pkg.tar.xz" - download_mingw "${format_url}-headers-git-7.0.0.5490.9ec54ed1-1-any.pkg.tar.xz" - download_mingw "${format_url}-libwinpthread-git-7.0.0.5480.e14d23be-1-any.pkg.tar.xz" - download_mingw "${format_url}-zlib-1.2.8-9-any.pkg.tar.xz" - download_mingw "${format_url}-isl-0.21-1-any.pkg.tar.xz" - download_mingw "${format_url}-mpfr-4.0.2-2-any.pkg.tar.xz" - download_mingw "${format_url}-gmp-6.1.2-1-any.pkg.tar.xz" - download_mingw "${format_url}-binutils-2.32-3-$pkg_variant.pkg.tar.xz" - download_mingw "${format_url}-libidn2-2.2.0-1-any.pkg.tar.xz" - download_mingw "${format_url}-gcc-9.2.0-1-$pkg_variant.pkg.tar.xz" - download_mingw "${format_url}-mpc-1.1.0-1-any.pkg.tar.xz" - download_mingw "${format_url}-windows-default-manifest-6.4-3-any.pkg.tar.xz" - - # Upstream is unfortunately quite inconsistent in naming - if test "$mingw_arch" != "sources"; then - download_mingw "${format_url}-gcc-libs-9.2.0-1-$pkg_variant.pkg.tar.xz" - fi - - if ! test "$missing_files" = "0" - then - exit 2 - fi -} - -download_i386() { - mingw_arch="i686" - tarball_dest_dir="mingw-w64/i686" - download_tarballs -} - -download_x86_64() { - mingw_arch="x86_64" - tarball_dest_dir="mingw-w64/x86_64" - download_tarballs -} - -download_sources() { - mingw_arch="sources" - tarball_dest_dir="mingw-w64/sources" - download_tarballs -} - -sync_binaries_and_sources() { - gpg --recv-key 5F92EFC1A47D45A1 - - # ensure sources are downloaded - sigs=1 - download_i386 - download_x86_64 - verify=0 - download_sources - - for f in $($FIND ghc-tarballs/mingw-w64 -iname '*.sig'); do - echo "Verifying $f" - gpg --verify $f - done - - md5sum `$FIND ghc-tarballs -type f -a -not -iname '*.sig'` >| mk/win32-tarballs.md5sum - chmod -R ugo+rX ghc-tarballs - - rsync -av ghc-tarballs/mingw-w64/* downloads.haskell.org:public_html/mingw - for f in $($FIND ghc-tarballs/mingw-w64); do - curl -XPURGE http://downloads.haskell.org/~ghc/mingw/$f - done -} - -patch_single_file () { - local patcher_base="$1" - local filename=$(readlink -f "$2") - local filepath=$(dirname "$filename") - local patcher="$patcher_base/iat-patcher.exe" - $patcher install "$filename" > /dev/null - rm -f "$filename.bak" - for file in $patcher_base/*.dll; do cp -f "$file" "${filepath}"; done - echo "Patched '$filename'" -} - -patch_tarball () { - local tarball_name="$1" - local filename=$(basename "$tarball_name") - local filepath=$(dirname "$tarball_name") - local newfile=`echo "$filepath/$filename" | sed -e 's/-any/-phyx/'` - local arch="" - - echo "=> ${filename}" - - case $1 in - *x86_64*) - arch="x86_64" - ;; - *i686*) - arch="i686" - ;; - *) - echo "unknown architecture detected. Stopping." - exit 1 - ;; - esac - - local base="$(pwd)" - local patcher_base="$(pwd)/ghc-tarballs/ghc-jailbreak/$arch" - local tmpdir="ghc-tarballs/tmpdir" - mkdir -p $tmpdir - cd $tmpdir - tar xJf "$base/$tarball_name" - find . -iname "*.exe" -exec bash -c \ - 'patch_single_file "'"${patcher_base}"'" "$0"' {} \; - tar cJf "$base/$newfile" . - cd "$base" - rm -rf $tmpdir - gpg --output "$base/${newfile}.sig" --detach-sig "$base/$newfile" - rm -f "$base/$tarball_name" -} - -show_hashes_for_binaries() { - $FIND ghc-tarballs/ -iname "*.*" | xargs md5sum | grep -v "\.sig" | sed -s "s/\*//" -} - -usage() { - echo "$0 - Download GHC mingw toolchain tarballs" - echo - echo "Usage: $0 []" - echo - echo "Where is one of," - echo "" - echo " download download the necessary tarballs for the given architecture" - echo " fetch download the necessary tarballs for the given architecture but doesn't verify their md5." - echo " grab download the necessary tarballs using patched toolchains for the given architecture but doesn't verify their md5." - echo " verify verify the existence and correctness of the necessary tarballs" - echo " patch jailbreak the binaries in the tarballs and remove MAX_PATH limitations." - echo " hash generate md5 hashes for inclusion in win32-tarballs.md5sum" - echo " sync upload packages downloaded with 'fetch mirror' to haskell.org" - echo "" - echo "and is one of i386, x86_64,all or mirror (which includes sources)" -} - -case $1 in - download) - download=1 - verify=1 - sigs=0 - ;; - fetch) - download=1 - verify= - ;; - grab) - download=1 - verify=0 - pkg_variant="any" - ;; - verify) - download=0 - verify=1 - ;; - sync) - download=1 - verify=0 - sync=1 - ;; - hash) - show_hashes_for_binaries - exit 1 - ;; - # This routine will download the latest ghc-jailbreak and unpack binutils and - # the ghc tarballs and patches every .exe in each. Along with this is copies - # two dlls in every folder that it patches a .exe in. Afterwards it re-creates - # the tarballs and generates a new signature file. - patch) - export -f patch_tarball - export -f patch_single_file - - echo "Downloading ghc-jailbreak..." - curl -f -L https://mistuke.blob.core.windows.net/binaries/ghc-jailbreak-0.3.tar.gz \ - -o ghc-tarballs/ghc-jailbreak/ghc-jailbreak.tar.gz --create-dirs -# - tar -C ghc-tarballs/ghc-jailbreak/ -xf ghc-tarballs/ghc-jailbreak/ghc-jailbreak.tar.gz - - find ghc-tarballs/mingw-w64/ \( -iname "*binutils*.tar.xz" \ - -o -iname "*gcc*.tar.xz" \) \ - -exec bash -c 'patch_tarball "$0"' {} \; - - rm -rf ghc-tarballs/ghc-jailbreak - - echo "Finished tarball generation, toolchain has been pre-patched." - exit 0 - ;; - *) - usage - exit 1 - ;; -esac - -case $2 in - i386) - download_i386 - ;; - x86_64) - download_x86_64 - ;; - all) - download_i386 - download_x86_64 - ;; - mirror) - sigs=1 - download_i386 - download_x86_64 - verify=0 - sigs=0 - download_sources - show_hashes_for_binaries - ;; - *) - if test "$sync" = "1"; then - sync_binaries_and_sources - else - usage - exit 1 - fi - ;; -esac View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/944e5f9ed126da0b28d22456dc97d85076b11f9d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/944e5f9ed126da0b28d22456dc97d85076b11f9d You're receiving 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 Mar 18 13:57:44 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 18 Mar 2020 09:57:44 -0400 Subject: [Git][ghc/ghc][wip/andreask/eqByTag] Eliminate generated Con2Tag bindings completely Message-ID: <5e7228d8e8c47_488a3fc6ca423d3c19010d4@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/andreask/eqByTag at Glasgow Haskell Compiler / GHC Commits: b173bc69 by Andreas Klebinger at 2020-03-18T13:57:23Z Eliminate generated Con2Tag bindings completely - - - - - 2 changed files: - compiler/typecheck/TcGenDeriv.hs - testsuite/tests/deriving/should_compile/T14682.stderr Changes: ===================================== compiler/typecheck/TcGenDeriv.hs ===================================== @@ -84,9 +84,8 @@ import Data.List ( find, partition, intersperse ) type BagDerivStuff = Bag DerivStuff data AuxBindSpec - = DerivCon2Tag TyCon -- The con2Tag for given TyCon - | DerivTag2Con TyCon -- ...ditto tag2Con - | DerivMaxTag TyCon -- ...and maxTag + = DerivTag2Con TyCon -- The tag2Con for given TyCon + | DerivMaxTag TyCon -- ...and ditto maxTag deriving( Eq ) -- All these generate ZERO-BASED tag operations -- I.e first constructor has tag 0 @@ -131,14 +130,14 @@ possibly zero of them). Here's an example, with both \tr{N}ullary and * For nullary constructors, we emit a catch-all clause of the form: - (==) a b = case (dataToTag a) of { a# -> - case (con2tag_Foo b) of { b# -> + (==) a b = case (dataToTag# a) of { a# -> + case (dataToTag# b) of { b# -> case (a# ==# b#) of { r -> r }}} - If con2tag gets inlined this leads to join point stuff, so - it's better to use regular pattern matching if there aren't too - many nullary constructors. "Ten" is arbitrary, of course + An older approach preferred regular pattern matches in some cases + but with dataToTag# forcing it's argument, and work on improving + join points, this seems no longer necessary. * If there aren't any nullary constructors, we emit a simpler catch-all: @@ -147,7 +146,7 @@ possibly zero of them). Here's an example, with both \tr{N}ullary and * For the @(/=)@ method, we normally just use the default method. If the type is an enumeration type, we could/may/should? generate - special code that calls @con2tag_Foo@, much like for @(==)@ shown + special code that calls @dataToTag#@, much like for @(==)@ shown above. We thought about doing this: If we're also deriving 'Ord' for this @@ -163,7 +162,7 @@ produced don't get through the typechecker. gen_Eq_binds :: SrcSpan -> TyCon -> TcM (LHsBinds GhcPs, BagDerivStuff) gen_Eq_binds loc tycon = do dflags <- getDynFlags - return (method_binds dflags, aux_binds) + return (method_binds dflags, emptyBag) where all_cons = tyConDataCons tycon (nullary_cons, non_nullary_cons) = partition isNullarySrcDataCon all_cons @@ -192,13 +191,9 @@ gen_Eq_binds loc tycon = do untag_Expr dflags tycon [(a_RDR,ah_RDR), (b_RDR,bh_RDR)] (genPrimOpApp (nlHsVar ah_RDR) eqInt_RDR (nlHsVar bh_RDR)))] - aux_binds | no_tag_match_cons = emptyBag - | otherwise = emptyBag - --unitBag $ DerivAuxBind $ DerivCon2Tag tycon - method_binds dflags = unitBag (eq_bind dflags) eq_bind dflags = mkFunBindEC 2 loc eq_RDR (const true_Expr) - (map pats_etc pat_match_cons + ( map pats_etc pat_match_cons ++ fall_through_eqn dflags) ------------------------------------------------------------------ @@ -348,11 +343,8 @@ gen_Ord_binds loc tycon = do then ( unitBag $ mkFunBindEC 2 loc compare_RDR (const eqTag_Expr) [] , emptyBag) else ( unitBag (mkOrdOp dflags OrdCompare) `unionBags` other_ops dflags - , aux_binds) + , emptyBag) where - aux_binds | single_con_type = emptyBag - | otherwise = unitBag $ DerivAuxBind $ DerivCon2Tag tycon - -- Note [Game plan for deriving Ord] other_ops dflags | (last_tag - first_tag) <= 2 -- 1-3 constructors @@ -371,7 +363,7 @@ gen_Ord_binds loc tycon = do get_tag con = dataConTag con - fIRST_TAG -- We want *zero-based* tags, because that's what - -- con2Tag returns (generated by untag_Expr)! + -- dataToTag# returns (generated by untag_Expr)! tycon_data_cons = tyConDataCons tycon single_con_type = isSingleton tycon_data_cons @@ -551,8 +543,8 @@ nlConWildPat con = noLoc (ConPatIn (noLoc (getRdrName con)) data Foo ... = N1 | N2 | ... | Nn \end{verbatim} -we use both @con2tag_Foo@ and @tag2con_Foo@ functions, as well as a - at maxtag_Foo@ variable (all generated by @gen_tag_n_con_binds@). +we use both dataToTag# and @tag2con_Foo@ functions, as well as a + at maxtag_Foo@ variable, the later generated by @gen_tag_n_con_binds. \begin{verbatim} instance ... Enum (Foo ...) where @@ -565,16 +557,16 @@ instance ... Enum (Foo ...) where -- or, really... enumFrom a - = case con2tag_Foo a of + = case dataToTag# a of a# -> map tag2con_Foo (enumFromTo (I# a#) maxtag_Foo) enumFromThen a b - = map tag2con_Foo [con2tag_Foo a, con2tag_Foo b .. maxtag_Foo] + = map tag2con_Foo [dataToTag# a, dataToTag# b .. maxtag_Foo] -- or, really... enumFromThen a b - = case con2tag_Foo a of { a# -> - case con2tag_Foo b of { b# -> + = case dataToTag# a of { a# -> + case dataToTag# b of { b# -> map tag2con_Foo (enumFromThenTo (I# a#) (I# b#) maxtag_Foo) }} \end{verbatim} @@ -596,7 +588,7 @@ gen_Enum_binds loc tycon = do , from_enum dflags ] aux_binds = listToBag $ map DerivAuxBind - [DerivCon2Tag tycon, DerivTag2Con tycon, DerivMaxTag tycon] + [DerivTag2Con tycon, DerivMaxTag tycon] occ_nm = getOccString tycon @@ -711,32 +703,32 @@ things go not too differently from @Enum@: \begin{verbatim} instance ... Ix (Foo ...) where range (a, b) - = map tag2con_Foo [con2tag_Foo a .. con2tag_Foo b] + = map tag2con_Foo [dataToTag# a .. dataToTag# b] -- or, really... range (a, b) - = case (con2tag_Foo a) of { a# -> - case (con2tag_Foo b) of { b# -> + = case (dataToTag# a) of { a# -> + case (dataToTag# b) of { b# -> map tag2con_Foo (enumFromTo (I# a#) (I# b#)) }} -- Generate code for unsafeIndex, because using index leads -- to lots of redundant range tests unsafeIndex c@(a, b) d - = case (con2tag_Foo d -# con2tag_Foo a) of + = case (dataToTag# d -# dataToTag# a) of r# -> I# r# inRange (a, b) c = let - p_tag = con2tag_Foo c + p_tag = dataToTag# c in - p_tag >= con2tag_Foo a && p_tag <= con2tag_Foo b + p_tag >= dataToTag# a && p_tag <= dataToTag# b -- or, really... inRange (a, b) c - = case (con2tag_Foo a) of { a_tag -> - case (con2tag_Foo b) of { b_tag -> - case (con2tag_Foo c) of { c_tag -> + = case (dataToTag# a) of { a_tag -> + case (dataToTag# b) of { b_tag -> + case (dataToTag# c) of { c_tag -> if (c_tag >=# a_tag) then c_tag <=# b_tag else @@ -759,8 +751,8 @@ gen_Ix_binds loc tycon = do dflags <- getDynFlags return $ if isEnumerationTyCon tycon then (enum_ixes dflags, listToBag $ map DerivAuxBind - [DerivCon2Tag tycon, DerivTag2Con tycon, DerivMaxTag tycon]) - else (single_con_ixes, unitBag (DerivAuxBind (DerivCon2Tag tycon))) + [DerivTag2Con tycon, DerivMaxTag tycon]) + else (single_con_ixes, emptyBag) where -------------------------------------------------------------- enum_ixes dflags = listToBag @@ -1939,41 +1931,18 @@ mkCoerceClassMethEqn cls inst_tvs inst_tys rhs_ty id \begin{verbatim} data Foo ... = ... -con2tag_Foo :: Foo ... -> Int# tag2con_Foo :: Int -> Foo ... -- easier if Int, not Int# maxtag_Foo :: Int -- ditto (NB: not unlifted) \end{verbatim} The `tags' here start at zero, hence the @fIRST_TAG@ (currently one) fiddling around. + +We also use dataToTag# heavily. -} genAuxBindSpec :: DynFlags -> SrcSpan -> AuxBindSpec -> (LHsBind GhcPs, LSig GhcPs) -genAuxBindSpec dflags loc (DerivCon2Tag tycon) - = (mkFunBindSE 0 loc rdr_name eqns, - L loc (TypeSig noExtField [L loc rdr_name] sig_ty)) - where - rdr_name = con2tag_RDR dflags tycon - - sig_ty = mkLHsSigWcType $ L loc $ XHsType $ NHsCoreTy $ - mkSpecSigmaTy (tyConTyVars tycon) (tyConStupidTheta tycon) $ - mkParentType tycon `mkVisFunTy` intPrimTy - - lots_of_constructors = tyConFamilySize tycon > 8 - -- was: mAX_FAMILY_SIZE_FOR_VEC_RETURNS - -- but we don't do vectored returns any more. - - eqns | lots_of_constructors = [get_tag_eqn] - | otherwise = map mk_eqn (tyConDataCons tycon) - - get_tag_eqn = ([nlVarPat a_RDR], nlHsApp (nlHsVar getTag_RDR) a_Expr) - - mk_eqn :: DataCon -> ([LPat GhcPs], LHsExpr GhcPs) - mk_eqn con = ([nlWildConPat con], - nlHsLit (HsIntPrim NoSourceText - (toInteger ((dataConTag con) - fIRST_TAG)))) - genAuxBindSpec dflags loc (DerivTag2Con tycon) = (mkFunBindSE 0 loc rdr_name [([nlConVarPat intDataCon_RDR [a_RDR]], @@ -2267,7 +2236,7 @@ untag_Expr :: DynFlags -> LHsExpr GhcPs -- Result expr untag_Expr _ _ [] expr = expr untag_Expr dflags tycon ((untag_this, put_tag_here) : more) expr - {- case (getTag untag_this) of + {- case (dataToTag# untag_this) of put_tag_here -> .... _ -> result -} @@ -2386,9 +2355,8 @@ minusInt_RDR, tagToEnum_RDR :: RdrName minusInt_RDR = getRdrName (primOpId IntSubOp ) tagToEnum_RDR = getRdrName (primOpId TagToEnumOp) -con2tag_RDR, tag2con_RDR, maxtag_RDR :: DynFlags -> TyCon -> RdrName +tag2con_RDR, maxtag_RDR :: DynFlags -> TyCon -> RdrName -- Generates Orig s RdrName, for the binding positions -con2tag_RDR dflags tycon = mk_tc_deriv_name dflags tycon mkCon2TagOcc tag2con_RDR dflags tycon = mk_tc_deriv_name dflags tycon mkTag2ConOcc maxtag_RDR dflags tycon = mk_tc_deriv_name dflags tycon mkMaxTagOcc @@ -2417,13 +2385,15 @@ mkAuxBinderName dflags parent occ_fun {- Note [Auxiliary binders] ~~~~~~~~~~~~~~~~~~~~~~~~ -We often want to make a top-level auxiliary binding. E.g. for comparison we have - instance Ord T where - compare a b = $con2tag a `compare` $con2tag b +We often want to make a top-level auxiliary binding. E.g. for enum we +turn a Integer into a constructor. So we have + + instance Enum T where + succ x = $tag2con (dataToTag x + 1) - $con2tag :: T -> Int - $con2tag = ...code.... + $tag2con :: Int -> T + $tag2con = ...code.... Of course these top-level bindings should all have distinct name, and we are generating RdrNames here. We can't just use the TyCon or DataCon to distinguish ===================================== testsuite/tests/deriving/should_compile/T14682.stderr ===================================== @@ -71,9 +71,6 @@ Derived class instances: = (GHC.Ix.inRange (a1, b1) c1 GHC.Classes.&& GHC.Ix.inRange (a2, b2) c2) - T14682.$con2tag_B4iUvrAY4wB3YczpMJQUOX :: - T14682.Foo -> GHC.Prim.Int# - T14682.$con2tag_B4iUvrAY4wB3YczpMJQUOX (T14682.Foo _ _) = 0# T14682.$tFoo :: Data.Data.DataType T14682.$cFoo :: Data.Data.Constr T14682.$tFoo = Data.Data.mkDataType "Foo" [T14682.$cFoo] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/b173bc69180febe2763117e90624ab1906a855a8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/b173bc69180febe2763117e90624ab1906a855a8 You're receiving 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 Mar 20 08:54:02 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Fri, 20 Mar 2020 04:54:02 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T17932 Message-ID: <5e7484aa4f3c6_488a3fc6ce6d2d902277435@gitlab.haskell.org.mail> Simon Peyton Jones pushed new branch wip/T17932 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/T17932 You're receiving 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 Mar 20 17:18:13 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 20 Mar 2020 13:18:13 -0400 Subject: [Git][ghc/ghc][master] 2 commits: Refactoring: use Platform instead of DynFlags when possible Message-ID: <5e74fad5aaff2_488a3fc6a691ddac23487c9@gitlab.haskell.org.mail> Ben Gamari pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 64f20756 by Sylvain Henry at 2020-03-19T16:16:49Z Refactoring: use Platform instead of DynFlags when possible Metric Decrease: ManyConstructors T12707 T13035 T1969 - - - - - cb1785d9 by Ömer Sinan Ağacan at 2020-03-19T16:16:54Z 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. - - - - - 30 changed files: - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Graph.hs - compiler/GHC/Cmm/Info.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/Ppr.hs - compiler/GHC/Cmm/Ppr/Decl.hs - compiler/GHC/Cmm/Ppr/Expr.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Switch/Implement.hs - compiler/GHC/Cmm/Type.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen/Amode.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen/Base.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen/CondCode.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen/Gen32.hs - compiler/GHC/CmmToAsm/SPARC/Ppr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/b03fd3bcd4ff14aed2942275c3b0db5392dc913c...cb1785d9f839e34a3a4892f354f0c51cc6553c0e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/b03fd3bcd4ff14aed2942275c3b0db5392dc913c...cb1785d9f839e34a3a4892f354f0c51cc6553c0e You're receiving 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 Mar 18 14:06:09 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 18 Mar 2020 10:06:09 -0400 Subject: [Git][ghc/ghc][master] Fix #17021 by checking more return kinds Message-ID: <5e722ad111b5f_488a3fc6ca423d3c19073ac@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 53ff2cd0 by Richard Eisenberg at 2020-03-17T13:46:57Z 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 - - - - - 30 changed files: - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Expr.hs - compiler/typecheck/FamInst.hs - compiler/typecheck/TcHsType.hs - compiler/typecheck/TcInstDcls.hs - compiler/typecheck/TcTyClsDecls.hs - docs/users_guide/exts/poly_kinds.rst - testsuite/tests/polykinds/T15787.stderr - testsuite/tests/polykinds/T7230.stderr - testsuite/tests/polykinds/T9222.stderr - + testsuite/tests/typecheck/should_compile/T17021a.hs - testsuite/tests/typecheck/should_compile/all.T - testsuite/tests/typecheck/should_fail/T12729.hs - testsuite/tests/typecheck/should_fail/T12729.stderr - testsuite/tests/typecheck/should_fail/T14048a.stderr - testsuite/tests/typecheck/should_fail/T14048b.stderr - testsuite/tests/typecheck/should_fail/T14048c.stderr - testsuite/tests/typecheck/should_fail/T15807.stderr - testsuite/tests/typecheck/should_fail/T15883.stderr - testsuite/tests/typecheck/should_fail/T16821.stderr - testsuite/tests/typecheck/should_fail/T16829a.stderr - testsuite/tests/typecheck/should_fail/T16829b.stderr - + testsuite/tests/typecheck/should_fail/T17021.hs - + testsuite/tests/typecheck/should_fail/T17021.stderr - + testsuite/tests/typecheck/should_fail/T17021b.hs - + testsuite/tests/typecheck/should_fail/T17021b.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/53ff2cd0c49735e8f709ac8a5ceab68483eb89df -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/53ff2cd0c49735e8f709ac8a5ceab68483eb89df You're receiving 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 Mar 19 13:17:11 2020 From: gitlab at gitlab.haskell.org (=?UTF-8?B?w5ZtZXIgU2luYW4gQcSfYWNhbg==?=) Date: Thu, 19 Mar 2020 09:17:11 -0400 Subject: [Git][ghc/ghc][wip/osa1/lfinfo] Cross-module LambdaFormInfo passing Message-ID: <5e7370d75e3c1_488a3fc6f93dbda02108686@gitlab.haskell.org.mail> Ömer Sinan Ağacan pushed to branch wip/osa1/lfinfo at Glasgow Haskell Compiler / GHC Commits: 99b0c93a by Ömer Sinan Ağacan at 2020-03-19T13:16:52Z Cross-module LambdaFormInfo passing - Store LambdaFormInfos of exported Ids in interface files - Use them in importing modules - - - - - 29 changed files: - compiler/GHC/CoreToIface.hs - compiler/GHC/Driver/Hooks.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Runtime/Heap/Layout.hs - compiler/GHC/StgToCmm.hs - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/StgToCmm/Env.hs - + compiler/GHC/StgToCmm/Types.hs - compiler/basicTypes/Id.hs - compiler/basicTypes/IdInfo.hs - compiler/ghc.cabal.in - compiler/main/UpdateCafInfos.hs - testsuite/tests/codeGen/should_compile/Makefile - + testsuite/tests/codeGen/should_compile/cg009/A.hs - + testsuite/tests/codeGen/should_compile/cg009/Main.hs - + testsuite/tests/codeGen/should_compile/cg009/Makefile - + testsuite/tests/codeGen/should_compile/cg009/all.T - + testsuite/tests/codeGen/should_compile/cg010/A.hs - + testsuite/tests/codeGen/should_compile/cg010/Main.hs - + testsuite/tests/codeGen/should_compile/cg010/Makefile - + testsuite/tests/codeGen/should_compile/cg010/all.T - + testsuite/tests/codeGen/should_compile/cg010/cg010.stdout - testsuite/tests/simplCore/should_compile/Makefile - testsuite/tests/simplCore/should_compile/T4201.stdout Changes: ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -41,6 +41,8 @@ module GHC.CoreToIface , toIfaceCon , toIfaceApp , toIfaceVar + -- * Other stuff + , toIfaceLFInfo ) where #include "HsVersions.h" @@ -49,6 +51,7 @@ import GhcPrelude import GHC.Iface.Syntax import GHC.Core.DataCon +import GHC.StgToCmm.Types import Id import IdInfo import GHC.Core @@ -74,6 +77,8 @@ import Demand ( isTopSig ) import Cpr ( topCprSig ) import Data.Maybe ( catMaybes ) +import Data.Word +import Data.Bits {- Note [Avoiding space leaks in toIface*] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -534,7 +539,7 @@ toIfaceExpr (Var v) = toIfaceVar v toIfaceExpr (Lit l) = IfaceLit l toIfaceExpr (Type ty) = IfaceType (toIfaceType ty) toIfaceExpr (Coercion co) = IfaceCo (toIfaceCoercion co) -toIfaceExpr (Lam x b) = IfaceLam (toIfaceBndr x, toIfaceOneShot x) (toIfaceExpr b) +toIfaceExpr (Lam x b) = IfaceLam (toIfaceBndr x, toIdIfaceOneShot x) (toIfaceExpr b) toIfaceExpr (App f a) = toIfaceApp f [a] toIfaceExpr (Case s x ty as) | null as = IfaceECase (toIfaceExpr s) (toIfaceType ty) @@ -545,12 +550,16 @@ toIfaceExpr (Tick t e) | Just t' <- toIfaceTickish t = IfaceTick t' (toIfaceExpr e) | otherwise = toIfaceExpr e -toIfaceOneShot :: Id -> IfaceOneShot -toIfaceOneShot id | isId id - , OneShotLam <- oneShotInfo (idInfo id) - = IfaceOneShot - | otherwise - = IfaceNoOneShot +toIdIfaceOneShot :: Id -> IfaceOneShot +toIdIfaceOneShot id + | isId id + = toIfaceOneShot (oneShotInfo (idInfo id)) + | otherwise + = IfaceNoOneShot + +toIfaceOneShot :: OneShotInfo -> IfaceOneShot +toIfaceOneShot OneShotLam = IfaceOneShot +toIfaceOneShot NoOneShotInfo = IfaceNoOneShot --------------------- toIfaceTickish :: Tickish Id -> Maybe IfaceTickish @@ -616,6 +625,41 @@ toIfaceVar v where name = idName v +--------------------- +toIfaceLFInfo :: LambdaFormInfo -> IfaceLFInfo +toIfaceLFInfo (LFReEntrant TopLevel oneshot rep fvs_flag _argdesc) = + IfLFReEntrant (toIfaceOneShot oneshot) rep fvs_flag +toIfaceLFInfo (LFThunk TopLevel hasfv updateable sfi m_function) = + -- Assert that arity fits in 14 bits + ASSERT(fromEnum hasfv <= 1 && fromEnum updateable <= 1 && fromEnum m_function <= 1) + IfLFThunk hasfv updateable (toIfaceStandardFormInfo sfi) m_function +toIfaceLFInfo LFUnlifted = IfLFUnlifted +toIfaceLFInfo (LFCon con) = IfLFCon (dataConName con) +-- All other cases are not possible at the top level. +toIfaceLFInfo lf = pprPanic "Invalid IfaceLFInfo conversion:" + (ppr lf <+> text "should not be exported") + +toIfaceStandardFormInfo :: StandardFormInfo -> IfaceStandardFormInfo +toIfaceStandardFormInfo NonStandardThunk = IfStandardFormInfo 1 +toIfaceStandardFormInfo sf = + IfStandardFormInfo $! + tag sf .|. encodeField (field sf) + where + tag SelectorThunk{} = 0 + tag ApThunk{} = 2 -- == setBit 0 1 + tag _ = panic "Impossible" + + field (SelectorThunk n) = n + field (ApThunk n) = n + field _ = panic "Impossible" + + encodeField n = + let wn = fromIntegral n :: Word + shifted = wn `unsafeShiftL` 2 + in ASSERT(shifted > 0 && shifted < fromIntegral (maxBound :: Word16)) + (fromIntegral shifted :: Word16) + + {- Note [Inlining and hs-boot files] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider this example (#10083, #12789): ===================================== compiler/GHC/Driver/Hooks.hs ===================================== @@ -55,6 +55,7 @@ import GHC.Stg.Syntax import Stream import GHC.Cmm import GHC.Hs.Extension +import GHC.StgToCmm.Types (ModuleLFInfos) import Data.Maybe @@ -109,7 +110,7 @@ data Hooks = Hooks -> IO (Maybe HValue)) , createIservProcessHook :: Maybe (CreateProcess -> IO ProcessHandle) , stgToCmmHook :: Maybe (DynFlags -> Module -> [TyCon] -> CollectedCCs - -> [CgStgTopBinding] -> HpcInfo -> Stream IO CmmGroup ()) + -> [CgStgTopBinding] -> HpcInfo -> Stream IO CmmGroup ModuleLFInfos) , cmmToRawCmmHook :: forall a . Maybe (DynFlags -> Maybe Module -> Stream IO CmmGroupSRTs a -> IO (Stream IO RawCmmGroup a)) } ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -162,6 +162,7 @@ import Bag import Exception import qualified Stream import Stream (Stream) +import GHC.StgToCmm.Types (ModuleLFInfos) import Util @@ -176,6 +177,7 @@ import qualified Data.Set as S import Data.Set (Set) import Data.Functor import Control.DeepSeq (force) +import Data.Bifunctor (first) import GHC.Iface.Ext.Ast ( mkHieFile ) import GHC.Iface.Ext.Types ( getAsts, hie_asts, hie_module ) @@ -1392,7 +1394,7 @@ hscWriteIface dflags iface no_change mod_location = do -- | Compile to hard-code. hscGenHardCode :: HscEnv -> CgGuts -> ModLocation -> FilePath - -> IO (FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)], NameSet) + -> IO (FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)], NameSet, ModuleLFInfos) -- ^ @Just f@ <=> _stub.c is f hscGenHardCode hsc_env cgguts location output_filename = do let CgGuts{ -- This is the last use of the ModGuts in a compilation. @@ -1451,11 +1453,11 @@ hscGenHardCode hsc_env cgguts location output_filename = do return a rawcmms1 = Stream.mapM dump rawcmms0 - (output_filename, (_stub_h_exists, stub_c_exists), foreign_fps, caf_infos) + (output_filename, (_stub_h_exists, stub_c_exists), foreign_fps, (caf_infos, lf_infos)) <- {-# SCC "codeOutput" #-} codeOutput dflags this_mod output_filename location foreign_stubs foreign_files dependencies rawcmms1 - return (output_filename, stub_c_exists, foreign_fps, caf_infos) + return (output_filename, stub_c_exists, foreign_fps, caf_infos, lf_infos) hscInteractive :: HscEnv @@ -1549,7 +1551,7 @@ doCodeGen :: HscEnv -> Module -> [TyCon] -> CollectedCCs -> [StgTopBinding] -> HpcInfo - -> IO (Stream IO CmmGroupSRTs NameSet) + -> IO (Stream IO CmmGroupSRTs (NameSet, ModuleLFInfos)) -- Note we produce a 'Stream' of CmmGroups, so that the -- backend can be run incrementally. Otherwise it generates all -- the C-- up front, which has a significant space cost. @@ -1561,7 +1563,7 @@ doCodeGen hsc_env this_mod data_tycons dumpIfSet_dyn dflags Opt_D_dump_stg_final "Final STG:" FormatSTG (pprGenStgTopBindings stg_binds_w_fvs) - let cmm_stream :: Stream IO CmmGroup () + let cmm_stream :: Stream IO CmmGroup ModuleLFInfos -- See Note [Forcing of stg_binds] cmm_stream = stg_binds_w_fvs `seqList` {-# SCC "StgToCmm" #-} lookupHook stgToCmmHook StgToCmm.codeGen dflags dflags this_mod data_tycons @@ -1580,10 +1582,11 @@ doCodeGen hsc_env this_mod data_tycons ppr_stream1 = Stream.mapM dump1 cmm_stream + pipeline_stream :: Stream IO CmmGroupSRTs (NameSet, ModuleLFInfos) pipeline_stream = {-# SCC "cmmPipeline" #-} - Stream.mapAccumL (cmmPipeline hsc_env) (emptySRT this_mod) ppr_stream1 - <&> (srtMapNonCAFs . moduleSRTMap) + Stream.mapAccumL_ (cmmPipeline hsc_env) (emptySRT this_mod) ppr_stream1 + <&> (first (srtMapNonCAFs . moduleSRTMap)) dump2 a = do unless (null a) $ ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -1192,12 +1192,12 @@ runPhase (HscOut src_flavour mod_name result) _ dflags = do PipeState{hsc_env=hsc_env'} <- getPipeState - (outputFilename, mStub, foreign_files, caf_infos) <- liftIO $ + (outputFilename, mStub, foreign_files, caf_infos, lf_infos) <- liftIO $ hscGenHardCode hsc_env' cgguts mod_location output_fn - final_iface <- liftIO (mkFullIface hsc_env'{hsc_dflags=iface_dflags} partial_iface (Just caf_infos)) + final_iface <- liftIO (mkFullIface hsc_env'{hsc_dflags=iface_dflags} partial_iface (Just (caf_infos, lf_infos))) let final_mod_details = {-# SCC updateModDetailsCafInfos #-} - updateModDetailsCafInfos iface_dflags caf_infos mod_details + updateModDetailsCafInfos iface_dflags caf_infos lf_infos mod_details setIface final_iface final_mod_details -- See Note [Writing interface files] ===================================== compiler/GHC/Iface/Make.hs ===================================== @@ -38,6 +38,7 @@ import GHC.Core.Coercion.Axiom import GHC.Core.ConLike import GHC.Core.DataCon import GHC.Core.Type +import GHC.StgToCmm.Types (ModuleLFInfos) import TcType import GHC.Core.InstEnv import GHC.Core.FamInstEnv @@ -100,13 +101,13 @@ mkPartialIface hsc_env mod_details -- | Fully instantiate a interface -- Adds fingerprints and potentially code generator produced information. -mkFullIface :: HscEnv -> PartialModIface -> Maybe NameSet -> IO ModIface -mkFullIface hsc_env partial_iface mb_non_cafs = do +mkFullIface :: HscEnv -> PartialModIface -> Maybe (NameSet, ModuleLFInfos) -> IO ModIface +mkFullIface hsc_env partial_iface mb_id_infos = do let decls | gopt Opt_OmitInterfacePragmas (hsc_dflags hsc_env) = mi_decls partial_iface | otherwise - = updateDeclCafInfos (mi_decls partial_iface) mb_non_cafs + = updateDecl (mi_decls partial_iface) mb_id_infos full_iface <- {-# SCC "addFingerprints" #-} @@ -117,15 +118,23 @@ mkFullIface hsc_env partial_iface mb_non_cafs = do return full_iface -updateDeclCafInfos :: [IfaceDecl] -> Maybe NameSet -> [IfaceDecl] -updateDeclCafInfos decls Nothing = decls -updateDeclCafInfos decls (Just non_cafs) = map update_decl decls +updateDecl :: [IfaceDecl] -> Maybe (NameSet, ModuleLFInfos) -> [IfaceDecl] +updateDecl decls Nothing = decls +updateDecl decls (Just (non_cafs, lf_infos)) = map update_decl decls where + update_decl (IfaceId nm ty details infos) + | let not_caffy = elemNameSet nm non_cafs + , let mb_lf_info = lookupNameEnv lf_infos nm + , WARN( isNothing mb_lf_info, text "Name without LFInfo:" <+> ppr nm ) True + -- Only allocate a new IfaceId if we're going to update the infos + , isJust mb_lf_info || not_caffy + = IfaceId nm ty details $ + (if not_caffy then (HsNoCafRefs :) else id) + (case mb_lf_info of + Nothing -> infos + Just lf_info -> HsLFInfo (toIfaceLFInfo lf_info) : infos) + update_decl decl - | IfaceId nm ty details infos <- decl - , elemNameSet nm non_cafs - = IfaceId nm ty details (HsNoCafRefs : infos) - | otherwise = decl -- | Make an interface from the results of typechecking only. Useful ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -22,6 +22,8 @@ module GHC.Iface.Syntax ( IfaceAxBranch(..), IfaceTyConParent(..), IfaceCompleteMatch(..), + IfaceLFInfo(..), + IfaceStandardFormInfo(..), -- * Binding names IfaceTopBndr, @@ -30,6 +32,7 @@ module GHC.Iface.Syntax ( -- Misc ifaceDeclImplicitBndrs, visibleIfConDecls, ifaceDeclFingerprints, + tcStandardFormInfo, -- Free Names freeNamesIfDecl, freeNamesIfRule, freeNamesIfFamInst, @@ -72,10 +75,13 @@ import GHC.Core.DataCon (SrcStrictness(..), SrcUnpackedness(..)) import Lexeme (isLexSym) import TysWiredIn ( constraintKindTyConName ) import Util (seqList) +import GHC.StgToCmm.Types import Control.Monad import System.IO.Unsafe import Control.DeepSeq +import Data.Word +import Data.Bits infixl 3 &&& @@ -114,7 +120,8 @@ data IfaceDecl = IfaceId { ifName :: IfaceTopBndr, ifType :: IfaceType, ifIdDetails :: IfaceIdDetails, - ifIdInfo :: IfaceIdInfo } + ifIdInfo :: IfaceIdInfo + } | IfaceData { ifName :: IfaceTopBndr, -- Type constructor ifBinders :: [IfaceTyConBinder], @@ -348,6 +355,7 @@ data IfaceInfoItem IfaceUnfolding -- See Note [Expose recursive functions] | HsNoCafRefs | HsLevity -- Present <=> never levity polymorphic + | HsLFInfo IfaceLFInfo -- NB: Specialisations and rules come in separately and are -- only later attached to the Id. Partial reason: some are orphans. @@ -379,6 +387,71 @@ data IfaceIdDetails | IfRecSelId (Either IfaceTyCon IfaceDecl) Bool | IfDFunId +-- Lambda form info +data IfaceLFInfo + = IfLFReEntrant !IfaceOneShot !RepArity !Bool + | IfLFThunk !Bool !Bool !IfaceStandardFormInfo !Bool + | IfLFCon -- A saturated constructor application + !Name -- The constructor Name + | IfLFUnknown !Bool + | IfLFUnlifted + +tcStandardFormInfo :: IfaceStandardFormInfo -> StandardFormInfo +tcStandardFormInfo (IfStandardFormInfo w) + | testBit w 0 = NonStandardThunk + | otherwise = con field + where + field = fromIntegral (w `unsafeShiftR` 2) + con + | testBit w 1 = ApThunk + | otherwise = SelectorThunk + +instance Outputable IfaceLFInfo where + ppr (IfLFReEntrant oneshot rep fvs_flag) = + text "LFReEntrant" <+> ppr (oneshot, rep, fvs_flag) + ppr (IfLFThunk fvs_flag upd_flag sfi fun_flag) = + text "LFThunk" <+> ppr (fvs_flag, upd_flag, fun_flag) <+> ppr (tcStandardFormInfo sfi) + ppr (IfLFCon con) = text "LFCon" <> brackets (ppr con) + ppr IfLFUnlifted = text "LFUnlifted" + ppr (IfLFUnknown fun_flag) = text "LFUnknown" <+> ppr fun_flag + +newtype IfaceStandardFormInfo = IfStandardFormInfo Word16 + +instance Binary IfaceStandardFormInfo where + put_ bh (IfStandardFormInfo w) = put_ bh (w :: Word16) + get bh = IfStandardFormInfo <$> (get bh :: IO Word16) + +instance Binary IfaceLFInfo where + -- TODO: We could pack the bytes somewhat + put_ bh (IfLFReEntrant oneshot rep fvs_flag) = do + putByte bh 0 + put_ bh oneshot + put_ bh rep + put_ bh fvs_flag + put_ bh (IfLFThunk top_lvl no_fvs std_form maybe_fun) = do + putByte bh 1 + put_ bh top_lvl + put_ bh no_fvs + put_ bh std_form + put_ bh maybe_fun + put_ bh (IfLFCon con_name) = do + putByte bh 2 + put_ bh con_name + put_ bh (IfLFUnknown fun_flag) = do + putByte bh 3 + put_ bh fun_flag + put_ bh IfLFUnlifted = + putByte bh 4 + get bh = do + tag <- getByte bh + case tag of + 0 -> IfLFReEntrant <$> get bh <*> get bh <*> get bh + 1 -> IfLFThunk <$> get bh <*> get bh <*> get bh <*> get bh + 2 -> IfLFCon <$> get bh + 3 -> IfLFUnknown <$> get bh + 4 -> pure IfLFUnlifted + _ -> panic "Invalid byte" + {- Note [Versioning of instances] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1393,6 +1466,7 @@ instance Outputable IfaceInfoItem where ppr (HsCpr cpr) = text "CPR:" <+> ppr cpr ppr HsNoCafRefs = text "HasNoCafRefs" ppr HsLevity = text "Never levity-polymorphic" + ppr (HsLFInfo lf_info) = text "LambdaFormInfo:" <+> ppr lf_info instance Outputable IfaceJoinInfo where ppr IfaceNotJoinPoint = empty @@ -1853,7 +1927,7 @@ instance Binary IfaceDecl where get bh = do h <- getByte bh case h of - 0 -> do name <- get bh + 0 -> do name <- get bh ~(ty, details, idinfo) <- lazyGet bh -- See Note [Lazy deserialization of IfaceId] return (IfaceId name ty details idinfo) @@ -2153,6 +2227,8 @@ instance Binary IfaceInfoItem where put_ bh HsNoCafRefs = putByte bh 4 put_ bh HsLevity = putByte bh 5 put_ bh (HsCpr cpr) = putByte bh 6 >> put_ bh cpr + put_ bh (HsLFInfo lf_info) = putByte bh 7 >> put_ bh lf_info + get bh = do h <- getByte bh case h of @@ -2164,7 +2240,8 @@ instance Binary IfaceInfoItem where 3 -> liftM HsInline $ get bh 4 -> return HsNoCafRefs 5 -> return HsLevity - _ -> HsCpr <$> get bh + 6 -> HsCpr <$> get bh + _ -> HsLFInfo <$> get bh instance Binary IfaceUnfolding where put_ bh (IfCoreUnfold s e) = do @@ -2495,6 +2572,7 @@ instance NFData IfaceInfoItem where HsNoCafRefs -> () HsLevity -> () HsCpr cpr -> cpr `seq` () + HsLFInfo lf_info -> lf_info `seq` () -- TODO: seq further? instance NFData IfaceUnfolding where rnf = \case ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -122,6 +122,9 @@ data IfaceOneShot -- See Note [Preserve OneShotInfo] in CoreTicy = IfaceNoOneShot -- and Note [The oneShot function] in MkId | IfaceOneShot +instance Outputable IfaceOneShot where + ppr IfaceNoOneShot = text "NoOneShotInfo" + ppr IfaceOneShot = text "OneShot" {- %************************************************************************ ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -19,7 +19,8 @@ module GHC.IfaceToCore ( tcIfaceDecl, tcIfaceInst, tcIfaceFamInst, tcIfaceRules, tcIfaceAnnotations, tcIfaceCompleteSigs, tcIfaceExpr, -- Desired by HERMIT (#7683) - tcIfaceGlobal + tcIfaceGlobal, + tcIfaceOneShot ) where #include "HsVersions.h" @@ -30,6 +31,9 @@ import TcTypeNats(typeNatCoAxiomRules) import GHC.Iface.Syntax import GHC.Iface.Load import GHC.Iface.Env +import GHC.StgToCmm.Types +import GHC.StgToCmm.Closure +import GHC.Types.RepType import BuildTyCl import TcRnMonad import TcType @@ -641,7 +645,7 @@ tc_iface_decl _ ignore_prags (IfaceId {ifName = name, ifType = iface_type, = do { ty <- tcIfaceType iface_type ; details <- tcIdDetails ty details ; info <- tcIdInfo ignore_prags TopLevel name ty info - ; return (AnId (mkGlobalId details name ty info)) } + ; return (AnId (addIdLFInfo (mkGlobalId details name ty info))) } tc_iface_decl _ _ (IfaceData {ifName = tc_name, ifCType = cType, @@ -1340,7 +1344,8 @@ tcIfaceExpr (IfaceLet (IfaceNonRec (IfLetBndr fs ty info ji) rhs) body) ; ty' <- tcIfaceType ty ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -} NotTopLevel name ty' info - ; let id = mkLocalIdWithInfo name ty' id_info + ; let id = addIdLFInfo $ + mkLocalIdWithInfo name ty' id_info `asJoinId_maybe` tcJoinInfo ji ; rhs' <- tcIfaceExpr rhs ; body' <- extendIfaceIdEnv [id] (tcIfaceExpr body) @@ -1361,7 +1366,7 @@ tcIfaceExpr (IfaceLet (IfaceRec pairs) body) = do { rhs' <- tcIfaceExpr rhs ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -} NotTopLevel (idName id) (idType id) info - ; return (setIdInfo id id_info, rhs') } + ; return (addIdLFInfo (setIdInfo id id_info), rhs') } tcIfaceExpr (IfaceTick tickish expr) = do expr' <- tcIfaceExpr expr @@ -1465,8 +1470,7 @@ tcIdInfo ignore_prags toplvl name ty info = do let init_info | if_boot lcl_env = vanillaIdInfo `setUnfoldingInfo` BootUnfolding | otherwise = vanillaIdInfo - let needed = needed_prags info - foldlM tcPrag init_info needed + foldlM tcPrag init_info (needed_prags info) where needed_prags :: [IfaceInfoItem] -> [IfaceInfoItem] needed_prags items @@ -1486,6 +1490,9 @@ tcIdInfo ignore_prags toplvl name ty info = do tcPrag info (HsCpr cpr) = return (info `setCprInfo` cpr) tcPrag info (HsInline prag) = return (info `setInlinePragInfo` prag) tcPrag info HsLevity = return (info `setNeverLevPoly` ty) + tcPrag info (HsLFInfo lf_info) = do + lf_info <- tcLFInfo lf_info + return (info `setLFInfo` lf_info) -- The next two are lazy, so they don't transitively suck stuff in tcPrag info (HsUnfold lb if_unf) @@ -1494,10 +1501,51 @@ tcIdInfo ignore_prags toplvl name ty info = do | otherwise = info ; return (info1 `setUnfoldingInfo` unf) } +addIdLFInfo :: Id -> Id +addIdLFInfo id = case idLFInfo_maybe id of + Nothing -> setIdLFInfo id (mkLFImported (idDetails id) (idInfo id) (idType id)) + Just _ -> id + +-- Make a LambdaFormInfo for the Ids without a LFInfo in the iface file +mkLFImported :: IdDetails -> IdInfo -> Type -> LambdaFormInfo +mkLFImported details info ty + | DataConWorkId con <- details + , isNullaryRepDataCon con + = LFCon con -- An imported nullary constructor + -- We assume that the constructor is evaluated so that + -- the id really does point directly to the constructor + + | arity > 0 + = LFReEntrant TopLevel noOneShotInfo arity True ArgUnknown + + | isUnliftedType ty + = LFUnlifted + + | mightBeAFunction ty + = LFUnknown True + + | otherwise + = LFUnknown False + where + arity = countFunRepArgs (arityInfo info) ty + tcJoinInfo :: IfaceJoinInfo -> Maybe JoinArity tcJoinInfo (IfaceJoinPoint ar) = Just ar tcJoinInfo IfaceNotJoinPoint = Nothing +tcLFInfo :: IfaceLFInfo -> IfL LambdaFormInfo +tcLFInfo (IfLFReEntrant oneshot rep fvs_flag) = + return (LFReEntrant TopLevel (tcIfaceOneShot oneshot) rep fvs_flag ArgUnknown) + +tcLFInfo (IfLFThunk fvs_flag upd_flag sfi fun_flag ) = do + return (LFThunk TopLevel fvs_flag upd_flag (tcStandardFormInfo sfi) fun_flag) + +tcLFInfo IfLFUnlifted = return LFUnlifted + +tcLFInfo (IfLFCon con_name) = LFCon <$!> tcIfaceDataCon con_name + +tcLFInfo (IfLFUnknown fun_flag) = return (LFUnknown fun_flag) + tcUnfolding :: TopLevelFlag -> Name -> Type -> IdInfo -> IfaceUnfolding -> IfL Unfolding tcUnfolding toplvl name _ info (IfCoreUnfold stable if_expr) = do { dflags <- getDynFlags @@ -1586,6 +1634,10 @@ tcPragExpr is_compulsory toplvl name expr -- It's OK to use nonDetEltsUFM here because we immediately forget -- the ordering by creating a set +tcIfaceOneShot :: IfaceOneShot -> OneShotInfo +tcIfaceOneShot IfaceNoOneShot = NoOneShotInfo +tcIfaceOneShot IfaceOneShot = OneShotLam + {- ************************************************************************ * * ===================================== compiler/GHC/Runtime/Heap/Layout.hs ===================================== @@ -51,6 +51,7 @@ import GHC.Driver.Session import Outputable import GHC.Platform import FastString +import GHC.StgToCmm.Types import Data.Word import Data.Bits @@ -64,9 +65,6 @@ import Data.ByteString (ByteString) ************************************************************************ -} --- | Word offset, or word count -type WordOff = Int - -- | Byte offset, or byte count type ByteOff = Int @@ -196,29 +194,6 @@ type ConstrDescription = ByteString -- result of dataConIdentity type FunArity = Int type SelectorOffset = Int -------------------------- --- We represent liveness bitmaps as a Bitmap (whose internal --- representation really is a bitmap). These are pinned onto case return --- vectors to indicate the state of the stack for the garbage collector. --- --- In the compiled program, liveness bitmaps that fit inside a single --- word (StgWord) are stored as a single word, while larger bitmaps are --- stored as a pointer to an array of words. - -type Liveness = [Bool] -- One Bool per word; True <=> non-ptr or dead - -- False <=> ptr - -------------------------- --- An ArgDescr describes the argument pattern of a function - -data ArgDescr - = ArgSpec -- Fits one of the standard patterns - !Int -- RTS type identifier ARG_P, ARG_N, ... - - | ArgGen -- General case - Liveness -- Details about the arguments - - ----------------------------------------------------------------------------- -- Construction @@ -540,10 +515,6 @@ instance Outputable SMRep where ppr (RTSRep ty rep) = text "tag:" <> ppr ty <+> ppr rep -instance Outputable ArgDescr where - ppr (ArgSpec n) = text "ArgSpec" <+> ppr n - ppr (ArgGen ls) = text "ArgGen" <+> ppr ls - pprTypeInfo :: ClosureTypeInfo -> SDoc pprTypeInfo (Constr tag descr) = text "Con" <+> ===================================== compiler/GHC/StgToCmm.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} +{-# LANGUAGE BangPatterns #-} ----------------------------------------------------------------------------- -- @@ -25,6 +26,7 @@ import GHC.StgToCmm.Utils import GHC.StgToCmm.Closure import GHC.StgToCmm.Hpc import GHC.StgToCmm.Ticky +import GHC.StgToCmm.Types (ModuleLFInfos) import GHC.Cmm import GHC.Cmm.CLabel @@ -45,6 +47,8 @@ import Outputable import Stream import BasicTypes import VarSet ( isEmptyDVarSet ) +import UniqFM +import NameEnv import OrdList import GHC.Cmm.Graph @@ -52,6 +56,7 @@ import GHC.Cmm.Graph import Data.IORef import Control.Monad (when,void) import Util +import Data.Maybe codeGen :: DynFlags -> Module @@ -59,7 +64,8 @@ codeGen :: DynFlags -> CollectedCCs -- (Local/global) cost-centres needing declaring/registering. -> [CgStgTopBinding] -- Bindings to convert -> HpcInfo - -> Stream IO CmmGroup () -- Output as a stream, so codegen can + -> Stream IO CmmGroup ModuleLFInfos + -- Output as a stream, so codegen can -- be interleaved with output codeGen dflags this_mod data_tycons @@ -101,6 +107,20 @@ codeGen dflags this_mod data_tycons mapM_ (cg . cgDataCon) (tyConDataCons tycon) ; mapM_ do_tycon data_tycons + + ; cg_id_infos <- cgs_binds <$> liftIO (readIORef cgref) + + -- Only external names are actually visible to codeGen. So they are the + -- only ones we care about. + ; let extractInfo info = lf `seq` Just (name,lf) + where + id = cg_id info + !name = idName id + lf = cg_lf info + + ; let !generatedInfo = mkNameEnv (mapMaybe extractInfo (eltsUFM cg_id_infos)) + + ; return $! generatedInfo } --------------------------------------------------------------- ===================================== compiler/GHC/StgToCmm/Closure.hs ===================================== @@ -24,7 +24,7 @@ module GHC.StgToCmm.Closure ( LambdaFormInfo, -- Abstract StandardFormInfo, -- ...ditto... mkLFThunk, mkLFReEntrant, mkConLFInfo, mkSelectorLFInfo, - mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape, + mkApLFInfo, mkLFArgument, mkLFLetNoEscape, mkLFStringLit, lfDynTag, isLFThunk, isLFReEntrant, lfUpdatable, @@ -51,6 +51,7 @@ module GHC.StgToCmm.Closure ( closureUpdReqd, closureSingleEntry, closureReEntrant, closureFunInfo, isToplevClosure, + mightBeAFunction, blackHoleOnEntry, -- Needs LambdaFormInfo and SMRep isStaticClosure, -- Needs SMPre @@ -70,6 +71,7 @@ import GHC.Stg.Syntax import GHC.Runtime.Heap.Layout import GHC.Cmm import GHC.Cmm.Ppr.Expr() -- For Outputable instances +import GHC.StgToCmm.Types import CostCentre import GHC.Cmm.BlockId @@ -188,86 +190,15 @@ addArgReps = map (\arg -> let arg' = fromNonVoid arg argPrimRep :: StgArg -> PrimRep argPrimRep arg = typePrimRep1 (stgArgType arg) - ------------------------------------------------------------------------------ --- LambdaFormInfo ------------------------------------------------------------------------------ - --- Information about an identifier, from the code generator's point of --- view. Every identifier is bound to a LambdaFormInfo in the --- environment, which gives the code generator enough info to be able to --- tail call or return that identifier. - -data LambdaFormInfo - = LFReEntrant -- Reentrant closure (a function) - TopLevelFlag -- True if top level - OneShotInfo - !RepArity -- Arity. Invariant: always > 0 - !Bool -- True <=> no fvs - ArgDescr -- Argument descriptor (should really be in ClosureInfo) - - | LFThunk -- Thunk (zero arity) - TopLevelFlag - !Bool -- True <=> no free vars - !Bool -- True <=> updatable (i.e., *not* single-entry) - StandardFormInfo - !Bool -- True <=> *might* be a function type - - | LFCon -- A saturated constructor application - DataCon -- The constructor - - | LFUnknown -- Used for function arguments and imported things. - -- We know nothing about this closure. - -- Treat like updatable "LFThunk"... - -- Imported things which we *do* know something about use - -- one of the other LF constructors (eg LFReEntrant for - -- known functions) - !Bool -- True <=> *might* be a function type - -- The False case is good when we want to enter it, - -- because then we know the entry code will do - -- For a function, the entry code is the fast entry point - - | LFUnlifted -- A value of unboxed type; - -- always a value, needs evaluation - - | LFLetNoEscape -- See LetNoEscape module for precise description - - -------------------------- --- StandardFormInfo tells whether this thunk has one of --- a small number of standard forms - -data StandardFormInfo - = NonStandardThunk - -- The usual case: not of the standard forms - - | SelectorThunk - -- A SelectorThunk is of form - -- case x of - -- con a1,..,an -> ak - -- and the constructor is from a single-constr type. - WordOff -- 0-origin offset of ak within the "goods" of - -- constructor (Recall that the a1,...,an may be laid - -- out in the heap in a non-obvious order.) - - | ApThunk - -- An ApThunk is of form - -- x1 ... xn - -- The code for the thunk just pushes x2..xn on the stack and enters x1. - -- There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled - -- in the RTS to save space. - RepArity -- Arity, n - - ------------------------------------------------------ -- Building LambdaFormInfo ------------------------------------------------------ mkLFArgument :: Id -> LambdaFormInfo mkLFArgument id - | isUnliftedType ty = LFUnlifted - | might_be_a_function ty = LFUnknown True - | otherwise = LFUnknown False + | isUnliftedType ty = LFUnlifted + | mightBeAFunction ty = LFUnknown True + | otherwise = LFUnknown False where ty = idType id @@ -295,13 +226,13 @@ mkLFThunk thunk_ty top fvs upd_flag LFThunk top (null fvs) (isUpdatable upd_flag) NonStandardThunk - (might_be_a_function thunk_ty) + (mightBeAFunction thunk_ty) -------------- -might_be_a_function :: Type -> Bool +mightBeAFunction :: Type -> Bool -- Return False only if we are *sure* it's a data type -- Look through newtypes etc as much as poss -might_be_a_function ty +mightBeAFunction ty | [LiftedRep] <- typePrimRep ty , Just tc <- tyConAppTyCon_maybe (unwrapType ty) , isDataTyCon tc @@ -317,30 +248,13 @@ mkConLFInfo con = LFCon con mkSelectorLFInfo :: Id -> Int -> Bool -> LambdaFormInfo mkSelectorLFInfo id offset updatable = LFThunk NotTopLevel False updatable (SelectorThunk offset) - (might_be_a_function (idType id)) + (mightBeAFunction (idType id)) ------------- mkApLFInfo :: Id -> UpdateFlag -> Arity -> LambdaFormInfo mkApLFInfo id upd_flag arity = LFThunk NotTopLevel (arity == 0) (isUpdatable upd_flag) (ApThunk arity) - (might_be_a_function (idType id)) - -------------- -mkLFImported :: Id -> LambdaFormInfo -mkLFImported id - | Just con <- isDataConWorkId_maybe id - , isNullaryRepDataCon con - = LFCon con -- An imported nullary constructor - -- We assume that the constructor is evaluated so that - -- the id really does point directly to the constructor - - | arity > 0 - = LFReEntrant TopLevel noOneShotInfo arity True (panic "arg_descr") - - | otherwise - = mkLFArgument id -- Not sure of exact arity - where - arity = idFunRepArity id + (mightBeAFunction (idType id)) ------------- mkLFStringLit :: LambdaFormInfo ===================================== compiler/GHC/StgToCmm/Env.hs ===================================== @@ -30,6 +30,7 @@ import GHC.Core.TyCon import GHC.StgToCmm.Monad import GHC.StgToCmm.Utils import GHC.StgToCmm.Closure +import GHC.StgToCmm.Types import GHC.Cmm.CLabel @@ -47,6 +48,8 @@ import TysPrim import UniqFM import Util import VarEnv +import GHC.Core.DataCon +import BasicTypes ------------------------------------- -- Manipulating CgIdInfo @@ -143,6 +146,26 @@ getCgIdInfo id cgLookupPanic id -- Bug }}} +mkLFImported :: Id -> LambdaFormInfo +mkLFImported id = + case idLFInfo_maybe id of + Just lf_info -> + lf_info + Nothing + | Just con <- isDataConWorkId_maybe id + , isNullaryRepDataCon con + -> LFCon con -- An imported nullary constructor + -- We assume that the constructor is evaluated so that + -- the id really does point directly to the constructor + + | arity > 0 + -> LFReEntrant TopLevel noOneShotInfo arity True (panic "arg_descr") + + | otherwise + -> mkLFArgument id -- Not sure of exact arity + where + arity = idFunRepArity id + cgLookupPanic :: Id -> FCode a cgLookupPanic id = do local_binds <- getBinds ===================================== compiler/GHC/StgToCmm/Types.hs ===================================== @@ -0,0 +1,157 @@ +{-# LANGUAGE CPP #-} + +module GHC.StgToCmm.Types + ( WordOff + , LambdaFormInfo (..) + , ModuleLFInfos + , Liveness + , ArgDescr (..) + , StandardFormInfo (..) + ) where + +#include "HsVersions.h" + +import GhcPrelude + +import BasicTypes +import GHC.Core.DataCon +import NameEnv +import Outputable + +-- | Word offset, or word count +type WordOff = Int + +-------------------------------------------------------------------------------- +-- LambdaFormInfo +-------------------------------------------------------------------------------- + +-- | Maps names in the current module to their LambdaFormInfos +type ModuleLFInfos = NameEnv LambdaFormInfo + +-- Information about an identifier, from the code generator's point of view. +-- Every identifier is bound to a LambdaFormInfo in the environment, which gives +-- the code generator enough info to be able to tail call or return that +-- identifier. + +data LambdaFormInfo + = LFReEntrant -- Reentrant closure (a function) + TopLevelFlag -- True if top level + OneShotInfo + !RepArity -- Arity. Invariant: always > 0 + !Bool -- True <=> no fvs + ArgDescr -- Argument descriptor (should really be in ClosureInfo) + + | LFThunk -- Thunk (zero arity) + TopLevelFlag + !Bool -- True <=> no free vars + !Bool -- True <=> updatable (i.e., *not* single-entry) + StandardFormInfo + !Bool -- True <=> *might* be a function type + + | LFCon -- A saturated constructor application + DataCon -- The constructor + + | LFUnknown -- Used for function arguments and imported things. + -- We know nothing about this closure. + -- Treat like updatable "LFThunk"... + -- Imported things which we *do* know something about use + -- one of the other LF constructors (eg LFReEntrant for + -- known functions) + !Bool -- True <=> *might* be a function type + -- The False case is good when we want to enter it, + -- because then we know the entry code will do + -- For a function, the entry code is the fast entry point + + | LFUnlifted -- A value of unboxed type; + -- always a value, needs evaluation + + | LFLetNoEscape -- See LetNoEscape module for precise description + +instance Outputable LambdaFormInfo where + ppr (LFReEntrant top oneshot rep fvs argdesc) = + text "LFReEntrant" <> brackets (ppr top <+> ppr oneshot <+> + ppr rep <+> pprFvs fvs <+> ppr argdesc) + ppr (LFThunk top hasfv updateable sfi m_function) = + text "LFThunk" <> brackets (ppr top <+> pprFvs hasfv <+> pprUpdateable updateable <+> + ppr sfi <+> pprFuncFlag m_function) + ppr (LFCon con) = text "LFCon" <> brackets (ppr con) + ppr (LFUnknown m_func) = + text "LFUnknown" <> brackets (pprFuncFlag m_func) + ppr LFUnlifted = text "LFUnlifted" + ppr LFLetNoEscape = text "LFLetNoEscape" + +pprFvs :: Bool -> SDoc +pprFvs True = text "no-fvs" +pprFvs False = text "fvs" + +pprFuncFlag :: Bool -> SDoc +pprFuncFlag True = text "mFunc" +pprFuncFlag False = text "value" + +pprUpdateable :: Bool -> SDoc +pprUpdateable True = text "updateable" +pprUpdateable False = text "oneshot" + +-------------------------------------------------------------------------------- + +-- | We represent liveness bitmaps as a Bitmap (whose internal representation +-- really is a bitmap). These are pinned onto case return vectors to indicate +-- the state of the stack for the garbage collector. +-- +-- In the compiled program, liveness bitmaps that fit inside a single word +-- (StgWord) are stored as a single word, while larger bitmaps are stored as a +-- pointer to an array of words. + +type Liveness = [Bool] -- One Bool per word; True <=> non-ptr or dead + -- False <=> ptr + +-------------------------------------------------------------------------------- +-- | An ArgDescr describes the argument pattern of a function + +data ArgDescr + = ArgSpec -- Fits one of the standard patterns + !Int -- RTS type identifier ARG_P, ARG_N, ... + + | ArgGen -- General case + Liveness -- Details about the arguments + + | ArgUnknown -- For imported binds. + -- Invariant: Never Unknown for binds of the module + -- we are compiling. + deriving (Eq) + +instance Outputable ArgDescr where + ppr (ArgSpec n) = text "ArgSpec" <+> ppr n + ppr (ArgGen ls) = text "ArgGen" <+> ppr ls + ppr ArgUnknown = text "ArgUnknown" + +-------------------------------------------------------------------------------- +-- | StandardFormInfo tells whether this thunk has one of a small number of +-- standard forms + +data StandardFormInfo + = NonStandardThunk + -- The usual case: not of the standard forms + + | SelectorThunk + -- A SelectorThunk is of form + -- case x of + -- con a1,..,an -> ak + -- and the constructor is from a single-constr type. + WordOff -- 0-origin offset of ak within the "goods" of + -- constructor (Recall that the a1,...,an may be laid + -- out in the heap in a non-obvious order.) + + | ApThunk + -- An ApThunk is of form + -- x1 ... xn + -- The code for the thunk just pushes x2..xn on the stack and enters x1. + -- There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled + -- in the RTS to save space. + RepArity -- Arity, n + deriving (Eq) + +instance Outputable StandardFormInfo where + ppr NonStandardThunk = text "RegThunk" + ppr (SelectorThunk w) = text "SelThunk:" <> ppr w + ppr (ApThunk n) = text "ApThunk:" <> ppr n ===================================== compiler/basicTypes/Id.hs ===================================== @@ -92,7 +92,7 @@ module Id ( idCallArity, idFunRepArity, idUnfolding, realIdUnfolding, idSpecialisation, idCoreRules, idHasRules, - idCafInfo, + idCafInfo, idLFInfo, idLFInfo_maybe, idOneShotInfo, idStateHackOneShotInfo, idOccInfo, isNeverLevPolyId, @@ -105,6 +105,7 @@ module Id ( setIdSpecialisation, setIdCafInfo, setIdOccInfo, zapIdOccInfo, + setIdLFInfo, setIdDemandInfo, setIdStrictness, @@ -731,6 +732,19 @@ idCafInfo id = cafInfo (idInfo id) setIdCafInfo :: Id -> CafInfo -> Id setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id + --------------------------------- + -- Lambda form info +idLFInfo :: HasCallStack => Id -> LambdaFormInfo +idLFInfo id = case lfInfo (idInfo id) of + Nothing -> pprPanic "idLFInfo" (text "LFInfo not available for Id" <+> ppr id) + Just lf_info -> lf_info + +idLFInfo_maybe :: Id -> Maybe LambdaFormInfo +idLFInfo_maybe = lfInfo . idInfo + +setIdLFInfo :: Id -> LambdaFormInfo -> Id +setIdLFInfo id lf = modifyIdInfo (`setLFInfo` lf) id + --------------------------------- -- Occurrence INFO idOccInfo :: Id -> OccInfo ===================================== compiler/basicTypes/IdInfo.hs ===================================== @@ -74,6 +74,10 @@ module IdInfo ( ppCafInfo, mayHaveCafRefs, cafInfo, setCafInfo, + -- ** The LambdaFormInfo type + LambdaFormInfo(..), + lfInfo, setLFInfo, + -- ** Tick-box Info TickBoxOp(..), TickBoxId, @@ -104,6 +108,8 @@ import Demand import Cpr import Util +import GHC.StgToCmm.Types (LambdaFormInfo (..)) + -- infixl so you can say (id `set` a `set` b) infixl 1 `setRuleInfo`, `setArityInfo`, @@ -270,8 +276,9 @@ data IdInfo -- ^ 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 + levityInfo :: LevityInfo, -- ^ when applied, will this Id ever have a levity-polymorphic type? + lfInfo :: !(Maybe LambdaFormInfo) } -- Setters @@ -294,13 +301,18 @@ setUnfoldingInfo info uf setArityInfo :: IdInfo -> ArityInfo -> IdInfo setArityInfo info ar = info { arityInfo = ar } + setCallArityInfo :: IdInfo -> ArityInfo -> IdInfo setCallArityInfo info ar = info { callArityInfo = ar } + setCafInfo :: IdInfo -> CafInfo -> IdInfo -setCafInfo info caf = info { cafInfo = caf } +setCafInfo info caf = info { cafInfo = caf } + +setLFInfo :: IdInfo -> LambdaFormInfo -> IdInfo +setLFInfo info lf = info { lfInfo = Just lf } setOneShotInfo :: IdInfo -> OneShotInfo -> IdInfo -setOneShotInfo info lb = {-lb `seq`-} info { oneShotInfo = lb } +setOneShotInfo info lb = {-lb `seq`-} info { oneShotInfo = lb } setDemandInfo :: IdInfo -> Demand -> IdInfo setDemandInfo info dd = dd `seq` info { demandInfo = dd } @@ -326,7 +338,8 @@ vanillaIdInfo strictnessInfo = nopSig, cprInfo = topCprSig, callArityInfo = unknownArity, - levityInfo = NoLevityInfo + levityInfo = NoLevityInfo, + lfInfo = Nothing } -- | More informative 'IdInfo' we can use when we know the 'Id' has no CAF references ===================================== compiler/ghc.cabal.in ===================================== @@ -298,6 +298,7 @@ Library GHC.StgToCmm.Ticky GHC.StgToCmm.Utils GHC.StgToCmm.ExtCode + GHC.StgToCmm.Types GHC.Runtime.Heap.Layout GHC.Core.Arity GHC.Core.FVs ===================================== compiler/main/UpdateCafInfos.hs ===================================== @@ -17,6 +17,7 @@ import NameSet import Util import Var import Outputable +import GHC.StgToCmm.Types (ModuleLFInfos) #include "HsVersions.h" @@ -24,14 +25,15 @@ import Outputable updateModDetailsCafInfos :: DynFlags -> NameSet -- ^ Non-CAFFY names in the module. Names not in this set are CAFFY. + -> ModuleLFInfos -> ModDetails -- ^ ModDetails to update -> ModDetails -updateModDetailsCafInfos dflags _ mod_details +updateModDetailsCafInfos dflags _ _ mod_details | gopt Opt_OmitInterfacePragmas dflags = mod_details -updateModDetailsCafInfos _ non_cafs mod_details = +updateModDetailsCafInfos _ non_cafs lf_infos mod_details = {- pprTrace "updateModDetailsCafInfos" (text "non_cafs:" <+> ppr non_cafs) $ -} let ModDetails{ md_types = type_env -- for unfoldings @@ -40,10 +42,10 @@ updateModDetailsCafInfos _ non_cafs mod_details = } = mod_details -- type TypeEnv = NameEnv TyThing - ~type_env' = mapNameEnv (updateTyThingCafInfos type_env' non_cafs) type_env + ~type_env' = mapNameEnv (updateTyThingCafInfos type_env' non_cafs lf_infos) type_env -- Not strict! - !insts' = strictMap (updateInstCafInfos type_env' non_cafs) insts + !insts' = strictMap (updateInstCafInfos type_env' non_cafs lf_infos) insts !rules' = strictMap (updateRuleCafInfos type_env') rules in mod_details{ md_types = type_env' @@ -63,20 +65,20 @@ updateRuleCafInfos type_env Rule{ .. } = Rule { ru_rhs = updateGlobalIds type_en -- Instances -------------------------------------------------------------------------------- -updateInstCafInfos :: TypeEnv -> NameSet -> ClsInst -> ClsInst -updateInstCafInfos type_env non_cafs = - updateClsInstDFun (updateIdUnfolding type_env . updateIdCafInfo non_cafs) +updateInstCafInfos :: TypeEnv -> NameSet -> ModuleLFInfos -> ClsInst -> ClsInst +updateInstCafInfos type_env non_cafs lf_infos = + updateClsInstDFun (updateIdUnfolding type_env . updateIdCafInfo non_cafs lf_infos) -------------------------------------------------------------------------------- -- TyThings -------------------------------------------------------------------------------- -updateTyThingCafInfos :: TypeEnv -> NameSet -> TyThing -> TyThing +updateTyThingCafInfos :: TypeEnv -> NameSet -> ModuleLFInfos -> TyThing -> TyThing -updateTyThingCafInfos type_env non_cafs (AnId id) = - AnId (updateIdUnfolding type_env (updateIdCafInfo non_cafs id)) +updateTyThingCafInfos type_env non_cafs lf_infos (AnId id) = + AnId (updateIdUnfolding type_env (updateIdCafInfo non_cafs lf_infos id)) -updateTyThingCafInfos _ _ other = other -- AConLike, ATyCon, ACoAxiom +updateTyThingCafInfos _ _ _ other = other -- AConLike, ATyCon, ACoAxiom -------------------------------------------------------------------------------- -- Unfoldings @@ -95,13 +97,18 @@ updateIdUnfolding type_env id = -- Expressions -------------------------------------------------------------------------------- -updateIdCafInfo :: NameSet -> Id -> Id -updateIdCafInfo non_cafs id - | idName id `elemNameSet` non_cafs - = -- pprTrace "updateIdCafInfo" (text "Marking" <+> ppr id <+> parens (ppr (idName id)) <+> text "as non-CAFFY") $ - id `setIdCafInfo` NoCafRefs - | otherwise - = id +updateIdCafInfo :: NameSet -> ModuleLFInfos -> Id -> Id +updateIdCafInfo non_cafs lf_infos id = + let + not_caffy = elemNameSet (idName id) non_cafs + mb_lf_info = lookupNameEnv lf_infos (idName id) + + id1 = if not_caffy then setIdCafInfo id NoCafRefs else id + id2 = case mb_lf_info of + Nothing -> id1 + Just lf_info -> setIdLFInfo id1 lf_info + in + id2 -------------------------------------------------------------------------------- ===================================== testsuite/tests/codeGen/should_compile/Makefile ===================================== @@ -64,10 +64,10 @@ T17648: # NoCafRefs) to the interface files. '$(TEST_HC)' $(TEST_HC_OPTS) -dno-typeable-binds -O T17648.hs -v0 '$(TEST_HC)' --show-iface T17648.hi | tr -d '\n' | \ - grep -F 'f :: T GHC.Types.Int -> () [HasNoCafRefs, Arity' >/dev/null + grep -F 'f :: T GHC.Types.Int -> () [HasNoCafRefs, LambdaFormInfo' >/dev/null # Second compilation with -fcatch-bottoms, f should be CAFFY '$(TEST_HC)' $(TEST_HC_OPTS) -dno-typeable-binds -O \ -fcatch-bottoms T17648.hs -v0 -fforce-recomp '$(TEST_HC)' --show-iface T17648.hi | tr -d '\n' | \ - grep -F 'f :: T GHC.Types.Int -> () [Arity: 1, Strictness' >/dev/null + grep -F 'f :: T GHC.Types.Int -> () [LambdaFormInfo' >/dev/null ===================================== testsuite/tests/codeGen/should_compile/cg009/A.hs ===================================== @@ -0,0 +1,5 @@ +module A where + +newtype A = A Int + +val = A 42 ===================================== testsuite/tests/codeGen/should_compile/cg009/Main.hs ===================================== @@ -0,0 +1,7 @@ +module Main where + +import A + +main = return () + +a = val ===================================== testsuite/tests/codeGen/should_compile/cg009/Makefile ===================================== @@ -0,0 +1,9 @@ +TOP=../../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +# Make sure the LFInfo for an exported, but not directly used newtype +# constructors does not trip up the compiler. +cg009: + '$(TEST_HC)' $(TEST_HC_OPTS) -c -O A.hs -fforce-recomp + '$(TEST_HC)' $(TEST_HC_OPTS) -c -O0 Main.hs -fforce-recomp ===================================== testsuite/tests/codeGen/should_compile/cg009/all.T ===================================== @@ -0,0 +1 @@ +test('cg009', [extra_files(['A.hs','Main.hs'])], makefile_test, ['cg009']) ===================================== testsuite/tests/codeGen/should_compile/cg010/A.hs ===================================== @@ -0,0 +1,4 @@ +module A where + +{-# NOINLINE val #-} +val = Just 42 ===================================== testsuite/tests/codeGen/should_compile/cg010/Main.hs ===================================== @@ -0,0 +1,8 @@ +module Main where + +import A + +main = return () + +a = val + ===================================== testsuite/tests/codeGen/should_compile/cg010/Makefile ===================================== @@ -0,0 +1,9 @@ +TOP=../../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +# Make sure LFInfo causes the imported reference to val to get tagged. +cg010: + '$(TEST_HC)' $(TEST_HC_OPTS) -c -O A.hs -fforce-recomp + '$(TEST_HC)' $(TEST_HC_OPTS) -c -O Main.hs -fforce-recomp -ddump-cmm -ddump-to-file + grep "A.val_closure+2" Main.dump-cmm ===================================== testsuite/tests/codeGen/should_compile/cg010/all.T ===================================== @@ -0,0 +1 @@ +test('cg010', [extra_files(['A.hs','Main.hs'])], makefile_test, ['cg010']) ===================================== testsuite/tests/codeGen/should_compile/cg010/cg010.stdout ===================================== @@ -0,0 +1 @@ + const A.val_closure+2; ===================================== testsuite/tests/simplCore/should_compile/Makefile ===================================== @@ -102,7 +102,7 @@ T4201: '$(TEST_HC)' $(TEST_HC_OPTS) -c -O T4201.hs '$(TEST_HC)' $(TEST_HC_OPTS) --show-iface T4201.hi > T4201.list # poor man idea about how to replace GNU grep -B2 "Sym" invocation with pure POSIX tools - for i in `grep -n "Sym" T4201.list |cut -d ':' -f -1`; do head -$$i T4201.list | tail -3 ; done + for i in `grep -n "Sym" T4201.list | cut -d ':' -f -1`; do head -$$i T4201.list | tail -5; done $(RM) -f T4201.list # This one looped as a result of bogus specialisation ===================================== testsuite/tests/simplCore/should_compile/T4201.stdout ===================================== @@ -1,3 +1,5 @@ - [HasNoCafRefs, Arity: 1, Strictness: , CPR: m1, + [HasNoCafRefs, + LambdaFormInfo: LFReEntrant (NoOneShotInfo, 1, True), Arity: 1, + Strictness: , CPR: m1, Unfolding: InlineRule (0, True, True) bof `cast` (Sym (N:Foo[0]) ->_R _R)] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/99b0c93a180a623e3447073f52f92e7650349e89 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/99b0c93a180a623e3447073f52f92e7650349e89 You're receiving 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 Mar 19 14:31:23 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 19 Mar 2020 10:31:23 -0400 Subject: [Git][ghc/ghc][wip/fix-win32-tarball-path] get-win32-tarballs: Improve diagnostics output Message-ID: <5e73823bd25c7_488a3fc6ca423d3c2140954@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/fix-win32-tarball-path at Glasgow Haskell Compiler / GHC Commits: 01292151 by Ben Gamari at 2020-03-19T14:31:07Z get-win32-tarballs: Improve diagnostics output - - - - - 1 changed file: - mk/get-win32-tarballs.py Changes: ===================================== mk/get-win32-tarballs.py ===================================== @@ -5,6 +5,7 @@ from pathlib import Path import urllib.request import subprocess import argparse +from sys import stderr TARBALL_VERSION = '0.1' BASE_URL = "https://downloads.haskell.org/ghc/mingw/{}".format(TARBALL_VERSION) @@ -18,11 +19,13 @@ def file_url(arch: str, fname: str) -> str: fname=fname) def fetch(url: str, dest: Path): - print('Fetching', url, '=>', dest) + print('Fetching', url, '=>', dest, file=stderr) urllib.request.urlretrieve(url, dest) def fetch_arch(arch: str): - req = urllib.request.urlopen(file_url(arch, 'MANIFEST')) + manifest_url = file_url(arch, 'MANIFEST') + print('Fetching', manifest_url, file=stderr) + req = urllib.request.urlopen(manifest_url) files = req.read().decode('UTF-8').split('\n') d = DEST / arch if not d.is_dir(): @@ -35,6 +38,9 @@ def fetch_arch(arch: str): verify(arch) def verify(arch: str): + if not Path(DEST / arch / "SHA256SUMS").is_file(): + raise IOError("SHA256SUMS doesn't exist; have you fetched?") + cmd = ['sha256sum', '--quiet', '--check', '--ignore-missing', 'SHA256SUMS'] subprocess.check_call(cmd, cwd=DEST / arch) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/01292151c8305cd5a914bd73ca287ba34d3913f4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/01292151c8305cd5a914bd73ca287ba34d3913f4 You're receiving 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 Mar 21 00:45:02 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 20 Mar 2020 20:45:02 -0400 Subject: [Git][ghc/ghc][master] Fix event message in withTiming' Message-ID: <5e75638e199eb_488a3fc6f8fa0cb82416658@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 7e0451c6 by Sergej Jaskiewicz at 2020-03-21T00:44:55Z Fix event message in withTiming' This typo caused generating 'end' events without the corresponding 'begin' events. - - - - - 1 changed file: - compiler/main/ErrUtils.hs Changes: ===================================== compiler/main/ErrUtils.hs ===================================== @@ -764,7 +764,7 @@ withTiming' dflags what force_result prtimings action where whenPrintTimings = liftIO . when (prtimings == PrintTimings) eventBegins dflags w = do whenPrintTimings $ traceMarkerIO (eventBeginsDoc dflags w) - liftIO $ traceEventIO (eventEndsDoc dflags w) + liftIO $ traceEventIO (eventBeginsDoc dflags w) eventEnds dflags w = do whenPrintTimings $ traceMarkerIO (eventEndsDoc dflags w) liftIO $ traceEventIO (eventEndsDoc dflags w) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/7e0451c6ce78b08b5f7564aa03a9a86051b35163 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/7e0451c6ce78b08b5f7564aa03a9a86051b35163 You're receiving 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 Mar 19 18:55:52 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Thu, 19 Mar 2020 14:55:52 -0400 Subject: [Git][ghc/ghc][wip/T17676] Comments Message-ID: <5e73c03861ca4_488a3fc6a691ddac224881a@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T17676 at Glasgow Haskell Compiler / GHC Commits: 3d667c32 by Sebastian Graf at 2020-03-19T18:55:46Z Comments - - - - - 2 changed files: - compiler/GHC/Core/Utils.hs - compiler/basicTypes/Demand.hs Changes: ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -1111,7 +1111,7 @@ exprIsBottom e | otherwise = go 0 e where - go n (Var v) = isDeadEndId v && n >= idArity v + go n (Var v) = isDeadEndId v && n >= idArity v go n (App e a) | isTypeArg a = go n e | otherwise = go (n+1) e go n (Tick _ e) = go n e ===================================== compiler/basicTypes/Demand.hs ===================================== @@ -186,10 +186,25 @@ only used by `raiseIO#` in order to preserve precise exceptions by strictness analysis, while not impacting the ability to eliminate dead code. See Note [Precise exceptions and strictness analysis]. +Note [What are precise exceptions?] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +An exception is considered to be /precise/ when it is thrown by the 'raiseIO#' +primop. It follows that all other primops (such as 'raise#' or +division-by-zero) throw /imprecise/ exceptions. Note that the actual type of +the exception thrown doesn't have any impact! + +GHC undertakes some effort not to apply an optimisation that would mask a +/precise/ exception with some other source of divergence, such as genuine +non-termination or an imprecise exception, so that the user can reliably +intercept the precise exception with a catch handler before and after +optimisations. + +See the paper "A Semantics for Imprecise Exceptions" for more details. + Note [Precise exceptions and strictness analysis] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We have to take care to preserve precise exception semantics (#17676). -There are two scenarios that need careful hacks. +We have to take care to preserve precise exception semantics in strictness +analysis (#17676). There are two scenarios that need careful hacks. Scenario 1: Precise exceptions in case scrutinees ------------------------------------------------- @@ -211,9 +226,9 @@ So the 'y' isn't necessarily going to be evaluated. To detect this scenario, why we track precise exceptions in the Divergence lattice. Specifically, if 'foo' throws an exception, the Divergence in its -strictness signature will indicate so (ExnOrDiv or Dunno), in which case +strictness signature will indicate so ('exnDiv' or 'topDiv'), in which case 'Demand.deferAfterPreciseException' will lub with the strictness analysis -results of the virtual branch. +results of the virtual branch when @dmdAnal'@ysing the @Case at . A more complete example (#148, #1592) where this shows up is: do { let len = ; @@ -232,15 +247,29 @@ The motivating example for #13380 is the following: f x y | x>0 = raiseIO blah | y>0 = return 1 | otherwise = return 2 -If 'f' was inferred to be strict in 'y', WW would turn a precise into an -imprecise exception in the call site @f 1 (error "boom")@. - -The solution is to give 'raiseIO#' 'topDiv' instead of 'botDiv', so that its -'Demand.defaultFvDmd' is lazy. But then the simplifier fails to eliminate a lot -of dead code, namely when 'raiseIO#' occurs in a case scrutinee. Hence we need -to give it 'exnDiv', which was conceived entirely for this reason. The default -FV demand of 'exnDiv' is lazy, its default arg dmd is absent, but otherwise (in -terms of 'Demand.isDeadEndDiv') it behaves exactly as 'botDiv', so that dead code +'f' should not be strict in 'y'. If 'f' was inferred to be strict in 'y', WW +would turn a precise into an imprecise exception in the call site + at f 1 (error "boom")@. If the user wrote a catch block for the precise exception +around that call site, it would no longer match. + +Contrast this with + g x y | x>0 = error "You won't see this" + | otherwise = return 2 +'error' throws an imprecise exception, which the compiler is free to mask +with a different exception or non-termination as it sees fit. + +You might think that the solution is to give 'raiseIO#' 'topDiv' instead of +'botDiv' (which we do for 'error' and other kinds of bottom), so that its +'Demand.defaultFvDmd' is lazy (cf. Note [Default demand on free variables and arguments]). +Then the first branch would no longer be strict in 'y'. + +But then the simplifier would fail to eliminate a lot of dead code (which +happens in 'Simplifier.rebuildCall', feeding on the 'arg_stricts' constructed +in 'SimplUtils.mkArgInfo', which in turn consults 'isDeadEndDiv') when +'raiseIO#' occurs in a case scrutinee. Hence we need to give it 'exnDiv', which +was conceived entirely for this reason. The default FV demand of 'exnDiv' is +lazy (and its default arg dmd is absent), but otherwise (in terms of +'Demand.isDeadEndDiv') it behaves exactly as 'botDiv', so that dead code elimination works as expected. -} @@ -1007,7 +1036,7 @@ lubDivergence ConOrDiv ConOrDiv = ConOrDiv lubDivergence _ _ = Dunno -- This needs to commute with defaultFvDmd, i.e. -- defaultFvDmd (r1 `lubDivergence` r2) = defaultFvDmd r1 `lubDmd` defaultFvDmd r2 --- (See Note [Default demand on free variables] for why) +-- (See Note [Default demand on free variables and arguments] for why) bothDivergence :: Divergence -> Divergence -> Divergence -- See Note [Asymmetry of 'both' for DmdType and Divergence] @@ -1046,7 +1075,7 @@ isDeadEndDiv ExnOrDiv = True isDeadEndDiv ConOrDiv = False isDeadEndDiv Dunno = False --- See Notes [Default demand on free variables] +-- See Notes [Default demand on free variables and arguments] -- and [defaultFvDmd vs. defaultArgDmd] -- and Scenario 2 in [Precise exceptions and strictness analysis] defaultFvDmd :: Divergence -> Demand @@ -1087,7 +1116,7 @@ different: ************************************************************************ -} -type DmdEnv = VarEnv Demand -- See Note [Default demand on free variables] +type DmdEnv = VarEnv Demand -- See Note [Default demand on free variables and arguments] data DmdType = DmdType DmdEnv -- Demand on explicitly-mentioned @@ -1484,7 +1513,7 @@ peelFV (DmdType fv ds res) id = -- pprTrace "rfv" (ppr id <+> ppr dmd $$ ppr fv) (DmdType fv' ds res, dmd) where fv' = fv `delVarEnv` id - -- See Note [Default demand on free variables] + -- See Note [Default demand on free variables and arguments] dmd = lookupVarEnv fv id `orElse` defaultFvDmd res addDemand :: Demand -> DmdType -> DmdType @@ -1495,17 +1524,24 @@ findIdDemand (DmdType fv _ res) id = lookupVarEnv fv id `orElse` defaultFvDmd res {- -Note [Default demand on free variables] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -If the variable is not mentioned in the environment of a demand type, -its demand is taken to be a result demand of the type. - For the strictness component, - if the result demand is a Diverges, then we use HyperStr - else we use Lazy - For the usage component, we use Absent. -So we use either absDmd or botDmd. - -Also note the equation for lubDivergence noted there. +Note [Default demand on free variables and arguments] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Free variables not mentioned in the environment of a 'DmdType' +are demanded according to the demand type's Divergence: + * In a Diverges (botDiv) context, that demand is botDmd + (HyperStr and Absent). + * In all other contexts, the demand is absDmd (Lazy and Absent). +This is recorded in 'defaultFvDmd'. + +Similarly, we can eta-expand demand types to get demands on excess arguments +not accounted for in the type, by consulting 'defaultArgDmd': + * In a Diverges (botDiv) context, that demand is again botDmd. + * In a ExnOrDiv (exnDiv) context, that demand is absDmd: We surely diverge + before evaluating the excess argument, but don't want to eagerly evaluate + it (cf. Note [Precise exceptions and strictness analysis]). + * In all other contexts (conDiv, topDiv), the demand is topDmd, because + it's perfectly possible to enter the additional lambda and evaluate it + in unforeseen ways. Note [Always analyse in virgin pass] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/3d667c3249a166a6c936589c688a143141bacc5f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/3d667c3249a166a6c936589c688a143141bacc5f You're receiving 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 Mar 18 17:47:11 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 18 Mar 2020 13:47:11 -0400 Subject: [Git][ghc/ghc][wip/test] users-guide: Fix unknown link targets Message-ID: <5e725e9faa63a_488a8eac47019894a0@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/test at Glasgow Haskell Compiler / GHC Commits: 5295fd5a by Ben Gamari at 2020-03-18T17:46:52Z users-guide: Fix unknown link targets - - - - - 1 changed file: - docs/users_guide/runtime_control.rst Changes: ===================================== docs/users_guide/runtime_control.rst ===================================== @@ -206,21 +206,32 @@ Furthermore GHC lets you specify the way event log data (see :rts-flag:`-l To use an :c:type:`EventLogWriter` the RTS API provides the following functions: -.. c:func:: enum EventLogStatus eventLogStatus(void) +.. c:function:: EventLogStatus eventLogStatus(void) Query whether the current runtime system supports the eventlog (e.g. whether the current executable was linked with :ghc-flag:`-eventlog`) and, if it is supported, whether it is currently logging. -.. c:func:: bool startEventLogging(const EventLogWriter *writer) +.. 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. -.. c:func:: void endEventLogging() +.. c:function:: void endEventLogging() Tear down the active :c:type:`EventLogWriter`. +where the ``enum`` :c:type:`EventLogStatus` is: + +.. c:type:: EventLogStatus + + * ``EVENTLOG_NOT_SUPPORTED``: The runtime system wasn't compiled with + eventlog support. + * ``EVENTLOG_NOT_CONFIGURED``: An :c:type:`EventLogWriter` has not yet been + configured. + * ``EVENTLOG_RUNNING``: An :c:type:`EventLogWriter` has been configured and + is running. + .. _rts-options-misc: @@ -246,7 +257,7 @@ Miscellaneous RTS options catch unhandled exceptions using the Windows exception handling mechanism. This option is primarily useful for when you are using the Haskell code as a DLL, and don't want the RTS to ungracefully terminate your application on - erros such as segfaults. + errors such as segfaults. .. rts-flag:: --generate-crash-dumps @@ -371,8 +382,8 @@ performance. collections. Under this collection strategy oldest-generation garbage collection can proceed concurrently with mutation. - Note that :rts-flag:`--nonmoving-gc` cannot be used with ``-G1`` nor - :rts-flag:`-c`. + Note that :rts-flag:`--nonmoving-gc` cannot be used with ``-G1``, + :rts-flag:`profiling <-hc>` nor :rts-flag:`-c`. .. rts-flag:: -xn @@ -652,6 +663,26 @@ performance. This is an experimental feature, please let us know if it causes problems and/or could benefit from further tuning. +.. rts-flag:: -Iw ⟨seconds⟩ + + :default: 0 seconds + + .. index:: + single: idle GC + + By default, if idle GC is enabled in the threaded runtime, a major + GC will be performed every time the process goes idle for a + sufficiently long duration (see :rts-flag:`-I ⟨seconds⟩`). For + large server processes accepting regular but infrequent requests + (e.g., once per second), an expensive, major GC may run after + every request. As an alternative to shutting off idle GC entirely + (with ``-I0``), a minimum wait time between idle GCs can be + specified with this flag. For example, ``-Iw60`` will ensure that + an idle GC runs at most once per minute. + + This is an experimental feature, please let us know if it causes + problems and/or could benefit from further tuning. + .. rts-flag:: -ki ⟨size⟩ :default: 1k @@ -841,10 +872,10 @@ performance. By default, the flag will cause a warning to be emitted to stderr when the sync time exceeds the specified time. This behaviour can - be overriden, however: the ``longGCSync()`` hook is called when + be overridden, however: the ``longGCSync()`` hook is called when the sync time is exceeded during the sync period, and the ``longGCSyncEnd()`` hook at the end. Both of these hooks can be - overriden in the ``RtsConfig`` when the runtime is started with + overridden in the ``RtsConfig`` when the runtime is started with ``hs_init_ghc()``. The default implementations of these hooks (``LongGcSync()`` and ``LongGCSyncEnd()`` respectively) print warnings to stderr. @@ -1116,7 +1147,7 @@ When the program is linked with the :ghc-flag:`-eventlog` option logs a default set of events, suitable for use with tools like ThreadScope. Per default the events are written to :file:`{program}.eventlog` though - the mechanism for writing event log data can be overriden with a custom + the mechanism for writing event log data can be overridden with a custom `EventLogWriter`. For some special use cases you may want more control over which @@ -1311,7 +1342,7 @@ recommended for everyday use! .. rts-flag:: -Z - Turn *off* "update-frame squeezing" at garbage-collection time. + Turn *off* update frame squeezing on context switch. (There's no particularly good reason to turn it off, except to ensure the accuracy of certain data collected regarding thunk entry counts.) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/5295fd5adc967f02ec8b0fa2f45e978e1f531295 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/5295fd5adc967f02ec8b0fa2f45e978e1f531295 You're receiving 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 Mar 19 14:04:31 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Thu, 19 Mar 2020 10:04:31 -0400 Subject: [Git][ghc/ghc][wip/tycl-group] minor comments Message-ID: <5e737befd936_488a3fc6cb49d8fc212811a@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/tycl-group at Glasgow Haskell Compiler / GHC Commits: 8c28209b by Vladislav Zavialov at 2020-03-19T14:04:23Z minor comments - - - - - 2 changed files: - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Hs/Decls.hs Changes: ===================================== compiler/GHC/Driver/Plugins.hs ===================================== @@ -229,7 +229,7 @@ keepRenamedSource _ gbl_env group = update_exports Nothing = Just [] update_exports m = m - update Nothing = Just (emptyRnGroup :: HsGroup GhcRn) + update Nothing = Just emptyRnGroup update m = m ===================================== compiler/GHC/Hs/Decls.hs ===================================== @@ -260,7 +260,7 @@ data HsGroup p type instance XCHsGroup GhcPs = NoExtField type instance XCHsGroup GhcRn = KindedDecls -type instance XCHsGroup GhcTc = KindedDecls +type instance XCHsGroup GhcTc = Void type instance XXHsGroup (GhcPass _) = NoExtCon -- | Names of declarations that either have a CUSK or a SAKS. @@ -275,9 +275,13 @@ instance Monoid KindedDecls where isKindedDecl :: KindedDecls -> TyClDecl GhcRn -> Bool isKindedDecl (KindedDecls nameSet) d = elemNameSet (tcdName d) nameSet -emptyGroup, emptyRdrGroup, emptyRnGroup :: Monoid (XCHsGroup (GhcPass p)) => HsGroup (GhcPass p) +emptyGroup :: Monoid (XCHsGroup (GhcPass p)) => HsGroup (GhcPass p) + +emptyRdrGroup :: HsGroup GhcPs emptyRdrGroup = emptyGroup { hs_valds = emptyValBindsIn } -emptyRnGroup = emptyGroup { hs_valds = emptyValBindsOut } + +emptyRnGroup :: HsGroup GhcRn +emptyRnGroup = emptyGroup { hs_valds = emptyValBindsOut } emptyGroup = HsGroup { hs_ext = mempty, hs_tyclds = [], View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/8c28209b53e324fd56fdc184db3e88ea82009b70 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/8c28209b53e324fd56fdc184db3e88ea82009b70 You're receiving 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 Mar 18 08:23:53 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Wed, 18 Mar 2020 04:23:53 -0400 Subject: [Git][ghc/ghc][wip/T17923] Progress Message-ID: <5e71da99825d_488a3fc6ccab21ec18603bb@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T17923 at Glasgow Haskell Compiler / GHC Commits: 95ecfa58 by Simon Peyton Jones at 2020-03-18T08:22:44Z Progress - - - - - 1 changed file: - compiler/GHC/Core/Lint.hs Changes: ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -575,28 +575,23 @@ lintExpr dflags vars expr Check a core binding, returning the list of variables bound. -} -lintSingleBinding :: TopLevelFlag -> RecFlag -> (Id, CoreExpr) -> LintM () +lintRecBinding :: TopLevelFlag -> RecFlag -> (LintedId, CoreExpr) -> LintM () -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] -lintSingleBinding top_lvl_flag rec_flag (binder,rhs) +lintRecBinding top_lvl_flag rec_flag (binder,rhs) = addLoc (RhsOf binder) $ - -- Check the rhs - do { ty <- lintRhs binder rhs - ; binder_ty <- applySubstTy (idType binder) - ; ensureEqTys binder_ty ty (mkRhsMsg binder (text "RHS") ty) + do { rhs_ty <- lintRhs binder rhs -- Check the rhs + ; lintLetBinder top_lvl rec_flag binder rhs_ty } + +lintRecBinding :: TopLevelFlag -> RecFlag -> LintedId -> LintedType -> LintM () +lintLetBinder top_lvl rec_flag binder rhs_ty + = do { ensureEqTys binder_ty rhs_ty (mkRhsMsg binder (text "RHS") rhs_ty) -- If the binding is for a CoVar, the RHS should be (Coercion co) -- See Note [Core type and coercion invariant] in GHC.Core ; checkL (not (isCoVar binder) || isCoArg rhs) (mkLetErr binder rhs) - -- Check that it's not levity-polymorphic - -- Do this first, because otherwise isUnliftedType panics - -- Annoyingly, this duplicates the test in lintIdBdr, - -- because for non-rec lets we call lintSingleBinding first - ; checkL (isJoinId binder || not (isTypeLevPoly binder_ty)) - (badBndrTyMsg binder (text "levity-polymorphic")) - -- Check the let/app invariant -- See Note [Core let/app invariant] in GHC.Core ; checkL ( isJoinId binder @@ -822,11 +817,12 @@ lintCoreExpr (Let (NonRec tv (Type ty)) body) lintCoreExpr (Let (NonRec bndr rhs) body) | isId bndr - = do { lintSingleBinding NotTopLevel NonRecursive (bndr,rhs) - ; addLoc (BodyOfLetRec [bndr]) - (lintBinder LetBind bndr $ \_ -> - addGoodJoins [bndr] $ - lintCoreExpr body) } + = do { rhs_ty <- lintCoreExpr rhs + ; lintBinder LetBind bndr $ \bndr' -> + do { lintLetBinder NotTopLevel NonRecursive bndr' rhs_ty + ; addLoc (BodyOfLetRec [bndr]) $ + addGoodJoins [bndr] $ + lintCoreExpr body } } | otherwise = failWithL (mkLetErr bndr rhs) -- Not quite accurate @@ -1138,10 +1134,10 @@ lintCaseExpr scrut var alt_ty alts = -- See Note [Join points are less general than the paper] -- in GHC.Core - ; (alt_ty, _) <- addLoc (CaseTy scrut) $ - lintValueType alt_ty - ; (var_ty, _) <- addLoc (IdTy var) $ - lintValueType (idType var) + ; alt_ty <- addLoc (CaseTy scrut) $ + lintValueType alt_ty + ; var_ty <- addLoc (IdTy var) $ + lintValueType (idType var) -- We used to try to check whether a case expression with no -- alternatives was legitimate, but this didn't work. @@ -1333,14 +1329,15 @@ lintIdBndr top_lvl bind_site id linterF ; checkL (not (isExternalName (Var.varName id)) || is_top_lvl) (mkNonTopExternalNameMsg id) - ; (id_ty, k) <- addLoc (IdTy id) $ - lintValueType (idType id) + ; id_ty <- addLoc (IdTy id) $ + lintValueType (idType id) ; let id' = setIdType id id_ty -- See Note [Levity polymorphism invariants] in GHC.Core - ; lintL (isJoinId id || not (lf_check_levity_poly flags) || not (isKindLevPoly k)) - (text "Levity-polymorphic binder:" <+> - (ppr id <+> dcolon <+> parens (ppr id_ty <+> dcolon <+> ppr k))) + ; lintL (isJoinId id || not (lf_check_levity_poly flags) + || not (isTypeLevPoly id_ty)) $ + text "Levity-polymorphic binder:" <+> ppr id <+> dcolon <+> + parens (ppr id_ty <+> dcolon <+> ppr (typeKind id_ty) -- Check that a join-id is a not-top-level let-binding ; when (isJoinId id) $ @@ -2404,9 +2401,6 @@ getTCvSubst = LintM (\ env errs -> (Just (le_subst env), errs)) getInScope :: LintM InScopeSet getInScope = LintM (\ env errs -> (Just (getTCvInScope $ le_subst env), errs)) -applySubstTy :: InType -> LintM OutType -applySubstTy ty = do { subst <- getTCvSubst; return (substTy subst ty) } - lookupIdInScope :: Id -> LintM Id lookupIdInScope id_occ = do { in_scope_ids <- getInScopeIds View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/95ecfa58c2b106c5521a4f3738bc7a4b0ca02857 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/95ecfa58c2b106c5521a4f3738bc7a4b0ca02857 You're receiving 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 Mar 18 01:08:27 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 17 Mar 2020 21:08:27 -0400 Subject: [Git][ghc/ghc][wip/dataToTag-opt] Use pointer tag in dataToTag# Message-ID: <5e71748b1305d_488a3fc6ceaba9f818179bc@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/dataToTag-opt at Glasgow Haskell Compiler / GHC Commits: 38db4a35 by Ben Gamari at 2020-03-18T01:08:21Z Use pointer tag in dataToTag# - - - - - 1 changed file: - compiler/GHC/StgToCmm/Expr.hs Changes: ===================================== compiler/GHC/StgToCmm/Expr.hs ===================================== @@ -35,6 +35,7 @@ import GHC.Stg.Syntax import GHC.Cmm.Graph import GHC.Cmm.BlockId import GHC.Cmm hiding ( succ ) +import GHC.Cmm.Utils ( zeroExpr ) import GHC.Cmm.Info import GHC.Core import DataCon @@ -73,10 +74,26 @@ cgExpr (StgOpApp (StgPrimOp SeqOp) [StgVarArg a, _] _res_ty) = cgExpr (StgOpApp (StgPrimOp DataToTagOp) [StgVarArg a] _res_ty) = do dflags <- getDynFlags emitComment (mkFastString "dataToTag#") - tmp <- newTemp (bWord dflags) - _ <- withSequel (AssignTo [tmp] False) (cgIdApp a []) - -- TODO: For small types look at the tag bits instead of reading info table - emitReturn [getConstrTag dflags (cmmUntag dflags (CmmReg (CmmLocal tmp)))] + info <- getCgIdInfo a + tag_reg <- assignTemp $ cmmConstrTag1 dflags (idInfoToAmode info) + result_reg <- newTemp (bWord dflags) + let tag = CmmReg $ CmmLocal tag_reg + + slow_path <- getCode $ do + tmp <- newTemp (bWord dflags) + _ <- withSequel (AssignTo [tmp] False) (cgIdApp a []) + -- TODO: For small types look at the tag bits instead of reading info table + emitAssign (CmmLocal result_reg) + $ getConstrTag dflags (cmmUntag dflags (CmmReg (CmmLocal tmp))) + + fast_path <- getCode $ do + emitAssign (CmmLocal result_reg) + $ cmmSubWord dflags tag (CmmLit $ mkWordCLit dflags 1) + + let zero = zeroExpr dflags + emit =<< mkCmmIfThenElse' (cmmEqWord dflags tag zero) slow_path fast_path (Just False) + emitReturn [CmmReg $ CmmLocal result_reg] + cgExpr (StgOpApp op args ty) = cgOpApp op args ty cgExpr (StgConApp con args _)= cgConApp con args View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/38db4a35dac7b250d3850c47bd06452f91f7a1f6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/38db4a35dac7b250d3850c47bd06452f91f7a1f6 You're receiving 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 Mar 18 14:38:41 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 18 Mar 2020 10:38:41 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Modules: Core operations (#13009) Message-ID: <5e723271f8dc_488a3fc6f93dbda019307f6@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 528df8ec by Sylvain Henry at 2020-03-18T14:06:43Z Modules: Core operations (#13009) - - - - - 4e8a71c1 by Richard Eisenberg at 2020-03-18T14:07:19Z 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. - - - - - 337d3ab0 by Andreas Klebinger at 2020-03-18T14:38:31Z 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] - - - - - 67744233 by Sebastian Graf at 2020-03-18T14:38:36Z 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. - - - - - 30 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/simplCore/CSE.hs → compiler/GHC/Core/Op/CSE.hs - compiler/simplCore/CallArity.hs → compiler/GHC/Core/Op/CallArity.hs - compiler/prelude/PrelRules.hs → compiler/GHC/Core/Op/ConstantFold.hs - compiler/stranal/CprAnal.hs → compiler/GHC/Core/Op/CprAnal.hs - compiler/stranal/DmdAnal.hs → compiler/GHC/Core/Op/DmdAnal.hs - compiler/simplCore/Exitify.hs → compiler/GHC/Core/Op/Exitify.hs - compiler/simplCore/FloatIn.hs → compiler/GHC/Core/Op/FloatIn.hs - compiler/simplCore/FloatOut.hs → compiler/GHC/Core/Op/FloatOut.hs - compiler/simplCore/LiberateCase.hs → compiler/GHC/Core/Op/LiberateCase.hs - compiler/simplCore/CoreMonad.hs → compiler/GHC/Core/Op/Monad.hs - compiler/simplCore/CoreMonad.hs-boot → compiler/GHC/Core/Op/Monad.hs-boot - compiler/simplCore/OccurAnal.hs → compiler/GHC/Core/Op/OccurAnal.hs - compiler/simplCore/SetLevels.hs → compiler/GHC/Core/Op/SetLevels.hs - compiler/simplCore/Simplify.hs → compiler/GHC/Core/Op/Simplify.hs - compiler/simplCore/SimplCore.hs → compiler/GHC/Core/Op/Simplify/Driver.hs - compiler/simplCore/SimplEnv.hs → compiler/GHC/Core/Op/Simplify/Env.hs - compiler/simplCore/SimplMonad.hs → compiler/GHC/Core/Op/Simplify/Monad.hs - compiler/simplCore/SimplUtils.hs → compiler/GHC/Core/Op/Simplify/Utils.hs - compiler/specialise/SpecConstr.hs → compiler/GHC/Core/Op/SpecConstr.hs - compiler/specialise/Specialise.hs → compiler/GHC/Core/Op/Specialise.hs - compiler/simplCore/SAT.hs → compiler/GHC/Core/Op/StaticArgs.hs - compiler/GHC/Core/Op/Tidy.hs - compiler/stranal/WorkWrap.hs → compiler/GHC/Core/Op/WorkWrap.hs - compiler/stranal/WwLib.hs → compiler/GHC/Core/Op/WorkWrap/Lib.hs - compiler/simplCore/simplifier.tib → compiler/GHC/Core/Op/simplifier.tib The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/77e28fc29d2309d03daaf46563c9a5b5d6db363e...677442333b9cce270a05f70e29dcd5df36f26d2b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/77e28fc29d2309d03daaf46563c9a5b5d6db363e...677442333b9cce270a05f70e29dcd5df36f26d2b You're receiving 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 Mar 19 13:34:56 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 19 Mar 2020 09:34:56 -0400 Subject: [Git][ghc/ghc][wip/test] Backport get-win32-tarballs configure changes Message-ID: <5e737500118d3_488a3fc6a691ddac21149ed@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/test at Glasgow Haskell Compiler / GHC Commits: 0d16820c by Ben Gamari at 2020-03-19T13:34:36Z Backport get-win32-tarballs configure changes - - - - - 1 changed file: - configure.ac Changes: ===================================== configure.ac ===================================== @@ -347,7 +347,7 @@ set_up_tarballs() { else action="download" fi - mk/get-win32-tarballs.sh $action $HostArch > missing-win32-tarballs + $PYTHON mk/get-win32-tarballs.py $action $mingw_arch > missing-win32-tarballs case $? in 0) rm missing-win32-tarballs @@ -359,7 +359,7 @@ set_up_tarballs() { echo echo " * run configure with the --enable-tarballs-autodownload option" echo - echo " * run mk/get-win32-tarballs.sh download ${HostArch}" + echo " * run mk/get-win32-tarballs.py download $mingw_arch" echo echo " * manually download the files listed in ./missing-win32-tarballs and place" echo " them in the ghc-tarballs directory." View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/0d16820cef7631be5848e7cdda76f4b7f8a6ebdc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/0d16820cef7631be5848e7cdda76f4b7f8a6ebdc You're receiving 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 Mar 18 13:38:50 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 18 Mar 2020 09:38:50 -0400 Subject: [Git][ghc/ghc][wip/dataToTag-opt] Use pointer tag in dataToTag# Message-ID: <5e72246abfe36_488a3fc6f8fa0cb818970e9@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/dataToTag-opt at Glasgow Haskell Compiler / GHC Commits: da41a337 by Ben Gamari at 2020-03-18T13:38:44Z Use pointer tag in dataToTag# While looking at !2873 I noticed that dataToTag# previously didn't look at a pointer's tag to determine its constructor. To be fair, there is a bit of a trade-off here: using the pointer tag requires a bit more code and another branch. On the other hand, it allows us to eliminate looking at the info table in many cases (especially now since we tag large constructor families; see #14373). - - - - - 1 changed file: - compiler/GHC/StgToCmm/Expr.hs Changes: ===================================== compiler/GHC/StgToCmm/Expr.hs ===================================== @@ -35,6 +35,7 @@ import GHC.Stg.Syntax import GHC.Cmm.Graph import GHC.Cmm.BlockId import GHC.Cmm hiding ( succ ) +import GHC.Cmm.Utils ( zeroExpr, cmmTagMask ) import GHC.Cmm.Info import GHC.Core import DataCon @@ -69,14 +70,43 @@ cgExpr (StgOpApp (StgPrimOp SeqOp) [StgVarArg a, _] _res_ty) = cgIdApp a [] -- dataToTag# :: a -> Int# --- See Note [dataToTag#] in primops.txt.pp +-- See Note [dataToTag# magic] in PrelRules. cgExpr (StgOpApp (StgPrimOp DataToTagOp) [StgVarArg a] _res_ty) = do dflags <- getDynFlags emitComment (mkFastString "dataToTag#") - tmp <- newTemp (bWord dflags) - _ <- withSequel (AssignTo [tmp] False) (cgIdApp a []) - -- TODO: For small types look at the tag bits instead of reading info table - emitReturn [getConstrTag dflags (cmmUntag dflags (CmmReg (CmmLocal tmp)))] + info <- getCgIdInfo a + tag_reg <- assignTemp $ cmmConstrTag1 dflags (idInfoToAmode info) + result_reg <- newTemp (bWord dflags) + let tag = CmmReg $ CmmLocal tag_reg + -- Here we will first check the tag bits of the pointer we were given; + -- if this doesn't work then enter the closure and use the info table + -- to determine the constructor. Note that all tag bits set means that + -- the constructor index is too large to fit in the pointer and therefore + -- we must look in the info table. See Note [Tagging big families]. + + slow_path <- getCode $ do + tmp <- newTemp (bWord dflags) + _ <- withSequel (AssignTo [tmp] False) (cgIdApp a []) + -- TODO: For small types look at the tag bits instead of reading info table + emitAssign (CmmLocal result_reg) + $ getConstrTag dflags (cmmUntag dflags (CmmReg (CmmLocal tmp))) + + fast_path <- getCode $ do + emitAssign (CmmLocal result_reg) + $ cmmSubWord dflags tag (CmmLit $ mkWordCLit dflags 1) + + let zero = zeroExpr dflags + too_big_tag = cmmTagMask dflags + is_tagged = + cmmNeWord dflags + (cmmOrWord dflags + (cmmEqWord dflags tag zero) -- not evaluated + (cmmEqWord dflags tag too_big_tag)) -- tag too big + zero + + emit =<< mkCmmIfThenElse' is_tagged slow_path fast_path (Just False) + emitReturn [CmmReg $ CmmLocal result_reg] + cgExpr (StgOpApp op args ty) = cgOpApp op args ty cgExpr (StgConApp con args _)= cgConApp con args View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/da41a337971df016e789cf78346013f3461d7289 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/da41a337971df016e789cf78346013f3461d7289 You're receiving 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 Mar 18 20:31:58 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 18 Mar 2020 16:31:58 -0400 Subject: [Git][ghc/ghc][wip/local-symbols-2] Enable -fexpose-all-symbols when debug level is set Message-ID: <5e72853e11201_488a3fc6f8fa0cb82022061@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/local-symbols-2 at Glasgow Haskell Compiler / GHC Commits: bd94eb01 by Ben Gamari at 2020-03-18T20:31:47Z Enable -fexpose-all-symbols when debug level is set - - - - - 2 changed files: - compiler/GHC/Driver/Session.hs - docs/users_guide/debug-info.rst Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -3915,8 +3915,7 @@ defaultFlags settings Opt_RPath, Opt_SharedImplib, Opt_SimplPreInlining, - Opt_VersionMacros, - Opt_ExposeAllSymbols + Opt_VersionMacros ] ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] @@ -4502,7 +4501,13 @@ setVerbosity :: Maybe Int -> DynP () setVerbosity mb_n = upd (\dfs -> dfs{ verbosity = mb_n `orElse` 3 }) setDebugLevel :: Maybe Int -> DynP () -setDebugLevel mb_n = upd (\dfs -> dfs{ debugLevel = mb_n `orElse` 2 }) +setDebugLevel mb_n = + upd (\dfs -> exposeSyms $ dfs{ debugLevel = n }) + where + n = mb_n `orElse` 2 + exposeSyms + | n > 0 = setGeneralFlag' Opt_ExposeAllSymbols + | otherwise = id data PkgDbRef = GlobalPkgDb ===================================== docs/users_guide/debug-info.rst ===================================== @@ -14,6 +14,7 @@ useable by most UNIX debugging tools. :category: debugging :since: 7.10, numeric levels since 8.0 + :implies: :ghc-flag:`-fexpose-all-symbols` Emit debug information in object code. Currently only DWARF debug information is supported on x86-64 and i386. Currently debug levels 0 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/bd94eb01d1d1b9b0cb04126e9a29c6e7454bea90 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/bd94eb01d1d1b9b0cb04126e9a29c6e7454bea90 You're receiving 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 Mar 18 22:15:51 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 18 Mar 2020 18:15:51 -0400 Subject: [Git][ghc/ghc][wip/test] Drop compare-flags Message-ID: <5e729d97ca977_488a3fc6ceaba9f820337d6@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/test at Glasgow Haskell Compiler / GHC Commits: cd4990ca by Ben Gamari at 2020-03-18T22:15:45Z Drop compare-flags - - - - - 2 changed files: - − docs/users_guide/compare-flags.py - hadrian/src/Rules/Documentation.hs Changes: ===================================== docs/users_guide/compare-flags.py deleted ===================================== @@ -1,93 +0,0 @@ -#!/usr/bin/env python -# -*- coding: utf-8 -*- - -""" -Linter to verify that all flags reported by GHC's --show-options mode -are documented in the user's guide. -""" - -import sys -import subprocess -from typing import Set -from pathlib import Path - -# A list of known-undocumented flags. This should be considered to be a to-do -# list of flags that need to be documented. -EXPECTED_UNDOCUMENTED_PATH = \ - Path(__file__).parent / 'expected-undocumented-flags.txt' - -EXPECTED_UNDOCUMENTED = \ - {line for line in open(EXPECTED_UNDOCUMENTED_PATH).read().split()} - -def expected_undocumented(flag: str) -> bool: - if flag in EXPECTED_UNDOCUMENTED: - return True - if flag.startswith('-Werror'): - return True - if flag.startswith('-Wno-') \ - or flag.startswith('-dno') \ - or flag.startswith('-fno') \ - or flag.startswith('-XNo'): - return True - if flag.startswith('-Wwarn=') \ - or flag.startswith('-Wno-warn='): - return True - - return False - -def read_documented_flags(doc_flags) -> Set[str]: - # Map characters that mark the end of a flag - # to whitespace. - trans = str.maketrans({ - '=': ' ', - '[': ' ', - '⟨': ' ', - }) - return {line.translate(trans).split()[0] - for line in doc_flags.read().split('\n') - if line != ''} - -def read_ghc_flags(ghc_path: str) -> Set[str]: - ghc_output = subprocess.check_output([ghc_path, '--show-options']) - return {flag - for flag in ghc_output.decode('UTF-8').split('\n') - if not expected_undocumented(flag) - if flag != ''} - -def error(s: str): - print(s, file=sys.stderr) - -def main() -> None: - import argparse - parser = argparse.ArgumentParser() - parser.add_argument('--ghc', type=argparse.FileType('r'), - help='path of GHC executable') - parser.add_argument('--doc-flags', type=argparse.FileType('r'), - help='path of ghc-flags.txt output from Sphinx') - args = parser.parse_args() - - doc_flags = read_documented_flags(args.doc_flags) - ghc_flags = read_ghc_flags(args.ghc.name) - - failed = False - - undocumented = ghc_flags - doc_flags - if len(undocumented) > 0: - error('Found {len_undoc} flags not documented in the users guide:'.format(len_undoc=len(undocumented)), ) - error('\n'.join(' {}'.format(flag) for flag in sorted(undocumented))) - error('') - failed = True - - now_documented = EXPECTED_UNDOCUMENTED.intersection(doc_flags) - if len(now_documented) > 0: - error('Found flags that are documented yet listed in {}:'.format(EXPECTED_UNDOCUMENTED_PATH)) - error('\n'.join(' {}'.format(flag) for flag in sorted(now_documented))) - error('') - failed = True - - if failed: - sys.exit(1) - - -if __name__ == '__main__': - main() ===================================== hadrian/src/Rules/Documentation.hs ===================================== @@ -16,7 +16,6 @@ import Context import Expression (getContextData, interpretInContext, (?), package) import Flavour import Oracles.ModuleFiles -import Oracles.Setting (topDirectory) import Packages import Settings import Target @@ -111,11 +110,6 @@ documentationRules = do need $ map (root -/-) targets - when (SphinxPDFs `Set.member` doctargets) - $ checkUserGuideFlags $ pdfRoot -/- "users_guide" -/- "ghc-flags.txt" - when (SphinxHTML `Set.member` doctargets) - $ checkUserGuideFlags $ root -/- htmlRoot -/- "users_guide" -/- "ghc-flags.txt" - where archiveTarget "libraries" = Haddocks archiveTarget _ = SphinxHTML @@ -129,17 +123,6 @@ checkSphinxWarnings out = do when ("reference target not found" `isInfixOf` log) $ fail "Undefined reference targets found in Sphinx log." --- | Check that all GHC flags are documented in the users guide. -checkUserGuideFlags :: FilePath -> Action () -checkUserGuideFlags documentedFlagList = do - scriptPath <- ( "docs/users_guide/compare-flags.py") <$> topDirectory - ghcPath <- () <$> topDirectory <*> programPath (vanillaContext Stage1 ghc) - runBuilder Python - [ scriptPath - , "--doc-flags", documentedFlagList - , "--ghc", ghcPath - ] [documentedFlagList] [] - ------------------------------------- HTML ------------------------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/cd4990ca1925e619afa547ba9ce6cfe2c6132dad -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/cd4990ca1925e619afa547ba9ce6cfe2c6132dad You're receiving 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 Mar 18 04:26:19 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 18 Mar 2020 00:26:19 -0400 Subject: [Git][ghc/ghc][wip/dataToTag-opt] 3 commits: When deriving Eq always use tag based comparisons for nullary constructors Message-ID: <5e71a2ebccd48_488a3fc6cb49d8fc18293e0@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/dataToTag-opt at Glasgow Haskell Compiler / GHC Commits: 05576ed5 by Andreas Klebinger at 2020-03-18T04:24:30Z When deriving Eq always use tag based comparisons for nullary constructors - - - - - 69ce4a89 by Andreas Klebinger at 2020-03-18T04:24:35Z Use dataToTag# instead of getTag in deriving code. getTag resides in base so is not useable in ghc-prim. Where we need it. - - - - - 4a2cf862 by Andreas Klebinger at 2020-03-18T04:24:39Z Eliminate generated Con2Tag bindings completely - - - - - 3 changed files: - compiler/prelude/PrelNames.hs - compiler/typecheck/TcGenDeriv.hs - compiler/utils/ListSetOps.hs Changes: ===================================== compiler/prelude/PrelNames.hs ===================================== @@ -749,12 +749,13 @@ toList_RDR = nameRdrName toListName compose_RDR :: RdrName compose_RDR = varQual_RDR gHC_BASE (fsLit ".") -not_RDR, getTag_RDR, succ_RDR, pred_RDR, minBound_RDR, maxBound_RDR, +not_RDR, getTag_RDR, dataToTag_RDR, succ_RDR, pred_RDR, minBound_RDR, maxBound_RDR, and_RDR, range_RDR, inRange_RDR, index_RDR, unsafeIndex_RDR, unsafeRangeSize_RDR :: RdrName and_RDR = varQual_RDR gHC_CLASSES (fsLit "&&") not_RDR = varQual_RDR gHC_CLASSES (fsLit "not") getTag_RDR = varQual_RDR gHC_BASE (fsLit "getTag") +dataToTag_RDR = varQual_RDR gHC_PRIM (fsLit "dataToTag#") succ_RDR = varQual_RDR gHC_ENUM (fsLit "succ") pred_RDR = varQual_RDR gHC_ENUM (fsLit "pred") minBound_RDR = varQual_RDR gHC_ENUM (fsLit "minBound") ===================================== compiler/typecheck/TcGenDeriv.hs ===================================== @@ -15,6 +15,7 @@ This is where we do all the grimy bindings' generation. {-# LANGUAGE CPP, ScopedTypeVariables #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DataKinds #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} @@ -83,9 +84,8 @@ import Data.List ( find, partition, intersperse ) type BagDerivStuff = Bag DerivStuff data AuxBindSpec - = DerivCon2Tag TyCon -- The con2Tag for given TyCon - | DerivTag2Con TyCon -- ...ditto tag2Con - | DerivMaxTag TyCon -- ...and maxTag + = DerivTag2Con TyCon -- The tag2Con for given TyCon + | DerivMaxTag TyCon -- ...and ditto maxTag deriving( Eq ) -- All these generate ZERO-BASED tag operations -- I.e first constructor has tag 0 @@ -127,17 +127,17 @@ possibly zero of them). Here's an example, with both \tr{N}ullary and case (a1 `eqFloat#` a2) of r -> r for that particular test. -* If there are a lot of (more than ten) nullary constructors, we emit a +* For nullary constructors, we emit a catch-all clause of the form: - (==) a b = case (con2tag_Foo a) of { a# -> - case (con2tag_Foo b) of { b# -> + (==) a b = case (dataToTag# a) of { a# -> + case (dataToTag# b) of { b# -> case (a# ==# b#) of { r -> r }}} - If con2tag gets inlined this leads to join point stuff, so - it's better to use regular pattern matching if there aren't too - many nullary constructors. "Ten" is arbitrary, of course + An older approach preferred regular pattern matches in some cases + but with dataToTag# forcing it's argument, and work on improving + join points this seems no longer necessary. * If there aren't any nullary constructors, we emit a simpler catch-all: @@ -146,7 +146,7 @@ possibly zero of them). Here's an example, with both \tr{N}ullary and * For the @(/=)@ method, we normally just use the default method. If the type is an enumeration type, we could/may/should? generate - special code that calls @con2tag_Foo@, much like for @(==)@ shown + special code that calls @dataToTag#@, much like for @(==)@ shown above. We thought about doing this: If we're also deriving 'Ord' for this @@ -162,20 +162,18 @@ produced don't get through the typechecker. gen_Eq_binds :: SrcSpan -> TyCon -> TcM (LHsBinds GhcPs, BagDerivStuff) gen_Eq_binds loc tycon = do dflags <- getDynFlags - return (method_binds dflags, aux_binds) + return (method_binds dflags, emptyBag) where all_cons = tyConDataCons tycon (nullary_cons, non_nullary_cons) = partition isNullarySrcDataCon all_cons - -- If there are ten or more (arbitrary number) nullary constructors, - -- use the con2tag stuff. For small types it's better to use - -- ordinary pattern matching. - (tag_match_cons, pat_match_cons) - | nullary_cons `lengthExceeds` 10 = (nullary_cons, non_nullary_cons) - | otherwise = ([], all_cons) - + -- For nullary constructors, use the getTag stuff. + (tag_match_cons, pat_match_cons) = (nullary_cons, non_nullary_cons) no_tag_match_cons = null tag_match_cons + -- (LHS patterns, result) + fall_through_eqn :: DynFlags + -> [([Located (Pat (GhcPass 'Parsed))] , LHsExpr GhcPs)] fall_through_eqn dflags | no_tag_match_cons -- All constructors have arguments = case pat_match_cons of @@ -186,17 +184,16 @@ gen_Eq_binds loc tycon = do [([nlWildPat, nlWildPat], false_Expr)] | otherwise -- One or more tag_match cons; add fall-through of - -- extract tags compare for equality + -- extract tags compare for equality, + -- The case `(C1 x) == (C1 y)` can no longer happen + -- at this point as it's matched earlier. = [([a_Pat, b_Pat], untag_Expr dflags tycon [(a_RDR,ah_RDR), (b_RDR,bh_RDR)] (genPrimOpApp (nlHsVar ah_RDR) eqInt_RDR (nlHsVar bh_RDR)))] - aux_binds | no_tag_match_cons = emptyBag - | otherwise = unitBag $ DerivAuxBind $ DerivCon2Tag tycon - method_binds dflags = unitBag (eq_bind dflags) eq_bind dflags = mkFunBindEC 2 loc eq_RDR (const true_Expr) - (map pats_etc pat_match_cons + ( map pats_etc pat_match_cons ++ fall_through_eqn dflags) ------------------------------------------------------------------ @@ -346,11 +343,8 @@ gen_Ord_binds loc tycon = do then ( unitBag $ mkFunBindEC 2 loc compare_RDR (const eqTag_Expr) [] , emptyBag) else ( unitBag (mkOrdOp dflags OrdCompare) `unionBags` other_ops dflags - , aux_binds) + , emptyBag) where - aux_binds | single_con_type = emptyBag - | otherwise = unitBag $ DerivAuxBind $ DerivCon2Tag tycon - -- Note [Game plan for deriving Ord] other_ops dflags | (last_tag - first_tag) <= 2 -- 1-3 constructors @@ -369,7 +363,7 @@ gen_Ord_binds loc tycon = do get_tag con = dataConTag con - fIRST_TAG -- We want *zero-based* tags, because that's what - -- con2Tag returns (generated by untag_Expr)! + -- dataToTag# returns (generated by untag_Expr)! tycon_data_cons = tyConDataCons tycon single_con_type = isSingleton tycon_data_cons @@ -549,8 +543,8 @@ nlConWildPat con = noLoc (ConPatIn (noLoc (getRdrName con)) data Foo ... = N1 | N2 | ... | Nn \end{verbatim} -we use both @con2tag_Foo@ and @tag2con_Foo@ functions, as well as a - at maxtag_Foo@ variable (all generated by @gen_tag_n_con_binds@). +we use both dataToTag# and @tag2con_Foo@ functions, as well as a + at maxtag_Foo@ variable, the later generated by @gen_tag_n_con_binds. \begin{verbatim} instance ... Enum (Foo ...) where @@ -563,16 +557,16 @@ instance ... Enum (Foo ...) where -- or, really... enumFrom a - = case con2tag_Foo a of + = case dataToTag# a of a# -> map tag2con_Foo (enumFromTo (I# a#) maxtag_Foo) enumFromThen a b - = map tag2con_Foo [con2tag_Foo a, con2tag_Foo b .. maxtag_Foo] + = map tag2con_Foo [dataToTag# a, dataToTag# b .. maxtag_Foo] -- or, really... enumFromThen a b - = case con2tag_Foo a of { a# -> - case con2tag_Foo b of { b# -> + = case dataToTag# a of { a# -> + case dataToTag# b of { b# -> map tag2con_Foo (enumFromThenTo (I# a#) (I# b#) maxtag_Foo) }} \end{verbatim} @@ -594,7 +588,7 @@ gen_Enum_binds loc tycon = do , from_enum dflags ] aux_binds = listToBag $ map DerivAuxBind - [DerivCon2Tag tycon, DerivTag2Con tycon, DerivMaxTag tycon] + [DerivTag2Con tycon, DerivMaxTag tycon] occ_nm = getOccString tycon @@ -709,32 +703,32 @@ things go not too differently from @Enum@: \begin{verbatim} instance ... Ix (Foo ...) where range (a, b) - = map tag2con_Foo [con2tag_Foo a .. con2tag_Foo b] + = map tag2con_Foo [dataToTag# a .. dataToTag# b] -- or, really... range (a, b) - = case (con2tag_Foo a) of { a# -> - case (con2tag_Foo b) of { b# -> + = case (dataToTag# a) of { a# -> + case (dataToTag# b) of { b# -> map tag2con_Foo (enumFromTo (I# a#) (I# b#)) }} -- Generate code for unsafeIndex, because using index leads -- to lots of redundant range tests unsafeIndex c@(a, b) d - = case (con2tag_Foo d -# con2tag_Foo a) of + = case (dataToTag# d -# dataToTag# a) of r# -> I# r# inRange (a, b) c = let - p_tag = con2tag_Foo c + p_tag = dataToTag# c in - p_tag >= con2tag_Foo a && p_tag <= con2tag_Foo b + p_tag >= dataToTag# a && p_tag <= dataToTag# b -- or, really... inRange (a, b) c - = case (con2tag_Foo a) of { a_tag -> - case (con2tag_Foo b) of { b_tag -> - case (con2tag_Foo c) of { c_tag -> + = case (dataToTag# a) of { a_tag -> + case (dataToTag# b) of { b_tag -> + case (dataToTag# c) of { c_tag -> if (c_tag >=# a_tag) then c_tag <=# b_tag else @@ -757,8 +751,8 @@ gen_Ix_binds loc tycon = do dflags <- getDynFlags return $ if isEnumerationTyCon tycon then (enum_ixes dflags, listToBag $ map DerivAuxBind - [DerivCon2Tag tycon, DerivTag2Con tycon, DerivMaxTag tycon]) - else (single_con_ixes, unitBag (DerivAuxBind (DerivCon2Tag tycon))) + [DerivTag2Con tycon, DerivMaxTag tycon]) + else (single_con_ixes, emptyBag) where -------------------------------------------------------------- enum_ixes dflags = listToBag @@ -1937,41 +1931,18 @@ mkCoerceClassMethEqn cls inst_tvs inst_tys rhs_ty id \begin{verbatim} data Foo ... = ... -con2tag_Foo :: Foo ... -> Int# tag2con_Foo :: Int -> Foo ... -- easier if Int, not Int# maxtag_Foo :: Int -- ditto (NB: not unlifted) \end{verbatim} The `tags' here start at zero, hence the @fIRST_TAG@ (currently one) fiddling around. + +We also use dataToTag# heavily. -} genAuxBindSpec :: DynFlags -> SrcSpan -> AuxBindSpec -> (LHsBind GhcPs, LSig GhcPs) -genAuxBindSpec dflags loc (DerivCon2Tag tycon) - = (mkFunBindSE 0 loc rdr_name eqns, - L loc (TypeSig noExtField [L loc rdr_name] sig_ty)) - where - rdr_name = con2tag_RDR dflags tycon - - sig_ty = mkLHsSigWcType $ L loc $ XHsType $ NHsCoreTy $ - mkSpecSigmaTy (tyConTyVars tycon) (tyConStupidTheta tycon) $ - mkParentType tycon `mkVisFunTy` intPrimTy - - lots_of_constructors = tyConFamilySize tycon > 8 - -- was: mAX_FAMILY_SIZE_FOR_VEC_RETURNS - -- but we don't do vectored returns any more. - - eqns | lots_of_constructors = [get_tag_eqn] - | otherwise = map mk_eqn (tyConDataCons tycon) - - get_tag_eqn = ([nlVarPat a_RDR], nlHsApp (nlHsVar getTag_RDR) a_Expr) - - mk_eqn :: DataCon -> ([LPat GhcPs], LHsExpr GhcPs) - mk_eqn con = ([nlWildConPat con], - nlHsLit (HsIntPrim NoSourceText - (toInteger ((dataConTag con) - fIRST_TAG)))) - genAuxBindSpec dflags loc (DerivTag2Con tycon) = (mkFunBindSE 0 loc rdr_name [([nlConVarPat intDataCon_RDR [a_RDR]], @@ -2254,14 +2225,26 @@ eq_Expr ty a b where (_, _, prim_eq, _, _) = primOrdOps "Eq" ty -untag_Expr :: DynFlags -> TyCon -> [( RdrName, RdrName)] - -> LHsExpr GhcPs -> LHsExpr GhcPs +-- | Take an expression and a list of pairs @(exprName1,tagName1)@. +-- Wraps the given expression in cases which bind tagName1 to the +-- tag of exprName1 and so forth for all pairs and returns the +-- resulting expression. +untag_Expr :: DynFlags + -> TyCon + -> [( RdrName, RdrName)] -- (expr, expr's tag bound to this) + -> LHsExpr GhcPs -- Final RHS + -> LHsExpr GhcPs -- Result expr untag_Expr _ _ [] expr = expr untag_Expr dflags tycon ((untag_this, put_tag_here) : more) expr - = nlHsCase (nlHsPar (nlHsVarApps (con2tag_RDR dflags tycon) - [untag_this])) {-of-} + {- case (dataToTag# untag_this) of + put_tag_here -> .... + _ -> result + -} + = nlHsCase (nlHsPar (nlHsApp (nlHsVar dataToTag_RDR) (nlHsVar untag_this))) {-of-} [mkHsCaseAlt (nlVarPat put_tag_here) (untag_Expr dflags tycon more expr)] + + enum_from_to_Expr :: LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs @@ -2372,9 +2355,8 @@ minusInt_RDR, tagToEnum_RDR :: RdrName minusInt_RDR = getRdrName (primOpId IntSubOp ) tagToEnum_RDR = getRdrName (primOpId TagToEnumOp) -con2tag_RDR, tag2con_RDR, maxtag_RDR :: DynFlags -> TyCon -> RdrName +tag2con_RDR, maxtag_RDR :: DynFlags -> TyCon -> RdrName -- Generates Orig s RdrName, for the binding positions -con2tag_RDR dflags tycon = mk_tc_deriv_name dflags tycon mkCon2TagOcc tag2con_RDR dflags tycon = mk_tc_deriv_name dflags tycon mkTag2ConOcc maxtag_RDR dflags tycon = mk_tc_deriv_name dflags tycon mkMaxTagOcc @@ -2403,13 +2385,15 @@ mkAuxBinderName dflags parent occ_fun {- Note [Auxiliary binders] ~~~~~~~~~~~~~~~~~~~~~~~~ -We often want to make a top-level auxiliary binding. E.g. for comparison we have - instance Ord T where - compare a b = $con2tag a `compare` $con2tag b +We often want to make a top-level auxiliary binding. E.g. for enum we +turn a Integer into a constructor. So we have + + instance Enum T where + succ x = $tag2con (dataToTag x + 1) - $con2tag :: T -> Int - $con2tag = ...code.... + $tag2con :: Int -> T + $tag2con = ...code.... Of course these top-level bindings should all have distinct name, and we are generating RdrNames here. We can't just use the TyCon or DataCon to distinguish ===================================== compiler/utils/ListSetOps.hs ===================================== @@ -104,12 +104,13 @@ minusList xs ys = filter (`S.notMember` yss) xs Inefficient finite maps based on association lists and equality. -} --- A finite mapping based on equality and association lists +-- | A finite mapping based on equality and association lists. type Assoc a b = [(a,b)] assoc :: (Eq a) => String -> Assoc a b -> a -> b assocDefault :: (Eq a) => b -> Assoc a b -> a -> b assocUsing :: (a -> a -> Bool) -> String -> Assoc a b -> a -> b +-- | Lookup key, fail gracefully using Nothing if not found. assocMaybe :: (Eq a) => Assoc a b -> a -> Maybe b assocDefaultUsing :: (a -> a -> Bool) -> b -> Assoc a b -> a -> b View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/d39b8d9f72b254d042fb16c00e78e23b35a6e879...4a2cf8627cc5fee9d0fc2423d598025a0d3bbb5f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/d39b8d9f72b254d042fb16c00e78e23b35a6e879...4a2cf8627cc5fee9d0fc2423d598025a0d3bbb5f You're receiving 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 Mar 21 00:44:26 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 20 Mar 2020 20:44:26 -0400 Subject: [Git][ghc/ghc][master] Update core spec to reflect changes to Core. Message-ID: <5e75636acb49b_488a8eac470241375b@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 9a96ff6b by Richard Eisenberg at 2020-03-21T00:44:17Z 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. - - - - - 11 changed files: - .gitlab/linters/check-cpp.py - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - docs/core-spec/.gitignore - docs/core-spec/CoreLint.ott - docs/core-spec/CoreSyn.ott - docs/core-spec/core-spec.mng - docs/core-spec/core-spec.pdf Changes: ===================================== .gitlab/linters/check-cpp.py ===================================== @@ -29,6 +29,8 @@ for l in linters: # Don't lint font files l.add_path_filter(lambda path: not path.parent == Path('docs','users_guide', 'rtd-theme', 'static', 'fonts')) + # Don't lint core spec + l.add_path_filter(lambda path: not path.name == 'core-spec.pdf') if __name__ == '__main__': run_linters(linters) ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -1371,7 +1371,7 @@ promoteCoercion co = case co of ForAllCo _ _ _ -> ASSERT( False ) mkNomReflCo liftedTypeKind - -- See Note [Weird typing rule for ForAllTy] in GHC.Core.Type + -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep FunCo _ _ _ -> ASSERT( False ) @@ -1420,7 +1420,7 @@ promoteCoercion co = case co of | otherwise -> ASSERT( False) mkNomReflCo liftedTypeKind - -- See Note [Weird typing rule for ForAllTy] in GHC.Core.Type + -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep KindCo _ -> ASSERT( False ) ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -1467,7 +1467,6 @@ lintType t@(ForAllTy (Bndr cv _vis) ty) ; checkValueKind k (text "the body of forall:" <+> ppr t) ; return liftedTypeKind -- We don't check variable escape here. Namely, k could refer to cv' - -- See Note [NthCo and newtypes] in GHC.Core.TyCo.Rep }} lintType ty@(LitTy l) = lintTyLit l >> return (typeKind ty) @@ -1826,7 +1825,7 @@ lintCoercion (ForAllCo cv1 kind_co co) ; (k3, k4, t1, t2, r) <- lintCoercion co ; checkValueKind k3 (text "the body of a ForAllCo over covar:" <+> ppr co) ; checkValueKind k4 (text "the body of a ForAllCo over covar:" <+> ppr co) - -- See Note [Weird typing rule for ForAllTy] in GHC.Core.Type + -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep ; in_scope <- getInScope ; let tyl = mkTyCoInvForAllTy cv1 t1 r2 = coVarRole cv1 @@ -1845,7 +1844,7 @@ lintCoercion (ForAllCo cv1 kind_co co) tyr = mkTyCoInvForAllTy cv2 $ substTy subst t2 ; return (liftedTypeKind, liftedTypeKind, tyl, tyr, r) } } - -- See Note [Weird typing rule for ForAllTy] in GHC.Core.Type + -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep lintCoercion co@(FunCo r co1 co2) = do { (k1,k'1,s1,t1,r1) <- lintCoercion co1 @@ -2019,7 +2018,7 @@ lintCoercion (InstCo co arg) , CoercionTy s2' <- s2 -> do { return $ (liftedTypeKind, liftedTypeKind - -- See Note [Weird typing rule for ForAllTy] in GHC.Core.Type + -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep , substTy (mkCvSubst in_scope $ unitVarEnv cv1 s1') t1 , substTy (mkCvSubst in_scope $ unitVarEnv cv2 s2') t2 , r) } ===================================== compiler/GHC/Core/TyCo/Rep.hs ===================================== @@ -206,6 +206,9 @@ data Type | ForAllTy {-# UNPACK #-} !TyCoVarBinder Type -- ^ A Π type. + -- INVARIANT: If the binder is a coercion variable, it must + -- be mentioned in the Type. See + -- Note [Unused coercion variable in ForAllTy] | FunTy -- ^ t1 -> t2 Very common, so an important special case -- See Note [Function types] @@ -218,9 +221,10 @@ data Type | CastTy Type KindCoercion -- ^ A kind cast. The coercion is always nominal. - -- INVARIANT: The cast is never refl. + -- INVARIANT: The cast is never reflexive -- INVARIANT: The Type is not a CastTy (use TransCo instead) - -- See Note [Respecting definitional equality] (EQ2) and (EQ3) + -- INVARIANT: The Type is not a ForAllTy over a type variable + -- See Note [Respecting definitional equality] (EQ2), (EQ3), (EQ4) | CoercionTy Coercion -- ^ Injection of a Coercion into a type @@ -567,10 +571,19 @@ be pulled to the right. But we don't need to pull it: (T |> axFun) Int is not `eqType` to any proper TyConApp -- thus, leaving it where it is doesn't violate our (EQ) property. -Lastly, in order to detect reflexive casts reliably, we must make sure not +In order to detect reflexive casts reliably, we must make sure not to have nested casts: we update (t |> co1 |> co2) to (t |> (co1 `TransCo` co2)). -In sum, in order to uphold (EQ), we need the following three invariants: +One other troublesome case is ForAllTy. See Note [Weird typing rule for ForAllTy]. +The kind of the body is the same as the kind of the ForAllTy. Accordingly, + + ForAllTy tv (ty |> co) and (ForAllTy tv ty) |> co + +are `eqType`. But only the first can be split by splitForAllTy. So we forbid +the second form, instead pushing the coercion inside to get the first form. +This is done in mkCastTy. + +In sum, in order to uphold (EQ), we need the following invariants: (EQ1) No decomposable CastTy to the left of an AppTy, where a decomposable cast is one that relates either a FunTy to a FunTy or a @@ -578,7 +591,7 @@ In sum, in order to uphold (EQ), we need the following three invariants: (EQ2) No reflexive casts in CastTy. (EQ3) No nested CastTys. (EQ4) No CastTy over (ForAllTy (Bndr tyvar vis) body). - See Note [Weird typing rule for ForAllTy] in GHC.Core.Type. + See Note [Weird typing rule for ForAllTy] These invariants are all documented above, in the declaration for Type. @@ -607,6 +620,45 @@ There are cases we want to skip the check. For example, the check is unnecessary when it is known from the context that the input variable is a type variable. In those cases, we use mkForAllTy. +Note [Weird typing rule for ForAllTy] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Here is the (truncated) typing rule for the dependent ForAllTy: + + inner : TYPE r + tyvar is not free in r + ---------------------------------------- + ForAllTy (Bndr tyvar vis) inner : TYPE r + +Note that the kind of `inner` is the kind of the overall ForAllTy. This is +necessary because every ForAllTy over a type variable is erased at runtime. +Thus the runtime representation of a ForAllTy (as encoded, via TYPE rep, in +the kind) must be the same as the representation of the body. We must check +for skolem-escape, though. The skolem-escape would prevent a definition like + + undefined :: forall (r :: RuntimeRep) (a :: TYPE r). a + +because the type's kind (TYPE r) mentions the out-of-scope r. Luckily, the real +type of undefined is + + undefined :: forall (r :: RuntimeRep) (a :: TYPE r). HasCallStack => a + +and that HasCallStack constraint neatly sidesteps the potential skolem-escape +problem. + +If the bound variable is a coercion variable: + + inner : TYPE r + covar is free in inner + ------------------------------------ + ForAllTy (Bndr covar vis) inner : Type + +Here, the kind of the ForAllTy is just Type, because coercion abstractions +are *not* erased. The "covar is free in inner" premise is solely to maintain +the representation invariant documented in +Note [Unused coercion variable in ForAllTy]. Though there is surface similarity +between this free-var check and the one in the tyvar rule, these two restrictions +are truly unrelated. + -} -- | A type labeled 'KnotTied' might have knot-tied tycons in it. See @@ -1003,6 +1055,7 @@ data Coercion -- The TyCon is never a synonym; -- we expand synonyms eagerly -- But it can be a type function + -- TyCon is never a saturated (->); use FunCo instead | AppCo Coercion CoercionN -- lift AppTy -- AppCo :: e -> N -> e ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -1382,6 +1382,7 @@ mkCastTy (CastTy ty co1) co2 mkCastTy (ForAllTy (Bndr tv vis) inner_ty) co -- (EQ4) from the Note + -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep. | isTyVar tv , let fvs = tyCoVarsOfCo co = -- have to make sure that pushing the co in doesn't capture the bound var! ===================================== compiler/GHC/Core/Unify.hs ===================================== @@ -1507,7 +1507,7 @@ ty_co_match menv subst (ForAllTy (Bndr tv1 _) ty1) -- subst2 <- ty_co_match menv subst1 s2 eta2 kco3 kco4 -- Question: How do we get kcoi? -- 2. Given: --- lkco :: <*> -- See Note [Weird typing rule for ForAllTy] in GHC.Core.Type +-- lkco :: <*> -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep -- rkco :: <*> -- Wanted: -- ty_co_match menv' subst2 ty1 co2 lkco' rkco' ===================================== docs/core-spec/.gitignore ===================================== @@ -4,3 +4,4 @@ CoreOtt.tex core-spec.tex *.fls +*.out ===================================== docs/core-spec/CoreLint.ott ===================================== @@ -232,8 +232,8 @@ G |-co g1 : s1 k1~R k'1 t1 G |-co g2 : s2 k2~R k'2 t2 G |-arrow k1 -> k2 : k G |-arrow k'1 -> k'2 : k' -------------------------- :: TyConAppCoFunTy -G |-co (->)_R g1 g2 : (s1 -> s2) k~R k' (t1 -> t2) +------------------------- :: FunCo +G |-co g1 ->_R g2 : (s1 -> s2) k~R k' (t1 -> t2) T /= (->) = take(length , tyConRolesX R T) @@ -258,9 +258,19 @@ G |-app (t2 : k2') : k2 ~> k4 G |-co g1 g2 : (s1 t1) k3~Ph k4 (s2 t2) G |-co h : k1 *~Nom * k2 -G, z_k1 |-co g : t1 k3~R k4 t2 ------------------------------------------------------------------- :: ForAllCo -G |-co forall z:h. g : (forall z_k1. t1) k3~R k4 (forall z_k2. (t2[z |-> z_k2 |> sym h])) +G, alpha_k1 |-co g : t1 k3~R k4 t2 +------------------------------------------------------------------ :: ForAllCo_Tv +G |-co forall alpha:h. g : (forall alpha_k1. t1) k3~R k4 (forall alpha_k2. (t2[alpha |-> alpha_k2 |> sym h])) + +G |-co h : k1 *~Nom * k2 +G, x_k1 |-co g : t1 {TYPE s1}~R {TYPE s2} t2 +R2 = coercionRole x_k1 +h' = downgradeRole R2 h +h1 = nth R2 2 h' +h2 = nth R2 3 h' +almostDevoid x g +------------------------------------------- :: ForAllCo_Cv +G |-co forall x:h.g : (forall x_k1. t1) *~R * (forall x_k2. (t2[ x |-> h1 ; x_k2 ; sym h2 ])) z_phi elt G phi = t1 k1~#k2 t2 @@ -495,10 +505,17 @@ G |-app : tyConKind T ~> k G |-ty T : k G |-ki k1 ok -G, z_k1 |-ty t : TYPE s -not (z elt fv(s)) ------------------------- :: ForAllTy -G |-ty forall z_k1. t : TYPE s +G, alpha_k1 |-ty t : TYPE s +not (alpha elt fv(s)) +------------------------ :: ForAllTy_Tv +G |-ty forall alpha_k1. t : TYPE s + +phi = s1 k1~#k2 s2 +G |-ki phi ok +G, x_phi |-ty t : TYPE s +x elt fv(t) +--------------------- :: ForAllTy_Cv +G |-ty forall x_phi.t : * G |-tylit lit : k -------------- :: LitTy ===================================== docs/core-spec/CoreSyn.ott ===================================== @@ -143,6 +143,7 @@ g {{ tex \gamma }}, h {{ tex \eta }} :: 'Coercion_' ::= {{ com Coercions, \coder | < t > R mg :: :: GRefl {{ com \ctor{GRefl}: Generalized Reflexivity }} {{ tex {\langle [[t]] \rangle}^{[[mg]]}_{[[R]]} }} | T RA :: :: TyConAppCo {{ com \ctor{TyConAppCo}: Type constructor application }} + | g1 -> RA g2 :: :: FunCo {{ com \ctor{FunCo}: Functions }} | g1 g2 :: :: AppCo {{ com \ctor{AppCo}: Application }} | forall z : h . g :: :: ForAllCo {{ com \ctor{ForAllCo}: Polymorphism }} {{ tex [[forall]] [[z]]{:}[[h]].[[g]] }} @@ -162,6 +163,7 @@ g {{ tex \gamma }}, h {{ tex \eta }} :: 'Coercion_' ::= {{ com Coercions, \coder | sub g :: :: SubCo {{ com \ctor{SubCo}: Sub-role --- convert nominal to representational }} | ( g ) :: M :: Parens {{ com Parentheses }} | t $ liftingsubst :: M :: Lifted {{ com Type lifted to coercion }} + | downgradeRole R g :: M :: downgradeRole {{ com \textsf{downgradeRole} }} prov :: 'UnivCoProvenance_' ::= {{ com \ctor{UnivCo} provenance, \coderef{types/TyCoRep.hs}{UnivCoProvenance} }} | UnsafeCoerceProv :: :: UnsafeCoerceProv {{ com From \texttt{unsafeCoerce\#} }} @@ -396,8 +398,10 @@ terminals :: 'terminals_' ::= | --> :: :: steps {{ tex \longrightarrow }} | coercionKind :: :: coercionKind {{ tex \textsf{coercionKind} }} | coercionRole :: :: coercionRole {{ tex \textsf{coercionRole} }} + | downgradeRole :: :: downgradeRole {{ tex \textsf{downgradeRole} }} | take :: :: take {{ tex \textsf{take}\! }} | coaxrProves :: :: coaxrProves {{ tex \textsf{coaxrProves} }} + | almostDevoid :: :: almostDevoid {{ tex \textsf{almostDevoid} }} | Just :: :: Just {{ tex \textsf{Just} }} | \\ :: :: newline {{ tex \\ }} | classifiesTypeWithValues :: :: ctwv {{ tex \textsf{classifiesTypeWithValues} }} @@ -483,6 +487,7 @@ formula :: 'formula_' ::= | z elt vars :: :: in_vars | split _ I s = types :: :: split_type {{ tex \mathop{\textsf{split} }_{[[I]]} [[s]] = [[types]] }} + | almostDevoid x g :: :: almostDevoid %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Subrules and Parsing %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ===================================== docs/core-spec/core-spec.mng ===================================== @@ -7,6 +7,7 @@ \usepackage{xcolor} \usepackage{fullpage} \usepackage{multirow} +\usepackage{hyperref} \usepackage{url} \newcommand{\ghcfile}[1]{\textsl{#1}} @@ -106,10 +107,10 @@ There are a few key invariants about expressions: \item The right-hand sides of all top-level and recursive $[[let]]$s must be of lifted type, with one exception: the right-hand side of a top-level $[[let]]$ may be of type \texttt{Addr\#} if it's a primitive string literal. -See \verb|#top_level_invariant#| in \ghcfile{coreSyn/CoreSyn.hs}. +See \verb|#top_level_invariant#| in \ghcfile{GHC.Core}. \item The right-hand side of a non-recursive $[[let]]$ and the argument of an application may be of unlifted type, but only if the expression -is ok-for-speculation. See \verb|#let_app_invariant#| in \ghcfile{coreSyn/CoreSyn.hs}. +is ok-for-speculation. See \verb|#let_app_invariant#| in \ghcfile{GHC.Core}. \item We allow a non-recursive $[[let]]$ for bind a type variable. \item The $[[_]]$ case for a $[[case]]$ must come first. \item The list of case alternatives must be exhaustive. @@ -119,7 +120,7 @@ In other words, the payload inside of a \texttt{Type} constructor must not turn to be built with \texttt{CoercionTy}. \item Join points (introduced by $[[join]]$ expressions) follow the invariants laid out in \verb|Note [Invariants on join points]| in -\ghcfile{coreSyn/CoreSyn.hs}: +\ghcfile{GHC.Core}: \begin{enumerate} \item All occurrences must be tail calls. This is enforced in our typing rules using the label environment $[[D]]$. @@ -166,13 +167,14 @@ A program is just a list of bindings: \gram{\ottprogram} \subsection{Types} +\label{sec:types} \gram{\ottt} \ctor{FunTy} is the special case for non-dependent function type. The -\ctor{TyBinder} in \ghcfile{types/TyCoRep.hs} distinguishes whether a binder is +\ctor{TyBinder} in \ghcfile{GHC.Core.TyCo.Rep} distinguishes whether a binder is anonymous (\ctor{FunTy}) or named (\ctor{ForAllTy}). See -\verb|Note [TyBinders]| in \ghcfile{types/TyCoRep.hs}. +\verb|Note [TyBinders]| in \ghcfile{GHC.Core.TyCo.Rep}. There are some invariants on types: \begin{itemize} @@ -191,7 +193,7 @@ a term-level literal, but we are ignoring this distinction here. \item If $[[forall n. t]]$ is a polymorphic type over a coercion variable (i.e. $[[n]]$ is a coercion variable), then $[[n]]$ must appear in $[[t]]$; otherwise it should be represented as a \texttt{FunTy}. See \texttt{Note - [Unused coercion variable in ForAllTy]} in \ghcfile{types/TyCoRep.hs}. + [Unused coercion variable in ForAllTy]} in \ghcfile{GHC.Core.TyCo.Rep}. \end{itemize} Note that the use of the $[[T ]]$ form and the $[[t1 -> t2]]$ form @@ -216,14 +218,15 @@ Invariants on coercions: reflexive, use $[[T_R ]]$, never $[[ g1 g2]] \ldots$. \item The $[[T]]$ in $[[T_R ]]$ is never a type synonym, though it could be a type function. -\item Every non-reflexive coercion coerces between two distinct types. \item The name in a coercion must be a term-level name (\ctor{Id}). \item The contents of $[[]]$ must not be a coercion. In other words, the payload in a \texttt{Refl} must not be built with \texttt{CoercionTy}. \item If $[[forall z: h .g]]$ is a polymorphic coercion over a coercion variable (i.e. $[[z]]$ is a coercion variable), then $[[z]]$ can only appear in - \texttt{Refl} and \texttt{GRefl} in $[[g]]$. See \texttt{Note[Unused coercion - variable in ForAllCo] in \ghcfile{types/Coercion.hs}}. + \texttt{Refl} and \texttt{GRefl} in $[[g]]$. See \texttt{Note [Unused coercion + variable in ForAllCo] in \ghcfile{GHC.Core.Coercion}}. +\item Prefer $[[g1 ->_R g2]]$ over $[[(->)_R g1 g2]]$; that is, we use \ctor{FunCo}, +never \ctor{TyConAppCo}, for coercions over saturated uses of $[[->]]$. \end{itemize} The \texttt{UnivCo} constructor takes several arguments: the two types coerced @@ -327,7 +330,7 @@ synonym for $[[TYPE 'Unlifted]]$. \section{Contexts} -The functions in \ghcfile{coreSyn/CoreLint.hs} use the \texttt{LintM} monad. +The functions in \ghcfile{GHC.Core.Lint} use the \texttt{LintM} monad. This monad contains a context with a set of bound variables $[[G]]$ and a set of bound labels $[[D]]$. The formalism treats $[[G]]$ and $[[D]]$ as ordered lists, but GHC uses sets as its @@ -432,6 +435,15 @@ a dead id and for one-tuples. These checks are omitted here. \ottdefnlintType{} +Note the contrast between \ottdrulename{Ty\_ForAllTy\_Tv} and \ottdrulename{Ty\_ForAllTy\_Cv}. +The former checks type abstractions, which are erased at runtime. Thus, the kind of the +body must be the same as the kind of the $[[forall]]$-type (as these kinds indicate +the runtime representation). The latter checks coercion abstractions, which are \emph{not} +erased at runtime. Accordingly, the kind of a coercion abstraction is $[[*]]$. The +\ottdrulename{Ty\_ForAllTy\_Cv} rule also asserts that the bound variable $[[x]]$ is +actually used in $[[t]]$: this is to uphold a representation invariant, documented +with the grammar for types, Section~\ref{sec:types}. + \subsection{Kind validity} \ottdefnlintKind{} @@ -451,6 +463,19 @@ and \ottdrulename{Co\_CoVarCoRepr}. See Section~\ref{sec:tyconroles} for more information about $[[tyConRolesX]]$, and see Section~\ref{sec:axiom_rules} for more information about $[[coaxrProves]]$. +The $[[downgradeRole R g]]$ function returns a new coercion that relates the same +types as $[[g]]$ but with role $[[R]]$. It assumes that the role of $[[g]]$ is a +sub-role ($\leq$) of $[[R]]$. + +The $[[almostDevoid x g]]$ function makes sure that, if $[[x]]$ appears at all +in $[[g]]$, it appears only within a \ctor{Refl} or \ctor{GRefl} node. See +Section 5.8.5.2 of Richard Eisenberg's thesis for the details, or the ICFP'17 +paper ``A Specification for Dependently-Typed Haskell''. (Richard's thesis +uses a technical treatment of this idea that's very close to GHC's implementation. +The ICFP'17 paper approaches the same restriction in a different way, by using +\emph{available sets} $\Delta$, as explained in Section 4.2 of that paper. +We believe both technical approaches are equivalent in what coercions they accept.) + \subsection{Name consistency} \label{sec:name_consistency} @@ -463,7 +488,7 @@ There are three very similar checks for names, two performed as part of The point of the extra checks on $[[t']]$ is that a join point's type cannot be polymorphic in its return type; see \texttt{Note [The polymorphism rule of join -points]} in \ghcfile{coreSyn/CoreSyn.hs}. +points]} in \ghcfile{GHC.Core}. \ottdefnlintBinder{} ===================================== docs/core-spec/core-spec.pdf ===================================== Binary files a/docs/core-spec/core-spec.pdf and b/docs/core-spec/core-spec.pdf differ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/9a96ff6b1c19c9d0af9c9a39fb2c086f311c7239 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/9a96ff6b1c19c9d0af9c9a39fb2c086f311c7239 You're receiving 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 Mar 18 15:26:52 2020 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Wed, 18 Mar 2020 11:26:52 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/hadrian-multi-component Message-ID: <5e723dbce8e69_488a3fc6a691ddac194500@gitlab.haskell.org.mail> Matthew Pickering pushed new branch wip/hadrian-multi-component at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/hadrian-multi-component You're receiving 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 Mar 19 06:57:47 2020 From: gitlab at gitlab.haskell.org (=?UTF-8?B?w5ZtZXIgU2luYW4gQcSfYWNhbg==?=) Date: Thu, 19 Mar 2020 02:57:47 -0400 Subject: [Git][ghc/ghc][wip/osa1/lfinfo] 14 commits: Fix #17021 by checking more return kinds Message-ID: <5e7317ebd962b_488a3fc6f93dbda020586c0@gitlab.haskell.org.mail> Ömer Sinan Ağacan pushed to branch wip/osa1/lfinfo at Glasgow Haskell Compiler / GHC Commits: 53ff2cd0 by Richard Eisenberg at 2020-03-17T13:46:57Z 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-18T14:06:43Z Modules: Core operations (#13009) - - - - - 4e8a71c1 by Richard Eisenberg at 2020-03-18T14:07:19Z 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-19T04:39:27Z 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-19T04:40:06Z 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. - - - - - 057ad6f7 by Ömer Sinan Ağacan at 2020-03-19T06:53:31Z Cross-module LambdaFormInfo passing - Store LambdaFormInfos of exported Ids in interface files - Use them in importing modules - - - - - 7b26c4e2 by Ömer Sinan Ağacan at 2020-03-19T06:53:31Z Use IfaceOneShot type in iface LFInfo types - - - - - 79d27a1e by Ömer Sinan Ağacan at 2020-03-19T06:53:31Z Update test T4201 - - - - - 59e6cba7 by Ömer Sinan Ağacan at 2020-03-19T06:53:31Z Revert changes in Maybes - - - - - ede78ab7 by Ömer Sinan Ağacan at 2020-03-19T06:53:31Z Remove unused Eq insts - - - - - 4cd2729d by Ömer Sinan Ağacan at 2020-03-19T06:53:31Z Revert data con work Id LFInfos for now - - - - - b9a4a1f9 by Ömer Sinan Ağacan at 2020-03-19T06:53:32Z Update T4201 again - - - - - 4e764fe8 by Ömer Sinan Ağacan at 2020-03-19T06:53:32Z Update T17648 - - - - - d08be845 by Ömer Sinan Ağacan at 2020-03-19T06:53:32Z Post-rebase fixups - - - - - 30 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/simplCore/CSE.hs → compiler/GHC/Core/Op/CSE.hs - compiler/simplCore/CallArity.hs → compiler/GHC/Core/Op/CallArity.hs - compiler/prelude/PrelRules.hs → compiler/GHC/Core/Op/ConstantFold.hs - compiler/stranal/CprAnal.hs → compiler/GHC/Core/Op/CprAnal.hs - compiler/stranal/DmdAnal.hs → compiler/GHC/Core/Op/DmdAnal.hs - compiler/simplCore/Exitify.hs → compiler/GHC/Core/Op/Exitify.hs - compiler/simplCore/FloatIn.hs → compiler/GHC/Core/Op/FloatIn.hs - compiler/simplCore/FloatOut.hs → compiler/GHC/Core/Op/FloatOut.hs - compiler/simplCore/LiberateCase.hs → compiler/GHC/Core/Op/LiberateCase.hs - compiler/simplCore/CoreMonad.hs → compiler/GHC/Core/Op/Monad.hs - compiler/simplCore/CoreMonad.hs-boot → compiler/GHC/Core/Op/Monad.hs-boot - compiler/simplCore/OccurAnal.hs → compiler/GHC/Core/Op/OccurAnal.hs - compiler/simplCore/SetLevels.hs → compiler/GHC/Core/Op/SetLevels.hs - compiler/simplCore/Simplify.hs → compiler/GHC/Core/Op/Simplify.hs - compiler/simplCore/SimplCore.hs → compiler/GHC/Core/Op/Simplify/Driver.hs - compiler/simplCore/SimplEnv.hs → compiler/GHC/Core/Op/Simplify/Env.hs - compiler/simplCore/SimplMonad.hs → compiler/GHC/Core/Op/Simplify/Monad.hs - compiler/simplCore/SimplUtils.hs → compiler/GHC/Core/Op/Simplify/Utils.hs - compiler/specialise/SpecConstr.hs → compiler/GHC/Core/Op/SpecConstr.hs - compiler/specialise/Specialise.hs → compiler/GHC/Core/Op/Specialise.hs - compiler/simplCore/SAT.hs → compiler/GHC/Core/Op/StaticArgs.hs - compiler/GHC/Core/Op/Tidy.hs - compiler/stranal/WorkWrap.hs → compiler/GHC/Core/Op/WorkWrap.hs - compiler/stranal/WwLib.hs → compiler/GHC/Core/Op/WorkWrap/Lib.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/1c3a7e7a7eb14676adbdafed2dd251724de3f160...d08be8455c8e357e212c7988acb196a9291e99bd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/1c3a7e7a7eb14676adbdafed2dd251724de3f160...d08be8455c8e357e212c7988acb196a9291e99bd You're receiving 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 Mar 18 00:17:51 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 17 Mar 2020 20:17:51 -0400 Subject: [Git][ghc/ghc][ghc-8.10] Bump hsc2hs submodule Message-ID: <5e7168afda2ba_488a3fc6f93dbda018121e1@gitlab.haskell.org.mail> Ben Gamari pushed to branch ghc-8.10 at Glasgow Haskell Compiler / GHC Commits: 4c0a45d1 by Ben Gamari at 2020-03-18T00:16:58Z Bump hsc2hs submodule Fixes Darwin build failure due to CPP whitespace. - - - - - 1 changed file: - utils/hsc2hs Changes: ===================================== utils/hsc2hs ===================================== @@ -1 +1 @@ -Subproject commit 0b9fc7824c0e4e0b8e488f6218940389c42e6121 +Subproject commit ed109c719925e358f68b95970199c4b961de6817 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/4c0a45d1043de427a1f179019e87723b1374bf19 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/4c0a45d1043de427a1f179019e87723b1374bf19 You're receiving 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 Mar 18 13:13:50 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 18 Mar 2020 09:13:50 -0400 Subject: [Git][ghc/ghc][wip/test] 8 commits: Warning about SAKs in release notes Message-ID: <5e721e8eb7d05_488a3fc6f87158a0187405e@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/test at Glasgow Haskell Compiler / GHC Commits: 5c1c4022 by Richard Eisenberg at 2020-03-16T16:47:14Z Warning about SAKs in release notes - - - - - af9eea15 by Ben Gamari at 2020-03-17T02:34:17Z Bump process submodule again - - - - - 3368f4f7 by Ben Gamari at 2020-03-17T02:34:17Z gitlab-ci: Fix integer-simple job - - - - - 90e28e61 by Ben Gamari at 2020-03-17T02:41:53Z Bump hsc2hs to 0.68.7 - - - - - 036133af by Ben Gamari at 2020-03-17T13:46:27Z gitlab-ci: Bootstrap Darwin/Windows with 8.8.3 To ensure we have a new enough process version. - - - - - 848cc69b by Ben Gamari at 2020-03-17T13:46:48Z gitlab-ci: Drop old build.mk logic on Windows - - - - - 4c0a45d1 by Ben Gamari at 2020-03-18T00:16:58Z Bump hsc2hs submodule Fixes Darwin build failure due to CPP whitespace. - - - - - b2cbfdc5 by Ben Gamari at 2020-03-18T13:13:26Z gitlab-ci: Backport CI rework from master - - - - - 9 changed files: - .gitlab-ci.yml - + .gitlab/ci.sh - − .gitlab/prepare-system.sh - − .gitlab/win32-init.sh - docs/users_guide/8.10.1-notes.rst - libraries/process - + mk/get-win32-tarballs.py - − mk/get-win32-tarballs.sh - utils/hsc2hs Changes: ===================================== .gitlab-ci.yml ===================================== @@ -5,17 +5,16 @@ variables: DOCKER_REV: 408eff66aef6ca2b44446c694c5a56d6ca0460cc # Sequential version number capturing the versions of all tools fetched by - # .gitlab/win32-init.sh. + # .gitlab/ci.sh. WINDOWS_TOOLCHAIN_VERSION: 1 # Disable shallow clones; they break our linting rules GIT_DEPTH: 0 -before_script: - - git submodule sync --recursive - - git submodule update --init --recursive - - git checkout .gitmodules - - "git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/perf || true" + # Overridden by individual jobs + CONFIGURE_ARGS: "" + + GIT_SUBMODULE_STRATEGY: "recursive" stages: - lint # Source linting @@ -36,7 +35,18 @@ stages: - tags - web +.nightly: &nightly + only: + variables: + - $NIGHTLY + artifacts: + when: always + expire_in: 8 weeks + .release: &release + variables: + BUILD_FLAVOUR: "perf" + FLAVOUR: "perf" artifacts: when: always expire_in: 1 year @@ -125,8 +135,7 @@ typecheck-testsuite: - base="$(git merge-base FETCH_HEAD $CI_COMMIT_SHA)" - "echo Linting submodule changes between $base..$CI_COMMIT_SHA" - git submodule foreach git remote update - # TODO: Fix submodule linter - - submodchecker . $(git rev-list $base..$CI_COMMIT_SHA) || true + - submodchecker . $(git rev-list $base..$CI_COMMIT_SHA) dependencies: [] tags: - lint @@ -170,11 +179,7 @@ lint-submods-branch: tags: - lint script: - - | - grep TBA libraries/*/changelog.md && ( - echo "Error: Found \"TBA\"s in changelogs." - exit 1 - ) || exit 0 + - bash .gitlab/linters/check-changelogs.sh lint-changelogs: extends: .lint-changelogs @@ -200,25 +205,10 @@ lint-release-changelogs: variables: FLAVOUR: "validate" script: - - cabal update - - git clean -xdf && git submodule foreach git clean -xdf - - .gitlab/prepare-system.sh - - if [[ -d ./cabal-cache ]]; then cp -R ./.cabal-cache ~/.cabal-cache; fi - - ./boot - - ./configure $CONFIGURE_ARGS - - hadrian/build.cabal.sh --flavour=$FLAVOUR -j`mk/detect-cpu-count.sh` --docs=no-sphinx binary-dist - - mv _build/bindist/ghc*.tar.xz ghc.tar.xz - - export TOP=$(pwd) - - cd _build/bindist/ghc-*/ && ./configure --prefix=$TOP/_build/install && make install && cd ../../../ - - | - # Prepare to push git notes. - export METRICS_FILE=$CI_PROJECT_DIR/performance-metrics.tsv - git config user.email "ben+ghc-ci at smart-cactus.org" - git config user.name "GHC GitLab CI" - - hadrian/build.cabal.sh --flavour=$FLAVOUR -j`mk/detect-cpu-count.sh` --docs=no-sphinx test --summary-junit=./junit.xml --test-compiler=$TOP/_build/install/bin/ghc || (.gitlab/push-test-metrics.sh && false) - - | - # Push git notes. - .gitlab/push-test-metrics.sh + - .gitlab/ci.sh setup + - .gitlab/ci.sh configure + - .gitlab/ci.sh build_hadrian + - .gitlab/ci.sh test_hadrian cache: key: hadrian paths: @@ -243,6 +233,8 @@ lint-release-changelogs: - git submodule update --init --recursive - git checkout .gitmodules - "git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/perf || true" + after_script: + - .gitlab/ci.sh clean tags: - x86_64-linux @@ -275,12 +267,12 @@ hadrian-ghc-in-ghci: - cabal update - cd hadrian; cabal new-build --project-file=ci.project; cd .. - git clean -xdf && git submodule foreach git clean -xdf - - .gitlab/prepare-system.sh + - .gitlab/ci.sh setup - if [[ -d ./cabal-cache ]]; then cp -R ./.cabal-cache ~/.cabal-cache; fi - ./boot - ./configure $CONFIGURE_ARGS # Load ghc-in-ghci then immediately exit and check the modules loaded - - echo ":q" | hadrian/ghci.sh -j`mk/detect-cpu-count.sh`| tail -n2 | grep "Ok," + - echo ":q" | hadrian/ghci -j`mk/detect-cpu-count.sh`| tail -n2 | grep "Ok," cache: key: hadrian-ghci paths: @@ -294,27 +286,12 @@ hadrian-ghc-in-ghci: <<: *only-default variables: TEST_TYPE: test - before_script: - - git clean -xdf && git submodule foreach git clean -xdf + MAKE_ARGS: "-Werror" script: - - ./boot - - ./configure $CONFIGURE_ARGS - - | - THREADS=`mk/detect-cpu-count.sh` - make V=0 -j$THREADS WERROR=-Werror - - make binary-dist-prep TAR_COMP_OPTS="-1" - - make test_bindist TEST_PREP=YES - - | - # Prepare to push git notes. - METRICS_FILE=$CI_PROJECT_DIR/performance-metrics.tsv - git config user.email "ben+ghc-ci at smart-cactus.org" - git config user.name "GHC GitLab CI" - - | - THREADS=`mk/detect-cpu-count.sh` - make $TEST_TYPE THREADS=$THREADS JUNIT_FILE=../../junit.xml METRICS_FILE=$METRICS_FILE || (METRICS_FILE=$METRICS_FILE .gitlab/push-test-metrics.sh && false) - - | - # Push git notes. - METRICS_FILE=$METRICS_FILE .gitlab/push-test-metrics.sh + - .gitlab/ci.sh setup + - .gitlab/ci.sh configure + - .gitlab/ci.sh build_make + - .gitlab/ci.sh test_make dependencies: [] artifacts: reports: @@ -325,6 +302,79 @@ hadrian-ghc-in-ghci: - junit.xml - performance-metrics.tsv +################################# +# x86_64-freebsd +################################# + +.build-x86_64-freebsd: + extends: .validate + tags: + - x86_64-freebsd + allow_failure: true + variables: + # N.B. we use iconv from ports as I see linker errors when we attempt + # to use the "native" iconv embedded in libc as suggested by the + # porting guide [1]. + # [1] https://www.freebsd.org/doc/en/books/porters-handbook/using-iconv.html) + CONFIGURE_ARGS: "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib" + GHC_VERSION: 8.6.3 + CABAL_INSTALL_VERSION: 3.0.0.0 + BIN_DIST_PREP_TAR_COMP: "ghc-x86_64-portbld-freebsd.tar.xz" + TEST_ENV: "x86_64-freebsd" + BUILD_FLAVOUR: "validate" + after_script: + - cp -Rf $HOME/.cabal cabal-cache + - .gitlab/ci.sh clean + artifacts: + when: always + expire_in: 2 week + cache: + key: "freebsd-$GHC_VERSION" + paths: + - cabal-cache + - toolchain + +# Disabled due to lack of builder capacity +.validate-x86_64-freebsd: + extends: .build-x86_64-freebsd + stage: full-build + +nightly-x86_64-freebsd: + <<: *nightly + extends: .build-x86_64-freebsd + stage: full-build + +.build-x86_64-freebsd-hadrian: + extends: .validate-hadrian + stage: full-build + tags: + - x86_64-freebsd + allow_failure: true + variables: + CONFIGURE_ARGS: "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib" + HADRIAN_ARGS: "--docs=no-sphinx" + GHC_VERSION: 8.6.3 + CABAL_INSTALL_VERSION: 3.0.0.0 + BIN_DIST_PREP_TAR_COMP: "ghc-x86_64-portbld-freebsd.tar.xz" + TEST_ENV: "x86_64-freebsd-hadrian" + FLAVOUR: "validate" + after_script: + - cp -Rf $HOME/.cabal cabal-cache + - .gitlab/ci.sh clean + artifacts: + when: always + expire_in: 2 week + cache: + key: "freebsd-$GHC_VERSION" + paths: + - cabal-cache + - toolchain + +# Disabled due to lack of builder capacity +.validate-x86_64-freebsd-hadrian: + extends: .build-x86_64-freebsd-hadrian + stage: full-build + ################################# # x86_64-darwin ################################# @@ -336,27 +386,18 @@ validate-x86_64-darwin: - x86_64-darwin variables: GHC_VERSION: 8.6.5 - CABAL_INSTALL_VERSION: 2.4.1.0 + CABAL_INSTALL_VERSION: 3.0.0.0 BIN_DIST_PREP_TAR_COMP: "ghc-x86_64-apple-darwin.tar.xz" MACOSX_DEPLOYMENT_TARGET: "10.7" # Only Sierra and onwards supports clock_gettime. See #12858 ac_cv_func_clock_gettime: "no" - # Only Mojave and onwards supports utimensat. See #17895 - ac_cv_func_utimensat: "no" LANG: "en_US.UTF-8" - CONFIGURE_ARGS: --with-intree-gmp + CONFIGURE_ARGS: "--with-intree-gmp" TEST_ENV: "x86_64-darwin" - before_script: - - git clean -xdf && git submodule foreach git clean -xdf - - git submodule sync --recursive - - git submodule update --init --recursive - - git checkout .gitmodules - - "git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/perf || true" - - - bash .gitlab/darwin-init.sh - - PATH="`pwd`/toolchain/bin:$PATH" + BUILD_FLAVOUR: "perf" after_script: - cp -Rf $HOME/.cabal cabal-cache + - .gitlab/ci.sh clean artifacts: when: always expire_in: 2 week @@ -380,26 +421,14 @@ validate-x86_64-darwin: CONFIGURE_ARGS: --with-intree-gmp TEST_ENV: "x86_64-darwin-hadrian" FLAVOUR: "validate" - before_script: - - git clean -xdf && git submodule foreach git clean -xdf - - git submodule sync --recursive - - git submodule update --init --recursive - - git checkout .gitmodules - - "git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/perf || true" - - - bash .gitlab/darwin-init.sh - - PATH="`pwd`/toolchain/bin:$PATH" script: - - cabal update - - ./boot - - ./configure $CONFIGURE_ARGS - - hadrian/build.cabal.sh --flavour=$FLAVOUR -j`mk/detect-cpu-count.sh` --docs=no-sphinx binary-dist - - mv _build/bindist/ghc*.tar.xz ghc.tar.xz - - export TOP=$(pwd) - - cd _build/bindist/ghc-*/ && ./configure --prefix=$TOP/_build/install && make install && cd ../../../ - - hadrian/build.cabal.sh --flavour=$FLAVOUR -j`mk/detect-cpu-count.sh` --docs=no-sphinx test --summary-junit=./junit.xml --test-compiler=$TOP/_build/install/bin/ghc + - .gitlab/ci.sh setup + - .gitlab/ci.sh configure + - .gitlab/ci.sh build_hadrian + - .gitlab/ci.sh test_hadrian after_script: - cp -Rf $HOME/.cabal cabal-cache + - .gitlab/ci.sh clean artifacts: when: always expire_in: 2 week @@ -413,19 +442,15 @@ validate-x86_64-darwin: extends: .validate tags: - x86_64-linux + variables: + BUILD_FLAVOUR: "perf" before_script: - - git clean -xdf && git submodule foreach git clean -xdf - - git submodule sync --recursive - - git submodule update --init --recursive - - git checkout .gitmodules - - "git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/perf || true" # Build hyperlinked sources for documentation when building releases - | if [[ -n "$CI_COMMIT_TAG" ]]; then - echo "EXTRA_HADDOCK_OPTS += --hyperlinked-source --quickjump" >> mk/build.mk + HADDOCK_HYPERLINKED_SOURCES=1 fi - - .gitlab/prepare-system.sh # workaround for docker permissions - sudo chown ghc:ghc -R . after_script: @@ -460,14 +485,10 @@ validate-aarch64-linux-deb9: expire_in: 2 week nightly-aarch64-linux-deb9: + <<: *nightly extends: .build-aarch64-linux-deb9 - artifacts: - expire_in: 2 year variables: TEST_TYPE: slowtest - only: - variables: - - $NIGHTLY ################################# # armv7-linux-deb9 @@ -477,7 +498,6 @@ nightly-aarch64-linux-deb9: extends: .validate-linux stage: full-build image: "registry.gitlab.haskell.org/ghc/ci-images/armv7-linux-deb9:$DOCKER_REV" - allow_failure: true variables: TEST_ENV: "armv7-linux-deb9" BIN_DIST_PREP_TAR_COMP: "ghc-armv7-linux-deb9.tar.xz" @@ -494,14 +514,10 @@ validate-armv7-linux-deb9: expire_in: 2 week nightly-armv7-linux-deb9: + <<: *nightly extends: .build-armv7-linux-deb9 - artifacts: - expire_in: 2 year variables: TEST_TYPE: slowtest - only: - variables: - - $NIGHTLY ################################# # i386-linux-deb9 @@ -524,15 +540,10 @@ validate-i386-linux-deb9: expire_in: 2 week nightly-i386-linux-deb9: + <<: *nightly extends: .build-i386-linux-deb9 variables: TEST_TYPE: slowtest - artifacts: - when: always - expire_in: 2 week - only: - variables: - - $NIGHTLY ################################# # x86_64-linux-deb9 @@ -561,20 +572,16 @@ release-x86_64-linux-deb9: stage: full-build nightly-x86_64-linux-deb9: + <<: *nightly extends: .build-x86_64-linux-deb9 stage: full-build - artifacts: - expire_in: 2 year variables: TEST_TYPE: slowtest - only: - variables: - - $NIGHTLY # N.B. Has DEBUG assertions enabled in stage2 validate-x86_64-linux-deb9-debug: extends: .build-x86_64-linux-deb9 - stage: build + stage: full-build variables: BUILD_FLAVOUR: validate # Ensure that stage2 also has DEBUG enabled @@ -583,7 +590,7 @@ validate-x86_64-linux-deb9-debug: BUILD_SPHINX_PDF: "YES" TEST_TYPE: slowtest TEST_ENV: "x86_64-linux-deb9-debug" - BIN_DIST_PREP_COMP: "ghc-x86_64-deb9-linux-debug.tar.xz" + BIN_DIST_PREP_TAR_COMP: "ghc-x86_64-deb9-linux-debug.tar.xz" artifacts: when: always expire_in: 2 week @@ -597,39 +604,34 @@ validate-x86_64-linux-deb9-debug: TEST_ENV: "x86_64-linux-deb9-llvm" nightly-x86_64-linux-deb9-llvm: + <<: *nightly extends: .build-x86_64-linux-deb9 stage: full-build variables: BUILD_FLAVOUR: perf-llvm TEST_ENV: "x86_64-linux-deb9-llvm" - only: - variables: - - $NIGHTLY validate-x86_64-linux-deb9-integer-simple: extends: .build-x86_64-linux-deb9 stage: full-build variables: + BUILD_FLAVOUR: validate INTEGER_LIBRARY: integer-simple - TEST_ENV: "x86_64-linux-deb9-integer-simple" + TEST_ENV: "x86_64-linux-deb9-integer-simple-validate" BIN_DIST_PREP_TAR_COMP: "ghc-x86_64-deb9-linux-integer-simple.tar.xz" nightly-x86_64-linux-deb9-integer-simple: + <<: *nightly extends: .build-x86_64-linux-deb9 stage: full-build variables: INTEGER_LIBRARY: integer-simple TEST_ENV: "x86_64-linux-deb9-integer-simple" TEST_TYPE: slowtest - artifacts: - expire_in: 2 year - only: - variables: - - $NIGHTLY validate-x86_64-linux-deb9-dwarf: extends: .build-x86_64-linux-deb9 - stage: build + stage: full-build variables: CONFIGURE_ARGS: "--enable-dwarf-unwind" BUILD_FLAVOUR: dwarf @@ -656,14 +658,10 @@ validate-x86_64-linux-deb9-dwarf: stage: full-build nightly-x86_64-linux-deb10: + <<: *nightly extends: .build-x86_64-linux-deb10 - artifacts: - expire_in: 2 weeks variables: TEST_TYPE: slowtest - only: - variables: - - $NIGHTLY release-x86_64-linux-deb10: <<: *release @@ -698,19 +696,21 @@ release-x86_64-linux-deb8: # x86_64-linux-alpine ################################# -.build-x86_64-linux-alpine: - extends: .validate-linux +.build-x86_64-linux-alpine-hadrian: + extends: .validate-linux-hadrian stage: full-build image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine:$DOCKER_REV" # There are currently a few failing tests allow_failure: true variables: - BUILD_SPHINX_PDF: "NO" TEST_ENV: "x86_64-linux-alpine" BIN_DIST_PREP_TAR_COMP: "ghc-x86_64-alpine-linux.tar.xz" # Can't use ld.gold due to #13958. CONFIGURE_ARGS: "--disable-ld-override" - INTEGER_LIBRARY: "integer-simple" + HADRIAN_ARGS: "--docs=no-sphinx" + # encoding004 due to lack of locale support + # T10458 due to fact that dynamic linker tries to reload libAS + BROKEN_TESTS: "encoding004 T10458" cache: key: linux-x86_64-alpine artifacts: @@ -719,13 +719,11 @@ release-x86_64-linux-deb8: release-x86_64-linux-alpine: <<: *release - extends: .build-x86_64-linux-alpine + extends: .build-x86_64-linux-alpine-hadrian nightly-x86_64-linux-alpine: - extends: .build-x86_64-linux-alpine - only: - variables: - - $NIGHTLY + <<: *nightly + extends: .build-x86_64-linux-alpine-hadrian ################################# # x86_64-linux-centos7 @@ -775,58 +773,49 @@ validate-x86_64-linux-fedora27: .build-windows: <<: *only-default + # For the reasons given in #17777 this build isn't reliable. + allow_failure: true before_script: - git clean -xdf - - git submodule foreach git clean -xdf - # Use a local temporary directory to ensure that concurrent builds don't - # interfere with one another - - | - mkdir tmp - set TMP=%cd%\tmp - set TEMP=%cd%\tmp - - - set PATH=C:\msys64\usr\bin;%PATH% - - git submodule sync --recursive - - git submodule update --init --recursive - - git checkout .gitmodules - - "git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/perf || true" - - bash .gitlab/win32-init.sh + # Setup toolchain + - bash .gitlab/ci.sh setup after_script: - - rd /s /q tmp - - robocopy /np /nfl /ndl /e "%APPDATA%\cabal" cabal-cache - - bash -c 'make clean || true' + - | + Copy-Item -Recurse -Path $Env:APPDATA\cabal -Destination cabal-cache + - bash .gitlab/ci.sh clean dependencies: [] variables: - FORCE_SYMLINKS: 1 + #FORCE_SYMLINKS: 1 LANG: "en_US.UTF-8" SPHINXBUILD: "/mingw64/bin/sphinx-build.exe" + CABAL_INSTALL_VERSION: 3.0.0.0 + GHC_VERSION: "8.8.3" cache: paths: - cabal-cache - - ghc-8.6.5 + - toolchain - ghc-tarballs .build-windows-hadrian: extends: .build-windows stage: full-build variables: - GHC_VERSION: "8.6.5" FLAVOUR: "validate" + # skipping perf tests for now since we build a quick-flavoured GHC, + # which might result in some broken perf tests? + HADRIAN_ARGS: "--docs=no-sphinx --skip-perf" + # due to #16574 this currently fails allow_failure: true + script: - - | - python boot - bash -c './configure --enable-tarballs-autodownload GHC=`pwd`/toolchain/bin/ghc HAPPY=`pwd`/toolchain/bin/happy ALEX=`pwd`/toolchain/bin/alex' - - bash -c "PATH=`pwd`/toolchain/bin:$PATH hadrian/build.cabal.sh --flavour=$FLAVOUR -j`mk/detect-cpu-count.sh` --flavour=Quick --docs=no-sphinx binary-dist" - - mv _build/bindist/ghc*.tar.xz ghc.tar.xz - - bash -c "export TOP=$(pwd); cd _build/bindist/ghc-*/ && PATH=$TOP/toolchain/bin:$PATH ./configure --prefix=$TOP/_build/install && make install && cd ../../../" - - bash -c "export TOP=$(pwd); PATH=$TOP/toolchain/bin:$PATH hadrian/build.cabal.sh --flavour=$FLAVOUR -j`mk/detect-cpu-count.sh` --flavour=quick test --summary-junit=./junit.xml --skip-perf --test-compiler=$TOP/_build/install/bin/ghc" - # skipping perf tests for now since we build a quick-flavoured GHC, - # which might result in some broken perf tests? + - bash .gitlab/ci.sh configure + - bash .gitlab/ci.sh build_hadrian + - bash .gitlab/ci.sh test_hadrian tags: - - x86_64-windows + - new-x86_64-windows + - test artifacts: reports: junit: junit.xml @@ -845,36 +834,27 @@ validate-x86_64-windows-hadrian: key: "x86_64-windows-hadrian-$WINDOWS_TOOLCHAIN_VERSION" nightly-i386-windows-hadrian: + <<: *nightly extends: .build-windows-hadrian variables: MSYSTEM: MINGW32 TEST_ENV: "i386-windows-hadrian" - only: - variables: - - $NIGHTLY cache: key: "i386-windows-hadrian-$WINDOWS_TOOLCHAIN_VERSION" .build-windows-make: extends: .build-windows stage: full-build - allow_failure: true variables: BUILD_FLAVOUR: "quick" - GHC_VERSION: "8.6.5" BIN_DIST_PREP_TAR_COMP: "ghc-x86_64-mingw32.tar.xz" script: - - | - python boot - bash -c './configure --enable-tarballs-autodownload GHC=`pwd`/toolchain/bin/ghc HAPPY=`pwd`/toolchain/bin/happy ALEX=`pwd`/toolchain/bin/alex $CONFIGURE_ARGS' - - bash -c "echo include mk/flavours/${BUILD_FLAVOUR}.mk > mk/build.mk" - - bash -c "echo 'GhcLibHcOpts+=-haddock' >> mk/build.mk" - - bash -c "PATH=`pwd`/toolchain/bin:$PATH make -j`mk/detect-cpu-count.sh`" - - bash -c "PATH=`pwd`/toolchain/bin:$PATH make binary-dist-prep TAR_COMP_OPTS=-1" - - bash -c "PATH=`pwd`/toolchain/bin:$PATH make test_bindist TEST_PREP=YES" - - bash -c 'make V=0 test PYTHON=/mingw64/bin/python3 THREADS=`mk/detect-cpu-count.sh` JUNIT_FILE=../../junit.xml' + - bash .gitlab/ci.sh configure + - bash .gitlab/ci.sh build_make + - bash .gitlab/ci.sh test_make tags: - - x86_64-windows + - new-x86_64-windows + - test artifacts: when: always expire_in: 2 week @@ -882,77 +862,69 @@ nightly-i386-windows-hadrian: junit: junit.xml paths: # N.B. variable interpolation apparently doesn't work on Windows so - # this can't be $BIN_DIST_TAR_COMP + # this can't be $BIN_DIST_PREP_TAR_COMP - "ghc-x86_64-mingw32.tar.xz" - junit.xml -validate-x86_64-windows: +.build-x86_64-windows-make: extends: .build-windows-make variables: MSYSTEM: MINGW64 - CONFIGURE_ARGS: "--target=x86_64-unknown-mingw32" TEST_ENV: "x86_64-windows" cache: key: "x86_64-windows-$WINDOWS_TOOLCHAIN_VERSION" +validate-x86_64-windows: + extends: .build-x86_64-windows-make + nightly-x86_64-windows: - extends: .build-windows-make + <<: *nightly + extends: .build-x86_64-windows-make stage: full-build variables: BUILD_FLAVOUR: "validate" - MSYSTEM: MINGW64 - CONFIGURE_ARGS: "--target=x86_64-unknown-mingw32" - only: - variables: - - $NIGHTLY - cache: - key: "x86_64-windows-$WINDOWS_TOOLCHAIN_VERSION" # Normal Windows validate builds are profiled; that won't do for releases. release-x86_64-windows: <<: *release extends: validate-x86_64-windows variables: - MSYSTEM: MINGW64 BUILD_FLAVOUR: "perf" - CONFIGURE_ARGS: "--target=x86_64-unknown-mingw32" - TEST_ENV: "x86_64-windows" - + # release-x86_64-windows-integer-simple: <<: *release extends: validate-x86_64-windows variables: INTEGER_LIBRARY: integer-simple BUILD_FLAVOUR: "perf" - CONFIGURE_ARGS: "--target=x86_64-unknown-mingw32" - TEST_ENV: "x86_64-windows" -release-i386-windows: - <<: *release + +.build-i386-windows-make: extends: .build-windows-make variables: MSYSTEM: MINGW32 - BUILD_FLAVOUR: "perf" - CONFIGURE_ARGS: "--target=i386-unknown-mingw32" # Due to #15934 BUILD_PROF_LIBS: "NO" TEST_ENV: "i386-windows" + # Due to #17736 + allow_failure: true cache: key: "i386-windows-$WINDOWS_TOOLCHAIN_VERSION" -nightly-i386-windows: - extends: .build-windows-make - only: - variables: - - $NIGHTLY +validate-i386-windows: + extends: .build-i386-windows-make variables: - MSYSTEM: MINGW32 - CONFIGURE_ARGS: "--target=i386-unknown-mingw32" - # Due to #15934 - BUILD_PROF_LIBS: "NO" - TEST_ENV: "i386-windows" - cache: - key: "i386-windows-$WINDOWS_TOOLCHAIN_VERSION" + BUILD_FLAVOUR: "perf" + +release-i386-windows: + <<: *release + extends: .build-i386-windows-make + variables: + BUILD_FLAVOUR: "perf" + +nightly-i386-windows: + <<: *nightly + extends: .build-i386-windows-make ############################################################ # Cleanup @@ -1008,7 +980,7 @@ doc-tarball: - validate-x86_64-linux-deb9-debug - validate-x86_64-windows variables: - LINUX_BINDIST: "ghc-x86_64-deb9-linux.tar.xz" + LINUX_BINDIST: "ghc-x86_64-deb9-linux-debug.tar.xz" WINDOWS_BINDIST: "ghc-x86_64-mingw32.tar.xz" # Due to Windows allow_failure allow_failure: true @@ -1048,7 +1020,7 @@ source-tarball: - ghc-*.tar.xz - version script: - - mk/get-win32-tarballs.sh download all + - python3 mk/get-win32-tarballs.py download all - ./boot - ./configure - make sdist @@ -1091,10 +1063,8 @@ hackage-label: - $CI_MERGE_REQUEST_LABELS =~ /.*user-facing.*/ nightly-hackage: + <<: *nightly extends: .hackage - only: - variables: - - $NIGHTLY ############################################################ # Nofib testing ===================================== .gitlab/ci.sh ===================================== @@ -0,0 +1,454 @@ +#!/usr/bin/env bash +# shellcheck disable=SC2230 + +# This is the primary driver of the GitLab CI infrastructure. + +set -e -o pipefail + +# Configuration: +hackage_index_state="@1579718451" + +# Colors +BLACK="0;30" +GRAY="1;30" +RED="0;31" +LT_RED="1;31" +BROWN="0;33" +LT_BROWN="1;33" +GREEN="0;32" +LT_GREEN="1;32" +BLUE="0;34" +LT_BLUE="1;34" +PURPLE="0;35" +LT_PURPLE="1;35" +CYAN="0;36" +LT_CYAN="1;36" +WHITE="1;37" +LT_GRAY="0;37" + +# GitLab Pipelines log section delimiters +# https://gitlab.com/gitlab-org/gitlab-foss/issues/14664 +start_section() { + name="$1" + echo -e "section_start:$(date +%s):$name\015\033[0K" +} + +end_section() { + name="$1" + echo -e "section_end:$(date +%s):$name\015\033[0K" +} + +echo_color() { + local color="$1" + local msg="$2" + echo -e "\033[${color}m${msg}\033[0m" +} + +error() { echo_color "${RED}" "$1"; } +warn() { echo_color "${LT_BROWN}" "$1"; } +info() { echo_color "${LT_BLUE}" "$1"; } + +fail() { error "error: $1"; exit 1; } + +function run() { + info "Running $*..." + "$@" || ( error "$* failed"; return 1; ) +} + +TOP="$(pwd)" + +function mingw_init() { + case "$MSYSTEM" in + MINGW32) + triple="i386-unknown-mingw32" + boot_triple="i386-unknown-mingw32" # triple of bootstrap GHC + ;; + MINGW64) + triple="x86_64-unknown-mingw32" + boot_triple="x86_64-unknown-mingw32" # triple of bootstrap GHC + ;; + *) + fail "win32-init: Unknown MSYSTEM $MSYSTEM" + ;; + esac + + # Bring mingw toolchain into PATH. + # This is extracted from /etc/profile since this script inexplicably fails to + # run under gitlab-runner. + # shellcheck disable=SC1091 + source /etc/msystem + MINGW_MOUNT_POINT="${MINGW_PREFIX}" + PATH="$MINGW_MOUNT_POINT/bin:$PATH" + + # We always use mingw64 Python to avoid path length issues like #17483. + export PYTHON="/mingw64/bin/python3" +} + +# This will contain GHC's local native toolchain +toolchain="$TOP/toolchain" +mkdir -p "$toolchain/bin" +PATH="$toolchain/bin:$PATH" + +export METRICS_FILE="$CI_PROJECT_DIR/performance-metrics.tsv" + +cores="$(mk/detect-cpu-count.sh)" + +# Use a local temporary directory to ensure that concurrent builds don't +# interfere with one another +mkdir -p "$TOP/tmp" +export TMP="$TOP/tmp" +export TEMP="$TOP/tmp" + +function darwin_setup() { + # It looks like we already have python2 here and just installing python3 + # does not work. + brew upgrade python + brew install ghc cabal-install ncurses gmp + + pip3 install sphinx + # PDF documentation disabled as MacTeX apparently doesn't include xelatex. + #brew cask install mactex +} + +function show_tool() { + local tool="$1" + info "$tool = ${!tool}" + ${!tool} --version +} + +function set_toolchain_paths() { + needs_toolchain=1 + case "$(uname)" in + Linux) needs_toolchain="" ;; + *) ;; + esac + + if [[ -n "$needs_toolchain" ]]; then + # These are populated by setup_toolchain + GHC="$toolchain/bin/ghc$exe" + CABAL="$toolchain/bin/cabal$exe" + HAPPY="$toolchain/bin/happy$exe" + ALEX="$toolchain/bin/alex$exe" + else + GHC="$(which ghc)" + CABAL="/usr/local/bin/cabal" + HAPPY="$HOME/.cabal/bin/happy" + ALEX="$HOME/.cabal/bin/alex" + fi + export GHC + export CABAL + export HAPPY + export ALEX + + # FIXME: Temporarily use ghc from ports + case "$(uname)" in + FreeBSD) GHC="/usr/local/bin/ghc" ;; + *) ;; + esac +} + +# Extract GHC toolchain +function setup() { + if [ -d "$TOP/cabal-cache" ]; then + info "Extracting cabal cache..." + mkdir -p "$cabal_dir" + cp -Rf cabal-cache/* "$cabal_dir" + fi + + if [[ -n "$needs_toolchain" ]]; then + setup_toolchain + fi + case "$(uname)" in + Darwin) darwin_setup ;; + *) ;; + esac + + # Make sure that git works + git config user.email "ghc-ci at gitlab-haskell.org" + git config user.name "GHC GitLab CI" + + info "=====================================================" + info "Toolchain versions" + info "=====================================================" + show_tool GHC + show_tool CABAL + show_tool HAPPY + show_tool ALEX +} + +function fetch_ghc() { + local v="$GHC_VERSION" + if [[ -z "$v" ]]; then + fail "GHC_VERSION is not set" + fi + + if [ ! -e "$GHC" ]; then + start_section "fetch GHC" + url="https://downloads.haskell.org/~ghc/${GHC_VERSION}/ghc-${GHC_VERSION}-${boot_triple}.tar.xz" + info "Fetching GHC binary distribution from $url..." + curl "$url" > ghc.tar.xz || fail "failed to fetch GHC binary distribution" + tar -xJf ghc.tar.xz || fail "failed to extract GHC binary distribution" + case "$(uname)" in + MSYS_*|MINGW*) + cp -r "ghc-${GHC_VERSION}"/* "$toolchain" + ;; + *) + pushd "ghc-${GHC_VERSION}" + ./configure --prefix="$toolchain" + "$MAKE" install + popd + ;; + esac + rm -Rf "ghc-${GHC_VERSION}" ghc.tar.xz + end_section "fetch GHC" + fi + +} + +function fetch_cabal() { + local v="$CABAL_INSTALL_VERSION" + if [[ -z "$v" ]]; then + fail "CABAL_INSTALL_VERSION is not set" + fi + + if [ ! -e "$CABAL" ]; then + start_section "fetch GHC" + case "$(uname)" in + # N.B. Windows uses zip whereas all others use .tar.xz + MSYS_*|MINGW*) + case "$MSYSTEM" in + MINGW32) cabal_arch="i386" ;; + MINGW64) cabal_arch="x86_64" ;; + *) fail "unknown MSYSTEM $MSYSTEM" ;; + esac + url="https://downloads.haskell.org/~cabal/cabal-install-$v/cabal-install-$v-$cabal_arch-unknown-mingw32.zip" + info "Fetching cabal binary distribution from $url..." + curl "$url" > "$TMP/cabal.zip" + unzip "$TMP/cabal.zip" + mv cabal.exe "$CABAL" + ;; + *) + local base_url="https://downloads.haskell.org/~cabal/cabal-install-$v/" + case "$(uname)" in + Darwin) cabal_url="$base_url/cabal-install-$v-x86_64-apple-darwin17.7.0.tar.xz" ;; + FreeBSD) + #cabal_url="$base_url/cabal-install-$v-x86_64-portbld-freebsd.tar.xz" ;; + cabal_url="http://home.smart-cactus.org/~ben/ghc/cabal-install-3.0.0.0-x86_64-portbld-freebsd.tar.xz" ;; + *) fail "don't know where to fetch cabal-install for $(uname)" + esac + echo "Fetching cabal-install from $cabal_url" + curl "$cabal_url" > cabal.tar.xz + tar -xJf cabal.tar.xz + mv cabal "$toolchain/bin" + ;; + esac + end_section "fetch GHC" + fi +} + +# For non-Docker platforms we prepare the bootstrap toolchain +# here. For Docker platforms this is done in the Docker image +# build. +function setup_toolchain() { + fetch_ghc + fetch_cabal + cabal_install="$CABAL v2-install --index-state=$hackage_index_state --installdir=$toolchain/bin" + # Avoid symlinks on Windows + case "$(uname)" in + MSYS_*|MINGW*) cabal_install="$cabal_install --install-method=copy" ;; + *) ;; + esac + + if [ ! -e "$HAPPY" ]; then + info "Building happy..." + cabal update + $cabal_install happy + fi + + if [ ! -e "$ALEX" ]; then + info "Building alex..." + cabal update + $cabal_install alex + fi +} + +function cleanup_submodules() { + start_section "clean submodules" + info "Cleaning submodules..." + # On Windows submodules can inexplicably get into funky states where git + # believes that the submodule is initialized yet its associated repository + # is not valid. Avoid failing in this case with the following insanity. + git submodule sync --recursive || git submodule deinit --force --all + git submodule update --init --recursive + git submodule foreach git clean -xdf + end_section "clean submodules" +} + +function prepare_build_mk() { + if [[ -z "$BUILD_FLAVOUR" ]]; then fail "BUILD_FLAVOUR is not set"; fi + if [[ -z ${BUILD_SPHINX_HTML:-} ]]; then BUILD_SPHINX_HTML=YES; fi + if [[ -z ${BUILD_SPHINX_PDF:-} ]]; then BUILD_SPHINX_PDF=YES; fi + if [[ -z ${INTEGER_LIBRARY:-} ]]; then INTEGER_LIBRARY=integer-gmp; fi + + cat > mk/build.mk <> mk/build.mk + fi + + case "$(uname)" in + Darwin) echo "libraries/integer-gmp_CONFIGURE_OPTS += --configure-option=--with-intree-gmp" >> mk/build.mk ;; + *) ;; + esac + + info "build.mk is:" + cat mk/build.mk +} + +function configure() { + start_section "booting" + run python3 boot + end_section "booting" + + local target_args="" + if [[ -n "$triple" ]]; then + target_args="--target=$triple" + fi + + start_section "configuring" + run ./configure \ + --enable-tarballs-autodownload \ + $target_args \ + $CONFIGURE_ARGS \ + GHC="$GHC" \ + HAPPY="$HAPPY" \ + ALEX="$ALEX" \ + || ( cat config.log; fail "configure failed" ) + end_section "configuring" +} + +function build_make() { + prepare_build_mk + if [[ -z "$BIN_DIST_PREP_TAR_COMP" ]]; then + fail "BIN_DIST_PREP_TAR_COMP is not set" + fi + + echo "include mk/flavours/${BUILD_FLAVOUR}.mk" > mk/build.mk + echo 'GhcLibHcOpts+=-haddock' >> mk/build.mk + run "$MAKE" -j"$cores" $MAKE_ARGS + run "$MAKE" -j"$cores" binary-dist-prep TAR_COMP_OPTS=-1 + ls -lh "$BIN_DIST_PREP_TAR_COMP" +} + +function fetch_perf_notes() { + info "Fetching perf notes..." + "$TOP/.gitlab/test-metrics.sh" pull +} + +function push_perf_notes() { + info "Pushing perf notes..." + "$TOP/.gitlab/test-metrics.sh" push +} + +function test_make() { + run "$MAKE" test_bindist TEST_PREP=YES + run "$MAKE" V=0 test \ + THREADS="$cores" \ + JUNIT_FILE=../../junit.xml +} + +function build_hadrian() { + if [ -z "$FLAVOUR" ]; then + fail "FLAVOUR not set" + fi + + run_hadrian binary-dist + + mv _build/bindist/ghc*.tar.xz ghc.tar.xz +} + +function test_hadrian() { + cd _build/bindist/ghc-*/ + run ./configure --prefix="$TOP"/_build/install + run "$MAKE" install + cd ../../../ + + run_hadrian \ + test \ + --summary-junit=./junit.xml \ + --test-compiler="$TOP"/_build/install/bin/ghc +} + +function clean() { + rm -R tmp + run "$MAKE" --quiet clean || true + run rm -Rf _build +} + +function run_hadrian() { + run hadrian/build-cabal \ + --flavour="$FLAVOUR" \ + -j"$cores" \ + --broken-test="$BROKEN_TESTS" \ + $HADRIAN_ARGS \ + $@ +} + +# A convenience function to allow debugging in the CI environment. +function shell() { + local cmd=$@ + if [ -z "$cmd" ]; then + cmd="bash -i" + fi + run $cmd +} + +# Determine Cabal data directory +case "$(uname)" in + MSYS_*|MINGW*) exe=".exe"; cabal_dir="$APPDATA/cabal" ;; + *) cabal_dir="$HOME/.cabal"; exe="" ;; +esac + +# Platform-specific environment initialization +MAKE="make" +case "$(uname)" in + MSYS_*|MINGW*) mingw_init ;; + Darwin) boot_triple="x86_64-apple-darwin" ;; + FreeBSD) + boot_triple="x86_64-portbld-freebsd" + MAKE="gmake" + ;; + Linux) ;; + *) fail "uname $(uname) is not supported" ;; +esac + +set_toolchain_paths + +case $1 in + setup) setup && cleanup_submodules ;; + configure) configure ;; + build_make) build_make ;; + test_make) fetch_perf_notes; test_make; push_perf_notes ;; + build_hadrian) build_hadrian ;; + test_hadrian) fetch_perf_notes; test_hadrian; push_perf_notes ;; + run_hadrian) run_hadrian $@ ;; + clean) clean ;; + shell) shell $@ ;; + *) fail "unknown mode $1" ;; +esac ===================================== .gitlab/prepare-system.sh deleted ===================================== @@ -1,99 +0,0 @@ -#!/usr/bin/env bash -# vim: sw=2 et -set -euo pipefail - -fail() { - echo "ERROR: $*" >&2 - exit 1 -} - -hackage_index_state="@1522046735" - -if [[ -z ${BUILD_SPHINX_HTML:-} ]]; then BUILD_SPHINX_HTML=YES; fi -if [[ -z ${BUILD_SPHINX_PDF:-} ]]; then BUILD_SPHINX_PDF=YES; fi -if [[ -z ${INTEGER_LIBRARY:-} ]]; then INTEGER_LIBRARY=integer-gmp; fi -if [[ -z ${BUILD_FLAVOUR:-} ]]; then BUILD_FLAVOUR=perf; fi - -if [[ -z ${XZ:-} ]]; then - if which pxz; then - XZ="pxz" - elif which xz; then - # Check whether --threads is supported - if echo "hello" | xz --threads=$CORES >/dev/null; then - XZ="xz --threads=$CORES" - else - XZ="xz" - fi - else - echo "error: neither pxz nor xz were found" - exit 1 - fi -fi -echo "Using $XZ for compression..." - - -cat > mk/build.mk <> mk/build.mk -BuildFlavour=$BUILD_FLAVOUR -ifneq "\$(BuildFlavour)" "" -include mk/flavours/\$(BuildFlavour).mk -endif -GhcLibHcOpts+=-haddock -EOF - -case "$(uname)" in - Linux) - if [[ -n ${TARGET:-} ]]; then - if [[ $TARGET = FreeBSD ]]; then - # cross-compiling to FreeBSD - echo 'HADDOCK_DOCS = NO' >> mk/build.mk - echo 'WERROR=' >> mk/build.mk - # https://circleci.com/docs/2.0/env-vars/#interpolating-environment-variables-to-set-other-environment-variables - echo 'export PATH=/opt/ghc/bin:$PATH' >> $BASH_ENV - else - fail "TARGET=$target not supported" - fi - fi - ;; - - Darwin) - if [[ -n ${TARGET:-} ]]; then - fail "uname=$(uname) not supported for cross-compilation" - fi - # It looks like we already have python2 here and just installing python3 - # does not work. - brew upgrade python - brew install ghc cabal-install ncurses gmp - - pip3 install sphinx - # PDF documentation disabled as MacTeX apparently doesn't include xelatex. - #brew cask install mactex - - cabal update - cabal install --reinstall alex happy haddock hscolour --index-state=$hackage_index_state - # put them on the $PATH, don't fail if already installed - ln -s $HOME/.cabal/bin/alex /usr/local/bin/alex || true - ln -s $HOME/.cabal/bin/happy /usr/local/bin/happy || true - ln -s $HOME/.cabal/bin/HsColour /usr/local/bin/HsColour || true - echo "libraries/integer-gmp_CONFIGURE_OPTS += --configure-option=--with-intree-gmp" >> mk/build.mk - ;; - *) - fail "uname=$(uname) not supported" -esac - -echo "=================================================" -echo "Build.mk:" -echo "" -cat mk/build.mk -echo "=================================================" ===================================== .gitlab/win32-init.sh deleted ===================================== @@ -1,47 +0,0 @@ -#!/bin/bash - -set -e - -toolchain=`pwd`/toolchain -PATH="$toolchain/bin:/mingw64/bin:$PATH" - -if [ -d "`pwd`/cabal-cache" ]; then - cp -Rf cabal-cache $APPDATA/cabal -fi - -if [ ! -e $toolchain/bin/ghc ]; then - case $MSYSTEM in - MINGW32) - triple="i386-unknown-mingw32" - ;; - MINGW64) - triple="x86_64-unknown-mingw32" - ;; - *) - echo "win32-init: Unknown MSYSTEM $MSYSTEM" - exit 1 - ;; - esac - curl https://downloads.haskell.org/~ghc/$GHC_VERSION/ghc-$GHC_VERSION-$triple.tar.xz | tar -xJ - mv ghc-$GHC_VERSION toolchain -fi - -if [ ! -e $toolchain/bin/cabal ]; then - url="https://downloads.haskell.org/~cabal/cabal-install-2.4.1.0/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 - -if [ ! -e $toolchain/bin/happy ]; then - cabal update - cabal install happy - cp $APPDATA/cabal/bin/happy $toolchain/bin -fi - -if [ ! -e $toolchain/bin/alex ]; then - cabal update - cabal install alex - cp $APPDATA/cabal/bin/alex $toolchain/bin -fi - ===================================== docs/users_guide/8.10.1-notes.rst ===================================== @@ -66,6 +66,11 @@ Language ` enables polymorphic recursion. This feature is a replacement for :extension:`CUSKs`. + **Note:** The finer points around this feature are subject to change. In particular, + it is likely that the treatment around :ref:`specified and inferred ` + variables may change, to become more like the way term-level type signatures are + handled. + - GHC now parses visible, dependent quantifiers (as proposed in `GHC proposal 35 `__), ===================================== libraries/process ===================================== @@ -1 +1 @@ -Subproject commit 062a69e2a5b4d5e51c896ee5d0433588b8f4d05c +Subproject commit 21149358df25d742cc79ce55510aa82f246e7044 ===================================== mk/get-win32-tarballs.py ===================================== @@ -0,0 +1,59 @@ +#!/usr/bin/env python +# -*- coding: utf-8 -*- + +from pathlib import Path +import urllib.request +import subprocess +import argparse + +TARBALL_VERSION = '0.1' +BASE_URL = "https://downloads.haskell.org/ghc/mingw/{}".format(TARBALL_VERSION) +BASE_URL = "http://home.smart-cactus.org/~ben/ghc/mingw/{}".format(TARBALL_VERSION) +DEST = Path('ghc-tarballs/mingw-w64') +ARCHS = ['i686', 'x86_64', 'sources'] + +def file_url(arch: str, fname: str) -> str: + return "{base}/{arch}/{fname}".format( + base=BASE_URL, + arch=arch, + fname=fname) + +def fetch(url: str, dest: Path): + print('Fetching', url, '=>', dest) + urllib.request.urlretrieve(url, dest) + +def fetch_arch(arch: str): + req = urllib.request.urlopen(file_url(arch, 'MANIFEST')) + files = req.read().decode('UTF-8').split('\n') + d = DEST / arch + if not d.is_dir(): + d.mkdir(parents=True) + fetch(file_url(arch, 'SHA256SUMS'), d / 'SHA256SUMS') + for fname in files: + if not (d / fname).is_file(): + fetch(file_url(arch, fname), d / fname) + + verify(arch) + +def verify(arch: str): + cmd = ['sha256sum', '--quiet', '--check', '--ignore-missing', 'SHA256SUMS'] + subprocess.check_call(cmd, cwd=DEST / arch) + +def main() -> None: + parser = argparse.ArgumentParser() + parser.add_argument('mode', choices=['verify', 'download']) + parser.add_argument( + 'arch', + choices=ARCHS + ['all'], + help="Architecture to fetch (either i686, x86_64, sources, or all)") + args = parser.parse_args() + + action = fetch_arch if args.mode == 'download' else verify + if args.arch == 'all': + for arch in ARCHS: + action(arch) + else: + action(args.arch) + +if __name__ == '__main__': + main() ===================================== mk/get-win32-tarballs.sh deleted ===================================== @@ -1,326 +0,0 @@ -#!/usr/bin/env bash - -tarball_dir='ghc-tarballs' -missing_files=0 -pkg_variant="phyx" - -# see #12502 -if test -z "$FIND"; then FIND="find"; fi - -fail() { - echo >&2 - echo "$1" >&2 - exit 1 -} - -download_file() { - local file_url="$1" - local dest_file="$2" - local description="$3" - local extra_curl_opts="$4" - local backup_url="$5" - local dest_dir="$(dirname $dest_file)" - - if ! test -f "${dest_file}" - then - local curl_cmd="curl -f -L ${file_url} -o ${dest_file} --create-dirs -# ${extra_curl_opts}" - if test -n "${backup_url}"; then - local curl_cmd_bnk="curl -f -L ${backup_url} -o ${dest_file} --create-dirs -# ${extra_curl_opts}" - else - local curl_cmd_bnk="true" - fi - - if test "$download" = "0" - then - echo "ERROR: Missing ${description}" >&2 - echo "${file_url}" - missing_files=1 - return - else - echo "Downloading ${description} to ${dest_dir}..." - $curl_cmd || (echo "Checking repo.msys2.org instead of Haskell.org..." && $curl_cmd_bnk) || { - rm -f "${dest_file}" - fail "ERROR: Download failed." - exit 1 - } - fi - fi - - local sig_file="${dest_file}.sig" - if test "$sigs" = "1" -a ! -f "$sig_file" - then - echo "Downloading ${description} (signature) to ${dest_dir}..." - local curl_cmd="curl -f -L ${file_url}.sig -o ${sig_file} --create-dirs -# ${extra_curl_opts}" - if test -n "${backup_url}"; then - local curl_cmd_bnk="curl -f -L "${backup_url}.sig" -o ${sig_file} --create-dirs -# ${extra_curl_opts}" - else - local curl_cmd_bnk="true" - fi - $curl_cmd || (echo "Checking repo.msys2.org instead of Haskell.org..." && $curl_cmd_bnk) || { - rm -f "${dest_file}.sig" - fail "ERROR: Download failed." - exit 1 - } - fi - - if test "$verify" = "1" - then - grep "${dest_file}$" mk/win32-tarballs.md5sum | md5sum --quiet -c - || - fail "ERROR: ${description} appears to be corrupted, please delete it and try again." - fi -} - -download_mingw() { - local mingw_base_url_primary="https://downloads.haskell.org/~ghc/mingw" - local mingw_base_url_secondary="http://repo.msys2.org/mingw" - - if test "$mingw_arch" = "sources" - then - mingw_url_tmp=`echo "$1" | sed -e 's/-any\.pkg\.tar\.xz/\.src\.tar\.gz/' \ - -e 's/-sources-/-/' \ - -e 's/-libwinpthread-git-/-winpthreads-git-/' ` - local mingw_url="${mingw_base_url_primary}/${mingw_url_tmp}" - local mingw_url_backup="${mingw_base_url_secondary}/${mingw_url_tmp}" - else - local mingw_url="${mingw_base_url_primary}/$1" - local mingw_url_backup="${mingw_base_url_secondary}/$1" - fi - - local mingw_toolchain="$(basename $mingw_url)" - local mingw_w64="${tarball_dir}/${tarball_dest_dir}/${mingw_toolchain}" - - download_file "${mingw_url}" "${mingw_w64}" "${mingw_toolchain}" "" "${mingw_url_backup}" - - # Mark the tree as needing updates by deleting the folder - if test -d inplace/mingw && test inplace/mingw -ot "$mingw_w64" ; then - echo "In-tree MinGW-w64 tree requires updates..." - rm -rf inplace/mingw - fi -} - -download_tarballs() { - local package_prefix="mingw-w64" - local format_url="/${mingw_arch}/${package_prefix}-${mingw_arch}" - - download_mingw "${format_url}-crt-git-7.0.0.5491.fe45801e-1-any.pkg.tar.xz" - download_mingw "${format_url}-winpthreads-git-7.0.0.5480.e14d23be-1-any.pkg.tar.xz" - download_mingw "${format_url}-headers-git-7.0.0.5490.9ec54ed1-1-any.pkg.tar.xz" - download_mingw "${format_url}-libwinpthread-git-7.0.0.5480.e14d23be-1-any.pkg.tar.xz" - download_mingw "${format_url}-zlib-1.2.8-9-any.pkg.tar.xz" - download_mingw "${format_url}-isl-0.21-1-any.pkg.tar.xz" - download_mingw "${format_url}-mpfr-4.0.2-2-any.pkg.tar.xz" - download_mingw "${format_url}-gmp-6.1.2-1-any.pkg.tar.xz" - download_mingw "${format_url}-binutils-2.32-3-$pkg_variant.pkg.tar.xz" - download_mingw "${format_url}-libidn2-2.2.0-1-any.pkg.tar.xz" - download_mingw "${format_url}-gcc-9.2.0-1-$pkg_variant.pkg.tar.xz" - download_mingw "${format_url}-mpc-1.1.0-1-any.pkg.tar.xz" - download_mingw "${format_url}-windows-default-manifest-6.4-3-any.pkg.tar.xz" - - # Upstream is unfortunately quite inconsistent in naming - if test "$mingw_arch" != "sources"; then - download_mingw "${format_url}-gcc-libs-9.2.0-1-$pkg_variant.pkg.tar.xz" - fi - - if ! test "$missing_files" = "0" - then - exit 2 - fi -} - -download_i386() { - mingw_arch="i686" - tarball_dest_dir="mingw-w64/i686" - download_tarballs -} - -download_x86_64() { - mingw_arch="x86_64" - tarball_dest_dir="mingw-w64/x86_64" - download_tarballs -} - -download_sources() { - mingw_arch="sources" - tarball_dest_dir="mingw-w64/sources" - download_tarballs -} - -sync_binaries_and_sources() { - gpg --recv-key 5F92EFC1A47D45A1 - - # ensure sources are downloaded - sigs=1 - download_i386 - download_x86_64 - verify=0 - download_sources - - for f in $($FIND ghc-tarballs/mingw-w64 -iname '*.sig'); do - echo "Verifying $f" - gpg --verify $f - done - - md5sum `$FIND ghc-tarballs -type f -a -not -iname '*.sig'` >| mk/win32-tarballs.md5sum - chmod -R ugo+rX ghc-tarballs - - rsync -av ghc-tarballs/mingw-w64/* downloads.haskell.org:public_html/mingw - for f in $($FIND ghc-tarballs/mingw-w64); do - curl -XPURGE http://downloads.haskell.org/~ghc/mingw/$f - done -} - -patch_single_file () { - local patcher_base="$1" - local filename=$(readlink -f "$2") - local filepath=$(dirname "$filename") - local patcher="$patcher_base/iat-patcher.exe" - $patcher install "$filename" > /dev/null - rm -f "$filename.bak" - for file in $patcher_base/*.dll; do cp -f "$file" "${filepath}"; done - echo "Patched '$filename'" -} - -patch_tarball () { - local tarball_name="$1" - local filename=$(basename "$tarball_name") - local filepath=$(dirname "$tarball_name") - local newfile=`echo "$filepath/$filename" | sed -e 's/-any/-phyx/'` - local arch="" - - echo "=> ${filename}" - - case $1 in - *x86_64*) - arch="x86_64" - ;; - *i686*) - arch="i686" - ;; - *) - echo "unknown architecture detected. Stopping." - exit 1 - ;; - esac - - local base="$(pwd)" - local patcher_base="$(pwd)/ghc-tarballs/ghc-jailbreak/$arch" - local tmpdir="ghc-tarballs/tmpdir" - mkdir -p $tmpdir - cd $tmpdir - tar xJf "$base/$tarball_name" - find . -iname "*.exe" -exec bash -c \ - 'patch_single_file "'"${patcher_base}"'" "$0"' {} \; - tar cJf "$base/$newfile" . - cd "$base" - rm -rf $tmpdir - gpg --output "$base/${newfile}.sig" --detach-sig "$base/$newfile" - rm -f "$base/$tarball_name" -} - -show_hashes_for_binaries() { - $FIND ghc-tarballs/ -iname "*.*" | xargs md5sum | grep -v "\.sig" | sed -s "s/\*//" -} - -usage() { - echo "$0 - Download GHC mingw toolchain tarballs" - echo - echo "Usage: $0 []" - echo - echo "Where is one of," - echo "" - echo " download download the necessary tarballs for the given architecture" - echo " fetch download the necessary tarballs for the given architecture but doesn't verify their md5." - echo " grab download the necessary tarballs using patched toolchains for the given architecture but doesn't verify their md5." - echo " verify verify the existence and correctness of the necessary tarballs" - echo " patch jailbreak the binaries in the tarballs and remove MAX_PATH limitations." - echo " hash generate md5 hashes for inclusion in win32-tarballs.md5sum" - echo " sync upload packages downloaded with 'fetch mirror' to haskell.org" - echo "" - echo "and is one of i386, x86_64,all or mirror (which includes sources)" -} - -case $1 in - download) - download=1 - verify=1 - sigs=0 - ;; - fetch) - download=1 - verify= - ;; - grab) - download=1 - verify=0 - pkg_variant="any" - ;; - verify) - download=0 - verify=1 - ;; - sync) - download=1 - verify=0 - sync=1 - ;; - hash) - show_hashes_for_binaries - exit 1 - ;; - # This routine will download the latest ghc-jailbreak and unpack binutils and - # the ghc tarballs and patches every .exe in each. Along with this is copies - # two dlls in every folder that it patches a .exe in. Afterwards it re-creates - # the tarballs and generates a new signature file. - patch) - export -f patch_tarball - export -f patch_single_file - - echo "Downloading ghc-jailbreak..." - curl -f -L https://mistuke.blob.core.windows.net/binaries/ghc-jailbreak-0.3.tar.gz \ - -o ghc-tarballs/ghc-jailbreak/ghc-jailbreak.tar.gz --create-dirs -# - tar -C ghc-tarballs/ghc-jailbreak/ -xf ghc-tarballs/ghc-jailbreak/ghc-jailbreak.tar.gz - - find ghc-tarballs/mingw-w64/ \( -iname "*binutils*.tar.xz" \ - -o -iname "*gcc*.tar.xz" \) \ - -exec bash -c 'patch_tarball "$0"' {} \; - - rm -rf ghc-tarballs/ghc-jailbreak - - echo "Finished tarball generation, toolchain has been pre-patched." - exit 0 - ;; - *) - usage - exit 1 - ;; -esac - -case $2 in - i386) - download_i386 - ;; - x86_64) - download_x86_64 - ;; - all) - download_i386 - download_x86_64 - ;; - mirror) - sigs=1 - download_i386 - download_x86_64 - verify=0 - sigs=0 - download_sources - show_hashes_for_binaries - ;; - *) - if test "$sync" = "1"; then - sync_binaries_and_sources - else - usage - exit 1 - fi - ;; -esac ===================================== utils/hsc2hs ===================================== @@ -1 +1 @@ -Subproject commit fff335b68958c05efe2b33ef2c56a1664596d021 +Subproject commit ed109c719925e358f68b95970199c4b961de6817 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/02f393fb33be26e1164b1ebe7139fc1be73f8f61...b2cbfdc596582ffdec5b491824498af6c1406bd0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/02f393fb33be26e1164b1ebe7139fc1be73f8f61...b2cbfdc596582ffdec5b491824498af6c1406bd0 You're receiving 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 Mar 18 13:26:23 2020 From: gitlab at gitlab.haskell.org (Richard Eisenberg) Date: Wed, 18 Mar 2020 09:26:23 -0400 Subject: [Git][ghc/ghc][wip/no-coholes] Simplify treatment of heterogeneous equality Message-ID: <5e72217fdca73_488a8eac47018855d7@gitlab.haskell.org.mail> Richard Eisenberg pushed to branch wip/no-coholes at Glasgow Haskell Compiler / GHC Commits: 11ea299e by Richard Eisenberg at 2020-03-18T13:26:08Z 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. - - - - - 30 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/HsToCore/PmCheck.hs - compiler/typecheck/Constraint.hs - compiler/typecheck/TcCanonical.hs - compiler/typecheck/TcErrors.hs - compiler/typecheck/TcFlatten.hs - compiler/typecheck/TcHsType.hs - compiler/typecheck/TcInteract.hs - compiler/typecheck/TcMType.hs - compiler/typecheck/TcOrigin.hs - compiler/typecheck/TcPluginM.hs - compiler/typecheck/TcSMonad.hs - compiler/typecheck/TcSimplify.hs - compiler/typecheck/TcUnify.hs - testsuite/tests/dependent/should_fail/BadTelescope5.stderr - testsuite/tests/dependent/should_fail/T14066.stderr - testsuite/tests/dependent/should_fail/T14066e.stderr - testsuite/tests/ghci.debugger/scripts/break012.stdout - testsuite/tests/indexed-types/should_fail/T14887.stderr - testsuite/tests/indexed-types/should_fail/T3330c.stderr - testsuite/tests/partial-sigs/should_fail/T14584.stderr - testsuite/tests/patsyn/should_fail/T15685.stderr - testsuite/tests/polykinds/T11399.stderr - testsuite/tests/polykinds/T14846.stderr - testsuite/tests/polykinds/T17841.stderr - testsuite/tests/polykinds/T7278.stderr - testsuite/tests/polykinds/T8616.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/11ea299ea4f079c5e2ec7eb859dcde6f900902b5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/11ea299ea4f079c5e2ec7eb859dcde6f900902b5 You're receiving 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 Mar 19 14:15:25 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Thu, 19 Mar 2020 10:15:25 -0400 Subject: [Git][ghc/ghc][wip/tycl-group] 8 commits: Update "GHC differences to the FFI Chapter" in user guide. Message-ID: <5e737e7de7aa8_488a3fc6f8fa0cb821309cf@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/tycl-group at Glasgow Haskell Compiler / GHC Commits: 5cbf9934 by Andreas Klebinger at 2020-03-19T04:39:27Z 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-19T04:40:06Z 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. - - - - - e35f1969 by Vladislav Zavialov at 2020-03-19T14:14:44Z Data family TyClGroup - - - - - 42269092 by Vladislav Zavialov at 2020-03-19T14:14:51Z tcLookupTcTyCon for kinded decls - - - - - 9d580d0f by Vladislav Zavialov at 2020-03-19T14:14:51Z improve tcLookupTcTyCon panic message - - - - - 5d98faa5 by Vladislav Zavialov at 2020-03-19T14:14:51Z accept new test output - - - - - 906d74e1 by Vladislav Zavialov at 2020-03-19T14:14:51Z minor comments - - - - - 2d7968dd by Vladislav Zavialov at 2020-03-19T14:14:51Z No concatMap - - - - - 18 changed files: - compiler/GHC/Core/TyCon.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Extension.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/PmCheck/Oracle.hs - compiler/GHC/HsToCore/PmCheck/Types.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Source.hs - compiler/typecheck/TcEnv.hs - compiler/typecheck/TcHsType.hs - compiler/typecheck/TcRnDriver.hs - compiler/typecheck/TcTyClsDecls.hs - docs/users_guide/exts/ffi.rst - testsuite/tests/parser/should_compile/DumpRenamedAst.stderr - testsuite/tests/parser/should_compile/T14189.stderr Changes: ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -7,6 +7,7 @@ The @TyCon@ datatype -} {-# LANGUAGE CPP, FlexibleInstances #-} +{-# LANGUAGE DeriveDataTypeable #-} module GHC.Core.TyCon( -- * Main TyCon data types @@ -2583,7 +2584,7 @@ data TyConFlavour | TypeSynonymFlavour | BuiltInTypeFlavour -- ^ e.g., the @(->)@ 'TyCon'. | PromotedDataConFlavour - deriving Eq + deriving (Eq, Data.Data) instance Outputable TyConFlavour where ppr = text . go ===================================== compiler/GHC/Hs/Decls.hs ===================================== @@ -3,6 +3,7 @@ (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 -} +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable, DeriveFunctor, DeriveFoldable, DeriveTraversable #-} {-# LANGUAGE StandaloneDeriving #-} @@ -10,6 +11,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow] -- in module GHC.Hs.Extension +{-# LANGUAGE DataKinds #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeApplications #-} @@ -29,6 +31,7 @@ module GHC.Hs.Decls ( -- ** Class or type declarations TyClDecl(..), LTyClDecl, DataDeclRn(..), + DeclHeaderRn(..), DeclSigRn(..), TyClGroup(..), tyClGroupTyClDecls, tyClGroupInstDecls, tyClGroupRoleDecls, tyClGroupKindSigs, @@ -42,7 +45,7 @@ module GHC.Hs.Decls ( FamilyDecl(..), LFamilyDecl, -- ** Instance declarations - InstDecl(..), LInstDecl, FamilyInfo(..), + InstDecl(..), LInstDecl, FamilyInfo(..), getFamFlav, TyFamInstDecl(..), LTyFamInstDecl, instDeclDataFamInsts, TyFamDefltDecl, LTyFamDefltDecl, DataFamInstDecl(..), LDataFamInstDecl, @@ -88,11 +91,14 @@ module GHC.Hs.Decls ( resultVariableName, familyDeclLName, familyDeclName, -- * Grouping - HsGroup(..), emptyRdrGroup, emptyRnGroup, appendGroups, hsGroupInstDecls, + KindedDecls(..), isKindedDecl, + HsGroup(..), emptyRdrGroup, emptyRnGroup, appendGroups, hsGroupTopLevelFixitySigs, ) where +#include "HsVersions.h" + -- friends: import GhcPrelude @@ -120,6 +126,8 @@ import GHC.Core.Type import Bag import Maybes import Data.Data hiding (TyCon,Fixity, Infix) +import Data.Void +import qualified Data.Semigroup {- ************************************************************************ @@ -250,18 +258,32 @@ data HsGroup p } | XHsGroup (XXHsGroup p) -type instance XCHsGroup (GhcPass _) = NoExtField +type instance XCHsGroup GhcPs = NoExtField +type instance XCHsGroup GhcRn = KindedDecls +type instance XCHsGroup GhcTc = Void type instance XXHsGroup (GhcPass _) = NoExtCon +-- | Names of declarations that either have a CUSK or a SAKS. +newtype KindedDecls = KindedDecls NameSet + +instance Semigroup KindedDecls where + KindedDecls a <> KindedDecls b = KindedDecls (unionNameSet a b) + +instance Monoid KindedDecls where + mempty = KindedDecls emptyNameSet + +isKindedDecl :: KindedDecls -> TyClDecl GhcRn -> Bool +isKindedDecl (KindedDecls nameSet) d = elemNameSet (tcdName d) nameSet -emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup (GhcPass p) +emptyGroup :: Monoid (XCHsGroup (GhcPass p)) => HsGroup (GhcPass p) + +emptyRdrGroup :: HsGroup GhcPs emptyRdrGroup = emptyGroup { hs_valds = emptyValBindsIn } -emptyRnGroup = emptyGroup { hs_valds = emptyValBindsOut } -hsGroupInstDecls :: HsGroup id -> [LInstDecl id] -hsGroupInstDecls = (=<<) group_instds . hs_tyclds +emptyRnGroup :: HsGroup GhcRn +emptyRnGroup = emptyGroup { hs_valds = emptyValBindsOut } -emptyGroup = HsGroup { hs_ext = noExtField, +emptyGroup = HsGroup { hs_ext = mempty, hs_tyclds = [], hs_derivds = [], hs_fixds = [], hs_defds = [], hs_annds = [], @@ -273,7 +295,7 @@ emptyGroup = HsGroup { hs_ext = noExtField, -- | The fixity signatures for each top-level declaration and class method -- in an 'HsGroup'. -- See Note [Top-level fixity signatures in an HsGroup] -hsGroupTopLevelFixitySigs :: HsGroup (GhcPass p) -> [LFixitySig (GhcPass p)] +hsGroupTopLevelFixitySigs :: IsPass p => HsGroup (GhcPass p) -> [LFixitySig (GhcPass p)] hsGroupTopLevelFixitySigs (HsGroup{ hs_fixds = fixds, hs_tyclds = tyclds }) = fixds ++ cls_fixds where @@ -283,10 +305,12 @@ hsGroupTopLevelFixitySigs (HsGroup{ hs_fixds = fixds, hs_tyclds = tyclds }) = ] hsGroupTopLevelFixitySigs (XHsGroup nec) = noExtCon nec -appendGroups :: HsGroup (GhcPass p) -> HsGroup (GhcPass p) +appendGroups :: Semigroup (XCHsGroup (GhcPass p)) + => HsGroup (GhcPass p) -> HsGroup (GhcPass p) -> HsGroup (GhcPass p) appendGroups HsGroup { + hs_ext = ext1, hs_valds = val_groups1, hs_splcds = spliceds1, hs_tyclds = tyclds1, @@ -299,6 +323,7 @@ appendGroups hs_ruleds = rulds1, hs_docs = docs1 } HsGroup { + hs_ext = ext2, hs_valds = val_groups2, hs_splcds = spliceds2, hs_tyclds = tyclds2, @@ -312,7 +337,7 @@ appendGroups hs_docs = docs2 } = HsGroup { - hs_ext = noExtField, + hs_ext = ext1 Data.Semigroup.<> ext2, hs_valds = val_groups1 `plusHsValBinds` val_groups2, hs_splcds = spliceds1 ++ spliceds2, hs_tyclds = tyclds1 ++ tyclds2, @@ -795,20 +820,28 @@ instance (OutputableBndrId p) => Outputable (TyClDecl (GhcPass p)) where ppr (XTyClDecl x) = ppr x -instance OutputableBndrId p - => Outputable (TyClGroup (GhcPass p)) where - ppr (TyClGroup { group_tyclds = tyclds - , group_roles = roles - , group_kisigs = kisigs - , group_instds = instds - } - ) - = hang (text "TyClGroup") 2 $ - ppr kisigs $$ - ppr tyclds $$ - ppr roles $$ - ppr instds - ppr (XTyClGroup x) = ppr x +instance IsPass p => Outputable (TyClGroup (GhcPass p)) where + ppr = + case ghcPass @p of + GhcPs -> pprPs + GhcRn -> pprRn + GhcTc -> tcg_tc_absurd + where + pprPs (TcgPsDecl d) = ppr d + pprPs (TcgPsRole role) = ppr role + pprPs (TcgPsKiSig kisig) = ppr kisig + pprPs (TcgPsInst instd) = ppr instd + + pprRn (TcgRn { tcg_rn_tyclds = tyclds + , tcg_rn_roles = roles + , tcg_rn_kisigs = kisigs + , tcg_rn_instds = instds + }) + = hang (text "TyClGroup") 2 $ + ppr kisigs $$ + ppr tyclds $$ + ppr roles $$ + ppr instds pp_vanilla_decl_head :: (OutputableBndrId p) => Located (IdP (GhcPass p)) @@ -965,31 +998,88 @@ See Note [Dependency analysis of type, class, and instance decls] in GHC.Rename.Source for more info. -} --- | Type or Class Group -data TyClGroup pass -- See Note [TyClGroups and dependency analysis] - = TyClGroup { group_ext :: XCTyClGroup pass - , group_tyclds :: [LTyClDecl pass] - , group_roles :: [LRoleAnnotDecl pass] - , group_kisigs :: [LStandaloneKindSig pass] - , group_instds :: [LInstDecl pass] } - | XTyClGroup (XXTyClGroup pass) - -type instance XCTyClGroup (GhcPass _) = NoExtField -type instance XXTyClGroup (GhcPass _) = NoExtCon - - -tyClGroupTyClDecls :: [TyClGroup pass] -> [LTyClDecl pass] -tyClGroupTyClDecls = concatMap group_tyclds - -tyClGroupInstDecls :: [TyClGroup pass] -> [LInstDecl pass] -tyClGroupInstDecls = concatMap group_instds - -tyClGroupRoleDecls :: [TyClGroup pass] -> [LRoleAnnotDecl pass] -tyClGroupRoleDecls = concatMap group_roles - -tyClGroupKindSigs :: [TyClGroup pass] -> [LStandaloneKindSig pass] -tyClGroupKindSigs = concatMap group_kisigs +-- | Renamed declaration header (left-hand side of a declaration): +-- +-- 1. data T a b = MkT (a -> b) +-- ^^^^^^^^^^ +-- +-- 2. class C a where +-- ^^^^^^^^^ +-- +-- 3. type family F a b :: r where +-- ^^^^^^^^^^^^^^^^^^^^^^ +-- +-- Supplies arity and flavor information not covered by a standalone kind +-- signature. +-- +data DeclHeaderRn + = DeclHeaderRn + { decl_header_flav :: TyConFlavour, + decl_header_name :: Located (IdP GhcRn), + decl_header_bndrs :: LHsQTyVars GhcRn, + decl_header_res_sig :: Maybe (LHsType GhcRn) + } +-- | Type or Class Group +data family TyClGroup pass + +data instance TyClGroup GhcPs + = TcgPsDecl (LTyClDecl GhcPs) + | TcgPsRole (LRoleAnnotDecl GhcPs) + | TcgPsKiSig (LStandaloneKindSig GhcPs) + | TcgPsInst (LInstDecl GhcPs) + +-- | Declaration signature (CUSK or SAKS). +data DeclSigRn + = DeclSigRnCUSK + (Located DeclHeaderRn) -- Complete user-specified kind (CUSK) + | DeclSigRnSAKS + (Located DeclHeaderRn) -- Not necessarily a CUSK + (LStandaloneKindSig GhcRn) -- Standalone kind signature (SAKS) + +instance Outputable DeclSigRn where + ppr (DeclSigRnCUSK hdr) = text "CUSK:" <+> ppr (decl_header_name (unLoc hdr)) + ppr (DeclSigRnSAKS _ sig) = ppr sig + +-- See Note [TyClGroups and dependency analysis] +data instance TyClGroup GhcRn = + TcgRn { tcg_rn_tyclds :: [LTyClDecl GhcRn] + , tcg_rn_roles :: [LRoleAnnotDecl GhcRn] + , tcg_rn_kisigs :: [DeclSigRn] + , tcg_rn_instds :: [LInstDecl GhcRn] } + +newtype instance TyClGroup GhcTc = TcgTc Void + +tcg_tc_absurd :: TyClGroup GhcTc -> a +tcg_tc_absurd (TcgTc a) = absurd a + +tyClGroupTyClDecls :: forall p. IsPass p => [TyClGroup (GhcPass p)] -> [LTyClDecl (GhcPass p)] +tyClGroupTyClDecls = concatMap $ \tcg -> + case ghcPass @p of + GhcPs -> [a | TcgPsDecl a <- [tcg] ] + GhcRn -> tcg_rn_tyclds tcg + GhcTc -> tcg_tc_absurd tcg + +tyClGroupInstDecls :: forall p. IsPass p => [TyClGroup (GhcPass p)] -> [LInstDecl (GhcPass p)] +tyClGroupInstDecls = concatMap $ \tcg -> + case ghcPass @p of + GhcPs -> [a | TcgPsInst a <- [tcg] ] + GhcRn -> tcg_rn_instds tcg + GhcTc -> tcg_tc_absurd tcg + +tyClGroupRoleDecls :: forall p. IsPass p => [TyClGroup (GhcPass p)] -> [LRoleAnnotDecl (GhcPass p)] +tyClGroupRoleDecls = concatMap $ \tcg -> + case ghcPass @p of + GhcPs -> [a | TcgPsRole a <- [tcg] ] + GhcRn -> tcg_rn_roles tcg + GhcTc -> tcg_tc_absurd tcg + +tyClGroupKindSigs :: forall p. IsPass p => [TyClGroup (GhcPass p)] -> [LStandaloneKindSig (GhcPass p)] +tyClGroupKindSigs = concatMap $ \tcg -> + case ghcPass @p of + GhcPs -> [a | TcgPsKiSig a <- [tcg] ] + GhcRn -> [a | DeclSigRnSAKS _ a <- tcg_rn_kisigs tcg ] + GhcTc -> tcg_tc_absurd tcg {- ********************************************************************* * * @@ -1145,6 +1235,27 @@ data FamilyInfo pass -- said "type family Foo x where .." | ClosedTypeFamily (Maybe [LTyFamInstEqn pass]) +getFamFlav + :: Maybe TyCon -- ^ Just cls <=> this is an associated family of class cls + -> FamilyInfo pass + -> TyConFlavour +getFamFlav mb_parent_tycon info = + case info of + DataFamily -> DataFamilyFlavour mb_parent_tycon + OpenTypeFamily -> OpenTypeFamilyFlavour mb_parent_tycon + ClosedTypeFamily _ -> ASSERT( isNothing mb_parent_tycon ) -- See Note [Closed type family mb_parent_tycon] + ClosedTypeFamilyFlavour + +{- Note [Closed type family mb_parent_tycon] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +There's no way to write a closed type family inside a class declaration: + + class C a where + type family F a where -- error: parse error on input ‘where’ + +In fact, it is not clear what the meaning of such a declaration would be. +Therefore, 'mb_parent_tycon' of any closed type family has to be Nothing. +-} ------------- Functions over FamilyDecls ----------- ===================================== compiler/GHC/Hs/Extension.hs ===================================== @@ -28,6 +28,7 @@ module GHC.Hs.Extension where import GhcPrelude import Data.Data hiding ( Fixity ) +import Data.Semigroup import Name import RdrName import Var @@ -143,6 +144,12 @@ data NoExtField = NoExtField instance Outputable NoExtField where ppr _ = text "NoExtField" +instance Semigroup NoExtField where + _ <> _ = NoExtField + +instance Monoid NoExtField where + mempty = NoExtField + -- | Used when constructing a term with an unused extension point. noExtField :: NoExtField noExtField = NoExtField @@ -375,11 +382,6 @@ type family XDataDecl x type family XClassDecl x type family XXTyClDecl x --- ------------------------------------- --- TyClGroup type families -type family XCTyClGroup x -type family XXTyClGroup x - -- ------------------------------------- -- FamilyResultSig type families type family XNoSig x ===================================== compiler/GHC/Hs/Instances.hs ===================================== @@ -104,6 +104,8 @@ deriving instance Data (HsDecl GhcPs) deriving instance Data (HsDecl GhcRn) deriving instance Data (HsDecl GhcTc) +deriving instance Data KindedDecls + -- deriving instance (DataIdLR p p) => Data (HsGroup p) deriving instance Data (HsGroup GhcPs) deriving instance Data (HsGroup GhcRn) @@ -119,6 +121,9 @@ deriving instance Data (TyClDecl GhcPs) deriving instance Data (TyClDecl GhcRn) deriving instance Data (TyClDecl GhcTc) +deriving instance Data DeclHeaderRn +deriving instance Data DeclSigRn + -- deriving instance (DataIdLR p p) => Data (TyClGroup p) deriving instance Data (TyClGroup GhcPs) deriving instance Data (TyClGroup GhcRn) ===================================== compiler/GHC/Hs/Utils.hs ===================================== @@ -1154,9 +1154,9 @@ hsTyClForeignBinders :: [TyClGroup GhcRn] hsTyClForeignBinders tycl_decls foreign_decls = map unLoc (hsForeignDeclsBinders foreign_decls) ++ getSelectorNames - (foldMap (foldMap hsLTyClDeclBinders . group_tyclds) tycl_decls + (foldMap hsLTyClDeclBinders (tyClGroupTyClDecls tycl_decls) `mappend` - foldMap (foldMap hsLInstDeclBinders . group_instds) tycl_decls) + foldMap hsLInstDeclBinders (tyClGroupInstDecls tycl_decls)) where getSelectorNames :: ([Located Name], [LFieldOcc GhcRn]) -> [Name] getSelectorNames (ns, fs) = map unLoc ns ++ map (extFieldOcc . unLoc) fs ===================================== compiler/GHC/HsToCore/PmCheck/Oracle.hs ===================================== @@ -51,7 +51,6 @@ import GHC.Core.Make (mkListExpr, mkCharExpr) import UniqSupply import FastString import SrcLoc -import ListSetOps (unionLists) import Maybes import GHC.Core.ConLike import GHC.Core.DataCon @@ -613,9 +612,6 @@ Maintaining these invariants in 'addVarCt' (the core of the term oracle) and - (Refine) If we had @x /~ K zs@, unify each y with each z in turn. * Adding negative information. Example: Add the fact @x /~ Nothing@ (see 'addNotConCt') - (Refut) If we have @x ~ K ys@, refute. - - (Redundant) If we have @x ~ K2@ and @eqPmAltCon K K2 == Disjoint@ - (ex. Just and Nothing), the info is redundant and can be - discarded. - (COMPLETE) If K=Nothing and we had @x /~ Just@, then we get @x /~ [Just,Nothing]@. This is vacuous by matter of comparing to the built-in COMPLETE set, so should refute. @@ -655,7 +651,7 @@ tmIsSatisfiable new_tm_cs = SC $ \delta -> runMaybeT $ foldlM addTmCt delta new_ -- * Looking up VarInfo emptyVarInfo :: Id -> VarInfo -emptyVarInfo x = VI (idType x) [] [] NoPM +emptyVarInfo x = VI (idType x) [] emptyPmAltConSet NoPM lookupVarInfo :: TmState -> Id -> VarInfo -- (lookupVarInfo tms x) tells what we know about 'x' @@ -754,7 +750,7 @@ TyCon, so tc_rep = tc_fam afterwards. canDiverge :: Delta -> Id -> Bool canDiverge delta at MkDelta{ delta_tm_st = ts } x | VI _ pos neg _ <- lookupVarInfo ts x - = null neg && all pos_can_diverge pos + = isEmptyPmAltConSet neg && all pos_can_diverge pos where pos_can_diverge (PmAltConLike (RealDataCon dc), _, [y]) -- See Note [Divergence of Newtype matches] @@ -793,8 +789,8 @@ lookupRefuts :: Uniquable k => Delta -> k -> [PmAltCon] lookupRefuts MkDelta{ delta_tm_st = ts@(TmSt (SDIE env) _) } k = case lookupUDFM env k of Nothing -> [] - Just (Indirect y) -> vi_neg (lookupVarInfo ts y) - Just (Entry vi) -> vi_neg vi + Just (Indirect y) -> pmAltConSetElems (vi_neg (lookupVarInfo ts y)) + Just (Entry vi) -> pmAltConSetElems (vi_neg vi) isDataConSolution :: (PmAltCon, [TyVar], [Id]) -> Bool isDataConSolution (PmAltConLike (RealDataCon _), _, _) = True @@ -937,7 +933,7 @@ addNotConCt delta at MkDelta{ delta_tm_st = TmSt env reps } x nalt = do | any (implies nalt) pos = neg -- See Note [Completeness checking with required Thetas] | hasRequiredTheta nalt = neg - | otherwise = unionLists neg [nalt] + | otherwise = extendPmAltConSet neg nalt let vi_ext = vi{ vi_neg = neg' } -- 3. Make sure there's at least one other possible constructor vi' <- case nalt of @@ -1129,7 +1125,7 @@ equate delta at MkDelta{ delta_tm_st = TmSt env reps } x y delta_pos <- foldlM add_fact delta_refs (vi_pos vi_x) -- Do the same for negative info let add_refut delta nalt = addNotConCt delta y nalt - delta_neg <- foldlM add_refut delta_pos (vi_neg vi_x) + delta_neg <- foldlM add_refut delta_pos (pmAltConSetElems (vi_neg vi_x)) -- vi_cache will be updated in addNotConCt, so we are good to -- go! pure delta_neg @@ -1144,7 +1140,7 @@ addConCt :: Delta -> Id -> PmAltCon -> [TyVar] -> [Id] -> MaybeT DsM Delta addConCt delta at MkDelta{ delta_tm_st = TmSt env reps } x alt tvs args = do VI ty pos neg cache <- lift (initLookupVarInfo delta x) -- First try to refute with a negative fact - guard (all ((/= Equal) . eqPmAltCon alt) neg) + guard (not (elemPmAltConSet alt neg)) -- Then see if any of the other solutions (remember: each of them is an -- additional refinement of the possible values x could take) indicate a -- contradiction @@ -1160,11 +1156,8 @@ addConCt delta at MkDelta{ delta_tm_st = TmSt env reps } x alt tvs args = do let tm_cts = zipWithEqual "addConCt" PmVarCt args other_args MaybeT $ addPmCts delta (listToBag ty_cts `unionBags` listToBag tm_cts) Nothing -> do - -- Filter out redundant negative facts (those that compare Just False to - -- the new solution) - let neg' = filter ((== PossiblyOverlap) . eqPmAltCon alt) neg let pos' = (alt, tvs, args):pos - pure delta{ delta_tm_st = TmSt (setEntrySDIE env x (VI ty pos' neg' cache)) reps} + pure delta{ delta_tm_st = TmSt (setEntrySDIE env x (VI ty pos' neg cache)) reps} equateTys :: [Type] -> [Type] -> [PmCt] equateTys ts us = @@ -1553,7 +1546,7 @@ provideEvidence = go [] -- When there are literals involved, just print negative info -- instead of listing missed constructors - | notNull [ l | PmAltLit l <- neg ] + | notNull [ l | PmAltLit l <- pmAltConSetElems neg ] -> go xs n delta [] -> try_instantiate x xs n delta ===================================== compiler/GHC/HsToCore/PmCheck/Types.hs ===================================== @@ -24,6 +24,10 @@ module GHC.HsToCore.PmCheck.Types ( -- * Caching partially matched COMPLETE sets ConLikeSet, PossibleMatches(..), + -- * PmAltConSet + PmAltConSet, emptyPmAltConSet, isEmptyPmAltConSet, elemPmAltConSet, + extendPmAltConSet, pmAltConSetElems, + -- * A 'DIdEnv' where entries may be shared Shared(..), SharedDIdEnv(..), emptySDIE, lookupSDIE, sameRepresentativeSDIE, setIndirectSDIE, setEntrySDIE, traverseSDIE, @@ -49,6 +53,7 @@ import Name import GHC.Core.DataCon import GHC.Core.ConLike import Outputable +import ListSetOps (unionLists) import Maybes import GHC.Core.Type import GHC.Core.TyCon @@ -152,6 +157,33 @@ eqConLike _ _ = PossiblyOverlap data PmAltCon = PmAltConLike ConLike | PmAltLit PmLit +data PmAltConSet = PACS !ConLikeSet ![PmLit] + +emptyPmAltConSet :: PmAltConSet +emptyPmAltConSet = PACS emptyUniqDSet [] + +isEmptyPmAltConSet :: PmAltConSet -> Bool +isEmptyPmAltConSet (PACS cls lits) = isEmptyUniqDSet cls && null lits + +-- | Whether there is a 'PmAltCon' in the 'PmAltConSet' that compares 'Equal' to +-- the given 'PmAltCon' according to 'eqPmAltCon'. +elemPmAltConSet :: PmAltCon -> PmAltConSet -> Bool +elemPmAltConSet (PmAltConLike cl) (PACS cls _ ) = elementOfUniqDSet cl cls +elemPmAltConSet (PmAltLit lit) (PACS _ lits) = elem lit lits + +extendPmAltConSet :: PmAltConSet -> PmAltCon -> PmAltConSet +extendPmAltConSet (PACS cls lits) (PmAltConLike cl) + = PACS (addOneToUniqDSet cls cl) lits +extendPmAltConSet (PACS cls lits) (PmAltLit lit) + = PACS cls (unionLists lits [lit]) + +pmAltConSetElems :: PmAltConSet -> [PmAltCon] +pmAltConSetElems (PACS cls lits) + = map PmAltConLike (uniqDSetToList cls) ++ map PmAltLit lits + +instance Outputable PmAltConSet where + ppr = ppr . pmAltConSetElems + -- | We can't in general decide whether two 'PmAltCon's match the same set of -- values. In addition to the reasons in 'eqPmLit' and 'eqConLike', a -- 'PmAltConLike' might or might not represent the same value as a 'PmAltLit'. @@ -475,7 +507,7 @@ data VarInfo -- However, no more than one RealDataCon in the list, otherwise contradiction -- because of generativity. - , vi_neg :: ![PmAltCon] + , vi_neg :: !PmAltConSet -- ^ Negative info: A list of 'PmAltCon's that it cannot match. -- Example, assuming -- @@ -489,6 +521,9 @@ data VarInfo -- between 'vi_pos' and 'vi_neg'. -- See Note [Why record both positive and negative info?] + -- It's worth having an actual set rather than a simple association list, + -- because files like Cabal's `LicenseId` define relatively huge enums + -- that lead to quadratic or worse behavior. , vi_cache :: !PossibleMatches -- ^ A cache of the associated COMPLETE sets. At any time a superset of ===================================== compiler/GHC/HsToCore/Quote.hs ===================================== @@ -270,7 +270,7 @@ repTopDs group@(HsGroup { hs_valds = valds = do { let { bndrs = hsScopedTvBinders valds ++ hsGroupBinders group ++ hsPatSynSelectors valds - ; instds = tyclds >>= group_instds } ; + ; instds = tyClGroupInstDecls tyclds } ; ss <- mkGenSyms bndrs ; -- Bind all the names mainly to avoid repeated use of explicit strings. @@ -284,8 +284,8 @@ repTopDs group@(HsGroup { hs_valds = valds do { val_ds <- rep_val_binds valds ; _ <- mapM no_splice splcds ; tycl_ds <- mapM repTyClD (tyClGroupTyClDecls tyclds) - ; role_ds <- mapM repRoleD (concatMap group_roles tyclds) - ; kisig_ds <- mapM repKiSigD (concatMap group_kisigs tyclds) + ; role_ds <- mapM repRoleD (tyClGroupRoleDecls tyclds) + ; kisig_ds <- mapM repKiSigD (tyClGroupKindSigs tyclds) ; inst_ds <- mapM repInstD instds ; deriv_ds <- mapM repStandaloneDerivD derivds ; fix_ds <- mapM repLFixD fixds ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -1261,17 +1261,16 @@ instance ( a ~ GhcPass p XCmd _ -> [] instance ToHie (TyClGroup GhcRn) where - toHie TyClGroup{ group_tyclds = classes - , group_roles = roles - , group_kisigs = sigs - , group_instds = instances } = + toHie TcgRn{ tcg_rn_tyclds = classes + , tcg_rn_roles = roles + , tcg_rn_kisigs = sigs + , tcg_rn_instds = instances } = concatM [ toHie classes - , toHie sigs + , toHie [a | DeclSigRnSAKS _ a <- sigs ] , toHie roles , toHie instances ] - toHie (XTyClGroup _) = pure [] instance ToHie (LTyClDecl GhcRn) where toHie (L span decl) = concatM $ makeNode decl span : case decl of ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -669,7 +669,7 @@ getLocalNonValBinders fixity_env hs_tyclds = tycl_decls, hs_fords = foreign_decls }) = do { -- Process all type/class decls *except* family instances - ; let inst_decls = tycl_decls >>= group_instds + ; let inst_decls = tyClGroupInstDecls tycl_decls ; overload_ok <- xoptM LangExt.DuplicateRecordFields ; (tc_avails, tc_fldss) <- fmap unzip $ mapM (new_tc overload_ok) ===================================== compiler/GHC/Rename/Source.hs ===================================== @@ -52,6 +52,7 @@ import PrelNames ( applicativeClassName, pureAName, thenAName import Name import NameSet import NameEnv +import GHC.Core.TyCon ( TyConFlavour(..) ) import Avail import Outputable import Bag @@ -59,7 +60,8 @@ import BasicTypes ( pprRuleName, TypeOrKind(..) ) import FastString import SrcLoc import GHC.Driver.Session -import Util ( debugIsOn, filterOut, lengthExceeds, partitionWith ) +import Util ( debugIsOn, filterOut, lengthExceeds, + partitionWith, (<&&>) ) import GHC.Driver.Types ( HscEnv, hsc_dflags ) import ListSetOps ( findDupsEq, removeDups, equivClasses ) import Digraph ( SCC, flattenSCC, flattenSCCs, Node(..) @@ -160,7 +162,7 @@ rnSrcDecls group@(HsGroup { hs_valds = val_decls, -- means we'll only report a declaration as unused if it isn't -- mentioned at all. Ah well. traceRn "Start rnTyClDecls" (ppr tycl_decls) ; - (rn_tycl_decls, src_fvs1) <- rnTyClDecls tycl_decls ; + (rn_tycl_decls, kinded_decls, src_fvs1) <- rnTyClDecls tycl_decls ; -- (F) Rename Value declarations right-hand sides traceRn "Start rnmono" empty ; @@ -202,7 +204,7 @@ rnSrcDecls group@(HsGroup { hs_valds = val_decls, last_tcg_env <- getGblEnv ; -- (I) Compute the results and return - let {rn_group = HsGroup { hs_ext = noExtField, + let {rn_group = HsGroup { hs_ext = kinded_decls, hs_valds = rn_val_decls, hs_splcds = rn_splice_decls, hs_tyclds = rn_tycl_decls, @@ -1287,7 +1289,7 @@ constructors] in TcEnv rnTyClDecls :: [TyClGroup GhcPs] - -> RnM ([TyClGroup GhcRn], FreeVars) + -> RnM ([TyClGroup GhcRn], KindedDecls, FreeVars) -- Rename the declarations and do dependency analysis on them rnTyClDecls tycl_ds = do { -- Rename the type/class, instance, and role declaraations @@ -1297,25 +1299,32 @@ rnTyClDecls tycl_ds ; instds_w_fvs <- mapM (wrapLocFstM rnSrcInstDecl) (tyClGroupInstDecls tycl_ds) ; role_annots <- rnRoleAnnots tc_names (tyClGroupRoleDecls tycl_ds) + ; cusks_enabled <- xoptM LangExt.CUSKs <&&> xoptM LangExt.PolyKinds + -- See Note [CUSKs and PolyKinds] in TcTyClsDecls + ; let (kisig_env, kisig_fv_env) = mkKindSig_fv_env kisigs_w_fvs + decl_sig_list = + mapMaybe (mkDeclSigRn cusks_enabled kisig_env . fst) $ + tycls_w_fvs + decl_sig_env = mkNameEnv decl_sig_list + kinded_decls = KindedDecls (mkNameSet (map fst decl_sig_list)) + -- Do SCC analysis on the type/class decls ; rdr_env <- getGlobalRdrEnv ; let tycl_sccs = depAnalTyClDecls rdr_env kisig_fv_env tycls_w_fvs role_annot_env = mkRoleAnnotEnv role_annots - (kisig_env, kisig_fv_env) = mkKindSig_fv_env kisigs_w_fvs inst_ds_map = mkInstDeclFreeVarsMap rdr_env tc_names instds_w_fvs (init_inst_ds, rest_inst_ds) = getInsts [] inst_ds_map first_group | null init_inst_ds = [] - | otherwise = [TyClGroup { group_ext = noExtField - , group_tyclds = [] - , group_kisigs = [] - , group_roles = [] - , group_instds = init_inst_ds }] + | otherwise = [TcgRn { tcg_rn_tyclds = [] + , tcg_rn_kisigs = [] + , tcg_rn_roles = [] + , tcg_rn_instds = init_inst_ds }] (final_inst_ds, groups) - = mapAccumL (mk_group role_annot_env kisig_env) rest_inst_ds tycl_sccs + = mapAccumL (mk_group role_annot_env decl_sig_env) rest_inst_ds tycl_sccs all_fvs = foldr (plusFV . snd) emptyFVs tycls_w_fvs `plusFV` foldr (plusFV . snd) emptyFVs instds_w_fvs `plusFV` @@ -1327,26 +1336,87 @@ rnTyClDecls tycl_ds $$ ppr (flattenSCCs tycl_sccs) $$ ppr final_inst_ds ) ; traceRn "rnTycl dependency analysis made groups" (ppr all_groups) - ; return (all_groups, all_fvs) } + ; return (all_groups, kinded_decls, all_fvs) } where mk_group :: RoleAnnotEnv - -> KindSigEnv + -> NameEnv DeclSigRn -> InstDeclFreeVarsMap -> SCC (LTyClDecl GhcRn) -> (InstDeclFreeVarsMap, TyClGroup GhcRn) - mk_group role_env kisig_env inst_map scc + mk_group role_env decl_sig_env inst_map scc = (inst_map', group) where tycl_ds = flattenSCC scc bndrs = map (tcdName . unLoc) tycl_ds roles = getRoleAnnots bndrs role_env - kisigs = getKindSigs bndrs kisig_env + decl_sigs = getDeclSigs bndrs decl_sig_env (inst_ds, inst_map') = getInsts bndrs inst_map - group = TyClGroup { group_ext = noExtField - , group_tyclds = tycl_ds - , group_kisigs = kisigs - , group_roles = roles - , group_instds = inst_ds } + group = TcgRn { tcg_rn_tyclds = tycl_ds + , tcg_rn_kisigs = decl_sigs + , tcg_rn_roles = roles + , tcg_rn_instds = inst_ds } + +mkDeclSigRn + :: Bool -- ^ CUSKs enabled + -> KindSigEnv + -> LTyClDecl GhcRn + -> Maybe (Name, DeclSigRn) +mkDeclSigRn cusks_enabled kisig_env tcd + -- Stanadlone kind signature + | Just ki <- lookupNameEnv kisig_env name + = Just (name, DeclSigRnSAKS decl_header ki) + -- Complete user-supplied kind + | cusks_enabled && has_cusk + = Just (name, DeclSigRnCUSK decl_header) + -- No signature: needs inference + | otherwise + = Nothing + where + has_cusk = hsDeclHasCusk (unLoc tcd) + name = tcdName (unLoc tcd) + decl_header = mapLoc mkDeclHeaderRn tcd + +mkDeclHeaderRn :: TyClDecl GhcRn -> DeclHeaderRn +mkDeclHeaderRn tcd = case tcd of + -- Class + ClassDecl { tcdLName = name, tcdTyVars = ktvs } + -> DeclHeaderRn + { decl_header_flav = ClassFlavour, + decl_header_name = name, + decl_header_bndrs = ktvs, + decl_header_res_sig = Nothing } + -- Data/Newtype + DataDecl { tcdLName = name + , tcdTyVars = ktvs + , tcdDataDefn = HsDataDefn { dd_kindSig = m_sig + , dd_ND = new_or_data } } + -> DeclHeaderRn + { decl_header_flav = newOrDataToFlavour new_or_data, + decl_header_name = name, + decl_header_bndrs = ktvs, + decl_header_res_sig = m_sig } + -- Type/data family + FamDecl { tcdFam = + FamilyDecl { fdLName = name + , fdTyVars = ktvs + , fdResultSig = L _ resultSig + , fdInfo = info } } + -> DeclHeaderRn + { decl_header_flav = getFamFlav Nothing info, + decl_header_name = name, + decl_header_bndrs = ktvs, + decl_header_res_sig = famResultKindSignature resultSig } + -- Type synonym + SynDecl { tcdLName = name, tcdTyVars = ktvs, tcdRhs = rhs } + -> DeclHeaderRn + { decl_header_flav = TypeSynonymFlavour, + decl_header_name = name, + decl_header_bndrs = ktvs, + decl_header_res_sig = hsTyKindSig rhs } + -- Impossible cases + DataDecl _ _ _ _ (XHsDataDefn nec) -> noExtCon nec + FamDecl {tcdFam = XFamilyDecl nec} -> noExtCon nec + XTyClDecl nec -> noExtCon nec -- | Free variables of standalone kind signatures. newtype KindSig_FV_Env = KindSig_FV_Env (NameEnv FreeVars) @@ -1366,8 +1436,8 @@ mkKindSig_fv_env kisigs_w_fvs = (kisig_env, kisig_fv_env) compound_env :: NameEnv (LStandaloneKindSig GhcRn, FreeVars) = mkNameEnvWith (standaloneKindSigName . unLoc . fst) kisigs_w_fvs -getKindSigs :: [Name] -> KindSigEnv -> [LStandaloneKindSig GhcRn] -getKindSigs bndrs kisig_env = mapMaybe (lookupNameEnv kisig_env) bndrs +getDeclSigs :: [Name] -> NameEnv DeclSigRn -> [DeclSigRn] +getDeclSigs bndrs decl_sig_env = mapMaybe (lookupNameEnv decl_sig_env) bndrs rnStandaloneKindSignatures :: NameSet -- names of types and classes in the current TyClGroup @@ -2306,7 +2376,7 @@ add gp loc (SpliceD _ splice@(SpliceDecl _ _ flag)) ds -- Class declarations: added to the TyClGroup add gp@(HsGroup {hs_tyclds = ts}) l (TyClD _ d) ds - = addl (gp { hs_tyclds = add_tycld (L l d) ts }) ds + = addl (gp { hs_tyclds = TcgPsDecl (L l d) : ts }) ds -- Signatures: fixity sigs go a different place than all others add gp@(HsGroup {hs_fixds = ts}) l (SigD _ (FixSig _ f)) ds @@ -2314,7 +2384,7 @@ add gp@(HsGroup {hs_fixds = ts}) l (SigD _ (FixSig _ f)) ds -- Standalone kind signatures: added to the TyClGroup add gp@(HsGroup {hs_tyclds = ts}) l (KindSigD _ s) ds - = addl (gp {hs_tyclds = add_kisig (L l s) ts}) ds + = addl (gp {hs_tyclds = TcgPsKiSig (L l s) : ts}) ds add gp@(HsGroup {hs_valds = ts}) l (SigD _ d) ds = addl (gp {hs_valds = add_sig (L l d) ts}) ds @@ -2325,13 +2395,13 @@ add gp@(HsGroup {hs_valds = ts}) l (ValD _ d) ds -- Role annotations: added to the TyClGroup add gp@(HsGroup {hs_tyclds = ts}) l (RoleAnnotD _ d) ds - = addl (gp { hs_tyclds = add_role_annot (L l d) ts }) ds + = addl (gp { hs_tyclds = TcgPsRole (L l d) : ts }) ds -- NB instance declarations go into TyClGroups. We throw them into the first -- group, just as we do for the TyClD case. The renamer will go on to group -- and order them later. add gp@(HsGroup {hs_tyclds = ts}) l (InstD _ d) ds - = addl (gp { hs_tyclds = add_instd (L l d) ts }) ds + = addl (gp { hs_tyclds = TcgPsInst (L l d) : ts }) ds -- The rest are routine add gp@(HsGroup {hs_derivds = ts}) l (DerivD _ d) ds @@ -2352,58 +2422,6 @@ add (HsGroup {}) _ (SpliceD _ (XSpliceDecl nec)) _ = noExtCon nec add (HsGroup {}) _ (XHsDecl nec) _ = noExtCon nec add (XHsGroup nec) _ _ _ = noExtCon nec -add_tycld :: LTyClDecl (GhcPass p) -> [TyClGroup (GhcPass p)] - -> [TyClGroup (GhcPass p)] -add_tycld d [] = [TyClGroup { group_ext = noExtField - , group_tyclds = [d] - , group_kisigs = [] - , group_roles = [] - , group_instds = [] - } - ] -add_tycld d (ds@(TyClGroup { group_tyclds = tyclds }):dss) - = ds { group_tyclds = d : tyclds } : dss -add_tycld _ (XTyClGroup nec: _) = noExtCon nec - -add_instd :: LInstDecl (GhcPass p) -> [TyClGroup (GhcPass p)] - -> [TyClGroup (GhcPass p)] -add_instd d [] = [TyClGroup { group_ext = noExtField - , group_tyclds = [] - , group_kisigs = [] - , group_roles = [] - , group_instds = [d] - } - ] -add_instd d (ds@(TyClGroup { group_instds = instds }):dss) - = ds { group_instds = d : instds } : dss -add_instd _ (XTyClGroup nec: _) = noExtCon nec - -add_role_annot :: LRoleAnnotDecl (GhcPass p) -> [TyClGroup (GhcPass p)] - -> [TyClGroup (GhcPass p)] -add_role_annot d [] = [TyClGroup { group_ext = noExtField - , group_tyclds = [] - , group_kisigs = [] - , group_roles = [d] - , group_instds = [] - } - ] -add_role_annot d (tycls@(TyClGroup { group_roles = roles }) : rest) - = tycls { group_roles = d : roles } : rest -add_role_annot _ (XTyClGroup nec: _) = noExtCon nec - -add_kisig :: LStandaloneKindSig (GhcPass p) - -> [TyClGroup (GhcPass p)] -> [TyClGroup (GhcPass p)] -add_kisig d [] = [TyClGroup { group_ext = noExtField - , group_tyclds = [] - , group_kisigs = [d] - , group_roles = [] - , group_instds = [] - } - ] -add_kisig d (tycls@(TyClGroup { group_kisigs = kisigs }) : rest) - = tycls { group_kisigs = d : kisigs } : rest -add_kisig _ (XTyClGroup nec : _) = noExtCon nec - add_bind :: LHsBind a -> HsValBinds a -> HsValBinds a add_bind b (ValBinds x bs sigs) = ValBinds x (bs `snocBag` b) sigs add_bind _ (XValBindsLR {}) = panic "RdrHsSyn:add_bind" ===================================== compiler/typecheck/TcEnv.hs ===================================== @@ -464,7 +464,7 @@ tcLookupTcTyCon name = do thing <- tcLookup name case thing of ATcTyCon tc -> return tc - _ -> pprPanic "tcLookupTcTyCon" (ppr name) + _ -> pprPanic "tcLookupTcTyCon" (ppr name <+> text ":" <+> ppr thing) getInLocalScope :: TcM (Name -> Bool) getInLocalScope = do { lcl_env <- getLclTypeEnv ===================================== compiler/typecheck/TcHsType.hs ===================================== @@ -251,8 +251,8 @@ tcHsSigType ctxt sig_ty skol_info = SigTypeSkol ctxt -- Does validity checking and zonking. -tcStandaloneKindSig :: LStandaloneKindSig GhcRn -> TcM (Name, Kind) -tcStandaloneKindSig (L _ kisig) = case kisig of +tcStandaloneKindSig :: StandaloneKindSig GhcRn -> TcM (Name, Kind) +tcStandaloneKindSig kisig = case kisig of StandaloneKindSig _ (L _ name) ksig -> let ctxt = StandaloneKindSigCtxt name in addSigCtxt ctxt (hsSigType ksig) $ ===================================== compiler/typecheck/TcRnDriver.hs ===================================== @@ -625,7 +625,8 @@ tcRnHsBootDecls hsc_src decls = do { (first_group, group_tail) <- findSplice decls -- Rename the declarations - ; (tcg_env, HsGroup { hs_tyclds = tycl_decls + ; (tcg_env, HsGroup { hs_ext = kinded_decls + , hs_tyclds = tycl_decls , hs_derivds = deriv_decls , hs_fords = for_decls , hs_defds = def_decls @@ -653,7 +654,7 @@ tcRnHsBootDecls hsc_src decls -- Typecheck type/class/instance decls ; traceTc "Tc2 (boot)" empty ; (tcg_env, inst_infos, _deriv_binds) - <- tcTyClsInstDecls tycl_decls deriv_decls val_binds + <- tcTyClsInstDecls kinded_decls tycl_decls deriv_decls val_binds ; setGblEnv tcg_env $ do { -- Emit Typeable bindings @@ -1396,7 +1397,8 @@ rnTopSrcDecls group } tcTopSrcDecls :: HsGroup GhcRn -> TcM (TcGblEnv, TcLclEnv) -tcTopSrcDecls (HsGroup { hs_tyclds = tycl_decls, +tcTopSrcDecls (HsGroup { hs_ext = kinded_decls, + hs_tyclds = tycl_decls, hs_derivds = deriv_decls, hs_fords = foreign_decls, hs_defds = default_decls, @@ -1412,7 +1414,7 @@ tcTopSrcDecls (HsGroup { hs_tyclds = tycl_decls, -- and import the supporting declarations traceTc "Tc3" empty ; (tcg_env, inst_infos, XValBindsLR (NValBinds deriv_binds deriv_sigs)) - <- tcTyClsInstDecls tycl_decls deriv_decls val_binds ; + <- tcTyClsInstDecls kinded_decls tycl_decls deriv_decls val_binds ; setGblEnv tcg_env $ do { @@ -1681,7 +1683,8 @@ tcMissingParentClassWarn warnFlag isName shouldName --------------------------- -tcTyClsInstDecls :: [TyClGroup GhcRn] +tcTyClsInstDecls :: KindedDecls + -> [TyClGroup GhcRn] -> [LDerivDecl GhcRn] -> [(RecFlag, LHsBinds GhcRn)] -> TcM (TcGblEnv, -- The full inst env @@ -1691,11 +1694,11 @@ tcTyClsInstDecls :: [TyClGroup GhcRn] HsValBinds GhcRn) -- Supporting bindings for derived -- instances -tcTyClsInstDecls tycl_decls deriv_decls binds - = tcAddDataFamConPlaceholders (tycl_decls >>= group_instds) $ +tcTyClsInstDecls kinded_decls tycl_decls deriv_decls binds + = tcAddDataFamConPlaceholders (tyClGroupInstDecls tycl_decls) $ tcAddPatSynPlaceholders (getPatSynBinds binds) $ do { (tcg_env, inst_info, deriv_info) - <- tcTyAndClassDecls tycl_decls ; + <- tcTyAndClassDecls kinded_decls tycl_decls ; ; setGblEnv tcg_env $ do { -- With the @TyClDecl at s and @InstDecl at s checked we're ready to -- process the deriving clauses, including data family deriving ===================================== compiler/typecheck/TcTyClsDecls.hs ===================================== @@ -123,7 +123,25 @@ Thus, we take two passes over the resulting tycons, first checking for general validity and then checking for valid role annotations. -} -tcTyAndClassDecls :: [TyClGroup GhcRn] -- Mutually-recursive groups in +-- | TcTyCons generated from SAKS/CUSKs, whose definitions occur in a later TyClGroup. +newtype InterGroupEnv = InterGroupEnv (NameEnv TcTyCon) + +emptyInterGroupEnv :: InterGroupEnv +emptyInterGroupEnv = InterGroupEnv emptyNameEnv + +extendInterGroupEnv :: [TcTyCon] -> InterGroupEnv -> InterGroupEnv +extendInterGroupEnv tcs (InterGroupEnv env) = InterGroupEnv (extendNameEnvList env named_tcs) + where named_tcs = map (\tc -> (tyConName tc, tc)) tcs + +purgeInterGroupEnv :: [TcTyCon] -> InterGroupEnv -> InterGroupEnv +purgeInterGroupEnv tcs (InterGroupEnv env) = InterGroupEnv (delListFromNameEnv env tcs_names) + where tcs_names = map tyConName tcs + +interGroupEnvTyCons :: InterGroupEnv -> [TcTyCon] +interGroupEnvTyCons (InterGroupEnv env )= nameEnvElts env + +tcTyAndClassDecls :: KindedDecls + -> [TyClGroup GhcRn] -- Mutually-recursive groups in -- dependency order -> TcM ( TcGblEnv -- Input env extended by types and -- classes @@ -132,44 +150,58 @@ tcTyAndClassDecls :: [TyClGroup GhcRn] -- Mutually-recursive groups in , [DerivInfo] -- Deriving info ) -- Fails if there are any errors -tcTyAndClassDecls tyclds_s +tcTyAndClassDecls kinded_decls tyclds_s -- The code recovers internally, but if anything gave rise to -- an error we'd better stop now, to avoid a cascade -- Type check each group in dependency order folding the global env - = checkNoErrs $ fold_env [] [] tyclds_s + = checkNoErrs $ fold_env emptyInterGroupEnv [] [] tyclds_s where - fold_env :: [InstInfo GhcRn] + fold_env :: InterGroupEnv + -> [InstInfo GhcRn] -> [DerivInfo] -> [TyClGroup GhcRn] -> TcM (TcGblEnv, [InstInfo GhcRn], [DerivInfo]) - fold_env inst_info deriv_info [] + fold_env _ inst_info deriv_info [] = do { gbl_env <- getGblEnv ; return (gbl_env, inst_info, deriv_info) } - fold_env inst_info deriv_info (tyclds:tyclds_s) - = do { (tcg_env, inst_info', deriv_info') <- tcTyClGroup tyclds + fold_env inter_group_env inst_info deriv_info (tyclds:tyclds_s) + = do { (tcg_env, inter_group_env', inst_info', deriv_info') <- + tcTyClGroup kinded_decls inter_group_env tyclds ; setGblEnv tcg_env $ -- remaining groups are typechecked in the extended global env. - fold_env (inst_info' ++ inst_info) + fold_env inter_group_env' + (inst_info' ++ inst_info) (deriv_info' ++ deriv_info) tyclds_s } -tcTyClGroup :: TyClGroup GhcRn - -> TcM (TcGblEnv, [InstInfo GhcRn], [DerivInfo]) +tcTyClGroup :: KindedDecls + -> InterGroupEnv + -> TyClGroup GhcRn + -> TcM (TcGblEnv, InterGroupEnv, [InstInfo GhcRn], [DerivInfo]) -- Typecheck one strongly-connected component of type, class, and instance decls -- See Note [TyClGroups and dependency analysis] in GHC.Hs.Decls -tcTyClGroup (TyClGroup { group_tyclds = tyclds - , group_roles = roles - , group_kisigs = kisigs - , group_instds = instds }) +tcTyClGroup kinded_decls inter_group_env + (TcgRn { tcg_rn_tyclds = tyclds + , tcg_rn_roles = roles + , tcg_rn_kisigs = kisigs + , tcg_rn_instds = instds }) = do { let role_annots = mkRoleAnnotEnv roles -- Step 1: Typecheck the standalone kind signatures and type/class declarations ; traceTc "---- tcTyClGroup ---- {" empty ; traceTc "Decls for" (ppr (map (tcdName . unLoc) tyclds)) - ; (tyclss, data_deriv_info) <- + ; (inter_group_env', tyclss, data_deriv_info) <- tcExtendKindEnv (mkPromotionErrorEnv tyclds) $ -- See Note [Type environment evolution] - do { kisig_env <- mkNameEnv <$> traverse tcStandaloneKindSig kisigs - ; tcTyClDecls tyclds kisig_env role_annots } + do { checked_tcs <- + tcExtendKindEnv (mkSigPromotionErrorEnv kisigs) $ + traverse tcDeclSig kisigs + ; let extended_inter_group_env = extendInterGroupEnv checked_tcs inter_group_env + ; (tyclss, data_deriv_info) <- + tcExtendKindEnvWithTyCons (interGroupEnvTyCons extended_inter_group_env) $ + tcTyClDecls tyclds kinded_decls role_annots + ; let purged_inter_group_env = purgeInterGroupEnv tyclss extended_inter_group_env + ; return (purged_inter_group_env, tyclss, data_deriv_info) + } -- Step 1.5: Make sure we don't have any type synonym cycles ; traceTc "Starting synonym cycle check" (ppr tyclss) @@ -200,24 +232,66 @@ tcTyClGroup (TyClGroup { group_tyclds = tyclds tcInstDecls1 instds ; let deriv_info = datafam_deriv_info ++ data_deriv_info - ; return (gbl_env', inst_info, deriv_info) } - - -tcTyClGroup (XTyClGroup nec) = noExtCon nec + ; return (gbl_env', inter_group_env', inst_info, deriv_info) } + +tcDeclSig :: DeclSigRn -> TcM TcTyCon +tcDeclSig (DeclSigRnCUSK (L l hdr)) = + setSrcSpan l $ check_decl_sig CUSK hdr +tcDeclSig (DeclSigRnSAKS (L l_hdr hdr) (L l_sig kisig)) = do + (_, ki) <- setSrcSpan l_sig $ tcStandaloneKindSig kisig + setSrcSpan l_hdr $ check_decl_sig (SAKS ki) hdr + +check_decl_sig :: SAKS_or_CUSK -> DeclHeaderRn -> TcM TcTyCon +check_decl_sig msig hdr = + kcDeclHeader (InitialKindCheck msig) name flav (decl_header_bndrs hdr) $ + if | flav == ClassFlavour + -> return (TheKind constraintKind) + + | flav == DataTypeFlavour + -> case res_sig of + Just ksig -> TheKind <$> tcLHsKindSig (DataKindCtxt name) ksig + Nothing -> return $ dataDeclDefaultResultKind DataType + + | flav == NewtypeFlavour + -> case res_sig of + Just ksig -> TheKind <$> tcLHsKindSig (DataKindCtxt name) ksig + Nothing -> return $ dataDeclDefaultResultKind NewType + + | is_fam_flav flav + -> case res_sig of + Just ksig -> TheKind <$> tcLHsKindSig (TyFamResKindCtxt name) ksig + Nothing -> + case msig of + CUSK -> return (TheKind liftedTypeKind) + SAKS _ -> return AnyKind + + | flav == TypeSynonymFlavour + -> case res_sig of + Just rhs_sig -> TheKind <$> tcLHsKindSig (TySynKindCtxt name) rhs_sig + Nothing -> return AnyKind + + | otherwise -> return AnyKind + where + L _ name = decl_header_name hdr + flav = decl_header_flav hdr + res_sig = decl_header_res_sig hdr --- Gives the kind for every TyCon that has a standalone kind signature -type KindSigEnv = NameEnv Kind +is_fam_flav :: TyConFlavour -> Bool +is_fam_flav DataFamilyFlavour{} = True +is_fam_flav OpenTypeFamilyFlavour{} = True +is_fam_flav ClosedTypeFamilyFlavour = True +is_fam_flav _ = False tcTyClDecls :: [LTyClDecl GhcRn] - -> KindSigEnv + -> KindedDecls -> RoleAnnotEnv -> TcM ([TyCon], [DerivInfo]) -tcTyClDecls tyclds kisig_env role_annots +tcTyClDecls tyclds kinded_decls role_annots = do { -- Step 1: kind-check this group and returns the final -- (possibly-polymorphic) kind of each TyCon and Class -- See Note [Kind checking for type and class decls] - tc_tycons <- kcTyClGroup kisig_env tyclds + tc_tycons <- kcTyClGroup kinded_decls tyclds ; traceTc "tcTyAndCl generalized kinds" (vcat (map ppr_tc_tycon tc_tycons)) -- Step 2: type-check all groups together, returning @@ -618,13 +692,13 @@ been generalized. -} -kcTyClGroup :: KindSigEnv -> [LTyClDecl GhcRn] -> TcM [TcTyCon] +kcTyClGroup :: KindedDecls -> [LTyClDecl GhcRn] -> TcM [TcTyCon] -- Kind check this group, kind generalize, and return the resulting local env -- This binds the TyCons and Classes of the group, but not the DataCons -- See Note [Kind checking for type and class decls] -- and Note [Inferring kinds for type declarations] -kcTyClGroup kisig_env decls +kcTyClGroup kd_set decls = do { mod <- getModule ; traceTc "---- kcTyClGroup ---- {" (text "module" <+> ppr mod $$ vcat (map ppr decls)) @@ -635,22 +709,16 @@ kcTyClGroup kisig_env decls -- 3. Generalise the inferred kinds -- See Note [Kind checking for type and class decls] - ; cusks_enabled <- xoptM LangExt.CUSKs <&&> xoptM LangExt.PolyKinds - -- See Note [CUSKs and PolyKinds] ; let (kindless_decls, kinded_decls) = partitionWith get_kind decls - get_kind d - | Just ki <- lookupNameEnv kisig_env (tcdName (unLoc d)) - = Right (d, SAKS ki) + get_kind (L l d) + | isKindedDecl kd_set d = Right d + | otherwise = Left (L l d) - | cusks_enabled && hsDeclHasCusk (unLoc d) - = Right (d, CUSK) - - | otherwise = Left d - - ; checked_tcs <- checkInitialKinds kinded_decls + ; (checked_tcs, concat -> checked_assoc_tcs) <- + mapAndUnzipM checkKindedDecl kinded_decls ; inferred_tcs - <- tcExtendKindEnvWithTyCons checked_tcs $ + <- tcExtendKindEnvWithTyCons checked_assoc_tcs $ pushTcLevelM_ $ -- We are going to kind-generalise, so -- unification variables in here must -- be one level in @@ -679,7 +747,7 @@ kcTyClGroup kisig_env decls ; generalized_tcs <- concatMapM (generaliseTyClDecl inferred_tc_env) kindless_decls - ; let poly_tcs = checked_tcs ++ generalized_tcs + ; let poly_tcs = checked_tcs ++ checked_assoc_tcs ++ generalized_tcs ; traceTc "---- kcTyClGroup end ---- }" (ppr_tc_kinds poly_tcs) ; return poly_tcs } where @@ -1254,6 +1322,21 @@ mk_prom_err_env decl = unitNameEnv (tcdName decl) (APromotionErr TyConPE) -- Works for family declarations too +mkSigPromotionErrorEnv :: [DeclSigRn] -> TcTypeEnv +mkSigPromotionErrorEnv = + foldr (plusNameEnv . mk_sig_prom_err_env) emptyNameEnv + +mk_sig_prom_err_env :: DeclSigRn -> TcTypeEnv +mk_sig_prom_err_env sig = + unitNameEnv (unLoc (decl_header_name hdr)) + (case decl_header_flav hdr of + ClassFlavour -> APromotionErr ClassPE + _ -> APromotionErr TyConPE) + where + hdr = case sig of + DeclSigRnCUSK (L _ h) -> h + DeclSigRnSAKS (L _ h) _ -> h + -------------- inferInitialKinds :: [LTyClDecl GhcRn] -> TcM [TcTyCon] -- Returns a TcTyCon for each TyCon bound by the decls, @@ -1261,27 +1344,24 @@ inferInitialKinds :: [LTyClDecl GhcRn] -> TcM [TcTyCon] inferInitialKinds decls = do { traceTc "inferInitialKinds {" $ ppr (map (tcdName . unLoc) decls) - ; tcs <- concatMapM infer_initial_kind decls + ; tcs <- concatMapM (addLocM inferInitialKind) decls ; traceTc "inferInitialKinds done }" empty ; return tcs } - where - infer_initial_kind = addLocM (getInitialKind InitialKindInfer) - --- Check type/class declarations against their standalone kind signatures or --- CUSKs, producing a generalized TcTyCon for each. -checkInitialKinds :: [(LTyClDecl GhcRn, SAKS_or_CUSK)] -> TcM [TcTyCon] -checkInitialKinds decls - = do { traceTc "checkInitialKinds {" $ ppr (mapFst (tcdName . unLoc) decls) - ; tcs <- concatMapM check_initial_kind decls - ; traceTc "checkInitialKinds done }" empty - ; return tcs } - where - check_initial_kind (ldecl, msig) = - addLocM (getInitialKind (InitialKindCheck msig)) ldecl --- | Get the initial kind of a TyClDecl, either generalized or non-generalized, --- depending on the 'InitialKindStrategy'. -getInitialKind :: InitialKindStrategy -> TyClDecl GhcRn -> TcM [TcTyCon] +checkKindedDecl :: TyClDecl GhcRn -> TcM (TcTyCon, [TcTyCon]) +checkKindedDecl (ClassDecl { tcdLName = L _ name , tcdATs = ats }) + = do { cls <- tcLookupTcTyCon name + ; let parent_tv_prs = tcTyConScopedTyVars cls + ; inner_tcs <- + tcExtendNameTyVarEnv parent_tv_prs $ + mapM (addLocM (check_initial_kind_assoc_fam cls)) ats + ; return (cls, inner_tcs) } +checkKindedDecl d + = do { tc <- tcLookupTcTyCon (tcdName d) + ; return (tc, []) } + +-- | Get the initial, non-generalized kind of a TyClDecl. +inferInitialKind :: TyClDecl GhcRn -> TcM [TcTyCon] -- Allocate a fresh kind variable for each TyCon and Class -- For each tycon, return a TcTyCon with kind k @@ -1296,71 +1376,49 @@ getInitialKind :: InitialKindStrategy -> TyClDecl GhcRn -> TcM [TcTyCon] -- * The result kinds signature on a TyClDecl -- -- No family instances are passed to checkInitialKinds/inferInitialKinds -getInitialKind strategy +inferInitialKind (ClassDecl { tcdLName = L _ name , tcdTyVars = ktvs , tcdATs = ats }) - = do { cls <- kcDeclHeader strategy name ClassFlavour ktvs $ + = do { cls <- kcDeclHeader InitialKindInfer name ClassFlavour ktvs $ return (TheKind constraintKind) ; let parent_tv_prs = tcTyConScopedTyVars cls -- See Note [Don't process associated types in getInitialKind] ; inner_tcs <- tcExtendNameTyVarEnv parent_tv_prs $ - mapM (addLocM (getAssocFamInitialKind cls)) ats + mapM (addLocM (get_fam_decl_initial_kind (Just cls))) ats ; return (cls : inner_tcs) } - where - getAssocFamInitialKind cls = - case strategy of - InitialKindInfer -> get_fam_decl_initial_kind (Just cls) - InitialKindCheck _ -> check_initial_kind_assoc_fam cls -getInitialKind strategy +inferInitialKind (DataDecl { tcdLName = L _ name , tcdTyVars = ktvs , tcdDataDefn = HsDataDefn { dd_kindSig = m_sig , dd_ND = new_or_data } }) = do { let flav = newOrDataToFlavour new_or_data ctxt = DataKindCtxt name - ; tc <- kcDeclHeader strategy name flav ktvs $ + ; tc <- kcDeclHeader InitialKindInfer name flav ktvs $ case m_sig of Just ksig -> TheKind <$> tcLHsKindSig ctxt ksig Nothing -> return $ dataDeclDefaultResultKind new_or_data ; return [tc] } -getInitialKind InitialKindInfer (FamDecl { tcdFam = decl }) +inferInitialKind (FamDecl { tcdFam = decl }) = do { tc <- get_fam_decl_initial_kind Nothing decl ; return [tc] } -getInitialKind (InitialKindCheck msig) (FamDecl { tcdFam = - FamilyDecl { fdLName = unLoc -> name - , fdTyVars = ktvs - , fdResultSig = unLoc -> resultSig - , fdInfo = info } } ) - = do { let flav = getFamFlav Nothing info - ctxt = TyFamResKindCtxt name - ; tc <- kcDeclHeader (InitialKindCheck msig) name flav ktvs $ - case famResultKindSignature resultSig of - Just ksig -> TheKind <$> tcLHsKindSig ctxt ksig - Nothing -> - case msig of - CUSK -> return (TheKind liftedTypeKind) - SAKS _ -> return AnyKind - ; return [tc] } - -getInitialKind strategy +inferInitialKind (SynDecl { tcdLName = L _ name , tcdTyVars = ktvs , tcdRhs = rhs }) = do { let ctxt = TySynKindCtxt name - ; tc <- kcDeclHeader strategy name TypeSynonymFlavour ktvs $ + ; tc <- kcDeclHeader InitialKindInfer name TypeSynonymFlavour ktvs $ case hsTyKindSig rhs of Just rhs_sig -> TheKind <$> tcLHsKindSig ctxt rhs_sig Nothing -> return AnyKind ; return [tc] } -getInitialKind _ (DataDecl _ _ _ _ (XHsDataDefn nec)) = noExtCon nec -getInitialKind _ (FamDecl {tcdFam = XFamilyDecl nec}) = noExtCon nec -getInitialKind _ (XTyClDecl nec) = noExtCon nec +inferInitialKind (DataDecl _ _ _ _ (XHsDataDefn nec)) = noExtCon nec +inferInitialKind (XTyClDecl nec) = noExtCon nec get_fam_decl_initial_kind :: Maybe TcTyCon -- ^ Just cls <=> this is an associated family of class cls @@ -1473,29 +1531,6 @@ See Note [Implementation of UnliftedNewtypes], STEP 1 and it's sub-note . -} ---------------------------------- -getFamFlav - :: Maybe TcTyCon -- ^ Just cls <=> this is an associated family of class cls - -> FamilyInfo pass - -> TyConFlavour -getFamFlav mb_parent_tycon info = - case info of - DataFamily -> DataFamilyFlavour mb_parent_tycon - OpenTypeFamily -> OpenTypeFamilyFlavour mb_parent_tycon - ClosedTypeFamily _ -> ASSERT( isNothing mb_parent_tycon ) -- See Note [Closed type family mb_parent_tycon] - ClosedTypeFamilyFlavour - -{- Note [Closed type family mb_parent_tycon] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -There's no way to write a closed type family inside a class declaration: - - class C a where - type family F a where -- error: parse error on input ‘where’ - -In fact, it is not clear what the meaning of such a declaration would be. -Therefore, 'mb_parent_tycon' of any closed type family has to be Nothing. --} - ------------------------------------------------------------------------ kcLTyClDecl :: LTyClDecl GhcRn -> TcM () -- See Note [Kind checking for type and class decls] ===================================== docs/users_guide/exts/ffi.rst ===================================== @@ -37,31 +37,51 @@ Guaranteed call safety ~~~~~~~~~~~~~~~~~~~~~~ The Haskell 2010 Report specifies that ``safe`` FFI calls must allow foreign -calls to safely call into Haskell code. In practice, this means that the -garbage collector must be able to run while these calls are in progress, -moving heap-allocated Haskell values around arbitrarily. +calls to safely call into Haskell code. In practice, this means that called +functions also have to assume heap-allocated Haskell values may move around +arbitrarily in order to allow for GC. This greatly constrains library authors since it implies that it is not safe to pass any heap object reference to a ``safe`` foreign function call. For -instance, it is often desirable to pass an :ref:`unpinned ` +instance, it is often desirable to pass :ref:`unpinned ` ``ByteArray#``\s directly to native code to avoid making an otherwise-unnecessary -copy. However, this can only be done safely if the array is guaranteed not to be -moved by the garbage collector in the middle of the call. +copy. However, this can not be done safely for ``safe`` calls since the array might +be moved by the garbage collector in the middle of the call. -The Chapter does *not* require implementations to refrain from doing the -same for ``unsafe`` calls, so strictly Haskell 2010-conforming programs +The Chapter *does* allow for implementations to move objects around during +``unsafe`` calls as well. So strictly Haskell 2010-conforming programs cannot pass heap-allocated references to ``unsafe`` FFI calls either. +GHC, since version 8.4, **guarantees** that garbage collection will never occur +during an ``unsafe`` call, even in the bytecode interpreter, and further guarantees +that ``unsafe`` calls will be performed in the calling thread. Making it safe to +pass heap-allocated objects to unsafe functions. + In previous releases, GHC would take advantage of the freedom afforded by the Chapter by performing ``safe`` foreign calls in place of ``unsafe`` calls in the bytecode interpreter. This meant that some packages which worked when -compiled would fail under GHCi (e.g. :ghc-ticket:`13730`). +compiled would fail under GHCi (e.g. :ghc-ticket:`13730`). But this is no +longer the case in recent releases. + +Interactions between ``safe`` calls and bound threads +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +A ``safe`` call calling into haskell is run on a bound thread by +the RTS. This means any nesting of ``safe`` calls will be executed on +the same operating system thread. *Sequential* ``safe`` calls however +do not enjoy this luxury and may be run on arbitrary OS threads. -However, since version 8.4 this is no longer the case: GHC **guarantees** that -garbage collection will never occur during an ``unsafe`` call, even in the -bytecode interpreter, and further guarantees that ``unsafe`` calls will be -performed in the calling thread. +This behaviour is considered an implementation detail and code relying on +thread local state should instead use one of the interfaces provided +in :base-ref:`Control.Concurrent.` to make this explicit. +For information on what bound threads are, +see the documentation for the :base-ref:`Control.Concurrent.`. + +For more details on the implementation see the Paper: +"Extending the Haskell Foreign Function Interface with Concurrency". +Last known to be accessible `here +`_. .. _ffi-ghcexts: @@ -100,7 +120,7 @@ restrictions: of heap objects record writes for the purpose of garbage collection. An array of heap objects is passed to a foreign C function, the runtime does not record any writes. Consequently, it is not safe to - write to an array of heap objects in a foreign function. + write to an array of heap objects in a foreign function. Since the runtime has no facilities for tracking mutation of a ``MutableByteArray#``, these can be safely mutated in any foreign function. @@ -169,7 +189,7 @@ In other situations, the C function may need knowledge of the RTS closure types. The following example sums the first element of each ``ByteArray#`` (interpreting the bytes as an array of ``CInt``) element of an ``ArrayArray##`` [3]_:: - + // C source, must include the RTS to make the struct StgArrBytes // available along with its fields: ptrs and payload. #include "Rts.h" ===================================== testsuite/tests/parser/should_compile/DumpRenamedAst.stderr ===================================== @@ -4,7 +4,12 @@ (Just ((,,,) (HsGroup - (NoExtField) + (KindedDecls + {NameSet: + [{Name: DumpRenamedAst.F1} + ,{Name: DumpRenamedAst.Length} + ,{Name: DumpRenamedAst.Nat} + ,{Name: DumpRenamedAst.Peano}]}) (XValBindsLR (NValBinds [((,) @@ -56,8 +61,7 @@ []))]})] [])) [] - [(TyClGroup - (NoExtField) + [(TcgRn [({ DumpRenamedAst.hs:9:1-30 } (DataDecl (DataDeclRn @@ -109,10 +113,18 @@ ({ } []))))] [] - [] + [(DeclSigRnCUSK + ({ DumpRenamedAst.hs:9:1-30 } + (DeclHeaderRn + (DataTypeFlavour) + ({ DumpRenamedAst.hs:9:6-10 } + {Name: DumpRenamedAst.Peano}) + (HsQTvs + [] + []) + (Nothing))))] []) - ,(TyClGroup - (NoExtField) + ,(TcgRn [({ DumpRenamedAst.hs:11:1-39 } (FamDecl (NoExtField) @@ -229,10 +241,37 @@ {Name: DumpRenamedAst.Peano}))))) (Nothing))))] [] - [] + [(DeclSigRnCUSK + ({ DumpRenamedAst.hs:11:1-39 } + (DeclHeaderRn + (ClosedTypeFamilyFlavour) + ({ DumpRenamedAst.hs:11:13-18 } + {Name: DumpRenamedAst.Length}) + (HsQTvs + [{Name: k}] + [({ DumpRenamedAst.hs:11:21-29 } + (KindedTyVar + (NoExtField) + ({ DumpRenamedAst.hs:11:21-22 } + {Name: as}) + ({ DumpRenamedAst.hs:11:27-29 } + (HsListTy + (NoExtField) + ({ DumpRenamedAst.hs:11:28 } + (HsTyVar + (NoExtField) + (NotPromoted) + ({ DumpRenamedAst.hs:11:28 } + {Name: k})))))))]) + (Just + ({ DumpRenamedAst.hs:11:35-39 } + (HsTyVar + (NoExtField) + (NotPromoted) + ({ DumpRenamedAst.hs:11:35-39 } + {Name: DumpRenamedAst.Peano})))))))] []) - ,(TyClGroup - (NoExtField) + ,(TcgRn [({ DumpRenamedAst.hs:15:1-33 } (FamDecl (NoExtField) @@ -274,7 +313,41 @@ {Name: GHC.Types.Type}))))))))) (Nothing))))] [] - [] + [(DeclSigRnCUSK + ({ DumpRenamedAst.hs:15:1-33 } + (DeclHeaderRn + (DataFamilyFlavour + (Nothing)) + ({ DumpRenamedAst.hs:15:13-15 } + {Name: DumpRenamedAst.Nat}) + (HsQTvs + [{Name: k}] + []) + (Just + ({ DumpRenamedAst.hs:15:20-33 } + (HsFunTy + (NoExtField) + ({ DumpRenamedAst.hs:15:20 } + (HsTyVar + (NoExtField) + (NotPromoted) + ({ DumpRenamedAst.hs:15:20 } + {Name: k}))) + ({ DumpRenamedAst.hs:15:25-33 } + (HsFunTy + (NoExtField) + ({ DumpRenamedAst.hs:15:25 } + (HsTyVar + (NoExtField) + (NotPromoted) + ({ DumpRenamedAst.hs:15:25 } + {Name: k}))) + ({ DumpRenamedAst.hs:15:30-33 } + (HsTyVar + (NoExtField) + (NotPromoted) + ({ DumpRenamedAst.hs:15:30-33 } + {Name: GHC.Types.Type})))))))))))] [({ DumpRenamedAst.hs:(18,1)-(19,45) } (DataFamInstD (NoExtField) @@ -435,8 +508,7 @@ (Nothing)))] ({ } [])))))))]) - ,(TyClGroup - (NoExtField) + ,(TcgRn [({ DumpRenamedAst.hs:21:1-29 } (DataDecl (DataDeclRn @@ -506,8 +578,7 @@ [] [] []) - ,(TyClGroup - (NoExtField) + ,(TcgRn [({ DumpRenamedAst.hs:23:1-48 } (FamDecl (NoExtField) @@ -627,7 +698,52 @@ {Name: GHC.Types.Type}))))) (Nothing))))] [] - [] + [(DeclSigRnCUSK + ({ DumpRenamedAst.hs:23:1-48 } + (DeclHeaderRn + (ClosedTypeFamilyFlavour) + ({ DumpRenamedAst.hs:23:13-14 } + {Name: DumpRenamedAst.F1}) + (HsQTvs + [{Name: k}] + [({ DumpRenamedAst.hs:23:17-22 } + (KindedTyVar + (NoExtField) + ({ DumpRenamedAst.hs:23:17 } + {Name: a}) + ({ DumpRenamedAst.hs:23:22 } + (HsTyVar + (NoExtField) + (NotPromoted) + ({ DumpRenamedAst.hs:23:22 } + {Name: k}))))) + ,({ DumpRenamedAst.hs:23:26-39 } + (KindedTyVar + (NoExtField) + ({ DumpRenamedAst.hs:23:26 } + {Name: f}) + ({ DumpRenamedAst.hs:23:31-39 } + (HsFunTy + (NoExtField) + ({ DumpRenamedAst.hs:23:31 } + (HsTyVar + (NoExtField) + (NotPromoted) + ({ DumpRenamedAst.hs:23:31 } + {Name: k}))) + ({ DumpRenamedAst.hs:23:36-39 } + (HsTyVar + (NoExtField) + (NotPromoted) + ({ DumpRenamedAst.hs:23:36-39 } + {Name: GHC.Types.Type})))))))]) + (Just + ({ DumpRenamedAst.hs:23:45-48 } + (HsTyVar + (NoExtField) + (NotPromoted) + ({ DumpRenamedAst.hs:23:45-48 } + {Name: GHC.Types.Type})))))))] [])] [] [] ===================================== testsuite/tests/parser/should_compile/T14189.stderr ===================================== @@ -4,14 +4,15 @@ (Just ((,,,) (HsGroup - (NoExtField) + (KindedDecls + {NameSet: + []}) (XValBindsLR (NValBinds [] [])) [] - [(TyClGroup - (NoExtField) + [(TcgRn [({ T14189.hs:6:1-42 } (DataDecl (DataDeclRn View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/8c28209b53e324fd56fdc184db3e88ea82009b70...2d7968dd8b157b9875a5de475887ab15ac666e23 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/8c28209b53e324fd56fdc184db3e88ea82009b70...2d7968dd8b157b9875a5de475887ab15ac666e23 You're receiving 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 Mar 18 07:55:58 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 18 Mar 2020 03:55:58 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: Modules: Core operations (#13009) Message-ID: <5e71d40eead57_488a8eac47018518c7@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: f7bbadc3 by Sylvain Henry at 2020-03-18T07:55:45Z Modules: Core operations (#13009) - - - - - 77e28fc2 by Richard Eisenberg at 2020-03-18T07:55:46Z 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. - - - - - 30 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/simplCore/CSE.hs → compiler/GHC/Core/Op/CSE.hs - compiler/simplCore/CallArity.hs → compiler/GHC/Core/Op/CallArity.hs - compiler/prelude/PrelRules.hs → compiler/GHC/Core/Op/ConstantFold.hs - compiler/stranal/CprAnal.hs → compiler/GHC/Core/Op/CprAnal.hs - compiler/stranal/DmdAnal.hs → compiler/GHC/Core/Op/DmdAnal.hs - compiler/simplCore/Exitify.hs → compiler/GHC/Core/Op/Exitify.hs - compiler/simplCore/FloatIn.hs → compiler/GHC/Core/Op/FloatIn.hs - compiler/simplCore/FloatOut.hs → compiler/GHC/Core/Op/FloatOut.hs - compiler/simplCore/LiberateCase.hs → compiler/GHC/Core/Op/LiberateCase.hs - compiler/simplCore/CoreMonad.hs → compiler/GHC/Core/Op/Monad.hs - compiler/simplCore/CoreMonad.hs-boot → compiler/GHC/Core/Op/Monad.hs-boot - compiler/simplCore/OccurAnal.hs → compiler/GHC/Core/Op/OccurAnal.hs - compiler/simplCore/SetLevels.hs → compiler/GHC/Core/Op/SetLevels.hs - compiler/simplCore/Simplify.hs → compiler/GHC/Core/Op/Simplify.hs - compiler/simplCore/SimplCore.hs → compiler/GHC/Core/Op/Simplify/Driver.hs - compiler/simplCore/SimplEnv.hs → compiler/GHC/Core/Op/Simplify/Env.hs - compiler/simplCore/SimplMonad.hs → compiler/GHC/Core/Op/Simplify/Monad.hs - compiler/simplCore/SimplUtils.hs → compiler/GHC/Core/Op/Simplify/Utils.hs - compiler/specialise/SpecConstr.hs → compiler/GHC/Core/Op/SpecConstr.hs - compiler/specialise/Specialise.hs → compiler/GHC/Core/Op/Specialise.hs - compiler/simplCore/SAT.hs → compiler/GHC/Core/Op/StaticArgs.hs - compiler/GHC/Core/Op/Tidy.hs - compiler/stranal/WorkWrap.hs → compiler/GHC/Core/Op/WorkWrap.hs - compiler/stranal/WwLib.hs → compiler/GHC/Core/Op/WorkWrap/Lib.hs - compiler/simplCore/simplifier.tib → compiler/GHC/Core/Op/simplifier.tib The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/093188bf6ebb8e4dc6f8f2c37346e5df7ce1831d...77e28fc29d2309d03daaf46563c9a5b5d6db363e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/093188bf6ebb8e4dc6f8f2c37346e5df7ce1831d...77e28fc29d2309d03daaf46563c9a5b5d6db363e You're receiving 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 Mar 18 21:14:52 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 18 Mar 2020 17:14:52 -0400 Subject: [Git][ghc/ghc][wip/T17917] 43 commits: hadrian: improve dependency tracking for the check-* programs Message-ID: <5e728f4ce84c2_488a3fc6cb49d8fc20317f2@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T17917 at Glasgow Haskell Compiler / GHC Commits: 6a65b8c2 by Alp Mestanogullari at 2020-03-13T06:29:20Z 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-13T06:30:22Z 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-13T06:31:03Z Update documentation for closureSize - - - - - f124ff0d by Ben Gamari at 2020-03-13T06:31:40Z gitlab-ci: Rework triggering of release builds Use a push option instead of tagging. - - - - - 7f25557a by Ben Gamari at 2020-03-13T14:38:09Z 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-14T09:25:30Z 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-14T09:26:11Z 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-14T09:26:49Z Make: refactor GMP rules Document and use simpler rules for the ghc-gmp.h header. - - - - - 7432b327 by Sylvain Henry at 2020-03-14T09:27:28Z Use correct option name (-opti) (fix #17314) s/pgmo/opti - - - - - 8f7dd571 by Judah Jacobson at 2020-03-14T09:28:07Z 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-14T09:28:07Z Use AC_ARG_VAR for LD_STAGE0 and AR_STAGE0. - - - - - 20d4d676 by Ben Gamari at 2020-03-14T09:28:43Z 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-14T09:29:18Z 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-14T09:29:55Z 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-14T09:29:55Z 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-14T09:30:31Z gitlab-ci: Add integer-simple release build for Windows Closes #16144. - - - - - e3c374cc by Simon Peyton Jones at 2020-03-14T09:31:07Z 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-14T09:31:07Z 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-14T09:31:42Z 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-14T09:32:18Z 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-14T23:34:42Z Enable stage1 build of haddock The submodule has already been bumped to contain the fix. - - - - - 49e9d739 by Ömer Sinan Ağacan at 2020-03-14T23:35:24Z rts: Fix printClosure when printing fwd ptrs - - - - - 1de3ab4a by Krzysztof Gogolewski at 2020-03-14T23:36:04Z Remove unused field var_inline (#17915) - - - - - d30aeb4b by Krzysztof Gogolewski at 2020-03-15T07:57:41Z 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-15T07:58:18Z Remove some dead code >From the notes.ghc.drop list found using weeder in #17713 - - - - - dd6ffe6b by Viktor Dukhovni at 2020-03-15T07:58:55Z 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-15T14:57:10Z 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-15T14:57:48Z 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-15T14:58:27Z 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-17T03:52:42Z base: add strict IO functions: readFile', getContents', hGetContents' - - - - - 18a346a4 by Sylvain Henry at 2020-03-17T03:53:24Z Modules: Core (#13009) Update submodule: haddock - - - - - 92327e3a by Ömer Sinan Ağacan at 2020-03-17T03:54:04Z 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-17T11:36:09Z 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-17T11:36:48Z 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-17T11:37:25Z 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-17T11:38:08Z 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-17T11:38:48Z Add example for Data.Semigroup.diff - - - - - 4d85d68b by Paavo at 2020-03-17T11:38:48Z Clean up - - - - - 75168d07 by Paavo at 2020-03-17T11:38:48Z Make example collapsible - - - - - 53ff2cd0 by Richard Eisenberg at 2020-03-17T13:46:57Z 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-18T14:06:43Z Modules: Core operations (#13009) - - - - - 4e8a71c1 by Richard Eisenberg at 2020-03-18T14:07:19Z 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. - - - - - 88d5964b by Simon Peyton Jones at 2020-03-18T21:14:35Z Avoid useless w/w split This patch is just a tidy-up for the post-strictness-analysis worker wrapper split. Consider f x = x Strictnesss analysis does not lead to a w/w split, so the obvious thing is to leave it 100% alone. But actually, because the RHS is small, we ended up adding a StableUnfolding for it. There is some reason to do this if we choose /not/ do to w/w on the grounds that the function is small. See Note [Don't w/w inline small non-loop-breaker things] But there is no reason if we would not have done w/w anyway. This patch just moves the conditional to later. Easy. This does move soem -ddump-simpl printouts around a bit. I also discovered that the previous code was overwritten an InlineCompulsory with InlineStable, which is utterly wrong. That in turn meant that some default methods (marked InlineCompulsory) were getting their InlineCompulsory squashed. This patch fixes that bug --- but of course that does mean a bit more inlining! Metric Increase: T11374 T3064 T9233 T9675 - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/InfoTable.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Dataflow/Block.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/BlockLayout.hs - compiler/GHC/CmmToAsm/CFG.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/Instr.hs - compiler/GHC/CmmToAsm/Monad.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Instr.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/PPC/Regs.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Graph.hs - compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs - compiler/GHC/CmmToAsm/Reg/Linear.hs - compiler/GHC/CmmToAsm/Reg/Linear/Base.hs - compiler/GHC/CmmToAsm/Reg/Linear/FreeRegs.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/f28c80c25e6566c29062b9e1d9c9c50b70948e8a...88d5964b0c1261c6dfbcd2bfd42c3dfc7351e333 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/f28c80c25e6566c29062b9e1d9c9c50b70948e8a...88d5964b0c1261c6dfbcd2bfd42c3dfc7351e333 You're receiving 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 Mar 20 20:28:04 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 20 Mar 2020 16:28:04 -0400 Subject: [Git][ghc/ghc][wip/hadrian-windows] 27 commits: base: add strict IO functions: readFile', getContents', hGetContents' Message-ID: <5e752754f2485_488a8eac47023850a0@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/hadrian-windows at Glasgow Haskell Compiler / GHC Commits: 818b3c38 by Lysxia at 2020-03-17T03:52:42Z base: add strict IO functions: readFile', getContents', hGetContents' - - - - - 18a346a4 by Sylvain Henry at 2020-03-17T03:53:24Z Modules: Core (#13009) Update submodule: haddock - - - - - 92327e3a by Ömer Sinan Ağacan at 2020-03-17T03:54:04Z 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-17T11:36:09Z 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-17T11:36:48Z 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-17T11:37:25Z 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-17T11:38:08Z 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-17T11:38:48Z Add example for Data.Semigroup.diff - - - - - 4d85d68b by Paavo at 2020-03-17T11:38:48Z Clean up - - - - - 75168d07 by Paavo at 2020-03-17T11:38:48Z Make example collapsible - - - - - 53ff2cd0 by Richard Eisenberg at 2020-03-17T13:46:57Z 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-18T14:06:43Z Modules: Core operations (#13009) - - - - - 4e8a71c1 by Richard Eisenberg at 2020-03-18T14:07:19Z 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-19T04:39:27Z 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-19T04:40:06Z 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-19T16:16:49Z Refactoring: use Platform instead of DynFlags when possible Metric Decrease: ManyConstructors T12707 T13035 T1969 - - - - - cb1785d9 by Ömer Sinan Ağacan at 2020-03-19T16:16:54Z 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. - - - - - 4bdf4137 by Ben Gamari at 2020-03-20T20:27:20Z fs.h: Add missing declarations on Windows - - - - - 9b6aa13a by Ben Gamari at 2020-03-20T20:27:59Z Bump process submodule Avoids redundant case alternative warning. - - - - - 667e1220 by Ben Gamari at 2020-03-20T20:27:59Z testsuite: Normalize slashes in ghc-api annotations output Enable `normalise_slashes` on `annotations`, `listcomps`, and `parseTree` to fix Windows failures. - - - - - 2cdfede1 by Ben Gamari at 2020-03-20T20:28:00Z testsuite: Update expected output on Windows - - - - - 8b45178d by Ben Gamari at 2020-03-20T20:28:00Z testsuite: Fix TOP of T17786 - - - - - c6872ba9 by GHC GitLab CI at 2020-03-20T20:28:00Z testsuite: Update expected output on Windows - - - - - 6729d45a by GHC GitLab CI at 2020-03-20T20:28:00Z hadrian: Fix executable extension passed to testsuite driver - - - - - d9aa74ac by GHC GitLab CI at 2020-03-20T20:28:00Z gitlab-ci: Require that Windows-hadrian job passes - - - - - 6e600a1f by Ben Gamari at 2020-03-20T20:28:00Z 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" - - - - - e4781712 by Ben Gamari at 2020-03-20T20:28:00Z Bump hsc2hs submodule - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/InfoTable.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Graph.hs - compiler/GHC/Cmm/Info.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/Ppr.hs - compiler/GHC/Cmm/Ppr/Decl.hs - compiler/GHC/Cmm/Ppr/Expr.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Switch/Implement.hs - compiler/GHC/Cmm/Type.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/ff831d0d795254bc7847e1e05530ad0ec1d01e27...e4781712254bb1a6e37d00bbffaca99606c06351 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/ff831d0d795254bc7847e1e05530ad0ec1d01e27...e4781712254bb1a6e37d00bbffaca99606c06351 You're receiving 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 Mar 19 17:18:32 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Thu, 19 Mar 2020 13:18:32 -0400 Subject: [Git][ghc/ghc][wip/T17676] Add strictness signature for a bunch of wired in Ids Message-ID: <5e73a968f1cd1_488a3fc6f8fa0cb82206134@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T17676 at Glasgow Haskell Compiler / GHC Commits: b273859f by Sebastian Graf at 2020-03-19T17:18:27Z Add strictness signature for a bunch of wired in Ids - - - - - 1 changed file: - compiler/basicTypes/MkId.hs Changes: ===================================== compiler/basicTypes/MkId.hs ===================================== @@ -1353,8 +1353,9 @@ noinlineIdName = mkWiredInIdName gHC_MAGIC (fsLit "noinline") noinlineI proxyHashId :: Id proxyHashId = pcMiscPrelId proxyName ty - (noCafIdInfo `setUnfoldingInfo` evaldUnfolding -- Note [evaldUnfoldings] - `setNeverLevPoly` ty ) + (noCafIdInfo `setUnfoldingInfo` evaldUnfolding -- Note [evaldUnfoldings] + `setNeverLevPoly` ty + `setStrictnessInfo` emptySig conDiv) where -- proxy# :: forall {k} (a:k). Proxy# k a -- @@ -1375,6 +1376,7 @@ nullAddrId = pcMiscPrelId nullAddrName addrPrimTy info info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma `setUnfoldingInfo` mkCompulsoryUnfolding (Lit nullAddrLit) `setNeverLevPoly` addrPrimTy + `setStrictnessInfo` emptySig conDiv ------------------------------------------------ seqId :: Id -- See Note [seqId magic] @@ -1680,14 +1682,16 @@ inlined. realWorldPrimId :: Id -- :: State# RealWorld realWorldPrimId = pcMiscPrelId realWorldName realWorldStatePrimTy - (noCafIdInfo `setUnfoldingInfo` evaldUnfolding -- Note [evaldUnfoldings] - `setOneShotInfo` stateHackOneShot - `setNeverLevPoly` realWorldStatePrimTy) + (noCafIdInfo `setUnfoldingInfo` evaldUnfolding -- Note [evaldUnfoldings] + `setOneShotInfo` stateHackOneShot + `setNeverLevPoly` realWorldStatePrimTy + `setStrictnessInfo` emptySig conDiv) voidPrimId :: Id -- Global constant :: Void# voidPrimId = pcMiscPrelId voidPrimIdName voidPrimTy - (noCafIdInfo `setUnfoldingInfo` evaldUnfolding -- Note [evaldUnfoldings] - `setNeverLevPoly` voidPrimTy) + (noCafIdInfo `setUnfoldingInfo` evaldUnfolding -- Note [evaldUnfoldings] + `setNeverLevPoly` voidPrimTy + `setStrictnessInfo` emptySig conDiv) voidArgId :: Id -- Local lambda-bound :: Void# voidArgId = mkSysLocal (fsLit "void") voidArgIdKey voidPrimTy View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/b273859f93645f666f4eaf6ee1de0c411e58380c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/b273859f93645f666f4eaf6ee1de0c411e58380c You're receiving 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 Mar 18 21:18:20 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 18 Mar 2020 17:18:20 -0400 Subject: [Git][ghc/ghc][wip/dataToTag-opt] 5 commits: When deriving Eq always use tag based comparisons for nullary constructors Message-ID: <5e72901cbd72c_488a3fc6f8fa0cb8203224a@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/dataToTag-opt at Glasgow Haskell Compiler / GHC Commits: 6b6307be by Andreas Klebinger at 2020-03-18T04:28:39Z When deriving Eq always use tag based comparisons for nullary constructors - - - - - 19eabed9 by Andreas Klebinger at 2020-03-18T04:28:39Z Use dataToTag# instead of getTag in deriving code. getTag resides in base so is not useable in ghc-prim. Where we need it. - - - - - ea6146a0 by Andreas Klebinger at 2020-03-18T04:34:32Z Eliminate generated Con2Tag bindings completely - - - - - daec3a5f by Ben Gamari at 2020-03-18T13:39:05Z Use pointer tag in dataToTag# While looking at !2873 I noticed that dataToTag# previously didn't look at a pointer's tag to determine its constructor. To be fair, there is a bit of a trade-off here: using the pointer tag requires a bit more code and another branch. On the other hand, it allows us to eliminate looking at the info table in many cases (especially now since we tag large constructor families; see #14373). - - - - - 8f26e408 by Ben Gamari at 2020-03-18T21:17:36Z Avoid unnecessary entry - - - - - 4 changed files: - compiler/GHC/StgToCmm/Expr.hs - compiler/prelude/PrelNames.hs - compiler/typecheck/TcGenDeriv.hs - compiler/utils/ListSetOps.hs Changes: ===================================== compiler/GHC/StgToCmm/Expr.hs ===================================== @@ -35,6 +35,7 @@ import GHC.Stg.Syntax import GHC.Cmm.Graph import GHC.Cmm.BlockId import GHC.Cmm hiding ( succ ) +import GHC.Cmm.Utils ( zeroExpr, cmmTagMask ) import GHC.Cmm.Info import GHC.Core import DataCon @@ -69,14 +70,44 @@ cgExpr (StgOpApp (StgPrimOp SeqOp) [StgVarArg a, _] _res_ty) = cgIdApp a [] -- dataToTag# :: a -> Int# --- See Note [dataToTag#] in primops.txt.pp +-- See Note [dataToTag# magic] in PrelRules. cgExpr (StgOpApp (StgPrimOp DataToTagOp) [StgVarArg a] _res_ty) = do dflags <- getDynFlags emitComment (mkFastString "dataToTag#") - tmp <- newTemp (bWord dflags) - _ <- withSequel (AssignTo [tmp] False) (cgIdApp a []) - -- TODO: For small types look at the tag bits instead of reading info table - emitReturn [getConstrTag dflags (cmmUntag dflags (CmmReg (CmmLocal tmp)))] + info <- getCgIdInfo a + let amode = idInfoToAmode info + tag_reg <- assignTemp $ cmmConstrTag1 dflags amode + result_reg <- newTemp (bWord dflags) + let tag = CmmReg $ CmmLocal tag_reg + is_tagged = cmmNeWord dflags tag (zeroExpr dflags) + is_too_big_tag = cmmEqWord dflags tag (cmmTagMask dflags) + -- Here we will first check the tag bits of the pointer we were given; + -- if this doesn't work then enter the closure and use the info table + -- to determine the constructor. Note that all tag bits set means that + -- the constructor index is too large to fit in the pointer and therefore + -- we must look in the info table. See Note [Tagging big families]. + + slow_path <- getCode $ do + tmp <- newTemp (bWord dflags) + _ <- withSequel (AssignTo [tmp] False) (cgIdApp a []) + emitAssign (CmmLocal result_reg) + $ getConstrTag dflags (cmmUntag dflags (CmmReg (CmmLocal tmp))) + + fast_path <- getCode $ do + -- Return the constructor index from the pointer tag + return_ptr_tag <- getCode $ do + emitAssign (CmmLocal result_reg) + $ cmmSubWord dflags tag (CmmLit $ mkWordCLit dflags 1) + -- Return the constructor index recorded in the info table + return_info_tag <- getCode $ do + emitAssign (CmmLocal result_reg) + $ getConstrTag dflags (cmmUntag dflags amode) + + emit =<< mkCmmIfThenElse' is_too_big_tag return_info_tag return_ptr_tag (Just False) + + emit =<< mkCmmIfThenElse' is_tagged fast_path slow_path (Just True) + emitReturn [CmmReg $ CmmLocal result_reg] + cgExpr (StgOpApp op args ty) = cgOpApp op args ty cgExpr (StgConApp con args _)= cgConApp con args ===================================== compiler/prelude/PrelNames.hs ===================================== @@ -749,12 +749,13 @@ toList_RDR = nameRdrName toListName compose_RDR :: RdrName compose_RDR = varQual_RDR gHC_BASE (fsLit ".") -not_RDR, getTag_RDR, succ_RDR, pred_RDR, minBound_RDR, maxBound_RDR, +not_RDR, getTag_RDR, dataToTag_RDR, succ_RDR, pred_RDR, minBound_RDR, maxBound_RDR, and_RDR, range_RDR, inRange_RDR, index_RDR, unsafeIndex_RDR, unsafeRangeSize_RDR :: RdrName and_RDR = varQual_RDR gHC_CLASSES (fsLit "&&") not_RDR = varQual_RDR gHC_CLASSES (fsLit "not") getTag_RDR = varQual_RDR gHC_BASE (fsLit "getTag") +dataToTag_RDR = varQual_RDR gHC_PRIM (fsLit "dataToTag#") succ_RDR = varQual_RDR gHC_ENUM (fsLit "succ") pred_RDR = varQual_RDR gHC_ENUM (fsLit "pred") minBound_RDR = varQual_RDR gHC_ENUM (fsLit "minBound") ===================================== compiler/typecheck/TcGenDeriv.hs ===================================== @@ -15,6 +15,7 @@ This is where we do all the grimy bindings' generation. {-# LANGUAGE CPP, ScopedTypeVariables #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DataKinds #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} @@ -83,9 +84,8 @@ import Data.List ( find, partition, intersperse ) type BagDerivStuff = Bag DerivStuff data AuxBindSpec - = DerivCon2Tag TyCon -- The con2Tag for given TyCon - | DerivTag2Con TyCon -- ...ditto tag2Con - | DerivMaxTag TyCon -- ...and maxTag + = DerivTag2Con TyCon -- The tag2Con for given TyCon + | DerivMaxTag TyCon -- ...and ditto maxTag deriving( Eq ) -- All these generate ZERO-BASED tag operations -- I.e first constructor has tag 0 @@ -127,17 +127,17 @@ possibly zero of them). Here's an example, with both \tr{N}ullary and case (a1 `eqFloat#` a2) of r -> r for that particular test. -* If there are a lot of (more than ten) nullary constructors, we emit a +* For nullary constructors, we emit a catch-all clause of the form: - (==) a b = case (con2tag_Foo a) of { a# -> - case (con2tag_Foo b) of { b# -> + (==) a b = case (dataToTag# a) of { a# -> + case (dataToTag# b) of { b# -> case (a# ==# b#) of { r -> r }}} - If con2tag gets inlined this leads to join point stuff, so - it's better to use regular pattern matching if there aren't too - many nullary constructors. "Ten" is arbitrary, of course + An older approach preferred regular pattern matches in some cases + but with dataToTag# forcing it's argument, and work on improving + join points, this seems no longer necessary. * If there aren't any nullary constructors, we emit a simpler catch-all: @@ -146,7 +146,7 @@ possibly zero of them). Here's an example, with both \tr{N}ullary and * For the @(/=)@ method, we normally just use the default method. If the type is an enumeration type, we could/may/should? generate - special code that calls @con2tag_Foo@, much like for @(==)@ shown + special code that calls @dataToTag#@, much like for @(==)@ shown above. We thought about doing this: If we're also deriving 'Ord' for this @@ -162,20 +162,18 @@ produced don't get through the typechecker. gen_Eq_binds :: SrcSpan -> TyCon -> TcM (LHsBinds GhcPs, BagDerivStuff) gen_Eq_binds loc tycon = do dflags <- getDynFlags - return (method_binds dflags, aux_binds) + return (method_binds dflags, emptyBag) where all_cons = tyConDataCons tycon (nullary_cons, non_nullary_cons) = partition isNullarySrcDataCon all_cons - -- If there are ten or more (arbitrary number) nullary constructors, - -- use the con2tag stuff. For small types it's better to use - -- ordinary pattern matching. - (tag_match_cons, pat_match_cons) - | nullary_cons `lengthExceeds` 10 = (nullary_cons, non_nullary_cons) - | otherwise = ([], all_cons) - + -- For nullary constructors, use the getTag stuff. + (tag_match_cons, pat_match_cons) = (nullary_cons, non_nullary_cons) no_tag_match_cons = null tag_match_cons + -- (LHS patterns, result) + fall_through_eqn :: DynFlags + -> [([Located (Pat (GhcPass 'Parsed))] , LHsExpr GhcPs)] fall_through_eqn dflags | no_tag_match_cons -- All constructors have arguments = case pat_match_cons of @@ -186,17 +184,16 @@ gen_Eq_binds loc tycon = do [([nlWildPat, nlWildPat], false_Expr)] | otherwise -- One or more tag_match cons; add fall-through of - -- extract tags compare for equality + -- extract tags compare for equality, + -- The case `(C1 x) == (C1 y)` can no longer happen + -- at this point as it's matched earlier. = [([a_Pat, b_Pat], untag_Expr dflags tycon [(a_RDR,ah_RDR), (b_RDR,bh_RDR)] (genPrimOpApp (nlHsVar ah_RDR) eqInt_RDR (nlHsVar bh_RDR)))] - aux_binds | no_tag_match_cons = emptyBag - | otherwise = unitBag $ DerivAuxBind $ DerivCon2Tag tycon - method_binds dflags = unitBag (eq_bind dflags) eq_bind dflags = mkFunBindEC 2 loc eq_RDR (const true_Expr) - (map pats_etc pat_match_cons + ( map pats_etc pat_match_cons ++ fall_through_eqn dflags) ------------------------------------------------------------------ @@ -346,11 +343,8 @@ gen_Ord_binds loc tycon = do then ( unitBag $ mkFunBindEC 2 loc compare_RDR (const eqTag_Expr) [] , emptyBag) else ( unitBag (mkOrdOp dflags OrdCompare) `unionBags` other_ops dflags - , aux_binds) + , emptyBag) where - aux_binds | single_con_type = emptyBag - | otherwise = unitBag $ DerivAuxBind $ DerivCon2Tag tycon - -- Note [Game plan for deriving Ord] other_ops dflags | (last_tag - first_tag) <= 2 -- 1-3 constructors @@ -369,7 +363,7 @@ gen_Ord_binds loc tycon = do get_tag con = dataConTag con - fIRST_TAG -- We want *zero-based* tags, because that's what - -- con2Tag returns (generated by untag_Expr)! + -- dataToTag# returns (generated by untag_Expr)! tycon_data_cons = tyConDataCons tycon single_con_type = isSingleton tycon_data_cons @@ -549,8 +543,8 @@ nlConWildPat con = noLoc (ConPatIn (noLoc (getRdrName con)) data Foo ... = N1 | N2 | ... | Nn \end{verbatim} -we use both @con2tag_Foo@ and @tag2con_Foo@ functions, as well as a - at maxtag_Foo@ variable (all generated by @gen_tag_n_con_binds@). +we use both dataToTag# and @tag2con_Foo@ functions, as well as a + at maxtag_Foo@ variable, the later generated by @gen_tag_n_con_binds. \begin{verbatim} instance ... Enum (Foo ...) where @@ -563,16 +557,16 @@ instance ... Enum (Foo ...) where -- or, really... enumFrom a - = case con2tag_Foo a of + = case dataToTag# a of a# -> map tag2con_Foo (enumFromTo (I# a#) maxtag_Foo) enumFromThen a b - = map tag2con_Foo [con2tag_Foo a, con2tag_Foo b .. maxtag_Foo] + = map tag2con_Foo [dataToTag# a, dataToTag# b .. maxtag_Foo] -- or, really... enumFromThen a b - = case con2tag_Foo a of { a# -> - case con2tag_Foo b of { b# -> + = case dataToTag# a of { a# -> + case dataToTag# b of { b# -> map tag2con_Foo (enumFromThenTo (I# a#) (I# b#) maxtag_Foo) }} \end{verbatim} @@ -594,7 +588,7 @@ gen_Enum_binds loc tycon = do , from_enum dflags ] aux_binds = listToBag $ map DerivAuxBind - [DerivCon2Tag tycon, DerivTag2Con tycon, DerivMaxTag tycon] + [DerivTag2Con tycon, DerivMaxTag tycon] occ_nm = getOccString tycon @@ -709,32 +703,32 @@ things go not too differently from @Enum@: \begin{verbatim} instance ... Ix (Foo ...) where range (a, b) - = map tag2con_Foo [con2tag_Foo a .. con2tag_Foo b] + = map tag2con_Foo [dataToTag# a .. dataToTag# b] -- or, really... range (a, b) - = case (con2tag_Foo a) of { a# -> - case (con2tag_Foo b) of { b# -> + = case (dataToTag# a) of { a# -> + case (dataToTag# b) of { b# -> map tag2con_Foo (enumFromTo (I# a#) (I# b#)) }} -- Generate code for unsafeIndex, because using index leads -- to lots of redundant range tests unsafeIndex c@(a, b) d - = case (con2tag_Foo d -# con2tag_Foo a) of + = case (dataToTag# d -# dataToTag# a) of r# -> I# r# inRange (a, b) c = let - p_tag = con2tag_Foo c + p_tag = dataToTag# c in - p_tag >= con2tag_Foo a && p_tag <= con2tag_Foo b + p_tag >= dataToTag# a && p_tag <= dataToTag# b -- or, really... inRange (a, b) c - = case (con2tag_Foo a) of { a_tag -> - case (con2tag_Foo b) of { b_tag -> - case (con2tag_Foo c) of { c_tag -> + = case (dataToTag# a) of { a_tag -> + case (dataToTag# b) of { b_tag -> + case (dataToTag# c) of { c_tag -> if (c_tag >=# a_tag) then c_tag <=# b_tag else @@ -757,8 +751,8 @@ gen_Ix_binds loc tycon = do dflags <- getDynFlags return $ if isEnumerationTyCon tycon then (enum_ixes dflags, listToBag $ map DerivAuxBind - [DerivCon2Tag tycon, DerivTag2Con tycon, DerivMaxTag tycon]) - else (single_con_ixes, unitBag (DerivAuxBind (DerivCon2Tag tycon))) + [DerivTag2Con tycon, DerivMaxTag tycon]) + else (single_con_ixes, emptyBag) where -------------------------------------------------------------- enum_ixes dflags = listToBag @@ -1937,41 +1931,18 @@ mkCoerceClassMethEqn cls inst_tvs inst_tys rhs_ty id \begin{verbatim} data Foo ... = ... -con2tag_Foo :: Foo ... -> Int# tag2con_Foo :: Int -> Foo ... -- easier if Int, not Int# maxtag_Foo :: Int -- ditto (NB: not unlifted) \end{verbatim} The `tags' here start at zero, hence the @fIRST_TAG@ (currently one) fiddling around. + +We also use dataToTag# heavily. -} genAuxBindSpec :: DynFlags -> SrcSpan -> AuxBindSpec -> (LHsBind GhcPs, LSig GhcPs) -genAuxBindSpec dflags loc (DerivCon2Tag tycon) - = (mkFunBindSE 0 loc rdr_name eqns, - L loc (TypeSig noExtField [L loc rdr_name] sig_ty)) - where - rdr_name = con2tag_RDR dflags tycon - - sig_ty = mkLHsSigWcType $ L loc $ XHsType $ NHsCoreTy $ - mkSpecSigmaTy (tyConTyVars tycon) (tyConStupidTheta tycon) $ - mkParentType tycon `mkVisFunTy` intPrimTy - - lots_of_constructors = tyConFamilySize tycon > 8 - -- was: mAX_FAMILY_SIZE_FOR_VEC_RETURNS - -- but we don't do vectored returns any more. - - eqns | lots_of_constructors = [get_tag_eqn] - | otherwise = map mk_eqn (tyConDataCons tycon) - - get_tag_eqn = ([nlVarPat a_RDR], nlHsApp (nlHsVar getTag_RDR) a_Expr) - - mk_eqn :: DataCon -> ([LPat GhcPs], LHsExpr GhcPs) - mk_eqn con = ([nlWildConPat con], - nlHsLit (HsIntPrim NoSourceText - (toInteger ((dataConTag con) - fIRST_TAG)))) - genAuxBindSpec dflags loc (DerivTag2Con tycon) = (mkFunBindSE 0 loc rdr_name [([nlConVarPat intDataCon_RDR [a_RDR]], @@ -2254,14 +2225,26 @@ eq_Expr ty a b where (_, _, prim_eq, _, _) = primOrdOps "Eq" ty -untag_Expr :: DynFlags -> TyCon -> [( RdrName, RdrName)] - -> LHsExpr GhcPs -> LHsExpr GhcPs +-- | Take an expression and a list of pairs @(exprName1,tagName1)@. +-- Wraps the given expression in cases which bind tagName1 to the +-- tag of exprName1 and so forth for all pairs and returns the +-- resulting expression. +untag_Expr :: DynFlags + -> TyCon + -> [( RdrName, RdrName)] -- (expr, expr's tag bound to this) + -> LHsExpr GhcPs -- Final RHS + -> LHsExpr GhcPs -- Result expr untag_Expr _ _ [] expr = expr untag_Expr dflags tycon ((untag_this, put_tag_here) : more) expr - = nlHsCase (nlHsPar (nlHsVarApps (con2tag_RDR dflags tycon) - [untag_this])) {-of-} + {- case (dataToTag# untag_this) of + put_tag_here -> .... + _ -> result + -} + = nlHsCase (nlHsPar (nlHsApp (nlHsVar dataToTag_RDR) (nlHsVar untag_this))) {-of-} [mkHsCaseAlt (nlVarPat put_tag_here) (untag_Expr dflags tycon more expr)] + + enum_from_to_Expr :: LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs @@ -2372,9 +2355,8 @@ minusInt_RDR, tagToEnum_RDR :: RdrName minusInt_RDR = getRdrName (primOpId IntSubOp ) tagToEnum_RDR = getRdrName (primOpId TagToEnumOp) -con2tag_RDR, tag2con_RDR, maxtag_RDR :: DynFlags -> TyCon -> RdrName +tag2con_RDR, maxtag_RDR :: DynFlags -> TyCon -> RdrName -- Generates Orig s RdrName, for the binding positions -con2tag_RDR dflags tycon = mk_tc_deriv_name dflags tycon mkCon2TagOcc tag2con_RDR dflags tycon = mk_tc_deriv_name dflags tycon mkTag2ConOcc maxtag_RDR dflags tycon = mk_tc_deriv_name dflags tycon mkMaxTagOcc @@ -2403,13 +2385,15 @@ mkAuxBinderName dflags parent occ_fun {- Note [Auxiliary binders] ~~~~~~~~~~~~~~~~~~~~~~~~ -We often want to make a top-level auxiliary binding. E.g. for comparison we have - instance Ord T where - compare a b = $con2tag a `compare` $con2tag b +We often want to make a top-level auxiliary binding. E.g. for enum we +turn a Integer into a constructor. So we have + + instance Enum T where + succ x = $tag2con (dataToTag x + 1) - $con2tag :: T -> Int - $con2tag = ...code.... + $tag2con :: Int -> T + $tag2con = ...code.... Of course these top-level bindings should all have distinct name, and we are generating RdrNames here. We can't just use the TyCon or DataCon to distinguish ===================================== compiler/utils/ListSetOps.hs ===================================== @@ -104,12 +104,13 @@ minusList xs ys = filter (`S.notMember` yss) xs Inefficient finite maps based on association lists and equality. -} --- A finite mapping based on equality and association lists +-- | A finite mapping based on equality and association lists. type Assoc a b = [(a,b)] assoc :: (Eq a) => String -> Assoc a b -> a -> b assocDefault :: (Eq a) => b -> Assoc a b -> a -> b assocUsing :: (a -> a -> Bool) -> String -> Assoc a b -> a -> b +-- | Lookup key, fail gracefully using Nothing if not found. assocMaybe :: (Eq a) => Assoc a b -> a -> Maybe b assocDefaultUsing :: (a -> a -> Bool) -> b -> Assoc a b -> a -> b View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/da41a337971df016e789cf78346013f3461d7289...8f26e408397dcb09d994bda807750a1de07f6a48 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/da41a337971df016e789cf78346013f3461d7289...8f26e408397dcb09d994bda807750a1de07f6a48 You're receiving 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 Mar 18 01:05:15 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 17 Mar 2020 21:05:15 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/dataToTag-opt Message-ID: <5e7173cb9fff9_488a3fc6f87158a018177f5@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/dataToTag-opt at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/dataToTag-opt You're receiving 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 Mar 19 13:36:11 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 19 Mar 2020 09:36:11 -0400 Subject: [Git][ghc/ghc][wip/test] Backport get-win32-tarballs configure changes Message-ID: <5e73754bf3c96_488a3fc6f8fa0cb82115458@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/test at Glasgow Haskell Compiler / GHC Commits: b9fb1ac4 by Ben Gamari at 2020-03-19T13:36:05Z Backport get-win32-tarballs configure changes - - - - - 2 changed files: - configure.ac - mk/get-win32-tarballs.py Changes: ===================================== configure.ac ===================================== @@ -347,7 +347,7 @@ set_up_tarballs() { else action="download" fi - mk/get-win32-tarballs.sh $action $HostArch > missing-win32-tarballs + $PYTHON mk/get-win32-tarballs.py $action $mingw_arch > missing-win32-tarballs case $? in 0) rm missing-win32-tarballs @@ -359,7 +359,7 @@ set_up_tarballs() { echo echo " * run configure with the --enable-tarballs-autodownload option" echo - echo " * run mk/get-win32-tarballs.sh download ${HostArch}" + echo " * run mk/get-win32-tarballs.py download $mingw_arch" echo echo " * manually download the files listed in ./missing-win32-tarballs and place" echo " them in the ghc-tarballs directory." ===================================== mk/get-win32-tarballs.py ===================================== @@ -8,7 +8,6 @@ import argparse TARBALL_VERSION = '0.1' BASE_URL = "https://downloads.haskell.org/ghc/mingw/{}".format(TARBALL_VERSION) -BASE_URL = "http://home.smart-cactus.org/~ben/ghc/mingw/{}".format(TARBALL_VERSION) DEST = Path('ghc-tarballs/mingw-w64') ARCHS = ['i686', 'x86_64', 'sources'] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/b9fb1ac47c1e282e8f07311462e922c19f4f69a5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/b9fb1ac47c1e282e8f07311462e922c19f4f69a5 You're receiving 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 Mar 19 08:06:40 2020 From: gitlab at gitlab.haskell.org (=?UTF-8?B?w5ZtZXIgU2luYW4gQcSfYWNhbg==?=) Date: Thu, 19 Mar 2020 04:06:40 -0400 Subject: [Git][ghc/ghc][wip/osa1/lfinfo] Cross-module LambdaFormInfo passing Message-ID: <5e7328101b10a_488a3fc6f87158a020601ee@gitlab.haskell.org.mail> Ömer Sinan Ağacan pushed to branch wip/osa1/lfinfo at Glasgow Haskell Compiler / GHC Commits: 481dfb8f by Ömer Sinan Ağacan at 2020-03-19T08:06:11Z Cross-module LambdaFormInfo passing - Store LambdaFormInfos of exported Ids in interface files - Use them in importing modules - - - - - 29 changed files: - compiler/GHC/CoreToIface.hs - compiler/GHC/Driver/Hooks.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Runtime/Heap/Layout.hs - compiler/GHC/StgToCmm.hs - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/StgToCmm/Env.hs - + compiler/GHC/StgToCmm/Types.hs - compiler/basicTypes/Id.hs - compiler/basicTypes/IdInfo.hs - compiler/ghc.cabal.in - compiler/main/UpdateCafInfos.hs - testsuite/tests/codeGen/should_compile/Makefile - + testsuite/tests/codeGen/should_compile/cg009/A.hs - + testsuite/tests/codeGen/should_compile/cg009/Main.hs - + testsuite/tests/codeGen/should_compile/cg009/Makefile - + testsuite/tests/codeGen/should_compile/cg009/all.T - + testsuite/tests/codeGen/should_compile/cg010/A.hs - + testsuite/tests/codeGen/should_compile/cg010/Main.hs - + testsuite/tests/codeGen/should_compile/cg010/Makefile - + testsuite/tests/codeGen/should_compile/cg010/all.T - + testsuite/tests/codeGen/should_compile/cg010/cg010.stdout - testsuite/tests/simplCore/should_compile/Makefile - testsuite/tests/simplCore/should_compile/T4201.stdout Changes: ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -41,6 +41,8 @@ module GHC.CoreToIface , toIfaceCon , toIfaceApp , toIfaceVar + -- * Other stuff + , toIfaceLFInfo ) where #include "HsVersions.h" @@ -49,6 +51,7 @@ import GhcPrelude import GHC.Iface.Syntax import GHC.Core.DataCon +import GHC.StgToCmm.Types import Id import IdInfo import GHC.Core @@ -74,6 +77,8 @@ import Demand ( isTopSig ) import Cpr ( topCprSig ) import Data.Maybe ( catMaybes ) +import Data.Word +import Data.Bits {- Note [Avoiding space leaks in toIface*] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -534,7 +539,7 @@ toIfaceExpr (Var v) = toIfaceVar v toIfaceExpr (Lit l) = IfaceLit l toIfaceExpr (Type ty) = IfaceType (toIfaceType ty) toIfaceExpr (Coercion co) = IfaceCo (toIfaceCoercion co) -toIfaceExpr (Lam x b) = IfaceLam (toIfaceBndr x, toIfaceOneShot x) (toIfaceExpr b) +toIfaceExpr (Lam x b) = IfaceLam (toIfaceBndr x, toIdIfaceOneShot x) (toIfaceExpr b) toIfaceExpr (App f a) = toIfaceApp f [a] toIfaceExpr (Case s x ty as) | null as = IfaceECase (toIfaceExpr s) (toIfaceType ty) @@ -545,12 +550,16 @@ toIfaceExpr (Tick t e) | Just t' <- toIfaceTickish t = IfaceTick t' (toIfaceExpr e) | otherwise = toIfaceExpr e -toIfaceOneShot :: Id -> IfaceOneShot -toIfaceOneShot id | isId id - , OneShotLam <- oneShotInfo (idInfo id) - = IfaceOneShot - | otherwise - = IfaceNoOneShot +toIdIfaceOneShot :: Id -> IfaceOneShot +toIdIfaceOneShot id + | isId id + = toIfaceOneShot (oneShotInfo (idInfo id)) + | otherwise + = IfaceNoOneShot + +toIfaceOneShot :: OneShotInfo -> IfaceOneShot +toIfaceOneShot OneShotLam = IfaceOneShot +toIfaceOneShot NoOneShotInfo = IfaceNoOneShot --------------------- toIfaceTickish :: Tickish Id -> Maybe IfaceTickish @@ -616,6 +625,41 @@ toIfaceVar v where name = idName v +--------------------- +toIfaceLFInfo :: LambdaFormInfo -> IfaceLFInfo +toIfaceLFInfo (LFReEntrant TopLevel oneshot rep fvs_flag _argdesc) = + IfLFReEntrant (toIfaceOneShot oneshot) rep fvs_flag +toIfaceLFInfo (LFThunk TopLevel hasfv updateable sfi m_function) = + -- Assert that arity fits in 14 bits + ASSERT(fromEnum hasfv <= 1 && fromEnum updateable <= 1 && fromEnum m_function <= 1) + IfLFThunk hasfv updateable (toIfaceStandardFormInfo sfi) m_function +toIfaceLFInfo LFUnlifted = IfLFUnlifted +toIfaceLFInfo (LFCon con) = IfLFCon (dataConName con) +-- All other cases are not possible at the top level. +toIfaceLFInfo lf = pprPanic "Invalid IfaceLFInfo conversion:" + (ppr lf <+> text "should not be exported") + +toIfaceStandardFormInfo :: StandardFormInfo -> IfaceStandardFormInfo +toIfaceStandardFormInfo NonStandardThunk = IfStandardFormInfo 1 +toIfaceStandardFormInfo sf = + IfStandardFormInfo $! + tag sf .|. encodeField (field sf) + where + tag SelectorThunk{} = 0 + tag ApThunk{} = 2 -- == setBit 0 1 + tag _ = panic "Impossible" + + field (SelectorThunk n) = n + field (ApThunk n) = n + field _ = panic "Impossible" + + encodeField n = + let wn = fromIntegral n :: Word + shifted = wn `unsafeShiftL` 2 + in ASSERT(shifted > 0 && shifted < fromIntegral (maxBound :: Word16)) + (fromIntegral shifted :: Word16) + + {- Note [Inlining and hs-boot files] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider this example (#10083, #12789): ===================================== compiler/GHC/Driver/Hooks.hs ===================================== @@ -55,6 +55,7 @@ import GHC.Stg.Syntax import Stream import GHC.Cmm import GHC.Hs.Extension +import GHC.StgToCmm.Types (ModuleLFInfos) import Data.Maybe @@ -109,7 +110,7 @@ data Hooks = Hooks -> IO (Maybe HValue)) , createIservProcessHook :: Maybe (CreateProcess -> IO ProcessHandle) , stgToCmmHook :: Maybe (DynFlags -> Module -> [TyCon] -> CollectedCCs - -> [CgStgTopBinding] -> HpcInfo -> Stream IO CmmGroup ()) + -> [CgStgTopBinding] -> HpcInfo -> Stream IO CmmGroup ModuleLFInfos) , cmmToRawCmmHook :: forall a . Maybe (DynFlags -> Maybe Module -> Stream IO CmmGroupSRTs a -> IO (Stream IO RawCmmGroup a)) } ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -162,6 +162,7 @@ import Bag import Exception import qualified Stream import Stream (Stream) +import GHC.StgToCmm.Types (ModuleLFInfos) import Util @@ -176,6 +177,7 @@ import qualified Data.Set as S import Data.Set (Set) import Data.Functor import Control.DeepSeq (force) +import Data.Bifunctor (first) import GHC.Iface.Ext.Ast ( mkHieFile ) import GHC.Iface.Ext.Types ( getAsts, hie_asts, hie_module ) @@ -1392,7 +1394,7 @@ hscWriteIface dflags iface no_change mod_location = do -- | Compile to hard-code. hscGenHardCode :: HscEnv -> CgGuts -> ModLocation -> FilePath - -> IO (FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)], NameSet) + -> IO (FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)], NameSet, ModuleLFInfos) -- ^ @Just f@ <=> _stub.c is f hscGenHardCode hsc_env cgguts location output_filename = do let CgGuts{ -- This is the last use of the ModGuts in a compilation. @@ -1451,11 +1453,11 @@ hscGenHardCode hsc_env cgguts location output_filename = do return a rawcmms1 = Stream.mapM dump rawcmms0 - (output_filename, (_stub_h_exists, stub_c_exists), foreign_fps, caf_infos) + (output_filename, (_stub_h_exists, stub_c_exists), foreign_fps, (caf_infos, lf_infos)) <- {-# SCC "codeOutput" #-} codeOutput dflags this_mod output_filename location foreign_stubs foreign_files dependencies rawcmms1 - return (output_filename, stub_c_exists, foreign_fps, caf_infos) + return (output_filename, stub_c_exists, foreign_fps, caf_infos, lf_infos) hscInteractive :: HscEnv @@ -1549,7 +1551,7 @@ doCodeGen :: HscEnv -> Module -> [TyCon] -> CollectedCCs -> [StgTopBinding] -> HpcInfo - -> IO (Stream IO CmmGroupSRTs NameSet) + -> IO (Stream IO CmmGroupSRTs (NameSet, ModuleLFInfos)) -- Note we produce a 'Stream' of CmmGroups, so that the -- backend can be run incrementally. Otherwise it generates all -- the C-- up front, which has a significant space cost. @@ -1561,7 +1563,7 @@ doCodeGen hsc_env this_mod data_tycons dumpIfSet_dyn dflags Opt_D_dump_stg_final "Final STG:" FormatSTG (pprGenStgTopBindings stg_binds_w_fvs) - let cmm_stream :: Stream IO CmmGroup () + let cmm_stream :: Stream IO CmmGroup ModuleLFInfos -- See Note [Forcing of stg_binds] cmm_stream = stg_binds_w_fvs `seqList` {-# SCC "StgToCmm" #-} lookupHook stgToCmmHook StgToCmm.codeGen dflags dflags this_mod data_tycons @@ -1580,10 +1582,11 @@ doCodeGen hsc_env this_mod data_tycons ppr_stream1 = Stream.mapM dump1 cmm_stream + pipeline_stream :: Stream IO CmmGroupSRTs (NameSet, ModuleLFInfos) pipeline_stream = {-# SCC "cmmPipeline" #-} - Stream.mapAccumL (cmmPipeline hsc_env) (emptySRT this_mod) ppr_stream1 - <&> (srtMapNonCAFs . moduleSRTMap) + Stream.mapAccumL_ (cmmPipeline hsc_env) (emptySRT this_mod) ppr_stream1 + <&> (first (srtMapNonCAFs . moduleSRTMap)) dump2 a = do unless (null a) $ ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -1192,12 +1192,12 @@ runPhase (HscOut src_flavour mod_name result) _ dflags = do PipeState{hsc_env=hsc_env'} <- getPipeState - (outputFilename, mStub, foreign_files, caf_infos) <- liftIO $ + (outputFilename, mStub, foreign_files, caf_infos, lf_infos) <- liftIO $ hscGenHardCode hsc_env' cgguts mod_location output_fn - final_iface <- liftIO (mkFullIface hsc_env'{hsc_dflags=iface_dflags} partial_iface (Just caf_infos)) + final_iface <- liftIO (mkFullIface hsc_env'{hsc_dflags=iface_dflags} partial_iface (Just (caf_infos, lf_infos))) let final_mod_details = {-# SCC updateModDetailsCafInfos #-} - updateModDetailsCafInfos iface_dflags caf_infos mod_details + updateModDetailsCafInfos iface_dflags caf_infos lf_infos mod_details setIface final_iface final_mod_details -- See Note [Writing interface files] ===================================== compiler/GHC/Iface/Make.hs ===================================== @@ -38,6 +38,7 @@ import GHC.Core.Coercion.Axiom import GHC.Core.ConLike import GHC.Core.DataCon import GHC.Core.Type +import GHC.StgToCmm.Types (ModuleLFInfos) import TcType import GHC.Core.InstEnv import GHC.Core.FamInstEnv @@ -100,13 +101,13 @@ mkPartialIface hsc_env mod_details -- | Fully instantiate a interface -- Adds fingerprints and potentially code generator produced information. -mkFullIface :: HscEnv -> PartialModIface -> Maybe NameSet -> IO ModIface -mkFullIface hsc_env partial_iface mb_non_cafs = do +mkFullIface :: HscEnv -> PartialModIface -> Maybe (NameSet, ModuleLFInfos) -> IO ModIface +mkFullIface hsc_env partial_iface mb_id_infos = do let decls | gopt Opt_OmitInterfacePragmas (hsc_dflags hsc_env) = mi_decls partial_iface | otherwise - = updateDeclCafInfos (mi_decls partial_iface) mb_non_cafs + = updateDecl (mi_decls partial_iface) mb_id_infos full_iface <- {-# SCC "addFingerprints" #-} @@ -117,15 +118,23 @@ mkFullIface hsc_env partial_iface mb_non_cafs = do return full_iface -updateDeclCafInfos :: [IfaceDecl] -> Maybe NameSet -> [IfaceDecl] -updateDeclCafInfos decls Nothing = decls -updateDeclCafInfos decls (Just non_cafs) = map update_decl decls +updateDecl :: [IfaceDecl] -> Maybe (NameSet, ModuleLFInfos) -> [IfaceDecl] +updateDecl decls Nothing = decls +updateDecl decls (Just (non_cafs, lf_infos)) = map update_decl decls where + update_decl (IfaceId nm ty details infos) + | let not_caffy = elemNameSet nm non_cafs + , let mb_lf_info = lookupNameEnv lf_infos nm + , WARN( isNothing mb_lf_info, text "Name without LFInfo:" <+> ppr nm ) True + -- Only allocate a new IfaceId if we're going to update the infos + , isJust mb_lf_info || not_caffy + = IfaceId nm ty details $ + (if not_caffy then (HsNoCafRefs :) else id) + (case mb_lf_info of + Nothing -> infos + Just lf_info -> HsLFInfo (toIfaceLFInfo lf_info) : infos) + update_decl decl - | IfaceId nm ty details infos <- decl - , elemNameSet nm non_cafs - = IfaceId nm ty details (HsNoCafRefs : infos) - | otherwise = decl -- | Make an interface from the results of typechecking only. Useful ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -22,6 +22,8 @@ module GHC.Iface.Syntax ( IfaceAxBranch(..), IfaceTyConParent(..), IfaceCompleteMatch(..), + IfaceLFInfo(..), + IfaceStandardFormInfo(..), -- * Binding names IfaceTopBndr, @@ -30,6 +32,7 @@ module GHC.Iface.Syntax ( -- Misc ifaceDeclImplicitBndrs, visibleIfConDecls, ifaceDeclFingerprints, + tcStandardFormInfo, -- Free Names freeNamesIfDecl, freeNamesIfRule, freeNamesIfFamInst, @@ -72,10 +75,13 @@ import GHC.Core.DataCon (SrcStrictness(..), SrcUnpackedness(..)) import Lexeme (isLexSym) import TysWiredIn ( constraintKindTyConName ) import Util (seqList) +import GHC.StgToCmm.Types import Control.Monad import System.IO.Unsafe import Control.DeepSeq +import Data.Word +import Data.Bits infixl 3 &&& @@ -114,7 +120,8 @@ data IfaceDecl = IfaceId { ifName :: IfaceTopBndr, ifType :: IfaceType, ifIdDetails :: IfaceIdDetails, - ifIdInfo :: IfaceIdInfo } + ifIdInfo :: IfaceIdInfo + } | IfaceData { ifName :: IfaceTopBndr, -- Type constructor ifBinders :: [IfaceTyConBinder], @@ -348,6 +355,7 @@ data IfaceInfoItem IfaceUnfolding -- See Note [Expose recursive functions] | HsNoCafRefs | HsLevity -- Present <=> never levity polymorphic + | HsLFInfo IfaceLFInfo -- NB: Specialisations and rules come in separately and are -- only later attached to the Id. Partial reason: some are orphans. @@ -379,6 +387,71 @@ data IfaceIdDetails | IfRecSelId (Either IfaceTyCon IfaceDecl) Bool | IfDFunId +-- Lambda form info +data IfaceLFInfo + = IfLFReEntrant !IfaceOneShot !RepArity !Bool + | IfLFThunk !Bool !Bool !IfaceStandardFormInfo !Bool + | IfLFCon -- A saturated constructor application + !Name -- The constructor Name + | IfLFUnknown !Bool + | IfLFUnlifted + +tcStandardFormInfo :: IfaceStandardFormInfo -> StandardFormInfo +tcStandardFormInfo (IfStandardFormInfo w) + | testBit w 0 = NonStandardThunk + | otherwise = con field + where + field = fromIntegral (w `unsafeShiftR` 2) + con + | testBit w 1 = ApThunk + | otherwise = SelectorThunk + +instance Outputable IfaceLFInfo where + ppr (IfLFReEntrant oneshot rep fvs_flag) = + text "LFReEntrant" <+> ppr (oneshot, rep, fvs_flag) + ppr (IfLFThunk fvs_flag upd_flag sfi fun_flag) = + text "LFThunk" <+> ppr (fvs_flag, upd_flag, fun_flag) <+> ppr (tcStandardFormInfo sfi) + ppr (IfLFCon con) = text "LFCon" <> brackets (ppr con) + ppr IfLFUnlifted = text "LFUnlifted" + ppr (IfLFUnknown fun_flag) = text "LFUnknown" <+> ppr fun_flag + +newtype IfaceStandardFormInfo = IfStandardFormInfo Word16 + +instance Binary IfaceStandardFormInfo where + put_ bh (IfStandardFormInfo w) = put_ bh (w :: Word16) + get bh = IfStandardFormInfo <$> (get bh :: IO Word16) + +instance Binary IfaceLFInfo where + -- TODO: We could pack the bytes somewhat + put_ bh (IfLFReEntrant oneshot rep fvs_flag) = do + putByte bh 0 + put_ bh oneshot + put_ bh rep + put_ bh fvs_flag + put_ bh (IfLFThunk top_lvl no_fvs std_form maybe_fun) = do + putByte bh 1 + put_ bh top_lvl + put_ bh no_fvs + put_ bh std_form + put_ bh maybe_fun + put_ bh (IfLFCon con_name) = do + putByte bh 2 + put_ bh con_name + put_ bh (IfLFUnknown fun_flag) = do + putByte bh 3 + put_ bh fun_flag + put_ bh IfLFUnlifted = + putByte bh 4 + get bh = do + tag <- getByte bh + case tag of + 0 -> IfLFReEntrant <$> get bh <*> get bh <*> get bh + 1 -> IfLFThunk <$> get bh <*> get bh <*> get bh <*> get bh + 2 -> IfLFCon <$> get bh + 3 -> IfLFUnknown <$> get bh + 4 -> pure IfLFUnlifted + _ -> panic "Invalid byte" + {- Note [Versioning of instances] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1393,6 +1466,7 @@ instance Outputable IfaceInfoItem where ppr (HsCpr cpr) = text "CPR:" <+> ppr cpr ppr HsNoCafRefs = text "HasNoCafRefs" ppr HsLevity = text "Never levity-polymorphic" + ppr (HsLFInfo lf_info) = text "LambdaFormInfo:" <+> ppr lf_info instance Outputable IfaceJoinInfo where ppr IfaceNotJoinPoint = empty @@ -1853,7 +1927,7 @@ instance Binary IfaceDecl where get bh = do h <- getByte bh case h of - 0 -> do name <- get bh + 0 -> do name <- get bh ~(ty, details, idinfo) <- lazyGet bh -- See Note [Lazy deserialization of IfaceId] return (IfaceId name ty details idinfo) @@ -2153,6 +2227,8 @@ instance Binary IfaceInfoItem where put_ bh HsNoCafRefs = putByte bh 4 put_ bh HsLevity = putByte bh 5 put_ bh (HsCpr cpr) = putByte bh 6 >> put_ bh cpr + put_ bh (HsLFInfo lf_info) = putByte bh 7 >> put_ bh lf_info + get bh = do h <- getByte bh case h of @@ -2164,7 +2240,8 @@ instance Binary IfaceInfoItem where 3 -> liftM HsInline $ get bh 4 -> return HsNoCafRefs 5 -> return HsLevity - _ -> HsCpr <$> get bh + 6 -> HsCpr <$> get bh + _ -> HsLFInfo <$> get bh instance Binary IfaceUnfolding where put_ bh (IfCoreUnfold s e) = do @@ -2495,6 +2572,7 @@ instance NFData IfaceInfoItem where HsNoCafRefs -> () HsLevity -> () HsCpr cpr -> cpr `seq` () + HsLFInfo lf_info -> lf_info `seq` () -- TODO: seq further? instance NFData IfaceUnfolding where rnf = \case ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -122,6 +122,9 @@ data IfaceOneShot -- See Note [Preserve OneShotInfo] in CoreTicy = IfaceNoOneShot -- and Note [The oneShot function] in MkId | IfaceOneShot +instance Outputable IfaceOneShot where + ppr IfaceNoOneShot = text "NoOneShotInfo" + ppr IfaceOneShot = text "OneShot" {- %************************************************************************ ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -19,7 +19,8 @@ module GHC.IfaceToCore ( tcIfaceDecl, tcIfaceInst, tcIfaceFamInst, tcIfaceRules, tcIfaceAnnotations, tcIfaceCompleteSigs, tcIfaceExpr, -- Desired by HERMIT (#7683) - tcIfaceGlobal + tcIfaceGlobal, + tcIfaceOneShot ) where #include "HsVersions.h" @@ -30,6 +31,9 @@ import TcTypeNats(typeNatCoAxiomRules) import GHC.Iface.Syntax import GHC.Iface.Load import GHC.Iface.Env +import GHC.StgToCmm.Types +import GHC.StgToCmm.Closure +import GHC.Types.RepType import BuildTyCl import TcRnMonad import TcType @@ -641,7 +645,7 @@ tc_iface_decl _ ignore_prags (IfaceId {ifName = name, ifType = iface_type, = do { ty <- tcIfaceType iface_type ; details <- tcIdDetails ty details ; info <- tcIdInfo ignore_prags TopLevel name ty info - ; return (AnId (mkGlobalId details name ty info)) } + ; return (AnId (addIdLFInfo (mkGlobalId details name ty info))) } tc_iface_decl _ _ (IfaceData {ifName = tc_name, ifCType = cType, @@ -1340,7 +1344,8 @@ tcIfaceExpr (IfaceLet (IfaceNonRec (IfLetBndr fs ty info ji) rhs) body) ; ty' <- tcIfaceType ty ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -} NotTopLevel name ty' info - ; let id = mkLocalIdWithInfo name ty' id_info + ; let id = addIdLFInfo $ + mkLocalIdWithInfo name ty' id_info `asJoinId_maybe` tcJoinInfo ji ; rhs' <- tcIfaceExpr rhs ; body' <- extendIfaceIdEnv [id] (tcIfaceExpr body) @@ -1361,7 +1366,7 @@ tcIfaceExpr (IfaceLet (IfaceRec pairs) body) = do { rhs' <- tcIfaceExpr rhs ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -} NotTopLevel (idName id) (idType id) info - ; return (setIdInfo id id_info, rhs') } + ; return (addIdLFInfo (setIdInfo id id_info), rhs') } tcIfaceExpr (IfaceTick tickish expr) = do expr' <- tcIfaceExpr expr @@ -1465,8 +1470,7 @@ tcIdInfo ignore_prags toplvl name ty info = do let init_info | if_boot lcl_env = vanillaIdInfo `setUnfoldingInfo` BootUnfolding | otherwise = vanillaIdInfo - let needed = needed_prags info - foldlM tcPrag init_info needed + foldlM tcPrag init_info (needed_prags info) where needed_prags :: [IfaceInfoItem] -> [IfaceInfoItem] needed_prags items @@ -1486,6 +1490,9 @@ tcIdInfo ignore_prags toplvl name ty info = do tcPrag info (HsCpr cpr) = return (info `setCprInfo` cpr) tcPrag info (HsInline prag) = return (info `setInlinePragInfo` prag) tcPrag info HsLevity = return (info `setNeverLevPoly` ty) + tcPrag info (HsLFInfo lf_info) = do + lf_info <- tcLFInfo lf_info + return (info `setLFInfo` lf_info) -- The next two are lazy, so they don't transitively suck stuff in tcPrag info (HsUnfold lb if_unf) @@ -1494,10 +1501,54 @@ tcIdInfo ignore_prags toplvl name ty info = do | otherwise = info ; return (info1 `setUnfoldingInfo` unf) } +addIdLFInfo :: Id -> Id +addIdLFInfo id = case idLFInfo_maybe id of + Nothing -> setIdLFInfo id (mkLFImported (idDetails id) (idInfo id) (idType id)) + Just _ -> id + +-- Make a LambdaFormInfo for the Ids without a LFInfo in the iface file +mkLFImported :: IdDetails -> IdInfo -> Type -> LambdaFormInfo +mkLFImported details info ty + | DataConWorkId con <- details + , isNullaryRepDataCon con + = LFCon con -- An imported nullary constructor + -- We assume that the constructor is evaluated so that + -- the id really does point directly to the constructor + + | arity > 0 + = LFReEntrant TopLevel noOneShotInfo arity True ArgUnknown + + | isUnliftedType ty + = LFUnlifted + + | mightBeAFunction ty + = LFUnknown True + + | otherwise + = LFUnknown False + where + arity = countFunRepArgs (arityInfo info) ty + tcJoinInfo :: IfaceJoinInfo -> Maybe JoinArity tcJoinInfo (IfaceJoinPoint ar) = Just ar tcJoinInfo IfaceNotJoinPoint = Nothing +tcLFInfo :: IfaceLFInfo -> IfL LambdaFormInfo +tcLFInfo (IfLFReEntrant oneshot rep fvs_flag) = + return (LFReEntrant TopLevel (tcIfaceOneShot oneshot) rep fvs_flag ArgUnknown) + +tcLFInfo (IfLFThunk fvs_flag upd_flag sfi fun_flag ) = do + return (LFThunk TopLevel fvs_flag upd_flag (tcStandardFormInfo sfi) fun_flag) + +tcLFInfo IfLFUnlifted = return LFUnlifted + +tcLFInfo (IfLFCon con_name) = + forkM (text "Loading LFCon constructor:" <+> ppr con_name) $ do + LFCon <$!> {-# SCC tcIfaceDataCon #-} tcIfaceDataCon con_name + +tcLFInfo (IfLFUnknown fun_flag) = + return (LFUnknown fun_flag) + tcUnfolding :: TopLevelFlag -> Name -> Type -> IdInfo -> IfaceUnfolding -> IfL Unfolding tcUnfolding toplvl name _ info (IfCoreUnfold stable if_expr) = do { dflags <- getDynFlags @@ -1586,6 +1637,10 @@ tcPragExpr is_compulsory toplvl name expr -- It's OK to use nonDetEltsUFM here because we immediately forget -- the ordering by creating a set +tcIfaceOneShot :: IfaceOneShot -> OneShotInfo +tcIfaceOneShot IfaceNoOneShot = NoOneShotInfo +tcIfaceOneShot IfaceOneShot = OneShotLam + {- ************************************************************************ * * ===================================== compiler/GHC/Runtime/Heap/Layout.hs ===================================== @@ -51,6 +51,7 @@ import GHC.Driver.Session import Outputable import GHC.Platform import FastString +import GHC.StgToCmm.Types import Data.Word import Data.Bits @@ -64,9 +65,6 @@ import Data.ByteString (ByteString) ************************************************************************ -} --- | Word offset, or word count -type WordOff = Int - -- | Byte offset, or byte count type ByteOff = Int @@ -196,29 +194,6 @@ type ConstrDescription = ByteString -- result of dataConIdentity type FunArity = Int type SelectorOffset = Int -------------------------- --- We represent liveness bitmaps as a Bitmap (whose internal --- representation really is a bitmap). These are pinned onto case return --- vectors to indicate the state of the stack for the garbage collector. --- --- In the compiled program, liveness bitmaps that fit inside a single --- word (StgWord) are stored as a single word, while larger bitmaps are --- stored as a pointer to an array of words. - -type Liveness = [Bool] -- One Bool per word; True <=> non-ptr or dead - -- False <=> ptr - -------------------------- --- An ArgDescr describes the argument pattern of a function - -data ArgDescr - = ArgSpec -- Fits one of the standard patterns - !Int -- RTS type identifier ARG_P, ARG_N, ... - - | ArgGen -- General case - Liveness -- Details about the arguments - - ----------------------------------------------------------------------------- -- Construction @@ -540,10 +515,6 @@ instance Outputable SMRep where ppr (RTSRep ty rep) = text "tag:" <> ppr ty <+> ppr rep -instance Outputable ArgDescr where - ppr (ArgSpec n) = text "ArgSpec" <+> ppr n - ppr (ArgGen ls) = text "ArgGen" <+> ppr ls - pprTypeInfo :: ClosureTypeInfo -> SDoc pprTypeInfo (Constr tag descr) = text "Con" <+> ===================================== compiler/GHC/StgToCmm.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} +{-# LANGUAGE BangPatterns #-} ----------------------------------------------------------------------------- -- @@ -25,6 +26,7 @@ import GHC.StgToCmm.Utils import GHC.StgToCmm.Closure import GHC.StgToCmm.Hpc import GHC.StgToCmm.Ticky +import GHC.StgToCmm.Types (ModuleLFInfos) import GHC.Cmm import GHC.Cmm.CLabel @@ -45,6 +47,8 @@ import Outputable import Stream import BasicTypes import VarSet ( isEmptyDVarSet ) +import UniqFM +import NameEnv import OrdList import GHC.Cmm.Graph @@ -52,6 +56,7 @@ import GHC.Cmm.Graph import Data.IORef import Control.Monad (when,void) import Util +import Data.Maybe codeGen :: DynFlags -> Module @@ -59,7 +64,8 @@ codeGen :: DynFlags -> CollectedCCs -- (Local/global) cost-centres needing declaring/registering. -> [CgStgTopBinding] -- Bindings to convert -> HpcInfo - -> Stream IO CmmGroup () -- Output as a stream, so codegen can + -> Stream IO CmmGroup ModuleLFInfos + -- Output as a stream, so codegen can -- be interleaved with output codeGen dflags this_mod data_tycons @@ -101,6 +107,20 @@ codeGen dflags this_mod data_tycons mapM_ (cg . cgDataCon) (tyConDataCons tycon) ; mapM_ do_tycon data_tycons + + ; cg_id_infos <- cgs_binds <$> liftIO (readIORef cgref) + + -- Only external names are actually visible to codeGen. So they are the + -- only ones we care about. + ; let extractInfo info = lf `seq` Just (name,lf) + where + id = cg_id info + !name = idName id + lf = cg_lf info + + ; let !generatedInfo = mkNameEnv (mapMaybe extractInfo (eltsUFM cg_id_infos)) + + ; return $! generatedInfo } --------------------------------------------------------------- ===================================== compiler/GHC/StgToCmm/Closure.hs ===================================== @@ -24,7 +24,7 @@ module GHC.StgToCmm.Closure ( LambdaFormInfo, -- Abstract StandardFormInfo, -- ...ditto... mkLFThunk, mkLFReEntrant, mkConLFInfo, mkSelectorLFInfo, - mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape, + mkApLFInfo, mkLFArgument, mkLFLetNoEscape, mkLFStringLit, lfDynTag, isLFThunk, isLFReEntrant, lfUpdatable, @@ -51,6 +51,7 @@ module GHC.StgToCmm.Closure ( closureUpdReqd, closureSingleEntry, closureReEntrant, closureFunInfo, isToplevClosure, + mightBeAFunction, blackHoleOnEntry, -- Needs LambdaFormInfo and SMRep isStaticClosure, -- Needs SMPre @@ -70,6 +71,7 @@ import GHC.Stg.Syntax import GHC.Runtime.Heap.Layout import GHC.Cmm import GHC.Cmm.Ppr.Expr() -- For Outputable instances +import GHC.StgToCmm.Types import CostCentre import GHC.Cmm.BlockId @@ -188,86 +190,15 @@ addArgReps = map (\arg -> let arg' = fromNonVoid arg argPrimRep :: StgArg -> PrimRep argPrimRep arg = typePrimRep1 (stgArgType arg) - ------------------------------------------------------------------------------ --- LambdaFormInfo ------------------------------------------------------------------------------ - --- Information about an identifier, from the code generator's point of --- view. Every identifier is bound to a LambdaFormInfo in the --- environment, which gives the code generator enough info to be able to --- tail call or return that identifier. - -data LambdaFormInfo - = LFReEntrant -- Reentrant closure (a function) - TopLevelFlag -- True if top level - OneShotInfo - !RepArity -- Arity. Invariant: always > 0 - !Bool -- True <=> no fvs - ArgDescr -- Argument descriptor (should really be in ClosureInfo) - - | LFThunk -- Thunk (zero arity) - TopLevelFlag - !Bool -- True <=> no free vars - !Bool -- True <=> updatable (i.e., *not* single-entry) - StandardFormInfo - !Bool -- True <=> *might* be a function type - - | LFCon -- A saturated constructor application - DataCon -- The constructor - - | LFUnknown -- Used for function arguments and imported things. - -- We know nothing about this closure. - -- Treat like updatable "LFThunk"... - -- Imported things which we *do* know something about use - -- one of the other LF constructors (eg LFReEntrant for - -- known functions) - !Bool -- True <=> *might* be a function type - -- The False case is good when we want to enter it, - -- because then we know the entry code will do - -- For a function, the entry code is the fast entry point - - | LFUnlifted -- A value of unboxed type; - -- always a value, needs evaluation - - | LFLetNoEscape -- See LetNoEscape module for precise description - - -------------------------- --- StandardFormInfo tells whether this thunk has one of --- a small number of standard forms - -data StandardFormInfo - = NonStandardThunk - -- The usual case: not of the standard forms - - | SelectorThunk - -- A SelectorThunk is of form - -- case x of - -- con a1,..,an -> ak - -- and the constructor is from a single-constr type. - WordOff -- 0-origin offset of ak within the "goods" of - -- constructor (Recall that the a1,...,an may be laid - -- out in the heap in a non-obvious order.) - - | ApThunk - -- An ApThunk is of form - -- x1 ... xn - -- The code for the thunk just pushes x2..xn on the stack and enters x1. - -- There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled - -- in the RTS to save space. - RepArity -- Arity, n - - ------------------------------------------------------ -- Building LambdaFormInfo ------------------------------------------------------ mkLFArgument :: Id -> LambdaFormInfo mkLFArgument id - | isUnliftedType ty = LFUnlifted - | might_be_a_function ty = LFUnknown True - | otherwise = LFUnknown False + | isUnliftedType ty = LFUnlifted + | mightBeAFunction ty = LFUnknown True + | otherwise = LFUnknown False where ty = idType id @@ -295,13 +226,13 @@ mkLFThunk thunk_ty top fvs upd_flag LFThunk top (null fvs) (isUpdatable upd_flag) NonStandardThunk - (might_be_a_function thunk_ty) + (mightBeAFunction thunk_ty) -------------- -might_be_a_function :: Type -> Bool +mightBeAFunction :: Type -> Bool -- Return False only if we are *sure* it's a data type -- Look through newtypes etc as much as poss -might_be_a_function ty +mightBeAFunction ty | [LiftedRep] <- typePrimRep ty , Just tc <- tyConAppTyCon_maybe (unwrapType ty) , isDataTyCon tc @@ -317,30 +248,13 @@ mkConLFInfo con = LFCon con mkSelectorLFInfo :: Id -> Int -> Bool -> LambdaFormInfo mkSelectorLFInfo id offset updatable = LFThunk NotTopLevel False updatable (SelectorThunk offset) - (might_be_a_function (idType id)) + (mightBeAFunction (idType id)) ------------- mkApLFInfo :: Id -> UpdateFlag -> Arity -> LambdaFormInfo mkApLFInfo id upd_flag arity = LFThunk NotTopLevel (arity == 0) (isUpdatable upd_flag) (ApThunk arity) - (might_be_a_function (idType id)) - -------------- -mkLFImported :: Id -> LambdaFormInfo -mkLFImported id - | Just con <- isDataConWorkId_maybe id - , isNullaryRepDataCon con - = LFCon con -- An imported nullary constructor - -- We assume that the constructor is evaluated so that - -- the id really does point directly to the constructor - - | arity > 0 - = LFReEntrant TopLevel noOneShotInfo arity True (panic "arg_descr") - - | otherwise - = mkLFArgument id -- Not sure of exact arity - where - arity = idFunRepArity id + (mightBeAFunction (idType id)) ------------- mkLFStringLit :: LambdaFormInfo ===================================== compiler/GHC/StgToCmm/Env.hs ===================================== @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP, MultiWayIf #-} ----------------------------------------------------------------------------- -- @@ -30,6 +30,7 @@ import GHC.Core.TyCon import GHC.StgToCmm.Monad import GHC.StgToCmm.Utils import GHC.StgToCmm.Closure +import GHC.StgToCmm.Types import GHC.Cmm.CLabel @@ -47,6 +48,8 @@ import TysPrim import UniqFM import Util import VarEnv +import GHC.Core.DataCon +import BasicTypes ------------------------------------- -- Manipulating CgIdInfo @@ -143,6 +146,27 @@ getCgIdInfo id cgLookupPanic id -- Bug }}} +mkLFImported :: Id -> LambdaFormInfo +mkLFImported id = + case idLFInfo_maybe id of + Just lf_info -> + lf_info + Nothing -> + WARN( True, text "mkLFImported: Id with unknown LFInfo: " <+> ppr id ) + if | Just con <- isDataConWorkId_maybe id + , isNullaryRepDataCon con + -> LFCon con -- An imported nullary constructor + -- We assume that the constructor is evaluated so that + -- the id really does point directly to the constructor + + | arity > 0 + -> LFReEntrant TopLevel noOneShotInfo arity True (panic "arg_descr") + + | otherwise + -> mkLFArgument id -- Not sure of exact arity + where + arity = idFunRepArity id + cgLookupPanic :: Id -> FCode a cgLookupPanic id = do local_binds <- getBinds ===================================== compiler/GHC/StgToCmm/Types.hs ===================================== @@ -0,0 +1,157 @@ +{-# LANGUAGE CPP #-} + +module GHC.StgToCmm.Types + ( WordOff + , LambdaFormInfo (..) + , ModuleLFInfos + , Liveness + , ArgDescr (..) + , StandardFormInfo (..) + ) where + +#include "HsVersions.h" + +import GhcPrelude + +import BasicTypes +import GHC.Core.DataCon +import NameEnv +import Outputable + +-- | Word offset, or word count +type WordOff = Int + +-------------------------------------------------------------------------------- +-- LambdaFormInfo +-------------------------------------------------------------------------------- + +-- | Maps names in the current module to their LambdaFormInfos +type ModuleLFInfos = NameEnv LambdaFormInfo + +-- Information about an identifier, from the code generator's point of view. +-- Every identifier is bound to a LambdaFormInfo in the environment, which gives +-- the code generator enough info to be able to tail call or return that +-- identifier. + +data LambdaFormInfo + = LFReEntrant -- Reentrant closure (a function) + TopLevelFlag -- True if top level + OneShotInfo + !RepArity -- Arity. Invariant: always > 0 + !Bool -- True <=> no fvs + ArgDescr -- Argument descriptor (should really be in ClosureInfo) + + | LFThunk -- Thunk (zero arity) + TopLevelFlag + !Bool -- True <=> no free vars + !Bool -- True <=> updatable (i.e., *not* single-entry) + StandardFormInfo + !Bool -- True <=> *might* be a function type + + | LFCon -- A saturated constructor application + DataCon -- The constructor + + | LFUnknown -- Used for function arguments and imported things. + -- We know nothing about this closure. + -- Treat like updatable "LFThunk"... + -- Imported things which we *do* know something about use + -- one of the other LF constructors (eg LFReEntrant for + -- known functions) + !Bool -- True <=> *might* be a function type + -- The False case is good when we want to enter it, + -- because then we know the entry code will do + -- For a function, the entry code is the fast entry point + + | LFUnlifted -- A value of unboxed type; + -- always a value, needs evaluation + + | LFLetNoEscape -- See LetNoEscape module for precise description + +instance Outputable LambdaFormInfo where + ppr (LFReEntrant top oneshot rep fvs argdesc) = + text "LFReEntrant" <> brackets (ppr top <+> ppr oneshot <+> + ppr rep <+> pprFvs fvs <+> ppr argdesc) + ppr (LFThunk top hasfv updateable sfi m_function) = + text "LFThunk" <> brackets (ppr top <+> pprFvs hasfv <+> pprUpdateable updateable <+> + ppr sfi <+> pprFuncFlag m_function) + ppr (LFCon con) = text "LFCon" <> brackets (ppr con) + ppr (LFUnknown m_func) = + text "LFUnknown" <> brackets (pprFuncFlag m_func) + ppr LFUnlifted = text "LFUnlifted" + ppr LFLetNoEscape = text "LFLetNoEscape" + +pprFvs :: Bool -> SDoc +pprFvs True = text "no-fvs" +pprFvs False = text "fvs" + +pprFuncFlag :: Bool -> SDoc +pprFuncFlag True = text "mFunc" +pprFuncFlag False = text "value" + +pprUpdateable :: Bool -> SDoc +pprUpdateable True = text "updateable" +pprUpdateable False = text "oneshot" + +-------------------------------------------------------------------------------- + +-- | We represent liveness bitmaps as a Bitmap (whose internal representation +-- really is a bitmap). These are pinned onto case return vectors to indicate +-- the state of the stack for the garbage collector. +-- +-- In the compiled program, liveness bitmaps that fit inside a single word +-- (StgWord) are stored as a single word, while larger bitmaps are stored as a +-- pointer to an array of words. + +type Liveness = [Bool] -- One Bool per word; True <=> non-ptr or dead + -- False <=> ptr + +-------------------------------------------------------------------------------- +-- | An ArgDescr describes the argument pattern of a function + +data ArgDescr + = ArgSpec -- Fits one of the standard patterns + !Int -- RTS type identifier ARG_P, ARG_N, ... + + | ArgGen -- General case + Liveness -- Details about the arguments + + | ArgUnknown -- For imported binds. + -- Invariant: Never Unknown for binds of the module + -- we are compiling. + deriving (Eq) + +instance Outputable ArgDescr where + ppr (ArgSpec n) = text "ArgSpec" <+> ppr n + ppr (ArgGen ls) = text "ArgGen" <+> ppr ls + ppr ArgUnknown = text "ArgUnknown" + +-------------------------------------------------------------------------------- +-- | StandardFormInfo tells whether this thunk has one of a small number of +-- standard forms + +data StandardFormInfo + = NonStandardThunk + -- The usual case: not of the standard forms + + | SelectorThunk + -- A SelectorThunk is of form + -- case x of + -- con a1,..,an -> ak + -- and the constructor is from a single-constr type. + WordOff -- 0-origin offset of ak within the "goods" of + -- constructor (Recall that the a1,...,an may be laid + -- out in the heap in a non-obvious order.) + + | ApThunk + -- An ApThunk is of form + -- x1 ... xn + -- The code for the thunk just pushes x2..xn on the stack and enters x1. + -- There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled + -- in the RTS to save space. + RepArity -- Arity, n + deriving (Eq) + +instance Outputable StandardFormInfo where + ppr NonStandardThunk = text "RegThunk" + ppr (SelectorThunk w) = text "SelThunk:" <> ppr w + ppr (ApThunk n) = text "ApThunk:" <> ppr n ===================================== compiler/basicTypes/Id.hs ===================================== @@ -92,7 +92,7 @@ module Id ( idCallArity, idFunRepArity, idUnfolding, realIdUnfolding, idSpecialisation, idCoreRules, idHasRules, - idCafInfo, + idCafInfo, idLFInfo, idLFInfo_maybe, idOneShotInfo, idStateHackOneShotInfo, idOccInfo, isNeverLevPolyId, @@ -105,6 +105,7 @@ module Id ( setIdSpecialisation, setIdCafInfo, setIdOccInfo, zapIdOccInfo, + setIdLFInfo, setIdDemandInfo, setIdStrictness, @@ -731,6 +732,19 @@ idCafInfo id = cafInfo (idInfo id) setIdCafInfo :: Id -> CafInfo -> Id setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id + --------------------------------- + -- Lambda form info +idLFInfo :: HasCallStack => Id -> LambdaFormInfo +idLFInfo id = case lfInfo (idInfo id) of + Nothing -> pprPanic "idLFInfo" (text "LFInfo not available for Id" <+> ppr id) + Just lf_info -> lf_info + +idLFInfo_maybe :: Id -> Maybe LambdaFormInfo +idLFInfo_maybe = lfInfo . idInfo + +setIdLFInfo :: Id -> LambdaFormInfo -> Id +setIdLFInfo id lf = modifyIdInfo (`setLFInfo` lf) id + --------------------------------- -- Occurrence INFO idOccInfo :: Id -> OccInfo ===================================== compiler/basicTypes/IdInfo.hs ===================================== @@ -74,6 +74,10 @@ module IdInfo ( ppCafInfo, mayHaveCafRefs, cafInfo, setCafInfo, + -- ** The LambdaFormInfo type + LambdaFormInfo(..), + lfInfo, setLFInfo, + -- ** Tick-box Info TickBoxOp(..), TickBoxId, @@ -104,6 +108,8 @@ import Demand import Cpr import Util +import GHC.StgToCmm.Types (LambdaFormInfo (..)) + -- infixl so you can say (id `set` a `set` b) infixl 1 `setRuleInfo`, `setArityInfo`, @@ -270,8 +276,9 @@ data IdInfo -- ^ 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 + levityInfo :: LevityInfo, -- ^ when applied, will this Id ever have a levity-polymorphic type? + lfInfo :: !(Maybe LambdaFormInfo) } -- Setters @@ -294,13 +301,18 @@ setUnfoldingInfo info uf setArityInfo :: IdInfo -> ArityInfo -> IdInfo setArityInfo info ar = info { arityInfo = ar } + setCallArityInfo :: IdInfo -> ArityInfo -> IdInfo setCallArityInfo info ar = info { callArityInfo = ar } + setCafInfo :: IdInfo -> CafInfo -> IdInfo -setCafInfo info caf = info { cafInfo = caf } +setCafInfo info caf = info { cafInfo = caf } + +setLFInfo :: IdInfo -> LambdaFormInfo -> IdInfo +setLFInfo info lf = info { lfInfo = Just lf } setOneShotInfo :: IdInfo -> OneShotInfo -> IdInfo -setOneShotInfo info lb = {-lb `seq`-} info { oneShotInfo = lb } +setOneShotInfo info lb = {-lb `seq`-} info { oneShotInfo = lb } setDemandInfo :: IdInfo -> Demand -> IdInfo setDemandInfo info dd = dd `seq` info { demandInfo = dd } @@ -326,7 +338,8 @@ vanillaIdInfo strictnessInfo = nopSig, cprInfo = topCprSig, callArityInfo = unknownArity, - levityInfo = NoLevityInfo + levityInfo = NoLevityInfo, + lfInfo = Nothing } -- | More informative 'IdInfo' we can use when we know the 'Id' has no CAF references ===================================== compiler/ghc.cabal.in ===================================== @@ -298,6 +298,7 @@ Library GHC.StgToCmm.Ticky GHC.StgToCmm.Utils GHC.StgToCmm.ExtCode + GHC.StgToCmm.Types GHC.Runtime.Heap.Layout GHC.Core.Arity GHC.Core.FVs ===================================== compiler/main/UpdateCafInfos.hs ===================================== @@ -17,6 +17,7 @@ import NameSet import Util import Var import Outputable +import GHC.StgToCmm.Types (ModuleLFInfos) #include "HsVersions.h" @@ -24,14 +25,15 @@ import Outputable updateModDetailsCafInfos :: DynFlags -> NameSet -- ^ Non-CAFFY names in the module. Names not in this set are CAFFY. + -> ModuleLFInfos -> ModDetails -- ^ ModDetails to update -> ModDetails -updateModDetailsCafInfos dflags _ mod_details +updateModDetailsCafInfos dflags _ _ mod_details | gopt Opt_OmitInterfacePragmas dflags = mod_details -updateModDetailsCafInfos _ non_cafs mod_details = +updateModDetailsCafInfos _ non_cafs lf_infos mod_details = {- pprTrace "updateModDetailsCafInfos" (text "non_cafs:" <+> ppr non_cafs) $ -} let ModDetails{ md_types = type_env -- for unfoldings @@ -40,10 +42,10 @@ updateModDetailsCafInfos _ non_cafs mod_details = } = mod_details -- type TypeEnv = NameEnv TyThing - ~type_env' = mapNameEnv (updateTyThingCafInfos type_env' non_cafs) type_env + ~type_env' = mapNameEnv (updateTyThingCafInfos type_env' non_cafs lf_infos) type_env -- Not strict! - !insts' = strictMap (updateInstCafInfos type_env' non_cafs) insts + !insts' = strictMap (updateInstCafInfos type_env' non_cafs lf_infos) insts !rules' = strictMap (updateRuleCafInfos type_env') rules in mod_details{ md_types = type_env' @@ -63,20 +65,20 @@ updateRuleCafInfos type_env Rule{ .. } = Rule { ru_rhs = updateGlobalIds type_en -- Instances -------------------------------------------------------------------------------- -updateInstCafInfos :: TypeEnv -> NameSet -> ClsInst -> ClsInst -updateInstCafInfos type_env non_cafs = - updateClsInstDFun (updateIdUnfolding type_env . updateIdCafInfo non_cafs) +updateInstCafInfos :: TypeEnv -> NameSet -> ModuleLFInfos -> ClsInst -> ClsInst +updateInstCafInfos type_env non_cafs lf_infos = + updateClsInstDFun (updateIdUnfolding type_env . updateIdCafInfo non_cafs lf_infos) -------------------------------------------------------------------------------- -- TyThings -------------------------------------------------------------------------------- -updateTyThingCafInfos :: TypeEnv -> NameSet -> TyThing -> TyThing +updateTyThingCafInfos :: TypeEnv -> NameSet -> ModuleLFInfos -> TyThing -> TyThing -updateTyThingCafInfos type_env non_cafs (AnId id) = - AnId (updateIdUnfolding type_env (updateIdCafInfo non_cafs id)) +updateTyThingCafInfos type_env non_cafs lf_infos (AnId id) = + AnId (updateIdUnfolding type_env (updateIdCafInfo non_cafs lf_infos id)) -updateTyThingCafInfos _ _ other = other -- AConLike, ATyCon, ACoAxiom +updateTyThingCafInfos _ _ _ other = other -- AConLike, ATyCon, ACoAxiom -------------------------------------------------------------------------------- -- Unfoldings @@ -95,13 +97,18 @@ updateIdUnfolding type_env id = -- Expressions -------------------------------------------------------------------------------- -updateIdCafInfo :: NameSet -> Id -> Id -updateIdCafInfo non_cafs id - | idName id `elemNameSet` non_cafs - = -- pprTrace "updateIdCafInfo" (text "Marking" <+> ppr id <+> parens (ppr (idName id)) <+> text "as non-CAFFY") $ - id `setIdCafInfo` NoCafRefs - | otherwise - = id +updateIdCafInfo :: NameSet -> ModuleLFInfos -> Id -> Id +updateIdCafInfo non_cafs lf_infos id = + let + not_caffy = elemNameSet (idName id) non_cafs + mb_lf_info = lookupNameEnv lf_infos (idName id) + + id1 = if not_caffy then setIdCafInfo id NoCafRefs else id + id2 = case mb_lf_info of + Nothing -> id1 + Just lf_info -> setIdLFInfo id1 lf_info + in + id2 -------------------------------------------------------------------------------- ===================================== testsuite/tests/codeGen/should_compile/Makefile ===================================== @@ -64,10 +64,10 @@ T17648: # NoCafRefs) to the interface files. '$(TEST_HC)' $(TEST_HC_OPTS) -dno-typeable-binds -O T17648.hs -v0 '$(TEST_HC)' --show-iface T17648.hi | tr -d '\n' | \ - grep -F 'f :: T GHC.Types.Int -> () [HasNoCafRefs, Arity' >/dev/null + grep -F 'f :: T GHC.Types.Int -> () [HasNoCafRefs, LambdaFormInfo' >/dev/null # Second compilation with -fcatch-bottoms, f should be CAFFY '$(TEST_HC)' $(TEST_HC_OPTS) -dno-typeable-binds -O \ -fcatch-bottoms T17648.hs -v0 -fforce-recomp '$(TEST_HC)' --show-iface T17648.hi | tr -d '\n' | \ - grep -F 'f :: T GHC.Types.Int -> () [Arity: 1, Strictness' >/dev/null + grep -F 'f :: T GHC.Types.Int -> () [LambdaFormInfo' >/dev/null ===================================== testsuite/tests/codeGen/should_compile/cg009/A.hs ===================================== @@ -0,0 +1,5 @@ +module A where + +newtype A = A Int + +val = A 42 ===================================== testsuite/tests/codeGen/should_compile/cg009/Main.hs ===================================== @@ -0,0 +1,7 @@ +module Main where + +import A + +main = return () + +a = val ===================================== testsuite/tests/codeGen/should_compile/cg009/Makefile ===================================== @@ -0,0 +1,9 @@ +TOP=../../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +# Make sure the LFInfo for an exported, but not directly used newtype +# constructors does not trip up the compiler. +cg009: + '$(TEST_HC)' $(TEST_HC_OPTS) -c -O A.hs -fforce-recomp + '$(TEST_HC)' $(TEST_HC_OPTS) -c -O0 Main.hs -fforce-recomp ===================================== testsuite/tests/codeGen/should_compile/cg009/all.T ===================================== @@ -0,0 +1 @@ +test('cg009', [extra_files(['A.hs','Main.hs'])], makefile_test, ['cg009']) ===================================== testsuite/tests/codeGen/should_compile/cg010/A.hs ===================================== @@ -0,0 +1,4 @@ +module A where + +{-# NOINLINE val #-} +val = Just 42 ===================================== testsuite/tests/codeGen/should_compile/cg010/Main.hs ===================================== @@ -0,0 +1,8 @@ +module Main where + +import A + +main = return () + +a = val + ===================================== testsuite/tests/codeGen/should_compile/cg010/Makefile ===================================== @@ -0,0 +1,9 @@ +TOP=../../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +# Make sure LFInfo causes the imported reference to val to get tagged. +cg010: + '$(TEST_HC)' $(TEST_HC_OPTS) -c -O A.hs -fforce-recomp + '$(TEST_HC)' $(TEST_HC_OPTS) -c -O Main.hs -fforce-recomp -ddump-cmm -ddump-to-file + grep "A.val_closure+2" Main.dump-cmm ===================================== testsuite/tests/codeGen/should_compile/cg010/all.T ===================================== @@ -0,0 +1 @@ +test('cg010', [extra_files(['A.hs','Main.hs'])], makefile_test, ['cg010']) ===================================== testsuite/tests/codeGen/should_compile/cg010/cg010.stdout ===================================== @@ -0,0 +1 @@ + const A.val_closure+2; ===================================== testsuite/tests/simplCore/should_compile/Makefile ===================================== @@ -102,7 +102,7 @@ T4201: '$(TEST_HC)' $(TEST_HC_OPTS) -c -O T4201.hs '$(TEST_HC)' $(TEST_HC_OPTS) --show-iface T4201.hi > T4201.list # poor man idea about how to replace GNU grep -B2 "Sym" invocation with pure POSIX tools - for i in `grep -n "Sym" T4201.list |cut -d ':' -f -1`; do head -$$i T4201.list | tail -3 ; done + for i in `grep -n "Sym" T4201.list | cut -d ':' -f -1`; do head -$$i T4201.list | tail -5; done $(RM) -f T4201.list # This one looped as a result of bogus specialisation ===================================== testsuite/tests/simplCore/should_compile/T4201.stdout ===================================== @@ -1,3 +1,5 @@ - [HasNoCafRefs, Arity: 1, Strictness: , CPR: m1, + [HasNoCafRefs, + LambdaFormInfo: LFReEntrant (NoOneShotInfo, 1, True), Arity: 1, + Strictness: , CPR: m1, Unfolding: InlineRule (0, True, True) bof `cast` (Sym (N:Foo[0]) ->_R _R)] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/481dfb8f795d396d764e05012ef6ea6345e22bb7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/481dfb8f795d396d764e05012ef6ea6345e22bb7 You're receiving 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 Mar 19 01:32:30 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 18 Mar 2020 21:32:30 -0400 Subject: [Git][ghc/ghc][wip/test] Add test-metrics.sh from master Message-ID: <5e72cbae6593_488a3fc6ca423d3c20394ba@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/test at Glasgow Haskell Compiler / GHC Commits: 06ee06fb by Ben Gamari at 2020-03-19T01:32:17Z Add test-metrics.sh from master - - - - - 1 changed file: - + .gitlab/test-metrics.sh Changes: ===================================== .gitlab/test-metrics.sh ===================================== @@ -0,0 +1,89 @@ +#!/usr/bin/env bash +# vim: sw=2 et +set -euo pipefail + +NOTES_ORIGIN="https://gitlab.haskell.org/ghc/ghc-performance-notes.git" +NOTES_ORIGIN_PUSH="git at gitlab.haskell.org:ghc/ghc-performance-notes.git" +REF="perf" + +run() { + echo "$@" + $@ +} + +fail() { + echo "ERROR: $*" >&2 + exit 1 +} + +function pull() { + local ref="refs/notes/$REF" + run git fetch -f $NOTES_ORIGIN $ref:$ref + echo "perf notes ref $ref is $(git rev-parse $ref)" +} + +function setup_ssh() { + # Add gitlab as a known host. + mkdir -p ~/.ssh + echo "|1|+AUrMGS1elvPeLNt+NHGa5+c6pU=|4XvfRsQftO1OgZD4c0JJ7oNaii8= ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAACAQDXilA5l4kOZPx0nM6xDATF+t4fS6te0eYPDwBI/jLWD9cJVtCnsrwMl5ar+/NfmcD0jnCYztUiVHuXyTaWPJYSQpwltfpTeqpo9/z/0MxkPtSl1uMP2cLbDiqA01OWveChktOXwU6hRQ+7MmO+dNRS/iXrRmYrGv/p1W811QgLBLS9fefEdF25n+0dP71L7Ov7riOawlDmd0C11FraE/R8HX6gs6lbXta1kisdxGyKojYSiCtobUaJxRoatMfUP0a9rwTAyl8tf56LgB+igjMky879VAbL7eQ/AmfHYPrSGJ/YlWP6Jj23Dnos5nOVlWL/rVTs9Y/NakLpPwMs75KTC0Pd74hdf2e3folDdAi2kLrQgO2SI6so7rOYZ+mFkCM751QdDVy4DzjmDvSgSIVf9SV7RQf7e7unE7pSZ/ILupZqz9KhR1MOwVO+ePa5qJMNSdC204PIsRWkIO5KP0QLl507NI9Ri84+aODoHD7gDIWNhU08J2P8/E6r0wcC8uWaxh+HaOjI9BkHjqRYsrgfn54BAuO9kw1cDvyi3c8n7VFlNtvQP15lANwim3gr9upV+r95KEPJCgZMYWJBDPIVtp4GdYxCfXxWj5oMXbA5pf0tNixwNJjAsY7I6RN2htHbuySH36JybOZk+gCj6mQkxpCT/tKaUn14hBJWLq7Q+Q==" >> ~/.ssh/known_hosts + echo "|1|JZkdAPJmpX6SzGeqhmQLfMWLGQA=|4vTELroOlbFxbCr0WX+PK9EcpD0= ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIJknufU+I6A5Nm58lmse4/o11Ai2UzYbYe7782J1+kRk" >> ~/.ssh/known_hosts + + # Setup ssh keys. + eval `ssh-agent` + echo "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQDJPR1vrZgeGTXmgJw2PsJfMjf22LcDnVVwt3l0rwTZ+8Q2J0bHaYxMRKBco1sON6LGcZepw0Hy76RQ87v057pTz18SXvnfE7U/B6v9qBk0ILJz+4BOX9sEhxu2XmScp/wMxkG9IoyruMlsxXzd1sz09o+rzzx24U2Rp27PRm08vG0oipve6BWLbYEqYrE4/nCufqOJmGd56fju7OTU0lTpEkGDEDWGMxutaX2CbTbDju7qy07Ld8BjSc9aHfvuQaslUbj3ex3EF8EXahURzGpHQn/UFFzVGMokFumiJCAagHQb7cj6jOkKseZLaysbA/mTBQsOzjWiRmkN23bQf1wF ben+ghc-ci at smart-cactus.org" > ~/.ssh/perf_rsa.pub + touch ~/.ssh/perf_rsa + chmod 0600 ~/.ssh/perf_rsa + echo "$PERF_NOTE_KEY" >> ~/.ssh/perf_rsa + ssh-add ~/.ssh/perf_rsa +} + +# Reset the git notes and append the metrics file to the notes, then push and return the result. +# This is favoured over a git notes merge as it avoids potential data loss/duplication from the merge strategy. +function reset_append_note_push { + pull || true + run git notes --ref=$REF append -F $METRICS_FILE HEAD + run git push $NOTES_ORIGIN_PUSH refs/notes/$REF +} + +function push() { + # Check that private key is available (Set on all GitLab protected branches). + if [ -z ${PERF_NOTE_KEY+"$PERF_NOTE_KEY"} ] + then + echo "Not pushing performance git notes: PERF_NOTE_KEY is not set." + exit 0 + fi + + # TEST_ENV must be set. + if [ -z ${TEST_ENV+"$TEST_ENV"} ] + then + fail "Not pushing performance git notes: TEST_ENV must be set." + fi + + # Assert that the METRICS_FILE exists and can be read. + if [ -z ${METRICS_FILE+"$METRICS_FILE"} ] + then + fail "\$METRICS_FILE not set." + fi + if ! [ -r $METRICS_FILE ] + then + fail "Metrics file not found: $METRICS_FILE" + fi + + setup_ssh + + # Push the metrics file as a git note. This may fail if another task pushes a note first. In that case + # the latest note is fetched and appended. + MAX_RETRY=20 + until reset_append_note_push || [ $MAX_RETRY -le 0 ] + do + ((MAX_RETRY--)) + echo "" + echo "Failed to push git notes. Fetching, appending, and retrying... $MAX_RETRY retries left." + done +} + +case $1 in + push) push ;; + pull) pull ;; + *) fail "Invalid mode $1" ;; +esac View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/06ee06fb89689d7c2e0c5b7b030641f58bb2f2c1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/06ee06fb89689d7c2e0c5b7b030641f58bb2f2c1 You're receiving 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 Mar 20 02:23:52 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 19 Mar 2020 22:23:52 -0400 Subject: [Git][ghc/ghc][wip/with2] 122 commits: check for safe arguments, raising error when invalid (fix #17720) Message-ID: <5e742938c3e0f_488a3fc6f87158a022736c4@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/with2 at Glasgow Haskell Compiler / GHC Commits: e295a024 by Stefan Pavikevik at 2020-02-25T01:53:44Z check for safe arguments, raising error when invalid (fix #17720) - - - - - 354e2787 by Krzysztof Gogolewski at 2020-02-25T01:54:35Z 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-25T01:55:25Z Modules: CmmToAsm (#13009) - - - - - 621468f6 by Alexis King at 2020-02-26T20:08:09Z Treat coercions as arguments for floating and inlining This reverts commit 8924224ecfa065ebc67b96a90d01cf9d2edd0e77 and fixes #17787. - - - - - def486c9 by Ben Gamari at 2020-02-26T20:08:47Z hadrian: Allow libnuma library path to be specified - - - - - ed03d4e7 by Ben Gamari at 2020-02-26T20:08:47Z hadrian: Refactor gmp arguments Move the gmp configuration to its own binding. - - - - - 09b88384 by Ben Gamari at 2020-02-26T20:08:47Z hadrian: Tell Cabal about integer-gmp library location - - - - - 161e08c5 by Krzysztof Gogolewski at 2020-02-26T20:09:30Z 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-26T20:10:09Z gitlab-ci: Use 8.8.3 to bootstrap on Windows This should fix #17861. - - - - - 972bcf3a by Ben Gamari at 2020-02-26T20:10:09Z testsuite: Fix symlink test Needs to `write` bytes, not str. - - - - - 273e60de by Ben Gamari at 2020-02-26T20:10:09Z gitlab-ci: Add shell subcommand for debugging within CI environment - - - - - 43b13ed3 by Ben Gamari at 2020-02-26T20:10:09Z gitlab-ci: Fix colors on Darwin Darwin sh doesn't support \e. - - - - - 217546a7 by Ben Gamari at 2020-02-26T20:10:09Z 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-26T20:10:09Z 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-26T20:10:09Z 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-26T20:10:09Z 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-26T20:10:09Z gitlab-ci: Mark some tests as broken on Alpine - - - - - 9ee7f87d by Ben Gamari at 2020-02-26T20:10:09Z SysTools: Don't use process jobs if they are broken - - - - - bfaa3961 by Ben Gamari at 2020-02-26T20:10:09Z Bump hsc2hs submodule Fixes name of C compiler. - - - - - b2b49a0a by Ben Gamari at 2020-02-26T20:10:09Z testsuite: Make hasMetricsFile RHS more descriptive - - - - - 817f93ea by Sylvain Henry at 2020-02-26T20:10:58Z Modules: Core (#13009) Update haddock submodule - - - - - 74311e10 by Sebastian Graf at 2020-02-27T21:22:45Z 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-27T21:23:25Z configure: correctly generate LIBRARY_template_haskell_VERSION - - - - - 9be82389 by Krzysztof Gogolewski at 2020-02-28T07:35:35Z 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-28T07:36:12Z 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-28T07:36:59Z 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-29T03:03:23Z 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-29T03:04:04Z 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-29T10:06:31Z 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-29T10:07:10Z 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-29T10:07:50Z 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-29T10:08:36Z 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-29T10:09:25Z 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-29T10:10:06Z docs: correct relative links to haddocks from users guide (fixes #17866) - - - - - 0f55df7f by Adam Sandberg Ericsson at 2020-02-29T10:10:06Z docs: correct link to th haddocks from users guide - - - - - 252e5117 by Jean-Baptiste Mazon at 2020-02-29T10:10:46Z rts: enforce POSIX numeric locale for heap profiles - - - - - 34c7d230 by Sylvain Henry at 2020-02-29T10:11:27Z Fix Hadrian's ``--configure`` (fix #17883) - - - - - 04d30137 by Ömer Sinan Ağacan at 2020-02-29T10:12:06Z 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-29T16:36:59Z 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-02T06:18:33Z 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-02T06:19:12Z 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-02T22:13:55Z 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-02T22:14:38Z Use configure script to detect that we should use in-tree GMP on Windows - - - - - 8c663c2c by Andreas Klebinger at 2020-03-04T15:12:14Z Be explicit about how stack usage of mvar primops are covered. This fixes #17893 [skip-ci] - - - - - cedd6f30 by Ben Gamari at 2020-03-05T19:53:12Z rts: Add getCurrentThreadCPUTime helper - - - - - ace618cd by Ben Gamari at 2020-03-05T19:53:12Z nonmoving-gc: Track time usage of nonmoving marking - - - - - 022b5ad5 by Ben Gamari at 2020-03-05T19:53:12Z Stats: Add sync pauses to +RTS -S output - - - - - 06763234 by Ben Gamari at 2020-03-05T19:53:12Z rts: Report nonmoving collector statistics in machine-readable output - - - - - 70d2b995 by Ben Gamari at 2020-03-09T10:10:52Z 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-09T10:11:30Z gitlab-ci: Disable Sphinx documentation in Alpine build - - - - - 8eb2c263 by Jean-Baptiste Mazon at 2020-03-09T20:33:37Z Fix Windows breakage by not touching locales on Windows - - - - - b8dab057 by Jean-Baptiste Mazon at 2020-03-09T20:33:37Z rts: ensure C numerics in heap profiles using Windows locales if needed - - - - - 7d95260f by Jean-Baptiste Mazon at 2020-03-09T20:33:37Z rts: refactor and comment profile locales - - - - - 5b627813 by Ryan Scott at 2020-03-09T20:34:14Z 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-10T06:05:42Z 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-10T06:05:42Z testsuite: Add test for #17786 This isn't pretty but it's perhaps better than nothing. - - - - - ee2c50cb by Sylvain Henry at 2020-03-10T06:06:33Z Hadrian: track missing configure results - - - - - ca8f51d4 by Ömer Sinan Ağacan at 2020-03-10T06:07:22Z Add regression test for T17904 Closes #17904 - - - - - 5fa9cb82 by Richard Eisenberg at 2020-03-10T16:29:46Z 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-10T16:30:27Z 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-10T16:31:15Z Comments only Clarify code added in #17852 and MR !2724 - - - - - 3300eeac by Krzysztof Gogolewski at 2020-03-10T16:31:54Z 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-10T17:05:01Z Typos in comments [skip ci] - - - - - bb586f89 by Ben Gamari at 2020-03-11T04:14:59Z 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-11T12:17:19Z 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-11T12:17:56Z Fixed a minor typo in codegen.rst - - - - - 0bc23338 by Ryan Scott at 2020-03-11T12:18:32Z 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-11T12:19:08Z 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-11T12:19:44Z 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-11T12:20:27Z 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-12T00:33:37Z 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-12T00:33:37Z 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-12T00:33:37Z 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-12T00:34:14Z 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-12T13:45:51Z 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-12T13:45:51Z 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-12T13:46:29Z 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-13T06:29:20Z 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-13T06:30:22Z 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-13T06:31:03Z Update documentation for closureSize - - - - - f124ff0d by Ben Gamari at 2020-03-13T06:31:40Z gitlab-ci: Rework triggering of release builds Use a push option instead of tagging. - - - - - 7f25557a by Ben Gamari at 2020-03-13T14:38:09Z 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-14T09:25:30Z 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-14T09:26:11Z 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-14T09:26:49Z Make: refactor GMP rules Document and use simpler rules for the ghc-gmp.h header. - - - - - 7432b327 by Sylvain Henry at 2020-03-14T09:27:28Z Use correct option name (-opti) (fix #17314) s/pgmo/opti - - - - - 8f7dd571 by Judah Jacobson at 2020-03-14T09:28:07Z 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-14T09:28:07Z Use AC_ARG_VAR for LD_STAGE0 and AR_STAGE0. - - - - - 20d4d676 by Ben Gamari at 2020-03-14T09:28:43Z 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-14T09:29:18Z 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-14T09:29:55Z 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-14T09:29:55Z 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-14T09:30:31Z gitlab-ci: Add integer-simple release build for Windows Closes #16144. - - - - - e3c374cc by Simon Peyton Jones at 2020-03-14T09:31:07Z 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-14T09:31:07Z 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-14T09:31:42Z 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-14T09:32:18Z 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-14T23:34:42Z Enable stage1 build of haddock The submodule has already been bumped to contain the fix. - - - - - 49e9d739 by Ömer Sinan Ağacan at 2020-03-14T23:35:24Z rts: Fix printClosure when printing fwd ptrs - - - - - 1de3ab4a by Krzysztof Gogolewski at 2020-03-14T23:36:04Z Remove unused field var_inline (#17915) - - - - - d30aeb4b by Krzysztof Gogolewski at 2020-03-15T07:57:41Z 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-15T07:58:18Z Remove some dead code >From the notes.ghc.drop list found using weeder in #17713 - - - - - dd6ffe6b by Viktor Dukhovni at 2020-03-15T07:58:55Z 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-15T14:57:10Z 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-15T14:57:48Z 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-15T14:58:27Z 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-17T03:52:42Z base: add strict IO functions: readFile', getContents', hGetContents' - - - - - 18a346a4 by Sylvain Henry at 2020-03-17T03:53:24Z Modules: Core (#13009) Update submodule: haddock - - - - - 92327e3a by Ömer Sinan Ağacan at 2020-03-17T03:54:04Z 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-17T11:36:09Z 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-17T11:36:48Z 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-17T11:37:25Z 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-17T11:38:08Z 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-17T11:38:48Z Add example for Data.Semigroup.diff - - - - - 4d85d68b by Paavo at 2020-03-17T11:38:48Z Clean up - - - - - 75168d07 by Paavo at 2020-03-17T11:38:48Z Make example collapsible - - - - - 53ff2cd0 by Richard Eisenberg at 2020-03-17T13:46:57Z 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-18T14:06:43Z Modules: Core operations (#13009) - - - - - 4e8a71c1 by Richard Eisenberg at 2020-03-18T14:07:19Z 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-19T04:39:27Z 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-19T04:40:06Z 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. - - - - - c4024713 by Ben Gamari at 2020-03-20T02:21:59Z Introduce with# - - - - - 30 changed files: - .ghcid - .gitlab-ci.yml - .gitlab/ci.sh - aclocal.m4 - boot - compiler/GHC.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/InfoTable.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Block.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Utils.hs - compiler/nativeGen/AsmCodeGen.hs → compiler/GHC/CmmToAsm.hs - compiler/nativeGen/BlockLayout.hs → compiler/GHC/CmmToAsm/BlockLayout.hs - compiler/nativeGen/CFG.hs → compiler/GHC/CmmToAsm/CFG.hs - compiler/utils/Dominators.hs → compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/nativeGen/CPrim.hs → compiler/GHC/CmmToAsm/CPrim.hs - + compiler/GHC/CmmToAsm/Config.hs - compiler/nativeGen/Dwarf.hs → compiler/GHC/CmmToAsm/Dwarf.hs - compiler/nativeGen/Dwarf/Constants.hs → compiler/GHC/CmmToAsm/Dwarf/Constants.hs - compiler/nativeGen/Dwarf/Types.hs → compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/nativeGen/Format.hs → compiler/GHC/CmmToAsm/Format.hs - compiler/nativeGen/Instruction.hs → compiler/GHC/CmmToAsm/Instr.hs - compiler/nativeGen/NCGMonad.hs → compiler/GHC/CmmToAsm/Monad.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/664cd0e51be35f9c012bc7ca114a5a0409c76877...c402471377ac14014a46c6029d31d4d8d3571d21 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/664cd0e51be35f9c012bc7ca114a5a0409c76877...c402471377ac14014a46c6029d31d4d8d3571d21 You're receiving 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 Mar 20 19:20:26 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 20 Mar 2020 15:20:26 -0400 Subject: [Git][ghc/ghc][ghc-8.10] 13 commits: gitlab-ci: Backport CI rework from master Message-ID: <5e75177a7c4ec_488a827fd64238298a@gitlab.haskell.org.mail> Ben Gamari pushed to branch ghc-8.10 at Glasgow Haskell Compiler / GHC Commits: de890c82 by Ben Gamari at 2020-03-18T13:53:53Z gitlab-ci: Backport CI rework from master - - - - - 671ac3f6 by Ben Gamari at 2020-03-18T15:57:52Z users-guide: Fix :default: fields - - - - - 00d25137 by Ben Gamari at 2020-03-18T17:42:15Z release notes: Fix undefined references - - - - - a5caf1a2 by Ben Gamari at 2020-03-18T17:43:11Z 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). (cherry picked from commit e43e6ece1418f84e50d572772394ab639a083e79) - - - - - 5295fd5a by Ben Gamari at 2020-03-18T17:46:52Z users-guide: Fix unknown link targets - - - - - 544e24e1 by Ben Gamari at 2020-03-18T19:35:34Z docs/compare-flags: Don't use python f-strings - - - - - 24966161 by Ben Gamari at 2020-03-18T19:35:38Z compare-flags: Don't rely on encoding flag of subprocess.check_output Apparently it isn't supported by some slightly older Python versions. - - - - - 0fd7e009 by Ben Gamari at 2020-03-18T19:35:42Z compare-flags: Fix output - - - - - cd4990ca by Ben Gamari at 2020-03-18T22:15:45Z Drop compare-flags - - - - - 06ee06fb by Ben Gamari at 2020-03-19T01:32:17Z Add test-metrics.sh from master - - - - - b9fb1ac4 by Ben Gamari at 2020-03-19T13:36:05Z Backport get-win32-tarballs configure changes - - - - - 8eb82c89 by Ben Gamari at 2020-03-20T03:45:02Z Bump process submodule - - - - - 06889a6f by Ben Gamari at 2020-03-20T03:45:28Z gitlab-ci: Allow armv7 to fail - - - - - 23 changed files: - .gitlab-ci.yml - + .gitlab/ci.sh - − .gitlab/prepare-system.sh - + .gitlab/test-metrics.sh - − .gitlab/win32-init.sh - configure.ac - docs/users_guide/8.10.1-notes.rst - − docs/users_guide/compare-flags.py - docs/users_guide/runtime_control.rst - docs/users_guide/using-warnings.rst - hadrian/src/Rules/Documentation.hs - includes/rts/EventLogWriter.h - libraries/process - + mk/get-win32-tarballs.py - − mk/get-win32-tarballs.sh - rts/Trace.c - rts/eventlog/EventLog.c - rts/eventlog/EventLog.h - rts/eventlog/EventLogWriter.c - + testsuite/tests/rts/InitEventLogging.hs - + testsuite/tests/rts/InitEventLogging.stdout - + testsuite/tests/rts/InitEventLogging_c.c - testsuite/tests/rts/all.T Changes: ===================================== .gitlab-ci.yml ===================================== @@ -5,17 +5,16 @@ variables: DOCKER_REV: 408eff66aef6ca2b44446c694c5a56d6ca0460cc # Sequential version number capturing the versions of all tools fetched by - # .gitlab/win32-init.sh. + # .gitlab/ci.sh. WINDOWS_TOOLCHAIN_VERSION: 1 # Disable shallow clones; they break our linting rules GIT_DEPTH: 0 -before_script: - - git submodule sync --recursive - - git submodule update --init --recursive - - git checkout .gitmodules - - "git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/perf || true" + # Overridden by individual jobs + CONFIGURE_ARGS: "" + + GIT_SUBMODULE_STRATEGY: "recursive" stages: - lint # Source linting @@ -36,7 +35,18 @@ stages: - tags - web +.nightly: &nightly + only: + variables: + - $NIGHTLY + artifacts: + when: always + expire_in: 8 weeks + .release: &release + variables: + BUILD_FLAVOUR: "perf" + FLAVOUR: "perf" artifacts: when: always expire_in: 1 year @@ -125,8 +135,7 @@ typecheck-testsuite: - base="$(git merge-base FETCH_HEAD $CI_COMMIT_SHA)" - "echo Linting submodule changes between $base..$CI_COMMIT_SHA" - git submodule foreach git remote update - # TODO: Fix submodule linter - - submodchecker . $(git rev-list $base..$CI_COMMIT_SHA) || true + - submodchecker . $(git rev-list $base..$CI_COMMIT_SHA) dependencies: [] tags: - lint @@ -170,11 +179,7 @@ lint-submods-branch: tags: - lint script: - - | - grep TBA libraries/*/changelog.md && ( - echo "Error: Found \"TBA\"s in changelogs." - exit 1 - ) || exit 0 + - bash .gitlab/linters/check-changelogs.sh lint-changelogs: extends: .lint-changelogs @@ -200,25 +205,10 @@ lint-release-changelogs: variables: FLAVOUR: "validate" script: - - cabal update - - git clean -xdf && git submodule foreach git clean -xdf - - .gitlab/prepare-system.sh - - if [[ -d ./cabal-cache ]]; then cp -R ./.cabal-cache ~/.cabal-cache; fi - - ./boot - - ./configure $CONFIGURE_ARGS - - hadrian/build.cabal.sh --flavour=$FLAVOUR -j`mk/detect-cpu-count.sh` --docs=no-sphinx binary-dist - - mv _build/bindist/ghc*.tar.xz ghc.tar.xz - - export TOP=$(pwd) - - cd _build/bindist/ghc-*/ && ./configure --prefix=$TOP/_build/install && make install && cd ../../../ - - | - # Prepare to push git notes. - export METRICS_FILE=$CI_PROJECT_DIR/performance-metrics.tsv - git config user.email "ben+ghc-ci at smart-cactus.org" - git config user.name "GHC GitLab CI" - - hadrian/build.cabal.sh --flavour=$FLAVOUR -j`mk/detect-cpu-count.sh` --docs=no-sphinx test --summary-junit=./junit.xml --test-compiler=$TOP/_build/install/bin/ghc || (.gitlab/push-test-metrics.sh && false) - - | - # Push git notes. - .gitlab/push-test-metrics.sh + - .gitlab/ci.sh setup + - .gitlab/ci.sh configure + - .gitlab/ci.sh build_hadrian + - .gitlab/ci.sh test_hadrian cache: key: hadrian paths: @@ -243,6 +233,8 @@ lint-release-changelogs: - git submodule update --init --recursive - git checkout .gitmodules - "git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/perf || true" + after_script: + - .gitlab/ci.sh clean tags: - x86_64-linux @@ -275,7 +267,7 @@ hadrian-ghc-in-ghci: - cabal update - cd hadrian; cabal new-build --project-file=ci.project; cd .. - git clean -xdf && git submodule foreach git clean -xdf - - .gitlab/prepare-system.sh + - .gitlab/ci.sh setup - if [[ -d ./cabal-cache ]]; then cp -R ./.cabal-cache ~/.cabal-cache; fi - ./boot - ./configure $CONFIGURE_ARGS @@ -294,27 +286,12 @@ hadrian-ghc-in-ghci: <<: *only-default variables: TEST_TYPE: test - before_script: - - git clean -xdf && git submodule foreach git clean -xdf + MAKE_ARGS: "-Werror" script: - - ./boot - - ./configure $CONFIGURE_ARGS - - | - THREADS=`mk/detect-cpu-count.sh` - make V=0 -j$THREADS WERROR=-Werror - - make binary-dist-prep TAR_COMP_OPTS="-1" - - make test_bindist TEST_PREP=YES - - | - # Prepare to push git notes. - METRICS_FILE=$CI_PROJECT_DIR/performance-metrics.tsv - git config user.email "ben+ghc-ci at smart-cactus.org" - git config user.name "GHC GitLab CI" - - | - THREADS=`mk/detect-cpu-count.sh` - make $TEST_TYPE THREADS=$THREADS JUNIT_FILE=../../junit.xml METRICS_FILE=$METRICS_FILE || (METRICS_FILE=$METRICS_FILE .gitlab/push-test-metrics.sh && false) - - | - # Push git notes. - METRICS_FILE=$METRICS_FILE .gitlab/push-test-metrics.sh + - .gitlab/ci.sh setup + - .gitlab/ci.sh configure + - .gitlab/ci.sh build_make + - .gitlab/ci.sh test_make dependencies: [] artifacts: reports: @@ -325,6 +302,79 @@ hadrian-ghc-in-ghci: - junit.xml - performance-metrics.tsv +################################# +# x86_64-freebsd +################################# + +.build-x86_64-freebsd: + extends: .validate + tags: + - x86_64-freebsd + allow_failure: true + variables: + # N.B. we use iconv from ports as I see linker errors when we attempt + # to use the "native" iconv embedded in libc as suggested by the + # porting guide [1]. + # [1] https://www.freebsd.org/doc/en/books/porters-handbook/using-iconv.html) + CONFIGURE_ARGS: "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib" + GHC_VERSION: 8.6.3 + CABAL_INSTALL_VERSION: 3.0.0.0 + BIN_DIST_PREP_TAR_COMP: "ghc-x86_64-portbld-freebsd.tar.xz" + TEST_ENV: "x86_64-freebsd" + BUILD_FLAVOUR: "validate" + after_script: + - cp -Rf $HOME/.cabal cabal-cache + - .gitlab/ci.sh clean + artifacts: + when: always + expire_in: 2 week + cache: + key: "freebsd-$GHC_VERSION" + paths: + - cabal-cache + - toolchain + +# Disabled due to lack of builder capacity +.validate-x86_64-freebsd: + extends: .build-x86_64-freebsd + stage: full-build + +nightly-x86_64-freebsd: + <<: *nightly + extends: .build-x86_64-freebsd + stage: full-build + +.build-x86_64-freebsd-hadrian: + extends: .validate-hadrian + stage: full-build + tags: + - x86_64-freebsd + allow_failure: true + variables: + CONFIGURE_ARGS: "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib" + HADRIAN_ARGS: "--docs=no-sphinx" + GHC_VERSION: 8.6.3 + CABAL_INSTALL_VERSION: 3.0.0.0 + BIN_DIST_PREP_TAR_COMP: "ghc-x86_64-portbld-freebsd.tar.xz" + TEST_ENV: "x86_64-freebsd-hadrian" + FLAVOUR: "validate" + after_script: + - cp -Rf $HOME/.cabal cabal-cache + - .gitlab/ci.sh clean + artifacts: + when: always + expire_in: 2 week + cache: + key: "freebsd-$GHC_VERSION" + paths: + - cabal-cache + - toolchain + +# Disabled due to lack of builder capacity +.validate-x86_64-freebsd-hadrian: + extends: .build-x86_64-freebsd-hadrian + stage: full-build + ################################# # x86_64-darwin ################################# @@ -335,28 +385,19 @@ validate-x86_64-darwin: tags: - x86_64-darwin variables: - GHC_VERSION: 8.8.3 - CABAL_INSTALL_VERSION: 2.4.1.0 + GHC_VERSION: 8.6.5 + CABAL_INSTALL_VERSION: 3.0.0.0 BIN_DIST_PREP_TAR_COMP: "ghc-x86_64-apple-darwin.tar.xz" MACOSX_DEPLOYMENT_TARGET: "10.7" # Only Sierra and onwards supports clock_gettime. See #12858 ac_cv_func_clock_gettime: "no" - # Only Mojave and onwards supports utimensat. See #17895 - ac_cv_func_utimensat: "no" LANG: "en_US.UTF-8" - CONFIGURE_ARGS: --with-intree-gmp + CONFIGURE_ARGS: "--with-intree-gmp" TEST_ENV: "x86_64-darwin" - before_script: - - git clean -xdf && git submodule foreach git clean -xdf - - git submodule sync --recursive - - git submodule update --init --recursive - - git checkout .gitmodules - - "git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/perf || true" - - - bash .gitlab/darwin-init.sh - - PATH="`pwd`/toolchain/bin:$PATH" + BUILD_FLAVOUR: "perf" after_script: - cp -Rf $HOME/.cabal cabal-cache + - .gitlab/ci.sh clean artifacts: when: always expire_in: 2 week @@ -373,33 +414,21 @@ validate-x86_64-darwin: tags: - x86_64-darwin variables: - GHC_VERSION: 8.8.3 + GHC_VERSION: 8.6.3 MACOSX_DEPLOYMENT_TARGET: "10.7" ac_cv_func_clock_gettime: "no" LANG: "en_US.UTF-8" CONFIGURE_ARGS: --with-intree-gmp TEST_ENV: "x86_64-darwin-hadrian" FLAVOUR: "validate" - before_script: - - git clean -xdf && git submodule foreach git clean -xdf - - git submodule sync --recursive - - git submodule update --init --recursive - - git checkout .gitmodules - - "git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/perf || true" - - - bash .gitlab/darwin-init.sh - - PATH="`pwd`/toolchain/bin:$PATH" script: - - cabal update - - ./boot - - ./configure $CONFIGURE_ARGS - - hadrian/build.cabal.sh --flavour=$FLAVOUR -j`mk/detect-cpu-count.sh` --docs=no-sphinx binary-dist - - mv _build/bindist/ghc*.tar.xz ghc.tar.xz - - export TOP=$(pwd) - - cd _build/bindist/ghc-*/ && ./configure --prefix=$TOP/_build/install && make install && cd ../../../ - - hadrian/build.cabal.sh --flavour=$FLAVOUR -j`mk/detect-cpu-count.sh` --docs=no-sphinx test --summary-junit=./junit.xml --test-compiler=$TOP/_build/install/bin/ghc + - .gitlab/ci.sh setup + - .gitlab/ci.sh configure + - .gitlab/ci.sh build_hadrian + - .gitlab/ci.sh test_hadrian after_script: - cp -Rf $HOME/.cabal cabal-cache + - .gitlab/ci.sh clean artifacts: when: always expire_in: 2 week @@ -413,19 +442,15 @@ validate-x86_64-darwin: extends: .validate tags: - x86_64-linux + variables: + BUILD_FLAVOUR: "perf" before_script: - - git clean -xdf && git submodule foreach git clean -xdf - - git submodule sync --recursive - - git submodule update --init --recursive - - git checkout .gitmodules - - "git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/perf || true" # Build hyperlinked sources for documentation when building releases - | if [[ -n "$CI_COMMIT_TAG" ]]; then - echo "EXTRA_HADDOCK_OPTS += --hyperlinked-source --quickjump" >> mk/build.mk + HADDOCK_HYPERLINKED_SOURCES=1 fi - - .gitlab/prepare-system.sh # workaround for docker permissions - sudo chown ghc:ghc -R . after_script: @@ -460,14 +485,10 @@ validate-aarch64-linux-deb9: expire_in: 2 week nightly-aarch64-linux-deb9: + <<: *nightly extends: .build-aarch64-linux-deb9 - artifacts: - expire_in: 2 year variables: TEST_TYPE: slowtest - only: - variables: - - $NIGHTLY ################################# # armv7-linux-deb9 @@ -477,7 +498,6 @@ nightly-aarch64-linux-deb9: extends: .validate-linux stage: full-build image: "registry.gitlab.haskell.org/ghc/ci-images/armv7-linux-deb9:$DOCKER_REV" - allow_failure: true variables: TEST_ENV: "armv7-linux-deb9" BIN_DIST_PREP_TAR_COMP: "ghc-armv7-linux-deb9.tar.xz" @@ -489,19 +509,16 @@ nightly-aarch64-linux-deb9: validate-armv7-linux-deb9: extends: .build-armv7-linux-deb9 + allow_failure: true artifacts: when: always expire_in: 2 week nightly-armv7-linux-deb9: + <<: *nightly extends: .build-armv7-linux-deb9 - artifacts: - expire_in: 2 year variables: TEST_TYPE: slowtest - only: - variables: - - $NIGHTLY ################################# # i386-linux-deb9 @@ -524,15 +541,10 @@ validate-i386-linux-deb9: expire_in: 2 week nightly-i386-linux-deb9: + <<: *nightly extends: .build-i386-linux-deb9 variables: TEST_TYPE: slowtest - artifacts: - when: always - expire_in: 2 week - only: - variables: - - $NIGHTLY ################################# # x86_64-linux-deb9 @@ -561,20 +573,16 @@ release-x86_64-linux-deb9: stage: full-build nightly-x86_64-linux-deb9: + <<: *nightly extends: .build-x86_64-linux-deb9 stage: full-build - artifacts: - expire_in: 2 year variables: TEST_TYPE: slowtest - only: - variables: - - $NIGHTLY # N.B. Has DEBUG assertions enabled in stage2 validate-x86_64-linux-deb9-debug: extends: .build-x86_64-linux-deb9 - stage: build + stage: full-build variables: BUILD_FLAVOUR: validate # Ensure that stage2 also has DEBUG enabled @@ -583,7 +591,7 @@ validate-x86_64-linux-deb9-debug: BUILD_SPHINX_PDF: "YES" TEST_TYPE: slowtest TEST_ENV: "x86_64-linux-deb9-debug" - BIN_DIST_PREP_COMP: "ghc-x86_64-deb9-linux-debug.tar.xz" + BIN_DIST_PREP_TAR_COMP: "ghc-x86_64-deb9-linux-debug.tar.xz" artifacts: when: always expire_in: 2 week @@ -597,39 +605,34 @@ validate-x86_64-linux-deb9-debug: TEST_ENV: "x86_64-linux-deb9-llvm" nightly-x86_64-linux-deb9-llvm: + <<: *nightly extends: .build-x86_64-linux-deb9 stage: full-build variables: BUILD_FLAVOUR: perf-llvm TEST_ENV: "x86_64-linux-deb9-llvm" - only: - variables: - - $NIGHTLY validate-x86_64-linux-deb9-integer-simple: extends: .build-x86_64-linux-deb9 stage: full-build variables: + BUILD_FLAVOUR: validate INTEGER_LIBRARY: integer-simple - TEST_ENV: "x86_64-linux-deb9-integer-simple" + TEST_ENV: "x86_64-linux-deb9-integer-simple-validate" BIN_DIST_PREP_TAR_COMP: "ghc-x86_64-deb9-linux-integer-simple.tar.xz" nightly-x86_64-linux-deb9-integer-simple: + <<: *nightly extends: .build-x86_64-linux-deb9 stage: full-build variables: INTEGER_LIBRARY: integer-simple TEST_ENV: "x86_64-linux-deb9-integer-simple" TEST_TYPE: slowtest - artifacts: - expire_in: 2 year - only: - variables: - - $NIGHTLY validate-x86_64-linux-deb9-dwarf: extends: .build-x86_64-linux-deb9 - stage: build + stage: full-build variables: CONFIGURE_ARGS: "--enable-dwarf-unwind" BUILD_FLAVOUR: dwarf @@ -656,14 +659,10 @@ validate-x86_64-linux-deb9-dwarf: stage: full-build nightly-x86_64-linux-deb10: + <<: *nightly extends: .build-x86_64-linux-deb10 - artifacts: - expire_in: 2 weeks variables: TEST_TYPE: slowtest - only: - variables: - - $NIGHTLY release-x86_64-linux-deb10: <<: *release @@ -698,19 +697,21 @@ release-x86_64-linux-deb8: # x86_64-linux-alpine ################################# -.build-x86_64-linux-alpine: - extends: .validate-linux +.build-x86_64-linux-alpine-hadrian: + extends: .validate-linux-hadrian stage: full-build image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine:$DOCKER_REV" # There are currently a few failing tests allow_failure: true variables: - BUILD_SPHINX_PDF: "NO" TEST_ENV: "x86_64-linux-alpine" BIN_DIST_PREP_TAR_COMP: "ghc-x86_64-alpine-linux.tar.xz" # Can't use ld.gold due to #13958. CONFIGURE_ARGS: "--disable-ld-override" - INTEGER_LIBRARY: "integer-simple" + HADRIAN_ARGS: "--docs=no-sphinx" + # encoding004 due to lack of locale support + # T10458 due to fact that dynamic linker tries to reload libAS + BROKEN_TESTS: "encoding004 T10458" cache: key: linux-x86_64-alpine artifacts: @@ -719,13 +720,11 @@ release-x86_64-linux-deb8: release-x86_64-linux-alpine: <<: *release - extends: .build-x86_64-linux-alpine + extends: .build-x86_64-linux-alpine-hadrian nightly-x86_64-linux-alpine: - extends: .build-x86_64-linux-alpine - only: - variables: - - $NIGHTLY + <<: *nightly + extends: .build-x86_64-linux-alpine-hadrian ################################# # x86_64-linux-centos7 @@ -775,58 +774,49 @@ validate-x86_64-linux-fedora27: .build-windows: <<: *only-default + # For the reasons given in #17777 this build isn't reliable. + allow_failure: true before_script: - git clean -xdf - - git submodule foreach git clean -xdf - - # Use a local temporary directory to ensure that concurrent builds don't - # interfere with one another - - | - mkdir tmp - set TMP=%cd%\tmp - set TEMP=%cd%\tmp - - set PATH=C:\msys64\usr\bin;%PATH% - - git submodule sync --recursive - - git submodule update --init --recursive - - git checkout .gitmodules - - "git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/perf || true" - - bash .gitlab/win32-init.sh + # Setup toolchain + - bash .gitlab/ci.sh setup after_script: - - rd /s /q tmp - - robocopy /np /nfl /ndl /e "%APPDATA%\cabal" cabal-cache - - bash -c 'make clean || true' + - | + Copy-Item -Recurse -Path $Env:APPDATA\cabal -Destination cabal-cache + - bash .gitlab/ci.sh clean dependencies: [] variables: - FORCE_SYMLINKS: 1 + #FORCE_SYMLINKS: 1 LANG: "en_US.UTF-8" SPHINXBUILD: "/mingw64/bin/sphinx-build.exe" + CABAL_INSTALL_VERSION: 3.0.0.0 + GHC_VERSION: "8.8.3" cache: paths: - cabal-cache - - ghc-8.6.5 + - toolchain - ghc-tarballs .build-windows-hadrian: extends: .build-windows stage: full-build variables: - GHC_VERSION: "8.8.3" FLAVOUR: "validate" + # skipping perf tests for now since we build a quick-flavoured GHC, + # which might result in some broken perf tests? + HADRIAN_ARGS: "--docs=no-sphinx --skip-perf" + # due to #16574 this currently fails allow_failure: true + script: - - | - python boot - bash -c './configure --enable-tarballs-autodownload GHC=`pwd`/toolchain/bin/ghc HAPPY=`pwd`/toolchain/bin/happy ALEX=`pwd`/toolchain/bin/alex' - - bash -c "PATH=`pwd`/toolchain/bin:$PATH hadrian/build.cabal.sh --flavour=$FLAVOUR -j`mk/detect-cpu-count.sh` --flavour=Quick --docs=no-sphinx binary-dist" - - mv _build/bindist/ghc*.tar.xz ghc.tar.xz - - bash -c "export TOP=$(pwd); cd _build/bindist/ghc-*/ && PATH=$TOP/toolchain/bin:$PATH ./configure --prefix=$TOP/_build/install && make install && cd ../../../" - - bash -c "export TOP=$(pwd); PATH=$TOP/toolchain/bin:$PATH hadrian/build.cabal.sh --flavour=$FLAVOUR -j`mk/detect-cpu-count.sh` --flavour=quick test --summary-junit=./junit.xml --skip-perf --test-compiler=$TOP/_build/install/bin/ghc" - # skipping perf tests for now since we build a quick-flavoured GHC, - # which might result in some broken perf tests? + - bash .gitlab/ci.sh configure + - bash .gitlab/ci.sh build_hadrian + - bash .gitlab/ci.sh test_hadrian tags: - - x86_64-windows + - new-x86_64-windows + - test artifacts: reports: junit: junit.xml @@ -845,34 +835,27 @@ validate-x86_64-windows-hadrian: key: "x86_64-windows-hadrian-$WINDOWS_TOOLCHAIN_VERSION" nightly-i386-windows-hadrian: + <<: *nightly extends: .build-windows-hadrian variables: MSYSTEM: MINGW32 TEST_ENV: "i386-windows-hadrian" - only: - variables: - - $NIGHTLY cache: key: "i386-windows-hadrian-$WINDOWS_TOOLCHAIN_VERSION" .build-windows-make: extends: .build-windows stage: full-build - allow_failure: true variables: BUILD_FLAVOUR: "quick" - GHC_VERSION: "8.8.3" BIN_DIST_PREP_TAR_COMP: "ghc-x86_64-mingw32.tar.xz" script: - - | - python boot - bash -c './configure --enable-tarballs-autodownload GHC=`pwd`/toolchain/bin/ghc HAPPY=`pwd`/toolchain/bin/happy ALEX=`pwd`/toolchain/bin/alex $CONFIGURE_ARGS' - - bash -c "PATH=`pwd`/toolchain/bin:$PATH make -j`mk/detect-cpu-count.sh`" - - bash -c "PATH=`pwd`/toolchain/bin:$PATH make binary-dist-prep TAR_COMP_OPTS=-1" - - bash -c "PATH=`pwd`/toolchain/bin:$PATH make test_bindist TEST_PREP=YES" - - bash -c 'make V=0 test PYTHON=/mingw64/bin/python3 THREADS=`mk/detect-cpu-count.sh` JUNIT_FILE=../../junit.xml' + - bash .gitlab/ci.sh configure + - bash .gitlab/ci.sh build_make + - bash .gitlab/ci.sh test_make tags: - - x86_64-windows + - new-x86_64-windows + - test artifacts: when: always expire_in: 2 week @@ -880,77 +863,69 @@ nightly-i386-windows-hadrian: junit: junit.xml paths: # N.B. variable interpolation apparently doesn't work on Windows so - # this can't be $BIN_DIST_TAR_COMP + # this can't be $BIN_DIST_PREP_TAR_COMP - "ghc-x86_64-mingw32.tar.xz" - junit.xml -validate-x86_64-windows: +.build-x86_64-windows-make: extends: .build-windows-make variables: MSYSTEM: MINGW64 - CONFIGURE_ARGS: "--target=x86_64-unknown-mingw32" TEST_ENV: "x86_64-windows" cache: key: "x86_64-windows-$WINDOWS_TOOLCHAIN_VERSION" +validate-x86_64-windows: + extends: .build-x86_64-windows-make + nightly-x86_64-windows: - extends: .build-windows-make + <<: *nightly + extends: .build-x86_64-windows-make stage: full-build variables: BUILD_FLAVOUR: "validate" - MSYSTEM: MINGW64 - CONFIGURE_ARGS: "--target=x86_64-unknown-mingw32" - only: - variables: - - $NIGHTLY - cache: - key: "x86_64-windows-$WINDOWS_TOOLCHAIN_VERSION" # Normal Windows validate builds are profiled; that won't do for releases. release-x86_64-windows: <<: *release extends: validate-x86_64-windows variables: - MSYSTEM: MINGW64 BUILD_FLAVOUR: "perf" - CONFIGURE_ARGS: "--target=x86_64-unknown-mingw32" - TEST_ENV: "x86_64-windows" - + # release-x86_64-windows-integer-simple: <<: *release extends: validate-x86_64-windows variables: INTEGER_LIBRARY: integer-simple BUILD_FLAVOUR: "perf" - CONFIGURE_ARGS: "--target=x86_64-unknown-mingw32" - TEST_ENV: "x86_64-windows" -release-i386-windows: - <<: *release + +.build-i386-windows-make: extends: .build-windows-make variables: MSYSTEM: MINGW32 - BUILD_FLAVOUR: "perf" - CONFIGURE_ARGS: "--target=i386-unknown-mingw32" # Due to #15934 BUILD_PROF_LIBS: "NO" TEST_ENV: "i386-windows" + # Due to #17736 + allow_failure: true cache: key: "i386-windows-$WINDOWS_TOOLCHAIN_VERSION" -nightly-i386-windows: - extends: .build-windows-make - only: - variables: - - $NIGHTLY +validate-i386-windows: + extends: .build-i386-windows-make variables: - MSYSTEM: MINGW32 - CONFIGURE_ARGS: "--target=i386-unknown-mingw32" - # Due to #15934 - BUILD_PROF_LIBS: "NO" - TEST_ENV: "i386-windows" - cache: - key: "i386-windows-$WINDOWS_TOOLCHAIN_VERSION" + BUILD_FLAVOUR: "perf" + +release-i386-windows: + <<: *release + extends: .build-i386-windows-make + variables: + BUILD_FLAVOUR: "perf" + +nightly-i386-windows: + <<: *nightly + extends: .build-i386-windows-make ############################################################ # Cleanup @@ -1006,7 +981,7 @@ doc-tarball: - validate-x86_64-linux-deb9-debug - validate-x86_64-windows variables: - LINUX_BINDIST: "ghc-x86_64-deb9-linux.tar.xz" + LINUX_BINDIST: "ghc-x86_64-deb9-linux-debug.tar.xz" WINDOWS_BINDIST: "ghc-x86_64-mingw32.tar.xz" # Due to Windows allow_failure allow_failure: true @@ -1046,7 +1021,7 @@ source-tarball: - ghc-*.tar.xz - version script: - - mk/get-win32-tarballs.sh download all + - python3 mk/get-win32-tarballs.py download all - ./boot - ./configure - make sdist @@ -1089,10 +1064,8 @@ hackage-label: - $CI_MERGE_REQUEST_LABELS =~ /.*user-facing.*/ nightly-hackage: + <<: *nightly extends: .hackage - only: - variables: - - $NIGHTLY ############################################################ # Nofib testing ===================================== .gitlab/ci.sh ===================================== @@ -0,0 +1,453 @@ +#!/usr/bin/env bash +# shellcheck disable=SC2230 + +# This is the primary driver of the GitLab CI infrastructure. + +set -e -o pipefail + +# Configuration: +hackage_index_state="@1579718451" + +# Colors +BLACK="0;30" +GRAY="1;30" +RED="0;31" +LT_RED="1;31" +BROWN="0;33" +LT_BROWN="1;33" +GREEN="0;32" +LT_GREEN="1;32" +BLUE="0;34" +LT_BLUE="1;34" +PURPLE="0;35" +LT_PURPLE="1;35" +CYAN="0;36" +LT_CYAN="1;36" +WHITE="1;37" +LT_GRAY="0;37" + +# GitLab Pipelines log section delimiters +# https://gitlab.com/gitlab-org/gitlab-foss/issues/14664 +start_section() { + name="$1" + echo -e "section_start:$(date +%s):$name\015\033[0K" +} + +end_section() { + name="$1" + echo -e "section_end:$(date +%s):$name\015\033[0K" +} + +echo_color() { + local color="$1" + local msg="$2" + echo -e "\033[${color}m${msg}\033[0m" +} + +error() { echo_color "${RED}" "$1"; } +warn() { echo_color "${LT_BROWN}" "$1"; } +info() { echo_color "${LT_BLUE}" "$1"; } + +fail() { error "error: $1"; exit 1; } + +function run() { + info "Running $*..." + "$@" || ( error "$* failed"; return 1; ) +} + +TOP="$(pwd)" + +function mingw_init() { + case "$MSYSTEM" in + MINGW32) + triple="i386-unknown-mingw32" + boot_triple="i386-unknown-mingw32" # triple of bootstrap GHC + ;; + MINGW64) + triple="x86_64-unknown-mingw32" + boot_triple="x86_64-unknown-mingw32" # triple of bootstrap GHC + ;; + *) + fail "win32-init: Unknown MSYSTEM $MSYSTEM" + ;; + esac + + # Bring mingw toolchain into PATH. + # This is extracted from /etc/profile since this script inexplicably fails to + # run under gitlab-runner. + # shellcheck disable=SC1091 + source /etc/msystem + MINGW_MOUNT_POINT="${MINGW_PREFIX}" + PATH="$MINGW_MOUNT_POINT/bin:$PATH" + + # We always use mingw64 Python to avoid path length issues like #17483. + export PYTHON="/mingw64/bin/python3" +} + +# This will contain GHC's local native toolchain +toolchain="$TOP/toolchain" +mkdir -p "$toolchain/bin" +PATH="$toolchain/bin:$PATH" + +export METRICS_FILE="$CI_PROJECT_DIR/performance-metrics.tsv" + +cores="$(mk/detect-cpu-count.sh)" + +# Use a local temporary directory to ensure that concurrent builds don't +# interfere with one another +mkdir -p "$TOP/tmp" +export TMP="$TOP/tmp" +export TEMP="$TOP/tmp" + +function darwin_setup() { + # It looks like we already have python2 here and just installing python3 + # does not work. + brew upgrade python + brew install ghc cabal-install ncurses gmp + + pip3 install sphinx + # PDF documentation disabled as MacTeX apparently doesn't include xelatex. + #brew cask install mactex +} + +function show_tool() { + local tool="$1" + info "$tool = ${!tool}" + ${!tool} --version +} + +function set_toolchain_paths() { + needs_toolchain=1 + case "$(uname)" in + Linux) needs_toolchain="" ;; + *) ;; + esac + + if [[ -n "$needs_toolchain" ]]; then + # These are populated by setup_toolchain + GHC="$toolchain/bin/ghc$exe" + CABAL="$toolchain/bin/cabal$exe" + HAPPY="$toolchain/bin/happy$exe" + ALEX="$toolchain/bin/alex$exe" + else + GHC="$(which ghc)" + CABAL="/usr/local/bin/cabal" + HAPPY="$HOME/.cabal/bin/happy" + ALEX="$HOME/.cabal/bin/alex" + fi + export GHC + export CABAL + export HAPPY + export ALEX + + # FIXME: Temporarily use ghc from ports + case "$(uname)" in + FreeBSD) GHC="/usr/local/bin/ghc" ;; + *) ;; + esac +} + +# Extract GHC toolchain +function setup() { + if [ -d "$TOP/cabal-cache" ]; then + info "Extracting cabal cache..." + mkdir -p "$cabal_dir" + cp -Rf cabal-cache/* "$cabal_dir" + fi + + if [[ -n "$needs_toolchain" ]]; then + setup_toolchain + fi + case "$(uname)" in + Darwin) darwin_setup ;; + *) ;; + esac + + # Make sure that git works + git config user.email "ghc-ci at gitlab-haskell.org" + git config user.name "GHC GitLab CI" + + info "=====================================================" + info "Toolchain versions" + info "=====================================================" + show_tool GHC + show_tool CABAL + show_tool HAPPY + show_tool ALEX +} + +function fetch_ghc() { + local v="$GHC_VERSION" + if [[ -z "$v" ]]; then + fail "GHC_VERSION is not set" + fi + + if [ ! -e "$GHC" ]; then + start_section "fetch GHC" + url="https://downloads.haskell.org/~ghc/${GHC_VERSION}/ghc-${GHC_VERSION}-${boot_triple}.tar.xz" + info "Fetching GHC binary distribution from $url..." + curl "$url" > ghc.tar.xz || fail "failed to fetch GHC binary distribution" + tar -xJf ghc.tar.xz || fail "failed to extract GHC binary distribution" + case "$(uname)" in + MSYS_*|MINGW*) + cp -r "ghc-${GHC_VERSION}"/* "$toolchain" + ;; + *) + pushd "ghc-${GHC_VERSION}" + ./configure --prefix="$toolchain" + "$MAKE" install + popd + ;; + esac + rm -Rf "ghc-${GHC_VERSION}" ghc.tar.xz + end_section "fetch GHC" + fi + +} + +function fetch_cabal() { + local v="$CABAL_INSTALL_VERSION" + if [[ -z "$v" ]]; then + fail "CABAL_INSTALL_VERSION is not set" + fi + + if [ ! -e "$CABAL" ]; then + start_section "fetch GHC" + case "$(uname)" in + # N.B. Windows uses zip whereas all others use .tar.xz + MSYS_*|MINGW*) + case "$MSYSTEM" in + MINGW32) cabal_arch="i386" ;; + MINGW64) cabal_arch="x86_64" ;; + *) fail "unknown MSYSTEM $MSYSTEM" ;; + esac + url="https://downloads.haskell.org/~cabal/cabal-install-$v/cabal-install-$v-$cabal_arch-unknown-mingw32.zip" + info "Fetching cabal binary distribution from $url..." + curl "$url" > "$TMP/cabal.zip" + unzip "$TMP/cabal.zip" + mv cabal.exe "$CABAL" + ;; + *) + local base_url="https://downloads.haskell.org/~cabal/cabal-install-$v/" + case "$(uname)" in + Darwin) cabal_url="$base_url/cabal-install-$v-x86_64-apple-darwin17.7.0.tar.xz" ;; + FreeBSD) + #cabal_url="$base_url/cabal-install-$v-x86_64-portbld-freebsd.tar.xz" ;; + cabal_url="http://home.smart-cactus.org/~ben/ghc/cabal-install-3.0.0.0-x86_64-portbld-freebsd.tar.xz" ;; + *) fail "don't know where to fetch cabal-install for $(uname)" + esac + echo "Fetching cabal-install from $cabal_url" + curl "$cabal_url" > cabal.tar.xz + tar -xJf cabal.tar.xz + mv cabal "$toolchain/bin" + ;; + esac + end_section "fetch GHC" + fi +} + +# For non-Docker platforms we prepare the bootstrap toolchain +# here. For Docker platforms this is done in the Docker image +# build. +function setup_toolchain() { + fetch_ghc + fetch_cabal + cabal_install="$CABAL v2-install --index-state=$hackage_index_state --installdir=$toolchain/bin" + # Avoid symlinks on Windows + case "$(uname)" in + MSYS_*|MINGW*) cabal_install="$cabal_install --install-method=copy" ;; + *) ;; + esac + + if [ ! -e "$HAPPY" ]; then + info "Building happy..." + cabal update + $cabal_install happy + fi + + if [ ! -e "$ALEX" ]; then + info "Building alex..." + cabal update + $cabal_install alex + fi +} + +function cleanup_submodules() { + start_section "clean submodules" + info "Cleaning submodules..." + # On Windows submodules can inexplicably get into funky states where git + # believes that the submodule is initialized yet its associated repository + # is not valid. Avoid failing in this case with the following insanity. + git submodule sync --recursive || git submodule deinit --force --all + git submodule update --init --recursive + git submodule foreach git clean -xdf + end_section "clean submodules" +} + +function prepare_build_mk() { + if [[ -z "$BUILD_FLAVOUR" ]]; then fail "BUILD_FLAVOUR is not set"; fi + if [[ -z ${BUILD_SPHINX_HTML:-} ]]; then BUILD_SPHINX_HTML=YES; fi + if [[ -z ${BUILD_SPHINX_PDF:-} ]]; then BUILD_SPHINX_PDF=YES; fi + if [[ -z ${INTEGER_LIBRARY:-} ]]; then INTEGER_LIBRARY=integer-gmp; fi + + cat > mk/build.mk <> mk/build.mk + fi + + case "$(uname)" in + Darwin) echo "libraries/integer-gmp_CONFIGURE_OPTS += --configure-option=--with-intree-gmp" >> mk/build.mk ;; + *) ;; + esac + + info "build.mk is:" + cat mk/build.mk +} + +function configure() { + start_section "booting" + run python3 boot + end_section "booting" + + local target_args="" + if [[ -n "$triple" ]]; then + target_args="--target=$triple" + fi + + start_section "configuring" + run ./configure \ + --enable-tarballs-autodownload \ + $target_args \ + $CONFIGURE_ARGS \ + GHC="$GHC" \ + HAPPY="$HAPPY" \ + ALEX="$ALEX" \ + || ( cat config.log; fail "configure failed" ) + end_section "configuring" +} + +function build_make() { + prepare_build_mk + if [[ -z "$BIN_DIST_PREP_TAR_COMP" ]]; then + fail "BIN_DIST_PREP_TAR_COMP is not set" + fi + + echo "include mk/flavours/${BUILD_FLAVOUR}.mk" > mk/build.mk + echo 'GhcLibHcOpts+=-haddock' >> mk/build.mk + run "$MAKE" -j"$cores" $MAKE_ARGS + run "$MAKE" -j"$cores" binary-dist-prep TAR_COMP_OPTS=-1 + ls -lh "$BIN_DIST_PREP_TAR_COMP" +} + +function fetch_perf_notes() { + info "Fetching perf notes..." + "$TOP/.gitlab/test-metrics.sh" pull +} + +function push_perf_notes() { + info "Pushing perf notes..." + "$TOP/.gitlab/test-metrics.sh" push +} + +function test_make() { + run "$MAKE" test_bindist TEST_PREP=YES + run "$MAKE" V=0 test \ + THREADS="$cores" \ + JUNIT_FILE=../../junit.xml +} + +function build_hadrian() { + if [ -z "$FLAVOUR" ]; then + fail "FLAVOUR not set" + fi + + run_hadrian binary-dist + + mv _build/bindist/ghc*.tar.xz ghc.tar.xz +} + +function test_hadrian() { + cd _build/bindist/ghc-*/ + run ./configure --prefix="$TOP"/_build/install + run "$MAKE" install + cd ../../../ + + run_hadrian \ + test \ + --summary-junit=./junit.xml \ + --test-compiler="$TOP"/_build/install/bin/ghc +} + +function clean() { + rm -R tmp + run "$MAKE" --quiet clean || true + run rm -Rf _build +} + +function run_hadrian() { + run hadrian/build.cabal.sh \ + --flavour="$FLAVOUR" \ + -j"$cores" \ + $HADRIAN_ARGS \ + $@ +} + +# A convenience function to allow debugging in the CI environment. +function shell() { + local cmd=$@ + if [ -z "$cmd" ]; then + cmd="bash -i" + fi + run $cmd +} + +# Determine Cabal data directory +case "$(uname)" in + MSYS_*|MINGW*) exe=".exe"; cabal_dir="$APPDATA/cabal" ;; + *) cabal_dir="$HOME/.cabal"; exe="" ;; +esac + +# Platform-specific environment initialization +MAKE="make" +case "$(uname)" in + MSYS_*|MINGW*) mingw_init ;; + Darwin) boot_triple="x86_64-apple-darwin" ;; + FreeBSD) + boot_triple="x86_64-portbld-freebsd" + MAKE="gmake" + ;; + Linux) ;; + *) fail "uname $(uname) is not supported" ;; +esac + +set_toolchain_paths + +case $1 in + setup) setup && cleanup_submodules ;; + configure) configure ;; + build_make) build_make ;; + test_make) fetch_perf_notes; test_make; push_perf_notes ;; + build_hadrian) build_hadrian ;; + test_hadrian) fetch_perf_notes; test_hadrian; push_perf_notes ;; + run_hadrian) run_hadrian $@ ;; + clean) clean ;; + shell) shell $@ ;; + *) fail "unknown mode $1" ;; +esac ===================================== .gitlab/prepare-system.sh deleted ===================================== @@ -1,99 +0,0 @@ -#!/usr/bin/env bash -# vim: sw=2 et -set -euo pipefail - -fail() { - echo "ERROR: $*" >&2 - exit 1 -} - -hackage_index_state="@1522046735" - -if [[ -z ${BUILD_SPHINX_HTML:-} ]]; then BUILD_SPHINX_HTML=YES; fi -if [[ -z ${BUILD_SPHINX_PDF:-} ]]; then BUILD_SPHINX_PDF=YES; fi -if [[ -z ${INTEGER_LIBRARY:-} ]]; then INTEGER_LIBRARY=integer-gmp; fi -if [[ -z ${BUILD_FLAVOUR:-} ]]; then BUILD_FLAVOUR=perf; fi - -if [[ -z ${XZ:-} ]]; then - if which pxz; then - XZ="pxz" - elif which xz; then - # Check whether --threads is supported - if echo "hello" | xz --threads=$CORES >/dev/null; then - XZ="xz --threads=$CORES" - else - XZ="xz" - fi - else - echo "error: neither pxz nor xz were found" - exit 1 - fi -fi -echo "Using $XZ for compression..." - - -cat > mk/build.mk <> mk/build.mk -BuildFlavour=$BUILD_FLAVOUR -ifneq "\$(BuildFlavour)" "" -include mk/flavours/\$(BuildFlavour).mk -endif -GhcLibHcOpts+=-haddock -EOF - -case "$(uname)" in - Linux) - if [[ -n ${TARGET:-} ]]; then - if [[ $TARGET = FreeBSD ]]; then - # cross-compiling to FreeBSD - echo 'HADDOCK_DOCS = NO' >> mk/build.mk - echo 'WERROR=' >> mk/build.mk - # https://circleci.com/docs/2.0/env-vars/#interpolating-environment-variables-to-set-other-environment-variables - echo 'export PATH=/opt/ghc/bin:$PATH' >> $BASH_ENV - else - fail "TARGET=$target not supported" - fi - fi - ;; - - Darwin) - if [[ -n ${TARGET:-} ]]; then - fail "uname=$(uname) not supported for cross-compilation" - fi - # It looks like we already have python2 here and just installing python3 - # does not work. - brew upgrade python - brew install ghc cabal-install ncurses gmp - - pip3 install sphinx - # PDF documentation disabled as MacTeX apparently doesn't include xelatex. - #brew cask install mactex - - cabal update - cabal install --reinstall alex happy haddock hscolour --index-state=$hackage_index_state - # put them on the $PATH, don't fail if already installed - ln -s $HOME/.cabal/bin/alex /usr/local/bin/alex || true - ln -s $HOME/.cabal/bin/happy /usr/local/bin/happy || true - ln -s $HOME/.cabal/bin/HsColour /usr/local/bin/HsColour || true - echo "libraries/integer-gmp_CONFIGURE_OPTS += --configure-option=--with-intree-gmp" >> mk/build.mk - ;; - *) - fail "uname=$(uname) not supported" -esac - -echo "=================================================" -echo "Build.mk:" -echo "" -cat mk/build.mk -echo "=================================================" ===================================== .gitlab/test-metrics.sh ===================================== @@ -0,0 +1,89 @@ +#!/usr/bin/env bash +# vim: sw=2 et +set -euo pipefail + +NOTES_ORIGIN="https://gitlab.haskell.org/ghc/ghc-performance-notes.git" +NOTES_ORIGIN_PUSH="git at gitlab.haskell.org:ghc/ghc-performance-notes.git" +REF="perf" + +run() { + echo "$@" + $@ +} + +fail() { + echo "ERROR: $*" >&2 + exit 1 +} + +function pull() { + local ref="refs/notes/$REF" + run git fetch -f $NOTES_ORIGIN $ref:$ref + echo "perf notes ref $ref is $(git rev-parse $ref)" +} + +function setup_ssh() { + # Add gitlab as a known host. + mkdir -p ~/.ssh + echo "|1|+AUrMGS1elvPeLNt+NHGa5+c6pU=|4XvfRsQftO1OgZD4c0JJ7oNaii8= ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAACAQDXilA5l4kOZPx0nM6xDATF+t4fS6te0eYPDwBI/jLWD9cJVtCnsrwMl5ar+/NfmcD0jnCYztUiVHuXyTaWPJYSQpwltfpTeqpo9/z/0MxkPtSl1uMP2cLbDiqA01OWveChktOXwU6hRQ+7MmO+dNRS/iXrRmYrGv/p1W811QgLBLS9fefEdF25n+0dP71L7Ov7riOawlDmd0C11FraE/R8HX6gs6lbXta1kisdxGyKojYSiCtobUaJxRoatMfUP0a9rwTAyl8tf56LgB+igjMky879VAbL7eQ/AmfHYPrSGJ/YlWP6Jj23Dnos5nOVlWL/rVTs9Y/NakLpPwMs75KTC0Pd74hdf2e3folDdAi2kLrQgO2SI6so7rOYZ+mFkCM751QdDVy4DzjmDvSgSIVf9SV7RQf7e7unE7pSZ/ILupZqz9KhR1MOwVO+ePa5qJMNSdC204PIsRWkIO5KP0QLl507NI9Ri84+aODoHD7gDIWNhU08J2P8/E6r0wcC8uWaxh+HaOjI9BkHjqRYsrgfn54BAuO9kw1cDvyi3c8n7VFlNtvQP15lANwim3gr9upV+r95KEPJCgZMYWJBDPIVtp4GdYxCfXxWj5oMXbA5pf0tNixwNJjAsY7I6RN2htHbuySH36JybOZk+gCj6mQkxpCT/tKaUn14hBJWLq7Q+Q==" >> ~/.ssh/known_hosts + echo "|1|JZkdAPJmpX6SzGeqhmQLfMWLGQA=|4vTELroOlbFxbCr0WX+PK9EcpD0= ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIJknufU+I6A5Nm58lmse4/o11Ai2UzYbYe7782J1+kRk" >> ~/.ssh/known_hosts + + # Setup ssh keys. + eval `ssh-agent` + echo "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQDJPR1vrZgeGTXmgJw2PsJfMjf22LcDnVVwt3l0rwTZ+8Q2J0bHaYxMRKBco1sON6LGcZepw0Hy76RQ87v057pTz18SXvnfE7U/B6v9qBk0ILJz+4BOX9sEhxu2XmScp/wMxkG9IoyruMlsxXzd1sz09o+rzzx24U2Rp27PRm08vG0oipve6BWLbYEqYrE4/nCufqOJmGd56fju7OTU0lTpEkGDEDWGMxutaX2CbTbDju7qy07Ld8BjSc9aHfvuQaslUbj3ex3EF8EXahURzGpHQn/UFFzVGMokFumiJCAagHQb7cj6jOkKseZLaysbA/mTBQsOzjWiRmkN23bQf1wF ben+ghc-ci at smart-cactus.org" > ~/.ssh/perf_rsa.pub + touch ~/.ssh/perf_rsa + chmod 0600 ~/.ssh/perf_rsa + echo "$PERF_NOTE_KEY" >> ~/.ssh/perf_rsa + ssh-add ~/.ssh/perf_rsa +} + +# Reset the git notes and append the metrics file to the notes, then push and return the result. +# This is favoured over a git notes merge as it avoids potential data loss/duplication from the merge strategy. +function reset_append_note_push { + pull || true + run git notes --ref=$REF append -F $METRICS_FILE HEAD + run git push $NOTES_ORIGIN_PUSH refs/notes/$REF +} + +function push() { + # Check that private key is available (Set on all GitLab protected branches). + if [ -z ${PERF_NOTE_KEY+"$PERF_NOTE_KEY"} ] + then + echo "Not pushing performance git notes: PERF_NOTE_KEY is not set." + exit 0 + fi + + # TEST_ENV must be set. + if [ -z ${TEST_ENV+"$TEST_ENV"} ] + then + fail "Not pushing performance git notes: TEST_ENV must be set." + fi + + # Assert that the METRICS_FILE exists and can be read. + if [ -z ${METRICS_FILE+"$METRICS_FILE"} ] + then + fail "\$METRICS_FILE not set." + fi + if ! [ -r $METRICS_FILE ] + then + fail "Metrics file not found: $METRICS_FILE" + fi + + setup_ssh + + # Push the metrics file as a git note. This may fail if another task pushes a note first. In that case + # the latest note is fetched and appended. + MAX_RETRY=20 + until reset_append_note_push || [ $MAX_RETRY -le 0 ] + do + ((MAX_RETRY--)) + echo "" + echo "Failed to push git notes. Fetching, appending, and retrying... $MAX_RETRY retries left." + done +} + +case $1 in + push) push ;; + pull) pull ;; + *) fail "Invalid mode $1" ;; +esac ===================================== .gitlab/win32-init.sh deleted ===================================== @@ -1,67 +0,0 @@ -#!/bin/bash - -set -e - -toolchain=`pwd`/toolchain -PATH="$toolchain/bin:/mingw64/bin:$PATH" - -if [ -d "`pwd`/cabal-cache" ]; then - cp -Rf cabal-cache $APPDATA/cabal -fi - -if [ ! -e $toolchain/bin/ghc ]; then - case $MSYSTEM in - MINGW32) - triple="i386-unknown-mingw32" - ;; - MINGW64) - triple="x86_64-unknown-mingw32" - ;; - *) - echo "win32-init: Unknown MSYSTEM $MSYSTEM" - exit 1 - ;; - esac - curl https://downloads.haskell.org/~ghc/$GHC_VERSION/ghc-$GHC_VERSION-$triple.tar.xz | tar -xJ - mv ghc-$GHC_VERSION toolchain -fi - -if [ ! -e $toolchain/bin/cabal ]; then - url="https://downloads.haskell.org/~cabal/cabal-install-2.4.1.0/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 - -if [ ! -e $toolchain/bin/happy ]; then - cabal update - cabal install happy - cp $APPDATA/cabal/bin/happy $toolchain/bin -fi - -if [ ! -e $toolchain/bin/alex ]; then - cabal update - cabal install alex - cp $APPDATA/cabal/bin/alex $toolchain/bin -fi - -if [[ -z ${INTEGER_LIBRARY:-} ]]; then INTEGER_LIBRARY=integer-gmp; fi -cat > mk/build.mk < missing-win32-tarballs + $PYTHON mk/get-win32-tarballs.py $action $mingw_arch > missing-win32-tarballs case $? in 0) rm missing-win32-tarballs @@ -359,7 +359,7 @@ set_up_tarballs() { echo echo " * run configure with the --enable-tarballs-autodownload option" echo - echo " * run mk/get-win32-tarballs.sh download ${HostArch}" + echo " * run mk/get-win32-tarballs.py download $mingw_arch" echo echo " * manually download the files listed in ./missing-win32-tarballs and place" echo " them in the ghc-tarballs directory." ===================================== docs/users_guide/8.10.1-notes.rst ===================================== @@ -176,7 +176,7 @@ Language good story for graceful degradation in these situations. These situations should occur much less frequently now and degradation happens much more smoothly, while still producing useful, sound results (see - :ghc-flag:`-fmax-pmcheck-models`). + :ghc-flag:`-fmax-pmcheck-models=⟨n⟩`). Compiler ~~~~~~~~ @@ -230,8 +230,8 @@ Compiler and much more. See the :ref:`user guide ` for more details as well as an example. -- Deprecated flag :ghc-flag:`-fmax-pmcheck-iterations` in favor of - :ghc-flag:`-fmax-pmcheck-models`, which uses a completely different mechanism. +- Deprecated flag ``-fmax-pmcheck-iterations`` in favor of + :ghc-flag:`-fmax-pmcheck-models=⟨n⟩`, which uses a completely different mechanism. - GHC now writes ``.o`` files atomically, resulting in reduced chances of truncated files when a build is cancelled or the computer crashes. ===================================== docs/users_guide/compare-flags.py deleted ===================================== @@ -1,91 +0,0 @@ -#!/usr/bin/env python -# -*- coding: utf-8 -*- - -""" -Linter to verify that all flags reported by GHC's --show-options mode -are documented in the user's guide. -""" - -import sys -import subprocess -from typing import Set -from pathlib import Path - -# A list of known-undocumented flags. This should be considered to be a to-do -# list of flags that need to be documented. -EXPECTED_UNDOCUMENTED_PATH = \ - Path(__file__).parent / 'expected-undocumented-flags.txt' - -EXPECTED_UNDOCUMENTED = \ - {line for line in open(EXPECTED_UNDOCUMENTED_PATH).read().split()} - -def expected_undocumented(flag: str) -> bool: - if flag in EXPECTED_UNDOCUMENTED: - return True - if flag.startswith('-Werror'): - return True - if flag.startswith('-Wno-') \ - or flag.startswith('-dno') \ - or flag.startswith('-fno') \ - or flag.startswith('-XNo'): - return True - if flag.startswith('-Wwarn=') \ - or flag.startswith('-Wno-warn='): - return True - - return False - -def read_documented_flags(doc_flags) -> Set[str]: - # Map characters that mark the end of a flag - # to whitespace. - trans = str.maketrans({ - '=': ' ', - '[': ' ', - '⟨': ' ', - }) - return {line.translate(trans).split()[0] - for line in doc_flags.read().split('\n') - if line != ''} - -def read_ghc_flags(ghc_path: str) -> Set[str]: - ghc_output = subprocess.check_output([ghc_path, '--show-options'], - encoding='UTF-8') - return {flag - for flag in ghc_output.split('\n') - if not expected_undocumented(flag) - if flag != ''} - -def main() -> None: - import argparse - parser = argparse.ArgumentParser() - parser.add_argument('--ghc', type=argparse.FileType('r'), - help='path of GHC executable') - parser.add_argument('--doc-flags', type=argparse.FileType('r'), - help='path of ghc-flags.txt output from Sphinx') - args = parser.parse_args() - - doc_flags = read_documented_flags(args.doc_flags) - ghc_flags = read_ghc_flags(args.ghc.name) - - failed = False - - undocumented = ghc_flags - doc_flags - if len(undocumented) > 0: - print(f'Found {len(undocumented)} flags not documented in the users guide:') - print('\n'.join(f' {flag}' for flag in sorted(undocumented))) - print() - failed = True - - now_documented = EXPECTED_UNDOCUMENTED.intersection(doc_flags) - if len(now_documented) > 0: - print(f'Found flags that are documented yet listed in {EXPECTED_UNDOCUMENTED_PATH}:') - print('\n'.join(f' {flag}' for flag in sorted(now_documented))) - print() - failed = True - - if failed: - sys.exit(1) - - -if __name__ == '__main__': - main() ===================================== docs/users_guide/runtime_control.rst ===================================== @@ -174,6 +174,8 @@ e.g., on stack overflow. The hooks for these are as follows: The message printed if ``malloc`` fails. +.. _event_log_output_api: + Event log output ################ @@ -190,7 +192,7 @@ Furthermore GHC lets you specify the way event log data (see :rts-flag:`-l .. c:member:: bool writeEventLog(void *eventlog, size_t eventlog_size) - Hands buffered event log data to your event log writer. + Hands buffered event log data to your event log writer. Return true on success. Required for a custom :c:type:`EventLogWriter`. .. c:member:: void flushEventLog(void) @@ -202,6 +204,35 @@ Furthermore GHC lets you specify the way event log data (see :rts-flag:`-l Called when event logging is about to stop. This can be ``NULL``. +To use an :c:type:`EventLogWriter` the RTS API provides the following functions: + +.. c:function:: EventLogStatus eventLogStatus(void) + + Query whether the current runtime system supports the eventlog (e.g. whether + the current executable was linked with :ghc-flag:`-eventlog`) and, if it + is supported, whether it is currently logging. + +.. 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. + +.. c:function:: void endEventLogging() + + Tear down the active :c:type:`EventLogWriter`. + +where the ``enum`` :c:type:`EventLogStatus` is: + +.. c:type:: EventLogStatus + + * ``EVENTLOG_NOT_SUPPORTED``: The runtime system wasn't compiled with + eventlog support. + * ``EVENTLOG_NOT_CONFIGURED``: An :c:type:`EventLogWriter` has not yet been + configured. + * ``EVENTLOG_RUNNING``: An :c:type:`EventLogWriter` has been configured and + is running. + + .. _rts-options-misc: Miscellaneous RTS options @@ -226,7 +257,7 @@ Miscellaneous RTS options catch unhandled exceptions using the Windows exception handling mechanism. This option is primarily useful for when you are using the Haskell code as a DLL, and don't want the RTS to ungracefully terminate your application on - erros such as segfaults. + errors such as segfaults. .. rts-flag:: --generate-crash-dumps @@ -351,8 +382,8 @@ performance. collections. Under this collection strategy oldest-generation garbage collection can proceed concurrently with mutation. - Note that :rts-flag:`--nonmoving-gc` cannot be used with ``-G1`` nor - :rts-flag:`-c`. + Note that :rts-flag:`--nonmoving-gc` cannot be used with ``-G1``, + :rts-flag:`profiling <-hc>` nor :rts-flag:`-c`. .. rts-flag:: -xn @@ -632,6 +663,26 @@ performance. This is an experimental feature, please let us know if it causes problems and/or could benefit from further tuning. +.. rts-flag:: -Iw ⟨seconds⟩ + + :default: 0 seconds + + .. index:: + single: idle GC + + By default, if idle GC is enabled in the threaded runtime, a major + GC will be performed every time the process goes idle for a + sufficiently long duration (see :rts-flag:`-I ⟨seconds⟩`). For + large server processes accepting regular but infrequent requests + (e.g., once per second), an expensive, major GC may run after + every request. As an alternative to shutting off idle GC entirely + (with ``-I0``), a minimum wait time between idle GCs can be + specified with this flag. For example, ``-Iw60`` will ensure that + an idle GC runs at most once per minute. + + This is an experimental feature, please let us know if it causes + problems and/or could benefit from further tuning. + .. rts-flag:: -ki ⟨size⟩ :default: 1k @@ -821,10 +872,10 @@ performance. By default, the flag will cause a warning to be emitted to stderr when the sync time exceeds the specified time. This behaviour can - be overriden, however: the ``longGCSync()`` hook is called when + be overridden, however: the ``longGCSync()`` hook is called when the sync time is exceeded during the sync period, and the ``longGCSyncEnd()`` hook at the end. Both of these hooks can be - overriden in the ``RtsConfig`` when the runtime is started with + overridden in the ``RtsConfig`` when the runtime is started with ``hs_init_ghc()``. The default implementations of these hooks (``LongGcSync()`` and ``LongGCSyncEnd()`` respectively) print warnings to stderr. @@ -1096,7 +1147,7 @@ When the program is linked with the :ghc-flag:`-eventlog` option logs a default set of events, suitable for use with tools like ThreadScope. Per default the events are written to :file:`{program}.eventlog` though - the mechanism for writing event log data can be overriden with a custom + the mechanism for writing event log data can be overridden with a custom `EventLogWriter`. For some special use cases you may want more control over which @@ -1291,7 +1342,7 @@ recommended for everyday use! .. rts-flag:: -Z - Turn *off* "update-frame squeezing" at garbage-collection time. + Turn *off* update frame squeezing on context switch. (There's no particularly good reason to turn it off, except to ensure the accuracy of certain data collected regarding thunk entry counts.) ===================================== docs/users_guide/using-warnings.rst ===================================== @@ -221,9 +221,10 @@ of ``-W(no-)*``. encountered on the command line. :type: dynamic :reverse: -Wno-unrecognised-warning-flags - :default: on :category: + :default: on + Enables warnings when the compiler encounters a ``-W...`` flag that is not recognised. @@ -253,9 +254,10 @@ of ``-W(no-)*``. :ghc-flag:`-fdefer-typed-holes`. :type: dynamic :reverse: -Wno-typed-holes - :default: on :category: + :default: on + Determines whether the compiler reports typed holes warnings. Has no effect unless typed holes errors are deferred until runtime. See :ref:`typed-holes` and :ref:`defer-type-errors` ===================================== hadrian/src/Rules/Documentation.hs ===================================== @@ -16,7 +16,6 @@ import Context import Expression (getContextData, interpretInContext, (?), package) import Flavour import Oracles.ModuleFiles -import Oracles.Setting (topDirectory) import Packages import Settings import Target @@ -111,11 +110,6 @@ documentationRules = do need $ map (root -/-) targets - when (SphinxPDFs `Set.member` doctargets) - $ checkUserGuideFlags $ pdfRoot -/- "users_guide" -/- "ghc-flags.txt" - when (SphinxHTML `Set.member` doctargets) - $ checkUserGuideFlags $ root -/- htmlRoot -/- "users_guide" -/- "ghc-flags.txt" - where archiveTarget "libraries" = Haddocks archiveTarget _ = SphinxHTML @@ -129,17 +123,6 @@ checkSphinxWarnings out = do when ("reference target not found" `isInfixOf` log) $ fail "Undefined reference targets found in Sphinx log." --- | Check that all GHC flags are documented in the users guide. -checkUserGuideFlags :: FilePath -> Action () -checkUserGuideFlags documentedFlagList = do - scriptPath <- ( "docs/users_guide/compare-flags.py") <$> topDirectory - ghcPath <- () <$> topDirectory <*> programPath (vanillaContext Stage1 ghc) - runBuilder Python - [ scriptPath - , "--doc-flags", documentedFlagList - , "--ghc", ghcPath - ] [documentedFlagList] [] - ------------------------------------- HTML ------------------------------------- ===================================== includes/rts/EventLogWriter.h ===================================== @@ -23,7 +23,7 @@ typedef struct { // Initialize an EventLogWriter (may be NULL) void (* initEventLogWriter) (void); - // Write a series of events + // Write a series of events returning true on success. bool (* writeEventLog) (void *eventlog, size_t eventlog_size); // Flush possibly existing buffers (may be NULL) @@ -38,3 +38,29 @@ typedef struct { * a file `program.eventlog`. */ extern const EventLogWriter FileEventLogWriter; + +enum EventLogStatus { + /* The runtime system wasn't compiled with eventlog support. */ + EVENTLOG_NOT_SUPPORTED, + /* An EventLogWriter has not yet been configured */ + EVENTLOG_NOT_CONFIGURED, + /* An EventLogWriter has been configured and is running. */ + EVENTLOG_RUNNING, +}; + +/* + * Query whether the current runtime system supports eventlogging. + */ +enum EventLogStatus eventLogStatus(void); + +/* + * Initialize event logging using the given EventLogWriter. + * Returns true on success or false if an EventLogWriter is already configured + * or eventlogging isn't supported by the runtime. + */ +bool startEventLogging(const EventLogWriter *writer); + +/* + * Stop event logging and destroy the current EventLogWriter. + */ +void endEventLogging(void); ===================================== libraries/process ===================================== @@ -1 +1 @@ -Subproject commit 21149358df25d742cc79ce55510aa82f246e7044 +Subproject commit 758d2f799020bc93b95494e3f54e7056d49041ae ===================================== mk/get-win32-tarballs.py ===================================== @@ -0,0 +1,58 @@ +#!/usr/bin/env python +# -*- coding: utf-8 -*- + +from pathlib import Path +import urllib.request +import subprocess +import argparse + +TARBALL_VERSION = '0.1' +BASE_URL = "https://downloads.haskell.org/ghc/mingw/{}".format(TARBALL_VERSION) +DEST = Path('ghc-tarballs/mingw-w64') +ARCHS = ['i686', 'x86_64', 'sources'] + +def file_url(arch: str, fname: str) -> str: + return "{base}/{arch}/{fname}".format( + base=BASE_URL, + arch=arch, + fname=fname) + +def fetch(url: str, dest: Path): + print('Fetching', url, '=>', dest) + urllib.request.urlretrieve(url, dest) + +def fetch_arch(arch: str): + req = urllib.request.urlopen(file_url(arch, 'MANIFEST')) + files = req.read().decode('UTF-8').split('\n') + d = DEST / arch + if not d.is_dir(): + d.mkdir(parents=True) + fetch(file_url(arch, 'SHA256SUMS'), d / 'SHA256SUMS') + for fname in files: + if not (d / fname).is_file(): + fetch(file_url(arch, fname), d / fname) + + verify(arch) + +def verify(arch: str): + cmd = ['sha256sum', '--quiet', '--check', '--ignore-missing', 'SHA256SUMS'] + subprocess.check_call(cmd, cwd=DEST / arch) + +def main() -> None: + parser = argparse.ArgumentParser() + parser.add_argument('mode', choices=['verify', 'download']) + parser.add_argument( + 'arch', + choices=ARCHS + ['all'], + help="Architecture to fetch (either i686, x86_64, sources, or all)") + args = parser.parse_args() + + action = fetch_arch if args.mode == 'download' else verify + if args.arch == 'all': + for arch in ARCHS: + action(arch) + else: + action(args.arch) + +if __name__ == '__main__': + main() ===================================== mk/get-win32-tarballs.sh deleted ===================================== @@ -1,326 +0,0 @@ -#!/usr/bin/env bash - -tarball_dir='ghc-tarballs' -missing_files=0 -pkg_variant="phyx" - -# see #12502 -if test -z "$FIND"; then FIND="find"; fi - -fail() { - echo >&2 - echo "$1" >&2 - exit 1 -} - -download_file() { - local file_url="$1" - local dest_file="$2" - local description="$3" - local extra_curl_opts="$4" - local backup_url="$5" - local dest_dir="$(dirname $dest_file)" - - if ! test -f "${dest_file}" - then - local curl_cmd="curl -f -L ${file_url} -o ${dest_file} --create-dirs -# ${extra_curl_opts}" - if test -n "${backup_url}"; then - local curl_cmd_bnk="curl -f -L ${backup_url} -o ${dest_file} --create-dirs -# ${extra_curl_opts}" - else - local curl_cmd_bnk="true" - fi - - if test "$download" = "0" - then - echo "ERROR: Missing ${description}" >&2 - echo "${file_url}" - missing_files=1 - return - else - echo "Downloading ${description} to ${dest_dir}..." - $curl_cmd || (echo "Checking repo.msys2.org instead of Haskell.org..." && $curl_cmd_bnk) || { - rm -f "${dest_file}" - fail "ERROR: Download failed." - exit 1 - } - fi - fi - - local sig_file="${dest_file}.sig" - if test "$sigs" = "1" -a ! -f "$sig_file" - then - echo "Downloading ${description} (signature) to ${dest_dir}..." - local curl_cmd="curl -f -L ${file_url}.sig -o ${sig_file} --create-dirs -# ${extra_curl_opts}" - if test -n "${backup_url}"; then - local curl_cmd_bnk="curl -f -L "${backup_url}.sig" -o ${sig_file} --create-dirs -# ${extra_curl_opts}" - else - local curl_cmd_bnk="true" - fi - $curl_cmd || (echo "Checking repo.msys2.org instead of Haskell.org..." && $curl_cmd_bnk) || { - rm -f "${dest_file}.sig" - fail "ERROR: Download failed." - exit 1 - } - fi - - if test "$verify" = "1" - then - grep "${dest_file}$" mk/win32-tarballs.md5sum | md5sum --quiet -c - || - fail "ERROR: ${description} appears to be corrupted, please delete it and try again." - fi -} - -download_mingw() { - local mingw_base_url_primary="https://downloads.haskell.org/~ghc/mingw" - local mingw_base_url_secondary="http://repo.msys2.org/mingw" - - if test "$mingw_arch" = "sources" - then - mingw_url_tmp=`echo "$1" | sed -e 's/-any\.pkg\.tar\.xz/\.src\.tar\.gz/' \ - -e 's/-sources-/-/' \ - -e 's/-libwinpthread-git-/-winpthreads-git-/' ` - local mingw_url="${mingw_base_url_primary}/${mingw_url_tmp}" - local mingw_url_backup="${mingw_base_url_secondary}/${mingw_url_tmp}" - else - local mingw_url="${mingw_base_url_primary}/$1" - local mingw_url_backup="${mingw_base_url_secondary}/$1" - fi - - local mingw_toolchain="$(basename $mingw_url)" - local mingw_w64="${tarball_dir}/${tarball_dest_dir}/${mingw_toolchain}" - - download_file "${mingw_url}" "${mingw_w64}" "${mingw_toolchain}" "" "${mingw_url_backup}" - - # Mark the tree as needing updates by deleting the folder - if test -d inplace/mingw && test inplace/mingw -ot "$mingw_w64" ; then - echo "In-tree MinGW-w64 tree requires updates..." - rm -rf inplace/mingw - fi -} - -download_tarballs() { - local package_prefix="mingw-w64" - local format_url="/${mingw_arch}/${package_prefix}-${mingw_arch}" - - download_mingw "${format_url}-crt-git-7.0.0.5491.fe45801e-1-any.pkg.tar.xz" - download_mingw "${format_url}-winpthreads-git-7.0.0.5480.e14d23be-1-any.pkg.tar.xz" - download_mingw "${format_url}-headers-git-7.0.0.5490.9ec54ed1-1-any.pkg.tar.xz" - download_mingw "${format_url}-libwinpthread-git-7.0.0.5480.e14d23be-1-any.pkg.tar.xz" - download_mingw "${format_url}-zlib-1.2.8-9-any.pkg.tar.xz" - download_mingw "${format_url}-isl-0.21-1-any.pkg.tar.xz" - download_mingw "${format_url}-mpfr-4.0.2-2-any.pkg.tar.xz" - download_mingw "${format_url}-gmp-6.1.2-1-any.pkg.tar.xz" - download_mingw "${format_url}-binutils-2.32-3-$pkg_variant.pkg.tar.xz" - download_mingw "${format_url}-libidn2-2.2.0-1-any.pkg.tar.xz" - download_mingw "${format_url}-gcc-9.2.0-1-$pkg_variant.pkg.tar.xz" - download_mingw "${format_url}-mpc-1.1.0-1-any.pkg.tar.xz" - download_mingw "${format_url}-windows-default-manifest-6.4-3-any.pkg.tar.xz" - - # Upstream is unfortunately quite inconsistent in naming - if test "$mingw_arch" != "sources"; then - download_mingw "${format_url}-gcc-libs-9.2.0-1-$pkg_variant.pkg.tar.xz" - fi - - if ! test "$missing_files" = "0" - then - exit 2 - fi -} - -download_i386() { - mingw_arch="i686" - tarball_dest_dir="mingw-w64/i686" - download_tarballs -} - -download_x86_64() { - mingw_arch="x86_64" - tarball_dest_dir="mingw-w64/x86_64" - download_tarballs -} - -download_sources() { - mingw_arch="sources" - tarball_dest_dir="mingw-w64/sources" - download_tarballs -} - -sync_binaries_and_sources() { - gpg --recv-key 5F92EFC1A47D45A1 - - # ensure sources are downloaded - sigs=1 - download_i386 - download_x86_64 - verify=0 - download_sources - - for f in $($FIND ghc-tarballs/mingw-w64 -iname '*.sig'); do - echo "Verifying $f" - gpg --verify $f - done - - md5sum `$FIND ghc-tarballs -type f -a -not -iname '*.sig'` >| mk/win32-tarballs.md5sum - chmod -R ugo+rX ghc-tarballs - - rsync -av ghc-tarballs/mingw-w64/* downloads.haskell.org:public_html/mingw - for f in $($FIND ghc-tarballs/mingw-w64); do - curl -XPURGE http://downloads.haskell.org/~ghc/mingw/$f - done -} - -patch_single_file () { - local patcher_base="$1" - local filename=$(readlink -f "$2") - local filepath=$(dirname "$filename") - local patcher="$patcher_base/iat-patcher.exe" - $patcher install "$filename" > /dev/null - rm -f "$filename.bak" - for file in $patcher_base/*.dll; do cp -f "$file" "${filepath}"; done - echo "Patched '$filename'" -} - -patch_tarball () { - local tarball_name="$1" - local filename=$(basename "$tarball_name") - local filepath=$(dirname "$tarball_name") - local newfile=`echo "$filepath/$filename" | sed -e 's/-any/-phyx/'` - local arch="" - - echo "=> ${filename}" - - case $1 in - *x86_64*) - arch="x86_64" - ;; - *i686*) - arch="i686" - ;; - *) - echo "unknown architecture detected. Stopping." - exit 1 - ;; - esac - - local base="$(pwd)" - local patcher_base="$(pwd)/ghc-tarballs/ghc-jailbreak/$arch" - local tmpdir="ghc-tarballs/tmpdir" - mkdir -p $tmpdir - cd $tmpdir - tar xJf "$base/$tarball_name" - find . -iname "*.exe" -exec bash -c \ - 'patch_single_file "'"${patcher_base}"'" "$0"' {} \; - tar cJf "$base/$newfile" . - cd "$base" - rm -rf $tmpdir - gpg --output "$base/${newfile}.sig" --detach-sig "$base/$newfile" - rm -f "$base/$tarball_name" -} - -show_hashes_for_binaries() { - $FIND ghc-tarballs/ -iname "*.*" | xargs md5sum | grep -v "\.sig" | sed -s "s/\*//" -} - -usage() { - echo "$0 - Download GHC mingw toolchain tarballs" - echo - echo "Usage: $0 []" - echo - echo "Where is one of," - echo "" - echo " download download the necessary tarballs for the given architecture" - echo " fetch download the necessary tarballs for the given architecture but doesn't verify their md5." - echo " grab download the necessary tarballs using patched toolchains for the given architecture but doesn't verify their md5." - echo " verify verify the existence and correctness of the necessary tarballs" - echo " patch jailbreak the binaries in the tarballs and remove MAX_PATH limitations." - echo " hash generate md5 hashes for inclusion in win32-tarballs.md5sum" - echo " sync upload packages downloaded with 'fetch mirror' to haskell.org" - echo "" - echo "and is one of i386, x86_64,all or mirror (which includes sources)" -} - -case $1 in - download) - download=1 - verify=1 - sigs=0 - ;; - fetch) - download=1 - verify= - ;; - grab) - download=1 - verify=0 - pkg_variant="any" - ;; - verify) - download=0 - verify=1 - ;; - sync) - download=1 - verify=0 - sync=1 - ;; - hash) - show_hashes_for_binaries - exit 1 - ;; - # This routine will download the latest ghc-jailbreak and unpack binutils and - # the ghc tarballs and patches every .exe in each. Along with this is copies - # two dlls in every folder that it patches a .exe in. Afterwards it re-creates - # the tarballs and generates a new signature file. - patch) - export -f patch_tarball - export -f patch_single_file - - echo "Downloading ghc-jailbreak..." - curl -f -L https://mistuke.blob.core.windows.net/binaries/ghc-jailbreak-0.3.tar.gz \ - -o ghc-tarballs/ghc-jailbreak/ghc-jailbreak.tar.gz --create-dirs -# - tar -C ghc-tarballs/ghc-jailbreak/ -xf ghc-tarballs/ghc-jailbreak/ghc-jailbreak.tar.gz - - find ghc-tarballs/mingw-w64/ \( -iname "*binutils*.tar.xz" \ - -o -iname "*gcc*.tar.xz" \) \ - -exec bash -c 'patch_tarball "$0"' {} \; - - rm -rf ghc-tarballs/ghc-jailbreak - - echo "Finished tarball generation, toolchain has been pre-patched." - exit 0 - ;; - *) - usage - exit 1 - ;; -esac - -case $2 in - i386) - download_i386 - ;; - x86_64) - download_x86_64 - ;; - all) - download_i386 - download_x86_64 - ;; - mirror) - sigs=1 - download_i386 - download_x86_64 - verify=0 - sigs=0 - download_sources - show_hashes_for_binaries - ;; - *) - if test "$sync" = "1"; then - sync_binaries_and_sources - else - usage - exit 1 - fi - ;; -esac ===================================== rts/Trace.c ===================================== @@ -40,21 +40,12 @@ int TRACE_cap; static Mutex trace_utx; #endif -static bool eventlog_enabled; - /* --------------------------------------------------------------------------- Starting up / shutting down the tracing facilities --------------------------------------------------------------------------- */ -static const EventLogWriter *getEventLogWriter(void) -{ - return rtsConfig.eventlog_writer; -} - void initTracing (void) { - const EventLogWriter *eventlog_writer = getEventLogWriter(); - #if defined(THREADED_RTS) initMutex(&trace_utx); #endif @@ -95,15 +86,14 @@ void initTracing (void) TRACE_spark_full || TRACE_user; - eventlog_enabled = RtsFlags.TraceFlags.tracing == TRACE_EVENTLOG && - eventlog_writer != NULL; - /* Note: we can have any of the TRACE_* flags turned on even when eventlog_enabled is off. In the DEBUG way we may be tracing to stderr. */ + initEventLogging(); - if (eventlog_enabled) { - initEventLogging(eventlog_writer); + if (RtsFlags.TraceFlags.tracing == TRACE_EVENTLOG + && rtsConfig.eventlog_writer != NULL) { + startEventLogging(rtsConfig.eventlog_writer); } } @@ -121,17 +111,10 @@ void freeTracing (void) } } +// Used to reset tracing in a forked child void resetTracing (void) { - const EventLogWriter *eventlog_writer; - eventlog_writer = getEventLogWriter(); - - if (eventlog_enabled) { - abortEventLogging(); // abort eventlog inherited from parent - if (eventlog_writer != NULL) { - initEventLogging(eventlog_writer); // child starts its own eventlog - } - } + restartEventLogging(); } void flushTrace (void) ===================================== rts/eventlog/EventLog.c ===================================== @@ -26,7 +26,9 @@ #include #endif -static const EventLogWriter *event_log_writer; +bool eventlog_enabled; + +static const EventLogWriter *event_log_writer = NULL; #define EVENT_LOG_SIZE 2 * (1024 * 1024) // 2MB @@ -516,16 +518,22 @@ postHeaderEvents(void) postInt32(&eventBuf, EVENT_DATA_BEGIN); } -void -initEventLogging(const EventLogWriter *ev_writer) +static uint32_t +get_n_capabilities(void) { - uint32_t n_caps; +#if defined(THREADED_RTS) + // XXX n_capabilities may not have been initialized yet + return (n_capabilities != 0) ? n_capabilities : RtsFlags.ParFlags.nCapabilities; +#else + return 1; +#endif +} +void +initEventLogging() +{ init_event_types(); - event_log_writer = ev_writer; - initEventLogWriter(); - int num_descs = sizeof(EventDesc) / sizeof(char*); if (num_descs != NUM_GHC_EVENT_TAGS) { barf("EventDesc array has the wrong number of elements (%d, NUM_GHC_EVENT_TAGS=%d)", @@ -542,18 +550,28 @@ initEventLogging(const EventLogWriter *ev_writer) * Use a single buffer to store the header with event types, then flush * the buffer so all buffers are empty for writing events. */ -#if defined(THREADED_RTS) - // XXX n_capabilities hasn't been initialized yet - n_caps = RtsFlags.ParFlags.nCapabilities; -#else - n_caps = 1; -#endif - moreCapEventBufs(0, n_caps); + moreCapEventBufs(0, get_n_capabilities()); initEventsBuf(&eventBuf, EVENT_LOG_SIZE, (EventCapNo)(-1)); #if defined(THREADED_RTS) initMutex(&eventBufMutex); #endif +} + +enum EventLogStatus +eventLogStatus(void) +{ + if (eventlog_enabled) { + return EVENTLOG_RUNNING; + } else { + return EVENTLOG_NOT_CONFIGURED; + } +} + +static bool +startEventLogging_(void) +{ + initEventLogWriter(); postHeaderEvents(); @@ -564,14 +582,42 @@ initEventLogging(const EventLogWriter *ev_writer) */ printAndClearEventBuf(&eventBuf); - for (uint32_t c = 0; c < n_caps; ++c) { + for (uint32_t c = 0; c < get_n_capabilities(); ++c) { postBlockMarker(&capEventBuf[c]); } + return true; +} + +bool +startEventLogging(const EventLogWriter *ev_writer) +{ + if (eventlog_enabled || event_log_writer) { + return false; + } + + eventlog_enabled = true; + event_log_writer = ev_writer; + return startEventLogging_(); +} + +// Called during forkProcess in the child to restart the eventlog writer. +void +restartEventLogging(void) +{ + freeEventLogging(); + stopEventLogWriter(); + initEventLogging(); // allocate new per-capability buffers + if (event_log_writer != NULL) { + startEventLogging_(); // child starts its own eventlog + } } void endEventLogging(void) { + if (!eventlog_enabled) + return; + // Flush all events remaining in the buffers. for (uint32_t c = 0; c < n_capabilities; ++c) { printAndClearEventBuf(&capEventBuf[c]); @@ -586,6 +632,8 @@ endEventLogging(void) printAndClearEventBuf(&eventBuf); stopEventLogWriter(); + event_log_writer = NULL; + eventlog_enabled = false; } void @@ -626,13 +674,6 @@ freeEventLogging(void) } } -void -abortEventLogging(void) -{ - freeEventLogging(); - stopEventLogWriter(); -} - /* * Post an event message to the capability's eventlog buffer. * If the buffer is full, prints out the buffer and clears it. @@ -1440,7 +1481,7 @@ void printAndClearEventBuf (EventsBuf *ebuf) size_t elog_size = ebuf->pos - ebuf->begin; if (!writeEventLog(ebuf->begin, elog_size)) { debugBelch( - "printAndClearEventLog: could not flush event log" + "printAndClearEventLog: could not flush event log\n" ); resetEventsBuf(ebuf); return; @@ -1524,4 +1565,17 @@ void postEventType(EventsBuf *eb, EventType *et) postInt32(eb, EVENT_ET_END); } +#else + +enum EventLogStatus eventLogStatus(void) +{ + return EVENTLOG_NOT_SUPPORTED; +} + +bool startEventLogging(const EventLogWriter *writer STG_UNUSED) { + return false; +} + +void endEventLogging(void) {} + #endif /* TRACING */ ===================================== rts/eventlog/EventLog.h ===================================== @@ -22,8 +22,10 @@ */ extern char *EventTagDesc[]; -void initEventLogging(const EventLogWriter *writer); -void endEventLogging(void); +extern bool eventlog_enabled; + +void initEventLogging(void); +void restartEventLogging(void); void freeEventLogging(void); void abortEventLogging(void); // #4512 - after fork child needs to abort void flushEventLog(void); // event log inherited from parent ===================================== rts/eventlog/EventLogWriter.c ===================================== @@ -122,6 +122,7 @@ stopEventLogFileWriter(void) { if (event_log_file != NULL) { fclose(event_log_file); + event_log_file = NULL; } } ===================================== testsuite/tests/rts/InitEventLogging.hs ===================================== @@ -0,0 +1,11 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +-- Test that the startEventLog interface works as expected. +main :: IO () +main = do + putStrLn "Starting eventlog..." + c_init_eventlog + putStrLn "done" + +foreign import ccall unsafe "init_eventlog" + c_init_eventlog :: IO () ===================================== testsuite/tests/rts/InitEventLogging.stdout ===================================== @@ -0,0 +1,8 @@ +Starting eventlog... +done +init +write +write +write +write +stop ===================================== testsuite/tests/rts/InitEventLogging_c.c ===================================== @@ -0,0 +1,33 @@ +#include +#include + +void test_init(void) { + printf("init\n"); +} + +bool test_write(void *eventlog, size_t eventlog_size) { + printf("write\n"); + return true; +} + +void test_flush(void) { + printf("flush\n"); +} + +void test_stop(void) { + printf("stop\n"); +} + +const EventLogWriter writer = { + .initEventLogWriter = test_init, + .writeEventLog = test_write, + .flushEventLog = test_flush, + .stopEventLogWriter = test_stop +}; + +void init_eventlog(void) { + if (!startEventLogging(&writer)) { + printf("failed to start eventlog\n"); + } +} + ===================================== testsuite/tests/rts/all.T ===================================== @@ -411,3 +411,6 @@ test('T17088', [only_ways(['normal']), extra_run_opts('+RTS -c -A256k -RTS')], compile_and_run, ['-rtsopts -O2']) +test('InitEventLogging', + [only_ways(['normal']), extra_run_opts('+RTS -RTS')], + compile_and_run, ['-eventlog InitEventLogging_c.c']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/4c0a45d1043de427a1f179019e87723b1374bf19...06889a6f2e2adfd308339a836074216108cd7149 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/4c0a45d1043de427a1f179019e87723b1374bf19...06889a6f2e2adfd308339a836074216108cd7149 You're receiving 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 Mar 20 10:47:10 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Fri, 20 Mar 2020 06:47:10 -0400 Subject: [Git][ghc/ghc][wip/T17917] 3 commits: Avoid useless w/w split Message-ID: <5e749f2ede498_488a3fc6a691ddac22932c1@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T17917 at Glasgow Haskell Compiler / GHC Commits: 6eab61f6 by Simon Peyton Jones at 2020-03-19T14:28:42Z Avoid useless w/w split This patch is just a tidy-up for the post-strictness-analysis worker wrapper split. Consider f x = x Strictnesss analysis does not lead to a w/w split, so the obvious thing is to leave it 100% alone. But actually, because the RHS is small, we ended up adding a StableUnfolding for it. There is some reason to do this if we choose /not/ do to w/w on the grounds that the function is small. See Note [Don't w/w inline small non-loop-breaker things] But there is no reason if we would not have done w/w anyway. This patch just moves the conditional to later. Easy. This does move soem -ddump-simpl printouts around a bit. I also discovered that the previous code was overwritten an InlineCompulsory with InlineStable, which is utterly wrong. That in turn meant that some default methods (marked InlineCompulsory) were getting their InlineCompulsory squashed. This patch fixes that bug --- but of course that does mean a bit more inlining! - - - - - cf1c1167 by Simon Peyton Jones at 2020-03-20T10:43:19Z Wibble to the worker/wrapper patch Don't attempt to w/w record selectors. Rather ad-hoc but very simple and effective. See WorkWrap Note [No worker-wrapper for record selectors]. - - - - - 761e9570 by Simon Peyton Jones at 2020-03-20T10:45:06Z DO NOT MERGE THIS PATCH This is a temporary fix on the T17917 branch, to account for This branch should be rebased once the patch for #17932 lands (namely !2929), and this particular commit discarded - - - - - 10 changed files: - compiler/GHC/Core/Op/DmdAnal.hs - compiler/GHC/Core/Op/WorkWrap.hs - compiler/GHC/Core/Unfold.hs - testsuite/tests/dependent/should_compile/dynamic-paper.stderr - testsuite/tests/driver/inline-check.stderr - testsuite/tests/numeric/should_compile/T14465.stdout - testsuite/tests/perf/compiler/T16473.stdout - testsuite/tests/simplCore/should_compile/T4201.stdout - testsuite/tests/simplCore/should_compile/T5658b.stdout - testsuite/tests/warnings/should_compile/T16282/T16282.stderr Changes: ===================================== compiler/GHC/Core/Op/DmdAnal.hs ===================================== @@ -623,10 +623,11 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs -- For example, a call of the form @mkRhsDmd _ 2 (\x y -> (x, y))@ returns a -- clean usage demand of @C1(C1(U(U,U)))@. mkRhsDmd :: AnalEnv -> Arity -> CoreExpr -> CleanDemand -mkRhsDmd env rhs_arity rhs = - case peelTsFuns rhs_arity (findTypeShape (ae_fam_envs env) (exprType rhs)) of - Just (TsProd tss) -> mkCallDmds rhs_arity (cleanEvalProdDmd (length tss)) - _ -> mkCallDmds rhs_arity cleanEvalDmd +mkRhsDmd _env rhs_arity _rhs = + mkCallDmds rhs_arity cleanEvalDmd +-- case peelTsFuns rhs_arity (findTypeShape (ae_fam_envs env) (exprType rhs)) of +-- Just (TsProd tss) -> mkCallDmds rhs_arity (cleanEvalProdDmd (length tss)) +-- _ -> mkCallDmds rhs_arity cleanEvalDmd -- | If given the let-bound 'Id', 'useLetUp' determines whether we should -- process the binding up (body before rhs) or down (rhs before body). ===================================== compiler/GHC/Core/Op/WorkWrap.hs ===================================== @@ -24,6 +24,7 @@ import GHC.Driver.Session import Demand import Cpr import GHC.Core.Op.WorkWrap.Lib +import Unique import Util import Outputable import GHC.Core.FamInstEnv @@ -203,6 +204,23 @@ unfolding to the *worker*. So we will get something like this: How do we "transfer the unfolding"? Easy: by using the old one, wrapped in work_fn! See GHC.Core.Unfold.mkWorkerUnfolding. +Note [No worker-wrapper for record selectors] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We sometimes generate a lot of record selectors, and generally the +don't benefit from worker/wrapper. Yes, mkWwBodies would find a w/w split, +but it is then suppressed by the certainlyWillInline test in splitFun. + +The wasted effort in mkWwBodies makes a measurable difference in +compile time (see MR !2873), so although it's a terribly ad-hoc test, +we just check here for record selectors, and do a no-op in that case. + +I did look for a generalisation, so that it's not just record +selectors that benefit. But you'd need a cheap test for "this +function will definitely get a w/w split" and that's hard to predict +in advance...the logic in mkWwBodies is complex. So I've left the +super-simple test, with this Note to explain. + + Note [Worker-wrapper for NOINLINE functions] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We used to disable worker/wrapper for NOINLINE things, but it turns out @@ -316,8 +334,8 @@ Note [Don't w/w inline small non-loop-breaker things] In general, we refrain from w/w-ing *small* functions, which are not loop breakers, because they'll inline anyway. But we must take care: it may look small now, but get to be big later after other inlining -has happened. So we take the precaution of adding an INLINE pragma to -any such functions. +has happened. So we take the precaution of adding a StableUnfolding +for any such functions. I made this change when I observed a big function at the end of compilation with a useful strictness signature but no w-w. (It was @@ -457,11 +475,6 @@ tryWW :: DynFlags tryWW dflags fam_envs is_rec fn_id rhs -- See Note [Worker-wrapper for NOINLINE functions] - | Just stable_unf <- certainlyWillInline dflags fn_info - = return [ (fn_id `setIdUnfolding` stable_unf, rhs) ] - -- See Note [Don't w/w INLINE things] - -- 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 @@ -567,105 +580,125 @@ See https://gitlab.haskell.org/ghc/ghc/merge_requests/312#note_192064. splitFun :: DynFlags -> FamInstEnvs -> Id -> IdInfo -> [Demand] -> Divergence -> CprResult -> 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 - -- The arity should match the signature - stuff <- mkWwBodies dflags fam_envs rhs_fvs fn_id wrap_dmds use_cpr_info - case stuff of - Just (work_demands, join_arity, wrap_fn, work_fn) -> do - work_uniq <- getUniqueM - let work_rhs = work_fn rhs - work_act = case fn_inline_spec of -- See Note [Worker activation] - NoInline -> fn_act - _ -> wrap_act - - work_prag = InlinePragma { inl_src = SourceText "{-# INLINE" - , inl_inline = fn_inline_spec - , inl_sat = Nothing - , inl_act = work_act - , inl_rule = FunLike } - -- inl_inline: copy from fn_id; see Note [Worker-wrapper for INLINABLE functions] - -- inl_act: see Note [Worker activation] - -- inl_rule: it does not make sense for workers to be constructorlike. - - work_join_arity | isJoinId fn_id = Just join_arity - | otherwise = Nothing - -- worker is join point iff wrapper is join point - -- (see Note [Don't w/w join points for CPR]) - - work_id = mkWorkerId work_uniq fn_id (exprType work_rhs) - `setIdOccInfo` occInfo fn_info - -- Copy over occurrence info from parent - -- Notably whether it's a loop breaker - -- Doesn't matter much, since we will simplify next, but - -- seems right-er to do so - - `setInlinePragma` work_prag - - `setIdUnfolding` mkWorkerUnfolding dflags work_fn fn_unfolding - -- See Note [Worker-wrapper for INLINABLE functions] - - `setIdStrictness` mkClosedStrictSig work_demands div - -- Even though we may not be at top level, - -- it's ok to give it an empty DmdEnv - - `setIdCprInfo` mkCprSig work_arity work_cpr_info - - `setIdDemandInfo` worker_demand - - `setIdArity` work_arity - -- Set the arity so that the Core Lint check that the - -- arity is consistent with the demand type goes - -- through - `asJoinId_maybe` work_join_arity - - work_arity = length work_demands - - -- See Note [Demand on the Worker] - single_call = saturatedByOneShots arity (demandInfo fn_info) - worker_demand | single_call = mkWorkerDemand work_arity - | otherwise = topDmd - - wrap_rhs = wrap_fn work_id - wrap_act = case fn_act of -- See Note [Wrapper activation] - ActiveAfter {} -> fn_act - NeverActive -> activeDuringFinal - _ -> activeAfterInitial - wrap_prag = InlinePragma { inl_src = SourceText "{-# INLINE" - , inl_inline = NoUserInline - , inl_sat = Nothing - , inl_act = wrap_act - , inl_rule = rule_match_info } - -- inl_act: see Note [Wrapper activation] - -- inl_inline: see Note [Wrapper NoUserInline] - -- inl_rule: RuleMatchInfo is (and must be) unaffected - - wrap_id = fn_id `setIdUnfolding` mkWwInlineRule dflags wrap_rhs arity - `setInlinePragma` wrap_prag - `setIdOccInfo` noOccInfo - -- Zap any loop-breaker-ness, to avoid bleating from Lint - -- about a loop breaker with an INLINE rule - - - - return $ [(work_id, work_rhs), (wrap_id, wrap_rhs)] - -- Worker first, because wrapper mentions it - - Nothing -> return [(fn_id, rhs)] + | isRecordSelector fn_id -- See Note [No worker/wrapper for record selectors] + = return [ (fn_id, rhs ) ] + + | otherwise + = WARN( not (wrap_dmds `lengthIs` arity), ppr fn_id <+> (ppr arity $$ ppr wrap_dmds $$ ppr cpr) ) + -- The arity should match the signature + do { mb_stuff <- mkWwBodies dflags fam_envs rhs_fvs fn_id wrap_dmds use_cpr_info + ; case mb_stuff of + Nothing -> return [(fn_id, rhs)] + + Just stuff + | Just stable_unf <- certainlyWillInline dflags fn_info + -> return [ (fn_id `setIdUnfolding` stable_unf, rhs) ] + -- See Note [Don't w/w INLINE things] + -- See Note [Don't w/w inline small non-loop-breaker things] + + | otherwise + -> do { work_uniq <- getUniqueM + ; return (mkWWBindPair dflags fn_id fn_info arity rhs + work_uniq div cpr stuff) } } where - rhs_fvs = exprFreeVars rhs + rhs_fvs = exprFreeVars rhs + arity = arityInfo fn_info + -- The arity is set by the simplifier using exprEtaExpandArity + -- So it may be more than the number of top-level-visible lambdas + + -- use_cpr_info is the CPR we w/w for. Note that we kill it for join points, + -- see Note [Don't w/w join points for CPR]. + use_cpr_info | isJoinId fn_id = topCpr + | otherwise = cpr + + +mkWWBindPair :: DynFlags -> Id -> IdInfo -> Arity + -> CoreExpr -> Unique -> Divergence -> CprResult + -> ([Demand], JoinArity, Id -> CoreExpr, Expr CoreBndr -> CoreExpr) + -> [(Id, CoreExpr)] +mkWWBindPair dflags fn_id fn_info arity rhs work_uniq div cpr + (work_demands, join_arity, wrap_fn, work_fn) + = [(work_id, work_rhs), (wrap_id, wrap_rhs)] + -- Worker first, because wrapper mentions it + where + work_rhs = work_fn rhs + work_act = case fn_inline_spec of -- See Note [Worker activation] + NoInline -> fn_act + _ -> wrap_act + + work_prag = InlinePragma { inl_src = SourceText "{-# INLINE" + , inl_inline = fn_inline_spec + , inl_sat = Nothing + , inl_act = work_act + , inl_rule = FunLike } + -- inl_inline: copy from fn_id; see Note [Worker-wrapper for INLINABLE functions] + -- inl_act: see Note [Worker activation] + -- inl_rule: it does not make sense for workers to be constructorlike. + + work_join_arity | isJoinId fn_id = Just join_arity + | otherwise = Nothing + -- worker is join point iff wrapper is join point + -- (see Note [Don't w/w join points for CPR]) + + work_id = mkWorkerId work_uniq fn_id (exprType work_rhs) + `setIdOccInfo` occInfo fn_info + -- Copy over occurrence info from parent + -- Notably whether it's a loop breaker + -- Doesn't matter much, since we will simplify next, but + -- seems right-er to do so + + `setInlinePragma` work_prag + + `setIdUnfolding` mkWorkerUnfolding dflags work_fn fn_unfolding + -- See Note [Worker-wrapper for INLINABLE functions] + + `setIdStrictness` mkClosedStrictSig work_demands div + -- Even though we may not be at top level, + -- it's ok to give it an empty DmdEnv + + `setIdCprInfo` mkCprSig work_arity work_cpr_info + + `setIdDemandInfo` worker_demand + + `setIdArity` work_arity + -- Set the arity so that the Core Lint check that the + -- arity is consistent with the demand type goes + -- through + `asJoinId_maybe` work_join_arity + + work_arity = length work_demands + + -- See Note [Demand on the Worker] + single_call = saturatedByOneShots arity (demandInfo fn_info) + worker_demand | single_call = mkWorkerDemand work_arity + | otherwise = topDmd + + wrap_rhs = wrap_fn work_id + wrap_act = case fn_act of -- See Note [Wrapper activation] + ActiveAfter {} -> fn_act + NeverActive -> activeDuringFinal + _ -> activeAfterInitial + wrap_prag = InlinePragma { inl_src = SourceText "{-# INLINE" + , inl_inline = NoUserInline + , inl_sat = Nothing + , inl_act = wrap_act + , inl_rule = rule_match_info } + -- inl_act: see Note [Wrapper activation] + -- inl_inline: see Note [Wrapper NoUserInline] + -- inl_rule: RuleMatchInfo is (and must be) unaffected + + wrap_id = fn_id `setIdUnfolding` mkWwInlineRule dflags wrap_rhs arity + `setInlinePragma` wrap_prag + `setIdOccInfo` noOccInfo + -- Zap any loop-breaker-ness, to avoid bleating from Lint + -- about a loop breaker with an INLINE rule + fn_inl_prag = inlinePragInfo fn_info fn_inline_spec = inl_inline fn_inl_prag fn_act = inl_act fn_inl_prag rule_match_info = inlinePragmaRuleMatchInfo fn_inl_prag fn_unfolding = unfoldingInfo fn_info - arity = arityInfo fn_info - -- The arity is set by the simplifier using exprEtaExpandArity - -- So it may be more than the number of top-level-visible lambdas - -- use_cpr_info is the CPR we w/w for. Note that we kill it for join points, - -- see Note [Don't w/w join points for CPR]. - use_cpr_info | isJoinId fn_id = topCpr - | otherwise = cpr -- Even if we don't w/w join points for CPR, we might still do so for -- strictness. In which case a join point worker keeps its original CPR -- property; see Note [Don't w/w join points for CPR]. Otherwise, the worker ===================================== compiler/GHC/Core/Unfold.hs ===================================== @@ -1147,11 +1147,21 @@ certainlyWillInline :: DynFlags -> IdInfo -> Maybe Unfolding -- ^ Sees if the unfolding is pretty certain to inline. -- If so, return a *stable* unfolding for it, that will always inline. certainlyWillInline dflags fn_info - = case unfoldingInfo fn_info of - CoreUnfolding { uf_tmpl = e, uf_guidance = g } - | loop_breaker -> Nothing -- Won't inline, so try w/w - | noinline -> Nothing -- See Note [Worker-wrapper for NOINLINE functions] - | otherwise -> do_cunf e g -- Depends on size, so look at that + = case fn_unf of + CoreUnfolding { uf_tmpl = expr, uf_guidance = guidance, uf_src = src } + | loop_breaker -> Nothing -- Won't inline, so try w/w + | noinline -> Nothing -- See Note [Worker-wrapper for NOINLINE functions] + | otherwise + -> case guidance of + UnfNever -> Nothing + UnfWhen {} -> Just (fn_unf { uf_src = src' }) + -- INLINE functions have UnfWhen + UnfIfGoodArgs { ug_size = size, ug_args = args } + -> do_cunf expr size args src' + where + src' = case src of + InlineRhs -> InlineStable + _ -> src -- Do not change InlineCompulsory! DFunUnfolding {} -> Just fn_unf -- Don't w/w DFuns; it never makes sense -- to do so, and even if it is currently a @@ -1164,17 +1174,12 @@ certainlyWillInline dflags fn_info noinline = inlinePragmaSpec (inlinePragInfo fn_info) == NoInline fn_unf = unfoldingInfo fn_info - do_cunf :: CoreExpr -> UnfoldingGuidance -> Maybe Unfolding - do_cunf _ UnfNever = Nothing - do_cunf _ (UnfWhen {}) = Just (fn_unf { uf_src = InlineStable }) - -- INLINE functions have UnfWhen - -- The UnfIfGoodArgs case seems important. If we w/w small functions -- binary sizes go up by 10%! (This is with SplitObjs.) -- I'm not totally sure why. -- INLINABLE functions come via this path -- See Note [certainlyWillInline: INLINABLE] - do_cunf expr (UnfIfGoodArgs { ug_size = size, ug_args = args }) + do_cunf expr size args src' | arityInfo fn_info > 0 -- See Note [certainlyWillInline: be careful of thunks] , not (isBottomingSig (strictnessInfo fn_info)) -- Do not unconditionally inline a bottoming functions even if @@ -1182,7 +1187,7 @@ certainlyWillInline dflags fn_info -- so we don't want to re-inline it. , let unf_arity = length args , size - (10 * (unf_arity + 1)) <= ufUseThreshold dflags - = Just (fn_unf { uf_src = InlineStable + = Just (fn_unf { uf_src = src' , uf_guidance = UnfWhen { ug_arity = unf_arity , ug_unsat_ok = unSaturatedOk , ug_boring_ok = inlineBoringOk expr } }) ===================================== testsuite/tests/dependent/should_compile/dynamic-paper.stderr ===================================== @@ -12,4 +12,4 @@ Simplifier ticks exhausted simplifier non-termination has been judged acceptable. To see detailed counts use -ddump-simpl-stats - Total ticks: 140086 + Total ticks: 159723 ===================================== testsuite/tests/driver/inline-check.stderr ===================================== @@ -21,6 +21,7 @@ Considering inlining: foo some_benefit False is exp: True is work-free: True - guidance ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + guidance IF_ARGS [0] 30 0 + discounted size = 20 ANSWER = NO Inactive unfolding: foo1 ===================================== testsuite/tests/numeric/should_compile/T14465.stdout ===================================== @@ -82,10 +82,8 @@ plusOne :: Natural -> Natural [GblId, 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= \ (n [Occ=Once] :: Natural) -> plusNatural n M.minusOne1}] + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [0] 30 0}] plusOne = \ (n :: Natural) -> plusNatural n M.minusOne1 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} ===================================== testsuite/tests/perf/compiler/T16473.stdout ===================================== @@ -2,10 +2,10 @@ Rule fired: Class op fmap (BUILTIN) Rule fired: Class op liftA2 (BUILTIN) Rule fired: Class op $p1Applicative (BUILTIN) Rule fired: Class op <*> (BUILTIN) -Rule fired: Class op <$ (BUILTIN) +Rule fired: Class op fmap (BUILTIN) Rule fired: Class op $p1Applicative (BUILTIN) Rule fired: Class op <*> (BUILTIN) -Rule fired: Class op fmap (BUILTIN) +Rule fired: Class op <$ (BUILTIN) Rule fired: Class op pure (BUILTIN) Rule fired: Class op pure (BUILTIN) Rule fired: Class op >>= (BUILTIN) @@ -104,7 +104,6 @@ Rule fired: Class op fmap (BUILTIN) Rule fired: Class op fmap (BUILTIN) Rule fired: Class op >>= (BUILTIN) Rule fired: Class op >>= (BUILTIN) -Rule fired: Class op fmap (BUILTIN) Rule fired: SPEC/Main $fFunctorStateT @Identity _ (Main) Rule fired: SPEC/Main $fApplicativeStateT_$cpure @Identity _ (Main) Rule fired: SPEC/Main $fApplicativeStateT_$c<*> @Identity _ (Main) ===================================== testsuite/tests/simplCore/should_compile/T4201.stdout ===================================== @@ -1,3 +1,3 @@ + lift :: Foo -> T [HasNoCafRefs, Arity: 1, Strictness: , CPR: m1, - Unfolding: InlineRule (0, True, True) - bof `cast` (Sym (N:Foo[0]) ->_R _R)] + Unfolding: (bof `cast` (Sym (N:Foo[0]) ->_R _R))] ===================================== testsuite/tests/simplCore/should_compile/T5658b.stdout ===================================== @@ -1 +1 @@ -4 +2 ===================================== testsuite/tests/warnings/should_compile/T16282/T16282.stderr ===================================== @@ -5,6 +5,5 @@ T16282.hs: warning: [-Wall-missed-specialisations] Probable fix: add INLINABLE pragma on ‘Data.Foldable.$wmapM_’ T16282.hs: warning: [-Wall-missed-specialisations] - Could not specialise imported function ‘Data.Map.Internal.$w$cshowsPrec’ - when specialising ‘Data.Map.Internal.$fShowMap_$cshowsPrec’ - Probable fix: add INLINABLE pragma on ‘Data.Map.Internal.$w$cshowsPrec’ + Could not specialise imported function ‘Data.Map.Internal.$fShowMap_$cshow’ + Probable fix: add INLINABLE pragma on ‘Data.Map.Internal.$fShowMap_$cshow’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/88d5964b0c1261c6dfbcd2bfd42c3dfc7351e333...761e957095ebb15cb67ebffca0390c16643511c9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/88d5964b0c1261c6dfbcd2bfd42c3dfc7351e333...761e957095ebb15cb67ebffca0390c16643511c9 You're receiving 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 Mar 19 10:42:18 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Thu, 19 Mar 2020 06:42:18 -0400 Subject: [Git][ghc/ghc][wip/haddock-accum] 48 commits: pretty-printer: Properly parenthesise LastStmt Message-ID: <5e734c8a25454_488a3fc6a691ddac20680db@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/haddock-accum at Glasgow Haskell Compiler / GHC Commits: 1f9db3e7 by Kirill Elagin at 2020-03-12T13:45:51Z 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-12T13:45:51Z 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-12T13:46:29Z 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-13T06:29:20Z 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-13T06:30:22Z 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-13T06:31:03Z Update documentation for closureSize - - - - - f124ff0d by Ben Gamari at 2020-03-13T06:31:40Z gitlab-ci: Rework triggering of release builds Use a push option instead of tagging. - - - - - 7f25557a by Ben Gamari at 2020-03-13T14:38:09Z 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-14T09:25:30Z 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-14T09:26:11Z 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-14T09:26:49Z Make: refactor GMP rules Document and use simpler rules for the ghc-gmp.h header. - - - - - 7432b327 by Sylvain Henry at 2020-03-14T09:27:28Z Use correct option name (-opti) (fix #17314) s/pgmo/opti - - - - - 8f7dd571 by Judah Jacobson at 2020-03-14T09:28:07Z 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-14T09:28:07Z Use AC_ARG_VAR for LD_STAGE0 and AR_STAGE0. - - - - - 20d4d676 by Ben Gamari at 2020-03-14T09:28:43Z 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-14T09:29:18Z 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-14T09:29:55Z 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-14T09:29:55Z 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-14T09:30:31Z gitlab-ci: Add integer-simple release build for Windows Closes #16144. - - - - - e3c374cc by Simon Peyton Jones at 2020-03-14T09:31:07Z 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-14T09:31:07Z 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-14T09:31:42Z 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-14T09:32:18Z 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-14T23:34:42Z Enable stage1 build of haddock The submodule has already been bumped to contain the fix. - - - - - 49e9d739 by Ömer Sinan Ağacan at 2020-03-14T23:35:24Z rts: Fix printClosure when printing fwd ptrs - - - - - 1de3ab4a by Krzysztof Gogolewski at 2020-03-14T23:36:04Z Remove unused field var_inline (#17915) - - - - - d30aeb4b by Krzysztof Gogolewski at 2020-03-15T07:57:41Z 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-15T07:58:18Z Remove some dead code >From the notes.ghc.drop list found using weeder in #17713 - - - - - dd6ffe6b by Viktor Dukhovni at 2020-03-15T07:58:55Z 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-15T14:57:10Z 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-15T14:57:48Z 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-15T14:58:27Z 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-17T03:52:42Z base: add strict IO functions: readFile', getContents', hGetContents' - - - - - 18a346a4 by Sylvain Henry at 2020-03-17T03:53:24Z Modules: Core (#13009) Update submodule: haddock - - - - - 92327e3a by Ömer Sinan Ağacan at 2020-03-17T03:54:04Z 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-17T11:36:09Z 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-17T11:36:48Z 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-17T11:37:25Z 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-17T11:38:08Z 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-17T11:38:48Z Add example for Data.Semigroup.diff - - - - - 4d85d68b by Paavo at 2020-03-17T11:38:48Z Clean up - - - - - 75168d07 by Paavo at 2020-03-17T11:38:48Z Make example collapsible - - - - - 53ff2cd0 by Richard Eisenberg at 2020-03-17T13:46:57Z 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-18T14:06:43Z Modules: Core operations (#13009) - - - - - 4e8a71c1 by Richard Eisenberg at 2020-03-18T14:07:19Z 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-19T04:39:27Z 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-19T04:40:06Z 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. - - - - - 2029a899 by Vladislav Zavialov at 2020-03-19T10:41:57Z Accumulate Haddock comments in P (#17544, #17561) 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). Metric Increase: T13719 ManyConstructors haddock.Cabal haddock.base haddock.compiler - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/InfoTable.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Dataflow/Block.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/BlockLayout.hs - compiler/GHC/CmmToAsm/CFG.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/Instr.hs - compiler/GHC/CmmToAsm/Monad.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Instr.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/PPC/Regs.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Graph.hs - compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs - compiler/GHC/CmmToAsm/Reg/Linear.hs - compiler/GHC/CmmToAsm/Reg/Linear/Base.hs - compiler/GHC/CmmToAsm/Reg/Linear/FreeRegs.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/e1f98f735adf2a49277084532be9ebdbcc4f98e6...2029a8999fb6c76656b25495e0bb9bb15bd00cea -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/e1f98f735adf2a49277084532be9ebdbcc4f98e6...2029a8999fb6c76656b25495e0bb9bb15bd00cea You're receiving 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 Mar 20 17:47:46 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Fri, 20 Mar 2020 13:47:46 -0400 Subject: [Git][ghc/ghc][wip/T16296] 62 commits: anyRewritableTyVar now looks in RuntimeReps Message-ID: <5e7501c29bd37_488a8eac470237414@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T16296 at Glasgow Haskell Compiler / GHC Commits: 5fa9cb82 by Richard Eisenberg at 2020-03-10T16:29:46Z 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-10T16:30:27Z 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-10T16:31:15Z Comments only Clarify code added in #17852 and MR !2724 - - - - - 3300eeac by Krzysztof Gogolewski at 2020-03-10T16:31:54Z 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-10T17:05:01Z Typos in comments [skip ci] - - - - - bb586f89 by Ben Gamari at 2020-03-11T04:14:59Z 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-11T12:17:19Z 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-11T12:17:56Z Fixed a minor typo in codegen.rst - - - - - 0bc23338 by Ryan Scott at 2020-03-11T12:18:32Z 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-11T12:19:08Z 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-11T12:19:44Z 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-11T12:20:27Z 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-12T00:33:37Z 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-12T00:33:37Z 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-12T00:33:37Z 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-12T00:34:14Z 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-12T13:45:51Z 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-12T13:45:51Z 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-12T13:46:29Z 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-13T06:29:20Z 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-13T06:30:22Z 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-13T06:31:03Z Update documentation for closureSize - - - - - f124ff0d by Ben Gamari at 2020-03-13T06:31:40Z gitlab-ci: Rework triggering of release builds Use a push option instead of tagging. - - - - - 7f25557a by Ben Gamari at 2020-03-13T14:38:09Z 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-14T09:25:30Z 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-14T09:26:11Z 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-14T09:26:49Z Make: refactor GMP rules Document and use simpler rules for the ghc-gmp.h header. - - - - - 7432b327 by Sylvain Henry at 2020-03-14T09:27:28Z Use correct option name (-opti) (fix #17314) s/pgmo/opti - - - - - 8f7dd571 by Judah Jacobson at 2020-03-14T09:28:07Z 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-14T09:28:07Z Use AC_ARG_VAR for LD_STAGE0 and AR_STAGE0. - - - - - 20d4d676 by Ben Gamari at 2020-03-14T09:28:43Z 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-14T09:29:18Z 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-14T09:29:55Z 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-14T09:29:55Z 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-14T09:30:31Z gitlab-ci: Add integer-simple release build for Windows Closes #16144. - - - - - e3c374cc by Simon Peyton Jones at 2020-03-14T09:31:07Z 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-14T09:31:07Z 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-14T09:31:42Z 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-14T09:32:18Z 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-14T23:34:42Z Enable stage1 build of haddock The submodule has already been bumped to contain the fix. - - - - - 49e9d739 by Ömer Sinan Ağacan at 2020-03-14T23:35:24Z rts: Fix printClosure when printing fwd ptrs - - - - - 1de3ab4a by Krzysztof Gogolewski at 2020-03-14T23:36:04Z Remove unused field var_inline (#17915) - - - - - d30aeb4b by Krzysztof Gogolewski at 2020-03-15T07:57:41Z 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-15T07:58:18Z Remove some dead code >From the notes.ghc.drop list found using weeder in #17713 - - - - - dd6ffe6b by Viktor Dukhovni at 2020-03-15T07:58:55Z 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-15T14:57:10Z 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-15T14:57:48Z 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-15T14:58:27Z 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-17T03:52:42Z base: add strict IO functions: readFile', getContents', hGetContents' - - - - - 18a346a4 by Sylvain Henry at 2020-03-17T03:53:24Z Modules: Core (#13009) Update submodule: haddock - - - - - 92327e3a by Ömer Sinan Ağacan at 2020-03-17T03:54:04Z 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-17T11:36:09Z 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-17T11:36:48Z 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-17T11:37:25Z 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-17T11:38:08Z 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-17T11:38:48Z Add example for Data.Semigroup.diff - - - - - 4d85d68b by Paavo at 2020-03-17T11:38:48Z Clean up - - - - - 75168d07 by Paavo at 2020-03-17T11:38:48Z Make example collapsible - - - - - 53ff2cd0 by Richard Eisenberg at 2020-03-17T13:46:57Z 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-18T14:06:43Z Modules: Core operations (#13009) - - - - - 4e8a71c1 by Richard Eisenberg at 2020-03-18T14:07:19Z 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. - - - - - 50681bad by Simon Peyton Jones at 2020-03-20T09:15:42Z 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 - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/InfoTable.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Dataflow/Block.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/BlockLayout.hs - compiler/GHC/CmmToAsm/CFG.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/Instr.hs - compiler/GHC/CmmToAsm/Monad.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Instr.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/PPC/Regs.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Graph.hs - compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs - compiler/GHC/CmmToAsm/Reg/Linear.hs - compiler/GHC/CmmToAsm/Reg/Linear/Base.hs - compiler/GHC/CmmToAsm/Reg/Linear/FreeRegs.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/fb25098610f3d431d5ac75b2c07f6014eb02dc54...50681bad7d5632152dffb9e46c810ef3ff581fa1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/fb25098610f3d431d5ac75b2c07f6014eb02dc54...50681bad7d5632152dffb9e46c810ef3ff581fa1 You're receiving 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 Mar 18 15:15:56 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Wed, 18 Mar 2020 11:15:56 -0400 Subject: [Git][ghc/ghc][wip/tycl-group] 40 commits: Fix Lint Message-ID: <5e723b2c9a0f2_488a3fc6ccab21ec193924a@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/tycl-group at Glasgow Haskell Compiler / GHC Commits: c12a2ec5 by Simon Peyton Jones at 2020-03-14T09:25:30Z 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-14T09:26:11Z 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-14T09:26:49Z Make: refactor GMP rules Document and use simpler rules for the ghc-gmp.h header. - - - - - 7432b327 by Sylvain Henry at 2020-03-14T09:27:28Z Use correct option name (-opti) (fix #17314) s/pgmo/opti - - - - - 8f7dd571 by Judah Jacobson at 2020-03-14T09:28:07Z 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-14T09:28:07Z Use AC_ARG_VAR for LD_STAGE0 and AR_STAGE0. - - - - - 20d4d676 by Ben Gamari at 2020-03-14T09:28:43Z 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-14T09:29:18Z 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-14T09:29:55Z 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-14T09:29:55Z 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-14T09:30:31Z gitlab-ci: Add integer-simple release build for Windows Closes #16144. - - - - - e3c374cc by Simon Peyton Jones at 2020-03-14T09:31:07Z 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-14T09:31:07Z 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-14T09:31:42Z 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-14T09:32:18Z 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-14T23:34:42Z Enable stage1 build of haddock The submodule has already been bumped to contain the fix. - - - - - 49e9d739 by Ömer Sinan Ağacan at 2020-03-14T23:35:24Z rts: Fix printClosure when printing fwd ptrs - - - - - 1de3ab4a by Krzysztof Gogolewski at 2020-03-14T23:36:04Z Remove unused field var_inline (#17915) - - - - - d30aeb4b by Krzysztof Gogolewski at 2020-03-15T07:57:41Z 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-15T07:58:18Z Remove some dead code >From the notes.ghc.drop list found using weeder in #17713 - - - - - dd6ffe6b by Viktor Dukhovni at 2020-03-15T07:58:55Z 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-15T14:57:10Z 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-15T14:57:48Z 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-15T14:58:27Z 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-17T03:52:42Z base: add strict IO functions: readFile', getContents', hGetContents' - - - - - 18a346a4 by Sylvain Henry at 2020-03-17T03:53:24Z Modules: Core (#13009) Update submodule: haddock - - - - - 92327e3a by Ömer Sinan Ağacan at 2020-03-17T03:54:04Z 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-17T11:36:09Z 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-17T11:36:48Z 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-17T11:37:25Z 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-17T11:38:08Z 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-17T11:38:48Z Add example for Data.Semigroup.diff - - - - - 4d85d68b by Paavo at 2020-03-17T11:38:48Z Clean up - - - - - 75168d07 by Paavo at 2020-03-17T11:38:48Z Make example collapsible - - - - - 53ff2cd0 by Richard Eisenberg at 2020-03-17T13:46:57Z 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-18T14:06:43Z Modules: Core operations (#13009) - - - - - 4e8a71c1 by Richard Eisenberg at 2020-03-18T14:07:19Z 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. - - - - - caf1dab6 by Vladislav Zavialov at 2020-03-18T15:15:40Z Data family TyClGroup Updates haddock submodule - - - - - 8495a508 by Vladislav Zavialov at 2020-03-18T15:15:42Z tcLookupTcTyCon for kinded decls - - - - - 75b41923 by Vladislav Zavialov at 2020-03-18T15:15:42Z split_group test - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/InfoTable.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Dataflow/Block.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/BlockLayout.hs - compiler/GHC/CmmToAsm/CFG.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/Instr.hs - compiler/GHC/CmmToAsm/Monad.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Instr.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/PPC/Regs.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Graph.hs - compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs - compiler/GHC/CmmToAsm/Reg/Linear.hs - compiler/GHC/CmmToAsm/Reg/Linear/Base.hs - compiler/GHC/CmmToAsm/Reg/Linear/FreeRegs.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/61c1ab8de8d9d682892a8e8857ffcbcf7cfb9f90...75b41923593348964d40ccbcf27b864240fa0658 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/61c1ab8de8d9d682892a8e8857ffcbcf7cfb9f90...75b41923593348964d40ccbcf27b864240fa0658 You're receiving 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 Mar 21 00:43:03 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 20 Mar 2020 20:43:03 -0400 Subject: [Git][ghc/ghc][master] Simplify treatment of heterogeneous equality Message-ID: <5e756317357bf_488a8eac4702404617@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 73a7383e by Richard Eisenberg at 2020-03-21T00:42:56Z 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. - - - - - 30 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/HsToCore/PmCheck.hs - compiler/typecheck/Constraint.hs - compiler/typecheck/TcCanonical.hs - compiler/typecheck/TcErrors.hs - compiler/typecheck/TcFlatten.hs - compiler/typecheck/TcHsType.hs - compiler/typecheck/TcInteract.hs - compiler/typecheck/TcMType.hs - compiler/typecheck/TcOrigin.hs - compiler/typecheck/TcPluginM.hs - compiler/typecheck/TcSMonad.hs - compiler/typecheck/TcSimplify.hs - compiler/typecheck/TcUnify.hs - testsuite/tests/dependent/should_fail/BadTelescope5.stderr - testsuite/tests/dependent/should_fail/T14066.stderr - testsuite/tests/dependent/should_fail/T14066e.stderr - testsuite/tests/ghci.debugger/scripts/break012.stdout - testsuite/tests/indexed-types/should_fail/T14887.stderr - testsuite/tests/indexed-types/should_fail/T3330c.stderr - testsuite/tests/partial-sigs/should_fail/T14584.stderr - testsuite/tests/patsyn/should_fail/T15685.stderr - testsuite/tests/polykinds/T11399.stderr - testsuite/tests/polykinds/T14846.stderr - testsuite/tests/polykinds/T17841.stderr - testsuite/tests/polykinds/T7278.stderr - testsuite/tests/polykinds/T8616.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/73a7383ebc17f495d7acd04007c8c56b46532cb6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/73a7383ebc17f495d7acd04007c8c56b46532cb6 You're receiving 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 Mar 18 04:34:41 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 18 Mar 2020 00:34:41 -0400 Subject: [Git][ghc/ghc][wip/andreask/eqByTag] 437 commits: Fix comment typos Message-ID: <5e71a4e1138ba_488a3fc6f87158a018299f5@gitlab.haskell.org.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: Ben Gamari pushed to branch wip/andreask/eqByTag at Glasgow Haskell Compiler / GHC Commits: d46a72e1 by Gabor Greif at 2019-12-09T17:05:15Z 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 [...] Content analysis details: (5.0 points, 5.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- -0.7 RCVD_IN_DNSWL_LOW RBL: Sender listed at http://www.dnswl.org/, low trust [147.75.105.105 listed in list.dnswl.org] 3.4 DATE_IN_PAST_96_XX Date: is 96 hours or more before Received: date -0.0 T_RP_MATCHES_RCVD Envelope sender domain matches handover relay domain 1.1 URI_HEX URI: URI hostname has long hexadecimal sequence -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.0 T_DKIM_INVALID DKIM-Signature header exists but is not valid 3.1 GAPPY_HTML HTML body with much useless whitespace 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: Ben Gamari Subject: [Git][ghc/ghc][wip/andreask/eqByTag] 437 commits: Fix comment typos Date: Wed, 18 Mar 2020 00:34:41 -0400 Size: 488037 URL: From gitlab at gitlab.haskell.org Thu Mar 19 08:12:05 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Thu, 19 Mar 2020 04:12:05 -0400 Subject: [Git][ghc/ghc][wip/tycl-group] 2 commits: improve tcLookupTcTyCon panic message Message-ID: <5e732955a85a6_488a3fc6f87158a02060834@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/tycl-group at Glasgow Haskell Compiler / GHC Commits: ffeeea14 by Vladislav Zavialov at 2020-03-19T07:47:56Z improve tcLookupTcTyCon panic message - - - - - 5bfed256 by Vladislav Zavialov at 2020-03-19T08:10:45Z accept new test output - - - - - 3 changed files: - compiler/typecheck/TcEnv.hs - testsuite/tests/parser/should_compile/DumpRenamedAst.stderr - testsuite/tests/parser/should_compile/T14189.stderr Changes: ===================================== compiler/typecheck/TcEnv.hs ===================================== @@ -464,7 +464,7 @@ tcLookupTcTyCon name = do thing <- tcLookup name case thing of ATcTyCon tc -> return tc - _ -> pprPanic "tcLookupTcTyCon" (ppr name) + _ -> pprPanic "tcLookupTcTyCon" (ppr name <+> text ":" <+> ppr thing) getInLocalScope :: TcM (Name -> Bool) getInLocalScope = do { lcl_env <- getLclTypeEnv ===================================== testsuite/tests/parser/should_compile/DumpRenamedAst.stderr ===================================== @@ -4,7 +4,12 @@ (Just ((,,,) (HsGroup - (NoExtField) + (KindedDecls + {NameSet: + [{Name: DumpRenamedAst.F1} + ,{Name: DumpRenamedAst.Length} + ,{Name: DumpRenamedAst.Nat} + ,{Name: DumpRenamedAst.Peano}]}) (XValBindsLR (NValBinds [((,) @@ -56,8 +61,7 @@ []))]})] [])) [] - [(TyClGroup - (NoExtField) + [(TcgRn [({ DumpRenamedAst.hs:9:1-30 } (DataDecl (DataDeclRn @@ -109,10 +113,18 @@ ({ } []))))] [] - [] + [(DeclSigRnCUSK + ({ DumpRenamedAst.hs:9:1-30 } + (DeclHeaderRn + (DataTypeFlavour) + ({ DumpRenamedAst.hs:9:6-10 } + {Name: DumpRenamedAst.Peano}) + (HsQTvs + [] + []) + (Nothing))))] []) - ,(TyClGroup - (NoExtField) + ,(TcgRn [({ DumpRenamedAst.hs:11:1-39 } (FamDecl (NoExtField) @@ -229,10 +241,37 @@ {Name: DumpRenamedAst.Peano}))))) (Nothing))))] [] - [] + [(DeclSigRnCUSK + ({ DumpRenamedAst.hs:11:1-39 } + (DeclHeaderRn + (ClosedTypeFamilyFlavour) + ({ DumpRenamedAst.hs:11:13-18 } + {Name: DumpRenamedAst.Length}) + (HsQTvs + [{Name: k}] + [({ DumpRenamedAst.hs:11:21-29 } + (KindedTyVar + (NoExtField) + ({ DumpRenamedAst.hs:11:21-22 } + {Name: as}) + ({ DumpRenamedAst.hs:11:27-29 } + (HsListTy + (NoExtField) + ({ DumpRenamedAst.hs:11:28 } + (HsTyVar + (NoExtField) + (NotPromoted) + ({ DumpRenamedAst.hs:11:28 } + {Name: k})))))))]) + (Just + ({ DumpRenamedAst.hs:11:35-39 } + (HsTyVar + (NoExtField) + (NotPromoted) + ({ DumpRenamedAst.hs:11:35-39 } + {Name: DumpRenamedAst.Peano})))))))] []) - ,(TyClGroup - (NoExtField) + ,(TcgRn [({ DumpRenamedAst.hs:15:1-33 } (FamDecl (NoExtField) @@ -274,7 +313,41 @@ {Name: GHC.Types.Type}))))))))) (Nothing))))] [] - [] + [(DeclSigRnCUSK + ({ DumpRenamedAst.hs:15:1-33 } + (DeclHeaderRn + (DataFamilyFlavour + (Nothing)) + ({ DumpRenamedAst.hs:15:13-15 } + {Name: DumpRenamedAst.Nat}) + (HsQTvs + [{Name: k}] + []) + (Just + ({ DumpRenamedAst.hs:15:20-33 } + (HsFunTy + (NoExtField) + ({ DumpRenamedAst.hs:15:20 } + (HsTyVar + (NoExtField) + (NotPromoted) + ({ DumpRenamedAst.hs:15:20 } + {Name: k}))) + ({ DumpRenamedAst.hs:15:25-33 } + (HsFunTy + (NoExtField) + ({ DumpRenamedAst.hs:15:25 } + (HsTyVar + (NoExtField) + (NotPromoted) + ({ DumpRenamedAst.hs:15:25 } + {Name: k}))) + ({ DumpRenamedAst.hs:15:30-33 } + (HsTyVar + (NoExtField) + (NotPromoted) + ({ DumpRenamedAst.hs:15:30-33 } + {Name: GHC.Types.Type})))))))))))] [({ DumpRenamedAst.hs:(18,1)-(19,45) } (DataFamInstD (NoExtField) @@ -435,8 +508,7 @@ (Nothing)))] ({ } [])))))))]) - ,(TyClGroup - (NoExtField) + ,(TcgRn [({ DumpRenamedAst.hs:21:1-29 } (DataDecl (DataDeclRn @@ -506,8 +578,7 @@ [] [] []) - ,(TyClGroup - (NoExtField) + ,(TcgRn [({ DumpRenamedAst.hs:23:1-48 } (FamDecl (NoExtField) @@ -627,7 +698,52 @@ {Name: GHC.Types.Type}))))) (Nothing))))] [] - [] + [(DeclSigRnCUSK + ({ DumpRenamedAst.hs:23:1-48 } + (DeclHeaderRn + (ClosedTypeFamilyFlavour) + ({ DumpRenamedAst.hs:23:13-14 } + {Name: DumpRenamedAst.F1}) + (HsQTvs + [{Name: k}] + [({ DumpRenamedAst.hs:23:17-22 } + (KindedTyVar + (NoExtField) + ({ DumpRenamedAst.hs:23:17 } + {Name: a}) + ({ DumpRenamedAst.hs:23:22 } + (HsTyVar + (NoExtField) + (NotPromoted) + ({ DumpRenamedAst.hs:23:22 } + {Name: k}))))) + ,({ DumpRenamedAst.hs:23:26-39 } + (KindedTyVar + (NoExtField) + ({ DumpRenamedAst.hs:23:26 } + {Name: f}) + ({ DumpRenamedAst.hs:23:31-39 } + (HsFunTy + (NoExtField) + ({ DumpRenamedAst.hs:23:31 } + (HsTyVar + (NoExtField) + (NotPromoted) + ({ DumpRenamedAst.hs:23:31 } + {Name: k}))) + ({ DumpRenamedAst.hs:23:36-39 } + (HsTyVar + (NoExtField) + (NotPromoted) + ({ DumpRenamedAst.hs:23:36-39 } + {Name: GHC.Types.Type})))))))]) + (Just + ({ DumpRenamedAst.hs:23:45-48 } + (HsTyVar + (NoExtField) + (NotPromoted) + ({ DumpRenamedAst.hs:23:45-48 } + {Name: GHC.Types.Type})))))))] [])] [] [] ===================================== testsuite/tests/parser/should_compile/T14189.stderr ===================================== @@ -4,14 +4,15 @@ (Just ((,,,) (HsGroup - (NoExtField) + (KindedDecls + {NameSet: + []}) (XValBindsLR (NValBinds [] [])) [] - [(TyClGroup - (NoExtField) + [(TcgRn [({ T14189.hs:6:1-42 } (DataDecl (DataDeclRn View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/117800fe7631e454ac7e7db9976c2548bc79f349...5bfed256397ff257023ae2af27c0bc78653905b2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/117800fe7631e454ac7e7db9976c2548bc79f349...5bfed256397ff257023ae2af27c0bc78653905b2 You're receiving 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 Mar 18 13:54:05 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 18 Mar 2020 09:54:05 -0400 Subject: [Git][ghc/ghc][wip/test] gitlab-ci: Backport CI rework from master Message-ID: <5e7227fd148da_488a3fc6f87158a019006df@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/test at Glasgow Haskell Compiler / GHC Commits: de890c82 by Ben Gamari at 2020-03-18T13:53:53Z gitlab-ci: Backport CI rework from master - - - - - 6 changed files: - .gitlab-ci.yml - + .gitlab/ci.sh - − .gitlab/prepare-system.sh - − .gitlab/win32-init.sh - + mk/get-win32-tarballs.py - − mk/get-win32-tarballs.sh Changes: ===================================== .gitlab-ci.yml ===================================== @@ -5,17 +5,16 @@ variables: DOCKER_REV: 408eff66aef6ca2b44446c694c5a56d6ca0460cc # Sequential version number capturing the versions of all tools fetched by - # .gitlab/win32-init.sh. + # .gitlab/ci.sh. WINDOWS_TOOLCHAIN_VERSION: 1 # Disable shallow clones; they break our linting rules GIT_DEPTH: 0 -before_script: - - git submodule sync --recursive - - git submodule update --init --recursive - - git checkout .gitmodules - - "git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/perf || true" + # Overridden by individual jobs + CONFIGURE_ARGS: "" + + GIT_SUBMODULE_STRATEGY: "recursive" stages: - lint # Source linting @@ -36,7 +35,18 @@ stages: - tags - web +.nightly: &nightly + only: + variables: + - $NIGHTLY + artifacts: + when: always + expire_in: 8 weeks + .release: &release + variables: + BUILD_FLAVOUR: "perf" + FLAVOUR: "perf" artifacts: when: always expire_in: 1 year @@ -125,8 +135,7 @@ typecheck-testsuite: - base="$(git merge-base FETCH_HEAD $CI_COMMIT_SHA)" - "echo Linting submodule changes between $base..$CI_COMMIT_SHA" - git submodule foreach git remote update - # TODO: Fix submodule linter - - submodchecker . $(git rev-list $base..$CI_COMMIT_SHA) || true + - submodchecker . $(git rev-list $base..$CI_COMMIT_SHA) dependencies: [] tags: - lint @@ -170,11 +179,7 @@ lint-submods-branch: tags: - lint script: - - | - grep TBA libraries/*/changelog.md && ( - echo "Error: Found \"TBA\"s in changelogs." - exit 1 - ) || exit 0 + - bash .gitlab/linters/check-changelogs.sh lint-changelogs: extends: .lint-changelogs @@ -200,25 +205,10 @@ lint-release-changelogs: variables: FLAVOUR: "validate" script: - - cabal update - - git clean -xdf && git submodule foreach git clean -xdf - - .gitlab/prepare-system.sh - - if [[ -d ./cabal-cache ]]; then cp -R ./.cabal-cache ~/.cabal-cache; fi - - ./boot - - ./configure $CONFIGURE_ARGS - - hadrian/build.cabal.sh --flavour=$FLAVOUR -j`mk/detect-cpu-count.sh` --docs=no-sphinx binary-dist - - mv _build/bindist/ghc*.tar.xz ghc.tar.xz - - export TOP=$(pwd) - - cd _build/bindist/ghc-*/ && ./configure --prefix=$TOP/_build/install && make install && cd ../../../ - - | - # Prepare to push git notes. - export METRICS_FILE=$CI_PROJECT_DIR/performance-metrics.tsv - git config user.email "ben+ghc-ci at smart-cactus.org" - git config user.name "GHC GitLab CI" - - hadrian/build.cabal.sh --flavour=$FLAVOUR -j`mk/detect-cpu-count.sh` --docs=no-sphinx test --summary-junit=./junit.xml --test-compiler=$TOP/_build/install/bin/ghc || (.gitlab/push-test-metrics.sh && false) - - | - # Push git notes. - .gitlab/push-test-metrics.sh + - .gitlab/ci.sh setup + - .gitlab/ci.sh configure + - .gitlab/ci.sh build_hadrian + - .gitlab/ci.sh test_hadrian cache: key: hadrian paths: @@ -243,6 +233,8 @@ lint-release-changelogs: - git submodule update --init --recursive - git checkout .gitmodules - "git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/perf || true" + after_script: + - .gitlab/ci.sh clean tags: - x86_64-linux @@ -275,7 +267,7 @@ hadrian-ghc-in-ghci: - cabal update - cd hadrian; cabal new-build --project-file=ci.project; cd .. - git clean -xdf && git submodule foreach git clean -xdf - - .gitlab/prepare-system.sh + - .gitlab/ci.sh setup - if [[ -d ./cabal-cache ]]; then cp -R ./.cabal-cache ~/.cabal-cache; fi - ./boot - ./configure $CONFIGURE_ARGS @@ -294,27 +286,12 @@ hadrian-ghc-in-ghci: <<: *only-default variables: TEST_TYPE: test - before_script: - - git clean -xdf && git submodule foreach git clean -xdf + MAKE_ARGS: "-Werror" script: - - ./boot - - ./configure $CONFIGURE_ARGS - - | - THREADS=`mk/detect-cpu-count.sh` - make V=0 -j$THREADS WERROR=-Werror - - make binary-dist-prep TAR_COMP_OPTS="-1" - - make test_bindist TEST_PREP=YES - - | - # Prepare to push git notes. - METRICS_FILE=$CI_PROJECT_DIR/performance-metrics.tsv - git config user.email "ben+ghc-ci at smart-cactus.org" - git config user.name "GHC GitLab CI" - - | - THREADS=`mk/detect-cpu-count.sh` - make $TEST_TYPE THREADS=$THREADS JUNIT_FILE=../../junit.xml METRICS_FILE=$METRICS_FILE || (METRICS_FILE=$METRICS_FILE .gitlab/push-test-metrics.sh && false) - - | - # Push git notes. - METRICS_FILE=$METRICS_FILE .gitlab/push-test-metrics.sh + - .gitlab/ci.sh setup + - .gitlab/ci.sh configure + - .gitlab/ci.sh build_make + - .gitlab/ci.sh test_make dependencies: [] artifacts: reports: @@ -325,6 +302,79 @@ hadrian-ghc-in-ghci: - junit.xml - performance-metrics.tsv +################################# +# x86_64-freebsd +################################# + +.build-x86_64-freebsd: + extends: .validate + tags: + - x86_64-freebsd + allow_failure: true + variables: + # N.B. we use iconv from ports as I see linker errors when we attempt + # to use the "native" iconv embedded in libc as suggested by the + # porting guide [1]. + # [1] https://www.freebsd.org/doc/en/books/porters-handbook/using-iconv.html) + CONFIGURE_ARGS: "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib" + GHC_VERSION: 8.6.3 + CABAL_INSTALL_VERSION: 3.0.0.0 + BIN_DIST_PREP_TAR_COMP: "ghc-x86_64-portbld-freebsd.tar.xz" + TEST_ENV: "x86_64-freebsd" + BUILD_FLAVOUR: "validate" + after_script: + - cp -Rf $HOME/.cabal cabal-cache + - .gitlab/ci.sh clean + artifacts: + when: always + expire_in: 2 week + cache: + key: "freebsd-$GHC_VERSION" + paths: + - cabal-cache + - toolchain + +# Disabled due to lack of builder capacity +.validate-x86_64-freebsd: + extends: .build-x86_64-freebsd + stage: full-build + +nightly-x86_64-freebsd: + <<: *nightly + extends: .build-x86_64-freebsd + stage: full-build + +.build-x86_64-freebsd-hadrian: + extends: .validate-hadrian + stage: full-build + tags: + - x86_64-freebsd + allow_failure: true + variables: + CONFIGURE_ARGS: "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib" + HADRIAN_ARGS: "--docs=no-sphinx" + GHC_VERSION: 8.6.3 + CABAL_INSTALL_VERSION: 3.0.0.0 + BIN_DIST_PREP_TAR_COMP: "ghc-x86_64-portbld-freebsd.tar.xz" + TEST_ENV: "x86_64-freebsd-hadrian" + FLAVOUR: "validate" + after_script: + - cp -Rf $HOME/.cabal cabal-cache + - .gitlab/ci.sh clean + artifacts: + when: always + expire_in: 2 week + cache: + key: "freebsd-$GHC_VERSION" + paths: + - cabal-cache + - toolchain + +# Disabled due to lack of builder capacity +.validate-x86_64-freebsd-hadrian: + extends: .build-x86_64-freebsd-hadrian + stage: full-build + ################################# # x86_64-darwin ################################# @@ -335,28 +385,19 @@ validate-x86_64-darwin: tags: - x86_64-darwin variables: - GHC_VERSION: 8.8.3 - CABAL_INSTALL_VERSION: 2.4.1.0 + GHC_VERSION: 8.6.5 + CABAL_INSTALL_VERSION: 3.0.0.0 BIN_DIST_PREP_TAR_COMP: "ghc-x86_64-apple-darwin.tar.xz" MACOSX_DEPLOYMENT_TARGET: "10.7" # Only Sierra and onwards supports clock_gettime. See #12858 ac_cv_func_clock_gettime: "no" - # Only Mojave and onwards supports utimensat. See #17895 - ac_cv_func_utimensat: "no" LANG: "en_US.UTF-8" - CONFIGURE_ARGS: --with-intree-gmp + CONFIGURE_ARGS: "--with-intree-gmp" TEST_ENV: "x86_64-darwin" - before_script: - - git clean -xdf && git submodule foreach git clean -xdf - - git submodule sync --recursive - - git submodule update --init --recursive - - git checkout .gitmodules - - "git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/perf || true" - - - bash .gitlab/darwin-init.sh - - PATH="`pwd`/toolchain/bin:$PATH" + BUILD_FLAVOUR: "perf" after_script: - cp -Rf $HOME/.cabal cabal-cache + - .gitlab/ci.sh clean artifacts: when: always expire_in: 2 week @@ -373,33 +414,21 @@ validate-x86_64-darwin: tags: - x86_64-darwin variables: - GHC_VERSION: 8.8.3 + GHC_VERSION: 8.6.3 MACOSX_DEPLOYMENT_TARGET: "10.7" ac_cv_func_clock_gettime: "no" LANG: "en_US.UTF-8" CONFIGURE_ARGS: --with-intree-gmp TEST_ENV: "x86_64-darwin-hadrian" FLAVOUR: "validate" - before_script: - - git clean -xdf && git submodule foreach git clean -xdf - - git submodule sync --recursive - - git submodule update --init --recursive - - git checkout .gitmodules - - "git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/perf || true" - - - bash .gitlab/darwin-init.sh - - PATH="`pwd`/toolchain/bin:$PATH" script: - - cabal update - - ./boot - - ./configure $CONFIGURE_ARGS - - hadrian/build.cabal.sh --flavour=$FLAVOUR -j`mk/detect-cpu-count.sh` --docs=no-sphinx binary-dist - - mv _build/bindist/ghc*.tar.xz ghc.tar.xz - - export TOP=$(pwd) - - cd _build/bindist/ghc-*/ && ./configure --prefix=$TOP/_build/install && make install && cd ../../../ - - hadrian/build.cabal.sh --flavour=$FLAVOUR -j`mk/detect-cpu-count.sh` --docs=no-sphinx test --summary-junit=./junit.xml --test-compiler=$TOP/_build/install/bin/ghc + - .gitlab/ci.sh setup + - .gitlab/ci.sh configure + - .gitlab/ci.sh build_hadrian + - .gitlab/ci.sh test_hadrian after_script: - cp -Rf $HOME/.cabal cabal-cache + - .gitlab/ci.sh clean artifacts: when: always expire_in: 2 week @@ -413,19 +442,15 @@ validate-x86_64-darwin: extends: .validate tags: - x86_64-linux + variables: + BUILD_FLAVOUR: "perf" before_script: - - git clean -xdf && git submodule foreach git clean -xdf - - git submodule sync --recursive - - git submodule update --init --recursive - - git checkout .gitmodules - - "git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/perf || true" # Build hyperlinked sources for documentation when building releases - | if [[ -n "$CI_COMMIT_TAG" ]]; then - echo "EXTRA_HADDOCK_OPTS += --hyperlinked-source --quickjump" >> mk/build.mk + HADDOCK_HYPERLINKED_SOURCES=1 fi - - .gitlab/prepare-system.sh # workaround for docker permissions - sudo chown ghc:ghc -R . after_script: @@ -460,14 +485,10 @@ validate-aarch64-linux-deb9: expire_in: 2 week nightly-aarch64-linux-deb9: + <<: *nightly extends: .build-aarch64-linux-deb9 - artifacts: - expire_in: 2 year variables: TEST_TYPE: slowtest - only: - variables: - - $NIGHTLY ################################# # armv7-linux-deb9 @@ -477,7 +498,6 @@ nightly-aarch64-linux-deb9: extends: .validate-linux stage: full-build image: "registry.gitlab.haskell.org/ghc/ci-images/armv7-linux-deb9:$DOCKER_REV" - allow_failure: true variables: TEST_ENV: "armv7-linux-deb9" BIN_DIST_PREP_TAR_COMP: "ghc-armv7-linux-deb9.tar.xz" @@ -494,14 +514,10 @@ validate-armv7-linux-deb9: expire_in: 2 week nightly-armv7-linux-deb9: + <<: *nightly extends: .build-armv7-linux-deb9 - artifacts: - expire_in: 2 year variables: TEST_TYPE: slowtest - only: - variables: - - $NIGHTLY ################################# # i386-linux-deb9 @@ -524,15 +540,10 @@ validate-i386-linux-deb9: expire_in: 2 week nightly-i386-linux-deb9: + <<: *nightly extends: .build-i386-linux-deb9 variables: TEST_TYPE: slowtest - artifacts: - when: always - expire_in: 2 week - only: - variables: - - $NIGHTLY ################################# # x86_64-linux-deb9 @@ -561,20 +572,16 @@ release-x86_64-linux-deb9: stage: full-build nightly-x86_64-linux-deb9: + <<: *nightly extends: .build-x86_64-linux-deb9 stage: full-build - artifacts: - expire_in: 2 year variables: TEST_TYPE: slowtest - only: - variables: - - $NIGHTLY # N.B. Has DEBUG assertions enabled in stage2 validate-x86_64-linux-deb9-debug: extends: .build-x86_64-linux-deb9 - stage: build + stage: full-build variables: BUILD_FLAVOUR: validate # Ensure that stage2 also has DEBUG enabled @@ -583,7 +590,7 @@ validate-x86_64-linux-deb9-debug: BUILD_SPHINX_PDF: "YES" TEST_TYPE: slowtest TEST_ENV: "x86_64-linux-deb9-debug" - BIN_DIST_PREP_COMP: "ghc-x86_64-deb9-linux-debug.tar.xz" + BIN_DIST_PREP_TAR_COMP: "ghc-x86_64-deb9-linux-debug.tar.xz" artifacts: when: always expire_in: 2 week @@ -597,39 +604,34 @@ validate-x86_64-linux-deb9-debug: TEST_ENV: "x86_64-linux-deb9-llvm" nightly-x86_64-linux-deb9-llvm: + <<: *nightly extends: .build-x86_64-linux-deb9 stage: full-build variables: BUILD_FLAVOUR: perf-llvm TEST_ENV: "x86_64-linux-deb9-llvm" - only: - variables: - - $NIGHTLY validate-x86_64-linux-deb9-integer-simple: extends: .build-x86_64-linux-deb9 stage: full-build variables: + BUILD_FLAVOUR: validate INTEGER_LIBRARY: integer-simple - TEST_ENV: "x86_64-linux-deb9-integer-simple" + TEST_ENV: "x86_64-linux-deb9-integer-simple-validate" BIN_DIST_PREP_TAR_COMP: "ghc-x86_64-deb9-linux-integer-simple.tar.xz" nightly-x86_64-linux-deb9-integer-simple: + <<: *nightly extends: .build-x86_64-linux-deb9 stage: full-build variables: INTEGER_LIBRARY: integer-simple TEST_ENV: "x86_64-linux-deb9-integer-simple" TEST_TYPE: slowtest - artifacts: - expire_in: 2 year - only: - variables: - - $NIGHTLY validate-x86_64-linux-deb9-dwarf: extends: .build-x86_64-linux-deb9 - stage: build + stage: full-build variables: CONFIGURE_ARGS: "--enable-dwarf-unwind" BUILD_FLAVOUR: dwarf @@ -656,14 +658,10 @@ validate-x86_64-linux-deb9-dwarf: stage: full-build nightly-x86_64-linux-deb10: + <<: *nightly extends: .build-x86_64-linux-deb10 - artifacts: - expire_in: 2 weeks variables: TEST_TYPE: slowtest - only: - variables: - - $NIGHTLY release-x86_64-linux-deb10: <<: *release @@ -698,19 +696,21 @@ release-x86_64-linux-deb8: # x86_64-linux-alpine ################################# -.build-x86_64-linux-alpine: - extends: .validate-linux +.build-x86_64-linux-alpine-hadrian: + extends: .validate-linux-hadrian stage: full-build image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine:$DOCKER_REV" # There are currently a few failing tests allow_failure: true variables: - BUILD_SPHINX_PDF: "NO" TEST_ENV: "x86_64-linux-alpine" BIN_DIST_PREP_TAR_COMP: "ghc-x86_64-alpine-linux.tar.xz" # Can't use ld.gold due to #13958. CONFIGURE_ARGS: "--disable-ld-override" - INTEGER_LIBRARY: "integer-simple" + HADRIAN_ARGS: "--docs=no-sphinx" + # encoding004 due to lack of locale support + # T10458 due to fact that dynamic linker tries to reload libAS + BROKEN_TESTS: "encoding004 T10458" cache: key: linux-x86_64-alpine artifacts: @@ -719,13 +719,11 @@ release-x86_64-linux-deb8: release-x86_64-linux-alpine: <<: *release - extends: .build-x86_64-linux-alpine + extends: .build-x86_64-linux-alpine-hadrian nightly-x86_64-linux-alpine: - extends: .build-x86_64-linux-alpine - only: - variables: - - $NIGHTLY + <<: *nightly + extends: .build-x86_64-linux-alpine-hadrian ################################# # x86_64-linux-centos7 @@ -775,58 +773,49 @@ validate-x86_64-linux-fedora27: .build-windows: <<: *only-default + # For the reasons given in #17777 this build isn't reliable. + allow_failure: true before_script: - git clean -xdf - - git submodule foreach git clean -xdf - - # Use a local temporary directory to ensure that concurrent builds don't - # interfere with one another - - | - mkdir tmp - set TMP=%cd%\tmp - set TEMP=%cd%\tmp - - set PATH=C:\msys64\usr\bin;%PATH% - - git submodule sync --recursive - - git submodule update --init --recursive - - git checkout .gitmodules - - "git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/perf || true" - - bash .gitlab/win32-init.sh + # Setup toolchain + - bash .gitlab/ci.sh setup after_script: - - rd /s /q tmp - - robocopy /np /nfl /ndl /e "%APPDATA%\cabal" cabal-cache - - bash -c 'make clean || true' + - | + Copy-Item -Recurse -Path $Env:APPDATA\cabal -Destination cabal-cache + - bash .gitlab/ci.sh clean dependencies: [] variables: - FORCE_SYMLINKS: 1 + #FORCE_SYMLINKS: 1 LANG: "en_US.UTF-8" SPHINXBUILD: "/mingw64/bin/sphinx-build.exe" + CABAL_INSTALL_VERSION: 3.0.0.0 + GHC_VERSION: "8.8.3" cache: paths: - cabal-cache - - ghc-8.6.5 + - toolchain - ghc-tarballs .build-windows-hadrian: extends: .build-windows stage: full-build variables: - GHC_VERSION: "8.8.3" FLAVOUR: "validate" + # skipping perf tests for now since we build a quick-flavoured GHC, + # which might result in some broken perf tests? + HADRIAN_ARGS: "--docs=no-sphinx --skip-perf" + # due to #16574 this currently fails allow_failure: true + script: - - | - python boot - bash -c './configure --enable-tarballs-autodownload GHC=`pwd`/toolchain/bin/ghc HAPPY=`pwd`/toolchain/bin/happy ALEX=`pwd`/toolchain/bin/alex' - - bash -c "PATH=`pwd`/toolchain/bin:$PATH hadrian/build.cabal.sh --flavour=$FLAVOUR -j`mk/detect-cpu-count.sh` --flavour=Quick --docs=no-sphinx binary-dist" - - mv _build/bindist/ghc*.tar.xz ghc.tar.xz - - bash -c "export TOP=$(pwd); cd _build/bindist/ghc-*/ && PATH=$TOP/toolchain/bin:$PATH ./configure --prefix=$TOP/_build/install && make install && cd ../../../" - - bash -c "export TOP=$(pwd); PATH=$TOP/toolchain/bin:$PATH hadrian/build.cabal.sh --flavour=$FLAVOUR -j`mk/detect-cpu-count.sh` --flavour=quick test --summary-junit=./junit.xml --skip-perf --test-compiler=$TOP/_build/install/bin/ghc" - # skipping perf tests for now since we build a quick-flavoured GHC, - # which might result in some broken perf tests? + - bash .gitlab/ci.sh configure + - bash .gitlab/ci.sh build_hadrian + - bash .gitlab/ci.sh test_hadrian tags: - - x86_64-windows + - new-x86_64-windows + - test artifacts: reports: junit: junit.xml @@ -845,34 +834,27 @@ validate-x86_64-windows-hadrian: key: "x86_64-windows-hadrian-$WINDOWS_TOOLCHAIN_VERSION" nightly-i386-windows-hadrian: + <<: *nightly extends: .build-windows-hadrian variables: MSYSTEM: MINGW32 TEST_ENV: "i386-windows-hadrian" - only: - variables: - - $NIGHTLY cache: key: "i386-windows-hadrian-$WINDOWS_TOOLCHAIN_VERSION" .build-windows-make: extends: .build-windows stage: full-build - allow_failure: true variables: BUILD_FLAVOUR: "quick" - GHC_VERSION: "8.8.3" BIN_DIST_PREP_TAR_COMP: "ghc-x86_64-mingw32.tar.xz" script: - - | - python boot - bash -c './configure --enable-tarballs-autodownload GHC=`pwd`/toolchain/bin/ghc HAPPY=`pwd`/toolchain/bin/happy ALEX=`pwd`/toolchain/bin/alex $CONFIGURE_ARGS' - - bash -c "PATH=`pwd`/toolchain/bin:$PATH make -j`mk/detect-cpu-count.sh`" - - bash -c "PATH=`pwd`/toolchain/bin:$PATH make binary-dist-prep TAR_COMP_OPTS=-1" - - bash -c "PATH=`pwd`/toolchain/bin:$PATH make test_bindist TEST_PREP=YES" - - bash -c 'make V=0 test PYTHON=/mingw64/bin/python3 THREADS=`mk/detect-cpu-count.sh` JUNIT_FILE=../../junit.xml' + - bash .gitlab/ci.sh configure + - bash .gitlab/ci.sh build_make + - bash .gitlab/ci.sh test_make tags: - - x86_64-windows + - new-x86_64-windows + - test artifacts: when: always expire_in: 2 week @@ -880,77 +862,69 @@ nightly-i386-windows-hadrian: junit: junit.xml paths: # N.B. variable interpolation apparently doesn't work on Windows so - # this can't be $BIN_DIST_TAR_COMP + # this can't be $BIN_DIST_PREP_TAR_COMP - "ghc-x86_64-mingw32.tar.xz" - junit.xml -validate-x86_64-windows: +.build-x86_64-windows-make: extends: .build-windows-make variables: MSYSTEM: MINGW64 - CONFIGURE_ARGS: "--target=x86_64-unknown-mingw32" TEST_ENV: "x86_64-windows" cache: key: "x86_64-windows-$WINDOWS_TOOLCHAIN_VERSION" +validate-x86_64-windows: + extends: .build-x86_64-windows-make + nightly-x86_64-windows: - extends: .build-windows-make + <<: *nightly + extends: .build-x86_64-windows-make stage: full-build variables: BUILD_FLAVOUR: "validate" - MSYSTEM: MINGW64 - CONFIGURE_ARGS: "--target=x86_64-unknown-mingw32" - only: - variables: - - $NIGHTLY - cache: - key: "x86_64-windows-$WINDOWS_TOOLCHAIN_VERSION" # Normal Windows validate builds are profiled; that won't do for releases. release-x86_64-windows: <<: *release extends: validate-x86_64-windows variables: - MSYSTEM: MINGW64 BUILD_FLAVOUR: "perf" - CONFIGURE_ARGS: "--target=x86_64-unknown-mingw32" - TEST_ENV: "x86_64-windows" - + # release-x86_64-windows-integer-simple: <<: *release extends: validate-x86_64-windows variables: INTEGER_LIBRARY: integer-simple BUILD_FLAVOUR: "perf" - CONFIGURE_ARGS: "--target=x86_64-unknown-mingw32" - TEST_ENV: "x86_64-windows" -release-i386-windows: - <<: *release + +.build-i386-windows-make: extends: .build-windows-make variables: MSYSTEM: MINGW32 - BUILD_FLAVOUR: "perf" - CONFIGURE_ARGS: "--target=i386-unknown-mingw32" # Due to #15934 BUILD_PROF_LIBS: "NO" TEST_ENV: "i386-windows" + # Due to #17736 + allow_failure: true cache: key: "i386-windows-$WINDOWS_TOOLCHAIN_VERSION" -nightly-i386-windows: - extends: .build-windows-make - only: - variables: - - $NIGHTLY +validate-i386-windows: + extends: .build-i386-windows-make variables: - MSYSTEM: MINGW32 - CONFIGURE_ARGS: "--target=i386-unknown-mingw32" - # Due to #15934 - BUILD_PROF_LIBS: "NO" - TEST_ENV: "i386-windows" - cache: - key: "i386-windows-$WINDOWS_TOOLCHAIN_VERSION" + BUILD_FLAVOUR: "perf" + +release-i386-windows: + <<: *release + extends: .build-i386-windows-make + variables: + BUILD_FLAVOUR: "perf" + +nightly-i386-windows: + <<: *nightly + extends: .build-i386-windows-make ############################################################ # Cleanup @@ -1006,7 +980,7 @@ doc-tarball: - validate-x86_64-linux-deb9-debug - validate-x86_64-windows variables: - LINUX_BINDIST: "ghc-x86_64-deb9-linux.tar.xz" + LINUX_BINDIST: "ghc-x86_64-deb9-linux-debug.tar.xz" WINDOWS_BINDIST: "ghc-x86_64-mingw32.tar.xz" # Due to Windows allow_failure allow_failure: true @@ -1046,7 +1020,7 @@ source-tarball: - ghc-*.tar.xz - version script: - - mk/get-win32-tarballs.sh download all + - python3 mk/get-win32-tarballs.py download all - ./boot - ./configure - make sdist @@ -1089,10 +1063,8 @@ hackage-label: - $CI_MERGE_REQUEST_LABELS =~ /.*user-facing.*/ nightly-hackage: + <<: *nightly extends: .hackage - only: - variables: - - $NIGHTLY ############################################################ # Nofib testing ===================================== .gitlab/ci.sh ===================================== @@ -0,0 +1,453 @@ +#!/usr/bin/env bash +# shellcheck disable=SC2230 + +# This is the primary driver of the GitLab CI infrastructure. + +set -e -o pipefail + +# Configuration: +hackage_index_state="@1579718451" + +# Colors +BLACK="0;30" +GRAY="1;30" +RED="0;31" +LT_RED="1;31" +BROWN="0;33" +LT_BROWN="1;33" +GREEN="0;32" +LT_GREEN="1;32" +BLUE="0;34" +LT_BLUE="1;34" +PURPLE="0;35" +LT_PURPLE="1;35" +CYAN="0;36" +LT_CYAN="1;36" +WHITE="1;37" +LT_GRAY="0;37" + +# GitLab Pipelines log section delimiters +# https://gitlab.com/gitlab-org/gitlab-foss/issues/14664 +start_section() { + name="$1" + echo -e "section_start:$(date +%s):$name\015\033[0K" +} + +end_section() { + name="$1" + echo -e "section_end:$(date +%s):$name\015\033[0K" +} + +echo_color() { + local color="$1" + local msg="$2" + echo -e "\033[${color}m${msg}\033[0m" +} + +error() { echo_color "${RED}" "$1"; } +warn() { echo_color "${LT_BROWN}" "$1"; } +info() { echo_color "${LT_BLUE}" "$1"; } + +fail() { error "error: $1"; exit 1; } + +function run() { + info "Running $*..." + "$@" || ( error "$* failed"; return 1; ) +} + +TOP="$(pwd)" + +function mingw_init() { + case "$MSYSTEM" in + MINGW32) + triple="i386-unknown-mingw32" + boot_triple="i386-unknown-mingw32" # triple of bootstrap GHC + ;; + MINGW64) + triple="x86_64-unknown-mingw32" + boot_triple="x86_64-unknown-mingw32" # triple of bootstrap GHC + ;; + *) + fail "win32-init: Unknown MSYSTEM $MSYSTEM" + ;; + esac + + # Bring mingw toolchain into PATH. + # This is extracted from /etc/profile since this script inexplicably fails to + # run under gitlab-runner. + # shellcheck disable=SC1091 + source /etc/msystem + MINGW_MOUNT_POINT="${MINGW_PREFIX}" + PATH="$MINGW_MOUNT_POINT/bin:$PATH" + + # We always use mingw64 Python to avoid path length issues like #17483. + export PYTHON="/mingw64/bin/python3" +} + +# This will contain GHC's local native toolchain +toolchain="$TOP/toolchain" +mkdir -p "$toolchain/bin" +PATH="$toolchain/bin:$PATH" + +export METRICS_FILE="$CI_PROJECT_DIR/performance-metrics.tsv" + +cores="$(mk/detect-cpu-count.sh)" + +# Use a local temporary directory to ensure that concurrent builds don't +# interfere with one another +mkdir -p "$TOP/tmp" +export TMP="$TOP/tmp" +export TEMP="$TOP/tmp" + +function darwin_setup() { + # It looks like we already have python2 here and just installing python3 + # does not work. + brew upgrade python + brew install ghc cabal-install ncurses gmp + + pip3 install sphinx + # PDF documentation disabled as MacTeX apparently doesn't include xelatex. + #brew cask install mactex +} + +function show_tool() { + local tool="$1" + info "$tool = ${!tool}" + ${!tool} --version +} + +function set_toolchain_paths() { + needs_toolchain=1 + case "$(uname)" in + Linux) needs_toolchain="" ;; + *) ;; + esac + + if [[ -n "$needs_toolchain" ]]; then + # These are populated by setup_toolchain + GHC="$toolchain/bin/ghc$exe" + CABAL="$toolchain/bin/cabal$exe" + HAPPY="$toolchain/bin/happy$exe" + ALEX="$toolchain/bin/alex$exe" + else + GHC="$(which ghc)" + CABAL="/usr/local/bin/cabal" + HAPPY="$HOME/.cabal/bin/happy" + ALEX="$HOME/.cabal/bin/alex" + fi + export GHC + export CABAL + export HAPPY + export ALEX + + # FIXME: Temporarily use ghc from ports + case "$(uname)" in + FreeBSD) GHC="/usr/local/bin/ghc" ;; + *) ;; + esac +} + +# Extract GHC toolchain +function setup() { + if [ -d "$TOP/cabal-cache" ]; then + info "Extracting cabal cache..." + mkdir -p "$cabal_dir" + cp -Rf cabal-cache/* "$cabal_dir" + fi + + if [[ -n "$needs_toolchain" ]]; then + setup_toolchain + fi + case "$(uname)" in + Darwin) darwin_setup ;; + *) ;; + esac + + # Make sure that git works + git config user.email "ghc-ci at gitlab-haskell.org" + git config user.name "GHC GitLab CI" + + info "=====================================================" + info "Toolchain versions" + info "=====================================================" + show_tool GHC + show_tool CABAL + show_tool HAPPY + show_tool ALEX +} + +function fetch_ghc() { + local v="$GHC_VERSION" + if [[ -z "$v" ]]; then + fail "GHC_VERSION is not set" + fi + + if [ ! -e "$GHC" ]; then + start_section "fetch GHC" + url="https://downloads.haskell.org/~ghc/${GHC_VERSION}/ghc-${GHC_VERSION}-${boot_triple}.tar.xz" + info "Fetching GHC binary distribution from $url..." + curl "$url" > ghc.tar.xz || fail "failed to fetch GHC binary distribution" + tar -xJf ghc.tar.xz || fail "failed to extract GHC binary distribution" + case "$(uname)" in + MSYS_*|MINGW*) + cp -r "ghc-${GHC_VERSION}"/* "$toolchain" + ;; + *) + pushd "ghc-${GHC_VERSION}" + ./configure --prefix="$toolchain" + "$MAKE" install + popd + ;; + esac + rm -Rf "ghc-${GHC_VERSION}" ghc.tar.xz + end_section "fetch GHC" + fi + +} + +function fetch_cabal() { + local v="$CABAL_INSTALL_VERSION" + if [[ -z "$v" ]]; then + fail "CABAL_INSTALL_VERSION is not set" + fi + + if [ ! -e "$CABAL" ]; then + start_section "fetch GHC" + case "$(uname)" in + # N.B. Windows uses zip whereas all others use .tar.xz + MSYS_*|MINGW*) + case "$MSYSTEM" in + MINGW32) cabal_arch="i386" ;; + MINGW64) cabal_arch="x86_64" ;; + *) fail "unknown MSYSTEM $MSYSTEM" ;; + esac + url="https://downloads.haskell.org/~cabal/cabal-install-$v/cabal-install-$v-$cabal_arch-unknown-mingw32.zip" + info "Fetching cabal binary distribution from $url..." + curl "$url" > "$TMP/cabal.zip" + unzip "$TMP/cabal.zip" + mv cabal.exe "$CABAL" + ;; + *) + local base_url="https://downloads.haskell.org/~cabal/cabal-install-$v/" + case "$(uname)" in + Darwin) cabal_url="$base_url/cabal-install-$v-x86_64-apple-darwin17.7.0.tar.xz" ;; + FreeBSD) + #cabal_url="$base_url/cabal-install-$v-x86_64-portbld-freebsd.tar.xz" ;; + cabal_url="http://home.smart-cactus.org/~ben/ghc/cabal-install-3.0.0.0-x86_64-portbld-freebsd.tar.xz" ;; + *) fail "don't know where to fetch cabal-install for $(uname)" + esac + echo "Fetching cabal-install from $cabal_url" + curl "$cabal_url" > cabal.tar.xz + tar -xJf cabal.tar.xz + mv cabal "$toolchain/bin" + ;; + esac + end_section "fetch GHC" + fi +} + +# For non-Docker platforms we prepare the bootstrap toolchain +# here. For Docker platforms this is done in the Docker image +# build. +function setup_toolchain() { + fetch_ghc + fetch_cabal + cabal_install="$CABAL v2-install --index-state=$hackage_index_state --installdir=$toolchain/bin" + # Avoid symlinks on Windows + case "$(uname)" in + MSYS_*|MINGW*) cabal_install="$cabal_install --install-method=copy" ;; + *) ;; + esac + + if [ ! -e "$HAPPY" ]; then + info "Building happy..." + cabal update + $cabal_install happy + fi + + if [ ! -e "$ALEX" ]; then + info "Building alex..." + cabal update + $cabal_install alex + fi +} + +function cleanup_submodules() { + start_section "clean submodules" + info "Cleaning submodules..." + # On Windows submodules can inexplicably get into funky states where git + # believes that the submodule is initialized yet its associated repository + # is not valid. Avoid failing in this case with the following insanity. + git submodule sync --recursive || git submodule deinit --force --all + git submodule update --init --recursive + git submodule foreach git clean -xdf + end_section "clean submodules" +} + +function prepare_build_mk() { + if [[ -z "$BUILD_FLAVOUR" ]]; then fail "BUILD_FLAVOUR is not set"; fi + if [[ -z ${BUILD_SPHINX_HTML:-} ]]; then BUILD_SPHINX_HTML=YES; fi + if [[ -z ${BUILD_SPHINX_PDF:-} ]]; then BUILD_SPHINX_PDF=YES; fi + if [[ -z ${INTEGER_LIBRARY:-} ]]; then INTEGER_LIBRARY=integer-gmp; fi + + cat > mk/build.mk <> mk/build.mk + fi + + case "$(uname)" in + Darwin) echo "libraries/integer-gmp_CONFIGURE_OPTS += --configure-option=--with-intree-gmp" >> mk/build.mk ;; + *) ;; + esac + + info "build.mk is:" + cat mk/build.mk +} + +function configure() { + start_section "booting" + run python3 boot + end_section "booting" + + local target_args="" + if [[ -n "$triple" ]]; then + target_args="--target=$triple" + fi + + start_section "configuring" + run ./configure \ + --enable-tarballs-autodownload \ + $target_args \ + $CONFIGURE_ARGS \ + GHC="$GHC" \ + HAPPY="$HAPPY" \ + ALEX="$ALEX" \ + || ( cat config.log; fail "configure failed" ) + end_section "configuring" +} + +function build_make() { + prepare_build_mk + if [[ -z "$BIN_DIST_PREP_TAR_COMP" ]]; then + fail "BIN_DIST_PREP_TAR_COMP is not set" + fi + + echo "include mk/flavours/${BUILD_FLAVOUR}.mk" > mk/build.mk + echo 'GhcLibHcOpts+=-haddock' >> mk/build.mk + run "$MAKE" -j"$cores" $MAKE_ARGS + run "$MAKE" -j"$cores" binary-dist-prep TAR_COMP_OPTS=-1 + ls -lh "$BIN_DIST_PREP_TAR_COMP" +} + +function fetch_perf_notes() { + info "Fetching perf notes..." + "$TOP/.gitlab/test-metrics.sh" pull +} + +function push_perf_notes() { + info "Pushing perf notes..." + "$TOP/.gitlab/test-metrics.sh" push +} + +function test_make() { + run "$MAKE" test_bindist TEST_PREP=YES + run "$MAKE" V=0 test \ + THREADS="$cores" \ + JUNIT_FILE=../../junit.xml +} + +function build_hadrian() { + if [ -z "$FLAVOUR" ]; then + fail "FLAVOUR not set" + fi + + run_hadrian binary-dist + + mv _build/bindist/ghc*.tar.xz ghc.tar.xz +} + +function test_hadrian() { + cd _build/bindist/ghc-*/ + run ./configure --prefix="$TOP"/_build/install + run "$MAKE" install + cd ../../../ + + run_hadrian \ + test \ + --summary-junit=./junit.xml \ + --test-compiler="$TOP"/_build/install/bin/ghc +} + +function clean() { + rm -R tmp + run "$MAKE" --quiet clean || true + run rm -Rf _build +} + +function run_hadrian() { + run hadrian/build.cabal.sh \ + --flavour="$FLAVOUR" \ + -j"$cores" \ + $HADRIAN_ARGS \ + $@ +} + +# A convenience function to allow debugging in the CI environment. +function shell() { + local cmd=$@ + if [ -z "$cmd" ]; then + cmd="bash -i" + fi + run $cmd +} + +# Determine Cabal data directory +case "$(uname)" in + MSYS_*|MINGW*) exe=".exe"; cabal_dir="$APPDATA/cabal" ;; + *) cabal_dir="$HOME/.cabal"; exe="" ;; +esac + +# Platform-specific environment initialization +MAKE="make" +case "$(uname)" in + MSYS_*|MINGW*) mingw_init ;; + Darwin) boot_triple="x86_64-apple-darwin" ;; + FreeBSD) + boot_triple="x86_64-portbld-freebsd" + MAKE="gmake" + ;; + Linux) ;; + *) fail "uname $(uname) is not supported" ;; +esac + +set_toolchain_paths + +case $1 in + setup) setup && cleanup_submodules ;; + configure) configure ;; + build_make) build_make ;; + test_make) fetch_perf_notes; test_make; push_perf_notes ;; + build_hadrian) build_hadrian ;; + test_hadrian) fetch_perf_notes; test_hadrian; push_perf_notes ;; + run_hadrian) run_hadrian $@ ;; + clean) clean ;; + shell) shell $@ ;; + *) fail "unknown mode $1" ;; +esac ===================================== .gitlab/prepare-system.sh deleted ===================================== @@ -1,99 +0,0 @@ -#!/usr/bin/env bash -# vim: sw=2 et -set -euo pipefail - -fail() { - echo "ERROR: $*" >&2 - exit 1 -} - -hackage_index_state="@1522046735" - -if [[ -z ${BUILD_SPHINX_HTML:-} ]]; then BUILD_SPHINX_HTML=YES; fi -if [[ -z ${BUILD_SPHINX_PDF:-} ]]; then BUILD_SPHINX_PDF=YES; fi -if [[ -z ${INTEGER_LIBRARY:-} ]]; then INTEGER_LIBRARY=integer-gmp; fi -if [[ -z ${BUILD_FLAVOUR:-} ]]; then BUILD_FLAVOUR=perf; fi - -if [[ -z ${XZ:-} ]]; then - if which pxz; then - XZ="pxz" - elif which xz; then - # Check whether --threads is supported - if echo "hello" | xz --threads=$CORES >/dev/null; then - XZ="xz --threads=$CORES" - else - XZ="xz" - fi - else - echo "error: neither pxz nor xz were found" - exit 1 - fi -fi -echo "Using $XZ for compression..." - - -cat > mk/build.mk <> mk/build.mk -BuildFlavour=$BUILD_FLAVOUR -ifneq "\$(BuildFlavour)" "" -include mk/flavours/\$(BuildFlavour).mk -endif -GhcLibHcOpts+=-haddock -EOF - -case "$(uname)" in - Linux) - if [[ -n ${TARGET:-} ]]; then - if [[ $TARGET = FreeBSD ]]; then - # cross-compiling to FreeBSD - echo 'HADDOCK_DOCS = NO' >> mk/build.mk - echo 'WERROR=' >> mk/build.mk - # https://circleci.com/docs/2.0/env-vars/#interpolating-environment-variables-to-set-other-environment-variables - echo 'export PATH=/opt/ghc/bin:$PATH' >> $BASH_ENV - else - fail "TARGET=$target not supported" - fi - fi - ;; - - Darwin) - if [[ -n ${TARGET:-} ]]; then - fail "uname=$(uname) not supported for cross-compilation" - fi - # It looks like we already have python2 here and just installing python3 - # does not work. - brew upgrade python - brew install ghc cabal-install ncurses gmp - - pip3 install sphinx - # PDF documentation disabled as MacTeX apparently doesn't include xelatex. - #brew cask install mactex - - cabal update - cabal install --reinstall alex happy haddock hscolour --index-state=$hackage_index_state - # put them on the $PATH, don't fail if already installed - ln -s $HOME/.cabal/bin/alex /usr/local/bin/alex || true - ln -s $HOME/.cabal/bin/happy /usr/local/bin/happy || true - ln -s $HOME/.cabal/bin/HsColour /usr/local/bin/HsColour || true - echo "libraries/integer-gmp_CONFIGURE_OPTS += --configure-option=--with-intree-gmp" >> mk/build.mk - ;; - *) - fail "uname=$(uname) not supported" -esac - -echo "=================================================" -echo "Build.mk:" -echo "" -cat mk/build.mk -echo "=================================================" ===================================== .gitlab/win32-init.sh deleted ===================================== @@ -1,67 +0,0 @@ -#!/bin/bash - -set -e - -toolchain=`pwd`/toolchain -PATH="$toolchain/bin:/mingw64/bin:$PATH" - -if [ -d "`pwd`/cabal-cache" ]; then - cp -Rf cabal-cache $APPDATA/cabal -fi - -if [ ! -e $toolchain/bin/ghc ]; then - case $MSYSTEM in - MINGW32) - triple="i386-unknown-mingw32" - ;; - MINGW64) - triple="x86_64-unknown-mingw32" - ;; - *) - echo "win32-init: Unknown MSYSTEM $MSYSTEM" - exit 1 - ;; - esac - curl https://downloads.haskell.org/~ghc/$GHC_VERSION/ghc-$GHC_VERSION-$triple.tar.xz | tar -xJ - mv ghc-$GHC_VERSION toolchain -fi - -if [ ! -e $toolchain/bin/cabal ]; then - url="https://downloads.haskell.org/~cabal/cabal-install-2.4.1.0/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 - -if [ ! -e $toolchain/bin/happy ]; then - cabal update - cabal install happy - cp $APPDATA/cabal/bin/happy $toolchain/bin -fi - -if [ ! -e $toolchain/bin/alex ]; then - cabal update - cabal install alex - cp $APPDATA/cabal/bin/alex $toolchain/bin -fi - -if [[ -z ${INTEGER_LIBRARY:-} ]]; then INTEGER_LIBRARY=integer-gmp; fi -cat > mk/build.mk < str: + return "{base}/{arch}/{fname}".format( + base=BASE_URL, + arch=arch, + fname=fname) + +def fetch(url: str, dest: Path): + print('Fetching', url, '=>', dest) + urllib.request.urlretrieve(url, dest) + +def fetch_arch(arch: str): + req = urllib.request.urlopen(file_url(arch, 'MANIFEST')) + files = req.read().decode('UTF-8').split('\n') + d = DEST / arch + if not d.is_dir(): + d.mkdir(parents=True) + fetch(file_url(arch, 'SHA256SUMS'), d / 'SHA256SUMS') + for fname in files: + if not (d / fname).is_file(): + fetch(file_url(arch, fname), d / fname) + + verify(arch) + +def verify(arch: str): + cmd = ['sha256sum', '--quiet', '--check', '--ignore-missing', 'SHA256SUMS'] + subprocess.check_call(cmd, cwd=DEST / arch) + +def main() -> None: + parser = argparse.ArgumentParser() + parser.add_argument('mode', choices=['verify', 'download']) + parser.add_argument( + 'arch', + choices=ARCHS + ['all'], + help="Architecture to fetch (either i686, x86_64, sources, or all)") + args = parser.parse_args() + + action = fetch_arch if args.mode == 'download' else verify + if args.arch == 'all': + for arch in ARCHS: + action(arch) + else: + action(args.arch) + +if __name__ == '__main__': + main() ===================================== mk/get-win32-tarballs.sh deleted ===================================== @@ -1,326 +0,0 @@ -#!/usr/bin/env bash - -tarball_dir='ghc-tarballs' -missing_files=0 -pkg_variant="phyx" - -# see #12502 -if test -z "$FIND"; then FIND="find"; fi - -fail() { - echo >&2 - echo "$1" >&2 - exit 1 -} - -download_file() { - local file_url="$1" - local dest_file="$2" - local description="$3" - local extra_curl_opts="$4" - local backup_url="$5" - local dest_dir="$(dirname $dest_file)" - - if ! test -f "${dest_file}" - then - local curl_cmd="curl -f -L ${file_url} -o ${dest_file} --create-dirs -# ${extra_curl_opts}" - if test -n "${backup_url}"; then - local curl_cmd_bnk="curl -f -L ${backup_url} -o ${dest_file} --create-dirs -# ${extra_curl_opts}" - else - local curl_cmd_bnk="true" - fi - - if test "$download" = "0" - then - echo "ERROR: Missing ${description}" >&2 - echo "${file_url}" - missing_files=1 - return - else - echo "Downloading ${description} to ${dest_dir}..." - $curl_cmd || (echo "Checking repo.msys2.org instead of Haskell.org..." && $curl_cmd_bnk) || { - rm -f "${dest_file}" - fail "ERROR: Download failed." - exit 1 - } - fi - fi - - local sig_file="${dest_file}.sig" - if test "$sigs" = "1" -a ! -f "$sig_file" - then - echo "Downloading ${description} (signature) to ${dest_dir}..." - local curl_cmd="curl -f -L ${file_url}.sig -o ${sig_file} --create-dirs -# ${extra_curl_opts}" - if test -n "${backup_url}"; then - local curl_cmd_bnk="curl -f -L "${backup_url}.sig" -o ${sig_file} --create-dirs -# ${extra_curl_opts}" - else - local curl_cmd_bnk="true" - fi - $curl_cmd || (echo "Checking repo.msys2.org instead of Haskell.org..." && $curl_cmd_bnk) || { - rm -f "${dest_file}.sig" - fail "ERROR: Download failed." - exit 1 - } - fi - - if test "$verify" = "1" - then - grep "${dest_file}$" mk/win32-tarballs.md5sum | md5sum --quiet -c - || - fail "ERROR: ${description} appears to be corrupted, please delete it and try again." - fi -} - -download_mingw() { - local mingw_base_url_primary="https://downloads.haskell.org/~ghc/mingw" - local mingw_base_url_secondary="http://repo.msys2.org/mingw" - - if test "$mingw_arch" = "sources" - then - mingw_url_tmp=`echo "$1" | sed -e 's/-any\.pkg\.tar\.xz/\.src\.tar\.gz/' \ - -e 's/-sources-/-/' \ - -e 's/-libwinpthread-git-/-winpthreads-git-/' ` - local mingw_url="${mingw_base_url_primary}/${mingw_url_tmp}" - local mingw_url_backup="${mingw_base_url_secondary}/${mingw_url_tmp}" - else - local mingw_url="${mingw_base_url_primary}/$1" - local mingw_url_backup="${mingw_base_url_secondary}/$1" - fi - - local mingw_toolchain="$(basename $mingw_url)" - local mingw_w64="${tarball_dir}/${tarball_dest_dir}/${mingw_toolchain}" - - download_file "${mingw_url}" "${mingw_w64}" "${mingw_toolchain}" "" "${mingw_url_backup}" - - # Mark the tree as needing updates by deleting the folder - if test -d inplace/mingw && test inplace/mingw -ot "$mingw_w64" ; then - echo "In-tree MinGW-w64 tree requires updates..." - rm -rf inplace/mingw - fi -} - -download_tarballs() { - local package_prefix="mingw-w64" - local format_url="/${mingw_arch}/${package_prefix}-${mingw_arch}" - - download_mingw "${format_url}-crt-git-7.0.0.5491.fe45801e-1-any.pkg.tar.xz" - download_mingw "${format_url}-winpthreads-git-7.0.0.5480.e14d23be-1-any.pkg.tar.xz" - download_mingw "${format_url}-headers-git-7.0.0.5490.9ec54ed1-1-any.pkg.tar.xz" - download_mingw "${format_url}-libwinpthread-git-7.0.0.5480.e14d23be-1-any.pkg.tar.xz" - download_mingw "${format_url}-zlib-1.2.8-9-any.pkg.tar.xz" - download_mingw "${format_url}-isl-0.21-1-any.pkg.tar.xz" - download_mingw "${format_url}-mpfr-4.0.2-2-any.pkg.tar.xz" - download_mingw "${format_url}-gmp-6.1.2-1-any.pkg.tar.xz" - download_mingw "${format_url}-binutils-2.32-3-$pkg_variant.pkg.tar.xz" - download_mingw "${format_url}-libidn2-2.2.0-1-any.pkg.tar.xz" - download_mingw "${format_url}-gcc-9.2.0-1-$pkg_variant.pkg.tar.xz" - download_mingw "${format_url}-mpc-1.1.0-1-any.pkg.tar.xz" - download_mingw "${format_url}-windows-default-manifest-6.4-3-any.pkg.tar.xz" - - # Upstream is unfortunately quite inconsistent in naming - if test "$mingw_arch" != "sources"; then - download_mingw "${format_url}-gcc-libs-9.2.0-1-$pkg_variant.pkg.tar.xz" - fi - - if ! test "$missing_files" = "0" - then - exit 2 - fi -} - -download_i386() { - mingw_arch="i686" - tarball_dest_dir="mingw-w64/i686" - download_tarballs -} - -download_x86_64() { - mingw_arch="x86_64" - tarball_dest_dir="mingw-w64/x86_64" - download_tarballs -} - -download_sources() { - mingw_arch="sources" - tarball_dest_dir="mingw-w64/sources" - download_tarballs -} - -sync_binaries_and_sources() { - gpg --recv-key 5F92EFC1A47D45A1 - - # ensure sources are downloaded - sigs=1 - download_i386 - download_x86_64 - verify=0 - download_sources - - for f in $($FIND ghc-tarballs/mingw-w64 -iname '*.sig'); do - echo "Verifying $f" - gpg --verify $f - done - - md5sum `$FIND ghc-tarballs -type f -a -not -iname '*.sig'` >| mk/win32-tarballs.md5sum - chmod -R ugo+rX ghc-tarballs - - rsync -av ghc-tarballs/mingw-w64/* downloads.haskell.org:public_html/mingw - for f in $($FIND ghc-tarballs/mingw-w64); do - curl -XPURGE http://downloads.haskell.org/~ghc/mingw/$f - done -} - -patch_single_file () { - local patcher_base="$1" - local filename=$(readlink -f "$2") - local filepath=$(dirname "$filename") - local patcher="$patcher_base/iat-patcher.exe" - $patcher install "$filename" > /dev/null - rm -f "$filename.bak" - for file in $patcher_base/*.dll; do cp -f "$file" "${filepath}"; done - echo "Patched '$filename'" -} - -patch_tarball () { - local tarball_name="$1" - local filename=$(basename "$tarball_name") - local filepath=$(dirname "$tarball_name") - local newfile=`echo "$filepath/$filename" | sed -e 's/-any/-phyx/'` - local arch="" - - echo "=> ${filename}" - - case $1 in - *x86_64*) - arch="x86_64" - ;; - *i686*) - arch="i686" - ;; - *) - echo "unknown architecture detected. Stopping." - exit 1 - ;; - esac - - local base="$(pwd)" - local patcher_base="$(pwd)/ghc-tarballs/ghc-jailbreak/$arch" - local tmpdir="ghc-tarballs/tmpdir" - mkdir -p $tmpdir - cd $tmpdir - tar xJf "$base/$tarball_name" - find . -iname "*.exe" -exec bash -c \ - 'patch_single_file "'"${patcher_base}"'" "$0"' {} \; - tar cJf "$base/$newfile" . - cd "$base" - rm -rf $tmpdir - gpg --output "$base/${newfile}.sig" --detach-sig "$base/$newfile" - rm -f "$base/$tarball_name" -} - -show_hashes_for_binaries() { - $FIND ghc-tarballs/ -iname "*.*" | xargs md5sum | grep -v "\.sig" | sed -s "s/\*//" -} - -usage() { - echo "$0 - Download GHC mingw toolchain tarballs" - echo - echo "Usage: $0 []" - echo - echo "Where is one of," - echo "" - echo " download download the necessary tarballs for the given architecture" - echo " fetch download the necessary tarballs for the given architecture but doesn't verify their md5." - echo " grab download the necessary tarballs using patched toolchains for the given architecture but doesn't verify their md5." - echo " verify verify the existence and correctness of the necessary tarballs" - echo " patch jailbreak the binaries in the tarballs and remove MAX_PATH limitations." - echo " hash generate md5 hashes for inclusion in win32-tarballs.md5sum" - echo " sync upload packages downloaded with 'fetch mirror' to haskell.org" - echo "" - echo "and is one of i386, x86_64,all or mirror (which includes sources)" -} - -case $1 in - download) - download=1 - verify=1 - sigs=0 - ;; - fetch) - download=1 - verify= - ;; - grab) - download=1 - verify=0 - pkg_variant="any" - ;; - verify) - download=0 - verify=1 - ;; - sync) - download=1 - verify=0 - sync=1 - ;; - hash) - show_hashes_for_binaries - exit 1 - ;; - # This routine will download the latest ghc-jailbreak and unpack binutils and - # the ghc tarballs and patches every .exe in each. Along with this is copies - # two dlls in every folder that it patches a .exe in. Afterwards it re-creates - # the tarballs and generates a new signature file. - patch) - export -f patch_tarball - export -f patch_single_file - - echo "Downloading ghc-jailbreak..." - curl -f -L https://mistuke.blob.core.windows.net/binaries/ghc-jailbreak-0.3.tar.gz \ - -o ghc-tarballs/ghc-jailbreak/ghc-jailbreak.tar.gz --create-dirs -# - tar -C ghc-tarballs/ghc-jailbreak/ -xf ghc-tarballs/ghc-jailbreak/ghc-jailbreak.tar.gz - - find ghc-tarballs/mingw-w64/ \( -iname "*binutils*.tar.xz" \ - -o -iname "*gcc*.tar.xz" \) \ - -exec bash -c 'patch_tarball "$0"' {} \; - - rm -rf ghc-tarballs/ghc-jailbreak - - echo "Finished tarball generation, toolchain has been pre-patched." - exit 0 - ;; - *) - usage - exit 1 - ;; -esac - -case $2 in - i386) - download_i386 - ;; - x86_64) - download_x86_64 - ;; - all) - download_i386 - download_x86_64 - ;; - mirror) - sigs=1 - download_i386 - download_x86_64 - verify=0 - sigs=0 - download_sources - show_hashes_for_binaries - ;; - *) - if test "$sync" = "1"; then - sync_binaries_and_sources - else - usage - exit 1 - fi - ;; -esac View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/de890c8294314de582e28b870d83971ef007e900 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/de890c8294314de582e28b870d83971ef007e900 You're receiving 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 Mar 20 19:20:18 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 20 Mar 2020 15:20:18 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/test Message-ID: <5e7517722f0a9_488a3fc6f8fa0cb82382788@gitlab.haskell.org.mail> Ben Gamari deleted branch wip/test 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 Mar 18 13:33:24 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 18 Mar 2020 09:33:24 -0400 Subject: [Git][ghc/ghc][wip/dataToTag-opt] Deleted 3 commits: When deriving Eq always use tag based comparisons for nullary constructors Message-ID: <5e722324ea66c_488a3fc6ca423d3c1896439@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/dataToTag-opt at Glasgow Haskell Compiler / GHC WARNING: The push did not contain any new commits, but force pushed to delete the commits and changes below. Deleted commits: 05576ed5 by Andreas Klebinger at 2020-03-18T04:24:30Z When deriving Eq always use tag based comparisons for nullary constructors - - - - - 69ce4a89 by Andreas Klebinger at 2020-03-18T04:24:35Z Use dataToTag# instead of getTag in deriving code. getTag resides in base so is not useable in ghc-prim. Where we need it. - - - - - 4a2cf862 by Andreas Klebinger at 2020-03-18T04:24:39Z Eliminate generated Con2Tag bindings completely - - - - - 3 changed files: - compiler/prelude/PrelNames.hs - compiler/typecheck/TcGenDeriv.hs - compiler/utils/ListSetOps.hs Changes: ===================================== compiler/prelude/PrelNames.hs ===================================== @@ -749,12 +749,13 @@ toList_RDR = nameRdrName toListName compose_RDR :: RdrName compose_RDR = varQual_RDR gHC_BASE (fsLit ".") -not_RDR, getTag_RDR, succ_RDR, pred_RDR, minBound_RDR, maxBound_RDR, +not_RDR, getTag_RDR, dataToTag_RDR, succ_RDR, pred_RDR, minBound_RDR, maxBound_RDR, and_RDR, range_RDR, inRange_RDR, index_RDR, unsafeIndex_RDR, unsafeRangeSize_RDR :: RdrName and_RDR = varQual_RDR gHC_CLASSES (fsLit "&&") not_RDR = varQual_RDR gHC_CLASSES (fsLit "not") getTag_RDR = varQual_RDR gHC_BASE (fsLit "getTag") +dataToTag_RDR = varQual_RDR gHC_PRIM (fsLit "dataToTag#") succ_RDR = varQual_RDR gHC_ENUM (fsLit "succ") pred_RDR = varQual_RDR gHC_ENUM (fsLit "pred") minBound_RDR = varQual_RDR gHC_ENUM (fsLit "minBound") ===================================== compiler/typecheck/TcGenDeriv.hs ===================================== @@ -15,6 +15,7 @@ This is where we do all the grimy bindings' generation. {-# LANGUAGE CPP, ScopedTypeVariables #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DataKinds #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} @@ -83,9 +84,8 @@ import Data.List ( find, partition, intersperse ) type BagDerivStuff = Bag DerivStuff data AuxBindSpec - = DerivCon2Tag TyCon -- The con2Tag for given TyCon - | DerivTag2Con TyCon -- ...ditto tag2Con - | DerivMaxTag TyCon -- ...and maxTag + = DerivTag2Con TyCon -- The tag2Con for given TyCon + | DerivMaxTag TyCon -- ...and ditto maxTag deriving( Eq ) -- All these generate ZERO-BASED tag operations -- I.e first constructor has tag 0 @@ -127,17 +127,17 @@ possibly zero of them). Here's an example, with both \tr{N}ullary and case (a1 `eqFloat#` a2) of r -> r for that particular test. -* If there are a lot of (more than ten) nullary constructors, we emit a +* For nullary constructors, we emit a catch-all clause of the form: - (==) a b = case (con2tag_Foo a) of { a# -> - case (con2tag_Foo b) of { b# -> + (==) a b = case (dataToTag# a) of { a# -> + case (dataToTag# b) of { b# -> case (a# ==# b#) of { r -> r }}} - If con2tag gets inlined this leads to join point stuff, so - it's better to use regular pattern matching if there aren't too - many nullary constructors. "Ten" is arbitrary, of course + An older approach preferred regular pattern matches in some cases + but with dataToTag# forcing it's argument, and work on improving + join points this seems no longer necessary. * If there aren't any nullary constructors, we emit a simpler catch-all: @@ -146,7 +146,7 @@ possibly zero of them). Here's an example, with both \tr{N}ullary and * For the @(/=)@ method, we normally just use the default method. If the type is an enumeration type, we could/may/should? generate - special code that calls @con2tag_Foo@, much like for @(==)@ shown + special code that calls @dataToTag#@, much like for @(==)@ shown above. We thought about doing this: If we're also deriving 'Ord' for this @@ -162,20 +162,18 @@ produced don't get through the typechecker. gen_Eq_binds :: SrcSpan -> TyCon -> TcM (LHsBinds GhcPs, BagDerivStuff) gen_Eq_binds loc tycon = do dflags <- getDynFlags - return (method_binds dflags, aux_binds) + return (method_binds dflags, emptyBag) where all_cons = tyConDataCons tycon (nullary_cons, non_nullary_cons) = partition isNullarySrcDataCon all_cons - -- If there are ten or more (arbitrary number) nullary constructors, - -- use the con2tag stuff. For small types it's better to use - -- ordinary pattern matching. - (tag_match_cons, pat_match_cons) - | nullary_cons `lengthExceeds` 10 = (nullary_cons, non_nullary_cons) - | otherwise = ([], all_cons) - + -- For nullary constructors, use the getTag stuff. + (tag_match_cons, pat_match_cons) = (nullary_cons, non_nullary_cons) no_tag_match_cons = null tag_match_cons + -- (LHS patterns, result) + fall_through_eqn :: DynFlags + -> [([Located (Pat (GhcPass 'Parsed))] , LHsExpr GhcPs)] fall_through_eqn dflags | no_tag_match_cons -- All constructors have arguments = case pat_match_cons of @@ -186,17 +184,16 @@ gen_Eq_binds loc tycon = do [([nlWildPat, nlWildPat], false_Expr)] | otherwise -- One or more tag_match cons; add fall-through of - -- extract tags compare for equality + -- extract tags compare for equality, + -- The case `(C1 x) == (C1 y)` can no longer happen + -- at this point as it's matched earlier. = [([a_Pat, b_Pat], untag_Expr dflags tycon [(a_RDR,ah_RDR), (b_RDR,bh_RDR)] (genPrimOpApp (nlHsVar ah_RDR) eqInt_RDR (nlHsVar bh_RDR)))] - aux_binds | no_tag_match_cons = emptyBag - | otherwise = unitBag $ DerivAuxBind $ DerivCon2Tag tycon - method_binds dflags = unitBag (eq_bind dflags) eq_bind dflags = mkFunBindEC 2 loc eq_RDR (const true_Expr) - (map pats_etc pat_match_cons + ( map pats_etc pat_match_cons ++ fall_through_eqn dflags) ------------------------------------------------------------------ @@ -346,11 +343,8 @@ gen_Ord_binds loc tycon = do then ( unitBag $ mkFunBindEC 2 loc compare_RDR (const eqTag_Expr) [] , emptyBag) else ( unitBag (mkOrdOp dflags OrdCompare) `unionBags` other_ops dflags - , aux_binds) + , emptyBag) where - aux_binds | single_con_type = emptyBag - | otherwise = unitBag $ DerivAuxBind $ DerivCon2Tag tycon - -- Note [Game plan for deriving Ord] other_ops dflags | (last_tag - first_tag) <= 2 -- 1-3 constructors @@ -369,7 +363,7 @@ gen_Ord_binds loc tycon = do get_tag con = dataConTag con - fIRST_TAG -- We want *zero-based* tags, because that's what - -- con2Tag returns (generated by untag_Expr)! + -- dataToTag# returns (generated by untag_Expr)! tycon_data_cons = tyConDataCons tycon single_con_type = isSingleton tycon_data_cons @@ -549,8 +543,8 @@ nlConWildPat con = noLoc (ConPatIn (noLoc (getRdrName con)) data Foo ... = N1 | N2 | ... | Nn \end{verbatim} -we use both @con2tag_Foo@ and @tag2con_Foo@ functions, as well as a - at maxtag_Foo@ variable (all generated by @gen_tag_n_con_binds@). +we use both dataToTag# and @tag2con_Foo@ functions, as well as a + at maxtag_Foo@ variable, the later generated by @gen_tag_n_con_binds. \begin{verbatim} instance ... Enum (Foo ...) where @@ -563,16 +557,16 @@ instance ... Enum (Foo ...) where -- or, really... enumFrom a - = case con2tag_Foo a of + = case dataToTag# a of a# -> map tag2con_Foo (enumFromTo (I# a#) maxtag_Foo) enumFromThen a b - = map tag2con_Foo [con2tag_Foo a, con2tag_Foo b .. maxtag_Foo] + = map tag2con_Foo [dataToTag# a, dataToTag# b .. maxtag_Foo] -- or, really... enumFromThen a b - = case con2tag_Foo a of { a# -> - case con2tag_Foo b of { b# -> + = case dataToTag# a of { a# -> + case dataToTag# b of { b# -> map tag2con_Foo (enumFromThenTo (I# a#) (I# b#) maxtag_Foo) }} \end{verbatim} @@ -594,7 +588,7 @@ gen_Enum_binds loc tycon = do , from_enum dflags ] aux_binds = listToBag $ map DerivAuxBind - [DerivCon2Tag tycon, DerivTag2Con tycon, DerivMaxTag tycon] + [DerivTag2Con tycon, DerivMaxTag tycon] occ_nm = getOccString tycon @@ -709,32 +703,32 @@ things go not too differently from @Enum@: \begin{verbatim} instance ... Ix (Foo ...) where range (a, b) - = map tag2con_Foo [con2tag_Foo a .. con2tag_Foo b] + = map tag2con_Foo [dataToTag# a .. dataToTag# b] -- or, really... range (a, b) - = case (con2tag_Foo a) of { a# -> - case (con2tag_Foo b) of { b# -> + = case (dataToTag# a) of { a# -> + case (dataToTag# b) of { b# -> map tag2con_Foo (enumFromTo (I# a#) (I# b#)) }} -- Generate code for unsafeIndex, because using index leads -- to lots of redundant range tests unsafeIndex c@(a, b) d - = case (con2tag_Foo d -# con2tag_Foo a) of + = case (dataToTag# d -# dataToTag# a) of r# -> I# r# inRange (a, b) c = let - p_tag = con2tag_Foo c + p_tag = dataToTag# c in - p_tag >= con2tag_Foo a && p_tag <= con2tag_Foo b + p_tag >= dataToTag# a && p_tag <= dataToTag# b -- or, really... inRange (a, b) c - = case (con2tag_Foo a) of { a_tag -> - case (con2tag_Foo b) of { b_tag -> - case (con2tag_Foo c) of { c_tag -> + = case (dataToTag# a) of { a_tag -> + case (dataToTag# b) of { b_tag -> + case (dataToTag# c) of { c_tag -> if (c_tag >=# a_tag) then c_tag <=# b_tag else @@ -757,8 +751,8 @@ gen_Ix_binds loc tycon = do dflags <- getDynFlags return $ if isEnumerationTyCon tycon then (enum_ixes dflags, listToBag $ map DerivAuxBind - [DerivCon2Tag tycon, DerivTag2Con tycon, DerivMaxTag tycon]) - else (single_con_ixes, unitBag (DerivAuxBind (DerivCon2Tag tycon))) + [DerivTag2Con tycon, DerivMaxTag tycon]) + else (single_con_ixes, emptyBag) where -------------------------------------------------------------- enum_ixes dflags = listToBag @@ -1937,41 +1931,18 @@ mkCoerceClassMethEqn cls inst_tvs inst_tys rhs_ty id \begin{verbatim} data Foo ... = ... -con2tag_Foo :: Foo ... -> Int# tag2con_Foo :: Int -> Foo ... -- easier if Int, not Int# maxtag_Foo :: Int -- ditto (NB: not unlifted) \end{verbatim} The `tags' here start at zero, hence the @fIRST_TAG@ (currently one) fiddling around. + +We also use dataToTag# heavily. -} genAuxBindSpec :: DynFlags -> SrcSpan -> AuxBindSpec -> (LHsBind GhcPs, LSig GhcPs) -genAuxBindSpec dflags loc (DerivCon2Tag tycon) - = (mkFunBindSE 0 loc rdr_name eqns, - L loc (TypeSig noExtField [L loc rdr_name] sig_ty)) - where - rdr_name = con2tag_RDR dflags tycon - - sig_ty = mkLHsSigWcType $ L loc $ XHsType $ NHsCoreTy $ - mkSpecSigmaTy (tyConTyVars tycon) (tyConStupidTheta tycon) $ - mkParentType tycon `mkVisFunTy` intPrimTy - - lots_of_constructors = tyConFamilySize tycon > 8 - -- was: mAX_FAMILY_SIZE_FOR_VEC_RETURNS - -- but we don't do vectored returns any more. - - eqns | lots_of_constructors = [get_tag_eqn] - | otherwise = map mk_eqn (tyConDataCons tycon) - - get_tag_eqn = ([nlVarPat a_RDR], nlHsApp (nlHsVar getTag_RDR) a_Expr) - - mk_eqn :: DataCon -> ([LPat GhcPs], LHsExpr GhcPs) - mk_eqn con = ([nlWildConPat con], - nlHsLit (HsIntPrim NoSourceText - (toInteger ((dataConTag con) - fIRST_TAG)))) - genAuxBindSpec dflags loc (DerivTag2Con tycon) = (mkFunBindSE 0 loc rdr_name [([nlConVarPat intDataCon_RDR [a_RDR]], @@ -2254,14 +2225,26 @@ eq_Expr ty a b where (_, _, prim_eq, _, _) = primOrdOps "Eq" ty -untag_Expr :: DynFlags -> TyCon -> [( RdrName, RdrName)] - -> LHsExpr GhcPs -> LHsExpr GhcPs +-- | Take an expression and a list of pairs @(exprName1,tagName1)@. +-- Wraps the given expression in cases which bind tagName1 to the +-- tag of exprName1 and so forth for all pairs and returns the +-- resulting expression. +untag_Expr :: DynFlags + -> TyCon + -> [( RdrName, RdrName)] -- (expr, expr's tag bound to this) + -> LHsExpr GhcPs -- Final RHS + -> LHsExpr GhcPs -- Result expr untag_Expr _ _ [] expr = expr untag_Expr dflags tycon ((untag_this, put_tag_here) : more) expr - = nlHsCase (nlHsPar (nlHsVarApps (con2tag_RDR dflags tycon) - [untag_this])) {-of-} + {- case (dataToTag# untag_this) of + put_tag_here -> .... + _ -> result + -} + = nlHsCase (nlHsPar (nlHsApp (nlHsVar dataToTag_RDR) (nlHsVar untag_this))) {-of-} [mkHsCaseAlt (nlVarPat put_tag_here) (untag_Expr dflags tycon more expr)] + + enum_from_to_Expr :: LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs @@ -2372,9 +2355,8 @@ minusInt_RDR, tagToEnum_RDR :: RdrName minusInt_RDR = getRdrName (primOpId IntSubOp ) tagToEnum_RDR = getRdrName (primOpId TagToEnumOp) -con2tag_RDR, tag2con_RDR, maxtag_RDR :: DynFlags -> TyCon -> RdrName +tag2con_RDR, maxtag_RDR :: DynFlags -> TyCon -> RdrName -- Generates Orig s RdrName, for the binding positions -con2tag_RDR dflags tycon = mk_tc_deriv_name dflags tycon mkCon2TagOcc tag2con_RDR dflags tycon = mk_tc_deriv_name dflags tycon mkTag2ConOcc maxtag_RDR dflags tycon = mk_tc_deriv_name dflags tycon mkMaxTagOcc @@ -2403,13 +2385,15 @@ mkAuxBinderName dflags parent occ_fun {- Note [Auxiliary binders] ~~~~~~~~~~~~~~~~~~~~~~~~ -We often want to make a top-level auxiliary binding. E.g. for comparison we have - instance Ord T where - compare a b = $con2tag a `compare` $con2tag b +We often want to make a top-level auxiliary binding. E.g. for enum we +turn a Integer into a constructor. So we have + + instance Enum T where + succ x = $tag2con (dataToTag x + 1) - $con2tag :: T -> Int - $con2tag = ...code.... + $tag2con :: Int -> T + $tag2con = ...code.... Of course these top-level bindings should all have distinct name, and we are generating RdrNames here. We can't just use the TyCon or DataCon to distinguish ===================================== compiler/utils/ListSetOps.hs ===================================== @@ -104,12 +104,13 @@ minusList xs ys = filter (`S.notMember` yss) xs Inefficient finite maps based on association lists and equality. -} --- A finite mapping based on equality and association lists +-- | A finite mapping based on equality and association lists. type Assoc a b = [(a,b)] assoc :: (Eq a) => String -> Assoc a b -> a -> b assocDefault :: (Eq a) => b -> Assoc a b -> a -> b assocUsing :: (a -> a -> Bool) -> String -> Assoc a b -> a -> b +-- | Lookup key, fail gracefully using Nothing if not found. assocMaybe :: (Eq a) => Assoc a b -> a -> Maybe b assocDefaultUsing :: (a -> a -> Bool) -> b -> Assoc a b -> a -> b View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/d39b8d9f72b254d042fb16c00e78e23b35a6e879...4a2cf8627cc5fee9d0fc2423d598025a0d3bbb5f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/d39b8d9f72b254d042fb16c00e78e23b35a6e879...4a2cf8627cc5fee9d0fc2423d598025a0d3bbb5f You're receiving 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 Mar 19 13:23:52 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 19 Mar 2020 09:23:52 -0400 Subject: [Git][ghc/ghc][wip/no-coholes] 6 commits: Fix #17021 by checking more return kinds Message-ID: <5e7372683185c_488a3fc6f8fa0cb821093b7@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/no-coholes at Glasgow Haskell Compiler / GHC Commits: 53ff2cd0 by Richard Eisenberg at 2020-03-17T13:46:57Z 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-18T14:06:43Z Modules: Core operations (#13009) - - - - - 4e8a71c1 by Richard Eisenberg at 2020-03-18T14:07:19Z 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-19T04:39:27Z 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-19T04:40:06Z 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. - - - - - 1cd5a211 by Richard Eisenberg at 2020-03-19T13:23:43Z 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. - - - - - 30 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/simplCore/CSE.hs → compiler/GHC/Core/Op/CSE.hs - compiler/simplCore/CallArity.hs → compiler/GHC/Core/Op/CallArity.hs - compiler/prelude/PrelRules.hs → compiler/GHC/Core/Op/ConstantFold.hs - compiler/stranal/CprAnal.hs → compiler/GHC/Core/Op/CprAnal.hs - compiler/stranal/DmdAnal.hs → compiler/GHC/Core/Op/DmdAnal.hs - compiler/simplCore/Exitify.hs → compiler/GHC/Core/Op/Exitify.hs - compiler/simplCore/FloatIn.hs → compiler/GHC/Core/Op/FloatIn.hs - compiler/simplCore/FloatOut.hs → compiler/GHC/Core/Op/FloatOut.hs - compiler/simplCore/LiberateCase.hs → compiler/GHC/Core/Op/LiberateCase.hs - compiler/simplCore/CoreMonad.hs → compiler/GHC/Core/Op/Monad.hs - compiler/simplCore/CoreMonad.hs-boot → compiler/GHC/Core/Op/Monad.hs-boot - compiler/simplCore/OccurAnal.hs → compiler/GHC/Core/Op/OccurAnal.hs - compiler/simplCore/SetLevels.hs → compiler/GHC/Core/Op/SetLevels.hs - compiler/simplCore/Simplify.hs → compiler/GHC/Core/Op/Simplify.hs - compiler/simplCore/SimplCore.hs → compiler/GHC/Core/Op/Simplify/Driver.hs - compiler/simplCore/SimplEnv.hs → compiler/GHC/Core/Op/Simplify/Env.hs - compiler/simplCore/SimplMonad.hs → compiler/GHC/Core/Op/Simplify/Monad.hs - compiler/simplCore/SimplUtils.hs → compiler/GHC/Core/Op/Simplify/Utils.hs - compiler/specialise/SpecConstr.hs → compiler/GHC/Core/Op/SpecConstr.hs - compiler/specialise/Specialise.hs → compiler/GHC/Core/Op/Specialise.hs - compiler/simplCore/SAT.hs → compiler/GHC/Core/Op/StaticArgs.hs - compiler/GHC/Core/Op/Tidy.hs - compiler/stranal/WorkWrap.hs → compiler/GHC/Core/Op/WorkWrap.hs - compiler/stranal/WwLib.hs → compiler/GHC/Core/Op/WorkWrap/Lib.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/11ea299ea4f079c5e2ec7eb859dcde6f900902b5...1cd5a2118bed700d42350ef94fb58d7e926e0235 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/11ea299ea4f079c5e2ec7eb859dcde6f900902b5...1cd5a2118bed700d42350ef94fb58d7e926e0235 You're receiving 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 Mar 18 14:07:28 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 18 Mar 2020 10:07:28 -0400 Subject: [Git][ghc/ghc][master] Add release note about fix to #16502. Message-ID: <5e722b2078962_488a3fc6f93dbda0191329c@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4e8a71c1 by Richard Eisenberg at 2020-03-18T14:07:19Z 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. - - - - - 1 changed file: - docs/users_guide/8.12.1-notes.rst Changes: ===================================== docs/users_guide/8.12.1-notes.rst ===================================== @@ -24,6 +24,23 @@ Language would have accepted ``x``, but its type would have involved the mysterious ``Any`` internal type family. Now, GHC rejects, explaining the situation. +* GHC now more faithfully implements the instance-lookup scheme described with + :extension:`QuantifiedConstraints`. Previous bugs meant that programs like this + were accepted:: + + data T (c :: Type -> Constraint) + instance (forall h. c h => Functor h) => Functor (T c) + instance (forall h. c h => Applicative h) => Applicative (T c) + + Note that in the instance declaration for ``Applicative (T c)``, we cannot prove + ``Functor (T c)``, because the quantified constraint shadows the global instance. + There is an easy workaround, though: just include ``Functor (T c)`` as an assumption. :: + + instance (forall h. c h => Applicative h, Functor (T c)) => Applicative (T c) + + There is a chance we will tweak the lookup scheme in the future, to make this + workaround unnecessary. + Compiler ~~~~~~~~ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/4e8a71c1138b587dfbab8a1823b3f7fa6f0166bd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/4e8a71c1138b587dfbab8a1823b3f7fa6f0166bd You're receiving 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 Mar 20 17:18:11 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 20 Mar 2020 13:18:11 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/marge_bot_batch_merge_job Message-ID: <5e74fad349068_488a8eac470234781a@gitlab.haskell.org.mail> Ben Gamari deleted branch wip/marge_bot_batch_merge_job 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 Mar 20 03:45:39 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 19 Mar 2020 23:45:39 -0400 Subject: [Git][ghc/ghc][wip/test] 2 commits: Bump process submodule Message-ID: <5e743c6378a95_488a3fc6ce6d2d9022758e2@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/test at Glasgow Haskell Compiler / GHC Commits: 8eb82c89 by Ben Gamari at 2020-03-20T03:45:02Z Bump process submodule - - - - - 06889a6f by Ben Gamari at 2020-03-20T03:45:28Z gitlab-ci: Allow armv7 to fail - - - - - 2 changed files: - .gitlab-ci.yml - libraries/process Changes: ===================================== .gitlab-ci.yml ===================================== @@ -509,6 +509,7 @@ nightly-aarch64-linux-deb9: validate-armv7-linux-deb9: extends: .build-armv7-linux-deb9 + allow_failure: true artifacts: when: always expire_in: 2 week ===================================== libraries/process ===================================== @@ -1 +1 @@ -Subproject commit 21149358df25d742cc79ce55510aa82f246e7044 +Subproject commit 758d2f799020bc93b95494e3f54e7056d49041ae View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/b9fb1ac47c1e282e8f07311462e922c19f4f69a5...06889a6f2e2adfd308339a836074216108cd7149 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/b9fb1ac47c1e282e8f07311462e922c19f4f69a5...06889a6f2e2adfd308339a836074216108cd7149 You're receiving 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 Mar 19 16:17:02 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 19 Mar 2020 12:17:02 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: Refactoring: use Platform instead of DynFlags when possible Message-ID: <5e739afe49219_488a3fc6f8fa0cb8218431b@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 64f20756 by Sylvain Henry at 2020-03-19T16:16:49Z Refactoring: use Platform instead of DynFlags when possible Metric Decrease: ManyConstructors T12707 T13035 T1969 - - - - - cb1785d9 by Ömer Sinan Ağacan at 2020-03-19T16:16:54Z 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. - - - - - 30 changed files: - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Graph.hs - compiler/GHC/Cmm/Info.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/Ppr.hs - compiler/GHC/Cmm/Ppr/Decl.hs - compiler/GHC/Cmm/Ppr/Expr.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Switch/Implement.hs - compiler/GHC/Cmm/Type.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen/Amode.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen/Base.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen/CondCode.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen/Gen32.hs - compiler/GHC/CmmToAsm/SPARC/Ppr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/15d057107600c4ad144ca4065455a8b70f0a109c...cb1785d9f839e34a3a4892f354f0c51cc6553c0e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/15d057107600c4ad144ca4065455a8b70f0a109c...cb1785d9f839e34a3a4892f354f0c51cc6553c0e You're receiving 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 Mar 18 19:55:34 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 18 Mar 2020 15:55:34 -0400 Subject: [Git][ghc/ghc][wip/local-symbols-2] 12 commits: Don't use non-portable operator "==" in configure.ac Message-ID: <5e727cb642397_488a3fc6ceaba9f820103da@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/local-symbols-2 at Glasgow Haskell Compiler / GHC Commits: e1aa4052 by PHO at 2020-03-17T11:36:09Z 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-17T11:36:48Z 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-17T11:37:25Z 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-17T11:38:08Z 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-17T11:38:48Z Add example for Data.Semigroup.diff - - - - - 4d85d68b by Paavo at 2020-03-17T11:38:48Z Clean up - - - - - 75168d07 by Paavo at 2020-03-17T11:38:48Z Make example collapsible - - - - - 53ff2cd0 by Richard Eisenberg at 2020-03-17T13:46:57Z 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-18T14:06:43Z Modules: Core operations (#13009) - - - - - 4e8a71c1 by Richard Eisenberg at 2020-03-18T14:07:19Z 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. - - - - - 50bef0e9 by Ben Gamari at 2020-03-18T19:44:09Z 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-all-symbols` flag. With this `perf record` can finally be used against Haskell executables. Even more, with `-g3` `perf annotate` provides inline source code. - - - - - da78b1dc by Ben Gamari at 2020-03-18T19:54:35Z Enable -fexpose-all-symbols when debug level is set - - - - - 30 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/Monad.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/SPARC/Ppr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/simplCore/CSE.hs → compiler/GHC/Core/Op/CSE.hs - compiler/simplCore/CallArity.hs → compiler/GHC/Core/Op/CallArity.hs - compiler/prelude/PrelRules.hs → compiler/GHC/Core/Op/ConstantFold.hs - compiler/stranal/CprAnal.hs → compiler/GHC/Core/Op/CprAnal.hs - compiler/stranal/DmdAnal.hs → compiler/GHC/Core/Op/DmdAnal.hs - compiler/simplCore/Exitify.hs → compiler/GHC/Core/Op/Exitify.hs - compiler/simplCore/FloatIn.hs → compiler/GHC/Core/Op/FloatIn.hs - compiler/simplCore/FloatOut.hs → compiler/GHC/Core/Op/FloatOut.hs - compiler/simplCore/LiberateCase.hs → compiler/GHC/Core/Op/LiberateCase.hs - compiler/simplCore/CoreMonad.hs → compiler/GHC/Core/Op/Monad.hs - compiler/simplCore/CoreMonad.hs-boot → compiler/GHC/Core/Op/Monad.hs-boot - compiler/simplCore/OccurAnal.hs → compiler/GHC/Core/Op/OccurAnal.hs - compiler/simplCore/SetLevels.hs → compiler/GHC/Core/Op/SetLevels.hs - compiler/simplCore/Simplify.hs → compiler/GHC/Core/Op/Simplify.hs - compiler/simplCore/SimplCore.hs → compiler/GHC/Core/Op/Simplify/Driver.hs - compiler/simplCore/SimplEnv.hs → compiler/GHC/Core/Op/Simplify/Env.hs - compiler/simplCore/SimplMonad.hs → compiler/GHC/Core/Op/Simplify/Monad.hs - compiler/simplCore/SimplUtils.hs → compiler/GHC/Core/Op/Simplify/Utils.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/d7ccbf461ae92a197f17bdbb489b33f08c9b4fc8...da78b1dc317c22ee4f7da77a20a30c0f54d3e2fe -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/d7ccbf461ae92a197f17bdbb489b33f08c9b4fc8...da78b1dc317c22ee4f7da77a20a30c0f54d3e2fe You're receiving 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 Mar 19 16:30:06 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Thu, 19 Mar 2020 12:30:06 -0400 Subject: [Git][ghc/ghc][wip/T17676] typo Message-ID: <5e739e0e3c62c_488a3fc6f87158a021925dd@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T17676 at Glasgow Haskell Compiler / GHC Commits: 8d4b9e8b by Sebastian Graf at 2020-03-19T16:30:00Z typo - - - - - 1 changed file: - compiler/basicTypes/Demand.hs Changes: ===================================== compiler/basicTypes/Demand.hs ===================================== @@ -1319,7 +1319,7 @@ deferAfterPreciseException d = lubDmdType d (emptyDmdType conDiv) mayThrowPreciseException :: DmdType -> Bool mayThrowPreciseException (DmdType _ _ Dunno) = True -mayThrowPreciseException (DmdType _ _ ConOrDiv) = True +mayThrowPreciseException (DmdType _ _ ExnOrDiv) = True mayThrowPreciseException (DmdType _ _ _) = False strictenDmd :: Demand -> CleanDemand View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/8d4b9e8b3bb2e142b9e135740927e2572dd1eb47 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/8d4b9e8b3bb2e142b9e135740927e2572dd1eb47 You're receiving 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 Mar 19 12:04:55 2020 From: gitlab at gitlab.haskell.org (Richard Eisenberg) Date: Thu, 19 Mar 2020 08:04:55 -0400 Subject: [Git][ghc/ghc][wip/update-core-spec] Update core spec to reflect changes to Core. Message-ID: <5e735fe72acf7_488a3fc6ca423d3c2102430@gitlab.haskell.org.mail> Richard Eisenberg pushed to branch wip/update-core-spec at Glasgow Haskell Compiler / GHC Commits: dd0ab863 by Richard Eisenberg at 2020-03-19T12:04:37Z 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. * Improves commentary (including restoring a Note lost in 03d4852658e1b7407abb4da84b1b03bfa6f6db3b) in the source. No changes to running code. - - - - - 9 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - docs/core-spec/CoreLint.ott - docs/core-spec/CoreSyn.ott - docs/core-spec/core-spec.mng - docs/core-spec/core-spec.pdf Changes: ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -1367,7 +1367,7 @@ promoteCoercion co = case co of ForAllCo _ _ _ -> ASSERT( False ) mkNomReflCo liftedTypeKind - -- See Note [Weird typing rule for ForAllTy] in GHC.Core.Type + -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep FunCo _ _ _ -> ASSERT( False ) @@ -1416,7 +1416,7 @@ promoteCoercion co = case co of | otherwise -> ASSERT( False) mkNomReflCo liftedTypeKind - -- See Note [Weird typing rule for ForAllTy] in GHC.Core.Type + -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep KindCo _ -> ASSERT( False ) ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -1825,7 +1825,7 @@ lintCoercion (ForAllCo cv1 kind_co co) ; (k3, k4, t1, t2, r) <- lintCoercion co ; checkValueKind k3 (text "the body of a ForAllCo over covar:" <+> ppr co) ; checkValueKind k4 (text "the body of a ForAllCo over covar:" <+> ppr co) - -- See Note [Weird typing rule for ForAllTy] in GHC.Core.Type + -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep ; in_scope <- getInScope ; let tyl = mkTyCoInvForAllTy cv1 t1 r2 = coVarRole cv1 @@ -1844,7 +1844,7 @@ lintCoercion (ForAllCo cv1 kind_co co) tyr = mkTyCoInvForAllTy cv2 $ substTy subst t2 ; return (liftedTypeKind, liftedTypeKind, tyl, tyr, r) } } - -- See Note [Weird typing rule for ForAllTy] in GHC.Core.Type + -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep lintCoercion co@(FunCo r co1 co2) = do { (k1,k'1,s1,t1,r1) <- lintCoercion co1 @@ -2018,7 +2018,7 @@ lintCoercion (InstCo co arg) , CoercionTy s2' <- s2 -> do { return $ (liftedTypeKind, liftedTypeKind - -- See Note [Weird typing rule for ForAllTy] in GHC.Core.Type + -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep , substTy (mkCvSubst in_scope $ unitVarEnv cv1 s1') t1 , substTy (mkCvSubst in_scope $ unitVarEnv cv2 s2') t2 , r) } ===================================== compiler/GHC/Core/TyCo/Rep.hs ===================================== @@ -578,7 +578,7 @@ In sum, in order to uphold (EQ), we need the following three invariants: (EQ2) No reflexive casts in CastTy. (EQ3) No nested CastTys. (EQ4) No CastTy over (ForAllTy (Bndr tyvar vis) body). - See Note [Weird typing rule for ForAllTy] in GHC.Core.Type. + See Note [Weird typing rule for ForAllTy] These invariants are all documented above, in the declaration for Type. @@ -607,6 +607,23 @@ There are cases we want to skip the check. For example, the check is unnecessary when it is known from the context that the input variable is a type variable. In those cases, we use mkForAllTy. +Note [Weird typing rule for ForAllTy] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Here is the (truncated) typing rule for the dependent ForAllTy: + +inner : kind +------------------------------------ +ForAllTy (Bndr tyvar vis) inner : kind + +inner : TYPE r +------------------------------------ +ForAllTy (Bndr covar vis) inner : TYPE + +Note that when inside the binder is a tyvar, neither the inner type nor for +ForAllTy itself have to have kind *! But, it means that we should push any kind +casts through the ForAllTy. The only trouble is avoiding capture. +See GHC.Core.Type.mkCastTy. + -} -- | A type labeled 'KnotTied' might have knot-tied tycons in it. See @@ -1003,6 +1020,7 @@ data Coercion -- The TyCon is never a synonym; -- we expand synonyms eagerly -- But it can be a type function + -- TyCon is never a saturated (->); use FunCo instead | AppCo Coercion CoercionN -- lift AppTy -- AppCo :: e -> N -> e ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -1382,6 +1382,7 @@ mkCastTy (CastTy ty co1) co2 mkCastTy (ForAllTy (Bndr tv vis) inner_ty) co -- (EQ4) from the Note + -- See Note [Weird typing rule for ForAllTy in GHC.Core.TyCo.Rep. | isTyVar tv , let fvs = tyCoVarsOfCo co = -- have to make sure that pushing the co in doesn't capture the bound var! ===================================== compiler/GHC/Core/Unify.hs ===================================== @@ -1507,7 +1507,7 @@ ty_co_match menv subst (ForAllTy (Bndr tv1 _) ty1) -- subst2 <- ty_co_match menv subst1 s2 eta2 kco3 kco4 -- Question: How do we get kcoi? -- 2. Given: --- lkco :: <*> -- See Note [Weird typing rule for ForAllTy] in GHC.Core.Type +-- lkco :: <*> -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep -- rkco :: <*> -- Wanted: -- ty_co_match menv' subst2 ty1 co2 lkco' rkco' ===================================== docs/core-spec/CoreLint.ott ===================================== @@ -232,8 +232,8 @@ G |-co g1 : s1 k1~R k'1 t1 G |-co g2 : s2 k2~R k'2 t2 G |-arrow k1 -> k2 : k G |-arrow k'1 -> k'2 : k' -------------------------- :: TyConAppCoFunTy -G |-co (->)_R g1 g2 : (s1 -> s2) k~R k' (t1 -> t2) +------------------------- :: FunCo +G |-co g1 ->_R g2 : (s1 -> s2) k~R k' (t1 -> t2) T /= (->) = take(length , tyConRolesX R T) @@ -258,9 +258,19 @@ G |-app (t2 : k2') : k2 ~> k4 G |-co g1 g2 : (s1 t1) k3~Ph k4 (s2 t2) G |-co h : k1 *~Nom * k2 -G, z_k1 |-co g : t1 k3~R k4 t2 ------------------------------------------------------------------- :: ForAllCo -G |-co forall z:h. g : (forall z_k1. t1) k3~R k4 (forall z_k2. (t2[z |-> z_k2 |> sym h])) +G, alpha_k1 |-co g : t1 k3~R k4 t2 +------------------------------------------------------------------ :: ForAllCoTv +G |-co forall alpha:h. g : (forall alpha_k1. t1) k3~R k4 (forall alpha_k2. (t2[alpha |-> alpha_k2 |> sym h])) + +G |-co h : k1 *~Nom * k2 +G, x_k1 |-co g : t1 *~R * t2 +R2 = coercionRole x_k1 +h' = downgradeRole R2 h +h1 = nth R2 2 h' +h2 = nth R2 3 h' +almostDevoid x g +------------------------------------------- :: ForAllCoCv +G |-co forall x:h.g : (forall x_k1. t1) *~R * (forall x_k2. (t2[ x |-> h1 ; x_k2 ; sym h2 ])) z_phi elt G phi = t1 k1~#k2 t2 ===================================== docs/core-spec/CoreSyn.ott ===================================== @@ -143,6 +143,7 @@ g {{ tex \gamma }}, h {{ tex \eta }} :: 'Coercion_' ::= {{ com Coercions, \coder | < t > R mg :: :: GRefl {{ com \ctor{GRefl}: Generalized Reflexivity }} {{ tex {\langle [[t]] \rangle}^{[[mg]]}_{[[R]]} }} | T RA :: :: TyConAppCo {{ com \ctor{TyConAppCo}: Type constructor application }} + | g1 -> RA g2 :: :: FunCo {{ com \ctor{FunCo}: Functions }} | g1 g2 :: :: AppCo {{ com \ctor{AppCo}: Application }} | forall z : h . g :: :: ForAllCo {{ com \ctor{ForAllCo}: Polymorphism }} {{ tex [[forall]] [[z]]{:}[[h]].[[g]] }} @@ -162,6 +163,7 @@ g {{ tex \gamma }}, h {{ tex \eta }} :: 'Coercion_' ::= {{ com Coercions, \coder | sub g :: :: SubCo {{ com \ctor{SubCo}: Sub-role --- convert nominal to representational }} | ( g ) :: M :: Parens {{ com Parentheses }} | t $ liftingsubst :: M :: Lifted {{ com Type lifted to coercion }} + | downgradeRole R g :: M :: downgradeRole {{ com \textsf{downgradeRole} }} prov :: 'UnivCoProvenance_' ::= {{ com \ctor{UnivCo} provenance, \coderef{types/TyCoRep.hs}{UnivCoProvenance} }} | UnsafeCoerceProv :: :: UnsafeCoerceProv {{ com From \texttt{unsafeCoerce\#} }} @@ -396,8 +398,10 @@ terminals :: 'terminals_' ::= | --> :: :: steps {{ tex \longrightarrow }} | coercionKind :: :: coercionKind {{ tex \textsf{coercionKind} }} | coercionRole :: :: coercionRole {{ tex \textsf{coercionRole} }} + | downgradeRole :: :: downgradeRole {{ tex \textsf{downgradeRole} }} | take :: :: take {{ tex \textsf{take}\! }} | coaxrProves :: :: coaxrProves {{ tex \textsf{coaxrProves} }} + | almostDevoid :: :: almostDevoid {{ tex \textsf{almostDevoid} }} | Just :: :: Just {{ tex \textsf{Just} }} | \\ :: :: newline {{ tex \\ }} | classifiesTypeWithValues :: :: ctwv {{ tex \textsf{classifiesTypeWithValues} }} @@ -483,6 +487,7 @@ formula :: 'formula_' ::= | z elt vars :: :: in_vars | split _ I s = types :: :: split_type {{ tex \mathop{\textsf{split} }_{[[I]]} [[s]] = [[types]] }} + | almostDevoid x g :: :: almostDevoid %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Subrules and Parsing %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ===================================== docs/core-spec/core-spec.mng ===================================== @@ -106,10 +106,10 @@ There are a few key invariants about expressions: \item The right-hand sides of all top-level and recursive $[[let]]$s must be of lifted type, with one exception: the right-hand side of a top-level $[[let]]$ may be of type \texttt{Addr\#} if it's a primitive string literal. -See \verb|#top_level_invariant#| in \ghcfile{coreSyn/CoreSyn.hs}. +See \verb|#top_level_invariant#| in \ghcfile{GHC.Core}. \item The right-hand side of a non-recursive $[[let]]$ and the argument of an application may be of unlifted type, but only if the expression -is ok-for-speculation. See \verb|#let_app_invariant#| in \ghcfile{coreSyn/CoreSyn.hs}. +is ok-for-speculation. See \verb|#let_app_invariant#| in \ghcfile{GHC.Core}. \item We allow a non-recursive $[[let]]$ for bind a type variable. \item The $[[_]]$ case for a $[[case]]$ must come first. \item The list of case alternatives must be exhaustive. @@ -119,7 +119,7 @@ In other words, the payload inside of a \texttt{Type} constructor must not turn to be built with \texttt{CoercionTy}. \item Join points (introduced by $[[join]]$ expressions) follow the invariants laid out in \verb|Note [Invariants on join points]| in -\ghcfile{coreSyn/CoreSyn.hs}: +\ghcfile{GHC.Core}: \begin{enumerate} \item All occurrences must be tail calls. This is enforced in our typing rules using the label environment $[[D]]$. @@ -170,9 +170,9 @@ A program is just a list of bindings: \gram{\ottt} \ctor{FunTy} is the special case for non-dependent function type. The -\ctor{TyBinder} in \ghcfile{types/TyCoRep.hs} distinguishes whether a binder is +\ctor{TyBinder} in \ghcfile{GHC.Core.TyCo.Rep} distinguishes whether a binder is anonymous (\ctor{FunTy}) or named (\ctor{ForAllTy}). See -\verb|Note [TyBinders]| in \ghcfile{types/TyCoRep.hs}. +\verb|Note [TyBinders]| in \ghcfile{GHC.Core.TyCo.Rep}. There are some invariants on types: \begin{itemize} @@ -191,7 +191,7 @@ a term-level literal, but we are ignoring this distinction here. \item If $[[forall n. t]]$ is a polymorphic type over a coercion variable (i.e. $[[n]]$ is a coercion variable), then $[[n]]$ must appear in $[[t]]$; otherwise it should be represented as a \texttt{FunTy}. See \texttt{Note - [Unused coercion variable in ForAllTy]} in \ghcfile{types/TyCoRep.hs}. + [Unused coercion variable in ForAllTy]} in \ghcfile{GHC.Core.TyCo.Rep}. \end{itemize} Note that the use of the $[[T ]]$ form and the $[[t1 -> t2]]$ form @@ -216,14 +216,15 @@ Invariants on coercions: reflexive, use $[[T_R ]]$, never $[[ g1 g2]] \ldots$. \item The $[[T]]$ in $[[T_R ]]$ is never a type synonym, though it could be a type function. -\item Every non-reflexive coercion coerces between two distinct types. \item The name in a coercion must be a term-level name (\ctor{Id}). \item The contents of $[[]]$ must not be a coercion. In other words, the payload in a \texttt{Refl} must not be built with \texttt{CoercionTy}. \item If $[[forall z: h .g]]$ is a polymorphic coercion over a coercion variable (i.e. $[[z]]$ is a coercion variable), then $[[z]]$ can only appear in - \texttt{Refl} and \texttt{GRefl} in $[[g]]$. See \texttt{Note[Unused coercion - variable in ForAllCo] in \ghcfile{types/Coercion.hs}}. + \texttt{Refl} and \texttt{GRefl} in $[[g]]$. See \texttt{Note [Unused coercion + variable in ForAllCo] in \ghcfile{GHC.Core.Coercion}}. +\item Prefer $[[g1 ->_R g2]]$ over $[[(->)_R g1 g2]]$; that is, we use \ctor{FunCo}, +never \ctor{TyConAppCo}, for coercions over saturated uses of $[[->]]$. \end{itemize} The \texttt{UnivCo} constructor takes several arguments: the two types coerced @@ -327,7 +328,7 @@ synonym for $[[TYPE 'Unlifted]]$. \section{Contexts} -The functions in \ghcfile{coreSyn/CoreLint.hs} use the \texttt{LintM} monad. +The functions in \ghcfile{GHC.Core.Lint} use the \texttt{LintM} monad. This monad contains a context with a set of bound variables $[[G]]$ and a set of bound labels $[[D]]$. The formalism treats $[[G]]$ and $[[D]]$ as ordered lists, but GHC uses sets as its @@ -451,6 +452,19 @@ and \ottdrulename{Co\_CoVarCoRepr}. See Section~\ref{sec:tyconroles} for more information about $[[tyConRolesX]]$, and see Section~\ref{sec:axiom_rules} for more information about $[[coaxrProves]]$. +The $[[downgradeRole R g]]$ function returns a new coercion that relates the same +types as $[[g]]$ but with role $[[R]]$. It assumes that the role of $[[g]]$ is a +sub-role ($\leq$) of $[[R]]$. + +The $[[almostDevoid x g]]$ function makes sure that, if $[[x]]$ appears at all +in $[[g]]$, it appears only within a \ctor{Refl} or \ctor{GRefl} node. See +Section 5.8.5.2 of Richard Eisenberg's thesis for the details, or the ICFP'17 +paper ``A Specification for Dependently-Typed Haskell''. (Richard's thesis +uses a technical treatment of this idea that's very close to GHC's implementation. +The ICFP'17 paper approaches the same restriction in a different way, by using +\emph{available sets} $\Delta$, as explained in Section 4.2 of that paper. +We believe both technical approaches are equivalent in what coercions they accept.) + \subsection{Name consistency} \label{sec:name_consistency} @@ -463,7 +477,7 @@ There are three very similar checks for names, two performed as part of The point of the extra checks on $[[t']]$ is that a join point's type cannot be polymorphic in its return type; see \texttt{Note [The polymorphism rule of join -points]} in \ghcfile{coreSyn/CoreSyn.hs}. +points]} in \ghcfile{GHC.Core}. \ottdefnlintBinder{} ===================================== docs/core-spec/core-spec.pdf ===================================== Binary files a/docs/core-spec/core-spec.pdf and b/docs/core-spec/core-spec.pdf differ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/dd0ab8635f191408aab4acdf140696606c895fa0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/dd0ab8635f191408aab4acdf140696606c895fa0 You're receiving 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 Mar 19 17:30:31 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Thu, 19 Mar 2020 13:30:31 -0400 Subject: [Git][ghc/ghc][wip/T17676] Accept a bunch of testcase changes Message-ID: <5e73ac372d207_488a3fc6ceaba9f82208531@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T17676 at Glasgow Haskell Compiler / GHC Commits: 1f0861c1 by Sebastian Graf at 2020-03-19T17:30:20Z Accept a bunch of testcase changes - - - - - 12 changed files: - testsuite/tests/stranal/should_compile/T10694.stderr - testsuite/tests/stranal/sigs/BottomFromInnerLambda.stderr - testsuite/tests/stranal/sigs/CaseBinderCPR.stderr - testsuite/tests/stranal/sigs/DmdAnalGADTs.stderr - testsuite/tests/stranal/sigs/HyperStrUse.stderr - testsuite/tests/stranal/sigs/NewtypeArity.stderr - testsuite/tests/stranal/sigs/StrAnalExample.stderr - testsuite/tests/stranal/sigs/T12370.stderr - testsuite/tests/stranal/sigs/T5075.stderr - testsuite/tests/stranal/sigs/T8569.stderr - testsuite/tests/stranal/sigs/T8598.stderr - testsuite/tests/stranal/sigs/UnsatFun.stderr Changes: ===================================== testsuite/tests/stranal/should_compile/T10694.stderr ===================================== @@ -4,72 +4,78 @@ Result size of Tidy Core = {terms: 74, types: 65, coercions: 0, joins: 0/4} -- RHS size: {terms: 39, types: 25, coercions: 0, joins: 0/4} T10694.$wpm [InlPrag=NOINLINE] :: Int -> Int -> (# Int, Int #) -[GblId, Arity=2, Str=, Unf=OtherCon []] +[GblId, Arity=2, Str=c, Unf=OtherCon []] T10694.$wpm - = \ (w_s1vj :: Int) (w1_s1vk :: Int) -> + = \ (w_s1vi :: Int) (w1_s1vj :: Int) -> let { - l_s1uR :: Int + l_s1uQ :: Int [LclId] - l_s1uR - = case w_s1vj of { GHC.Types.I# x_aJ9 -> case w1_s1vk of { GHC.Types.I# y_aJc -> GHC.Types.I# (GHC.Prim.+# x_aJ9 y_aJc) } } } in + l_s1uQ + = case w_s1vi of { GHC.Types.I# x_aJ8 -> case w1_s1vj of { GHC.Types.I# y_aJb -> GHC.Types.I# (GHC.Prim.+# x_aJ8 y_aJb) } } } in let { - l1_s1uS :: Int + l1_s1uR :: Int [LclId] - l1_s1uS - = case w_s1vj of { GHC.Types.I# x_aJh -> case w1_s1vk of { GHC.Types.I# y_aJk -> GHC.Types.I# (GHC.Prim.-# x_aJh y_aJk) } } } in + l1_s1uR + = case w_s1vi of { GHC.Types.I# x_aJg -> case w1_s1vj of { GHC.Types.I# y_aJj -> GHC.Types.I# (GHC.Prim.-# x_aJg y_aJj) } } } in let { - l2_s1uT :: [Int] + l2_s1uS :: [Int] [LclId, Unf=OtherCon []] - l2_s1uT = GHC.Types.: @Int l1_s1uS (GHC.Types.[] @Int) } in + l2_s1uS = GHC.Types.: @Int l1_s1uR (GHC.Types.[] @Int) } in let { - l3_sJv :: [Int] + l3_sJu :: [Int] [LclId, Unf=OtherCon []] - l3_sJv = GHC.Types.: @Int l_s1uR l2_s1uT } in - (# GHC.List.$w!! @Int l3_sJv 0#, GHC.List.$w!! @Int l3_sJv 1# #) + l3_sJu = GHC.Types.: @Int l_s1uQ l2_s1uS } in + (# GHC.List.$w!! @Int l3_sJu 0#, GHC.List.$w!! @Int l3_sJu 1# #) -- RHS size: {terms: 10, types: 11, coercions: 0, joins: 0/0} pm [InlPrag=NOUSERINLINE[0]] :: Int -> Int -> (Int, Int) [GblId, Arity=2, - Str=, + Str=c, Cpr=m1, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) - Tmpl= \ (w_s1vj [Occ=Once] :: Int) (w1_s1vk [Occ=Once] :: Int) -> - case T10694.$wpm w_s1vj w1_s1vk of { (# ww1_s1vp [Occ=Once], ww2_s1vq [Occ=Once] #) -> (ww1_s1vp, ww2_s1vq) }}] -pm = \ (w_s1vj :: Int) (w1_s1vk :: Int) -> case T10694.$wpm w_s1vj w1_s1vk of { (# ww1_s1vp, ww2_s1vq #) -> (ww1_s1vp, ww2_s1vq) } + Tmpl= \ (w_s1vi [Occ=Once] :: Int) (w1_s1vj [Occ=Once] :: Int) -> + case T10694.$wpm w_s1vi w1_s1vj of { (# ww1_s1vo [Occ=Once], ww2_s1vp [Occ=Once] #) -> (ww1_s1vo, ww2_s1vp) }}] +pm = \ (w_s1vi :: Int) (w1_s1vj :: Int) -> case T10694.$wpm w_s1vi w1_s1vj of { (# ww1_s1vo, ww2_s1vp #) -> (ww1_s1vo, ww2_s1vp) } -- RHS size: {terms: 8, types: 9, coercions: 0, joins: 0/0} m :: Int -> Int -> Int [GblId, Arity=2, - Str=, + Str=c, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) - Tmpl= \ (x_awt [Occ=Once] :: Int) (y_awu [Occ=Once] :: Int) -> - case pm x_awt y_awu of { (_ [Occ=Dead], mr_aww [Occ=Once]) -> mr_aww }}] -m = \ (x_awt :: Int) (y_awu :: Int) -> case T10694.$wpm x_awt y_awu of { (# ww1_s1vp, ww2_s1vq #) -> ww2_s1vq } + Tmpl= \ (x_awv [Occ=Once] :: Int) (y_aww [Occ=Once] :: Int) -> + case pm x_awv y_aww of { (_ [Occ=Dead], mr_awy [Occ=Once]) -> mr_awy }}] +m = \ (x_awv :: Int) (y_aww :: Int) -> case T10694.$wpm x_awv y_aww of { (# ww1_s1vo, ww2_s1vp #) -> ww2_s1vp } -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T10694.$trModule4 :: GHC.Prim.Addr# -[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +[GblId, + Str=c, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] T10694.$trModule4 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T10694.$trModule3 :: GHC.Types.TrName [GblId, + Str=c, Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] T10694.$trModule3 = GHC.Types.TrNameS T10694.$trModule4 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T10694.$trModule2 :: GHC.Prim.Addr# -[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +[GblId, + Str=c, + Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] T10694.$trModule2 = "T10694"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T10694.$trModule1 :: GHC.Types.TrName [GblId, + Str=c, Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] T10694.$trModule1 = GHC.Types.TrNameS T10694.$trModule2 @@ -77,6 +83,7 @@ T10694.$trModule1 = GHC.Types.TrNameS T10694.$trModule2 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} T10694.$trModule :: GHC.Types.Module [GblId, + Str=c, Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] T10694.$trModule = GHC.Types.Module T10694.$trModule3 T10694.$trModule1 ===================================== testsuite/tests/stranal/sigs/BottomFromInnerLambda.stderr ===================================== @@ -1,8 +1,8 @@ ==================== Strictness signatures ==================== -BottomFromInnerLambda.$trModule: -BottomFromInnerLambda.expensive: -BottomFromInnerLambda.f: +BottomFromInnerLambda.$trModule: c +BottomFromInnerLambda.expensive: c +BottomFromInnerLambda.f: c @@ -14,8 +14,8 @@ BottomFromInnerLambda.f: ==================== Strictness signatures ==================== -BottomFromInnerLambda.$trModule: -BottomFromInnerLambda.expensive: -BottomFromInnerLambda.f: +BottomFromInnerLambda.$trModule: c +BottomFromInnerLambda.expensive: c +BottomFromInnerLambda.f: c ===================================== testsuite/tests/stranal/sigs/CaseBinderCPR.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Strictness signatures ==================== -CaseBinderCPR.$trModule: -CaseBinderCPR.f_list_cmp: +CaseBinderCPR.$trModule: c +CaseBinderCPR.f_list_cmp: c @@ -12,7 +12,7 @@ CaseBinderCPR.f_list_cmp: m1 ==================== Strictness signatures ==================== -CaseBinderCPR.$trModule: -CaseBinderCPR.f_list_cmp: +CaseBinderCPR.$trModule: c +CaseBinderCPR.f_list_cmp: c ===================================== testsuite/tests/stranal/sigs/DmdAnalGADTs.stderr ===================================== @@ -1,15 +1,15 @@ ==================== Strictness signatures ==================== -DmdAnalGADTs.$tc'A: -DmdAnalGADTs.$tc'B: -DmdAnalGADTs.$tcD: -DmdAnalGADTs.$trModule: +DmdAnalGADTs.$tc'A: c +DmdAnalGADTs.$tc'B: c +DmdAnalGADTs.$tcD: c +DmdAnalGADTs.$trModule: c DmdAnalGADTs.diverges: b DmdAnalGADTs.f: -DmdAnalGADTs.f': -DmdAnalGADTs.g: -DmdAnalGADTs.hasCPR: -DmdAnalGADTs.hasStrSig: +DmdAnalGADTs.f': c +DmdAnalGADTs.g: c +DmdAnalGADTs.hasCPR: c +DmdAnalGADTs.hasStrSig: c @@ -28,15 +28,15 @@ DmdAnalGADTs.hasStrSig: m1 ==================== Strictness signatures ==================== -DmdAnalGADTs.$tc'A: -DmdAnalGADTs.$tc'B: -DmdAnalGADTs.$tcD: -DmdAnalGADTs.$trModule: +DmdAnalGADTs.$tc'A: c +DmdAnalGADTs.$tc'B: c +DmdAnalGADTs.$tcD: c +DmdAnalGADTs.$trModule: c DmdAnalGADTs.diverges: b DmdAnalGADTs.f: -DmdAnalGADTs.f': -DmdAnalGADTs.g: -DmdAnalGADTs.hasCPR: -DmdAnalGADTs.hasStrSig: +DmdAnalGADTs.f': c +DmdAnalGADTs.g: c +DmdAnalGADTs.hasCPR: c +DmdAnalGADTs.hasStrSig: c ===================================== testsuite/tests/stranal/sigs/HyperStrUse.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Strictness signatures ==================== -HyperStrUse.$trModule: -HyperStrUse.f: +HyperStrUse.$trModule: c +HyperStrUse.f: c @@ -12,7 +12,7 @@ HyperStrUse.f: m1 ==================== Strictness signatures ==================== -HyperStrUse.$trModule: -HyperStrUse.f: +HyperStrUse.$trModule: c +HyperStrUse.f: c ===================================== testsuite/tests/stranal/sigs/NewtypeArity.stderr ===================================== @@ -1,10 +1,10 @@ ==================== Strictness signatures ==================== -Test.$tc'MkT: -Test.$tcT: -Test.$trModule: -Test.t: -Test.t2: +Test.$tc'MkT: c +Test.$tcT: c +Test.$trModule: c +Test.t: c +Test.t2: c @@ -18,10 +18,10 @@ Test.t2: m1 ==================== Strictness signatures ==================== -Test.$tc'MkT: -Test.$tcT: -Test.$trModule: -Test.t: -Test.t2: +Test.$tc'MkT: c +Test.$tcT: c +Test.$trModule: c +Test.t: c +Test.t2: c ===================================== testsuite/tests/stranal/sigs/StrAnalExample.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Strictness signatures ==================== -StrAnalExample.$trModule: -StrAnalExample.foo: +StrAnalExample.$trModule: c +StrAnalExample.foo: c @@ -12,7 +12,7 @@ StrAnalExample.foo: ==================== Strictness signatures ==================== -StrAnalExample.$trModule: -StrAnalExample.foo: +StrAnalExample.$trModule: c +StrAnalExample.foo: c ===================================== testsuite/tests/stranal/sigs/T12370.stderr ===================================== @@ -1,8 +1,8 @@ ==================== Strictness signatures ==================== -T12370.$trModule: -T12370.bar: -T12370.foo: +T12370.$trModule: c +T12370.bar: c +T12370.foo: c @@ -14,8 +14,8 @@ T12370.foo: m1 ==================== Strictness signatures ==================== -T12370.$trModule: -T12370.bar: -T12370.foo: +T12370.$trModule: c +T12370.bar: c +T12370.foo: c ===================================== testsuite/tests/stranal/sigs/T5075.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Strictness signatures ==================== -T5075.$trModule: -T5075.loop: +T5075.$trModule: c +T5075.loop: c @@ -12,7 +12,7 @@ T5075.loop: ==================== Strictness signatures ==================== -T5075.$trModule: -T5075.loop: +T5075.$trModule: c +T5075.loop: c ===================================== testsuite/tests/stranal/sigs/T8569.stderr ===================================== @@ -1,10 +1,10 @@ ==================== Strictness signatures ==================== -T8569.$tc'Rdata: -T8569.$tc'Rint: -T8569.$tcRep: -T8569.$trModule: -T8569.addUp: +T8569.$tc'Rdata: c +T8569.$tc'Rint: c +T8569.$tcRep: c +T8569.$trModule: c +T8569.addUp: c @@ -18,10 +18,10 @@ T8569.addUp: ==================== Strictness signatures ==================== -T8569.$tc'Rdata: -T8569.$tc'Rint: -T8569.$tcRep: -T8569.$trModule: -T8569.addUp: +T8569.$tc'Rdata: c +T8569.$tc'Rint: c +T8569.$tcRep: c +T8569.$trModule: c +T8569.addUp: c ===================================== testsuite/tests/stranal/sigs/T8598.stderr ===================================== @@ -1,6 +1,6 @@ ==================== Strictness signatures ==================== -T8598.$trModule: +T8598.$trModule: c T8598.fun: @@ -12,7 +12,7 @@ T8598.fun: m1 ==================== Strictness signatures ==================== -T8598.$trModule: +T8598.$trModule: c T8598.fun: ===================================== testsuite/tests/stranal/sigs/UnsatFun.stderr ===================================== @@ -1,13 +1,13 @@ ==================== Strictness signatures ==================== -UnsatFun.$trModule: +UnsatFun.$trModule: c UnsatFun.f: b UnsatFun.g: b -UnsatFun.g': -UnsatFun.g3: -UnsatFun.h: -UnsatFun.h2: -UnsatFun.h3: +UnsatFun.g': c +UnsatFun.g3: c +UnsatFun.h: c +UnsatFun.h2: c +UnsatFun.h3: c @@ -24,13 +24,13 @@ UnsatFun.h3: m1 ==================== Strictness signatures ==================== -UnsatFun.$trModule: +UnsatFun.$trModule: c UnsatFun.f: b UnsatFun.g: b -UnsatFun.g': -UnsatFun.g3: -UnsatFun.h: -UnsatFun.h2: -UnsatFun.h3: +UnsatFun.g': c +UnsatFun.g3: c +UnsatFun.h: c +UnsatFun.h2: c +UnsatFun.h3: c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/1f0861c187099ef136fd27b3140be2c836314bb4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/1f0861c187099ef136fd27b3140be2c836314bb4 You're receiving 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 Mar 17 19:04:40 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 17 Mar 2020 15:04:40 -0400 Subject: [Git][ghc/ghc][wip/T17676] 70 commits: Be explicit about how stack usage of mvar primops are covered. Message-ID: <5e711f481cf19_488a3fc6a6ae53c4176535f@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T17676 at Glasgow Haskell Compiler / GHC Commits: 8c663c2c by Andreas Klebinger at 2020-03-04T15:12:14Z Be explicit about how stack usage of mvar primops are covered. This fixes #17893 [skip-ci] - - - - - cedd6f30 by Ben Gamari at 2020-03-05T19:53:12Z rts: Add getCurrentThreadCPUTime helper - - - - - ace618cd by Ben Gamari at 2020-03-05T19:53:12Z nonmoving-gc: Track time usage of nonmoving marking - - - - - 022b5ad5 by Ben Gamari at 2020-03-05T19:53:12Z Stats: Add sync pauses to +RTS -S output - - - - - 06763234 by Ben Gamari at 2020-03-05T19:53:12Z rts: Report nonmoving collector statistics in machine-readable output - - - - - 70d2b995 by Ben Gamari at 2020-03-09T10:10:52Z 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-09T10:11:30Z gitlab-ci: Disable Sphinx documentation in Alpine build - - - - - 8eb2c263 by Jean-Baptiste Mazon at 2020-03-09T20:33:37Z Fix Windows breakage by not touching locales on Windows - - - - - b8dab057 by Jean-Baptiste Mazon at 2020-03-09T20:33:37Z rts: ensure C numerics in heap profiles using Windows locales if needed - - - - - 7d95260f by Jean-Baptiste Mazon at 2020-03-09T20:33:37Z rts: refactor and comment profile locales - - - - - 5b627813 by Ryan Scott at 2020-03-09T20:34:14Z 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-10T06:05:42Z 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-10T06:05:42Z testsuite: Add test for #17786 This isn't pretty but it's perhaps better than nothing. - - - - - ee2c50cb by Sylvain Henry at 2020-03-10T06:06:33Z Hadrian: track missing configure results - - - - - ca8f51d4 by Ömer Sinan Ağacan at 2020-03-10T06:07:22Z Add regression test for T17904 Closes #17904 - - - - - 5fa9cb82 by Richard Eisenberg at 2020-03-10T16:29:46Z 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-10T16:30:27Z 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-10T16:31:15Z Comments only Clarify code added in #17852 and MR !2724 - - - - - 3300eeac by Krzysztof Gogolewski at 2020-03-10T16:31:54Z 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-10T17:05:01Z Typos in comments [skip ci] - - - - - bb586f89 by Ben Gamari at 2020-03-11T04:14:59Z 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-11T12:17:19Z 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-11T12:17:56Z Fixed a minor typo in codegen.rst - - - - - 0bc23338 by Ryan Scott at 2020-03-11T12:18:32Z 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-11T12:19:08Z 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-11T12:19:44Z 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-11T12:20:27Z 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-12T00:33:37Z 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-12T00:33:37Z 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-12T00:33:37Z 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-12T00:34:14Z 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-12T13:45:51Z 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-12T13:45:51Z 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-12T13:46:29Z 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-13T06:29:20Z 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-13T06:30:22Z 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-13T06:31:03Z Update documentation for closureSize - - - - - f124ff0d by Ben Gamari at 2020-03-13T06:31:40Z gitlab-ci: Rework triggering of release builds Use a push option instead of tagging. - - - - - 7f25557a by Ben Gamari at 2020-03-13T14:38:09Z 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-14T09:25:30Z 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-14T09:26:11Z 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-14T09:26:49Z Make: refactor GMP rules Document and use simpler rules for the ghc-gmp.h header. - - - - - 7432b327 by Sylvain Henry at 2020-03-14T09:27:28Z Use correct option name (-opti) (fix #17314) s/pgmo/opti - - - - - 8f7dd571 by Judah Jacobson at 2020-03-14T09:28:07Z 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-14T09:28:07Z Use AC_ARG_VAR for LD_STAGE0 and AR_STAGE0. - - - - - 20d4d676 by Ben Gamari at 2020-03-14T09:28:43Z 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-14T09:29:18Z 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-14T09:29:55Z 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-14T09:29:55Z 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-14T09:30:31Z gitlab-ci: Add integer-simple release build for Windows Closes #16144. - - - - - e3c374cc by Simon Peyton Jones at 2020-03-14T09:31:07Z 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-14T09:31:07Z 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-14T09:31:42Z 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-14T09:32:18Z 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-14T23:34:42Z Enable stage1 build of haddock The submodule has already been bumped to contain the fix. - - - - - 49e9d739 by Ömer Sinan Ağacan at 2020-03-14T23:35:24Z rts: Fix printClosure when printing fwd ptrs - - - - - 1de3ab4a by Krzysztof Gogolewski at 2020-03-14T23:36:04Z Remove unused field var_inline (#17915) - - - - - d30aeb4b by Krzysztof Gogolewski at 2020-03-15T07:57:41Z 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-15T07:58:18Z Remove some dead code >From the notes.ghc.drop list found using weeder in #17713 - - - - - dd6ffe6b by Viktor Dukhovni at 2020-03-15T07:58:55Z 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-15T14:57:10Z 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-15T14:57:48Z 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-15T14:58:27Z 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-17T03:52:42Z base: add strict IO functions: readFile', getContents', hGetContents' - - - - - 18a346a4 by Sylvain Henry at 2020-03-17T03:53:24Z Modules: Core (#13009) Update submodule: haddock - - - - - 92327e3a by Ömer Sinan Ağacan at 2020-03-17T03:54:04Z 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. - - - - - 5ac04eed by Sebastian Graf at 2020-03-17T10:05:58Z Preserve precise exceptions in strictness analysis The "IO hack" (which is a fallback to preserve precise exceptions semantics and thus *soundness*, rather than some smart thing that increases *precision*) always was quite hard to understand. That led to a misguided effort to simplify it (!1829), because the Note wasn't particularly clear about what kinds of side-effects it cares about. The implementation seemed to care about preserving precise exception semantics, but failed to deliver for the central case of `raiseIO#` (#17676), which is in stark contrast to one of the motivating examples in the Note (the one about `exitWith ExitSuccess`). This patch rewords the Note to apply to IO actions throwing precise exceptions, rather than all side-effecting IO actions (such as write effects) in general. Also it makes this clear in the implementation by extracting the rather opaque `io_hack_reqd` into `CoreUtils.exprMightThrowPreciseException`. In fact, that alone wasn't enough to fix #17676. It actually turned out to be a duplicate of #13380, for which we had a fix in 7b087aeb, making `catchIO#` have `topDiv` from `botDiv`. But that was reverted on the grounds of regressing dead code elimination too much. In this patch we introduce `exnDiv` for `raiseIO#`, the `defaultDmd` of which acts like `topDiv`s (which was the key point which fixed #13380), but otherwise acts like `botDiv` in terms of dead code elimination. Fixes #13380 and #17676. - - - - - 80f00345 by Sebastian Graf at 2020-03-17T10:05:58Z Add ConOrDiv to Divergence and see where it gets us - - - - - 9760f64c by Sebastian Graf at 2020-03-17T10:05:58Z Actually use conDiv - - - - - ff735c48 by Sebastian Graf at 2020-03-17T19:04:23Z Attempt to make ensureArgs do the right thing - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/InfoTable.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Dataflow/Block.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/BlockLayout.hs - compiler/GHC/CmmToAsm/CFG.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/Instr.hs - compiler/GHC/CmmToAsm/Monad.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Instr.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/PPC/Regs.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Graph.hs - compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs - compiler/GHC/CmmToAsm/Reg/Linear.hs - compiler/GHC/CmmToAsm/Reg/Linear/Base.hs - compiler/GHC/CmmToAsm/Reg/Linear/FreeRegs.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/38fa79111a873e5f519bd952e665c7a770d3961c...ff735c48a5f9aeddf9640c0ffb12013a07ad3fec -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/38fa79111a873e5f519bd952e665c7a770d3961c...ff735c48a5f9aeddf9640c0ffb12013a07ad3fec You're receiving 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 Mar 18 12:52:29 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 18 Mar 2020 08:52:29 -0400 Subject: [Git][ghc/ghc][wip/T17676] More pondering over the can of worms I opened Message-ID: <5e72198d4172d_488a3fc6cb49d8fc18705f2@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T17676 at Glasgow Haskell Compiler / GHC Commits: 8b01f4cf by Sebastian Graf at 2020-03-18T12:52:12Z More pondering over the can of worms I opened - - - - - 4 changed files: - compiler/basicTypes/Demand.hs - compiler/basicTypes/Id.hs - compiler/basicTypes/IdInfo.hs - compiler/stranal/DmdAnal.hs Changes: ===================================== compiler/basicTypes/Demand.hs ===================================== @@ -22,7 +22,7 @@ module Demand ( addCaseBndrDmd, DmdType(..), dmdTypeDepth, lubDmdType, bothDmdType, - nopDmdType, botDmdType, mkDmdType, + emptyDmdType, botDmdType, mkDmdType, addDemand, ensureArgs, BothDmdArg, mkBothDmdArg, toBothDmdArg, @@ -32,7 +32,7 @@ module Demand ( Divergence(..), lubDivergence, isBotDiv, topDiv, botDiv, exnDiv, conDiv, appIsBottom, isBottomingSig, pprIfaceStrictSig, StrictSig(..), mkStrictSigForArity, mkClosedStrictSig, - nopSig, botSig, cprProdSig, + emptySig, botSig, cprProdSig, isTopSig, hasDemandEnvSig, splitStrictSig, strictSigDmdEnv, increaseStrictSigArity, etaExpandStrictSig, @@ -1219,13 +1219,26 @@ instance Outputable DmdType where emptyDmdEnv :: VarEnv Demand emptyDmdEnv = emptyVarEnv --- nopDmdType is the demand of doing nothing --- (lazy, absent, no CPR information, no termination information). --- Note that it is ''not'' the top of the lattice (which would be "may use everything"), --- so it is (no longer) called topDmd -nopDmdType, botDmdType :: DmdType -nopDmdType = DmdType emptyDmdEnv [] conDiv -botDmdType = DmdType emptyDmdEnv [] botDiv +-- | 'emptyDmdType' is the demand type where every FV is used according to the +-- defaultFvDemand of the given 'Divergence' and every argument is used +-- according to the defaultArgDmd. Examples: +-- +-- * 'botDiv': Every free var has 'botDmd' and every argument has 'botDmd'. +-- This is 'botDmdType'. +-- * 'exnDiv': Every free var has 'absDmd' and every argument has 'absDmd'. +-- * 'botDiv': This is 'botDmdType'. Every free variable and argument has +-- 'botDmd'. +-- * 'topDiv': Every free var has 'absDmd' and every argument has 'topDmd'. +-- * 'conDiv': Like 'topDiv', but the 'Divergence' interacts in a crucial way +-- when 'bothDmdType'd with a 'botDiv' 'DmdType'. +-- See Note [Precise exceptions and strictness analysis] in +-- "Demand". +-- +emptyDmdType :: Divergence -> DmdType +emptyDmdType div = DmdType emptyDmdEnv [] div + +botDmdType :: DmdType +botDmdType = emptyDmdType botDiv isTopDmdType :: DmdType -> Bool isTopDmdType (DmdType env [] Dunno) @@ -1239,12 +1252,12 @@ dmdTypeDepth :: DmdType -> Arity dmdTypeDepth (DmdType _ ds _) = length ds -- | This makes sure we can use the demand type with n arguments. --- It extends the argument list with the correct defaultArgDmd. --- It also adjusts the Divergence: Divergence survives additional arguments. +-- It appends the argument list with the correct defaultArgDmd. +-- It also adjusts the Divergence: 'Diverges'survives additional arguments. ensureArgs :: Arity -> DmdType -> DmdType ensureArgs n d | n == depth = d | n > depth = DmdType inc_fv inc_ds inc_div - | otherwise = DmdType dec_fv dec_ds dec_div + | otherwise = decreaseArityDmdType d where depth = dmdTypeDepth d DmdType fv ds div = d @@ -1260,16 +1273,22 @@ ensureArgs n d | n == depth = d ConOrDiv -> Dunno _ -> div - -- Arity decrease: - -- * Demands on FVs must be zapped, because they were computed for a - -- stronger incoming demand. - -- * Demands on args must also be zapped. - -- * Divergence may now also converge. Dunno would be a conservative - -- way to say so, but also very crude because we won't throw a - -- precise exception if we didn't before anyway. - dec_fv = emptyVarEnv - dec_ds = [] - dec_div = lubDivergence ConOrDiv div -- we possibly converge now +-- | A conservative approximation for a given 'DmdType' in case of an arity +-- decrease: +-- +-- * Demands on FVs must be zapped, because they were computed for a +-- stronger incoming demand. +-- * Demands on args must also be zapped. +-- * Divergence may now also converge. Dunno would be a conservative +-- way to say so, but also very crude because we won't throw a +-- precise exception if we didn't before anyway. +-- +-- So, basically this will return either @'emptyDmdType' topDiv@ or +-- @'emptyDmdType' conDiv@, depending on whether the original 'DmdType' +-- could throw a precise exception or not. +decreaseArityDmdType :: DmdType -> DmdType +decreaseArityDmdType (DmdType _ _ div) + = DmdType emptyVarEnv [] (lubDivergence ConOrDiv div) seqDmdType :: DmdType -> () seqDmdType (DmdType env ds res) = @@ -1675,7 +1694,7 @@ increaseStrictSigArity arity_increase sig@(StrictSig dmd_ty@(DmdType env dmds re | arity_increase < 0 = WARN( True, text "increaseStrictSigArity:" <+> text "negative arity increase" <+> ppr arity_increase ) - nopSig + StrictSig (decreaseArityDmdType dmd_ty) | otherwise = StrictSig (DmdType env dmds' res) where dmds' = replicate arity_increase topDmd ++ dmds @@ -1699,12 +1718,15 @@ strictSigDmdEnv (StrictSig (DmdType env _ _)) = env isBottomingSig :: StrictSig -> Bool isBottomingSig (StrictSig (DmdType _ _ res)) = isBotDiv res -nopSig, botSig :: StrictSig -nopSig = StrictSig nopDmdType +-- | See 'emptyDmdType'. +emptySig :: Divergence ->StrictSig +emptySig div = StrictSig (emptyDmdType div) + +botSig :: StrictSig botSig = StrictSig botDmdType cprProdSig :: Arity -> StrictSig -cprProdSig _arity = nopSig +cprProdSig _arity = emptySig conDiv -- constructor applications never throw precise exceptions seqStrictSig :: StrictSig -> () seqStrictSig (StrictSig ty) = seqDmdType ty @@ -1730,7 +1752,7 @@ dmdTransformDataConSig arity (StrictSig (DmdType _ _ con_res)) -- Must remember whether it's a product, hence con_res, not TopRes | otherwise -- Not saturated - = nopDmdType + = emptyDmdType conDiv where go_str 0 dmd = splitStrProdDmd arity dmd go_str n (SCall s') = go_str (n-1) s' @@ -1752,7 +1774,7 @@ dmdTransformDictSelSig (StrictSig (DmdType _ [dict_dmd] _)) cd = postProcessUnsat defer_use $ DmdType emptyDmdEnv [mkOnceUsedDmd $ mkProdDmd $ map (enhance cd') jds] conDiv | otherwise - = nopDmdType -- See Note [Demand transformer for a dictionary selector] + = emptyDmdType conDiv -- See Note [Demand transformer for a dictionary selector] where enhance cd old | isAbsDmd old = old | otherwise = mkOnceUsedDmd cd -- This is the one! @@ -1771,7 +1793,7 @@ For single-method classes, which are represented by newtypes the signature of 'op' won't look like U(...), so the splitProdDmd_maybe will fail. That's fine: if we are doing strictness analysis we are also doing inlining, so we'll have inlined 'op' into a cast. So we can bale out in a conservative -way, returning nopDmdType. +way, returning emptyDmdType. It is (just.. #8329) possible to be running strictness analysis *without* having inlined class ops from single-method classes. Suppose you are using ===================================== compiler/basicTypes/Id.hs ===================================== @@ -657,7 +657,7 @@ setIdCprInfo :: Id -> CprSig -> Id setIdCprInfo id sig = modifyIdInfo (\info -> setCprInfo info sig) id zapIdStrictness :: Id -> Id -zapIdStrictness id = modifyIdInfo (`setStrictnessInfo` nopSig) id +zapIdStrictness id = modifyIdInfo (`setStrictnessInfo` emptySig topDiv) id -- | This predicate says whether the 'Id' has a strict demand placed on it or -- has a type such that it can always be evaluated strictly (i.e an ===================================== compiler/basicTypes/IdInfo.hs ===================================== @@ -323,7 +323,7 @@ vanillaIdInfo inlinePragInfo = defaultInlinePragma, occInfo = noOccInfo, demandInfo = topDmd, - strictnessInfo = nopSig, + strictnessInfo = emptySig topDiv, cprInfo = topCprSig, callArityInfo = unknownArity, levityInfo = NoLevityInfo ===================================== compiler/stranal/DmdAnal.hs ===================================== @@ -148,8 +148,8 @@ dmdAnal, dmdAnal' :: AnalEnv dmdAnal env d e = -- pprTrace "dmdAnal" (ppr d <+> ppr e) $ dmdAnal' env d e -dmdAnal' _ _ (Lit lit) = (nopDmdType, Lit lit) -dmdAnal' _ _ (Type ty) = (nopDmdType, Type ty) -- Doesn't happen, in fact +dmdAnal' _ _ (Lit lit) = (emptyDmdType conDiv, Lit lit) +dmdAnal' _ _ (Type ty) = (emptyDmdType conDiv, Type ty) -- Doesn't happen, in fact dmdAnal' _ _ (Coercion co) = (unitDmdType (coercionDmdEnv co), Coercion co) @@ -485,7 +485,7 @@ dmdFix top_lvl env let_dmd orig_pairs zapIdStrictness :: [(Id, CoreExpr)] -> [(Id, CoreExpr)] - zapIdStrictness pairs = [(setIdStrictness id nopSig, rhs) | (id, rhs) <- pairs ] + zapIdStrictness pairs = [(setIdStrictness id (emptySig topDiv), rhs) | (id, rhs) <- pairs ] {- Note [Safe abortion in the fixed-point iteration] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/8b01f4cf7fc5a9bd778ff09f03fc39c4827b23db -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/8b01f4cf7fc5a9bd778ff09f03fc39c4827b23db You're receiving 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 Mar 18 13:25:21 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 18 Mar 2020 09:25:21 -0400 Subject: [Git][ghc/ghc][wip/andreask/ffi_docs_update] 64 commits: Be explicit about how stack usage of mvar primops are covered. Message-ID: <5e7221416aa09_488a3fc6cb49d8fc188137e@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/andreask/ffi_docs_update at Glasgow Haskell Compiler / GHC Commits: 8c663c2c by Andreas Klebinger at 2020-03-04T15:12:14Z Be explicit about how stack usage of mvar primops are covered. This fixes #17893 [skip-ci] - - - - - cedd6f30 by Ben Gamari at 2020-03-05T19:53:12Z rts: Add getCurrentThreadCPUTime helper - - - - - ace618cd by Ben Gamari at 2020-03-05T19:53:12Z nonmoving-gc: Track time usage of nonmoving marking - - - - - 022b5ad5 by Ben Gamari at 2020-03-05T19:53:12Z Stats: Add sync pauses to +RTS -S output - - - - - 06763234 by Ben Gamari at 2020-03-05T19:53:12Z rts: Report nonmoving collector statistics in machine-readable output - - - - - 70d2b995 by Ben Gamari at 2020-03-09T10:10:52Z 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-09T10:11:30Z gitlab-ci: Disable Sphinx documentation in Alpine build - - - - - 8eb2c263 by Jean-Baptiste Mazon at 2020-03-09T20:33:37Z Fix Windows breakage by not touching locales on Windows - - - - - b8dab057 by Jean-Baptiste Mazon at 2020-03-09T20:33:37Z rts: ensure C numerics in heap profiles using Windows locales if needed - - - - - 7d95260f by Jean-Baptiste Mazon at 2020-03-09T20:33:37Z rts: refactor and comment profile locales - - - - - 5b627813 by Ryan Scott at 2020-03-09T20:34:14Z 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-10T06:05:42Z 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-10T06:05:42Z testsuite: Add test for #17786 This isn't pretty but it's perhaps better than nothing. - - - - - ee2c50cb by Sylvain Henry at 2020-03-10T06:06:33Z Hadrian: track missing configure results - - - - - ca8f51d4 by Ömer Sinan Ağacan at 2020-03-10T06:07:22Z Add regression test for T17904 Closes #17904 - - - - - 5fa9cb82 by Richard Eisenberg at 2020-03-10T16:29:46Z 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-10T16:30:27Z 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-10T16:31:15Z Comments only Clarify code added in #17852 and MR !2724 - - - - - 3300eeac by Krzysztof Gogolewski at 2020-03-10T16:31:54Z 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-10T17:05:01Z Typos in comments [skip ci] - - - - - bb586f89 by Ben Gamari at 2020-03-11T04:14:59Z 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-11T12:17:19Z 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-11T12:17:56Z Fixed a minor typo in codegen.rst - - - - - 0bc23338 by Ryan Scott at 2020-03-11T12:18:32Z 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-11T12:19:08Z 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-11T12:19:44Z 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-11T12:20:27Z 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-12T00:33:37Z 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-12T00:33:37Z 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-12T00:33:37Z 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-12T00:34:14Z 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-12T13:45:51Z 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-12T13:45:51Z 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-12T13:46:29Z 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-13T06:29:20Z 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-13T06:30:22Z 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-13T06:31:03Z Update documentation for closureSize - - - - - f124ff0d by Ben Gamari at 2020-03-13T06:31:40Z gitlab-ci: Rework triggering of release builds Use a push option instead of tagging. - - - - - 7f25557a by Ben Gamari at 2020-03-13T14:38:09Z 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-14T09:25:30Z 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-14T09:26:11Z 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-14T09:26:49Z Make: refactor GMP rules Document and use simpler rules for the ghc-gmp.h header. - - - - - 7432b327 by Sylvain Henry at 2020-03-14T09:27:28Z Use correct option name (-opti) (fix #17314) s/pgmo/opti - - - - - 8f7dd571 by Judah Jacobson at 2020-03-14T09:28:07Z 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-14T09:28:07Z Use AC_ARG_VAR for LD_STAGE0 and AR_STAGE0. - - - - - 20d4d676 by Ben Gamari at 2020-03-14T09:28:43Z 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-14T09:29:18Z 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-14T09:29:55Z 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-14T09:29:55Z 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-14T09:30:31Z gitlab-ci: Add integer-simple release build for Windows Closes #16144. - - - - - e3c374cc by Simon Peyton Jones at 2020-03-14T09:31:07Z 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-14T09:31:07Z 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-14T09:31:42Z 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-14T09:32:18Z 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-14T23:34:42Z Enable stage1 build of haddock The submodule has already been bumped to contain the fix. - - - - - 49e9d739 by Ömer Sinan Ağacan at 2020-03-14T23:35:24Z rts: Fix printClosure when printing fwd ptrs - - - - - 1de3ab4a by Krzysztof Gogolewski at 2020-03-14T23:36:04Z Remove unused field var_inline (#17915) - - - - - d30aeb4b by Krzysztof Gogolewski at 2020-03-15T07:57:41Z 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-15T07:58:18Z Remove some dead code >From the notes.ghc.drop list found using weeder in #17713 - - - - - dd6ffe6b by Viktor Dukhovni at 2020-03-15T07:58:55Z 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-15T14:57:10Z 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-15T14:57:48Z 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-15T14:58:27Z 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. - - - - - b8a6e1ef by Andreas Klebinger at 2020-03-18T13:25:13Z 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] - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Dataflow/Block.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/BlockLayout.hs - compiler/GHC/CmmToAsm/CFG.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/Instr.hs - compiler/GHC/CmmToAsm/Monad.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Instr.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/PPC/Regs.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Graph.hs - compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs - compiler/GHC/CmmToAsm/Reg/Linear.hs - compiler/GHC/CmmToAsm/Reg/Linear/Base.hs - compiler/GHC/CmmToAsm/Reg/Linear/FreeRegs.hs - compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs - compiler/GHC/CmmToAsm/Reg/Linear/StackMap.hs - compiler/GHC/CmmToAsm/Reg/Linear/State.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs - compiler/GHC/CmmToAsm/SPARC/Base.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/510008add5d91426f6d361c445fd232216a20494...b8a6e1ef4f91a974fb0023b59215f7c9700547a2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/510008add5d91426f6d361c445fd232216a20494...b8a6e1ef4f91a974fb0023b59215f7c9700547a2 You're receiving 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 Mar 18 04:10:34 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 18 Mar 2020 00:10:34 -0400 Subject: [Git][ghc/ghc][wip/dataToTag-opt] Use pointer tag in dataToTag# Message-ID: <5e719f3a41d2c_488a3fc6ca423d3c18287cc@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/dataToTag-opt at Glasgow Haskell Compiler / GHC Commits: d39b8d9f by Ben Gamari at 2020-03-18T04:10:18Z Use pointer tag in dataToTag# While looking at !2873 I noticed that dataToTag# previously didn't look at a pointer's tag to determine its constructor. To be fair, there is a bit of a trade-off here: using the pointer tag requires a bit more code and another branch. On the other hand, it allows us to eliminate looking at the info table in many cases (especially now since we tag large constructor families; see #14373). - - - - - 1 changed file: - compiler/GHC/StgToCmm/Expr.hs Changes: ===================================== compiler/GHC/StgToCmm/Expr.hs ===================================== @@ -35,6 +35,7 @@ import GHC.Stg.Syntax import GHC.Cmm.Graph import GHC.Cmm.BlockId import GHC.Cmm hiding ( succ ) +import GHC.Cmm.Utils ( zeroExpr ) import GHC.Cmm.Info import GHC.Core import DataCon @@ -69,14 +70,39 @@ cgExpr (StgOpApp (StgPrimOp SeqOp) [StgVarArg a, _] _res_ty) = cgIdApp a [] -- dataToTag# :: a -> Int# --- See Note [dataToTag#] in primops.txt.pp +-- See Note [dataToTag# magic] in PrelRules. cgExpr (StgOpApp (StgPrimOp DataToTagOp) [StgVarArg a] _res_ty) = do dflags <- getDynFlags emitComment (mkFastString "dataToTag#") - tmp <- newTemp (bWord dflags) - _ <- withSequel (AssignTo [tmp] False) (cgIdApp a []) - -- TODO: For small types look at the tag bits instead of reading info table - emitReturn [getConstrTag dflags (cmmUntag dflags (CmmReg (CmmLocal tmp)))] + info <- getCgIdInfo a + tag_reg <- assignTemp $ cmmConstrTag1 dflags (idInfoToAmode info) + result_reg <- newTemp (bWord dflags) + let tag = CmmReg $ CmmLocal tag_reg + -- Here we will first check the tag bits of the pointer we were given; + -- if this doesn't work then enter the closure and use the info table + -- to determine the constructor. Note that all tag bits set means that + -- the constructor index is too large to fit in the pointer and therefore + -- we must look in the info table. See Note [Tagging big families]. + + slow_path <- getCode $ do + tmp <- newTemp (bWord dflags) + _ <- withSequel (AssignTo [tmp] False) (cgIdApp a []) + -- TODO: For small types look at the tag bits instead of reading info table + emitAssign (CmmLocal result_reg) + $ getConstrTag dflags (cmmUntag dflags (CmmReg (CmmLocal tmp))) + + fast_path <- getCode $ do + emitAssign (CmmLocal result_reg) + $ cmmSubWord dflags tag (CmmLit $ mkWordCLit dflags 1) + + let not_evald_tag = zeroExpr dflags + too_big_tag = cmmTagMask dflags + is_tagged = cmmOrWord dflags + (cmmEqWord dflags tag not_evald_tag) + (cmmEqWord dflags tag too_big_tag) + emit =<< mkCmmIfThenElse' slow_path fast_path (Just False) + emitReturn [CmmReg $ CmmLocal result_reg] + cgExpr (StgOpApp op args ty) = cgOpApp op args ty cgExpr (StgConApp con args _)= cgConApp con args View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/d39b8d9f72b254d042fb16c00e78e23b35a6e879 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/d39b8d9f72b254d042fb16c00e78e23b35a6e879 You're receiving 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 Mar 18 15:15:33 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Wed, 18 Mar 2020 11:15:33 -0400 Subject: [Git][ghc/ghc][wip/T17923] 11 commits: Don't use non-portable operator "==" in configure.ac Message-ID: <5e723b1543424_488a3fc6ceaba9f8193908e@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T17923 at Glasgow Haskell Compiler / GHC Commits: e1aa4052 by PHO at 2020-03-17T11:36:09Z 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-17T11:36:48Z 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-17T11:37:25Z 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-17T11:38:08Z 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-17T11:38:48Z Add example for Data.Semigroup.diff - - - - - 4d85d68b by Paavo at 2020-03-17T11:38:48Z Clean up - - - - - 75168d07 by Paavo at 2020-03-17T11:38:48Z Make example collapsible - - - - - 53ff2cd0 by Richard Eisenberg at 2020-03-17T13:46:57Z 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-18T14:06:43Z Modules: Core operations (#13009) - - - - - 4e8a71c1 by Richard Eisenberg at 2020-03-18T14:07:19Z 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. - - - - - 27b11c5e by Simon Peyton Jones at 2020-03-18T15:15:18Z 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. - - - - - 30 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/simplCore/CSE.hs → compiler/GHC/Core/Op/CSE.hs - compiler/simplCore/CallArity.hs → compiler/GHC/Core/Op/CallArity.hs - compiler/prelude/PrelRules.hs → compiler/GHC/Core/Op/ConstantFold.hs - compiler/stranal/CprAnal.hs → compiler/GHC/Core/Op/CprAnal.hs - compiler/stranal/DmdAnal.hs → compiler/GHC/Core/Op/DmdAnal.hs - compiler/simplCore/Exitify.hs → compiler/GHC/Core/Op/Exitify.hs - compiler/simplCore/FloatIn.hs → compiler/GHC/Core/Op/FloatIn.hs - compiler/simplCore/FloatOut.hs → compiler/GHC/Core/Op/FloatOut.hs - compiler/simplCore/LiberateCase.hs → compiler/GHC/Core/Op/LiberateCase.hs - compiler/simplCore/CoreMonad.hs → compiler/GHC/Core/Op/Monad.hs - compiler/simplCore/CoreMonad.hs-boot → compiler/GHC/Core/Op/Monad.hs-boot - compiler/simplCore/OccurAnal.hs → compiler/GHC/Core/Op/OccurAnal.hs - compiler/simplCore/SetLevels.hs → compiler/GHC/Core/Op/SetLevels.hs - compiler/simplCore/Simplify.hs → compiler/GHC/Core/Op/Simplify.hs - compiler/simplCore/SimplCore.hs → compiler/GHC/Core/Op/Simplify/Driver.hs - compiler/simplCore/SimplEnv.hs → compiler/GHC/Core/Op/Simplify/Env.hs - compiler/simplCore/SimplMonad.hs → compiler/GHC/Core/Op/Simplify/Monad.hs - compiler/simplCore/SimplUtils.hs → compiler/GHC/Core/Op/Simplify/Utils.hs - compiler/specialise/SpecConstr.hs → compiler/GHC/Core/Op/SpecConstr.hs - compiler/specialise/Specialise.hs → compiler/GHC/Core/Op/Specialise.hs - compiler/simplCore/SAT.hs → compiler/GHC/Core/Op/StaticArgs.hs - compiler/GHC/Core/Op/Tidy.hs - compiler/stranal/WorkWrap.hs → compiler/GHC/Core/Op/WorkWrap.hs - compiler/stranal/WwLib.hs → compiler/GHC/Core/Op/WorkWrap/Lib.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/95ecfa58c2b106c5521a4f3738bc7a4b0ca02857...27b11c5efa8f3f265ed840701321aa6988f2915f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/95ecfa58c2b106c5521a4f3738bc7a4b0ca02857...27b11c5efa8f3f265ed840701321aa6988f2915f You're receiving 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 Mar 19 14:45:08 2020 From: gitlab at gitlab.haskell.org (Richard Eisenberg) Date: Thu, 19 Mar 2020 10:45:08 -0400 Subject: [Git][ghc/ghc][wip/update-core-spec] Update core spec to reflect changes to Core. Message-ID: <5e73857478846_488a3fc6ceaba9f821444e2@gitlab.haskell.org.mail> Richard Eisenberg pushed to branch wip/update-core-spec at Glasgow Haskell Compiler / GHC Commits: 4f2c8810 by Richard Eisenberg at 2020-03-19T14:44:37Z 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. - - - - - 11 changed files: - .gitlab/linters/check-cpp.py - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - docs/core-spec/.gitignore - docs/core-spec/CoreLint.ott - docs/core-spec/CoreSyn.ott - docs/core-spec/core-spec.mng - docs/core-spec/core-spec.pdf Changes: ===================================== .gitlab/linters/check-cpp.py ===================================== @@ -29,6 +29,8 @@ for l in linters: # Don't lint font files l.add_path_filter(lambda path: not path.parent == Path('docs','users_guide', 'rtd-theme', 'static', 'fonts')) + # Don't lint core spec + l.add_path_filter(lambda path: not path.name == 'core-spec.pdf') if __name__ == '__main__': run_linters(linters) ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -1367,7 +1367,7 @@ promoteCoercion co = case co of ForAllCo _ _ _ -> ASSERT( False ) mkNomReflCo liftedTypeKind - -- See Note [Weird typing rule for ForAllTy] in GHC.Core.Type + -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep FunCo _ _ _ -> ASSERT( False ) @@ -1416,7 +1416,7 @@ promoteCoercion co = case co of | otherwise -> ASSERT( False) mkNomReflCo liftedTypeKind - -- See Note [Weird typing rule for ForAllTy] in GHC.Core.Type + -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep KindCo _ -> ASSERT( False ) ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -1466,7 +1466,6 @@ lintType t@(ForAllTy (Bndr cv _vis) ty) ; checkValueKind k (text "the body of forall:" <+> ppr t) ; return liftedTypeKind -- We don't check variable escape here. Namely, k could refer to cv' - -- See Note [NthCo and newtypes] in GHC.Core.TyCo.Rep }} lintType ty@(LitTy l) = lintTyLit l >> return (typeKind ty) @@ -1825,7 +1824,7 @@ lintCoercion (ForAllCo cv1 kind_co co) ; (k3, k4, t1, t2, r) <- lintCoercion co ; checkValueKind k3 (text "the body of a ForAllCo over covar:" <+> ppr co) ; checkValueKind k4 (text "the body of a ForAllCo over covar:" <+> ppr co) - -- See Note [Weird typing rule for ForAllTy] in GHC.Core.Type + -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep ; in_scope <- getInScope ; let tyl = mkTyCoInvForAllTy cv1 t1 r2 = coVarRole cv1 @@ -1844,7 +1843,7 @@ lintCoercion (ForAllCo cv1 kind_co co) tyr = mkTyCoInvForAllTy cv2 $ substTy subst t2 ; return (liftedTypeKind, liftedTypeKind, tyl, tyr, r) } } - -- See Note [Weird typing rule for ForAllTy] in GHC.Core.Type + -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep lintCoercion co@(FunCo r co1 co2) = do { (k1,k'1,s1,t1,r1) <- lintCoercion co1 @@ -2018,7 +2017,7 @@ lintCoercion (InstCo co arg) , CoercionTy s2' <- s2 -> do { return $ (liftedTypeKind, liftedTypeKind - -- See Note [Weird typing rule for ForAllTy] in GHC.Core.Type + -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep , substTy (mkCvSubst in_scope $ unitVarEnv cv1 s1') t1 , substTy (mkCvSubst in_scope $ unitVarEnv cv2 s2') t2 , r) } ===================================== compiler/GHC/Core/TyCo/Rep.hs ===================================== @@ -206,6 +206,9 @@ data Type | ForAllTy {-# UNPACK #-} !TyCoVarBinder Type -- ^ A Π type. + -- INVARIANT: If the binder is a coercion variable, it must + -- be mentioned in the Type. See + -- Note [Unused coercion variable in ForAllTy] | FunTy -- ^ t1 -> t2 Very common, so an important special case -- See Note [Function types] @@ -218,9 +221,10 @@ data Type | CastTy Type KindCoercion -- ^ A kind cast. The coercion is always nominal. - -- INVARIANT: The cast is never refl. + -- INVARIANT: The cast is never reflexive -- INVARIANT: The Type is not a CastTy (use TransCo instead) - -- See Note [Respecting definitional equality] (EQ2) and (EQ3) + -- INVARIANT: The Type is not a ForAllTy over a type variable + -- See Note [Respecting definitional equality] (EQ2), (EQ3), (EQ4) | CoercionTy Coercion -- ^ Injection of a Coercion into a type @@ -567,10 +571,19 @@ be pulled to the right. But we don't need to pull it: (T |> axFun) Int is not `eqType` to any proper TyConApp -- thus, leaving it where it is doesn't violate our (EQ) property. -Lastly, in order to detect reflexive casts reliably, we must make sure not +In order to detect reflexive casts reliably, we must make sure not to have nested casts: we update (t |> co1 |> co2) to (t |> (co1 `TransCo` co2)). -In sum, in order to uphold (EQ), we need the following three invariants: +One other troublesome case is ForAllTy. See Note [Weird typing rule for ForAllTy]. +The kind of the body is the same as the kind of the ForAllTy. Accordingly, + + ForAllTy tv (ty |> co) and (ForAllTy tv ty) |> co + +are `eqType`. But only the first can be split by splitForAllTy. So we forbid +the second form, instead pushing the coercion inside to get the first form. +This is done in mkCastTy. + +In sum, in order to uphold (EQ), we need the following invariants: (EQ1) No decomposable CastTy to the left of an AppTy, where a decomposable cast is one that relates either a FunTy to a FunTy or a @@ -578,7 +591,7 @@ In sum, in order to uphold (EQ), we need the following three invariants: (EQ2) No reflexive casts in CastTy. (EQ3) No nested CastTys. (EQ4) No CastTy over (ForAllTy (Bndr tyvar vis) body). - See Note [Weird typing rule for ForAllTy] in GHC.Core.Type. + See Note [Weird typing rule for ForAllTy] These invariants are all documented above, in the declaration for Type. @@ -607,6 +620,45 @@ There are cases we want to skip the check. For example, the check is unnecessary when it is known from the context that the input variable is a type variable. In those cases, we use mkForAllTy. +Note [Weird typing rule for ForAllTy] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Here is the (truncated) typing rule for the dependent ForAllTy: + + inner : TYPE r + tyvar is not free in r + ---------------------------------------- + ForAllTy (Bndr tyvar vis) inner : TYPE r + +Note that the kind of `inner` is the kind of the overall ForAllTy. This is +necessary because every ForAllTy over a type variable is erased at runtime. +Thus the runtime representation of a ForAllTy (as encoded, via TYPE rep, in +the kind) must be the same as the representation of the body. We must check +for skolem-escape, though. The skolem-escape would prevent a definition like + + undefined :: forall (r :: RuntimeRep) (a :: TYPE r). a + +because the type's kind (TYPE r) mentions the out-of-scope r. Luckily, the real +type of undefined is + + undefined :: forall (r :: RuntimeRep) (a :: TYPE r). HasCallStack => a + +and that HasCallStack constraint neatly sidesteps the potential skolem-escape +problem. + +If the bound variable is a coercion variable: + + inner : TYPE r + covar is free in inner + ------------------------------------ + ForAllTy (Bndr covar vis) inner : Type + +Here, the kind of the ForAllTy is just Type, because coercion abstractions +are *not* erased. The "covar is free in inner" premise is solely to maintain +the representation invariant documented in +Note [Unused coercion variable in ForAllTy]. Though there is surface similarity +between this free-var check and the one in the tyvar rule, these two restrictions +are truly unrelated. + -} -- | A type labeled 'KnotTied' might have knot-tied tycons in it. See @@ -1003,6 +1055,7 @@ data Coercion -- The TyCon is never a synonym; -- we expand synonyms eagerly -- But it can be a type function + -- TyCon is never a saturated (->); use FunCo instead | AppCo Coercion CoercionN -- lift AppTy -- AppCo :: e -> N -> e ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -1382,6 +1382,7 @@ mkCastTy (CastTy ty co1) co2 mkCastTy (ForAllTy (Bndr tv vis) inner_ty) co -- (EQ4) from the Note + -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep. | isTyVar tv , let fvs = tyCoVarsOfCo co = -- have to make sure that pushing the co in doesn't capture the bound var! ===================================== compiler/GHC/Core/Unify.hs ===================================== @@ -1507,7 +1507,7 @@ ty_co_match menv subst (ForAllTy (Bndr tv1 _) ty1) -- subst2 <- ty_co_match menv subst1 s2 eta2 kco3 kco4 -- Question: How do we get kcoi? -- 2. Given: --- lkco :: <*> -- See Note [Weird typing rule for ForAllTy] in GHC.Core.Type +-- lkco :: <*> -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep -- rkco :: <*> -- Wanted: -- ty_co_match menv' subst2 ty1 co2 lkco' rkco' ===================================== docs/core-spec/.gitignore ===================================== @@ -4,3 +4,4 @@ CoreOtt.tex core-spec.tex *.fls +*.out ===================================== docs/core-spec/CoreLint.ott ===================================== @@ -232,8 +232,8 @@ G |-co g1 : s1 k1~R k'1 t1 G |-co g2 : s2 k2~R k'2 t2 G |-arrow k1 -> k2 : k G |-arrow k'1 -> k'2 : k' -------------------------- :: TyConAppCoFunTy -G |-co (->)_R g1 g2 : (s1 -> s2) k~R k' (t1 -> t2) +------------------------- :: FunCo +G |-co g1 ->_R g2 : (s1 -> s2) k~R k' (t1 -> t2) T /= (->) = take(length , tyConRolesX R T) @@ -258,9 +258,19 @@ G |-app (t2 : k2') : k2 ~> k4 G |-co g1 g2 : (s1 t1) k3~Ph k4 (s2 t2) G |-co h : k1 *~Nom * k2 -G, z_k1 |-co g : t1 k3~R k4 t2 ------------------------------------------------------------------- :: ForAllCo -G |-co forall z:h. g : (forall z_k1. t1) k3~R k4 (forall z_k2. (t2[z |-> z_k2 |> sym h])) +G, alpha_k1 |-co g : t1 k3~R k4 t2 +------------------------------------------------------------------ :: ForAllCo_Tv +G |-co forall alpha:h. g : (forall alpha_k1. t1) k3~R k4 (forall alpha_k2. (t2[alpha |-> alpha_k2 |> sym h])) + +G |-co h : k1 *~Nom * k2 +G, x_k1 |-co g : t1 {TYPE s1}~R {TYPE s2} t2 +R2 = coercionRole x_k1 +h' = downgradeRole R2 h +h1 = nth R2 2 h' +h2 = nth R2 3 h' +almostDevoid x g +------------------------------------------- :: ForAllCo_Cv +G |-co forall x:h.g : (forall x_k1. t1) *~R * (forall x_k2. (t2[ x |-> h1 ; x_k2 ; sym h2 ])) z_phi elt G phi = t1 k1~#k2 t2 @@ -495,10 +505,17 @@ G |-app : tyConKind T ~> k G |-ty T : k G |-ki k1 ok -G, z_k1 |-ty t : TYPE s -not (z elt fv(s)) ------------------------- :: ForAllTy -G |-ty forall z_k1. t : TYPE s +G, alpha_k1 |-ty t : TYPE s +not (alpha elt fv(s)) +------------------------ :: ForAllTy_Tv +G |-ty forall alpha_k1. t : TYPE s + +phi = s1 k1~#k2 s2 +G |-ki phi ok +G, x_phi |-ty t : TYPE s +x elt fv(t) +--------------------- :: ForAllTy_Cv +G |-ty forall x_phi.t : * G |-tylit lit : k -------------- :: LitTy ===================================== docs/core-spec/CoreSyn.ott ===================================== @@ -143,6 +143,7 @@ g {{ tex \gamma }}, h {{ tex \eta }} :: 'Coercion_' ::= {{ com Coercions, \coder | < t > R mg :: :: GRefl {{ com \ctor{GRefl}: Generalized Reflexivity }} {{ tex {\langle [[t]] \rangle}^{[[mg]]}_{[[R]]} }} | T RA :: :: TyConAppCo {{ com \ctor{TyConAppCo}: Type constructor application }} + | g1 -> RA g2 :: :: FunCo {{ com \ctor{FunCo}: Functions }} | g1 g2 :: :: AppCo {{ com \ctor{AppCo}: Application }} | forall z : h . g :: :: ForAllCo {{ com \ctor{ForAllCo}: Polymorphism }} {{ tex [[forall]] [[z]]{:}[[h]].[[g]] }} @@ -162,6 +163,7 @@ g {{ tex \gamma }}, h {{ tex \eta }} :: 'Coercion_' ::= {{ com Coercions, \coder | sub g :: :: SubCo {{ com \ctor{SubCo}: Sub-role --- convert nominal to representational }} | ( g ) :: M :: Parens {{ com Parentheses }} | t $ liftingsubst :: M :: Lifted {{ com Type lifted to coercion }} + | downgradeRole R g :: M :: downgradeRole {{ com \textsf{downgradeRole} }} prov :: 'UnivCoProvenance_' ::= {{ com \ctor{UnivCo} provenance, \coderef{types/TyCoRep.hs}{UnivCoProvenance} }} | UnsafeCoerceProv :: :: UnsafeCoerceProv {{ com From \texttt{unsafeCoerce\#} }} @@ -396,8 +398,10 @@ terminals :: 'terminals_' ::= | --> :: :: steps {{ tex \longrightarrow }} | coercionKind :: :: coercionKind {{ tex \textsf{coercionKind} }} | coercionRole :: :: coercionRole {{ tex \textsf{coercionRole} }} + | downgradeRole :: :: downgradeRole {{ tex \textsf{downgradeRole} }} | take :: :: take {{ tex \textsf{take}\! }} | coaxrProves :: :: coaxrProves {{ tex \textsf{coaxrProves} }} + | almostDevoid :: :: almostDevoid {{ tex \textsf{almostDevoid} }} | Just :: :: Just {{ tex \textsf{Just} }} | \\ :: :: newline {{ tex \\ }} | classifiesTypeWithValues :: :: ctwv {{ tex \textsf{classifiesTypeWithValues} }} @@ -483,6 +487,7 @@ formula :: 'formula_' ::= | z elt vars :: :: in_vars | split _ I s = types :: :: split_type {{ tex \mathop{\textsf{split} }_{[[I]]} [[s]] = [[types]] }} + | almostDevoid x g :: :: almostDevoid %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Subrules and Parsing %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ===================================== docs/core-spec/core-spec.mng ===================================== @@ -7,6 +7,7 @@ \usepackage{xcolor} \usepackage{fullpage} \usepackage{multirow} +\usepackage{hyperref} \usepackage{url} \newcommand{\ghcfile}[1]{\textsl{#1}} @@ -106,10 +107,10 @@ There are a few key invariants about expressions: \item The right-hand sides of all top-level and recursive $[[let]]$s must be of lifted type, with one exception: the right-hand side of a top-level $[[let]]$ may be of type \texttt{Addr\#} if it's a primitive string literal. -See \verb|#top_level_invariant#| in \ghcfile{coreSyn/CoreSyn.hs}. +See \verb|#top_level_invariant#| in \ghcfile{GHC.Core}. \item The right-hand side of a non-recursive $[[let]]$ and the argument of an application may be of unlifted type, but only if the expression -is ok-for-speculation. See \verb|#let_app_invariant#| in \ghcfile{coreSyn/CoreSyn.hs}. +is ok-for-speculation. See \verb|#let_app_invariant#| in \ghcfile{GHC.Core}. \item We allow a non-recursive $[[let]]$ for bind a type variable. \item The $[[_]]$ case for a $[[case]]$ must come first. \item The list of case alternatives must be exhaustive. @@ -119,7 +120,7 @@ In other words, the payload inside of a \texttt{Type} constructor must not turn to be built with \texttt{CoercionTy}. \item Join points (introduced by $[[join]]$ expressions) follow the invariants laid out in \verb|Note [Invariants on join points]| in -\ghcfile{coreSyn/CoreSyn.hs}: +\ghcfile{GHC.Core}: \begin{enumerate} \item All occurrences must be tail calls. This is enforced in our typing rules using the label environment $[[D]]$. @@ -166,13 +167,14 @@ A program is just a list of bindings: \gram{\ottprogram} \subsection{Types} +\label{sec:types} \gram{\ottt} \ctor{FunTy} is the special case for non-dependent function type. The -\ctor{TyBinder} in \ghcfile{types/TyCoRep.hs} distinguishes whether a binder is +\ctor{TyBinder} in \ghcfile{GHC.Core.TyCo.Rep} distinguishes whether a binder is anonymous (\ctor{FunTy}) or named (\ctor{ForAllTy}). See -\verb|Note [TyBinders]| in \ghcfile{types/TyCoRep.hs}. +\verb|Note [TyBinders]| in \ghcfile{GHC.Core.TyCo.Rep}. There are some invariants on types: \begin{itemize} @@ -191,7 +193,7 @@ a term-level literal, but we are ignoring this distinction here. \item If $[[forall n. t]]$ is a polymorphic type over a coercion variable (i.e. $[[n]]$ is a coercion variable), then $[[n]]$ must appear in $[[t]]$; otherwise it should be represented as a \texttt{FunTy}. See \texttt{Note - [Unused coercion variable in ForAllTy]} in \ghcfile{types/TyCoRep.hs}. + [Unused coercion variable in ForAllTy]} in \ghcfile{GHC.Core.TyCo.Rep}. \end{itemize} Note that the use of the $[[T ]]$ form and the $[[t1 -> t2]]$ form @@ -216,14 +218,15 @@ Invariants on coercions: reflexive, use $[[T_R ]]$, never $[[ g1 g2]] \ldots$. \item The $[[T]]$ in $[[T_R ]]$ is never a type synonym, though it could be a type function. -\item Every non-reflexive coercion coerces between two distinct types. \item The name in a coercion must be a term-level name (\ctor{Id}). \item The contents of $[[]]$ must not be a coercion. In other words, the payload in a \texttt{Refl} must not be built with \texttt{CoercionTy}. \item If $[[forall z: h .g]]$ is a polymorphic coercion over a coercion variable (i.e. $[[z]]$ is a coercion variable), then $[[z]]$ can only appear in - \texttt{Refl} and \texttt{GRefl} in $[[g]]$. See \texttt{Note[Unused coercion - variable in ForAllCo] in \ghcfile{types/Coercion.hs}}. + \texttt{Refl} and \texttt{GRefl} in $[[g]]$. See \texttt{Note [Unused coercion + variable in ForAllCo] in \ghcfile{GHC.Core.Coercion}}. +\item Prefer $[[g1 ->_R g2]]$ over $[[(->)_R g1 g2]]$; that is, we use \ctor{FunCo}, +never \ctor{TyConAppCo}, for coercions over saturated uses of $[[->]]$. \end{itemize} The \texttt{UnivCo} constructor takes several arguments: the two types coerced @@ -327,7 +330,7 @@ synonym for $[[TYPE 'Unlifted]]$. \section{Contexts} -The functions in \ghcfile{coreSyn/CoreLint.hs} use the \texttt{LintM} monad. +The functions in \ghcfile{GHC.Core.Lint} use the \texttt{LintM} monad. This monad contains a context with a set of bound variables $[[G]]$ and a set of bound labels $[[D]]$. The formalism treats $[[G]]$ and $[[D]]$ as ordered lists, but GHC uses sets as its @@ -432,6 +435,15 @@ a dead id and for one-tuples. These checks are omitted here. \ottdefnlintType{} +Note the contrast between \ottdrulename{Ty\_ForAllTy\_Tv} and \ottdrulename{Ty\_ForAllTy\_Cv}. +The former checks type abstractions, which are erased at runtime. Thus, the kind of the +body must be the same as the kind of the $[[forall]]$-type (as these kinds indicate +the runtime representation). The latter checks coercion abstractions, which are \emph{not} +erased at runtime. Accordingly, the kind of a coercion abstraction is $[[*]]$. The +\ottdrulename{Ty\_ForAllTy\_Cv} rule also asserts that the bound variable $[[x]]$ is +actually used in $[[t]]$: this is to uphold a representation invariant, documented +with the grammar for types, Section~\ref{sec:types}. + \subsection{Kind validity} \ottdefnlintKind{} @@ -451,6 +463,19 @@ and \ottdrulename{Co\_CoVarCoRepr}. See Section~\ref{sec:tyconroles} for more information about $[[tyConRolesX]]$, and see Section~\ref{sec:axiom_rules} for more information about $[[coaxrProves]]$. +The $[[downgradeRole R g]]$ function returns a new coercion that relates the same +types as $[[g]]$ but with role $[[R]]$. It assumes that the role of $[[g]]$ is a +sub-role ($\leq$) of $[[R]]$. + +The $[[almostDevoid x g]]$ function makes sure that, if $[[x]]$ appears at all +in $[[g]]$, it appears only within a \ctor{Refl} or \ctor{GRefl} node. See +Section 5.8.5.2 of Richard Eisenberg's thesis for the details, or the ICFP'17 +paper ``A Specification for Dependently-Typed Haskell''. (Richard's thesis +uses a technical treatment of this idea that's very close to GHC's implementation. +The ICFP'17 paper approaches the same restriction in a different way, by using +\emph{available sets} $\Delta$, as explained in Section 4.2 of that paper. +We believe both technical approaches are equivalent in what coercions they accept.) + \subsection{Name consistency} \label{sec:name_consistency} @@ -463,7 +488,7 @@ There are three very similar checks for names, two performed as part of The point of the extra checks on $[[t']]$ is that a join point's type cannot be polymorphic in its return type; see \texttt{Note [The polymorphism rule of join -points]} in \ghcfile{coreSyn/CoreSyn.hs}. +points]} in \ghcfile{GHC.Core}. \ottdefnlintBinder{} ===================================== docs/core-spec/core-spec.pdf ===================================== Binary files a/docs/core-spec/core-spec.pdf and b/docs/core-spec/core-spec.pdf differ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/4f2c8810cab3b2a76bb5e85d6c4c956aa91c3ac8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/4f2c8810cab3b2a76bb5e85d6c4c956aa91c3ac8 You're receiving 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 Mar 19 17:36:49 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Thu, 19 Mar 2020 13:36:49 -0400 Subject: [Git][ghc/ghc][wip/T17676] Rename isBot* to isDeadEnd* Message-ID: <5e73adb13a0c7_488a3fc6f8fa0cb8221182d@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T17676 at Glasgow Haskell Compiler / GHC Commits: 28a031e8 by Sebastian Graf at 2020-03-19T17:36:40Z Rename isBot* to isDeadEnd* - - - - - 17 changed files: - compiler/GHC.hs - compiler/GHC/Core/Arity.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/IfaceToCore.hs - compiler/basicTypes/Demand.hs - compiler/basicTypes/Id.hs - compiler/basicTypes/MkId.hs - compiler/simplCore/CallArity.hs - compiler/simplCore/FloatOut.hs - compiler/simplCore/LiberateCase.hs - compiler/simplCore/SetLevels.hs - compiler/simplCore/SimplUtils.hs - compiler/simplCore/Simplify.hs - compiler/specialise/SpecConstr.hs Changes: ===================================== compiler/GHC.hs ===================================== @@ -179,7 +179,7 @@ module GHC ( isRecordSelector, isPrimOpId, isFCallId, isClassOpId_maybe, isDataConWorkId, idDataCon, - isBottomingId, isDictonaryId, + isDeadEndId, isDictonaryId, recordSelectorTyCon, -- ** Type constructors ===================================== compiler/GHC/Core/Arity.hs ===================================== @@ -759,7 +759,7 @@ arityType _ (Var v) , not $ isTopSig strict_sig , (ds, res) <- splitStrictSig strict_sig , let arity = length ds - = if isBotDiv res then ABot arity + = if isDeadEndDiv res then ABot arity else ATop (take arity one_shots) | otherwise = ATop (take (idArity v) one_shots) ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -65,7 +65,7 @@ import Util import GHC.Core.InstEnv ( instanceDFunId ) import GHC.Core.Coercion.Opt ( checkAxInstCo ) import GHC.Core.Arity ( typeArity ) -import Demand ( splitStrictSig, isBotDiv ) +import Demand ( splitStrictSig, isDeadEndDiv ) import GHC.Driver.Types import GHC.Driver.Session @@ -651,7 +651,7 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs) ppr binder) ; case splitStrictSig (idStrictness binder) of - (demands, result_info) | isBotDiv result_info -> + (demands, result_info) | isDeadEndDiv result_info -> checkL (demands `lengthAtLeast` idArity binder) (text "idArity" <+> ppr (idArity binder) <+> text "exceeds arity imposed by the strictness signature" <+> ===================================== compiler/GHC/Core/Unfold.hs ===================================== @@ -53,7 +53,7 @@ import GHC.Core.SimpleOpt import GHC.Core.Arity ( manifestArity ) import GHC.Core.Utils import Id -import Demand ( isBottomingSig ) +import Demand ( isDeadEndSig ) import GHC.Core.DataCon import Literal import PrimOp @@ -1176,7 +1176,7 @@ certainlyWillInline dflags fn_info -- See Note [certainlyWillInline: INLINABLE] do_cunf expr (UnfIfGoodArgs { ug_size = size, ug_args = args }) | arityInfo fn_info > 0 -- See Note [certainlyWillInline: be careful of thunks] - , not (isBottomingSig (strictnessInfo fn_info)) + , not (isDeadEndSig (strictnessInfo fn_info)) -- Do not unconditionally inline a bottoming functions even if -- it seems smallish. We've carefully lifted it out to top level, -- so we don't want to re-inline it. ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -1111,7 +1111,7 @@ exprIsBottom e | otherwise = go 0 e where - go n (Var v) = isBottomingId v && n >= idArity v + go n (Var v) = isDeadEndId v && n >= idArity v go n (App e a) | isTypeArg a = go n e | otherwise = go (n+1) e go n (Tick _ e) = go n e @@ -1434,7 +1434,7 @@ isWorkFreeApp fn n_val_args isCheapApp :: CheapAppFun isCheapApp fn n_val_args | isWorkFreeApp fn n_val_args = True - | isBottomingId fn = True -- See Note [isCheapApp: bottoming functions] + | isDeadEndId fn = True -- See Note [isCheapApp: bottoming functions] | otherwise = case idDetails fn of DataConWorkId {} -> True -- Actually handled by isWorkFreeApp @@ -1456,7 +1456,7 @@ isExpandableApp fn n_val_args RecSelId {} -> n_val_args == 1 -- See Note [Record selection] ClassOpId {} -> n_val_args == 1 PrimOpId {} -> False - _ | isBottomingId fn -> False + _ | isDeadEndId fn -> False -- See Note [isExpandableApp: bottoming functions] | isConLike (idRuleMatchInfo fn) -> True | all_args_are_preds -> True @@ -2202,7 +2202,7 @@ diffExpr top env (Tick n1 e1) (Tick n2 e2) -- generated names, which are allowed to differ. diffExpr _ _ (App (App (Var absent) _) _) (App (App (Var absent2) _) _) - | isBottomingId absent && isBottomingId absent2 = [] + | isDeadEndId absent && isDeadEndId absent2 = [] diffExpr top env (App f1 a1) (App f2 a2) = diffExpr top env f1 f2 ++ diffExpr top env a1 a2 diffExpr top env (Lam b1 e1) (Lam b2 e2) ===================================== compiler/GHC/Iface/Tidy.hs ===================================== @@ -39,7 +39,7 @@ import MkId ( mkDictSelRhs ) import IdInfo import GHC.Core.InstEnv import GHC.Core.Type ( tidyTopType ) -import Demand ( appIsBottom, isTopSig, isBottomingSig ) +import Demand ( appIsBottom, isTopSig, isDeadEndSig ) import Cpr ( mkCprSig, botCpr ) import BasicTypes import Name hiding (varName) @@ -726,7 +726,7 @@ addExternal omit_prags expose_all id show_unfold = show_unfolding unfolding never_active = isNeverActive (inlinePragmaActivation (inlinePragInfo idinfo)) loop_breaker = isStrongLoopBreaker (occInfo idinfo) - bottoming_fn = isBottomingSig (strictnessInfo idinfo) + bottoming_fn = isDeadEndSig (strictnessInfo idinfo) -- Stuff to do with the Id's unfolding -- We leave the unfolding there even if there is a worker @@ -1240,7 +1240,7 @@ tidyTopIdInfo dflags rhs_tidy_env name orig_rhs tidy_rhs idinfo show_unfold = minimal_unfold_info minimal_unfold_info = zapUnfolding unf_info unf_from_rhs = mkTopUnfolding dflags is_bot tidy_rhs - is_bot = isBottomingSig final_sig + is_bot = isDeadEndSig final_sig -- NB: do *not* expose the worker if show_unfold is off, -- because that means this thing is a loop breaker or -- marked NOINLINE or something like that ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -1508,7 +1508,7 @@ tcUnfolding toplvl name _ info (IfCoreUnfold stable if_expr) Nothing -> NoUnfolding Just expr -> mkUnfolding dflags unf_src True {- Top level -} - (isBottomingSig strict_sig) + (isDeadEndSig strict_sig) expr } where ===================================== compiler/basicTypes/Demand.hs ===================================== @@ -28,8 +28,8 @@ module Demand ( DmdEnv, emptyDmdEnv, peelFV, findIdDemand, - Divergence(..), lubDivergence, isBotDiv, topDiv, botDiv, exnDiv, conDiv, - appIsBottom, isBottomingSig, pprIfaceStrictSig, + Divergence(..), lubDivergence, isDeadEndDiv, topDiv, botDiv, exnDiv, conDiv, + appIsBottom, isDeadEndSig, pprIfaceStrictSig, StrictSig(..), mkStrictSigForArity, mkClosedStrictSig, emptySig, botSig, cprProdSig, isTopSig, hasDemandEnvSig, @@ -240,7 +240,7 @@ The solution is to give 'raiseIO#' 'topDiv' instead of 'botDiv', so that its of dead code, namely when 'raiseIO#' occurs in a case scrutinee. Hence we need to give it 'exnDiv', which was conceived entirely for this reason. The default FV demand of 'exnDiv' is lazy, its default arg dmd is absent, but otherwise (in -terms of 'Demand.isBotDiv') it behaves exactly as 'botDiv', so that dead code +terms of 'Demand.isDeadEndDiv') it behaves exactly as 'botDiv', so that dead code elimination works as expected. -} @@ -988,7 +988,7 @@ splitProdDmd_maybe (JD { sd = s, ud = u }) data Divergence = Diverges -- ^ Definitely throws an imprecise exception or diverges. | ExnOrDiv -- ^ Definitely throws a *precise* exception, an imprecise - -- exception or diverges. Never converges, hence 'isBotDiv'! + -- exception or diverges. Never converges, hence 'isDeadEndDiv'! -- See scenario 2 in Note [Precise exceptions and strictness analysis]. | ConOrDiv -- ^ Definitely converges, throws an imprecise exception or -- diverges. Never throws a precise exception! Important for @@ -1040,11 +1040,11 @@ conDiv = ConOrDiv botDiv = Diverges -- | True if the result indicates that evaluation will not return. -isBotDiv :: Divergence -> Bool -isBotDiv Diverges = True -isBotDiv ExnOrDiv = True -isBotDiv ConOrDiv = False -isBotDiv Dunno = False +isDeadEndDiv :: Divergence -> Bool +isDeadEndDiv Diverges = True +isDeadEndDiv ExnOrDiv = True +isDeadEndDiv ConOrDiv = False +isDeadEndDiv Dunno = False -- See Notes [Default demand on free variables] -- and [defaultFvDmd vs. defaultArgDmd] @@ -1739,8 +1739,8 @@ strictSigDmdEnv :: StrictSig -> DmdEnv strictSigDmdEnv (StrictSig (DmdType env _ _)) = env -- | True if the signature diverges or throws an exception -isBottomingSig :: StrictSig -> Bool -isBottomingSig (StrictSig (DmdType _ _ res)) = isBotDiv res +isDeadEndSig :: StrictSig -> Bool +isDeadEndSig (StrictSig (DmdType _ _ res)) = isDeadEndDiv res -- | See 'emptyDmdType'. emptySig :: Divergence ->StrictSig @@ -1886,7 +1886,7 @@ binders \pqr and \xyz; see Note [Use one-shot information] in OccurAnal. -- See Note [Unsaturated applications] appIsBottom :: StrictSig -> Int -> Bool appIsBottom (StrictSig (DmdType _ ds res)) n - | isBotDiv res = not $ lengthExceeds ds n + | isDeadEndDiv res = not $ lengthExceeds ds n appIsBottom _ _ = False {- ===================================== compiler/basicTypes/Id.hs ===================================== @@ -70,7 +70,7 @@ module Id ( isDataConWrapId, isDataConWrapId_maybe, isDataConId_maybe, idDataCon, - isConLikeId, isBottomingId, idIsFrom, + isConLikeId, isDeadEndId, idIsFrom, hasNoBinding, -- ** Join variables @@ -638,9 +638,9 @@ idFunRepArity :: Id -> RepArity idFunRepArity x = countFunRepArgs (idArity x) (idType x) -- | Returns true if an application to n args would diverge -isBottomingId :: Var -> Bool -isBottomingId v - | isId v = isBottomingSig (idStrictness v) +isDeadEndId :: Var -> Bool +isDeadEndId v + | isId v = isDeadEndSig (idStrictness v) | otherwise = False -- | Accesses the 'Id''s 'strictnessInfo'. ===================================== compiler/basicTypes/MkId.hs ===================================== @@ -1227,7 +1227,7 @@ mkPrimOpId prim_op -- PrimOps don't ever construct a product, but we want to preserve bottoms cpr - | isBotDiv (snd (splitStrictSig strict_sig)) = botCpr + | isDeadEndDiv (snd (splitStrictSig strict_sig)) = botCpr | otherwise = topCpr info = noCafIdInfo ===================================== compiler/simplCore/CallArity.hs ===================================== @@ -701,7 +701,7 @@ trimArity v a = minimum [a, max_arity_by_type, max_arity_by_strsig] where max_arity_by_type = length (typeArity (idType v)) max_arity_by_strsig - | isBotDiv result_info = length demands + | isDeadEndDiv result_info = length demands | otherwise = a (demands, result_info) = splitStrictSig (idStrictness v) ===================================== compiler/simplCore/FloatOut.hs ===================================== @@ -20,7 +20,7 @@ import CoreMonad ( FloatOutSwitches(..) ) import GHC.Driver.Session import ErrUtils ( dumpIfSet_dyn, DumpFormat (..) ) -import Id ( Id, idArity, idType, isBottomingId, +import Id ( Id, idArity, idType, isDeadEndId, isJoinId, isJoinId_maybe ) import SetLevels import UniqSupply ( UniqSupply ) @@ -221,7 +221,7 @@ floatBind (NonRec (TB var _) rhs) -- A tiresome hack: -- see Note [Bottoming floats: eta expansion] in SetLevels - let rhs'' | isBottomingId var = etaExpand (idArity var) rhs' + let rhs'' | isDeadEndId var = etaExpand (idArity var) rhs' | otherwise = rhs' in (fs, rhs_floats, [NonRec var rhs'']) } ===================================== compiler/simplCore/LiberateCase.hs ===================================== @@ -158,8 +158,8 @@ libCaseBind env (Rec pairs) Let (Rec dup_pairs) (Var unitDataConId) ok_pair (id,_) - = idArity id > 0 -- Note [Only functions!] - && not (isBottomingId id) -- Note [Not bottoming ids] + = idArity id > 0 -- Note [Only functions!] + && not (isDeadEndId id) -- Note [Not bottoming ids] {- Note [Not bottoming Ids] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/simplCore/SetLevels.hs ===================================== @@ -293,7 +293,7 @@ lvlTopBind env (Rec pairs) lvl_top :: LevelEnv -> RecFlag -> Id -> CoreExpr -> LvlM LevelledExpr lvl_top env is_rec bndr rhs = lvlRhs env is_rec - (isBottomingId bndr) + (isDeadEndId bndr) Nothing -- Not a join point (freeVars rhs) ===================================== compiler/simplCore/SimplUtils.hs ===================================== @@ -499,7 +499,7 @@ mkArgInfo env fun rules n_val_args call_cont -- top-level bindings for (say) strings into -- calls to error. But now we are more careful about -- inlining lone variables, so its ok (see SimplUtils.analyseCont) - if isBotDiv result_info then + if isDeadEndDiv result_info then map isStrictDmd demands -- Finite => result is bottom else map isStrictDmd demands ++ vanilla_stricts @@ -1141,7 +1141,7 @@ preInlineUnconditionally preInlineUnconditionally env top_lvl bndr rhs rhs_env | not pre_inline_unconditionally = Nothing | not active = Nothing - | isTopLevel top_lvl && isBottomingId bndr = Nothing -- Note [Top-level bottoming Ids] + | isTopLevel top_lvl && isDeadEndId bndr = Nothing -- Note [Top-level bottoming Ids] | isCoVar bndr = Nothing -- Note [Do not inline CoVars unconditionally] | isExitJoinId bndr = Nothing -- Note [Do not inline exit join points] -- in module Exitify ===================================== compiler/simplCore/Simplify.hs ===================================== @@ -3513,7 +3513,7 @@ mkLetUnfolding dflags top_lvl src id new_rhs -- we don't.) The simple thing is always to have one. where is_top_lvl = isTopLevel top_lvl - is_bottoming = isBottomingId id + is_bottoming = isDeadEndId id ------------------- simplStableUnfolding :: SimplEnv -> TopLevelFlag ===================================== compiler/specialise/SpecConstr.hs ===================================== @@ -1599,8 +1599,8 @@ specialise env bind_calls (RI { ri_fn = fn, ri_lam_bndrs = arg_bndrs , ri_lam_body = body, ri_arg_occs = arg_occs }) spec_info@(SI { si_specs = specs, si_n_specs = spec_count , si_mb_unspec = mb_unspec }) - | isBottomingId fn -- Note [Do not specialise diverging functions] - -- and do not generate specialisation seeds from its RHS + | isDeadEndId fn -- Note [Do not specialise diverging functions] + -- and do not generate specialisation seeds from its RHS = -- pprTrace "specialise bot" (ppr fn) $ return (nullUsage, spec_info) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/28a031e817d40fe0366a64e52da2f235b72cbfd3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/28a031e817d40fe0366a64e52da2f235b72cbfd3 You're receiving 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 Mar 18 17:43:20 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 18 Mar 2020 13:43:20 -0400 Subject: [Git][ghc/ghc][wip/test] 2 commits: release notes: Fix undefined references Message-ID: <5e725db833eca_488a3fc6a691ddac1989087@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/test at Glasgow Haskell Compiler / GHC Commits: 00d25137 by Ben Gamari at 2020-03-18T17:42:15Z release notes: Fix undefined references - - - - - a5caf1a2 by Ben Gamari at 2020-03-18T17:43:11Z 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). (cherry picked from commit e43e6ece1418f84e50d572772394ab639a083e79) - - - - - 11 changed files: - docs/users_guide/8.10.1-notes.rst - docs/users_guide/runtime_control.rst - includes/rts/EventLogWriter.h - rts/Trace.c - rts/eventlog/EventLog.c - rts/eventlog/EventLog.h - rts/eventlog/EventLogWriter.c - + testsuite/tests/rts/InitEventLogging.hs - + testsuite/tests/rts/InitEventLogging.stdout - + testsuite/tests/rts/InitEventLogging_c.c - testsuite/tests/rts/all.T Changes: ===================================== docs/users_guide/8.10.1-notes.rst ===================================== @@ -176,7 +176,7 @@ Language good story for graceful degradation in these situations. These situations should occur much less frequently now and degradation happens much more smoothly, while still producing useful, sound results (see - :ghc-flag:`-fmax-pmcheck-models`). + :ghc-flag:`-fmax-pmcheck-models=⟨n⟩`). Compiler ~~~~~~~~ @@ -230,8 +230,8 @@ Compiler and much more. See the :ref:`user guide ` for more details as well as an example. -- Deprecated flag :ghc-flag:`-fmax-pmcheck-iterations` in favor of - :ghc-flag:`-fmax-pmcheck-models`, which uses a completely different mechanism. +- Deprecated flag ``-fmax-pmcheck-iterations`` in favor of + :ghc-flag:`-fmax-pmcheck-models=⟨n⟩`, which uses a completely different mechanism. - GHC now writes ``.o`` files atomically, resulting in reduced chances of truncated files when a build is cancelled or the computer crashes. ===================================== docs/users_guide/runtime_control.rst ===================================== @@ -174,6 +174,8 @@ e.g., on stack overflow. The hooks for these are as follows: The message printed if ``malloc`` fails. +.. _event_log_output_api: + Event log output ################ @@ -190,7 +192,7 @@ Furthermore GHC lets you specify the way event log data (see :rts-flag:`-l .. c:member:: bool writeEventLog(void *eventlog, size_t eventlog_size) - Hands buffered event log data to your event log writer. + Hands buffered event log data to your event log writer. Return true on success. Required for a custom :c:type:`EventLogWriter`. .. c:member:: void flushEventLog(void) @@ -202,6 +204,24 @@ Furthermore GHC lets you specify the way event log data (see :rts-flag:`-l Called when event logging is about to stop. This can be ``NULL``. +To use an :c:type:`EventLogWriter` the RTS API provides the following functions: + +.. c:func:: enum EventLogStatus eventLogStatus(void) + + Query whether the current runtime system supports the eventlog (e.g. whether + the current executable was linked with :ghc-flag:`-eventlog`) and, if it + is supported, whether it is currently logging. + +.. c:func:: 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. + +.. c:func:: void endEventLogging() + + Tear down the active :c:type:`EventLogWriter`. + + .. _rts-options-misc: Miscellaneous RTS options ===================================== includes/rts/EventLogWriter.h ===================================== @@ -23,7 +23,7 @@ typedef struct { // Initialize an EventLogWriter (may be NULL) void (* initEventLogWriter) (void); - // Write a series of events + // Write a series of events returning true on success. bool (* writeEventLog) (void *eventlog, size_t eventlog_size); // Flush possibly existing buffers (may be NULL) @@ -38,3 +38,29 @@ typedef struct { * a file `program.eventlog`. */ extern const EventLogWriter FileEventLogWriter; + +enum EventLogStatus { + /* The runtime system wasn't compiled with eventlog support. */ + EVENTLOG_NOT_SUPPORTED, + /* An EventLogWriter has not yet been configured */ + EVENTLOG_NOT_CONFIGURED, + /* An EventLogWriter has been configured and is running. */ + EVENTLOG_RUNNING, +}; + +/* + * Query whether the current runtime system supports eventlogging. + */ +enum EventLogStatus eventLogStatus(void); + +/* + * Initialize event logging using the given EventLogWriter. + * Returns true on success or false if an EventLogWriter is already configured + * or eventlogging isn't supported by the runtime. + */ +bool startEventLogging(const EventLogWriter *writer); + +/* + * Stop event logging and destroy the current EventLogWriter. + */ +void endEventLogging(void); ===================================== rts/Trace.c ===================================== @@ -40,21 +40,12 @@ int TRACE_cap; static Mutex trace_utx; #endif -static bool eventlog_enabled; - /* --------------------------------------------------------------------------- Starting up / shutting down the tracing facilities --------------------------------------------------------------------------- */ -static const EventLogWriter *getEventLogWriter(void) -{ - return rtsConfig.eventlog_writer; -} - void initTracing (void) { - const EventLogWriter *eventlog_writer = getEventLogWriter(); - #if defined(THREADED_RTS) initMutex(&trace_utx); #endif @@ -95,15 +86,14 @@ void initTracing (void) TRACE_spark_full || TRACE_user; - eventlog_enabled = RtsFlags.TraceFlags.tracing == TRACE_EVENTLOG && - eventlog_writer != NULL; - /* Note: we can have any of the TRACE_* flags turned on even when eventlog_enabled is off. In the DEBUG way we may be tracing to stderr. */ + initEventLogging(); - if (eventlog_enabled) { - initEventLogging(eventlog_writer); + if (RtsFlags.TraceFlags.tracing == TRACE_EVENTLOG + && rtsConfig.eventlog_writer != NULL) { + startEventLogging(rtsConfig.eventlog_writer); } } @@ -121,17 +111,10 @@ void freeTracing (void) } } +// Used to reset tracing in a forked child void resetTracing (void) { - const EventLogWriter *eventlog_writer; - eventlog_writer = getEventLogWriter(); - - if (eventlog_enabled) { - abortEventLogging(); // abort eventlog inherited from parent - if (eventlog_writer != NULL) { - initEventLogging(eventlog_writer); // child starts its own eventlog - } - } + restartEventLogging(); } void flushTrace (void) ===================================== rts/eventlog/EventLog.c ===================================== @@ -26,7 +26,9 @@ #include #endif -static const EventLogWriter *event_log_writer; +bool eventlog_enabled; + +static const EventLogWriter *event_log_writer = NULL; #define EVENT_LOG_SIZE 2 * (1024 * 1024) // 2MB @@ -516,16 +518,22 @@ postHeaderEvents(void) postInt32(&eventBuf, EVENT_DATA_BEGIN); } -void -initEventLogging(const EventLogWriter *ev_writer) +static uint32_t +get_n_capabilities(void) { - uint32_t n_caps; +#if defined(THREADED_RTS) + // XXX n_capabilities may not have been initialized yet + return (n_capabilities != 0) ? n_capabilities : RtsFlags.ParFlags.nCapabilities; +#else + return 1; +#endif +} +void +initEventLogging() +{ init_event_types(); - event_log_writer = ev_writer; - initEventLogWriter(); - int num_descs = sizeof(EventDesc) / sizeof(char*); if (num_descs != NUM_GHC_EVENT_TAGS) { barf("EventDesc array has the wrong number of elements (%d, NUM_GHC_EVENT_TAGS=%d)", @@ -542,18 +550,28 @@ initEventLogging(const EventLogWriter *ev_writer) * Use a single buffer to store the header with event types, then flush * the buffer so all buffers are empty for writing events. */ -#if defined(THREADED_RTS) - // XXX n_capabilities hasn't been initialized yet - n_caps = RtsFlags.ParFlags.nCapabilities; -#else - n_caps = 1; -#endif - moreCapEventBufs(0, n_caps); + moreCapEventBufs(0, get_n_capabilities()); initEventsBuf(&eventBuf, EVENT_LOG_SIZE, (EventCapNo)(-1)); #if defined(THREADED_RTS) initMutex(&eventBufMutex); #endif +} + +enum EventLogStatus +eventLogStatus(void) +{ + if (eventlog_enabled) { + return EVENTLOG_RUNNING; + } else { + return EVENTLOG_NOT_CONFIGURED; + } +} + +static bool +startEventLogging_(void) +{ + initEventLogWriter(); postHeaderEvents(); @@ -564,14 +582,42 @@ initEventLogging(const EventLogWriter *ev_writer) */ printAndClearEventBuf(&eventBuf); - for (uint32_t c = 0; c < n_caps; ++c) { + for (uint32_t c = 0; c < get_n_capabilities(); ++c) { postBlockMarker(&capEventBuf[c]); } + return true; +} + +bool +startEventLogging(const EventLogWriter *ev_writer) +{ + if (eventlog_enabled || event_log_writer) { + return false; + } + + eventlog_enabled = true; + event_log_writer = ev_writer; + return startEventLogging_(); +} + +// Called during forkProcess in the child to restart the eventlog writer. +void +restartEventLogging(void) +{ + freeEventLogging(); + stopEventLogWriter(); + initEventLogging(); // allocate new per-capability buffers + if (event_log_writer != NULL) { + startEventLogging_(); // child starts its own eventlog + } } void endEventLogging(void) { + if (!eventlog_enabled) + return; + // Flush all events remaining in the buffers. for (uint32_t c = 0; c < n_capabilities; ++c) { printAndClearEventBuf(&capEventBuf[c]); @@ -586,6 +632,8 @@ endEventLogging(void) printAndClearEventBuf(&eventBuf); stopEventLogWriter(); + event_log_writer = NULL; + eventlog_enabled = false; } void @@ -626,13 +674,6 @@ freeEventLogging(void) } } -void -abortEventLogging(void) -{ - freeEventLogging(); - stopEventLogWriter(); -} - /* * Post an event message to the capability's eventlog buffer. * If the buffer is full, prints out the buffer and clears it. @@ -1440,7 +1481,7 @@ void printAndClearEventBuf (EventsBuf *ebuf) size_t elog_size = ebuf->pos - ebuf->begin; if (!writeEventLog(ebuf->begin, elog_size)) { debugBelch( - "printAndClearEventLog: could not flush event log" + "printAndClearEventLog: could not flush event log\n" ); resetEventsBuf(ebuf); return; @@ -1524,4 +1565,17 @@ void postEventType(EventsBuf *eb, EventType *et) postInt32(eb, EVENT_ET_END); } +#else + +enum EventLogStatus eventLogStatus(void) +{ + return EVENTLOG_NOT_SUPPORTED; +} + +bool startEventLogging(const EventLogWriter *writer STG_UNUSED) { + return false; +} + +void endEventLogging(void) {} + #endif /* TRACING */ ===================================== rts/eventlog/EventLog.h ===================================== @@ -22,8 +22,10 @@ */ extern char *EventTagDesc[]; -void initEventLogging(const EventLogWriter *writer); -void endEventLogging(void); +extern bool eventlog_enabled; + +void initEventLogging(void); +void restartEventLogging(void); void freeEventLogging(void); void abortEventLogging(void); // #4512 - after fork child needs to abort void flushEventLog(void); // event log inherited from parent ===================================== rts/eventlog/EventLogWriter.c ===================================== @@ -122,6 +122,7 @@ stopEventLogFileWriter(void) { if (event_log_file != NULL) { fclose(event_log_file); + event_log_file = NULL; } } ===================================== testsuite/tests/rts/InitEventLogging.hs ===================================== @@ -0,0 +1,11 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +-- Test that the startEventLog interface works as expected. +main :: IO () +main = do + putStrLn "Starting eventlog..." + c_init_eventlog + putStrLn "done" + +foreign import ccall unsafe "init_eventlog" + c_init_eventlog :: IO () ===================================== testsuite/tests/rts/InitEventLogging.stdout ===================================== @@ -0,0 +1,8 @@ +Starting eventlog... +done +init +write +write +write +write +stop ===================================== testsuite/tests/rts/InitEventLogging_c.c ===================================== @@ -0,0 +1,33 @@ +#include +#include + +void test_init(void) { + printf("init\n"); +} + +bool test_write(void *eventlog, size_t eventlog_size) { + printf("write\n"); + return true; +} + +void test_flush(void) { + printf("flush\n"); +} + +void test_stop(void) { + printf("stop\n"); +} + +const EventLogWriter writer = { + .initEventLogWriter = test_init, + .writeEventLog = test_write, + .flushEventLog = test_flush, + .stopEventLogWriter = test_stop +}; + +void init_eventlog(void) { + if (!startEventLogging(&writer)) { + printf("failed to start eventlog\n"); + } +} + ===================================== testsuite/tests/rts/all.T ===================================== @@ -411,3 +411,6 @@ test('T17088', [only_ways(['normal']), extra_run_opts('+RTS -c -A256k -RTS')], compile_and_run, ['-rtsopts -O2']) +test('InitEventLogging', + [only_ways(['normal']), extra_run_opts('+RTS -RTS')], + compile_and_run, ['-eventlog InitEventLogging_c.c']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/671ac3f68327ce7ed0181b5d38c677802085686c...a5caf1a2859837d0e6a74ddbc69eea174b5131c3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/671ac3f68327ce7ed0181b5d38c677802085686c...a5caf1a2859837d0e6a74ddbc69eea174b5131c3 You're receiving 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 Mar 20 17:22:57 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 20 Mar 2020 13:22:57 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/marge_bot_batch_merge_job Message-ID: <5e74fbf1949c7_488a827fd64236071@gitlab.haskell.org.mail> Marge Bot pushed new branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/tree/wip/marge_bot_batch_merge_job You're receiving 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 Mar 20 12:39:04 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Fri, 20 Mar 2020 08:39:04 -0400 Subject: [Git][ghc/ghc][wip/T17932] Demand analysis: simplify the demand for a RHS Message-ID: <5e74b968900bb_488a3fc6ceaba9f8231934c@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T17932 at Glasgow Haskell Compiler / GHC Commits: aa89fe2d by Simon Peyton Jones at 2020-03-20T12:38:58Z 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. 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. - - - - - 4 changed files: - compiler/GHC/Core/Op/DmdAnal.hs - + testsuite/tests/stranal/sigs/T17932.hs - + testsuite/tests/stranal/sigs/T17932.stderr - testsuite/tests/stranal/sigs/all.T Changes: ===================================== compiler/GHC/Core/Op/DmdAnal.hs ===================================== @@ -617,16 +617,11 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs is_thunk = not (exprIsHNF rhs) && not (isJoinId id) -- | @mkRhsDmd env rhs_arity rhs@ creates a 'CleanDemand' for --- unleashing on the given function's @rhs@, by creating a call demand of --- @rhs_arity@ with a body demand appropriate for possible product types. --- See Note [Product demands for function body]. --- For example, a call of the form @mkRhsDmd _ 2 (\x y -> (x, y))@ returns a --- clean usage demand of @C1(C1(U(U,U)))@. +-- 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 -> CleanDemand -mkRhsDmd env rhs_arity rhs = - case peelTsFuns rhs_arity (findTypeShape (ae_fam_envs env) (exprType rhs)) of - Just (TsProd tss) -> mkCallDmds rhs_arity (cleanEvalProdDmd (length tss)) - _ -> mkCallDmds rhs_arity cleanEvalDmd +mkRhsDmd _env rhs_arity _rhs = mkCallDmds rhs_arity cleanEvalDmd -- | If given the let-bound 'Id', 'useLetUp' determines whether we should -- process the binding up (body before rhs) or down (rhs before body). @@ -857,9 +852,9 @@ forward plusInt's demand signature, and all is well (see Note [Newtype arity] in GHC.Core.Arity)! A small example is the test case NewtypeArity. -Note [Product demands for function body] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -This example comes from shootout/binary_trees: +Historical Note [Product demands for function body] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In 2013 I spotted this example, in shootout/binary_trees: Main.check' = \ b z ds. case z of z' { I# ip -> case ds_d13s of @@ -878,8 +873,12 @@ Here we *really* want to unbox z, even though it appears to be used boxed in the Nil case. Partly the Nil case is not a hot path. But more specifically, the whole function gets the CPR property if we do. -So for the demand on the body of a RHS we use a product demand if it's -a product type. +That motivated using a demand of C(C(C(S(L,L)))) for the RHS, where +(solely because the result was a product) we used a product demand +(albeit with lazy components) for the body. But that gives very silly +behaviour -- see #17932. Happily it turns out now to be entirely +unnecessary: we get good results with C(C(C(S))). So I simply +deleted the special case. ************************************************************************ * * ===================================== testsuite/tests/stranal/sigs/T17932.hs ===================================== @@ -0,0 +1,11 @@ +-- See commentary in #17932 + +module T17932 where + +flags (Options f x) + = reverse (reverse (reverse (reverse (reverse (reverse (reverse (reverse x))))))) + `seq` f + +data X = X String Bool Bool Bool Bool + +data Options = Options !X [Int] ===================================== testsuite/tests/stranal/sigs/T17932.stderr ===================================== @@ -0,0 +1,30 @@ + +==================== Strictness signatures ==================== +T17932.$tc'Options: +T17932.$tc'X: +T17932.$tcOptions: +T17932.$tcX: +T17932.$trModule: +T17932.flags: + + + +==================== Cpr signatures ==================== +T17932.$tc'Options: m1 +T17932.$tc'X: m1 +T17932.$tcOptions: m1 +T17932.$tcX: m1 +T17932.$trModule: m1 +T17932.flags: m1 + + + +==================== Strictness signatures ==================== +T17932.$tc'Options: +T17932.$tc'X: +T17932.$tcOptions: +T17932.$tcX: +T17932.$trModule: +T17932.flags: + + ===================================== testsuite/tests/stranal/sigs/all.T ===================================== @@ -19,3 +19,4 @@ test('T12370', normal, compile, ['']) test('CaseBinderCPR', normal, compile, ['']) test('NewtypeArity', normal, compile, ['']) test('T5075', normal, compile, ['']) +test('T17932', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/aa89fe2dec16e68b77dc13574a503a00c589fe5c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/aa89fe2dec16e68b77dc13574a503a00c589fe5c You're receiving 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 Mar 17 23:15:31 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 17 Mar 2020 19:15:31 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: Don't use non-portable operator "==" in configure.ac Message-ID: <5e715a1399396_488a3fc6f8fa0cb818047a7@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: e1aa4052 by PHO at 2020-03-17T11:36:09Z 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-17T11:36:48Z 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-17T11:37:25Z 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-17T11:38:08Z 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-17T11:38:48Z Add example for Data.Semigroup.diff - - - - - 4d85d68b by Paavo at 2020-03-17T11:38:48Z Clean up - - - - - 75168d07 by Paavo at 2020-03-17T11:38:48Z Make example collapsible - - - - - 53ff2cd0 by Richard Eisenberg at 2020-03-17T13:46:57Z 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 - - - - - 093188bf by Sylvain Henry at 2020-03-17T23:15:17Z Modules: Core operations (#13009) - - - - - 30 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/simplCore/CSE.hs → compiler/GHC/Core/Op/CSE.hs - compiler/simplCore/CallArity.hs → compiler/GHC/Core/Op/CallArity.hs - compiler/prelude/PrelRules.hs → compiler/GHC/Core/Op/ConstantFold.hs - compiler/stranal/CprAnal.hs → compiler/GHC/Core/Op/CprAnal.hs - compiler/stranal/DmdAnal.hs → compiler/GHC/Core/Op/DmdAnal.hs - compiler/simplCore/Exitify.hs → compiler/GHC/Core/Op/Exitify.hs - compiler/simplCore/FloatIn.hs → compiler/GHC/Core/Op/FloatIn.hs - compiler/simplCore/FloatOut.hs → compiler/GHC/Core/Op/FloatOut.hs - compiler/simplCore/LiberateCase.hs → compiler/GHC/Core/Op/LiberateCase.hs - compiler/simplCore/CoreMonad.hs → compiler/GHC/Core/Op/Monad.hs - compiler/simplCore/CoreMonad.hs-boot → compiler/GHC/Core/Op/Monad.hs-boot - compiler/simplCore/OccurAnal.hs → compiler/GHC/Core/Op/OccurAnal.hs - compiler/simplCore/SetLevels.hs → compiler/GHC/Core/Op/SetLevels.hs - compiler/simplCore/Simplify.hs → compiler/GHC/Core/Op/Simplify.hs - compiler/simplCore/SimplCore.hs → compiler/GHC/Core/Op/Simplify/Driver.hs - compiler/simplCore/SimplEnv.hs → compiler/GHC/Core/Op/Simplify/Env.hs - compiler/simplCore/SimplMonad.hs → compiler/GHC/Core/Op/Simplify/Monad.hs - compiler/simplCore/SimplUtils.hs → compiler/GHC/Core/Op/Simplify/Utils.hs - compiler/specialise/SpecConstr.hs → compiler/GHC/Core/Op/SpecConstr.hs - compiler/specialise/Specialise.hs → compiler/GHC/Core/Op/Specialise.hs - compiler/simplCore/SAT.hs → compiler/GHC/Core/Op/StaticArgs.hs - compiler/GHC/Core/Op/Tidy.hs - compiler/stranal/WorkWrap.hs → compiler/GHC/Core/Op/WorkWrap.hs - compiler/stranal/WwLib.hs → compiler/GHC/Core/Op/WorkWrap/Lib.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/60e00bcd0be15aec84fabb71c6808d38d5682bb8...093188bf6ebb8e4dc6f8f2c37346e5df7ce1831d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/60e00bcd0be15aec84fabb71c6808d38d5682bb8...093188bf6ebb8e4dc6f8f2c37346e5df7ce1831d You're receiving 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 Mar 18 20:09:15 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 18 Mar 2020 16:09:15 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: Update "GHC differences to the FFI Chapter" in user guide. Message-ID: <5e727feb89da1_488a3fc6ccab21ec20157a@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: d5c01480 by Andreas Klebinger at 2020-03-18T20:09:04Z 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] - - - - - 336767f9 by Sebastian Graf at 2020-03-18T20:09:10Z 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. - - - - - 3 changed files: - compiler/GHC/HsToCore/PmCheck/Oracle.hs - compiler/GHC/HsToCore/PmCheck/Types.hs - docs/users_guide/exts/ffi.rst Changes: ===================================== compiler/GHC/HsToCore/PmCheck/Oracle.hs ===================================== @@ -51,7 +51,6 @@ import GHC.Core.Make (mkListExpr, mkCharExpr) import UniqSupply import FastString import SrcLoc -import ListSetOps (unionLists) import Maybes import GHC.Core.ConLike import GHC.Core.DataCon @@ -613,9 +612,6 @@ Maintaining these invariants in 'addVarCt' (the core of the term oracle) and - (Refine) If we had @x /~ K zs@, unify each y with each z in turn. * Adding negative information. Example: Add the fact @x /~ Nothing@ (see 'addNotConCt') - (Refut) If we have @x ~ K ys@, refute. - - (Redundant) If we have @x ~ K2@ and @eqPmAltCon K K2 == Disjoint@ - (ex. Just and Nothing), the info is redundant and can be - discarded. - (COMPLETE) If K=Nothing and we had @x /~ Just@, then we get @x /~ [Just,Nothing]@. This is vacuous by matter of comparing to the built-in COMPLETE set, so should refute. @@ -655,7 +651,7 @@ tmIsSatisfiable new_tm_cs = SC $ \delta -> runMaybeT $ foldlM addTmCt delta new_ -- * Looking up VarInfo emptyVarInfo :: Id -> VarInfo -emptyVarInfo x = VI (idType x) [] [] NoPM +emptyVarInfo x = VI (idType x) [] emptyPmAltConSet NoPM lookupVarInfo :: TmState -> Id -> VarInfo -- (lookupVarInfo tms x) tells what we know about 'x' @@ -754,7 +750,7 @@ TyCon, so tc_rep = tc_fam afterwards. canDiverge :: Delta -> Id -> Bool canDiverge delta at MkDelta{ delta_tm_st = ts } x | VI _ pos neg _ <- lookupVarInfo ts x - = null neg && all pos_can_diverge pos + = isEmptyPmAltConSet neg && all pos_can_diverge pos where pos_can_diverge (PmAltConLike (RealDataCon dc), _, [y]) -- See Note [Divergence of Newtype matches] @@ -793,8 +789,8 @@ lookupRefuts :: Uniquable k => Delta -> k -> [PmAltCon] lookupRefuts MkDelta{ delta_tm_st = ts@(TmSt (SDIE env) _) } k = case lookupUDFM env k of Nothing -> [] - Just (Indirect y) -> vi_neg (lookupVarInfo ts y) - Just (Entry vi) -> vi_neg vi + Just (Indirect y) -> pmAltConSetElems (vi_neg (lookupVarInfo ts y)) + Just (Entry vi) -> pmAltConSetElems (vi_neg vi) isDataConSolution :: (PmAltCon, [TyVar], [Id]) -> Bool isDataConSolution (PmAltConLike (RealDataCon _), _, _) = True @@ -937,7 +933,7 @@ addNotConCt delta at MkDelta{ delta_tm_st = TmSt env reps } x nalt = do | any (implies nalt) pos = neg -- See Note [Completeness checking with required Thetas] | hasRequiredTheta nalt = neg - | otherwise = unionLists neg [nalt] + | otherwise = extendPmAltConSet neg nalt let vi_ext = vi{ vi_neg = neg' } -- 3. Make sure there's at least one other possible constructor vi' <- case nalt of @@ -1129,7 +1125,7 @@ equate delta at MkDelta{ delta_tm_st = TmSt env reps } x y delta_pos <- foldlM add_fact delta_refs (vi_pos vi_x) -- Do the same for negative info let add_refut delta nalt = addNotConCt delta y nalt - delta_neg <- foldlM add_refut delta_pos (vi_neg vi_x) + delta_neg <- foldlM add_refut delta_pos (pmAltConSetElems (vi_neg vi_x)) -- vi_cache will be updated in addNotConCt, so we are good to -- go! pure delta_neg @@ -1144,7 +1140,7 @@ addConCt :: Delta -> Id -> PmAltCon -> [TyVar] -> [Id] -> MaybeT DsM Delta addConCt delta at MkDelta{ delta_tm_st = TmSt env reps } x alt tvs args = do VI ty pos neg cache <- lift (initLookupVarInfo delta x) -- First try to refute with a negative fact - guard (all ((/= Equal) . eqPmAltCon alt) neg) + guard (not (elemPmAltConSet alt neg)) -- Then see if any of the other solutions (remember: each of them is an -- additional refinement of the possible values x could take) indicate a -- contradiction @@ -1160,11 +1156,8 @@ addConCt delta at MkDelta{ delta_tm_st = TmSt env reps } x alt tvs args = do let tm_cts = zipWithEqual "addConCt" PmVarCt args other_args MaybeT $ addPmCts delta (listToBag ty_cts `unionBags` listToBag tm_cts) Nothing -> do - -- Filter out redundant negative facts (those that compare Just False to - -- the new solution) - let neg' = filter ((== PossiblyOverlap) . eqPmAltCon alt) neg let pos' = (alt, tvs, args):pos - pure delta{ delta_tm_st = TmSt (setEntrySDIE env x (VI ty pos' neg' cache)) reps} + pure delta{ delta_tm_st = TmSt (setEntrySDIE env x (VI ty pos' neg cache)) reps} equateTys :: [Type] -> [Type] -> [PmCt] equateTys ts us = @@ -1553,7 +1546,7 @@ provideEvidence = go [] -- When there are literals involved, just print negative info -- instead of listing missed constructors - | notNull [ l | PmAltLit l <- neg ] + | notNull [ l | PmAltLit l <- pmAltConSetElems neg ] -> go xs n delta [] -> try_instantiate x xs n delta ===================================== compiler/GHC/HsToCore/PmCheck/Types.hs ===================================== @@ -24,6 +24,10 @@ module GHC.HsToCore.PmCheck.Types ( -- * Caching partially matched COMPLETE sets ConLikeSet, PossibleMatches(..), + -- * PmAltConSet + PmAltConSet, emptyPmAltConSet, isEmptyPmAltConSet, elemPmAltConSet, + extendPmAltConSet, pmAltConSetElems, + -- * A 'DIdEnv' where entries may be shared Shared(..), SharedDIdEnv(..), emptySDIE, lookupSDIE, sameRepresentativeSDIE, setIndirectSDIE, setEntrySDIE, traverseSDIE, @@ -49,6 +53,7 @@ import Name import GHC.Core.DataCon import GHC.Core.ConLike import Outputable +import ListSetOps (unionLists) import Maybes import GHC.Core.Type import GHC.Core.TyCon @@ -152,6 +157,33 @@ eqConLike _ _ = PossiblyOverlap data PmAltCon = PmAltConLike ConLike | PmAltLit PmLit +data PmAltConSet = PACS !ConLikeSet ![PmLit] + +emptyPmAltConSet :: PmAltConSet +emptyPmAltConSet = PACS emptyUniqDSet [] + +isEmptyPmAltConSet :: PmAltConSet -> Bool +isEmptyPmAltConSet (PACS cls lits) = isEmptyUniqDSet cls && null lits + +-- | Whether there is a 'PmAltCon' in the 'PmAltConSet' that compares 'Equal' to +-- the given 'PmAltCon' according to 'eqPmAltCon'. +elemPmAltConSet :: PmAltCon -> PmAltConSet -> Bool +elemPmAltConSet (PmAltConLike cl) (PACS cls _ ) = elementOfUniqDSet cl cls +elemPmAltConSet (PmAltLit lit) (PACS _ lits) = elem lit lits + +extendPmAltConSet :: PmAltConSet -> PmAltCon -> PmAltConSet +extendPmAltConSet (PACS cls lits) (PmAltConLike cl) + = PACS (addOneToUniqDSet cls cl) lits +extendPmAltConSet (PACS cls lits) (PmAltLit lit) + = PACS cls (unionLists lits [lit]) + +pmAltConSetElems :: PmAltConSet -> [PmAltCon] +pmAltConSetElems (PACS cls lits) + = map PmAltConLike (uniqDSetToList cls) ++ map PmAltLit lits + +instance Outputable PmAltConSet where + ppr = ppr . pmAltConSetElems + -- | We can't in general decide whether two 'PmAltCon's match the same set of -- values. In addition to the reasons in 'eqPmLit' and 'eqConLike', a -- 'PmAltConLike' might or might not represent the same value as a 'PmAltLit'. @@ -475,7 +507,7 @@ data VarInfo -- However, no more than one RealDataCon in the list, otherwise contradiction -- because of generativity. - , vi_neg :: ![PmAltCon] + , vi_neg :: !PmAltConSet -- ^ Negative info: A list of 'PmAltCon's that it cannot match. -- Example, assuming -- @@ -489,6 +521,9 @@ data VarInfo -- between 'vi_pos' and 'vi_neg'. -- See Note [Why record both positive and negative info?] + -- It's worth having an actual set rather than a simple association list, + -- because files like Cabal's `LicenseId` define relatively huge enums + -- that lead to quadratic or worse behavior. , vi_cache :: !PossibleMatches -- ^ A cache of the associated COMPLETE sets. At any time a superset of ===================================== docs/users_guide/exts/ffi.rst ===================================== @@ -37,31 +37,51 @@ Guaranteed call safety ~~~~~~~~~~~~~~~~~~~~~~ The Haskell 2010 Report specifies that ``safe`` FFI calls must allow foreign -calls to safely call into Haskell code. In practice, this means that the -garbage collector must be able to run while these calls are in progress, -moving heap-allocated Haskell values around arbitrarily. +calls to safely call into Haskell code. In practice, this means that called +functions also have to assume heap-allocated Haskell values may move around +arbitrarily in order to allow for GC. This greatly constrains library authors since it implies that it is not safe to pass any heap object reference to a ``safe`` foreign function call. For -instance, it is often desirable to pass an :ref:`unpinned ` +instance, it is often desirable to pass :ref:`unpinned ` ``ByteArray#``\s directly to native code to avoid making an otherwise-unnecessary -copy. However, this can only be done safely if the array is guaranteed not to be -moved by the garbage collector in the middle of the call. +copy. However, this can not be done safely for ``safe`` calls since the array might +be moved by the garbage collector in the middle of the call. -The Chapter does *not* require implementations to refrain from doing the -same for ``unsafe`` calls, so strictly Haskell 2010-conforming programs +The Chapter *does* allow for implementations to move objects around during +``unsafe`` calls as well. So strictly Haskell 2010-conforming programs cannot pass heap-allocated references to ``unsafe`` FFI calls either. +GHC, since version 8.4, **guarantees** that garbage collection will never occur +during an ``unsafe`` call, even in the bytecode interpreter, and further guarantees +that ``unsafe`` calls will be performed in the calling thread. Making it safe to +pass heap-allocated objects to unsafe functions. + In previous releases, GHC would take advantage of the freedom afforded by the Chapter by performing ``safe`` foreign calls in place of ``unsafe`` calls in the bytecode interpreter. This meant that some packages which worked when -compiled would fail under GHCi (e.g. :ghc-ticket:`13730`). +compiled would fail under GHCi (e.g. :ghc-ticket:`13730`). But this is no +longer the case in recent releases. + +Interactions between ``safe`` calls and bound threads +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +A ``safe`` call calling into haskell is run on a bound thread by +the RTS. This means any nesting of ``safe`` calls will be executed on +the same operating system thread. *Sequential* ``safe`` calls however +do not enjoy this luxury and may be run on arbitrary OS threads. -However, since version 8.4 this is no longer the case: GHC **guarantees** that -garbage collection will never occur during an ``unsafe`` call, even in the -bytecode interpreter, and further guarantees that ``unsafe`` calls will be -performed in the calling thread. +This behaviour is considered an implementation detail and code relying on +thread local state should instead use one of the interfaces provided +in :base-ref:`Control.Concurrent.` to make this explicit. +For information on what bound threads are, +see the documentation for the :base-ref:`Control.Concurrent.`. + +For more details on the implementation see the Paper: +"Extending the Haskell Foreign Function Interface with Concurrency". +Last known to be accessible `here +`_. .. _ffi-ghcexts: @@ -100,7 +120,7 @@ restrictions: of heap objects record writes for the purpose of garbage collection. An array of heap objects is passed to a foreign C function, the runtime does not record any writes. Consequently, it is not safe to - write to an array of heap objects in a foreign function. + write to an array of heap objects in a foreign function. Since the runtime has no facilities for tracking mutation of a ``MutableByteArray#``, these can be safely mutated in any foreign function. @@ -169,7 +189,7 @@ In other situations, the C function may need knowledge of the RTS closure types. The following example sums the first element of each ``ByteArray#`` (interpreting the bytes as an array of ``CInt``) element of an ``ArrayArray##`` [3]_:: - + // C source, must include the RTS to make the struct StgArrBytes // available along with its fields: ptrs and payload. #include "Rts.h" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/677442333b9cce270a05f70e29dcd5df36f26d2b...336767f94b296377c59e73e8183e0d4934791485 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/677442333b9cce270a05f70e29dcd5df36f26d2b...336767f94b296377c59e73e8183e0d4934791485 You're receiving 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 Mar 19 16:02:31 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Thu, 19 Mar 2020 12:02:31 -0400 Subject: [Git][ghc/ghc][wip/T17676] A bunch of fixes involving the new Divergence lattice Message-ID: <5e73979791684_488a3fc6ce6d2d9021786c2@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T17676 at Glasgow Haskell Compiler / GHC Commits: 0cd21aef by Sebastian Graf at 2020-03-19T16:02:23Z A bunch of fixes involving the new Divergence lattice - - - - - 6 changed files: - compiler/GHC/Core/SimpleOpt.hs - compiler/basicTypes/Demand.hs - compiler/basicTypes/Id.hs - compiler/simplCore/SetLevels.hs - compiler/stranal/DmdAnal.hs - compiler/stranal/WwLib.hs Changes: ===================================== compiler/GHC/Core/SimpleOpt.hs ===================================== @@ -39,7 +39,7 @@ import Var ( isNonCoVarId ) import VarSet import VarEnv import GHC.Core.DataCon -import Demand( etaExpandStrictSig ) +import Demand( etaConvertStrictSig ) import GHC.Core.Coercion.Opt ( optCoercion ) import GHC.Core.Type hiding ( substTy, extendTvSubst, extendCvSubst, extendTvSubstList , isInScope, substTyVarBndr, cloneTyVarBndr ) @@ -764,7 +764,7 @@ joinPointBinding_maybe bndr rhs , let str_sig = idStrictness bndr str_arity = count isId bndrs -- Strictness demands are for Ids only join_bndr = bndr `asJoinId` join_arity - `setIdStrictness` etaExpandStrictSig str_arity str_sig + `setIdStrictness` etaConvertStrictSig str_arity str_sig = Just (join_bndr, mkLams bndrs body) | otherwise ===================================== compiler/basicTypes/Demand.hs ===================================== @@ -22,9 +22,8 @@ module Demand ( addCaseBndrDmd, DmdType(..), dmdTypeDepth, lubDmdType, bothDmdType, - emptyDmdType, botDmdType, mkDmdType, - addDemand, ensureArgs, BothDmdArg, mkBothDmdArg, toBothDmdArg, + emptyDmdType, botDmdType, mkDmdType, addDemand, DmdEnv, emptyDmdEnv, peelFV, findIdDemand, @@ -35,12 +34,13 @@ module Demand ( emptySig, botSig, cprProdSig, isTopSig, hasDemandEnvSig, splitStrictSig, strictSigDmdEnv, - increaseStrictSigArity, etaExpandStrictSig, + prependArgsStrictSig, etaConvertStrictSig, seqDemand, seqDemandList, seqDmdType, seqStrictSig, evalDmd, cleanEvalDmd, cleanEvalProdDmd, isStrictDmd, splitDmdTy, splitFVs, + mayThrowPreciseException, deferAfterPreciseException, postProcessUnsat, postProcessDmdType, splitProdDmd_maybe, peelCallDmd, peelManyCalls, mkCallDmd, mkCallDmds, @@ -209,8 +209,9 @@ as if we had other -> return () So the 'y' isn't necessarily going to be evaluated. -The function that spots this situation is -'CoreUtils.exprMayThrowPreciseException', and +To detect this scenario, why we track precise exceptions in the Divergence +lattice. Specifically, if 'foo' throws an exception, the Divergence in its +strictness signature will indicate so (ExnOrDiv or Dunno), in which case 'Demand.deferAfterPreciseException' will lub with the strictness analysis results of the virtual branch. @@ -221,16 +222,9 @@ A more complete example (#148, #1592) where this shows up is: Here, we want to defer, because @when (...) (exitWith ExitSuccess)@ might throw a precise exception. -However, consider - f x s = case getMaskingState# s of - (# s, r #) -> - case x of I# x2 -> ... - -Here it is terribly sad to make 'f' lazy in 'x'. After all, -getMaskingState# is not going throw a precise exception! And -'exprMayThrowPreciseException' recognises that. -This situation actually arises in GHC.IO.Handle.Internals.wantReadableHandle -(on an MVar not an Int), and made a material difference. +Note that Dunno is still the top of the lattice, hence we need a new element +that denotes absence of precise exception, but still allows for convergence. +That element is ConOrDiv. Scenario 2: Precise exceptions in case alternatives --------------------------------------------------- @@ -245,8 +239,9 @@ The solution is to give 'raiseIO#' 'topDiv' instead of 'botDiv', so that its 'Demand.defaultFvDmd' is lazy. But then the simplifier fails to eliminate a lot of dead code, namely when 'raiseIO#' occurs in a case scrutinee. Hence we need to give it 'exnDiv', which was conceived entirely for this reason. The default -demand of 'exnDiv' is lazy, but otherwise (in terms of 'Demand.isBotDiv') it -behaves exactly as 'botDiv', so that dead code elimination works as expected. +FV demand of 'exnDiv' is lazy, its default arg dmd is absent, but otherwise (in +terms of 'Demand.isBotDiv') it behaves exactly as 'botDiv', so that dead code +elimination works as expected. -} -- | Vanilla strictness domain @@ -1004,9 +999,9 @@ data Divergence | Dunno -- ^ Might diverge, throw any kind of exception or converge. deriving( Eq, Show ) -lubDivergence :: Divergence -> Divergence ->Divergence -lubDivergence Diverges r = r -lubDivergence r Diverges = r +lubDivergence :: Divergence -> Divergence -> Divergence +lubDivergence Diverges div = div +lubDivergence div Diverges = div lubDivergence ExnOrDiv ExnOrDiv = ExnOrDiv lubDivergence ConOrDiv ConOrDiv = ConOrDiv lubDivergence _ _ = Dunno @@ -1016,10 +1011,17 @@ lubDivergence _ _ = Dunno bothDivergence :: Divergence -> Divergence -> Divergence -- See Note [Asymmetry of 'both' for DmdType and Divergence] -bothDivergence Diverges _ = Diverges -bothDivergence ExnOrDiv _ = ExnOrDiv -bothDivergence ConOrDiv r = lubDivergence Diverges r -- strip convergence! -bothDivergence Dunno r = lubDivergence ExnOrDiv r -- strip convergence! +-- The result +-- * may throw a precise exception if /either/ result does +-- * may converge if /both/ results do +-- Hence this is a bit complicated. Amazingly, by sheer coincidence this +-- corresponds to rotating the lattice by 90° to the left (so that ExnOrDiv is +-- Top and ConOrDiv is Bot) and computing the least upper bound! +bothDivergence ConOrDiv div = div +bothDivergence div ConOrDiv = div +bothDivergence Diverges Diverges = Diverges +bothDivergence Dunno Dunno = Dunno +bothDivergence _ _ = ExnOrDiv instance Outputable Divergence where ppr Diverges = char 'b' -- for (b)ottom @@ -1145,16 +1147,13 @@ We 2. take the demand on arguments from the first argument 3. combine the termination results, as in bothDivergence. -What should be the semantics of 'bothDivergence'? Note that we can only "fall -through" from the left to the right argument when the left argument might -converge. Similarly, the whole expression can only converge when /both/ -arguments can converge. Thus: -- When the left argument 'isBotDiv': We return that result, because there is no - possibility to fall through to the second argument. -- Otherwise, we return the 'lubDivergence', with a twist: If the right argument - also 'isBotDiv', we surely won't converge. - - +But note that the argument demand types are not guaranteed to be observed in +left to right order. For example, analysis of a case expression will pass the +demand type for the alts as the left argument and the type for the scrutinee as +the right argument. Also, it is not at all clear if there is such an order; +consider the LetUp case, where the RHS might be forced at any point while +evaluating the let body. Therefore, it is crucial that 'bothDivergence' behaves +symmetrically! -} -- Equality needed for fixpoints in DmdAnal @@ -1166,13 +1165,15 @@ instance Eq DmdType where -- Unique order, it is the same order for both && ds1 == ds2 && div1 == div2 +-- | Compute the least upper bound of two 'DmdType's elicited /by the same +-- incoming demand/! lubDmdType :: DmdType -> DmdType -> DmdType lubDmdType d1 d2 = DmdType lub_fv lub_ds lub_div where n = max (dmdTypeDepth d1) (dmdTypeDepth d2) - (DmdType fv1 ds1 r1) = ensureArgs n d1 - (DmdType fv2 ds2 r2) = ensureArgs n d2 + (DmdType fv1 ds1 r1) = etaExpandDmdType n d1 + (DmdType fv2 ds2 r2) = etaExpandDmdType n d2 lub_fv = plusVarEnv_CD lubDmd fv1 (defaultFvDmd r1) fv2 (defaultFvDmd r2) lub_ds = zipWithEqual "lubDmdType" lubDmd ds1 ds2 @@ -1191,7 +1192,7 @@ only passing the relevant information. type BothDmdArg = (DmdEnv, Divergence) mkBothDmdArg :: DmdEnv -> BothDmdArg -mkBothDmdArg env = (env, Dunno) +mkBothDmdArg env = (env, conDiv) toBothDmdArg :: DmdType -> BothDmdArg toBothDmdArg (DmdType fv _ r) = (fv, r) @@ -1251,13 +1252,15 @@ mkDmdType fv ds res = DmdType fv ds res dmdTypeDepth :: DmdType -> Arity dmdTypeDepth (DmdType _ ds _) = length ds --- | This makes sure we can use the demand type with n arguments. --- It appends the argument list with the correct defaultArgDmd. --- It also adjusts the Divergence: 'Diverges'survives additional arguments. -ensureArgs :: Arity -> DmdType -> DmdType -ensureArgs n d | n == depth = d - | n > depth = DmdType inc_fv inc_ds inc_div - | otherwise = decreaseArityDmdType d +-- | This makes sure we can use the demand type with n arguments after eta +-- expansion, where n must not be lower than the demand types depth. +-- It appends the argument list with the correct 'defaultArgDmd'. +-- It also adjusts the Divergence: 'ConOrDiv' turns into 'Dunno'. +etaExpandDmdType :: Arity -> DmdType -> DmdType +etaExpandDmdType n d + | n == depth = d + | n > depth = DmdType inc_fv inc_ds inc_div + | otherwise = pprPanic "etaExpandDmdType: arity decrease" (ppr n $$ ppr d) where depth = dmdTypeDepth d DmdType fv ds div = d @@ -1274,7 +1277,8 @@ ensureArgs n d | n == depth = d _ -> div -- | A conservative approximation for a given 'DmdType' in case of an arity --- decrease: +-- decrease (meaning we have to adjust the 'DmdType' for a weaker incoming +-- call demand): -- -- * Demands on FVs must be zapped, because they were computed for a -- stronger incoming demand. @@ -1304,6 +1308,20 @@ splitDmdTy :: DmdType -> (Demand, DmdType) splitDmdTy (DmdType fv (dmd:dmds) res_ty) = (dmd, DmdType fv dmds res_ty) splitDmdTy ty@(DmdType _ [] res_ty) = (defaultArgDmd res_ty, ty) +-- When e is evaluated after executing an IO action that may throw a precise +-- exception, and d is e's demand, then what of this demand should we consider? +-- * We have to kill all strictness demands (i.e. lub with a lazy demand) +-- * We can keep usage information (i.e. lub with an absent demand) +-- * We have to kill definite divergence +-- See Note [Precise exceptions and strictness analysis] +deferAfterPreciseException :: DmdType -> DmdType +deferAfterPreciseException d = lubDmdType d (emptyDmdType conDiv) + +mayThrowPreciseException :: DmdType -> Bool +mayThrowPreciseException (DmdType _ _ Dunno) = True +mayThrowPreciseException (DmdType _ _ ConOrDiv) = True +mayThrowPreciseException (DmdType _ _ _) = False + strictenDmd :: Demand -> CleanDemand strictenDmd (JD { sd = s, ud = u}) = JD { sd = poke_s s, ud = poke_u u } @@ -1654,9 +1672,6 @@ 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 @@ -1676,7 +1691,9 @@ pprIfaceStrictSig (StrictSig (DmdType _ dmds res)) -- | 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) +mkStrictSigForArity arity dmd_ty@(DmdType fvs args div) + | arity < dmdTypeDepth dmd_ty = StrictSig (DmdType fvs (take arity args) div) + | otherwise = StrictSig (etaExpandDmdType arity dmd_ty) mkClosedStrictSig :: [Demand] -> Divergence -> StrictSig mkClosedStrictSig ds res = mkStrictSigForArity (length ds) (DmdType emptyDmdEnv ds res) @@ -1684,26 +1701,33 @@ mkClosedStrictSig ds res = mkStrictSigForArity (length ds) (DmdType emptyDmdEnv splitStrictSig :: StrictSig -> ([Demand], Divergence) splitStrictSig (StrictSig (DmdType _ dmds res)) = (dmds, res) -increaseStrictSigArity :: Int -> StrictSig -> StrictSig --- ^ 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)) +prependArgsStrictSig :: Int -> StrictSig -> StrictSig +-- ^ Add extra ('topDmd') arguments to a strictness signature. +-- In contrast to 'etaConvertStrictSig', this /prepends/ additional argument +-- demands. This is used by FloatOut. +prependArgsStrictSig new_args sig@(StrictSig dmd_ty@(DmdType env dmds res)) + | new_args == 0 = sig | isTopDmdType dmd_ty = sig - | arity_increase == 0 = sig - | arity_increase < 0 = WARN( True, text "increaseStrictSigArity:" - <+> text "negative arity increase" - <+> ppr arity_increase ) - StrictSig (decreaseArityDmdType dmd_ty) + | new_args < 0 = pprPanic "prependArgsStrictSig: negative new_args" + (ppr new_args $$ ppr sig) | 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). --- In contrast to 'increaseStrictSigArity', this /appends/ extra arg demands if --- necessary, potentially destroying the signature's CPR property. -etaExpandStrictSig arity (StrictSig dmd_ty) = StrictSig $ ensureArgs arity dmd_ty + dmds' = replicate new_args topDmd ++ dmds + +etaConvertStrictSig :: Arity -> StrictSig -> StrictSig +-- ^ We are expanding (\x y. e) to (\x y z. e z) or reducing from the latter to +-- the former (when the Simplifier identifies a new join points, for example). +-- In contrast to 'prependArgsStrictSig', this /appends/ extra arg demands if +-- necessary. +-- This works by looking at the 'DmdType' (which was produced under a call +-- demand for the old arity) and trying to transfer as many facts as we can to +-- the call demand of new arity. +-- An arity increase (resulting in a stronger incoming demand) can retain much +-- of the info, while an arity decrease (a weakening of the incoming demand) +-- must fall back to a conservative default. +etaConvertStrictSig arity (StrictSig dmd_ty) + | arity < dmdTypeDepth dmd_ty = StrictSig $ decreaseArityDmdType dmd_ty + | otherwise = StrictSig $ etaExpandDmdType arity dmd_ty isTopSig :: StrictSig -> Bool isTopSig (StrictSig ty) = isTopDmdType ty ===================================== compiler/basicTypes/Id.hs ===================================== @@ -958,7 +958,7 @@ transferPolyIdInfo old_id abstract_wrt new_id new_occ_info = zapOccTailCallInfo old_occ_info old_strictness = strictnessInfo old_info - new_strictness = increaseStrictSigArity arity_increase old_strictness + new_strictness = prependArgsStrictSig arity_increase old_strictness old_cpr = cprInfo old_info transfer new_info = new_info `setArityInfo` new_arity ===================================== compiler/simplCore/SetLevels.hs ===================================== @@ -87,7 +87,7 @@ import UniqSet ( nonDetFoldUniqSet ) import UniqDSet ( getUniqDSet ) import VarEnv import Literal ( litIsTrivial ) -import Demand ( StrictSig, Demand, isStrictDmd, splitStrictSig, increaseStrictSigArity ) +import Demand ( StrictSig, Demand, isStrictDmd, splitStrictSig, prependArgsStrictSig ) import Cpr ( mkCprSig, botCpr ) import Name ( getOccName, mkSystemVarName ) import OccName ( occNameString ) @@ -983,7 +983,7 @@ annotateBotStr id n_extra mb_str = case mb_str of Nothing -> id Just (arity, sig) -> id `setIdArity` (arity + n_extra) - `setIdStrictness` (increaseStrictSigArity n_extra sig) + `setIdStrictness` (prependArgsStrictSig n_extra sig) `setIdCprInfo` mkCprSig (arity + n_extra) botCpr notWorthFloating :: CoreExpr -> [Var] -> Bool ===================================== compiler/stranal/DmdAnal.hs ===================================== @@ -220,12 +220,15 @@ dmdAnal' env dmd (Case scrut case_bndr ty [(DataAlt dc, bndrs, rhs)]) (alt_ty1, dmds) = findBndrsDmds env rhs_ty bndrs (alt_ty2, case_bndr_dmd) = findBndrDmd env False alt_ty1 case_bndr id_dmds = addCaseBndrDmd case_bndr_dmd dmds + -- See Note [Precise exceptions and strictness analysis] in Demand + alt_ty3 | mayThrowPreciseException scrut_ty = deferAfterPreciseException alt_ty2 + | otherwise = alt_ty2 -- Compute demand on the scrutinee -- See Note [Demand on scrutinee of a product case] scrut_dmd = mkProdDmd id_dmds (scrut_ty, scrut') = dmdAnal env scrut_dmd scrut - res_ty = alt_ty2 `bothDmdType` toBothDmdArg scrut_ty + res_ty = alt_ty3 `bothDmdType` toBothDmdArg scrut_ty case_bndr' = setIdDemandInfo case_bndr case_bndr_dmd bndrs' = setBndrsDemandInfo bndrs id_dmds in @@ -540,8 +543,6 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs = mkRhsDmd env rhs_arity rhs (DmdType rhs_fv rhs_dmds rhs_div, rhs') = dmdAnal env rhs_dmd rhs - -- TODO: Won't the following line unnecessarily trim down arity for join - -- points returning a lambda in a C(S) context? sig = mkStrictSigForArity rhs_arity (mkDmdType sig_fv rhs_dmds rhs_div) id' = set_idStrictness env id sig -- See Note [NOINLINE and strictness] ===================================== compiler/stranal/WwLib.hs ===================================== @@ -1189,7 +1189,10 @@ 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)) + (ppr arg <+> ppr (idType arg) <+> file_msg) + file_msg = case outputFile dflags of + Nothing -> empty + 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 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/0cd21aef3a23de4ec0ae21e7fc8f9904758c7554 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/0cd21aef3a23de4ec0ae21e7fc8f9904758c7554 You're receiving 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 Mar 23 16:23:10 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 23 Mar 2020 12:23:10 -0400 Subject: [Git][ghc/ghc][wip/fix-test-type] 42 commits: Enable stage1 build of haddock Message-ID: <5e78e26e51b6d_61679b221b4931bf@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/fix-test-type at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - 1fde5bbb by Ben Gamari at 2020-03-23T12:22:13-04:00 gitlab-ci: Respect TEST_TYPE variable Previously this was dropped in the CI refactoring of !2487. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/linters/check-cpp.py - compiler/GHC.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/InfoTable.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/Dataflow/Block.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Graph.hs - compiler/GHC/Cmm/Info.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/Ppr.hs - compiler/GHC/Cmm/Ppr/Decl.hs - compiler/GHC/Cmm/Ppr/Expr.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Switch/Implement.hs - compiler/GHC/Cmm/Type.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/454ace36fb15e319488e74223b963f52fb1ec29a...1fde5bbba8147b2a06f0cc0afbe22ff3f2105b46 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/454ace36fb15e319488e74223b963f52fb1ec29a...1fde5bbba8147b2a06f0cc0afbe22ff3f2105b46 You're receiving 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 Mar 23 16:38:10 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 23 Mar 2020 12:38:10 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T17944 Message-ID: <5e78e5f215aef_61673f81cd890bc895953@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/T17944 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T17944 You're receiving 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 Mar 23 16:38:21 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 23 Mar 2020 12:38:21 -0400 Subject: [Git][ghc/ghc][wip/T17944] rts: Don't mark evacuate_large as inline Message-ID: <5e78e5fd90b5_61673f81cd890bc896124@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T17944 at Glasgow Haskell Compiler / GHC Commits: 2c39d765 by Ben Gamari at 2020-03-23T12:37:46-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. - - - - - 1 changed file: - rts/sm/Evac.c Changes: ===================================== rts/sm/Evac.c ===================================== @@ -298,7 +298,7 @@ copy(StgClosure **p, const StgInfoTable *info, that has been evacuated, or unset otherwise. -------------------------------------------------------------------------- */ -STATIC_INLINE void +static void evacuate_large(StgPtr p) { bdescr *bd; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2c39d7659dd36633a460503dc6c3984cac0a4028 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2c39d7659dd36633a460503dc6c3984cac0a4028 You're receiving 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 Mar 23 17:00:21 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Mon, 23 Mar 2020 13:00:21 -0400 Subject: [Git][ghc/ghc][wip/T16296] Wibbles Message-ID: <5e78eb25705b2_61673f81ccac04941017c6@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T16296 at Glasgow Haskell Compiler / GHC Commits: 1276e275 by Simon Peyton Jones at 2020-03-23T16:59:13+00:00 Wibbles - - - - - 3 changed files: - compiler/GHC/Core/Op/OccurAnal.hs - testsuite/tests/simplCore/should_compile/T17901.stdout - testsuite/tests/simplCore/should_compile/T7360.stderr Changes: ===================================== compiler/GHC/Core/Op/OccurAnal.hs ===================================== @@ -814,7 +814,8 @@ occAnalNonRecBind env lvl imp_rule_edges bndr rhs body_usage -- Unfoldings -- See Note [Unfoldings and join points] - (unf_usage, unf') = occAnalUnfolding rhs_env mb_join_arity bndr + unf = idUnfolding bndr + (unf_usage, unf') = occAnalUnfolding rhs_env mb_join_arity unf rhs_usage2 = rhs_usage1 `andUDs` unf_usage -- Rules @@ -1180,6 +1181,8 @@ type LetrecNode = Node Unique Details -- Node comes from Digraph -- The Unique key is gotten from the Id data Details = ND { nd_bndr :: Id -- Binder + , nd_unf :: Unfolding -- Original unfolding of this binder + -- (used for size information in nodeScore) , nd_rhs :: CoreExpr -- RHS, already occ-analysed , nd_rhs_bndrs :: [CoreBndr] -- Outer lambdas of RHS -- INVARIANT: (nd_rhs_bndrs nd, _) == @@ -1208,6 +1211,7 @@ data Details instance Outputable Details where ppr nd = text "ND" <> braces (sep [ text "bndr =" <+> ppr (nd_bndr nd) + , text "unf =" <+> ppr (nd_unf nd) , text "uds =" <+> ppr (nd_uds nd) , text "inl =" <+> ppr (nd_inl nd) , text "weak =" <+> ppr (nd_weak nd) @@ -1238,6 +1242,7 @@ makeNode env imp_rule_edges bndr_set (bndr, rhs) -- explained in Note [Deterministic SCC] in Digraph. where details = ND { nd_bndr = bndr' + , nd_unf = unf -- The original unfolding , nd_rhs = rhs' , nd_rhs_bndrs = bndrs' , nd_uds = rhs_usage3 @@ -1287,7 +1292,9 @@ makeNode env imp_rule_edges bndr_set (bndr, rhs) , is_active a] -- Finding the usage details of the INLINE pragma (if any) - (unf_uds, unf') = occAnalUnfolding rhs_env mb_join_arity bndr + unf = realIdUnfolding bndr -- realIdUnfolding: Ignore loop-breaker-ness + -- here because that is what we are setting! + (unf_uds, unf') = occAnalUnfolding rhs_env mb_join_arity unf -- Find the "nd_inl" free vars; for the loop-breaker phase -- These are the vars that would become free if the function @@ -1323,15 +1330,16 @@ mkLoopBreakerNodes env lvl bndr_set body_uds details_s | ND { nd_bndr = bndr, nd_uds = uds, nd_rhs_bndrs = rhs_bndrs } <- details_s ] - mk_lb_node nd@(ND { nd_bndr = bndr, nd_rhs = rhs, nd_inl = inl_fvs }) bndr' - = DigraphNode nd' (varUnique bndr) (nonDetKeysUniqSet lb_deps) + mk_lb_node nd@(ND { nd_bndr = old_bndr, nd_unf = old_unf + , nd_rhs = rhs, nd_inl = inl_fvs }) new_bndr + = DigraphNode nd' (varUnique old_bndr) (nonDetKeysUniqSet lb_deps) -- It's OK to use nonDetKeysUniqSet here as -- stronglyConnCompFromEdgedVerticesR is still deterministic with edges -- in nondeterministic order as explained in -- Note [Deterministic SCC] in Digraph. where - nd' = nd { nd_bndr = bndr', nd_score = score } - score = nodeScore env bndr bndr' rhs lb_deps + nd' = nd { nd_bndr = new_bndr, nd_score = score } + score = nodeScore env old_bndr old_unf new_bndr rhs lb_deps lb_deps = extendFvs_ rule_fv_env inl_fvs rule_fv_env :: IdEnv IdSet @@ -1349,11 +1357,13 @@ mkLoopBreakerNodes env lvl bndr_set body_uds details_s ------------------------------------------ nodeScore :: OccEnv -> Id -- Binder has old occ-info (just for loop-breaker-ness) + -- but its unfolding may have been zapped by now + -> Unfolding -- Old unfolding (for size info etc) -> Id -- Binder with new occ-info -> CoreExpr -- RHS -> VarSet -- Loop-breaker dependencies -> NodeScore -nodeScore env old_bndr new_bndr bind_rhs lb_deps +nodeScore env old_bndr old_unf new_bndr bind_rhs lb_deps | not (isId old_bndr) -- A type or coercion variable is never a loop breaker = (100, 0, False) @@ -1371,7 +1381,7 @@ nodeScore env old_bndr new_bndr bind_rhs lb_deps -- where df is the exported dictionary. Then df makes a really -- bad choice for loop breaker - | DFunUnfolding { df_args = args } <- id_unfolding + | DFunUnfolding { df_args = args } <- old_unf -- Never choose a DFun as a loop breaker -- Note [DFuns should not be loop breakers] = (9, length args, is_lb) @@ -1379,13 +1389,13 @@ nodeScore env old_bndr new_bndr bind_rhs lb_deps -- Data structures are more important than INLINE pragmas -- so that dictionary/method recursion unravels - | CoreUnfolding { uf_guidance = UnfWhen {} } <- id_unfolding + | CoreUnfolding { uf_guidance = UnfWhen {} } <- old_unf = mk_score 6 | is_con_app rhs -- Data types help with cases: = mk_score 5 -- Note [Constructor applications] - | isStableUnfolding id_unfolding + | isStableUnfolding old_unf , can_unfold = mk_score 3 @@ -1403,22 +1413,20 @@ nodeScore env old_bndr new_bndr bind_rhs lb_deps mk_score rank = (rank, rhs_size, is_lb) is_lb = isStrongLoopBreaker (idOccInfo old_bndr) - rhs = case id_unfolding of - CoreUnfolding { uf_src = src, uf_tmpl = unf_rhs } - | isStableSource src - -> unf_rhs - _ -> bind_rhs + + can_unfold = canUnfold old_unf + rhs = case old_unf of + CoreUnfolding { uf_src = src, uf_tmpl = unf_rhs } + | isStableSource src + -> unf_rhs + _ -> bind_rhs -- 'bind_rhs' is irrelevant for inlining things with a stable unfolding - rhs_size = case id_unfolding of + rhs_size = case old_unf of CoreUnfolding { uf_guidance = guidance } | UnfIfGoodArgs { ug_size = size } <- guidance -> size _ -> cheapExprSize rhs - can_unfold = canUnfold id_unfolding - id_unfolding = realIdUnfolding old_bndr - -- realIdUnfolding: Ignore loop-breaker-ness here because - -- that is what we are setting! -- Checking for a constructor application -- Cheap and cheerful; the simplifier moves casts out of the way @@ -1572,11 +1580,12 @@ occAnalRhs env mb_join_arity rhs occAnalUnfolding :: OccEnv -> Maybe JoinArity -- See Note [Join points and unfoldings/rules] - -> Id -> (UsageDetails, Unfolding) + -> Unfolding + -> (UsageDetails, Unfolding) -- Occurrence-analyse a stable unfolding; -- discard a non-stable one altogether. -occAnalUnfolding env mb_join_arity id - = case realIdUnfolding id of -- ignore previous loop-breaker flag +occAnalUnfolding env mb_join_arity unf + = case unf of unf@(CoreUnfolding { uf_tmpl = rhs, uf_src = src }) | isStableSource src -> (usage, unf') | otherwise -> (emptyDetails, NoUnfolding) ===================================== testsuite/tests/simplCore/should_compile/T17901.stdout ===================================== @@ -4,13 +4,11 @@ C -> wombat1 T17901.C = \ (@p) (wombat1 :: T -> p) (x :: T) -> case x of wild { __DEFAULT -> wombat1 wild } - (wombat2 [Occ=Once*!] :: S -> p) - SA _ [Occ=Dead] -> wombat2 wild; - SB -> wombat2 T17901.SB + Tmpl= \ (@p) (wombat2 [Occ=Once!] :: S -> p) (x [Occ=Once] :: S) -> + case x of wild [Occ=Once] { __DEFAULT -> wombat2 wild }}] = \ (@p) (wombat2 :: S -> p) (x :: S) -> case x of wild { __DEFAULT -> wombat2 wild } - (wombat3 [Occ=Once*!] :: W -> p) - WB -> wombat3 T17901.WB; - WA _ [Occ=Dead] -> wombat3 wild + Tmpl= \ (@p) (wombat3 [Occ=Once!] :: W -> p) (x [Occ=Once] :: W) -> + case x of wild [Occ=Once] { __DEFAULT -> wombat3 wild }}] = \ (@p) (wombat3 :: W -> p) (x :: W) -> case x of wild { __DEFAULT -> wombat3 wild } ===================================== testsuite/tests/simplCore/should_compile/T7360.stderr ===================================== @@ -31,15 +31,7 @@ T7360.fun4 :: () WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 20 0}] T7360.fun4 = fun1 T7360.Foo1 --- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T7360.fun4 :: Int -[GblId, - Cpr=m1, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] -T7360.fun4 = GHC.Types.I# 0# - --- RHS size: {terms: 16, types: 13, coercions: 0, joins: 0/0} +-- RHS size: {terms: 11, types: 8, coercions: 0, joins: 0/0} fun2 :: forall {a}. [a] -> ((), Int) [GblId, Arity=1, @@ -48,24 +40,18 @@ fun2 :: forall {a}. [a] -> ((), Int) 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) (x [Occ=Once!] :: [a]) -> - (T7360.fun5, - case x of wild [Occ=Once] { - [] -> T7360.fun4; - : _ [Occ=Dead] _ [Occ=Dead] -> - case GHC.List.$wlenAcc @a wild 0# of ww2 [Occ=Once] { __DEFAULT -> - GHC.Types.I# ww2 - } + Tmpl= \ (@a) (x [Occ=Once] :: [a]) -> + (T7360.fun4, + case x of wild [Occ=Once] { __DEFAULT -> + case GHC.List.$wlenAcc @a wild 0# of ww2 [Occ=Once] { __DEFAULT -> + GHC.Types.I# ww2 + } })}] fun2 = \ (@a) (x :: [a]) -> - (T7360.fun5, - case x of wild { - [] -> T7360.fun4; - : ds ds1 -> - case GHC.List.$wlenAcc @a wild 0# of ww2 { __DEFAULT -> - GHC.Types.I# ww2 - } + (T7360.fun4, + case GHC.List.$wlenAcc @a x 0# of ww2 { __DEFAULT -> + GHC.Types.I# ww2 }) -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1276e27512d7a79c4cb64dd6366178551286e957 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1276e27512d7a79c4cb64dd6366178551286e957 You're receiving 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 Mar 23 17:22:42 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 23 Mar 2020 13:22:42 -0400 Subject: [Git][ghc/ghc][wip/T17932] Demand analysis: simplify the demand for a RHS Message-ID: <5e78f06238c9b_6167118f1e501101b2@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T17932 at Glasgow Haskell Compiler / GHC Commits: 524a2109 by Simon Peyton Jones at 2020-03-23T18:21:25+01: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. - - - - - 12 changed files: - compiler/GHC/Core/Op/CprAnal.hs - compiler/GHC/Core/Op/DmdAnal.hs - compiler/GHC/Core/Op/WorkWrap/Lib.hs - testsuite/tests/simplCore/should_compile/T4201.stdout - testsuite/tests/stranal/T10482a.hs - testsuite/tests/stranal/should_compile/T10482.stderr - testsuite/tests/stranal/should_compile/T10482a.stderr - testsuite/tests/stranal/sigs/DmdAnalGADTs.stderr - + testsuite/tests/stranal/sigs/T17932.hs - + testsuite/tests/stranal/sigs/T17932.stderr - testsuite/tests/stranal/sigs/UnsatFun.stderr - testsuite/tests/stranal/sigs/all.T Changes: ===================================== compiler/GHC/Core/Op/CprAnal.hs ===================================== @@ -13,7 +13,6 @@ module GHC.Core.Op.CprAnal ( cprAnalProgram ) where import GhcPrelude -import GHC.Core.Op.WorkWrap.Lib ( deepSplitProductType_maybe ) import GHC.Driver.Session import Demand import Cpr @@ -30,6 +29,7 @@ import GHC.Core.Utils ( exprIsHNF, dumpIdInfoOfProgram ) import GHC.Core.TyCon import GHC.Core.Type import GHC.Core.FamInstEnv +import GHC.Core.Op.WorkWrap.Lib import Util import ErrUtils ( dumpIfSet_dyn, DumpFormat (..) ) import Maybes ( isJust, isNothing ) @@ -88,7 +88,8 @@ Ideally, we would want the following pipeline: 4. worker/wrapper (for CPR) Currently, we omit 2. and anticipate the results of worker/wrapper. -See Note [CPR in a DataAlt case alternative] and Note [CPR for strict binders]. +See Note [CPR in a DataAlt case alternative] +and Note [CPR for binders that will be unboxed]. An additional w/w pass would simplify things, but probably add slight overhead. So currently we have @@ -175,7 +176,7 @@ cprAnal' env (Lam var body) | otherwise = (lam_ty, Lam var body') where - env' = extendSigsWithLam env var + env' = extendAnalEnvForDemand env var (idDemandInfo var) (body_ty, body') = cprAnal env' body lam_ty = abstractCprTy body_ty @@ -392,15 +393,25 @@ lookupSigEnv env id = lookupVarEnv (ae_sigs env) id nonVirgin :: AnalEnv -> AnalEnv nonVirgin env = env { ae_virgin = False } -extendSigsWithLam :: AnalEnv -> Id -> AnalEnv --- Extend the AnalEnv when we meet a lambda binder -extendSigsWithLam env id +-- | A version of 'extendAnalEnv' for a binder of which we don't see the RHS +-- needed to compute a 'CprSig' (e.g. lambdas and DataAlt field binders). +-- In this case, we can still look at their demand to attach CPR signatures +-- anticipating the unboxing done by worker/wrapper. +-- See Note [CPR for binders that will be unboxed]. +extendAnalEnvForDemand :: AnalEnv -> Id -> Demand -> AnalEnv +extendAnalEnvForDemand env id dmd | isId id - , isStrictDmd (idDemandInfo id) -- See Note [CPR for strict binders] - , Just (dc,_,_,_) <- deepSplitProductType_maybe (ae_fam_envs env) $ idType id + , Just (_, DataConAppContext { dcac_dc = dc }) + <- wantToUnbox (ae_fam_envs env) has_inlineable_prag (idType id) dmd = extendAnalEnv env id (CprSig (conCprType (dataConTag dc))) | otherwise = env + where + -- Rather than maintaining in AnalEnv whether we are in an INLINEABLE + -- function, we just assume that we aren't. That flag is only relevant + -- to Note [Do not unpack class dictionaries], the few unboxing + -- opportunities on dicts it prohibits are probably irrelevant to CPR. + has_inlineable_prag = False extendEnvForDataAlt :: AnalEnv -> CoreExpr -> Id -> DataCon -> [Var] -> AnalEnv -- See Note [CPR in a DataAlt case alternative] @@ -425,18 +436,16 @@ extendEnvForDataAlt env scrut case_bndr dc bndrs -- propagate available unboxed things from the scrutinee, getting rid of -- the is_var_scrut heuristic. See Note [CPR in a DataAlt case alternative]. -- Giving strict binders the CPR property only makes sense for products, as - -- the arguments in Note [CPR for strict binders] don't apply to sums (yet); - -- we lack WW for strict binders of sum type. + -- the arguments in Note [CPR for binders that will be unboxed] don't apply + -- to sums (yet); we lack WW for strict binders of sum type. do_con_arg env (id, str) - | let is_strict = isStrictDmd (idDemandInfo id) || isMarkedStrict str - , is_var_scrut && is_strict - , let fam_envs = ae_fam_envs env - , Just (dc,_,_,_) <- deepSplitProductType_maybe fam_envs $ idType id - = extendAnalEnv env id (CprSig (conCprType (dataConTag dc))) + | is_var scrut + -- See Note [Add demands for strict constructors] in WorkWrap.Lib + , let dmd = applyWhen (isMarkedStrict str) strictifyDmd (idDemandInfo id) + = extendAnalEnvForDemand env id dmd | otherwise = env - is_var_scrut = is_var scrut is_var (Cast e _) = is_var e is_var (Var v) = isLocalId v is_var _ = False @@ -472,7 +481,8 @@ Specifically box. If the wrapper doesn't cancel with its caller, we'll end up re-boxing something that we did have available in boxed form. - * Any strict binders with product type, can use Note [CPR for strict binders] + * Any strict binders with product type, can use + Note [CPR for binders that will be unboxed] to anticipate worker/wrappering for strictness info. But we can go a little further. Consider @@ -499,11 +509,11 @@ Specifically sub-component thereof. But it's simple, and nothing terrible happens if we get it wrong. e.g. Trac #10694. -Note [CPR for strict binders] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -If a lambda-bound variable is marked demanded with a strict demand, then give it -a CPR signature, anticipating the results of worker/wrapper. Here's a concrete -example ('f1' in test T10482a), assuming h is strict: +Note [CPR for binders that will be unboxed] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +If a lambda-bound variable will be unboxed by worker/wrapper (so it must be +demanded strictly), then give it a CPR signature. Here's a concrete example +('f1' in test T10482a), assuming h is strict: f1 :: Int -> Int f1 x = case h x of @@ -527,6 +537,9 @@ Note that has product type, else we may get over-optimistic CPR results (e.g. from \x -> x!). + * This also (approximately) applies to DataAlt field binders; + See Note [CPR in a DataAlt case alternative]. + * See Note [CPR examples] Note [CPR for sum types] @@ -628,21 +641,6 @@ point: all of these functions can have the CPR property. True -> x False -> f1 (x-1) - - ------- f2 ----------- - -- x is a strict field of MkT2, so we'll pass it unboxed - -- to $wf2, so it's available unboxed. This depends on - -- the case expression analysing (a subcomponent of) one - -- of the original arguments to the function, so it's - -- a bit more delicate. - - data T2 = MkT2 !Int Int - - f2 :: T2 -> Int - f2 (MkT2 x y) | y>0 = f2 (MkT2 x (y-1)) - | otherwise = x - - ------- f3 ----------- -- h is strict in x, so x will be unboxed before it -- is rerturned in the otherwise case. @@ -652,18 +650,4 @@ point: all of these functions can have the CPR property. f1 :: T3 -> Int f1 (MkT3 x y) | h x y = f3 (MkT3 x (y-1)) | otherwise = x - - - ------- f4 ----------- - -- Just like f2, but MkT4 can't unbox its strict - -- argument automatically, as f2 can - - data family Foo a - newtype instance Foo Int = Foo Int - - data T4 a = MkT4 !(Foo a) Int - - f4 :: T4 Int -> Int - f4 (MkT4 x@(Foo v) y) | y>0 = f4 (MkT4 x (y-1)) - | otherwise = v -} ===================================== compiler/GHC/Core/Op/DmdAnal.hs ===================================== @@ -617,16 +617,11 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs is_thunk = not (exprIsHNF rhs) && not (isJoinId id) -- | @mkRhsDmd env rhs_arity rhs@ creates a 'CleanDemand' for --- unleashing on the given function's @rhs@, by creating a call demand of --- @rhs_arity@ with a body demand appropriate for possible product types. --- See Note [Product demands for function body]. --- For example, a call of the form @mkRhsDmd _ 2 (\x y -> (x, y))@ returns a --- clean usage demand of @C1(C1(U(U,U)))@. +-- 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 -> CleanDemand -mkRhsDmd env rhs_arity rhs = - case peelTsFuns rhs_arity (findTypeShape (ae_fam_envs env) (exprType rhs)) of - Just (TsProd tss) -> mkCallDmds rhs_arity (cleanEvalProdDmd (length tss)) - _ -> mkCallDmds rhs_arity cleanEvalDmd +mkRhsDmd _env rhs_arity _rhs = mkCallDmds rhs_arity cleanEvalDmd -- | If given the let-bound 'Id', 'useLetUp' determines whether we should -- process the binding up (body before rhs) or down (rhs before body). @@ -857,9 +852,9 @@ forward plusInt's demand signature, and all is well (see Note [Newtype arity] in GHC.Core.Arity)! A small example is the test case NewtypeArity. -Note [Product demands for function body] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -This example comes from shootout/binary_trees: +Historical Note [Product demands for function body] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In 2013 I spotted this example, in shootout/binary_trees: Main.check' = \ b z ds. case z of z' { I# ip -> case ds_d13s of @@ -878,8 +873,12 @@ Here we *really* want to unbox z, even though it appears to be used boxed in the Nil case. Partly the Nil case is not a hot path. But more specifically, the whole function gets the CPR property if we do. -So for the demand on the body of a RHS we use a product demand if it's -a product type. +That motivated using a demand of C(C(C(S(L,L)))) for the RHS, where +(solely because the result was a product) we used a product demand +(albeit with lazy components) for the body. But that gives very silly +behaviour -- see #17932. Happily it turns out now to be entirely +unnecessary: we get good results with C(C(C(S))). So I simply +deleted the special case. ************************************************************************ * * ===================================== compiler/GHC/Core/Op/WorkWrap/Lib.hs ===================================== @@ -8,7 +8,8 @@ A library for the ``worker\/wrapper'' back-end to the strictness analyser module GHC.Core.Op.WorkWrap.Lib ( mkWwBodies, mkWWstr, mkWorkerArgs - , deepSplitProductType_maybe, findTypeShape + , DataConAppContext(..), deepSplitProductType_maybe, wantToUnbox + , findTypeShape , isWorkerSmallEnough ) where @@ -588,21 +589,8 @@ mkWWstr_one dflags fam_envs has_inlineable_prag arg -- (that's what mk_absent_let does) = return (True, [], nop_fn, work_fn) - | isStrictDmd dmd - , Just cs <- splitProdDmd_maybe dmd - -- See Note [Unpacking arguments with product and polymorphic demands] - , not (has_inlineable_prag && isClassPred arg_ty) - -- See Note [Do not unpack class dictionaries] - , Just stuff@(_, _, inst_con_arg_tys, _) <- deepSplitProductType_maybe fam_envs arg_ty - , cs `equalLength` inst_con_arg_tys - -- See Note [mkWWstr and unsafeCoerce] - = unbox_one dflags fam_envs arg cs stuff - - | isSeqDmd dmd -- For seqDmd, splitProdDmd_maybe will return Nothing, but - -- it should behave like , for some suitable arity - , Just stuff@(_, _, inst_con_arg_tys, _) <- deepSplitProductType_maybe fam_envs arg_ty - , let abs_dmds = map (const absDmd) inst_con_arg_tys - = unbox_one dflags fam_envs arg abs_dmds stuff + | Just (cs, acdc) <- wantToUnbox fam_envs has_inlineable_prag arg_ty dmd + = unbox_one dflags fam_envs arg cs acdc | otherwise -- Other cases = return (False, [arg], nop_fn, nop_fn) @@ -611,12 +599,36 @@ 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 fam_envs has_inlineable_prag ty dmd = + case deepSplitProductType_maybe fam_envs ty of + Just dcac at DataConAppContext{ dcac_arg_tys = con_arg_tys } + | isStrictDmd dmd + -- See Note [Unpacking arguments with product and polymorphic demands] + , Just cs <- split_prod_dmd_arity dmd (length con_arg_tys) + -- 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) + _ -> Nothing + where + split_prod_dmd_arity dmd arty + -- For seqDmd, splitProdDmd_maybe will return Nothing (because how would + -- it know the arity?), but it should behave like , for some + -- suitable arity + | isSeqDmd dmd = Just (replicate arty absDmd) + -- Otherwise splitProdDmd_maybe does the job + | otherwise = splitProdDmd_maybe dmd + unbox_one :: DynFlags -> FamInstEnvs -> Var -> [Demand] - -> (DataCon, [Type], [(Type, StrictnessMark)], Coercion) + -> DataConAppContext -> UniqSM (Bool, [Var], CoreExpr -> CoreExpr, CoreExpr -> CoreExpr) unbox_one dflags fam_envs arg cs - (data_con, inst_tys, inst_con_arg_tys, co) + DataConAppContext { dcac_dc = data_con, dcac_tys = inst_tys + , dcac_arg_tys = inst_con_arg_tys + , dcac_co = co } = do { (uniq1:uniqs) <- getUniquesM ; let -- See Note [Add demands for strict constructors] cs' = addDataConStrictness data_con cs @@ -898,8 +910,8 @@ If we have f :: Ord a => [a] -> Int -> a {-# INLINABLE f #-} and we worker/wrapper f, we'll get a worker with an INLINABLE pragma -(see Note [Worker-wrapper for INLINABLE functions] in GHC.Core.Op.WorkWrap), which -can still be specialised by the type-class specialiser, something like +(see Note [Worker-wrapper for INLINABLE functions] in GHC.Core.Op.WorkWrap), +which can still be specialised by the type-class specialiser, something like fw :: Ord a => [a] -> Int# -> a BUT if f is strict in the Ord dictionary, we might unpack it, to get @@ -915,9 +927,29 @@ Historical note: #14955 describes how I got this fix wrong the first time. -} -deepSplitProductType_maybe - :: FamInstEnvs -> Type - -> Maybe (DataCon, [Type], [(Type, StrictnessMark)], Coercion) +-- | 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) +-- +-- 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 :: ![(Type, StrictnessMark)] + , dcac_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 @@ -930,12 +962,14 @@ deepSplitProductType_maybe fam_envs ty , Just con <- isDataProductTyCon_maybe tc , let arg_tys = dataConInstArgTys con tc_args strict_marks = dataConRepStrictness con - = Just (con, tc_args, zipEqual "dspt" arg_tys strict_marks, co) + = 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 (DataCon, [Type], [(Type, StrictnessMark)], Coercion) + :: 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 @@ -952,7 +986,10 @@ deepSplitCprType_maybe fam_envs con_tag ty , let con = cons `getNth` (con_tag - fIRST_TAG) arg_tys = dataConInstArgTys con tc_args strict_marks = dataConRepStrictness con - = Just (con, tc_args, zipEqual "dsct" arg_tys strict_marks, co) + = Just DataConAppContext { dcac_dc = con + , dcac_tys = tc_args + , dcac_arg_tys = zipEqual "dspt" arg_tys strict_marks + , dcac_co = co } deepSplitCprType_maybe _ _ _ = Nothing findTypeShape :: FamInstEnvs -> Type -> TypeShape @@ -1009,17 +1046,18 @@ 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 stuff <- deepSplitCprType_maybe fam_envs con_tag body_ty - -> mkWWcpr_help stuff + Just con_tag | Just dcac <- deepSplitCprType_maybe fam_envs con_tag body_ty + -> mkWWcpr_help dcac | 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 :: (DataCon, [Type], [(Type,StrictnessMark)], Coercion) +mkWWcpr_help :: DataConAppContext -> UniqSM (Bool, CoreExpr -> CoreExpr, CoreExpr -> CoreExpr, Type) -mkWWcpr_help (data_con, inst_tys, arg_tys, co) +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 arg_ty1 -- Special case when there is a single result of unlifted type ===================================== testsuite/tests/simplCore/should_compile/T4201.stdout ===================================== @@ -1,3 +1,3 @@ - [HasNoCafRefs, Arity: 1, Strictness: , CPR: m1, + [HasNoCafRefs, Arity: 1, Strictness: , Unfolding: InlineRule (0, True, True) bof `cast` (Sym (N:Foo[0]) ->_R _R)] ===================================== testsuite/tests/stranal/T10482a.hs ===================================== @@ -22,6 +22,9 @@ f1 x = case h x x of ------- f2 ----------- +-- We used to unbox x here and rebox it in the wrapper. After #17932, we don't. +-- After #17932, we don't. +-- Historical comment: -- x is a strict field of MkT2, so we'll pass it unboxed -- to $wf2, so it's available unboxed. This depends on -- the case expression analysing (a subcomponent of) one @@ -48,6 +51,8 @@ f1 (MkT3 x y) | h x y = f3 (MkT3 x (y-1)) ------- f4 ----------- +-- We used to unbox x here and rebox it in the wrapper. After #17932, we don't. +-- Historical comment: -- Just like f2, but MkT4 can't unbox its strict -- argument automatically, as f2 can ===================================== testsuite/tests/stranal/should_compile/T10482.stderr ===================================== @@ -1,261 +1,243 @@ ==================== Tidy Core ==================== -Result size of Tidy Core = {terms: 171, types: 116, coercions: 15, joins: 0/0} +Result size of Tidy Core = {terms: 167, types: 116, coercions: 15, joins: 0/0} -- RHS size: {terms: 13, types: 14, coercions: 4, joins: 0/0} -T10482.$WFooPair [InlPrag=INLINE[2]] :: forall a b. Foo a -> Foo b -> Foo (a, b) +T10482.$WFooPair [InlPrag=INLINE[0]] :: forall a b. Foo a -> Foo b -> Foo (a, b) [GblId[DataConWrapper], Arity=2, Caf=NoCafRefs, - Str=m, + Str=, + Cpr=m1, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) - Tmpl= \ (@ a_aX9) (@ b_aXa) (dt_a2pg [Occ=Once] :: Foo a_aX9[sk:2]) (dt_a2ph [Occ=Once] :: Foo b_aXa[sk:2]) -> - (case dt_a2pg of dt_X2pl { __DEFAULT -> case dt_a2ph of dt_X2pn { __DEFAULT -> T10482.FooPair @ a_aX9 @ b_aXa dt_X2pl dt_X2pn } }) - `cast` (Sym (T10482.D:R:Foo(,)0[0] _N _N) :: (T10482.R:Foo(,) a_aX9 b_aXa :: *) ~R# (Foo (a_aX9, b_aXa) :: *))}] + Tmpl= \ (@a_atL) (@b_atM) (dt_a1r7 [Occ=Once] :: Foo a_atL) (dt_a1r8 [Occ=Once] :: Foo b_atM) -> + (case dt_a1r7 of dt_X0 [Occ=Once] { __DEFAULT -> + case dt_a1r8 of dt_X1 [Occ=Once] { __DEFAULT -> T10482.FooPair @a_atL @b_atM dt_X0 dt_X1 } + }) + `cast` (Sym (T10482.D:R:Foo(,)0[0] _N _N) :: T10482.R:Foo(,) a_atL b_atM ~R# Foo (a_atL, b_atM))}] T10482.$WFooPair - = \ (@ a_aX9) (@ b_aXa) (dt_a2pg [Occ=Once] :: Foo a_aX9[sk:2]) (dt_a2ph [Occ=Once] :: Foo b_aXa[sk:2]) -> - (case dt_a2pg of dt_X2pl { __DEFAULT -> case dt_a2ph of dt_X2pn { __DEFAULT -> T10482.FooPair @ a_aX9 @ b_aXa dt_X2pl dt_X2pn } }) - `cast` (Sym (T10482.D:R:Foo(,)0[0] _N _N) :: (T10482.R:Foo(,) a_aX9 b_aXa :: *) ~R# (Foo (a_aX9, b_aXa) :: *)) + = \ (@a_atL) (@b_atM) (dt_a1r7 [Occ=Once] :: Foo a_atL) (dt_a1r8 [Occ=Once] :: Foo b_atM) -> + (case dt_a1r7 of dt_X0 [Occ=Once] { __DEFAULT -> + case dt_a1r8 of dt_X1 [Occ=Once] { __DEFAULT -> T10482.FooPair @a_atL @b_atM dt_X0 dt_X1 } + }) + `cast` (Sym (T10482.D:R:Foo(,)0[0] _N _N) :: T10482.R:Foo(,) a_atL b_atM ~R# Foo (a_atL, b_atM)) -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T10482.$trModule4 :: GHC.Prim.Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] T10482.$trModule4 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T10482.$trModule3 :: GHC.Types.TrName [GblId, - Caf=NoCafRefs, - Str=m1, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] T10482.$trModule3 = GHC.Types.TrNameS T10482.$trModule4 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T10482.$trModule2 :: GHC.Prim.Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] T10482.$trModule2 = "T10482"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T10482.$trModule1 :: GHC.Types.TrName [GblId, - Caf=NoCafRefs, - Str=m1, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] T10482.$trModule1 = GHC.Types.TrNameS T10482.$trModule2 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} T10482.$trModule :: GHC.Types.Module [GblId, - Caf=NoCafRefs, - Str=m, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] T10482.$trModule = GHC.Types.Module T10482.$trModule3 T10482.$trModule1 -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} -$krep_r2Q4 :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] -$krep_r2Q4 = GHC.Types.KindRepTyConApp GHC.Types.$tcInt (GHC.Types.[] @ GHC.Types.KindRep) +$krep_r1Gw :: GHC.Types.KindRep +[GblId, Cpr=m1, Unf=OtherCon []] +$krep_r1Gw = GHC.Types.KindRepTyConApp GHC.Types.$tcInt (GHC.Types.[] @GHC.Types.KindRep) -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -$krep1_r2Q5 :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] -$krep1_r2Q5 = GHC.Types.KindRepVar 1# +$krep1_r1Gx :: GHC.Types.KindRep +[GblId, Cpr=m2, Unf=OtherCon []] +$krep1_r1Gx = GHC.Types.KindRepVar 1# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -$krep2_r2Q6 :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] -$krep2_r2Q6 = GHC.Types.KindRepVar 0# +$krep2_r1Gy :: GHC.Types.KindRep +[GblId, Cpr=m2, Unf=OtherCon []] +$krep2_r1Gy = GHC.Types.KindRepVar 0# -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -$krep3_r2Q7 :: [GHC.Types.KindRep] -[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] -$krep3_r2Q7 = GHC.Types.: @ GHC.Types.KindRep $krep1_r2Q5 (GHC.Types.[] @ GHC.Types.KindRep) +$krep3_r1Gz :: [GHC.Types.KindRep] +[GblId, Cpr=m2, Unf=OtherCon []] +$krep3_r1Gz = GHC.Types.: @GHC.Types.KindRep $krep1_r1Gx (GHC.Types.[] @GHC.Types.KindRep) -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} -$krep4_r2Q8 :: [GHC.Types.KindRep] -[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] -$krep4_r2Q8 = GHC.Types.: @ GHC.Types.KindRep $krep2_r2Q6 $krep3_r2Q7 +$krep4_r1GA :: [GHC.Types.KindRep] +[GblId, Cpr=m2, Unf=OtherCon []] +$krep4_r1GA = GHC.Types.: @GHC.Types.KindRep $krep2_r1Gy $krep3_r1Gz -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep5_r2Q9 :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] -$krep5_r2Q9 = GHC.Types.KindRepTyConApp GHC.Tuple.$tc(,) $krep4_r2Q8 +$krep5_r1GB :: GHC.Types.KindRep +[GblId, Cpr=m1, Unf=OtherCon []] +$krep5_r1GB = GHC.Types.KindRepTyConApp GHC.Tuple.$tc(,) $krep4_r1GA -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T10482.$tcFoo2 :: GHC.Prim.Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] T10482.$tcFoo2 = "Foo"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T10482.$tcFoo1 :: GHC.Types.TrName [GblId, - Caf=NoCafRefs, - Str=m1, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] T10482.$tcFoo1 = GHC.Types.TrNameS T10482.$tcFoo2 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T10482.$tcFoo :: GHC.Types.TyCon [GblId, - Caf=NoCafRefs, - Str=m, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] T10482.$tcFoo = GHC.Types.TyCon 3311038889639791302## 7944995683507700778## T10482.$trModule T10482.$tcFoo1 0# GHC.Types.krep$*Arr* -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -$krep6_r2Qa :: [GHC.Types.KindRep] -[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] -$krep6_r2Qa = GHC.Types.: @ GHC.Types.KindRep $krep2_r2Q6 (GHC.Types.[] @ GHC.Types.KindRep) +$krep6_r1GC :: [GHC.Types.KindRep] +[GblId, Cpr=m2, Unf=OtherCon []] +$krep6_r1GC = GHC.Types.: @GHC.Types.KindRep $krep2_r1Gy (GHC.Types.[] @GHC.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep7_r2Qb :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] -$krep7_r2Qb = GHC.Types.KindRepTyConApp T10482.$tcFoo $krep6_r2Qa +$krep7_r1GD :: GHC.Types.KindRep +[GblId, Cpr=m1, Unf=OtherCon []] +$krep7_r1GD = GHC.Types.KindRepTyConApp T10482.$tcFoo $krep6_r1GC -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep8_r2Qc :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] -$krep8_r2Qc = GHC.Types.KindRepTyConApp T10482.$tcFoo $krep3_r2Q7 +$krep8_r1GE :: GHC.Types.KindRep +[GblId, Cpr=m1, Unf=OtherCon []] +$krep8_r1GE = GHC.Types.KindRepTyConApp T10482.$tcFoo $krep3_r1Gz -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -$krep9_r2Qd :: [GHC.Types.KindRep] -[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] -$krep9_r2Qd = GHC.Types.: @ GHC.Types.KindRep $krep5_r2Q9 (GHC.Types.[] @ GHC.Types.KindRep) +$krep9_r1GF :: [GHC.Types.KindRep] +[GblId, Cpr=m2, Unf=OtherCon []] +$krep9_r1GF = GHC.Types.: @GHC.Types.KindRep $krep5_r1GB (GHC.Types.[] @GHC.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep10_r2Qe :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] -$krep10_r2Qe = GHC.Types.KindRepTyConApp T10482.$tcFoo $krep9_r2Qd +$krep10_r1GG :: GHC.Types.KindRep +[GblId, Cpr=m1, Unf=OtherCon []] +$krep10_r1GG = GHC.Types.KindRepTyConApp T10482.$tcFoo $krep9_r1GF -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep11_r2Qf :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] -$krep11_r2Qf = GHC.Types.KindRepFun $krep8_r2Qc $krep10_r2Qe +$krep11_r1GH :: GHC.Types.KindRep +[GblId, Cpr=m4, Unf=OtherCon []] +$krep11_r1GH = GHC.Types.KindRepFun $krep8_r1GE $krep10_r1GG -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} T10482.$tc'FooPair1 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] -T10482.$tc'FooPair1 = GHC.Types.KindRepFun $krep7_r2Qb $krep11_r2Qf +[GblId, Cpr=m4, Unf=OtherCon []] +T10482.$tc'FooPair1 = GHC.Types.KindRepFun $krep7_r1GD $krep11_r1GH -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -$krep12_r2Qg :: [GHC.Types.KindRep] -[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] -$krep12_r2Qg = GHC.Types.: @ GHC.Types.KindRep $krep_r2Q4 (GHC.Types.[] @ GHC.Types.KindRep) +$krep12_r1GI :: [GHC.Types.KindRep] +[GblId, Cpr=m2, Unf=OtherCon []] +$krep12_r1GI = GHC.Types.: @GHC.Types.KindRep $krep_r1Gw (GHC.Types.[] @GHC.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep13_r2Qh :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] -$krep13_r2Qh = GHC.Types.KindRepTyConApp T10482.$tcFoo $krep12_r2Qg +$krep13_r1GJ :: GHC.Types.KindRep +[GblId, Cpr=m1, Unf=OtherCon []] +$krep13_r1GJ = GHC.Types.KindRepTyConApp T10482.$tcFoo $krep12_r1GI -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} T10482.$tc'Foo1 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] -T10482.$tc'Foo1 = GHC.Types.KindRepFun $krep_r2Q4 $krep13_r2Qh +[GblId, Cpr=m4, Unf=OtherCon []] +T10482.$tc'Foo1 = GHC.Types.KindRepFun $krep_r1Gw $krep13_r1GJ -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T10482.$tc'FooPair3 :: GHC.Prim.Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] T10482.$tc'FooPair3 = "'FooPair"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T10482.$tc'FooPair2 :: GHC.Types.TrName [GblId, - Caf=NoCafRefs, - Str=m1, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] T10482.$tc'FooPair2 = GHC.Types.TrNameS T10482.$tc'FooPair3 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T10482.$tc'FooPair :: GHC.Types.TyCon [GblId, - Caf=NoCafRefs, - Str=m, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] T10482.$tc'FooPair = GHC.Types.TyCon 5329411373903054066## 1455261321638291317## T10482.$trModule T10482.$tc'FooPair2 2# T10482.$tc'FooPair1 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T10482.$tc'Foo3 :: GHC.Prim.Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] T10482.$tc'Foo3 = "'Foo"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T10482.$tc'Foo2 :: GHC.Types.TrName [GblId, - Caf=NoCafRefs, - Str=m1, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] T10482.$tc'Foo2 = GHC.Types.TrNameS T10482.$tc'Foo3 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T10482.$tc'Foo :: GHC.Types.TyCon [GblId, - Caf=NoCafRefs, - Str=m, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] T10482.$tc'Foo = GHC.Types.TyCon 5096937192618987042## 15136671864408054946## T10482.$trModule T10482.$tc'Foo2 0# T10482.$tc'Foo1 +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl_r1GK :: Int +[GblId, Cpr=m1, Unf=OtherCon []] +lvl_r1GK = GHC.Types.I# 0# + Rec { --- RHS size: {terms: 19, types: 4, coercions: 0, joins: 0/0} -T10482.$wfoo [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.Int# -> GHC.Prim.Int# -[GblId, Arity=2, Caf=NoCafRefs, Str=, Unf=OtherCon []] +-- RHS size: {terms: 19, types: 5, coercions: 3, joins: 0/0} +T10482.$wfoo [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker] :: Foo Int -> GHC.Prim.Int# -> Int +[GblId, Arity=2, Str=, Unf=OtherCon []] T10482.$wfoo - = \ (ww_s2OA :: GHC.Prim.Int#) (ww1_s2OI :: GHC.Prim.Int#) -> - case ww1_s2OI of wild_X1r { + = \ (ww_s1Fu + :: Foo Int + Unf=OtherCon []) + (ww1_s1FB :: GHC.Prim.Int#) -> + case ww1_s1FB of wild_X1 { __DEFAULT -> - case GHC.Prim.remInt# wild_X1r 2# of { - __DEFAULT -> ww_s2OA; - 0# -> T10482.$wfoo ww_s2OA (GHC.Prim.-# wild_X1r 1#) + case GHC.Prim.remInt# wild_X1 2# of { + __DEFAULT -> ww_s1Fu `cast` (T10482.D:R:FooInt0[0] ; T10482.N:R:FooInt[0] :: Foo Int ~R# Int); + 0# -> T10482.$wfoo ww_s1Fu (GHC.Prim.-# wild_X1 1#) }; - 0# -> 0# + 0# -> lvl_r1GK } end Rec } --- RHS size: {terms: 21, types: 30, coercions: 11, joins: 0/0} +-- RHS size: {terms: 14, types: 27, coercions: 8, joins: 0/0} foo [InlPrag=NOUSERINLINE[2]] :: Foo ((Int, Int), Int) -> Int -> Int [GblId, Arity=2, - Caf=NoCafRefs, - Str=m, + Str=, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) - Tmpl= \ (w_s2Oq [Occ=Once] :: Foo ((Int, Int), Int)) (w1_s2Or [Occ=Once!] :: Int) -> - case w_s2Oq - `cast` (T10482.D:R:Foo(,)0[0] <(Int, Int)>_N _N :: (Foo ((Int, Int), Int) :: *) ~R# (T10482.R:Foo(,) (Int, Int) Int :: *)) - of - { FooPair ww1_s2Ou [Occ=Once] _ [Occ=Dead] -> - case ww1_s2Ou `cast` (T10482.D:R:Foo(,)0[0] _N _N :: (Foo (Int, Int) :: *) ~R# (T10482.R:Foo(,) Int Int :: *)) of - { FooPair ww4_s2Ox [Occ=Once] _ [Occ=Dead] -> - case ww4_s2Ox `cast` (T10482.D:R:FooInt0[0] ; T10482.N:R:FooInt[0] :: (Foo Int :: *) ~R# (Int :: *)) of - { GHC.Types.I# ww7_s2OA [Occ=Once] -> - case w1_s2Or of { GHC.Types.I# ww9_s2OI [Occ=Once] -> - case T10482.$wfoo ww7_s2OA ww9_s2OI of ww10_s2OM { __DEFAULT -> GHC.Types.I# ww10_s2OM } - } - } + Tmpl= \ (w_s1Fn [Occ=Once] :: Foo ((Int, Int), Int)) (w1_s1Fo [Occ=Once!] :: Int) -> + case w_s1Fn `cast` (T10482.D:R:Foo(,)0[0] <(Int, Int)>_N _N :: Foo ((Int, Int), Int) ~R# T10482.R:Foo(,) (Int, Int) Int) of + { FooPair ww1_s1Fr [Occ=Once] _ [Occ=Dead] -> + case ww1_s1Fr `cast` (T10482.D:R:Foo(,)0[0] _N _N :: Foo (Int, Int) ~R# T10482.R:Foo(,) Int Int) of + { FooPair ww4_s1Fu [Occ=Once] _ [Occ=Dead] -> + case w1_s1Fo of { GHC.Types.I# ww7_s1FB [Occ=Once] -> T10482.$wfoo ww4_s1Fu ww7_s1FB } } }}] foo - = \ (w_s2Oq :: Foo ((Int, Int), Int)) (w1_s2Or :: Int) -> - case w_s2Oq - `cast` (T10482.D:R:Foo(,)0[0] <(Int, Int)>_N _N :: (Foo ((Int, Int), Int) :: *) ~R# (T10482.R:Foo(,) (Int, Int) Int :: *)) - of - { FooPair ww1_s2Ou ww2_s2OE -> - case ww1_s2Ou `cast` (T10482.D:R:Foo(,)0[0] _N _N :: (Foo (Int, Int) :: *) ~R# (T10482.R:Foo(,) Int Int :: *)) of - { FooPair ww4_s2Pm ww5_s2Pn -> - case ww4_s2Pm `cast` (T10482.D:R:FooInt0[0] ; T10482.N:R:FooInt[0] :: (Foo Int :: *) ~R# (Int :: *)) of { GHC.Types.I# ww7_s2Pq -> - case w1_s2Or of { GHC.Types.I# ww9_s2OI -> case T10482.$wfoo ww7_s2Pq ww9_s2OI of ww10_s2OM { __DEFAULT -> GHC.Types.I# ww10_s2OM } } - } + = \ (w_s1Fn :: Foo ((Int, Int), Int)) (w1_s1Fo :: Int) -> + case w_s1Fn `cast` (T10482.D:R:Foo(,)0[0] <(Int, Int)>_N _N :: Foo ((Int, Int), Int) ~R# T10482.R:Foo(,) (Int, Int) Int) of + { FooPair ww1_s1Fr ww2_s1Fx -> + case ww1_s1Fr `cast` (T10482.D:R:Foo(,)0[0] _N _N :: Foo (Int, Int) ~R# T10482.R:Foo(,) Int Int) of + { FooPair ww4_s1G0 ww5_s1G1 -> + case w1_s1Fo of { GHC.Types.I# ww7_s1FB -> T10482.$wfoo ww4_s1G0 ww7_s1FB } } } ===================================== testsuite/tests/stranal/should_compile/T10482a.stderr ===================================== @@ -1,407 +1,366 @@ ==================== Tidy Core ==================== -Result size of Tidy Core = {terms: 353, types: 155, coercions: 3, joins: 0/0} +Result size of Tidy Core = {terms: 342, types: 152, coercions: 3, joins: 0/0} -- RHS size: {terms: 9, types: 8, coercions: 0, joins: 0/0} -Foo.$WMkT4 [InlPrag=INLINE[2]] :: forall a. Foo a -> Int -> T4 a +Foo.$WMkT4 [InlPrag=INLINE[0]] :: forall a. Foo a -> Int -> T4 a [GblId[DataConWrapper], Arity=2, Caf=NoCafRefs, - Str=m, + Str=, + Cpr=m1, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) - Tmpl= \ (@ a_atA) (dt_a21M [Occ=Once] :: Foo a_atA[sk:1]) (dt_a21N [Occ=Once] :: Int) -> - case dt_a21M of dt_X21Q { __DEFAULT -> Foo.MkT4 @ a_atA dt_X21Q dt_a21N }}] + Tmpl= \ (@a_agw) (dt_a1hl [Occ=Once] :: Foo a_agw) (dt_a1hm [Occ=Once] :: Int) -> + case dt_a1hl of dt_X0 [Occ=Once] { __DEFAULT -> Foo.MkT4 @a_agw dt_X0 dt_a1hm }}] Foo.$WMkT4 - = \ (@ a_atA) (dt_a21M [Occ=Once] :: Foo a_atA[sk:1]) (dt_a21N [Occ=Once] :: Int) -> - case dt_a21M of dt_X21Q { __DEFAULT -> Foo.MkT4 @ a_atA dt_X21Q dt_a21N } + = \ (@a_agw) (dt_a1hl [Occ=Once] :: Foo a_agw) (dt_a1hm [Occ=Once] :: Int) -> + case dt_a1hl of dt_X0 [Occ=Once] { __DEFAULT -> Foo.MkT4 @a_agw dt_X0 dt_a1hm } -- RHS size: {terms: 8, types: 3, coercions: 0, joins: 0/0} -Foo.$WMkT2 [InlPrag=INLINE[2]] :: Int -> Int -> T2 +Foo.$WMkT2 [InlPrag=INLINE[0]] :: Int -> Int -> T2 [GblId[DataConWrapper], Arity=2, Caf=NoCafRefs, - Str=m, + Str=, + Cpr=m1, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) - Tmpl= \ (dt_a20w [Occ=Once] :: Int) (dt_a20x [Occ=Once] :: Int) -> - case dt_a20w of dt_X20z { __DEFAULT -> Foo.MkT2 dt_X20z dt_a20x }}] + Tmpl= \ (dt_a1gu [Occ=Once] :: Int) (dt_a1gv [Occ=Once] :: Int) -> + case dt_a1gu of dt_X0 [Occ=Once] { __DEFAULT -> Foo.MkT2 dt_X0 dt_a1gv }}] Foo.$WMkT2 - = \ (dt_a20w [Occ=Once] :: Int) (dt_a20x [Occ=Once] :: Int) -> case dt_a20w of dt_X20z { __DEFAULT -> Foo.MkT2 dt_X20z dt_a20x } + = \ (dt_a1gu [Occ=Once] :: Int) (dt_a1gv [Occ=Once] :: Int) -> + case dt_a1gu of dt_X0 [Occ=Once] { __DEFAULT -> Foo.MkT2 dt_X0 dt_a1gv } -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} Foo.$trModule4 :: GHC.Prim.Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] Foo.$trModule4 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} Foo.$trModule3 :: GHC.Types.TrName [GblId, - Caf=NoCafRefs, - Str=m1, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] Foo.$trModule3 = GHC.Types.TrNameS Foo.$trModule4 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} Foo.$trModule2 :: GHC.Prim.Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] Foo.$trModule2 = "Foo"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} Foo.$trModule1 :: GHC.Types.TrName [GblId, - Caf=NoCafRefs, - Str=m1, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] Foo.$trModule1 = GHC.Types.TrNameS Foo.$trModule2 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} Foo.$trModule :: GHC.Types.Module [GblId, - Caf=NoCafRefs, - Str=m, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] Foo.$trModule = GHC.Types.Module Foo.$trModule3 Foo.$trModule1 -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} -$krep_r2oJ :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] -$krep_r2oJ = GHC.Types.KindRepTyConApp GHC.Types.$tcInt (GHC.Types.[] @ GHC.Types.KindRep) +$krep_r1x7 :: GHC.Types.KindRep +[GblId, Cpr=m1, Unf=OtherCon []] +$krep_r1x7 = GHC.Types.KindRepTyConApp GHC.Types.$tcInt (GHC.Types.[] @GHC.Types.KindRep) -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -$krep1_r2oK :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] -$krep1_r2oK = GHC.Types.KindRepVar 0# +$krep1_r1x8 :: GHC.Types.KindRep +[GblId, Cpr=m2, Unf=OtherCon []] +$krep1_r1x8 = GHC.Types.KindRepVar 0# -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} Foo.$tcT5 :: GHC.Prim.Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] Foo.$tcT5 = "T2"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} Foo.$tcT1 :: GHC.Types.TrName [GblId, - Caf=NoCafRefs, - Str=m1, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] Foo.$tcT1 = GHC.Types.TrNameS Foo.$tcT5 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} Foo.$tcT2 :: GHC.Types.TyCon [GblId, - Caf=NoCafRefs, - Str=m, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] Foo.$tcT2 = GHC.Types.TyCon 12492463661685256209## 1082997131366389398## Foo.$trModule Foo.$tcT1 0# GHC.Types.krep$* -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} -$krep2_r2oL :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] -$krep2_r2oL = GHC.Types.KindRepTyConApp Foo.$tcT2 (GHC.Types.[] @ GHC.Types.KindRep) +$krep2_r1x9 :: GHC.Types.KindRep +[GblId, Cpr=m1, Unf=OtherCon []] +$krep2_r1x9 = GHC.Types.KindRepTyConApp Foo.$tcT2 (GHC.Types.[] @GHC.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep3_r2oM :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] -$krep3_r2oM = GHC.Types.KindRepFun $krep_r2oJ $krep2_r2oL +$krep3_r1xa :: GHC.Types.KindRep +[GblId, Cpr=m4, Unf=OtherCon []] +$krep3_r1xa = GHC.Types.KindRepFun $krep_r1x7 $krep2_r1x9 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} Foo.$tc'MkT1 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] -Foo.$tc'MkT1 = GHC.Types.KindRepFun $krep_r2oJ $krep3_r2oM +[GblId, Cpr=m4, Unf=OtherCon []] +Foo.$tc'MkT1 = GHC.Types.KindRepFun $krep_r1x7 $krep3_r1xa -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} Foo.$tc'MkT6 :: GHC.Prim.Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] Foo.$tc'MkT6 = "'MkT2"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} Foo.$tc'MkT5 :: GHC.Types.TrName [GblId, - Caf=NoCafRefs, - Str=m1, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] Foo.$tc'MkT5 = GHC.Types.TrNameS Foo.$tc'MkT6 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} Foo.$tc'MkT2 :: GHC.Types.TyCon [GblId, - Caf=NoCafRefs, - Str=m, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] Foo.$tc'MkT2 = GHC.Types.TyCon 5707542518475997625## 9584804394183763875## Foo.$trModule Foo.$tc'MkT5 0# Foo.$tc'MkT1 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} Foo.$tcT7 :: GHC.Prim.Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] Foo.$tcT7 = "T3"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} Foo.$tcT6 :: GHC.Types.TrName [GblId, - Caf=NoCafRefs, - Str=m1, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] Foo.$tcT6 = GHC.Types.TrNameS Foo.$tcT7 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} Foo.$tcT3 :: GHC.Types.TyCon [GblId, - Caf=NoCafRefs, - Str=m, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] Foo.$tcT3 = GHC.Types.TyCon 8915518733037212359## 16476420519216613869## Foo.$trModule Foo.$tcT6 0# GHC.Types.krep$* -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} -$krep4_r2oN :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] -$krep4_r2oN = GHC.Types.KindRepTyConApp Foo.$tcT3 (GHC.Types.[] @ GHC.Types.KindRep) +$krep4_r1xb :: GHC.Types.KindRep +[GblId, Cpr=m1, Unf=OtherCon []] +$krep4_r1xb = GHC.Types.KindRepTyConApp Foo.$tcT3 (GHC.Types.[] @GHC.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep5_r2oO :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] -$krep5_r2oO = GHC.Types.KindRepFun $krep_r2oJ $krep4_r2oN +$krep5_r1xc :: GHC.Types.KindRep +[GblId, Cpr=m4, Unf=OtherCon []] +$krep5_r1xc = GHC.Types.KindRepFun $krep_r1x7 $krep4_r1xb -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} Foo.$tc'MkT7 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] -Foo.$tc'MkT7 = GHC.Types.KindRepFun $krep_r2oJ $krep5_r2oO +[GblId, Cpr=m4, Unf=OtherCon []] +Foo.$tc'MkT7 = GHC.Types.KindRepFun $krep_r1x7 $krep5_r1xc -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} Foo.$tc'MkT9 :: GHC.Prim.Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] Foo.$tc'MkT9 = "'MkT3"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} Foo.$tc'MkT8 :: GHC.Types.TrName [GblId, - Caf=NoCafRefs, - Str=m1, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] Foo.$tc'MkT8 = GHC.Types.TrNameS Foo.$tc'MkT9 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} Foo.$tc'MkT3 :: GHC.Types.TyCon [GblId, - Caf=NoCafRefs, - Str=m, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] Foo.$tc'MkT3 = GHC.Types.TyCon 7218783144619306039## 13236146459150723629## Foo.$trModule Foo.$tc'MkT8 0# Foo.$tc'MkT7 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} Foo.$tcFoo :: GHC.Types.TyCon [GblId, - Caf=NoCafRefs, - Str=m, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] Foo.$tcFoo = GHC.Types.TyCon 11236787750777559483## 2472662601374496863## Foo.$trModule Foo.$trModule1 0# GHC.Types.krep$*Arr* -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -$krep6_r2oP :: [GHC.Types.KindRep] -[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] -$krep6_r2oP = GHC.Types.: @ GHC.Types.KindRep $krep1_r2oK (GHC.Types.[] @ GHC.Types.KindRep) +$krep6_r1xd :: [GHC.Types.KindRep] +[GblId, Cpr=m2, Unf=OtherCon []] +$krep6_r1xd = GHC.Types.: @GHC.Types.KindRep $krep1_r1x8 (GHC.Types.[] @GHC.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep7_r2oQ :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] -$krep7_r2oQ = GHC.Types.KindRepTyConApp Foo.$tcFoo $krep6_r2oP +$krep7_r1xe :: GHC.Types.KindRep +[GblId, Cpr=m1, Unf=OtherCon []] +$krep7_r1xe = GHC.Types.KindRepTyConApp Foo.$tcFoo $krep6_r1xd -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -$krep8_r2oR :: [GHC.Types.KindRep] -[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] -$krep8_r2oR = GHC.Types.: @ GHC.Types.KindRep $krep_r2oJ (GHC.Types.[] @ GHC.Types.KindRep) +$krep8_r1xf :: [GHC.Types.KindRep] +[GblId, Cpr=m2, Unf=OtherCon []] +$krep8_r1xf = GHC.Types.: @GHC.Types.KindRep $krep_r1x7 (GHC.Types.[] @GHC.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep9_r2oS :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] -$krep9_r2oS = GHC.Types.KindRepTyConApp Foo.$tcFoo $krep8_r2oR +$krep9_r1xg :: GHC.Types.KindRep +[GblId, Cpr=m1, Unf=OtherCon []] +$krep9_r1xg = GHC.Types.KindRepTyConApp Foo.$tcFoo $krep8_r1xf -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} Foo.$tc'Foo1 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] -Foo.$tc'Foo1 = GHC.Types.KindRepFun $krep_r2oJ $krep9_r2oS +[GblId, Cpr=m4, Unf=OtherCon []] +Foo.$tc'Foo1 = GHC.Types.KindRepFun $krep_r1x7 $krep9_r1xg -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} Foo.$tc'Foo3 :: GHC.Prim.Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] Foo.$tc'Foo3 = "'Foo"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} Foo.$tc'Foo2 :: GHC.Types.TrName [GblId, - Caf=NoCafRefs, - Str=m1, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] Foo.$tc'Foo2 = GHC.Types.TrNameS Foo.$tc'Foo3 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} Foo.$tc'Foo :: GHC.Types.TyCon [GblId, - Caf=NoCafRefs, - Str=m, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] Foo.$tc'Foo = GHC.Types.TyCon 10641757595611461765## 13961773224584044648## Foo.$trModule Foo.$tc'Foo2 0# Foo.$tc'Foo1 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} Foo.$tcT9 :: GHC.Prim.Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] Foo.$tcT9 = "T4"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} Foo.$tcT8 :: GHC.Types.TrName [GblId, - Caf=NoCafRefs, - Str=m1, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] Foo.$tcT8 = GHC.Types.TrNameS Foo.$tcT9 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} Foo.$tcT4 :: GHC.Types.TyCon [GblId, - Caf=NoCafRefs, - Str=m, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] Foo.$tcT4 = GHC.Types.TyCon 15961711399118996930## 13694522307176382499## Foo.$trModule Foo.$tcT8 0# GHC.Types.krep$*Arr* -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep10_r2oT :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] -$krep10_r2oT = GHC.Types.KindRepTyConApp Foo.$tcT4 $krep6_r2oP +$krep10_r1xh :: GHC.Types.KindRep +[GblId, Cpr=m1, Unf=OtherCon []] +$krep10_r1xh = GHC.Types.KindRepTyConApp Foo.$tcT4 $krep6_r1xd -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep11_r2oU :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] -$krep11_r2oU = GHC.Types.KindRepFun $krep_r2oJ $krep10_r2oT +$krep11_r1xi :: GHC.Types.KindRep +[GblId, Cpr=m4, Unf=OtherCon []] +$krep11_r1xi = GHC.Types.KindRepFun $krep_r1x7 $krep10_r1xh -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} Foo.$tc'MkT10 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] -Foo.$tc'MkT10 = GHC.Types.KindRepFun $krep7_r2oQ $krep11_r2oU +[GblId, Cpr=m4, Unf=OtherCon []] +Foo.$tc'MkT10 = GHC.Types.KindRepFun $krep7_r1xe $krep11_r1xi -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} Foo.$tc'MkT12 :: GHC.Prim.Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] Foo.$tc'MkT12 = "'MkT4"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} Foo.$tc'MkT11 :: GHC.Types.TrName [GblId, - Caf=NoCafRefs, - Str=m1, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] Foo.$tc'MkT11 = GHC.Types.TrNameS Foo.$tc'MkT12 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} Foo.$tc'MkT4 :: GHC.Types.TyCon [GblId, - Caf=NoCafRefs, - Str=m, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] Foo.$tc'MkT4 = GHC.Types.TyCon 6077781708614236332## 14823286043222481570## Foo.$trModule Foo.$tc'MkT11 1# Foo.$tc'MkT10 Rec { --- RHS size: {terms: 14, types: 3, coercions: 0, joins: 0/0} -Foo.$wf4 [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.Int# -> GHC.Prim.Int# -[GblId, Arity=2, Caf=NoCafRefs, Str=, Unf=OtherCon []] +-- RHS size: {terms: 14, types: 4, coercions: 3, joins: 0/0} +Foo.$wf4 [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker] :: Foo Int -> GHC.Prim.Int# -> Int +[GblId, Arity=2, Str=, Unf=OtherCon []] Foo.$wf4 - = \ (ww_s2jL :: GHC.Prim.Int#) (ww1_s2jQ :: GHC.Prim.Int#) -> - case GHC.Prim.># ww1_s2jQ 0# of { - __DEFAULT -> ww_s2jL; - 1# -> Foo.$wf4 ww_s2jL (GHC.Prim.-# ww1_s2jQ 1#) + = \ (ww_s1tc + :: Foo Int + Unf=OtherCon []) + (ww1_s1tg :: GHC.Prim.Int#) -> + case GHC.Prim.># ww1_s1tg 0# of { + __DEFAULT -> ww_s1tc `cast` (Foo.D:R:FooInt0[0] ; Foo.N:R:FooInt[0] :: Foo Int ~R# Int); + 1# -> Foo.$wf4 ww_s1tc (GHC.Prim.-# ww1_s1tg 1#) } end Rec } --- RHS size: {terms: 17, types: 12, coercions: 3, joins: 0/0} +-- RHS size: {terms: 10, types: 9, coercions: 0, joins: 0/0} f4 [InlPrag=NOUSERINLINE[2]] :: T4 Int -> Int [GblId, Arity=1, - Caf=NoCafRefs, - Str=m, + 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_s2jF [Occ=Once!] :: T4 Int) -> - case w_s2jF of { MkT4 ww1_s2jI [Occ=Once] ww2_s2jN [Occ=Once!] -> - case ww1_s2jI `cast` (Foo.D:R:FooInt0[0] ; Foo.N:R:FooInt[0] :: (Foo Int :: *) ~R# (Int :: *)) of - { GHC.Types.I# ww4_s2jL [Occ=Once] -> - case ww2_s2jN of { GHC.Types.I# ww6_s2jQ [Occ=Once] -> - case Foo.$wf4 ww4_s2jL ww6_s2jQ of ww7_s2jV { __DEFAULT -> GHC.Types.I# ww7_s2jV } - } - } + Tmpl= \ (w_s1t9 [Occ=Once!] :: T4 Int) -> + case w_s1t9 of { MkT4 ww1_s1tc [Occ=Once] ww2_s1td [Occ=Once!] -> + case ww2_s1td of { GHC.Types.I# ww4_s1tg [Occ=Once] -> Foo.$wf4 ww1_s1tc ww4_s1tg } }}] f4 - = \ (w_s2jF :: T4 Int) -> - case w_s2jF of { MkT4 ww1_s2jI ww2_s2jN -> - case ww1_s2jI `cast` (Foo.D:R:FooInt0[0] ; Foo.N:R:FooInt[0] :: (Foo Int :: *) ~R# (Int :: *)) of { GHC.Types.I# ww4_s2mW -> - case ww2_s2jN of { GHC.Types.I# ww6_s2jQ -> case Foo.$wf4 ww4_s2mW ww6_s2jQ of ww7_s2jV { __DEFAULT -> GHC.Types.I# ww7_s2jV } } - } - } + = \ (w_s1t9 :: T4 Int) -> + case w_s1t9 of { MkT4 ww1_s1tc ww2_s1td -> case ww2_s1td of { GHC.Types.I# ww4_s1tg -> Foo.$wf4 ww1_s1tc ww4_s1tg } } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl_r1xj :: Int +[GblId, Cpr=m1, Unf=OtherCon []] +lvl_r1xj = GHC.Types.I# 1# Rec { -- RHS size: {terms: 21, types: 4, coercions: 0, joins: 0/0} -Foo.$wf2 [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.Int# -> GHC.Prim.Int# -[GblId, Arity=2, Caf=NoCafRefs, Str=, Unf=OtherCon []] +Foo.$wf2 [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker] :: Int -> GHC.Prim.Int# -> Int +[GblId, Arity=2, Str=, Unf=OtherCon []] Foo.$wf2 - = \ (ww_s2k3 :: GHC.Prim.Int#) (ww1_s2k8 :: GHC.Prim.Int#) -> - case GHC.Prim.># ww1_s2k8 0# of { + = \ (ww_s1tn + :: Int + Unf=OtherCon []) + (ww1_s1tr :: GHC.Prim.Int#) -> + case GHC.Prim.># ww1_s1tr 0# of { __DEFAULT -> - case GHC.Prim.># ww1_s2k8 1# of { - __DEFAULT -> ww_s2k3; - 1# -> 1# + case GHC.Prim.># ww1_s1tr 1# of { + __DEFAULT -> ww_s1tn; + 1# -> lvl_r1xj }; - 1# -> Foo.$wf2 ww_s2k3 (GHC.Prim.-# ww1_s2k8 1#) + 1# -> Foo.$wf2 ww_s1tn (GHC.Prim.-# ww1_s1tr 1#) } end Rec } --- RHS size: {terms: 17, types: 9, coercions: 0, joins: 0/0} +-- RHS size: {terms: 10, types: 6, coercions: 0, joins: 0/0} f2 [InlPrag=NOUSERINLINE[2]] :: T2 -> Int [GblId, Arity=1, - Caf=NoCafRefs, - Str=m, + 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_s2jX [Occ=Once!] :: T2) -> - case w_s2jX of { MkT2 ww1_s2k0 [Occ=Once!] ww2_s2k5 [Occ=Once!] -> - case ww1_s2k0 of { GHC.Types.I# ww4_s2k3 [Occ=Once] -> - case ww2_s2k5 of { GHC.Types.I# ww6_s2k8 [Occ=Once] -> - case Foo.$wf2 ww4_s2k3 ww6_s2k8 of ww7_s2kd { __DEFAULT -> GHC.Types.I# ww7_s2kd } - } - } + Tmpl= \ (w_s1tk [Occ=Once!] :: T2) -> + case w_s1tk of { MkT2 ww1_s1tn [Occ=Once] ww2_s1to [Occ=Once!] -> + case ww2_s1to of { GHC.Types.I# ww4_s1tr [Occ=Once] -> Foo.$wf2 ww1_s1tn ww4_s1tr } }}] f2 - = \ (w_s2jX :: T2) -> - case w_s2jX of { MkT2 ww1_s2k0 ww2_s2k5 -> - case ww1_s2k0 of { GHC.Types.I# ww4_s2mZ -> - case ww2_s2k5 of { GHC.Types.I# ww6_s2k8 -> case Foo.$wf2 ww4_s2mZ ww6_s2k8 of ww7_s2kd { __DEFAULT -> GHC.Types.I# ww7_s2kd } } - } - } + = \ (w_s1tk :: T2) -> + case w_s1tk of { MkT2 ww1_s1tn ww2_s1to -> case ww2_s1to of { GHC.Types.I# ww4_s1tr -> Foo.$wf2 ww1_s1tn ww4_s1tr } } Rec { -- RHS size: {terms: 15, types: 4, coercions: 0, joins: 0/0} Foo.$wh [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.Int# -> Bool -[GblId, Arity=2, Caf=NoCafRefs, Str=, Unf=OtherCon []] +[GblId, Arity=2, Str=, Unf=OtherCon []] Foo.$wh - = \ (ww_s2kj :: GHC.Prim.Int#) (ww1_s2kn :: GHC.Prim.Int#) -> - case ww_s2kj of ds_X2gt { - __DEFAULT -> Foo.$wh (GHC.Prim.-# ds_X2gt 1#) ww1_s2kn; - 0# -> GHC.Prim.tagToEnum# @ Bool (GHC.Prim.># ww1_s2kn 0#) + = \ (ww_s1tz :: GHC.Prim.Int#) (ww1_s1tD :: GHC.Prim.Int#) -> + case ww_s1tz of ds_X2 { + __DEFAULT -> Foo.$wh (GHC.Prim.-# ds_X2 1#) ww1_s1tD; + 0# -> GHC.Prim.tagToEnum# @Bool (GHC.Prim.># ww1_s1tD 0#) } end Rec } @@ -409,26 +368,25 @@ end Rec } h [InlPrag=NOUSERINLINE[2]] :: Int -> Int -> Bool [GblId, Arity=2, - Caf=NoCafRefs, - Str=, + Str=, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) - Tmpl= \ (w_s2kf [Occ=Once!] :: Int) (w1_s2kg [Occ=Once!] :: Int) -> - case w_s2kf of { GHC.Types.I# ww1_s2kj [Occ=Once] -> - case w1_s2kg of { GHC.Types.I# ww3_s2kn [Occ=Once] -> Foo.$wh ww1_s2kj ww3_s2kn } + Tmpl= \ (w_s1tv [Occ=Once!] :: Int) (w1_s1tw [Occ=Once!] :: Int) -> + case w_s1tv of { GHC.Types.I# ww1_s1tz [Occ=Once] -> + case w1_s1tw of { GHC.Types.I# ww3_s1tD [Occ=Once] -> Foo.$wh ww1_s1tz ww3_s1tD } }}] -h = \ (w_s2kf :: Int) (w1_s2kg :: Int) -> - case w_s2kf of { GHC.Types.I# ww1_s2kj -> case w1_s2kg of { GHC.Types.I# ww3_s2kn -> Foo.$wh ww1_s2kj ww3_s2kn } } +h = \ (w_s1tv :: Int) (w1_s1tw :: Int) -> + case w_s1tv of { GHC.Types.I# ww1_s1tz -> case w1_s1tw of { GHC.Types.I# ww3_s1tD -> Foo.$wh ww1_s1tz ww3_s1tD } } Rec { -- RHS size: {terms: 12, types: 2, coercions: 0, joins: 0/0} Foo.$wf1 [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.Int# -[GblId, Arity=1, Caf=NoCafRefs, Str=, Unf=OtherCon []] +[GblId, Arity=1, Str=, Unf=OtherCon []] Foo.$wf1 - = \ (ww_s2kt :: GHC.Prim.Int#) -> - case Foo.$wh ww_s2kt ww_s2kt of { - False -> Foo.$wf1 (GHC.Prim.-# ww_s2kt 1#); - True -> ww_s2kt + = \ (ww_s1tJ :: GHC.Prim.Int#) -> + case Foo.$wh ww_s1tJ ww_s1tJ of { + False -> Foo.$wf1 (GHC.Prim.-# ww_s1tJ 1#); + True -> ww_s1tJ } end Rec } @@ -436,25 +394,27 @@ end Rec } f1 [InlPrag=NOUSERINLINE[2]] :: Int -> Int [GblId, Arity=1, - Caf=NoCafRefs, - Str=m, + Str=, + Cpr=m1, 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_s2kq [Occ=Once!] :: Int) -> - case w_s2kq of { GHC.Types.I# ww1_s2kt [Occ=Once] -> case Foo.$wf1 ww1_s2kt of ww2_s2kx { __DEFAULT -> GHC.Types.I# ww2_s2kx } }}] + Tmpl= \ (w_s1tG [Occ=Once!] :: Int) -> + case w_s1tG of { GHC.Types.I# ww1_s1tJ [Occ=Once] -> + case Foo.$wf1 ww1_s1tJ of ww2_s1tN [Occ=Once] { __DEFAULT -> GHC.Types.I# ww2_s1tN } + }}] f1 - = \ (w_s2kq :: Int) -> - case w_s2kq of { GHC.Types.I# ww1_s2kt -> case Foo.$wf1 ww1_s2kt of ww2_s2kx { __DEFAULT -> GHC.Types.I# ww2_s2kx } } + = \ (w_s1tG :: Int) -> + case w_s1tG of { GHC.Types.I# ww1_s1tJ -> case Foo.$wf1 ww1_s1tJ of ww2_s1tN { __DEFAULT -> GHC.Types.I# ww2_s1tN } } Rec { -- RHS size: {terms: 14, types: 3, coercions: 0, joins: 0/0} Foo.$wf3 [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.Int# -> GHC.Prim.Int# -[GblId, Arity=2, Caf=NoCafRefs, Str=, Unf=OtherCon []] +[GblId, Arity=2, Str=, Unf=OtherCon []] Foo.$wf3 - = \ (ww_s2kF :: GHC.Prim.Int#) (ww1_s2kK :: GHC.Prim.Int#) -> - case Foo.$wh ww_s2kF ww1_s2kK of { - False -> ww_s2kF; - True -> Foo.$wf3 ww_s2kF (GHC.Prim.-# ww1_s2kK 1#) + = \ (ww_s1tV :: GHC.Prim.Int#) (ww1_s1u0 :: GHC.Prim.Int#) -> + case Foo.$wh ww_s1tV ww1_s1u0 of { + False -> ww_s1tV; + True -> Foo.$wf3 ww_s1tV (GHC.Prim.-# ww1_s1u0 1#) } end Rec } @@ -462,23 +422,23 @@ end Rec } f3 [InlPrag=NOUSERINLINE[2]] :: T3 -> Int [GblId, Arity=1, - Caf=NoCafRefs, - Str=m, + Str=, + Cpr=m1, 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_s2kz [Occ=Once!] :: T3) -> - case w_s2kz of { MkT3 ww1_s2kC [Occ=Once!] ww2_s2kH [Occ=Once!] -> - case ww1_s2kC of { GHC.Types.I# ww4_s2kF [Occ=Once] -> - case ww2_s2kH of { GHC.Types.I# ww6_s2kK [Occ=Once] -> - case Foo.$wf3 ww4_s2kF ww6_s2kK of ww7_s2kP { __DEFAULT -> GHC.Types.I# ww7_s2kP } + Tmpl= \ (w_s1tP [Occ=Once!] :: T3) -> + case w_s1tP of { MkT3 ww1_s1tS [Occ=Once!] ww2_s1tX [Occ=Once!] -> + case ww1_s1tS of { GHC.Types.I# ww4_s1tV [Occ=Once] -> + case ww2_s1tX of { GHC.Types.I# ww6_s1u0 [Occ=Once] -> + case Foo.$wf3 ww4_s1tV ww6_s1u0 of ww7_s1u5 [Occ=Once] { __DEFAULT -> GHC.Types.I# ww7_s1u5 } } } }}] f3 - = \ (w_s2kz :: T3) -> - case w_s2kz of { MkT3 ww1_s2kC ww2_s2kH -> - case ww1_s2kC of { GHC.Types.I# ww4_s2kF -> - case ww2_s2kH of { GHC.Types.I# ww6_s2kK -> case Foo.$wf3 ww4_s2kF ww6_s2kK of ww7_s2kP { __DEFAULT -> GHC.Types.I# ww7_s2kP } } + = \ (w_s1tP :: T3) -> + case w_s1tP of { MkT3 ww1_s1tS ww2_s1tX -> + case ww1_s1tS of { GHC.Types.I# ww4_s1tV -> + case ww2_s1tX of { GHC.Types.I# ww6_s1u0 -> case Foo.$wf3 ww4_s1tV ww6_s1u0 of ww7_s1u5 { __DEFAULT -> GHC.Types.I# ww7_s1u5 } } } } ===================================== testsuite/tests/stranal/sigs/DmdAnalGADTs.stderr ===================================== @@ -9,7 +9,7 @@ DmdAnalGADTs.f: DmdAnalGADTs.f': DmdAnalGADTs.g: DmdAnalGADTs.hasCPR: -DmdAnalGADTs.hasStrSig: +DmdAnalGADTs.hasStrSig: @@ -23,7 +23,7 @@ DmdAnalGADTs.f: DmdAnalGADTs.f': m1 DmdAnalGADTs.g: DmdAnalGADTs.hasCPR: m1 -DmdAnalGADTs.hasStrSig: m1 +DmdAnalGADTs.hasStrSig: @@ -37,6 +37,6 @@ DmdAnalGADTs.f: DmdAnalGADTs.f': DmdAnalGADTs.g: DmdAnalGADTs.hasCPR: -DmdAnalGADTs.hasStrSig: +DmdAnalGADTs.hasStrSig: ===================================== testsuite/tests/stranal/sigs/T17932.hs ===================================== @@ -0,0 +1,11 @@ +-- See commentary in #17932 + +module T17932 where + +flags (Options f x) + = reverse (reverse (reverse (reverse (reverse (reverse (reverse (reverse x))))))) + `seq` f + +data X = X String Bool Bool Bool Bool + +data Options = Options !X [Int] ===================================== testsuite/tests/stranal/sigs/T17932.stderr ===================================== @@ -0,0 +1,30 @@ + +==================== Strictness signatures ==================== +T17932.$tc'Options: +T17932.$tc'X: +T17932.$tcOptions: +T17932.$tcX: +T17932.$trModule: +T17932.flags: + + + +==================== Cpr signatures ==================== +T17932.$tc'Options: m1 +T17932.$tc'X: m1 +T17932.$tcOptions: m1 +T17932.$tcX: m1 +T17932.$trModule: m1 +T17932.flags: + + + +==================== Strictness signatures ==================== +T17932.$tc'Options: +T17932.$tc'X: +T17932.$tcOptions: +T17932.$tcX: +T17932.$trModule: +T17932.flags: + + ===================================== testsuite/tests/stranal/sigs/UnsatFun.stderr ===================================== @@ -5,8 +5,8 @@ UnsatFun.f: b UnsatFun.g: b UnsatFun.g': UnsatFun.g3: -UnsatFun.h: -UnsatFun.h2: +UnsatFun.h: +UnsatFun.h2: UnsatFun.h3: @@ -29,8 +29,8 @@ UnsatFun.f: b UnsatFun.g: b UnsatFun.g': UnsatFun.g3: -UnsatFun.h: -UnsatFun.h2: +UnsatFun.h: +UnsatFun.h2: UnsatFun.h3: ===================================== testsuite/tests/stranal/sigs/all.T ===================================== @@ -19,3 +19,4 @@ test('T12370', normal, compile, ['']) test('CaseBinderCPR', normal, compile, ['']) test('NewtypeArity', normal, compile, ['']) test('T5075', normal, compile, ['']) +test('T17932', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/524a210977e7cc33ab40440ac7229b63e0f9af8d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/524a210977e7cc33ab40440ac7229b63e0f9af8d You're receiving 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 Mar 23 18:56:15 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 23 Mar 2020 14:56:15 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T17950 Message-ID: <5e79064f18efd_61673f8198ee100c15864e@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/T17950 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T17950 You're receiving 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 Mar 23 20:52:09 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 23 Mar 2020 16:52:09 -0400 Subject: [Git][ghc/ghc][ghc-8.8] Note platform-specific Foreign.C.Types in context Message-ID: <5e792179e68bf_61677b155d8201388@gitlab.haskell.org.mail> Ben Gamari pushed to branch ghc-8.8 at Glasgow Haskell Compiler / GHC Commits: 4299f090 by Viktor Dukhovni at 2020-03-17T09:02:24-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. - - - - - 1 changed file: - libraries/base/Foreign/C/Types.hs Changes: ===================================== libraries/base/Foreign/C/Types.hs ===================================== @@ -27,11 +27,11 @@ module Foreign.C.Types ( -- * Representations of C types -- $ctypes - -- ** Platform differences + -- ** #platform# Platform differences -- | This module contains platform specific information about types. - -- __/As such the types presented on this page reflect the platform - -- on which the documentation was generated and may not coincide with - -- the types on your platform./__ + -- __/As such, the types presented on this page reflect the/__ + -- __/platform on which the documentation was generated and may/__ + -- __/not coincide with the types on your platform./__ -- ** Integral types -- | These types are represented as @newtype at s of @@ -105,33 +105,45 @@ import GHC.Num #include "CTypes.h" -- | Haskell type representing the C @char@ type. +-- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/ INTEGRAL_TYPE(CChar,HTYPE_CHAR) -- | Haskell type representing the C @signed char@ type. +-- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/ INTEGRAL_TYPE(CSChar,HTYPE_SIGNED_CHAR) -- | Haskell type representing the C @unsigned char@ type. +-- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/ INTEGRAL_TYPE(CUChar,HTYPE_UNSIGNED_CHAR) -- | Haskell type representing the C @short@ type. +-- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/ INTEGRAL_TYPE(CShort,HTYPE_SHORT) -- | Haskell type representing the C @unsigned short@ type. +-- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/ INTEGRAL_TYPE(CUShort,HTYPE_UNSIGNED_SHORT) -- | Haskell type representing the C @int@ type. +-- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/ INTEGRAL_TYPE(CInt,HTYPE_INT) -- | Haskell type representing the C @unsigned int@ type. +-- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/ INTEGRAL_TYPE(CUInt,HTYPE_UNSIGNED_INT) -- | Haskell type representing the C @long@ type. +-- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/ INTEGRAL_TYPE(CLong,HTYPE_LONG) -- | Haskell type representing the C @unsigned long@ type. +-- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/ INTEGRAL_TYPE(CULong,HTYPE_UNSIGNED_LONG) -- | Haskell type representing the C @long long@ type. +-- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/ INTEGRAL_TYPE(CLLong,HTYPE_LONG_LONG) -- | Haskell type representing the C @unsigned long long@ type. +-- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/ INTEGRAL_TYPE(CULLong,HTYPE_UNSIGNED_LONG_LONG) -- | Haskell type representing the C @bool@ type. +-- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/ -- -- @since 4.10.0.0 INTEGRAL_TYPE_WITH_CTYPE(CBool,bool,HTYPE_BOOL) @@ -164,8 +176,10 @@ INTEGRAL_TYPE_WITH_CTYPE(CBool,bool,HTYPE_BOOL) #-} -- | Haskell type representing the C @float@ type. +-- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/ FLOATING_TYPE(CFloat,HTYPE_FLOAT) -- | Haskell type representing the C @double@ type. +-- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/ FLOATING_TYPE(CDouble,HTYPE_DOUBLE) -- XXX GHC doesn't support CLDouble yet @@ -182,12 +196,16 @@ FLOATING_TYPE(CDouble,HTYPE_DOUBLE) -- "realToFrac/CLDouble->a" realToFrac = \(CLDouble x) -> realToFrac x -- | Haskell type representing the C @ptrdiff_t@ type. +-- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/ INTEGRAL_TYPE(CPtrdiff,HTYPE_PTRDIFF_T) -- | Haskell type representing the C @size_t@ type. +-- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/ INTEGRAL_TYPE(CSize,HTYPE_SIZE_T) -- | Haskell type representing the C @wchar_t@ type. +-- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/ INTEGRAL_TYPE(CWchar,HTYPE_WCHAR_T) -- | Haskell type representing the C @sig_atomic_t@ type. +-- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/ INTEGRAL_TYPE(CSigAtomic,HTYPE_SIG_ATOMIC_T) {-# RULES @@ -203,25 +221,32 @@ INTEGRAL_TYPE(CSigAtomic,HTYPE_SIG_ATOMIC_T) #-} -- | Haskell type representing the C @clock_t@ type. +-- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/ ARITHMETIC_TYPE(CClock,HTYPE_CLOCK_T) -- | Haskell type representing the C @time_t@ type. +-- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/ ARITHMETIC_TYPE(CTime,HTYPE_TIME_T) -- | Haskell type representing the C @useconds_t@ type. +-- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/ -- -- @since 4.4.0.0 ARITHMETIC_TYPE(CUSeconds,HTYPE_USECONDS_T) -- | Haskell type representing the C @suseconds_t@ type. +-- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/ -- -- @since 4.4.0.0 ARITHMETIC_TYPE(CSUSeconds,HTYPE_SUSECONDS_T) -- FIXME: Implement and provide instances for Eq and Storable -- | Haskell type representing the C @FILE@ type. +-- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/ data CFile = CFile -- | Haskell type representing the C @fpos_t@ type. +-- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/ data CFpos = CFpos -- | Haskell type representing the C @jmp_buf@ type. +-- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/ data CJmpBuf = CJmpBuf INTEGRAL_TYPE(CIntPtr,HTYPE_INTPTR_T) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4299f090f6b376f44674224495838a9e2b7ce858 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4299f090f6b376f44674224495838a9e2b7ce858 You're receiving 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 Mar 24 04:20:46 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 24 Mar 2020 00:20:46 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 13 commits: fs.h: Add missing declarations on Windows Message-ID: <5e798a9e3ffb_616713339fc425136c@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 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. - - - - - cc480cdc by Paavo at 2020-03-24T00:20:39-04:00 Add example and doc for Arg (Fixes #17153) - - - - - 23 changed files: - .gitlab-ci.yml - compiler/GHC/Hs/Expr.hs - compiler/GHC/Rename/Expr.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Builders/RunTest.hs - libraries/base/Data/Foldable.hs - libraries/base/Data/Semigroup.hs - libraries/process - testsuite/tests/ado/T13242a.stderr - + testsuite/tests/ado/T17835.hs - testsuite/tests/ado/ado001.stdout - testsuite/tests/ado/all.T - testsuite/tests/driver/T12062/Makefile - + testsuite/tests/driver/T365.stderr-mingw32 - testsuite/tests/ghc-api/annotations/all.T - + testsuite/tests/ghc-api/annotations/annotations.stdout-mingw32 - + testsuite/tests/ghc-api/annotations/listcomps.stdout-mingw32 - + testsuite/tests/ghc-api/annotations/parseTree.stdout-mingw32 - testsuite/tests/ghci/scripts/T9293.stdout-mingw32 - testsuite/tests/ghci/scripts/ghci024.stdout-mingw32 - testsuite/tests/ghci/scripts/ghci057.stdout-mingw32 - utils/fs/fs.h - utils/hsc2hs Changes: ===================================== .gitlab-ci.yml ===================================== @@ -806,9 +806,6 @@ validate-x86_64-linux-fedora27: # which might result in some broken perf tests? HADRIAN_ARGS: "--docs=no-sphinx --skip-perf" - # due to #16574 this currently fails - allow_failure: true - script: - bash .gitlab/ci.sh configure - bash .gitlab/ci.sh build_hadrian ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -2274,22 +2274,31 @@ pprStmt (ApplicativeStmt _ args mb_join) (if lengthAtLeast args 2 then parens else id) ap_expr pp_arg :: (a, ApplicativeArg (GhcPass idL)) -> SDoc - pp_arg (_, ApplicativeArgOne _ pat expr isBody _) - | isBody = -- See Note [Applicative BodyStmt] - ppr (BodyStmt (panic "pprStmt") expr noSyntaxExpr noSyntaxExpr + pp_arg (_, applicativeArg) = ppr applicativeArg + +pprStmt (XStmtLR x) = ppr x + + +instance (OutputableBndrId idL) + => Outputable (ApplicativeArg (GhcPass idL)) where + ppr = pprArg + +pprArg :: forall idL . (OutputableBndrId idL) => ApplicativeArg (GhcPass idL) -> SDoc +pprArg (ApplicativeArgOne _ pat expr isBody _) + | isBody = -- See Note [Applicative BodyStmt] + ppr (BodyStmt (panic "pprStmt") expr noSyntaxExpr noSyntaxExpr :: ExprStmt (GhcPass idL)) - | otherwise = - ppr (BindStmt (panic "pprStmt") pat expr noSyntaxExpr noSyntaxExpr + | otherwise = + ppr (BindStmt (panic "pprStmt") pat expr noSyntaxExpr noSyntaxExpr :: ExprStmt (GhcPass idL)) - pp_arg (_, ApplicativeArgMany _ stmts return pat) = +pprArg (ApplicativeArgMany _ stmts return pat) = ppr pat <+> text "<-" <+> ppr (HsDo (panic "pprStmt") DoExpr (noLoc (stmts ++ [noLoc (LastStmt noExtField (noLoc return) Nothing noSyntaxExpr)]))) - pp_arg (_, XApplicativeArg x) = ppr x -pprStmt (XStmtLR x) = ppr x +pprArg (XApplicativeArg x) = ppr x pprTransformStmt :: (OutputableBndrId p) => [IdP (GhcPass p)] -> LHsExpr (GhcPass p) ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -1498,7 +1498,7 @@ ApplicativeDo touches a few phases in the compiler: scheduled as outlined above and transformed into applicative combinators. However, the code is still represented as a do-block with special forms of applicative statements. This allows us to - recover the original do-block when e.g. printing type errors, where + recover the original do-block when e.g. printing type errors, where we don't want to show any of the applicative combinators since they don't exist in the source code. See ApplicativeStmt and ApplicativeArg in HsExpr. @@ -1682,7 +1682,7 @@ stmtTreeToStmts monad_names ctxt (StmtTreeOne (L _ (BindStmt _ pat rhs _ fail_op , is_body_stmt = False , fail_operator = fail_op}] False tail' -stmtTreeToStmts monad_names ctxt (StmtTreeOne (L _ (BodyStmt _ rhs _ fail_op),_)) +stmtTreeToStmts monad_names ctxt (StmtTreeOne (L _ (BodyStmt _ rhs _ _),_)) tail _tail_fvs | (False,tail') <- needJoin monad_names tail = mkApplicativeStmt ctxt @@ -1691,7 +1691,7 @@ stmtTreeToStmts monad_names ctxt (StmtTreeOne (L _ (BodyStmt _ rhs _ fail_op),_) , app_arg_pattern = nlWildPatName , arg_expr = rhs , is_body_stmt = True - , fail_operator = fail_op}] False tail' + , fail_operator = noSyntaxExpr}] False tail' stmtTreeToStmts _monad_names _ctxt (StmtTreeOne (s,_)) tail _tail_fvs = return (s : tail, emptyNameSet) @@ -1706,7 +1706,8 @@ stmtTreeToStmts monad_names ctxt (StmtTreeApplicative trees) tail tail_fvs = do pairs <- mapM (stmtTreeArg ctxt tail_fvs) trees let (stmts', fvss) = unzip pairs let (need_join, tail') = - if any hasStrictPattern trees + -- See Note [ApplicativeDo and refutable patterns] + if any hasRefutablePattern stmts' then (True, tail) else needJoin monad_names tail @@ -1721,13 +1722,13 @@ stmtTreeToStmts monad_names ctxt (StmtTreeApplicative trees) tail tail_fvs = do , is_body_stmt = False , fail_operator = fail_op }, emptyFVs) - stmtTreeArg _ctxt _tail_fvs (StmtTreeOne (L _ (BodyStmt _ exp _ fail_op), _)) = + stmtTreeArg _ctxt _tail_fvs (StmtTreeOne (L _ (BodyStmt _ exp _ _), _)) = return (ApplicativeArgOne { xarg_app_arg_one = noExtField , app_arg_pattern = nlWildPatName , arg_expr = exp , is_body_stmt = True - , fail_operator = fail_op + , fail_operator = noSyntaxExpr }, emptyFVs) stmtTreeArg ctxt tail_fvs tree = do let stmts = flattenStmtTree tree @@ -1854,12 +1855,19 @@ isStrictPattern lpat = SplicePat{} -> True _otherwise -> panic "isStrictPattern" -hasStrictPattern :: ExprStmtTree -> Bool -hasStrictPattern (StmtTreeOne (L _ (BindStmt _ pat _ _ _), _)) = isStrictPattern pat -hasStrictPattern (StmtTreeOne _) = False -hasStrictPattern (StmtTreeBind a b) = hasStrictPattern a || hasStrictPattern b -hasStrictPattern (StmtTreeApplicative trees) = any hasStrictPattern trees +{- +Note [ApplicativeDo and refutable patterns] + +Refutable patterns in do blocks are desugared to use the monadic 'fail' operation. +This means that sometimes an applicative block needs to be wrapped in 'join' simply because +of a refutable pattern, in order for the types to work out. + +-} +hasRefutablePattern :: ApplicativeArg GhcRn -> Bool +hasRefutablePattern (ApplicativeArgOne { app_arg_pattern = pat + , is_body_stmt = False}) = not (isIrrefutableHsPat pat) +hasRefutablePattern _ = False isLetStmt :: LStmt a b -> Bool isLetStmt (L _ LetStmt{}) = True ===================================== hadrian/src/Rules/Test.hs ===================================== @@ -48,7 +48,7 @@ testRules = do -- Using program shipped with testsuite to generate ghcconfig file. root -/- ghcConfigProgPath %> \_ -> do - ghc0Path <- (<.> exe) <$> getCompilerPath "stage0" + ghc0Path <- getCompilerPath "stage0" -- Invoke via bash to work around #17362. -- Reasons why this is required are not entirely clear. cmd ["bash"] ["-c", ghc0Path ++ " " ++ ghcConfigHsPath ++ " -o " ++ (root -/- ghcConfigProgPath)] ===================================== hadrian/src/Settings/Builders/RunTest.hs ===================================== @@ -106,7 +106,7 @@ runTestBuilderArgs = builder RunTest ? do , arg "-e", arg $ "config.accept=" ++ show accept , arg "-e", arg $ "config.accept_platform=" ++ show acceptPlatform , arg "-e", arg $ "config.accept_os=" ++ show acceptOS - , arg "-e", arg $ "config.exeext=" ++ quote exe + , arg "-e", arg $ "config.exeext=" ++ quote (if null exe then "" else "."<>exe) , arg "-e", arg $ "config.compiler_debugged=" ++ show debugged , arg "-e", arg $ asBool "ghc_with_native_codegen=" withNativeCodeGen ===================================== libraries/base/Data/Foldable.hs ===================================== @@ -215,6 +215,8 @@ class Foldable t where -- | A variant of 'foldr' that has no base case, -- and thus may only be applied to non-empty structures. -- + -- ⚠️ This function is non-total and will raise a runtime exception if the structure happens to be empty. + -- -- @'foldr1' f = 'List.foldr1' f . 'toList'@ foldr1 :: (a -> a -> a) -> t a -> a foldr1 f xs = fromMaybe (errorWithoutStackTrace "foldr1: empty structure") @@ -227,6 +229,8 @@ class Foldable t where -- | A variant of 'foldl' that has no base case, -- and thus may only be applied to non-empty structures. -- + -- ⚠️ This function is non-total and will raise a runtime exception if the structure happens to be empty. + -- -- @'foldl1' f = 'List.foldl1' f . 'toList'@ foldl1 :: (a -> a -> a) -> t a -> a foldl1 f xs = fromMaybe (errorWithoutStackTrace "foldl1: empty structure") @@ -267,6 +271,14 @@ class Foldable t where -- | The largest element of a non-empty structure. -- + -- ⚠️ This function is non-total and will raise a runtime exception if the structure happens to be empty. + -- + -- === __Examples__ + -- >>> maximum [1..10] + -- 10 + -- >>> maximum [] + -- *** Exception: Prelude.maximum: empty list + -- -- @since 4.8.0.0 maximum :: forall a . Ord a => t a -> a maximum = fromMaybe (errorWithoutStackTrace "maximum: empty structure") . @@ -274,6 +286,14 @@ class Foldable t where -- | The least element of a non-empty structure. -- + -- ⚠️ This function is non-total and will raise a runtime exception if the structure happens to be empty + -- + -- === __Examples__ + -- >>> minimum [1..10] + -- 1 + -- >>> minimum [] + -- *** Exception: Prelude.minimum: empty list + -- -- @since 4.8.0.0 minimum :: forall a . Ord a => t a -> a minimum = fromMaybe (errorWithoutStackTrace "minimum: empty structure") . ===================================== libraries/base/Data/Semigroup.hs ===================================== @@ -286,7 +286,15 @@ instance Num a => Num (Max a) where -- | 'Arg' isn't itself a 'Semigroup' in its own right, but it can be -- placed inside 'Min' and 'Max' to compute an arg min or arg max. -data Arg a b = Arg a b deriving +-- +-- >>> minimum [ Arg (x * x) x | x <- [-10 .. 10] ] +-- Arg 0 0 +data Arg a b = Arg + a + -- ^ The argument used for comparisons in 'Eq' and 'Ord'. + b + -- ^ The "value" exposed via the 'Functor', 'Foldable' etc. instances. + deriving ( Show -- ^ @since 4.9.0.0 , Read -- ^ @since 4.9.0.0 , Data -- ^ @since 4.9.0.0 ===================================== libraries/process ===================================== @@ -1 +1 @@ -Subproject commit 26ea79ceb2193a86f76a302a126be3319f22700d +Subproject commit 8fffea5ca319e85e1bc9e7cac39e5a2c8effefcc ===================================== testsuite/tests/ado/T13242a.stderr ===================================== @@ -32,10 +32,15 @@ T13242a.hs:13:11: error: ...plus 21 others ...plus six instances involving out-of-scope types (use -fprint-potential-instances to see them all) - • In the first argument of ‘return’, namely ‘(x == x)’ In a stmt of a 'do' block: return (x == x) In the expression: do A x <- undefined _ <- return 'a' _ <- return 'b' return (x == x) + In an equation for ‘test’: + test + = do A x <- undefined + _ <- return 'a' + _ <- return 'b' + return (x == x) ===================================== testsuite/tests/ado/T17835.hs ===================================== @@ -0,0 +1,38 @@ +-- Build.hs +{-# LANGUAGE ApplicativeDo #-} +module Build (configRules) where + +type Action = IO +type Rules = IO + +type Config = () + +(%>) :: String -> (String -> Action ()) -> Rules () +(%>) = undefined + +command_ :: [String] -> String -> [String] -> Action () +command_ = undefined + +recursive :: Config -> String -> [String] -> IO (FilePath, [String]) +recursive = undefined + +liftIO :: IO a -> Action a +liftIO = id + +need :: [String] -> Action () +need = undefined + +historyDisable :: Action () +historyDisable = undefined + +get_config :: () -> Action Config +get_config = undefined + +configRules :: Rules () +configRules = do + "snapshot" %> \out -> do + historyDisable -- 8.10-rc1 refuses to compile without bind here + config <- get_config () + need [] + (exe,args) <- liftIO $ recursive config "snapshot" [] + command_ [] exe args ===================================== testsuite/tests/ado/ado001.stdout ===================================== @@ -9,4 +9,4 @@ a; ((b | c) | d) ((a | (b; c)) | d) | e ((a | b); (c | d)) | e a | b -(a | (b; c)) +a | (b; c) ===================================== testsuite/tests/ado/all.T ===================================== @@ -17,3 +17,4 @@ test('T13875', normal, compile_and_run, ['']) test('T14163', normal, compile_and_run, ['']) test('T15344', normal, compile_and_run, ['']) test('T16628', normal, compile_fail, ['']) +test('T17835', normal, compile, ['']) ===================================== testsuite/tests/driver/T12062/Makefile ===================================== @@ -1,3 +1,3 @@ -TOP=../../../.. +TOP=../../.. include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/test.mk ===================================== testsuite/tests/driver/T365.stderr-mingw32 ===================================== @@ -0,0 +1 @@ +./test_preprocessor.txt: builderMainLoop: invalid argument (Exec format error) ===================================== testsuite/tests/ghc-api/annotations/all.T ===================================== @@ -1,12 +1,15 @@ test('annotations', [extra_files(['AnnotationLet.hs']), + normalise_slashes, ignore_stderr], makefile_test, ['annotations']) test('parseTree', [extra_files(['AnnotationTuple.hs']), + normalise_slashes, ignore_stderr], makefile_test, ['parseTree']) test('comments', [extra_files(['CommentsTest.hs']), ignore_stderr], makefile_test, ['comments']) test('exampleTest', [extra_files(['AnnotationTuple.hs']), ignore_stderr], makefile_test, ['exampleTest']) test('listcomps', [extra_files(['ListComprehensions.hs']), + normalise_slashes, ignore_stderr], makefile_test, ['listcomps']) test('T10255', [extra_files(['Test10255.hs']), ignore_stderr], makefile_test, ['T10255']) ===================================== testsuite/tests/ghc-api/annotations/annotations.stdout-mingw32 ===================================== @@ -0,0 +1,86 @@ +[ +(AK AnnotationLet.hs:1:1 AnnCloseC = [AnnotationLet.hs:17:1]) + +(AK AnnotationLet.hs:1:1 AnnModule = [AnnotationLet.hs:2:1-6]) + +(AK AnnotationLet.hs:1:1 AnnOpenC = [AnnotationLet.hs:4:1]) + +(AK AnnotationLet.hs:1:1 AnnWhere = [AnnotationLet.hs:2:28-32]) + +(AK AnnotationLet.hs:2:22-26 AnnCloseP = [AnnotationLet.hs:2:26]) + +(AK AnnotationLet.hs:2:22-26 AnnOpenP = [AnnotationLet.hs:2:22]) + +(AK AnnotationLet.hs:5:1-32 AnnAs = [AnnotationLet.hs:5:28-29]) + +(AK AnnotationLet.hs:5:1-32 AnnImport = [AnnotationLet.hs:5:1-6]) + +(AK AnnotationLet.hs:5:1-32 AnnQualified = [AnnotationLet.hs:5:8-16]) + +(AK AnnotationLet.hs:5:1-32 AnnSemi = [AnnotationLet.hs:6:1]) + +(AK AnnotationLet.hs:(7,1)-(11,12) AnnEqual = [AnnotationLet.hs:7:5]) + +(AK AnnotationLet.hs:(7,1)-(11,12) AnnFunId = [AnnotationLet.hs:7:1-3]) + +(AK AnnotationLet.hs:(7,1)-(11,12) AnnSemi = [AnnotationLet.hs:12:1]) + +(AK AnnotationLet.hs:(7,7)-(11,12) AnnIn = [AnnotationLet.hs:11:7-8]) + +(AK AnnotationLet.hs:(7,7)-(11,12) AnnLet = [AnnotationLet.hs:7:7-9]) + +(AK AnnotationLet.hs:8:9-15 AnnEqual = [AnnotationLet.hs:8:13]) + +(AK AnnotationLet.hs:8:9-15 AnnFunId = [AnnotationLet.hs:8:9]) + +(AK AnnotationLet.hs:8:9-15 AnnSemi = [AnnotationLet.hs:9:9]) + +(AK AnnotationLet.hs:9:9-15 AnnEqual = [AnnotationLet.hs:9:13]) + +(AK AnnotationLet.hs:9:9-15 AnnFunId = [AnnotationLet.hs:9:9]) + +(AK AnnotationLet.hs:9:9-15 AnnSemi = [AnnotationLet.hs:10:9]) + +(AK AnnotationLet.hs:10:9-13 AnnEqual = [AnnotationLet.hs:10:11]) + +(AK AnnotationLet.hs:10:9-13 AnnFunId = [AnnotationLet.hs:10:9]) + +(AK AnnotationLet.hs:13:1-10 AnnInfix = [AnnotationLet.hs:13:1-6]) + +(AK AnnotationLet.hs:13:1-10 AnnSemi = [AnnotationLet.hs:14:1]) + +(AK AnnotationLet.hs:13:1-10 AnnVal = [AnnotationLet.hs:13:8]) + +(AK AnnotationLet.hs:15:1-40 AnnCloseP = [AnnotationLet.hs:15:14, AnnotationLet.hs:15:13]) + +(AK AnnotationLet.hs:15:1-40 AnnData = [AnnotationLet.hs:15:1-4]) + +(AK AnnotationLet.hs:15:1-40 AnnEqual = [AnnotationLet.hs:15:18]) + +(AK AnnotationLet.hs:15:1-40 AnnOpenP = [AnnotationLet.hs:15:6, AnnotationLet.hs:15:7]) + +(AK AnnotationLet.hs:15:1-40 AnnSemi = [AnnotationLet.hs:16:1]) + +(AK AnnotationLet.hs:15:6-14 AnnCloseP = [AnnotationLet.hs:15:14]) + +(AK AnnotationLet.hs:15:6-14 AnnOpenP = [AnnotationLet.hs:15:6]) + +(AK AnnotationLet.hs:15:7-13 AnnCloseP = [AnnotationLet.hs:15:13]) + +(AK AnnotationLet.hs:15:7-13 AnnOpenP = [AnnotationLet.hs:15:7]) + +(AK AnnotationLet.hs:15:20-28 AnnVbar = [AnnotationLet.hs:15:30]) + +(AK AnnotationLet.hs:15:24-28 AnnCloseP = [AnnotationLet.hs:15:28]) + +(AK AnnotationLet.hs:15:24-28 AnnOpenP = [AnnotationLet.hs:15:24]) + +(AK AnnotationLet.hs:15:36-40 AnnCloseP = [AnnotationLet.hs:15:40]) + +(AK AnnotationLet.hs:15:36-40 AnnOpenP = [AnnotationLet.hs:15:36]) +] + +[AnnotationLet.hs:2:1-6] +[] +AnnotationLet.hs:1:1 +EOF: Just SrcSpanPoint ".\\AnnotationLet.hs" 18 1 ===================================== testsuite/tests/ghc-api/annotations/listcomps.stdout-mingw32 ===================================== @@ -0,0 +1,160 @@ +{ListComprehensions.hs:1:1, ListComprehensions.hs:6:8-25, + ListComprehensions.hs:10:1-15, ListComprehensions.hs:10:8-15, + ListComprehensions.hs:11:1-30, ListComprehensions.hs:11:18-25, + ListComprehensions.hs:11:30, ListComprehensions.hs:12:1-27, + ListComprehensions.hs:12:8-15, ListComprehensions.hs:12:17-27, + ListComprehensions.hs:12:18-26, ListComprehensions.hs:13:1-25, + ListComprehensions.hs:13:8-16, ListComprehensions.hs:13:18-25, + ListComprehensions.hs:13:19-24, ListComprehensions.hs:17:1-16, + ListComprehensions.hs:17:1-25, ListComprehensions.hs:17:21-25, + ListComprehensions.hs:17:22-24, ListComprehensions.hs:18:1-16, + ListComprehensions.hs:(18,1)-(22,20), + ListComprehensions.hs:(18,18)-(22,20), + ListComprehensions.hs:(18,20)-(22,20), ListComprehensions.hs:18:22, + ListComprehensions.hs:18:22-26, ListComprehensions.hs:18:22-30, + ListComprehensions.hs:(18,22)-(21,34), ListComprehensions.hs:18:24, + ListComprehensions.hs:18:26, ListComprehensions.hs:18:28, + ListComprehensions.hs:18:30, ListComprehensions.hs:19:22, + ListComprehensions.hs:19:22-33, + ListComprehensions.hs:(19,22)-(21,34), + ListComprehensions.hs:19:27-33, ListComprehensions.hs:19:28, + ListComprehensions.hs:19:31-32, ListComprehensions.hs:20:22, + ListComprehensions.hs:20:22-34, ListComprehensions.hs:20:27-34, + ListComprehensions.hs:20:28-29, ListComprehensions.hs:20:32-33, + ListComprehensions.hs:21:22, ListComprehensions.hs:21:22-34, + ListComprehensions.hs:21:27-34, ListComprehensions.hs:21:28-29, + ListComprehensions.hs:21:32-33, ListComprehensions.hs:24:1-6, + ListComprehensions.hs:24:1-27, ListComprehensions.hs:24:11-15, + ListComprehensions.hs:24:11-27, ListComprehensions.hs:24:12-14, + ListComprehensions.hs:24:20-27, ListComprehensions.hs:24:21-26, + ListComprehensions.hs:25:1-6, ListComprehensions.hs:(25,1)-(28,14), + ListComprehensions.hs:25:8-10, + ListComprehensions.hs:(25,12)-(28,14), + ListComprehensions.hs:(25,14)-(28,14), + ListComprehensions.hs:25:16-20, + ListComprehensions.hs:(25,16)-(27,22), ListComprehensions.hs:26:16, + ListComprehensions.hs:26:16-23, + ListComprehensions.hs:(26,16)-(27,22), + ListComprehensions.hs:26:21-23, ListComprehensions.hs:27:21-22} +-------------------------------- +[ +(AK ListComprehensions.hs:1:1 AnnModule = [ListComprehensions.hs:6:1-6]) + +(AK ListComprehensions.hs:1:1 AnnWhere = [ListComprehensions.hs:6:27-31]) + +(AK ListComprehensions.hs:10:1-15 AnnImport = [ListComprehensions.hs:10:1-6]) + +(AK ListComprehensions.hs:10:1-15 AnnSemi = [ListComprehensions.hs:11:1]) + +(AK ListComprehensions.hs:11:1-30 AnnAs = [ListComprehensions.hs:11:27-28]) + +(AK ListComprehensions.hs:11:1-30 AnnImport = [ListComprehensions.hs:11:1-6]) + +(AK ListComprehensions.hs:11:1-30 AnnQualified = [ListComprehensions.hs:11:8-16]) + +(AK ListComprehensions.hs:11:1-30 AnnSemi = [ListComprehensions.hs:12:1]) + +(AK ListComprehensions.hs:12:1-27 AnnImport = [ListComprehensions.hs:12:1-6]) + +(AK ListComprehensions.hs:12:1-27 AnnSemi = [ListComprehensions.hs:13:1]) + +(AK ListComprehensions.hs:12:17-27 AnnCloseP = [ListComprehensions.hs:12:27]) + +(AK ListComprehensions.hs:12:17-27 AnnOpenP = [ListComprehensions.hs:12:17]) + +(AK ListComprehensions.hs:13:1-25 AnnImport = [ListComprehensions.hs:13:1-6]) + +(AK ListComprehensions.hs:13:1-25 AnnSemi = [ListComprehensions.hs:17:1]) + +(AK ListComprehensions.hs:13:18-25 AnnCloseP = [ListComprehensions.hs:13:25]) + +(AK ListComprehensions.hs:13:18-25 AnnOpenP = [ListComprehensions.hs:13:18]) + +(AK ListComprehensions.hs:17:1-25 AnnDcolon = [ListComprehensions.hs:17:18-19]) + +(AK ListComprehensions.hs:17:1-25 AnnSemi = [ListComprehensions.hs:18:1]) + +(AK ListComprehensions.hs:17:21-25 AnnCloseS = [ListComprehensions.hs:17:25]) + +(AK ListComprehensions.hs:17:21-25 AnnOpenS = [ListComprehensions.hs:17:21]) + +(AK ListComprehensions.hs:(18,1)-(22,20) AnnEqual = [ListComprehensions.hs:18:18]) + +(AK ListComprehensions.hs:(18,1)-(22,20) AnnFunId = [ListComprehensions.hs:18:1-16]) + +(AK ListComprehensions.hs:(18,1)-(22,20) AnnSemi = [ListComprehensions.hs:24:1]) + +(AK ListComprehensions.hs:(18,20)-(22,20) AnnCloseS = [ListComprehensions.hs:22:20]) + +(AK ListComprehensions.hs:(18,20)-(22,20) AnnOpenS = [ListComprehensions.hs:18:20]) + +(AK ListComprehensions.hs:(18,20)-(22,20) AnnVbar = [ListComprehensions.hs:19:20]) + +(AK ListComprehensions.hs:18:22-26 AnnVal = [ListComprehensions.hs:18:24]) + +(AK ListComprehensions.hs:18:22-30 AnnVal = [ListComprehensions.hs:18:28]) + +(AK ListComprehensions.hs:19:22-33 AnnLarrow = [ListComprehensions.hs:19:24-25]) + +(AK ListComprehensions.hs:19:22-33 AnnVbar = [ListComprehensions.hs:20:20]) + +(AK ListComprehensions.hs:19:27-33 AnnCloseS = [ListComprehensions.hs:19:33]) + +(AK ListComprehensions.hs:19:27-33 AnnDotdot = [ListComprehensions.hs:19:29-30]) + +(AK ListComprehensions.hs:19:27-33 AnnOpenS = [ListComprehensions.hs:19:27]) + +(AK ListComprehensions.hs:20:22-34 AnnLarrow = [ListComprehensions.hs:20:24-25]) + +(AK ListComprehensions.hs:20:22-34 AnnVbar = [ListComprehensions.hs:21:20]) + +(AK ListComprehensions.hs:20:27-34 AnnCloseS = [ListComprehensions.hs:20:34]) + +(AK ListComprehensions.hs:20:27-34 AnnDotdot = [ListComprehensions.hs:20:30-31]) + +(AK ListComprehensions.hs:20:27-34 AnnOpenS = [ListComprehensions.hs:20:27]) + +(AK ListComprehensions.hs:21:22-34 AnnLarrow = [ListComprehensions.hs:21:24-25]) + +(AK ListComprehensions.hs:21:27-34 AnnCloseS = [ListComprehensions.hs:21:34]) + +(AK ListComprehensions.hs:21:27-34 AnnDotdot = [ListComprehensions.hs:21:30-31]) + +(AK ListComprehensions.hs:21:27-34 AnnOpenS = [ListComprehensions.hs:21:27]) + +(AK ListComprehensions.hs:24:1-27 AnnDcolon = [ListComprehensions.hs:24:8-9]) + +(AK ListComprehensions.hs:24:1-27 AnnSemi = [ListComprehensions.hs:25:1]) + +(AK ListComprehensions.hs:24:11-15 AnnCloseS = [ListComprehensions.hs:24:15]) + +(AK ListComprehensions.hs:24:11-15 AnnOpenS = [ListComprehensions.hs:24:11]) + +(AK ListComprehensions.hs:24:11-15 AnnRarrow = [ListComprehensions.hs:24:17-18]) + +(AK ListComprehensions.hs:24:11-27 AnnRarrow = [ListComprehensions.hs:24:17-18]) + +(AK ListComprehensions.hs:24:20-27 AnnCloseS = [ListComprehensions.hs:24:27]) + +(AK ListComprehensions.hs:24:20-27 AnnOpenS = [ListComprehensions.hs:24:20]) + +(AK ListComprehensions.hs:(25,1)-(28,14) AnnEqual = [ListComprehensions.hs:25:12]) + +(AK ListComprehensions.hs:(25,1)-(28,14) AnnFunId = [ListComprehensions.hs:25:1-6]) + +(AK ListComprehensions.hs:(25,1)-(28,14) AnnSemi = [ListComprehensions.hs:29:1]) + +(AK ListComprehensions.hs:(25,14)-(28,14) AnnCloseS = [ListComprehensions.hs:28:14]) + +(AK ListComprehensions.hs:(25,14)-(28,14) AnnOpenS = [ListComprehensions.hs:25:14]) + +(AK ListComprehensions.hs:(25,14)-(28,14) AnnVbar = [ListComprehensions.hs:26:14]) + +(AK ListComprehensions.hs:26:16-23 AnnComma = [ListComprehensions.hs:27:14]) + +(AK ListComprehensions.hs:26:16-23 AnnLarrow = [ListComprehensions.hs:26:18-19]) + +(AK ListComprehensions.hs:(26,16)-(27,22) AnnThen = [ListComprehensions.hs:27:16-19]) +] + +EOF: Just SrcSpanPoint ".\\ListComprehensions.hs" 29 1 ===================================== testsuite/tests/ghc-api/annotations/parseTree.stdout-mingw32 ===================================== @@ -0,0 +1,160 @@ +[(AnnotationTuple.hs:14:20, [p], Unit 1), + (AnnotationTuple.hs:14:23-29, [p], Unit "hello"), + (AnnotationTuple.hs:14:35-37, [p], Unit 6.5), + (AnnotationTuple.hs:14:39, [m], ()), + (AnnotationTuple.hs:14:41-52, [p], Unit [5, 5, 6, 7]), + (AnnotationTuple.hs:16:8, [p], Unit 1), + (AnnotationTuple.hs:16:11-17, [p], Unit "hello"), + (AnnotationTuple.hs:16:20-22, [p], Unit 6.5), + (AnnotationTuple.hs:16:24, [m], ()), + (AnnotationTuple.hs:16:25, [m], ()), + (AnnotationTuple.hs:16:26, [m], ()), (, [m], ())] +[ +(AK AnnotationTuple.hs:1:1 AnnCloseC = [AnnotationTuple.hs:27:1]) + +(AK AnnotationTuple.hs:1:1 AnnModule = [AnnotationTuple.hs:3:1-6]) + +(AK AnnotationTuple.hs:1:1 AnnOpenC = [AnnotationTuple.hs:5:1]) + +(AK AnnotationTuple.hs:1:1 AnnWhere = [AnnotationTuple.hs:3:30-34]) + +(AK AnnotationTuple.hs:3:24-28 AnnCloseP = [AnnotationTuple.hs:3:28]) + +(AK AnnotationTuple.hs:3:24-28 AnnOpenP = [AnnotationTuple.hs:3:24]) + +(AK AnnotationTuple.hs:6:1-32 AnnAs = [AnnotationTuple.hs:6:28-29]) + +(AK AnnotationTuple.hs:6:1-32 AnnImport = [AnnotationTuple.hs:6:1-6]) + +(AK AnnotationTuple.hs:6:1-32 AnnQualified = [AnnotationTuple.hs:6:8-16]) + +(AK AnnotationTuple.hs:6:1-32 AnnSemi = [AnnotationTuple.hs:7:1]) + +(AK AnnotationTuple.hs:(8,1)-(11,14) AnnEqual = [AnnotationTuple.hs:8:5]) + +(AK AnnotationTuple.hs:(8,1)-(11,14) AnnFunId = [AnnotationTuple.hs:8:1-3]) + +(AK AnnotationTuple.hs:(8,1)-(11,14) AnnSemi = [AnnotationTuple.hs:13:1]) + +(AK AnnotationTuple.hs:(8,7)-(11,14) AnnIn = [AnnotationTuple.hs:11:7-8]) + +(AK AnnotationTuple.hs:(8,7)-(11,14) AnnLet = [AnnotationTuple.hs:8:7-9]) + +(AK AnnotationTuple.hs:9:9-13 AnnEqual = [AnnotationTuple.hs:9:11]) + +(AK AnnotationTuple.hs:9:9-13 AnnFunId = [AnnotationTuple.hs:9:9]) + +(AK AnnotationTuple.hs:9:9-13 AnnSemi = [AnnotationTuple.hs:10:9]) + +(AK AnnotationTuple.hs:10:9-13 AnnEqual = [AnnotationTuple.hs:10:11]) + +(AK AnnotationTuple.hs:10:9-13 AnnFunId = [AnnotationTuple.hs:10:9]) + +(AK AnnotationTuple.hs:11:10-14 AnnVal = [AnnotationTuple.hs:11:12]) + +(AK AnnotationTuple.hs:14:1-72 AnnEqual = [AnnotationTuple.hs:14:5]) + +(AK AnnotationTuple.hs:14:1-72 AnnFunId = [AnnotationTuple.hs:14:1-3]) + +(AK AnnotationTuple.hs:14:1-72 AnnSemi = [AnnotationTuple.hs:15:1]) + +(AK AnnotationTuple.hs:14:7-72 AnnVal = [AnnotationTuple.hs:14:13]) + +(AK AnnotationTuple.hs:14:19-53 AnnCloseP = [AnnotationTuple.hs:14:53]) + +(AK AnnotationTuple.hs:14:19-53 AnnOpenP = [AnnotationTuple.hs:14:19]) + +(AK AnnotationTuple.hs:14:20 AnnComma = [AnnotationTuple.hs:14:21]) + +(AK AnnotationTuple.hs:14:23-29 AnnComma = [AnnotationTuple.hs:14:33]) + +(AK AnnotationTuple.hs:14:35-37 AnnComma = [AnnotationTuple.hs:14:38]) + +(AK AnnotationTuple.hs:14:39 AnnComma = [AnnotationTuple.hs:14:39]) + +(AK AnnotationTuple.hs:14:41-52 AnnCloseS = [AnnotationTuple.hs:14:52]) + +(AK AnnotationTuple.hs:14:41-52 AnnOpenS = [AnnotationTuple.hs:14:41]) + +(AK AnnotationTuple.hs:14:42 AnnComma = [AnnotationTuple.hs:14:43]) + +(AK AnnotationTuple.hs:14:45 AnnComma = [AnnotationTuple.hs:14:46]) + +(AK AnnotationTuple.hs:14:48 AnnComma = [AnnotationTuple.hs:14:49]) + +(AK AnnotationTuple.hs:14:55-72 AnnCloseS = [AnnotationTuple.hs:14:72]) + +(AK AnnotationTuple.hs:14:55-72 AnnOpenS = [AnnotationTuple.hs:14:55]) + +(AK AnnotationTuple.hs:14:56-62 AnnComma = [AnnotationTuple.hs:14:63]) + +(AK AnnotationTuple.hs:14:61-62 AnnCloseP = [AnnotationTuple.hs:14:62]) + +(AK AnnotationTuple.hs:14:61-62 AnnOpenP = [AnnotationTuple.hs:14:61]) + +(AK AnnotationTuple.hs:16:1-41 AnnEqual = [AnnotationTuple.hs:16:5]) + +(AK AnnotationTuple.hs:16:1-41 AnnFunId = [AnnotationTuple.hs:16:1-3]) + +(AK AnnotationTuple.hs:16:1-41 AnnSemi = [AnnotationTuple.hs:17:1]) + +(AK AnnotationTuple.hs:16:7-27 AnnCloseP = [AnnotationTuple.hs:16:27]) + +(AK AnnotationTuple.hs:16:7-27 AnnOpenP = [AnnotationTuple.hs:16:7]) + +(AK AnnotationTuple.hs:16:8 AnnComma = [AnnotationTuple.hs:16:9]) + +(AK AnnotationTuple.hs:16:11-17 AnnComma = [AnnotationTuple.hs:16:18]) + +(AK AnnotationTuple.hs:16:20-22 AnnComma = [AnnotationTuple.hs:16:23]) + +(AK AnnotationTuple.hs:16:24 AnnComma = [AnnotationTuple.hs:16:24]) + +(AK AnnotationTuple.hs:16:25 AnnComma = [AnnotationTuple.hs:16:25]) + +(AK AnnotationTuple.hs:16:26 AnnComma = [AnnotationTuple.hs:16:26]) + +(AK AnnotationTuple.hs:16:33-41 AnnCloseP = [AnnotationTuple.hs:16:41]) + +(AK AnnotationTuple.hs:16:33-41 AnnOpenP = [AnnotationTuple.hs:16:33]) + +(AK AnnotationTuple.hs:16:39-40 AnnCloseP = [AnnotationTuple.hs:16:40]) + +(AK AnnotationTuple.hs:16:39-40 AnnOpenP = [AnnotationTuple.hs:16:39]) + +(AK AnnotationTuple.hs:18:1-28 AnnData = [AnnotationTuple.hs:18:1-4]) + +(AK AnnotationTuple.hs:18:1-28 AnnDcolon = [AnnotationTuple.hs:18:20-21]) + +(AK AnnotationTuple.hs:18:1-28 AnnFamily = [AnnotationTuple.hs:18:6-11]) + +(AK AnnotationTuple.hs:18:1-28 AnnSemi = [AnnotationTuple.hs:19:1]) + +(AK AnnotationTuple.hs:18:23 AnnRarrow = [AnnotationTuple.hs:18:25-26]) + +(AK AnnotationTuple.hs:18:23-28 AnnRarrow = [AnnotationTuple.hs:18:25-26]) + +(AK AnnotationTuple.hs:(20,1)-(24,14) AnnFunId = [AnnotationTuple.hs:20:1-5]) + +(AK AnnotationTuple.hs:(20,1)-(24,14) AnnSemi = [AnnotationTuple.hs:25:1]) + +(AK AnnotationTuple.hs:(21,7)-(24,14) AnnEqual = [AnnotationTuple.hs:24:7]) + +(AK AnnotationTuple.hs:(21,7)-(24,14) AnnVbar = [AnnotationTuple.hs:21:7]) + +(AK AnnotationTuple.hs:21:9-24 AnnComma = [AnnotationTuple.hs:22:7]) + +(AK AnnotationTuple.hs:21:9-24 AnnLarrow = [AnnotationTuple.hs:21:16-17]) + +(AK AnnotationTuple.hs:22:9-25 AnnComma = [AnnotationTuple.hs:23:7]) + +(AK AnnotationTuple.hs:22:9-25 AnnLarrow = [AnnotationTuple.hs:22:16-17]) + +(AK AnnotationTuple.hs:23:9-24 AnnLarrow = [AnnotationTuple.hs:23:16-17]) + +(AK AnnotationTuple.hs:26:1-10 AnnDcolon = [AnnotationTuple.hs:26:5-6]) + +(AK AnnotationTuple.hs:26:1-14 AnnEqual = [AnnotationTuple.hs:26:12]) +] + +EOF: Just SrcSpanPoint ".\\AnnotationTuple.hs" 32 1 ===================================== testsuite/tests/ghci/scripts/T9293.stdout-mingw32 ===================================== @@ -12,7 +12,6 @@ other dynamic, non-language, flag settings: -fimplicit-import-qualified -fshow-warning-groups warning settings: - -Wmissing-monadfail-instances -Wsemigroup -Wnoncanonical-monoid-instances -Wstar-is-type @@ -35,7 +34,6 @@ other dynamic, non-language, flag settings: -fimplicit-import-qualified -fshow-warning-groups warning settings: - -Wmissing-monadfail-instances -Wsemigroup -Wnoncanonical-monoid-instances -Wstar-is-type @@ -57,7 +55,6 @@ other dynamic, non-language, flag settings: -fimplicit-import-qualified -fshow-warning-groups warning settings: - -Wmissing-monadfail-instances -Wsemigroup -Wnoncanonical-monoid-instances -Wstar-is-type @@ -81,7 +78,6 @@ other dynamic, non-language, flag settings: -fimplicit-import-qualified -fshow-warning-groups warning settings: - -Wmissing-monadfail-instances -Wsemigroup -Wnoncanonical-monoid-instances -Wstar-is-type ===================================== testsuite/tests/ghci/scripts/ghci024.stdout-mingw32 ===================================== @@ -13,7 +13,6 @@ other dynamic, non-language, flag settings: -fimplicit-import-qualified -fshow-warning-groups warning settings: - -Wmissing-monadfail-instances -Wsemigroup -Wnoncanonical-monoid-instances -Wstar-is-type ===================================== testsuite/tests/ghci/scripts/ghci057.stdout-mingw32 ===================================== @@ -12,7 +12,6 @@ other dynamic, non-language, flag settings: -fimplicit-import-qualified -fshow-warning-groups warning settings: - -Wmissing-monadfail-instances -Wsemigroup -Wnoncanonical-monoid-instances -Wstar-is-type @@ -35,7 +34,6 @@ other dynamic, non-language, flag settings: -fimplicit-import-qualified -fshow-warning-groups warning settings: - -Wmissing-monadfail-instances -Wsemigroup -Wnoncanonical-monoid-instances -Wstar-is-type @@ -57,7 +55,6 @@ other dynamic, non-language, flag settings: -fimplicit-import-qualified -fshow-warning-groups warning settings: - -Wmissing-monadfail-instances -Wsemigroup -Wnoncanonical-monoid-instances -Wstar-is-type @@ -81,7 +78,6 @@ other dynamic, non-language, flag settings: -fimplicit-import-qualified -fshow-warning-groups warning settings: - -Wmissing-monadfail-instances -Wsemigroup -Wnoncanonical-monoid-instances -Wstar-is-type ===================================== utils/fs/fs.h ===================================== @@ -37,6 +37,13 @@ int FS(_stat) (const char *path, struct _stat *buffer); int FS(_stat64) (const char *path, struct __stat64 *buffer); int FS(_wstat) (const wchar_t *path, struct _stat *buffer); int FS(_wstat64) (const wchar_t *path, struct __stat64 *buffer); +int FS(_wrename) (const wchar_t *from, const wchar_t *to); +int FS(rename) (const char *from, const char *to); +int FS(unlink) (const char *filename); +int FS(_unlink) (const char *filename); +int FS(_wunlink) (const wchar_t *filename); +int FS(remove) (const char *path); +int FS(_wremove) (const wchar_t *path); #else FILE *FS(fopen) (const char* filename, const char* mode); ===================================== utils/hsc2hs ===================================== @@ -1 +1 @@ -Subproject commit 4089deb3295c28d6bca7d67322b408469a6f6496 +Subproject commit dff4ed1acf9ebbdd004fc833a474dc8c16a90f5b View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/de104b898ae6f9a5a500195fea2c67cfe782265c...cc480cdcca610621429ca091869af10be8f415f7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/de104b898ae6f9a5a500195fea2c67cfe782265c...cc480cdcca610621429ca091869af10be8f415f7 You're receiving 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 Mar 24 08:03:06 2020 From: gitlab at gitlab.haskell.org (=?UTF-8?B?w5ZtZXIgU2luYW4gQcSfYWNhbg==?=) Date: Tue, 24 Mar 2020 04:03:06 -0400 Subject: [Git][ghc/ghc][wip/osa1/lfinfo] Refactor types to eliminate bottom fields Message-ID: <5e79beba44217_61674f59d902616bb@gitlab.haskell.org.mail> Ömer Sinan Ağacan pushed to branch wip/osa1/lfinfo at Glasgow Haskell Compiler / GHC Commits: 168a1ebb by Ömer Sinan Ağacan at 2020-03-24T11:02:45+03:00 Refactor types to eliminate bottom fields - - - - - 21 changed files: - compiler/GHC/ByteCode/InfoTable.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/StgToCmm.hs - compiler/GHC/StgToCmm/Bind.hs - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/StgToCmm/Env.hs - compiler/GHC/StgToCmm/Expr.hs - compiler/GHC/StgToCmm/Heap.hs - compiler/GHC/StgToCmm/Layout.hs - compiler/GHC/StgToCmm/Monad.hs - compiler/GHC/StgToCmm/Ticky.hs - compiler/GHC/StgToCmm/Types.hs - compiler/basicTypes/Id.hs - compiler/basicTypes/IdInfo.hs - compiler/main/UpdateCafInfos.hs - testsuite/tests/codeGen/should_compile/Makefile - testsuite/tests/simplCore/should_compile/Makefile - testsuite/tests/simplCore/should_compile/T4201.stdout Changes: ===================================== compiler/GHC/ByteCode/InfoTable.hs ===================================== @@ -15,9 +15,9 @@ import GHC.ByteCode.Types import GHC.Runtime.Interpreter import GHC.Driver.Session import GHC.Driver.Types +import GHC.Core.DataCon import Name ( Name, getName ) import NameEnv -import GHC.Core.DataCon ( DataCon, dataConRepArgTys, dataConIdentity ) import GHC.Core.TyCon ( TyCon, tyConFamilySize, isDataTyCon, tyConDataCons ) import GHC.Types.RepType import GHC.StgToCmm.Layout ( mkVirtConstrSizes ) @@ -69,7 +69,7 @@ make_constr_itbls hsc_env cons = | ptrs' + nptrs' >= mIN_PAYLOAD_SIZE dflags = nptrs' | otherwise = mIN_PAYLOAD_SIZE dflags - ptrs' - descr = dataConIdentity dcon + descr = dataConIdentity (dataConName dcon) r <- iservCmd hsc_env (MkConInfoTable ptrs' nptrs_really conNo (tagForCon dflags dcon) descr) ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -1339,17 +1339,16 @@ dataConRepArgTys (MkData { dcRep = rep -- | The string @package:module.name@ identifying a constructor, which is attached -- to its info table and used by the GHCi debugger and the heap profiler -dataConIdentity :: DataCon -> ByteString +dataConIdentity :: Name -> ByteString -- We want this string to be UTF-8, so we get the bytes directly from the FastStrings. -dataConIdentity dc = LBS.toStrict $ BSB.toLazyByteString $ mconcat +dataConIdentity name = LBS.toStrict $ BSB.toLazyByteString $ mconcat [ BSB.byteString $ bytesFS (unitIdFS (moduleUnitId mod)) , BSB.int8 $ fromIntegral (ord ':') , BSB.byteString $ bytesFS (moduleNameFS (moduleName mod)) , BSB.int8 $ fromIntegral (ord '.') , BSB.byteString $ bytesFS (occNameFS (nameOccName name)) ] - where name = dataConName dc - mod = ASSERT( isExternalName name ) nameModule name + where mod = ASSERT( isExternalName name ) nameModule name isTupleDataCon :: DataCon -> Bool isTupleDataCon (MkData {dcRepTyCon = tc}) = isTupleTyCon tc ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE Strict #-} -- See Note [Avoiding space leaks in toIface*] +{-# LANGUAGE LambdaCase #-} -- | Functions for converting Core things to interface file things. module GHC.CoreToIface @@ -442,8 +443,7 @@ toIfaceIdDetails (RecSelId { sel_naughty = n -- The remaining cases are all "implicit Ids" which don't -- appear in interface files at all -toIfaceIdDetails other = pprTrace "toIfaceIdDetails" (ppr other) - IfVanillaId -- Unexpected; the other +toIfaceIdDetails _ = IfVanillaId -- Unexpected; the other toIfaceIdInfo :: IdInfo -> IfaceIdInfo toIfaceIdInfo id_info @@ -626,18 +626,14 @@ toIfaceVar v --------------------- -toIfaceLFInfo :: LambdaFormInfo -> IfaceLFInfo -toIfaceLFInfo (LFReEntrant TopLevel oneshot rep fvs_flag _argdesc) = - IfLFReEntrant (toIfaceOneShot oneshot) rep fvs_flag -toIfaceLFInfo (LFThunk TopLevel hasfv updateable sfi m_function) = - -- Assert that arity fits in 14 bits - ASSERT(fromEnum hasfv <= 1 && fromEnum updateable <= 1 && fromEnum m_function <= 1) - IfLFThunk hasfv updateable (toIfaceStandardFormInfo sfi) m_function -toIfaceLFInfo LFUnlifted = IfLFUnlifted -toIfaceLFInfo (LFCon con) = IfLFCon (dataConName con) --- All other cases are not possible at the top level. -toIfaceLFInfo lf = pprPanic "Invalid IfaceLFInfo conversion:" - (ppr lf <+> text "should not be exported") +toIfaceLFInfo :: ImportedLFI -> IfaceLFInfo +toIfaceLFInfo = \case + LFReEntrant lfr -> IfLFReEntrant (lfr_rep_arity lfr) + LFThunk lft -> IfLFThunk (lft_updatable lft) (toIfaceStandardFormInfo (lft_sfi lft)) (lft_mb_fun lft) + LFCon name _ -> IfLFCon name + LFUnknown mb_fun -> IfLFUnknown mb_fun + LFUnlifted -> IfLFUnlifted + LFLetNoEscape -> panic "toIfaceLFInfo: LFLetNoEscape" toIfaceStandardFormInfo :: StandardFormInfo -> IfaceStandardFormInfo toIfaceStandardFormInfo NonStandardThunk = IfStandardFormInfo 1 ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -389,8 +389,8 @@ data IfaceIdDetails -- Lambda form info data IfaceLFInfo - = IfLFReEntrant !IfaceOneShot !RepArity !Bool - | IfLFThunk !Bool !Bool !IfaceStandardFormInfo !Bool + = IfLFReEntrant !RepArity + | IfLFThunk !Bool !IfaceStandardFormInfo !Bool | IfLFCon -- A saturated constructor application !Name -- The constructor Name | IfLFUnknown !Bool @@ -407,10 +407,10 @@ tcStandardFormInfo (IfStandardFormInfo w) | otherwise = SelectorThunk instance Outputable IfaceLFInfo where - ppr (IfLFReEntrant oneshot rep fvs_flag) = - text "LFReEntrant" <+> ppr (oneshot, rep, fvs_flag) - ppr (IfLFThunk fvs_flag upd_flag sfi fun_flag) = - text "LFThunk" <+> ppr (fvs_flag, upd_flag, fun_flag) <+> ppr (tcStandardFormInfo sfi) + ppr (IfLFReEntrant arity) = + text "LFReEntrant" <+> ppr arity + ppr (IfLFThunk updatable sfi mb_fun) = + text "LFThunk" <+> ppr (updatable, tcStandardFormInfo sfi, mb_fun) ppr (IfLFCon con) = text "LFCon" <> brackets (ppr con) ppr IfLFUnlifted = text "LFUnlifted" ppr (IfLFUnknown fun_flag) = text "LFUnknown" <+> ppr fun_flag @@ -423,17 +423,14 @@ instance Binary IfaceStandardFormInfo where instance Binary IfaceLFInfo where -- TODO: We could pack the bytes somewhat - put_ bh (IfLFReEntrant oneshot rep fvs_flag) = do + put_ bh (IfLFReEntrant arity) = do putByte bh 0 - put_ bh oneshot - put_ bh rep - put_ bh fvs_flag - put_ bh (IfLFThunk top_lvl no_fvs std_form maybe_fun) = do + put_ bh arity + put_ bh (IfLFThunk updatable sfi mb_fun) = do putByte bh 1 - put_ bh top_lvl - put_ bh no_fvs - put_ bh std_form - put_ bh maybe_fun + put_ bh updatable + put_ bh sfi + put_ bh mb_fun put_ bh (IfLFCon con_name) = do putByte bh 2 put_ bh con_name @@ -445,8 +442,8 @@ instance Binary IfaceLFInfo where get bh = do tag <- getByte bh case tag of - 0 -> IfLFReEntrant <$> get bh <*> get bh <*> get bh - 1 -> IfLFThunk <$> get bh <*> get bh <*> get bh <*> get bh + 0 -> IfLFReEntrant <$> get bh + 1 -> IfLFThunk <$> get bh <*> get bh <*> get bh 2 -> IfLFCon <$> get bh 3 -> IfLFUnknown <$> get bh 4 -> pure IfLFUnlifted ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -1507,16 +1507,17 @@ addIdLFInfo id = case idLFInfo_maybe id of Just _ -> id -- Make a LambdaFormInfo for the Ids without a LFInfo in the iface file -mkLFImported :: IdDetails -> IdInfo -> Type -> LambdaFormInfo +mkLFImported :: IdDetails -> IdInfo -> Type -> ImportedLFI mkLFImported details info ty | DataConWorkId con <- details , isNullaryRepDataCon con - = LFCon con -- An imported nullary constructor + = LFCon (dataConName con) (dataConTag con) + -- An imported nullary constructor -- We assume that the constructor is evaluated so that -- the id really does point directly to the constructor | arity > 0 - = LFReEntrant TopLevel noOneShotInfo arity True ArgUnknown + = LFReEntrant (LFR_Imported arity) | isUnliftedType ty = LFUnlifted @@ -1533,16 +1534,18 @@ tcJoinInfo :: IfaceJoinInfo -> Maybe JoinArity tcJoinInfo (IfaceJoinPoint ar) = Just ar tcJoinInfo IfaceNotJoinPoint = Nothing -tcLFInfo :: IfaceLFInfo -> IfL LambdaFormInfo -tcLFInfo (IfLFReEntrant oneshot rep fvs_flag) = - return (LFReEntrant TopLevel (tcIfaceOneShot oneshot) rep fvs_flag ArgUnknown) +tcLFInfo :: IfaceLFInfo -> IfL ImportedLFI -tcLFInfo (IfLFThunk fvs_flag upd_flag sfi fun_flag ) = do - return (LFThunk TopLevel fvs_flag upd_flag (tcStandardFormInfo sfi) fun_flag) +tcLFInfo (IfLFReEntrant arity) = return (LFReEntrant (LFR_Imported arity)) + +tcLFInfo (IfLFThunk updatable sfi mb_fun) = + return (LFThunk (LFT_Imported updatable (tcStandardFormInfo sfi) mb_fun)) tcLFInfo IfLFUnlifted = return LFUnlifted -tcLFInfo (IfLFCon con_name) = LFCon <$!> tcIfaceDataCon con_name +tcLFInfo (IfLFCon name) = do + con <- tcIfaceDataCon name + return (LFCon name (dataConTag con)) tcLFInfo (IfLFUnknown fun_flag) = return (LFUnknown fun_flag) ===================================== compiler/GHC/StgToCmm.hs ===================================== @@ -26,7 +26,7 @@ import GHC.StgToCmm.Utils import GHC.StgToCmm.Closure import GHC.StgToCmm.Hpc import GHC.StgToCmm.Ticky -import GHC.StgToCmm.Types (ModuleLFInfos) +import GHC.StgToCmm.Types (ModuleLFInfos, toImportedLFI) import GHC.Cmm import GHC.Cmm.CLabel @@ -112,15 +112,14 @@ codeGen dflags this_mod data_tycons -- Only external names are actually visible to codeGen. So they are the -- only ones we care about. - ; let extractInfo info = lf `seq` Just (name,lf) - where - id = cg_id info - !name = idName id - lf = cg_lf info + ; let extractInfo (CgIdInfo !id !lf _) = + let !lf' = toImportedLFI lf + !name = idName id + in Just (name, lf') ; let !generatedInfo = mkNameEnv (mapMaybe extractInfo (eltsUFM cg_id_infos)) - ; return $! generatedInfo + ; return generatedInfo } --------------------------------------------------------------- ===================================== compiler/GHC/StgToCmm/Bind.hs ===================================== @@ -15,6 +15,7 @@ module GHC.StgToCmm.Bind ( import GhcPrelude hiding ((<*>)) +import GHC.StgToCmm.Types import GHC.StgToCmm.Expr import GHC.StgToCmm.Monad import GHC.StgToCmm.Env @@ -374,7 +375,7 @@ mkRhsClosure dflags bndr cc fvs upd_flag args body ------------------------- cgRhsStdThunk :: Id - -> LambdaFormInfo + -> LocalLFI -> [StgArg] -- payload -> FCode (CgIdInfo, FCode CmmAGraph) @@ -418,7 +419,7 @@ mkClosureLFInfo :: DynFlags -> [NonVoid Id] -- Free vars -> UpdateFlag -- Update flag -> [Id] -- Args - -> LambdaFormInfo + -> LocalLFI mkClosureLFInfo dflags bndr top fvs upd_flag args | null args = mkLFThunk (idType bndr) top (map fromNonVoid fvs) upd_flag @@ -524,7 +525,7 @@ closureCodeBody top_lvl bndr cl_info cc args arity body fv_details bind_fv :: (NonVoid Id, ByteOff) -> FCode (LocalReg, ByteOff) bind_fv (id, off) = do { reg <- rebindToReg id; return (reg, off) } -load_fvs :: LocalReg -> LambdaFormInfo -> [(LocalReg, ByteOff)] -> FCode () +load_fvs :: LocalReg -> LocalLFI -> [(LocalReg, ByteOff)] -> FCode () load_fvs node lf_info = mapM_ (\ (reg, off) -> do dflags <- getDynFlags platform <- getPlatform ===================================== compiler/GHC/StgToCmm/Closure.hs ===================================== @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, RecordWildCards #-} +{-# LANGUAGE CPP, RecordWildCards, ImplicitParams, GADTs #-} ----------------------------------------------------------------------------- -- @@ -50,7 +50,6 @@ module GHC.StgToCmm.Closure ( -- These are really just functions on LambdaFormInfo closureUpdReqd, closureSingleEntry, closureReEntrant, closureFunInfo, - isToplevClosure, mightBeAFunction, blackHoleOnEntry, -- Needs LambdaFormInfo and SMRep @@ -118,10 +117,10 @@ instance Outputable CgLoc where type SelfLoopInfo = (Id, BlockId, [LocalReg]) -- used by ticky profiling -isKnownFun :: LambdaFormInfo -> Bool +isKnownFun :: LambdaFormInfo a -> Bool isKnownFun LFReEntrant{} = True isKnownFun LFLetNoEscape = True -isKnownFun _ = False +isKnownFun _ = False ------------------------------------- @@ -194,7 +193,7 @@ argPrimRep arg = typePrimRep1 (stgArgType arg) -- Building LambdaFormInfo ------------------------------------------------------ -mkLFArgument :: Id -> LambdaFormInfo +mkLFArgument :: Id -> LambdaFormInfo a mkLFArgument id | isUnliftedType ty = LFUnlifted | mightBeAFunction ty = LFUnknown True @@ -203,7 +202,7 @@ mkLFArgument id ty = idType id ------------- -mkLFLetNoEscape :: LambdaFormInfo +mkLFLetNoEscape :: LambdaFormInfo a mkLFLetNoEscape = LFLetNoEscape ------------- @@ -211,22 +210,19 @@ mkLFReEntrant :: TopLevelFlag -- True of top level -> [Id] -- Free vars -> [Id] -- Args -> ArgDescr -- Argument descriptor - -> LambdaFormInfo + -> LocalLFI mkLFReEntrant _ _ [] _ = pprPanic "mkLFReEntrant" empty mkLFReEntrant top fvs args arg_descr - = LFReEntrant top os_info (length args) (null fvs) arg_descr + = LFReEntrant (LFR_Local top os_info (length args) (null fvs) arg_descr) where os_info = idOneShotInfo (head args) ------------- -mkLFThunk :: Type -> TopLevelFlag -> [Id] -> UpdateFlag -> LambdaFormInfo +mkLFThunk :: Type -> TopLevelFlag -> [Id] -> UpdateFlag -> LocalLFI mkLFThunk thunk_ty top fvs upd_flag = ASSERT( not (isUpdatable upd_flag) || not (isUnliftedType thunk_ty) ) - LFThunk top (null fvs) - (isUpdatable upd_flag) - NonStandardThunk - (mightBeAFunction thunk_ty) + LFThunk (LFT_Local top (null fvs) (isUpdatable upd_flag) NonStandardThunk (mightBeAFunction thunk_ty)) -------------- mightBeAFunction :: Type -> Bool @@ -241,23 +237,21 @@ mightBeAFunction ty = True ------------- -mkConLFInfo :: DataCon -> LambdaFormInfo -mkConLFInfo con = LFCon con +mkConLFInfo :: DataCon -> LambdaFormInfo a +mkConLFInfo con = LFCon (dataConName con) (dataConTag con) ------------- -mkSelectorLFInfo :: Id -> Int -> Bool -> LambdaFormInfo +mkSelectorLFInfo :: Id -> Int -> Bool -> LocalLFI mkSelectorLFInfo id offset updatable - = LFThunk NotTopLevel False updatable (SelectorThunk offset) - (mightBeAFunction (idType id)) + = LFThunk (LFT_Local NotTopLevel False updatable (SelectorThunk offset) (mightBeAFunction (idType id))) ------------- -mkApLFInfo :: Id -> UpdateFlag -> Arity -> LambdaFormInfo +mkApLFInfo :: Id -> UpdateFlag -> Arity -> LocalLFI mkApLFInfo id upd_flag arity - = LFThunk NotTopLevel (arity == 0) (isUpdatable upd_flag) (ApThunk arity) - (mightBeAFunction (idType id)) + = LFThunk (LFT_Local NotTopLevel (arity == 0) (isUpdatable upd_flag) (ApThunk arity) (mightBeAFunction (idType id))) ------------- -mkLFStringLit :: LambdaFormInfo +mkLFStringLit :: LambdaFormInfo a mkLFStringLit = LFUnlifted ----------------------------------------------------- @@ -295,37 +289,37 @@ tagForArity dflags arity | isSmallFamily dflags arity = arity | otherwise = 0 -lfDynTag :: DynFlags -> LambdaFormInfo -> DynTag +lfDynTag :: DynFlags -> LambdaFormInfo a -> DynTag -- Return the tag in the low order bits of a variable bound -- to this LambdaForm -lfDynTag dflags (LFCon con) = tagForCon dflags con -lfDynTag dflags (LFReEntrant _ _ arity _ _) = tagForArity dflags arity -lfDynTag _ _other = 0 - +lfDynTag dflags lfi = + case lfi of + LFCon _ tag -> min tag (mAX_PTR_TAG dflags) + LFReEntrant lfr -> tagForArity dflags (lfr_rep_arity lfr) + _ -> 0 ----------------------------------------------------------------------------- -- Observing LambdaFormInfo ----------------------------------------------------------------------------- ------------ -isLFThunk :: LambdaFormInfo -> Bool -isLFThunk (LFThunk {}) = True +isLFThunk :: LambdaFormInfo a -> Bool +isLFThunk LFThunk{} = True isLFThunk _ = False -isLFReEntrant :: LambdaFormInfo -> Bool -isLFReEntrant (LFReEntrant {}) = True -isLFReEntrant _ = False +isLFReEntrant :: LambdaFormInfo a -> Bool +isLFReEntrant LFReEntrant{} = True +isLFReEntrant _ = False ----------------------------------------------------------------------------- -- Choosing SM reps ----------------------------------------------------------------------------- -lfClosureType :: LambdaFormInfo -> ClosureTypeInfo -lfClosureType (LFReEntrant _ _ arity _ argd) = Fun arity argd -lfClosureType (LFCon con) = Constr (dataConTagZ con) - (dataConIdentity con) -lfClosureType (LFThunk _ _ _ is_sel _) = thunkClosureType is_sel -lfClosureType _ = panic "lfClosureType" +lfClosureType :: LocalLFI -> ClosureTypeInfo +lfClosureType (LFReEntrant lfr) = Fun (lfr_rep_arity lfr) (lfr_arg_descr lfr) +lfClosureType (LFCon name tag) = Constr (tag - 1) (dataConIdentity name) +lfClosureType (LFThunk lft) = thunkClosureType (lft_sfi lft) +lfClosureType _ = panic "lfClosureType" thunkClosureType :: StandardFormInfo -> ClosureTypeInfo thunkClosureType (SelectorThunk off) = ThunkSelector off @@ -340,22 +334,23 @@ thunkClosureType _ = Thunk -- nodeMustPointToIt ----------------------------------------------------------------------------- -nodeMustPointToIt :: DynFlags -> LambdaFormInfo -> Bool +nodeMustPointToIt :: DynFlags -> LambdaFormInfo a -> Bool -- If nodeMustPointToIt is true, then the entry convention for -- this closure has R1 (the "Node" register) pointing to the -- closure itself --- the "self" argument -nodeMustPointToIt _ (LFReEntrant top _ _ no_fvs _) - = not no_fvs -- Certainly if it has fvs we need to point to it - || isNotTopLevel top -- See Note [GC recovery] +nodeMustPointToIt _ (LFReEntrant lfr) + = not (lfr_no_fvs lfr) -- Certainly if it has fvs we need to point to it + || isNotTopLevel (lfr_top_lvl lfr) -- See Note [GC recovery] -- For lex_profiling we also access the cost centre for a -- non-inherited (i.e. non-top-level) function. -- The isNotTopLevel test above ensures this is ok. -nodeMustPointToIt dflags (LFThunk top no_fvs updatable NonStandardThunk _) - = not no_fvs -- Self parameter - || isNotTopLevel top -- Note [GC recovery] - || updatable -- Need to push update frame +nodeMustPointToIt dflags (LFThunk lft) + | NonStandardThunk <- lft_sfi lft + = not (lft_no_fvs lft) -- Self parameter + || isNotTopLevel (lft_top_lvl lft) -- Note [GC recovery] + || lft_updatable lft -- Need to push update frame || gopt Opt_SccProfilingOn dflags -- For the non-updatable (single-entry case): -- @@ -369,7 +364,7 @@ nodeMustPointToIt dflags (LFThunk top no_fvs updatable NonStandardThunk _) nodeMustPointToIt _ (LFThunk {}) -- Node must point to a standard-form thunk = True -nodeMustPointToIt _ (LFCon _) = True +nodeMustPointToIt _ (LFCon _ _) = True -- Strictly speaking, the above two don't need Node to point -- to it if the arity = 0. But this is a *really* unlikely @@ -456,7 +451,8 @@ getCallMethod :: DynFlags -> Id -- Function Id used to chech if it can refer to -- CAF's and whether the function is tail-calling -- itself - -> LambdaFormInfo -- Its info + -> LambdaFormInfo a + -- Its info -> RepArity -- Number of available arguments -> RepArity -- Number of them being void arguments -> CgLoc -- Passed in from cgIdApp so that we can @@ -480,31 +476,30 @@ getCallMethod dflags _ id _ n_args v_args _cg_loc -- self-recursive tail calls] in GHC.StgToCmm.Expr for more details = JumpToIt block_id args -getCallMethod dflags name id (LFReEntrant _ _ arity _ _) n_args _v_args _cg_loc +getCallMethod dflags name id (LFReEntrant lfr) n_args _v_args _cg_loc _self_loop_info | n_args == 0 -- No args at all && not (gopt Opt_SccProfilingOn dflags) -- See Note [Evaluating functions with profiling] in rts/Apply.cmm - = ASSERT( arity /= 0 ) ReturnIt - | n_args < arity = SlowCall -- Not enough args - | otherwise = DirectEntry (enterIdLabel dflags name (idCafInfo id)) arity + = ASSERT( lfr_rep_arity lfr /= 0 ) ReturnIt + | n_args < lfr_rep_arity lfr = SlowCall -- Not enough args + | otherwise = DirectEntry (enterIdLabel dflags name (idCafInfo id)) (lfr_rep_arity lfr) getCallMethod _ _name _ LFUnlifted n_args _v_args _cg_loc _self_loop_info = ASSERT( n_args == 0 ) ReturnIt -getCallMethod _ _name _ (LFCon _) n_args _v_args _cg_loc _self_loop_info +getCallMethod _ _name _ (LFCon _ _) n_args _v_args _cg_loc _self_loop_info = ASSERT( n_args == 0 ) ReturnIt -- n_args=0 because it'd be ill-typed to apply a saturated -- constructor application to anything -getCallMethod dflags name id (LFThunk _ _ updatable std_form_info is_fun) - n_args _v_args _cg_loc _self_loop_info - | is_fun -- it *might* be a function, so we must "call" it (which is always safe) - = SlowCall -- We cannot just enter it [in eval/apply, the entry code - -- is the fast-entry code] +getCallMethod dflags name id (LFThunk lft) n_args _v_args _cg_loc _self_loop_info + | lft_mb_fun lft -- it *might* be a function, so we must "call" it (which is always safe) + = SlowCall -- We cannot just enter it [in eval/apply, the entry code + -- is the fast-entry code] -- Since is_fun is False, we are *definitely* looking at a data value - | updatable || gopt Opt_Ticky dflags -- to catch double entry + | lft_updatable lft || gopt Opt_Ticky dflags -- to catch double entry {- OLD: || opt_SMP I decided to remove this, because in SMP mode it doesn't matter if we enter the same thunk multiple times, so the optimisation @@ -514,7 +509,7 @@ getCallMethod dflags name id (LFThunk _ _ updatable std_form_info is_fun) -- even a non-updatable selector thunk can be updated by the garbage -- collector, so we must enter it. (#8817) - | SelectorThunk{} <- std_form_info + | SelectorThunk{} <- lft_sfi lft = EnterIt -- We used to have ASSERT( n_args == 0 ), but actually it is @@ -526,8 +521,7 @@ getCallMethod dflags name id (LFThunk _ _ updatable std_form_info is_fun) | otherwise -- Jump direct to code for single-entry thunks = ASSERT( n_args == 0 ) - DirectEntry (thunkEntryLabel dflags name (idCafInfo id) std_form_info - updatable) 0 + DirectEntry (thunkEntryLabel dflags name (idCafInfo id) (lft_sfi lft) (lft_updatable lft)) 0 getCallMethod _ _name _ (LFUnknown True) _n_arg _v_args _cg_locs _self_loop_info = SlowCall -- might be a function @@ -570,7 +564,7 @@ data ClosureInfo -- code for ticky and profiling, and we could pass the information -- around separately, but it doesn't do much harm to keep it here. - closureLFInfo :: !LambdaFormInfo, -- NOTE: not an LFCon + closureLFInfo :: !LocalLFI, -- NOTE: not an LFCon -- this tells us about what the closure contains: it's right-hand-side. -- the rest is just an unpacked CmmInfoTable. @@ -595,10 +589,10 @@ mkCmmInfo ClosureInfo {..} id ccs -------------------------------------- mkClosureInfo :: DynFlags - -> Bool -- Is static + -> Bool -- Is static -> Id - -> LambdaFormInfo - -> Int -> Int -- Total and pointer words + -> LocalLFI + -> Int -> Int -- Total and pointer words -> String -- String descriptor -> ClosureInfo mkClosureInfo dflags is_static id lf_info tot_wds ptr_wds val_descr @@ -643,9 +637,9 @@ blackHoleOnEntry cl_info | otherwise = case closureLFInfo cl_info of - LFReEntrant {} -> False - LFLetNoEscape -> False - LFThunk _ _no_fvs upd _ _ -> upd -- See Note [Black-holing non-updatable thunks] + LFReEntrant {} -> False + LFLetNoEscape -> False + LFThunk lft -> lft_updatable lft -- See Note [Black-holing non-updatable thunks] _other -> panic "blackHoleOnEntry" {- Note [Black-holing non-updatable thunks] @@ -721,13 +715,13 @@ isStaticClosure cl_info = isStaticRep (closureSMRep cl_info) closureUpdReqd :: ClosureInfo -> Bool closureUpdReqd ClosureInfo{ closureLFInfo = lf_info } = lfUpdatable lf_info -lfUpdatable :: LambdaFormInfo -> Bool -lfUpdatable (LFThunk _ _ upd _ _) = upd +lfUpdatable :: LambdaFormInfo a -> Bool +lfUpdatable (LFThunk lft) = lft_updatable lft lfUpdatable _ = False closureSingleEntry :: ClosureInfo -> Bool -closureSingleEntry (ClosureInfo { closureLFInfo = LFThunk _ _ upd _ _}) = not upd -closureSingleEntry (ClosureInfo { closureLFInfo = LFReEntrant _ OneShotLam _ _ _}) = True +closureSingleEntry (ClosureInfo { closureLFInfo = LFThunk lft }) = not (lft_updatable lft) +closureSingleEntry (ClosureInfo { closureLFInfo = LFReEntrant (LFR_Local _ OneShotLam _ _ _) }) = True closureSingleEntry _ = False closureReEntrant :: ClosureInfo -> Bool @@ -737,21 +731,14 @@ closureReEntrant _ = False closureFunInfo :: ClosureInfo -> Maybe (RepArity, ArgDescr) closureFunInfo (ClosureInfo { closureLFInfo = lf_info }) = lfFunInfo lf_info -lfFunInfo :: LambdaFormInfo -> Maybe (RepArity, ArgDescr) -lfFunInfo (LFReEntrant _ _ arity _ arg_desc) = Just (arity, arg_desc) -lfFunInfo _ = Nothing +lfFunInfo :: LocalLFI -> Maybe (RepArity, ArgDescr) +lfFunInfo (LFReEntrant lfr) = Just (lfr_rep_arity lfr, lfr_arg_descr lfr) +lfFunInfo _ = Nothing funTag :: DynFlags -> ClosureInfo -> DynTag funTag dflags (ClosureInfo { closureLFInfo = lf_info }) = lfDynTag dflags lf_info -isToplevClosure :: ClosureInfo -> Bool -isToplevClosure (ClosureInfo { closureLFInfo = lf_info }) - = case lf_info of - LFReEntrant TopLevel _ _ _ _ -> True - LFThunk TopLevel _ _ _ _ -> True - _other -> False - -------------------------------------- -- Label generation -------------------------------------- @@ -767,14 +754,14 @@ closureLocalEntryLabel dflags | tablesNextToCode dflags = toInfoLbl . closureInfoLabel | otherwise = toEntryLbl . closureInfoLabel -mkClosureInfoTableLabel :: Id -> LambdaFormInfo -> CLabel +mkClosureInfoTableLabel :: Id -> LocalLFI -> CLabel mkClosureInfoTableLabel id lf_info = case lf_info of - LFThunk _ _ upd_flag (SelectorThunk offset) _ - -> mkSelectorInfoLabel upd_flag offset + LFThunk lft | SelectorThunk offset <- lft_sfi lft + -> mkSelectorInfoLabel (lft_updatable lft) offset - LFThunk _ _ upd_flag (ApThunk arity) _ - -> mkApInfoTableLabel upd_flag arity + LFThunk lft | ApThunk arity <- lft_sfi lft + -> mkApInfoTableLabel (lft_updatable lft) arity LFThunk{} -> std_mk_lbl name cafs LFReEntrant{} -> std_mk_lbl name cafs @@ -878,7 +865,7 @@ mkDataConInfoTable dflags data_con is_static ptr_wds nonptr_wds name = dataConName data_con info_lbl = mkConInfoTableLabel name NoCafRefs sm_rep = mkHeapRep dflags is_static ptr_wds nonptr_wds cl_type - cl_type = Constr (dataConTagZ data_con) (dataConIdentity data_con) + cl_type = Constr (dataConTagZ data_con) (dataConIdentity (dataConName data_con)) -- We keep the *zero-indexed* tag in the srt_len field -- of the info table of a data constructor. ===================================== compiler/GHC/StgToCmm/Env.hs ===================================== @@ -50,18 +50,17 @@ import UniqFM import Util import VarEnv import GHC.Core.DataCon -import BasicTypes ------------------------------------- -- Manipulating CgIdInfo ------------------------------------- -mkCgIdInfo :: Id -> LambdaFormInfo -> CmmExpr -> CgIdInfo +mkCgIdInfo :: Id -> LambdaFormInfo a -> CmmExpr -> CgIdInfo mkCgIdInfo id lf expr = CgIdInfo { cg_id = id, cg_lf = lf , cg_loc = CmmLoc expr } -litIdInfo :: DynFlags -> Id -> LambdaFormInfo -> CmmLit -> CgIdInfo +litIdInfo :: DynFlags -> Id -> LambdaFormInfo a -> CmmLit -> CgIdInfo litIdInfo dflags id lf lit = CgIdInfo { cg_id = id, cg_lf = lf , cg_loc = CmmLoc (addDynTag platform (CmmLit lit) tag) } @@ -78,13 +77,13 @@ lneIdInfo platform id regs blk_id = mkBlockId (idUnique id) -rhsIdInfo :: Id -> LambdaFormInfo -> FCode (CgIdInfo, LocalReg) +rhsIdInfo :: Id -> LocalLFI -> FCode (CgIdInfo, LocalReg) rhsIdInfo id lf_info = do platform <- getPlatform reg <- newTemp (gcWord platform) return (mkCgIdInfo id lf_info (CmmReg (CmmLocal reg)), reg) -mkRhsInit :: DynFlags -> LocalReg -> LambdaFormInfo -> CmmExpr -> CmmAGraph +mkRhsInit :: DynFlags -> LocalReg -> LambdaFormInfo a -> CmmExpr -> CmmAGraph mkRhsInit dflags reg lf_info expr = mkAssign (CmmLocal reg) (addDynTag platform expr (lfDynTag dflags lf_info)) where platform = targetPlatform dflags @@ -149,7 +148,7 @@ getCgIdInfo id cgLookupPanic id -- Bug }}} -mkLFImported :: Id -> LambdaFormInfo +mkLFImported :: Id -> ImportedLFI mkLFImported id = case idLFInfo_maybe id of Just lf_info -> @@ -157,12 +156,13 @@ mkLFImported id = Nothing | Just con <- isDataConWorkId_maybe id , isNullaryRepDataCon con - -> LFCon con -- An imported nullary constructor + -> LFCon (dataConName con) (dataConTag con) + -- An imported nullary constructor -- We assume that the constructor is evaluated so that -- the id really does point directly to the constructor | arity > 0 - -> LFReEntrant TopLevel noOneShotInfo arity True (panic "arg_descr") + -> LFReEntrant (LFR_Imported arity) | otherwise -> mkLFArgument id -- Not sure of exact arity @@ -200,7 +200,7 @@ getNonVoidArgAmodes (arg:args) -- Interface functions for binding and re-binding names ------------------------------------------------------------------------ -bindToReg :: NonVoid Id -> LambdaFormInfo -> FCode LocalReg +bindToReg :: NonVoid Id -> LambdaFormInfo a -> FCode LocalReg -- Bind an Id to a fresh LocalReg bindToReg nvid@(NonVoid id) lf_info = do platform <- getPlatform @@ -212,8 +212,8 @@ rebindToReg :: NonVoid Id -> FCode LocalReg -- Like bindToReg, but the Id is already in scope, so -- get its LF info from the envt rebindToReg nvid@(NonVoid id) - = do { info <- getCgIdInfo id - ; bindToReg nvid (cg_lf info) } + = do { CgIdInfo _ lfi _ <- getCgIdInfo id + ; bindToReg nvid lfi } bindArgToReg :: NonVoid Id -> FCode LocalReg bindArgToReg nvid@(NonVoid id) = bindToReg nvid (mkLFArgument id) ===================================== compiler/GHC/StgToCmm/Expr.hs ===================================== @@ -861,13 +861,14 @@ cgIdApp fun_id args = do dflags <- getDynFlags fun_info <- getCgIdInfo fun_id self_loop_info <- getSelfLoop + case fun_info of + { CgIdInfo _ lf_info _ -> let fun_arg = StgVarArg fun_id fun_name = idName fun_id fun = idInfoToAmode fun_info - lf_info = cg_lf fun_info n_args = length args v_args = length $ filter (isVoidTy . stgArgType) args - node_points dflags = nodeMustPointToIt dflags lf_info + node_points dflags = nodeMustPointToIt dflags lf_info in case getCallMethod dflags fun_name fun_id lf_info n_args v_args (cg_loc fun_info) self_loop_info of -- A value in WHNF, so we can just return it. ReturnIt @@ -896,7 +897,7 @@ cgIdApp fun_id args = do ; cmm_args <- getNonVoidArgAmodes args ; emitMultiAssign lne_regs cmm_args ; emit (mkBranch blk_id) - ; return AssignedDirectly } + ; return AssignedDirectly } } -- Note [Self-recursive tail calls] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/StgToCmm/Heap.hs ===================================== @@ -18,7 +18,7 @@ module GHC.StgToCmm.Heap ( mkStaticClosureFields, mkStaticClosure, - allocDynClosure, allocDynClosureCmm, allocHeapClosure, + allocDynClosure, allocHeapClosure, emitSetDynHdr ) where @@ -33,6 +33,7 @@ import GHC.StgToCmm.Prof (profDynAlloc, dynProfHdr, staticProfHdr) import GHC.StgToCmm.Ticky import GHC.StgToCmm.Closure import GHC.StgToCmm.Env +import GHC.StgToCmm.Types import GHC.Cmm.Graph @@ -60,7 +61,7 @@ import Data.Maybe (isJust) allocDynClosure :: Maybe Id -> CmmInfoTable - -> LambdaFormInfo + -> LocalLFI -> CmmExpr -- Cost Centre to stick in the object -> CmmExpr -- Cost Centre to blame for this alloc -- (usually the same; sometimes "OVERHEAD") @@ -71,7 +72,11 @@ allocDynClosure -> FCode CmmExpr -- returns Hp+n allocDynClosureCmm - :: Maybe Id -> CmmInfoTable -> LambdaFormInfo -> CmmExpr -> CmmExpr + :: Maybe Id + -> CmmInfoTable + -> LocalLFI + -> CmmExpr + -> CmmExpr -> [(CmmExpr, ByteOff)] -> FCode CmmExpr -- returns Hp+n ===================================== compiler/GHC/StgToCmm/Layout.hs ===================================== @@ -595,7 +595,7 @@ stdPattern reps emitClosureProcAndInfoTable :: Bool -- top-level? -> Id -- name of the closure - -> LambdaFormInfo + -> LambdaFormInfo a -> CmmInfoTable -> [NonVoid Id] -- incoming arguments -> ((Int, LocalReg, [LocalReg]) -> FCode ()) -- function body ===================================== compiler/GHC/StgToCmm/Monad.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE ExistentialQuantification #-} ----------------------------------------------------------------------------- -- @@ -64,6 +65,7 @@ import GhcPrelude hiding( sequence, succ ) import GHC.Platform import GHC.Cmm import GHC.StgToCmm.Closure +import GHC.StgToCmm.Types import GHC.Driver.Session import GHC.Cmm.Dataflow.Collections import GHC.Cmm.Graph as CmmGraph @@ -172,15 +174,15 @@ data CgInfoDownwards -- information only passed *downwards* by the monad type CgBindings = IdEnv CgIdInfo data CgIdInfo - = CgIdInfo + = forall a . CgIdInfo { cg_id :: Id -- Id that this is the info for - , cg_lf :: LambdaFormInfo - , cg_loc :: CgLoc -- CmmExpr for the *tagged* value + , cg_lf :: LambdaFormInfo a -- LFI, local or imported + , cg_loc :: CgLoc -- CmmExpr for the *tagged* value } instance Outputable CgIdInfo where - ppr (CgIdInfo { cg_id = id, cg_loc = loc }) - = ppr id <+> text "-->" <+> ppr loc + ppr (CgIdInfo { cg_id = id, cg_loc = loc, cg_lf = lf }) + = ppr id <+> text "-->" <+> ppr loc <+> parens (ppr lf) -- Sequel tells what to do with the result of this expression data Sequel ===================================== compiler/GHC/StgToCmm/Ticky.hs ===================================== @@ -409,7 +409,7 @@ tickyUnknownCall = ifTicky $ bumpTickyCounter (fsLit "UNKNOWN_CALL_ctr") -- Tick for the call pattern at slow call site (i.e. in addition to -- tickyUnknownCall, tickyKnownCallExtraArgs, etc.) -tickySlowCall :: LambdaFormInfo -> [StgArg] -> FCode () +tickySlowCall :: LambdaFormInfo a -> [StgArg] -> FCode () tickySlowCall _ [] = return () tickySlowCall lf_info args = do -- see Note [Ticky for slow calls] @@ -448,7 +448,7 @@ bad for both space and time). -- ----------------------------------------------------------------------------- -- Ticky allocation -tickyDynAlloc :: Maybe Id -> SMRep -> LambdaFormInfo -> FCode () +tickyDynAlloc :: Maybe Id -> SMRep -> LambdaFormInfo a -> FCode () -- Called when doing a dynamic heap allocation; the LambdaFormInfo -- used to distinguish between closure types -- ===================================== compiler/GHC/StgToCmm/Types.hs ===================================== @@ -1,9 +1,19 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP, DataKinds, GADTs, KindSignatures, LambdaCase #-} module GHC.StgToCmm.Types ( WordOff - , LambdaFormInfo (..) + + -- * LambdaFormInfo types + , LFIVariant (..), ImportedLFI, LocalLFI, LambdaFormInfo (..) + , LFReEntrant (..), LFThunk (..) , ModuleLFInfos + + -- * LambdaFormInfo queries + , lfr_top_lvl, lfr_one_shot, lfr_rep_arity, lfr_no_fvs, lfr_arg_descr + , lft_top_lvl, lft_no_fvs, lft_updatable, lft_sfi, lft_mb_fun + + -- * Other stuff + , toImportedLFI , Liveness , ArgDescr (..) , StandardFormInfo (..) @@ -14,9 +24,9 @@ module GHC.StgToCmm.Types import GhcPrelude import BasicTypes -import GHC.Core.DataCon import NameEnv import Outputable +import Name -- | Word offset, or word count type WordOff = Int @@ -25,31 +35,148 @@ type WordOff = Int -- LambdaFormInfo -------------------------------------------------------------------------------- --- | Maps names in the current module to their LambdaFormInfos -type ModuleLFInfos = NameEnv LambdaFormInfo +-- | Type alias for LambdaFormInfos of imported things +type ImportedLFI = LambdaFormInfo 'LFI_Imported --- Information about an identifier, from the code generator's point of view. --- Every identifier is bound to a LambdaFormInfo in the environment, which gives --- the code generator enough info to be able to tail call or return that --- identifier. +-- | Type alias for LambdaForInfos of local things +type LocalLFI = LambdaFormInfo 'LFI_Local + +-- | Maps names in the current module to their exported LambdaFormInfos +type ModuleLFInfos = NameEnv ImportedLFI + +-- | LambdaFormInfo variants +data LFIVariant + = LFI_Imported + | LFI_Local + +-- | LambdaFormInfo for a re-entrant closure (a function) +data LFReEntrant lfi_variant where + LFR_Imported + :: !RepArity + -> LFReEntrant 'LFI_Imported + + LFR_Local + :: !TopLevelFlag + -> !OneShotInfo + -> !RepArity + -> !Bool + -- ^ True <=> no fvs + -> !ArgDescr + -> LFReEntrant 'LFI_Local + +-- | Lambda form info for a thunk (zero arity) +data LFThunk lfi_variant where + LFT_Imported + :: !Bool + -- ^ True <=> updatable (i.e., *not* single-entry) + -> !StandardFormInfo + -> !Bool + -- ^ True <=> *might* be a function type + -> LFThunk 'LFI_Imported + + LFT_Local + :: !TopLevelFlag + -> !Bool + -- ^ True <=> no fvs + -> !Bool + -- ^ True <=> updatable (i.e., *not* single-entry) + -> !StandardFormInfo + -> !Bool + -- ^ True <=> *might* be a function type + -> LFThunk 'LFI_Local + +-------------------------------------------------------------------------------- +-- LambdaFormInfo queries +-------------------------------------------------------------------------------- + +lfr_top_lvl :: LFReEntrant a -> TopLevelFlag +lfr_top_lvl = \case + LFR_Imported _ -> TopLevel + LFR_Local top_lvl _ _ _ _ -> top_lvl + +lfr_one_shot :: LFReEntrant 'LFI_Local -> OneShotInfo +lfr_one_shot (LFR_Local _ one_shot _ _ _) = one_shot + +lfr_rep_arity :: LFReEntrant a -> RepArity +lfr_rep_arity = \case + LFR_Imported arity -> arity + LFR_Local _ _ arity _ _ -> arity + +lfr_no_fvs :: LFReEntrant a -> Bool +lfr_no_fvs = \case + LFR_Imported _ -> True + LFR_Local _ _ _ no_fvs _ -> no_fvs + +lfr_arg_descr :: LFReEntrant 'LFI_Local -> ArgDescr +lfr_arg_descr (LFR_Local _ _ _ _ arg_descr) = arg_descr + +lft_top_lvl :: LFThunk a -> TopLevelFlag +lft_top_lvl = \case + LFT_Imported _ _ _ -> TopLevel + LFT_Local top_lvl _ _ _ _ -> top_lvl + +lft_no_fvs :: LFThunk a -> Bool +lft_no_fvs = \case + LFT_Imported _ _ _ -> True + LFT_Local _ no_fvs _ _ _ -> no_fvs + +lft_updatable :: LFThunk a -> Bool +lft_updatable = \case + LFT_Imported updatable _ _ -> updatable + LFT_Local _ _ updatable _ _ -> updatable -data LambdaFormInfo +lft_sfi :: LFThunk a -> StandardFormInfo +lft_sfi = \case + LFT_Imported _ sfi _ -> sfi + LFT_Local _ _ _ sfi _ -> sfi + +lft_mb_fun :: LFThunk a -> Bool +lft_mb_fun = \case + LFT_Imported _ _ mb_fun -> mb_fun + LFT_Local _ _ _ _ mb_fun -> mb_fun + +-------------------------------------------------------------------------------- +-- Local LFI to imported LFI +-------------------------------------------------------------------------------- + +toImportedLFI :: LambdaFormInfo a -> ImportedLFI +toImportedLFI = \case + LFReEntrant lfr -> LFReEntrant (toImportedLFR lfr) + LFThunk lft -> LFThunk (toImportedLFT lft) + LFCon name tag -> LFCon name tag + LFUnknown mb_fun -> LFUnknown mb_fun + LFUnlifted -> LFUnlifted + LFLetNoEscape -> LFLetNoEscape -- TODO: This case should be unreachable + +toImportedLFR :: LFReEntrant a -> LFReEntrant 'LFI_Imported +toImportedLFR = \case + LFR_Imported arity -> LFR_Imported arity + LFR_Local _ _ arity _ _ -> LFR_Imported arity + +toImportedLFT :: LFThunk a -> LFThunk 'LFI_Imported +toImportedLFT = \case + LFT_Imported updatable sfi mb_fun -> LFT_Imported updatable sfi mb_fun + LFT_Local _ _ updatable sfi mb_fun -> LFT_Imported updatable sfi mb_fun + +-------------------------------------------------------------------------------- + +-- | Information about an identifier, from the code generator's point of view. +-- +-- Local identifiers are bound to a LambdaFormInfo in the environment, which +-- gives the code generator enough info to be able to tail call or return that +-- identifier. +-- +-- Imported identifiers have the information in idLFInfo field. +data LambdaFormInfo (lfi_variant :: LFIVariant) = LFReEntrant -- Reentrant closure (a function) - TopLevelFlag -- True if top level - OneShotInfo - !RepArity -- Arity. Invariant: always > 0 - !Bool -- True <=> no fvs - ArgDescr -- Argument descriptor (should really be in ClosureInfo) + !(LFReEntrant lfi_variant) | LFThunk -- Thunk (zero arity) - TopLevelFlag - !Bool -- True <=> no free vars - !Bool -- True <=> updatable (i.e., *not* single-entry) - StandardFormInfo - !Bool -- True <=> *might* be a function type + !(LFThunk lfi_variant) | LFCon -- A saturated constructor application - DataCon -- The constructor + !Name -- Name of the constructor + !ConTag -- The constructor's (1-based) tag | LFUnknown -- Used for function arguments and imported things. -- We know nothing about this closure. @@ -65,18 +192,40 @@ data LambdaFormInfo | LFUnlifted -- A value of unboxed type; -- always a value, needs evaluation + -- TODO: This should only be available for local LFIs | LFLetNoEscape -- See LetNoEscape module for precise description -instance Outputable LambdaFormInfo where - ppr (LFReEntrant top oneshot rep fvs argdesc) = - text "LFReEntrant" <> brackets (ppr top <+> ppr oneshot <+> - ppr rep <+> pprFvs fvs <+> ppr argdesc) - ppr (LFThunk top hasfv updateable sfi m_function) = - text "LFThunk" <> brackets (ppr top <+> pprFvs hasfv <+> pprUpdateable updateable <+> - ppr sfi <+> pprFuncFlag m_function) - ppr (LFCon con) = text "LFCon" <> brackets (ppr con) - ppr (LFUnknown m_func) = - text "LFUnknown" <> brackets (pprFuncFlag m_func) +instance Outputable (LFReEntrant a) where + ppr (LFR_Imported arity ) = + text "LFReEntrant" <> brackets (ppr arity) + + ppr (LFR_Local top one_shot arity no_fvs arg_desc) = + text "LFReEntrant" <> brackets + (ppr top <+> ppr one_shot <+> + ppr arity <+> pprFvs no_fvs <+> ppr arg_desc) + +instance Outputable (LFThunk a) where + ppr (LFT_Imported updatable sfi mb_fun) = + text "LFThunk" <> brackets (hcat + [ text "upd=" <> ppr updatable + , text "sfi=" <> ppr sfi + , text "mb_fun=" <> ppr mb_fun + ]) + + ppr (LFT_Local top no_fvs updatable sfi mb_fun) = + text "LFThunk" <> brackets (hcat + [ text "top_lvl=" <> ppr top + , text "no_fvs=" <> ppr no_fvs + , text "updatable=" <> ppr updatable + , text "sfi=" <> ppr sfi + , text "mb_fun=" <> ppr mb_fun + ]) + +instance Outputable (LambdaFormInfo a) where + ppr (LFReEntrant lfr) = ppr lfr + ppr (LFThunk lft) = ppr lft + ppr (LFCon name _tag) = text "LFCon" <> brackets (ppr name) + ppr (LFUnknown mb_fun) = text "LFUnknown" <> brackets (pprFuncFlag mb_fun) ppr LFUnlifted = text "LFUnlifted" ppr LFLetNoEscape = text "LFLetNoEscape" @@ -88,10 +237,6 @@ pprFuncFlag :: Bool -> SDoc pprFuncFlag True = text "mFunc" pprFuncFlag False = text "value" -pprUpdateable :: Bool -> SDoc -pprUpdateable True = text "updateable" -pprUpdateable False = text "oneshot" - -------------------------------------------------------------------------------- -- | We represent liveness bitmaps as a Bitmap (whose internal representation @@ -114,16 +259,11 @@ data ArgDescr | ArgGen -- General case Liveness -- Details about the arguments - - | ArgUnknown -- For imported binds. - -- Invariant: Never Unknown for binds of the module - -- we are compiling. deriving (Eq) instance Outputable ArgDescr where ppr (ArgSpec n) = text "ArgSpec" <+> ppr n ppr (ArgGen ls) = text "ArgGen" <+> ppr ls - ppr ArgUnknown = text "ArgUnknown" -------------------------------------------------------------------------------- -- | StandardFormInfo tells whether this thunk has one of a small number of ===================================== compiler/basicTypes/Id.hs ===================================== @@ -734,15 +734,15 @@ setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id --------------------------------- -- Lambda form info -idLFInfo :: HasCallStack => Id -> LambdaFormInfo +idLFInfo :: HasCallStack => Id -> ImportedLFI idLFInfo id = case lfInfo (idInfo id) of Nothing -> pprPanic "idLFInfo" (text "LFInfo not available for Id" <+> ppr id) - Just lf_info -> lf_info + Just lfi -> lfi -idLFInfo_maybe :: Id -> Maybe LambdaFormInfo +idLFInfo_maybe :: Id -> Maybe ImportedLFI idLFInfo_maybe = lfInfo . idInfo -setIdLFInfo :: Id -> LambdaFormInfo -> Id +setIdLFInfo :: Id -> ImportedLFI -> Id setIdLFInfo id lf = modifyIdInfo (`setLFInfo` lf) id --------------------------------- ===================================== compiler/basicTypes/IdInfo.hs ===================================== @@ -75,7 +75,7 @@ module IdInfo ( cafInfo, setCafInfo, -- ** The LambdaFormInfo type - LambdaFormInfo(..), + LambdaFormInfo(..), ImportedLFI, lfInfo, setLFInfo, -- ** Tick-box Info @@ -108,7 +108,7 @@ import Demand import Cpr import Util -import GHC.StgToCmm.Types (LambdaFormInfo (..)) +import GHC.StgToCmm.Types (LambdaFormInfo (..), ImportedLFI) -- infixl so you can say (id `set` a `set` b) infixl 1 `setRuleInfo`, @@ -278,7 +278,11 @@ data IdInfo -- n <=> all calls have at least n arguments levityInfo :: LevityInfo, -- ^ when applied, will this Id ever have a levity-polymorphic type? - lfInfo :: !(Maybe LambdaFormInfo) + lfInfo :: !(Maybe ImportedLFI) + -- ^ Lambda form info of the Id. Not available in two cases: + -- + -- 1. The Id is wired-in and we haven't given it an LFI + -- 2. The Id is local to the module being compiled } -- Setters @@ -308,7 +312,7 @@ setCallArityInfo info ar = info { callArityInfo = ar } setCafInfo :: IdInfo -> CafInfo -> IdInfo setCafInfo info caf = info { cafInfo = caf } -setLFInfo :: IdInfo -> LambdaFormInfo -> IdInfo +setLFInfo :: IdInfo -> ImportedLFI -> IdInfo setLFInfo info lf = info { lfInfo = Just lf } setOneShotInfo :: IdInfo -> OneShotInfo -> IdInfo ===================================== compiler/main/UpdateCafInfos.hs ===================================== @@ -17,7 +17,7 @@ import NameSet import Util import Var import Outputable -import GHC.StgToCmm.Types (ModuleLFInfos) +import GHC.StgToCmm.Types (ModuleLFInfos, toImportedLFI) #include "HsVersions.h" @@ -106,7 +106,7 @@ updateIdCafInfo non_cafs lf_infos id = id1 = if not_caffy then setIdCafInfo id NoCafRefs else id id2 = case mb_lf_info of Nothing -> id1 - Just lf_info -> setIdLFInfo id1 lf_info + Just lf_info -> setIdLFInfo id1 (toImportedLFI lf_info) in id2 ===================================== testsuite/tests/codeGen/should_compile/Makefile ===================================== @@ -64,7 +64,7 @@ T17648: # NoCafRefs) to the interface files. '$(TEST_HC)' $(TEST_HC_OPTS) -dno-typeable-binds -O T17648.hs -v0 '$(TEST_HC)' --show-iface T17648.hi | tr -d '\n' | \ - grep -F 'f :: T GHC.Types.Int -> () [HasNoCafRefs, LambdaFormInfo' >/dev/null + grep -F 'f :: T GHC.Types.Int -> () [HasNoCafRefs, LambdaFormInfo' >/dev/null # Second compilation with -fcatch-bottoms, f should be CAFFY '$(TEST_HC)' $(TEST_HC_OPTS) -dno-typeable-binds -O \ ===================================== testsuite/tests/simplCore/should_compile/Makefile ===================================== @@ -102,7 +102,7 @@ T4201: '$(TEST_HC)' $(TEST_HC_OPTS) -c -O T4201.hs '$(TEST_HC)' $(TEST_HC_OPTS) --show-iface T4201.hi > T4201.list # poor man idea about how to replace GNU grep -B2 "Sym" invocation with pure POSIX tools - for i in `grep -n "Sym" T4201.list | cut -d ':' -f -1`; do head -$$i T4201.list | tail -5; done + for i in `grep -n "Sym" T4201.list | cut -d ':' -f -1`; do head -$$i T4201.list | tail -4; done $(RM) -f T4201.list # This one looped as a result of bogus specialisation ===================================== testsuite/tests/simplCore/should_compile/T4201.stdout ===================================== @@ -1,5 +1,4 @@ - [HasNoCafRefs, - LambdaFormInfo: LFReEntrant (NoOneShotInfo, 1, True), Arity: 1, + [HasNoCafRefs, LambdaFormInfo: LFReEntrant 1, Arity: 1, Strictness: , CPR: m1, Unfolding: InlineRule (0, True, True) bof `cast` (Sym (N:Foo[0]) ->_R _R)] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/168a1ebb1793513203f81af92dd6d023c20dd996 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/168a1ebb1793513203f81af92dd6d023c20dd996 You're receiving 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 Mar 24 10:51:35 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 24 Mar 2020 06:51:35 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/dmdanal-remove-killUsage Message-ID: <5e79e637bd47b_6167e6514b4274170@gitlab.haskell.org.mail> Sebastian Graf pushed new branch wip/dmdanal-remove-killUsage at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/dmdanal-remove-killUsage You're receiving 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 Mar 24 11:01:21 2020 From: gitlab at gitlab.haskell.org (Peter Trommler) Date: Tue, 24 Mar 2020 07:01:21 -0400 Subject: [Git][ghc/ghc][wip/T11531] 96 commits: Be explicit about how stack usage of mvar primops are covered. Message-ID: <5e79e881e445e_61675cefcac279765@gitlab.haskell.org.mail> Peter Trommler pushed to branch wip/T11531 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 - - - - - 02ff54ab by Peter Trommler at 2020-03-24T12:00:18+01:00 Do not panic on linker errors - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/linters/check-cpp.py - compiler/GHC.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/InfoTable.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/Dataflow/Block.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Graph.hs - compiler/GHC/Cmm/Info.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/Ppr.hs - compiler/GHC/Cmm/Ppr/Decl.hs - compiler/GHC/Cmm/Ppr/Expr.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Switch/Implement.hs - compiler/GHC/Cmm/Type.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/BlockLayout.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/06503a464b1befa090077fd822236be297f9f8fb...02ff54ab3f35c4f25f480e2f8cbd8edbfdf75512 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/06503a464b1befa090077fd822236be297f9f8fb...02ff54ab3f35c4f25f480e2f8cbd8edbfdf75512 You're receiving 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 Mar 24 11:09:32 2020 From: gitlab at gitlab.haskell.org (Peter Trommler) Date: Tue, 24 Mar 2020 07:09:32 -0400 Subject: [Git][ghc/ghc][wip/T11531] Do not panic on linker errors Message-ID: <5e79ea6c69309_61673f8198ee100c282051@gitlab.haskell.org.mail> Peter Trommler pushed to branch wip/T11531 at Glasgow Haskell Compiler / GHC Commits: 3a32ba75 by Peter Trommler at 2020-03-24T12:09:14+01:00 Do not panic on linker errors - - - - - 7 changed files: - compiler/GHC/Runtime/Linker.hs - testsuite/tests/ghci/linking/Makefile - + testsuite/tests/ghci/linking/T11531.c - + testsuite/tests/ghci/linking/T11531.h - + testsuite/tests/ghci/linking/T11531.hs - + testsuite/tests/ghci/linking/T11531.stderr - testsuite/tests/ghci/linking/all.T Changes: ===================================== compiler/GHC/Runtime/Linker.hs ===================================== @@ -187,7 +187,7 @@ getHValue hsc_env name = do m <- lookupClosure hsc_env (unpackFS sym_to_find) case m of Just hvref -> mkFinalizedHValue hsc_env hvref - Nothing -> linkFail "GHC.ByteCode.Linker.lookupCE" + Nothing -> linkFail "GHC.Runtime.Linker.getHValue" (unpackFS sym_to_find) linkDependencies :: HscEnv -> PersistentLinkerState @@ -472,7 +472,7 @@ preloadLib hsc_env lib_paths framework_paths pls lib_spec = do Nothing -> maybePutStrLn dflags "done" Just mm -> preloadFailed mm framework_paths lib_spec return pls - else panic "preloadLib Framework" + else throwGhcExceptionIO (ProgramError "preloadLib Framework") where dflags = hsc_dflags hsc_env @@ -964,7 +964,9 @@ dynLoadObjs hsc_env pls at PersistentLinkerState{..} objs = do m <- loadDLL hsc_env soFile case m of Nothing -> return $! pls { temp_sos = (libPath, libName) : temp_sos } - Just err -> panic ("Loading temp shared object failed: " ++ err) + Just err -> linkFail msg err + where + msg = "GHC.Runtime.Linker.dynLoadObjs: Loading temp shared object failed" rmDupLinkables :: [Linkable] -- Already loaded -> [Linkable] -- New linkables ===================================== testsuite/tests/ghci/linking/Makefile ===================================== @@ -127,6 +127,11 @@ T3333: "$(TEST_HC)" -c T3333.c -o T3333.o echo "weak_test 10" | "$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) T3333.hs T3333.o +.PHONY: T11531 +T11531: + $(CC) $(CFLAGS) -fPIC -c T11531.c -o T11531.o + - echo ":q" | "$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) T11531.o T11531.hs 2>&1 | sed -e '/undefined symbol:/d' 1>&2 + .PHONY: T14708 T14708: $(RM) -rf T14708scratch ===================================== testsuite/tests/ghci/linking/T11531.c ===================================== @@ -0,0 +1,9 @@ +extern void undefined_function(void); + +int some_function(int d) { + return 64; +} + +void __attribute__ ((constructor)) setup(void) { + undefined_function(); +} ===================================== testsuite/tests/ghci/linking/T11531.h ===================================== @@ -0,0 +1,2 @@ +int some_function(int d); + ===================================== testsuite/tests/ghci/linking/T11531.hs ===================================== @@ -0,0 +1,3 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +foreign import ccall "T11531.h some_function" someFunction :: Int -> Int ===================================== testsuite/tests/ghci/linking/T11531.stderr ===================================== @@ -0,0 +1,11 @@ + +GHC.Runtime.Linker.dynLoadObjs: Loading temp shared object failed +During interactive linking, GHCi couldn't find the following symbol: +This may be due to you not asking GHCi to load extra object files, +archives or DLLs needed by your current session. Restart GHCi, specifying +the missing library using the -L/path/to/object/dir and -lmissinglibname +flags, or simply by naming the relevant files on the GHCi command line. +Alternatively, this link failure might indicate a bug in GHCi. +If you suspect the latter, please report this as a GHC bug: + https://www.haskell.org/ghc/reportabug + ===================================== testsuite/tests/ghci/linking/all.T ===================================== @@ -43,6 +43,11 @@ test('T3333', expect_broken(3333))], makefile_test, ['T3333']) +test('T11531', + [extra_files(['T11531.hs', 'T11531.c', 'T11531.h']), + unless(doing_ghci, skip)], + makefile_test, ['T11531']) + test('T14708', [extra_files(['T14708.hs', 'add.c']), unless(doing_ghci, skip), View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3a32ba7525a255ecb6fd8e8c2da1d23a4f657851 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3a32ba7525a255ecb6fd8e8c2da1d23a4f657851 You're receiving 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 Mar 24 12:31:08 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 24 Mar 2020 08:31:08 -0400 Subject: [Git][ghc/ghc][master] Fix ApplicativeDo regression #17835 Message-ID: <5e79fd8c284cb_61677b155d82974db@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 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. - - - - - 6 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Rename/Expr.hs - testsuite/tests/ado/T13242a.stderr - + testsuite/tests/ado/T17835.hs - testsuite/tests/ado/ado001.stdout - testsuite/tests/ado/all.T Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -2274,22 +2274,31 @@ pprStmt (ApplicativeStmt _ args mb_join) (if lengthAtLeast args 2 then parens else id) ap_expr pp_arg :: (a, ApplicativeArg (GhcPass idL)) -> SDoc - pp_arg (_, ApplicativeArgOne _ pat expr isBody _) - | isBody = -- See Note [Applicative BodyStmt] - ppr (BodyStmt (panic "pprStmt") expr noSyntaxExpr noSyntaxExpr + pp_arg (_, applicativeArg) = ppr applicativeArg + +pprStmt (XStmtLR x) = ppr x + + +instance (OutputableBndrId idL) + => Outputable (ApplicativeArg (GhcPass idL)) where + ppr = pprArg + +pprArg :: forall idL . (OutputableBndrId idL) => ApplicativeArg (GhcPass idL) -> SDoc +pprArg (ApplicativeArgOne _ pat expr isBody _) + | isBody = -- See Note [Applicative BodyStmt] + ppr (BodyStmt (panic "pprStmt") expr noSyntaxExpr noSyntaxExpr :: ExprStmt (GhcPass idL)) - | otherwise = - ppr (BindStmt (panic "pprStmt") pat expr noSyntaxExpr noSyntaxExpr + | otherwise = + ppr (BindStmt (panic "pprStmt") pat expr noSyntaxExpr noSyntaxExpr :: ExprStmt (GhcPass idL)) - pp_arg (_, ApplicativeArgMany _ stmts return pat) = +pprArg (ApplicativeArgMany _ stmts return pat) = ppr pat <+> text "<-" <+> ppr (HsDo (panic "pprStmt") DoExpr (noLoc (stmts ++ [noLoc (LastStmt noExtField (noLoc return) Nothing noSyntaxExpr)]))) - pp_arg (_, XApplicativeArg x) = ppr x -pprStmt (XStmtLR x) = ppr x +pprArg (XApplicativeArg x) = ppr x pprTransformStmt :: (OutputableBndrId p) => [IdP (GhcPass p)] -> LHsExpr (GhcPass p) ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -1498,7 +1498,7 @@ ApplicativeDo touches a few phases in the compiler: scheduled as outlined above and transformed into applicative combinators. However, the code is still represented as a do-block with special forms of applicative statements. This allows us to - recover the original do-block when e.g. printing type errors, where + recover the original do-block when e.g. printing type errors, where we don't want to show any of the applicative combinators since they don't exist in the source code. See ApplicativeStmt and ApplicativeArg in HsExpr. @@ -1682,7 +1682,7 @@ stmtTreeToStmts monad_names ctxt (StmtTreeOne (L _ (BindStmt _ pat rhs _ fail_op , is_body_stmt = False , fail_operator = fail_op}] False tail' -stmtTreeToStmts monad_names ctxt (StmtTreeOne (L _ (BodyStmt _ rhs _ fail_op),_)) +stmtTreeToStmts monad_names ctxt (StmtTreeOne (L _ (BodyStmt _ rhs _ _),_)) tail _tail_fvs | (False,tail') <- needJoin monad_names tail = mkApplicativeStmt ctxt @@ -1691,7 +1691,7 @@ stmtTreeToStmts monad_names ctxt (StmtTreeOne (L _ (BodyStmt _ rhs _ fail_op),_) , app_arg_pattern = nlWildPatName , arg_expr = rhs , is_body_stmt = True - , fail_operator = fail_op}] False tail' + , fail_operator = noSyntaxExpr}] False tail' stmtTreeToStmts _monad_names _ctxt (StmtTreeOne (s,_)) tail _tail_fvs = return (s : tail, emptyNameSet) @@ -1706,7 +1706,8 @@ stmtTreeToStmts monad_names ctxt (StmtTreeApplicative trees) tail tail_fvs = do pairs <- mapM (stmtTreeArg ctxt tail_fvs) trees let (stmts', fvss) = unzip pairs let (need_join, tail') = - if any hasStrictPattern trees + -- See Note [ApplicativeDo and refutable patterns] + if any hasRefutablePattern stmts' then (True, tail) else needJoin monad_names tail @@ -1721,13 +1722,13 @@ stmtTreeToStmts monad_names ctxt (StmtTreeApplicative trees) tail tail_fvs = do , is_body_stmt = False , fail_operator = fail_op }, emptyFVs) - stmtTreeArg _ctxt _tail_fvs (StmtTreeOne (L _ (BodyStmt _ exp _ fail_op), _)) = + stmtTreeArg _ctxt _tail_fvs (StmtTreeOne (L _ (BodyStmt _ exp _ _), _)) = return (ApplicativeArgOne { xarg_app_arg_one = noExtField , app_arg_pattern = nlWildPatName , arg_expr = exp , is_body_stmt = True - , fail_operator = fail_op + , fail_operator = noSyntaxExpr }, emptyFVs) stmtTreeArg ctxt tail_fvs tree = do let stmts = flattenStmtTree tree @@ -1854,12 +1855,19 @@ isStrictPattern lpat = SplicePat{} -> True _otherwise -> panic "isStrictPattern" -hasStrictPattern :: ExprStmtTree -> Bool -hasStrictPattern (StmtTreeOne (L _ (BindStmt _ pat _ _ _), _)) = isStrictPattern pat -hasStrictPattern (StmtTreeOne _) = False -hasStrictPattern (StmtTreeBind a b) = hasStrictPattern a || hasStrictPattern b -hasStrictPattern (StmtTreeApplicative trees) = any hasStrictPattern trees +{- +Note [ApplicativeDo and refutable patterns] + +Refutable patterns in do blocks are desugared to use the monadic 'fail' operation. +This means that sometimes an applicative block needs to be wrapped in 'join' simply because +of a refutable pattern, in order for the types to work out. + +-} +hasRefutablePattern :: ApplicativeArg GhcRn -> Bool +hasRefutablePattern (ApplicativeArgOne { app_arg_pattern = pat + , is_body_stmt = False}) = not (isIrrefutableHsPat pat) +hasRefutablePattern _ = False isLetStmt :: LStmt a b -> Bool isLetStmt (L _ LetStmt{}) = True ===================================== testsuite/tests/ado/T13242a.stderr ===================================== @@ -32,10 +32,15 @@ T13242a.hs:13:11: error: ...plus 21 others ...plus six instances involving out-of-scope types (use -fprint-potential-instances to see them all) - • In the first argument of ‘return’, namely ‘(x == x)’ In a stmt of a 'do' block: return (x == x) In the expression: do A x <- undefined _ <- return 'a' _ <- return 'b' return (x == x) + In an equation for ‘test’: + test + = do A x <- undefined + _ <- return 'a' + _ <- return 'b' + return (x == x) ===================================== testsuite/tests/ado/T17835.hs ===================================== @@ -0,0 +1,38 @@ +-- Build.hs +{-# LANGUAGE ApplicativeDo #-} +module Build (configRules) where + +type Action = IO +type Rules = IO + +type Config = () + +(%>) :: String -> (String -> Action ()) -> Rules () +(%>) = undefined + +command_ :: [String] -> String -> [String] -> Action () +command_ = undefined + +recursive :: Config -> String -> [String] -> IO (FilePath, [String]) +recursive = undefined + +liftIO :: IO a -> Action a +liftIO = id + +need :: [String] -> Action () +need = undefined + +historyDisable :: Action () +historyDisable = undefined + +get_config :: () -> Action Config +get_config = undefined + +configRules :: Rules () +configRules = do + "snapshot" %> \out -> do + historyDisable -- 8.10-rc1 refuses to compile without bind here + config <- get_config () + need [] + (exe,args) <- liftIO $ recursive config "snapshot" [] + command_ [] exe args ===================================== testsuite/tests/ado/ado001.stdout ===================================== @@ -9,4 +9,4 @@ a; ((b | c) | d) ((a | (b; c)) | d) | e ((a | b); (c | d)) | e a | b -(a | (b; c)) +a | (b; c) ===================================== testsuite/tests/ado/all.T ===================================== @@ -17,3 +17,4 @@ test('T13875', normal, compile_and_run, ['']) test('T14163', normal, compile_and_run, ['']) test('T15344', normal, compile_and_run, ['']) test('T16628', normal, compile_fail, ['']) +test('T17835', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/19f125578247dfe8036b5793cb3f6b684474f9c7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/19f125578247dfe8036b5793cb3f6b684474f9c7 You're receiving 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 Mar 24 12:31:41 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 24 Mar 2020 08:31:41 -0400 Subject: [Git][ghc/ghc][master] Add example and doc for Arg (Fixes #17153) Message-ID: <5e79fdad79397_61671196b3f4301199@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 2643ba46 by Paavo at 2020-03-24T08:31:32-04:00 Add example and doc for Arg (Fixes #17153) - - - - - 1 changed file: - libraries/base/Data/Semigroup.hs Changes: ===================================== libraries/base/Data/Semigroup.hs ===================================== @@ -286,7 +286,15 @@ instance Num a => Num (Max a) where -- | 'Arg' isn't itself a 'Semigroup' in its own right, but it can be -- placed inside 'Min' and 'Max' to compute an arg min or arg max. -data Arg a b = Arg a b deriving +-- +-- >>> minimum [ Arg (x * x) x | x <- [-10 .. 10] ] +-- Arg 0 0 +data Arg a b = Arg + a + -- ^ The argument used for comparisons in 'Eq' and 'Ord'. + b + -- ^ The "value" exposed via the 'Functor', 'Foldable' etc. instances. + deriving ( Show -- ^ @since 4.9.0.0 , Read -- ^ @since 4.9.0.0 , Data -- ^ @since 4.9.0.0 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2643ba465cd2a133b6f495f34fc59cd1a6d23525 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2643ba465cd2a133b6f495f34fc59cd1a6d23525 You're receiving 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 Mar 24 14:09:39 2020 From: gitlab at gitlab.haskell.org (Josh Meredith) Date: Tue, 24 Mar 2020 10:09:39 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/extensible-interface-files Message-ID: <5e7a14a340cc5_6167e0e2c9431798e@gitlab.haskell.org.mail> Josh Meredith pushed new branch wip/extensible-interface-files at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/extensible-interface-files You're receiving 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 Mar 24 14:23:43 2020 From: gitlab at gitlab.haskell.org (Josh Meredith) Date: Tue, 24 Mar 2020 10:23:43 -0400 Subject: [Git][ghc/ghc][wip/extensible-interface-files] 17 commits: fs.h: Add missing declarations on Windows Message-ID: <5e7a17efac9eb_61671196b3f4320961@gitlab.haskell.org.mail> Josh Meredith pushed to branch wip/extensible-interface-files at Glasgow Haskell Compiler / GHC Commits: 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) - - - - - 80bdf40f by Josh Meredith at 2020-03-25T01:22:34+11:00 Implement extensible interface files - - - - - a744686d by Josh Meredith at 2020-03-25T01:22:34+11:00 Remove redundant import - - - - - ad4f780f by Josh Meredith at 2020-03-25T01:22:35+11:00 Change expected stdout for hi file Docs tests - - - - - 63cef464 by Josh Meredith at 2020-03-25T01:22:35+11:00 Add comment subtitle section for BinData - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/Driver/Types.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Iface/Binary.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Rename/Expr.hs - compiler/utils/Binary.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Builders/RunTest.hs - libraries/base/Data/Foldable.hs - libraries/base/Data/Semigroup.hs - libraries/process - testsuite/tests/ado/T13242a.stderr - + testsuite/tests/ado/T17835.hs - testsuite/tests/ado/ado001.stdout - testsuite/tests/ado/all.T - testsuite/tests/driver/T12062/Makefile - + testsuite/tests/driver/T365.stderr-mingw32 - testsuite/tests/ghc-api/annotations/all.T - + testsuite/tests/ghc-api/annotations/annotations.stdout-mingw32 - + testsuite/tests/ghc-api/annotations/listcomps.stdout-mingw32 - + testsuite/tests/ghc-api/annotations/parseTree.stdout-mingw32 - testsuite/tests/ghci/scripts/T9293.stdout-mingw32 - testsuite/tests/ghci/scripts/ghci024.stdout-mingw32 - testsuite/tests/ghci/scripts/ghci057.stdout-mingw32 - testsuite/tests/showIface/DocsInHiFile0.stdout - testsuite/tests/showIface/DocsInHiFile1.stdout - utils/fs/fs.h - utils/hsc2hs Changes: ===================================== .gitlab-ci.yml ===================================== @@ -806,9 +806,6 @@ validate-x86_64-linux-fedora27: # which might result in some broken perf tests? HADRIAN_ARGS: "--docs=no-sphinx --skip-perf" - # due to #16574 this currently fails - allow_failure: true - script: - bash .gitlab/ci.sh configure - bash .gitlab/ci.sh build_hadrian ===================================== compiler/GHC/Driver/Types.hs ===================================== @@ -147,7 +147,14 @@ module GHC.Driver.Types ( -- * COMPLETE signature CompleteMatch(..), CompleteMatchMap, - mkCompleteMatchMap, extendCompleteMatchMap + mkCompleteMatchMap, extendCompleteMatchMap, + + -- * Exstensible Iface fields + ExtensibleFields(..), FieldName, + emptyExtensibleFields, + readField, readIfaceField, readIfaceFieldWith, + writeField, writeIfaceField, writeIfaceFieldWith, + deleteField, deleteIfaceField, ) where #include "HsVersions.h" @@ -215,8 +222,10 @@ import GHC.Serialized ( Serialized ) import qualified GHC.LanguageExtensions as LangExt import Foreign -import Control.Monad ( guard, liftM, ap ) +import Control.Monad ( guard, liftM, ap, forM, forM_, replicateM ) import Data.IORef +import Data.Map ( Map ) +import qualified Data.Map as Map import Data.Time import Exception import System.FilePath @@ -1090,9 +1099,17 @@ data ModIface_ (phase :: ModIfacePhase) mi_arg_docs :: ArgDocMap, -- ^ Docs on arguments. - mi_final_exts :: !(IfaceBackendExts phase) + mi_final_exts :: !(IfaceBackendExts phase), -- ^ Either `()` or `ModIfaceBackend` for -- a fully instantiated interface. + + mi_ext_fields :: ExtensibleFields + -- ^ Additional optional fields, where the Map key represents + -- the field name, resulting in a (size, serialized data) pair. + -- Because the data is intended to be serialized through the + -- internal `Binary` class (increasing compatibility with types + -- using `Name` and `FastString`, such as HIE), this format is + -- chosen over `ByteString`s. } -- | Old-style accessor for whether or not the ModIface came from an hs-boot @@ -1164,6 +1181,9 @@ instance Binary ModIface where mi_doc_hdr = doc_hdr, mi_decl_docs = decl_docs, mi_arg_docs = arg_docs, + mi_ext_fields = _ext_fields, -- Don't `put_` this in the instance so we + -- can deal with it's pointer in the header + -- when we write the actual file mi_final_exts = ModIfaceBackend { mi_iface_hash = iface_hash, mi_mod_hash = mod_hash, @@ -1264,6 +1284,8 @@ instance Binary ModIface where mi_doc_hdr = doc_hdr, mi_decl_docs = decl_docs, mi_arg_docs = arg_docs, + mi_ext_fields = emptyExtensibleFields, -- placeholder because this is dealt + -- with specially when the file is read mi_final_exts = ModIfaceBackend { mi_iface_hash = iface_hash, mi_mod_hash = mod_hash, @@ -1307,7 +1329,9 @@ emptyPartialModIface mod mi_doc_hdr = Nothing, mi_decl_docs = emptyDeclDocMap, mi_arg_docs = emptyArgDocMap, - mi_final_exts = () } + mi_final_exts = (), + mi_ext_fields = emptyExtensibleFields + } emptyFullModIface :: Module -> ModIface emptyFullModIface mod = @@ -3279,7 +3303,105 @@ phaseForeignLanguage phase = case phase of -- avoid major space leaks. instance (NFData (IfaceBackendExts (phase :: ModIfacePhase)), NFData (IfaceDeclExts (phase :: ModIfacePhase))) => NFData (ModIface_ phase) where rnf (ModIface f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 - f13 f14 f15 f16 f17 f18 f19 f20 f21 f22 f23) = + f13 f14 f15 f16 f17 f18 f19 f20 f21 f22 f23 f24) = rnf f1 `seq` rnf f2 `seq` f3 `seq` f4 `seq` f5 `seq` f6 `seq` rnf f7 `seq` f8 `seq` f9 `seq` rnf f10 `seq` rnf f11 `seq` f12 `seq` rnf f13 `seq` rnf f14 `seq` rnf f15 `seq` rnf f16 `seq` f17 `seq` rnf f18 `seq` rnf f19 `seq` f20 `seq` f21 `seq` f22 `seq` rnf f23 + `seq` rnf f24 + +{- +************************************************************************ +* * +\subsection{Extensible Iface Fields} +* * +************************************************************************ +-} + +type FieldName = String + +newtype ExtensibleFields = ExtensibleFields { getExtensibleFields :: (Map FieldName BinData) } + +instance Binary ExtensibleFields where + put_ bh (ExtensibleFields fs) = do + put_ bh (Map.size fs :: Int) + + -- Put the names of each field, and reserve a space + -- for a payload pointer after each name: + header_entries <- forM (Map.toList fs) $ \(name, dat) -> do + put_ bh name + field_p_p <- tellBin bh + put_ bh field_p_p + return (field_p_p, dat) + + -- Now put the payloads and use the reserved space + -- to point to the start of each payload: + forM_ header_entries $ \(field_p_p, dat) -> do + field_p <- tellBin bh + putAt bh field_p_p field_p + seekBin bh field_p + put_ bh dat + + get bh = do + n <- get bh :: IO Int + + -- Get the names and field pointers: + header_entries <- replicateM n $ do + (,) <$> get bh <*> get bh + + -- Seek to and get each field's payload: + fields <- forM header_entries $ \(name, field_p) -> do + seekBin bh field_p + dat <- get bh + return (name, dat) + + return . ExtensibleFields . Map.fromList $ fields + +instance NFData ExtensibleFields where + rnf (ExtensibleFields fs) = rnf fs + +emptyExtensibleFields :: ExtensibleFields +emptyExtensibleFields = ExtensibleFields Map.empty + +-------------------------------------------------------------------------------- +-- | Reading + +readIfaceField :: Binary a => FieldName -> ModIface -> IO (Maybe a) +readIfaceField name = readIfaceFieldWith name get + +readField :: Binary a => FieldName -> ExtensibleFields -> IO (Maybe a) +readField name = readFieldWith name get + +readIfaceFieldWith :: FieldName -> (BinHandle -> IO a) -> ModIface -> IO (Maybe a) +readIfaceFieldWith name read iface = readFieldWith name read (mi_ext_fields iface) + +readFieldWith :: FieldName -> (BinHandle -> IO a) -> ExtensibleFields -> IO (Maybe a) +readFieldWith name read fields = sequence $ ((read =<<) . dataHandle) <$> + Map.lookup name (getExtensibleFields fields) + +-------------------------------------------------------------------------------- +-- | Writing + +writeIfaceField :: Binary a => FieldName -> a -> ModIface -> IO ModIface +writeIfaceField name x = writeIfaceFieldWith name (`put_` x) + +writeField :: Binary a => FieldName -> a -> ExtensibleFields -> IO ExtensibleFields +writeField name x = writeFieldWith name (`put_` x) + +writeIfaceFieldWith :: FieldName -> (BinHandle -> IO ()) -> ModIface -> IO ModIface +writeIfaceFieldWith name write iface = do + fields <- writeFieldWith name write (mi_ext_fields iface) + return iface{ mi_ext_fields = fields } + +writeFieldWith :: FieldName -> (BinHandle -> IO ()) -> ExtensibleFields -> IO ExtensibleFields +writeFieldWith name write fields = do + bh <- openBinMem (1024 * 1024) + write bh + -- + bd <- handleData bh + return $ ExtensibleFields (Map.insert name bd $ getExtensibleFields fields) + +deleteField :: FieldName -> ExtensibleFields -> ExtensibleFields +deleteField name (ExtensibleFields fs) = ExtensibleFields $ Map.delete name fs + +deleteIfaceField :: FieldName -> ModIface -> ModIface +deleteIfaceField name iface = iface { mi_ext_fields = deleteField name (mi_ext_fields iface) } ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -2274,22 +2274,31 @@ pprStmt (ApplicativeStmt _ args mb_join) (if lengthAtLeast args 2 then parens else id) ap_expr pp_arg :: (a, ApplicativeArg (GhcPass idL)) -> SDoc - pp_arg (_, ApplicativeArgOne _ pat expr isBody _) - | isBody = -- See Note [Applicative BodyStmt] - ppr (BodyStmt (panic "pprStmt") expr noSyntaxExpr noSyntaxExpr + pp_arg (_, applicativeArg) = ppr applicativeArg + +pprStmt (XStmtLR x) = ppr x + + +instance (OutputableBndrId idL) + => Outputable (ApplicativeArg (GhcPass idL)) where + ppr = pprArg + +pprArg :: forall idL . (OutputableBndrId idL) => ApplicativeArg (GhcPass idL) -> SDoc +pprArg (ApplicativeArgOne _ pat expr isBody _) + | isBody = -- See Note [Applicative BodyStmt] + ppr (BodyStmt (panic "pprStmt") expr noSyntaxExpr noSyntaxExpr :: ExprStmt (GhcPass idL)) - | otherwise = - ppr (BindStmt (panic "pprStmt") pat expr noSyntaxExpr noSyntaxExpr + | otherwise = + ppr (BindStmt (panic "pprStmt") pat expr noSyntaxExpr noSyntaxExpr :: ExprStmt (GhcPass idL)) - pp_arg (_, ApplicativeArgMany _ stmts return pat) = +pprArg (ApplicativeArgMany _ stmts return pat) = ppr pat <+> text "<-" <+> ppr (HsDo (panic "pprStmt") DoExpr (noLoc (stmts ++ [noLoc (LastStmt noExtField (noLoc return) Nothing noSyntaxExpr)]))) - pp_arg (_, XApplicativeArg x) = ppr x -pprStmt (XStmtLR x) = ppr x +pprArg (XApplicativeArg x) = ppr x pprTransformStmt :: (OutputableBndrId p) => [IdP (GhcPass p)] -> LHsExpr (GhcPass p) ===================================== compiler/GHC/Iface/Binary.hs ===================================== @@ -148,7 +148,15 @@ readBinIface_ dflags checkHiWay traceBinIFaceReading hi_path ncu = do wantedGot "Way" way_descr check_way ppr when (checkHiWay == CheckHiWay) $ errorOnMismatch "mismatched interface file ways" way_descr check_way - getWithUserData ncu bh + + extFields_p <- get bh + + mod_iface <- getWithUserData ncu bh + + seekBin bh extFields_p + extFields <- get bh + + return mod_iface{mi_ext_fields = extFields} -- | This performs a get action after reading the dictionary and symbol @@ -200,8 +208,16 @@ writeBinIface dflags hi_path mod_iface = do let way_descr = getWayDescr dflags put_ bh way_descr + extFields_p_p <- tellBin bh + put_ bh extFields_p_p putWithUserData (debugTraceMsg dflags 3) bh mod_iface + + extFields_p <- tellBin bh + putAt bh extFields_p_p extFields_p + seekBin bh extFields_p + put_ bh (mi_ext_fields mod_iface) + -- And send the result to the file writeBinMem bh hi_path ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -48,6 +48,7 @@ import GHC.Driver.Types import BasicTypes hiding (SuccessFlag(..)) import TcRnMonad +import Binary ( BinData(..) ) import Constants import PrelNames import PrelInfo @@ -83,6 +84,7 @@ import GHC.Driver.Plugins import Control.Monad import Control.Exception import Data.IORef +import Data.Map ( toList ) import System.FilePath import System.Directory @@ -1159,6 +1161,7 @@ pprModIface iface at ModIface{ mi_final_exts = exts } , text "module header:" $$ nest 2 (ppr (mi_doc_hdr iface)) , text "declaration docs:" $$ nest 2 (ppr (mi_decl_docs iface)) , text "arg docs:" $$ nest 2 (ppr (mi_arg_docs iface)) + , text "extensible fields:" $$ nest 2 (pprExtensibleFields (mi_ext_fields iface)) ] where pp_hsc_src HsBootFile = text "[boot]" @@ -1248,6 +1251,11 @@ pprIfaceAnnotation :: IfaceAnnotation -> SDoc pprIfaceAnnotation (IfaceAnnotation { ifAnnotatedTarget = target, ifAnnotatedValue = serialized }) = ppr target <+> text "annotated by" <+> ppr serialized +pprExtensibleFields :: ExtensibleFields -> SDoc +pprExtensibleFields (ExtensibleFields fs) = vcat . map pprField $ toList fs + where + pprField (name, (BinData size _data)) = text name <+> text "-" <+> ppr size <+> text "bytes" + {- ********************************************************* * * ===================================== compiler/GHC/Iface/Make.hs ===================================== @@ -268,7 +268,8 @@ mkIface_ hsc_env mi_doc_hdr = doc_hdr, mi_decl_docs = decl_docs, mi_arg_docs = arg_docs, - mi_final_exts = () } + mi_final_exts = (), + mi_ext_fields = emptyExtensibleFields } where cmp_rule = comparing ifRuleName -- Compare these lexicographically by OccName, *not* by unique, ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -1498,7 +1498,7 @@ ApplicativeDo touches a few phases in the compiler: scheduled as outlined above and transformed into applicative combinators. However, the code is still represented as a do-block with special forms of applicative statements. This allows us to - recover the original do-block when e.g. printing type errors, where + recover the original do-block when e.g. printing type errors, where we don't want to show any of the applicative combinators since they don't exist in the source code. See ApplicativeStmt and ApplicativeArg in HsExpr. @@ -1682,7 +1682,7 @@ stmtTreeToStmts monad_names ctxt (StmtTreeOne (L _ (BindStmt _ pat rhs _ fail_op , is_body_stmt = False , fail_operator = fail_op}] False tail' -stmtTreeToStmts monad_names ctxt (StmtTreeOne (L _ (BodyStmt _ rhs _ fail_op),_)) +stmtTreeToStmts monad_names ctxt (StmtTreeOne (L _ (BodyStmt _ rhs _ _),_)) tail _tail_fvs | (False,tail') <- needJoin monad_names tail = mkApplicativeStmt ctxt @@ -1691,7 +1691,7 @@ stmtTreeToStmts monad_names ctxt (StmtTreeOne (L _ (BodyStmt _ rhs _ fail_op),_) , app_arg_pattern = nlWildPatName , arg_expr = rhs , is_body_stmt = True - , fail_operator = fail_op}] False tail' + , fail_operator = noSyntaxExpr}] False tail' stmtTreeToStmts _monad_names _ctxt (StmtTreeOne (s,_)) tail _tail_fvs = return (s : tail, emptyNameSet) @@ -1706,7 +1706,8 @@ stmtTreeToStmts monad_names ctxt (StmtTreeApplicative trees) tail tail_fvs = do pairs <- mapM (stmtTreeArg ctxt tail_fvs) trees let (stmts', fvss) = unzip pairs let (need_join, tail') = - if any hasStrictPattern trees + -- See Note [ApplicativeDo and refutable patterns] + if any hasRefutablePattern stmts' then (True, tail) else needJoin monad_names tail @@ -1721,13 +1722,13 @@ stmtTreeToStmts monad_names ctxt (StmtTreeApplicative trees) tail tail_fvs = do , is_body_stmt = False , fail_operator = fail_op }, emptyFVs) - stmtTreeArg _ctxt _tail_fvs (StmtTreeOne (L _ (BodyStmt _ exp _ fail_op), _)) = + stmtTreeArg _ctxt _tail_fvs (StmtTreeOne (L _ (BodyStmt _ exp _ _), _)) = return (ApplicativeArgOne { xarg_app_arg_one = noExtField , app_arg_pattern = nlWildPatName , arg_expr = exp , is_body_stmt = True - , fail_operator = fail_op + , fail_operator = noSyntaxExpr }, emptyFVs) stmtTreeArg ctxt tail_fvs tree = do let stmts = flattenStmtTree tree @@ -1854,12 +1855,19 @@ isStrictPattern lpat = SplicePat{} -> True _otherwise -> panic "isStrictPattern" -hasStrictPattern :: ExprStmtTree -> Bool -hasStrictPattern (StmtTreeOne (L _ (BindStmt _ pat _ _ _), _)) = isStrictPattern pat -hasStrictPattern (StmtTreeOne _) = False -hasStrictPattern (StmtTreeBind a b) = hasStrictPattern a || hasStrictPattern b -hasStrictPattern (StmtTreeApplicative trees) = any hasStrictPattern trees +{- +Note [ApplicativeDo and refutable patterns] + +Refutable patterns in do blocks are desugared to use the monadic 'fail' operation. +This means that sometimes an applicative block needs to be wrapped in 'join' simply because +of a refutable pattern, in order for the types to work out. + +-} +hasRefutablePattern :: ApplicativeArg GhcRn -> Bool +hasRefutablePattern (ApplicativeArgOne { app_arg_pattern = pat + , is_body_stmt = False}) = not (isIrrefutableHsPat pat) +hasRefutablePattern _ = False isLetStmt :: LStmt a b -> Bool isLetStmt (L _ LetStmt{}) = True ===================================== compiler/utils/Binary.hs ===================================== @@ -27,6 +27,8 @@ module Binary {-type-} BinHandle, SymbolTable, Dictionary, + BinData(..), dataHandle, handleData, + openBinMem, -- closeBin, @@ -73,6 +75,7 @@ import Fingerprint import BasicTypes import SrcLoc +import Control.DeepSeq import Foreign import Data.Array import Data.ByteString (ByteString) @@ -95,6 +98,44 @@ import GHC.Serialized type BinArray = ForeignPtr Word8 + + +--------------------------------------------------------------- +-- BinData +--------------------------------------------------------------- + +data BinData = BinData Int BinArray + +instance NFData BinData where + rnf (BinData sz _) = rnf sz + +instance Binary BinData where + put_ bh (BinData sz dat) = do + put_ bh sz + putPrim bh sz $ \dest -> + withForeignPtr dat $ \orig -> + copyBytes dest orig sz + -- + get bh = do + sz <- get bh + dat <- mallocForeignPtrBytes sz + getPrim bh sz $ \orig -> + withForeignPtr dat $ \dest -> + copyBytes dest orig sz + return (BinData sz dat) + +dataHandle :: BinData -> IO BinHandle +dataHandle (BinData size bin) = do + ixr <- newFastMutInt + szr <- newFastMutInt + writeFastMutInt ixr 0 + writeFastMutInt szr size + binr <- newIORef bin + return (BinMem noUserData ixr szr binr) + +handleData :: BinHandle -> IO BinData +handleData (BinMem _ ixr _ binr) = BinData <$> readFastMutInt ixr <*> readIORef binr + --------------------------------------------------------------- -- BinHandle --------------------------------------------------------------- ===================================== hadrian/src/Rules/Test.hs ===================================== @@ -48,7 +48,7 @@ testRules = do -- Using program shipped with testsuite to generate ghcconfig file. root -/- ghcConfigProgPath %> \_ -> do - ghc0Path <- (<.> exe) <$> getCompilerPath "stage0" + ghc0Path <- getCompilerPath "stage0" -- Invoke via bash to work around #17362. -- Reasons why this is required are not entirely clear. cmd ["bash"] ["-c", ghc0Path ++ " " ++ ghcConfigHsPath ++ " -o " ++ (root -/- ghcConfigProgPath)] ===================================== hadrian/src/Settings/Builders/RunTest.hs ===================================== @@ -106,7 +106,7 @@ runTestBuilderArgs = builder RunTest ? do , arg "-e", arg $ "config.accept=" ++ show accept , arg "-e", arg $ "config.accept_platform=" ++ show acceptPlatform , arg "-e", arg $ "config.accept_os=" ++ show acceptOS - , arg "-e", arg $ "config.exeext=" ++ quote exe + , arg "-e", arg $ "config.exeext=" ++ quote (if null exe then "" else "."<>exe) , arg "-e", arg $ "config.compiler_debugged=" ++ show debugged , arg "-e", arg $ asBool "ghc_with_native_codegen=" withNativeCodeGen ===================================== libraries/base/Data/Foldable.hs ===================================== @@ -215,6 +215,8 @@ class Foldable t where -- | A variant of 'foldr' that has no base case, -- and thus may only be applied to non-empty structures. -- + -- ⚠️ This function is non-total and will raise a runtime exception if the structure happens to be empty. + -- -- @'foldr1' f = 'List.foldr1' f . 'toList'@ foldr1 :: (a -> a -> a) -> t a -> a foldr1 f xs = fromMaybe (errorWithoutStackTrace "foldr1: empty structure") @@ -227,6 +229,8 @@ class Foldable t where -- | A variant of 'foldl' that has no base case, -- and thus may only be applied to non-empty structures. -- + -- ⚠️ This function is non-total and will raise a runtime exception if the structure happens to be empty. + -- -- @'foldl1' f = 'List.foldl1' f . 'toList'@ foldl1 :: (a -> a -> a) -> t a -> a foldl1 f xs = fromMaybe (errorWithoutStackTrace "foldl1: empty structure") @@ -267,6 +271,14 @@ class Foldable t where -- | The largest element of a non-empty structure. -- + -- ⚠️ This function is non-total and will raise a runtime exception if the structure happens to be empty. + -- + -- === __Examples__ + -- >>> maximum [1..10] + -- 10 + -- >>> maximum [] + -- *** Exception: Prelude.maximum: empty list + -- -- @since 4.8.0.0 maximum :: forall a . Ord a => t a -> a maximum = fromMaybe (errorWithoutStackTrace "maximum: empty structure") . @@ -274,6 +286,14 @@ class Foldable t where -- | The least element of a non-empty structure. -- + -- ⚠️ This function is non-total and will raise a runtime exception if the structure happens to be empty + -- + -- === __Examples__ + -- >>> minimum [1..10] + -- 1 + -- >>> minimum [] + -- *** Exception: Prelude.minimum: empty list + -- -- @since 4.8.0.0 minimum :: forall a . Ord a => t a -> a minimum = fromMaybe (errorWithoutStackTrace "minimum: empty structure") . ===================================== libraries/base/Data/Semigroup.hs ===================================== @@ -286,7 +286,15 @@ instance Num a => Num (Max a) where -- | 'Arg' isn't itself a 'Semigroup' in its own right, but it can be -- placed inside 'Min' and 'Max' to compute an arg min or arg max. -data Arg a b = Arg a b deriving +-- +-- >>> minimum [ Arg (x * x) x | x <- [-10 .. 10] ] +-- Arg 0 0 +data Arg a b = Arg + a + -- ^ The argument used for comparisons in 'Eq' and 'Ord'. + b + -- ^ The "value" exposed via the 'Functor', 'Foldable' etc. instances. + deriving ( Show -- ^ @since 4.9.0.0 , Read -- ^ @since 4.9.0.0 , Data -- ^ @since 4.9.0.0 ===================================== libraries/process ===================================== @@ -1 +1 @@ -Subproject commit 26ea79ceb2193a86f76a302a126be3319f22700d +Subproject commit 8fffea5ca319e85e1bc9e7cac39e5a2c8effefcc ===================================== testsuite/tests/ado/T13242a.stderr ===================================== @@ -32,10 +32,15 @@ T13242a.hs:13:11: error: ...plus 21 others ...plus six instances involving out-of-scope types (use -fprint-potential-instances to see them all) - • In the first argument of ‘return’, namely ‘(x == x)’ In a stmt of a 'do' block: return (x == x) In the expression: do A x <- undefined _ <- return 'a' _ <- return 'b' return (x == x) + In an equation for ‘test’: + test + = do A x <- undefined + _ <- return 'a' + _ <- return 'b' + return (x == x) ===================================== testsuite/tests/ado/T17835.hs ===================================== @@ -0,0 +1,38 @@ +-- Build.hs +{-# LANGUAGE ApplicativeDo #-} +module Build (configRules) where + +type Action = IO +type Rules = IO + +type Config = () + +(%>) :: String -> (String -> Action ()) -> Rules () +(%>) = undefined + +command_ :: [String] -> String -> [String] -> Action () +command_ = undefined + +recursive :: Config -> String -> [String] -> IO (FilePath, [String]) +recursive = undefined + +liftIO :: IO a -> Action a +liftIO = id + +need :: [String] -> Action () +need = undefined + +historyDisable :: Action () +historyDisable = undefined + +get_config :: () -> Action Config +get_config = undefined + +configRules :: Rules () +configRules = do + "snapshot" %> \out -> do + historyDisable -- 8.10-rc1 refuses to compile without bind here + config <- get_config () + need [] + (exe,args) <- liftIO $ recursive config "snapshot" [] + command_ [] exe args ===================================== testsuite/tests/ado/ado001.stdout ===================================== @@ -9,4 +9,4 @@ a; ((b | c) | d) ((a | (b; c)) | d) | e ((a | b); (c | d)) | e a | b -(a | (b; c)) +a | (b; c) ===================================== testsuite/tests/ado/all.T ===================================== @@ -17,3 +17,4 @@ test('T13875', normal, compile_and_run, ['']) test('T14163', normal, compile_and_run, ['']) test('T15344', normal, compile_and_run, ['']) test('T16628', normal, compile_fail, ['']) +test('T17835', normal, compile, ['']) ===================================== testsuite/tests/driver/T12062/Makefile ===================================== @@ -1,3 +1,3 @@ -TOP=../../../.. +TOP=../../.. include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/test.mk ===================================== testsuite/tests/driver/T365.stderr-mingw32 ===================================== @@ -0,0 +1 @@ +./test_preprocessor.txt: builderMainLoop: invalid argument (Exec format error) ===================================== testsuite/tests/ghc-api/annotations/all.T ===================================== @@ -1,12 +1,15 @@ test('annotations', [extra_files(['AnnotationLet.hs']), + normalise_slashes, ignore_stderr], makefile_test, ['annotations']) test('parseTree', [extra_files(['AnnotationTuple.hs']), + normalise_slashes, ignore_stderr], makefile_test, ['parseTree']) test('comments', [extra_files(['CommentsTest.hs']), ignore_stderr], makefile_test, ['comments']) test('exampleTest', [extra_files(['AnnotationTuple.hs']), ignore_stderr], makefile_test, ['exampleTest']) test('listcomps', [extra_files(['ListComprehensions.hs']), + normalise_slashes, ignore_stderr], makefile_test, ['listcomps']) test('T10255', [extra_files(['Test10255.hs']), ignore_stderr], makefile_test, ['T10255']) ===================================== testsuite/tests/ghc-api/annotations/annotations.stdout-mingw32 ===================================== @@ -0,0 +1,86 @@ +[ +(AK AnnotationLet.hs:1:1 AnnCloseC = [AnnotationLet.hs:17:1]) + +(AK AnnotationLet.hs:1:1 AnnModule = [AnnotationLet.hs:2:1-6]) + +(AK AnnotationLet.hs:1:1 AnnOpenC = [AnnotationLet.hs:4:1]) + +(AK AnnotationLet.hs:1:1 AnnWhere = [AnnotationLet.hs:2:28-32]) + +(AK AnnotationLet.hs:2:22-26 AnnCloseP = [AnnotationLet.hs:2:26]) + +(AK AnnotationLet.hs:2:22-26 AnnOpenP = [AnnotationLet.hs:2:22]) + +(AK AnnotationLet.hs:5:1-32 AnnAs = [AnnotationLet.hs:5:28-29]) + +(AK AnnotationLet.hs:5:1-32 AnnImport = [AnnotationLet.hs:5:1-6]) + +(AK AnnotationLet.hs:5:1-32 AnnQualified = [AnnotationLet.hs:5:8-16]) + +(AK AnnotationLet.hs:5:1-32 AnnSemi = [AnnotationLet.hs:6:1]) + +(AK AnnotationLet.hs:(7,1)-(11,12) AnnEqual = [AnnotationLet.hs:7:5]) + +(AK AnnotationLet.hs:(7,1)-(11,12) AnnFunId = [AnnotationLet.hs:7:1-3]) + +(AK AnnotationLet.hs:(7,1)-(11,12) AnnSemi = [AnnotationLet.hs:12:1]) + +(AK AnnotationLet.hs:(7,7)-(11,12) AnnIn = [AnnotationLet.hs:11:7-8]) + +(AK AnnotationLet.hs:(7,7)-(11,12) AnnLet = [AnnotationLet.hs:7:7-9]) + +(AK AnnotationLet.hs:8:9-15 AnnEqual = [AnnotationLet.hs:8:13]) + +(AK AnnotationLet.hs:8:9-15 AnnFunId = [AnnotationLet.hs:8:9]) + +(AK AnnotationLet.hs:8:9-15 AnnSemi = [AnnotationLet.hs:9:9]) + +(AK AnnotationLet.hs:9:9-15 AnnEqual = [AnnotationLet.hs:9:13]) + +(AK AnnotationLet.hs:9:9-15 AnnFunId = [AnnotationLet.hs:9:9]) + +(AK AnnotationLet.hs:9:9-15 AnnSemi = [AnnotationLet.hs:10:9]) + +(AK AnnotationLet.hs:10:9-13 AnnEqual = [AnnotationLet.hs:10:11]) + +(AK AnnotationLet.hs:10:9-13 AnnFunId = [AnnotationLet.hs:10:9]) + +(AK AnnotationLet.hs:13:1-10 AnnInfix = [AnnotationLet.hs:13:1-6]) + +(AK AnnotationLet.hs:13:1-10 AnnSemi = [AnnotationLet.hs:14:1]) + +(AK AnnotationLet.hs:13:1-10 AnnVal = [AnnotationLet.hs:13:8]) + +(AK AnnotationLet.hs:15:1-40 AnnCloseP = [AnnotationLet.hs:15:14, AnnotationLet.hs:15:13]) + +(AK AnnotationLet.hs:15:1-40 AnnData = [AnnotationLet.hs:15:1-4]) + +(AK AnnotationLet.hs:15:1-40 AnnEqual = [AnnotationLet.hs:15:18]) + +(AK AnnotationLet.hs:15:1-40 AnnOpenP = [AnnotationLet.hs:15:6, AnnotationLet.hs:15:7]) + +(AK AnnotationLet.hs:15:1-40 AnnSemi = [AnnotationLet.hs:16:1]) + +(AK AnnotationLet.hs:15:6-14 AnnCloseP = [AnnotationLet.hs:15:14]) + +(AK AnnotationLet.hs:15:6-14 AnnOpenP = [AnnotationLet.hs:15:6]) + +(AK AnnotationLet.hs:15:7-13 AnnCloseP = [AnnotationLet.hs:15:13]) + +(AK AnnotationLet.hs:15:7-13 AnnOpenP = [AnnotationLet.hs:15:7]) + +(AK AnnotationLet.hs:15:20-28 AnnVbar = [AnnotationLet.hs:15:30]) + +(AK AnnotationLet.hs:15:24-28 AnnCloseP = [AnnotationLet.hs:15:28]) + +(AK AnnotationLet.hs:15:24-28 AnnOpenP = [AnnotationLet.hs:15:24]) + +(AK AnnotationLet.hs:15:36-40 AnnCloseP = [AnnotationLet.hs:15:40]) + +(AK AnnotationLet.hs:15:36-40 AnnOpenP = [AnnotationLet.hs:15:36]) +] + +[AnnotationLet.hs:2:1-6] +[] +AnnotationLet.hs:1:1 +EOF: Just SrcSpanPoint ".\\AnnotationLet.hs" 18 1 ===================================== testsuite/tests/ghc-api/annotations/listcomps.stdout-mingw32 ===================================== @@ -0,0 +1,160 @@ +{ListComprehensions.hs:1:1, ListComprehensions.hs:6:8-25, + ListComprehensions.hs:10:1-15, ListComprehensions.hs:10:8-15, + ListComprehensions.hs:11:1-30, ListComprehensions.hs:11:18-25, + ListComprehensions.hs:11:30, ListComprehensions.hs:12:1-27, + ListComprehensions.hs:12:8-15, ListComprehensions.hs:12:17-27, + ListComprehensions.hs:12:18-26, ListComprehensions.hs:13:1-25, + ListComprehensions.hs:13:8-16, ListComprehensions.hs:13:18-25, + ListComprehensions.hs:13:19-24, ListComprehensions.hs:17:1-16, + ListComprehensions.hs:17:1-25, ListComprehensions.hs:17:21-25, + ListComprehensions.hs:17:22-24, ListComprehensions.hs:18:1-16, + ListComprehensions.hs:(18,1)-(22,20), + ListComprehensions.hs:(18,18)-(22,20), + ListComprehensions.hs:(18,20)-(22,20), ListComprehensions.hs:18:22, + ListComprehensions.hs:18:22-26, ListComprehensions.hs:18:22-30, + ListComprehensions.hs:(18,22)-(21,34), ListComprehensions.hs:18:24, + ListComprehensions.hs:18:26, ListComprehensions.hs:18:28, + ListComprehensions.hs:18:30, ListComprehensions.hs:19:22, + ListComprehensions.hs:19:22-33, + ListComprehensions.hs:(19,22)-(21,34), + ListComprehensions.hs:19:27-33, ListComprehensions.hs:19:28, + ListComprehensions.hs:19:31-32, ListComprehensions.hs:20:22, + ListComprehensions.hs:20:22-34, ListComprehensions.hs:20:27-34, + ListComprehensions.hs:20:28-29, ListComprehensions.hs:20:32-33, + ListComprehensions.hs:21:22, ListComprehensions.hs:21:22-34, + ListComprehensions.hs:21:27-34, ListComprehensions.hs:21:28-29, + ListComprehensions.hs:21:32-33, ListComprehensions.hs:24:1-6, + ListComprehensions.hs:24:1-27, ListComprehensions.hs:24:11-15, + ListComprehensions.hs:24:11-27, ListComprehensions.hs:24:12-14, + ListComprehensions.hs:24:20-27, ListComprehensions.hs:24:21-26, + ListComprehensions.hs:25:1-6, ListComprehensions.hs:(25,1)-(28,14), + ListComprehensions.hs:25:8-10, + ListComprehensions.hs:(25,12)-(28,14), + ListComprehensions.hs:(25,14)-(28,14), + ListComprehensions.hs:25:16-20, + ListComprehensions.hs:(25,16)-(27,22), ListComprehensions.hs:26:16, + ListComprehensions.hs:26:16-23, + ListComprehensions.hs:(26,16)-(27,22), + ListComprehensions.hs:26:21-23, ListComprehensions.hs:27:21-22} +-------------------------------- +[ +(AK ListComprehensions.hs:1:1 AnnModule = [ListComprehensions.hs:6:1-6]) + +(AK ListComprehensions.hs:1:1 AnnWhere = [ListComprehensions.hs:6:27-31]) + +(AK ListComprehensions.hs:10:1-15 AnnImport = [ListComprehensions.hs:10:1-6]) + +(AK ListComprehensions.hs:10:1-15 AnnSemi = [ListComprehensions.hs:11:1]) + +(AK ListComprehensions.hs:11:1-30 AnnAs = [ListComprehensions.hs:11:27-28]) + +(AK ListComprehensions.hs:11:1-30 AnnImport = [ListComprehensions.hs:11:1-6]) + +(AK ListComprehensions.hs:11:1-30 AnnQualified = [ListComprehensions.hs:11:8-16]) + +(AK ListComprehensions.hs:11:1-30 AnnSemi = [ListComprehensions.hs:12:1]) + +(AK ListComprehensions.hs:12:1-27 AnnImport = [ListComprehensions.hs:12:1-6]) + +(AK ListComprehensions.hs:12:1-27 AnnSemi = [ListComprehensions.hs:13:1]) + +(AK ListComprehensions.hs:12:17-27 AnnCloseP = [ListComprehensions.hs:12:27]) + +(AK ListComprehensions.hs:12:17-27 AnnOpenP = [ListComprehensions.hs:12:17]) + +(AK ListComprehensions.hs:13:1-25 AnnImport = [ListComprehensions.hs:13:1-6]) + +(AK ListComprehensions.hs:13:1-25 AnnSemi = [ListComprehensions.hs:17:1]) + +(AK ListComprehensions.hs:13:18-25 AnnCloseP = [ListComprehensions.hs:13:25]) + +(AK ListComprehensions.hs:13:18-25 AnnOpenP = [ListComprehensions.hs:13:18]) + +(AK ListComprehensions.hs:17:1-25 AnnDcolon = [ListComprehensions.hs:17:18-19]) + +(AK ListComprehensions.hs:17:1-25 AnnSemi = [ListComprehensions.hs:18:1]) + +(AK ListComprehensions.hs:17:21-25 AnnCloseS = [ListComprehensions.hs:17:25]) + +(AK ListComprehensions.hs:17:21-25 AnnOpenS = [ListComprehensions.hs:17:21]) + +(AK ListComprehensions.hs:(18,1)-(22,20) AnnEqual = [ListComprehensions.hs:18:18]) + +(AK ListComprehensions.hs:(18,1)-(22,20) AnnFunId = [ListComprehensions.hs:18:1-16]) + +(AK ListComprehensions.hs:(18,1)-(22,20) AnnSemi = [ListComprehensions.hs:24:1]) + +(AK ListComprehensions.hs:(18,20)-(22,20) AnnCloseS = [ListComprehensions.hs:22:20]) + +(AK ListComprehensions.hs:(18,20)-(22,20) AnnOpenS = [ListComprehensions.hs:18:20]) + +(AK ListComprehensions.hs:(18,20)-(22,20) AnnVbar = [ListComprehensions.hs:19:20]) + +(AK ListComprehensions.hs:18:22-26 AnnVal = [ListComprehensions.hs:18:24]) + +(AK ListComprehensions.hs:18:22-30 AnnVal = [ListComprehensions.hs:18:28]) + +(AK ListComprehensions.hs:19:22-33 AnnLarrow = [ListComprehensions.hs:19:24-25]) + +(AK ListComprehensions.hs:19:22-33 AnnVbar = [ListComprehensions.hs:20:20]) + +(AK ListComprehensions.hs:19:27-33 AnnCloseS = [ListComprehensions.hs:19:33]) + +(AK ListComprehensions.hs:19:27-33 AnnDotdot = [ListComprehensions.hs:19:29-30]) + +(AK ListComprehensions.hs:19:27-33 AnnOpenS = [ListComprehensions.hs:19:27]) + +(AK ListComprehensions.hs:20:22-34 AnnLarrow = [ListComprehensions.hs:20:24-25]) + +(AK ListComprehensions.hs:20:22-34 AnnVbar = [ListComprehensions.hs:21:20]) + +(AK ListComprehensions.hs:20:27-34 AnnCloseS = [ListComprehensions.hs:20:34]) + +(AK ListComprehensions.hs:20:27-34 AnnDotdot = [ListComprehensions.hs:20:30-31]) + +(AK ListComprehensions.hs:20:27-34 AnnOpenS = [ListComprehensions.hs:20:27]) + +(AK ListComprehensions.hs:21:22-34 AnnLarrow = [ListComprehensions.hs:21:24-25]) + +(AK ListComprehensions.hs:21:27-34 AnnCloseS = [ListComprehensions.hs:21:34]) + +(AK ListComprehensions.hs:21:27-34 AnnDotdot = [ListComprehensions.hs:21:30-31]) + +(AK ListComprehensions.hs:21:27-34 AnnOpenS = [ListComprehensions.hs:21:27]) + +(AK ListComprehensions.hs:24:1-27 AnnDcolon = [ListComprehensions.hs:24:8-9]) + +(AK ListComprehensions.hs:24:1-27 AnnSemi = [ListComprehensions.hs:25:1]) + +(AK ListComprehensions.hs:24:11-15 AnnCloseS = [ListComprehensions.hs:24:15]) + +(AK ListComprehensions.hs:24:11-15 AnnOpenS = [ListComprehensions.hs:24:11]) + +(AK ListComprehensions.hs:24:11-15 AnnRarrow = [ListComprehensions.hs:24:17-18]) + +(AK ListComprehensions.hs:24:11-27 AnnRarrow = [ListComprehensions.hs:24:17-18]) + +(AK ListComprehensions.hs:24:20-27 AnnCloseS = [ListComprehensions.hs:24:27]) + +(AK ListComprehensions.hs:24:20-27 AnnOpenS = [ListComprehensions.hs:24:20]) + +(AK ListComprehensions.hs:(25,1)-(28,14) AnnEqual = [ListComprehensions.hs:25:12]) + +(AK ListComprehensions.hs:(25,1)-(28,14) AnnFunId = [ListComprehensions.hs:25:1-6]) + +(AK ListComprehensions.hs:(25,1)-(28,14) AnnSemi = [ListComprehensions.hs:29:1]) + +(AK ListComprehensions.hs:(25,14)-(28,14) AnnCloseS = [ListComprehensions.hs:28:14]) + +(AK ListComprehensions.hs:(25,14)-(28,14) AnnOpenS = [ListComprehensions.hs:25:14]) + +(AK ListComprehensions.hs:(25,14)-(28,14) AnnVbar = [ListComprehensions.hs:26:14]) + +(AK ListComprehensions.hs:26:16-23 AnnComma = [ListComprehensions.hs:27:14]) + +(AK ListComprehensions.hs:26:16-23 AnnLarrow = [ListComprehensions.hs:26:18-19]) + +(AK ListComprehensions.hs:(26,16)-(27,22) AnnThen = [ListComprehensions.hs:27:16-19]) +] + +EOF: Just SrcSpanPoint ".\\ListComprehensions.hs" 29 1 ===================================== testsuite/tests/ghc-api/annotations/parseTree.stdout-mingw32 ===================================== @@ -0,0 +1,160 @@ +[(AnnotationTuple.hs:14:20, [p], Unit 1), + (AnnotationTuple.hs:14:23-29, [p], Unit "hello"), + (AnnotationTuple.hs:14:35-37, [p], Unit 6.5), + (AnnotationTuple.hs:14:39, [m], ()), + (AnnotationTuple.hs:14:41-52, [p], Unit [5, 5, 6, 7]), + (AnnotationTuple.hs:16:8, [p], Unit 1), + (AnnotationTuple.hs:16:11-17, [p], Unit "hello"), + (AnnotationTuple.hs:16:20-22, [p], Unit 6.5), + (AnnotationTuple.hs:16:24, [m], ()), + (AnnotationTuple.hs:16:25, [m], ()), + (AnnotationTuple.hs:16:26, [m], ()), (, [m], ())] +[ +(AK AnnotationTuple.hs:1:1 AnnCloseC = [AnnotationTuple.hs:27:1]) + +(AK AnnotationTuple.hs:1:1 AnnModule = [AnnotationTuple.hs:3:1-6]) + +(AK AnnotationTuple.hs:1:1 AnnOpenC = [AnnotationTuple.hs:5:1]) + +(AK AnnotationTuple.hs:1:1 AnnWhere = [AnnotationTuple.hs:3:30-34]) + +(AK AnnotationTuple.hs:3:24-28 AnnCloseP = [AnnotationTuple.hs:3:28]) + +(AK AnnotationTuple.hs:3:24-28 AnnOpenP = [AnnotationTuple.hs:3:24]) + +(AK AnnotationTuple.hs:6:1-32 AnnAs = [AnnotationTuple.hs:6:28-29]) + +(AK AnnotationTuple.hs:6:1-32 AnnImport = [AnnotationTuple.hs:6:1-6]) + +(AK AnnotationTuple.hs:6:1-32 AnnQualified = [AnnotationTuple.hs:6:8-16]) + +(AK AnnotationTuple.hs:6:1-32 AnnSemi = [AnnotationTuple.hs:7:1]) + +(AK AnnotationTuple.hs:(8,1)-(11,14) AnnEqual = [AnnotationTuple.hs:8:5]) + +(AK AnnotationTuple.hs:(8,1)-(11,14) AnnFunId = [AnnotationTuple.hs:8:1-3]) + +(AK AnnotationTuple.hs:(8,1)-(11,14) AnnSemi = [AnnotationTuple.hs:13:1]) + +(AK AnnotationTuple.hs:(8,7)-(11,14) AnnIn = [AnnotationTuple.hs:11:7-8]) + +(AK AnnotationTuple.hs:(8,7)-(11,14) AnnLet = [AnnotationTuple.hs:8:7-9]) + +(AK AnnotationTuple.hs:9:9-13 AnnEqual = [AnnotationTuple.hs:9:11]) + +(AK AnnotationTuple.hs:9:9-13 AnnFunId = [AnnotationTuple.hs:9:9]) + +(AK AnnotationTuple.hs:9:9-13 AnnSemi = [AnnotationTuple.hs:10:9]) + +(AK AnnotationTuple.hs:10:9-13 AnnEqual = [AnnotationTuple.hs:10:11]) + +(AK AnnotationTuple.hs:10:9-13 AnnFunId = [AnnotationTuple.hs:10:9]) + +(AK AnnotationTuple.hs:11:10-14 AnnVal = [AnnotationTuple.hs:11:12]) + +(AK AnnotationTuple.hs:14:1-72 AnnEqual = [AnnotationTuple.hs:14:5]) + +(AK AnnotationTuple.hs:14:1-72 AnnFunId = [AnnotationTuple.hs:14:1-3]) + +(AK AnnotationTuple.hs:14:1-72 AnnSemi = [AnnotationTuple.hs:15:1]) + +(AK AnnotationTuple.hs:14:7-72 AnnVal = [AnnotationTuple.hs:14:13]) + +(AK AnnotationTuple.hs:14:19-53 AnnCloseP = [AnnotationTuple.hs:14:53]) + +(AK AnnotationTuple.hs:14:19-53 AnnOpenP = [AnnotationTuple.hs:14:19]) + +(AK AnnotationTuple.hs:14:20 AnnComma = [AnnotationTuple.hs:14:21]) + +(AK AnnotationTuple.hs:14:23-29 AnnComma = [AnnotationTuple.hs:14:33]) + +(AK AnnotationTuple.hs:14:35-37 AnnComma = [AnnotationTuple.hs:14:38]) + +(AK AnnotationTuple.hs:14:39 AnnComma = [AnnotationTuple.hs:14:39]) + +(AK AnnotationTuple.hs:14:41-52 AnnCloseS = [AnnotationTuple.hs:14:52]) + +(AK AnnotationTuple.hs:14:41-52 AnnOpenS = [AnnotationTuple.hs:14:41]) + +(AK AnnotationTuple.hs:14:42 AnnComma = [AnnotationTuple.hs:14:43]) + +(AK AnnotationTuple.hs:14:45 AnnComma = [AnnotationTuple.hs:14:46]) + +(AK AnnotationTuple.hs:14:48 AnnComma = [AnnotationTuple.hs:14:49]) + +(AK AnnotationTuple.hs:14:55-72 AnnCloseS = [AnnotationTuple.hs:14:72]) + +(AK AnnotationTuple.hs:14:55-72 AnnOpenS = [AnnotationTuple.hs:14:55]) + +(AK AnnotationTuple.hs:14:56-62 AnnComma = [AnnotationTuple.hs:14:63]) + +(AK AnnotationTuple.hs:14:61-62 AnnCloseP = [AnnotationTuple.hs:14:62]) + +(AK AnnotationTuple.hs:14:61-62 AnnOpenP = [AnnotationTuple.hs:14:61]) + +(AK AnnotationTuple.hs:16:1-41 AnnEqual = [AnnotationTuple.hs:16:5]) + +(AK AnnotationTuple.hs:16:1-41 AnnFunId = [AnnotationTuple.hs:16:1-3]) + +(AK AnnotationTuple.hs:16:1-41 AnnSemi = [AnnotationTuple.hs:17:1]) + +(AK AnnotationTuple.hs:16:7-27 AnnCloseP = [AnnotationTuple.hs:16:27]) + +(AK AnnotationTuple.hs:16:7-27 AnnOpenP = [AnnotationTuple.hs:16:7]) + +(AK AnnotationTuple.hs:16:8 AnnComma = [AnnotationTuple.hs:16:9]) + +(AK AnnotationTuple.hs:16:11-17 AnnComma = [AnnotationTuple.hs:16:18]) + +(AK AnnotationTuple.hs:16:20-22 AnnComma = [AnnotationTuple.hs:16:23]) + +(AK AnnotationTuple.hs:16:24 AnnComma = [AnnotationTuple.hs:16:24]) + +(AK AnnotationTuple.hs:16:25 AnnComma = [AnnotationTuple.hs:16:25]) + +(AK AnnotationTuple.hs:16:26 AnnComma = [AnnotationTuple.hs:16:26]) + +(AK AnnotationTuple.hs:16:33-41 AnnCloseP = [AnnotationTuple.hs:16:41]) + +(AK AnnotationTuple.hs:16:33-41 AnnOpenP = [AnnotationTuple.hs:16:33]) + +(AK AnnotationTuple.hs:16:39-40 AnnCloseP = [AnnotationTuple.hs:16:40]) + +(AK AnnotationTuple.hs:16:39-40 AnnOpenP = [AnnotationTuple.hs:16:39]) + +(AK AnnotationTuple.hs:18:1-28 AnnData = [AnnotationTuple.hs:18:1-4]) + +(AK AnnotationTuple.hs:18:1-28 AnnDcolon = [AnnotationTuple.hs:18:20-21]) + +(AK AnnotationTuple.hs:18:1-28 AnnFamily = [AnnotationTuple.hs:18:6-11]) + +(AK AnnotationTuple.hs:18:1-28 AnnSemi = [AnnotationTuple.hs:19:1]) + +(AK AnnotationTuple.hs:18:23 AnnRarrow = [AnnotationTuple.hs:18:25-26]) + +(AK AnnotationTuple.hs:18:23-28 AnnRarrow = [AnnotationTuple.hs:18:25-26]) + +(AK AnnotationTuple.hs:(20,1)-(24,14) AnnFunId = [AnnotationTuple.hs:20:1-5]) + +(AK AnnotationTuple.hs:(20,1)-(24,14) AnnSemi = [AnnotationTuple.hs:25:1]) + +(AK AnnotationTuple.hs:(21,7)-(24,14) AnnEqual = [AnnotationTuple.hs:24:7]) + +(AK AnnotationTuple.hs:(21,7)-(24,14) AnnVbar = [AnnotationTuple.hs:21:7]) + +(AK AnnotationTuple.hs:21:9-24 AnnComma = [AnnotationTuple.hs:22:7]) + +(AK AnnotationTuple.hs:21:9-24 AnnLarrow = [AnnotationTuple.hs:21:16-17]) + +(AK AnnotationTuple.hs:22:9-25 AnnComma = [AnnotationTuple.hs:23:7]) + +(AK AnnotationTuple.hs:22:9-25 AnnLarrow = [AnnotationTuple.hs:22:16-17]) + +(AK AnnotationTuple.hs:23:9-24 AnnLarrow = [AnnotationTuple.hs:23:16-17]) + +(AK AnnotationTuple.hs:26:1-10 AnnDcolon = [AnnotationTuple.hs:26:5-6]) + +(AK AnnotationTuple.hs:26:1-14 AnnEqual = [AnnotationTuple.hs:26:12]) +] + +EOF: Just SrcSpanPoint ".\\AnnotationTuple.hs" 32 1 ===================================== testsuite/tests/ghci/scripts/T9293.stdout-mingw32 ===================================== @@ -12,7 +12,6 @@ other dynamic, non-language, flag settings: -fimplicit-import-qualified -fshow-warning-groups warning settings: - -Wmissing-monadfail-instances -Wsemigroup -Wnoncanonical-monoid-instances -Wstar-is-type @@ -35,7 +34,6 @@ other dynamic, non-language, flag settings: -fimplicit-import-qualified -fshow-warning-groups warning settings: - -Wmissing-monadfail-instances -Wsemigroup -Wnoncanonical-monoid-instances -Wstar-is-type @@ -57,7 +55,6 @@ other dynamic, non-language, flag settings: -fimplicit-import-qualified -fshow-warning-groups warning settings: - -Wmissing-monadfail-instances -Wsemigroup -Wnoncanonical-monoid-instances -Wstar-is-type @@ -81,7 +78,6 @@ other dynamic, non-language, flag settings: -fimplicit-import-qualified -fshow-warning-groups warning settings: - -Wmissing-monadfail-instances -Wsemigroup -Wnoncanonical-monoid-instances -Wstar-is-type ===================================== testsuite/tests/ghci/scripts/ghci024.stdout-mingw32 ===================================== @@ -13,7 +13,6 @@ other dynamic, non-language, flag settings: -fimplicit-import-qualified -fshow-warning-groups warning settings: - -Wmissing-monadfail-instances -Wsemigroup -Wnoncanonical-monoid-instances -Wstar-is-type ===================================== testsuite/tests/ghci/scripts/ghci057.stdout-mingw32 ===================================== @@ -12,7 +12,6 @@ other dynamic, non-language, flag settings: -fimplicit-import-qualified -fshow-warning-groups warning settings: - -Wmissing-monadfail-instances -Wsemigroup -Wnoncanonical-monoid-instances -Wstar-is-type @@ -35,7 +34,6 @@ other dynamic, non-language, flag settings: -fimplicit-import-qualified -fshow-warning-groups warning settings: - -Wmissing-monadfail-instances -Wsemigroup -Wnoncanonical-monoid-instances -Wstar-is-type @@ -57,7 +55,6 @@ other dynamic, non-language, flag settings: -fimplicit-import-qualified -fshow-warning-groups warning settings: - -Wmissing-monadfail-instances -Wsemigroup -Wnoncanonical-monoid-instances -Wstar-is-type @@ -81,7 +78,6 @@ other dynamic, non-language, flag settings: -fimplicit-import-qualified -fshow-warning-groups warning settings: - -Wmissing-monadfail-instances -Wsemigroup -Wnoncanonical-monoid-instances -Wstar-is-type ===================================== testsuite/tests/showIface/DocsInHiFile0.stdout ===================================== @@ -2,3 +2,4 @@ module header: Nothing declaration docs: arg docs: +extensible fields: ===================================== testsuite/tests/showIface/DocsInHiFile1.stdout ===================================== @@ -33,4 +33,4 @@ arg docs: p: 0: " An argument" - +extensible fields: ===================================== utils/fs/fs.h ===================================== @@ -37,6 +37,13 @@ int FS(_stat) (const char *path, struct _stat *buffer); int FS(_stat64) (const char *path, struct __stat64 *buffer); int FS(_wstat) (const wchar_t *path, struct _stat *buffer); int FS(_wstat64) (const wchar_t *path, struct __stat64 *buffer); +int FS(_wrename) (const wchar_t *from, const wchar_t *to); +int FS(rename) (const char *from, const char *to); +int FS(unlink) (const char *filename); +int FS(_unlink) (const char *filename); +int FS(_wunlink) (const wchar_t *filename); +int FS(remove) (const char *path); +int FS(_wremove) (const wchar_t *path); #else FILE *FS(fopen) (const char* filename, const char* mode); ===================================== utils/hsc2hs ===================================== @@ -1 +1 @@ -Subproject commit 4089deb3295c28d6bca7d67322b408469a6f6496 +Subproject commit dff4ed1acf9ebbdd004fc833a474dc8c16a90f5b View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/92bc457144870e1e8f8a70893abec5ce308c03d9...63cef4649a94516a46843cc9ff434bc32a7c6103 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/92bc457144870e1e8f8a70893abec5ce308c03d9...63cef4649a94516a46843cc9ff434bc32a7c6103 You're receiving 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 Mar 24 14:29:04 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Tue, 24 Mar 2020 10:29:04 -0400 Subject: [Git][ghc/ghc][wip/T17923] 3 commits: Fix ApplicativeDo regression #17835 Message-ID: <5e7a193015f0e_616713339fc43226a4@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T17923 at Glasgow Haskell Compiler / GHC Commits: 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) - - - - - 777f8c36 by Simon Peyton Jones at 2020-03-24T14:28:35+00: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. - - - - - 11 changed files: - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Rename/Expr.hs - libraries/base/Data/Semigroup.hs - testsuite/tests/ado/T13242a.stderr - + testsuite/tests/ado/T17835.hs - testsuite/tests/ado/ado001.stdout - testsuite/tests/ado/all.T - + testsuite/tests/indexed-types/should_compile/T17923.hs - testsuite/tests/indexed-types/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -8,7 +8,7 @@ See Note [Core Lint guarantee]. -} {-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE ScopedTypeVariables, DeriveFunctor #-} module GHC.Core.Lint ( lintCoreBindings, lintUnfolding, @@ -33,7 +33,6 @@ import GHC.Core.Op.Monad import Bag import Literal import GHC.Core.DataCon -import TysWiredIn import TysPrim import TcType ( isFloatingTy ) import Var @@ -461,14 +460,17 @@ lintCoreBindings :: DynFlags -> CoreToDo -> [Var] -> CoreProgram -> (Bag MsgDoc, lintCoreBindings dflags pass local_in_scope binds = initL dflags flags local_in_scope $ addLoc TopLevelBindings $ - lintLetBndrs TopLevel binders $ - -- Put all the top-level binders in scope at the start - -- This is because transformation rules can bring something - -- into use 'unexpectedly' do { checkL (null dups) (dupVars dups) ; checkL (null ext_dups) (dupExtVars ext_dups) - ; mapM lint_bind binds } + ; lintRecBindings TopLevel all_pairs $ + return () } where + all_pairs = flattenBinds binds + -- Put all the top-level binders in scope at the start + -- This is because transformation rules can bring something + -- into use 'unexpectedly'; see Note [Glomming] in OccurAnal + binders = map fst all_pairs + flags = defaultLintFlags { lf_check_global_ids = check_globals , lf_check_inline_loop_breakers = check_lbs @@ -494,7 +496,6 @@ lintCoreBindings dflags pass local_in_scope binds CorePrep -> AllowAtTopLevel _ -> AllowAnywhere - binders = bindersOfBinds binds (_, dups) = removeDups compare binders -- dups_ext checks for names with different uniques @@ -509,11 +510,6 @@ lintCoreBindings dflags pass local_in_scope binds = compare (m1, nameOccName n1) (m2, nameOccName n2) | otherwise = LT - -- If you edit this function, you may need to update the GHC formalism - -- See Note [GHC Formalism] - lint_bind (Rec prs) = mapM_ (lintSingleBinding TopLevel Recursive) prs - lint_bind (NonRec bndr rhs) = lintSingleBinding TopLevel NonRecursive (bndr,rhs) - {- ************************************************************************ * * @@ -576,28 +572,32 @@ lintExpr dflags vars expr Check a core binding, returning the list of variables bound. -} -lintSingleBinding :: TopLevelFlag -> RecFlag -> (Id, CoreExpr) -> LintM () --- If you edit this function, you may need to update the GHC formalism --- See Note [GHC Formalism] -lintSingleBinding top_lvl_flag rec_flag (binder,rhs) - = addLoc (RhsOf binder) $ - -- Check the rhs - do { ty <- lintRhs binder rhs - ; binder_ty <- applySubstTy (idType binder) - ; ensureEqTys binder_ty ty (mkRhsMsg binder (text "RHS") ty) +lintRecBindings :: TopLevelFlag -> [(Id, CoreExpr)] + -> LintM a -> LintM a +lintRecBindings top_lvl pairs thing_inside + = lintIdBndrs top_lvl bndrs $ \ bndrs' -> + do { zipWithM_ lint_pair bndrs' rhss + ; thing_inside } + where + (bndrs, rhss) = unzip pairs + lint_pair bndr' rhs + = addLoc (RhsOf bndr') $ + do { rhs_ty <- lintRhs bndr' rhs -- Check the rhs + ; lintLetBind top_lvl Recursive bndr' rhs rhs_ty } + +lintLetBind :: TopLevelFlag -> RecFlag -> LintedId + -> CoreExpr -> LintedType -> LintM () +-- Binder's type, and the RHS, have already been linted +-- This function checks other invariants +lintLetBind top_lvl rec_flag binder rhs rhs_ty + = do { let binder_ty = idType binder + ; ensureEqTys binder_ty rhs_ty (mkRhsMsg binder (text "RHS") rhs_ty) -- If the binding is for a CoVar, the RHS should be (Coercion co) -- See Note [Core type and coercion invariant] in GHC.Core ; checkL (not (isCoVar binder) || isCoArg rhs) (mkLetErr binder rhs) - -- Check that it's not levity-polymorphic - -- Do this first, because otherwise isUnliftedType panics - -- Annoyingly, this duplicates the test in lintIdBdr, - -- because for non-rec lets we call lintSingleBinding first - ; checkL (isJoinId binder || not (isTypeLevPoly binder_ty)) - (badBndrTyMsg binder (text "levity-polymorphic")) - -- Check the let/app invariant -- See Note [Core let/app invariant] in GHC.Core ; checkL ( isJoinId binder @@ -610,14 +610,14 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs) -- 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_flag)) + || (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]. - ; checkL (not (isTopLevel top_lvl_flag && binder_ty `eqType` addrPrimTy) + ; checkL (not (isTopLevel top_lvl && binder_ty `eqType` addrPrimTy) || exprIsTickedString rhs) (mkTopNonLitStrMsg binder) @@ -674,7 +674,9 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs) -- join point. -- -- See Note [Checking StaticPtrs]. -lintRhs :: Id -> CoreExpr -> LintM OutType +lintRhs :: Id -> CoreExpr -> LintM LintedType +-- NB: the Id can be Linted or not -- it's only used for +-- its OccInfo and join-pointer-hood lintRhs bndr rhs | Just arity <- isJoinId_maybe bndr = lint_join_lams arity arity True rhs @@ -761,13 +763,14 @@ hurts us here. ************************************************************************ -} --- For OutType, OutKind, the substitution has been applied, --- but has not been linted yet - -type LintedType = Type -- Substitution applied, and type is linted -type LintedKind = Kind +-- Linted things: substitution applied, and type is linted +type LintedType = Type +type LintedKind = Kind +type LintedCoercion = Coercion +type LintedTyCoVar = TyCoVar +type LintedId = Id -lintCoreExpr :: CoreExpr -> LintM OutType +lintCoreExpr :: CoreExpr -> LintM LintedType -- The returned type has the substitution from the monad -- already applied to it: -- lintCoreExpr e subst = exprType (subst e) @@ -776,6 +779,7 @@ lintCoreExpr :: CoreExpr -> LintM OutType -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] + lintCoreExpr (Var var) = lintVarOcc var 0 @@ -784,10 +788,11 @@ lintCoreExpr (Lit lit) lintCoreExpr (Cast expr co) = do { expr_ty <- markAllJoinsBad $ lintCoreExpr expr - ; co' <- applySubstCo co - ; (_, k2, from_ty, to_ty, r) <- lintCoercion co' - ; checkValueKind k2 (text "target of cast" <+> quotes (ppr co)) - ; lintRole co' Representational r + ; co' <- lintCoercion co + ; let (Pair from_ty to_ty, role) = coercionKindRole co' + ; checkValueKind (typeKind to_ty) $ + text "target of cast" <+> quotes (ppr co') + ; lintRole co' Representational role ; ensureEqTys from_ty expr_ty (mkCastErr expr co' from_ty expr_ty) ; return to_ty } @@ -809,7 +814,7 @@ lintCoreExpr (Tick tickish expr) lintCoreExpr (Let (NonRec tv (Type ty)) body) | isTyVar tv = -- See Note [Linting type lets] - do { ty' <- applySubstTy ty + do { ty' <- lintType ty ; lintTyBndr tv $ \ tv' -> do { addLoc (RhsOf tv) $ lintTyKind tv' ty' -- Now extend the substitution so we @@ -820,33 +825,34 @@ lintCoreExpr (Let (NonRec tv (Type ty)) body) lintCoreExpr (Let (NonRec bndr rhs) body) | isId bndr - = do { lintSingleBinding NotTopLevel NonRecursive (bndr,rhs) - ; addLoc (BodyOfLetRec [bndr]) - (lintBinder LetBind bndr $ \_ -> - addGoodJoins [bndr] $ - lintCoreExpr body) } + = do { -- First Lint the RHS, before bringing the binder into scope + rhs_ty <- lintRhs bndr rhs + + -- Now lint the binder + ; lintBinder LetBind bndr $ \bndr' -> + do { lintLetBind NotTopLevel NonRecursive bndr' rhs rhs_ty + ; addLoc (BodyOfLetRec [bndr]) (lintCoreExpr body) } } | otherwise = failWithL (mkLetErr bndr rhs) -- Not quite accurate lintCoreExpr e@(Let (Rec pairs) body) - = lintLetBndrs NotTopLevel bndrs $ - addGoodJoins bndrs $ - do { -- Check that the list of pairs is non-empty + = do { -- Check that the list of pairs is non-empty checkL (not (null pairs)) (emptyRec e) -- Check that there are no duplicated binders + ; let (_, dups) = removeDups compare bndrs ; checkL (null dups) (dupVars dups) -- Check that either all the binders are joins, or none ; checkL (all isJoinId bndrs || all (not . isJoinId) bndrs) $ - mkInconsistentRecMsg bndrs + mkInconsistentRecMsg bndrs - ; mapM_ (lintSingleBinding NotTopLevel Recursive) pairs - ; addLoc (BodyOfLetRec bndrs) (lintCoreExpr body) } + ; lintRecBindings NotTopLevel pairs $ + addLoc (BodyOfLetRec bndrs) $ + lintCoreExpr body } where bndrs = map fst pairs - (_, dups) = removeDups compare bndrs lintCoreExpr e@(App _ _) = do { fun_ty <- lintCoreFun fun (length args) @@ -867,20 +873,27 @@ lintCoreExpr (Type ty) = failWithL (text "Type found as expression" <+> ppr ty) lintCoreExpr (Coercion co) - = do { (k1, k2, ty1, ty2, role) <- lintInCo co - ; return (mkHeteroCoercionType role k1 k2 ty1 ty2) } + = do { co' <- addLoc (InCo co) $ + lintCoercion co + ; return (coercionType co') } ---------------------- lintVarOcc :: Var -> Int -- Number of arguments (type or value) being passed - -> LintM Type -- returns type of the *variable* + -> LintM LintedType -- returns type of the *variable* lintVarOcc var nargs - = do { checkL (isNonCoVarId var) + = addLoc (OccOf var) $ + do { checkL (isNonCoVarId var) (text "Non term variable" <+> ppr var) -- See GHC.Core Note [Variable occurrences in Core] -- Check that the type of the occurrence is the same - -- as the type of the binding site - ; ty <- applySubstTy (idType var) + -- as the type of the binding site. We lint the type so that + -- we apply the substitution. Actually this will get into trouble + -- with /\a. \(x::Maybe a). /\a. ...(x::Maybe a)... + -- The "::Maybe a" on the occurrence is referring to the /outer/ a. + -- But this naive check will treat it like the inner one. + -- This looks like a bug waiting to happen. + ; ty <- lintType (idType var) ; var' <- lookupIdInScope var ; let ty' = idType var' ; ensureEqTys ty ty' $ mkBndrOccTypeMismatchMsg var' var ty' ty @@ -898,8 +911,8 @@ lintVarOcc var nargs ; return (idType var') } lintCoreFun :: CoreExpr - -> Int -- Number of arguments (type or val) being passed - -> LintM Type -- Returns type of the *function* + -> Int -- Number of arguments (type or val) being passed + -> LintM LintedType -- Returns type of the *function* lintCoreFun (Var var) nargs = lintVarOcc var nargs @@ -941,7 +954,9 @@ checkJoinOcc var n_args = do { mb_join_arity_bndr <- lookupJoinId var ; case mb_join_arity_bndr of { Nothing -> -- Binder is not a join point - addErrL (invalidJoinOcc var) ; + do { join_set <- getValidJoins + ; addErrL (text "join set " <+> ppr join_set $$ + invalidJoinOcc var) } ; Just join_arity_bndr -> @@ -1038,15 +1053,15 @@ subtype of the required type, as one would expect. -} -lintCoreArgs :: OutType -> [CoreArg] -> LintM OutType +lintCoreArgs :: LintedType -> [CoreArg] -> LintM LintedType lintCoreArgs fun_ty args = foldM lintCoreArg fun_ty args -lintCoreArg :: OutType -> CoreArg -> LintM OutType +lintCoreArg :: LintedType -> CoreArg -> LintM LintedType lintCoreArg fun_ty (Type arg_ty) = do { checkL (not (isCoercionTy arg_ty)) (text "Unnecessary coercion-to-type injection:" <+> ppr arg_ty) - ; arg_ty' <- applySubstTy arg_ty + ; arg_ty' <- lintType arg_ty ; lintTyApp fun_ty arg_ty' } lintCoreArg fun_ty arg @@ -1060,11 +1075,12 @@ lintCoreArg fun_ty arg ; checkL (not (isUnliftedType arg_ty) || exprOkForSpeculation arg) (mkLetAppMsg arg) + ; lintValApp arg fun_ty arg_ty } ----------------- -lintAltBinders :: OutType -- Scrutinee type - -> OutType -- Constructor type +lintAltBinders :: LintedType -- Scrutinee type + -> LintedType -- Constructor type -> [OutVar] -- Binders -> LintM () -- If you edit this function, you may need to update the GHC formalism @@ -1080,7 +1096,7 @@ lintAltBinders scrut_ty con_ty (bndr:bndrs) ; lintAltBinders scrut_ty con_ty' bndrs } ----------------- -lintTyApp :: OutType -> OutType -> LintM OutType +lintTyApp :: LintedType -> LintedType -> LintM LintedType lintTyApp fun_ty arg_ty | Just (tv,body_ty) <- splitForAllTy_maybe fun_ty = do { lintTyKind tv arg_ty @@ -1094,7 +1110,7 @@ lintTyApp fun_ty arg_ty = failWithL (mkTyAppMsg fun_ty arg_ty) ----------------- -lintValApp :: CoreExpr -> OutType -> OutType -> LintM OutType +lintValApp :: CoreExpr -> LintedType -> LintedType -> LintM LintedType lintValApp arg fun_ty arg_ty | Just (arg,res) <- splitFunTy_maybe fun_ty = do { ensureEqTys arg arg_ty err1 @@ -1105,17 +1121,17 @@ lintValApp arg fun_ty arg_ty err1 = mkAppMsg fun_ty arg_ty arg err2 = mkNonFunAppMsg fun_ty arg_ty arg -lintTyKind :: OutTyVar -> OutType -> LintM () +lintTyKind :: OutTyVar -> LintedType -> LintM () -- Both args have had substitution applied -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] lintTyKind tyvar arg_ty - = do { arg_kind <- lintType arg_ty - ; unless (arg_kind `eqType` tyvar_kind) - (addErrL (mkKindErrMsg tyvar arg_ty $$ (text "Linted Arg kind:" <+> ppr arg_kind))) } + = unless (arg_kind `eqType` tyvar_kind) $ + addErrL (mkKindErrMsg tyvar arg_ty $$ (text "Linted Arg kind:" <+> ppr arg_kind)) where tyvar_kind = tyVarKind tyvar + arg_kind = typeKind arg_ty {- ************************************************************************ @@ -1125,7 +1141,7 @@ lintTyKind tyvar arg_ty ************************************************************************ -} -lintCaseExpr :: CoreExpr -> Id -> Type -> [CoreAlt] -> LintM OutType +lintCaseExpr :: CoreExpr -> Id -> Type -> [CoreAlt] -> LintM LintedType lintCaseExpr scrut var alt_ty alts = do { let e = Case scrut var alt_ty alts -- Just for error messages @@ -1134,10 +1150,10 @@ lintCaseExpr scrut var alt_ty alts = -- See Note [Join points are less general than the paper] -- in GHC.Core - ; (alt_ty, _) <- addLoc (CaseTy scrut) $ - lintInTy alt_ty - ; (var_ty, _) <- addLoc (IdTy var) $ - lintInTy (idType var) + ; alt_ty <- addLoc (CaseTy scrut) $ + lintValueType alt_ty + ; var_ty <- addLoc (IdTy var) $ + lintValueType (idType var) -- We used to try to check whether a case expression with no -- alternatives was legitimate, but this didn't work. @@ -1179,7 +1195,7 @@ lintCaseExpr scrut var alt_ty alts = ; checkCaseAlts e scrut_ty alts ; return alt_ty } } -checkCaseAlts :: CoreExpr -> OutType -> [CoreAlt] -> LintM () +checkCaseAlts :: CoreExpr -> LintedType -> [CoreAlt] -> LintM () -- a) Check that the alts are non-empty -- b1) Check that the DEFAULT comes first, if it exists -- b2) Check that the others are in increasing order @@ -1219,14 +1235,14 @@ checkCaseAlts e ty alts = Nothing -> False Just tycon -> isPrimTyCon tycon -lintAltExpr :: CoreExpr -> OutType -> LintM () +lintAltExpr :: CoreExpr -> LintedType -> LintM () lintAltExpr expr ann_ty = do { actual_ty <- lintCoreExpr expr ; ensureEqTys actual_ty ann_ty (mkCaseAltMsg expr actual_ty ann_ty) } -- See GHC.Core Note [Case expression invariants] item (6) -lintCoreAlt :: OutType -- Type of scrutinee - -> OutType -- Type of the alternative +lintCoreAlt :: LintedType -- Type of scrutinee + -> LintedType -- Type of the alternative -> CoreAlt -> LintM () -- If you edit this function, you may need to update the GHC formalism @@ -1286,33 +1302,36 @@ lintBinders site (var:vars) linterF = lintBinder site var $ \var' -> -- See Note [GHC Formalism] lintBinder :: BindingSite -> Var -> (Var -> LintM a) -> LintM a lintBinder site var linterF - | isTyVar var = lintTyBndr var linterF - | isCoVar var = lintCoBndr var linterF - | otherwise = lintIdBndr NotTopLevel site var linterF + | isTyCoVar var = lintTyCoBndr var linterF + | otherwise = lintIdBndr NotTopLevel site var linterF -lintTyBndr :: InTyVar -> (OutTyVar -> LintM a) -> LintM a -lintTyBndr tv thing_inside - = do { subst <- getTCvSubst - ; let (subst', tv') = substTyVarBndr subst tv - ; lintKind (varType tv') - ; updateTCvSubst subst' (thing_inside tv') } +lintTyBndr :: TyVar -> (LintedTyCoVar -> LintM a) -> LintM a +lintTyBndr = lintTyCoBndr -- We could specialise it, I guess + +lintCoBndr :: CoVar -> (LintedTyCoVar -> LintM a) -> LintM a +lintCoBndr = lintTyCoBndr -- We could specialise it, I guess -lintCoBndr :: InCoVar -> (OutCoVar -> LintM a) -> LintM a -lintCoBndr cv thing_inside +lintTyCoBndr :: TyCoVar -> (LintedTyCoVar -> LintM a) -> LintM a +lintTyCoBndr tcv thing_inside = do { subst <- getTCvSubst - ; let (subst', cv') = substCoVarBndr subst cv - ; lintKind (varType cv') - ; lintL (isCoVarType (varType cv')) - (text "CoVar with non-coercion type:" <+> pprTyVar cv) - ; updateTCvSubst subst' (thing_inside cv') } - -lintLetBndrs :: TopLevelFlag -> [Var] -> LintM a -> LintM a -lintLetBndrs top_lvl ids linterF - = go ids + ; kind' <- lintType (varType tcv) + ; let tcv' = uniqAway (getTCvInScope subst) $ + setVarType tcv kind' + subst' = extendTCvSubstWithClone subst tcv tcv' + ; when (isCoVar tcv) $ + lintL (isCoVarType kind') + (text "CoVar with non-coercion type:" <+> pprTyVar tcv) + ; updateTCvSubst subst' (thing_inside tcv') } + +lintIdBndrs :: forall a. TopLevelFlag -> [Id] -> ([LintedId] -> LintM a) -> LintM a +lintIdBndrs top_lvl ids thing_inside + = go ids thing_inside where - go [] = linterF - go (id:ids) = lintIdBndr top_lvl LetBind id $ \_ -> - go ids + go :: [Id] -> ([Id] -> LintM a) -> LintM a + go [] thing_inside = thing_inside [] + go (id:ids) thing_inside = lintIdBndr top_lvl LetBind id $ \id' -> + go ids $ \ids' -> + thing_inside (id' : ids') lintIdBndr :: TopLevelFlag -> BindingSite -> InVar -> (OutVar -> LintM a) -> LintM a @@ -1334,14 +1353,15 @@ lintIdBndr top_lvl bind_site id linterF ; checkL (not (isExternalName (Var.varName id)) || is_top_lvl) (mkNonTopExternalNameMsg id) - ; (id_ty, k) <- addLoc (IdTy id) $ - lintInTy (idType id) + ; id_ty <- addLoc (IdTy id) $ + lintValueType (idType id) ; let id' = setIdType id id_ty -- See Note [Levity polymorphism invariants] in GHC.Core - ; lintL (isJoinId id || not (lf_check_levity_poly flags) || not (isKindLevPoly k)) - (text "Levity-polymorphic binder:" <+> - (ppr id <+> dcolon <+> parens (ppr id_ty <+> dcolon <+> ppr k))) + ; lintL (isJoinId id || not (lf_check_levity_poly flags) + || not (isTypeLevPoly id_ty)) $ + text "Levity-polymorphic binder:" <+> ppr id <+> dcolon <+> + parens (ppr id_ty <+> dcolon <+> ppr (typeKind id_ty)) -- Check that a join-id is a not-top-level let-binding ; when (isJoinId id) $ @@ -1378,45 +1398,52 @@ lintTypes dflags vars tys where (_warns, errs) = initL dflags defaultLintFlags vars linter linter = lintBinders LambdaBind vars $ \_ -> - mapM_ lintInTy tys + mapM_ lintType tys -lintInTy :: InType -> LintM (LintedType, LintedKind) +lintValueType :: Type -> LintM LintedType -- Types only, not kinds -- Check the type, and apply the substitution to it -- See Note [Linting type lets] -lintInTy ty +lintValueType ty = addLoc (InType ty) $ - do { ty' <- applySubstTy ty - ; k <- lintType ty' - ; addLoc (InKind ty' k) $ - lintKind k -- The kind returned by lintType is already - -- a LintedKind but we also want to check that - -- k :: *, which lintKind does - ; return (ty', k) } + do { ty' <- lintType ty + ; let sk = typeKind ty' + ; lintL (classifiesTypeWithValues sk) $ + hang (text "Ill-kinded type:" <+> ppr ty) + 2 (text "has kind:" <+> ppr sk) + ; return ty' } checkTyCon :: TyCon -> LintM () checkTyCon tc = checkL (not (isTcTyCon tc)) (text "Found TcTyCon:" <+> ppr tc) ------------------- -lintType :: OutType -> LintM LintedKind --- The returned Kind has itself been linted +lintType :: LintedType -> LintM LintedType -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] lintType (TyVarTy tv) - = do { checkL (isTyVar tv) (mkBadTyVarMsg tv) - ; tv' <- lintTyCoVarInScope tv - ; return (tyVarKind tv') } - -- We checked its kind when we added it to the envt + | not (isTyVar tv) + = failWithL (mkBadTyVarMsg tv) + + | otherwise + = do { subst <- getTCvSubst + ; case lookupTyVar subst tv of + Just linted_ty -> return linted_ty ; + Nothing -> -- lintTyBndr always extends the substitition + failWithL $ + hang (text "The type variable" <+> pprBndr LetBind tv) + 2 (text "is out of scope") + } lintType ty@(AppTy t1 t2) | TyConApp {} <- t1 = failWithL $ text "TyConApp to the left of AppTy:" <+> ppr ty | otherwise - = do { k1 <- lintType t1 - ; k2 <- lintType t2 - ; lint_ty_app ty k1 [(t2,k2)] } + = do { t1' <- lintType t1 + ; t2' <- lintType t2 + ; lint_ty_app ty (typeKind t1') [t2'] + ; return (AppTy t1' t2') } lintType ty@(TyConApp tc tys) | isTypeSynonymTyCon tc || isTypeFamilyTyCon tc @@ -1433,71 +1460,67 @@ lintType ty@(TyConApp tc tys) | otherwise -- Data types, data families, primitive types = do { checkTyCon tc - ; ks <- mapM lintType tys - ; lint_ty_app ty (tyConKind tc) (tys `zip` ks) } + ; tys' <- mapM lintType tys + ; lint_ty_app ty (tyConKind tc) tys' + ; return (TyConApp tc tys') } -- arrows can related *unlifted* kinds, so this has to be separate from -- a dependent forall. -lintType ty@(FunTy _ t1 t2) - = do { k1 <- lintType t1 - ; k2 <- lintType t2 - ; lintArrow (text "type or kind" <+> quotes (ppr ty)) k1 k2 } - -lintType t@(ForAllTy (Bndr tv _vis) ty) - -- forall over types - | isTyVar tv - = lintTyBndr tv $ \tv' -> - do { k <- lintType ty - ; checkValueKind k (text "the body of forall:" <+> ppr t) - ; case occCheckExpand [tv'] k of -- See Note [Stupid type synonyms] - Just k' -> return k' +lintType ty@(FunTy af t1 t2) + = do { t1' <- lintType t1 + ; t2' <- lintType t2 + ; lintArrow (text "type or kind" <+> quotes (ppr ty)) t1' t2' + ; return (FunTy af t1' t2') } + +lintType ty@(ForAllTy (Bndr tcv vis) body_ty) + | isTyVar tcv + = lintTyBndr tcv $ \tv' -> + do { body_ty' <- lintType body_ty + ; let k = typeKind body_ty' + ; checkValueKind k (text "the body of forall:" <+> ppr ty) + ; case occCheckExpand [tv'] k of + -- See Note [Phantom type variables in kinds] in GHC.Core.Type + Just {} -> return (ForAllTy (Bndr tv' vis) body_ty') Nothing -> failWithL (hang (text "Variable escape in forall:") - 2 (vcat [ text "type:" <+> ppr t + 2 (vcat [ text "type:" <+> ppr body_ty' , text "kind:" <+> ppr k ])) } -lintType t@(ForAllTy (Bndr cv _vis) ty) - -- forall over coercions - = do { lintL (isCoVar cv) - (text "Non-Tyvar or Non-Covar bound in type:" <+> ppr t) - ; lintL (cv `elemVarSet` tyCoVarsOfType ty) - (text "Covar does not occur in the body:" <+> ppr t) - ; lintCoBndr cv $ \_ -> - do { k <- lintType ty - ; checkValueKind k (text "the body of forall:" <+> ppr t) - ; return liftedTypeKind - -- We don't check variable escape here. Namely, k could refer to cv' - }} - -lintType ty@(LitTy l) = lintTyLit l >> return (typeKind ty) + | isCoVar tcv + = lintCoBndr tcv $ \cv' -> + do { body_ty' <- lintType body_ty + + ; lintL (cv' `elemVarSet` tyCoVarsOfType body_ty') $ + text "Covar does not occur in the body:" <+> ppr ty + + ; let k = typeKind body_ty' + ; checkValueKind k (text "the body of forall:" <+> ppr ty) + + -- The kind of (forall cv. th) is liftedTypeKind, so no + -- need to check for skolem-escape, as we must do in the tyvar case + + ; return (ForAllTy (Bndr cv' vis) body_ty') } + + | otherwise + = failWithL (text "Non-Tyvar or Non-Covar bound in type:" <+> ppr ty) + +lintType ty@(LitTy l) + = do { lintTyLit l; return ty } lintType (CastTy ty co) - = do { k1 <- lintType ty - ; (k1', k2) <- lintStarCoercion co - ; ensureEqTys k1 k1' (mkCastTyErr ty co k1' k1) - ; return k2 } + = do { ty' <- lintType ty + ; co' <- lintStarCoercion co + ; let tyk = typeKind ty' + cok = coercionLKind co' + ; ensureEqTys tyk cok (mkCastTyErr ty co tyk cok) + ; return (CastTy ty' co') } lintType (CoercionTy co) - = do { (k1, k2, ty1, ty2, r) <- lintCoercion co - ; return $ mkHeteroCoercionType r k1 k2 ty1 ty2 } - -{- Note [Stupid type synonyms] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider (#14939) - type Alg cls ob = ob - f :: forall (cls :: * -> Constraint) (b :: Alg cls *). b - -Here 'cls' appears free in b's kind, which would usually be illegal -(because in (forall a. ty), ty's kind should not mention 'a'). But -#in this case (Alg cls *) = *, so all is well. Currently we allow -this, and make Lint expand synonyms where necessary to make it so. - -c.f. TcUnify.occCheckExpand and GHC.Core.Utils.coreAltsType which deal -with the same problem. A single systematic solution eludes me. --} + = do { co' <- lintCoercion co + ; return (CoercionTy co') } ----------------- -lintTySynFamApp :: Bool -> Type -> TyCon -> [Type] -> LintM LintedKind +lintTySynFamApp :: Bool -> InType -> TyCon -> [InType] -> LintM LintedType -- The TyCon is a type synonym or a type family (not a data family) -- See Note [Linting type synonym applications] -- c.f. TcValidity.check_syn_tc_app @@ -1511,27 +1534,20 @@ lintTySynFamApp report_unsat ty tc tys , let expanded_ty = mkAppTys (substTy (mkTvSubstPrs tenv) rhs) tys' = do { -- Kind-check the argument types, but without reporting -- un-saturated type families/synonyms - ks <- setReportUnsat False (mapM lintType tys) + tys' <- setReportUnsat False (mapM lintType tys) ; when report_unsat $ do { _ <- lintType expanded_ty ; return () } - ; lint_ty_app ty (tyConKind tc) (tys `zip` ks) } + ; lint_ty_app ty (tyConKind tc) tys' + ; return (TyConApp tc tys') } -- Otherwise this must be a type family | otherwise - = do { ks <- mapM lintType tys - ; lint_ty_app ty (tyConKind tc) (tys `zip` ks) } - ------------------ -lintKind :: OutKind -> LintM () --- If you edit this function, you may need to update the GHC formalism --- See Note [GHC Formalism] -lintKind k = do { sk <- lintType k - ; unless (classifiesTypeWithValues sk) - (addErrL (hang (text "Ill-kinded kind:" <+> ppr k) - 2 (text "has kind:" <+> ppr sk))) } + = do { tys' <- mapM lintType tys + ; lint_ty_app ty (tyConKind tc) tys' + ; return (TyConApp tc tys') } ----------------- -- Confirms that a type is really *, #, Constraint etc @@ -1542,27 +1558,28 @@ checkValueKind k doc text "when checking" <+> doc) ----------------- -lintArrow :: SDoc -> LintedKind -> LintedKind -> LintM LintedKind +lintArrow :: SDoc -> LintedType -> LintedType -> LintM () -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] -lintArrow what k1 k2 -- Eg lintArrow "type or kind `blah'" k1 k2 +lintArrow what t1 t2 -- Eg lintArrow "type or kind `blah'" k1 k2 -- or lintArrow "coercion `blah'" k1 k2 = do { unless (classifiesTypeWithValues k1) (addErrL (msg (text "argument") k1)) - ; unless (classifiesTypeWithValues k2) (addErrL (msg (text "result") k2)) - ; return liftedTypeKind } + ; unless (classifiesTypeWithValues k2) (addErrL (msg (text "result") k2)) } where + k1 = typeKind t1 + k2 = typeKind t2 msg ar k = vcat [ hang (text "Ill-kinded" <+> ar) 2 (text "in" <+> what) , what <+> text "kind:" <+> ppr k ] ----------------- -lint_ty_app :: Type -> LintedKind -> [(LintedType,LintedKind)] -> LintM LintedKind +lint_ty_app :: Type -> LintedKind -> [LintedType] -> LintM () lint_ty_app ty k tys = lint_app (text "type" <+> quotes (ppr ty)) k tys ---------------- -lint_co_app :: Coercion -> LintedKind -> [(LintedType,LintedKind)] -> LintM LintedKind +lint_co_app :: Coercion -> LintedKind -> [LintedType] -> LintM () lint_co_app ty k tys = lint_app (text "coercion" <+> quotes (ppr ty)) k tys @@ -1574,42 +1591,45 @@ lintTyLit (NumTyLit n) where msg = text "Negative type literal:" <+> integer n lintTyLit (StrTyLit _) = return () -lint_app :: SDoc -> LintedKind -> [(LintedType,LintedKind)] -> LintM Kind +lint_app :: SDoc -> LintedKind -> [LintedType] -> LintM () -- (lint_app d fun_kind arg_tys) -- We have an application (f arg_ty1 .. arg_tyn), -- where f :: fun_kind --- Takes care of linting the OutTypes -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] -lint_app doc kfn kas +lint_app doc kfn arg_tys = do { in_scope <- getInScope -- We need the in_scope set to satisfy the invariant in -- Note [The substitution invariant] in GHC.Core.TyCo.Subst - ; foldlM (go_app in_scope) kfn kas } + ; _ <- foldlM (go_app in_scope) kfn arg_tys + ; return () } where fail_msg extra = vcat [ hang (text "Kind application error in") 2 doc , nest 2 (text "Function kind =" <+> ppr kfn) - , nest 2 (text "Arg kinds =" <+> ppr kas) + , nest 2 (text "Arg types =" <+> ppr arg_tys) , extra ] - go_app in_scope kfn tka + go_app in_scope kfn ta | Just kfn' <- coreView kfn - = go_app in_scope kfn' tka + = go_app in_scope kfn' ta - go_app _ (FunTy _ kfa kfb) tka@(_,ka) - = do { unless (ka `eqType` kfa) $ - addErrL (fail_msg (text "Fun:" <+> (ppr kfa $$ ppr tka))) + go_app _ fun_kind@(FunTy _ kfa kfb) ta + = do { let ka = typeKind ta + ; unless (ka `eqType` kfa) $ + addErrL (fail_msg (text "Fun:" <+> (ppr fun_kind $$ ppr ta <+> dcolon <+> ppr ka))) ; return kfb } - go_app in_scope (ForAllTy (Bndr kv _vis) kfn) tka@(ta,ka) + go_app in_scope (ForAllTy (Bndr kv _vis) kfn) ta = do { let kv_kind = varType kv + ka = typeKind ta ; unless (ka `eqType` kv_kind) $ - addErrL (fail_msg (text "Forall:" <+> (ppr kv $$ ppr kv_kind $$ ppr tka))) + addErrL (fail_msg (text "Forall:" <+> (ppr kv $$ ppr kv_kind $$ + ppr ta <+> dcolon <+> ppr ka))) ; return $ substTy (extendTCvSubst (mkEmptyTCvSubst in_scope) kv ta) kfn } - go_app _ kfn ka - = failWithL (fail_msg (text "Not a fun:" <+> (ppr kfn $$ ppr ka))) + go_app _ kfn ta + = failWithL (fail_msg (text "Not a fun:" <+> (ppr kfn $$ ppr ta))) {- ********************************************************************* * * @@ -1617,7 +1637,7 @@ lint_app doc kfn kas * * ********************************************************************* -} -lintCoreRule :: OutVar -> OutType -> CoreRule -> LintM () +lintCoreRule :: OutVar -> LintedType -> CoreRule -> LintM () lintCoreRule _ _ (BuiltinRule {}) = return () -- Don't bother @@ -1710,68 +1730,73 @@ Note [Rules and join points] in OccurAnal for further discussion. ************************************************************************ -} -lintInCo :: InCoercion -> LintM (LintedKind, LintedKind, LintedType, LintedType, Role) --- Check the coercion, and apply the substitution to it --- See Note [Linting type lets] -lintInCo co - = addLoc (InCo co) $ - do { co' <- applySubstCo co - ; lintCoercion co' } - -- lints a coercion, confirming that its lh kind and its rh kind are both * -- also ensures that the role is Nominal -lintStarCoercion :: OutCoercion -> LintM (LintedType, LintedType) +lintStarCoercion :: InCoercion -> LintM LintedCoercion lintStarCoercion g - = do { (k1, k2, t1, t2, r) <- lintCoercion g - ; checkValueKind k1 (text "the kind of the left type in" <+> ppr g) - ; checkValueKind k2 (text "the kind of the right type in" <+> ppr g) - ; lintRole g Nominal r - ; return (t1, t2) } - -lintCoercion :: OutCoercion -> LintM (LintedKind, LintedKind, LintedType, LintedType, Role) --- Check the kind of a coercion term, returning the kind --- Post-condition: the returned OutTypes are lint-free --- --- If lintCoercion co = (k1, k2, s1, s2, r) --- then co :: s1 ~r s2 --- s1 :: k1 --- s2 :: k2 - + = do { g' <- lintCoercion g + ; let Pair t1 t2 = coercionKind g' + ; checkValueKind (typeKind t1) (text "the kind of the left type in" <+> ppr g) + ; checkValueKind (typeKind t2) (text "the kind of the right type in" <+> ppr g) + ; lintRole g Nominal (coercionRole g) + ; return g' } + +lintCoercion :: InCoercion -> LintM LintedCoercion -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] + +lintCoercion (CoVarCo cv) + | not (isCoVar cv) + = failWithL (hang (text "Bad CoVarCo:" <+> ppr cv) + 2 (text "With offending type:" <+> ppr (varType cv))) + + | otherwise + = do { subst <- getTCvSubst + ; case lookupCoVar subst cv of + Just linted_co -> return linted_co ; + Nothing -> -- lintCoBndr always extends the substitition + failWithL $ + hang (text "The coercion variable" <+> pprBndr LetBind cv) + 2 (text "is out of scope") + } + + lintCoercion (Refl ty) - = do { k <- lintType ty - ; return (k, k, ty, ty, Nominal) } + = do { ty' <- lintType ty + ; return (Refl ty') } lintCoercion (GRefl r ty MRefl) - = do { k <- lintType ty - ; return (k, k, ty, ty, r) } + = do { ty' <- lintType ty + ; return (GRefl r ty' MRefl) } lintCoercion (GRefl r ty (MCo co)) - = do { k <- lintType ty - ; (_, _, k1, k2, r') <- lintCoercion co - ; ensureEqTys k k1 - (hang (text "GRefl coercion kind mis-match:" <+> ppr co) - 2 (vcat [ppr ty, ppr k, ppr k1])) - ; lintRole co Nominal r' - ; return (k1, k2, ty, mkCastTy ty co, r) } + = do { ty' <- lintType ty + ; co' <- lintCoercion co + ; let tk = typeKind ty' + tl = coercionLKind co' + ; ensureEqTys tk tl $ + hang (text "GRefl coercion kind mis-match:" <+> ppr co) + 2 (vcat [ppr ty', ppr tk, ppr tl]) + ; lintRole co' Nominal (coercionRole co') + ; return (GRefl r ty' (MCo co')) } lintCoercion co@(TyConAppCo r tc cos) | tc `hasKey` funTyConKey , [_rep1,_rep2,_co1,_co2] <- cos - = do { failWithL (text "Saturated TyConAppCo (->):" <+> ppr co) - } -- All saturated TyConAppCos should be FunCos + = failWithL (text "Saturated TyConAppCo (->):" <+> ppr co) + -- All saturated TyConAppCos should be FunCos | Just {} <- synTyConDefn_maybe tc = failWithL (text "Synonym in TyConAppCo:" <+> ppr co) | otherwise = do { checkTyCon tc - ; (k's, ks, ss, ts, rs) <- mapAndUnzip5M lintCoercion cos - ; k' <- lint_co_app co (tyConKind tc) (ss `zip` k's) - ; k <- lint_co_app co (tyConKind tc) (ts `zip` ks) - ; _ <- zipWith3M lintRole cos (tyConRolesX r tc) rs - ; return (k', k, mkTyConApp tc ss, mkTyConApp tc ts, r) } + ; cos' <- mapM lintCoercion cos + ; lint_co_app co (tyConKind tc) (map coercionLKind cos') + ; lint_co_app co (tyConKind tc) (map coercionRKind cos') + ; sequence_ [ lintRole co' r (coercionRole co') + | (r, co') <- zip (tyConRolesX r tc) cos' ] + ; return (TyConAppCo r tc cos') } lintCoercion co@(AppCo co1 co2) | TyConAppCo {} <- co1 @@ -1779,111 +1804,63 @@ lintCoercion co@(AppCo co1 co2) | Just (TyConApp {}, _) <- isReflCo_maybe co1 = failWithL (text "Refl (TyConApp ...) to the left of AppCo:" <+> ppr co) | otherwise - = do { (k1, k2, s1, s2, r1) <- lintCoercion co1 - ; (k'1, k'2, t1, t2, r2) <- lintCoercion co2 - ; k3 <- lint_co_app co k1 [(t1,k'1)] - ; k4 <- lint_co_app co k2 [(t2,k'2)] + = do { co1' <- lintCoercion co1 + ; co2' <- lintCoercion co2 + ; lint_co_app co (typeKind (coercionLKind co1')) [coercionLKind co2'] + ; lint_co_app co (typeKind (coercionRKind co1')) [coercionRKind co2'] + + ; let r1 = coercionRole co1 + r2 = coercionRole co2 ; if r1 == Phantom then lintL (r2 == Phantom || r2 == Nominal) (text "Second argument in AppCo cannot be R:" $$ ppr co) else lintRole co Nominal r2 - ; return (k3, k4, mkAppTy s1 t1, mkAppTy s2 t2, r1) } + + ; return (AppCo co1' co2') } ---------- -lintCoercion (ForAllCo tv1 kind_co co) - -- forall over types - | isTyVar tv1 - = do { (_, k2) <- lintStarCoercion kind_co - ; let tv2 = setTyVarKind tv1 k2 - ; addInScopeTyCoVar tv1 $ - do { - ; (k3, k4, t1, t2, r) <- lintCoercion co - ; in_scope <- getInScope - ; let tyl = mkInvForAllTy tv1 t1 - subst = mkTvSubst in_scope $ - -- We need both the free vars of the `t2` and the - -- free vars of the range of the substitution in - -- scope. All the free vars of `t2` and `kind_co` should - -- already be in `in_scope`, because they've been - -- linted and `tv2` has the same unique as `tv1`. - -- See Note [The substitution invariant] in GHC.Core.TyCo.Subst. - unitVarEnv tv1 (TyVarTy tv2 `mkCastTy` mkSymCo kind_co) - tyr = mkInvForAllTy tv2 $ - substTy subst t2 - ; return (k3, k4, tyl, tyr, r) } } - -lintCoercion (ForAllCo cv1 kind_co co) - -- forall over coercions - = ASSERT( isCoVar cv1 ) - do { lintL (almostDevoidCoVarOfCo cv1 co) +lintCoercion co@(ForAllCo tcv1 kind_co body_co) + | not (isTyCoVar tcv1) + = failWithL (text "Non tyco binder in ForAllCo:" <+> ppr co) + | otherwise + = do { kind_co' <- lintStarCoercion kind_co + ; lintTyCoBndr tcv1 $ \tcv1' -> + do { body_co' <- lintCoercion body_co + ; ensureEqTys (varType tcv1') (coercionLKind kind_co') $ + text "Kind mis-match in ForallCo" <+> ppr co + + ; when (isCoVar tcv1) $ + lintL (almostDevoidCoVarOfCo tcv1 body_co) (text "Covar can only appear in Refl and GRefl: " <+> ppr co) - ; (_, k2) <- lintStarCoercion kind_co - ; let cv2 = setVarType cv1 k2 - ; addInScopeTyCoVar cv1 $ - do { - ; (k3, k4, t1, t2, r) <- lintCoercion co - ; checkValueKind k3 (text "the body of a ForAllCo over covar:" <+> ppr co) - ; checkValueKind k4 (text "the body of a ForAllCo over covar:" <+> ppr co) - -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep - ; in_scope <- getInScope - ; let tyl = mkTyCoInvForAllTy cv1 t1 - r2 = coVarRole cv1 - kind_co' = downgradeRole r2 Nominal kind_co - eta1 = mkNthCo r2 2 kind_co' - eta2 = mkNthCo r2 3 kind_co' - subst = mkCvSubst in_scope $ - -- We need both the free vars of the `t2` and the - -- free vars of the range of the substitution in - -- scope. All the free vars of `t2` and `kind_co` should - -- already be in `in_scope`, because they've been - -- linted and `cv2` has the same unique as `cv1`. - -- See Note [The substitution invariant] in GHC.Core.TyCo.Subst. - unitVarEnv cv1 (eta1 `mkTransCo` (mkCoVarCo cv2) - `mkTransCo` (mkSymCo eta2)) - tyr = mkTyCoInvForAllTy cv2 $ - substTy subst t2 - ; return (liftedTypeKind, liftedTypeKind, tyl, tyr, r) } } - -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep + -- What is this all about? -lintCoercion co@(FunCo r co1 co2) - = do { (k1,k'1,s1,t1,r1) <- lintCoercion co1 - ; (k2,k'2,s2,t2,r2) <- lintCoercion co2 - ; k <- lintArrow (text "coercion" <+> quotes (ppr co)) k1 k2 - ; k' <- lintArrow (text "coercion" <+> quotes (ppr co)) k'1 k'2 - ; lintRole co1 r r1 - ; lintRole co2 r r2 - ; return (k, k', mkVisFunTy s1 s2, mkVisFunTy t1 t2, r) } + ; return (ForAllCo tcv1' kind_co' body_co') } } -lintCoercion (CoVarCo cv) - | not (isCoVar cv) - = failWithL (hang (text "Bad CoVarCo:" <+> ppr cv) - 2 (text "With offending type:" <+> ppr (varType cv))) - | otherwise - = do { cv' <- lintTyCoVarInScope cv - ; lintUnliftedCoVar cv' - ; return $ coVarKindsTypesRole cv' } +lintCoercion co@(FunCo r co1 co2) + = do { co1' <- lintCoercion co1 + ; co2' <- lintCoercion co2 + ; let Pair lt1 rt1 = coercionKind co1 + Pair lt2 rt2 = coercionKind co2 + ; lintArrow (text "coercion" <+> quotes (ppr co)) lt1 lt2 + ; lintArrow (text "coercion" <+> quotes (ppr co)) rt1 rt2 + ; lintRole co1 r (coercionRole co1) + ; lintRole co2 r (coercionRole co2) + ; return (FunCo r co1' co2') } -- See Note [Bad unsafe coercion] lintCoercion co@(UnivCo prov r ty1 ty2) - = do { k1 <- lintType ty1 - ; k2 <- lintType ty2 - ; case prov of - PhantomProv kco -> do { lintRole co Phantom r - ; check_kinds kco k1 k2 } - - ProofIrrelProv kco -> do { lintL (isCoercionTy ty1) $ - mkBadProofIrrelMsg ty1 co - ; lintL (isCoercionTy ty2) $ - mkBadProofIrrelMsg ty2 co - ; check_kinds kco k1 k2 } - - PluginProv _ -> return () -- no extra checks + = do { ty1' <- lintType ty1 + ; ty2' <- lintType ty2 + ; let k1 = typeKind ty1' + k2 = typeKind ty2' + ; prov' <- lint_prov k1 k2 prov ; when (r /= Phantom && classifiesTypeWithValues k1 && classifiesTypeWithValues k2) (checkTypes ty1 ty2) - ; return (k1, k2, ty1, ty2, r) } + + ; return (UnivCo prov' r ty1' ty2') } where report s = hang (text $ "Unsafe coercion: " ++ s) 2 (vcat [ text "From:" <+> ppr ty1 @@ -1926,39 +1903,54 @@ lintCoercion co@(UnivCo prov r ty1 ty2) _ -> return () } - check_kinds kco k1 k2 = do { (k1', k2') <- lintStarCoercion kco - ; ensureEqTys k1 k1' (mkBadUnivCoMsg CLeft co) - ; ensureEqTys k2 k2' (mkBadUnivCoMsg CRight co) } + lint_prov k1 k2 (PhantomProv kco) + = do { kco' <- lintStarCoercion kco + ; lintRole co Phantom r + ; check_kinds kco' k1 k2 + ; return (PhantomProv kco') } + + lint_prov k1 k2 (ProofIrrelProv kco) + = do { lintL (isCoercionTy ty1) (mkBadProofIrrelMsg ty1 co) + ; lintL (isCoercionTy ty2) (mkBadProofIrrelMsg ty2 co) + ; kco' <- lintStarCoercion kco + ; check_kinds kco k1 k2 + ; return (ProofIrrelProv kco') } + + lint_prov _ _ prov@(PluginProv _) = return prov + + check_kinds kco k1 k2 + = do { let Pair k1' k2' = coercionKind kco + ; ensureEqTys k1 k1' (mkBadUnivCoMsg CLeft co) + ; ensureEqTys k2 k2' (mkBadUnivCoMsg CRight co) } lintCoercion (SymCo co) - = do { (k1, k2, ty1, ty2, r) <- lintCoercion co - ; return (k2, k1, ty2, ty1, r) } + = do { co' <- lintCoercion co + ; return (SymCo co') } lintCoercion co@(TransCo co1 co2) - = do { (k1a, _k1b, ty1a, ty1b, r1) <- lintCoercion co1 - ; (_k2a, k2b, ty2a, ty2b, r2) <- lintCoercion co2 + = do { co1' <- lintCoercion co1 + ; co2' <- lintCoercion co2 + ; let Pair ty1a ty1b = coercionKind co1' + Pair ty2a ty2b = coercionKind co2' ; ensureEqTys ty1b ty2a (hang (text "Trans coercion mis-match:" <+> ppr co) 2 (vcat [ppr ty1a, ppr ty1b, ppr ty2a, ppr ty2b])) - ; lintRole co r1 r2 - ; return (k1a, k2b, ty1a, ty2b, r1) } + ; lintRole co (coercionRole co1) (coercionRole co2) + ; return (TransCo co1' co2') } lintCoercion the_co@(NthCo r0 n co) - = do { (_, _, s, t, r) <- lintCoercion co + = do { co' <- lintCoercion co + ; let Pair s t = coercionKind co' + r = coercionRole co' ; case (splitForAllTy_maybe s, splitForAllTy_maybe t) of - { (Just (tcv_s, _ty_s), Just (tcv_t, _ty_t)) + { (Just _, Just _) -- works for both tyvar and covar | n == 0 , (isForAllTy_ty s && isForAllTy_ty t) || (isForAllTy_co s && isForAllTy_co t) -> do { lintRole the_co Nominal r0 - ; return (ks, kt, ts, tt, r0) } - where - ts = varType tcv_s - tt = varType tcv_t - ks = typeKind ts - kt = typeKind tt + ; return (NthCo r0 n co') } ; _ -> case (splitTyConApp_maybe s, splitTyConApp_maybe t) of { (Just (tc_s, tys_s), Just (tc_t, tys_t)) @@ -1968,62 +1960,51 @@ lintCoercion the_co@(NthCo r0 n co) , tys_s `equalLength` tys_t , tys_s `lengthExceeds` n -> do { lintRole the_co tr r0 - ; return (ks, kt, ts, tt, r0) } - where - ts = getNth tys_s n - tt = getNth tys_t n - tr = nthRole r tc_s n - ks = typeKind ts - kt = typeKind tt + ; return (NthCo r0 n co') } + where + tr = nthRole r tc_s n ; _ -> failWithL (hang (text "Bad getNth:") 2 (ppr the_co $$ ppr s $$ ppr t)) }}} lintCoercion the_co@(LRCo lr co) - = do { (_,_,s,t,r) <- lintCoercion co + = do { co' <- lintCoercion co + ; let Pair s t = coercionKind co' + r = coercionRole co' ; lintRole co Nominal r ; case (splitAppTy_maybe s, splitAppTy_maybe t) of - (Just s_pr, Just t_pr) - -> return (ks_pick, kt_pick, s_pick, t_pick, Nominal) - where - s_pick = pickLR lr s_pr - t_pick = pickLR lr t_pr - ks_pick = typeKind s_pick - kt_pick = typeKind t_pick - + (Just _, Just _) -> return (LRCo lr co') _ -> failWithL (hang (text "Bad LRCo:") 2 (ppr the_co $$ ppr s $$ ppr t)) } lintCoercion (InstCo co arg) - = do { (k3, k4, t1',t2', r) <- lintCoercion co - ; (k1',k2',s1,s2, r') <- lintCoercion arg - ; lintRole arg Nominal r' - ; in_scope <- getInScope - ; case (splitForAllTy_ty_maybe t1', splitForAllTy_ty_maybe t2') of + = do { co' <- lintCoercion co + ; arg' <- lintCoercion arg + ; let Pair t1' t2' = coercionKind co' + Pair s1 s2 = coercionKind arg + + ; lintRole arg Nominal (coercionRole arg') + + ; case (splitForAllTy_ty_maybe t1', splitForAllTy_ty_maybe t2') of -- forall over tvar - { (Just (tv1,t1), Just (tv2,t2)) - | k1' `eqType` tyVarKind tv1 - , k2' `eqType` tyVarKind tv2 - -> return (k3, k4, - substTyWithInScope in_scope [tv1] [s1] t1, - substTyWithInScope in_scope [tv2] [s2] t2, r) + { (Just (tv1,_), Just (tv2,_)) + | typeKind s1 `eqType` tyVarKind tv1 + , typeKind s2 `eqType` tyVarKind tv2 + -> return (InstCo co' arg') | otherwise -> failWithL (text "Kind mis-match in inst coercion") + ; _ -> case (splitForAllTy_co_maybe t1', splitForAllTy_co_maybe t2') of -- forall over covar - { (Just (cv1, t1), Just (cv2, t2)) - | k1' `eqType` varType cv1 - , k2' `eqType` varType cv2 - , CoercionTy s1' <- s1 - , CoercionTy s2' <- s2 - -> do { return $ - (liftedTypeKind, liftedTypeKind - -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep - , substTy (mkCvSubst in_scope $ unitVarEnv cv1 s1') t1 - , substTy (mkCvSubst in_scope $ unitVarEnv cv2 s2') t2 - , r) } + { (Just (cv1, _), Just (cv2, _)) + | typeKind s1 `eqType` varType cv1 + , typeKind s2 `eqType` varType cv2 + , CoercionTy _ <- s1 + , CoercionTy _ <- s2 + -> return (InstCo co' arg') | otherwise -> failWithL (text "Kind mis-match in inst coercion") + ; _ -> failWithL (text "Bad argument of inst") }}} lintCoercion co@(AxiomInstCo con ind cos) @@ -2031,67 +2012,63 @@ lintCoercion co@(AxiomInstCo con ind cos) (bad_ax (text "index out of range")) ; let CoAxBranch { cab_tvs = ktvs , cab_cvs = cvs - , cab_roles = roles - , cab_lhs = lhs - , cab_rhs = rhs } = coAxiomNthBranch con ind + , cab_roles = roles } = coAxiomNthBranch con ind ; unless (cos `equalLength` (ktvs ++ cvs)) $ bad_ax (text "lengths") + ; cos' <- mapM lintCoercion cos ; subst <- getTCvSubst ; let empty_subst = zapTCvSubst subst - ; (subst_l, subst_r) <- foldlM check_ki - (empty_subst, empty_subst) - (zip3 (ktvs ++ cvs) roles cos) - ; let lhs' = substTys subst_l lhs - rhs' = substTy subst_r rhs - fam_tc = coAxiomTyCon con + ; _ <- foldlM check_ki (empty_subst, empty_subst) + (zip3 (ktvs ++ cvs) roles cos') + ; let fam_tc = coAxiomTyCon con ; case checkAxInstCo co of Just bad_branch -> bad_ax $ text "inconsistent with" <+> pprCoAxBranch fam_tc bad_branch Nothing -> return () - ; let s2 = mkTyConApp fam_tc lhs' - ; return (typeKind s2, typeKind rhs', s2, rhs', coAxiomRole con) } + ; return (AxiomInstCo con ind cos') } where bad_ax what = addErrL (hang (text "Bad axiom application" <+> parens what) 2 (ppr co)) - check_ki (subst_l, subst_r) (ktv, role, arg) - = do { (k', k'', s', t', r) <- lintCoercion arg - ; lintRole arg role r + check_ki (subst_l, subst_r) (ktv, role, arg') + = do { let Pair s' t' = coercionKind arg' + sk' = typeKind s' + tk' = typeKind t' + ; lintRole arg' role (coercionRole arg') ; let ktv_kind_l = substTy subst_l (tyVarKind ktv) ktv_kind_r = substTy subst_r (tyVarKind ktv) - ; unless (k' `eqType` ktv_kind_l) - (bad_ax (text "check_ki1" <+> vcat [ ppr co, ppr k', ppr ktv, ppr ktv_kind_l ] )) - ; unless (k'' `eqType` ktv_kind_r) - (bad_ax (text "check_ki2" <+> vcat [ ppr co, ppr k'', ppr ktv, ppr ktv_kind_r ] )) + ; unless (sk' `eqType` ktv_kind_l) + (bad_ax (text "check_ki1" <+> vcat [ ppr co, ppr sk', ppr ktv, ppr ktv_kind_l ] )) + ; unless (tk' `eqType` ktv_kind_r) + (bad_ax (text "check_ki2" <+> vcat [ ppr co, ppr tk', ppr ktv, ppr ktv_kind_r ] )) ; return (extendTCvSubst subst_l ktv s', extendTCvSubst subst_r ktv t') } lintCoercion (KindCo co) - = do { (k1, k2, _, _, _) <- lintCoercion co - ; return (liftedTypeKind, liftedTypeKind, k1, k2, Nominal) } + = do { co' <- lintCoercion co + ; return (KindCo co') } lintCoercion (SubCo co') - = do { (k1,k2,s,t,r) <- lintCoercion co' - ; lintRole co' Nominal r - ; return (k1,k2,s,t,Representational) } - -lintCoercion this@(AxiomRuleCo co cs) - = do { eqs <- mapM lintCoercion cs - ; lintRoles 0 (coaxrAsmpRoles co) eqs - ; case coaxrProves co [ Pair l r | (_,_,l,r,_) <- eqs ] of + = do { co' <- lintCoercion co' + ; lintRole co' Nominal (coercionRole co') + ; return (SubCo co') } + +lintCoercion this@(AxiomRuleCo ax cos) + = do { cos' <- mapM lintCoercion cos + ; lintRoles 0 (coaxrAsmpRoles ax) cos' + ; case coaxrProves ax (map coercionKind cos') of Nothing -> err "Malformed use of AxiomRuleCo" [ ppr this ] - Just (Pair l r) -> - return (typeKind l, typeKind r, l, r, coaxrRole co) } + Just _ -> return (AxiomRuleCo ax cos') } where err m xs = failWithL $ - hang (text m) 2 $ vcat (text "Rule:" <+> ppr (coaxrName co) : xs) + hang (text m) 2 $ vcat (text "Rule:" <+> ppr (coaxrName ax) : xs) - lintRoles n (e : es) ((_,_,_,_,r) : rs) - | e == r = lintRoles (n+1) es rs + lintRoles n (e : es) (co : cos) + | e == coercionRole co = lintRoles (n+1) es cos | otherwise = err "Argument roles mismatch" [ text "In argument:" <+> int (n+1) , text "Expected:" <+> ppr e - , text "Found:" <+> ppr r ] + , text "Found:" <+> ppr (coercionRole co) ] lintRoles _ [] [] = return () lintRoles n [] rs = err "Too many coercion arguments" [ text "Expected:" <+> int n @@ -2106,13 +2083,6 @@ lintCoercion (HoleCo h) ; lintCoercion (CoVarCo (coHoleCoVar h)) } ----------- -lintUnliftedCoVar :: CoVar -> LintM () -lintUnliftedCoVar cv - = when (not (isUnliftedType (coVarKind cv))) $ - failWithL (text "Bad lifted equality:" <+> ppr cv - <+> dcolon <+> ppr (coVarKind cv)) - {- ************************************************************************ * * @@ -2129,12 +2099,13 @@ data LintEnv , le_subst :: TCvSubst -- Current TyCo substitution -- See Note [Linting type lets] - -- /Only/ substitutes for type variables; - -- but might clone CoVars - -- We also use le_subst to keep track of - -- in-scope TyVars and CoVars + -- /Only/ substitutes for type variables; + -- but might clone CoVars + -- We also use le_subst to keep track of + -- in-scope TyVars and CoVars (but not Ids) + -- Range of the TCvSubst is LintedType/LintedCo - , le_ids :: IdSet -- In-scope Ids + , le_ids :: IdSet -- In-scope Ids; all Linted , le_joins :: IdSet -- Join points in scope that are valid -- A subset of the InScopeSet in le_subst -- See Note [Join points] @@ -2266,6 +2237,7 @@ instance HasDynFlags LintM where data LintLocInfo = RhsOf Id -- The variable bound + | OccOf Id -- Occurrence of id | LambdaBodyOf Id -- The lambda-binder | UnfoldingOf Id -- Unfolding of a binder | BodyOfLetRec [Id] -- One of the binders @@ -2278,7 +2250,6 @@ data LintLocInfo | ImportedUnfolding SrcLoc -- Some imported unfolding (ToDo: say which) | TopLevelBindings | InType Type -- Inside a type - | InKind Type Kind -- Inside a kind | InCo Coercion -- Inside a coercion initL :: DynFlags -> LintFlags -> [Var] @@ -2341,7 +2312,7 @@ addWarnL msg = LintM $ \ env (warns,errs) -> addMsg :: Bool -> LintEnv -> Bag MsgDoc -> MsgDoc -> Bag MsgDoc addMsg is_error env msgs msg - = ASSERT( notNull loc_msgs ) + = WARN( notNull loc_msgs, msg ) msgs `snocBag` mk_msg msg where loc_msgs :: [(SrcLoc, SDoc)] -- Innermost first @@ -2373,16 +2344,15 @@ inCasePat = LintM $ \ env errs -> (Just (is_case_pat env), errs) is_case_pat (LE { le_loc = CasePat {} : _ }) = True is_case_pat _other = False -addInScopeTyCoVar :: Var -> LintM a -> LintM a -addInScopeTyCoVar var m - = LintM $ \ env errs -> - unLintM m (env { le_subst = extendTCvInScope (le_subst env) var }) errs - addInScopeId :: Id -> LintM a -> LintM a addInScopeId id m - = LintM $ \ env errs -> - unLintM m (env { le_ids = extendVarSet (le_ids env) id - , le_joins = delVarSet (le_joins env) id }) errs + = LintM $ \ env@(LE { le_ids = id_set, le_joins = join_set }) errs -> + unLintM m (env { le_ids = extendVarSet id_set id + , le_joins = add_joins join_set }) errs + where + add_joins join_set + | isJoinId id = extendVarSet join_set id -- Overwrite with new arity + | otherwise = delVarSet join_set id -- Remove any existing binding getInScopeIds :: LintM IdSet getInScopeIds = LintM (\env errs -> (Just (le_ids env), errs)) @@ -2404,13 +2374,6 @@ markAllJoinsBadIf :: Bool -> LintM a -> LintM a markAllJoinsBadIf True m = markAllJoinsBad m markAllJoinsBadIf False m = m -addGoodJoins :: [Var] -> LintM a -> LintM a -addGoodJoins vars thing_inside - = LintM $ \ env errs -> unLintM thing_inside (add_joins env) errs - where - add_joins env = env { le_joins = le_joins env `extendVarSetList` join_ids } - join_ids = filter isJoinId vars - getValidJoins :: LintM IdSet getValidJoins = LintM (\ env errs -> (Just (le_joins env), errs)) @@ -2420,12 +2383,6 @@ getTCvSubst = LintM (\ env errs -> (Just (le_subst env), errs)) getInScope :: LintM InScopeSet getInScope = LintM (\ env errs -> (Just (getTCvInScope $ le_subst env), errs)) -applySubstTy :: InType -> LintM OutType -applySubstTy ty = do { subst <- getTCvSubst; return (substTy subst ty) } - -applySubstCo :: InCoercion -> LintM OutCoercion -applySubstCo co = do { subst <- getTCvSubst; return (substCo subst co) } - lookupIdInScope :: Id -> LintM Id lookupIdInScope id_occ = do { in_scope_ids <- getInScopeIds @@ -2461,16 +2418,7 @@ lookupJoinId id Just id' -> return (isJoinId_maybe id') Nothing -> return Nothing } -lintTyCoVarInScope :: TyCoVar -> LintM TyCoVar -lintTyCoVarInScope var - = do { subst <- getTCvSubst - ; case lookupInScope (getTCvInScope subst) var of - Just var' -> return var' - Nothing -> failWithL $ - hang (text "The TyCo variable" <+> pprBndr LetBind var) - 2 (text "is out of scope") } - -ensureEqTys :: OutType -> OutType -> MsgDoc -> LintM () +ensureEqTys :: LintedType -> LintedType -> MsgDoc -> LintM () -- check ty2 is subtype of ty1 (ie, has same structure but usage -- annotations need only be consistent, not equal) -- Assumes ty1,ty2 are have already had the substitution applied @@ -2500,6 +2448,9 @@ dumpLoc :: LintLocInfo -> (SrcLoc, SDoc) dumpLoc (RhsOf v) = (getSrcLoc v, text "In the RHS of" <+> pp_binders [v]) +dumpLoc (OccOf v) + = (getSrcLoc v, text "In an occurrence of" <+> pp_binder v) + dumpLoc (LambdaBodyOf b) = (getSrcLoc b, text "In the body of lambda with binder" <+> pp_binder b) @@ -2534,8 +2485,6 @@ dumpLoc TopLevelBindings = (noSrcLoc, Outputable.empty) dumpLoc (InType ty) = (noSrcLoc, text "In the type" <+> quotes (ppr ty)) -dumpLoc (InKind ty ki) - = (noSrcLoc, text "In the kind of" <+> parens (ppr ty <+> dcolon <+> ppr ki)) dumpLoc (InCo co) = (noSrcLoc, text "In the coercion" <+> quotes (ppr co)) @@ -2780,7 +2729,7 @@ mkJoinBndrOccMismatchMsg bndr join_arity_bndr join_arity_occ , text "Arity at binding site:" <+> ppr join_arity_bndr , text "Arity at occurrence: " <+> ppr join_arity_occ ] -mkBndrOccTypeMismatchMsg :: Var -> Var -> OutType -> OutType -> SDoc +mkBndrOccTypeMismatchMsg :: Var -> Var -> LintedType -> LintedType -> SDoc mkBndrOccTypeMismatchMsg bndr var bndr_ty var_ty = vcat [ text "Mismatch in type between binder and occurrence" , text "Binder:" <+> ppr bndr <+> dcolon <+> ppr bndr_ty ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -2447,7 +2447,7 @@ normally it would make no sense to have forall r. (ty :: K r) because the kind of the forall would escape the binding of 'r'. But in this case it's fine because (K r) exapands -to Type, so we expliclity /permit/ the type +to Type, so we explicitly /permit/ the type forall r. T r To accommodate such a type, in typeKind (forall a.ty) we use @@ -2455,8 +2455,13 @@ occCheckExpand to expand any type synonyms in the kind of 'ty' to eliminate 'a'. See kinding rule (FORALL) in Note [Kinding rules for types] -And in TcValidity.checkEscapingKind, we use also use -occCheckExpand, for the same reason. +See also + * TcUnify.occCheckExpand + * GHC.Core.Utils.coreAltsType + * TcValidity.checkEscapingKind +all of which grapple with with the same problem. + +See #14939. -} ----------------------------- ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -2274,22 +2274,31 @@ pprStmt (ApplicativeStmt _ args mb_join) (if lengthAtLeast args 2 then parens else id) ap_expr pp_arg :: (a, ApplicativeArg (GhcPass idL)) -> SDoc - pp_arg (_, ApplicativeArgOne _ pat expr isBody _) - | isBody = -- See Note [Applicative BodyStmt] - ppr (BodyStmt (panic "pprStmt") expr noSyntaxExpr noSyntaxExpr + pp_arg (_, applicativeArg) = ppr applicativeArg + +pprStmt (XStmtLR x) = ppr x + + +instance (OutputableBndrId idL) + => Outputable (ApplicativeArg (GhcPass idL)) where + ppr = pprArg + +pprArg :: forall idL . (OutputableBndrId idL) => ApplicativeArg (GhcPass idL) -> SDoc +pprArg (ApplicativeArgOne _ pat expr isBody _) + | isBody = -- See Note [Applicative BodyStmt] + ppr (BodyStmt (panic "pprStmt") expr noSyntaxExpr noSyntaxExpr :: ExprStmt (GhcPass idL)) - | otherwise = - ppr (BindStmt (panic "pprStmt") pat expr noSyntaxExpr noSyntaxExpr + | otherwise = + ppr (BindStmt (panic "pprStmt") pat expr noSyntaxExpr noSyntaxExpr :: ExprStmt (GhcPass idL)) - pp_arg (_, ApplicativeArgMany _ stmts return pat) = +pprArg (ApplicativeArgMany _ stmts return pat) = ppr pat <+> text "<-" <+> ppr (HsDo (panic "pprStmt") DoExpr (noLoc (stmts ++ [noLoc (LastStmt noExtField (noLoc return) Nothing noSyntaxExpr)]))) - pp_arg (_, XApplicativeArg x) = ppr x -pprStmt (XStmtLR x) = ppr x +pprArg (XApplicativeArg x) = ppr x pprTransformStmt :: (OutputableBndrId p) => [IdP (GhcPass p)] -> LHsExpr (GhcPass p) ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -1498,7 +1498,7 @@ ApplicativeDo touches a few phases in the compiler: scheduled as outlined above and transformed into applicative combinators. However, the code is still represented as a do-block with special forms of applicative statements. This allows us to - recover the original do-block when e.g. printing type errors, where + recover the original do-block when e.g. printing type errors, where we don't want to show any of the applicative combinators since they don't exist in the source code. See ApplicativeStmt and ApplicativeArg in HsExpr. @@ -1682,7 +1682,7 @@ stmtTreeToStmts monad_names ctxt (StmtTreeOne (L _ (BindStmt _ pat rhs _ fail_op , is_body_stmt = False , fail_operator = fail_op}] False tail' -stmtTreeToStmts monad_names ctxt (StmtTreeOne (L _ (BodyStmt _ rhs _ fail_op),_)) +stmtTreeToStmts monad_names ctxt (StmtTreeOne (L _ (BodyStmt _ rhs _ _),_)) tail _tail_fvs | (False,tail') <- needJoin monad_names tail = mkApplicativeStmt ctxt @@ -1691,7 +1691,7 @@ stmtTreeToStmts monad_names ctxt (StmtTreeOne (L _ (BodyStmt _ rhs _ fail_op),_) , app_arg_pattern = nlWildPatName , arg_expr = rhs , is_body_stmt = True - , fail_operator = fail_op}] False tail' + , fail_operator = noSyntaxExpr}] False tail' stmtTreeToStmts _monad_names _ctxt (StmtTreeOne (s,_)) tail _tail_fvs = return (s : tail, emptyNameSet) @@ -1706,7 +1706,8 @@ stmtTreeToStmts monad_names ctxt (StmtTreeApplicative trees) tail tail_fvs = do pairs <- mapM (stmtTreeArg ctxt tail_fvs) trees let (stmts', fvss) = unzip pairs let (need_join, tail') = - if any hasStrictPattern trees + -- See Note [ApplicativeDo and refutable patterns] + if any hasRefutablePattern stmts' then (True, tail) else needJoin monad_names tail @@ -1721,13 +1722,13 @@ stmtTreeToStmts monad_names ctxt (StmtTreeApplicative trees) tail tail_fvs = do , is_body_stmt = False , fail_operator = fail_op }, emptyFVs) - stmtTreeArg _ctxt _tail_fvs (StmtTreeOne (L _ (BodyStmt _ exp _ fail_op), _)) = + stmtTreeArg _ctxt _tail_fvs (StmtTreeOne (L _ (BodyStmt _ exp _ _), _)) = return (ApplicativeArgOne { xarg_app_arg_one = noExtField , app_arg_pattern = nlWildPatName , arg_expr = exp , is_body_stmt = True - , fail_operator = fail_op + , fail_operator = noSyntaxExpr }, emptyFVs) stmtTreeArg ctxt tail_fvs tree = do let stmts = flattenStmtTree tree @@ -1854,12 +1855,19 @@ isStrictPattern lpat = SplicePat{} -> True _otherwise -> panic "isStrictPattern" -hasStrictPattern :: ExprStmtTree -> Bool -hasStrictPattern (StmtTreeOne (L _ (BindStmt _ pat _ _ _), _)) = isStrictPattern pat -hasStrictPattern (StmtTreeOne _) = False -hasStrictPattern (StmtTreeBind a b) = hasStrictPattern a || hasStrictPattern b -hasStrictPattern (StmtTreeApplicative trees) = any hasStrictPattern trees +{- +Note [ApplicativeDo and refutable patterns] + +Refutable patterns in do blocks are desugared to use the monadic 'fail' operation. +This means that sometimes an applicative block needs to be wrapped in 'join' simply because +of a refutable pattern, in order for the types to work out. + +-} +hasRefutablePattern :: ApplicativeArg GhcRn -> Bool +hasRefutablePattern (ApplicativeArgOne { app_arg_pattern = pat + , is_body_stmt = False}) = not (isIrrefutableHsPat pat) +hasRefutablePattern _ = False isLetStmt :: LStmt a b -> Bool isLetStmt (L _ LetStmt{}) = True ===================================== libraries/base/Data/Semigroup.hs ===================================== @@ -286,7 +286,15 @@ instance Num a => Num (Max a) where -- | 'Arg' isn't itself a 'Semigroup' in its own right, but it can be -- placed inside 'Min' and 'Max' to compute an arg min or arg max. -data Arg a b = Arg a b deriving +-- +-- >>> minimum [ Arg (x * x) x | x <- [-10 .. 10] ] +-- Arg 0 0 +data Arg a b = Arg + a + -- ^ The argument used for comparisons in 'Eq' and 'Ord'. + b + -- ^ The "value" exposed via the 'Functor', 'Foldable' etc. instances. + deriving ( Show -- ^ @since 4.9.0.0 , Read -- ^ @since 4.9.0.0 , Data -- ^ @since 4.9.0.0 ===================================== testsuite/tests/ado/T13242a.stderr ===================================== @@ -32,10 +32,15 @@ T13242a.hs:13:11: error: ...plus 21 others ...plus six instances involving out-of-scope types (use -fprint-potential-instances to see them all) - • In the first argument of ‘return’, namely ‘(x == x)’ In a stmt of a 'do' block: return (x == x) In the expression: do A x <- undefined _ <- return 'a' _ <- return 'b' return (x == x) + In an equation for ‘test’: + test + = do A x <- undefined + _ <- return 'a' + _ <- return 'b' + return (x == x) ===================================== testsuite/tests/ado/T17835.hs ===================================== @@ -0,0 +1,38 @@ +-- Build.hs +{-# LANGUAGE ApplicativeDo #-} +module Build (configRules) where + +type Action = IO +type Rules = IO + +type Config = () + +(%>) :: String -> (String -> Action ()) -> Rules () +(%>) = undefined + +command_ :: [String] -> String -> [String] -> Action () +command_ = undefined + +recursive :: Config -> String -> [String] -> IO (FilePath, [String]) +recursive = undefined + +liftIO :: IO a -> Action a +liftIO = id + +need :: [String] -> Action () +need = undefined + +historyDisable :: Action () +historyDisable = undefined + +get_config :: () -> Action Config +get_config = undefined + +configRules :: Rules () +configRules = do + "snapshot" %> \out -> do + historyDisable -- 8.10-rc1 refuses to compile without bind here + config <- get_config () + need [] + (exe,args) <- liftIO $ recursive config "snapshot" [] + command_ [] exe args ===================================== testsuite/tests/ado/ado001.stdout ===================================== @@ -9,4 +9,4 @@ a; ((b | c) | d) ((a | (b; c)) | d) | e ((a | b); (c | d)) | e a | b -(a | (b; c)) +a | (b; c) ===================================== testsuite/tests/ado/all.T ===================================== @@ -17,3 +17,4 @@ test('T13875', normal, compile_and_run, ['']) test('T14163', normal, compile_and_run, ['']) test('T15344', normal, compile_and_run, ['']) test('T16628', normal, compile_fail, ['']) +test('T17835', normal, compile, ['']) ===================================== testsuite/tests/indexed-types/should_compile/T17923.hs ===================================== @@ -0,0 +1,44 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# OPTIONS_GHC -Wall #-} +module Bug where + +import Data.Kind + +-- type SingFunction2 f = forall t1 t2. Sing t1 -> Sing t2 -> Sing (f `Apply` t1 `Apply` t2) +type SingFunction2 f = forall t1. Sing t1 -> forall t2. Sing t2 -> Sing (f `Apply` t1 `Apply` t2) +singFun2 :: forall f. SingFunction2 f -> Sing f +singFun2 f = SLambda (\x -> SLambda (f x)) + +type family Sing :: k -> Type +data TyFun :: Type -> Type -> Type +type a ~> b = TyFun a b -> Type +infixr 0 ~> + +type family Apply (f :: a ~> b) (x :: a) :: b +data Sym4 a +data Sym3 a + +type instance Apply Sym3 _ = Sym4 + +newtype SLambda (f :: k1 ~> k2) = + SLambda { applySing :: forall t. Sing t -> Sing (Apply f t) } +type instance Sing = SLambda + +und :: a +und = undefined + +data E +data ShowCharSym0 :: E ~> E ~> E + +sShow_tuple :: SLambda Sym4 +sShow_tuple + = applySing (singFun2 @Sym3 und) + (und (singFun2 @Sym3 + (und (applySing (singFun2 @Sym3 und) + (applySing (singFun2 @ShowCharSym0 und) und))))) ===================================== testsuite/tests/indexed-types/should_compile/all.T ===================================== @@ -294,3 +294,4 @@ test('T16828', normal, compile, ['']) test('T17008b', normal, compile, ['']) test('T17056', normal, compile, ['']) test('T17405', normal, multimod_compile, ['T17405c', '-v0']) +test('T17923', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ecf4d5e80a2e616c427f7f078162c4d29235002d...777f8c36c41fb37cf3601dab96f58f8908b4e539 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ecf4d5e80a2e616c427f7f078162c4d29235002d...777f8c36c41fb37cf3601dab96f58f8908b4e539 You're receiving 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 Mar 24 14:59:00 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 24 Mar 2020 10:59:00 -0400 Subject: [Git][ghc/ghc] Pushed new tag ghc-8.10.1-release Message-ID: <5e7a2034ad32a_61671196b3f4328144@gitlab.haskell.org.mail> Ben Gamari pushed new tag ghc-8.10.1-release at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/ghc-8.10.1-release You're receiving 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 Mar 24 15:23:07 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 24 Mar 2020 11:23:07 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/ftext-no-length Message-ID: <5e7a25db869c8_61673f8198ee100c33695b@gitlab.haskell.org.mail> Sebastian Graf pushed new branch wip/ftext-no-length at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/ftext-no-length You're receiving 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 Mar 24 15:29:16 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Tue, 24 Mar 2020 11:29:16 -0400 Subject: [Git][ghc/ghc][wip/T17923] Significant refactor of Lint Message-ID: <5e7a274ccd5e2_616713339fc4343328@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T17923 at Glasgow Haskell Compiler / GHC Commits: 5aca7133 by Simon Peyton Jones at 2020-03-24T15:28:29+00: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. - - - - - 4 changed files: - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Type.hs - + testsuite/tests/indexed-types/should_compile/T17923.hs - testsuite/tests/indexed-types/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -8,7 +8,7 @@ See Note [Core Lint guarantee]. -} {-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE ScopedTypeVariables, DeriveFunctor #-} module GHC.Core.Lint ( lintCoreBindings, lintUnfolding, @@ -33,7 +33,6 @@ import GHC.Core.Op.Monad import Bag import Literal import GHC.Core.DataCon -import TysWiredIn import TysPrim import TcType ( isFloatingTy ) import Var @@ -461,14 +460,17 @@ lintCoreBindings :: DynFlags -> CoreToDo -> [Var] -> CoreProgram -> (Bag MsgDoc, lintCoreBindings dflags pass local_in_scope binds = initL dflags flags local_in_scope $ addLoc TopLevelBindings $ - lintLetBndrs TopLevel binders $ - -- Put all the top-level binders in scope at the start - -- This is because transformation rules can bring something - -- into use 'unexpectedly' do { checkL (null dups) (dupVars dups) ; checkL (null ext_dups) (dupExtVars ext_dups) - ; mapM lint_bind binds } + ; lintRecBindings TopLevel all_pairs $ + return () } where + all_pairs = flattenBinds binds + -- Put all the top-level binders in scope at the start + -- This is because transformation rules can bring something + -- into use 'unexpectedly'; see Note [Glomming] in OccurAnal + binders = map fst all_pairs + flags = defaultLintFlags { lf_check_global_ids = check_globals , lf_check_inline_loop_breakers = check_lbs @@ -494,7 +496,6 @@ lintCoreBindings dflags pass local_in_scope binds CorePrep -> AllowAtTopLevel _ -> AllowAnywhere - binders = bindersOfBinds binds (_, dups) = removeDups compare binders -- dups_ext checks for names with different uniques @@ -509,11 +510,6 @@ lintCoreBindings dflags pass local_in_scope binds = compare (m1, nameOccName n1) (m2, nameOccName n2) | otherwise = LT - -- If you edit this function, you may need to update the GHC formalism - -- See Note [GHC Formalism] - lint_bind (Rec prs) = mapM_ (lintSingleBinding TopLevel Recursive) prs - lint_bind (NonRec bndr rhs) = lintSingleBinding TopLevel NonRecursive (bndr,rhs) - {- ************************************************************************ * * @@ -576,28 +572,32 @@ lintExpr dflags vars expr Check a core binding, returning the list of variables bound. -} -lintSingleBinding :: TopLevelFlag -> RecFlag -> (Id, CoreExpr) -> LintM () --- If you edit this function, you may need to update the GHC formalism --- See Note [GHC Formalism] -lintSingleBinding top_lvl_flag rec_flag (binder,rhs) - = addLoc (RhsOf binder) $ - -- Check the rhs - do { ty <- lintRhs binder rhs - ; binder_ty <- applySubstTy (idType binder) - ; ensureEqTys binder_ty ty (mkRhsMsg binder (text "RHS") ty) +lintRecBindings :: TopLevelFlag -> [(Id, CoreExpr)] + -> LintM a -> LintM a +lintRecBindings top_lvl pairs thing_inside + = lintIdBndrs top_lvl bndrs $ \ bndrs' -> + do { zipWithM_ lint_pair bndrs' rhss + ; thing_inside } + where + (bndrs, rhss) = unzip pairs + lint_pair bndr' rhs + = addLoc (RhsOf bndr') $ + do { rhs_ty <- lintRhs bndr' rhs -- Check the rhs + ; lintLetBind top_lvl Recursive bndr' rhs rhs_ty } + +lintLetBind :: TopLevelFlag -> RecFlag -> LintedId + -> CoreExpr -> LintedType -> LintM () +-- Binder's type, and the RHS, have already been linted +-- This function checks other invariants +lintLetBind top_lvl rec_flag binder rhs rhs_ty + = do { let binder_ty = idType binder + ; ensureEqTys binder_ty rhs_ty (mkRhsMsg binder (text "RHS") rhs_ty) -- If the binding is for a CoVar, the RHS should be (Coercion co) -- See Note [Core type and coercion invariant] in GHC.Core ; checkL (not (isCoVar binder) || isCoArg rhs) (mkLetErr binder rhs) - -- Check that it's not levity-polymorphic - -- Do this first, because otherwise isUnliftedType panics - -- Annoyingly, this duplicates the test in lintIdBdr, - -- because for non-rec lets we call lintSingleBinding first - ; checkL (isJoinId binder || not (isTypeLevPoly binder_ty)) - (badBndrTyMsg binder (text "levity-polymorphic")) - -- Check the let/app invariant -- See Note [Core let/app invariant] in GHC.Core ; checkL ( isJoinId binder @@ -610,14 +610,14 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs) -- 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_flag)) + || (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]. - ; checkL (not (isTopLevel top_lvl_flag && binder_ty `eqType` addrPrimTy) + ; checkL (not (isTopLevel top_lvl && binder_ty `eqType` addrPrimTy) || exprIsTickedString rhs) (mkTopNonLitStrMsg binder) @@ -674,7 +674,9 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs) -- join point. -- -- See Note [Checking StaticPtrs]. -lintRhs :: Id -> CoreExpr -> LintM OutType +lintRhs :: Id -> CoreExpr -> LintM LintedType +-- NB: the Id can be Linted or not -- it's only used for +-- its OccInfo and join-pointer-hood lintRhs bndr rhs | Just arity <- isJoinId_maybe bndr = lint_join_lams arity arity True rhs @@ -761,13 +763,14 @@ hurts us here. ************************************************************************ -} --- For OutType, OutKind, the substitution has been applied, --- but has not been linted yet - -type LintedType = Type -- Substitution applied, and type is linted -type LintedKind = Kind +-- Linted things: substitution applied, and type is linted +type LintedType = Type +type LintedKind = Kind +type LintedCoercion = Coercion +type LintedTyCoVar = TyCoVar +type LintedId = Id -lintCoreExpr :: CoreExpr -> LintM OutType +lintCoreExpr :: CoreExpr -> LintM LintedType -- The returned type has the substitution from the monad -- already applied to it: -- lintCoreExpr e subst = exprType (subst e) @@ -776,6 +779,7 @@ lintCoreExpr :: CoreExpr -> LintM OutType -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] + lintCoreExpr (Var var) = lintVarOcc var 0 @@ -784,10 +788,11 @@ lintCoreExpr (Lit lit) lintCoreExpr (Cast expr co) = do { expr_ty <- markAllJoinsBad $ lintCoreExpr expr - ; co' <- applySubstCo co - ; (_, k2, from_ty, to_ty, r) <- lintCoercion co' - ; checkValueKind k2 (text "target of cast" <+> quotes (ppr co)) - ; lintRole co' Representational r + ; co' <- lintCoercion co + ; let (Pair from_ty to_ty, role) = coercionKindRole co' + ; checkValueKind (typeKind to_ty) $ + text "target of cast" <+> quotes (ppr co') + ; lintRole co' Representational role ; ensureEqTys from_ty expr_ty (mkCastErr expr co' from_ty expr_ty) ; return to_ty } @@ -809,7 +814,7 @@ lintCoreExpr (Tick tickish expr) lintCoreExpr (Let (NonRec tv (Type ty)) body) | isTyVar tv = -- See Note [Linting type lets] - do { ty' <- applySubstTy ty + do { ty' <- lintType ty ; lintTyBndr tv $ \ tv' -> do { addLoc (RhsOf tv) $ lintTyKind tv' ty' -- Now extend the substitution so we @@ -820,33 +825,34 @@ lintCoreExpr (Let (NonRec tv (Type ty)) body) lintCoreExpr (Let (NonRec bndr rhs) body) | isId bndr - = do { lintSingleBinding NotTopLevel NonRecursive (bndr,rhs) - ; addLoc (BodyOfLetRec [bndr]) - (lintBinder LetBind bndr $ \_ -> - addGoodJoins [bndr] $ - lintCoreExpr body) } + = do { -- First Lint the RHS, before bringing the binder into scope + rhs_ty <- lintRhs bndr rhs + + -- Now lint the binder + ; lintBinder LetBind bndr $ \bndr' -> + do { lintLetBind NotTopLevel NonRecursive bndr' rhs rhs_ty + ; addLoc (BodyOfLetRec [bndr]) (lintCoreExpr body) } } | otherwise = failWithL (mkLetErr bndr rhs) -- Not quite accurate lintCoreExpr e@(Let (Rec pairs) body) - = lintLetBndrs NotTopLevel bndrs $ - addGoodJoins bndrs $ - do { -- Check that the list of pairs is non-empty + = do { -- Check that the list of pairs is non-empty checkL (not (null pairs)) (emptyRec e) -- Check that there are no duplicated binders + ; let (_, dups) = removeDups compare bndrs ; checkL (null dups) (dupVars dups) -- Check that either all the binders are joins, or none ; checkL (all isJoinId bndrs || all (not . isJoinId) bndrs) $ - mkInconsistentRecMsg bndrs + mkInconsistentRecMsg bndrs - ; mapM_ (lintSingleBinding NotTopLevel Recursive) pairs - ; addLoc (BodyOfLetRec bndrs) (lintCoreExpr body) } + ; lintRecBindings NotTopLevel pairs $ + addLoc (BodyOfLetRec bndrs) $ + lintCoreExpr body } where bndrs = map fst pairs - (_, dups) = removeDups compare bndrs lintCoreExpr e@(App _ _) = do { fun_ty <- lintCoreFun fun (length args) @@ -867,20 +873,27 @@ lintCoreExpr (Type ty) = failWithL (text "Type found as expression" <+> ppr ty) lintCoreExpr (Coercion co) - = do { (k1, k2, ty1, ty2, role) <- lintInCo co - ; return (mkHeteroCoercionType role k1 k2 ty1 ty2) } + = do { co' <- addLoc (InCo co) $ + lintCoercion co + ; return (coercionType co') } ---------------------- lintVarOcc :: Var -> Int -- Number of arguments (type or value) being passed - -> LintM Type -- returns type of the *variable* + -> LintM LintedType -- returns type of the *variable* lintVarOcc var nargs - = do { checkL (isNonCoVarId var) + = addLoc (OccOf var) $ + do { checkL (isNonCoVarId var) (text "Non term variable" <+> ppr var) -- See GHC.Core Note [Variable occurrences in Core] -- Check that the type of the occurrence is the same - -- as the type of the binding site - ; ty <- applySubstTy (idType var) + -- as the type of the binding site. We lint the type so that + -- we apply the substitution. Actually this will get into trouble + -- with /\a. \(x::Maybe a). /\a. ...(x::Maybe a)... + -- The "::Maybe a" on the occurrence is referring to the /outer/ a. + -- But this naive check will treat it like the inner one. + -- This looks like a bug waiting to happen. + ; ty <- lintType (idType var) ; var' <- lookupIdInScope var ; let ty' = idType var' ; ensureEqTys ty ty' $ mkBndrOccTypeMismatchMsg var' var ty' ty @@ -898,8 +911,8 @@ lintVarOcc var nargs ; return (idType var') } lintCoreFun :: CoreExpr - -> Int -- Number of arguments (type or val) being passed - -> LintM Type -- Returns type of the *function* + -> Int -- Number of arguments (type or val) being passed + -> LintM LintedType -- Returns type of the *function* lintCoreFun (Var var) nargs = lintVarOcc var nargs @@ -941,7 +954,9 @@ checkJoinOcc var n_args = do { mb_join_arity_bndr <- lookupJoinId var ; case mb_join_arity_bndr of { Nothing -> -- Binder is not a join point - addErrL (invalidJoinOcc var) ; + do { join_set <- getValidJoins + ; addErrL (text "join set " <+> ppr join_set $$ + invalidJoinOcc var) } ; Just join_arity_bndr -> @@ -1038,15 +1053,15 @@ subtype of the required type, as one would expect. -} -lintCoreArgs :: OutType -> [CoreArg] -> LintM OutType +lintCoreArgs :: LintedType -> [CoreArg] -> LintM LintedType lintCoreArgs fun_ty args = foldM lintCoreArg fun_ty args -lintCoreArg :: OutType -> CoreArg -> LintM OutType +lintCoreArg :: LintedType -> CoreArg -> LintM LintedType lintCoreArg fun_ty (Type arg_ty) = do { checkL (not (isCoercionTy arg_ty)) (text "Unnecessary coercion-to-type injection:" <+> ppr arg_ty) - ; arg_ty' <- applySubstTy arg_ty + ; arg_ty' <- lintType arg_ty ; lintTyApp fun_ty arg_ty' } lintCoreArg fun_ty arg @@ -1060,11 +1075,12 @@ lintCoreArg fun_ty arg ; checkL (not (isUnliftedType arg_ty) || exprOkForSpeculation arg) (mkLetAppMsg arg) + ; lintValApp arg fun_ty arg_ty } ----------------- -lintAltBinders :: OutType -- Scrutinee type - -> OutType -- Constructor type +lintAltBinders :: LintedType -- Scrutinee type + -> LintedType -- Constructor type -> [OutVar] -- Binders -> LintM () -- If you edit this function, you may need to update the GHC formalism @@ -1080,7 +1096,7 @@ lintAltBinders scrut_ty con_ty (bndr:bndrs) ; lintAltBinders scrut_ty con_ty' bndrs } ----------------- -lintTyApp :: OutType -> OutType -> LintM OutType +lintTyApp :: LintedType -> LintedType -> LintM LintedType lintTyApp fun_ty arg_ty | Just (tv,body_ty) <- splitForAllTy_maybe fun_ty = do { lintTyKind tv arg_ty @@ -1094,7 +1110,7 @@ lintTyApp fun_ty arg_ty = failWithL (mkTyAppMsg fun_ty arg_ty) ----------------- -lintValApp :: CoreExpr -> OutType -> OutType -> LintM OutType +lintValApp :: CoreExpr -> LintedType -> LintedType -> LintM LintedType lintValApp arg fun_ty arg_ty | Just (arg,res) <- splitFunTy_maybe fun_ty = do { ensureEqTys arg arg_ty err1 @@ -1105,17 +1121,17 @@ lintValApp arg fun_ty arg_ty err1 = mkAppMsg fun_ty arg_ty arg err2 = mkNonFunAppMsg fun_ty arg_ty arg -lintTyKind :: OutTyVar -> OutType -> LintM () +lintTyKind :: OutTyVar -> LintedType -> LintM () -- Both args have had substitution applied -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] lintTyKind tyvar arg_ty - = do { arg_kind <- lintType arg_ty - ; unless (arg_kind `eqType` tyvar_kind) - (addErrL (mkKindErrMsg tyvar arg_ty $$ (text "Linted Arg kind:" <+> ppr arg_kind))) } + = unless (arg_kind `eqType` tyvar_kind) $ + addErrL (mkKindErrMsg tyvar arg_ty $$ (text "Linted Arg kind:" <+> ppr arg_kind)) where tyvar_kind = tyVarKind tyvar + arg_kind = typeKind arg_ty {- ************************************************************************ @@ -1125,7 +1141,7 @@ lintTyKind tyvar arg_ty ************************************************************************ -} -lintCaseExpr :: CoreExpr -> Id -> Type -> [CoreAlt] -> LintM OutType +lintCaseExpr :: CoreExpr -> Id -> Type -> [CoreAlt] -> LintM LintedType lintCaseExpr scrut var alt_ty alts = do { let e = Case scrut var alt_ty alts -- Just for error messages @@ -1134,10 +1150,10 @@ lintCaseExpr scrut var alt_ty alts = -- See Note [Join points are less general than the paper] -- in GHC.Core - ; (alt_ty, _) <- addLoc (CaseTy scrut) $ - lintInTy alt_ty - ; (var_ty, _) <- addLoc (IdTy var) $ - lintInTy (idType var) + ; alt_ty <- addLoc (CaseTy scrut) $ + lintValueType alt_ty + ; var_ty <- addLoc (IdTy var) $ + lintValueType (idType var) -- We used to try to check whether a case expression with no -- alternatives was legitimate, but this didn't work. @@ -1179,7 +1195,7 @@ lintCaseExpr scrut var alt_ty alts = ; checkCaseAlts e scrut_ty alts ; return alt_ty } } -checkCaseAlts :: CoreExpr -> OutType -> [CoreAlt] -> LintM () +checkCaseAlts :: CoreExpr -> LintedType -> [CoreAlt] -> LintM () -- a) Check that the alts are non-empty -- b1) Check that the DEFAULT comes first, if it exists -- b2) Check that the others are in increasing order @@ -1219,14 +1235,14 @@ checkCaseAlts e ty alts = Nothing -> False Just tycon -> isPrimTyCon tycon -lintAltExpr :: CoreExpr -> OutType -> LintM () +lintAltExpr :: CoreExpr -> LintedType -> LintM () lintAltExpr expr ann_ty = do { actual_ty <- lintCoreExpr expr ; ensureEqTys actual_ty ann_ty (mkCaseAltMsg expr actual_ty ann_ty) } -- See GHC.Core Note [Case expression invariants] item (6) -lintCoreAlt :: OutType -- Type of scrutinee - -> OutType -- Type of the alternative +lintCoreAlt :: LintedType -- Type of scrutinee + -> LintedType -- Type of the alternative -> CoreAlt -> LintM () -- If you edit this function, you may need to update the GHC formalism @@ -1286,33 +1302,36 @@ lintBinders site (var:vars) linterF = lintBinder site var $ \var' -> -- See Note [GHC Formalism] lintBinder :: BindingSite -> Var -> (Var -> LintM a) -> LintM a lintBinder site var linterF - | isTyVar var = lintTyBndr var linterF - | isCoVar var = lintCoBndr var linterF - | otherwise = lintIdBndr NotTopLevel site var linterF + | isTyCoVar var = lintTyCoBndr var linterF + | otherwise = lintIdBndr NotTopLevel site var linterF -lintTyBndr :: InTyVar -> (OutTyVar -> LintM a) -> LintM a -lintTyBndr tv thing_inside - = do { subst <- getTCvSubst - ; let (subst', tv') = substTyVarBndr subst tv - ; lintKind (varType tv') - ; updateTCvSubst subst' (thing_inside tv') } +lintTyBndr :: TyVar -> (LintedTyCoVar -> LintM a) -> LintM a +lintTyBndr = lintTyCoBndr -- We could specialise it, I guess + +lintCoBndr :: CoVar -> (LintedTyCoVar -> LintM a) -> LintM a +lintCoBndr = lintTyCoBndr -- We could specialise it, I guess -lintCoBndr :: InCoVar -> (OutCoVar -> LintM a) -> LintM a -lintCoBndr cv thing_inside +lintTyCoBndr :: TyCoVar -> (LintedTyCoVar -> LintM a) -> LintM a +lintTyCoBndr tcv thing_inside = do { subst <- getTCvSubst - ; let (subst', cv') = substCoVarBndr subst cv - ; lintKind (varType cv') - ; lintL (isCoVarType (varType cv')) - (text "CoVar with non-coercion type:" <+> pprTyVar cv) - ; updateTCvSubst subst' (thing_inside cv') } - -lintLetBndrs :: TopLevelFlag -> [Var] -> LintM a -> LintM a -lintLetBndrs top_lvl ids linterF - = go ids + ; kind' <- lintType (varType tcv) + ; let tcv' = uniqAway (getTCvInScope subst) $ + setVarType tcv kind' + subst' = extendTCvSubstWithClone subst tcv tcv' + ; when (isCoVar tcv) $ + lintL (isCoVarType kind') + (text "CoVar with non-coercion type:" <+> pprTyVar tcv) + ; updateTCvSubst subst' (thing_inside tcv') } + +lintIdBndrs :: forall a. TopLevelFlag -> [Id] -> ([LintedId] -> LintM a) -> LintM a +lintIdBndrs top_lvl ids thing_inside + = go ids thing_inside where - go [] = linterF - go (id:ids) = lintIdBndr top_lvl LetBind id $ \_ -> - go ids + go :: [Id] -> ([Id] -> LintM a) -> LintM a + go [] thing_inside = thing_inside [] + go (id:ids) thing_inside = lintIdBndr top_lvl LetBind id $ \id' -> + go ids $ \ids' -> + thing_inside (id' : ids') lintIdBndr :: TopLevelFlag -> BindingSite -> InVar -> (OutVar -> LintM a) -> LintM a @@ -1334,14 +1353,15 @@ lintIdBndr top_lvl bind_site id linterF ; checkL (not (isExternalName (Var.varName id)) || is_top_lvl) (mkNonTopExternalNameMsg id) - ; (id_ty, k) <- addLoc (IdTy id) $ - lintInTy (idType id) + ; id_ty <- addLoc (IdTy id) $ + lintValueType (idType id) ; let id' = setIdType id id_ty -- See Note [Levity polymorphism invariants] in GHC.Core - ; lintL (isJoinId id || not (lf_check_levity_poly flags) || not (isKindLevPoly k)) - (text "Levity-polymorphic binder:" <+> - (ppr id <+> dcolon <+> parens (ppr id_ty <+> dcolon <+> ppr k))) + ; lintL (isJoinId id || not (lf_check_levity_poly flags) + || not (isTypeLevPoly id_ty)) $ + text "Levity-polymorphic binder:" <+> ppr id <+> dcolon <+> + parens (ppr id_ty <+> dcolon <+> ppr (typeKind id_ty)) -- Check that a join-id is a not-top-level let-binding ; when (isJoinId id) $ @@ -1378,45 +1398,52 @@ lintTypes dflags vars tys where (_warns, errs) = initL dflags defaultLintFlags vars linter linter = lintBinders LambdaBind vars $ \_ -> - mapM_ lintInTy tys + mapM_ lintType tys -lintInTy :: InType -> LintM (LintedType, LintedKind) +lintValueType :: Type -> LintM LintedType -- Types only, not kinds -- Check the type, and apply the substitution to it -- See Note [Linting type lets] -lintInTy ty +lintValueType ty = addLoc (InType ty) $ - do { ty' <- applySubstTy ty - ; k <- lintType ty' - ; addLoc (InKind ty' k) $ - lintKind k -- The kind returned by lintType is already - -- a LintedKind but we also want to check that - -- k :: *, which lintKind does - ; return (ty', k) } + do { ty' <- lintType ty + ; let sk = typeKind ty' + ; lintL (classifiesTypeWithValues sk) $ + hang (text "Ill-kinded type:" <+> ppr ty) + 2 (text "has kind:" <+> ppr sk) + ; return ty' } checkTyCon :: TyCon -> LintM () checkTyCon tc = checkL (not (isTcTyCon tc)) (text "Found TcTyCon:" <+> ppr tc) ------------------- -lintType :: OutType -> LintM LintedKind --- The returned Kind has itself been linted +lintType :: LintedType -> LintM LintedType -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] lintType (TyVarTy tv) - = do { checkL (isTyVar tv) (mkBadTyVarMsg tv) - ; tv' <- lintTyCoVarInScope tv - ; return (tyVarKind tv') } - -- We checked its kind when we added it to the envt + | not (isTyVar tv) + = failWithL (mkBadTyVarMsg tv) + + | otherwise + = do { subst <- getTCvSubst + ; case lookupTyVar subst tv of + Just linted_ty -> return linted_ty ; + Nothing -> -- lintTyBndr always extends the substitition + failWithL $ + hang (text "The type variable" <+> pprBndr LetBind tv) + 2 (text "is out of scope") + } lintType ty@(AppTy t1 t2) | TyConApp {} <- t1 = failWithL $ text "TyConApp to the left of AppTy:" <+> ppr ty | otherwise - = do { k1 <- lintType t1 - ; k2 <- lintType t2 - ; lint_ty_app ty k1 [(t2,k2)] } + = do { t1' <- lintType t1 + ; t2' <- lintType t2 + ; lint_ty_app ty (typeKind t1') [t2'] + ; return (AppTy t1' t2') } lintType ty@(TyConApp tc tys) | isTypeSynonymTyCon tc || isTypeFamilyTyCon tc @@ -1433,71 +1460,67 @@ lintType ty@(TyConApp tc tys) | otherwise -- Data types, data families, primitive types = do { checkTyCon tc - ; ks <- mapM lintType tys - ; lint_ty_app ty (tyConKind tc) (tys `zip` ks) } + ; tys' <- mapM lintType tys + ; lint_ty_app ty (tyConKind tc) tys' + ; return (TyConApp tc tys') } -- arrows can related *unlifted* kinds, so this has to be separate from -- a dependent forall. -lintType ty@(FunTy _ t1 t2) - = do { k1 <- lintType t1 - ; k2 <- lintType t2 - ; lintArrow (text "type or kind" <+> quotes (ppr ty)) k1 k2 } - -lintType t@(ForAllTy (Bndr tv _vis) ty) - -- forall over types - | isTyVar tv - = lintTyBndr tv $ \tv' -> - do { k <- lintType ty - ; checkValueKind k (text "the body of forall:" <+> ppr t) - ; case occCheckExpand [tv'] k of -- See Note [Stupid type synonyms] - Just k' -> return k' +lintType ty@(FunTy af t1 t2) + = do { t1' <- lintType t1 + ; t2' <- lintType t2 + ; lintArrow (text "type or kind" <+> quotes (ppr ty)) t1' t2' + ; return (FunTy af t1' t2') } + +lintType ty@(ForAllTy (Bndr tcv vis) body_ty) + | isTyVar tcv + = lintTyBndr tcv $ \tv' -> + do { body_ty' <- lintType body_ty + ; let k = typeKind body_ty' + ; checkValueKind k (text "the body of forall:" <+> ppr ty) + ; case occCheckExpand [tv'] k of + -- See Note [Phantom type variables in kinds] in GHC.Core.Type + Just {} -> return (ForAllTy (Bndr tv' vis) body_ty') Nothing -> failWithL (hang (text "Variable escape in forall:") - 2 (vcat [ text "type:" <+> ppr t + 2 (vcat [ text "type:" <+> ppr body_ty' , text "kind:" <+> ppr k ])) } -lintType t@(ForAllTy (Bndr cv _vis) ty) - -- forall over coercions - = do { lintL (isCoVar cv) - (text "Non-Tyvar or Non-Covar bound in type:" <+> ppr t) - ; lintL (cv `elemVarSet` tyCoVarsOfType ty) - (text "Covar does not occur in the body:" <+> ppr t) - ; lintCoBndr cv $ \_ -> - do { k <- lintType ty - ; checkValueKind k (text "the body of forall:" <+> ppr t) - ; return liftedTypeKind - -- We don't check variable escape here. Namely, k could refer to cv' - }} - -lintType ty@(LitTy l) = lintTyLit l >> return (typeKind ty) + | isCoVar tcv + = lintCoBndr tcv $ \cv' -> + do { body_ty' <- lintType body_ty + + ; lintL (cv' `elemVarSet` tyCoVarsOfType body_ty') $ + text "Covar does not occur in the body:" <+> ppr ty + + ; let k = typeKind body_ty' + ; checkValueKind k (text "the body of forall:" <+> ppr ty) + + -- The kind of (forall cv. th) is liftedTypeKind, so no + -- need to check for skolem-escape, as we must do in the tyvar case + + ; return (ForAllTy (Bndr cv' vis) body_ty') } + + | otherwise + = failWithL (text "Non-Tyvar or Non-Covar bound in type:" <+> ppr ty) + +lintType ty@(LitTy l) + = do { lintTyLit l; return ty } lintType (CastTy ty co) - = do { k1 <- lintType ty - ; (k1', k2) <- lintStarCoercion co - ; ensureEqTys k1 k1' (mkCastTyErr ty co k1' k1) - ; return k2 } + = do { ty' <- lintType ty + ; co' <- lintStarCoercion co + ; let tyk = typeKind ty' + cok = coercionLKind co' + ; ensureEqTys tyk cok (mkCastTyErr ty co tyk cok) + ; return (CastTy ty' co') } lintType (CoercionTy co) - = do { (k1, k2, ty1, ty2, r) <- lintCoercion co - ; return $ mkHeteroCoercionType r k1 k2 ty1 ty2 } - -{- Note [Stupid type synonyms] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider (#14939) - type Alg cls ob = ob - f :: forall (cls :: * -> Constraint) (b :: Alg cls *). b - -Here 'cls' appears free in b's kind, which would usually be illegal -(because in (forall a. ty), ty's kind should not mention 'a'). But -#in this case (Alg cls *) = *, so all is well. Currently we allow -this, and make Lint expand synonyms where necessary to make it so. - -c.f. TcUnify.occCheckExpand and GHC.Core.Utils.coreAltsType which deal -with the same problem. A single systematic solution eludes me. --} + = do { co' <- lintCoercion co + ; return (CoercionTy co') } ----------------- -lintTySynFamApp :: Bool -> Type -> TyCon -> [Type] -> LintM LintedKind +lintTySynFamApp :: Bool -> InType -> TyCon -> [InType] -> LintM LintedType -- The TyCon is a type synonym or a type family (not a data family) -- See Note [Linting type synonym applications] -- c.f. TcValidity.check_syn_tc_app @@ -1511,27 +1534,20 @@ lintTySynFamApp report_unsat ty tc tys , let expanded_ty = mkAppTys (substTy (mkTvSubstPrs tenv) rhs) tys' = do { -- Kind-check the argument types, but without reporting -- un-saturated type families/synonyms - ks <- setReportUnsat False (mapM lintType tys) + tys' <- setReportUnsat False (mapM lintType tys) ; when report_unsat $ do { _ <- lintType expanded_ty ; return () } - ; lint_ty_app ty (tyConKind tc) (tys `zip` ks) } + ; lint_ty_app ty (tyConKind tc) tys' + ; return (TyConApp tc tys') } -- Otherwise this must be a type family | otherwise - = do { ks <- mapM lintType tys - ; lint_ty_app ty (tyConKind tc) (tys `zip` ks) } - ------------------ -lintKind :: OutKind -> LintM () --- If you edit this function, you may need to update the GHC formalism --- See Note [GHC Formalism] -lintKind k = do { sk <- lintType k - ; unless (classifiesTypeWithValues sk) - (addErrL (hang (text "Ill-kinded kind:" <+> ppr k) - 2 (text "has kind:" <+> ppr sk))) } + = do { tys' <- mapM lintType tys + ; lint_ty_app ty (tyConKind tc) tys' + ; return (TyConApp tc tys') } ----------------- -- Confirms that a type is really *, #, Constraint etc @@ -1542,27 +1558,28 @@ checkValueKind k doc text "when checking" <+> doc) ----------------- -lintArrow :: SDoc -> LintedKind -> LintedKind -> LintM LintedKind +lintArrow :: SDoc -> LintedType -> LintedType -> LintM () -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] -lintArrow what k1 k2 -- Eg lintArrow "type or kind `blah'" k1 k2 +lintArrow what t1 t2 -- Eg lintArrow "type or kind `blah'" k1 k2 -- or lintArrow "coercion `blah'" k1 k2 = do { unless (classifiesTypeWithValues k1) (addErrL (msg (text "argument") k1)) - ; unless (classifiesTypeWithValues k2) (addErrL (msg (text "result") k2)) - ; return liftedTypeKind } + ; unless (classifiesTypeWithValues k2) (addErrL (msg (text "result") k2)) } where + k1 = typeKind t1 + k2 = typeKind t2 msg ar k = vcat [ hang (text "Ill-kinded" <+> ar) 2 (text "in" <+> what) , what <+> text "kind:" <+> ppr k ] ----------------- -lint_ty_app :: Type -> LintedKind -> [(LintedType,LintedKind)] -> LintM LintedKind +lint_ty_app :: Type -> LintedKind -> [LintedType] -> LintM () lint_ty_app ty k tys = lint_app (text "type" <+> quotes (ppr ty)) k tys ---------------- -lint_co_app :: Coercion -> LintedKind -> [(LintedType,LintedKind)] -> LintM LintedKind +lint_co_app :: Coercion -> LintedKind -> [LintedType] -> LintM () lint_co_app ty k tys = lint_app (text "coercion" <+> quotes (ppr ty)) k tys @@ -1574,42 +1591,45 @@ lintTyLit (NumTyLit n) where msg = text "Negative type literal:" <+> integer n lintTyLit (StrTyLit _) = return () -lint_app :: SDoc -> LintedKind -> [(LintedType,LintedKind)] -> LintM Kind +lint_app :: SDoc -> LintedKind -> [LintedType] -> LintM () -- (lint_app d fun_kind arg_tys) -- We have an application (f arg_ty1 .. arg_tyn), -- where f :: fun_kind --- Takes care of linting the OutTypes -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] -lint_app doc kfn kas +lint_app doc kfn arg_tys = do { in_scope <- getInScope -- We need the in_scope set to satisfy the invariant in -- Note [The substitution invariant] in GHC.Core.TyCo.Subst - ; foldlM (go_app in_scope) kfn kas } + ; _ <- foldlM (go_app in_scope) kfn arg_tys + ; return () } where fail_msg extra = vcat [ hang (text "Kind application error in") 2 doc , nest 2 (text "Function kind =" <+> ppr kfn) - , nest 2 (text "Arg kinds =" <+> ppr kas) + , nest 2 (text "Arg types =" <+> ppr arg_tys) , extra ] - go_app in_scope kfn tka + go_app in_scope kfn ta | Just kfn' <- coreView kfn - = go_app in_scope kfn' tka + = go_app in_scope kfn' ta - go_app _ (FunTy _ kfa kfb) tka@(_,ka) - = do { unless (ka `eqType` kfa) $ - addErrL (fail_msg (text "Fun:" <+> (ppr kfa $$ ppr tka))) + go_app _ fun_kind@(FunTy _ kfa kfb) ta + = do { let ka = typeKind ta + ; unless (ka `eqType` kfa) $ + addErrL (fail_msg (text "Fun:" <+> (ppr fun_kind $$ ppr ta <+> dcolon <+> ppr ka))) ; return kfb } - go_app in_scope (ForAllTy (Bndr kv _vis) kfn) tka@(ta,ka) + go_app in_scope (ForAllTy (Bndr kv _vis) kfn) ta = do { let kv_kind = varType kv + ka = typeKind ta ; unless (ka `eqType` kv_kind) $ - addErrL (fail_msg (text "Forall:" <+> (ppr kv $$ ppr kv_kind $$ ppr tka))) + addErrL (fail_msg (text "Forall:" <+> (ppr kv $$ ppr kv_kind $$ + ppr ta <+> dcolon <+> ppr ka))) ; return $ substTy (extendTCvSubst (mkEmptyTCvSubst in_scope) kv ta) kfn } - go_app _ kfn ka - = failWithL (fail_msg (text "Not a fun:" <+> (ppr kfn $$ ppr ka))) + go_app _ kfn ta + = failWithL (fail_msg (text "Not a fun:" <+> (ppr kfn $$ ppr ta))) {- ********************************************************************* * * @@ -1617,7 +1637,7 @@ lint_app doc kfn kas * * ********************************************************************* -} -lintCoreRule :: OutVar -> OutType -> CoreRule -> LintM () +lintCoreRule :: OutVar -> LintedType -> CoreRule -> LintM () lintCoreRule _ _ (BuiltinRule {}) = return () -- Don't bother @@ -1710,68 +1730,94 @@ Note [Rules and join points] in OccurAnal for further discussion. ************************************************************************ -} -lintInCo :: InCoercion -> LintM (LintedKind, LintedKind, LintedType, LintedType, Role) --- Check the coercion, and apply the substitution to it --- See Note [Linting type lets] -lintInCo co - = addLoc (InCo co) $ - do { co' <- applySubstCo co - ; lintCoercion co' } +{- Note [Asymptotic efficiency] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When linting coercions (and types actually) we return a linted +(substituted) coercion. Then we often have to take the coercionKind of +that returned coercion. If we get long chains, that can be asymptotically +inefficient, notably in +* TransCo +* InstCo +* NthCo (cf #9233) +* LRCo + +But the code is simple. And this is only Lint. Let's wait to see if +the bad perf bites us in practice. + +A solution would be to return the kind and role of the coercion, +as well as the linted coercion. Or perhaps even *only* the kind and role, +which is what used to happen. But that proved tricky and error prone +(#17923), so now we return the coercion. +-} + -- lints a coercion, confirming that its lh kind and its rh kind are both * -- also ensures that the role is Nominal -lintStarCoercion :: OutCoercion -> LintM (LintedType, LintedType) +lintStarCoercion :: InCoercion -> LintM LintedCoercion lintStarCoercion g - = do { (k1, k2, t1, t2, r) <- lintCoercion g - ; checkValueKind k1 (text "the kind of the left type in" <+> ppr g) - ; checkValueKind k2 (text "the kind of the right type in" <+> ppr g) - ; lintRole g Nominal r - ; return (t1, t2) } - -lintCoercion :: OutCoercion -> LintM (LintedKind, LintedKind, LintedType, LintedType, Role) --- Check the kind of a coercion term, returning the kind --- Post-condition: the returned OutTypes are lint-free --- --- If lintCoercion co = (k1, k2, s1, s2, r) --- then co :: s1 ~r s2 --- s1 :: k1 --- s2 :: k2 - + = do { g' <- lintCoercion g + ; let Pair t1 t2 = coercionKind g' + ; checkValueKind (typeKind t1) (text "the kind of the left type in" <+> ppr g) + ; checkValueKind (typeKind t2) (text "the kind of the right type in" <+> ppr g) + ; lintRole g Nominal (coercionRole g) + ; return g' } + +lintCoercion :: InCoercion -> LintM LintedCoercion -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] + +lintCoercion (CoVarCo cv) + | not (isCoVar cv) + = failWithL (hang (text "Bad CoVarCo:" <+> ppr cv) + 2 (text "With offending type:" <+> ppr (varType cv))) + + | otherwise + = do { subst <- getTCvSubst + ; case lookupCoVar subst cv of + Just linted_co -> return linted_co ; + Nothing -> -- lintCoBndr always extends the substitition + failWithL $ + hang (text "The coercion variable" <+> pprBndr LetBind cv) + 2 (text "is out of scope") + } + + lintCoercion (Refl ty) - = do { k <- lintType ty - ; return (k, k, ty, ty, Nominal) } + = do { ty' <- lintType ty + ; return (Refl ty') } lintCoercion (GRefl r ty MRefl) - = do { k <- lintType ty - ; return (k, k, ty, ty, r) } + = do { ty' <- lintType ty + ; return (GRefl r ty' MRefl) } lintCoercion (GRefl r ty (MCo co)) - = do { k <- lintType ty - ; (_, _, k1, k2, r') <- lintCoercion co - ; ensureEqTys k k1 - (hang (text "GRefl coercion kind mis-match:" <+> ppr co) - 2 (vcat [ppr ty, ppr k, ppr k1])) - ; lintRole co Nominal r' - ; return (k1, k2, ty, mkCastTy ty co, r) } + = do { ty' <- lintType ty + ; co' <- lintCoercion co + ; let tk = typeKind ty' + tl = coercionLKind co' + ; ensureEqTys tk tl $ + hang (text "GRefl coercion kind mis-match:" <+> ppr co) + 2 (vcat [ppr ty', ppr tk, ppr tl]) + ; lintRole co' Nominal (coercionRole co') + ; return (GRefl r ty' (MCo co')) } lintCoercion co@(TyConAppCo r tc cos) | tc `hasKey` funTyConKey , [_rep1,_rep2,_co1,_co2] <- cos - = do { failWithL (text "Saturated TyConAppCo (->):" <+> ppr co) - } -- All saturated TyConAppCos should be FunCos + = failWithL (text "Saturated TyConAppCo (->):" <+> ppr co) + -- All saturated TyConAppCos should be FunCos | Just {} <- synTyConDefn_maybe tc = failWithL (text "Synonym in TyConAppCo:" <+> ppr co) | otherwise = do { checkTyCon tc - ; (k's, ks, ss, ts, rs) <- mapAndUnzip5M lintCoercion cos - ; k' <- lint_co_app co (tyConKind tc) (ss `zip` k's) - ; k <- lint_co_app co (tyConKind tc) (ts `zip` ks) - ; _ <- zipWith3M lintRole cos (tyConRolesX r tc) rs - ; return (k', k, mkTyConApp tc ss, mkTyConApp tc ts, r) } + ; cos' <- mapM lintCoercion cos + ; let (co_kinds, co_roles) = unzip (map coercionKindRole cos') + ; lint_co_app co (tyConKind tc) (map pFst co_kinds) + ; lint_co_app co (tyConKind tc) (map pSnd co_kinds) + ; zipWithM_ (lintRole co) (tyConRolesX r tc) co_roles + ; return (TyConAppCo r tc cos') } lintCoercion co@(AppCo co1 co2) | TyConAppCo {} <- co1 @@ -1779,111 +1825,64 @@ lintCoercion co@(AppCo co1 co2) | Just (TyConApp {}, _) <- isReflCo_maybe co1 = failWithL (text "Refl (TyConApp ...) to the left of AppCo:" <+> ppr co) | otherwise - = do { (k1, k2, s1, s2, r1) <- lintCoercion co1 - ; (k'1, k'2, t1, t2, r2) <- lintCoercion co2 - ; k3 <- lint_co_app co k1 [(t1,k'1)] - ; k4 <- lint_co_app co k2 [(t2,k'2)] + = do { co1' <- lintCoercion co1 + ; co2' <- lintCoercion co2 + ; let (Pair lk1 rk1, r1) = coercionKindRole co1' + (Pair lk2 rk2, r2) = coercionKindRole co2' + ; lint_co_app co (typeKind lk1) [lk2] + ; lint_co_app co (typeKind rk1) [rk2] + ; if r1 == Phantom then lintL (r2 == Phantom || r2 == Nominal) (text "Second argument in AppCo cannot be R:" $$ ppr co) else lintRole co Nominal r2 - ; return (k3, k4, mkAppTy s1 t1, mkAppTy s2 t2, r1) } + + ; return (AppCo co1' co2') } ---------- -lintCoercion (ForAllCo tv1 kind_co co) - -- forall over types - | isTyVar tv1 - = do { (_, k2) <- lintStarCoercion kind_co - ; let tv2 = setTyVarKind tv1 k2 - ; addInScopeTyCoVar tv1 $ - do { - ; (k3, k4, t1, t2, r) <- lintCoercion co - ; in_scope <- getInScope - ; let tyl = mkInvForAllTy tv1 t1 - subst = mkTvSubst in_scope $ - -- We need both the free vars of the `t2` and the - -- free vars of the range of the substitution in - -- scope. All the free vars of `t2` and `kind_co` should - -- already be in `in_scope`, because they've been - -- linted and `tv2` has the same unique as `tv1`. - -- See Note [The substitution invariant] in GHC.Core.TyCo.Subst. - unitVarEnv tv1 (TyVarTy tv2 `mkCastTy` mkSymCo kind_co) - tyr = mkInvForAllTy tv2 $ - substTy subst t2 - ; return (k3, k4, tyl, tyr, r) } } - -lintCoercion (ForAllCo cv1 kind_co co) - -- forall over coercions - = ASSERT( isCoVar cv1 ) - do { lintL (almostDevoidCoVarOfCo cv1 co) +lintCoercion co@(ForAllCo tcv1 kind_co body_co) + | not (isTyCoVar tcv1) + = failWithL (text "Non tyco binder in ForAllCo:" <+> ppr co) + | otherwise + = do { kind_co' <- lintStarCoercion kind_co + ; lintTyCoBndr tcv1 $ \tcv1' -> + do { body_co' <- lintCoercion body_co + ; ensureEqTys (varType tcv1') (coercionLKind kind_co') $ + text "Kind mis-match in ForallCo" <+> ppr co + + ; when (isCoVar tcv1) $ + lintL (almostDevoidCoVarOfCo tcv1 body_co) (text "Covar can only appear in Refl and GRefl: " <+> ppr co) - ; (_, k2) <- lintStarCoercion kind_co - ; let cv2 = setVarType cv1 k2 - ; addInScopeTyCoVar cv1 $ - do { - ; (k3, k4, t1, t2, r) <- lintCoercion co - ; checkValueKind k3 (text "the body of a ForAllCo over covar:" <+> ppr co) - ; checkValueKind k4 (text "the body of a ForAllCo over covar:" <+> ppr co) - -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep - ; in_scope <- getInScope - ; let tyl = mkTyCoInvForAllTy cv1 t1 - r2 = coVarRole cv1 - kind_co' = downgradeRole r2 Nominal kind_co - eta1 = mkNthCo r2 2 kind_co' - eta2 = mkNthCo r2 3 kind_co' - subst = mkCvSubst in_scope $ - -- We need both the free vars of the `t2` and the - -- free vars of the range of the substitution in - -- scope. All the free vars of `t2` and `kind_co` should - -- already be in `in_scope`, because they've been - -- linted and `cv2` has the same unique as `cv1`. - -- See Note [The substitution invariant] in GHC.Core.TyCo.Subst. - unitVarEnv cv1 (eta1 `mkTransCo` (mkCoVarCo cv2) - `mkTransCo` (mkSymCo eta2)) - tyr = mkTyCoInvForAllTy cv2 $ - substTy subst t2 - ; return (liftedTypeKind, liftedTypeKind, tyl, tyr, r) } } - -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep + -- See "last wrinkle" in GHC.Core.Coercion + -- Note [Unused coercion variable in ForAllCo] -lintCoercion co@(FunCo r co1 co2) - = do { (k1,k'1,s1,t1,r1) <- lintCoercion co1 - ; (k2,k'2,s2,t2,r2) <- lintCoercion co2 - ; k <- lintArrow (text "coercion" <+> quotes (ppr co)) k1 k2 - ; k' <- lintArrow (text "coercion" <+> quotes (ppr co)) k'1 k'2 - ; lintRole co1 r r1 - ; lintRole co2 r r2 - ; return (k, k', mkVisFunTy s1 s2, mkVisFunTy t1 t2, r) } + ; return (ForAllCo tcv1' kind_co' body_co') } } -lintCoercion (CoVarCo cv) - | not (isCoVar cv) - = failWithL (hang (text "Bad CoVarCo:" <+> ppr cv) - 2 (text "With offending type:" <+> ppr (varType cv))) - | otherwise - = do { cv' <- lintTyCoVarInScope cv - ; lintUnliftedCoVar cv' - ; return $ coVarKindsTypesRole cv' } +lintCoercion co@(FunCo r co1 co2) + = do { co1' <- lintCoercion co1 + ; co2' <- lintCoercion co2 + ; let Pair lt1 rt1 = coercionKind co1 + Pair lt2 rt2 = coercionKind co2 + ; lintArrow (text "coercion" <+> quotes (ppr co)) lt1 lt2 + ; lintArrow (text "coercion" <+> quotes (ppr co)) rt1 rt2 + ; lintRole co1 r (coercionRole co1) + ; lintRole co2 r (coercionRole co2) + ; return (FunCo r co1' co2') } -- See Note [Bad unsafe coercion] lintCoercion co@(UnivCo prov r ty1 ty2) - = do { k1 <- lintType ty1 - ; k2 <- lintType ty2 - ; case prov of - PhantomProv kco -> do { lintRole co Phantom r - ; check_kinds kco k1 k2 } - - ProofIrrelProv kco -> do { lintL (isCoercionTy ty1) $ - mkBadProofIrrelMsg ty1 co - ; lintL (isCoercionTy ty2) $ - mkBadProofIrrelMsg ty2 co - ; check_kinds kco k1 k2 } - - PluginProv _ -> return () -- no extra checks + = do { ty1' <- lintType ty1 + ; ty2' <- lintType ty2 + ; let k1 = typeKind ty1' + k2 = typeKind ty2' + ; prov' <- lint_prov k1 k2 prov ; when (r /= Phantom && classifiesTypeWithValues k1 && classifiesTypeWithValues k2) (checkTypes ty1 ty2) - ; return (k1, k2, ty1, ty2, r) } + + ; return (UnivCo prov' r ty1' ty2') } where report s = hang (text $ "Unsafe coercion: " ++ s) 2 (vcat [ text "From:" <+> ppr ty1 @@ -1926,39 +1925,53 @@ lintCoercion co@(UnivCo prov r ty1 ty2) _ -> return () } - check_kinds kco k1 k2 = do { (k1', k2') <- lintStarCoercion kco - ; ensureEqTys k1 k1' (mkBadUnivCoMsg CLeft co) - ; ensureEqTys k2 k2' (mkBadUnivCoMsg CRight co) } + lint_prov k1 k2 (PhantomProv kco) + = do { kco' <- lintStarCoercion kco + ; lintRole co Phantom r + ; check_kinds kco' k1 k2 + ; return (PhantomProv kco') } + + lint_prov k1 k2 (ProofIrrelProv kco) + = do { lintL (isCoercionTy ty1) (mkBadProofIrrelMsg ty1 co) + ; lintL (isCoercionTy ty2) (mkBadProofIrrelMsg ty2 co) + ; kco' <- lintStarCoercion kco + ; check_kinds kco k1 k2 + ; return (ProofIrrelProv kco') } + + lint_prov _ _ prov@(PluginProv _) = return prov + + check_kinds kco k1 k2 + = do { let Pair k1' k2' = coercionKind kco + ; ensureEqTys k1 k1' (mkBadUnivCoMsg CLeft co) + ; ensureEqTys k2 k2' (mkBadUnivCoMsg CRight co) } lintCoercion (SymCo co) - = do { (k1, k2, ty1, ty2, r) <- lintCoercion co - ; return (k2, k1, ty2, ty1, r) } + = do { co' <- lintCoercion co + ; return (SymCo co') } lintCoercion co@(TransCo co1 co2) - = do { (k1a, _k1b, ty1a, ty1b, r1) <- lintCoercion co1 - ; (_k2a, k2b, ty2a, ty2b, r2) <- lintCoercion co2 + = do { co1' <- lintCoercion co1 + ; co2' <- lintCoercion co2 + ; let ty1b = coercionRKind co1' + ty2a = coercionLKind co2' ; ensureEqTys ty1b ty2a (hang (text "Trans coercion mis-match:" <+> ppr co) - 2 (vcat [ppr ty1a, ppr ty1b, ppr ty2a, ppr ty2b])) - ; lintRole co r1 r2 - ; return (k1a, k2b, ty1a, ty2b, r1) } + 2 (vcat [ppr (coercionKind co1'), ppr (coercionKind co2')])) + ; lintRole co (coercionRole co1) (coercionRole co2) + ; return (TransCo co1' co2') } lintCoercion the_co@(NthCo r0 n co) - = do { (_, _, s, t, r) <- lintCoercion co + = do { co' <- lintCoercion co + ; let (Pair s t, r) = coercionKindRole co' ; case (splitForAllTy_maybe s, splitForAllTy_maybe t) of - { (Just (tcv_s, _ty_s), Just (tcv_t, _ty_t)) + { (Just _, Just _) -- works for both tyvar and covar | n == 0 , (isForAllTy_ty s && isForAllTy_ty t) || (isForAllTy_co s && isForAllTy_co t) -> do { lintRole the_co Nominal r0 - ; return (ks, kt, ts, tt, r0) } - where - ts = varType tcv_s - tt = varType tcv_t - ks = typeKind ts - kt = typeKind tt + ; return (NthCo r0 n co') } ; _ -> case (splitTyConApp_maybe s, splitTyConApp_maybe t) of { (Just (tc_s, tys_s), Just (tc_t, tys_t)) @@ -1968,62 +1981,51 @@ lintCoercion the_co@(NthCo r0 n co) , tys_s `equalLength` tys_t , tys_s `lengthExceeds` n -> do { lintRole the_co tr r0 - ; return (ks, kt, ts, tt, r0) } - where - ts = getNth tys_s n - tt = getNth tys_t n - tr = nthRole r tc_s n - ks = typeKind ts - kt = typeKind tt + ; return (NthCo r0 n co') } + where + tr = nthRole r tc_s n ; _ -> failWithL (hang (text "Bad getNth:") 2 (ppr the_co $$ ppr s $$ ppr t)) }}} lintCoercion the_co@(LRCo lr co) - = do { (_,_,s,t,r) <- lintCoercion co + = do { co' <- lintCoercion co + ; let Pair s t = coercionKind co' + r = coercionRole co' ; lintRole co Nominal r ; case (splitAppTy_maybe s, splitAppTy_maybe t) of - (Just s_pr, Just t_pr) - -> return (ks_pick, kt_pick, s_pick, t_pick, Nominal) - where - s_pick = pickLR lr s_pr - t_pick = pickLR lr t_pr - ks_pick = typeKind s_pick - kt_pick = typeKind t_pick - + (Just _, Just _) -> return (LRCo lr co') _ -> failWithL (hang (text "Bad LRCo:") 2 (ppr the_co $$ ppr s $$ ppr t)) } lintCoercion (InstCo co arg) - = do { (k3, k4, t1',t2', r) <- lintCoercion co - ; (k1',k2',s1,s2, r') <- lintCoercion arg - ; lintRole arg Nominal r' - ; in_scope <- getInScope - ; case (splitForAllTy_ty_maybe t1', splitForAllTy_ty_maybe t2') of + = do { co' <- lintCoercion co + ; arg' <- lintCoercion arg + ; let Pair t1' t2' = coercionKind co' + Pair s1 s2 = coercionKind arg + + ; lintRole arg Nominal (coercionRole arg') + + ; case (splitForAllTy_ty_maybe t1', splitForAllTy_ty_maybe t2') of -- forall over tvar - { (Just (tv1,t1), Just (tv2,t2)) - | k1' `eqType` tyVarKind tv1 - , k2' `eqType` tyVarKind tv2 - -> return (k3, k4, - substTyWithInScope in_scope [tv1] [s1] t1, - substTyWithInScope in_scope [tv2] [s2] t2, r) + { (Just (tv1,_), Just (tv2,_)) + | typeKind s1 `eqType` tyVarKind tv1 + , typeKind s2 `eqType` tyVarKind tv2 + -> return (InstCo co' arg') | otherwise -> failWithL (text "Kind mis-match in inst coercion") + ; _ -> case (splitForAllTy_co_maybe t1', splitForAllTy_co_maybe t2') of -- forall over covar - { (Just (cv1, t1), Just (cv2, t2)) - | k1' `eqType` varType cv1 - , k2' `eqType` varType cv2 - , CoercionTy s1' <- s1 - , CoercionTy s2' <- s2 - -> do { return $ - (liftedTypeKind, liftedTypeKind - -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep - , substTy (mkCvSubst in_scope $ unitVarEnv cv1 s1') t1 - , substTy (mkCvSubst in_scope $ unitVarEnv cv2 s2') t2 - , r) } + { (Just (cv1, _), Just (cv2, _)) + | typeKind s1 `eqType` varType cv1 + , typeKind s2 `eqType` varType cv2 + , CoercionTy _ <- s1 + , CoercionTy _ <- s2 + -> return (InstCo co' arg') | otherwise -> failWithL (text "Kind mis-match in inst coercion") + ; _ -> failWithL (text "Bad argument of inst") }}} lintCoercion co@(AxiomInstCo con ind cos) @@ -2031,73 +2033,69 @@ lintCoercion co@(AxiomInstCo con ind cos) (bad_ax (text "index out of range")) ; let CoAxBranch { cab_tvs = ktvs , cab_cvs = cvs - , cab_roles = roles - , cab_lhs = lhs - , cab_rhs = rhs } = coAxiomNthBranch con ind + , cab_roles = roles } = coAxiomNthBranch con ind ; unless (cos `equalLength` (ktvs ++ cvs)) $ bad_ax (text "lengths") + ; cos' <- mapM lintCoercion cos ; subst <- getTCvSubst ; let empty_subst = zapTCvSubst subst - ; (subst_l, subst_r) <- foldlM check_ki - (empty_subst, empty_subst) - (zip3 (ktvs ++ cvs) roles cos) - ; let lhs' = substTys subst_l lhs - rhs' = substTy subst_r rhs - fam_tc = coAxiomTyCon con + ; _ <- foldlM check_ki (empty_subst, empty_subst) + (zip3 (ktvs ++ cvs) roles cos') + ; let fam_tc = coAxiomTyCon con ; case checkAxInstCo co of Just bad_branch -> bad_ax $ text "inconsistent with" <+> pprCoAxBranch fam_tc bad_branch Nothing -> return () - ; let s2 = mkTyConApp fam_tc lhs' - ; return (typeKind s2, typeKind rhs', s2, rhs', coAxiomRole con) } + ; return (AxiomInstCo con ind cos') } where bad_ax what = addErrL (hang (text "Bad axiom application" <+> parens what) 2 (ppr co)) - check_ki (subst_l, subst_r) (ktv, role, arg) - = do { (k', k'', s', t', r) <- lintCoercion arg - ; lintRole arg role r + check_ki (subst_l, subst_r) (ktv, role, arg') + = do { let Pair s' t' = coercionKind arg' + sk' = typeKind s' + tk' = typeKind t' + ; lintRole arg' role (coercionRole arg') ; let ktv_kind_l = substTy subst_l (tyVarKind ktv) ktv_kind_r = substTy subst_r (tyVarKind ktv) - ; unless (k' `eqType` ktv_kind_l) - (bad_ax (text "check_ki1" <+> vcat [ ppr co, ppr k', ppr ktv, ppr ktv_kind_l ] )) - ; unless (k'' `eqType` ktv_kind_r) - (bad_ax (text "check_ki2" <+> vcat [ ppr co, ppr k'', ppr ktv, ppr ktv_kind_r ] )) + ; unless (sk' `eqType` ktv_kind_l) + (bad_ax (text "check_ki1" <+> vcat [ ppr co, ppr sk', ppr ktv, ppr ktv_kind_l ] )) + ; unless (tk' `eqType` ktv_kind_r) + (bad_ax (text "check_ki2" <+> vcat [ ppr co, ppr tk', ppr ktv, ppr ktv_kind_r ] )) ; return (extendTCvSubst subst_l ktv s', extendTCvSubst subst_r ktv t') } lintCoercion (KindCo co) - = do { (k1, k2, _, _, _) <- lintCoercion co - ; return (liftedTypeKind, liftedTypeKind, k1, k2, Nominal) } + = do { co' <- lintCoercion co + ; return (KindCo co') } lintCoercion (SubCo co') - = do { (k1,k2,s,t,r) <- lintCoercion co' - ; lintRole co' Nominal r - ; return (k1,k2,s,t,Representational) } - -lintCoercion this@(AxiomRuleCo co cs) - = do { eqs <- mapM lintCoercion cs - ; lintRoles 0 (coaxrAsmpRoles co) eqs - ; case coaxrProves co [ Pair l r | (_,_,l,r,_) <- eqs ] of + = do { co' <- lintCoercion co' + ; lintRole co' Nominal (coercionRole co') + ; return (SubCo co') } + +lintCoercion this@(AxiomRuleCo ax cos) + = do { cos' <- mapM lintCoercion cos + ; lint_roles 0 (coaxrAsmpRoles ax) cos' + ; case coaxrProves ax (map coercionKind cos') of Nothing -> err "Malformed use of AxiomRuleCo" [ ppr this ] - Just (Pair l r) -> - return (typeKind l, typeKind r, l, r, coaxrRole co) } + Just _ -> return (AxiomRuleCo ax cos') } where err m xs = failWithL $ - hang (text m) 2 $ vcat (text "Rule:" <+> ppr (coaxrName co) : xs) + hang (text m) 2 $ vcat (text "Rule:" <+> ppr (coaxrName ax) : xs) - lintRoles n (e : es) ((_,_,_,_,r) : rs) - | e == r = lintRoles (n+1) es rs + lint_roles n (e : es) (co : cos) + | e == coercionRole co = lint_roles (n+1) es cos | otherwise = err "Argument roles mismatch" [ text "In argument:" <+> int (n+1) , text "Expected:" <+> ppr e - , text "Found:" <+> ppr r ] - lintRoles _ [] [] = return () - lintRoles n [] rs = err "Too many coercion arguments" + , text "Found:" <+> ppr (coercionRole co) ] + lint_roles _ [] [] = return () + lint_roles n [] rs = err "Too many coercion arguments" [ text "Expected:" <+> int n , text "Provided:" <+> int (n + length rs) ] - lintRoles n es [] = err "Not enough coercion arguments" + lint_roles n es [] = err "Not enough coercion arguments" [ text "Expected:" <+> int (n + length es) , text "Provided:" <+> int n ] @@ -2106,13 +2104,6 @@ lintCoercion (HoleCo h) ; lintCoercion (CoVarCo (coHoleCoVar h)) } ----------- -lintUnliftedCoVar :: CoVar -> LintM () -lintUnliftedCoVar cv - = when (not (isUnliftedType (coVarKind cv))) $ - failWithL (text "Bad lifted equality:" <+> ppr cv - <+> dcolon <+> ppr (coVarKind cv)) - {- ************************************************************************ * * @@ -2129,12 +2120,13 @@ data LintEnv , le_subst :: TCvSubst -- Current TyCo substitution -- See Note [Linting type lets] - -- /Only/ substitutes for type variables; - -- but might clone CoVars - -- We also use le_subst to keep track of - -- in-scope TyVars and CoVars + -- /Only/ substitutes for type variables; + -- but might clone CoVars + -- We also use le_subst to keep track of + -- in-scope TyVars and CoVars (but not Ids) + -- Range of the TCvSubst is LintedType/LintedCo - , le_ids :: IdSet -- In-scope Ids + , le_ids :: IdSet -- In-scope Ids; all Linted , le_joins :: IdSet -- Join points in scope that are valid -- A subset of the InScopeSet in le_subst -- See Note [Join points] @@ -2266,6 +2258,7 @@ instance HasDynFlags LintM where data LintLocInfo = RhsOf Id -- The variable bound + | OccOf Id -- Occurrence of id | LambdaBodyOf Id -- The lambda-binder | UnfoldingOf Id -- Unfolding of a binder | BodyOfLetRec [Id] -- One of the binders @@ -2278,7 +2271,6 @@ data LintLocInfo | ImportedUnfolding SrcLoc -- Some imported unfolding (ToDo: say which) | TopLevelBindings | InType Type -- Inside a type - | InKind Type Kind -- Inside a kind | InCo Coercion -- Inside a coercion initL :: DynFlags -> LintFlags -> [Var] @@ -2341,7 +2333,7 @@ addWarnL msg = LintM $ \ env (warns,errs) -> addMsg :: Bool -> LintEnv -> Bag MsgDoc -> MsgDoc -> Bag MsgDoc addMsg is_error env msgs msg - = ASSERT( notNull loc_msgs ) + = ASSERT2( notNull loc_msgs, msg ) msgs `snocBag` mk_msg msg where loc_msgs :: [(SrcLoc, SDoc)] -- Innermost first @@ -2373,16 +2365,15 @@ inCasePat = LintM $ \ env errs -> (Just (is_case_pat env), errs) is_case_pat (LE { le_loc = CasePat {} : _ }) = True is_case_pat _other = False -addInScopeTyCoVar :: Var -> LintM a -> LintM a -addInScopeTyCoVar var m - = LintM $ \ env errs -> - unLintM m (env { le_subst = extendTCvInScope (le_subst env) var }) errs - addInScopeId :: Id -> LintM a -> LintM a addInScopeId id m - = LintM $ \ env errs -> - unLintM m (env { le_ids = extendVarSet (le_ids env) id - , le_joins = delVarSet (le_joins env) id }) errs + = LintM $ \ env@(LE { le_ids = id_set, le_joins = join_set }) errs -> + unLintM m (env { le_ids = extendVarSet id_set id + , le_joins = add_joins join_set }) errs + where + add_joins join_set + | isJoinId id = extendVarSet join_set id -- Overwrite with new arity + | otherwise = delVarSet join_set id -- Remove any existing binding getInScopeIds :: LintM IdSet getInScopeIds = LintM (\env errs -> (Just (le_ids env), errs)) @@ -2404,13 +2395,6 @@ markAllJoinsBadIf :: Bool -> LintM a -> LintM a markAllJoinsBadIf True m = markAllJoinsBad m markAllJoinsBadIf False m = m -addGoodJoins :: [Var] -> LintM a -> LintM a -addGoodJoins vars thing_inside - = LintM $ \ env errs -> unLintM thing_inside (add_joins env) errs - where - add_joins env = env { le_joins = le_joins env `extendVarSetList` join_ids } - join_ids = filter isJoinId vars - getValidJoins :: LintM IdSet getValidJoins = LintM (\ env errs -> (Just (le_joins env), errs)) @@ -2420,12 +2404,6 @@ getTCvSubst = LintM (\ env errs -> (Just (le_subst env), errs)) getInScope :: LintM InScopeSet getInScope = LintM (\ env errs -> (Just (getTCvInScope $ le_subst env), errs)) -applySubstTy :: InType -> LintM OutType -applySubstTy ty = do { subst <- getTCvSubst; return (substTy subst ty) } - -applySubstCo :: InCoercion -> LintM OutCoercion -applySubstCo co = do { subst <- getTCvSubst; return (substCo subst co) } - lookupIdInScope :: Id -> LintM Id lookupIdInScope id_occ = do { in_scope_ids <- getInScopeIds @@ -2461,16 +2439,7 @@ lookupJoinId id Just id' -> return (isJoinId_maybe id') Nothing -> return Nothing } -lintTyCoVarInScope :: TyCoVar -> LintM TyCoVar -lintTyCoVarInScope var - = do { subst <- getTCvSubst - ; case lookupInScope (getTCvInScope subst) var of - Just var' -> return var' - Nothing -> failWithL $ - hang (text "The TyCo variable" <+> pprBndr LetBind var) - 2 (text "is out of scope") } - -ensureEqTys :: OutType -> OutType -> MsgDoc -> LintM () +ensureEqTys :: LintedType -> LintedType -> MsgDoc -> LintM () -- check ty2 is subtype of ty1 (ie, has same structure but usage -- annotations need only be consistent, not equal) -- Assumes ty1,ty2 are have already had the substitution applied @@ -2500,6 +2469,9 @@ dumpLoc :: LintLocInfo -> (SrcLoc, SDoc) dumpLoc (RhsOf v) = (getSrcLoc v, text "In the RHS of" <+> pp_binders [v]) +dumpLoc (OccOf v) + = (getSrcLoc v, text "In an occurrence of" <+> pp_binder v) + dumpLoc (LambdaBodyOf b) = (getSrcLoc b, text "In the body of lambda with binder" <+> pp_binder b) @@ -2534,8 +2506,6 @@ dumpLoc TopLevelBindings = (noSrcLoc, Outputable.empty) dumpLoc (InType ty) = (noSrcLoc, text "In the type" <+> quotes (ppr ty)) -dumpLoc (InKind ty ki) - = (noSrcLoc, text "In the kind of" <+> parens (ppr ty <+> dcolon <+> ppr ki)) dumpLoc (InCo co) = (noSrcLoc, text "In the coercion" <+> quotes (ppr co)) @@ -2780,7 +2750,7 @@ mkJoinBndrOccMismatchMsg bndr join_arity_bndr join_arity_occ , text "Arity at binding site:" <+> ppr join_arity_bndr , text "Arity at occurrence: " <+> ppr join_arity_occ ] -mkBndrOccTypeMismatchMsg :: Var -> Var -> OutType -> OutType -> SDoc +mkBndrOccTypeMismatchMsg :: Var -> Var -> LintedType -> LintedType -> SDoc mkBndrOccTypeMismatchMsg bndr var bndr_ty var_ty = vcat [ text "Mismatch in type between binder and occurrence" , text "Binder:" <+> ppr bndr <+> dcolon <+> ppr bndr_ty ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -2447,7 +2447,7 @@ normally it would make no sense to have forall r. (ty :: K r) because the kind of the forall would escape the binding of 'r'. But in this case it's fine because (K r) exapands -to Type, so we expliclity /permit/ the type +to Type, so we explicitly /permit/ the type forall r. T r To accommodate such a type, in typeKind (forall a.ty) we use @@ -2455,8 +2455,13 @@ occCheckExpand to expand any type synonyms in the kind of 'ty' to eliminate 'a'. See kinding rule (FORALL) in Note [Kinding rules for types] -And in TcValidity.checkEscapingKind, we use also use -occCheckExpand, for the same reason. +See also + * TcUnify.occCheckExpand + * GHC.Core.Utils.coreAltsType + * TcValidity.checkEscapingKind +all of which grapple with with the same problem. + +See #14939. -} ----------------------------- ===================================== testsuite/tests/indexed-types/should_compile/T17923.hs ===================================== @@ -0,0 +1,44 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# OPTIONS_GHC -Wall #-} +module Bug where + +import Data.Kind + +-- type SingFunction2 f = forall t1 t2. Sing t1 -> Sing t2 -> Sing (f `Apply` t1 `Apply` t2) +type SingFunction2 f = forall t1. Sing t1 -> forall t2. Sing t2 -> Sing (f `Apply` t1 `Apply` t2) +singFun2 :: forall f. SingFunction2 f -> Sing f +singFun2 f = SLambda (\x -> SLambda (f x)) + +type family Sing :: k -> Type +data TyFun :: Type -> Type -> Type +type a ~> b = TyFun a b -> Type +infixr 0 ~> + +type family Apply (f :: a ~> b) (x :: a) :: b +data Sym4 a +data Sym3 a + +type instance Apply Sym3 _ = Sym4 + +newtype SLambda (f :: k1 ~> k2) = + SLambda { applySing :: forall t. Sing t -> Sing (Apply f t) } +type instance Sing = SLambda + +und :: a +und = undefined + +data E +data ShowCharSym0 :: E ~> E ~> E + +sShow_tuple :: SLambda Sym4 +sShow_tuple + = applySing (singFun2 @Sym3 und) + (und (singFun2 @Sym3 + (und (applySing (singFun2 @Sym3 und) + (applySing (singFun2 @ShowCharSym0 und) und))))) ===================================== testsuite/tests/indexed-types/should_compile/all.T ===================================== @@ -294,3 +294,4 @@ test('T16828', normal, compile, ['']) test('T17008b', normal, compile, ['']) test('T17056', normal, compile, ['']) test('T17405', normal, multimod_compile, ['T17405c', '-v0']) +test('T17923', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5aca7133265e8c2092e2b1e79ab9c793515eb5a8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5aca7133265e8c2092e2b1e79ab9c793515eb5a8 You're receiving 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 Mar 24 15:30:56 2020 From: gitlab at gitlab.haskell.org (Simon Jakobi) Date: Tue, 24 Mar 2020 11:30:56 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/sjakobi-argmin-argmax-docs Message-ID: <5e7a27b0ece68_61673f8198ee100c343862@gitlab.haskell.org.mail> Simon Jakobi pushed new branch wip/sjakobi-argmin-argmax-docs at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/sjakobi-argmin-argmax-docs You're receiving 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 Mar 24 17:16:40 2020 From: gitlab at gitlab.haskell.org (Andreas Klebinger) Date: Tue, 24 Mar 2020 13:16:40 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/andreask/bits_docs Message-ID: <5e7a407897ce3_6167e0e2c94380275@gitlab.haskell.org.mail> Andreas Klebinger pushed new branch wip/andreask/bits_docs at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/andreask/bits_docs You're receiving 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 Mar 24 17:18:13 2020 From: gitlab at gitlab.haskell.org (Andreas Klebinger) Date: Tue, 24 Mar 2020 13:18:13 -0400 Subject: [Git][ghc/ghc][wip/andreask/bits_docs] Correct haddocks for testBit in Data.Bits Message-ID: <5e7a40d589514_6167e6514b4380470@gitlab.haskell.org.mail> Andreas Klebinger pushed to branch wip/andreask/bits_docs at Glasgow Haskell Compiler / GHC Commits: 0fcb2a0a by Andreas Klebinger at 2020-03-24T18:18:02+01: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. - - - - - 1 changed file: - libraries/base/Data/Bits.hs Changes: ===================================== libraries/base/Data/Bits.hs ===================================== @@ -168,10 +168,14 @@ class Eq a => Bits a where -- | @x \`complementBit\` i@ is the same as @x \`xor\` bit i@ complementBit :: a -> Int -> a - -- | Return 'True' if the @n at th bit of the argument is 1 - -- - -- Can be implemented using `testBitDefault' if @a@ is also an - -- instance of 'Num'. + {-| @x \`testBit\` i@ is the same as @x .&. bit n == 1@ + + In other words it returns True if the bit at offset @n + is set. + + Can be implemented using `testBitDefault' if @a@ is also an + instance of 'Num'. + -} testBit :: a -> Int -> Bool {-| Return the number of bits in the type of the argument. The actual View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0fcb2a0adcdf0140170f050af2d3e865bd4e8fe6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0fcb2a0adcdf0140170f050af2d3e865bd4e8fe6 You're receiving 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 Mar 24 17:26:30 2020 From: gitlab at gitlab.haskell.org (Peter Trommler) Date: Tue, 24 Mar 2020 13:26:30 -0400 Subject: [Git][ghc/ghc][wip/T11531] Do not panic on linker errors Message-ID: <5e7a42c67286b_616713339fc43835df@gitlab.haskell.org.mail> Peter Trommler pushed to branch wip/T11531 at Glasgow Haskell Compiler / GHC Commits: f7334c1b by Peter Trommler at 2020-03-24T18:19:13+01:00 Do not panic on linker errors - - - - - 7 changed files: - compiler/GHC/Runtime/Linker.hs - testsuite/tests/ghci/linking/Makefile - + testsuite/tests/ghci/linking/T11531.c - + testsuite/tests/ghci/linking/T11531.h - + testsuite/tests/ghci/linking/T11531.hs - + testsuite/tests/ghci/linking/T11531.stderr - testsuite/tests/ghci/linking/all.T Changes: ===================================== compiler/GHC/Runtime/Linker.hs ===================================== @@ -187,7 +187,7 @@ getHValue hsc_env name = do m <- lookupClosure hsc_env (unpackFS sym_to_find) case m of Just hvref -> mkFinalizedHValue hsc_env hvref - Nothing -> linkFail "GHC.ByteCode.Linker.lookupCE" + Nothing -> linkFail "GHC.Runtime.Linker.getHValue" (unpackFS sym_to_find) linkDependencies :: HscEnv -> PersistentLinkerState @@ -472,7 +472,7 @@ preloadLib hsc_env lib_paths framework_paths pls lib_spec = do Nothing -> maybePutStrLn dflags "done" Just mm -> preloadFailed mm framework_paths lib_spec return pls - else panic "preloadLib Framework" + else throwGhcExceptionIO (ProgramError "preloadLib Framework") where dflags = hsc_dflags hsc_env @@ -964,7 +964,9 @@ dynLoadObjs hsc_env pls at PersistentLinkerState{..} objs = do m <- loadDLL hsc_env soFile case m of Nothing -> return $! pls { temp_sos = (libPath, libName) : temp_sos } - Just err -> panic ("Loading temp shared object failed: " ++ err) + Just err -> linkFail msg err + where + msg = "GHC.Runtime.Linker.dynLoadObjs: Loading temp shared object failed" rmDupLinkables :: [Linkable] -- Already loaded -> [Linkable] -- New linkables ===================================== testsuite/tests/ghci/linking/Makefile ===================================== @@ -127,6 +127,11 @@ T3333: "$(TEST_HC)" -c T3333.c -o T3333.o echo "weak_test 10" | "$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) T3333.hs T3333.o +.PHONY: T11531 +T11531: + "$(TEST_HC)" -dynamic -fPIC -c T11531.c -o T11531.o + - echo ":q" | "$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) T11531.o T11531.hs 2>&1 | sed -e '/undefined symbol:/d' 1>&2 + .PHONY: T14708 T14708: $(RM) -rf T14708scratch ===================================== testsuite/tests/ghci/linking/T11531.c ===================================== @@ -0,0 +1,9 @@ +extern void undefined_function(void); + +int some_function(int d) { + return 64; +} + +void __attribute__ ((constructor)) setup(void) { + undefined_function(); +} ===================================== testsuite/tests/ghci/linking/T11531.h ===================================== @@ -0,0 +1,2 @@ +int some_function(int d); + ===================================== testsuite/tests/ghci/linking/T11531.hs ===================================== @@ -0,0 +1,3 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +foreign import ccall "T11531.h some_function" someFunction :: Int -> Int ===================================== testsuite/tests/ghci/linking/T11531.stderr ===================================== @@ -0,0 +1,11 @@ + +GHC.Runtime.Linker.dynLoadObjs: Loading temp shared object failed +During interactive linking, GHCi couldn't find the following symbol: +This may be due to you not asking GHCi to load extra object files, +archives or DLLs needed by your current session. Restart GHCi, specifying +the missing library using the -L/path/to/object/dir and -lmissinglibname +flags, or simply by naming the relevant files on the GHCi command line. +Alternatively, this link failure might indicate a bug in GHCi. +If you suspect the latter, please report this as a GHC bug: + https://www.haskell.org/ghc/reportabug + ===================================== testsuite/tests/ghci/linking/all.T ===================================== @@ -43,6 +43,11 @@ test('T3333', expect_broken(3333))], makefile_test, ['T3333']) +test('T11531', + [extra_files(['T11531.hs', 'T11531.c', 'T11531.h']), + unless(doing_ghci, skip)], + makefile_test, ['T11531']) + test('T14708', [extra_files(['T14708.hs', 'add.c']), unless(doing_ghci, skip), View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f7334c1bca3d151aed224d708e65feb9afa22fd8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f7334c1bca3d151aed224d708e65feb9afa22fd8 You're receiving 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 Mar 24 17:53:02 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 24 Mar 2020 13:53:02 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/tyconapp-opts Message-ID: <5e7a48fe9b271_6167e0e2c943862e8@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/tyconapp-opts at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/tyconapp-opts You're receiving 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 Mar 24 19:57:13 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 24 Mar 2020 15:57:13 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/freebsd-release-job Message-ID: <5e7a66196180d_6167120434ec40283f@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/freebsd-release-job at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/freebsd-release-job You're receiving 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 Mar 24 21:02:56 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 24 Mar 2020 17:02:56 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/mkTyConApp-counters Message-ID: <5e7a758066f72_61673f81cd4b0f584109f9@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/mkTyConApp-counters at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/mkTyConApp-counters You're receiving 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 Mar 24 21:46:48 2020 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Tue, 24 Mar 2020 17:46:48 -0400 Subject: [Git][ghc/ghc][wip/compact-iface] 311 commits: Improve/fix -fcatch-bottoms documentation Message-ID: <5e7a7fc83becc_6167e6514b4422235@gitlab.haskell.org.mail> Matthew Pickering pushed to branch wip/compact-iface at Glasgow Haskell Compiler / GHC Commits: 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. - - - - - 228086d5 by Daniel Gröber at 2020-03-22T17:56:22+01:00 Remove length field from FastString - - - - - 5ccf3c23 by Daniel Gröber at 2020-03-22T18:02:11+01: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 - - - - - 51bf5cc7 by Daniel Gröber at 2020-03-22T18:02:11+01: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. - - - - - 48a00e07 by Daniel Gröber at 2020-03-22T18:02:11+01:00 Encoding: Add comment about tricky ForeignPtr lifetime - - - - - 2d678b8a by Daniel Gröber at 2020-03-22T18:02:11+01:00 Use IO constructor instead of `stToIO . ST` - - - - - f9d03e46 by Daniel Gröber at 2020-03-22T18:02:11+01:00 Encoding: Remove redundant use of withForeignPtr - - - - - d1cb11d0 by Daniel Gröber at 2020-03-22T18:02:11+01:00 Encoding: Reformat utf8EncodeShortByteString to be more consistent - - - - - 1c3af883 by Daniel Gröber at 2020-03-22T18:02:11+01:00 FastString: Reintroduce character count cache - - - - - e4806791 by Matthew Pickering at 2020-03-24T20:12:44+00:00 Remove TyThing from WiredIn names This change will allow `ModIface` to be compacted. Related to #17097 - - - - - e218ea5d by Matthew Pickering at 2020-03-24T21:05:01+00:00 Parameterise Literal so that the Type can be removed The `Type` field contains references to things which can't be compacted. See #17097 - - - - - 4eb663ba by Matthew Pickering at 2020-03-24T21:05:01+00:00 Use FastString instead of ByteString in LitString Not sure this is the best choice but manipulating ShortByteStrings is also awkward - - - - - 5cc54249 by Matthew Pickering at 2020-03-24T21:05:01+00:00 Split off cache fields from ModIface This is necessary as functions can't be compacted. See #17097 - - - - - 4e1d9e65 by Matthew Pickering at 2020-03-24T21:05:01+00:00 Refactor HsDocString to use ShortByteString This is towards being able to compact a ModIface (see #17097) - - - - - 6bcebaa7 by Matthew Pickering at 2020-03-24T21:05:01+00:00 HIE Files: Remove use of ByteString for ShortByteString See #17097 - - - - - a8fe3fe2 by Matthew Pickering at 2020-03-24T21:05:01+00:00 Remove Binary instance for ByteString This is a defensive incase someone tries to add back something which mentions ByteString into a ModIface See #17097 - - - - - 4df64100 by Matthew Pickering at 2020-03-24T21:05:02+00:00 Proof of compacting ModIface - - - - - a24587b0 by Matthew Pickering at 2020-03-24T21:44:44+00:00 Use ShortByteString for FastZString We need something compactable here, as a FastString ends up getting compacted. - - - - - d42fc22d by Matthew Pickering at 2020-03-24T21:44:44+00:00 Don't throw away extra info, for now - - - - - 2d19bccb by Matthew Pickering at 2020-03-24T21:45:52+00:00 Update haddock - - - - - 30 changed files: - .ghcid - .gitlab-ci.yml - + .gitlab/ci.sh - − .gitlab/darwin-init.sh - .gitlab/linters/check-cpp.py - .gitlab/merge_request_templates/merge-request.md - − .gitlab/prepare-system.sh - − .gitlab/win32-init.sh - HACKING.md - aclocal.m4 - boot - compiler/main/GHC.hs → compiler/GHC.hs - compiler/ghci/ByteCodeAsm.hs → compiler/GHC/ByteCode/Asm.hs - compiler/ghci/ByteCodeItbls.hs → compiler/GHC/ByteCode/InfoTable.hs - compiler/ghci/ByteCodeInstr.hs → compiler/GHC/ByteCode/Instr.hs - compiler/ghci/ByteCodeLink.hs → compiler/GHC/ByteCode/Linker.hs - compiler/ghci/ByteCodeTypes.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.hs - compiler/GHC/Cmm/Dataflow/Block.hs - compiler/GHC/Cmm/Dataflow/Graph.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Graph.hs - compiler/GHC/Cmm/Info.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/aa293b8959cd27efe2e5146cb8d8f77d0dbb706a...2d19bccba404f3334ae896d9c22a1d295cfcb5c0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/aa293b8959cd27efe2e5146cb8d8f77d0dbb706a...2d19bccba404f3334ae896d9c22a1d295cfcb5c0 You're receiving 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 Mar 24 22:51:32 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Tue, 24 Mar 2020 18:51:32 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T17955 Message-ID: <5e7a8ef4cba78_6167120434ec4495b7@gitlab.haskell.org.mail> Ryan Scott pushed new branch wip/T17955 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T17955 You're receiving 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 Mar 25 03:32:27 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 24 Mar 2020 23:32:27 -0400 Subject: [Git][ghc/ghc][ghc-8.10.1-release] Bump Haddock submodule for 2.24 release Message-ID: <5e7ad0cb21c59_616713339fc44577a9@gitlab.haskell.org.mail> Ben Gamari pushed to tag ghc-8.10.1-release at Glasgow Haskell Compiler / GHC Commits: 5c3cadf5 by Alec Theriault at 2020-03-22T20:26:41-04:00 Bump Haddock submodule for 2.24 release - - - - - 1 changed file: - utils/haddock Changes: ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 46c288ea42c50302d708fa7a2495f3544aafac35 +Subproject commit 03dbfdd70186e484135ba1ea8d27672264cd9712 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5c3cadf5db0d7eb859ff2c278ab07585c7df17b5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5c3cadf5db0d7eb859ff2c278ab07585c7df17b5 You're receiving 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 Mar 25 06:50:16 2020 From: gitlab at gitlab.haskell.org (=?UTF-8?B?w5ZtZXIgU2luYW4gQcSfYWNhbg==?=) Date: Wed, 25 Mar 2020 02:50:16 -0400 Subject: [Git][ghc/ghc][wip/osa1/lfinfo] 3 commits: Fix ApplicativeDo regression #17835 Message-ID: <5e7aff2856b55_61677b155d8458167@gitlab.haskell.org.mail> Ömer Sinan Ağacan pushed to branch wip/osa1/lfinfo at Glasgow Haskell Compiler / GHC Commits: 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) - - - - - 84a4679e by Ömer Sinan Ağacan at 2020-03-25T09:49:36+03:00 Cross-module LambdaFormInfo passing - Store LambdaFormInfos of exported Ids in interface files - Use them in importing modules - - - - - 30 changed files: - compiler/GHC/CoreToIface.hs - compiler/GHC/Driver/Hooks.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Runtime/Heap/Layout.hs - compiler/GHC/StgToCmm.hs - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/StgToCmm/Env.hs - + compiler/GHC/StgToCmm/Types.hs - compiler/basicTypes/Id.hs - compiler/basicTypes/IdInfo.hs - compiler/ghc.cabal.in - compiler/main/UpdateCafInfos.hs - libraries/base/Data/Semigroup.hs - testsuite/tests/ado/T13242a.stderr - + testsuite/tests/ado/T17835.hs - testsuite/tests/ado/ado001.stdout - testsuite/tests/ado/all.T - testsuite/tests/codeGen/should_compile/Makefile - + testsuite/tests/codeGen/should_compile/cg009/A.hs - + testsuite/tests/codeGen/should_compile/cg009/Main.hs - + testsuite/tests/codeGen/should_compile/cg009/Makefile - + testsuite/tests/codeGen/should_compile/cg009/all.T - + testsuite/tests/codeGen/should_compile/cg010/A.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/168a1ebb1793513203f81af92dd6d023c20dd996...84a4679eaa676363dded643120c240d4ef01795b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/168a1ebb1793513203f81af92dd6d023c20dd996...84a4679eaa676363dded643120c240d4ef01795b You're receiving 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 Mar 25 06:52:38 2020 From: gitlab at gitlab.haskell.org (=?UTF-8?B?w5ZtZXIgU2luYW4gQcSfYWNhbg==?=) Date: Wed, 25 Mar 2020 02:52:38 -0400 Subject: [Git][ghc/ghc][wip/osa1/lfinfo] Cross-module LambdaFormInfo passing Message-ID: <5e7affb6deee4_61677b155d8458894@gitlab.haskell.org.mail> Ömer Sinan Ağacan pushed to branch wip/osa1/lfinfo at Glasgow Haskell Compiler / GHC Commits: bad23a78 by Ömer Sinan Ağacan at 2020-03-25T09:52:22+03:00 Cross-module LambdaFormInfo passing - Store LambdaFormInfos of exported Ids in interface files - Use them in importing modules - - - - - 29 changed files: - compiler/GHC/CoreToIface.hs - compiler/GHC/Driver/Hooks.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Runtime/Heap/Layout.hs - compiler/GHC/StgToCmm.hs - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/StgToCmm/Env.hs - + compiler/GHC/StgToCmm/Types.hs - compiler/basicTypes/Id.hs - compiler/basicTypes/IdInfo.hs - compiler/ghc.cabal.in - compiler/main/UpdateCafInfos.hs - testsuite/tests/codeGen/should_compile/Makefile - + testsuite/tests/codeGen/should_compile/cg009/A.hs - + testsuite/tests/codeGen/should_compile/cg009/Main.hs - + testsuite/tests/codeGen/should_compile/cg009/Makefile - + testsuite/tests/codeGen/should_compile/cg009/all.T - + testsuite/tests/codeGen/should_compile/cg010/A.hs - + testsuite/tests/codeGen/should_compile/cg010/Main.hs - + testsuite/tests/codeGen/should_compile/cg010/Makefile - + testsuite/tests/codeGen/should_compile/cg010/all.T - + testsuite/tests/codeGen/should_compile/cg010/cg010.stdout - testsuite/tests/simplCore/should_compile/Makefile - testsuite/tests/simplCore/should_compile/T4201.stdout Changes: ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -34,13 +34,14 @@ module GHC.CoreToIface , toIfaceIdDetails , toIfaceIdInfo , toIfUnfolding - , toIfaceOneShot , toIfaceTickish , toIfaceBind , toIfaceAlt , toIfaceCon , toIfaceApp , toIfaceVar + -- * Other stuff + , toIfaceLFInfo ) where #include "HsVersions.h" @@ -49,6 +50,7 @@ import GhcPrelude import GHC.Iface.Syntax import GHC.Core.DataCon +import GHC.StgToCmm.Types import Id import IdInfo import GHC.Core @@ -74,6 +76,8 @@ import Demand ( isTopSig ) import Cpr ( topCprSig ) import Data.Maybe ( catMaybes ) +import Data.Word +import Data.Bits {- Note [Avoiding space leaks in toIface*] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -616,6 +620,43 @@ toIfaceVar v where name = idName v +--------------------- +toIfaceLFInfo :: LambdaFormInfo -> IfaceLFInfo +toIfaceLFInfo lfi = case lfi of + LFReEntrant _ _ arity _ _ -> + IfLFReEntrant arity + LFThunk _ _ updatable sfi mb_fun -> + IfLFThunk updatable (toIfaceStandardFormInfo sfi) mb_fun + LFCon dc -> + IfLFCon (dataConName dc) + LFUnknown mb_fun -> + IfLFUnknown mb_fun + LFUnlifted -> + IfLFUnlifted + LFLetNoEscape -> + panic "toIfaceLFInfo: LFLetNoEscape" + +toIfaceStandardFormInfo :: StandardFormInfo -> IfaceStandardFormInfo +toIfaceStandardFormInfo NonStandardThunk = IfStandardFormInfo 1 +toIfaceStandardFormInfo sf = + IfStandardFormInfo $! + tag sf .|. encodeField (field sf) + where + tag SelectorThunk{} = 0 + tag ApThunk{} = 2 -- == setBit 0 1 + tag _ = panic "Impossible" + + field (SelectorThunk n) = n + field (ApThunk n) = n + field _ = panic "Impossible" + + encodeField n = + let wn = fromIntegral n :: Word + shifted = wn `unsafeShiftL` 2 + in ASSERT(shifted > 0 && shifted < fromIntegral (maxBound :: Word16)) + (fromIntegral shifted :: Word16) + + {- Note [Inlining and hs-boot files] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider this example (#10083, #12789): ===================================== compiler/GHC/Driver/Hooks.hs ===================================== @@ -55,6 +55,7 @@ import GHC.Stg.Syntax import Stream import GHC.Cmm import GHC.Hs.Extension +import GHC.StgToCmm.Types (ModuleLFInfos) import Data.Maybe @@ -109,7 +110,7 @@ data Hooks = Hooks -> IO (Maybe HValue)) , createIservProcessHook :: Maybe (CreateProcess -> IO ProcessHandle) , stgToCmmHook :: Maybe (DynFlags -> Module -> [TyCon] -> CollectedCCs - -> [CgStgTopBinding] -> HpcInfo -> Stream IO CmmGroup ()) + -> [CgStgTopBinding] -> HpcInfo -> Stream IO CmmGroup ModuleLFInfos) , cmmToRawCmmHook :: forall a . Maybe (DynFlags -> Maybe Module -> Stream IO CmmGroupSRTs a -> IO (Stream IO RawCmmGroup a)) } ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -162,6 +162,7 @@ import Bag import Exception import qualified Stream import Stream (Stream) +import GHC.StgToCmm.Types (ModuleLFInfos) import Util @@ -176,6 +177,7 @@ import qualified Data.Set as S import Data.Set (Set) import Data.Functor import Control.DeepSeq (force) +import Data.Bifunctor (first) import GHC.Iface.Ext.Ast ( mkHieFile ) import GHC.Iface.Ext.Types ( getAsts, hie_asts, hie_module ) @@ -1392,7 +1394,7 @@ hscWriteIface dflags iface no_change mod_location = do -- | Compile to hard-code. hscGenHardCode :: HscEnv -> CgGuts -> ModLocation -> FilePath - -> IO (FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)], NameSet) + -> IO (FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)], NameSet, ModuleLFInfos) -- ^ @Just f@ <=> _stub.c is f hscGenHardCode hsc_env cgguts location output_filename = do let CgGuts{ -- This is the last use of the ModGuts in a compilation. @@ -1451,11 +1453,11 @@ hscGenHardCode hsc_env cgguts location output_filename = do return a rawcmms1 = Stream.mapM dump rawcmms0 - (output_filename, (_stub_h_exists, stub_c_exists), foreign_fps, caf_infos) + (output_filename, (_stub_h_exists, stub_c_exists), foreign_fps, (caf_infos, lf_infos)) <- {-# SCC "codeOutput" #-} codeOutput dflags this_mod output_filename location foreign_stubs foreign_files dependencies rawcmms1 - return (output_filename, stub_c_exists, foreign_fps, caf_infos) + return (output_filename, stub_c_exists, foreign_fps, caf_infos, lf_infos) hscInteractive :: HscEnv @@ -1549,7 +1551,7 @@ doCodeGen :: HscEnv -> Module -> [TyCon] -> CollectedCCs -> [StgTopBinding] -> HpcInfo - -> IO (Stream IO CmmGroupSRTs NameSet) + -> IO (Stream IO CmmGroupSRTs (NameSet, ModuleLFInfos)) -- Note we produce a 'Stream' of CmmGroups, so that the -- backend can be run incrementally. Otherwise it generates all -- the C-- up front, which has a significant space cost. @@ -1561,7 +1563,7 @@ doCodeGen hsc_env this_mod data_tycons dumpIfSet_dyn dflags Opt_D_dump_stg_final "Final STG:" FormatSTG (pprGenStgTopBindings stg_binds_w_fvs) - let cmm_stream :: Stream IO CmmGroup () + let cmm_stream :: Stream IO CmmGroup ModuleLFInfos -- See Note [Forcing of stg_binds] cmm_stream = stg_binds_w_fvs `seqList` {-# SCC "StgToCmm" #-} lookupHook stgToCmmHook StgToCmm.codeGen dflags dflags this_mod data_tycons @@ -1580,10 +1582,11 @@ doCodeGen hsc_env this_mod data_tycons ppr_stream1 = Stream.mapM dump1 cmm_stream + pipeline_stream :: Stream IO CmmGroupSRTs (NameSet, ModuleLFInfos) pipeline_stream = {-# SCC "cmmPipeline" #-} - Stream.mapAccumL (cmmPipeline hsc_env) (emptySRT this_mod) ppr_stream1 - <&> (srtMapNonCAFs . moduleSRTMap) + Stream.mapAccumL_ (cmmPipeline hsc_env) (emptySRT this_mod) ppr_stream1 + <&> (first (srtMapNonCAFs . moduleSRTMap)) dump2 a = do unless (null a) $ ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -1192,12 +1192,12 @@ runPhase (HscOut src_flavour mod_name result) _ dflags = do PipeState{hsc_env=hsc_env'} <- getPipeState - (outputFilename, mStub, foreign_files, caf_infos) <- liftIO $ + (outputFilename, mStub, foreign_files, caf_infos, lf_infos) <- liftIO $ hscGenHardCode hsc_env' cgguts mod_location output_fn - final_iface <- liftIO (mkFullIface hsc_env'{hsc_dflags=iface_dflags} partial_iface (Just caf_infos)) + final_iface <- liftIO (mkFullIface hsc_env'{hsc_dflags=iface_dflags} partial_iface (Just (caf_infos, lf_infos))) let final_mod_details = {-# SCC updateModDetailsCafInfos #-} - updateModDetailsCafInfos iface_dflags caf_infos mod_details + updateModDetailsCafInfos iface_dflags caf_infos lf_infos mod_details setIface final_iface final_mod_details -- See Note [Writing interface files] ===================================== compiler/GHC/Iface/Make.hs ===================================== @@ -38,6 +38,7 @@ import GHC.Core.Coercion.Axiom import GHC.Core.ConLike import GHC.Core.DataCon import GHC.Core.Type +import GHC.StgToCmm.Types (ModuleLFInfos) import TcType import GHC.Core.InstEnv import GHC.Core.FamInstEnv @@ -100,13 +101,13 @@ mkPartialIface hsc_env mod_details -- | Fully instantiate a interface -- Adds fingerprints and potentially code generator produced information. -mkFullIface :: HscEnv -> PartialModIface -> Maybe NameSet -> IO ModIface -mkFullIface hsc_env partial_iface mb_non_cafs = do +mkFullIface :: HscEnv -> PartialModIface -> Maybe (NameSet, ModuleLFInfos) -> IO ModIface +mkFullIface hsc_env partial_iface mb_id_infos = do let decls | gopt Opt_OmitInterfacePragmas (hsc_dflags hsc_env) = mi_decls partial_iface | otherwise - = updateDeclCafInfos (mi_decls partial_iface) mb_non_cafs + = updateDecl (mi_decls partial_iface) mb_id_infos full_iface <- {-# SCC "addFingerprints" #-} @@ -117,15 +118,23 @@ mkFullIface hsc_env partial_iface mb_non_cafs = do return full_iface -updateDeclCafInfos :: [IfaceDecl] -> Maybe NameSet -> [IfaceDecl] -updateDeclCafInfos decls Nothing = decls -updateDeclCafInfos decls (Just non_cafs) = map update_decl decls +updateDecl :: [IfaceDecl] -> Maybe (NameSet, ModuleLFInfos) -> [IfaceDecl] +updateDecl decls Nothing = decls +updateDecl decls (Just (non_cafs, lf_infos)) = map update_decl decls where + update_decl (IfaceId nm ty details infos) + | let not_caffy = elemNameSet nm non_cafs + , let mb_lf_info = lookupNameEnv lf_infos nm + , WARN( isNothing mb_lf_info, text "Name without LFInfo:" <+> ppr nm ) True + -- Only allocate a new IfaceId if we're going to update the infos + , isJust mb_lf_info || not_caffy + = IfaceId nm ty details $ + (if not_caffy then (HsNoCafRefs :) else id) + (case mb_lf_info of + Nothing -> infos + Just lf_info -> HsLFInfo (toIfaceLFInfo lf_info) : infos) + update_decl decl - | IfaceId nm ty details infos <- decl - , elemNameSet nm non_cafs - = IfaceId nm ty details (HsNoCafRefs : infos) - | otherwise = decl -- | Make an interface from the results of typechecking only. Useful ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -22,6 +22,8 @@ module GHC.Iface.Syntax ( IfaceAxBranch(..), IfaceTyConParent(..), IfaceCompleteMatch(..), + IfaceLFInfo(..), + IfaceStandardFormInfo(..), -- * Binding names IfaceTopBndr, @@ -30,6 +32,7 @@ module GHC.Iface.Syntax ( -- Misc ifaceDeclImplicitBndrs, visibleIfConDecls, ifaceDeclFingerprints, + tcStandardFormInfo, -- Free Names freeNamesIfDecl, freeNamesIfRule, freeNamesIfFamInst, @@ -72,10 +75,13 @@ import GHC.Core.DataCon (SrcStrictness(..), SrcUnpackedness(..)) import Lexeme (isLexSym) import TysWiredIn ( constraintKindTyConName ) import Util (seqList) +import GHC.StgToCmm.Types import Control.Monad import System.IO.Unsafe import Control.DeepSeq +import Data.Word +import Data.Bits infixl 3 &&& @@ -114,7 +120,8 @@ data IfaceDecl = IfaceId { ifName :: IfaceTopBndr, ifType :: IfaceType, ifIdDetails :: IfaceIdDetails, - ifIdInfo :: IfaceIdInfo } + ifIdInfo :: IfaceIdInfo + } | IfaceData { ifName :: IfaceTopBndr, -- Type constructor ifBinders :: [IfaceTyConBinder], @@ -348,6 +355,7 @@ data IfaceInfoItem IfaceUnfolding -- See Note [Expose recursive functions] | HsNoCafRefs | HsLevity -- Present <=> never levity polymorphic + | HsLFInfo IfaceLFInfo -- NB: Specialisations and rules come in separately and are -- only later attached to the Id. Partial reason: some are orphans. @@ -379,6 +387,74 @@ data IfaceIdDetails | IfRecSelId (Either IfaceTyCon IfaceDecl) Bool | IfDFunId +-- | Iface type for LambdaFormInfo. Fields not relevant for imported Ids are +-- omitted in this type. +data IfaceLFInfo + = IfLFReEntrant !RepArity + | IfLFThunk !Bool !IfaceStandardFormInfo !Bool + | IfLFCon !Name + | IfLFUnknown !Bool + | IfLFUnlifted + +tcStandardFormInfo :: IfaceStandardFormInfo -> StandardFormInfo +tcStandardFormInfo (IfStandardFormInfo w) + | testBit w 0 = NonStandardThunk + | otherwise = con field + where + field = fromIntegral (w `unsafeShiftR` 2) + con + | testBit w 1 = ApThunk + | otherwise = SelectorThunk + +instance Outputable IfaceLFInfo where + ppr (IfLFReEntrant arity) = + text "LFReEntrant" <+> ppr arity + + ppr (IfLFThunk updatable sfi mb_fun) = + text "LFThunk" <+> ppr (updatable, tcStandardFormInfo sfi, mb_fun) + + ppr (IfLFCon con) = + text "LFCon" <> brackets (ppr con) + + ppr IfLFUnlifted = + text "LFUnlifted" + + ppr (IfLFUnknown fun_flag) = + text "LFUnknown" <+> ppr fun_flag + +newtype IfaceStandardFormInfo = IfStandardFormInfo Word16 + +instance Binary IfaceStandardFormInfo where + put_ bh (IfStandardFormInfo w) = put_ bh (w :: Word16) + get bh = IfStandardFormInfo <$> (get bh :: IO Word16) + +instance Binary IfaceLFInfo where + put_ bh (IfLFReEntrant arity) = do + putByte bh 0 + put_ bh arity + put_ bh (IfLFThunk updatable sfi mb_fun) = do + putByte bh 1 + put_ bh updatable + put_ bh sfi + put_ bh mb_fun + put_ bh (IfLFCon con_name) = do + putByte bh 2 + put_ bh con_name + put_ bh (IfLFUnknown fun_flag) = do + putByte bh 3 + put_ bh fun_flag + put_ bh IfLFUnlifted = + putByte bh 4 + get bh = do + tag <- getByte bh + case tag of + 0 -> IfLFReEntrant <$> get bh + 1 -> IfLFThunk <$> get bh <*> get bh <*> get bh + 2 -> IfLFCon <$> get bh + 3 -> IfLFUnknown <$> get bh + 4 -> pure IfLFUnlifted + _ -> panic "Invalid byte" + {- Note [Versioning of instances] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1393,6 +1469,7 @@ instance Outputable IfaceInfoItem where ppr (HsCpr cpr) = text "CPR:" <+> ppr cpr ppr HsNoCafRefs = text "HasNoCafRefs" ppr HsLevity = text "Never levity-polymorphic" + ppr (HsLFInfo lf_info) = text "LambdaFormInfo:" <+> ppr lf_info instance Outputable IfaceJoinInfo where ppr IfaceNotJoinPoint = empty @@ -1853,7 +1930,7 @@ instance Binary IfaceDecl where get bh = do h <- getByte bh case h of - 0 -> do name <- get bh + 0 -> do name <- get bh ~(ty, details, idinfo) <- lazyGet bh -- See Note [Lazy deserialization of IfaceId] return (IfaceId name ty details idinfo) @@ -2153,6 +2230,8 @@ instance Binary IfaceInfoItem where put_ bh HsNoCafRefs = putByte bh 4 put_ bh HsLevity = putByte bh 5 put_ bh (HsCpr cpr) = putByte bh 6 >> put_ bh cpr + put_ bh (HsLFInfo lf_info) = putByte bh 7 >> put_ bh lf_info + get bh = do h <- getByte bh case h of @@ -2164,7 +2243,8 @@ instance Binary IfaceInfoItem where 3 -> liftM HsInline $ get bh 4 -> return HsNoCafRefs 5 -> return HsLevity - _ -> HsCpr <$> get bh + 6 -> HsCpr <$> get bh + _ -> HsLFInfo <$> get bh instance Binary IfaceUnfolding where put_ bh (IfCoreUnfold s e) = do @@ -2495,6 +2575,7 @@ instance NFData IfaceInfoItem where HsNoCafRefs -> () HsLevity -> () HsCpr cpr -> cpr `seq` () + HsLFInfo lf_info -> lf_info `seq` () -- TODO: seq further? instance NFData IfaceUnfolding where rnf = \case ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -122,6 +122,9 @@ data IfaceOneShot -- See Note [Preserve OneShotInfo] in CoreTicy = IfaceNoOneShot -- and Note [The oneShot function] in MkId | IfaceOneShot +instance Outputable IfaceOneShot where + ppr IfaceNoOneShot = text "NoOneShotInfo" + ppr IfaceOneShot = text "OneShot" {- %************************************************************************ ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -19,7 +19,8 @@ module GHC.IfaceToCore ( tcIfaceDecl, tcIfaceInst, tcIfaceFamInst, tcIfaceRules, tcIfaceAnnotations, tcIfaceCompleteSigs, tcIfaceExpr, -- Desired by HERMIT (#7683) - tcIfaceGlobal + tcIfaceGlobal, + tcIfaceOneShot ) where #include "HsVersions.h" @@ -30,6 +31,9 @@ import TcTypeNats(typeNatCoAxiomRules) import GHC.Iface.Syntax import GHC.Iface.Load import GHC.Iface.Env +import GHC.StgToCmm.Types +import GHC.StgToCmm.Closure +import GHC.Types.RepType import BuildTyCl import TcRnMonad import TcType @@ -641,7 +645,7 @@ tc_iface_decl _ ignore_prags (IfaceId {ifName = name, ifType = iface_type, = do { ty <- tcIfaceType iface_type ; details <- tcIdDetails ty details ; info <- tcIdInfo ignore_prags TopLevel name ty info - ; return (AnId (mkGlobalId details name ty info)) } + ; return (AnId (addIdLFInfo (mkGlobalId details name ty info))) } tc_iface_decl _ _ (IfaceData {ifName = tc_name, ifCType = cType, @@ -1340,7 +1344,8 @@ tcIfaceExpr (IfaceLet (IfaceNonRec (IfLetBndr fs ty info ji) rhs) body) ; ty' <- tcIfaceType ty ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -} NotTopLevel name ty' info - ; let id = mkLocalIdWithInfo name ty' id_info + ; let id = addIdLFInfo $ + mkLocalIdWithInfo name ty' id_info `asJoinId_maybe` tcJoinInfo ji ; rhs' <- tcIfaceExpr rhs ; body' <- extendIfaceIdEnv [id] (tcIfaceExpr body) @@ -1361,7 +1366,7 @@ tcIfaceExpr (IfaceLet (IfaceRec pairs) body) = do { rhs' <- tcIfaceExpr rhs ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -} NotTopLevel (idName id) (idType id) info - ; return (setIdInfo id id_info, rhs') } + ; return (addIdLFInfo (setIdInfo id id_info), rhs') } tcIfaceExpr (IfaceTick tickish expr) = do expr' <- tcIfaceExpr expr @@ -1465,8 +1470,7 @@ tcIdInfo ignore_prags toplvl name ty info = do let init_info | if_boot lcl_env = vanillaIdInfo `setUnfoldingInfo` BootUnfolding | otherwise = vanillaIdInfo - let needed = needed_prags info - foldlM tcPrag init_info needed + foldlM tcPrag init_info (needed_prags info) where needed_prags :: [IfaceInfoItem] -> [IfaceInfoItem] needed_prags items @@ -1486,6 +1490,9 @@ tcIdInfo ignore_prags toplvl name ty info = do tcPrag info (HsCpr cpr) = return (info `setCprInfo` cpr) tcPrag info (HsInline prag) = return (info `setInlinePragInfo` prag) tcPrag info HsLevity = return (info `setNeverLevPoly` ty) + tcPrag info (HsLFInfo lf_info) = do + lf_info <- tcLFInfo lf_info + return (info `setLFInfo` lf_info) -- The next two are lazy, so they don't transitively suck stuff in tcPrag info (HsUnfold lb if_unf) @@ -1494,10 +1501,55 @@ tcIdInfo ignore_prags toplvl name ty info = do | otherwise = info ; return (info1 `setUnfoldingInfo` unf) } +addIdLFInfo :: Id -> Id +addIdLFInfo id = case idLFInfo_maybe id of + Nothing -> setIdLFInfo id (mkLFImported (idDetails id) (idInfo id) (idType id)) + Just _ -> id + +-- Make a LambdaFormInfo for the Ids without a LFInfo in the iface file +mkLFImported :: IdDetails -> IdInfo -> Type -> LambdaFormInfo +mkLFImported details info ty + | DataConWorkId con <- details + , isNullaryRepDataCon con + = LFCon con -- An imported nullary constructor + -- We assume that the constructor is evaluated so that + -- the id really does point directly to the constructor + + | arity > 0 + = LFReEntrant TopLevel noOneShotInfo arity True ArgUnknown + + | isUnliftedType ty + = LFUnlifted + + | mightBeAFunction ty + = LFUnknown True + + | otherwise + = LFUnknown False + where + arity = countFunRepArgs (arityInfo info) ty + tcJoinInfo :: IfaceJoinInfo -> Maybe JoinArity tcJoinInfo (IfaceJoinPoint ar) = Just ar tcJoinInfo IfaceNotJoinPoint = Nothing +tcLFInfo :: IfaceLFInfo -> IfL LambdaFormInfo +tcLFInfo lfi = case lfi of + IfLFReEntrant rep_arity -> + return (LFReEntrant TopLevel NoOneShotInfo rep_arity True ArgUnknown) + + IfLFThunk updatable sfi mb_fun -> + return (LFThunk TopLevel True updatable (tcStandardFormInfo sfi) mb_fun) + + IfLFUnlifted -> + return LFUnlifted + + IfLFCon con_name -> + LFCon <$!> tcIfaceDataCon con_name + + IfLFUnknown fun_flag -> + return (LFUnknown fun_flag) + tcUnfolding :: TopLevelFlag -> Name -> Type -> IdInfo -> IfaceUnfolding -> IfL Unfolding tcUnfolding toplvl name _ info (IfCoreUnfold stable if_expr) = do { dflags <- getDynFlags @@ -1586,6 +1638,10 @@ tcPragExpr is_compulsory toplvl name expr -- It's OK to use nonDetEltsUFM here because we immediately forget -- the ordering by creating a set +tcIfaceOneShot :: IfaceOneShot -> OneShotInfo +tcIfaceOneShot IfaceNoOneShot = NoOneShotInfo +tcIfaceOneShot IfaceOneShot = OneShotLam + {- ************************************************************************ * * ===================================== compiler/GHC/Runtime/Heap/Layout.hs ===================================== @@ -51,6 +51,7 @@ import GHC.Driver.Session import Outputable import GHC.Platform import FastString +import GHC.StgToCmm.Types import Data.Word import Data.Bits @@ -64,9 +65,6 @@ import Data.ByteString (ByteString) ************************************************************************ -} --- | Word offset, or word count -type WordOff = Int - -- | Byte offset, or byte count type ByteOff = Int @@ -196,29 +194,6 @@ type ConstrDescription = ByteString -- result of dataConIdentity type FunArity = Int type SelectorOffset = Int -------------------------- --- We represent liveness bitmaps as a Bitmap (whose internal --- representation really is a bitmap). These are pinned onto case return --- vectors to indicate the state of the stack for the garbage collector. --- --- In the compiled program, liveness bitmaps that fit inside a single --- word (StgWord) are stored as a single word, while larger bitmaps are --- stored as a pointer to an array of words. - -type Liveness = [Bool] -- One Bool per word; True <=> non-ptr or dead - -- False <=> ptr - -------------------------- --- An ArgDescr describes the argument pattern of a function - -data ArgDescr - = ArgSpec -- Fits one of the standard patterns - !Int -- RTS type identifier ARG_P, ARG_N, ... - - | ArgGen -- General case - Liveness -- Details about the arguments - - ----------------------------------------------------------------------------- -- Construction @@ -545,10 +520,6 @@ instance Outputable SMRep where ppr (RTSRep ty rep) = text "tag:" <> ppr ty <+> ppr rep -instance Outputable ArgDescr where - ppr (ArgSpec n) = text "ArgSpec" <+> ppr n - ppr (ArgGen ls) = text "ArgGen" <+> ppr ls - pprTypeInfo :: ClosureTypeInfo -> SDoc pprTypeInfo (Constr tag descr) = text "Con" <+> ===================================== compiler/GHC/StgToCmm.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} +{-# LANGUAGE BangPatterns #-} ----------------------------------------------------------------------------- -- @@ -25,6 +26,7 @@ import GHC.StgToCmm.Utils import GHC.StgToCmm.Closure import GHC.StgToCmm.Hpc import GHC.StgToCmm.Ticky +import GHC.StgToCmm.Types (ModuleLFInfos) import GHC.Cmm import GHC.Cmm.CLabel @@ -45,6 +47,8 @@ import Outputable import Stream import BasicTypes import VarSet ( isEmptyDVarSet ) +import UniqFM +import NameEnv import OrdList import GHC.Cmm.Graph @@ -52,6 +56,7 @@ import GHC.Cmm.Graph import Data.IORef import Control.Monad (when,void) import Util +import Data.Maybe codeGen :: DynFlags -> Module @@ -59,7 +64,8 @@ codeGen :: DynFlags -> CollectedCCs -- (Local/global) cost-centres needing declaring/registering. -> [CgStgTopBinding] -- Bindings to convert -> HpcInfo - -> Stream IO CmmGroup () -- Output as a stream, so codegen can + -> Stream IO CmmGroup ModuleLFInfos + -- Output as a stream, so codegen can -- be interleaved with output codeGen dflags this_mod data_tycons @@ -101,6 +107,20 @@ codeGen dflags this_mod data_tycons mapM_ (cg . cgDataCon) (tyConDataCons tycon) ; mapM_ do_tycon data_tycons + + ; cg_id_infos <- cgs_binds <$> liftIO (readIORef cgref) + + -- Only external names are actually visible to codeGen. So they are the + -- only ones we care about. + ; let extractInfo info = lf `seq` Just (name,lf) + where + id = cg_id info + !name = idName id + lf = cg_lf info + + ; let !generatedInfo = mkNameEnv (mapMaybe extractInfo (eltsUFM cg_id_infos)) + + ; return $! generatedInfo } --------------------------------------------------------------- ===================================== compiler/GHC/StgToCmm/Closure.hs ===================================== @@ -24,7 +24,7 @@ module GHC.StgToCmm.Closure ( LambdaFormInfo, -- Abstract StandardFormInfo, -- ...ditto... mkLFThunk, mkLFReEntrant, mkConLFInfo, mkSelectorLFInfo, - mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape, + mkApLFInfo, mkLFArgument, mkLFLetNoEscape, mkLFStringLit, lfDynTag, isLFThunk, isLFReEntrant, lfUpdatable, @@ -51,6 +51,7 @@ module GHC.StgToCmm.Closure ( closureUpdReqd, closureSingleEntry, closureReEntrant, closureFunInfo, isToplevClosure, + mightBeAFunction, blackHoleOnEntry, -- Needs LambdaFormInfo and SMRep isStaticClosure, -- Needs SMPre @@ -70,6 +71,7 @@ import GHC.Stg.Syntax import GHC.Runtime.Heap.Layout import GHC.Cmm import GHC.Cmm.Ppr.Expr() -- For Outputable instances +import GHC.StgToCmm.Types import CostCentre import GHC.Cmm.BlockId @@ -188,86 +190,15 @@ addArgReps = map (\arg -> let arg' = fromNonVoid arg argPrimRep :: StgArg -> PrimRep argPrimRep arg = typePrimRep1 (stgArgType arg) - ------------------------------------------------------------------------------ --- LambdaFormInfo ------------------------------------------------------------------------------ - --- Information about an identifier, from the code generator's point of --- view. Every identifier is bound to a LambdaFormInfo in the --- environment, which gives the code generator enough info to be able to --- tail call or return that identifier. - -data LambdaFormInfo - = LFReEntrant -- Reentrant closure (a function) - TopLevelFlag -- True if top level - OneShotInfo - !RepArity -- Arity. Invariant: always > 0 - !Bool -- True <=> no fvs - ArgDescr -- Argument descriptor (should really be in ClosureInfo) - - | LFThunk -- Thunk (zero arity) - TopLevelFlag - !Bool -- True <=> no free vars - !Bool -- True <=> updatable (i.e., *not* single-entry) - StandardFormInfo - !Bool -- True <=> *might* be a function type - - | LFCon -- A saturated constructor application - DataCon -- The constructor - - | LFUnknown -- Used for function arguments and imported things. - -- We know nothing about this closure. - -- Treat like updatable "LFThunk"... - -- Imported things which we *do* know something about use - -- one of the other LF constructors (eg LFReEntrant for - -- known functions) - !Bool -- True <=> *might* be a function type - -- The False case is good when we want to enter it, - -- because then we know the entry code will do - -- For a function, the entry code is the fast entry point - - | LFUnlifted -- A value of unboxed type; - -- always a value, needs evaluation - - | LFLetNoEscape -- See LetNoEscape module for precise description - - -------------------------- --- StandardFormInfo tells whether this thunk has one of --- a small number of standard forms - -data StandardFormInfo - = NonStandardThunk - -- The usual case: not of the standard forms - - | SelectorThunk - -- A SelectorThunk is of form - -- case x of - -- con a1,..,an -> ak - -- and the constructor is from a single-constr type. - WordOff -- 0-origin offset of ak within the "goods" of - -- constructor (Recall that the a1,...,an may be laid - -- out in the heap in a non-obvious order.) - - | ApThunk - -- An ApThunk is of form - -- x1 ... xn - -- The code for the thunk just pushes x2..xn on the stack and enters x1. - -- There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled - -- in the RTS to save space. - RepArity -- Arity, n - - ------------------------------------------------------ -- Building LambdaFormInfo ------------------------------------------------------ mkLFArgument :: Id -> LambdaFormInfo mkLFArgument id - | isUnliftedType ty = LFUnlifted - | might_be_a_function ty = LFUnknown True - | otherwise = LFUnknown False + | isUnliftedType ty = LFUnlifted + | mightBeAFunction ty = LFUnknown True + | otherwise = LFUnknown False where ty = idType id @@ -295,13 +226,13 @@ mkLFThunk thunk_ty top fvs upd_flag LFThunk top (null fvs) (isUpdatable upd_flag) NonStandardThunk - (might_be_a_function thunk_ty) + (mightBeAFunction thunk_ty) -------------- -might_be_a_function :: Type -> Bool +mightBeAFunction :: Type -> Bool -- Return False only if we are *sure* it's a data type -- Look through newtypes etc as much as poss -might_be_a_function ty +mightBeAFunction ty | [LiftedRep] <- typePrimRep ty , Just tc <- tyConAppTyCon_maybe (unwrapType ty) , isDataTyCon tc @@ -317,30 +248,13 @@ mkConLFInfo con = LFCon con mkSelectorLFInfo :: Id -> Int -> Bool -> LambdaFormInfo mkSelectorLFInfo id offset updatable = LFThunk NotTopLevel False updatable (SelectorThunk offset) - (might_be_a_function (idType id)) + (mightBeAFunction (idType id)) ------------- mkApLFInfo :: Id -> UpdateFlag -> Arity -> LambdaFormInfo mkApLFInfo id upd_flag arity = LFThunk NotTopLevel (arity == 0) (isUpdatable upd_flag) (ApThunk arity) - (might_be_a_function (idType id)) - -------------- -mkLFImported :: Id -> LambdaFormInfo -mkLFImported id - | Just con <- isDataConWorkId_maybe id - , isNullaryRepDataCon con - = LFCon con -- An imported nullary constructor - -- We assume that the constructor is evaluated so that - -- the id really does point directly to the constructor - - | arity > 0 - = LFReEntrant TopLevel noOneShotInfo arity True (panic "arg_descr") - - | otherwise - = mkLFArgument id -- Not sure of exact arity - where - arity = idFunRepArity id + (mightBeAFunction (idType id)) ------------- mkLFStringLit :: LambdaFormInfo ===================================== compiler/GHC/StgToCmm/Env.hs ===================================== @@ -31,6 +31,7 @@ import GHC.Platform import GHC.StgToCmm.Monad import GHC.StgToCmm.Utils import GHC.StgToCmm.Closure +import GHC.StgToCmm.Types import GHC.Cmm.CLabel @@ -48,6 +49,8 @@ import TysPrim import UniqFM import Util import VarEnv +import GHC.Core.DataCon +import BasicTypes ------------------------------------- -- Manipulating CgIdInfo @@ -146,6 +149,26 @@ getCgIdInfo id cgLookupPanic id -- Bug }}} +mkLFImported :: Id -> LambdaFormInfo +mkLFImported id = + case idLFInfo_maybe id of + Just lf_info -> + lf_info + Nothing + | Just con <- isDataConWorkId_maybe id + , isNullaryRepDataCon con + -> LFCon con -- An imported nullary constructor + -- We assume that the constructor is evaluated so that + -- the id really does point directly to the constructor + + | arity > 0 + -> LFReEntrant TopLevel noOneShotInfo arity True ArgUnknown + + | otherwise + -> mkLFArgument id -- Not sure of exact arity + where + arity = idFunRepArity id + cgLookupPanic :: Id -> FCode a cgLookupPanic id = do local_binds <- getBinds ===================================== compiler/GHC/StgToCmm/Types.hs ===================================== @@ -0,0 +1,157 @@ +{-# LANGUAGE CPP #-} + +module GHC.StgToCmm.Types + ( WordOff + , LambdaFormInfo (..) + , ModuleLFInfos + , Liveness + , ArgDescr (..) + , StandardFormInfo (..) + ) where + +#include "HsVersions.h" + +import GhcPrelude + +import BasicTypes +import GHC.Core.DataCon +import NameEnv +import Outputable + +-- | Word offset, or word count +type WordOff = Int + +-------------------------------------------------------------------------------- +-- LambdaFormInfo +-------------------------------------------------------------------------------- + +-- | Maps names in the current module to their LambdaFormInfos +type ModuleLFInfos = NameEnv LambdaFormInfo + +-- Information about an identifier, from the code generator's point of view. +-- Every identifier is bound to a LambdaFormInfo in the environment, which gives +-- the code generator enough info to be able to tail call or return that +-- identifier. + +data LambdaFormInfo + = LFReEntrant -- Reentrant closure (a function) + !TopLevelFlag -- True if top level + !OneShotInfo + !RepArity -- Arity. Invariant: always > 0 + !Bool -- True <=> no fvs + !ArgDescr -- Argument descriptor (should really be in ClosureInfo) + + | LFThunk -- Thunk (zero arity) + !TopLevelFlag + !Bool -- True <=> no free vars + !Bool -- True <=> updatable (i.e., *not* single-entry) + !StandardFormInfo + !Bool -- True <=> *might* be a function type + + | LFCon -- A saturated constructor application + !DataCon -- The constructor + + | LFUnknown -- Used for function arguments and imported things. + -- We know nothing about this closure. + -- Treat like updatable "LFThunk"... + -- Imported things which we *do* know something about use + -- one of the other LF constructors (eg LFReEntrant for + -- known functions) + !Bool -- True <=> *might* be a function type + -- The False case is good when we want to enter it, + -- because then we know the entry code will do + -- For a function, the entry code is the fast entry point + + | LFUnlifted -- A value of unboxed type; + -- always a value, needs evaluation + + | LFLetNoEscape -- See LetNoEscape module for precise description + +instance Outputable LambdaFormInfo where + ppr (LFReEntrant top oneshot rep fvs argdesc) = + text "LFReEntrant" <> brackets (ppr top <+> ppr oneshot <+> + ppr rep <+> pprFvs fvs <+> ppr argdesc) + ppr (LFThunk top hasfv updateable sfi m_function) = + text "LFThunk" <> brackets (ppr top <+> pprFvs hasfv <+> pprUpdateable updateable <+> + ppr sfi <+> pprFuncFlag m_function) + ppr (LFCon con) = text "LFCon" <> brackets (ppr con) + ppr (LFUnknown m_func) = + text "LFUnknown" <> brackets (pprFuncFlag m_func) + ppr LFUnlifted = text "LFUnlifted" + ppr LFLetNoEscape = text "LFLetNoEscape" + +pprFvs :: Bool -> SDoc +pprFvs True = text "no-fvs" +pprFvs False = text "fvs" + +pprFuncFlag :: Bool -> SDoc +pprFuncFlag True = text "mFunc" +pprFuncFlag False = text "value" + +pprUpdateable :: Bool -> SDoc +pprUpdateable True = text "updateable" +pprUpdateable False = text "oneshot" + +-------------------------------------------------------------------------------- + +-- | We represent liveness bitmaps as a Bitmap (whose internal representation +-- really is a bitmap). These are pinned onto case return vectors to indicate +-- the state of the stack for the garbage collector. +-- +-- In the compiled program, liveness bitmaps that fit inside a single word +-- (StgWord) are stored as a single word, while larger bitmaps are stored as a +-- pointer to an array of words. + +type Liveness = [Bool] -- One Bool per word; True <=> non-ptr or dead + -- False <=> ptr + +-------------------------------------------------------------------------------- +-- | An ArgDescr describes the argument pattern of a function + +data ArgDescr + = ArgSpec -- Fits one of the standard patterns + !Int -- RTS type identifier ARG_P, ARG_N, ... + + | ArgGen -- General case + Liveness -- Details about the arguments + + | ArgUnknown -- For imported binds. + -- Invariant: Never Unknown for binds of the module + -- we are compiling. + deriving (Eq) + +instance Outputable ArgDescr where + ppr (ArgSpec n) = text "ArgSpec" <+> ppr n + ppr (ArgGen ls) = text "ArgGen" <+> ppr ls + ppr ArgUnknown = text "ArgUnknown" + +-------------------------------------------------------------------------------- +-- | StandardFormInfo tells whether this thunk has one of a small number of +-- standard forms + +data StandardFormInfo + = NonStandardThunk + -- The usual case: not of the standard forms + + | SelectorThunk + -- A SelectorThunk is of form + -- case x of + -- con a1,..,an -> ak + -- and the constructor is from a single-constr type. + WordOff -- 0-origin offset of ak within the "goods" of + -- constructor (Recall that the a1,...,an may be laid + -- out in the heap in a non-obvious order.) + + | ApThunk + -- An ApThunk is of form + -- x1 ... xn + -- The code for the thunk just pushes x2..xn on the stack and enters x1. + -- There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled + -- in the RTS to save space. + RepArity -- Arity, n + deriving (Eq) + +instance Outputable StandardFormInfo where + ppr NonStandardThunk = text "RegThunk" + ppr (SelectorThunk w) = text "SelThunk:" <> ppr w + ppr (ApThunk n) = text "ApThunk:" <> ppr n ===================================== compiler/basicTypes/Id.hs ===================================== @@ -92,7 +92,7 @@ module Id ( idCallArity, idFunRepArity, idUnfolding, realIdUnfolding, idSpecialisation, idCoreRules, idHasRules, - idCafInfo, + idCafInfo, idLFInfo, idLFInfo_maybe, idOneShotInfo, idStateHackOneShotInfo, idOccInfo, isNeverLevPolyId, @@ -105,6 +105,7 @@ module Id ( setIdSpecialisation, setIdCafInfo, setIdOccInfo, zapIdOccInfo, + setIdLFInfo, setIdDemandInfo, setIdStrictness, @@ -731,6 +732,19 @@ idCafInfo id = cafInfo (idInfo id) setIdCafInfo :: Id -> CafInfo -> Id setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id + --------------------------------- + -- Lambda form info +idLFInfo :: HasCallStack => Id -> LambdaFormInfo +idLFInfo id = case lfInfo (idInfo id) of + Nothing -> pprPanic "idLFInfo" (text "LFInfo not available for Id" <+> ppr id) + Just lf_info -> lf_info + +idLFInfo_maybe :: Id -> Maybe LambdaFormInfo +idLFInfo_maybe = lfInfo . idInfo + +setIdLFInfo :: Id -> LambdaFormInfo -> Id +setIdLFInfo id lf = modifyIdInfo (`setLFInfo` lf) id + --------------------------------- -- Occurrence INFO idOccInfo :: Id -> OccInfo ===================================== compiler/basicTypes/IdInfo.hs ===================================== @@ -74,6 +74,10 @@ module IdInfo ( ppCafInfo, mayHaveCafRefs, cafInfo, setCafInfo, + -- ** The LambdaFormInfo type + LambdaFormInfo(..), + lfInfo, setLFInfo, + -- ** Tick-box Info TickBoxOp(..), TickBoxId, @@ -104,6 +108,8 @@ import Demand import Cpr import Util +import GHC.StgToCmm.Types (LambdaFormInfo (..)) + -- infixl so you can say (id `set` a `set` b) infixl 1 `setRuleInfo`, `setArityInfo`, @@ -270,8 +276,9 @@ data IdInfo -- ^ 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 + levityInfo :: LevityInfo, -- ^ when applied, will this Id ever have a levity-polymorphic type? + lfInfo :: !(Maybe LambdaFormInfo) } -- Setters @@ -294,13 +301,18 @@ setUnfoldingInfo info uf setArityInfo :: IdInfo -> ArityInfo -> IdInfo setArityInfo info ar = info { arityInfo = ar } + setCallArityInfo :: IdInfo -> ArityInfo -> IdInfo setCallArityInfo info ar = info { callArityInfo = ar } + setCafInfo :: IdInfo -> CafInfo -> IdInfo -setCafInfo info caf = info { cafInfo = caf } +setCafInfo info caf = info { cafInfo = caf } + +setLFInfo :: IdInfo -> LambdaFormInfo -> IdInfo +setLFInfo info lf = info { lfInfo = Just lf } setOneShotInfo :: IdInfo -> OneShotInfo -> IdInfo -setOneShotInfo info lb = {-lb `seq`-} info { oneShotInfo = lb } +setOneShotInfo info lb = {-lb `seq`-} info { oneShotInfo = lb } setDemandInfo :: IdInfo -> Demand -> IdInfo setDemandInfo info dd = dd `seq` info { demandInfo = dd } @@ -326,7 +338,8 @@ vanillaIdInfo strictnessInfo = nopSig, cprInfo = topCprSig, callArityInfo = unknownArity, - levityInfo = NoLevityInfo + levityInfo = NoLevityInfo, + lfInfo = Nothing } -- | More informative 'IdInfo' we can use when we know the 'Id' has no CAF references ===================================== compiler/ghc.cabal.in ===================================== @@ -298,6 +298,7 @@ Library GHC.StgToCmm.Ticky GHC.StgToCmm.Utils GHC.StgToCmm.ExtCode + GHC.StgToCmm.Types GHC.Runtime.Heap.Layout GHC.Core.Arity GHC.Core.FVs ===================================== compiler/main/UpdateCafInfos.hs ===================================== @@ -17,6 +17,7 @@ import NameSet import Util import Var import Outputable +import GHC.StgToCmm.Types (ModuleLFInfos) #include "HsVersions.h" @@ -24,14 +25,15 @@ import Outputable updateModDetailsCafInfos :: DynFlags -> NameSet -- ^ Non-CAFFY names in the module. Names not in this set are CAFFY. + -> ModuleLFInfos -> ModDetails -- ^ ModDetails to update -> ModDetails -updateModDetailsCafInfos dflags _ mod_details +updateModDetailsCafInfos dflags _ _ mod_details | gopt Opt_OmitInterfacePragmas dflags = mod_details -updateModDetailsCafInfos _ non_cafs mod_details = +updateModDetailsCafInfos _ non_cafs lf_infos mod_details = {- pprTrace "updateModDetailsCafInfos" (text "non_cafs:" <+> ppr non_cafs) $ -} let ModDetails{ md_types = type_env -- for unfoldings @@ -40,10 +42,10 @@ updateModDetailsCafInfos _ non_cafs mod_details = } = mod_details -- type TypeEnv = NameEnv TyThing - ~type_env' = mapNameEnv (updateTyThingCafInfos type_env' non_cafs) type_env + ~type_env' = mapNameEnv (updateTyThingCafInfos type_env' non_cafs lf_infos) type_env -- Not strict! - !insts' = strictMap (updateInstCafInfos type_env' non_cafs) insts + !insts' = strictMap (updateInstCafInfos type_env' non_cafs lf_infos) insts !rules' = strictMap (updateRuleCafInfos type_env') rules in mod_details{ md_types = type_env' @@ -63,20 +65,20 @@ updateRuleCafInfos type_env Rule{ .. } = Rule { ru_rhs = updateGlobalIds type_en -- Instances -------------------------------------------------------------------------------- -updateInstCafInfos :: TypeEnv -> NameSet -> ClsInst -> ClsInst -updateInstCafInfos type_env non_cafs = - updateClsInstDFun (updateIdUnfolding type_env . updateIdCafInfo non_cafs) +updateInstCafInfos :: TypeEnv -> NameSet -> ModuleLFInfos -> ClsInst -> ClsInst +updateInstCafInfos type_env non_cafs lf_infos = + updateClsInstDFun (updateIdUnfolding type_env . updateIdCafInfo non_cafs lf_infos) -------------------------------------------------------------------------------- -- TyThings -------------------------------------------------------------------------------- -updateTyThingCafInfos :: TypeEnv -> NameSet -> TyThing -> TyThing +updateTyThingCafInfos :: TypeEnv -> NameSet -> ModuleLFInfos -> TyThing -> TyThing -updateTyThingCafInfos type_env non_cafs (AnId id) = - AnId (updateIdUnfolding type_env (updateIdCafInfo non_cafs id)) +updateTyThingCafInfos type_env non_cafs lf_infos (AnId id) = + AnId (updateIdUnfolding type_env (updateIdCafInfo non_cafs lf_infos id)) -updateTyThingCafInfos _ _ other = other -- AConLike, ATyCon, ACoAxiom +updateTyThingCafInfos _ _ _ other = other -- AConLike, ATyCon, ACoAxiom -------------------------------------------------------------------------------- -- Unfoldings @@ -95,13 +97,18 @@ updateIdUnfolding type_env id = -- Expressions -------------------------------------------------------------------------------- -updateIdCafInfo :: NameSet -> Id -> Id -updateIdCafInfo non_cafs id - | idName id `elemNameSet` non_cafs - = -- pprTrace "updateIdCafInfo" (text "Marking" <+> ppr id <+> parens (ppr (idName id)) <+> text "as non-CAFFY") $ - id `setIdCafInfo` NoCafRefs - | otherwise - = id +updateIdCafInfo :: NameSet -> ModuleLFInfos -> Id -> Id +updateIdCafInfo non_cafs lf_infos id = + let + not_caffy = elemNameSet (idName id) non_cafs + mb_lf_info = lookupNameEnv lf_infos (idName id) + + id1 = if not_caffy then setIdCafInfo id NoCafRefs else id + id2 = case mb_lf_info of + Nothing -> id1 + Just lf_info -> setIdLFInfo id1 lf_info + in + id2 -------------------------------------------------------------------------------- ===================================== testsuite/tests/codeGen/should_compile/Makefile ===================================== @@ -64,10 +64,10 @@ T17648: # NoCafRefs) to the interface files. '$(TEST_HC)' $(TEST_HC_OPTS) -dno-typeable-binds -O T17648.hs -v0 '$(TEST_HC)' --show-iface T17648.hi | tr -d '\n' | \ - grep -F 'f :: T GHC.Types.Int -> () [HasNoCafRefs, Arity' >/dev/null + grep -F 'f :: T GHC.Types.Int -> () [HasNoCafRefs, LambdaFormInfo' >/dev/null # Second compilation with -fcatch-bottoms, f should be CAFFY '$(TEST_HC)' $(TEST_HC_OPTS) -dno-typeable-binds -O \ -fcatch-bottoms T17648.hs -v0 -fforce-recomp '$(TEST_HC)' --show-iface T17648.hi | tr -d '\n' | \ - grep -F 'f :: T GHC.Types.Int -> () [Arity: 1, Strictness' >/dev/null + grep -F 'f :: T GHC.Types.Int -> () [LambdaFormInfo' >/dev/null ===================================== testsuite/tests/codeGen/should_compile/cg009/A.hs ===================================== @@ -0,0 +1,5 @@ +module A where + +newtype A = A Int + +val = A 42 ===================================== testsuite/tests/codeGen/should_compile/cg009/Main.hs ===================================== @@ -0,0 +1,7 @@ +module Main where + +import A + +main = return () + +a = val ===================================== testsuite/tests/codeGen/should_compile/cg009/Makefile ===================================== @@ -0,0 +1,9 @@ +TOP=../../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +# Make sure the LFInfo for an exported, but not directly used newtype +# constructors does not trip up the compiler. +cg009: + '$(TEST_HC)' $(TEST_HC_OPTS) -c -O A.hs -fforce-recomp + '$(TEST_HC)' $(TEST_HC_OPTS) -c -O0 Main.hs -fforce-recomp ===================================== testsuite/tests/codeGen/should_compile/cg009/all.T ===================================== @@ -0,0 +1 @@ +test('cg009', [extra_files(['A.hs','Main.hs'])], makefile_test, ['cg009']) ===================================== testsuite/tests/codeGen/should_compile/cg010/A.hs ===================================== @@ -0,0 +1,4 @@ +module A where + +{-# NOINLINE val #-} +val = Just 42 ===================================== testsuite/tests/codeGen/should_compile/cg010/Main.hs ===================================== @@ -0,0 +1,8 @@ +module Main where + +import A + +main = return () + +a = val + ===================================== testsuite/tests/codeGen/should_compile/cg010/Makefile ===================================== @@ -0,0 +1,9 @@ +TOP=../../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +# Make sure LFInfo causes the imported reference to val to get tagged. +cg010: + '$(TEST_HC)' $(TEST_HC_OPTS) -c -O A.hs -fforce-recomp + '$(TEST_HC)' $(TEST_HC_OPTS) -c -O Main.hs -fforce-recomp -ddump-cmm -ddump-to-file + grep "A.val_closure+2" Main.dump-cmm ===================================== testsuite/tests/codeGen/should_compile/cg010/all.T ===================================== @@ -0,0 +1 @@ +test('cg010', [extra_files(['A.hs','Main.hs'])], makefile_test, ['cg010']) ===================================== testsuite/tests/codeGen/should_compile/cg010/cg010.stdout ===================================== @@ -0,0 +1 @@ + const A.val_closure+2; ===================================== testsuite/tests/simplCore/should_compile/Makefile ===================================== @@ -102,7 +102,7 @@ T4201: '$(TEST_HC)' $(TEST_HC_OPTS) -c -O T4201.hs '$(TEST_HC)' $(TEST_HC_OPTS) --show-iface T4201.hi > T4201.list # poor man idea about how to replace GNU grep -B2 "Sym" invocation with pure POSIX tools - for i in `grep -n "Sym" T4201.list |cut -d ':' -f -1`; do head -$$i T4201.list | tail -3 ; done + for i in `grep -n "Sym" T4201.list | cut -d ':' -f -1`; do head -$$i T4201.list | tail -5; done $(RM) -f T4201.list # This one looped as a result of bogus specialisation ===================================== testsuite/tests/simplCore/should_compile/T4201.stdout ===================================== @@ -1,3 +1,5 @@ - [HasNoCafRefs, Arity: 1, Strictness: , CPR: m1, + [HasNoCafRefs, + LambdaFormInfo: LFReEntrant (NoOneShotInfo, 1, True), Arity: 1, + Strictness: , CPR: m1, Unfolding: InlineRule (0, True, True) bof `cast` (Sym (N:Foo[0]) ->_R _R)] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bad23a7855210cbee36287a559ef72cd71ecb713 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bad23a7855210cbee36287a559ef72cd71ecb713 You're receiving 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 Mar 25 06:57:53 2020 From: gitlab at gitlab.haskell.org (=?UTF-8?B?w5ZtZXIgU2luYW4gQcSfYWNhbg==?=) Date: Wed, 25 Mar 2020 02:57:53 -0400 Subject: [Git][ghc/ghc][wip/osa1/lfinfo] Cross-module LambdaFormInfo passing Message-ID: <5e7b00f171d90_61675cefcac45954b@gitlab.haskell.org.mail> Ömer Sinan Ağacan pushed to branch wip/osa1/lfinfo at Glasgow Haskell Compiler / GHC Commits: bb431788 by Ömer Sinan Ağacan at 2020-03-25T09:57:40+03:00 Cross-module LambdaFormInfo passing - Store LambdaFormInfos of exported Ids in interface files - Use them in importing modules - - - - - 29 changed files: - compiler/GHC/CoreToIface.hs - compiler/GHC/Driver/Hooks.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Runtime/Heap/Layout.hs - compiler/GHC/StgToCmm.hs - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/StgToCmm/Env.hs - + compiler/GHC/StgToCmm/Types.hs - compiler/basicTypes/Id.hs - compiler/basicTypes/IdInfo.hs - compiler/ghc.cabal.in - compiler/main/UpdateCafInfos.hs - testsuite/tests/codeGen/should_compile/Makefile - + testsuite/tests/codeGen/should_compile/cg009/A.hs - + testsuite/tests/codeGen/should_compile/cg009/Main.hs - + testsuite/tests/codeGen/should_compile/cg009/Makefile - + testsuite/tests/codeGen/should_compile/cg009/all.T - + testsuite/tests/codeGen/should_compile/cg010/A.hs - + testsuite/tests/codeGen/should_compile/cg010/Main.hs - + testsuite/tests/codeGen/should_compile/cg010/Makefile - + testsuite/tests/codeGen/should_compile/cg010/all.T - + testsuite/tests/codeGen/should_compile/cg010/cg010.stdout - testsuite/tests/simplCore/should_compile/Makefile - testsuite/tests/simplCore/should_compile/T4201.stdout Changes: ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -34,13 +34,14 @@ module GHC.CoreToIface , toIfaceIdDetails , toIfaceIdInfo , toIfUnfolding - , toIfaceOneShot , toIfaceTickish , toIfaceBind , toIfaceAlt , toIfaceCon , toIfaceApp , toIfaceVar + -- * Other stuff + , toIfaceLFInfo ) where #include "HsVersions.h" @@ -49,6 +50,7 @@ import GhcPrelude import GHC.Iface.Syntax import GHC.Core.DataCon +import GHC.StgToCmm.Types import Id import IdInfo import GHC.Core @@ -74,6 +76,8 @@ import Demand ( isTopSig ) import Cpr ( topCprSig ) import Data.Maybe ( catMaybes ) +import Data.Word +import Data.Bits {- Note [Avoiding space leaks in toIface*] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -616,6 +620,43 @@ toIfaceVar v where name = idName v +--------------------- +toIfaceLFInfo :: LambdaFormInfo -> IfaceLFInfo +toIfaceLFInfo lfi = case lfi of + LFReEntrant _ _ arity _ _ -> + IfLFReEntrant arity + LFThunk _ _ updatable sfi mb_fun -> + IfLFThunk updatable (toIfaceStandardFormInfo sfi) mb_fun + LFCon dc -> + IfLFCon (dataConName dc) + LFUnknown mb_fun -> + IfLFUnknown mb_fun + LFUnlifted -> + IfLFUnlifted + LFLetNoEscape -> + panic "toIfaceLFInfo: LFLetNoEscape" + +toIfaceStandardFormInfo :: StandardFormInfo -> IfaceStandardFormInfo +toIfaceStandardFormInfo NonStandardThunk = IfStandardFormInfo 1 +toIfaceStandardFormInfo sf = + IfStandardFormInfo $! + tag sf .|. encodeField (field sf) + where + tag SelectorThunk{} = 0 + tag ApThunk{} = setBit 0 1 + tag NonStandardThunk = panic "toIfaceStandardFormInfo: StandardFo" + + field (SelectorThunk n) = n + field (ApThunk n) = n + field NonStandardThunk = panic "toIfaceStandardFormInfo: StandardFo" + + encodeField n = + let wn = fromIntegral n :: Word + shifted = wn `unsafeShiftL` 2 + in ASSERT(shifted > 0 && shifted < fromIntegral (maxBound :: Word16)) + (fromIntegral shifted :: Word16) + + {- Note [Inlining and hs-boot files] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider this example (#10083, #12789): ===================================== compiler/GHC/Driver/Hooks.hs ===================================== @@ -55,6 +55,7 @@ import GHC.Stg.Syntax import Stream import GHC.Cmm import GHC.Hs.Extension +import GHC.StgToCmm.Types (ModuleLFInfos) import Data.Maybe @@ -109,7 +110,7 @@ data Hooks = Hooks -> IO (Maybe HValue)) , createIservProcessHook :: Maybe (CreateProcess -> IO ProcessHandle) , stgToCmmHook :: Maybe (DynFlags -> Module -> [TyCon] -> CollectedCCs - -> [CgStgTopBinding] -> HpcInfo -> Stream IO CmmGroup ()) + -> [CgStgTopBinding] -> HpcInfo -> Stream IO CmmGroup ModuleLFInfos) , cmmToRawCmmHook :: forall a . Maybe (DynFlags -> Maybe Module -> Stream IO CmmGroupSRTs a -> IO (Stream IO RawCmmGroup a)) } ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -162,6 +162,7 @@ import Bag import Exception import qualified Stream import Stream (Stream) +import GHC.StgToCmm.Types (ModuleLFInfos) import Util @@ -176,6 +177,7 @@ import qualified Data.Set as S import Data.Set (Set) import Data.Functor import Control.DeepSeq (force) +import Data.Bifunctor (first) import GHC.Iface.Ext.Ast ( mkHieFile ) import GHC.Iface.Ext.Types ( getAsts, hie_asts, hie_module ) @@ -1392,7 +1394,7 @@ hscWriteIface dflags iface no_change mod_location = do -- | Compile to hard-code. hscGenHardCode :: HscEnv -> CgGuts -> ModLocation -> FilePath - -> IO (FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)], NameSet) + -> IO (FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)], NameSet, ModuleLFInfos) -- ^ @Just f@ <=> _stub.c is f hscGenHardCode hsc_env cgguts location output_filename = do let CgGuts{ -- This is the last use of the ModGuts in a compilation. @@ -1451,11 +1453,11 @@ hscGenHardCode hsc_env cgguts location output_filename = do return a rawcmms1 = Stream.mapM dump rawcmms0 - (output_filename, (_stub_h_exists, stub_c_exists), foreign_fps, caf_infos) + (output_filename, (_stub_h_exists, stub_c_exists), foreign_fps, (caf_infos, lf_infos)) <- {-# SCC "codeOutput" #-} codeOutput dflags this_mod output_filename location foreign_stubs foreign_files dependencies rawcmms1 - return (output_filename, stub_c_exists, foreign_fps, caf_infos) + return (output_filename, stub_c_exists, foreign_fps, caf_infos, lf_infos) hscInteractive :: HscEnv @@ -1549,7 +1551,7 @@ doCodeGen :: HscEnv -> Module -> [TyCon] -> CollectedCCs -> [StgTopBinding] -> HpcInfo - -> IO (Stream IO CmmGroupSRTs NameSet) + -> IO (Stream IO CmmGroupSRTs (NameSet, ModuleLFInfos)) -- Note we produce a 'Stream' of CmmGroups, so that the -- backend can be run incrementally. Otherwise it generates all -- the C-- up front, which has a significant space cost. @@ -1561,7 +1563,7 @@ doCodeGen hsc_env this_mod data_tycons dumpIfSet_dyn dflags Opt_D_dump_stg_final "Final STG:" FormatSTG (pprGenStgTopBindings stg_binds_w_fvs) - let cmm_stream :: Stream IO CmmGroup () + let cmm_stream :: Stream IO CmmGroup ModuleLFInfos -- See Note [Forcing of stg_binds] cmm_stream = stg_binds_w_fvs `seqList` {-# SCC "StgToCmm" #-} lookupHook stgToCmmHook StgToCmm.codeGen dflags dflags this_mod data_tycons @@ -1580,10 +1582,11 @@ doCodeGen hsc_env this_mod data_tycons ppr_stream1 = Stream.mapM dump1 cmm_stream + pipeline_stream :: Stream IO CmmGroupSRTs (NameSet, ModuleLFInfos) pipeline_stream = {-# SCC "cmmPipeline" #-} - Stream.mapAccumL (cmmPipeline hsc_env) (emptySRT this_mod) ppr_stream1 - <&> (srtMapNonCAFs . moduleSRTMap) + Stream.mapAccumL_ (cmmPipeline hsc_env) (emptySRT this_mod) ppr_stream1 + <&> (first (srtMapNonCAFs . moduleSRTMap)) dump2 a = do unless (null a) $ ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -1192,12 +1192,12 @@ runPhase (HscOut src_flavour mod_name result) _ dflags = do PipeState{hsc_env=hsc_env'} <- getPipeState - (outputFilename, mStub, foreign_files, caf_infos) <- liftIO $ + (outputFilename, mStub, foreign_files, caf_infos, lf_infos) <- liftIO $ hscGenHardCode hsc_env' cgguts mod_location output_fn - final_iface <- liftIO (mkFullIface hsc_env'{hsc_dflags=iface_dflags} partial_iface (Just caf_infos)) + final_iface <- liftIO (mkFullIface hsc_env'{hsc_dflags=iface_dflags} partial_iface (Just (caf_infos, lf_infos))) let final_mod_details = {-# SCC updateModDetailsCafInfos #-} - updateModDetailsCafInfos iface_dflags caf_infos mod_details + updateModDetailsCafInfos iface_dflags caf_infos lf_infos mod_details setIface final_iface final_mod_details -- See Note [Writing interface files] ===================================== compiler/GHC/Iface/Make.hs ===================================== @@ -38,6 +38,7 @@ import GHC.Core.Coercion.Axiom import GHC.Core.ConLike import GHC.Core.DataCon import GHC.Core.Type +import GHC.StgToCmm.Types (ModuleLFInfos) import TcType import GHC.Core.InstEnv import GHC.Core.FamInstEnv @@ -100,13 +101,13 @@ mkPartialIface hsc_env mod_details -- | Fully instantiate a interface -- Adds fingerprints and potentially code generator produced information. -mkFullIface :: HscEnv -> PartialModIface -> Maybe NameSet -> IO ModIface -mkFullIface hsc_env partial_iface mb_non_cafs = do +mkFullIface :: HscEnv -> PartialModIface -> Maybe (NameSet, ModuleLFInfos) -> IO ModIface +mkFullIface hsc_env partial_iface mb_id_infos = do let decls | gopt Opt_OmitInterfacePragmas (hsc_dflags hsc_env) = mi_decls partial_iface | otherwise - = updateDeclCafInfos (mi_decls partial_iface) mb_non_cafs + = updateDecl (mi_decls partial_iface) mb_id_infos full_iface <- {-# SCC "addFingerprints" #-} @@ -117,15 +118,23 @@ mkFullIface hsc_env partial_iface mb_non_cafs = do return full_iface -updateDeclCafInfos :: [IfaceDecl] -> Maybe NameSet -> [IfaceDecl] -updateDeclCafInfos decls Nothing = decls -updateDeclCafInfos decls (Just non_cafs) = map update_decl decls +updateDecl :: [IfaceDecl] -> Maybe (NameSet, ModuleLFInfos) -> [IfaceDecl] +updateDecl decls Nothing = decls +updateDecl decls (Just (non_cafs, lf_infos)) = map update_decl decls where + update_decl (IfaceId nm ty details infos) + | let not_caffy = elemNameSet nm non_cafs + , let mb_lf_info = lookupNameEnv lf_infos nm + , WARN( isNothing mb_lf_info, text "Name without LFInfo:" <+> ppr nm ) True + -- Only allocate a new IfaceId if we're going to update the infos + , isJust mb_lf_info || not_caffy + = IfaceId nm ty details $ + (if not_caffy then (HsNoCafRefs :) else id) + (case mb_lf_info of + Nothing -> infos + Just lf_info -> HsLFInfo (toIfaceLFInfo lf_info) : infos) + update_decl decl - | IfaceId nm ty details infos <- decl - , elemNameSet nm non_cafs - = IfaceId nm ty details (HsNoCafRefs : infos) - | otherwise = decl -- | Make an interface from the results of typechecking only. Useful ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -22,6 +22,8 @@ module GHC.Iface.Syntax ( IfaceAxBranch(..), IfaceTyConParent(..), IfaceCompleteMatch(..), + IfaceLFInfo(..), + IfaceStandardFormInfo(..), -- * Binding names IfaceTopBndr, @@ -30,6 +32,7 @@ module GHC.Iface.Syntax ( -- Misc ifaceDeclImplicitBndrs, visibleIfConDecls, ifaceDeclFingerprints, + tcStandardFormInfo, -- Free Names freeNamesIfDecl, freeNamesIfRule, freeNamesIfFamInst, @@ -72,10 +75,13 @@ import GHC.Core.DataCon (SrcStrictness(..), SrcUnpackedness(..)) import Lexeme (isLexSym) import TysWiredIn ( constraintKindTyConName ) import Util (seqList) +import GHC.StgToCmm.Types import Control.Monad import System.IO.Unsafe import Control.DeepSeq +import Data.Word +import Data.Bits infixl 3 &&& @@ -114,7 +120,8 @@ data IfaceDecl = IfaceId { ifName :: IfaceTopBndr, ifType :: IfaceType, ifIdDetails :: IfaceIdDetails, - ifIdInfo :: IfaceIdInfo } + ifIdInfo :: IfaceIdInfo + } | IfaceData { ifName :: IfaceTopBndr, -- Type constructor ifBinders :: [IfaceTyConBinder], @@ -348,6 +355,7 @@ data IfaceInfoItem IfaceUnfolding -- See Note [Expose recursive functions] | HsNoCafRefs | HsLevity -- Present <=> never levity polymorphic + | HsLFInfo IfaceLFInfo -- NB: Specialisations and rules come in separately and are -- only later attached to the Id. Partial reason: some are orphans. @@ -379,6 +387,74 @@ data IfaceIdDetails | IfRecSelId (Either IfaceTyCon IfaceDecl) Bool | IfDFunId +-- | Iface type for LambdaFormInfo. Fields not relevant for imported Ids are +-- omitted in this type. +data IfaceLFInfo + = IfLFReEntrant !RepArity + | IfLFThunk !Bool !IfaceStandardFormInfo !Bool + | IfLFCon !Name + | IfLFUnknown !Bool + | IfLFUnlifted + +tcStandardFormInfo :: IfaceStandardFormInfo -> StandardFormInfo +tcStandardFormInfo (IfStandardFormInfo w) + | testBit w 0 = NonStandardThunk + | otherwise = con field + where + field = fromIntegral (w `unsafeShiftR` 2) + con + | testBit w 1 = ApThunk + | otherwise = SelectorThunk + +instance Outputable IfaceLFInfo where + ppr (IfLFReEntrant arity) = + text "LFReEntrant" <+> ppr arity + + ppr (IfLFThunk updatable sfi mb_fun) = + text "LFThunk" <+> ppr (updatable, tcStandardFormInfo sfi, mb_fun) + + ppr (IfLFCon con) = + text "LFCon" <> brackets (ppr con) + + ppr IfLFUnlifted = + text "LFUnlifted" + + ppr (IfLFUnknown fun_flag) = + text "LFUnknown" <+> ppr fun_flag + +newtype IfaceStandardFormInfo = IfStandardFormInfo Word16 + +instance Binary IfaceStandardFormInfo where + put_ bh (IfStandardFormInfo w) = put_ bh (w :: Word16) + get bh = IfStandardFormInfo <$> (get bh :: IO Word16) + +instance Binary IfaceLFInfo where + put_ bh (IfLFReEntrant arity) = do + putByte bh 0 + put_ bh arity + put_ bh (IfLFThunk updatable sfi mb_fun) = do + putByte bh 1 + put_ bh updatable + put_ bh sfi + put_ bh mb_fun + put_ bh (IfLFCon con_name) = do + putByte bh 2 + put_ bh con_name + put_ bh (IfLFUnknown fun_flag) = do + putByte bh 3 + put_ bh fun_flag + put_ bh IfLFUnlifted = + putByte bh 4 + get bh = do + tag <- getByte bh + case tag of + 0 -> IfLFReEntrant <$> get bh + 1 -> IfLFThunk <$> get bh <*> get bh <*> get bh + 2 -> IfLFCon <$> get bh + 3 -> IfLFUnknown <$> get bh + 4 -> pure IfLFUnlifted + _ -> panic "Invalid byte" + {- Note [Versioning of instances] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1393,6 +1469,7 @@ instance Outputable IfaceInfoItem where ppr (HsCpr cpr) = text "CPR:" <+> ppr cpr ppr HsNoCafRefs = text "HasNoCafRefs" ppr HsLevity = text "Never levity-polymorphic" + ppr (HsLFInfo lf_info) = text "LambdaFormInfo:" <+> ppr lf_info instance Outputable IfaceJoinInfo where ppr IfaceNotJoinPoint = empty @@ -1853,7 +1930,7 @@ instance Binary IfaceDecl where get bh = do h <- getByte bh case h of - 0 -> do name <- get bh + 0 -> do name <- get bh ~(ty, details, idinfo) <- lazyGet bh -- See Note [Lazy deserialization of IfaceId] return (IfaceId name ty details idinfo) @@ -2153,6 +2230,8 @@ instance Binary IfaceInfoItem where put_ bh HsNoCafRefs = putByte bh 4 put_ bh HsLevity = putByte bh 5 put_ bh (HsCpr cpr) = putByte bh 6 >> put_ bh cpr + put_ bh (HsLFInfo lf_info) = putByte bh 7 >> put_ bh lf_info + get bh = do h <- getByte bh case h of @@ -2164,7 +2243,8 @@ instance Binary IfaceInfoItem where 3 -> liftM HsInline $ get bh 4 -> return HsNoCafRefs 5 -> return HsLevity - _ -> HsCpr <$> get bh + 6 -> HsCpr <$> get bh + _ -> HsLFInfo <$> get bh instance Binary IfaceUnfolding where put_ bh (IfCoreUnfold s e) = do @@ -2495,6 +2575,7 @@ instance NFData IfaceInfoItem where HsNoCafRefs -> () HsLevity -> () HsCpr cpr -> cpr `seq` () + HsLFInfo lf_info -> lf_info `seq` () -- TODO: seq further? instance NFData IfaceUnfolding where rnf = \case ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -122,6 +122,9 @@ data IfaceOneShot -- See Note [Preserve OneShotInfo] in CoreTicy = IfaceNoOneShot -- and Note [The oneShot function] in MkId | IfaceOneShot +instance Outputable IfaceOneShot where + ppr IfaceNoOneShot = text "NoOneShotInfo" + ppr IfaceOneShot = text "OneShot" {- %************************************************************************ ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -19,7 +19,8 @@ module GHC.IfaceToCore ( tcIfaceDecl, tcIfaceInst, tcIfaceFamInst, tcIfaceRules, tcIfaceAnnotations, tcIfaceCompleteSigs, tcIfaceExpr, -- Desired by HERMIT (#7683) - tcIfaceGlobal + tcIfaceGlobal, + tcIfaceOneShot ) where #include "HsVersions.h" @@ -30,6 +31,9 @@ import TcTypeNats(typeNatCoAxiomRules) import GHC.Iface.Syntax import GHC.Iface.Load import GHC.Iface.Env +import GHC.StgToCmm.Types +import GHC.StgToCmm.Closure +import GHC.Types.RepType import BuildTyCl import TcRnMonad import TcType @@ -641,7 +645,7 @@ tc_iface_decl _ ignore_prags (IfaceId {ifName = name, ifType = iface_type, = do { ty <- tcIfaceType iface_type ; details <- tcIdDetails ty details ; info <- tcIdInfo ignore_prags TopLevel name ty info - ; return (AnId (mkGlobalId details name ty info)) } + ; return (AnId (addIdLFInfo (mkGlobalId details name ty info))) } tc_iface_decl _ _ (IfaceData {ifName = tc_name, ifCType = cType, @@ -1340,7 +1344,8 @@ tcIfaceExpr (IfaceLet (IfaceNonRec (IfLetBndr fs ty info ji) rhs) body) ; ty' <- tcIfaceType ty ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -} NotTopLevel name ty' info - ; let id = mkLocalIdWithInfo name ty' id_info + ; let id = addIdLFInfo $ + mkLocalIdWithInfo name ty' id_info `asJoinId_maybe` tcJoinInfo ji ; rhs' <- tcIfaceExpr rhs ; body' <- extendIfaceIdEnv [id] (tcIfaceExpr body) @@ -1361,7 +1366,7 @@ tcIfaceExpr (IfaceLet (IfaceRec pairs) body) = do { rhs' <- tcIfaceExpr rhs ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -} NotTopLevel (idName id) (idType id) info - ; return (setIdInfo id id_info, rhs') } + ; return (addIdLFInfo (setIdInfo id id_info), rhs') } tcIfaceExpr (IfaceTick tickish expr) = do expr' <- tcIfaceExpr expr @@ -1465,8 +1470,7 @@ tcIdInfo ignore_prags toplvl name ty info = do let init_info | if_boot lcl_env = vanillaIdInfo `setUnfoldingInfo` BootUnfolding | otherwise = vanillaIdInfo - let needed = needed_prags info - foldlM tcPrag init_info needed + foldlM tcPrag init_info (needed_prags info) where needed_prags :: [IfaceInfoItem] -> [IfaceInfoItem] needed_prags items @@ -1486,6 +1490,9 @@ tcIdInfo ignore_prags toplvl name ty info = do tcPrag info (HsCpr cpr) = return (info `setCprInfo` cpr) tcPrag info (HsInline prag) = return (info `setInlinePragInfo` prag) tcPrag info HsLevity = return (info `setNeverLevPoly` ty) + tcPrag info (HsLFInfo lf_info) = do + lf_info <- tcLFInfo lf_info + return (info `setLFInfo` lf_info) -- The next two are lazy, so they don't transitively suck stuff in tcPrag info (HsUnfold lb if_unf) @@ -1494,10 +1501,55 @@ tcIdInfo ignore_prags toplvl name ty info = do | otherwise = info ; return (info1 `setUnfoldingInfo` unf) } +addIdLFInfo :: Id -> Id +addIdLFInfo id = case idLFInfo_maybe id of + Nothing -> setIdLFInfo id (mkLFImported (idDetails id) (idInfo id) (idType id)) + Just _ -> id + +-- Make a LambdaFormInfo for the Ids without a LFInfo in the iface file +mkLFImported :: IdDetails -> IdInfo -> Type -> LambdaFormInfo +mkLFImported details info ty + | DataConWorkId con <- details + , isNullaryRepDataCon con + = LFCon con -- An imported nullary constructor + -- We assume that the constructor is evaluated so that + -- the id really does point directly to the constructor + + | arity > 0 + = LFReEntrant TopLevel noOneShotInfo arity True ArgUnknown + + | isUnliftedType ty + = LFUnlifted + + | mightBeAFunction ty + = LFUnknown True + + | otherwise + = LFUnknown False + where + arity = countFunRepArgs (arityInfo info) ty + tcJoinInfo :: IfaceJoinInfo -> Maybe JoinArity tcJoinInfo (IfaceJoinPoint ar) = Just ar tcJoinInfo IfaceNotJoinPoint = Nothing +tcLFInfo :: IfaceLFInfo -> IfL LambdaFormInfo +tcLFInfo lfi = case lfi of + IfLFReEntrant rep_arity -> + return (LFReEntrant TopLevel NoOneShotInfo rep_arity True ArgUnknown) + + IfLFThunk updatable sfi mb_fun -> + return (LFThunk TopLevel True updatable (tcStandardFormInfo sfi) mb_fun) + + IfLFUnlifted -> + return LFUnlifted + + IfLFCon con_name -> + LFCon <$!> tcIfaceDataCon con_name + + IfLFUnknown fun_flag -> + return (LFUnknown fun_flag) + tcUnfolding :: TopLevelFlag -> Name -> Type -> IdInfo -> IfaceUnfolding -> IfL Unfolding tcUnfolding toplvl name _ info (IfCoreUnfold stable if_expr) = do { dflags <- getDynFlags @@ -1586,6 +1638,10 @@ tcPragExpr is_compulsory toplvl name expr -- It's OK to use nonDetEltsUFM here because we immediately forget -- the ordering by creating a set +tcIfaceOneShot :: IfaceOneShot -> OneShotInfo +tcIfaceOneShot IfaceNoOneShot = NoOneShotInfo +tcIfaceOneShot IfaceOneShot = OneShotLam + {- ************************************************************************ * * ===================================== compiler/GHC/Runtime/Heap/Layout.hs ===================================== @@ -51,6 +51,7 @@ import GHC.Driver.Session import Outputable import GHC.Platform import FastString +import GHC.StgToCmm.Types import Data.Word import Data.Bits @@ -64,9 +65,6 @@ import Data.ByteString (ByteString) ************************************************************************ -} --- | Word offset, or word count -type WordOff = Int - -- | Byte offset, or byte count type ByteOff = Int @@ -196,29 +194,6 @@ type ConstrDescription = ByteString -- result of dataConIdentity type FunArity = Int type SelectorOffset = Int -------------------------- --- We represent liveness bitmaps as a Bitmap (whose internal --- representation really is a bitmap). These are pinned onto case return --- vectors to indicate the state of the stack for the garbage collector. --- --- In the compiled program, liveness bitmaps that fit inside a single --- word (StgWord) are stored as a single word, while larger bitmaps are --- stored as a pointer to an array of words. - -type Liveness = [Bool] -- One Bool per word; True <=> non-ptr or dead - -- False <=> ptr - -------------------------- --- An ArgDescr describes the argument pattern of a function - -data ArgDescr - = ArgSpec -- Fits one of the standard patterns - !Int -- RTS type identifier ARG_P, ARG_N, ... - - | ArgGen -- General case - Liveness -- Details about the arguments - - ----------------------------------------------------------------------------- -- Construction @@ -545,10 +520,6 @@ instance Outputable SMRep where ppr (RTSRep ty rep) = text "tag:" <> ppr ty <+> ppr rep -instance Outputable ArgDescr where - ppr (ArgSpec n) = text "ArgSpec" <+> ppr n - ppr (ArgGen ls) = text "ArgGen" <+> ppr ls - pprTypeInfo :: ClosureTypeInfo -> SDoc pprTypeInfo (Constr tag descr) = text "Con" <+> ===================================== compiler/GHC/StgToCmm.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} +{-# LANGUAGE BangPatterns #-} ----------------------------------------------------------------------------- -- @@ -25,6 +26,7 @@ import GHC.StgToCmm.Utils import GHC.StgToCmm.Closure import GHC.StgToCmm.Hpc import GHC.StgToCmm.Ticky +import GHC.StgToCmm.Types (ModuleLFInfos) import GHC.Cmm import GHC.Cmm.CLabel @@ -45,6 +47,8 @@ import Outputable import Stream import BasicTypes import VarSet ( isEmptyDVarSet ) +import UniqFM +import NameEnv import OrdList import GHC.Cmm.Graph @@ -52,6 +56,7 @@ import GHC.Cmm.Graph import Data.IORef import Control.Monad (when,void) import Util +import Data.Maybe codeGen :: DynFlags -> Module @@ -59,7 +64,8 @@ codeGen :: DynFlags -> CollectedCCs -- (Local/global) cost-centres needing declaring/registering. -> [CgStgTopBinding] -- Bindings to convert -> HpcInfo - -> Stream IO CmmGroup () -- Output as a stream, so codegen can + -> Stream IO CmmGroup ModuleLFInfos + -- Output as a stream, so codegen can -- be interleaved with output codeGen dflags this_mod data_tycons @@ -101,6 +107,20 @@ codeGen dflags this_mod data_tycons mapM_ (cg . cgDataCon) (tyConDataCons tycon) ; mapM_ do_tycon data_tycons + + ; cg_id_infos <- cgs_binds <$> liftIO (readIORef cgref) + + -- Only external names are actually visible to codeGen. So they are the + -- only ones we care about. + ; let extractInfo info = lf `seq` Just (name,lf) + where + id = cg_id info + !name = idName id + lf = cg_lf info + + ; let !generatedInfo = mkNameEnv (mapMaybe extractInfo (eltsUFM cg_id_infos)) + + ; return $! generatedInfo } --------------------------------------------------------------- ===================================== compiler/GHC/StgToCmm/Closure.hs ===================================== @@ -24,7 +24,7 @@ module GHC.StgToCmm.Closure ( LambdaFormInfo, -- Abstract StandardFormInfo, -- ...ditto... mkLFThunk, mkLFReEntrant, mkConLFInfo, mkSelectorLFInfo, - mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape, + mkApLFInfo, mkLFArgument, mkLFLetNoEscape, mkLFStringLit, lfDynTag, isLFThunk, isLFReEntrant, lfUpdatable, @@ -51,6 +51,7 @@ module GHC.StgToCmm.Closure ( closureUpdReqd, closureSingleEntry, closureReEntrant, closureFunInfo, isToplevClosure, + mightBeAFunction, blackHoleOnEntry, -- Needs LambdaFormInfo and SMRep isStaticClosure, -- Needs SMPre @@ -70,6 +71,7 @@ import GHC.Stg.Syntax import GHC.Runtime.Heap.Layout import GHC.Cmm import GHC.Cmm.Ppr.Expr() -- For Outputable instances +import GHC.StgToCmm.Types import CostCentre import GHC.Cmm.BlockId @@ -188,86 +190,15 @@ addArgReps = map (\arg -> let arg' = fromNonVoid arg argPrimRep :: StgArg -> PrimRep argPrimRep arg = typePrimRep1 (stgArgType arg) - ------------------------------------------------------------------------------ --- LambdaFormInfo ------------------------------------------------------------------------------ - --- Information about an identifier, from the code generator's point of --- view. Every identifier is bound to a LambdaFormInfo in the --- environment, which gives the code generator enough info to be able to --- tail call or return that identifier. - -data LambdaFormInfo - = LFReEntrant -- Reentrant closure (a function) - TopLevelFlag -- True if top level - OneShotInfo - !RepArity -- Arity. Invariant: always > 0 - !Bool -- True <=> no fvs - ArgDescr -- Argument descriptor (should really be in ClosureInfo) - - | LFThunk -- Thunk (zero arity) - TopLevelFlag - !Bool -- True <=> no free vars - !Bool -- True <=> updatable (i.e., *not* single-entry) - StandardFormInfo - !Bool -- True <=> *might* be a function type - - | LFCon -- A saturated constructor application - DataCon -- The constructor - - | LFUnknown -- Used for function arguments and imported things. - -- We know nothing about this closure. - -- Treat like updatable "LFThunk"... - -- Imported things which we *do* know something about use - -- one of the other LF constructors (eg LFReEntrant for - -- known functions) - !Bool -- True <=> *might* be a function type - -- The False case is good when we want to enter it, - -- because then we know the entry code will do - -- For a function, the entry code is the fast entry point - - | LFUnlifted -- A value of unboxed type; - -- always a value, needs evaluation - - | LFLetNoEscape -- See LetNoEscape module for precise description - - -------------------------- --- StandardFormInfo tells whether this thunk has one of --- a small number of standard forms - -data StandardFormInfo - = NonStandardThunk - -- The usual case: not of the standard forms - - | SelectorThunk - -- A SelectorThunk is of form - -- case x of - -- con a1,..,an -> ak - -- and the constructor is from a single-constr type. - WordOff -- 0-origin offset of ak within the "goods" of - -- constructor (Recall that the a1,...,an may be laid - -- out in the heap in a non-obvious order.) - - | ApThunk - -- An ApThunk is of form - -- x1 ... xn - -- The code for the thunk just pushes x2..xn on the stack and enters x1. - -- There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled - -- in the RTS to save space. - RepArity -- Arity, n - - ------------------------------------------------------ -- Building LambdaFormInfo ------------------------------------------------------ mkLFArgument :: Id -> LambdaFormInfo mkLFArgument id - | isUnliftedType ty = LFUnlifted - | might_be_a_function ty = LFUnknown True - | otherwise = LFUnknown False + | isUnliftedType ty = LFUnlifted + | mightBeAFunction ty = LFUnknown True + | otherwise = LFUnknown False where ty = idType id @@ -295,13 +226,13 @@ mkLFThunk thunk_ty top fvs upd_flag LFThunk top (null fvs) (isUpdatable upd_flag) NonStandardThunk - (might_be_a_function thunk_ty) + (mightBeAFunction thunk_ty) -------------- -might_be_a_function :: Type -> Bool +mightBeAFunction :: Type -> Bool -- Return False only if we are *sure* it's a data type -- Look through newtypes etc as much as poss -might_be_a_function ty +mightBeAFunction ty | [LiftedRep] <- typePrimRep ty , Just tc <- tyConAppTyCon_maybe (unwrapType ty) , isDataTyCon tc @@ -317,30 +248,13 @@ mkConLFInfo con = LFCon con mkSelectorLFInfo :: Id -> Int -> Bool -> LambdaFormInfo mkSelectorLFInfo id offset updatable = LFThunk NotTopLevel False updatable (SelectorThunk offset) - (might_be_a_function (idType id)) + (mightBeAFunction (idType id)) ------------- mkApLFInfo :: Id -> UpdateFlag -> Arity -> LambdaFormInfo mkApLFInfo id upd_flag arity = LFThunk NotTopLevel (arity == 0) (isUpdatable upd_flag) (ApThunk arity) - (might_be_a_function (idType id)) - -------------- -mkLFImported :: Id -> LambdaFormInfo -mkLFImported id - | Just con <- isDataConWorkId_maybe id - , isNullaryRepDataCon con - = LFCon con -- An imported nullary constructor - -- We assume that the constructor is evaluated so that - -- the id really does point directly to the constructor - - | arity > 0 - = LFReEntrant TopLevel noOneShotInfo arity True (panic "arg_descr") - - | otherwise - = mkLFArgument id -- Not sure of exact arity - where - arity = idFunRepArity id + (mightBeAFunction (idType id)) ------------- mkLFStringLit :: LambdaFormInfo ===================================== compiler/GHC/StgToCmm/Env.hs ===================================== @@ -31,6 +31,7 @@ import GHC.Platform import GHC.StgToCmm.Monad import GHC.StgToCmm.Utils import GHC.StgToCmm.Closure +import GHC.StgToCmm.Types import GHC.Cmm.CLabel @@ -48,6 +49,8 @@ import TysPrim import UniqFM import Util import VarEnv +import GHC.Core.DataCon +import BasicTypes ------------------------------------- -- Manipulating CgIdInfo @@ -146,6 +149,26 @@ getCgIdInfo id cgLookupPanic id -- Bug }}} +mkLFImported :: Id -> LambdaFormInfo +mkLFImported id = + case idLFInfo_maybe id of + Just lf_info -> + lf_info + Nothing + | Just con <- isDataConWorkId_maybe id + , isNullaryRepDataCon con + -> LFCon con -- An imported nullary constructor + -- We assume that the constructor is evaluated so that + -- the id really does point directly to the constructor + + | arity > 0 + -> LFReEntrant TopLevel noOneShotInfo arity True ArgUnknown + + | otherwise + -> mkLFArgument id -- Not sure of exact arity + where + arity = idFunRepArity id + cgLookupPanic :: Id -> FCode a cgLookupPanic id = do local_binds <- getBinds ===================================== compiler/GHC/StgToCmm/Types.hs ===================================== @@ -0,0 +1,157 @@ +{-# LANGUAGE CPP #-} + +module GHC.StgToCmm.Types + ( WordOff + , LambdaFormInfo (..) + , ModuleLFInfos + , Liveness + , ArgDescr (..) + , StandardFormInfo (..) + ) where + +#include "HsVersions.h" + +import GhcPrelude + +import BasicTypes +import GHC.Core.DataCon +import NameEnv +import Outputable + +-- | Word offset, or word count +type WordOff = Int + +-------------------------------------------------------------------------------- +-- LambdaFormInfo +-------------------------------------------------------------------------------- + +-- | Maps names in the current module to their LambdaFormInfos +type ModuleLFInfos = NameEnv LambdaFormInfo + +-- Information about an identifier, from the code generator's point of view. +-- Every identifier is bound to a LambdaFormInfo in the environment, which gives +-- the code generator enough info to be able to tail call or return that +-- identifier. + +data LambdaFormInfo + = LFReEntrant -- Reentrant closure (a function) + !TopLevelFlag -- True if top level + !OneShotInfo + !RepArity -- Arity. Invariant: always > 0 + !Bool -- True <=> no fvs + !ArgDescr -- Argument descriptor (should really be in ClosureInfo) + + | LFThunk -- Thunk (zero arity) + !TopLevelFlag + !Bool -- True <=> no free vars + !Bool -- True <=> updatable (i.e., *not* single-entry) + !StandardFormInfo + !Bool -- True <=> *might* be a function type + + | LFCon -- A saturated constructor application + !DataCon -- The constructor + + | LFUnknown -- Used for function arguments and imported things. + -- We know nothing about this closure. + -- Treat like updatable "LFThunk"... + -- Imported things which we *do* know something about use + -- one of the other LF constructors (eg LFReEntrant for + -- known functions) + !Bool -- True <=> *might* be a function type + -- The False case is good when we want to enter it, + -- because then we know the entry code will do + -- For a function, the entry code is the fast entry point + + | LFUnlifted -- A value of unboxed type; + -- always a value, needs evaluation + + | LFLetNoEscape -- See LetNoEscape module for precise description + +instance Outputable LambdaFormInfo where + ppr (LFReEntrant top oneshot rep fvs argdesc) = + text "LFReEntrant" <> brackets (ppr top <+> ppr oneshot <+> + ppr rep <+> pprFvs fvs <+> ppr argdesc) + ppr (LFThunk top hasfv updateable sfi m_function) = + text "LFThunk" <> brackets (ppr top <+> pprFvs hasfv <+> pprUpdateable updateable <+> + ppr sfi <+> pprFuncFlag m_function) + ppr (LFCon con) = text "LFCon" <> brackets (ppr con) + ppr (LFUnknown m_func) = + text "LFUnknown" <> brackets (pprFuncFlag m_func) + ppr LFUnlifted = text "LFUnlifted" + ppr LFLetNoEscape = text "LFLetNoEscape" + +pprFvs :: Bool -> SDoc +pprFvs True = text "no-fvs" +pprFvs False = text "fvs" + +pprFuncFlag :: Bool -> SDoc +pprFuncFlag True = text "mFunc" +pprFuncFlag False = text "value" + +pprUpdateable :: Bool -> SDoc +pprUpdateable True = text "updateable" +pprUpdateable False = text "oneshot" + +-------------------------------------------------------------------------------- + +-- | We represent liveness bitmaps as a Bitmap (whose internal representation +-- really is a bitmap). These are pinned onto case return vectors to indicate +-- the state of the stack for the garbage collector. +-- +-- In the compiled program, liveness bitmaps that fit inside a single word +-- (StgWord) are stored as a single word, while larger bitmaps are stored as a +-- pointer to an array of words. + +type Liveness = [Bool] -- One Bool per word; True <=> non-ptr or dead + -- False <=> ptr + +-------------------------------------------------------------------------------- +-- | An ArgDescr describes the argument pattern of a function + +data ArgDescr + = ArgSpec -- Fits one of the standard patterns + !Int -- RTS type identifier ARG_P, ARG_N, ... + + | ArgGen -- General case + Liveness -- Details about the arguments + + | ArgUnknown -- For imported binds. + -- Invariant: Never Unknown for binds of the module + -- we are compiling. + deriving (Eq) + +instance Outputable ArgDescr where + ppr (ArgSpec n) = text "ArgSpec" <+> ppr n + ppr (ArgGen ls) = text "ArgGen" <+> ppr ls + ppr ArgUnknown = text "ArgUnknown" + +-------------------------------------------------------------------------------- +-- | StandardFormInfo tells whether this thunk has one of a small number of +-- standard forms + +data StandardFormInfo + = NonStandardThunk + -- The usual case: not of the standard forms + + | SelectorThunk + -- A SelectorThunk is of form + -- case x of + -- con a1,..,an -> ak + -- and the constructor is from a single-constr type. + WordOff -- 0-origin offset of ak within the "goods" of + -- constructor (Recall that the a1,...,an may be laid + -- out in the heap in a non-obvious order.) + + | ApThunk + -- An ApThunk is of form + -- x1 ... xn + -- The code for the thunk just pushes x2..xn on the stack and enters x1. + -- There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled + -- in the RTS to save space. + RepArity -- Arity, n + deriving (Eq) + +instance Outputable StandardFormInfo where + ppr NonStandardThunk = text "RegThunk" + ppr (SelectorThunk w) = text "SelThunk:" <> ppr w + ppr (ApThunk n) = text "ApThunk:" <> ppr n ===================================== compiler/basicTypes/Id.hs ===================================== @@ -92,7 +92,7 @@ module Id ( idCallArity, idFunRepArity, idUnfolding, realIdUnfolding, idSpecialisation, idCoreRules, idHasRules, - idCafInfo, + idCafInfo, idLFInfo, idLFInfo_maybe, idOneShotInfo, idStateHackOneShotInfo, idOccInfo, isNeverLevPolyId, @@ -105,6 +105,7 @@ module Id ( setIdSpecialisation, setIdCafInfo, setIdOccInfo, zapIdOccInfo, + setIdLFInfo, setIdDemandInfo, setIdStrictness, @@ -731,6 +732,19 @@ idCafInfo id = cafInfo (idInfo id) setIdCafInfo :: Id -> CafInfo -> Id setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id + --------------------------------- + -- Lambda form info +idLFInfo :: HasCallStack => Id -> LambdaFormInfo +idLFInfo id = case lfInfo (idInfo id) of + Nothing -> pprPanic "idLFInfo" (text "LFInfo not available for Id" <+> ppr id) + Just lf_info -> lf_info + +idLFInfo_maybe :: Id -> Maybe LambdaFormInfo +idLFInfo_maybe = lfInfo . idInfo + +setIdLFInfo :: Id -> LambdaFormInfo -> Id +setIdLFInfo id lf = modifyIdInfo (`setLFInfo` lf) id + --------------------------------- -- Occurrence INFO idOccInfo :: Id -> OccInfo ===================================== compiler/basicTypes/IdInfo.hs ===================================== @@ -74,6 +74,10 @@ module IdInfo ( ppCafInfo, mayHaveCafRefs, cafInfo, setCafInfo, + -- ** The LambdaFormInfo type + LambdaFormInfo(..), + lfInfo, setLFInfo, + -- ** Tick-box Info TickBoxOp(..), TickBoxId, @@ -104,6 +108,8 @@ import Demand import Cpr import Util +import GHC.StgToCmm.Types (LambdaFormInfo (..)) + -- infixl so you can say (id `set` a `set` b) infixl 1 `setRuleInfo`, `setArityInfo`, @@ -270,8 +276,9 @@ data IdInfo -- ^ 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 + levityInfo :: LevityInfo, -- ^ when applied, will this Id ever have a levity-polymorphic type? + lfInfo :: !(Maybe LambdaFormInfo) } -- Setters @@ -294,13 +301,18 @@ setUnfoldingInfo info uf setArityInfo :: IdInfo -> ArityInfo -> IdInfo setArityInfo info ar = info { arityInfo = ar } + setCallArityInfo :: IdInfo -> ArityInfo -> IdInfo setCallArityInfo info ar = info { callArityInfo = ar } + setCafInfo :: IdInfo -> CafInfo -> IdInfo -setCafInfo info caf = info { cafInfo = caf } +setCafInfo info caf = info { cafInfo = caf } + +setLFInfo :: IdInfo -> LambdaFormInfo -> IdInfo +setLFInfo info lf = info { lfInfo = Just lf } setOneShotInfo :: IdInfo -> OneShotInfo -> IdInfo -setOneShotInfo info lb = {-lb `seq`-} info { oneShotInfo = lb } +setOneShotInfo info lb = {-lb `seq`-} info { oneShotInfo = lb } setDemandInfo :: IdInfo -> Demand -> IdInfo setDemandInfo info dd = dd `seq` info { demandInfo = dd } @@ -326,7 +338,8 @@ vanillaIdInfo strictnessInfo = nopSig, cprInfo = topCprSig, callArityInfo = unknownArity, - levityInfo = NoLevityInfo + levityInfo = NoLevityInfo, + lfInfo = Nothing } -- | More informative 'IdInfo' we can use when we know the 'Id' has no CAF references ===================================== compiler/ghc.cabal.in ===================================== @@ -298,6 +298,7 @@ Library GHC.StgToCmm.Ticky GHC.StgToCmm.Utils GHC.StgToCmm.ExtCode + GHC.StgToCmm.Types GHC.Runtime.Heap.Layout GHC.Core.Arity GHC.Core.FVs ===================================== compiler/main/UpdateCafInfos.hs ===================================== @@ -17,6 +17,7 @@ import NameSet import Util import Var import Outputable +import GHC.StgToCmm.Types (ModuleLFInfos) #include "HsVersions.h" @@ -24,14 +25,15 @@ import Outputable updateModDetailsCafInfos :: DynFlags -> NameSet -- ^ Non-CAFFY names in the module. Names not in this set are CAFFY. + -> ModuleLFInfos -> ModDetails -- ^ ModDetails to update -> ModDetails -updateModDetailsCafInfos dflags _ mod_details +updateModDetailsCafInfos dflags _ _ mod_details | gopt Opt_OmitInterfacePragmas dflags = mod_details -updateModDetailsCafInfos _ non_cafs mod_details = +updateModDetailsCafInfos _ non_cafs lf_infos mod_details = {- pprTrace "updateModDetailsCafInfos" (text "non_cafs:" <+> ppr non_cafs) $ -} let ModDetails{ md_types = type_env -- for unfoldings @@ -40,10 +42,10 @@ updateModDetailsCafInfos _ non_cafs mod_details = } = mod_details -- type TypeEnv = NameEnv TyThing - ~type_env' = mapNameEnv (updateTyThingCafInfos type_env' non_cafs) type_env + ~type_env' = mapNameEnv (updateTyThingCafInfos type_env' non_cafs lf_infos) type_env -- Not strict! - !insts' = strictMap (updateInstCafInfos type_env' non_cafs) insts + !insts' = strictMap (updateInstCafInfos type_env' non_cafs lf_infos) insts !rules' = strictMap (updateRuleCafInfos type_env') rules in mod_details{ md_types = type_env' @@ -63,20 +65,20 @@ updateRuleCafInfos type_env Rule{ .. } = Rule { ru_rhs = updateGlobalIds type_en -- Instances -------------------------------------------------------------------------------- -updateInstCafInfos :: TypeEnv -> NameSet -> ClsInst -> ClsInst -updateInstCafInfos type_env non_cafs = - updateClsInstDFun (updateIdUnfolding type_env . updateIdCafInfo non_cafs) +updateInstCafInfos :: TypeEnv -> NameSet -> ModuleLFInfos -> ClsInst -> ClsInst +updateInstCafInfos type_env non_cafs lf_infos = + updateClsInstDFun (updateIdUnfolding type_env . updateIdCafInfo non_cafs lf_infos) -------------------------------------------------------------------------------- -- TyThings -------------------------------------------------------------------------------- -updateTyThingCafInfos :: TypeEnv -> NameSet -> TyThing -> TyThing +updateTyThingCafInfos :: TypeEnv -> NameSet -> ModuleLFInfos -> TyThing -> TyThing -updateTyThingCafInfos type_env non_cafs (AnId id) = - AnId (updateIdUnfolding type_env (updateIdCafInfo non_cafs id)) +updateTyThingCafInfos type_env non_cafs lf_infos (AnId id) = + AnId (updateIdUnfolding type_env (updateIdCafInfo non_cafs lf_infos id)) -updateTyThingCafInfos _ _ other = other -- AConLike, ATyCon, ACoAxiom +updateTyThingCafInfos _ _ _ other = other -- AConLike, ATyCon, ACoAxiom -------------------------------------------------------------------------------- -- Unfoldings @@ -95,13 +97,18 @@ updateIdUnfolding type_env id = -- Expressions -------------------------------------------------------------------------------- -updateIdCafInfo :: NameSet -> Id -> Id -updateIdCafInfo non_cafs id - | idName id `elemNameSet` non_cafs - = -- pprTrace "updateIdCafInfo" (text "Marking" <+> ppr id <+> parens (ppr (idName id)) <+> text "as non-CAFFY") $ - id `setIdCafInfo` NoCafRefs - | otherwise - = id +updateIdCafInfo :: NameSet -> ModuleLFInfos -> Id -> Id +updateIdCafInfo non_cafs lf_infos id = + let + not_caffy = elemNameSet (idName id) non_cafs + mb_lf_info = lookupNameEnv lf_infos (idName id) + + id1 = if not_caffy then setIdCafInfo id NoCafRefs else id + id2 = case mb_lf_info of + Nothing -> id1 + Just lf_info -> setIdLFInfo id1 lf_info + in + id2 -------------------------------------------------------------------------------- ===================================== testsuite/tests/codeGen/should_compile/Makefile ===================================== @@ -64,10 +64,10 @@ T17648: # NoCafRefs) to the interface files. '$(TEST_HC)' $(TEST_HC_OPTS) -dno-typeable-binds -O T17648.hs -v0 '$(TEST_HC)' --show-iface T17648.hi | tr -d '\n' | \ - grep -F 'f :: T GHC.Types.Int -> () [HasNoCafRefs, Arity' >/dev/null + grep -F 'f :: T GHC.Types.Int -> () [HasNoCafRefs, LambdaFormInfo' >/dev/null # Second compilation with -fcatch-bottoms, f should be CAFFY '$(TEST_HC)' $(TEST_HC_OPTS) -dno-typeable-binds -O \ -fcatch-bottoms T17648.hs -v0 -fforce-recomp '$(TEST_HC)' --show-iface T17648.hi | tr -d '\n' | \ - grep -F 'f :: T GHC.Types.Int -> () [Arity: 1, Strictness' >/dev/null + grep -F 'f :: T GHC.Types.Int -> () [LambdaFormInfo' >/dev/null ===================================== testsuite/tests/codeGen/should_compile/cg009/A.hs ===================================== @@ -0,0 +1,5 @@ +module A where + +newtype A = A Int + +val = A 42 ===================================== testsuite/tests/codeGen/should_compile/cg009/Main.hs ===================================== @@ -0,0 +1,7 @@ +module Main where + +import A + +main = return () + +a = val ===================================== testsuite/tests/codeGen/should_compile/cg009/Makefile ===================================== @@ -0,0 +1,9 @@ +TOP=../../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +# Make sure the LFInfo for an exported, but not directly used newtype +# constructors does not trip up the compiler. +cg009: + '$(TEST_HC)' $(TEST_HC_OPTS) -c -O A.hs -fforce-recomp + '$(TEST_HC)' $(TEST_HC_OPTS) -c -O0 Main.hs -fforce-recomp ===================================== testsuite/tests/codeGen/should_compile/cg009/all.T ===================================== @@ -0,0 +1 @@ +test('cg009', [extra_files(['A.hs','Main.hs'])], makefile_test, ['cg009']) ===================================== testsuite/tests/codeGen/should_compile/cg010/A.hs ===================================== @@ -0,0 +1,4 @@ +module A where + +{-# NOINLINE val #-} +val = Just 42 ===================================== testsuite/tests/codeGen/should_compile/cg010/Main.hs ===================================== @@ -0,0 +1,8 @@ +module Main where + +import A + +main = return () + +a = val + ===================================== testsuite/tests/codeGen/should_compile/cg010/Makefile ===================================== @@ -0,0 +1,9 @@ +TOP=../../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +# Make sure LFInfo causes the imported reference to val to get tagged. +cg010: + '$(TEST_HC)' $(TEST_HC_OPTS) -c -O A.hs -fforce-recomp + '$(TEST_HC)' $(TEST_HC_OPTS) -c -O Main.hs -fforce-recomp -ddump-cmm -ddump-to-file + grep "A.val_closure+2" Main.dump-cmm ===================================== testsuite/tests/codeGen/should_compile/cg010/all.T ===================================== @@ -0,0 +1 @@ +test('cg010', [extra_files(['A.hs','Main.hs'])], makefile_test, ['cg010']) ===================================== testsuite/tests/codeGen/should_compile/cg010/cg010.stdout ===================================== @@ -0,0 +1 @@ + const A.val_closure+2; ===================================== testsuite/tests/simplCore/should_compile/Makefile ===================================== @@ -102,7 +102,7 @@ T4201: '$(TEST_HC)' $(TEST_HC_OPTS) -c -O T4201.hs '$(TEST_HC)' $(TEST_HC_OPTS) --show-iface T4201.hi > T4201.list # poor man idea about how to replace GNU grep -B2 "Sym" invocation with pure POSIX tools - for i in `grep -n "Sym" T4201.list |cut -d ':' -f -1`; do head -$$i T4201.list | tail -3 ; done + for i in `grep -n "Sym" T4201.list | cut -d ':' -f -1`; do head -$$i T4201.list | tail -5; done $(RM) -f T4201.list # This one looped as a result of bogus specialisation ===================================== testsuite/tests/simplCore/should_compile/T4201.stdout ===================================== @@ -1,3 +1,5 @@ - [HasNoCafRefs, Arity: 1, Strictness: , CPR: m1, + [HasNoCafRefs, + LambdaFormInfo: LFReEntrant (NoOneShotInfo, 1, True), Arity: 1, + Strictness: , CPR: m1, Unfolding: InlineRule (0, True, True) bof `cast` (Sym (N:Foo[0]) ->_R _R)] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bb4317884517db32171838bcc5e2b7b6eb46dadb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bb4317884517db32171838bcc5e2b7b6eb46dadb You're receiving 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 Mar 25 07:02:37 2020 From: gitlab at gitlab.haskell.org (=?UTF-8?B?w5ZtZXIgU2luYW4gQcSfYWNhbg==?=) Date: Wed, 25 Mar 2020 03:02:37 -0400 Subject: [Git][ghc/ghc][wip/osa1/lfinfo] Cross-module LambdaFormInfo passing Message-ID: <5e7b020d5f4de_61673f81cd4b0f584602e0@gitlab.haskell.org.mail> Ömer Sinan Ağacan pushed to branch wip/osa1/lfinfo at Glasgow Haskell Compiler / GHC Commits: 6e26c783 by Ömer Sinan Ağacan at 2020-03-25T10:02:19+03:00 Cross-module LambdaFormInfo passing - Store LambdaFormInfos of exported Ids in interface files - Use them in importing modules - - - - - 29 changed files: - compiler/GHC/CoreToIface.hs - compiler/GHC/Driver/Hooks.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Runtime/Heap/Layout.hs - compiler/GHC/StgToCmm.hs - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/StgToCmm/Env.hs - + compiler/GHC/StgToCmm/Types.hs - compiler/basicTypes/Id.hs - compiler/basicTypes/IdInfo.hs - compiler/ghc.cabal.in - compiler/main/UpdateCafInfos.hs → compiler/main/UpdateIdInfos.hs - testsuite/tests/codeGen/should_compile/Makefile - + testsuite/tests/codeGen/should_compile/cg009/A.hs - + testsuite/tests/codeGen/should_compile/cg009/Main.hs - + testsuite/tests/codeGen/should_compile/cg009/Makefile - + testsuite/tests/codeGen/should_compile/cg009/all.T - + testsuite/tests/codeGen/should_compile/cg010/A.hs - + testsuite/tests/codeGen/should_compile/cg010/Main.hs - + testsuite/tests/codeGen/should_compile/cg010/Makefile - + testsuite/tests/codeGen/should_compile/cg010/all.T - + testsuite/tests/codeGen/should_compile/cg010/cg010.stdout - testsuite/tests/simplCore/should_compile/Makefile - testsuite/tests/simplCore/should_compile/T4201.stdout Changes: ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -34,13 +34,14 @@ module GHC.CoreToIface , toIfaceIdDetails , toIfaceIdInfo , toIfUnfolding - , toIfaceOneShot , toIfaceTickish , toIfaceBind , toIfaceAlt , toIfaceCon , toIfaceApp , toIfaceVar + -- * Other stuff + , toIfaceLFInfo ) where #include "HsVersions.h" @@ -49,6 +50,7 @@ import GhcPrelude import GHC.Iface.Syntax import GHC.Core.DataCon +import GHC.StgToCmm.Types import Id import IdInfo import GHC.Core @@ -74,6 +76,8 @@ import Demand ( isTopSig ) import Cpr ( topCprSig ) import Data.Maybe ( catMaybes ) +import Data.Word +import Data.Bits {- Note [Avoiding space leaks in toIface*] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -616,6 +620,43 @@ toIfaceVar v where name = idName v +--------------------- +toIfaceLFInfo :: LambdaFormInfo -> IfaceLFInfo +toIfaceLFInfo lfi = case lfi of + LFReEntrant _ _ arity _ _ -> + IfLFReEntrant arity + LFThunk _ _ updatable sfi mb_fun -> + IfLFThunk updatable (toIfaceStandardFormInfo sfi) mb_fun + LFCon dc -> + IfLFCon (dataConName dc) + LFUnknown mb_fun -> + IfLFUnknown mb_fun + LFUnlifted -> + IfLFUnlifted + LFLetNoEscape -> + panic "toIfaceLFInfo: LFLetNoEscape" + +toIfaceStandardFormInfo :: StandardFormInfo -> IfaceStandardFormInfo +toIfaceStandardFormInfo NonStandardThunk = IfStandardFormInfo 1 +toIfaceStandardFormInfo sf = + IfStandardFormInfo $! + tag sf .|. encodeField (field sf) + where + tag SelectorThunk{} = 0 + tag ApThunk{} = setBit 0 1 + tag NonStandardThunk = panic "toIfaceStandardFormInfo: NonStandardThunk" + + field (SelectorThunk n) = n + field (ApThunk n) = n + field NonStandardThunk = panic "toIfaceStandardFormInfo: NonStandardThunk" + + encodeField n = + let wn = fromIntegral n :: Word + shifted = wn `unsafeShiftL` 2 + in ASSERT(shifted > 0 && shifted < fromIntegral (maxBound :: Word16)) + (fromIntegral shifted :: Word16) + + {- Note [Inlining and hs-boot files] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider this example (#10083, #12789): ===================================== compiler/GHC/Driver/Hooks.hs ===================================== @@ -55,6 +55,7 @@ import GHC.Stg.Syntax import Stream import GHC.Cmm import GHC.Hs.Extension +import GHC.StgToCmm.Types (ModuleLFInfos) import Data.Maybe @@ -109,7 +110,7 @@ data Hooks = Hooks -> IO (Maybe HValue)) , createIservProcessHook :: Maybe (CreateProcess -> IO ProcessHandle) , stgToCmmHook :: Maybe (DynFlags -> Module -> [TyCon] -> CollectedCCs - -> [CgStgTopBinding] -> HpcInfo -> Stream IO CmmGroup ()) + -> [CgStgTopBinding] -> HpcInfo -> Stream IO CmmGroup ModuleLFInfos) , cmmToRawCmmHook :: forall a . Maybe (DynFlags -> Maybe Module -> Stream IO CmmGroupSRTs a -> IO (Stream IO RawCmmGroup a)) } ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -162,6 +162,7 @@ import Bag import Exception import qualified Stream import Stream (Stream) +import GHC.StgToCmm.Types (ModuleLFInfos) import Util @@ -176,6 +177,7 @@ import qualified Data.Set as S import Data.Set (Set) import Data.Functor import Control.DeepSeq (force) +import Data.Bifunctor (first) import GHC.Iface.Ext.Ast ( mkHieFile ) import GHC.Iface.Ext.Types ( getAsts, hie_asts, hie_module ) @@ -1392,7 +1394,7 @@ hscWriteIface dflags iface no_change mod_location = do -- | Compile to hard-code. hscGenHardCode :: HscEnv -> CgGuts -> ModLocation -> FilePath - -> IO (FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)], NameSet) + -> IO (FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)], NameSet, ModuleLFInfos) -- ^ @Just f@ <=> _stub.c is f hscGenHardCode hsc_env cgguts location output_filename = do let CgGuts{ -- This is the last use of the ModGuts in a compilation. @@ -1451,11 +1453,11 @@ hscGenHardCode hsc_env cgguts location output_filename = do return a rawcmms1 = Stream.mapM dump rawcmms0 - (output_filename, (_stub_h_exists, stub_c_exists), foreign_fps, caf_infos) + (output_filename, (_stub_h_exists, stub_c_exists), foreign_fps, (caf_infos, lf_infos)) <- {-# SCC "codeOutput" #-} codeOutput dflags this_mod output_filename location foreign_stubs foreign_files dependencies rawcmms1 - return (output_filename, stub_c_exists, foreign_fps, caf_infos) + return (output_filename, stub_c_exists, foreign_fps, caf_infos, lf_infos) hscInteractive :: HscEnv @@ -1549,7 +1551,7 @@ doCodeGen :: HscEnv -> Module -> [TyCon] -> CollectedCCs -> [StgTopBinding] -> HpcInfo - -> IO (Stream IO CmmGroupSRTs NameSet) + -> IO (Stream IO CmmGroupSRTs (NameSet, ModuleLFInfos)) -- Note we produce a 'Stream' of CmmGroups, so that the -- backend can be run incrementally. Otherwise it generates all -- the C-- up front, which has a significant space cost. @@ -1561,7 +1563,7 @@ doCodeGen hsc_env this_mod data_tycons dumpIfSet_dyn dflags Opt_D_dump_stg_final "Final STG:" FormatSTG (pprGenStgTopBindings stg_binds_w_fvs) - let cmm_stream :: Stream IO CmmGroup () + let cmm_stream :: Stream IO CmmGroup ModuleLFInfos -- See Note [Forcing of stg_binds] cmm_stream = stg_binds_w_fvs `seqList` {-# SCC "StgToCmm" #-} lookupHook stgToCmmHook StgToCmm.codeGen dflags dflags this_mod data_tycons @@ -1580,10 +1582,11 @@ doCodeGen hsc_env this_mod data_tycons ppr_stream1 = Stream.mapM dump1 cmm_stream + pipeline_stream :: Stream IO CmmGroupSRTs (NameSet, ModuleLFInfos) pipeline_stream = {-# SCC "cmmPipeline" #-} - Stream.mapAccumL (cmmPipeline hsc_env) (emptySRT this_mod) ppr_stream1 - <&> (srtMapNonCAFs . moduleSRTMap) + Stream.mapAccumL_ (cmmPipeline hsc_env) (emptySRT this_mod) ppr_stream1 + <&> (first (srtMapNonCAFs . moduleSRTMap)) dump2 a = do unless (null a) $ ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -69,8 +69,8 @@ import FileCleanup import Ar import Bag ( unitBag ) import FastString ( mkFastString ) -import GHC.Iface.Make ( mkFullIface ) -import UpdateCafInfos ( updateModDetailsCafInfos ) +import GHC.Iface.Make ( mkFullIface ) +import UpdateIdInfos ( updateModDetailsIdInfos ) import Exception import System.Directory @@ -1192,12 +1192,12 @@ runPhase (HscOut src_flavour mod_name result) _ dflags = do PipeState{hsc_env=hsc_env'} <- getPipeState - (outputFilename, mStub, foreign_files, caf_infos) <- liftIO $ + (outputFilename, mStub, foreign_files, caf_infos, lf_infos) <- liftIO $ hscGenHardCode hsc_env' cgguts mod_location output_fn - final_iface <- liftIO (mkFullIface hsc_env'{hsc_dflags=iface_dflags} partial_iface (Just caf_infos)) - let final_mod_details = {-# SCC updateModDetailsCafInfos #-} - updateModDetailsCafInfos iface_dflags caf_infos mod_details + final_iface <- liftIO (mkFullIface hsc_env'{hsc_dflags=iface_dflags} partial_iface (Just (caf_infos, lf_infos))) + let final_mod_details = {-# SCC updateModDetailsIdInfos #-} + updateModDetailsIdInfos iface_dflags caf_infos lf_infos mod_details setIface final_iface final_mod_details -- See Note [Writing interface files] ===================================== compiler/GHC/Iface/Make.hs ===================================== @@ -38,6 +38,7 @@ import GHC.Core.Coercion.Axiom import GHC.Core.ConLike import GHC.Core.DataCon import GHC.Core.Type +import GHC.StgToCmm.Types (ModuleLFInfos) import TcType import GHC.Core.InstEnv import GHC.Core.FamInstEnv @@ -100,13 +101,13 @@ mkPartialIface hsc_env mod_details -- | Fully instantiate a interface -- Adds fingerprints and potentially code generator produced information. -mkFullIface :: HscEnv -> PartialModIface -> Maybe NameSet -> IO ModIface -mkFullIface hsc_env partial_iface mb_non_cafs = do +mkFullIface :: HscEnv -> PartialModIface -> Maybe (NameSet, ModuleLFInfos) -> IO ModIface +mkFullIface hsc_env partial_iface mb_id_infos = do let decls | gopt Opt_OmitInterfacePragmas (hsc_dflags hsc_env) = mi_decls partial_iface | otherwise - = updateDeclCafInfos (mi_decls partial_iface) mb_non_cafs + = updateDecl (mi_decls partial_iface) mb_id_infos full_iface <- {-# SCC "addFingerprints" #-} @@ -117,15 +118,23 @@ mkFullIface hsc_env partial_iface mb_non_cafs = do return full_iface -updateDeclCafInfos :: [IfaceDecl] -> Maybe NameSet -> [IfaceDecl] -updateDeclCafInfos decls Nothing = decls -updateDeclCafInfos decls (Just non_cafs) = map update_decl decls +updateDecl :: [IfaceDecl] -> Maybe (NameSet, ModuleLFInfos) -> [IfaceDecl] +updateDecl decls Nothing = decls +updateDecl decls (Just (non_cafs, lf_infos)) = map update_decl decls where + update_decl (IfaceId nm ty details infos) + | let not_caffy = elemNameSet nm non_cafs + , let mb_lf_info = lookupNameEnv lf_infos nm + , WARN( isNothing mb_lf_info, text "Name without LFInfo:" <+> ppr nm ) True + -- Only allocate a new IfaceId if we're going to update the infos + , isJust mb_lf_info || not_caffy + = IfaceId nm ty details $ + (if not_caffy then (HsNoCafRefs :) else id) + (case mb_lf_info of + Nothing -> infos + Just lf_info -> HsLFInfo (toIfaceLFInfo lf_info) : infos) + update_decl decl - | IfaceId nm ty details infos <- decl - , elemNameSet nm non_cafs - = IfaceId nm ty details (HsNoCafRefs : infos) - | otherwise = decl -- | Make an interface from the results of typechecking only. Useful ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -22,6 +22,8 @@ module GHC.Iface.Syntax ( IfaceAxBranch(..), IfaceTyConParent(..), IfaceCompleteMatch(..), + IfaceLFInfo(..), + IfaceStandardFormInfo(..), -- * Binding names IfaceTopBndr, @@ -30,6 +32,7 @@ module GHC.Iface.Syntax ( -- Misc ifaceDeclImplicitBndrs, visibleIfConDecls, ifaceDeclFingerprints, + tcStandardFormInfo, -- Free Names freeNamesIfDecl, freeNamesIfRule, freeNamesIfFamInst, @@ -72,10 +75,13 @@ import GHC.Core.DataCon (SrcStrictness(..), SrcUnpackedness(..)) import Lexeme (isLexSym) import TysWiredIn ( constraintKindTyConName ) import Util (seqList) +import GHC.StgToCmm.Types import Control.Monad import System.IO.Unsafe import Control.DeepSeq +import Data.Word +import Data.Bits infixl 3 &&& @@ -114,7 +120,8 @@ data IfaceDecl = IfaceId { ifName :: IfaceTopBndr, ifType :: IfaceType, ifIdDetails :: IfaceIdDetails, - ifIdInfo :: IfaceIdInfo } + ifIdInfo :: IfaceIdInfo + } | IfaceData { ifName :: IfaceTopBndr, -- Type constructor ifBinders :: [IfaceTyConBinder], @@ -348,6 +355,7 @@ data IfaceInfoItem IfaceUnfolding -- See Note [Expose recursive functions] | HsNoCafRefs | HsLevity -- Present <=> never levity polymorphic + | HsLFInfo IfaceLFInfo -- NB: Specialisations and rules come in separately and are -- only later attached to the Id. Partial reason: some are orphans. @@ -379,6 +387,74 @@ data IfaceIdDetails | IfRecSelId (Either IfaceTyCon IfaceDecl) Bool | IfDFunId +-- | Iface type for LambdaFormInfo. Fields not relevant for imported Ids are +-- omitted in this type. +data IfaceLFInfo + = IfLFReEntrant !RepArity + | IfLFThunk !Bool !IfaceStandardFormInfo !Bool + | IfLFCon !Name + | IfLFUnknown !Bool + | IfLFUnlifted + +tcStandardFormInfo :: IfaceStandardFormInfo -> StandardFormInfo +tcStandardFormInfo (IfStandardFormInfo w) + | testBit w 0 = NonStandardThunk + | otherwise = con field + where + field = fromIntegral (w `unsafeShiftR` 2) + con + | testBit w 1 = ApThunk + | otherwise = SelectorThunk + +instance Outputable IfaceLFInfo where + ppr (IfLFReEntrant arity) = + text "LFReEntrant" <+> ppr arity + + ppr (IfLFThunk updatable sfi mb_fun) = + text "LFThunk" <+> ppr (updatable, tcStandardFormInfo sfi, mb_fun) + + ppr (IfLFCon con) = + text "LFCon" <> brackets (ppr con) + + ppr IfLFUnlifted = + text "LFUnlifted" + + ppr (IfLFUnknown fun_flag) = + text "LFUnknown" <+> ppr fun_flag + +newtype IfaceStandardFormInfo = IfStandardFormInfo Word16 + +instance Binary IfaceStandardFormInfo where + put_ bh (IfStandardFormInfo w) = put_ bh (w :: Word16) + get bh = IfStandardFormInfo <$> (get bh :: IO Word16) + +instance Binary IfaceLFInfo where + put_ bh (IfLFReEntrant arity) = do + putByte bh 0 + put_ bh arity + put_ bh (IfLFThunk updatable sfi mb_fun) = do + putByte bh 1 + put_ bh updatable + put_ bh sfi + put_ bh mb_fun + put_ bh (IfLFCon con_name) = do + putByte bh 2 + put_ bh con_name + put_ bh (IfLFUnknown fun_flag) = do + putByte bh 3 + put_ bh fun_flag + put_ bh IfLFUnlifted = + putByte bh 4 + get bh = do + tag <- getByte bh + case tag of + 0 -> IfLFReEntrant <$> get bh + 1 -> IfLFThunk <$> get bh <*> get bh <*> get bh + 2 -> IfLFCon <$> get bh + 3 -> IfLFUnknown <$> get bh + 4 -> pure IfLFUnlifted + _ -> panic "Invalid byte" + {- Note [Versioning of instances] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1393,6 +1469,7 @@ instance Outputable IfaceInfoItem where ppr (HsCpr cpr) = text "CPR:" <+> ppr cpr ppr HsNoCafRefs = text "HasNoCafRefs" ppr HsLevity = text "Never levity-polymorphic" + ppr (HsLFInfo lf_info) = text "LambdaFormInfo:" <+> ppr lf_info instance Outputable IfaceJoinInfo where ppr IfaceNotJoinPoint = empty @@ -1853,7 +1930,7 @@ instance Binary IfaceDecl where get bh = do h <- getByte bh case h of - 0 -> do name <- get bh + 0 -> do name <- get bh ~(ty, details, idinfo) <- lazyGet bh -- See Note [Lazy deserialization of IfaceId] return (IfaceId name ty details idinfo) @@ -2153,6 +2230,8 @@ instance Binary IfaceInfoItem where put_ bh HsNoCafRefs = putByte bh 4 put_ bh HsLevity = putByte bh 5 put_ bh (HsCpr cpr) = putByte bh 6 >> put_ bh cpr + put_ bh (HsLFInfo lf_info) = putByte bh 7 >> put_ bh lf_info + get bh = do h <- getByte bh case h of @@ -2164,7 +2243,8 @@ instance Binary IfaceInfoItem where 3 -> liftM HsInline $ get bh 4 -> return HsNoCafRefs 5 -> return HsLevity - _ -> HsCpr <$> get bh + 6 -> HsCpr <$> get bh + _ -> HsLFInfo <$> get bh instance Binary IfaceUnfolding where put_ bh (IfCoreUnfold s e) = do @@ -2495,6 +2575,7 @@ instance NFData IfaceInfoItem where HsNoCafRefs -> () HsLevity -> () HsCpr cpr -> cpr `seq` () + HsLFInfo lf_info -> lf_info `seq` () -- TODO: seq further? instance NFData IfaceUnfolding where rnf = \case ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -122,6 +122,9 @@ data IfaceOneShot -- See Note [Preserve OneShotInfo] in CoreTicy = IfaceNoOneShot -- and Note [The oneShot function] in MkId | IfaceOneShot +instance Outputable IfaceOneShot where + ppr IfaceNoOneShot = text "NoOneShotInfo" + ppr IfaceOneShot = text "OneShot" {- %************************************************************************ ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -19,7 +19,8 @@ module GHC.IfaceToCore ( tcIfaceDecl, tcIfaceInst, tcIfaceFamInst, tcIfaceRules, tcIfaceAnnotations, tcIfaceCompleteSigs, tcIfaceExpr, -- Desired by HERMIT (#7683) - tcIfaceGlobal + tcIfaceGlobal, + tcIfaceOneShot ) where #include "HsVersions.h" @@ -30,6 +31,9 @@ import TcTypeNats(typeNatCoAxiomRules) import GHC.Iface.Syntax import GHC.Iface.Load import GHC.Iface.Env +import GHC.StgToCmm.Types +import GHC.StgToCmm.Closure +import GHC.Types.RepType import BuildTyCl import TcRnMonad import TcType @@ -641,7 +645,7 @@ tc_iface_decl _ ignore_prags (IfaceId {ifName = name, ifType = iface_type, = do { ty <- tcIfaceType iface_type ; details <- tcIdDetails ty details ; info <- tcIdInfo ignore_prags TopLevel name ty info - ; return (AnId (mkGlobalId details name ty info)) } + ; return (AnId (addIdLFInfo (mkGlobalId details name ty info))) } tc_iface_decl _ _ (IfaceData {ifName = tc_name, ifCType = cType, @@ -1340,7 +1344,8 @@ tcIfaceExpr (IfaceLet (IfaceNonRec (IfLetBndr fs ty info ji) rhs) body) ; ty' <- tcIfaceType ty ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -} NotTopLevel name ty' info - ; let id = mkLocalIdWithInfo name ty' id_info + ; let id = addIdLFInfo $ + mkLocalIdWithInfo name ty' id_info `asJoinId_maybe` tcJoinInfo ji ; rhs' <- tcIfaceExpr rhs ; body' <- extendIfaceIdEnv [id] (tcIfaceExpr body) @@ -1361,7 +1366,7 @@ tcIfaceExpr (IfaceLet (IfaceRec pairs) body) = do { rhs' <- tcIfaceExpr rhs ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -} NotTopLevel (idName id) (idType id) info - ; return (setIdInfo id id_info, rhs') } + ; return (addIdLFInfo (setIdInfo id id_info), rhs') } tcIfaceExpr (IfaceTick tickish expr) = do expr' <- tcIfaceExpr expr @@ -1465,8 +1470,7 @@ tcIdInfo ignore_prags toplvl name ty info = do let init_info | if_boot lcl_env = vanillaIdInfo `setUnfoldingInfo` BootUnfolding | otherwise = vanillaIdInfo - let needed = needed_prags info - foldlM tcPrag init_info needed + foldlM tcPrag init_info (needed_prags info) where needed_prags :: [IfaceInfoItem] -> [IfaceInfoItem] needed_prags items @@ -1486,6 +1490,9 @@ tcIdInfo ignore_prags toplvl name ty info = do tcPrag info (HsCpr cpr) = return (info `setCprInfo` cpr) tcPrag info (HsInline prag) = return (info `setInlinePragInfo` prag) tcPrag info HsLevity = return (info `setNeverLevPoly` ty) + tcPrag info (HsLFInfo lf_info) = do + lf_info <- tcLFInfo lf_info + return (info `setLFInfo` lf_info) -- The next two are lazy, so they don't transitively suck stuff in tcPrag info (HsUnfold lb if_unf) @@ -1494,10 +1501,55 @@ tcIdInfo ignore_prags toplvl name ty info = do | otherwise = info ; return (info1 `setUnfoldingInfo` unf) } +addIdLFInfo :: Id -> Id +addIdLFInfo id = case idLFInfo_maybe id of + Nothing -> setIdLFInfo id (mkLFImported (idDetails id) (idInfo id) (idType id)) + Just _ -> id + +-- Make a LambdaFormInfo for the Ids without a LFInfo in the iface file +mkLFImported :: IdDetails -> IdInfo -> Type -> LambdaFormInfo +mkLFImported details info ty + | DataConWorkId con <- details + , isNullaryRepDataCon con + = LFCon con -- An imported nullary constructor + -- We assume that the constructor is evaluated so that + -- the id really does point directly to the constructor + + | arity > 0 + = LFReEntrant TopLevel noOneShotInfo arity True ArgUnknown + + | isUnliftedType ty + = LFUnlifted + + | mightBeAFunction ty + = LFUnknown True + + | otherwise + = LFUnknown False + where + arity = countFunRepArgs (arityInfo info) ty + tcJoinInfo :: IfaceJoinInfo -> Maybe JoinArity tcJoinInfo (IfaceJoinPoint ar) = Just ar tcJoinInfo IfaceNotJoinPoint = Nothing +tcLFInfo :: IfaceLFInfo -> IfL LambdaFormInfo +tcLFInfo lfi = case lfi of + IfLFReEntrant rep_arity -> + return (LFReEntrant TopLevel NoOneShotInfo rep_arity True ArgUnknown) + + IfLFThunk updatable sfi mb_fun -> + return (LFThunk TopLevel True updatable (tcStandardFormInfo sfi) mb_fun) + + IfLFUnlifted -> + return LFUnlifted + + IfLFCon con_name -> + LFCon <$!> tcIfaceDataCon con_name + + IfLFUnknown fun_flag -> + return (LFUnknown fun_flag) + tcUnfolding :: TopLevelFlag -> Name -> Type -> IdInfo -> IfaceUnfolding -> IfL Unfolding tcUnfolding toplvl name _ info (IfCoreUnfold stable if_expr) = do { dflags <- getDynFlags @@ -1586,6 +1638,10 @@ tcPragExpr is_compulsory toplvl name expr -- It's OK to use nonDetEltsUFM here because we immediately forget -- the ordering by creating a set +tcIfaceOneShot :: IfaceOneShot -> OneShotInfo +tcIfaceOneShot IfaceNoOneShot = NoOneShotInfo +tcIfaceOneShot IfaceOneShot = OneShotLam + {- ************************************************************************ * * ===================================== compiler/GHC/Runtime/Heap/Layout.hs ===================================== @@ -51,6 +51,7 @@ import GHC.Driver.Session import Outputable import GHC.Platform import FastString +import GHC.StgToCmm.Types import Data.Word import Data.Bits @@ -64,9 +65,6 @@ import Data.ByteString (ByteString) ************************************************************************ -} --- | Word offset, or word count -type WordOff = Int - -- | Byte offset, or byte count type ByteOff = Int @@ -196,29 +194,6 @@ type ConstrDescription = ByteString -- result of dataConIdentity type FunArity = Int type SelectorOffset = Int -------------------------- --- We represent liveness bitmaps as a Bitmap (whose internal --- representation really is a bitmap). These are pinned onto case return --- vectors to indicate the state of the stack for the garbage collector. --- --- In the compiled program, liveness bitmaps that fit inside a single --- word (StgWord) are stored as a single word, while larger bitmaps are --- stored as a pointer to an array of words. - -type Liveness = [Bool] -- One Bool per word; True <=> non-ptr or dead - -- False <=> ptr - -------------------------- --- An ArgDescr describes the argument pattern of a function - -data ArgDescr - = ArgSpec -- Fits one of the standard patterns - !Int -- RTS type identifier ARG_P, ARG_N, ... - - | ArgGen -- General case - Liveness -- Details about the arguments - - ----------------------------------------------------------------------------- -- Construction @@ -545,10 +520,6 @@ instance Outputable SMRep where ppr (RTSRep ty rep) = text "tag:" <> ppr ty <+> ppr rep -instance Outputable ArgDescr where - ppr (ArgSpec n) = text "ArgSpec" <+> ppr n - ppr (ArgGen ls) = text "ArgGen" <+> ppr ls - pprTypeInfo :: ClosureTypeInfo -> SDoc pprTypeInfo (Constr tag descr) = text "Con" <+> ===================================== compiler/GHC/StgToCmm.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} +{-# LANGUAGE BangPatterns #-} ----------------------------------------------------------------------------- -- @@ -25,6 +26,7 @@ import GHC.StgToCmm.Utils import GHC.StgToCmm.Closure import GHC.StgToCmm.Hpc import GHC.StgToCmm.Ticky +import GHC.StgToCmm.Types (ModuleLFInfos) import GHC.Cmm import GHC.Cmm.CLabel @@ -45,6 +47,8 @@ import Outputable import Stream import BasicTypes import VarSet ( isEmptyDVarSet ) +import UniqFM +import NameEnv import OrdList import GHC.Cmm.Graph @@ -52,6 +56,7 @@ import GHC.Cmm.Graph import Data.IORef import Control.Monad (when,void) import Util +import Data.Maybe codeGen :: DynFlags -> Module @@ -59,7 +64,8 @@ codeGen :: DynFlags -> CollectedCCs -- (Local/global) cost-centres needing declaring/registering. -> [CgStgTopBinding] -- Bindings to convert -> HpcInfo - -> Stream IO CmmGroup () -- Output as a stream, so codegen can + -> Stream IO CmmGroup ModuleLFInfos + -- Output as a stream, so codegen can -- be interleaved with output codeGen dflags this_mod data_tycons @@ -101,6 +107,20 @@ codeGen dflags this_mod data_tycons mapM_ (cg . cgDataCon) (tyConDataCons tycon) ; mapM_ do_tycon data_tycons + + ; cg_id_infos <- cgs_binds <$> liftIO (readIORef cgref) + + -- Only external names are actually visible to codeGen. So they are the + -- only ones we care about. + ; let extractInfo info = lf `seq` Just (name,lf) + where + id = cg_id info + !name = idName id + lf = cg_lf info + + ; let !generatedInfo = mkNameEnv (mapMaybe extractInfo (eltsUFM cg_id_infos)) + + ; return $! generatedInfo } --------------------------------------------------------------- ===================================== compiler/GHC/StgToCmm/Closure.hs ===================================== @@ -24,7 +24,7 @@ module GHC.StgToCmm.Closure ( LambdaFormInfo, -- Abstract StandardFormInfo, -- ...ditto... mkLFThunk, mkLFReEntrant, mkConLFInfo, mkSelectorLFInfo, - mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape, + mkApLFInfo, mkLFArgument, mkLFLetNoEscape, mkLFStringLit, lfDynTag, isLFThunk, isLFReEntrant, lfUpdatable, @@ -51,6 +51,7 @@ module GHC.StgToCmm.Closure ( closureUpdReqd, closureSingleEntry, closureReEntrant, closureFunInfo, isToplevClosure, + mightBeAFunction, blackHoleOnEntry, -- Needs LambdaFormInfo and SMRep isStaticClosure, -- Needs SMPre @@ -70,6 +71,7 @@ import GHC.Stg.Syntax import GHC.Runtime.Heap.Layout import GHC.Cmm import GHC.Cmm.Ppr.Expr() -- For Outputable instances +import GHC.StgToCmm.Types import CostCentre import GHC.Cmm.BlockId @@ -188,86 +190,15 @@ addArgReps = map (\arg -> let arg' = fromNonVoid arg argPrimRep :: StgArg -> PrimRep argPrimRep arg = typePrimRep1 (stgArgType arg) - ------------------------------------------------------------------------------ --- LambdaFormInfo ------------------------------------------------------------------------------ - --- Information about an identifier, from the code generator's point of --- view. Every identifier is bound to a LambdaFormInfo in the --- environment, which gives the code generator enough info to be able to --- tail call or return that identifier. - -data LambdaFormInfo - = LFReEntrant -- Reentrant closure (a function) - TopLevelFlag -- True if top level - OneShotInfo - !RepArity -- Arity. Invariant: always > 0 - !Bool -- True <=> no fvs - ArgDescr -- Argument descriptor (should really be in ClosureInfo) - - | LFThunk -- Thunk (zero arity) - TopLevelFlag - !Bool -- True <=> no free vars - !Bool -- True <=> updatable (i.e., *not* single-entry) - StandardFormInfo - !Bool -- True <=> *might* be a function type - - | LFCon -- A saturated constructor application - DataCon -- The constructor - - | LFUnknown -- Used for function arguments and imported things. - -- We know nothing about this closure. - -- Treat like updatable "LFThunk"... - -- Imported things which we *do* know something about use - -- one of the other LF constructors (eg LFReEntrant for - -- known functions) - !Bool -- True <=> *might* be a function type - -- The False case is good when we want to enter it, - -- because then we know the entry code will do - -- For a function, the entry code is the fast entry point - - | LFUnlifted -- A value of unboxed type; - -- always a value, needs evaluation - - | LFLetNoEscape -- See LetNoEscape module for precise description - - -------------------------- --- StandardFormInfo tells whether this thunk has one of --- a small number of standard forms - -data StandardFormInfo - = NonStandardThunk - -- The usual case: not of the standard forms - - | SelectorThunk - -- A SelectorThunk is of form - -- case x of - -- con a1,..,an -> ak - -- and the constructor is from a single-constr type. - WordOff -- 0-origin offset of ak within the "goods" of - -- constructor (Recall that the a1,...,an may be laid - -- out in the heap in a non-obvious order.) - - | ApThunk - -- An ApThunk is of form - -- x1 ... xn - -- The code for the thunk just pushes x2..xn on the stack and enters x1. - -- There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled - -- in the RTS to save space. - RepArity -- Arity, n - - ------------------------------------------------------ -- Building LambdaFormInfo ------------------------------------------------------ mkLFArgument :: Id -> LambdaFormInfo mkLFArgument id - | isUnliftedType ty = LFUnlifted - | might_be_a_function ty = LFUnknown True - | otherwise = LFUnknown False + | isUnliftedType ty = LFUnlifted + | mightBeAFunction ty = LFUnknown True + | otherwise = LFUnknown False where ty = idType id @@ -295,13 +226,13 @@ mkLFThunk thunk_ty top fvs upd_flag LFThunk top (null fvs) (isUpdatable upd_flag) NonStandardThunk - (might_be_a_function thunk_ty) + (mightBeAFunction thunk_ty) -------------- -might_be_a_function :: Type -> Bool +mightBeAFunction :: Type -> Bool -- Return False only if we are *sure* it's a data type -- Look through newtypes etc as much as poss -might_be_a_function ty +mightBeAFunction ty | [LiftedRep] <- typePrimRep ty , Just tc <- tyConAppTyCon_maybe (unwrapType ty) , isDataTyCon tc @@ -317,30 +248,13 @@ mkConLFInfo con = LFCon con mkSelectorLFInfo :: Id -> Int -> Bool -> LambdaFormInfo mkSelectorLFInfo id offset updatable = LFThunk NotTopLevel False updatable (SelectorThunk offset) - (might_be_a_function (idType id)) + (mightBeAFunction (idType id)) ------------- mkApLFInfo :: Id -> UpdateFlag -> Arity -> LambdaFormInfo mkApLFInfo id upd_flag arity = LFThunk NotTopLevel (arity == 0) (isUpdatable upd_flag) (ApThunk arity) - (might_be_a_function (idType id)) - -------------- -mkLFImported :: Id -> LambdaFormInfo -mkLFImported id - | Just con <- isDataConWorkId_maybe id - , isNullaryRepDataCon con - = LFCon con -- An imported nullary constructor - -- We assume that the constructor is evaluated so that - -- the id really does point directly to the constructor - - | arity > 0 - = LFReEntrant TopLevel noOneShotInfo arity True (panic "arg_descr") - - | otherwise - = mkLFArgument id -- Not sure of exact arity - where - arity = idFunRepArity id + (mightBeAFunction (idType id)) ------------- mkLFStringLit :: LambdaFormInfo ===================================== compiler/GHC/StgToCmm/Env.hs ===================================== @@ -31,6 +31,7 @@ import GHC.Platform import GHC.StgToCmm.Monad import GHC.StgToCmm.Utils import GHC.StgToCmm.Closure +import GHC.StgToCmm.Types import GHC.Cmm.CLabel @@ -48,6 +49,8 @@ import TysPrim import UniqFM import Util import VarEnv +import GHC.Core.DataCon +import BasicTypes ------------------------------------- -- Manipulating CgIdInfo @@ -146,6 +149,26 @@ getCgIdInfo id cgLookupPanic id -- Bug }}} +mkLFImported :: Id -> LambdaFormInfo +mkLFImported id = + case idLFInfo_maybe id of + Just lf_info -> + lf_info + Nothing + | Just con <- isDataConWorkId_maybe id + , isNullaryRepDataCon con + -> LFCon con -- An imported nullary constructor + -- We assume that the constructor is evaluated so that + -- the id really does point directly to the constructor + + | arity > 0 + -> LFReEntrant TopLevel noOneShotInfo arity True ArgUnknown + + | otherwise + -> mkLFArgument id -- Not sure of exact arity + where + arity = idFunRepArity id + cgLookupPanic :: Id -> FCode a cgLookupPanic id = do local_binds <- getBinds ===================================== compiler/GHC/StgToCmm/Types.hs ===================================== @@ -0,0 +1,157 @@ +{-# LANGUAGE CPP #-} + +module GHC.StgToCmm.Types + ( WordOff + , LambdaFormInfo (..) + , ModuleLFInfos + , Liveness + , ArgDescr (..) + , StandardFormInfo (..) + ) where + +#include "HsVersions.h" + +import GhcPrelude + +import BasicTypes +import GHC.Core.DataCon +import NameEnv +import Outputable + +-- | Word offset, or word count +type WordOff = Int + +-------------------------------------------------------------------------------- +-- LambdaFormInfo +-------------------------------------------------------------------------------- + +-- | Maps names in the current module to their LambdaFormInfos +type ModuleLFInfos = NameEnv LambdaFormInfo + +-- Information about an identifier, from the code generator's point of view. +-- Every identifier is bound to a LambdaFormInfo in the environment, which gives +-- the code generator enough info to be able to tail call or return that +-- identifier. + +data LambdaFormInfo + = LFReEntrant -- Reentrant closure (a function) + !TopLevelFlag -- True if top level + !OneShotInfo + !RepArity -- Arity. Invariant: always > 0 + !Bool -- True <=> no fvs + !ArgDescr -- Argument descriptor (should really be in ClosureInfo) + + | LFThunk -- Thunk (zero arity) + !TopLevelFlag + !Bool -- True <=> no free vars + !Bool -- True <=> updatable (i.e., *not* single-entry) + !StandardFormInfo + !Bool -- True <=> *might* be a function type + + | LFCon -- A saturated constructor application + !DataCon -- The constructor + + | LFUnknown -- Used for function arguments and imported things. + -- We know nothing about this closure. + -- Treat like updatable "LFThunk"... + -- Imported things which we *do* know something about use + -- one of the other LF constructors (eg LFReEntrant for + -- known functions) + !Bool -- True <=> *might* be a function type + -- The False case is good when we want to enter it, + -- because then we know the entry code will do + -- For a function, the entry code is the fast entry point + + | LFUnlifted -- A value of unboxed type; + -- always a value, needs evaluation + + | LFLetNoEscape -- See LetNoEscape module for precise description + +instance Outputable LambdaFormInfo where + ppr (LFReEntrant top oneshot rep fvs argdesc) = + text "LFReEntrant" <> brackets (ppr top <+> ppr oneshot <+> + ppr rep <+> pprFvs fvs <+> ppr argdesc) + ppr (LFThunk top hasfv updateable sfi m_function) = + text "LFThunk" <> brackets (ppr top <+> pprFvs hasfv <+> pprUpdateable updateable <+> + ppr sfi <+> pprFuncFlag m_function) + ppr (LFCon con) = text "LFCon" <> brackets (ppr con) + ppr (LFUnknown m_func) = + text "LFUnknown" <> brackets (pprFuncFlag m_func) + ppr LFUnlifted = text "LFUnlifted" + ppr LFLetNoEscape = text "LFLetNoEscape" + +pprFvs :: Bool -> SDoc +pprFvs True = text "no-fvs" +pprFvs False = text "fvs" + +pprFuncFlag :: Bool -> SDoc +pprFuncFlag True = text "mFunc" +pprFuncFlag False = text "value" + +pprUpdateable :: Bool -> SDoc +pprUpdateable True = text "updateable" +pprUpdateable False = text "oneshot" + +-------------------------------------------------------------------------------- + +-- | We represent liveness bitmaps as a Bitmap (whose internal representation +-- really is a bitmap). These are pinned onto case return vectors to indicate +-- the state of the stack for the garbage collector. +-- +-- In the compiled program, liveness bitmaps that fit inside a single word +-- (StgWord) are stored as a single word, while larger bitmaps are stored as a +-- pointer to an array of words. + +type Liveness = [Bool] -- One Bool per word; True <=> non-ptr or dead + -- False <=> ptr + +-------------------------------------------------------------------------------- +-- | An ArgDescr describes the argument pattern of a function + +data ArgDescr + = ArgSpec -- Fits one of the standard patterns + !Int -- RTS type identifier ARG_P, ARG_N, ... + + | ArgGen -- General case + Liveness -- Details about the arguments + + | ArgUnknown -- For imported binds. + -- Invariant: Never Unknown for binds of the module + -- we are compiling. + deriving (Eq) + +instance Outputable ArgDescr where + ppr (ArgSpec n) = text "ArgSpec" <+> ppr n + ppr (ArgGen ls) = text "ArgGen" <+> ppr ls + ppr ArgUnknown = text "ArgUnknown" + +-------------------------------------------------------------------------------- +-- | StandardFormInfo tells whether this thunk has one of a small number of +-- standard forms + +data StandardFormInfo + = NonStandardThunk + -- The usual case: not of the standard forms + + | SelectorThunk + -- A SelectorThunk is of form + -- case x of + -- con a1,..,an -> ak + -- and the constructor is from a single-constr type. + WordOff -- 0-origin offset of ak within the "goods" of + -- constructor (Recall that the a1,...,an may be laid + -- out in the heap in a non-obvious order.) + + | ApThunk + -- An ApThunk is of form + -- x1 ... xn + -- The code for the thunk just pushes x2..xn on the stack and enters x1. + -- There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled + -- in the RTS to save space. + RepArity -- Arity, n + deriving (Eq) + +instance Outputable StandardFormInfo where + ppr NonStandardThunk = text "RegThunk" + ppr (SelectorThunk w) = text "SelThunk:" <> ppr w + ppr (ApThunk n) = text "ApThunk:" <> ppr n ===================================== compiler/basicTypes/Id.hs ===================================== @@ -92,7 +92,7 @@ module Id ( idCallArity, idFunRepArity, idUnfolding, realIdUnfolding, idSpecialisation, idCoreRules, idHasRules, - idCafInfo, + idCafInfo, idLFInfo, idLFInfo_maybe, idOneShotInfo, idStateHackOneShotInfo, idOccInfo, isNeverLevPolyId, @@ -105,6 +105,7 @@ module Id ( setIdSpecialisation, setIdCafInfo, setIdOccInfo, zapIdOccInfo, + setIdLFInfo, setIdDemandInfo, setIdStrictness, @@ -731,6 +732,19 @@ idCafInfo id = cafInfo (idInfo id) setIdCafInfo :: Id -> CafInfo -> Id setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id + --------------------------------- + -- Lambda form info +idLFInfo :: HasCallStack => Id -> LambdaFormInfo +idLFInfo id = case lfInfo (idInfo id) of + Nothing -> pprPanic "idLFInfo" (text "LFInfo not available for Id" <+> ppr id) + Just lf_info -> lf_info + +idLFInfo_maybe :: Id -> Maybe LambdaFormInfo +idLFInfo_maybe = lfInfo . idInfo + +setIdLFInfo :: Id -> LambdaFormInfo -> Id +setIdLFInfo id lf = modifyIdInfo (`setLFInfo` lf) id + --------------------------------- -- Occurrence INFO idOccInfo :: Id -> OccInfo ===================================== compiler/basicTypes/IdInfo.hs ===================================== @@ -74,6 +74,10 @@ module IdInfo ( ppCafInfo, mayHaveCafRefs, cafInfo, setCafInfo, + -- ** The LambdaFormInfo type + LambdaFormInfo(..), + lfInfo, setLFInfo, + -- ** Tick-box Info TickBoxOp(..), TickBoxId, @@ -104,6 +108,8 @@ import Demand import Cpr import Util +import GHC.StgToCmm.Types (LambdaFormInfo (..)) + -- infixl so you can say (id `set` a `set` b) infixl 1 `setRuleInfo`, `setArityInfo`, @@ -270,8 +276,9 @@ data IdInfo -- ^ 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 + levityInfo :: LevityInfo, -- ^ when applied, will this Id ever have a levity-polymorphic type? + lfInfo :: !(Maybe LambdaFormInfo) } -- Setters @@ -294,13 +301,18 @@ setUnfoldingInfo info uf setArityInfo :: IdInfo -> ArityInfo -> IdInfo setArityInfo info ar = info { arityInfo = ar } + setCallArityInfo :: IdInfo -> ArityInfo -> IdInfo setCallArityInfo info ar = info { callArityInfo = ar } + setCafInfo :: IdInfo -> CafInfo -> IdInfo -setCafInfo info caf = info { cafInfo = caf } +setCafInfo info caf = info { cafInfo = caf } + +setLFInfo :: IdInfo -> LambdaFormInfo -> IdInfo +setLFInfo info lf = info { lfInfo = Just lf } setOneShotInfo :: IdInfo -> OneShotInfo -> IdInfo -setOneShotInfo info lb = {-lb `seq`-} info { oneShotInfo = lb } +setOneShotInfo info lb = {-lb `seq`-} info { oneShotInfo = lb } setDemandInfo :: IdInfo -> Demand -> IdInfo setDemandInfo info dd = dd `seq` info { demandInfo = dd } @@ -326,7 +338,8 @@ vanillaIdInfo strictnessInfo = nopSig, cprInfo = topCprSig, callArityInfo = unknownArity, - levityInfo = NoLevityInfo + levityInfo = NoLevityInfo, + lfInfo = Nothing } -- | More informative 'IdInfo' we can use when we know the 'Id' has no CAF references ===================================== compiler/ghc.cabal.in ===================================== @@ -229,7 +229,7 @@ Library SrcLoc UniqSupply Unique - UpdateCafInfos + UpdateIdInfos Var VarEnv VarSet @@ -298,6 +298,7 @@ Library GHC.StgToCmm.Ticky GHC.StgToCmm.Utils GHC.StgToCmm.ExtCode + GHC.StgToCmm.Types GHC.Runtime.Heap.Layout GHC.Core.Arity GHC.Core.FVs ===================================== compiler/main/UpdateCafInfos.hs → compiler/main/UpdateIdInfos.hs ===================================== @@ -1,7 +1,7 @@ {-# LANGUAGE CPP, BangPatterns, Strict, RecordWildCards #-} -module UpdateCafInfos - ( updateModDetailsCafInfos +module UpdateIdInfos + ( updateModDetailsIdInfos ) where import GhcPrelude @@ -17,22 +17,23 @@ import NameSet import Util import Var import Outputable +import GHC.StgToCmm.Types (ModuleLFInfos) #include "HsVersions.h" --- | Update CafInfos of all occurences (in rules, unfoldings, class instances) -updateModDetailsCafInfos +-- | Update CafInfos and LFInfos of all occurences (in rules, unfoldings, class instances) +updateModDetailsIdInfos :: DynFlags -> NameSet -- ^ Non-CAFFY names in the module. Names not in this set are CAFFY. + -> ModuleLFInfos -> ModDetails -- ^ ModDetails to update -> ModDetails -updateModDetailsCafInfos dflags _ mod_details +updateModDetailsIdInfos dflags _ _ mod_details | gopt Opt_OmitInterfacePragmas dflags = mod_details -updateModDetailsCafInfos _ non_cafs mod_details = - {- pprTrace "updateModDetailsCafInfos" (text "non_cafs:" <+> ppr non_cafs) $ -} +updateModDetailsIdInfos _ non_cafs lf_infos mod_details = let ModDetails{ md_types = type_env -- for unfoldings , md_insts = insts @@ -40,11 +41,11 @@ updateModDetailsCafInfos _ non_cafs mod_details = } = mod_details -- type TypeEnv = NameEnv TyThing - ~type_env' = mapNameEnv (updateTyThingCafInfos type_env' non_cafs) type_env + ~type_env' = mapNameEnv (updateTyThingCafInfos type_env' non_cafs lf_infos) type_env -- Not strict! - !insts' = strictMap (updateInstCafInfos type_env' non_cafs) insts - !rules' = strictMap (updateRuleCafInfos type_env') rules + !insts' = strictMap (updateInstIdInfos type_env' non_cafs lf_infos) insts + !rules' = strictMap (updateRuleIdInfos type_env') rules in mod_details{ md_types = type_env' , md_insts = insts' @@ -55,28 +56,28 @@ updateModDetailsCafInfos _ non_cafs mod_details = -- Rules -------------------------------------------------------------------------------- -updateRuleCafInfos :: TypeEnv -> CoreRule -> CoreRule -updateRuleCafInfos _ rule at BuiltinRule{} = rule -updateRuleCafInfos type_env Rule{ .. } = Rule { ru_rhs = updateGlobalIds type_env ru_rhs, .. } +updateRuleIdInfos :: TypeEnv -> CoreRule -> CoreRule +updateRuleIdInfos _ rule at BuiltinRule{} = rule +updateRuleIdInfos type_env Rule{ .. } = Rule { ru_rhs = updateGlobalIds type_env ru_rhs, .. } -------------------------------------------------------------------------------- -- Instances -------------------------------------------------------------------------------- -updateInstCafInfos :: TypeEnv -> NameSet -> ClsInst -> ClsInst -updateInstCafInfos type_env non_cafs = - updateClsInstDFun (updateIdUnfolding type_env . updateIdCafInfo non_cafs) +updateInstIdInfos :: TypeEnv -> NameSet -> ModuleLFInfos -> ClsInst -> ClsInst +updateInstIdInfos type_env non_cafs lf_infos = + updateClsInstDFun (updateIdUnfolding type_env . updateIdInfo non_cafs lf_infos) -------------------------------------------------------------------------------- -- TyThings -------------------------------------------------------------------------------- -updateTyThingCafInfos :: TypeEnv -> NameSet -> TyThing -> TyThing +updateTyThingCafInfos :: TypeEnv -> NameSet -> ModuleLFInfos -> TyThing -> TyThing -updateTyThingCafInfos type_env non_cafs (AnId id) = - AnId (updateIdUnfolding type_env (updateIdCafInfo non_cafs id)) +updateTyThingCafInfos type_env non_cafs lf_infos (AnId id) = + AnId (updateIdUnfolding type_env (updateIdInfo non_cafs lf_infos id)) -updateTyThingCafInfos _ _ other = other -- AConLike, ATyCon, ACoAxiom +updateTyThingCafInfos _ _ _ other = other -- AConLike, ATyCon, ACoAxiom -------------------------------------------------------------------------------- -- Unfoldings @@ -95,13 +96,18 @@ updateIdUnfolding type_env id = -- Expressions -------------------------------------------------------------------------------- -updateIdCafInfo :: NameSet -> Id -> Id -updateIdCafInfo non_cafs id - | idName id `elemNameSet` non_cafs - = -- pprTrace "updateIdCafInfo" (text "Marking" <+> ppr id <+> parens (ppr (idName id)) <+> text "as non-CAFFY") $ - id `setIdCafInfo` NoCafRefs - | otherwise - = id +updateIdInfo :: NameSet -> ModuleLFInfos -> Id -> Id +updateIdInfo non_cafs lf_infos id = + let + not_caffy = elemNameSet (idName id) non_cafs + mb_lf_info = lookupNameEnv lf_infos (idName id) + + id1 = if not_caffy then setIdCafInfo id NoCafRefs else id + id2 = case mb_lf_info of + Nothing -> id1 + Just lf_info -> setIdLFInfo id1 lf_info + in + id2 -------------------------------------------------------------------------------- ===================================== testsuite/tests/codeGen/should_compile/Makefile ===================================== @@ -64,10 +64,10 @@ T17648: # NoCafRefs) to the interface files. '$(TEST_HC)' $(TEST_HC_OPTS) -dno-typeable-binds -O T17648.hs -v0 '$(TEST_HC)' --show-iface T17648.hi | tr -d '\n' | \ - grep -F 'f :: T GHC.Types.Int -> () [HasNoCafRefs, Arity' >/dev/null + grep -F 'f :: T GHC.Types.Int -> () [HasNoCafRefs, LambdaFormInfo' >/dev/null # Second compilation with -fcatch-bottoms, f should be CAFFY '$(TEST_HC)' $(TEST_HC_OPTS) -dno-typeable-binds -O \ -fcatch-bottoms T17648.hs -v0 -fforce-recomp '$(TEST_HC)' --show-iface T17648.hi | tr -d '\n' | \ - grep -F 'f :: T GHC.Types.Int -> () [Arity: 1, Strictness' >/dev/null + grep -F 'f :: T GHC.Types.Int -> () [LambdaFormInfo' >/dev/null ===================================== testsuite/tests/codeGen/should_compile/cg009/A.hs ===================================== @@ -0,0 +1,5 @@ +module A where + +newtype A = A Int + +val = A 42 ===================================== testsuite/tests/codeGen/should_compile/cg009/Main.hs ===================================== @@ -0,0 +1,7 @@ +module Main where + +import A + +main = return () + +a = val ===================================== testsuite/tests/codeGen/should_compile/cg009/Makefile ===================================== @@ -0,0 +1,9 @@ +TOP=../../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +# Make sure the LFInfo for an exported, but not directly used newtype +# constructors does not trip up the compiler. +cg009: + '$(TEST_HC)' $(TEST_HC_OPTS) -c -O A.hs -fforce-recomp + '$(TEST_HC)' $(TEST_HC_OPTS) -c -O0 Main.hs -fforce-recomp ===================================== testsuite/tests/codeGen/should_compile/cg009/all.T ===================================== @@ -0,0 +1 @@ +test('cg009', [extra_files(['A.hs','Main.hs'])], makefile_test, ['cg009']) ===================================== testsuite/tests/codeGen/should_compile/cg010/A.hs ===================================== @@ -0,0 +1,4 @@ +module A where + +{-# NOINLINE val #-} +val = Just 42 ===================================== testsuite/tests/codeGen/should_compile/cg010/Main.hs ===================================== @@ -0,0 +1,8 @@ +module Main where + +import A + +main = return () + +a = val + ===================================== testsuite/tests/codeGen/should_compile/cg010/Makefile ===================================== @@ -0,0 +1,9 @@ +TOP=../../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +# Make sure LFInfo causes the imported reference to val to get tagged. +cg010: + '$(TEST_HC)' $(TEST_HC_OPTS) -c -O A.hs -fforce-recomp + '$(TEST_HC)' $(TEST_HC_OPTS) -c -O Main.hs -fforce-recomp -ddump-cmm -ddump-to-file + grep "A.val_closure+2" Main.dump-cmm ===================================== testsuite/tests/codeGen/should_compile/cg010/all.T ===================================== @@ -0,0 +1 @@ +test('cg010', [extra_files(['A.hs','Main.hs'])], makefile_test, ['cg010']) ===================================== testsuite/tests/codeGen/should_compile/cg010/cg010.stdout ===================================== @@ -0,0 +1 @@ + const A.val_closure+2; ===================================== testsuite/tests/simplCore/should_compile/Makefile ===================================== @@ -102,7 +102,7 @@ T4201: '$(TEST_HC)' $(TEST_HC_OPTS) -c -O T4201.hs '$(TEST_HC)' $(TEST_HC_OPTS) --show-iface T4201.hi > T4201.list # poor man idea about how to replace GNU grep -B2 "Sym" invocation with pure POSIX tools - for i in `grep -n "Sym" T4201.list |cut -d ':' -f -1`; do head -$$i T4201.list | tail -3 ; done + for i in `grep -n "Sym" T4201.list | cut -d ':' -f -1`; do head -$$i T4201.list | tail -5; done $(RM) -f T4201.list # This one looped as a result of bogus specialisation ===================================== testsuite/tests/simplCore/should_compile/T4201.stdout ===================================== @@ -1,3 +1,5 @@ - [HasNoCafRefs, Arity: 1, Strictness: , CPR: m1, + [HasNoCafRefs, + LambdaFormInfo: LFReEntrant (NoOneShotInfo, 1, True), Arity: 1, + Strictness: , CPR: m1, Unfolding: InlineRule (0, True, True) bof `cast` (Sym (N:Foo[0]) ->_R _R)] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6e26c7831729d9864e23891db5b8ecbd5b798553 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6e26c7831729d9864e23891db5b8ecbd5b798553 You're receiving 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 Mar 25 07:03:38 2020 From: gitlab at gitlab.haskell.org (=?UTF-8?B?w5ZtZXIgU2luYW4gQcSfYWNhbg==?=) Date: Wed, 25 Mar 2020 03:03:38 -0400 Subject: [Git][ghc/ghc][wip/osa1/lfinfo] Cross-module LambdaFormInfo passing Message-ID: <5e7b024a6a904_61674f59d90460965@gitlab.haskell.org.mail> Ömer Sinan Ağacan pushed to branch wip/osa1/lfinfo at Glasgow Haskell Compiler / GHC Commits: ccd09ef4 by Ömer Sinan Ağacan at 2020-03-25T10:03:25+03:00 Cross-module LambdaFormInfo passing - Store LambdaFormInfos of exported Ids in interface files - Use them in importing modules - - - - - 29 changed files: - compiler/GHC/CoreToIface.hs - compiler/GHC/Driver/Hooks.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Runtime/Heap/Layout.hs - compiler/GHC/StgToCmm.hs - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/StgToCmm/Env.hs - + compiler/GHC/StgToCmm/Types.hs - compiler/basicTypes/Id.hs - compiler/basicTypes/IdInfo.hs - compiler/ghc.cabal.in - compiler/main/UpdateCafInfos.hs → compiler/main/UpdateIdInfos.hs - testsuite/tests/codeGen/should_compile/Makefile - + testsuite/tests/codeGen/should_compile/cg009/A.hs - + testsuite/tests/codeGen/should_compile/cg009/Main.hs - + testsuite/tests/codeGen/should_compile/cg009/Makefile - + testsuite/tests/codeGen/should_compile/cg009/all.T - + testsuite/tests/codeGen/should_compile/cg010/A.hs - + testsuite/tests/codeGen/should_compile/cg010/Main.hs - + testsuite/tests/codeGen/should_compile/cg010/Makefile - + testsuite/tests/codeGen/should_compile/cg010/all.T - + testsuite/tests/codeGen/should_compile/cg010/cg010.stdout - testsuite/tests/simplCore/should_compile/Makefile - testsuite/tests/simplCore/should_compile/T4201.stdout Changes: ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -34,13 +34,14 @@ module GHC.CoreToIface , toIfaceIdDetails , toIfaceIdInfo , toIfUnfolding - , toIfaceOneShot , toIfaceTickish , toIfaceBind , toIfaceAlt , toIfaceCon , toIfaceApp , toIfaceVar + -- * Other stuff + , toIfaceLFInfo ) where #include "HsVersions.h" @@ -49,6 +50,7 @@ import GhcPrelude import GHC.Iface.Syntax import GHC.Core.DataCon +import GHC.StgToCmm.Types import Id import IdInfo import GHC.Core @@ -74,6 +76,8 @@ import Demand ( isTopSig ) import Cpr ( topCprSig ) import Data.Maybe ( catMaybes ) +import Data.Word +import Data.Bits {- Note [Avoiding space leaks in toIface*] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -616,6 +620,43 @@ toIfaceVar v where name = idName v +--------------------- +toIfaceLFInfo :: LambdaFormInfo -> IfaceLFInfo +toIfaceLFInfo lfi = case lfi of + LFReEntrant _ _ arity _ _ -> + IfLFReEntrant arity + LFThunk _ _ updatable sfi mb_fun -> + IfLFThunk updatable (toIfaceStandardFormInfo sfi) mb_fun + LFCon dc -> + IfLFCon (dataConName dc) + LFUnknown mb_fun -> + IfLFUnknown mb_fun + LFUnlifted -> + IfLFUnlifted + LFLetNoEscape -> + panic "toIfaceLFInfo: LFLetNoEscape" + +toIfaceStandardFormInfo :: StandardFormInfo -> IfaceStandardFormInfo +toIfaceStandardFormInfo NonStandardThunk = IfStandardFormInfo 1 +toIfaceStandardFormInfo sf = + IfStandardFormInfo $! + tag sf .|. encodeField (field sf) + where + tag SelectorThunk{} = 0 + tag ApThunk{} = setBit 0 1 + tag NonStandardThunk = panic "toIfaceStandardFormInfo: NonStandardThunk" + + field (SelectorThunk n) = n + field (ApThunk n) = n + field NonStandardThunk = panic "toIfaceStandardFormInfo: NonStandardThunk" + + encodeField n = + let wn = fromIntegral n :: Word + shifted = wn `unsafeShiftL` 2 + in ASSERT(shifted > 0 && shifted < fromIntegral (maxBound :: Word16)) + (fromIntegral shifted :: Word16) + + {- Note [Inlining and hs-boot files] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider this example (#10083, #12789): ===================================== compiler/GHC/Driver/Hooks.hs ===================================== @@ -55,6 +55,7 @@ import GHC.Stg.Syntax import Stream import GHC.Cmm import GHC.Hs.Extension +import GHC.StgToCmm.Types (ModuleLFInfos) import Data.Maybe @@ -109,7 +110,7 @@ data Hooks = Hooks -> IO (Maybe HValue)) , createIservProcessHook :: Maybe (CreateProcess -> IO ProcessHandle) , stgToCmmHook :: Maybe (DynFlags -> Module -> [TyCon] -> CollectedCCs - -> [CgStgTopBinding] -> HpcInfo -> Stream IO CmmGroup ()) + -> [CgStgTopBinding] -> HpcInfo -> Stream IO CmmGroup ModuleLFInfos) , cmmToRawCmmHook :: forall a . Maybe (DynFlags -> Maybe Module -> Stream IO CmmGroupSRTs a -> IO (Stream IO RawCmmGroup a)) } ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -162,6 +162,7 @@ import Bag import Exception import qualified Stream import Stream (Stream) +import GHC.StgToCmm.Types (ModuleLFInfos) import Util @@ -176,6 +177,7 @@ import qualified Data.Set as S import Data.Set (Set) import Data.Functor import Control.DeepSeq (force) +import Data.Bifunctor (first) import GHC.Iface.Ext.Ast ( mkHieFile ) import GHC.Iface.Ext.Types ( getAsts, hie_asts, hie_module ) @@ -1392,7 +1394,7 @@ hscWriteIface dflags iface no_change mod_location = do -- | Compile to hard-code. hscGenHardCode :: HscEnv -> CgGuts -> ModLocation -> FilePath - -> IO (FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)], NameSet) + -> IO (FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)], NameSet, ModuleLFInfos) -- ^ @Just f@ <=> _stub.c is f hscGenHardCode hsc_env cgguts location output_filename = do let CgGuts{ -- This is the last use of the ModGuts in a compilation. @@ -1451,11 +1453,11 @@ hscGenHardCode hsc_env cgguts location output_filename = do return a rawcmms1 = Stream.mapM dump rawcmms0 - (output_filename, (_stub_h_exists, stub_c_exists), foreign_fps, caf_infos) + (output_filename, (_stub_h_exists, stub_c_exists), foreign_fps, (caf_infos, lf_infos)) <- {-# SCC "codeOutput" #-} codeOutput dflags this_mod output_filename location foreign_stubs foreign_files dependencies rawcmms1 - return (output_filename, stub_c_exists, foreign_fps, caf_infos) + return (output_filename, stub_c_exists, foreign_fps, caf_infos, lf_infos) hscInteractive :: HscEnv @@ -1549,7 +1551,7 @@ doCodeGen :: HscEnv -> Module -> [TyCon] -> CollectedCCs -> [StgTopBinding] -> HpcInfo - -> IO (Stream IO CmmGroupSRTs NameSet) + -> IO (Stream IO CmmGroupSRTs (NameSet, ModuleLFInfos)) -- Note we produce a 'Stream' of CmmGroups, so that the -- backend can be run incrementally. Otherwise it generates all -- the C-- up front, which has a significant space cost. @@ -1561,7 +1563,7 @@ doCodeGen hsc_env this_mod data_tycons dumpIfSet_dyn dflags Opt_D_dump_stg_final "Final STG:" FormatSTG (pprGenStgTopBindings stg_binds_w_fvs) - let cmm_stream :: Stream IO CmmGroup () + let cmm_stream :: Stream IO CmmGroup ModuleLFInfos -- See Note [Forcing of stg_binds] cmm_stream = stg_binds_w_fvs `seqList` {-# SCC "StgToCmm" #-} lookupHook stgToCmmHook StgToCmm.codeGen dflags dflags this_mod data_tycons @@ -1580,10 +1582,11 @@ doCodeGen hsc_env this_mod data_tycons ppr_stream1 = Stream.mapM dump1 cmm_stream + pipeline_stream :: Stream IO CmmGroupSRTs (NameSet, ModuleLFInfos) pipeline_stream = {-# SCC "cmmPipeline" #-} - Stream.mapAccumL (cmmPipeline hsc_env) (emptySRT this_mod) ppr_stream1 - <&> (srtMapNonCAFs . moduleSRTMap) + Stream.mapAccumL_ (cmmPipeline hsc_env) (emptySRT this_mod) ppr_stream1 + <&> (first (srtMapNonCAFs . moduleSRTMap)) dump2 a = do unless (null a) $ ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -69,8 +69,8 @@ import FileCleanup import Ar import Bag ( unitBag ) import FastString ( mkFastString ) -import GHC.Iface.Make ( mkFullIface ) -import UpdateCafInfos ( updateModDetailsCafInfos ) +import GHC.Iface.Make ( mkFullIface ) +import UpdateIdInfos ( updateModDetailsIdInfos ) import Exception import System.Directory @@ -1192,12 +1192,12 @@ runPhase (HscOut src_flavour mod_name result) _ dflags = do PipeState{hsc_env=hsc_env'} <- getPipeState - (outputFilename, mStub, foreign_files, caf_infos) <- liftIO $ + (outputFilename, mStub, foreign_files, caf_infos, lf_infos) <- liftIO $ hscGenHardCode hsc_env' cgguts mod_location output_fn - final_iface <- liftIO (mkFullIface hsc_env'{hsc_dflags=iface_dflags} partial_iface (Just caf_infos)) - let final_mod_details = {-# SCC updateModDetailsCafInfos #-} - updateModDetailsCafInfos iface_dflags caf_infos mod_details + final_iface <- liftIO (mkFullIface hsc_env'{hsc_dflags=iface_dflags} partial_iface (Just (caf_infos, lf_infos))) + let final_mod_details = {-# SCC updateModDetailsIdInfos #-} + updateModDetailsIdInfos iface_dflags caf_infos lf_infos mod_details setIface final_iface final_mod_details -- See Note [Writing interface files] ===================================== compiler/GHC/Iface/Make.hs ===================================== @@ -38,6 +38,7 @@ import GHC.Core.Coercion.Axiom import GHC.Core.ConLike import GHC.Core.DataCon import GHC.Core.Type +import GHC.StgToCmm.Types (ModuleLFInfos) import TcType import GHC.Core.InstEnv import GHC.Core.FamInstEnv @@ -100,13 +101,13 @@ mkPartialIface hsc_env mod_details -- | Fully instantiate a interface -- Adds fingerprints and potentially code generator produced information. -mkFullIface :: HscEnv -> PartialModIface -> Maybe NameSet -> IO ModIface -mkFullIface hsc_env partial_iface mb_non_cafs = do +mkFullIface :: HscEnv -> PartialModIface -> Maybe (NameSet, ModuleLFInfos) -> IO ModIface +mkFullIface hsc_env partial_iface mb_id_infos = do let decls | gopt Opt_OmitInterfacePragmas (hsc_dflags hsc_env) = mi_decls partial_iface | otherwise - = updateDeclCafInfos (mi_decls partial_iface) mb_non_cafs + = updateDecl (mi_decls partial_iface) mb_id_infos full_iface <- {-# SCC "addFingerprints" #-} @@ -117,15 +118,23 @@ mkFullIface hsc_env partial_iface mb_non_cafs = do return full_iface -updateDeclCafInfos :: [IfaceDecl] -> Maybe NameSet -> [IfaceDecl] -updateDeclCafInfos decls Nothing = decls -updateDeclCafInfos decls (Just non_cafs) = map update_decl decls +updateDecl :: [IfaceDecl] -> Maybe (NameSet, ModuleLFInfos) -> [IfaceDecl] +updateDecl decls Nothing = decls +updateDecl decls (Just (non_cafs, lf_infos)) = map update_decl decls where + update_decl (IfaceId nm ty details infos) + | let not_caffy = elemNameSet nm non_cafs + , let mb_lf_info = lookupNameEnv lf_infos nm + , WARN( isNothing mb_lf_info, text "Name without LFInfo:" <+> ppr nm ) True + -- Only allocate a new IfaceId if we're going to update the infos + , isJust mb_lf_info || not_caffy + = IfaceId nm ty details $ + (if not_caffy then (HsNoCafRefs :) else id) + (case mb_lf_info of + Nothing -> infos + Just lf_info -> HsLFInfo (toIfaceLFInfo lf_info) : infos) + update_decl decl - | IfaceId nm ty details infos <- decl - , elemNameSet nm non_cafs - = IfaceId nm ty details (HsNoCafRefs : infos) - | otherwise = decl -- | Make an interface from the results of typechecking only. Useful ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -22,6 +22,8 @@ module GHC.Iface.Syntax ( IfaceAxBranch(..), IfaceTyConParent(..), IfaceCompleteMatch(..), + IfaceLFInfo(..), + IfaceStandardFormInfo(..), -- * Binding names IfaceTopBndr, @@ -30,6 +32,7 @@ module GHC.Iface.Syntax ( -- Misc ifaceDeclImplicitBndrs, visibleIfConDecls, ifaceDeclFingerprints, + tcStandardFormInfo, -- Free Names freeNamesIfDecl, freeNamesIfRule, freeNamesIfFamInst, @@ -72,10 +75,13 @@ import GHC.Core.DataCon (SrcStrictness(..), SrcUnpackedness(..)) import Lexeme (isLexSym) import TysWiredIn ( constraintKindTyConName ) import Util (seqList) +import GHC.StgToCmm.Types import Control.Monad import System.IO.Unsafe import Control.DeepSeq +import Data.Word +import Data.Bits infixl 3 &&& @@ -114,7 +120,8 @@ data IfaceDecl = IfaceId { ifName :: IfaceTopBndr, ifType :: IfaceType, ifIdDetails :: IfaceIdDetails, - ifIdInfo :: IfaceIdInfo } + ifIdInfo :: IfaceIdInfo + } | IfaceData { ifName :: IfaceTopBndr, -- Type constructor ifBinders :: [IfaceTyConBinder], @@ -348,6 +355,7 @@ data IfaceInfoItem IfaceUnfolding -- See Note [Expose recursive functions] | HsNoCafRefs | HsLevity -- Present <=> never levity polymorphic + | HsLFInfo IfaceLFInfo -- NB: Specialisations and rules come in separately and are -- only later attached to the Id. Partial reason: some are orphans. @@ -379,6 +387,74 @@ data IfaceIdDetails | IfRecSelId (Either IfaceTyCon IfaceDecl) Bool | IfDFunId +-- | Iface type for LambdaFormInfo. Fields not relevant for imported Ids are +-- omitted in this type. +data IfaceLFInfo + = IfLFReEntrant !RepArity + | IfLFThunk !Bool !IfaceStandardFormInfo !Bool + | IfLFCon !Name + | IfLFUnknown !Bool + | IfLFUnlifted + +tcStandardFormInfo :: IfaceStandardFormInfo -> StandardFormInfo +tcStandardFormInfo (IfStandardFormInfo w) + | testBit w 0 = NonStandardThunk + | otherwise = con field + where + field = fromIntegral (w `unsafeShiftR` 2) + con + | testBit w 1 = ApThunk + | otherwise = SelectorThunk + +instance Outputable IfaceLFInfo where + ppr (IfLFReEntrant arity) = + text "LFReEntrant" <+> ppr arity + + ppr (IfLFThunk updatable sfi mb_fun) = + text "LFThunk" <+> ppr (updatable, tcStandardFormInfo sfi, mb_fun) + + ppr (IfLFCon con) = + text "LFCon" <> brackets (ppr con) + + ppr IfLFUnlifted = + text "LFUnlifted" + + ppr (IfLFUnknown fun_flag) = + text "LFUnknown" <+> ppr fun_flag + +newtype IfaceStandardFormInfo = IfStandardFormInfo Word16 + +instance Binary IfaceStandardFormInfo where + put_ bh (IfStandardFormInfo w) = put_ bh (w :: Word16) + get bh = IfStandardFormInfo <$> (get bh :: IO Word16) + +instance Binary IfaceLFInfo where + put_ bh (IfLFReEntrant arity) = do + putByte bh 0 + put_ bh arity + put_ bh (IfLFThunk updatable sfi mb_fun) = do + putByte bh 1 + put_ bh updatable + put_ bh sfi + put_ bh mb_fun + put_ bh (IfLFCon con_name) = do + putByte bh 2 + put_ bh con_name + put_ bh (IfLFUnknown fun_flag) = do + putByte bh 3 + put_ bh fun_flag + put_ bh IfLFUnlifted = + putByte bh 4 + get bh = do + tag <- getByte bh + case tag of + 0 -> IfLFReEntrant <$> get bh + 1 -> IfLFThunk <$> get bh <*> get bh <*> get bh + 2 -> IfLFCon <$> get bh + 3 -> IfLFUnknown <$> get bh + 4 -> pure IfLFUnlifted + _ -> panic "Invalid byte" + {- Note [Versioning of instances] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1393,6 +1469,7 @@ instance Outputable IfaceInfoItem where ppr (HsCpr cpr) = text "CPR:" <+> ppr cpr ppr HsNoCafRefs = text "HasNoCafRefs" ppr HsLevity = text "Never levity-polymorphic" + ppr (HsLFInfo lf_info) = text "LambdaFormInfo:" <+> ppr lf_info instance Outputable IfaceJoinInfo where ppr IfaceNotJoinPoint = empty @@ -1853,7 +1930,7 @@ instance Binary IfaceDecl where get bh = do h <- getByte bh case h of - 0 -> do name <- get bh + 0 -> do name <- get bh ~(ty, details, idinfo) <- lazyGet bh -- See Note [Lazy deserialization of IfaceId] return (IfaceId name ty details idinfo) @@ -2153,6 +2230,8 @@ instance Binary IfaceInfoItem where put_ bh HsNoCafRefs = putByte bh 4 put_ bh HsLevity = putByte bh 5 put_ bh (HsCpr cpr) = putByte bh 6 >> put_ bh cpr + put_ bh (HsLFInfo lf_info) = putByte bh 7 >> put_ bh lf_info + get bh = do h <- getByte bh case h of @@ -2164,7 +2243,8 @@ instance Binary IfaceInfoItem where 3 -> liftM HsInline $ get bh 4 -> return HsNoCafRefs 5 -> return HsLevity - _ -> HsCpr <$> get bh + 6 -> HsCpr <$> get bh + _ -> HsLFInfo <$> get bh instance Binary IfaceUnfolding where put_ bh (IfCoreUnfold s e) = do @@ -2495,6 +2575,7 @@ instance NFData IfaceInfoItem where HsNoCafRefs -> () HsLevity -> () HsCpr cpr -> cpr `seq` () + HsLFInfo lf_info -> lf_info `seq` () -- TODO: seq further? instance NFData IfaceUnfolding where rnf = \case ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -122,6 +122,9 @@ data IfaceOneShot -- See Note [Preserve OneShotInfo] in CoreTicy = IfaceNoOneShot -- and Note [The oneShot function] in MkId | IfaceOneShot +instance Outputable IfaceOneShot where + ppr IfaceNoOneShot = text "NoOneShotInfo" + ppr IfaceOneShot = text "OneShot" {- %************************************************************************ ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -19,7 +19,8 @@ module GHC.IfaceToCore ( tcIfaceDecl, tcIfaceInst, tcIfaceFamInst, tcIfaceRules, tcIfaceAnnotations, tcIfaceCompleteSigs, tcIfaceExpr, -- Desired by HERMIT (#7683) - tcIfaceGlobal + tcIfaceGlobal, + tcIfaceOneShot ) where #include "HsVersions.h" @@ -30,6 +31,9 @@ import TcTypeNats(typeNatCoAxiomRules) import GHC.Iface.Syntax import GHC.Iface.Load import GHC.Iface.Env +import GHC.StgToCmm.Types +import GHC.StgToCmm.Closure +import GHC.Types.RepType import BuildTyCl import TcRnMonad import TcType @@ -641,7 +645,7 @@ tc_iface_decl _ ignore_prags (IfaceId {ifName = name, ifType = iface_type, = do { ty <- tcIfaceType iface_type ; details <- tcIdDetails ty details ; info <- tcIdInfo ignore_prags TopLevel name ty info - ; return (AnId (mkGlobalId details name ty info)) } + ; return (AnId (addIdLFInfo (mkGlobalId details name ty info))) } tc_iface_decl _ _ (IfaceData {ifName = tc_name, ifCType = cType, @@ -1340,7 +1344,8 @@ tcIfaceExpr (IfaceLet (IfaceNonRec (IfLetBndr fs ty info ji) rhs) body) ; ty' <- tcIfaceType ty ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -} NotTopLevel name ty' info - ; let id = mkLocalIdWithInfo name ty' id_info + ; let id = addIdLFInfo $ + mkLocalIdWithInfo name ty' id_info `asJoinId_maybe` tcJoinInfo ji ; rhs' <- tcIfaceExpr rhs ; body' <- extendIfaceIdEnv [id] (tcIfaceExpr body) @@ -1361,7 +1366,7 @@ tcIfaceExpr (IfaceLet (IfaceRec pairs) body) = do { rhs' <- tcIfaceExpr rhs ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -} NotTopLevel (idName id) (idType id) info - ; return (setIdInfo id id_info, rhs') } + ; return (addIdLFInfo (setIdInfo id id_info), rhs') } tcIfaceExpr (IfaceTick tickish expr) = do expr' <- tcIfaceExpr expr @@ -1465,8 +1470,7 @@ tcIdInfo ignore_prags toplvl name ty info = do let init_info | if_boot lcl_env = vanillaIdInfo `setUnfoldingInfo` BootUnfolding | otherwise = vanillaIdInfo - let needed = needed_prags info - foldlM tcPrag init_info needed + foldlM tcPrag init_info (needed_prags info) where needed_prags :: [IfaceInfoItem] -> [IfaceInfoItem] needed_prags items @@ -1486,6 +1490,9 @@ tcIdInfo ignore_prags toplvl name ty info = do tcPrag info (HsCpr cpr) = return (info `setCprInfo` cpr) tcPrag info (HsInline prag) = return (info `setInlinePragInfo` prag) tcPrag info HsLevity = return (info `setNeverLevPoly` ty) + tcPrag info (HsLFInfo lf_info) = do + lf_info <- tcLFInfo lf_info + return (info `setLFInfo` lf_info) -- The next two are lazy, so they don't transitively suck stuff in tcPrag info (HsUnfold lb if_unf) @@ -1494,10 +1501,55 @@ tcIdInfo ignore_prags toplvl name ty info = do | otherwise = info ; return (info1 `setUnfoldingInfo` unf) } +addIdLFInfo :: Id -> Id +addIdLFInfo id = case idLFInfo_maybe id of + Nothing -> setIdLFInfo id (mkLFImported (idDetails id) (idInfo id) (idType id)) + Just _ -> id + +-- Make a LambdaFormInfo for the Ids without a LFInfo in the iface file +mkLFImported :: IdDetails -> IdInfo -> Type -> LambdaFormInfo +mkLFImported details info ty + | DataConWorkId con <- details + , isNullaryRepDataCon con + = LFCon con -- An imported nullary constructor + -- We assume that the constructor is evaluated so that + -- the id really does point directly to the constructor + + | arity > 0 + = LFReEntrant TopLevel noOneShotInfo arity True ArgUnknown + + | isUnliftedType ty + = LFUnlifted + + | mightBeAFunction ty + = LFUnknown True + + | otherwise + = LFUnknown False + where + arity = countFunRepArgs (arityInfo info) ty + tcJoinInfo :: IfaceJoinInfo -> Maybe JoinArity tcJoinInfo (IfaceJoinPoint ar) = Just ar tcJoinInfo IfaceNotJoinPoint = Nothing +tcLFInfo :: IfaceLFInfo -> IfL LambdaFormInfo +tcLFInfo lfi = case lfi of + IfLFReEntrant rep_arity -> + return (LFReEntrant TopLevel NoOneShotInfo rep_arity True ArgUnknown) + + IfLFThunk updatable sfi mb_fun -> + return (LFThunk TopLevel True updatable (tcStandardFormInfo sfi) mb_fun) + + IfLFUnlifted -> + return LFUnlifted + + IfLFCon con_name -> + LFCon <$!> tcIfaceDataCon con_name + + IfLFUnknown fun_flag -> + return (LFUnknown fun_flag) + tcUnfolding :: TopLevelFlag -> Name -> Type -> IdInfo -> IfaceUnfolding -> IfL Unfolding tcUnfolding toplvl name _ info (IfCoreUnfold stable if_expr) = do { dflags <- getDynFlags @@ -1586,6 +1638,10 @@ tcPragExpr is_compulsory toplvl name expr -- It's OK to use nonDetEltsUFM here because we immediately forget -- the ordering by creating a set +tcIfaceOneShot :: IfaceOneShot -> OneShotInfo +tcIfaceOneShot IfaceNoOneShot = NoOneShotInfo +tcIfaceOneShot IfaceOneShot = OneShotLam + {- ************************************************************************ * * ===================================== compiler/GHC/Runtime/Heap/Layout.hs ===================================== @@ -51,6 +51,7 @@ import GHC.Driver.Session import Outputable import GHC.Platform import FastString +import GHC.StgToCmm.Types import Data.Word import Data.Bits @@ -64,9 +65,6 @@ import Data.ByteString (ByteString) ************************************************************************ -} --- | Word offset, or word count -type WordOff = Int - -- | Byte offset, or byte count type ByteOff = Int @@ -196,29 +194,6 @@ type ConstrDescription = ByteString -- result of dataConIdentity type FunArity = Int type SelectorOffset = Int -------------------------- --- We represent liveness bitmaps as a Bitmap (whose internal --- representation really is a bitmap). These are pinned onto case return --- vectors to indicate the state of the stack for the garbage collector. --- --- In the compiled program, liveness bitmaps that fit inside a single --- word (StgWord) are stored as a single word, while larger bitmaps are --- stored as a pointer to an array of words. - -type Liveness = [Bool] -- One Bool per word; True <=> non-ptr or dead - -- False <=> ptr - -------------------------- --- An ArgDescr describes the argument pattern of a function - -data ArgDescr - = ArgSpec -- Fits one of the standard patterns - !Int -- RTS type identifier ARG_P, ARG_N, ... - - | ArgGen -- General case - Liveness -- Details about the arguments - - ----------------------------------------------------------------------------- -- Construction @@ -545,10 +520,6 @@ instance Outputable SMRep where ppr (RTSRep ty rep) = text "tag:" <> ppr ty <+> ppr rep -instance Outputable ArgDescr where - ppr (ArgSpec n) = text "ArgSpec" <+> ppr n - ppr (ArgGen ls) = text "ArgGen" <+> ppr ls - pprTypeInfo :: ClosureTypeInfo -> SDoc pprTypeInfo (Constr tag descr) = text "Con" <+> ===================================== compiler/GHC/StgToCmm.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} +{-# LANGUAGE BangPatterns #-} ----------------------------------------------------------------------------- -- @@ -25,6 +26,7 @@ import GHC.StgToCmm.Utils import GHC.StgToCmm.Closure import GHC.StgToCmm.Hpc import GHC.StgToCmm.Ticky +import GHC.StgToCmm.Types (ModuleLFInfos) import GHC.Cmm import GHC.Cmm.CLabel @@ -45,6 +47,8 @@ import Outputable import Stream import BasicTypes import VarSet ( isEmptyDVarSet ) +import UniqFM +import NameEnv import OrdList import GHC.Cmm.Graph @@ -52,6 +56,7 @@ import GHC.Cmm.Graph import Data.IORef import Control.Monad (when,void) import Util +import Data.Maybe codeGen :: DynFlags -> Module @@ -59,7 +64,8 @@ codeGen :: DynFlags -> CollectedCCs -- (Local/global) cost-centres needing declaring/registering. -> [CgStgTopBinding] -- Bindings to convert -> HpcInfo - -> Stream IO CmmGroup () -- Output as a stream, so codegen can + -> Stream IO CmmGroup ModuleLFInfos + -- Output as a stream, so codegen can -- be interleaved with output codeGen dflags this_mod data_tycons @@ -101,6 +107,20 @@ codeGen dflags this_mod data_tycons mapM_ (cg . cgDataCon) (tyConDataCons tycon) ; mapM_ do_tycon data_tycons + + ; cg_id_infos <- cgs_binds <$> liftIO (readIORef cgref) + + -- Only external names are actually visible to codeGen. So they are the + -- only ones we care about. + ; let extractInfo info = lf `seq` Just (name,lf) + where + id = cg_id info + !name = idName id + lf = cg_lf info + + ; let !generatedInfo = mkNameEnv (mapMaybe extractInfo (eltsUFM cg_id_infos)) + + ; return $! generatedInfo } --------------------------------------------------------------- ===================================== compiler/GHC/StgToCmm/Closure.hs ===================================== @@ -24,7 +24,7 @@ module GHC.StgToCmm.Closure ( LambdaFormInfo, -- Abstract StandardFormInfo, -- ...ditto... mkLFThunk, mkLFReEntrant, mkConLFInfo, mkSelectorLFInfo, - mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape, + mkApLFInfo, mkLFArgument, mkLFLetNoEscape, mkLFStringLit, lfDynTag, isLFThunk, isLFReEntrant, lfUpdatable, @@ -51,6 +51,7 @@ module GHC.StgToCmm.Closure ( closureUpdReqd, closureSingleEntry, closureReEntrant, closureFunInfo, isToplevClosure, + mightBeAFunction, blackHoleOnEntry, -- Needs LambdaFormInfo and SMRep isStaticClosure, -- Needs SMPre @@ -70,6 +71,7 @@ import GHC.Stg.Syntax import GHC.Runtime.Heap.Layout import GHC.Cmm import GHC.Cmm.Ppr.Expr() -- For Outputable instances +import GHC.StgToCmm.Types import CostCentre import GHC.Cmm.BlockId @@ -188,86 +190,15 @@ addArgReps = map (\arg -> let arg' = fromNonVoid arg argPrimRep :: StgArg -> PrimRep argPrimRep arg = typePrimRep1 (stgArgType arg) - ------------------------------------------------------------------------------ --- LambdaFormInfo ------------------------------------------------------------------------------ - --- Information about an identifier, from the code generator's point of --- view. Every identifier is bound to a LambdaFormInfo in the --- environment, which gives the code generator enough info to be able to --- tail call or return that identifier. - -data LambdaFormInfo - = LFReEntrant -- Reentrant closure (a function) - TopLevelFlag -- True if top level - OneShotInfo - !RepArity -- Arity. Invariant: always > 0 - !Bool -- True <=> no fvs - ArgDescr -- Argument descriptor (should really be in ClosureInfo) - - | LFThunk -- Thunk (zero arity) - TopLevelFlag - !Bool -- True <=> no free vars - !Bool -- True <=> updatable (i.e., *not* single-entry) - StandardFormInfo - !Bool -- True <=> *might* be a function type - - | LFCon -- A saturated constructor application - DataCon -- The constructor - - | LFUnknown -- Used for function arguments and imported things. - -- We know nothing about this closure. - -- Treat like updatable "LFThunk"... - -- Imported things which we *do* know something about use - -- one of the other LF constructors (eg LFReEntrant for - -- known functions) - !Bool -- True <=> *might* be a function type - -- The False case is good when we want to enter it, - -- because then we know the entry code will do - -- For a function, the entry code is the fast entry point - - | LFUnlifted -- A value of unboxed type; - -- always a value, needs evaluation - - | LFLetNoEscape -- See LetNoEscape module for precise description - - -------------------------- --- StandardFormInfo tells whether this thunk has one of --- a small number of standard forms - -data StandardFormInfo - = NonStandardThunk - -- The usual case: not of the standard forms - - | SelectorThunk - -- A SelectorThunk is of form - -- case x of - -- con a1,..,an -> ak - -- and the constructor is from a single-constr type. - WordOff -- 0-origin offset of ak within the "goods" of - -- constructor (Recall that the a1,...,an may be laid - -- out in the heap in a non-obvious order.) - - | ApThunk - -- An ApThunk is of form - -- x1 ... xn - -- The code for the thunk just pushes x2..xn on the stack and enters x1. - -- There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled - -- in the RTS to save space. - RepArity -- Arity, n - - ------------------------------------------------------ -- Building LambdaFormInfo ------------------------------------------------------ mkLFArgument :: Id -> LambdaFormInfo mkLFArgument id - | isUnliftedType ty = LFUnlifted - | might_be_a_function ty = LFUnknown True - | otherwise = LFUnknown False + | isUnliftedType ty = LFUnlifted + | mightBeAFunction ty = LFUnknown True + | otherwise = LFUnknown False where ty = idType id @@ -295,13 +226,13 @@ mkLFThunk thunk_ty top fvs upd_flag LFThunk top (null fvs) (isUpdatable upd_flag) NonStandardThunk - (might_be_a_function thunk_ty) + (mightBeAFunction thunk_ty) -------------- -might_be_a_function :: Type -> Bool +mightBeAFunction :: Type -> Bool -- Return False only if we are *sure* it's a data type -- Look through newtypes etc as much as poss -might_be_a_function ty +mightBeAFunction ty | [LiftedRep] <- typePrimRep ty , Just tc <- tyConAppTyCon_maybe (unwrapType ty) , isDataTyCon tc @@ -317,30 +248,13 @@ mkConLFInfo con = LFCon con mkSelectorLFInfo :: Id -> Int -> Bool -> LambdaFormInfo mkSelectorLFInfo id offset updatable = LFThunk NotTopLevel False updatable (SelectorThunk offset) - (might_be_a_function (idType id)) + (mightBeAFunction (idType id)) ------------- mkApLFInfo :: Id -> UpdateFlag -> Arity -> LambdaFormInfo mkApLFInfo id upd_flag arity = LFThunk NotTopLevel (arity == 0) (isUpdatable upd_flag) (ApThunk arity) - (might_be_a_function (idType id)) - -------------- -mkLFImported :: Id -> LambdaFormInfo -mkLFImported id - | Just con <- isDataConWorkId_maybe id - , isNullaryRepDataCon con - = LFCon con -- An imported nullary constructor - -- We assume that the constructor is evaluated so that - -- the id really does point directly to the constructor - - | arity > 0 - = LFReEntrant TopLevel noOneShotInfo arity True (panic "arg_descr") - - | otherwise - = mkLFArgument id -- Not sure of exact arity - where - arity = idFunRepArity id + (mightBeAFunction (idType id)) ------------- mkLFStringLit :: LambdaFormInfo ===================================== compiler/GHC/StgToCmm/Env.hs ===================================== @@ -31,6 +31,7 @@ import GHC.Platform import GHC.StgToCmm.Monad import GHC.StgToCmm.Utils import GHC.StgToCmm.Closure +import GHC.StgToCmm.Types import GHC.Cmm.CLabel @@ -48,6 +49,8 @@ import TysPrim import UniqFM import Util import VarEnv +import GHC.Core.DataCon +import BasicTypes ------------------------------------- -- Manipulating CgIdInfo @@ -146,6 +149,26 @@ getCgIdInfo id cgLookupPanic id -- Bug }}} +mkLFImported :: Id -> LambdaFormInfo +mkLFImported id = + case idLFInfo_maybe id of + Just lf_info -> + lf_info + Nothing + | Just con <- isDataConWorkId_maybe id + , isNullaryRepDataCon con + -> LFCon con -- An imported nullary constructor + -- We assume that the constructor is evaluated so that + -- the id really does point directly to the constructor + + | arity > 0 + -> LFReEntrant TopLevel noOneShotInfo arity True ArgUnknown + + | otherwise + -> mkLFArgument id -- Not sure of exact arity + where + arity = idFunRepArity id + cgLookupPanic :: Id -> FCode a cgLookupPanic id = do local_binds <- getBinds ===================================== compiler/GHC/StgToCmm/Types.hs ===================================== @@ -0,0 +1,157 @@ +{-# LANGUAGE CPP #-} + +module GHC.StgToCmm.Types + ( WordOff + , LambdaFormInfo (..) + , ModuleLFInfos + , Liveness + , ArgDescr (..) + , StandardFormInfo (..) + ) where + +#include "HsVersions.h" + +import GhcPrelude + +import BasicTypes +import GHC.Core.DataCon +import NameEnv +import Outputable + +-- | Word offset, or word count +type WordOff = Int + +-------------------------------------------------------------------------------- +-- LambdaFormInfo +-------------------------------------------------------------------------------- + +-- | Maps names in the current module to their LambdaFormInfos +type ModuleLFInfos = NameEnv LambdaFormInfo + +-- Information about an identifier, from the code generator's point of view. +-- Every identifier is bound to a LambdaFormInfo in the environment, which gives +-- the code generator enough info to be able to tail call or return that +-- identifier. + +data LambdaFormInfo + = LFReEntrant -- Reentrant closure (a function) + !TopLevelFlag -- True if top level + !OneShotInfo + !RepArity -- Arity. Invariant: always > 0 + !Bool -- True <=> no fvs + !ArgDescr -- Argument descriptor (should really be in ClosureInfo) + + | LFThunk -- Thunk (zero arity) + !TopLevelFlag + !Bool -- True <=> no free vars + !Bool -- True <=> updatable (i.e., *not* single-entry) + !StandardFormInfo + !Bool -- True <=> *might* be a function type + + | LFCon -- A saturated constructor application + !DataCon -- The constructor + + | LFUnknown -- Used for function arguments and imported things. + -- We know nothing about this closure. + -- Treat like updatable "LFThunk"... + -- Imported things which we *do* know something about use + -- one of the other LF constructors (eg LFReEntrant for + -- known functions) + !Bool -- True <=> *might* be a function type + -- The False case is good when we want to enter it, + -- because then we know the entry code will do + -- For a function, the entry code is the fast entry point + + | LFUnlifted -- A value of unboxed type; + -- always a value, needs evaluation + + | LFLetNoEscape -- See LetNoEscape module for precise description + +instance Outputable LambdaFormInfo where + ppr (LFReEntrant top oneshot rep fvs argdesc) = + text "LFReEntrant" <> brackets (ppr top <+> ppr oneshot <+> + ppr rep <+> pprFvs fvs <+> ppr argdesc) + ppr (LFThunk top hasfv updateable sfi m_function) = + text "LFThunk" <> brackets (ppr top <+> pprFvs hasfv <+> pprUpdateable updateable <+> + ppr sfi <+> pprFuncFlag m_function) + ppr (LFCon con) = text "LFCon" <> brackets (ppr con) + ppr (LFUnknown m_func) = + text "LFUnknown" <> brackets (pprFuncFlag m_func) + ppr LFUnlifted = text "LFUnlifted" + ppr LFLetNoEscape = text "LFLetNoEscape" + +pprFvs :: Bool -> SDoc +pprFvs True = text "no-fvs" +pprFvs False = text "fvs" + +pprFuncFlag :: Bool -> SDoc +pprFuncFlag True = text "mFunc" +pprFuncFlag False = text "value" + +pprUpdateable :: Bool -> SDoc +pprUpdateable True = text "updateable" +pprUpdateable False = text "oneshot" + +-------------------------------------------------------------------------------- + +-- | We represent liveness bitmaps as a Bitmap (whose internal representation +-- really is a bitmap). These are pinned onto case return vectors to indicate +-- the state of the stack for the garbage collector. +-- +-- In the compiled program, liveness bitmaps that fit inside a single word +-- (StgWord) are stored as a single word, while larger bitmaps are stored as a +-- pointer to an array of words. + +type Liveness = [Bool] -- One Bool per word; True <=> non-ptr or dead + -- False <=> ptr + +-------------------------------------------------------------------------------- +-- | An ArgDescr describes the argument pattern of a function + +data ArgDescr + = ArgSpec -- Fits one of the standard patterns + !Int -- RTS type identifier ARG_P, ARG_N, ... + + | ArgGen -- General case + Liveness -- Details about the arguments + + | ArgUnknown -- For imported binds. + -- Invariant: Never Unknown for binds of the module + -- we are compiling. + deriving (Eq) + +instance Outputable ArgDescr where + ppr (ArgSpec n) = text "ArgSpec" <+> ppr n + ppr (ArgGen ls) = text "ArgGen" <+> ppr ls + ppr ArgUnknown = text "ArgUnknown" + +-------------------------------------------------------------------------------- +-- | StandardFormInfo tells whether this thunk has one of a small number of +-- standard forms + +data StandardFormInfo + = NonStandardThunk + -- The usual case: not of the standard forms + + | SelectorThunk + -- A SelectorThunk is of form + -- case x of + -- con a1,..,an -> ak + -- and the constructor is from a single-constr type. + WordOff -- 0-origin offset of ak within the "goods" of + -- constructor (Recall that the a1,...,an may be laid + -- out in the heap in a non-obvious order.) + + | ApThunk + -- An ApThunk is of form + -- x1 ... xn + -- The code for the thunk just pushes x2..xn on the stack and enters x1. + -- There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled + -- in the RTS to save space. + RepArity -- Arity, n + deriving (Eq) + +instance Outputable StandardFormInfo where + ppr NonStandardThunk = text "RegThunk" + ppr (SelectorThunk w) = text "SelThunk:" <> ppr w + ppr (ApThunk n) = text "ApThunk:" <> ppr n ===================================== compiler/basicTypes/Id.hs ===================================== @@ -92,7 +92,7 @@ module Id ( idCallArity, idFunRepArity, idUnfolding, realIdUnfolding, idSpecialisation, idCoreRules, idHasRules, - idCafInfo, + idCafInfo, idLFInfo, idLFInfo_maybe, idOneShotInfo, idStateHackOneShotInfo, idOccInfo, isNeverLevPolyId, @@ -105,6 +105,7 @@ module Id ( setIdSpecialisation, setIdCafInfo, setIdOccInfo, zapIdOccInfo, + setIdLFInfo, setIdDemandInfo, setIdStrictness, @@ -731,6 +732,19 @@ idCafInfo id = cafInfo (idInfo id) setIdCafInfo :: Id -> CafInfo -> Id setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id + --------------------------------- + -- Lambda form info +idLFInfo :: HasCallStack => Id -> LambdaFormInfo +idLFInfo id = case lfInfo (idInfo id) of + Nothing -> pprPanic "idLFInfo" (text "LFInfo not available for Id" <+> ppr id) + Just lf_info -> lf_info + +idLFInfo_maybe :: Id -> Maybe LambdaFormInfo +idLFInfo_maybe = lfInfo . idInfo + +setIdLFInfo :: Id -> LambdaFormInfo -> Id +setIdLFInfo id lf = modifyIdInfo (`setLFInfo` lf) id + --------------------------------- -- Occurrence INFO idOccInfo :: Id -> OccInfo ===================================== compiler/basicTypes/IdInfo.hs ===================================== @@ -74,6 +74,10 @@ module IdInfo ( ppCafInfo, mayHaveCafRefs, cafInfo, setCafInfo, + -- ** The LambdaFormInfo type + LambdaFormInfo(..), + lfInfo, setLFInfo, + -- ** Tick-box Info TickBoxOp(..), TickBoxId, @@ -104,6 +108,8 @@ import Demand import Cpr import Util +import GHC.StgToCmm.Types (LambdaFormInfo (..)) + -- infixl so you can say (id `set` a `set` b) infixl 1 `setRuleInfo`, `setArityInfo`, @@ -270,8 +276,9 @@ data IdInfo -- ^ 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 + levityInfo :: LevityInfo, -- ^ when applied, will this Id ever have a levity-polymorphic type? + lfInfo :: !(Maybe LambdaFormInfo) } -- Setters @@ -294,13 +301,18 @@ setUnfoldingInfo info uf setArityInfo :: IdInfo -> ArityInfo -> IdInfo setArityInfo info ar = info { arityInfo = ar } + setCallArityInfo :: IdInfo -> ArityInfo -> IdInfo setCallArityInfo info ar = info { callArityInfo = ar } + setCafInfo :: IdInfo -> CafInfo -> IdInfo -setCafInfo info caf = info { cafInfo = caf } +setCafInfo info caf = info { cafInfo = caf } + +setLFInfo :: IdInfo -> LambdaFormInfo -> IdInfo +setLFInfo info lf = info { lfInfo = Just lf } setOneShotInfo :: IdInfo -> OneShotInfo -> IdInfo -setOneShotInfo info lb = {-lb `seq`-} info { oneShotInfo = lb } +setOneShotInfo info lb = {-lb `seq`-} info { oneShotInfo = lb } setDemandInfo :: IdInfo -> Demand -> IdInfo setDemandInfo info dd = dd `seq` info { demandInfo = dd } @@ -326,7 +338,8 @@ vanillaIdInfo strictnessInfo = nopSig, cprInfo = topCprSig, callArityInfo = unknownArity, - levityInfo = NoLevityInfo + levityInfo = NoLevityInfo, + lfInfo = Nothing } -- | More informative 'IdInfo' we can use when we know the 'Id' has no CAF references ===================================== compiler/ghc.cabal.in ===================================== @@ -229,7 +229,7 @@ Library SrcLoc UniqSupply Unique - UpdateCafInfos + UpdateIdInfos Var VarEnv VarSet @@ -298,6 +298,7 @@ Library GHC.StgToCmm.Ticky GHC.StgToCmm.Utils GHC.StgToCmm.ExtCode + GHC.StgToCmm.Types GHC.Runtime.Heap.Layout GHC.Core.Arity GHC.Core.FVs ===================================== compiler/main/UpdateCafInfos.hs → compiler/main/UpdateIdInfos.hs ===================================== @@ -1,7 +1,7 @@ {-# LANGUAGE CPP, BangPatterns, Strict, RecordWildCards #-} -module UpdateCafInfos - ( updateModDetailsCafInfos +module UpdateIdInfos + ( updateModDetailsIdInfos ) where import GhcPrelude @@ -17,22 +17,23 @@ import NameSet import Util import Var import Outputable +import GHC.StgToCmm.Types (ModuleLFInfos) #include "HsVersions.h" --- | Update CafInfos of all occurences (in rules, unfoldings, class instances) -updateModDetailsCafInfos +-- | Update CafInfos and LFInfos of all occurences (in rules, unfoldings, class instances) +updateModDetailsIdInfos :: DynFlags -> NameSet -- ^ Non-CAFFY names in the module. Names not in this set are CAFFY. + -> ModuleLFInfos -> ModDetails -- ^ ModDetails to update -> ModDetails -updateModDetailsCafInfos dflags _ mod_details +updateModDetailsIdInfos dflags _ _ mod_details | gopt Opt_OmitInterfacePragmas dflags = mod_details -updateModDetailsCafInfos _ non_cafs mod_details = - {- pprTrace "updateModDetailsCafInfos" (text "non_cafs:" <+> ppr non_cafs) $ -} +updateModDetailsIdInfos _ non_cafs lf_infos mod_details = let ModDetails{ md_types = type_env -- for unfoldings , md_insts = insts @@ -40,11 +41,11 @@ updateModDetailsCafInfos _ non_cafs mod_details = } = mod_details -- type TypeEnv = NameEnv TyThing - ~type_env' = mapNameEnv (updateTyThingCafInfos type_env' non_cafs) type_env + ~type_env' = mapNameEnv (updateTyThingCafInfos type_env' non_cafs lf_infos) type_env -- Not strict! - !insts' = strictMap (updateInstCafInfos type_env' non_cafs) insts - !rules' = strictMap (updateRuleCafInfos type_env') rules + !insts' = strictMap (updateInstIdInfos type_env' non_cafs lf_infos) insts + !rules' = strictMap (updateRuleIdInfos type_env') rules in mod_details{ md_types = type_env' , md_insts = insts' @@ -55,28 +56,28 @@ updateModDetailsCafInfos _ non_cafs mod_details = -- Rules -------------------------------------------------------------------------------- -updateRuleCafInfos :: TypeEnv -> CoreRule -> CoreRule -updateRuleCafInfos _ rule at BuiltinRule{} = rule -updateRuleCafInfos type_env Rule{ .. } = Rule { ru_rhs = updateGlobalIds type_env ru_rhs, .. } +updateRuleIdInfos :: TypeEnv -> CoreRule -> CoreRule +updateRuleIdInfos _ rule at BuiltinRule{} = rule +updateRuleIdInfos type_env Rule{ .. } = Rule { ru_rhs = updateGlobalIds type_env ru_rhs, .. } -------------------------------------------------------------------------------- -- Instances -------------------------------------------------------------------------------- -updateInstCafInfos :: TypeEnv -> NameSet -> ClsInst -> ClsInst -updateInstCafInfos type_env non_cafs = - updateClsInstDFun (updateIdUnfolding type_env . updateIdCafInfo non_cafs) +updateInstIdInfos :: TypeEnv -> NameSet -> ModuleLFInfos -> ClsInst -> ClsInst +updateInstIdInfos type_env non_cafs lf_infos = + updateClsInstDFun (updateIdUnfolding type_env . updateIdInfo non_cafs lf_infos) -------------------------------------------------------------------------------- -- TyThings -------------------------------------------------------------------------------- -updateTyThingCafInfos :: TypeEnv -> NameSet -> TyThing -> TyThing +updateTyThingCafInfos :: TypeEnv -> NameSet -> ModuleLFInfos -> TyThing -> TyThing -updateTyThingCafInfos type_env non_cafs (AnId id) = - AnId (updateIdUnfolding type_env (updateIdCafInfo non_cafs id)) +updateTyThingCafInfos type_env non_cafs lf_infos (AnId id) = + AnId (updateIdUnfolding type_env (updateIdInfo non_cafs lf_infos id)) -updateTyThingCafInfos _ _ other = other -- AConLike, ATyCon, ACoAxiom +updateTyThingCafInfos _ _ _ other = other -- AConLike, ATyCon, ACoAxiom -------------------------------------------------------------------------------- -- Unfoldings @@ -95,13 +96,18 @@ updateIdUnfolding type_env id = -- Expressions -------------------------------------------------------------------------------- -updateIdCafInfo :: NameSet -> Id -> Id -updateIdCafInfo non_cafs id - | idName id `elemNameSet` non_cafs - = -- pprTrace "updateIdCafInfo" (text "Marking" <+> ppr id <+> parens (ppr (idName id)) <+> text "as non-CAFFY") $ - id `setIdCafInfo` NoCafRefs - | otherwise - = id +updateIdInfo :: NameSet -> ModuleLFInfos -> Id -> Id +updateIdInfo non_cafs lf_infos id = + let + not_caffy = elemNameSet (idName id) non_cafs + mb_lf_info = lookupNameEnv lf_infos (idName id) + + id1 = if not_caffy then setIdCafInfo id NoCafRefs else id + id2 = case mb_lf_info of + Nothing -> id1 + Just lf_info -> setIdLFInfo id1 lf_info + in + id2 -------------------------------------------------------------------------------- ===================================== testsuite/tests/codeGen/should_compile/Makefile ===================================== @@ -64,10 +64,10 @@ T17648: # NoCafRefs) to the interface files. '$(TEST_HC)' $(TEST_HC_OPTS) -dno-typeable-binds -O T17648.hs -v0 '$(TEST_HC)' --show-iface T17648.hi | tr -d '\n' | \ - grep -F 'f :: T GHC.Types.Int -> () [HasNoCafRefs, Arity' >/dev/null + grep -F 'f :: T GHC.Types.Int -> () [HasNoCafRefs, LambdaFormInfo' >/dev/null # Second compilation with -fcatch-bottoms, f should be CAFFY '$(TEST_HC)' $(TEST_HC_OPTS) -dno-typeable-binds -O \ -fcatch-bottoms T17648.hs -v0 -fforce-recomp '$(TEST_HC)' --show-iface T17648.hi | tr -d '\n' | \ - grep -F 'f :: T GHC.Types.Int -> () [Arity: 1, Strictness' >/dev/null + grep -F 'f :: T GHC.Types.Int -> () [LambdaFormInfo' >/dev/null ===================================== testsuite/tests/codeGen/should_compile/cg009/A.hs ===================================== @@ -0,0 +1,5 @@ +module A where + +newtype A = A Int + +val = A 42 ===================================== testsuite/tests/codeGen/should_compile/cg009/Main.hs ===================================== @@ -0,0 +1,7 @@ +module Main where + +import A + +main = return () + +a = val ===================================== testsuite/tests/codeGen/should_compile/cg009/Makefile ===================================== @@ -0,0 +1,9 @@ +TOP=../../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +# Make sure the LFInfo for an exported, but not directly used newtype +# constructors does not trip up the compiler. +cg009: + '$(TEST_HC)' $(TEST_HC_OPTS) -c -O A.hs -fforce-recomp + '$(TEST_HC)' $(TEST_HC_OPTS) -c -O0 Main.hs -fforce-recomp ===================================== testsuite/tests/codeGen/should_compile/cg009/all.T ===================================== @@ -0,0 +1 @@ +test('cg009', [extra_files(['A.hs','Main.hs'])], makefile_test, ['cg009']) ===================================== testsuite/tests/codeGen/should_compile/cg010/A.hs ===================================== @@ -0,0 +1,4 @@ +module A where + +{-# NOINLINE val #-} +val = Just 42 ===================================== testsuite/tests/codeGen/should_compile/cg010/Main.hs ===================================== @@ -0,0 +1,8 @@ +module Main where + +import A + +main = return () + +a = val + ===================================== testsuite/tests/codeGen/should_compile/cg010/Makefile ===================================== @@ -0,0 +1,9 @@ +TOP=../../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +# Make sure LFInfo causes the imported reference to val to get tagged. +cg010: + '$(TEST_HC)' $(TEST_HC_OPTS) -c -O A.hs -fforce-recomp + '$(TEST_HC)' $(TEST_HC_OPTS) -c -O Main.hs -fforce-recomp -ddump-cmm -ddump-to-file + grep "A.val_closure+2" Main.dump-cmm ===================================== testsuite/tests/codeGen/should_compile/cg010/all.T ===================================== @@ -0,0 +1 @@ +test('cg010', [extra_files(['A.hs','Main.hs'])], makefile_test, ['cg010']) ===================================== testsuite/tests/codeGen/should_compile/cg010/cg010.stdout ===================================== @@ -0,0 +1 @@ + const A.val_closure+2; ===================================== testsuite/tests/simplCore/should_compile/Makefile ===================================== @@ -102,7 +102,7 @@ T4201: '$(TEST_HC)' $(TEST_HC_OPTS) -c -O T4201.hs '$(TEST_HC)' $(TEST_HC_OPTS) --show-iface T4201.hi > T4201.list # poor man idea about how to replace GNU grep -B2 "Sym" invocation with pure POSIX tools - for i in `grep -n "Sym" T4201.list |cut -d ':' -f -1`; do head -$$i T4201.list | tail -3 ; done + for i in `grep -n "Sym" T4201.list | cut -d ':' -f -1`; do head -$$i T4201.list | tail -4; done $(RM) -f T4201.list # This one looped as a result of bogus specialisation ===================================== testsuite/tests/simplCore/should_compile/T4201.stdout ===================================== @@ -1,3 +1,4 @@ - [HasNoCafRefs, Arity: 1, Strictness: , CPR: m1, + [HasNoCafRefs, LambdaFormInfo: LFReEntrant 1, Arity: 1, + Strictness: , CPR: m1, Unfolding: InlineRule (0, True, True) bof `cast` (Sym (N:Foo[0]) ->_R _R)] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ccd09ef4b132a722cbef9d41638921ea0bd0854d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ccd09ef4b132a722cbef9d41638921ea0bd0854d You're receiving 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 Mar 25 07:10:20 2020 From: gitlab at gitlab.haskell.org (=?UTF-8?B?w5ZtZXIgU2luYW4gQcSfYWNhbg==?=) Date: Wed, 25 Mar 2020 03:10:20 -0400 Subject: [Git][ghc/ghc][wip/osa1/lfinfo] Revert some of the changes Message-ID: <5e7b03dce6ee8_616713339fc446168c@gitlab.haskell.org.mail> Ömer Sinan Ağacan pushed to branch wip/osa1/lfinfo at Glasgow Haskell Compiler / GHC Commits: da40331b by Ömer Sinan Ağacan at 2020-03-25T10:09:57+03:00 Revert some of the changes - - - - - 3 changed files: - compiler/GHC/IfaceToCore.hs - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/StgToCmm/Env.hs Changes: ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -32,8 +32,6 @@ import GHC.Iface.Syntax import GHC.Iface.Load import GHC.Iface.Env import GHC.StgToCmm.Types -import GHC.StgToCmm.Closure -import GHC.Types.RepType import BuildTyCl import TcRnMonad import TcType @@ -645,7 +643,7 @@ tc_iface_decl _ ignore_prags (IfaceId {ifName = name, ifType = iface_type, = do { ty <- tcIfaceType iface_type ; details <- tcIdDetails ty details ; info <- tcIdInfo ignore_prags TopLevel name ty info - ; return (AnId (addIdLFInfo (mkGlobalId details name ty info))) } + ; return (AnId (mkGlobalId details name ty info)) } tc_iface_decl _ _ (IfaceData {ifName = tc_name, ifCType = cType, @@ -1344,8 +1342,7 @@ tcIfaceExpr (IfaceLet (IfaceNonRec (IfLetBndr fs ty info ji) rhs) body) ; ty' <- tcIfaceType ty ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -} NotTopLevel name ty' info - ; let id = addIdLFInfo $ - mkLocalIdWithInfo name ty' id_info + ; let id = mkLocalIdWithInfo name ty' id_info `asJoinId_maybe` tcJoinInfo ji ; rhs' <- tcIfaceExpr rhs ; body' <- extendIfaceIdEnv [id] (tcIfaceExpr body) @@ -1366,7 +1363,7 @@ tcIfaceExpr (IfaceLet (IfaceRec pairs) body) = do { rhs' <- tcIfaceExpr rhs ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -} NotTopLevel (idName id) (idType id) info - ; return (addIdLFInfo (setIdInfo id id_info), rhs') } + ; return (setIdInfo id id_info, rhs') } tcIfaceExpr (IfaceTick tickish expr) = do expr' <- tcIfaceExpr expr @@ -1501,34 +1498,6 @@ tcIdInfo ignore_prags toplvl name ty info = do | otherwise = info ; return (info1 `setUnfoldingInfo` unf) } -addIdLFInfo :: Id -> Id -addIdLFInfo id = case idLFInfo_maybe id of - Nothing -> setIdLFInfo id (mkLFImported (idDetails id) (idInfo id) (idType id)) - Just _ -> id - --- Make a LambdaFormInfo for the Ids without a LFInfo in the iface file -mkLFImported :: IdDetails -> IdInfo -> Type -> LambdaFormInfo -mkLFImported details info ty - | DataConWorkId con <- details - , isNullaryRepDataCon con - = LFCon con -- An imported nullary constructor - -- We assume that the constructor is evaluated so that - -- the id really does point directly to the constructor - - | arity > 0 - = LFReEntrant TopLevel noOneShotInfo arity True ArgUnknown - - | isUnliftedType ty - = LFUnlifted - - | mightBeAFunction ty - = LFUnknown True - - | otherwise - = LFUnknown False - where - arity = countFunRepArgs (arityInfo info) ty - tcJoinInfo :: IfaceJoinInfo -> Maybe JoinArity tcJoinInfo (IfaceJoinPoint ar) = Just ar tcJoinInfo IfaceNotJoinPoint = Nothing ===================================== compiler/GHC/StgToCmm/Closure.hs ===================================== @@ -24,7 +24,7 @@ module GHC.StgToCmm.Closure ( LambdaFormInfo, -- Abstract StandardFormInfo, -- ...ditto... mkLFThunk, mkLFReEntrant, mkConLFInfo, mkSelectorLFInfo, - mkApLFInfo, mkLFArgument, mkLFLetNoEscape, + mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape, mkLFStringLit, lfDynTag, isLFThunk, isLFReEntrant, lfUpdatable, @@ -51,7 +51,6 @@ module GHC.StgToCmm.Closure ( closureUpdReqd, closureSingleEntry, closureReEntrant, closureFunInfo, isToplevClosure, - mightBeAFunction, blackHoleOnEntry, -- Needs LambdaFormInfo and SMRep isStaticClosure, -- Needs SMPre @@ -196,9 +195,9 @@ argPrimRep arg = typePrimRep1 (stgArgType arg) mkLFArgument :: Id -> LambdaFormInfo mkLFArgument id - | isUnliftedType ty = LFUnlifted - | mightBeAFunction ty = LFUnknown True - | otherwise = LFUnknown False + | isUnliftedType ty = LFUnlifted + | might_be_a_function ty = LFUnknown True + | otherwise = LFUnknown False where ty = idType id @@ -226,13 +225,13 @@ mkLFThunk thunk_ty top fvs upd_flag LFThunk top (null fvs) (isUpdatable upd_flag) NonStandardThunk - (mightBeAFunction thunk_ty) + (might_be_a_function thunk_ty) -------------- -mightBeAFunction :: Type -> Bool +might_be_a_function :: Type -> Bool -- Return False only if we are *sure* it's a data type -- Look through newtypes etc as much as poss -mightBeAFunction ty +might_be_a_function ty | [LiftedRep] <- typePrimRep ty , Just tc <- tyConAppTyCon_maybe (unwrapType ty) , isDataTyCon tc @@ -248,13 +247,34 @@ mkConLFInfo con = LFCon con mkSelectorLFInfo :: Id -> Int -> Bool -> LambdaFormInfo mkSelectorLFInfo id offset updatable = LFThunk NotTopLevel False updatable (SelectorThunk offset) - (mightBeAFunction (idType id)) + (might_be_a_function (idType id)) ------------- mkApLFInfo :: Id -> UpdateFlag -> Arity -> LambdaFormInfo mkApLFInfo id upd_flag arity = LFThunk NotTopLevel (arity == 0) (isUpdatable upd_flag) (ApThunk arity) - (mightBeAFunction (idType id)) + (might_be_a_function (idType id)) + +------------- +mkLFImported :: Id -> LambdaFormInfo +mkLFImported id = + case idLFInfo_maybe id of + Just lf_info -> + lf_info + Nothing + | Just con <- isDataConWorkId_maybe id + , isNullaryRepDataCon con + -> LFCon con -- An imported nullary constructor + -- We assume that the constructor is evaluated so that + -- the id really does point directly to the constructor + + | arity > 0 + -> LFReEntrant TopLevel noOneShotInfo arity True ArgUnknown + + | otherwise + -> mkLFArgument id -- Not sure of exact arity + where + arity = idFunRepArity id ------------- mkLFStringLit :: LambdaFormInfo ===================================== compiler/GHC/StgToCmm/Env.hs ===================================== @@ -31,7 +31,6 @@ import GHC.Platform import GHC.StgToCmm.Monad import GHC.StgToCmm.Utils import GHC.StgToCmm.Closure -import GHC.StgToCmm.Types import GHC.Cmm.CLabel @@ -49,8 +48,6 @@ import TysPrim import UniqFM import Util import VarEnv -import GHC.Core.DataCon -import BasicTypes ------------------------------------- -- Manipulating CgIdInfo @@ -149,26 +146,6 @@ getCgIdInfo id cgLookupPanic id -- Bug }}} -mkLFImported :: Id -> LambdaFormInfo -mkLFImported id = - case idLFInfo_maybe id of - Just lf_info -> - lf_info - Nothing - | Just con <- isDataConWorkId_maybe id - , isNullaryRepDataCon con - -> LFCon con -- An imported nullary constructor - -- We assume that the constructor is evaluated so that - -- the id really does point directly to the constructor - - | arity > 0 - -> LFReEntrant TopLevel noOneShotInfo arity True ArgUnknown - - | otherwise - -> mkLFArgument id -- Not sure of exact arity - where - arity = idFunRepArity id - cgLookupPanic :: Id -> FCode a cgLookupPanic id = do local_binds <- getBinds View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/da40331b7c57e6b3a87da389a884ae6dd2cacf36 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/da40331b7c57e6b3a87da389a884ae6dd2cacf36 You're receiving 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 Mar 25 07:12:03 2020 From: gitlab at gitlab.haskell.org (=?UTF-8?B?w5ZtZXIgU2luYW4gQcSfYWNhbg==?=) Date: Wed, 25 Mar 2020 03:12:03 -0400 Subject: [Git][ghc/ghc][wip/osa1/lfinfo] Remove unused function idLFInfo Message-ID: <5e7b04437eadc_61673f81cd4b0f5846237@gitlab.haskell.org.mail> Ömer Sinan Ağacan pushed to branch wip/osa1/lfinfo at Glasgow Haskell Compiler / GHC Commits: f51f3738 by Ömer Sinan Ağacan at 2020-03-25T10:11:54+03:00 Remove unused function idLFInfo - - - - - 1 changed file: - compiler/basicTypes/Id.hs Changes: ===================================== compiler/basicTypes/Id.hs ===================================== @@ -92,7 +92,7 @@ module Id ( idCallArity, idFunRepArity, idUnfolding, realIdUnfolding, idSpecialisation, idCoreRules, idHasRules, - idCafInfo, idLFInfo, idLFInfo_maybe, + idCafInfo, idLFInfo_maybe, idOneShotInfo, idStateHackOneShotInfo, idOccInfo, isNeverLevPolyId, @@ -734,10 +734,6 @@ setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id --------------------------------- -- Lambda form info -idLFInfo :: HasCallStack => Id -> LambdaFormInfo -idLFInfo id = case lfInfo (idInfo id) of - Nothing -> pprPanic "idLFInfo" (text "LFInfo not available for Id" <+> ppr id) - Just lf_info -> lf_info idLFInfo_maybe :: Id -> Maybe LambdaFormInfo idLFInfo_maybe = lfInfo . idInfo View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f51f3738f263c4196614afb70f704476a000d7b2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f51f3738f263c4196614afb70f704476a000d7b2 You're receiving 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 Mar 25 07:41:27 2020 From: gitlab at gitlab.haskell.org (=?UTF-8?B?w5ZtZXIgU2luYW4gQcSfYWNhbg==?=) Date: Wed, 25 Mar 2020 03:41:27 -0400 Subject: [Git][ghc/ghc][wip/osa1/lfinfo] Update a test Message-ID: <5e7b0b27c6012_61671196b3f446300@gitlab.haskell.org.mail> Ömer Sinan Ağacan pushed to branch wip/osa1/lfinfo at Glasgow Haskell Compiler / GHC Commits: d1b19c0f by Ömer Sinan Ağacan at 2020-03-25T10:41:14+03:00 Update a test - - - - - 1 changed file: - testsuite/tests/codeGen/should_compile/Makefile Changes: ===================================== testsuite/tests/codeGen/should_compile/Makefile ===================================== @@ -64,7 +64,7 @@ T17648: # NoCafRefs) to the interface files. '$(TEST_HC)' $(TEST_HC_OPTS) -dno-typeable-binds -O T17648.hs -v0 '$(TEST_HC)' --show-iface T17648.hi | tr -d '\n' | \ - grep -F 'f :: T GHC.Types.Int -> () [HasNoCafRefs, LambdaFormInfo' >/dev/null + grep -F 'f :: T GHC.Types.Int -> () [HasNoCafRefs, LambdaFormInfo' >/dev/null # Second compilation with -fcatch-bottoms, f should be CAFFY '$(TEST_HC)' $(TEST_HC_OPTS) -dno-typeable-binds -O \ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d1b19c0f5213fd08744b1b6c90f70ed2b90e8d21 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d1b19c0f5213fd08744b1b6c90f70ed2b90e8d21 You're receiving 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 Mar 25 07:42:15 2020 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Wed, 25 Mar 2020 03:42:15 -0400 Subject: [Git][ghc/ghc][wip/compact-iface] Remove redundant import Message-ID: <5e7b0b572af85_6167e6514b44652dc@gitlab.haskell.org.mail> Matthew Pickering pushed to branch wip/compact-iface at Glasgow Haskell Compiler / GHC Commits: 89ef70db by Matthew Pickering at 2020-03-25T07:42:07+00:00 Remove redundant import - - - - - 1 changed file: - compiler/utils/FastString.hs Changes: ===================================== compiler/utils/FastString.hs ===================================== @@ -113,7 +113,6 @@ import Data.ByteString (ByteString) import Data.ByteString.Short (ShortByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BSC -import qualified Data.ByteString.Unsafe as BS import qualified Data.ByteString.Short as SBS import qualified Data.ByteString.Short.Internal as SBS import Data.ByteString.Internal (c2w) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/89ef70dba19ab2ddfac635247fb1b5aa70919f9d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/89ef70dba19ab2ddfac635247fb1b5aa70919f9d You're receiving 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 Mar 25 08:34:32 2020 From: gitlab at gitlab.haskell.org (=?UTF-8?B?w5ZtZXIgU2luYW4gQcSfYWNhbg==?=) Date: Wed, 25 Mar 2020 04:34:32 -0400 Subject: [Git][ghc/ghc][wip/osa1/lfinfo] Tweaks Message-ID: <5e7b179854823_6167120434ec4661e8@gitlab.haskell.org.mail> Ömer Sinan Ağacan pushed to branch wip/osa1/lfinfo at Glasgow Haskell Compiler / GHC Commits: 2146ec46 by Ömer Sinan Ağacan at 2020-03-25T11:34:17+03:00 Tweaks - - - - - 2 changed files: - compiler/GHC/Driver/Main.hs - compiler/GHC/StgToCmm.hs Changes: ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -1586,7 +1586,7 @@ doCodeGen hsc_env this_mod data_tycons pipeline_stream = {-# SCC "cmmPipeline" #-} Stream.mapAccumL_ (cmmPipeline hsc_env) (emptySRT this_mod) ppr_stream1 - <&> (first (srtMapNonCAFs . moduleSRTMap)) + <&> first (srtMapNonCAFs . moduleSRTMap) dump2 a = do unless (null a) $ ===================================== compiler/GHC/StgToCmm.hs ===================================== @@ -110,17 +110,15 @@ codeGen dflags this_mod data_tycons ; cg_id_infos <- cgs_binds <$> liftIO (readIORef cgref) - -- Only external names are actually visible to codeGen. So they are the - -- only ones we care about. - ; let extractInfo info = lf `seq` Just (name,lf) + ; let extractInfo info = (name, lf) where - id = cg_id info + !id = cg_id info !name = idName id - lf = cg_lf info + !lf = cg_lf info - ; let !generatedInfo = mkNameEnv (mapMaybe extractInfo (eltsUFM cg_id_infos)) + ; let !generatedInfo = mkNameEnv (map extractInfo (eltsUFM cg_id_infos)) - ; return $! generatedInfo + ; return generatedInfo } --------------------------------------------------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2146ec466bba818f4c339bc564442e3f53219c9c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2146ec466bba818f4c339bc564442e3f53219c9c You're receiving 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 Mar 25 09:11:20 2020 From: gitlab at gitlab.haskell.org (=?UTF-8?B?w5ZtZXIgU2luYW4gQcSfYWNhbg==?=) Date: Wed, 25 Mar 2020 05:11:20 -0400 Subject: [Git][ghc/ghc][wip/osa1/lfinfo] Cross-module LambdaFormInfo passing Message-ID: <5e7b20382d383_6167120434ec474562@gitlab.haskell.org.mail> Ömer Sinan Ağacan pushed to branch wip/osa1/lfinfo at Glasgow Haskell Compiler / GHC Commits: 9f7e4c71 by Ömer Sinan Ağacan at 2020-03-25T12:11:02+03:00 Cross-module LambdaFormInfo passing - Store LambdaFormInfos of exported Ids in interface files - Use them in importing modules - - - - - 28 changed files: - compiler/GHC/CoreToIface.hs - compiler/GHC/Driver/Hooks.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Runtime/Heap/Layout.hs - compiler/GHC/StgToCmm.hs - compiler/GHC/StgToCmm/Closure.hs - + compiler/GHC/StgToCmm/Types.hs - compiler/basicTypes/Id.hs - compiler/basicTypes/IdInfo.hs - compiler/ghc.cabal.in - compiler/main/UpdateCafInfos.hs → compiler/main/UpdateIdInfos.hs - testsuite/tests/codeGen/should_compile/Makefile - + testsuite/tests/codeGen/should_compile/cg009/A.hs - + testsuite/tests/codeGen/should_compile/cg009/Main.hs - + testsuite/tests/codeGen/should_compile/cg009/Makefile - + testsuite/tests/codeGen/should_compile/cg009/all.T - + testsuite/tests/codeGen/should_compile/cg010/A.hs - + testsuite/tests/codeGen/should_compile/cg010/Main.hs - + testsuite/tests/codeGen/should_compile/cg010/Makefile - + testsuite/tests/codeGen/should_compile/cg010/all.T - + testsuite/tests/codeGen/should_compile/cg010/cg010.stdout - testsuite/tests/simplCore/should_compile/Makefile - testsuite/tests/simplCore/should_compile/T4201.stdout Changes: ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -34,13 +34,14 @@ module GHC.CoreToIface , toIfaceIdDetails , toIfaceIdInfo , toIfUnfolding - , toIfaceOneShot , toIfaceTickish , toIfaceBind , toIfaceAlt , toIfaceCon , toIfaceApp , toIfaceVar + -- * Other stuff + , toIfaceLFInfo ) where #include "HsVersions.h" @@ -49,6 +50,7 @@ import GhcPrelude import GHC.Iface.Syntax import GHC.Core.DataCon +import GHC.StgToCmm.Types import Id import IdInfo import GHC.Core @@ -74,6 +76,8 @@ import Demand ( isTopSig ) import Cpr ( topCprSig ) import Data.Maybe ( catMaybes ) +import Data.Word +import Data.Bits {- Note [Avoiding space leaks in toIface*] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -616,6 +620,43 @@ toIfaceVar v where name = idName v +--------------------- +toIfaceLFInfo :: LambdaFormInfo -> IfaceLFInfo +toIfaceLFInfo lfi = case lfi of + LFReEntrant _ _ arity _ _ -> + IfLFReEntrant arity + LFThunk _ _ updatable sfi mb_fun -> + IfLFThunk updatable (toIfaceStandardFormInfo sfi) mb_fun + LFCon dc -> + IfLFCon (dataConName dc) + LFUnknown mb_fun -> + IfLFUnknown mb_fun + LFUnlifted -> + IfLFUnlifted + LFLetNoEscape -> + panic "toIfaceLFInfo: LFLetNoEscape" + +toIfaceStandardFormInfo :: StandardFormInfo -> IfaceStandardFormInfo +toIfaceStandardFormInfo NonStandardThunk = IfStandardFormInfo 1 +toIfaceStandardFormInfo sf = + IfStandardFormInfo $! + tag sf .|. encodeField (field sf) + where + tag SelectorThunk{} = 0 + tag ApThunk{} = setBit 0 1 + tag NonStandardThunk = panic "toIfaceStandardFormInfo: NonStandardThunk" + + field (SelectorThunk n) = n + field (ApThunk n) = n + field NonStandardThunk = panic "toIfaceStandardFormInfo: NonStandardThunk" + + encodeField n = + let wn = fromIntegral n :: Word + shifted = wn `unsafeShiftL` 2 + in ASSERT(shifted > 0 && shifted < fromIntegral (maxBound :: Word16)) + (fromIntegral shifted :: Word16) + + {- Note [Inlining and hs-boot files] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider this example (#10083, #12789): ===================================== compiler/GHC/Driver/Hooks.hs ===================================== @@ -55,6 +55,7 @@ import GHC.Stg.Syntax import Stream import GHC.Cmm import GHC.Hs.Extension +import GHC.StgToCmm.Types (ModuleLFInfos) import Data.Maybe @@ -109,7 +110,7 @@ data Hooks = Hooks -> IO (Maybe HValue)) , createIservProcessHook :: Maybe (CreateProcess -> IO ProcessHandle) , stgToCmmHook :: Maybe (DynFlags -> Module -> [TyCon] -> CollectedCCs - -> [CgStgTopBinding] -> HpcInfo -> Stream IO CmmGroup ()) + -> [CgStgTopBinding] -> HpcInfo -> Stream IO CmmGroup ModuleLFInfos) , cmmToRawCmmHook :: forall a . Maybe (DynFlags -> Maybe Module -> Stream IO CmmGroupSRTs a -> IO (Stream IO RawCmmGroup a)) } ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -162,6 +162,7 @@ import Bag import Exception import qualified Stream import Stream (Stream) +import GHC.StgToCmm.Types (ModuleLFInfos) import Util @@ -176,6 +177,7 @@ import qualified Data.Set as S import Data.Set (Set) import Data.Functor import Control.DeepSeq (force) +import Data.Bifunctor (first) import GHC.Iface.Ext.Ast ( mkHieFile ) import GHC.Iface.Ext.Types ( getAsts, hie_asts, hie_module ) @@ -1392,7 +1394,7 @@ hscWriteIface dflags iface no_change mod_location = do -- | Compile to hard-code. hscGenHardCode :: HscEnv -> CgGuts -> ModLocation -> FilePath - -> IO (FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)], NameSet) + -> IO (FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)], NameSet, ModuleLFInfos) -- ^ @Just f@ <=> _stub.c is f hscGenHardCode hsc_env cgguts location output_filename = do let CgGuts{ -- This is the last use of the ModGuts in a compilation. @@ -1451,11 +1453,11 @@ hscGenHardCode hsc_env cgguts location output_filename = do return a rawcmms1 = Stream.mapM dump rawcmms0 - (output_filename, (_stub_h_exists, stub_c_exists), foreign_fps, caf_infos) + (output_filename, (_stub_h_exists, stub_c_exists), foreign_fps, (caf_infos, lf_infos)) <- {-# SCC "codeOutput" #-} codeOutput dflags this_mod output_filename location foreign_stubs foreign_files dependencies rawcmms1 - return (output_filename, stub_c_exists, foreign_fps, caf_infos) + return (output_filename, stub_c_exists, foreign_fps, caf_infos, lf_infos) hscInteractive :: HscEnv @@ -1549,7 +1551,7 @@ doCodeGen :: HscEnv -> Module -> [TyCon] -> CollectedCCs -> [StgTopBinding] -> HpcInfo - -> IO (Stream IO CmmGroupSRTs NameSet) + -> IO (Stream IO CmmGroupSRTs (NameSet, ModuleLFInfos)) -- Note we produce a 'Stream' of CmmGroups, so that the -- backend can be run incrementally. Otherwise it generates all -- the C-- up front, which has a significant space cost. @@ -1561,7 +1563,7 @@ doCodeGen hsc_env this_mod data_tycons dumpIfSet_dyn dflags Opt_D_dump_stg_final "Final STG:" FormatSTG (pprGenStgTopBindings stg_binds_w_fvs) - let cmm_stream :: Stream IO CmmGroup () + let cmm_stream :: Stream IO CmmGroup ModuleLFInfos -- See Note [Forcing of stg_binds] cmm_stream = stg_binds_w_fvs `seqList` {-# SCC "StgToCmm" #-} lookupHook stgToCmmHook StgToCmm.codeGen dflags dflags this_mod data_tycons @@ -1580,10 +1582,11 @@ doCodeGen hsc_env this_mod data_tycons ppr_stream1 = Stream.mapM dump1 cmm_stream + pipeline_stream :: Stream IO CmmGroupSRTs (NameSet, ModuleLFInfos) pipeline_stream = {-# SCC "cmmPipeline" #-} - Stream.mapAccumL (cmmPipeline hsc_env) (emptySRT this_mod) ppr_stream1 - <&> (srtMapNonCAFs . moduleSRTMap) + Stream.mapAccumL_ (cmmPipeline hsc_env) (emptySRT this_mod) ppr_stream1 + <&> first (srtMapNonCAFs . moduleSRTMap) dump2 a = do unless (null a) $ ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -69,8 +69,8 @@ import FileCleanup import Ar import Bag ( unitBag ) import FastString ( mkFastString ) -import GHC.Iface.Make ( mkFullIface ) -import UpdateCafInfos ( updateModDetailsCafInfos ) +import GHC.Iface.Make ( mkFullIface ) +import UpdateIdInfos ( updateModDetailsIdInfos ) import Exception import System.Directory @@ -1192,12 +1192,12 @@ runPhase (HscOut src_flavour mod_name result) _ dflags = do PipeState{hsc_env=hsc_env'} <- getPipeState - (outputFilename, mStub, foreign_files, caf_infos) <- liftIO $ + (outputFilename, mStub, foreign_files, caf_infos, lf_infos) <- liftIO $ hscGenHardCode hsc_env' cgguts mod_location output_fn - final_iface <- liftIO (mkFullIface hsc_env'{hsc_dflags=iface_dflags} partial_iface (Just caf_infos)) - let final_mod_details = {-# SCC updateModDetailsCafInfos #-} - updateModDetailsCafInfos iface_dflags caf_infos mod_details + final_iface <- liftIO (mkFullIface hsc_env'{hsc_dflags=iface_dflags} partial_iface (Just (caf_infos, lf_infos))) + let final_mod_details = {-# SCC updateModDetailsIdInfos #-} + updateModDetailsIdInfos iface_dflags caf_infos lf_infos mod_details setIface final_iface final_mod_details -- See Note [Writing interface files] ===================================== compiler/GHC/Iface/Make.hs ===================================== @@ -38,6 +38,7 @@ import GHC.Core.Coercion.Axiom import GHC.Core.ConLike import GHC.Core.DataCon import GHC.Core.Type +import GHC.StgToCmm.Types (ModuleLFInfos) import TcType import GHC.Core.InstEnv import GHC.Core.FamInstEnv @@ -100,13 +101,13 @@ mkPartialIface hsc_env mod_details -- | Fully instantiate a interface -- Adds fingerprints and potentially code generator produced information. -mkFullIface :: HscEnv -> PartialModIface -> Maybe NameSet -> IO ModIface -mkFullIface hsc_env partial_iface mb_non_cafs = do +mkFullIface :: HscEnv -> PartialModIface -> Maybe (NameSet, ModuleLFInfos) -> IO ModIface +mkFullIface hsc_env partial_iface mb_id_infos = do let decls | gopt Opt_OmitInterfacePragmas (hsc_dflags hsc_env) = mi_decls partial_iface | otherwise - = updateDeclCafInfos (mi_decls partial_iface) mb_non_cafs + = updateDecl (mi_decls partial_iface) mb_id_infos full_iface <- {-# SCC "addFingerprints" #-} @@ -117,15 +118,23 @@ mkFullIface hsc_env partial_iface mb_non_cafs = do return full_iface -updateDeclCafInfos :: [IfaceDecl] -> Maybe NameSet -> [IfaceDecl] -updateDeclCafInfos decls Nothing = decls -updateDeclCafInfos decls (Just non_cafs) = map update_decl decls +updateDecl :: [IfaceDecl] -> Maybe (NameSet, ModuleLFInfos) -> [IfaceDecl] +updateDecl decls Nothing = decls +updateDecl decls (Just (non_cafs, lf_infos)) = map update_decl decls where + update_decl (IfaceId nm ty details infos) + | let not_caffy = elemNameSet nm non_cafs + , let mb_lf_info = lookupNameEnv lf_infos nm + , WARN( isNothing mb_lf_info, text "Name without LFInfo:" <+> ppr nm ) True + -- Only allocate a new IfaceId if we're going to update the infos + , isJust mb_lf_info || not_caffy + = IfaceId nm ty details $ + (if not_caffy then (HsNoCafRefs :) else id) + (case mb_lf_info of + Nothing -> infos + Just lf_info -> HsLFInfo (toIfaceLFInfo lf_info) : infos) + update_decl decl - | IfaceId nm ty details infos <- decl - , elemNameSet nm non_cafs - = IfaceId nm ty details (HsNoCafRefs : infos) - | otherwise = decl -- | Make an interface from the results of typechecking only. Useful ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -22,6 +22,8 @@ module GHC.Iface.Syntax ( IfaceAxBranch(..), IfaceTyConParent(..), IfaceCompleteMatch(..), + IfaceLFInfo(..), + IfaceStandardFormInfo(..), -- * Binding names IfaceTopBndr, @@ -30,6 +32,7 @@ module GHC.Iface.Syntax ( -- Misc ifaceDeclImplicitBndrs, visibleIfConDecls, ifaceDeclFingerprints, + tcStandardFormInfo, -- Free Names freeNamesIfDecl, freeNamesIfRule, freeNamesIfFamInst, @@ -72,10 +75,13 @@ import GHC.Core.DataCon (SrcStrictness(..), SrcUnpackedness(..)) import Lexeme (isLexSym) import TysWiredIn ( constraintKindTyConName ) import Util (seqList) +import GHC.StgToCmm.Types import Control.Monad import System.IO.Unsafe import Control.DeepSeq +import Data.Word +import Data.Bits infixl 3 &&& @@ -114,7 +120,8 @@ data IfaceDecl = IfaceId { ifName :: IfaceTopBndr, ifType :: IfaceType, ifIdDetails :: IfaceIdDetails, - ifIdInfo :: IfaceIdInfo } + ifIdInfo :: IfaceIdInfo + } | IfaceData { ifName :: IfaceTopBndr, -- Type constructor ifBinders :: [IfaceTyConBinder], @@ -348,6 +355,7 @@ data IfaceInfoItem IfaceUnfolding -- See Note [Expose recursive functions] | HsNoCafRefs | HsLevity -- Present <=> never levity polymorphic + | HsLFInfo IfaceLFInfo -- NB: Specialisations and rules come in separately and are -- only later attached to the Id. Partial reason: some are orphans. @@ -379,6 +387,74 @@ data IfaceIdDetails | IfRecSelId (Either IfaceTyCon IfaceDecl) Bool | IfDFunId +-- | Iface type for LambdaFormInfo. Fields not relevant for imported Ids are +-- omitted in this type. +data IfaceLFInfo + = IfLFReEntrant !RepArity + | IfLFThunk !Bool !IfaceStandardFormInfo !Bool + | IfLFCon !Name + | IfLFUnknown !Bool + | IfLFUnlifted + +tcStandardFormInfo :: IfaceStandardFormInfo -> StandardFormInfo +tcStandardFormInfo (IfStandardFormInfo w) + | testBit w 0 = NonStandardThunk + | otherwise = con field + where + field = fromIntegral (w `unsafeShiftR` 2) + con + | testBit w 1 = ApThunk + | otherwise = SelectorThunk + +instance Outputable IfaceLFInfo where + ppr (IfLFReEntrant arity) = + text "LFReEntrant" <+> ppr arity + + ppr (IfLFThunk updatable sfi mb_fun) = + text "LFThunk" <+> ppr (updatable, tcStandardFormInfo sfi, mb_fun) + + ppr (IfLFCon con) = + text "LFCon" <> brackets (ppr con) + + ppr IfLFUnlifted = + text "LFUnlifted" + + ppr (IfLFUnknown fun_flag) = + text "LFUnknown" <+> ppr fun_flag + +newtype IfaceStandardFormInfo = IfStandardFormInfo Word16 + +instance Binary IfaceStandardFormInfo where + put_ bh (IfStandardFormInfo w) = put_ bh (w :: Word16) + get bh = IfStandardFormInfo <$> (get bh :: IO Word16) + +instance Binary IfaceLFInfo where + put_ bh (IfLFReEntrant arity) = do + putByte bh 0 + put_ bh arity + put_ bh (IfLFThunk updatable sfi mb_fun) = do + putByte bh 1 + put_ bh updatable + put_ bh sfi + put_ bh mb_fun + put_ bh (IfLFCon con_name) = do + putByte bh 2 + put_ bh con_name + put_ bh (IfLFUnknown fun_flag) = do + putByte bh 3 + put_ bh fun_flag + put_ bh IfLFUnlifted = + putByte bh 4 + get bh = do + tag <- getByte bh + case tag of + 0 -> IfLFReEntrant <$> get bh + 1 -> IfLFThunk <$> get bh <*> get bh <*> get bh + 2 -> IfLFCon <$> get bh + 3 -> IfLFUnknown <$> get bh + 4 -> pure IfLFUnlifted + _ -> panic "Invalid byte" + {- Note [Versioning of instances] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1393,6 +1469,7 @@ instance Outputable IfaceInfoItem where ppr (HsCpr cpr) = text "CPR:" <+> ppr cpr ppr HsNoCafRefs = text "HasNoCafRefs" ppr HsLevity = text "Never levity-polymorphic" + ppr (HsLFInfo lf_info) = text "LambdaFormInfo:" <+> ppr lf_info instance Outputable IfaceJoinInfo where ppr IfaceNotJoinPoint = empty @@ -1853,7 +1930,7 @@ instance Binary IfaceDecl where get bh = do h <- getByte bh case h of - 0 -> do name <- get bh + 0 -> do name <- get bh ~(ty, details, idinfo) <- lazyGet bh -- See Note [Lazy deserialization of IfaceId] return (IfaceId name ty details idinfo) @@ -2153,6 +2230,8 @@ instance Binary IfaceInfoItem where put_ bh HsNoCafRefs = putByte bh 4 put_ bh HsLevity = putByte bh 5 put_ bh (HsCpr cpr) = putByte bh 6 >> put_ bh cpr + put_ bh (HsLFInfo lf_info) = putByte bh 7 >> put_ bh lf_info + get bh = do h <- getByte bh case h of @@ -2164,7 +2243,8 @@ instance Binary IfaceInfoItem where 3 -> liftM HsInline $ get bh 4 -> return HsNoCafRefs 5 -> return HsLevity - _ -> HsCpr <$> get bh + 6 -> HsCpr <$> get bh + _ -> HsLFInfo <$> get bh instance Binary IfaceUnfolding where put_ bh (IfCoreUnfold s e) = do @@ -2495,6 +2575,7 @@ instance NFData IfaceInfoItem where HsNoCafRefs -> () HsLevity -> () HsCpr cpr -> cpr `seq` () + HsLFInfo lf_info -> lf_info `seq` () -- TODO: seq further? instance NFData IfaceUnfolding where rnf = \case ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -122,6 +122,9 @@ data IfaceOneShot -- See Note [Preserve OneShotInfo] in CoreTicy = IfaceNoOneShot -- and Note [The oneShot function] in MkId | IfaceOneShot +instance Outputable IfaceOneShot where + ppr IfaceNoOneShot = text "NoOneShotInfo" + ppr IfaceOneShot = text "OneShot" {- %************************************************************************ ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -19,7 +19,8 @@ module GHC.IfaceToCore ( tcIfaceDecl, tcIfaceInst, tcIfaceFamInst, tcIfaceRules, tcIfaceAnnotations, tcIfaceCompleteSigs, tcIfaceExpr, -- Desired by HERMIT (#7683) - tcIfaceGlobal + tcIfaceGlobal, + tcIfaceOneShot ) where #include "HsVersions.h" @@ -30,6 +31,7 @@ import TcTypeNats(typeNatCoAxiomRules) import GHC.Iface.Syntax import GHC.Iface.Load import GHC.Iface.Env +import GHC.StgToCmm.Types import BuildTyCl import TcRnMonad import TcType @@ -1465,8 +1467,7 @@ tcIdInfo ignore_prags toplvl name ty info = do let init_info | if_boot lcl_env = vanillaIdInfo `setUnfoldingInfo` BootUnfolding | otherwise = vanillaIdInfo - let needed = needed_prags info - foldlM tcPrag init_info needed + foldlM tcPrag init_info (needed_prags info) where needed_prags :: [IfaceInfoItem] -> [IfaceInfoItem] needed_prags items @@ -1486,6 +1487,9 @@ tcIdInfo ignore_prags toplvl name ty info = do tcPrag info (HsCpr cpr) = return (info `setCprInfo` cpr) tcPrag info (HsInline prag) = return (info `setInlinePragInfo` prag) tcPrag info HsLevity = return (info `setNeverLevPoly` ty) + tcPrag info (HsLFInfo lf_info) = do + lf_info <- tcLFInfo lf_info + return (info `setLFInfo` lf_info) -- The next two are lazy, so they don't transitively suck stuff in tcPrag info (HsUnfold lb if_unf) @@ -1498,6 +1502,23 @@ tcJoinInfo :: IfaceJoinInfo -> Maybe JoinArity tcJoinInfo (IfaceJoinPoint ar) = Just ar tcJoinInfo IfaceNotJoinPoint = Nothing +tcLFInfo :: IfaceLFInfo -> IfL LambdaFormInfo +tcLFInfo lfi = case lfi of + IfLFReEntrant rep_arity -> + return (LFReEntrant TopLevel NoOneShotInfo rep_arity True ArgUnknown) + + IfLFThunk updatable sfi mb_fun -> + return (LFThunk TopLevel True updatable (tcStandardFormInfo sfi) mb_fun) + + IfLFUnlifted -> + return LFUnlifted + + IfLFCon con_name -> + LFCon <$!> tcIfaceDataCon con_name + + IfLFUnknown fun_flag -> + return (LFUnknown fun_flag) + tcUnfolding :: TopLevelFlag -> Name -> Type -> IdInfo -> IfaceUnfolding -> IfL Unfolding tcUnfolding toplvl name _ info (IfCoreUnfold stable if_expr) = do { dflags <- getDynFlags @@ -1586,6 +1607,10 @@ tcPragExpr is_compulsory toplvl name expr -- It's OK to use nonDetEltsUFM here because we immediately forget -- the ordering by creating a set +tcIfaceOneShot :: IfaceOneShot -> OneShotInfo +tcIfaceOneShot IfaceNoOneShot = NoOneShotInfo +tcIfaceOneShot IfaceOneShot = OneShotLam + {- ************************************************************************ * * ===================================== compiler/GHC/Runtime/Heap/Layout.hs ===================================== @@ -51,6 +51,7 @@ import GHC.Driver.Session import Outputable import GHC.Platform import FastString +import GHC.StgToCmm.Types import Data.Word import Data.Bits @@ -64,9 +65,6 @@ import Data.ByteString (ByteString) ************************************************************************ -} --- | Word offset, or word count -type WordOff = Int - -- | Byte offset, or byte count type ByteOff = Int @@ -196,29 +194,6 @@ type ConstrDescription = ByteString -- result of dataConIdentity type FunArity = Int type SelectorOffset = Int -------------------------- --- We represent liveness bitmaps as a Bitmap (whose internal --- representation really is a bitmap). These are pinned onto case return --- vectors to indicate the state of the stack for the garbage collector. --- --- In the compiled program, liveness bitmaps that fit inside a single --- word (StgWord) are stored as a single word, while larger bitmaps are --- stored as a pointer to an array of words. - -type Liveness = [Bool] -- One Bool per word; True <=> non-ptr or dead - -- False <=> ptr - -------------------------- --- An ArgDescr describes the argument pattern of a function - -data ArgDescr - = ArgSpec -- Fits one of the standard patterns - !Int -- RTS type identifier ARG_P, ARG_N, ... - - | ArgGen -- General case - Liveness -- Details about the arguments - - ----------------------------------------------------------------------------- -- Construction @@ -545,10 +520,6 @@ instance Outputable SMRep where ppr (RTSRep ty rep) = text "tag:" <> ppr ty <+> ppr rep -instance Outputable ArgDescr where - ppr (ArgSpec n) = text "ArgSpec" <+> ppr n - ppr (ArgGen ls) = text "ArgGen" <+> ppr ls - pprTypeInfo :: ClosureTypeInfo -> SDoc pprTypeInfo (Constr tag descr) = text "Con" <+> ===================================== compiler/GHC/StgToCmm.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} +{-# LANGUAGE BangPatterns #-} ----------------------------------------------------------------------------- -- @@ -25,6 +26,7 @@ import GHC.StgToCmm.Utils import GHC.StgToCmm.Closure import GHC.StgToCmm.Hpc import GHC.StgToCmm.Ticky +import GHC.StgToCmm.Types (ModuleLFInfos) import GHC.Cmm import GHC.Cmm.CLabel @@ -45,6 +47,8 @@ import Outputable import Stream import BasicTypes import VarSet ( isEmptyDVarSet ) +import UniqFM +import NameEnv import OrdList import GHC.Cmm.Graph @@ -59,7 +63,8 @@ codeGen :: DynFlags -> CollectedCCs -- (Local/global) cost-centres needing declaring/registering. -> [CgStgTopBinding] -- Bindings to convert -> HpcInfo - -> Stream IO CmmGroup () -- Output as a stream, so codegen can + -> Stream IO CmmGroup ModuleLFInfos + -- Output as a stream, so codegen can -- be interleaved with output codeGen dflags this_mod data_tycons @@ -101,6 +106,18 @@ codeGen dflags this_mod data_tycons mapM_ (cg . cgDataCon) (tyConDataCons tycon) ; mapM_ do_tycon data_tycons + + ; cg_id_infos <- cgs_binds <$> liftIO (readIORef cgref) + + ; let extractInfo info = (name, lf) + where + !id = cg_id info + !name = idName id + !lf = cg_lf info + + ; let !generatedInfo = mkNameEnv (Prelude.map extractInfo (eltsUFM cg_id_infos)) + + ; return generatedInfo } --------------------------------------------------------------- ===================================== compiler/GHC/StgToCmm/Closure.hs ===================================== @@ -70,6 +70,7 @@ import GHC.Stg.Syntax import GHC.Runtime.Heap.Layout import GHC.Cmm import GHC.Cmm.Ppr.Expr() -- For Outputable instances +import GHC.StgToCmm.Types import CostCentre import GHC.Cmm.BlockId @@ -188,77 +189,6 @@ addArgReps = map (\arg -> let arg' = fromNonVoid arg argPrimRep :: StgArg -> PrimRep argPrimRep arg = typePrimRep1 (stgArgType arg) - ------------------------------------------------------------------------------ --- LambdaFormInfo ------------------------------------------------------------------------------ - --- Information about an identifier, from the code generator's point of --- view. Every identifier is bound to a LambdaFormInfo in the --- environment, which gives the code generator enough info to be able to --- tail call or return that identifier. - -data LambdaFormInfo - = LFReEntrant -- Reentrant closure (a function) - TopLevelFlag -- True if top level - OneShotInfo - !RepArity -- Arity. Invariant: always > 0 - !Bool -- True <=> no fvs - ArgDescr -- Argument descriptor (should really be in ClosureInfo) - - | LFThunk -- Thunk (zero arity) - TopLevelFlag - !Bool -- True <=> no free vars - !Bool -- True <=> updatable (i.e., *not* single-entry) - StandardFormInfo - !Bool -- True <=> *might* be a function type - - | LFCon -- A saturated constructor application - DataCon -- The constructor - - | LFUnknown -- Used for function arguments and imported things. - -- We know nothing about this closure. - -- Treat like updatable "LFThunk"... - -- Imported things which we *do* know something about use - -- one of the other LF constructors (eg LFReEntrant for - -- known functions) - !Bool -- True <=> *might* be a function type - -- The False case is good when we want to enter it, - -- because then we know the entry code will do - -- For a function, the entry code is the fast entry point - - | LFUnlifted -- A value of unboxed type; - -- always a value, needs evaluation - - | LFLetNoEscape -- See LetNoEscape module for precise description - - -------------------------- --- StandardFormInfo tells whether this thunk has one of --- a small number of standard forms - -data StandardFormInfo - = NonStandardThunk - -- The usual case: not of the standard forms - - | SelectorThunk - -- A SelectorThunk is of form - -- case x of - -- con a1,..,an -> ak - -- and the constructor is from a single-constr type. - WordOff -- 0-origin offset of ak within the "goods" of - -- constructor (Recall that the a1,...,an may be laid - -- out in the heap in a non-obvious order.) - - | ApThunk - -- An ApThunk is of form - -- x1 ... xn - -- The code for the thunk just pushes x2..xn on the stack and enters x1. - -- There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled - -- in the RTS to save space. - RepArity -- Arity, n - - ------------------------------------------------------ -- Building LambdaFormInfo ------------------------------------------------------ @@ -327,18 +257,22 @@ mkApLFInfo id upd_flag arity ------------- mkLFImported :: Id -> LambdaFormInfo -mkLFImported id - | Just con <- isDataConWorkId_maybe id - , isNullaryRepDataCon con - = LFCon con -- An imported nullary constructor - -- We assume that the constructor is evaluated so that - -- the id really does point directly to the constructor - - | arity > 0 - = LFReEntrant TopLevel noOneShotInfo arity True (panic "arg_descr") - - | otherwise - = mkLFArgument id -- Not sure of exact arity +mkLFImported id = + case idLFInfo_maybe id of + Just lf_info -> + lf_info + Nothing + | Just con <- isDataConWorkId_maybe id + , isNullaryRepDataCon con + -> LFCon con -- An imported nullary constructor + -- We assume that the constructor is evaluated so that + -- the id really does point directly to the constructor + + | arity > 0 + -> LFReEntrant TopLevel noOneShotInfo arity True ArgUnknown + + | otherwise + -> mkLFArgument id -- Not sure of exact arity where arity = idFunRepArity id ===================================== compiler/GHC/StgToCmm/Types.hs ===================================== @@ -0,0 +1,157 @@ +{-# LANGUAGE CPP #-} + +module GHC.StgToCmm.Types + ( WordOff + , LambdaFormInfo (..) + , ModuleLFInfos + , Liveness + , ArgDescr (..) + , StandardFormInfo (..) + ) where + +#include "HsVersions.h" + +import GhcPrelude + +import BasicTypes +import GHC.Core.DataCon +import NameEnv +import Outputable + +-- | Word offset, or word count +type WordOff = Int + +-------------------------------------------------------------------------------- +-- LambdaFormInfo +-------------------------------------------------------------------------------- + +-- | Maps names in the current module to their LambdaFormInfos +type ModuleLFInfos = NameEnv LambdaFormInfo + +-- Information about an identifier, from the code generator's point of view. +-- Every identifier is bound to a LambdaFormInfo in the environment, which gives +-- the code generator enough info to be able to tail call or return that +-- identifier. + +data LambdaFormInfo + = LFReEntrant -- Reentrant closure (a function) + !TopLevelFlag -- True if top level + !OneShotInfo + !RepArity -- Arity. Invariant: always > 0 + !Bool -- True <=> no fvs + !ArgDescr -- Argument descriptor (should really be in ClosureInfo) + + | LFThunk -- Thunk (zero arity) + !TopLevelFlag + !Bool -- True <=> no free vars + !Bool -- True <=> updatable (i.e., *not* single-entry) + !StandardFormInfo + !Bool -- True <=> *might* be a function type + + | LFCon -- A saturated constructor application + !DataCon -- The constructor + + | LFUnknown -- Used for function arguments and imported things. + -- We know nothing about this closure. + -- Treat like updatable "LFThunk"... + -- Imported things which we *do* know something about use + -- one of the other LF constructors (eg LFReEntrant for + -- known functions) + !Bool -- True <=> *might* be a function type + -- The False case is good when we want to enter it, + -- because then we know the entry code will do + -- For a function, the entry code is the fast entry point + + | LFUnlifted -- A value of unboxed type; + -- always a value, needs evaluation + + | LFLetNoEscape -- See LetNoEscape module for precise description + +instance Outputable LambdaFormInfo where + ppr (LFReEntrant top oneshot rep fvs argdesc) = + text "LFReEntrant" <> brackets (ppr top <+> ppr oneshot <+> + ppr rep <+> pprFvs fvs <+> ppr argdesc) + ppr (LFThunk top hasfv updateable sfi m_function) = + text "LFThunk" <> brackets (ppr top <+> pprFvs hasfv <+> pprUpdateable updateable <+> + ppr sfi <+> pprFuncFlag m_function) + ppr (LFCon con) = text "LFCon" <> brackets (ppr con) + ppr (LFUnknown m_func) = + text "LFUnknown" <> brackets (pprFuncFlag m_func) + ppr LFUnlifted = text "LFUnlifted" + ppr LFLetNoEscape = text "LFLetNoEscape" + +pprFvs :: Bool -> SDoc +pprFvs True = text "no-fvs" +pprFvs False = text "fvs" + +pprFuncFlag :: Bool -> SDoc +pprFuncFlag True = text "mFunc" +pprFuncFlag False = text "value" + +pprUpdateable :: Bool -> SDoc +pprUpdateable True = text "updateable" +pprUpdateable False = text "oneshot" + +-------------------------------------------------------------------------------- + +-- | We represent liveness bitmaps as a Bitmap (whose internal representation +-- really is a bitmap). These are pinned onto case return vectors to indicate +-- the state of the stack for the garbage collector. +-- +-- In the compiled program, liveness bitmaps that fit inside a single word +-- (StgWord) are stored as a single word, while larger bitmaps are stored as a +-- pointer to an array of words. + +type Liveness = [Bool] -- One Bool per word; True <=> non-ptr or dead + -- False <=> ptr + +-------------------------------------------------------------------------------- +-- | An ArgDescr describes the argument pattern of a function + +data ArgDescr + = ArgSpec -- Fits one of the standard patterns + !Int -- RTS type identifier ARG_P, ARG_N, ... + + | ArgGen -- General case + Liveness -- Details about the arguments + + | ArgUnknown -- For imported binds. + -- Invariant: Never Unknown for binds of the module + -- we are compiling. + deriving (Eq) + +instance Outputable ArgDescr where + ppr (ArgSpec n) = text "ArgSpec" <+> ppr n + ppr (ArgGen ls) = text "ArgGen" <+> ppr ls + ppr ArgUnknown = text "ArgUnknown" + +-------------------------------------------------------------------------------- +-- | StandardFormInfo tells whether this thunk has one of a small number of +-- standard forms + +data StandardFormInfo + = NonStandardThunk + -- The usual case: not of the standard forms + + | SelectorThunk + -- A SelectorThunk is of form + -- case x of + -- con a1,..,an -> ak + -- and the constructor is from a single-constr type. + WordOff -- 0-origin offset of ak within the "goods" of + -- constructor (Recall that the a1,...,an may be laid + -- out in the heap in a non-obvious order.) + + | ApThunk + -- An ApThunk is of form + -- x1 ... xn + -- The code for the thunk just pushes x2..xn on the stack and enters x1. + -- There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled + -- in the RTS to save space. + RepArity -- Arity, n + deriving (Eq) + +instance Outputable StandardFormInfo where + ppr NonStandardThunk = text "RegThunk" + ppr (SelectorThunk w) = text "SelThunk:" <> ppr w + ppr (ApThunk n) = text "ApThunk:" <> ppr n ===================================== compiler/basicTypes/Id.hs ===================================== @@ -92,7 +92,7 @@ module Id ( idCallArity, idFunRepArity, idUnfolding, realIdUnfolding, idSpecialisation, idCoreRules, idHasRules, - idCafInfo, + idCafInfo, idLFInfo_maybe, idOneShotInfo, idStateHackOneShotInfo, idOccInfo, isNeverLevPolyId, @@ -105,6 +105,7 @@ module Id ( setIdSpecialisation, setIdCafInfo, setIdOccInfo, zapIdOccInfo, + setIdLFInfo, setIdDemandInfo, setIdStrictness, @@ -731,6 +732,15 @@ idCafInfo id = cafInfo (idInfo id) setIdCafInfo :: Id -> CafInfo -> Id setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id + --------------------------------- + -- Lambda form info + +idLFInfo_maybe :: Id -> Maybe LambdaFormInfo +idLFInfo_maybe = lfInfo . idInfo + +setIdLFInfo :: Id -> LambdaFormInfo -> Id +setIdLFInfo id lf = modifyIdInfo (`setLFInfo` lf) id + --------------------------------- -- Occurrence INFO idOccInfo :: Id -> OccInfo ===================================== compiler/basicTypes/IdInfo.hs ===================================== @@ -74,6 +74,10 @@ module IdInfo ( ppCafInfo, mayHaveCafRefs, cafInfo, setCafInfo, + -- ** The LambdaFormInfo type + LambdaFormInfo(..), + lfInfo, setLFInfo, + -- ** Tick-box Info TickBoxOp(..), TickBoxId, @@ -104,6 +108,8 @@ import Demand import Cpr import Util +import GHC.StgToCmm.Types (LambdaFormInfo (..)) + -- infixl so you can say (id `set` a `set` b) infixl 1 `setRuleInfo`, `setArityInfo`, @@ -270,8 +276,9 @@ data IdInfo -- ^ 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 + levityInfo :: LevityInfo, -- ^ when applied, will this Id ever have a levity-polymorphic type? + lfInfo :: !(Maybe LambdaFormInfo) } -- Setters @@ -294,13 +301,18 @@ setUnfoldingInfo info uf setArityInfo :: IdInfo -> ArityInfo -> IdInfo setArityInfo info ar = info { arityInfo = ar } + setCallArityInfo :: IdInfo -> ArityInfo -> IdInfo setCallArityInfo info ar = info { callArityInfo = ar } + setCafInfo :: IdInfo -> CafInfo -> IdInfo -setCafInfo info caf = info { cafInfo = caf } +setCafInfo info caf = info { cafInfo = caf } + +setLFInfo :: IdInfo -> LambdaFormInfo -> IdInfo +setLFInfo info lf = info { lfInfo = Just lf } setOneShotInfo :: IdInfo -> OneShotInfo -> IdInfo -setOneShotInfo info lb = {-lb `seq`-} info { oneShotInfo = lb } +setOneShotInfo info lb = {-lb `seq`-} info { oneShotInfo = lb } setDemandInfo :: IdInfo -> Demand -> IdInfo setDemandInfo info dd = dd `seq` info { demandInfo = dd } @@ -326,7 +338,8 @@ vanillaIdInfo strictnessInfo = nopSig, cprInfo = topCprSig, callArityInfo = unknownArity, - levityInfo = NoLevityInfo + levityInfo = NoLevityInfo, + lfInfo = Nothing } -- | More informative 'IdInfo' we can use when we know the 'Id' has no CAF references ===================================== compiler/ghc.cabal.in ===================================== @@ -229,7 +229,7 @@ Library SrcLoc UniqSupply Unique - UpdateCafInfos + UpdateIdInfos Var VarEnv VarSet @@ -298,6 +298,7 @@ Library GHC.StgToCmm.Ticky GHC.StgToCmm.Utils GHC.StgToCmm.ExtCode + GHC.StgToCmm.Types GHC.Runtime.Heap.Layout GHC.Core.Arity GHC.Core.FVs ===================================== compiler/main/UpdateCafInfos.hs → compiler/main/UpdateIdInfos.hs ===================================== @@ -1,7 +1,7 @@ {-# LANGUAGE CPP, BangPatterns, Strict, RecordWildCards #-} -module UpdateCafInfos - ( updateModDetailsCafInfos +module UpdateIdInfos + ( updateModDetailsIdInfos ) where import GhcPrelude @@ -17,22 +17,23 @@ import NameSet import Util import Var import Outputable +import GHC.StgToCmm.Types (ModuleLFInfos) #include "HsVersions.h" --- | Update CafInfos of all occurences (in rules, unfoldings, class instances) -updateModDetailsCafInfos +-- | Update CafInfos and LFInfos of all occurences (in rules, unfoldings, class instances) +updateModDetailsIdInfos :: DynFlags -> NameSet -- ^ Non-CAFFY names in the module. Names not in this set are CAFFY. + -> ModuleLFInfos -> ModDetails -- ^ ModDetails to update -> ModDetails -updateModDetailsCafInfos dflags _ mod_details +updateModDetailsIdInfos dflags _ _ mod_details | gopt Opt_OmitInterfacePragmas dflags = mod_details -updateModDetailsCafInfos _ non_cafs mod_details = - {- pprTrace "updateModDetailsCafInfos" (text "non_cafs:" <+> ppr non_cafs) $ -} +updateModDetailsIdInfos _ non_cafs lf_infos mod_details = let ModDetails{ md_types = type_env -- for unfoldings , md_insts = insts @@ -40,11 +41,11 @@ updateModDetailsCafInfos _ non_cafs mod_details = } = mod_details -- type TypeEnv = NameEnv TyThing - ~type_env' = mapNameEnv (updateTyThingCafInfos type_env' non_cafs) type_env + ~type_env' = mapNameEnv (updateTyThingCafInfos type_env' non_cafs lf_infos) type_env -- Not strict! - !insts' = strictMap (updateInstCafInfos type_env' non_cafs) insts - !rules' = strictMap (updateRuleCafInfos type_env') rules + !insts' = strictMap (updateInstIdInfos type_env' non_cafs lf_infos) insts + !rules' = strictMap (updateRuleIdInfos type_env') rules in mod_details{ md_types = type_env' , md_insts = insts' @@ -55,28 +56,28 @@ updateModDetailsCafInfos _ non_cafs mod_details = -- Rules -------------------------------------------------------------------------------- -updateRuleCafInfos :: TypeEnv -> CoreRule -> CoreRule -updateRuleCafInfos _ rule at BuiltinRule{} = rule -updateRuleCafInfos type_env Rule{ .. } = Rule { ru_rhs = updateGlobalIds type_env ru_rhs, .. } +updateRuleIdInfos :: TypeEnv -> CoreRule -> CoreRule +updateRuleIdInfos _ rule at BuiltinRule{} = rule +updateRuleIdInfos type_env Rule{ .. } = Rule { ru_rhs = updateGlobalIds type_env ru_rhs, .. } -------------------------------------------------------------------------------- -- Instances -------------------------------------------------------------------------------- -updateInstCafInfos :: TypeEnv -> NameSet -> ClsInst -> ClsInst -updateInstCafInfos type_env non_cafs = - updateClsInstDFun (updateIdUnfolding type_env . updateIdCafInfo non_cafs) +updateInstIdInfos :: TypeEnv -> NameSet -> ModuleLFInfos -> ClsInst -> ClsInst +updateInstIdInfos type_env non_cafs lf_infos = + updateClsInstDFun (updateIdUnfolding type_env . updateIdInfo non_cafs lf_infos) -------------------------------------------------------------------------------- -- TyThings -------------------------------------------------------------------------------- -updateTyThingCafInfos :: TypeEnv -> NameSet -> TyThing -> TyThing +updateTyThingCafInfos :: TypeEnv -> NameSet -> ModuleLFInfos -> TyThing -> TyThing -updateTyThingCafInfos type_env non_cafs (AnId id) = - AnId (updateIdUnfolding type_env (updateIdCafInfo non_cafs id)) +updateTyThingCafInfos type_env non_cafs lf_infos (AnId id) = + AnId (updateIdUnfolding type_env (updateIdInfo non_cafs lf_infos id)) -updateTyThingCafInfos _ _ other = other -- AConLike, ATyCon, ACoAxiom +updateTyThingCafInfos _ _ _ other = other -- AConLike, ATyCon, ACoAxiom -------------------------------------------------------------------------------- -- Unfoldings @@ -95,13 +96,18 @@ updateIdUnfolding type_env id = -- Expressions -------------------------------------------------------------------------------- -updateIdCafInfo :: NameSet -> Id -> Id -updateIdCafInfo non_cafs id - | idName id `elemNameSet` non_cafs - = -- pprTrace "updateIdCafInfo" (text "Marking" <+> ppr id <+> parens (ppr (idName id)) <+> text "as non-CAFFY") $ - id `setIdCafInfo` NoCafRefs - | otherwise - = id +updateIdInfo :: NameSet -> ModuleLFInfos -> Id -> Id +updateIdInfo non_cafs lf_infos id = + let + not_caffy = elemNameSet (idName id) non_cafs + mb_lf_info = lookupNameEnv lf_infos (idName id) + + id1 = if not_caffy then setIdCafInfo id NoCafRefs else id + id2 = case mb_lf_info of + Nothing -> id1 + Just lf_info -> setIdLFInfo id1 lf_info + in + id2 -------------------------------------------------------------------------------- ===================================== testsuite/tests/codeGen/should_compile/Makefile ===================================== @@ -64,10 +64,10 @@ T17648: # NoCafRefs) to the interface files. '$(TEST_HC)' $(TEST_HC_OPTS) -dno-typeable-binds -O T17648.hs -v0 '$(TEST_HC)' --show-iface T17648.hi | tr -d '\n' | \ - grep -F 'f :: T GHC.Types.Int -> () [HasNoCafRefs, Arity' >/dev/null + grep -F 'f :: T GHC.Types.Int -> () [HasNoCafRefs, LambdaFormInfo' >/dev/null # Second compilation with -fcatch-bottoms, f should be CAFFY '$(TEST_HC)' $(TEST_HC_OPTS) -dno-typeable-binds -O \ -fcatch-bottoms T17648.hs -v0 -fforce-recomp '$(TEST_HC)' --show-iface T17648.hi | tr -d '\n' | \ - grep -F 'f :: T GHC.Types.Int -> () [Arity: 1, Strictness' >/dev/null + grep -F 'f :: T GHC.Types.Int -> () [LambdaFormInfo' >/dev/null ===================================== testsuite/tests/codeGen/should_compile/cg009/A.hs ===================================== @@ -0,0 +1,5 @@ +module A where + +newtype A = A Int + +val = A 42 ===================================== testsuite/tests/codeGen/should_compile/cg009/Main.hs ===================================== @@ -0,0 +1,7 @@ +module Main where + +import A + +main = return () + +a = val ===================================== testsuite/tests/codeGen/should_compile/cg009/Makefile ===================================== @@ -0,0 +1,9 @@ +TOP=../../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +# Make sure the LFInfo for an exported, but not directly used newtype +# constructors does not trip up the compiler. +cg009: + '$(TEST_HC)' $(TEST_HC_OPTS) -c -O A.hs -fforce-recomp + '$(TEST_HC)' $(TEST_HC_OPTS) -c -O0 Main.hs -fforce-recomp ===================================== testsuite/tests/codeGen/should_compile/cg009/all.T ===================================== @@ -0,0 +1 @@ +test('cg009', [extra_files(['A.hs','Main.hs'])], makefile_test, ['cg009']) ===================================== testsuite/tests/codeGen/should_compile/cg010/A.hs ===================================== @@ -0,0 +1,4 @@ +module A where + +{-# NOINLINE val #-} +val = Just 42 ===================================== testsuite/tests/codeGen/should_compile/cg010/Main.hs ===================================== @@ -0,0 +1,8 @@ +module Main where + +import A + +main = return () + +a = val + ===================================== testsuite/tests/codeGen/should_compile/cg010/Makefile ===================================== @@ -0,0 +1,9 @@ +TOP=../../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +# Make sure LFInfo causes the imported reference to val to get tagged. +cg010: + '$(TEST_HC)' $(TEST_HC_OPTS) -c -O A.hs -fforce-recomp + '$(TEST_HC)' $(TEST_HC_OPTS) -c -O Main.hs -fforce-recomp -ddump-cmm -ddump-to-file + grep "A.val_closure+2" Main.dump-cmm ===================================== testsuite/tests/codeGen/should_compile/cg010/all.T ===================================== @@ -0,0 +1 @@ +test('cg010', [extra_files(['A.hs','Main.hs'])], makefile_test, ['cg010']) ===================================== testsuite/tests/codeGen/should_compile/cg010/cg010.stdout ===================================== @@ -0,0 +1 @@ + const A.val_closure+2; ===================================== testsuite/tests/simplCore/should_compile/Makefile ===================================== @@ -102,7 +102,7 @@ T4201: '$(TEST_HC)' $(TEST_HC_OPTS) -c -O T4201.hs '$(TEST_HC)' $(TEST_HC_OPTS) --show-iface T4201.hi > T4201.list # poor man idea about how to replace GNU grep -B2 "Sym" invocation with pure POSIX tools - for i in `grep -n "Sym" T4201.list |cut -d ':' -f -1`; do head -$$i T4201.list | tail -3 ; done + for i in `grep -n "Sym" T4201.list | cut -d ':' -f -1`; do head -$$i T4201.list | tail -4; done $(RM) -f T4201.list # This one looped as a result of bogus specialisation ===================================== testsuite/tests/simplCore/should_compile/T4201.stdout ===================================== @@ -1,3 +1,4 @@ - [HasNoCafRefs, Arity: 1, Strictness: , CPR: m1, + [HasNoCafRefs, LambdaFormInfo: LFReEntrant 1, Arity: 1, + Strictness: , CPR: m1, Unfolding: InlineRule (0, True, True) bof `cast` (Sym (N:Foo[0]) ->_R _R)] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9f7e4c7193ce2122bd3ff5532ad284a7c8041605 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9f7e4c7193ce2122bd3ff5532ad284a7c8041605 You're receiving 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 Mar 25 09:26:35 2020 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Wed, 25 Mar 2020 05:26:35 -0400 Subject: [Git][ghc/ghc][wip/compact-iface] 8.6.5 hack, for now Message-ID: <5e7b23cb78da9_61673f81cd4b0f584764d0@gitlab.haskell.org.mail> Matthew Pickering pushed to branch wip/compact-iface at Glasgow Haskell Compiler / GHC Commits: 0e1ef282 by Matthew Pickering at 2020-03-25T09:26:01+00:00 8.6.5 hack, for now This instance is only used in rare code paths such as HieFiles - - - - - 1 changed file: - compiler/utils/Binary.hs Changes: ===================================== compiler/utils/Binary.hs ===================================== @@ -1122,10 +1122,12 @@ putBS bh bs = putPrim bh l (\op -> BS.memcpy op (castPtr ptr) l) putSBS :: BinHandle -> ShortByteString -> IO () -putSBS bh bs = +putSBS bh bs = putBS bh (BSS.fromShort bs) +{- BSS.useAsCStringLen bs $ \(ptr, l) -> do put_ bh l putPrim bh l (\op -> BS.memcpy op (castPtr ptr) l) + -} getSBS :: BinHandle -> IO ShortByteString getSBS bh = do View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0e1ef2821f793b370972d0378a67c3b84a485e5d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0e1ef2821f793b370972d0378a67c3b84a485e5d You're receiving 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 Mar 25 09:44:39 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 25 Mar 2020 05:44:39 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: Add example and doc for Arg (Fixes #17153) Message-ID: <5e7b280789e14_6167e0e2c94479390@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 2643ba46 by Paavo at 2020-03-24T08:31:32-04:00 Add example and doc for Arg (Fixes #17153) - - - - - 718fcf3a by Roland Senn at 2020-03-25T05:44:28-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. - - - - - 1e312fd9 by Sebastian Graf at 2020-03-25T05:44:29-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. - - - - - 25 changed files: - compiler/GHC/Core/Op/DmdAnal.hs - compiler/GHC/Driver/Session.hs - compiler/basicTypes/Demand.hs - compiler/typecheck/TcExpr.hs - compiler/typecheck/TcRnDriver.hs - libraries/base/Data/Semigroup.hs - + testsuite/tests/typecheck/should_fail/T16453E1.hs - + testsuite/tests/typecheck/should_fail/T16453E1.stderr - + testsuite/tests/typecheck/should_fail/T16453E2.hs - + testsuite/tests/typecheck/should_fail/T16453E2.stderr - + testsuite/tests/typecheck/should_fail/T16453S.hs - + testsuite/tests/typecheck/should_fail/T16453T.hs - testsuite/tests/typecheck/should_fail/all.T - + testsuite/tests/typecheck/should_run/T16453M0.hs - + testsuite/tests/typecheck/should_run/T16453M0.stdout - + testsuite/tests/typecheck/should_run/T16453M1.hs - + testsuite/tests/typecheck/should_run/T16453M1.stdout - + testsuite/tests/typecheck/should_run/T16453M2.hs - + testsuite/tests/typecheck/should_run/T16453M2.stdout - + testsuite/tests/typecheck/should_run/T16453M3.hs - + testsuite/tests/typecheck/should_run/T16453M3.stdout - + testsuite/tests/typecheck/should_run/T16453M4.hs - + testsuite/tests/typecheck/should_run/T16453M4.stdout - + testsuite/tests/typecheck/should_run/T16453T.hs - testsuite/tests/typecheck/should_run/all.T Changes: ===================================== compiler/GHC/Core/Op/DmdAnal.hs ===================================== @@ -603,7 +603,7 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs -- TODO: Won't the following line unnecessarily trim down arity for join -- points returning a lambda in a C(S) context? sig = mkStrictSigForArity rhs_arity (mkDmdType sig_fv rhs_dmds rhs_div) - id' = set_idStrictness env id sig + id' = setIdStrictness id sig -- See Note [NOINLINE and strictness] @@ -1171,8 +1171,7 @@ findBndrDmd :: AnalEnv -> Bool -> DmdType -> Id -> (DmdType, Demand) findBndrDmd env arg_of_dfun dmd_ty id = (dmd_ty', dmd') where - dmd' = killUsageDemand (ae_dflags env) $ - strictify $ + dmd' = strictify $ trimToType starting_dmd (findTypeShape fam_envs id_ty) (dmd_ty', starting_dmd) = peelFV dmd_ty id @@ -1191,10 +1190,6 @@ findBndrDmd env arg_of_dfun dmd_ty id fam_envs = ae_fam_envs env -set_idStrictness :: AnalEnv -> Id -> StrictSig -> Id -set_idStrictness env id sig - = setIdStrictness id (killUsageSig (ae_dflags env) sig) - {- Note [Initialising strictness] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ See section 9.2 (Finding fixpoints) of the paper. ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -3568,8 +3568,6 @@ fFlagsDeps = [ flagGhciSpec "implicit-import-qualified" Opt_ImplicitImportQualified, flagSpec "irrefutable-tuples" Opt_IrrefutableTuples, flagSpec "keep-going" Opt_KeepGoing, - flagSpec "kill-absence" Opt_KillAbsence, - flagSpec "kill-one-shot" Opt_KillOneShot, flagSpec "late-dmd-anal" Opt_LateDmdAnal, flagSpec "late-specialise" Opt_LateSpecialise, flagSpec "liberate-case" Opt_LiberateCase, ===================================== compiler/basicTypes/Demand.hs ===================================== @@ -50,7 +50,7 @@ module Demand ( TypeShape(..), peelTsFuns, trimToType, useCount, isUsedOnce, reuseEnv, - killUsageDemand, killUsageSig, zapUsageDemand, zapUsageEnvSig, + zapUsageDemand, zapUsageEnvSig, zapUsedOnceDemand, zapUsedOnceSig, strictifyDictDmd, strictifyDmd @@ -60,7 +60,6 @@ module Demand ( import GhcPrelude -import GHC.Driver.Session import Outputable import Var ( Var ) import VarEnv @@ -1754,14 +1753,6 @@ that it is going to diverge. This is the reason why we use the function appIsBottom, which, given a strictness signature and a number of arguments, says conservatively if the function is going to diverge or not. - -Zap absence or one-shot information, under control of flags - -Note [Killing usage information] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The flags -fkill-one-shot and -fkill-absence let you switch off the generation -of absence or one-shot information altogether. This is only used for performance -tests, to see how important they are. -} zapUsageEnvSig :: StrictSig -> StrictSig @@ -1790,34 +1781,12 @@ zapUsedOnceSig :: StrictSig -> StrictSig zapUsedOnceSig (StrictSig (DmdType env ds r)) = StrictSig (DmdType env (map zapUsedOnceDemand ds) r) -killUsageDemand :: DynFlags -> Demand -> Demand --- See Note [Killing usage information] -killUsageDemand dflags dmd - | Just kfs <- killFlags dflags = kill_usage kfs dmd - | otherwise = dmd - -killUsageSig :: DynFlags -> StrictSig -> StrictSig --- See Note [Killing usage information] -killUsageSig dflags sig@(StrictSig (DmdType env ds r)) - | Just kfs <- killFlags dflags = StrictSig (DmdType env (map (kill_usage kfs) ds) r) - | otherwise = sig - data KillFlags = KillFlags { kf_abs :: Bool , kf_used_once :: Bool , kf_called_once :: Bool } -killFlags :: DynFlags -> Maybe KillFlags --- See Note [Killing usage information] -killFlags dflags - | not kf_abs && not kf_used_once = Nothing - | otherwise = Just (KillFlags {..}) - where - kf_abs = gopt Opt_KillAbsence dflags - kf_used_once = gopt Opt_KillOneShot dflags - kf_called_once = kf_used_once - kill_usage :: KillFlags -> Demand -> Demand kill_usage kfs (JD {sd = s, ud = u}) = JD {sd = s, ud = zap_musg kfs u} ===================================== compiler/typecheck/TcExpr.hs ===================================== @@ -17,6 +17,7 @@ module TcExpr ( tcPolyExpr, tcMonoExpr, tcMonoExprNC, tcSyntaxOp, tcSyntaxOpGen, SyntaxOpType(..), synKnownType, tcCheckId, addExprErrCtxt, + addAmbiguousNameErr, getFixedTyVars ) where #include "HsVersions.h" @@ -2193,10 +2194,16 @@ disambiguateSelector lr@(L _ rdr) parent_type -- occurrence" error, then give up. ambiguousSelector :: Located RdrName -> TcM a ambiguousSelector (L _ rdr) + = do { addAmbiguousNameErr rdr + ; failM } + +-- | This name really is ambiguous, so add a suitable "ambiguous +-- occurrence" error, then continue +addAmbiguousNameErr :: RdrName -> TcM () +addAmbiguousNameErr rdr = do { env <- getGlobalRdrEnv ; let gres = lookupGRE_RdrName rdr env - ; setErrCtxt [] $ addNameClashErrRn rdr gres - ; failM } + ; setErrCtxt [] $ addNameClashErrRn rdr gres} -- Disambiguate the fields in a record update. -- See Note [Disambiguating record fields] ===================================== compiler/typecheck/TcRnDriver.hs ===================================== @@ -129,7 +129,7 @@ import GHC.Core.Class import BasicTypes hiding( SuccessFlag(..) ) import GHC.Core.Coercion.Axiom import Annotations -import Data.List ( sortBy, sort ) +import Data.List ( find, sortBy, sort ) import Data.Ord import FastString import Maybes @@ -268,17 +268,13 @@ tcRnModuleTcRnM hsc_env mod_sum ; tcg_env <- if isHsBootOrSig hsc_src then tcRnHsBootDecls hsc_src local_decls else {-# SCC "tcRnSrcDecls" #-} - tcRnSrcDecls explicit_mod_hdr local_decls + tcRnSrcDecls explicit_mod_hdr local_decls export_ies ; setGblEnv tcg_env $ do { -- Process the export list traceRn "rn4a: before exports" empty ; tcg_env <- tcRnExports explicit_mod_hdr export_ies tcg_env ; traceRn "rn4b: after exports" empty - ; -- When a module header is specified, - -- check that the main module exports a main function. - -- (must be after tcRnExports) - when explicit_mod_hdr $ checkMainExported tcg_env ; -- Compare hi-boot iface (if any) with the real thing -- Must be done after processing the exports tcg_env <- checkHiBootIface tcg_env boot_info @@ -400,8 +396,9 @@ tcRnImports hsc_env import_decls tcRnSrcDecls :: Bool -- False => no 'module M(..) where' header at all -> [LHsDecl GhcPs] -- Declarations + -> Maybe (Located [LIE GhcPs]) -> TcM TcGblEnv -tcRnSrcDecls explicit_mod_hdr decls +tcRnSrcDecls explicit_mod_hdr decls export_ies = do { -- Do all the declarations ; (tcg_env, tcl_env, lie) <- tc_rn_src_decls decls @@ -410,7 +407,7 @@ tcRnSrcDecls explicit_mod_hdr decls -- NB: always set envs *before* captureTopConstraints ; (tcg_env, lie_main) <- setEnvs (tcg_env, tcl_env) $ captureTopConstraints $ - checkMain explicit_mod_hdr + checkMain explicit_mod_hdr export_ies ; setEnvs (tcg_env, tcl_env) $ do { @@ -1719,29 +1716,69 @@ tcTyClsInstDecls tycl_decls deriv_decls binds -} checkMain :: Bool -- False => no 'module M(..) where' header at all + -> Maybe (Located [LIE GhcPs]) -- Export specs of Main module -> TcM TcGblEnv --- If we are in module Main, check that 'main' is defined. -checkMain explicit_mod_hdr +-- If we are in module Main, check that 'main' is defined and exported. +checkMain explicit_mod_hdr export_ies = do { dflags <- getDynFlags ; tcg_env <- getGblEnv - ; check_main dflags tcg_env explicit_mod_hdr } + ; check_main dflags tcg_env explicit_mod_hdr export_ies } -check_main :: DynFlags -> TcGblEnv -> Bool -> TcM TcGblEnv -check_main dflags tcg_env explicit_mod_hdr +check_main :: DynFlags -> TcGblEnv -> Bool -> Maybe (Located [LIE GhcPs]) + -> TcM TcGblEnv +check_main dflags tcg_env explicit_mod_hdr export_ies | mod /= main_mod = traceTc "checkMain not" (ppr main_mod <+> ppr mod) >> return tcg_env | otherwise - = do { mb_main <- lookupGlobalOccRn_maybe main_fn - -- Check that 'main' is in scope - -- It might be imported from another module! - ; case mb_main of { - Nothing -> do { traceTc "checkMain fail" (ppr main_mod <+> ppr main_fn) - ; complain_no_main - ; return tcg_env } ; - Just main_name -> do + -- Compare the list of main functions in scope with those + -- specified in the export list. + = do mains_all <- lookupInfoOccRn main_fn + -- get all 'main' functions in scope + -- They may also be imported from other modules! + case exportedMains of -- check the main(s) specified in the export list + [ ] -> do + -- The module has no main functions in the export spec, so we must give + -- some kind of error message. The tricky part is giving an error message + -- that accurately characterizes what the problem is. + -- See Note [Main module without a main function in the export spec] + traceTc "checkMain no main module exported" ppr_mod_mainfn + complain_no_main + -- In order to reduce the number of potential error messages, we check + -- to see if there are any main functions defined (but not exported)... + case getSomeMain mains_all of + Nothing -> return tcg_env + -- ...if there are no such main functions, there is nothing we can do... + Just some_main -> use_as_main some_main + -- ...if there is such a main function, then communicate this to the + -- typechecker. This can prevent a spurious "Ambiguous type variable" + -- error message in certain cases, as described in + -- Note [Main module without a main function in the export spec]. + _ -> do -- The module has one or more main functions in the export spec + let mains = filterInsMains exportedMains mains_all + case mains of + [] -> do -- + traceTc "checkMain fail" ppr_mod_mainfn + complain_no_main + return tcg_env + [main_name] -> use_as_main main_name + _ -> do -- multiple main functions are exported + addAmbiguousNameErr main_fn -- issue error msg + return tcg_env + where + mod = tcg_mod tcg_env + main_mod = mainModIs dflags + main_mod_nm = moduleName main_mod + main_fn = getMainFun dflags + occ_main_fn = occName main_fn + interactive = ghcLink dflags == LinkInMemory + exportedMains = selExportMains export_ies + ppr_mod_mainfn = ppr main_mod <+> ppr main_fn + -- There is a single exported 'main' function. + use_as_main :: Name -> TcM TcGblEnv + use_as_main main_name = do { traceTc "checkMain found" (ppr main_mod <+> ppr main_fn) ; let loc = srcLocSpan (getSrcLoc main_name) ; ioTyCon <- tcLookupTyCon ioTyConName @@ -1779,13 +1816,7 @@ check_main dflags tcg_env explicit_mod_hdr `plusDU` usesOnly (unitFV main_name) -- Record the use of 'main', so that we don't -- complain about it being defined but not used - }) - }}} - where - mod = tcg_mod tcg_env - main_mod = mainModIs dflags - main_fn = getMainFun dflags - interactive = ghcLink dflags == LinkInMemory + })} complain_no_main = unless (interactive && not explicit_mod_hdr) (addErrTc noMainMsg) -- #12906 @@ -1795,9 +1826,56 @@ check_main dflags tcg_env explicit_mod_hdr mainCtxt = text "When checking the type of the" <+> pp_main_fn noMainMsg = text "The" <+> pp_main_fn - <+> text "is not defined in module" <+> quotes (ppr main_mod) + <+> text "is not" <+> text defOrExp <+> text "module" + <+> quotes (ppr main_mod) + defOrExp = if null exportedMains then "exported by" else "defined in" + pp_main_fn = ppMainFn main_fn + -- Select the main functions from the export list. + -- Only the module name is needed, the function name is fixed. + selExportMains :: Maybe (Located [LIE GhcPs]) -> [ModuleName] -- #16453 + selExportMains Nothing = [main_mod_nm] + -- no main specified, but there is a header. + selExportMains (Just exps) = fmap fst $ + filter (\(_,n) -> n == occ_main_fn ) texp + where + ies = fmap unLoc $ unLoc exps + texp = mapMaybe transExportIE ies + + -- Filter all main functions in scope that match the export specs + filterInsMains :: [ModuleName] -> [Name] -> [Name] -- #16453 + filterInsMains export_mains inscope_mains = + [mod | mod <- inscope_mains, + (moduleName . nameModule) mod `elem` export_mains] + + -- Transform an export_ie to a (ModuleName, OccName) pair. + -- 'IEVar' constructors contain exported values (functions), eg '(Main.main)' + -- 'IEModuleContents' constructors contain fully exported modules, eg '(Main)' + -- All other 'IE...' constructors are not used and transformed to Nothing. + transExportIE :: IE GhcPs -> Maybe (ModuleName, OccName) -- #16453 + transExportIE (IEVar _ var) = isQual_maybe $ + upqual $ ieWrappedName $ unLoc var + where + -- A module name is always needed, so qualify 'UnQual' rdr names. + upqual (Unqual occ) = Qual main_mod_nm occ + upqual rdr = rdr + transExportIE (IEModuleContents _ mod) = Just (unLoc mod, occ_main_fn) + transExportIE _ = Nothing + + -- Get a main function that is in scope. + -- See Note [Main module without a main function in the export spec] + getSomeMain :: [Name] -> Maybe Name -- #16453 + getSomeMain all_mains = case all_mains of + [] -> Nothing -- No main function in scope + [m] -> Just m -- Just one main function in scope + _ -> case mbMainOfMain of + Nothing -> listToMaybe all_mains -- Take the first main function in scope or Nothing + _ -> mbMainOfMain -- Take the Main module's main function or Nothing + where + mbMainOfMain = find (\n -> (moduleName . nameModule) n == main_mod_nm ) + all_mains -- the main function of the Main module + -- | Get the unqualified name of the function to use as the \"main\" for the main module. -- Either returns the default name or the one configured on the command line with -main-is getMainFun :: DynFlags -> RdrName @@ -1805,19 +1883,6 @@ getMainFun dflags = case mainFunIs dflags of Just fn -> mkRdrUnqual (mkVarOccFS (mkFastString fn)) Nothing -> main_RDR_Unqual --- If we are in module Main, check that 'main' is exported. -checkMainExported :: TcGblEnv -> TcM () -checkMainExported tcg_env - = case tcg_main tcg_env of - Nothing -> return () -- not the main module - Just main_name -> - do { dflags <- getDynFlags - ; let main_mod = mainModIs dflags - ; checkTc (main_name `elem` - concatMap availNames (tcg_exports tcg_env)) $ - text "The" <+> ppMainFn (nameRdrName main_name) <+> - text "is not exported by module" <+> quotes (ppr main_mod) } - ppMainFn :: RdrName -> SDoc ppMainFn main_fn | rdrNameOcc main_fn == mainOcc @@ -1842,6 +1907,53 @@ module. Tiresomely, we must filter it out again in GHC.Iface.Make, less we get two defns for 'main' in the interface file! +Note [Main module without a main function in the export spec] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Giving accurate error messages for a Main module that does not export a main +function is surprisingly tricky. To see why, consider a module in a file +`Foo.hs` that has no `main` function in the explicit export specs of the module +header: + + module Main () where + foo = return () + +This does not export a main function and therefore should be rejected, per +chapter 5 of the Haskell Report 2010: + + A Haskell program is a collection of modules, one of which, by convention, + must be called Main and must export the value main. The value of the + program is the value of the identifier main in module Main, which must be + a computation of type IO τ for some type τ. + +In fact, when you compile the program above using `ghc Foo.hs`, you will +actually get *two* errors: + + - The IO action ‘main’ is not defined in module ‘Main’ + + - Ambiguous type variable ‘m0’ arising from a use of ‘return’ + prevents the constraint ‘(Monad m0)’ from being solved. + +The first error is self-explanatory, while the second error message occurs +due to the monomorphism restriction. + +Now consider what would happen if the program above were compiled with +`ghc -main-is foo Foo`. The has the effect of `foo` being designated as the +main function. The program will still be rejected since it does not export +`foo` (and therefore does not export its main function), but there is one +important difference: `foo` will be checked against the type `IO τ`. As a +result, we would *not* expect the monomorphism restriction error message +to occur, since the typechecker should have no trouble figuring out the type +of `foo`. In other words, we should only throw the former error message, +not the latter. + +The implementation uses the function `getSomeMain` to find a potential main +function that is defined but not exported. If one is found, it is passed to +`use_as_main` to inform the typechecker that the main function should be of +type `IO τ`. See also the `T414` and `T17171a` test cases for similar examples +of programs whose error messages are influenced by the situation described in +this Note. + + ********************************************************* * * GHCi stuff @@ -2574,7 +2686,7 @@ tcRnDeclsi :: HscEnv -> IO (Messages, Maybe TcGblEnv) tcRnDeclsi hsc_env local_decls = runTcInteractive hsc_env $ - tcRnSrcDecls False local_decls + tcRnSrcDecls False local_decls Nothing externaliseAndTidyId :: Module -> Id -> TcM Id externaliseAndTidyId this_mod id ===================================== libraries/base/Data/Semigroup.hs ===================================== @@ -286,7 +286,15 @@ instance Num a => Num (Max a) where -- | 'Arg' isn't itself a 'Semigroup' in its own right, but it can be -- placed inside 'Min' and 'Max' to compute an arg min or arg max. -data Arg a b = Arg a b deriving +-- +-- >>> minimum [ Arg (x * x) x | x <- [-10 .. 10] ] +-- Arg 0 0 +data Arg a b = Arg + a + -- ^ The argument used for comparisons in 'Eq' and 'Ord'. + b + -- ^ The "value" exposed via the 'Functor', 'Foldable' etc. instances. + deriving ( Show -- ^ @since 4.9.0.0 , Read -- ^ @since 4.9.0.0 , Data -- ^ @since 4.9.0.0 ===================================== testsuite/tests/typecheck/should_fail/T16453E1.hs ===================================== @@ -0,0 +1,2 @@ +module Main where +import T16453T ===================================== testsuite/tests/typecheck/should_fail/T16453E1.stderr ===================================== @@ -0,0 +1,2 @@ +T16453E1.hs:1:1: error: + The IO action ‘main’ is not defined in module ‘Main’ ===================================== testsuite/tests/typecheck/should_fail/T16453E2.hs ===================================== @@ -0,0 +1,3 @@ +module Main (T16453T.main, T16453S.main) where +import T16453T +import T16453S ===================================== testsuite/tests/typecheck/should_fail/T16453E2.stderr ===================================== @@ -0,0 +1,9 @@ +T16453E2.hs:1:1: + Ambiguous occurrence ‘main’ + It could refer to + either ‘T16453T.main’, + imported from ‘T16453T’ at T16453E2.hs:2:1-14 + (and originally defined at T16453T.hs:2:1-4) + or ‘T16453S.main’, + imported from ‘T16453S’ at T16453E2.hs:3:1-14 + (and originally defined at T16453S.hs:2:1-4) ===================================== testsuite/tests/typecheck/should_fail/T16453S.hs ===================================== @@ -0,0 +1,2 @@ +module T16453S where +main = putStrLn "T16453S" ===================================== testsuite/tests/typecheck/should_fail/T16453T.hs ===================================== @@ -0,0 +1,2 @@ +module T16453T where +main = putStrLn "T16453T" ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -516,6 +516,10 @@ test('T16255', normal, compile_fail, ['']) test('T16204c', normal, compile_fail, ['']) test('T16394', normal, compile_fail, ['']) test('T16414', normal, compile_fail, ['']) +test('T16453E1', extra_files(['T16453T.hs', 'T16453S.hs']), multimod_compile_fail, + ['T16453E1.hs', '-v0']) +test('T16453E2', extra_files(['T16453T.hs', 'T16453S.hs']), + multimod_compile_fail, ['T16453E2.hs', '-v0']) test('T16456', normal, compile_fail, ['-fprint-explicit-foralls']) test('T16627', normal, compile_fail, ['']) test('T502', normal, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_run/T16453M0.hs ===================================== @@ -0,0 +1,3 @@ +module Main where +import T16453T +main = putStrLn "T16453M0" ===================================== testsuite/tests/typecheck/should_run/T16453M0.stdout ===================================== @@ -0,0 +1 @@ +T16453M0 ===================================== testsuite/tests/typecheck/should_run/T16453M1.hs ===================================== @@ -0,0 +1,3 @@ +module Main (T16453T.main) where +import T16453T +main = putStrLn "T16453M1" ===================================== testsuite/tests/typecheck/should_run/T16453M1.stdout ===================================== @@ -0,0 +1 @@ +T16453T ===================================== testsuite/tests/typecheck/should_run/T16453M2.hs ===================================== @@ -0,0 +1,3 @@ +module Main (Main.main) where +import T16453T +main = putStrLn "T16453M2" ===================================== testsuite/tests/typecheck/should_run/T16453M2.stdout ===================================== @@ -0,0 +1 @@ +T16453M2 ===================================== testsuite/tests/typecheck/should_run/T16453M3.hs ===================================== @@ -0,0 +1,3 @@ +module Main (module Main) where +import T16453T +main = putStrLn "T16453M3" ===================================== testsuite/tests/typecheck/should_run/T16453M3.stdout ===================================== @@ -0,0 +1 @@ +T16453M3 ===================================== testsuite/tests/typecheck/should_run/T16453M4.hs ===================================== @@ -0,0 +1,3 @@ +module Main (module T16453T) where +import T16453T +main = putStrLn "T16453M4" ===================================== testsuite/tests/typecheck/should_run/T16453M4.stdout ===================================== @@ -0,0 +1 @@ +T16453T ===================================== testsuite/tests/typecheck/should_run/T16453T.hs ===================================== @@ -0,0 +1,2 @@ +module T16453T where +main = putStrLn "T16453T" ===================================== testsuite/tests/typecheck/should_run/all.T ===================================== @@ -135,6 +135,11 @@ test('T14218', normal, compile_and_run, ['']) test('T14236', normal, compile_and_run, ['']) test('T14925', normal, compile_and_run, ['']) test('T14341', normal, compile_and_run, ['']) +test('T16453M0', extra_files(['T16453T.hs']), compile_and_run, ['']) +test('T16453M1', extra_files(['T16453T.hs']), compile_and_run, ['']) +test('T16453M2', extra_files(['T16453T.hs']), compile_and_run, ['']) +test('T16453M3', extra_files(['T16453T.hs']), compile_and_run, ['']) +test('T16453M4', extra_files(['T16453T.hs']), compile_and_run, ['']) test('UnliftedNewtypesRun', normal, compile_and_run, ['']) test('UnliftedNewtypesFamilyRun', normal, compile_and_run, ['']) test('UnliftedNewtypesDependentFamilyRun', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cc480cdcca610621429ca091869af10be8f415f7...1e312fd9c84eb9c49f4d468ff45be79065f2a7be -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cc480cdcca610621429ca091869af10be8f415f7...1e312fd9c84eb9c49f4d468ff45be79065f2a7be You're receiving 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 Mar 25 10:52:38 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 25 Mar 2020 06:52:38 -0400 Subject: [Git][ghc/ghc][wip/T17676] Assume that precise exceptions can only be thrown from IO Message-ID: <5e7b37f6951c1_61673f8198ee100c501251@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T17676 at Glasgow Haskell Compiler / GHC Commits: bb59fada by Sebastian Graf at 2020-03-25T11:51:53+01:00 Assume that precise exceptions can only be thrown from IO - - - - - 2 changed files: - compiler/basicTypes/Demand.hs - compiler/stranal/DmdAnal.hs Changes: ===================================== compiler/basicTypes/Demand.hs ===================================== @@ -28,7 +28,8 @@ module Demand ( DmdEnv, emptyDmdEnv, peelFV, findIdDemand, - Divergence(..), lubDivergence, isDeadEndDiv, topDiv, botDiv, exnDiv, conDiv, + Divergence(..), lubDivergence, isDeadEndDiv, removeExn, + topDiv, botDiv, exnDiv, conDiv, appIsBottom, isDeadEndSig, pprIfaceStrictSig, StrictSig(..), mkStrictSigForArity, mkClosedStrictSig, emptySig, botSig, cprProdSig, @@ -39,8 +40,7 @@ module Demand ( seqDemand, seqDemandList, seqDmdType, seqStrictSig, evalDmd, cleanEvalDmd, cleanEvalProdDmd, isStrictDmd, - splitDmdTy, splitFVs, - mayThrowPreciseException, deferAfterPreciseException, + splitDmdTy, splitFVs, deferAfterPreciseException, postProcessUnsat, postProcessDmdType, splitProdDmd_maybe, peelCallDmd, peelManyCalls, mkCallDmd, mkCallDmds, @@ -1075,6 +1075,11 @@ isDeadEndDiv ExnOrDiv = True isDeadEndDiv ConOrDiv = False isDeadEndDiv Dunno = False +removeExn :: Divergence -> Divergence +removeExn ExnOrDiv = Diverges +removeExn Dunno = ConOrDiv +removeExn div = div + -- See Notes [Default demand on free variables and arguments] -- and [defaultFvDmd vs. defaultArgDmd] -- and Scenario 2 in [Precise exceptions and strictness analysis] @@ -1346,11 +1351,6 @@ splitDmdTy ty@(DmdType _ [] res_ty) = (defaultArgDmd res_ty, ty) deferAfterPreciseException :: DmdType -> DmdType deferAfterPreciseException d = lubDmdType d (emptyDmdType conDiv) -mayThrowPreciseException :: DmdType -> Bool -mayThrowPreciseException (DmdType _ _ Dunno) = True -mayThrowPreciseException (DmdType _ _ ExnOrDiv) = True -mayThrowPreciseException (DmdType _ _ _) = False - strictenDmd :: Demand -> CleanDemand strictenDmd (JD { sd = s, ud = u}) = JD { sd = poke_s s, ud = poke_u u } @@ -1804,15 +1804,17 @@ dmdTransformDataConSig :: Arity -> StrictSig -> CleanDemand -> DmdType -- which has a special kind of demand transformer. -- If the constructor is saturated, we feed the demand on -- the result into the constructor arguments. -dmdTransformDataConSig arity (StrictSig (DmdType _ _ con_res)) - (JD { sd = str, ud = abs }) +-- NB: Its idStrictness will just be the special case of this transformer +-- for a head-strict demand. +dmdTransformDataConSig arity str_sig cd@(JD { sd = str, ud = abs }) + -- TODO: I think this should be more like dmdTransformSig, using a + -- combination of postProcessUnsat, peelManyCalls and splitProdDmd_maybe. | Just str_dmds <- go_str arity str , Just abs_dmds <- go_abs arity abs - = DmdType emptyDmdEnv (mkJointDmds str_dmds abs_dmds) con_res - -- Must remember whether it's a product, hence con_res, not TopRes - - | otherwise -- Not saturated - = emptyDmdType conDiv + = DmdType emptyDmdEnv (mkJointDmds str_dmds abs_dmds) conDiv + -- Not saturated. Fall back to transforming the StrictSig (see MkId) + | otherwise + = dmdTransformSig str_sig cd where go_str 0 dmd = splitStrProdDmd arity dmd go_str n (SCall s') = go_str (n-1) s' ===================================== compiler/stranal/DmdAnal.hs ===================================== @@ -16,7 +16,7 @@ module DmdAnal ( dmdAnalProgram ) where import GhcPrelude import GHC.Driver.Session -import WwLib ( findTypeShape ) +import WwLib ( findTypeShape, deepSplitProductType_maybe ) import Demand -- All of it import GHC.Core import GHC.Core.Seq ( seqBinds ) @@ -34,6 +34,7 @@ import GHC.Core.Coercion ( Coercion, coVarsOfCo ) import GHC.Core.FamInstEnv import Util import Maybes ( isJust ) +import TysPrim ( realWorldStatePrimTy ) import ErrUtils ( dumpIfSet_dyn, DumpFormat (..) ) import UniqSet @@ -220,9 +221,13 @@ dmdAnal' env dmd (Case scrut case_bndr ty [(DataAlt dc, bndrs, rhs)]) (alt_ty1, dmds) = findBndrsDmds env rhs_ty bndrs (alt_ty2, case_bndr_dmd) = findBndrDmd env False alt_ty1 case_bndr id_dmds = addCaseBndrDmd case_bndr_dmd dmds + fam_envs = ae_fam_envs env -- See Note [Precise exceptions and strictness analysis] in Demand - alt_ty3 | mayThrowPreciseException scrut_ty = deferAfterPreciseException alt_ty2 - | otherwise = alt_ty2 + alt_ty3 + | mayThrowPreciseException fam_envs (idType case_bndr) scrut_ty + = deferAfterPreciseException alt_ty2 + | otherwise + = alt_ty2 -- Compute demand on the scrutinee -- See Note [Demand on scrutinee of a product case] @@ -326,6 +331,49 @@ dmdAnalAlt env dmd case_bndr (con,bndrs,rhs) id_dmds = addCaseBndrDmd case_bndr_dmd dmds = (alt_ty, (con, setBndrsDemandInfo bndrs id_dmds, rhs')) +mayThrowPreciseException :: FamInstEnvs -> Type -> DmdType -> Bool +mayThrowPreciseException _ _ (DmdType _ _ ConOrDiv) = False +mayThrowPreciseException _ _ (DmdType _ _ Diverges) = False +-- Anything that throws a precise exception must force the RealWorld#, +-- disregarding black magic like unsafePerformIO (for which we give no +-- guarantees to preserve precise exceptions). +mayThrowPreciseException fam_envs ty _ = forcesRealWorld fam_envs ty + +-- | Whether a 'seqDmd' on an expression of the given type may force the +-- 'RealWorld#', incurring a side-effect (ignoring unsafe shenigans like +-- 'unsafePerformIO'). Looks through +forcesRealWorld :: FamInstEnvs -> Type -> Bool +forcesRealWorld fam_envs = go initRecTc + where + go :: RecTcChecker -> Type -> Bool + go rec_tc ty + -- Found it! + | ty `eqType` realWorldStatePrimTy + = True + -- search depth-first + | Just (dc, _, field_tys, _) <- deepSplitProductType_maybe fam_envs ty + -- don't check the same TyCon twice + , Just rec_tc' <- checkRecTc rec_tc (dataConTyCon dc) + = any (strict_field_forces rec_tc') field_tys + | otherwise + = False + + strict_field_forces rec_tc (field_ty, str_mark) = + (isMarkedStrict str_mark || isLiftedType_maybe field_ty == Just False) + && go rec_tc field_ty + +-- | Tries to reset the precise exception flag from the 'StrictSig's +-- 'Divergence' if really it not 'mayThrowPreciseException'. Resetting the flag +-- means that the (very conservative) precise exception "taint" won't spread +-- unhindered. TODO explain +tryClearPreciseException :: FamInstEnvs -> Type -> StrictSig -> StrictSig +tryClearPreciseException fam_envs ty sig@(StrictSig dmd_ty@(DmdType fvs args div)) + | (arg_tys, res_ty) <- splitPiTys ty + , args `equalLength` filter (not . isNamedBinder) arg_tys + , mayThrowPreciseException fam_envs res_ty dmd_ty + = sig + | otherwise + = StrictSig (DmdType fvs args (removeExn div)) {- Note [Demand on the scrutinee of a product case] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -488,7 +536,8 @@ dmdFix top_lvl env let_dmd orig_pairs zapIdStrictness :: [(Id, CoreExpr)] -> [(Id, CoreExpr)] - zapIdStrictness pairs = [(setIdStrictness id (emptySig topDiv), rhs) | (id, rhs) <- pairs ] + zapIdStrictness pairs + = [(setIdStrictnessResetExc env id (emptySig topDiv), rhs) | (id, rhs) <- pairs ] {- Note [Safe abortion in the fixed-point iteration] @@ -544,7 +593,8 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs (DmdType rhs_fv rhs_dmds rhs_div, rhs') = dmdAnal env rhs_dmd rhs sig = mkStrictSigForArity rhs_arity (mkDmdType sig_fv rhs_dmds rhs_div) - id' = set_idStrictness env id sig + id' = -- pprTraceWith "dmdAnalRhsLetDown" (\sig'-> ppr id <+> ppr sig <+> ppr sig') $ + setIdStrictnessResetExc env id sig -- See Note [NOINLINE and strictness] @@ -1132,9 +1182,9 @@ findBndrDmd env arg_of_dfun dmd_ty id fam_envs = ae_fam_envs env -set_idStrictness :: AnalEnv -> Id -> StrictSig -> Id -set_idStrictness env id sig - = setIdStrictness id (killUsageSig (ae_dflags env) sig) +setIdStrictnessResetExc :: AnalEnv -> Id -> StrictSig -> Id +setIdStrictnessResetExc env id sig + = setIdStrictness id (tryClearPreciseException (ae_fam_envs env) (idType id) sig) {- Note [Initialising strictness] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bb59fadad7cc98f69f9cde2ac4fd0e624691983c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bb59fadad7cc98f69f9cde2ac4fd0e624691983c You're receiving 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 Mar 25 11:00:29 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 25 Mar 2020 07:00:29 -0400 Subject: [Git][ghc/ghc][wip/T17676] Assume that precise exceptions can only be thrown from IO Message-ID: <5e7b39cdc4629_6167e6514b4501976@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T17676 at Glasgow Haskell Compiler / GHC Commits: 28ed3fb4 by Sebastian Graf at 2020-03-25T12:00:15+01:00 Assume that precise exceptions can only be thrown from IO - - - - - 2 changed files: - compiler/basicTypes/Demand.hs - compiler/stranal/DmdAnal.hs Changes: ===================================== compiler/basicTypes/Demand.hs ===================================== @@ -28,7 +28,8 @@ module Demand ( DmdEnv, emptyDmdEnv, peelFV, findIdDemand, - Divergence(..), lubDivergence, isDeadEndDiv, topDiv, botDiv, exnDiv, conDiv, + Divergence(..), lubDivergence, isDeadEndDiv, removeExn, + topDiv, botDiv, exnDiv, conDiv, appIsBottom, isDeadEndSig, pprIfaceStrictSig, StrictSig(..), mkStrictSigForArity, mkClosedStrictSig, emptySig, botSig, cprProdSig, @@ -39,8 +40,7 @@ module Demand ( seqDemand, seqDemandList, seqDmdType, seqStrictSig, evalDmd, cleanEvalDmd, cleanEvalProdDmd, isStrictDmd, - splitDmdTy, splitFVs, - mayThrowPreciseException, deferAfterPreciseException, + splitDmdTy, splitFVs, deferAfterPreciseException, postProcessUnsat, postProcessDmdType, splitProdDmd_maybe, peelCallDmd, peelManyCalls, mkCallDmd, mkCallDmds, @@ -1075,6 +1075,11 @@ isDeadEndDiv ExnOrDiv = True isDeadEndDiv ConOrDiv = False isDeadEndDiv Dunno = False +removeExn :: Divergence -> Divergence +removeExn ExnOrDiv = Diverges +removeExn Dunno = ConOrDiv +removeExn div = div + -- See Notes [Default demand on free variables and arguments] -- and [defaultFvDmd vs. defaultArgDmd] -- and Scenario 2 in [Precise exceptions and strictness analysis] @@ -1346,11 +1351,6 @@ splitDmdTy ty@(DmdType _ [] res_ty) = (defaultArgDmd res_ty, ty) deferAfterPreciseException :: DmdType -> DmdType deferAfterPreciseException d = lubDmdType d (emptyDmdType conDiv) -mayThrowPreciseException :: DmdType -> Bool -mayThrowPreciseException (DmdType _ _ Dunno) = True -mayThrowPreciseException (DmdType _ _ ExnOrDiv) = True -mayThrowPreciseException (DmdType _ _ _) = False - strictenDmd :: Demand -> CleanDemand strictenDmd (JD { sd = s, ud = u}) = JD { sd = poke_s s, ud = poke_u u } @@ -1804,15 +1804,17 @@ dmdTransformDataConSig :: Arity -> StrictSig -> CleanDemand -> DmdType -- which has a special kind of demand transformer. -- If the constructor is saturated, we feed the demand on -- the result into the constructor arguments. -dmdTransformDataConSig arity (StrictSig (DmdType _ _ con_res)) - (JD { sd = str, ud = abs }) +-- NB: Its idStrictness will just be the special case of this transformer +-- for a head-strict demand. +dmdTransformDataConSig arity str_sig cd@(JD { sd = str, ud = abs }) + -- TODO: I think this should be more like dmdTransformSig, using a + -- combination of postProcessUnsat, peelManyCalls and splitProdDmd_maybe. | Just str_dmds <- go_str arity str , Just abs_dmds <- go_abs arity abs - = DmdType emptyDmdEnv (mkJointDmds str_dmds abs_dmds) con_res - -- Must remember whether it's a product, hence con_res, not TopRes - - | otherwise -- Not saturated - = emptyDmdType conDiv + = DmdType emptyDmdEnv (mkJointDmds str_dmds abs_dmds) conDiv + -- Not saturated. Fall back to transforming the StrictSig (see MkId) + | otherwise + = dmdTransformSig str_sig cd where go_str 0 dmd = splitStrProdDmd arity dmd go_str n (SCall s') = go_str (n-1) s' ===================================== compiler/stranal/DmdAnal.hs ===================================== @@ -16,7 +16,7 @@ module DmdAnal ( dmdAnalProgram ) where import GhcPrelude import GHC.Driver.Session -import WwLib ( findTypeShape ) +import WwLib ( findTypeShape, deepSplitProductType_maybe ) import Demand -- All of it import GHC.Core import GHC.Core.Seq ( seqBinds ) @@ -34,6 +34,7 @@ import GHC.Core.Coercion ( Coercion, coVarsOfCo ) import GHC.Core.FamInstEnv import Util import Maybes ( isJust ) +import TysPrim ( realWorldStatePrimTy ) import ErrUtils ( dumpIfSet_dyn, DumpFormat (..) ) import UniqSet @@ -220,9 +221,13 @@ dmdAnal' env dmd (Case scrut case_bndr ty [(DataAlt dc, bndrs, rhs)]) (alt_ty1, dmds) = findBndrsDmds env rhs_ty bndrs (alt_ty2, case_bndr_dmd) = findBndrDmd env False alt_ty1 case_bndr id_dmds = addCaseBndrDmd case_bndr_dmd dmds + fam_envs = ae_fam_envs env -- See Note [Precise exceptions and strictness analysis] in Demand - alt_ty3 | mayThrowPreciseException scrut_ty = deferAfterPreciseException alt_ty2 - | otherwise = alt_ty2 + alt_ty3 + | mayThrowPreciseException fam_envs (idType case_bndr) scrut_ty + = deferAfterPreciseException alt_ty2 + | otherwise + = alt_ty2 -- Compute demand on the scrutinee -- See Note [Demand on scrutinee of a product case] @@ -326,6 +331,49 @@ dmdAnalAlt env dmd case_bndr (con,bndrs,rhs) id_dmds = addCaseBndrDmd case_bndr_dmd dmds = (alt_ty, (con, setBndrsDemandInfo bndrs id_dmds, rhs')) +mayThrowPreciseException :: FamInstEnvs -> Type -> DmdType -> Bool +mayThrowPreciseException _ _ (DmdType _ _ ConOrDiv) = False +mayThrowPreciseException _ _ (DmdType _ _ Diverges) = False +-- Anything that throws a precise exception must force the RealWorld#, +-- disregarding black magic like unsafePerformIO (for which we give no +-- guarantees to preserve precise exceptions). +mayThrowPreciseException fam_envs ty _ = forcesRealWorld fam_envs ty + +-- | Whether a 'seqDmd' on an expression of the given type may force the +-- 'RealWorld#', incurring a side-effect (ignoring unsafe shenigans like +-- 'unsafePerformIO'). Looks through +forcesRealWorld :: FamInstEnvs -> Type -> Bool +forcesRealWorld fam_envs = go initRecTc + where + go :: RecTcChecker -> Type -> Bool + go rec_tc ty + -- Found it! + | ty `eqType` realWorldStatePrimTy + = True + -- search depth-first + | Just (dc, _, field_tys, _) <- deepSplitProductType_maybe fam_envs ty + -- don't check the same TyCon twice + , Just rec_tc' <- checkRecTc rec_tc (dataConTyCon dc) + = any (strict_field_forces rec_tc') field_tys + | otherwise + = False + + strict_field_forces rec_tc (field_ty, str_mark) = + (isMarkedStrict str_mark || isLiftedType_maybe field_ty == Just False) + && go rec_tc field_ty + +-- | Tries to reset the precise exception flag from the 'StrictSig's +-- 'Divergence' if really it not 'mayThrowPreciseException'. Resetting the flag +-- means that the (very conservative) precise exception "taint" won't spread +-- unhindered. TODO explain +tryClearPreciseException :: FamInstEnvs -> Type -> StrictSig -> StrictSig +tryClearPreciseException fam_envs ty sig@(StrictSig dmd_ty@(DmdType fvs args div)) + | (arg_tys, res_ty) <- splitPiTys ty + , args `equalLength` filter (not . isNamedBinder) arg_tys + , mayThrowPreciseException fam_envs res_ty dmd_ty + = sig + | otherwise + = StrictSig (DmdType fvs args (removeExn div)) {- Note [Demand on the scrutinee of a product case] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -488,7 +536,8 @@ dmdFix top_lvl env let_dmd orig_pairs zapIdStrictness :: [(Id, CoreExpr)] -> [(Id, CoreExpr)] - zapIdStrictness pairs = [(setIdStrictness id (emptySig topDiv), rhs) | (id, rhs) <- pairs ] + zapIdStrictness pairs + = [(setIdStrictnessResetExc env id (emptySig topDiv), rhs) | (id, rhs) <- pairs ] {- Note [Safe abortion in the fixed-point iteration] @@ -544,7 +593,8 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs (DmdType rhs_fv rhs_dmds rhs_div, rhs') = dmdAnal env rhs_dmd rhs sig = mkStrictSigForArity rhs_arity (mkDmdType sig_fv rhs_dmds rhs_div) - id' = set_idStrictness env id sig + id' = -- pprTraceWith "dmdAnalRhsLetDown" (\sig'-> ppr id <+> ppr sig <+> ppr sig') $ + setIdStrictnessResetExc env id sig -- See Note [NOINLINE and strictness] @@ -1132,9 +1182,9 @@ findBndrDmd env arg_of_dfun dmd_ty id fam_envs = ae_fam_envs env -set_idStrictness :: AnalEnv -> Id -> StrictSig -> Id -set_idStrictness env id sig - = setIdStrictness id (killUsageSig (ae_dflags env) sig) +setIdStrictnessResetExc :: AnalEnv -> Id -> StrictSig -> Id +setIdStrictnessResetExc env id sig + = setIdStrictness id (tryClearPreciseException (ae_fam_envs env) (idType id) sig) {- Note [Initialising strictness] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/28ed3fb4fed153f97237600c2839d76d6de0f701 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/28ed3fb4fed153f97237600c2839d76d6de0f701 You're receiving 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 Mar 25 12:04:42 2020 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Wed, 25 Mar 2020 08:04:42 -0400 Subject: [Git][ghc/ghc][wip/compact-iface] Turn off compacting Message-ID: <5e7b48dabfa1b_61677b155d851002b@gitlab.haskell.org.mail> Matthew Pickering pushed to branch wip/compact-iface at Glasgow Haskell Compiler / GHC Commits: b7ea9ba3 by Matthew Pickering at 2020-03-25T12:04:28+00:00 Turn off compacting - - - - - 1 changed file: - compiler/GHC/Driver/Types.hs Changes: ===================================== compiler/GHC/Driver/Types.hs ===================================== @@ -625,22 +625,28 @@ type HomePackageTable = DModuleNameEnv HomeModInfo data CompactRegion = forall a . CompactRegion (Compact a) | EmptyRegion -- | Helps us find information about modules in the imported packages -data PackageIfaceTable = PackageIfaceTable CompactRegion (ModuleEnv ModIface) +data PackageIfaceTable = PackageIfaceTable (Maybe CompactRegion) (ModuleEnv ModIface) -- Domain = modules in the imported packages -- | Constructs an empty HomePackageTable emptyHomePackageTable :: HomePackageTable emptyHomePackageTable = emptyUDFM +-- | Constructs an empty PackageIfaceTable +emptyPackageIfaceTableWithCompact :: Maybe CompactRegion -> PackageIfaceTable +emptyPackageIfaceTableWithCompact c = PackageIfaceTable c emptyModuleEnv + -- | Constructs an empty PackageIfaceTable emptyPackageIfaceTable :: PackageIfaceTable -emptyPackageIfaceTable = PackageIfaceTable EmptyRegion emptyModuleEnv +emptyPackageIfaceTable = emptyPackageIfaceTableWithCompact Nothing lookupPIT :: PackageIfaceTable -> Module -> Maybe ModIface lookupPIT (PackageIfaceTable _ pit) m = lookupModuleEnv pit m extendPIT :: PackageIfaceTable -> Module -> ModIface -> IO PackageIfaceTable -extendPIT (PackageIfaceTable comp pit) m mi = do +extendPIT (PackageIfaceTable Nothing pit) m mi = + return $ PackageIfaceTable Nothing (extendModuleEnv pit m mi) +extendPIT (PackageIfaceTable (Just comp) pit) m mi = do let raw_iface = forgetModIfaceCaches mi compact_region <- case comp of CompactRegion c -> do @@ -648,7 +654,7 @@ extendPIT (PackageIfaceTable comp pit) m mi = do EmptyRegion -> do compact raw_iface let compacted_iface = initModIfaceCaches $ getCompact compact_region - return (PackageIfaceTable (CompactRegion compact_region) (extendModuleEnv pit m compacted_iface)) + return (PackageIfaceTable (Just (CompactRegion compact_region)) (extendModuleEnv pit m compacted_iface)) extendPITFake :: PackageIfaceTable -> Module -> PackageIfaceTable extendPITFake (PackageIfaceTable c pit) mod = View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b7ea9ba3fa75ad86b8220f92b51f60c24d737069 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b7ea9ba3fa75ad86b8220f92b51f60c24d737069 You're receiving 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 Mar 25 12:30:16 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 25 Mar 2020 08:30:16 -0400 Subject: [Git][ghc/ghc][wip/T17676] Accept new testsuite results Message-ID: <5e7b4ed885809_6167120434ec5199b8@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T17676 at Glasgow Haskell Compiler / GHC Commits: b9975eab by Sebastian Graf at 2020-03-25T13:30:06+01:00 Accept new testsuite results - - - - - 17 changed files: - testsuite/tests/deSugar/should_compile/T2431.stderr - testsuite/tests/numeric/should_compile/T14170.stdout - testsuite/tests/numeric/should_compile/T14465.stdout - testsuite/tests/numeric/should_compile/T7116.stdout - testsuite/tests/simplCore/should_compile/T13143.stderr - testsuite/tests/simplCore/should_compile/T13543.stderr - testsuite/tests/simplCore/should_compile/T3717.stderr - testsuite/tests/simplCore/should_compile/T3772.stdout - testsuite/tests/simplCore/should_compile/T4201.stdout - testsuite/tests/simplCore/should_compile/T4908.stderr - testsuite/tests/simplCore/should_compile/T4930.stderr - testsuite/tests/simplCore/should_compile/T7360.stderr - testsuite/tests/simplCore/should_compile/noinline01.stderr - testsuite/tests/simplCore/should_compile/par01.stderr - testsuite/tests/simplCore/should_compile/spec-inline.stderr - testsuite/tests/stranal/sigs/DmdAnalGADTs.stderr - testsuite/tests/stranal/sigs/T8598.stderr Changes: ===================================== testsuite/tests/deSugar/should_compile/T2431.stderr ===================================== @@ -7,6 +7,7 @@ Result size of Tidy Core T2431.$WRefl [InlPrag=INLINE[0]] :: forall a. a :~: a [GblId[DataConWrapper], Caf=NoCafRefs, + Str=c, Cpr=m1, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, @@ -110,3 +111,6 @@ T2431.$tc'Refl $tc'Refl2 1# $krep3 + + + ===================================== testsuite/tests/numeric/should_compile/T14170.stdout ===================================== @@ -6,6 +6,7 @@ Result size of Tidy Core -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} NatVal.$trModule4 :: GHC.Prim.Addr# [GblId, + Str=c, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] NatVal.$trModule4 = "main"# @@ -13,6 +14,7 @@ NatVal.$trModule4 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} NatVal.$trModule3 :: GHC.Types.TrName [GblId, + Str=c, Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] @@ -21,6 +23,7 @@ NatVal.$trModule3 = GHC.Types.TrNameS NatVal.$trModule4 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} NatVal.$trModule2 :: GHC.Prim.Addr# [GblId, + Str=c, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] NatVal.$trModule2 = "NatVal"# @@ -28,6 +31,7 @@ NatVal.$trModule2 = "NatVal"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} NatVal.$trModule1 :: GHC.Types.TrName [GblId, + Str=c, Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] @@ -36,6 +40,7 @@ NatVal.$trModule1 = GHC.Types.TrNameS NatVal.$trModule2 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} NatVal.$trModule :: GHC.Types.Module [GblId, + Str=c, Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] @@ -45,6 +50,7 @@ NatVal.$trModule -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} foo :: Integer [GblId, + Str=c, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 100 0}] foo = 0 ===================================== testsuite/tests/numeric/should_compile/T14465.stdout ===================================== @@ -6,6 +6,7 @@ Result size of Tidy Core -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} ten :: Natural [GblId, + Str=c, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 100 0}] ten = 10 @@ -13,6 +14,7 @@ ten = 10 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} M.$trModule4 :: GHC.Prim.Addr# [GblId, + Str=c, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] M.$trModule4 = "main"# @@ -20,6 +22,7 @@ M.$trModule4 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} M.$trModule3 :: GHC.Types.TrName [GblId, + Str=c, Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] @@ -28,6 +31,7 @@ M.$trModule3 = GHC.Types.TrNameS M.$trModule4 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} M.$trModule2 :: GHC.Prim.Addr# [GblId, + Str=c, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] M.$trModule2 = "M"# @@ -35,6 +39,7 @@ M.$trModule2 = "M"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} M.$trModule1 :: GHC.Types.TrName [GblId, + Str=c, Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] @@ -43,6 +48,7 @@ M.$trModule1 = GHC.Types.TrNameS M.$trModule2 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} M.$trModule :: GHC.Types.Module [GblId, + Str=c, Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] @@ -51,6 +57,7 @@ M.$trModule = GHC.Types.Module M.$trModule3 M.$trModule1 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} M.minusOne1 :: Natural [GblId, + Str=c, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 100 0}] M.minusOne1 = 1 @@ -58,6 +65,7 @@ M.minusOne1 = 1 -- RHS size: {terms: 11, types: 6, coercions: 0, joins: 0/0} minusOne :: Natural [GblId, + Str=c, Unf=Unf{Src=, TopLvl=True, Value=False, ConLike=False, WorkFree=True, Expandable=False, Guidance=IF_ARGS [] 40 0}] minusOne @@ -73,6 +81,7 @@ minusOne -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} twoTimesTwo :: Natural [GblId, + Str=c, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 100 0}] twoTimesTwo = 4 @@ -81,7 +90,7 @@ twoTimesTwo = 4 plusOne :: Natural -> Natural [GblId, Arity=1, - Str=, + Str=c, 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) @@ -91,6 +100,7 @@ plusOne = \ (n :: Natural) -> plusNatural n M.minusOne1 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} one :: Natural [GblId, + Str=c, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}] ===================================== testsuite/tests/numeric/should_compile/T7116.stdout ===================================== @@ -6,6 +6,7 @@ Result size of Tidy Core -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T7116.$trModule4 :: GHC.Prim.Addr# [GblId, + Str=c, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] T7116.$trModule4 = "main"# @@ -13,6 +14,7 @@ T7116.$trModule4 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T7116.$trModule3 :: GHC.Types.TrName [GblId, + Str=c, Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] @@ -21,6 +23,7 @@ T7116.$trModule3 = GHC.Types.TrNameS T7116.$trModule4 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T7116.$trModule2 :: GHC.Prim.Addr# [GblId, + Str=c, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] T7116.$trModule2 = "T7116"# @@ -28,6 +31,7 @@ T7116.$trModule2 = "T7116"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T7116.$trModule1 :: GHC.Types.TrName [GblId, + Str=c, Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] @@ -36,6 +40,7 @@ T7116.$trModule1 = GHC.Types.TrNameS T7116.$trModule2 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} T7116.$trModule :: GHC.Types.Module [GblId, + Str=c, Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] @@ -46,7 +51,7 @@ T7116.$trModule dr :: Double -> Double [GblId, Arity=1, - Str=, + Str=c, Cpr=m1, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, @@ -63,7 +68,7 @@ dr dl :: Double -> Double [GblId, Arity=1, - Str=, + Str=c, Cpr=m1, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, @@ -76,7 +81,7 @@ dl = dr fr :: Float -> Float [GblId, Arity=1, - Str=, + Str=c, Cpr=m1, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, @@ -95,7 +100,7 @@ fr fl :: Float -> Float [GblId, Arity=1, - Str=, + Str=c, Cpr=m1, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, ===================================== testsuite/tests/simplCore/should_compile/T13143.stderr ===================================== @@ -26,6 +26,7 @@ f = \ (@a) _ [Occ=Dead] -> T13143.$wf @a GHC.Prim.void# -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T13143.$trModule4 :: GHC.Prim.Addr# [GblId, + Str=c, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] T13143.$trModule4 = "main"# @@ -33,6 +34,7 @@ T13143.$trModule4 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T13143.$trModule3 :: GHC.Types.TrName [GblId, + Str=c, Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] @@ -41,6 +43,7 @@ T13143.$trModule3 = GHC.Types.TrNameS T13143.$trModule4 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T13143.$trModule2 :: GHC.Prim.Addr# [GblId, + Str=c, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] T13143.$trModule2 = "T13143"# @@ -48,6 +51,7 @@ T13143.$trModule2 = "T13143"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T13143.$trModule1 :: GHC.Types.TrName [GblId, + Str=c, Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] @@ -56,6 +60,7 @@ T13143.$trModule1 = GHC.Types.TrNameS T13143.$trModule2 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} T13143.$trModule :: GHC.Types.Module [GblId, + Str=c, Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] @@ -71,7 +76,7 @@ Rec { -- RHS size: {terms: 28, types: 7, coercions: 0, joins: 0/0} T13143.$wg [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker] :: Bool -> Bool -> GHC.Prim.Int# -> GHC.Prim.Int# -[GblId, Arity=3, Str=, Unf=OtherCon []] +[GblId, Arity=3, Str=c, Unf=OtherCon []] T13143.$wg = \ (w :: Bool) (w1 :: Bool) (ww :: GHC.Prim.Int#) -> case w of { @@ -92,7 +97,7 @@ end Rec } g [InlPrag=NOUSERINLINE[2]] :: Bool -> Bool -> Int -> Int [GblId, Arity=3, - Str=, + Str=c, Cpr=m1, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, ===================================== testsuite/tests/simplCore/should_compile/T13543.stderr ===================================== @@ -1,8 +1,8 @@ ==================== Strictness signatures ==================== -Foo.$trModule: -Foo.f: -Foo.g: +Foo.$trModule: c +Foo.f: c +Foo.g: c @@ -14,8 +14,8 @@ Foo.g: m1 ==================== Strictness signatures ==================== -Foo.$trModule: -Foo.f: -Foo.g: +Foo.$trModule: c +Foo.f: c +Foo.g: c ===================================== testsuite/tests/simplCore/should_compile/T3717.stderr ===================================== @@ -6,6 +6,7 @@ Result size of Tidy Core -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T3717.$trModule4 :: GHC.Prim.Addr# [GblId, + Str=c, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] T3717.$trModule4 = "main"# @@ -13,6 +14,7 @@ T3717.$trModule4 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T3717.$trModule3 :: GHC.Types.TrName [GblId, + Str=c, Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] @@ -21,6 +23,7 @@ T3717.$trModule3 = GHC.Types.TrNameS T3717.$trModule4 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T3717.$trModule2 :: GHC.Prim.Addr# [GblId, + Str=c, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] T3717.$trModule2 = "T3717"# @@ -28,6 +31,7 @@ T3717.$trModule2 = "T3717"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T3717.$trModule1 :: GHC.Types.TrName [GblId, + Str=c, Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] @@ -36,6 +40,7 @@ T3717.$trModule1 = GHC.Types.TrNameS T3717.$trModule2 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} T3717.$trModule :: GHC.Types.Module [GblId, + Str=c, Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] @@ -46,7 +51,7 @@ Rec { -- RHS size: {terms: 10, types: 2, coercions: 0, joins: 0/0} T3717.$wfoo [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.Int# -[GblId, Arity=1, Str=, Unf=OtherCon []] +[GblId, Arity=1, Str=c, Unf=OtherCon []] T3717.$wfoo = \ (ww :: GHC.Prim.Int#) -> case ww of ds { @@ -59,7 +64,7 @@ end Rec } foo [InlPrag=NOUSERINLINE[2]] :: Int -> Int [GblId, Arity=1, - Str=, + Str=c, Cpr=m1, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, ===================================== testsuite/tests/simplCore/should_compile/T3772.stdout ===================================== @@ -6,6 +6,7 @@ Result size of Tidy Core -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T3772.$trModule4 :: GHC.Prim.Addr# [GblId, + Str=c, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] T3772.$trModule4 = "main"# @@ -13,6 +14,7 @@ T3772.$trModule4 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T3772.$trModule3 :: GHC.Types.TrName [GblId, + Str=c, Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] @@ -21,6 +23,7 @@ T3772.$trModule3 = GHC.Types.TrNameS T3772.$trModule4 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T3772.$trModule2 :: GHC.Prim.Addr# [GblId, + Str=c, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] T3772.$trModule2 = "T3772"# @@ -28,6 +31,7 @@ T3772.$trModule2 = "T3772"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T3772.$trModule1 :: GHC.Types.TrName [GblId, + Str=c, Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] @@ -36,6 +40,7 @@ T3772.$trModule1 = GHC.Types.TrNameS T3772.$trModule2 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} T3772.$trModule :: GHC.Types.Module [GblId, + Str=c, Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] @@ -45,7 +50,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=c, Unf=OtherCon []] $wxs = \ (ww :: GHC.Prim.Int#) -> case ww of ds1 { @@ -56,7 +61,7 @@ end Rec } -- RHS size: {terms: 10, types: 2, coercions: 0, joins: 0/0} T3772.$wfoo [InlPrag=NOINLINE] :: GHC.Prim.Int# -> () -[GblId, Arity=1, Str=, Unf=OtherCon []] +[GblId, Arity=1, Str=c, Unf=OtherCon []] T3772.$wfoo = \ (ww :: GHC.Prim.Int#) -> case GHC.Prim.<# 0# ww of { @@ -68,7 +73,7 @@ T3772.$wfoo foo [InlPrag=NOUSERINLINE[0]] :: Int -> () [GblId, Arity=1, - Str=, + Str=c, 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) ===================================== testsuite/tests/simplCore/should_compile/T4201.stdout ===================================== @@ -1,3 +1,3 @@ - [HasNoCafRefs, Arity: 1, Strictness: , CPR: m1, + [HasNoCafRefs, Arity: 1, Strictness: c, CPR: m1, Unfolding: InlineRule (0, True, True) bof `cast` (Sym (N:Foo[0]) ->_R _R)] ===================================== testsuite/tests/simplCore/should_compile/T4908.stderr ===================================== @@ -6,6 +6,7 @@ Result size of Tidy Core -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T4908.$trModule4 :: Addr# [GblId, + Str=c, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] T4908.$trModule4 = "main"# @@ -13,6 +14,7 @@ T4908.$trModule4 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T4908.$trModule3 :: TrName [GblId, + Str=c, Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] @@ -21,6 +23,7 @@ T4908.$trModule3 = GHC.Types.TrNameS T4908.$trModule4 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T4908.$trModule2 :: Addr# [GblId, + Str=c, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] T4908.$trModule2 = "T4908"# @@ -28,6 +31,7 @@ T4908.$trModule2 = "T4908"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T4908.$trModule1 :: TrName [GblId, + Str=c, Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] @@ -36,6 +40,7 @@ T4908.$trModule1 = GHC.Types.TrNameS T4908.$trModule2 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} T4908.$trModule :: Module [GblId, + Str=c, Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] @@ -45,7 +50,7 @@ T4908.$trModule Rec { -- RHS size: {terms: 19, types: 5, coercions: 0, joins: 0/0} T4908.f_$s$wf [Occ=LoopBreaker] :: Int -> Int# -> Int# -> Bool -[GblId, Arity=3, Str=, Unf=OtherCon []] +[GblId, Arity=3, Str=c, Unf=OtherCon []] T4908.f_$s$wf = \ (sc :: Int) (sc1 :: Int#) (sc2 :: Int#) -> case sc2 of ds { @@ -62,7 +67,7 @@ end Rec } T4908.$wf [InlPrag=NOUSERINLINE[2]] :: Int# -> (Int, Int) -> Bool [GblId, Arity=2, - Str=, + Str=c, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [30 20] 101 20}] T4908.$wf @@ -84,7 +89,7 @@ T4908.$wf f [InlPrag=NOUSERINLINE[2]] :: Int -> (Int, Int) -> Bool [GblId, Arity=2, - Str=, + Str=c, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) ===================================== testsuite/tests/simplCore/should_compile/T4930.stderr ===================================== @@ -6,6 +6,7 @@ Result size of Tidy Core -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T4930.$trModule4 :: GHC.Prim.Addr# [GblId, + Str=c, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] T4930.$trModule4 = "main"# @@ -13,6 +14,7 @@ T4930.$trModule4 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T4930.$trModule3 :: GHC.Types.TrName [GblId, + Str=c, Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] @@ -21,6 +23,7 @@ T4930.$trModule3 = GHC.Types.TrNameS T4930.$trModule4 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T4930.$trModule2 :: GHC.Prim.Addr# [GblId, + Str=c, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] T4930.$trModule2 = "T4930"# @@ -28,6 +31,7 @@ T4930.$trModule2 = "T4930"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T4930.$trModule1 :: GHC.Types.TrName [GblId, + Str=c, Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] @@ -36,6 +40,7 @@ T4930.$trModule1 = GHC.Types.TrNameS T4930.$trModule2 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} T4930.$trModule :: GHC.Types.Module [GblId, + Str=c, Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] @@ -46,7 +51,7 @@ Rec { -- RHS size: {terms: 17, types: 3, coercions: 0, joins: 0/0} T4930.$wfoo [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.Int# -[GblId, Arity=1, Str=, Unf=OtherCon []] +[GblId, Arity=1, Str=c, Unf=OtherCon []] T4930.$wfoo = \ (ww :: GHC.Prim.Int#) -> case GHC.Prim.<# ww 5# of { @@ -59,7 +64,7 @@ end Rec } foo [InlPrag=NOUSERINLINE[2]] :: Int -> Int [GblId, Arity=1, - Str=, + Str=c, Cpr=m1, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, ===================================== testsuite/tests/simplCore/should_compile/T7360.stderr ===================================== @@ -8,7 +8,7 @@ T7360.$WFoo3 [InlPrag=INLINE[0]] :: Int -> Foo [GblId[DataConWrapper], Arity=1, Caf=NoCafRefs, - Str=, + Str=c, Cpr=m3, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, @@ -21,12 +21,13 @@ T7360.$WFoo3 -- RHS size: {terms: 5, types: 2, coercions: 0, joins: 0/0} fun1 [InlPrag=NOINLINE] :: Foo -> () -[GblId, Arity=1, Str=, Unf=OtherCon []] +[GblId, Arity=1, Str=c, Unf=OtherCon []] fun1 = \ (x :: Foo) -> case x of { __DEFAULT -> GHC.Tuple.() } -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T7360.fun5 :: () [GblId, + Str=c, Unf=Unf{Src=, TopLvl=True, Value=False, ConLike=False, WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 20 0}] T7360.fun5 = fun1 T7360.Foo1 @@ -34,6 +35,7 @@ T7360.fun5 = fun1 T7360.Foo1 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T7360.fun4 :: Int [GblId, + Str=c, Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] @@ -43,7 +45,7 @@ T7360.fun4 = GHC.Types.I# 0# fun2 :: forall {a}. [a] -> ((), Int) [GblId, Arity=1, - Str=, + Str=c, Cpr=m1, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, @@ -71,6 +73,7 @@ fun2 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T7360.$trModule4 :: GHC.Prim.Addr# [GblId, + Str=c, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] T7360.$trModule4 = "main"# @@ -78,6 +81,7 @@ T7360.$trModule4 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T7360.$trModule3 :: GHC.Types.TrName [GblId, + Str=c, Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] @@ -86,6 +90,7 @@ T7360.$trModule3 = GHC.Types.TrNameS T7360.$trModule4 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T7360.$trModule2 :: GHC.Prim.Addr# [GblId, + Str=c, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] T7360.$trModule2 = "T7360"# @@ -93,6 +98,7 @@ T7360.$trModule2 = "T7360"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T7360.$trModule1 :: GHC.Types.TrName [GblId, + Str=c, Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] @@ -101,6 +107,7 @@ T7360.$trModule1 = GHC.Types.TrNameS T7360.$trModule2 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} T7360.$trModule :: GHC.Types.Module [GblId, + Str=c, Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] @@ -109,7 +116,7 @@ T7360.$trModule -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} $krep :: GHC.Types.KindRep -[GblId, Cpr=m1, Unf=OtherCon []] +[GblId, Str=c, Cpr=m1, Unf=OtherCon []] $krep = GHC.Types.KindRepTyConApp GHC.Types.$tcInt (GHC.Types.[] @GHC.Types.KindRep) @@ -117,6 +124,7 @@ $krep -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T7360.$tcFoo2 :: GHC.Prim.Addr# [GblId, + Str=c, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] T7360.$tcFoo2 = "Foo"# @@ -124,6 +132,7 @@ T7360.$tcFoo2 = "Foo"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T7360.$tcFoo1 :: GHC.Types.TrName [GblId, + Str=c, Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] @@ -132,6 +141,7 @@ T7360.$tcFoo1 = GHC.Types.TrNameS T7360.$tcFoo2 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T7360.$tcFoo :: GHC.Types.TyCon [GblId, + Str=c, Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] @@ -146,7 +156,7 @@ T7360.$tcFoo -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} T7360.$tc'Foo4 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep -[GblId, Cpr=m1, Unf=OtherCon []] +[GblId, Str=c, Cpr=m1, Unf=OtherCon []] T7360.$tc'Foo4 = GHC.Types.KindRepTyConApp T7360.$tcFoo (GHC.Types.[] @GHC.Types.KindRep) @@ -154,6 +164,7 @@ T7360.$tc'Foo4 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T7360.$tc'Foo6 :: GHC.Prim.Addr# [GblId, + Str=c, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] T7360.$tc'Foo6 = "'Foo1"# @@ -161,6 +172,7 @@ T7360.$tc'Foo6 = "'Foo1"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T7360.$tc'Foo5 :: GHC.Types.TrName [GblId, + Str=c, Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] @@ -169,6 +181,7 @@ T7360.$tc'Foo5 = GHC.Types.TrNameS T7360.$tc'Foo6 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T7360.$tc'Foo1 :: GHC.Types.TyCon [GblId, + Str=c, Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] @@ -184,6 +197,7 @@ T7360.$tc'Foo1 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T7360.$tc'Foo8 :: GHC.Prim.Addr# [GblId, + Str=c, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] T7360.$tc'Foo8 = "'Foo2"# @@ -191,6 +205,7 @@ T7360.$tc'Foo8 = "'Foo2"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T7360.$tc'Foo7 :: GHC.Types.TrName [GblId, + Str=c, Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] @@ -199,6 +214,7 @@ T7360.$tc'Foo7 = GHC.Types.TrNameS T7360.$tc'Foo8 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T7360.$tc'Foo2 :: GHC.Types.TyCon [GblId, + Str=c, Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] @@ -213,12 +229,13 @@ T7360.$tc'Foo2 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} T7360.$tc'Foo9 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep -[GblId, Cpr=m4, Unf=OtherCon []] +[GblId, Str=c, Cpr=m4, Unf=OtherCon []] T7360.$tc'Foo9 = GHC.Types.KindRepFun $krep T7360.$tc'Foo4 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T7360.$tc'Foo11 :: GHC.Prim.Addr# [GblId, + Str=c, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] T7360.$tc'Foo11 = "'Foo3"# @@ -226,6 +243,7 @@ T7360.$tc'Foo11 = "'Foo3"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T7360.$tc'Foo10 :: GHC.Types.TrName [GblId, + Str=c, Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] @@ -234,6 +252,7 @@ T7360.$tc'Foo10 = GHC.Types.TrNameS T7360.$tc'Foo11 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T7360.$tc'Foo3 :: GHC.Types.TyCon [GblId, + Str=c, Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] ===================================== testsuite/tests/simplCore/should_compile/noinline01.stderr ===================================== @@ -2,31 +2,31 @@ ==================== STG: ==================== Noinline01.f [InlPrag=INLINE (sat-args=1)] :: forall {p}. p -> GHC.Types.Bool -[GblId, Arity=1, Str=, Unf=OtherCon []] = +[GblId, Arity=1, Str=c, Unf=OtherCon []] = \r [eta] GHC.Types.True []; Noinline01.g :: GHC.Types.Bool -[GblId] = +[GblId, Str=c] = \u [] Noinline01.f GHC.Types.False; Noinline01.$trModule4 :: GHC.Prim.Addr# -[GblId, Unf=OtherCon []] = +[GblId, Str=c, Unf=OtherCon []] = "main"#; Noinline01.$trModule3 :: GHC.Types.TrName -[GblId, Cpr=m1, Unf=OtherCon []] = +[GblId, Str=c, Cpr=m1, Unf=OtherCon []] = CCS_DONT_CARE GHC.Types.TrNameS! [Noinline01.$trModule4]; Noinline01.$trModule2 :: GHC.Prim.Addr# -[GblId, Unf=OtherCon []] = +[GblId, Str=c, Unf=OtherCon []] = "Noinline01"#; Noinline01.$trModule1 :: GHC.Types.TrName -[GblId, Cpr=m1, Unf=OtherCon []] = +[GblId, Str=c, Cpr=m1, Unf=OtherCon []] = CCS_DONT_CARE GHC.Types.TrNameS! [Noinline01.$trModule2]; Noinline01.$trModule :: GHC.Types.Module -[GblId, Cpr=m1, Unf=OtherCon []] = +[GblId, Str=c, Cpr=m1, Unf=OtherCon []] = CCS_DONT_CARE GHC.Types.Module! [Noinline01.$trModule3 Noinline01.$trModule1]; ===================================== testsuite/tests/simplCore/should_compile/par01.stderr ===================================== @@ -6,7 +6,7 @@ Result size of CorePrep Rec { -- RHS size: {terms: 7, types: 3, coercions: 0, joins: 0/0} Par01.depth [Occ=LoopBreaker] :: GHC.Types.Int -> GHC.Types.Int -[GblId, Arity=1, Str=, Unf=OtherCon []] +[GblId, Arity=1, Str=c, Unf=OtherCon []] Par01.depth = \ (d :: GHC.Types.Int) -> case GHC.Prim.par# @GHC.Types.Int d of { __DEFAULT -> @@ -16,27 +16,27 @@ end Rec } -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} Par01.$trModule4 :: GHC.Prim.Addr# -[GblId, Unf=OtherCon []] +[GblId, Str=c, Unf=OtherCon []] Par01.$trModule4 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} Par01.$trModule3 :: GHC.Types.TrName -[GblId, Cpr=m1, Unf=OtherCon []] +[GblId, Str=c, Cpr=m1, Unf=OtherCon []] Par01.$trModule3 = GHC.Types.TrNameS Par01.$trModule4 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} Par01.$trModule2 :: GHC.Prim.Addr# -[GblId, Unf=OtherCon []] +[GblId, Str=c, Unf=OtherCon []] Par01.$trModule2 = "Par01"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} Par01.$trModule1 :: GHC.Types.TrName -[GblId, Cpr=m1, Unf=OtherCon []] +[GblId, Str=c, Cpr=m1, Unf=OtherCon []] Par01.$trModule1 = GHC.Types.TrNameS Par01.$trModule2 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} Par01.$trModule :: GHC.Types.Module -[GblId, Cpr=m1, Unf=OtherCon []] +[GblId, Str=c, Cpr=m1, Unf=OtherCon []] Par01.$trModule = GHC.Types.Module Par01.$trModule3 Par01.$trModule1 ===================================== testsuite/tests/simplCore/should_compile/spec-inline.stderr ===================================== @@ -6,6 +6,7 @@ Result size of Tidy Core -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} Roman.$trModule4 :: GHC.Prim.Addr# [GblId, + Str=c, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] Roman.$trModule4 = "main"# @@ -13,6 +14,7 @@ Roman.$trModule4 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} Roman.$trModule3 :: GHC.Types.TrName [GblId, + Str=c, Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] @@ -21,6 +23,7 @@ Roman.$trModule3 = GHC.Types.TrNameS Roman.$trModule4 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} Roman.$trModule2 :: GHC.Prim.Addr# [GblId, + Str=c, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] Roman.$trModule2 = "Roman"# @@ -28,6 +31,7 @@ Roman.$trModule2 = "Roman"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} Roman.$trModule1 :: GHC.Types.TrName [GblId, + Str=c, Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] @@ -36,6 +40,7 @@ Roman.$trModule1 = GHC.Types.TrNameS Roman.$trModule2 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} Roman.$trModule :: GHC.Types.Module [GblId, + Str=c, Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] @@ -44,7 +49,7 @@ Roman.$trModule -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} lvl :: GHC.Prim.Addr# -[GblId, Unf=OtherCon []] +[GblId, Str=c, Unf=OtherCon []] lvl = "spec-inline.hs:(19,5)-(29,25)|function go"# -- RHS size: {terms: 2, types: 2, coercions: 0, joins: 0/0} @@ -57,7 +62,7 @@ Rec { -- RHS size: {terms: 40, types: 5, coercions: 0, joins: 0/0} Roman.foo_$s$wgo [Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.Int# -> GHC.Prim.Int# -[GblId, Arity=2, Str=, Unf=OtherCon []] +[GblId, Arity=2, Str=c, Unf=OtherCon []] Roman.foo_$s$wgo = \ (sc :: GHC.Prim.Int#) (sc1 :: GHC.Prim.Int#) -> case GHC.Prim.<=# sc1 0# of { @@ -80,7 +85,7 @@ Roman.$wgo [InlPrag=NOUSERINLINE[2]] :: Maybe Int -> Maybe Int -> GHC.Prim.Int# [GblId, Arity=2, - Str=, + Str=c, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [61 30] 249 0}] Roman.$wgo @@ -116,7 +121,7 @@ Roman.foo_go [InlPrag=NOUSERINLINE[2]] :: Maybe Int -> Maybe Int -> Int [GblId, Arity=2, - Str=, + Str=c, Cpr=m1, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, @@ -132,6 +137,7 @@ Roman.foo_go -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} Roman.foo2 :: Int [GblId, + Str=c, Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] @@ -140,6 +146,7 @@ Roman.foo2 = GHC.Types.I# 6# -- RHS size: {terms: 2, types: 1, coercions: 0, joins: 0/0} Roman.foo1 :: Maybe Int [GblId, + Str=c, Cpr=m2, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] @@ -149,7 +156,7 @@ Roman.foo1 = GHC.Maybe.Just @Int Roman.foo2 foo :: Int -> Int [GblId, Arity=1, - Str=, + Str=c, Cpr=m1, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, ===================================== testsuite/tests/stranal/sigs/DmdAnalGADTs.stderr ===================================== @@ -5,7 +5,7 @@ DmdAnalGADTs.$tc'B: c DmdAnalGADTs.$tcD: c DmdAnalGADTs.$trModule: c DmdAnalGADTs.diverges: b -DmdAnalGADTs.f: +DmdAnalGADTs.f: c DmdAnalGADTs.f': c DmdAnalGADTs.g: c DmdAnalGADTs.hasCPR: c @@ -33,7 +33,7 @@ DmdAnalGADTs.$tc'B: c DmdAnalGADTs.$tcD: c DmdAnalGADTs.$trModule: c DmdAnalGADTs.diverges: b -DmdAnalGADTs.f: +DmdAnalGADTs.f: c DmdAnalGADTs.f': c DmdAnalGADTs.g: c DmdAnalGADTs.hasCPR: c ===================================== testsuite/tests/stranal/sigs/T8598.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Strictness signatures ==================== T8598.$trModule: c -T8598.fun: +T8598.fun: c @@ -13,6 +13,6 @@ T8598.fun: m1 ==================== Strictness signatures ==================== T8598.$trModule: c -T8598.fun: +T8598.fun: c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b9975eabd46c9690dacf63b59e5e26fa91b2397a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b9975eabd46c9690dacf63b59e5e26fa91b2397a You're receiving 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 Mar 25 12:30:57 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 25 Mar 2020 08:30:57 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/dmdanal-precise-exn Message-ID: <5e7b4f019f669_616713339fc4522416@gitlab.haskell.org.mail> Sebastian Graf pushed new branch wip/dmdanal-precise-exn at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/dmdanal-precise-exn You're receiving 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 Mar 25 12:52:28 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 25 Mar 2020 08:52:28 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T13380 Message-ID: <5e7b540ca1ef4_6167e6514b45245de@gitlab.haskell.org.mail> Sebastian Graf pushed new branch wip/T13380 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T13380 You're receiving 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 Mar 25 12:56:21 2020 From: gitlab at gitlab.haskell.org (Peter Trommler) Date: Wed, 25 Mar 2020 08:56:21 -0400 Subject: [Git][ghc/ghc][wip/T11531] 3 commits: Fix ApplicativeDo regression #17835 Message-ID: <5e7b54f587f0f_61671196b3f4524927@gitlab.haskell.org.mail> Peter Trommler pushed to branch wip/T11531 at Glasgow Haskell Compiler / GHC Commits: 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) - - - - - 883f5933 by Peter Trommler at 2020-03-25T13:55:17+01:00 Do not panic on linker errors - - - - - 14 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Runtime/Linker.hs - libraries/base/Data/Semigroup.hs - testsuite/tests/ado/T13242a.stderr - + testsuite/tests/ado/T17835.hs - testsuite/tests/ado/ado001.stdout - testsuite/tests/ado/all.T - testsuite/tests/ghci/linking/Makefile - + testsuite/tests/ghci/linking/T11531.c - + testsuite/tests/ghci/linking/T11531.h - + testsuite/tests/ghci/linking/T11531.hs - + testsuite/tests/ghci/linking/T11531.stderr - testsuite/tests/ghci/linking/all.T Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -2274,22 +2274,31 @@ pprStmt (ApplicativeStmt _ args mb_join) (if lengthAtLeast args 2 then parens else id) ap_expr pp_arg :: (a, ApplicativeArg (GhcPass idL)) -> SDoc - pp_arg (_, ApplicativeArgOne _ pat expr isBody _) - | isBody = -- See Note [Applicative BodyStmt] - ppr (BodyStmt (panic "pprStmt") expr noSyntaxExpr noSyntaxExpr + pp_arg (_, applicativeArg) = ppr applicativeArg + +pprStmt (XStmtLR x) = ppr x + + +instance (OutputableBndrId idL) + => Outputable (ApplicativeArg (GhcPass idL)) where + ppr = pprArg + +pprArg :: forall idL . (OutputableBndrId idL) => ApplicativeArg (GhcPass idL) -> SDoc +pprArg (ApplicativeArgOne _ pat expr isBody _) + | isBody = -- See Note [Applicative BodyStmt] + ppr (BodyStmt (panic "pprStmt") expr noSyntaxExpr noSyntaxExpr :: ExprStmt (GhcPass idL)) - | otherwise = - ppr (BindStmt (panic "pprStmt") pat expr noSyntaxExpr noSyntaxExpr + | otherwise = + ppr (BindStmt (panic "pprStmt") pat expr noSyntaxExpr noSyntaxExpr :: ExprStmt (GhcPass idL)) - pp_arg (_, ApplicativeArgMany _ stmts return pat) = +pprArg (ApplicativeArgMany _ stmts return pat) = ppr pat <+> text "<-" <+> ppr (HsDo (panic "pprStmt") DoExpr (noLoc (stmts ++ [noLoc (LastStmt noExtField (noLoc return) Nothing noSyntaxExpr)]))) - pp_arg (_, XApplicativeArg x) = ppr x -pprStmt (XStmtLR x) = ppr x +pprArg (XApplicativeArg x) = ppr x pprTransformStmt :: (OutputableBndrId p) => [IdP (GhcPass p)] -> LHsExpr (GhcPass p) ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -1498,7 +1498,7 @@ ApplicativeDo touches a few phases in the compiler: scheduled as outlined above and transformed into applicative combinators. However, the code is still represented as a do-block with special forms of applicative statements. This allows us to - recover the original do-block when e.g. printing type errors, where + recover the original do-block when e.g. printing type errors, where we don't want to show any of the applicative combinators since they don't exist in the source code. See ApplicativeStmt and ApplicativeArg in HsExpr. @@ -1682,7 +1682,7 @@ stmtTreeToStmts monad_names ctxt (StmtTreeOne (L _ (BindStmt _ pat rhs _ fail_op , is_body_stmt = False , fail_operator = fail_op}] False tail' -stmtTreeToStmts monad_names ctxt (StmtTreeOne (L _ (BodyStmt _ rhs _ fail_op),_)) +stmtTreeToStmts monad_names ctxt (StmtTreeOne (L _ (BodyStmt _ rhs _ _),_)) tail _tail_fvs | (False,tail') <- needJoin monad_names tail = mkApplicativeStmt ctxt @@ -1691,7 +1691,7 @@ stmtTreeToStmts monad_names ctxt (StmtTreeOne (L _ (BodyStmt _ rhs _ fail_op),_) , app_arg_pattern = nlWildPatName , arg_expr = rhs , is_body_stmt = True - , fail_operator = fail_op}] False tail' + , fail_operator = noSyntaxExpr}] False tail' stmtTreeToStmts _monad_names _ctxt (StmtTreeOne (s,_)) tail _tail_fvs = return (s : tail, emptyNameSet) @@ -1706,7 +1706,8 @@ stmtTreeToStmts monad_names ctxt (StmtTreeApplicative trees) tail tail_fvs = do pairs <- mapM (stmtTreeArg ctxt tail_fvs) trees let (stmts', fvss) = unzip pairs let (need_join, tail') = - if any hasStrictPattern trees + -- See Note [ApplicativeDo and refutable patterns] + if any hasRefutablePattern stmts' then (True, tail) else needJoin monad_names tail @@ -1721,13 +1722,13 @@ stmtTreeToStmts monad_names ctxt (StmtTreeApplicative trees) tail tail_fvs = do , is_body_stmt = False , fail_operator = fail_op }, emptyFVs) - stmtTreeArg _ctxt _tail_fvs (StmtTreeOne (L _ (BodyStmt _ exp _ fail_op), _)) = + stmtTreeArg _ctxt _tail_fvs (StmtTreeOne (L _ (BodyStmt _ exp _ _), _)) = return (ApplicativeArgOne { xarg_app_arg_one = noExtField , app_arg_pattern = nlWildPatName , arg_expr = exp , is_body_stmt = True - , fail_operator = fail_op + , fail_operator = noSyntaxExpr }, emptyFVs) stmtTreeArg ctxt tail_fvs tree = do let stmts = flattenStmtTree tree @@ -1854,12 +1855,19 @@ isStrictPattern lpat = SplicePat{} -> True _otherwise -> panic "isStrictPattern" -hasStrictPattern :: ExprStmtTree -> Bool -hasStrictPattern (StmtTreeOne (L _ (BindStmt _ pat _ _ _), _)) = isStrictPattern pat -hasStrictPattern (StmtTreeOne _) = False -hasStrictPattern (StmtTreeBind a b) = hasStrictPattern a || hasStrictPattern b -hasStrictPattern (StmtTreeApplicative trees) = any hasStrictPattern trees +{- +Note [ApplicativeDo and refutable patterns] + +Refutable patterns in do blocks are desugared to use the monadic 'fail' operation. +This means that sometimes an applicative block needs to be wrapped in 'join' simply because +of a refutable pattern, in order for the types to work out. + +-} +hasRefutablePattern :: ApplicativeArg GhcRn -> Bool +hasRefutablePattern (ApplicativeArgOne { app_arg_pattern = pat + , is_body_stmt = False}) = not (isIrrefutableHsPat pat) +hasRefutablePattern _ = False isLetStmt :: LStmt a b -> Bool isLetStmt (L _ LetStmt{}) = True ===================================== compiler/GHC/Runtime/Linker.hs ===================================== @@ -187,7 +187,7 @@ getHValue hsc_env name = do m <- lookupClosure hsc_env (unpackFS sym_to_find) case m of Just hvref -> mkFinalizedHValue hsc_env hvref - Nothing -> linkFail "GHC.ByteCode.Linker.lookupCE" + Nothing -> linkFail "GHC.Runtime.Linker.getHValue" (unpackFS sym_to_find) linkDependencies :: HscEnv -> PersistentLinkerState @@ -472,7 +472,7 @@ preloadLib hsc_env lib_paths framework_paths pls lib_spec = do Nothing -> maybePutStrLn dflags "done" Just mm -> preloadFailed mm framework_paths lib_spec return pls - else panic "preloadLib Framework" + else throwGhcExceptionIO (ProgramError "preloadLib Framework") where dflags = hsc_dflags hsc_env @@ -964,7 +964,9 @@ dynLoadObjs hsc_env pls at PersistentLinkerState{..} objs = do m <- loadDLL hsc_env soFile case m of Nothing -> return $! pls { temp_sos = (libPath, libName) : temp_sos } - Just err -> panic ("Loading temp shared object failed: " ++ err) + Just err -> linkFail msg err + where + msg = "GHC.Runtime.Linker.dynLoadObjs: Loading temp shared object failed" rmDupLinkables :: [Linkable] -- Already loaded -> [Linkable] -- New linkables ===================================== libraries/base/Data/Semigroup.hs ===================================== @@ -286,7 +286,15 @@ instance Num a => Num (Max a) where -- | 'Arg' isn't itself a 'Semigroup' in its own right, but it can be -- placed inside 'Min' and 'Max' to compute an arg min or arg max. -data Arg a b = Arg a b deriving +-- +-- >>> minimum [ Arg (x * x) x | x <- [-10 .. 10] ] +-- Arg 0 0 +data Arg a b = Arg + a + -- ^ The argument used for comparisons in 'Eq' and 'Ord'. + b + -- ^ The "value" exposed via the 'Functor', 'Foldable' etc. instances. + deriving ( Show -- ^ @since 4.9.0.0 , Read -- ^ @since 4.9.0.0 , Data -- ^ @since 4.9.0.0 ===================================== testsuite/tests/ado/T13242a.stderr ===================================== @@ -32,10 +32,15 @@ T13242a.hs:13:11: error: ...plus 21 others ...plus six instances involving out-of-scope types (use -fprint-potential-instances to see them all) - • In the first argument of ‘return’, namely ‘(x == x)’ In a stmt of a 'do' block: return (x == x) In the expression: do A x <- undefined _ <- return 'a' _ <- return 'b' return (x == x) + In an equation for ‘test’: + test + = do A x <- undefined + _ <- return 'a' + _ <- return 'b' + return (x == x) ===================================== testsuite/tests/ado/T17835.hs ===================================== @@ -0,0 +1,38 @@ +-- Build.hs +{-# LANGUAGE ApplicativeDo #-} +module Build (configRules) where + +type Action = IO +type Rules = IO + +type Config = () + +(%>) :: String -> (String -> Action ()) -> Rules () +(%>) = undefined + +command_ :: [String] -> String -> [String] -> Action () +command_ = undefined + +recursive :: Config -> String -> [String] -> IO (FilePath, [String]) +recursive = undefined + +liftIO :: IO a -> Action a +liftIO = id + +need :: [String] -> Action () +need = undefined + +historyDisable :: Action () +historyDisable = undefined + +get_config :: () -> Action Config +get_config = undefined + +configRules :: Rules () +configRules = do + "snapshot" %> \out -> do + historyDisable -- 8.10-rc1 refuses to compile without bind here + config <- get_config () + need [] + (exe,args) <- liftIO $ recursive config "snapshot" [] + command_ [] exe args ===================================== testsuite/tests/ado/ado001.stdout ===================================== @@ -9,4 +9,4 @@ a; ((b | c) | d) ((a | (b; c)) | d) | e ((a | b); (c | d)) | e a | b -(a | (b; c)) +a | (b; c) ===================================== testsuite/tests/ado/all.T ===================================== @@ -17,3 +17,4 @@ test('T13875', normal, compile_and_run, ['']) test('T14163', normal, compile_and_run, ['']) test('T15344', normal, compile_and_run, ['']) test('T16628', normal, compile_fail, ['']) +test('T17835', normal, compile, ['']) ===================================== testsuite/tests/ghci/linking/Makefile ===================================== @@ -127,6 +127,11 @@ T3333: "$(TEST_HC)" -c T3333.c -o T3333.o echo "weak_test 10" | "$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) T3333.hs T3333.o +.PHONY: T11531 +T11531: + "$(TEST_HC)" -dynamic -fPIC -c T11531.c -o T11531.o + - echo ":q" | "$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) T11531.o T11531.hs 2>&1 | sed -e '/undefined symbol:/d' 1>&2 + .PHONY: T14708 T14708: $(RM) -rf T14708scratch ===================================== testsuite/tests/ghci/linking/T11531.c ===================================== @@ -0,0 +1,9 @@ +extern void undefined_function(void); + +int some_function(int d) { + return 64; +} + +void __attribute__ ((constructor)) setup(void) { + undefined_function(); +} ===================================== testsuite/tests/ghci/linking/T11531.h ===================================== @@ -0,0 +1,2 @@ +int some_function(int d); + ===================================== testsuite/tests/ghci/linking/T11531.hs ===================================== @@ -0,0 +1,3 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +foreign import ccall "T11531.h some_function" someFunction :: Int -> Int ===================================== testsuite/tests/ghci/linking/T11531.stderr ===================================== @@ -0,0 +1,11 @@ + +GHC.Runtime.Linker.dynLoadObjs: Loading temp shared object failed +During interactive linking, GHCi couldn't find the following symbol: +This may be due to you not asking GHCi to load extra object files, +archives or DLLs needed by your current session. Restart GHCi, specifying +the missing library using the -L/path/to/object/dir and -lmissinglibname +flags, or simply by naming the relevant files on the GHCi command line. +Alternatively, this link failure might indicate a bug in GHCi. +If you suspect the latter, please report this as a GHC bug: + https://www.haskell.org/ghc/reportabug + ===================================== testsuite/tests/ghci/linking/all.T ===================================== @@ -43,6 +43,12 @@ test('T3333', expect_broken(3333))], makefile_test, ['T3333']) +test('T11531', + [extra_files(['T11531.hs', 'T11531.c', 'T11531.h']), + unless(doing_ghci, skip), + unless(opsys('linux'), skip)], + makefile_test, ['T11531']) + test('T14708', [extra_files(['T14708.hs', 'add.c']), unless(doing_ghci, skip), View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f7334c1bca3d151aed224d708e65feb9afa22fd8...883f59332c53f23a77bdbda69fa54d37a5ab708d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f7334c1bca3d151aed224d708e65feb9afa22fd8...883f59332c53f23a77bdbda69fa54d37a5ab708d You're receiving 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 Mar 25 13:28:35 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 25 Mar 2020 09:28:35 -0400 Subject: [Git][ghc/ghc][wip/T13380] Fix #13380 and #17676 Message-ID: <5e7b5c8325bc9_616713339fc45293c7@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T13380 at Glasgow Haskell Compiler / GHC Commits: c07e8396 by Sebastian Graf at 2020-03-25T13:57:15+01:00 Fix #13380 and #17676 By 1. Changing `raiseIO#` to have topDiv 2. Give it special treatment in `Simplifier.Util.mkArgInfo`, treating it as if it 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. - - - - - 5 changed files: - compiler/GHC/Core/Op/Simplify/Utils.hs - compiler/basicTypes/Demand.hs - compiler/prelude/primops.txt.pp - + testsuite/tests/stranal/should_run/T17676.hs - testsuite/tests/stranal/should_run/all.T Changes: ===================================== compiler/GHC/Core/Op/Simplify/Utils.hs ===================================== @@ -55,6 +55,7 @@ import Name import Id import IdInfo import Var +import PrimOp import Demand import GHC.Core.Op.Simplify.Monad import GHC.Core.Type hiding( substTy ) @@ -500,7 +501,9 @@ mkArgInfo env fun rules n_val_args call_cont -- calls to error. But now we are more careful about -- inlining lone variables, so it's ok -- (see GHC.Core.Op.Simplify.Utils.analyseCont) - if isBotDiv result_info then + -- See Note [Precise exceptions and strictness analysis] in Demand.hs + -- for the special case on raiseIO# + if isBotDiv result_info || isPrimOpId_maybe fun == Just RaiseIOOp then map isStrictDmd demands -- Finite => result is bottom else map isStrictDmd demands ++ vanilla_stricts ===================================== compiler/basicTypes/Demand.hs ===================================== @@ -932,6 +932,28 @@ instance Outputable Divergence where ppr Diverges = char 'b' ppr Dunno = empty +{- Note [Precise exceptions and strictness analysis] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +raiseIO# needs to be a primop (rather than defining it in terms of raise#), +because exceptions raised by it are considered *precise* - we don't want the +strictness analyser turning one kind of bottom into another, as it is allowed +to do in pure code. + +This means that raiseIO# is lazy in its free variables, see the following +example from #13380 (similarly #17676): + f x y | x>0 = raiseIO Exc + | y>0 = return 1 + | otherwise = return 2 + at f@ strict in @y@? One might be tempted to say yes! But that plays fast and +loose with the precise exception; after optimisation, @f 42 (error "boom")@ +turns from throwing the precise @Exc@ to throwing the imprecise user error +"boom". So, the @defaultDmd@ of @raiseIO#@ should be lazy (@topDmd@), which can +be achieved by giving it @topDiv at . +But then the simplifier fails to drop a lot of dead code, hence we have special +treatment for raiseIO# in @Simplifier.Utils.mkArgInfo at . +-} + + ------------------------------------------------------------------------ -- Combined demand result -- ------------------------------------------------------------------------ ===================================== compiler/prelude/primops.txt.pp ===================================== @@ -2644,27 +2644,12 @@ primop RaiseOverflowOp "raiseOverflow#" GenPrimOp out_of_line = True has_side_effects = True --- raiseIO# needs to be a primop, because exceptions in the IO monad --- must be *precise* - we don't want the strictness analyser turning --- one kind of bottom into another, as it is allowed to do in pure code. --- --- But we *do* want to know that it returns bottom after --- being applied to two arguments, so that this function is strict in y --- f x y | x>0 = raiseIO blah --- | y>0 = return 1 --- | otherwise = return 2 --- --- TODO Check that the above notes on @f@ are valid. The function successfully --- produces an IO exception when compiled without optimization. If we analyze --- it as strict in @y@, won't we change that behavior under optimization? --- I thought the rule was that it was okay to replace one valid imprecise --- exception with another, but not to replace a precise exception with --- an imprecise one (dfeuer, 2017-03-05). - primop RaiseIOOp "raiseIO#" GenPrimOp a -> State# RealWorld -> (# State# RealWorld, b #) with - strictness = { \ _arity -> mkClosedStrictSig [topDmd, topDmd] botDiv } + -- See Note [Precise exceptions and strictness analysis] in Demand.hs + -- for why we give it topDiv + -- strictness = { \ _arity -> mkClosedStrictSig [topDmd, topDmd] topDiv } out_of_line = True has_side_effects = True ===================================== testsuite/tests/stranal/should_run/T17676.hs ===================================== @@ -0,0 +1,18 @@ +{-# LANGUAGE ScopedTypeVariables #-} +import Data.IORef +import Control.Exception +import Control.Monad + +data Exc = Exc deriving Show + +instance Exception Exc + +-- Recursive instead of NOINLINE because of #17673 +f :: Int -> Int -> IO () +f 0 x = do + let true = sum [0..4] == 10 + when true $ throwIO Exc + x `seq` return () +f n x = f (n-1) (x+1) + +main = f 1 (error "expensive computation") `catch` \(_ :: Exc) -> return () ===================================== testsuite/tests/stranal/should_run/all.T ===================================== @@ -19,7 +19,8 @@ test('T11076', normal, multimod_compile_and_run, ['T11076.hs', 'T11076_prim.cmm' test('T11555a', normal, compile_and_run, ['']) test('T12368', exit_code(1), compile_and_run, ['']) test('T12368a', exit_code(1), compile_and_run, ['']) -test('T13380', [expect_broken(13380), exit_code(1)], compile_and_run, ['']) +test('T13380', exit_code(1), compile_and_run, ['']) 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, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c07e839635b873aeff80d8207c902f196b86ec8c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c07e839635b873aeff80d8207c902f196b86ec8c You're receiving 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 Mar 25 13:31:23 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 25 Mar 2020 09:31:23 -0400 Subject: [Git][ghc/ghc][wip/T13380] Fix #13380 and #17676 Message-ID: <5e7b5d2b37871_61671196b3f453091f@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T13380 at Glasgow Haskell Compiler / GHC Commits: 15857aa5 by Sebastian Graf at 2020-03-25T14:31:12+01:00 Fix #13380 and #17676 By 1. Changing `raiseIO#` to have topDiv 2. Give it special treatment in `Simplifier.Util.mkArgInfo`, treating it as if it 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. - - - - - 5 changed files: - compiler/GHC/Core/Op/Simplify/Utils.hs - compiler/basicTypes/Demand.hs - compiler/prelude/primops.txt.pp - + testsuite/tests/stranal/should_run/T17676.hs - testsuite/tests/stranal/should_run/all.T Changes: ===================================== compiler/GHC/Core/Op/Simplify/Utils.hs ===================================== @@ -55,6 +55,7 @@ import Name import Id import IdInfo import Var +import PrimOp import Demand import GHC.Core.Op.Simplify.Monad import GHC.Core.Type hiding( substTy ) @@ -500,7 +501,9 @@ mkArgInfo env fun rules n_val_args call_cont -- calls to error. But now we are more careful about -- inlining lone variables, so it's ok -- (see GHC.Core.Op.Simplify.Utils.analyseCont) - if isBotDiv result_info then + -- See Note [Precise exceptions and strictness analysis] in Demand.hs + -- for the special case on raiseIO# + if isBotDiv result_info || isPrimOpId_maybe fun == Just RaiseIOOp then map isStrictDmd demands -- Finite => result is bottom else map isStrictDmd demands ++ vanilla_stricts ===================================== compiler/basicTypes/Demand.hs ===================================== @@ -932,6 +932,28 @@ instance Outputable Divergence where ppr Diverges = char 'b' ppr Dunno = empty +{- Note [Precise exceptions and strictness analysis] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +raiseIO# needs to be a primop (rather than defining it in terms of raise#), +because exceptions raised by it are considered *precise* - we don't want the +strictness analyser turning one kind of bottom into another, as it is allowed +to do in pure code. + +This means that raiseIO# is lazy in its free variables, see the following +example from #13380 (similarly #17676): + f x y | x>0 = raiseIO Exc + | y>0 = return 1 + | otherwise = return 2 +Is @f@ strict in @y@? One might be tempted to say yes! But that plays fast and +loose with the precise exception; after optimisation, @f 42 (error "boom")@ +turns from throwing the precise @Exc@ to throwing the imprecise user error +"boom". So, the @defaultDmd@ of @raiseIO#@ should be lazy (@topDmd@), which can +be achieved by giving it @topDiv at . +But then the simplifier fails to drop a lot of dead code, hence we have special +treatment for raiseIO# in @Simplifier.Utils.mkArgInfo at . +-} + + ------------------------------------------------------------------------ -- Combined demand result -- ------------------------------------------------------------------------ ===================================== compiler/prelude/primops.txt.pp ===================================== @@ -2644,27 +2644,12 @@ primop RaiseOverflowOp "raiseOverflow#" GenPrimOp out_of_line = True has_side_effects = True --- raiseIO# needs to be a primop, because exceptions in the IO monad --- must be *precise* - we don't want the strictness analyser turning --- one kind of bottom into another, as it is allowed to do in pure code. --- --- But we *do* want to know that it returns bottom after --- being applied to two arguments, so that this function is strict in y --- f x y | x>0 = raiseIO blah --- | y>0 = return 1 --- | otherwise = return 2 --- --- TODO Check that the above notes on @f@ are valid. The function successfully --- produces an IO exception when compiled without optimization. If we analyze --- it as strict in @y@, won't we change that behavior under optimization? --- I thought the rule was that it was okay to replace one valid imprecise --- exception with another, but not to replace a precise exception with --- an imprecise one (dfeuer, 2017-03-05). - primop RaiseIOOp "raiseIO#" GenPrimOp a -> State# RealWorld -> (# State# RealWorld, b #) with - strictness = { \ _arity -> mkClosedStrictSig [topDmd, topDmd] botDiv } + -- See Note [Precise exceptions and strictness analysis] in Demand.hs + -- for why we give it topDiv + -- strictness = { \ _arity -> mkClosedStrictSig [topDmd, topDmd] topDiv } out_of_line = True has_side_effects = True ===================================== testsuite/tests/stranal/should_run/T17676.hs ===================================== @@ -0,0 +1,18 @@ +{-# LANGUAGE ScopedTypeVariables #-} +import Data.IORef +import Control.Exception +import Control.Monad + +data Exc = Exc deriving Show + +instance Exception Exc + +-- Recursive instead of NOINLINE because of #17673 +f :: Int -> Int -> IO () +f 0 x = do + let true = sum [0..4] == 10 + when true $ throwIO Exc + x `seq` return () +f n x = f (n-1) (x+1) + +main = f 1 (error "expensive computation") `catch` \(_ :: Exc) -> return () ===================================== testsuite/tests/stranal/should_run/all.T ===================================== @@ -19,7 +19,8 @@ test('T11076', normal, multimod_compile_and_run, ['T11076.hs', 'T11076_prim.cmm' test('T11555a', normal, compile_and_run, ['']) test('T12368', exit_code(1), compile_and_run, ['']) test('T12368a', exit_code(1), compile_and_run, ['']) -test('T13380', [expect_broken(13380), exit_code(1)], compile_and_run, ['']) +test('T13380', exit_code(1), compile_and_run, ['']) 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, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/15857aa51416b054df049d86805ccbc7f087190c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/15857aa51416b054df049d86805ccbc7f087190c You're receiving 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 Mar 25 13:48:42 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Wed, 25 Mar 2020 09:48:42 -0400 Subject: [Git][ghc/ghc][wip/T17923] Significant refactor of Lint Message-ID: <5e7b613a880c3_61675cefcac533232@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T17923 at Glasgow Haskell Compiler / GHC Commits: 8ae203c7 by Simon Peyton Jones at 2020-03-25T13:48:00+00: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. - - - - - 4 changed files: - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Type.hs - + testsuite/tests/indexed-types/should_compile/T17923.hs - testsuite/tests/indexed-types/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -8,7 +8,7 @@ See Note [Core Lint guarantee]. -} {-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE ScopedTypeVariables, DeriveFunctor #-} module GHC.Core.Lint ( lintCoreBindings, lintUnfolding, @@ -33,7 +33,6 @@ import GHC.Core.Op.Monad import Bag import Literal import GHC.Core.DataCon -import TysWiredIn import TysPrim import TcType ( isFloatingTy ) import Var @@ -461,14 +460,17 @@ lintCoreBindings :: DynFlags -> CoreToDo -> [Var] -> CoreProgram -> (Bag MsgDoc, lintCoreBindings dflags pass local_in_scope binds = initL dflags flags local_in_scope $ addLoc TopLevelBindings $ - lintLetBndrs TopLevel binders $ - -- Put all the top-level binders in scope at the start - -- This is because transformation rules can bring something - -- into use 'unexpectedly' do { checkL (null dups) (dupVars dups) ; checkL (null ext_dups) (dupExtVars ext_dups) - ; mapM lint_bind binds } + ; lintRecBindings TopLevel all_pairs $ + return () } where + all_pairs = flattenBinds binds + -- Put all the top-level binders in scope at the start + -- This is because transformation rules can bring something + -- into use 'unexpectedly'; see Note [Glomming] in OccurAnal + binders = map fst all_pairs + flags = defaultLintFlags { lf_check_global_ids = check_globals , lf_check_inline_loop_breakers = check_lbs @@ -494,7 +496,6 @@ lintCoreBindings dflags pass local_in_scope binds CorePrep -> AllowAtTopLevel _ -> AllowAnywhere - binders = bindersOfBinds binds (_, dups) = removeDups compare binders -- dups_ext checks for names with different uniques @@ -509,11 +510,6 @@ lintCoreBindings dflags pass local_in_scope binds = compare (m1, nameOccName n1) (m2, nameOccName n2) | otherwise = LT - -- If you edit this function, you may need to update the GHC formalism - -- See Note [GHC Formalism] - lint_bind (Rec prs) = mapM_ (lintSingleBinding TopLevel Recursive) prs - lint_bind (NonRec bndr rhs) = lintSingleBinding TopLevel NonRecursive (bndr,rhs) - {- ************************************************************************ * * @@ -576,28 +572,32 @@ lintExpr dflags vars expr Check a core binding, returning the list of variables bound. -} -lintSingleBinding :: TopLevelFlag -> RecFlag -> (Id, CoreExpr) -> LintM () --- If you edit this function, you may need to update the GHC formalism --- See Note [GHC Formalism] -lintSingleBinding top_lvl_flag rec_flag (binder,rhs) - = addLoc (RhsOf binder) $ - -- Check the rhs - do { ty <- lintRhs binder rhs - ; binder_ty <- applySubstTy (idType binder) - ; ensureEqTys binder_ty ty (mkRhsMsg binder (text "RHS") ty) +lintRecBindings :: TopLevelFlag -> [(Id, CoreExpr)] + -> LintM a -> LintM a +lintRecBindings top_lvl pairs thing_inside + = lintIdBndrs top_lvl bndrs $ \ bndrs' -> + do { zipWithM_ lint_pair bndrs' rhss + ; thing_inside } + where + (bndrs, rhss) = unzip pairs + lint_pair bndr' rhs + = addLoc (RhsOf bndr') $ + do { rhs_ty <- lintRhs bndr' rhs -- Check the rhs + ; lintLetBind top_lvl Recursive bndr' rhs rhs_ty } + +lintLetBind :: TopLevelFlag -> RecFlag -> LintedId + -> CoreExpr -> LintedType -> LintM () +-- Binder's type, and the RHS, have already been linted +-- This function checks other invariants +lintLetBind top_lvl rec_flag binder rhs rhs_ty + = do { let binder_ty = idType binder + ; ensureEqTys binder_ty rhs_ty (mkRhsMsg binder (text "RHS") rhs_ty) -- If the binding is for a CoVar, the RHS should be (Coercion co) -- See Note [Core type and coercion invariant] in GHC.Core ; checkL (not (isCoVar binder) || isCoArg rhs) (mkLetErr binder rhs) - -- Check that it's not levity-polymorphic - -- Do this first, because otherwise isUnliftedType panics - -- Annoyingly, this duplicates the test in lintIdBdr, - -- because for non-rec lets we call lintSingleBinding first - ; checkL (isJoinId binder || not (isTypeLevPoly binder_ty)) - (badBndrTyMsg binder (text "levity-polymorphic")) - -- Check the let/app invariant -- See Note [Core let/app invariant] in GHC.Core ; checkL ( isJoinId binder @@ -610,14 +610,14 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs) -- 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_flag)) + || (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]. - ; checkL (not (isTopLevel top_lvl_flag && binder_ty `eqType` addrPrimTy) + ; checkL (not (isTopLevel top_lvl && binder_ty `eqType` addrPrimTy) || exprIsTickedString rhs) (mkTopNonLitStrMsg binder) @@ -674,7 +674,9 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs) -- join point. -- -- See Note [Checking StaticPtrs]. -lintRhs :: Id -> CoreExpr -> LintM OutType +lintRhs :: Id -> CoreExpr -> LintM LintedType +-- NB: the Id can be Linted or not -- it's only used for +-- its OccInfo and join-pointer-hood lintRhs bndr rhs | Just arity <- isJoinId_maybe bndr = lint_join_lams arity arity True rhs @@ -761,13 +763,14 @@ hurts us here. ************************************************************************ -} --- For OutType, OutKind, the substitution has been applied, --- but has not been linted yet +-- Linted things: substitution applied, and type is linted +type LintedType = Type +type LintedKind = Kind +type LintedCoercion = Coercion +type LintedTyCoVar = TyCoVar +type LintedId = Id -type LintedType = Type -- Substitution applied, and type is linted -type LintedKind = Kind - -lintCoreExpr :: CoreExpr -> LintM OutType +lintCoreExpr :: CoreExpr -> LintM LintedType -- The returned type has the substitution from the monad -- already applied to it: -- lintCoreExpr e subst = exprType (subst e) @@ -776,6 +779,7 @@ lintCoreExpr :: CoreExpr -> LintM OutType -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] + lintCoreExpr (Var var) = lintVarOcc var 0 @@ -784,10 +788,11 @@ lintCoreExpr (Lit lit) lintCoreExpr (Cast expr co) = do { expr_ty <- markAllJoinsBad $ lintCoreExpr expr - ; co' <- applySubstCo co - ; (_, k2, from_ty, to_ty, r) <- lintCoercion co' - ; checkValueKind k2 (text "target of cast" <+> quotes (ppr co)) - ; lintRole co' Representational r + ; co' <- lintCoercion co + ; let (Pair from_ty to_ty, role) = coercionKindRole co' + ; checkValueType to_ty $ + text "target of cast" <+> quotes (ppr co') + ; lintRole co' Representational role ; ensureEqTys from_ty expr_ty (mkCastErr expr co' from_ty expr_ty) ; return to_ty } @@ -809,7 +814,7 @@ lintCoreExpr (Tick tickish expr) lintCoreExpr (Let (NonRec tv (Type ty)) body) | isTyVar tv = -- See Note [Linting type lets] - do { ty' <- applySubstTy ty + do { ty' <- lintType ty ; lintTyBndr tv $ \ tv' -> do { addLoc (RhsOf tv) $ lintTyKind tv' ty' -- Now extend the substitution so we @@ -820,33 +825,34 @@ lintCoreExpr (Let (NonRec tv (Type ty)) body) lintCoreExpr (Let (NonRec bndr rhs) body) | isId bndr - = do { lintSingleBinding NotTopLevel NonRecursive (bndr,rhs) - ; addLoc (BodyOfLetRec [bndr]) - (lintBinder LetBind bndr $ \_ -> - addGoodJoins [bndr] $ - lintCoreExpr body) } + = do { -- First Lint the RHS, before bringing the binder into scope + rhs_ty <- lintRhs bndr rhs + + -- Now lint the binder + ; lintBinder LetBind bndr $ \bndr' -> + do { lintLetBind NotTopLevel NonRecursive bndr' rhs rhs_ty + ; addLoc (BodyOfLetRec [bndr]) (lintCoreExpr body) } } | otherwise = failWithL (mkLetErr bndr rhs) -- Not quite accurate lintCoreExpr e@(Let (Rec pairs) body) - = lintLetBndrs NotTopLevel bndrs $ - addGoodJoins bndrs $ - do { -- Check that the list of pairs is non-empty + = do { -- Check that the list of pairs is non-empty checkL (not (null pairs)) (emptyRec e) -- Check that there are no duplicated binders + ; let (_, dups) = removeDups compare bndrs ; checkL (null dups) (dupVars dups) -- Check that either all the binders are joins, or none ; checkL (all isJoinId bndrs || all (not . isJoinId) bndrs) $ - mkInconsistentRecMsg bndrs + mkInconsistentRecMsg bndrs - ; mapM_ (lintSingleBinding NotTopLevel Recursive) pairs - ; addLoc (BodyOfLetRec bndrs) (lintCoreExpr body) } + ; lintRecBindings NotTopLevel pairs $ + addLoc (BodyOfLetRec bndrs) $ + lintCoreExpr body } where bndrs = map fst pairs - (_, dups) = removeDups compare bndrs lintCoreExpr e@(App _ _) = do { fun_ty <- lintCoreFun fun (length args) @@ -867,20 +873,27 @@ lintCoreExpr (Type ty) = failWithL (text "Type found as expression" <+> ppr ty) lintCoreExpr (Coercion co) - = do { (k1, k2, ty1, ty2, role) <- lintInCo co - ; return (mkHeteroCoercionType role k1 k2 ty1 ty2) } + = do { co' <- addLoc (InCo co) $ + lintCoercion co + ; return (coercionType co') } ---------------------- lintVarOcc :: Var -> Int -- Number of arguments (type or value) being passed - -> LintM Type -- returns type of the *variable* + -> LintM LintedType -- returns type of the *variable* lintVarOcc var nargs - = do { checkL (isNonCoVarId var) + = addLoc (OccOf var) $ + do { checkL (isNonCoVarId var) (text "Non term variable" <+> ppr var) -- See GHC.Core Note [Variable occurrences in Core] -- Check that the type of the occurrence is the same - -- as the type of the binding site - ; ty <- applySubstTy (idType var) + -- as the type of the binding site. We lint the type so that + -- we apply the substitution. Actually this will get into trouble + -- with /\a. \(x::Maybe a). /\a. ...(x::Maybe a)... + -- The "::Maybe a" on the occurrence is referring to the /outer/ a. + -- But this naive check will treat it like the inner one. + -- This looks like a bug waiting to happen. + ; ty <- lintType (idType var) ; var' <- lookupIdInScope var ; let ty' = idType var' ; ensureEqTys ty ty' $ mkBndrOccTypeMismatchMsg var' var ty' ty @@ -898,8 +911,8 @@ lintVarOcc var nargs ; return (idType var') } lintCoreFun :: CoreExpr - -> Int -- Number of arguments (type or val) being passed - -> LintM Type -- Returns type of the *function* + -> Int -- Number of arguments (type or val) being passed + -> LintM LintedType -- Returns type of the *function* lintCoreFun (Var var) nargs = lintVarOcc var nargs @@ -941,7 +954,9 @@ checkJoinOcc var n_args = do { mb_join_arity_bndr <- lookupJoinId var ; case mb_join_arity_bndr of { Nothing -> -- Binder is not a join point - addErrL (invalidJoinOcc var) ; + do { join_set <- getValidJoins + ; addErrL (text "join set " <+> ppr join_set $$ + invalidJoinOcc var) } ; Just join_arity_bndr -> @@ -1038,15 +1053,15 @@ subtype of the required type, as one would expect. -} -lintCoreArgs :: OutType -> [CoreArg] -> LintM OutType +lintCoreArgs :: LintedType -> [CoreArg] -> LintM LintedType lintCoreArgs fun_ty args = foldM lintCoreArg fun_ty args -lintCoreArg :: OutType -> CoreArg -> LintM OutType +lintCoreArg :: LintedType -> CoreArg -> LintM LintedType lintCoreArg fun_ty (Type arg_ty) = do { checkL (not (isCoercionTy arg_ty)) (text "Unnecessary coercion-to-type injection:" <+> ppr arg_ty) - ; arg_ty' <- applySubstTy arg_ty + ; arg_ty' <- lintType arg_ty ; lintTyApp fun_ty arg_ty' } lintCoreArg fun_ty arg @@ -1060,11 +1075,12 @@ lintCoreArg fun_ty arg ; checkL (not (isUnliftedType arg_ty) || exprOkForSpeculation arg) (mkLetAppMsg arg) + ; lintValApp arg fun_ty arg_ty } ----------------- -lintAltBinders :: OutType -- Scrutinee type - -> OutType -- Constructor type +lintAltBinders :: LintedType -- Scrutinee type + -> LintedType -- Constructor type -> [OutVar] -- Binders -> LintM () -- If you edit this function, you may need to update the GHC formalism @@ -1080,7 +1096,7 @@ lintAltBinders scrut_ty con_ty (bndr:bndrs) ; lintAltBinders scrut_ty con_ty' bndrs } ----------------- -lintTyApp :: OutType -> OutType -> LintM OutType +lintTyApp :: LintedType -> LintedType -> LintM LintedType lintTyApp fun_ty arg_ty | Just (tv,body_ty) <- splitForAllTy_maybe fun_ty = do { lintTyKind tv arg_ty @@ -1094,7 +1110,7 @@ lintTyApp fun_ty arg_ty = failWithL (mkTyAppMsg fun_ty arg_ty) ----------------- -lintValApp :: CoreExpr -> OutType -> OutType -> LintM OutType +lintValApp :: CoreExpr -> LintedType -> LintedType -> LintM LintedType lintValApp arg fun_ty arg_ty | Just (arg,res) <- splitFunTy_maybe fun_ty = do { ensureEqTys arg arg_ty err1 @@ -1105,17 +1121,17 @@ lintValApp arg fun_ty arg_ty err1 = mkAppMsg fun_ty arg_ty arg err2 = mkNonFunAppMsg fun_ty arg_ty arg -lintTyKind :: OutTyVar -> OutType -> LintM () +lintTyKind :: OutTyVar -> LintedType -> LintM () -- Both args have had substitution applied -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] lintTyKind tyvar arg_ty - = do { arg_kind <- lintType arg_ty - ; unless (arg_kind `eqType` tyvar_kind) - (addErrL (mkKindErrMsg tyvar arg_ty $$ (text "Linted Arg kind:" <+> ppr arg_kind))) } + = unless (arg_kind `eqType` tyvar_kind) $ + addErrL (mkKindErrMsg tyvar arg_ty $$ (text "Linted Arg kind:" <+> ppr arg_kind)) where tyvar_kind = tyVarKind tyvar + arg_kind = typeKind arg_ty {- ************************************************************************ @@ -1125,7 +1141,7 @@ lintTyKind tyvar arg_ty ************************************************************************ -} -lintCaseExpr :: CoreExpr -> Id -> Type -> [CoreAlt] -> LintM OutType +lintCaseExpr :: CoreExpr -> Id -> Type -> [CoreAlt] -> LintM LintedType lintCaseExpr scrut var alt_ty alts = do { let e = Case scrut var alt_ty alts -- Just for error messages @@ -1134,10 +1150,10 @@ lintCaseExpr scrut var alt_ty alts = -- See Note [Join points are less general than the paper] -- in GHC.Core - ; (alt_ty, _) <- addLoc (CaseTy scrut) $ - lintInTy alt_ty - ; (var_ty, _) <- addLoc (IdTy var) $ - lintInTy (idType var) + ; alt_ty <- addLoc (CaseTy scrut) $ + lintValueType alt_ty + ; var_ty <- addLoc (IdTy var) $ + lintValueType (idType var) -- We used to try to check whether a case expression with no -- alternatives was legitimate, but this didn't work. @@ -1179,7 +1195,7 @@ lintCaseExpr scrut var alt_ty alts = ; checkCaseAlts e scrut_ty alts ; return alt_ty } } -checkCaseAlts :: CoreExpr -> OutType -> [CoreAlt] -> LintM () +checkCaseAlts :: CoreExpr -> LintedType -> [CoreAlt] -> LintM () -- a) Check that the alts are non-empty -- b1) Check that the DEFAULT comes first, if it exists -- b2) Check that the others are in increasing order @@ -1219,14 +1235,14 @@ checkCaseAlts e ty alts = Nothing -> False Just tycon -> isPrimTyCon tycon -lintAltExpr :: CoreExpr -> OutType -> LintM () +lintAltExpr :: CoreExpr -> LintedType -> LintM () lintAltExpr expr ann_ty = do { actual_ty <- lintCoreExpr expr ; ensureEqTys actual_ty ann_ty (mkCaseAltMsg expr actual_ty ann_ty) } -- See GHC.Core Note [Case expression invariants] item (6) -lintCoreAlt :: OutType -- Type of scrutinee - -> OutType -- Type of the alternative +lintCoreAlt :: LintedType -- Type of scrutinee + -> LintedType -- Type of the alternative -> CoreAlt -> LintM () -- If you edit this function, you may need to update the GHC formalism @@ -1286,33 +1302,36 @@ lintBinders site (var:vars) linterF = lintBinder site var $ \var' -> -- See Note [GHC Formalism] lintBinder :: BindingSite -> Var -> (Var -> LintM a) -> LintM a lintBinder site var linterF - | isTyVar var = lintTyBndr var linterF - | isCoVar var = lintCoBndr var linterF - | otherwise = lintIdBndr NotTopLevel site var linterF + | isTyCoVar var = lintTyCoBndr var linterF + | otherwise = lintIdBndr NotTopLevel site var linterF -lintTyBndr :: InTyVar -> (OutTyVar -> LintM a) -> LintM a -lintTyBndr tv thing_inside - = do { subst <- getTCvSubst - ; let (subst', tv') = substTyVarBndr subst tv - ; lintKind (varType tv') - ; updateTCvSubst subst' (thing_inside tv') } +lintTyBndr :: TyVar -> (LintedTyCoVar -> LintM a) -> LintM a +lintTyBndr = lintTyCoBndr -- We could specialise it, I guess -lintCoBndr :: InCoVar -> (OutCoVar -> LintM a) -> LintM a -lintCoBndr cv thing_inside +-- lintCoBndr :: CoVar -> (LintedTyCoVar -> LintM a) -> LintM a +-- lintCoBndr = lintTyCoBndr -- We could specialise it, I guess + +lintTyCoBndr :: TyCoVar -> (LintedTyCoVar -> LintM a) -> LintM a +lintTyCoBndr tcv thing_inside = do { subst <- getTCvSubst - ; let (subst', cv') = substCoVarBndr subst cv - ; lintKind (varType cv') - ; lintL (isCoVarType (varType cv')) - (text "CoVar with non-coercion type:" <+> pprTyVar cv) - ; updateTCvSubst subst' (thing_inside cv') } - -lintLetBndrs :: TopLevelFlag -> [Var] -> LintM a -> LintM a -lintLetBndrs top_lvl ids linterF - = go ids + ; kind' <- lintType (varType tcv) + ; let tcv' = uniqAway (getTCvInScope subst) $ + setVarType tcv kind' + subst' = extendTCvSubstWithClone subst tcv tcv' + ; when (isCoVar tcv) $ + lintL (isCoVarType kind') + (text "CoVar with non-coercion type:" <+> pprTyVar tcv) + ; updateTCvSubst subst' (thing_inside tcv') } + +lintIdBndrs :: forall a. TopLevelFlag -> [Id] -> ([LintedId] -> LintM a) -> LintM a +lintIdBndrs top_lvl ids thing_inside + = go ids thing_inside where - go [] = linterF - go (id:ids) = lintIdBndr top_lvl LetBind id $ \_ -> - go ids + go :: [Id] -> ([Id] -> LintM a) -> LintM a + go [] thing_inside = thing_inside [] + go (id:ids) thing_inside = lintIdBndr top_lvl LetBind id $ \id' -> + go ids $ \ids' -> + thing_inside (id' : ids') lintIdBndr :: TopLevelFlag -> BindingSite -> InVar -> (OutVar -> LintM a) -> LintM a @@ -1334,14 +1353,15 @@ lintIdBndr top_lvl bind_site id linterF ; checkL (not (isExternalName (Var.varName id)) || is_top_lvl) (mkNonTopExternalNameMsg id) - ; (id_ty, k) <- addLoc (IdTy id) $ - lintInTy (idType id) + ; id_ty <- addLoc (IdTy id) $ + lintValueType (idType id) ; let id' = setIdType id id_ty -- See Note [Levity polymorphism invariants] in GHC.Core - ; lintL (isJoinId id || not (lf_check_levity_poly flags) || not (isKindLevPoly k)) - (text "Levity-polymorphic binder:" <+> - (ppr id <+> dcolon <+> parens (ppr id_ty <+> dcolon <+> ppr k))) + ; lintL (isJoinId id || not (lf_check_levity_poly flags) + || not (isTypeLevPoly id_ty)) $ + text "Levity-polymorphic binder:" <+> ppr id <+> dcolon <+> + parens (ppr id_ty <+> dcolon <+> ppr (typeKind id_ty)) -- Check that a join-id is a not-top-level let-binding ; when (isJoinId id) $ @@ -1378,45 +1398,52 @@ lintTypes dflags vars tys where (_warns, errs) = initL dflags defaultLintFlags vars linter linter = lintBinders LambdaBind vars $ \_ -> - mapM_ lintInTy tys + mapM_ lintType tys -lintInTy :: InType -> LintM (LintedType, LintedKind) +lintValueType :: Type -> LintM LintedType -- Types only, not kinds -- Check the type, and apply the substitution to it -- See Note [Linting type lets] -lintInTy ty +lintValueType ty = addLoc (InType ty) $ - do { ty' <- applySubstTy ty - ; k <- lintType ty' - ; addLoc (InKind ty' k) $ - lintKind k -- The kind returned by lintType is already - -- a LintedKind but we also want to check that - -- k :: *, which lintKind does - ; return (ty', k) } + do { ty' <- lintType ty + ; let sk = typeKind ty' + ; lintL (classifiesTypeWithValues sk) $ + hang (text "Ill-kinded type:" <+> ppr ty) + 2 (text "has kind:" <+> ppr sk) + ; return ty' } checkTyCon :: TyCon -> LintM () checkTyCon tc = checkL (not (isTcTyCon tc)) (text "Found TcTyCon:" <+> ppr tc) ------------------- -lintType :: OutType -> LintM LintedKind --- The returned Kind has itself been linted +lintType :: LintedType -> LintM LintedType -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] lintType (TyVarTy tv) - = do { checkL (isTyVar tv) (mkBadTyVarMsg tv) - ; tv' <- lintTyCoVarInScope tv - ; return (tyVarKind tv') } - -- We checked its kind when we added it to the envt + | not (isTyVar tv) + = failWithL (mkBadTyVarMsg tv) + + | otherwise + = do { subst <- getTCvSubst + ; case lookupTyVar subst tv of + Just linted_ty -> return linted_ty ; + Nothing -> -- lintTyBndr always extends the substitition + failWithL $ + hang (text "The type variable" <+> pprBndr LetBind tv) + 2 (text "is out of scope") + } lintType ty@(AppTy t1 t2) | TyConApp {} <- t1 = failWithL $ text "TyConApp to the left of AppTy:" <+> ppr ty | otherwise - = do { k1 <- lintType t1 - ; k2 <- lintType t2 - ; lint_ty_app ty k1 [(t2,k2)] } + = do { t1' <- lintType t1 + ; t2' <- lintType t2 + ; lint_ty_app ty (typeKind t1') [t2'] + ; return (AppTy t1' t2') } lintType ty@(TyConApp tc tys) | isTypeSynonymTyCon tc || isTypeFamilyTyCon tc @@ -1433,71 +1460,73 @@ lintType ty@(TyConApp tc tys) | otherwise -- Data types, data families, primitive types = do { checkTyCon tc - ; ks <- mapM lintType tys - ; lint_ty_app ty (tyConKind tc) (tys `zip` ks) } + ; tys' <- mapM lintType tys + ; lint_ty_app ty (tyConKind tc) tys' + ; return (TyConApp tc tys') } -- arrows can related *unlifted* kinds, so this has to be separate from -- a dependent forall. -lintType ty@(FunTy _ t1 t2) - = do { k1 <- lintType t1 - ; k2 <- lintType t2 - ; lintArrow (text "type or kind" <+> quotes (ppr ty)) k1 k2 } +lintType ty@(FunTy af t1 t2) + = do { t1' <- lintType t1 + ; t2' <- lintType t2 + ; lintArrow (text "type or kind" <+> quotes (ppr ty)) t1' t2' + ; return (FunTy af t1' t2') } -lintType t@(ForAllTy (Bndr tv _vis) ty) - -- forall over types - | isTyVar tv - = lintTyBndr tv $ \tv' -> - do { k <- lintType ty - ; checkValueKind k (text "the body of forall:" <+> ppr t) - ; case occCheckExpand [tv'] k of -- See Note [Stupid type synonyms] - Just k' -> return k' - Nothing -> failWithL (hang (text "Variable escape in forall:") - 2 (vcat [ text "type:" <+> ppr t - , text "kind:" <+> ppr k ])) - } +lintType (ForAllTy (Bndr tcv vis) body_ty) + = lintTyCoBndr tcv $ \tcv' -> + do { body_ty' <- lintType body_ty + ; lintForAllBody tcv' body_ty' + ; return (ForAllTy (Bndr tcv' vis) body_ty') } -lintType t@(ForAllTy (Bndr cv _vis) ty) - -- forall over coercions - = do { lintL (isCoVar cv) - (text "Non-Tyvar or Non-Covar bound in type:" <+> ppr t) - ; lintL (cv `elemVarSet` tyCoVarsOfType ty) - (text "Covar does not occur in the body:" <+> ppr t) - ; lintCoBndr cv $ \_ -> - do { k <- lintType ty - ; checkValueKind k (text "the body of forall:" <+> ppr t) - ; return liftedTypeKind - -- We don't check variable escape here. Namely, k could refer to cv' - }} - -lintType ty@(LitTy l) = lintTyLit l >> return (typeKind ty) +lintType ty@(LitTy l) + = do { lintTyLit l; return ty } lintType (CastTy ty co) - = do { k1 <- lintType ty - ; (k1', k2) <- lintStarCoercion co - ; ensureEqTys k1 k1' (mkCastTyErr ty co k1' k1) - ; return k2 } + = do { ty' <- lintType ty + ; co' <- lintStarCoercion co + ; let tyk = typeKind ty' + cok = coercionLKind co' + ; ensureEqTys tyk cok (mkCastTyErr ty co tyk cok) + ; return (CastTy ty' co') } lintType (CoercionTy co) - = do { (k1, k2, ty1, ty2, r) <- lintCoercion co - ; return $ mkHeteroCoercionType r k1 k2 ty1 ty2 } - -{- Note [Stupid type synonyms] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider (#14939) - type Alg cls ob = ob - f :: forall (cls :: * -> Constraint) (b :: Alg cls *). b - -Here 'cls' appears free in b's kind, which would usually be illegal -(because in (forall a. ty), ty's kind should not mention 'a'). But -#in this case (Alg cls *) = *, so all is well. Currently we allow -this, and make Lint expand synonyms where necessary to make it so. - -c.f. TcUnify.occCheckExpand and GHC.Core.Utils.coreAltsType which deal -with the same problem. A single systematic solution eludes me. --} + = do { co' <- lintCoercion co + ; return (CoercionTy co') } ----------------- -lintTySynFamApp :: Bool -> Type -> TyCon -> [Type] -> LintM LintedKind +lintForAllBody :: LintedTyCoVar -> LintedType -> LintM () +-- Do the checks for the body of a forall-type +lintForAllBody tcv body_ty + | isTyVar tcv + = do { checkValueType body_ty (text "the body of forall:" <+> ppr body_ty) + + -- Check for skolem escape + -- See Note [Phantom type variables in kinds] in GHC.Core.Type + ; let body_kind = typeKind body_ty + ; case occCheckExpand [tcv] body_kind of + Just {} -> return () + Nothing -> failWithL $ + hang (text "Variable escape in forall:") + 2 (vcat [ text "tyvar:" <+> ppr tcv + , text "type:" <+> ppr body_ty + , text "kind:" <+> ppr body_kind ]) + } + + | isCoVar tcv + = do { checkValueType body_ty (text "the body of forall:" <+> ppr body_ty) + + ; lintL (tcv `elemVarSet` tyCoVarsOfType body_ty) $ + text "Covar does not occur in the body:" <+> (ppr tcv $$ ppr body_ty) + + -- The kind of (forall cv. th) is liftedTypeKind, so no + -- need to check for skolem-escape, as we must do in the tyvar case + } + + | otherwise + = failWithL (text "Non-Tyvar or Non-Covar bound in type:" <+> ppr tcv) + +----------------- +lintTySynFamApp :: Bool -> InType -> TyCon -> [InType] -> LintM LintedType -- The TyCon is a type synonym or a type family (not a data family) -- See Note [Linting type synonym applications] -- c.f. TcValidity.check_syn_tc_app @@ -1511,58 +1540,54 @@ lintTySynFamApp report_unsat ty tc tys , let expanded_ty = mkAppTys (substTy (mkTvSubstPrs tenv) rhs) tys' = do { -- Kind-check the argument types, but without reporting -- un-saturated type families/synonyms - ks <- setReportUnsat False (mapM lintType tys) + tys' <- setReportUnsat False (mapM lintType tys) ; when report_unsat $ do { _ <- lintType expanded_ty ; return () } - ; lint_ty_app ty (tyConKind tc) (tys `zip` ks) } + ; lint_ty_app ty (tyConKind tc) tys' + ; return (TyConApp tc tys') } -- Otherwise this must be a type family | otherwise - = do { ks <- mapM lintType tys - ; lint_ty_app ty (tyConKind tc) (tys `zip` ks) } - ------------------ -lintKind :: OutKind -> LintM () --- If you edit this function, you may need to update the GHC formalism --- See Note [GHC Formalism] -lintKind k = do { sk <- lintType k - ; unless (classifiesTypeWithValues sk) - (addErrL (hang (text "Ill-kinded kind:" <+> ppr k) - 2 (text "has kind:" <+> ppr sk))) } + = do { tys' <- mapM lintType tys + ; lint_ty_app ty (tyConKind tc) tys' + ; return (TyConApp tc tys') } ----------------- -- Confirms that a type is really *, #, Constraint etc -checkValueKind :: OutKind -> SDoc -> LintM () -checkValueKind k doc - = lintL (classifiesTypeWithValues k) - (text "Non-*-like kind when *-like expected:" <+> ppr k $$ +checkValueType :: LintedType -> SDoc -> LintM () +checkValueType ty doc + = lintL (classifiesTypeWithValues kind) + (text "Non-*-like kind when *-like expected:" <+> ppr kind $$ text "when checking" <+> doc) + where + kind = typeKind ty ----------------- -lintArrow :: SDoc -> LintedKind -> LintedKind -> LintM LintedKind +lintArrow :: SDoc -> LintedType -> LintedType -> LintM () -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] -lintArrow what k1 k2 -- Eg lintArrow "type or kind `blah'" k1 k2 +lintArrow what t1 t2 -- Eg lintArrow "type or kind `blah'" k1 k2 -- or lintArrow "coercion `blah'" k1 k2 = do { unless (classifiesTypeWithValues k1) (addErrL (msg (text "argument") k1)) - ; unless (classifiesTypeWithValues k2) (addErrL (msg (text "result") k2)) - ; return liftedTypeKind } + ; unless (classifiesTypeWithValues k2) (addErrL (msg (text "result") k2)) } where + k1 = typeKind t1 + k2 = typeKind t2 msg ar k = vcat [ hang (text "Ill-kinded" <+> ar) 2 (text "in" <+> what) , what <+> text "kind:" <+> ppr k ] ----------------- -lint_ty_app :: Type -> LintedKind -> [(LintedType,LintedKind)] -> LintM LintedKind +lint_ty_app :: Type -> LintedKind -> [LintedType] -> LintM () lint_ty_app ty k tys = lint_app (text "type" <+> quotes (ppr ty)) k tys ---------------- -lint_co_app :: Coercion -> LintedKind -> [(LintedType,LintedKind)] -> LintM LintedKind +lint_co_app :: Coercion -> LintedKind -> [LintedType] -> LintM () lint_co_app ty k tys = lint_app (text "coercion" <+> quotes (ppr ty)) k tys @@ -1574,42 +1599,45 @@ lintTyLit (NumTyLit n) where msg = text "Negative type literal:" <+> integer n lintTyLit (StrTyLit _) = return () -lint_app :: SDoc -> LintedKind -> [(LintedType,LintedKind)] -> LintM Kind +lint_app :: SDoc -> LintedKind -> [LintedType] -> LintM () -- (lint_app d fun_kind arg_tys) -- We have an application (f arg_ty1 .. arg_tyn), -- where f :: fun_kind --- Takes care of linting the OutTypes -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] -lint_app doc kfn kas +lint_app doc kfn arg_tys = do { in_scope <- getInScope -- We need the in_scope set to satisfy the invariant in -- Note [The substitution invariant] in GHC.Core.TyCo.Subst - ; foldlM (go_app in_scope) kfn kas } + ; _ <- foldlM (go_app in_scope) kfn arg_tys + ; return () } where fail_msg extra = vcat [ hang (text "Kind application error in") 2 doc , nest 2 (text "Function kind =" <+> ppr kfn) - , nest 2 (text "Arg kinds =" <+> ppr kas) + , nest 2 (text "Arg types =" <+> ppr arg_tys) , extra ] - go_app in_scope kfn tka + go_app in_scope kfn ta | Just kfn' <- coreView kfn - = go_app in_scope kfn' tka + = go_app in_scope kfn' ta - go_app _ (FunTy _ kfa kfb) tka@(_,ka) - = do { unless (ka `eqType` kfa) $ - addErrL (fail_msg (text "Fun:" <+> (ppr kfa $$ ppr tka))) + go_app _ fun_kind@(FunTy _ kfa kfb) ta + = do { let ka = typeKind ta + ; unless (ka `eqType` kfa) $ + addErrL (fail_msg (text "Fun:" <+> (ppr fun_kind $$ ppr ta <+> dcolon <+> ppr ka))) ; return kfb } - go_app in_scope (ForAllTy (Bndr kv _vis) kfn) tka@(ta,ka) + go_app in_scope (ForAllTy (Bndr kv _vis) kfn) ta = do { let kv_kind = varType kv + ka = typeKind ta ; unless (ka `eqType` kv_kind) $ - addErrL (fail_msg (text "Forall:" <+> (ppr kv $$ ppr kv_kind $$ ppr tka))) + addErrL (fail_msg (text "Forall:" <+> (ppr kv $$ ppr kv_kind $$ + ppr ta <+> dcolon <+> ppr ka))) ; return $ substTy (extendTCvSubst (mkEmptyTCvSubst in_scope) kv ta) kfn } - go_app _ kfn ka - = failWithL (fail_msg (text "Not a fun:" <+> (ppr kfn $$ ppr ka))) + go_app _ kfn ta + = failWithL (fail_msg (text "Not a fun:" <+> (ppr kfn $$ ppr ta))) {- ********************************************************************* * * @@ -1617,7 +1645,7 @@ lint_app doc kfn kas * * ********************************************************************* -} -lintCoreRule :: OutVar -> OutType -> CoreRule -> LintM () +lintCoreRule :: OutVar -> LintedType -> CoreRule -> LintM () lintCoreRule _ _ (BuiltinRule {}) = return () -- Don't bother @@ -1710,68 +1738,94 @@ Note [Rules and join points] in OccurAnal for further discussion. ************************************************************************ -} -lintInCo :: InCoercion -> LintM (LintedKind, LintedKind, LintedType, LintedType, Role) --- Check the coercion, and apply the substitution to it --- See Note [Linting type lets] -lintInCo co - = addLoc (InCo co) $ - do { co' <- applySubstCo co - ; lintCoercion co' } +{- Note [Asymptotic efficiency] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When linting coercions (and types actually) we return a linted +(substituted) coercion. Then we often have to take the coercionKind of +that returned coercion. If we get long chains, that can be asymptotically +inefficient, notably in +* TransCo +* InstCo +* NthCo (cf #9233) +* LRCo + +But the code is simple. And this is only Lint. Let's wait to see if +the bad perf bites us in practice. + +A solution would be to return the kind and role of the coercion, +as well as the linted coercion. Or perhaps even *only* the kind and role, +which is what used to happen. But that proved tricky and error prone +(#17923), so now we return the coercion. +-} + -- lints a coercion, confirming that its lh kind and its rh kind are both * -- also ensures that the role is Nominal -lintStarCoercion :: OutCoercion -> LintM (LintedType, LintedType) +lintStarCoercion :: InCoercion -> LintM LintedCoercion lintStarCoercion g - = do { (k1, k2, t1, t2, r) <- lintCoercion g - ; checkValueKind k1 (text "the kind of the left type in" <+> ppr g) - ; checkValueKind k2 (text "the kind of the right type in" <+> ppr g) - ; lintRole g Nominal r - ; return (t1, t2) } - -lintCoercion :: OutCoercion -> LintM (LintedKind, LintedKind, LintedType, LintedType, Role) --- Check the kind of a coercion term, returning the kind --- Post-condition: the returned OutTypes are lint-free --- --- If lintCoercion co = (k1, k2, s1, s2, r) --- then co :: s1 ~r s2 --- s1 :: k1 --- s2 :: k2 - + = do { g' <- lintCoercion g + ; let Pair t1 t2 = coercionKind g' + ; checkValueType t1 (text "the kind of the left type in" <+> ppr g) + ; checkValueType t2 (text "the kind of the right type in" <+> ppr g) + ; lintRole g Nominal (coercionRole g) + ; return g' } + +lintCoercion :: InCoercion -> LintM LintedCoercion -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] + +lintCoercion (CoVarCo cv) + | not (isCoVar cv) + = failWithL (hang (text "Bad CoVarCo:" <+> ppr cv) + 2 (text "With offending type:" <+> ppr (varType cv))) + + | otherwise + = do { subst <- getTCvSubst + ; case lookupCoVar subst cv of + Just linted_co -> return linted_co ; + Nothing -> -- lintCoBndr always extends the substitition + failWithL $ + hang (text "The coercion variable" <+> pprBndr LetBind cv) + 2 (text "is out of scope") + } + + lintCoercion (Refl ty) - = do { k <- lintType ty - ; return (k, k, ty, ty, Nominal) } + = do { ty' <- lintType ty + ; return (Refl ty') } lintCoercion (GRefl r ty MRefl) - = do { k <- lintType ty - ; return (k, k, ty, ty, r) } + = do { ty' <- lintType ty + ; return (GRefl r ty' MRefl) } lintCoercion (GRefl r ty (MCo co)) - = do { k <- lintType ty - ; (_, _, k1, k2, r') <- lintCoercion co - ; ensureEqTys k k1 - (hang (text "GRefl coercion kind mis-match:" <+> ppr co) - 2 (vcat [ppr ty, ppr k, ppr k1])) - ; lintRole co Nominal r' - ; return (k1, k2, ty, mkCastTy ty co, r) } + = do { ty' <- lintType ty + ; co' <- lintCoercion co + ; let tk = typeKind ty' + tl = coercionLKind co' + ; ensureEqTys tk tl $ + hang (text "GRefl coercion kind mis-match:" <+> ppr co) + 2 (vcat [ppr ty', ppr tk, ppr tl]) + ; lintRole co' Nominal (coercionRole co') + ; return (GRefl r ty' (MCo co')) } lintCoercion co@(TyConAppCo r tc cos) | tc `hasKey` funTyConKey , [_rep1,_rep2,_co1,_co2] <- cos - = do { failWithL (text "Saturated TyConAppCo (->):" <+> ppr co) - } -- All saturated TyConAppCos should be FunCos + = failWithL (text "Saturated TyConAppCo (->):" <+> ppr co) + -- All saturated TyConAppCos should be FunCos | Just {} <- synTyConDefn_maybe tc = failWithL (text "Synonym in TyConAppCo:" <+> ppr co) | otherwise = do { checkTyCon tc - ; (k's, ks, ss, ts, rs) <- mapAndUnzip5M lintCoercion cos - ; k' <- lint_co_app co (tyConKind tc) (ss `zip` k's) - ; k <- lint_co_app co (tyConKind tc) (ts `zip` ks) - ; _ <- zipWith3M lintRole cos (tyConRolesX r tc) rs - ; return (k', k, mkTyConApp tc ss, mkTyConApp tc ts, r) } + ; cos' <- mapM lintCoercion cos + ; let (co_kinds, co_roles) = unzip (map coercionKindRole cos') + ; lint_co_app co (tyConKind tc) (map pFst co_kinds) + ; lint_co_app co (tyConKind tc) (map pSnd co_kinds) + ; zipWithM_ (lintRole co) (tyConRolesX r tc) co_roles + ; return (TyConAppCo r tc cos') } lintCoercion co@(AppCo co1 co2) | TyConAppCo {} <- co1 @@ -1779,111 +1833,66 @@ lintCoercion co@(AppCo co1 co2) | Just (TyConApp {}, _) <- isReflCo_maybe co1 = failWithL (text "Refl (TyConApp ...) to the left of AppCo:" <+> ppr co) | otherwise - = do { (k1, k2, s1, s2, r1) <- lintCoercion co1 - ; (k'1, k'2, t1, t2, r2) <- lintCoercion co2 - ; k3 <- lint_co_app co k1 [(t1,k'1)] - ; k4 <- lint_co_app co k2 [(t2,k'2)] + = do { co1' <- lintCoercion co1 + ; co2' <- lintCoercion co2 + ; let (Pair lk1 rk1, r1) = coercionKindRole co1' + (Pair lk2 rk2, r2) = coercionKindRole co2' + ; lint_co_app co (typeKind lk1) [lk2] + ; lint_co_app co (typeKind rk1) [rk2] + ; if r1 == Phantom then lintL (r2 == Phantom || r2 == Nominal) (text "Second argument in AppCo cannot be R:" $$ ppr co) else lintRole co Nominal r2 - ; return (k3, k4, mkAppTy s1 t1, mkAppTy s2 t2, r1) } + + ; return (AppCo co1' co2') } ---------- -lintCoercion (ForAllCo tv1 kind_co co) - -- forall over types - | isTyVar tv1 - = do { (_, k2) <- lintStarCoercion kind_co - ; let tv2 = setTyVarKind tv1 k2 - ; addInScopeTyCoVar tv1 $ - do { - ; (k3, k4, t1, t2, r) <- lintCoercion co - ; in_scope <- getInScope - ; let tyl = mkInvForAllTy tv1 t1 - subst = mkTvSubst in_scope $ - -- We need both the free vars of the `t2` and the - -- free vars of the range of the substitution in - -- scope. All the free vars of `t2` and `kind_co` should - -- already be in `in_scope`, because they've been - -- linted and `tv2` has the same unique as `tv1`. - -- See Note [The substitution invariant] in GHC.Core.TyCo.Subst. - unitVarEnv tv1 (TyVarTy tv2 `mkCastTy` mkSymCo kind_co) - tyr = mkInvForAllTy tv2 $ - substTy subst t2 - ; return (k3, k4, tyl, tyr, r) } } - -lintCoercion (ForAllCo cv1 kind_co co) - -- forall over coercions - = ASSERT( isCoVar cv1 ) - do { lintL (almostDevoidCoVarOfCo cv1 co) +lintCoercion co@(ForAllCo tcv1 kind_co body_co) + | not (isTyCoVar tcv1) + = failWithL (text "Non tyco binder in ForAllCo:" <+> ppr co) + | otherwise + = do { kind_co' <- lintStarCoercion kind_co + ; lintTyCoBndr tcv1 $ \tcv1' -> + do { body_co' <- lintCoercion body_co + ; ensureEqTys (varType tcv1') (coercionLKind kind_co') $ + text "Kind mis-match in ForallCo" <+> ppr co + + ; lintForAllBody tcv1' (coercionLKind body_co') + + ; when (isCoVar tcv1) $ + lintL (almostDevoidCoVarOfCo tcv1 body_co) (text "Covar can only appear in Refl and GRefl: " <+> ppr co) - ; (_, k2) <- lintStarCoercion kind_co - ; let cv2 = setVarType cv1 k2 - ; addInScopeTyCoVar cv1 $ - do { - ; (k3, k4, t1, t2, r) <- lintCoercion co - ; checkValueKind k3 (text "the body of a ForAllCo over covar:" <+> ppr co) - ; checkValueKind k4 (text "the body of a ForAllCo over covar:" <+> ppr co) - -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep - ; in_scope <- getInScope - ; let tyl = mkTyCoInvForAllTy cv1 t1 - r2 = coVarRole cv1 - kind_co' = downgradeRole r2 Nominal kind_co - eta1 = mkNthCo r2 2 kind_co' - eta2 = mkNthCo r2 3 kind_co' - subst = mkCvSubst in_scope $ - -- We need both the free vars of the `t2` and the - -- free vars of the range of the substitution in - -- scope. All the free vars of `t2` and `kind_co` should - -- already be in `in_scope`, because they've been - -- linted and `cv2` has the same unique as `cv1`. - -- See Note [The substitution invariant] in GHC.Core.TyCo.Subst. - unitVarEnv cv1 (eta1 `mkTransCo` (mkCoVarCo cv2) - `mkTransCo` (mkSymCo eta2)) - tyr = mkTyCoInvForAllTy cv2 $ - substTy subst t2 - ; return (liftedTypeKind, liftedTypeKind, tyl, tyr, r) } } - -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep + -- See "last wrinkle" in GHC.Core.Coercion + -- Note [Unused coercion variable in ForAllCo] -lintCoercion co@(FunCo r co1 co2) - = do { (k1,k'1,s1,t1,r1) <- lintCoercion co1 - ; (k2,k'2,s2,t2,r2) <- lintCoercion co2 - ; k <- lintArrow (text "coercion" <+> quotes (ppr co)) k1 k2 - ; k' <- lintArrow (text "coercion" <+> quotes (ppr co)) k'1 k'2 - ; lintRole co1 r r1 - ; lintRole co2 r r2 - ; return (k, k', mkVisFunTy s1 s2, mkVisFunTy t1 t2, r) } + ; return (ForAllCo tcv1' kind_co' body_co') } } -lintCoercion (CoVarCo cv) - | not (isCoVar cv) - = failWithL (hang (text "Bad CoVarCo:" <+> ppr cv) - 2 (text "With offending type:" <+> ppr (varType cv))) - | otherwise - = do { cv' <- lintTyCoVarInScope cv - ; lintUnliftedCoVar cv' - ; return $ coVarKindsTypesRole cv' } +lintCoercion co@(FunCo r co1 co2) + = do { co1' <- lintCoercion co1 + ; co2' <- lintCoercion co2 + ; let Pair lt1 rt1 = coercionKind co1 + Pair lt2 rt2 = coercionKind co2 + ; lintArrow (text "coercion" <+> quotes (ppr co)) lt1 lt2 + ; lintArrow (text "coercion" <+> quotes (ppr co)) rt1 rt2 + ; lintRole co1 r (coercionRole co1) + ; lintRole co2 r (coercionRole co2) + ; return (FunCo r co1' co2') } -- See Note [Bad unsafe coercion] lintCoercion co@(UnivCo prov r ty1 ty2) - = do { k1 <- lintType ty1 - ; k2 <- lintType ty2 - ; case prov of - PhantomProv kco -> do { lintRole co Phantom r - ; check_kinds kco k1 k2 } - - ProofIrrelProv kco -> do { lintL (isCoercionTy ty1) $ - mkBadProofIrrelMsg ty1 co - ; lintL (isCoercionTy ty2) $ - mkBadProofIrrelMsg ty2 co - ; check_kinds kco k1 k2 } - - PluginProv _ -> return () -- no extra checks + = do { ty1' <- lintType ty1 + ; ty2' <- lintType ty2 + ; let k1 = typeKind ty1' + k2 = typeKind ty2' + ; prov' <- lint_prov k1 k2 prov ; when (r /= Phantom && classifiesTypeWithValues k1 && classifiesTypeWithValues k2) (checkTypes ty1 ty2) - ; return (k1, k2, ty1, ty2, r) } + + ; return (UnivCo prov' r ty1' ty2') } where report s = hang (text $ "Unsafe coercion: " ++ s) 2 (vcat [ text "From:" <+> ppr ty1 @@ -1926,39 +1935,53 @@ lintCoercion co@(UnivCo prov r ty1 ty2) _ -> return () } - check_kinds kco k1 k2 = do { (k1', k2') <- lintStarCoercion kco - ; ensureEqTys k1 k1' (mkBadUnivCoMsg CLeft co) - ; ensureEqTys k2 k2' (mkBadUnivCoMsg CRight co) } + lint_prov k1 k2 (PhantomProv kco) + = do { kco' <- lintStarCoercion kco + ; lintRole co Phantom r + ; check_kinds kco' k1 k2 + ; return (PhantomProv kco') } + + lint_prov k1 k2 (ProofIrrelProv kco) + = do { lintL (isCoercionTy ty1) (mkBadProofIrrelMsg ty1 co) + ; lintL (isCoercionTy ty2) (mkBadProofIrrelMsg ty2 co) + ; kco' <- lintStarCoercion kco + ; check_kinds kco k1 k2 + ; return (ProofIrrelProv kco') } + + lint_prov _ _ prov@(PluginProv _) = return prov + + check_kinds kco k1 k2 + = do { let Pair k1' k2' = coercionKind kco + ; ensureEqTys k1 k1' (mkBadUnivCoMsg CLeft co) + ; ensureEqTys k2 k2' (mkBadUnivCoMsg CRight co) } lintCoercion (SymCo co) - = do { (k1, k2, ty1, ty2, r) <- lintCoercion co - ; return (k2, k1, ty2, ty1, r) } + = do { co' <- lintCoercion co + ; return (SymCo co') } lintCoercion co@(TransCo co1 co2) - = do { (k1a, _k1b, ty1a, ty1b, r1) <- lintCoercion co1 - ; (_k2a, k2b, ty2a, ty2b, r2) <- lintCoercion co2 + = do { co1' <- lintCoercion co1 + ; co2' <- lintCoercion co2 + ; let ty1b = coercionRKind co1' + ty2a = coercionLKind co2' ; ensureEqTys ty1b ty2a (hang (text "Trans coercion mis-match:" <+> ppr co) - 2 (vcat [ppr ty1a, ppr ty1b, ppr ty2a, ppr ty2b])) - ; lintRole co r1 r2 - ; return (k1a, k2b, ty1a, ty2b, r1) } + 2 (vcat [ppr (coercionKind co1'), ppr (coercionKind co2')])) + ; lintRole co (coercionRole co1) (coercionRole co2) + ; return (TransCo co1' co2') } lintCoercion the_co@(NthCo r0 n co) - = do { (_, _, s, t, r) <- lintCoercion co + = do { co' <- lintCoercion co + ; let (Pair s t, r) = coercionKindRole co' ; case (splitForAllTy_maybe s, splitForAllTy_maybe t) of - { (Just (tcv_s, _ty_s), Just (tcv_t, _ty_t)) + { (Just _, Just _) -- works for both tyvar and covar | n == 0 , (isForAllTy_ty s && isForAllTy_ty t) || (isForAllTy_co s && isForAllTy_co t) -> do { lintRole the_co Nominal r0 - ; return (ks, kt, ts, tt, r0) } - where - ts = varType tcv_s - tt = varType tcv_t - ks = typeKind ts - kt = typeKind tt + ; return (NthCo r0 n co') } ; _ -> case (splitTyConApp_maybe s, splitTyConApp_maybe t) of { (Just (tc_s, tys_s), Just (tc_t, tys_t)) @@ -1968,62 +1991,51 @@ lintCoercion the_co@(NthCo r0 n co) , tys_s `equalLength` tys_t , tys_s `lengthExceeds` n -> do { lintRole the_co tr r0 - ; return (ks, kt, ts, tt, r0) } - where - ts = getNth tys_s n - tt = getNth tys_t n - tr = nthRole r tc_s n - ks = typeKind ts - kt = typeKind tt + ; return (NthCo r0 n co') } + where + tr = nthRole r tc_s n ; _ -> failWithL (hang (text "Bad getNth:") 2 (ppr the_co $$ ppr s $$ ppr t)) }}} lintCoercion the_co@(LRCo lr co) - = do { (_,_,s,t,r) <- lintCoercion co + = do { co' <- lintCoercion co + ; let Pair s t = coercionKind co' + r = coercionRole co' ; lintRole co Nominal r ; case (splitAppTy_maybe s, splitAppTy_maybe t) of - (Just s_pr, Just t_pr) - -> return (ks_pick, kt_pick, s_pick, t_pick, Nominal) - where - s_pick = pickLR lr s_pr - t_pick = pickLR lr t_pr - ks_pick = typeKind s_pick - kt_pick = typeKind t_pick - + (Just _, Just _) -> return (LRCo lr co') _ -> failWithL (hang (text "Bad LRCo:") 2 (ppr the_co $$ ppr s $$ ppr t)) } lintCoercion (InstCo co arg) - = do { (k3, k4, t1',t2', r) <- lintCoercion co - ; (k1',k2',s1,s2, r') <- lintCoercion arg - ; lintRole arg Nominal r' - ; in_scope <- getInScope - ; case (splitForAllTy_ty_maybe t1', splitForAllTy_ty_maybe t2') of + = do { co' <- lintCoercion co + ; arg' <- lintCoercion arg + ; let Pair t1' t2' = coercionKind co' + Pair s1 s2 = coercionKind arg + + ; lintRole arg Nominal (coercionRole arg') + + ; case (splitForAllTy_ty_maybe t1', splitForAllTy_ty_maybe t2') of -- forall over tvar - { (Just (tv1,t1), Just (tv2,t2)) - | k1' `eqType` tyVarKind tv1 - , k2' `eqType` tyVarKind tv2 - -> return (k3, k4, - substTyWithInScope in_scope [tv1] [s1] t1, - substTyWithInScope in_scope [tv2] [s2] t2, r) + { (Just (tv1,_), Just (tv2,_)) + | typeKind s1 `eqType` tyVarKind tv1 + , typeKind s2 `eqType` tyVarKind tv2 + -> return (InstCo co' arg') | otherwise -> failWithL (text "Kind mis-match in inst coercion") + ; _ -> case (splitForAllTy_co_maybe t1', splitForAllTy_co_maybe t2') of -- forall over covar - { (Just (cv1, t1), Just (cv2, t2)) - | k1' `eqType` varType cv1 - , k2' `eqType` varType cv2 - , CoercionTy s1' <- s1 - , CoercionTy s2' <- s2 - -> do { return $ - (liftedTypeKind, liftedTypeKind - -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep - , substTy (mkCvSubst in_scope $ unitVarEnv cv1 s1') t1 - , substTy (mkCvSubst in_scope $ unitVarEnv cv2 s2') t2 - , r) } + { (Just (cv1, _), Just (cv2, _)) + | typeKind s1 `eqType` varType cv1 + , typeKind s2 `eqType` varType cv2 + , CoercionTy _ <- s1 + , CoercionTy _ <- s2 + -> return (InstCo co' arg') | otherwise -> failWithL (text "Kind mis-match in inst coercion") + ; _ -> failWithL (text "Bad argument of inst") }}} lintCoercion co@(AxiomInstCo con ind cos) @@ -2031,73 +2043,69 @@ lintCoercion co@(AxiomInstCo con ind cos) (bad_ax (text "index out of range")) ; let CoAxBranch { cab_tvs = ktvs , cab_cvs = cvs - , cab_roles = roles - , cab_lhs = lhs - , cab_rhs = rhs } = coAxiomNthBranch con ind + , cab_roles = roles } = coAxiomNthBranch con ind ; unless (cos `equalLength` (ktvs ++ cvs)) $ bad_ax (text "lengths") + ; cos' <- mapM lintCoercion cos ; subst <- getTCvSubst ; let empty_subst = zapTCvSubst subst - ; (subst_l, subst_r) <- foldlM check_ki - (empty_subst, empty_subst) - (zip3 (ktvs ++ cvs) roles cos) - ; let lhs' = substTys subst_l lhs - rhs' = substTy subst_r rhs - fam_tc = coAxiomTyCon con + ; _ <- foldlM check_ki (empty_subst, empty_subst) + (zip3 (ktvs ++ cvs) roles cos') + ; let fam_tc = coAxiomTyCon con ; case checkAxInstCo co of Just bad_branch -> bad_ax $ text "inconsistent with" <+> pprCoAxBranch fam_tc bad_branch Nothing -> return () - ; let s2 = mkTyConApp fam_tc lhs' - ; return (typeKind s2, typeKind rhs', s2, rhs', coAxiomRole con) } + ; return (AxiomInstCo con ind cos') } where bad_ax what = addErrL (hang (text "Bad axiom application" <+> parens what) 2 (ppr co)) - check_ki (subst_l, subst_r) (ktv, role, arg) - = do { (k', k'', s', t', r) <- lintCoercion arg - ; lintRole arg role r + check_ki (subst_l, subst_r) (ktv, role, arg') + = do { let Pair s' t' = coercionKind arg' + sk' = typeKind s' + tk' = typeKind t' + ; lintRole arg' role (coercionRole arg') ; let ktv_kind_l = substTy subst_l (tyVarKind ktv) ktv_kind_r = substTy subst_r (tyVarKind ktv) - ; unless (k' `eqType` ktv_kind_l) - (bad_ax (text "check_ki1" <+> vcat [ ppr co, ppr k', ppr ktv, ppr ktv_kind_l ] )) - ; unless (k'' `eqType` ktv_kind_r) - (bad_ax (text "check_ki2" <+> vcat [ ppr co, ppr k'', ppr ktv, ppr ktv_kind_r ] )) + ; unless (sk' `eqType` ktv_kind_l) + (bad_ax (text "check_ki1" <+> vcat [ ppr co, ppr sk', ppr ktv, ppr ktv_kind_l ] )) + ; unless (tk' `eqType` ktv_kind_r) + (bad_ax (text "check_ki2" <+> vcat [ ppr co, ppr tk', ppr ktv, ppr ktv_kind_r ] )) ; return (extendTCvSubst subst_l ktv s', extendTCvSubst subst_r ktv t') } lintCoercion (KindCo co) - = do { (k1, k2, _, _, _) <- lintCoercion co - ; return (liftedTypeKind, liftedTypeKind, k1, k2, Nominal) } + = do { co' <- lintCoercion co + ; return (KindCo co') } lintCoercion (SubCo co') - = do { (k1,k2,s,t,r) <- lintCoercion co' - ; lintRole co' Nominal r - ; return (k1,k2,s,t,Representational) } - -lintCoercion this@(AxiomRuleCo co cs) - = do { eqs <- mapM lintCoercion cs - ; lintRoles 0 (coaxrAsmpRoles co) eqs - ; case coaxrProves co [ Pair l r | (_,_,l,r,_) <- eqs ] of + = do { co' <- lintCoercion co' + ; lintRole co' Nominal (coercionRole co') + ; return (SubCo co') } + +lintCoercion this@(AxiomRuleCo ax cos) + = do { cos' <- mapM lintCoercion cos + ; lint_roles 0 (coaxrAsmpRoles ax) cos' + ; case coaxrProves ax (map coercionKind cos') of Nothing -> err "Malformed use of AxiomRuleCo" [ ppr this ] - Just (Pair l r) -> - return (typeKind l, typeKind r, l, r, coaxrRole co) } + Just _ -> return (AxiomRuleCo ax cos') } where err m xs = failWithL $ - hang (text m) 2 $ vcat (text "Rule:" <+> ppr (coaxrName co) : xs) + hang (text m) 2 $ vcat (text "Rule:" <+> ppr (coaxrName ax) : xs) - lintRoles n (e : es) ((_,_,_,_,r) : rs) - | e == r = lintRoles (n+1) es rs + lint_roles n (e : es) (co : cos) + | e == coercionRole co = lint_roles (n+1) es cos | otherwise = err "Argument roles mismatch" [ text "In argument:" <+> int (n+1) , text "Expected:" <+> ppr e - , text "Found:" <+> ppr r ] - lintRoles _ [] [] = return () - lintRoles n [] rs = err "Too many coercion arguments" + , text "Found:" <+> ppr (coercionRole co) ] + lint_roles _ [] [] = return () + lint_roles n [] rs = err "Too many coercion arguments" [ text "Expected:" <+> int n , text "Provided:" <+> int (n + length rs) ] - lintRoles n es [] = err "Not enough coercion arguments" + lint_roles n es [] = err "Not enough coercion arguments" [ text "Expected:" <+> int (n + length es) , text "Provided:" <+> int n ] @@ -2106,13 +2114,6 @@ lintCoercion (HoleCo h) ; lintCoercion (CoVarCo (coHoleCoVar h)) } ----------- -lintUnliftedCoVar :: CoVar -> LintM () -lintUnliftedCoVar cv - = when (not (isUnliftedType (coVarKind cv))) $ - failWithL (text "Bad lifted equality:" <+> ppr cv - <+> dcolon <+> ppr (coVarKind cv)) - {- ************************************************************************ * * @@ -2129,12 +2130,13 @@ data LintEnv , le_subst :: TCvSubst -- Current TyCo substitution -- See Note [Linting type lets] - -- /Only/ substitutes for type variables; - -- but might clone CoVars - -- We also use le_subst to keep track of - -- in-scope TyVars and CoVars + -- /Only/ substitutes for type variables; + -- but might clone CoVars + -- We also use le_subst to keep track of + -- in-scope TyVars and CoVars (but not Ids) + -- Range of the TCvSubst is LintedType/LintedCo - , le_ids :: IdSet -- In-scope Ids + , le_ids :: IdSet -- In-scope Ids; all Linted , le_joins :: IdSet -- Join points in scope that are valid -- A subset of the InScopeSet in le_subst -- See Note [Join points] @@ -2266,6 +2268,7 @@ instance HasDynFlags LintM where data LintLocInfo = RhsOf Id -- The variable bound + | OccOf Id -- Occurrence of id | LambdaBodyOf Id -- The lambda-binder | UnfoldingOf Id -- Unfolding of a binder | BodyOfLetRec [Id] -- One of the binders @@ -2278,7 +2281,6 @@ data LintLocInfo | ImportedUnfolding SrcLoc -- Some imported unfolding (ToDo: say which) | TopLevelBindings | InType Type -- Inside a type - | InKind Type Kind -- Inside a kind | InCo Coercion -- Inside a coercion initL :: DynFlags -> LintFlags -> [Var] @@ -2341,7 +2343,7 @@ addWarnL msg = LintM $ \ env (warns,errs) -> addMsg :: Bool -> LintEnv -> Bag MsgDoc -> MsgDoc -> Bag MsgDoc addMsg is_error env msgs msg - = ASSERT( notNull loc_msgs ) + = ASSERT2( notNull loc_msgs, msg ) msgs `snocBag` mk_msg msg where loc_msgs :: [(SrcLoc, SDoc)] -- Innermost first @@ -2373,16 +2375,15 @@ inCasePat = LintM $ \ env errs -> (Just (is_case_pat env), errs) is_case_pat (LE { le_loc = CasePat {} : _ }) = True is_case_pat _other = False -addInScopeTyCoVar :: Var -> LintM a -> LintM a -addInScopeTyCoVar var m - = LintM $ \ env errs -> - unLintM m (env { le_subst = extendTCvInScope (le_subst env) var }) errs - addInScopeId :: Id -> LintM a -> LintM a addInScopeId id m - = LintM $ \ env errs -> - unLintM m (env { le_ids = extendVarSet (le_ids env) id - , le_joins = delVarSet (le_joins env) id }) errs + = LintM $ \ env@(LE { le_ids = id_set, le_joins = join_set }) errs -> + unLintM m (env { le_ids = extendVarSet id_set id + , le_joins = add_joins join_set }) errs + where + add_joins join_set + | isJoinId id = extendVarSet join_set id -- Overwrite with new arity + | otherwise = delVarSet join_set id -- Remove any existing binding getInScopeIds :: LintM IdSet getInScopeIds = LintM (\env errs -> (Just (le_ids env), errs)) @@ -2404,13 +2405,6 @@ markAllJoinsBadIf :: Bool -> LintM a -> LintM a markAllJoinsBadIf True m = markAllJoinsBad m markAllJoinsBadIf False m = m -addGoodJoins :: [Var] -> LintM a -> LintM a -addGoodJoins vars thing_inside - = LintM $ \ env errs -> unLintM thing_inside (add_joins env) errs - where - add_joins env = env { le_joins = le_joins env `extendVarSetList` join_ids } - join_ids = filter isJoinId vars - getValidJoins :: LintM IdSet getValidJoins = LintM (\ env errs -> (Just (le_joins env), errs)) @@ -2420,12 +2414,6 @@ getTCvSubst = LintM (\ env errs -> (Just (le_subst env), errs)) getInScope :: LintM InScopeSet getInScope = LintM (\ env errs -> (Just (getTCvInScope $ le_subst env), errs)) -applySubstTy :: InType -> LintM OutType -applySubstTy ty = do { subst <- getTCvSubst; return (substTy subst ty) } - -applySubstCo :: InCoercion -> LintM OutCoercion -applySubstCo co = do { subst <- getTCvSubst; return (substCo subst co) } - lookupIdInScope :: Id -> LintM Id lookupIdInScope id_occ = do { in_scope_ids <- getInScopeIds @@ -2461,16 +2449,7 @@ lookupJoinId id Just id' -> return (isJoinId_maybe id') Nothing -> return Nothing } -lintTyCoVarInScope :: TyCoVar -> LintM TyCoVar -lintTyCoVarInScope var - = do { subst <- getTCvSubst - ; case lookupInScope (getTCvInScope subst) var of - Just var' -> return var' - Nothing -> failWithL $ - hang (text "The TyCo variable" <+> pprBndr LetBind var) - 2 (text "is out of scope") } - -ensureEqTys :: OutType -> OutType -> MsgDoc -> LintM () +ensureEqTys :: LintedType -> LintedType -> MsgDoc -> LintM () -- check ty2 is subtype of ty1 (ie, has same structure but usage -- annotations need only be consistent, not equal) -- Assumes ty1,ty2 are have already had the substitution applied @@ -2500,6 +2479,9 @@ dumpLoc :: LintLocInfo -> (SrcLoc, SDoc) dumpLoc (RhsOf v) = (getSrcLoc v, text "In the RHS of" <+> pp_binders [v]) +dumpLoc (OccOf v) + = (getSrcLoc v, text "In an occurrence of" <+> pp_binder v) + dumpLoc (LambdaBodyOf b) = (getSrcLoc b, text "In the body of lambda with binder" <+> pp_binder b) @@ -2534,8 +2516,6 @@ dumpLoc TopLevelBindings = (noSrcLoc, Outputable.empty) dumpLoc (InType ty) = (noSrcLoc, text "In the type" <+> quotes (ppr ty)) -dumpLoc (InKind ty ki) - = (noSrcLoc, text "In the kind of" <+> parens (ppr ty <+> dcolon <+> ppr ki)) dumpLoc (InCo co) = (noSrcLoc, text "In the coercion" <+> quotes (ppr co)) @@ -2780,7 +2760,7 @@ mkJoinBndrOccMismatchMsg bndr join_arity_bndr join_arity_occ , text "Arity at binding site:" <+> ppr join_arity_bndr , text "Arity at occurrence: " <+> ppr join_arity_occ ] -mkBndrOccTypeMismatchMsg :: Var -> Var -> OutType -> OutType -> SDoc +mkBndrOccTypeMismatchMsg :: Var -> Var -> LintedType -> LintedType -> SDoc mkBndrOccTypeMismatchMsg bndr var bndr_ty var_ty = vcat [ text "Mismatch in type between binder and occurrence" , text "Binder:" <+> ppr bndr <+> dcolon <+> ppr bndr_ty ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -2447,7 +2447,7 @@ normally it would make no sense to have forall r. (ty :: K r) because the kind of the forall would escape the binding of 'r'. But in this case it's fine because (K r) exapands -to Type, so we expliclity /permit/ the type +to Type, so we explicitly /permit/ the type forall r. T r To accommodate such a type, in typeKind (forall a.ty) we use @@ -2455,8 +2455,13 @@ occCheckExpand to expand any type synonyms in the kind of 'ty' to eliminate 'a'. See kinding rule (FORALL) in Note [Kinding rules for types] -And in TcValidity.checkEscapingKind, we use also use -occCheckExpand, for the same reason. +See also + * TcUnify.occCheckExpand + * GHC.Core.Utils.coreAltsType + * TcValidity.checkEscapingKind +all of which grapple with with the same problem. + +See #14939. -} ----------------------------- ===================================== testsuite/tests/indexed-types/should_compile/T17923.hs ===================================== @@ -0,0 +1,44 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# OPTIONS_GHC -Wall #-} +module Bug where + +import Data.Kind + +-- type SingFunction2 f = forall t1 t2. Sing t1 -> Sing t2 -> Sing (f `Apply` t1 `Apply` t2) +type SingFunction2 f = forall t1. Sing t1 -> forall t2. Sing t2 -> Sing (f `Apply` t1 `Apply` t2) +singFun2 :: forall f. SingFunction2 f -> Sing f +singFun2 f = SLambda (\x -> SLambda (f x)) + +type family Sing :: k -> Type +data TyFun :: Type -> Type -> Type +type a ~> b = TyFun a b -> Type +infixr 0 ~> + +type family Apply (f :: a ~> b) (x :: a) :: b +data Sym4 a +data Sym3 a + +type instance Apply Sym3 _ = Sym4 + +newtype SLambda (f :: k1 ~> k2) = + SLambda { applySing :: forall t. Sing t -> Sing (Apply f t) } +type instance Sing = SLambda + +und :: a +und = undefined + +data E +data ShowCharSym0 :: E ~> E ~> E + +sShow_tuple :: SLambda Sym4 +sShow_tuple + = applySing (singFun2 @Sym3 und) + (und (singFun2 @Sym3 + (und (applySing (singFun2 @Sym3 und) + (applySing (singFun2 @ShowCharSym0 und) und))))) ===================================== testsuite/tests/indexed-types/should_compile/all.T ===================================== @@ -294,3 +294,4 @@ test('T16828', normal, compile, ['']) test('T17008b', normal, compile, ['']) test('T17056', normal, compile, ['']) test('T17405', normal, multimod_compile, ['T17405c', '-v0']) +test('T17923', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8ae203c70bbaec128264fa4a25e4af3b1685843a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8ae203c70bbaec128264fa4a25e4af3b1685843a You're receiving 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 Mar 25 17:51:18 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Wed, 25 Mar 2020 13:51:18 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/require-8.8-or-later Message-ID: <5e7b9a1669ad4_6167e0e2c945670c@gitlab.haskell.org.mail> Ryan Scott pushed new branch wip/require-8.8-or-later at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/require-8.8-or-later You're receiving 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 Mar 25 18:45:15 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 25 Mar 2020 14:45:15 -0400 Subject: [Git][ghc/ghc][master] Use export list of Main module in function TcRnDriver.hs:check_main (Fix #16453) Message-ID: <5e7ba6bb9e81c_61673f81cd4b0f585810e6@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 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. - - - - - 21 changed files: - compiler/typecheck/TcExpr.hs - compiler/typecheck/TcRnDriver.hs - + testsuite/tests/typecheck/should_fail/T16453E1.hs - + testsuite/tests/typecheck/should_fail/T16453E1.stderr - + testsuite/tests/typecheck/should_fail/T16453E2.hs - + testsuite/tests/typecheck/should_fail/T16453E2.stderr - + testsuite/tests/typecheck/should_fail/T16453S.hs - + testsuite/tests/typecheck/should_fail/T16453T.hs - testsuite/tests/typecheck/should_fail/all.T - + testsuite/tests/typecheck/should_run/T16453M0.hs - + testsuite/tests/typecheck/should_run/T16453M0.stdout - + testsuite/tests/typecheck/should_run/T16453M1.hs - + testsuite/tests/typecheck/should_run/T16453M1.stdout - + testsuite/tests/typecheck/should_run/T16453M2.hs - + testsuite/tests/typecheck/should_run/T16453M2.stdout - + testsuite/tests/typecheck/should_run/T16453M3.hs - + testsuite/tests/typecheck/should_run/T16453M3.stdout - + testsuite/tests/typecheck/should_run/T16453M4.hs - + testsuite/tests/typecheck/should_run/T16453M4.stdout - + testsuite/tests/typecheck/should_run/T16453T.hs - testsuite/tests/typecheck/should_run/all.T Changes: ===================================== compiler/typecheck/TcExpr.hs ===================================== @@ -17,6 +17,7 @@ module TcExpr ( tcPolyExpr, tcMonoExpr, tcMonoExprNC, tcSyntaxOp, tcSyntaxOpGen, SyntaxOpType(..), synKnownType, tcCheckId, addExprErrCtxt, + addAmbiguousNameErr, getFixedTyVars ) where #include "HsVersions.h" @@ -2193,10 +2194,16 @@ disambiguateSelector lr@(L _ rdr) parent_type -- occurrence" error, then give up. ambiguousSelector :: Located RdrName -> TcM a ambiguousSelector (L _ rdr) + = do { addAmbiguousNameErr rdr + ; failM } + +-- | This name really is ambiguous, so add a suitable "ambiguous +-- occurrence" error, then continue +addAmbiguousNameErr :: RdrName -> TcM () +addAmbiguousNameErr rdr = do { env <- getGlobalRdrEnv ; let gres = lookupGRE_RdrName rdr env - ; setErrCtxt [] $ addNameClashErrRn rdr gres - ; failM } + ; setErrCtxt [] $ addNameClashErrRn rdr gres} -- Disambiguate the fields in a record update. -- See Note [Disambiguating record fields] ===================================== compiler/typecheck/TcRnDriver.hs ===================================== @@ -129,7 +129,7 @@ import GHC.Core.Class import BasicTypes hiding( SuccessFlag(..) ) import GHC.Core.Coercion.Axiom import Annotations -import Data.List ( sortBy, sort ) +import Data.List ( find, sortBy, sort ) import Data.Ord import FastString import Maybes @@ -268,17 +268,13 @@ tcRnModuleTcRnM hsc_env mod_sum ; tcg_env <- if isHsBootOrSig hsc_src then tcRnHsBootDecls hsc_src local_decls else {-# SCC "tcRnSrcDecls" #-} - tcRnSrcDecls explicit_mod_hdr local_decls + tcRnSrcDecls explicit_mod_hdr local_decls export_ies ; setGblEnv tcg_env $ do { -- Process the export list traceRn "rn4a: before exports" empty ; tcg_env <- tcRnExports explicit_mod_hdr export_ies tcg_env ; traceRn "rn4b: after exports" empty - ; -- When a module header is specified, - -- check that the main module exports a main function. - -- (must be after tcRnExports) - when explicit_mod_hdr $ checkMainExported tcg_env ; -- Compare hi-boot iface (if any) with the real thing -- Must be done after processing the exports tcg_env <- checkHiBootIface tcg_env boot_info @@ -400,8 +396,9 @@ tcRnImports hsc_env import_decls tcRnSrcDecls :: Bool -- False => no 'module M(..) where' header at all -> [LHsDecl GhcPs] -- Declarations + -> Maybe (Located [LIE GhcPs]) -> TcM TcGblEnv -tcRnSrcDecls explicit_mod_hdr decls +tcRnSrcDecls explicit_mod_hdr decls export_ies = do { -- Do all the declarations ; (tcg_env, tcl_env, lie) <- tc_rn_src_decls decls @@ -410,7 +407,7 @@ tcRnSrcDecls explicit_mod_hdr decls -- NB: always set envs *before* captureTopConstraints ; (tcg_env, lie_main) <- setEnvs (tcg_env, tcl_env) $ captureTopConstraints $ - checkMain explicit_mod_hdr + checkMain explicit_mod_hdr export_ies ; setEnvs (tcg_env, tcl_env) $ do { @@ -1719,29 +1716,69 @@ tcTyClsInstDecls tycl_decls deriv_decls binds -} checkMain :: Bool -- False => no 'module M(..) where' header at all + -> Maybe (Located [LIE GhcPs]) -- Export specs of Main module -> TcM TcGblEnv --- If we are in module Main, check that 'main' is defined. -checkMain explicit_mod_hdr +-- If we are in module Main, check that 'main' is defined and exported. +checkMain explicit_mod_hdr export_ies = do { dflags <- getDynFlags ; tcg_env <- getGblEnv - ; check_main dflags tcg_env explicit_mod_hdr } + ; check_main dflags tcg_env explicit_mod_hdr export_ies } -check_main :: DynFlags -> TcGblEnv -> Bool -> TcM TcGblEnv -check_main dflags tcg_env explicit_mod_hdr +check_main :: DynFlags -> TcGblEnv -> Bool -> Maybe (Located [LIE GhcPs]) + -> TcM TcGblEnv +check_main dflags tcg_env explicit_mod_hdr export_ies | mod /= main_mod = traceTc "checkMain not" (ppr main_mod <+> ppr mod) >> return tcg_env | otherwise - = do { mb_main <- lookupGlobalOccRn_maybe main_fn - -- Check that 'main' is in scope - -- It might be imported from another module! - ; case mb_main of { - Nothing -> do { traceTc "checkMain fail" (ppr main_mod <+> ppr main_fn) - ; complain_no_main - ; return tcg_env } ; - Just main_name -> do + -- Compare the list of main functions in scope with those + -- specified in the export list. + = do mains_all <- lookupInfoOccRn main_fn + -- get all 'main' functions in scope + -- They may also be imported from other modules! + case exportedMains of -- check the main(s) specified in the export list + [ ] -> do + -- The module has no main functions in the export spec, so we must give + -- some kind of error message. The tricky part is giving an error message + -- that accurately characterizes what the problem is. + -- See Note [Main module without a main function in the export spec] + traceTc "checkMain no main module exported" ppr_mod_mainfn + complain_no_main + -- In order to reduce the number of potential error messages, we check + -- to see if there are any main functions defined (but not exported)... + case getSomeMain mains_all of + Nothing -> return tcg_env + -- ...if there are no such main functions, there is nothing we can do... + Just some_main -> use_as_main some_main + -- ...if there is such a main function, then communicate this to the + -- typechecker. This can prevent a spurious "Ambiguous type variable" + -- error message in certain cases, as described in + -- Note [Main module without a main function in the export spec]. + _ -> do -- The module has one or more main functions in the export spec + let mains = filterInsMains exportedMains mains_all + case mains of + [] -> do -- + traceTc "checkMain fail" ppr_mod_mainfn + complain_no_main + return tcg_env + [main_name] -> use_as_main main_name + _ -> do -- multiple main functions are exported + addAmbiguousNameErr main_fn -- issue error msg + return tcg_env + where + mod = tcg_mod tcg_env + main_mod = mainModIs dflags + main_mod_nm = moduleName main_mod + main_fn = getMainFun dflags + occ_main_fn = occName main_fn + interactive = ghcLink dflags == LinkInMemory + exportedMains = selExportMains export_ies + ppr_mod_mainfn = ppr main_mod <+> ppr main_fn + -- There is a single exported 'main' function. + use_as_main :: Name -> TcM TcGblEnv + use_as_main main_name = do { traceTc "checkMain found" (ppr main_mod <+> ppr main_fn) ; let loc = srcLocSpan (getSrcLoc main_name) ; ioTyCon <- tcLookupTyCon ioTyConName @@ -1779,13 +1816,7 @@ check_main dflags tcg_env explicit_mod_hdr `plusDU` usesOnly (unitFV main_name) -- Record the use of 'main', so that we don't -- complain about it being defined but not used - }) - }}} - where - mod = tcg_mod tcg_env - main_mod = mainModIs dflags - main_fn = getMainFun dflags - interactive = ghcLink dflags == LinkInMemory + })} complain_no_main = unless (interactive && not explicit_mod_hdr) (addErrTc noMainMsg) -- #12906 @@ -1795,9 +1826,56 @@ check_main dflags tcg_env explicit_mod_hdr mainCtxt = text "When checking the type of the" <+> pp_main_fn noMainMsg = text "The" <+> pp_main_fn - <+> text "is not defined in module" <+> quotes (ppr main_mod) + <+> text "is not" <+> text defOrExp <+> text "module" + <+> quotes (ppr main_mod) + defOrExp = if null exportedMains then "exported by" else "defined in" + pp_main_fn = ppMainFn main_fn + -- Select the main functions from the export list. + -- Only the module name is needed, the function name is fixed. + selExportMains :: Maybe (Located [LIE GhcPs]) -> [ModuleName] -- #16453 + selExportMains Nothing = [main_mod_nm] + -- no main specified, but there is a header. + selExportMains (Just exps) = fmap fst $ + filter (\(_,n) -> n == occ_main_fn ) texp + where + ies = fmap unLoc $ unLoc exps + texp = mapMaybe transExportIE ies + + -- Filter all main functions in scope that match the export specs + filterInsMains :: [ModuleName] -> [Name] -> [Name] -- #16453 + filterInsMains export_mains inscope_mains = + [mod | mod <- inscope_mains, + (moduleName . nameModule) mod `elem` export_mains] + + -- Transform an export_ie to a (ModuleName, OccName) pair. + -- 'IEVar' constructors contain exported values (functions), eg '(Main.main)' + -- 'IEModuleContents' constructors contain fully exported modules, eg '(Main)' + -- All other 'IE...' constructors are not used and transformed to Nothing. + transExportIE :: IE GhcPs -> Maybe (ModuleName, OccName) -- #16453 + transExportIE (IEVar _ var) = isQual_maybe $ + upqual $ ieWrappedName $ unLoc var + where + -- A module name is always needed, so qualify 'UnQual' rdr names. + upqual (Unqual occ) = Qual main_mod_nm occ + upqual rdr = rdr + transExportIE (IEModuleContents _ mod) = Just (unLoc mod, occ_main_fn) + transExportIE _ = Nothing + + -- Get a main function that is in scope. + -- See Note [Main module without a main function in the export spec] + getSomeMain :: [Name] -> Maybe Name -- #16453 + getSomeMain all_mains = case all_mains of + [] -> Nothing -- No main function in scope + [m] -> Just m -- Just one main function in scope + _ -> case mbMainOfMain of + Nothing -> listToMaybe all_mains -- Take the first main function in scope or Nothing + _ -> mbMainOfMain -- Take the Main module's main function or Nothing + where + mbMainOfMain = find (\n -> (moduleName . nameModule) n == main_mod_nm ) + all_mains -- the main function of the Main module + -- | Get the unqualified name of the function to use as the \"main\" for the main module. -- Either returns the default name or the one configured on the command line with -main-is getMainFun :: DynFlags -> RdrName @@ -1805,19 +1883,6 @@ getMainFun dflags = case mainFunIs dflags of Just fn -> mkRdrUnqual (mkVarOccFS (mkFastString fn)) Nothing -> main_RDR_Unqual --- If we are in module Main, check that 'main' is exported. -checkMainExported :: TcGblEnv -> TcM () -checkMainExported tcg_env - = case tcg_main tcg_env of - Nothing -> return () -- not the main module - Just main_name -> - do { dflags <- getDynFlags - ; let main_mod = mainModIs dflags - ; checkTc (main_name `elem` - concatMap availNames (tcg_exports tcg_env)) $ - text "The" <+> ppMainFn (nameRdrName main_name) <+> - text "is not exported by module" <+> quotes (ppr main_mod) } - ppMainFn :: RdrName -> SDoc ppMainFn main_fn | rdrNameOcc main_fn == mainOcc @@ -1842,6 +1907,53 @@ module. Tiresomely, we must filter it out again in GHC.Iface.Make, less we get two defns for 'main' in the interface file! +Note [Main module without a main function in the export spec] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Giving accurate error messages for a Main module that does not export a main +function is surprisingly tricky. To see why, consider a module in a file +`Foo.hs` that has no `main` function in the explicit export specs of the module +header: + + module Main () where + foo = return () + +This does not export a main function and therefore should be rejected, per +chapter 5 of the Haskell Report 2010: + + A Haskell program is a collection of modules, one of which, by convention, + must be called Main and must export the value main. The value of the + program is the value of the identifier main in module Main, which must be + a computation of type IO τ for some type τ. + +In fact, when you compile the program above using `ghc Foo.hs`, you will +actually get *two* errors: + + - The IO action ‘main’ is not defined in module ‘Main’ + + - Ambiguous type variable ‘m0’ arising from a use of ‘return’ + prevents the constraint ‘(Monad m0)’ from being solved. + +The first error is self-explanatory, while the second error message occurs +due to the monomorphism restriction. + +Now consider what would happen if the program above were compiled with +`ghc -main-is foo Foo`. The has the effect of `foo` being designated as the +main function. The program will still be rejected since it does not export +`foo` (and therefore does not export its main function), but there is one +important difference: `foo` will be checked against the type `IO τ`. As a +result, we would *not* expect the monomorphism restriction error message +to occur, since the typechecker should have no trouble figuring out the type +of `foo`. In other words, we should only throw the former error message, +not the latter. + +The implementation uses the function `getSomeMain` to find a potential main +function that is defined but not exported. If one is found, it is passed to +`use_as_main` to inform the typechecker that the main function should be of +type `IO τ`. See also the `T414` and `T17171a` test cases for similar examples +of programs whose error messages are influenced by the situation described in +this Note. + + ********************************************************* * * GHCi stuff @@ -2574,7 +2686,7 @@ tcRnDeclsi :: HscEnv -> IO (Messages, Maybe TcGblEnv) tcRnDeclsi hsc_env local_decls = runTcInteractive hsc_env $ - tcRnSrcDecls False local_decls + tcRnSrcDecls False local_decls Nothing externaliseAndTidyId :: Module -> Id -> TcM Id externaliseAndTidyId this_mod id ===================================== testsuite/tests/typecheck/should_fail/T16453E1.hs ===================================== @@ -0,0 +1,2 @@ +module Main where +import T16453T ===================================== testsuite/tests/typecheck/should_fail/T16453E1.stderr ===================================== @@ -0,0 +1,2 @@ +T16453E1.hs:1:1: error: + The IO action ‘main’ is not defined in module ‘Main’ ===================================== testsuite/tests/typecheck/should_fail/T16453E2.hs ===================================== @@ -0,0 +1,3 @@ +module Main (T16453T.main, T16453S.main) where +import T16453T +import T16453S ===================================== testsuite/tests/typecheck/should_fail/T16453E2.stderr ===================================== @@ -0,0 +1,9 @@ +T16453E2.hs:1:1: + Ambiguous occurrence ‘main’ + It could refer to + either ‘T16453T.main’, + imported from ‘T16453T’ at T16453E2.hs:2:1-14 + (and originally defined at T16453T.hs:2:1-4) + or ‘T16453S.main’, + imported from ‘T16453S’ at T16453E2.hs:3:1-14 + (and originally defined at T16453S.hs:2:1-4) ===================================== testsuite/tests/typecheck/should_fail/T16453S.hs ===================================== @@ -0,0 +1,2 @@ +module T16453S where +main = putStrLn "T16453S" ===================================== testsuite/tests/typecheck/should_fail/T16453T.hs ===================================== @@ -0,0 +1,2 @@ +module T16453T where +main = putStrLn "T16453T" ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -516,6 +516,10 @@ test('T16255', normal, compile_fail, ['']) test('T16204c', normal, compile_fail, ['']) test('T16394', normal, compile_fail, ['']) test('T16414', normal, compile_fail, ['']) +test('T16453E1', extra_files(['T16453T.hs', 'T16453S.hs']), multimod_compile_fail, + ['T16453E1.hs', '-v0']) +test('T16453E2', extra_files(['T16453T.hs', 'T16453S.hs']), + multimod_compile_fail, ['T16453E2.hs', '-v0']) test('T16456', normal, compile_fail, ['-fprint-explicit-foralls']) test('T16627', normal, compile_fail, ['']) test('T502', normal, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_run/T16453M0.hs ===================================== @@ -0,0 +1,3 @@ +module Main where +import T16453T +main = putStrLn "T16453M0" ===================================== testsuite/tests/typecheck/should_run/T16453M0.stdout ===================================== @@ -0,0 +1 @@ +T16453M0 ===================================== testsuite/tests/typecheck/should_run/T16453M1.hs ===================================== @@ -0,0 +1,3 @@ +module Main (T16453T.main) where +import T16453T +main = putStrLn "T16453M1" ===================================== testsuite/tests/typecheck/should_run/T16453M1.stdout ===================================== @@ -0,0 +1 @@ +T16453T ===================================== testsuite/tests/typecheck/should_run/T16453M2.hs ===================================== @@ -0,0 +1,3 @@ +module Main (Main.main) where +import T16453T +main = putStrLn "T16453M2" ===================================== testsuite/tests/typecheck/should_run/T16453M2.stdout ===================================== @@ -0,0 +1 @@ +T16453M2 ===================================== testsuite/tests/typecheck/should_run/T16453M3.hs ===================================== @@ -0,0 +1,3 @@ +module Main (module Main) where +import T16453T +main = putStrLn "T16453M3" ===================================== testsuite/tests/typecheck/should_run/T16453M3.stdout ===================================== @@ -0,0 +1 @@ +T16453M3 ===================================== testsuite/tests/typecheck/should_run/T16453M4.hs ===================================== @@ -0,0 +1,3 @@ +module Main (module T16453T) where +import T16453T +main = putStrLn "T16453M4" ===================================== testsuite/tests/typecheck/should_run/T16453M4.stdout ===================================== @@ -0,0 +1 @@ +T16453T ===================================== testsuite/tests/typecheck/should_run/T16453T.hs ===================================== @@ -0,0 +1,2 @@ +module T16453T where +main = putStrLn "T16453T" ===================================== testsuite/tests/typecheck/should_run/all.T ===================================== @@ -135,6 +135,11 @@ test('T14218', normal, compile_and_run, ['']) test('T14236', normal, compile_and_run, ['']) test('T14925', normal, compile_and_run, ['']) test('T14341', normal, compile_and_run, ['']) +test('T16453M0', extra_files(['T16453T.hs']), compile_and_run, ['']) +test('T16453M1', extra_files(['T16453T.hs']), compile_and_run, ['']) +test('T16453M2', extra_files(['T16453T.hs']), compile_and_run, ['']) +test('T16453M3', extra_files(['T16453T.hs']), compile_and_run, ['']) +test('T16453M4', extra_files(['T16453T.hs']), compile_and_run, ['']) test('UnliftedNewtypesRun', normal, compile_and_run, ['']) test('UnliftedNewtypesFamilyRun', normal, compile_and_run, ['']) test('UnliftedNewtypesDependentFamilyRun', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/703221f408b023a1b3433938572e7b5c24b4af60 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/703221f408b023a1b3433938572e7b5c24b4af60 You're receiving 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 Mar 25 18:45:50 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 25 Mar 2020 14:45:50 -0400 Subject: [Git][ghc/ghc][master] Remove -fkill-absence and -fkill-one-shot flags Message-ID: <5e7ba6de69ef5_61673f8198ee100c58392a@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 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. - - - - - 3 changed files: - compiler/GHC/Core/Op/DmdAnal.hs - compiler/GHC/Driver/Session.hs - compiler/basicTypes/Demand.hs Changes: ===================================== compiler/GHC/Core/Op/DmdAnal.hs ===================================== @@ -603,7 +603,7 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs -- TODO: Won't the following line unnecessarily trim down arity for join -- points returning a lambda in a C(S) context? sig = mkStrictSigForArity rhs_arity (mkDmdType sig_fv rhs_dmds rhs_div) - id' = set_idStrictness env id sig + id' = setIdStrictness id sig -- See Note [NOINLINE and strictness] @@ -1171,8 +1171,7 @@ findBndrDmd :: AnalEnv -> Bool -> DmdType -> Id -> (DmdType, Demand) findBndrDmd env arg_of_dfun dmd_ty id = (dmd_ty', dmd') where - dmd' = killUsageDemand (ae_dflags env) $ - strictify $ + dmd' = strictify $ trimToType starting_dmd (findTypeShape fam_envs id_ty) (dmd_ty', starting_dmd) = peelFV dmd_ty id @@ -1191,10 +1190,6 @@ findBndrDmd env arg_of_dfun dmd_ty id fam_envs = ae_fam_envs env -set_idStrictness :: AnalEnv -> Id -> StrictSig -> Id -set_idStrictness env id sig - = setIdStrictness id (killUsageSig (ae_dflags env) sig) - {- Note [Initialising strictness] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ See section 9.2 (Finding fixpoints) of the paper. ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -3568,8 +3568,6 @@ fFlagsDeps = [ flagGhciSpec "implicit-import-qualified" Opt_ImplicitImportQualified, flagSpec "irrefutable-tuples" Opt_IrrefutableTuples, flagSpec "keep-going" Opt_KeepGoing, - flagSpec "kill-absence" Opt_KillAbsence, - flagSpec "kill-one-shot" Opt_KillOneShot, flagSpec "late-dmd-anal" Opt_LateDmdAnal, flagSpec "late-specialise" Opt_LateSpecialise, flagSpec "liberate-case" Opt_LiberateCase, ===================================== compiler/basicTypes/Demand.hs ===================================== @@ -50,7 +50,7 @@ module Demand ( TypeShape(..), peelTsFuns, trimToType, useCount, isUsedOnce, reuseEnv, - killUsageDemand, killUsageSig, zapUsageDemand, zapUsageEnvSig, + zapUsageDemand, zapUsageEnvSig, zapUsedOnceDemand, zapUsedOnceSig, strictifyDictDmd, strictifyDmd @@ -60,7 +60,6 @@ module Demand ( import GhcPrelude -import GHC.Driver.Session import Outputable import Var ( Var ) import VarEnv @@ -1754,14 +1753,6 @@ that it is going to diverge. This is the reason why we use the function appIsBottom, which, given a strictness signature and a number of arguments, says conservatively if the function is going to diverge or not. - -Zap absence or one-shot information, under control of flags - -Note [Killing usage information] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The flags -fkill-one-shot and -fkill-absence let you switch off the generation -of absence or one-shot information altogether. This is only used for performance -tests, to see how important they are. -} zapUsageEnvSig :: StrictSig -> StrictSig @@ -1790,34 +1781,12 @@ zapUsedOnceSig :: StrictSig -> StrictSig zapUsedOnceSig (StrictSig (DmdType env ds r)) = StrictSig (DmdType env (map zapUsedOnceDemand ds) r) -killUsageDemand :: DynFlags -> Demand -> Demand --- See Note [Killing usage information] -killUsageDemand dflags dmd - | Just kfs <- killFlags dflags = kill_usage kfs dmd - | otherwise = dmd - -killUsageSig :: DynFlags -> StrictSig -> StrictSig --- See Note [Killing usage information] -killUsageSig dflags sig@(StrictSig (DmdType env ds r)) - | Just kfs <- killFlags dflags = StrictSig (DmdType env (map (kill_usage kfs) ds) r) - | otherwise = sig - data KillFlags = KillFlags { kf_abs :: Bool , kf_used_once :: Bool , kf_called_once :: Bool } -killFlags :: DynFlags -> Maybe KillFlags --- See Note [Killing usage information] -killFlags dflags - | not kf_abs && not kf_used_once = Nothing - | otherwise = Just (KillFlags {..}) - where - kf_abs = gopt Opt_KillAbsence dflags - kf_used_once = gopt Opt_KillOneShot dflags - kf_called_once = kf_used_once - kill_usage :: KillFlags -> Demand -> Demand kill_usage kfs (JD {sd = s, ud = u}) = JD {sd = s, ud = zap_musg kfs u} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3e27205a66b06a4501d87eb31e285eadbc693eb7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3e27205a66b06a4501d87eb31e285eadbc693eb7 You're receiving 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 Mar 25 19:17:22 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 25 Mar 2020 15:17:22 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: Use export list of Main module in function TcRnDriver.hs:check_main (Fix #16453) Message-ID: <5e7bae423b315_61677b155d8591726@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 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. - - - - - bf0a381b by Ben Gamari at 2020-03-25T15:17:12-04:00 testsuite: Fix T17786 on Windows Fixes line ending normalization issue. - - - - - 16987040 by Ben Gamari at 2020-03-25T15:17:12-04:00 testsuite: Fix T17786 Fix missing quoting and expected exit code. - - - - - bd819105 by Ben Gamari at 2020-03-25T15:17:12-04:00 testsuite: Mark T12971 as broken on Windows Due to #17945. - - - - - f948a061 by Ben Gamari at 2020-03-25T15:17:13-04:00 gitlab-ci: Add FreeBSD release job - - - - - 11a43080 by Ryan Scott at 2020-03-25T15:17:13-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. - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/Core/Op/DmdAnal.hs - compiler/GHC/Driver/Session.hs - compiler/basicTypes/Demand.hs - compiler/typecheck/TcExpr.hs - compiler/typecheck/TcRnDriver.hs - compiler/typecheck/TcTyClsDecls.hs - testsuite/tests/codeGen/should_compile/Makefile - testsuite/tests/driver/Makefile - testsuite/tests/driver/all.T - + testsuite/tests/typecheck/should_fail/T16453E1.hs - + testsuite/tests/typecheck/should_fail/T16453E1.stderr - + testsuite/tests/typecheck/should_fail/T16453E2.hs - + testsuite/tests/typecheck/should_fail/T16453E2.stderr - + testsuite/tests/typecheck/should_fail/T16453S.hs - + testsuite/tests/typecheck/should_fail/T16453T.hs - + testsuite/tests/typecheck/should_fail/T17955.hs - + testsuite/tests/typecheck/should_fail/T17955.stderr - testsuite/tests/typecheck/should_fail/all.T - + testsuite/tests/typecheck/should_run/T16453M0.hs - + testsuite/tests/typecheck/should_run/T16453M0.stdout - + testsuite/tests/typecheck/should_run/T16453M1.hs - + testsuite/tests/typecheck/should_run/T16453M1.stdout - + testsuite/tests/typecheck/should_run/T16453M2.hs - + testsuite/tests/typecheck/should_run/T16453M2.stdout - + testsuite/tests/typecheck/should_run/T16453M3.hs - + testsuite/tests/typecheck/should_run/T16453M3.stdout - + testsuite/tests/typecheck/should_run/T16453M4.hs - + testsuite/tests/typecheck/should_run/T16453M4.stdout - + testsuite/tests/typecheck/should_run/T16453T.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1e312fd9c84eb9c49f4d468ff45be79065f2a7be...11a43080518ee6e5b474b9e1d91d6758bfac9878 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1e312fd9c84eb9c49f4d468ff45be79065f2a7be...11a43080518ee6e5b474b9e1d91d6758bfac9878 You're receiving 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 Mar 25 19:32:10 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 25 Mar 2020 15:32:10 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/test Message-ID: <5e7bb1ba408e9_61673f81cd4b0f586013c8@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/test at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/test You're receiving 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 Mar 25 20:06:16 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 25 Mar 2020 16:06:16 -0400 Subject: [Git][ghc/ghc][wip/tyconapp-opts] 6 commits: Fix ApplicativeDo regression #17835 Message-ID: <5e7bb9b85c80c_61677b155d8606613@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/tyconapp-opts at Glasgow Haskell Compiler / GHC Commits: 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) - - - - - 3a83b452 by Ben Gamari at 2020-03-24T15:58:11-04:00 Notes from call - - - - - e6e4d941 by Ben Gamari at 2020-03-24T15:58:11-04:00 Comparing nullary type synonyms - - - - - 735c6450 by Ben Gamari at 2020-03-24T15:58:11-04:00 Fixes - - - - - 667fe314 by Ben Gamari at 2020-03-24T15:58:11-04:00 Move logic into tYPE - - - - - 13 changed files: - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Rename/Expr.hs - compiler/prelude/TysPrim.hs - compiler/prelude/TysWiredIn.hs - compiler/typecheck/TcCanonical.hs - compiler/typecheck/TcType.hs - libraries/base/Data/Semigroup.hs - testsuite/tests/ado/T13242a.stderr - + testsuite/tests/ado/T17835.hs - testsuite/tests/ado/ado001.stdout - testsuite/tests/ado/all.T Changes: ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -243,7 +243,7 @@ import GHC.Core.TyCon import TysPrim import {-# SOURCE #-} TysWiredIn ( listTyCon, typeNatKind , typeSymbolKind, liftedTypeKind - , liftedTypeKindTyCon + , liftedTypeKindTyCon, liftedRepDataConTy , constraintKind ) import Name( Name ) import PrelNames @@ -1231,6 +1231,7 @@ compilation. In order to avoid a potentially expensive series of checks in -- its arguments. Applies its arguments to the constructor from left to right. mkTyConApp :: TyCon -> [Type] -> Type mkTyConApp tycon tys +-- TODO: TYPE 'LiftedRep | isFunTyCon tycon , [_rep1,_rep2,ty1,ty2] <- tys -- The FunTyCon (->) is always a visible one @@ -1239,6 +1240,10 @@ mkTyConApp tycon tys | tycon == liftedTypeKindTyCon = ASSERT2( null tys, ppr tycon $$ ppr tys ) liftedTypeKindTyConApp + -- Note [mkTyConApp and Type] + | tycon == tYPETyCon + , [rep] <- tys + = tYPE rep | otherwise = TyConApp tycon tys @@ -2266,6 +2271,7 @@ data TypeOrdering = TLT -- ^ @t1 < t2@ | TGT -- ^ @t1 > t2@ deriving (Eq, Ord, Enum, Bounded) +-- TODO: nullary synonym optimization nonDetCmpTypeX :: RnEnv2 -> Type -> Type -> Ordering -- Main workhorse -- See Note [Non-trivial definitional equality] in GHC.Core.TyCo.Rep nonDetCmpTypeX env orig_t1 orig_t2 = @@ -2301,6 +2307,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,6 +957,11 @@ unify_ty :: UMEnv -- Respects newtypes, PredTypes unify_ty env ty1 ty2 kco + -- See Note [Comparing nullary type synonyms]. + | 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 ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -2274,22 +2274,31 @@ pprStmt (ApplicativeStmt _ args mb_join) (if lengthAtLeast args 2 then parens else id) ap_expr pp_arg :: (a, ApplicativeArg (GhcPass idL)) -> SDoc - pp_arg (_, ApplicativeArgOne _ pat expr isBody _) - | isBody = -- See Note [Applicative BodyStmt] - ppr (BodyStmt (panic "pprStmt") expr noSyntaxExpr noSyntaxExpr + pp_arg (_, applicativeArg) = ppr applicativeArg + +pprStmt (XStmtLR x) = ppr x + + +instance (OutputableBndrId idL) + => Outputable (ApplicativeArg (GhcPass idL)) where + ppr = pprArg + +pprArg :: forall idL . (OutputableBndrId idL) => ApplicativeArg (GhcPass idL) -> SDoc +pprArg (ApplicativeArgOne _ pat expr isBody _) + | isBody = -- See Note [Applicative BodyStmt] + ppr (BodyStmt (panic "pprStmt") expr noSyntaxExpr noSyntaxExpr :: ExprStmt (GhcPass idL)) - | otherwise = - ppr (BindStmt (panic "pprStmt") pat expr noSyntaxExpr noSyntaxExpr + | otherwise = + ppr (BindStmt (panic "pprStmt") pat expr noSyntaxExpr noSyntaxExpr :: ExprStmt (GhcPass idL)) - pp_arg (_, ApplicativeArgMany _ stmts return pat) = +pprArg (ApplicativeArgMany _ stmts return pat) = ppr pat <+> text "<-" <+> ppr (HsDo (panic "pprStmt") DoExpr (noLoc (stmts ++ [noLoc (LastStmt noExtField (noLoc return) Nothing noSyntaxExpr)]))) - pp_arg (_, XApplicativeArg x) = ppr x -pprStmt (XStmtLR x) = ppr x +pprArg (XApplicativeArg x) = ppr x pprTransformStmt :: (OutputableBndrId p) => [IdP (GhcPass p)] -> LHsExpr (GhcPass p) ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -1498,7 +1498,7 @@ ApplicativeDo touches a few phases in the compiler: scheduled as outlined above and transformed into applicative combinators. However, the code is still represented as a do-block with special forms of applicative statements. This allows us to - recover the original do-block when e.g. printing type errors, where + recover the original do-block when e.g. printing type errors, where we don't want to show any of the applicative combinators since they don't exist in the source code. See ApplicativeStmt and ApplicativeArg in HsExpr. @@ -1682,7 +1682,7 @@ stmtTreeToStmts monad_names ctxt (StmtTreeOne (L _ (BindStmt _ pat rhs _ fail_op , is_body_stmt = False , fail_operator = fail_op}] False tail' -stmtTreeToStmts monad_names ctxt (StmtTreeOne (L _ (BodyStmt _ rhs _ fail_op),_)) +stmtTreeToStmts monad_names ctxt (StmtTreeOne (L _ (BodyStmt _ rhs _ _),_)) tail _tail_fvs | (False,tail') <- needJoin monad_names tail = mkApplicativeStmt ctxt @@ -1691,7 +1691,7 @@ stmtTreeToStmts monad_names ctxt (StmtTreeOne (L _ (BodyStmt _ rhs _ fail_op),_) , app_arg_pattern = nlWildPatName , arg_expr = rhs , is_body_stmt = True - , fail_operator = fail_op}] False tail' + , fail_operator = noSyntaxExpr}] False tail' stmtTreeToStmts _monad_names _ctxt (StmtTreeOne (s,_)) tail _tail_fvs = return (s : tail, emptyNameSet) @@ -1706,7 +1706,8 @@ stmtTreeToStmts monad_names ctxt (StmtTreeApplicative trees) tail tail_fvs = do pairs <- mapM (stmtTreeArg ctxt tail_fvs) trees let (stmts', fvss) = unzip pairs let (need_join, tail') = - if any hasStrictPattern trees + -- See Note [ApplicativeDo and refutable patterns] + if any hasRefutablePattern stmts' then (True, tail) else needJoin monad_names tail @@ -1721,13 +1722,13 @@ stmtTreeToStmts monad_names ctxt (StmtTreeApplicative trees) tail tail_fvs = do , is_body_stmt = False , fail_operator = fail_op }, emptyFVs) - stmtTreeArg _ctxt _tail_fvs (StmtTreeOne (L _ (BodyStmt _ exp _ fail_op), _)) = + stmtTreeArg _ctxt _tail_fvs (StmtTreeOne (L _ (BodyStmt _ exp _ _), _)) = return (ApplicativeArgOne { xarg_app_arg_one = noExtField , app_arg_pattern = nlWildPatName , arg_expr = exp , is_body_stmt = True - , fail_operator = fail_op + , fail_operator = noSyntaxExpr }, emptyFVs) stmtTreeArg ctxt tail_fvs tree = do let stmts = flattenStmtTree tree @@ -1854,12 +1855,19 @@ isStrictPattern lpat = SplicePat{} -> True _otherwise -> panic "isStrictPattern" -hasStrictPattern :: ExprStmtTree -> Bool -hasStrictPattern (StmtTreeOne (L _ (BindStmt _ pat _ _ _), _)) = isStrictPattern pat -hasStrictPattern (StmtTreeOne _) = False -hasStrictPattern (StmtTreeBind a b) = hasStrictPattern a || hasStrictPattern b -hasStrictPattern (StmtTreeApplicative trees) = any hasStrictPattern trees +{- +Note [ApplicativeDo and refutable patterns] + +Refutable patterns in do blocks are desugared to use the monadic 'fail' operation. +This means that sometimes an applicative block needs to be wrapped in 'join' simply because +of a refutable pattern, in order for the types to work out. + +-} +hasRefutablePattern :: ApplicativeArg GhcRn -> Bool +hasRefutablePattern (ApplicativeArgOne { app_arg_pattern = pat + , is_body_stmt = False}) = not (isIrrefutableHsPat pat) +hasRefutablePattern _ = False isLetStmt :: LStmt a b -> Bool isLetStmt (L _ LetStmt{}) = True ===================================== compiler/prelude/TysPrim.hs ===================================== @@ -527,6 +527,9 @@ mkPrimTcName built_in_syntax occ key tycon -- | Given a RuntimeRep, applies TYPE to it. -- see Note [TYPE and RuntimeRep] tYPE :: Type -> Type + -- static cases +tYPE (TyConApp tc []) + | tc `hasKey` liftedRepDataConKey = liftedTypeKind -- TYPE 'LiftedPtrRep tYPE rr = TyConApp tYPETyCon [rr] {- ===================================== compiler/prelude/TysWiredIn.hs ===================================== @@ -145,6 +145,7 @@ import Id import Constants ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE, mAX_SUM_SIZE ) import 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 {-# SOURCE #-} GHC.Core.ConLike @@ -642,7 +643,7 @@ constraintKindTyCon :: TyCon constraintKindTyCon = pcTyCon constraintKindTyConName Nothing [] [] liftedTypeKind, typeToTypeKind, constraintKind :: Kind -liftedTypeKind = tYPE liftedRepTy +liftedTypeKind = TyCoRep.TyConApp liftedTypeKindTyCon [] typeToTypeKind = liftedTypeKind `mkVisFunTy` liftedTypeKind constraintKind = mkTyConApp constraintKindTyCon [] ===================================== compiler/typecheck/TcCanonical.hs ===================================== @@ -969,8 +969,14 @@ can_eq_nc' -> Type -> Type -- RHS, after and before type-synonym expansion, resp -> TcS (StopOrContinue Ct) +-- See Note [Comparing nullary type synonyms]. +can_eq_nc' _flat _rdr_env _envs ev _eq_rel ty1@(TyConApp tc1 []) _ps_ty1 (TyConApp tc2 []) _ps_ty2 + | tc1 == tc2 + = canEqReflexive ev ReprEq 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 +-- TODO: Handle nullary synonyms | Just ty1' <- tcView ty1 = can_eq_nc' flat rdr_env envs ev eq_rel ty1' ps_ty1 ty2 ps_ty2 | Just ty2' <- tcView ty2 = can_eq_nc' flat rdr_env envs ev eq_rel ty1 ps_ty1 ty2' ps_ty2 ===================================== compiler/typecheck/TcType.hs ===================================== @@ -1533,6 +1533,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]. + 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' @@ -1565,6 +1570,7 @@ tc_eq_type keep_syns vis_only orig_ty1 orig_ty2 = go env s1 s2 && go env t1 t2 go env (TyConApp tc1 ts1) (TyConApp tc2 ts2) + -- TODO: nullary synonym optimisation = tc1 == tc2 && gos env (tc_vis tc1) ts1 ts2 go env (CastTy t1 _) t2 = go env t1 t2 ===================================== libraries/base/Data/Semigroup.hs ===================================== @@ -286,7 +286,15 @@ instance Num a => Num (Max a) where -- | 'Arg' isn't itself a 'Semigroup' in its own right, but it can be -- placed inside 'Min' and 'Max' to compute an arg min or arg max. -data Arg a b = Arg a b deriving +-- +-- >>> minimum [ Arg (x * x) x | x <- [-10 .. 10] ] +-- Arg 0 0 +data Arg a b = Arg + a + -- ^ The argument used for comparisons in 'Eq' and 'Ord'. + b + -- ^ The "value" exposed via the 'Functor', 'Foldable' etc. instances. + deriving ( Show -- ^ @since 4.9.0.0 , Read -- ^ @since 4.9.0.0 , Data -- ^ @since 4.9.0.0 ===================================== testsuite/tests/ado/T13242a.stderr ===================================== @@ -32,10 +32,15 @@ T13242a.hs:13:11: error: ...plus 21 others ...plus six instances involving out-of-scope types (use -fprint-potential-instances to see them all) - • In the first argument of ‘return’, namely ‘(x == x)’ In a stmt of a 'do' block: return (x == x) In the expression: do A x <- undefined _ <- return 'a' _ <- return 'b' return (x == x) + In an equation for ‘test’: + test + = do A x <- undefined + _ <- return 'a' + _ <- return 'b' + return (x == x) ===================================== testsuite/tests/ado/T17835.hs ===================================== @@ -0,0 +1,38 @@ +-- Build.hs +{-# LANGUAGE ApplicativeDo #-} +module Build (configRules) where + +type Action = IO +type Rules = IO + +type Config = () + +(%>) :: String -> (String -> Action ()) -> Rules () +(%>) = undefined + +command_ :: [String] -> String -> [String] -> Action () +command_ = undefined + +recursive :: Config -> String -> [String] -> IO (FilePath, [String]) +recursive = undefined + +liftIO :: IO a -> Action a +liftIO = id + +need :: [String] -> Action () +need = undefined + +historyDisable :: Action () +historyDisable = undefined + +get_config :: () -> Action Config +get_config = undefined + +configRules :: Rules () +configRules = do + "snapshot" %> \out -> do + historyDisable -- 8.10-rc1 refuses to compile without bind here + config <- get_config () + need [] + (exe,args) <- liftIO $ recursive config "snapshot" [] + command_ [] exe args ===================================== testsuite/tests/ado/ado001.stdout ===================================== @@ -9,4 +9,4 @@ a; ((b | c) | d) ((a | (b; c)) | d) | e ((a | b); (c | d)) | e a | b -(a | (b; c)) +a | (b; c) ===================================== testsuite/tests/ado/all.T ===================================== @@ -17,3 +17,4 @@ test('T13875', normal, compile_and_run, ['']) test('T14163', normal, compile_and_run, ['']) test('T15344', normal, compile_and_run, ['']) test('T16628', normal, compile_fail, ['']) +test('T17835', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c7546de3736a0b925d9e6273f7cf9598c2fc75c9...667fe3140c90d9437a389787476fbbbe3bb2903b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c7546de3736a0b925d9e6273f7cf9598c2fc75c9...667fe3140c90d9437a389787476fbbbe3bb2903b You're receiving 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 Mar 25 22:00:07 2020 From: gitlab at gitlab.haskell.org (Alan Zimmerman) Date: Wed, 25 Mar 2020 18:00:07 -0400 Subject: [Git][ghc/ghc][wip/az/exactprint] 242 commits: Document GMP build [skip ci] Message-ID: <5e7bd4671c77_61677b155d86247e9@gitlab.haskell.org.mail> Alan Zimmerman pushed to branch wip/az/exactprint at Glasgow Haskell Compiler / GHC Commits: 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. - - - - - 4bf5cd0a by Alan Zimmerman at 2020-03-25T20:09:02+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. ---- Work in progress, adding more TTG extensions for annotations. And fixing ppr round-trip tests by being able to blank out in-tree annotations, as done with SrcSpans. This is needed for the case of class Foo a where for which current ppr does not print the "where". Rename AA to AddApiAnn and AA to AddAnn Add XConPatIn and XConPatOut Rebase ---- First pass at bringing in LocatedA for API anns in locations Treatment of ECP in parsing is provisional at this stage, leads to some horribly stuff in Parser.y and RdrHsSyn. It is an extensive but not invasive change. I think (AZ). Locally it reports some parsing tests using less memory. Add ApiAnns to the HsExpr data structure. rebase. Change HsMatchContext and HsStmtContext to use an id, not a GhcPass parameter. Add ApiAnns to Hs/Types Rebase - - - - - 41197ffe by Alan Zimmerman at 2020-03-25T21:58:24+00:00 Rebased 2020-03-25 - - - - - 30 changed files: - .ghcid - .gitlab-ci.yml - + .gitlab/ci.sh - − .gitlab/darwin-init.sh - .gitlab/linters/check-cpp.py - .gitlab/merge_request_templates/merge-request.md - − .gitlab/prepare-system.sh - − .gitlab/win32-init.sh - HACKING.md - aclocal.m4 - boot - compiler/main/GHC.hs → compiler/GHC.hs - compiler/ghci/ByteCodeAsm.hs → compiler/GHC/ByteCode/Asm.hs - compiler/ghci/ByteCodeItbls.hs → compiler/GHC/ByteCode/InfoTable.hs - compiler/ghci/ByteCodeInstr.hs → compiler/GHC/ByteCode/Instr.hs - compiler/ghci/ByteCodeLink.hs → compiler/GHC/ByteCode/Linker.hs - compiler/ghci/ByteCodeTypes.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.hs - compiler/GHC/Cmm/Dataflow/Block.hs - compiler/GHC/Cmm/Dataflow/Graph.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Graph.hs - compiler/GHC/Cmm/Info.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5c65344bb76a7c428ea5b4a1223351e937ab3a04...41197ffe73d560317b9012da36d56b797e4aa0cb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5c65344bb76a7c428ea5b4a1223351e937ab3a04...41197ffe73d560317b9012da36d56b797e4aa0cb You're receiving 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 Mar 26 02:33:59 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 25 Mar 2020 22:33:59 -0400 Subject: [Git][ghc/ghc][wip/tyconapp-opts] Fix it Message-ID: <5e7c1497ea102_6167120434ec629671@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/tyconapp-opts at Glasgow Haskell Compiler / GHC Commits: e4eba425 by Ben Gamari at 2020-03-25T22:33:52-04:00 Fix it - - - - - 1 changed file: - compiler/prelude/TysWiredIn.hs Changes: ===================================== compiler/prelude/TysWiredIn.hs ===================================== @@ -1179,8 +1179,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 [] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e4eba42556fa47d2514ea25aae1f20ca0c47fc3c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e4eba42556fa47d2514ea25aae1f20ca0c47fc3c You're receiving 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 Mar 26 02:34:11 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 25 Mar 2020 22:34:11 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/with2-primop Message-ID: <5e7c14a33747f_616713339fc463024f@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/with2-primop at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/with2-primop You're receiving 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 Mar 26 02:42:26 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 25 Mar 2020 22:42:26 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 11 commits: Do not panic on linker errors Message-ID: <5e7c1692a340a_61677b155d86387e@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - 6c7fc974 by Ben Gamari at 2020-03-25T22:42:07-04:00 testsuite: Fix T17786 on Windows Fixes line ending normalization issue. - - - - - 9ea46e26 by Ben Gamari at 2020-03-25T22:42:07-04:00 testsuite: Fix T17786 Fix missing quoting and expected exit code. - - - - - 3f3f3e1d by Ben Gamari at 2020-03-25T22:42:07-04:00 testsuite: Mark T12971 as broken on Windows Due to #17945. - - - - - af5ff1ac by Marius Bakke at 2020-03-25T22:42:11-04:00 testsuite: Remove test that dlopens a PIE object. glibc 2.30 disallowed dlopening PIE objects, so just remove the test. Fixes #17952. - - - - - dc4eb975 by Ben Gamari at 2020-03-25T22:42:12-04:00 gitlab-ci: Add FreeBSD release job - - - - - 8c2ad322 by Ryan Scott at 2020-03-25T22:42:12-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. - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm/Config.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Op/ConstantFold.hs - compiler/GHC/Core/Op/FloatIn.hs - compiler/GHC/Core/Op/Simplify.hs - compiler/GHC/Core/Op/Simplify/Utils.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToByteCode.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Foreign/Call.hs - compiler/GHC/HsToCore/Foreign/Decl.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/PmCheck.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Binary.hs - compiler/GHC/Runtime/Heap/Inspect.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/11a43080518ee6e5b474b9e1d91d6758bfac9878...8c2ad322741a4628ce65e6e625bb9911e2d598ba -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/11a43080518ee6e5b474b9e1d91d6758bfac9878...8c2ad322741a4628ce65e6e625bb9911e2d598ba You're receiving 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 Mar 26 02:49:35 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 25 Mar 2020 22:49:35 -0400 Subject: [Git][ghc/ghc][wip/with2-primop] Fix it Message-ID: <5e7c183fd92e4_616713339fc46542c8@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/with2-primop at Glasgow Haskell Compiler / GHC Commits: 85d077c3 by Ben Gamari at 2020-03-26T02:49:26+00:00 Fix it - - - - - 8 changed files: - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/basicTypes/MkId.hs - compiler/prelude/PrelNames.hs - compiler/prelude/primops.txt.pp - libraries/base/GHC/Exts.hs - libraries/base/GHC/ForeignPtr.hs - libraries/ghc-compact/GHC/Compact/Serialized.hs Changes: ===================================== compiler/GHC/CoreToStg/Prep.hs ===================================== @@ -24,7 +24,7 @@ import GHC.Core.Op.OccurAnal import GHC.Driver.Types import PrelNames import MkId ( realWorldPrimId, mkPrimOpId ) -import PrimOp ( PrimOp(TouchOp, WithOp) ) +import PrimOp ( PrimOp(TouchOp) ) import GHC.Core.Utils import GHC.Core.Arity import GHC.Core.FVs @@ -861,7 +861,7 @@ cpeApp top_env expr cpe_app env (Var f) [CpeApp (Type argRep), CpeApp (Type argTy), CpeApp (Type resultRep), CpeApp (Type resultTy), CpeApp x, CpeApp k, CpeApp s0] _depth - | Just WithOp <- isPrimOpId_maybe f + | f `hasKey` withKey = do { let voidRepTy = primRepToRuntimeRep VoidRep ; b0 <- newVar $ mkTyConApp (tupleTyCon Unboxed 2) [voidRepTy, resultRep, realWorldStatePrimTy, resultTy] @@ -877,13 +877,17 @@ cpeApp top_env expr (DataAlt (tupleDataCon Unboxed 2), [stateVar, resultVar], rhs) expr = Case (App k s0) b0 (varType b0) [stateResultAlt s1 y rhs1] - rhs1 = Case (mkApps (Var touchId) [Type argTy, x, Var s1]) s1 (varType s1) [(DEFAULT, [], rhs2)] - rhs2 = mkApps (Var $ dataConWrapId $ tupleDataCon Unboxed 2) [Var s2, Var y] + rhs1 = + let scrut = mkApps (Var touchId) [Type argRep, Type argTy, x, Var s1] + in Case scrut s2 (mkTupleTy Unboxed [realWorldStatePrimTy, resultTy]) [(DEFAULT, [], rhs2)] + + -- (# s2, y #) + rhs2 = mkApps (Var $ dataConWrapId $ tupleDataCon Unboxed 2) [Type voidRepTy, Type resultRep, Type realWorldStatePrimTy, Type resultTy, Var s2, Var y] ; cpeBody env expr } - cpe_app env (Var f) args n - | Just WithOp <- isPrimOpId_maybe f + cpe_app _env (Var f) args n + | f `hasKey` withKey = pprPanic "cpe_app" (ppr f $$ ppr args $$ ppr n) cpe_app env (Var v) args depth ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -344,10 +344,6 @@ emitPrimOp dflags = \case GetSizeofMutableByteArrayOp -> \[arg] -> opAllDone $ \[res] -> do emitAssign (CmmLocal res) (cmmLoadIndexW dflags arg (fixedHdrSizeW dflags) (bWord dflags)) - - WithOp -> \args -> - pprPanic "WithOp" (ppr args) - -- #define touchzh(o) /* nothing */ TouchOp -> \args@[_] -> opAllDone $ \res@[] -> do emitPrimCall res MO_Touch args ===================================== compiler/basicTypes/MkId.hs ===================================== @@ -157,6 +157,7 @@ ghcPrimIds , seqId , magicDictId , coerceId + , withId , proxyHashId ] @@ -1334,7 +1335,7 @@ another gun with which to shoot yourself in the foot. nullAddrName, seqName, realWorldName, voidPrimIdName, coercionTokenName, - magicDictName, coerceName, proxyName :: Name + magicDictName, coerceName, proxyName, withName :: Name nullAddrName = mkWiredInIdName gHC_PRIM (fsLit "nullAddr#") nullAddrIdKey nullAddrId seqName = mkWiredInIdName gHC_PRIM (fsLit "seq") seqIdKey seqId realWorldName = mkWiredInIdName gHC_PRIM (fsLit "realWorld#") realWorldPrimIdKey realWorldPrimId @@ -1343,12 +1344,35 @@ coercionTokenName = mkWiredInIdName gHC_PRIM (fsLit "coercionToken#") coercionT magicDictName = mkWiredInIdName gHC_PRIM (fsLit "magicDict") magicDictKey magicDictId coerceName = mkWiredInIdName gHC_PRIM (fsLit "coerce") coerceKey coerceId proxyName = mkWiredInIdName gHC_PRIM (fsLit "proxy#") proxyHashKey proxyHashId +withName = mkWiredInIdName gHC_PRIM (fsLit "with#") withKey withId lazyIdName, oneShotName, noinlineIdName :: Name lazyIdName = mkWiredInIdName gHC_MAGIC (fsLit "lazy") lazyIdKey lazyId oneShotName = mkWiredInIdName gHC_MAGIC (fsLit "oneShot") oneShotKey oneShotId noinlineIdName = mkWiredInIdName gHC_MAGIC (fsLit "noinline") noinlineIdKey noinlineId +------------------------------------------------ +withId :: Id +withId + = pcMiscPrelId withName ty noCafIdInfo + where + -- with# :: forall (rep_a :: RuntimeRep) (a :: TYPE rep_a) + -- (rep_r :: RuntimeRep) (r :: TYPE rep_r). + -- a + -- -> (State# RealWorld -> (# State# RealWorld, r #)) + -- -> State# RealWorld + -- -> (# State# RealWorld, r #) + -- + rep_a = runtimeRep1TyVar + a = openAlphaTyVar + rep_r = runtimeRep2TyVar + r = openBetaTyVar + ty = mkInvForAllTys [rep_a, a, rep_r, r] + $ mkVisFunTys [mkTyVarTy a, cont_ty, realWorldStatePrimTy] result_ty + cont_ty = realWorldStatePrimTy `mkVisFunTy` result_ty + -- (# State# RealWorld, r #) + result_ty = mkTupleTy Unboxed [realWorldStatePrimTy, mkTyVarTy r] + ------------------------------------------------ proxyHashId :: Id proxyHashId ===================================== compiler/prelude/PrelNames.hs ===================================== @@ -2198,12 +2198,13 @@ rootMainKey, runMainKey :: Unique rootMainKey = mkPreludeMiscIdUnique 101 runMainKey = mkPreludeMiscIdUnique 102 -thenIOIdKey, lazyIdKey, assertErrorIdKey, oneShotKey, runRWKey :: Unique +thenIOIdKey, lazyIdKey, assertErrorIdKey, oneShotKey, runRWKey, withKey :: Unique thenIOIdKey = mkPreludeMiscIdUnique 103 lazyIdKey = mkPreludeMiscIdUnique 104 assertErrorIdKey = mkPreludeMiscIdUnique 105 oneShotKey = mkPreludeMiscIdUnique 106 runRWKey = mkPreludeMiscIdUnique 107 +withKey = mkPreludeMiscIdUnique 108 traceKey :: Unique traceKey = mkPreludeMiscIdUnique 109 ===================================== compiler/prelude/primops.txt.pp ===================================== @@ -3025,12 +3025,6 @@ primop FinalizeWeakOp "finalizeWeak#" GenPrimOp has_side_effects = True out_of_line = True -primop WithOp "with#" GenPrimOp - o -> (State# RealWorld -> (# State# RealWorld, p #)) -> State# RealWorld -> (# State# RealWorld, p #) - { TODO. } - with - code_size = { 0 } - primop TouchOp "touch#" GenPrimOp o -> State# RealWorld -> State# RealWorld with @@ -3400,6 +3394,10 @@ pseudoop "proxy#" { Witness for an unboxed {\tt Proxy#} value, which has no runtime representation. } +pseudoop "with#" + o -> (State# RealWorld -> (# State# RealWorld, p #)) -> State# RealWorld -> (# State# RealWorld, p #) + { TODO. } + pseudoop "seq" a -> b -> b { The value of {\tt seq a b} is bottom if {\tt a} is bottom, and ===================================== libraries/base/GHC/Exts.hs ===================================== @@ -61,9 +61,6 @@ module GHC.Exts -- * Running 'RealWorld' state thread runRW#, - -- * Keeping values alive - with#, - -- * Safe coercions -- -- | These are available from the /Trustworthy/ module "Data.Coerce" as well ===================================== libraries/base/GHC/ForeignPtr.hs ===================================== @@ -55,7 +55,6 @@ import GHC.Base import GHC.IORef import GHC.STRef ( STRef(..) ) import GHC.Ptr ( Ptr(..), FunPtr(..) ) -import GHC.Prim ( with# ) import Unsafe.Coerce ( unsafeCoerce, unsafeCoerceUnlifted ) @@ -410,7 +409,7 @@ 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 fo@(ForeignPtr _ r) f = IO $ \s -> +withForeignPtr fo@(ForeignPtr _ r) f = IO $ \s -> case f (unsafeForeignPtrToPtr fo) of IO action# -> with# r action# s ===================================== libraries/ghc-compact/GHC/Compact/Serialized.hs ===================================== @@ -30,7 +30,6 @@ import GHC.Prim import GHC.Types import GHC.Word (Word8) -import GHC.Magic (with#) import GHC.Ptr (Ptr(..), plusPtr) import Control.Concurrent View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/85d077c3d2ecd2479d7244adf33159f7aaa73b7d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/85d077c3d2ecd2479d7244adf33159f7aaa73b7d You're receiving 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 Mar 26 02:57:03 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 25 Mar 2020 22:57:03 -0400 Subject: [Git][ghc/ghc][wip/tyconapp-opts] Fix it Message-ID: <5e7c19ff2a90e_6167e0e2c946573b7@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/tyconapp-opts at Glasgow Haskell Compiler / GHC Commits: bff55d1a by Ben Gamari at 2020-03-25T22:56:57-04:00 Fix it - - - - - 2 changed files: - compiler/GHC/Core/Type.hs - compiler/prelude/TysWiredIn.hs Changes: ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -243,7 +243,7 @@ import GHC.Core.TyCon import TysPrim import {-# SOURCE #-} TysWiredIn ( listTyCon, typeNatKind , typeSymbolKind, liftedTypeKind - , liftedTypeKindTyCon, liftedRepDataConTy + , liftedTypeKindTyCon, , constraintKind ) import Name( Name ) import PrelNames ===================================== compiler/prelude/TysWiredIn.hs ===================================== @@ -1179,8 +1179,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 [] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bff55d1a2094f242f11740ded8287423f718d34e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bff55d1a2094f242f11740ded8287423f718d34e You're receiving 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 Mar 26 03:18:26 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 25 Mar 2020 23:18:26 -0400 Subject: [Git][ghc/ghc][wip/with2-primop] 18 commits: Refactoring: use Platform instead of DynFlags when possible Message-ID: <5e7c1f023b45c_61671196b3f465857@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/with2-primop at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - c68e753b by Ben Gamari at 2020-03-26T03:18:05+00:00 Introduce with# - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/linters/check-cpp.py - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Graph.hs - compiler/GHC/Cmm/Info.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/Ppr.hs - compiler/GHC/Cmm/Ppr/Decl.hs - compiler/GHC/Cmm/Ppr/Expr.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Switch/Implement.hs - compiler/GHC/Cmm/Type.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen/Amode.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen/Base.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen/CondCode.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/85d077c3d2ecd2479d7244adf33159f7aaa73b7d...c68e753b0eff399d4b6fbece5227d1700fd90903 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/85d077c3d2ecd2479d7244adf33159f7aaa73b7d...c68e753b0eff399d4b6fbece5227d1700fd90903 You're receiving 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 Mar 26 03:39:38 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 25 Mar 2020 23:39:38 -0400 Subject: [Git][ghc/ghc][wip/tyconapp-opts] Fix it Message-ID: <5e7c23fa7ac14_616776d1c746591f2@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/tyconapp-opts at Glasgow Haskell Compiler / GHC Commits: 8a7e82db by Ben Gamari at 2020-03-25T23:39:30-04:00 Fix it - - - - - 2 changed files: - compiler/GHC/Core/Type.hs - compiler/prelude/TysWiredIn.hs Changes: ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -243,7 +243,7 @@ import GHC.Core.TyCon import TysPrim import {-# SOURCE #-} TysWiredIn ( listTyCon, typeNatKind , typeSymbolKind, liftedTypeKind - , liftedTypeKindTyCon, liftedRepDataConTy + , liftedTypeKindTyCon , constraintKind ) import Name( Name ) import PrelNames ===================================== compiler/prelude/TysWiredIn.hs ===================================== @@ -1179,8 +1179,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 [] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8a7e82dbecae343c061ddcaee6cf22812a2b8d2b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8a7e82dbecae343c061ddcaee6cf22812a2b8d2b You're receiving 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 Mar 26 04:27:35 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 26 Mar 2020 00:27:35 -0400 Subject: [Git][ghc/ghc][wip/tyconapp-opts] Notes from call Message-ID: <5e7c2f37383bd_6167e6514b465997@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/tyconapp-opts at Glasgow Haskell Compiler / GHC Commits: f25cda0c by Ben Gamari at 2020-03-26T00:27:25-04:00 Notes from call - - - - - 15 changed files: - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/prelude/TysPrim.hs - compiler/prelude/TysWiredIn.hs - compiler/typecheck/TcCanonical.hs - compiler/typecheck/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/simplCore/should_compile/T13143.stderr - testsuite/tests/simplCore/should_compile/T7360.stderr - testsuite/tests/typecheck/should_compile/T13032.stderr Changes: ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -1231,6 +1231,7 @@ compilation. In order to avoid a potentially expensive series of checks in -- its arguments. Applies its arguments to the constructor from left to right. mkTyConApp :: TyCon -> [Type] -> Type mkTyConApp tycon tys +-- TODO: TYPE 'LiftedRep | isFunTyCon tycon , [_rep1,_rep2,ty1,ty2] <- tys -- The FunTyCon (->) is always a visible one @@ -1239,6 +1240,10 @@ mkTyConApp tycon tys | tycon == liftedTypeKindTyCon = ASSERT2( null tys, ppr tycon $$ ppr tys ) liftedTypeKindTyConApp + -- Note [mkTyConApp and Type] + | tycon == tYPETyCon + , [rep] <- tys + = tYPE rep | otherwise = TyConApp tycon tys @@ -2266,6 +2271,7 @@ data TypeOrdering = TLT -- ^ @t1 < t2@ | TGT -- ^ @t1 > t2@ deriving (Eq, Ord, Enum, Bounded) +-- TODO: nullary synonym optimization nonDetCmpTypeX :: RnEnv2 -> Type -> Type -> Ordering -- Main workhorse -- See Note [Non-trivial definitional equality] in GHC.Core.TyCo.Rep nonDetCmpTypeX env orig_t1 orig_t2 = @@ -2301,6 +2307,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,6 +957,11 @@ unify_ty :: UMEnv -- Respects newtypes, PredTypes unify_ty env ty1 ty2 kco + -- See Note [Comparing nullary type synonyms]. + | 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 ===================================== compiler/prelude/TysPrim.hs ===================================== @@ -527,6 +527,9 @@ mkPrimTcName built_in_syntax occ key tycon -- | Given a RuntimeRep, applies TYPE to it. -- see Note [TYPE and RuntimeRep] tYPE :: Type -> Type + -- static cases +tYPE (TyConApp tc []) + | tc `hasKey` liftedRepDataConKey = liftedTypeKind -- TYPE 'LiftedPtrRep tYPE rr = TyConApp tYPETyCon [rr] {- ===================================== compiler/prelude/TysWiredIn.hs ===================================== @@ -145,6 +145,7 @@ import Id import Constants ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE, mAX_SUM_SIZE ) import 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 {-# SOURCE #-} GHC.Core.ConLike @@ -642,7 +643,7 @@ constraintKindTyCon :: TyCon constraintKindTyCon = pcTyCon constraintKindTyConName Nothing [] [] liftedTypeKind, typeToTypeKind, constraintKind :: Kind -liftedTypeKind = tYPE liftedRepTy +liftedTypeKind = TyCoRep.TyConApp liftedTypeKindTyCon [] typeToTypeKind = liftedTypeKind `mkVisFunTy` liftedTypeKind constraintKind = mkTyConApp constraintKindTyCon [] @@ -1178,8 +1179,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/typecheck/TcCanonical.hs ===================================== @@ -969,8 +969,14 @@ can_eq_nc' -> Type -> Type -- RHS, after and before type-synonym expansion, resp -> TcS (StopOrContinue Ct) +-- See Note [Comparing nullary type synonyms]. +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 +-- TODO: Handle nullary synonyms | Just ty1' <- tcView ty1 = can_eq_nc' flat rdr_env envs ev eq_rel ty1' ps_ty1 ty2 ps_ty2 | Just ty2' <- tcView ty2 = can_eq_nc' flat rdr_env envs ev eq_rel ty1 ps_ty1 ty2' ps_ty2 ===================================== compiler/typecheck/TcType.hs ===================================== @@ -1533,6 +1533,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]. + 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' @@ -1565,6 +1570,7 @@ tc_eq_type keep_syns vis_only orig_ty1 orig_ty2 = go env s1 s2 && go env t1 t2 go env (TyConApp tc1 ts1) (TyConApp tc2 ts2) + -- TODO: nullary synonym optimisation = tc1 == tc2 && gos env (tc_vis tc1) ts1 ts2 go env (CastTy t1 _) 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[0]] :: forall a. a :~: a [GblId[DataConWrapper], Caf=NoCafRefs, @@ -15,7 +15,7 @@ T2431.$WRefl [InlPrag=INLINE[0]] :: 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 { } @@ -110,3 +110,6 @@ T2431.$tc'Refl $tc'Refl2 1# $krep3 + + + ===================================== testsuite/tests/deriving/should_compile/T14578.stderr ===================================== @@ -9,7 +9,7 @@ Derived class instances: GHC.Base.sconcat :: GHC.Base.NonEmpty (T14578.Wat f g a) -> T14578.Wat f g a GHC.Base.stimes :: - forall (b :: TYPE GHC.Types.LiftedRep). + forall (b :: GHC.Types.Type). GHC.Real.Integral b => b -> T14578.Wat f g a -> T14578.Wat f g a (GHC.Base.<>) = GHC.Prim.coerce @@ -37,12 +37,10 @@ Derived class instances: instance GHC.Base.Functor f => GHC.Base.Functor (T14578.App f) where GHC.Base.fmap :: - forall (a :: TYPE GHC.Types.LiftedRep) - (b :: TYPE GHC.Types.LiftedRep). + forall (a :: GHC.Types.Type) (b :: GHC.Types.Type). (a -> b) -> T14578.App f a -> T14578.App f b (GHC.Base.<$) :: - forall (a :: TYPE GHC.Types.LiftedRep) - (b :: TYPE GHC.Types.LiftedRep). + forall (a :: GHC.Types.Type) (b :: GHC.Types.Type). a -> T14578.App f b -> T14578.App f a GHC.Base.fmap = GHC.Prim.coerce @@ -55,24 +53,20 @@ Derived class instances: instance GHC.Base.Applicative f => GHC.Base.Applicative (T14578.App f) where - GHC.Base.pure :: - forall (a :: TYPE GHC.Types.LiftedRep). a -> T14578.App f a + GHC.Base.pure :: forall (a :: GHC.Types.Type). a -> T14578.App f a (GHC.Base.<*>) :: - forall (a :: TYPE GHC.Types.LiftedRep) - (b :: TYPE GHC.Types.LiftedRep). + forall (a :: GHC.Types.Type) (b :: GHC.Types.Type). T14578.App f (a -> b) -> T14578.App f a -> T14578.App f b GHC.Base.liftA2 :: - forall (a :: TYPE GHC.Types.LiftedRep) - (b :: TYPE GHC.Types.LiftedRep) - (c :: TYPE GHC.Types.LiftedRep). + forall (a :: GHC.Types.Type) + (b :: GHC.Types.Type) + (c :: GHC.Types.Type). (a -> b -> c) -> T14578.App f a -> T14578.App f b -> T14578.App f c (GHC.Base.*>) :: - forall (a :: TYPE GHC.Types.LiftedRep) - (b :: TYPE GHC.Types.LiftedRep). + forall (a :: GHC.Types.Type) (b :: GHC.Types.Type). T14578.App f a -> T14578.App f b -> T14578.App f b (GHC.Base.<*) :: - forall (a :: TYPE GHC.Types.LiftedRep) - (b :: TYPE GHC.Types.LiftedRep). + forall (a :: GHC.Types.Type) (b :: GHC.Types.Type). T14578.App f a -> T14578.App f b -> T14578.App f a GHC.Base.pure = GHC.Prim.coerce ===================================== testsuite/tests/plugins/plugins09.stdout ===================================== @@ -3,7 +3,6 @@ interfacePlugin: Prelude interfacePlugin: GHC.Float interfacePlugin: GHC.Base typeCheckPlugin (rn) -interfacePlugin: GHC.Types typeCheckPlugin (tc) interfacePlugin: GHC.Integer.Type interfacePlugin: GHC.Natural ===================================== 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.Integer.Type interfacePlugin: GHC.Natural ===================================== testsuite/tests/plugins/plugins11.stdout ===================================== @@ -3,7 +3,6 @@ interfacePlugin: Prelude interfacePlugin: GHC.Float interfacePlugin: GHC.Base typeCheckPlugin (rn) -interfacePlugin: GHC.Types typeCheckPlugin (tc) interfacePlugin: GHC.Integer.Type interfacePlugin: GHC.Natural ===================================== 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.Integer.Type interfacePlugin: GHC.Natural ===================================== 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}. GHC.Prim.Void# -> a [GblId, Arity=1, Str=b, Cpr=b, Unf=OtherCon []] T13143.$wf = \ (@a) _ [Occ=Dead] -> T13143.$wf @a GHC.Prim.void# 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=NOUSERINLINE[0]] :: forall a. Int -> a [GblId, Arity=1, ===================================== testsuite/tests/simplCore/should_compile/T7360.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 114, types: 53, coercions: 0, joins: 0/0} + = {terms: 114, types: 51, coercions: 0, joins: 0/0} -- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} T7360.$WFoo3 [InlPrag=INLINE[0]] :: Int -> Foo @@ -39,7 +39,7 @@ T7360.fun4 :: Int WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] T7360.fun4 = GHC.Types.I# 0# --- RHS size: {terms: 16, types: 13, coercions: 0, joins: 0/0} +-- RHS size: {terms: 16, types: 12, 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/f25cda0c941a6643c635eaa21803d7c2e50892c2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f25cda0c941a6643c635eaa21803d7c2e50892c2 You're receiving 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 Mar 26 08:12:11 2020 From: gitlab at gitlab.haskell.org (Andreas Klebinger) Date: Thu, 26 Mar 2020 04:12:11 -0400 Subject: [Git][ghc/ghc][wip/andreask/bits_docs] Apply suggestion to libraries/base/Data/Bits.hs Message-ID: <5e7c63db54948_61675cefcac665778@gitlab.haskell.org.mail> Andreas Klebinger pushed to branch wip/andreask/bits_docs at Glasgow Haskell Compiler / GHC Commits: e9e45888 by Andreas Klebinger at 2020-03-26T04:11:47-04:00 Apply suggestion to libraries/base/Data/Bits.hs - - - - - 1 changed file: - libraries/base/Data/Bits.hs Changes: ===================================== libraries/base/Data/Bits.hs ===================================== @@ -168,7 +168,7 @@ class Eq a => Bits a where -- | @x \`complementBit\` i@ is the same as @x \`xor\` bit i@ complementBit :: a -> Int -> a - {-| @x \`testBit\` i@ is the same as @x .&. bit n == 1@ + {-| @x \`testBit\` i@ is the same as @x .&. bit n /= 0@ In other words it returns True if the bit at offset @n is set. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e9e4588872aaab57dc199cb789768efb13edb997 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e9e4588872aaab57dc199cb789768efb13edb997 You're receiving 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 Mar 26 10:05:12 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Thu, 26 Mar 2020 06:05:12 -0400 Subject: [Git][ghc/ghc][wip/T16296] 24 commits: Update "GHC differences to the FFI Chapter" in user guide. Message-ID: <5e7c7e581de48_61671196b3f46774cf@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T16296 at Glasgow Haskell Compiler / GHC Commits: 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. - - - - - c31b1921 by Simon Peyton Jones at 2020-03-26T10:04:26+00: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 - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/linters/check-cpp.py - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Graph.hs - compiler/GHC/Cmm/Info.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/Ppr.hs - compiler/GHC/Cmm/Ppr/Decl.hs - compiler/GHC/Cmm/Ppr/Expr.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Switch/Implement.hs - compiler/GHC/Cmm/Type.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen/Amode.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen/Base.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen/CondCode.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1276e27512d7a79c4cb64dd6366178551286e957...c31b19211f64bfbfb1a70d02d443e4b1b1023b7d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1276e27512d7a79c4cb64dd6366178551286e957...c31b19211f64bfbfb1a70d02d443e4b1b1023b7d You're receiving 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 Mar 26 10:12:37 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 26 Mar 2020 06:12:37 -0400 Subject: [Git][ghc/ghc][master] 5 commits: Do not panic on linker errors Message-ID: <5e7c8015aa2b6_61675cefcac683296@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - 30 changed files: - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm/Config.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Op/ConstantFold.hs - compiler/GHC/Core/Op/FloatIn.hs - compiler/GHC/Core/Op/Simplify.hs - compiler/GHC/Core/Op/Simplify/Utils.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToByteCode.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Foreign/Call.hs - compiler/GHC/HsToCore/Foreign/Decl.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/PmCheck.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Binary.hs - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Runtime/Linker.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3e27205a66b06a4501d87eb31e285eadbc693eb7...6d172e63f3dd3590b0a57371efb8f924f1fcdf05 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3e27205a66b06a4501d87eb31e285eadbc693eb7...6d172e63f3dd3590b0a57371efb8f924f1fcdf05 You're receiving 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 Mar 26 12:08:08 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Thu, 26 Mar 2020 08:08:08 -0400 Subject: [Git][ghc/ghc][wip/require-8.8-or-later] 8 commits: Use export list of Main module in function TcRnDriver.hs:check_main (Fix #16453) Message-ID: <5e7c9b286352b_6167e0e2c946913a3@gitlab.haskell.org.mail> Ryan Scott pushed to branch wip/require-8.8-or-later at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - 7b52f87a by Ryan Scott at 2020-03-26T08:06:35-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. - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm/Config.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Op/ConstantFold.hs - compiler/GHC/Core/Op/DmdAnal.hs - compiler/GHC/Core/Op/FloatIn.hs - compiler/GHC/Core/Op/Simplify.hs - compiler/GHC/Core/Op/Simplify/Utils.hs - compiler/GHC/Core/Op/Specialise.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToByteCode.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Foreign/Call.hs - compiler/GHC/HsToCore/Foreign/Decl.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/PmCheck.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e22a64c05f0a88af9b78c94600e6b68cc6c247f3...7b52f87a2a1b57e3c291865f748f2a52efe74969 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e22a64c05f0a88af9b78c94600e6b68cc6c247f3...7b52f87a2a1b57e3c291865f748f2a52efe74969 You're receiving 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 Mar 26 13:48:31 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Thu, 26 Mar 2020 09:48:31 -0400 Subject: [Git][ghc/ghc][wip/require-8.8-or-later] Require GHC 8.8 as the minimum compiler for bootstrapping Message-ID: <5e7cb2af9801e_6167e0e2c94708375@gitlab.haskell.org.mail> Ryan Scott pushed to branch wip/require-8.8-or-later at Glasgow Haskell Compiler / GHC Commits: 69719d17 by Ryan Scott at 2020-03-26T09:48:06-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. - - - - - 21 changed files: - .gitlab-ci.yml - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Op/ConstantFold.hs - compiler/GHC/Core/Op/Specialise.hs - compiler/GHC/Core/Unify.hs - compiler/basicTypes/UniqSupply.hs - compiler/main/SysTools/Process.hs - compiler/typecheck/TcRnTypes.hs - compiler/typecheck/TcSMonad.hs - compiler/utils/Binary.hs - compiler/utils/IOEnv.hs - configure.ac - hadrian/src/Hadrian/Utilities.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Ghc.hs - libraries/base/Control/Monad/ST/Lazy/Imp.hs - libraries/base/GHC/ST.hs - libraries/base/Text/ParserCombinators/ReadPrec.hs - libraries/ghci/GHCi/TH.hs - libraries/template-haskell/Language/Haskell/TH/Syntax.hs 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: 408eff66aef6ca2b44446c694c5a56d6ca0460cc + DOCKER_REV: 3f731f5d37a156e7ebe10cd32656946083baaf4a # Sequential version number capturing the versions of all tools fetched by # .gitlab/ci.sh. @@ -385,7 +385,7 @@ validate-x86_64-darwin: tags: - x86_64-darwin variables: - GHC_VERSION: 8.6.5 + GHC_VERSION: 8.8.3 CABAL_INSTALL_VERSION: 3.0.0.0 BIN_DIST_PREP_TAR_COMP: "ghc-x86_64-apple-darwin.tar.xz" MACOSX_DEPLOYMENT_TARGET: "10.7" @@ -414,7 +414,7 @@ validate-x86_64-darwin: tags: - x86_64-darwin variables: - GHC_VERSION: 8.6.3 + GHC_VERSION: 8.8.3 MACOSX_DEPLOYMENT_TARGET: "10.7" ac_cv_func_clock_gettime: "no" LANG: "en_US.UTF-8" ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -70,7 +70,6 @@ import Demand ( splitStrictSig, isBotDiv ) import GHC.Driver.Types import GHC.Driver.Session import Control.Monad -import qualified Control.Monad.Fail as MonadFail import MonadUtils import Data.Foldable ( toList ) import Data.List.NonEmpty ( NonEmpty ) @@ -2249,16 +2248,13 @@ instance Applicative LintM where (<*>) = ap instance Monad LintM where -#if !MIN_VERSION_base(4,13,0) - fail = MonadFail.fail -#endif m >>= k = LintM (\ env errs -> let (res, errs') = unLintM m env errs in case res of Just r -> unLintM (k r) env errs' Nothing -> (Nothing, errs')) -instance MonadFail.MonadFail LintM where +instance MonadFail LintM where fail err = failWithL (text err) instance HasDynFlags LintM where ===================================== compiler/GHC/Core/Make.hs ===================================== @@ -85,7 +85,6 @@ import Util import Data.List import Data.Char ( ord ) -import Control.Monad.Fail as MonadFail ( MonadFail ) infixl 4 `mkCoreApp`, `mkCoreApps` @@ -640,7 +639,7 @@ mkFoldrExpr elt_ty result_ty c n list = do `App` list) -- | Make a 'build' expression applied to a locally-bound worker function -mkBuildExpr :: (MonadFail.MonadFail m, MonadThings m, MonadUnique m) +mkBuildExpr :: (MonadFail m, MonadThings m, MonadUnique m) => Type -- ^ Type of list elements to be built -> ((Id, Type) -> (Id, Type) -> m CoreExpr) -- ^ Function that, given information about the 'Id's -- of the binders for the build worker function, returns ===================================== compiler/GHC/Core/Op/ConstantFold.hs ===================================== @@ -61,7 +61,6 @@ import GHC.Core.Coercion (mkUnbranchedAxInstCo,mkSymCo,Role(..)) import Control.Applicative ( Alternative(..) ) import Control.Monad -import qualified Control.Monad.Fail as MonadFail import Data.Bits as Bits import qualified Data.ByteString as BS import Data.Int @@ -796,11 +795,7 @@ instance Monad RuleM where Nothing -> Nothing Just r -> runRuleM (g r) env iu fn args -#if !MIN_VERSION_base(4,13,0) - fail = MonadFail.fail -#endif - -instance MonadFail.MonadFail RuleM where +instance MonadFail RuleM where fail _ = mzero instance Alternative RuleM where ===================================== compiler/GHC/Core/Op/Specialise.hs ===================================== @@ -50,7 +50,6 @@ import UniqDFM import GHC.Core.TyCo.Rep (TyCoBinder (..)) import Control.Monad -import qualified Control.Monad.Fail as MonadFail {- ************************************************************************ @@ -2551,11 +2550,8 @@ instance Monad SpecM where case f y of SpecM z -> z -#if !MIN_VERSION_base(4,13,0) - fail = MonadFail.fail -#endif -instance MonadFail.MonadFail SpecM where +instance MonadFail SpecM where fail str = SpecM $ error str instance MonadUnique SpecM where ===================================== compiler/GHC/Core/Unify.hs ===================================== @@ -46,7 +46,6 @@ import UniqFM import UniqSet import Control.Monad -import qualified Control.Monad.Fail as MonadFail import Control.Applicative hiding ( empty ) import qualified Control.Applicative @@ -1244,9 +1243,6 @@ instance Applicative UM where (<*>) = ap instance Monad UM where -#if !MIN_VERSION_base(4,13,0) - fail = MonadFail.fail -#endif m >>= k = UM (\state -> do { (state', v) <- unUM m state ; unUM (k v) state' }) @@ -1260,7 +1256,7 @@ instance Alternative UM where instance MonadPlus UM -instance MonadFail.MonadFail UM where +instance MonadFail UM where fail _ = UM (\_ -> SurelyApart) -- failed pattern match initUM :: TvSubstEnv -- subst to extend ===================================== compiler/basicTypes/UniqSupply.hs ===================================== @@ -44,7 +44,6 @@ import MonadUtils import Control.Monad import Data.Bits import Data.Char -import Control.Monad.Fail as Fail #include "Unique.h" @@ -156,7 +155,7 @@ instance Applicative UniqSM where (*>) = thenUs_ -- TODO: try to get rid of this instance -instance Fail.MonadFail UniqSM where +instance MonadFail UniqSM where fail = panic -- | Run the 'UniqSM' action, returning the final 'UniqSupply' ===================================== compiler/main/SysTools/Process.hs ===================================== @@ -36,14 +36,10 @@ import FileCleanup -- @process >= 1.6.8.0@). enableProcessJobs :: CreateProcess -> CreateProcess #if defined(MIN_VERSION_process) -#if MIN_VERSION_process(1,6,8) enableProcessJobs opts = opts { use_process_jobs = True } #else enableProcessJobs opts = opts #endif -#else -enableProcessJobs opts = opts -#endif -- Similar to System.Process.readCreateProcessWithExitCode, but stderr is -- inherited from the parent process, and output to stderr is not captured. ===================================== compiler/typecheck/TcRnTypes.hs ===================================== @@ -124,7 +124,6 @@ import PrelNames ( isUnboundName ) import CostCentreState import Control.Monad (ap) -import qualified Control.Monad.Fail as MonadFail import Data.Set ( Set ) import qualified Data.Set as S @@ -1653,14 +1652,11 @@ instance Applicative TcPluginM where (<*>) = ap instance Monad TcPluginM where -#if !MIN_VERSION_base(4,13,0) - fail = MonadFail.fail -#endif TcPluginM m >>= k = TcPluginM (\ ev -> do a <- m ev runTcPluginM (k a) ev) -instance MonadFail.MonadFail TcPluginM where +instance MonadFail TcPluginM where fail x = TcPluginM (const $ fail x) runTcPluginM :: TcPluginM a -> EvBindsVar -> TcM a ===================================== compiler/typecheck/TcSMonad.hs ===================================== @@ -177,7 +177,6 @@ import Maybes import GHC.Core.Map import Control.Monad -import qualified Control.Monad.Fail as MonadFail import MonadUtils import Data.IORef import Data.List ( partition, mapAccumL ) @@ -2699,12 +2698,9 @@ instance Applicative TcS where (<*>) = ap instance Monad TcS where -#if !MIN_VERSION_base(4,13,0) - fail = MonadFail.fail -#endif m >>= k = TcS (\ebs -> unTcS m ebs >>= \r -> unTcS (k r) ebs) -instance MonadFail.MonadFail TcS where +instance MonadFail TcS where fail err = TcS (\_ -> fail err) instance MonadUnique TcS where ===================================== compiler/utils/Binary.hs ===================================== @@ -829,12 +829,10 @@ instance Binary RuntimeRep where put_ bh AddrRep = putByte bh 9 put_ bh FloatRep = putByte bh 10 put_ bh DoubleRep = putByte bh 11 -#if __GLASGOW_HASKELL__ >= 807 put_ bh Int8Rep = putByte bh 12 put_ bh Word8Rep = putByte bh 13 put_ bh Int16Rep = putByte bh 14 put_ bh Word16Rep = putByte bh 15 -#endif #if __GLASGOW_HASKELL__ >= 809 put_ bh Int32Rep = putByte bh 16 put_ bh Word32Rep = putByte bh 17 @@ -855,12 +853,10 @@ instance Binary RuntimeRep where 9 -> pure AddrRep 10 -> pure FloatRep 11 -> pure DoubleRep -#if __GLASGOW_HASKELL__ >= 807 12 -> pure Int8Rep 13 -> pure Word8Rep 14 -> pure Int16Rep 15 -> pure Word16Rep -#endif #if __GLASGOW_HASKELL__ >= 809 16 -> pure Int32Rep 17 -> pure Word32Rep ===================================== compiler/utils/IOEnv.hs ===================================== @@ -43,7 +43,6 @@ import Data.IORef ( IORef, newIORef, readIORef, writeIORef, modifyIORef, import System.IO.Unsafe ( unsafeInterleaveIO ) import System.IO ( fixIO ) import Control.Monad -import qualified Control.Monad.Fail as MonadFail import MonadUtils import Control.Applicative (Alternative(..)) @@ -60,11 +59,8 @@ unIOEnv (IOEnv m) = m instance Monad (IOEnv m) where (>>=) = thenM (>>) = (*>) -#if !MIN_VERSION_base(4,13,0) - fail = MonadFail.fail -#endif -instance MonadFail.MonadFail (IOEnv m) where +instance MonadFail (IOEnv m) where fail _ = failM -- Ignore the string instance Applicative (IOEnv m) where ===================================== configure.ac ===================================== @@ -158,8 +158,8 @@ if test "$WithGhc" = "" then AC_MSG_ERROR([GHC is required.]) fi -FP_COMPARE_VERSIONS([$GhcVersion],[-lt],[8.6], - [AC_MSG_ERROR([GHC version 8.6 or later is required to compile GHC.])]) +FP_COMPARE_VERSIONS([$GhcVersion],[-lt],[8.8], + [AC_MSG_ERROR([GHC version 8.8 or later is required to compile GHC.])]) if test `expr $GhcMinVersion % 2` = "1" then ===================================== hadrian/src/Hadrian/Utilities.hs ===================================== @@ -40,7 +40,6 @@ import Data.Char import Data.Dynamic (Dynamic, fromDynamic, toDyn) import Data.Functor import Data.HashMap.Strict (HashMap) -import Data.List (isPrefixOf) import Data.List.Extra import Data.Maybe import Data.Typeable (TypeRep, typeOf) ===================================== hadrian/src/Settings/Builders/Cabal.hs ===================================== @@ -1,6 +1,5 @@ module Settings.Builders.Cabal (cabalBuilderArgs) where -import Hadrian.Builder (getBuilderPath, needBuilder) import Hadrian.Haskell.Cabal import Builder ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -2,8 +2,6 @@ module Settings.Builders.Ghc (ghcBuilderArgs, haddockGhcArgs) where -import Data.List.Extra (splitOn) - import Hadrian.Haskell.Cabal import Hadrian.Haskell.Cabal.Type ===================================== libraries/base/Control/Monad/ST/Lazy/Imp.hs ===================================== @@ -8,7 +8,7 @@ -- Module : Control.Monad.ST.Lazy.Imp -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) --- +-- -- Maintainer : libraries at haskell.org -- Stability : provisional -- Portability : non-portable (requires universal quantification for runST) @@ -44,7 +44,6 @@ import qualified Control.Monad.ST.Unsafe as ST import qualified GHC.ST as GHC.ST import GHC.Base -import qualified Control.Monad.Fail as Fail -- | The lazy @'ST' monad. -- The ST monad allows for destructive updates, but is escapable (unlike IO). @@ -192,7 +191,7 @@ instance Monad (ST s) where unST (k r) new_s -- | @since 4.10 -instance Fail.MonadFail (ST s) where +instance MonadFail (ST s) where fail s = errorWithoutStackTrace s -- | Return the value computed by an 'ST' computation. @@ -205,8 +204,8 @@ runST (ST st) = runRW# (\s -> case st (S# s) of (r, _) -> r) -- inside the computation. -- Note that if @f@ is strict, @'fixST' f = _|_ at . fixST :: (a -> ST s a) -> ST s a -fixST m = ST (\ s -> - let +fixST m = ST (\ s -> + let q@(r,_s') = unST (m r) s in q) -- Why don't we need unsafePerformIO in fixST? We create a thunk, q, @@ -233,7 +232,7 @@ strictToLazyST (GHC.ST.ST m) = ST $ \(S# s) -> (# s', a #) -> (a, S# s') -- See Note [Lazy ST: not producing lazy pairs] -{-| +{-| Convert a lazy 'ST' computation into a strict one. -} lazyToStrictST :: ST s a -> ST.ST s a ===================================== libraries/base/GHC/ST.hs ===================================== @@ -26,7 +26,7 @@ module GHC.ST ( import GHC.Base import GHC.Show -import qualified Control.Monad.Fail as Fail +import Control.Monad.Fail default () @@ -79,7 +79,7 @@ instance Monad (ST s) where (k2 new_s) }}) -- | @since 4.11.0.0 -instance Fail.MonadFail (ST s) where +instance MonadFail (ST s) where fail s = errorWithoutStackTrace s -- | @since 4.11.0.0 ===================================== libraries/base/Text/ParserCombinators/ReadPrec.hs ===================================== @@ -64,7 +64,7 @@ import qualified Text.ParserCombinators.ReadP as ReadP import GHC.Num( Num(..) ) import GHC.Base -import qualified Control.Monad.Fail as MonadFail +import Control.Monad.Fail -- --------------------------------------------------------------------------- -- The readPrec type @@ -88,8 +88,8 @@ instance Monad ReadPrec where P f >>= k = P (\n -> do a <- f n; let P f' = k a in f' n) -- | @since 4.9.0.0 -instance MonadFail.MonadFail ReadPrec where - fail s = P (\_ -> MonadFail.fail s) +instance MonadFail ReadPrec where + fail s = P (\_ -> fail s) -- | @since 2.01 instance MonadPlus ReadPrec ===================================== libraries/ghci/GHCi/TH.hs ===================================== @@ -97,7 +97,6 @@ import GHCi.RemoteTypes import GHC.Serialized import Control.Exception -import qualified Control.Monad.Fail as Fail import Control.Monad.IO.Class (MonadIO (..)) import Data.Binary import Data.Binary.Put @@ -144,11 +143,8 @@ instance Monad GHCiQ where do (m', s') <- runGHCiQ m s (a, s'') <- runGHCiQ (f m') s' return (a, s'') -#if !MIN_VERSION_base(4,13,0) - fail = Fail.fail -#endif -instance Fail.MonadFail GHCiQ where +instance MonadFail GHCiQ where fail err = GHCiQ $ \s -> throwIO (GHCiQException s err) getState :: GHCiQ QState ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -52,15 +52,13 @@ import Numeric.Natural import Prelude import Foreign.ForeignPtr -import qualified Control.Monad.Fail as Fail - ----------------------------------------------------- -- -- The Quasi class -- ----------------------------------------------------- -class (MonadIO m, Fail.MonadFail m) => Quasi m where +class (MonadIO m, MonadFail m) => Quasi m where qNewName :: String -> m Name -- ^ Fresh names @@ -187,12 +185,9 @@ runQ (Q m) = m instance Monad Q where Q m >>= k = Q (m >>= \x -> unQ (k x)) (>>) = (*>) -#if !MIN_VERSION_base(4,13,0) - fail = Fail.fail -#endif -instance Fail.MonadFail Q where - fail s = report True s >> Q (Fail.fail "Q monad failure") +instance MonadFail Q where + fail s = report True s >> Q (fail "Q monad failure") instance Functor Q where fmap f (Q x) = Q (fmap f x) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/69719d17e08272418eea0a13407aa72455bd9079 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/69719d17e08272418eea0a13407aa72455bd9079 You're receiving 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 Mar 26 14:16:39 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Thu, 26 Mar 2020 10:16:39 -0400 Subject: [Git][ghc/ghc][wip/T16296] Re-engineer the binder-swap transformation Message-ID: <5e7cb94722837_616713339fc47216d2@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T16296 at Glasgow Haskell Compiler / GHC Commits: 4d63f94c by Simon Peyton Jones at 2020-03-26T14:14:38+00: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 There's a 4.6% metric decrease here: Metric Decrease: T9961 - - - - - 19 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Op/OccurAnal.hs - compiler/GHC/Core/Op/Simplify.hs - compiler/GHC/Core/Op/Simplify/Utils.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Stg/CSE.hs - compiler/basicTypes/IdInfo.hs - compiler/basicTypes/MkId.hs - testsuite/tests/dependent/should_compile/dynamic-paper.stderr - testsuite/tests/simplCore/should_compile/T17901.stdout - testsuite/tests/simplCore/should_compile/T7360.hs - testsuite/tests/simplCore/should_compile/T7360.stderr Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -69,7 +69,7 @@ module GHC.Core ( maybeUnfoldingTemplate, otherCons, isValueUnfolding, isEvaldUnfolding, isCheapUnfolding, isExpandableUnfolding, isConLikeUnfolding, isCompulsoryUnfolding, - isStableUnfolding, isFragileUnfolding, hasSomeUnfolding, + isStableUnfolding, hasCoreUnfolding, hasSomeUnfolding, isBootUnfolding, canUnfold, neverUnfoldGuidance, isStableSource, @@ -1732,14 +1732,13 @@ neverUnfoldGuidance :: UnfoldingGuidance -> Bool neverUnfoldGuidance UnfNever = True neverUnfoldGuidance _ = False -isFragileUnfolding :: Unfolding -> Bool --- An unfolding is fragile if it mentions free variables or --- is otherwise subject to change. A robust one can be kept. --- See Note [Fragile unfoldings] -isFragileUnfolding (CoreUnfolding {}) = True -isFragileUnfolding (DFunUnfolding {}) = True -isFragileUnfolding _ = False - -- NoUnfolding, BootUnfolding, OtherCon are all non-fragile +hasCoreUnfolding :: Unfolding -> Bool +-- An unfolding "has Core" if it contains a Core expression, which +-- may mention free variables. See Note [Fragile unfoldings] +hasCoreUnfolding (CoreUnfolding {}) = True +hasCoreUnfolding (DFunUnfolding {}) = True +hasCoreUnfolding _ = False + -- NoUnfolding, BootUnfolding, OtherCon have no Core canUnfold :: Unfolding -> Bool canUnfold (CoreUnfolding { uf_guidance = g }) = not (neverUnfoldGuidance g) ===================================== compiler/GHC/Core/FVs.hs ===================================== @@ -35,7 +35,7 @@ module GHC.Core.FVs ( idFVs, idRuleVars, idRuleRhsVars, stableUnfoldingVars, ruleRhsFreeVars, ruleFreeVars, rulesFreeVars, - rulesFreeVarsDSet, + rulesFreeVarsDSet, mkRuleInfo, ruleLhsFreeIds, ruleLhsFreeIdsList, expr_fvs, @@ -469,6 +469,11 @@ rulesFVs = mapUnionFV ruleFVs rulesFreeVarsDSet :: [CoreRule] -> DVarSet rulesFreeVarsDSet rules = fvDVarSet $ rulesFVs 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 ===================================== compiler/GHC/Core/Op/OccurAnal.hs ===================================== @@ -14,10 +14,7 @@ core expression with (hopefully) improved usage information. {-# LANGUAGE CPP, BangPatterns, MultiWayIf, ViewPatterns #-} {-# OPTIONS_GHC -Wno-incomplete-record-updates #-} - -module GHC.Core.Op.OccurAnal ( - occurAnalysePgm, occurAnalyseExpr, occurAnalyseExpr_NoBinderSwap - ) where +module GHC.Core.Op.OccurAnal ( occurAnalysePgm, occurAnalyseExpr ) where #include "HsVersions.h" @@ -30,7 +27,6 @@ import GHC.Core.Utils ( exprIsTrivial, isDefaultAlt, isExpandableApp, import GHC.Core.Arity ( joinRhsArity ) import Id import IdInfo -import Name( localiseName ) import BasicTypes import Module( Module ) import GHC.Core.Coercion @@ -47,14 +43,14 @@ import Unique import UniqFM import UniqSet import Util +import Maybes( orElse, isJust ) import Outputable import Data.List -import Control.Arrow ( second ) {- ************************************************************************ * * - occurAnalysePgm, occurAnalyseExpr, occurAnalyseExpr_NoBinderSwap + occurAnalysePgm, occurAnalyseExpr * * ************************************************************************ @@ -92,8 +88,7 @@ occurAnalysePgm this_mod active_unf active_rule imp_rules binds -- a binding that was actually needed (albeit before its -- definition site). #17724 threw this up. - initial_uds = addManyOccsSet emptyDetails - (rulesFreeVars imp_rules) + initial_uds = addManyOccs emptyDetails (rulesFreeVars imp_rules) -- The RULES declarations keep things alive! -- Note [Preventing loops due to imported functions rules] @@ -117,17 +112,9 @@ occurAnalysePgm this_mod active_unf active_rule imp_rules binds bs_usage occurAnalyseExpr :: CoreExpr -> CoreExpr - -- Do occurrence analysis, and discard occurrence info returned -occurAnalyseExpr = occurAnalyseExpr' True -- do binder swap - -occurAnalyseExpr_NoBinderSwap :: CoreExpr -> CoreExpr -occurAnalyseExpr_NoBinderSwap = occurAnalyseExpr' False -- do not do binder swap - -occurAnalyseExpr' :: Bool -> CoreExpr -> CoreExpr -occurAnalyseExpr' enable_binder_swap expr - = snd (occAnal env expr) - where - env = initOccEnv { occ_binder_swap = enable_binder_swap } +-- Do occurrence analysis, and discard occurrence info returned +occurAnalyseExpr expr + = snd (occAnal initOccEnv expr) {- Note [Plugin rules] ~~~~~~~~~~~~~~~~~~~~~~ @@ -672,38 +659,66 @@ tail call with `n` arguments (counting both value and type arguments). Otherwise 'occ_tail' will be 'NoTailCallInfo'. The tail call info flows bottom-up with the rest of 'OccInfo' until it goes on the binder. -Note [Rules and join points] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [Join points and unfoldings/rules] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + let j2 y = blah + let j x = j2 (x+x) + {-# INLINE [2] j #-} + in case e of { A -> j 1; B -> ...; C -> j 2 } -Things get fiddly with rules. Suppose we have: +Before j is inlined, we'll have occurrences of j2 in +both j's RHS and in its stable unfolding. We want to discover +j2 as a join point. So we must do the adjustRhsUsage thing +on j's RHS. That's why we pass mb_join_arity to calcUnfolding. + +Aame with rules. Suppose we have: let j :: Int -> Int j y = 2 * y - k :: Int -> Int -> Int - {-# RULES "SPEC k 0" k 0 = j #-} + let k :: Int -> Int -> Int + {-# RULES "SPEC k 0" k 0 y = j y #-} k x y = x + 2 * y - in ... - -Now suppose that both j and k appear only as saturated tail calls in the body. -Thus we would like to make them both join points. The rule complicates matters, -though, as its RHS has an unapplied occurrence of j. *However*, if we were to -eta-expand the rule, all would be well: - - {-# RULES "SPEC k 0" forall a. k 0 a = j a #-} - -So conceivably we could notice that a potential join point would have an -"undersaturated" rule and account for it. This would mean we could make -something that's been specialised a join point, for instance. But local bindings -are rarely specialised, and being overly cautious about rules only -costs us anything when, for some `j`: + in case e of { A -> k 1 2; B -> k 3 5; C -> blah } + +We identify k as a join point, and we want j to be a join point too. +Without the RULE it would be, and we don't want the RULE to mess it +up. So provided the join-point arity of k matches the args of the +rule we can allow the tail-cal info from the RHS of the rule to +propagate. + +* Wrinkle for Rec case. In the recursive case we don't know the + join-point arity in advance, when calling occAnalUnfolding and + occAnalRules. (See makeNode.) We don't want to pass Nothing, + because then a recursive joinrec might lose its join-poin-hood + when SpecConstr adds a RULE. So we just make do with the + *current* join-poin-hood, stored in the Id. + + In the non-recursive case things are simple: see occAnalNonRecBind + +* Wrinkle for RULES. Suppose the example was a bit different: + let j :: Int -> Int + j y = 2 * y + k :: Int -> Int -> Int + {-# RULES "SPEC k 0" k 0 = j #-} + k x y = x + 2 * y + in ... + If we eta-expanded the rule all woudl be well, but as it stands the + one arg of the rule don't match the join-point arity of 2. + + Conceivably we could notice that a potential join point would have + an "undersaturated" rule and account for it. This would mean we + could make something that's been specialised a join point, for + instance. But local bindings are rarely specialised, and being + overly cautious about rules only costs us anything when, for some `j`: * Before specialisation, `j` has non-tail calls, so it can't be a join point. * During specialisation, `j` gets specialised and thus acquires rules. * Sometime afterward, the non-tail calls to `j` disappear (as dead code, say), and so now `j` *could* become a join point. -This appears to be very rare in practice. TODO Perhaps we should gather -statistics to be sure. + This appears to be very rare in practice. TODO Perhaps we should gather + statistics to be sure. ------------------------------------------------------------ Note [Adjusting right-hand sides] @@ -767,44 +782,62 @@ occAnalBind env lvl top_env (Rec pairs) body_usage ----------------- occAnalNonRecBind :: OccEnv -> TopLevelFlag -> ImpRuleEdges -> Var -> CoreExpr -> UsageDetails -> (UsageDetails, [CoreBind]) -occAnalNonRecBind env lvl imp_rule_edges binder rhs body_usage - | isTyVar binder -- A type let; we don't gather usage info - = (body_usage, [NonRec binder rhs]) +occAnalNonRecBind env lvl imp_rule_edges bndr rhs body_usage + | isTyVar bndr -- A type let; we don't gather usage info + = (body_usage, [NonRec bndr rhs]) - | not (binder `usedIn` body_usage) -- It's not mentioned + | not (bndr `usedIn` body_usage) -- It's not mentioned = (body_usage, []) | otherwise -- It's mentioned in the body - = (body_usage' `andUDs` rhs_usage', [NonRec tagged_binder rhs']) + = (body_usage' `andUDs` rhs_usage4, [NonRec final_bndr rhs']) where - (body_usage', tagged_binder) = tagNonRecBinder lvl body_usage binder - mb_join_arity = willBeJoinId_maybe tagged_binder + (body_usage', tagged_bndr) = tagNonRecBinder lvl body_usage bndr + occ = idOccInfo tagged_bndr - (bndrs, body) = collectBinders rhs + -- Get the join info from the *new* decision + -- See Note [Join points and unfoldings/rules] + mb_join_arity = willBeJoinId_maybe tagged_bndr + is_join_point = isJust mb_join_arity - (rhs_usage1, bndrs', body') = occAnalNonRecRhs env tagged_binder bndrs body - rhs' = mkLams (markJoinOneShots mb_join_arity bndrs') body' - -- For a /non-recursive/ join point we can mark all - -- its join-lambda as one-shot; and it's a good idea to do so + final_bndr = tagged_bndr `setIdUnfolding` unf' + `setIdSpecialisation` mkRuleInfo rules' + + env1 | is_join_point = env -- See Note [Join point RHSs] + | certainly_inline = env -- See Note [Cascading inlines] + | otherwise = rhsCtxt env + + -- See Note [Sources of one-shot information] + rhs_env = env1 { occ_one_shots = argOneShots dmd } + + (rhs_usage1, rhs') = occAnalRhs rhs_env mb_join_arity rhs -- Unfoldings -- See Note [Unfoldings and join points] - rhs_usage2 = case occAnalUnfolding env NonRecursive binder of - Just unf_usage -> rhs_usage1 `andUDs` unf_usage - Nothing -> rhs_usage1 + unf = idUnfolding bndr + (unf_usage, unf') = occAnalUnfolding rhs_env mb_join_arity unf + rhs_usage2 = rhs_usage1 `andUDs` unf_usage -- Rules -- See Note [Rules are extra RHSs] and Note [Rule dependency info] - rules_w_uds = occAnalRules env mb_join_arity NonRecursive tagged_binder + rules_w_uds = occAnalRules rhs_env mb_join_arity bndr rule_uds = map (\(_, l, r) -> l `andUDs` r) rules_w_uds + rules' = map fstOf3 rules_w_uds rhs_usage3 = foldr andUDs rhs_usage2 rule_uds - rhs_usage4 = case lookupVarEnv imp_rule_edges binder of + rhs_usage4 = case lookupVarEnv imp_rule_edges bndr of Nothing -> rhs_usage3 - Just vs -> addManyOccsSet rhs_usage3 vs + Just vs -> addManyOccs rhs_usage3 vs -- See Note [Preventing loops due to imported functions rules] - -- Final adjustment - rhs_usage' = adjustRhsUsage mb_join_arity NonRecursive bndrs' rhs_usage4 + certainly_inline -- See Note [Cascading inlines] + = case occ of + OneOcc { occ_in_lam = NotInsideLam, occ_one_br = InOneBranch } + -> active && not_stable + _ -> False + + dmd = idDemandInfo bndr + active = isAlwaysActive (idInlineActivation bndr) + not_stable = not (isStableUnfolding (idUnfolding bndr)) ----------------- occAnalRecBind :: OccEnv -> TopLevelFlag -> ImpRuleEdges -> [(Var,CoreExpr)] @@ -866,8 +899,8 @@ occAnalRec env lvl (CyclicSCC details_s) (body_uds, binds) | otherwise -- At this point we always build a single Rec = -- pprTrace "occAnalRec" (vcat - -- [ text "weak_fvs" <+> ppr weak_fvs - -- , text "lb nodes" <+> ppr loop_breaker_nodes]) + -- [ text "weak_fvs" <+> ppr weak_fvs + -- , text "lb nodes" <+> ppr loop_breaker_nodes]) (final_uds, Rec pairs : binds) where @@ -931,10 +964,10 @@ recording inlinings for any Ids which aren't marked as "no-inline" as it goes. -- Return the bindings sorted into a plausible order, and marked with loop breakers. loopBreakNodes depth bndr_set weak_fvs nodes binds = -- pprTrace "loopBreakNodes" (ppr nodes) $ - go (stronglyConnCompFromEdgedVerticesUniqR nodes) binds + go (stronglyConnCompFromEdgedVerticesUniqR nodes) where - go [] binds = binds - go (scc:sccs) binds = loop_break_scc scc (go sccs binds) + go [] = binds + go (scc:sccs) = loop_break_scc scc (go sccs) loop_break_scc scc binds = case scc of @@ -949,7 +982,7 @@ reOrderNodes _ _ _ [] _ = panic "reOrderNodes" reOrderNodes _ _ _ [node] binds = mk_loop_breaker node : binds reOrderNodes depth bndr_set weak_fvs (node : nodes) binds = -- pprTrace "reOrderNodes" (vcat [ text "unchosen" <+> ppr unchosen - -- , text "chosen" <+> ppr chosen_nodes ]) $ + -- , text "chosen" <+> ppr chosen_nodes ]) $ loopBreakNodes new_depth bndr_set weak_fvs unchosen $ (map mk_loop_breaker chosen_nodes ++ binds) where @@ -1148,7 +1181,9 @@ type LetrecNode = Node Unique Details -- Node comes from Digraph -- The Unique key is gotten from the Id data Details = ND { nd_bndr :: Id -- Binder + , nd_rhs :: CoreExpr -- RHS, already occ-analysed + , nd_rhs_bndrs :: [CoreBndr] -- Outer lambdas of RHS -- INVARIANT: (nd_rhs_bndrs nd, _) == -- collectBinders (nd_rhs nd) @@ -1205,7 +1240,7 @@ makeNode env imp_rule_edges bndr_set (bndr, rhs) -- is still deterministic with edges in nondeterministic order as -- explained in Note [Deterministic SCC] in Digraph. where - details = ND { nd_bndr = bndr + details = ND { nd_bndr = bndr' , nd_rhs = rhs' , nd_rhs_bndrs = bndrs' , nd_uds = rhs_usage3 @@ -1214,24 +1249,35 @@ makeNode env imp_rule_edges bndr_set (bndr, rhs) , nd_active_rule_fvs = active_rule_fvs , nd_score = pprPanic "makeNodeDetails" (ppr bndr) } + bndr' = bndr `setIdUnfolding` unf' + `setIdSpecialisation` mkRuleInfo rules' + + -- Get join point info from the *current* decision + -- We don't know what the new decision will be! + -- Using the old decision at least allows us to + -- preserve existing join point, even RULEs are added + -- See Note [Join points and unfoldings/rules] + mb_join_arity = isJoinId_maybe bndr + -- Constructing the edges for the main Rec computation -- See Note [Forming Rec groups] (bndrs, body) = collectBinders rhs - (rhs_usage1, bndrs', body') = occAnalRecRhs env bndrs body - rhs' = mkLams bndrs' body' - rhs_usage2 = foldr andUDs rhs_usage1 rule_uds + rhs_env = rhsCtxt env + (rhs_usage1, bndrs', body') = occAnalLamOrRhs rhs_env bndrs body + rhs' = mkLams bndrs' body' + rhs_usage3 = foldr andUDs rhs_usage1 rule_uds + `andUDs` unf_uds -- Note [Rules are extra RHSs] -- Note [Rule dependency info] - rhs_usage3 = case mb_unf_uds of - Just unf_uds -> rhs_usage2 `andUDs` unf_uds - Nothing -> rhs_usage2 - node_fvs = udFreeVars bndr_set rhs_usage3 + node_fvs = udFreeVars bndr_set rhs_usage3 -- Finding the free variables of the rules is_active = occ_rule_act env :: Activation -> Bool rules_w_uds :: [(CoreRule, UsageDetails, UsageDetails)] - rules_w_uds = occAnalRules env (Just (length bndrs)) Recursive bndr + rules_w_uds = occAnalRules rhs_env mb_join_arity bndr + + rules' = map fstOf3 rules_w_uds rules_w_rhs_fvs :: [(Activation, VarSet)] -- Find the RHS fvs rules_w_rhs_fvs = maybe id (\ids -> ((AlwaysActive, ids):)) @@ -1244,16 +1290,20 @@ makeNode env imp_rule_edges bndr_set (bndr, rhs) , is_active a] -- Finding the usage details of the INLINE pragma (if any) - mb_unf_uds = occAnalUnfolding env Recursive bndr + unf = realIdUnfolding bndr -- realIdUnfolding: Ignore loop-breaker-ness + -- here because that is what we are setting! + (unf_uds, unf') = occAnalUnfolding rhs_env mb_join_arity unf -- Find the "nd_inl" free vars; for the loop-breaker phase - inl_fvs = case mb_unf_uds of - Nothing -> udFreeVars bndr_set rhs_usage1 -- No INLINE, use RHS - Just unf_uds -> udFreeVars bndr_set unf_uds - -- We could check for an *active* INLINE (returning - -- emptyVarSet for an inactive one), but is_active - -- isn't the right thing (it tells about - -- RULE activation), so we'd need more plumbing + -- These are the vars that would become free if the function + -- was inlinined; usually that means the RHS, unless the + -- unfolding is a stable one. + -- Note: We could do this only for functions with an *active* unfolding + -- (returning emptyVarSet for an inactive one), but is_active + -- isn't the right thing (it tells about RULE activation), + -- so we'd need more plumbing + inl_fvs | isStableUnfolding unf = udFreeVars bndr_set unf_uds + | otherwise = udFreeVars bndr_set rhs_usage1 mkLoopBreakerNodes :: OccEnv -> TopLevelFlag -> VarSet @@ -1271,22 +1321,24 @@ mkLoopBreakerNodes :: OccEnv -> TopLevelFlag mkLoopBreakerNodes env lvl bndr_set body_uds details_s = (final_uds, zipWith mk_lb_node details_s bndrs') where - (final_uds, bndrs') = tagRecBinders lvl body_uds - [ ((nd_bndr nd) - ,(nd_uds nd) - ,(nd_rhs_bndrs nd)) - | nd <- details_s ] - mk_lb_node nd@(ND { nd_bndr = bndr, nd_rhs = rhs, nd_inl = inl_fvs }) bndr' - = DigraphNode nd' (varUnique bndr) (nonDetKeysUniqSet lb_deps) + (final_uds, bndrs') + = tagRecBinders lvl body_uds + [ (bndr, uds, rhs_bndrs) + | ND { nd_bndr = bndr, nd_uds = uds, nd_rhs_bndrs = rhs_bndrs } + <- details_s ] + + mk_lb_node nd@(ND { nd_bndr = old_bndr, nd_inl = inl_fvs }) new_bndr + = DigraphNode nd' (varUnique old_bndr) (nonDetKeysUniqSet lb_deps) -- It's OK to use nonDetKeysUniqSet here as -- stronglyConnCompFromEdgedVerticesR is still deterministic with edges -- in nondeterministic order as explained in -- Note [Deterministic SCC] in Digraph. where - nd' = nd { nd_bndr = bndr', nd_score = score } - score = nodeScore env bndr bndr' rhs lb_deps + nd' = nd { nd_bndr = new_bndr, nd_score = score } + score = nodeScore env new_bndr lb_deps nd lb_deps = extendFvs_ rule_fv_env inl_fvs + rule_fv_env :: IdEnv IdSet -- Maps a variable f to the variables from this group -- mentioned in RHS of active rules for f @@ -1301,12 +1353,13 @@ mkLoopBreakerNodes env lvl bndr_set body_uds details_s ------------------------------------------ nodeScore :: OccEnv - -> Id -- Binder has old occ-info (just for loop-breaker-ness) -> Id -- Binder with new occ-info - -> CoreExpr -- RHS -> VarSet -- Loop-breaker dependencies + -> Details -> NodeScore -nodeScore env old_bndr new_bndr bind_rhs lb_deps +nodeScore env new_bndr lb_deps + (ND { nd_bndr = old_bndr, nd_rhs = bind_rhs }) + | not (isId old_bndr) -- A type or coercion variable is never a loop breaker = (100, 0, False) @@ -1324,7 +1377,7 @@ nodeScore env old_bndr new_bndr bind_rhs lb_deps -- where df is the exported dictionary. Then df makes a really -- bad choice for loop breaker - | DFunUnfolding { df_args = args } <- id_unfolding + | DFunUnfolding { df_args = args } <- old_unf -- Never choose a DFun as a loop breaker -- Note [DFuns should not be loop breakers] = (9, length args, is_lb) @@ -1332,13 +1385,13 @@ nodeScore env old_bndr new_bndr bind_rhs lb_deps -- Data structures are more important than INLINE pragmas -- so that dictionary/method recursion unravels - | CoreUnfolding { uf_guidance = UnfWhen {} } <- id_unfolding + | CoreUnfolding { uf_guidance = UnfWhen {} } <- old_unf = mk_score 6 | is_con_app rhs -- Data types help with cases: = mk_score 5 -- Note [Constructor applications] - | isStableUnfolding id_unfolding + | isStableUnfolding old_unf , can_unfold = mk_score 3 @@ -1355,23 +1408,23 @@ nodeScore env old_bndr new_bndr bind_rhs lb_deps mk_score :: Int -> NodeScore mk_score rank = (rank, rhs_size, is_lb) - is_lb = isStrongLoopBreaker (idOccInfo old_bndr) - rhs = case id_unfolding of - CoreUnfolding { uf_src = src, uf_tmpl = unf_rhs } - | isStableSource src - -> unf_rhs - _ -> bind_rhs + -- is_lb: see Note [Loop breakers, node scoring, and stability] + is_lb = isStrongLoopBreaker (idOccInfo old_bndr) + + old_unf = realIdUnfolding old_bndr + can_unfold = canUnfold old_unf + rhs = case old_unf of + CoreUnfolding { uf_src = src, uf_tmpl = unf_rhs } + | isStableSource src + -> unf_rhs + _ -> bind_rhs -- 'bind_rhs' is irrelevant for inlining things with a stable unfolding - rhs_size = case id_unfolding of + rhs_size = case old_unf of CoreUnfolding { uf_guidance = guidance } | UnfIfGoodArgs { ug_size = size } <- guidance -> size _ -> cheapExprSize rhs - can_unfold = canUnfold id_unfolding - id_unfolding = realIdUnfolding old_bndr - -- realIdUnfolding: Ignore loop-breaker-ness here because - -- that is what we are setting! -- Checking for a constructor application -- Cheap and cheerful; the simplifier moves casts out of the way @@ -1508,108 +1561,84 @@ Hence the is_lb field of NodeScore ************************************************************************ -} -occAnalRhs :: OccEnv -> RecFlag -> Id -> [CoreBndr] -> CoreExpr - -> (UsageDetails, [CoreBndr], CoreExpr) - -- Returned usage details covers only the RHS, - -- and *not* the RULE or INLINE template for the Id -occAnalRhs env Recursive _ bndrs body - = occAnalRecRhs env bndrs body -occAnalRhs env NonRecursive id bndrs body - = occAnalNonRecRhs env id bndrs body - -occAnalRecRhs :: OccEnv -> [CoreBndr] -> CoreExpr -- Rhs lambdas, body - -> (UsageDetails, [CoreBndr], CoreExpr) - -- Returned usage details covers only the RHS, - -- and *not* the RULE or INLINE template for the Id -occAnalRecRhs env bndrs body = occAnalLamOrRhs (rhsCtxt env) bndrs body - -occAnalNonRecRhs :: OccEnv - -> Id -> [CoreBndr] -> CoreExpr -- Binder; rhs lams, body - -- Binder is already tagged with occurrence info - -> (UsageDetails, [CoreBndr], CoreExpr) - -- Returned usage details covers only the RHS, - -- and *not* the RULE or INLINE template for the Id -occAnalNonRecRhs env bndr bndrs body - = occAnalLamOrRhs rhs_env bndrs body +occAnalRhs :: OccEnv -> Maybe JoinArity + -> CoreExpr -- RHS + -> (UsageDetails, CoreExpr) +occAnalRhs env mb_join_arity rhs + = (rhs_usage, rhs') where - env1 | is_join_point = env -- See Note [Join point RHSs] - | certainly_inline = env -- See Note [Cascading inlines] - | otherwise = rhsCtxt env - - -- See Note [Sources of one-shot information] - rhs_env = env1 { occ_one_shots = argOneShots dmd } - - certainly_inline -- See Note [Cascading inlines] - = case occ of - OneOcc { occ_in_lam = NotInsideLam, occ_one_br = InOneBranch } - -> active && not_stable - _ -> False - - is_join_point = isAlwaysTailCalled occ - -- Like (isJoinId bndr) but happens one step earlier - -- c.f. willBeJoinId_maybe + (bndrs, body) = collectBinders rhs + (body_usage, bndrs', body') = occAnalLamOrRhs env bndrs body + rhs' = mkLams (markJoinOneShots mb_join_arity bndrs') body' + -- For a /non-recursive/ join point we can mark all + -- its join-lambda as one-shot; and it's a good idea to do so - occ = idOccInfo bndr - dmd = idDemandInfo bndr - active = isAlwaysActive (idInlineActivation bndr) - not_stable = not (isStableUnfolding (idUnfolding bndr)) + -- Final adjustment + rhs_usage = adjustRhsUsage mb_join_arity NonRecursive bndrs' body_usage occAnalUnfolding :: OccEnv - -> RecFlag - -> Id - -> Maybe UsageDetails - -- Just the analysis, not a new unfolding. The unfolding - -- got analysed when it was created and we don't need to - -- update it. -occAnalUnfolding env rec_flag id - = case realIdUnfolding id of -- ignore previous loop-breaker flag - CoreUnfolding { uf_tmpl = rhs, uf_src = src } - | not (isStableSource src) - -> Nothing - | otherwise - -> Just $ markAllMany usage + -> Maybe JoinArity -- See Note [Join points and unfoldings/rules] + -> Unfolding + -> (UsageDetails, Unfolding) +-- Occurrence-analyse a stable unfolding; +-- discard a non-stable one altogether. +occAnalUnfolding env mb_join_arity unf + = case unf of + unf@(CoreUnfolding { uf_tmpl = rhs, uf_src = src }) + | isStableSource src -> (usage, unf') + | otherwise -> (emptyDetails, unf) + where -- For non-Stable unfoldings we leave them undisturbed, but + -- don't count their usage because the simplifier will discard them. + -- We leave them undisturbed because nodeScore uses their size info + -- to guide its decisions. It's ok to leave un-substituted + -- expressions in the tree because all the variables that were in + -- scope remain in scope; there is no cloning etc. + (usage, rhs') = occAnalRhs env mb_join_arity rhs + + unf' | noBinderSwaps env = unf -- Note [Unfoldings and rules] + | otherwise = unf { uf_tmpl = rhs' } + + unf@(DFunUnfolding { df_bndrs = bndrs, df_args = args }) + -> ( final_usage, unf { df_args = args' } ) where - (bndrs, body) = collectBinders rhs - (usage, _, _) = occAnalRhs env rec_flag id bndrs body + env' = env `addInScope` bndrs + (usage, args') = occAnalList env' args + final_usage = zapDetails (delDetailsList usage bndrs) - DFunUnfolding { df_bndrs = bndrs, df_args = args } - -> Just $ zapDetails (delDetailsList usage bndrs) - where - usage = andUDsList (map (fst . occAnal env) args) - - _ -> Nothing + unf -> (emptyDetails, unf) occAnalRules :: OccEnv - -> Maybe JoinArity -- If the binder is (or MAY become) a join - -- point, what its join arity is (or WOULD - -- become). See Note [Rules and join points]. - -> RecFlag - -> Id + -> Maybe JoinArity -- See Note [Join points and unfoldings/rules] + -> Id -- Get rules from here -> [(CoreRule, -- Each (non-built-in) rule UsageDetails, -- Usage details for LHS UsageDetails)] -- Usage details for RHS -occAnalRules env mb_expected_join_arity rec_flag id - = [ (rule, lhs_uds, rhs_uds) | rule at Rule {} <- idCoreRules id - , let (lhs_uds, rhs_uds) = occ_anal_rule rule ] +occAnalRules env mb_join_arity bndr + = map occ_anal_rule (idCoreRules bndr) where - occ_anal_rule (Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs }) - = (lhs_uds, final_rhs_uds) + occ_anal_rule rule@(Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs }) + = (rule', lhs_uds', rhs_uds') where - lhs_uds = addManyOccsSet emptyDetails $ - (exprsFreeVars args `delVarSetList` bndrs) - (rhs_bndrs, rhs_body) = collectBinders rhs - (rhs_uds, _, _) = occAnalRhs env rec_flag id rhs_bndrs rhs_body + env' = env `addInScope` bndrs + rule' | noBinderSwaps env = rule -- Note [Unfoldings and rules] + | otherwise = rule { ru_args = args', ru_rhs = rhs' } + + (lhs_uds, args') = occAnalList env' args + lhs_uds' = markAllMany $ + lhs_uds `delDetailsList` bndrs + + (rhs_uds, rhs') = occAnal env' rhs -- Note [Rules are extra RHSs] -- Note [Rule dependency info] - final_rhs_uds = adjust_tail_info args $ markAllMany $ - (rhs_uds `delDetailsList` bndrs) - occ_anal_rule _ - = (emptyDetails, emptyDetails) - - adjust_tail_info args uds -- see Note [Rules and join points] - = case mb_expected_join_arity of - Just ar | args `lengthIs` ar -> uds - _ -> markAllNonTailCalled uds + rhs_uds' = markAllNonTailCalledIf (not exact_join) $ + markAllMany $ + rhs_uds `delDetailsList` bndrs + + exact_join = exactJoin mb_join_arity args + -- See Note [Join points and unfoldings/rules] + + occ_anal_rule other_rule = (other_rule, emptyDetails, emptyDetails) + {- Note [Join point RHSs] ~~~~~~~~~~~~~~~~~~~~~~~~~ Consider @@ -1622,6 +1651,19 @@ the FloatIn pass knows to float into join point RHSs; and the simplifier does not float things out of join point RHSs. But it's a simple, cheap thing to do. See #14137. +Note [Unfoldings and rules] +~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Generally unfoldings and rules are already occurrence-analysed, so we +don't want to reconstruct their trees; we just want to analyse them to +find how they use their free variables. + +EXCEPT if there is a binder-swap going on, in which case we do want to +produce a new tree. + +So we have a fast-path that keeps the old tree if the occ_bs_env is +empty. This just saves a bit of allocation and reconstruction; not +a big deal. + Note [Cascading inlines] ~~~~~~~~~~~~~~~~~~~~~~~~ By default we use an rhsCtxt for the RHS of a binding. This tells the @@ -1674,6 +1716,12 @@ for the various clauses. ************************************************************************ -} +occAnalList :: OccEnv -> [CoreExpr] -> (UsageDetails, [CoreExpr]) +occAnalList _ [] = (emptyDetails, []) +occAnalList env (e:es) = case occAnal env e of { (uds1, e') -> + case occAnalList env es of { (uds2, es') -> + (uds1 `andUDs` uds2, e' : es') } } + occAnal :: OccEnv -> CoreExpr -> (UsageDetails, -- Gives info only about the "interesting" Ids @@ -1690,7 +1738,7 @@ occAnal env expr@(Var _) = occAnalApp env (expr, [], []) -- weren't used at all. occAnal _ (Coercion co) - = (addManyOccsSet emptyDetails (coVarsOfCo co), Coercion co) + = (addManyOccs emptyDetails (coVarsOfCo co), Coercion co) -- See Note [Gather occurrences of coercion variables] {- @@ -1711,7 +1759,7 @@ occAnal env (Tick tickish body) = (markAllNonTailCalled usage, Tick tickish body') | Breakpoint _ ids <- tickish - = (usage_lam `andUDs` foldr addManyOccs emptyDetails ids, Tick tickish body') + = (usage_lam `andUDs` foldr addManyOcc emptyDetails ids, Tick tickish body') -- never substitute for any of the Ids in a Breakpoint | otherwise @@ -1734,7 +1782,7 @@ occAnal env (Cast expr co) -- usage1: if we see let x = y `cast` co -- then mark y as 'Many' so that we don't -- immediately inline y again. - usage2 = addManyOccsSet usage1 (coVarsOfCo co) + usage2 = addManyOccs usage1 (coVarsOfCo co) -- usage2: see Note [Gather occurrences of coercion variables] in (markAllNonTailCalled usage2, Cast expr' co) } @@ -1762,21 +1810,23 @@ occAnal env (Lam x body) -- Then, the simplifier is careful when partially applying lambdas. occAnal env expr@(Lam _ _) - = case occAnalLamOrRhs env binders body of { (usage, tagged_binders, body') -> + = case occAnalLamOrRhs env bndrs body of { (usage, tagged_bndrs, body') -> let - expr' = mkLams tagged_binders body' + expr' = mkLams tagged_bndrs body' usage1 = markAllNonTailCalled usage - one_shot_gp = all isOneShotBndr tagged_binders - final_usage | one_shot_gp = usage1 - | otherwise = markAllInsideLam usage1 + one_shot_gp = all isOneShotBndr tagged_bndrs + final_usage = markAllInsideLamIf (not one_shot_gp) usage1 in (final_usage, expr') } where - (binders, body) = collectBinders expr + (bndrs, body) = collectBinders expr occAnal env (Case scrut bndr ty alts) - = case occ_anal_scrut scrut alts of { (scrut_usage, scrut') -> - case mapAndUnzip occ_anal_alt alts of { (alts_usage_s, alts') -> + = case occAnal (scrutCtxt env alts) scrut of { (scrut_usage, scrut') -> + let alt_env = addBndrSwap scrut' bndr $ + env { occ_encl = OccVanilla } `addInScope` [bndr] + in + case mapAndUnzip (occAnalAlt alt_env) alts of { (alts_usage_s, alts') -> let alts_usage = foldr orUDs emptyDetails alts_usage_s (alts_usage1, tagged_bndr) = tagLamBinder alts_usage bndr @@ -1784,27 +1834,10 @@ occAnal env (Case scrut bndr ty alts) -- Alts can have tail calls, but the scrutinee can't in total_usage `seq` (total_usage, Case scrut' tagged_bndr ty alts') }} - where - alt_env = mkAltEnv env scrut bndr - occ_anal_alt = occAnalAlt alt_env - - occ_anal_scrut (Var v) (alt1 : other_alts) - | not (null other_alts) || not (isDefaultAlt alt1) - = (mkOneOcc env v IsInteresting 0, Var v) - -- The 'True' says that the variable occurs in an interesting - -- context; the case has at least one non-default alternative - occ_anal_scrut (Tick t e) alts - | t `tickishScopesLike` SoftScope - -- No reason to not look through all ticks here, but only - -- for soft-scoped ticks we can do so without having to - -- update returned occurrence info (see occAnal) - = second (Tick t) $ occ_anal_scrut e alts - - occ_anal_scrut scrut _alts - = occAnal (vanillaCtxt env) scrut -- No need for rhsCtxt occAnal env (Let bind body) - = case occAnal env body of { (body_usage, body') -> + = case occAnal (env `addInScope` bindersOf bind) + body of { (body_usage, body') -> case occAnalBind env NotTopLevel noImpRuleEdges bind body_usage of { (final_usage, new_binds) -> @@ -1845,17 +1878,22 @@ Constructors are rather like lambdas in this way. occAnalApp :: OccEnv -> (Expr CoreBndr, [Arg CoreBndr], [Tickish Id]) -> (UsageDetails, Expr CoreBndr) +-- Naked variables (not applied) end up here too occAnalApp env (Var fun, args, ticks) - | null ticks = (uds, mkApps (Var fun) args') - | otherwise = (uds, mkTicks ticks $ mkApps (Var fun) args') + | null ticks = (all_uds, mkApps fun' args') + | otherwise = (all_uds, mkTicks ticks $ mkApps fun' args') where - uds = fun_uds `andUDs` final_args_uds + (fun', fun_id') = lookupVarEnv (occ_bs_env env) fun + `orElse` (Var fun, fun) + -- See Note [The binder-swap substitution] + + 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 - !final_args_uds - | isRhsEnv env && is_exp = markAllNonTailCalled $ - markAllInsideLam args_uds - | otherwise = markAllNonTailCalled args_uds + !final_args_uds = markAllNonTailCalled $ + markAllInsideLamIf (isRhsEnv env && is_exp) $ + args_uds -- We mark the free vars of the argument of a constructor or PAP -- as "inside-lambda", if it is the RHS of a let(rec). -- This means that nothing gets inlined into a constructor or PAP @@ -1868,7 +1906,11 @@ occAnalApp env (Var fun, args, ticks) n_val_args = valArgCount args n_args = length args - fun_uds = mkOneOcc env fun (if n_val_args > 0 then IsInteresting else NotInteresting) n_args + int_cxt = case occ_encl env of + OccScrut -> IsInteresting + _other | n_val_args > 0 -> IsInteresting + | otherwise -> NotInteresting + is_exp = isExpandableApp fun n_val_args -- See Note [CONLIKE pragma] in BasicTypes -- The definition of is_exp should match that in GHC.Core.Op.Simplify.prepareRhs @@ -1891,11 +1933,6 @@ occAnalApp env (fun, args, ticks) -- onto the context stack. !(args_uds, args') = occAnalArgs env args [] -zapDetailsIf :: Bool -- If this is true - -> UsageDetails -- Then do zapDetails on this - -> UsageDetails -zapDetailsIf True uds = zapDetails uds -zapDetailsIf False uds = uds {- Note [Sources of one-shot information] @@ -1987,9 +2024,12 @@ scrutinised y). occAnalLamOrRhs :: OccEnv -> [CoreBndr] -> CoreExpr -> (UsageDetails, [CoreBndr], CoreExpr) +-- Tags the returned binders with their OccInfo, but does +-- not do any markInsideLam to the returned usage details occAnalLamOrRhs env [] body = case occAnal env body of (body_usage, body') -> (body_usage, [], body') -- RHS of thunk or nullary join point + occAnalLamOrRhs env (bndr:bndrs) body | isTyVar bndr = -- Important: Keep the environment so that we don't inline into an RHS like @@ -1997,6 +2037,7 @@ occAnalLamOrRhs env (bndr:bndrs) body -- (see the beginning of Note [Cascading inlines]). case occAnalLamOrRhs env bndrs body of (body_usage, bndrs', body') -> (body_usage, bndr:bndrs', body') + occAnalLamOrRhs env binders body = case occAnal env_body body of { (body_usage, body') -> let @@ -2005,47 +2046,17 @@ occAnalLamOrRhs env binders body in (final_usage, tagged_binders, body') } where - (env_body, binders') = oneShotGroup env binders + env1 = env `addInScope` binders + (env_body, binders') = oneShotGroup env1 binders -occAnalAlt :: (OccEnv, Maybe (Id, CoreExpr)) - -> CoreAlt - -> (UsageDetails, Alt IdWithOccInfo) -occAnalAlt (env, scrut_bind) (con, bndrs, rhs) - = case occAnal env rhs of { (rhs_usage1, rhs1) -> +occAnalAlt :: OccEnv -> CoreAlt -> (UsageDetails, Alt IdWithOccInfo) +occAnalAlt env (con, bndrs, rhs) + = case occAnal (env `addInScope` bndrs) rhs of { (rhs_usage1, rhs1) -> let (alt_usg, tagged_bndrs) = tagLamBinders rhs_usage1 bndrs - -- See Note [Binders in case alternatives] - (alt_usg', rhs2) = wrapAltRHS env scrut_bind alt_usg tagged_bndrs rhs1 - in - (alt_usg', (con, tagged_bndrs, rhs2)) } - -wrapAltRHS :: OccEnv - -> Maybe (Id, CoreExpr) -- proxy mapping generated by mkAltEnv - -> UsageDetails -- usage for entire alt (p -> rhs) - -> [Var] -- alt binders - -> CoreExpr -- alt RHS - -> (UsageDetails, CoreExpr) -wrapAltRHS env (Just (scrut_var, let_rhs)) alt_usg bndrs alt_rhs - | occ_binder_swap env - , scrut_var `usedIn` alt_usg -- bndrs are not be present in alt_usg so this - -- handles condition (a) in Note [Binder swap] - , not captured -- See condition (b) in Note [Binder swap] - = ( alt_usg' `andUDs` let_rhs_usg - , Let (NonRec tagged_scrut_var let_rhs') alt_rhs ) - where - captured = any (`usedIn` let_rhs_usg) bndrs -- Check condition (b) - - -- The rhs of the let may include coercion variables - -- if the scrutinee was a cast, so we must gather their - -- usage. See Note [Gather occurrences of coercion variables] - -- Moreover, the rhs of the let may mention the case-binder, and - -- we want to gather its occ-info as well - (let_rhs_usg, let_rhs') = occAnal env let_rhs - - (alt_usg', tagged_scrut_var) = tagLamBinder alt_usg scrut_var + in -- See Note [Binders in case alternatives] + (alt_usg, (con, tagged_bndrs, rhs1)) } -wrapAltRHS _ _ alt_usg _ alt_rhs - = (alt_usg, alt_rhs) {- ************************************************************************ @@ -2058,18 +2069,17 @@ wrapAltRHS _ _ alt_usg _ alt_rhs data OccEnv = OccEnv { occ_encl :: !OccEncl -- Enclosing context information , occ_one_shots :: !OneShots -- See Note [OneShots] - , occ_gbl_scrut :: GlobalScruts - - , occ_unf_act :: Id -> Bool -- Which Id unfoldings are active - - , occ_rule_act :: Activation -> Bool -- Which rules are active + , 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] - , occ_binder_swap :: !Bool -- enable the binder_swap - -- See CorePrep Note [Dead code in CorePrep] + -- 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 } -type GlobalScruts = IdSet -- See Note [Binder swap on GlobalId scrutinees] ----------------------------- -- OccEncl is used to control whether to inline into constructor arguments @@ -2079,15 +2089,22 @@ type GlobalScruts = IdSet -- See Note [Binder swap on GlobalId scrutinees] -- z = f (p,q) -- Do inline p,q; it may make a rule fire -- So OccEncl tells enough about the context to know what to do when -- we encounter a constructor application or PAP. +-- +-- OccScrut is used to set the "interesting context" field of OncOcc data OccEncl - = OccRhs -- RHS of let(rec), albeit perhaps inside a type lambda - -- Don't inline into constructor args here - | OccVanilla -- Argument of function, body of lambda, scruintee of case etc. - -- Do inline into constructor args here + = OccRhs -- RHS of let(rec), albeit perhaps inside a type lambda + -- Don't inline into constructor args here + + | OccScrut -- Scrutintee of a case + -- Can inline into constructor args + + | OccVanilla -- Argument of function, body of lambda, etc + -- Do inline into constructor args here instance Outputable OccEncl where ppr OccRhs = text "occRhs" + ppr OccScrut = text "occScrut" ppr OccVanilla = text "occVanilla" -- See note [OneShots] @@ -2097,15 +2114,30 @@ initOccEnv :: OccEnv initOccEnv = OccEnv { occ_encl = OccVanilla , occ_one_shots = [] - , occ_gbl_scrut = emptyVarSet + -- To be conservative, we say that all -- inlines and rules are active , occ_unf_act = \_ -> True , occ_rule_act = \_ -> True - , occ_binder_swap = True } -vanillaCtxt :: OccEnv -> OccEnv -vanillaCtxt env = env { occ_encl = OccVanilla, occ_one_shots = [] } + , occ_bs_env = emptyVarEnv + , occ_bs_rng = emptyVarSet } + +noBinderSwaps :: OccEnv -> Bool +noBinderSwaps (OccEnv { occ_bs_env = bs_env }) = isEmptyVarEnv bs_env + +scrutCtxt :: OccEnv -> [CoreAlt] -> OccEnv +scrutCtxt env alts + | interesting_alts = env { occ_encl = OccScrut, occ_one_shots = [] } + | otherwise = env { occ_encl = OccVanilla, occ_one_shots = [] } + where + interesting_alts = case alts of + [] -> False + [alt] -> not (isDefaultAlt alt) + _ -> True + -- 'interesting_alts' is True if the case has at least one + -- non-default alternative. That in turn influences + -- pre/postInlineUnconditionally. Grep for "occ_int_cxt"! rhsCtxt :: OccEnv -> OccEnv rhsCtxt env = env { occ_encl = OccRhs, occ_one_shots = [] } @@ -2117,8 +2149,15 @@ argCtxt env (one_shots:one_shots_s) = (env { occ_encl = OccVanilla, occ_one_shots = one_shots }, one_shots_s) isRhsEnv :: OccEnv -> Bool -isRhsEnv (OccEnv { occ_encl = OccRhs }) = True -isRhsEnv (OccEnv { occ_encl = OccVanilla }) = False +isRhsEnv (OccEnv { occ_encl = cxt }) = case cxt of + OccRhs -> True + _ -> False + +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_bs_rng = emptyVarSet } + | otherwise = env { occ_bs_env = swap_env `delVarEnvList` bndrs } oneShotGroup :: OccEnv -> [CoreBndr] -> ( OccEnv @@ -2222,14 +2261,14 @@ scrutinee of a case for occurrences of the case-binder: (1) case x of b { pi -> ri } ==> - case x of b { pi -> let x=b in ri } + case x of b { pi -> ri[b/x] } (2) case (x |> co) of b { pi -> ri } ==> - case (x |> co) of b { pi -> let x = b |> sym co in ri } + case (x |> co) of b { pi -> ri[b |> sym co/x] } -In both cases, the trivial 'let' can be eliminated by the -immediately following simplifier pass. +The substitution ri[b/x] etc is done by the occurrence analyser. +See Note [The binder-swap substitution]. There are two reasons for making this swap: @@ -2257,20 +2296,6 @@ There are two reasons for making this swap: The same can happen even if the scrutinee is a variable with a cast: see Note [Case of cast] -In both cases, in a particular alternative (pi -> ri), we only -add the binding if - (a) x occurs free in (pi -> ri) - (ie it occurs in ri, but is not bound in pi) - (b) the pi does not bind b (or the free vars of co) -We need (a) and (b) for the inserted binding to be correct. - -For the alternatives where we inject the binding, we can transfer -all x's OccInfo to b. And that is the point. - -Notice that - * The deliberate shadowing of 'x'. - * That (a) rapidly becomes false, so no bindings are injected. - The reason for doing these transformations /here in the occurrence analyser/ is because it allows us to adjust the OccInfo for 'x' and 'b' as we go. @@ -2279,15 +2304,9 @@ analyser/ is because it allows us to adjust the OccInfo for 'x' and ri; then this transformation makes it occur just once, and hence get inlined right away. - * If instead we do this in the Simplifier, we don't know whether 'x' - is used in ri, so we are forced to pessimistically zap b's OccInfo - even though it is typically dead (ie neither it nor x appear in - the ri). There's nothing actually wrong with zapping it, except - that it's kind of nice to know which variables are dead. My nose - tells me to keep this information as robustly as possible. - -The Maybe (Id,CoreExpr) passed to occAnalAlt is the extra let-binding -{x=b}; it's Nothing if the binder-swap doesn't happen. + * If instead the Simplifier replaces occurrences of x with + occurrences of b, that will mess up b's occurrence info. That in + turn might have consequences. There is a danger though. Consider let v = x +# y @@ -2299,6 +2318,75 @@ same simplifier pass that reduced (f v) to v. I think this is just too bad. CSE will recover some of it. +Note [The binder-swap substitution] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The binder-swap is implemented by the occ_bs_env field of OccEnv. +Given case x |> co of b { alts } +we add [x :-> (b |> sym co)] to the occ_bs_env environment; this is +done by addBndrSwap. Then, at an occurrence of a variable, we look +up in the occ_bs_env to perform the swap. See occAnalApp. + +Some tricky corners: + +* We do the substitution before gathering occurrence info. So in + the above example, an occurrence of x turns into an occurrence + of b, and that's what we gather in the UsageDetails. It's as + if the binder-swap occurred before occurrence analysis. + +* We need care when shadowing. Suppose [x :-> b] is in occ_bs_env, + and we encounter: + - \x. blah + Here we want to delete the x-binding from occ_bs_env + + - \b. blah + This is harder: we really want to delete all bindings that + have 'b' free in the range. That is a bit tiresome to implement, + so we compromise. We keep occ_bs_rng, which is the set of + free vars of rng(occc_bs_env). If a binder shadows any of these + variables, we discard all of occ_bs_env. Safe, if a bit + brutal. NB, however: the simplifer de-shadows the code, so the + next time around this won't happen. + + These checks are implemented in addInScope. + +* The occurrence analyser itself does /not/ do cloning. It could, in + principle, but it'd make it a bit more complicated and there is no + great benefit. The simplifer uses cloning to get a no-shadowing + situation, the care-when-shadowing behaviour above isn't needed for + long. + +* The domain of occ_bs_env can include GlobaIds. Eg + case M.foo of b { alts } + We extend occ_bs_env with [M.foo :-> b]. That's fine. + +* We have to apply the substitution uniformly, including to rules and + unfoldings. + +Historical note +--------------- +We used to do the binder-swap transformation by introducing +a proxy let-binding, thus; + + case x of b { pi -> ri } + ==> + case x of b { pi -> let x = b in ri } + +But that had two problems: + +1. If 'x' is an imported GlobalId, we'd end up with a GlobalId + on the LHS of a let-binding which isn't allowed. We worked + around this for a while by "localising" x, but it turned + out to be very painful #16296, + +2. In CorePrep we use the occurrence analyser to do dead-code + elimination (see Note [Dead code in CorePrep]). But that + occasionally led to an unlifted let-binding + case x of b { DEFAULT -> let x::Int# = b in ... } + which disobeys one of CorePrep's output invariants (no unlifted + let-bindings) -- see #5433. + +Doing a substitution (via occ_bs_env) is much better. + Note [Case of cast] ~~~~~~~~~~~~~~~~~~~ Consider case (x `cast` co) of b { I# -> @@ -2307,25 +2395,12 @@ We'd like to eliminate the inner case. That is the motivation for equation (2) in Note [Binder swap]. When we get to the inner case, we inline x, cancel the casts, and away we go. -Note [Binder swap on GlobalId scrutinees] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When the scrutinee is a GlobalId we must take care in two ways - - i) In order to *know* whether 'x' occurs free in the RHS, we need its - occurrence info. BUT, we don't gather occurrence info for - GlobalIds. That's the reason for the (small) occ_gbl_scrut env in - OccEnv is for: it says "gather occurrence info for these". - - ii) We must call localiseId on 'x' first, in case it's a GlobalId, or - has an External Name. See, for example, SimplEnv Note [Global Ids in - the substitution]. - Note [Zap case binders in proxy bindings] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ From the original case x of cb(dead) { p -> ...x... } we will get - case x of cb(live) { p -> let x = cb in ...x... } + case x of cb(live) { p -> ...cb... } Core Lint never expects to find an *occurrence* of an Id marked as Dead, so we must zap the OccInfo on cb before making the @@ -2396,37 +2471,25 @@ binder-swap unconditionally and still get occurrence analysis information right. -} -mkAltEnv :: OccEnv -> CoreExpr -> Id -> (OccEnv, Maybe (Id, CoreExpr)) --- Does three things: a) makes the occ_one_shots = OccVanilla --- b) extends the GlobalScruts if possible --- c) returns a proxy mapping, binding the scrutinee --- to the case binder, if possible -mkAltEnv env@(OccEnv { occ_gbl_scrut = pe }) scrut case_bndr - = case stripTicksTopE (const True) scrut of - Var v -> add_scrut v case_bndr' - Cast (Var v) co -> add_scrut v (Cast case_bndr' (mkSymCo co)) - -- See Note [Case of cast] - _ -> (env { occ_encl = OccVanilla }, Nothing) +addBndrSwap :: OutExpr -> Id -> OccEnv -> OccEnv +-- See Note [The binder-swap substitution] +addBndrSwap scrut case_bndr + env@(OccEnv { occ_bs_env = swap_env, occ_bs_rng = rng_vars }) + | Just (v, rhs) <- try_swap (stripTicksTopE (const True) scrut) + = env { occ_bs_env = extendVarEnv swap_env v (rhs, case_bndr') + , occ_bs_rng = rng_vars `unionVarSet` exprFreeVars rhs } + | otherwise + = env where - add_scrut v rhs - | isGlobalId v = (env { occ_encl = OccVanilla }, Nothing) - | otherwise = ( env { occ_encl = OccVanilla - , occ_gbl_scrut = pe `extendVarSet` v } - , Just (localise v, rhs) ) - -- ToDO: this isGlobalId stuff is a TEMPORARY FIX - -- to avoid the binder-swap for GlobalIds - -- See #16346 - - case_bndr' = Var (zapIdOccInfo case_bndr) - -- See Note [Zap case binders in proxy bindings] - - -- Localise the scrut_var before shadowing it; we're making a - -- new binding for it, and it might have an External Name, or - -- even be a GlobalId; Note [Binder swap on GlobalId scrutinees] - -- Also we don't want any INLINE or NOINLINE pragmas! - localise scrut_var = mkLocalIdOrCoVar (localiseName (idName scrut_var)) - (idType scrut_var) + try_swap :: OutExpr -> Maybe (OutVar, OutExpr) + try_swap (Var v) = Just (v, Var case_bndr') + try_swap (Cast (Var v) co) = Just (v, Cast (Var case_bndr') (mkSymCo co)) + -- See Note [Case of cast] + try_swap _ = Nothing + + case_bndr' = zapIdOccInfo case_bndr + -- See Note [Zap case binders in proxy bindings] {- ************************************************************************ @@ -2437,7 +2500,6 @@ mkAltEnv env@(OccEnv { occ_gbl_scrut = pe }) scrut case_bndr Note [UsageDetails and zapping] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - On many occasions, we must modify all gathered occurrence data at once. For instance, all occurrences underneath a (non-one-shot) lambda set the 'occ_in_lam' flag to become 'True'. We could use 'mapVarEnv' to do this, but @@ -2476,45 +2538,36 @@ andUDs, orUDs andUDs = combineUsageDetailsWith addOccInfo orUDs = combineUsageDetailsWith orOccInfo -andUDsList :: [UsageDetails] -> UsageDetails -andUDsList = foldl' andUDs emptyDetails - -mkOneOcc :: OccEnv -> Id -> InterestingCxt -> JoinArity -> UsageDetails -mkOneOcc env id int_cxt arity +mkOneOcc ::Id -> InterestingCxt -> JoinArity -> UsageDetails +mkOneOcc id int_cxt arity | isLocalId id - = singleton $ OneOcc { occ_in_lam = NotInsideLam - , occ_one_br = InOneBranch - , occ_int_cxt = int_cxt - , occ_tail = AlwaysTailCalled arity } - | id `elemVarSet` occ_gbl_scrut env - = singleton noOccInfo - + = emptyDetails { ud_env = unitVarEnv id occ_info } | otherwise = emptyDetails where - singleton info = emptyDetails { ud_env = unitVarEnv id info } - -addOneOcc :: UsageDetails -> Id -> OccInfo -> UsageDetails -addOneOcc ud id info - = ud { ud_env = extendVarEnv_C plus_zapped (ud_env ud) id info } - `alterZappedSets` (`delVarEnv` id) - where - plus_zapped old new = doZapping ud id old `addOccInfo` new + occ_info = OneOcc { occ_in_lam = NotInsideLam + , occ_one_br = InOneBranch + , occ_int_cxt = int_cxt + , occ_tail = AlwaysTailCalled arity } -addManyOccsSet :: UsageDetails -> VarSet -> UsageDetails -addManyOccsSet usage id_set = nonDetFoldUniqSet addManyOccs usage id_set - -- It's OK to use nonDetFoldUFM here because addManyOccs commutes +addManyOccId :: UsageDetails -> Id -> UsageDetails +-- Add the non-committal (id :-> noOccInfo) to the usage details +addManyOccId ud id = ud { ud_env = extendVarEnv (ud_env ud) id noOccInfo } -- Add several occurrences, assumed not to be tail calls -addManyOccs :: Var -> UsageDetails -> UsageDetails -addManyOccs v u | isId v = addOneOcc u v noOccInfo - | otherwise = u +addManyOcc :: Var -> UsageDetails -> UsageDetails +addManyOcc v u | isId v = addManyOccId u v + | otherwise = u -- Give a non-committal binder info (i.e noOccInfo) because -- a) Many copies of the specialised thing can appear -- b) We don't want to substitute a BIG expression inside a RULE -- even if that's the only occurrence of the thing -- (Same goes for INLINE.) +addManyOccs :: UsageDetails -> VarSet -> UsageDetails +addManyOccs usage id_set = nonDetFoldUniqSet addManyOcc usage id_set + -- It's OK to use nonDetFoldUFM here because addManyOcc commutes + delDetails :: UsageDetails -> Id -> UsageDetails delDetails ud bndr = ud `alterUsageDetails` (`delVarEnv` bndr) @@ -2538,8 +2591,23 @@ markAllMany ud = ud { ud_z_many = ud_env ud } markAllInsideLam ud = ud { ud_z_in_lam = ud_env ud } markAllNonTailCalled ud = ud { ud_z_no_tail = ud_env ud } +markAllInsideLamIf, markAllNonTailCalledIf :: Bool -> UsageDetails -> UsageDetails + +markAllInsideLamIf True ud = markAllInsideLam ud +markAllInsideLamIf False ud = ud + +markAllNonTailCalledIf True ud = markAllNonTailCalled ud +markAllNonTailCalledIf False ud = ud + + zapDetails = markAllMany . markAllNonTailCalled -- effectively sets to noOccInfo +zapDetailsIf :: Bool -- If this is true + -> UsageDetails -- Then do zapDetails on this + -> UsageDetails +zapDetailsIf True uds = zapDetails uds +zapDetailsIf False uds = uds + lookupDetails :: UsageDetails -> Id -> OccInfo lookupDetails ud id | isCoVar id -- We do not currently gather occurrence info (from types) @@ -2595,14 +2663,17 @@ doZapping ud var occ = doZappingByUnique ud (varUnique var) occ doZappingByUnique :: UsageDetails -> Unique -> OccInfo -> OccInfo -doZappingByUnique ud uniq - = (if | in_subset ud_z_many -> markMany - | in_subset ud_z_in_lam -> markInsideLam - | otherwise -> id) . - (if | in_subset ud_z_no_tail -> markNonTailCalled - | otherwise -> id) +doZappingByUnique (UD { ud_z_many = many + , ud_z_in_lam = in_lam + , ud_z_no_tail = no_tail }) + uniq occ + = occ2 where - in_subset field = uniq `elemVarEnvByKey` field ud + occ1 | uniq `elemVarEnvByKey` many = markMany occ + | uniq `elemVarEnvByKey` in_lam = markInsideLam occ + | otherwise = occ + occ2 | uniq `elemVarEnvByKey` no_tail = markNonTailCalled occ1 + | otherwise = occ1 alterZappedSets :: UsageDetails -> (ZappedSet -> ZappedSet) -> UsageDetails alterZappedSets ud f @@ -2612,8 +2683,7 @@ alterZappedSets ud f alterUsageDetails :: UsageDetails -> (OccInfoEnv -> OccInfoEnv) -> UsageDetails alterUsageDetails ud f - = ud { ud_env = f (ud_env ud) } - `alterZappedSets` f + = ud { ud_env = f (ud_env ud) } `alterZappedSets` f flattenUsageDetails :: UsageDetails -> UsageDetails flattenUsageDetails ud @@ -2623,25 +2693,26 @@ flattenUsageDetails ud ------------------- -- See Note [Adjusting right-hand sides] adjustRhsUsage :: Maybe JoinArity -> RecFlag - -> [CoreBndr] -- Outer lambdas, AFTER occ anal - -> UsageDetails -> UsageDetails + -> [CoreBndr] -- Outer lambdas, AFTER occ anal + -> UsageDetails -- From body of lambda + -> UsageDetails adjustRhsUsage mb_join_arity rec_flag bndrs usage - = maybe_mark_lam (maybe_drop_tails usage) + = markAllInsideLamIf (not one_shot) $ + markAllNonTailCalledIf (not exact_join) $ + usage where - maybe_mark_lam ud | one_shot = ud - | otherwise = markAllInsideLam ud - maybe_drop_tails ud | exact_join = ud - | otherwise = markAllNonTailCalled ud - one_shot = case mb_join_arity of Just join_arity | isRec rec_flag -> False | otherwise -> all isOneShotBndr (drop join_arity bndrs) Nothing -> all isOneShotBndr bndrs - exact_join = case mb_join_arity of - Just join_arity -> bndrs `lengthIs` join_arity - _ -> False + exact_join = exactJoin mb_join_arity bndrs + +exactJoin :: Maybe JoinArity -> [a] -> Bool +exactJoin Nothing _ = False +exactJoin (Just join_arity) args = args `lengthIs` join_arity + -- Remember join_arity includes type binders type IdWithOccInfo = Id @@ -2668,7 +2739,7 @@ tagLamBinder usage bndr bndr' = setBinderOcc (markNonTailCalled occ) bndr -- Don't try to make an argument into a join point usage1 = usage `delDetails` bndr - usage2 | isId bndr = addManyOccsSet usage1 (idUnfoldingVars bndr) + usage2 | isId bndr = addManyOccs usage1 (idUnfoldingVars bndr) -- This is effectively the RHS of a -- non-join-point binding, so it's okay to use -- addManyOccsSet, which assumes no tail calls ===================================== compiler/GHC/Core/Op/Simplify.hs ===================================== @@ -44,7 +44,8 @@ import GHC.Core.Unfold import GHC.Core.Utils import GHC.Core.SimpleOpt ( pushCoTyArg, pushCoValArg , joinPointBinding_maybe, joinPointBindings_maybe ) -import GHC.Core.Rules ( mkRuleInfo, lookupRule, getRules ) +import GHC.Core.Rules ( lookupRule, getRules ) +import GHC.Core.FVs ( mkRuleInfo ) import BasicTypes ( TopLevelFlag(..), isNotTopLevel, isTopLevel, RecFlag(..), Arity ) import MonadUtils ( mapAccumLM, liftIO ) @@ -1421,7 +1422,7 @@ simplLamBndr :: SimplEnv -> InBndr -> SimplM (SimplEnv, OutBndr) -- fw a b x{=(a,b)} = ... -- The "{=(a,b)}" is an unfolding we can't reconstruct otherwise. simplLamBndr env bndr - | isId bndr && isFragileUnfolding old_unf -- Special case + | isId bndr && hasCoreUnfolding old_unf -- Special case = do { (env1, bndr1) <- simplBinder env bndr ; unf' <- simplStableUnfolding env1 NotTopLevel Nothing bndr old_unf (idType bndr1) @@ -2882,7 +2883,7 @@ the unfolding (a,b), and *that* mentions b. If f has a RULE RULE f (p, I# q) = ... we want that rule to match, so we must extend the in-scope env with a suitable unfolding for 'y'. It's *essential* for rule matching; but -it's also good for case-elimintation -- suppose that 'f' was inlined +it's also good for case-elimination -- suppose that 'f' was inlined and did multi-level case analysis, then we'd solve it in one simplifier sweep instead of two. ===================================== compiler/GHC/Core/Op/Simplify/Utils.hs ===================================== @@ -1872,22 +1872,26 @@ Historical note: if you use let-bindings instead of a substitution, beware of th prepareAlts tries these things: -1. Eliminate alternatives that cannot match, including the - DEFAULT alternative. +1. filterAlts: eliminate alternatives that cannot match, including + the DEFAULT alternative. Here "cannot match" includes knowledge + from GADTs -2. If the DEFAULT alternative can match only one possible constructor, - then make that constructor explicit. +2. refineDefaultAlt: if the DEFAULT alternative can match only one + possible constructor, then make that constructor explicit. e.g. case e of x { DEFAULT -> rhs } ===> case e of x { (a,b) -> rhs } where the type is a single constructor type. This gives better code when rhs also scrutinises x or e. + See CoreUtils Note [Refine DEFAULT case alternatives] -3. Returns a list of the constructors that cannot holds in the - DEFAULT alternative (if there is one) +3. combineIdenticalAlts: combine identical alternatives into a DEFAULT. + See CoreUtils Note [Combine identical alternatives], which also + says why we do this on InAlts not on OutAlts -Here "cannot match" includes knowledge from GADTs +4. Returns a list of the constructors that cannot holds in the + DEFAULT alternative (if there is one) It's a good idea to do this stuff before simplifying the alternatives, to avoid simplifying alternatives we know can't happen, and to come up with ===================================== compiler/GHC/Core/Rules.hs ===================================== @@ -17,7 +17,7 @@ module GHC.Core.Rules ( ruleCheckProgram, -- ** Manipulating 'RuleInfo' rules - mkRuleInfo, extendRuleInfo, addRuleInfo, + extendRuleInfo, addRuleInfo, addIdSpecialisations, -- * Misc. CoreRule helpers @@ -278,11 +278,6 @@ pprRulesForUser dflags 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) - extendRuleInfo :: RuleInfo -> [CoreRule] -> RuleInfo extendRuleInfo (RuleInfo rs1 fvs1) rs2 = RuleInfo (rs2 ++ rs1) (rulesFreeVarsDSet rs2 `unionDVarSet` fvs1) ===================================== compiler/GHC/Core/Subst.hs ===================================== @@ -618,7 +618,7 @@ substIdInfo subst new_id info where old_rules = ruleInfo info old_unf = unfoldingInfo info - nothing_to_do = isEmptyRuleInfo old_rules && not (isFragileUnfolding old_unf) + nothing_to_do = isEmptyRuleInfo old_rules && not (hasCoreUnfolding old_unf) ------------------ -- | Substitutes for the 'Id's within an unfolding ===================================== compiler/GHC/Core/Unfold.hs ===================================== @@ -22,9 +22,9 @@ find, unsurprisingly, a Core expression. module GHC.Core.Unfold ( Unfolding, UnfoldingGuidance, -- Abstract types - noUnfolding, mkImplicitUnfolding, + noUnfolding, mkUnfolding, mkCoreUnfolding, - mkTopUnfolding, mkSimpleUnfolding, mkWorkerUnfolding, + mkFinalUnfolding, mkSimpleUnfolding, mkWorkerUnfolding, mkInlineUnfolding, mkInlineUnfoldingWithArity, mkInlinableUnfolding, mkWwInlineRule, mkCompulsoryUnfolding, mkDFunUnfolding, @@ -48,12 +48,12 @@ import GhcPrelude import GHC.Driver.Session import GHC.Core -import GHC.Core.Op.OccurAnal ( occurAnalyseExpr_NoBinderSwap ) +import GHC.Core.Op.OccurAnal ( occurAnalyseExpr ) import GHC.Core.SimpleOpt import GHC.Core.Arity ( manifestArity ) import GHC.Core.Utils import Id -import Demand ( isBottomingSig ) +import Demand ( StrictSig, isBottomingSig ) import GHC.Core.DataCon import Literal import PrimOp @@ -80,14 +80,22 @@ import Data.List ************************************************************************ -} -mkTopUnfolding :: DynFlags -> Bool -> CoreExpr -> Unfolding -mkTopUnfolding dflags is_bottoming rhs - = mkUnfolding dflags InlineRhs True is_bottoming rhs +mkFinalUnfolding :: DynFlags -> UnfoldingSource -> StrictSig -> CoreExpr -> Unfolding +-- "Final" in the sense that this is a GlobalId that will not be further +-- simplified; so the unfolding should be occurrence-analysed +mkFinalUnfolding dflags src strict_sig expr + = mkUnfolding dflags src + True {- Top level -} + (isBottomingSig strict_sig) + expr + +mkCompulsoryUnfolding :: CoreExpr -> Unfolding +mkCompulsoryUnfolding expr -- Used for things that absolutely must be unfolded + = mkCoreUnfolding InlineCompulsory True + (simpleOptExpr unsafeGlobalDynFlags expr) + (UnfWhen { ug_arity = 0 -- Arity of unfolding doesn't matter + , ug_unsat_ok = unSaturatedOk, ug_boring_ok = boringCxtOk }) -mkImplicitUnfolding :: DynFlags -> CoreExpr -> Unfolding --- For implicit Ids, do a tiny bit of optimising first -mkImplicitUnfolding dflags expr - = mkTopUnfolding dflags False (simpleOptExpr dflags expr) -- Note [Top-level flag on inline rules] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -103,7 +111,7 @@ mkDFunUnfolding :: [Var] -> DataCon -> [CoreExpr] -> Unfolding mkDFunUnfolding bndrs con ops = DFunUnfolding { df_bndrs = bndrs , df_con = con - , df_args = map occurAnalyseExpr_NoBinderSwap ops } + , df_args = map occurAnalyseExpr ops } -- See Note [Occurrence analysis of unfoldings] mkWwInlineRule :: DynFlags -> CoreExpr -> Arity -> Unfolding @@ -113,13 +121,6 @@ mkWwInlineRule dflags expr arity (UnfWhen { ug_arity = arity, ug_unsat_ok = unSaturatedOk , ug_boring_ok = boringCxtNotOk }) -mkCompulsoryUnfolding :: CoreExpr -> Unfolding -mkCompulsoryUnfolding expr -- Used for things that absolutely must be unfolded - = mkCoreUnfolding InlineCompulsory True - (simpleOptExpr unsafeGlobalDynFlags expr) - (UnfWhen { ug_arity = 0 -- Arity of unfolding doesn't matter - , ug_unsat_ok = unSaturatedOk, ug_boring_ok = boringCxtOk }) - mkWorkerUnfolding :: DynFlags -> (CoreExpr -> CoreExpr) -> Unfolding -> Unfolding -- See Note [Worker-wrapper for INLINABLE functions] in GHC.Core.Op.WorkWrap mkWorkerUnfolding dflags work_fn @@ -309,20 +310,6 @@ I'm a bit worried that it's possible for the same kind of problem to arise for non-0-ary functions too, but let's wait and see. -} -mkCoreUnfolding :: UnfoldingSource -> Bool -> CoreExpr - -> UnfoldingGuidance -> Unfolding --- Occurrence-analyses the expression before capturing it -mkCoreUnfolding src top_lvl expr guidance - = CoreUnfolding { uf_tmpl = occurAnalyseExpr_NoBinderSwap expr, - -- See Note [Occurrence analysis of unfoldings] - uf_src = src, - uf_is_top = top_lvl, - uf_is_value = exprIsHNF expr, - uf_is_conlike = exprIsConLike expr, - uf_is_work_free = exprIsWorkFree expr, - uf_expandable = exprIsExpandable expr, - uf_guidance = guidance } - mkUnfolding :: DynFlags -> UnfoldingSource -> Bool -- Is top-level -> Bool -- Definitely a bottoming binding @@ -331,21 +318,28 @@ mkUnfolding :: DynFlags -> UnfoldingSource -> Unfolding -- Calculates unfolding guidance -- Occurrence-analyses the expression before capturing it -mkUnfolding dflags src is_top_lvl is_bottoming expr - = CoreUnfolding { uf_tmpl = occurAnalyseExpr_NoBinderSwap expr, +mkUnfolding dflags src top_lvl is_bottoming expr + = mkCoreUnfolding src top_lvl expr guidance + where + is_top_bottoming = top_lvl && is_bottoming + guidance = calcUnfoldingGuidance dflags is_top_bottoming expr + -- NB: *not* (calcUnfoldingGuidance (occurAnalyseExpr expr))! + -- See Note [Calculate unfolding guidance on the non-occ-anal'd expression] + +mkCoreUnfolding :: UnfoldingSource -> Bool -> CoreExpr + -> UnfoldingGuidance -> Unfolding +-- Occurrence-analyses the expression before capturing it +mkCoreUnfolding src top_lvl expr guidance + = CoreUnfolding { uf_tmpl = occurAnalyseExpr expr, -- See Note [Occurrence analysis of unfoldings] uf_src = src, - uf_is_top = is_top_lvl, + uf_is_top = top_lvl, uf_is_value = exprIsHNF expr, uf_is_conlike = exprIsConLike expr, - uf_expandable = exprIsExpandable expr, uf_is_work_free = exprIsWorkFree expr, + uf_expandable = exprIsExpandable expr, uf_guidance = guidance } - where - is_top_bottoming = is_top_lvl && is_bottoming - guidance = calcUnfoldingGuidance dflags is_top_bottoming expr - -- NB: *not* (calcUnfoldingGuidance (occurAnalyseExpr_NoBinderSwap expr))! - -- See Note [Calculate unfolding guidance on the non-occ-anal'd expression] + {- Note [Occurrence analysis of unfoldings] @@ -366,39 +360,6 @@ But more generally, the simplifier is designed on the basis that it is looking at occurrence-analysed expressions, so better ensure that they actually are. -We use occurAnalyseExpr_NoBinderSwap instead of occurAnalyseExpr; -see Note [No binder swap in unfoldings]. - -Note [No binder swap in unfoldings] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The binder swap can temporarily violate Core Lint, by assigning -a LocalId binding to a GlobalId. For example, if A.foo{r872} -is a GlobalId with unique r872, then - - case A.foo{r872} of bar { - K x -> ...(A.foo{r872})... - } - -gets transformed to - - case A.foo{r872} of bar { - K x -> let foo{r872} = bar - in ...(A.foo{r872})... - -This is usually not a problem, because the simplifier will transform -this to: - - case A.foo{r872} of bar { - K x -> ...(bar)... - -However, after occurrence analysis but before simplification, this extra 'let' -violates the Core Lint invariant that we do not have local 'let' bindings for -GlobalIds. That seems (just) tolerable for the occurrence analysis that happens -just before the Simplifier, but not for unfoldings, which are Linted -independently. -As a quick workaround, we disable binder swap in this module. -See #16288 and #16296 for further plans. - Note [Calculate unfolding guidance on the non-occ-anal'd expression] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Notice that we give the non-occur-analysed expression to ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -696,7 +696,7 @@ filterAlts _tycon inst_tys imposs_cons alts impossible_alt _ _ = False -- | Refine the default alternative to a 'DataAlt', if there is a unique way to do so. --- See Note [Refine Default Alts] +-- See Note [Refine DEFAULT case alternatives] refineDefaultAlt :: [Unique] -- ^ Uniques for constructing new binders -> TyCon -- ^ Type constructor of scrutinee's type -> [Type] -- ^ Type arguments of scrutinee's type @@ -739,95 +739,62 @@ refineDefaultAlt us tycon tys imposs_deflt_cons all_alts | otherwise -- The common case = (False, all_alts) -{- Note [Refine Default Alts] - -refineDefaultAlt replaces the DEFAULT alt with a constructor if there is one -possible value it could be. +{- Note [Refine DEFAULT case alternatives] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +refineDefaultAlt replaces the DEFAULT alt with a constructor if there +is one possible value it could be. The simplest example being + foo :: () -> () + foo x = case x of !_ -> () +which rewrites to + foo :: () -> () + foo x = case x of () -> () + +There are two reasons in general why replacing a DEFAULT alternative +with a specific constructor is desirable. + +1. We can simplify inner expressions. For example + + data Foo = Foo1 () + + test :: Foo -> () + test x = case x of + DEFAULT -> mid (case x of + Foo1 x1 -> x1) + + refineDefaultAlt fills in the DEFAULT here with `Foo ip1` and then + x becomes bound to `Foo ip1` so is inlined into the other case + which causes the KnownBranch optimisation to kick in. If we don't + refine DEFAULT to `Foo ip1`, we are left with both case expressions. + +2. combineIdenticalAlts does a better job. For exapple (Simon Jacobi) + data D = C0 | C1 | C2 + + case e of + DEFAULT -> e0 + C0 -> e1 + C1 -> e1 + + When we apply combineIdenticalAlts to this expression, it can't + combine the alts for C0 and C1, as we already have a default case. + But if we apply refineDefaultAlt first, we get + case e of + C0 -> e1 + C1 -> e1 + C2 -> e0 + and combineIdenticalAlts can turn that into + case e of + DEFAULT -> e1 + C2 -> e0 -foo :: () -> () -foo x = case x of !_ -> () - -rewrites to - -foo :: () -> () -foo x = case x of () -> () - -There are two reasons in general why this is desirable. - -1. We can simplify inner expressions - -In this example we can eliminate the inner case by refining the outer case. -If we don't refine it, we are left with both case expressions. - -``` -{-# LANGUAGE BangPatterns #-} -module Test where - -mid x = x -{-# NOINLINE mid #-} - -data Foo = Foo1 () - -test :: Foo -> () -test x = - case x of - !_ -> mid (case x of - Foo1 x1 -> x1) - -``` - -refineDefaultAlt fills in the DEFAULT here with `Foo ip1` and then x -becomes bound to `Foo ip1` so is inlined into the other case which -causes the KnownBranch optimisation to kick in. - - -2. combineIdenticalAlts does a better job - -Simon Jakobi also points out that that combineIdenticalAlts will do a better job -if we refine the DEFAULT first. - -``` -data D = C0 | C1 | C2 - -case e of - DEFAULT -> e0 - C0 -> e1 - C1 -> e1 -``` - -When we apply combineIdenticalAlts to this expression, it can't -combine the alts for C0 and C1, as we already have a default case. - -If we apply refineDefaultAlt first, we get - -``` -case e of - C0 -> e1 - C1 -> e1 - C2 -> e0 -``` - -and combineIdenticalAlts can turn that into - -``` -case e of - DEFAULT -> e1 - C2 -> e0 -``` - -It isn't obvious that refineDefaultAlt does this but if you look at its one call -site in GHC.Core.Op.Simplify.Utils then the `imposs_deflt_cons` argument is -populated with constructors which are matched elsewhere. - --} - - - + It isn't obvious that refineDefaultAlt does this but if you look + at its one call site in GHC.Core.Op.Simplify.Utils then the + `imposs_deflt_cons` argument is populated with constructors which + are matched elsewhere. -{- Note [Combine identical alternatives] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [Combine identical alternatives] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ If several alternatives are identical, merge them into a single DEFAULT alternative. I've occasionally seen this making a big difference: ===================================== compiler/GHC/CoreToStg/Prep.hs ===================================== @@ -346,10 +346,7 @@ The way we fix this is to: * In cloneBndr, drop all unfoldings/rules * In deFloatTop, run a simple dead code analyser on each top-level - RHS to drop the dead local bindings. For that call to OccAnal, we - disable the binder swap, else the occurrence analyser sometimes - introduces new let bindings for cased binders, which lead to the bug - in #5433. + RHS to drop the dead local bindings. The reason we don't just OccAnal the whole output of CorePrep is that the tidier ensures that all top-level binders are GlobalIds, so they @@ -1315,14 +1312,13 @@ deFloatTop :: Floats -> [CoreBind] deFloatTop (Floats _ floats) = foldrOL get [] floats where - get (FloatLet b) bs = occurAnalyseRHSs b : bs - get (FloatCase body var _ _ _) bs - = occurAnalyseRHSs (NonRec var body) : bs + get (FloatLet b) bs = get_bind b : bs + get (FloatCase body var _ _ _) bs = get_bind (NonRec var body) : bs get b _ = pprPanic "corePrepPgm" (ppr b) -- See Note [Dead code in CorePrep] - occurAnalyseRHSs (NonRec x e) = NonRec x (occurAnalyseExpr_NoBinderSwap e) - occurAnalyseRHSs (Rec xes) = Rec [(x, occurAnalyseExpr_NoBinderSwap e) | (x, e) <- xes] + get_bind (NonRec x e) = NonRec x (occurAnalyseExpr e) + get_bind (Rec xes) = Rec [(x, occurAnalyseExpr e) | (x, e) <- xes] --------------------------------------------------------------------------- ===================================== compiler/GHC/Iface/Tidy.hs ===================================== @@ -1239,8 +1239,7 @@ tidyTopIdInfo dflags rhs_tidy_env name orig_rhs tidy_rhs idinfo show_unfold | otherwise = minimal_unfold_info minimal_unfold_info = zapUnfolding unf_info - unf_from_rhs = mkTopUnfolding dflags is_bot tidy_rhs - is_bot = isBottomingSig final_sig + unf_from_rhs = mkFinalUnfolding dflags InlineRhs final_sig tidy_rhs -- NB: do *not* expose the worker if show_unfold is off, -- because that means this thing is a loop breaker or -- marked NOINLINE or something like that ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -63,7 +63,6 @@ import Name import NameEnv import NameSet import GHC.Core.Op.OccurAnal ( occurAnalyseExpr ) -import Demand import Module import UniqFM import UniqSupply @@ -1506,14 +1505,12 @@ tcUnfolding toplvl name _ info (IfCoreUnfold stable if_expr) | otherwise = InlineRhs ; return $ case mb_expr of Nothing -> NoUnfolding - Just expr -> mkUnfolding dflags unf_src - True {- Top level -} - (isBottomingSig strict_sig) - expr + Just expr -> mkFinalUnfolding dflags unf_src strict_sig expr } where -- Strictness should occur before unfolding! strict_sig = strictnessInfo info + tcUnfolding toplvl name _ _ (IfCompulsory if_expr) = do { mb_expr <- tcPragExpr True toplvl name if_expr ; return (case mb_expr of ===================================== compiler/GHC/Stg/CSE.hs ===================================== @@ -93,6 +93,7 @@ import Id import GHC.Stg.Syntax import Outputable import VarEnv +import BasicTypes( isWeakLoopBreaker ) import GHC.Core (AltCon(..)) import Data.List (mapAccumL) import Data.Maybe (fromMaybe) @@ -391,6 +392,7 @@ stgCsePairs env0 ((b,e):pairs) stgCseRhs :: CseEnv -> OutId -> InStgRhs -> (Maybe (OutId, OutStgRhs), CseEnv) stgCseRhs env bndr (StgRhsCon ccs dataCon args) | Just other_bndr <- envLookup dataCon args' env + , not (isWeakLoopBreaker (idOccInfo bndr)) -- See Note [Care with loop breakers] = let env' = addSubst bndr other_bndr env in (Nothing, env') | otherwise @@ -399,6 +401,7 @@ stgCseRhs env bndr (StgRhsCon ccs dataCon args) pair = (bndr, StgRhsCon ccs dataCon args') in (Just pair, env') where args' = substArgs env args + stgCseRhs env bndr (StgRhsClosure ext ccs upd args body) = let (env1, args') = substBndrs env args env2 = forgetCse env1 -- See note [Free variables of an StgClosure] @@ -416,6 +419,21 @@ mkStgCase scrut bndr ty alts | all isBndr alts = scrut isBndr _ = False +{- Note [Care with loop breakers] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When doing CSE on a letrec we must be careful about loop +breakers. Consider + rec { y = K z + ; z = K z } +Now if, somehow (and wrongly)), y and z are both marked as +loop-breakers, we do *not* want to drop the (z = K z) binding +in favour of a substitution (z :-> y). + +I think this bug will only show up if the loop-breaker-ness is done +wrongly (itself a bug), but it still seems better to do the right +thing regardless. +-} + -- Utilities -- | This function short-cuts let-bindings that are now obsolete ===================================== compiler/basicTypes/IdInfo.hs ===================================== @@ -86,7 +86,8 @@ module IdInfo ( import GhcPrelude -import GHC.Core +import GHC.Core hiding( hasCoreUnfolding ) +import GHC.Core( hasCoreUnfolding ) import GHC.Core.Class import {-# SOURCE #-} PrimOp (PrimOp) @@ -567,8 +568,8 @@ zapFragileInfo info@(IdInfo { occInfo = occ, unfoldingInfo = unf }) zapFragileUnfolding :: Unfolding -> Unfolding zapFragileUnfolding unf - | isFragileUnfolding unf = noUnfolding - | otherwise = unf + | hasCoreUnfolding unf = noUnfolding + | otherwise = unf zapUnfolding :: Unfolding -> Unfolding -- Squash all unfolding info, preserving only evaluated-ness ===================================== compiler/basicTypes/MkId.hs ===================================== @@ -42,7 +42,6 @@ module MkId ( import GhcPrelude -import GHC.Core.Rules import TysPrim import TysWiredIn import GHC.Core.Op.ConstantFold @@ -52,7 +51,8 @@ import GHC.Core.FamInstEnv import GHC.Core.Coercion import TcType import GHC.Core.Make -import GHC.Core.Utils ( mkCast, mkDefaultCase ) +import GHC.Core.FVs ( mkRuleInfo ) +import GHC.Core.Utils ( mkCast, mkDefaultCase ) import GHC.Core.Unfold import Literal import GHC.Core.TyCon ===================================== testsuite/tests/dependent/should_compile/dynamic-paper.stderr ===================================== @@ -1,5 +1,5 @@ Simplifier ticks exhausted - When trying UnfoldingDone delta + When trying UnfoldingDone delta1 To increase the limit, use -fsimpl-tick-factor=N (default 100). If you need to increase the limit substantially, please file a @@ -12,4 +12,4 @@ Simplifier ticks exhausted simplifier non-termination has been judged acceptable. To see detailed counts use -ddump-simpl-stats - Total ticks: 140086 + Total ticks: 140082 ===================================== testsuite/tests/simplCore/should_compile/T17901.stdout ===================================== @@ -4,13 +4,11 @@ C -> wombat1 T17901.C = \ (@p) (wombat1 :: T -> p) (x :: T) -> case x of wild { __DEFAULT -> wombat1 wild } - (wombat2 [Occ=Once*!] :: S -> p) - SA _ [Occ=Dead] -> wombat2 wild; - SB -> wombat2 T17901.SB + Tmpl= \ (@p) (wombat2 [Occ=Once!] :: S -> p) (x [Occ=Once] :: S) -> + case x of wild [Occ=Once] { __DEFAULT -> wombat2 wild }}] = \ (@p) (wombat2 :: S -> p) (x :: S) -> case x of wild { __DEFAULT -> wombat2 wild } - (wombat3 [Occ=Once*!] :: W -> p) - WB -> wombat3 T17901.WB; - WA _ [Occ=Dead] -> wombat3 wild + Tmpl= \ (@p) (wombat3 [Occ=Once!] :: W -> p) (x [Occ=Once] :: W) -> + case x of wild [Occ=Once] { __DEFAULT -> wombat3 wild }}] = \ (@p) (wombat3 :: W -> p) (x :: W) -> case x of wild { __DEFAULT -> wombat3 wild } ===================================== testsuite/tests/simplCore/should_compile/T7360.hs ===================================== @@ -6,7 +6,7 @@ module T7360 where import GHC.List as L data Foo = Foo1 | Foo2 | Foo3 !Int - + fun1 :: Foo -> () {-# NOINLINE fun1 #-} fun1 x = case x of @@ -14,7 +14,7 @@ fun1 x = case x of Foo2 -> () Foo3 {} -> () -fun2 x = (fun1 Foo1, -- Keep -ddump-simpl output +fun2 x = (fun1 Foo1, -- Keep -ddump-simpl output -- in a predictable order case x of [] -> L.length x ===================================== testsuite/tests/simplCore/should_compile/T7360.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 114, types: 53, 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[0]] :: Int -> Foo @@ -25,21 +25,13 @@ fun1 [InlPrag=NOINLINE] :: Foo -> () fun1 = \ (x :: Foo) -> case x of { __DEFAULT -> GHC.Tuple.() } -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T7360.fun5 :: () +T7360.fun4 :: () [GblId, Unf=Unf{Src=, TopLvl=True, Value=False, ConLike=False, WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 20 0}] -T7360.fun5 = fun1 T7360.Foo1 +T7360.fun4 = fun1 T7360.Foo1 --- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T7360.fun4 :: Int -[GblId, - Cpr=m1, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] -T7360.fun4 = GHC.Types.I# 0# - --- RHS size: {terms: 16, types: 13, coercions: 0, joins: 0/0} +-- RHS size: {terms: 11, types: 8, coercions: 0, joins: 0/0} fun2 :: forall {a}. [a] -> ((), Int) [GblId, Arity=1, @@ -48,24 +40,18 @@ fun2 :: forall {a}. [a] -> ((), Int) 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) (x [Occ=Once!] :: [a]) -> - (T7360.fun5, - case x of wild [Occ=Once] { - [] -> T7360.fun4; - : _ [Occ=Dead] _ [Occ=Dead] -> - case GHC.List.$wlenAcc @a wild 0# of ww2 [Occ=Once] { __DEFAULT -> - GHC.Types.I# ww2 - } + Tmpl= \ (@a) (x [Occ=Once] :: [a]) -> + (T7360.fun4, + case x of wild [Occ=Once] { __DEFAULT -> + case GHC.List.$wlenAcc @a wild 0# of ww2 [Occ=Once] { __DEFAULT -> + GHC.Types.I# ww2 + } })}] fun2 = \ (@a) (x :: [a]) -> - (T7360.fun5, - case x of wild { - [] -> T7360.fun4; - : ds ds1 -> - case GHC.List.$wlenAcc @a wild 0# of ww2 { __DEFAULT -> - GHC.Types.I# ww2 - } + (T7360.fun4, + case GHC.List.$wlenAcc @a x 0# of ww2 { __DEFAULT -> + GHC.Types.I# ww2 }) -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4d63f94c181dfaf0b4ceeda76afd3284927a3351 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4d63f94c181dfaf0b4ceeda76afd3284927a3351 You're receiving 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 Mar 26 14:26:23 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Thu, 26 Mar 2020 10:26:23 -0400 Subject: [Git][ghc/ghc][wip/T17923] Significant refactor of Lint Message-ID: <5e7cbb8fedd67_616713339fc47344b9@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T17923 at Glasgow Haskell Compiler / GHC Commits: 03e1f65f by Simon Peyton Jones at 2020-03-26T14:20:07+00: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. - - - - - 4 changed files: - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Type.hs - + testsuite/tests/indexed-types/should_compile/T17923.hs - testsuite/tests/indexed-types/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -8,7 +8,7 @@ See Note [Core Lint guarantee]. -} {-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE ScopedTypeVariables, DeriveFunctor #-} module GHC.Core.Lint ( lintCoreBindings, lintUnfolding, @@ -33,7 +33,6 @@ import GHC.Core.Op.Monad import Bag import Literal import GHC.Core.DataCon -import TysWiredIn import TysPrim import TcType ( isFloatingTy ) import Var @@ -461,14 +460,17 @@ lintCoreBindings :: DynFlags -> CoreToDo -> [Var] -> CoreProgram -> (Bag MsgDoc, lintCoreBindings dflags pass local_in_scope binds = initL dflags flags local_in_scope $ addLoc TopLevelBindings $ - lintLetBndrs TopLevel binders $ - -- Put all the top-level binders in scope at the start - -- This is because transformation rules can bring something - -- into use 'unexpectedly' do { checkL (null dups) (dupVars dups) ; checkL (null ext_dups) (dupExtVars ext_dups) - ; mapM lint_bind binds } + ; lintRecBindings TopLevel all_pairs $ + return () } where + all_pairs = flattenBinds binds + -- Put all the top-level binders in scope at the start + -- This is because transformation rules can bring something + -- into use 'unexpectedly'; see Note [Glomming] in OccurAnal + binders = map fst all_pairs + flags = defaultLintFlags { lf_check_global_ids = check_globals , lf_check_inline_loop_breakers = check_lbs @@ -494,7 +496,6 @@ lintCoreBindings dflags pass local_in_scope binds CorePrep -> AllowAtTopLevel _ -> AllowAnywhere - binders = bindersOfBinds binds (_, dups) = removeDups compare binders -- dups_ext checks for names with different uniques @@ -509,11 +510,6 @@ lintCoreBindings dflags pass local_in_scope binds = compare (m1, nameOccName n1) (m2, nameOccName n2) | otherwise = LT - -- If you edit this function, you may need to update the GHC formalism - -- See Note [GHC Formalism] - lint_bind (Rec prs) = mapM_ (lintSingleBinding TopLevel Recursive) prs - lint_bind (NonRec bndr rhs) = lintSingleBinding TopLevel NonRecursive (bndr,rhs) - {- ************************************************************************ * * @@ -576,28 +572,32 @@ lintExpr dflags vars expr Check a core binding, returning the list of variables bound. -} -lintSingleBinding :: TopLevelFlag -> RecFlag -> (Id, CoreExpr) -> LintM () --- If you edit this function, you may need to update the GHC formalism --- See Note [GHC Formalism] -lintSingleBinding top_lvl_flag rec_flag (binder,rhs) - = addLoc (RhsOf binder) $ - -- Check the rhs - do { ty <- lintRhs binder rhs - ; binder_ty <- applySubstTy (idType binder) - ; ensureEqTys binder_ty ty (mkRhsMsg binder (text "RHS") ty) +lintRecBindings :: TopLevelFlag -> [(Id, CoreExpr)] + -> LintM a -> LintM a +lintRecBindings top_lvl pairs thing_inside + = lintIdBndrs top_lvl bndrs $ \ bndrs' -> + do { zipWithM_ lint_pair bndrs' rhss + ; thing_inside } + where + (bndrs, rhss) = unzip pairs + lint_pair bndr' rhs + = addLoc (RhsOf bndr') $ + do { rhs_ty <- lintRhs bndr' rhs -- Check the rhs + ; lintLetBind top_lvl Recursive bndr' rhs rhs_ty } + +lintLetBind :: TopLevelFlag -> RecFlag -> LintedId + -> CoreExpr -> LintedType -> LintM () +-- Binder's type, and the RHS, have already been linted +-- This function checks other invariants +lintLetBind top_lvl rec_flag binder rhs rhs_ty + = do { let binder_ty = idType binder + ; ensureEqTys binder_ty rhs_ty (mkRhsMsg binder (text "RHS") rhs_ty) -- If the binding is for a CoVar, the RHS should be (Coercion co) -- See Note [Core type and coercion invariant] in GHC.Core ; checkL (not (isCoVar binder) || isCoArg rhs) (mkLetErr binder rhs) - -- Check that it's not levity-polymorphic - -- Do this first, because otherwise isUnliftedType panics - -- Annoyingly, this duplicates the test in lintIdBdr, - -- because for non-rec lets we call lintSingleBinding first - ; checkL (isJoinId binder || not (isTypeLevPoly binder_ty)) - (badBndrTyMsg binder (text "levity-polymorphic")) - -- Check the let/app invariant -- See Note [Core let/app invariant] in GHC.Core ; checkL ( isJoinId binder @@ -610,14 +610,14 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs) -- 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_flag)) + || (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]. - ; checkL (not (isTopLevel top_lvl_flag && binder_ty `eqType` addrPrimTy) + ; checkL (not (isTopLevel top_lvl && binder_ty `eqType` addrPrimTy) || exprIsTickedString rhs) (mkTopNonLitStrMsg binder) @@ -674,7 +674,9 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs) -- join point. -- -- See Note [Checking StaticPtrs]. -lintRhs :: Id -> CoreExpr -> LintM OutType +lintRhs :: Id -> CoreExpr -> LintM LintedType +-- NB: the Id can be Linted or not -- it's only used for +-- its OccInfo and join-pointer-hood lintRhs bndr rhs | Just arity <- isJoinId_maybe bndr = lint_join_lams arity arity True rhs @@ -761,13 +763,14 @@ hurts us here. ************************************************************************ -} --- For OutType, OutKind, the substitution has been applied, --- but has not been linted yet +-- Linted things: substitution applied, and type is linted +type LintedType = Type +type LintedKind = Kind +type LintedCoercion = Coercion +type LintedTyCoVar = TyCoVar +type LintedId = Id -type LintedType = Type -- Substitution applied, and type is linted -type LintedKind = Kind - -lintCoreExpr :: CoreExpr -> LintM OutType +lintCoreExpr :: CoreExpr -> LintM LintedType -- The returned type has the substitution from the monad -- already applied to it: -- lintCoreExpr e subst = exprType (subst e) @@ -776,18 +779,20 @@ lintCoreExpr :: CoreExpr -> LintM OutType -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] + lintCoreExpr (Var var) - = lintVarOcc var 0 + = lintIdOcc var 0 lintCoreExpr (Lit lit) = return (literalType lit) lintCoreExpr (Cast expr co) = do { expr_ty <- markAllJoinsBad $ lintCoreExpr expr - ; co' <- applySubstCo co - ; (_, k2, from_ty, to_ty, r) <- lintCoercion co' - ; checkValueKind k2 (text "target of cast" <+> quotes (ppr co)) - ; lintRole co' Representational r + ; co' <- lintCoercion co + ; let (Pair from_ty to_ty, role) = coercionKindRole co' + ; checkValueType to_ty $ + text "target of cast" <+> quotes (ppr co') + ; lintRole co' Representational role ; ensureEqTys from_ty expr_ty (mkCastErr expr co' from_ty expr_ty) ; return to_ty } @@ -809,7 +814,7 @@ lintCoreExpr (Tick tickish expr) lintCoreExpr (Let (NonRec tv (Type ty)) body) | isTyVar tv = -- See Note [Linting type lets] - do { ty' <- applySubstTy ty + do { ty' <- lintType ty ; lintTyBndr tv $ \ tv' -> do { addLoc (RhsOf tv) $ lintTyKind tv' ty' -- Now extend the substitution so we @@ -820,33 +825,34 @@ lintCoreExpr (Let (NonRec tv (Type ty)) body) lintCoreExpr (Let (NonRec bndr rhs) body) | isId bndr - = do { lintSingleBinding NotTopLevel NonRecursive (bndr,rhs) - ; addLoc (BodyOfLetRec [bndr]) - (lintBinder LetBind bndr $ \_ -> - addGoodJoins [bndr] $ - lintCoreExpr body) } + = do { -- First Lint the RHS, before bringing the binder into scope + rhs_ty <- lintRhs bndr rhs + + -- Now lint the binder + ; lintBinder LetBind bndr $ \bndr' -> + do { lintLetBind NotTopLevel NonRecursive bndr' rhs rhs_ty + ; addLoc (BodyOfLetRec [bndr]) (lintCoreExpr body) } } | otherwise = failWithL (mkLetErr bndr rhs) -- Not quite accurate lintCoreExpr e@(Let (Rec pairs) body) - = lintLetBndrs NotTopLevel bndrs $ - addGoodJoins bndrs $ - do { -- Check that the list of pairs is non-empty + = do { -- Check that the list of pairs is non-empty checkL (not (null pairs)) (emptyRec e) -- Check that there are no duplicated binders + ; let (_, dups) = removeDups compare bndrs ; checkL (null dups) (dupVars dups) -- Check that either all the binders are joins, or none ; checkL (all isJoinId bndrs || all (not . isJoinId) bndrs) $ - mkInconsistentRecMsg bndrs + mkInconsistentRecMsg bndrs - ; mapM_ (lintSingleBinding NotTopLevel Recursive) pairs - ; addLoc (BodyOfLetRec bndrs) (lintCoreExpr body) } + ; lintRecBindings NotTopLevel pairs $ + addLoc (BodyOfLetRec bndrs) $ + lintCoreExpr body } where bndrs = map fst pairs - (_, dups) = removeDups compare bndrs lintCoreExpr e@(App _ _) = do { fun_ty <- lintCoreFun fun (length args) @@ -867,23 +873,35 @@ lintCoreExpr (Type ty) = failWithL (text "Type found as expression" <+> ppr ty) lintCoreExpr (Coercion co) - = do { (k1, k2, ty1, ty2, role) <- lintInCo co - ; return (mkHeteroCoercionType role k1 k2 ty1 ty2) } + = do { co' <- addLoc (InCo co) $ + lintCoercion co + ; return (coercionType co') } ---------------------- -lintVarOcc :: Var -> Int -- Number of arguments (type or value) being passed - -> LintM Type -- returns type of the *variable* -lintVarOcc var nargs - = do { checkL (isNonCoVarId var) +lintIdOcc :: Var -> Int -- Number of arguments (type or value) being passed + -> LintM LintedType -- returns type of the *variable* +lintIdOcc var nargs + = addLoc (OccOf var) $ + do { checkL (isNonCoVarId var) (text "Non term variable" <+> ppr var) -- See GHC.Core Note [Variable occurrences in Core] -- Check that the type of the occurrence is the same - -- as the type of the binding site - ; ty <- applySubstTy (idType var) - ; var' <- lookupIdInScope var - ; let ty' = idType var' - ; ensureEqTys ty ty' $ mkBndrOccTypeMismatchMsg var' var ty' ty + -- as the type of the binding site. The inScopeIds are + -- /un-substituted/, so this checks that the occurrence type + -- is identical to the binder type. + -- This makes things much easier for things like: + -- /\a. \(x::Maybe a). /\a. ...(x::Maybe a)... + -- The "::Maybe a" on the occurrence is referring to the /outer/ a. + -- If we compared /substituted/ types we'd risk comparing + -- (Maybe a) from the binding site with bogus (Maybe a1) from + -- the occurrence site. Comparing un-substituted types finesses + -- this altogether + ; (bndr, linted_bndr_ty) <- lookupIdInScope var + ; let occ_ty = idType var + bndr_ty = idType bndr + ; ensureEqTys occ_ty bndr_ty $ + mkBndrOccTypeMismatchMsg bndr var bndr_ty occ_ty -- Check for a nested occurrence of the StaticPtr constructor. -- See Note [Checking StaticPtrs]. @@ -895,13 +913,13 @@ lintVarOcc var nargs ; checkDeadIdOcc var ; checkJoinOcc var nargs - ; return (idType var') } + ; return linted_bndr_ty } lintCoreFun :: CoreExpr - -> Int -- Number of arguments (type or val) being passed - -> LintM Type -- Returns type of the *function* + -> Int -- Number of arguments (type or val) being passed + -> LintM LintedType -- Returns type of the *function* lintCoreFun (Var var) nargs - = lintVarOcc var nargs + = lintIdOcc var nargs lintCoreFun (Lam var body) nargs -- Act like lintCoreExpr of Lam, but *don't* call markAllJoinsBad; see @@ -941,7 +959,9 @@ checkJoinOcc var n_args = do { mb_join_arity_bndr <- lookupJoinId var ; case mb_join_arity_bndr of { Nothing -> -- Binder is not a join point - addErrL (invalidJoinOcc var) ; + do { join_set <- getValidJoins + ; addErrL (text "join set " <+> ppr join_set $$ + invalidJoinOcc var) } ; Just join_arity_bndr -> @@ -1038,15 +1058,15 @@ subtype of the required type, as one would expect. -} -lintCoreArgs :: OutType -> [CoreArg] -> LintM OutType +lintCoreArgs :: LintedType -> [CoreArg] -> LintM LintedType lintCoreArgs fun_ty args = foldM lintCoreArg fun_ty args -lintCoreArg :: OutType -> CoreArg -> LintM OutType +lintCoreArg :: LintedType -> CoreArg -> LintM LintedType lintCoreArg fun_ty (Type arg_ty) = do { checkL (not (isCoercionTy arg_ty)) (text "Unnecessary coercion-to-type injection:" <+> ppr arg_ty) - ; arg_ty' <- applySubstTy arg_ty + ; arg_ty' <- lintType arg_ty ; lintTyApp fun_ty arg_ty' } lintCoreArg fun_ty arg @@ -1060,11 +1080,12 @@ lintCoreArg fun_ty arg ; checkL (not (isUnliftedType arg_ty) || exprOkForSpeculation arg) (mkLetAppMsg arg) + ; lintValApp arg fun_ty arg_ty } ----------------- -lintAltBinders :: OutType -- Scrutinee type - -> OutType -- Constructor type +lintAltBinders :: LintedType -- Scrutinee type + -> LintedType -- Constructor type -> [OutVar] -- Binders -> LintM () -- If you edit this function, you may need to update the GHC formalism @@ -1080,7 +1101,7 @@ lintAltBinders scrut_ty con_ty (bndr:bndrs) ; lintAltBinders scrut_ty con_ty' bndrs } ----------------- -lintTyApp :: OutType -> OutType -> LintM OutType +lintTyApp :: LintedType -> LintedType -> LintM LintedType lintTyApp fun_ty arg_ty | Just (tv,body_ty) <- splitForAllTy_maybe fun_ty = do { lintTyKind tv arg_ty @@ -1094,7 +1115,7 @@ lintTyApp fun_ty arg_ty = failWithL (mkTyAppMsg fun_ty arg_ty) ----------------- -lintValApp :: CoreExpr -> OutType -> OutType -> LintM OutType +lintValApp :: CoreExpr -> LintedType -> LintedType -> LintM LintedType lintValApp arg fun_ty arg_ty | Just (arg,res) <- splitFunTy_maybe fun_ty = do { ensureEqTys arg arg_ty err1 @@ -1105,17 +1126,17 @@ lintValApp arg fun_ty arg_ty err1 = mkAppMsg fun_ty arg_ty arg err2 = mkNonFunAppMsg fun_ty arg_ty arg -lintTyKind :: OutTyVar -> OutType -> LintM () +lintTyKind :: OutTyVar -> LintedType -> LintM () -- Both args have had substitution applied -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] lintTyKind tyvar arg_ty - = do { arg_kind <- lintType arg_ty - ; unless (arg_kind `eqType` tyvar_kind) - (addErrL (mkKindErrMsg tyvar arg_ty $$ (text "Linted Arg kind:" <+> ppr arg_kind))) } + = unless (arg_kind `eqType` tyvar_kind) $ + addErrL (mkKindErrMsg tyvar arg_ty $$ (text "Linted Arg kind:" <+> ppr arg_kind)) where tyvar_kind = tyVarKind tyvar + arg_kind = typeKind arg_ty {- ************************************************************************ @@ -1125,7 +1146,7 @@ lintTyKind tyvar arg_ty ************************************************************************ -} -lintCaseExpr :: CoreExpr -> Id -> Type -> [CoreAlt] -> LintM OutType +lintCaseExpr :: CoreExpr -> Id -> Type -> [CoreAlt] -> LintM LintedType lintCaseExpr scrut var alt_ty alts = do { let e = Case scrut var alt_ty alts -- Just for error messages @@ -1134,10 +1155,10 @@ lintCaseExpr scrut var alt_ty alts = -- See Note [Join points are less general than the paper] -- in GHC.Core - ; (alt_ty, _) <- addLoc (CaseTy scrut) $ - lintInTy alt_ty - ; (var_ty, _) <- addLoc (IdTy var) $ - lintInTy (idType var) + ; alt_ty <- addLoc (CaseTy scrut) $ + lintValueType alt_ty + ; var_ty <- addLoc (IdTy var) $ + lintValueType (idType var) -- We used to try to check whether a case expression with no -- alternatives was legitimate, but this didn't work. @@ -1179,7 +1200,7 @@ lintCaseExpr scrut var alt_ty alts = ; checkCaseAlts e scrut_ty alts ; return alt_ty } } -checkCaseAlts :: CoreExpr -> OutType -> [CoreAlt] -> LintM () +checkCaseAlts :: CoreExpr -> LintedType -> [CoreAlt] -> LintM () -- a) Check that the alts are non-empty -- b1) Check that the DEFAULT comes first, if it exists -- b2) Check that the others are in increasing order @@ -1219,14 +1240,14 @@ checkCaseAlts e ty alts = Nothing -> False Just tycon -> isPrimTyCon tycon -lintAltExpr :: CoreExpr -> OutType -> LintM () +lintAltExpr :: CoreExpr -> LintedType -> LintM () lintAltExpr expr ann_ty = do { actual_ty <- lintCoreExpr expr ; ensureEqTys actual_ty ann_ty (mkCaseAltMsg expr actual_ty ann_ty) } -- See GHC.Core Note [Case expression invariants] item (6) -lintCoreAlt :: OutType -- Type of scrutinee - -> OutType -- Type of the alternative +lintCoreAlt :: LintedType -- Type of scrutinee + -> LintedType -- Type of the alternative -> CoreAlt -> LintM () -- If you edit this function, you may need to update the GHC formalism @@ -1286,40 +1307,43 @@ lintBinders site (var:vars) linterF = lintBinder site var $ \var' -> -- See Note [GHC Formalism] lintBinder :: BindingSite -> Var -> (Var -> LintM a) -> LintM a lintBinder site var linterF - | isTyVar var = lintTyBndr var linterF - | isCoVar var = lintCoBndr var linterF - | otherwise = lintIdBndr NotTopLevel site var linterF + | isTyCoVar var = lintTyCoBndr var linterF + | otherwise = lintIdBndr NotTopLevel site var linterF -lintTyBndr :: InTyVar -> (OutTyVar -> LintM a) -> LintM a -lintTyBndr tv thing_inside - = do { subst <- getTCvSubst - ; let (subst', tv') = substTyVarBndr subst tv - ; lintKind (varType tv') - ; updateTCvSubst subst' (thing_inside tv') } +lintTyBndr :: TyVar -> (LintedTyCoVar -> LintM a) -> LintM a +lintTyBndr = lintTyCoBndr -- We could specialise it, I guess -lintCoBndr :: InCoVar -> (OutCoVar -> LintM a) -> LintM a -lintCoBndr cv thing_inside +-- lintCoBndr :: CoVar -> (LintedTyCoVar -> LintM a) -> LintM a +-- lintCoBndr = lintTyCoBndr -- We could specialise it, I guess + +lintTyCoBndr :: TyCoVar -> (LintedTyCoVar -> LintM a) -> LintM a +lintTyCoBndr tcv thing_inside = do { subst <- getTCvSubst - ; let (subst', cv') = substCoVarBndr subst cv - ; lintKind (varType cv') - ; lintL (isCoVarType (varType cv')) - (text "CoVar with non-coercion type:" <+> pprTyVar cv) - ; updateTCvSubst subst' (thing_inside cv') } - -lintLetBndrs :: TopLevelFlag -> [Var] -> LintM a -> LintM a -lintLetBndrs top_lvl ids linterF - = go ids + ; kind' <- lintType (varType tcv) + ; let tcv' = uniqAway (getTCvInScope subst) $ + setVarType tcv kind' + subst' = extendTCvSubstWithClone subst tcv tcv' + ; when (isCoVar tcv) $ + lintL (isCoVarType kind') + (text "CoVar with non-coercion type:" <+> pprTyVar tcv) + ; updateTCvSubst subst' (thing_inside tcv') } + +lintIdBndrs :: forall a. TopLevelFlag -> [Id] -> ([LintedId] -> LintM a) -> LintM a +lintIdBndrs top_lvl ids thing_inside + = go ids thing_inside where - go [] = linterF - go (id:ids) = lintIdBndr top_lvl LetBind id $ \_ -> - go ids + go :: [Id] -> ([Id] -> LintM a) -> LintM a + go [] thing_inside = thing_inside [] + go (id:ids) thing_inside = lintIdBndr top_lvl LetBind id $ \id' -> + go ids $ \ids' -> + thing_inside (id' : ids') lintIdBndr :: TopLevelFlag -> BindingSite -> InVar -> (OutVar -> LintM a) -> LintM a -- Do substitution on the type of a binder and add the var with this -- new type to the in-scope set of the second argument -- ToDo: lint its rules -lintIdBndr top_lvl bind_site id linterF +lintIdBndr top_lvl bind_site id thing_inside = ASSERT2( isId id, ppr id ) do { flags <- getLintFlags ; checkL (not (lf_check_global_ids flags) || isLocalId id) @@ -1334,14 +1358,11 @@ lintIdBndr top_lvl bind_site id linterF ; checkL (not (isExternalName (Var.varName id)) || is_top_lvl) (mkNonTopExternalNameMsg id) - ; (id_ty, k) <- addLoc (IdTy id) $ - lintInTy (idType id) - ; let id' = setIdType id id_ty - -- See Note [Levity polymorphism invariants] in GHC.Core - ; lintL (isJoinId id || not (lf_check_levity_poly flags) || not (isKindLevPoly k)) - (text "Levity-polymorphic binder:" <+> - (ppr id <+> dcolon <+> parens (ppr id_ty <+> dcolon <+> ppr k))) + ; lintL (isJoinId id || not (lf_check_levity_poly flags) + || not (isTypeLevPoly id_ty)) $ + text "Levity-polymorphic binder:" <+> ppr id <+> dcolon <+> + parens (ppr id_ty <+> dcolon <+> ppr (typeKind id_ty)) -- Check that a join-id is a not-top-level let-binding ; when (isJoinId id) $ @@ -1353,8 +1374,13 @@ lintIdBndr top_lvl bind_site id linterF ; lintL (not (isCoVarType id_ty)) (text "Non-CoVar has coercion type" <+> ppr id <+> dcolon <+> ppr id_ty) - ; addInScopeId id' $ (linterF id') } + ; linted_ty <- addLoc (IdTy id) (lintValueType id_ty) + + ; addInScopeId id linted_ty $ + thing_inside (setIdType id linted_ty) } where + id_ty = idType id + is_top_lvl = isTopLevel top_lvl is_let_bind = case bind_site of LetBind -> True @@ -1378,45 +1404,52 @@ lintTypes dflags vars tys where (_warns, errs) = initL dflags defaultLintFlags vars linter linter = lintBinders LambdaBind vars $ \_ -> - mapM_ lintInTy tys + mapM_ lintType tys -lintInTy :: InType -> LintM (LintedType, LintedKind) +lintValueType :: Type -> LintM LintedType -- Types only, not kinds -- Check the type, and apply the substitution to it -- See Note [Linting type lets] -lintInTy ty +lintValueType ty = addLoc (InType ty) $ - do { ty' <- applySubstTy ty - ; k <- lintType ty' - ; addLoc (InKind ty' k) $ - lintKind k -- The kind returned by lintType is already - -- a LintedKind but we also want to check that - -- k :: *, which lintKind does - ; return (ty', k) } + do { ty' <- lintType ty + ; let sk = typeKind ty' + ; lintL (classifiesTypeWithValues sk) $ + hang (text "Ill-kinded type:" <+> ppr ty) + 2 (text "has kind:" <+> ppr sk) + ; return ty' } checkTyCon :: TyCon -> LintM () checkTyCon tc = checkL (not (isTcTyCon tc)) (text "Found TcTyCon:" <+> ppr tc) ------------------- -lintType :: OutType -> LintM LintedKind --- The returned Kind has itself been linted +lintType :: LintedType -> LintM LintedType -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] lintType (TyVarTy tv) - = do { checkL (isTyVar tv) (mkBadTyVarMsg tv) - ; tv' <- lintTyCoVarInScope tv - ; return (tyVarKind tv') } - -- We checked its kind when we added it to the envt + | not (isTyVar tv) + = failWithL (mkBadTyVarMsg tv) + + | otherwise + = do { subst <- getTCvSubst + ; case lookupTyVar subst tv of + Just linted_ty -> return linted_ty ; + Nothing -> -- lintTyBndr always extends the substitition + failWithL $ + hang (text "The type variable" <+> pprBndr LetBind tv) + 2 (text "is out of scope") + } lintType ty@(AppTy t1 t2) | TyConApp {} <- t1 = failWithL $ text "TyConApp to the left of AppTy:" <+> ppr ty | otherwise - = do { k1 <- lintType t1 - ; k2 <- lintType t2 - ; lint_ty_app ty k1 [(t2,k2)] } + = do { t1' <- lintType t1 + ; t2' <- lintType t2 + ; lint_ty_app ty (typeKind t1') [t2'] + ; return (AppTy t1' t2') } lintType ty@(TyConApp tc tys) | isTypeSynonymTyCon tc || isTypeFamilyTyCon tc @@ -1433,71 +1466,73 @@ lintType ty@(TyConApp tc tys) | otherwise -- Data types, data families, primitive types = do { checkTyCon tc - ; ks <- mapM lintType tys - ; lint_ty_app ty (tyConKind tc) (tys `zip` ks) } + ; tys' <- mapM lintType tys + ; lint_ty_app ty (tyConKind tc) tys' + ; return (TyConApp tc tys') } -- arrows can related *unlifted* kinds, so this has to be separate from -- a dependent forall. -lintType ty@(FunTy _ t1 t2) - = do { k1 <- lintType t1 - ; k2 <- lintType t2 - ; lintArrow (text "type or kind" <+> quotes (ppr ty)) k1 k2 } +lintType ty@(FunTy af t1 t2) + = do { t1' <- lintType t1 + ; t2' <- lintType t2 + ; lintArrow (text "type or kind" <+> quotes (ppr ty)) t1' t2' + ; return (FunTy af t1' t2') } -lintType t@(ForAllTy (Bndr tv _vis) ty) - -- forall over types - | isTyVar tv - = lintTyBndr tv $ \tv' -> - do { k <- lintType ty - ; checkValueKind k (text "the body of forall:" <+> ppr t) - ; case occCheckExpand [tv'] k of -- See Note [Stupid type synonyms] - Just k' -> return k' - Nothing -> failWithL (hang (text "Variable escape in forall:") - 2 (vcat [ text "type:" <+> ppr t - , text "kind:" <+> ppr k ])) - } +lintType (ForAllTy (Bndr tcv vis) body_ty) + = lintTyCoBndr tcv $ \tcv' -> + do { body_ty' <- lintType body_ty + ; lintForAllBody tcv' body_ty' + ; return (ForAllTy (Bndr tcv' vis) body_ty') } -lintType t@(ForAllTy (Bndr cv _vis) ty) - -- forall over coercions - = do { lintL (isCoVar cv) - (text "Non-Tyvar or Non-Covar bound in type:" <+> ppr t) - ; lintL (cv `elemVarSet` tyCoVarsOfType ty) - (text "Covar does not occur in the body:" <+> ppr t) - ; lintCoBndr cv $ \_ -> - do { k <- lintType ty - ; checkValueKind k (text "the body of forall:" <+> ppr t) - ; return liftedTypeKind - -- We don't check variable escape here. Namely, k could refer to cv' - }} - -lintType ty@(LitTy l) = lintTyLit l >> return (typeKind ty) +lintType ty@(LitTy l) + = do { lintTyLit l; return ty } lintType (CastTy ty co) - = do { k1 <- lintType ty - ; (k1', k2) <- lintStarCoercion co - ; ensureEqTys k1 k1' (mkCastTyErr ty co k1' k1) - ; return k2 } + = do { ty' <- lintType ty + ; co' <- lintStarCoercion co + ; let tyk = typeKind ty' + cok = coercionLKind co' + ; ensureEqTys tyk cok (mkCastTyErr ty co tyk cok) + ; return (CastTy ty' co') } lintType (CoercionTy co) - = do { (k1, k2, ty1, ty2, r) <- lintCoercion co - ; return $ mkHeteroCoercionType r k1 k2 ty1 ty2 } - -{- Note [Stupid type synonyms] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider (#14939) - type Alg cls ob = ob - f :: forall (cls :: * -> Constraint) (b :: Alg cls *). b - -Here 'cls' appears free in b's kind, which would usually be illegal -(because in (forall a. ty), ty's kind should not mention 'a'). But -#in this case (Alg cls *) = *, so all is well. Currently we allow -this, and make Lint expand synonyms where necessary to make it so. - -c.f. TcUnify.occCheckExpand and GHC.Core.Utils.coreAltsType which deal -with the same problem. A single systematic solution eludes me. --} + = do { co' <- lintCoercion co + ; return (CoercionTy co') } ----------------- -lintTySynFamApp :: Bool -> Type -> TyCon -> [Type] -> LintM LintedKind +lintForAllBody :: LintedTyCoVar -> LintedType -> LintM () +-- Do the checks for the body of a forall-type +lintForAllBody tcv body_ty + | isTyVar tcv + = do { checkValueType body_ty (text "the body of forall:" <+> ppr body_ty) + + -- Check for skolem escape + -- See Note [Phantom type variables in kinds] in GHC.Core.Type + ; let body_kind = typeKind body_ty + ; case occCheckExpand [tcv] body_kind of + Just {} -> return () + Nothing -> failWithL $ + hang (text "Variable escape in forall:") + 2 (vcat [ text "tyvar:" <+> ppr tcv + , text "type:" <+> ppr body_ty + , text "kind:" <+> ppr body_kind ]) + } + + | isCoVar tcv + = do { checkValueType body_ty (text "the body of forall:" <+> ppr body_ty) + + ; lintL (tcv `elemVarSet` tyCoVarsOfType body_ty) $ + text "Covar does not occur in the body:" <+> (ppr tcv $$ ppr body_ty) + + -- The kind of (forall cv. th) is liftedTypeKind, so no + -- need to check for skolem-escape, as we must do in the tyvar case + } + + | otherwise + = failWithL (text "Non-Tyvar or Non-Covar bound in type:" <+> ppr tcv) + +----------------- +lintTySynFamApp :: Bool -> InType -> TyCon -> [InType] -> LintM LintedType -- The TyCon is a type synonym or a type family (not a data family) -- See Note [Linting type synonym applications] -- c.f. TcValidity.check_syn_tc_app @@ -1511,58 +1546,54 @@ lintTySynFamApp report_unsat ty tc tys , let expanded_ty = mkAppTys (substTy (mkTvSubstPrs tenv) rhs) tys' = do { -- Kind-check the argument types, but without reporting -- un-saturated type families/synonyms - ks <- setReportUnsat False (mapM lintType tys) + tys' <- setReportUnsat False (mapM lintType tys) ; when report_unsat $ do { _ <- lintType expanded_ty ; return () } - ; lint_ty_app ty (tyConKind tc) (tys `zip` ks) } + ; lint_ty_app ty (tyConKind tc) tys' + ; return (TyConApp tc tys') } -- Otherwise this must be a type family | otherwise - = do { ks <- mapM lintType tys - ; lint_ty_app ty (tyConKind tc) (tys `zip` ks) } - ------------------ -lintKind :: OutKind -> LintM () --- If you edit this function, you may need to update the GHC formalism --- See Note [GHC Formalism] -lintKind k = do { sk <- lintType k - ; unless (classifiesTypeWithValues sk) - (addErrL (hang (text "Ill-kinded kind:" <+> ppr k) - 2 (text "has kind:" <+> ppr sk))) } + = do { tys' <- mapM lintType tys + ; lint_ty_app ty (tyConKind tc) tys' + ; return (TyConApp tc tys') } ----------------- -- Confirms that a type is really *, #, Constraint etc -checkValueKind :: OutKind -> SDoc -> LintM () -checkValueKind k doc - = lintL (classifiesTypeWithValues k) - (text "Non-*-like kind when *-like expected:" <+> ppr k $$ +checkValueType :: LintedType -> SDoc -> LintM () +checkValueType ty doc + = lintL (classifiesTypeWithValues kind) + (text "Non-*-like kind when *-like expected:" <+> ppr kind $$ text "when checking" <+> doc) + where + kind = typeKind ty ----------------- -lintArrow :: SDoc -> LintedKind -> LintedKind -> LintM LintedKind +lintArrow :: SDoc -> LintedType -> LintedType -> LintM () -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] -lintArrow what k1 k2 -- Eg lintArrow "type or kind `blah'" k1 k2 +lintArrow what t1 t2 -- Eg lintArrow "type or kind `blah'" k1 k2 -- or lintArrow "coercion `blah'" k1 k2 = do { unless (classifiesTypeWithValues k1) (addErrL (msg (text "argument") k1)) - ; unless (classifiesTypeWithValues k2) (addErrL (msg (text "result") k2)) - ; return liftedTypeKind } + ; unless (classifiesTypeWithValues k2) (addErrL (msg (text "result") k2)) } where + k1 = typeKind t1 + k2 = typeKind t2 msg ar k = vcat [ hang (text "Ill-kinded" <+> ar) 2 (text "in" <+> what) , what <+> text "kind:" <+> ppr k ] ----------------- -lint_ty_app :: Type -> LintedKind -> [(LintedType,LintedKind)] -> LintM LintedKind +lint_ty_app :: Type -> LintedKind -> [LintedType] -> LintM () lint_ty_app ty k tys = lint_app (text "type" <+> quotes (ppr ty)) k tys ---------------- -lint_co_app :: Coercion -> LintedKind -> [(LintedType,LintedKind)] -> LintM LintedKind +lint_co_app :: Coercion -> LintedKind -> [LintedType] -> LintM () lint_co_app ty k tys = lint_app (text "coercion" <+> quotes (ppr ty)) k tys @@ -1574,42 +1605,45 @@ lintTyLit (NumTyLit n) where msg = text "Negative type literal:" <+> integer n lintTyLit (StrTyLit _) = return () -lint_app :: SDoc -> LintedKind -> [(LintedType,LintedKind)] -> LintM Kind +lint_app :: SDoc -> LintedKind -> [LintedType] -> LintM () -- (lint_app d fun_kind arg_tys) -- We have an application (f arg_ty1 .. arg_tyn), -- where f :: fun_kind --- Takes care of linting the OutTypes -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] -lint_app doc kfn kas +lint_app doc kfn arg_tys = do { in_scope <- getInScope -- We need the in_scope set to satisfy the invariant in -- Note [The substitution invariant] in GHC.Core.TyCo.Subst - ; foldlM (go_app in_scope) kfn kas } + ; _ <- foldlM (go_app in_scope) kfn arg_tys + ; return () } where fail_msg extra = vcat [ hang (text "Kind application error in") 2 doc , nest 2 (text "Function kind =" <+> ppr kfn) - , nest 2 (text "Arg kinds =" <+> ppr kas) + , nest 2 (text "Arg types =" <+> ppr arg_tys) , extra ] - go_app in_scope kfn tka + go_app in_scope kfn ta | Just kfn' <- coreView kfn - = go_app in_scope kfn' tka + = go_app in_scope kfn' ta - go_app _ (FunTy _ kfa kfb) tka@(_,ka) - = do { unless (ka `eqType` kfa) $ - addErrL (fail_msg (text "Fun:" <+> (ppr kfa $$ ppr tka))) + go_app _ fun_kind@(FunTy _ kfa kfb) ta + = do { let ka = typeKind ta + ; unless (ka `eqType` kfa) $ + addErrL (fail_msg (text "Fun:" <+> (ppr fun_kind $$ ppr ta <+> dcolon <+> ppr ka))) ; return kfb } - go_app in_scope (ForAllTy (Bndr kv _vis) kfn) tka@(ta,ka) + go_app in_scope (ForAllTy (Bndr kv _vis) kfn) ta = do { let kv_kind = varType kv + ka = typeKind ta ; unless (ka `eqType` kv_kind) $ - addErrL (fail_msg (text "Forall:" <+> (ppr kv $$ ppr kv_kind $$ ppr tka))) + addErrL (fail_msg (text "Forall:" <+> (ppr kv $$ ppr kv_kind $$ + ppr ta <+> dcolon <+> ppr ka))) ; return $ substTy (extendTCvSubst (mkEmptyTCvSubst in_scope) kv ta) kfn } - go_app _ kfn ka - = failWithL (fail_msg (text "Not a fun:" <+> (ppr kfn $$ ppr ka))) + go_app _ kfn ta + = failWithL (fail_msg (text "Not a fun:" <+> (ppr kfn $$ ppr ta))) {- ********************************************************************* * * @@ -1617,7 +1651,7 @@ lint_app doc kfn kas * * ********************************************************************* -} -lintCoreRule :: OutVar -> OutType -> CoreRule -> LintM () +lintCoreRule :: OutVar -> LintedType -> CoreRule -> LintM () lintCoreRule _ _ (BuiltinRule {}) = return () -- Don't bother @@ -1710,68 +1744,94 @@ Note [Rules and join points] in OccurAnal for further discussion. ************************************************************************ -} -lintInCo :: InCoercion -> LintM (LintedKind, LintedKind, LintedType, LintedType, Role) --- Check the coercion, and apply the substitution to it --- See Note [Linting type lets] -lintInCo co - = addLoc (InCo co) $ - do { co' <- applySubstCo co - ; lintCoercion co' } +{- Note [Asymptotic efficiency] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When linting coercions (and types actually) we return a linted +(substituted) coercion. Then we often have to take the coercionKind of +that returned coercion. If we get long chains, that can be asymptotically +inefficient, notably in +* TransCo +* InstCo +* NthCo (cf #9233) +* LRCo + +But the code is simple. And this is only Lint. Let's wait to see if +the bad perf bites us in practice. + +A solution would be to return the kind and role of the coercion, +as well as the linted coercion. Or perhaps even *only* the kind and role, +which is what used to happen. But that proved tricky and error prone +(#17923), so now we return the coercion. +-} + -- lints a coercion, confirming that its lh kind and its rh kind are both * -- also ensures that the role is Nominal -lintStarCoercion :: OutCoercion -> LintM (LintedType, LintedType) +lintStarCoercion :: InCoercion -> LintM LintedCoercion lintStarCoercion g - = do { (k1, k2, t1, t2, r) <- lintCoercion g - ; checkValueKind k1 (text "the kind of the left type in" <+> ppr g) - ; checkValueKind k2 (text "the kind of the right type in" <+> ppr g) - ; lintRole g Nominal r - ; return (t1, t2) } - -lintCoercion :: OutCoercion -> LintM (LintedKind, LintedKind, LintedType, LintedType, Role) --- Check the kind of a coercion term, returning the kind --- Post-condition: the returned OutTypes are lint-free --- --- If lintCoercion co = (k1, k2, s1, s2, r) --- then co :: s1 ~r s2 --- s1 :: k1 --- s2 :: k2 - + = do { g' <- lintCoercion g + ; let Pair t1 t2 = coercionKind g' + ; checkValueType t1 (text "the kind of the left type in" <+> ppr g) + ; checkValueType t2 (text "the kind of the right type in" <+> ppr g) + ; lintRole g Nominal (coercionRole g) + ; return g' } + +lintCoercion :: InCoercion -> LintM LintedCoercion -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] + +lintCoercion (CoVarCo cv) + | not (isCoVar cv) + = failWithL (hang (text "Bad CoVarCo:" <+> ppr cv) + 2 (text "With offending type:" <+> ppr (varType cv))) + + | otherwise + = do { subst <- getTCvSubst + ; case lookupCoVar subst cv of + Just linted_co -> return linted_co ; + Nothing -> -- lintCoBndr always extends the substitition + failWithL $ + hang (text "The coercion variable" <+> pprBndr LetBind cv) + 2 (text "is out of scope") + } + + lintCoercion (Refl ty) - = do { k <- lintType ty - ; return (k, k, ty, ty, Nominal) } + = do { ty' <- lintType ty + ; return (Refl ty') } lintCoercion (GRefl r ty MRefl) - = do { k <- lintType ty - ; return (k, k, ty, ty, r) } + = do { ty' <- lintType ty + ; return (GRefl r ty' MRefl) } lintCoercion (GRefl r ty (MCo co)) - = do { k <- lintType ty - ; (_, _, k1, k2, r') <- lintCoercion co - ; ensureEqTys k k1 - (hang (text "GRefl coercion kind mis-match:" <+> ppr co) - 2 (vcat [ppr ty, ppr k, ppr k1])) - ; lintRole co Nominal r' - ; return (k1, k2, ty, mkCastTy ty co, r) } + = do { ty' <- lintType ty + ; co' <- lintCoercion co + ; let tk = typeKind ty' + tl = coercionLKind co' + ; ensureEqTys tk tl $ + hang (text "GRefl coercion kind mis-match:" <+> ppr co) + 2 (vcat [ppr ty', ppr tk, ppr tl]) + ; lintRole co' Nominal (coercionRole co') + ; return (GRefl r ty' (MCo co')) } lintCoercion co@(TyConAppCo r tc cos) | tc `hasKey` funTyConKey , [_rep1,_rep2,_co1,_co2] <- cos - = do { failWithL (text "Saturated TyConAppCo (->):" <+> ppr co) - } -- All saturated TyConAppCos should be FunCos + = failWithL (text "Saturated TyConAppCo (->):" <+> ppr co) + -- All saturated TyConAppCos should be FunCos | Just {} <- synTyConDefn_maybe tc = failWithL (text "Synonym in TyConAppCo:" <+> ppr co) | otherwise = do { checkTyCon tc - ; (k's, ks, ss, ts, rs) <- mapAndUnzip5M lintCoercion cos - ; k' <- lint_co_app co (tyConKind tc) (ss `zip` k's) - ; k <- lint_co_app co (tyConKind tc) (ts `zip` ks) - ; _ <- zipWith3M lintRole cos (tyConRolesX r tc) rs - ; return (k', k, mkTyConApp tc ss, mkTyConApp tc ts, r) } + ; cos' <- mapM lintCoercion cos + ; let (co_kinds, co_roles) = unzip (map coercionKindRole cos') + ; lint_co_app co (tyConKind tc) (map pFst co_kinds) + ; lint_co_app co (tyConKind tc) (map pSnd co_kinds) + ; zipWithM_ (lintRole co) (tyConRolesX r tc) co_roles + ; return (TyConAppCo r tc cos') } lintCoercion co@(AppCo co1 co2) | TyConAppCo {} <- co1 @@ -1779,111 +1839,66 @@ lintCoercion co@(AppCo co1 co2) | Just (TyConApp {}, _) <- isReflCo_maybe co1 = failWithL (text "Refl (TyConApp ...) to the left of AppCo:" <+> ppr co) | otherwise - = do { (k1, k2, s1, s2, r1) <- lintCoercion co1 - ; (k'1, k'2, t1, t2, r2) <- lintCoercion co2 - ; k3 <- lint_co_app co k1 [(t1,k'1)] - ; k4 <- lint_co_app co k2 [(t2,k'2)] + = do { co1' <- lintCoercion co1 + ; co2' <- lintCoercion co2 + ; let (Pair lk1 rk1, r1) = coercionKindRole co1' + (Pair lk2 rk2, r2) = coercionKindRole co2' + ; lint_co_app co (typeKind lk1) [lk2] + ; lint_co_app co (typeKind rk1) [rk2] + ; if r1 == Phantom then lintL (r2 == Phantom || r2 == Nominal) (text "Second argument in AppCo cannot be R:" $$ ppr co) else lintRole co Nominal r2 - ; return (k3, k4, mkAppTy s1 t1, mkAppTy s2 t2, r1) } + + ; return (AppCo co1' co2') } ---------- -lintCoercion (ForAllCo tv1 kind_co co) - -- forall over types - | isTyVar tv1 - = do { (_, k2) <- lintStarCoercion kind_co - ; let tv2 = setTyVarKind tv1 k2 - ; addInScopeTyCoVar tv1 $ - do { - ; (k3, k4, t1, t2, r) <- lintCoercion co - ; in_scope <- getInScope - ; let tyl = mkInvForAllTy tv1 t1 - subst = mkTvSubst in_scope $ - -- We need both the free vars of the `t2` and the - -- free vars of the range of the substitution in - -- scope. All the free vars of `t2` and `kind_co` should - -- already be in `in_scope`, because they've been - -- linted and `tv2` has the same unique as `tv1`. - -- See Note [The substitution invariant] in GHC.Core.TyCo.Subst. - unitVarEnv tv1 (TyVarTy tv2 `mkCastTy` mkSymCo kind_co) - tyr = mkInvForAllTy tv2 $ - substTy subst t2 - ; return (k3, k4, tyl, tyr, r) } } - -lintCoercion (ForAllCo cv1 kind_co co) - -- forall over coercions - = ASSERT( isCoVar cv1 ) - do { lintL (almostDevoidCoVarOfCo cv1 co) +lintCoercion co@(ForAllCo tcv1 kind_co body_co) + | not (isTyCoVar tcv1) + = failWithL (text "Non tyco binder in ForAllCo:" <+> ppr co) + | otherwise + = do { kind_co' <- lintStarCoercion kind_co + ; lintTyCoBndr tcv1 $ \tcv1' -> + do { body_co' <- lintCoercion body_co + ; ensureEqTys (varType tcv1') (coercionLKind kind_co') $ + text "Kind mis-match in ForallCo" <+> ppr co + + ; lintForAllBody tcv1' (coercionLKind body_co') + + ; when (isCoVar tcv1) $ + lintL (almostDevoidCoVarOfCo tcv1 body_co) (text "Covar can only appear in Refl and GRefl: " <+> ppr co) - ; (_, k2) <- lintStarCoercion kind_co - ; let cv2 = setVarType cv1 k2 - ; addInScopeTyCoVar cv1 $ - do { - ; (k3, k4, t1, t2, r) <- lintCoercion co - ; checkValueKind k3 (text "the body of a ForAllCo over covar:" <+> ppr co) - ; checkValueKind k4 (text "the body of a ForAllCo over covar:" <+> ppr co) - -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep - ; in_scope <- getInScope - ; let tyl = mkTyCoInvForAllTy cv1 t1 - r2 = coVarRole cv1 - kind_co' = downgradeRole r2 Nominal kind_co - eta1 = mkNthCo r2 2 kind_co' - eta2 = mkNthCo r2 3 kind_co' - subst = mkCvSubst in_scope $ - -- We need both the free vars of the `t2` and the - -- free vars of the range of the substitution in - -- scope. All the free vars of `t2` and `kind_co` should - -- already be in `in_scope`, because they've been - -- linted and `cv2` has the same unique as `cv1`. - -- See Note [The substitution invariant] in GHC.Core.TyCo.Subst. - unitVarEnv cv1 (eta1 `mkTransCo` (mkCoVarCo cv2) - `mkTransCo` (mkSymCo eta2)) - tyr = mkTyCoInvForAllTy cv2 $ - substTy subst t2 - ; return (liftedTypeKind, liftedTypeKind, tyl, tyr, r) } } - -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep + -- See "last wrinkle" in GHC.Core.Coercion + -- Note [Unused coercion variable in ForAllCo] -lintCoercion co@(FunCo r co1 co2) - = do { (k1,k'1,s1,t1,r1) <- lintCoercion co1 - ; (k2,k'2,s2,t2,r2) <- lintCoercion co2 - ; k <- lintArrow (text "coercion" <+> quotes (ppr co)) k1 k2 - ; k' <- lintArrow (text "coercion" <+> quotes (ppr co)) k'1 k'2 - ; lintRole co1 r r1 - ; lintRole co2 r r2 - ; return (k, k', mkVisFunTy s1 s2, mkVisFunTy t1 t2, r) } + ; return (ForAllCo tcv1' kind_co' body_co') } } -lintCoercion (CoVarCo cv) - | not (isCoVar cv) - = failWithL (hang (text "Bad CoVarCo:" <+> ppr cv) - 2 (text "With offending type:" <+> ppr (varType cv))) - | otherwise - = do { cv' <- lintTyCoVarInScope cv - ; lintUnliftedCoVar cv' - ; return $ coVarKindsTypesRole cv' } +lintCoercion co@(FunCo r co1 co2) + = do { co1' <- lintCoercion co1 + ; co2' <- lintCoercion co2 + ; let Pair lt1 rt1 = coercionKind co1 + Pair lt2 rt2 = coercionKind co2 + ; lintArrow (text "coercion" <+> quotes (ppr co)) lt1 lt2 + ; lintArrow (text "coercion" <+> quotes (ppr co)) rt1 rt2 + ; lintRole co1 r (coercionRole co1) + ; lintRole co2 r (coercionRole co2) + ; return (FunCo r co1' co2') } -- See Note [Bad unsafe coercion] lintCoercion co@(UnivCo prov r ty1 ty2) - = do { k1 <- lintType ty1 - ; k2 <- lintType ty2 - ; case prov of - PhantomProv kco -> do { lintRole co Phantom r - ; check_kinds kco k1 k2 } - - ProofIrrelProv kco -> do { lintL (isCoercionTy ty1) $ - mkBadProofIrrelMsg ty1 co - ; lintL (isCoercionTy ty2) $ - mkBadProofIrrelMsg ty2 co - ; check_kinds kco k1 k2 } - - PluginProv _ -> return () -- no extra checks + = do { ty1' <- lintType ty1 + ; ty2' <- lintType ty2 + ; let k1 = typeKind ty1' + k2 = typeKind ty2' + ; prov' <- lint_prov k1 k2 prov ; when (r /= Phantom && classifiesTypeWithValues k1 && classifiesTypeWithValues k2) (checkTypes ty1 ty2) - ; return (k1, k2, ty1, ty2, r) } + + ; return (UnivCo prov' r ty1' ty2') } where report s = hang (text $ "Unsafe coercion: " ++ s) 2 (vcat [ text "From:" <+> ppr ty1 @@ -1926,39 +1941,53 @@ lintCoercion co@(UnivCo prov r ty1 ty2) _ -> return () } - check_kinds kco k1 k2 = do { (k1', k2') <- lintStarCoercion kco - ; ensureEqTys k1 k1' (mkBadUnivCoMsg CLeft co) - ; ensureEqTys k2 k2' (mkBadUnivCoMsg CRight co) } + lint_prov k1 k2 (PhantomProv kco) + = do { kco' <- lintStarCoercion kco + ; lintRole co Phantom r + ; check_kinds kco' k1 k2 + ; return (PhantomProv kco') } + + lint_prov k1 k2 (ProofIrrelProv kco) + = do { lintL (isCoercionTy ty1) (mkBadProofIrrelMsg ty1 co) + ; lintL (isCoercionTy ty2) (mkBadProofIrrelMsg ty2 co) + ; kco' <- lintStarCoercion kco + ; check_kinds kco k1 k2 + ; return (ProofIrrelProv kco') } + + lint_prov _ _ prov@(PluginProv _) = return prov + + check_kinds kco k1 k2 + = do { let Pair k1' k2' = coercionKind kco + ; ensureEqTys k1 k1' (mkBadUnivCoMsg CLeft co) + ; ensureEqTys k2 k2' (mkBadUnivCoMsg CRight co) } lintCoercion (SymCo co) - = do { (k1, k2, ty1, ty2, r) <- lintCoercion co - ; return (k2, k1, ty2, ty1, r) } + = do { co' <- lintCoercion co + ; return (SymCo co') } lintCoercion co@(TransCo co1 co2) - = do { (k1a, _k1b, ty1a, ty1b, r1) <- lintCoercion co1 - ; (_k2a, k2b, ty2a, ty2b, r2) <- lintCoercion co2 + = do { co1' <- lintCoercion co1 + ; co2' <- lintCoercion co2 + ; let ty1b = coercionRKind co1' + ty2a = coercionLKind co2' ; ensureEqTys ty1b ty2a (hang (text "Trans coercion mis-match:" <+> ppr co) - 2 (vcat [ppr ty1a, ppr ty1b, ppr ty2a, ppr ty2b])) - ; lintRole co r1 r2 - ; return (k1a, k2b, ty1a, ty2b, r1) } + 2 (vcat [ppr (coercionKind co1'), ppr (coercionKind co2')])) + ; lintRole co (coercionRole co1) (coercionRole co2) + ; return (TransCo co1' co2') } lintCoercion the_co@(NthCo r0 n co) - = do { (_, _, s, t, r) <- lintCoercion co + = do { co' <- lintCoercion co + ; let (Pair s t, r) = coercionKindRole co' ; case (splitForAllTy_maybe s, splitForAllTy_maybe t) of - { (Just (tcv_s, _ty_s), Just (tcv_t, _ty_t)) + { (Just _, Just _) -- works for both tyvar and covar | n == 0 , (isForAllTy_ty s && isForAllTy_ty t) || (isForAllTy_co s && isForAllTy_co t) -> do { lintRole the_co Nominal r0 - ; return (ks, kt, ts, tt, r0) } - where - ts = varType tcv_s - tt = varType tcv_t - ks = typeKind ts - kt = typeKind tt + ; return (NthCo r0 n co') } ; _ -> case (splitTyConApp_maybe s, splitTyConApp_maybe t) of { (Just (tc_s, tys_s), Just (tc_t, tys_t)) @@ -1968,62 +1997,51 @@ lintCoercion the_co@(NthCo r0 n co) , tys_s `equalLength` tys_t , tys_s `lengthExceeds` n -> do { lintRole the_co tr r0 - ; return (ks, kt, ts, tt, r0) } - where - ts = getNth tys_s n - tt = getNth tys_t n - tr = nthRole r tc_s n - ks = typeKind ts - kt = typeKind tt + ; return (NthCo r0 n co') } + where + tr = nthRole r tc_s n ; _ -> failWithL (hang (text "Bad getNth:") 2 (ppr the_co $$ ppr s $$ ppr t)) }}} lintCoercion the_co@(LRCo lr co) - = do { (_,_,s,t,r) <- lintCoercion co + = do { co' <- lintCoercion co + ; let Pair s t = coercionKind co' + r = coercionRole co' ; lintRole co Nominal r ; case (splitAppTy_maybe s, splitAppTy_maybe t) of - (Just s_pr, Just t_pr) - -> return (ks_pick, kt_pick, s_pick, t_pick, Nominal) - where - s_pick = pickLR lr s_pr - t_pick = pickLR lr t_pr - ks_pick = typeKind s_pick - kt_pick = typeKind t_pick - + (Just _, Just _) -> return (LRCo lr co') _ -> failWithL (hang (text "Bad LRCo:") 2 (ppr the_co $$ ppr s $$ ppr t)) } lintCoercion (InstCo co arg) - = do { (k3, k4, t1',t2', r) <- lintCoercion co - ; (k1',k2',s1,s2, r') <- lintCoercion arg - ; lintRole arg Nominal r' - ; in_scope <- getInScope - ; case (splitForAllTy_ty_maybe t1', splitForAllTy_ty_maybe t2') of + = do { co' <- lintCoercion co + ; arg' <- lintCoercion arg + ; let Pair t1' t2' = coercionKind co' + Pair s1 s2 = coercionKind arg + + ; lintRole arg Nominal (coercionRole arg') + + ; case (splitForAllTy_ty_maybe t1', splitForAllTy_ty_maybe t2') of -- forall over tvar - { (Just (tv1,t1), Just (tv2,t2)) - | k1' `eqType` tyVarKind tv1 - , k2' `eqType` tyVarKind tv2 - -> return (k3, k4, - substTyWithInScope in_scope [tv1] [s1] t1, - substTyWithInScope in_scope [tv2] [s2] t2, r) + { (Just (tv1,_), Just (tv2,_)) + | typeKind s1 `eqType` tyVarKind tv1 + , typeKind s2 `eqType` tyVarKind tv2 + -> return (InstCo co' arg') | otherwise -> failWithL (text "Kind mis-match in inst coercion") + ; _ -> case (splitForAllTy_co_maybe t1', splitForAllTy_co_maybe t2') of -- forall over covar - { (Just (cv1, t1), Just (cv2, t2)) - | k1' `eqType` varType cv1 - , k2' `eqType` varType cv2 - , CoercionTy s1' <- s1 - , CoercionTy s2' <- s2 - -> do { return $ - (liftedTypeKind, liftedTypeKind - -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep - , substTy (mkCvSubst in_scope $ unitVarEnv cv1 s1') t1 - , substTy (mkCvSubst in_scope $ unitVarEnv cv2 s2') t2 - , r) } + { (Just (cv1, _), Just (cv2, _)) + | typeKind s1 `eqType` varType cv1 + , typeKind s2 `eqType` varType cv2 + , CoercionTy _ <- s1 + , CoercionTy _ <- s2 + -> return (InstCo co' arg') | otherwise -> failWithL (text "Kind mis-match in inst coercion") + ; _ -> failWithL (text "Bad argument of inst") }}} lintCoercion co@(AxiomInstCo con ind cos) @@ -2031,73 +2049,69 @@ lintCoercion co@(AxiomInstCo con ind cos) (bad_ax (text "index out of range")) ; let CoAxBranch { cab_tvs = ktvs , cab_cvs = cvs - , cab_roles = roles - , cab_lhs = lhs - , cab_rhs = rhs } = coAxiomNthBranch con ind + , cab_roles = roles } = coAxiomNthBranch con ind ; unless (cos `equalLength` (ktvs ++ cvs)) $ bad_ax (text "lengths") + ; cos' <- mapM lintCoercion cos ; subst <- getTCvSubst ; let empty_subst = zapTCvSubst subst - ; (subst_l, subst_r) <- foldlM check_ki - (empty_subst, empty_subst) - (zip3 (ktvs ++ cvs) roles cos) - ; let lhs' = substTys subst_l lhs - rhs' = substTy subst_r rhs - fam_tc = coAxiomTyCon con + ; _ <- foldlM check_ki (empty_subst, empty_subst) + (zip3 (ktvs ++ cvs) roles cos') + ; let fam_tc = coAxiomTyCon con ; case checkAxInstCo co of Just bad_branch -> bad_ax $ text "inconsistent with" <+> pprCoAxBranch fam_tc bad_branch Nothing -> return () - ; let s2 = mkTyConApp fam_tc lhs' - ; return (typeKind s2, typeKind rhs', s2, rhs', coAxiomRole con) } + ; return (AxiomInstCo con ind cos') } where bad_ax what = addErrL (hang (text "Bad axiom application" <+> parens what) 2 (ppr co)) - check_ki (subst_l, subst_r) (ktv, role, arg) - = do { (k', k'', s', t', r) <- lintCoercion arg - ; lintRole arg role r + check_ki (subst_l, subst_r) (ktv, role, arg') + = do { let Pair s' t' = coercionKind arg' + sk' = typeKind s' + tk' = typeKind t' + ; lintRole arg' role (coercionRole arg') ; let ktv_kind_l = substTy subst_l (tyVarKind ktv) ktv_kind_r = substTy subst_r (tyVarKind ktv) - ; unless (k' `eqType` ktv_kind_l) - (bad_ax (text "check_ki1" <+> vcat [ ppr co, ppr k', ppr ktv, ppr ktv_kind_l ] )) - ; unless (k'' `eqType` ktv_kind_r) - (bad_ax (text "check_ki2" <+> vcat [ ppr co, ppr k'', ppr ktv, ppr ktv_kind_r ] )) + ; unless (sk' `eqType` ktv_kind_l) + (bad_ax (text "check_ki1" <+> vcat [ ppr co, ppr sk', ppr ktv, ppr ktv_kind_l ] )) + ; unless (tk' `eqType` ktv_kind_r) + (bad_ax (text "check_ki2" <+> vcat [ ppr co, ppr tk', ppr ktv, ppr ktv_kind_r ] )) ; return (extendTCvSubst subst_l ktv s', extendTCvSubst subst_r ktv t') } lintCoercion (KindCo co) - = do { (k1, k2, _, _, _) <- lintCoercion co - ; return (liftedTypeKind, liftedTypeKind, k1, k2, Nominal) } + = do { co' <- lintCoercion co + ; return (KindCo co') } lintCoercion (SubCo co') - = do { (k1,k2,s,t,r) <- lintCoercion co' - ; lintRole co' Nominal r - ; return (k1,k2,s,t,Representational) } - -lintCoercion this@(AxiomRuleCo co cs) - = do { eqs <- mapM lintCoercion cs - ; lintRoles 0 (coaxrAsmpRoles co) eqs - ; case coaxrProves co [ Pair l r | (_,_,l,r,_) <- eqs ] of + = do { co' <- lintCoercion co' + ; lintRole co' Nominal (coercionRole co') + ; return (SubCo co') } + +lintCoercion this@(AxiomRuleCo ax cos) + = do { cos' <- mapM lintCoercion cos + ; lint_roles 0 (coaxrAsmpRoles ax) cos' + ; case coaxrProves ax (map coercionKind cos') of Nothing -> err "Malformed use of AxiomRuleCo" [ ppr this ] - Just (Pair l r) -> - return (typeKind l, typeKind r, l, r, coaxrRole co) } + Just _ -> return (AxiomRuleCo ax cos') } where err m xs = failWithL $ - hang (text m) 2 $ vcat (text "Rule:" <+> ppr (coaxrName co) : xs) + hang (text m) 2 $ vcat (text "Rule:" <+> ppr (coaxrName ax) : xs) - lintRoles n (e : es) ((_,_,_,_,r) : rs) - | e == r = lintRoles (n+1) es rs + lint_roles n (e : es) (co : cos) + | e == coercionRole co = lint_roles (n+1) es cos | otherwise = err "Argument roles mismatch" [ text "In argument:" <+> int (n+1) , text "Expected:" <+> ppr e - , text "Found:" <+> ppr r ] - lintRoles _ [] [] = return () - lintRoles n [] rs = err "Too many coercion arguments" + , text "Found:" <+> ppr (coercionRole co) ] + lint_roles _ [] [] = return () + lint_roles n [] rs = err "Too many coercion arguments" [ text "Expected:" <+> int n , text "Provided:" <+> int (n + length rs) ] - lintRoles n es [] = err "Not enough coercion arguments" + lint_roles n es [] = err "Not enough coercion arguments" [ text "Expected:" <+> int (n + length es) , text "Provided:" <+> int n ] @@ -2106,13 +2120,6 @@ lintCoercion (HoleCo h) ; lintCoercion (CoVarCo (coHoleCoVar h)) } ----------- -lintUnliftedCoVar :: CoVar -> LintM () -lintUnliftedCoVar cv - = when (not (isUnliftedType (coVarKind cv))) $ - failWithL (text "Bad lifted equality:" <+> ppr cv - <+> dcolon <+> ppr (coVarKind cv)) - {- ************************************************************************ * * @@ -2129,12 +2136,19 @@ data LintEnv , le_subst :: TCvSubst -- Current TyCo substitution -- See Note [Linting type lets] - -- /Only/ substitutes for type variables; - -- but might clone CoVars - -- We also use le_subst to keep track of - -- in-scope TyVars and CoVars + -- /Only/ substitutes for type variables; + -- but might clone CoVars + -- We also use le_subst to keep track of + -- in-scope TyVars and CoVars (but not Ids) + -- Range of the TCvSubst is LintedType/LintedCo + + , le_ids :: VarEnv (Id, LintedType) -- In-scope Ids + -- Used to check that occurrences have an enclosing binder. + -- The Id is /pre-substitution/, used to check that + -- the occurrence has an identical type to the binder + -- The LintedType is used to return the type of the occurrence, + -- without having to lint it again. - , le_ids :: IdSet -- In-scope Ids , le_joins :: IdSet -- Join points in scope that are valid -- A subset of the InScopeSet in le_subst -- See Note [Join points] @@ -2266,6 +2280,7 @@ instance HasDynFlags LintM where data LintLocInfo = RhsOf Id -- The variable bound + | OccOf Id -- Occurrence of id | LambdaBodyOf Id -- The lambda-binder | UnfoldingOf Id -- Unfolding of a binder | BodyOfLetRec [Id] -- One of the binders @@ -2278,7 +2293,6 @@ data LintLocInfo | ImportedUnfolding SrcLoc -- Some imported unfolding (ToDo: say which) | TopLevelBindings | InType Type -- Inside a type - | InKind Type Kind -- Inside a kind | InCo Coercion -- Inside a coercion initL :: DynFlags -> LintFlags -> [Var] @@ -2293,7 +2307,7 @@ initL dflags flags vars m (tcvs, ids) = partition isTyCoVar vars env = LE { le_flags = flags , le_subst = mkEmptyTCvSubst (mkInScopeSet (mkVarSet tcvs)) - , le_ids = mkVarSet ids + , le_ids = mkVarEnv [(id, (id,idType id)) | id <- ids] , le_joins = emptyVarSet , le_loc = [] , le_dynflags = dflags } @@ -2341,7 +2355,7 @@ addWarnL msg = LintM $ \ env (warns,errs) -> addMsg :: Bool -> LintEnv -> Bag MsgDoc -> MsgDoc -> Bag MsgDoc addMsg is_error env msgs msg - = ASSERT( notNull loc_msgs ) + = ASSERT2( notNull loc_msgs, msg ) msgs `snocBag` mk_msg msg where loc_msgs :: [(SrcLoc, SDoc)] -- Innermost first @@ -2373,18 +2387,17 @@ inCasePat = LintM $ \ env errs -> (Just (is_case_pat env), errs) is_case_pat (LE { le_loc = CasePat {} : _ }) = True is_case_pat _other = False -addInScopeTyCoVar :: Var -> LintM a -> LintM a -addInScopeTyCoVar var m - = LintM $ \ env errs -> - unLintM m (env { le_subst = extendTCvInScope (le_subst env) var }) errs - -addInScopeId :: Id -> LintM a -> LintM a -addInScopeId id m - = LintM $ \ env errs -> - unLintM m (env { le_ids = extendVarSet (le_ids env) id - , le_joins = delVarSet (le_joins env) id }) errs +addInScopeId :: Id -> LintedType -> LintM a -> LintM a +addInScopeId id linted_ty m + = LintM $ \ env@(LE { le_ids = id_set, le_joins = join_set }) errs -> + unLintM m (env { le_ids = extendVarEnv id_set id (id, linted_ty) + , le_joins = add_joins join_set }) errs + where + add_joins join_set + | isJoinId id = extendVarSet join_set id -- Overwrite with new arity + | otherwise = delVarSet join_set id -- Remove any existing binding -getInScopeIds :: LintM IdSet +getInScopeIds :: LintM (VarEnv (Id,LintedType)) getInScopeIds = LintM (\env errs -> (Just (le_ids env), errs)) extendTvSubstL :: TyVar -> Type -> LintM a -> LintM a @@ -2404,13 +2417,6 @@ markAllJoinsBadIf :: Bool -> LintM a -> LintM a markAllJoinsBadIf True m = markAllJoinsBad m markAllJoinsBadIf False m = m -addGoodJoins :: [Var] -> LintM a -> LintM a -addGoodJoins vars thing_inside - = LintM $ \ env errs -> unLintM thing_inside (add_joins env) errs - where - add_joins env = env { le_joins = le_joins env `extendVarSetList` join_ids } - join_ids = filter isJoinId vars - getValidJoins :: LintM IdSet getValidJoins = LintM (\ env errs -> (Just (le_joins env), errs)) @@ -2420,20 +2426,17 @@ getTCvSubst = LintM (\ env errs -> (Just (le_subst env), errs)) getInScope :: LintM InScopeSet getInScope = LintM (\ env errs -> (Just (getTCvInScope $ le_subst env), errs)) -applySubstTy :: InType -> LintM OutType -applySubstTy ty = do { subst <- getTCvSubst; return (substTy subst ty) } - -applySubstCo :: InCoercion -> LintM OutCoercion -applySubstCo co = do { subst <- getTCvSubst; return (substCo subst co) } - -lookupIdInScope :: Id -> LintM Id +lookupIdInScope :: Id -> LintM (Id, LintedType) lookupIdInScope id_occ = do { in_scope_ids <- getInScopeIds - ; case lookupVarSet in_scope_ids id_occ of - Just id_bnd -> do { checkL (not (bad_global id_bnd)) global_in_scope - ; return id_bnd } + ; case lookupVarEnv in_scope_ids id_occ of + Just (id_bndr, linted_ty) + -> do { checkL (not (bad_global id_bndr)) global_in_scope + ; return (id_bndr, linted_ty) } Nothing -> do { checkL (not is_local) local_out_of_scope - ; return id_occ } } + ; return (id_occ, idType id_occ) } } + -- We don't bother to lint the type + -- of global (i.e. imported) Ids where is_local = mustHaveLocalBinding id_occ local_out_of_scope = text "Out of scope:" <+> pprBndr LetBind id_occ @@ -2461,16 +2464,7 @@ lookupJoinId id Just id' -> return (isJoinId_maybe id') Nothing -> return Nothing } -lintTyCoVarInScope :: TyCoVar -> LintM TyCoVar -lintTyCoVarInScope var - = do { subst <- getTCvSubst - ; case lookupInScope (getTCvInScope subst) var of - Just var' -> return var' - Nothing -> failWithL $ - hang (text "The TyCo variable" <+> pprBndr LetBind var) - 2 (text "is out of scope") } - -ensureEqTys :: OutType -> OutType -> MsgDoc -> LintM () +ensureEqTys :: LintedType -> LintedType -> MsgDoc -> LintM () -- check ty2 is subtype of ty1 (ie, has same structure but usage -- annotations need only be consistent, not equal) -- Assumes ty1,ty2 are have already had the substitution applied @@ -2500,6 +2494,9 @@ dumpLoc :: LintLocInfo -> (SrcLoc, SDoc) dumpLoc (RhsOf v) = (getSrcLoc v, text "In the RHS of" <+> pp_binders [v]) +dumpLoc (OccOf v) + = (getSrcLoc v, text "In an occurrence of" <+> pp_binder v) + dumpLoc (LambdaBodyOf b) = (getSrcLoc b, text "In the body of lambda with binder" <+> pp_binder b) @@ -2534,8 +2531,6 @@ dumpLoc TopLevelBindings = (noSrcLoc, Outputable.empty) dumpLoc (InType ty) = (noSrcLoc, text "In the type" <+> quotes (ppr ty)) -dumpLoc (InKind ty ki) - = (noSrcLoc, text "In the kind of" <+> parens (ppr ty <+> dcolon <+> ppr ki)) dumpLoc (InCo co) = (noSrcLoc, text "In the coercion" <+> quotes (ppr co)) @@ -2780,7 +2775,7 @@ mkJoinBndrOccMismatchMsg bndr join_arity_bndr join_arity_occ , text "Arity at binding site:" <+> ppr join_arity_bndr , text "Arity at occurrence: " <+> ppr join_arity_occ ] -mkBndrOccTypeMismatchMsg :: Var -> Var -> OutType -> OutType -> SDoc +mkBndrOccTypeMismatchMsg :: Var -> Var -> LintedType -> LintedType -> SDoc mkBndrOccTypeMismatchMsg bndr var bndr_ty var_ty = vcat [ text "Mismatch in type between binder and occurrence" , text "Binder:" <+> ppr bndr <+> dcolon <+> ppr bndr_ty ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -2447,7 +2447,7 @@ normally it would make no sense to have forall r. (ty :: K r) because the kind of the forall would escape the binding of 'r'. But in this case it's fine because (K r) exapands -to Type, so we expliclity /permit/ the type +to Type, so we explicitly /permit/ the type forall r. T r To accommodate such a type, in typeKind (forall a.ty) we use @@ -2455,8 +2455,13 @@ occCheckExpand to expand any type synonyms in the kind of 'ty' to eliminate 'a'. See kinding rule (FORALL) in Note [Kinding rules for types] -And in TcValidity.checkEscapingKind, we use also use -occCheckExpand, for the same reason. +See also + * TcUnify.occCheckExpand + * GHC.Core.Utils.coreAltsType + * TcValidity.checkEscapingKind +all of which grapple with with the same problem. + +See #14939. -} ----------------------------- ===================================== testsuite/tests/indexed-types/should_compile/T17923.hs ===================================== @@ -0,0 +1,44 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# OPTIONS_GHC -Wall #-} +module Bug where + +import Data.Kind + +-- type SingFunction2 f = forall t1 t2. Sing t1 -> Sing t2 -> Sing (f `Apply` t1 `Apply` t2) +type SingFunction2 f = forall t1. Sing t1 -> forall t2. Sing t2 -> Sing (f `Apply` t1 `Apply` t2) +singFun2 :: forall f. SingFunction2 f -> Sing f +singFun2 f = SLambda (\x -> SLambda (f x)) + +type family Sing :: k -> Type +data TyFun :: Type -> Type -> Type +type a ~> b = TyFun a b -> Type +infixr 0 ~> + +type family Apply (f :: a ~> b) (x :: a) :: b +data Sym4 a +data Sym3 a + +type instance Apply Sym3 _ = Sym4 + +newtype SLambda (f :: k1 ~> k2) = + SLambda { applySing :: forall t. Sing t -> Sing (Apply f t) } +type instance Sing = SLambda + +und :: a +und = undefined + +data E +data ShowCharSym0 :: E ~> E ~> E + +sShow_tuple :: SLambda Sym4 +sShow_tuple + = applySing (singFun2 @Sym3 und) + (und (singFun2 @Sym3 + (und (applySing (singFun2 @Sym3 und) + (applySing (singFun2 @ShowCharSym0 und) und))))) ===================================== testsuite/tests/indexed-types/should_compile/all.T ===================================== @@ -294,3 +294,4 @@ test('T16828', normal, compile, ['']) test('T17008b', normal, compile, ['']) test('T17056', normal, compile, ['']) test('T17405', normal, multimod_compile, ['T17405c', '-v0']) +test('T17923', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/03e1f65f8394f610b722c9e6c16b2df520e8cfcc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/03e1f65f8394f610b722c9e6c16b2df520e8cfcc You're receiving 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 Mar 26 14:41:37 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Thu, 26 Mar 2020 10:41:37 -0400 Subject: [Git][ghc/ghc][wip/T17923] Significant refactor of Lint Message-ID: <5e7cbf21380a6_616776d1c7473493@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T17923 at Glasgow Haskell Compiler / GHC Commits: a9934ce8 by Simon Peyton Jones at 2020-03-26T14:41:04+00: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. - - - - - 4 changed files: - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Type.hs - + testsuite/tests/indexed-types/should_compile/T17923.hs - testsuite/tests/indexed-types/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -8,7 +8,7 @@ See Note [Core Lint guarantee]. -} {-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE ScopedTypeVariables, DeriveFunctor #-} module GHC.Core.Lint ( lintCoreBindings, lintUnfolding, @@ -33,7 +33,6 @@ import GHC.Core.Op.Monad import Bag import Literal import GHC.Core.DataCon -import TysWiredIn import TysPrim import TcType ( isFloatingTy ) import Var @@ -461,14 +460,17 @@ lintCoreBindings :: DynFlags -> CoreToDo -> [Var] -> CoreProgram -> (Bag MsgDoc, lintCoreBindings dflags pass local_in_scope binds = initL dflags flags local_in_scope $ addLoc TopLevelBindings $ - lintLetBndrs TopLevel binders $ - -- Put all the top-level binders in scope at the start - -- This is because transformation rules can bring something - -- into use 'unexpectedly' do { checkL (null dups) (dupVars dups) ; checkL (null ext_dups) (dupExtVars ext_dups) - ; mapM lint_bind binds } + ; lintRecBindings TopLevel all_pairs $ + return () } where + all_pairs = flattenBinds binds + -- Put all the top-level binders in scope at the start + -- This is because transformation rules can bring something + -- into use 'unexpectedly'; see Note [Glomming] in OccurAnal + binders = map fst all_pairs + flags = defaultLintFlags { lf_check_global_ids = check_globals , lf_check_inline_loop_breakers = check_lbs @@ -494,7 +496,6 @@ lintCoreBindings dflags pass local_in_scope binds CorePrep -> AllowAtTopLevel _ -> AllowAnywhere - binders = bindersOfBinds binds (_, dups) = removeDups compare binders -- dups_ext checks for names with different uniques @@ -509,11 +510,6 @@ lintCoreBindings dflags pass local_in_scope binds = compare (m1, nameOccName n1) (m2, nameOccName n2) | otherwise = LT - -- If you edit this function, you may need to update the GHC formalism - -- See Note [GHC Formalism] - lint_bind (Rec prs) = mapM_ (lintSingleBinding TopLevel Recursive) prs - lint_bind (NonRec bndr rhs) = lintSingleBinding TopLevel NonRecursive (bndr,rhs) - {- ************************************************************************ * * @@ -576,28 +572,32 @@ lintExpr dflags vars expr Check a core binding, returning the list of variables bound. -} -lintSingleBinding :: TopLevelFlag -> RecFlag -> (Id, CoreExpr) -> LintM () --- If you edit this function, you may need to update the GHC formalism --- See Note [GHC Formalism] -lintSingleBinding top_lvl_flag rec_flag (binder,rhs) - = addLoc (RhsOf binder) $ - -- Check the rhs - do { ty <- lintRhs binder rhs - ; binder_ty <- applySubstTy (idType binder) - ; ensureEqTys binder_ty ty (mkRhsMsg binder (text "RHS") ty) +lintRecBindings :: TopLevelFlag -> [(Id, CoreExpr)] + -> LintM a -> LintM a +lintRecBindings top_lvl pairs thing_inside + = lintIdBndrs top_lvl bndrs $ \ bndrs' -> + do { zipWithM_ lint_pair bndrs' rhss + ; thing_inside } + where + (bndrs, rhss) = unzip pairs + lint_pair bndr' rhs + = addLoc (RhsOf bndr') $ + do { rhs_ty <- lintRhs bndr' rhs -- Check the rhs + ; lintLetBind top_lvl Recursive bndr' rhs rhs_ty } + +lintLetBind :: TopLevelFlag -> RecFlag -> LintedId + -> CoreExpr -> LintedType -> LintM () +-- Binder's type, and the RHS, have already been linted +-- This function checks other invariants +lintLetBind top_lvl rec_flag binder rhs rhs_ty + = do { let binder_ty = idType binder + ; ensureEqTys binder_ty rhs_ty (mkRhsMsg binder (text "RHS") rhs_ty) -- If the binding is for a CoVar, the RHS should be (Coercion co) -- See Note [Core type and coercion invariant] in GHC.Core ; checkL (not (isCoVar binder) || isCoArg rhs) (mkLetErr binder rhs) - -- Check that it's not levity-polymorphic - -- Do this first, because otherwise isUnliftedType panics - -- Annoyingly, this duplicates the test in lintIdBdr, - -- because for non-rec lets we call lintSingleBinding first - ; checkL (isJoinId binder || not (isTypeLevPoly binder_ty)) - (badBndrTyMsg binder (text "levity-polymorphic")) - -- Check the let/app invariant -- See Note [Core let/app invariant] in GHC.Core ; checkL ( isJoinId binder @@ -610,14 +610,14 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs) -- 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_flag)) + || (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]. - ; checkL (not (isTopLevel top_lvl_flag && binder_ty `eqType` addrPrimTy) + ; checkL (not (isTopLevel top_lvl && binder_ty `eqType` addrPrimTy) || exprIsTickedString rhs) (mkTopNonLitStrMsg binder) @@ -674,7 +674,9 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs) -- join point. -- -- See Note [Checking StaticPtrs]. -lintRhs :: Id -> CoreExpr -> LintM OutType +lintRhs :: Id -> CoreExpr -> LintM LintedType +-- NB: the Id can be Linted or not -- it's only used for +-- its OccInfo and join-pointer-hood lintRhs bndr rhs | Just arity <- isJoinId_maybe bndr = lint_join_lams arity arity True rhs @@ -761,13 +763,14 @@ hurts us here. ************************************************************************ -} --- For OutType, OutKind, the substitution has been applied, --- but has not been linted yet +-- Linted things: substitution applied, and type is linted +type LintedType = Type +type LintedKind = Kind +type LintedCoercion = Coercion +type LintedTyCoVar = TyCoVar +type LintedId = Id -type LintedType = Type -- Substitution applied, and type is linted -type LintedKind = Kind - -lintCoreExpr :: CoreExpr -> LintM OutType +lintCoreExpr :: CoreExpr -> LintM LintedType -- The returned type has the substitution from the monad -- already applied to it: -- lintCoreExpr e subst = exprType (subst e) @@ -776,18 +779,20 @@ lintCoreExpr :: CoreExpr -> LintM OutType -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] + lintCoreExpr (Var var) - = lintVarOcc var 0 + = lintIdOcc var 0 lintCoreExpr (Lit lit) = return (literalType lit) lintCoreExpr (Cast expr co) = do { expr_ty <- markAllJoinsBad $ lintCoreExpr expr - ; co' <- applySubstCo co - ; (_, k2, from_ty, to_ty, r) <- lintCoercion co' - ; checkValueKind k2 (text "target of cast" <+> quotes (ppr co)) - ; lintRole co' Representational r + ; co' <- lintCoercion co + ; let (Pair from_ty to_ty, role) = coercionKindRole co' + ; checkValueType to_ty $ + text "target of cast" <+> quotes (ppr co') + ; lintRole co' Representational role ; ensureEqTys from_ty expr_ty (mkCastErr expr co' from_ty expr_ty) ; return to_ty } @@ -809,7 +814,7 @@ lintCoreExpr (Tick tickish expr) lintCoreExpr (Let (NonRec tv (Type ty)) body) | isTyVar tv = -- See Note [Linting type lets] - do { ty' <- applySubstTy ty + do { ty' <- lintType ty ; lintTyBndr tv $ \ tv' -> do { addLoc (RhsOf tv) $ lintTyKind tv' ty' -- Now extend the substitution so we @@ -820,33 +825,34 @@ lintCoreExpr (Let (NonRec tv (Type ty)) body) lintCoreExpr (Let (NonRec bndr rhs) body) | isId bndr - = do { lintSingleBinding NotTopLevel NonRecursive (bndr,rhs) - ; addLoc (BodyOfLetRec [bndr]) - (lintBinder LetBind bndr $ \_ -> - addGoodJoins [bndr] $ - lintCoreExpr body) } + = do { -- First Lint the RHS, before bringing the binder into scope + rhs_ty <- lintRhs bndr rhs + + -- Now lint the binder + ; lintBinder LetBind bndr $ \bndr' -> + do { lintLetBind NotTopLevel NonRecursive bndr' rhs rhs_ty + ; addLoc (BodyOfLetRec [bndr]) (lintCoreExpr body) } } | otherwise = failWithL (mkLetErr bndr rhs) -- Not quite accurate lintCoreExpr e@(Let (Rec pairs) body) - = lintLetBndrs NotTopLevel bndrs $ - addGoodJoins bndrs $ - do { -- Check that the list of pairs is non-empty + = do { -- Check that the list of pairs is non-empty checkL (not (null pairs)) (emptyRec e) -- Check that there are no duplicated binders + ; let (_, dups) = removeDups compare bndrs ; checkL (null dups) (dupVars dups) -- Check that either all the binders are joins, or none ; checkL (all isJoinId bndrs || all (not . isJoinId) bndrs) $ - mkInconsistentRecMsg bndrs + mkInconsistentRecMsg bndrs - ; mapM_ (lintSingleBinding NotTopLevel Recursive) pairs - ; addLoc (BodyOfLetRec bndrs) (lintCoreExpr body) } + ; lintRecBindings NotTopLevel pairs $ + addLoc (BodyOfLetRec bndrs) $ + lintCoreExpr body } where bndrs = map fst pairs - (_, dups) = removeDups compare bndrs lintCoreExpr e@(App _ _) = do { fun_ty <- lintCoreFun fun (length args) @@ -867,23 +873,35 @@ lintCoreExpr (Type ty) = failWithL (text "Type found as expression" <+> ppr ty) lintCoreExpr (Coercion co) - = do { (k1, k2, ty1, ty2, role) <- lintInCo co - ; return (mkHeteroCoercionType role k1 k2 ty1 ty2) } + = do { co' <- addLoc (InCo co) $ + lintCoercion co + ; return (coercionType co') } ---------------------- -lintVarOcc :: Var -> Int -- Number of arguments (type or value) being passed - -> LintM Type -- returns type of the *variable* -lintVarOcc var nargs - = do { checkL (isNonCoVarId var) +lintIdOcc :: Var -> Int -- Number of arguments (type or value) being passed + -> LintM LintedType -- returns type of the *variable* +lintIdOcc var nargs + = addLoc (OccOf var) $ + do { checkL (isNonCoVarId var) (text "Non term variable" <+> ppr var) -- See GHC.Core Note [Variable occurrences in Core] -- Check that the type of the occurrence is the same - -- as the type of the binding site - ; ty <- applySubstTy (idType var) - ; var' <- lookupIdInScope var - ; let ty' = idType var' - ; ensureEqTys ty ty' $ mkBndrOccTypeMismatchMsg var' var ty' ty + -- as the type of the binding site. The inScopeIds are + -- /un-substituted/, so this checks that the occurrence type + -- is identical to the binder type. + -- This makes things much easier for things like: + -- /\a. \(x::Maybe a). /\a. ...(x::Maybe a)... + -- The "::Maybe a" on the occurrence is referring to the /outer/ a. + -- If we compared /substituted/ types we'd risk comparing + -- (Maybe a) from the binding site with bogus (Maybe a1) from + -- the occurrence site. Comparing un-substituted types finesses + -- this altogether + ; (bndr, linted_bndr_ty) <- lookupIdInScope var + ; let occ_ty = idType var + bndr_ty = idType bndr + ; ensureEqTys occ_ty bndr_ty $ + mkBndrOccTypeMismatchMsg bndr var bndr_ty occ_ty -- Check for a nested occurrence of the StaticPtr constructor. -- See Note [Checking StaticPtrs]. @@ -895,13 +913,13 @@ lintVarOcc var nargs ; checkDeadIdOcc var ; checkJoinOcc var nargs - ; return (idType var') } + ; return linted_bndr_ty } lintCoreFun :: CoreExpr - -> Int -- Number of arguments (type or val) being passed - -> LintM Type -- Returns type of the *function* + -> Int -- Number of arguments (type or val) being passed + -> LintM LintedType -- Returns type of the *function* lintCoreFun (Var var) nargs - = lintVarOcc var nargs + = lintIdOcc var nargs lintCoreFun (Lam var body) nargs -- Act like lintCoreExpr of Lam, but *don't* call markAllJoinsBad; see @@ -941,7 +959,9 @@ checkJoinOcc var n_args = do { mb_join_arity_bndr <- lookupJoinId var ; case mb_join_arity_bndr of { Nothing -> -- Binder is not a join point - addErrL (invalidJoinOcc var) ; + do { join_set <- getValidJoins + ; addErrL (text "join set " <+> ppr join_set $$ + invalidJoinOcc var) } ; Just join_arity_bndr -> @@ -1038,15 +1058,15 @@ subtype of the required type, as one would expect. -} -lintCoreArgs :: OutType -> [CoreArg] -> LintM OutType +lintCoreArgs :: LintedType -> [CoreArg] -> LintM LintedType lintCoreArgs fun_ty args = foldM lintCoreArg fun_ty args -lintCoreArg :: OutType -> CoreArg -> LintM OutType +lintCoreArg :: LintedType -> CoreArg -> LintM LintedType lintCoreArg fun_ty (Type arg_ty) = do { checkL (not (isCoercionTy arg_ty)) (text "Unnecessary coercion-to-type injection:" <+> ppr arg_ty) - ; arg_ty' <- applySubstTy arg_ty + ; arg_ty' <- lintType arg_ty ; lintTyApp fun_ty arg_ty' } lintCoreArg fun_ty arg @@ -1060,11 +1080,12 @@ lintCoreArg fun_ty arg ; checkL (not (isUnliftedType arg_ty) || exprOkForSpeculation arg) (mkLetAppMsg arg) + ; lintValApp arg fun_ty arg_ty } ----------------- -lintAltBinders :: OutType -- Scrutinee type - -> OutType -- Constructor type +lintAltBinders :: LintedType -- Scrutinee type + -> LintedType -- Constructor type -> [OutVar] -- Binders -> LintM () -- If you edit this function, you may need to update the GHC formalism @@ -1080,7 +1101,7 @@ lintAltBinders scrut_ty con_ty (bndr:bndrs) ; lintAltBinders scrut_ty con_ty' bndrs } ----------------- -lintTyApp :: OutType -> OutType -> LintM OutType +lintTyApp :: LintedType -> LintedType -> LintM LintedType lintTyApp fun_ty arg_ty | Just (tv,body_ty) <- splitForAllTy_maybe fun_ty = do { lintTyKind tv arg_ty @@ -1094,7 +1115,7 @@ lintTyApp fun_ty arg_ty = failWithL (mkTyAppMsg fun_ty arg_ty) ----------------- -lintValApp :: CoreExpr -> OutType -> OutType -> LintM OutType +lintValApp :: CoreExpr -> LintedType -> LintedType -> LintM LintedType lintValApp arg fun_ty arg_ty | Just (arg,res) <- splitFunTy_maybe fun_ty = do { ensureEqTys arg arg_ty err1 @@ -1105,17 +1126,17 @@ lintValApp arg fun_ty arg_ty err1 = mkAppMsg fun_ty arg_ty arg err2 = mkNonFunAppMsg fun_ty arg_ty arg -lintTyKind :: OutTyVar -> OutType -> LintM () +lintTyKind :: OutTyVar -> LintedType -> LintM () -- Both args have had substitution applied -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] lintTyKind tyvar arg_ty - = do { arg_kind <- lintType arg_ty - ; unless (arg_kind `eqType` tyvar_kind) - (addErrL (mkKindErrMsg tyvar arg_ty $$ (text "Linted Arg kind:" <+> ppr arg_kind))) } + = unless (arg_kind `eqType` tyvar_kind) $ + addErrL (mkKindErrMsg tyvar arg_ty $$ (text "Linted Arg kind:" <+> ppr arg_kind)) where tyvar_kind = tyVarKind tyvar + arg_kind = typeKind arg_ty {- ************************************************************************ @@ -1125,7 +1146,7 @@ lintTyKind tyvar arg_ty ************************************************************************ -} -lintCaseExpr :: CoreExpr -> Id -> Type -> [CoreAlt] -> LintM OutType +lintCaseExpr :: CoreExpr -> Id -> Type -> [CoreAlt] -> LintM LintedType lintCaseExpr scrut var alt_ty alts = do { let e = Case scrut var alt_ty alts -- Just for error messages @@ -1134,10 +1155,10 @@ lintCaseExpr scrut var alt_ty alts = -- See Note [Join points are less general than the paper] -- in GHC.Core - ; (alt_ty, _) <- addLoc (CaseTy scrut) $ - lintInTy alt_ty - ; (var_ty, _) <- addLoc (IdTy var) $ - lintInTy (idType var) + ; alt_ty <- addLoc (CaseTy scrut) $ + lintValueType alt_ty + ; var_ty <- addLoc (IdTy var) $ + lintValueType (idType var) -- We used to try to check whether a case expression with no -- alternatives was legitimate, but this didn't work. @@ -1179,7 +1200,7 @@ lintCaseExpr scrut var alt_ty alts = ; checkCaseAlts e scrut_ty alts ; return alt_ty } } -checkCaseAlts :: CoreExpr -> OutType -> [CoreAlt] -> LintM () +checkCaseAlts :: CoreExpr -> LintedType -> [CoreAlt] -> LintM () -- a) Check that the alts are non-empty -- b1) Check that the DEFAULT comes first, if it exists -- b2) Check that the others are in increasing order @@ -1219,14 +1240,14 @@ checkCaseAlts e ty alts = Nothing -> False Just tycon -> isPrimTyCon tycon -lintAltExpr :: CoreExpr -> OutType -> LintM () +lintAltExpr :: CoreExpr -> LintedType -> LintM () lintAltExpr expr ann_ty = do { actual_ty <- lintCoreExpr expr ; ensureEqTys actual_ty ann_ty (mkCaseAltMsg expr actual_ty ann_ty) } -- See GHC.Core Note [Case expression invariants] item (6) -lintCoreAlt :: OutType -- Type of scrutinee - -> OutType -- Type of the alternative +lintCoreAlt :: LintedType -- Type of scrutinee + -> LintedType -- Type of the alternative -> CoreAlt -> LintM () -- If you edit this function, you may need to update the GHC formalism @@ -1286,40 +1307,43 @@ lintBinders site (var:vars) linterF = lintBinder site var $ \var' -> -- See Note [GHC Formalism] lintBinder :: BindingSite -> Var -> (Var -> LintM a) -> LintM a lintBinder site var linterF - | isTyVar var = lintTyBndr var linterF - | isCoVar var = lintCoBndr var linterF - | otherwise = lintIdBndr NotTopLevel site var linterF + | isTyCoVar var = lintTyCoBndr var linterF + | otherwise = lintIdBndr NotTopLevel site var linterF -lintTyBndr :: InTyVar -> (OutTyVar -> LintM a) -> LintM a -lintTyBndr tv thing_inside - = do { subst <- getTCvSubst - ; let (subst', tv') = substTyVarBndr subst tv - ; lintKind (varType tv') - ; updateTCvSubst subst' (thing_inside tv') } +lintTyBndr :: TyVar -> (LintedTyCoVar -> LintM a) -> LintM a +lintTyBndr = lintTyCoBndr -- We could specialise it, I guess -lintCoBndr :: InCoVar -> (OutCoVar -> LintM a) -> LintM a -lintCoBndr cv thing_inside +-- lintCoBndr :: CoVar -> (LintedTyCoVar -> LintM a) -> LintM a +-- lintCoBndr = lintTyCoBndr -- We could specialise it, I guess + +lintTyCoBndr :: TyCoVar -> (LintedTyCoVar -> LintM a) -> LintM a +lintTyCoBndr tcv thing_inside = do { subst <- getTCvSubst - ; let (subst', cv') = substCoVarBndr subst cv - ; lintKind (varType cv') - ; lintL (isCoVarType (varType cv')) - (text "CoVar with non-coercion type:" <+> pprTyVar cv) - ; updateTCvSubst subst' (thing_inside cv') } - -lintLetBndrs :: TopLevelFlag -> [Var] -> LintM a -> LintM a -lintLetBndrs top_lvl ids linterF - = go ids + ; kind' <- lintType (varType tcv) + ; let tcv' = uniqAway (getTCvInScope subst) $ + setVarType tcv kind' + subst' = extendTCvSubstWithClone subst tcv tcv' + ; when (isCoVar tcv) $ + lintL (isCoVarType kind') + (text "CoVar with non-coercion type:" <+> pprTyVar tcv) + ; updateTCvSubst subst' (thing_inside tcv') } + +lintIdBndrs :: forall a. TopLevelFlag -> [Id] -> ([LintedId] -> LintM a) -> LintM a +lintIdBndrs top_lvl ids thing_inside + = go ids thing_inside where - go [] = linterF - go (id:ids) = lintIdBndr top_lvl LetBind id $ \_ -> - go ids + go :: [Id] -> ([Id] -> LintM a) -> LintM a + go [] thing_inside = thing_inside [] + go (id:ids) thing_inside = lintIdBndr top_lvl LetBind id $ \id' -> + go ids $ \ids' -> + thing_inside (id' : ids') lintIdBndr :: TopLevelFlag -> BindingSite -> InVar -> (OutVar -> LintM a) -> LintM a -- Do substitution on the type of a binder and add the var with this -- new type to the in-scope set of the second argument -- ToDo: lint its rules -lintIdBndr top_lvl bind_site id linterF +lintIdBndr top_lvl bind_site id thing_inside = ASSERT2( isId id, ppr id ) do { flags <- getLintFlags ; checkL (not (lf_check_global_ids flags) || isLocalId id) @@ -1334,14 +1358,11 @@ lintIdBndr top_lvl bind_site id linterF ; checkL (not (isExternalName (Var.varName id)) || is_top_lvl) (mkNonTopExternalNameMsg id) - ; (id_ty, k) <- addLoc (IdTy id) $ - lintInTy (idType id) - ; let id' = setIdType id id_ty - -- See Note [Levity polymorphism invariants] in GHC.Core - ; lintL (isJoinId id || not (lf_check_levity_poly flags) || not (isKindLevPoly k)) - (text "Levity-polymorphic binder:" <+> - (ppr id <+> dcolon <+> parens (ppr id_ty <+> dcolon <+> ppr k))) + ; lintL (isJoinId id || not (lf_check_levity_poly flags) + || not (isTypeLevPoly id_ty)) $ + text "Levity-polymorphic binder:" <+> ppr id <+> dcolon <+> + parens (ppr id_ty <+> dcolon <+> ppr (typeKind id_ty)) -- Check that a join-id is a not-top-level let-binding ; when (isJoinId id) $ @@ -1353,8 +1374,13 @@ lintIdBndr top_lvl bind_site id linterF ; lintL (not (isCoVarType id_ty)) (text "Non-CoVar has coercion type" <+> ppr id <+> dcolon <+> ppr id_ty) - ; addInScopeId id' $ (linterF id') } + ; linted_ty <- addLoc (IdTy id) (lintValueType id_ty) + + ; addInScopeId id linted_ty $ + thing_inside (setIdType id linted_ty) } where + id_ty = idType id + is_top_lvl = isTopLevel top_lvl is_let_bind = case bind_site of LetBind -> True @@ -1378,45 +1404,52 @@ lintTypes dflags vars tys where (_warns, errs) = initL dflags defaultLintFlags vars linter linter = lintBinders LambdaBind vars $ \_ -> - mapM_ lintInTy tys + mapM_ lintType tys -lintInTy :: InType -> LintM (LintedType, LintedKind) +lintValueType :: Type -> LintM LintedType -- Types only, not kinds -- Check the type, and apply the substitution to it -- See Note [Linting type lets] -lintInTy ty +lintValueType ty = addLoc (InType ty) $ - do { ty' <- applySubstTy ty - ; k <- lintType ty' - ; addLoc (InKind ty' k) $ - lintKind k -- The kind returned by lintType is already - -- a LintedKind but we also want to check that - -- k :: *, which lintKind does - ; return (ty', k) } + do { ty' <- lintType ty + ; let sk = typeKind ty' + ; lintL (classifiesTypeWithValues sk) $ + hang (text "Ill-kinded type:" <+> ppr ty) + 2 (text "has kind:" <+> ppr sk) + ; return ty' } checkTyCon :: TyCon -> LintM () checkTyCon tc = checkL (not (isTcTyCon tc)) (text "Found TcTyCon:" <+> ppr tc) ------------------- -lintType :: OutType -> LintM LintedKind --- The returned Kind has itself been linted +lintType :: LintedType -> LintM LintedType -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] lintType (TyVarTy tv) - = do { checkL (isTyVar tv) (mkBadTyVarMsg tv) - ; tv' <- lintTyCoVarInScope tv - ; return (tyVarKind tv') } - -- We checked its kind when we added it to the envt + | not (isTyVar tv) + = failWithL (mkBadTyVarMsg tv) + + | otherwise + = do { subst <- getTCvSubst + ; case lookupTyVar subst tv of + Just linted_ty -> return linted_ty ; + Nothing -> -- lintTyBndr always extends the substitition + failWithL $ + hang (text "The type variable" <+> pprBndr LetBind tv) + 2 (text "is out of scope") + } lintType ty@(AppTy t1 t2) | TyConApp {} <- t1 = failWithL $ text "TyConApp to the left of AppTy:" <+> ppr ty | otherwise - = do { k1 <- lintType t1 - ; k2 <- lintType t2 - ; lint_ty_app ty k1 [(t2,k2)] } + = do { t1' <- lintType t1 + ; t2' <- lintType t2 + ; lint_ty_app ty (typeKind t1') [t2'] + ; return (AppTy t1' t2') } lintType ty@(TyConApp tc tys) | isTypeSynonymTyCon tc || isTypeFamilyTyCon tc @@ -1433,71 +1466,72 @@ lintType ty@(TyConApp tc tys) | otherwise -- Data types, data families, primitive types = do { checkTyCon tc - ; ks <- mapM lintType tys - ; lint_ty_app ty (tyConKind tc) (tys `zip` ks) } + ; tys' <- mapM lintType tys + ; lint_ty_app ty (tyConKind tc) tys' + ; return (TyConApp tc tys') } -- arrows can related *unlifted* kinds, so this has to be separate from -- a dependent forall. -lintType ty@(FunTy _ t1 t2) - = do { k1 <- lintType t1 - ; k2 <- lintType t2 - ; lintArrow (text "type or kind" <+> quotes (ppr ty)) k1 k2 } +lintType ty@(FunTy af t1 t2) + = do { t1' <- lintType t1 + ; t2' <- lintType t2 + ; lintArrow (text "type or kind" <+> quotes (ppr ty)) t1' t2' + ; return (FunTy af t1' t2') } -lintType t@(ForAllTy (Bndr tv _vis) ty) - -- forall over types - | isTyVar tv - = lintTyBndr tv $ \tv' -> - do { k <- lintType ty - ; checkValueKind k (text "the body of forall:" <+> ppr t) - ; case occCheckExpand [tv'] k of -- See Note [Stupid type synonyms] - Just k' -> return k' - Nothing -> failWithL (hang (text "Variable escape in forall:") - 2 (vcat [ text "type:" <+> ppr t - , text "kind:" <+> ppr k ])) - } +lintType (ForAllTy (Bndr tcv vis) body_ty) + = lintTyCoBndr tcv $ \tcv' -> + do { body_ty' <- lintType body_ty + ; lintForAllBody tcv' body_ty' + + ; when (isCoVar tcv) $ + lintL (tcv `elemVarSet` tyCoVarsOfType body_ty) $ + text "Covar does not occur in the body:" <+> (ppr tcv $$ ppr body_ty) + -- See GHC.Core.TyCo.Rep Note [Unused coercion variable in ForAllTy] + -- and cf GHC.Core.Coercion Note [Unused coercion variable in ForAllCo] -lintType t@(ForAllTy (Bndr cv _vis) ty) - -- forall over coercions - = do { lintL (isCoVar cv) - (text "Non-Tyvar or Non-Covar bound in type:" <+> ppr t) - ; lintL (cv `elemVarSet` tyCoVarsOfType ty) - (text "Covar does not occur in the body:" <+> ppr t) - ; lintCoBndr cv $ \_ -> - do { k <- lintType ty - ; checkValueKind k (text "the body of forall:" <+> ppr t) - ; return liftedTypeKind - -- We don't check variable escape here. Namely, k could refer to cv' - }} - -lintType ty@(LitTy l) = lintTyLit l >> return (typeKind ty) + ; return (ForAllTy (Bndr tcv' vis) body_ty') } + +lintType ty@(LitTy l) + = do { lintTyLit l; return ty } lintType (CastTy ty co) - = do { k1 <- lintType ty - ; (k1', k2) <- lintStarCoercion co - ; ensureEqTys k1 k1' (mkCastTyErr ty co k1' k1) - ; return k2 } + = do { ty' <- lintType ty + ; co' <- lintStarCoercion co + ; let tyk = typeKind ty' + cok = coercionLKind co' + ; ensureEqTys tyk cok (mkCastTyErr ty co tyk cok) + ; return (CastTy ty' co') } lintType (CoercionTy co) - = do { (k1, k2, ty1, ty2, r) <- lintCoercion co - ; return $ mkHeteroCoercionType r k1 k2 ty1 ty2 } - -{- Note [Stupid type synonyms] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider (#14939) - type Alg cls ob = ob - f :: forall (cls :: * -> Constraint) (b :: Alg cls *). b - -Here 'cls' appears free in b's kind, which would usually be illegal -(because in (forall a. ty), ty's kind should not mention 'a'). But -#in this case (Alg cls *) = *, so all is well. Currently we allow -this, and make Lint expand synonyms where necessary to make it so. - -c.f. TcUnify.occCheckExpand and GHC.Core.Utils.coreAltsType which deal -with the same problem. A single systematic solution eludes me. --} + = do { co' <- lintCoercion co + ; return (CoercionTy co') } + +----------------- +lintForAllBody :: LintedTyCoVar -> LintedType -> LintM () +-- Do the checks for the body of a forall-type +lintForAllBody tcv body_ty + = do { checkL (isTyCoVar tcv) $ + text "Non-Tyvar or Non-Covar bound in type:" <+> ppr tcv + + ; checkValueType body_ty (text "the body of forall:" <+> ppr body_ty) + + -- For type variables, check for skolem escape + -- See Note [Phantom type variables in kinds] in GHC.Core.Type + -- The kind of (forall cv. th) is liftedTypeKind, so no + -- need to check for skolem-escape in the CoVar case + ; let body_kind = typeKind body_ty + ; when (isTyVar tcv) $ + case occCheckExpand [tcv] body_kind of + Just {} -> return () + Nothing -> failWithL $ + hang (text "Variable escape in forall:") + 2 (vcat [ text "tyvar:" <+> ppr tcv + , text "type:" <+> ppr body_ty + , text "kind:" <+> ppr body_kind ]) + } ----------------- -lintTySynFamApp :: Bool -> Type -> TyCon -> [Type] -> LintM LintedKind +lintTySynFamApp :: Bool -> InType -> TyCon -> [InType] -> LintM LintedType -- The TyCon is a type synonym or a type family (not a data family) -- See Note [Linting type synonym applications] -- c.f. TcValidity.check_syn_tc_app @@ -1511,58 +1545,54 @@ lintTySynFamApp report_unsat ty tc tys , let expanded_ty = mkAppTys (substTy (mkTvSubstPrs tenv) rhs) tys' = do { -- Kind-check the argument types, but without reporting -- un-saturated type families/synonyms - ks <- setReportUnsat False (mapM lintType tys) + tys' <- setReportUnsat False (mapM lintType tys) ; when report_unsat $ do { _ <- lintType expanded_ty ; return () } - ; lint_ty_app ty (tyConKind tc) (tys `zip` ks) } + ; lint_ty_app ty (tyConKind tc) tys' + ; return (TyConApp tc tys') } -- Otherwise this must be a type family | otherwise - = do { ks <- mapM lintType tys - ; lint_ty_app ty (tyConKind tc) (tys `zip` ks) } - ------------------ -lintKind :: OutKind -> LintM () --- If you edit this function, you may need to update the GHC formalism --- See Note [GHC Formalism] -lintKind k = do { sk <- lintType k - ; unless (classifiesTypeWithValues sk) - (addErrL (hang (text "Ill-kinded kind:" <+> ppr k) - 2 (text "has kind:" <+> ppr sk))) } + = do { tys' <- mapM lintType tys + ; lint_ty_app ty (tyConKind tc) tys' + ; return (TyConApp tc tys') } ----------------- -- Confirms that a type is really *, #, Constraint etc -checkValueKind :: OutKind -> SDoc -> LintM () -checkValueKind k doc - = lintL (classifiesTypeWithValues k) - (text "Non-*-like kind when *-like expected:" <+> ppr k $$ +checkValueType :: LintedType -> SDoc -> LintM () +checkValueType ty doc + = lintL (classifiesTypeWithValues kind) + (text "Non-*-like kind when *-like expected:" <+> ppr kind $$ text "when checking" <+> doc) + where + kind = typeKind ty ----------------- -lintArrow :: SDoc -> LintedKind -> LintedKind -> LintM LintedKind +lintArrow :: SDoc -> LintedType -> LintedType -> LintM () -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] -lintArrow what k1 k2 -- Eg lintArrow "type or kind `blah'" k1 k2 +lintArrow what t1 t2 -- Eg lintArrow "type or kind `blah'" k1 k2 -- or lintArrow "coercion `blah'" k1 k2 = do { unless (classifiesTypeWithValues k1) (addErrL (msg (text "argument") k1)) - ; unless (classifiesTypeWithValues k2) (addErrL (msg (text "result") k2)) - ; return liftedTypeKind } + ; unless (classifiesTypeWithValues k2) (addErrL (msg (text "result") k2)) } where + k1 = typeKind t1 + k2 = typeKind t2 msg ar k = vcat [ hang (text "Ill-kinded" <+> ar) 2 (text "in" <+> what) , what <+> text "kind:" <+> ppr k ] ----------------- -lint_ty_app :: Type -> LintedKind -> [(LintedType,LintedKind)] -> LintM LintedKind +lint_ty_app :: Type -> LintedKind -> [LintedType] -> LintM () lint_ty_app ty k tys = lint_app (text "type" <+> quotes (ppr ty)) k tys ---------------- -lint_co_app :: Coercion -> LintedKind -> [(LintedType,LintedKind)] -> LintM LintedKind +lint_co_app :: Coercion -> LintedKind -> [LintedType] -> LintM () lint_co_app ty k tys = lint_app (text "coercion" <+> quotes (ppr ty)) k tys @@ -1574,42 +1604,45 @@ lintTyLit (NumTyLit n) where msg = text "Negative type literal:" <+> integer n lintTyLit (StrTyLit _) = return () -lint_app :: SDoc -> LintedKind -> [(LintedType,LintedKind)] -> LintM Kind +lint_app :: SDoc -> LintedKind -> [LintedType] -> LintM () -- (lint_app d fun_kind arg_tys) -- We have an application (f arg_ty1 .. arg_tyn), -- where f :: fun_kind --- Takes care of linting the OutTypes -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] -lint_app doc kfn kas +lint_app doc kfn arg_tys = do { in_scope <- getInScope -- We need the in_scope set to satisfy the invariant in -- Note [The substitution invariant] in GHC.Core.TyCo.Subst - ; foldlM (go_app in_scope) kfn kas } + ; _ <- foldlM (go_app in_scope) kfn arg_tys + ; return () } where fail_msg extra = vcat [ hang (text "Kind application error in") 2 doc , nest 2 (text "Function kind =" <+> ppr kfn) - , nest 2 (text "Arg kinds =" <+> ppr kas) + , nest 2 (text "Arg types =" <+> ppr arg_tys) , extra ] - go_app in_scope kfn tka + go_app in_scope kfn ta | Just kfn' <- coreView kfn - = go_app in_scope kfn' tka + = go_app in_scope kfn' ta - go_app _ (FunTy _ kfa kfb) tka@(_,ka) - = do { unless (ka `eqType` kfa) $ - addErrL (fail_msg (text "Fun:" <+> (ppr kfa $$ ppr tka))) + go_app _ fun_kind@(FunTy _ kfa kfb) ta + = do { let ka = typeKind ta + ; unless (ka `eqType` kfa) $ + addErrL (fail_msg (text "Fun:" <+> (ppr fun_kind $$ ppr ta <+> dcolon <+> ppr ka))) ; return kfb } - go_app in_scope (ForAllTy (Bndr kv _vis) kfn) tka@(ta,ka) + go_app in_scope (ForAllTy (Bndr kv _vis) kfn) ta = do { let kv_kind = varType kv + ka = typeKind ta ; unless (ka `eqType` kv_kind) $ - addErrL (fail_msg (text "Forall:" <+> (ppr kv $$ ppr kv_kind $$ ppr tka))) + addErrL (fail_msg (text "Forall:" <+> (ppr kv $$ ppr kv_kind $$ + ppr ta <+> dcolon <+> ppr ka))) ; return $ substTy (extendTCvSubst (mkEmptyTCvSubst in_scope) kv ta) kfn } - go_app _ kfn ka - = failWithL (fail_msg (text "Not a fun:" <+> (ppr kfn $$ ppr ka))) + go_app _ kfn ta + = failWithL (fail_msg (text "Not a fun:" <+> (ppr kfn $$ ppr ta))) {- ********************************************************************* * * @@ -1617,7 +1650,7 @@ lint_app doc kfn kas * * ********************************************************************* -} -lintCoreRule :: OutVar -> OutType -> CoreRule -> LintM () +lintCoreRule :: OutVar -> LintedType -> CoreRule -> LintM () lintCoreRule _ _ (BuiltinRule {}) = return () -- Don't bother @@ -1710,68 +1743,94 @@ Note [Rules and join points] in OccurAnal for further discussion. ************************************************************************ -} -lintInCo :: InCoercion -> LintM (LintedKind, LintedKind, LintedType, LintedType, Role) --- Check the coercion, and apply the substitution to it --- See Note [Linting type lets] -lintInCo co - = addLoc (InCo co) $ - do { co' <- applySubstCo co - ; lintCoercion co' } +{- Note [Asymptotic efficiency] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When linting coercions (and types actually) we return a linted +(substituted) coercion. Then we often have to take the coercionKind of +that returned coercion. If we get long chains, that can be asymptotically +inefficient, notably in +* TransCo +* InstCo +* NthCo (cf #9233) +* LRCo + +But the code is simple. And this is only Lint. Let's wait to see if +the bad perf bites us in practice. + +A solution would be to return the kind and role of the coercion, +as well as the linted coercion. Or perhaps even *only* the kind and role, +which is what used to happen. But that proved tricky and error prone +(#17923), so now we return the coercion. +-} + -- lints a coercion, confirming that its lh kind and its rh kind are both * -- also ensures that the role is Nominal -lintStarCoercion :: OutCoercion -> LintM (LintedType, LintedType) +lintStarCoercion :: InCoercion -> LintM LintedCoercion lintStarCoercion g - = do { (k1, k2, t1, t2, r) <- lintCoercion g - ; checkValueKind k1 (text "the kind of the left type in" <+> ppr g) - ; checkValueKind k2 (text "the kind of the right type in" <+> ppr g) - ; lintRole g Nominal r - ; return (t1, t2) } - -lintCoercion :: OutCoercion -> LintM (LintedKind, LintedKind, LintedType, LintedType, Role) --- Check the kind of a coercion term, returning the kind --- Post-condition: the returned OutTypes are lint-free --- --- If lintCoercion co = (k1, k2, s1, s2, r) --- then co :: s1 ~r s2 --- s1 :: k1 --- s2 :: k2 - + = do { g' <- lintCoercion g + ; let Pair t1 t2 = coercionKind g' + ; checkValueType t1 (text "the kind of the left type in" <+> ppr g) + ; checkValueType t2 (text "the kind of the right type in" <+> ppr g) + ; lintRole g Nominal (coercionRole g) + ; return g' } + +lintCoercion :: InCoercion -> LintM LintedCoercion -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] + +lintCoercion (CoVarCo cv) + | not (isCoVar cv) + = failWithL (hang (text "Bad CoVarCo:" <+> ppr cv) + 2 (text "With offending type:" <+> ppr (varType cv))) + + | otherwise + = do { subst <- getTCvSubst + ; case lookupCoVar subst cv of + Just linted_co -> return linted_co ; + Nothing -> -- lintCoBndr always extends the substitition + failWithL $ + hang (text "The coercion variable" <+> pprBndr LetBind cv) + 2 (text "is out of scope") + } + + lintCoercion (Refl ty) - = do { k <- lintType ty - ; return (k, k, ty, ty, Nominal) } + = do { ty' <- lintType ty + ; return (Refl ty') } lintCoercion (GRefl r ty MRefl) - = do { k <- lintType ty - ; return (k, k, ty, ty, r) } + = do { ty' <- lintType ty + ; return (GRefl r ty' MRefl) } lintCoercion (GRefl r ty (MCo co)) - = do { k <- lintType ty - ; (_, _, k1, k2, r') <- lintCoercion co - ; ensureEqTys k k1 - (hang (text "GRefl coercion kind mis-match:" <+> ppr co) - 2 (vcat [ppr ty, ppr k, ppr k1])) - ; lintRole co Nominal r' - ; return (k1, k2, ty, mkCastTy ty co, r) } + = do { ty' <- lintType ty + ; co' <- lintCoercion co + ; let tk = typeKind ty' + tl = coercionLKind co' + ; ensureEqTys tk tl $ + hang (text "GRefl coercion kind mis-match:" <+> ppr co) + 2 (vcat [ppr ty', ppr tk, ppr tl]) + ; lintRole co' Nominal (coercionRole co') + ; return (GRefl r ty' (MCo co')) } lintCoercion co@(TyConAppCo r tc cos) | tc `hasKey` funTyConKey , [_rep1,_rep2,_co1,_co2] <- cos - = do { failWithL (text "Saturated TyConAppCo (->):" <+> ppr co) - } -- All saturated TyConAppCos should be FunCos + = failWithL (text "Saturated TyConAppCo (->):" <+> ppr co) + -- All saturated TyConAppCos should be FunCos | Just {} <- synTyConDefn_maybe tc = failWithL (text "Synonym in TyConAppCo:" <+> ppr co) | otherwise = do { checkTyCon tc - ; (k's, ks, ss, ts, rs) <- mapAndUnzip5M lintCoercion cos - ; k' <- lint_co_app co (tyConKind tc) (ss `zip` k's) - ; k <- lint_co_app co (tyConKind tc) (ts `zip` ks) - ; _ <- zipWith3M lintRole cos (tyConRolesX r tc) rs - ; return (k', k, mkTyConApp tc ss, mkTyConApp tc ts, r) } + ; cos' <- mapM lintCoercion cos + ; let (co_kinds, co_roles) = unzip (map coercionKindRole cos') + ; lint_co_app co (tyConKind tc) (map pFst co_kinds) + ; lint_co_app co (tyConKind tc) (map pSnd co_kinds) + ; zipWithM_ (lintRole co) (tyConRolesX r tc) co_roles + ; return (TyConAppCo r tc cos') } lintCoercion co@(AppCo co1 co2) | TyConAppCo {} <- co1 @@ -1779,111 +1838,67 @@ lintCoercion co@(AppCo co1 co2) | Just (TyConApp {}, _) <- isReflCo_maybe co1 = failWithL (text "Refl (TyConApp ...) to the left of AppCo:" <+> ppr co) | otherwise - = do { (k1, k2, s1, s2, r1) <- lintCoercion co1 - ; (k'1, k'2, t1, t2, r2) <- lintCoercion co2 - ; k3 <- lint_co_app co k1 [(t1,k'1)] - ; k4 <- lint_co_app co k2 [(t2,k'2)] + = do { co1' <- lintCoercion co1 + ; co2' <- lintCoercion co2 + ; let (Pair lk1 rk1, r1) = coercionKindRole co1' + (Pair lk2 rk2, r2) = coercionKindRole co2' + ; lint_co_app co (typeKind lk1) [lk2] + ; lint_co_app co (typeKind rk1) [rk2] + ; if r1 == Phantom then lintL (r2 == Phantom || r2 == Nominal) (text "Second argument in AppCo cannot be R:" $$ ppr co) else lintRole co Nominal r2 - ; return (k3, k4, mkAppTy s1 t1, mkAppTy s2 t2, r1) } + + ; return (AppCo co1' co2') } ---------- -lintCoercion (ForAllCo tv1 kind_co co) - -- forall over types - | isTyVar tv1 - = do { (_, k2) <- lintStarCoercion kind_co - ; let tv2 = setTyVarKind tv1 k2 - ; addInScopeTyCoVar tv1 $ - do { - ; (k3, k4, t1, t2, r) <- lintCoercion co - ; in_scope <- getInScope - ; let tyl = mkInvForAllTy tv1 t1 - subst = mkTvSubst in_scope $ - -- We need both the free vars of the `t2` and the - -- free vars of the range of the substitution in - -- scope. All the free vars of `t2` and `kind_co` should - -- already be in `in_scope`, because they've been - -- linted and `tv2` has the same unique as `tv1`. - -- See Note [The substitution invariant] in GHC.Core.TyCo.Subst. - unitVarEnv tv1 (TyVarTy tv2 `mkCastTy` mkSymCo kind_co) - tyr = mkInvForAllTy tv2 $ - substTy subst t2 - ; return (k3, k4, tyl, tyr, r) } } - -lintCoercion (ForAllCo cv1 kind_co co) - -- forall over coercions - = ASSERT( isCoVar cv1 ) - do { lintL (almostDevoidCoVarOfCo cv1 co) - (text "Covar can only appear in Refl and GRefl: " <+> ppr co) - ; (_, k2) <- lintStarCoercion kind_co - ; let cv2 = setVarType cv1 k2 - ; addInScopeTyCoVar cv1 $ - do { - ; (k3, k4, t1, t2, r) <- lintCoercion co - ; checkValueKind k3 (text "the body of a ForAllCo over covar:" <+> ppr co) - ; checkValueKind k4 (text "the body of a ForAllCo over covar:" <+> ppr co) - -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep - ; in_scope <- getInScope - ; let tyl = mkTyCoInvForAllTy cv1 t1 - r2 = coVarRole cv1 - kind_co' = downgradeRole r2 Nominal kind_co - eta1 = mkNthCo r2 2 kind_co' - eta2 = mkNthCo r2 3 kind_co' - subst = mkCvSubst in_scope $ - -- We need both the free vars of the `t2` and the - -- free vars of the range of the substitution in - -- scope. All the free vars of `t2` and `kind_co` should - -- already be in `in_scope`, because they've been - -- linted and `cv2` has the same unique as `cv1`. - -- See Note [The substitution invariant] in GHC.Core.TyCo.Subst. - unitVarEnv cv1 (eta1 `mkTransCo` (mkCoVarCo cv2) - `mkTransCo` (mkSymCo eta2)) - tyr = mkTyCoInvForAllTy cv2 $ - substTy subst t2 - ; return (liftedTypeKind, liftedTypeKind, tyl, tyr, r) } } - -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep +lintCoercion co@(ForAllCo tcv1 kind_co body_co) + | not (isTyCoVar tcv1) + = failWithL (text "Non tyco binder in ForAllCo:" <+> ppr co) + | otherwise + = do { kind_co' <- lintStarCoercion kind_co + ; lintTyCoBndr tcv1 $ \tcv1' -> + do { body_co' <- lintCoercion body_co + ; ensureEqTys (varType tcv1') (coercionLKind kind_co') $ + text "Kind mis-match in ForallCo" <+> ppr co -lintCoercion co@(FunCo r co1 co2) - = do { (k1,k'1,s1,t1,r1) <- lintCoercion co1 - ; (k2,k'2,s2,t2,r2) <- lintCoercion co2 - ; k <- lintArrow (text "coercion" <+> quotes (ppr co)) k1 k2 - ; k' <- lintArrow (text "coercion" <+> quotes (ppr co)) k'1 k'2 - ; lintRole co1 r r1 - ; lintRole co2 r r2 - ; return (k, k', mkVisFunTy s1 s2, mkVisFunTy t1 t2, r) } + ; lintForAllBody tcv1' (coercionLKind body_co') -lintCoercion (CoVarCo cv) - | not (isCoVar cv) - = failWithL (hang (text "Bad CoVarCo:" <+> ppr cv) - 2 (text "With offending type:" <+> ppr (varType cv))) - | otherwise - = do { cv' <- lintTyCoVarInScope cv - ; lintUnliftedCoVar cv' - ; return $ coVarKindsTypesRole cv' } + ; when (isCoVar tcv1) $ + lintL (almostDevoidCoVarOfCo tcv1 body_co) $ + text "Covar can only appear in Refl and GRefl: " <+> ppr co + -- See "last wrinkle" in GHC.Core.Coercion + -- Note [Unused coercion variable in ForAllCo] + -- and c.f. GHC.Core.TyCo.Rep Note [Unused coercion variable in ForAllTy] --- See Note [Bad unsafe coercion] -lintCoercion co@(UnivCo prov r ty1 ty2) - = do { k1 <- lintType ty1 - ; k2 <- lintType ty2 - ; case prov of - PhantomProv kco -> do { lintRole co Phantom r - ; check_kinds kco k1 k2 } + ; return (ForAllCo tcv1' kind_co' body_co') } } - ProofIrrelProv kco -> do { lintL (isCoercionTy ty1) $ - mkBadProofIrrelMsg ty1 co - ; lintL (isCoercionTy ty2) $ - mkBadProofIrrelMsg ty2 co - ; check_kinds kco k1 k2 } +lintCoercion co@(FunCo r co1 co2) + = do { co1' <- lintCoercion co1 + ; co2' <- lintCoercion co2 + ; let Pair lt1 rt1 = coercionKind co1 + Pair lt2 rt2 = coercionKind co2 + ; lintArrow (text "coercion" <+> quotes (ppr co)) lt1 lt2 + ; lintArrow (text "coercion" <+> quotes (ppr co)) rt1 rt2 + ; lintRole co1 r (coercionRole co1) + ; lintRole co2 r (coercionRole co2) + ; return (FunCo r co1' co2') } - PluginProv _ -> return () -- no extra checks +-- See Note [Bad unsafe coercion] +lintCoercion co@(UnivCo prov r ty1 ty2) + = do { ty1' <- lintType ty1 + ; ty2' <- lintType ty2 + ; let k1 = typeKind ty1' + k2 = typeKind ty2' + ; prov' <- lint_prov k1 k2 prov ; when (r /= Phantom && classifiesTypeWithValues k1 && classifiesTypeWithValues k2) (checkTypes ty1 ty2) - ; return (k1, k2, ty1, ty2, r) } + + ; return (UnivCo prov' r ty1' ty2') } where report s = hang (text $ "Unsafe coercion: " ++ s) 2 (vcat [ text "From:" <+> ppr ty1 @@ -1926,39 +1941,53 @@ lintCoercion co@(UnivCo prov r ty1 ty2) _ -> return () } - check_kinds kco k1 k2 = do { (k1', k2') <- lintStarCoercion kco - ; ensureEqTys k1 k1' (mkBadUnivCoMsg CLeft co) - ; ensureEqTys k2 k2' (mkBadUnivCoMsg CRight co) } + lint_prov k1 k2 (PhantomProv kco) + = do { kco' <- lintStarCoercion kco + ; lintRole co Phantom r + ; check_kinds kco' k1 k2 + ; return (PhantomProv kco') } + + lint_prov k1 k2 (ProofIrrelProv kco) + = do { lintL (isCoercionTy ty1) (mkBadProofIrrelMsg ty1 co) + ; lintL (isCoercionTy ty2) (mkBadProofIrrelMsg ty2 co) + ; kco' <- lintStarCoercion kco + ; check_kinds kco k1 k2 + ; return (ProofIrrelProv kco') } + + lint_prov _ _ prov@(PluginProv _) = return prov + + check_kinds kco k1 k2 + = do { let Pair k1' k2' = coercionKind kco + ; ensureEqTys k1 k1' (mkBadUnivCoMsg CLeft co) + ; ensureEqTys k2 k2' (mkBadUnivCoMsg CRight co) } lintCoercion (SymCo co) - = do { (k1, k2, ty1, ty2, r) <- lintCoercion co - ; return (k2, k1, ty2, ty1, r) } + = do { co' <- lintCoercion co + ; return (SymCo co') } lintCoercion co@(TransCo co1 co2) - = do { (k1a, _k1b, ty1a, ty1b, r1) <- lintCoercion co1 - ; (_k2a, k2b, ty2a, ty2b, r2) <- lintCoercion co2 + = do { co1' <- lintCoercion co1 + ; co2' <- lintCoercion co2 + ; let ty1b = coercionRKind co1' + ty2a = coercionLKind co2' ; ensureEqTys ty1b ty2a (hang (text "Trans coercion mis-match:" <+> ppr co) - 2 (vcat [ppr ty1a, ppr ty1b, ppr ty2a, ppr ty2b])) - ; lintRole co r1 r2 - ; return (k1a, k2b, ty1a, ty2b, r1) } + 2 (vcat [ppr (coercionKind co1'), ppr (coercionKind co2')])) + ; lintRole co (coercionRole co1) (coercionRole co2) + ; return (TransCo co1' co2') } lintCoercion the_co@(NthCo r0 n co) - = do { (_, _, s, t, r) <- lintCoercion co + = do { co' <- lintCoercion co + ; let (Pair s t, r) = coercionKindRole co' ; case (splitForAllTy_maybe s, splitForAllTy_maybe t) of - { (Just (tcv_s, _ty_s), Just (tcv_t, _ty_t)) + { (Just _, Just _) -- works for both tyvar and covar | n == 0 , (isForAllTy_ty s && isForAllTy_ty t) || (isForAllTy_co s && isForAllTy_co t) -> do { lintRole the_co Nominal r0 - ; return (ks, kt, ts, tt, r0) } - where - ts = varType tcv_s - tt = varType tcv_t - ks = typeKind ts - kt = typeKind tt + ; return (NthCo r0 n co') } ; _ -> case (splitTyConApp_maybe s, splitTyConApp_maybe t) of { (Just (tc_s, tys_s), Just (tc_t, tys_t)) @@ -1968,62 +1997,51 @@ lintCoercion the_co@(NthCo r0 n co) , tys_s `equalLength` tys_t , tys_s `lengthExceeds` n -> do { lintRole the_co tr r0 - ; return (ks, kt, ts, tt, r0) } - where - ts = getNth tys_s n - tt = getNth tys_t n - tr = nthRole r tc_s n - ks = typeKind ts - kt = typeKind tt + ; return (NthCo r0 n co') } + where + tr = nthRole r tc_s n ; _ -> failWithL (hang (text "Bad getNth:") 2 (ppr the_co $$ ppr s $$ ppr t)) }}} lintCoercion the_co@(LRCo lr co) - = do { (_,_,s,t,r) <- lintCoercion co + = do { co' <- lintCoercion co + ; let Pair s t = coercionKind co' + r = coercionRole co' ; lintRole co Nominal r ; case (splitAppTy_maybe s, splitAppTy_maybe t) of - (Just s_pr, Just t_pr) - -> return (ks_pick, kt_pick, s_pick, t_pick, Nominal) - where - s_pick = pickLR lr s_pr - t_pick = pickLR lr t_pr - ks_pick = typeKind s_pick - kt_pick = typeKind t_pick - + (Just _, Just _) -> return (LRCo lr co') _ -> failWithL (hang (text "Bad LRCo:") 2 (ppr the_co $$ ppr s $$ ppr t)) } lintCoercion (InstCo co arg) - = do { (k3, k4, t1',t2', r) <- lintCoercion co - ; (k1',k2',s1,s2, r') <- lintCoercion arg - ; lintRole arg Nominal r' - ; in_scope <- getInScope - ; case (splitForAllTy_ty_maybe t1', splitForAllTy_ty_maybe t2') of + = do { co' <- lintCoercion co + ; arg' <- lintCoercion arg + ; let Pair t1' t2' = coercionKind co' + Pair s1 s2 = coercionKind arg + + ; lintRole arg Nominal (coercionRole arg') + + ; case (splitForAllTy_ty_maybe t1', splitForAllTy_ty_maybe t2') of -- forall over tvar - { (Just (tv1,t1), Just (tv2,t2)) - | k1' `eqType` tyVarKind tv1 - , k2' `eqType` tyVarKind tv2 - -> return (k3, k4, - substTyWithInScope in_scope [tv1] [s1] t1, - substTyWithInScope in_scope [tv2] [s2] t2, r) + { (Just (tv1,_), Just (tv2,_)) + | typeKind s1 `eqType` tyVarKind tv1 + , typeKind s2 `eqType` tyVarKind tv2 + -> return (InstCo co' arg') | otherwise -> failWithL (text "Kind mis-match in inst coercion") + ; _ -> case (splitForAllTy_co_maybe t1', splitForAllTy_co_maybe t2') of -- forall over covar - { (Just (cv1, t1), Just (cv2, t2)) - | k1' `eqType` varType cv1 - , k2' `eqType` varType cv2 - , CoercionTy s1' <- s1 - , CoercionTy s2' <- s2 - -> do { return $ - (liftedTypeKind, liftedTypeKind - -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep - , substTy (mkCvSubst in_scope $ unitVarEnv cv1 s1') t1 - , substTy (mkCvSubst in_scope $ unitVarEnv cv2 s2') t2 - , r) } + { (Just (cv1, _), Just (cv2, _)) + | typeKind s1 `eqType` varType cv1 + , typeKind s2 `eqType` varType cv2 + , CoercionTy _ <- s1 + , CoercionTy _ <- s2 + -> return (InstCo co' arg') | otherwise -> failWithL (text "Kind mis-match in inst coercion") + ; _ -> failWithL (text "Bad argument of inst") }}} lintCoercion co@(AxiomInstCo con ind cos) @@ -2031,73 +2049,69 @@ lintCoercion co@(AxiomInstCo con ind cos) (bad_ax (text "index out of range")) ; let CoAxBranch { cab_tvs = ktvs , cab_cvs = cvs - , cab_roles = roles - , cab_lhs = lhs - , cab_rhs = rhs } = coAxiomNthBranch con ind + , cab_roles = roles } = coAxiomNthBranch con ind ; unless (cos `equalLength` (ktvs ++ cvs)) $ bad_ax (text "lengths") + ; cos' <- mapM lintCoercion cos ; subst <- getTCvSubst ; let empty_subst = zapTCvSubst subst - ; (subst_l, subst_r) <- foldlM check_ki - (empty_subst, empty_subst) - (zip3 (ktvs ++ cvs) roles cos) - ; let lhs' = substTys subst_l lhs - rhs' = substTy subst_r rhs - fam_tc = coAxiomTyCon con + ; _ <- foldlM check_ki (empty_subst, empty_subst) + (zip3 (ktvs ++ cvs) roles cos') + ; let fam_tc = coAxiomTyCon con ; case checkAxInstCo co of Just bad_branch -> bad_ax $ text "inconsistent with" <+> pprCoAxBranch fam_tc bad_branch Nothing -> return () - ; let s2 = mkTyConApp fam_tc lhs' - ; return (typeKind s2, typeKind rhs', s2, rhs', coAxiomRole con) } + ; return (AxiomInstCo con ind cos') } where bad_ax what = addErrL (hang (text "Bad axiom application" <+> parens what) 2 (ppr co)) - check_ki (subst_l, subst_r) (ktv, role, arg) - = do { (k', k'', s', t', r) <- lintCoercion arg - ; lintRole arg role r + check_ki (subst_l, subst_r) (ktv, role, arg') + = do { let Pair s' t' = coercionKind arg' + sk' = typeKind s' + tk' = typeKind t' + ; lintRole arg' role (coercionRole arg') ; let ktv_kind_l = substTy subst_l (tyVarKind ktv) ktv_kind_r = substTy subst_r (tyVarKind ktv) - ; unless (k' `eqType` ktv_kind_l) - (bad_ax (text "check_ki1" <+> vcat [ ppr co, ppr k', ppr ktv, ppr ktv_kind_l ] )) - ; unless (k'' `eqType` ktv_kind_r) - (bad_ax (text "check_ki2" <+> vcat [ ppr co, ppr k'', ppr ktv, ppr ktv_kind_r ] )) + ; unless (sk' `eqType` ktv_kind_l) + (bad_ax (text "check_ki1" <+> vcat [ ppr co, ppr sk', ppr ktv, ppr ktv_kind_l ] )) + ; unless (tk' `eqType` ktv_kind_r) + (bad_ax (text "check_ki2" <+> vcat [ ppr co, ppr tk', ppr ktv, ppr ktv_kind_r ] )) ; return (extendTCvSubst subst_l ktv s', extendTCvSubst subst_r ktv t') } lintCoercion (KindCo co) - = do { (k1, k2, _, _, _) <- lintCoercion co - ; return (liftedTypeKind, liftedTypeKind, k1, k2, Nominal) } + = do { co' <- lintCoercion co + ; return (KindCo co') } lintCoercion (SubCo co') - = do { (k1,k2,s,t,r) <- lintCoercion co' - ; lintRole co' Nominal r - ; return (k1,k2,s,t,Representational) } - -lintCoercion this@(AxiomRuleCo co cs) - = do { eqs <- mapM lintCoercion cs - ; lintRoles 0 (coaxrAsmpRoles co) eqs - ; case coaxrProves co [ Pair l r | (_,_,l,r,_) <- eqs ] of + = do { co' <- lintCoercion co' + ; lintRole co' Nominal (coercionRole co') + ; return (SubCo co') } + +lintCoercion this@(AxiomRuleCo ax cos) + = do { cos' <- mapM lintCoercion cos + ; lint_roles 0 (coaxrAsmpRoles ax) cos' + ; case coaxrProves ax (map coercionKind cos') of Nothing -> err "Malformed use of AxiomRuleCo" [ ppr this ] - Just (Pair l r) -> - return (typeKind l, typeKind r, l, r, coaxrRole co) } + Just _ -> return (AxiomRuleCo ax cos') } where err m xs = failWithL $ - hang (text m) 2 $ vcat (text "Rule:" <+> ppr (coaxrName co) : xs) + hang (text m) 2 $ vcat (text "Rule:" <+> ppr (coaxrName ax) : xs) - lintRoles n (e : es) ((_,_,_,_,r) : rs) - | e == r = lintRoles (n+1) es rs + lint_roles n (e : es) (co : cos) + | e == coercionRole co = lint_roles (n+1) es cos | otherwise = err "Argument roles mismatch" [ text "In argument:" <+> int (n+1) , text "Expected:" <+> ppr e - , text "Found:" <+> ppr r ] - lintRoles _ [] [] = return () - lintRoles n [] rs = err "Too many coercion arguments" + , text "Found:" <+> ppr (coercionRole co) ] + lint_roles _ [] [] = return () + lint_roles n [] rs = err "Too many coercion arguments" [ text "Expected:" <+> int n , text "Provided:" <+> int (n + length rs) ] - lintRoles n es [] = err "Not enough coercion arguments" + lint_roles n es [] = err "Not enough coercion arguments" [ text "Expected:" <+> int (n + length es) , text "Provided:" <+> int n ] @@ -2106,13 +2120,6 @@ lintCoercion (HoleCo h) ; lintCoercion (CoVarCo (coHoleCoVar h)) } ----------- -lintUnliftedCoVar :: CoVar -> LintM () -lintUnliftedCoVar cv - = when (not (isUnliftedType (coVarKind cv))) $ - failWithL (text "Bad lifted equality:" <+> ppr cv - <+> dcolon <+> ppr (coVarKind cv)) - {- ************************************************************************ * * @@ -2129,12 +2136,19 @@ data LintEnv , le_subst :: TCvSubst -- Current TyCo substitution -- See Note [Linting type lets] - -- /Only/ substitutes for type variables; - -- but might clone CoVars - -- We also use le_subst to keep track of - -- in-scope TyVars and CoVars + -- /Only/ substitutes for type variables; + -- but might clone CoVars + -- We also use le_subst to keep track of + -- in-scope TyVars and CoVars (but not Ids) + -- Range of the TCvSubst is LintedType/LintedCo + + , le_ids :: VarEnv (Id, LintedType) -- In-scope Ids + -- Used to check that occurrences have an enclosing binder. + -- The Id is /pre-substitution/, used to check that + -- the occurrence has an identical type to the binder + -- The LintedType is used to return the type of the occurrence, + -- without having to lint it again. - , le_ids :: IdSet -- In-scope Ids , le_joins :: IdSet -- Join points in scope that are valid -- A subset of the InScopeSet in le_subst -- See Note [Join points] @@ -2266,6 +2280,7 @@ instance HasDynFlags LintM where data LintLocInfo = RhsOf Id -- The variable bound + | OccOf Id -- Occurrence of id | LambdaBodyOf Id -- The lambda-binder | UnfoldingOf Id -- Unfolding of a binder | BodyOfLetRec [Id] -- One of the binders @@ -2278,7 +2293,6 @@ data LintLocInfo | ImportedUnfolding SrcLoc -- Some imported unfolding (ToDo: say which) | TopLevelBindings | InType Type -- Inside a type - | InKind Type Kind -- Inside a kind | InCo Coercion -- Inside a coercion initL :: DynFlags -> LintFlags -> [Var] @@ -2293,7 +2307,7 @@ initL dflags flags vars m (tcvs, ids) = partition isTyCoVar vars env = LE { le_flags = flags , le_subst = mkEmptyTCvSubst (mkInScopeSet (mkVarSet tcvs)) - , le_ids = mkVarSet ids + , le_ids = mkVarEnv [(id, (id,idType id)) | id <- ids] , le_joins = emptyVarSet , le_loc = [] , le_dynflags = dflags } @@ -2341,7 +2355,7 @@ addWarnL msg = LintM $ \ env (warns,errs) -> addMsg :: Bool -> LintEnv -> Bag MsgDoc -> MsgDoc -> Bag MsgDoc addMsg is_error env msgs msg - = ASSERT( notNull loc_msgs ) + = ASSERT2( notNull loc_msgs, msg ) msgs `snocBag` mk_msg msg where loc_msgs :: [(SrcLoc, SDoc)] -- Innermost first @@ -2373,18 +2387,17 @@ inCasePat = LintM $ \ env errs -> (Just (is_case_pat env), errs) is_case_pat (LE { le_loc = CasePat {} : _ }) = True is_case_pat _other = False -addInScopeTyCoVar :: Var -> LintM a -> LintM a -addInScopeTyCoVar var m - = LintM $ \ env errs -> - unLintM m (env { le_subst = extendTCvInScope (le_subst env) var }) errs - -addInScopeId :: Id -> LintM a -> LintM a -addInScopeId id m - = LintM $ \ env errs -> - unLintM m (env { le_ids = extendVarSet (le_ids env) id - , le_joins = delVarSet (le_joins env) id }) errs +addInScopeId :: Id -> LintedType -> LintM a -> LintM a +addInScopeId id linted_ty m + = LintM $ \ env@(LE { le_ids = id_set, le_joins = join_set }) errs -> + unLintM m (env { le_ids = extendVarEnv id_set id (id, linted_ty) + , le_joins = add_joins join_set }) errs + where + add_joins join_set + | isJoinId id = extendVarSet join_set id -- Overwrite with new arity + | otherwise = delVarSet join_set id -- Remove any existing binding -getInScopeIds :: LintM IdSet +getInScopeIds :: LintM (VarEnv (Id,LintedType)) getInScopeIds = LintM (\env errs -> (Just (le_ids env), errs)) extendTvSubstL :: TyVar -> Type -> LintM a -> LintM a @@ -2404,13 +2417,6 @@ markAllJoinsBadIf :: Bool -> LintM a -> LintM a markAllJoinsBadIf True m = markAllJoinsBad m markAllJoinsBadIf False m = m -addGoodJoins :: [Var] -> LintM a -> LintM a -addGoodJoins vars thing_inside - = LintM $ \ env errs -> unLintM thing_inside (add_joins env) errs - where - add_joins env = env { le_joins = le_joins env `extendVarSetList` join_ids } - join_ids = filter isJoinId vars - getValidJoins :: LintM IdSet getValidJoins = LintM (\ env errs -> (Just (le_joins env), errs)) @@ -2420,20 +2426,17 @@ getTCvSubst = LintM (\ env errs -> (Just (le_subst env), errs)) getInScope :: LintM InScopeSet getInScope = LintM (\ env errs -> (Just (getTCvInScope $ le_subst env), errs)) -applySubstTy :: InType -> LintM OutType -applySubstTy ty = do { subst <- getTCvSubst; return (substTy subst ty) } - -applySubstCo :: InCoercion -> LintM OutCoercion -applySubstCo co = do { subst <- getTCvSubst; return (substCo subst co) } - -lookupIdInScope :: Id -> LintM Id +lookupIdInScope :: Id -> LintM (Id, LintedType) lookupIdInScope id_occ = do { in_scope_ids <- getInScopeIds - ; case lookupVarSet in_scope_ids id_occ of - Just id_bnd -> do { checkL (not (bad_global id_bnd)) global_in_scope - ; return id_bnd } + ; case lookupVarEnv in_scope_ids id_occ of + Just (id_bndr, linted_ty) + -> do { checkL (not (bad_global id_bndr)) global_in_scope + ; return (id_bndr, linted_ty) } Nothing -> do { checkL (not is_local) local_out_of_scope - ; return id_occ } } + ; return (id_occ, idType id_occ) } } + -- We don't bother to lint the type + -- of global (i.e. imported) Ids where is_local = mustHaveLocalBinding id_occ local_out_of_scope = text "Out of scope:" <+> pprBndr LetBind id_occ @@ -2461,16 +2464,7 @@ lookupJoinId id Just id' -> return (isJoinId_maybe id') Nothing -> return Nothing } -lintTyCoVarInScope :: TyCoVar -> LintM TyCoVar -lintTyCoVarInScope var - = do { subst <- getTCvSubst - ; case lookupInScope (getTCvInScope subst) var of - Just var' -> return var' - Nothing -> failWithL $ - hang (text "The TyCo variable" <+> pprBndr LetBind var) - 2 (text "is out of scope") } - -ensureEqTys :: OutType -> OutType -> MsgDoc -> LintM () +ensureEqTys :: LintedType -> LintedType -> MsgDoc -> LintM () -- check ty2 is subtype of ty1 (ie, has same structure but usage -- annotations need only be consistent, not equal) -- Assumes ty1,ty2 are have already had the substitution applied @@ -2500,6 +2494,9 @@ dumpLoc :: LintLocInfo -> (SrcLoc, SDoc) dumpLoc (RhsOf v) = (getSrcLoc v, text "In the RHS of" <+> pp_binders [v]) +dumpLoc (OccOf v) + = (getSrcLoc v, text "In an occurrence of" <+> pp_binder v) + dumpLoc (LambdaBodyOf b) = (getSrcLoc b, text "In the body of lambda with binder" <+> pp_binder b) @@ -2534,8 +2531,6 @@ dumpLoc TopLevelBindings = (noSrcLoc, Outputable.empty) dumpLoc (InType ty) = (noSrcLoc, text "In the type" <+> quotes (ppr ty)) -dumpLoc (InKind ty ki) - = (noSrcLoc, text "In the kind of" <+> parens (ppr ty <+> dcolon <+> ppr ki)) dumpLoc (InCo co) = (noSrcLoc, text "In the coercion" <+> quotes (ppr co)) @@ -2780,7 +2775,7 @@ mkJoinBndrOccMismatchMsg bndr join_arity_bndr join_arity_occ , text "Arity at binding site:" <+> ppr join_arity_bndr , text "Arity at occurrence: " <+> ppr join_arity_occ ] -mkBndrOccTypeMismatchMsg :: Var -> Var -> OutType -> OutType -> SDoc +mkBndrOccTypeMismatchMsg :: Var -> Var -> LintedType -> LintedType -> SDoc mkBndrOccTypeMismatchMsg bndr var bndr_ty var_ty = vcat [ text "Mismatch in type between binder and occurrence" , text "Binder:" <+> ppr bndr <+> dcolon <+> ppr bndr_ty ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -2447,7 +2447,7 @@ normally it would make no sense to have forall r. (ty :: K r) because the kind of the forall would escape the binding of 'r'. But in this case it's fine because (K r) exapands -to Type, so we expliclity /permit/ the type +to Type, so we explicitly /permit/ the type forall r. T r To accommodate such a type, in typeKind (forall a.ty) we use @@ -2455,8 +2455,13 @@ occCheckExpand to expand any type synonyms in the kind of 'ty' to eliminate 'a'. See kinding rule (FORALL) in Note [Kinding rules for types] -And in TcValidity.checkEscapingKind, we use also use -occCheckExpand, for the same reason. +See also + * TcUnify.occCheckExpand + * GHC.Core.Utils.coreAltsType + * TcValidity.checkEscapingKind +all of which grapple with with the same problem. + +See #14939. -} ----------------------------- ===================================== testsuite/tests/indexed-types/should_compile/T17923.hs ===================================== @@ -0,0 +1,44 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# OPTIONS_GHC -Wall #-} +module Bug where + +import Data.Kind + +-- type SingFunction2 f = forall t1 t2. Sing t1 -> Sing t2 -> Sing (f `Apply` t1 `Apply` t2) +type SingFunction2 f = forall t1. Sing t1 -> forall t2. Sing t2 -> Sing (f `Apply` t1 `Apply` t2) +singFun2 :: forall f. SingFunction2 f -> Sing f +singFun2 f = SLambda (\x -> SLambda (f x)) + +type family Sing :: k -> Type +data TyFun :: Type -> Type -> Type +type a ~> b = TyFun a b -> Type +infixr 0 ~> + +type family Apply (f :: a ~> b) (x :: a) :: b +data Sym4 a +data Sym3 a + +type instance Apply Sym3 _ = Sym4 + +newtype SLambda (f :: k1 ~> k2) = + SLambda { applySing :: forall t. Sing t -> Sing (Apply f t) } +type instance Sing = SLambda + +und :: a +und = undefined + +data E +data ShowCharSym0 :: E ~> E ~> E + +sShow_tuple :: SLambda Sym4 +sShow_tuple + = applySing (singFun2 @Sym3 und) + (und (singFun2 @Sym3 + (und (applySing (singFun2 @Sym3 und) + (applySing (singFun2 @ShowCharSym0 und) und))))) ===================================== testsuite/tests/indexed-types/should_compile/all.T ===================================== @@ -294,3 +294,4 @@ test('T16828', normal, compile, ['']) test('T17008b', normal, compile, ['']) test('T17056', normal, compile, ['']) test('T17405', normal, multimod_compile, ['T17405c', '-v0']) +test('T17923', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a9934ce8e0b14da218ecbcaddb4c1c328e5488e0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a9934ce8e0b14da218ecbcaddb4c1c328e5488e0 You're receiving 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 Mar 26 16:01:29 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Thu, 26 Mar 2020 12:01:29 -0400 Subject: [Git][ghc/ghc][wip/T17923] Significant refactor of Lint Message-ID: <5e7cd1d9a10b9_61675cefcac7656a9@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T17923 at Glasgow Haskell Compiler / GHC Commits: bb556764 by Simon Peyton Jones at 2020-03-26T16:00:18+00: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. - - - - - 4 changed files: - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Type.hs - + testsuite/tests/indexed-types/should_compile/T17923.hs - testsuite/tests/indexed-types/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -8,7 +8,7 @@ See Note [Core Lint guarantee]. -} {-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE ScopedTypeVariables, DeriveFunctor #-} module GHC.Core.Lint ( lintCoreBindings, lintUnfolding, @@ -33,7 +33,6 @@ import GHC.Core.Op.Monad import Bag import Literal import GHC.Core.DataCon -import TysWiredIn import TysPrim import TcType ( isFloatingTy ) import Var @@ -461,14 +460,17 @@ lintCoreBindings :: DynFlags -> CoreToDo -> [Var] -> CoreProgram -> (Bag MsgDoc, lintCoreBindings dflags pass local_in_scope binds = initL dflags flags local_in_scope $ addLoc TopLevelBindings $ - lintLetBndrs TopLevel binders $ - -- Put all the top-level binders in scope at the start - -- This is because transformation rules can bring something - -- into use 'unexpectedly' do { checkL (null dups) (dupVars dups) ; checkL (null ext_dups) (dupExtVars ext_dups) - ; mapM lint_bind binds } + ; lintRecBindings TopLevel all_pairs $ + return () } where + all_pairs = flattenBinds binds + -- Put all the top-level binders in scope at the start + -- This is because transformation rules can bring something + -- into use 'unexpectedly'; see Note [Glomming] in OccurAnal + binders = map fst all_pairs + flags = defaultLintFlags { lf_check_global_ids = check_globals , lf_check_inline_loop_breakers = check_lbs @@ -494,7 +496,6 @@ lintCoreBindings dflags pass local_in_scope binds CorePrep -> AllowAtTopLevel _ -> AllowAnywhere - binders = bindersOfBinds binds (_, dups) = removeDups compare binders -- dups_ext checks for names with different uniques @@ -509,11 +510,6 @@ lintCoreBindings dflags pass local_in_scope binds = compare (m1, nameOccName n1) (m2, nameOccName n2) | otherwise = LT - -- If you edit this function, you may need to update the GHC formalism - -- See Note [GHC Formalism] - lint_bind (Rec prs) = mapM_ (lintSingleBinding TopLevel Recursive) prs - lint_bind (NonRec bndr rhs) = lintSingleBinding TopLevel NonRecursive (bndr,rhs) - {- ************************************************************************ * * @@ -576,28 +572,32 @@ lintExpr dflags vars expr Check a core binding, returning the list of variables bound. -} -lintSingleBinding :: TopLevelFlag -> RecFlag -> (Id, CoreExpr) -> LintM () --- If you edit this function, you may need to update the GHC formalism --- See Note [GHC Formalism] -lintSingleBinding top_lvl_flag rec_flag (binder,rhs) - = addLoc (RhsOf binder) $ - -- Check the rhs - do { ty <- lintRhs binder rhs - ; binder_ty <- applySubstTy (idType binder) - ; ensureEqTys binder_ty ty (mkRhsMsg binder (text "RHS") ty) +lintRecBindings :: TopLevelFlag -> [(Id, CoreExpr)] + -> LintM a -> LintM a +lintRecBindings top_lvl pairs thing_inside + = lintIdBndrs top_lvl bndrs $ \ bndrs' -> + do { zipWithM_ lint_pair bndrs' rhss + ; thing_inside } + where + (bndrs, rhss) = unzip pairs + lint_pair bndr' rhs + = addLoc (RhsOf bndr') $ + do { rhs_ty <- lintRhs bndr' rhs -- Check the rhs + ; lintLetBind top_lvl Recursive bndr' rhs rhs_ty } + +lintLetBind :: TopLevelFlag -> RecFlag -> LintedId + -> CoreExpr -> LintedType -> LintM () +-- Binder's type, and the RHS, have already been linted +-- This function checks other invariants +lintLetBind top_lvl rec_flag binder rhs rhs_ty + = do { let binder_ty = idType binder + ; ensureEqTys binder_ty rhs_ty (mkRhsMsg binder (text "RHS") rhs_ty) -- If the binding is for a CoVar, the RHS should be (Coercion co) -- See Note [Core type and coercion invariant] in GHC.Core ; checkL (not (isCoVar binder) || isCoArg rhs) (mkLetErr binder rhs) - -- Check that it's not levity-polymorphic - -- Do this first, because otherwise isUnliftedType panics - -- Annoyingly, this duplicates the test in lintIdBdr, - -- because for non-rec lets we call lintSingleBinding first - ; checkL (isJoinId binder || not (isTypeLevPoly binder_ty)) - (badBndrTyMsg binder (text "levity-polymorphic")) - -- Check the let/app invariant -- See Note [Core let/app invariant] in GHC.Core ; checkL ( isJoinId binder @@ -610,14 +610,14 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs) -- 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_flag)) + || (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]. - ; checkL (not (isTopLevel top_lvl_flag && binder_ty `eqType` addrPrimTy) + ; checkL (not (isTopLevel top_lvl && binder_ty `eqType` addrPrimTy) || exprIsTickedString rhs) (mkTopNonLitStrMsg binder) @@ -674,7 +674,9 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs) -- join point. -- -- See Note [Checking StaticPtrs]. -lintRhs :: Id -> CoreExpr -> LintM OutType +lintRhs :: Id -> CoreExpr -> LintM LintedType +-- NB: the Id can be Linted or not -- it's only used for +-- its OccInfo and join-pointer-hood lintRhs bndr rhs | Just arity <- isJoinId_maybe bndr = lint_join_lams arity arity True rhs @@ -761,13 +763,14 @@ hurts us here. ************************************************************************ -} --- For OutType, OutKind, the substitution has been applied, --- but has not been linted yet - -type LintedType = Type -- Substitution applied, and type is linted -type LintedKind = Kind +-- Linted things: substitution applied, and type is linted +type LintedType = Type +type LintedKind = Kind +type LintedCoercion = Coercion +type LintedTyCoVar = TyCoVar +type LintedId = Id -lintCoreExpr :: CoreExpr -> LintM OutType +lintCoreExpr :: CoreExpr -> LintM LintedType -- The returned type has the substitution from the monad -- already applied to it: -- lintCoreExpr e subst = exprType (subst e) @@ -776,18 +779,20 @@ lintCoreExpr :: CoreExpr -> LintM OutType -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] + lintCoreExpr (Var var) - = lintVarOcc var 0 + = lintIdOcc var 0 lintCoreExpr (Lit lit) = return (literalType lit) lintCoreExpr (Cast expr co) = do { expr_ty <- markAllJoinsBad $ lintCoreExpr expr - ; co' <- applySubstCo co - ; (_, k2, from_ty, to_ty, r) <- lintCoercion co' - ; checkValueKind k2 (text "target of cast" <+> quotes (ppr co)) - ; lintRole co' Representational r + ; co' <- lintCoercion co + ; let (Pair from_ty to_ty, role) = coercionKindRole co' + ; checkValueType to_ty $ + text "target of cast" <+> quotes (ppr co') + ; lintRole co' Representational role ; ensureEqTys from_ty expr_ty (mkCastErr expr co' from_ty expr_ty) ; return to_ty } @@ -809,7 +814,7 @@ lintCoreExpr (Tick tickish expr) lintCoreExpr (Let (NonRec tv (Type ty)) body) | isTyVar tv = -- See Note [Linting type lets] - do { ty' <- applySubstTy ty + do { ty' <- lintType ty ; lintTyBndr tv $ \ tv' -> do { addLoc (RhsOf tv) $ lintTyKind tv' ty' -- Now extend the substitution so we @@ -820,33 +825,34 @@ lintCoreExpr (Let (NonRec tv (Type ty)) body) lintCoreExpr (Let (NonRec bndr rhs) body) | isId bndr - = do { lintSingleBinding NotTopLevel NonRecursive (bndr,rhs) - ; addLoc (BodyOfLetRec [bndr]) - (lintBinder LetBind bndr $ \_ -> - addGoodJoins [bndr] $ - lintCoreExpr body) } + = do { -- First Lint the RHS, before bringing the binder into scope + rhs_ty <- lintRhs bndr rhs + + -- Now lint the binder + ; lintBinder LetBind bndr $ \bndr' -> + do { lintLetBind NotTopLevel NonRecursive bndr' rhs rhs_ty + ; addLoc (BodyOfLetRec [bndr]) (lintCoreExpr body) } } | otherwise = failWithL (mkLetErr bndr rhs) -- Not quite accurate lintCoreExpr e@(Let (Rec pairs) body) - = lintLetBndrs NotTopLevel bndrs $ - addGoodJoins bndrs $ - do { -- Check that the list of pairs is non-empty + = do { -- Check that the list of pairs is non-empty checkL (not (null pairs)) (emptyRec e) -- Check that there are no duplicated binders + ; let (_, dups) = removeDups compare bndrs ; checkL (null dups) (dupVars dups) -- Check that either all the binders are joins, or none ; checkL (all isJoinId bndrs || all (not . isJoinId) bndrs) $ - mkInconsistentRecMsg bndrs + mkInconsistentRecMsg bndrs - ; mapM_ (lintSingleBinding NotTopLevel Recursive) pairs - ; addLoc (BodyOfLetRec bndrs) (lintCoreExpr body) } + ; lintRecBindings NotTopLevel pairs $ + addLoc (BodyOfLetRec bndrs) $ + lintCoreExpr body } where bndrs = map fst pairs - (_, dups) = removeDups compare bndrs lintCoreExpr e@(App _ _) = do { fun_ty <- lintCoreFun fun (length args) @@ -867,23 +873,35 @@ lintCoreExpr (Type ty) = failWithL (text "Type found as expression" <+> ppr ty) lintCoreExpr (Coercion co) - = do { (k1, k2, ty1, ty2, role) <- lintInCo co - ; return (mkHeteroCoercionType role k1 k2 ty1 ty2) } + = do { co' <- addLoc (InCo co) $ + lintCoercion co + ; return (coercionType co') } ---------------------- -lintVarOcc :: Var -> Int -- Number of arguments (type or value) being passed - -> LintM Type -- returns type of the *variable* -lintVarOcc var nargs - = do { checkL (isNonCoVarId var) +lintIdOcc :: Var -> Int -- Number of arguments (type or value) being passed + -> LintM LintedType -- returns type of the *variable* +lintIdOcc var nargs + = addLoc (OccOf var) $ + do { checkL (isNonCoVarId var) (text "Non term variable" <+> ppr var) -- See GHC.Core Note [Variable occurrences in Core] -- Check that the type of the occurrence is the same - -- as the type of the binding site - ; ty <- applySubstTy (idType var) - ; var' <- lookupIdInScope var - ; let ty' = idType var' - ; ensureEqTys ty ty' $ mkBndrOccTypeMismatchMsg var' var ty' ty + -- as the type of the binding site. The inScopeIds are + -- /un-substituted/, so this checks that the occurrence type + -- is identical to the binder type. + -- This makes things much easier for things like: + -- /\a. \(x::Maybe a). /\a. ...(x::Maybe a)... + -- The "::Maybe a" on the occurrence is referring to the /outer/ a. + -- If we compared /substituted/ types we'd risk comparing + -- (Maybe a) from the binding site with bogus (Maybe a1) from + -- the occurrence site. Comparing un-substituted types finesses + -- this altogether + ; (bndr, linted_bndr_ty) <- lookupIdInScope var + ; let occ_ty = idType var + bndr_ty = idType bndr + ; ensureEqTys occ_ty bndr_ty $ + mkBndrOccTypeMismatchMsg bndr var bndr_ty occ_ty -- Check for a nested occurrence of the StaticPtr constructor. -- See Note [Checking StaticPtrs]. @@ -895,13 +913,13 @@ lintVarOcc var nargs ; checkDeadIdOcc var ; checkJoinOcc var nargs - ; return (idType var') } + ; return linted_bndr_ty } lintCoreFun :: CoreExpr - -> Int -- Number of arguments (type or val) being passed - -> LintM Type -- Returns type of the *function* + -> Int -- Number of arguments (type or val) being passed + -> LintM LintedType -- Returns type of the *function* lintCoreFun (Var var) nargs - = lintVarOcc var nargs + = lintIdOcc var nargs lintCoreFun (Lam var body) nargs -- Act like lintCoreExpr of Lam, but *don't* call markAllJoinsBad; see @@ -941,7 +959,9 @@ checkJoinOcc var n_args = do { mb_join_arity_bndr <- lookupJoinId var ; case mb_join_arity_bndr of { Nothing -> -- Binder is not a join point - addErrL (invalidJoinOcc var) ; + do { join_set <- getValidJoins + ; addErrL (text "join set " <+> ppr join_set $$ + invalidJoinOcc var) } ; Just join_arity_bndr -> @@ -1038,15 +1058,15 @@ subtype of the required type, as one would expect. -} -lintCoreArgs :: OutType -> [CoreArg] -> LintM OutType +lintCoreArgs :: LintedType -> [CoreArg] -> LintM LintedType lintCoreArgs fun_ty args = foldM lintCoreArg fun_ty args -lintCoreArg :: OutType -> CoreArg -> LintM OutType +lintCoreArg :: LintedType -> CoreArg -> LintM LintedType lintCoreArg fun_ty (Type arg_ty) = do { checkL (not (isCoercionTy arg_ty)) (text "Unnecessary coercion-to-type injection:" <+> ppr arg_ty) - ; arg_ty' <- applySubstTy arg_ty + ; arg_ty' <- lintType arg_ty ; lintTyApp fun_ty arg_ty' } lintCoreArg fun_ty arg @@ -1060,11 +1080,12 @@ lintCoreArg fun_ty arg ; checkL (not (isUnliftedType arg_ty) || exprOkForSpeculation arg) (mkLetAppMsg arg) + ; lintValApp arg fun_ty arg_ty } ----------------- -lintAltBinders :: OutType -- Scrutinee type - -> OutType -- Constructor type +lintAltBinders :: LintedType -- Scrutinee type + -> LintedType -- Constructor type -> [OutVar] -- Binders -> LintM () -- If you edit this function, you may need to update the GHC formalism @@ -1080,7 +1101,7 @@ lintAltBinders scrut_ty con_ty (bndr:bndrs) ; lintAltBinders scrut_ty con_ty' bndrs } ----------------- -lintTyApp :: OutType -> OutType -> LintM OutType +lintTyApp :: LintedType -> LintedType -> LintM LintedType lintTyApp fun_ty arg_ty | Just (tv,body_ty) <- splitForAllTy_maybe fun_ty = do { lintTyKind tv arg_ty @@ -1094,7 +1115,7 @@ lintTyApp fun_ty arg_ty = failWithL (mkTyAppMsg fun_ty arg_ty) ----------------- -lintValApp :: CoreExpr -> OutType -> OutType -> LintM OutType +lintValApp :: CoreExpr -> LintedType -> LintedType -> LintM LintedType lintValApp arg fun_ty arg_ty | Just (arg,res) <- splitFunTy_maybe fun_ty = do { ensureEqTys arg arg_ty err1 @@ -1105,17 +1126,17 @@ lintValApp arg fun_ty arg_ty err1 = mkAppMsg fun_ty arg_ty arg err2 = mkNonFunAppMsg fun_ty arg_ty arg -lintTyKind :: OutTyVar -> OutType -> LintM () +lintTyKind :: OutTyVar -> LintedType -> LintM () -- Both args have had substitution applied -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] lintTyKind tyvar arg_ty - = do { arg_kind <- lintType arg_ty - ; unless (arg_kind `eqType` tyvar_kind) - (addErrL (mkKindErrMsg tyvar arg_ty $$ (text "Linted Arg kind:" <+> ppr arg_kind))) } + = unless (arg_kind `eqType` tyvar_kind) $ + addErrL (mkKindErrMsg tyvar arg_ty $$ (text "Linted Arg kind:" <+> ppr arg_kind)) where tyvar_kind = tyVarKind tyvar + arg_kind = typeKind arg_ty {- ************************************************************************ @@ -1125,7 +1146,7 @@ lintTyKind tyvar arg_ty ************************************************************************ -} -lintCaseExpr :: CoreExpr -> Id -> Type -> [CoreAlt] -> LintM OutType +lintCaseExpr :: CoreExpr -> Id -> Type -> [CoreAlt] -> LintM LintedType lintCaseExpr scrut var alt_ty alts = do { let e = Case scrut var alt_ty alts -- Just for error messages @@ -1134,10 +1155,10 @@ lintCaseExpr scrut var alt_ty alts = -- See Note [Join points are less general than the paper] -- in GHC.Core - ; (alt_ty, _) <- addLoc (CaseTy scrut) $ - lintInTy alt_ty - ; (var_ty, _) <- addLoc (IdTy var) $ - lintInTy (idType var) + ; alt_ty <- addLoc (CaseTy scrut) $ + lintValueType alt_ty + ; var_ty <- addLoc (IdTy var) $ + lintValueType (idType var) -- We used to try to check whether a case expression with no -- alternatives was legitimate, but this didn't work. @@ -1179,7 +1200,7 @@ lintCaseExpr scrut var alt_ty alts = ; checkCaseAlts e scrut_ty alts ; return alt_ty } } -checkCaseAlts :: CoreExpr -> OutType -> [CoreAlt] -> LintM () +checkCaseAlts :: CoreExpr -> LintedType -> [CoreAlt] -> LintM () -- a) Check that the alts are non-empty -- b1) Check that the DEFAULT comes first, if it exists -- b2) Check that the others are in increasing order @@ -1219,14 +1240,14 @@ checkCaseAlts e ty alts = Nothing -> False Just tycon -> isPrimTyCon tycon -lintAltExpr :: CoreExpr -> OutType -> LintM () +lintAltExpr :: CoreExpr -> LintedType -> LintM () lintAltExpr expr ann_ty = do { actual_ty <- lintCoreExpr expr ; ensureEqTys actual_ty ann_ty (mkCaseAltMsg expr actual_ty ann_ty) } -- See GHC.Core Note [Case expression invariants] item (6) -lintCoreAlt :: OutType -- Type of scrutinee - -> OutType -- Type of the alternative +lintCoreAlt :: LintedType -- Type of scrutinee + -> LintedType -- Type of the alternative -> CoreAlt -> LintM () -- If you edit this function, you may need to update the GHC formalism @@ -1286,40 +1307,43 @@ lintBinders site (var:vars) linterF = lintBinder site var $ \var' -> -- See Note [GHC Formalism] lintBinder :: BindingSite -> Var -> (Var -> LintM a) -> LintM a lintBinder site var linterF - | isTyVar var = lintTyBndr var linterF - | isCoVar var = lintCoBndr var linterF - | otherwise = lintIdBndr NotTopLevel site var linterF + | isTyCoVar var = lintTyCoBndr var linterF + | otherwise = lintIdBndr NotTopLevel site var linterF -lintTyBndr :: InTyVar -> (OutTyVar -> LintM a) -> LintM a -lintTyBndr tv thing_inside - = do { subst <- getTCvSubst - ; let (subst', tv') = substTyVarBndr subst tv - ; lintKind (varType tv') - ; updateTCvSubst subst' (thing_inside tv') } +lintTyBndr :: TyVar -> (LintedTyCoVar -> LintM a) -> LintM a +lintTyBndr = lintTyCoBndr -- We could specialise it, I guess + +-- lintCoBndr :: CoVar -> (LintedTyCoVar -> LintM a) -> LintM a +-- lintCoBndr = lintTyCoBndr -- We could specialise it, I guess -lintCoBndr :: InCoVar -> (OutCoVar -> LintM a) -> LintM a -lintCoBndr cv thing_inside +lintTyCoBndr :: TyCoVar -> (LintedTyCoVar -> LintM a) -> LintM a +lintTyCoBndr tcv thing_inside = do { subst <- getTCvSubst - ; let (subst', cv') = substCoVarBndr subst cv - ; lintKind (varType cv') - ; lintL (isCoVarType (varType cv')) - (text "CoVar with non-coercion type:" <+> pprTyVar cv) - ; updateTCvSubst subst' (thing_inside cv') } - -lintLetBndrs :: TopLevelFlag -> [Var] -> LintM a -> LintM a -lintLetBndrs top_lvl ids linterF - = go ids + ; kind' <- lintType (varType tcv) + ; let tcv' = uniqAway (getTCvInScope subst) $ + setVarType tcv kind' + subst' = extendTCvSubstWithClone subst tcv tcv' + ; when (isCoVar tcv) $ + lintL (isCoVarType kind') + (text "CoVar with non-coercion type:" <+> pprTyVar tcv) + ; updateTCvSubst subst' (thing_inside tcv') } + +lintIdBndrs :: forall a. TopLevelFlag -> [Id] -> ([LintedId] -> LintM a) -> LintM a +lintIdBndrs top_lvl ids thing_inside + = go ids thing_inside where - go [] = linterF - go (id:ids) = lintIdBndr top_lvl LetBind id $ \_ -> - go ids + go :: [Id] -> ([Id] -> LintM a) -> LintM a + go [] thing_inside = thing_inside [] + go (id:ids) thing_inside = lintIdBndr top_lvl LetBind id $ \id' -> + go ids $ \ids' -> + thing_inside (id' : ids') lintIdBndr :: TopLevelFlag -> BindingSite -> InVar -> (OutVar -> LintM a) -> LintM a -- Do substitution on the type of a binder and add the var with this -- new type to the in-scope set of the second argument -- ToDo: lint its rules -lintIdBndr top_lvl bind_site id linterF +lintIdBndr top_lvl bind_site id thing_inside = ASSERT2( isId id, ppr id ) do { flags <- getLintFlags ; checkL (not (lf_check_global_ids flags) || isLocalId id) @@ -1334,14 +1358,11 @@ lintIdBndr top_lvl bind_site id linterF ; checkL (not (isExternalName (Var.varName id)) || is_top_lvl) (mkNonTopExternalNameMsg id) - ; (id_ty, k) <- addLoc (IdTy id) $ - lintInTy (idType id) - ; let id' = setIdType id id_ty - -- See Note [Levity polymorphism invariants] in GHC.Core - ; lintL (isJoinId id || not (lf_check_levity_poly flags) || not (isKindLevPoly k)) - (text "Levity-polymorphic binder:" <+> - (ppr id <+> dcolon <+> parens (ppr id_ty <+> dcolon <+> ppr k))) + ; lintL (isJoinId id || not (lf_check_levity_poly flags) + || not (isTypeLevPoly id_ty)) $ + text "Levity-polymorphic binder:" <+> ppr id <+> dcolon <+> + parens (ppr id_ty <+> dcolon <+> ppr (typeKind id_ty)) -- Check that a join-id is a not-top-level let-binding ; when (isJoinId id) $ @@ -1353,8 +1374,13 @@ lintIdBndr top_lvl bind_site id linterF ; lintL (not (isCoVarType id_ty)) (text "Non-CoVar has coercion type" <+> ppr id <+> dcolon <+> ppr id_ty) - ; addInScopeId id' $ (linterF id') } + ; linted_ty <- addLoc (IdTy id) (lintValueType id_ty) + + ; addInScopeId id linted_ty $ + thing_inside (setIdType id linted_ty) } where + id_ty = idType id + is_top_lvl = isTopLevel top_lvl is_let_bind = case bind_site of LetBind -> True @@ -1378,45 +1404,52 @@ lintTypes dflags vars tys where (_warns, errs) = initL dflags defaultLintFlags vars linter linter = lintBinders LambdaBind vars $ \_ -> - mapM_ lintInTy tys + mapM_ lintType tys -lintInTy :: InType -> LintM (LintedType, LintedKind) +lintValueType :: Type -> LintM LintedType -- Types only, not kinds -- Check the type, and apply the substitution to it -- See Note [Linting type lets] -lintInTy ty +lintValueType ty = addLoc (InType ty) $ - do { ty' <- applySubstTy ty - ; k <- lintType ty' - ; addLoc (InKind ty' k) $ - lintKind k -- The kind returned by lintType is already - -- a LintedKind but we also want to check that - -- k :: *, which lintKind does - ; return (ty', k) } + do { ty' <- lintType ty + ; let sk = typeKind ty' + ; lintL (classifiesTypeWithValues sk) $ + hang (text "Ill-kinded type:" <+> ppr ty) + 2 (text "has kind:" <+> ppr sk) + ; return ty' } checkTyCon :: TyCon -> LintM () checkTyCon tc = checkL (not (isTcTyCon tc)) (text "Found TcTyCon:" <+> ppr tc) ------------------- -lintType :: OutType -> LintM LintedKind --- The returned Kind has itself been linted +lintType :: LintedType -> LintM LintedType -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] lintType (TyVarTy tv) - = do { checkL (isTyVar tv) (mkBadTyVarMsg tv) - ; tv' <- lintTyCoVarInScope tv - ; return (tyVarKind tv') } - -- We checked its kind when we added it to the envt + | not (isTyVar tv) + = failWithL (mkBadTyVarMsg tv) + + | otherwise + = do { subst <- getTCvSubst + ; case lookupTyVar subst tv of + Just linted_ty -> return linted_ty ; + Nothing -> -- lintTyBndr always extends the substitition + failWithL $ + hang (text "The type variable" <+> pprBndr LetBind tv) + 2 (text "is out of scope") + } lintType ty@(AppTy t1 t2) | TyConApp {} <- t1 = failWithL $ text "TyConApp to the left of AppTy:" <+> ppr ty | otherwise - = do { k1 <- lintType t1 - ; k2 <- lintType t2 - ; lint_ty_app ty k1 [(t2,k2)] } + = do { t1' <- lintType t1 + ; t2' <- lintType t2 + ; lint_ty_app ty (typeKind t1') [t2'] + ; return (AppTy t1' t2') } lintType ty@(TyConApp tc tys) | isTypeSynonymTyCon tc || isTypeFamilyTyCon tc @@ -1433,71 +1466,72 @@ lintType ty@(TyConApp tc tys) | otherwise -- Data types, data families, primitive types = do { checkTyCon tc - ; ks <- mapM lintType tys - ; lint_ty_app ty (tyConKind tc) (tys `zip` ks) } + ; tys' <- mapM lintType tys + ; lint_ty_app ty (tyConKind tc) tys' + ; return (TyConApp tc tys') } -- arrows can related *unlifted* kinds, so this has to be separate from -- a dependent forall. -lintType ty@(FunTy _ t1 t2) - = do { k1 <- lintType t1 - ; k2 <- lintType t2 - ; lintArrow (text "type or kind" <+> quotes (ppr ty)) k1 k2 } +lintType ty@(FunTy af t1 t2) + = do { t1' <- lintType t1 + ; t2' <- lintType t2 + ; lintArrow (text "type or kind" <+> quotes (ppr ty)) t1' t2' + ; return (FunTy af t1' t2') } + +lintType ty@(ForAllTy (Bndr tcv vis) body_ty) + | not (isTyCoVar tcv) + = failWithL (text "Non-Tyvar or Non-Covar bound in type:" <+> ppr ty) + | otherwise + = lintTyCoBndr tcv $ \tcv' -> + do { body_ty' <- lintType body_ty + ; lintForAllBody tcv' body_ty' -lintType t@(ForAllTy (Bndr tv _vis) ty) - -- forall over types - | isTyVar tv - = lintTyBndr tv $ \tv' -> - do { k <- lintType ty - ; checkValueKind k (text "the body of forall:" <+> ppr t) - ; case occCheckExpand [tv'] k of -- See Note [Stupid type synonyms] - Just k' -> return k' - Nothing -> failWithL (hang (text "Variable escape in forall:") - 2 (vcat [ text "type:" <+> ppr t - , text "kind:" <+> ppr k ])) - } + ; when (isCoVar tcv) $ + lintL (tcv `elemVarSet` tyCoVarsOfType body_ty) $ + text "Covar does not occur in the body:" <+> (ppr tcv $$ ppr body_ty) + -- See GHC.Core.TyCo.Rep Note [Unused coercion variable in ForAllTy] + -- and cf GHC.Core.Coercion Note [Unused coercion variable in ForAllCo] + + ; return (ForAllTy (Bndr tcv' vis) body_ty') } -lintType t@(ForAllTy (Bndr cv _vis) ty) - -- forall over coercions - = do { lintL (isCoVar cv) - (text "Non-Tyvar or Non-Covar bound in type:" <+> ppr t) - ; lintL (cv `elemVarSet` tyCoVarsOfType ty) - (text "Covar does not occur in the body:" <+> ppr t) - ; lintCoBndr cv $ \_ -> - do { k <- lintType ty - ; checkValueKind k (text "the body of forall:" <+> ppr t) - ; return liftedTypeKind - -- We don't check variable escape here. Namely, k could refer to cv' - }} - -lintType ty@(LitTy l) = lintTyLit l >> return (typeKind ty) +lintType ty@(LitTy l) + = do { lintTyLit l; return ty } lintType (CastTy ty co) - = do { k1 <- lintType ty - ; (k1', k2) <- lintStarCoercion co - ; ensureEqTys k1 k1' (mkCastTyErr ty co k1' k1) - ; return k2 } + = do { ty' <- lintType ty + ; co' <- lintStarCoercion co + ; let tyk = typeKind ty' + cok = coercionLKind co' + ; ensureEqTys tyk cok (mkCastTyErr ty co tyk cok) + ; return (CastTy ty' co') } lintType (CoercionTy co) - = do { (k1, k2, ty1, ty2, r) <- lintCoercion co - ; return $ mkHeteroCoercionType r k1 k2 ty1 ty2 } - -{- Note [Stupid type synonyms] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider (#14939) - type Alg cls ob = ob - f :: forall (cls :: * -> Constraint) (b :: Alg cls *). b - -Here 'cls' appears free in b's kind, which would usually be illegal -(because in (forall a. ty), ty's kind should not mention 'a'). But -#in this case (Alg cls *) = *, so all is well. Currently we allow -this, and make Lint expand synonyms where necessary to make it so. - -c.f. TcUnify.occCheckExpand and GHC.Core.Utils.coreAltsType which deal -with the same problem. A single systematic solution eludes me. --} + = do { co' <- lintCoercion co + ; return (CoercionTy co') } + +----------------- +lintForAllBody :: LintedTyCoVar -> LintedType -> LintM () +-- Do the checks for the body of a forall-type +lintForAllBody tcv body_ty + = do { checkValueType body_ty (text "the body of forall:" <+> ppr body_ty) + + -- For type variables, check for skolem escape + -- See Note [Phantom type variables in kinds] in GHC.Core.Type + -- The kind of (forall cv. th) is liftedTypeKind, so no + -- need to check for skolem-escape in the CoVar case + ; let body_kind = typeKind body_ty + ; when (isTyVar tcv) $ + case occCheckExpand [tcv] body_kind of + Just {} -> return () + Nothing -> failWithL $ + hang (text "Variable escape in forall:") + 2 (vcat [ text "tyvar:" <+> ppr tcv + , text "type:" <+> ppr body_ty + , text "kind:" <+> ppr body_kind ]) + } ----------------- -lintTySynFamApp :: Bool -> Type -> TyCon -> [Type] -> LintM LintedKind +lintTySynFamApp :: Bool -> InType -> TyCon -> [InType] -> LintM LintedType -- The TyCon is a type synonym or a type family (not a data family) -- See Note [Linting type synonym applications] -- c.f. TcValidity.check_syn_tc_app @@ -1511,58 +1545,54 @@ lintTySynFamApp report_unsat ty tc tys , let expanded_ty = mkAppTys (substTy (mkTvSubstPrs tenv) rhs) tys' = do { -- Kind-check the argument types, but without reporting -- un-saturated type families/synonyms - ks <- setReportUnsat False (mapM lintType tys) + tys' <- setReportUnsat False (mapM lintType tys) ; when report_unsat $ do { _ <- lintType expanded_ty ; return () } - ; lint_ty_app ty (tyConKind tc) (tys `zip` ks) } + ; lint_ty_app ty (tyConKind tc) tys' + ; return (TyConApp tc tys') } -- Otherwise this must be a type family | otherwise - = do { ks <- mapM lintType tys - ; lint_ty_app ty (tyConKind tc) (tys `zip` ks) } - ------------------ -lintKind :: OutKind -> LintM () --- If you edit this function, you may need to update the GHC formalism --- See Note [GHC Formalism] -lintKind k = do { sk <- lintType k - ; unless (classifiesTypeWithValues sk) - (addErrL (hang (text "Ill-kinded kind:" <+> ppr k) - 2 (text "has kind:" <+> ppr sk))) } + = do { tys' <- mapM lintType tys + ; lint_ty_app ty (tyConKind tc) tys' + ; return (TyConApp tc tys') } ----------------- -- Confirms that a type is really *, #, Constraint etc -checkValueKind :: OutKind -> SDoc -> LintM () -checkValueKind k doc - = lintL (classifiesTypeWithValues k) - (text "Non-*-like kind when *-like expected:" <+> ppr k $$ +checkValueType :: LintedType -> SDoc -> LintM () +checkValueType ty doc + = lintL (classifiesTypeWithValues kind) + (text "Non-*-like kind when *-like expected:" <+> ppr kind $$ text "when checking" <+> doc) + where + kind = typeKind ty ----------------- -lintArrow :: SDoc -> LintedKind -> LintedKind -> LintM LintedKind +lintArrow :: SDoc -> LintedType -> LintedType -> LintM () -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] -lintArrow what k1 k2 -- Eg lintArrow "type or kind `blah'" k1 k2 +lintArrow what t1 t2 -- Eg lintArrow "type or kind `blah'" k1 k2 -- or lintArrow "coercion `blah'" k1 k2 = do { unless (classifiesTypeWithValues k1) (addErrL (msg (text "argument") k1)) - ; unless (classifiesTypeWithValues k2) (addErrL (msg (text "result") k2)) - ; return liftedTypeKind } + ; unless (classifiesTypeWithValues k2) (addErrL (msg (text "result") k2)) } where + k1 = typeKind t1 + k2 = typeKind t2 msg ar k = vcat [ hang (text "Ill-kinded" <+> ar) 2 (text "in" <+> what) , what <+> text "kind:" <+> ppr k ] ----------------- -lint_ty_app :: Type -> LintedKind -> [(LintedType,LintedKind)] -> LintM LintedKind +lint_ty_app :: Type -> LintedKind -> [LintedType] -> LintM () lint_ty_app ty k tys = lint_app (text "type" <+> quotes (ppr ty)) k tys ---------------- -lint_co_app :: Coercion -> LintedKind -> [(LintedType,LintedKind)] -> LintM LintedKind +lint_co_app :: Coercion -> LintedKind -> [LintedType] -> LintM () lint_co_app ty k tys = lint_app (text "coercion" <+> quotes (ppr ty)) k tys @@ -1574,42 +1604,45 @@ lintTyLit (NumTyLit n) where msg = text "Negative type literal:" <+> integer n lintTyLit (StrTyLit _) = return () -lint_app :: SDoc -> LintedKind -> [(LintedType,LintedKind)] -> LintM Kind +lint_app :: SDoc -> LintedKind -> [LintedType] -> LintM () -- (lint_app d fun_kind arg_tys) -- We have an application (f arg_ty1 .. arg_tyn), -- where f :: fun_kind --- Takes care of linting the OutTypes -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] -lint_app doc kfn kas +lint_app doc kfn arg_tys = do { in_scope <- getInScope -- We need the in_scope set to satisfy the invariant in -- Note [The substitution invariant] in GHC.Core.TyCo.Subst - ; foldlM (go_app in_scope) kfn kas } + ; _ <- foldlM (go_app in_scope) kfn arg_tys + ; return () } where fail_msg extra = vcat [ hang (text "Kind application error in") 2 doc , nest 2 (text "Function kind =" <+> ppr kfn) - , nest 2 (text "Arg kinds =" <+> ppr kas) + , nest 2 (text "Arg types =" <+> ppr arg_tys) , extra ] - go_app in_scope kfn tka + go_app in_scope kfn ta | Just kfn' <- coreView kfn - = go_app in_scope kfn' tka + = go_app in_scope kfn' ta - go_app _ (FunTy _ kfa kfb) tka@(_,ka) - = do { unless (ka `eqType` kfa) $ - addErrL (fail_msg (text "Fun:" <+> (ppr kfa $$ ppr tka))) + go_app _ fun_kind@(FunTy _ kfa kfb) ta + = do { let ka = typeKind ta + ; unless (ka `eqType` kfa) $ + addErrL (fail_msg (text "Fun:" <+> (ppr fun_kind $$ ppr ta <+> dcolon <+> ppr ka))) ; return kfb } - go_app in_scope (ForAllTy (Bndr kv _vis) kfn) tka@(ta,ka) + go_app in_scope (ForAllTy (Bndr kv _vis) kfn) ta = do { let kv_kind = varType kv + ka = typeKind ta ; unless (ka `eqType` kv_kind) $ - addErrL (fail_msg (text "Forall:" <+> (ppr kv $$ ppr kv_kind $$ ppr tka))) + addErrL (fail_msg (text "Forall:" <+> (ppr kv $$ ppr kv_kind $$ + ppr ta <+> dcolon <+> ppr ka))) ; return $ substTy (extendTCvSubst (mkEmptyTCvSubst in_scope) kv ta) kfn } - go_app _ kfn ka - = failWithL (fail_msg (text "Not a fun:" <+> (ppr kfn $$ ppr ka))) + go_app _ kfn ta + = failWithL (fail_msg (text "Not a fun:" <+> (ppr kfn $$ ppr ta))) {- ********************************************************************* * * @@ -1617,7 +1650,7 @@ lint_app doc kfn kas * * ********************************************************************* -} -lintCoreRule :: OutVar -> OutType -> CoreRule -> LintM () +lintCoreRule :: OutVar -> LintedType -> CoreRule -> LintM () lintCoreRule _ _ (BuiltinRule {}) = return () -- Don't bother @@ -1710,68 +1743,94 @@ Note [Rules and join points] in OccurAnal for further discussion. ************************************************************************ -} -lintInCo :: InCoercion -> LintM (LintedKind, LintedKind, LintedType, LintedType, Role) --- Check the coercion, and apply the substitution to it --- See Note [Linting type lets] -lintInCo co - = addLoc (InCo co) $ - do { co' <- applySubstCo co - ; lintCoercion co' } +{- Note [Asymptotic efficiency] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When linting coercions (and types actually) we return a linted +(substituted) coercion. Then we often have to take the coercionKind of +that returned coercion. If we get long chains, that can be asymptotically +inefficient, notably in +* TransCo +* InstCo +* NthCo (cf #9233) +* LRCo + +But the code is simple. And this is only Lint. Let's wait to see if +the bad perf bites us in practice. + +A solution would be to return the kind and role of the coercion, +as well as the linted coercion. Or perhaps even *only* the kind and role, +which is what used to happen. But that proved tricky and error prone +(#17923), so now we return the coercion. +-} + -- lints a coercion, confirming that its lh kind and its rh kind are both * -- also ensures that the role is Nominal -lintStarCoercion :: OutCoercion -> LintM (LintedType, LintedType) +lintStarCoercion :: InCoercion -> LintM LintedCoercion lintStarCoercion g - = do { (k1, k2, t1, t2, r) <- lintCoercion g - ; checkValueKind k1 (text "the kind of the left type in" <+> ppr g) - ; checkValueKind k2 (text "the kind of the right type in" <+> ppr g) - ; lintRole g Nominal r - ; return (t1, t2) } - -lintCoercion :: OutCoercion -> LintM (LintedKind, LintedKind, LintedType, LintedType, Role) --- Check the kind of a coercion term, returning the kind --- Post-condition: the returned OutTypes are lint-free --- --- If lintCoercion co = (k1, k2, s1, s2, r) --- then co :: s1 ~r s2 --- s1 :: k1 --- s2 :: k2 - + = do { g' <- lintCoercion g + ; let Pair t1 t2 = coercionKind g' + ; checkValueType t1 (text "the kind of the left type in" <+> ppr g) + ; checkValueType t2 (text "the kind of the right type in" <+> ppr g) + ; lintRole g Nominal (coercionRole g) + ; return g' } + +lintCoercion :: InCoercion -> LintM LintedCoercion -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] + +lintCoercion (CoVarCo cv) + | not (isCoVar cv) + = failWithL (hang (text "Bad CoVarCo:" <+> ppr cv) + 2 (text "With offending type:" <+> ppr (varType cv))) + + | otherwise + = do { subst <- getTCvSubst + ; case lookupCoVar subst cv of + Just linted_co -> return linted_co ; + Nothing -> -- lintCoBndr always extends the substitition + failWithL $ + hang (text "The coercion variable" <+> pprBndr LetBind cv) + 2 (text "is out of scope") + } + + lintCoercion (Refl ty) - = do { k <- lintType ty - ; return (k, k, ty, ty, Nominal) } + = do { ty' <- lintType ty + ; return (Refl ty') } lintCoercion (GRefl r ty MRefl) - = do { k <- lintType ty - ; return (k, k, ty, ty, r) } + = do { ty' <- lintType ty + ; return (GRefl r ty' MRefl) } lintCoercion (GRefl r ty (MCo co)) - = do { k <- lintType ty - ; (_, _, k1, k2, r') <- lintCoercion co - ; ensureEqTys k k1 - (hang (text "GRefl coercion kind mis-match:" <+> ppr co) - 2 (vcat [ppr ty, ppr k, ppr k1])) - ; lintRole co Nominal r' - ; return (k1, k2, ty, mkCastTy ty co, r) } + = do { ty' <- lintType ty + ; co' <- lintCoercion co + ; let tk = typeKind ty' + tl = coercionLKind co' + ; ensureEqTys tk tl $ + hang (text "GRefl coercion kind mis-match:" <+> ppr co) + 2 (vcat [ppr ty', ppr tk, ppr tl]) + ; lintRole co' Nominal (coercionRole co') + ; return (GRefl r ty' (MCo co')) } lintCoercion co@(TyConAppCo r tc cos) | tc `hasKey` funTyConKey , [_rep1,_rep2,_co1,_co2] <- cos - = do { failWithL (text "Saturated TyConAppCo (->):" <+> ppr co) - } -- All saturated TyConAppCos should be FunCos + = failWithL (text "Saturated TyConAppCo (->):" <+> ppr co) + -- All saturated TyConAppCos should be FunCos | Just {} <- synTyConDefn_maybe tc = failWithL (text "Synonym in TyConAppCo:" <+> ppr co) | otherwise = do { checkTyCon tc - ; (k's, ks, ss, ts, rs) <- mapAndUnzip5M lintCoercion cos - ; k' <- lint_co_app co (tyConKind tc) (ss `zip` k's) - ; k <- lint_co_app co (tyConKind tc) (ts `zip` ks) - ; _ <- zipWith3M lintRole cos (tyConRolesX r tc) rs - ; return (k', k, mkTyConApp tc ss, mkTyConApp tc ts, r) } + ; cos' <- mapM lintCoercion cos + ; let (co_kinds, co_roles) = unzip (map coercionKindRole cos') + ; lint_co_app co (tyConKind tc) (map pFst co_kinds) + ; lint_co_app co (tyConKind tc) (map pSnd co_kinds) + ; zipWithM_ (lintRole co) (tyConRolesX r tc) co_roles + ; return (TyConAppCo r tc cos') } lintCoercion co@(AppCo co1 co2) | TyConAppCo {} <- co1 @@ -1779,111 +1838,75 @@ lintCoercion co@(AppCo co1 co2) | Just (TyConApp {}, _) <- isReflCo_maybe co1 = failWithL (text "Refl (TyConApp ...) to the left of AppCo:" <+> ppr co) | otherwise - = do { (k1, k2, s1, s2, r1) <- lintCoercion co1 - ; (k'1, k'2, t1, t2, r2) <- lintCoercion co2 - ; k3 <- lint_co_app co k1 [(t1,k'1)] - ; k4 <- lint_co_app co k2 [(t2,k'2)] + = do { co1' <- lintCoercion co1 + ; co2' <- lintCoercion co2 + ; let (Pair lk1 rk1, r1) = coercionKindRole co1' + (Pair lk2 rk2, r2) = coercionKindRole co2' + ; lint_co_app co (typeKind lk1) [lk2] + ; lint_co_app co (typeKind rk1) [rk2] + ; if r1 == Phantom then lintL (r2 == Phantom || r2 == Nominal) (text "Second argument in AppCo cannot be R:" $$ ppr co) else lintRole co Nominal r2 - ; return (k3, k4, mkAppTy s1 t1, mkAppTy s2 t2, r1) } + + ; return (AppCo co1' co2') } ---------- -lintCoercion (ForAllCo tv1 kind_co co) - -- forall over types - | isTyVar tv1 - = do { (_, k2) <- lintStarCoercion kind_co - ; let tv2 = setTyVarKind tv1 k2 - ; addInScopeTyCoVar tv1 $ - do { - ; (k3, k4, t1, t2, r) <- lintCoercion co - ; in_scope <- getInScope - ; let tyl = mkInvForAllTy tv1 t1 - subst = mkTvSubst in_scope $ - -- We need both the free vars of the `t2` and the - -- free vars of the range of the substitution in - -- scope. All the free vars of `t2` and `kind_co` should - -- already be in `in_scope`, because they've been - -- linted and `tv2` has the same unique as `tv1`. - -- See Note [The substitution invariant] in GHC.Core.TyCo.Subst. - unitVarEnv tv1 (TyVarTy tv2 `mkCastTy` mkSymCo kind_co) - tyr = mkInvForAllTy tv2 $ - substTy subst t2 - ; return (k3, k4, tyl, tyr, r) } } - -lintCoercion (ForAllCo cv1 kind_co co) - -- forall over coercions - = ASSERT( isCoVar cv1 ) - do { lintL (almostDevoidCoVarOfCo cv1 co) - (text "Covar can only appear in Refl and GRefl: " <+> ppr co) - ; (_, k2) <- lintStarCoercion kind_co - ; let cv2 = setVarType cv1 k2 - ; addInScopeTyCoVar cv1 $ - do { - ; (k3, k4, t1, t2, r) <- lintCoercion co - ; checkValueKind k3 (text "the body of a ForAllCo over covar:" <+> ppr co) - ; checkValueKind k4 (text "the body of a ForAllCo over covar:" <+> ppr co) - -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep - ; in_scope <- getInScope - ; let tyl = mkTyCoInvForAllTy cv1 t1 - r2 = coVarRole cv1 - kind_co' = downgradeRole r2 Nominal kind_co - eta1 = mkNthCo r2 2 kind_co' - eta2 = mkNthCo r2 3 kind_co' - subst = mkCvSubst in_scope $ - -- We need both the free vars of the `t2` and the - -- free vars of the range of the substitution in - -- scope. All the free vars of `t2` and `kind_co` should - -- already be in `in_scope`, because they've been - -- linted and `cv2` has the same unique as `cv1`. - -- See Note [The substitution invariant] in GHC.Core.TyCo.Subst. - unitVarEnv cv1 (eta1 `mkTransCo` (mkCoVarCo cv2) - `mkTransCo` (mkSymCo eta2)) - tyr = mkTyCoInvForAllTy cv2 $ - substTy subst t2 - ; return (liftedTypeKind, liftedTypeKind, tyl, tyr, r) } } - -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep +lintCoercion co@(ForAllCo tcv kind_co body_co) + | not (isTyCoVar tcv) + = failWithL (text "Non tyco binder in ForAllCo:" <+> ppr co) + | otherwise + = do { kind_co' <- lintStarCoercion kind_co + ; lintTyCoBndr tcv $ \tcv' -> + do { body_co' <- lintCoercion body_co + ; ensureEqTys (varType tcv') (coercionLKind kind_co') $ + text "Kind mis-match in ForallCo" <+> ppr co + + -- Assuming kind_co :: k1 ~ k2 + -- Need to check that + -- (forall (tcv:k1). lty) and + -- (forall (tcv:k2). rty[(tcv:k2) |> sym kind_co/tcv]) + -- are both well formed. Easiest way is to call lintForAllBody + -- for each; there is actually no need to do the funky substitution + ; let Pair lty rty = coercionKind body_co' + ; lintForAllBody tcv' lty + ; lintForAllBody tcv' rty + + ; when (isCoVar tcv) $ + lintL (almostDevoidCoVarOfCo tcv body_co) $ + text "Covar can only appear in Refl and GRefl: " <+> ppr co + -- See "last wrinkle" in GHC.Core.Coercion + -- Note [Unused coercion variable in ForAllCo] + -- and c.f. GHC.Core.TyCo.Rep Note [Unused coercion variable in ForAllTy] + + ; return (ForAllCo tcv' kind_co' body_co') } } lintCoercion co@(FunCo r co1 co2) - = do { (k1,k'1,s1,t1,r1) <- lintCoercion co1 - ; (k2,k'2,s2,t2,r2) <- lintCoercion co2 - ; k <- lintArrow (text "coercion" <+> quotes (ppr co)) k1 k2 - ; k' <- lintArrow (text "coercion" <+> quotes (ppr co)) k'1 k'2 - ; lintRole co1 r r1 - ; lintRole co2 r r2 - ; return (k, k', mkVisFunTy s1 s2, mkVisFunTy t1 t2, r) } - -lintCoercion (CoVarCo cv) - | not (isCoVar cv) - = failWithL (hang (text "Bad CoVarCo:" <+> ppr cv) - 2 (text "With offending type:" <+> ppr (varType cv))) - | otherwise - = do { cv' <- lintTyCoVarInScope cv - ; lintUnliftedCoVar cv' - ; return $ coVarKindsTypesRole cv' } + = do { co1' <- lintCoercion co1 + ; co2' <- lintCoercion co2 + ; let Pair lt1 rt1 = coercionKind co1 + Pair lt2 rt2 = coercionKind co2 + ; lintArrow (text "coercion" <+> quotes (ppr co)) lt1 lt2 + ; lintArrow (text "coercion" <+> quotes (ppr co)) rt1 rt2 + ; lintRole co1 r (coercionRole co1) + ; lintRole co2 r (coercionRole co2) + ; return (FunCo r co1' co2') } -- See Note [Bad unsafe coercion] lintCoercion co@(UnivCo prov r ty1 ty2) - = do { k1 <- lintType ty1 - ; k2 <- lintType ty2 - ; case prov of - PhantomProv kco -> do { lintRole co Phantom r - ; check_kinds kco k1 k2 } - - ProofIrrelProv kco -> do { lintL (isCoercionTy ty1) $ - mkBadProofIrrelMsg ty1 co - ; lintL (isCoercionTy ty2) $ - mkBadProofIrrelMsg ty2 co - ; check_kinds kco k1 k2 } - - PluginProv _ -> return () -- no extra checks + = do { ty1' <- lintType ty1 + ; ty2' <- lintType ty2 + ; let k1 = typeKind ty1' + k2 = typeKind ty2' + ; prov' <- lint_prov k1 k2 prov ; when (r /= Phantom && classifiesTypeWithValues k1 && classifiesTypeWithValues k2) (checkTypes ty1 ty2) - ; return (k1, k2, ty1, ty2, r) } + + ; return (UnivCo prov' r ty1' ty2') } where report s = hang (text $ "Unsafe coercion: " ++ s) 2 (vcat [ text "From:" <+> ppr ty1 @@ -1926,39 +1949,53 @@ lintCoercion co@(UnivCo prov r ty1 ty2) _ -> return () } - check_kinds kco k1 k2 = do { (k1', k2') <- lintStarCoercion kco - ; ensureEqTys k1 k1' (mkBadUnivCoMsg CLeft co) - ; ensureEqTys k2 k2' (mkBadUnivCoMsg CRight co) } + lint_prov k1 k2 (PhantomProv kco) + = do { kco' <- lintStarCoercion kco + ; lintRole co Phantom r + ; check_kinds kco' k1 k2 + ; return (PhantomProv kco') } + + lint_prov k1 k2 (ProofIrrelProv kco) + = do { lintL (isCoercionTy ty1) (mkBadProofIrrelMsg ty1 co) + ; lintL (isCoercionTy ty2) (mkBadProofIrrelMsg ty2 co) + ; kco' <- lintStarCoercion kco + ; check_kinds kco k1 k2 + ; return (ProofIrrelProv kco') } + + lint_prov _ _ prov@(PluginProv _) = return prov + + check_kinds kco k1 k2 + = do { let Pair k1' k2' = coercionKind kco + ; ensureEqTys k1 k1' (mkBadUnivCoMsg CLeft co) + ; ensureEqTys k2 k2' (mkBadUnivCoMsg CRight co) } lintCoercion (SymCo co) - = do { (k1, k2, ty1, ty2, r) <- lintCoercion co - ; return (k2, k1, ty2, ty1, r) } + = do { co' <- lintCoercion co + ; return (SymCo co') } lintCoercion co@(TransCo co1 co2) - = do { (k1a, _k1b, ty1a, ty1b, r1) <- lintCoercion co1 - ; (_k2a, k2b, ty2a, ty2b, r2) <- lintCoercion co2 + = do { co1' <- lintCoercion co1 + ; co2' <- lintCoercion co2 + ; let ty1b = coercionRKind co1' + ty2a = coercionLKind co2' ; ensureEqTys ty1b ty2a (hang (text "Trans coercion mis-match:" <+> ppr co) - 2 (vcat [ppr ty1a, ppr ty1b, ppr ty2a, ppr ty2b])) - ; lintRole co r1 r2 - ; return (k1a, k2b, ty1a, ty2b, r1) } + 2 (vcat [ppr (coercionKind co1'), ppr (coercionKind co2')])) + ; lintRole co (coercionRole co1) (coercionRole co2) + ; return (TransCo co1' co2') } lintCoercion the_co@(NthCo r0 n co) - = do { (_, _, s, t, r) <- lintCoercion co + = do { co' <- lintCoercion co + ; let (Pair s t, r) = coercionKindRole co' ; case (splitForAllTy_maybe s, splitForAllTy_maybe t) of - { (Just (tcv_s, _ty_s), Just (tcv_t, _ty_t)) + { (Just _, Just _) -- works for both tyvar and covar | n == 0 , (isForAllTy_ty s && isForAllTy_ty t) || (isForAllTy_co s && isForAllTy_co t) -> do { lintRole the_co Nominal r0 - ; return (ks, kt, ts, tt, r0) } - where - ts = varType tcv_s - tt = varType tcv_t - ks = typeKind ts - kt = typeKind tt + ; return (NthCo r0 n co') } ; _ -> case (splitTyConApp_maybe s, splitTyConApp_maybe t) of { (Just (tc_s, tys_s), Just (tc_t, tys_t)) @@ -1968,62 +2005,51 @@ lintCoercion the_co@(NthCo r0 n co) , tys_s `equalLength` tys_t , tys_s `lengthExceeds` n -> do { lintRole the_co tr r0 - ; return (ks, kt, ts, tt, r0) } - where - ts = getNth tys_s n - tt = getNth tys_t n - tr = nthRole r tc_s n - ks = typeKind ts - kt = typeKind tt + ; return (NthCo r0 n co') } + where + tr = nthRole r tc_s n ; _ -> failWithL (hang (text "Bad getNth:") 2 (ppr the_co $$ ppr s $$ ppr t)) }}} lintCoercion the_co@(LRCo lr co) - = do { (_,_,s,t,r) <- lintCoercion co + = do { co' <- lintCoercion co + ; let Pair s t = coercionKind co' + r = coercionRole co' ; lintRole co Nominal r ; case (splitAppTy_maybe s, splitAppTy_maybe t) of - (Just s_pr, Just t_pr) - -> return (ks_pick, kt_pick, s_pick, t_pick, Nominal) - where - s_pick = pickLR lr s_pr - t_pick = pickLR lr t_pr - ks_pick = typeKind s_pick - kt_pick = typeKind t_pick - + (Just _, Just _) -> return (LRCo lr co') _ -> failWithL (hang (text "Bad LRCo:") 2 (ppr the_co $$ ppr s $$ ppr t)) } lintCoercion (InstCo co arg) - = do { (k3, k4, t1',t2', r) <- lintCoercion co - ; (k1',k2',s1,s2, r') <- lintCoercion arg - ; lintRole arg Nominal r' - ; in_scope <- getInScope - ; case (splitForAllTy_ty_maybe t1', splitForAllTy_ty_maybe t2') of + = do { co' <- lintCoercion co + ; arg' <- lintCoercion arg + ; let Pair t1' t2' = coercionKind co' + Pair s1 s2 = coercionKind arg + + ; lintRole arg Nominal (coercionRole arg') + + ; case (splitForAllTy_ty_maybe t1', splitForAllTy_ty_maybe t2') of -- forall over tvar - { (Just (tv1,t1), Just (tv2,t2)) - | k1' `eqType` tyVarKind tv1 - , k2' `eqType` tyVarKind tv2 - -> return (k3, k4, - substTyWithInScope in_scope [tv1] [s1] t1, - substTyWithInScope in_scope [tv2] [s2] t2, r) + { (Just (tv1,_), Just (tv2,_)) + | typeKind s1 `eqType` tyVarKind tv1 + , typeKind s2 `eqType` tyVarKind tv2 + -> return (InstCo co' arg') | otherwise -> failWithL (text "Kind mis-match in inst coercion") + ; _ -> case (splitForAllTy_co_maybe t1', splitForAllTy_co_maybe t2') of -- forall over covar - { (Just (cv1, t1), Just (cv2, t2)) - | k1' `eqType` varType cv1 - , k2' `eqType` varType cv2 - , CoercionTy s1' <- s1 - , CoercionTy s2' <- s2 - -> do { return $ - (liftedTypeKind, liftedTypeKind - -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep - , substTy (mkCvSubst in_scope $ unitVarEnv cv1 s1') t1 - , substTy (mkCvSubst in_scope $ unitVarEnv cv2 s2') t2 - , r) } + { (Just (cv1, _), Just (cv2, _)) + | typeKind s1 `eqType` varType cv1 + , typeKind s2 `eqType` varType cv2 + , CoercionTy _ <- s1 + , CoercionTy _ <- s2 + -> return (InstCo co' arg') | otherwise -> failWithL (text "Kind mis-match in inst coercion") + ; _ -> failWithL (text "Bad argument of inst") }}} lintCoercion co@(AxiomInstCo con ind cos) @@ -2031,73 +2057,69 @@ lintCoercion co@(AxiomInstCo con ind cos) (bad_ax (text "index out of range")) ; let CoAxBranch { cab_tvs = ktvs , cab_cvs = cvs - , cab_roles = roles - , cab_lhs = lhs - , cab_rhs = rhs } = coAxiomNthBranch con ind + , cab_roles = roles } = coAxiomNthBranch con ind ; unless (cos `equalLength` (ktvs ++ cvs)) $ bad_ax (text "lengths") + ; cos' <- mapM lintCoercion cos ; subst <- getTCvSubst ; let empty_subst = zapTCvSubst subst - ; (subst_l, subst_r) <- foldlM check_ki - (empty_subst, empty_subst) - (zip3 (ktvs ++ cvs) roles cos) - ; let lhs' = substTys subst_l lhs - rhs' = substTy subst_r rhs - fam_tc = coAxiomTyCon con + ; _ <- foldlM check_ki (empty_subst, empty_subst) + (zip3 (ktvs ++ cvs) roles cos') + ; let fam_tc = coAxiomTyCon con ; case checkAxInstCo co of Just bad_branch -> bad_ax $ text "inconsistent with" <+> pprCoAxBranch fam_tc bad_branch Nothing -> return () - ; let s2 = mkTyConApp fam_tc lhs' - ; return (typeKind s2, typeKind rhs', s2, rhs', coAxiomRole con) } + ; return (AxiomInstCo con ind cos') } where bad_ax what = addErrL (hang (text "Bad axiom application" <+> parens what) 2 (ppr co)) - check_ki (subst_l, subst_r) (ktv, role, arg) - = do { (k', k'', s', t', r) <- lintCoercion arg - ; lintRole arg role r + check_ki (subst_l, subst_r) (ktv, role, arg') + = do { let Pair s' t' = coercionKind arg' + sk' = typeKind s' + tk' = typeKind t' + ; lintRole arg' role (coercionRole arg') ; let ktv_kind_l = substTy subst_l (tyVarKind ktv) ktv_kind_r = substTy subst_r (tyVarKind ktv) - ; unless (k' `eqType` ktv_kind_l) - (bad_ax (text "check_ki1" <+> vcat [ ppr co, ppr k', ppr ktv, ppr ktv_kind_l ] )) - ; unless (k'' `eqType` ktv_kind_r) - (bad_ax (text "check_ki2" <+> vcat [ ppr co, ppr k'', ppr ktv, ppr ktv_kind_r ] )) + ; unless (sk' `eqType` ktv_kind_l) + (bad_ax (text "check_ki1" <+> vcat [ ppr co, ppr sk', ppr ktv, ppr ktv_kind_l ] )) + ; unless (tk' `eqType` ktv_kind_r) + (bad_ax (text "check_ki2" <+> vcat [ ppr co, ppr tk', ppr ktv, ppr ktv_kind_r ] )) ; return (extendTCvSubst subst_l ktv s', extendTCvSubst subst_r ktv t') } lintCoercion (KindCo co) - = do { (k1, k2, _, _, _) <- lintCoercion co - ; return (liftedTypeKind, liftedTypeKind, k1, k2, Nominal) } + = do { co' <- lintCoercion co + ; return (KindCo co') } lintCoercion (SubCo co') - = do { (k1,k2,s,t,r) <- lintCoercion co' - ; lintRole co' Nominal r - ; return (k1,k2,s,t,Representational) } - -lintCoercion this@(AxiomRuleCo co cs) - = do { eqs <- mapM lintCoercion cs - ; lintRoles 0 (coaxrAsmpRoles co) eqs - ; case coaxrProves co [ Pair l r | (_,_,l,r,_) <- eqs ] of + = do { co' <- lintCoercion co' + ; lintRole co' Nominal (coercionRole co') + ; return (SubCo co') } + +lintCoercion this@(AxiomRuleCo ax cos) + = do { cos' <- mapM lintCoercion cos + ; lint_roles 0 (coaxrAsmpRoles ax) cos' + ; case coaxrProves ax (map coercionKind cos') of Nothing -> err "Malformed use of AxiomRuleCo" [ ppr this ] - Just (Pair l r) -> - return (typeKind l, typeKind r, l, r, coaxrRole co) } + Just _ -> return (AxiomRuleCo ax cos') } where err m xs = failWithL $ - hang (text m) 2 $ vcat (text "Rule:" <+> ppr (coaxrName co) : xs) + hang (text m) 2 $ vcat (text "Rule:" <+> ppr (coaxrName ax) : xs) - lintRoles n (e : es) ((_,_,_,_,r) : rs) - | e == r = lintRoles (n+1) es rs + lint_roles n (e : es) (co : cos) + | e == coercionRole co = lint_roles (n+1) es cos | otherwise = err "Argument roles mismatch" [ text "In argument:" <+> int (n+1) , text "Expected:" <+> ppr e - , text "Found:" <+> ppr r ] - lintRoles _ [] [] = return () - lintRoles n [] rs = err "Too many coercion arguments" + , text "Found:" <+> ppr (coercionRole co) ] + lint_roles _ [] [] = return () + lint_roles n [] rs = err "Too many coercion arguments" [ text "Expected:" <+> int n , text "Provided:" <+> int (n + length rs) ] - lintRoles n es [] = err "Not enough coercion arguments" + lint_roles n es [] = err "Not enough coercion arguments" [ text "Expected:" <+> int (n + length es) , text "Provided:" <+> int n ] @@ -2106,13 +2128,6 @@ lintCoercion (HoleCo h) ; lintCoercion (CoVarCo (coHoleCoVar h)) } ----------- -lintUnliftedCoVar :: CoVar -> LintM () -lintUnliftedCoVar cv - = when (not (isUnliftedType (coVarKind cv))) $ - failWithL (text "Bad lifted equality:" <+> ppr cv - <+> dcolon <+> ppr (coVarKind cv)) - {- ************************************************************************ * * @@ -2129,12 +2144,19 @@ data LintEnv , le_subst :: TCvSubst -- Current TyCo substitution -- See Note [Linting type lets] - -- /Only/ substitutes for type variables; - -- but might clone CoVars - -- We also use le_subst to keep track of - -- in-scope TyVars and CoVars + -- /Only/ substitutes for type variables; + -- but might clone CoVars + -- We also use le_subst to keep track of + -- in-scope TyVars and CoVars (but not Ids) + -- Range of the TCvSubst is LintedType/LintedCo + + , le_ids :: VarEnv (Id, LintedType) -- In-scope Ids + -- Used to check that occurrences have an enclosing binder. + -- The Id is /pre-substitution/, used to check that + -- the occurrence has an identical type to the binder + -- The LintedType is used to return the type of the occurrence, + -- without having to lint it again. - , le_ids :: IdSet -- In-scope Ids , le_joins :: IdSet -- Join points in scope that are valid -- A subset of the InScopeSet in le_subst -- See Note [Join points] @@ -2266,6 +2288,7 @@ instance HasDynFlags LintM where data LintLocInfo = RhsOf Id -- The variable bound + | OccOf Id -- Occurrence of id | LambdaBodyOf Id -- The lambda-binder | UnfoldingOf Id -- Unfolding of a binder | BodyOfLetRec [Id] -- One of the binders @@ -2278,7 +2301,6 @@ data LintLocInfo | ImportedUnfolding SrcLoc -- Some imported unfolding (ToDo: say which) | TopLevelBindings | InType Type -- Inside a type - | InKind Type Kind -- Inside a kind | InCo Coercion -- Inside a coercion initL :: DynFlags -> LintFlags -> [Var] @@ -2293,7 +2315,7 @@ initL dflags flags vars m (tcvs, ids) = partition isTyCoVar vars env = LE { le_flags = flags , le_subst = mkEmptyTCvSubst (mkInScopeSet (mkVarSet tcvs)) - , le_ids = mkVarSet ids + , le_ids = mkVarEnv [(id, (id,idType id)) | id <- ids] , le_joins = emptyVarSet , le_loc = [] , le_dynflags = dflags } @@ -2341,7 +2363,7 @@ addWarnL msg = LintM $ \ env (warns,errs) -> addMsg :: Bool -> LintEnv -> Bag MsgDoc -> MsgDoc -> Bag MsgDoc addMsg is_error env msgs msg - = ASSERT( notNull loc_msgs ) + = ASSERT2( notNull loc_msgs, msg ) msgs `snocBag` mk_msg msg where loc_msgs :: [(SrcLoc, SDoc)] -- Innermost first @@ -2373,18 +2395,17 @@ inCasePat = LintM $ \ env errs -> (Just (is_case_pat env), errs) is_case_pat (LE { le_loc = CasePat {} : _ }) = True is_case_pat _other = False -addInScopeTyCoVar :: Var -> LintM a -> LintM a -addInScopeTyCoVar var m - = LintM $ \ env errs -> - unLintM m (env { le_subst = extendTCvInScope (le_subst env) var }) errs - -addInScopeId :: Id -> LintM a -> LintM a -addInScopeId id m - = LintM $ \ env errs -> - unLintM m (env { le_ids = extendVarSet (le_ids env) id - , le_joins = delVarSet (le_joins env) id }) errs +addInScopeId :: Id -> LintedType -> LintM a -> LintM a +addInScopeId id linted_ty m + = LintM $ \ env@(LE { le_ids = id_set, le_joins = join_set }) errs -> + unLintM m (env { le_ids = extendVarEnv id_set id (id, linted_ty) + , le_joins = add_joins join_set }) errs + where + add_joins join_set + | isJoinId id = extendVarSet join_set id -- Overwrite with new arity + | otherwise = delVarSet join_set id -- Remove any existing binding -getInScopeIds :: LintM IdSet +getInScopeIds :: LintM (VarEnv (Id,LintedType)) getInScopeIds = LintM (\env errs -> (Just (le_ids env), errs)) extendTvSubstL :: TyVar -> Type -> LintM a -> LintM a @@ -2404,13 +2425,6 @@ markAllJoinsBadIf :: Bool -> LintM a -> LintM a markAllJoinsBadIf True m = markAllJoinsBad m markAllJoinsBadIf False m = m -addGoodJoins :: [Var] -> LintM a -> LintM a -addGoodJoins vars thing_inside - = LintM $ \ env errs -> unLintM thing_inside (add_joins env) errs - where - add_joins env = env { le_joins = le_joins env `extendVarSetList` join_ids } - join_ids = filter isJoinId vars - getValidJoins :: LintM IdSet getValidJoins = LintM (\ env errs -> (Just (le_joins env), errs)) @@ -2420,20 +2434,17 @@ getTCvSubst = LintM (\ env errs -> (Just (le_subst env), errs)) getInScope :: LintM InScopeSet getInScope = LintM (\ env errs -> (Just (getTCvInScope $ le_subst env), errs)) -applySubstTy :: InType -> LintM OutType -applySubstTy ty = do { subst <- getTCvSubst; return (substTy subst ty) } - -applySubstCo :: InCoercion -> LintM OutCoercion -applySubstCo co = do { subst <- getTCvSubst; return (substCo subst co) } - -lookupIdInScope :: Id -> LintM Id +lookupIdInScope :: Id -> LintM (Id, LintedType) lookupIdInScope id_occ = do { in_scope_ids <- getInScopeIds - ; case lookupVarSet in_scope_ids id_occ of - Just id_bnd -> do { checkL (not (bad_global id_bnd)) global_in_scope - ; return id_bnd } + ; case lookupVarEnv in_scope_ids id_occ of + Just (id_bndr, linted_ty) + -> do { checkL (not (bad_global id_bndr)) global_in_scope + ; return (id_bndr, linted_ty) } Nothing -> do { checkL (not is_local) local_out_of_scope - ; return id_occ } } + ; return (id_occ, idType id_occ) } } + -- We don't bother to lint the type + -- of global (i.e. imported) Ids where is_local = mustHaveLocalBinding id_occ local_out_of_scope = text "Out of scope:" <+> pprBndr LetBind id_occ @@ -2461,16 +2472,7 @@ lookupJoinId id Just id' -> return (isJoinId_maybe id') Nothing -> return Nothing } -lintTyCoVarInScope :: TyCoVar -> LintM TyCoVar -lintTyCoVarInScope var - = do { subst <- getTCvSubst - ; case lookupInScope (getTCvInScope subst) var of - Just var' -> return var' - Nothing -> failWithL $ - hang (text "The TyCo variable" <+> pprBndr LetBind var) - 2 (text "is out of scope") } - -ensureEqTys :: OutType -> OutType -> MsgDoc -> LintM () +ensureEqTys :: LintedType -> LintedType -> MsgDoc -> LintM () -- check ty2 is subtype of ty1 (ie, has same structure but usage -- annotations need only be consistent, not equal) -- Assumes ty1,ty2 are have already had the substitution applied @@ -2500,6 +2502,9 @@ dumpLoc :: LintLocInfo -> (SrcLoc, SDoc) dumpLoc (RhsOf v) = (getSrcLoc v, text "In the RHS of" <+> pp_binders [v]) +dumpLoc (OccOf v) + = (getSrcLoc v, text "In an occurrence of" <+> pp_binder v) + dumpLoc (LambdaBodyOf b) = (getSrcLoc b, text "In the body of lambda with binder" <+> pp_binder b) @@ -2534,8 +2539,6 @@ dumpLoc TopLevelBindings = (noSrcLoc, Outputable.empty) dumpLoc (InType ty) = (noSrcLoc, text "In the type" <+> quotes (ppr ty)) -dumpLoc (InKind ty ki) - = (noSrcLoc, text "In the kind of" <+> parens (ppr ty <+> dcolon <+> ppr ki)) dumpLoc (InCo co) = (noSrcLoc, text "In the coercion" <+> quotes (ppr co)) @@ -2780,7 +2783,7 @@ mkJoinBndrOccMismatchMsg bndr join_arity_bndr join_arity_occ , text "Arity at binding site:" <+> ppr join_arity_bndr , text "Arity at occurrence: " <+> ppr join_arity_occ ] -mkBndrOccTypeMismatchMsg :: Var -> Var -> OutType -> OutType -> SDoc +mkBndrOccTypeMismatchMsg :: Var -> Var -> LintedType -> LintedType -> SDoc mkBndrOccTypeMismatchMsg bndr var bndr_ty var_ty = vcat [ text "Mismatch in type between binder and occurrence" , text "Binder:" <+> ppr bndr <+> dcolon <+> ppr bndr_ty ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -2447,7 +2447,7 @@ normally it would make no sense to have forall r. (ty :: K r) because the kind of the forall would escape the binding of 'r'. But in this case it's fine because (K r) exapands -to Type, so we expliclity /permit/ the type +to Type, so we explicitly /permit/ the type forall r. T r To accommodate such a type, in typeKind (forall a.ty) we use @@ -2455,8 +2455,13 @@ occCheckExpand to expand any type synonyms in the kind of 'ty' to eliminate 'a'. See kinding rule (FORALL) in Note [Kinding rules for types] -And in TcValidity.checkEscapingKind, we use also use -occCheckExpand, for the same reason. +See also + * TcUnify.occCheckExpand + * GHC.Core.Utils.coreAltsType + * TcValidity.checkEscapingKind +all of which grapple with with the same problem. + +See #14939. -} ----------------------------- ===================================== testsuite/tests/indexed-types/should_compile/T17923.hs ===================================== @@ -0,0 +1,44 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# OPTIONS_GHC -Wall #-} +module Bug where + +import Data.Kind + +-- type SingFunction2 f = forall t1 t2. Sing t1 -> Sing t2 -> Sing (f `Apply` t1 `Apply` t2) +type SingFunction2 f = forall t1. Sing t1 -> forall t2. Sing t2 -> Sing (f `Apply` t1 `Apply` t2) +singFun2 :: forall f. SingFunction2 f -> Sing f +singFun2 f = SLambda (\x -> SLambda (f x)) + +type family Sing :: k -> Type +data TyFun :: Type -> Type -> Type +type a ~> b = TyFun a b -> Type +infixr 0 ~> + +type family Apply (f :: a ~> b) (x :: a) :: b +data Sym4 a +data Sym3 a + +type instance Apply Sym3 _ = Sym4 + +newtype SLambda (f :: k1 ~> k2) = + SLambda { applySing :: forall t. Sing t -> Sing (Apply f t) } +type instance Sing = SLambda + +und :: a +und = undefined + +data E +data ShowCharSym0 :: E ~> E ~> E + +sShow_tuple :: SLambda Sym4 +sShow_tuple + = applySing (singFun2 @Sym3 und) + (und (singFun2 @Sym3 + (und (applySing (singFun2 @Sym3 und) + (applySing (singFun2 @ShowCharSym0 und) und))))) ===================================== testsuite/tests/indexed-types/should_compile/all.T ===================================== @@ -294,3 +294,4 @@ test('T16828', normal, compile, ['']) test('T17008b', normal, compile, ['']) test('T17056', normal, compile, ['']) test('T17405', normal, multimod_compile, ['T17405c', '-v0']) +test('T17923', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bb556764b9e21c1c809cf3cc5930f2c951b438bc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bb556764b9e21c1c809cf3cc5930f2c951b438bc You're receiving 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 Mar 26 16:33:00 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Thu, 26 Mar 2020 12:33:00 -0400 Subject: [Git][ghc/ghc][wip/T13380] Preserve precise exceptions in strictness analysis Message-ID: <5e7cd93c7da80_61677b155d877657b@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T13380 at Glasgow Haskell Compiler / GHC Commits: c4597cd8 by Sebastian Graf at 2020-03-26T17:32:01+01: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. - - - - - 5 changed files: - compiler/GHC/Core/Op/Simplify/Utils.hs - compiler/basicTypes/Demand.hs - compiler/prelude/primops.txt.pp - + testsuite/tests/stranal/should_run/T17676.hs - testsuite/tests/stranal/should_run/all.T Changes: ===================================== compiler/GHC/Core/Op/Simplify/Utils.hs ===================================== @@ -55,6 +55,7 @@ import Name import Id import IdInfo import Var +import PrimOp import Demand import GHC.Core.Op.Simplify.Monad import GHC.Core.Type hiding( substTy ) @@ -500,7 +501,9 @@ mkArgInfo env fun rules n_val_args call_cont -- calls to error. But now we are more careful about -- inlining lone variables, so it's ok -- (see GHC.Core.Op.Simplify.Utils.analyseCont) - if isBotDiv result_info then + -- See Note [Precise exceptions and strictness analysis] in Demand.hs + -- for the special case on raiseIO# + if isBotDiv result_info || isPrimOpId_maybe fun == Just RaiseIOOp then map isStrictDmd demands -- Finite => result is bottom else map isStrictDmd demands ++ vanilla_stricts ===================================== compiler/basicTypes/Demand.hs ===================================== @@ -932,6 +932,51 @@ instance Outputable Divergence where ppr Diverges = char 'b' ppr Dunno = empty +{- Note [Precise vs imprecise exceptions] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +An exception is considered to be /precise/ when it is thrown by the 'raiseIO#' +primop. It follows that all other primops (such as 'raise#' or +division-by-zero) throw /imprecise/ exceptions. Note that the actual type of +the exception thrown doesn't have any impact! + +GHC undertakes some effort not to apply an optimisation that would mask a +/precise/ exception with some other source of nontermination, such as genuine +divergence or an imprecise exception, so that the user can reliably +intercept the precise exception with a catch handler before and after +optimisations. + +See section 5 of "Tackling the awkward squad" for semantic concerns. +Imprecise exceptions are actually more interesting than precise ones (which are +fairly standard) from the perspective of semantics. See the paper "A Semantics +for Imprecise Exceptions" for more details. + +Note [Precise exceptions and strictness analysis] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +raiseIO# raises a *precise* exception, in contrast to raise# which +raise an *imprecise* exception. See Note [Precise vs imprecise exceptions] +in XXXX. + +Unlike raise# (which returns botDiv), we want raiseIO# to return topDiv. +Here's why. Consider this example from #13380 (similarly #17676): + f x y | x>0 = raiseIO Exc + | y>0 = return 1 + | otherwise = return 2 +Is 'f' strict in 'y'? One might be tempted to say yes! But that plays fast and +loose with the precise exception; after optimisation, (f 42 (error "boom")) +turns from throwing the precise Exc to throwing the imprecise user error +"boom". So, the defaultDmd of raiseIO# should be lazy (topDmd), which can be +achieved by giving it divergence topDiv. + +But if it returns topDiv, the simplifier will fail to discard raiseIO#'s +continuation in + case raiseIO# x s of { (# s', r #) -> } +which we'd like to optimise to + raiseIO# x s +Temporary hack solution: special treatment for raiseIO# in +Simplifier.Utils.mkArgInfo. +-} + + ------------------------------------------------------------------------ -- Combined demand result -- ------------------------------------------------------------------------ ===================================== compiler/prelude/primops.txt.pp ===================================== @@ -2644,27 +2644,12 @@ primop RaiseOverflowOp "raiseOverflow#" GenPrimOp out_of_line = True has_side_effects = True --- raiseIO# needs to be a primop, because exceptions in the IO monad --- must be *precise* - we don't want the strictness analyser turning --- one kind of bottom into another, as it is allowed to do in pure code. --- --- But we *do* want to know that it returns bottom after --- being applied to two arguments, so that this function is strict in y --- f x y | x>0 = raiseIO blah --- | y>0 = return 1 --- | otherwise = return 2 --- --- TODO Check that the above notes on @f@ are valid. The function successfully --- produces an IO exception when compiled without optimization. If we analyze --- it as strict in @y@, won't we change that behavior under optimization? --- I thought the rule was that it was okay to replace one valid imprecise --- exception with another, but not to replace a precise exception with --- an imprecise one (dfeuer, 2017-03-05). - primop RaiseIOOp "raiseIO#" GenPrimOp a -> State# RealWorld -> (# State# RealWorld, b #) with - strictness = { \ _arity -> mkClosedStrictSig [topDmd, topDmd] botDiv } + -- See Note [Precise exceptions and strictness analysis] in Demand.hs + -- for why we give it topDiv + -- strictness = { \ _arity -> mkClosedStrictSig [topDmd, topDmd] topDiv } out_of_line = True has_side_effects = True ===================================== testsuite/tests/stranal/should_run/T17676.hs ===================================== @@ -0,0 +1,18 @@ +{-# LANGUAGE ScopedTypeVariables #-} +import Data.IORef +import Control.Exception +import Control.Monad + +data Exc = Exc deriving Show + +instance Exception Exc + +-- Recursive instead of NOINLINE because of #17673 +f :: Int -> Int -> IO () +f 0 x = do + let true = sum [0..4] == 10 + when true $ throwIO Exc + x `seq` return () +f n x = f (n-1) (x+1) + +main = f 1 (error "expensive computation") `catch` \(_ :: Exc) -> return () ===================================== testsuite/tests/stranal/should_run/all.T ===================================== @@ -19,7 +19,8 @@ test('T11076', normal, multimod_compile_and_run, ['T11076.hs', 'T11076_prim.cmm' test('T11555a', normal, compile_and_run, ['']) test('T12368', exit_code(1), compile_and_run, ['']) test('T12368a', exit_code(1), compile_and_run, ['']) -test('T13380', [expect_broken(13380), exit_code(1)], compile_and_run, ['']) +test('T13380', exit_code(1), compile_and_run, ['']) 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, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c4597cd8ab7a37e488197ed5078d36a23a4f9a96 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c4597cd8ab7a37e488197ed5078d36a23a4f9a96 You're receiving 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 Mar 26 16:37:13 2020 From: gitlab at gitlab.haskell.org (John Ericson) Date: Thu, 26 Mar 2020 12:37:13 -0400 Subject: [Git][ghc/ghc][wip/D5082] 102 commits: nonmoving: Fix collection of sparks Message-ID: <5e7cda39dd40f_616713339fc47786c1@gitlab.haskell.org.mail> John Ericson pushed to branch wip/D5082 at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/linters/check-cpp.py - compiler/GHC.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/InfoTable.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/Dataflow/Block.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Graph.hs - compiler/GHC/Cmm/Info.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/Ppr.hs - compiler/GHC/Cmm/Ppr/Decl.hs - compiler/GHC/Cmm/Ppr/Expr.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Switch/Implement.hs - compiler/GHC/Cmm/Type.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/BlockLayout.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c9ac25e385f3686a8c017e7f876097762f22ee90...1c446220250dcada51d4bb33a0cc7d8ce572e8b6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c9ac25e385f3686a8c017e7f876097762f22ee90...1c446220250dcada51d4bb33a0cc7d8ce572e8b6 You're receiving 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 Mar 26 18:01:30 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Thu, 26 Mar 2020 14:01:30 -0400 Subject: [Git][ghc/ghc][wip/T13380] Preserve precise exceptions in strictness analysis Message-ID: <5e7cedfa5a109_61674f59d90807664@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T13380 at Glasgow Haskell Compiler / GHC Commits: ac492646 by Sebastian Graf at 2020-03-26T19:01:17+01: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. - - - - - 5 changed files: - compiler/GHC/Core/Op/Simplify/Utils.hs - compiler/basicTypes/Demand.hs - compiler/prelude/primops.txt.pp - + testsuite/tests/stranal/should_run/T17676.hs - testsuite/tests/stranal/should_run/all.T Changes: ===================================== compiler/GHC/Core/Op/Simplify/Utils.hs ===================================== @@ -55,6 +55,7 @@ import Name import Id import IdInfo import Var +import PrimOp import Demand import GHC.Core.Op.Simplify.Monad import GHC.Core.Type hiding( substTy ) @@ -500,7 +501,9 @@ mkArgInfo env fun rules n_val_args call_cont -- calls to error. But now we are more careful about -- inlining lone variables, so it's ok -- (see GHC.Core.Op.Simplify.Utils.analyseCont) - if isBotDiv result_info then + -- See Note [Precise exceptions and strictness analysis] in Demand.hs + -- for the special case on raiseIO# + if isBotDiv result_info || isPrimOpId_maybe fun == Just RaiseIOOp then map isStrictDmd demands -- Finite => result is bottom else map isStrictDmd demands ++ vanilla_stricts ===================================== compiler/basicTypes/Demand.hs ===================================== @@ -932,6 +932,53 @@ instance Outputable Divergence where ppr Diverges = char 'b' ppr Dunno = empty +{- Note [Precise vs imprecise exceptions] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +An exception is considered to be /precise/ when it is thrown by the 'raiseIO#' +primop. It follows that all other primops (such as 'raise#' or +division-by-zero) throw /imprecise/ exceptions. Note that the actual type of +the exception thrown doesn't have any impact! + +GHC undertakes some effort not to apply an optimisation that would mask a +/precise/ exception with some other source of nontermination, such as genuine +divergence or an imprecise exception, so that the user can reliably +intercept the precise exception with a catch handler before and after +optimisations. + +See also the wiki page on precise exceptions: +https://gitlab.haskell.org/ghc/ghc/-/wikis/exceptions/precise-exceptions +Section 5 of "Tackling the awkward squad" talks about semantic concerns. +Imprecise exceptions are actually more interesting than precise ones (which are +fairly standard) from the perspective of semantics. See the paper "A Semantics +for Imprecise Exceptions" for more details. + +Note [Precise exceptions and strictness analysis] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +raiseIO# raises a *precise* exception, in contrast to raise# which +raise an *imprecise* exception. See Note [Precise vs imprecise exceptions] +in XXXX. + +Unlike raise# (which returns botDiv), we want raiseIO# to return topDiv. +Here's why. Consider this example from #13380 (similarly #17676): + f x y | x>0 = raiseIO Exc + | y>0 = return 1 + | otherwise = return 2 +Is 'f' strict in 'y'? One might be tempted to say yes! But that plays fast and +loose with the precise exception; after optimisation, (f 42 (error "boom")) +turns from throwing the precise Exc to throwing the imprecise user error +"boom". So, the defaultDmd of raiseIO# should be lazy (topDmd), which can be +achieved by giving it divergence topDiv. + +But if it returns topDiv, the simplifier will fail to discard raiseIO#'s +continuation in + case raiseIO# x s of { (# s', r #) -> } +which we'd like to optimise to + raiseIO# x s +Temporary hack solution: special treatment for raiseIO# in +Simplifier.Utils.mkArgInfo. +-} + + ------------------------------------------------------------------------ -- Combined demand result -- ------------------------------------------------------------------------ ===================================== compiler/prelude/primops.txt.pp ===================================== @@ -2644,27 +2644,12 @@ primop RaiseOverflowOp "raiseOverflow#" GenPrimOp out_of_line = True has_side_effects = True --- raiseIO# needs to be a primop, because exceptions in the IO monad --- must be *precise* - we don't want the strictness analyser turning --- one kind of bottom into another, as it is allowed to do in pure code. --- --- But we *do* want to know that it returns bottom after --- being applied to two arguments, so that this function is strict in y --- f x y | x>0 = raiseIO blah --- | y>0 = return 1 --- | otherwise = return 2 --- --- TODO Check that the above notes on @f@ are valid. The function successfully --- produces an IO exception when compiled without optimization. If we analyze --- it as strict in @y@, won't we change that behavior under optimization? --- I thought the rule was that it was okay to replace one valid imprecise --- exception with another, but not to replace a precise exception with --- an imprecise one (dfeuer, 2017-03-05). - primop RaiseIOOp "raiseIO#" GenPrimOp a -> State# RealWorld -> (# State# RealWorld, b #) with - strictness = { \ _arity -> mkClosedStrictSig [topDmd, topDmd] botDiv } + -- See Note [Precise exceptions and strictness analysis] in Demand.hs + -- for why we give it topDiv + -- strictness = { \ _arity -> mkClosedStrictSig [topDmd, topDmd] topDiv } out_of_line = True has_side_effects = True ===================================== testsuite/tests/stranal/should_run/T17676.hs ===================================== @@ -0,0 +1,18 @@ +{-# LANGUAGE ScopedTypeVariables #-} +import Data.IORef +import Control.Exception +import Control.Monad + +data Exc = Exc deriving Show + +instance Exception Exc + +-- Recursive instead of NOINLINE because of #17673 +f :: Int -> Int -> IO () +f 0 x = do + let true = sum [0..4] == 10 + when true $ throwIO Exc + x `seq` return () +f n x = f (n-1) (x+1) + +main = f 1 (error "expensive computation") `catch` \(_ :: Exc) -> return () ===================================== testsuite/tests/stranal/should_run/all.T ===================================== @@ -19,7 +19,8 @@ test('T11076', normal, multimod_compile_and_run, ['T11076.hs', 'T11076_prim.cmm' test('T11555a', normal, compile_and_run, ['']) test('T12368', exit_code(1), compile_and_run, ['']) test('T12368a', exit_code(1), compile_and_run, ['']) -test('T13380', [expect_broken(13380), exit_code(1)], compile_and_run, ['']) +test('T13380', exit_code(1), compile_and_run, ['']) 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, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ac492646fe3453a78c3f7e5f5e97d9736f973cda -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ac492646fe3453a78c3f7e5f5e97d9736f973cda You're receiving 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 Mar 26 18:19:33 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Thu, 26 Mar 2020 14:19:33 -0400 Subject: [Git][ghc/ghc][wip/T17932] Demand analysis: simplify the demand for a RHS Message-ID: <5e7cf23598077_61675cefcac819838@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T17932 at Glasgow Haskell Compiler / GHC Commits: 8dd78b90 by Simon Peyton Jones at 2020-03-26T19:19:19+01: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. - - - - - 13 changed files: - compiler/GHC/Core/Op/CprAnal.hs - compiler/GHC/Core/Op/DmdAnal.hs - compiler/GHC/Core/Op/WorkWrap/Lib.hs - testsuite/tests/perf/should_run/all.T - testsuite/tests/simplCore/should_compile/T4201.stdout - testsuite/tests/stranal/T10482a.hs - testsuite/tests/stranal/should_compile/T10482.stderr - testsuite/tests/stranal/should_compile/T10482a.stderr - testsuite/tests/stranal/sigs/DmdAnalGADTs.stderr - + testsuite/tests/stranal/sigs/T17932.hs - + testsuite/tests/stranal/sigs/T17932.stderr - testsuite/tests/stranal/sigs/UnsatFun.stderr - testsuite/tests/stranal/sigs/all.T Changes: ===================================== compiler/GHC/Core/Op/CprAnal.hs ===================================== @@ -13,7 +13,6 @@ module GHC.Core.Op.CprAnal ( cprAnalProgram ) where import GhcPrelude -import GHC.Core.Op.WorkWrap.Lib ( deepSplitProductType_maybe ) import GHC.Driver.Session import Demand import Cpr @@ -30,6 +29,7 @@ import GHC.Core.Utils ( exprIsHNF, dumpIdInfoOfProgram ) import GHC.Core.TyCon import GHC.Core.Type import GHC.Core.FamInstEnv +import GHC.Core.Op.WorkWrap.Lib import Util import ErrUtils ( dumpIfSet_dyn, DumpFormat (..) ) import Maybes ( isJust, isNothing ) @@ -88,7 +88,8 @@ Ideally, we would want the following pipeline: 4. worker/wrapper (for CPR) Currently, we omit 2. and anticipate the results of worker/wrapper. -See Note [CPR in a DataAlt case alternative] and Note [CPR for strict binders]. +See Note [CPR in a DataAlt case alternative] +and Note [CPR for binders that will be unboxed]. An additional w/w pass would simplify things, but probably add slight overhead. So currently we have @@ -175,7 +176,7 @@ cprAnal' env (Lam var body) | otherwise = (lam_ty, Lam var body') where - env' = extendSigsWithLam env var + env' = extendAnalEnvForDemand env var (idDemandInfo var) (body_ty, body') = cprAnal env' body lam_ty = abstractCprTy body_ty @@ -392,15 +393,25 @@ lookupSigEnv env id = lookupVarEnv (ae_sigs env) id nonVirgin :: AnalEnv -> AnalEnv nonVirgin env = env { ae_virgin = False } -extendSigsWithLam :: AnalEnv -> Id -> AnalEnv --- Extend the AnalEnv when we meet a lambda binder -extendSigsWithLam env id +-- | A version of 'extendAnalEnv' for a binder of which we don't see the RHS +-- needed to compute a 'CprSig' (e.g. lambdas and DataAlt field binders). +-- In this case, we can still look at their demand to attach CPR signatures +-- anticipating the unboxing done by worker/wrapper. +-- See Note [CPR for binders that will be unboxed]. +extendAnalEnvForDemand :: AnalEnv -> Id -> Demand -> AnalEnv +extendAnalEnvForDemand env id dmd | isId id - , isStrictDmd (idDemandInfo id) -- See Note [CPR for strict binders] - , Just (dc,_,_,_) <- deepSplitProductType_maybe (ae_fam_envs env) $ idType id + , Just (_, DataConAppContext { dcac_dc = dc }) + <- wantToUnbox (ae_fam_envs env) has_inlineable_prag (idType id) dmd = extendAnalEnv env id (CprSig (conCprType (dataConTag dc))) | otherwise = env + where + -- Rather than maintaining in AnalEnv whether we are in an INLINEABLE + -- function, we just assume that we aren't. That flag is only relevant + -- to Note [Do not unpack class dictionaries], the few unboxing + -- opportunities on dicts it prohibits are probably irrelevant to CPR. + has_inlineable_prag = False extendEnvForDataAlt :: AnalEnv -> CoreExpr -> Id -> DataCon -> [Var] -> AnalEnv -- See Note [CPR in a DataAlt case alternative] @@ -425,18 +436,16 @@ extendEnvForDataAlt env scrut case_bndr dc bndrs -- propagate available unboxed things from the scrutinee, getting rid of -- the is_var_scrut heuristic. See Note [CPR in a DataAlt case alternative]. -- Giving strict binders the CPR property only makes sense for products, as - -- the arguments in Note [CPR for strict binders] don't apply to sums (yet); - -- we lack WW for strict binders of sum type. + -- the arguments in Note [CPR for binders that will be unboxed] don't apply + -- to sums (yet); we lack WW for strict binders of sum type. do_con_arg env (id, str) - | let is_strict = isStrictDmd (idDemandInfo id) || isMarkedStrict str - , is_var_scrut && is_strict - , let fam_envs = ae_fam_envs env - , Just (dc,_,_,_) <- deepSplitProductType_maybe fam_envs $ idType id - = extendAnalEnv env id (CprSig (conCprType (dataConTag dc))) + | is_var scrut + -- See Note [Add demands for strict constructors] in WorkWrap.Lib + , let dmd = applyWhen (isMarkedStrict str) strictifyDmd (idDemandInfo id) + = extendAnalEnvForDemand env id dmd | otherwise = env - is_var_scrut = is_var scrut is_var (Cast e _) = is_var e is_var (Var v) = isLocalId v is_var _ = False @@ -472,7 +481,8 @@ Specifically box. If the wrapper doesn't cancel with its caller, we'll end up re-boxing something that we did have available in boxed form. - * Any strict binders with product type, can use Note [CPR for strict binders] + * Any strict binders with product type, can use + Note [CPR for binders that will be unboxed] to anticipate worker/wrappering for strictness info. But we can go a little further. Consider @@ -499,11 +509,11 @@ Specifically sub-component thereof. But it's simple, and nothing terrible happens if we get it wrong. e.g. Trac #10694. -Note [CPR for strict binders] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -If a lambda-bound variable is marked demanded with a strict demand, then give it -a CPR signature, anticipating the results of worker/wrapper. Here's a concrete -example ('f1' in test T10482a), assuming h is strict: +Note [CPR for binders that will be unboxed] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +If a lambda-bound variable will be unboxed by worker/wrapper (so it must be +demanded strictly), then give it a CPR signature. Here's a concrete example +('f1' in test T10482a), assuming h is strict: f1 :: Int -> Int f1 x = case h x of @@ -527,6 +537,9 @@ Note that has product type, else we may get over-optimistic CPR results (e.g. from \x -> x!). + * This also (approximately) applies to DataAlt field binders; + See Note [CPR in a DataAlt case alternative]. + * See Note [CPR examples] Note [CPR for sum types] @@ -628,21 +641,6 @@ point: all of these functions can have the CPR property. True -> x False -> f1 (x-1) - - ------- f2 ----------- - -- x is a strict field of MkT2, so we'll pass it unboxed - -- to $wf2, so it's available unboxed. This depends on - -- the case expression analysing (a subcomponent of) one - -- of the original arguments to the function, so it's - -- a bit more delicate. - - data T2 = MkT2 !Int Int - - f2 :: T2 -> Int - f2 (MkT2 x y) | y>0 = f2 (MkT2 x (y-1)) - | otherwise = x - - ------- f3 ----------- -- h is strict in x, so x will be unboxed before it -- is rerturned in the otherwise case. @@ -652,18 +650,4 @@ point: all of these functions can have the CPR property. f1 :: T3 -> Int f1 (MkT3 x y) | h x y = f3 (MkT3 x (y-1)) | otherwise = x - - - ------- f4 ----------- - -- Just like f2, but MkT4 can't unbox its strict - -- argument automatically, as f2 can - - data family Foo a - newtype instance Foo Int = Foo Int - - data T4 a = MkT4 !(Foo a) Int - - f4 :: T4 Int -> Int - f4 (MkT4 x@(Foo v) y) | y>0 = f4 (MkT4 x (y-1)) - | otherwise = v -} ===================================== compiler/GHC/Core/Op/DmdAnal.hs ===================================== @@ -617,16 +617,11 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs is_thunk = not (exprIsHNF rhs) && not (isJoinId id) -- | @mkRhsDmd env rhs_arity rhs@ creates a 'CleanDemand' for --- unleashing on the given function's @rhs@, by creating a call demand of --- @rhs_arity@ with a body demand appropriate for possible product types. --- See Note [Product demands for function body]. --- For example, a call of the form @mkRhsDmd _ 2 (\x y -> (x, y))@ returns a --- clean usage demand of @C1(C1(U(U,U)))@. +-- 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 -> CleanDemand -mkRhsDmd env rhs_arity rhs = - case peelTsFuns rhs_arity (findTypeShape (ae_fam_envs env) (exprType rhs)) of - Just (TsProd tss) -> mkCallDmds rhs_arity (cleanEvalProdDmd (length tss)) - _ -> mkCallDmds rhs_arity cleanEvalDmd +mkRhsDmd _env rhs_arity _rhs = mkCallDmds rhs_arity cleanEvalDmd -- | If given the let-bound 'Id', 'useLetUp' determines whether we should -- process the binding up (body before rhs) or down (rhs before body). @@ -857,9 +852,9 @@ forward plusInt's demand signature, and all is well (see Note [Newtype arity] in GHC.Core.Arity)! A small example is the test case NewtypeArity. -Note [Product demands for function body] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -This example comes from shootout/binary_trees: +Historical Note [Product demands for function body] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In 2013 I spotted this example, in shootout/binary_trees: Main.check' = \ b z ds. case z of z' { I# ip -> case ds_d13s of @@ -878,8 +873,12 @@ Here we *really* want to unbox z, even though it appears to be used boxed in the Nil case. Partly the Nil case is not a hot path. But more specifically, the whole function gets the CPR property if we do. -So for the demand on the body of a RHS we use a product demand if it's -a product type. +That motivated using a demand of C(C(C(S(L,L)))) for the RHS, where +(solely because the result was a product) we used a product demand +(albeit with lazy components) for the body. But that gives very silly +behaviour -- see #17932. Happily it turns out now to be entirely +unnecessary: we get good results with C(C(C(S))). So I simply +deleted the special case. ************************************************************************ * * ===================================== compiler/GHC/Core/Op/WorkWrap/Lib.hs ===================================== @@ -8,7 +8,8 @@ A library for the ``worker\/wrapper'' back-end to the strictness analyser module GHC.Core.Op.WorkWrap.Lib ( mkWwBodies, mkWWstr, mkWorkerArgs - , deepSplitProductType_maybe, findTypeShape + , DataConAppContext(..), deepSplitProductType_maybe, wantToUnbox + , findTypeShape , isWorkerSmallEnough ) where @@ -588,21 +589,8 @@ mkWWstr_one dflags fam_envs has_inlineable_prag arg -- (that's what mk_absent_let does) = return (True, [], nop_fn, work_fn) - | isStrictDmd dmd - , Just cs <- splitProdDmd_maybe dmd - -- See Note [Unpacking arguments with product and polymorphic demands] - , not (has_inlineable_prag && isClassPred arg_ty) - -- See Note [Do not unpack class dictionaries] - , Just stuff@(_, _, inst_con_arg_tys, _) <- deepSplitProductType_maybe fam_envs arg_ty - , cs `equalLength` inst_con_arg_tys - -- See Note [mkWWstr and unsafeCoerce] - = unbox_one dflags fam_envs arg cs stuff - - | isSeqDmd dmd -- For seqDmd, splitProdDmd_maybe will return Nothing, but - -- it should behave like , for some suitable arity - , Just stuff@(_, _, inst_con_arg_tys, _) <- deepSplitProductType_maybe fam_envs arg_ty - , let abs_dmds = map (const absDmd) inst_con_arg_tys - = unbox_one dflags fam_envs arg abs_dmds stuff + | Just (cs, acdc) <- wantToUnbox fam_envs has_inlineable_prag arg_ty dmd + = unbox_one dflags fam_envs arg cs acdc | otherwise -- Other cases = return (False, [arg], nop_fn, nop_fn) @@ -611,12 +599,36 @@ 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 fam_envs has_inlineable_prag ty dmd = + case deepSplitProductType_maybe fam_envs ty of + Just dcac at DataConAppContext{ dcac_arg_tys = con_arg_tys } + | isStrictDmd dmd + -- See Note [Unpacking arguments with product and polymorphic demands] + , Just cs <- split_prod_dmd_arity dmd (length con_arg_tys) + -- 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) + _ -> Nothing + where + split_prod_dmd_arity dmd arty + -- For seqDmd, splitProdDmd_maybe will return Nothing (because how would + -- it know the arity?), but it should behave like , for some + -- suitable arity + | isSeqDmd dmd = Just (replicate arty absDmd) + -- Otherwise splitProdDmd_maybe does the job + | otherwise = splitProdDmd_maybe dmd + unbox_one :: DynFlags -> FamInstEnvs -> Var -> [Demand] - -> (DataCon, [Type], [(Type, StrictnessMark)], Coercion) + -> DataConAppContext -> UniqSM (Bool, [Var], CoreExpr -> CoreExpr, CoreExpr -> CoreExpr) unbox_one dflags fam_envs arg cs - (data_con, inst_tys, inst_con_arg_tys, co) + DataConAppContext { dcac_dc = data_con, dcac_tys = inst_tys + , dcac_arg_tys = inst_con_arg_tys + , dcac_co = co } = do { (uniq1:uniqs) <- getUniquesM ; let -- See Note [Add demands for strict constructors] cs' = addDataConStrictness data_con cs @@ -898,8 +910,8 @@ If we have f :: Ord a => [a] -> Int -> a {-# INLINABLE f #-} and we worker/wrapper f, we'll get a worker with an INLINABLE pragma -(see Note [Worker-wrapper for INLINABLE functions] in GHC.Core.Op.WorkWrap), which -can still be specialised by the type-class specialiser, something like +(see Note [Worker-wrapper for INLINABLE functions] in GHC.Core.Op.WorkWrap), +which can still be specialised by the type-class specialiser, something like fw :: Ord a => [a] -> Int# -> a BUT if f is strict in the Ord dictionary, we might unpack it, to get @@ -915,9 +927,29 @@ Historical note: #14955 describes how I got this fix wrong the first time. -} -deepSplitProductType_maybe - :: FamInstEnvs -> Type - -> Maybe (DataCon, [Type], [(Type, StrictnessMark)], Coercion) +-- | 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) +-- +-- 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 :: ![(Type, StrictnessMark)] + , dcac_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 @@ -930,12 +962,14 @@ deepSplitProductType_maybe fam_envs ty , Just con <- isDataProductTyCon_maybe tc , let arg_tys = dataConInstArgTys con tc_args strict_marks = dataConRepStrictness con - = Just (con, tc_args, zipEqual "dspt" arg_tys strict_marks, co) + = 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 (DataCon, [Type], [(Type, StrictnessMark)], Coercion) + :: 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 @@ -952,7 +986,10 @@ deepSplitCprType_maybe fam_envs con_tag ty , let con = cons `getNth` (con_tag - fIRST_TAG) arg_tys = dataConInstArgTys con tc_args strict_marks = dataConRepStrictness con - = Just (con, tc_args, zipEqual "dsct" arg_tys strict_marks, co) + = Just DataConAppContext { dcac_dc = con + , dcac_tys = tc_args + , dcac_arg_tys = zipEqual "dspt" arg_tys strict_marks + , dcac_co = co } deepSplitCprType_maybe _ _ _ = Nothing findTypeShape :: FamInstEnvs -> Type -> TypeShape @@ -1009,17 +1046,18 @@ 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 stuff <- deepSplitCprType_maybe fam_envs con_tag body_ty - -> mkWWcpr_help stuff + Just con_tag | Just dcac <- deepSplitCprType_maybe fam_envs con_tag body_ty + -> mkWWcpr_help dcac | 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 :: (DataCon, [Type], [(Type,StrictnessMark)], Coercion) +mkWWcpr_help :: DataConAppContext -> UniqSM (Bool, CoreExpr -> CoreExpr, CoreExpr -> CoreExpr, Type) -mkWWcpr_help (data_con, inst_tys, arg_tys, co) +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 arg_ty1 -- Special case when there is a single result of unlifted type ===================================== testsuite/tests/perf/should_run/all.T ===================================== @@ -233,7 +233,8 @@ test('T5949', ['-O']) test('T4267', - [collect_stats('bytes allocated',10), + [expect_broken(4267), + collect_stats('bytes allocated',10), only_ways(['normal'])], compile_and_run, ['-O']) ===================================== testsuite/tests/simplCore/should_compile/T4201.stdout ===================================== @@ -1,3 +1,3 @@ - [HasNoCafRefs, Arity: 1, Strictness: , CPR: m1, + [HasNoCafRefs, Arity: 1, Strictness: , Unfolding: InlineRule (0, True, True) bof `cast` (Sym (N:Foo[0]) ->_R _R)] ===================================== testsuite/tests/stranal/T10482a.hs ===================================== @@ -22,6 +22,9 @@ f1 x = case h x x of ------- f2 ----------- +-- We used to unbox x here and rebox it in the wrapper. After #17932, we don't. +-- After #17932, we don't. +-- Historical comment: -- x is a strict field of MkT2, so we'll pass it unboxed -- to $wf2, so it's available unboxed. This depends on -- the case expression analysing (a subcomponent of) one @@ -48,6 +51,8 @@ f1 (MkT3 x y) | h x y = f3 (MkT3 x (y-1)) ------- f4 ----------- +-- We used to unbox x here and rebox it in the wrapper. After #17932, we don't. +-- Historical comment: -- Just like f2, but MkT4 can't unbox its strict -- argument automatically, as f2 can ===================================== testsuite/tests/stranal/should_compile/T10482.stderr ===================================== @@ -1,261 +1,243 @@ ==================== Tidy Core ==================== -Result size of Tidy Core = {terms: 171, types: 116, coercions: 15, joins: 0/0} +Result size of Tidy Core = {terms: 167, types: 116, coercions: 15, joins: 0/0} -- RHS size: {terms: 13, types: 14, coercions: 4, joins: 0/0} -T10482.$WFooPair [InlPrag=INLINE[2]] :: forall a b. Foo a -> Foo b -> Foo (a, b) +T10482.$WFooPair [InlPrag=INLINE[0]] :: forall a b. Foo a -> Foo b -> Foo (a, b) [GblId[DataConWrapper], Arity=2, Caf=NoCafRefs, - Str=m, + Str=, + Cpr=m1, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) - Tmpl= \ (@ a_aX9) (@ b_aXa) (dt_a2pg [Occ=Once] :: Foo a_aX9[sk:2]) (dt_a2ph [Occ=Once] :: Foo b_aXa[sk:2]) -> - (case dt_a2pg of dt_X2pl { __DEFAULT -> case dt_a2ph of dt_X2pn { __DEFAULT -> T10482.FooPair @ a_aX9 @ b_aXa dt_X2pl dt_X2pn } }) - `cast` (Sym (T10482.D:R:Foo(,)0[0] _N _N) :: (T10482.R:Foo(,) a_aX9 b_aXa :: *) ~R# (Foo (a_aX9, b_aXa) :: *))}] + Tmpl= \ (@a_atL) (@b_atM) (dt_a1r7 [Occ=Once] :: Foo a_atL) (dt_a1r8 [Occ=Once] :: Foo b_atM) -> + (case dt_a1r7 of dt_X0 [Occ=Once] { __DEFAULT -> + case dt_a1r8 of dt_X1 [Occ=Once] { __DEFAULT -> T10482.FooPair @a_atL @b_atM dt_X0 dt_X1 } + }) + `cast` (Sym (T10482.D:R:Foo(,)0[0] _N _N) :: T10482.R:Foo(,) a_atL b_atM ~R# Foo (a_atL, b_atM))}] T10482.$WFooPair - = \ (@ a_aX9) (@ b_aXa) (dt_a2pg [Occ=Once] :: Foo a_aX9[sk:2]) (dt_a2ph [Occ=Once] :: Foo b_aXa[sk:2]) -> - (case dt_a2pg of dt_X2pl { __DEFAULT -> case dt_a2ph of dt_X2pn { __DEFAULT -> T10482.FooPair @ a_aX9 @ b_aXa dt_X2pl dt_X2pn } }) - `cast` (Sym (T10482.D:R:Foo(,)0[0] _N _N) :: (T10482.R:Foo(,) a_aX9 b_aXa :: *) ~R# (Foo (a_aX9, b_aXa) :: *)) + = \ (@a_atL) (@b_atM) (dt_a1r7 [Occ=Once] :: Foo a_atL) (dt_a1r8 [Occ=Once] :: Foo b_atM) -> + (case dt_a1r7 of dt_X0 [Occ=Once] { __DEFAULT -> + case dt_a1r8 of dt_X1 [Occ=Once] { __DEFAULT -> T10482.FooPair @a_atL @b_atM dt_X0 dt_X1 } + }) + `cast` (Sym (T10482.D:R:Foo(,)0[0] _N _N) :: T10482.R:Foo(,) a_atL b_atM ~R# Foo (a_atL, b_atM)) -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T10482.$trModule4 :: GHC.Prim.Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] T10482.$trModule4 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T10482.$trModule3 :: GHC.Types.TrName [GblId, - Caf=NoCafRefs, - Str=m1, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] T10482.$trModule3 = GHC.Types.TrNameS T10482.$trModule4 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T10482.$trModule2 :: GHC.Prim.Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] T10482.$trModule2 = "T10482"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T10482.$trModule1 :: GHC.Types.TrName [GblId, - Caf=NoCafRefs, - Str=m1, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] T10482.$trModule1 = GHC.Types.TrNameS T10482.$trModule2 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} T10482.$trModule :: GHC.Types.Module [GblId, - Caf=NoCafRefs, - Str=m, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] T10482.$trModule = GHC.Types.Module T10482.$trModule3 T10482.$trModule1 -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} -$krep_r2Q4 :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] -$krep_r2Q4 = GHC.Types.KindRepTyConApp GHC.Types.$tcInt (GHC.Types.[] @ GHC.Types.KindRep) +$krep_r1Gw :: GHC.Types.KindRep +[GblId, Cpr=m1, Unf=OtherCon []] +$krep_r1Gw = GHC.Types.KindRepTyConApp GHC.Types.$tcInt (GHC.Types.[] @GHC.Types.KindRep) -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -$krep1_r2Q5 :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] -$krep1_r2Q5 = GHC.Types.KindRepVar 1# +$krep1_r1Gx :: GHC.Types.KindRep +[GblId, Cpr=m2, Unf=OtherCon []] +$krep1_r1Gx = GHC.Types.KindRepVar 1# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -$krep2_r2Q6 :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] -$krep2_r2Q6 = GHC.Types.KindRepVar 0# +$krep2_r1Gy :: GHC.Types.KindRep +[GblId, Cpr=m2, Unf=OtherCon []] +$krep2_r1Gy = GHC.Types.KindRepVar 0# -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -$krep3_r2Q7 :: [GHC.Types.KindRep] -[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] -$krep3_r2Q7 = GHC.Types.: @ GHC.Types.KindRep $krep1_r2Q5 (GHC.Types.[] @ GHC.Types.KindRep) +$krep3_r1Gz :: [GHC.Types.KindRep] +[GblId, Cpr=m2, Unf=OtherCon []] +$krep3_r1Gz = GHC.Types.: @GHC.Types.KindRep $krep1_r1Gx (GHC.Types.[] @GHC.Types.KindRep) -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} -$krep4_r2Q8 :: [GHC.Types.KindRep] -[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] -$krep4_r2Q8 = GHC.Types.: @ GHC.Types.KindRep $krep2_r2Q6 $krep3_r2Q7 +$krep4_r1GA :: [GHC.Types.KindRep] +[GblId, Cpr=m2, Unf=OtherCon []] +$krep4_r1GA = GHC.Types.: @GHC.Types.KindRep $krep2_r1Gy $krep3_r1Gz -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep5_r2Q9 :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] -$krep5_r2Q9 = GHC.Types.KindRepTyConApp GHC.Tuple.$tc(,) $krep4_r2Q8 +$krep5_r1GB :: GHC.Types.KindRep +[GblId, Cpr=m1, Unf=OtherCon []] +$krep5_r1GB = GHC.Types.KindRepTyConApp GHC.Tuple.$tc(,) $krep4_r1GA -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T10482.$tcFoo2 :: GHC.Prim.Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] T10482.$tcFoo2 = "Foo"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T10482.$tcFoo1 :: GHC.Types.TrName [GblId, - Caf=NoCafRefs, - Str=m1, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] T10482.$tcFoo1 = GHC.Types.TrNameS T10482.$tcFoo2 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T10482.$tcFoo :: GHC.Types.TyCon [GblId, - Caf=NoCafRefs, - Str=m, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] T10482.$tcFoo = GHC.Types.TyCon 3311038889639791302## 7944995683507700778## T10482.$trModule T10482.$tcFoo1 0# GHC.Types.krep$*Arr* -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -$krep6_r2Qa :: [GHC.Types.KindRep] -[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] -$krep6_r2Qa = GHC.Types.: @ GHC.Types.KindRep $krep2_r2Q6 (GHC.Types.[] @ GHC.Types.KindRep) +$krep6_r1GC :: [GHC.Types.KindRep] +[GblId, Cpr=m2, Unf=OtherCon []] +$krep6_r1GC = GHC.Types.: @GHC.Types.KindRep $krep2_r1Gy (GHC.Types.[] @GHC.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep7_r2Qb :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] -$krep7_r2Qb = GHC.Types.KindRepTyConApp T10482.$tcFoo $krep6_r2Qa +$krep7_r1GD :: GHC.Types.KindRep +[GblId, Cpr=m1, Unf=OtherCon []] +$krep7_r1GD = GHC.Types.KindRepTyConApp T10482.$tcFoo $krep6_r1GC -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep8_r2Qc :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] -$krep8_r2Qc = GHC.Types.KindRepTyConApp T10482.$tcFoo $krep3_r2Q7 +$krep8_r1GE :: GHC.Types.KindRep +[GblId, Cpr=m1, Unf=OtherCon []] +$krep8_r1GE = GHC.Types.KindRepTyConApp T10482.$tcFoo $krep3_r1Gz -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -$krep9_r2Qd :: [GHC.Types.KindRep] -[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] -$krep9_r2Qd = GHC.Types.: @ GHC.Types.KindRep $krep5_r2Q9 (GHC.Types.[] @ GHC.Types.KindRep) +$krep9_r1GF :: [GHC.Types.KindRep] +[GblId, Cpr=m2, Unf=OtherCon []] +$krep9_r1GF = GHC.Types.: @GHC.Types.KindRep $krep5_r1GB (GHC.Types.[] @GHC.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep10_r2Qe :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] -$krep10_r2Qe = GHC.Types.KindRepTyConApp T10482.$tcFoo $krep9_r2Qd +$krep10_r1GG :: GHC.Types.KindRep +[GblId, Cpr=m1, Unf=OtherCon []] +$krep10_r1GG = GHC.Types.KindRepTyConApp T10482.$tcFoo $krep9_r1GF -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep11_r2Qf :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] -$krep11_r2Qf = GHC.Types.KindRepFun $krep8_r2Qc $krep10_r2Qe +$krep11_r1GH :: GHC.Types.KindRep +[GblId, Cpr=m4, Unf=OtherCon []] +$krep11_r1GH = GHC.Types.KindRepFun $krep8_r1GE $krep10_r1GG -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} T10482.$tc'FooPair1 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] -T10482.$tc'FooPair1 = GHC.Types.KindRepFun $krep7_r2Qb $krep11_r2Qf +[GblId, Cpr=m4, Unf=OtherCon []] +T10482.$tc'FooPair1 = GHC.Types.KindRepFun $krep7_r1GD $krep11_r1GH -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -$krep12_r2Qg :: [GHC.Types.KindRep] -[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] -$krep12_r2Qg = GHC.Types.: @ GHC.Types.KindRep $krep_r2Q4 (GHC.Types.[] @ GHC.Types.KindRep) +$krep12_r1GI :: [GHC.Types.KindRep] +[GblId, Cpr=m2, Unf=OtherCon []] +$krep12_r1GI = GHC.Types.: @GHC.Types.KindRep $krep_r1Gw (GHC.Types.[] @GHC.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep13_r2Qh :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] -$krep13_r2Qh = GHC.Types.KindRepTyConApp T10482.$tcFoo $krep12_r2Qg +$krep13_r1GJ :: GHC.Types.KindRep +[GblId, Cpr=m1, Unf=OtherCon []] +$krep13_r1GJ = GHC.Types.KindRepTyConApp T10482.$tcFoo $krep12_r1GI -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} T10482.$tc'Foo1 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] -T10482.$tc'Foo1 = GHC.Types.KindRepFun $krep_r2Q4 $krep13_r2Qh +[GblId, Cpr=m4, Unf=OtherCon []] +T10482.$tc'Foo1 = GHC.Types.KindRepFun $krep_r1Gw $krep13_r1GJ -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T10482.$tc'FooPair3 :: GHC.Prim.Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] T10482.$tc'FooPair3 = "'FooPair"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T10482.$tc'FooPair2 :: GHC.Types.TrName [GblId, - Caf=NoCafRefs, - Str=m1, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] T10482.$tc'FooPair2 = GHC.Types.TrNameS T10482.$tc'FooPair3 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T10482.$tc'FooPair :: GHC.Types.TyCon [GblId, - Caf=NoCafRefs, - Str=m, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] T10482.$tc'FooPair = GHC.Types.TyCon 5329411373903054066## 1455261321638291317## T10482.$trModule T10482.$tc'FooPair2 2# T10482.$tc'FooPair1 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T10482.$tc'Foo3 :: GHC.Prim.Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] T10482.$tc'Foo3 = "'Foo"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T10482.$tc'Foo2 :: GHC.Types.TrName [GblId, - Caf=NoCafRefs, - Str=m1, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] T10482.$tc'Foo2 = GHC.Types.TrNameS T10482.$tc'Foo3 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T10482.$tc'Foo :: GHC.Types.TyCon [GblId, - Caf=NoCafRefs, - Str=m, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] T10482.$tc'Foo = GHC.Types.TyCon 5096937192618987042## 15136671864408054946## T10482.$trModule T10482.$tc'Foo2 0# T10482.$tc'Foo1 +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl_r1GK :: Int +[GblId, Cpr=m1, Unf=OtherCon []] +lvl_r1GK = GHC.Types.I# 0# + Rec { --- RHS size: {terms: 19, types: 4, coercions: 0, joins: 0/0} -T10482.$wfoo [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.Int# -> GHC.Prim.Int# -[GblId, Arity=2, Caf=NoCafRefs, Str=, Unf=OtherCon []] +-- RHS size: {terms: 19, types: 5, coercions: 3, joins: 0/0} +T10482.$wfoo [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker] :: Foo Int -> GHC.Prim.Int# -> Int +[GblId, Arity=2, Str=, Unf=OtherCon []] T10482.$wfoo - = \ (ww_s2OA :: GHC.Prim.Int#) (ww1_s2OI :: GHC.Prim.Int#) -> - case ww1_s2OI of wild_X1r { + = \ (ww_s1Fu + :: Foo Int + Unf=OtherCon []) + (ww1_s1FB :: GHC.Prim.Int#) -> + case ww1_s1FB of wild_X1 { __DEFAULT -> - case GHC.Prim.remInt# wild_X1r 2# of { - __DEFAULT -> ww_s2OA; - 0# -> T10482.$wfoo ww_s2OA (GHC.Prim.-# wild_X1r 1#) + case GHC.Prim.remInt# wild_X1 2# of { + __DEFAULT -> ww_s1Fu `cast` (T10482.D:R:FooInt0[0] ; T10482.N:R:FooInt[0] :: Foo Int ~R# Int); + 0# -> T10482.$wfoo ww_s1Fu (GHC.Prim.-# wild_X1 1#) }; - 0# -> 0# + 0# -> lvl_r1GK } end Rec } --- RHS size: {terms: 21, types: 30, coercions: 11, joins: 0/0} +-- RHS size: {terms: 14, types: 27, coercions: 8, joins: 0/0} foo [InlPrag=NOUSERINLINE[2]] :: Foo ((Int, Int), Int) -> Int -> Int [GblId, Arity=2, - Caf=NoCafRefs, - Str=m, + Str=, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) - Tmpl= \ (w_s2Oq [Occ=Once] :: Foo ((Int, Int), Int)) (w1_s2Or [Occ=Once!] :: Int) -> - case w_s2Oq - `cast` (T10482.D:R:Foo(,)0[0] <(Int, Int)>_N _N :: (Foo ((Int, Int), Int) :: *) ~R# (T10482.R:Foo(,) (Int, Int) Int :: *)) - of - { FooPair ww1_s2Ou [Occ=Once] _ [Occ=Dead] -> - case ww1_s2Ou `cast` (T10482.D:R:Foo(,)0[0] _N _N :: (Foo (Int, Int) :: *) ~R# (T10482.R:Foo(,) Int Int :: *)) of - { FooPair ww4_s2Ox [Occ=Once] _ [Occ=Dead] -> - case ww4_s2Ox `cast` (T10482.D:R:FooInt0[0] ; T10482.N:R:FooInt[0] :: (Foo Int :: *) ~R# (Int :: *)) of - { GHC.Types.I# ww7_s2OA [Occ=Once] -> - case w1_s2Or of { GHC.Types.I# ww9_s2OI [Occ=Once] -> - case T10482.$wfoo ww7_s2OA ww9_s2OI of ww10_s2OM { __DEFAULT -> GHC.Types.I# ww10_s2OM } - } - } + Tmpl= \ (w_s1Fn [Occ=Once] :: Foo ((Int, Int), Int)) (w1_s1Fo [Occ=Once!] :: Int) -> + case w_s1Fn `cast` (T10482.D:R:Foo(,)0[0] <(Int, Int)>_N _N :: Foo ((Int, Int), Int) ~R# T10482.R:Foo(,) (Int, Int) Int) of + { FooPair ww1_s1Fr [Occ=Once] _ [Occ=Dead] -> + case ww1_s1Fr `cast` (T10482.D:R:Foo(,)0[0] _N _N :: Foo (Int, Int) ~R# T10482.R:Foo(,) Int Int) of + { FooPair ww4_s1Fu [Occ=Once] _ [Occ=Dead] -> + case w1_s1Fo of { GHC.Types.I# ww7_s1FB [Occ=Once] -> T10482.$wfoo ww4_s1Fu ww7_s1FB } } }}] foo - = \ (w_s2Oq :: Foo ((Int, Int), Int)) (w1_s2Or :: Int) -> - case w_s2Oq - `cast` (T10482.D:R:Foo(,)0[0] <(Int, Int)>_N _N :: (Foo ((Int, Int), Int) :: *) ~R# (T10482.R:Foo(,) (Int, Int) Int :: *)) - of - { FooPair ww1_s2Ou ww2_s2OE -> - case ww1_s2Ou `cast` (T10482.D:R:Foo(,)0[0] _N _N :: (Foo (Int, Int) :: *) ~R# (T10482.R:Foo(,) Int Int :: *)) of - { FooPair ww4_s2Pm ww5_s2Pn -> - case ww4_s2Pm `cast` (T10482.D:R:FooInt0[0] ; T10482.N:R:FooInt[0] :: (Foo Int :: *) ~R# (Int :: *)) of { GHC.Types.I# ww7_s2Pq -> - case w1_s2Or of { GHC.Types.I# ww9_s2OI -> case T10482.$wfoo ww7_s2Pq ww9_s2OI of ww10_s2OM { __DEFAULT -> GHC.Types.I# ww10_s2OM } } - } + = \ (w_s1Fn :: Foo ((Int, Int), Int)) (w1_s1Fo :: Int) -> + case w_s1Fn `cast` (T10482.D:R:Foo(,)0[0] <(Int, Int)>_N _N :: Foo ((Int, Int), Int) ~R# T10482.R:Foo(,) (Int, Int) Int) of + { FooPair ww1_s1Fr ww2_s1Fx -> + case ww1_s1Fr `cast` (T10482.D:R:Foo(,)0[0] _N _N :: Foo (Int, Int) ~R# T10482.R:Foo(,) Int Int) of + { FooPair ww4_s1G0 ww5_s1G1 -> + case w1_s1Fo of { GHC.Types.I# ww7_s1FB -> T10482.$wfoo ww4_s1G0 ww7_s1FB } } } ===================================== testsuite/tests/stranal/should_compile/T10482a.stderr ===================================== @@ -1,407 +1,366 @@ ==================== Tidy Core ==================== -Result size of Tidy Core = {terms: 353, types: 155, coercions: 3, joins: 0/0} +Result size of Tidy Core = {terms: 342, types: 152, coercions: 3, joins: 0/0} -- RHS size: {terms: 9, types: 8, coercions: 0, joins: 0/0} -Foo.$WMkT4 [InlPrag=INLINE[2]] :: forall a. Foo a -> Int -> T4 a +Foo.$WMkT4 [InlPrag=INLINE[0]] :: forall a. Foo a -> Int -> T4 a [GblId[DataConWrapper], Arity=2, Caf=NoCafRefs, - Str=m, + Str=, + Cpr=m1, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) - Tmpl= \ (@ a_atA) (dt_a21M [Occ=Once] :: Foo a_atA[sk:1]) (dt_a21N [Occ=Once] :: Int) -> - case dt_a21M of dt_X21Q { __DEFAULT -> Foo.MkT4 @ a_atA dt_X21Q dt_a21N }}] + Tmpl= \ (@a_agw) (dt_a1hl [Occ=Once] :: Foo a_agw) (dt_a1hm [Occ=Once] :: Int) -> + case dt_a1hl of dt_X0 [Occ=Once] { __DEFAULT -> Foo.MkT4 @a_agw dt_X0 dt_a1hm }}] Foo.$WMkT4 - = \ (@ a_atA) (dt_a21M [Occ=Once] :: Foo a_atA[sk:1]) (dt_a21N [Occ=Once] :: Int) -> - case dt_a21M of dt_X21Q { __DEFAULT -> Foo.MkT4 @ a_atA dt_X21Q dt_a21N } + = \ (@a_agw) (dt_a1hl [Occ=Once] :: Foo a_agw) (dt_a1hm [Occ=Once] :: Int) -> + case dt_a1hl of dt_X0 [Occ=Once] { __DEFAULT -> Foo.MkT4 @a_agw dt_X0 dt_a1hm } -- RHS size: {terms: 8, types: 3, coercions: 0, joins: 0/0} -Foo.$WMkT2 [InlPrag=INLINE[2]] :: Int -> Int -> T2 +Foo.$WMkT2 [InlPrag=INLINE[0]] :: Int -> Int -> T2 [GblId[DataConWrapper], Arity=2, Caf=NoCafRefs, - Str=m, + Str=, + Cpr=m1, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) - Tmpl= \ (dt_a20w [Occ=Once] :: Int) (dt_a20x [Occ=Once] :: Int) -> - case dt_a20w of dt_X20z { __DEFAULT -> Foo.MkT2 dt_X20z dt_a20x }}] + Tmpl= \ (dt_a1gu [Occ=Once] :: Int) (dt_a1gv [Occ=Once] :: Int) -> + case dt_a1gu of dt_X0 [Occ=Once] { __DEFAULT -> Foo.MkT2 dt_X0 dt_a1gv }}] Foo.$WMkT2 - = \ (dt_a20w [Occ=Once] :: Int) (dt_a20x [Occ=Once] :: Int) -> case dt_a20w of dt_X20z { __DEFAULT -> Foo.MkT2 dt_X20z dt_a20x } + = \ (dt_a1gu [Occ=Once] :: Int) (dt_a1gv [Occ=Once] :: Int) -> + case dt_a1gu of dt_X0 [Occ=Once] { __DEFAULT -> Foo.MkT2 dt_X0 dt_a1gv } -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} Foo.$trModule4 :: GHC.Prim.Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] Foo.$trModule4 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} Foo.$trModule3 :: GHC.Types.TrName [GblId, - Caf=NoCafRefs, - Str=m1, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] Foo.$trModule3 = GHC.Types.TrNameS Foo.$trModule4 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} Foo.$trModule2 :: GHC.Prim.Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] Foo.$trModule2 = "Foo"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} Foo.$trModule1 :: GHC.Types.TrName [GblId, - Caf=NoCafRefs, - Str=m1, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] Foo.$trModule1 = GHC.Types.TrNameS Foo.$trModule2 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} Foo.$trModule :: GHC.Types.Module [GblId, - Caf=NoCafRefs, - Str=m, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] Foo.$trModule = GHC.Types.Module Foo.$trModule3 Foo.$trModule1 -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} -$krep_r2oJ :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] -$krep_r2oJ = GHC.Types.KindRepTyConApp GHC.Types.$tcInt (GHC.Types.[] @ GHC.Types.KindRep) +$krep_r1x7 :: GHC.Types.KindRep +[GblId, Cpr=m1, Unf=OtherCon []] +$krep_r1x7 = GHC.Types.KindRepTyConApp GHC.Types.$tcInt (GHC.Types.[] @GHC.Types.KindRep) -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -$krep1_r2oK :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] -$krep1_r2oK = GHC.Types.KindRepVar 0# +$krep1_r1x8 :: GHC.Types.KindRep +[GblId, Cpr=m2, Unf=OtherCon []] +$krep1_r1x8 = GHC.Types.KindRepVar 0# -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} Foo.$tcT5 :: GHC.Prim.Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] Foo.$tcT5 = "T2"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} Foo.$tcT1 :: GHC.Types.TrName [GblId, - Caf=NoCafRefs, - Str=m1, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] Foo.$tcT1 = GHC.Types.TrNameS Foo.$tcT5 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} Foo.$tcT2 :: GHC.Types.TyCon [GblId, - Caf=NoCafRefs, - Str=m, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] Foo.$tcT2 = GHC.Types.TyCon 12492463661685256209## 1082997131366389398## Foo.$trModule Foo.$tcT1 0# GHC.Types.krep$* -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} -$krep2_r2oL :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] -$krep2_r2oL = GHC.Types.KindRepTyConApp Foo.$tcT2 (GHC.Types.[] @ GHC.Types.KindRep) +$krep2_r1x9 :: GHC.Types.KindRep +[GblId, Cpr=m1, Unf=OtherCon []] +$krep2_r1x9 = GHC.Types.KindRepTyConApp Foo.$tcT2 (GHC.Types.[] @GHC.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep3_r2oM :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] -$krep3_r2oM = GHC.Types.KindRepFun $krep_r2oJ $krep2_r2oL +$krep3_r1xa :: GHC.Types.KindRep +[GblId, Cpr=m4, Unf=OtherCon []] +$krep3_r1xa = GHC.Types.KindRepFun $krep_r1x7 $krep2_r1x9 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} Foo.$tc'MkT1 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] -Foo.$tc'MkT1 = GHC.Types.KindRepFun $krep_r2oJ $krep3_r2oM +[GblId, Cpr=m4, Unf=OtherCon []] +Foo.$tc'MkT1 = GHC.Types.KindRepFun $krep_r1x7 $krep3_r1xa -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} Foo.$tc'MkT6 :: GHC.Prim.Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] Foo.$tc'MkT6 = "'MkT2"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} Foo.$tc'MkT5 :: GHC.Types.TrName [GblId, - Caf=NoCafRefs, - Str=m1, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] Foo.$tc'MkT5 = GHC.Types.TrNameS Foo.$tc'MkT6 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} Foo.$tc'MkT2 :: GHC.Types.TyCon [GblId, - Caf=NoCafRefs, - Str=m, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] Foo.$tc'MkT2 = GHC.Types.TyCon 5707542518475997625## 9584804394183763875## Foo.$trModule Foo.$tc'MkT5 0# Foo.$tc'MkT1 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} Foo.$tcT7 :: GHC.Prim.Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] Foo.$tcT7 = "T3"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} Foo.$tcT6 :: GHC.Types.TrName [GblId, - Caf=NoCafRefs, - Str=m1, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] Foo.$tcT6 = GHC.Types.TrNameS Foo.$tcT7 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} Foo.$tcT3 :: GHC.Types.TyCon [GblId, - Caf=NoCafRefs, - Str=m, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] Foo.$tcT3 = GHC.Types.TyCon 8915518733037212359## 16476420519216613869## Foo.$trModule Foo.$tcT6 0# GHC.Types.krep$* -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} -$krep4_r2oN :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] -$krep4_r2oN = GHC.Types.KindRepTyConApp Foo.$tcT3 (GHC.Types.[] @ GHC.Types.KindRep) +$krep4_r1xb :: GHC.Types.KindRep +[GblId, Cpr=m1, Unf=OtherCon []] +$krep4_r1xb = GHC.Types.KindRepTyConApp Foo.$tcT3 (GHC.Types.[] @GHC.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep5_r2oO :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] -$krep5_r2oO = GHC.Types.KindRepFun $krep_r2oJ $krep4_r2oN +$krep5_r1xc :: GHC.Types.KindRep +[GblId, Cpr=m4, Unf=OtherCon []] +$krep5_r1xc = GHC.Types.KindRepFun $krep_r1x7 $krep4_r1xb -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} Foo.$tc'MkT7 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] -Foo.$tc'MkT7 = GHC.Types.KindRepFun $krep_r2oJ $krep5_r2oO +[GblId, Cpr=m4, Unf=OtherCon []] +Foo.$tc'MkT7 = GHC.Types.KindRepFun $krep_r1x7 $krep5_r1xc -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} Foo.$tc'MkT9 :: GHC.Prim.Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] Foo.$tc'MkT9 = "'MkT3"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} Foo.$tc'MkT8 :: GHC.Types.TrName [GblId, - Caf=NoCafRefs, - Str=m1, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] Foo.$tc'MkT8 = GHC.Types.TrNameS Foo.$tc'MkT9 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} Foo.$tc'MkT3 :: GHC.Types.TyCon [GblId, - Caf=NoCafRefs, - Str=m, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] Foo.$tc'MkT3 = GHC.Types.TyCon 7218783144619306039## 13236146459150723629## Foo.$trModule Foo.$tc'MkT8 0# Foo.$tc'MkT7 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} Foo.$tcFoo :: GHC.Types.TyCon [GblId, - Caf=NoCafRefs, - Str=m, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] Foo.$tcFoo = GHC.Types.TyCon 11236787750777559483## 2472662601374496863## Foo.$trModule Foo.$trModule1 0# GHC.Types.krep$*Arr* -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -$krep6_r2oP :: [GHC.Types.KindRep] -[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] -$krep6_r2oP = GHC.Types.: @ GHC.Types.KindRep $krep1_r2oK (GHC.Types.[] @ GHC.Types.KindRep) +$krep6_r1xd :: [GHC.Types.KindRep] +[GblId, Cpr=m2, Unf=OtherCon []] +$krep6_r1xd = GHC.Types.: @GHC.Types.KindRep $krep1_r1x8 (GHC.Types.[] @GHC.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep7_r2oQ :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] -$krep7_r2oQ = GHC.Types.KindRepTyConApp Foo.$tcFoo $krep6_r2oP +$krep7_r1xe :: GHC.Types.KindRep +[GblId, Cpr=m1, Unf=OtherCon []] +$krep7_r1xe = GHC.Types.KindRepTyConApp Foo.$tcFoo $krep6_r1xd -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -$krep8_r2oR :: [GHC.Types.KindRep] -[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] -$krep8_r2oR = GHC.Types.: @ GHC.Types.KindRep $krep_r2oJ (GHC.Types.[] @ GHC.Types.KindRep) +$krep8_r1xf :: [GHC.Types.KindRep] +[GblId, Cpr=m2, Unf=OtherCon []] +$krep8_r1xf = GHC.Types.: @GHC.Types.KindRep $krep_r1x7 (GHC.Types.[] @GHC.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep9_r2oS :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] -$krep9_r2oS = GHC.Types.KindRepTyConApp Foo.$tcFoo $krep8_r2oR +$krep9_r1xg :: GHC.Types.KindRep +[GblId, Cpr=m1, Unf=OtherCon []] +$krep9_r1xg = GHC.Types.KindRepTyConApp Foo.$tcFoo $krep8_r1xf -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} Foo.$tc'Foo1 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] -Foo.$tc'Foo1 = GHC.Types.KindRepFun $krep_r2oJ $krep9_r2oS +[GblId, Cpr=m4, Unf=OtherCon []] +Foo.$tc'Foo1 = GHC.Types.KindRepFun $krep_r1x7 $krep9_r1xg -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} Foo.$tc'Foo3 :: GHC.Prim.Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] Foo.$tc'Foo3 = "'Foo"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} Foo.$tc'Foo2 :: GHC.Types.TrName [GblId, - Caf=NoCafRefs, - Str=m1, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] Foo.$tc'Foo2 = GHC.Types.TrNameS Foo.$tc'Foo3 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} Foo.$tc'Foo :: GHC.Types.TyCon [GblId, - Caf=NoCafRefs, - Str=m, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] Foo.$tc'Foo = GHC.Types.TyCon 10641757595611461765## 13961773224584044648## Foo.$trModule Foo.$tc'Foo2 0# Foo.$tc'Foo1 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} Foo.$tcT9 :: GHC.Prim.Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] Foo.$tcT9 = "T4"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} Foo.$tcT8 :: GHC.Types.TrName [GblId, - Caf=NoCafRefs, - Str=m1, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] Foo.$tcT8 = GHC.Types.TrNameS Foo.$tcT9 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} Foo.$tcT4 :: GHC.Types.TyCon [GblId, - Caf=NoCafRefs, - Str=m, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] Foo.$tcT4 = GHC.Types.TyCon 15961711399118996930## 13694522307176382499## Foo.$trModule Foo.$tcT8 0# GHC.Types.krep$*Arr* -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep10_r2oT :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] -$krep10_r2oT = GHC.Types.KindRepTyConApp Foo.$tcT4 $krep6_r2oP +$krep10_r1xh :: GHC.Types.KindRep +[GblId, Cpr=m1, Unf=OtherCon []] +$krep10_r1xh = GHC.Types.KindRepTyConApp Foo.$tcT4 $krep6_r1xd -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep11_r2oU :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] -$krep11_r2oU = GHC.Types.KindRepFun $krep_r2oJ $krep10_r2oT +$krep11_r1xi :: GHC.Types.KindRep +[GblId, Cpr=m4, Unf=OtherCon []] +$krep11_r1xi = GHC.Types.KindRepFun $krep_r1x7 $krep10_r1xh -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} Foo.$tc'MkT10 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] -Foo.$tc'MkT10 = GHC.Types.KindRepFun $krep7_r2oQ $krep11_r2oU +[GblId, Cpr=m4, Unf=OtherCon []] +Foo.$tc'MkT10 = GHC.Types.KindRepFun $krep7_r1xe $krep11_r1xi -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} Foo.$tc'MkT12 :: GHC.Prim.Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] Foo.$tc'MkT12 = "'MkT4"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} Foo.$tc'MkT11 :: GHC.Types.TrName [GblId, - Caf=NoCafRefs, - Str=m1, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] Foo.$tc'MkT11 = GHC.Types.TrNameS Foo.$tc'MkT12 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} Foo.$tc'MkT4 :: GHC.Types.TyCon [GblId, - Caf=NoCafRefs, - Str=m, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] Foo.$tc'MkT4 = GHC.Types.TyCon 6077781708614236332## 14823286043222481570## Foo.$trModule Foo.$tc'MkT11 1# Foo.$tc'MkT10 Rec { --- RHS size: {terms: 14, types: 3, coercions: 0, joins: 0/0} -Foo.$wf4 [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.Int# -> GHC.Prim.Int# -[GblId, Arity=2, Caf=NoCafRefs, Str=, Unf=OtherCon []] +-- RHS size: {terms: 14, types: 4, coercions: 3, joins: 0/0} +Foo.$wf4 [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker] :: Foo Int -> GHC.Prim.Int# -> Int +[GblId, Arity=2, Str=, Unf=OtherCon []] Foo.$wf4 - = \ (ww_s2jL :: GHC.Prim.Int#) (ww1_s2jQ :: GHC.Prim.Int#) -> - case GHC.Prim.># ww1_s2jQ 0# of { - __DEFAULT -> ww_s2jL; - 1# -> Foo.$wf4 ww_s2jL (GHC.Prim.-# ww1_s2jQ 1#) + = \ (ww_s1tc + :: Foo Int + Unf=OtherCon []) + (ww1_s1tg :: GHC.Prim.Int#) -> + case GHC.Prim.># ww1_s1tg 0# of { + __DEFAULT -> ww_s1tc `cast` (Foo.D:R:FooInt0[0] ; Foo.N:R:FooInt[0] :: Foo Int ~R# Int); + 1# -> Foo.$wf4 ww_s1tc (GHC.Prim.-# ww1_s1tg 1#) } end Rec } --- RHS size: {terms: 17, types: 12, coercions: 3, joins: 0/0} +-- RHS size: {terms: 10, types: 9, coercions: 0, joins: 0/0} f4 [InlPrag=NOUSERINLINE[2]] :: T4 Int -> Int [GblId, Arity=1, - Caf=NoCafRefs, - Str=m, + 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_s2jF [Occ=Once!] :: T4 Int) -> - case w_s2jF of { MkT4 ww1_s2jI [Occ=Once] ww2_s2jN [Occ=Once!] -> - case ww1_s2jI `cast` (Foo.D:R:FooInt0[0] ; Foo.N:R:FooInt[0] :: (Foo Int :: *) ~R# (Int :: *)) of - { GHC.Types.I# ww4_s2jL [Occ=Once] -> - case ww2_s2jN of { GHC.Types.I# ww6_s2jQ [Occ=Once] -> - case Foo.$wf4 ww4_s2jL ww6_s2jQ of ww7_s2jV { __DEFAULT -> GHC.Types.I# ww7_s2jV } - } - } + Tmpl= \ (w_s1t9 [Occ=Once!] :: T4 Int) -> + case w_s1t9 of { MkT4 ww1_s1tc [Occ=Once] ww2_s1td [Occ=Once!] -> + case ww2_s1td of { GHC.Types.I# ww4_s1tg [Occ=Once] -> Foo.$wf4 ww1_s1tc ww4_s1tg } }}] f4 - = \ (w_s2jF :: T4 Int) -> - case w_s2jF of { MkT4 ww1_s2jI ww2_s2jN -> - case ww1_s2jI `cast` (Foo.D:R:FooInt0[0] ; Foo.N:R:FooInt[0] :: (Foo Int :: *) ~R# (Int :: *)) of { GHC.Types.I# ww4_s2mW -> - case ww2_s2jN of { GHC.Types.I# ww6_s2jQ -> case Foo.$wf4 ww4_s2mW ww6_s2jQ of ww7_s2jV { __DEFAULT -> GHC.Types.I# ww7_s2jV } } - } - } + = \ (w_s1t9 :: T4 Int) -> + case w_s1t9 of { MkT4 ww1_s1tc ww2_s1td -> case ww2_s1td of { GHC.Types.I# ww4_s1tg -> Foo.$wf4 ww1_s1tc ww4_s1tg } } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl_r1xj :: Int +[GblId, Cpr=m1, Unf=OtherCon []] +lvl_r1xj = GHC.Types.I# 1# Rec { -- RHS size: {terms: 21, types: 4, coercions: 0, joins: 0/0} -Foo.$wf2 [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.Int# -> GHC.Prim.Int# -[GblId, Arity=2, Caf=NoCafRefs, Str=, Unf=OtherCon []] +Foo.$wf2 [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker] :: Int -> GHC.Prim.Int# -> Int +[GblId, Arity=2, Str=, Unf=OtherCon []] Foo.$wf2 - = \ (ww_s2k3 :: GHC.Prim.Int#) (ww1_s2k8 :: GHC.Prim.Int#) -> - case GHC.Prim.># ww1_s2k8 0# of { + = \ (ww_s1tn + :: Int + Unf=OtherCon []) + (ww1_s1tr :: GHC.Prim.Int#) -> + case GHC.Prim.># ww1_s1tr 0# of { __DEFAULT -> - case GHC.Prim.># ww1_s2k8 1# of { - __DEFAULT -> ww_s2k3; - 1# -> 1# + case GHC.Prim.># ww1_s1tr 1# of { + __DEFAULT -> ww_s1tn; + 1# -> lvl_r1xj }; - 1# -> Foo.$wf2 ww_s2k3 (GHC.Prim.-# ww1_s2k8 1#) + 1# -> Foo.$wf2 ww_s1tn (GHC.Prim.-# ww1_s1tr 1#) } end Rec } --- RHS size: {terms: 17, types: 9, coercions: 0, joins: 0/0} +-- RHS size: {terms: 10, types: 6, coercions: 0, joins: 0/0} f2 [InlPrag=NOUSERINLINE[2]] :: T2 -> Int [GblId, Arity=1, - Caf=NoCafRefs, - Str=m, + 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_s2jX [Occ=Once!] :: T2) -> - case w_s2jX of { MkT2 ww1_s2k0 [Occ=Once!] ww2_s2k5 [Occ=Once!] -> - case ww1_s2k0 of { GHC.Types.I# ww4_s2k3 [Occ=Once] -> - case ww2_s2k5 of { GHC.Types.I# ww6_s2k8 [Occ=Once] -> - case Foo.$wf2 ww4_s2k3 ww6_s2k8 of ww7_s2kd { __DEFAULT -> GHC.Types.I# ww7_s2kd } - } - } + Tmpl= \ (w_s1tk [Occ=Once!] :: T2) -> + case w_s1tk of { MkT2 ww1_s1tn [Occ=Once] ww2_s1to [Occ=Once!] -> + case ww2_s1to of { GHC.Types.I# ww4_s1tr [Occ=Once] -> Foo.$wf2 ww1_s1tn ww4_s1tr } }}] f2 - = \ (w_s2jX :: T2) -> - case w_s2jX of { MkT2 ww1_s2k0 ww2_s2k5 -> - case ww1_s2k0 of { GHC.Types.I# ww4_s2mZ -> - case ww2_s2k5 of { GHC.Types.I# ww6_s2k8 -> case Foo.$wf2 ww4_s2mZ ww6_s2k8 of ww7_s2kd { __DEFAULT -> GHC.Types.I# ww7_s2kd } } - } - } + = \ (w_s1tk :: T2) -> + case w_s1tk of { MkT2 ww1_s1tn ww2_s1to -> case ww2_s1to of { GHC.Types.I# ww4_s1tr -> Foo.$wf2 ww1_s1tn ww4_s1tr } } Rec { -- RHS size: {terms: 15, types: 4, coercions: 0, joins: 0/0} Foo.$wh [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.Int# -> Bool -[GblId, Arity=2, Caf=NoCafRefs, Str=, Unf=OtherCon []] +[GblId, Arity=2, Str=, Unf=OtherCon []] Foo.$wh - = \ (ww_s2kj :: GHC.Prim.Int#) (ww1_s2kn :: GHC.Prim.Int#) -> - case ww_s2kj of ds_X2gt { - __DEFAULT -> Foo.$wh (GHC.Prim.-# ds_X2gt 1#) ww1_s2kn; - 0# -> GHC.Prim.tagToEnum# @ Bool (GHC.Prim.># ww1_s2kn 0#) + = \ (ww_s1tz :: GHC.Prim.Int#) (ww1_s1tD :: GHC.Prim.Int#) -> + case ww_s1tz of ds_X2 { + __DEFAULT -> Foo.$wh (GHC.Prim.-# ds_X2 1#) ww1_s1tD; + 0# -> GHC.Prim.tagToEnum# @Bool (GHC.Prim.># ww1_s1tD 0#) } end Rec } @@ -409,26 +368,25 @@ end Rec } h [InlPrag=NOUSERINLINE[2]] :: Int -> Int -> Bool [GblId, Arity=2, - Caf=NoCafRefs, - Str=, + Str=, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) - Tmpl= \ (w_s2kf [Occ=Once!] :: Int) (w1_s2kg [Occ=Once!] :: Int) -> - case w_s2kf of { GHC.Types.I# ww1_s2kj [Occ=Once] -> - case w1_s2kg of { GHC.Types.I# ww3_s2kn [Occ=Once] -> Foo.$wh ww1_s2kj ww3_s2kn } + Tmpl= \ (w_s1tv [Occ=Once!] :: Int) (w1_s1tw [Occ=Once!] :: Int) -> + case w_s1tv of { GHC.Types.I# ww1_s1tz [Occ=Once] -> + case w1_s1tw of { GHC.Types.I# ww3_s1tD [Occ=Once] -> Foo.$wh ww1_s1tz ww3_s1tD } }}] -h = \ (w_s2kf :: Int) (w1_s2kg :: Int) -> - case w_s2kf of { GHC.Types.I# ww1_s2kj -> case w1_s2kg of { GHC.Types.I# ww3_s2kn -> Foo.$wh ww1_s2kj ww3_s2kn } } +h = \ (w_s1tv :: Int) (w1_s1tw :: Int) -> + case w_s1tv of { GHC.Types.I# ww1_s1tz -> case w1_s1tw of { GHC.Types.I# ww3_s1tD -> Foo.$wh ww1_s1tz ww3_s1tD } } Rec { -- RHS size: {terms: 12, types: 2, coercions: 0, joins: 0/0} Foo.$wf1 [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.Int# -[GblId, Arity=1, Caf=NoCafRefs, Str=, Unf=OtherCon []] +[GblId, Arity=1, Str=, Unf=OtherCon []] Foo.$wf1 - = \ (ww_s2kt :: GHC.Prim.Int#) -> - case Foo.$wh ww_s2kt ww_s2kt of { - False -> Foo.$wf1 (GHC.Prim.-# ww_s2kt 1#); - True -> ww_s2kt + = \ (ww_s1tJ :: GHC.Prim.Int#) -> + case Foo.$wh ww_s1tJ ww_s1tJ of { + False -> Foo.$wf1 (GHC.Prim.-# ww_s1tJ 1#); + True -> ww_s1tJ } end Rec } @@ -436,25 +394,27 @@ end Rec } f1 [InlPrag=NOUSERINLINE[2]] :: Int -> Int [GblId, Arity=1, - Caf=NoCafRefs, - Str=m, + Str=, + Cpr=m1, 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_s2kq [Occ=Once!] :: Int) -> - case w_s2kq of { GHC.Types.I# ww1_s2kt [Occ=Once] -> case Foo.$wf1 ww1_s2kt of ww2_s2kx { __DEFAULT -> GHC.Types.I# ww2_s2kx } }}] + Tmpl= \ (w_s1tG [Occ=Once!] :: Int) -> + case w_s1tG of { GHC.Types.I# ww1_s1tJ [Occ=Once] -> + case Foo.$wf1 ww1_s1tJ of ww2_s1tN [Occ=Once] { __DEFAULT -> GHC.Types.I# ww2_s1tN } + }}] f1 - = \ (w_s2kq :: Int) -> - case w_s2kq of { GHC.Types.I# ww1_s2kt -> case Foo.$wf1 ww1_s2kt of ww2_s2kx { __DEFAULT -> GHC.Types.I# ww2_s2kx } } + = \ (w_s1tG :: Int) -> + case w_s1tG of { GHC.Types.I# ww1_s1tJ -> case Foo.$wf1 ww1_s1tJ of ww2_s1tN { __DEFAULT -> GHC.Types.I# ww2_s1tN } } Rec { -- RHS size: {terms: 14, types: 3, coercions: 0, joins: 0/0} Foo.$wf3 [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.Int# -> GHC.Prim.Int# -[GblId, Arity=2, Caf=NoCafRefs, Str=, Unf=OtherCon []] +[GblId, Arity=2, Str=, Unf=OtherCon []] Foo.$wf3 - = \ (ww_s2kF :: GHC.Prim.Int#) (ww1_s2kK :: GHC.Prim.Int#) -> - case Foo.$wh ww_s2kF ww1_s2kK of { - False -> ww_s2kF; - True -> Foo.$wf3 ww_s2kF (GHC.Prim.-# ww1_s2kK 1#) + = \ (ww_s1tV :: GHC.Prim.Int#) (ww1_s1u0 :: GHC.Prim.Int#) -> + case Foo.$wh ww_s1tV ww1_s1u0 of { + False -> ww_s1tV; + True -> Foo.$wf3 ww_s1tV (GHC.Prim.-# ww1_s1u0 1#) } end Rec } @@ -462,23 +422,23 @@ end Rec } f3 [InlPrag=NOUSERINLINE[2]] :: T3 -> Int [GblId, Arity=1, - Caf=NoCafRefs, - Str=m, + Str=, + Cpr=m1, 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_s2kz [Occ=Once!] :: T3) -> - case w_s2kz of { MkT3 ww1_s2kC [Occ=Once!] ww2_s2kH [Occ=Once!] -> - case ww1_s2kC of { GHC.Types.I# ww4_s2kF [Occ=Once] -> - case ww2_s2kH of { GHC.Types.I# ww6_s2kK [Occ=Once] -> - case Foo.$wf3 ww4_s2kF ww6_s2kK of ww7_s2kP { __DEFAULT -> GHC.Types.I# ww7_s2kP } + Tmpl= \ (w_s1tP [Occ=Once!] :: T3) -> + case w_s1tP of { MkT3 ww1_s1tS [Occ=Once!] ww2_s1tX [Occ=Once!] -> + case ww1_s1tS of { GHC.Types.I# ww4_s1tV [Occ=Once] -> + case ww2_s1tX of { GHC.Types.I# ww6_s1u0 [Occ=Once] -> + case Foo.$wf3 ww4_s1tV ww6_s1u0 of ww7_s1u5 [Occ=Once] { __DEFAULT -> GHC.Types.I# ww7_s1u5 } } } }}] f3 - = \ (w_s2kz :: T3) -> - case w_s2kz of { MkT3 ww1_s2kC ww2_s2kH -> - case ww1_s2kC of { GHC.Types.I# ww4_s2kF -> - case ww2_s2kH of { GHC.Types.I# ww6_s2kK -> case Foo.$wf3 ww4_s2kF ww6_s2kK of ww7_s2kP { __DEFAULT -> GHC.Types.I# ww7_s2kP } } + = \ (w_s1tP :: T3) -> + case w_s1tP of { MkT3 ww1_s1tS ww2_s1tX -> + case ww1_s1tS of { GHC.Types.I# ww4_s1tV -> + case ww2_s1tX of { GHC.Types.I# ww6_s1u0 -> case Foo.$wf3 ww4_s1tV ww6_s1u0 of ww7_s1u5 { __DEFAULT -> GHC.Types.I# ww7_s1u5 } } } } ===================================== testsuite/tests/stranal/sigs/DmdAnalGADTs.stderr ===================================== @@ -9,7 +9,7 @@ DmdAnalGADTs.f: DmdAnalGADTs.f': DmdAnalGADTs.g: DmdAnalGADTs.hasCPR: -DmdAnalGADTs.hasStrSig: +DmdAnalGADTs.hasStrSig: @@ -23,7 +23,7 @@ DmdAnalGADTs.f: DmdAnalGADTs.f': m1 DmdAnalGADTs.g: DmdAnalGADTs.hasCPR: m1 -DmdAnalGADTs.hasStrSig: m1 +DmdAnalGADTs.hasStrSig: @@ -37,6 +37,6 @@ DmdAnalGADTs.f: DmdAnalGADTs.f': DmdAnalGADTs.g: DmdAnalGADTs.hasCPR: -DmdAnalGADTs.hasStrSig: +DmdAnalGADTs.hasStrSig: ===================================== testsuite/tests/stranal/sigs/T17932.hs ===================================== @@ -0,0 +1,11 @@ +-- See commentary in #17932 + +module T17932 where + +flags (Options f x) + = reverse (reverse (reverse (reverse (reverse (reverse (reverse (reverse x))))))) + `seq` f + +data X = X String Bool Bool Bool Bool + +data Options = Options !X [Int] ===================================== testsuite/tests/stranal/sigs/T17932.stderr ===================================== @@ -0,0 +1,30 @@ + +==================== Strictness signatures ==================== +T17932.$tc'Options: +T17932.$tc'X: +T17932.$tcOptions: +T17932.$tcX: +T17932.$trModule: +T17932.flags: + + + +==================== Cpr signatures ==================== +T17932.$tc'Options: m1 +T17932.$tc'X: m1 +T17932.$tcOptions: m1 +T17932.$tcX: m1 +T17932.$trModule: m1 +T17932.flags: + + + +==================== Strictness signatures ==================== +T17932.$tc'Options: +T17932.$tc'X: +T17932.$tcOptions: +T17932.$tcX: +T17932.$trModule: +T17932.flags: + + ===================================== testsuite/tests/stranal/sigs/UnsatFun.stderr ===================================== @@ -5,8 +5,8 @@ UnsatFun.f: b UnsatFun.g: b UnsatFun.g': UnsatFun.g3: -UnsatFun.h: -UnsatFun.h2: +UnsatFun.h: +UnsatFun.h2: UnsatFun.h3: @@ -29,8 +29,8 @@ UnsatFun.f: b UnsatFun.g: b UnsatFun.g': UnsatFun.g3: -UnsatFun.h: -UnsatFun.h2: +UnsatFun.h: +UnsatFun.h2: UnsatFun.h3: ===================================== testsuite/tests/stranal/sigs/all.T ===================================== @@ -19,3 +19,4 @@ test('T12370', normal, compile, ['']) test('CaseBinderCPR', normal, compile, ['']) test('NewtypeArity', normal, compile, ['']) test('T5075', normal, compile, ['']) +test('T17932', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8dd78b9083ca0f1b5260f0969d174dab2002aa93 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8dd78b9083ca0f1b5260f0969d174dab2002aa93 You're receiving 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 Mar 26 20:12:06 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Thu, 26 Mar 2020 16:12:06 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T17963 Message-ID: <5e7d0c96abe2d_6167120434ec8372ab@gitlab.haskell.org.mail> Ryan Scott pushed new branch wip/T17963 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T17963 You're receiving 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 Mar 26 22:04:00 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Thu, 26 Mar 2020 18:04:00 -0400 Subject: [Git][ghc/ghc][wip/ftext-no-length] Add Pretty.zeroWidth{F,P}Text, use it in Cmm Ppr Message-ID: <5e7d26d06b3f0_6167e6514b4852621@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/ftext-no-length at Glasgow Haskell Compiler / GHC Commits: fb415b18 by Sebastian Graf at 2020-03-26T23:03:33+01:00 Add Pretty.zeroWidth{F,P}Text, use it in Cmm Ppr This is ultimately so that we can drop the length field of `FastString`. The Cmm pretty printer doesn't look at the width anyway, so eagerly computing it is redundant. There are a multitude of occurrences of `text` in `compiler/GHC/Cmm`, but they mostly rewrite to `ptext` anyway, where computing the length isn't particularly expensive, so I refrained from changing these occurrences to `zeroWidthText` for the time being. >From the three proposed approaches in https://gitlab.haskell.org/ghc/ghc/issues/17069#note_259689 this one seemed like the simplest and least intrusive; plus, there is already precedent with `Pretty.zeroWidthText`. Fixes #17069. - - - - - 4 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Ppr.hs - compiler/utils/Outputable.hs - compiler/utils/Pretty.hs Changes: ===================================== compiler/GHC/Cmm/CLabel.hs ===================================== @@ -1177,7 +1177,7 @@ pprCLabel dynFlags (AsmTempDerivedLabel l suf) <> case l of AsmTempLabel u -> pprUniqueAlways u LocalBlockLabel u -> pprUniqueAlways u _other -> pprCLabel dynFlags l - <> ftext suf + <> zeroWidthFText suf pprCLabel dynFlags (DynamicLinkerLabel info lbl) | platformMisc_ghcWithNativeCodeGen $ platformMisc dynFlags @@ -1220,7 +1220,7 @@ pprAsmCLbl platform (ForeignLabel fs (Just sz) _ _) | platformOS platform == OSMinGW32 -- In asm mode, we need to put the suffix on a stdcall ForeignLabel. -- (The C compiler does this itself). - = ftext fs <> char '@' <> int sz + = zeroWidthFText fs <> char '@' <> int sz pprAsmCLbl _ lbl = pprCLbl lbl @@ -1239,14 +1239,14 @@ pprCLbl (LargeBitmapLabel u) = -- with a letter so the label will be legal assembly code. -pprCLbl (CmmLabel _ str CmmCode) = ftext str -pprCLbl (CmmLabel _ str CmmData) = ftext str -pprCLbl (CmmLabel _ str CmmPrimCall) = ftext str +pprCLbl (CmmLabel _ str CmmCode) = zeroWidthFText str +pprCLbl (CmmLabel _ str CmmData) = zeroWidthFText str +pprCLbl (CmmLabel _ str CmmPrimCall) = zeroWidthFText str pprCLbl (LocalBlockLabel u) = tempLabelPrefixOrUnderscore <> text "blk_" <> pprUniqueAlways u -pprCLbl (RtsLabel (RtsApFast str)) = ftext str <> text "_fast" +pprCLbl (RtsLabel (RtsApFast str)) = zeroWidthFText str <> text "_fast" pprCLbl (RtsLabel (RtsSelectorInfoTable upd_reqd offset)) = sdocWithDynFlags $ \dflags -> @@ -1285,19 +1285,19 @@ pprCLbl (RtsLabel (RtsApEntry upd_reqd arity)) ] pprCLbl (CmmLabel _ fs CmmInfo) - = ftext fs <> text "_info" + = zeroWidthFText fs <> text "_info" pprCLbl (CmmLabel _ fs CmmEntry) - = ftext fs <> text "_entry" + = zeroWidthFText fs <> text "_entry" pprCLbl (CmmLabel _ fs CmmRetInfo) - = ftext fs <> text "_info" + = zeroWidthFText fs <> text "_info" pprCLbl (CmmLabel _ fs CmmRet) - = ftext fs <> text "_ret" + = zeroWidthFText fs <> text "_ret" pprCLbl (CmmLabel _ fs CmmClosure) - = ftext fs <> text "_closure" + = zeroWidthFText fs <> text "_closure" pprCLbl (RtsLabel (RtsPrimOp primop)) = text "stg_" <> ppr primop @@ -1306,7 +1306,7 @@ pprCLbl (RtsLabel (RtsSlowFastTickyCtr pat)) = text "SLOW_CALL_fast_" <> text pat <> ptext (sLit "_ctr") pprCLbl (ForeignLabel str _ _ _) - = ftext str + = zeroWidthFText str pprCLbl (IdLabel name _cafs flavor) = internalNamePrefix name <> ppr name <> ppIdFlavor flavor ===================================== compiler/GHC/Cmm/Ppr.hs ===================================== @@ -195,7 +195,7 @@ pprNode platform node = pp_node <+> pp_debug <+> ppUnlessOption sdocSuppressTicks (text "//" <+> ppr tscope) -- // text - CmmComment s -> text "//" <+> ftext s + CmmComment s -> text "//" <+> zeroWidthFText s -- //tick bla<...> CmmTick t -> ppUnlessOption sdocSuppressTicks ===================================== compiler/utils/Outputable.hs ===================================== @@ -24,6 +24,7 @@ module Outputable ( empty, isEmpty, nest, char, text, ftext, ptext, ztext, + zeroWidthText, zeroWidthFText, zeroWidthPText, int, intWithCommas, integer, word, float, double, rational, doublePrec, parens, cparen, brackets, braces, quotes, quote, doubleQuotes, angleBrackets, @@ -622,6 +623,14 @@ word n = sdocOption sdocHexWordLiterals $ \case True -> docToSDoc $ Pretty.hex n False -> docToSDoc $ Pretty.integer n +zeroWidthText :: String -> SDoc +zeroWidthFText :: FastString -> SDoc +zeroWidthPText :: PtrString -> SDoc + +zeroWidthText s = docToSDoc $ Pretty.zeroWidthText s +zeroWidthFText s = docToSDoc $ Pretty.zeroWidthFText s +zeroWidthPText s = docToSDoc $ Pretty.zeroWidthPText s + -- | @doublePrec p n@ shows a floating point number @n@ with @p@ -- digits of precision after the decimal point. doublePrec :: Int -> Double -> SDoc ===================================== compiler/utils/Pretty.hs ===================================== @@ -71,7 +71,8 @@ module Pretty ( -- * Constructing documents -- ** Converting values into documents - char, text, ftext, ptext, ztext, sizedText, zeroWidthText, + char, text, ftext, ptext, ztext, sizedText, + zeroWidthText, zeroWidthFText, zeroWidthPText, int, integer, float, double, rational, hex, -- ** Simple derived documents @@ -309,12 +310,33 @@ text s = textBeside_ (Str s) (length s) Empty forall p n. text (unpackNBytes# p n) = ptext (PtrString (Ptr p) (I# n)) #-} +-- | Some text, but without any width. Use for non-printing text +-- such as a HTML or Latex tags +zeroWidthText :: String -> Doc +zeroWidthText = sizedText 0 +{-# NOINLINE [0] zeroWidthText #-} + +{-# RULES "zeroWidthText/str" + forall a. zeroWidthText (unpackCString# a) = zeroWidthPText (mkPtrString# a) + #-} +{-# RULES "zeroWidthText/unpackNBytes#" + forall p n. zeroWidthText (unpackNBytes# p n) = zeroWidthPText (PtrString (Ptr p) (I# n)) + #-} + ftext :: FastString -> Doc ftext s = textBeside_ (PStr s) (lengthFS s) Empty +-- | Like 'zeroWidthText', but for 'FastString'. +zeroWidthFText :: FastString -> Doc +zeroWidthFText s = textBeside_ (PStr s) 0 Empty + ptext :: PtrString -> Doc ptext s = textBeside_ (LStr s) (lengthPS s) Empty +-- | Like 'zeroWidthText', but for 'PtrString'. +zeroWidthPText :: PtrString -> Doc +zeroWidthPText s = textBeside_ (LStr s) 0 Empty + ztext :: FastZString -> Doc ztext s = textBeside_ (ZStr s) (lengthFZS s) Empty @@ -322,11 +344,6 @@ ztext s = textBeside_ (ZStr s) (lengthFZS s) Empty sizedText :: Int -> String -> Doc sizedText l s = textBeside_ (Str s) l Empty --- | Some text, but without any width. Use for non-printing text --- such as a HTML or Latex tags -zeroWidthText :: String -> Doc -zeroWidthText = sizedText 0 - -- | The empty document, with no height and no width. -- 'empty' is the identity for '<>', '<+>', '$$' and '$+$', and anywhere -- in the argument list for 'sep', 'hcat', 'hsep', 'vcat', 'fcat' etc. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fb415b18baf61b8f7aeec4a01652de6154f08850 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fb415b18baf61b8f7aeec4a01652de6154f08850 You're receiving 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 Mar 26 23:48:15 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Thu, 26 Mar 2020 19:48:15 -0400 Subject: [Git][ghc/ghc][wip/T16296] 6 commits: Do not panic on linker errors Message-ID: <5e7d3f3f1cc16_616776d1c748766ba@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T16296 at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - f299ed57 by Simon Peyton Jones at 2020-03-26T23:47:54+00: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 There's a 4.6% metric decrease here: Metric Decrease: T9961 - - - - - 12 changed files: - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm/Config.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Op/ConstantFold.hs - compiler/GHC/Core/Op/FloatIn.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4d63f94c181dfaf0b4ceeda76afd3284927a3351...f299ed573c8b560b8ef7e10ba16d598a1a479b41 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4d63f94c181dfaf0b4ceeda76afd3284927a3351...f299ed573c8b560b8ef7e10ba16d598a1a479b41 You're receiving 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 Mar 27 00:06:31 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Thu, 26 Mar 2020 20:06:31 -0400 Subject: [Git][ghc/ghc][wip/T17923] Significant refactor of Lint Message-ID: <5e7d43872f85c_6167120434ec8792c2@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T17923 at Glasgow Haskell Compiler / GHC Commits: 92cbc212 by Simon Peyton Jones at 2020-03-27T00:05:52+00: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. - - - - - 4 changed files: - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Type.hs - + testsuite/tests/indexed-types/should_compile/T17923.hs - testsuite/tests/indexed-types/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -8,7 +8,7 @@ See Note [Core Lint guarantee]. -} {-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE ScopedTypeVariables, DeriveFunctor #-} module GHC.Core.Lint ( lintCoreBindings, lintUnfolding, @@ -33,7 +33,6 @@ import GHC.Core.Op.Monad import Bag import Literal import GHC.Core.DataCon -import TysWiredIn import TysPrim import TcType ( isFloatingTy ) import Var @@ -461,14 +460,17 @@ lintCoreBindings :: DynFlags -> CoreToDo -> [Var] -> CoreProgram -> (Bag MsgDoc, lintCoreBindings dflags pass local_in_scope binds = initL dflags flags local_in_scope $ addLoc TopLevelBindings $ - lintLetBndrs TopLevel binders $ - -- Put all the top-level binders in scope at the start - -- This is because transformation rules can bring something - -- into use 'unexpectedly' do { checkL (null dups) (dupVars dups) ; checkL (null ext_dups) (dupExtVars ext_dups) - ; mapM lint_bind binds } + ; lintRecBindings TopLevel all_pairs $ + return () } where + all_pairs = flattenBinds binds + -- Put all the top-level binders in scope at the start + -- This is because transformation rules can bring something + -- into use 'unexpectedly'; see Note [Glomming] in OccurAnal + binders = map fst all_pairs + flags = defaultLintFlags { lf_check_global_ids = check_globals , lf_check_inline_loop_breakers = check_lbs @@ -494,7 +496,6 @@ lintCoreBindings dflags pass local_in_scope binds CorePrep -> AllowAtTopLevel _ -> AllowAnywhere - binders = bindersOfBinds binds (_, dups) = removeDups compare binders -- dups_ext checks for names with different uniques @@ -509,11 +510,6 @@ lintCoreBindings dflags pass local_in_scope binds = compare (m1, nameOccName n1) (m2, nameOccName n2) | otherwise = LT - -- If you edit this function, you may need to update the GHC formalism - -- See Note [GHC Formalism] - lint_bind (Rec prs) = mapM_ (lintSingleBinding TopLevel Recursive) prs - lint_bind (NonRec bndr rhs) = lintSingleBinding TopLevel NonRecursive (bndr,rhs) - {- ************************************************************************ * * @@ -576,28 +572,32 @@ lintExpr dflags vars expr Check a core binding, returning the list of variables bound. -} -lintSingleBinding :: TopLevelFlag -> RecFlag -> (Id, CoreExpr) -> LintM () --- If you edit this function, you may need to update the GHC formalism --- See Note [GHC Formalism] -lintSingleBinding top_lvl_flag rec_flag (binder,rhs) - = addLoc (RhsOf binder) $ - -- Check the rhs - do { ty <- lintRhs binder rhs - ; binder_ty <- applySubstTy (idType binder) - ; ensureEqTys binder_ty ty (mkRhsMsg binder (text "RHS") ty) +lintRecBindings :: TopLevelFlag -> [(Id, CoreExpr)] + -> LintM a -> LintM a +lintRecBindings top_lvl pairs thing_inside + = lintIdBndrs top_lvl bndrs $ \ bndrs' -> + do { zipWithM_ lint_pair bndrs' rhss + ; thing_inside } + where + (bndrs, rhss) = unzip pairs + lint_pair bndr' rhs + = addLoc (RhsOf bndr') $ + do { rhs_ty <- lintRhs bndr' rhs -- Check the rhs + ; lintLetBind top_lvl Recursive bndr' rhs rhs_ty } + +lintLetBind :: TopLevelFlag -> RecFlag -> LintedId + -> CoreExpr -> LintedType -> LintM () +-- Binder's type, and the RHS, have already been linted +-- This function checks other invariants +lintLetBind top_lvl rec_flag binder rhs rhs_ty + = do { let binder_ty = idType binder + ; ensureEqTys binder_ty rhs_ty (mkRhsMsg binder (text "RHS") rhs_ty) -- If the binding is for a CoVar, the RHS should be (Coercion co) -- See Note [Core type and coercion invariant] in GHC.Core ; checkL (not (isCoVar binder) || isCoArg rhs) (mkLetErr binder rhs) - -- Check that it's not levity-polymorphic - -- Do this first, because otherwise isUnliftedType panics - -- Annoyingly, this duplicates the test in lintIdBdr, - -- because for non-rec lets we call lintSingleBinding first - ; checkL (isJoinId binder || not (isTypeLevPoly binder_ty)) - (badBndrTyMsg binder (text "levity-polymorphic")) - -- Check the let/app invariant -- See Note [Core let/app invariant] in GHC.Core ; checkL ( isJoinId binder @@ -610,14 +610,14 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs) -- 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_flag)) + || (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]. - ; checkL (not (isTopLevel top_lvl_flag && binder_ty `eqType` addrPrimTy) + ; checkL (not (isTopLevel top_lvl && binder_ty `eqType` addrPrimTy) || exprIsTickedString rhs) (mkTopNonLitStrMsg binder) @@ -674,7 +674,9 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs) -- join point. -- -- See Note [Checking StaticPtrs]. -lintRhs :: Id -> CoreExpr -> LintM OutType +lintRhs :: Id -> CoreExpr -> LintM LintedType +-- NB: the Id can be Linted or not -- it's only used for +-- its OccInfo and join-pointer-hood lintRhs bndr rhs | Just arity <- isJoinId_maybe bndr = lint_join_lams arity arity True rhs @@ -761,13 +763,14 @@ hurts us here. ************************************************************************ -} --- For OutType, OutKind, the substitution has been applied, --- but has not been linted yet - -type LintedType = Type -- Substitution applied, and type is linted -type LintedKind = Kind +-- Linted things: substitution applied, and type is linted +type LintedType = Type +type LintedKind = Kind +type LintedCoercion = Coercion +type LintedTyCoVar = TyCoVar +type LintedId = Id -lintCoreExpr :: CoreExpr -> LintM OutType +lintCoreExpr :: CoreExpr -> LintM LintedType -- The returned type has the substitution from the monad -- already applied to it: -- lintCoreExpr e subst = exprType (subst e) @@ -776,18 +779,20 @@ lintCoreExpr :: CoreExpr -> LintM OutType -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] + lintCoreExpr (Var var) - = lintVarOcc var 0 + = lintIdOcc var 0 lintCoreExpr (Lit lit) = return (literalType lit) lintCoreExpr (Cast expr co) = do { expr_ty <- markAllJoinsBad $ lintCoreExpr expr - ; co' <- applySubstCo co - ; (_, k2, from_ty, to_ty, r) <- lintCoercion co' - ; checkValueKind k2 (text "target of cast" <+> quotes (ppr co)) - ; lintRole co' Representational r + ; co' <- lintCoercion co + ; let (Pair from_ty to_ty, role) = coercionKindRole co' + ; checkValueType to_ty $ + text "target of cast" <+> quotes (ppr co') + ; lintRole co' Representational role ; ensureEqTys from_ty expr_ty (mkCastErr expr co' from_ty expr_ty) ; return to_ty } @@ -809,7 +814,7 @@ lintCoreExpr (Tick tickish expr) lintCoreExpr (Let (NonRec tv (Type ty)) body) | isTyVar tv = -- See Note [Linting type lets] - do { ty' <- applySubstTy ty + do { ty' <- lintType ty ; lintTyBndr tv $ \ tv' -> do { addLoc (RhsOf tv) $ lintTyKind tv' ty' -- Now extend the substitution so we @@ -820,33 +825,34 @@ lintCoreExpr (Let (NonRec tv (Type ty)) body) lintCoreExpr (Let (NonRec bndr rhs) body) | isId bndr - = do { lintSingleBinding NotTopLevel NonRecursive (bndr,rhs) - ; addLoc (BodyOfLetRec [bndr]) - (lintBinder LetBind bndr $ \_ -> - addGoodJoins [bndr] $ - lintCoreExpr body) } + = do { -- First Lint the RHS, before bringing the binder into scope + rhs_ty <- lintRhs bndr rhs + + -- Now lint the binder + ; lintBinder LetBind bndr $ \bndr' -> + do { lintLetBind NotTopLevel NonRecursive bndr' rhs rhs_ty + ; addLoc (BodyOfLetRec [bndr]) (lintCoreExpr body) } } | otherwise = failWithL (mkLetErr bndr rhs) -- Not quite accurate lintCoreExpr e@(Let (Rec pairs) body) - = lintLetBndrs NotTopLevel bndrs $ - addGoodJoins bndrs $ - do { -- Check that the list of pairs is non-empty + = do { -- Check that the list of pairs is non-empty checkL (not (null pairs)) (emptyRec e) -- Check that there are no duplicated binders + ; let (_, dups) = removeDups compare bndrs ; checkL (null dups) (dupVars dups) -- Check that either all the binders are joins, or none ; checkL (all isJoinId bndrs || all (not . isJoinId) bndrs) $ - mkInconsistentRecMsg bndrs + mkInconsistentRecMsg bndrs - ; mapM_ (lintSingleBinding NotTopLevel Recursive) pairs - ; addLoc (BodyOfLetRec bndrs) (lintCoreExpr body) } + ; lintRecBindings NotTopLevel pairs $ + addLoc (BodyOfLetRec bndrs) $ + lintCoreExpr body } where bndrs = map fst pairs - (_, dups) = removeDups compare bndrs lintCoreExpr e@(App _ _) = do { fun_ty <- lintCoreFun fun (length args) @@ -867,23 +873,35 @@ lintCoreExpr (Type ty) = failWithL (text "Type found as expression" <+> ppr ty) lintCoreExpr (Coercion co) - = do { (k1, k2, ty1, ty2, role) <- lintInCo co - ; return (mkHeteroCoercionType role k1 k2 ty1 ty2) } + = do { co' <- addLoc (InCo co) $ + lintCoercion co + ; return (coercionType co') } ---------------------- -lintVarOcc :: Var -> Int -- Number of arguments (type or value) being passed - -> LintM Type -- returns type of the *variable* -lintVarOcc var nargs - = do { checkL (isNonCoVarId var) +lintIdOcc :: Var -> Int -- Number of arguments (type or value) being passed + -> LintM LintedType -- returns type of the *variable* +lintIdOcc var nargs + = addLoc (OccOf var) $ + do { checkL (isNonCoVarId var) (text "Non term variable" <+> ppr var) -- See GHC.Core Note [Variable occurrences in Core] -- Check that the type of the occurrence is the same - -- as the type of the binding site - ; ty <- applySubstTy (idType var) - ; var' <- lookupIdInScope var - ; let ty' = idType var' - ; ensureEqTys ty ty' $ mkBndrOccTypeMismatchMsg var' var ty' ty + -- as the type of the binding site. The inScopeIds are + -- /un-substituted/, so this checks that the occurrence type + -- is identical to the binder type. + -- This makes things much easier for things like: + -- /\a. \(x::Maybe a). /\a. ...(x::Maybe a)... + -- The "::Maybe a" on the occurrence is referring to the /outer/ a. + -- If we compared /substituted/ types we'd risk comparing + -- (Maybe a) from the binding site with bogus (Maybe a1) from + -- the occurrence site. Comparing un-substituted types finesses + -- this altogether + ; (bndr, linted_bndr_ty) <- lookupIdInScope var + ; let occ_ty = idType var + bndr_ty = idType bndr + ; ensureEqTys occ_ty bndr_ty $ + mkBndrOccTypeMismatchMsg bndr var bndr_ty occ_ty -- Check for a nested occurrence of the StaticPtr constructor. -- See Note [Checking StaticPtrs]. @@ -895,13 +913,13 @@ lintVarOcc var nargs ; checkDeadIdOcc var ; checkJoinOcc var nargs - ; return (idType var') } + ; return linted_bndr_ty } lintCoreFun :: CoreExpr - -> Int -- Number of arguments (type or val) being passed - -> LintM Type -- Returns type of the *function* + -> Int -- Number of arguments (type or val) being passed + -> LintM LintedType -- Returns type of the *function* lintCoreFun (Var var) nargs - = lintVarOcc var nargs + = lintIdOcc var nargs lintCoreFun (Lam var body) nargs -- Act like lintCoreExpr of Lam, but *don't* call markAllJoinsBad; see @@ -941,7 +959,9 @@ checkJoinOcc var n_args = do { mb_join_arity_bndr <- lookupJoinId var ; case mb_join_arity_bndr of { Nothing -> -- Binder is not a join point - addErrL (invalidJoinOcc var) ; + do { join_set <- getValidJoins + ; addErrL (text "join set " <+> ppr join_set $$ + invalidJoinOcc var) } ; Just join_arity_bndr -> @@ -1038,15 +1058,15 @@ subtype of the required type, as one would expect. -} -lintCoreArgs :: OutType -> [CoreArg] -> LintM OutType +lintCoreArgs :: LintedType -> [CoreArg] -> LintM LintedType lintCoreArgs fun_ty args = foldM lintCoreArg fun_ty args -lintCoreArg :: OutType -> CoreArg -> LintM OutType +lintCoreArg :: LintedType -> CoreArg -> LintM LintedType lintCoreArg fun_ty (Type arg_ty) = do { checkL (not (isCoercionTy arg_ty)) (text "Unnecessary coercion-to-type injection:" <+> ppr arg_ty) - ; arg_ty' <- applySubstTy arg_ty + ; arg_ty' <- lintType arg_ty ; lintTyApp fun_ty arg_ty' } lintCoreArg fun_ty arg @@ -1060,11 +1080,12 @@ lintCoreArg fun_ty arg ; checkL (not (isUnliftedType arg_ty) || exprOkForSpeculation arg) (mkLetAppMsg arg) + ; lintValApp arg fun_ty arg_ty } ----------------- -lintAltBinders :: OutType -- Scrutinee type - -> OutType -- Constructor type +lintAltBinders :: LintedType -- Scrutinee type + -> LintedType -- Constructor type -> [OutVar] -- Binders -> LintM () -- If you edit this function, you may need to update the GHC formalism @@ -1080,7 +1101,7 @@ lintAltBinders scrut_ty con_ty (bndr:bndrs) ; lintAltBinders scrut_ty con_ty' bndrs } ----------------- -lintTyApp :: OutType -> OutType -> LintM OutType +lintTyApp :: LintedType -> LintedType -> LintM LintedType lintTyApp fun_ty arg_ty | Just (tv,body_ty) <- splitForAllTy_maybe fun_ty = do { lintTyKind tv arg_ty @@ -1094,7 +1115,7 @@ lintTyApp fun_ty arg_ty = failWithL (mkTyAppMsg fun_ty arg_ty) ----------------- -lintValApp :: CoreExpr -> OutType -> OutType -> LintM OutType +lintValApp :: CoreExpr -> LintedType -> LintedType -> LintM LintedType lintValApp arg fun_ty arg_ty | Just (arg,res) <- splitFunTy_maybe fun_ty = do { ensureEqTys arg arg_ty err1 @@ -1105,17 +1126,17 @@ lintValApp arg fun_ty arg_ty err1 = mkAppMsg fun_ty arg_ty arg err2 = mkNonFunAppMsg fun_ty arg_ty arg -lintTyKind :: OutTyVar -> OutType -> LintM () +lintTyKind :: OutTyVar -> LintedType -> LintM () -- Both args have had substitution applied -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] lintTyKind tyvar arg_ty - = do { arg_kind <- lintType arg_ty - ; unless (arg_kind `eqType` tyvar_kind) - (addErrL (mkKindErrMsg tyvar arg_ty $$ (text "Linted Arg kind:" <+> ppr arg_kind))) } + = unless (arg_kind `eqType` tyvar_kind) $ + addErrL (mkKindErrMsg tyvar arg_ty $$ (text "Linted Arg kind:" <+> ppr arg_kind)) where tyvar_kind = tyVarKind tyvar + arg_kind = typeKind arg_ty {- ************************************************************************ @@ -1125,7 +1146,7 @@ lintTyKind tyvar arg_ty ************************************************************************ -} -lintCaseExpr :: CoreExpr -> Id -> Type -> [CoreAlt] -> LintM OutType +lintCaseExpr :: CoreExpr -> Id -> Type -> [CoreAlt] -> LintM LintedType lintCaseExpr scrut var alt_ty alts = do { let e = Case scrut var alt_ty alts -- Just for error messages @@ -1134,10 +1155,10 @@ lintCaseExpr scrut var alt_ty alts = -- See Note [Join points are less general than the paper] -- in GHC.Core - ; (alt_ty, _) <- addLoc (CaseTy scrut) $ - lintInTy alt_ty - ; (var_ty, _) <- addLoc (IdTy var) $ - lintInTy (idType var) + ; alt_ty <- addLoc (CaseTy scrut) $ + lintValueType alt_ty + ; var_ty <- addLoc (IdTy var) $ + lintValueType (idType var) -- We used to try to check whether a case expression with no -- alternatives was legitimate, but this didn't work. @@ -1179,7 +1200,7 @@ lintCaseExpr scrut var alt_ty alts = ; checkCaseAlts e scrut_ty alts ; return alt_ty } } -checkCaseAlts :: CoreExpr -> OutType -> [CoreAlt] -> LintM () +checkCaseAlts :: CoreExpr -> LintedType -> [CoreAlt] -> LintM () -- a) Check that the alts are non-empty -- b1) Check that the DEFAULT comes first, if it exists -- b2) Check that the others are in increasing order @@ -1219,14 +1240,14 @@ checkCaseAlts e ty alts = Nothing -> False Just tycon -> isPrimTyCon tycon -lintAltExpr :: CoreExpr -> OutType -> LintM () +lintAltExpr :: CoreExpr -> LintedType -> LintM () lintAltExpr expr ann_ty = do { actual_ty <- lintCoreExpr expr ; ensureEqTys actual_ty ann_ty (mkCaseAltMsg expr actual_ty ann_ty) } -- See GHC.Core Note [Case expression invariants] item (6) -lintCoreAlt :: OutType -- Type of scrutinee - -> OutType -- Type of the alternative +lintCoreAlt :: LintedType -- Type of scrutinee + -> LintedType -- Type of the alternative -> CoreAlt -> LintM () -- If you edit this function, you may need to update the GHC formalism @@ -1286,40 +1307,43 @@ lintBinders site (var:vars) linterF = lintBinder site var $ \var' -> -- See Note [GHC Formalism] lintBinder :: BindingSite -> Var -> (Var -> LintM a) -> LintM a lintBinder site var linterF - | isTyVar var = lintTyBndr var linterF - | isCoVar var = lintCoBndr var linterF - | otherwise = lintIdBndr NotTopLevel site var linterF + | isTyCoVar var = lintTyCoBndr var linterF + | otherwise = lintIdBndr NotTopLevel site var linterF -lintTyBndr :: InTyVar -> (OutTyVar -> LintM a) -> LintM a -lintTyBndr tv thing_inside - = do { subst <- getTCvSubst - ; let (subst', tv') = substTyVarBndr subst tv - ; lintKind (varType tv') - ; updateTCvSubst subst' (thing_inside tv') } +lintTyBndr :: TyVar -> (LintedTyCoVar -> LintM a) -> LintM a +lintTyBndr = lintTyCoBndr -- We could specialise it, I guess + +-- lintCoBndr :: CoVar -> (LintedTyCoVar -> LintM a) -> LintM a +-- lintCoBndr = lintTyCoBndr -- We could specialise it, I guess -lintCoBndr :: InCoVar -> (OutCoVar -> LintM a) -> LintM a -lintCoBndr cv thing_inside +lintTyCoBndr :: TyCoVar -> (LintedTyCoVar -> LintM a) -> LintM a +lintTyCoBndr tcv thing_inside = do { subst <- getTCvSubst - ; let (subst', cv') = substCoVarBndr subst cv - ; lintKind (varType cv') - ; lintL (isCoVarType (varType cv')) - (text "CoVar with non-coercion type:" <+> pprTyVar cv) - ; updateTCvSubst subst' (thing_inside cv') } - -lintLetBndrs :: TopLevelFlag -> [Var] -> LintM a -> LintM a -lintLetBndrs top_lvl ids linterF - = go ids + ; kind' <- lintType (varType tcv) + ; let tcv' = uniqAway (getTCvInScope subst) $ + setVarType tcv kind' + subst' = extendTCvSubstWithClone subst tcv tcv' + ; when (isCoVar tcv) $ + lintL (isCoVarType kind') + (text "CoVar with non-coercion type:" <+> pprTyVar tcv) + ; updateTCvSubst subst' (thing_inside tcv') } + +lintIdBndrs :: forall a. TopLevelFlag -> [Id] -> ([LintedId] -> LintM a) -> LintM a +lintIdBndrs top_lvl ids thing_inside + = go ids thing_inside where - go [] = linterF - go (id:ids) = lintIdBndr top_lvl LetBind id $ \_ -> - go ids + go :: [Id] -> ([Id] -> LintM a) -> LintM a + go [] thing_inside = thing_inside [] + go (id:ids) thing_inside = lintIdBndr top_lvl LetBind id $ \id' -> + go ids $ \ids' -> + thing_inside (id' : ids') lintIdBndr :: TopLevelFlag -> BindingSite -> InVar -> (OutVar -> LintM a) -> LintM a -- Do substitution on the type of a binder and add the var with this -- new type to the in-scope set of the second argument -- ToDo: lint its rules -lintIdBndr top_lvl bind_site id linterF +lintIdBndr top_lvl bind_site id thing_inside = ASSERT2( isId id, ppr id ) do { flags <- getLintFlags ; checkL (not (lf_check_global_ids flags) || isLocalId id) @@ -1334,14 +1358,11 @@ lintIdBndr top_lvl bind_site id linterF ; checkL (not (isExternalName (Var.varName id)) || is_top_lvl) (mkNonTopExternalNameMsg id) - ; (id_ty, k) <- addLoc (IdTy id) $ - lintInTy (idType id) - ; let id' = setIdType id id_ty - -- See Note [Levity polymorphism invariants] in GHC.Core - ; lintL (isJoinId id || not (lf_check_levity_poly flags) || not (isKindLevPoly k)) - (text "Levity-polymorphic binder:" <+> - (ppr id <+> dcolon <+> parens (ppr id_ty <+> dcolon <+> ppr k))) + ; lintL (isJoinId id || not (lf_check_levity_poly flags) + || not (isTypeLevPoly id_ty)) $ + text "Levity-polymorphic binder:" <+> ppr id <+> dcolon <+> + parens (ppr id_ty <+> dcolon <+> ppr (typeKind id_ty)) -- Check that a join-id is a not-top-level let-binding ; when (isJoinId id) $ @@ -1353,8 +1374,13 @@ lintIdBndr top_lvl bind_site id linterF ; lintL (not (isCoVarType id_ty)) (text "Non-CoVar has coercion type" <+> ppr id <+> dcolon <+> ppr id_ty) - ; addInScopeId id' $ (linterF id') } + ; linted_ty <- addLoc (IdTy id) (lintValueType id_ty) + + ; addInScopeId id linted_ty $ + thing_inside (setIdType id linted_ty) } where + id_ty = idType id + is_top_lvl = isTopLevel top_lvl is_let_bind = case bind_site of LetBind -> True @@ -1378,45 +1404,58 @@ lintTypes dflags vars tys where (_warns, errs) = initL dflags defaultLintFlags vars linter linter = lintBinders LambdaBind vars $ \_ -> - mapM_ lintInTy tys + mapM_ lintType tys -lintInTy :: InType -> LintM (LintedType, LintedKind) +lintValueType :: Type -> LintM LintedType -- Types only, not kinds -- Check the type, and apply the substitution to it -- See Note [Linting type lets] -lintInTy ty +lintValueType ty = addLoc (InType ty) $ - do { ty' <- applySubstTy ty - ; k <- lintType ty' - ; addLoc (InKind ty' k) $ - lintKind k -- The kind returned by lintType is already - -- a LintedKind but we also want to check that - -- k :: *, which lintKind does - ; return (ty', k) } + do { ty' <- lintType ty + ; let sk = typeKind ty' + ; lintL (classifiesTypeWithValues sk) $ + hang (text "Ill-kinded type:" <+> ppr ty) + 2 (text "has kind:" <+> ppr sk) + ; return ty' } checkTyCon :: TyCon -> LintM () checkTyCon tc = checkL (not (isTcTyCon tc)) (text "Found TcTyCon:" <+> ppr tc) ------------------- -lintType :: OutType -> LintM LintedKind --- The returned Kind has itself been linted +lintType :: LintedType -> LintM LintedType -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] lintType (TyVarTy tv) - = do { checkL (isTyVar tv) (mkBadTyVarMsg tv) - ; tv' <- lintTyCoVarInScope tv - ; return (tyVarKind tv') } - -- We checked its kind when we added it to the envt + | not (isTyVar tv) + = failWithL (mkBadTyVarMsg tv) + + | otherwise + = do { subst <- getTCvSubst + ; case lookupTyVar subst tv of + Just linted_ty -> return linted_ty + + -- In GHCi we may lint an expression with a free + -- type variable. Then it won't be in the + -- substitution, but it should be in scope + Nothing | tv `isInScope` subst + -> return (TyVarTy tv) + | otherwise + -> failWithL $ + hang (text "The type variable" <+> pprBndr LetBind tv) + 2 (text "is out of scope") + } lintType ty@(AppTy t1 t2) | TyConApp {} <- t1 = failWithL $ text "TyConApp to the left of AppTy:" <+> ppr ty | otherwise - = do { k1 <- lintType t1 - ; k2 <- lintType t2 - ; lint_ty_app ty k1 [(t2,k2)] } + = do { t1' <- lintType t1 + ; t2' <- lintType t2 + ; lint_ty_app ty (typeKind t1') [t2'] + ; return (AppTy t1' t2') } lintType ty@(TyConApp tc tys) | isTypeSynonymTyCon tc || isTypeFamilyTyCon tc @@ -1433,71 +1472,72 @@ lintType ty@(TyConApp tc tys) | otherwise -- Data types, data families, primitive types = do { checkTyCon tc - ; ks <- mapM lintType tys - ; lint_ty_app ty (tyConKind tc) (tys `zip` ks) } + ; tys' <- mapM lintType tys + ; lint_ty_app ty (tyConKind tc) tys' + ; return (TyConApp tc tys') } -- arrows can related *unlifted* kinds, so this has to be separate from -- a dependent forall. -lintType ty@(FunTy _ t1 t2) - = do { k1 <- lintType t1 - ; k2 <- lintType t2 - ; lintArrow (text "type or kind" <+> quotes (ppr ty)) k1 k2 } +lintType ty@(FunTy af t1 t2) + = do { t1' <- lintType t1 + ; t2' <- lintType t2 + ; lintArrow (text "type or kind" <+> quotes (ppr ty)) t1' t2' + ; return (FunTy af t1' t2') } + +lintType ty@(ForAllTy (Bndr tcv vis) body_ty) + | not (isTyCoVar tcv) + = failWithL (text "Non-Tyvar or Non-Covar bound in type:" <+> ppr ty) + | otherwise + = lintTyCoBndr tcv $ \tcv' -> + do { body_ty' <- lintType body_ty + ; lintForAllBody tcv' body_ty' -lintType t@(ForAllTy (Bndr tv _vis) ty) - -- forall over types - | isTyVar tv - = lintTyBndr tv $ \tv' -> - do { k <- lintType ty - ; checkValueKind k (text "the body of forall:" <+> ppr t) - ; case occCheckExpand [tv'] k of -- See Note [Stupid type synonyms] - Just k' -> return k' - Nothing -> failWithL (hang (text "Variable escape in forall:") - 2 (vcat [ text "type:" <+> ppr t - , text "kind:" <+> ppr k ])) - } + ; when (isCoVar tcv) $ + lintL (tcv `elemVarSet` tyCoVarsOfType body_ty) $ + text "Covar does not occur in the body:" <+> (ppr tcv $$ ppr body_ty) + -- See GHC.Core.TyCo.Rep Note [Unused coercion variable in ForAllTy] + -- and cf GHC.Core.Coercion Note [Unused coercion variable in ForAllCo] + + ; return (ForAllTy (Bndr tcv' vis) body_ty') } -lintType t@(ForAllTy (Bndr cv _vis) ty) - -- forall over coercions - = do { lintL (isCoVar cv) - (text "Non-Tyvar or Non-Covar bound in type:" <+> ppr t) - ; lintL (cv `elemVarSet` tyCoVarsOfType ty) - (text "Covar does not occur in the body:" <+> ppr t) - ; lintCoBndr cv $ \_ -> - do { k <- lintType ty - ; checkValueKind k (text "the body of forall:" <+> ppr t) - ; return liftedTypeKind - -- We don't check variable escape here. Namely, k could refer to cv' - }} - -lintType ty@(LitTy l) = lintTyLit l >> return (typeKind ty) +lintType ty@(LitTy l) + = do { lintTyLit l; return ty } lintType (CastTy ty co) - = do { k1 <- lintType ty - ; (k1', k2) <- lintStarCoercion co - ; ensureEqTys k1 k1' (mkCastTyErr ty co k1' k1) - ; return k2 } + = do { ty' <- lintType ty + ; co' <- lintStarCoercion co + ; let tyk = typeKind ty' + cok = coercionLKind co' + ; ensureEqTys tyk cok (mkCastTyErr ty co tyk cok) + ; return (CastTy ty' co') } lintType (CoercionTy co) - = do { (k1, k2, ty1, ty2, r) <- lintCoercion co - ; return $ mkHeteroCoercionType r k1 k2 ty1 ty2 } - -{- Note [Stupid type synonyms] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider (#14939) - type Alg cls ob = ob - f :: forall (cls :: * -> Constraint) (b :: Alg cls *). b - -Here 'cls' appears free in b's kind, which would usually be illegal -(because in (forall a. ty), ty's kind should not mention 'a'). But -#in this case (Alg cls *) = *, so all is well. Currently we allow -this, and make Lint expand synonyms where necessary to make it so. - -c.f. TcUnify.occCheckExpand and GHC.Core.Utils.coreAltsType which deal -with the same problem. A single systematic solution eludes me. --} + = do { co' <- lintCoercion co + ; return (CoercionTy co') } + +----------------- +lintForAllBody :: LintedTyCoVar -> LintedType -> LintM () +-- Do the checks for the body of a forall-type +lintForAllBody tcv body_ty + = do { checkValueType body_ty (text "the body of forall:" <+> ppr body_ty) + + -- For type variables, check for skolem escape + -- See Note [Phantom type variables in kinds] in GHC.Core.Type + -- The kind of (forall cv. th) is liftedTypeKind, so no + -- need to check for skolem-escape in the CoVar case + ; let body_kind = typeKind body_ty + ; when (isTyVar tcv) $ + case occCheckExpand [tcv] body_kind of + Just {} -> return () + Nothing -> failWithL $ + hang (text "Variable escape in forall:") + 2 (vcat [ text "tyvar:" <+> ppr tcv + , text "type:" <+> ppr body_ty + , text "kind:" <+> ppr body_kind ]) + } ----------------- -lintTySynFamApp :: Bool -> Type -> TyCon -> [Type] -> LintM LintedKind +lintTySynFamApp :: Bool -> InType -> TyCon -> [InType] -> LintM LintedType -- The TyCon is a type synonym or a type family (not a data family) -- See Note [Linting type synonym applications] -- c.f. TcValidity.check_syn_tc_app @@ -1511,58 +1551,54 @@ lintTySynFamApp report_unsat ty tc tys , let expanded_ty = mkAppTys (substTy (mkTvSubstPrs tenv) rhs) tys' = do { -- Kind-check the argument types, but without reporting -- un-saturated type families/synonyms - ks <- setReportUnsat False (mapM lintType tys) + tys' <- setReportUnsat False (mapM lintType tys) ; when report_unsat $ do { _ <- lintType expanded_ty ; return () } - ; lint_ty_app ty (tyConKind tc) (tys `zip` ks) } + ; lint_ty_app ty (tyConKind tc) tys' + ; return (TyConApp tc tys') } -- Otherwise this must be a type family | otherwise - = do { ks <- mapM lintType tys - ; lint_ty_app ty (tyConKind tc) (tys `zip` ks) } - ------------------ -lintKind :: OutKind -> LintM () --- If you edit this function, you may need to update the GHC formalism --- See Note [GHC Formalism] -lintKind k = do { sk <- lintType k - ; unless (classifiesTypeWithValues sk) - (addErrL (hang (text "Ill-kinded kind:" <+> ppr k) - 2 (text "has kind:" <+> ppr sk))) } + = do { tys' <- mapM lintType tys + ; lint_ty_app ty (tyConKind tc) tys' + ; return (TyConApp tc tys') } ----------------- -- Confirms that a type is really *, #, Constraint etc -checkValueKind :: OutKind -> SDoc -> LintM () -checkValueKind k doc - = lintL (classifiesTypeWithValues k) - (text "Non-*-like kind when *-like expected:" <+> ppr k $$ +checkValueType :: LintedType -> SDoc -> LintM () +checkValueType ty doc + = lintL (classifiesTypeWithValues kind) + (text "Non-*-like kind when *-like expected:" <+> ppr kind $$ text "when checking" <+> doc) + where + kind = typeKind ty ----------------- -lintArrow :: SDoc -> LintedKind -> LintedKind -> LintM LintedKind +lintArrow :: SDoc -> LintedType -> LintedType -> LintM () -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] -lintArrow what k1 k2 -- Eg lintArrow "type or kind `blah'" k1 k2 +lintArrow what t1 t2 -- Eg lintArrow "type or kind `blah'" k1 k2 -- or lintArrow "coercion `blah'" k1 k2 = do { unless (classifiesTypeWithValues k1) (addErrL (msg (text "argument") k1)) - ; unless (classifiesTypeWithValues k2) (addErrL (msg (text "result") k2)) - ; return liftedTypeKind } + ; unless (classifiesTypeWithValues k2) (addErrL (msg (text "result") k2)) } where + k1 = typeKind t1 + k2 = typeKind t2 msg ar k = vcat [ hang (text "Ill-kinded" <+> ar) 2 (text "in" <+> what) , what <+> text "kind:" <+> ppr k ] ----------------- -lint_ty_app :: Type -> LintedKind -> [(LintedType,LintedKind)] -> LintM LintedKind +lint_ty_app :: Type -> LintedKind -> [LintedType] -> LintM () lint_ty_app ty k tys = lint_app (text "type" <+> quotes (ppr ty)) k tys ---------------- -lint_co_app :: Coercion -> LintedKind -> [(LintedType,LintedKind)] -> LintM LintedKind +lint_co_app :: Coercion -> LintedKind -> [LintedType] -> LintM () lint_co_app ty k tys = lint_app (text "coercion" <+> quotes (ppr ty)) k tys @@ -1574,42 +1610,45 @@ lintTyLit (NumTyLit n) where msg = text "Negative type literal:" <+> integer n lintTyLit (StrTyLit _) = return () -lint_app :: SDoc -> LintedKind -> [(LintedType,LintedKind)] -> LintM Kind +lint_app :: SDoc -> LintedKind -> [LintedType] -> LintM () -- (lint_app d fun_kind arg_tys) -- We have an application (f arg_ty1 .. arg_tyn), -- where f :: fun_kind --- Takes care of linting the OutTypes -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] -lint_app doc kfn kas +lint_app doc kfn arg_tys = do { in_scope <- getInScope -- We need the in_scope set to satisfy the invariant in -- Note [The substitution invariant] in GHC.Core.TyCo.Subst - ; foldlM (go_app in_scope) kfn kas } + ; _ <- foldlM (go_app in_scope) kfn arg_tys + ; return () } where fail_msg extra = vcat [ hang (text "Kind application error in") 2 doc , nest 2 (text "Function kind =" <+> ppr kfn) - , nest 2 (text "Arg kinds =" <+> ppr kas) + , nest 2 (text "Arg types =" <+> ppr arg_tys) , extra ] - go_app in_scope kfn tka + go_app in_scope kfn ta | Just kfn' <- coreView kfn - = go_app in_scope kfn' tka + = go_app in_scope kfn' ta - go_app _ (FunTy _ kfa kfb) tka@(_,ka) - = do { unless (ka `eqType` kfa) $ - addErrL (fail_msg (text "Fun:" <+> (ppr kfa $$ ppr tka))) + go_app _ fun_kind@(FunTy _ kfa kfb) ta + = do { let ka = typeKind ta + ; unless (ka `eqType` kfa) $ + addErrL (fail_msg (text "Fun:" <+> (ppr fun_kind $$ ppr ta <+> dcolon <+> ppr ka))) ; return kfb } - go_app in_scope (ForAllTy (Bndr kv _vis) kfn) tka@(ta,ka) + go_app in_scope (ForAllTy (Bndr kv _vis) kfn) ta = do { let kv_kind = varType kv + ka = typeKind ta ; unless (ka `eqType` kv_kind) $ - addErrL (fail_msg (text "Forall:" <+> (ppr kv $$ ppr kv_kind $$ ppr tka))) + addErrL (fail_msg (text "Forall:" <+> (ppr kv $$ ppr kv_kind $$ + ppr ta <+> dcolon <+> ppr ka))) ; return $ substTy (extendTCvSubst (mkEmptyTCvSubst in_scope) kv ta) kfn } - go_app _ kfn ka - = failWithL (fail_msg (text "Not a fun:" <+> (ppr kfn $$ ppr ka))) + go_app _ kfn ta + = failWithL (fail_msg (text "Not a fun:" <+> (ppr kfn $$ ppr ta))) {- ********************************************************************* * * @@ -1617,7 +1656,7 @@ lint_app doc kfn kas * * ********************************************************************* -} -lintCoreRule :: OutVar -> OutType -> CoreRule -> LintM () +lintCoreRule :: OutVar -> LintedType -> CoreRule -> LintM () lintCoreRule _ _ (BuiltinRule {}) = return () -- Don't bother @@ -1710,68 +1749,94 @@ Note [Rules and join points] in OccurAnal for further discussion. ************************************************************************ -} -lintInCo :: InCoercion -> LintM (LintedKind, LintedKind, LintedType, LintedType, Role) --- Check the coercion, and apply the substitution to it --- See Note [Linting type lets] -lintInCo co - = addLoc (InCo co) $ - do { co' <- applySubstCo co - ; lintCoercion co' } +{- Note [Asymptotic efficiency] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When linting coercions (and types actually) we return a linted +(substituted) coercion. Then we often have to take the coercionKind of +that returned coercion. If we get long chains, that can be asymptotically +inefficient, notably in +* TransCo +* InstCo +* NthCo (cf #9233) +* LRCo + +But the code is simple. And this is only Lint. Let's wait to see if +the bad perf bites us in practice. + +A solution would be to return the kind and role of the coercion, +as well as the linted coercion. Or perhaps even *only* the kind and role, +which is what used to happen. But that proved tricky and error prone +(#17923), so now we return the coercion. +-} + -- lints a coercion, confirming that its lh kind and its rh kind are both * -- also ensures that the role is Nominal -lintStarCoercion :: OutCoercion -> LintM (LintedType, LintedType) +lintStarCoercion :: InCoercion -> LintM LintedCoercion lintStarCoercion g - = do { (k1, k2, t1, t2, r) <- lintCoercion g - ; checkValueKind k1 (text "the kind of the left type in" <+> ppr g) - ; checkValueKind k2 (text "the kind of the right type in" <+> ppr g) - ; lintRole g Nominal r - ; return (t1, t2) } - -lintCoercion :: OutCoercion -> LintM (LintedKind, LintedKind, LintedType, LintedType, Role) --- Check the kind of a coercion term, returning the kind --- Post-condition: the returned OutTypes are lint-free --- --- If lintCoercion co = (k1, k2, s1, s2, r) --- then co :: s1 ~r s2 --- s1 :: k1 --- s2 :: k2 - + = do { g' <- lintCoercion g + ; let Pair t1 t2 = coercionKind g' + ; checkValueType t1 (text "the kind of the left type in" <+> ppr g) + ; checkValueType t2 (text "the kind of the right type in" <+> ppr g) + ; lintRole g Nominal (coercionRole g) + ; return g' } + +lintCoercion :: InCoercion -> LintM LintedCoercion -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] + +lintCoercion (CoVarCo cv) + | not (isCoVar cv) + = failWithL (hang (text "Bad CoVarCo:" <+> ppr cv) + 2 (text "With offending type:" <+> ppr (varType cv))) + + | otherwise + = do { subst <- getTCvSubst + ; case lookupCoVar subst cv of + Just linted_co -> return linted_co ; + Nothing -> -- lintCoBndr always extends the substitition + failWithL $ + hang (text "The coercion variable" <+> pprBndr LetBind cv) + 2 (text "is out of scope") + } + + lintCoercion (Refl ty) - = do { k <- lintType ty - ; return (k, k, ty, ty, Nominal) } + = do { ty' <- lintType ty + ; return (Refl ty') } lintCoercion (GRefl r ty MRefl) - = do { k <- lintType ty - ; return (k, k, ty, ty, r) } + = do { ty' <- lintType ty + ; return (GRefl r ty' MRefl) } lintCoercion (GRefl r ty (MCo co)) - = do { k <- lintType ty - ; (_, _, k1, k2, r') <- lintCoercion co - ; ensureEqTys k k1 - (hang (text "GRefl coercion kind mis-match:" <+> ppr co) - 2 (vcat [ppr ty, ppr k, ppr k1])) - ; lintRole co Nominal r' - ; return (k1, k2, ty, mkCastTy ty co, r) } + = do { ty' <- lintType ty + ; co' <- lintCoercion co + ; let tk = typeKind ty' + tl = coercionLKind co' + ; ensureEqTys tk tl $ + hang (text "GRefl coercion kind mis-match:" <+> ppr co) + 2 (vcat [ppr ty', ppr tk, ppr tl]) + ; lintRole co' Nominal (coercionRole co') + ; return (GRefl r ty' (MCo co')) } lintCoercion co@(TyConAppCo r tc cos) | tc `hasKey` funTyConKey , [_rep1,_rep2,_co1,_co2] <- cos - = do { failWithL (text "Saturated TyConAppCo (->):" <+> ppr co) - } -- All saturated TyConAppCos should be FunCos + = failWithL (text "Saturated TyConAppCo (->):" <+> ppr co) + -- All saturated TyConAppCos should be FunCos | Just {} <- synTyConDefn_maybe tc = failWithL (text "Synonym in TyConAppCo:" <+> ppr co) | otherwise = do { checkTyCon tc - ; (k's, ks, ss, ts, rs) <- mapAndUnzip5M lintCoercion cos - ; k' <- lint_co_app co (tyConKind tc) (ss `zip` k's) - ; k <- lint_co_app co (tyConKind tc) (ts `zip` ks) - ; _ <- zipWith3M lintRole cos (tyConRolesX r tc) rs - ; return (k', k, mkTyConApp tc ss, mkTyConApp tc ts, r) } + ; cos' <- mapM lintCoercion cos + ; let (co_kinds, co_roles) = unzip (map coercionKindRole cos') + ; lint_co_app co (tyConKind tc) (map pFst co_kinds) + ; lint_co_app co (tyConKind tc) (map pSnd co_kinds) + ; zipWithM_ (lintRole co) (tyConRolesX r tc) co_roles + ; return (TyConAppCo r tc cos') } lintCoercion co@(AppCo co1 co2) | TyConAppCo {} <- co1 @@ -1779,111 +1844,75 @@ lintCoercion co@(AppCo co1 co2) | Just (TyConApp {}, _) <- isReflCo_maybe co1 = failWithL (text "Refl (TyConApp ...) to the left of AppCo:" <+> ppr co) | otherwise - = do { (k1, k2, s1, s2, r1) <- lintCoercion co1 - ; (k'1, k'2, t1, t2, r2) <- lintCoercion co2 - ; k3 <- lint_co_app co k1 [(t1,k'1)] - ; k4 <- lint_co_app co k2 [(t2,k'2)] + = do { co1' <- lintCoercion co1 + ; co2' <- lintCoercion co2 + ; let (Pair lk1 rk1, r1) = coercionKindRole co1' + (Pair lk2 rk2, r2) = coercionKindRole co2' + ; lint_co_app co (typeKind lk1) [lk2] + ; lint_co_app co (typeKind rk1) [rk2] + ; if r1 == Phantom then lintL (r2 == Phantom || r2 == Nominal) (text "Second argument in AppCo cannot be R:" $$ ppr co) else lintRole co Nominal r2 - ; return (k3, k4, mkAppTy s1 t1, mkAppTy s2 t2, r1) } + + ; return (AppCo co1' co2') } ---------- -lintCoercion (ForAllCo tv1 kind_co co) - -- forall over types - | isTyVar tv1 - = do { (_, k2) <- lintStarCoercion kind_co - ; let tv2 = setTyVarKind tv1 k2 - ; addInScopeTyCoVar tv1 $ - do { - ; (k3, k4, t1, t2, r) <- lintCoercion co - ; in_scope <- getInScope - ; let tyl = mkInvForAllTy tv1 t1 - subst = mkTvSubst in_scope $ - -- We need both the free vars of the `t2` and the - -- free vars of the range of the substitution in - -- scope. All the free vars of `t2` and `kind_co` should - -- already be in `in_scope`, because they've been - -- linted and `tv2` has the same unique as `tv1`. - -- See Note [The substitution invariant] in GHC.Core.TyCo.Subst. - unitVarEnv tv1 (TyVarTy tv2 `mkCastTy` mkSymCo kind_co) - tyr = mkInvForAllTy tv2 $ - substTy subst t2 - ; return (k3, k4, tyl, tyr, r) } } - -lintCoercion (ForAllCo cv1 kind_co co) - -- forall over coercions - = ASSERT( isCoVar cv1 ) - do { lintL (almostDevoidCoVarOfCo cv1 co) - (text "Covar can only appear in Refl and GRefl: " <+> ppr co) - ; (_, k2) <- lintStarCoercion kind_co - ; let cv2 = setVarType cv1 k2 - ; addInScopeTyCoVar cv1 $ - do { - ; (k3, k4, t1, t2, r) <- lintCoercion co - ; checkValueKind k3 (text "the body of a ForAllCo over covar:" <+> ppr co) - ; checkValueKind k4 (text "the body of a ForAllCo over covar:" <+> ppr co) - -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep - ; in_scope <- getInScope - ; let tyl = mkTyCoInvForAllTy cv1 t1 - r2 = coVarRole cv1 - kind_co' = downgradeRole r2 Nominal kind_co - eta1 = mkNthCo r2 2 kind_co' - eta2 = mkNthCo r2 3 kind_co' - subst = mkCvSubst in_scope $ - -- We need both the free vars of the `t2` and the - -- free vars of the range of the substitution in - -- scope. All the free vars of `t2` and `kind_co` should - -- already be in `in_scope`, because they've been - -- linted and `cv2` has the same unique as `cv1`. - -- See Note [The substitution invariant] in GHC.Core.TyCo.Subst. - unitVarEnv cv1 (eta1 `mkTransCo` (mkCoVarCo cv2) - `mkTransCo` (mkSymCo eta2)) - tyr = mkTyCoInvForAllTy cv2 $ - substTy subst t2 - ; return (liftedTypeKind, liftedTypeKind, tyl, tyr, r) } } - -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep +lintCoercion co@(ForAllCo tcv kind_co body_co) + | not (isTyCoVar tcv) + = failWithL (text "Non tyco binder in ForAllCo:" <+> ppr co) + | otherwise + = do { kind_co' <- lintStarCoercion kind_co + ; lintTyCoBndr tcv $ \tcv' -> + do { body_co' <- lintCoercion body_co + ; ensureEqTys (varType tcv') (coercionLKind kind_co') $ + text "Kind mis-match in ForallCo" <+> ppr co + + -- Assuming kind_co :: k1 ~ k2 + -- Need to check that + -- (forall (tcv:k1). lty) and + -- (forall (tcv:k2). rty[(tcv:k2) |> sym kind_co/tcv]) + -- are both well formed. Easiest way is to call lintForAllBody + -- for each; there is actually no need to do the funky substitution + ; let Pair lty rty = coercionKind body_co' + ; lintForAllBody tcv' lty + ; lintForAllBody tcv' rty + + ; when (isCoVar tcv) $ + lintL (almostDevoidCoVarOfCo tcv body_co) $ + text "Covar can only appear in Refl and GRefl: " <+> ppr co + -- See "last wrinkle" in GHC.Core.Coercion + -- Note [Unused coercion variable in ForAllCo] + -- and c.f. GHC.Core.TyCo.Rep Note [Unused coercion variable in ForAllTy] + + ; return (ForAllCo tcv' kind_co' body_co') } } lintCoercion co@(FunCo r co1 co2) - = do { (k1,k'1,s1,t1,r1) <- lintCoercion co1 - ; (k2,k'2,s2,t2,r2) <- lintCoercion co2 - ; k <- lintArrow (text "coercion" <+> quotes (ppr co)) k1 k2 - ; k' <- lintArrow (text "coercion" <+> quotes (ppr co)) k'1 k'2 - ; lintRole co1 r r1 - ; lintRole co2 r r2 - ; return (k, k', mkVisFunTy s1 s2, mkVisFunTy t1 t2, r) } - -lintCoercion (CoVarCo cv) - | not (isCoVar cv) - = failWithL (hang (text "Bad CoVarCo:" <+> ppr cv) - 2 (text "With offending type:" <+> ppr (varType cv))) - | otherwise - = do { cv' <- lintTyCoVarInScope cv - ; lintUnliftedCoVar cv' - ; return $ coVarKindsTypesRole cv' } + = do { co1' <- lintCoercion co1 + ; co2' <- lintCoercion co2 + ; let Pair lt1 rt1 = coercionKind co1 + Pair lt2 rt2 = coercionKind co2 + ; lintArrow (text "coercion" <+> quotes (ppr co)) lt1 lt2 + ; lintArrow (text "coercion" <+> quotes (ppr co)) rt1 rt2 + ; lintRole co1 r (coercionRole co1) + ; lintRole co2 r (coercionRole co2) + ; return (FunCo r co1' co2') } -- See Note [Bad unsafe coercion] lintCoercion co@(UnivCo prov r ty1 ty2) - = do { k1 <- lintType ty1 - ; k2 <- lintType ty2 - ; case prov of - PhantomProv kco -> do { lintRole co Phantom r - ; check_kinds kco k1 k2 } - - ProofIrrelProv kco -> do { lintL (isCoercionTy ty1) $ - mkBadProofIrrelMsg ty1 co - ; lintL (isCoercionTy ty2) $ - mkBadProofIrrelMsg ty2 co - ; check_kinds kco k1 k2 } - - PluginProv _ -> return () -- no extra checks + = do { ty1' <- lintType ty1 + ; ty2' <- lintType ty2 + ; let k1 = typeKind ty1' + k2 = typeKind ty2' + ; prov' <- lint_prov k1 k2 prov ; when (r /= Phantom && classifiesTypeWithValues k1 && classifiesTypeWithValues k2) (checkTypes ty1 ty2) - ; return (k1, k2, ty1, ty2, r) } + + ; return (UnivCo prov' r ty1' ty2') } where report s = hang (text $ "Unsafe coercion: " ++ s) 2 (vcat [ text "From:" <+> ppr ty1 @@ -1926,39 +1955,53 @@ lintCoercion co@(UnivCo prov r ty1 ty2) _ -> return () } - check_kinds kco k1 k2 = do { (k1', k2') <- lintStarCoercion kco - ; ensureEqTys k1 k1' (mkBadUnivCoMsg CLeft co) - ; ensureEqTys k2 k2' (mkBadUnivCoMsg CRight co) } + lint_prov k1 k2 (PhantomProv kco) + = do { kco' <- lintStarCoercion kco + ; lintRole co Phantom r + ; check_kinds kco' k1 k2 + ; return (PhantomProv kco') } + + lint_prov k1 k2 (ProofIrrelProv kco) + = do { lintL (isCoercionTy ty1) (mkBadProofIrrelMsg ty1 co) + ; lintL (isCoercionTy ty2) (mkBadProofIrrelMsg ty2 co) + ; kco' <- lintStarCoercion kco + ; check_kinds kco k1 k2 + ; return (ProofIrrelProv kco') } + + lint_prov _ _ prov@(PluginProv _) = return prov + + check_kinds kco k1 k2 + = do { let Pair k1' k2' = coercionKind kco + ; ensureEqTys k1 k1' (mkBadUnivCoMsg CLeft co) + ; ensureEqTys k2 k2' (mkBadUnivCoMsg CRight co) } lintCoercion (SymCo co) - = do { (k1, k2, ty1, ty2, r) <- lintCoercion co - ; return (k2, k1, ty2, ty1, r) } + = do { co' <- lintCoercion co + ; return (SymCo co') } lintCoercion co@(TransCo co1 co2) - = do { (k1a, _k1b, ty1a, ty1b, r1) <- lintCoercion co1 - ; (_k2a, k2b, ty2a, ty2b, r2) <- lintCoercion co2 + = do { co1' <- lintCoercion co1 + ; co2' <- lintCoercion co2 + ; let ty1b = coercionRKind co1' + ty2a = coercionLKind co2' ; ensureEqTys ty1b ty2a (hang (text "Trans coercion mis-match:" <+> ppr co) - 2 (vcat [ppr ty1a, ppr ty1b, ppr ty2a, ppr ty2b])) - ; lintRole co r1 r2 - ; return (k1a, k2b, ty1a, ty2b, r1) } + 2 (vcat [ppr (coercionKind co1'), ppr (coercionKind co2')])) + ; lintRole co (coercionRole co1) (coercionRole co2) + ; return (TransCo co1' co2') } lintCoercion the_co@(NthCo r0 n co) - = do { (_, _, s, t, r) <- lintCoercion co + = do { co' <- lintCoercion co + ; let (Pair s t, r) = coercionKindRole co' ; case (splitForAllTy_maybe s, splitForAllTy_maybe t) of - { (Just (tcv_s, _ty_s), Just (tcv_t, _ty_t)) + { (Just _, Just _) -- works for both tyvar and covar | n == 0 , (isForAllTy_ty s && isForAllTy_ty t) || (isForAllTy_co s && isForAllTy_co t) -> do { lintRole the_co Nominal r0 - ; return (ks, kt, ts, tt, r0) } - where - ts = varType tcv_s - tt = varType tcv_t - ks = typeKind ts - kt = typeKind tt + ; return (NthCo r0 n co') } ; _ -> case (splitTyConApp_maybe s, splitTyConApp_maybe t) of { (Just (tc_s, tys_s), Just (tc_t, tys_t)) @@ -1968,62 +2011,51 @@ lintCoercion the_co@(NthCo r0 n co) , tys_s `equalLength` tys_t , tys_s `lengthExceeds` n -> do { lintRole the_co tr r0 - ; return (ks, kt, ts, tt, r0) } - where - ts = getNth tys_s n - tt = getNth tys_t n - tr = nthRole r tc_s n - ks = typeKind ts - kt = typeKind tt + ; return (NthCo r0 n co') } + where + tr = nthRole r tc_s n ; _ -> failWithL (hang (text "Bad getNth:") 2 (ppr the_co $$ ppr s $$ ppr t)) }}} lintCoercion the_co@(LRCo lr co) - = do { (_,_,s,t,r) <- lintCoercion co + = do { co' <- lintCoercion co + ; let Pair s t = coercionKind co' + r = coercionRole co' ; lintRole co Nominal r ; case (splitAppTy_maybe s, splitAppTy_maybe t) of - (Just s_pr, Just t_pr) - -> return (ks_pick, kt_pick, s_pick, t_pick, Nominal) - where - s_pick = pickLR lr s_pr - t_pick = pickLR lr t_pr - ks_pick = typeKind s_pick - kt_pick = typeKind t_pick - + (Just _, Just _) -> return (LRCo lr co') _ -> failWithL (hang (text "Bad LRCo:") 2 (ppr the_co $$ ppr s $$ ppr t)) } lintCoercion (InstCo co arg) - = do { (k3, k4, t1',t2', r) <- lintCoercion co - ; (k1',k2',s1,s2, r') <- lintCoercion arg - ; lintRole arg Nominal r' - ; in_scope <- getInScope - ; case (splitForAllTy_ty_maybe t1', splitForAllTy_ty_maybe t2') of + = do { co' <- lintCoercion co + ; arg' <- lintCoercion arg + ; let Pair t1' t2' = coercionKind co' + Pair s1 s2 = coercionKind arg + + ; lintRole arg Nominal (coercionRole arg') + + ; case (splitForAllTy_ty_maybe t1', splitForAllTy_ty_maybe t2') of -- forall over tvar - { (Just (tv1,t1), Just (tv2,t2)) - | k1' `eqType` tyVarKind tv1 - , k2' `eqType` tyVarKind tv2 - -> return (k3, k4, - substTyWithInScope in_scope [tv1] [s1] t1, - substTyWithInScope in_scope [tv2] [s2] t2, r) + { (Just (tv1,_), Just (tv2,_)) + | typeKind s1 `eqType` tyVarKind tv1 + , typeKind s2 `eqType` tyVarKind tv2 + -> return (InstCo co' arg') | otherwise -> failWithL (text "Kind mis-match in inst coercion") + ; _ -> case (splitForAllTy_co_maybe t1', splitForAllTy_co_maybe t2') of -- forall over covar - { (Just (cv1, t1), Just (cv2, t2)) - | k1' `eqType` varType cv1 - , k2' `eqType` varType cv2 - , CoercionTy s1' <- s1 - , CoercionTy s2' <- s2 - -> do { return $ - (liftedTypeKind, liftedTypeKind - -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep - , substTy (mkCvSubst in_scope $ unitVarEnv cv1 s1') t1 - , substTy (mkCvSubst in_scope $ unitVarEnv cv2 s2') t2 - , r) } + { (Just (cv1, _), Just (cv2, _)) + | typeKind s1 `eqType` varType cv1 + , typeKind s2 `eqType` varType cv2 + , CoercionTy _ <- s1 + , CoercionTy _ <- s2 + -> return (InstCo co' arg') | otherwise -> failWithL (text "Kind mis-match in inst coercion") + ; _ -> failWithL (text "Bad argument of inst") }}} lintCoercion co@(AxiomInstCo con ind cos) @@ -2031,73 +2063,69 @@ lintCoercion co@(AxiomInstCo con ind cos) (bad_ax (text "index out of range")) ; let CoAxBranch { cab_tvs = ktvs , cab_cvs = cvs - , cab_roles = roles - , cab_lhs = lhs - , cab_rhs = rhs } = coAxiomNthBranch con ind + , cab_roles = roles } = coAxiomNthBranch con ind ; unless (cos `equalLength` (ktvs ++ cvs)) $ bad_ax (text "lengths") + ; cos' <- mapM lintCoercion cos ; subst <- getTCvSubst ; let empty_subst = zapTCvSubst subst - ; (subst_l, subst_r) <- foldlM check_ki - (empty_subst, empty_subst) - (zip3 (ktvs ++ cvs) roles cos) - ; let lhs' = substTys subst_l lhs - rhs' = substTy subst_r rhs - fam_tc = coAxiomTyCon con + ; _ <- foldlM check_ki (empty_subst, empty_subst) + (zip3 (ktvs ++ cvs) roles cos') + ; let fam_tc = coAxiomTyCon con ; case checkAxInstCo co of Just bad_branch -> bad_ax $ text "inconsistent with" <+> pprCoAxBranch fam_tc bad_branch Nothing -> return () - ; let s2 = mkTyConApp fam_tc lhs' - ; return (typeKind s2, typeKind rhs', s2, rhs', coAxiomRole con) } + ; return (AxiomInstCo con ind cos') } where bad_ax what = addErrL (hang (text "Bad axiom application" <+> parens what) 2 (ppr co)) - check_ki (subst_l, subst_r) (ktv, role, arg) - = do { (k', k'', s', t', r) <- lintCoercion arg - ; lintRole arg role r + check_ki (subst_l, subst_r) (ktv, role, arg') + = do { let Pair s' t' = coercionKind arg' + sk' = typeKind s' + tk' = typeKind t' + ; lintRole arg' role (coercionRole arg') ; let ktv_kind_l = substTy subst_l (tyVarKind ktv) ktv_kind_r = substTy subst_r (tyVarKind ktv) - ; unless (k' `eqType` ktv_kind_l) - (bad_ax (text "check_ki1" <+> vcat [ ppr co, ppr k', ppr ktv, ppr ktv_kind_l ] )) - ; unless (k'' `eqType` ktv_kind_r) - (bad_ax (text "check_ki2" <+> vcat [ ppr co, ppr k'', ppr ktv, ppr ktv_kind_r ] )) + ; unless (sk' `eqType` ktv_kind_l) + (bad_ax (text "check_ki1" <+> vcat [ ppr co, ppr sk', ppr ktv, ppr ktv_kind_l ] )) + ; unless (tk' `eqType` ktv_kind_r) + (bad_ax (text "check_ki2" <+> vcat [ ppr co, ppr tk', ppr ktv, ppr ktv_kind_r ] )) ; return (extendTCvSubst subst_l ktv s', extendTCvSubst subst_r ktv t') } lintCoercion (KindCo co) - = do { (k1, k2, _, _, _) <- lintCoercion co - ; return (liftedTypeKind, liftedTypeKind, k1, k2, Nominal) } + = do { co' <- lintCoercion co + ; return (KindCo co') } lintCoercion (SubCo co') - = do { (k1,k2,s,t,r) <- lintCoercion co' - ; lintRole co' Nominal r - ; return (k1,k2,s,t,Representational) } - -lintCoercion this@(AxiomRuleCo co cs) - = do { eqs <- mapM lintCoercion cs - ; lintRoles 0 (coaxrAsmpRoles co) eqs - ; case coaxrProves co [ Pair l r | (_,_,l,r,_) <- eqs ] of + = do { co' <- lintCoercion co' + ; lintRole co' Nominal (coercionRole co') + ; return (SubCo co') } + +lintCoercion this@(AxiomRuleCo ax cos) + = do { cos' <- mapM lintCoercion cos + ; lint_roles 0 (coaxrAsmpRoles ax) cos' + ; case coaxrProves ax (map coercionKind cos') of Nothing -> err "Malformed use of AxiomRuleCo" [ ppr this ] - Just (Pair l r) -> - return (typeKind l, typeKind r, l, r, coaxrRole co) } + Just _ -> return (AxiomRuleCo ax cos') } where err m xs = failWithL $ - hang (text m) 2 $ vcat (text "Rule:" <+> ppr (coaxrName co) : xs) + hang (text m) 2 $ vcat (text "Rule:" <+> ppr (coaxrName ax) : xs) - lintRoles n (e : es) ((_,_,_,_,r) : rs) - | e == r = lintRoles (n+1) es rs + lint_roles n (e : es) (co : cos) + | e == coercionRole co = lint_roles (n+1) es cos | otherwise = err "Argument roles mismatch" [ text "In argument:" <+> int (n+1) , text "Expected:" <+> ppr e - , text "Found:" <+> ppr r ] - lintRoles _ [] [] = return () - lintRoles n [] rs = err "Too many coercion arguments" + , text "Found:" <+> ppr (coercionRole co) ] + lint_roles _ [] [] = return () + lint_roles n [] rs = err "Too many coercion arguments" [ text "Expected:" <+> int n , text "Provided:" <+> int (n + length rs) ] - lintRoles n es [] = err "Not enough coercion arguments" + lint_roles n es [] = err "Not enough coercion arguments" [ text "Expected:" <+> int (n + length es) , text "Provided:" <+> int n ] @@ -2106,13 +2134,6 @@ lintCoercion (HoleCo h) ; lintCoercion (CoVarCo (coHoleCoVar h)) } ----------- -lintUnliftedCoVar :: CoVar -> LintM () -lintUnliftedCoVar cv - = when (not (isUnliftedType (coVarKind cv))) $ - failWithL (text "Bad lifted equality:" <+> ppr cv - <+> dcolon <+> ppr (coVarKind cv)) - {- ************************************************************************ * * @@ -2129,12 +2150,19 @@ data LintEnv , le_subst :: TCvSubst -- Current TyCo substitution -- See Note [Linting type lets] - -- /Only/ substitutes for type variables; - -- but might clone CoVars - -- We also use le_subst to keep track of - -- in-scope TyVars and CoVars + -- /Only/ substitutes for type variables; + -- but might clone CoVars + -- We also use le_subst to keep track of + -- in-scope TyVars and CoVars (but not Ids) + -- Range of the TCvSubst is LintedType/LintedCo + + , le_ids :: VarEnv (Id, LintedType) -- In-scope Ids + -- Used to check that occurrences have an enclosing binder. + -- The Id is /pre-substitution/, used to check that + -- the occurrence has an identical type to the binder + -- The LintedType is used to return the type of the occurrence, + -- without having to lint it again. - , le_ids :: IdSet -- In-scope Ids , le_joins :: IdSet -- Join points in scope that are valid -- A subset of the InScopeSet in le_subst -- See Note [Join points] @@ -2266,6 +2294,7 @@ instance HasDynFlags LintM where data LintLocInfo = RhsOf Id -- The variable bound + | OccOf Id -- Occurrence of id | LambdaBodyOf Id -- The lambda-binder | UnfoldingOf Id -- Unfolding of a binder | BodyOfLetRec [Id] -- One of the binders @@ -2278,7 +2307,6 @@ data LintLocInfo | ImportedUnfolding SrcLoc -- Some imported unfolding (ToDo: say which) | TopLevelBindings | InType Type -- Inside a type - | InKind Type Kind -- Inside a kind | InCo Coercion -- Inside a coercion initL :: DynFlags -> LintFlags -> [Var] @@ -2293,7 +2321,7 @@ initL dflags flags vars m (tcvs, ids) = partition isTyCoVar vars env = LE { le_flags = flags , le_subst = mkEmptyTCvSubst (mkInScopeSet (mkVarSet tcvs)) - , le_ids = mkVarSet ids + , le_ids = mkVarEnv [(id, (id,idType id)) | id <- ids] , le_joins = emptyVarSet , le_loc = [] , le_dynflags = dflags } @@ -2341,7 +2369,7 @@ addWarnL msg = LintM $ \ env (warns,errs) -> addMsg :: Bool -> LintEnv -> Bag MsgDoc -> MsgDoc -> Bag MsgDoc addMsg is_error env msgs msg - = ASSERT( notNull loc_msgs ) + = ASSERT2( notNull loc_msgs, msg ) msgs `snocBag` mk_msg msg where loc_msgs :: [(SrcLoc, SDoc)] -- Innermost first @@ -2373,18 +2401,17 @@ inCasePat = LintM $ \ env errs -> (Just (is_case_pat env), errs) is_case_pat (LE { le_loc = CasePat {} : _ }) = True is_case_pat _other = False -addInScopeTyCoVar :: Var -> LintM a -> LintM a -addInScopeTyCoVar var m - = LintM $ \ env errs -> - unLintM m (env { le_subst = extendTCvInScope (le_subst env) var }) errs - -addInScopeId :: Id -> LintM a -> LintM a -addInScopeId id m - = LintM $ \ env errs -> - unLintM m (env { le_ids = extendVarSet (le_ids env) id - , le_joins = delVarSet (le_joins env) id }) errs +addInScopeId :: Id -> LintedType -> LintM a -> LintM a +addInScopeId id linted_ty m + = LintM $ \ env@(LE { le_ids = id_set, le_joins = join_set }) errs -> + unLintM m (env { le_ids = extendVarEnv id_set id (id, linted_ty) + , le_joins = add_joins join_set }) errs + where + add_joins join_set + | isJoinId id = extendVarSet join_set id -- Overwrite with new arity + | otherwise = delVarSet join_set id -- Remove any existing binding -getInScopeIds :: LintM IdSet +getInScopeIds :: LintM (VarEnv (Id,LintedType)) getInScopeIds = LintM (\env errs -> (Just (le_ids env), errs)) extendTvSubstL :: TyVar -> Type -> LintM a -> LintM a @@ -2404,13 +2431,6 @@ markAllJoinsBadIf :: Bool -> LintM a -> LintM a markAllJoinsBadIf True m = markAllJoinsBad m markAllJoinsBadIf False m = m -addGoodJoins :: [Var] -> LintM a -> LintM a -addGoodJoins vars thing_inside - = LintM $ \ env errs -> unLintM thing_inside (add_joins env) errs - where - add_joins env = env { le_joins = le_joins env `extendVarSetList` join_ids } - join_ids = filter isJoinId vars - getValidJoins :: LintM IdSet getValidJoins = LintM (\ env errs -> (Just (le_joins env), errs)) @@ -2420,20 +2440,17 @@ getTCvSubst = LintM (\ env errs -> (Just (le_subst env), errs)) getInScope :: LintM InScopeSet getInScope = LintM (\ env errs -> (Just (getTCvInScope $ le_subst env), errs)) -applySubstTy :: InType -> LintM OutType -applySubstTy ty = do { subst <- getTCvSubst; return (substTy subst ty) } - -applySubstCo :: InCoercion -> LintM OutCoercion -applySubstCo co = do { subst <- getTCvSubst; return (substCo subst co) } - -lookupIdInScope :: Id -> LintM Id +lookupIdInScope :: Id -> LintM (Id, LintedType) lookupIdInScope id_occ = do { in_scope_ids <- getInScopeIds - ; case lookupVarSet in_scope_ids id_occ of - Just id_bnd -> do { checkL (not (bad_global id_bnd)) global_in_scope - ; return id_bnd } + ; case lookupVarEnv in_scope_ids id_occ of + Just (id_bndr, linted_ty) + -> do { checkL (not (bad_global id_bndr)) global_in_scope + ; return (id_bndr, linted_ty) } Nothing -> do { checkL (not is_local) local_out_of_scope - ; return id_occ } } + ; return (id_occ, idType id_occ) } } + -- We don't bother to lint the type + -- of global (i.e. imported) Ids where is_local = mustHaveLocalBinding id_occ local_out_of_scope = text "Out of scope:" <+> pprBndr LetBind id_occ @@ -2461,16 +2478,7 @@ lookupJoinId id Just id' -> return (isJoinId_maybe id') Nothing -> return Nothing } -lintTyCoVarInScope :: TyCoVar -> LintM TyCoVar -lintTyCoVarInScope var - = do { subst <- getTCvSubst - ; case lookupInScope (getTCvInScope subst) var of - Just var' -> return var' - Nothing -> failWithL $ - hang (text "The TyCo variable" <+> pprBndr LetBind var) - 2 (text "is out of scope") } - -ensureEqTys :: OutType -> OutType -> MsgDoc -> LintM () +ensureEqTys :: LintedType -> LintedType -> MsgDoc -> LintM () -- check ty2 is subtype of ty1 (ie, has same structure but usage -- annotations need only be consistent, not equal) -- Assumes ty1,ty2 are have already had the substitution applied @@ -2500,6 +2508,9 @@ dumpLoc :: LintLocInfo -> (SrcLoc, SDoc) dumpLoc (RhsOf v) = (getSrcLoc v, text "In the RHS of" <+> pp_binders [v]) +dumpLoc (OccOf v) + = (getSrcLoc v, text "In an occurrence of" <+> pp_binder v) + dumpLoc (LambdaBodyOf b) = (getSrcLoc b, text "In the body of lambda with binder" <+> pp_binder b) @@ -2534,8 +2545,6 @@ dumpLoc TopLevelBindings = (noSrcLoc, Outputable.empty) dumpLoc (InType ty) = (noSrcLoc, text "In the type" <+> quotes (ppr ty)) -dumpLoc (InKind ty ki) - = (noSrcLoc, text "In the kind of" <+> parens (ppr ty <+> dcolon <+> ppr ki)) dumpLoc (InCo co) = (noSrcLoc, text "In the coercion" <+> quotes (ppr co)) @@ -2780,7 +2789,7 @@ mkJoinBndrOccMismatchMsg bndr join_arity_bndr join_arity_occ , text "Arity at binding site:" <+> ppr join_arity_bndr , text "Arity at occurrence: " <+> ppr join_arity_occ ] -mkBndrOccTypeMismatchMsg :: Var -> Var -> OutType -> OutType -> SDoc +mkBndrOccTypeMismatchMsg :: Var -> Var -> LintedType -> LintedType -> SDoc mkBndrOccTypeMismatchMsg bndr var bndr_ty var_ty = vcat [ text "Mismatch in type between binder and occurrence" , text "Binder:" <+> ppr bndr <+> dcolon <+> ppr bndr_ty ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -2447,7 +2447,7 @@ normally it would make no sense to have forall r. (ty :: K r) because the kind of the forall would escape the binding of 'r'. But in this case it's fine because (K r) exapands -to Type, so we expliclity /permit/ the type +to Type, so we explicitly /permit/ the type forall r. T r To accommodate such a type, in typeKind (forall a.ty) we use @@ -2455,8 +2455,13 @@ occCheckExpand to expand any type synonyms in the kind of 'ty' to eliminate 'a'. See kinding rule (FORALL) in Note [Kinding rules for types] -And in TcValidity.checkEscapingKind, we use also use -occCheckExpand, for the same reason. +See also + * TcUnify.occCheckExpand + * GHC.Core.Utils.coreAltsType + * TcValidity.checkEscapingKind +all of which grapple with with the same problem. + +See #14939. -} ----------------------------- ===================================== testsuite/tests/indexed-types/should_compile/T17923.hs ===================================== @@ -0,0 +1,44 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# OPTIONS_GHC -Wall #-} +module Bug where + +import Data.Kind + +-- type SingFunction2 f = forall t1 t2. Sing t1 -> Sing t2 -> Sing (f `Apply` t1 `Apply` t2) +type SingFunction2 f = forall t1. Sing t1 -> forall t2. Sing t2 -> Sing (f `Apply` t1 `Apply` t2) +singFun2 :: forall f. SingFunction2 f -> Sing f +singFun2 f = SLambda (\x -> SLambda (f x)) + +type family Sing :: k -> Type +data TyFun :: Type -> Type -> Type +type a ~> b = TyFun a b -> Type +infixr 0 ~> + +type family Apply (f :: a ~> b) (x :: a) :: b +data Sym4 a +data Sym3 a + +type instance Apply Sym3 _ = Sym4 + +newtype SLambda (f :: k1 ~> k2) = + SLambda { applySing :: forall t. Sing t -> Sing (Apply f t) } +type instance Sing = SLambda + +und :: a +und = undefined + +data E +data ShowCharSym0 :: E ~> E ~> E + +sShow_tuple :: SLambda Sym4 +sShow_tuple + = applySing (singFun2 @Sym3 und) + (und (singFun2 @Sym3 + (und (applySing (singFun2 @Sym3 und) + (applySing (singFun2 @ShowCharSym0 und) und))))) ===================================== testsuite/tests/indexed-types/should_compile/all.T ===================================== @@ -294,3 +294,4 @@ test('T16828', normal, compile, ['']) test('T17008b', normal, compile, ['']) test('T17056', normal, compile, ['']) test('T17405', normal, multimod_compile, ['T17405c', '-v0']) +test('T17923', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/92cbc212164cebd7c1963e78372ed25eb85527b9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/92cbc212164cebd7c1963e78372ed25eb85527b9 You're receiving 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 Mar 27 00:07:28 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Thu, 26 Mar 2020 20:07:28 -0400 Subject: [Git][ghc/ghc][wip/T17923] 8 commits: Use export list of Main module in function TcRnDriver.hs:check_main (Fix #16453) Message-ID: <5e7d43c0dabb8_616776d1c748799f7@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T17923 at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - a262ea49 by Simon Peyton Jones at 2020-03-27T00:07:11+00: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. - - - - - 11 changed files: - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm/Config.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Op/ConstantFold.hs - compiler/GHC/Core/Op/DmdAnal.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/92cbc212164cebd7c1963e78372ed25eb85527b9...a262ea4953db303f5faf20ae3fb4be5ec5367639 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/92cbc212164cebd7c1963e78372ed25eb85527b9...a262ea4953db303f5faf20ae3fb4be5ec5367639 You're receiving 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 Mar 27 13:58:40 2020 From: gitlab at gitlab.haskell.org (=?UTF-8?B?w5ZtZXIgU2luYW4gQcSfYWNhbg==?=) Date: Fri, 27 Mar 2020 09:58:40 -0400 Subject: [Git][ghc/ghc][wip/osa1/lfinfo] 8 commits: Use export list of Main module in function TcRnDriver.hs:check_main (Fix #16453) Message-ID: <5e7e06905172b_61675cefcac9831bd@gitlab.haskell.org.mail> Ömer Sinan Ağacan pushed to branch wip/osa1/lfinfo at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - 5484426d by Ömer Sinan Ağacan at 2020-03-27T16:55:15+03: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. TODO: Add NoFib numbers - - - - - 30 changed files: - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm/Config.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Op/ConstantFold.hs - compiler/GHC/Core/Op/DmdAnal.hs - compiler/GHC/Core/Op/FloatIn.hs - compiler/GHC/Core/Op/Simplify.hs - compiler/GHC/Core/Op/Simplify/Utils.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToByteCode.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Hooks.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Foreign/Call.hs - compiler/GHC/HsToCore/Foreign/Decl.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Literal.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9f7e4c7193ce2122bd3ff5532ad284a7c8041605...5484426d737ff9f48686498d0f2f082d8a727069 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9f7e4c7193ce2122bd3ff5532ad284a7c8041605...5484426d737ff9f48686498d0f2f082d8a727069 You're receiving 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 Mar 27 15:17:50 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 27 Mar 2020 11:17:50 -0400 Subject: [Git][ghc/ghc][wip/zap-coercions] 1325 commits: rts: Correct handling of LARGE ARR_WORDS in LDV profiler Message-ID: <5e7e191ecf789_6167120434ec997138@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/zap-coercions at Glasgow Haskell Compiler / GHC Commits: a586b33f by Matthew Pickering at 2019-06-27T10:42:29-04:00 rts: Correct handling of LARGE ARR_WORDS in LDV profiler This implements the correct fix for #11627 by skipping over the slop (which is zeroed) rather than adding special case logic for LARGE ARR_WORDS which runs the risk of not performing a correct census by ignoring any subsequent blocks. This approach implements similar logic to that in Sanity.c - - - - - ed4cbd93 by Matthew Pickering at 2019-06-27T10:42:29-04:00 rts: Correct assertion in LDV_recordDead It is possible that void_total is exactly equal to not_used and the other assertions for this check for <= rather than <. - - - - - 07cffc49 by Matthew Pickering at 2019-06-27T10:42:29-04:00 rts: Do not traverse nursery for dead closures in LDV profile It is important that `heapCensus` and `LdvCensusForDead` traverse the same areas. `heapCensus` increases the `not_used` counter which tracks how many closures are live but haven't been used yet. `LdvCensusForDead` increases the `void_total` counter which tracks how many dead closures there are. The `LAG` is then calculated by substracting the `void_total` from `not_used` and so it is essential that `not_used >= void_total`. This fact is checked by quite a few assertions. However, if a program has low maximum residency but allocates a lot in the nursery then these assertions were failing (see #16753 and #15903) because `LdvCensusForDead` was observing dead closures from the nursery which totalled more than the `not_used`. The same closures were not counted by `heapCensus`. Therefore, it seems that the correct fix is to make `LdvCensusForDead` agree with `heapCensus` and not traverse the nursery for dead closures. Fixes #16100 #16753 #15903 #8982 - - - - - c1f67887 by Roland Senn at 2019-06-27T10:43:10-04:00 Improve doc for :type-at. (#14780) - - - - - 52f10216 by Roland Zumkeller at 2019-06-27T10:43:47-04:00 configure: prefer cc over gcc Fixes #16857. - - - - - 90e0ab7d by Sylvain Henry at 2019-06-27T10:44:25-04:00 Fix Happy deps for Stack (#16825) - - - - - d35cec7a by Fraser Tweedale at 2019-06-27T10:45:01-04:00 getExecutablePath: get path from sysctl on FreeBSD - - - - - 2a68b8b7 by nineonine at 2019-06-27T10:45:39-04:00 Fix #16805 by formatting warning message - - - - - 217258d0 by Ben Gamari at 2019-06-27T10:46:18-04:00 testsuite: Add more type annotations to perf_notes - - - - - 4ec233ec by Sylvain Henry at 2019-06-27T23:58:37-04:00 Fix GCC warnings with __clear_cache builtin (#16867) - - - - - ef6d9a50 by Artem Pelenitsyn at 2019-06-27T23:59:15-04:00 typo in the docs for DynFlags.hs - - - - - 11bac115 by Travis Whitaker at 2019-06-28T15:25:05-04:00 Correct closure observation, construction, and mutation on weak memory machines. Here the following changes are introduced: - A read barrier machine op is added to Cmm. - The order in which a closure's fields are read and written is changed. - Memory barriers are added to RTS code to ensure correctness on out-or-order machines with weak memory ordering. Cmm has a new CallishMachOp called MO_ReadBarrier. On weak memory machines, this is lowered to an instruction that ensures memory reads that occur after said instruction in program order are not performed before reads coming before said instruction in program order. On machines with strong memory ordering properties (e.g. X86, SPARC in TSO mode) no such instruction is necessary, so MO_ReadBarrier is simply erased. However, such an instruction is necessary on weakly ordered machines, e.g. ARM and PowerPC. Weam memory ordering has consequences for how closures are observed and mutated. For example, consider a closure that needs to be updated to an indirection. In order for the indirection to be safe for concurrent observers to enter, said observers must read the indirection's info table before they read the indirectee. Furthermore, the entering observer makes assumptions about the closure based on its info table contents, e.g. an INFO_TYPE of IND imples the closure has an indirectee pointer that is safe to follow. When a closure is updated with an indirection, both its info table and its indirectee must be written. With weak memory ordering, these two writes can be arbitrarily reordered, and perhaps even interleaved with other threads' reads and writes (in the absence of memory barrier instructions). Consider this example of a bad reordering: - An updater writes to a closure's info table (INFO_TYPE is now IND). - A concurrent observer branches upon reading the closure's INFO_TYPE as IND. - A concurrent observer reads the closure's indirectee and enters it. (!!!) - An updater writes the closure's indirectee. Here the update to the indirectee comes too late and the concurrent observer has jumped off into the abyss. Speculative execution can also cause us issues, consider: - An observer is about to case on a value in closure's info table. - The observer speculatively reads one or more of closure's fields. - An updater writes to closure's info table. - The observer takes a branch based on the new info table value, but with the old closure fields! - The updater writes to the closure's other fields, but its too late. Because of these effects, reads and writes to a closure's info table must be ordered carefully with respect to reads and writes to the closure's other fields, and memory barriers must be placed to ensure that reads and writes occur in program order. Specifically, updates to a closure must follow the following pattern: - Update the closure's (non-info table) fields. - Write barrier. - Update the closure's info table. Observing a closure's fields must follow the following pattern: - Read the closure's info pointer. - Read barrier. - Read the closure's (non-info table) fields. This patch updates RTS code to obey this pattern. This should fix long-standing SMP bugs on ARM (specifically newer aarch64 microarchitectures supporting out-of-order execution) and PowerPC. This fixes issue #15449. Co-Authored-By: Ben Gamari <ben at well-typed.com> - - - - - bd660ede by Ben Gamari at 2019-06-28T15:25:30-04:00 rts: Assert that LDV profiling isn't used with parallel GC I'm not entirely sure we are careful about ensuring this; this is a last-ditch check. - - - - - 82693938 by Moritz Angermann at 2019-07-02T16:18:05-04:00 Add _GLOBAL_OFFSET_TABLE_ support This adds lookup logic for _GLOBAL_OFFSET_TABLE_ as well as relocation logic for R_ARM_BASE_PREL and R_ARM_GOT_BREL which the gnu toolchain (gas, gcc, ...) prefers to produce. Apparently recent llvm toolchains will produce those as well. - - - - - 348e3f8e by Edward Amsden at 2019-07-02T16:18:05-04:00 Lookup _GLOBAL_OFFSET_TABLE by symbol->addr when doing relocations - - - - - e9abcad4 by Moritz Angermann at 2019-07-02T16:18:05-04:00 No atomics on arm32; this will just yield stubs. As such the internal linker will fail for them. The alternative would be to implement them as stubs in the linker and have them barf when called. > Not all operations are supported by all target processors. If a particular operation cannot be implemented on the target processor, a warning is generated and a call an external function is generated. The external function carries the same name as the built-in version, with an additional suffix ‘_n’ where n is the size of the data type. (https://gcc.gnu.org/onlinedocs/gcc/_005f_005fsync-Builtins.html) - - - - - 023a2bc7 by Ben Gamari at 2019-07-02T16:18:05-04:00 Apply suggestion to rts/linker/elf_got.c - - - - - 0bed9647 by Ben Gamari at 2019-07-02T16:18:05-04:00 Apply suggestion to rts/linker/Elf.c - - - - - cef80c0b by nineonine at 2019-07-02T16:18:44-04:00 Fix #15843 by extending Template Haskell AST for tuples to support sections - - - - - 294b55dc by Eric Wolf at 2019-07-02T16:19:21-04:00 Add test for #16575 just use the test to show the defective behaviour, so we can see the difference, when it gets fixed - - - - - 60b9eab9 by Ömer Sinan Ağacan at 2019-07-02T16:19:59-04:00 Fix stage 1 warnings - - - - - df3e5b74 by David Eichmann at 2019-07-02T16:20:36-04:00 Hadrian: disable cloud build cache for symlinks #16800 This is a temporary workaround shake not supporting symlinks when using cloud/cached builds. - - - - - acd79558 by Abhiroop Sarkar at 2019-07-03T09:33:39-04:00 Add support for SIMD operations in the NCG This adds support for constructing vector types from Float#, Double# etc and performing arithmetic operations on them Cleaned-Up-By: Ben Gamari <ben at well-typed.com> - - - - - 973c61b5 by Ben Gamari at 2019-07-03T09:34:16-04:00 gitlab-ci: Fix doc-tarball job Previously we used the deb9-debug job which used the `validate` build flavour which disabled `BUILD_SPHINX_PDF`. Fix this. Fixes #16890. - - - - - a25f6f55 by Ryan Scott at 2019-07-03T09:34:54-04:00 Bump template-haskell version to 2.16.0.0 Commit cef80c0b9edca3d21b5c762f51dfbab4c5857d8a debuted a breaking change to `template-haskell`, so in order to guard against it properly with CPP, we need to bump the `template-haskell` version number accordingly. - - - - - f7a2e709 by Ben Gamari at 2019-07-04T15:29:49-04:00 Bump parsec submodule to 3.1.14.0 - - - - - d7f7e1ed by Siddharth Bhat at 2019-07-04T21:22:00-04:00 Make printer untag when chasing a pointer in a RET_FUN frame This is to mimic what `Scav.c` does. This should fix a crash in the printer. - - - - - 675d27fc by Ben Gamari at 2019-07-04T21:22:35-04:00 gitlab: Reduce size of template headings - - - - - 679427f8 by Vladislav Zavialov at 2019-07-04T21:23:10-04:00 Produce all DerivInfo in tcTyAndClassDecls Before this refactoring: * DerivInfo for data family instances was returned from tcTyAndClassDecls * DerivInfo for data declarations was generated with mkDerivInfos and added at a later stage of the pipeline in tcInstDeclsDeriv After this refactoring: * DerivInfo for both data family instances and data declarations is returned from tcTyAndClassDecls in a single list. This uniform treatment results in a more convenient arrangement to fix #16731. - - - - - 53aa59f3 by Simon Peyton Jones at 2019-07-04T21:23:49-04:00 Add a missing zonk (fixes #16902) In the eager unifier, when unifying (tv1 ~ tv2), when we decide to swap them over, to unify (tv2 ~ tv1), I'd forgotten to ensure that tv1's kind was fully zonked, which is an invariant of uUnfilledTyVar2. That could lead us to build an infinite kind, or (in the case of #16902) update the same unification variable twice. Yikes. Now we get an error message rather than non-termination, which is much better. The error message is not great, but it's a very strange program, and I can't see an easy way to improve it, so for now I'm just committing this fix. Here's the decl data F (a :: k) :: (a ~~ k) => Type where MkF :: F a and the rather error message of which I am not proud T16902.hs:11:10: error: • Expected a type, but found something with kind ‘a1’ • In the type ‘F a’ - - - - - ed662901 by Daniel Gröber at 2019-07-04T21:24:26-04:00 rts: Fix -hT option with profiling rts In dumpCensus we switch/case on doHeapProfile twice. The second switch tries to barf on unknown doHeapProfile modes but HEAP_BY_CLOSURE_TYPE is checked by the first switch and not included in the second. So when trying to pass -hT to the profiling rts it barfs. This commit simply merges the two switches into one which fixes this problem. - - - - - 80afdf6b by Simon Peyton Jones at 2019-07-04T21:25:05-04:00 Fix over-eager implication constraint discard Ticket #16247 showed that we were discarding an implication constraint that had empty ic_wanted, when we still needed to keep it so we could check whether it had a bad telescope. Happily it's a one line fix. All the rest is comments! - - - - - f002250a by Andreas Klebinger at 2019-07-04T21:25:43-04:00 Dont gather ticks when only striping them in STG. Adds stripStgTicksTopE which only returns the stripped expression. So far we also allocated a list for the stripped ticks which was never used. Allocation difference is as expected very small but present. About 0.02% difference when compiling with -O. - - - - - a76b233d by Artem Pelenitsyn at 2019-07-05T07:06:55-04:00 Make all submodules have absolute URLs The relative URLs were a workaround to let most contributors fork from Github due to a weakness in the haskell.org server. This workaround is no longer needed. And relative submodule URLs are an impediment to forking which makes contributions harder than they should be. The URLs are chosen to clone from https, because this makes sure that anybody, even not a registered Gitlab user, can clone a fork recursively. - - - - - 62b82135 by Ryan Scott at 2019-07-05T07:07:38-04:00 More sensible SrcSpans for recursive pattern synonym errors (#16900) Attach the `SrcSpan` of the first pattern synonym binding involved in the recursive group when throwing the corresponding error message, similarly to how it is done for type synonyms. Fixes #16900. - - - - - 2fd1ed54 by nineonine at 2019-07-05T07:08:17-04:00 Fix #16895 by checking whether infix expression operator is a variable - - - - - 03f5adcd by David Eichmann at 2019-07-08T07:07:10-04:00 Bump Shake and copy instead of hard link from cloud cache This is important as in hard link mode shake makes all such files read only to avoid accidentally modifying cache files via the hard link. It turns out, many Hadrian rules attempt read access to such files and hence fail in the hard link mode. These rules could be refactored to avoid write access, but using copy instead of hard link a much simpler solution. - - - - - 5af815f2 by Kevin Buhr at 2019-07-08T07:07:11-04:00 Add test for old issue w/ bad source locations for warnings in .lhs files (#515) - - - - - 6a03d77b by Ryan Scott at 2019-07-09T11:52:45-04:00 Use an empty data type in TTG extension constructors (#15247) To avoid having to `panic` any time a TTG extension constructor is consumed, this MR introduces an uninhabited 'NoExtCon' type and uses that in every extension constructor's type family instance where it is appropriate. This also introduces a 'noExtCon' function which eliminates a 'NoExtCon', much like 'Data.Void.absurd' eliminates a 'Void'. I also renamed the existing `NoExt` type to `NoExtField` to better distinguish it from `NoExtCon`. Unsurprisingly, there is a lot of code churn resulting from this. Bumps the Haddock submodule. Fixes #15247. - - - - - b05c8423 by Phuong Trinh at 2019-07-09T22:55:41-04:00 Fix #16511: changes in interface dependencies should trigger recompilation If the union of dependencies of imported modules change, the `mi_deps` field of the interface files should change as well. Because of that, we need to check for changes in this in recompilation checker which we are not doing right now. This adds a checks for that. - - - - - fb43bddc by John Ericson at 2019-07-09T22:56:18-04:00 Fix two more `#ifndef` for the linter - - - - - 0472f0f6 by John Ericson at 2019-07-09T22:56:18-04:00 Remove most uses of TARGET platform macros These prevent multi-target builds. They were gotten rid of in 3 ways: 1. In the compiler itself, replacing `#if` with runtime `if`. In these cases, we care about the target platform still, but the target platform is dynamic so we must delay the elimination to run time. 2. In the compiler itself, replacing `TARGET` with `HOST`. There was just one bit of this, in some code splitting strings representing lists of paths. These paths are used by GHC itself, and not by the compiled binary. (They are compiler lookup paths, rather than RPATHS or something that does matter to the compiled binary, and thus would legitamentally be target-sensative.) As such, the path-splitting method only depends on where GHC runs and not where code it produces runs. This should have been `HOST` all along. 3. Changing the RTS. The RTS doesn't care about the target platform, full stop. 4. `includes/stg/HaskellMachRegs.h` This file is also included in the genapply executable. This is tricky because the RTS's host platform really is that utility's target platform. so that utility really really isn't multi-target either. But at least it isn't an installed part of GHC, but just a one-off tool when building the RTS. Lying with the `HOST` to a one-off program (genapply) that isn't installed doesn't seem so bad. It's certainly better than the other way around of lying to the RTS though not to genapply. The RTS is more important, and it is installed, *and* this header is installed as part of the RTS. - - - - - 24782b89 by John Ericson at 2019-07-09T22:56:18-04:00 Deduplicate "unique subdir" code between GHC and Cabal The code, including the generated module with the version, is now in ghc-boot. Config.hs reexports stuff as needed, ghc-pkg doesn't need any tricks at all. - - - - - 42ff8653 by Ben Gamari at 2019-07-09T22:56:53-04:00 testsuite: Fix #16818 Renames performance metrics to include whether they are compile-time or runtime metrics. - - - - - 18ac9ad4 by Alp Mestanogullari at 2019-07-09T22:57:31-04:00 Hadrian: implement key-value settings for builder options They take the general form `foo.bar.baz [+]= some values`, where `=` completely overrides the arguments for a builder and `+=` extends them. We currenly only support settings for updating the GHC and C compiler options, of the form: ``` {stage0, ..., stage3 or *}.{package name or *} .ghc.{c, hs, link, deps, toolargs or *}.opts {stage0, ..., stage3 or *}.{package name or *} .cc.{c, deps or *}.opts ``` The supported settings and their use is covered in the new section of `hadrian/doc/user-settings.md`, while the implementation is explained in a new Note [Hadrian settings]. Most of the logic is implemented in a new module, `Settings.Parser`, which contains key-value assignment/extension parsers as well as utilities for specifying allowed settings at a high-level, generating a `Predicate` from such a description or generating the list of possible completions for a given string. The additions to the `Settings` module make use of this to describe the settings that Hadrian currently supports, and apply all such key-value settings (from the command line and `<root>/hadrian.settings`) to the flavour that Hadrian is going to proceed with. This new setting system comes with support for generating Bash completions, implemented in `hadrian/completion.sh` and Hadrian's `autocomplete` target: > source hadrian/completion.sh > hadrian/build.sh stage1.base.ghc.<TAB> stage1.base.ghc.c.opts stage1.base.ghc.hs.opts stage1.base.ghc.*.opts stage1.base.ghc.deps.opts stage1.base.ghc.link.opts stage1.base.ghc.toolargs.opts - - - - - 7f8bf98e by Alp Mestanogullari at 2019-07-09T22:58:09-04:00 Hadrian: fix source-dist rule The first problem was that the list of files/dirs to embed or ignore was not up-to-date. The second problem was that the 'Cwd' option used when running the Tar builder in the source-dist rule didn't actually change the current directory and was therefore failing. Finally, the source-dist rule did not pre-generate Haskell modules derived from .x (alex) and .y (happy) files, like the Make build system does -- this is now fixed. We might be doing too much work for that last step (we seem to be building many things until we get to generating the source distribution), but extracting the distribution and running ./configure && hadrian/build.sh --flavour=quickest -j from there does work for me now. - - - - - d7423f10 by Ömer Sinan Ağacan at 2019-07-09T22:58:48-04:00 Testsuite tweaks and refactoring - Rename requires_th to req_th for consistency with other req functions (e.g. req_interp, req_profiling etc.) - req_th (previously requires_th) now checks for interpreter (via req_interp). With this running TH tests are skipped when running the test suite with stage=1. - Test tweaks: - T9360a, T9360b: Use req_interp - recomp009, T13938, RAE_T32a: Use req_th - Fix check-makefiles linter: it now looks for Makefiles instead of .T files (which are actually Python files) - - - - - 897a59a5 by Ömer Sinan Ağacan at 2019-07-09T22:59:26-04:00 Minor refactoring in CoreSimpl When `join_ids` is empty `extendVarSetList existing_joins join_ids` is already no-op, so no need to check whether `join_ids` is empty or not before extending the joins set. - - - - - 85da17e5 by Eric Wolf at 2019-07-09T23:00:03-04:00 Add testcase T16804 for #16804 slightly larger testcase for :type-at and :uses so we can see changes, if #16804 is done. - - - - - 8fcc931c by Eric Wolf at 2019-07-09T23:00:03-04:00 T16804: adjust src spans - - - - - a35e0916 by Ben Gamari at 2019-07-09T23:00:42-04:00 hadrian/doc: Add some discussion of compilation stages This documents some of the lore surrounding the nature and naming of GHC's stage numbers. - - - - - d2e290d3 by Simon Peyton Jones at 2019-07-09T23:01:24-04:00 Fix erroneous float in CoreOpt The simple optimiser was making an invalid transformation to join points -- yikes. The fix is easy. I also added some documentation about the fact that GHC uses a slightly more restrictive version of join points than does the paper. Fix #16918 - - - - - cb5271ac by Kevin Buhr at 2019-07-11T17:46:19-04:00 Add regression test for old panic on inlining undeclared identifier (#495) - - - - - 01ec8549 by Andreas Klebinger at 2019-07-11T17:46:57-04:00 Special case a few common patterns in unionLists. In particular we very often pass one empty list and in these cases we want to avoid the overhead of computing `xs ++ []`. This should fix #14759 and #16911. - - - - - b507aceb by Ryan Scott at 2019-07-11T17:47:41-04:00 Don't typecheck too much (or too little) in DerivingVia (#16923) Previously, GHC would typecheck the `via` type once per class in a `deriving` clause, which caused the problems observed in #16923. This patch restructures some of the functionality in `TcDeriv` and `TcHsType` to avoid this problem. We now typecheck the `via` type exactly once per `deriving` clause and *then* typecheck all of the classes in the clause. See `Note [Don't typecheck too much in DerivingVia]` in `TcDeriv` for the full details. - - - - - 8449c5b6 by nineonine at 2019-07-11T17:48:18-04:00 Allow reusing temporary object files generated by GHCi by writing to -odir in case -fwrite-interface was specified (#16670) - - - - - d5c899d1 by Ben Gamari at 2019-07-11T17:48:54-04:00 head.hackage: Run build on head.hackage's master branch The GitLab CI infrastructure is now in the master branch. - - - - - 8a209384 by Ben Gamari at 2019-07-11T17:48:54-04:00 head.hackage: Run builds with -dcore-lint - - - - - e4c73514 by Simon Peyton Jones at 2019-07-12T02:20:01-04:00 Fix kind-checking for data/newtypes In one spot in kcConDecl we were passing in the return kind signature rether than the return kind. e.g. #16828 newtype instance Foo :: Type -> Type where MkFoo :: a -> Foo a We were giving kcConDecl the kind (Type -> Type), whereas it was expecting the ultimate return kind, namely Type. This "looking past arrows" was being done, independently, in several places, but we'd missed one. This patch moves it all to one place -- the new function kcConDecls (note the plural). I also took the opportunity to rename tcDataFamHeader to tcDataFamInstHeader (The previous name was consistently a source of confusion.) - - - - - de3935a6 by Shayne Fletcher at 2019-07-12T02:20:43-04:00 Add shake 0.18.3 to extra deps - - - - - a31b24a5 by Ashley Yakeley at 2019-07-13T16:35:41-04:00 base: Data.Fixed: make HasResolution poly-kinded (#10055, #15622) - - - - - 688a1b89 by Alp Mestanogullari at 2019-07-13T16:36:18-04:00 compiler: trace SysTools commands to emit start/stop eventlog markers This patch was motivated by some performance characterization work done for #16822, where we suspected that GHC was spending a lot of time waiting on the linker to be done. (That turned out to be true.) The tracing is taken care of by ErrUtils.withTiming, so this patch just defines and uses a little wrapper around that function in all the helpers for calling the various systools (C compiler, linker, unlit, ...). With this patch, assuming a GHC executable linked against an eventlog-capable RTS (RTS ways that contain the debug, profiling or eventlog way units), we can measure how much time is spent in each of the SysTools when building hello.hs by simply doing: ghc hello.hs -ddump-timings +RTS -l The event names are "systool:{cc, linker, as, unlit, ...}". - - - - - 348cc8eb by Andreas Klebinger at 2019-07-13T16:36:57-04:00 Add two CmmSwitch optimizations. Move switch expressions into a local variable when generating switches. This avoids duplicating the expression if we translate the switch to a tree search. This fixes #16933. Further we now check if all branches of a switch have the same destination, replacing the switch with a direct branch if that is the case. Both of these patterns appear in the ENTER macro used by the RTS but are unlikely to occur in intermediate Cmm generated by GHC. Nofib result summary: -------------------------------------------------------------------------------- Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- Min -0.0% -0.0% -15.7% -15.6% 0.0% Max -0.0% 0.0% +5.4% +5.5% 0.0% Geometric Mean -0.0% -0.0% -1.0% -1.0% -0.0% Compiler allocations go up slightly: +0.2% Example output before and after the change taken from RTS code below. All but one of the memory loads `I32[_c3::I64 - 8]` are eliminated. Instead the data is loaded once from memory in block c6. Also the switch in block `ud` in the original code has been eliminated completely. Cmm without this commit: ``` stg_ap_0_fast() { // [R1] { [] } {offset ca: _c1::P64 = R1; // CmmAssign goto c2; // CmmBranch c2: if (_c1::P64 & 7 != 0) goto c4; else goto c6; c6: _c3::I64 = I64[_c1::P64]; if (I32[_c3::I64 - 8] < 26 :: W32) goto ub; else goto ug; ub: if (I32[_c3::I64 - 8] < 15 :: W32) goto uc; else goto ue; uc: if (I32[_c3::I64 - 8] < 8 :: W32) goto c7; else goto ud; ud: switch [8 .. 14] (%MO_SS_Conv_W32_W64(I32[_c3::I64 - 8])) { case 8, 9, 10, 11, 12, 13, 14 : goto c4; } ue: if (I32[_c3::I64 - 8] >= 25 :: W32) goto c4; else goto uf; uf: if (%MO_SS_Conv_W32_W64(I32[_c3::I64 - 8]) != 23) goto c7; else goto c4; c4: R1 = _c1::P64; call (P64[Sp])(R1) args: 8, res: 0, upd: 8; ug: if (I32[_c3::I64 - 8] < 28 :: W32) goto uh; else goto ui; uh: if (I32[_c3::I64 - 8] < 27 :: W32) goto c7; else goto c8; ui: if (I32[_c3::I64 - 8] < 29 :: W32) goto c8; else goto c7; c8: _c1::P64 = P64[_c1::P64 + 8]; goto c2; c7: R1 = _c1::P64; call (_c3::I64)(R1) args: 8, res: 0, upd: 8; } } ``` Cmm with this commit: ``` stg_ap_0_fast() { // [R1] { [] } {offset ca: _c1::P64 = R1; goto c2; c2: if (_c1::P64 & 7 != 0) goto c4; else goto c6; c6: _c3::I64 = I64[_c1::P64]; _ub::I64 = %MO_SS_Conv_W32_W64(I32[_c3::I64 - 8]); if (_ub::I64 < 26) goto uc; else goto uh; uc: if (_ub::I64 < 15) goto ud; else goto uf; ud: if (_ub::I64 < 8) goto c7; else goto c4; uf: if (_ub::I64 >= 25) goto c4; else goto ug; ug: if (_ub::I64 != 23) goto c7; else goto c4; c4: R1 = _c1::P64; call (P64[Sp])(R1) args: 8, res: 0, upd: 8; uh: if (_ub::I64 < 28) goto ui; else goto uj; ui: if (_ub::I64 < 27) goto c7; else goto c8; uj: if (_ub::I64 < 29) goto c8; else goto c7; c8: _c1::P64 = P64[_c1::P64 + 8]; goto c2; c7: R1 = _c1::P64; call (_c3::I64)(R1) args: 8, res: 0, upd: 8; } } ``` - - - - - 232002c4 by James Foster at 2019-07-13T16:37:34-04:00 Make HsInstances and DynFlags compile with -O0 for Stage0 to speed up Hadrian builds (fixes #16936) - - - - - a7176fa1 by Ömer Sinan Ağacan at 2019-07-13T16:38:13-04:00 Minor refactoring in CmmBuildInfoTables - Replace `catMaybes (map ...)` with `mapMaybe ...` - Remove a list->set->list conversion - - - - - ff04eb59 by John Ericson at 2019-07-14T01:19:22-04:00 Remove purely external primops The compiler doesn't create uses nor compiles the uses that exist specially. These are just plain C-- FFI. These `await*` ones are especially important to so convert because "true" primops are hard to make platform-specific currently. The other exports are part of this commit so this module always exports something, which avoids silly CPP elsewhere. More will be added later once `foreign import prim` is extended. - - - - - f9b00038 by Matthew Pickering at 2019-07-14T01:19:58-04:00 hadrian: Build debug rts with -O0 -g3 and disable rts stripping Fixes #16920 - - - - - f508b7ce by Ben Gamari at 2019-07-14T01:20:34-04:00 Don't package settings in bindist Since !712 the `settings` file is produced by the build system instead of autoconf. However, this introduced a subtle bug where we would fail to rebuild the `settings` file with what we have learned from the install-time `configure` invocation. Fix this by not packaging `settings` in the bindist tarball. The build system will take care of the rest. Also fix a bug where the value of `UseLibdw` was not being persisted to the install time `configure`. - - - - - e7ed53c9 by John Ericson at 2019-07-14T01:21:11-04:00 Remove LLVM_TARGET platform macros Instead following @angerman's suggestion put them in the config file. Maybe we could re-key llvm-targets someday, but this is good for now. - - - - - bd9fc1b2 by John Ericson at 2019-07-14T01:21:48-04:00 Make CPP linter skip certain files - docs which document the lint and need to contain the unutterable - vendored code which is outside our purview - - - - - d7c6c471 by John Ericson at 2019-07-14T01:21:48-04:00 Expunge #ifdef and #ifndef from the codebase These are unexploded minds as far as the linter is concerned. I don't want to hit in my MRs by mistake! I did this with `sed`, and then rolled back some changes in the docs, config.guess, and the linter itself. - - - - - fce8f240 by xplorld at 2019-07-14T08:32:48-04:00 rename type parameter in `instance Applicative ((->) a)`, fixing #16928 - - - - - 78ed46f3 by Niklas Hambüchen at 2019-07-14T08:33:26-04:00 primops: haddock: Fix typo in referenced function. Found by @lehins. - - - - - a39a3cd6 by Ben Gamari at 2019-07-15T00:14:40-04:00 gitlab-ci: Disable submodule linter for now - - - - - 0670f98a by Arnaud Spiwack at 2019-07-15T09:23:15+02:00 Add a note in the simplifier about in-scope set as a substitution See also the discussion at #16592 - - - - - 284a2f44 by Vladislav Zavialov at 2019-07-15T18:29:05-04:00 Decouple AddAnn from P - - - - - 1befd2c0 by Vladislav Zavialov at 2019-07-15T18:29:05-04:00 PV is not P (#16611) - - - - - 5728d9fa by Artem Pelenitsyn at 2019-07-16T02:40:08-04:00 Sort out Hadrian colored output flags (fix #16397) Hadrian used to have a separate flag --progress-colour to control colored output during the build. After introduction of a Shake flag with similar purpose Hadrian's flag became redundant. The commit removes --progress-colour and switches to Shake's flag. The only difference between the two is that Hadrian has special default mode when it tries to determine if the terminal support colored output. The user can override it using (Shake's) `--[no-]color`. - - - - - db948dae by Ben Gamari at 2019-07-16T02:40:43-04:00 Revert "Add support for SIMD operations in the NCG" Unfortunately this will require more work; register allocation is quite broken. This reverts commit acd795583625401c5554f8e04ec7efca18814011. - - - - - 373c9cb3 by Daniel Gröber at 2019-07-16T02:41:23-04:00 rts: Divorce init of Heap profiler from CCS profiler Currently initProfiling gets defined by Profiling.c only if PROFILING is defined. Otherwise the ProfHeap.c defines it. This is just needlessly complicated so in this commit I make Profiling and ProfHeap into properly seperate modules and call their respective init functions from RtsStartup.c. - - - - - 52f755aa by Daniel Gröber at 2019-07-16T02:41:23-04:00 rts: Rename the nondescript initProfiling2 to refreshProfilingCCSs - - - - - 0a9b77b8 by John Ericson at 2019-07-17T12:20:26-04:00 Create {Int,Word}32Rep This prepares the way for making Int32# and Word32# the actual size they claim to be. Updates binary submodule for (de)serializing the new runtime reps. - - - - - 8add024f by Sebastian Graf at 2019-07-17T12:20:27-04:00 Make GHC-in-GHCi work on Windows By not building anything in the dynamic way on Windows, where we don't have a working story for DLLs yet. Also the ghcid command needs to call bash on the hadrian/ghci.sh script explicitly as the path gets interpreted differently otherwise. - - - - - d48da6ff by Ben Gamari at 2019-07-18T20:55:11-04:00 gitlab-ci: Run slow validate in -debug job Otherwise we don't compile the stage2 compiler with DEBUG, meaning the testsuite isn't checked with assertions. Metric Increase: haddock.Cabal - - - - - 272246bf by Ben Gamari at 2019-07-18T20:55:11-04:00 testsuite: More type checking fixes - - - - - c7bcd017 by Ben Gamari at 2019-07-18T20:55:11-04:00 Add HasDebugCallStack to unionLists This should help identify a few cases where this is throwing warnings - - - - - 3cec2af6 by Ben Gamari at 2019-07-18T20:55:11-04:00 testsuite: Mark static-plugins as broken in profiled ways See #16803. - - - - - e8adffb5 by Ben Gamari at 2019-07-18T20:55:11-04:00 testsuite: Set -dinitial-unique when reversing uniques Otherwise the unique counter starts at 0, causing us to immediately underflow. - - - - - b9e9d8c9 by Ben Gamari at 2019-07-18T20:55:11-04:00 testsuite: Fix req_th - - - - - d238d306 by Ben Gamari at 2019-07-18T20:55:11-04:00 Fix formatting of --info's "Debug on" field As noted in #16914, the value `True` was used instead of `YES` here, in contrast to the other boolean fields emitted by `--info`. This confused the testsuite driver and broke the `ghc_debugged` testsuite predicate. - - - - - eb8c40e3 by Ben Gamari at 2019-07-18T20:55:11-04:00 testsuite: Mark hWaitForInput-accurate-stdin as broken in all threaded ways Previously it was not marked as broken in profthreaded - - - - - b16cabc1 by Ben Gamari at 2019-07-18T20:55:11-04:00 testsuite: Print output from hp2ps - - - - - b62a2dfb by Ben Gamari at 2019-07-18T20:55:11-04:00 testsuite: Fix some ints used as bools - - - - - b3df1efb by Ben Gamari at 2019-07-18T20:55:11-04:00 testsuite: Skip forking tests in profiled ways As noted in #11645 and #8862, forking and profiling don't go well together. Bumps hpc and unix submodules. - - - - - 49dcbf86 by Ben Gamari at 2019-07-18T20:55:11-04:00 testsuite: Mark test-hole-plugin as req_th This requires code loading and therefore can't be run in the profiled ways when GHC is dynamically linked. - - - - - ce8ffd80 by Ben Gamari at 2019-07-18T20:55:11-04:00 testsuite: Unmark recomp007 as broken Fixed in #14759. - - - - - 82abc479 by Ben Gamari at 2019-07-18T20:55:11-04:00 testsuite: Mark T4808 as broken in threaded2 way As noted in #16909. - - - - - 73703d9b by Artem Pelenitsyn at 2019-07-19T18:06:22-04:00 Hide "Loading package environment" message with -v0 (fix #16879) - - - - - 9372ff92 by Vladislav Zavialov at 2019-07-19T18:06:57-04:00 Drop the orphan roles check (#16941) 9366e019 introduced a check for orphan roles to fix #8485 6ab5da99 changed the lookup code and made the check redundant. Now it is removed. - - - - - 69adb253 by Richard Eisenberg at 2019-07-19T18:07:37-04:00 Fix #16870 by improving documentation (only) - - - - - f1980a1e by Sebastian Graf at 2019-07-19T18:08:15-04:00 Make generated ghc-stage<n> scripts executable - - - - - bec17997 by James Foster at 2019-07-19T18:08:51-04:00 users-guide: corrected -fmax-relevant-binds reverse to be -fno-max-relevant-binds - - - - - 257d1fd8 by Ryan Scott at 2019-07-19T18:09:28-04:00 Don't maintainer-clean libraries/ghc-boot/ghc.mk (#16953) This makes the `maintainer-clean` rule in `ghc.mk` slightly more sophisticated so that it does not remove the version-controlled file `libraries/ghc-boot/ghc.mk`, which was checked into version control in commit 24782b89907ab36fb5aef3a17584f4c10f1e2690. Fixes #16953. - - - - - ff996555 by Richard Eisenberg at 2019-07-19T18:10:06-04:00 Add module doc for Plugins. This was requested in #15650. - - - - - 08ad7ef4 by Baldur Blöndal at 2019-07-20T07:51:22-04:00 Added do-notation examples for Functor, Applicative and Monad combinators. - - - - - 7b42ece5 by Alfredo Di Napoli at 2019-07-20T07:52:01-04:00 Line wrap when pp long expressions (fixes #16874) This commit fixes #16874 by using `fsep` rather than `sep` when pretty printing long patterns and expressions. - - - - - 3676375f by Andreas Klebinger at 2019-07-20T07:52:39-04:00 Bump nofib submodule. - - - - - 4dfd6a5f by Matthew Pickering at 2019-07-20T07:53:15-04:00 hadrian: Remove RTS -Waggregate-return warning This was removed from make in 077b92fa39839a8e83cd87398435424403cf6486 - - - - - 5042ba9d by Andreas Klebinger at 2019-07-21T05:03:04-04:00 Expose the GhcPrelude module. This makes it simpler to load Modules importing it when using ghc-the-package. ------------------------- Metric Decrease: haddock.compiler ------------------------- - - - - - 67ee741b by Ivan Kasatenko at 2019-07-21T05:03:40-04:00 Do not ignore events deletion when events to be added are provided (#16916) Kqueue/kevent implementation used to ignore events to be unsubscribed from when events to be subscribed to were provided. This resulted in a lost notification subscription, when GHC runtime didn't listen for any events, yet the kernel considered otherwise and kept waking up the IO manager thread. This commit fixes this issue by always adding and removing all of the provided subscriptions. - - - - - 32be4461 by Roland Senn at 2019-07-21T05:04:17-04:00 Fix #8487: Debugger confuses variables To display the free variables for a single breakpoint, GHCi pulls out the information from the fields `modBreaks_breakInfo` and `modBreaks_vars` of the `ModBreaks` data structure. For a specific breakpoint this gives 2 lists of types 'Id` (`Var`) and `OccName`. They are used to create the Id's for the free variables and must be kept in sync: If we remove an element from the Names list, then we also must remove the corresponding element from the OccNames list. - - - - - 4854a349 by Ben Gamari at 2019-07-21T05:04:53-04:00 ghc-cabal: Use fromFlagOrDefault instead of fromFlag As fromFlag is partial. The only case where we used fromFlag is when determining whether to strip libraries; we now assume that we shouldn't. - - - - - 4c7a8462 by Xavier Denis at 2019-07-23T11:43:59-04:00 Make sure to load interfaces when running :instances - - - - - f9af30f8 by Ömer Sinan Ağacan at 2019-07-23T11:44:38-04:00 Remove fix-submodules.py Now that we have absolute paths for submodules (since a76b233d) we no longer need this script. - - - - - 6ade71fb by Alp Mestanogullari at 2019-07-23T23:06:36-04:00 Hadrian: run the testsuite in Windows CI job Since MR !1025 fixed the Windows build, allowing us to build a binary distribution, we can now run the testsuite in that CI job. This required fixing 'createFileLink': it should not try to create symlinks on Windows (that requires admin priviledges, which Hadrian can't assume). We now instead fall back to copying. This patch also removes some duplicated logic for iserv in the test rules, where we handle our dependency on the iserv binaries in a special way. - - - - - 3dbcc368 by Richard Eisenberg at 2019-07-23T23:07:13-04:00 Simon and I like to work in hsSyn, too. - - - - - b95b6380 by John Ericson at 2019-07-24T16:49:53-04:00 Make stage 1 GHC target independent Now that the target macros are not being used, we remove them. This prevents target hardcoding regressions. - - - - - d0f8ed20 by Ben Gamari at 2019-07-24T16:50:28-04:00 gitlab-ci: Fix source tarball job * Use show! in source tarball job. Since we aren't actually building anything in this job `show` won't work. * Fix Docker image name * Make `version` file contain only version string - - - - - 90dd2ea0 by Vladislav Zavialov at 2019-07-24T23:11:22-04:00 ASSERT(vis_flag==ForallInvis) in hsScopedTvs - - - - - e07f0e2b by Vladislav Zavialov at 2019-07-24T23:11:57-04:00 Drop unused helpers 'mkTyClGroup' and 'emptyTyClGroup' - - - - - cb495b3c by Ryan Scott at 2019-07-25T17:25:26-04:00 Make DefUses = OrdList DefUse Before, `type DefUses = [DefUse]`. But lists are a terrible choice of data structure here, as we frequently append to the right of a `DefUses`, which yields some displeasing asymptotics. Let's instead use `OrdList`, which has constant-time appending to the right. This is one step on the way to #10347. - - - - - b9c99df1 by Ömer Sinan Ağacan at 2019-07-25T17:26:03-04:00 Printer: add an empty line between bindings in Rec STG binding groups Before: Rec { x2_r10T :: Lib.Bar [GblId, Unf=OtherCon []] = CCS_DONT_CARE Lib.Bar! [x3_r10U]; x3_r10U :: Lib.Foo [GblId, Unf=OtherCon []] = CCS_DONT_CARE Lib.Foo! [x1_r10p x2_r10T]; end Rec } After: Rec { x2_r10T :: Lib.Bar [GblId, Unf=OtherCon []] = CCS_DONT_CARE Lib.Bar! [x3_r10U]; x3_r10U :: Lib.Foo [GblId, Unf=OtherCon []] = CCS_DONT_CARE Lib.Foo! [x1_r10p x2_r10T]; end Rec } - - - - - 30b6f391 by Ryan Scott at 2019-07-26T00:57:02-04:00 Banish reportFloatingViaTvs to the shadow realm (#15831, #16181) GHC used to reject programs of this form: ``` newtype Age = MkAge Int deriving Eq via Const Int a ``` That's because an earlier implementation of `DerivingVia` would generate the following instance: ``` instance Eq Age where (==) = coerce @(Const Int a -> Const Int a -> Bool) @(Age -> Age -> Bool) (==) ``` Note that the `a` in `Const Int a` is not bound anywhere, which causes all sorts of issues. I figured that no one would ever want to write code like this anyway, so I simply banned "floating" `via` type variables like `a`, checking for their presence in the aptly named `reportFloatingViaTvs` function. `reportFloatingViaTvs` ended up being implemented in a subtly incorrect way, as #15831 demonstrates. Following counsel with the sage of gold fire, I decided to abandon `reportFloatingViaTvs` entirely and opt for a different approach that would _accept_ the instance above. This is because GHC now generates this instance instead: ``` instance forall a. Eq Age where (==) = coerce @(Const Int a -> Const Int a -> Bool) @(Age -> Age -> Bool) (==) ``` Notice that we now explicitly quantify the `a` in `instance forall a. Eq Age`, so everything is peachy scoping-wise. See `Note [Floating `via` type variables]` in `TcDeriv` for the full scoop. A pleasant benefit of this refactoring is that it made it much easier to catch the problem observed in #16181, so this patch fixes that issue too. Fixes #15831. Fixes #16181. - - - - - aae0457f by nineonine at 2019-07-26T00:57:39-04:00 Change behaviour of -ddump-cmm-verbose to dump each Cmm pass output to a separate file and add -ddump-cmm-verbose-by-proc to keep old behaviour (#16930) - - - - - 00d9d284 by Vladislav Zavialov at 2019-07-26T00:58:15-04:00 TemplateHaskell: reifyType (#16976) - - - - - ea08fa37 by Vladislav Zavialov at 2019-07-26T00:58:15-04:00 reifyTypeOfThing: panic on impossible cases - - - - - 7c9fb2f0 by Adam Sandberg Eriksson at 2019-07-26T09:49:14-04:00 ghc-heap: implement WEAK closure type #16974 - - - - - 26314386 by nineonine at 2019-07-26T09:49:51-04:00 Add regression test for #16946 - - - - - cd11f81f by Fumiaki Kinoshita at 2019-07-28T19:47:50-04:00 base: add Functor, Applicative, Monad, Alternative, MonadPlus, Generic and Generic1 instances to Kleisli - - - - - c1a06d49 by Dale Wijnand at 2019-07-28T19:48:27-04:00 hadrian: relink to the flavours doc in the ghc repo - - - - - 9f8cdb35 by Richard Eisenberg at 2019-07-29T19:32:16-04:00 Add Note [RuntimeRep and PrimRep] in RepType Also adds Note [Getting from RuntimeRep to PrimRep], which deocuments a related thorny process. This Note addresses #16964, which correctly observes that documentation for this thorny design is lacking. Documentation only. - - - - - 86f47b8e by Dale Wijnand at 2019-07-29T19:32:52-04:00 hadrian: Drop a stale limitation tracking issue https://github.com/snowleopard/hadrian/issues/187 was superseded by https://github.com/snowleopard/hadrian/issues/669, which has also been closed. So, optimistically, dropping this as a limitation issue. - - - - - 9c8a211a by Andreas Klebinger at 2019-07-30T01:33:50-04:00 Expand the preallocated Int range to [-16,255] Effects as I measured them: RTS Size: +0.1% Compile times: -0.5% Runtine nofib: -1.1% Nofib runtime result seems to mostly come from the `CS` benchmark which is very sensible to alignment changes so this is likely over represented. However the compile time changes are realistic. This is related to #16961. - - - - - 2829f6da by Simon Peyton Jones at 2019-07-30T01:34:27-04:00 Apply a missing substitution in mkEtaWW (#16979) The `mkEtaWW` case for newtypes forgot to apply the substitution to the newtype coercion, resulting in the Core Lint errors observed in #16979. Easily fixed. Fixes #16979. Co-authored-by: Ryan Scott <ryan.gl.scott at gmail.com> - - - - - 371dadfb by Ben Gamari at 2019-07-31T04:27:59-04:00 Break up TyCoRep This breaks up the monstrous TyCoReps module into several new modules by topic: * TyCoRep: Contains the `Coercion`, `Type`, and related type definitions and a few simple predicates but nothing further * TyCoPpr: Contains the the pretty-printer logic * TyCoFVs: Contains the free variable computations (and `tyConAppNeedsKindSig`, although I suspect this should change) * TyCoSubst: Contains the substitution logic for types and coercions * TyCoTidy: Contains the tidying logic for types While we are able to eliminate a good number of `SOURCE` imports (and make a few others smaller) with this change, we must introduce one new `hs-boot` file for `TyCoPpr` so that `TyCoRep` can define `Outputable` instances for the types it defines. Metric Increase: haddock.Cabal haddock.compiler - - - - - b6fa7fe3 by Ben Gamari at 2019-07-31T04:27:59-04:00 gitignore: Add .mypy_cache - - - - - 88410e77 by Ben Gamari at 2019-07-31T04:27:59-04:00 Move tyConAppNeedsKindSig to Type Previously it was awkwardly in TyCoFVs (and before that in TyCoRep). Type seems like a sensible place for it to live. - - - - - 787fab43 by Ben Gamari at 2019-07-31T04:27:59-04:00 Work around redundant import issue As mentioned in #16997, GHC currently complains about this import. In general I'm reluctant to paper over things like this but in the case of an hs-boot file I think adding an import list is the right thing to do regardless of the bug. - - - - - 5e04841c by Ben Gamari at 2019-07-31T13:53:58-04:00 gitlab-ci: Fix it after upgrade It seems that the regular expression parser changed in GitLab 12.1 and now does now support forward slashes in the RE, even when escaped. - - - - - 986643cb by Ivan Kasatenko at 2019-08-01T13:49:50-04:00 Fix T16916 CI failures (#16966) 1. Slightly increased the waiting time for the tested effect to be more profound. 2. Introduced measuring of the actual time spent waiting and adjusing CPU time by it to compensate for threadDelay waiting time inconsistencies. - - - - - 95521140 by Andreas Klebinger at 2019-08-02T08:14:10-04:00 Add StandaloneDeriving example for DerivingVia. [skip-ci] - - - - - 1b9d32b8 by Ryan Scott at 2019-08-02T08:14:47-04:00 Rip out 9-year-old pattern variable hack (#17007) GHC had an ad hoc validity check in place to rule out pattern variables bound by type synonyms, such as in the following example: ```hs type ItemColID a b = Int -- Discards a,b get :: ItemColID a b -> ItemColID a b get (x :: ItemColID a b) = x :: ItemColID a b ``` This hack is wholly unnecessary nowadays, since OutsideIn(X) is more than capable of instantiating `a` and `b` to `Any`. In light of this, let's rip out this validity check. Fixes #17007. - - - - - 93bed40a by Ryan Scott at 2019-08-02T08:15:25-04:00 Use injectiveVarsOfType to catch dodgy type family instance binders (#17008) Previously, we detected dodgy type family instances binders by expanding type synonyms (via `exactTyCoVarsOfType`) and looking for type variables on the RHS that weren't mentioned on the (expanded) LHS. But this doesn't account for type families (like the example in #17008), so we instead use `injectiveVarsOfType` to only count LHS type variables that are in injective positions. That way, the `a` in `type instance F (x :: T a) = a` will not count if `T` is a type synonym _or_ a type family. Along the way, I moved `exactTyCoVarsOfType` to `TyCoFVs` to live alongside its sibling functions that also compute free variables. Fixes #17008. - - - - - c902f56b by Krzysztof Gogolewski at 2019-08-02T08:16:03-04:00 Remove build.nix.sh This file refers to shell.nix, which was removed in 430e6fedfda and c00d2f59d. - - - - - 5e960287 by Adam Sandberg Eriksson at 2019-08-02T08:16:45-04:00 docs: fixs -prof links in rts-flags section - - - - - 0c5cd771 by Alp Mestanogullari at 2019-08-02T22:20:14-04:00 compiler: emit finer grained codegen events to eventlog - - - - - 0ecacb1e by Alp Mestanogullari at 2019-08-02T22:20:14-04:00 Add Note [withTiming] in compiler/main/ErrUtils.hs - - - - - 4664bafc by Ben Gamari at 2019-08-02T22:20:50-04:00 rts: Always truncate output files Previously there were numerous places in the RTS where we would fopen with the "w" flag string. This is wrong as it will not truncate the file. Consequently if we write less data than the previous length of the file we will leave garbage at its end. Fixes #16993. - - - - - e3cbe319 by Ben Gamari at 2019-08-02T22:21:26-04:00 Packages: Add timing for package database initialization - - - - - a5227080 by Alp Mestanogullari at 2019-08-02T22:22:06-04:00 Hadrian: make settings, platformConstants, etc dependencies of lib:ghc This fixes #17003, where a user directly asked for the 'docs-haddock' target without building a complete stage 2 GHC first. Since haddock only depends on lib:ghc, the stage 2 GHC executable wasn't built, and neither were the settings, platformConstants, llvm-passes and llvm-targets files, since they are declared to be dependencies of exe:ghc. This makes sense in general since all GHC API users (haddock is one) will likely want those files to be there. - - - - - 7e404afd by Ben Gamari at 2019-08-04T18:16:51-04:00 gitlab-ci: Manually set SPHINXBUILD on Windows For some reason configure seems unable to find it on its own. Let's try giving it a hint. Addresses #16398. - - - - - 8a061d18 by Matthew Pickering at 2019-08-04T18:17:28-04:00 Update .gitignore Add some files generated by hadrian and some tooling files - - - - - 7d8d0012 by Simon Peyton Jones at 2019-08-04T18:18:08-04:00 Don't float unlifted join points to top level Ticket #16978 showed that we were floating a recursive, unlifted join point to top level. It's very much a corner case: joinrec j :: Int# j = jump j in ... But somehow it showed up in a real program. For non-recursive bindings in SetLevels.lvlBind we were already (correctly) checking for unlifted bindings, but when I wrote that code I didn't think that a /recursive/ binding could be unlifted but /join-points/ can be! Actually I don't think that SetLevels should be floating join points at all. SetLevels really floats things to move stuff out of loops and save allocation; but none of that applies to join points. The only reason to float join points is in cases like join j1 x = join j2 y = ... in ... which we might want to swizzle to join j2 x y = ... in join j1 x = ... in ... because now j1 looks small and might be inlined away altogether. But this is a very local float perhaps better done in the simplifier. Still: this patch fixes the crash, and does so in a way that is harmless if/when we change our strategy for floating join points. - - - - - 3b31a94d by Ben Gamari at 2019-08-04T18:18:08-04:00 testsuite: Add testsuite for #16978 - - - - - 2e031806 by Ben Gamari at 2019-08-04T18:18:45-04:00 configure: Search for LLVM executables with two-number versions Fedora uses the naming llc-7.0 while Debian uses llc-7. Ensure that both are found. Fixes #16990. - - - - - 6e5dfcd2 by Ben Gamari at 2019-08-04T18:19:21-04:00 testsuite: Rework tracking of fragile tests Breaks fragile tests into two groups, allowing us to easily preserve stdout/stderr of failing fragile tests. - - - - - ea16f6cb by Simon Peyton Jones at 2019-08-06T20:24:41-04:00 Remove dead parameter from coreToStgApp - - - - - 0c1ccf3c by James Foster at 2019-08-06T20:25:18-04:00 hadrian: Refactor file patterns for future Shake changes (fixes #17005) Shake will be moving from its current implementation of ?== to one from System.FilePattern. Support for `//` is being dropped, leaving only `*` and `**` as special forms. This commit converts the existing file patterns in Hadrian to the new format. It also removes all occurances of <//> and changes the user-settings docs to remove references to // and add **. The conversion is as follows: - //a ==> **/a - a// ==> a/** - a//b ==> a/**/b - - - - - c83e39bf by Matthew Pickering at 2019-08-06T20:25:54-04:00 Remove old/broken(?) .ghci script I was attempting to load hadrian into ghci by using `cabal new-repl exe:hadrian` but it failed because it tried to use this `.ghci` configuration. I'm not sure who used this script but you should really use the new-repl method. - - - - - 6f116005 by Ömer Sinan Ağacan at 2019-08-06T20:26:32-04:00 Introduce a type for "platform word size", use it instead of Int We introduce a PlatformWordSize type and use it in platformWordSize field. This removes to panic/error calls called when platform word size is not 32 or 64. We now check for this when reading the platform config. - - - - - 2073745c by mniip at 2019-08-07T10:18:07-04:00 Add a -fprint-axiom-incomps option (#15546) Supply branch incomps when building an IfaceClosedSynFamilyTyCon `pprTyThing` now has access to incomps. This also causes them to be written out to .hi files, but that doesn't pose an issue other than a more faithful bijection between `tyThingToIfaceDecl` and `tcIfaceDecl`. The machinery for displaying axiom incomps was already present but not in use. Since this is now a thing that pops up in ghci's :info the format was modified to look like a haskell comment. Documentation and a test for the new feature included. Test Plan: T15546 Reviewers: simonpj, bgamari, goldfire Reviewed By: simonpj Subscribers: rwbarton, carter GHC Trac Issues: #15546 Differential Revision: https://phabricator.haskell.org/D5097 - - - - - bca79345 by mniip at 2019-08-07T10:18:07-04:00 Fix test - - - - - 3d32286d by mniip at 2019-08-07T10:18:07-04:00 Explicitly number equations when printing axiom incompatibilities - - - - - ca8efc49 by mniip at 2019-08-07T10:18:07-04:00 Fix documentation - - - - - 2c1b1ad7 by mniip at 2019-08-07T10:18:07-04:00 Fix test - - - - - 8e2fe575 by Zubin Duggal at 2019-08-07T10:18:44-04:00 Fix bug preventing information about patterns from being serialized in .hie files - - - - - f1d0e49f by Ben Gamari at 2019-08-07T10:19:21-04:00 testsuite: Add tests for #16943 - - - - - 83ca42de by Ben Gamari at 2019-08-07T10:19:21-04:00 Revert "Make scanr a good producer and consumer" This reverts commit 4e1dfc3767167dddd0e151a2df8305b12aa0f49c. Due to #16943. - - - - - 81860281 by Joachim Breitner at 2019-08-10T14:39:27-04:00 Consolidate `TablesNextToCode` and `GhcUnreigsterised` in configure (#15548) `TablesNextToCode` is now a substituted by configure, where it has the correct defaults and error handling. Nowhere else needs to duplicate that, though we may want the compiler to to guard against bogus settings files. I renamed it from `GhcEnableTablesNextToCode` to `TablesNextToCode` to: - Help me guard against any unfixed usages - Remove any lingering connotation that this flag needs to be combined with `GhcUnreigsterised`. Original reviewers: Original subscribers: TerrorJack, rwbarton, carter Original Differential Revision: https://phabricator.haskell.org/D5082 - - - - - 422ffce0 by Ben Gamari at 2019-08-10T14:40:03-04:00 Add timing on loadInterface AndreasK recently mentioned that he thought that interface file loading may be a non-trivial cost. Let's measure. - - - - - 0424de2d by Ömer Sinan Ağacan at 2019-08-10T14:40:46-04:00 Add test for #16893 - - - - - 672cbab2 by Ömer Sinan Ağacan at 2019-08-10T14:41:26-04:00 Reformat comments in StgSyn This does not make any changes in the contents -- formatting only. Previously the comments were too noisy and I've always found it very hard to read. Hopefully it's easier to read now. - - - - - 328a0efa by Sebastian Graf at 2019-08-13T17:30:15-04:00 Add Foldable, Traversable instances for Uniq(D)FM The `UniqDFM` is deterministic, of course, while we provide an unsafe `NonDetUniqFM` wrapper for `UniqFM` to opt into nondeterministic instances. - - - - - b1d29c67 by Tamar Christina at 2019-08-13T17:30:50-04:00 Fix binary distribution - - - - - a38104b4 by Andreas Klebinger at 2019-08-14T16:55:42-04:00 Rework the Binary Integer instance. We used to serialise large integers as strings. Now they are serialized as a list of Bytes. This changes the size for a Integer in the higher 64bit range from 77 to 9 bytes when written to disk. The impact on the general case is small (<1% for interface files) as we don't use many Integers. But for code that uses many this should be a nice benefit. - - - - - aa4d8b07 by Andreas Klebinger at 2019-08-14T16:56:20-04:00 Use os.devnull instead of '/dev/null' in the testsuite driver. The later caused issues on windows by being translated into "\\dev\\null" and python then trying to open this non-existant file. So we now use os.devnull inside python and convert it to "/dev/null" when calling out to the shell, which is bound to run in a unix like environment. This fixes an issue a test producing unexpected stderr output failed with a framework failure instead of showing a diff of the output. - - - - - 6329c70a by Richard Eisenberg at 2019-08-14T17:47:25-04:00 GHCi supports not-necessarily-lifted join points Fixes #16509. See Note [Not-necessarily-lifted join points] in ByteCodeGen, which tells the full story. This commit also adds some comments and cleans some code in the byte-code generator, as I was exploring around trying to understand it. (This commit removes an old test -- this is really a GHCi problem, not a pattern-synonym problem.) test case: ghci/scripts/T16509 - - - - - ca71d551 by James Foster at 2019-08-15T12:01:43-04:00 Remove unused imports of the form 'import foo ()' (Fixes #17065) These kinds of imports are necessary in some cases such as importing instances of typeclasses or intentionally creating dependencies in the build system, but '-Wunused-imports' can't detect when they are no longer needed. This commit removes the unused ones currently in the code base (not including test files or submodules), with the hope that doing so may increase parallelism in the build system by removing unnecessary dependencies. - - - - - 95837c0f by Tobias Dammers at 2019-08-15T22:13:13-04:00 Add test cases for #16615 - - - - - 8d076841 by Tobias Dammers at 2019-08-15T22:13:13-04:00 Make add_info attach unfoldings (#16615) - - - - - 14208853 by Sylvain Henry at 2019-08-15T22:13:52-04:00 Cmm: constant folding `quotRem x 2^N` `quot` and `rem` are implemented efficiently when the second argument is a constant power of 2. This patch uses the same implementations for `quotRem` primop. - - - - - 47e16237 by Ömer Sinan Ağacan at 2019-08-15T22:14:31-04:00 Document types of LitNumbers, minor refactoring in Literal.hs - - - - - ac73c1b1 by Sylvain Henry at 2019-08-18T05:16:40-04:00 Faster exactLog2 Make `exactLog2` faster (use `countLeadingZeros` and Int32 bit-ops). On my Core i7-9700k Criterion reports ~50% speedup (from 16 to 8ns). - - - - - 1230d6f9 by Ömer Sinan Ağacan at 2019-08-18T05:17:20-04:00 Typo fix in CoreToStg - - - - - d0716279 by Ryan Scott at 2019-08-18T05:18:01-04:00 Fix #17067 by making data family type constructors actually injective `TcTyClsDecls.tcFamDecl1` was using `NotInjective` when creating data family type constructors, which is just plain wrong. This tweaks it to use `Injective` instead. Fixes #17067. - - - - - 993804bf by Sam Halliday at 2019-08-18T16:39:21-04:00 expose ModuleInfo.minf_rdr_env for tooling authors - - - - - 5b713aa3 by Ömer Sinan Ağacan at 2019-08-18T16:40:03-04:00 Fix COMPACT_NFDATA closure size, more CNF sanity checking We now do a shallow closure check on objects in compact regions. See the new comment on why we can't do a "normal" closure check. - - - - - ac7c738b by Richard Lupton at 2019-08-19T02:11:59-04:00 Generalized MonadUtils folds to Foldable (#16969) - - - - - 3a1efe1a by Richard Lupton at 2019-08-19T02:12:00-04:00 Re-export foldlM and foldrM from Data.Foldable in MonadUtils (#16969) - - - - - 2a394246 by Richard Lupton at 2019-08-19T02:12:00-04:00 Use Foldable instance of Bag for specialised Bag folds (#16969) - - - - - ac79dfe9 by Richard Lupton at 2019-08-19T02:12:00-04:00 Remove Bag fold specialisations (#16969) - - - - - 5e40356f by Ben Gamari at 2019-08-19T02:12:36-04:00 gitlab-ci: Update bootstrap compiled used for Darwin builds - - - - - d5055248 by Ben Gamari at 2019-08-22T09:25:08-04:00 gitlab-ci: Add Windows full build during the nightly pipeline - - - - - a33bad2d by Sylvain Henry at 2019-08-22T09:25:47-04:00 Doc: add Haddocks for quotRemWord2 primop - - - - - 605bce26 by James Foster at 2019-08-22T18:47:20-04:00 Add documentation for Hadrian expressions This commit adds documentation on Hadrian's 'Expr' type and references the documentation in hadrian/README.md - - - - - 8f32d2bc by TDecki at 2019-08-22T18:47:57-04:00 base: Reintroduce fusion for scanr While avoiding #16943. - - - - - c3e26ab3 by Ömer Sinan Ağacan at 2019-08-22T22:19:26-04:00 Remove special case in SRT generation with -split-sections Previously we were using an empty ModuleSRTInfo for each Cmm group with -split-section. As far as I can see this has no benefits, and simplifying this makes another patch simpler (!1304). We also remove some outdated comments: we no longer generate one module-level SRT. - - - - - a8300520 by Ömer Sinan Ağacan at 2019-08-23T12:04:15+03:00 Make non-streaming LLVM and C backends streaming This adds a Stream.consume function, uses it in LLVM and C code generators, and removes the use of Stream.collect function which was used to collect streaming Cmm generation results into a list. LLVM and C backends now properly use streamed Cmm generation, instead of collecting Cmm groups into a list before generating LLVM/C code. - - - - - 47070144 by Andreas Klebinger at 2019-08-23T19:26:42-04:00 Use variable length encoding for Binary instances. Use LEB128 encoding for Int/Word variants. This reduces the size of interface files significantly. (~19%). Also includes a few small optimizations to make unboxing work better that I have noticed while looking at the core. - - - - - cff44d86 by Sergei Trofimovich at 2019-08-23T19:27:21-04:00 configure.ac: fix '--disable-dwarf-debug' Before the change ./configure --disable-dwarf-debug enabled DWARF debugging unconditionally. This happened due to use of 5-argument form of `AC_ARG_ENABLE` without actually checking the passed `$enableval` parameter: ``` AC_ARG_ENABLE(dwarf-unwind, [AC_HELP_STRING([--enable-dwarf-unwind], [Enable DWARF unwinding support in the runtime system via elfutils' libdw [default=no]])], [AC_CHECK_LIB(dw, dwfl_attach_state, [UseLibdw=YES], [AC_MSG_ERROR([Cannot find system libdw (required by --enable-dwarf-unwind)])])] [UseLibdw=NO] ) ``` Note: - `[UseLibdw=NO]` is called when `--{enable,disable}-dwarf-unwind` is not passed at all as a parameter (ok). - `[AC_CHECK_LIB(dw, dwfl_attach_state, [UseLibdw=YES],` is called for both: * `--enable-dwarf-unwind` being passed: `$enableval = "yes"` (ok). * --disable-dwarf-unwind` being passed: `$enableval = "no"` (bad). The change is to use 3-argument `AC_ARG_ENABLE` and check for passed value as `"$enable_dwarf_unwind" = "yes"`. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 10763ce0 by Ömer Sinan Ağacan at 2019-08-27T10:45:02+03:00 Some more documentation for typePrimRep1 stuff [skip ci] - - - - - 89487be2 by Ömer Sinan Ağacan at 2019-08-27T15:21:50-04:00 Some tweaks in GHC.Compact haddocks - - - - - ee2fad9e by Andreas Klebinger at 2019-08-27T15:22:28-04:00 Remove redundant OPTIONS_GHC in BlockLayout.hs - - - - - 1c7ec449 by Ömer Sinan Ağacan at 2019-08-28T12:51:12+03:00 Return results of Cmm streams in backends This generalizes code generators (outputAsm, outputLlvm, outputC, and the call site codeOutput) so that they'll return the return values of the passed Cmm streams. This allows accumulating data during Cmm generation and returning it to the call site in HscMain. Previously the Cmm streams were assumed to return (), so the code generators returned () as well. This change is required by !1304 and !1530. Skipping CI as this was tested before and I only updated the commit message. [skip ci] - - - - - a308b435 by Sebastian Graf at 2019-08-28T11:33:49-04:00 Fix #17112 The `mkOneConFull` function of the pattern match checker used to try to guess the type arguments of the data type's type constructor by looking at the ambient type of the match. This doesn't work well for Pattern Synonyms, where the result type isn't even necessarily a TyCon application, and it shows in #11336 and #17112. Also the effort seems futile; why try to try hard when the type checker has already done the hard lifting? After this patch, we instead supply the type constructors arguments as an argument to the function and lean on the type-annotated AST. - - - - - 137c24e1 by Ryan Scott at 2019-08-28T22:36:40-04:00 Balance parentheses in GHC 8.10.1 release notes [ci skip] - - - - - 66282ba5 by luca at 2019-08-28T22:37:19-04:00 Remove Unused flag -ddump-shape [skip ci] - - - - - bf9dfe1c by Ömer Sinan Ağacan at 2019-08-29T04:28:35-04:00 Fix LLVM version check yet again There were two problems with LLVM version checking: - The parser would only parse x and x.y formatted versions. E.g. 1.2.3 would be rejected. - The version check was too strict and would reject x.y formatted versions. E.g. when we support version 7 it'd reject 7.0 ("LLVM version 7.0") and only accept 7 ("LLVM version 7"). We now parse versions with arbitrarily deep minor numbering (x.y.z.t...) and accept versions as long as the major version matches the supported version (e.g. 7.1, 7.1.2, 7.1.2.3 ...). - - - - - fc746e98 by Ben Gamari at 2019-08-29T04:29:13-04:00 gitlab-ci: Fix URL of Darwin's cabal-install tarball This was inadvertently referring to the cabal-install-latest/ directory which is volatile. - - - - - 304067a0 by Ömer Sinan Ağacan at 2019-08-29T09:38:25-04:00 Small optimization in the SRT algorithm Noticed by @simonmar in !1362: If the srtEntry is Nothing, then it should be safe to omit references to this SRT from other SRTs, even if it is a static function. When updating SRT map we don't omit references to static functions (see Note [Invalid optimisation: shortcutting]), but there's no reason to add an SRT entry for a static function if the function is not CAFFY. (Previously we'd add SRT entries for static functions even when they're not CAFFY) Using 9151b99e I checked sizes of all SRTs when building GHC and containers: - GHC: 583736 (HEAD), 581695 (this patch). 2041 less SRT entries. - containers: 2457 (HEAD), 2381 (this patch). 76 less SRT entries. - - - - - 78afc2c9 by Sergei Trofimovich at 2019-08-30T06:14:44-04:00 configure.ac: add --enable-numa switch Before the change ./configure detected numa support automatically withoun a nice way to disable autodetection. The change adds `--enable-numa` / `--disable-numa` switch to override the default. If `--enable-numa` is passed and `libnuma` is not present then configure will fail. Reported-by: Sergey Alirzaev Bug: https://github.com/gentoo-haskell/gentoo-haskell/issues/955 Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - c0956c14 by Vladislav Zavialov at 2019-08-30T06:15:21-04:00 Remove HsUtils/userHsLTyVarBndrs This patch removes 'userHsLTyVarBndrs' and 'userHsTyVarBndrs' from HsUtils. These helper functions were not used anywhere. - - - - - 7e6aeb13 by Eric Wolf at 2019-08-31T10:25:39+02:00 Add additional step to T16804 Add another small test step Use the same identifier name in different scopes and see, if ':uses' handles that. Add another test step to check wether local bindings with the same identifier name might get confused Add easier to understand test output Fix annotated lines from file correctly - - - - - e56251f6 by Ömer Sinan Ağacan at 2019-08-31T17:55:13-04:00 Remove redundant special case in STG pretty-printer This special case existed for no reason, and made things inconsistent. Before Boolean.$bT :: Boolean.Boolean [GblId, Str=m, Unf=OtherCon []] = CAF_ccs \ u [] Boolean.$bT1; After Boolean.$bF :: Boolean.Boolean [GblId, Str=m, Unf=OtherCon []] = \u [] Boolean.$bF1; The cost-centre is now hidden when not profiling, as is the case with other types of closures. - - - - - cfab4abe by Gershom Bazerman at 2019-09-01T00:34:05-04:00 cap max stack size at 32 bit limit (#17019) - - - - - 9acba780 by John Ericson at 2019-09-01T22:44:45-04:00 Use C99 Fixed width types to avoid hack in base's configure Define MD5Context in terms of `uint*_t` and don't use `HsFFI.h`. - - - - - 11679e5b by Ömer Sinan Ağacan at 2019-09-02T13:17:49+03:00 Few tweaks in -ddump-debug output, minor refactoring - Fixes crazy indentation in -ddump-debug output - We no longer dump empty sections in -ddump-debug when a code block does not have any generated debug info - Minor refactoring in Debug.hs and AsmCodeGen.hs - - - - - f96d57b8 by John Ericson at 2019-09-05T18:50:19-04:00 Make the C-- O and C types constructors with DataKinds The tightens up the kinds a bit. I use type synnonyms to avoid adding promotion ticks everywhere. - - - - - b55ee979 by John Ericson at 2019-09-05T18:50:56-04:00 Make sure all boolean settings entries use `YES` / `NO` Some where using `True` / `False`, a legacy of when they were in `Config.hs`. See #16914 / d238d3062a9858 for a similar problem. Also clean up the configure variables names for consistency and clarity while we're at it. "Target" makes clear we are talking about outputted code, not where GHC itself runs. - - - - - 821bece9 by Ömer Sinan Ağacan at 2019-09-07T04:50:21-04:00 Minor refactoring in deriveConstants Mainly we now generate this data PlatformConstants = PlatformConstants { pc_CONTROL_GROUP_CONST_291 :: Int, pc_STD_HDR_SIZE :: Int, pc_PROF_HDR_SIZE :: Int, pc_BLOCK_SIZE :: Int, } instead of data PlatformConstants = PlatformConstants { pc_platformConstants :: () , pc_CONTROL_GROUP_CONST_291 :: Int , pc_STD_HDR_SIZE :: Int , pc_PROF_HDR_SIZE :: Int , pc_BLOCK_SIZE :: Int ... } The first field has no use and according to (removed) comments it was to make code generator's work easier.. if anything this version is simpler because it has less repetition (the commas in strings are gone). - - - - - b0fdd7fe by Alp Mestanogullari at 2019-09-07T04:50:59-04:00 hadrian: fix _build/ghc-stage1 to make it callable from any directory - - - - - 51379b89 by Ömer Sinan Ağacan at 2019-09-08T21:40:32-04:00 Add a new flag -dno-typeable-binds for debugging See the user manual entry -- this helps when debugging as generated Core gets smaller without these bindings. - - - - - d0b45ac6 by Moritz Kiefer at 2019-09-08T21:41:12-04:00 Fix GHC version guard for Int32Rep/Word32Rep Those constructors have been added after GHC 8.8. The version guards in `binary` are correct, see https://github.com/kolmodin/binary/pull/167/files. - - - - - 4cf91d1a by Daniel Gröber at 2019-09-09T05:42:33-04:00 Use lazyness for FastString's z-encoding memoization Having an IORef in FastString to memoize the z-encoded version is unecessary because there is this amazing thing Haskell can do natively, it's called "lazyness" :) We simply remove the UNPACK and strictness annotations from the constructor field corresponding to the z-encoding, making it lazy, and store the (pure) z-encoded string there. The only complication here is 'hasZEncoding' which allows cheking if a z-encoding was computed for a given string. Since this is only used for compiler performance statistics though it's not actually necessary to have the current per-string granularity. Instead I add a global IORef counter to the FastStringTable and use unsafePerformIO to increment the counter whenever a lazy z-encoding is forced. - - - - - f5e2fde4 by Daniel Gröber at 2019-09-09T05:42:33-04:00 Update FastString docstrings 1) FastStrings are always UTF-8 encoded now. 2) Clarify what is meant by "hashed" 3) Add mention of lazy z-enc - - - - - 270fbe85 by Ryan Scott at 2019-09-09T05:43:12-04:00 Replace queryCygwinTerminal with Win32's isMinTTYHandle `SysTools.Terminal.queryCygwinTerminal` now exists in the `Win32` library under the name `isMinTTYHandle` since `Win32-2.5.0.0`. (GHC 8.4.4 ships with `Win32-2.6.1.0`, so this is well within GHC's support window.) We can therefore get replace `queryCygwinTerminal` with `isMinTTYHandle` and delete quite a bit of code from `SysTools.Terminal` in the process. Along the way I needed to replace some uses of `#if defined x` with `#if defined(x)` to please the CI linters. - - - - - 447864a9 by Sylvain Henry at 2019-09-10T00:04:50+02:00 Module hierarchy: StgToCmm (#13009) Add StgToCmm module hierarchy. Platform modules that are used in several other places (NCG, LLVM codegen, Cmm transformations) are put into GHC.Platform. - - - - - 60c26403 by Niklas Hambüchen at 2019-09-11T09:44:23-04:00 linker: Move -optl flags to end of linker invocation. Until now, giving `-optl` linker flags to `ghc` on the command line placed them in the wrong place in the `ld` command line: They were given before all the Haskell libararies, when they should appear after. Background: Most linkers like `ld.bfd` and `ld.gold`, but not the newer LLVM `lld`, work in a way where the order of `-l` flags given matters; earlier `-lmylib1` flags are supposed to create "holes" for linker symbols that are to be filled with later `lmylib2` flags that "fill the holes" for these symbols. As discovered in https://github.com/haskell/cabal/pull/5451#issuecomment-518001240, the `-optl` flags appeared before e.g. the -lHStext-1.2.3.1 -lHSbinary-0.8.6.0 -lHScontainers-0.6.0.1 flags that GHC added at the very end. Haskell libraries typically depend on C libraries, so `-lHS*` flags will create holes for the C libraries to fill in, but that only works when those libraries' `-l` flags are given **after** the `-lHS*` flags; until now they were given before, which was wrong. This meant that Cabal's `--ld-options` flag and `ld-options` `.cabal` file field were pretty ineffective, unless you used the `--ld-option=--start-group` hack as (https://github.com/haskell/cabal/pull/5451#issuecomment-406761676) that convinces the classical linkers to not be dependent on the order of linker flags given. This commit fixes the problem by simply flipping the order, putting `-optl` flags at the end, after Haskell libraries. The code change is effectively only `args1 ++ args` -> `args ++ args1` but the commit also renames the variables for improved clarity. Simple way to test it: ghc --make Main.hs -fforce-recomp -v -optl-s on a `Main.hs` like: import qualified Data.Set as Set main = print $ Set.fromList "hello" - - - - - 7032a913 by John Ericson at 2019-09-11T09:45:02-04:00 Remove COMPILING_GHC It is no longer used. I guess we are sharing fewer headers with the RTS than the comment claims. That's a relief! - - - - - 58569a5b by Peter Trommler at 2019-09-11T09:45:47-04:00 testsuite: check for RTS linker Fixes #16833 - - - - - df6fbe03 by Luke Lau at 2019-09-11T09:46:36-04:00 Bump Hadrian's QuickCheck dependency - - - - - d9e637df by John Ericson at 2019-09-11T09:47:26-04:00 Remove dead `ncgDebugIsOn` and `NCG_DEBUG` Haven't been used since 16206a6603e87e15d61c57456267c5f7ba68050e. - - - - - 7ef6fe8f by Ben Gamari at 2019-09-11T09:48:03-04:00 SetLevels: Fix potential panic in lvlBind 3b31a94d introduced a use of isUnliftedType which can panic in the case of levity-polymorphic types. Fix this by introducing mightBeUnliftedType which returns whether the type is *guaranteed* to be lifted. - - - - - c76cc0c6 by Ömer Sinan Ağacan at 2019-09-11T19:40:06-04:00 Refactor bad coercion checking in a few places We do bad coercion checking in a few places in the compiler, but they all checked it differently: - CoreToStg.coreToStgArgs: Disallowed lifted-to-unlifted, disallowed changing prim reps even when the sizes are the same. - StgCmmExpr.cgCase: Checked primRepSlot equality. This disallowed Int to Int64 coercions on 64-bit systems (and Int to Int32 on 32-bit) even though those are fine. - CoreLint: Only place where we do this right. Full rules are explained in Note [Bad unsafe coercion]. This patch implements the check explained in Note [Bad unsafe coercion] in CoreLint and uses it in CoreToStg.coreToStgArgs and StgCmmExpr.cgCase. This fixes #16952 and unblocks !1381 (which fixes #16893). This is the most conservative and correct change I came up with that fixes #16952. One remaining problem with coercion checking is that it's currently done in seemingly random places. What's special about CoreToStg.coreToStgArgs and StgCmmExpr.cgCase? My guess is that adding assertions to those places caught bugs before so we left assertions in those places. I think we should remove these assertions and do coercion checking in CoreLint and StgLint only (#17041). - - - - - 3a7d3923 by Tamar Christina at 2019-09-11T19:40:53-04:00 Windows: make openTempFile fully atomic. - - - - - 98b0d6ee by Pranay Sashank at 2019-09-12T04:52:33-04:00 Print the correct system memory in use with +RTS -s (#17158) Use `stats.max_mem_in_use_bytes` to print the memory usage instead of `stats.max_live_bytes` which prints maximum residency. Fixes (#17158). - - - - - a06629b4 by John Ericson at 2019-09-12T04:53:13-04:00 Do not throw away backpack instantiations for module lookup cache Currently, there is only one home package so this probably doesn't matter. But if we support multiple home packages, they could differ only in arguments (same indef component being applied). It looks like it used to be this way before 4e8a0607140b23561248a41aeaf837224aa6315b, but that commit doesn't seem to comment on this change in the particular. (It's main purpose is creating the InstalledUnitId and recategorizing the UnitId expressions accordingly.) Trying this as a separate commit for testing purposes. I leave it to others to decide whether this is a good change on its own. - - - - - 09fa5654 by John Ericson at 2019-09-12T04:53:51-04:00 Remove unused `#include`s from parser/cutils.c Looks like these have been unused since 7c665f9ce0980ee7c81a44c8f861686395637453. - - - - - 2b37a79d by Sebastian Graf at 2019-09-12T14:05:29-04:00 Bump Cabal submodule to 3.1 ------------------------- Metric Increase: haddock.Cabal T4029 ------------------------- - - - - - 86753475 by Ningning Xie at 2019-09-12T14:06:07-04:00 Fix StandaloneDeriving If I understand correctly, `deriving instance _ => Eq (Foo a)` is equivalent to `data Foo a deriving Eq`, rather than `data Foo a deriving Foo`. - - - - - a733002a by Ben Gamari at 2019-09-13T03:09:47-04:00 Update mailmap - - - - - 5b64aee2 by Simon Peyton Jones at 2019-09-13T03:10:26-04:00 Fix scoping of implicit parameters There was an outright bug in TcInteract.solveOneFromTheOther which meant that we did not always pick the innermost implicit parameter binding, causing #17104. The fix is easy, just a rearrangement of conditional tests - - - - - 47b12660 by Tamar Christina at 2019-09-13T03:11:06-04:00 Windows: Fix hsc2hs non-deterministic failures. - - - - - e3a7592b by Alp Mestanogullari at 2019-09-13T03:11:50-04:00 Add a test to make sure we don't regress on #17140 in the future - - - - - 6f3cd50e by Zubin Duggal at 2019-09-13T11:24:51-04:00 Explain how to update HieAst [skip ci] - - - - - 71428a43 by Zubin Duggal at 2019-09-13T11:24:51-04:00 Address review comments [skip CI] - - - - - ccb4e646 by John Ericson at 2019-09-13T11:25:29-04:00 Compiler should always get fingerprinting impl from base 07ee15915d5a0d6d1aeee137541eec6e9c153e65 started the transition, but the job was never finished. - - - - - c45c89d6 by Ben Gamari at 2019-09-13T11:26:05-04:00 gitlab: Add issue template for documentation issues Fixes #17180. - - - - - a0e220b7 by John Ericson at 2019-09-13T11:26:43-04:00 Remove empty NCG.h - - - - - 046ca133 by Andrew Martin at 2019-09-13T15:43:16-04:00 Add predicates for testing if IOError is ResourceVanished. This adds isResourceVanished, resourceVanishedErrorType, and isResourceVanishedErrorType to System.IO.Error, resolving #14730. - - - - - bd079345 by taylorfausak at 2019-09-14T06:25:27-04:00 Fix CONLIKE typo - - - - - cf7e78a3 by Ben Gamari at 2019-09-15T23:46:36-04:00 Rename GHC.StgToCmm.Con -> GHC.StgToCmm.DataCon Incredibly, Windows disallows the manipulation of any file matching Con(\..*)?. The `GHC.StgToCmm.Con` was introduced in the renamings in 447864a9, breaking the Windows build. Work around this by renaming it to `GHC.StgToCmm.DataCon` Fixes #17187. - - - - - 7208160d by Sylvain Henry at 2019-09-15T23:47:22-04:00 Fix Hadrian build with Stack (#17189) Broken by 2b37a79d61e9b3787873dc9f7458ef2bde4809b0 - - - - - b5ae3868 by Sylvain Henry at 2019-09-16T13:32:22-04:00 Allow validation with Hadrian built with Stack [skip ci] - - - - - 7915afc6 by Sebastian Graf at 2019-09-16T13:33:05-04:00 Encode shape information in `PmOracle` Previously, we had an elaborate mechanism for selecting the warnings to generate in the presence of different `COMPLETE` matching groups that, albeit finely-tuned, produced wrong results from an end user's perspective in some cases (#13363). The underlying issue is that at the point where the `ConVar` case has to commit to a particular `COMPLETE` group, there's not enough information to do so and the status quo was to just enumerate all possible complete sets nondeterministically. The `getResult` function would then pick the outcome according to metrics defined in accordance to the user's guide. But crucially, it lacked knowledge about the order in which affected clauses appear, leading to the surprising behavior in #13363. In !1010 we taught the term oracle to reason about literal values a variable can certainly not take on. This MR extends that idea to `ConLike`s and thereby fixes #13363: Instead of committing to a particular `COMPLETE` group in the `ConVar` case, we now split off the matching constructor incrementally and record the newly covered case as a refutable shape in the oracle. Whenever the set of refutable shapes covers any `COMPLETE` set, the oracle recognises vacuosity of the uncovered set. This patch goes a step further: Since at this point the information in value abstractions is merely a cut down representation of what the oracle knows, value abstractions degenerate to a single `Id`, the semantics of which is determined by the oracle state `Delta`. Value vectors become lists of `[Id]` given meaning to by a single `Delta`, value set abstractions (of which the uncovered set is an instance) correspond to a union of `Delta`s which instantiate the same `[Id]` (akin to models of formula). Fixes #11528 #13021, #13363, #13965, #14059, #14253, #14851, #15753, #17096, #17149 ------------------------- Metric Decrease: ManyAlternatives T11195 ------------------------- - - - - - ae4415b9 by Matthew Pickering at 2019-09-17T19:21:10-04:00 eventlog: Add biographical and retainer profiling traces This patch adds a new eventlog event which indicates the start of a biographical profiler sample. These are different to normal events as they also include the timestamp of when the census took place. This is because the LDV profiler only emits samples at the end of the run. Now all the different profiling modes emit consumable events to the eventlog. - - - - - 9c21b2fd by Richard Eisenberg at 2019-09-17T19:22:00-04:00 Fix #13571 by adding an extension flag check Test case: indexed-types/should_fail/T13571 - - - - - 8039b125 by Simon Peyton Jones at 2019-09-17T19:22:50-04:00 Comments only - - - - - 1c3af277 by Simon Peyton Jones at 2019-09-17T19:23:37-04:00 Improve error message for out-of-scope variables + VTA As #13834 and #17150 report, we get a TERRIBLE error message when you have an out of scope variable applied in a visible type application: (outOfScope @Int True) This very simple patch improves matters. See TcExpr Note [VTA for out-of-scope functions] - - - - - c77fc3b2 by John Ericson at 2019-09-17T19:24:20-04:00 Deduplicate `HaskellMachRegs.h` and `RtsMachRegs.h` headers Until 0472f0f6a92395d478e9644c0dbd12948518099f there was a meaningful host vs target distinction (though it wasn't used right, in genapply). After that, they did not differ in meaningful ways, so it's best to just only keep one. - - - - - c3eaaca6 by Simon Peyton Jones at 2019-09-19T09:03:19-04:00 Add a missing update of sc_hole_ty (#16312) In simplCast I totally failed to keep the sc_hole_ty field of ApplyToTy (see Note [The hole type in ApplyToTy]) up to date. When a cast goes by, of course the hole type changes. Amazingly this has not bitten us before, but #16312 finally triggered it. Fortunately the fix is simple. Fixes #16312. - - - - - de1723b2 by Ben Gamari at 2019-09-19T09:03:19-04:00 Simplify: Lazy pattern match - - - - - d9c6b86e by Richard Eisenberg at 2019-09-19T09:04:03-04:00 Refactor kindGeneralize and friends This commit should have no change in behavior.(*) The observation was that Note [Recipe for checking a signature] says that every metavariable in a type-checked type must either (A) be generalized (B) be promoted (C) be zapped. Yet the code paths for doing these were all somewhat separate. This led to some steps being skipped. This commit shores this all up. The key innovation is TcHsType.kindGeneralizeSome, with appropriate commentary. This commit also sets the stage for #15809, by turning the WARNing about bad level-numbers in generalisation into an ASSERTion. The actual fix for #15809 will be in a separate commit. Other changes: * zonkPromoteType is now replaced by kindGeneralizeNone. This might have a small performance degradation, because zonkPromoteType zonked and promoted all at once. The new code path promotes first, and then zonks. * A call to kindGeneralizeNone was added in tcHsPartialSigType. I think this was a lurking bug, because it did not follow Note [Recipe for checking a signature]. I did not try to come up with an example showing the bug. This is the (*) above. Because of this change, there is an error message regression in partial-sigs/should_fail/T14040a. This problem isn't really a direct result of this refactoring, but is a symptom of something deeper. See #16775, which addresses the deeper problem. * I added a short-cut to quantifyTyVars, in case there's nothing to quantify. * There was a horribly-outdated Note that wasn't referred to. Gone now. * While poking around with T14040a, I discovered a small mistake in the Coercion.simplifyArgsWorker. Easy to fix, happily. * See new Note [Free vars in coercion hole] in TcMType. Previously, we were doing the wrong thing when looking at a coercion hole in the gather-candidates algorithm. Fixed now, with lengthy explanation. Metric Decrease: T14683 - - - - - f594a68a by Richard Eisenberg at 2019-09-19T09:04:03-04:00 Use level numbers for generalisation This fixes #15809, and is covered in Note [Use level numbers for quantification] in TcMType. This patch removes the "global tyvars" from the environment, a nice little win. - - - - - c675d08f by Richard Eisenberg at 2019-09-19T09:04:03-04:00 Test #17077. - - - - - 912afaf4 by Ben Gamari at 2019-09-19T09:04:39-04:00 CoreUtils: Use mightBeUnliftedType in exprIsTopLevelBindable Also add reference from isUnliftedType to mightBeUnliftedType. - - - - - baf47661 by Sebastian Graf at 2019-09-19T09:05:20-04:00 Extract PmTypes module from PmExpr and PmOracle Apparently ghc-lib-parser's API blew up because the newly induced cyclic dependency between TcRnTypes and PmOracle pulled in the other half of GHC into the relevant strongly-connected component. This patch arranges it so that PmTypes exposes mostly data type definitions and type class instances to be used within PmOracle, without importing the any of the possibly offending modules DsMonad, TcSimplify and FamInst. - - - - - 2a8867cf by Sebastian Graf at 2019-09-19T09:05:58-04:00 Add a regression test for #11822 The particular test is already fixed, but the issue seems to have multiple different test cases lumped together. - - - - - 52173990 by Ben Gamari at 2019-09-19T09:06:36-04:00 testsuite: Add testcase for #17206 - - - - - b3e5c731 by Alp Mestanogullari at 2019-09-19T21:42:17-04:00 ErrUtils: split withTiming into withTiming and withTimingSilent 'withTiming' becomes a function that, when passed '-vN' (N >= 2) or '-ddump-timings', will print timing (and possibly allocations) related information. When additionally built with '-eventlog' and executed with '+RTS -l', 'withTiming' will also emit both 'traceMarker' and 'traceEvent' events to the eventlog. 'withTimingSilent' on the other hand will never print any timing information, under any circumstance, and will only emit 'traceEvent' events to the eventlog. As pointed out in !1672, 'traceMarker' is better suited for things that we might want to visualize in tools like eventlog2html, while 'traceEvent' is better suited for internal events that occur a lot more often and that we don't necessarily want to visualize. This addresses #17138 by using 'withTimingSilent' for all the codegen bits that are expressed as a bunch of small computations over streams of codegen ASTs. - - - - - 4853d962 by Ben Gamari at 2019-09-19T21:42:55-04:00 users guide: Fix link to let generalization blog post Fixes #17200. - - - - - 51192964 by Sylvain Henry at 2019-09-20T05:14:34-04:00 Module hierarchy: Hs (#13009) Add GHC.Hs module hierarchy replacing hsSyn. Metric Increase: haddock.compiler - - - - - 2f8ce45a by Ben Gamari at 2019-09-20T05:15:11-04:00 testsuite: Add test for #17202 - - - - - f257bf73 by Matthew Pickering at 2019-09-20T05:15:52-04:00 hadrian/ghci.sh: Enable building in parallel - - - - - 070f7b85 by Matthew Pickering at 2019-09-20T05:15:52-04:00 Remove trailing whitespace - - - - - 5390b553 by Matthew Pickering at 2019-09-20T05:15:52-04:00 Pass -j to ghc-in-ghci CI job - - - - - 1b7e1d31 by John Ericson at 2019-09-20T05:16:36-04:00 Remove pointless partiality in `Parser.ajs` - - - - - 17554248 by Simon Peyton Jones at 2019-09-20T10:50:21+01:00 Fix PmOracle.addVarCoreCt in-scope set PmOracle.addVarCoreCt was giving a bogus (empty) in-scope set to exprIsConApp_maybe, which resulted in a substitution-invariant failure (see MR !1647 discussion). This patch fixes it, by taking the free vars of the expression. - - - - - 0dad81ca by Simon Peyton Jones at 2019-09-20T10:50:21+01:00 Fix bogus type of case expression Issue #17056 revealed that we were sometimes building a case expression whose type field (in the Case constructor) was bogus. Consider a phantom type synonym type S a = Int and we want to form the case expression case x of K (a::*) -> (e :: S a) We must not make the type field of the Case constructor be (S a) because 'a' isn't in scope. We must instead expand the synonym. Changes in this patch: * Expand synonyms in the new function CoreUtils.mkSingleAltCase. * Use mkSingleAltCase in MkCore.wrapFloat, which was the proximate source of the bug (when called by exprIsConApp_maybe) * Use mkSingleAltCase elsewhere * Documentation CoreSyn new invariant (6) in Note [Case expression invariants] CoreSyn Note [Why does Case have a 'Type' field?] CoreUtils Note [Care with the type of a case expression] * I improved Core Lint's error reporting, which was pretty confusing in this case, because it didn't mention that the offending type was the return type of a case expression. * A little bit of cosmetic refactoring in CoreUtils - - - - - 1ea8c451 by Sebastian Graf at 2019-09-21T09:52:34-04:00 PredType for type constraints in the pattern match checker instead of EvVar Using EvVars for capturing type constraints implied side-effects in DsM when we just wanted to *construct* type constraints. But giving names to type constraints is only necessary when passing Givens to the type checker, of which the majority of the pattern match checker should be unaware. Thus, we simply generate `newtype TyCt = TyCt PredType`, which are nicely stateless. But at the same time this means we have to allocate EvVars when we want to query the type oracle! So we keep the type oracle state as `newtype TyState = TySt (Bag EvVar)`, which nicely makes a distinction between new, unchecked `TyCt`s and the inert set in `TyState`. - - - - - ded96fb3 by Ömer Sinan Ağacan at 2019-09-21T09:53:29-04:00 Document MIN_PAYLOAD_SIZE and mark-compact GC mark bits This updates the documentation of the MIN_PAYLOAD_SIZE constant and adds a new Note [Mark bits in mark-compact collector] explaning why the mark-compact collector uses two bits per objet and why we need MIN_PAYLOAD_SIZE. - - - - - a7867c79 by Sebastian Graf at 2019-09-21T14:56:58+01:00 Get rid of PmFake The pattern match oracle can now cope with the abundance of information that ViewPatterns, NPlusKPats, overloaded lists, etc. provide. No need to have PmFake anymore! Also got rid of a spurious call to `allCompleteMatches`, which we used to call *for every constructor* match. Naturally this blows up quadratically for programs like `ManyAlternatives`. ------------------------- Metric Decrease: ManyAlternatives Metric Increase: T11822 ------------------------- - - - - - fa66e3e5 by Alp Mestanogullari at 2019-09-21T23:31:08-04:00 Fix haddocks for marker events in Debug.Trace - - - - - da12da79 by Daniel Gröber at 2019-09-22T14:34:56+02:00 rts: retainer: Remove cStackSize debug counter This can only ever be one since 5f1d949ab9 ("Remove explicit recursion in retainer profiling"), so it's pointless. - - - - - 3ebaa4b5 by Daniel Gröber at 2019-09-22T15:17:53+02:00 rts: Remove bitrotten retainer debug code The `defined(DEBUG_RETAINER) == true` branch doesn't even compile anymore because 1) retainerSet was renamed to RetainerSet and 2) even if I fix that the context in Rts.h seems to have changed such that it's not in scope. If 3) I fix that 'flip' is still not in scope :) At that point I just gave up. - - - - - 63023dc2 by Daniel Gröber at 2019-09-22T15:18:09+02:00 rts: Fix outdated references to 'ldvTime' This got renamed to 'era' in dbef766ce7 ("[project @ 2001-11-26 16:54:21 by simonmar] Profiling cleanup"). - - - - - ead05f80 by Daniel Gröber at 2019-09-22T15:18:09+02:00 rts: retainer: Turn global traversal state into a struct Global state is ugly and hard to test. Since the profiling code isn't quite as performance critical as, say, GC we should prefer better code here. I would like to move the 'flip' bit into the struct too but that's complicated by the fact that the defines which use it directly are also called from ProfHeap where the traversalState is not easily available. Maybe in a future commit. - - - - - 94ecdb4f by Daniel Gröber at 2019-09-22T15:18:10+02:00 rts: retainer: Move info.next.parent to stackElement I don't see a point in having this live in 'info', just seems to make the code more complicated. - - - - - f79ac2ef by Daniel Gröber at 2019-09-22T15:18:10+02:00 rts: retainer: Generalise per-stackElement data This essentially ammounts to s/retainer/stackData/, s/c_child_r/data/ and some temporary casting of c_child_r to stackData until refactoring of this module is completed by a subsequent commit. We also introduce a new union 'stackData' which will contain the actual extra data to be stored on the stack. The idea is to make the heap traversal logic of the retainer profiler ready for extraction into it's own module. So talking about "retainers" there doesn't really make sense anymore. Essentially the "retainers" we store in the stack are just data associated with the push()ed closures which we return when pop()ing it. - - - - - f083358b by Daniel Gröber at 2019-09-22T15:18:10+02:00 rts: retainer: Fix comment typo s/keeps/keep/ - - - - - 2f2f6dd5 by Daniel Gröber at 2019-09-22T15:18:10+02:00 rts: Generalise profiling heap traversal flip bit handling This commit starts renaming some flip bit related functions for the generalised heap traversal code and adds provitions for sharing the per-closure profiling header field currently used exclusively for retainer profiling with other heap traversal profiling modes. - - - - - e40b3c23 by Daniel Gröber at 2019-09-22T15:18:10+02:00 rts: GC: Remove redundant #include "RetainerProfiler.h" - - - - - b03db9da by Daniel Gröber at 2019-09-22T15:18:10+02:00 rts: retainer: Pull retainer specific code into a callback This essentially turns the heap traversal code into a visitor. You add a bunch of roots to the work-stack and then the callback you give to traverseWorkStack() will be called with every reachable closure at least once. - - - - - 48e816f0 by Daniel Gröber at 2019-09-22T15:18:10+02:00 rts: retainer: simplify pop() control flow Instead of breaking out of the switch-in-while construct using `return` this uses `goto out` which makes it possible to share a lot of the out-variable assignment code in all the cases. I also replaced the nasty `while(true)` business by the real loop condition: `while(*c == NULL)`. All `break` calls inside the switch aready have either a check for NULL or an assignment of `c` to NULL so this should not change any behaviour. Using `goto out` also allowed me to remove another minor wart: In the MVAR_*/WEAK cases the popOff() call used to happen before reading the stackElement. This looked like a use-after-free hazard to me as the stack is allocated in blocks and depletion of a block could mean it getting freed and possibly overwritten by zero or garbage, depending on the block allocator's behaviour. - - - - - b92ed68a by Daniel Gröber at 2019-09-22T15:18:10+02:00 rts: Add note reference to SET_PROF_HDR for profiling 'flip' bit - - - - - f3bb7397 by Daniel Gröber at 2019-09-22T15:18:10+02:00 rts: RetainerSet: Remove obsolete fist/second-approach choice In the old code when DEBUG_RETAINER was set, FIRST_APPROACH is implied. However ProfHeap.c now depends on printRetainerSetShort which is only available with SECOND_APPROACH. This is because with FIRST_APPROACH retainerProfile() will free all retainer sets before returning so by the time ProfHeap calls dumpCensus the retainer set pointers are segfaulty. Since all of this debugging code obviously hasn't been compiled in ages anyways I'm taking the liberty of just removing it. Remember guys: Dead code is a liability not an asset :) - - - - - ec1d76e2 by Daniel Gröber at 2019-09-22T15:18:10+02:00 rts: retainer: Remove obsolete debug code Commit dbef766ce7 ("Profiling cleanup.") made this debug code obsolete by removing the 'cost' function without a replacement. As best I can tell the retainer profiler used to do some heap census too and this debug code was mainly concerned with that. - - - - - b7e15d17 by Daniel Gröber at 2019-09-22T15:18:10+02:00 rts: retainer: Rename heap traversal functions for extraction This gets all remaining functions in-line with the new 'traverse' prefix and module name. - - - - - 64ec45a7 by Daniel Gröber at 2019-09-22T15:18:10+02:00 rts: retainer: Reduce DEBUG_RETAINER ifdef noise Keeping track of the maximum stack seems like a good idea in all configurations. The associated ASSERTs only materialize in debug mode but having the statistic is nice. To make the debug code less prone to bitrotting I introduce a function 'debug()' which doesn't actually print by default and is #define'd away only when the standard DEBUG define is off. - - - - - bd78b696 by Daniel Gröber at 2019-09-22T15:18:10+02:00 rts: retainer: Cleanup comments and strings for traversal extraction A lot of comments and strings are still talking about old names, fix that. - - - - - cb7220b3 by Daniel Gröber at 2019-09-22T15:18:10+02:00 rts: retainer: Remove outdated invariants on traversePushStack These invariants don't seem to make any sense in the current code. The text talks about c_child_r as if it were an StgClosure, for which RSET() would make sense, but it's a retainer aka 'CostCentreStack*'. - - - - - bb92660c by Daniel Gröber at 2019-09-22T15:18:10+02:00 rts: retainer: Use global STATIC_INLINE macro STATIC_INLINE already does what the code wanted here, no need to duplicate the functionality here. - - - - - 2b76cf9e by Daniel Gröber at 2019-09-22T15:18:10+02:00 rts: retainer: Move heap traversal declarations to new header - - - - - 44d5cc0d by Daniel Gröber at 2019-09-22T15:18:10+02:00 rts: retainer: Abstract maxStackSize for generic traversal - - - - - fd213d17 by Daniel Gröber at 2019-09-22T15:18:10+02:00 rts: retainer: Update obsolete docs for traverseMaybeInitClosureData - - - - - 39f2878c by Daniel Gröber at 2019-09-22T15:18:10+02:00 rts: retainer: Move actual 'flip' bit flip to generic traversal code - - - - - f9b4c4f2 by Daniel Gröber at 2019-09-22T15:18:10+02:00 rts: retainer: Remove traverse-stack chunk support There's simply no need anymore for this whole business. Instead of individually traversing roots in retainRoot() we just push them all onto the stack and traverse everything in one go. This feature was not really used anyways. There is an `ASSERT(isEmptyWorkStack(ts))` at the top of retainRoot() which means there really can't ever have been any chunks at the toplevel. The only place where this was probably used is in traversePushStack but only way back when we were still using explicit recursion on the C callstack. Since the code was changed to use an explicit traversal-stack these stack-chunks can never escape one call to traversePushStack anymore. See commit 5f1d949ab9 ("Remove explicit recursion in retainer profiling") - - - - - c7def600 by Daniel Gröber at 2019-09-22T15:18:10+02:00 rts: retainer: Move mut_list reset to generic traversal code - - - - - 9bf27060 by Daniel Gröber at 2019-09-22T15:18:10+02:00 rts: retainer: Make visit callback easier to implement Currently it is necessary for user code to expend at least one extra bit in the closure header just to know whether visit() should return true or false, to indicate if children should be traversed. The generic traversal code already has this information in the visited bit so simply pass it to the visit callback. - - - - - 96adf179 by Daniel Gröber at 2019-09-22T15:18:10+02:00 rts: retainer: Improve Note [Profiling heap traversal visited bit] - - - - - 187192a6 by Daniel Gröber at 2019-09-22T15:18:10+02:00 rts: RetainerProfile.c: Re-enable and fix warnings Turns out some genius disabled warnings for RetainerProfile.c in the build system. That would have been good to know about five silent type mismatch crashes ago.. :) - - - - - eb29735e by Daniel Gröber at 2019-09-22T15:18:10+02:00 rts: RetainerProfile.c: Minimize #includes A lot of these includes are presumably leftovers from when the retainer profiler still did it's own heap profiling. - - - - - 383f9089 by Daniel Gröber at 2019-09-22T15:18:10+02:00 rts: Split heap traversal from retainer profiler This finally moves the newly generalised heap traversal code from the retainer profiler into it's own file. - - - - - 52c5ea71 by Daniel Gröber at 2019-09-22T15:18:10+02:00 rts: TraverseHeap: Make comment style consistent - - - - - 75355228 by Daniel Gröber at 2019-09-22T15:18:10+02:00 rts: TraverseHeap: Make pushStackElement argument const - - - - - a8137780 by Daniel Gröber at 2019-09-22T15:18:10+02:00 rts: TraverseHeap: Move stackElement.cp back into nextPos union The 'cp' field really is only used when type==posTypeFresh so it's more space efficient to have it in the nextPos union. - - - - - 7f10cc2d by Daniel Gröber at 2019-09-22T15:18:10+02:00 rts: RetainerProfile: Explain retainVisitClosure return values [ci skip] - - - - - 111f2761 by Daniel Gröber at 2019-09-22T15:33:41+02:00 rts: TraverseHeap: Add doc comment for getTraverseStackMaxSize - - - - - 68ddb43c by Ben Gamari at 2019-09-23T00:34:00-04:00 gitlab-ci: Fix URL of Windows cabal-install tarball - - - - - 0e478407 by Takenobu Tani at 2019-09-23T17:51:37-04:00 users-guide: Fix links and formats for GHC 8.10 This commit only fixes links and markdown syntax. [skip ci] - - - - - 74631bbc by Adam Sandberg Eriksson at 2019-09-23T17:52:32-04:00 base: add newtypes for socklen_t and ndfs_t to System.Posix.Types #16568 Metric Increase: haddock.base T4029 - - - - - 4470a144 by Björn Gohla at 2019-09-23T17:53:23-04:00 add Hadrian rule to build user guide as Info book - - - - - dbbea5a8 by Björn Gohla at 2019-09-23T17:53:23-04:00 use the Make builder instead of raw cmd_ - - - - - b0e3b173 by Björn Gohla at 2019-09-23T17:53:23-04:00 detect makeinfo in configure(.ac) - - - - - 9fe4d2df by Björn Gohla at 2019-09-23T17:53:23-04:00 explicit dependence on makeinfo - - - - - b650c2b6 by Björn Gohla at 2019-09-23T17:53:23-04:00 alphabetical ordering - - - - - 27789294 by Björn Gohla at 2019-09-23T17:53:23-04:00 sort-paragraphs in runBuilderWith - - - - - d0c2f3a2 by Artem Pyanykh at 2019-09-23T17:54:04-04:00 [hadrian] Rebuild programs on dynamicGhcPrograms/ghcProfiled change Currently, if you change these ^ flavour parameters, rebuilding is not triggered, since `programContext` doesn't set up a dependency on those values. Exposing these values via an oracle does set the dependency and properly triggers a rebuild of binaries. Several attempts to factor out these actions ended up in cyclic dependency here or there. I'm not absolutely happy with this variant either, but at least it works. ==== Issue repro: In UserSettings.hs: ``` dbgDynamic = defaultFlavour { name = "dbg-dynamic" , dynamicGhcPrograms = pure True, ... } dbgStatic = defaultFlavour { name = "dbg-static" , dynamicGhcPrograms = pure False ... } ``` Then in console: ``` $ hadrian/build.sh -j --flavour=dbg-dynamic ... does the build $ hadrian/build.sh -j --flavour=dbg-static ... does nothing, considers binaries up to date ``` - - - - - 238b58e4 by Kari Pahula at 2019-09-23T17:54:42-04:00 Add -fkeep-going to make compiler continue despite errors (#15424) Add a new optional failure handling for upsweep which continues the compilation on other modules if any of them has errors. - - - - - 146f26cc by Sebastian Graf at 2019-09-24T01:06:40-04:00 Some leftovers from !1732. Comments only [skip ci] - - - - - b5f24fb4 by Takenobu Tani at 2019-09-24T01:07:19-04:00 Hadrian: Add -haddock option for GHCi's :doc command This commit adds -haddock option to Hadrian-based build system. To enable :doc command on GHCi, core libraries must be compiled with -haddock option. Especially, the `-haddock` option is essential for a release build. Assuming current GitLab CI condition (.gitlab-ci.yml), I add -haddock option to the default flavour only. This has already been done for Make-based build system. Please see #16415. - - - - - f97a7aac by Sebastian Graf at 2019-09-24T01:07:57-04:00 Fix some duplication in the parser D3673 experienced reduce/reduce conflicts when trying to use opt_instance for associated data families. That was probably because the author tried to use it for Haskell98-syntax without also applying it to GADT-syntax, which actually leads to a reduce/reduce conflict. Consider the following state: ``` data . T = T data . T where T :: T ``` The parser must decide at this point whether or not to reduce an empty `opt_instance`. But doing so would also commit to either Haskell98 or GADT syntax! Good thing we also accept an optional "instance" for GADT syntax, so the `opt_instance` is there in both productions and there's no reduce/reduce conflict anymore. Also no need to inline `opt_instance`, how it used to be. - - - - - b23f01fd by Ben Gamari at 2019-09-24T08:49:43-04:00 base: Add link to "A reflection on types" Fixes #17181. - - - - - 4bbe0dba by Ben Gamari at 2019-09-24T08:50:20-04:00 gitlab-ci: Bump ci-images This bumps the CI Docker images to ghc/ci-images at 990c5217d1d0e03aea415f951afbc3b1a89240c6. - - - - - 6bca867c by Ben Gamari at 2019-09-24T08:50:59-04:00 hadrian: Update source-repository - - - - - b2d47536 by Ben Gamari at 2019-09-24T08:51:45-04:00 testsuite: Mark threadstatus-9333 as fragile in profthreaded Due to #16555. - - - - - ed520678 by Andreas Klebinger at 2019-09-24T21:08:42-04:00 Fix bounds check in ocResolve_PEi386 for relocation values. The old test was wrong at least for gcc and the value -2287728808L. It also relied on implementation defined behaviour (right shift on a negative value), which might or might not be ok. Either way it's now a simple comparison which will always work. - - - - - 218c5dbf by Matthew Pickering at 2019-09-24T21:09:23-04:00 Add ghcide configuration files This commit adds three new files 1. A hie.yaml file to the project root which specifies to IDEs how to set up the correct environment for loading GHC. This currently specifies to call the `./hadrian/hie-bios` script. 2. A `hie.yaml` file for the hadrian subcomponent, which uses the `cabal` cradle type. 2. The `./hadrian/hie-bios` script which supplies the correct arguments for an IDE to start a session. With these two files it is possible to run ``` ghcide compiler/ ``` and successfully load all the modules for use in the IDE. or ``` ghcide --cwd hadrian/ src/ ``` to test loading all of Hadrian's modules. Closes #17194 - - - - - 2970dc7a by Kari Pahula at 2019-09-25T13:52:48-04:00 Add -Wderiving-defaults (#15839) Enabling both DeriveAnyClass and GeneralizedNewtypeDeriving can cause a warning when no explicit deriving strategy is in use. This change adds an enable/suppress flag for it. - - - - - 4540bbe2 by John Ericson at 2019-09-25T13:53:42-04:00 includes/CodeGen.Platform.hs don't include ghcautoconf.h It doesn't need it, and it shouldn't need it or else multi-target will break. - - - - - ebc65025 by Sebastian Graf at 2019-09-25T13:54:22-04:00 PmCheck: Only ever check constantly many models against a single pattern Introduces a new flag `-fmax-pmcheck-deltas` to achieve that. Deprecates the old `-fmax-pmcheck-iter` mechanism in favor of this new flag. >From the user's guide: Pattern match checking can be exponential in some cases. This limit makes sure we scale polynomially in the number of patterns, by forgetting refined information gained from a partially successful match. For example, when matching `x` against `Just 4`, we split each incoming matching model into two sub-models: One where `x` is not `Nothing` and one where `x` is `Just y` but `y` is not `4`. When the number of incoming models exceeds the limit, we continue checking the next clause with the original, unrefined model. This also retires the incredibly hard to understand "maximum number of refinements" mechanism, because the current mechanism is more general and should catch the same exponential cases like PrelRules at the same time. ------------------------- Metric Decrease: T11822 ------------------------- - - - - - d90d0bad by Ben Gamari at 2019-09-25T13:55:09-04:00 base: Move Ix typeclass to GHC.Ix The `Ix` class seems rather orthogonal to its original home in `GHC.Arr`. - - - - - 795986aa by Ryan Scott at 2019-09-25T13:56:07-04:00 Remove unneeded CPP now that GHC 8.6 is the minimum The minimum required GHC version for bootstrapping is 8.6, so we can get rid of some unneeded `#if `__GLASGOW_HASKELL__` CPP guards, as well as one `MIN_VERSION_ghc_prim(0,5,3)` guard (since GHC 8.6 bundles `ghc-prim-0.5.3`). - - - - - 0b5eede9 by Vladislav Zavialov at 2019-09-25T21:06:04+03:00 Standalone kind signatures (#16794) Implements GHC Proposal #54: .../ghc-proposals/blob/master/proposals/0054-kind-signatures.rst With this patch, a type constructor can now be given an explicit standalone kind signature: {-# LANGUAGE StandaloneKindSignatures #-} type Functor :: (Type -> Type) -> Constraint class Functor f where fmap :: (a -> b) -> f a -> f b This is a replacement for CUSKs (complete user-specified kind signatures), which are now scheduled for deprecation. User-facing changes ------------------- * A new extension flag has been added, -XStandaloneKindSignatures, which implies -XNoCUSKs. * There is a new syntactic construct, a standalone kind signature: type <name> :: <kind> Declarations of data types, classes, data families, type families, and type synonyms may be accompanied by a standalone kind signature. * A standalone kind signature enables polymorphic recursion in types, just like a function type signature enables polymorphic recursion in terms. This obviates the need for CUSKs. * TemplateHaskell AST has been extended with 'KiSigD' to represent standalone kind signatures. * GHCi :info command now prints the kind signature of type constructors: ghci> :info Functor type Functor :: (Type -> Type) -> Constraint ... Limitations ----------- * 'forall'-bound type variables of a standalone kind signature do not scope over the declaration body, even if the -XScopedTypeVariables is enabled. See #16635 and #16734. * Wildcards are not allowed in standalone kind signatures, as partial signatures do not allow for polymorphic recursion. * Associated types may not be given an explicit standalone kind signature. Instead, they are assumed to have a CUSK if the parent class has a standalone kind signature and regardless of the -XCUSKs flag. * Standalone kind signatures do not support multiple names at the moment: type T1, T2 :: Type -> Type -- rejected type T1 = Maybe type T2 = Either String See #16754. * Creative use of equality constraints in standalone kind signatures may lead to GHC panics: type C :: forall (a :: Type) -> a ~ Int => Constraint class C a where f :: C a => a -> Int See #16758. Implementation notes -------------------- * The heart of this patch is the 'kcDeclHeader' function, which is used to kind-check a declaration header against its standalone kind signature. It does so in two rounds: 1. check user-written binders 2. instantiate invisible binders a la 'checkExpectedKind' * 'kcTyClGroup' now partitions declarations into declarations with a standalone kind signature or a CUSK (kinded_decls) and declarations without either (kindless_decls): * 'kinded_decls' are kind-checked with 'checkInitialKinds' * 'kindless_decls' are kind-checked with 'getInitialKinds' * DerivInfo has been extended with a new field: di_scoped_tvs :: ![(Name,TyVar)] These variables must be added to the context in case the deriving clause references tcTyConScopedTyVars. See #16731. - - - - - 4f81fab0 by Ryan Scott at 2019-09-26T14:04:38-04:00 Make -fbyte-code prevent unboxed tuples/sums from implying object code (#16876) This resolves #16876 by making the explicit use of `-fbyte-code` prevent code that enables `UnboxedTuples` or `UnboxedSums` from automatically compiling to object code. This allows for a nice middle ground where most code that enables `UnboxedTuples`/-`Sums` will still benefit from automatically enabling `-fobject-code`, but allows power users who wish to avoid this behavior in certain corner cases (such as `lens`, whose use case is documented in #16876) to do so. Along the way, I did a little cleanup of the relevant code and documentation: * `enableCodeGenForUnboxedTuples` was only checking for the presence of `UnboxedTuples`, but `UnboxedSums` has the same complications. I fixed this and renamed the function to `enableCodeGenForUnboxedTuplesOrSums`. * I amended the users' guide with a discussion of these issues. - - - - - 289fc8da by Sebastian Graf at 2019-09-27T22:10:17-04:00 PmCheck: Elaborate what 'model' means in the user guide [skip ci] - - - - - 9c02a793 by Ron Mordechai at 2019-09-27T22:11:06-04:00 Allow users to disable Unicode with an env var Unicode renders funny on my terminal and I like to avoid it where possible. Most applications which print out non-ascii characters allow users to disable such prints with an environment variable (e.g. Homebrew). This diff disables Unicode usage when the environment variable `GHC_NO_UNICODE` is set. To test, set the env var and compile a bad program. Note that GHC does not print Unicode bullets but instead prints out asterisks: ``` $ GHC_NO_UNICODE= _build/stage1/bin/ghc ../Temp.hs [1 of 1] Compiling Temp ( ../Temp.hs, ../Temp.o ) ../Temp.hs:4:23: error: * Couldn't match type `Bool' with `a -> Bool' Expected type: Bool -> a -> Bool Actual type: Bool -> Bool * In the first argument of `foldl', namely `(&& (flip $ elem u))' In the expression: foldl (&& (flip $ elem u)) True v In an equation for `isPermut': isPermut u v = foldl (&& (flip $ elem u)) True v * Relevant bindings include v :: [a] (bound at ../Temp.hs:4:12) u :: [a] (bound at ../Temp.hs:4:10) isPermut :: [a] -> [a] -> Bool (bound at ../Temp.hs:4:1) | 4 | isPermut u v = foldl (&& (flip $ elem u)) True v | ^^^^^^^^^^^^^^^^^^ ``` (Broken code taken from Stack Overflow) - - - - - 144abba3 by Ben Gamari at 2019-09-27T22:11:53-04:00 configure: Don't depend upon alex in source dist build This fixes #16860 by verifying that the generated sources don't already exist before asserting that the `alex` executable was found. This replicates the logic already used for `happy` in the case of `alex`. - - - - - c6fb913c by John Ericson at 2019-09-27T22:12:35-04:00 Just get RTS libs from its package conf `rts.conf` already contains this exact information in its `extra-libraries` stanza. - - - - - f07862b4 by Ben Gamari at 2019-09-27T22:13:16-04:00 ghc-prim: Fix documentation of Type As pointed out in #17243, `Type` is not the only kind having values. - - - - - 0201d0bf by chris-martin at 2019-09-27T22:14:00-04:00 Clarify the purpose and status of the GHC.TypeLits module - - - - - 444e554f by chris-martin at 2019-09-27T22:14:00-04:00 Expand description of DataKinds to mention data constructors, and include mention of TypeError - - - - - 1582dafa by Sebastian Graf at 2019-09-27T22:14:44-04:00 PmCheck: Look at precendence to give type signatures to some wildcards Basically do what we currently only do for -XEmptyCase in other cases where adding the type signature won't distract from pattern matches in other positions. We use the precedence to guide us, equating "need to parenthesise" with "too much noise". - - - - - ad0c4390 by Shayne Fletcher at 2019-09-27T22:15:27-04:00 Add test for expected dependencies of 'Parser' - - - - - 0b1fa64d by Ben Gamari at 2019-09-27T22:16:04-04:00 testsuite: Mark cgrun071 as broken on i386 As described in #17247. - - - - - 24620182 by Daniel Gröber at 2019-09-27T22:17:04-04:00 Raise minimum GHC version to 8.6 commit 795986aaf33e ("Remove unneeded CPP now that GHC 8.6 is the minimum") broke the 8.4 build. - - - - - e0bbb961 by Ben Gamari at 2019-09-27T22:17:44-04:00 testsuite: Mark compact_gc as fragile in the ghci way As noted in #17253. - - - - - bb984ac6 by Ben Gamari at 2019-09-27T22:18:42-04:00 testsuite: Mark hs_try_putmvar003 as fragile in threaded1 Due to #16361. Note that I'm leaving out threaded2 since it's not clear whether the single crash in that way was due to other causes. - - - - - ad2a1f99 by Ben Gamari at 2019-09-27T22:19:26-04:00 testsuite: Mark T3389 as broken in profiled ways on i386 As noted in #17256. - - - - - 6f9fa0be by Ben Gamari at 2019-09-27T22:20:04-04:00 testsuite: Mark TH tests as fragile in LLVM built external-interpreter Due to #16087. This drops the previous explicit list of broken tests and rather encompasses the entire set of tests since they all appear to be broken. - - - - - c5d888d4 by Sebastian Graf at 2019-09-28T17:11:41-04:00 PmCheck: No ConLike instantiation in pmcheck `pmcheck` used to call `refineToAltCon` which would refine the knowledge we had about a variable by equating it to a `ConLike` application. Since we weren't particularly smart about this in the Check module, we simply freshened the constructors existential and term binders utimately through a call to `mkOneConFull`. But that instantiation is unnecessary for when we match against a concrete pattern! The pattern will already have fresh binders and field types. So we don't call `refineToAltCon` from `Check` anymore. Subsequently, we can simplify a couple of call sites and functions in `PmOracle`. Also implementing `computeCovered` becomes viable and we don't have to live with the hack that was `addVarPatVecCt` anymore. A side-effect of not indirectly calling `mkOneConFull` anymore is that we don't generate the proper strict argument field constraints anymore. Instead we now desugar ConPatOuts as if they had bangs on their strict fields. This implies that `PmVar` now carries a `HsImplBang` that we need to respect by a (somewhat ephemeral) non-void check. We fix #17234 in doing so. - - - - - ce64b397 by Sebastian Graf at 2019-09-28T17:12:26-04:00 `exprOkForSpeculation` for Note [IO hack in the demand analyser] In #14998 I realised that the notion of speculative execution *exactly matches* eager evaluation of expressions in a case alternative where the scrutinee is an IO action. Normally we have to `deferIO` any result from that single case alternative to prevent this speculative execution, so we had a special case in place in the demand analyser that would check if the scrutinee was a prim-op, in which case we assumed that it would be ok to do the eager evaluation. Now we just check if the scrutinee is `exprOkForSpeculation`, corresponding to the notion that we want to push evaluation of the scrutinee *after* eagerly evaluating stuff from the case alternative. This fixes #14988, because it resolves the last open Item 4 there. - - - - - f3cb8c7c by Ömer Sinan Ağacan at 2019-09-30T22:39:53-04:00 Refactor iface file generation: This commit refactors interface file generation to allow information from the later passed (NCG, STG) to be stored in interface files. We achieve this by splitting interface file generation into two parts: * Partial interfaces, built based on the result of the core pipeline * A fully instantiated interface, which also contains the final fingerprints and can optionally contain information produced by the backend. This change is required by !1304 and !1530. -dynamic-too handling is refactored too: previously when generating code we'd branch on -dynamic-too *before* code generation, but now we do it after. (Original code written by @AndreasK in !1530) Performance ~~~~~~~~~~~ Before this patch interface files where created and immediately flushed to disk which made space leaks impossible. With this change we instead use NFData to force all iface related data structures to avoid space leaks. In the process of refactoring it was discovered that the code in the ToIface Module allocated a lot of thunks which were immediately forced when writing/forcing the interface file. So we made this module more strict to avoid creating many of those thunks. Bottom line is that allocations go down by about ~0.1% compared to master. Residency is not meaningfully different after this patch. Runtime was not benchmarked. Co-Authored-By: Andreas Klebinger <klebinger.andreas at gmx.at> Co-Authored-By: Ömer Sinan Ağacan <omer at well-typed.com> - - - - - 6a1700aa by Simon Peyton Jones at 2019-09-30T22:40:30-04:00 Fix arguments for unbound binders in RULE application We were failing to correctly implement Note [Unbound RULE binders] in Rules.hs. In particular, when cooking up a fake Refl, were were failing to apply the substitition. This patch fixes that problem, and simultaneously tidies up the impedence mis-match between RuleSubst and TCvSubst. Thanks to Sebastian! - - - - - 97811ef5 by Takenobu Tani at 2019-09-30T22:41:35-04:00 Add help message for GHCi :instances command This commit updates GHCi's help message for GHC 8.10. - - - - - 6f8550a3 by Sebastian Graf at 2019-09-30T22:42:14-04:00 Move pattern match checker modules to GHC.HsToCore.PmCheck - - - - - b36dd49b by Takenobu Tani at 2019-09-30T22:42:53-04:00 testsuite: Add minimal test for :doc command Currently, there are no testcases for GHCi `:doc` command. Perhaps because it was experimental. And it could be changed in the future. But `:doc` command is already useful, so I add a minimal regression test to keep current behavior. See also 85309a3cda for implementation of `:doc` command. - - - - - bdba6ac2 by Vladislav Zavialov at 2019-09-30T22:43:31-04:00 Do not rely on CUSKs in 'base' Use standalone kind signatures instead of complete user-specified kinds in Data.Type.Equality and Data.Typeable - - - - - dbdf6a3d by Ben Gamari at 2019-09-30T22:44:07-04:00 testsuite: Mark T3389 as broken in hpc way on i386 See #17256. - - - - - 822481d5 by Ben Gamari at 2019-09-30T22:44:44-04:00 Bump process submodule Marks process003 as fragile, as noted in #17245. - - - - - 6548b7b0 by Sebastian Graf at 2019-10-01T09:22:10+00:00 Add a bunch of testcases for the pattern match checker Adds regression tests for tickets #17207, #17208, #17215, #17216, #17218, #17219, #17248 - - - - - 58013220 by Sebastian Graf at 2019-10-01T09:22:18+00:00 Add testcases inspired by Luke Maranget's pattern match series In his paper "Warnings for Pattern Matching", Luke Maranget describes three series in his appendix for which GHC's pattern match checker scaled very badly. We mostly avoid this now with !1752. This commit adds regression tests for each of the series. Fixes #17264. - - - - - 9c002177 by Ryan Scott at 2019-10-01T16:24:12-04:00 Refactor some cruft in TcDeriv * `mk_eqn_stock`, `mk_eqn_anyclass`, and `mk_eqn_no_mechanism` all took a continuation of type `DerivSpecMechanism -> DerivM EarlyDerivSpec` to represent its primary control flow. However, in practice this continuation was always instantiated with the `mk_originative_eqn` function, so there's not much point in making this be a continuation in the first place. This patch removes these continuations in favor of invoking `mk_originative_eqn` directly, which is simpler. * There were several parts of `TcDeriv` that took different code paths if compiling an `.hs-boot` file. But this is silly, because ever since 101a8c770b9d3abd57ff289bffea3d838cf25c80 we simply error eagerly whenever attempting to derive any instances in an `.hs-boot` file. This patch removes all of the unnecessary `.hs-boot` code paths, leaving only one (which errors out). * Remove various error continuation arguments from `mk_eqn_stock` and related functions. - - - - - 9a27a063 by David Eichmann at 2019-10-01T16:55:33-04:00 Hadrian: Libffi rule now `produces` dynamic library files. - - - - - 0956c194 by David Eichmann at 2019-10-01T16:55:33-04:00 Hadrian: do not cache GHC configure rule - - - - - 8924224e by Ömer Sinan Ağacan at 2019-10-01T16:55:37-04:00 Make small INLINE functions behave properly Simon writes: Currently we check for a type arg rather than isTyCoArg. This in turn makes INLINE things look bigger than they should be, and stops them being inlined into boring contexts when they perfectly well could be. E.g. f x = g <refl> x {-# INLINE g #-} ... (map (f x) xs) ... The context is boring, so don't inline unconditionally. But f's RHS is no bigger than its call, provided you realise that the coercion argument is ultimately cost-free. This happens in practice for $WHRefl. It's not a big deal: at most it means we have an extra function call overhead. But it's untidy, and actually worse than what happens without an INLINE pragma. Fixes #17182 This makes 0.0% change in nofib binary sizes. - - - - - 53b0c6e0 by Gabor Greif at 2019-10-03T08:15:50-04:00 Typo in comment [ci skip] - - - - - 60229e9e by Ryan Scott at 2019-10-03T12:17:10-04:00 Merge TcTypeableValidity into TcTypeable, document treatment of casts This patch: * Implements a refactoring (suggested in https://gitlab.haskell.org/ghc/ghc/merge_requests/1199#note_207345) that moves all functions from `TcTypeableValidity` back to `TcTypeable`, as the former module doesn't really need to live on its own. * Adds `Note [Typeable instances for casted types]` to `TcTypeable` explaining why the `Typeable` solver currently does not support types containing casts. Resolves #16835. - - - - - 3b9d4907 by Richard Eisenberg at 2019-10-03T12:17:13-04:00 Note [Don't flatten tuples from HsSyn] in MkCore Previously, we would sometimes flatten 1-tuples and sometimes not. This didn't cause damage because there is no way to generate HsSyn with 1-tuples. But, with the upcoming fix to #16881, there will be. Without this patch, obscure lint errors would have resulted. No test case, as there is not yet a way to tickle this. - - - - - 8a254d6b by Ömer Sinan Ağacan at 2019-10-03T12:17:19-04:00 Fix new compact block allocation in allocateForCompact allocateForCompact() is called when nursery of a compact region is full, to add new blocks to the compact. New blocks added to an existing region needs a StgCompactNFDataBlock header, not a StgCompactNFData. This fixes allocateForCompact() so that it now correctly allocates space for StgCompactNFDataBlock instead of StgCompactNFData as before. Fixes #17044. A regression test T17044 added. - - - - - 3c7b172b by James Brock at 2019-10-03T12:17:24-04:00 docs String, hyperlink to Data.List Add a reference to the documentation for Data.List in the description for String. On the generated Haddock for Data.String, http://hackage.haskell.org/package/base-4.12.0.0/docs/Data-String.html there is curently no hyperlink to Data.List, which is where a reader will find most of the useful functions which can operate on Strings. I imagine this has confused beginners who came to this page looking for String operations. - - - - - 67bf734c by John Ericson at 2019-10-03T12:17:28-04:00 Add `module {-# SOURCE #-} Foo` syntax for hs-boot in bkp This is a good convenience for testing. - - - - - 6655ec73 by Richard Eisenberg at 2019-10-03T12:17:30-04:00 Improve documentation around empty tuples/lists This patch also changes the way we handle empty lists, simplifying them somewhat. See Note [Empty lists]. Previously, we had to special-case empty lists in the type-checker. Now no more! Finally, this patch improves some documentation around the ir_inst field used in the type-checker. This breaks a test case, but I really think the problem is #17251, not really related to this patch. Test case: typecheck/should_compile/T13680 - - - - - 9a4ff210 by John Ericson at 2019-10-03T12:17:31-04:00 Make Haddock submodule remote point to gitlab mirror This makes it match the others - - - - - cb364bc2 by Ben Gamari at 2019-10-03T12:17:32-04:00 testsuite: Mark print037 as fragile, not broken See #16205. - - - - - 259f4dff by Ben Gamari at 2019-10-03T12:17:32-04:00 Exclude rts.cabal from source distributions This modifies both the Hadrian and make build systems to avoid included the rts.cabal generated by autoconf in the source distribution. Fixes #17265. - - - - - e4c93896 by Ben Gamari at 2019-10-03T12:17:32-04:00 DynFlags: Only warn when split-sections is ignored Previously we would throw an error which seems a bit harsh. As reported in #17283. - - - - - ee6324ad by Tobias Guggenmos at 2019-10-03T12:17:33-04:00 Improve documentation for runtime debugging flags - - - - - 47386fe8 by Tobias Guggenmos at 2019-10-03T12:17:33-04:00 Add new debug flag -DZ Zeros heap memory after gc freed it. - - - - - d0924b15 by Stefan Schulze Frielinghaus at 2019-10-03T12:17:34-04:00 Extend argument of createIOThread to word size Function createIOThread expects its second argument to be of size word. The natural size of the second parameter is 32bits. Thus for some 64bit architectures, where a write of the lower half of a register does not clear the upper half, the value must be zero extended. - - - - - 1357d023 by Ben Gamari at 2019-10-03T12:17:34-04:00 rules/haddock: Ensure that RTS stats directory exists It may not exist if the source tarball was extracted yet not the testsuite tarball. - - - - - ec93d2a9 by Fumiaki Kinoshita at 2019-10-04T21:43:49-04:00 Add Monad instances to `(,,) a b` and `(,,,) a b c` - - - - - 05419e55 by John Ericson at 2019-10-04T21:44:29-04:00 Per stage headers, ghc_boot_platform.h -> stage 0 ghcplatform.h The generated headers are now generated per stage, which means we can skip hacks like `ghc_boot_platform.h` and just have that be the stage 0 header as proper. In general, stages are to be embraced: freely generate everything in each stage but then just build what you depend on, and everything is symmetrical and efficient. Trying to avoid stages because bootstrapping is a mind bender just creates tons of bespoke mini-mind-benders that add up to something far crazier. Hadrian was pretty close to this "stage-major" approach already, and so was fairly easy to fix. Make needed more work, however: it did know about stages so at least there was a scaffold, but few packages except for the compiler cared, and the compiler used its own counting system. That said, make and Hadrian now work more similarly, which is good for the transition to Hadrian. The merits of embracing stage aside, the change may be worthy for easing that transition alone. - - - - - 75a5dd8e by John Ericson at 2019-10-04T21:44:29-04:00 Remove {Build,Host}Platform_NAME from header They are only used in a file we construct directly, so just skip CPP. - - - - - b538476b by Daroc Alden at 2019-10-04T21:45:09-04:00 Deprecate -fwarn-hi-shadowing, because it was never implemented and is not used. This fixes #10913. - - - - - dd8f76b2 by John Ericson at 2019-10-04T21:45:48-04:00 Factor out a smaller part of Platform for host fallback - - - - - d15b44d6 by John Ericson at 2019-10-04T21:45:49-04:00 Pull out the settings file parsing code into it's own module. This has two benefits: 1. One less hunk of code dependent on DynFlags 2. Add a little bit of error granularity to distrinugish between missing data and bad data. This could someday be shared with ghc-pkg which aims to work even with a missing file. I also am about to to make --supported-extensions use this too. - - - - - eb892b28 by John Ericson at 2019-10-04T21:45:49-04:00 Add tryFindTopDir to look for the top dir without blowing up if it is not found. - - - - - 0dded5ec by John Ericson at 2019-10-04T21:45:49-04:00 Always enable the external interpreter You can always just not use or even build `iserv`. I don't think the maintenance cost of the CPP is worth...I can't even tell what the benefit is. - - - - - 0d31ccdd by Artem Pyanykh at 2019-10-04T21:46:28-04:00 [linker, macho] Don't map/allocate zero size sections and segments Zero size sections are common even during regular build on MacOS. For instance: ``` $ ar -xv libHSghc-prim-0.6.1.a longlong.o $ otool -l longlong.o longlong.o: Mach header magic cputype cpusubtype caps filetype ncmds sizeofcmds flags 0xfeedfacf 16777223 3 0x00 1 2 176 0x00002000 Load command 0 cmd LC_SEGMENT_64 cmdsize 152 segname vmaddr 0x0000000000000000 vmsize 0x0000000000000000 <-- segment size = 0 fileoff 208 filesize 0 maxprot 0x00000007 initprot 0x00000007 nsects 1 flags 0x0 Section sectname __text segname __TEXT addr 0x0000000000000000 size 0x0000000000000000 <-- section size = 0 offset 208 align 2^0 (1) reloff 0 nreloc 0 flags 0x80000000 reserved1 0 reserved2 0 cmd LC_BUILD_VERSION cmdsize 24 platform macos sdk 10.14 minos 10.14 ntools 0 ``` The issue of `mmap`ing 0 bytes was resolved in !1050, but the problem remained. These 0 size segments and sections were still allocated in object code, which lead to failed `ASSERT(size > 0)` in `addProddableBlock` further down the road. With this change zero size segments **and** sections are not mapped/allocated at all. Test plan: 1. Build statically linked GHC. 2. Run `ghc --interactive`. Observe that REPL loads successfully (which was not the case before). 3. Load several more compiled hs files into repl. No failures. - - - - - 93f02b62 by Roland Senn at 2019-10-04T21:47:07-04:00 New fix for #11647. Avoid side effects like #17171 If a main module doesn't contain a header, we omit the check whether the main module is exported. With this patch GHC, GHCi and runghc use the same code. - - - - - 8039b625 by Matthew Bauer at 2019-10-04T21:47:47-04:00 Add musl systems to llvm-targets This was done in Nixpkgs, but never upstreamed. Musl is pretty much the same as gnu, but with a different libc. I’ve used the same values for everything. - - - - - ee8118ca by John Ericson at 2019-10-05T00:11:58-04:00 Clean up `#include`s in the compiler - Remove unneeded ones - Use <..> for inter-package. Besides general clean up, helps distinguish between the RTS we link against vs the RTS we compile for. - - - - - 241921a0 by Ben Gamari at 2019-10-05T19:18:40-04:00 rts: Fix CNF dirtying logic Previously due to a silly implementation bug CNFs would never have their dirty flag set, resulting in their being added again and again to the `mut_list`. Fix this. Fixes #17297. - - - - - 825c108b by Ryan Scott at 2019-10-07T12:00:59-04:00 Only flatten up to type family arity in coreFlattenTyFamApp (#16995) Among other uses, `coreFlattenTyFamApp` is used by Core Lint as a part of its check to ensure that each type family axiom reduces according to the way it is defined in the source code. Unfortunately, the logic that `coreFlattenTyFamApp` uses to flatten type family applications disagreed with the logic in `TcFlatten`, which caused it to spuriously complain this program: ```hs type family Param :: Type -> Type type family LookupParam (a :: Type) :: Type where LookupParam (f Char) = Bool LookupParam x = Int foo :: LookupParam (Param ()) foo = 42 ``` This is because `coreFlattenTyFamApp` tries to flatten the `Param ()` in `LookupParam (Param ())` to `alpha` (where `alpha` is a flattening skolem), and GHC is unable to conclude that `alpha` is apart from `f Char`. This patch spruces up `coreFlattenTyFamApp` so that it instead flattens `Param ()` to `alpha ()`, which GHC _can_ know for sure is apart from `f Char`. See `Note [Flatten], wrinkle 3` in `FamInstEnv`. - - - - - b2577081 by Ben Gamari at 2019-10-07T12:01:46-04:00 Refactor, document, and optimize LLVM configuration loading As described in the new Note [LLVM Configuration] in SysTools, we now load llvm-targets and llvm-passes lazily to avoid the overhead of doing so when -fllvm isn't used (also known as "the common case"). Noticed in #17003. Metric Decrease: T12234 T12150 - - - - - 93c71ae6 by Ben Gamari at 2019-10-07T12:02:23-04:00 configure: Determine library versions of template-haskell, et al. These are needed by the user guide documentation. Fixes #17260. - - - - - b7890611 by Andrey Mokhov at 2019-10-07T12:03:13-04:00 Hadrian: Stop using in-tree Cabal - - - - - 0ceb98f6 by Andrey Mokhov at 2019-10-07T12:03:13-04:00 Switch to cabal-version=3.0 in ghc-heap.cabal - - - - - e3418e96 by Andrey Mokhov at 2019-10-07T12:03:13-04:00 Switch to cabal-version=3.0 in base.cabal and rts.cabal - - - - - 805653f6 by John Ericson at 2019-10-07T12:04:19-04:00 Get rid of wildcard patterns in prim Cmm emitting code This way, we can be sure we don't miss a case. - - - - - ab945819 by Ryan Scott at 2019-10-07T12:05:09-04:00 Refactor some cruft in TcGenGenerics * `foldBal` contains needless partiality that can easily be avoided. * `mkProd_E` and `mkProd_P` both contain unique supply arguments that are completely unused, which can be removed. - - - - - d0edba3a by John Ericson at 2019-10-07T12:05:47-04:00 Remove CONFIGURE_ARGS from configure.ac It looks like it's been unused since at least 34cc75e1a62638f2833815746ebce0a9114dc26b. - - - - - 9a6bfb0a by John Ericson at 2019-10-07T12:06:26-04:00 Keep OSTYPE local to configure.ac Unused outside it since b6be81b841e34ca45b3549c4c79e886a8761e59a. - - - - - 4df39fd0 by John Ericson at 2019-10-07T12:07:08-04:00 Get rid of GHC_PACKAGE_DB_FLAG We no longer support booting from older GHC since 527bcc41630918977c73584d99125ff164400695. - - - - - 31a29a7a by John Ericson at 2019-10-07T12:07:46-04:00 Remove GhcLibsWithUnix d679ca43e7477284d733b94ff542be5363be3353 meant to remove it but did not finish the job. - - - - - 77ca39e3 by Ben Gamari at 2019-10-08T05:11:03-04:00 gitlab-ci: Add missing TEST_ENV variables This should fix #16985. - - - - - 9a2798e1 by Ben Gamari at 2019-10-08T05:11:03-04:00 hadrian: Add `validate` and `slow validate` flavours - - - - - ab311696 by Ben Gamari at 2019-10-08T05:11:03-04:00 validate: Use Hadrian's validate flavour - - - - - 98179a77 by Ben Gamari at 2019-10-08T05:11:03-04:00 gitlab-ci: Use validate flavour in hadrian builds - - - - - 8af9eba8 by Ben Gamari at 2019-10-08T05:11:40-04:00 base: Document the fact that Typeable is automatically "derived" This fixes #17060. - - - - - 397c6ed5 by Sebastian Graf at 2019-10-08T05:12:15-04:00 PmCheck: Identify some semantically equivalent expressions By introducing a `CoreMap Id` to the term oracle, we can represent syntactically equivalent expressions by the same `Id`. Combine that with `CoreOpt.simpleCoreExpr` and it might even catch non-trivial semantic equalities. Unfortunately due to scoping issues, this will not solve #17208 for view patterns yet. - - - - - 8a2e8408 by Ben Gamari at 2019-10-08T05:12:58-04:00 users-guide: Refer to language extension flags via :extension: Previously several were referred to via :ghc-flag:`-X...`. - - - - - 7cd54538 by Ben Gamari at 2019-10-08T05:12:58-04:00 users-guide: Make reverse flags addressable via :ghc-flag: Previously one could not easily link to the :reverse: flag of a ghc-flag. - - - - - e9813afc by Ben Gamari at 2019-10-08T05:12:58-04:00 users-guide: Document -XHaskell98 and -XHaskell2010 - - - - - eaeb28a1 by Ben Gamari at 2019-10-08T05:12:58-04:00 users-guide: Fix various warnings - - - - - 180cf177 by Ben Gamari at 2019-10-08T05:12:58-04:00 users-guide: Document NondecreasingIndentation - - - - - 0a26f9e8 by Ben Gamari at 2019-10-08T05:12:58-04:00 users-guide: Document -fworker-wrapper - - - - - ca4791db by Ben Gamari at 2019-10-08T05:12:58-04:00 users-guide: Rework pragma key generation Previously we had a hack to handle the case of multi-token SPECIALISE pragmas. Now we use a slightly more general rule of using a prefix of tokens containing only alphabetical characters. - - - - - 98c09422 by Ben Gamari at 2019-10-08T05:12:58-04:00 users-guide: Run sphinx in nit-picky mode This ensure that it blurts an error on missing references. - - - - - a95f7185 by Ben Gamari at 2019-10-08T05:12:58-04:00 doc: Write out documented flag list - - - - - 9402608e by Ben Gamari at 2019-10-08T05:12:58-04:00 gitlab-ci: Check coverage of GHC flags in users guide This ensures that all GHC flags are documented during the documentation build. Fixes #17315. - - - - - 9ac3bcbb by Andrew Martin at 2019-10-08T13:24:52-04:00 Document the UnliftedFFITypes extension. - - - - - 77f3ba23 by Andrew Martin at 2019-10-08T13:24:52-04:00 Rephrase a bunch of things in the unlifted ffi types documentation. Add a section on pinned byte arrays. - - - - - a70db7bf by Andrew Martin at 2019-10-08T13:24:52-04:00 [skip ci] link to foreign cmm call - - - - - 0d413259 by Andrew Martin at 2019-10-08T13:24:52-04:00 [skip ci] make the table better - - - - - 0c7a5bcd by Andrew Martin at 2019-10-08T13:24:52-04:00 [skip ci] can not -> may not - - - - - 6a5c249d by Andrew Martin at 2019-10-08T13:24:52-04:00 [skip ci] clarify what unsound means - - - - - bf02c264 by Ryan Scott at 2019-10-08T13:25:37-04:00 Mark newtype constructors as used in the Coercible solver (#10347) Currently, newtype constructors are not marked as used when they are accessed under the hood by uses of `coerce`, as described in #10347. This fixes #10347 by co-opting the `tcg_keep` field of `TcGblEnv` to track uses of newtype constructors in the `Coercible` solver. See `Note [Tracking unused binding and imports]` in `TcRnTypes`. Since #10347 is fixed, I was able to simplify the code in `TcDeriv` slightly, as the hack described in `Note [Newtype deriving and unused constructors]` is no longer necessary. - - - - - 9612e91c by Richard Eisenberg at 2019-10-08T13:26:20-04:00 Solve constraints from top-level groups sooner Previously, all constraints from all top-level groups (as separated by top-level splices) were lumped together and solved at the end. This could leak metavariables to TH, though, and that's bad. This patch solves each group's constraints before running the next group's splice. Naturally, we now report fewer errors in some cases. One nice benefit is that this also fixes #11680, but in a much simpler way than the original fix for that ticket. Admittedly, the error messages degrade just a bit from the fix from #11680 (previously, we informed users about variables that will be brought into scope below a top-level splice, and now we just report an out-of-scope error), but the amount of complexity required throughout GHC to get that error was just not worth it. This patch thus reverts much of f93c9517a2c6e158e4a5c5bc7a3d3f88cb4ed119. Fixes #16980 Test cases: th/T16980{,a} - - - - - c2d4011c by Vladislav Zavialov at 2019-10-08T13:27:12-04:00 Bump array and haddock submodules - - - - - f691f0c2 by Sebastian Graf at 2019-10-08T13:27:49-04:00 PmCheck: Look up parent data family TyCon when populating `PossibleMatches` The vanilla COMPLETE set is attached to the representation TyCon of a data family instance, whereas the user-defined COMPLETE sets are attached to the parent data family TyCon itself. Previously, we weren't trying particularly hard to get back to the representation TyCon to the parent data family TyCon, resulting in bugs like #17207. Now we should do much better. Fixes the original issue in #17207, but I found another related bug that isn't so easy to fix. - - - - - 0c0a15a8 by Ben Gamari at 2019-10-09T16:21:14-04:00 Rename STAGE macro to GHC_STAGE To avoid polluting the macro namespace - - - - - 63a5371d by Ben Gamari at 2019-10-09T16:21:14-04:00 Relayout generated header body - - - - - 817c1a94 by Ben Gamari at 2019-10-09T16:21:14-04:00 Define GHC_STAGE in headers instead of command-line - - - - - 5f2c49d8 by Ben Gamari at 2019-10-09T16:21:14-04:00 Remove GHC_STAGE guards from MachDeps This allows the stage1 compiler (which needs to run on the build platform and produce code for the host) to depend upon properties of the target. This is wrong. However, it's no more wrong than it was previously and @Erichson2314 is working on fixing this so I'm going to remove the guard so we can finally bootstrap HEAD with ghc-8.8 (see issue #17146). - - - - - 35cc5eff by Ben Gamari at 2019-10-09T16:21:15-04:00 Test - - - - - d584e3f0 by Ryan Scott at 2019-10-09T16:21:50-04:00 Use addUsedDataCons more judiciously in TcDeriv (#17324) If you derive an instance like this: ```hs deriving <...> instance Foo C ``` And the data constructors for `C` aren't in scope, then `doDerivInstErrorChecks1` throws an error. Moreover, it will _only_ throw an error if `<...>` is either `stock` or `newtype`. This is because the code that the `anyclass` or `via` strategies would generate would not require the use of the data constructors for `C`. However, `doDerivInstErrorChecks1` has another purpose. If you write this: ```hs import M (C(MkC1, ..., MkCn)) deriving <...> instance Foo C ``` Then `doDerivInstErrorChecks1` will call `addUsedDataCons` on `MkC1` through `MkCn` to ensure that `-Wunused-imports` does not complain about them. However, `doDerivInstErrorChecks1` was doing this for _every_ deriving strategy, which mean that if `<...>` were `anyclass` or `via`, then the warning about `MkC1` through `MkCn` being unused would be suppressed! The fix is simple enough: only call `addUsedDataCons` when the strategy is `stock` or `newtype`, just like the other code paths in `doDerivInstErrorChecks1`. Fixes #17324. - - - - - 30f5ac07 by Sebastian Graf at 2019-10-11T22:10:12-04:00 Much simpler language for PmCheck Simon realised that the simple language composed of let bindings, bang patterns and flat constructor patterns is enough to capture the semantics of the source pattern language that are important for pattern-match checking. Well, given that the Oracle is smart enough to connect the dots in this less informationally dense form, which it is now. So we transform `translatePat` to return a list of `PmGrd`s relative to an incoming match variable. `pmCheck` then trivially translates each of the `PmGrd`s into constraints that the oracle understands. Since we pass in the match variable, we incidentally fix #15884 (coverage checks for view patterns) through an interaction with !1746. - - - - - 166e1c2a by Stefan Schulze Frielinghaus at 2019-10-11T22:10:51-04:00 Hadrian: Take care of assembler source files Fixes #17286. - - - - - c2290596 by John Ericson at 2019-10-12T06:32:18-04:00 Simplify Configure in a few ways - No need to distinguish between gcc-llvm and clang. First of all, gcc-llvm is quite old and surely unmaintained by now. Second of all, none of the code actually care about that distinction! Now, it does make sense to consider C multiple frontends for LLVMs in the form of clang vs clang-cl (same clang, yes, but tweaked interface). But this is better handled in terms of "gccish vs mvscish" and "is LLVM", yielding 4 combinations. Therefore, I don't think it is useful saving the existing code for that. - Get the remaining CC_LLVM_BACKEND, and also TABLES_NEXT_TO_CODE in mk/config.h the normal way, rather than hacking it post-hoc. No point keeping these special cases around for now reason. - Get rid of hand-rolled `die` function and just use `AC_MSG_ERROR`. - Abstract check + flag override for unregisterised and tables next to code. Oh, and as part of the above I also renamed/combined some variables where it felt appropriate. - GccIsClang -> CcLlvmBackend. This is for `AC_SUBST`, like the other Camal case ones. It was never about gcc-llvm, or Apple's renamed clang, to be clear. - llvm_CC_FLAVOR -> CC_LLVM_BACKEND. This is for `AC_DEFINE`, like the other all-caps snake case ones. llvm_CC_FLAVOR was just silly indirection *and* an odd name to boot. - - - - - f1ce3535 by Vladislav Zavialov at 2019-10-12T06:33:05-04:00 Escape stats file command (#13676) - - - - - cd1a8808 by Vladislav Zavialov at 2019-10-12T06:33:05-04:00 Skip T13767 on Darwin The CI job fails with: +++ rts/T13676.run/T13676.run.stderr.normalised 2019-10-09 12:27:56.000000000 -0700 @@ -0,0 +1,4 @@ +dyld: Library not loaded: @rpath/libHShaskeline-0.7.5.0-ghc8.9.0.20191009.dylib + Referenced from: /Users/builder/builds/ewzE5N2p/0/ghc/ghc/inplace/lib/bin/ghc + Reason: image not found +*** Exception: readCreateProcess: '/Users/builder/builds/ewzE5N2p/0/ghc/ghc/inplace/lib/bin/ghc' '-B/Users/builder/builds/ewzE5N2p/0/ghc/ghc/inplace/lib' '-e' ''/''$'/'' == '/''/x0024'/''' +RTS '-tT13676.t' (exit -6): failed Unable to reproduce locally. - - - - - 0a338264 by Ryan Scott at 2019-10-12T06:33:42-04:00 Use newDFunName for both manual and derived instances (#17339) Issue #17339 was caused by using a slightly different version of `newDFunName` for derived instances that, confusingly enough, did not take all arguments to the class into account when generating the `DFun` name. I cannot think of any good reason for doing this, so this patch uses `newDFunName` uniformly for both derived instances and manually written instances alike. Fixes #17339. - - - - - c50e4c92 by Simon Peyton Jones at 2019-10-12T13:35:24-04:00 Fix validity checking for inferred types GHC is suposed to uphold the principle that an /inferred/ type for a let-binding should obey the rules for that module. E.g. we should only accept an inferred higher rank type if we have RankNTypes on. But we were failing to check this: TcValidity.checkValidType allowed arbitrary rank for inferred types. This patch fixes the bug. It might in principle cause some breakage, but if so that's good: the user should add RankNTypes and/or a manual signature. (And almost every package has explicit user signatures for all top-level things anyway.) Let's see. Fixes #17213. Metric Decrease: T10370 - - - - - 226d86d2 by Simon Peyton Jones at 2019-10-12T13:36:02-04:00 Do not add a 'solved dict' for quantified constraints GHC has a wonderful-but-delicate mechanism for building recursive dictionaries by adding a goal to the "solved dictionaries" before solving the sub-goals. See Note [Solved dictionaries] in TcSMonad Ticket #17267 showed that if you use this mechanism for local /quantified/ constraints you can get a loop -- or even unsafe coerce. This patch fixes the bug. Specifically * Make TcSMonad.addSolvedDict be conditional on using a /top level/ instance, not a quantified one. * Moreover, we /also/ don't want to add a solved dict for equalities (a~b). * Add lots more comments to Note [Solved dictionaries] to explain the above cryptic stuff. * Extend InstanceWhat to identify those strange built-in equality instances. A couple of other things along the way * Delete the unused Type.isIPPred_maybe. * Stop making addSolvedDict conditional on not being an impolicit parameter. This comes from way back. But it's irrelevant now because IP dicts are never solved via an instance. - - - - - 5ab1a28d by nineonine at 2019-10-13T06:31:40-04:00 Template Haskell: make unary tuples legal (#16881) - - - - - c1bd07cd by Andreas Klebinger at 2019-10-13T06:32:19-04:00 Fix #17334 where NCG did not properly update the CFG. Statements can change the basic block in which instructions are placed during instruction selection. We have to keep track of this switch of the current basic block as we need this information in order to properly update the CFG. This commit implements this change and fixes #17334. We do so by having stmtToInstr return the new block id if a statement changed the basic block. - - - - - 1eda9f28 by Takenobu Tani at 2019-10-13T19:06:02-04:00 users-guide: Add GHCi's ::<builtin-command> form This commit explicitly adds description about double colon command of GHCi. [skip ci] - - - - - 27145351 by Takenobu Tani at 2019-10-13T19:06:40-04:00 Add GHCi help message for :def! and :: commands - - - - - 78463fc5 by Ryan Scott at 2019-10-14T08:38:36-04:00 Add docs/users_guide/.log to .gitignore When the users guide fails to build (as in #17346), a `docs/users_guide/.log` file will be generated with contents that look something like this: ``` WARNING: unknown config value 'latex_paper_size' in override, ignoring /home/rgscott/Software/ghc5/docs/users_guide/ghci.rst:3410: WARNING: u'ghc-flag' reference target not found: -pgmo ?option? /home/rgscott/Software/ghc5/docs/users_guide/ghci.rst:3410: WARNING: u'ghc-flag' reference target not found: -pgmo ?port? Encoding error: 'ascii' codec can't encode character u'\u27e8' in position 132: ordinal not in range(128) The full traceback has been saved in /tmp/sphinx-err-rDF2LX.log, if you want to report the issue to the developers. ``` This definitely should not be checked in to version control, so let's add this to `.gitignore`. - - - - - 4aba72d6 by Ryan Scott at 2019-10-14T08:39:12-04:00 Mention changes from #16980, #17213 in 8.10.1 release notes The fixes for these issues both have user-facing consequences, so it would be good to mention them in the release notes for GHC 8.10.1. While I'm in town, also mention `UnboxedSums` in the release notes entry related to `-fobject-code`. - - - - - 0ca044fd by Ben Gamari at 2019-10-14T08:39:48-04:00 gitlab-ci: Move hadrian-ghc-in-ghci job first This is a very cheap job and can catch a number of "easy" failure modes (e.g. missing imports in the compiler). Let's run it first. - - - - - a2d3594c by Ryan Scott at 2019-10-15T01:35:34-04:00 Refactor some cruft in TcDerivInfer.inferConstraints The latest installment in my quest to clean up the code in `TcDeriv*`. This time, my sights are set on `TcDerivInfer.inferConstraints`, which infers the context for derived instances. This function is a wee bit awkward at the moment: * It's not terribly obvious from a quick glance, but `inferConstraints` is only ever invoked when using the `stock` or `anyclass` deriving strategies, as the code for inferring the context for `newtype`- or `via`-derived instances is located separately in `mk_coerce_based_eqn`. But there's no good reason for things to be this way, so I moved this code from `mk_coerce_based_eqn` to `inferConstraints` so that everything related to inferring instance contexts is located in one place. * In this process, I discovered that the Haddocks for the auxiliary function `inferConstraintsDataConArgs` are completely wrong. It claims that it handles both `stock` and `newtype` deriving, but this is completely wrong, as discussed above—it only handles `stock`. To rectify this, I renamed this function to `inferConstraintsStock` to reflect its actual purpose and created a new `inferConstraintsCoerceBased` function to specifically handle `newtype` (and `via`) deriving. Doing this revealed some opportunities for further simplification: * Removing the context-inference–related code from `mk_coerce_based_eqn` made me realize that the overall structure of the function is basically identical to `mk_originative_eqn`. In fact, I was easily able to combine the two functions into a single `mk_eqn_from_mechanism` function. As part of this merger, I now invoke `atf_coerce_based_error_checks` from `doDerivInstErrorChecks1`. * I discovered that GHC defined this function: ```hs typeToTypeKind = liftedTypeKind `mkVisFunTy` liftedTypeKind ``` No fewer than four times in different modules. I consolidated all of these definitions in a single location in `TysWiredIn`. - - - - - 426b0ddc by Ryan Scott at 2019-10-15T01:36:14-04:00 Don't skip validity checks for built-in classes (#17355) Issue #17355 occurred because the control flow for `TcValidity.check_valid_inst_head` was structured in such a way that whenever it checked a special, built-in class (like `Generic` or `HasField`), it would skip the most important check of all: `checkValidTypePats`, which rejects nonsense like this: ```hs instance Generic (forall a. a) ``` This fixes the issue by carving out `checkValidTypePats` from `check_valid_inst_head` so that `checkValidTypePats` is always invoked. `check_valid_inst_head` has also been renamed to `check_special_inst_head` to reflect its new purpose of _only_ checking for instances headed by special classes. Fixes #17355. - - - - - a55b8a65 by Alp Mestanogullari at 2019-10-15T18:41:18-04:00 iface: export a few more functions from BinIface - - - - - 9c11f817 by Ben Gamari at 2019-10-15T18:41:54-04:00 hadrian: Add support for bindist compressors other than Xz Fixes #17351. - - - - - 535a88e1 by klebinger.andreas at gmx.at at 2019-10-16T07:04:21-04:00 Add loop level analysis to the NCG backend. For backends maintaining the CFG during codegen we can now find loops and their nesting level. This is based on the Cmm CFG and dominator analysis. As a result we can estimate edge frequencies a lot better for methods, resulting in far better code layout. Speedup on nofib: ~1.5% Increase in compile times: ~1.9% To make this feasible this commit adds: * Dominator analysis based on the Lengauer-Tarjan Algorithm. * An algorithm estimating global edge frequences from branch probabilities - In CFG.hs A few static branch prediction heuristics: * Expect to take the backedge in loops. * Expect to take the branch NOT exiting a loop. * Expect integer vs constant comparisons to be false. We also treat heap/stack checks special for branch prediction to avoid them being treated as loops. - - - - - cc2bda50 by adithyaov at 2019-10-16T07:05:01-04:00 Compiling with -S and -fno-code no longer panics (fixes #17143) - - - - - 19641957 by Takenobu Tani at 2019-10-16T07:05:41-04:00 testsuite: Add test for #8305 This is a test for the current algorithm of GHCi command name resolution. I add this test in preparation for updating GHCi command name resolution. For the current algorithm, see https://downloads.haskell.org/ghc/latest/docs/html/users_guide/ghci.html#the-ghci-files - - - - - 6ede3554 by Sebastian Graf at 2019-10-16T07:06:20-04:00 Infer rho-types instead of sigma-types in guard BindStmts and TransStmts In #17343 we saw that we didn't handle the pattern guard `!_ <- undefined` correctly: The `undefined` was never evaluated. Indeed, elaboration failed to insert the invisible type aruments to `undefined`. So `undefined` was trivially a normal-form and in turn never entered. The problem is that we used to infer a sigma-type for the RHS of the guard, the leading qualifiers of which will never be useful in a pattern match situation. Hence we infer a rho-type now. Fixes #17343. - - - - - 798037a1 by John Ericson at 2019-10-16T07:06:58-04:00 Delete ghctags cabal file It came back to life in 381c3ae31b68019177f1cd20cb4da2f9d3b7d6c6 by mistake. - - - - - 51fad9e6 by Richard Eisenberg at 2019-10-16T15:58:58-04:00 Break up TcRnTypes, among other modules. This introduces three new modules: - basicTypes/Predicate.hs describes predicates, moving this logic out of Type. Predicates don't really exist in Core, and so don't belong in Type. - typecheck/TcOrigin.hs describes the origin of constraints and types. It was easy to remove from other modules and can often be imported instead of other, scarier modules. - typecheck/Constraint.hs describes constraints as used in the solver. It is taken from TcRnTypes. No work other than module splitting is in this patch. This is the first step toward homogeneous equality, which will rely more strongly on predicates. And homogeneous equality is the next step toward a dependently typed core language. - - - - - 11d4fc50 by Ben Gamari at 2019-10-16T15:59:52-04:00 hadrian: Introduce enableDebugInfo flavour transformer Also refactor things a bit to eliminate repetition. - - - - - deb96399 by Ryan Scott at 2019-10-16T16:00:29-04:00 Make Coverage.TM a newtype - - - - - 42ebc3f6 by Brian Wignall at 2019-10-16T16:01:06-04:00 Add hyperlinks to PDF/HTML documentation; closes #17342 - - - - - b15a7fb8 by Ben Gamari at 2019-10-17T01:03:11-04:00 testsuite: Ensure that makefile tests get run Previously `makefile_test` and `run_command` tests could easily end up in a situation where they wouldn't be run if the user used the `only_ways` modifier. The reason is to build the set of a ways to run the test in we first start with a candidate set determined by the test type (e.g. `makefile_test`, `compile_run`, etc.) and then filter that set with the constraints given by the test's modifiers. `makefile_test` and `run_command` tests' candidate sets were simply `{normal}`, and consequently most uses of `only_ways` would result in the test being never run. To avoid this we rather use all ways as the candidate sets for these test types. This may result in a few more testcases than we would like (given that some `run_command` tests are insensitive to way) but this can be fixed by adding modifiers and we would much rather run too many tests than too few. This fixes #16042 and a number of other tests afflicted by the same issue. However, there were a few cases that required special attention: * `T14028` is currently failing and is therefore marked as broken due to #17300 * `T-signals-child` is fragile in the `threaded1` and `threaded2` ways (tracked in #17307) - - - - - 4efdda90 by Richard Eisenberg at 2019-10-17T01:03:51-04:00 Tiny fixes to comments around flattening. - - - - - c4c9904b by Ben Gamari at 2019-10-17T01:04:26-04:00 testsuite: Assert that testsuite ways are known This ensures that all testsuite way names given to `omit_ways`, `only_ways`, etc. are known ways. - - - - - 697be2b6 by Ömer Sinan Ağacan at 2019-10-18T15:26:53-04:00 rts/GC: Add an obvious assertion during block initialization Namely ensure that block descriptors are initialized with valid generation numbers. Co-Authored-By: Ben Gamari <ben at well-typed.com> - - - - - 61d2ed42 by Ben Gamari at 2019-10-18T15:26:53-04:00 rts: Add Note explaining applicability of selector optimisation depth limit This was slightly non-obvious so a note seems deserved. - - - - - 11395037 by Ben Gamari at 2019-10-18T15:26:53-04:00 rts/Capability: A few documentation comments - - - - - 206f782a by Ben Gamari at 2019-10-18T15:26:53-04:00 rts: Give stack flags proper macros This were previously quite unclear and will change a bit under the non-moving collector so let's clear this up now. - - - - - 81d4675e by Ben Gamari at 2019-10-18T15:26:53-04:00 rts/GC: Refactor gcCAFs - - - - - 4d674c4e by Ben Gamari at 2019-10-18T15:26:53-04:00 rts: Fix macro parenthesisation - - - - - bfcafd39 by Ben Gamari at 2019-10-18T15:27:42-04:00 rts/Schedule: Allow synchronization without holding a capability The concurrent mark-and-sweep will be performed by a GHC task which will not hold a capability. This is necessary to avoid a concurrent mark from interfering with minor generation collections. However, the major collector must synchronize with the mutators at the end of marking to flush their update remembered sets. This patch extends the `requestSync` mechanism used to synchronize garbage collectors to allow synchronization without holding a capability. This change is fairly straightforward as the capability was previously only required for two reasons: 1. to ensure that we don't try to re-acquire a capability that we the sync requestor already holds. 2. to provide a way to suspend and later resume the sync request if there is already a sync pending. When synchronizing without holding a capability we needn't worry about consideration (1) at all. (2) is slightly trickier and may happen, for instance, when a capability requests a minor collection and shortly thereafter the non-moving mark thread requests a post-mark synchronization. In this case we need to ensure that the non-moving mark thread suspends his request until after the minor GC has concluded to avoid dead-locking. For this we introduce a condition variable, `sync_finished_cond`, which a non-capability-bearing requestor will wait on and which is signalled after a synchronization or GC has finished. - - - - - 921e4e36 by Ömer Sinan Ağacan at 2019-10-18T15:27:56-04:00 rts/BlockAlloc: Allow aligned allocation requests This implements support for block group allocations which are aligned to an integral number of blocks. This will be used by the nonmoving garbage collector, which uses the block allocator to allocate the segments which back its heap. These segments are a fixed number of blocks in size, with each segment being aligned to the segment size boundary. This allows us to easily find the segment metadata stored at the beginning of the segment. - - - - - 4b431f33 by Tamar Christina at 2019-10-20T16:21:10+01:00 Windows: Update tarballs to GCC 9.2 and remove MAX_PATH limit. - - - - - 8057ac96 by Ben Gamari at 2019-10-20T21:15:14-04:00 Merge branches 'wip/gc/sync-without-capability' and 'wip/gc/aligned-block-allocation' into wip/gc/preparation - - - - - 32500f64 by Ömer Sinan Ağacan at 2019-10-20T21:15:37-04:00 rts/StableName: Expose FOR_EACH_STABLE_NAME, freeSnEntry, SNT_size These will be needed when we implement sweeping in the nonmoving collector. - - - - - 4be5152a by Ben Gamari at 2019-10-20T21:15:37-04:00 rts: Disable aggregate-return warnings from gcc This warning is a bit of a relic; there is little reason to avoid aggregate return values in 2019. - - - - - 04471c4f by Ömer Sinan Ağacan at 2019-10-20T21:15:37-04:00 rts/Scav: Expose scavenging functions To keep the non-moving collector nicely separated from the moving collector its scavenging phase will live in another file, `NonMovingScav.c`. However, it will need to use these functions so let's expose them. - - - - - 6ff29c06 by Ben Gamari at 2019-10-20T21:15:37-04:00 rts: Introduce flag to enable the nonmoving old generation This flag will enable the use of a non-moving oldest generation. - - - - - b3ef2d1a by Ben Gamari at 2019-10-20T21:15:37-04:00 rts: Introduce debug flag for non-moving GC - - - - - 68e0647f by Ömer Sinan Ağacan at 2019-10-20T21:15:37-04:00 rts: Non-concurrent mark and sweep This implements the core heap structure and a serial mark/sweep collector which can be used to manage the oldest-generation heap. This is the first step towards a concurrent mark-and-sweep collector aimed at low-latency applications. The full design of the collector implemented here is described in detail in a technical note B. Gamari. "A Concurrent Garbage Collector For the Glasgow Haskell Compiler" (2018) The basic heap structure used in this design is heavily inspired by K. Ueno & A. Ohori. "A fully concurrent garbage collector for functional programs on multicore processors." /ACM SIGPLAN Notices/ Vol. 51. No. 9 (presented by ICFP 2016) This design is intended to allow both marking and sweeping concurrent to execution of a multi-core mutator. Unlike the Ueno design, which requires no global synchronization pauses, the collector introduced here requires a stop-the-world pause at the beginning and end of the mark phase. To avoid heap fragmentation, the allocator consists of a number of fixed-size /sub-allocators/. Each of these sub-allocators allocators into its own set of /segments/, themselves allocated from the block allocator. Each segment is broken into a set of fixed-size allocation blocks (which back allocations) in addition to a bitmap (used to track the liveness of blocks) and some additional metadata (used also used to track liveness). This heap structure enables collection via mark-and-sweep, which can be performed concurrently via a snapshot-at-the-beginning scheme (although concurrent collection is not implemented in this patch). The mark queue is a fairly straightforward chunked-array structure. The representation is a bit more verbose than a typical mark queue to accomodate a combination of two features: * a mark FIFO, which improves the locality of marking, reducing one of the major overheads seen in mark/sweep allocators (see [1] for details) * the selector optimization and indirection shortcutting, which requires that we track where we found each reference to an object in case we need to update the reference at a later point (e.g. when we find that it is an indirection). See Note [Origin references in the nonmoving collector] (in `NonMovingMark.h`) for details. Beyond this the mark/sweep is fairly run-of-the-mill. [1] R. Garner, S.M. Blackburn, D. Frampton. "Effective Prefetch for Mark-Sweep Garbage Collection." ISMM 2007. Co-Authored-By: Ben Gamari <ben at well-typed.com> - - - - - c7e73d12 by Ben Gamari at 2019-10-20T21:15:37-04:00 testsuite: Add nonmoving WAY This simply runs the compile_and_run tests with `-xn`, enabling the nonmoving oldest generation. - - - - - f8f77a07 by Ben Gamari at 2019-10-20T21:15:37-04:00 rts: Mark binder as const - - - - - bd8e3ff4 by Ben Gamari at 2019-10-20T21:15:52-04:00 rts: Implement concurrent collection in the nonmoving collector This extends the non-moving collector to allow concurrent collection. The full design of the collector implemented here is described in detail in a technical note B. Gamari. "A Concurrent Garbage Collector For the Glasgow Haskell Compiler" (2018) This extension involves the introduction of a capability-local remembered set, known as the /update remembered set/, which tracks objects which may no longer be visible to the collector due to mutation. To maintain this remembered set we introduce a write barrier on mutations which is enabled while a concurrent mark is underway. The update remembered set representation is similar to that of the nonmoving mark queue, being a chunked array of `MarkEntry`s. Each `Capability` maintains a single accumulator chunk, which it flushed when it (a) is filled, or (b) when the nonmoving collector enters its post-mark synchronization phase. While the write barrier touches a significant amount of code it is conceptually straightforward: the mutator must ensure that the referee of any pointer it overwrites is added to the update remembered set. However, there are a few details: * In the case of objects with a dirty flag (e.g. `MVar`s) we can exploit the fact that only the *first* mutation requires a write barrier. * Weak references, as usual, complicate things. In particular, we must ensure that the referee of a weak object is marked if dereferenced by the mutator. For this we (unfortunately) must introduce a read barrier, as described in Note [Concurrent read barrier on deRefWeak#] (in `NonMovingMark.c`). * Stable names are also a bit tricky as described in Note [Sweeping stable names in the concurrent collector] (`NonMovingSweep.c`). We take quite some pains to ensure that the high thread count often seen in parallel Haskell applications doesn't affect pause times. To this end we allow thread stacks to be marked either by the thread itself (when it is executed or stack-underflows) or the concurrent mark thread (if the thread owning the stack is never scheduled). There is a non-trivial handshake to ensure that this happens without racing which is described in Note [StgStack dirtiness flags and concurrent marking]. Co-Authored-by: Ömer Sinan Ağacan <omer at well-typed.com> - - - - - dd1b4fdd by Ben Gamari at 2019-10-20T21:15:52-04:00 Nonmoving: Disable memory inventory with concurrent collection - - - - - 4a44ab33 by Ben Gamari at 2019-10-20T21:15:52-04:00 rts: Shrink size of STACK's dirty and marking fields - - - - - 10373416 by Ben Gamari at 2019-10-20T21:15:52-04:00 Don't cleanup until we've stopped the collector This requires that we break nonmovingExit into two pieces since we need to first stop the collector to relinquish any capabilities, then we need to shutdown the scheduler, then we need to free the nonmoving allocators. - - - - - 26c3827f by Ben Gamari at 2019-10-21T11:43:54-04:00 Nonmoving: Ensure write barrier vanishes in non-threaded RTS - - - - - 17e5a032 by Ben Gamari at 2019-10-21T11:43:54-04:00 ThreadPaused: Add barrer on updated thunk - - - - - 8ea316da by David Eichmann at 2019-10-22T02:07:48-04:00 CI: Always dump performance metrics. - - - - - aa31ceaf by Matthew Bauer at 2019-10-22T02:39:01-04:00 Replace freebsd-gnueabihf with freebsd FreeBSD does not support GNU libc, so it makes no sense to use this triple. Most likely previous builds were just using the FreeBSD libc instead of gnueabihf. To fix this, we should just use armv6-unknown-freebsd and armv7-unknown-freebsd triples. Note that both of these are actually "soft-float", not "hard-float". FreeBSD has never officially released hard-float arm32: https://wiki.freebsd.org/ARMTier1 - - - - - fd8b666a by Stefan Schulze Frielinghaus at 2019-10-22T02:39:03-04:00 Implement s390x LLVM backend. This patch adds support for the s390x architecture for the LLVM code generator. The patch includes a register mapping of STG registers onto s390x machine registers which enables a registerised build. - - - - - 2d2cc76f by Tilman Blumhagen at 2019-10-22T02:39:04-04:00 Documentation for (&&) and (&&) states that they are lazy in their second argument (fixes #17354) - - - - - 06d51c4e by Ben Gamari at 2019-10-22T12:13:36-04:00 Fix unregisterised build This required some fiddling around with the location of forward declarations since the C sources generated by GHC's C backend only includes Stg.h. - - - - - 912e440e by Ben Gamari at 2019-10-22T12:17:00-04:00 rts: Tracing support for nonmoving collection events This introduces a few events to mark key points in the nonmoving garbage collection cycle. These include: * `EVENT_CONC_MARK_BEGIN`, denoting the beginning of a round of marking. This may happen more than once in a single major collection since we the major collector iterates until it hits a fixed point. * `EVENT_CONC_MARK_END`, denoting the end of a round of marking. * `EVENT_CONC_SYNC_BEGIN`, denoting the beginning of the post-mark synchronization phase * `EVENT_CONC_UPD_REM_SET_FLUSH`, indicating that a capability has flushed its update remembered set. * `EVENT_CONC_SYNC_END`, denoting that all mutators have flushed their update remembered sets. * `EVENT_CONC_SWEEP_BEGIN`, denoting the beginning of the sweep portion of the major collection. * `EVENT_CONC_SWEEP_END`, denoting the end of the sweep portion of the major collection. - - - - - 9f42cd81 by Ben Gamari at 2019-10-22T12:17:00-04:00 rts: Introduce non-moving heap census This introduces a simple census of the non-moving heap (not to be confused with the heap census used by the heap profiler). This collects basic heap usage information (number of allocated and free blocks) which is useful when characterising fragmentation of the nonmoving heap. - - - - - 711837cc by Ben Gamari at 2019-10-22T12:17:00-04:00 rts/Eventlog: More descriptive error message - - - - - 0d31819e by Ben Gamari at 2019-10-22T12:17:00-04:00 Allow census without live word count Otherwise the census is unsafe when mutators are running due to concurrent mutation. - - - - - 6f173181 by Ben Gamari at 2019-10-22T12:17:00-04:00 NonmovingCensus: Emit samples to eventlog - - - - - 13dd78dd by Ben Gamari at 2019-10-22T12:18:33-04:00 Nonmoving: Allow aging and refactor static objects logic This commit does two things: * Allow aging of objects during the preparatory minor GC * Refactor handling of static objects to avoid the use of a hashtable - - - - - 7b79e8b4 by Ben Gamari at 2019-10-22T12:18:33-04:00 Disable aging when doing deadlock detection GC - - - - - 8fffe12b by Ben Gamari at 2019-10-22T12:18:33-04:00 More comments for aging - - - - - 039d2906 by Ben Gamari at 2019-10-22T12:18:39-04:00 NonMoving: Eliminate integer division in nonmovingBlockCount Perf showed that the this single div was capturing up to 10% of samples in nonmovingMark. However, the overwhelming majority of cases is looking at small block sizes. These cases we can easily compute explicitly, allowing the compiler to turn the division into a significantly more efficient division-by-constant. While the increase in source code looks scary, this all optimises down to very nice looking assembler. At this point the only remaining hotspots in nonmovingBlockCount are due to memory access. - - - - - d15ac82d by Ben Gamari at 2019-10-22T12:18:39-04:00 NonMoving: Allocate mark queues in larger block groups - - - - - 26d2d331 by Ben Gamari at 2019-10-22T12:18:39-04:00 NonMovingMark: Optimize representation of mark queue This shortens MarkQueueEntry by 30% (one word) - - - - - e5eda61e by Ben Gamari at 2019-10-22T12:18:39-04:00 NonMoving: Optimize bitmap search during allocation Use memchr instead of a open-coded loop. This is nearly twice as fast in a synthetic benchmark. - - - - - dacf4cae by Ben Gamari at 2019-10-22T12:18:39-04:00 rts: Add prefetch macros - - - - - 786c52d2 by Ben Gamari at 2019-10-22T12:18:39-04:00 NonMoving: Prefetch when clearing bitmaps Ensure that the bitmap of the segmentt that we will clear next is in cache by the time we reach it. - - - - - 0387df5b by Ben Gamari at 2019-10-22T12:18:39-04:00 NonMoving: Inline nonmovingClearAllBitmaps - - - - - e893877e by Ben Gamari at 2019-10-22T12:18:39-04:00 NonMoving: Fuse sweep preparation into mark prep - - - - - e6f6823f by Ben Gamari at 2019-10-22T12:18:39-04:00 NonMoving: Pre-fetch during mark This improved overall runtime on nofib's constraints test by nearly 10%. - - - - - 56c5ebdc by Ben Gamari at 2019-10-22T12:18:39-04:00 NonMoving: Prefetch segment header - - - - - 19bfe460 by Ben Gamari at 2019-10-22T12:18:39-04:00 NonMoving: Optimise allocator cache behavior Previously we would look at the segment header to determine the block size despite the fact that we already had the block size at hand. - - - - - 53a1a27e by Ben Gamari at 2019-10-22T12:18:39-04:00 NonMovingMark: Eliminate redundant check_in_nonmoving_heaps - - - - - b967e470 by Ben Gamari at 2019-10-22T12:18:39-04:00 NonMoving: Don't do major GC if one is already running Previously we would perform a preparatory moving collection, resulting in many things being added to the mark queue. When we finished with this we would realize in nonmovingCollect that there was already a collection running, in which case we would simply not run the nonmoving collector. However, it was very easy to end up in a "treadmilling" situation: all subsequent GC following the first failed major GC would be scheduled as major GCs. Consequently we would continuously feed the concurrent collector with more mark queue entries and it would never finish. This patch aborts the major collection far earlier, meaning that we avoid adding nonmoving objects to the mark queue and allowing the concurrent collector to finish. - - - - - 3bc172a4 by Ben Gamari at 2019-10-22T12:18:39-04:00 NonMoving: Clean mut_list - - - - - 8e79e2a9 by Ben Gamari at 2019-10-22T12:18:39-04:00 Unconditionally flush update remembered set during minor GC Flush the update remembered set. The goal here is to flush periodically to ensure that we don't end up with a thread who marks their stack on their local update remembered set and doesn't flush until the nonmoving sync period as this would result in a large fraction of the heap being marked during the sync pause. - - - - - b281e80b by Ben Gamari at 2019-10-22T12:18:44-04:00 testsuite: Add nonmoving_thr way - - - - - 07987957 by Ben Gamari at 2019-10-22T12:18:44-04:00 testsuite: Add nonmoving_thr_ghc way This uses the nonmoving collector when compiling the testcases. - - - - - 01fd0242 by Ben Gamari at 2019-10-22T12:18:44-04:00 testsuite: Don't run T15892 in nonmoving ways The nonmoving GC doesn't support `+RTS -G1`, which this test insists on. - - - - - 097f4fd0 by Ben Gamari at 2019-10-22T12:18:44-04:00 testsuite: Nonmoving collector doesn't support -G1 - - - - - 4b91dd25 by Ben Gamari at 2019-10-22T12:18:44-04:00 testsuite: Ensure that threaded tests are run in nonmoving_thr - - - - - 78ce35b9 by Ben Gamari at 2019-10-22T12:18:44-04:00 testsuite: bug1010 requires -c, which isn't supported by nonmoving - - - - - 6e97cc47 by Ben Gamari at 2019-10-22T12:18:44-04:00 testsuite: Skip T15892 in nonmoving_thr_ghc - - - - - 5ce853c8 by Ben Gamari at 2019-10-22T12:18:44-04:00 ghc-heap: Skip heap_all test with debugged RTS The debugged RTS initializes the heap with 0xaa, which breaks the (admittedly rather fragile) assumption that uninitialized fields are set to 0x00: ``` Wrong exit code for heap_all(nonmoving)(expected 0 , actual 1 ) Stderr ( heap_all ): heap_all: user error (assertClosuresEq: Closures do not match Expected: FunClosure {info = StgInfoTable {entry = Nothing, ptrs = 0, nptrs = 1, tipe = FUN_0_1, srtlen = 0, code = Nothing}, ptrArgs = [], dataArgs = [0]} Actual: FunClosure {info = StgInfoTable {entry = Nothing, ptrs = 0, nptrs = 1, tipe = FUN_0_1, srtlen = 1032832, code = Nothing}, ptrArgs = [], dataArgs = [12297829382473034410]} CallStack (from HasCallStack): assertClosuresEq, called at heap_all.hs:230:9 in main:Main ) ``` - - - - - 6abefce7 by Ben Gamari at 2019-10-22T12:18:44-04:00 Skip ghc_heap_all test in nonmoving ways - - - - - 99baff8c by Ben Gamari at 2019-10-22T12:18:44-04:00 testsuite: Don't run T9630 in nonmoving ways The nonmoving collector doesn't support -G1 - - - - - 25ae8f7d by Ben Gamari at 2019-10-22T12:18:44-04:00 testsuite: Don't run T7160 in nonmoving_thr ways The nonmoving way finalizes things in a different order. - - - - - 8cab149b by Ben Gamari at 2019-10-22T12:18:44-04:00 testsuite: Mark length001 as failing under nonmoving ways This is consistent with the other unoptimized ways. - - - - - 5b130b3d by Ben Gamari at 2019-10-22T12:18:46-04:00 Merge branches 'wip/gc/optimize' and 'wip/gc/test' into wip/gc/everything - - - - - 246ce2af by Ömer Sinan Ağacan at 2019-10-22T12:20:15-04:00 NonMoving: Implement indirection shortcutting This allows indirection chains residing in the non-moving heap to be shorted-out. - - - - - 875861ef by Ömer Sinan Ağacan at 2019-10-22T12:20:15-04:00 NonMoving: Implement selector optimisation - - - - - c72e84c6 by Ben Gamari at 2019-10-22T12:20:15-04:00 NonMovingMark: Handle INDs left by shortcutting - - - - - 0f8fd3c6 by Ömer Sinan Ağacan at 2019-10-22T12:20:15-04:00 NonMoving: Implement -xns to disable selector optimization - - - - - c936a245 by Ben Gamari at 2019-10-22T12:20:37-04:00 NonMoving: Introduce nonmovingSegmentLogBlockSize acccessor This will allow us to easily move the block size elsewhere. - - - - - 6dcef5ee by Ben Gamari at 2019-10-22T12:20:37-04:00 NonMoving: Move block size to block descriptor - - - - - dd8d1b49 by Ben Gamari at 2019-10-22T12:20:37-04:00 NonMoving: Move next_free_snap to block descriptor - - - - - 116e4646 by Ben Gamari at 2019-10-22T12:20:46-04:00 NonMoving: Add summarizing Note - - - - - 22eee2bc by Ben Gamari at 2019-10-22T12:20:48-04:00 Merge branches 'wip/gc/segment-header-to-bdescr' and 'wip/gc/docs' into wip/gc/everything2 - - - - - 3a862703 by Ömer Sinan Ağacan at 2019-10-22T18:56:32-04:00 rts: COMPACT_NFDATA support for the nonmoving collector This largely follows the model used for large objects, with appropriate adjustments made to account for references in the sharing deduplication hashtable. - - - - - 7c35d39b by Ben Gamari at 2019-10-22T18:56:32-04:00 rts: Mark nonmoving GC paths in moving collector as unlikely The expectation here is that the nonmoving GC is latency-centric, whereas the moving GC emphasizes throughput. Therefore we give the latter the benefit of better static branch prediction. - - - - - 91109404 by Ben Gamari at 2019-10-22T18:57:27-04:00 nonmoving: Trace GC preparation steps - - - - - a69b28f4 by Ben Gamari at 2019-10-22T18:57:27-04:00 nonmoving: Don't do two passes over large and compact object lists Previously we would first move the new objects to their appropriate non-moving GC list, then do another pass over that list to clear their mark bits. This is needlessly expensive. First clear the mark bits of the existing objects, then add the newly evacuated objects and, at the same time, clear their mark bits. This cuts the preparatory GC time in half for the Pusher benchmark with a large queue size. - - - - - 984745b0 by Ben Gamari at 2019-10-22T18:57:27-04:00 nonmoving: Upper-bound time we hold SM_MUTEX for during sweep - - - - - 96c5411a by David Feuer at 2019-10-23T05:58:37-04:00 Use an IORef for QSemN Replace the outer `MVar` in `QSemN` with an `IORef`. This should probably be lighter, and it removes the need for `uninterruptibleMask`. Previously Differential Revision https://phabricator.haskell.org/D4896 - - - - - faa30dcb by Andreas Klebinger at 2019-10-23T05:58:43-04:00 Warn about missing profiled libs when using the Interpreter. When GHC itself, or it's interpreter is profiled we need to load profiled libraries as well. This requirement is not always obvious, especially when TH implicilty uses the interpreter. When the libs were not found we fall back to assuming the are in a DLL. This is usually not the case so now we warn users when we do so. This makes it more obvious what is happening and gives users a way to fix the issue. This fixes #17121. - - - - - 1cd3fa29 by Richard Eisenberg at 2019-10-23T05:58:46-04:00 Implement a coverage checker for injectivity This fixes #16512. There are lots of parts of this patch: * The main payload is in FamInst. See Note [Coverage condition for injective type families] there for the overview. But it doesn't fix the bug. * We now bump the reduction depth every time we discharge a CFunEqCan. See Note [Flatten when discharging CFunEqCan] in TcInteract. * Exploration of this revealed a new, easy to maintain invariant for CTyEqCans. See Note [Almost function-free] in TcRnTypes. * We also realized that type inference for injectivity was a bit incomplete. This means we exchanged lookupFlattenTyVar for rewriteTyVar. See Note [rewriteTyVar] in TcFlatten. The new function is monadic while the previous one was pure, necessitating some faff in TcInteract. Nothing too bad. * zonkCt did not maintain invariants on CTyEqCan. It's not worth the bother doing so, so we just transmute CTyEqCans to CNonCanonicals. * The pure unifier was finding the fixpoint of the returned substitution, even when doing one-way matching (in tcUnifyTysWithTFs). Fixed now. Test cases: typecheck/should_fail/T16512{a,b} - - - - - 900cf195 by Alp Mestanogullari at 2019-10-23T05:58:48-04:00 compiler: introduce DynFlags plugins They have type '[CommandLineOpts] -> Maybe (DynFlags -> IO DynFlags)'. All plugins that supply a non-Nothing 'dynflagsPlugin' will see their updates applied to the current DynFlags right after the plugins are loaded. One use case for this is to superseede !1580 for registering hooks from a plugin. Frontend/parser plugins were considered to achieve this but they respectively conflict with how this plugin is going to be used and don't allow overriding/modifying the DynFlags, which is how hooks have to be registered. This commit comes with a test, 'test-hook-plugin', that registers a "fake" meta hook that replaces TH expressions with the 0 integer literal. - - - - - a19c7d17 by Ryan Scott at 2019-10-23T05:58:49-04:00 Reify oversaturated data family instances correctly (#17296) `TcSplice` was not properly handling oversaturated data family instances, such as the example in #17296, as it dropped arguments due to carelessly zipping data family instance arguments with `tyConTyVars`. For data families, the number of `tyConTyVars` can sometimes be less than the number of arguments it can accept in a data family instance due to the fact that data family instances can be oversaturated. To account for this, `TcSplice.mkIsPolyTvs` has now been renamed to `tyConArgsPolyKinded` and now factors in `tyConResKind` in addition to `tyConTyVars`. I've also added `Note [Reified instances and explicit kind signatures]` which explains the various subtleties in play here. Fixes #17296. - - - - - 9b2a5008 by Ben Gamari at 2019-10-23T05:58:50-04:00 testsuite: Don't run T7653 in ghci and profiled ways Currently this routinely fails in the i386 job. See #7653. - - - - - b521e8b6 by Ömer Sinan Ağacan at 2019-10-23T05:58:57-04:00 Refactor Compact.c: - Remove forward declarations - Introduce UNTAG_PTR and GET_PTR_TAG for dealing with pointer tags without having to cast arguments to StgClosure* - Remove dead code - Use W_ instead of StgWord - Use P_ instead of StgPtr - - - - - 17987a4b by Matthew Pickering at 2019-10-23T05:58:58-04:00 eventlog: Dump cost centre stack on each sample With this change it is possible to reconstruct the timing portion of a `.prof` file after the fact. By logging the stacks at each time point a more precise executation trace of the program can be observed rather than all identical cost centres being identified in the report. There are two new events: 1. `EVENT_PROF_BEGIN` - emitted at the start of profiling to communicate the tick interval 2. `EVENT_PROF_SAMPLE_COST_CENTRE` - emitted on each tick to communicate the current call stack. Fixes #17322 - - - - - 4798f3b9 by Takenobu Tani at 2019-10-23T05:59:00-04:00 Allow command name resolution for GHCi commands with option `!` #17345 This commit allows command name resolution for GHCi commands with option `!` as follows: ghci> :k! Int Int :: * = Int This commit changes implementation as follows: Before: * Prefix match with full string including the option `!` (e.g. `k!`) After (this patch): * Prefix match without option suffix `!` (e.g. `k`) * in addition, suffix match with option `!` See also #8305 and #8113 - - - - - aa778152 by Andreas Klebinger at 2019-10-23T05:59:01-04:00 Fix bug in the x86 backend involving the CFG. This is part two of fixing #17334. There are two parts to this commit: - A bugfix for computing loop levels - A bugfix of basic block invariants in the NCG. ----------------------------------------------------------- In the first bug we ended up with a CFG of the sort: [A -> B -> C] This was represented via maps as fromList [(A,B),(B,C)] and later transformed into a adjacency array. However the transformation did not include block C in the array (since we only looked at the keys of the map). This was still fine until we tried to look up successors for C and tried to read outside of the array bounds when accessing C. In order to prevent this in the future I refactored to code to include all nodes as keys in the map representation. And make this a invariant which is checked in a few places. Overall I expect this to make the code more robust as now any failed lookup will represent an error, versus failed lookups sometimes being expected and sometimes not. In terms of performance this makes some things cheaper (getting a list of all nodes) and others more expensive (adding a new edge). Overall this adds up to no noteable performance difference. ----------------------------------------------------------- Part 2: When the NCG generated a new basic block, it did not always insert a NEWBLOCK meta instruction in the stream which caused a quite subtle bug. During instruction selection a statement `s` in a block B with control of the sort: B -> C will sometimes result in control flow of the sort: ┌ < ┐ v ^ B -> B1 ┴ -> C as is the case for some atomic operations. Now to keep the CFG in sync when introducing B1 we clearly want to insert it between B and C. However there is a catch when we have to deal with self loops. We might start with code and a CFG of these forms: loop: stmt1 ┌ < ┐ .... v ^ stmtX loop ┘ stmtY .... goto loop: Now we introduce B1: ┌ ─ ─ ─ ─ ─┐ loop: │ ┌ < ┐ │ instrs v │ │ ^ .... loop ┴ B1 ┴ ┘ instrsFromX stmtY goto loop: This is simple, all outgoing edges from loop now simply start from B1 instead and the code generator knows which new edges it introduced for the self loop of B1. Disaster strikes if the statement Y follows the same pattern. If we apply the same rule that all outgoing edges change then we end up with: loop ─> B1 ─> B2 ┬─┐ │ │ └─<┤ │ │ └───<───┘ │ └───────<────────┘ This is problematic. The edge B1->B1 is modified as expected. However the modification is wrong! The assembly in this case looked like this: _loop: <instrs> _B1: ... cmpxchgq ... jne _B1 <instrs> <end _B1> _B2: ... cmpxchgq ... jne _B2 <instrs> jmp loop There is no edge _B2 -> _B1 here. It's still a self loop onto _B1. The problem here is that really B1 should be two basic blocks. Otherwise we have control flow in the *middle* of a basic block. A contradiction! So to account for this we add yet another basic block marker: _B: <instrs> _B1: ... cmpxchgq ... jne _B1 jmp _B1' _B1': <instrs> <end _B1> _B2: ... Now when inserting B2 we will only look at the outgoing edges of B1' and everything will work out nicely. You might also wonder why we don't insert jumps at the end of _B1'. There is no way another block ends up jumping to the labels _B1 or _B2 since they are essentially invisible to other blocks. View them as control flow labels local to the basic block if you'd like. Not doing this ultimately caused (part 2 of) #17334. - - - - - 1f40e68a by Ryan Yates at 2019-10-23T05:59:03-04:00 Full abort on validate failure merging `orElse`. Previously partial roll back of a branch of an `orElse` was attempted if validation failure was observed. Validation here, however, does not account for what part of the transaction observed inconsistent state. This commit fixes this by fully aborting and restarting the transaction. - - - - - 9c1f0f7c by Ben Gamari at 2019-10-23T05:59:03-04:00 Bump stm submodule - - - - - 6beea836 by Andreas Klebinger at 2019-10-23T05:59:04-04:00 Make dynflag argument for withTiming pure. 19 times out of 20 we already have dynflags in scope. We could just always use `return dflags`. But this is in fact not free. When looking at some STG code I noticed that we always allocate a closure for this expression in the heap. Clearly a waste in these cases. For the other cases we can either just modify the callsite to get dynflags or use the _D variants of withTiming I added which will use getDynFlags under the hood. - - - - - 8dd480cc by Matthew Pickering at 2019-10-23T05:59:06-04:00 Performance tests: Reduce acceptance threshold for bytes allocated tests The "new" performance testing infrastructure resets the baseline after every test so it's easy to miss gradual performance regressions over time. We should at least make these numbers smaller to catch patches which affect performance earlier. - - - - - 4af20bbc by Ben Gamari at 2019-10-23T05:59:06-04:00 users-guide: Fix :since: for -Wunused-packages Fixes #17382. - - - - - 21663693 by Ben Gamari at 2019-10-23T05:59:07-04:00 Drop duplicate -optl's from GHC invocations Previously the make build system would pass things like `-optl-optl-Wl,-x -optl-optl-Wl,noexecstack` to GHC. This would naturally result in mass confusion as GHC would pass `-optl-Wl,-x` to GCC. GCC would in turn interpret this as `-o ptl-Wl,-x`, setting the output pass of the invocation. The problem that `-optl` was added to the command-line in two places in the build system. Fix this. Fixes #17385. - - - - - bb0dc5a5 by Andreas Klebinger at 2019-10-23T05:59:07-04:00 Hadrian: Invoke ghc0 via bash when running tests to fix #17362. cmd uses RawCommand which uses Windows semantics to find the executable which sometimes seems to fail for unclear reasons. If we invoke ghc via bash then bash will find the ghc executable and the issue goes away. - - - - - 266435a7 by Ömer Sinan Ağacan at 2019-10-23T05:59:09-04:00 Add new flag for unarised STG dumps Previously -ddump-stg would dump pre and post-unarise STGs. Now we have a new flag for post-unarise STG and -ddump-stg only dumps coreToStg output. STG dump flags after this commit: - -ddump-stg: Dumps CoreToStg output - -ddump-stg-unarised: Unarise output - -ddump-stg-final: STG right before code gen (includes CSE and lambda lifting) - - - - - 8abddac8 by Ben Gamari at 2019-10-23T05:59:10-04:00 base: Add @since on GHC.IO.Handle.Lock.hUnlock Unfortunately this was introduced in base-4.11.0 (GHC 8.4.1) whereas the other locking primitives were added in base-4.10.0 (GHC 8.2.1). - - - - - 7f72b540 by Ben Gamari at 2019-10-23T14:56:46-04:00 Merge non-moving garbage collector This introduces a concurrent mark & sweep garbage collector to manage the old generation. The concurrent nature of this collector typically results in significantly reduced maximum and mean pause times in applications with large working sets. Due to the large and intricate nature of the change I have opted to preserve the fully-buildable history, including merge commits, which is described in the "Branch overview" section below. Collector design ================ The full design of the collector implemented here is described in detail in a technical note > B. Gamari. "A Concurrent Garbage Collector For the Glasgow Haskell > Compiler" (2018) This document can be requested from @bgamari. The basic heap structure used in this design is heavily inspired by > K. Ueno & A. Ohori. "A fully concurrent garbage collector for > functional programs on multicore processors." /ACM SIGPLAN Notices/ > Vol. 51. No. 9 (presented at ICFP 2016) This design is intended to allow both marking and sweeping concurrent to execution of a multi-core mutator. Unlike the Ueno design, which requires no global synchronization pauses, the collector introduced here requires a stop-the-world pause at the beginning and end of the mark phase. To avoid heap fragmentation, the allocator consists of a number of fixed-size /sub-allocators/. Each of these sub-allocators allocators into its own set of /segments/, themselves allocated from the block allocator. Each segment is broken into a set of fixed-size allocation blocks (which back allocations) in addition to a bitmap (used to track the liveness of blocks) and some additional metadata (used also used to track liveness). This heap structure enables collection via mark-and-sweep, which can be performed concurrently via a snapshot-at-the-beginning scheme (although concurrent collection is not implemented in this patch). Implementation structure ======================== The majority of the collector is implemented in a handful of files: * `rts/Nonmoving.c` is the heart of the beast. It implements the entry-point to the nonmoving collector (`nonmoving_collect`), as well as the allocator (`nonmoving_allocate`) and a number of utilities for manipulating the heap. * `rts/NonmovingMark.c` implements the mark queue functionality, update remembered set, and mark loop. * `rts/NonmovingSweep.c` implements the sweep loop. * `rts/NonmovingScav.c` implements the logic necessary to scavenge the nonmoving heap. Branch overview =============== ``` * wip/gc/opt-pause: | A variety of small optimisations to further reduce pause times. | * wip/gc/compact-nfdata: | Introduce support for compact regions into the non-moving |\ collector | \ | \ | | * wip/gc/segment-header-to-bdescr: | | | Another optimization that we are considering, pushing | | | some segment metadata into the segment descriptor for | | | the sake of locality during mark | | | | * | wip/gc/shortcutting: | | | Support for indirection shortcutting and the selector optimization | | | in the non-moving heap. | | | * | | wip/gc/docs: | |/ Work on implementation documentation. | / |/ * wip/gc/everything: | A roll-up of everything below. |\ | \ | |\ | | \ | | * wip/gc/optimize: | | | A variety of optimizations, primarily to the mark loop. | | | Some of these are microoptimizations but a few are quite | | | significant. In particular, the prefetch patches have | | | produced a nontrivial improvement in mark performance. | | | | | * wip/gc/aging: | | | Enable support for aging in major collections. | | | | * | wip/gc/test: | | | Fix up the testsuite to more or less pass. | | | * | | wip/gc/instrumentation: | | | A variety of runtime instrumentation including statistics | | / support, the nonmoving census, and eventlog support. | |/ | / |/ * wip/gc/nonmoving-concurrent: | The concurrent write barriers. | * wip/gc/nonmoving-nonconcurrent: | The nonmoving collector without the write barriers necessary | for concurrent collection. | * wip/gc/preparation: | A merge of the various preparatory patches that aren't directly | implementing the GC. | | * GHC HEAD . . . ``` - - - - - 83655b06 by Ben Gamari at 2019-10-24T08:45:41-04:00 hadrian: Warn user if hadrian build fails due to lack of threaded RTS See #16873. - - - - - 6824f29a by Ryan Scott at 2019-10-24T08:46:19-04:00 Parenthesize GADT return types in pprIfaceConDecl (#17384) We were using `pprIfaceAppArgs` instead of `pprParendIfaceAppArgs` in `pprIfaceConDecl`. Oops. Fixes #17384. - - - - - 9de3f8b1 by Ryan Scott at 2019-10-24T18:38:32-04:00 Make isTcLevPoly more conservative with newtypes (#17360) `isTcLevPoly` gives an approximate answer for when a type constructor is levity polymorphic when fully applied, where `True` means "possibly levity polymorphic" and `False` means "definitely not levity polymorphic". `isTcLevPoly` returned `False` for newtypes, which is incorrect in the presence of `UnliftedNewtypes`, leading to #17360. This patch tweaks `isTcLevPoly` to return `True` for newtypes instead. Fixes #17360. - - - - - 243c72eb by Ryan Scott at 2019-10-24T18:39:08-04:00 Mark promoted InfixT names as IsPromoted (#17394) We applied a similar fix for `ConT` in #15572 but forgot to apply the fix to `InfixT` as well. This patch fixes #17394 by doing just that. - - - - - 87175e78 by James Foster at 2019-10-25T09:01:08-04:00 Make Hadrian use -dynamic-too in the basic case This commit makes Hadrian use the `-dynamic-too` flag when the current Flavour's libraryWays contains both vanilla and dynamic, cutting down the amount of repeated work caused by separate compilation of dynamic and static files. It does this for the basic case where '.o' and '.dyn_o' files are built with one command, but does not generalise to cases like '.prof_o' and '.prof_dyn_o'. - - - - - ecd89062 by Alp Mestanogullari at 2019-10-25T09:01:47-04:00 hadrian/ci: run testsuite against a freshly produced and installed bindist - - - - - 2a16b555 by Ben Gamari at 2019-10-25T09:02:26-04:00 testsuite: Mark T13786 as fragile in unreg build Due to #17018. - - - - - 08298926 by Ben Gamari at 2019-10-25T09:02:26-04:00 testsuite: Use fragile modifier in TH_foreignInterruptible It looks like this use of `skip` snuck through my previous refactoring. - - - - - 4c7d45d1 by Brian Wignall at 2019-10-25T09:03:04-04:00 Make documentation for byteSwap16 consistent with byteSwap32 (impl is same, with s/16/32) - - - - - 02822d84 by Ben Gamari at 2019-10-25T09:03:40-04:00 aclocal: A bit of reformatting - - - - - 519f5162 by Ben Gamari at 2019-10-25T09:03:40-04:00 configure: Drop GccLT46 GCC 4.6 was released 7 years ago. I think we can finally assume that it's available. This is a simplification prompted by #15742. - - - - - acedfc8b by Ben Gamari at 2019-10-25T09:04:16-04:00 gitlab-ci: Run check-uniques during lint job - - - - - 8916e64e by Andrew Martin at 2019-10-26T05:19:38-04:00 Implement shrinkSmallMutableArray# and resizeSmallMutableArray#. This is a part of GHC Proposal #25: "Offer more array resizing primitives". Resources related to the proposal: - Discussion: https://github.com/ghc-proposals/ghc-proposals/pull/121 - Proposal: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0025-resize-boxed.rst Only shrinkSmallMutableArray# is implemented as a primop since a library-space implementation of resizeSmallMutableArray# (in GHC.Exts) is no less efficient than a primop would be. This may be replaced by a primop in the future if someone devises a strategy for growing arrays in-place. The library-space implementation always copies the array when growing it. This commit also tweaks the documentation of the deprecated sizeofMutableByteArray#, removing the mention of concurrency. That primop is unsound even in single-threaded applications. Additionally, the non-negativity assertion on the existing shrinkMutableByteArray# primop has been removed since this predicate is trivially always true. - - - - - 1be9c35c by Roland Senn at 2019-10-26T05:20:14-04:00 Fix #14690 - :steplocal panics after break-on-error `:steplocal` enables only breakpoints in the current top-level binding. When a normal breakpoint is hit, then the module name and the break id from the `BRK_FUN` byte code allow us to access the corresponding entry in a ModBreak table. From this entry we then get the SrcSpan (see compiler/main/InteractiveEval.hs:bindLocalsAtBreakpoint). With this source-span we can then determine the current top-level binding, needed for the steplocal command. However, if we break at an exception or at an error, we don't have an BRK_FUN byte-code, so we don't have any source information. The function `bindLocalsAtBreakpoint` creates an `UnhelpfulSpan`, which doesn't allow us to determine the current top-level binding. To avoid a `panic`, we have to check for `UnhelpfulSpan` in the function `ghc/GHCi/UI.hs:stepLocalCmd`. Hence a :steplocal command after a break-on-exception or a break-on-error is not possible. - - - - - 4820af10 by Adam Sandberg Eriksson at 2019-10-26T19:53:01-04:00 hadrian: point link to ghc gitlab [skip ci] - - - - - 609c7ee6 by Ben Gamari at 2019-10-26T19:53:36-04:00 gitlab-ci: Produce ARMv7 binary distributions - - - - - 8ac49411 by Ben Gamari at 2019-10-26T19:53:36-04:00 testsuite: Skip regalloc_unit_tests unless have_ncg This is a unit test for the native code generator's register allocator; naturally. the NCG is required. - - - - - 60575596 by Ben Gamari at 2019-10-26T19:53:36-04:00 Enable PDF documentation - - - - - 417f59d4 by Ben Gamari at 2019-10-26T19:53:36-04:00 rts: Fix ARM linker includes * Prefer #pragma once over guard macros * Drop redundant #includes * Fix order to ensure that necessary macros are defined when we condition on them - - - - - 4054f0e5 by Ömer Sinan Ağacan at 2019-10-26T19:54:16-04:00 Remove redundant -fno-cse options These were probably added with some GLOBAL_VARs, but those GLOBAL_VARs are now gone. - - - - - c62817f2 by Luke Lau at 2019-10-27T11:35:40-04:00 Fix RankNTypes :ghc-flag: in users guide This fixes a hadrian `build docs` failure - - - - - fc3a5205 by Luke Lau at 2019-10-27T11:35:40-04:00 Remove unused import - - - - - d2520bef by Luke Lau at 2019-10-27T11:35:40-04:00 Fix path to ghc-flags in users guide Hadrian rules It should point to the _build directory, not the source - - - - - 896d470a by Luke Lau at 2019-10-27T11:35:40-04:00 Add back documentation for deprecated -Whi-shadowing This was removed in b538476be3706264620c072e6e436debf9e0d3e4, but without it the compare-flags.py script fails. This adds it back and marks it as deprecated, with a notice that it is slated for removal. - - - - - 7d80f8b5 by Luke Lau at 2019-10-27T11:35:40-04:00 Remove documented flags from expected-undocumented-flags.txt - - - - - fa0d4809 by Ryan Scott at 2019-10-27T11:36:17-04:00 Parenthesize nullary constraint tuples using sigPrec (#17403) We were using `appPrec`, not `sigPrec`, as the precedence when determining whether or not to parenthesize `() :: Constraint`, which lead to the parentheses being omitted in function contexts like `(() :: Constraint) => String`. Easily fixed. Fixes #17403. - - - - - 90d06fd0 by Ben Gamari at 2019-10-27T17:27:17-04:00 hadrian: Silence output from Support SMP check Previously we would allow the output from the check of SMP support introduced by 83655b06e6d3e93b2d15bb0fa250fbb113d7fe68 leak to stdout. Silence this. See #16873. - - - - - 6635a3f6 by Josef Svenningsson at 2019-10-28T09:20:34-04:00 Fix #15344: use fail when desugaring applicative-do Applicative-do has a bug where it fails to use the monadic fail method when desugaring patternmatches which can fail. See #15344. This patch fixes that problem. It required more rewiring than I had expected. Applicative-do happens mostly in the renamer; that's where decisions about scheduling are made. This schedule is then carried through the typechecker and into the desugarer which performs the actual translation. Fixing this bug required sending information about the fail method from the renamer, through the type checker and into the desugarer. Previously, the desugarer didn't have enough information to actually desugar pattern matches correctly. As a side effect, we also fix #16628, where GHC wouldn't catch missing MonadFail instances with -XApplicativeDo. - - - - - cd9b9459 by Ryan Scott at 2019-10-28T09:21:13-04:00 Refactor TcDeriv to validity-check less in anyclass/via deriving (#13154) Due to the way `DerivEnv` is currently structured, there is an invariant that every derived instance must consist of a class applied to a non-empty list of argument types, where the last argument *must* be an application of a type constructor to some arguments. This works for many cases, but there are also some design patterns in standalone `anyclass`/`via` deriving that are made impossible due to enforcing this invariant, as documented in #13154. This fixes #13154 by refactoring `TcDeriv` and friends to perform fewer validity checks when using the `anyclass` or `via` strategies. The highlights are as followed: * Five fields of `DerivEnv` have been factored out into a new `DerivInstTys` data type. These fields only make sense for instances that satisfy the invariant mentioned above, so `DerivInstTys` is now only used in `stock` and `newtype` deriving, but not in other deriving strategies. * There is now a `Note [DerivEnv and DerivSpecMechanism]` describing the bullet point above in more detail, as well as explaining the exact requirements that each deriving strategy imposes. * I've refactored `mkEqnHelp`'s call graph to be slightly less complicated. Instead of the previous `mkDataTypeEqn`/`mkNewTypeEqn` dichotomy, there is now a single entrypoint `mk_eqn`. * Various bits of code were tweaked so as not to use fields that are specific to `DerivInstTys` so that they may be used by all deriving strategies, since not all deriving strategies use `DerivInstTys`. - - - - - e0e04856 by Alan Zimmerman at 2019-10-28T09:21:58-04:00 Attach API Annotations for {-# SOURCE #-} import pragma Attach the API annotations for the start and end locations of the {-# SOURCE #-} pragma in an ImportDecl. Closes #17388 - - - - - e951f219 by Sebastian Graf at 2019-10-28T09:22:35-04:00 Use FlexibleInstances for `Outputable (* p)` instead of match-all instances with equality constraints In #17304, Richard and Simon dicovered that using `-XFlexibleInstances` for `Outputable` instances of AST data types means users can provide orphan `Outputable` instances for passes other than `GhcPass`. Type inference doesn't currently to suffer, and Richard gave an example in #17304 that shows how rare a case would be where the slightly worse type inference would matter. So I went ahead with the refactoring, attempting to fix #17304. - - - - - ad1fe274 by Simon Peyton Jones at 2019-10-28T09:23:14-04:00 Better arity for join points A join point was getting too large an arity, leading to #17294. I've tightened up the invariant: see CoreSyn, Note [Invariants on join points], invariant 2b - - - - - fb4f245c by Takenobu Tani at 2019-10-29T03:45:02-04:00 users-guide: Fix :since: for -xn flag [skip ci] - - - - - 35abbfee by Takenobu Tani at 2019-10-29T03:45:41-04:00 users-guide: Add some new features and fix warnings for GHC 8.10 This updates the following: * Add description for ImportQualifiedPost extension * Add description for ghci command name resolution * Fix markdown warnings [skip ci] - - - - - 57dc1565 by Sylvain Henry at 2019-10-29T03:46:22-04:00 Use `not#` primitive to implement Word's complement - - - - - 28e52732 by Ben Gamari at 2019-10-29T03:46:59-04:00 linters: Add mode to lint given set of files This makes testing much easier. - - - - - db43b3b3 by Ben Gamari at 2019-10-29T03:46:59-04:00 linters: Add linter to catch unquoted use of $(TEST_HC) This is a common bug that creeps into Makefiles (e.g. see T12674). - - - - - ebee0d6b by Ben Gamari at 2019-10-29T03:46:59-04:00 testsuite: Fix quoting of $(TEST_HC) in T12674 I have no idea how this went unnoticed until now. - - - - - 3bd3456f by Ömer Sinan Ağacan at 2019-10-29T03:47:44-04:00 Refactor HscRecomp constructors: Make it evident in the constructors that the final interface is only available when HscStatus is not HscRecomp. (When HscStatus == HscRecomp we need to finish the compilation to get the final interface) `Maybe ModIface` return value of hscIncrementalCompile and the partial `expectIface` function are removed. - - - - - bbdd54aa by Ömer Sinan Ağacan at 2019-10-29T03:47:44-04:00 Return ModIface in compilation pipeline, remove IORef hack for generating ModIfaces The compilation phases now optionally return ModIface (for phases that generate an interface, currently only HscOut when (re)compiling a file). The value is then used by compileOne' to return the generated interface with HomeModInfo (which is then used by the batch mode compiler when building rest of the tree). hscIncrementalMode also returns a DynFlags with plugin info, to be used in the rest of the pipeline. Unfortunately this introduces a (perhaps less bad) hack in place of the previous IORef: we now record the DynFlags used to generate the partial infterface in HscRecomp and use the same DynFlags when generating the full interface. I spent almost three days trying to understand what's changing in DynFlags that causes a backpack test to fail, but I couldn't figure it out. There's a FIXME added next to the field so hopefully someone who understands this better than I do will fix it leter. - - - - - a56433a9 by Ömer Sinan Ağacan at 2019-10-29T03:47:44-04:00 Remove unused DynFlags arg of lookupIfaceByModule - - - - - dcd40c71 by Ömer Sinan Ağacan at 2019-10-29T03:47:44-04:00 HscMain: Move a comment closer to the relevant site - - - - - 593f6543 by Ömer Sinan Ağacan at 2019-10-29T03:47:44-04:00 MkIface: Remove redundant parameter and outdated comments from addFingerprints - - - - - f868e1fe by Ben Gamari at 2019-10-29T03:48:20-04:00 gitlab-ci: Use Hadrian for unregisterised job - - - - - 7b2ecbc0 by Ben Gamari at 2019-10-29T03:48:20-04:00 gitlab-ci: Factor out Linux Hadrian validation logic - - - - - 8e5de15d by Ben Gamari at 2019-10-29T03:48:20-04:00 hadrian: Define USE_LIBFFI_FOR_ADJUSTORS when necessary - - - - - 6a090270 by Ben Gamari at 2019-10-29T03:48:20-04:00 hadrian: Define NOSMP when building rts unregisterised It seems that NOSMP was previously only defined when compiling the compiler, not the RTS. Fix this. In addition do some spring-cleaning and make the logic match that of the Make build system. - - - - - b741d19d by Ben Gamari at 2019-10-29T03:48:20-04:00 hadrian: Shuffle around RTS build flags Some of these flags wanted to be passed to .cmm builds as well as C builds. - - - - - d7cedd9d by Ben Gamari at 2019-10-29T03:48:20-04:00 hadrian: Drop -Werror=unused-but-set-variable from GHC flags Previously `hadrian` would pass `-optc-Werror=unused-but-set-variable` to all GHC invocations. This was a difference from the make build system and cause the unregisterised build to fail as the C that GHC produces contains many unused functions. Drop it from the GHC flags. Note, however, that the flag is still present in `Settings.Builders.Common.cWarnings` and therefore will still be applied during compilation of C sources. - - - - - 7d3a15c7 by Ben Gamari at 2019-10-29T03:48:55-04:00 base: Fix open-file locking The OFD locking path introduced in 3b784d440d4b01b4c549df7c9a3ed2058edfc780 due to #13945 appears to have never actually worked but we never noticed due to an oversight in the autoconf check. Fix it. Thanks to Oleg Grenrus for noticing this. - - - - - 78b70e63 by Ben Gamari at 2019-10-29T03:48:55-04:00 base: Split up file locking implementation This makes the CPP significantly easier to follow. - - - - - 63977398 by Ben Gamari at 2019-10-29T03:49:31-04:00 Don't substitute GccVersion variable Not only is it now unused but we generally can't assume that we are compiling with GCC, so it really shouldn't be used. - - - - - 72f7ac9a by Ben Gamari at 2019-10-29T03:50:06-04:00 Revert "Replace freebsd-gnueabihf with freebsd" This reverts commit aa31ceaf7568802590f73a740ffbc8b800096342 as suggested in #17392. - - - - - 3c0372d6 by Ben Gamari at 2019-10-29T20:31:36-04:00 distrib: Fix binary distribution installation This had silently regressed due to 81860281 and the variable renaming performed in b55ee979, as noted in #17374. - - - - - a7f423ee by Ben Gamari at 2019-10-29T20:31:36-04:00 gitlab-ci: Use pxz to compress binary distributions - - - - - db602643 by Ben Gamari at 2019-10-29T20:31:36-04:00 Don't include settings file in binary distribution The configuration in the installation environment (as determined by `autoconf`) may differ from the build environment and therefore we need to be sure to rebuild the settings file. Fixes #17374. - - - - - 260e2379 by Ben Gamari at 2019-10-29T20:31:36-04:00 gitlab-ci: Fix binary distribution testing - - - - - 01ef3e1f by Ömer Sinan Ağacan at 2019-10-29T20:32:18-04:00 Interpreter: initialize arity fields of AP_NOUPDs AP_NOUPD entry code doesn't use the arity field, but not initializing this field confuses printers/debuggers, and also makes testing harder as the field's value changes randomly. - - - - - 93ff9197 by Ben Gamari at 2019-10-30T07:36:49-04:00 rts: More aarch64 header fixes - - - - - 3e7569bc by Vladislav Zavialov at 2019-10-30T07:36:50-04:00 Whitespace forward compatibility for proposal #229 GHC Proposal #229 changes the lexical rules of Haskell, which may require slight whitespace adjustments in certain cases. This patch changes formatting in a few places in GHC and its testsuite in a way that enables it to compile under the proposed rules. - - - - - 4898df1c by Ben Gamari at 2019-10-30T18:15:52-04:00 gitlab-ci: Fix the ARMv7 triple Previously we were configuring the ARMv7 builds with a host/target triple of arm-linux-gnueabihf, which caused us to target ARMv6 and consequently rely on the old CP15 memory barrier implementation. This barrier has to be emulated on ARMv8 machines which is glacially slow. Hopefully this should fix the ARMv7 builds which currently consistently time out. - - - - - 337e9b5a by Ömer Sinan Ağacan at 2019-10-31T19:01:54-04:00 Remove redundant 0s in ghc-heap pointer strings Before: 0x0000004200c86888 After: 0x42000224f8 This is more concise and consistent with the RTS's printer (which uses %p formatter, and at least on Linux gcc prints the short form) and gdb's pointer formatter. - - - - - 97b6f7a3 by Ben Gamari at 2019-10-31T19:02:32-04:00 base: Clamp IO operation size to 2GB on Darwin As reported in #17414, Darwin throws EINVAL in response to large writes. - - - - - a9743eb7 by Ben Gamari at 2019-10-31T19:02:32-04:00 testsuite: Add test for #17414 - - - - - 73d6e508 by Ben Gamari at 2019-10-31T19:03:10-04:00 base: Various haddock fixes Just a few things I found while looking at #17383. - - - - - dc487642 by taylorfausak at 2019-11-01T04:54:47-04:00 Implement `round` for `Ratio` that doesn't explode with `Natural`s - - - - - 3932fb97 by taylorfausak at 2019-11-01T04:54:47-04:00 Fix rounding around 0 - - - - - baf47ff8 by taylorfausak at 2019-11-01T04:54:47-04:00 Add tests for rounding ratios - - - - - 214d8122 by taylorfausak at 2019-11-01T04:54:47-04:00 Fix running of ratio test case - - - - - 70b62c97 by Ben Gamari at 2019-11-01T04:55:24-04:00 mmap: Factor out protection flags - - - - - c6759080 by Ben Gamari at 2019-11-01T04:55:24-04:00 rts: Make m32 allocator per-ObjectCode MacOS Catalina is finally going to force our hand in forbidden writable exeutable mappings. Unfortunately, this is quite incompatible with the current global m32 allocator, which mixes symbols from various objects in a single page. The problem here is that some of these symbols may not yet be resolved (e.g. had relocations performed) as this happens lazily (and therefore we can't yet make the section read-only and therefore executable). The easiest way around this is to simply create one m32 allocator per ObjectCode. This may slightly increase fragmentation for short-running programs but I suspect will actually improve fragmentation for programs doing lots of loading/unloading since we can always free all of the pages allocated to an object when it is unloaded (although this ability will only be implemented in a later patch). - - - - - 35c99e72 by Simon Peyton Jones at 2019-11-01T04:56:02-04:00 Makes Lint less chatty: I found in #17415 that Lint was printing out truly gigantic warnings, unmanageably huge, with repeated copies of the same thing. This patch makes Lint less chatty, especially for warnings: * For **warnings**, I don't print details of the location, unless you add `-dppr-debug`. * For **errors**, I still print all the info. They are fatal and stop exection, whereas warnings appear repeatedly. * I've made much less use of `AnExpr` in `LintLocInfo`; the expression can be gigantic. - - - - - d2471964 by Simon Peyton Jones at 2019-11-01T04:56:38-04:00 Add another test for #17267 This one came in a comment from James Payor - - - - - 1e2e82aa by Simon Peyton Jones at 2019-11-01T04:57:15-04:00 Fix a bad error in tcMatchTy This patch fixes #17395, a very subtle and hard-to-trigger bug in tcMatchTy. It's all explained in Note [Matching in the presence of casts (2)] I have not added a regression test because it is very hard to trigger it, until we have the upcoming mkAppTyM patch, after which lacking this patch means you can't even compile the libraries. - - - - - 51067194 by Ben Gamari at 2019-11-01T15:48:37-04:00 base: Ensure that failIO isn't SOURCE imported failIO has useful information in its demand signature (specifically that it bottoms) which is hidden if it is SOURCE imported, as noted in #16588. Rejigger things such that we don't SOURCE import it. Metric Increase: T13701 - - - - - c751082c by Ben Gamari at 2019-11-01T15:48:37-04:00 testsuite: Make ExplicitForAllRules1 more robust Previously the test relied on `id` not inlining. Fix this. - - - - - dab12c87 by Ben Gamari at 2019-11-01T15:48:37-04:00 Describe optimisation of demand analysis of noinline As described in #16588. - - - - - c9236384 by Adam Sandberg Eriksson at 2019-11-01T15:49:16-04:00 template-haskell: require at least 1 GADT constructor name (#17379) - - - - - a4ce26e0 by Ben Gamari at 2019-11-01T15:49:53-04:00 hadrian: Make runtest invocation consistency with Make Use True/False instead of 0/1. This shouldn't be a functional change but we should be consistent. - - - - - cabafe34 by Ben Gamari at 2019-11-01T15:50:29-04:00 testsuite: Add test for #17423 - - - - - 4a6d3d68 by Simon Peyton Jones at 2019-11-01T23:11:37-04:00 Make CSE delay inlining less CSE delays inlining a little bit, to avoid losing vital specialisations; see Note [Delay inlining after CSE] in CSE. But it was being over-enthusiastic. This patch makes the delay only apply to Ids with specialisation rules, which avoids unnecessary delay (#17409). - - - - - 01006bc7 by Niklas Hambüchen at 2019-11-01T23:12:17-04:00 doc: Fix backticks - - - - - 9980fb58 by Niklas Hambüchen at 2019-11-01T23:12:17-04:00 Add +RTS --disable-delayed-os-memory-return. Fixes #17411. Sets `MiscFlags.disableDelayedOsMemoryReturn`. See the added `Note [MADV_FREE and MADV_DONTNEED]` for details. - - - - - 182b1199 by Sebastian Graf at 2019-11-02T20:16:33-04:00 Separate `LPat` from `Pat` on the type-level Since the Trees That Grow effort started, we had `type LPat = Pat`. This is so that `SrcLoc`s would only be annotated in GHC's AST, which is the reason why all GHC passes use the extension constructor `XPat` to attach source locations. See #15495 for the design discussion behind that. But now suddenly there are `XPat`s everywhere! There are several functions which dont't cope with `XPat`s by either crashing (`hsPatType`) or simply returning incorrect results (`collectEvVarsPat`). This issue was raised in #17330. I also came up with a rather clean and type-safe solution to the problem: We define ```haskell type family XRec p (f :: * -> *) = r | r -> p f type instance XRec (GhcPass p) f = Located (f (GhcPass p)) type instance XRec TH f = f p type LPat p = XRec p Pat ``` This is a rather modular embedding of the old "ping-pong" style, while we only pay for the `Located` wrapper within GHC. No ping-ponging in a potential Template Haskell AST, for example. Yet, we miss no case where we should've handled a `SrcLoc`: `hsPatType` and `collectEvVarsPat` are not callable at an `LPat`. Also, this gets rid of one indirection in `Located` variants: Previously, we'd have to go through `XPat` and `Located` to get from `LPat` to the wrapped `Pat`. Now it's just `Located` again. Thus we fix #17330. - - - - - 3c916162 by Richard Eisenberg at 2019-11-02T20:17:13-04:00 Update Note references -- comments only Follow-on from !2041. - - - - - 3b65655c by Ben Gamari at 2019-11-04T03:40:31-05:00 SysTools: Only apply Windows-specific workaround on Windows Issue #1110 was apparently due to a bug in Vista which prevented GCC from finding its binaries unless we explicitly added it to PATH. However, this workaround was incorrectly applied on non-Windows platforms as well, resulting in ill-formed PATHs (#17266). Fixes #17266. - - - - - 5d4f16ee by Leif Metcalf at 2019-11-04T03:41:09-05:00 Rephrase note on full-laziness - - - - - 120f2e53 by Ben Gamari at 2019-11-04T03:41:44-05:00 rts/linker: Ensure that code isn't writable For many years the linker would simply map all of its memory with PROT_READ|PROT_WRITE|PROT_EXEC. However operating systems have been becoming increasingly reluctant to accept this practice (e.g. #17353 and #12657) and for good reason: writable code is ripe for exploitation. Consequently mmapForLinker now maps its memory with PROT_READ|PROT_WRITE. After the linker has finished filling/relocating the mapping it must then call mmapForLinkerMarkExecutable on the sections of the mapping which contain executable code. Moreover, to make all of this possible it was necessary to redesign the m32 allocator. First, we gave (in an earlier commit) each ObjectCode its own m32_allocator. This was necessary since code loading and symbol resolution/relocation are currently interleaved, meaning that it is not possible to enforce W^X when symbols from different objects reside in the same page. We then redesigned the m32 allocator to take advantage of the fact that all of the pages allocated with the allocator die at the same time (namely, when the owning ObjectCode is unloaded). This makes a number of things simpler (e.g. no more page reference counting; the interface provided by the allocator for freeing is simpler). See Note [M32 Allocator] for details. - - - - - 7c28087a by Takenobu Tani at 2019-11-05T02:45:31-05:00 users-guide: Improve documentaion of CPP extension Currently, the description of CPP extension is given in the section of command-line options. Therefore, it is a little difficult to understand that it is a language extension. This commit explicitly adds a description for it. [skip ci] - - - - - d57059f7 by Ben Gamari at 2019-11-05T02:46:10-05:00 rts: Add missing const in HEAP_ALLOCED_GC This was previously unnoticed as this code-path is hit on very few platforms (e.g. OpenBSD). - - - - - 487ede42 by Peter Trommler at 2019-11-05T02:46:48-05:00 testsuite: skip test requiring RTS linker on PowerPC The RTS linker is not available on 64-bit PowerPC. Instead of marking tests that require the RTS linker as broken on PowerPC 64-bit skip the respective tests on all platforms where the RTS linker or a statically linked external interpreter is not available. Fixes #11259 - - - - - 1593debf by Sebastian Graf at 2019-11-05T11:38:30-05:00 Check EmptyCase by simply adding a non-void constraint We can handle non-void constraints since !1733, so we can now express the strictness of `-XEmptyCase` just by adding a non-void constraint to the initial Uncovered set. For `case x of {}` we thus check that the Uncovered set `{ x | x /~ ⊥ }` is non-empty. This is conceptually simpler than the plan outlined in #17376, because it talks to the oracle directly. In order for this patch to pass the testsuite, I had to fix handling of newtypes in the pattern-match checker (#17248). Since we use a different code path (well, the main code path) for `-XEmptyCase` now, we apparently also handle #13717 correctly. There's also some dead code that we can get rid off now. `provideEvidence` has been updated to provide output more in line with the old logic, which used `inhabitationCandidates` under the hood. A consequence of the shift away from the `UncoveredPatterns` type is that we don't report reduced type families for empty case matches, because the pretty printer is pure and only knows the match variable's type. Fixes #13717, #17248, #17386 - - - - - e6ffe148 by Ömer Sinan Ağacan at 2019-11-05T11:39:13-05:00 TidyPgm: replace an explicit loop with mapAccumL - - - - - b7460492 by Ömer Sinan Ağacan at 2019-11-05T11:39:13-05:00 CoreTidy: hide tidyRule - - - - - f9978f53 by Stefan Schulze Frielinghaus at 2019-11-05T11:39:51-05:00 Hadrian: enable interpreter for s390x - - - - - 3ce18700 by Ben Gamari at 2019-11-06T08:05:57-05:00 rts: Drop redundant flags for libffi These are now handled in the cabal file's include-dirs field. - - - - - ce9e2a1a by Ben Gamari at 2019-11-06T08:05:57-05:00 configure: Add --with-libdw-{includes,libraries} flags Fixing #17255. - - - - - 97f9674b by Takenobu Tani at 2019-11-06T08:06:37-05:00 configure: Add checking python3-sphinx This checks the configuration about python3-sphinx. We need python3-sphinx instead of python2-sphinx to build documentation. The approach is as follows: * Check python3 version with custom `conf.py` invoked from sphinx-build` executable * Place custom `conf.py` into new `utils/check-sphinx` directory If sphinx is for python2 not python3, it's treated as config ERROR instead of WARN. See also #17346 and #17356. - - - - - b4fb2328 by Dan Brooks at 2019-11-06T08:07:15-05:00 Adding examples to Semigroup/monoid - - - - - 708c60aa by Ryan Scott at 2019-11-07T08:39:36-05:00 Clean up TH's treatment of unary tuples (or, #16881 part two) !1906 left some loose ends in regards to Template Haskell's treatment of unary tuples. This patch ends to tie up those loose ends: * In addition to having `TupleT 1` produce unary tuples, `TupE [exp]` and `TupP [pat]` also now produce unary tuples. * I have added various special cases in GHC's pretty-printers to ensure that explicit 1-tuples are printed using the `Unit` type. See `testsuite/tests/th/T17380`. * The GHC 8.10.1 release notes entry has been tidied up a little. Fixes #16881. Fixes #17371. Fixes #17380. - - - - - a424229d by Stefan Schulze Frielinghaus at 2019-11-07T08:40:13-05:00 For s390x issue a warning if LLVM 9 or older is used For s390x the GHC calling convention is only supported since LLVM version 10. Issue a warning in case an older version of LLVM is used. - - - - - 55bc3787 by Ben Gamari at 2019-11-07T08:40:50-05:00 FlagChecker: Add ticky flags to hashed flags These affect output and therefore should be part of the flag hash. - - - - - fa0b1b4b by Stefan Schulze Frielinghaus at 2019-11-07T08:41:33-05:00 Bump libffi-tarballs submodule - - - - - a9566632 by Takenobu Tani at 2019-11-07T08:42:15-05:00 configure: Modify ERROR to WARN for sphinx's python check If sphinx's python version check failed, many people prefer to build without documents instead of stopping on the error. So this commit fixes the following: * Modify AC_MSG_ERROR to AC_MSG_WARN * Add clearing of SPHINXBUILD variable when check fails See also !2016. - - - - - d0ef8312 by Alp Mestanogullari at 2019-11-07T21:24:59-05:00 hadrian: fix support for the recording of perf test results Before this patch, Hadrian didn't care about the TEST_ENV and METRICS_FILE environment variables, that the performance testing infrastructure uses to record perf tests results from CI jobs. It now looks them up right before running the testsuite driver, and passes suitable --test-env/--metrics-file arguments when these environment variables are set. - - - - - 601e554c by Ben Gamari at 2019-11-07T21:25:36-05:00 Bump the process submodule This should fix the #17108 and #17249 with the fix from https://github.com/haskell/process/pull/159. - - - - - 6b7d7e1c by Ben Gamari at 2019-11-07T21:25:36-05:00 Bump hsc2hs submodule - - - - - b1c158c9 by Ben Gamari at 2019-11-07T21:25:36-05:00 rts: Fix m32 allocator build on Windows An inconsistency in the name of m32_allocator_flush caused the build to fail with a missing prototype error. - - - - - ae431cf4 by Ben Gamari at 2019-11-07T21:25:36-05:00 rts: Ensure that Rts.h is always included first In general this is the convention that we use in the RTS. On Windows things actually fail if we break it. For instance, you see things like: includes\stg\Types.h:26:9: error: warning: #warning "Mismatch between __USE_MINGW_ANSI_STDIO definitions. If using Rts.h make sure it is the first header included." [-Wcpp] - - - - - 0d141d28 by Ben Gamari at 2019-11-07T21:25:36-05:00 rts: Remove undesireable inline specifier I have no idea why I marked this as inline originally but clearly it shouldn't be inlined. - - - - - 870376f9 by Ben Gamari at 2019-11-07T21:25:36-05:00 base: Add missing imports in Windows locking implementation - - - - - 23994738 by Ben Gamari at 2019-11-07T21:25:36-05:00 rts/NonMoving: Fix various Windows build issues The Windows build seems to be stricter about not providing threading primitives in the non-threaded RTS. - - - - - a3ce52fd by Ben Gamari at 2019-11-07T21:25:36-05:00 users_guide: Set flags list file encoding Otherwise this fails on Windows. - - - - - 9db2e905 by Stefan Schulze Frielinghaus at 2019-11-08T05:36:54-05:00 Testsuite: Introduce req_rts_linker Some tests depend on the RTS linker. Introduce a modifier to skip such tests, in case the RTS linker is not available. - - - - - a4631335 by Szymon Nowicki-Korgol at 2019-11-08T05:37:34-05:00 Set correct length of DWARF .debug_aranges section (fixes #17428) - - - - - 3db2ab30 by Ben Gamari at 2019-11-08T05:38:11-05:00 hadrian: Add enableTickyGhc helper This took a bit of trial-and-error to get working so it seems worth having in the tree. - - - - - 5c87ebd7 by Ben Gamari at 2019-11-08T12:09:22-05:00 SetLevels: Don't set context level when floating cases When floating a single-alternative case we previously would set the context level to the level where we were floating the case. However, this is wrong as we are only moving the case and its binders. This resulted in #16978, where the disrepancy caused us to unnecessarily abstract over some free variables of the case body, resulting in shadowing and consequently Core Lint failures. (cherry picked from commit a2a0e6f3bb2d02a9347dec4c7c4f6d4480bc2421) - - - - - 43623b09 by Ben Gamari at 2019-11-08T12:10:01-05:00 testsuite: Run tests in nonmoving_thr in speed==slow - - - - - 6e4656cc by Ben Gamari at 2019-11-08T12:10:01-05:00 rts/nonmoving: Catch failure of createOSThread - - - - - 2e4fc04b by Ben Gamari at 2019-11-08T12:10:01-05:00 Bump unix submodule Marks executeFile001 as broken in all concurrent ways. - - - - - 8a10f9fb by Ben Gamari at 2019-11-09T18:03:01-05:00 template-haskell: Document assembler foreign file support See #16180. - - - - - 5ad3cb53 by Ben Gamari at 2019-11-09T18:03:01-05:00 template-haskell: Fix TBAs in changelog - - - - - 4a75a832 by Ben Gamari at 2019-11-09T18:03:01-05:00 base: Fix TBA in changelog - - - - - d7de0d81 by Ryan Scott at 2019-11-09T18:03:02-05:00 template-haskell: Fix italics in changelog [ci-skip] - - - - - 0fb246c3 by Ben Gamari at 2019-11-09T18:03:37-05:00 testsuite: Fix Windows cleanup path This was a regression introduced with the Path refactoring. - - - - - 925fbdbb by Ben Gamari at 2019-11-09T18:03:37-05:00 testsuite: Skip T16916 on Windows The event manager is not supported on Windows. - - - - - 7c2ce0a0 by Ben Gamari at 2019-11-09T18:03:38-05:00 testsuite: Skip T14931 on Windows This test uses -dynamic-too, which is not supported on Windows. - - - - - 7c63edb4 by Ben Gamari at 2019-11-09T18:03:38-05:00 gitlab-ci: Don't allow Windows make job to fail While linking is still slow (#16084) all of the correctness issues which were preventing us from being able to enforce testsuite-green on Windows are now resolved. - - - - - a50ecda6 by Ben Gamari at 2019-11-09T18:03:38-05:00 testsuite: Fix header #include order on Windows <Rts.h> must always come first. - - - - - dcb23ec9 by Ben Gamari at 2019-11-09T18:03:38-05:00 testsuite: Mark T13676 as broken on Darwin and Windows Due to #17447. - - - - - 411ba7ba by Ben Gamari at 2019-11-09T18:03:38-05:00 testsuite: Mark T11627b as fragile It was previously marked as broken due to #12236 however it passes for me locally while failing on CI. - - - - - c1f1f3f9 by Ben Gamari at 2019-11-09T18:03:38-05:00 testsuite: Mark T16219 as unbroken This was previously broken due to #16386 yet it passes for me locally. - - - - - 1f871e70 by Ben Gamari at 2019-11-09T18:03:38-05:00 testsuite: Remove redundant cleaning logic from T16511 The GHCi script for T16511 had some `rm` commands to clean up output from previous runs. This should be harmless since stderr was redirected to /dev/null; however, it seems that this redirection doesn't work on Windows (perhaps because GHCi uses `cmd` to execute the command-line; I'm not sure). I tried to fix it but was unable to find a sensible solution. Regardless, the cleaning logic is quite redundant now that we run each test in a hermetic environment. Let's just remove it. - - - - - 4d523cb1 by Ben Gamari at 2019-11-09T18:03:38-05:00 testsuite: Mark T17414 as fragile on Windows This consistently times out on Windows as described in #17453. I have tried increasing the timeout multiplier to two yet it stills fails. Disabling until we have time to investigate. - - - - - f73fbd2d by Ben Gamari at 2019-11-09T18:03:38-05:00 testsuite: Ignore stderr in PartialDownsweep As described in #17449, PartialDownsweep is currently fragile due to its dependence on the error messages produced by the C preprocessor. To eliminate this dependence we simply ignore stderr output, instead relying on the fact that the test will exit with a non-zero exit code on failure. Fixes #17449. - - - - - a9b14790 by Ben Gamari at 2019-11-09T18:03:38-05:00 testsuite: Fix putStrLn in saks028 Bizarrely, `saks028` previously failed reliably, but only on Windows (#17450). The test would exit with a zero exit code but simply didn't emit the expected text to stderr. I believe this was due to the fact that the test used `putStrLn`, resulting in the output ending up on stdout. This worked on other platforms since (apparently) we redirect stdout to stderr when evaluating splices. However, on Windows it seems that the redirected output wasn't flushed as it was on other platforms. Anyways, it seems like the right thing to do here is to be explicit about our desire for the output to end up on stderr. Closes #17450. - - - - - b62ca659 by Ben Gamari at 2019-11-09T18:03:38-05:00 testsuite: Drop T7995 This test is quite sensitive to the build configuration as it requires that ghc have unfoldings, which isn't true in the quick build flavours. I considered various options to make the test more robust but none of them seemed particularly appealing. Moreover, Simon PJ was a bit skeptical of the value of the test to begin with and I strongly suspect that any regression in #7995 would be accompanied by failures in our other compiler performance tests. Closes #17399. - - - - - 011f3121 by Ben Gamari at 2019-11-09T18:03:38-05:00 testsuite: Mark T16219 as fragile on Windows As noted in #17452, this test produces very long file paths which exceed the Windows MAX_PATH limitation. Mark the test as fragile for not until we can come up with a better solution. - - - - - 1f98e47d by Simon Peyton Jones at 2019-11-09T18:04:14-05:00 Use the right type in :force A missing prime meant that we were considering the wrong type in the GHCi debugger, when doing :force on multiple arguments (issue #17431). The fix is trivial. - - - - - 1f911de4 by Brian Wignall at 2019-11-09T18:04:57-05:00 Add IsList instance for ZipList (closes #17433) - - - - - e3672f40 by Brian Wignall at 2019-11-09T18:04:57-05:00 Incorporate MR review suggestions; add change in changelog - - - - - 3957bdf2 by Brian Wignall at 2019-11-09T18:04:57-05:00 Fix incorrect plurals - - - - - 6f4c1250 by Alina Banerjee at 2019-11-10T01:06:12-05:00 Improve SPECIALIZE pragma error messages (Fixes #12126) - - - - - fa25c8c4 by Richard Eisenberg at 2019-11-10T01:06:48-05:00 Update release notes about #16512 / #17405. - - - - - 55ca1085 by Richard Eisenberg at 2019-11-10T01:06:48-05:00 Fix #17405 by not checking imported equations Previously, we checked all imported type family equations for injectivity. This is very silly. Now, we check only for conflicts. Before I could even imagine doing the fix, I needed to untangle several functions that were (in my opinion) overly complicated. It's still not quite as perfect as I'd like, but it's good enough for now. Test case: typecheck/should_compile/T17405 - - - - - a9467f4f by Ben Gamari at 2019-11-10T21:06:33-05:00 testsuite: Mark tests fragile in threaded2 as fragile in all concurrent ways - - - - - 3e07ea8d by Ben Gamari at 2019-11-10T21:10:30-05:00 testsuite: Use small allocation area when measuring residency As suggested in #17387; this helps reduce the variance in our residency sampling. Metric Increase: T10370 T3586 lazy-bs-alloc Metric Decrease 'compile_time/peak_megabytes_allocated': T1969 Metric Decrease 'runtime/bytes allocated': space_leak_001 Metric Increase 'compile_time/bytes allocated': T1969 Metric Increase 'runtime/peak_megabytes_allocated': space_leak_001 Metric Decrease: T3064 T9675 - - - - - 049d9ae0 by Ben Gamari at 2019-11-10T21:10:30-05:00 testsuite: Don't check_stats at runtime if not requested Previously we would call check_stats to check the runtime metrics even if the test definition hadn't requested it. This would result in an error since the .stats file doesn't exist. - - - - - 64433428 by Alp Mestanogullari at 2019-11-11T08:49:01-05:00 hadrian: export METRICS_FILE to make it accessible to perf notes script This addresses #17456 and also fixes the --metrics-file argument that Hadrian passes to the testsuite driver. - - - - - 06640394 by Ben Gamari at 2019-11-11T08:50:45-05:00 testsuite: Disable T4334 in nonmoving_thr way - - - - - f8ec32d7 by Alp Mestanogullari at 2019-11-11T11:36:44-05:00 ci: push perf test metrics even when the testsuite doesn't pass The corresponding commit might introduce a regression on a perf test, in which case we certainly want to record it. The testsuite might also fail because of a test unrelated to performance, in which case we want to record that the perf test results were good. Either way, we likely want to record them under all circumstances but we don't without this patch. Metric Decrease: T3586 Metric Increase: lazy-bs-alloc - - - - - 643d42fc by Alp Mestanogullari at 2019-11-12T18:40:19-05:00 testsuite: don't collect compiler stats in collect_runtime_residency We instead want to collect the runtime stats (with collect_stats, instead of collect_compiler_stats). This should fix a number of perf tests failures we have been seeing, where we suddenly started measuring metrics we didn't intend to measure, which tend to fall outside of the acceptance window. Metric Decrease: lazy-bs-alloc T3586 Metric Increase: space_leak_001 T4801 T5835 T12791 - - - - - 535d0edc by Ömer Sinan Ağacan at 2019-11-13T07:06:12-05:00 Document CmmTopInfo type [ci skip] - - - - - 2d4f9ad8 by Ben Gamari at 2019-11-13T07:06:49-05:00 Ensure that coreView/tcView are able to inline Previously an import cycle between Type and TyCoRep meant that several functions in TyCoRep ended up SOURCE import coreView. This is quite unfortunate as coreView is intended to be fused into a larger pattern match and not incur an extra call. Fix this with a bit of restructuring: * Move the functions in `TyCoRep` which depend upon things in `Type` into `Type` * Fold contents of `Kind` into `Type` and turn `Kind` into a simple wrapper re-exporting kind-ish things from `Type` * Clean up the redundant imports that popped up as a result Closes #17441. Metric Decrease: T4334 - - - - - b795637f by Alp Mestanogullari at 2019-11-13T07:07:28-05:00 hadrian: fix Windows CI script By only using 'export' from within bash commands. - - - - - 6885e22c by Ben Gamari at 2019-11-13T07:08:03-05:00 testsuite: Add test for #17458 As noted in #17458, QuantifiedConstraints and UndecideableInstances could previously be used to write programs which can loop at runtime. This was fixed in !1870. - - - - - b4b19d89 by Ben Gamari at 2019-11-13T07:08:03-05:00 users guide: Fix broken link - - - - - 9a939a6c by Ryan Scott at 2019-11-13T07:08:40-05:00 Print name prefixly in the Outputable instance for StandaloneKindSig Issue #17461 was occurring because the `Outputable` instance for standalone kind signatures was simply calling `ppr` on the name in the kind signature, which does not add parentheses to infix names. The solution is simple: use `pprPrefixOcc` instead. Fixes #17461. - - - - - a06cfb59 by Ömer Sinan Ağacan at 2019-11-13T07:09:18-05:00 Only pass mod_location with HscRecomp instead of the entire ModSummary HscRecomp users only need the ModLocation of the module being compiled, so only pass that to users instead of the entire ModSummary Metric Decrease: T4801 - - - - - dd49b3f0 by Ben Gamari at 2019-11-13T17:01:21-05:00 Bump Haskeline and add exceptions as boot library Haskeline now depends upon exceptions. See #16752. - - - - - b06b1858 by Ben Gamari at 2019-11-14T11:30:20-05:00 base: Bump version to 4.14.0.0 Metric Increase: T4801 - - - - - 6ab80439 by Ben Gamari at 2019-11-14T23:05:30-05:00 gitlab-ci: Allow Windows to fail again - - - - - 46afc380 by Ben Gamari at 2019-11-15T09:45:36-05:00 gitlab-ci: Install process to global pkgdb before starting build This is an attempt to mitigate #17480 by ensuring that a functional version of the process library is available before attempting the build. - - - - - 8c5cb806 by Ben Gamari at 2019-11-15T10:45:55-05:00 Bump supported LLVM version to 9.0 - - - - - 8e5851f0 by Ben Gamari at 2019-11-15T10:45:55-05:00 llvm-targets: Update with Clang 9 - - - - - f3ffec27 by Ben Gamari at 2019-11-15T11:54:26-05:00 testsuite: Increase acceptance window of T4801 This statistic is rather unstable. Hopefully fixes #17475. - - - - - c2991f16 by Ben Gamari at 2019-11-15T11:56:10-05:00 users-guide: Drop 8.6.1 release notes - - - - - e8da1354 by Ben Gamari at 2019-11-17T06:48:16-05:00 gitlab-ci: Fix submodule linter We ran it against the .git directory despite the fact that the linter wants to be run against the repository. - - - - - 13290f91 by Ben Gamari at 2019-11-17T06:48:16-05:00 Bump version to 8.10.0 Bumps haddock submodule. - - - - - fa98f823 by Ben Gamari at 2019-11-17T06:48:16-05:00 testsuite: Don't collect residency for T4801 I previously increased the size of the acceptance window from 2% to 5% but this still isn't enough. Regardless, measuring bytes allocated should be sufficient to catch any regressions. - - - - - 002b2842 by Ivan Kasatenko at 2019-11-17T06:49:22-05:00 Make test 16916 more stable across runs - - - - - ca89dd3b by Ben Gamari at 2019-11-17T06:58:17-05:00 users-guide: Address #17329 Adopts the language suggested by @JakobBruenker. - - - - - 2f5ed225 by Ben Gamari at 2019-11-17T07:16:32-05:00 exceptions: Bump submodule back to master The previous commit hasn't made it to master yet. - - - - - 34515e7c by nineonine at 2019-11-17T13:33:22-08:00 Fix random typos [skip ci] - - - - - 4a37a29b by Mario Blažević at 2019-11-17T17:26:24-05:00 Fixed issue #17435, missing Data instances - - - - - 97f1bcae by Andreas Klebinger at 2019-11-17T17:26:24-05:00 Turn some comments into GHC.Hs.Utils into haddocks - - - - - cf7f8e5b by Ben Gamari at 2019-11-17T17:26:26-05:00 testsuite: Skip T17414 on Linux It is typical for $TMP to be a small tmpfson Linux. This test will fail in such cases since we must create a file larger than the filesystem. See #17459. - - - - - 88013b78 by nineonine at 2019-11-19T11:53:16-05:00 Optimize MonadUnique instances based on IO (#16843) Metric Decrease: T14683 - - - - - a8adb5b4 by Ben Gamari at 2019-11-19T11:53:55-05:00 desugar: Drop stale Note [Matching seqId] The need for this note vanished in eae703aa60f41fd232be5478e196b661839ec3de. - - - - - 08d595c0 by Ben Gamari at 2019-11-19T11:53:55-05:00 Give seq a more precise type and remove magic `GHC.Prim.seq` previously had the rather plain type: seq :: forall a b. a -> b -> b However, it also had a special typing rule to applications where `b` is not of kind `Type`. Issue #17440 noted that levity polymorphism allows us to rather give it the more precise type: seq :: forall (r :: RuntimeRep) a (b :: TYPE r). a -> b -> b This allows us to remove the special typing rule that we previously required to allow applications on unlifted arguments. T9404 contains a non-Type application of `seq` which should verify that this works as expected. Closes #17440. - - - - - ec8a463d by Viktor Dukhovni at 2019-11-19T11:54:45-05:00 Enable USE_PTHREAD_FOR_ITIMER also on FreeBSD If using a pthread instead of a timer signal is more reliable, and has no known drawbacks, then FreeBSD is also capable of supporting this mode of operation (tested on FreeBSD 12 with GHC 8.8.1, but no reason why it would not also work on FreeBSD 11 or GHC 8.6). Proposed by Kevin Zhang in: https://bugs.freebsd.org/bugzilla/show_bug.cgi?id=241849 - - - - - cd40e12a by Ömer Sinan Ağacan at 2019-11-19T11:55:36-05:00 Packages.hs: use O(n*log(n)) ordNub instead of O(n*n) nub As reported in #8173 in some environments package lists can get quite long, so we use more efficient ordNub instead of nub on package lists. - - - - - 2b27cc16 by Ben Gamari at 2019-11-19T11:56:21-05:00 Properly account for libdw paths in make build system Should finally fix #17255. - - - - - 0418c38d by Ben Gamari at 2019-11-19T11:56:58-05:00 rts: Add missing include of SymbolExtras.h This broke the Windows build. - - - - - c819c0e4 by Ben Gamari at 2019-11-19T11:57:36-05:00 nonmoving: Use correct info table pointer accessor Previously we used INFO_PTR_TO_STRUCT instead of THUNK_INFO_PTR_TO_STRUCT when looking at a thunk. These two happen to be equivalent on 64-bit architectures due to alignment considerations however they are different on 32-bit platforms. This lead to #17487. To fix this we also employ a small optimization: there is only one thunk of type WHITEHOLE (namely stg_WHITEHOLE_info). Consequently, we can just use a plain pointer comparison instead of testing against info->type. - - - - - deed8e31 by Ben Gamari at 2019-11-19T11:57:36-05:00 nonmoving: Fix incorrect masking in mark queue type test We were using TAG_BITS instead of TAG_MASK. This happened to work on 64-bit platforms where TAG_BITS==3 since we only use tag values 0 and 3. However, this broken on 32-bit platforms where TAG_BITS==2. - - - - - 097f8072 by Ben Gamari at 2019-11-19T11:57:36-05:00 nonmoving: Rework mark queue representation The previous representation needlessly limited the array length to 16-bits on 32-bit platforms. - - - - - eb7b233a by Ben Gamari at 2019-11-19T11:57:36-05:00 nonmoving: Fix handling on large object marking on 32-bit Previously we would reset the pointer pointing to the object to be marked to the beginning of the block when marking a large object. This did no harm on 64-bit but on 32-bit it broke, e.g. `arr020`, since we align pinned ByteArray allocations such that the payload is 8 byte-aligned. This means that the object might not begin at the beginning of the block., - - - - - a7571a74 by Ben Gamari at 2019-11-19T11:57:36-05:00 testsuite: Increase width of stack003 test Previously the returned tuple seemed to fit in registers on amd64. This meant that non-moving collector bug would cause the test to fail on i386 yet not amd64. - - - - - 098d5017 by Ben Gamari at 2019-11-19T11:57:36-05:00 nonmoving: Drop redundant write barrier on stack underflow Previously we would push stack-carried return values to the new stack on a stack overflow. While the precise reasoning for this barrier is unfortunately lost to history, in hindsight I suspect it was prompted by a missing barrier elsewhere (that has been since fixed). Moreover, there the redundant barrier is actively harmful: the stack may contain non-pointer values; blindly pushing these to the mark queue will result in a crash. This is precisely what happened in the `stack003` test. However, because of a (now fixed) deficiency in the test this crash did not trigger on amd64. - - - - - 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) - - - - - c4f820a8 by Ben Gamari at 2020-03-26T11:22:59-04:00 typecheck: Check for non-sensical mkCoherence*Co applications The mkCoherenceLeftCo and mkCoherenceRightCo helpers expect a precondition on their arguments. Namely, in the case of mkCoherenceLeftCo r ty1 co co2 it holds that co2 :: ty1 ~r ty2 Check this. - - - - - 2ec74231 by Ben Gamari at 2020-03-26T11:22:59-04:00 Assert that Vars are of expected type in toIface{Ty,Co}Var - - - - - 227bec20 by Ben Gamari at 2020-03-26T11:28:23-04:00 Coercion zapping - - - - - e19bcc51 by Ben Gamari at 2020-03-26T16:36:37-04:00 Fix it - - - - - 26 changed files: - .ghcid - .gitignore - .gitlab-ci.yml - + .gitlab/ci.sh - − .gitlab/darwin-init.sh - − .gitlab/fix-submodules.py - .gitlab/issue_templates/bug.md - + .gitlab/issue_templates/documentation_issue.md - .gitlab/issue_templates/feature_request.md - + .gitlab/linters/check-changelogs.sh - .gitlab/linters/check-cpp.py - .gitlab/linters/check-makefiles.py - .gitlab/linters/linter.py - .gitlab/merge_request_templates/merge-request.md - − .gitlab/prepare-system.sh - − .gitlab/push-test-metrics.sh - .gitlab/start-head.hackage.sh - + .gitlab/test-metrics.sh - − .gitlab/win32-init.sh - .gitmodules - .mailmap - CODEOWNERS - HACKING.md - aclocal.m4 - boot - − build.nix.sh The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/75cb667c434a2b59a237c6d95877cc0eeb81b258...e19bcc513d66ac1e246a0b47bf5aea2cf6f20723 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/75cb667c434a2b59a237c6d95877cc0eeb81b258...e19bcc513d66ac1e246a0b47bf5aea2cf6f20723 You're receiving 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 Mar 27 15:21:40 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 27 Mar 2020 11:21:40 -0400 Subject: [Git][ghc/ghc][wip/zap-coercions] Coercion zapping Message-ID: <5e7e1a0495ab3_616713339fc499895@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/zap-coercions at Glasgow Haskell Compiler / GHC Commits: 81578d45 by Ben Gamari at 2020-03-27T11:21:28-04:00 Coercion zapping - - - - - 27 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/Type.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Env.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/basicTypes/IdInfo.hs - compiler/basicTypes/IdInfo.hs-boot - compiler/basicTypes/Var.hs - compiler/basicTypes/VarSet.hs - compiler/typecheck/TcFlatten.hs - compiler/typecheck/TcMType.hs - compiler/typecheck/TcTyDecls.hs - testsuite/tests/profiling/should_run/T2552.prof.sample Changes: ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -41,6 +41,9 @@ module GHC.Core.Coercion ( downgradeRole, mkAxiomRuleCo, mkGReflRightCo, mkGReflLeftCo, mkCoherenceLeftCo, mkCoherenceRightCo, mkKindCo, castCoercionKind, castCoercionKindI, + -- + -- ** Zapping coercions + mkZappedCoercion, zapCoercion, mkHeteroCoercionType, mkPrimEqPred, mkReprPrimEqPred, mkPrimEqPredRole, @@ -136,9 +139,10 @@ import Var import VarEnv import VarSet import Name hiding ( varName ) -import Util +import Util hiding ( seqList ) import BasicTypes import Outputable +import GHC.Driver.Session ( DynFlags, shouldBuildCoercions ) import Unique import Pair import SrcLoc @@ -963,6 +967,9 @@ mkSymCo :: Coercion -> Coercion mkSymCo co | isReflCo co = co mkSymCo (SymCo co) = co mkSymCo (SubCo (SymCo co)) = SubCo co +mkSymCo (UnivCo (ZappedProv fvs) r t1 t2) = UnivCo (ZappedProv fvs) r t2 t1 +mkSymCo (UnivCo (TcZappedProv fvs coholes) r t1 t2) = UnivCo (TcZappedProv fvs coholes) r t2 t1 +-- TODO: Handle other provenances mkSymCo co = SymCo co -- | Create a new 'Coercion' by composing the two given 'Coercion's transitively. @@ -972,6 +979,14 @@ mkTransCo co1 co2 | isReflCo co1 = co2 | isReflCo co2 = co1 mkTransCo (GRefl r t1 (MCo co1)) (GRefl _ _ (MCo co2)) = GRefl r t1 (MCo $ mkTransCo co1 co2) +mkTransCo (UnivCo (ZappedProv fvs1) r t1a _t1b) (UnivCo (ZappedProv fvs2) _ _t2a t2b) + = UnivCo (ZappedProv (fvs1 `unionDVarSet` fvs2)) r t1a t2b +mkTransCo (UnivCo (ZappedProv fvs) r t1a _t1b) co2 + = UnivCo (ZappedProv (fvs `unionDVarSet` tyCoVarsOfCoDSet co2)) r t1a t2b + where Pair _t2a t2b = coercionKind co2 +mkTransCo co1 (UnivCo (ZappedProv fvs) r _t2a t2b) + = UnivCo (ZappedProv (fvs `unionDVarSet` tyCoVarsOfCoDSet co1)) r t1a t2b + where Pair t1a _t1b = coercionKind co1 mkTransCo co1 co2 = TransCo co1 co2 -- | Compose two MCoercions via transitivity @@ -1108,6 +1123,14 @@ nthCoRole n co r = coercionRole co mkLRCo :: LeftOrRight -> Coercion -> Coercion +mkLRCo lr (UnivCo (ZappedProv fvs) r t1 t2) + = UnivCo (ZappedProv fvs) r + (pickLR lr (splitAppTy t1)) + (pickLR lr (splitAppTy t2)) +mkLRCo lr (UnivCo (TcZappedProv fvs coholes) r t1 t2) + = UnivCo (TcZappedProv fvs coholes) r + (pickLR lr (splitAppTy t1)) + (pickLR lr (splitAppTy t2)) mkLRCo lr co | Just (ty, eq) <- isReflCo_maybe co = mkReflCo eq (pickLR lr (splitAppTy ty)) @@ -1146,9 +1169,6 @@ mkGReflLeftCo r ty co -- is a GRefl coercion. mkCoherenceLeftCo :: Role -> Type -> CoercionN -> Coercion -> Coercion mkCoherenceLeftCo r ty co co2 - | debugIsOn - , Pair ty' _ <- coercionKind co2 - , not $ ty `eqType` ty' = pprPanic "mkCoherenceLeftCo" (ppr ty $$ ppr co $$ ppr co2) | isGReflCo co = co2 | otherwise = (mkSymCo $ GRefl r ty (MCo co)) `mkTransCo` co2 @@ -1158,9 +1178,6 @@ mkCoherenceLeftCo r ty co co2 -- is a GRefl coercion. mkCoherenceRightCo :: Role -> Type -> CoercionN -> Coercion -> Coercion mkCoherenceRightCo r ty co co2 - | debugIsOn - , Pair _ ty' <- coercionKind co2 - , not $ ty `eqType` ty' = pprPanic "mkCoherenceLeftCo" (ppr ty $$ ppr co $$ ppr co2) | isGReflCo co = co2 | otherwise = co2 `mkTransCo` GRefl r ty (MCo co) @@ -1170,6 +1187,8 @@ mkKindCo co | Just (ty, _) <- isReflCo_maybe co = Refl (typeKind ty) mkKindCo (GRefl _ _ (MCo co)) = co mkKindCo (UnivCo (PhantomProv h) _ _ _) = h mkKindCo (UnivCo (ProofIrrelProv h) _ _ _) = h +mkKindCo (UnivCo (ZappedProv fvs) _ ty1 ty2) = mkUnivCo (ZappedProv fvs) Nominal (typeKind ty1) (typeKind ty2) +mkKindCo (UnivCo (TcZappedProv fvs coholes) _ ty1 ty2) = mkUnivCo (TcZappedProv fvs coholes) Nominal (typeKind ty1) (typeKind ty2) mkKindCo co | Pair ty1 ty2 <- coercionKind co -- generally, calling coercionKind during coercion creation is a bad idea, @@ -1193,6 +1212,9 @@ mkSubCo (FunCo Nominal arg res) = FunCo Representational (downgradeRole Representational Nominal arg) (downgradeRole Representational Nominal res) +mkSubCo (UnivCo (ZappedProv fvs) Nominal t1 t2) = UnivCo (ZappedProv fvs) Representational t1 t2 +mkSubCo (UnivCo (TcZappedProv fvs coholes) Nominal t1 t2) = UnivCo (TcZappedProv fvs coholes) Representational t1 t2 +mkSubCo co@(SubCo _) = co mkSubCo co = ASSERT2( coercionRole co == Nominal, ppr co <+> ppr (coercionRole co) ) SubCo co @@ -1285,6 +1307,8 @@ setNominalRole_maybe r co | case prov of PhantomProv _ -> False -- should always be phantom ProofIrrelProv _ -> True -- it's always safe PluginProv _ -> False -- who knows? This choice is conservative. + ZappedProv _ -> False -- conservatively say no + TcZappedProv _ _ -> False -- conservatively say no = Just $ UnivCo prov Nominal co1 co2 setNominalRole_maybe_helper _ = Nothing @@ -1391,6 +1415,8 @@ promoteCoercion co = case co of UnivCo (PhantomProv kco) _ _ _ -> kco UnivCo (ProofIrrelProv kco) _ _ _ -> kco UnivCo (PluginProv _) _ _ _ -> mkKindCo co + UnivCo (ZappedProv _) _ _ _ -> mkKindCo co + UnivCo (TcZappedProv _ _) _ _ _ -> mkKindCo co SymCo g -> mkSymCo (promoteCoercion g) @@ -1535,6 +1561,232 @@ mkCoCast c g (tc, _) = splitTyConApp (coercionLKind g) co_list = decomposeCo (tyConArity tc) g (tyConRolesRepresentational tc) +{- +%************************************************************************ +%* * + Zapping coercions into oblivion +%* * +%************************************************************************ +-} + +{- Note [Zapping coercions] +~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Coercions for even small programs can grow to be quite large (e.g. #8095), +especially when type families are involved. For instance, the case of addition +of inductive natural numbers can build coercions quadratic in size of the +summands. For instance, consider the type-level addition operation defined on +Peano naturals, + + data Nat = Z | Succ Nat + + type family (+) (a :: Nat) (b :: Nat) + type instance (+) Z a = a -- CoAx1 + type instance (+) (Succ a) b = Succ (a + b) -- CoAx2 + +Now consider what is necessary to reduce (S (S (S Z)) + S Z). This +reduction will produce two results: the reduced (i.e. flattened) type, and a +coercion witnessing the reduction. The reduction will proceed as follows: + + S (S (S Z)) + S Z |> Refl + ~> S (S (S Z) + S Z) |> CoAx2 Refl + ~> S (S (S Z + S Z)) |> CoAx2 (CoAx2 Refl) + ~> S (S (S (Z + S Z))) |> CoAx2 (CoAx2 (CoAx2 Refl)) + ~> S (S (S (S (S Z)))) |> CoAx1 (CoAx2 (CoAx2 (CoAx2 Refl))) + +Note that when we are building coercions [TODO] + +Moreover, coercions are really only useful when validating core transformations +(i.e. by the Core Linter). To avoid burdening users who aren't linting with the +cost of maintaining these structures, we replace coercions with placeholders +("zap" them) them unless -dcore-lint is enabled. These placeholders are +represented by UnivCo with ZappedProv provenance. Concretely, a coercion + + co :: t1 ~r t2 + +is replaced by + + UnivCo (ZappedProv fvs) r t1 t2 + +To ensure that such coercions aren't floated out of the scope of proofs they +require, the ZappedProv constructor includes the coercion's set of free type +and coercion variables (as a DVarSet, since these sets are included in +interface files). + + +Zapping during type family reduction +------------------------------------ + +To avoid the quadratic blow-up in coercion size during type family reduction +described above, we zap on every type family reduction step taken by +TcFlatten.flatten_exact_fam_app_fully. When zapping we take care to avoid +looking at the constructed coercion and instead build up a zapped coercion +directly from type being reduced, its free variables, and the result of the +reduction. This allows us to reduce recursive type families in time linear to +the size of the type at the expense of Core Lint's ability to validate the +reduction. + +Note that the free variable set of the zapped coercion is taken to be the free +variable set of the unreduced family application, which is computed once at the +beginning of reduction. This is an important optimisation as it allows us to +avoid recomputing the free variable set (which requires linear work in the size +of the coercion) with every reduction step. Moreover, this gives us the same +result as naively computing the free variables of every reduction: + + * The FV set of the unreduced type cannot be smaller than that of the reduced type + because there is nowhere for extra FVs to come from. Type family equations + are essentially function reduction, which can never introduce new fvs. + + * The FV set of the unreducecd type cannot be larger than that of the reduced + type because the zapped coercion's kind must mention the types these fvs come + from, so the FVs of the zapped coercion must be at least those in the + starting types. + +Thus, the two sets are subsets of each other and are equal. + + +Other places where we zap +------------------------- + +Besides during type family reduction, we also zap coercions in a number of other +places (again, only when DynFlags.shouldBuildCoercions is False). This zapping +occurs in zapCoercion, which maps a coercion to its zapped form. However, there +are a few optimisations which we implement: + + * We don't zap coercions which are already zapping; this avoids an unnecessary + free variable computation. + + * We don't zap Refl coercions. This is because Refls are actually far more + compact than zapped coercions: the coercion (Refl T) holds only one + reference to T, whereas its zapped equivalent would hold two. While this + makes little difference directly after construction due to sharing, this + sharing will be lost when we substitute or otherwise manipulate the zapped + coercion, resulting in a doubling of the coercions representation size. + +zapCoercion is called in a few places: + + * CoreOpt.pushCoTyArg zaps the coercions it produces to avoid pile-up during + simplification [TODO] + + * TcIface.tcIfaceCo + + * Type.mapCoercion (which is used by zonking) can optionally zap coercions, + although this is currently disabled since it causes compiler allocations to + regress in a few cases. + + * We considered zapping as well in optCoercion, although this too caused + significant allocation regressions. + +The importance of tracking free coercion variables +-------------------------------------------------- + +It is quite important that zapped coercions track their free coercion variables. +To see why, consider this program: + + data T a where + T1 :: Bool -> T Bool + T2 :: T Int + + f :: T a -> a -> Bool + f = /\a (x:T a) (y:a). + case x of + T1 (c : a~Bool) (z : Bool) -> not (y |> c) + T2 -> True + +Now imagine that we zap the coercion `c`, replacing it with a generic UnivCo +between `a` and Bool. If we didn't record the fact that this coercion was +previously free in `c`, we may incorrectly float the expression `not (y |> c)` +out of the case alternative which brings proof of `c` into scope. If this +happened then `f T2 (I# 5)` would try to interpret `y` as a Bool, at +which point we aren't far from a segmentation fault or much worse. + +Note that we don't need to track the coercion's free *type* variables. This +means that we may float past type variables which the original proof had as free +variables. While surprising, this doesn't jeopardise the validity of the +coercion, which only depends upon the scoping relative to the free coercion +variables. + + +Differences between zapped and unzapped coercions +------------------------------------------------- + +Alas, sometimes zapped coercions will behave slightly differently from their +unzapped counterparts. Specifically, we are a bit lax in tracking external names +that are present in the unzapped coercion but not its kind. This manifests in a +few places (these are labelled in the source with the [ZappedCoDifference] +keyword): + + * IfaceSyn.freeNamesIfCoercion will fail to report top-level names present in + the unzapped proof but not its kind. + + * TcTyDecls.synonymTyConsOfType will fail to report type synonyms present in + in the unzapped proof but not its kind. + + * The result of TcValidity.fvCo will contain each free variable of a ZappedCo + only once, even if it would have reported multiple occurrences in the + unzapped coercion. + + * Type.tyConsOfType does not report TyCons which appear only in the unzapped + proof and not its kind. + + * Zapped coercions are represented in interface files as IfaceZappedProv. This + representation only includes local free variables, since these are sufficient + to avoid unsound floating. This means that the free variable lists of zapped + coercions loaded from interface files will lack top-level things (e.g. type + constructors) that appear only in the unzapped proof. + +-} + +-- | Make a zapped coercion if building of coercions is disabled, otherwise +-- return the given un-zapped coercion. +mkZappedCoercion :: HasDebugCallStack + => DynFlags + -> Coercion -- ^ the un-zapped coercion + -> Pair Type -- ^ the kind of the coercion + -> Role -- ^ the role of the coercion + -> DTyCoVarSet -- ^ the free variables of the coercion + -> Coercion +mkZappedCoercion dflags co (Pair ty1 ty2) role fvs + | debugIsOn && real_role /= role = + pprPanic "mkZappedCoercion(roles mismatch)" panic_doc + | debugIsOn && not co_kind_ok = + pprPanic "mkZappedCoercion(kind mismatch)" panic_doc + | shouldBuildCoercions dflags = co + | otherwise = + mkUnivCo (ZappedProv fvs) role ty1 ty2 + where + (Pair real_ty1 real_ty2, real_role) = coercionKindRole co + real_fvs = tyCoVarsOfCoDSet co + -- We must unify here (at the loss of some precision in the assertion) + -- since we may encounter flattening skolems. + --co_kind_ok = isJust $ tcUnifyTys (const BindMe) [real_ty1, real_ty2] [ty1, ty2] + co_kind_ok = True + -- N.B. It's not generally possible to check fCvs against the actual + -- free variable set since we may encounter flattening skolems during + -- reduction. + panic_doc = vcat + [ text "real role:" <+> ppr real_role + , text "given role:" <+> ppr role + , text "real ty1:" <+> ppr real_ty1 + , text "given ty1:" <+> ppr ty1 + , text "real ty2:" <+> ppr real_ty2 + , text "given ty2:" <+> ppr ty2 + , text "real free co vars:" <+> ppr real_fvs + , text "given free co vars:" <+> ppr fvs + , text "coercion:" <+> ppr co + ] + +-- | Replace a coercion with a zapped coercion unless coercions are needed. +zapCoercion :: DynFlags -> Coercion -> Coercion +zapCoercion _ co@(UnivCo (ZappedProv _) _ _ _) = co -- already zapped +zapCoercion _ co@(Refl _) = co -- Refl is smaller than zapped coercions +zapCoercion dflags co = + mkZappedCoercion dflags co (Pair t1 t2) role fvs + where + (Pair t1 t2, role) = coercionKindRole co + fvs = filterDVarSet (not . isCoercionHole) $ tyCoVarsOfCoDSet co + + {- %************************************************************************ %* * @@ -2147,10 +2399,15 @@ seqProv :: UnivCoProvenance -> () seqProv (PhantomProv co) = seqCo co seqProv (ProofIrrelProv co) = seqCo co seqProv (PluginProv _) = () +seqProv (ZappedProv fvs) = seqDVarSet fvs +seqProv (TcZappedProv fvs coholes) = seqDVarSet fvs `seq` seqList (\h -> coHoleCoVar h `seq` ()) coholes + +seqList :: (a -> ()) -> [a] -> () +seqList _ [] = () +seqList f (x:xs) = f x `seq` seqList f xs seqCos :: [Coercion] -> () -seqCos [] = () -seqCos (co:cos) = seqCo co `seq` seqCos cos +seqCos = seqList seqCo {- %************************************************************************ ===================================== compiler/GHC/Core/Coercion.hs-boot ===================================== @@ -48,6 +48,7 @@ liftCoSubst :: HasDebugCallStack => Role -> LiftingContext -> Type -> Coercion seqCo :: Coercion -> () coercionKind :: Coercion -> Pair Type +coercionKindRole :: Coercion -> (Pair Type, Role) coercionLKind :: Coercion -> Type coercionRKind :: Coercion -> Type coercionType :: Coercion -> Type ===================================== compiler/GHC/Core/Coercion/Opt.hs ===================================== @@ -498,6 +498,22 @@ opt_univ env sym (PhantomProv h) _r ty1 ty2 ty1' = substTy (lcSubstLeft env) ty1 ty2' = substTy (lcSubstRight env) ty2 +opt_univ env sym (ZappedProv fvs) role ty1 ty2 + | sym = mkUnivCo (ZappedProv fvs') role ty2' ty1' + | otherwise = mkUnivCo (ZappedProv fvs') role ty1' ty2' + where + ty1' = substTy (lcSubstLeft env) ty1 + ty2' = substTy (lcSubstRight env) ty2 + fvs' = substFreeDVarSet (lcTCvSubst env) fvs + +opt_univ env sym (TcZappedProv fvs coholes) role ty1 ty2 + | sym = mkUnivCo (TcZappedProv fvs' coholes) role ty2' ty1' + | otherwise = mkUnivCo (TcZappedProv fvs' coholes) role ty1' ty2' + where + ty1' = substTy (lcSubstLeft env) ty1 + ty2' = substTy (lcSubstRight env) ty2 + fvs' = substFreeDVarSet (lcTCvSubst env) fvs + opt_univ env sym prov role oty1 oty2 | Just (tc1, tys1) <- splitTyConApp_maybe oty1 , Just (tc2, tys2) <- splitTyConApp_maybe oty2 @@ -557,6 +573,9 @@ opt_univ env sym prov role oty1 oty2 PhantomProv kco -> PhantomProv $ opt_co4_wrap env sym False Nominal kco ProofIrrelProv kco -> ProofIrrelProv $ opt_co4_wrap env sym False Nominal kco PluginProv _ -> prov + ZappedProv fvs -> ZappedProv $ substFreeDVarSet (lcTCvSubst env) fvs + TcZappedProv fvs coholes + -> TcZappedProv (substFreeDVarSet (lcTCvSubst env) fvs) coholes ------------- opt_transList :: InScopeSet -> [NormalCo] -> [NormalCo] -> [NormalCo] @@ -638,6 +657,11 @@ opt_trans_rule is in_co1@(UnivCo p1 r1 tyl1 _tyr1) opt_trans_prov (ProofIrrelProv kco1) (ProofIrrelProv kco2) = Just $ ProofIrrelProv $ opt_trans is kco1 kco2 opt_trans_prov (PluginProv str1) (PluginProv str2) | str1 == str2 = Just p1 + opt_trans_prov (ZappedProv fvs1) (ZappedProv fvs2) + = Just $ ZappedProv $ fvs1 `unionDVarSet` fvs2 + opt_trans_prov (TcZappedProv fvs1 coholes1) + (TcZappedProv fvs2 coholes2) + = Just $ TcZappedProv (fvs1 `unionDVarSet` fvs2) (coholes1 ++ coholes2) opt_trans_prov _ _ = Nothing -- Push transitivity down through matching top-level constructors. ===================================== compiler/GHC/Core/FVs.hs ===================================== @@ -396,6 +396,10 @@ orphNamesOfProv :: UnivCoProvenance -> NameSet orphNamesOfProv (PhantomProv co) = orphNamesOfCo co orphNamesOfProv (ProofIrrelProv co) = orphNamesOfCo co orphNamesOfProv (PluginProv _) = emptyNameSet +orphNamesOfProv (ZappedProv _) = emptyNameSet +orphNamesOfProv (TcZappedProv _ _) = emptyNameSet + -- [ZappedCoDifference] Zapped coercions refer to no orphan names, even if the + -- original contained such names. orphNamesOfCos :: [Coercion] -> NameSet orphNamesOfCos = orphNamesOfThings orphNamesOfCo ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -1879,6 +1879,11 @@ lintCoercion co@(UnivCo prov r ty1 ty2) ; check_kinds kco k1 k2 } PluginProv _ -> return () -- no extra checks + ZappedProv fvs -> mapM_ lintTyCoVarInScope (dVarSetElems fvs) + TcZappedProv fvs coholes + -> do { addErrL $ text "Unfilled coercion hole:" <+> ppr coholes + ; mapM_ lintTyCoVarInScope (dVarSetElems fvs) + } ; when (r /= Phantom && classifiesTypeWithValues k1 && classifiesTypeWithValues k2) @@ -2105,7 +2110,6 @@ lintCoercion (HoleCo h) = do { addErrL $ text "Unfilled coercion hole:" <+> ppr h ; lintCoercion (CoVarCo (coHoleCoVar h)) } - ---------- lintUnliftedCoVar :: CoVar -> LintM () lintUnliftedCoVar cv ===================================== compiler/GHC/Core/SimpleOpt.hs ===================================== @@ -1284,13 +1284,15 @@ pushCoTyArg co ty -- tyL = forall (a1 :: k1). ty1 -- tyR = forall (a2 :: k2). ty2 - co1 = mkSymCo (mkNthCo Nominal 0 co) + zap = id -- zapCoercion dflags + + co1 = zap $ mkSymCo (mkNthCo Nominal 0 co) -- co1 :: k2 ~N k1 -- Note that NthCo can extract a Nominal equality between the -- kinds of the types related by a coercion between forall-types. -- See the NthCo case in GHC.Core.Lint. - co2 = mkInstCo co (mkGReflLeftCo Nominal ty co1) + co2 = zap $ mkInstCo co (mkGReflLeftCo Nominal ty co1) -- co2 :: ty1[ (ty|>co1)/a1 ] ~ ty2[ ty/a2 ] -- Arg of mkInstCo is always nominal, hence mkNomReflCo ===================================== compiler/GHC/Core/TyCo/FVs.hs ===================================== @@ -645,6 +645,9 @@ tyCoFVsOfProv :: UnivCoProvenance -> FV tyCoFVsOfProv (PhantomProv co) fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc tyCoFVsOfProv (ProofIrrelProv co) fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc tyCoFVsOfProv (PluginProv _) fv_cand in_scope acc = emptyFV fv_cand in_scope acc +tyCoFVsOfProv (ZappedProv fvs) fv_cand in_scope acc = (mkFVs $ dVarSetElems fvs) fv_cand in_scope acc +tyCoFVsOfProv (TcZappedProv fvs coholes) + fv_cand in_scope acc = (mkFVs $ dVarSetElems fvs ++ map coHoleCoVar coholes) fv_cand in_scope acc tyCoFVsOfCos :: [Coercion] -> FV tyCoFVsOfCos [] fv_cand in_scope acc = emptyFV fv_cand in_scope acc @@ -714,6 +717,8 @@ almost_devoid_co_var_of_prov (PhantomProv co) cv almost_devoid_co_var_of_prov (ProofIrrelProv co) cv = almost_devoid_co_var_of_co co cv almost_devoid_co_var_of_prov (PluginProv _) _ = True +almost_devoid_co_var_of_prov (ZappedProv fvs) cv = cv `elemDVarSet` fvs +almost_devoid_co_var_of_prov (TcZappedProv fvs coholes) cv = cv `elemDVarSet` fvs || cv `elem` map coHoleCoVar coholes almost_devoid_co_var_of_type :: Type -> CoVar -> Bool almost_devoid_co_var_of_type (TyVarTy _) _ = True ===================================== compiler/GHC/Core/TyCo/Rep.hs ===================================== @@ -1531,12 +1531,24 @@ data UnivCoProvenance | PluginProv String -- ^ From a plugin, which asserts that this coercion -- is sound. The string is for the use of the plugin. + | ZappedProv { zappedFreeVars :: DTyCoVarSet } + -- ^ See Note [Zapping coercions]. + -- Free variables must be tracked in 'DVarSet' since they appear in + -- interface files. See Note [Deterministic UniqFM] for details. + + | TcZappedProv { zappedFreeVars :: DTyCoVarSet + , zappedCoHoles :: [CoercionHole] + } + deriving Data.Data instance Outputable UnivCoProvenance where ppr (PhantomProv _) = text "(phantom)" ppr (ProofIrrelProv _) = text "(proof irrel.)" ppr (PluginProv str) = parens (text "plugin" <+> brackets (text str)) + ppr (ZappedProv fvs) = parens (text "zapped" <+> brackets (ppr fvs)) + ppr (TcZappedProv fvs coholes) + = parens (text "zapped" <+> brackets (ppr fvs) <+> brackets (ppr coholes)) -- | A coercion to be filled in by the type-checker. See Note [Coercion holes] data CoercionHole @@ -1602,12 +1614,15 @@ equality types story] in TysPrim for background on equality constraints. For unboxed equalities: - Generate a CoercionHole, a mutable variable just like a unification - variable + variable. - Wrap the CoercionHole in a Wanted constraint; see TcRnTypes.TcEvDest - Use the CoercionHole in a Coercion, via HoleCo - Solve the constraint later - When solved, fill in the CoercionHole by side effect, instead of doing the let-binding thing + - To ensure that Core Lint can catch when a CoercionHole variable + inappropriately persists beyond typechecking we distinguish such + variables by giving them the CoercionHoleId IdDetails. The main reason for all this is that there may be no good place to let-bind the evidence for unboxed equalities: @@ -1853,6 +1868,14 @@ foldTyCo (TyCoFolder { tcf_view = view go_prov env (PhantomProv co) = go_co env co go_prov env (ProofIrrelProv co) = go_co env co go_prov _ (PluginProv _) = mempty + go_prov env (ZappedProv fvs) = tycovars env fvs + go_prov env (TcZappedProv fvs hole) = tycovars env fvs `mappend` foldMap (cohole env) hole + + tycovars env = foldDVarSet f mempty + where f v acc + | isTyVar v = tyvar env v `mappend` acc + | isCoVar v = covar env v `mappend` acc + | otherwise = error "unknown thingy" {- ********************************************************************* * * @@ -1908,3 +1931,5 @@ provSize :: UnivCoProvenance -> Int provSize (PhantomProv co) = 1 + coercionSize co provSize (ProofIrrelProv co) = 1 + coercionSize co provSize (PluginProv _) = 1 +provSize (ZappedProv _) = 1 +provSize (TcZappedProv _ _) = 1 ===================================== compiler/GHC/Core/TyCo/Subst.hs ===================================== @@ -46,6 +46,7 @@ module GHC.Core.TyCo.Subst substTyVarBndr, substTyVarBndrs, substCoVarBndr, substTyVar, substTyVars, substTyCoVars, + substFreeDVarSet, substForAllCoBndr, substVarBndrUsing, substForAllCoBndrUsing, checkValidSubst, isValidTCvSubst, @@ -824,11 +825,22 @@ subst_co subst co go_prov (PhantomProv kco) = PhantomProv (go kco) go_prov (ProofIrrelProv kco) = ProofIrrelProv (go kco) go_prov p@(PluginProv _) = p + go_prov (ZappedProv fvs) = ZappedProv (substFreeDVarSet subst fvs) + go_prov (TcZappedProv fvs coholes) + = TcZappedProv (substFreeDVarSet subst fvs) coholes -- See Note [Substituting in a coercion hole] go_hole h@(CoercionHole { ch_co_var = cv }) = h { ch_co_var = updateVarType go_ty cv } +-- | Perform a substitution within a 'DVarSet' of free variables. +substFreeDVarSet :: TCvSubst -> DVarSet -> DVarSet +substFreeDVarSet subst = + let f v + | isTyVar v = tyCoVarsOfTypeDSet $ substTyVar subst v + | otherwise = tyCoVarsOfCoDSet $ substCoVar subst v + in mapUnionDVarSet f . dVarSetElems + substForAllCoBndr :: TCvSubst -> TyCoVar -> KindCoercion -> (TCvSubst, TyCoVar, Coercion) substForAllCoBndr subst @@ -908,14 +920,15 @@ substForAllCoCoVarBndrUsing sym sco (TCvSubst in_scope tenv cenv) substCoVar :: TCvSubst -> CoVar -> Coercion substCoVar (TCvSubst _ _ cenv) cv - = case lookupVarEnv cenv cv of + = ASSERT( isCoVar cv ) + case lookupVarEnv cenv cv of Just co -> co Nothing -> CoVarCo cv substCoVars :: TCvSubst -> [CoVar] -> [Coercion] substCoVars subst cvs = map (substCoVar subst) cvs -lookupCoVar :: TCvSubst -> Var -> Maybe Coercion +lookupCoVar :: TCvSubst -> CoVar -> Maybe Coercion lookupCoVar (TCvSubst _ _ cenv) v = lookupVarEnv cenv v substTyVarBndr :: HasCallStack => TCvSubst -> TyVar -> (TCvSubst, TyVar) ===================================== compiler/GHC/Core/TyCo/Tidy.hs ===================================== @@ -26,9 +26,11 @@ import GHC.Core.TyCo.FVs (tyCoVarsOfTypesWellScoped, tyCoVarsOfTypeList) import Name hiding (varName) import Var import VarEnv +import VarSet import Util (seqList) import Data.List (mapAccumL) +import Data.Maybe (fromMaybe) {- %************************************************************************ @@ -209,9 +211,7 @@ tidyCo env@(_, subst) co -- the case above duplicates a bit of work in tidying h and the kind -- of tv. But the alternative is to use coercionKind, which seems worse. go (FunCo r co1 co2) = (FunCo r $! go co1) $! go co2 - go (CoVarCo cv) = case lookupVarEnv subst cv of - Nothing -> CoVarCo cv - Just cv' -> CoVarCo cv' + go (CoVarCo cv) = CoVarCo $ substCoVar cv go (HoleCo h) = HoleCo h go (AxiomInstCo con ind cos) = let args = map go cos in args `seqList` AxiomInstCo con ind args @@ -230,6 +230,12 @@ tidyCo env@(_, subst) co go_prov (PhantomProv co) = PhantomProv (go co) go_prov (ProofIrrelProv co) = ProofIrrelProv (go co) go_prov p@(PluginProv _) = p + go_prov (ZappedProv fvs) = ZappedProv $ mapUnionDVarSet (unitDVarSet . substCoVar) (dVarSetElems fvs) + go_prov (TcZappedProv fvs coholes) + = TcZappedProv (mapUnionDVarSet (unitDVarSet . substCoVar) (dVarSetElems fvs)) + coholes -- Tidying needed? + + substCoVar cv = fromMaybe cv $ lookupVarEnv subst cv tidyCos :: TidyEnv -> [Coercion] -> [Coercion] tidyCos env = map (tidyCo env) ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -474,6 +474,10 @@ expandTypeSynonyms ty go_prov subst (PhantomProv co) = PhantomProv (go_co subst co) go_prov subst (ProofIrrelProv co) = ProofIrrelProv (go_co subst co) go_prov _ p@(PluginProv _) = p + go_prov subst (ZappedProv fvs) + = ZappedProv $ substFreeDVarSet subst fvs + go_prov subst (TcZappedProv fvs coholes) + = TcZappedProv (substFreeDVarSet subst fvs) coholes -- the "False" and "const" are to accommodate the type of -- substForAllCoBndrUsing, which is general enough to @@ -716,7 +720,22 @@ mapTyCoX (TyCoMapper { tcm_tyvar = tyvar go_prov env (PhantomProv co) = PhantomProv <$> go_co env co go_prov env (ProofIrrelProv co) = ProofIrrelProv <$> go_co env co go_prov _ p@(PluginProv _) = return p - + go_prov env (ZappedProv fvs) + = let bndrFVs v + | isCoVar v = tyCoVarsOfCoDSet <$> covar env v + | isTyVar v = tyCoVarsOfTypeDSet <$> tyvar env v + | otherwise = pprPanic "mapCoercion(ZappedProv): Bad free variable" (ppr v) + in do fvs' <- unionDVarSets <$> mapM bndrFVs (dVarSetElems fvs) + return $ ZappedProv fvs' + go_prov env (TcZappedProv fvs coholes) + = let bndrFVs v + | isCoVar v = tyCoVarsOfCoDSet <$> covar env v + | isTyVar v = tyCoVarsOfTypeDSet <$> tyvar env v + | otherwise = pprPanic "mapCoercion(TcZappedProv): Bad free variable" (ppr v) + in do fvs' <- unionDVarSets <$> mapM bndrFVs (dVarSetElems fvs) + coholes' <- mapM (cohole env) coholes + let fvs'' = mapUnionDVarSet tyCoVarsOfCoDSet coholes' + return $ ZappedProv $ fvs' `unionDVarSet` fvs'' {- ************************************************************************ @@ -2772,7 +2791,8 @@ occCheckExpand vs_to_avoid ty go_prov cxt (PhantomProv co) = PhantomProv <$> go_co cxt co go_prov cxt (ProofIrrelProv co) = ProofIrrelProv <$> go_co cxt co go_prov _ p@(PluginProv _) = return p - + go_prov _ p@(ZappedProv _) = return p + go_prov _ p@(TcZappedProv{}) = return p {- %************************************************************************ @@ -2827,6 +2847,11 @@ tyConsOfType ty go_prov (PluginProv _) = emptyUniqSet -- this last case can happen from the tyConsOfType used from -- checkTauTvUpdate + go_prov (ZappedProv _) = emptyUniqSet + go_prov (TcZappedProv _ _) = emptyUniqSet + -- [ZappedCoDifference] that this will not report TyCons present in the + -- unzapped proof but not its kind. See Note [Zapping coercions] in + -- TyCoRep. go_s tys = foldr (unionUniqSets . go) emptyUniqSet tys go_cos cos = foldr (unionUniqSets . go_co) emptyUniqSet cos ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -304,6 +304,16 @@ toIfaceCoercionX fr co go_prov (PhantomProv co) = IfacePhantomProv (go co) go_prov (ProofIrrelProv co) = IfaceProofIrrelProv (go co) go_prov (PluginProv str) = IfacePluginProv str + go_prov (ZappedProv fvs) = IfaceZappedProv tvs cvs openVars + where + (tvs, cvs, openVars) = foldl' f ([], [], []) (dVarSetElems fvs) + isOpen = (`elemVarSet` fr) + f (a,b,c) v + | isOpen v = (a, b, v:c) + | isCoVar v = (a, toIfaceCoVar v:b, c) + | isTyVar v = (toIfaceTyVar v:a, b, c) + | otherwise = panic "ToIface.toIfaceCoercionX(go_prov): Bad free variable in ZappedProv" + go_prov (TcZappedProv _ _) = panic "ToIface.toIfaceCoercionX(go_prov): TcZappedProv" toIfaceTcArgs :: TyCon -> [Type] -> IfaceAppArgs toIfaceTcArgs = toIfaceTcArgsX emptyVarSet ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -120,6 +120,7 @@ data GeneralFlag | Opt_D_faststring_stats | Opt_D_dump_minimal_imports | Opt_DoCoreLinting + | Opt_DropCoercions | Opt_DoStgLinting | Opt_DoCmmLinting | Opt_DoAsmLinting ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -40,6 +40,7 @@ module GHC.Driver.Session ( lang_set, whenGeneratingDynamicToo, ifGeneratingDynamicToo, whenCannotGenerateDynamicToo, + shouldBuildCoercions, dynamicTooMkDynamicDynFlags, dynamicOutputFile, DynFlags(..), @@ -1185,6 +1186,14 @@ data RtsOptsEnabled | RtsOptsAll deriving (Show) +-- | Should we generate coercions? +-- +-- See Note [Zapping coercions] for details. +shouldBuildCoercions :: DynFlags -> Bool +shouldBuildCoercions dflags = + gopt Opt_DoCoreLinting dflags && not (gopt Opt_DropCoercions dflags) + -- TODO: Add flag to explicitly enable coercion generation without linting? + -- | Are we building with @-fPIE@ or @-fPIC@ enabled? positionIndependent :: DynFlags -> Bool positionIndependent dflags = gopt Opt_PIC dflags || gopt Opt_PIE dflags @@ -2808,6 +2817,8 @@ dynamic_flags_deps = [ (setDumpFlag Opt_D_dump_rtti) , make_ord_flag defGhcFlag "dcore-lint" (NoArg (setGeneralFlag Opt_DoCoreLinting)) + , make_ord_flag defGhcFlag "ddrop-coercions" + (NoArg (setGeneralFlag Opt_DropCoercions)) , make_ord_flag defGhcFlag "dstg-lint" (NoArg (setGeneralFlag Opt_DoStgLinting)) , make_ord_flag defGhcFlag "dcmm-lint" ===================================== compiler/GHC/Iface/Env.hs ===================================== @@ -226,7 +226,7 @@ tcIfaceLclId occ = do { lcl <- getLclEnv ; case (lookupFsEnv (if_id_env lcl) occ) of Just ty_var -> return ty_var - Nothing -> failIfM (text "Iface id out of scope: " <+> ppr occ) + Nothing -> failIfM (text "Iface id out of scope: " <+> ppr occ $$ ppr (if_id_env lcl)) } extendIfaceIdEnv :: [Id] -> IfL a -> IfL a ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -843,7 +843,7 @@ loadDecl ignore_prags (_version, decl) [(n, lookup n) | n <- implicit_names] } where - doc = text "Declaration for" <+> ppr (ifName decl) + doc = text "Declaration for" <+> ppr (ifName decl) $$ ppr decl bumpDeclStats :: Name -> IfL () -- Record that one more declaration has actually been used bumpDeclStats name ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -1614,6 +1614,9 @@ freeNamesIfProv :: IfaceUnivCoProv -> NameSet freeNamesIfProv (IfacePhantomProv co) = freeNamesIfCoercion co freeNamesIfProv (IfaceProofIrrelProv co) = freeNamesIfCoercion co freeNamesIfProv (IfacePluginProv _) = emptyNameSet +freeNamesIfProv (IfaceZappedProv _ _ _) = emptyNameSet + -- [ZappedCoDifference]: This won't report top-level names present in the + -- unzapped proof but not its kind. freeNamesIfVarBndr :: VarBndr IfaceBndr vis -> NameSet freeNamesIfVarBndr (Bndr bndr _) = freeNamesIfBndr bndr ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -359,6 +359,13 @@ data IfaceUnivCoProv = IfacePhantomProv IfaceCoercion | IfaceProofIrrelProv IfaceCoercion | IfacePluginProv String + | IfaceZappedProv [IfLclName] [IfLclName] [Var] + -- ^ @local tyvars, local covars, open free variables@ + -- + -- Local variables are those bound in the current IfaceType; free variables + -- are used only when printing open types and are not serialised; see Note + -- [Free tyvars in IfaceType]. + -- See Note [Zapping coercions] in TyCoRep. {- Note [Holes in IfaceCoercion] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -532,6 +539,8 @@ substIfaceType env ty go_prov (IfacePhantomProv co) = IfacePhantomProv (go_co co) go_prov (IfaceProofIrrelProv co) = IfaceProofIrrelProv (go_co co) go_prov (IfacePluginProv str) = IfacePluginProv str + go_prov (IfaceZappedProv tvs cvs fCvs) + = IfaceZappedProv tvs cvs fCvs substIfaceAppArgs :: IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs substIfaceAppArgs env args @@ -1606,6 +1615,12 @@ pprIfaceUnivCoProv (IfaceProofIrrelProv co) = text "irrel" <+> pprParendIfaceCoercion co pprIfaceUnivCoProv (IfacePluginProv s) = text "plugin" <+> doubleQuotes (text s) +pprIfaceUnivCoProv (IfaceZappedProv tvs cvs fCvs) + = text "Zapped" <> brackets (whenPprDebug fvsDoc) + where + fvsDoc = text "free tyvars:" <+> ppr tvs + $$ text "free covars:" <+> ppr cvs + $$ text "open free covars:" <+> ppr fCvs ------------------- instance Outputable IfaceTyCon where @@ -1956,6 +1971,12 @@ instance Binary IfaceUnivCoProv where put_ bh (IfacePluginProv a) = do putByte bh 3 put_ bh a + put_ bh (IfaceZappedProv tyFvs coFvs _) = do + putByte bh 5 + put_ bh tyFvs + put_ bh coFvs + -- N.B. Free variables aren't serialised; see Note [Free tyvars in + -- IfaceType]. get bh = do tag <- getByte bh @@ -1966,6 +1987,11 @@ instance Binary IfaceUnivCoProv where return $ IfaceProofIrrelProv a 3 -> do a <- get bh return $ IfacePluginProv a + 5 -> do a <- get bh + b <- get bh + -- N.B. Open free variables aren't serialised; see Note + -- [Free tyvars in IfaceType]. + return $ IfaceZappedProv a b [] _ -> panic ("get IfaceUnivCoProv " ++ show tag) ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -1212,7 +1212,12 @@ tcIfaceTyLit (IfaceStrTyLit n) = return (StrTyLit n) -} tcIfaceCo :: IfaceCoercion -> IfL Coercion -tcIfaceCo = go +tcIfaceCo = \co0 -> do + dflags <- getDynFlags + co <- go co0 + if shouldBuildCoercions dflags + then return co + else return $ zapCoercion dflags co where go_mco IfaceMRefl = pure MRefl go_mco (IfaceMCo co) = MCo <$> (go co) @@ -1252,6 +1257,10 @@ tcIfaceUnivCoProv :: IfaceUnivCoProv -> IfL UnivCoProvenance tcIfaceUnivCoProv (IfacePhantomProv kco) = PhantomProv <$> tcIfaceCo kco tcIfaceUnivCoProv (IfaceProofIrrelProv kco) = ProofIrrelProv <$> tcIfaceCo kco tcIfaceUnivCoProv (IfacePluginProv str) = return $ PluginProv str +tcIfaceUnivCoProv (IfaceZappedProv tvs cvs _) + = do cvs' <- mapM tcIfaceLclId cvs + tvs' <- mapM tcIfaceTyVar tvs + return $ ZappedProv $ mkDVarSet $ cvs' ++ tvs' {- ************************************************************************ ===================================== compiler/basicTypes/IdInfo.hs ===================================== @@ -15,7 +15,8 @@ Haskell. [WDP 94/11]) module IdInfo ( -- * The IdDetails type - IdDetails(..), pprIdDetails, coVarDetails, isCoVarDetails, + IdDetails(..), pprIdDetails, coVarDetails, + isCoVarDetails, isCoercionHoleDetails, JoinArity, isJoinIdDetails_maybe, RecSelParent(..), @@ -164,6 +165,9 @@ data IdDetails | CoVarId -- ^ A coercion variable -- This only covers /un-lifted/ coercions, of type -- (t1 ~# t2) or (t1 ~R# t2), not their lifted variants + | CoercionHoleId -- ^ A variable introduced for tracking the scoping of + -- a coercion hole during typechecking. See + -- Note [Coercion holes] in TyCoRep. | JoinId JoinArity -- ^ An 'Id' for a join point taking n arguments -- Note [Join points] in GHC.Core @@ -189,6 +193,11 @@ isCoVarDetails :: IdDetails -> Bool isCoVarDetails CoVarId = True isCoVarDetails _ = False +-- | Check if an 'IdDetails' says 'CoercionHoleId'. +isCoercionHoleDetails :: IdDetails -> Bool +isCoercionHoleDetails CoercionHoleId = True +isCoercionHoleDetails _ = False + isJoinIdDetails_maybe :: IdDetails -> Maybe JoinArity isJoinIdDetails_maybe (JoinId join_arity) = Just join_arity isJoinIdDetails_maybe _ = Nothing @@ -212,6 +221,7 @@ pprIdDetails other = brackets (pp other) = brackets $ text "RecSel" <> ppWhen is_naughty (text "(naughty)") pp CoVarId = text "CoVarId" + pp CoercionHoleId = text "CoercionHoleId" pp (JoinId arity) = text "JoinId" <> parens (int arity) {- ===================================== compiler/basicTypes/IdInfo.hs-boot ===================================== @@ -7,5 +7,6 @@ data IdDetails vanillaIdInfo :: IdInfo coVarDetails :: IdDetails isCoVarDetails :: IdDetails -> Bool +isCoercionHoleDetails :: IdDetails -> Bool pprIdDetails :: IdDetails -> SDoc ===================================== compiler/basicTypes/Var.hs ===================================== @@ -58,7 +58,7 @@ module Var ( -- ** Predicates isId, isTyVar, isTcTyVar, - isLocalVar, isLocalId, isCoVar, isNonCoVarId, isTyCoVar, + isLocalVar, isLocalId, isCoVar, isCoercionHole, isNonCoVarId, isTyCoVar, isGlobalId, isExportedId, mustHaveLocalBinding, @@ -94,7 +94,8 @@ import GhcPrelude import {-# SOURCE #-} GHC.Core.TyCo.Rep( Type, Kind ) import {-# SOURCE #-} GHC.Core.TyCo.Ppr( pprKind ) import {-# SOURCE #-} TcType( TcTyVarDetails, pprTcTyVarDetails, vanillaSkolemTv ) -import {-# SOURCE #-} IdInfo( IdDetails, IdInfo, coVarDetails, isCoVarDetails, +import {-# SOURCE #-} IdInfo( IdDetails, IdInfo, coVarDetails, + isCoVarDetails, isCoercionHoleDetails, vanillaIdInfo, pprIdDetails ) import Name hiding (varName) @@ -728,6 +729,11 @@ isCoVar :: Var -> Bool isCoVar (Id { id_details = details }) = isCoVarDetails details isCoVar _ = False +-- | Is this a CoercionHoleId? See Note [Coercion holes] in TyCoRep. +isCoercionHole :: Var -> Bool +isCoercionHole (Id { id_details = details }) = isCoercionHoleDetails details +isCoercionHole _ = False + -- | Is this a term variable ('Id') that is /not/ a coercion variable? -- Satisfies @'isId' v ==> 'isCoVar' v == not ('isNonCoVarId' v)@. isNonCoVarId :: Var -> Bool ===================================== compiler/basicTypes/VarSet.hs ===================================== @@ -26,7 +26,7 @@ module VarSet ( nonDetFoldVarSet, -- * Deterministic Var set types - DVarSet, DIdSet, DTyVarSet, DTyCoVarSet, + DVarSet, DIdSet, DTyVarSet, DCoVarSet, DTyCoVarSet, -- ** Manipulating these sets emptyDVarSet, unitDVarSet, mkDVarSet, @@ -229,6 +229,9 @@ type DIdSet = UniqDSet Id -- | Deterministic Type Variable Set type DTyVarSet = UniqDSet TyVar +-- | Deterministic Coercion Variable Set +type DCoVarSet = UniqDSet CoVar + -- | Deterministic Type or Coercion Variable Set type DTyCoVarSet = UniqDSet TyCoVar ===================================== compiler/typecheck/TcFlatten.hs ===================================== @@ -28,10 +28,12 @@ import Var import VarSet import VarEnv import Outputable +import GHC.Driver.Session ( HasDynFlags(..) ) import TcSMonad as TcS import BasicTypes( SwapFlag(..) ) import Util +import Pair import Bag import Control.Monad import MonadUtils ( zipWith3M ) @@ -501,6 +503,9 @@ instance Applicative FlatM where pure x = FlatM $ const (pure x) (<*>) = ap +instance HasDynFlags FlatM where + getDynFlags = liftTcS getDynFlags + liftTcS :: TcS a -> FlatM a liftTcS thing_inside = FlatM $ const thing_inside @@ -1376,7 +1381,7 @@ flatten_exact_fam_app_fully tc tys -- See Note [Reduce type family applications eagerly] -- the following tcTypeKind should never be evaluated, as it's just used in -- casting, and casts by refl are dropped - = do { mOut <- try_to_reduce_nocache tc tys + = do { mOut <- try_to_reduce_nocache tc tys emptyDVarSet ; case mOut of Just out -> pure out Nothing -> do @@ -1386,6 +1391,7 @@ flatten_exact_fam_app_fully tc tys -- each arg flatten_args_tc tc (repeat Nominal) tys -- kind_co :: tcTypeKind(F xis) ~N tcTypeKind(F tys) + -- cos !! n :: (xis !! n) ~N (tys !! n) ; eq_rel <- getEqRel ; cur_flav <- getFlavour ; let role = eqRelRole eq_rel @@ -1420,6 +1426,7 @@ flatten_exact_fam_app_fully tc tys _ -> do { mOut <- try_to_reduce tc xis kind_co + (tyCoVarsOfCoDSet ret_co) (`mkTransCo` ret_co) ; case mOut of Just out -> pure out @@ -1465,25 +1472,34 @@ flatten_exact_fam_app_fully tc tys -- where -- orig_args is what was passed to the outer -- function + -> DTyCoVarSet -- free variables of ret_co -> ( Coercion -- :: (xi |> kind_co) ~ F args -> Coercion ) -- what to return from outer function -> FlatM (Maybe (Xi, Coercion)) - try_to_reduce tc tys kind_co update_co - = do { checkStackDepth (mkTyConApp tc tys) + try_to_reduce tc tys kind_co ret_co_fvs update_co + = do { let fvs = tyCoVarsOfTypesDSet tys + `unionDVarSet` tyCoVarsOfCoDSet kind_co + `unionDVarSet` ret_co_fvs + -- See Note [Zapping coercions] in TyCoRep + fam_ty = mkTyConApp tc tys + ; checkStackDepth (mkTyConApp tc tys) + ; dflags <- getDynFlags ; mb_match <- liftTcS $ matchFam tc tys ; case mb_match of -- NB: norm_co will always be homogeneous. All type families -- are homogeneous. - Just (norm_co, norm_ty) + Just (norm_co, norm_ty) -- norm_co :: fam_ty ~R norm_ty -> do { traceFlat "Eager T.F. reduction success" $ vcat [ ppr tc, ppr tys, ppr norm_ty , ppr norm_co <+> dcolon <+> ppr (coercionKind norm_co) ] ; (xi, final_co) <- bumpDepth $ flatten_one norm_ty + -- final_co :: xi ~ norm_ty ; eq_rel <- getEqRel ; let co = maybeTcSubCo eq_rel norm_co `mkTransCo` mkSymCo final_co + -- co :: fam_ty ~eq_rel xi ; flavour <- getFlavour -- NB: only extend cache with nominal equalities ; when (eq_rel == NomEq) $ @@ -1491,16 +1507,25 @@ flatten_exact_fam_app_fully tc tys extendFlatCache tc tys ( co, xi, flavour ) ; let role = eqRelRole eq_rel xi' = xi `mkCastTy` kind_co - co' = update_co $ - mkTcCoherenceLeftCo role xi kind_co (mkSymCo co) - ; return $ Just (xi', co') } + -- See Note [Zapping coercions] + co' = mkTcCoherenceLeftCo role xi kind_co (mkSymCo co) + co'_kind = Pair xi' fam_ty + -- co' :: (xi |> kind_co) ~role fam_ty + co'' = update_co $ mkZappedCoercion dflags co' co'_kind role fvs + --co'' = update_co co' + ; return $ Just (xi', co'') } Nothing -> pure Nothing } try_to_reduce_nocache :: TyCon -- F, family tycon -> [Type] -- args, not necessarily flattened + -> DTyCoVarSet -- free variables of ret_co -> FlatM (Maybe (Xi, Coercion)) - try_to_reduce_nocache tc tys - = do { checkStackDepth (mkTyConApp tc tys) + try_to_reduce_nocache tc tys fvs_ret_co + = do { let fvs = tyCoVarsOfTypesDSet tys `unionDVarSet` fvs_ret_co + -- See Note [Zapping coercions] in TyCoRep + fam_ty = mkTyConApp tc tys + ; checkStackDepth fam_ty + ; dflags <- getDynFlags ; mb_match <- liftTcS $ matchFam tc tys ; case mb_match of -- NB: norm_co will always be homogeneous. All type families @@ -1508,9 +1533,12 @@ flatten_exact_fam_app_fully tc tys Just (norm_co, norm_ty) -> do { (xi, final_co) <- bumpDepth $ flatten_one norm_ty ; eq_rel <- getEqRel + ; let role = eqRelRole eq_rel ; let co = mkSymCo (maybeTcSubCo eq_rel norm_co `mkTransCo` mkSymCo final_co) - ; return $ Just (xi, co) } + co' = mkZappedCoercion dflags co (Pair xi fam_ty) role fvs + --co' = co + ; return $ Just (xi, co') } Nothing -> pure Nothing } {- Note [Reduce type family applications eagerly] ===================================== compiler/typecheck/TcMType.hs ===================================== @@ -1383,11 +1383,7 @@ collect_cand_qtvs_co orig_ty bound = go_co go_co dv (KindCo co) = go_co dv co go_co dv (SubCo co) = go_co dv co - go_co dv (HoleCo hole) - = do m_co <- unpackCoercionHole_maybe hole - case m_co of - Just co -> go_co dv co - Nothing -> go_cv dv (coHoleCoVar hole) + go_co dv (HoleCo hole) = go_cohole dv hole go_co dv (CoVarCo cv) = go_cv dv cv @@ -1401,6 +1397,10 @@ collect_cand_qtvs_co orig_ty bound = go_co go_prov dv (PhantomProv co) = go_co dv co go_prov dv (ProofIrrelProv co) = go_co dv co go_prov dv (PluginProv _) = return dv + go_prov dv (ZappedProv fvs) = foldlM go_cv dv (dVarSetElems fvs) + go_prov dv (TcZappedProv fvs coholes) + = do dv1 <- foldlM go_cv dv (dVarSetElems fvs) + foldlM go_cohole dv1 coholes go_cv :: CandidatesQTvs -> CoVar -> TcM CandidatesQTvs go_cv dv@(DV { dv_cvs = cvs }) cv @@ -1412,6 +1412,14 @@ collect_cand_qtvs_co orig_ty bound = go_co (dv { dv_cvs = cvs `extendVarSet` cv }) (idType cv) + go_cohole :: CandidatesQTvs -> CoercionHole -> TcM CandidatesQTvs + go_cohole dv cohole + = do { m_co <- unpackCoercionHole_maybe cohole + ; case m_co of + Just co -> go_co dv co + Nothing -> go_cv dv (coHoleCoVar cohole) + } + is_bound tv = tv `elemVarSet` bound {- Note [Order of accumulation] ===================================== compiler/typecheck/TcTyDecls.hs ===================================== @@ -141,6 +141,10 @@ synonymTyConsOfType ty go_prov (PhantomProv co) = go_co co go_prov (ProofIrrelProv co) = go_co co go_prov (PluginProv _) = emptyNameEnv + go_prov (ZappedProv _) = emptyNameEnv + go_prov (TcZappedProv _ _) = emptyNameEnv + -- [ZappedCoDifference]: This won't report type synonyms present in the + -- unzapped proof but not its kind. go_tc tc | isTypeSynonymTyCon tc = unitNameEnv (tyConName tc) tc | otherwise = emptyNameEnv ===================================== testsuite/tests/profiling/should_run/T2552.prof.sample ===================================== @@ -17,7 +17,8 @@ COST CENTRE MODULE SRC no. entr MAIN MAIN 45 0 0.0 0.0 100.0 100.0 CAF Main 89 0 0.0 0.0 100.0 100.0 - main Main T2552.hs:(17,1)-(20,17) 90 1 0.0 0.0 100.0 100.0 + main Main T2552.hs:12:1-12 90 1 0.0 0.0 100.0 100.0 + fib3 Main T2552.hs:(1,1)-(5,61) 92 1 0.0 0.0 37.8 33.3 fib1 Main T2552.hs:(1,1)-(5,61) 92 1 0.0 0.0 37.8 33.3 fib1.fib1' Main T2552.hs:(3,5)-(5,61) 93 1 0.0 0.0 37.8 33.3 nfib' Main T2552.hs:3:35-40 94 1 0.0 0.0 37.8 33.3 @@ -25,7 +26,7 @@ MAIN MAIN 45 fib2 Main T2552.hs:7:1-16 96 1 0.0 0.0 31.1 33.3 fib2' Main T2552.hs:(8,1)-(10,57) 97 1 0.0 0.0 31.1 33.3 fib2'.nfib Main T2552.hs:10:5-57 98 1028457 31.1 33.3 31.1 33.3 - fib3 Main T2552.hs:12:1-12 99 1 0.0 0.0 0.0 0.0 + fib3 Main T2552.hs:12:1-12 99 0 0.0 0.0 0.0 0.0 fib3' Main T2552.hs:(13,1)-(15,57) 100 1 0.0 0.0 31.1 33.3 fib3'.nfib Main T2552.hs:15:5-57 101 1028457 31.1 33.3 31.1 33.3 CAF GHC.IO.Handle.FD 84 0 0.0 0.0 0.0 0.0 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/81578d45f7bb2cc84d153c8152a1e8faa9fd53b5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/81578d45f7bb2cc84d153c8152a1e8faa9fd53b5 You're receiving 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 Mar 27 18:10:02 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Fri, 27 Mar 2020 14:10:02 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/hadrian-8.10 Message-ID: <5e7e417ad67c7_6167e6514b410082e9@gitlab.haskell.org.mail> Ryan Scott pushed new branch wip/hadrian-8.10 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/hadrian-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 Fri Mar 27 18:32:56 2020 From: gitlab at gitlab.haskell.org (John Ericson) Date: Fri, 27 Mar 2020 14:32:56 -0400 Subject: [Git][ghc/ghc][wip/ttg-con-pat] 260 commits: Fix long distance info for record updates Message-ID: <5e7e46d84a27b_616713339fc410126af@gitlab.haskell.org.mail> John Ericson pushed to branch wip/ttg-con-pat at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - cf83afba by John Ericson at 2020-03-27T11:49:46-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. - - - - - 468f9be1 by Cale Gibbard at 2020-03-27T12:15:03-04:00 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. - - - - - 857ea3dc by Cale Gibbard at 2020-03-27T14:26:25-04:00 Pure refactor of code around ConPat Now that things are working, clean some things up: - 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 - - - - - 30 changed files: - .ghcid - .gitlab-ci.yml - + .gitlab/ci.sh - − .gitlab/darwin-init.sh - .gitlab/linters/check-cpp.py - .gitlab/merge_request_templates/merge-request.md - − .gitlab/prepare-system.sh - − .gitlab/win32-init.sh - HACKING.md - aclocal.m4 - boot - compiler/main/GHC.hs → compiler/GHC.hs - compiler/ghci/ByteCodeAsm.hs → compiler/GHC/ByteCode/Asm.hs - compiler/ghci/ByteCodeItbls.hs → compiler/GHC/ByteCode/InfoTable.hs - compiler/ghci/ByteCodeInstr.hs → compiler/GHC/ByteCode/Instr.hs - compiler/ghci/ByteCodeLink.hs → compiler/GHC/ByteCode/Linker.hs - compiler/ghci/ByteCodeTypes.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.hs - compiler/GHC/Cmm/Dataflow/Block.hs - compiler/GHC/Cmm/Dataflow/Graph.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Graph.hs - compiler/GHC/Cmm/Info.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b61b0d13fdc95e50d3fb3b6eda1e1461b0267472...857ea3dc79c7d3d30488cee9f56cee806915afe5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b61b0d13fdc95e50d3fb3b6eda1e1461b0267472...857ea3dc79c7d3d30488cee9f56cee806915afe5 You're receiving 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 Mar 27 18:43:17 2020 From: gitlab at gitlab.haskell.org (John Ericson) Date: Fri, 27 Mar 2020 14:43:17 -0400 Subject: [Git][ghc/ghc][wip/ttg-con-pat] Pure refactor of code around ConPat Message-ID: <5e7e4945304_616776d1c7410136a9@gitlab.haskell.org.mail> John Ericson pushed to branch wip/ttg-con-pat at Glasgow Haskell Compiler / GHC Commits: 2bb83e98 by Cale Gibbard at 2020-03-27T14:42:59-04:00 Pure refactor of code around ConPat Now that things are working, clean some things up: - 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 - - - - - 25 changed files: - compiler/GHC/Hs/Extension.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/ListComp.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/PmCheck.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Types.hs - compiler/GHC/ThToHs.hs - compiler/parser/RdrHsSyn.hs - compiler/typecheck/TcArrows.hs - compiler/typecheck/TcBinds.hs - compiler/typecheck/TcGenDeriv.hs - compiler/typecheck/TcHsSyn.hs - compiler/typecheck/TcPat.hs - compiler/typecheck/TcPatSyn.hs - compiler/typecheck/TcTyClsDecls.hs - compiler/typecheck/TcTyDecls.hs - compiler/typecheck/TcValidity.hs Changes: ===================================== compiler/GHC/Hs/Extension.hs ===================================== @@ -662,7 +662,6 @@ type family XListPat x type family XTuplePat x type family XSumPat x type family XConPat x -type family XConPatCon x type family XViewPat x type family XSplicePat x type family XLitPat x ===================================== compiler/GHC/Hs/Pat.hs ===================================== @@ -23,10 +23,11 @@ {-# LANGUAGE LambdaCase #-} module GHC.Hs.Pat ( - Pat(..), InPat, OutPat, LPat, + Pat(..), LPat, ConPatTc (..), CoPat (..), ListPatTc(..), + ConLikeP, HsConPatDetails, hsConPatArgs, HsRecFields(..), HsRecField'(..), LHsRecField', @@ -72,12 +73,10 @@ import GHC.Core.Type import SrcLoc import Bag -- collect ev vars from pats import Maybes +import Name (Name) -- libraries: import Data.Data hiding (TyCon,Fixity) -type InPat p = LPat p -- No 'Out' constructors -type OutPat p = LPat GhcTc -- No 'In' constructors - type LPat p = XRec p Pat -- | Pattern @@ -175,9 +174,9 @@ data Pat p ------------ Constructor patterns --------------- | ConPat { - pat_con :: Located (XConPatCon p), - pat_args :: HsConPatDetails p, - pat_con_ext :: XConPat p + pat_con_ext :: XConPat p, + pat_con :: Located (ConLikeP p), + pat_args :: HsConPatDetails p } -- ^ Constructor Pattern @@ -282,10 +281,6 @@ type instance XConPat GhcPs = NoExtField type instance XConPat GhcRn = NoExtField type instance XConPat GhcTc = ConPatTc -type instance XConPatCon GhcPs = IdP GhcPs -type instance XConPatCon GhcRn = IdP GhcRn -type instance XConPatCon GhcTc = ConLike - type instance XSumPat GhcPs = NoExtField type instance XSumPat GhcRn = NoExtField type instance XSumPat GhcTc = [Type] @@ -313,6 +308,11 @@ type instance XXPat GhcPs = NoExtCon type instance XXPat GhcRn = NoExtCon type instance XXPat GhcTc = CoPat +type family ConLikeP x + +type instance ConLikeP GhcPs = RdrName -- IdP GhcPs +type instance ConLikeP GhcRn = Name -- IdP GhcRn +type instance ConLikeP GhcTc = ConLike -- --------------------------------------------------------------------- @@ -329,26 +329,26 @@ data ConPatTc = ConPatTc { -- | The universal arg types 1-1 with the universal -- tyvars of the constructor/pattern synonym - -- Use (conLikeResTy pat_con pat_arg_tys) to get + -- Use (conLikeResTy pat_con cpt_arg_tys) to get -- the type of the pattern - pat_arg_tys :: [Type] + cpt_arg_tys :: [Type] , -- | Existentially bound type variables -- in correctly-scoped order e.g. [k:* x:k] - pat_tvs :: [TyVar] + cpt_tvs :: [TyVar] , -- | Ditto *coercion variables* and *dictionaries* -- One reason for putting coercion variable here I think -- is to ensure their kinds are zonked - pat_dicts :: [EvVar] + cpt_dicts :: [EvVar] , -- | Bindings involving those dictionaries - pat_binds :: TcEvBinds + cpt_binds :: TcEvBinds , -- ^ Extra wrapper to pass to the matcher -- Only relevant for pattern-synonyms; -- ignored for data cons - pat_wrap :: HsWrapper + cpt_wrap :: HsWrapper } -- | Coercion Pattern (translation only) @@ -360,7 +360,7 @@ data CoPat { -- | Coercion Pattern -- If co :: t1 ~ t2, p :: t2, -- then (CoPat co p) :: t1 - co_pat_wrap :: HsWrapper + co_cpt_wrap :: HsWrapper , -- | Why not LPat? Ans: existing locn will do co_pat_inner :: Pat GhcTc @@ -523,16 +523,14 @@ pprParendLPat :: (OutputableBndrId p) => PprPrec -> LPat (GhcPass p) -> SDoc pprParendLPat p = pprParendPat p . unLoc -pprParendPat - :: forall p - . OutputableBndrId p - => PprPrec - -> Pat (GhcPass p) - -> SDoc +pprParendPat :: forall p. OutputableBndrId p + => PprPrec + -> Pat (GhcPass p) + -> SDoc pprParendPat p pat = sdocOption sdocPrintTypecheckerElaboration $ \ print_tc_elab -> if need_parens print_tc_elab pat then parens (pprPat pat) - else pprPat pat + else pprPat pat where need_parens print_tc_elab pat | GhcTc <- ghcPass @p @@ -547,7 +545,7 @@ pprParendPat p pat = sdocOption sdocPrintTypecheckerElaboration $ \ print_tc_ela -- But otherwise the CoPat is discarded, so it -- is the pattern inside that matters. Sigh. -pprPat :: forall p. (IsPass p, OutputableBndrId p) => Pat (GhcPass p) -> SDoc +pprPat :: forall p. (OutputableBndrId p) => Pat (GhcPass p) -> SDoc pprPat (VarPat _ lvar) = pprPatBndr (unLoc lvar) pprPat (WildPat _) = char '_' pprPat (LazyPat _ pat) = char '~' <> pprParendLPat appPrec pat @@ -591,16 +589,16 @@ pprPat (ConPat { pat_con = con -- error message, and we want to make sure it prints nicely ppr con <> braces (sep [ hsep (map pprPatBndr (tvs ++ dicts)) - , pprIfTc @p $ ppr binds ]) + , ppr binds ]) <+> pprConArgs details - where ConPatTc { pat_tvs = tvs - , pat_dicts = dicts - , pat_binds = binds + where ConPatTc { cpt_tvs = tvs + , cpt_dicts = dicts + , cpt_binds = binds } = ext pprPat (XPat ext) = case ghcPass @p of GhcPs -> noExtCon ext GhcRn -> noExtCon ext - GhcTc -> pprIfTc @p $ pprHsWrapper co $ \parens -> + GhcTc -> pprHsWrapper co $ \parens -> if parens then pprParendPat appPrec pat else pprPat pat @@ -643,24 +641,24 @@ instance (Outputable p, Outputable arg) -} mkPrefixConPat :: DataCon -> - [OutPat (GhcPass p)] -> [Type] -> OutPat (GhcPass p) + [LPat GhcTc] -> [Type] -> LPat GhcTc -- Make a vanilla Prefix constructor pattern mkPrefixConPat dc pats tys = noLoc $ ConPat { pat_con = noLoc (RealDataCon dc) , pat_args = PrefixCon pats , pat_con_ext = ConPatTc - { pat_tvs = [] - , pat_dicts = [] - , pat_binds = emptyTcEvBinds - , pat_arg_tys = tys - , pat_wrap = idHsWrapper + { cpt_tvs = [] + , cpt_dicts = [] + , cpt_binds = emptyTcEvBinds + , cpt_arg_tys = tys + , cpt_wrap = idHsWrapper } } -mkNilPat :: Type -> OutPat (GhcPass p) +mkNilPat :: Type -> LPat GhcTc mkNilPat ty = mkPrefixConPat nilDataCon [] [ty] -mkCharLitPat :: SourceText -> Char -> OutPat (GhcPass p) +mkCharLitPat :: SourceText -> Char -> LPat GhcTc mkCharLitPat src c = mkPrefixConPat charDataCon [noLoc $ LitPat noExtField (HsCharPrim src c)] [] @@ -728,7 +726,7 @@ looksLazyPat (VarPat {}) = False looksLazyPat (WildPat {}) = False looksLazyPat _ = True -isIrrefutableHsPat :: forall p. (IsPass p, OutputableBndrId p) => LPat (GhcPass p) -> Bool +isIrrefutableHsPat :: forall p. (OutputableBndrId p) => LPat (GhcPass p) -> Bool -- (isIrrefutableHsPat p) is true if matching against p cannot fail, -- in the sense of falling through to the next pattern. -- (NB: this is not quite the same as the (silly) defn @@ -867,11 +865,10 @@ conPatNeedsParens p = go -- | @'parenthesizePat' p pat@ checks if @'patNeedsParens' p pat@ is true, and -- if so, surrounds @pat@ with a 'ParPat'. Otherwise, it simply returns @pat at . -parenthesizePat - :: IsPass p - => PprPrec - -> LPat (GhcPass p) - -> LPat (GhcPass p) +parenthesizePat :: IsPass p + => PprPrec + -> LPat (GhcPass p) + -> LPat (GhcPass p) parenthesizePat p lpat@(L loc pat) | patNeedsParens p pat = L loc (ParPat noExtField lpat) | otherwise = lpat @@ -900,7 +897,7 @@ collectEvVarsPat pat = ConPat { pat_args = args , pat_con_ext = ConPatTc - { pat_dicts = dicts + { cpt_dicts = dicts } } -> unionBags (listToBag dicts) ===================================== compiler/GHC/Hs/Utils.hs ===================================== @@ -91,7 +91,7 @@ module GHC.Hs.Utils( collectPatBinders, collectPatsBinders, collectLStmtsBinders, collectStmtsBinders, collectLStmtBinders, collectStmtBinders, - XCollectPat(..), + CollectPass(..), hsLTyClDeclBinders, hsTyClForeignBinders, hsPatSynSelectors, getPatSynBinds, @@ -200,12 +200,11 @@ mkHsAppType e t = addCLoc e t_body (HsAppType noExtField e paren_wct) mkHsAppTypes :: LHsExpr GhcRn -> [LHsWcType GhcRn] -> LHsExpr GhcRn mkHsAppTypes = foldl' mkHsAppType -mkHsLam - :: IsPass p - => (XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ NoExtField) - => [LPat (GhcPass p)] - -> LHsExpr (GhcPass p) - -> LHsExpr (GhcPass p) +mkHsLam :: IsPass p + => (XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ NoExtField) + => [LPat (GhcPass p)] + -> LHsExpr (GhcPass p) + -> LHsExpr (GhcPass p) mkHsLam pats body = mkHsPar (L (getLoc body) (HsLam noExtField matches)) where matches = mkMatchGroup Generated @@ -444,38 +443,41 @@ nlConVarPatName con vars = nlConPatName con (map nlVarPat vars) nlInfixConPat :: RdrName -> LPat GhcPs -> LPat GhcPs -> LPat GhcPs nlInfixConPat con l r = noLoc $ ConPat - (noLoc con) - (InfixCon (parenthesizePat opPrec l) - (parenthesizePat opPrec r)) - noExtField + { pat_con = noLoc con + , pat_args = InfixCon (parenthesizePat opPrec l) + (parenthesizePat opPrec r) + , pat_con_ext = noExtField + } nlConPat :: RdrName -> [LPat GhcPs] -> LPat GhcPs nlConPat con pats = noLoc $ ConPat - (noLoc con) - (PrefixCon (map (parenthesizePat appPrec) pats)) - noExtField + { pat_con_ext = noExtField + , pat_con = noLoc con + , pat_args = PrefixCon (map (parenthesizePat appPrec) pats) + } nlConPatName :: Name -> [LPat GhcRn] -> LPat GhcRn nlConPatName con pats = noLoc $ ConPat - (noLoc con) - (PrefixCon (map (parenthesizePat appPrec) pats)) - noExtField - -nlNullaryConPat - :: ( XConPatCon (GhcPass p) ~ IdP (GhcPass p) - , XConPat (GhcPass p) ~ NoExtField - ) - => IdP (GhcPass p) - -> LPat (GhcPass p) -nlNullaryConPat con = noLoc $ ConPat (noLoc con) (PrefixCon []) noExtField + { pat_con_ext = noExtField + , pat_con = noLoc con + , pat_args = PrefixCon (map (parenthesizePat appPrec) pats) + } + +nlNullaryConPat :: RdrName -> LPat GhcPs +nlNullaryConPat con = noLoc $ ConPat + { pat_con_ext = noExtField + , pat_con = noLoc con + , pat_args = PrefixCon [] + } nlWildConPat :: DataCon -> LPat GhcPs nlWildConPat con = noLoc $ ConPat - (noLoc $ getRdrName con) - (PrefixCon $ + { pat_con_ext = noExtField + , pat_con = noLoc $ getRdrName con + , pat_args = PrefixCon $ replicate (dataConSourceArity con) - nlWildPat) - noExtField + nlWildPat + } -- | Wildcard pattern - after parsing nlWildPat :: LPat GhcPs @@ -897,14 +899,12 @@ mkPrefixFunRhs n = FunRhs { mc_fun = n , mc_strictness = NoSrcStrict } ------------ -mkMatch - :: forall p - . IsPass p - => HsMatchContext (NoGhcTc (GhcPass p)) - -> [LPat (GhcPass p)] - -> LHsExpr (GhcPass p) - -> Located (HsLocalBinds (GhcPass p)) - -> LMatch (GhcPass p) (LHsExpr (GhcPass p)) +mkMatch :: forall p. IsPass p + => HsMatchContext (NoGhcTc (GhcPass p)) + -> [LPat (GhcPass p)] + -> LHsExpr (GhcPass p) + -> Located (HsLocalBinds (GhcPass p)) + -> LMatch (GhcPass p) (LHsExpr (GhcPass p)) mkMatch ctxt pats expr lbinds = noLoc (Match { m_ext = noExtField , m_ctxt = ctxt @@ -1001,74 +1001,70 @@ isBangedHsBind (PatBind {pat_lhs = pat}) isBangedHsBind _ = False -collectLocalBinders - :: XCollectPat (GhcPass idL) - => HsLocalBindsLR (GhcPass idL) (GhcPass idR) - -> [IdP (GhcPass idL)] +collectLocalBinders :: CollectPass (GhcPass idL) + => HsLocalBindsLR (GhcPass idL) (GhcPass idR) + -> [IdP (GhcPass idL)] collectLocalBinders (HsValBinds _ binds) = collectHsIdBinders binds -- No pattern synonyms here collectLocalBinders (HsIPBinds {}) = [] collectLocalBinders (EmptyLocalBinds _) = [] collectLocalBinders (XHsLocalBindsLR _) = [] -collectHsIdBinders, collectHsValBinders - :: XCollectPat (GhcPass idL) - => HsValBindsLR (GhcPass idL) (GhcPass idR) - -> [IdP (GhcPass idL)] +collectHsIdBinders :: CollectPass (GhcPass idL) + => HsValBindsLR (GhcPass idL) (GhcPass idR) + -> [IdP (GhcPass idL)] -- ^ Collect 'Id' binders only, or 'Id's + pattern synonyms, respectively collectHsIdBinders = collect_hs_val_binders True + +collectHsValBinders :: CollectPass (GhcPass idL) + => HsValBindsLR (GhcPass idL) (GhcPass idR) + -> [IdP (GhcPass idL)] collectHsValBinders = collect_hs_val_binders False -collectHsBindBinders - :: XCollectPat p - => HsBindLR p idR -> [IdP p] +collectHsBindBinders :: CollectPass p + => HsBindLR p idR + -> [IdP p] -- ^ Collect both 'Id's and pattern-synonym binders collectHsBindBinders b = collect_bind False b [] -collectHsBindsBinders - :: XCollectPat p - => LHsBindsLR p idR - -> [IdP p] +collectHsBindsBinders :: CollectPass p + => LHsBindsLR p idR + -> [IdP p] collectHsBindsBinders binds = collect_binds False binds [] -collectHsBindListBinders - :: XCollectPat p - => [LHsBindLR p idR] - -> [IdP p] +collectHsBindListBinders :: CollectPass p + => [LHsBindLR p idR] + -> [IdP p] -- ^ Same as 'collectHsBindsBinders', but works over a list of bindings collectHsBindListBinders = foldr (collect_bind False . unLoc) [] -collect_hs_val_binders - :: XCollectPat (GhcPass idL) - => Bool - -> HsValBindsLR (GhcPass idL) (GhcPass idR) - -> [IdP (GhcPass idL)] +collect_hs_val_binders :: CollectPass (GhcPass idL) + => Bool + -> HsValBindsLR (GhcPass idL) (GhcPass idR) + -> [IdP (GhcPass idL)] collect_hs_val_binders ps (ValBinds _ binds _) = collect_binds ps binds [] collect_hs_val_binders ps (XValBindsLR (NValBinds binds _)) = collect_out_binds ps binds -collect_out_binds - :: XCollectPat p - => Bool - -> [(RecFlag, LHsBinds p)] - -> [IdP p] +collect_out_binds :: CollectPass p + => Bool + -> [(RecFlag, LHsBinds p)] + -> [IdP p] collect_out_binds ps = foldr (collect_binds ps . snd) [] -collect_binds - :: XCollectPat p - => Bool - -> LHsBindsLR p idR - -> [IdP p] - -> [IdP p] +collect_binds :: CollectPass p + => Bool + -> LHsBindsLR p idR + -> [IdP p] + -> [IdP p] -- ^ Collect 'Id's, or 'Id's + pattern synonyms, depending on boolean flag collect_binds ps binds acc = foldr (collect_bind ps . unLoc) acc binds -collect_bind - :: XCollectPat p - => Bool - -> HsBindLR p idR - -> [IdP p] - -> [IdP p] +collect_bind :: CollectPass p + => Bool + -> HsBindLR p idR + -> [IdP p] + -> [IdP p] collect_bind _ (PatBind { pat_lhs = p }) acc = collect_lpat p acc collect_bind _ (FunBind { fun_id = L _ f }) acc = f : acc collect_bind _ (VarBind { var_id = f }) acc = f : acc @@ -1092,25 +1088,24 @@ collectMethodBinders binds = foldr (get . unLoc) [] binds -- Someone else complains about non-FunBinds ----------------- Statements -------------------------- -collectLStmtsBinders :: (XCollectPat (GhcPass idL)) +collectLStmtsBinders :: (CollectPass (GhcPass idL)) => [LStmtLR (GhcPass idL) (GhcPass idR) body] -> [IdP (GhcPass idL)] collectLStmtsBinders = concatMap collectLStmtBinders -collectStmtsBinders :: (XCollectPat (GhcPass idL)) +collectStmtsBinders :: (CollectPass (GhcPass idL)) => [StmtLR (GhcPass idL) (GhcPass idR) body] -> [IdP (GhcPass idL)] collectStmtsBinders = concatMap collectStmtBinders -collectLStmtBinders :: (XCollectPat (GhcPass idL)) +collectLStmtBinders :: (CollectPass (GhcPass idL)) => LStmtLR (GhcPass idL) (GhcPass idR) body -> [IdP (GhcPass idL)] collectLStmtBinders = collectStmtBinders . unLoc -collectStmtBinders - :: (XCollectPat (GhcPass idL)) - => StmtLR (GhcPass idL) (GhcPass idR) body - -> [IdP (GhcPass idL)] +collectStmtBinders :: (CollectPass (GhcPass idL)) + => StmtLR (GhcPass idL) (GhcPass idR) body + -> [IdP (GhcPass idL)] -- Id Binders for a Stmt... [but what about pattern-sig type vars]? collectStmtBinders (BindStmt _ pat _ _ _) = collectPatBinders pat collectStmtBinders (LetStmt _ binds) = collectLocalBinders (unLoc binds) @@ -1129,25 +1124,21 @@ collectStmtBinders (XStmtLR nec) = noExtCon nec ----------------- Patterns -------------------------- -collectPatBinders :: XCollectPat p => LPat p -> [IdP p] +collectPatBinders :: CollectPass p => LPat p -> [IdP p] collectPatBinders pat = collect_lpat pat [] -collectPatsBinders :: XCollectPat p => [LPat p] -> [IdP p] +collectPatsBinders :: CollectPass p => [LPat p] -> [IdP p] collectPatsBinders pats = foldr collect_lpat [] pats ------------- -collect_lpat - :: forall pass. - (XCollectPat pass) - => LPat pass -> [IdP pass] -> [IdP pass] +collect_lpat :: forall pass. (CollectPass pass) + => LPat pass -> [IdP pass] -> [IdP pass] collect_lpat p bndrs = collect_pat (unLoc p) bndrs -collect_pat - :: forall p. - XCollectPat p - => Pat p - -> [IdP p] - -> [IdP p] +collect_pat :: forall p. CollectPass p + => Pat p + -> [IdP p] + -> [IdP p] collect_pat pat bndrs = case pat of (VarPat _ var) -> unLoc var : bndrs (WildPat _) -> bndrs @@ -1168,19 +1159,22 @@ collect_pat pat bndrs = case pat of (SplicePat _ (HsSpliced _ _ (HsSplicedPat pat))) -> collect_pat pat bndrs (SplicePat _ _) -> bndrs - (XPat ext) -> collectPatX (Proxy @p) ext bndrs + (XPat ext) -> collectXXPat (Proxy @p) ext bndrs -class (XRec p Pat ~ Located (Pat p)) => XCollectPat p where - collectPatX :: Proxy p -> XXPat p -> [IdP p] -> [IdP p] +-- This class specifies how to collect variable identifiers from extension patterns in the given pass. +-- Consumers of the GHC API that define their own passes should feel free to implement instances in order +-- to make use of functions which depend on it. +class (XRec p Pat ~ Located (Pat p)) => CollectPass p where + collectXXPat :: Proxy p -> XXPat p -> [IdP p] -> [IdP p] -instance XCollectPat (GhcPass 'Parsed) where - collectPatX _ ext = noExtCon ext +instance CollectPass (GhcPass 'Parsed) where + collectXXPat _ ext = noExtCon ext -instance XCollectPat (GhcPass 'Renamed) where - collectPatX _ ext = noExtCon ext +instance CollectPass (GhcPass 'Renamed) where + collectXXPat _ ext = noExtCon ext -instance XCollectPat (GhcPass 'Typechecked) where - collectPatX _ (CoPat _ pat _) = collect_pat pat +instance CollectPass (GhcPass 'Typechecked) where + collectXXPat _ (CoPat _ pat _) = collect_pat pat {- ===================================== compiler/GHC/HsToCore/Arrows.hs ===================================== @@ -1196,7 +1196,7 @@ Note [Dictionary binders in ConPatOut] See also same Note in GHC.Hs.Utils ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The following functions to collect value variables from patterns are copied from GHC.Hs.Utils, with one change: we also collect the dictionary -bindings (pat_binds) from ConPatOut. We need them for cases like +bindings (cpt_binds) from ConPatOut. We need them for cases like h :: Arrow a => Int -> a (Int,Int) Int h x = proc (y,z) -> case compare x y of @@ -1237,7 +1237,7 @@ collectl (L _ pat) bndrs go (SumPat _ pat _ _) = collectl pat bndrs go (ConPat { pat_args = ps - , pat_con_ext = ConPatTc { pat_binds = ds }}) = + , pat_con_ext = ConPatTc { cpt_binds = ds }}) = collectEvBinders ds ++ foldr collectl bndrs (hsConPatArgs ps) go (LitPat _ _) = bndrs ===================================== compiler/GHC/HsToCore/Docs.hs ===================================== @@ -117,10 +117,9 @@ user-written. This lets us relate Names (from ClsInsts) to comments (associated with InstDecls and DerivDecls). -} -getMainDeclBinder - :: (XCollectPat (GhcPass p)) - => HsDecl (GhcPass p) - -> [IdP (GhcPass p)] +getMainDeclBinder :: (CollectPass (GhcPass p)) + => HsDecl (GhcPass p) + -> [IdP (GhcPass p)] getMainDeclBinder (TyClD _ d) = [tcdName d] getMainDeclBinder (ValD _ d) = case collectHsBindBinders d of ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -708,11 +708,11 @@ dsExpr expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = fields pat = noLoc $ ConPat { pat_con = noLoc con , pat_args = PrefixCon $ map nlVarPat arg_ids , pat_con_ext = ConPatTc - { pat_tvs = ex_tvs - , pat_dicts = eqs_vars ++ theta_vars - , pat_binds = emptyTcEvBinds - , pat_arg_tys = in_inst_tys - , pat_wrap = req_wrap + { cpt_tvs = ex_tvs + , cpt_dicts = eqs_vars ++ theta_vars + , cpt_binds = emptyTcEvBinds + , cpt_arg_tys = in_inst_tys + , cpt_wrap = req_wrap } } ; return (mkSimpleMatch RecUpd [pat] wrapped_rhs) } ===================================== compiler/GHC/HsToCore/ListComp.hs ===================================== @@ -270,7 +270,7 @@ deListComp (ApplicativeStmt {} : _) _ = deListComp (XStmtLR nec : _) _ = noExtCon nec -deBindComp :: OutPat GhcTc +deBindComp :: LPat GhcTc -> CoreExpr -> [ExprStmt GhcTc] -> CoreExpr ===================================== compiler/GHC/HsToCore/Match.hs ===================================== @@ -525,7 +525,7 @@ tidy_bang_pat v o _ p@(SumPat {}) = tidy1 v o p tidy_bang_pat v o l p@(ConPat { pat_con = L _ (RealDataCon dc) , pat_args = args , pat_con_ext = ConPatTc - { pat_arg_tys = arg_tys + { cpt_arg_tys = arg_tys } }) -- Newtypes: push bang inwards (#9844) @@ -1124,7 +1124,7 @@ viewLExprEq (e1,_) (e2,_) = lexp e1 e2 patGroup :: Platform -> Pat GhcTc -> PatGroup patGroup _ (ConPat { pat_con = L _ con - , pat_con_ext = ConPatTc { pat_arg_tys = tys } + , pat_con_ext = ConPatTc { cpt_arg_tys = tys } }) | RealDataCon dcon <- con = PgCon dcon | PatSynCon psyn <- con = PgSyn psyn tys ===================================== compiler/GHC/HsToCore/Match/Constructor.hs ===================================== @@ -147,9 +147,9 @@ matchOneConLike vars ty (eqn1 :| eqns) -- All eqns for a single constructor { eqn_pats = ConPat { pat_args = args , pat_con_ext = ConPatTc - { pat_tvs = tvs - , pat_dicts = ds - , pat_binds = bind + { cpt_tvs = tvs + , cpt_dicts = ds + , cpt_binds = bind } } : pats })) @@ -181,10 +181,10 @@ matchOneConLike vars ty (eqn1 :| eqns) -- All eqns for a single constructor ConPat { pat_con = L _ con1 , pat_args = args1 , pat_con_ext = ConPatTc - { pat_arg_tys = arg_tys - , pat_wrap = wrapper1 - , pat_tvs = tvs1 - , pat_dicts = dicts1 + { cpt_arg_tys = arg_tys + , cpt_wrap = wrapper1 + , cpt_tvs = tvs1 + , cpt_dicts = dicts1 } } = firstPat eqn1 fields1 = map flSelector (conLikeFieldLabels con1) ===================================== compiler/GHC/HsToCore/PmCheck.hs ===================================== @@ -502,9 +502,9 @@ translatePat fam_insts x pat = case pat of ConPat { pat_con = L _ con , pat_args = ps , pat_con_ext = ConPatTc - { pat_arg_tys = arg_tys - , pat_tvs = ex_tvs - , pat_dicts = dicts + { cpt_arg_tys = arg_tys + , cpt_tvs = ex_tvs + , cpt_dicts = dicts } } -> do translateConPatOut fam_insts x con arg_tys ex_tvs dicts ps ===================================== compiler/GHC/HsToCore/Quote.hs ===================================== @@ -1984,7 +1984,7 @@ repP (TuplePat _ ps boxed) | otherwise = do { qs <- repLPs ps; repPunboxedTup qs } repP (SumPat _ p alt arity) = do { p1 <- repLP p ; repPunboxedSum p1 alt arity } -repP (ConPat dc details NoExtField) +repP (ConPat NoExtField dc details) = do { con_str <- lookupLOcc dc ; case details of PrefixCon ps -> do { qs <- repLPs ps; repPcon con_str qs } ===================================== compiler/GHC/HsToCore/Utils.hs ===================================== @@ -760,7 +760,7 @@ mkLHsPatTup [lpat] = lpat mkLHsPatTup lpats = L (getLoc (head lpats)) $ mkVanillaTuplePat lpats Boxed -mkVanillaTuplePat :: [OutPat GhcTc] -> Boxity -> Pat GhcTc +mkVanillaTuplePat :: [LPat GhcTc] -> Boxity -> Pat GhcTc -- A vanilla tuple pattern simply gets its type from its sub-patterns mkVanillaTuplePat pats box = TuplePat (map hsLPatType pats) pats box ===================================== compiler/GHC/Rename/Pat.hs ===================================== @@ -468,14 +468,14 @@ rnPatAndThen mk p@(ViewPat x expr pat) -- ; return (ViewPat expr' pat' ty) } ; return (ViewPat x expr' pat') } -rnPatAndThen mk (ConPat con stuff NoExtField) +rnPatAndThen mk (ConPat NoExtField con args) -- rnConPatAndThen takes care of reconstructing the pattern -- The pattern for the empty list needs to be replaced by an empty explicit list pattern when overloaded lists is turned on. = case unLoc con == nameRdrName (dataConName nilDataCon) of True -> do { ol_flag <- liftCps $ xoptM LangExt.OverloadedLists ; if ol_flag then rnPatAndThen mk (ListPat noExtField []) - else rnConPatAndThen mk con stuff} - False -> rnConPatAndThen mk con stuff + else rnConPatAndThen mk con args} + False -> rnConPatAndThen mk con args rnPatAndThen mk (ListPat _ pats) = do { opt_OverloadedLists <- liftCps $ xoptM LangExt.OverloadedLists @@ -517,7 +517,12 @@ rnConPatAndThen :: NameMaker rnConPatAndThen mk con (PrefixCon pats) = do { con' <- lookupConCps con ; pats' <- rnLPatsAndThen mk pats - ; return (ConPat con' (PrefixCon pats') NoExtField) } + ; return $ ConPat + { pat_con_ext = noExtField + , pat_con = con' + , pat_args = PrefixCon pats' + } + } rnConPatAndThen mk con (InfixCon pat1 pat2) = do { con' <- lookupConCps con @@ -529,7 +534,12 @@ rnConPatAndThen mk con (InfixCon pat1 pat2) rnConPatAndThen mk con (RecCon rpats) = do { con' <- lookupConCps con ; rpats' <- rnHsRecPatsAndThen mk con' rpats - ; return (ConPat con' (RecCon rpats') NoExtField) } + ; return $ ConPat + { pat_con_ext = noExtField + , pat_con = con' + , pat_args = RecCon rpats' + } + } checkUnusedRecordWildcardCps :: SrcSpan -> Maybe [Name] -> CpsRn () checkUnusedRecordWildcardCps loc dotdot_names = ===================================== compiler/GHC/Rename/Types.hs ===================================== @@ -1231,27 +1231,46 @@ mkOpFormRn arg1 op fix arg2 -- Default case, no rearrangment mkConOpPatRn :: Located Name -> Fixity -> LPat GhcRn -> LPat GhcRn -> RnM (Pat GhcRn) -mkConOpPatRn op2 fix2 p1@(L loc (ConPat op1 (InfixCon p11 p12) NoExtField)) p2 +mkConOpPatRn op2 fix2 p1@(L loc (ConPat NoExtField op1 (InfixCon p11 p12))) p2 = do { fix1 <- lookupFixityRn (unLoc op1) ; let (nofix_error, associate_right) = compareFixity fix1 fix2 ; if nofix_error then do { precParseErr (NormalOp (unLoc op1),fix1) (NormalOp (unLoc op2),fix2) - ; return (ConPat op2 (InfixCon p1 p2) NoExtField) } + ; return $ ConPat + { pat_con_ext = noExtField + , pat_con = op2 + , pat_args = InfixCon p1 p2 + } + } else if associate_right then do { new_p <- mkConOpPatRn op2 fix2 p12 p2 - ; return (ConPat op1 (InfixCon p11 (L loc new_p)) NoExtField) } + ; return $ ConPat + { pat_con_ext = noExtField + , pat_con = op1 + , pat_args = InfixCon p11 (L loc new_p) + } + } -- XXX loc right? - else return (ConPat op2 (InfixCon p1 p2) NoExtField) } + else return $ ConPat + { pat_con_ext = noExtField + , pat_con = op2 + , pat_args = InfixCon p1 p2 + } + } mkConOpPatRn op _ p1 p2 -- Default case, no rearrangment = ASSERT( not_op_pat (unLoc p2) ) - return (ConPat op (InfixCon p1 p2) NoExtField) + return $ ConPat + { pat_con_ext = noExtField + , pat_con = op + , pat_args = InfixCon p1 p2 + } not_op_pat :: Pat GhcRn -> Bool -not_op_pat (ConPat _ (InfixCon _ _) NoExtField) = False +not_op_pat (ConPat NoExtField _ (InfixCon _ _)) = False not_op_pat _ = True -------------------------------------- @@ -1281,7 +1300,7 @@ checkPrecMatch op (MG { mg_alts = (L _ ms) }) checkPrecMatch _ (XMatchGroup nec) = noExtCon nec checkPrec :: Name -> Pat GhcRn -> Bool -> IOEnv (Env TcGblEnv TcLclEnv) () -checkPrec op (ConPat op1 (InfixCon _ _) NoExtField) right = do +checkPrec op (ConPat NoExtField op1 (InfixCon _ _)) right = do op_fix@(Fixity _ op_prec op_dir) <- lookupFixityRn op op1_fix@(Fixity _ op1_prec op1_dir) <- lookupFixityRn (unLoc op1) let ===================================== compiler/GHC/ThToHs.hs ===================================== @@ -1270,13 +1270,21 @@ cvtp (UnboxedSumP p alt arity) ; return $ SumPat noExtField p' alt arity } cvtp (ConP s ps) = do { s' <- cNameL s; ps' <- cvtPats ps ; let pps = map (parenthesizePat appPrec) ps' - ; return $ ConPat s' (PrefixCon pps) NoExtField } + ; return $ ConPat + { pat_con_ext = noExtField + , pat_con = s' + , pat_args = PrefixCon pps + } + } cvtp (InfixP p1 s p2) = do { s' <- cNameL s; p1' <- cvtPat p1; p2' <- cvtPat p2 ; wrapParL (ParPat noExtField) $ - ConPat s' - (InfixCon (parenthesizePat opPrec p1') - (parenthesizePat opPrec p2')) - NoExtField + ConPat + { pat_con_ext = NoExtField + , pat_con = s' + , pat_args = InfixCon + (parenthesizePat opPrec p1') + (parenthesizePat opPrec p2') + } } -- See Note [Operator association] cvtp (UInfixP p1 s p2) = do { p1' <- cvtPat p1; cvtOpAppP p1' s p2 } -- Note [Converting UInfix] @@ -1290,9 +1298,11 @@ cvtp (TH.AsP s p) = do { s' <- vNameL s; p' <- cvtPat p ; return $ AsPat noExtField s' p' } cvtp TH.WildP = return $ WildPat noExtField cvtp (RecP c fs) = do { c' <- cNameL c; fs' <- mapM cvtPatFld fs - ; return $ ConPat c' - (Hs.RecCon $ HsRecFields fs' Nothing) - NoExtField + ; return $ ConPat + { pat_con_ext = noExtField + , pat_con = c' + , pat_args = Hs.RecCon $ HsRecFields fs' Nothing + } } cvtp (ListP ps) = do { ps' <- cvtPats ps ; return @@ -1323,7 +1333,11 @@ cvtOpAppP x op1 (UInfixP y op2 z) cvtOpAppP x op y = do { op' <- cNameL op ; y' <- cvtPat y - ; return $ ConPat op' (InfixCon x y') NoExtField + ; return $ ConPat + { pat_con_ext = noExtField + , pat_con = op' + , pat_args = InfixCon x y' + } } ----------------------------------------------------------- ===================================== compiler/parser/RdrHsSyn.hs ===================================== @@ -603,7 +603,7 @@ mkPatSynMatchGroup (L loc patsyn_name) (L _ decls) = ; return $ mkMatchGroup FromSource matches } where fromDecl (L loc decl@(ValD _ (PatBind _ - pat@(L _ (ConPat ln@(L _ name) details NoExtField)) + pat@(L _ (ConPat NoExtField ln@(L _ name) details)) rhs _))) = do { unless (name == patsyn_name) $ wrongNameBindingErr loc decl @@ -1077,7 +1077,11 @@ checkLPat e@(L l _) = checkPat l e [] checkPat :: SrcSpan -> Located (PatBuilder GhcPs) -> [LPat GhcPs] -> PV (LPat GhcPs) checkPat loc (L l e@(PatBuilderVar (L _ c))) args - | isRdrDataCon c = return (L loc (ConPat (L l c) (PrefixCon args) NoExtField)) + | isRdrDataCon c = return . L loc $ ConPat + { pat_con_ext = noExtField + , pat_con = L l c + , pat_args = PrefixCon args + } | not (null args) && patIsRec c = localPV_msg (\_ -> text "Perhaps you intended to use RecursiveDo") $ patFail l (ppr e) @@ -1114,7 +1118,11 @@ checkAPat loc e0 = do | isRdrDataCon c -> do l <- checkLPat l r <- checkLPat r - return (ConPat (L cl c) (InfixCon l r) NoExtField) + return $ ConPat + { pat_con_ext = noExtField + , pat_con = L cl c + , pat_args = InfixCon l r + } PatBuilderPar e -> checkLPat e >>= (return . (ParPat noExtField)) _ -> patFail loc (ppr e0) @@ -2065,7 +2073,11 @@ mkPatRec :: mkPatRec (unLoc -> PatBuilderVar c) (HsRecFields fs dd) | isRdrDataCon (unLoc c) = do fs <- mapM checkPatField fs - return $ PatBuilderPat $ ConPat c (RecCon (HsRecFields fs dd)) NoExtField + return $ PatBuilderPat $ ConPat + { pat_con_ext = noExtField + , pat_con = c + , pat_args = RecCon (HsRecFields fs dd) + } mkPatRec p _ = addFatalError (getLoc p) $ text "Not a record constructor:" <+> ppr p ===================================== compiler/typecheck/TcArrows.hs ===================================== @@ -81,9 +81,9 @@ Note that ************************************************************************ -} -tcProc :: InPat GhcRn -> LHsCmdTop GhcRn -- proc pat -> expr +tcProc :: LPat GhcRn -> LHsCmdTop GhcRn -- proc pat -> expr -> ExpRhoType -- Expected type of whole proc expression - -> TcM (OutPat GhcTcId, LHsCmdTop GhcTcId, TcCoercion) + -> TcM (LPat GhcTc, LHsCmdTop GhcTcId, TcCoercion) tcProc pat cmd exp_ty = newArrowScope $ ===================================== compiler/typecheck/TcBinds.hs ===================================== @@ -505,7 +505,7 @@ tc_group top_lvl sig_fn prag_fn (Recursive, binds) closed thing_inside tcPolyBinds sig_fn prag_fn Recursive rec_tc closed binds recursivePatSynErr :: - (OutputableBndrId p, XCollectPat (GhcPass p)) + (OutputableBndrId p, CollectPass (GhcPass p)) => SrcSpan -- ^ The location of the first pattern synonym binding -- (for error reporting) -> LHsBinds (GhcPass p) ===================================== compiler/typecheck/TcGenDeriv.hs ===================================== @@ -534,10 +534,12 @@ unliftedCompare lt_op eq_op a_expr b_expr lt eq gt nlConWildPat :: DataCon -> LPat GhcPs -- The pattern (K {}) nlConWildPat con = noLoc $ ConPat - (noLoc $ getRdrName con) - (RecCon $ HsRecFields { rec_flds = [] - , rec_dotdot = Nothing }) - NoExtField + { pat_con_ext = noExtField + , pat_con = noLoc $ getRdrName con + , pat_args = RecCon $ HsRecFields + { rec_flds = [] + , rec_dotdot = Nothing } + } {- ************************************************************************ ===================================== compiler/typecheck/TcHsSyn.hs ===================================== @@ -118,7 +118,7 @@ hsPatType (TuplePat tys _ bx) = mkTupleTy1 bx tys hsPatType (SumPat tys _ _ _ ) = mkSumTy tys hsPatType (ConPat { pat_con = lcon , pat_con_ext = ConPatTc - { pat_arg_tys = tys + { cpt_arg_tys = tys } }) = conLikeResTy (unLoc lcon) tys @@ -1309,7 +1309,7 @@ mapIPNameTc f (Right x) = do r <- f x ************************************************************************ -} -zonkPat :: ZonkEnv -> OutPat GhcTcId -> TcM (ZonkEnv, OutPat GhcTc) +zonkPat :: ZonkEnv -> LPat GhcTc -> TcM (ZonkEnv, LPat GhcTc) -- Extend the environment as we go, because it's possible for one -- pattern to bind something that is used in another (inside or -- to the right) @@ -1374,11 +1374,11 @@ zonk_pat env (SumPat tys pat alt arity ) zonk_pat env p@(ConPat { pat_con = L _ con , pat_args = args , pat_con_ext = p'@(ConPatTc - { pat_tvs = tyvars - , pat_dicts = evs - , pat_binds = binds - , pat_wrap = wrapper - , pat_arg_tys = tys + { cpt_tvs = tyvars + , cpt_dicts = evs + , cpt_binds = binds + , cpt_wrap = wrapper + , cpt_arg_tys = tys }) }) = ASSERT( all isImmutableTyVar tyvars ) @@ -1404,11 +1404,11 @@ zonk_pat env p@(ConPat { pat_con = L _ con , p { pat_args = new_args , pat_con_ext = p' - { pat_arg_tys = new_tys - , pat_tvs = new_tyvars - , pat_dicts = new_evs - , pat_binds = new_binds - , pat_wrap = new_wrapper + { cpt_arg_tys = new_tys + , cpt_tvs = new_tyvars + , cpt_dicts = new_evs + , cpt_binds = new_binds + , cpt_wrap = new_wrapper } } ) @@ -1454,9 +1454,9 @@ zonk_pat _ pat = pprPanic "zonk_pat" (ppr pat) --------------------------- zonkConStuff :: ZonkEnv - -> HsConDetails (OutPat GhcTcId) (HsRecFields id (OutPat GhcTcId)) + -> HsConDetails (LPat GhcTc) (HsRecFields id (LPat GhcTc)) -> TcM (ZonkEnv, - HsConDetails (OutPat GhcTc) (HsRecFields id (OutPat GhcTc))) + HsConDetails (LPat GhcTc) (HsRecFields id (LPat GhcTc))) zonkConStuff env (PrefixCon pats) = do { (env', pats') <- zonkPats env pats ; return (env', PrefixCon pats') } @@ -1475,7 +1475,7 @@ zonkConStuff env (RecCon (HsRecFields rpats dd)) -- Field selectors have declared types; hence no zonking --------------------------- -zonkPats :: ZonkEnv -> [OutPat GhcTcId] -> TcM (ZonkEnv, [OutPat GhcTc]) +zonkPats :: ZonkEnv -> [LPat GhcTc] -> TcM (ZonkEnv, [LPat GhcTc]) zonkPats env [] = return (env, []) zonkPats env (pat:pats) = do { (env1, pat') <- zonkPat env pat ; (env', pats') <- zonkPats env1 pats ===================================== compiler/typecheck/TcPat.hs ===================================== @@ -495,7 +495,7 @@ tc_pat penv (SumPat _ pat alt arity ) pat_ty thing_inside ------------------------ -- Data constructors -tc_pat penv (ConPat con arg_pats NoExtField) pat_ty thing_inside +tc_pat penv (ConPat NoExtField con arg_pats) pat_ty thing_inside = tcConPat penv con pat_ty arg_pats thing_inside ------------------------ @@ -789,10 +789,10 @@ tcDataConPat penv (L con_span con_name) data_con pat_ty ; let res_pat = ConPat { pat_con = header , pat_args = arg_pats' , pat_con_ext = ConPatTc - { pat_tvs = [], pat_dicts = [] - , pat_binds = emptyTcEvBinds - , pat_arg_tys = ctxt_res_tys - , pat_wrap = idHsWrapper + { cpt_tvs = [], cpt_dicts = [] + , cpt_binds = emptyTcEvBinds + , cpt_arg_tys = ctxt_res_tys + , cpt_wrap = idHsWrapper } } @@ -827,11 +827,11 @@ tcDataConPat penv (L con_span con_name) data_con pat_ty { pat_con = header , pat_args = arg_pats' , pat_con_ext = ConPatTc - { pat_tvs = ex_tvs' - , pat_dicts = given - , pat_binds = ev_binds - , pat_arg_tys = ctxt_res_tys - , pat_wrap = idHsWrapper + { cpt_tvs = ex_tvs' + , cpt_dicts = given + , cpt_binds = ev_binds + , cpt_arg_tys = ctxt_res_tys + , cpt_wrap = idHsWrapper } } ; return (mkHsWrapPat wrap res_pat pat_ty, res) @@ -881,11 +881,11 @@ tcPatSynPat penv (L con_span _) pat_syn pat_ty arg_pats thing_inside ; let res_pat = ConPat { pat_con = L con_span $ PatSynCon pat_syn , pat_args = arg_pats' , pat_con_ext = ConPatTc - { pat_tvs = ex_tvs' - , pat_dicts = prov_dicts' - , pat_binds = ev_binds - , pat_arg_tys = mkTyVarTys univ_tvs' - , pat_wrap = req_wrap + { cpt_tvs = ex_tvs' + , cpt_dicts = prov_dicts' + , cpt_binds = ev_binds + , cpt_arg_tys = mkTyVarTys univ_tvs' + , cpt_wrap = req_wrap } } ; pat_ty <- readExpType pat_ty ===================================== compiler/typecheck/TcPatSyn.hs ===================================== @@ -942,7 +942,7 @@ tcPatToExpr name args pat = go pat go (L loc p) = L loc <$> go1 p go1 :: Pat GhcRn -> Either MsgDoc (HsExpr GhcRn) - go1 (ConPat con info NoExtField) + go1 (ConPat NoExtField con info) = case info of PrefixCon ps -> mkPrefixConExpr con ps InfixCon l r -> mkPrefixConExpr con [l,r] @@ -1127,7 +1127,7 @@ tcCollectEx pat = go pat go1 (SumPat _ p _ _) = go p go1 (ViewPat _ _ p) = go p go1 con at ConPat{ pat_con_ext = con' } - = merge (pat_tvs con', pat_dicts con') $ + = merge (cpt_tvs con', cpt_dicts con') $ goConDetails $ pat_args con go1 (SigPat _ p _) = go p go1 (XPat (CoPat _ p _)) = go1 p ===================================== compiler/typecheck/TcTyClsDecls.hs ===================================== @@ -2195,9 +2195,9 @@ tcDefaultAssocDecl fam_tc , text "pats" <+> ppr pats , text "rhs_ty" <+> ppr rhs_ty ]) - ; pat_tvs <- zipWithM (extract_tv ppr_eqn) pats pats_vis - ; check_all_distinct_tvs ppr_eqn $ zip pat_tvs pats_vis - ; let subst = zipTvSubst pat_tvs (mkTyVarTys fam_tvs) + ; cpt_tvs <- zipWithM (extract_tv ppr_eqn) pats pats_vis + ; check_all_distinct_tvs ppr_eqn $ zip cpt_tvs pats_vis + ; let subst = zipTvSubst cpt_tvs (mkTyVarTys fam_tvs) ; pure $ Just (substTyUnchecked subst rhs_ty, loc) -- We also perform other checks for well-formedness and validity -- later, in checkValidClass @@ -2234,8 +2234,8 @@ tcDefaultAssocDecl fam_tc -- visibilities (the latter are only used for error -- message purposes) -> TcM () - check_all_distinct_tvs ppr_eqn pat_tvs_vis = - let dups = findDupsEq ((==) `on` fst) pat_tvs_vis in + check_all_distinct_tvs ppr_eqn cpt_tvs_vis = + let dups = findDupsEq ((==) `on` fst) cpt_tvs_vis in traverse_ (\d -> let (pat_tv, pat_vis) = NE.head d in failWithTc $ pprWithExplicitKindsWhen (isInvisibleArgFlag pat_vis) $ ===================================== compiler/typecheck/TcTyDecls.hs ===================================== @@ -895,7 +895,7 @@ mkOneRecordSelector all_cons idDetails fl mk_match con = mkSimpleMatch (mkPrefixFunRhs sel_lname) [L loc (mk_sel_pat con)] (L loc (HsVar noExtField (L loc field_var))) - mk_sel_pat con = ConPat (L loc (getName con)) (RecCon rec_fields) NoExtField + mk_sel_pat con = ConPat NoExtField (L loc (getName con)) (RecCon rec_fields) rec_fields = HsRecFields { rec_flds = [rec_field], rec_dotdot = Nothing } rec_field = noLoc (HsRecField { hsRecFieldLbl ===================================== compiler/typecheck/TcValidity.hs ===================================== @@ -2155,8 +2155,8 @@ checkFamPatBinders fam_tc qtvs pats rhs , ppr (mkTyConApp fam_tc pats) , text "qtvs:" <+> ppr qtvs , text "rhs_tvs:" <+> ppr (fvVarSet rhs_fvs) - , text "pat_tvs:" <+> ppr pat_tvs - , text "inj_pat_tvs:" <+> ppr inj_pat_tvs ] + , text "cpt_tvs:" <+> ppr cpt_tvs + , text "inj_cpt_tvs:" <+> ppr inj_cpt_tvs ] -- Check for implicitly-bound tyvars, mentioned on the -- RHS but not bound on the LHS @@ -2176,23 +2176,23 @@ checkFamPatBinders fam_tc qtvs pats rhs (text "used in") } where - pat_tvs = tyCoVarsOfTypes pats - inj_pat_tvs = fvVarSet $ injectiveVarsOfTypes False pats + cpt_tvs = tyCoVarsOfTypes pats + inj_cpt_tvs = fvVarSet $ injectiveVarsOfTypes False pats -- The type variables that are in injective positions. -- See Note [Dodgy binding sites in type family instances] -- NB: The False above is irrelevant, as we never have type families in -- patterns. -- -- NB: It's OK to use the nondeterministic `fvVarSet` function here, - -- since the order of `inj_pat_tvs` is never revealed in an error + -- since the order of `inj_cpt_tvs` is never revealed in an error -- message. rhs_fvs = tyCoFVsOfType rhs - used_tvs = pat_tvs `unionVarSet` fvVarSet rhs_fvs + used_tvs = cpt_tvs `unionVarSet` fvVarSet rhs_fvs bad_qtvs = filterOut (`elemVarSet` used_tvs) qtvs -- Bound but not used at all - bad_rhs_tvs = filterOut (`elemVarSet` inj_pat_tvs) (fvVarList rhs_fvs) + bad_rhs_tvs = filterOut (`elemVarSet` inj_cpt_tvs) (fvVarList rhs_fvs) -- Used on RHS but not bound on LHS - dodgy_tvs = pat_tvs `minusVarSet` inj_pat_tvs + dodgy_tvs = cpt_tvs `minusVarSet` inj_cpt_tvs check_tvs tvs what what2 = unless (null tvs) $ addErrAt (getSrcSpan (head tvs)) $ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2bb83e98b5d4f49475f1ddf79c10d5ed91061082 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2bb83e98b5d4f49475f1ddf79c10d5ed91061082 You're receiving 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 Mar 27 20:41:16 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 27 Mar 2020 16:41:16 -0400 Subject: [Git][ghc/ghc][wip/zap-coercions] 2 commits: Rules: Match UnivCos Message-ID: <5e7e64ecc3de5_61673f8198ee100c102091f@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/zap-coercions at Glasgow Haskell Compiler / GHC Commits: 8711a4f8 by Ben Gamari at 2020-03-27T14:45:35-04:00 Rules: Match UnivCos - - - - - 6a41b6b1 by Ben Gamari at 2020-03-27T16:38:25-04:00 Fix it - - - - - 12 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/IfaceToCore.hs - compiler/typecheck/TcFlatten.hs - compiler/typecheck/TcMType.hs Changes: ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -43,7 +43,10 @@ module GHC.Core.Coercion ( mkKindCo, castCoercionKind, castCoercionKindI, -- -- ** Zapping coercions - mkZappedCoercion, zapCoercion, + + mkZappedCo, mkTcZappedCo, + mkZappedProv, mkTcZappedProv, + perhapsZapCoercion, zapCoercion, mkHeteroCoercionType, mkPrimEqPred, mkReprPrimEqPred, mkPrimEqPredRole, @@ -62,6 +65,7 @@ module GHC.Core.Coercion ( splitFunCo_maybe, splitForAllCo_maybe, splitForAllCo_ty_maybe, splitForAllCo_co_maybe, + splitUnivCo_maybe, nthRole, tyConRolesX, tyConRolesRepresentational, setNominalRole_maybe, @@ -478,6 +482,10 @@ splitForAllCo_co_maybe (ForAllCo cv k_co co) | isCoVar cv = Just (cv, k_co, co) splitForAllCo_co_maybe _ = Nothing +splitUnivCo_maybe :: Coercion -> Maybe (UnivCoProvenance, Role, Pair Type) +splitUnivCo_maybe (UnivCo prov r t1 t2) = Just (prov, r, Pair t1 t2) +splitUnivCo_maybe _ = Nothing + ------------------------------------------------------- -- and some coercion kind stuff @@ -980,12 +988,12 @@ mkTransCo co1 co2 | isReflCo co1 = co2 mkTransCo (GRefl r t1 (MCo co1)) (GRefl _ _ (MCo co2)) = GRefl r t1 (MCo $ mkTransCo co1 co2) mkTransCo (UnivCo (ZappedProv fvs1) r t1a _t1b) (UnivCo (ZappedProv fvs2) _ _t2a t2b) - = UnivCo (ZappedProv (fvs1 `unionDVarSet` fvs2)) r t1a t2b + = UnivCo (mkZappedProv (fvs1 `unionDVarSet` fvs2)) r t1a t2b mkTransCo (UnivCo (ZappedProv fvs) r t1a _t1b) co2 - = UnivCo (ZappedProv (fvs `unionDVarSet` tyCoVarsOfCoDSet co2)) r t1a t2b + = UnivCo (mkZappedProv (fvs `unionDVarSet` tyCoVarsOfCoDSet co2)) r t1a t2b where Pair _t2a t2b = coercionKind co2 mkTransCo co1 (UnivCo (ZappedProv fvs) r _t2a t2b) - = UnivCo (ZappedProv (fvs `unionDVarSet` tyCoVarsOfCoDSet co1)) r t1a t2b + = UnivCo (mkZappedProv (fvs `unionDVarSet` tyCoVarsOfCoDSet co1)) r t1a t2b where Pair t1a _t1b = coercionKind co1 mkTransCo co1 co2 = TransCo co1 co2 @@ -1737,23 +1745,59 @@ keyword): -} +mkZappedProv :: HasDebugCallStack + => DTyCoVarSet + -> UnivCoProvenance +mkZappedProv fvs + -- | debugIsOn && anyDVarSet isCoercionHole fvs = pprPanic "mkZappedProv(unexpected cohole)" (ppr fvs) + | otherwise = + ZappedProv $ filterDVarSet (not . isCoercionHole) fvs + +mkTcZappedProv :: HasDebugCallStack + => DTyCoVarSet + -> [CoercionHole] + -> UnivCoProvenance +mkTcZappedProv fvs coholes + | debugIsOn && anyDVarSet isCoercionHole fvs = + pprPanic "mkTcZappedProv(unexpected cohole)" (ppr fvs) + | otherwise = + TcZappedProv (filterDVarSet (not . isCoercionHole) fvs) coholes + +-- | Smart constructor for 'TcZappedProv' 'UnivCo's. +mkTcZappedCo :: HasDebugCallStack + => Pair Type + -> Role + -> DTyCoVarSet + -> [CoercionHole] + -> Coercion +mkTcZappedCo (Pair ty1 ty2) role fvs coholes + = mkUnivCo (mkTcZappedProv fvs coholes) role ty1 ty2 + +-- | Smart constructor for 'ZappedProv' 'UnivCo's. +mkZappedCo :: HasDebugCallStack + => Pair Type + -> Role + -> DTyCoVarSet + -> Coercion +mkZappedCo (Pair ty1 ty2) role fvs = + mkUnivCo (mkZappedProv fvs) role ty1 ty2 + -- | Make a zapped coercion if building of coercions is disabled, otherwise -- return the given un-zapped coercion. -mkZappedCoercion :: HasDebugCallStack - => DynFlags - -> Coercion -- ^ the un-zapped coercion - -> Pair Type -- ^ the kind of the coercion - -> Role -- ^ the role of the coercion - -> DTyCoVarSet -- ^ the free variables of the coercion - -> Coercion -mkZappedCoercion dflags co (Pair ty1 ty2) role fvs +perhapsZapCoercion :: HasDebugCallStack + => DynFlags + -> Coercion -- ^ the un-zapped coercion + -> Pair Type -- ^ the kind of the coercion + -> Role -- ^ the role of the coercion + -> DTyCoVarSet -- ^ the free variables of the coercion + -> Coercion +perhapsZapCoercion dflags co pair@(Pair ty1 ty2) role fvs | debugIsOn && real_role /= role = - pprPanic "mkZappedCoercion(roles mismatch)" panic_doc + pprPanic "perhapsZapCoercion(roles mismatch)" panic_doc | debugIsOn && not co_kind_ok = - pprPanic "mkZappedCoercion(kind mismatch)" panic_doc + pprPanic "perhapsZapCoercion(kind mismatch)" panic_doc | shouldBuildCoercions dflags = co - | otherwise = - mkUnivCo (ZappedProv fvs) role ty1 ty2 + | otherwise = mkZappedCo pair role fvs where (Pair real_ty1 real_ty2, real_role) = coercionKindRole co real_fvs = tyCoVarsOfCoDSet co @@ -1781,7 +1825,7 @@ zapCoercion :: DynFlags -> Coercion -> Coercion zapCoercion _ co@(UnivCo (ZappedProv _) _ _ _) = co -- already zapped zapCoercion _ co@(Refl _) = co -- Refl is smaller than zapped coercions zapCoercion dflags co = - mkZappedCoercion dflags co (Pair t1 t2) role fvs + perhapsZapCoercion dflags co (Pair t1 t2) role fvs where (Pair t1 t2, role) = coercionKindRole co fvs = filterDVarSet (not . isCoercionHole) $ tyCoVarsOfCoDSet co ===================================== compiler/GHC/Core/Coercion.hs-boot ===================================== @@ -9,7 +9,9 @@ import {-# SOURCE #-} GHC.Core.TyCon import BasicTypes ( LeftOrRight ) import GHC.Core.Coercion.Axiom +import GHC.Core.TyCo.Rep (CoercionHole) import Var +import VarSet import Pair import Util @@ -41,6 +43,9 @@ decomposePiCos :: HasDebugCallStack => Coercion -> Pair Type -> [Type] -> ([Coer coVarKindsTypesRole :: HasDebugCallStack => CoVar -> (Kind, Kind, Type, Type, Role) coVarRole :: CoVar -> Role +mkZappedProv :: HasDebugCallStack => DTyCoVarSet -> UnivCoProvenance +mkTcZappedProv :: HasDebugCallStack => DTyCoVarSet -> [CoercionHole] -> UnivCoProvenance + mkCoercionType :: Role -> Type -> Type -> Type data LiftingContext ===================================== compiler/GHC/Core/Coercion/Opt.hs ===================================== @@ -499,17 +499,17 @@ opt_univ env sym (PhantomProv h) _r ty1 ty2 ty2' = substTy (lcSubstRight env) ty2 opt_univ env sym (ZappedProv fvs) role ty1 ty2 - | sym = mkUnivCo (ZappedProv fvs') role ty2' ty1' - | otherwise = mkUnivCo (ZappedProv fvs') role ty1' ty2' + = mkZappedCo pair role fvs' where + pair = if sym then Pair ty2' ty1' else Pair ty1' ty2' ty1' = substTy (lcSubstLeft env) ty1 ty2' = substTy (lcSubstRight env) ty2 fvs' = substFreeDVarSet (lcTCvSubst env) fvs opt_univ env sym (TcZappedProv fvs coholes) role ty1 ty2 - | sym = mkUnivCo (TcZappedProv fvs' coholes) role ty2' ty1' - | otherwise = mkUnivCo (TcZappedProv fvs' coholes) role ty1' ty2' + = mkTcZappedCo pair role fvs' coholes where + pair = if sym then Pair ty2' ty1' else Pair ty1' ty2' ty1' = substTy (lcSubstLeft env) ty1 ty2' = substTy (lcSubstRight env) ty2 fvs' = substFreeDVarSet (lcTCvSubst env) fvs @@ -573,9 +573,9 @@ opt_univ env sym prov role oty1 oty2 PhantomProv kco -> PhantomProv $ opt_co4_wrap env sym False Nominal kco ProofIrrelProv kco -> ProofIrrelProv $ opt_co4_wrap env sym False Nominal kco PluginProv _ -> prov - ZappedProv fvs -> ZappedProv $ substFreeDVarSet (lcTCvSubst env) fvs + ZappedProv fvs -> mkZappedProv $ substFreeDVarSet (lcTCvSubst env) fvs TcZappedProv fvs coholes - -> TcZappedProv (substFreeDVarSet (lcTCvSubst env) fvs) coholes + -> mkTcZappedProv (substFreeDVarSet (lcTCvSubst env) fvs) coholes ------------- opt_transList :: InScopeSet -> [NormalCo] -> [NormalCo] -> [NormalCo] @@ -658,10 +658,10 @@ opt_trans_rule is in_co1@(UnivCo p1 r1 tyl1 _tyr1) = Just $ ProofIrrelProv $ opt_trans is kco1 kco2 opt_trans_prov (PluginProv str1) (PluginProv str2) | str1 == str2 = Just p1 opt_trans_prov (ZappedProv fvs1) (ZappedProv fvs2) - = Just $ ZappedProv $ fvs1 `unionDVarSet` fvs2 + = Just $ mkZappedProv $ fvs1 `unionDVarSet` fvs2 opt_trans_prov (TcZappedProv fvs1 coholes1) (TcZappedProv fvs2 coholes2) - = Just $ TcZappedProv (fvs1 `unionDVarSet` fvs2) (coholes1 ++ coholes2) + = Just $ mkTcZappedProv (fvs1 `unionDVarSet` fvs2) (coholes1 ++ coholes2) opt_trans_prov _ _ = Nothing -- Push transitivity down through matching top-level constructors. ===================================== compiler/GHC/Core/Rules.hs ===================================== @@ -63,6 +63,7 @@ import Outputable import FastString import Maybes import Bag +import Pair import Util import Data.List import Data.Ord @@ -840,6 +841,14 @@ match_co renv subst co1 co2 Just (arg2, res2) -> match_cos renv subst [arg1, res1] [arg2, res2] _ -> Nothing +match_co renv subst co1 co2 + | Just (prov1, r1, Pair ty1a ty1b) <- splitUnivCo_maybe co1 + , Just (prov2, r2, Pair ty2a ty2b) <- splitUnivCo_maybe co2 + = do { guard (r1 == r2) + -- TODO: Should we try to match provenance? + ; subst' <- match_ty renv subst ty1a ty2a + ; match_ty renv subst' ty1b ty2b + } match_co _ _ _co1 _co2 -- Currently just deals with CoVarCo, TyConAppCo and Refl #if defined(DEBUG) ===================================== compiler/GHC/Core/TyCo/Rep.hs ===================================== @@ -1875,7 +1875,7 @@ foldTyCo (TyCoFolder { tcf_view = view where f v acc | isTyVar v = tyvar env v `mappend` acc | isCoVar v = covar env v `mappend` acc - | otherwise = error "unknown thingy" + | otherwise = pprPanic "unknown thingy" (ppr v) {- ********************************************************************* * * ===================================== compiler/GHC/Core/TyCo/Subst.hs ===================================== @@ -64,7 +64,7 @@ import {-# SOURCE #-} GHC.Core.Coercion , mkFunCo, mkForAllCo, mkUnivCo , mkAxiomInstCo, mkAppCo, mkGReflCo , mkInstCo, mkLRCo, mkTyConAppCo - , mkCoercionType + , mkCoercionType, mkZappedProv, mkTcZappedProv , coercionKind, coercionLKind, coVarKindsTypesRole ) import GHC.Core.TyCo.Rep @@ -825,9 +825,9 @@ subst_co subst co go_prov (PhantomProv kco) = PhantomProv (go kco) go_prov (ProofIrrelProv kco) = ProofIrrelProv (go kco) go_prov p@(PluginProv _) = p - go_prov (ZappedProv fvs) = ZappedProv (substFreeDVarSet subst fvs) + go_prov (ZappedProv fvs) = mkZappedProv (substFreeDVarSet subst fvs) go_prov (TcZappedProv fvs coholes) - = TcZappedProv (substFreeDVarSet subst fvs) coholes + = mkTcZappedProv (substFreeDVarSet subst fvs) coholes -- See Note [Substituting in a coercion hole] go_hole h@(CoercionHole { ch_co_var = cv }) ===================================== compiler/GHC/Core/TyCo/Tidy.hs ===================================== @@ -21,6 +21,7 @@ module GHC.Core.TyCo.Tidy import GhcPrelude import GHC.Core.TyCo.Rep +import {-# SOURCE #-} GHC.Core.Coercion ( mkZappedProv, mkTcZappedProv ) import GHC.Core.TyCo.FVs (tyCoVarsOfTypesWellScoped, tyCoVarsOfTypeList) import Name hiding (varName) @@ -230,10 +231,10 @@ tidyCo env@(_, subst) co go_prov (PhantomProv co) = PhantomProv (go co) go_prov (ProofIrrelProv co) = ProofIrrelProv (go co) go_prov p@(PluginProv _) = p - go_prov (ZappedProv fvs) = ZappedProv $ mapUnionDVarSet (unitDVarSet . substCoVar) (dVarSetElems fvs) + go_prov (ZappedProv fvs) = mkZappedProv $ mapUnionDVarSet (unitDVarSet . substCoVar) (dVarSetElems fvs) go_prov (TcZappedProv fvs coholes) - = TcZappedProv (mapUnionDVarSet (unitDVarSet . substCoVar) (dVarSetElems fvs)) - coholes -- Tidying needed? + = mkTcZappedProv (mapUnionDVarSet (unitDVarSet . substCoVar) (dVarSetElems fvs)) + coholes -- Tidying needed? substCoVar cv = fromMaybe cv $ lookupVarEnv subst cv ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -254,6 +254,7 @@ import {-# SOURCE #-} GHC.Core.Coercion , mkForAllCo, mkFunCo, mkAxiomInstCo, mkUnivCo , mkSymCo, mkTransCo, mkNthCo, mkLRCo, mkInstCo , mkKindCo, mkSubCo, mkFunCo, mkAxiomInstCo + , mkZappedProv, mkTcZappedProv , decomposePiCos, coercionKind, coercionLKind , coercionRKind, coercionType , isReflexiveCo, seqCo ) @@ -475,9 +476,9 @@ expandTypeSynonyms ty go_prov subst (ProofIrrelProv co) = ProofIrrelProv (go_co subst co) go_prov _ p@(PluginProv _) = p go_prov subst (ZappedProv fvs) - = ZappedProv $ substFreeDVarSet subst fvs + = mkZappedProv $ substFreeDVarSet subst fvs go_prov subst (TcZappedProv fvs coholes) - = TcZappedProv (substFreeDVarSet subst fvs) coholes + = mkTcZappedProv (substFreeDVarSet subst fvs) coholes -- the "False" and "const" are to accommodate the type of -- substForAllCoBndrUsing, which is general enough to @@ -721,21 +722,18 @@ mapTyCoX (TyCoMapper { tcm_tyvar = tyvar go_prov env (ProofIrrelProv co) = ProofIrrelProv <$> go_co env co go_prov _ p@(PluginProv _) = return p go_prov env (ZappedProv fvs) - = let bndrFVs v - | isCoVar v = tyCoVarsOfCoDSet <$> covar env v - | isTyVar v = tyCoVarsOfTypeDSet <$> tyvar env v - | otherwise = pprPanic "mapCoercion(ZappedProv): Bad free variable" (ppr v) - in do fvs' <- unionDVarSets <$> mapM bndrFVs (dVarSetElems fvs) - return $ ZappedProv fvs' + = do { fvs' <- unionDVarSets <$> mapM (bndr_fvs env) (dVarSetElems fvs) + ; return $ mkZappedProv fvs' } go_prov env (TcZappedProv fvs coholes) - = let bndrFVs v - | isCoVar v = tyCoVarsOfCoDSet <$> covar env v - | isTyVar v = tyCoVarsOfTypeDSet <$> tyvar env v - | otherwise = pprPanic "mapCoercion(TcZappedProv): Bad free variable" (ppr v) - in do fvs' <- unionDVarSets <$> mapM bndrFVs (dVarSetElems fvs) - coholes' <- mapM (cohole env) coholes - let fvs'' = mapUnionDVarSet tyCoVarsOfCoDSet coholes' - return $ ZappedProv $ fvs' `unionDVarSet` fvs'' + = do { fvs' <- unionDVarSets <$> mapM (bndr_fvs env) (dVarSetElems fvs) + ; coholes' <- mapM (cohole env) coholes + ; let fvs'' = mapUnionDVarSet tyCoVarsOfCoDSet coholes' + ; return $ mkZappedProv $ fvs' `unionDVarSet` fvs'' } + + bndr_fvs env v + | isCoVar v = tyCoVarsOfCoDSet <$> covar env v + | isTyVar v = tyCoVarsOfTypeDSet <$> tyvar env v + | otherwise = pprPanic "mapCoercion(ZappedProv): Bad free variable" (ppr v) {- ************************************************************************ ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -1191,7 +1191,7 @@ data RtsOptsEnabled -- See Note [Zapping coercions] for details. shouldBuildCoercions :: DynFlags -> Bool shouldBuildCoercions dflags = - gopt Opt_DoCoreLinting dflags && not (gopt Opt_DropCoercions dflags) + not (gopt Opt_DropCoercions dflags) -- && gopt Opt_DoCoreLinting dflags -- TODO: Add flag to explicitly enable coercion generation without linting? -- | Are we building with @-fPIE@ or @-fPIC@ enabled? ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -1260,7 +1260,7 @@ tcIfaceUnivCoProv (IfacePluginProv str) = return $ PluginProv str tcIfaceUnivCoProv (IfaceZappedProv tvs cvs _) = do cvs' <- mapM tcIfaceLclId cvs tvs' <- mapM tcIfaceTyVar tvs - return $ ZappedProv $ mkDVarSet $ cvs' ++ tvs' + return $ mkZappedProv $ mkDVarSet $ cvs' ++ tvs' {- ************************************************************************ ===================================== compiler/typecheck/TcFlatten.hs ===================================== @@ -1511,7 +1511,7 @@ flatten_exact_fam_app_fully tc tys co' = mkTcCoherenceLeftCo role xi kind_co (mkSymCo co) co'_kind = Pair xi' fam_ty -- co' :: (xi |> kind_co) ~role fam_ty - co'' = update_co $ mkZappedCoercion dflags co' co'_kind role fvs + co'' = update_co $ perhapsZapCoercion dflags co' co'_kind role fvs --co'' = update_co co' ; return $ Just (xi', co'') } Nothing -> pure Nothing } @@ -1536,7 +1536,7 @@ flatten_exact_fam_app_fully tc tys ; let role = eqRelRole eq_rel ; let co = mkSymCo (maybeTcSubCo eq_rel norm_co `mkTransCo` mkSymCo final_co) - co' = mkZappedCoercion dflags co (Pair xi fam_ty) role fvs + co' = perhapsZapCoercion dflags co (Pair xi fam_ty) role fvs --co' = co ; return $ Just (xi, co') } Nothing -> pure Nothing } ===================================== compiler/typecheck/TcMType.hs ===================================== @@ -113,6 +113,7 @@ import TcRnMonad -- TcType, amongst others import Constraint import TcEvidence import Id +import IdInfo (IdDetails(CoercionHoleId)) import Name import VarSet import TysWiredIn @@ -328,7 +329,7 @@ newCoercionHole :: BlockSubstFlag -- should the presence of this hole block sub -- Note [Equalities with incompatible kinds] -> TcPredType -> TcM CoercionHole newCoercionHole blocker pred_ty - = do { co_var <- newEvVar pred_ty + = do { co_var <- fmap (`setIdDetails` CoercionHoleId) (newEvVar pred_ty) ; traceTc "New coercion hole:" (ppr co_var <+> ppr blocker) ; ref <- newMutVar Nothing ; return $ CoercionHole { ch_co_var = co_var, ch_blocker = blocker View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/81578d45f7bb2cc84d153c8152a1e8faa9fd53b5...6a41b6b1fc23f2d0251cf7da634e9453a20810d0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/81578d45f7bb2cc84d153c8152a1e8faa9fd53b5...6a41b6b1fc23f2d0251cf7da634e9453a20810d0 You're receiving 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 Mar 27 21:23:53 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Fri, 27 Mar 2020 17:23:53 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/strict-NoExtCon Message-ID: <5e7e6ee9e5550_6167e6514b410307e5@gitlab.haskell.org.mail> Ryan Scott pushed new branch wip/strict-NoExtCon at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/strict-NoExtCon You're receiving 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 Mar 27 21:42:49 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 27 Mar 2020 17:42:49 -0400 Subject: [Git][ghc/ghc][wip/zap-coercions] Fix it Message-ID: <5e7e7359c3a9a_6167e6514b41030962@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/zap-coercions at Glasgow Haskell Compiler / GHC Commits: 1e047402 by Ben Gamari at 2020-03-27T17:42:41-04:00 Fix it - - - - - 1 changed file: - compiler/GHC/Core/Rules.hs Changes: ===================================== compiler/GHC/Core/Rules.hs ===================================== @@ -842,8 +842,8 @@ match_co renv subst co1 co2 -> match_cos renv subst [arg1, res1] [arg2, res2] _ -> Nothing match_co renv subst co1 co2 - | Just (prov1, r1, Pair ty1a ty1b) <- splitUnivCo_maybe co1 - , Just (prov2, r2, Pair ty2a ty2b) <- splitUnivCo_maybe co2 + | Just (_prov1, r1, Pair ty1a ty1b) <- splitUnivCo_maybe co1 + , Just (_prov2, r2, Pair ty2a ty2b) <- splitUnivCo_maybe co2 = do { guard (r1 == r2) -- TODO: Should we try to match provenance? ; subst' <- match_ty renv subst ty1a ty2a View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1e047402d6a59813461d7941338af6cfb574f252 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1e047402d6a59813461d7941338af6cfb574f252 You're receiving 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 Mar 28 01:00:38 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 27 Mar 2020 21:00:38 -0400 Subject: [Git][ghc/ghc][wip/zap-coercions] 3 commits: Fix warnings Message-ID: <5e7ea1b656a9b_61674f59d90104577d@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/zap-coercions at Glasgow Haskell Compiler / GHC Commits: ab19a41e by Ben Gamari at 2020-03-27T19:37:23-04:00 Fix warnings - - - - - f584d409 by Ben Gamari at 2020-03-27T19:37:51-04:00 Improve documentation of Coercion - - - - - d56d6691 by Ben Gamari at 2020-03-27T19:38:11-04:00 Handle mkNthCo of zapped coercions - - - - - 3 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/TyCo/Rep.hs Changes: ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -1069,6 +1069,16 @@ mkNthCo r n co , ppr r ]) ) arg_cos `getNth` n + go r 0 co@(UnivCo prov _ ty1 ty2) + | isForAllTy ty1 + = ASSERT(isForAllTy ty2) + UnivCo prov r (typeKind ty1) (typeKind ty2) + go r n co@(UnivCo prov _ ty1 ty2) + | (_, ts1) <- splitAppTys ty1 + , (_, ts2) <- splitAppTys ty2 + = ASSERT2(ts1 `lengthAtLeast` succ n && ts1 `lengthAtLeast` succ n, ppr n $$ ppr co) + UnivCo prov r (ts1 !! n) (ts2 !! n) + go r n co = NthCo r n co ===================================== compiler/GHC/Core/Coercion.hs-boot ===================================== @@ -4,12 +4,11 @@ module GHC.Core.Coercion where import GhcPrelude -import {-# SOURCE #-} GHC.Core.TyCo.Rep import {-# SOURCE #-} GHC.Core.TyCon import BasicTypes ( LeftOrRight ) import GHC.Core.Coercion.Axiom -import GHC.Core.TyCo.Rep (CoercionHole) +import GHC.Core.TyCo.Rep import Var import VarSet import Pair ===================================== compiler/GHC/Core/TyCo/Rep.hs ===================================== @@ -1027,6 +1027,7 @@ data Coercion -- These ones mirror the shape of types = -- Refl :: _ -> N + -- Refl a :: a ~_N a Refl Type -- See Note [Refl invariant] -- Invariant: applications of (Refl T) to a bunch of identity coercions -- always show up as Refl. @@ -1041,6 +1042,7 @@ data Coercion -- Use (GRefl Representational ty MRefl), not (SubCo (Refl ty)) -- GRefl :: "e" -> _ -> Maybe N -> e + -- GRefl r a (Just r') :: a ~_r' a -- See Note [Generalized reflexive coercion] | GRefl Role Type MCoercionN -- See Note [Refl invariant] -- Use (Refl ty), not (GRefl Nominal ty MRefl) @@ -1050,6 +1052,8 @@ data Coercion -- Type constructors into Coercions -- TyConAppCo :: "e" -> _ -> ?? -> e + -- TyConAppCo r tc [co1 :: a1 ~_r b1, ..., coN :: aN ~_r bN] + -- :: (tc a1 ... aN ~_r tc b1 ... bN) -- See Note [TyConAppCo roles] | TyConAppCo Role TyCon [Coercion] -- lift TyConApp -- The TyCon is never a synonym; @@ -1059,13 +1063,20 @@ data Coercion | AppCo Coercion CoercionN -- lift AppTy -- AppCo :: e -> N -> e + -- AppCo (co1 :: a1 ~_r b1) (co2 :: a2 ~_N b2) + -- :: (a1 a2) ~_r (b1 b2) -- See Note [Forall coercions] | ForAllCo TyCoVar KindCoercion Coercion -- ForAllCo :: _ -> N -> e -> e + -- ForAllCo v (kco :: k1 ~_N m1) (co :: a ~_r b) + -- :: (forall (v :: k1). a) ~_r (forall (v :: m1). b) | FunCo Role Coercion Coercion -- lift FunTy -- FunCo :: "e" -> e -> e -> e + -- FunCo r (co1 :: a1 ~_r b1) (co2 :: a2 ~_r b2) + -- :: (a1 -> a2) ~_r (b1 -> b2) + -- -- Note: why doesn't FunCo have a AnonArgFlag, like FunTy? -- Because the AnonArgFlag has no impact on Core; it is only -- there to guide implicit instantiation of Haskell source @@ -1073,8 +1084,11 @@ data Coercion -- Core-only. -- These are special - | CoVarCo CoVar -- :: _ -> (N or R) - -- result role depends on the tycon of the variable's type + | CoVarCo CoVar + -- CoVarCo :: _ -> (N or R) + -- CoVarCo (v :: a ~_r b) + -- :: a ~_r b + -- result role depends on the tycon of the variable's type -- AxiomInstCo :: e -> _ -> ?? -> e | AxiomInstCo (CoAxiom Branched) BranchIndex [Coercion] @@ -1094,11 +1108,20 @@ data Coercion | UnivCo UnivCoProvenance Role Type Type -- :: _ -> "e" -> _ -> _ -> e - | SymCo Coercion -- :: e -> e - | TransCo Coercion Coercion -- :: e -> e -> e + | SymCo Coercion + -- SymCo :: e -> e + -- SymCo (co :: a ~_r b) + -- :: b ~_r a + + | TransCo Coercion Coercion + -- TransCo :: e -> e -> e + -- TransCo (co1 :: a ~_r b) (co2 :: b ~_r c) + -- :: a ~_r c | NthCo Role Int Coercion -- Zero-indexed; decomposes (T t0 ... tn) -- :: "e" -> _ -> e0 -> e (inverse of TyConAppCo, see Note [TyConAppCo roles]) + -- NthCo r i (co :: (T t_0 ... t_n) ~_r (U u_1 ... u_n) + -- :: t_i ~_r u_i -- Using NthCo on a ForAllCo gives an N coercion always -- See Note [NthCo and newtypes] -- @@ -1108,17 +1131,26 @@ data Coercion | LRCo LeftOrRight CoercionN -- Decomposes (t_left t_right) -- :: _ -> N -> N + -- LRCo Left (co :: (a1 b1 ~_r a2 b2)) + -- :: a1 ~_r a2 | InstCo Coercion CoercionN -- :: e -> N -> e + -- InstCo (co1 :: forall (a1::k). b1 ~_r forall (a2::k). b2)) + -- (co2 :: k ~_N k') + -- :: b1 (a |-> 1) ~_r b2 (a2 |-> s2) -- See Note [InstCo roles] -- Extract a kind coercion from a (heterogeneous) type coercion -- NB: all kind coercions are Nominal | KindCo Coercion -- :: e -> N + -- KindCo (co :: ((a1 :: k1) ~_r (a2 :: k2))) + -- :: k1 ~_N k2 | SubCo CoercionN -- Turns a ~N into a ~R -- :: N -> R + -- SubCo (co :: (a ~_N b)) + -- :: a ~_R b | HoleCo CoercionHole -- ^ See Note [Coercion holes] -- Only present during typechecking View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1e047402d6a59813461d7941338af6cfb574f252...d56d669130fe16cd790b2c9948ea6535317ec9fb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1e047402d6a59813461d7941338af6cfb574f252...d56d669130fe16cd790b2c9948ea6535317ec9fb You're receiving 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 Mar 28 01:25:11 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 27 Mar 2020 21:25:11 -0400 Subject: [Git][ghc/ghc][wip/zap-coercions] Fix warning Message-ID: <5e7ea777c10e8_616713339fc410492fe@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/zap-coercions at Glasgow Haskell Compiler / GHC Commits: a221cec2 by Ben Gamari at 2020-03-27T21:24:42-04:00 Fix warning - - - - - 1 changed file: - compiler/GHC/Core/Coercion.hs Changes: ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -1069,7 +1069,7 @@ mkNthCo r n co , ppr r ]) ) arg_cos `getNth` n - go r 0 co@(UnivCo prov _ ty1 ty2) + go r 0 (UnivCo prov _ ty1 ty2) | isForAllTy ty1 = ASSERT(isForAllTy ty2) UnivCo prov r (typeKind ty1) (typeKind ty2) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a221cec2bcf576d2d5830999d2074438784fce8a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a221cec2bcf576d2d5830999d2074438784fce8a You're receiving 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 Mar 28 03:26:54 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 27 Mar 2020 23:26:54 -0400 Subject: [Git][ghc/ghc][wip/zap-coercions] Fix haddock Message-ID: <5e7ec3fe7b1e9_6167e0e2c9410512a6@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/zap-coercions at Glasgow Haskell Compiler / GHC Commits: 9a576de4 by Ben Gamari at 2020-03-27T23:26:46-04:00 Fix haddock - - - - - 1 changed file: - compiler/GHC/Core/Coercion.hs Changes: ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -1759,9 +1759,7 @@ mkZappedProv :: HasDebugCallStack => DTyCoVarSet -> UnivCoProvenance mkZappedProv fvs - -- | debugIsOn && anyDVarSet isCoercionHole fvs = pprPanic "mkZappedProv(unexpected cohole)" (ppr fvs) - | otherwise = - ZappedProv $ filterDVarSet (not . isCoercionHole) fvs + = ZappedProv $ filterDVarSet (not . isCoercionHole) fvs mkTcZappedProv :: HasDebugCallStack => DTyCoVarSet View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9a576de4aade27eb0391af5664f7862f2c792577 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9a576de4aade27eb0391af5664f7862f2c792577 You're receiving 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 Mar 28 12:48:14 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Sat, 28 Mar 2020 08:48:14 -0400 Subject: [Git][ghc/ghc][wip/dmdanal-precise-exn] 48 commits: Don't use non-portable operator "==" in configure.ac Message-ID: <5e7f478e98504_616776d1c7410908df@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/dmdanal-precise-exn at Glasgow Haskell Compiler / GHC Commits: 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) - - - - - ac492646 by Sebastian Graf at 2020-03-26T19:01:17+01: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. - - - - - 466e9229 by Sebastian Graf at 2020-03-27T13:00:22+01:00 Preserve precise exceptions in strictness analysis The "IO hack" (which is a fallback to preserve precise exceptions semantics and thus *soundness*, rather than some smart thing that increases *precision*) always was quite hard to understand. That led to a misguided effort to simplify it (!1829), because the Note wasn't particularly clear about what kinds of side-effects it cares about. The implementation seemed to care about preserving precise exception semantics, but failed to deliver for the central case of `raiseIO#` (#17676), which is in stark contrast to one of the motivating examples in the Note (the one about `exitWith ExitSuccess`). This patch rewords the Note to apply to IO actions throwing precise exceptions, rather than all side-effecting IO actions (such as write effects) in general. Also it makes this clear in the implementation by extracting the rather opaque `io_hack_reqd` into `CoreUtils.exprMightThrowPreciseException`. In fact, that alone wasn't enough to fix #17676. It actually turned out to be a duplicate of #13380, for which we had a fix in 7b087aeb, making `catchIO#` have `topDiv` from `botDiv`. But that was reverted on the grounds of regressing dead code elimination too much. In this patch we introduce `exnDiv` for `raiseIO#`, the `defaultDmd` of which acts like `topDiv`s (which was the key point which fixed #13380), but otherwise acts like `botDiv` in terms of dead code elimination. Fixes #13380 and #17676. - - - - - 5ce7b106 by Sebastian Graf at 2020-03-27T13:00:22+01:00 Add ConOrDiv to Divergence and see where it gets us - - - - - 46399b96 by Sebastian Graf at 2020-03-27T13:00:22+01:00 Actually use conDiv - - - - - d976e90f by Sebastian Graf at 2020-03-27T13:00:22+01:00 Attempt to make ensureArgs do the right thing - - - - - 39a6b95e by Sebastian Graf at 2020-03-27T13:00:22+01:00 More pondering over the can of worms I opened - - - - - b0334149 by Sebastian Graf at 2020-03-27T13:00:22+01:00 A bunch of fixes involving the new Divergence lattice - - - - - f4330a23 by Sebastian Graf at 2020-03-27T13:00:22+01:00 typo - - - - - 14566678 by Sebastian Graf at 2020-03-27T13:00:22+01:00 Add strictness signature for a bunch of wired in Ids - - - - - 95522bb3 by Sebastian Graf at 2020-03-27T13:00:23+01:00 Accept a bunch of testcase changes - - - - - e1a34001 by Sebastian Graf at 2020-03-27T13:00:23+01:00 Rename isBot* to isDeadEnd* - - - - - f011a336 by Sebastian Graf at 2020-03-27T13:00:23+01:00 Comments - - - - - 63199442 by Sebastian Graf at 2020-03-27T13:00:23+01:00 Assume that precise exceptions can only be thrown from IO - - - - - cb4f0c6b by Sebastian Graf at 2020-03-27T13:00:23+01:00 Accept new testsuite results - - - - - e6d02e3e by Sebastian Graf at 2020-03-27T15:21:15+01:00 Polish Notes - - - - - 5e894f11 by Sebastian Graf at 2020-03-27T15:39:45+01:00 More comments - - - - - 516987db by Sebastian Graf at 2020-03-28T13:47:58+01:00 Change forcesRealWorld to work like the old IO hack - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/linters/check-cpp.py - compiler/GHC.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Graph.hs - compiler/GHC/Cmm/Info.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/Ppr.hs - compiler/GHC/Cmm/Ppr/Decl.hs - compiler/GHC/Cmm/Ppr/Expr.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Switch/Implement.hs - compiler/GHC/Cmm/Type.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen/Amode.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen/Base.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b9975eabd46c9690dacf63b59e5e26fa91b2397a...516987db1eb32bb231063e1e0fa4ff78178b15c9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b9975eabd46c9690dacf63b59e5e26fa91b2397a...516987db1eb32bb231063e1e0fa4ff78178b15c9 You're receiving 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 Mar 28 13:22:06 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sat, 28 Mar 2020 09:22:06 -0400 Subject: [Git][ghc/ghc][wip/zap-coercions] Document -ddrop-coercions Message-ID: <5e7f4f7eb735f_61674f59d901099968@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/zap-coercions at Glasgow Haskell Compiler / GHC Commits: 1ad95f12 by Ben Gamari at 2020-03-28T09:21:53-04:00 Document -ddrop-coercions - - - - - 1 changed file: - docs/users_guide/debugging.rst Changes: ===================================== docs/users_guide/debugging.rst ===================================== @@ -818,6 +818,12 @@ Checking for consistency single: consistency checks single: lint +.. ghc-flag:: -ddrop-coercions + :shortdesc: TODO + :type: dynamic + + TODO + .. ghc-flag:: -dcore-lint :shortdesc: Turn on internal sanity checking :type: dynamic View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1ad95f12e3839348214de6dfd9c11b1ad1a02769 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1ad95f12e3839348214de6dfd9c11b1ad1a02769 You're receiving 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 Mar 28 13:35:02 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sat, 28 Mar 2020 09:35:02 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T17970 Message-ID: <5e7f52866d370_616713339fc411049c4@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/T17970 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T17970 You're receiving 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 Mar 28 15:57:36 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Sat, 28 Mar 2020 11:57:36 -0400 Subject: [Git][ghc/ghc][wip/strict-NoExtCon] WIP: Make NoExtCon fields strict Message-ID: <5e7f73f093c0a_6167e6514b4111978@gitlab.haskell.org.mail> Ryan Scott pushed to branch wip/strict-NoExtCon at Glasgow Haskell Compiler / GHC Commits: 66fbd3a2 by Ryan Scott at 2020-03-28T11:57:22-04:00 WIP: Make NoExtCon fields strict Bumps the haddock submodule. [ci skip] - - - - - 30 changed files: - compiler/GHC/Driver/Main.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Extension.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Types.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Coverage.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Foreign/Decl.hs - compiler/GHC/HsToCore/GuardedRHSs.hs - compiler/GHC/HsToCore/ListComp.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/PmCheck.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Rename/Binds.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Fixity.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Source.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/66fbd3a2dbbc0e81afde7a8a975012fe5a8abaed -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/66fbd3a2dbbc0e81afde7a8a975012fe5a8abaed You're receiving 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 Mar 29 00:06:16 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Sat, 28 Mar 2020 20:06:16 -0400 Subject: [Git][ghc/ghc][wip/T17923] Significant refactor of Lint Message-ID: <5e7fe67837f56_61675cefcac1147064@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T17923 at Glasgow Haskell Compiler / GHC Commits: 1e135c8a by Simon Peyton Jones at 2020-03-29T00:05:28+00: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 - - - - - 4 changed files: - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Type.hs - + testsuite/tests/indexed-types/should_compile/T17923.hs - testsuite/tests/indexed-types/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -8,7 +8,7 @@ See Note [Core Lint guarantee]. -} {-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE ScopedTypeVariables, DeriveFunctor #-} module GHC.Core.Lint ( lintCoreBindings, lintUnfolding, @@ -33,7 +33,6 @@ import GHC.Core.Op.Monad import Bag import Literal import GHC.Core.DataCon -import TysWiredIn import TysPrim import TcType ( isFloatingTy ) import Var @@ -461,14 +460,17 @@ lintCoreBindings :: DynFlags -> CoreToDo -> [Var] -> CoreProgram -> (Bag MsgDoc, lintCoreBindings dflags pass local_in_scope binds = initL dflags flags local_in_scope $ addLoc TopLevelBindings $ - lintLetBndrs TopLevel binders $ - -- Put all the top-level binders in scope at the start - -- This is because transformation rules can bring something - -- into use 'unexpectedly' do { checkL (null dups) (dupVars dups) ; checkL (null ext_dups) (dupExtVars ext_dups) - ; mapM lint_bind binds } + ; lintRecBindings TopLevel all_pairs $ + return () } where + all_pairs = flattenBinds binds + -- Put all the top-level binders in scope at the start + -- This is because transformation rules can bring something + -- into use 'unexpectedly'; see Note [Glomming] in OccurAnal + binders = map fst all_pairs + flags = defaultLintFlags { lf_check_global_ids = check_globals , lf_check_inline_loop_breakers = check_lbs @@ -494,7 +496,6 @@ lintCoreBindings dflags pass local_in_scope binds CorePrep -> AllowAtTopLevel _ -> AllowAnywhere - binders = bindersOfBinds binds (_, dups) = removeDups compare binders -- dups_ext checks for names with different uniques @@ -509,11 +510,6 @@ lintCoreBindings dflags pass local_in_scope binds = compare (m1, nameOccName n1) (m2, nameOccName n2) | otherwise = LT - -- If you edit this function, you may need to update the GHC formalism - -- See Note [GHC Formalism] - lint_bind (Rec prs) = mapM_ (lintSingleBinding TopLevel Recursive) prs - lint_bind (NonRec bndr rhs) = lintSingleBinding TopLevel NonRecursive (bndr,rhs) - {- ************************************************************************ * * @@ -576,28 +572,32 @@ lintExpr dflags vars expr Check a core binding, returning the list of variables bound. -} -lintSingleBinding :: TopLevelFlag -> RecFlag -> (Id, CoreExpr) -> LintM () --- If you edit this function, you may need to update the GHC formalism --- See Note [GHC Formalism] -lintSingleBinding top_lvl_flag rec_flag (binder,rhs) - = addLoc (RhsOf binder) $ - -- Check the rhs - do { ty <- lintRhs binder rhs - ; binder_ty <- applySubstTy (idType binder) - ; ensureEqTys binder_ty ty (mkRhsMsg binder (text "RHS") ty) +lintRecBindings :: TopLevelFlag -> [(Id, CoreExpr)] + -> LintM a -> LintM a +lintRecBindings top_lvl pairs thing_inside + = lintIdBndrs top_lvl bndrs $ \ bndrs' -> + do { zipWithM_ lint_pair bndrs' rhss + ; thing_inside } + where + (bndrs, rhss) = unzip pairs + lint_pair bndr' rhs + = addLoc (RhsOf bndr') $ + do { rhs_ty <- lintRhs bndr' rhs -- Check the rhs + ; lintLetBind top_lvl Recursive bndr' rhs rhs_ty } + +lintLetBind :: TopLevelFlag -> RecFlag -> LintedId + -> CoreExpr -> LintedType -> LintM () +-- Binder's type, and the RHS, have already been linted +-- This function checks other invariants +lintLetBind top_lvl rec_flag binder rhs rhs_ty + = do { let binder_ty = idType binder + ; ensureEqTys binder_ty rhs_ty (mkRhsMsg binder (text "RHS") rhs_ty) -- If the binding is for a CoVar, the RHS should be (Coercion co) -- See Note [Core type and coercion invariant] in GHC.Core ; checkL (not (isCoVar binder) || isCoArg rhs) (mkLetErr binder rhs) - -- Check that it's not levity-polymorphic - -- Do this first, because otherwise isUnliftedType panics - -- Annoyingly, this duplicates the test in lintIdBdr, - -- because for non-rec lets we call lintSingleBinding first - ; checkL (isJoinId binder || not (isTypeLevPoly binder_ty)) - (badBndrTyMsg binder (text "levity-polymorphic")) - -- Check the let/app invariant -- See Note [Core let/app invariant] in GHC.Core ; checkL ( isJoinId binder @@ -610,14 +610,14 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs) -- 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_flag)) + || (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]. - ; checkL (not (isTopLevel top_lvl_flag && binder_ty `eqType` addrPrimTy) + ; checkL (not (isTopLevel top_lvl && binder_ty `eqType` addrPrimTy) || exprIsTickedString rhs) (mkTopNonLitStrMsg binder) @@ -674,7 +674,9 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs) -- join point. -- -- See Note [Checking StaticPtrs]. -lintRhs :: Id -> CoreExpr -> LintM OutType +lintRhs :: Id -> CoreExpr -> LintM LintedType +-- NB: the Id can be Linted or not -- it's only used for +-- its OccInfo and join-pointer-hood lintRhs bndr rhs | Just arity <- isJoinId_maybe bndr = lint_join_lams arity arity True rhs @@ -761,13 +763,14 @@ hurts us here. ************************************************************************ -} --- For OutType, OutKind, the substitution has been applied, --- but has not been linted yet - -type LintedType = Type -- Substitution applied, and type is linted -type LintedKind = Kind +-- Linted things: substitution applied, and type is linted +type LintedType = Type +type LintedKind = Kind +type LintedCoercion = Coercion +type LintedTyCoVar = TyCoVar +type LintedId = Id -lintCoreExpr :: CoreExpr -> LintM OutType +lintCoreExpr :: CoreExpr -> LintM LintedType -- The returned type has the substitution from the monad -- already applied to it: -- lintCoreExpr e subst = exprType (subst e) @@ -776,18 +779,20 @@ lintCoreExpr :: CoreExpr -> LintM OutType -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] + lintCoreExpr (Var var) - = lintVarOcc var 0 + = lintIdOcc var 0 lintCoreExpr (Lit lit) = return (literalType lit) lintCoreExpr (Cast expr co) = do { expr_ty <- markAllJoinsBad $ lintCoreExpr expr - ; co' <- applySubstCo co - ; (_, k2, from_ty, to_ty, r) <- lintCoercion co' - ; checkValueKind k2 (text "target of cast" <+> quotes (ppr co)) - ; lintRole co' Representational r + ; co' <- lintCoercion co + ; let (Pair from_ty to_ty, role) = coercionKindRole co' + ; checkValueType to_ty $ + text "target of cast" <+> quotes (ppr co') + ; lintRole co' Representational role ; ensureEqTys from_ty expr_ty (mkCastErr expr co' from_ty expr_ty) ; return to_ty } @@ -809,7 +814,7 @@ lintCoreExpr (Tick tickish expr) lintCoreExpr (Let (NonRec tv (Type ty)) body) | isTyVar tv = -- See Note [Linting type lets] - do { ty' <- applySubstTy ty + do { ty' <- lintType ty ; lintTyBndr tv $ \ tv' -> do { addLoc (RhsOf tv) $ lintTyKind tv' ty' -- Now extend the substitution so we @@ -820,33 +825,34 @@ lintCoreExpr (Let (NonRec tv (Type ty)) body) lintCoreExpr (Let (NonRec bndr rhs) body) | isId bndr - = do { lintSingleBinding NotTopLevel NonRecursive (bndr,rhs) - ; addLoc (BodyOfLetRec [bndr]) - (lintBinder LetBind bndr $ \_ -> - addGoodJoins [bndr] $ - lintCoreExpr body) } + = do { -- First Lint the RHS, before bringing the binder into scope + rhs_ty <- lintRhs bndr rhs + + -- Now lint the binder + ; lintBinder LetBind bndr $ \bndr' -> + do { lintLetBind NotTopLevel NonRecursive bndr' rhs rhs_ty + ; addLoc (BodyOfLetRec [bndr]) (lintCoreExpr body) } } | otherwise = failWithL (mkLetErr bndr rhs) -- Not quite accurate lintCoreExpr e@(Let (Rec pairs) body) - = lintLetBndrs NotTopLevel bndrs $ - addGoodJoins bndrs $ - do { -- Check that the list of pairs is non-empty + = do { -- Check that the list of pairs is non-empty checkL (not (null pairs)) (emptyRec e) -- Check that there are no duplicated binders + ; let (_, dups) = removeDups compare bndrs ; checkL (null dups) (dupVars dups) -- Check that either all the binders are joins, or none ; checkL (all isJoinId bndrs || all (not . isJoinId) bndrs) $ - mkInconsistentRecMsg bndrs + mkInconsistentRecMsg bndrs - ; mapM_ (lintSingleBinding NotTopLevel Recursive) pairs - ; addLoc (BodyOfLetRec bndrs) (lintCoreExpr body) } + ; lintRecBindings NotTopLevel pairs $ + addLoc (BodyOfLetRec bndrs) $ + lintCoreExpr body } where bndrs = map fst pairs - (_, dups) = removeDups compare bndrs lintCoreExpr e@(App _ _) = do { fun_ty <- lintCoreFun fun (length args) @@ -867,23 +873,35 @@ lintCoreExpr (Type ty) = failWithL (text "Type found as expression" <+> ppr ty) lintCoreExpr (Coercion co) - = do { (k1, k2, ty1, ty2, role) <- lintInCo co - ; return (mkHeteroCoercionType role k1 k2 ty1 ty2) } + = do { co' <- addLoc (InCo co) $ + lintCoercion co + ; return (coercionType co') } ---------------------- -lintVarOcc :: Var -> Int -- Number of arguments (type or value) being passed - -> LintM Type -- returns type of the *variable* -lintVarOcc var nargs - = do { checkL (isNonCoVarId var) +lintIdOcc :: Var -> Int -- Number of arguments (type or value) being passed + -> LintM LintedType -- returns type of the *variable* +lintIdOcc var nargs + = addLoc (OccOf var) $ + do { checkL (isNonCoVarId var) (text "Non term variable" <+> ppr var) -- See GHC.Core Note [Variable occurrences in Core] -- Check that the type of the occurrence is the same - -- as the type of the binding site - ; ty <- applySubstTy (idType var) - ; var' <- lookupIdInScope var - ; let ty' = idType var' - ; ensureEqTys ty ty' $ mkBndrOccTypeMismatchMsg var' var ty' ty + -- as the type of the binding site. The inScopeIds are + -- /un-substituted/, so this checks that the occurrence type + -- is identical to the binder type. + -- This makes things much easier for things like: + -- /\a. \(x::Maybe a). /\a. ...(x::Maybe a)... + -- The "::Maybe a" on the occurrence is referring to the /outer/ a. + -- If we compared /substituted/ types we'd risk comparing + -- (Maybe a) from the binding site with bogus (Maybe a1) from + -- the occurrence site. Comparing un-substituted types finesses + -- this altogether + ; (bndr, linted_bndr_ty) <- lookupIdInScope var + ; let occ_ty = idType var + bndr_ty = idType bndr + ; ensureEqTys occ_ty bndr_ty $ + mkBndrOccTypeMismatchMsg bndr var bndr_ty occ_ty -- Check for a nested occurrence of the StaticPtr constructor. -- See Note [Checking StaticPtrs]. @@ -895,13 +913,13 @@ lintVarOcc var nargs ; checkDeadIdOcc var ; checkJoinOcc var nargs - ; return (idType var') } + ; return linted_bndr_ty } lintCoreFun :: CoreExpr - -> Int -- Number of arguments (type or val) being passed - -> LintM Type -- Returns type of the *function* + -> Int -- Number of arguments (type or val) being passed + -> LintM LintedType -- Returns type of the *function* lintCoreFun (Var var) nargs - = lintVarOcc var nargs + = lintIdOcc var nargs lintCoreFun (Lam var body) nargs -- Act like lintCoreExpr of Lam, but *don't* call markAllJoinsBad; see @@ -941,7 +959,9 @@ checkJoinOcc var n_args = do { mb_join_arity_bndr <- lookupJoinId var ; case mb_join_arity_bndr of { Nothing -> -- Binder is not a join point - addErrL (invalidJoinOcc var) ; + do { join_set <- getValidJoins + ; addErrL (text "join set " <+> ppr join_set $$ + invalidJoinOcc var) } ; Just join_arity_bndr -> @@ -1038,15 +1058,15 @@ subtype of the required type, as one would expect. -} -lintCoreArgs :: OutType -> [CoreArg] -> LintM OutType +lintCoreArgs :: LintedType -> [CoreArg] -> LintM LintedType lintCoreArgs fun_ty args = foldM lintCoreArg fun_ty args -lintCoreArg :: OutType -> CoreArg -> LintM OutType +lintCoreArg :: LintedType -> CoreArg -> LintM LintedType lintCoreArg fun_ty (Type arg_ty) = do { checkL (not (isCoercionTy arg_ty)) (text "Unnecessary coercion-to-type injection:" <+> ppr arg_ty) - ; arg_ty' <- applySubstTy arg_ty + ; arg_ty' <- lintType arg_ty ; lintTyApp fun_ty arg_ty' } lintCoreArg fun_ty arg @@ -1060,11 +1080,12 @@ lintCoreArg fun_ty arg ; checkL (not (isUnliftedType arg_ty) || exprOkForSpeculation arg) (mkLetAppMsg arg) + ; lintValApp arg fun_ty arg_ty } ----------------- -lintAltBinders :: OutType -- Scrutinee type - -> OutType -- Constructor type +lintAltBinders :: LintedType -- Scrutinee type + -> LintedType -- Constructor type -> [OutVar] -- Binders -> LintM () -- If you edit this function, you may need to update the GHC formalism @@ -1080,7 +1101,7 @@ lintAltBinders scrut_ty con_ty (bndr:bndrs) ; lintAltBinders scrut_ty con_ty' bndrs } ----------------- -lintTyApp :: OutType -> OutType -> LintM OutType +lintTyApp :: LintedType -> LintedType -> LintM LintedType lintTyApp fun_ty arg_ty | Just (tv,body_ty) <- splitForAllTy_maybe fun_ty = do { lintTyKind tv arg_ty @@ -1094,7 +1115,7 @@ lintTyApp fun_ty arg_ty = failWithL (mkTyAppMsg fun_ty arg_ty) ----------------- -lintValApp :: CoreExpr -> OutType -> OutType -> LintM OutType +lintValApp :: CoreExpr -> LintedType -> LintedType -> LintM LintedType lintValApp arg fun_ty arg_ty | Just (arg,res) <- splitFunTy_maybe fun_ty = do { ensureEqTys arg arg_ty err1 @@ -1105,17 +1126,17 @@ lintValApp arg fun_ty arg_ty err1 = mkAppMsg fun_ty arg_ty arg err2 = mkNonFunAppMsg fun_ty arg_ty arg -lintTyKind :: OutTyVar -> OutType -> LintM () +lintTyKind :: OutTyVar -> LintedType -> LintM () -- Both args have had substitution applied -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] lintTyKind tyvar arg_ty - = do { arg_kind <- lintType arg_ty - ; unless (arg_kind `eqType` tyvar_kind) - (addErrL (mkKindErrMsg tyvar arg_ty $$ (text "Linted Arg kind:" <+> ppr arg_kind))) } + = unless (arg_kind `eqType` tyvar_kind) $ + addErrL (mkKindErrMsg tyvar arg_ty $$ (text "Linted Arg kind:" <+> ppr arg_kind)) where tyvar_kind = tyVarKind tyvar + arg_kind = typeKind arg_ty {- ************************************************************************ @@ -1125,7 +1146,7 @@ lintTyKind tyvar arg_ty ************************************************************************ -} -lintCaseExpr :: CoreExpr -> Id -> Type -> [CoreAlt] -> LintM OutType +lintCaseExpr :: CoreExpr -> Id -> Type -> [CoreAlt] -> LintM LintedType lintCaseExpr scrut var alt_ty alts = do { let e = Case scrut var alt_ty alts -- Just for error messages @@ -1134,10 +1155,10 @@ lintCaseExpr scrut var alt_ty alts = -- See Note [Join points are less general than the paper] -- in GHC.Core - ; (alt_ty, _) <- addLoc (CaseTy scrut) $ - lintInTy alt_ty - ; (var_ty, _) <- addLoc (IdTy var) $ - lintInTy (idType var) + ; alt_ty <- addLoc (CaseTy scrut) $ + lintValueType alt_ty + ; var_ty <- addLoc (IdTy var) $ + lintValueType (idType var) -- We used to try to check whether a case expression with no -- alternatives was legitimate, but this didn't work. @@ -1179,7 +1200,7 @@ lintCaseExpr scrut var alt_ty alts = ; checkCaseAlts e scrut_ty alts ; return alt_ty } } -checkCaseAlts :: CoreExpr -> OutType -> [CoreAlt] -> LintM () +checkCaseAlts :: CoreExpr -> LintedType -> [CoreAlt] -> LintM () -- a) Check that the alts are non-empty -- b1) Check that the DEFAULT comes first, if it exists -- b2) Check that the others are in increasing order @@ -1219,14 +1240,14 @@ checkCaseAlts e ty alts = Nothing -> False Just tycon -> isPrimTyCon tycon -lintAltExpr :: CoreExpr -> OutType -> LintM () +lintAltExpr :: CoreExpr -> LintedType -> LintM () lintAltExpr expr ann_ty = do { actual_ty <- lintCoreExpr expr ; ensureEqTys actual_ty ann_ty (mkCaseAltMsg expr actual_ty ann_ty) } -- See GHC.Core Note [Case expression invariants] item (6) -lintCoreAlt :: OutType -- Type of scrutinee - -> OutType -- Type of the alternative +lintCoreAlt :: LintedType -- Type of scrutinee + -> LintedType -- Type of the alternative -> CoreAlt -> LintM () -- If you edit this function, you may need to update the GHC formalism @@ -1286,40 +1307,43 @@ lintBinders site (var:vars) linterF = lintBinder site var $ \var' -> -- See Note [GHC Formalism] lintBinder :: BindingSite -> Var -> (Var -> LintM a) -> LintM a lintBinder site var linterF - | isTyVar var = lintTyBndr var linterF - | isCoVar var = lintCoBndr var linterF - | otherwise = lintIdBndr NotTopLevel site var linterF + | isTyCoVar var = lintTyCoBndr var linterF + | otherwise = lintIdBndr NotTopLevel site var linterF -lintTyBndr :: InTyVar -> (OutTyVar -> LintM a) -> LintM a -lintTyBndr tv thing_inside - = do { subst <- getTCvSubst - ; let (subst', tv') = substTyVarBndr subst tv - ; lintKind (varType tv') - ; updateTCvSubst subst' (thing_inside tv') } +lintTyBndr :: TyVar -> (LintedTyCoVar -> LintM a) -> LintM a +lintTyBndr = lintTyCoBndr -- We could specialise it, I guess + +-- lintCoBndr :: CoVar -> (LintedTyCoVar -> LintM a) -> LintM a +-- lintCoBndr = lintTyCoBndr -- We could specialise it, I guess -lintCoBndr :: InCoVar -> (OutCoVar -> LintM a) -> LintM a -lintCoBndr cv thing_inside +lintTyCoBndr :: TyCoVar -> (LintedTyCoVar -> LintM a) -> LintM a +lintTyCoBndr tcv thing_inside = do { subst <- getTCvSubst - ; let (subst', cv') = substCoVarBndr subst cv - ; lintKind (varType cv') - ; lintL (isCoVarType (varType cv')) - (text "CoVar with non-coercion type:" <+> pprTyVar cv) - ; updateTCvSubst subst' (thing_inside cv') } - -lintLetBndrs :: TopLevelFlag -> [Var] -> LintM a -> LintM a -lintLetBndrs top_lvl ids linterF - = go ids + ; kind' <- lintType (varType tcv) + ; let tcv' = uniqAway (getTCvInScope subst) $ + setVarType tcv kind' + subst' = extendTCvSubstWithClone subst tcv tcv' + ; when (isCoVar tcv) $ + lintL (isCoVarType kind') + (text "CoVar with non-coercion type:" <+> pprTyVar tcv) + ; updateTCvSubst subst' (thing_inside tcv') } + +lintIdBndrs :: forall a. TopLevelFlag -> [Id] -> ([LintedId] -> LintM a) -> LintM a +lintIdBndrs top_lvl ids thing_inside + = go ids thing_inside where - go [] = linterF - go (id:ids) = lintIdBndr top_lvl LetBind id $ \_ -> - go ids + go :: [Id] -> ([Id] -> LintM a) -> LintM a + go [] thing_inside = thing_inside [] + go (id:ids) thing_inside = lintIdBndr top_lvl LetBind id $ \id' -> + go ids $ \ids' -> + thing_inside (id' : ids') lintIdBndr :: TopLevelFlag -> BindingSite -> InVar -> (OutVar -> LintM a) -> LintM a -- Do substitution on the type of a binder and add the var with this -- new type to the in-scope set of the second argument -- ToDo: lint its rules -lintIdBndr top_lvl bind_site id linterF +lintIdBndr top_lvl bind_site id thing_inside = ASSERT2( isId id, ppr id ) do { flags <- getLintFlags ; checkL (not (lf_check_global_ids flags) || isLocalId id) @@ -1334,14 +1358,11 @@ lintIdBndr top_lvl bind_site id linterF ; checkL (not (isExternalName (Var.varName id)) || is_top_lvl) (mkNonTopExternalNameMsg id) - ; (id_ty, k) <- addLoc (IdTy id) $ - lintInTy (idType id) - ; let id' = setIdType id id_ty - -- See Note [Levity polymorphism invariants] in GHC.Core - ; lintL (isJoinId id || not (lf_check_levity_poly flags) || not (isKindLevPoly k)) - (text "Levity-polymorphic binder:" <+> - (ppr id <+> dcolon <+> parens (ppr id_ty <+> dcolon <+> ppr k))) + ; lintL (isJoinId id || not (lf_check_levity_poly flags) + || not (isTypeLevPoly id_ty)) $ + text "Levity-polymorphic binder:" <+> ppr id <+> dcolon <+> + parens (ppr id_ty <+> dcolon <+> ppr (typeKind id_ty)) -- Check that a join-id is a not-top-level let-binding ; when (isJoinId id) $ @@ -1353,8 +1374,13 @@ lintIdBndr top_lvl bind_site id linterF ; lintL (not (isCoVarType id_ty)) (text "Non-CoVar has coercion type" <+> ppr id <+> dcolon <+> ppr id_ty) - ; addInScopeId id' $ (linterF id') } + ; linted_ty <- addLoc (IdTy id) (lintValueType id_ty) + + ; addInScopeId id linted_ty $ + thing_inside (setIdType id linted_ty) } where + id_ty = idType id + is_top_lvl = isTopLevel top_lvl is_let_bind = case bind_site of LetBind -> True @@ -1378,45 +1404,58 @@ lintTypes dflags vars tys where (_warns, errs) = initL dflags defaultLintFlags vars linter linter = lintBinders LambdaBind vars $ \_ -> - mapM_ lintInTy tys + mapM_ lintType tys -lintInTy :: InType -> LintM (LintedType, LintedKind) +lintValueType :: Type -> LintM LintedType -- Types only, not kinds -- Check the type, and apply the substitution to it -- See Note [Linting type lets] -lintInTy ty +lintValueType ty = addLoc (InType ty) $ - do { ty' <- applySubstTy ty - ; k <- lintType ty' - ; addLoc (InKind ty' k) $ - lintKind k -- The kind returned by lintType is already - -- a LintedKind but we also want to check that - -- k :: *, which lintKind does - ; return (ty', k) } + do { ty' <- lintType ty + ; let sk = typeKind ty' + ; lintL (classifiesTypeWithValues sk) $ + hang (text "Ill-kinded type:" <+> ppr ty) + 2 (text "has kind:" <+> ppr sk) + ; return ty' } checkTyCon :: TyCon -> LintM () checkTyCon tc = checkL (not (isTcTyCon tc)) (text "Found TcTyCon:" <+> ppr tc) ------------------- -lintType :: OutType -> LintM LintedKind --- The returned Kind has itself been linted +lintType :: LintedType -> LintM LintedType -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] lintType (TyVarTy tv) - = do { checkL (isTyVar tv) (mkBadTyVarMsg tv) - ; tv' <- lintTyCoVarInScope tv - ; return (tyVarKind tv') } - -- We checked its kind when we added it to the envt + | not (isTyVar tv) + = failWithL (mkBadTyVarMsg tv) + + | otherwise + = do { subst <- getTCvSubst + ; case lookupTyVar subst tv of + Just linted_ty -> return linted_ty + + -- In GHCi we may lint an expression with a free + -- type variable. Then it won't be in the + -- substitution, but it should be in scope + Nothing | tv `isInScope` subst + -> return (TyVarTy tv) + | otherwise + -> failWithL $ + hang (text "The type variable" <+> pprBndr LetBind tv) + 2 (text "is out of scope") + } lintType ty@(AppTy t1 t2) | TyConApp {} <- t1 = failWithL $ text "TyConApp to the left of AppTy:" <+> ppr ty | otherwise - = do { k1 <- lintType t1 - ; k2 <- lintType t2 - ; lint_ty_app ty k1 [(t2,k2)] } + = do { t1' <- lintType t1 + ; t2' <- lintType t2 + ; lint_ty_app ty (typeKind t1') [t2'] + ; return (AppTy t1' t2') } lintType ty@(TyConApp tc tys) | isTypeSynonymTyCon tc || isTypeFamilyTyCon tc @@ -1433,71 +1472,72 @@ lintType ty@(TyConApp tc tys) | otherwise -- Data types, data families, primitive types = do { checkTyCon tc - ; ks <- mapM lintType tys - ; lint_ty_app ty (tyConKind tc) (tys `zip` ks) } + ; tys' <- mapM lintType tys + ; lint_ty_app ty (tyConKind tc) tys' + ; return (TyConApp tc tys') } -- arrows can related *unlifted* kinds, so this has to be separate from -- a dependent forall. -lintType ty@(FunTy _ t1 t2) - = do { k1 <- lintType t1 - ; k2 <- lintType t2 - ; lintArrow (text "type or kind" <+> quotes (ppr ty)) k1 k2 } +lintType ty@(FunTy af t1 t2) + = do { t1' <- lintType t1 + ; t2' <- lintType t2 + ; lintArrow (text "type or kind" <+> quotes (ppr ty)) t1' t2' + ; return (FunTy af t1' t2') } + +lintType ty@(ForAllTy (Bndr tcv vis) body_ty) + | not (isTyCoVar tcv) + = failWithL (text "Non-Tyvar or Non-Covar bound in type:" <+> ppr ty) + | otherwise + = lintTyCoBndr tcv $ \tcv' -> + do { body_ty' <- lintType body_ty + ; lintForAllBody tcv' body_ty' -lintType t@(ForAllTy (Bndr tv _vis) ty) - -- forall over types - | isTyVar tv - = lintTyBndr tv $ \tv' -> - do { k <- lintType ty - ; checkValueKind k (text "the body of forall:" <+> ppr t) - ; case occCheckExpand [tv'] k of -- See Note [Stupid type synonyms] - Just k' -> return k' - Nothing -> failWithL (hang (text "Variable escape in forall:") - 2 (vcat [ text "type:" <+> ppr t - , text "kind:" <+> ppr k ])) - } + ; when (isCoVar tcv) $ + lintL (tcv `elemVarSet` tyCoVarsOfType body_ty) $ + text "Covar does not occur in the body:" <+> (ppr tcv $$ ppr body_ty) + -- See GHC.Core.TyCo.Rep Note [Unused coercion variable in ForAllTy] + -- and cf GHC.Core.Coercion Note [Unused coercion variable in ForAllCo] + + ; return (ForAllTy (Bndr tcv' vis) body_ty') } -lintType t@(ForAllTy (Bndr cv _vis) ty) - -- forall over coercions - = do { lintL (isCoVar cv) - (text "Non-Tyvar or Non-Covar bound in type:" <+> ppr t) - ; lintL (cv `elemVarSet` tyCoVarsOfType ty) - (text "Covar does not occur in the body:" <+> ppr t) - ; lintCoBndr cv $ \_ -> - do { k <- lintType ty - ; checkValueKind k (text "the body of forall:" <+> ppr t) - ; return liftedTypeKind - -- We don't check variable escape here. Namely, k could refer to cv' - }} - -lintType ty@(LitTy l) = lintTyLit l >> return (typeKind ty) +lintType ty@(LitTy l) + = do { lintTyLit l; return ty } lintType (CastTy ty co) - = do { k1 <- lintType ty - ; (k1', k2) <- lintStarCoercion co - ; ensureEqTys k1 k1' (mkCastTyErr ty co k1' k1) - ; return k2 } + = do { ty' <- lintType ty + ; co' <- lintStarCoercion co + ; let tyk = typeKind ty' + cok = coercionLKind co' + ; ensureEqTys tyk cok (mkCastTyErr ty co tyk cok) + ; return (CastTy ty' co') } lintType (CoercionTy co) - = do { (k1, k2, ty1, ty2, r) <- lintCoercion co - ; return $ mkHeteroCoercionType r k1 k2 ty1 ty2 } - -{- Note [Stupid type synonyms] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider (#14939) - type Alg cls ob = ob - f :: forall (cls :: * -> Constraint) (b :: Alg cls *). b - -Here 'cls' appears free in b's kind, which would usually be illegal -(because in (forall a. ty), ty's kind should not mention 'a'). But -#in this case (Alg cls *) = *, so all is well. Currently we allow -this, and make Lint expand synonyms where necessary to make it so. - -c.f. TcUnify.occCheckExpand and GHC.Core.Utils.coreAltsType which deal -with the same problem. A single systematic solution eludes me. --} + = do { co' <- lintCoercion co + ; return (CoercionTy co') } + +----------------- +lintForAllBody :: LintedTyCoVar -> LintedType -> LintM () +-- Do the checks for the body of a forall-type +lintForAllBody tcv body_ty + = do { checkValueType body_ty (text "the body of forall:" <+> ppr body_ty) + + -- For type variables, check for skolem escape + -- See Note [Phantom type variables in kinds] in GHC.Core.Type + -- The kind of (forall cv. th) is liftedTypeKind, so no + -- need to check for skolem-escape in the CoVar case + ; let body_kind = typeKind body_ty + ; when (isTyVar tcv) $ + case occCheckExpand [tcv] body_kind of + Just {} -> return () + Nothing -> failWithL $ + hang (text "Variable escape in forall:") + 2 (vcat [ text "tyvar:" <+> ppr tcv + , text "type:" <+> ppr body_ty + , text "kind:" <+> ppr body_kind ]) + } ----------------- -lintTySynFamApp :: Bool -> Type -> TyCon -> [Type] -> LintM LintedKind +lintTySynFamApp :: Bool -> InType -> TyCon -> [InType] -> LintM LintedType -- The TyCon is a type synonym or a type family (not a data family) -- See Note [Linting type synonym applications] -- c.f. TcValidity.check_syn_tc_app @@ -1511,58 +1551,54 @@ lintTySynFamApp report_unsat ty tc tys , let expanded_ty = mkAppTys (substTy (mkTvSubstPrs tenv) rhs) tys' = do { -- Kind-check the argument types, but without reporting -- un-saturated type families/synonyms - ks <- setReportUnsat False (mapM lintType tys) + tys' <- setReportUnsat False (mapM lintType tys) ; when report_unsat $ do { _ <- lintType expanded_ty ; return () } - ; lint_ty_app ty (tyConKind tc) (tys `zip` ks) } + ; lint_ty_app ty (tyConKind tc) tys' + ; return (TyConApp tc tys') } -- Otherwise this must be a type family | otherwise - = do { ks <- mapM lintType tys - ; lint_ty_app ty (tyConKind tc) (tys `zip` ks) } - ------------------ -lintKind :: OutKind -> LintM () --- If you edit this function, you may need to update the GHC formalism --- See Note [GHC Formalism] -lintKind k = do { sk <- lintType k - ; unless (classifiesTypeWithValues sk) - (addErrL (hang (text "Ill-kinded kind:" <+> ppr k) - 2 (text "has kind:" <+> ppr sk))) } + = do { tys' <- mapM lintType tys + ; lint_ty_app ty (tyConKind tc) tys' + ; return (TyConApp tc tys') } ----------------- -- Confirms that a type is really *, #, Constraint etc -checkValueKind :: OutKind -> SDoc -> LintM () -checkValueKind k doc - = lintL (classifiesTypeWithValues k) - (text "Non-*-like kind when *-like expected:" <+> ppr k $$ +checkValueType :: LintedType -> SDoc -> LintM () +checkValueType ty doc + = lintL (classifiesTypeWithValues kind) + (text "Non-*-like kind when *-like expected:" <+> ppr kind $$ text "when checking" <+> doc) + where + kind = typeKind ty ----------------- -lintArrow :: SDoc -> LintedKind -> LintedKind -> LintM LintedKind +lintArrow :: SDoc -> LintedType -> LintedType -> LintM () -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] -lintArrow what k1 k2 -- Eg lintArrow "type or kind `blah'" k1 k2 +lintArrow what t1 t2 -- Eg lintArrow "type or kind `blah'" k1 k2 -- or lintArrow "coercion `blah'" k1 k2 = do { unless (classifiesTypeWithValues k1) (addErrL (msg (text "argument") k1)) - ; unless (classifiesTypeWithValues k2) (addErrL (msg (text "result") k2)) - ; return liftedTypeKind } + ; unless (classifiesTypeWithValues k2) (addErrL (msg (text "result") k2)) } where + k1 = typeKind t1 + k2 = typeKind t2 msg ar k = vcat [ hang (text "Ill-kinded" <+> ar) 2 (text "in" <+> what) , what <+> text "kind:" <+> ppr k ] ----------------- -lint_ty_app :: Type -> LintedKind -> [(LintedType,LintedKind)] -> LintM LintedKind +lint_ty_app :: Type -> LintedKind -> [LintedType] -> LintM () lint_ty_app ty k tys = lint_app (text "type" <+> quotes (ppr ty)) k tys ---------------- -lint_co_app :: Coercion -> LintedKind -> [(LintedType,LintedKind)] -> LintM LintedKind +lint_co_app :: Coercion -> LintedKind -> [LintedType] -> LintM () lint_co_app ty k tys = lint_app (text "coercion" <+> quotes (ppr ty)) k tys @@ -1574,42 +1610,45 @@ lintTyLit (NumTyLit n) where msg = text "Negative type literal:" <+> integer n lintTyLit (StrTyLit _) = return () -lint_app :: SDoc -> LintedKind -> [(LintedType,LintedKind)] -> LintM Kind +lint_app :: SDoc -> LintedKind -> [LintedType] -> LintM () -- (lint_app d fun_kind arg_tys) -- We have an application (f arg_ty1 .. arg_tyn), -- where f :: fun_kind --- Takes care of linting the OutTypes -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] -lint_app doc kfn kas +lint_app doc kfn arg_tys = do { in_scope <- getInScope -- We need the in_scope set to satisfy the invariant in -- Note [The substitution invariant] in GHC.Core.TyCo.Subst - ; foldlM (go_app in_scope) kfn kas } + ; _ <- foldlM (go_app in_scope) kfn arg_tys + ; return () } where fail_msg extra = vcat [ hang (text "Kind application error in") 2 doc , nest 2 (text "Function kind =" <+> ppr kfn) - , nest 2 (text "Arg kinds =" <+> ppr kas) + , nest 2 (text "Arg types =" <+> ppr arg_tys) , extra ] - go_app in_scope kfn tka + go_app in_scope kfn ta | Just kfn' <- coreView kfn - = go_app in_scope kfn' tka + = go_app in_scope kfn' ta - go_app _ (FunTy _ kfa kfb) tka@(_,ka) - = do { unless (ka `eqType` kfa) $ - addErrL (fail_msg (text "Fun:" <+> (ppr kfa $$ ppr tka))) + go_app _ fun_kind@(FunTy _ kfa kfb) ta + = do { let ka = typeKind ta + ; unless (ka `eqType` kfa) $ + addErrL (fail_msg (text "Fun:" <+> (ppr fun_kind $$ ppr ta <+> dcolon <+> ppr ka))) ; return kfb } - go_app in_scope (ForAllTy (Bndr kv _vis) kfn) tka@(ta,ka) + go_app in_scope (ForAllTy (Bndr kv _vis) kfn) ta = do { let kv_kind = varType kv + ka = typeKind ta ; unless (ka `eqType` kv_kind) $ - addErrL (fail_msg (text "Forall:" <+> (ppr kv $$ ppr kv_kind $$ ppr tka))) + addErrL (fail_msg (text "Forall:" <+> (ppr kv $$ ppr kv_kind $$ + ppr ta <+> dcolon <+> ppr ka))) ; return $ substTy (extendTCvSubst (mkEmptyTCvSubst in_scope) kv ta) kfn } - go_app _ kfn ka - = failWithL (fail_msg (text "Not a fun:" <+> (ppr kfn $$ ppr ka))) + go_app _ kfn ta + = failWithL (fail_msg (text "Not a fun:" <+> (ppr kfn $$ ppr ta))) {- ********************************************************************* * * @@ -1617,7 +1656,7 @@ lint_app doc kfn kas * * ********************************************************************* -} -lintCoreRule :: OutVar -> OutType -> CoreRule -> LintM () +lintCoreRule :: OutVar -> LintedType -> CoreRule -> LintM () lintCoreRule _ _ (BuiltinRule {}) = return () -- Don't bother @@ -1710,68 +1749,94 @@ Note [Rules and join points] in OccurAnal for further discussion. ************************************************************************ -} -lintInCo :: InCoercion -> LintM (LintedKind, LintedKind, LintedType, LintedType, Role) --- Check the coercion, and apply the substitution to it --- See Note [Linting type lets] -lintInCo co - = addLoc (InCo co) $ - do { co' <- applySubstCo co - ; lintCoercion co' } +{- Note [Asymptotic efficiency] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When linting coercions (and types actually) we return a linted +(substituted) coercion. Then we often have to take the coercionKind of +that returned coercion. If we get long chains, that can be asymptotically +inefficient, notably in +* TransCo +* InstCo +* NthCo (cf #9233) +* LRCo + +But the code is simple. And this is only Lint. Let's wait to see if +the bad perf bites us in practice. + +A solution would be to return the kind and role of the coercion, +as well as the linted coercion. Or perhaps even *only* the kind and role, +which is what used to happen. But that proved tricky and error prone +(#17923), so now we return the coercion. +-} + -- lints a coercion, confirming that its lh kind and its rh kind are both * -- also ensures that the role is Nominal -lintStarCoercion :: OutCoercion -> LintM (LintedType, LintedType) +lintStarCoercion :: InCoercion -> LintM LintedCoercion lintStarCoercion g - = do { (k1, k2, t1, t2, r) <- lintCoercion g - ; checkValueKind k1 (text "the kind of the left type in" <+> ppr g) - ; checkValueKind k2 (text "the kind of the right type in" <+> ppr g) - ; lintRole g Nominal r - ; return (t1, t2) } - -lintCoercion :: OutCoercion -> LintM (LintedKind, LintedKind, LintedType, LintedType, Role) --- Check the kind of a coercion term, returning the kind --- Post-condition: the returned OutTypes are lint-free --- --- If lintCoercion co = (k1, k2, s1, s2, r) --- then co :: s1 ~r s2 --- s1 :: k1 --- s2 :: k2 - + = do { g' <- lintCoercion g + ; let Pair t1 t2 = coercionKind g' + ; checkValueType t1 (text "the kind of the left type in" <+> ppr g) + ; checkValueType t2 (text "the kind of the right type in" <+> ppr g) + ; lintRole g Nominal (coercionRole g) + ; return g' } + +lintCoercion :: InCoercion -> LintM LintedCoercion -- If you edit this function, you may need to update the GHC formalism -- See Note [GHC Formalism] + +lintCoercion (CoVarCo cv) + | not (isCoVar cv) + = failWithL (hang (text "Bad CoVarCo:" <+> ppr cv) + 2 (text "With offending type:" <+> ppr (varType cv))) + + | otherwise + = do { subst <- getTCvSubst + ; case lookupCoVar subst cv of + Just linted_co -> return linted_co ; + Nothing -> -- lintCoBndr always extends the substitition + failWithL $ + hang (text "The coercion variable" <+> pprBndr LetBind cv) + 2 (text "is out of scope") + } + + lintCoercion (Refl ty) - = do { k <- lintType ty - ; return (k, k, ty, ty, Nominal) } + = do { ty' <- lintType ty + ; return (Refl ty') } lintCoercion (GRefl r ty MRefl) - = do { k <- lintType ty - ; return (k, k, ty, ty, r) } + = do { ty' <- lintType ty + ; return (GRefl r ty' MRefl) } lintCoercion (GRefl r ty (MCo co)) - = do { k <- lintType ty - ; (_, _, k1, k2, r') <- lintCoercion co - ; ensureEqTys k k1 - (hang (text "GRefl coercion kind mis-match:" <+> ppr co) - 2 (vcat [ppr ty, ppr k, ppr k1])) - ; lintRole co Nominal r' - ; return (k1, k2, ty, mkCastTy ty co, r) } + = do { ty' <- lintType ty + ; co' <- lintCoercion co + ; let tk = typeKind ty' + tl = coercionLKind co' + ; ensureEqTys tk tl $ + hang (text "GRefl coercion kind mis-match:" <+> ppr co) + 2 (vcat [ppr ty', ppr tk, ppr tl]) + ; lintRole co' Nominal (coercionRole co') + ; return (GRefl r ty' (MCo co')) } lintCoercion co@(TyConAppCo r tc cos) | tc `hasKey` funTyConKey , [_rep1,_rep2,_co1,_co2] <- cos - = do { failWithL (text "Saturated TyConAppCo (->):" <+> ppr co) - } -- All saturated TyConAppCos should be FunCos + = failWithL (text "Saturated TyConAppCo (->):" <+> ppr co) + -- All saturated TyConAppCos should be FunCos | Just {} <- synTyConDefn_maybe tc = failWithL (text "Synonym in TyConAppCo:" <+> ppr co) | otherwise = do { checkTyCon tc - ; (k's, ks, ss, ts, rs) <- mapAndUnzip5M lintCoercion cos - ; k' <- lint_co_app co (tyConKind tc) (ss `zip` k's) - ; k <- lint_co_app co (tyConKind tc) (ts `zip` ks) - ; _ <- zipWith3M lintRole cos (tyConRolesX r tc) rs - ; return (k', k, mkTyConApp tc ss, mkTyConApp tc ts, r) } + ; cos' <- mapM lintCoercion cos + ; let (co_kinds, co_roles) = unzip (map coercionKindRole cos') + ; lint_co_app co (tyConKind tc) (map pFst co_kinds) + ; lint_co_app co (tyConKind tc) (map pSnd co_kinds) + ; zipWithM_ (lintRole co) (tyConRolesX r tc) co_roles + ; return (TyConAppCo r tc cos') } lintCoercion co@(AppCo co1 co2) | TyConAppCo {} <- co1 @@ -1779,111 +1844,75 @@ lintCoercion co@(AppCo co1 co2) | Just (TyConApp {}, _) <- isReflCo_maybe co1 = failWithL (text "Refl (TyConApp ...) to the left of AppCo:" <+> ppr co) | otherwise - = do { (k1, k2, s1, s2, r1) <- lintCoercion co1 - ; (k'1, k'2, t1, t2, r2) <- lintCoercion co2 - ; k3 <- lint_co_app co k1 [(t1,k'1)] - ; k4 <- lint_co_app co k2 [(t2,k'2)] + = do { co1' <- lintCoercion co1 + ; co2' <- lintCoercion co2 + ; let (Pair lk1 rk1, r1) = coercionKindRole co1' + (Pair lk2 rk2, r2) = coercionKindRole co2' + ; lint_co_app co (typeKind lk1) [lk2] + ; lint_co_app co (typeKind rk1) [rk2] + ; if r1 == Phantom then lintL (r2 == Phantom || r2 == Nominal) (text "Second argument in AppCo cannot be R:" $$ ppr co) else lintRole co Nominal r2 - ; return (k3, k4, mkAppTy s1 t1, mkAppTy s2 t2, r1) } + + ; return (AppCo co1' co2') } ---------- -lintCoercion (ForAllCo tv1 kind_co co) - -- forall over types - | isTyVar tv1 - = do { (_, k2) <- lintStarCoercion kind_co - ; let tv2 = setTyVarKind tv1 k2 - ; addInScopeTyCoVar tv1 $ - do { - ; (k3, k4, t1, t2, r) <- lintCoercion co - ; in_scope <- getInScope - ; let tyl = mkInvForAllTy tv1 t1 - subst = mkTvSubst in_scope $ - -- We need both the free vars of the `t2` and the - -- free vars of the range of the substitution in - -- scope. All the free vars of `t2` and `kind_co` should - -- already be in `in_scope`, because they've been - -- linted and `tv2` has the same unique as `tv1`. - -- See Note [The substitution invariant] in GHC.Core.TyCo.Subst. - unitVarEnv tv1 (TyVarTy tv2 `mkCastTy` mkSymCo kind_co) - tyr = mkInvForAllTy tv2 $ - substTy subst t2 - ; return (k3, k4, tyl, tyr, r) } } - -lintCoercion (ForAllCo cv1 kind_co co) - -- forall over coercions - = ASSERT( isCoVar cv1 ) - do { lintL (almostDevoidCoVarOfCo cv1 co) - (text "Covar can only appear in Refl and GRefl: " <+> ppr co) - ; (_, k2) <- lintStarCoercion kind_co - ; let cv2 = setVarType cv1 k2 - ; addInScopeTyCoVar cv1 $ - do { - ; (k3, k4, t1, t2, r) <- lintCoercion co - ; checkValueKind k3 (text "the body of a ForAllCo over covar:" <+> ppr co) - ; checkValueKind k4 (text "the body of a ForAllCo over covar:" <+> ppr co) - -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep - ; in_scope <- getInScope - ; let tyl = mkTyCoInvForAllTy cv1 t1 - r2 = coVarRole cv1 - kind_co' = downgradeRole r2 Nominal kind_co - eta1 = mkNthCo r2 2 kind_co' - eta2 = mkNthCo r2 3 kind_co' - subst = mkCvSubst in_scope $ - -- We need both the free vars of the `t2` and the - -- free vars of the range of the substitution in - -- scope. All the free vars of `t2` and `kind_co` should - -- already be in `in_scope`, because they've been - -- linted and `cv2` has the same unique as `cv1`. - -- See Note [The substitution invariant] in GHC.Core.TyCo.Subst. - unitVarEnv cv1 (eta1 `mkTransCo` (mkCoVarCo cv2) - `mkTransCo` (mkSymCo eta2)) - tyr = mkTyCoInvForAllTy cv2 $ - substTy subst t2 - ; return (liftedTypeKind, liftedTypeKind, tyl, tyr, r) } } - -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep +lintCoercion co@(ForAllCo tcv kind_co body_co) + | not (isTyCoVar tcv) + = failWithL (text "Non tyco binder in ForAllCo:" <+> ppr co) + | otherwise + = do { kind_co' <- lintStarCoercion kind_co + ; lintTyCoBndr tcv $ \tcv' -> + do { body_co' <- lintCoercion body_co + ; ensureEqTys (varType tcv') (coercionLKind kind_co') $ + text "Kind mis-match in ForallCo" <+> ppr co + + -- Assuming kind_co :: k1 ~ k2 + -- Need to check that + -- (forall (tcv:k1). lty) and + -- (forall (tcv:k2). rty[(tcv:k2) |> sym kind_co/tcv]) + -- are both well formed. Easiest way is to call lintForAllBody + -- for each; there is actually no need to do the funky substitution + ; let Pair lty rty = coercionKind body_co' + ; lintForAllBody tcv' lty + ; lintForAllBody tcv' rty + + ; when (isCoVar tcv) $ + lintL (almostDevoidCoVarOfCo tcv body_co) $ + text "Covar can only appear in Refl and GRefl: " <+> ppr co + -- See "last wrinkle" in GHC.Core.Coercion + -- Note [Unused coercion variable in ForAllCo] + -- and c.f. GHC.Core.TyCo.Rep Note [Unused coercion variable in ForAllTy] + + ; return (ForAllCo tcv' kind_co' body_co') } } lintCoercion co@(FunCo r co1 co2) - = do { (k1,k'1,s1,t1,r1) <- lintCoercion co1 - ; (k2,k'2,s2,t2,r2) <- lintCoercion co2 - ; k <- lintArrow (text "coercion" <+> quotes (ppr co)) k1 k2 - ; k' <- lintArrow (text "coercion" <+> quotes (ppr co)) k'1 k'2 - ; lintRole co1 r r1 - ; lintRole co2 r r2 - ; return (k, k', mkVisFunTy s1 s2, mkVisFunTy t1 t2, r) } - -lintCoercion (CoVarCo cv) - | not (isCoVar cv) - = failWithL (hang (text "Bad CoVarCo:" <+> ppr cv) - 2 (text "With offending type:" <+> ppr (varType cv))) - | otherwise - = do { cv' <- lintTyCoVarInScope cv - ; lintUnliftedCoVar cv' - ; return $ coVarKindsTypesRole cv' } + = do { co1' <- lintCoercion co1 + ; co2' <- lintCoercion co2 + ; let Pair lt1 rt1 = coercionKind co1 + Pair lt2 rt2 = coercionKind co2 + ; lintArrow (text "coercion" <+> quotes (ppr co)) lt1 lt2 + ; lintArrow (text "coercion" <+> quotes (ppr co)) rt1 rt2 + ; lintRole co1 r (coercionRole co1) + ; lintRole co2 r (coercionRole co2) + ; return (FunCo r co1' co2') } -- See Note [Bad unsafe coercion] lintCoercion co@(UnivCo prov r ty1 ty2) - = do { k1 <- lintType ty1 - ; k2 <- lintType ty2 - ; case prov of - PhantomProv kco -> do { lintRole co Phantom r - ; check_kinds kco k1 k2 } - - ProofIrrelProv kco -> do { lintL (isCoercionTy ty1) $ - mkBadProofIrrelMsg ty1 co - ; lintL (isCoercionTy ty2) $ - mkBadProofIrrelMsg ty2 co - ; check_kinds kco k1 k2 } - - PluginProv _ -> return () -- no extra checks + = do { ty1' <- lintType ty1 + ; ty2' <- lintType ty2 + ; let k1 = typeKind ty1' + k2 = typeKind ty2' + ; prov' <- lint_prov k1 k2 prov ; when (r /= Phantom && classifiesTypeWithValues k1 && classifiesTypeWithValues k2) (checkTypes ty1 ty2) - ; return (k1, k2, ty1, ty2, r) } + + ; return (UnivCo prov' r ty1' ty2') } where report s = hang (text $ "Unsafe coercion: " ++ s) 2 (vcat [ text "From:" <+> ppr ty1 @@ -1926,39 +1955,53 @@ lintCoercion co@(UnivCo prov r ty1 ty2) _ -> return () } - check_kinds kco k1 k2 = do { (k1', k2') <- lintStarCoercion kco - ; ensureEqTys k1 k1' (mkBadUnivCoMsg CLeft co) - ; ensureEqTys k2 k2' (mkBadUnivCoMsg CRight co) } + lint_prov k1 k2 (PhantomProv kco) + = do { kco' <- lintStarCoercion kco + ; lintRole co Phantom r + ; check_kinds kco' k1 k2 + ; return (PhantomProv kco') } + + lint_prov k1 k2 (ProofIrrelProv kco) + = do { lintL (isCoercionTy ty1) (mkBadProofIrrelMsg ty1 co) + ; lintL (isCoercionTy ty2) (mkBadProofIrrelMsg ty2 co) + ; kco' <- lintStarCoercion kco + ; check_kinds kco k1 k2 + ; return (ProofIrrelProv kco') } + + lint_prov _ _ prov@(PluginProv _) = return prov + + check_kinds kco k1 k2 + = do { let Pair k1' k2' = coercionKind kco + ; ensureEqTys k1 k1' (mkBadUnivCoMsg CLeft co) + ; ensureEqTys k2 k2' (mkBadUnivCoMsg CRight co) } lintCoercion (SymCo co) - = do { (k1, k2, ty1, ty2, r) <- lintCoercion co - ; return (k2, k1, ty2, ty1, r) } + = do { co' <- lintCoercion co + ; return (SymCo co') } lintCoercion co@(TransCo co1 co2) - = do { (k1a, _k1b, ty1a, ty1b, r1) <- lintCoercion co1 - ; (_k2a, k2b, ty2a, ty2b, r2) <- lintCoercion co2 + = do { co1' <- lintCoercion co1 + ; co2' <- lintCoercion co2 + ; let ty1b = coercionRKind co1' + ty2a = coercionLKind co2' ; ensureEqTys ty1b ty2a (hang (text "Trans coercion mis-match:" <+> ppr co) - 2 (vcat [ppr ty1a, ppr ty1b, ppr ty2a, ppr ty2b])) - ; lintRole co r1 r2 - ; return (k1a, k2b, ty1a, ty2b, r1) } + 2 (vcat [ppr (coercionKind co1'), ppr (coercionKind co2')])) + ; lintRole co (coercionRole co1) (coercionRole co2) + ; return (TransCo co1' co2') } lintCoercion the_co@(NthCo r0 n co) - = do { (_, _, s, t, r) <- lintCoercion co + = do { co' <- lintCoercion co + ; let (Pair s t, r) = coercionKindRole co' ; case (splitForAllTy_maybe s, splitForAllTy_maybe t) of - { (Just (tcv_s, _ty_s), Just (tcv_t, _ty_t)) + { (Just _, Just _) -- works for both tyvar and covar | n == 0 , (isForAllTy_ty s && isForAllTy_ty t) || (isForAllTy_co s && isForAllTy_co t) -> do { lintRole the_co Nominal r0 - ; return (ks, kt, ts, tt, r0) } - where - ts = varType tcv_s - tt = varType tcv_t - ks = typeKind ts - kt = typeKind tt + ; return (NthCo r0 n co') } ; _ -> case (splitTyConApp_maybe s, splitTyConApp_maybe t) of { (Just (tc_s, tys_s), Just (tc_t, tys_t)) @@ -1968,62 +2011,51 @@ lintCoercion the_co@(NthCo r0 n co) , tys_s `equalLength` tys_t , tys_s `lengthExceeds` n -> do { lintRole the_co tr r0 - ; return (ks, kt, ts, tt, r0) } - where - ts = getNth tys_s n - tt = getNth tys_t n - tr = nthRole r tc_s n - ks = typeKind ts - kt = typeKind tt + ; return (NthCo r0 n co') } + where + tr = nthRole r tc_s n ; _ -> failWithL (hang (text "Bad getNth:") 2 (ppr the_co $$ ppr s $$ ppr t)) }}} lintCoercion the_co@(LRCo lr co) - = do { (_,_,s,t,r) <- lintCoercion co + = do { co' <- lintCoercion co + ; let Pair s t = coercionKind co' + r = coercionRole co' ; lintRole co Nominal r ; case (splitAppTy_maybe s, splitAppTy_maybe t) of - (Just s_pr, Just t_pr) - -> return (ks_pick, kt_pick, s_pick, t_pick, Nominal) - where - s_pick = pickLR lr s_pr - t_pick = pickLR lr t_pr - ks_pick = typeKind s_pick - kt_pick = typeKind t_pick - + (Just _, Just _) -> return (LRCo lr co') _ -> failWithL (hang (text "Bad LRCo:") 2 (ppr the_co $$ ppr s $$ ppr t)) } lintCoercion (InstCo co arg) - = do { (k3, k4, t1',t2', r) <- lintCoercion co - ; (k1',k2',s1,s2, r') <- lintCoercion arg - ; lintRole arg Nominal r' - ; in_scope <- getInScope - ; case (splitForAllTy_ty_maybe t1', splitForAllTy_ty_maybe t2') of + = do { co' <- lintCoercion co + ; arg' <- lintCoercion arg + ; let Pair t1' t2' = coercionKind co' + Pair s1 s2 = coercionKind arg + + ; lintRole arg Nominal (coercionRole arg') + + ; case (splitForAllTy_ty_maybe t1', splitForAllTy_ty_maybe t2') of -- forall over tvar - { (Just (tv1,t1), Just (tv2,t2)) - | k1' `eqType` tyVarKind tv1 - , k2' `eqType` tyVarKind tv2 - -> return (k3, k4, - substTyWithInScope in_scope [tv1] [s1] t1, - substTyWithInScope in_scope [tv2] [s2] t2, r) + { (Just (tv1,_), Just (tv2,_)) + | typeKind s1 `eqType` tyVarKind tv1 + , typeKind s2 `eqType` tyVarKind tv2 + -> return (InstCo co' arg') | otherwise -> failWithL (text "Kind mis-match in inst coercion") + ; _ -> case (splitForAllTy_co_maybe t1', splitForAllTy_co_maybe t2') of -- forall over covar - { (Just (cv1, t1), Just (cv2, t2)) - | k1' `eqType` varType cv1 - , k2' `eqType` varType cv2 - , CoercionTy s1' <- s1 - , CoercionTy s2' <- s2 - -> do { return $ - (liftedTypeKind, liftedTypeKind - -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep - , substTy (mkCvSubst in_scope $ unitVarEnv cv1 s1') t1 - , substTy (mkCvSubst in_scope $ unitVarEnv cv2 s2') t2 - , r) } + { (Just (cv1, _), Just (cv2, _)) + | typeKind s1 `eqType` varType cv1 + , typeKind s2 `eqType` varType cv2 + , CoercionTy _ <- s1 + , CoercionTy _ <- s2 + -> return (InstCo co' arg') | otherwise -> failWithL (text "Kind mis-match in inst coercion") + ; _ -> failWithL (text "Bad argument of inst") }}} lintCoercion co@(AxiomInstCo con ind cos) @@ -2031,73 +2063,69 @@ lintCoercion co@(AxiomInstCo con ind cos) (bad_ax (text "index out of range")) ; let CoAxBranch { cab_tvs = ktvs , cab_cvs = cvs - , cab_roles = roles - , cab_lhs = lhs - , cab_rhs = rhs } = coAxiomNthBranch con ind + , cab_roles = roles } = coAxiomNthBranch con ind ; unless (cos `equalLength` (ktvs ++ cvs)) $ bad_ax (text "lengths") + ; cos' <- mapM lintCoercion cos ; subst <- getTCvSubst ; let empty_subst = zapTCvSubst subst - ; (subst_l, subst_r) <- foldlM check_ki - (empty_subst, empty_subst) - (zip3 (ktvs ++ cvs) roles cos) - ; let lhs' = substTys subst_l lhs - rhs' = substTy subst_r rhs - fam_tc = coAxiomTyCon con + ; _ <- foldlM check_ki (empty_subst, empty_subst) + (zip3 (ktvs ++ cvs) roles cos') + ; let fam_tc = coAxiomTyCon con ; case checkAxInstCo co of Just bad_branch -> bad_ax $ text "inconsistent with" <+> pprCoAxBranch fam_tc bad_branch Nothing -> return () - ; let s2 = mkTyConApp fam_tc lhs' - ; return (typeKind s2, typeKind rhs', s2, rhs', coAxiomRole con) } + ; return (AxiomInstCo con ind cos') } where bad_ax what = addErrL (hang (text "Bad axiom application" <+> parens what) 2 (ppr co)) - check_ki (subst_l, subst_r) (ktv, role, arg) - = do { (k', k'', s', t', r) <- lintCoercion arg - ; lintRole arg role r + check_ki (subst_l, subst_r) (ktv, role, arg') + = do { let Pair s' t' = coercionKind arg' + sk' = typeKind s' + tk' = typeKind t' + ; lintRole arg' role (coercionRole arg') ; let ktv_kind_l = substTy subst_l (tyVarKind ktv) ktv_kind_r = substTy subst_r (tyVarKind ktv) - ; unless (k' `eqType` ktv_kind_l) - (bad_ax (text "check_ki1" <+> vcat [ ppr co, ppr k', ppr ktv, ppr ktv_kind_l ] )) - ; unless (k'' `eqType` ktv_kind_r) - (bad_ax (text "check_ki2" <+> vcat [ ppr co, ppr k'', ppr ktv, ppr ktv_kind_r ] )) + ; unless (sk' `eqType` ktv_kind_l) + (bad_ax (text "check_ki1" <+> vcat [ ppr co, ppr sk', ppr ktv, ppr ktv_kind_l ] )) + ; unless (tk' `eqType` ktv_kind_r) + (bad_ax (text "check_ki2" <+> vcat [ ppr co, ppr tk', ppr ktv, ppr ktv_kind_r ] )) ; return (extendTCvSubst subst_l ktv s', extendTCvSubst subst_r ktv t') } lintCoercion (KindCo co) - = do { (k1, k2, _, _, _) <- lintCoercion co - ; return (liftedTypeKind, liftedTypeKind, k1, k2, Nominal) } + = do { co' <- lintCoercion co + ; return (KindCo co') } lintCoercion (SubCo co') - = do { (k1,k2,s,t,r) <- lintCoercion co' - ; lintRole co' Nominal r - ; return (k1,k2,s,t,Representational) } - -lintCoercion this@(AxiomRuleCo co cs) - = do { eqs <- mapM lintCoercion cs - ; lintRoles 0 (coaxrAsmpRoles co) eqs - ; case coaxrProves co [ Pair l r | (_,_,l,r,_) <- eqs ] of + = do { co' <- lintCoercion co' + ; lintRole co' Nominal (coercionRole co') + ; return (SubCo co') } + +lintCoercion this@(AxiomRuleCo ax cos) + = do { cos' <- mapM lintCoercion cos + ; lint_roles 0 (coaxrAsmpRoles ax) cos' + ; case coaxrProves ax (map coercionKind cos') of Nothing -> err "Malformed use of AxiomRuleCo" [ ppr this ] - Just (Pair l r) -> - return (typeKind l, typeKind r, l, r, coaxrRole co) } + Just _ -> return (AxiomRuleCo ax cos') } where err m xs = failWithL $ - hang (text m) 2 $ vcat (text "Rule:" <+> ppr (coaxrName co) : xs) + hang (text m) 2 $ vcat (text "Rule:" <+> ppr (coaxrName ax) : xs) - lintRoles n (e : es) ((_,_,_,_,r) : rs) - | e == r = lintRoles (n+1) es rs + lint_roles n (e : es) (co : cos) + | e == coercionRole co = lint_roles (n+1) es cos | otherwise = err "Argument roles mismatch" [ text "In argument:" <+> int (n+1) , text "Expected:" <+> ppr e - , text "Found:" <+> ppr r ] - lintRoles _ [] [] = return () - lintRoles n [] rs = err "Too many coercion arguments" + , text "Found:" <+> ppr (coercionRole co) ] + lint_roles _ [] [] = return () + lint_roles n [] rs = err "Too many coercion arguments" [ text "Expected:" <+> int n , text "Provided:" <+> int (n + length rs) ] - lintRoles n es [] = err "Not enough coercion arguments" + lint_roles n es [] = err "Not enough coercion arguments" [ text "Expected:" <+> int (n + length es) , text "Provided:" <+> int n ] @@ -2106,13 +2134,6 @@ lintCoercion (HoleCo h) ; lintCoercion (CoVarCo (coHoleCoVar h)) } ----------- -lintUnliftedCoVar :: CoVar -> LintM () -lintUnliftedCoVar cv - = when (not (isUnliftedType (coVarKind cv))) $ - failWithL (text "Bad lifted equality:" <+> ppr cv - <+> dcolon <+> ppr (coVarKind cv)) - {- ************************************************************************ * * @@ -2129,12 +2150,19 @@ data LintEnv , le_subst :: TCvSubst -- Current TyCo substitution -- See Note [Linting type lets] - -- /Only/ substitutes for type variables; - -- but might clone CoVars - -- We also use le_subst to keep track of - -- in-scope TyVars and CoVars + -- /Only/ substitutes for type variables; + -- but might clone CoVars + -- We also use le_subst to keep track of + -- in-scope TyVars and CoVars (but not Ids) + -- Range of the TCvSubst is LintedType/LintedCo + + , le_ids :: VarEnv (Id, LintedType) -- In-scope Ids + -- Used to check that occurrences have an enclosing binder. + -- The Id is /pre-substitution/, used to check that + -- the occurrence has an identical type to the binder + -- The LintedType is used to return the type of the occurrence, + -- without having to lint it again. - , le_ids :: IdSet -- In-scope Ids , le_joins :: IdSet -- Join points in scope that are valid -- A subset of the InScopeSet in le_subst -- See Note [Join points] @@ -2266,6 +2294,7 @@ instance HasDynFlags LintM where data LintLocInfo = RhsOf Id -- The variable bound + | OccOf Id -- Occurrence of id | LambdaBodyOf Id -- The lambda-binder | UnfoldingOf Id -- Unfolding of a binder | BodyOfLetRec [Id] -- One of the binders @@ -2278,7 +2307,6 @@ data LintLocInfo | ImportedUnfolding SrcLoc -- Some imported unfolding (ToDo: say which) | TopLevelBindings | InType Type -- Inside a type - | InKind Type Kind -- Inside a kind | InCo Coercion -- Inside a coercion initL :: DynFlags -> LintFlags -> [Var] @@ -2293,7 +2321,7 @@ initL dflags flags vars m (tcvs, ids) = partition isTyCoVar vars env = LE { le_flags = flags , le_subst = mkEmptyTCvSubst (mkInScopeSet (mkVarSet tcvs)) - , le_ids = mkVarSet ids + , le_ids = mkVarEnv [(id, (id,idType id)) | id <- ids] , le_joins = emptyVarSet , le_loc = [] , le_dynflags = dflags } @@ -2341,7 +2369,7 @@ addWarnL msg = LintM $ \ env (warns,errs) -> addMsg :: Bool -> LintEnv -> Bag MsgDoc -> MsgDoc -> Bag MsgDoc addMsg is_error env msgs msg - = ASSERT( notNull loc_msgs ) + = ASSERT2( notNull loc_msgs, msg ) msgs `snocBag` mk_msg msg where loc_msgs :: [(SrcLoc, SDoc)] -- Innermost first @@ -2373,18 +2401,17 @@ inCasePat = LintM $ \ env errs -> (Just (is_case_pat env), errs) is_case_pat (LE { le_loc = CasePat {} : _ }) = True is_case_pat _other = False -addInScopeTyCoVar :: Var -> LintM a -> LintM a -addInScopeTyCoVar var m - = LintM $ \ env errs -> - unLintM m (env { le_subst = extendTCvInScope (le_subst env) var }) errs - -addInScopeId :: Id -> LintM a -> LintM a -addInScopeId id m - = LintM $ \ env errs -> - unLintM m (env { le_ids = extendVarSet (le_ids env) id - , le_joins = delVarSet (le_joins env) id }) errs +addInScopeId :: Id -> LintedType -> LintM a -> LintM a +addInScopeId id linted_ty m + = LintM $ \ env@(LE { le_ids = id_set, le_joins = join_set }) errs -> + unLintM m (env { le_ids = extendVarEnv id_set id (id, linted_ty) + , le_joins = add_joins join_set }) errs + where + add_joins join_set + | isJoinId id = extendVarSet join_set id -- Overwrite with new arity + | otherwise = delVarSet join_set id -- Remove any existing binding -getInScopeIds :: LintM IdSet +getInScopeIds :: LintM (VarEnv (Id,LintedType)) getInScopeIds = LintM (\env errs -> (Just (le_ids env), errs)) extendTvSubstL :: TyVar -> Type -> LintM a -> LintM a @@ -2404,13 +2431,6 @@ markAllJoinsBadIf :: Bool -> LintM a -> LintM a markAllJoinsBadIf True m = markAllJoinsBad m markAllJoinsBadIf False m = m -addGoodJoins :: [Var] -> LintM a -> LintM a -addGoodJoins vars thing_inside - = LintM $ \ env errs -> unLintM thing_inside (add_joins env) errs - where - add_joins env = env { le_joins = le_joins env `extendVarSetList` join_ids } - join_ids = filter isJoinId vars - getValidJoins :: LintM IdSet getValidJoins = LintM (\ env errs -> (Just (le_joins env), errs)) @@ -2420,20 +2440,17 @@ getTCvSubst = LintM (\ env errs -> (Just (le_subst env), errs)) getInScope :: LintM InScopeSet getInScope = LintM (\ env errs -> (Just (getTCvInScope $ le_subst env), errs)) -applySubstTy :: InType -> LintM OutType -applySubstTy ty = do { subst <- getTCvSubst; return (substTy subst ty) } - -applySubstCo :: InCoercion -> LintM OutCoercion -applySubstCo co = do { subst <- getTCvSubst; return (substCo subst co) } - -lookupIdInScope :: Id -> LintM Id +lookupIdInScope :: Id -> LintM (Id, LintedType) lookupIdInScope id_occ = do { in_scope_ids <- getInScopeIds - ; case lookupVarSet in_scope_ids id_occ of - Just id_bnd -> do { checkL (not (bad_global id_bnd)) global_in_scope - ; return id_bnd } + ; case lookupVarEnv in_scope_ids id_occ of + Just (id_bndr, linted_ty) + -> do { checkL (not (bad_global id_bndr)) global_in_scope + ; return (id_bndr, linted_ty) } Nothing -> do { checkL (not is_local) local_out_of_scope - ; return id_occ } } + ; return (id_occ, idType id_occ) } } + -- We don't bother to lint the type + -- of global (i.e. imported) Ids where is_local = mustHaveLocalBinding id_occ local_out_of_scope = text "Out of scope:" <+> pprBndr LetBind id_occ @@ -2461,16 +2478,7 @@ lookupJoinId id Just id' -> return (isJoinId_maybe id') Nothing -> return Nothing } -lintTyCoVarInScope :: TyCoVar -> LintM TyCoVar -lintTyCoVarInScope var - = do { subst <- getTCvSubst - ; case lookupInScope (getTCvInScope subst) var of - Just var' -> return var' - Nothing -> failWithL $ - hang (text "The TyCo variable" <+> pprBndr LetBind var) - 2 (text "is out of scope") } - -ensureEqTys :: OutType -> OutType -> MsgDoc -> LintM () +ensureEqTys :: LintedType -> LintedType -> MsgDoc -> LintM () -- check ty2 is subtype of ty1 (ie, has same structure but usage -- annotations need only be consistent, not equal) -- Assumes ty1,ty2 are have already had the substitution applied @@ -2500,6 +2508,9 @@ dumpLoc :: LintLocInfo -> (SrcLoc, SDoc) dumpLoc (RhsOf v) = (getSrcLoc v, text "In the RHS of" <+> pp_binders [v]) +dumpLoc (OccOf v) + = (getSrcLoc v, text "In an occurrence of" <+> pp_binder v) + dumpLoc (LambdaBodyOf b) = (getSrcLoc b, text "In the body of lambda with binder" <+> pp_binder b) @@ -2534,8 +2545,6 @@ dumpLoc TopLevelBindings = (noSrcLoc, Outputable.empty) dumpLoc (InType ty) = (noSrcLoc, text "In the type" <+> quotes (ppr ty)) -dumpLoc (InKind ty ki) - = (noSrcLoc, text "In the kind of" <+> parens (ppr ty <+> dcolon <+> ppr ki)) dumpLoc (InCo co) = (noSrcLoc, text "In the coercion" <+> quotes (ppr co)) @@ -2780,7 +2789,7 @@ mkJoinBndrOccMismatchMsg bndr join_arity_bndr join_arity_occ , text "Arity at binding site:" <+> ppr join_arity_bndr , text "Arity at occurrence: " <+> ppr join_arity_occ ] -mkBndrOccTypeMismatchMsg :: Var -> Var -> OutType -> OutType -> SDoc +mkBndrOccTypeMismatchMsg :: Var -> Var -> LintedType -> LintedType -> SDoc mkBndrOccTypeMismatchMsg bndr var bndr_ty var_ty = vcat [ text "Mismatch in type between binder and occurrence" , text "Binder:" <+> ppr bndr <+> dcolon <+> ppr bndr_ty ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -2447,7 +2447,7 @@ normally it would make no sense to have forall r. (ty :: K r) because the kind of the forall would escape the binding of 'r'. But in this case it's fine because (K r) exapands -to Type, so we expliclity /permit/ the type +to Type, so we explicitly /permit/ the type forall r. T r To accommodate such a type, in typeKind (forall a.ty) we use @@ -2455,8 +2455,13 @@ occCheckExpand to expand any type synonyms in the kind of 'ty' to eliminate 'a'. See kinding rule (FORALL) in Note [Kinding rules for types] -And in TcValidity.checkEscapingKind, we use also use -occCheckExpand, for the same reason. +See also + * TcUnify.occCheckExpand + * GHC.Core.Utils.coreAltsType + * TcValidity.checkEscapingKind +all of which grapple with with the same problem. + +See #14939. -} ----------------------------- ===================================== testsuite/tests/indexed-types/should_compile/T17923.hs ===================================== @@ -0,0 +1,44 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# OPTIONS_GHC -Wall #-} +module Bug where + +import Data.Kind + +-- type SingFunction2 f = forall t1 t2. Sing t1 -> Sing t2 -> Sing (f `Apply` t1 `Apply` t2) +type SingFunction2 f = forall t1. Sing t1 -> forall t2. Sing t2 -> Sing (f `Apply` t1 `Apply` t2) +singFun2 :: forall f. SingFunction2 f -> Sing f +singFun2 f = SLambda (\x -> SLambda (f x)) + +type family Sing :: k -> Type +data TyFun :: Type -> Type -> Type +type a ~> b = TyFun a b -> Type +infixr 0 ~> + +type family Apply (f :: a ~> b) (x :: a) :: b +data Sym4 a +data Sym3 a + +type instance Apply Sym3 _ = Sym4 + +newtype SLambda (f :: k1 ~> k2) = + SLambda { applySing :: forall t. Sing t -> Sing (Apply f t) } +type instance Sing = SLambda + +und :: a +und = undefined + +data E +data ShowCharSym0 :: E ~> E ~> E + +sShow_tuple :: SLambda Sym4 +sShow_tuple + = applySing (singFun2 @Sym3 und) + (und (singFun2 @Sym3 + (und (applySing (singFun2 @Sym3 und) + (applySing (singFun2 @ShowCharSym0 und) und))))) ===================================== testsuite/tests/indexed-types/should_compile/all.T ===================================== @@ -294,3 +294,4 @@ test('T16828', normal, compile, ['']) test('T17008b', normal, compile, ['']) test('T17056', normal, compile, ['']) test('T17405', normal, multimod_compile, ['T17405c', '-v0']) +test('T17923', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1e135c8aa46f056aa6bdbd5a31d6da0dabdf0c0e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1e135c8aa46f056aa6bdbd5a31d6da0dabdf0c0e You're receiving 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 Mar 29 13:28:00 2020 From: gitlab at gitlab.haskell.org (Andreas Klebinger) Date: Sun, 29 Mar 2020 09:28:00 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/andreask/hadrian_idx_state Message-ID: <5e80a2606ac4b_61677b155d811937b6@gitlab.haskell.org.mail> Andreas Klebinger pushed new branch wip/andreask/hadrian_idx_state at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/andreask/hadrian_idx_state You're receiving 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 Mar 29 14:28:16 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 29 Mar 2020 10:28:16 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 21 commits: Remove unused `ghciTablesNextToCode` from compiler proper Message-ID: <5e80b080cb6a_61671196b3f412116ab@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - 9229ac3e by Sylvain Henry at 2020-03-29T10:27:26-04:00 Modules: Types (#13009) Update Haddock submodule Metric Increase: haddock.compiler - - - - - 15b30937 by Sylvain Henry at 2020-03-29T10:27:26-04:00 Remove GHC.Types.Unique.Map module This module isn't used anywhere in GHC. - - - - - f13e2c37 by Sylvain Henry at 2020-03-29T10:27:26-04:00 Merge GHC.Types.CostCentre.Init into GHC.Driver.CodeOutput - - - - - fb01a5d0 by Simon Peyton Jones at 2020-03-29T10:27:27-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. - - - - - 9c2ab5be by Ben Gamari at 2020-03-29T10:27:28-04:00 testsuite: Fix T17786 on Windows Fixes line ending normalization issue. - - - - - 0485a9b0 by Ben Gamari at 2020-03-29T10:27:28-04:00 testsuite: Fix T17786 Fix missing quoting and expected exit code. - - - - - 6f922356 by Ben Gamari at 2020-03-29T10:27:28-04:00 testsuite: Mark T12971 as broken on Windows Due to #17945. - - - - - 53b2f709 by Sylvain Henry at 2020-03-29T10:27:30-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. - - - - - 443fc20d by Marius Bakke at 2020-03-29T10:27:34-04:00 testsuite: Remove test that dlopens a PIE object. glibc 2.30 disallowed dlopening PIE objects, so just remove the test. Fixes #17952. - - - - - b5c1d43d by Andreas Klebinger at 2020-03-29T10:27:35-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. - - - - - aeb111e8 by Andreas Klebinger at 2020-03-29T10:27:35-04:00 Apply suggestion to libraries/base/Data/Bits.hs - - - - - 7dba8041 by Ben Gamari at 2020-03-29T10:27:36-04:00 gitlab-ci: Add FreeBSD release job - - - - - 16c0a263 by Ryan Scott at 2020-03-29T10:27:37-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. - - - - - 300f3c70 by Krzysztof Gogolewski at 2020-03-29T10:27:53-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. - - - - - 39f9ead5 by Ryan Scott at 2020-03-29T10:27:54-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. - - - - - a1c91185 by Ryan Scott at 2020-03-29T10:27:55-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. - - - - - 45185726 by Ömer Sinan Ağacan at 2020-03-29T10:28:00-04:00 Simplify stderrSupportsAnsiColors The combinator andM is used only once, and the code is shorter and simpler if you inline it. - - - - - 06ac6912 by Ben Gamari at 2020-03-29T10:28:01-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. - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC.hs - 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/BlockId.hs - compiler/GHC/Cmm/BlockId.hs-boot - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow.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.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/Ppr.hs - compiler/GHC/Cmm/ProcPoint.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Switch/Implement.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/8c2ad322741a4628ce65e6e625bb9911e2d598ba...06ac69128b5872b5ae84e124be0fbea818ec427e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8c2ad322741a4628ce65e6e625bb9911e2d598ba...06ac69128b5872b5ae84e124be0fbea818ec427e You're receiving 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 Mar 29 15:03:35 2020 From: gitlab at gitlab.haskell.org (Andreas Klebinger) Date: Sun, 29 Mar 2020 11:03:35 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/andreask/hadrian_ghci_fix Message-ID: <5e80b8c7ab27e_61677b155d812341e4@gitlab.haskell.org.mail> Andreas Klebinger pushed new branch wip/andreask/hadrian_ghci_fix at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/andreask/hadrian_ghci_fix You're receiving 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 Mar 29 15:09:59 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Sun, 29 Mar 2020 11:09:59 -0400 Subject: [Git][ghc/ghc][wip/dmdanal-precise-exn] Revert "Change forcesRealWorld to work like the old IO hack" Message-ID: <5e80ba472aa77_61673f81cca05dd8123742b@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/dmdanal-precise-exn at Glasgow Haskell Compiler / GHC Commits: 8ebfdf4f by Sebastian Graf at 2020-03-29T17:09:50+02:00 Revert "Change forcesRealWorld to work like the old IO hack" This reverts commit 516987db1eb32bb231063e1e0fa4ff78178b15c9. - - - - - 1 changed file: - compiler/GHC/Core/Op/DmdAnal.hs Changes: ===================================== compiler/GHC/Core/Op/DmdAnal.hs ===================================== @@ -27,7 +27,6 @@ import Data.List ( mapAccumL ) import GHC.Core.DataCon import Id import IdInfo -import TysWiredIn import GHC.Core.Utils import GHC.Core.TyCon import GHC.Core.Type @@ -351,24 +350,19 @@ forcesRealWorld :: FamInstEnvs -> Type -> Bool forcesRealWorld fam_envs = go initRecTc where go :: RecTcChecker -> Type -> Bool - go _rec_tc ty - | Just (dc, _, field_tys, _) <- deepSplitProductType_maybe fam_envs ty - , dc == tupleDataCon Unboxed 2 - , ((first_ty,_):_) <- field_tys - , first_ty `eqType` realWorldStatePrimTy + go rec_tc ty + -- Found it! + | ty `eqType` realWorldStatePrimTy = True - -- -- Found it! - -- | ty `eqType` realWorldStatePrimTy - -- = True - -- -- search depth-first - -- | Just (dc, _, field_tys, _) <- deepSplitProductType_maybe fam_envs ty - -- -- don't check the same TyCon twice - -- , Just rec_tc' <- checkRecTc rec_tc (dataConTyCon dc) - -- = any (strict_field_forces rec_tc') field_tys + -- search depth-first + | Just (dc, _, field_tys, _) <- deepSplitProductType_maybe fam_envs ty + -- don't check the same TyCon twice + , Just rec_tc' <- checkRecTc rec_tc (dataConTyCon dc) + = any (strict_field_forces rec_tc') field_tys | otherwise = False - _strict_field_forces rec_tc (field_ty, str_mark) = + strict_field_forces rec_tc (field_ty, str_mark) = (isMarkedStrict str_mark || isLiftedType_maybe field_ty == Just False) && go rec_tc field_ty View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8ebfdf4fb3f0e1c020b166f11864b30cf7587d28 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8ebfdf4fb3f0e1c020b166f11864b30cf7587d28 You're receiving 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 Mar 29 21:28:22 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 29 Mar 2020 17:28:22 -0400 Subject: [Git][ghc/ghc][master] 3 commits: Remove unused `ghciTablesNextToCode` from compiler proper Message-ID: <5e8112f67e0fc_6167e0e2c94125271d@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - 9 changed files: - compiler/GHC/ByteCode/InfoTable.hs - compiler/ghc.mk - compiler/utils/Util.hs - hadrian/src/Settings/Packages.hs - libraries/ghc-heap/GHC/Exts/Heap/InfoTable/Types.hsc - libraries/ghci/GHCi/InfoTable.hsc - libraries/ghci/GHCi/Message.hs - libraries/ghci/GHCi/Run.hs - testsuite/tests/codeGen/should_compile/jmp_tbl.hs Changes: ===================================== compiler/GHC/ByteCode/InfoTable.hs ===================================== @@ -71,6 +71,8 @@ make_constr_itbls hsc_env cons = descr = dataConIdentity dcon - r <- iservCmd hsc_env (MkConInfoTable ptrs' nptrs_really + tables_next_to_code = tablesNextToCode dflags + + r <- iservCmd hsc_env (MkConInfoTable tables_next_to_code ptrs' nptrs_really conNo (tagForCon dflags dcon) descr) return (getName dcon, ItblPtr r) ===================================== compiler/ghc.mk ===================================== @@ -199,14 +199,6 @@ endif ifeq "$(GhcWithInterpreter)" "YES" compiler_stage2_CONFIGURE_OPTS += --flags=ghci -ifeq "$(TablesNextToCode)" "YES" -# Should GHCI be building info tables in the TABLES_NEXT_TO_CODE style -# or not? -# XXX This should logically be a CPP option, but there doesn't seem to -# be a flag for that -compiler_stage2_CONFIGURE_OPTS += --ghc-option=-DGHCI_TABLES_NEXT_TO_CODE -endif - # Should the debugger commands be enabled? ifeq "$(GhciWithDebugger)" "YES" compiler_stage2_CONFIGURE_OPTS += --ghc-option=-DDEBUGGER ===================================== compiler/utils/Util.hs ===================================== @@ -13,7 +13,6 @@ module Util ( -- * Flags dependent on the compiler build ghciSupported, debugIsOn, - ghciTablesNextToCode, isWindowsHost, isDarwinHost, -- * Miscellaneous higher-order functions @@ -203,13 +202,6 @@ debugIsOn = True debugIsOn = False #endif -ghciTablesNextToCode :: Bool -#if defined(GHCI_TABLES_NEXT_TO_CODE) -ghciTablesNextToCode = True -#else -ghciTablesNextToCode = False -#endif - isWindowsHost :: Bool #if defined(mingw32_HOST_OS) isWindowsHost = True ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -62,10 +62,6 @@ packageArgs = do , notM targetSupportsSMP ? arg "--ghc-option=-optc-DNOSMP" , (any (wayUnit Threaded) rtsWays) ? notStage0 ? arg "--ghc-option=-optc-DTHREADED_RTS" - , ghcWithInterpreter ? - flag TablesNextToCode ? - notM (flag GhcUnregisterised) ? - notStage0 ? arg "--ghc-option=-DGHCI_TABLES_NEXT_TO_CODE" , ghcWithInterpreter ? ghciWithDebugger <$> flavour ? notStage0 ? arg "--ghc-option=-DDEBUGGER" ===================================== libraries/ghc-heap/GHC/Exts/Heap/InfoTable/Types.hsc ===================================== @@ -31,10 +31,10 @@ type EntryFunPtr = FunPtr (Ptr () -> IO (Ptr ())) -- -- for more details on this data structure. data StgInfoTable = StgInfoTable { - entry :: Maybe EntryFunPtr, -- Just <=> not ghciTablesNextToCode + entry :: Maybe EntryFunPtr, -- Just <=> not TABLES_NEXT_TO_CODE ptrs :: HalfWord, nptrs :: HalfWord, tipe :: ClosureType, srtlen :: HalfWord, - code :: Maybe ItblCodes -- Just <=> ghciTablesNextToCode + code :: Maybe ItblCodes -- Just <=> TABLES_NEXT_TO_CODE } deriving (Show, Generic) ===================================== libraries/ghci/GHCi/InfoTable.hsc ===================================== @@ -13,27 +13,23 @@ module GHCi.InfoTable mkConInfoTable ) where -import Prelude -- See note [Why do we import Prelude here?] +import Prelude hiding (fail) -- See note [Why do we import Prelude here?] + import Foreign import Foreign.C import GHC.Ptr import GHC.Exts import GHC.Exts.Heap import Data.ByteString (ByteString) +import Control.Monad.Fail import qualified Data.ByteString as BS -ghciTablesNextToCode :: Bool -#if defined(TABLES_NEXT_TO_CODE) -ghciTablesNextToCode = True -#else -ghciTablesNextToCode = False -#endif - -- 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 the 'code' field. -- Otherwise, it should point to the start of the StgInfoTable. mkConInfoTable - :: Int -- ptr words + :: Bool -- TABLES_NEXT_TO_CODE + -> Int -- ptr words -> Int -- non-ptr words -> Int -- constr tag -> Int -- pointer tag @@ -42,23 +38,23 @@ mkConInfoTable -- resulting info table is allocated with allocateExec(), and -- should be freed with freeExec(). -mkConInfoTable ptr_words nonptr_words tag ptrtag con_desc = - castFunPtrToPtr <$> newExecConItbl itbl con_desc - where - entry_addr = interpConstrEntry !! ptrtag - code' = mkJumpToAddr entry_addr +mkConInfoTable tables_next_to_code ptr_words nonptr_words tag ptrtag con_desc = do + let entry_addr = interpConstrEntry !! ptrtag + code' <- if tables_next_to_code + then Just <$> mkJumpToAddr entry_addr + else pure Nothing + let itbl = StgInfoTable { - entry = if ghciTablesNextToCode + entry = if tables_next_to_code then Nothing else Just entry_addr, ptrs = fromIntegral ptr_words, nptrs = fromIntegral nonptr_words, tipe = CONSTR, srtlen = fromIntegral tag, - code = if ghciTablesNextToCode - then Just code' - else Nothing + code = code' } + castFunPtrToPtr <$> newExecConItbl tables_next_to_code itbl con_desc -- ----------------------------------------------------------------------------- @@ -77,41 +73,48 @@ data Arch = ArchSPARC | ArchPPC64 | ArchPPC64LE | ArchS390X - | ArchUnknown deriving Show -platform :: Arch -platform = +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) - ArchSPARC + Just ArchSPARC #elif defined(powerpc_HOST_ARCH) - ArchPPC + Just ArchPPC #elif defined(i386_HOST_ARCH) - ArchX86 + Just ArchX86 #elif defined(x86_64_HOST_ARCH) - ArchX86_64 + Just ArchX86_64 #elif defined(alpha_HOST_ARCH) - ArchAlpha + Just ArchAlpha #elif defined(arm_HOST_ARCH) - ArchARM + Just ArchARM #elif defined(aarch64_HOST_ARCH) - ArchARM64 + Just ArchARM64 #elif defined(powerpc64_HOST_ARCH) - ArchPPC64 + Just ArchPPC64 #elif defined(powerpc64le_HOST_ARCH) - ArchPPC64LE + Just ArchPPC64LE #elif defined(s390x_HOST_ARCH) - ArchS390X + Just ArchS390X #else -# if defined(TABLES_NEXT_TO_CODE) -# error Unimplemented architecture -# else - ArchUnknown -# endif + Nothing #endif -mkJumpToAddr :: EntryFunPtr -> ItblCodes -mkJumpToAddr a = case platform of +mkJumpToAddr' :: Arch -> EntryFunPtr -> ItblCodes +mkJumpToAddr' platform a = case platform of ArchSPARC -> -- After some consideration, we'll try this, where -- 0x55555555 stands in for the address to jump to. @@ -285,11 +288,6 @@ mkJumpToAddr a = case platform of 0xC0, 0x19, byte3 w64, byte2 w64, byte1 w64, byte0 w64, 0x07, 0xF1 ] - -- This code must not be called. You either need to - -- add your architecture as a distinct case or - -- use non-TABLES_NEXT_TO_CODE mode - ArchUnknown -> error "mkJumpToAddr: ArchUnknown is unsupported" - byte0 :: (Integral w) => w -> Word8 byte0 w = fromIntegral w @@ -333,38 +331,40 @@ data StgConInfoTable = StgConInfoTable { pokeConItbl - :: Ptr StgConInfoTable -> Ptr StgConInfoTable -> StgConInfoTable + :: Bool -> Ptr StgConInfoTable -> Ptr StgConInfoTable -> StgConInfoTable -> IO () -pokeConItbl wr_ptr _ex_ptr itbl = do -#if defined(TABLES_NEXT_TO_CODE) - -- Write the offset to the con_desc from the end of the standard InfoTable - -- at the first byte. - let con_desc_offset = conDesc itbl `minusPtr` (_ex_ptr `plusPtr` conInfoTableSizeB) - (#poke StgConInfoTable, con_desc) wr_ptr con_desc_offset -#else - -- Write the con_desc address after the end of the info table. - -- Use itblSize because CPP will not pick up PROFILING when calculating - -- the offset. - pokeByteOff wr_ptr itblSize (conDesc itbl) -#endif +pokeConItbl tables_next_to_code wr_ptr _ex_ptr itbl = do + if tables_next_to_code + then do + -- Write the offset to the con_desc from the end of the standard InfoTable + -- at the first byte. + let con_desc_offset = conDesc itbl `minusPtr` (_ex_ptr `plusPtr` conInfoTableSizeB) + (#poke StgConInfoTable, con_desc) wr_ptr con_desc_offset + else do + -- Write the con_desc address after the end of the info table. + -- Use itblSize because CPP will not pick up PROFILING when calculating + -- the offset. + pokeByteOff wr_ptr itblSize (conDesc itbl) pokeItbl (wr_ptr `plusPtr` (#offset StgConInfoTable, i)) (infoTable itbl) -sizeOfEntryCode :: Int -sizeOfEntryCode - | not ghciTablesNextToCode = 0 - | otherwise = - case mkJumpToAddr undefined of +sizeOfEntryCode :: MonadFail m => Bool -> m Int +sizeOfEntryCode tables_next_to_code + | not tables_next_to_code = pure 0 + | otherwise = do + code' <- mkJumpToAddr undefined + pure $ case code' of Left xs -> sizeOf (head xs) * length xs Right xs -> sizeOf (head xs) * length xs -- Note: Must return proper pointer for use in a closure -newExecConItbl :: StgInfoTable -> ByteString -> IO (FunPtr ()) -newExecConItbl obj con_desc +newExecConItbl :: Bool -> StgInfoTable -> ByteString -> IO (FunPtr ()) +newExecConItbl tables_next_to_code obj con_desc = alloca $ \pcode -> do + sz0 <- sizeOfEntryCode tables_next_to_code let lcon_desc = BS.length con_desc + 1{- null terminator -} -- SCARY -- This size represents the number of bytes in an StgConInfoTable. - sz = fromIntegral (conInfoTableSizeB + sizeOfEntryCode) + sz = fromIntegral $ conInfoTableSizeB + sz0 -- Note: we need to allocate the conDesc string next to the info -- table, because on a 64-bit platform we reference this string -- with a 32-bit offset relative to the info table, so if we @@ -373,17 +373,15 @@ newExecConItbl obj con_desc ex_ptr <- peek pcode let cinfo = StgConInfoTable { conDesc = ex_ptr `plusPtr` fromIntegral sz , infoTable = obj } - pokeConItbl wr_ptr ex_ptr cinfo + pokeConItbl tables_next_to_code wr_ptr ex_ptr cinfo BS.useAsCStringLen con_desc $ \(src, len) -> copyBytes (castPtr wr_ptr `plusPtr` fromIntegral sz) src len let null_off = fromIntegral sz + fromIntegral (BS.length con_desc) poke (castPtr wr_ptr `plusPtr` null_off) (0 :: Word8) _flushExec sz ex_ptr -- Cache flush (if needed) -#if defined(TABLES_NEXT_TO_CODE) - return (castPtrToFunPtr (ex_ptr `plusPtr` conInfoTableSizeB)) -#else - return (castPtrToFunPtr ex_ptr) -#endif + pure $ if tables_next_to_code + then castPtrToFunPtr $ ex_ptr `plusPtr` conInfoTableSizeB + else castPtrToFunPtr ex_ptr foreign import ccall unsafe "allocateExec" _allocateExec :: CUInt -> Ptr (Ptr a) -> IO (Ptr a) ===================================== libraries/ghci/GHCi/Message.hs ===================================== @@ -104,7 +104,8 @@ data Message a where -- | Create an info table for a constructor MkConInfoTable - :: Int -- ptr words + :: Bool -- TABLES_NEXT_TO_CODE + -> Int -- ptr words -> Int -- non-ptr words -> Int -- constr tag -> Int -- pointer tag @@ -477,7 +478,7 @@ getMessage = do 15 -> Msg <$> MallocStrings <$> get 16 -> Msg <$> (PrepFFI <$> get <*> get <*> get) 17 -> Msg <$> FreeFFI <$> get - 18 -> Msg <$> (MkConInfoTable <$> get <*> get <*> get <*> get <*> get) + 18 -> Msg <$> (MkConInfoTable <$> get <*> get <*> get <*> get <*> get <*> get) 19 -> Msg <$> (EvalStmt <$> get <*> get) 20 -> Msg <$> (ResumeStmt <$> get <*> get) 21 -> Msg <$> (AbandonStmt <$> get) @@ -520,7 +521,7 @@ putMessage m = case m of MallocStrings bss -> putWord8 15 >> put bss PrepFFI conv args res -> putWord8 16 >> put conv >> put args >> put res FreeFFI p -> putWord8 17 >> put p - MkConInfoTable p n t pt d -> putWord8 18 >> put p >> put n >> put t >> put pt >> put d + MkConInfoTable tc p n t pt d -> putWord8 18 >> put tc >> put p >> put n >> put t >> put pt >> put d EvalStmt opts val -> putWord8 19 >> put opts >> put val ResumeStmt opts val -> putWord8 20 >> put opts >> put val AbandonStmt val -> putWord8 21 >> put val ===================================== libraries/ghci/GHCi/Run.hs ===================================== @@ -89,8 +89,8 @@ run m = case m of MallocStrings bss -> mapM mkString0 bss PrepFFI conv args res -> toRemotePtr <$> prepForeignCall conv args res FreeFFI p -> freeForeignCallInfo (fromRemotePtr p) - MkConInfoTable ptrs nptrs tag ptrtag desc -> - toRemotePtr <$> mkConInfoTable ptrs nptrs tag ptrtag desc + MkConInfoTable tc ptrs nptrs tag ptrtag desc -> + toRemotePtr <$> mkConInfoTable tc ptrs nptrs tag ptrtag desc StartTH -> startTH GetClosure ref -> do clos <- getClosureData =<< localRef ref ===================================== testsuite/tests/codeGen/should_compile/jmp_tbl.hs ===================================== @@ -4,7 +4,7 @@ This funny module was reduced from a failing build of stage2 using the new code generator and the linear register allocator, with this bug: -"inplace/bin/ghc-stage1" -fPIC -dynamic -H32m -O -Wall -H64m -O0 -package-name ghc-7.1.20110414 -hide-all-packages -i -icompiler/basicTypes -icompiler/cmm -icompiler/codeGen -icompiler/coreSyn -icompiler/deSugar -icompiler/ghci -icompiler/hsSyn -icompiler/iface -icompiler/llvmGen -icompiler/main -icompiler/nativeGen -icompiler/parser -icompiler/prelude -icompiler/profiling -icompiler/rename -icompiler/simplCore -icompiler/simplStg -icompiler/specialise -icompiler/stgSyn -icompiler/stranal -icompiler/typecheck -icompiler/types -icompiler/utils -icompiler/vectorise -icompiler/stage2/build -icompiler/stage2/build/autogen -Icompiler/stage2/build -Icompiler/stage2/build/autogen -Icompiler/../libffi/build/include -Icompiler/stage2 -Icompiler/../libraries/base/cbits -Icompiler/../libraries/base/include -Icompiler/. -Icompiler/parser -Icompiler/utils -optP-DHAVE_INTERNAL_INTERPRETER -optP-include -optPcompiler/stage2/build/autogen/cabal_macros.h -package Cabal-1.11.0 -package array-0.3.0.2 -package base-4.3.1.0 -package ghc-boot-0.0.0.0 -package bytestring-0.9.1.10 -package containers-0.4.0.0 -package directory-1.1.0.0 -package filepath-1.2.0.0 -package hoopl-3.8.7.0 -package hpc-0.5.0.6 -package old-time-1.0.0.6 -package process-1.0.1.4 -package template-haskell-2.5.0.0 -package unix-2.4.1.0 -Wall -fno-warn-name-shadowing -fno-warn-orphans -XHaskell98 -XNondecreasingIndentation -XCPP -XMagicHash -XUnboxedTuples -XPatternGuards -XForeignFunctionInterface -XEmptyDataDecls -XTypeSynonymInstances -XMultiParamTypeClasses -XFlexibleInstances -XRank2Types -XScopedTypeVariables -XDeriveDataTypeable -DGHCI_TABLES_NEXT_TO_CODE -DSTAGE=2 -O2 -O -DGHC_DEFAULT_NEW_CODEGEN -no-user-package-db -rtsopts -odir compiler/stage2/build -hidir compiler/stage2/build -stubdir compiler/stage2/build -hisuf dyn_hi -osuf dyn_o -hcsuf dyn_hc -c compiler/main/DriverPipeline.hs -o compiler/stage2/build/DriverPipeline.dyn_o -fforce-recomp -dno-debug-output -fno-warn-unused-binds +"inplace/bin/ghc-stage1" -fPIC -dynamic -H32m -O -Wall -H64m -O0 -package-name ghc-7.1.20110414 -hide-all-packages -i -icompiler/basicTypes -icompiler/cmm -icompiler/codeGen -icompiler/coreSyn -icompiler/deSugar -icompiler/ghci -icompiler/hsSyn -icompiler/iface -icompiler/llvmGen -icompiler/main -icompiler/nativeGen -icompiler/parser -icompiler/prelude -icompiler/profiling -icompiler/rename -icompiler/simplCore -icompiler/simplStg -icompiler/specialise -icompiler/stgSyn -icompiler/stranal -icompiler/typecheck -icompiler/types -icompiler/utils -icompiler/vectorise -icompiler/stage2/build -icompiler/stage2/build/autogen -Icompiler/stage2/build -Icompiler/stage2/build/autogen -Icompiler/../libffi/build/include -Icompiler/stage2 -Icompiler/../libraries/base/cbits -Icompiler/../libraries/base/include -Icompiler/. -Icompiler/parser -Icompiler/utils -optP-DHAVE_INTERNAL_INTERPRETER -optP-include -optPcompiler/stage2/build/autogen/cabal_macros.h -package Cabal-1.11.0 -package array-0.3.0.2 -package base-4.3.1.0 -package ghc-boot-0.0.0.0 -package bytestring-0.9.1.10 -package containers-0.4.0.0 -package directory-1.1.0.0 -package filepath-1.2.0.0 -package hoopl-3.8.7.0 -package hpc-0.5.0.6 -package old-time-1.0.0.6 -package process-1.0.1.4 -package template-haskell-2.5.0.0 -package unix-2.4.1.0 -Wall -fno-warn-name-shadowing -fno-warn-orphans -XHaskell98 -XNondecreasingIndentation -XCPP -XMagicHash -XUnboxedTuples -XPatternGuards -XForeignFunctionInterface -XEmptyDataDecls -XTypeSynonymInstances -XMultiParamTypeClasses -XFlexibleInstances -XRank2Types -XScopedTypeVariables -XDeriveDataTypeable -DSTAGE=2 -O2 -O -DGHC_DEFAULT_NEW_CODEGEN -no-user-package-db -rtsopts -odir compiler/stage2/build -hidir compiler/stage2/build -stubdir compiler/stage2/build -hisuf dyn_hi -osuf dyn_o -hcsuf dyn_hc -c compiler/main/DriverPipeline.hs -o compiler/stage2/build/DriverPipeline.dyn_o -fforce-recomp -dno-debug-output -fno-warn-unused-binds ghc-stage1: panic! (the 'impossible' happened) (GHC version 7.1.20110414 for x86_64-unknown-linux): View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6d172e63f3dd3590b0a57371efb8f924f1fcdf05...1c446220250dcada51d4bb33a0cc7d8ce572e8b6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6d172e63f3dd3590b0a57371efb8f924f1fcdf05...1c446220250dcada51d4bb33a0cc7d8ce572e8b6 You're receiving 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 Mar 29 21:29:42 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 29 Mar 2020 17:29:42 -0400 Subject: [Git][ghc/ghc][master] Demand analysis: simplify the demand for a RHS Message-ID: <5e811346e0eeb_61675cefcac126087@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 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. - - - - - 13 changed files: - compiler/GHC/Core/Op/CprAnal.hs - compiler/GHC/Core/Op/DmdAnal.hs - compiler/GHC/Core/Op/WorkWrap/Lib.hs - testsuite/tests/perf/should_run/all.T - testsuite/tests/simplCore/should_compile/T4201.stdout - testsuite/tests/stranal/T10482a.hs - testsuite/tests/stranal/should_compile/T10482.stderr - testsuite/tests/stranal/should_compile/T10482a.stderr - testsuite/tests/stranal/sigs/DmdAnalGADTs.stderr - + testsuite/tests/stranal/sigs/T17932.hs - + testsuite/tests/stranal/sigs/T17932.stderr - testsuite/tests/stranal/sigs/UnsatFun.stderr - testsuite/tests/stranal/sigs/all.T Changes: ===================================== compiler/GHC/Core/Op/CprAnal.hs ===================================== @@ -13,7 +13,6 @@ module GHC.Core.Op.CprAnal ( cprAnalProgram ) where import GhcPrelude -import GHC.Core.Op.WorkWrap.Lib ( deepSplitProductType_maybe ) import GHC.Driver.Session import GHC.Types.Demand import GHC.Types.Cpr @@ -30,6 +29,7 @@ import GHC.Core.Utils ( exprIsHNF, dumpIdInfoOfProgram ) import GHC.Core.TyCon import GHC.Core.Type import GHC.Core.FamInstEnv +import GHC.Core.Op.WorkWrap.Lib import Util import ErrUtils ( dumpIfSet_dyn, DumpFormat (..) ) import Maybes ( isJust, isNothing ) @@ -88,7 +88,8 @@ Ideally, we would want the following pipeline: 4. worker/wrapper (for CPR) Currently, we omit 2. and anticipate the results of worker/wrapper. -See Note [CPR in a DataAlt case alternative] and Note [CPR for strict binders]. +See Note [CPR in a DataAlt case alternative] +and Note [CPR for binders that will be unboxed]. An additional w/w pass would simplify things, but probably add slight overhead. So currently we have @@ -175,7 +176,7 @@ cprAnal' env (Lam var body) | otherwise = (lam_ty, Lam var body') where - env' = extendSigsWithLam env var + env' = extendAnalEnvForDemand env var (idDemandInfo var) (body_ty, body') = cprAnal env' body lam_ty = abstractCprTy body_ty @@ -392,15 +393,25 @@ lookupSigEnv env id = lookupVarEnv (ae_sigs env) id nonVirgin :: AnalEnv -> AnalEnv nonVirgin env = env { ae_virgin = False } -extendSigsWithLam :: AnalEnv -> Id -> AnalEnv --- Extend the AnalEnv when we meet a lambda binder -extendSigsWithLam env id +-- | A version of 'extendAnalEnv' for a binder of which we don't see the RHS +-- needed to compute a 'CprSig' (e.g. lambdas and DataAlt field binders). +-- In this case, we can still look at their demand to attach CPR signatures +-- anticipating the unboxing done by worker/wrapper. +-- See Note [CPR for binders that will be unboxed]. +extendAnalEnvForDemand :: AnalEnv -> Id -> Demand -> AnalEnv +extendAnalEnvForDemand env id dmd | isId id - , isStrictDmd (idDemandInfo id) -- See Note [CPR for strict binders] - , Just (dc,_,_,_) <- deepSplitProductType_maybe (ae_fam_envs env) $ idType id + , Just (_, DataConAppContext { dcac_dc = dc }) + <- wantToUnbox (ae_fam_envs env) has_inlineable_prag (idType id) dmd = extendAnalEnv env id (CprSig (conCprType (dataConTag dc))) | otherwise = env + where + -- Rather than maintaining in AnalEnv whether we are in an INLINEABLE + -- function, we just assume that we aren't. That flag is only relevant + -- to Note [Do not unpack class dictionaries], the few unboxing + -- opportunities on dicts it prohibits are probably irrelevant to CPR. + has_inlineable_prag = False extendEnvForDataAlt :: AnalEnv -> CoreExpr -> Id -> DataCon -> [Var] -> AnalEnv -- See Note [CPR in a DataAlt case alternative] @@ -425,18 +436,16 @@ extendEnvForDataAlt env scrut case_bndr dc bndrs -- propagate available unboxed things from the scrutinee, getting rid of -- the is_var_scrut heuristic. See Note [CPR in a DataAlt case alternative]. -- Giving strict binders the CPR property only makes sense for products, as - -- the arguments in Note [CPR for strict binders] don't apply to sums (yet); - -- we lack WW for strict binders of sum type. + -- the arguments in Note [CPR for binders that will be unboxed] don't apply + -- to sums (yet); we lack WW for strict binders of sum type. do_con_arg env (id, str) - | let is_strict = isStrictDmd (idDemandInfo id) || isMarkedStrict str - , is_var_scrut && is_strict - , let fam_envs = ae_fam_envs env - , Just (dc,_,_,_) <- deepSplitProductType_maybe fam_envs $ idType id - = extendAnalEnv env id (CprSig (conCprType (dataConTag dc))) + | is_var scrut + -- See Note [Add demands for strict constructors] in WorkWrap.Lib + , let dmd = applyWhen (isMarkedStrict str) strictifyDmd (idDemandInfo id) + = extendAnalEnvForDemand env id dmd | otherwise = env - is_var_scrut = is_var scrut is_var (Cast e _) = is_var e is_var (Var v) = isLocalId v is_var _ = False @@ -472,7 +481,8 @@ Specifically box. If the wrapper doesn't cancel with its caller, we'll end up re-boxing something that we did have available in boxed form. - * Any strict binders with product type, can use Note [CPR for strict binders] + * Any strict binders with product type, can use + Note [CPR for binders that will be unboxed] to anticipate worker/wrappering for strictness info. But we can go a little further. Consider @@ -499,11 +509,11 @@ Specifically sub-component thereof. But it's simple, and nothing terrible happens if we get it wrong. e.g. Trac #10694. -Note [CPR for strict binders] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -If a lambda-bound variable is marked demanded with a strict demand, then give it -a CPR signature, anticipating the results of worker/wrapper. Here's a concrete -example ('f1' in test T10482a), assuming h is strict: +Note [CPR for binders that will be unboxed] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +If a lambda-bound variable will be unboxed by worker/wrapper (so it must be +demanded strictly), then give it a CPR signature. Here's a concrete example +('f1' in test T10482a), assuming h is strict: f1 :: Int -> Int f1 x = case h x of @@ -527,6 +537,9 @@ Note that has product type, else we may get over-optimistic CPR results (e.g. from \x -> x!). + * This also (approximately) applies to DataAlt field binders; + See Note [CPR in a DataAlt case alternative]. + * See Note [CPR examples] Note [CPR for sum types] @@ -628,21 +641,6 @@ point: all of these functions can have the CPR property. True -> x False -> f1 (x-1) - - ------- f2 ----------- - -- x is a strict field of MkT2, so we'll pass it unboxed - -- to $wf2, so it's available unboxed. This depends on - -- the case expression analysing (a subcomponent of) one - -- of the original arguments to the function, so it's - -- a bit more delicate. - - data T2 = MkT2 !Int Int - - f2 :: T2 -> Int - f2 (MkT2 x y) | y>0 = f2 (MkT2 x (y-1)) - | otherwise = x - - ------- f3 ----------- -- h is strict in x, so x will be unboxed before it -- is rerturned in the otherwise case. @@ -652,18 +650,4 @@ point: all of these functions can have the CPR property. f1 :: T3 -> Int f1 (MkT3 x y) | h x y = f3 (MkT3 x (y-1)) | otherwise = x - - - ------- f4 ----------- - -- Just like f2, but MkT4 can't unbox its strict - -- argument automatically, as f2 can - - data family Foo a - newtype instance Foo Int = Foo Int - - data T4 a = MkT4 !(Foo a) Int - - f4 :: T4 Int -> Int - f4 (MkT4 x@(Foo v) y) | y>0 = f4 (MkT4 x (y-1)) - | otherwise = v -} ===================================== compiler/GHC/Core/Op/DmdAnal.hs ===================================== @@ -617,16 +617,11 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs is_thunk = not (exprIsHNF rhs) && not (isJoinId id) -- | @mkRhsDmd env rhs_arity rhs@ creates a 'CleanDemand' for --- unleashing on the given function's @rhs@, by creating a call demand of --- @rhs_arity@ with a body demand appropriate for possible product types. --- See Note [Product demands for function body]. --- For example, a call of the form @mkRhsDmd _ 2 (\x y -> (x, y))@ returns a --- clean usage demand of @C1(C1(U(U,U)))@. +-- 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 -> CleanDemand -mkRhsDmd env rhs_arity rhs = - case peelTsFuns rhs_arity (findTypeShape (ae_fam_envs env) (exprType rhs)) of - Just (TsProd tss) -> mkCallDmds rhs_arity (cleanEvalProdDmd (length tss)) - _ -> mkCallDmds rhs_arity cleanEvalDmd +mkRhsDmd _env rhs_arity _rhs = mkCallDmds rhs_arity cleanEvalDmd -- | If given the let-bound 'Id', 'useLetUp' determines whether we should -- process the binding up (body before rhs) or down (rhs before body). @@ -857,9 +852,9 @@ forward plusInt's demand signature, and all is well (see Note [Newtype arity] in GHC.Core.Arity)! A small example is the test case NewtypeArity. -Note [Product demands for function body] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -This example comes from shootout/binary_trees: +Historical Note [Product demands for function body] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In 2013 I spotted this example, in shootout/binary_trees: Main.check' = \ b z ds. case z of z' { I# ip -> case ds_d13s of @@ -878,8 +873,12 @@ Here we *really* want to unbox z, even though it appears to be used boxed in the Nil case. Partly the Nil case is not a hot path. But more specifically, the whole function gets the CPR property if we do. -So for the demand on the body of a RHS we use a product demand if it's -a product type. +That motivated using a demand of C(C(C(S(L,L)))) for the RHS, where +(solely because the result was a product) we used a product demand +(albeit with lazy components) for the body. But that gives very silly +behaviour -- see #17932. Happily it turns out now to be entirely +unnecessary: we get good results with C(C(C(S))). So I simply +deleted the special case. ************************************************************************ * * ===================================== compiler/GHC/Core/Op/WorkWrap/Lib.hs ===================================== @@ -8,7 +8,8 @@ A library for the ``worker\/wrapper'' back-end to the strictness analyser module GHC.Core.Op.WorkWrap.Lib ( mkWwBodies, mkWWstr, mkWorkerArgs - , deepSplitProductType_maybe, findTypeShape + , DataConAppContext(..), deepSplitProductType_maybe, wantToUnbox + , findTypeShape , isWorkerSmallEnough ) where @@ -588,21 +589,8 @@ mkWWstr_one dflags fam_envs has_inlineable_prag arg -- (that's what mk_absent_let does) = return (True, [], nop_fn, work_fn) - | isStrictDmd dmd - , Just cs <- splitProdDmd_maybe dmd - -- See Note [Unpacking arguments with product and polymorphic demands] - , not (has_inlineable_prag && isClassPred arg_ty) - -- See Note [Do not unpack class dictionaries] - , Just stuff@(_, _, inst_con_arg_tys, _) <- deepSplitProductType_maybe fam_envs arg_ty - , cs `equalLength` inst_con_arg_tys - -- See Note [mkWWstr and unsafeCoerce] - = unbox_one dflags fam_envs arg cs stuff - - | isSeqDmd dmd -- For seqDmd, splitProdDmd_maybe will return Nothing, but - -- it should behave like , for some suitable arity - , Just stuff@(_, _, inst_con_arg_tys, _) <- deepSplitProductType_maybe fam_envs arg_ty - , let abs_dmds = map (const absDmd) inst_con_arg_tys - = unbox_one dflags fam_envs arg abs_dmds stuff + | Just (cs, acdc) <- wantToUnbox fam_envs has_inlineable_prag arg_ty dmd + = unbox_one dflags fam_envs arg cs acdc | otherwise -- Other cases = return (False, [arg], nop_fn, nop_fn) @@ -611,12 +599,36 @@ 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 fam_envs has_inlineable_prag ty dmd = + case deepSplitProductType_maybe fam_envs ty of + Just dcac at DataConAppContext{ dcac_arg_tys = con_arg_tys } + | isStrictDmd dmd + -- See Note [Unpacking arguments with product and polymorphic demands] + , Just cs <- split_prod_dmd_arity dmd (length con_arg_tys) + -- 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) + _ -> Nothing + where + split_prod_dmd_arity dmd arty + -- For seqDmd, splitProdDmd_maybe will return Nothing (because how would + -- it know the arity?), but it should behave like , for some + -- suitable arity + | isSeqDmd dmd = Just (replicate arty absDmd) + -- Otherwise splitProdDmd_maybe does the job + | otherwise = splitProdDmd_maybe dmd + unbox_one :: DynFlags -> FamInstEnvs -> Var -> [Demand] - -> (DataCon, [Type], [(Type, StrictnessMark)], Coercion) + -> DataConAppContext -> UniqSM (Bool, [Var], CoreExpr -> CoreExpr, CoreExpr -> CoreExpr) unbox_one dflags fam_envs arg cs - (data_con, inst_tys, inst_con_arg_tys, co) + DataConAppContext { dcac_dc = data_con, dcac_tys = inst_tys + , dcac_arg_tys = inst_con_arg_tys + , dcac_co = co } = do { (uniq1:uniqs) <- getUniquesM ; let -- See Note [Add demands for strict constructors] cs' = addDataConStrictness data_con cs @@ -898,8 +910,8 @@ If we have f :: Ord a => [a] -> Int -> a {-# INLINABLE f #-} and we worker/wrapper f, we'll get a worker with an INLINABLE pragma -(see Note [Worker-wrapper for INLINABLE functions] in GHC.Core.Op.WorkWrap), which -can still be specialised by the type-class specialiser, something like +(see Note [Worker-wrapper for INLINABLE functions] in GHC.Core.Op.WorkWrap), +which can still be specialised by the type-class specialiser, something like fw :: Ord a => [a] -> Int# -> a BUT if f is strict in the Ord dictionary, we might unpack it, to get @@ -915,9 +927,29 @@ Historical note: #14955 describes how I got this fix wrong the first time. -} -deepSplitProductType_maybe - :: FamInstEnvs -> Type - -> Maybe (DataCon, [Type], [(Type, StrictnessMark)], Coercion) +-- | 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) +-- +-- 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 :: ![(Type, StrictnessMark)] + , dcac_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 @@ -930,12 +962,14 @@ deepSplitProductType_maybe fam_envs ty , Just con <- isDataProductTyCon_maybe tc , let arg_tys = dataConInstArgTys con tc_args strict_marks = dataConRepStrictness con - = Just (con, tc_args, zipEqual "dspt" arg_tys strict_marks, co) + = 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 (DataCon, [Type], [(Type, StrictnessMark)], Coercion) + :: 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 @@ -952,7 +986,10 @@ deepSplitCprType_maybe fam_envs con_tag ty , let con = cons `getNth` (con_tag - fIRST_TAG) arg_tys = dataConInstArgTys con tc_args strict_marks = dataConRepStrictness con - = Just (con, tc_args, zipEqual "dsct" arg_tys strict_marks, co) + = Just DataConAppContext { dcac_dc = con + , dcac_tys = tc_args + , dcac_arg_tys = zipEqual "dspt" arg_tys strict_marks + , dcac_co = co } deepSplitCprType_maybe _ _ _ = Nothing findTypeShape :: FamInstEnvs -> Type -> TypeShape @@ -1009,17 +1046,18 @@ 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 stuff <- deepSplitCprType_maybe fam_envs con_tag body_ty - -> mkWWcpr_help stuff + Just con_tag | Just dcac <- deepSplitCprType_maybe fam_envs con_tag body_ty + -> mkWWcpr_help dcac | 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 :: (DataCon, [Type], [(Type,StrictnessMark)], Coercion) +mkWWcpr_help :: DataConAppContext -> UniqSM (Bool, CoreExpr -> CoreExpr, CoreExpr -> CoreExpr, Type) -mkWWcpr_help (data_con, inst_tys, arg_tys, co) +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 arg_ty1 -- Special case when there is a single result of unlifted type ===================================== testsuite/tests/perf/should_run/all.T ===================================== @@ -233,7 +233,8 @@ test('T5949', ['-O']) test('T4267', - [collect_stats('bytes allocated',10), + [expect_broken(4267), + collect_stats('bytes allocated',10), only_ways(['normal'])], compile_and_run, ['-O']) ===================================== testsuite/tests/simplCore/should_compile/T4201.stdout ===================================== @@ -1,3 +1,3 @@ - [HasNoCafRefs, Arity: 1, Strictness: , CPR: m1, + [HasNoCafRefs, Arity: 1, Strictness: , Unfolding: InlineRule (0, True, True) bof `cast` (Sym (N:Foo[0]) ->_R _R)] ===================================== testsuite/tests/stranal/T10482a.hs ===================================== @@ -22,6 +22,9 @@ f1 x = case h x x of ------- f2 ----------- +-- We used to unbox x here and rebox it in the wrapper. After #17932, we don't. +-- After #17932, we don't. +-- Historical comment: -- x is a strict field of MkT2, so we'll pass it unboxed -- to $wf2, so it's available unboxed. This depends on -- the case expression analysing (a subcomponent of) one @@ -48,6 +51,8 @@ f1 (MkT3 x y) | h x y = f3 (MkT3 x (y-1)) ------- f4 ----------- +-- We used to unbox x here and rebox it in the wrapper. After #17932, we don't. +-- Historical comment: -- Just like f2, but MkT4 can't unbox its strict -- argument automatically, as f2 can ===================================== testsuite/tests/stranal/should_compile/T10482.stderr ===================================== @@ -1,261 +1,243 @@ ==================== Tidy Core ==================== -Result size of Tidy Core = {terms: 171, types: 116, coercions: 15, joins: 0/0} +Result size of Tidy Core = {terms: 167, types: 116, coercions: 15, joins: 0/0} -- RHS size: {terms: 13, types: 14, coercions: 4, joins: 0/0} -T10482.$WFooPair [InlPrag=INLINE[2]] :: forall a b. Foo a -> Foo b -> Foo (a, b) +T10482.$WFooPair [InlPrag=INLINE[0]] :: forall a b. Foo a -> Foo b -> Foo (a, b) [GblId[DataConWrapper], Arity=2, Caf=NoCafRefs, - Str=m, + Str=, + Cpr=m1, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) - Tmpl= \ (@ a_aX9) (@ b_aXa) (dt_a2pg [Occ=Once] :: Foo a_aX9[sk:2]) (dt_a2ph [Occ=Once] :: Foo b_aXa[sk:2]) -> - (case dt_a2pg of dt_X2pl { __DEFAULT -> case dt_a2ph of dt_X2pn { __DEFAULT -> T10482.FooPair @ a_aX9 @ b_aXa dt_X2pl dt_X2pn } }) - `cast` (Sym (T10482.D:R:Foo(,)0[0] _N _N) :: (T10482.R:Foo(,) a_aX9 b_aXa :: *) ~R# (Foo (a_aX9, b_aXa) :: *))}] + Tmpl= \ (@a_atL) (@b_atM) (dt_a1r7 [Occ=Once] :: Foo a_atL) (dt_a1r8 [Occ=Once] :: Foo b_atM) -> + (case dt_a1r7 of dt_X0 [Occ=Once] { __DEFAULT -> + case dt_a1r8 of dt_X1 [Occ=Once] { __DEFAULT -> T10482.FooPair @a_atL @b_atM dt_X0 dt_X1 } + }) + `cast` (Sym (T10482.D:R:Foo(,)0[0] _N _N) :: T10482.R:Foo(,) a_atL b_atM ~R# Foo (a_atL, b_atM))}] T10482.$WFooPair - = \ (@ a_aX9) (@ b_aXa) (dt_a2pg [Occ=Once] :: Foo a_aX9[sk:2]) (dt_a2ph [Occ=Once] :: Foo b_aXa[sk:2]) -> - (case dt_a2pg of dt_X2pl { __DEFAULT -> case dt_a2ph of dt_X2pn { __DEFAULT -> T10482.FooPair @ a_aX9 @ b_aXa dt_X2pl dt_X2pn } }) - `cast` (Sym (T10482.D:R:Foo(,)0[0] _N _N) :: (T10482.R:Foo(,) a_aX9 b_aXa :: *) ~R# (Foo (a_aX9, b_aXa) :: *)) + = \ (@a_atL) (@b_atM) (dt_a1r7 [Occ=Once] :: Foo a_atL) (dt_a1r8 [Occ=Once] :: Foo b_atM) -> + (case dt_a1r7 of dt_X0 [Occ=Once] { __DEFAULT -> + case dt_a1r8 of dt_X1 [Occ=Once] { __DEFAULT -> T10482.FooPair @a_atL @b_atM dt_X0 dt_X1 } + }) + `cast` (Sym (T10482.D:R:Foo(,)0[0] _N _N) :: T10482.R:Foo(,) a_atL b_atM ~R# Foo (a_atL, b_atM)) -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T10482.$trModule4 :: GHC.Prim.Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] T10482.$trModule4 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T10482.$trModule3 :: GHC.Types.TrName [GblId, - Caf=NoCafRefs, - Str=m1, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] T10482.$trModule3 = GHC.Types.TrNameS T10482.$trModule4 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T10482.$trModule2 :: GHC.Prim.Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] T10482.$trModule2 = "T10482"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T10482.$trModule1 :: GHC.Types.TrName [GblId, - Caf=NoCafRefs, - Str=m1, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] T10482.$trModule1 = GHC.Types.TrNameS T10482.$trModule2 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} T10482.$trModule :: GHC.Types.Module [GblId, - Caf=NoCafRefs, - Str=m, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] T10482.$trModule = GHC.Types.Module T10482.$trModule3 T10482.$trModule1 -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} -$krep_r2Q4 :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] -$krep_r2Q4 = GHC.Types.KindRepTyConApp GHC.Types.$tcInt (GHC.Types.[] @ GHC.Types.KindRep) +$krep_r1Gw :: GHC.Types.KindRep +[GblId, Cpr=m1, Unf=OtherCon []] +$krep_r1Gw = GHC.Types.KindRepTyConApp GHC.Types.$tcInt (GHC.Types.[] @GHC.Types.KindRep) -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -$krep1_r2Q5 :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] -$krep1_r2Q5 = GHC.Types.KindRepVar 1# +$krep1_r1Gx :: GHC.Types.KindRep +[GblId, Cpr=m2, Unf=OtherCon []] +$krep1_r1Gx = GHC.Types.KindRepVar 1# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -$krep2_r2Q6 :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] -$krep2_r2Q6 = GHC.Types.KindRepVar 0# +$krep2_r1Gy :: GHC.Types.KindRep +[GblId, Cpr=m2, Unf=OtherCon []] +$krep2_r1Gy = GHC.Types.KindRepVar 0# -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -$krep3_r2Q7 :: [GHC.Types.KindRep] -[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] -$krep3_r2Q7 = GHC.Types.: @ GHC.Types.KindRep $krep1_r2Q5 (GHC.Types.[] @ GHC.Types.KindRep) +$krep3_r1Gz :: [GHC.Types.KindRep] +[GblId, Cpr=m2, Unf=OtherCon []] +$krep3_r1Gz = GHC.Types.: @GHC.Types.KindRep $krep1_r1Gx (GHC.Types.[] @GHC.Types.KindRep) -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} -$krep4_r2Q8 :: [GHC.Types.KindRep] -[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] -$krep4_r2Q8 = GHC.Types.: @ GHC.Types.KindRep $krep2_r2Q6 $krep3_r2Q7 +$krep4_r1GA :: [GHC.Types.KindRep] +[GblId, Cpr=m2, Unf=OtherCon []] +$krep4_r1GA = GHC.Types.: @GHC.Types.KindRep $krep2_r1Gy $krep3_r1Gz -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep5_r2Q9 :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] -$krep5_r2Q9 = GHC.Types.KindRepTyConApp GHC.Tuple.$tc(,) $krep4_r2Q8 +$krep5_r1GB :: GHC.Types.KindRep +[GblId, Cpr=m1, Unf=OtherCon []] +$krep5_r1GB = GHC.Types.KindRepTyConApp GHC.Tuple.$tc(,) $krep4_r1GA -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T10482.$tcFoo2 :: GHC.Prim.Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] T10482.$tcFoo2 = "Foo"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T10482.$tcFoo1 :: GHC.Types.TrName [GblId, - Caf=NoCafRefs, - Str=m1, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] T10482.$tcFoo1 = GHC.Types.TrNameS T10482.$tcFoo2 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T10482.$tcFoo :: GHC.Types.TyCon [GblId, - Caf=NoCafRefs, - Str=m, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] T10482.$tcFoo = GHC.Types.TyCon 3311038889639791302## 7944995683507700778## T10482.$trModule T10482.$tcFoo1 0# GHC.Types.krep$*Arr* -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -$krep6_r2Qa :: [GHC.Types.KindRep] -[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] -$krep6_r2Qa = GHC.Types.: @ GHC.Types.KindRep $krep2_r2Q6 (GHC.Types.[] @ GHC.Types.KindRep) +$krep6_r1GC :: [GHC.Types.KindRep] +[GblId, Cpr=m2, Unf=OtherCon []] +$krep6_r1GC = GHC.Types.: @GHC.Types.KindRep $krep2_r1Gy (GHC.Types.[] @GHC.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep7_r2Qb :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] -$krep7_r2Qb = GHC.Types.KindRepTyConApp T10482.$tcFoo $krep6_r2Qa +$krep7_r1GD :: GHC.Types.KindRep +[GblId, Cpr=m1, Unf=OtherCon []] +$krep7_r1GD = GHC.Types.KindRepTyConApp T10482.$tcFoo $krep6_r1GC -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep8_r2Qc :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] -$krep8_r2Qc = GHC.Types.KindRepTyConApp T10482.$tcFoo $krep3_r2Q7 +$krep8_r1GE :: GHC.Types.KindRep +[GblId, Cpr=m1, Unf=OtherCon []] +$krep8_r1GE = GHC.Types.KindRepTyConApp T10482.$tcFoo $krep3_r1Gz -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -$krep9_r2Qd :: [GHC.Types.KindRep] -[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] -$krep9_r2Qd = GHC.Types.: @ GHC.Types.KindRep $krep5_r2Q9 (GHC.Types.[] @ GHC.Types.KindRep) +$krep9_r1GF :: [GHC.Types.KindRep] +[GblId, Cpr=m2, Unf=OtherCon []] +$krep9_r1GF = GHC.Types.: @GHC.Types.KindRep $krep5_r1GB (GHC.Types.[] @GHC.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep10_r2Qe :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] -$krep10_r2Qe = GHC.Types.KindRepTyConApp T10482.$tcFoo $krep9_r2Qd +$krep10_r1GG :: GHC.Types.KindRep +[GblId, Cpr=m1, Unf=OtherCon []] +$krep10_r1GG = GHC.Types.KindRepTyConApp T10482.$tcFoo $krep9_r1GF -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep11_r2Qf :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] -$krep11_r2Qf = GHC.Types.KindRepFun $krep8_r2Qc $krep10_r2Qe +$krep11_r1GH :: GHC.Types.KindRep +[GblId, Cpr=m4, Unf=OtherCon []] +$krep11_r1GH = GHC.Types.KindRepFun $krep8_r1GE $krep10_r1GG -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} T10482.$tc'FooPair1 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] -T10482.$tc'FooPair1 = GHC.Types.KindRepFun $krep7_r2Qb $krep11_r2Qf +[GblId, Cpr=m4, Unf=OtherCon []] +T10482.$tc'FooPair1 = GHC.Types.KindRepFun $krep7_r1GD $krep11_r1GH -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -$krep12_r2Qg :: [GHC.Types.KindRep] -[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] -$krep12_r2Qg = GHC.Types.: @ GHC.Types.KindRep $krep_r2Q4 (GHC.Types.[] @ GHC.Types.KindRep) +$krep12_r1GI :: [GHC.Types.KindRep] +[GblId, Cpr=m2, Unf=OtherCon []] +$krep12_r1GI = GHC.Types.: @GHC.Types.KindRep $krep_r1Gw (GHC.Types.[] @GHC.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep13_r2Qh :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] -$krep13_r2Qh = GHC.Types.KindRepTyConApp T10482.$tcFoo $krep12_r2Qg +$krep13_r1GJ :: GHC.Types.KindRep +[GblId, Cpr=m1, Unf=OtherCon []] +$krep13_r1GJ = GHC.Types.KindRepTyConApp T10482.$tcFoo $krep12_r1GI -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} T10482.$tc'Foo1 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] -T10482.$tc'Foo1 = GHC.Types.KindRepFun $krep_r2Q4 $krep13_r2Qh +[GblId, Cpr=m4, Unf=OtherCon []] +T10482.$tc'Foo1 = GHC.Types.KindRepFun $krep_r1Gw $krep13_r1GJ -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T10482.$tc'FooPair3 :: GHC.Prim.Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] T10482.$tc'FooPair3 = "'FooPair"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T10482.$tc'FooPair2 :: GHC.Types.TrName [GblId, - Caf=NoCafRefs, - Str=m1, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] T10482.$tc'FooPair2 = GHC.Types.TrNameS T10482.$tc'FooPair3 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T10482.$tc'FooPair :: GHC.Types.TyCon [GblId, - Caf=NoCafRefs, - Str=m, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] T10482.$tc'FooPair = GHC.Types.TyCon 5329411373903054066## 1455261321638291317## T10482.$trModule T10482.$tc'FooPair2 2# T10482.$tc'FooPair1 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T10482.$tc'Foo3 :: GHC.Prim.Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] T10482.$tc'Foo3 = "'Foo"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T10482.$tc'Foo2 :: GHC.Types.TrName [GblId, - Caf=NoCafRefs, - Str=m1, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] T10482.$tc'Foo2 = GHC.Types.TrNameS T10482.$tc'Foo3 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T10482.$tc'Foo :: GHC.Types.TyCon [GblId, - Caf=NoCafRefs, - Str=m, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] T10482.$tc'Foo = GHC.Types.TyCon 5096937192618987042## 15136671864408054946## T10482.$trModule T10482.$tc'Foo2 0# T10482.$tc'Foo1 +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl_r1GK :: Int +[GblId, Cpr=m1, Unf=OtherCon []] +lvl_r1GK = GHC.Types.I# 0# + Rec { --- RHS size: {terms: 19, types: 4, coercions: 0, joins: 0/0} -T10482.$wfoo [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.Int# -> GHC.Prim.Int# -[GblId, Arity=2, Caf=NoCafRefs, Str=, Unf=OtherCon []] +-- RHS size: {terms: 19, types: 5, coercions: 3, joins: 0/0} +T10482.$wfoo [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker] :: Foo Int -> GHC.Prim.Int# -> Int +[GblId, Arity=2, Str=, Unf=OtherCon []] T10482.$wfoo - = \ (ww_s2OA :: GHC.Prim.Int#) (ww1_s2OI :: GHC.Prim.Int#) -> - case ww1_s2OI of wild_X1r { + = \ (ww_s1Fu + :: Foo Int + Unf=OtherCon []) + (ww1_s1FB :: GHC.Prim.Int#) -> + case ww1_s1FB of wild_X1 { __DEFAULT -> - case GHC.Prim.remInt# wild_X1r 2# of { - __DEFAULT -> ww_s2OA; - 0# -> T10482.$wfoo ww_s2OA (GHC.Prim.-# wild_X1r 1#) + case GHC.Prim.remInt# wild_X1 2# of { + __DEFAULT -> ww_s1Fu `cast` (T10482.D:R:FooInt0[0] ; T10482.N:R:FooInt[0] :: Foo Int ~R# Int); + 0# -> T10482.$wfoo ww_s1Fu (GHC.Prim.-# wild_X1 1#) }; - 0# -> 0# + 0# -> lvl_r1GK } end Rec } --- RHS size: {terms: 21, types: 30, coercions: 11, joins: 0/0} +-- RHS size: {terms: 14, types: 27, coercions: 8, joins: 0/0} foo [InlPrag=NOUSERINLINE[2]] :: Foo ((Int, Int), Int) -> Int -> Int [GblId, Arity=2, - Caf=NoCafRefs, - Str=m, + Str=, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) - Tmpl= \ (w_s2Oq [Occ=Once] :: Foo ((Int, Int), Int)) (w1_s2Or [Occ=Once!] :: Int) -> - case w_s2Oq - `cast` (T10482.D:R:Foo(,)0[0] <(Int, Int)>_N _N :: (Foo ((Int, Int), Int) :: *) ~R# (T10482.R:Foo(,) (Int, Int) Int :: *)) - of - { FooPair ww1_s2Ou [Occ=Once] _ [Occ=Dead] -> - case ww1_s2Ou `cast` (T10482.D:R:Foo(,)0[0] _N _N :: (Foo (Int, Int) :: *) ~R# (T10482.R:Foo(,) Int Int :: *)) of - { FooPair ww4_s2Ox [Occ=Once] _ [Occ=Dead] -> - case ww4_s2Ox `cast` (T10482.D:R:FooInt0[0] ; T10482.N:R:FooInt[0] :: (Foo Int :: *) ~R# (Int :: *)) of - { GHC.Types.I# ww7_s2OA [Occ=Once] -> - case w1_s2Or of { GHC.Types.I# ww9_s2OI [Occ=Once] -> - case T10482.$wfoo ww7_s2OA ww9_s2OI of ww10_s2OM { __DEFAULT -> GHC.Types.I# ww10_s2OM } - } - } + Tmpl= \ (w_s1Fn [Occ=Once] :: Foo ((Int, Int), Int)) (w1_s1Fo [Occ=Once!] :: Int) -> + case w_s1Fn `cast` (T10482.D:R:Foo(,)0[0] <(Int, Int)>_N _N :: Foo ((Int, Int), Int) ~R# T10482.R:Foo(,) (Int, Int) Int) of + { FooPair ww1_s1Fr [Occ=Once] _ [Occ=Dead] -> + case ww1_s1Fr `cast` (T10482.D:R:Foo(,)0[0] _N _N :: Foo (Int, Int) ~R# T10482.R:Foo(,) Int Int) of + { FooPair ww4_s1Fu [Occ=Once] _ [Occ=Dead] -> + case w1_s1Fo of { GHC.Types.I# ww7_s1FB [Occ=Once] -> T10482.$wfoo ww4_s1Fu ww7_s1FB } } }}] foo - = \ (w_s2Oq :: Foo ((Int, Int), Int)) (w1_s2Or :: Int) -> - case w_s2Oq - `cast` (T10482.D:R:Foo(,)0[0] <(Int, Int)>_N _N :: (Foo ((Int, Int), Int) :: *) ~R# (T10482.R:Foo(,) (Int, Int) Int :: *)) - of - { FooPair ww1_s2Ou ww2_s2OE -> - case ww1_s2Ou `cast` (T10482.D:R:Foo(,)0[0] _N _N :: (Foo (Int, Int) :: *) ~R# (T10482.R:Foo(,) Int Int :: *)) of - { FooPair ww4_s2Pm ww5_s2Pn -> - case ww4_s2Pm `cast` (T10482.D:R:FooInt0[0] ; T10482.N:R:FooInt[0] :: (Foo Int :: *) ~R# (Int :: *)) of { GHC.Types.I# ww7_s2Pq -> - case w1_s2Or of { GHC.Types.I# ww9_s2OI -> case T10482.$wfoo ww7_s2Pq ww9_s2OI of ww10_s2OM { __DEFAULT -> GHC.Types.I# ww10_s2OM } } - } + = \ (w_s1Fn :: Foo ((Int, Int), Int)) (w1_s1Fo :: Int) -> + case w_s1Fn `cast` (T10482.D:R:Foo(,)0[0] <(Int, Int)>_N _N :: Foo ((Int, Int), Int) ~R# T10482.R:Foo(,) (Int, Int) Int) of + { FooPair ww1_s1Fr ww2_s1Fx -> + case ww1_s1Fr `cast` (T10482.D:R:Foo(,)0[0] _N _N :: Foo (Int, Int) ~R# T10482.R:Foo(,) Int Int) of + { FooPair ww4_s1G0 ww5_s1G1 -> + case w1_s1Fo of { GHC.Types.I# ww7_s1FB -> T10482.$wfoo ww4_s1G0 ww7_s1FB } } } ===================================== testsuite/tests/stranal/should_compile/T10482a.stderr ===================================== @@ -1,407 +1,366 @@ ==================== Tidy Core ==================== -Result size of Tidy Core = {terms: 353, types: 155, coercions: 3, joins: 0/0} +Result size of Tidy Core = {terms: 342, types: 152, coercions: 3, joins: 0/0} -- RHS size: {terms: 9, types: 8, coercions: 0, joins: 0/0} -Foo.$WMkT4 [InlPrag=INLINE[2]] :: forall a. Foo a -> Int -> T4 a +Foo.$WMkT4 [InlPrag=INLINE[0]] :: forall a. Foo a -> Int -> T4 a [GblId[DataConWrapper], Arity=2, Caf=NoCafRefs, - Str=m, + Str=, + Cpr=m1, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) - Tmpl= \ (@ a_atA) (dt_a21M [Occ=Once] :: Foo a_atA[sk:1]) (dt_a21N [Occ=Once] :: Int) -> - case dt_a21M of dt_X21Q { __DEFAULT -> Foo.MkT4 @ a_atA dt_X21Q dt_a21N }}] + Tmpl= \ (@a_agw) (dt_a1hl [Occ=Once] :: Foo a_agw) (dt_a1hm [Occ=Once] :: Int) -> + case dt_a1hl of dt_X0 [Occ=Once] { __DEFAULT -> Foo.MkT4 @a_agw dt_X0 dt_a1hm }}] Foo.$WMkT4 - = \ (@ a_atA) (dt_a21M [Occ=Once] :: Foo a_atA[sk:1]) (dt_a21N [Occ=Once] :: Int) -> - case dt_a21M of dt_X21Q { __DEFAULT -> Foo.MkT4 @ a_atA dt_X21Q dt_a21N } + = \ (@a_agw) (dt_a1hl [Occ=Once] :: Foo a_agw) (dt_a1hm [Occ=Once] :: Int) -> + case dt_a1hl of dt_X0 [Occ=Once] { __DEFAULT -> Foo.MkT4 @a_agw dt_X0 dt_a1hm } -- RHS size: {terms: 8, types: 3, coercions: 0, joins: 0/0} -Foo.$WMkT2 [InlPrag=INLINE[2]] :: Int -> Int -> T2 +Foo.$WMkT2 [InlPrag=INLINE[0]] :: Int -> Int -> T2 [GblId[DataConWrapper], Arity=2, Caf=NoCafRefs, - Str=m, + Str=, + Cpr=m1, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) - Tmpl= \ (dt_a20w [Occ=Once] :: Int) (dt_a20x [Occ=Once] :: Int) -> - case dt_a20w of dt_X20z { __DEFAULT -> Foo.MkT2 dt_X20z dt_a20x }}] + Tmpl= \ (dt_a1gu [Occ=Once] :: Int) (dt_a1gv [Occ=Once] :: Int) -> + case dt_a1gu of dt_X0 [Occ=Once] { __DEFAULT -> Foo.MkT2 dt_X0 dt_a1gv }}] Foo.$WMkT2 - = \ (dt_a20w [Occ=Once] :: Int) (dt_a20x [Occ=Once] :: Int) -> case dt_a20w of dt_X20z { __DEFAULT -> Foo.MkT2 dt_X20z dt_a20x } + = \ (dt_a1gu [Occ=Once] :: Int) (dt_a1gv [Occ=Once] :: Int) -> + case dt_a1gu of dt_X0 [Occ=Once] { __DEFAULT -> Foo.MkT2 dt_X0 dt_a1gv } -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} Foo.$trModule4 :: GHC.Prim.Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] Foo.$trModule4 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} Foo.$trModule3 :: GHC.Types.TrName [GblId, - Caf=NoCafRefs, - Str=m1, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] Foo.$trModule3 = GHC.Types.TrNameS Foo.$trModule4 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} Foo.$trModule2 :: GHC.Prim.Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] Foo.$trModule2 = "Foo"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} Foo.$trModule1 :: GHC.Types.TrName [GblId, - Caf=NoCafRefs, - Str=m1, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] Foo.$trModule1 = GHC.Types.TrNameS Foo.$trModule2 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} Foo.$trModule :: GHC.Types.Module [GblId, - Caf=NoCafRefs, - Str=m, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] Foo.$trModule = GHC.Types.Module Foo.$trModule3 Foo.$trModule1 -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} -$krep_r2oJ :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] -$krep_r2oJ = GHC.Types.KindRepTyConApp GHC.Types.$tcInt (GHC.Types.[] @ GHC.Types.KindRep) +$krep_r1x7 :: GHC.Types.KindRep +[GblId, Cpr=m1, Unf=OtherCon []] +$krep_r1x7 = GHC.Types.KindRepTyConApp GHC.Types.$tcInt (GHC.Types.[] @GHC.Types.KindRep) -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -$krep1_r2oK :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] -$krep1_r2oK = GHC.Types.KindRepVar 0# +$krep1_r1x8 :: GHC.Types.KindRep +[GblId, Cpr=m2, Unf=OtherCon []] +$krep1_r1x8 = GHC.Types.KindRepVar 0# -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} Foo.$tcT5 :: GHC.Prim.Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] Foo.$tcT5 = "T2"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} Foo.$tcT1 :: GHC.Types.TrName [GblId, - Caf=NoCafRefs, - Str=m1, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] Foo.$tcT1 = GHC.Types.TrNameS Foo.$tcT5 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} Foo.$tcT2 :: GHC.Types.TyCon [GblId, - Caf=NoCafRefs, - Str=m, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] Foo.$tcT2 = GHC.Types.TyCon 12492463661685256209## 1082997131366389398## Foo.$trModule Foo.$tcT1 0# GHC.Types.krep$* -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} -$krep2_r2oL :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] -$krep2_r2oL = GHC.Types.KindRepTyConApp Foo.$tcT2 (GHC.Types.[] @ GHC.Types.KindRep) +$krep2_r1x9 :: GHC.Types.KindRep +[GblId, Cpr=m1, Unf=OtherCon []] +$krep2_r1x9 = GHC.Types.KindRepTyConApp Foo.$tcT2 (GHC.Types.[] @GHC.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep3_r2oM :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] -$krep3_r2oM = GHC.Types.KindRepFun $krep_r2oJ $krep2_r2oL +$krep3_r1xa :: GHC.Types.KindRep +[GblId, Cpr=m4, Unf=OtherCon []] +$krep3_r1xa = GHC.Types.KindRepFun $krep_r1x7 $krep2_r1x9 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} Foo.$tc'MkT1 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] -Foo.$tc'MkT1 = GHC.Types.KindRepFun $krep_r2oJ $krep3_r2oM +[GblId, Cpr=m4, Unf=OtherCon []] +Foo.$tc'MkT1 = GHC.Types.KindRepFun $krep_r1x7 $krep3_r1xa -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} Foo.$tc'MkT6 :: GHC.Prim.Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] Foo.$tc'MkT6 = "'MkT2"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} Foo.$tc'MkT5 :: GHC.Types.TrName [GblId, - Caf=NoCafRefs, - Str=m1, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] Foo.$tc'MkT5 = GHC.Types.TrNameS Foo.$tc'MkT6 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} Foo.$tc'MkT2 :: GHC.Types.TyCon [GblId, - Caf=NoCafRefs, - Str=m, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] Foo.$tc'MkT2 = GHC.Types.TyCon 5707542518475997625## 9584804394183763875## Foo.$trModule Foo.$tc'MkT5 0# Foo.$tc'MkT1 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} Foo.$tcT7 :: GHC.Prim.Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] Foo.$tcT7 = "T3"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} Foo.$tcT6 :: GHC.Types.TrName [GblId, - Caf=NoCafRefs, - Str=m1, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] Foo.$tcT6 = GHC.Types.TrNameS Foo.$tcT7 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} Foo.$tcT3 :: GHC.Types.TyCon [GblId, - Caf=NoCafRefs, - Str=m, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] Foo.$tcT3 = GHC.Types.TyCon 8915518733037212359## 16476420519216613869## Foo.$trModule Foo.$tcT6 0# GHC.Types.krep$* -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} -$krep4_r2oN :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] -$krep4_r2oN = GHC.Types.KindRepTyConApp Foo.$tcT3 (GHC.Types.[] @ GHC.Types.KindRep) +$krep4_r1xb :: GHC.Types.KindRep +[GblId, Cpr=m1, Unf=OtherCon []] +$krep4_r1xb = GHC.Types.KindRepTyConApp Foo.$tcT3 (GHC.Types.[] @GHC.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep5_r2oO :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] -$krep5_r2oO = GHC.Types.KindRepFun $krep_r2oJ $krep4_r2oN +$krep5_r1xc :: GHC.Types.KindRep +[GblId, Cpr=m4, Unf=OtherCon []] +$krep5_r1xc = GHC.Types.KindRepFun $krep_r1x7 $krep4_r1xb -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} Foo.$tc'MkT7 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] -Foo.$tc'MkT7 = GHC.Types.KindRepFun $krep_r2oJ $krep5_r2oO +[GblId, Cpr=m4, Unf=OtherCon []] +Foo.$tc'MkT7 = GHC.Types.KindRepFun $krep_r1x7 $krep5_r1xc -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} Foo.$tc'MkT9 :: GHC.Prim.Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] Foo.$tc'MkT9 = "'MkT3"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} Foo.$tc'MkT8 :: GHC.Types.TrName [GblId, - Caf=NoCafRefs, - Str=m1, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] Foo.$tc'MkT8 = GHC.Types.TrNameS Foo.$tc'MkT9 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} Foo.$tc'MkT3 :: GHC.Types.TyCon [GblId, - Caf=NoCafRefs, - Str=m, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] Foo.$tc'MkT3 = GHC.Types.TyCon 7218783144619306039## 13236146459150723629## Foo.$trModule Foo.$tc'MkT8 0# Foo.$tc'MkT7 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} Foo.$tcFoo :: GHC.Types.TyCon [GblId, - Caf=NoCafRefs, - Str=m, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] Foo.$tcFoo = GHC.Types.TyCon 11236787750777559483## 2472662601374496863## Foo.$trModule Foo.$trModule1 0# GHC.Types.krep$*Arr* -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -$krep6_r2oP :: [GHC.Types.KindRep] -[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] -$krep6_r2oP = GHC.Types.: @ GHC.Types.KindRep $krep1_r2oK (GHC.Types.[] @ GHC.Types.KindRep) +$krep6_r1xd :: [GHC.Types.KindRep] +[GblId, Cpr=m2, Unf=OtherCon []] +$krep6_r1xd = GHC.Types.: @GHC.Types.KindRep $krep1_r1x8 (GHC.Types.[] @GHC.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep7_r2oQ :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] -$krep7_r2oQ = GHC.Types.KindRepTyConApp Foo.$tcFoo $krep6_r2oP +$krep7_r1xe :: GHC.Types.KindRep +[GblId, Cpr=m1, Unf=OtherCon []] +$krep7_r1xe = GHC.Types.KindRepTyConApp Foo.$tcFoo $krep6_r1xd -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -$krep8_r2oR :: [GHC.Types.KindRep] -[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] -$krep8_r2oR = GHC.Types.: @ GHC.Types.KindRep $krep_r2oJ (GHC.Types.[] @ GHC.Types.KindRep) +$krep8_r1xf :: [GHC.Types.KindRep] +[GblId, Cpr=m2, Unf=OtherCon []] +$krep8_r1xf = GHC.Types.: @GHC.Types.KindRep $krep_r1x7 (GHC.Types.[] @GHC.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep9_r2oS :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] -$krep9_r2oS = GHC.Types.KindRepTyConApp Foo.$tcFoo $krep8_r2oR +$krep9_r1xg :: GHC.Types.KindRep +[GblId, Cpr=m1, Unf=OtherCon []] +$krep9_r1xg = GHC.Types.KindRepTyConApp Foo.$tcFoo $krep8_r1xf -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} Foo.$tc'Foo1 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] -Foo.$tc'Foo1 = GHC.Types.KindRepFun $krep_r2oJ $krep9_r2oS +[GblId, Cpr=m4, Unf=OtherCon []] +Foo.$tc'Foo1 = GHC.Types.KindRepFun $krep_r1x7 $krep9_r1xg -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} Foo.$tc'Foo3 :: GHC.Prim.Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] Foo.$tc'Foo3 = "'Foo"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} Foo.$tc'Foo2 :: GHC.Types.TrName [GblId, - Caf=NoCafRefs, - Str=m1, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] Foo.$tc'Foo2 = GHC.Types.TrNameS Foo.$tc'Foo3 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} Foo.$tc'Foo :: GHC.Types.TyCon [GblId, - Caf=NoCafRefs, - Str=m, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] Foo.$tc'Foo = GHC.Types.TyCon 10641757595611461765## 13961773224584044648## Foo.$trModule Foo.$tc'Foo2 0# Foo.$tc'Foo1 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} Foo.$tcT9 :: GHC.Prim.Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] Foo.$tcT9 = "T4"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} Foo.$tcT8 :: GHC.Types.TrName [GblId, - Caf=NoCafRefs, - Str=m1, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] Foo.$tcT8 = GHC.Types.TrNameS Foo.$tcT9 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} Foo.$tcT4 :: GHC.Types.TyCon [GblId, - Caf=NoCafRefs, - Str=m, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] Foo.$tcT4 = GHC.Types.TyCon 15961711399118996930## 13694522307176382499## Foo.$trModule Foo.$tcT8 0# GHC.Types.krep$*Arr* -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep10_r2oT :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] -$krep10_r2oT = GHC.Types.KindRepTyConApp Foo.$tcT4 $krep6_r2oP +$krep10_r1xh :: GHC.Types.KindRep +[GblId, Cpr=m1, Unf=OtherCon []] +$krep10_r1xh = GHC.Types.KindRepTyConApp Foo.$tcT4 $krep6_r1xd -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep11_r2oU :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] -$krep11_r2oU = GHC.Types.KindRepFun $krep_r2oJ $krep10_r2oT +$krep11_r1xi :: GHC.Types.KindRep +[GblId, Cpr=m4, Unf=OtherCon []] +$krep11_r1xi = GHC.Types.KindRepFun $krep_r1x7 $krep10_r1xh -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} Foo.$tc'MkT10 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] -Foo.$tc'MkT10 = GHC.Types.KindRepFun $krep7_r2oQ $krep11_r2oU +[GblId, Cpr=m4, Unf=OtherCon []] +Foo.$tc'MkT10 = GHC.Types.KindRepFun $krep7_r1xe $krep11_r1xi -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} Foo.$tc'MkT12 :: GHC.Prim.Addr# -[GblId, - Caf=NoCafRefs, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] Foo.$tc'MkT12 = "'MkT4"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} Foo.$tc'MkT11 :: GHC.Types.TrName [GblId, - Caf=NoCafRefs, - Str=m1, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] Foo.$tc'MkT11 = GHC.Types.TrNameS Foo.$tc'MkT12 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} Foo.$tc'MkT4 :: GHC.Types.TyCon [GblId, - Caf=NoCafRefs, - Str=m, + Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] Foo.$tc'MkT4 = GHC.Types.TyCon 6077781708614236332## 14823286043222481570## Foo.$trModule Foo.$tc'MkT11 1# Foo.$tc'MkT10 Rec { --- RHS size: {terms: 14, types: 3, coercions: 0, joins: 0/0} -Foo.$wf4 [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.Int# -> GHC.Prim.Int# -[GblId, Arity=2, Caf=NoCafRefs, Str=, Unf=OtherCon []] +-- RHS size: {terms: 14, types: 4, coercions: 3, joins: 0/0} +Foo.$wf4 [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker] :: Foo Int -> GHC.Prim.Int# -> Int +[GblId, Arity=2, Str=, Unf=OtherCon []] Foo.$wf4 - = \ (ww_s2jL :: GHC.Prim.Int#) (ww1_s2jQ :: GHC.Prim.Int#) -> - case GHC.Prim.># ww1_s2jQ 0# of { - __DEFAULT -> ww_s2jL; - 1# -> Foo.$wf4 ww_s2jL (GHC.Prim.-# ww1_s2jQ 1#) + = \ (ww_s1tc + :: Foo Int + Unf=OtherCon []) + (ww1_s1tg :: GHC.Prim.Int#) -> + case GHC.Prim.># ww1_s1tg 0# of { + __DEFAULT -> ww_s1tc `cast` (Foo.D:R:FooInt0[0] ; Foo.N:R:FooInt[0] :: Foo Int ~R# Int); + 1# -> Foo.$wf4 ww_s1tc (GHC.Prim.-# ww1_s1tg 1#) } end Rec } --- RHS size: {terms: 17, types: 12, coercions: 3, joins: 0/0} +-- RHS size: {terms: 10, types: 9, coercions: 0, joins: 0/0} f4 [InlPrag=NOUSERINLINE[2]] :: T4 Int -> Int [GblId, Arity=1, - Caf=NoCafRefs, - Str=m, + 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_s2jF [Occ=Once!] :: T4 Int) -> - case w_s2jF of { MkT4 ww1_s2jI [Occ=Once] ww2_s2jN [Occ=Once!] -> - case ww1_s2jI `cast` (Foo.D:R:FooInt0[0] ; Foo.N:R:FooInt[0] :: (Foo Int :: *) ~R# (Int :: *)) of - { GHC.Types.I# ww4_s2jL [Occ=Once] -> - case ww2_s2jN of { GHC.Types.I# ww6_s2jQ [Occ=Once] -> - case Foo.$wf4 ww4_s2jL ww6_s2jQ of ww7_s2jV { __DEFAULT -> GHC.Types.I# ww7_s2jV } - } - } + Tmpl= \ (w_s1t9 [Occ=Once!] :: T4 Int) -> + case w_s1t9 of { MkT4 ww1_s1tc [Occ=Once] ww2_s1td [Occ=Once!] -> + case ww2_s1td of { GHC.Types.I# ww4_s1tg [Occ=Once] -> Foo.$wf4 ww1_s1tc ww4_s1tg } }}] f4 - = \ (w_s2jF :: T4 Int) -> - case w_s2jF of { MkT4 ww1_s2jI ww2_s2jN -> - case ww1_s2jI `cast` (Foo.D:R:FooInt0[0] ; Foo.N:R:FooInt[0] :: (Foo Int :: *) ~R# (Int :: *)) of { GHC.Types.I# ww4_s2mW -> - case ww2_s2jN of { GHC.Types.I# ww6_s2jQ -> case Foo.$wf4 ww4_s2mW ww6_s2jQ of ww7_s2jV { __DEFAULT -> GHC.Types.I# ww7_s2jV } } - } - } + = \ (w_s1t9 :: T4 Int) -> + case w_s1t9 of { MkT4 ww1_s1tc ww2_s1td -> case ww2_s1td of { GHC.Types.I# ww4_s1tg -> Foo.$wf4 ww1_s1tc ww4_s1tg } } + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl_r1xj :: Int +[GblId, Cpr=m1, Unf=OtherCon []] +lvl_r1xj = GHC.Types.I# 1# Rec { -- RHS size: {terms: 21, types: 4, coercions: 0, joins: 0/0} -Foo.$wf2 [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.Int# -> GHC.Prim.Int# -[GblId, Arity=2, Caf=NoCafRefs, Str=, Unf=OtherCon []] +Foo.$wf2 [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker] :: Int -> GHC.Prim.Int# -> Int +[GblId, Arity=2, Str=, Unf=OtherCon []] Foo.$wf2 - = \ (ww_s2k3 :: GHC.Prim.Int#) (ww1_s2k8 :: GHC.Prim.Int#) -> - case GHC.Prim.># ww1_s2k8 0# of { + = \ (ww_s1tn + :: Int + Unf=OtherCon []) + (ww1_s1tr :: GHC.Prim.Int#) -> + case GHC.Prim.># ww1_s1tr 0# of { __DEFAULT -> - case GHC.Prim.># ww1_s2k8 1# of { - __DEFAULT -> ww_s2k3; - 1# -> 1# + case GHC.Prim.># ww1_s1tr 1# of { + __DEFAULT -> ww_s1tn; + 1# -> lvl_r1xj }; - 1# -> Foo.$wf2 ww_s2k3 (GHC.Prim.-# ww1_s2k8 1#) + 1# -> Foo.$wf2 ww_s1tn (GHC.Prim.-# ww1_s1tr 1#) } end Rec } --- RHS size: {terms: 17, types: 9, coercions: 0, joins: 0/0} +-- RHS size: {terms: 10, types: 6, coercions: 0, joins: 0/0} f2 [InlPrag=NOUSERINLINE[2]] :: T2 -> Int [GblId, Arity=1, - Caf=NoCafRefs, - Str=m, + 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_s2jX [Occ=Once!] :: T2) -> - case w_s2jX of { MkT2 ww1_s2k0 [Occ=Once!] ww2_s2k5 [Occ=Once!] -> - case ww1_s2k0 of { GHC.Types.I# ww4_s2k3 [Occ=Once] -> - case ww2_s2k5 of { GHC.Types.I# ww6_s2k8 [Occ=Once] -> - case Foo.$wf2 ww4_s2k3 ww6_s2k8 of ww7_s2kd { __DEFAULT -> GHC.Types.I# ww7_s2kd } - } - } + Tmpl= \ (w_s1tk [Occ=Once!] :: T2) -> + case w_s1tk of { MkT2 ww1_s1tn [Occ=Once] ww2_s1to [Occ=Once!] -> + case ww2_s1to of { GHC.Types.I# ww4_s1tr [Occ=Once] -> Foo.$wf2 ww1_s1tn ww4_s1tr } }}] f2 - = \ (w_s2jX :: T2) -> - case w_s2jX of { MkT2 ww1_s2k0 ww2_s2k5 -> - case ww1_s2k0 of { GHC.Types.I# ww4_s2mZ -> - case ww2_s2k5 of { GHC.Types.I# ww6_s2k8 -> case Foo.$wf2 ww4_s2mZ ww6_s2k8 of ww7_s2kd { __DEFAULT -> GHC.Types.I# ww7_s2kd } } - } - } + = \ (w_s1tk :: T2) -> + case w_s1tk of { MkT2 ww1_s1tn ww2_s1to -> case ww2_s1to of { GHC.Types.I# ww4_s1tr -> Foo.$wf2 ww1_s1tn ww4_s1tr } } Rec { -- RHS size: {terms: 15, types: 4, coercions: 0, joins: 0/0} Foo.$wh [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.Int# -> Bool -[GblId, Arity=2, Caf=NoCafRefs, Str=, Unf=OtherCon []] +[GblId, Arity=2, Str=, Unf=OtherCon []] Foo.$wh - = \ (ww_s2kj :: GHC.Prim.Int#) (ww1_s2kn :: GHC.Prim.Int#) -> - case ww_s2kj of ds_X2gt { - __DEFAULT -> Foo.$wh (GHC.Prim.-# ds_X2gt 1#) ww1_s2kn; - 0# -> GHC.Prim.tagToEnum# @ Bool (GHC.Prim.># ww1_s2kn 0#) + = \ (ww_s1tz :: GHC.Prim.Int#) (ww1_s1tD :: GHC.Prim.Int#) -> + case ww_s1tz of ds_X2 { + __DEFAULT -> Foo.$wh (GHC.Prim.-# ds_X2 1#) ww1_s1tD; + 0# -> GHC.Prim.tagToEnum# @Bool (GHC.Prim.># ww1_s1tD 0#) } end Rec } @@ -409,26 +368,25 @@ end Rec } h [InlPrag=NOUSERINLINE[2]] :: Int -> Int -> Bool [GblId, Arity=2, - Caf=NoCafRefs, - Str=, + Str=, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) - Tmpl= \ (w_s2kf [Occ=Once!] :: Int) (w1_s2kg [Occ=Once!] :: Int) -> - case w_s2kf of { GHC.Types.I# ww1_s2kj [Occ=Once] -> - case w1_s2kg of { GHC.Types.I# ww3_s2kn [Occ=Once] -> Foo.$wh ww1_s2kj ww3_s2kn } + Tmpl= \ (w_s1tv [Occ=Once!] :: Int) (w1_s1tw [Occ=Once!] :: Int) -> + case w_s1tv of { GHC.Types.I# ww1_s1tz [Occ=Once] -> + case w1_s1tw of { GHC.Types.I# ww3_s1tD [Occ=Once] -> Foo.$wh ww1_s1tz ww3_s1tD } }}] -h = \ (w_s2kf :: Int) (w1_s2kg :: Int) -> - case w_s2kf of { GHC.Types.I# ww1_s2kj -> case w1_s2kg of { GHC.Types.I# ww3_s2kn -> Foo.$wh ww1_s2kj ww3_s2kn } } +h = \ (w_s1tv :: Int) (w1_s1tw :: Int) -> + case w_s1tv of { GHC.Types.I# ww1_s1tz -> case w1_s1tw of { GHC.Types.I# ww3_s1tD -> Foo.$wh ww1_s1tz ww3_s1tD } } Rec { -- RHS size: {terms: 12, types: 2, coercions: 0, joins: 0/0} Foo.$wf1 [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.Int# -[GblId, Arity=1, Caf=NoCafRefs, Str=, Unf=OtherCon []] +[GblId, Arity=1, Str=, Unf=OtherCon []] Foo.$wf1 - = \ (ww_s2kt :: GHC.Prim.Int#) -> - case Foo.$wh ww_s2kt ww_s2kt of { - False -> Foo.$wf1 (GHC.Prim.-# ww_s2kt 1#); - True -> ww_s2kt + = \ (ww_s1tJ :: GHC.Prim.Int#) -> + case Foo.$wh ww_s1tJ ww_s1tJ of { + False -> Foo.$wf1 (GHC.Prim.-# ww_s1tJ 1#); + True -> ww_s1tJ } end Rec } @@ -436,25 +394,27 @@ end Rec } f1 [InlPrag=NOUSERINLINE[2]] :: Int -> Int [GblId, Arity=1, - Caf=NoCafRefs, - Str=m, + Str=, + Cpr=m1, 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_s2kq [Occ=Once!] :: Int) -> - case w_s2kq of { GHC.Types.I# ww1_s2kt [Occ=Once] -> case Foo.$wf1 ww1_s2kt of ww2_s2kx { __DEFAULT -> GHC.Types.I# ww2_s2kx } }}] + Tmpl= \ (w_s1tG [Occ=Once!] :: Int) -> + case w_s1tG of { GHC.Types.I# ww1_s1tJ [Occ=Once] -> + case Foo.$wf1 ww1_s1tJ of ww2_s1tN [Occ=Once] { __DEFAULT -> GHC.Types.I# ww2_s1tN } + }}] f1 - = \ (w_s2kq :: Int) -> - case w_s2kq of { GHC.Types.I# ww1_s2kt -> case Foo.$wf1 ww1_s2kt of ww2_s2kx { __DEFAULT -> GHC.Types.I# ww2_s2kx } } + = \ (w_s1tG :: Int) -> + case w_s1tG of { GHC.Types.I# ww1_s1tJ -> case Foo.$wf1 ww1_s1tJ of ww2_s1tN { __DEFAULT -> GHC.Types.I# ww2_s1tN } } Rec { -- RHS size: {terms: 14, types: 3, coercions: 0, joins: 0/0} Foo.$wf3 [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.Int# -> GHC.Prim.Int# -[GblId, Arity=2, Caf=NoCafRefs, Str=, Unf=OtherCon []] +[GblId, Arity=2, Str=, Unf=OtherCon []] Foo.$wf3 - = \ (ww_s2kF :: GHC.Prim.Int#) (ww1_s2kK :: GHC.Prim.Int#) -> - case Foo.$wh ww_s2kF ww1_s2kK of { - False -> ww_s2kF; - True -> Foo.$wf3 ww_s2kF (GHC.Prim.-# ww1_s2kK 1#) + = \ (ww_s1tV :: GHC.Prim.Int#) (ww1_s1u0 :: GHC.Prim.Int#) -> + case Foo.$wh ww_s1tV ww1_s1u0 of { + False -> ww_s1tV; + True -> Foo.$wf3 ww_s1tV (GHC.Prim.-# ww1_s1u0 1#) } end Rec } @@ -462,23 +422,23 @@ end Rec } f3 [InlPrag=NOUSERINLINE[2]] :: T3 -> Int [GblId, Arity=1, - Caf=NoCafRefs, - Str=m, + Str=, + Cpr=m1, 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_s2kz [Occ=Once!] :: T3) -> - case w_s2kz of { MkT3 ww1_s2kC [Occ=Once!] ww2_s2kH [Occ=Once!] -> - case ww1_s2kC of { GHC.Types.I# ww4_s2kF [Occ=Once] -> - case ww2_s2kH of { GHC.Types.I# ww6_s2kK [Occ=Once] -> - case Foo.$wf3 ww4_s2kF ww6_s2kK of ww7_s2kP { __DEFAULT -> GHC.Types.I# ww7_s2kP } + Tmpl= \ (w_s1tP [Occ=Once!] :: T3) -> + case w_s1tP of { MkT3 ww1_s1tS [Occ=Once!] ww2_s1tX [Occ=Once!] -> + case ww1_s1tS of { GHC.Types.I# ww4_s1tV [Occ=Once] -> + case ww2_s1tX of { GHC.Types.I# ww6_s1u0 [Occ=Once] -> + case Foo.$wf3 ww4_s1tV ww6_s1u0 of ww7_s1u5 [Occ=Once] { __DEFAULT -> GHC.Types.I# ww7_s1u5 } } } }}] f3 - = \ (w_s2kz :: T3) -> - case w_s2kz of { MkT3 ww1_s2kC ww2_s2kH -> - case ww1_s2kC of { GHC.Types.I# ww4_s2kF -> - case ww2_s2kH of { GHC.Types.I# ww6_s2kK -> case Foo.$wf3 ww4_s2kF ww6_s2kK of ww7_s2kP { __DEFAULT -> GHC.Types.I# ww7_s2kP } } + = \ (w_s1tP :: T3) -> + case w_s1tP of { MkT3 ww1_s1tS ww2_s1tX -> + case ww1_s1tS of { GHC.Types.I# ww4_s1tV -> + case ww2_s1tX of { GHC.Types.I# ww6_s1u0 -> case Foo.$wf3 ww4_s1tV ww6_s1u0 of ww7_s1u5 { __DEFAULT -> GHC.Types.I# ww7_s1u5 } } } } ===================================== testsuite/tests/stranal/sigs/DmdAnalGADTs.stderr ===================================== @@ -9,7 +9,7 @@ DmdAnalGADTs.f: DmdAnalGADTs.f': DmdAnalGADTs.g: DmdAnalGADTs.hasCPR: -DmdAnalGADTs.hasStrSig: +DmdAnalGADTs.hasStrSig: @@ -23,7 +23,7 @@ DmdAnalGADTs.f: DmdAnalGADTs.f': m1 DmdAnalGADTs.g: DmdAnalGADTs.hasCPR: m1 -DmdAnalGADTs.hasStrSig: m1 +DmdAnalGADTs.hasStrSig: @@ -37,6 +37,6 @@ DmdAnalGADTs.f: DmdAnalGADTs.f': DmdAnalGADTs.g: DmdAnalGADTs.hasCPR: -DmdAnalGADTs.hasStrSig: +DmdAnalGADTs.hasStrSig: ===================================== testsuite/tests/stranal/sigs/T17932.hs ===================================== @@ -0,0 +1,11 @@ +-- See commentary in #17932 + +module T17932 where + +flags (Options f x) + = reverse (reverse (reverse (reverse (reverse (reverse (reverse (reverse x))))))) + `seq` f + +data X = X String Bool Bool Bool Bool + +data Options = Options !X [Int] ===================================== testsuite/tests/stranal/sigs/T17932.stderr ===================================== @@ -0,0 +1,30 @@ + +==================== Strictness signatures ==================== +T17932.$tc'Options: +T17932.$tc'X: +T17932.$tcOptions: +T17932.$tcX: +T17932.$trModule: +T17932.flags: + + + +==================== Cpr signatures ==================== +T17932.$tc'Options: m1 +T17932.$tc'X: m1 +T17932.$tcOptions: m1 +T17932.$tcX: m1 +T17932.$trModule: m1 +T17932.flags: + + + +==================== Strictness signatures ==================== +T17932.$tc'Options: +T17932.$tc'X: +T17932.$tcOptions: +T17932.$tcX: +T17932.$trModule: +T17932.flags: + + ===================================== testsuite/tests/stranal/sigs/UnsatFun.stderr ===================================== @@ -5,8 +5,8 @@ UnsatFun.f: b UnsatFun.g: b UnsatFun.g': UnsatFun.g3: -UnsatFun.h: -UnsatFun.h2: +UnsatFun.h: +UnsatFun.h2: UnsatFun.h3: @@ -29,8 +29,8 @@ UnsatFun.f: b UnsatFun.g: b UnsatFun.g': UnsatFun.g3: -UnsatFun.h: -UnsatFun.h2: +UnsatFun.h: +UnsatFun.h2: UnsatFun.h3: ===================================== testsuite/tests/stranal/sigs/all.T ===================================== @@ -19,3 +19,4 @@ test('T12370', normal, compile, ['']) test('CaseBinderCPR', normal, compile, ['']) test('NewtypeArity', normal, compile, ['']) test('T5075', normal, compile, ['']) +test('T17932', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/54250f2d8de910b094070c1b48f086030df634b1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/54250f2d8de910b094070c1b48f086030df634b1 You're receiving 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 Mar 29 21:29:02 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 29 Mar 2020 17:29:02 -0400 Subject: [Git][ghc/ghc][master] 3 commits: Modules: Types (#13009) Message-ID: <5e81131e8badc_6167120434ec1256379@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - 30 changed files: - compiler/GHC.hs - 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/BlockId.hs - compiler/GHC/Cmm/BlockId.hs-boot - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow.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.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/Ppr.hs - compiler/GHC/Cmm/ProcPoint.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Switch/Implement.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/BlockLayout.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1c446220250dcada51d4bb33a0cc7d8ce572e8b6...f1a6c73d01912b389e012a0af81a5c2002e82636 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1c446220250dcada51d4bb33a0cc7d8ce572e8b6...f1a6c73d01912b389e012a0af81a5c2002e82636 You're receiving 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 Mar 29 21:30:14 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 29 Mar 2020 17:30:14 -0400 Subject: [Git][ghc/ghc][master] 3 commits: testsuite: Fix T17786 on Windows Message-ID: <5e811366de704_61677b155d8126354e@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 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. - - - - - 3 changed files: - testsuite/tests/codeGen/should_compile/Makefile - testsuite/tests/driver/Makefile - testsuite/tests/driver/all.T Changes: ===================================== testsuite/tests/codeGen/should_compile/Makefile ===================================== @@ -63,11 +63,11 @@ T17648: # -O is necessary as otherwise we don't write interface pragmas (e.g. # NoCafRefs) to the interface files. '$(TEST_HC)' $(TEST_HC_OPTS) -dno-typeable-binds -O T17648.hs -v0 - '$(TEST_HC)' --show-iface T17648.hi | tr -d '\n' | \ + '$(TEST_HC)' --show-iface T17648.hi | tr -d '\n\r' | \ grep -F 'f :: T GHC.Types.Int -> () [HasNoCafRefs, Arity' >/dev/null # Second compilation with -fcatch-bottoms, f should be CAFFY '$(TEST_HC)' $(TEST_HC_OPTS) -dno-typeable-binds -O \ -fcatch-bottoms T17648.hs -v0 -fforce-recomp - '$(TEST_HC)' --show-iface T17648.hi | tr -d '\n' | \ + '$(TEST_HC)' --show-iface T17648.hi | tr -d '\n\r' | \ grep -F 'f :: T GHC.Types.Int -> () [Arity: 1, Strictness' >/dev/null ===================================== testsuite/tests/driver/Makefile ===================================== @@ -678,4 +678,4 @@ T14452: .PHONY: T17786 T17786: # N.B. Check for the presence of caret diagnostics. - "$(TEST_HC)" $(TEST_HC_OPTS) -v $(shell cygpath -w -a T17786.hs) 2>&1 | grep --quiet '3 |' + "$(TEST_HC)" $(TEST_HC_OPTS) -v "$(shell cygpath -w -a T17786.hs)" 2>&1 | grep --quiet '3 |' ===================================== testsuite/tests/driver/all.T ===================================== @@ -258,7 +258,7 @@ test('T12752pass', normal, compile, ['-DSHOULD_PASS=1 -Wcpp-undef']) test('T12955', normal, makefile_test, []) -test('T12971', ignore_stdout, makefile_test, []) +test('T12971', [when(opsys('mingw32'), expect_broken(17945)), ignore_stdout], makefile_test, []) test('json', normal, compile_fail, ['-ddump-json']) test('json2', normalise_version('base','ghc-prim'), compile, ['-ddump-types -ddump-json']) test('T13604', [], makefile_test, []) @@ -278,4 +278,4 @@ test('T16737', compile_and_run, ['-optP=-isystem -optP=T16737include']) test('T17143', exit_code(1), run_command, ['{compiler} T17143.hs -S -fno-code']) -test('T17786', [unless(opsys('mingw32'), skip), exit_code(1)], makefile_test, []) +test('T17786', unless(opsys('mingw32'), skip), makefile_test, []) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/54250f2d8de910b094070c1b48f086030df634b1...ef9c608eba417c59fe45c9edd6a946c59f50b5d2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/54250f2d8de910b094070c1b48f086030df634b1...ef9c608eba417c59fe45c9edd6a946c59f50b5d2 You're receiving 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 Mar 29 21:30:59 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 29 Mar 2020 17:30:59 -0400 Subject: [Git][ghc/ghc][master] Store ComponentId details Message-ID: <5e811393eea23_61673f8198ee100c1266472@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 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. - - - - - 15 changed files: - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/Finder.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Packages.hs - compiler/GHC/Driver/Packages.hs-boot - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Driver/Types.hs - compiler/GHC/Runtime/Linker.hs - compiler/GHC/Types/Module.hs - compiler/GHC/Types/Module.hs-boot - compiler/main/UnitInfo.hs - compiler/typecheck/TcBackpack.hs - ghc/GHCi/UI.hs - ghc/Main.hs Changes: ===================================== compiler/GHC/Driver/Backpack.hs ===================================== @@ -87,7 +87,8 @@ doBackpack [src_filename] = do POk _ pkgname_bkp -> do -- OK, so we have an LHsUnit PackageName, but we want an -- LHsUnit HsComponentId. So let's rename it. - let bkp = renameHsUnits dflags (packageNameMap pkgname_bkp) pkgname_bkp + let pkgstate = pkgState dflags + let bkp = renameHsUnits pkgstate (packageNameMap pkgstate pkgname_bkp) pkgname_bkp initBkpM src_filename bkp $ forM_ (zip [1..] bkp) $ \(i, lunit) -> do let comp_name = unLoc (hsunitName (unLoc lunit)) @@ -95,7 +96,7 @@ doBackpack [src_filename] = do innerBkpM $ do let (cid, insts) = computeUnitId lunit if null insts - then if cid == ComponentId (fsLit "main") + then if cid == ComponentId (fsLit "main") Nothing then compileExe lunit else compileUnit cid [] else typecheckUnit cid insts @@ -136,7 +137,7 @@ withBkpSession :: ComponentId -> BkpM a withBkpSession cid insts deps session_type do_this = do dflags <- getDynFlags - let (ComponentId cid_fs) = cid + let (ComponentId cid_fs _) = cid is_primary = False uid_str = unpackFS (hashUnitId cid insts) cid_str = unpackFS cid_fs @@ -205,7 +206,7 @@ withBkpSession cid insts deps session_type do_this = do withBkpExeSession :: [(UnitId, ModRenaming)] -> BkpM a -> BkpM a withBkpExeSession deps do_this = do - withBkpSession (ComponentId (fsLit "main")) [] deps ExeSession do_this + withBkpSession (ComponentId (fsLit "main") Nothing) [] deps ExeSession do_this getSource :: ComponentId -> BkpM (LHsUnit HsComponentId) getSource cid = do @@ -303,7 +304,7 @@ buildUnit session cid insts lunit = do getOfiles (LM _ _ us) = map nameOfObject (filter isObject us) obj_files = concatMap getOfiles linkables - let compat_fs = (case cid of ComponentId fs -> fs) + let compat_fs = (case cid of ComponentId fs _ -> fs) compat_pn = PackageName compat_fs return InstalledPackageInfo { @@ -560,22 +561,22 @@ type PackageNameMap a = Map PackageName a -- For now, something really simple, since we're not actually going -- to use this for anything -unitDefines :: LHsUnit PackageName -> (PackageName, HsComponentId) -unitDefines (L _ HsUnit{ hsunitName = L _ pn@(PackageName fs) }) - = (pn, HsComponentId pn (ComponentId fs)) +unitDefines :: PackageState -> LHsUnit PackageName -> (PackageName, HsComponentId) +unitDefines pkgstate (L _ HsUnit{ hsunitName = L _ pn@(PackageName fs) }) + = (pn, HsComponentId pn (mkComponentId pkgstate fs)) -packageNameMap :: [LHsUnit PackageName] -> PackageNameMap HsComponentId -packageNameMap units = Map.fromList (map unitDefines units) +packageNameMap :: PackageState -> [LHsUnit PackageName] -> PackageNameMap HsComponentId +packageNameMap pkgstate units = Map.fromList (map (unitDefines pkgstate) units) -renameHsUnits :: DynFlags -> PackageNameMap HsComponentId -> [LHsUnit PackageName] -> [LHsUnit HsComponentId] -renameHsUnits dflags m units = map (fmap renameHsUnit) units +renameHsUnits :: PackageState -> PackageNameMap HsComponentId -> [LHsUnit PackageName] -> [LHsUnit HsComponentId] +renameHsUnits pkgstate m units = map (fmap renameHsUnit) units where renamePackageName :: PackageName -> HsComponentId renamePackageName pn = case Map.lookup pn m of Nothing -> - case lookupPackageName dflags pn of + case lookupPackageName pkgstate pn of Nothing -> error "no package name" Just cid -> HsComponentId pn cid Just hscid -> hscid @@ -824,7 +825,7 @@ hsModuleToModSummary pn hsc_src modname -- | Create a new, externally provided hashed unit id from -- a hash. newInstalledUnitId :: ComponentId -> Maybe FastString -> InstalledUnitId -newInstalledUnitId (ComponentId cid_fs) (Just fs) +newInstalledUnitId (ComponentId cid_fs _) (Just fs) = InstalledUnitId (cid_fs `appendFS` mkFastString "+" `appendFS` fs) -newInstalledUnitId (ComponentId cid_fs) Nothing +newInstalledUnitId (ComponentId cid_fs _) Nothing = InstalledUnitId cid_fs ===================================== compiler/GHC/Driver/Finder.hs ===================================== @@ -340,8 +340,9 @@ findPackageModule hsc_env mod = do let dflags = hsc_dflags hsc_env pkg_id = installedModuleUnitId mod + pkgstate = pkgState dflags -- - case lookupInstalledPackage dflags pkg_id of + case lookupInstalledPackage pkgstate pkg_id of Nothing -> return (InstalledNoPackage pkg_id) Just pkg_conf -> findPackageModule_ hsc_env mod pkg_conf @@ -805,12 +806,13 @@ cantFindInstalledErr cannot_find _ dflags mod_name find_result _ -> panic "cantFindInstalledErr" build_tag = buildTag dflags + pkgstate = pkgState dflags looks_like_srcpkgid :: InstalledUnitId -> SDoc looks_like_srcpkgid pk -- Unsafely coerce a unit id FastString into a source package ID -- FastString and see if it means anything. - | (pkg:pkgs) <- searchPackageId dflags (SourcePackageId (installedUnitIdFS pk)) + | (pkg:pkgs) <- searchPackageId pkgstate (SourcePackageId (installedUnitIdFS pk)) = parens (text "This unit ID looks like the source package ID;" $$ text "the real unit ID is" <+> quotes (ftext (installedUnitIdFS (unitId pkg))) $$ (if null pkgs then Outputable.empty ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -1227,7 +1227,7 @@ checkPkgTrust pkgs = do dflags <- getDynFlags let errors = S.foldr go [] pkgs go pkg acc - | trusted $ getInstalledPackageDetails dflags pkg + | trusted $ getInstalledPackageDetails (pkgState dflags) pkg = acc | otherwise = (:acc) $ mkErrMsg dflags noSrcSpan (pkgQual dflags) ===================================== compiler/GHC/Driver/Packages.hs ===================================== @@ -47,6 +47,7 @@ module GHC.Driver.Packages ( getPackageFrameworkPath, getPackageFrameworks, getUnitInfoMap, + getPackageState, getPreloadPackagesAnd, collectArchives, @@ -54,6 +55,8 @@ module GHC.Driver.Packages ( packageHsLibs, getLibs, -- * Utils + mkComponentId, + updateComponentId, unwireUnitId, pprFlag, pprPackages, @@ -408,21 +411,21 @@ lookupUnit' True m@(UnitInfoMap pkg_map _) uid = -- | Find the indefinite package for a given 'ComponentId'. -- The way this works is just by fiat'ing that every indefinite package's -- unit key is precisely its component ID; and that they share uniques. -lookupComponentId :: DynFlags -> ComponentId -> Maybe UnitInfo -lookupComponentId dflags (ComponentId cid_fs) = lookupUDFM pkg_map cid_fs +lookupComponentId :: PackageState -> ComponentId -> Maybe UnitInfo +lookupComponentId pkgstate (ComponentId cid_fs) = lookupUDFM pkg_map cid_fs where - UnitInfoMap pkg_map = unitInfoMap (pkgState dflags) + UnitInfoMap pkg_map = unitInfoMap pkgstate -} -- | Find the package we know about with the given package name (e.g. @foo@), if any -- (NB: there might be a locally defined unit name which overrides this) -lookupPackageName :: DynFlags -> PackageName -> Maybe ComponentId -lookupPackageName dflags n = Map.lookup n (packageNameMap (pkgState dflags)) +lookupPackageName :: PackageState -> PackageName -> Maybe ComponentId +lookupPackageName pkgstate n = Map.lookup n (packageNameMap pkgstate) -- | Search for packages with a given package ID (e.g. \"foo-0.1\") -searchPackageId :: DynFlags -> SourcePackageId -> [UnitInfo] -searchPackageId dflags pid = filter ((pid ==) . sourcePackageId) - (listUnitInfoMap dflags) +searchPackageId :: PackageState -> SourcePackageId -> [UnitInfo] +searchPackageId pkgstate pid = filter ((pid ==) . sourcePackageId) + (listUnitInfoMap pkgstate) -- | Extends the package configuration map with a list of package configs. extendUnitInfoMap @@ -442,15 +445,15 @@ getPackageDetails dflags pid = Just config -> config Nothing -> pprPanic "getPackageDetails" (ppr pid) -lookupInstalledPackage :: DynFlags -> InstalledUnitId -> Maybe UnitInfo -lookupInstalledPackage dflags uid = lookupInstalledPackage' (unitInfoMap (pkgState dflags)) uid +lookupInstalledPackage :: PackageState -> InstalledUnitId -> Maybe UnitInfo +lookupInstalledPackage pkgstate uid = lookupInstalledPackage' (unitInfoMap pkgstate) uid lookupInstalledPackage' :: UnitInfoMap -> InstalledUnitId -> Maybe UnitInfo lookupInstalledPackage' (UnitInfoMap db _) uid = lookupUDFM db uid -getInstalledPackageDetails :: HasDebugCallStack => DynFlags -> InstalledUnitId -> UnitInfo -getInstalledPackageDetails dflags uid = - case lookupInstalledPackage dflags uid of +getInstalledPackageDetails :: HasDebugCallStack => PackageState -> InstalledUnitId -> UnitInfo +getInstalledPackageDetails pkgstate uid = + case lookupInstalledPackage pkgstate uid of Just config -> config Nothing -> pprPanic "getInstalledPackageDetails" (ppr uid) @@ -458,10 +461,10 @@ getInstalledPackageDetails dflags uid = -- this function, although all packages in this map are "visible", this -- does not imply that the exposed-modules of the package are available -- (they may have been thinned or renamed). -listUnitInfoMap :: DynFlags -> [UnitInfo] -listUnitInfoMap dflags = eltsUDFM pkg_map +listUnitInfoMap :: PackageState -> [UnitInfo] +listUnitInfoMap pkgstate = eltsUDFM pkg_map where - UnitInfoMap pkg_map _ = unitInfoMap (pkgState dflags) + UnitInfoMap pkg_map _ = unitInfoMap pkgstate -- ---------------------------------------------------------------------------- -- Loading the package db files and building up the package state @@ -1074,6 +1077,7 @@ findWiredInPackages dflags prec_map pkgs vis_map = do mb_wired_in_pkgs <- mapM (findWiredInPackage pkgs) wired_in_unitids let wired_in_pkgs = catMaybes mb_wired_in_pkgs + pkgstate = pkgState dflags -- this is old: we used to assume that if there were -- multiple versions of wired-in packages installed that @@ -1102,7 +1106,7 @@ findWiredInPackages dflags prec_map pkgs vis_map = do = let fs = installedUnitIdFS (unDefUnitId wiredInUnitId) in pkg { unitId = fsToInstalledUnitId fs, - componentId = ComponentId fs + componentId = mkComponentId pkgstate fs } | otherwise = pkg @@ -2054,7 +2058,7 @@ getPreloadPackagesAnd dflags pkgids0 = pairs = zip pkgids (repeat Nothing) in do all_pkgs <- throwErr dflags (foldM (add_package dflags pkg_map) preload pairs) - return (map (getInstalledPackageDetails dflags) all_pkgs) + return (map (getInstalledPackageDetails state) all_pkgs) -- Takes a list of packages, and returns the list with dependencies included, -- in reverse dependency order (a package appears before those it depends on). @@ -2107,20 +2111,48 @@ missingDependencyMsg (Just parent) -- ----------------------------------------------------------------------------- -componentIdString :: DynFlags -> ComponentId -> Maybe String -componentIdString dflags cid = do - conf <- lookupInstalledPackage dflags (componentIdToInstalledUnitId cid) - return $ - case sourceLibName conf of - Nothing -> sourcePackageIdString conf - Just (PackageName libname) -> - packageNameString conf - ++ "-" ++ showVersion (packageVersion conf) - ++ ":" ++ unpackFS libname - -displayInstalledUnitId :: DynFlags -> InstalledUnitId -> Maybe String -displayInstalledUnitId dflags uid = - fmap sourcePackageIdString (lookupInstalledPackage dflags uid) +componentIdString :: ComponentId -> String +componentIdString (ComponentId raw Nothing) = unpackFS raw +componentIdString (ComponentId _raw (Just details)) = + case componentName details of + Nothing -> componentSourcePkdId details + Just cname -> componentPackageName details + ++ "-" ++ showVersion (componentPackageVersion details) + ++ ":" ++ cname + +-- Cabal packages may contain several components (programs, libraries, etc.). +-- As far as GHC is concerned, installed package components ("units") are +-- identified by an opaque ComponentId string provided by Cabal. As the string +-- contains a hash, we don't want to display it to users so GHC queries the +-- database to retrieve some infos about the original source package (name, +-- version, component name). +-- +-- Instead we want to display: packagename-version[:componentname] +-- +-- Component name is only displayed if it isn't the default library +-- +-- To do this we need to query the database (cached in DynFlags). We cache +-- these details in the ComponentId itself because we don't want to query +-- DynFlags each time we pretty-print the ComponentId +-- +mkComponentId :: PackageState -> FastString -> ComponentId +mkComponentId pkgstate raw = + case lookupInstalledPackage pkgstate (InstalledUnitId raw) of + Nothing -> ComponentId raw Nothing -- we didn't find the unit at all + Just c -> ComponentId raw $ Just $ ComponentDetails + (packageNameString c) + (packageVersion c) + ((unpackFS . unPackageName) <$> sourceLibName c) + (sourcePackageIdString c) + +-- | Update component ID details from the database +updateComponentId :: PackageState -> ComponentId -> ComponentId +updateComponentId pkgstate (ComponentId raw _) = mkComponentId pkgstate raw + + +displayInstalledUnitId :: PackageState -> InstalledUnitId -> Maybe String +displayInstalledUnitId pkgstate uid = + fmap sourcePackageIdString (lookupInstalledPackage pkgstate uid) -- | Will the 'Name' come from a dynamically linked package? isDynLinkName :: DynFlags -> Module -> Name -> Bool @@ -2159,18 +2191,18 @@ isDynLinkName dflags this_mod name -- Displaying packages -- | Show (very verbose) package info -pprPackages :: DynFlags -> SDoc +pprPackages :: PackageState -> SDoc pprPackages = pprPackagesWith pprUnitInfo -pprPackagesWith :: (UnitInfo -> SDoc) -> DynFlags -> SDoc -pprPackagesWith pprIPI dflags = - vcat (intersperse (text "---") (map pprIPI (listUnitInfoMap dflags))) +pprPackagesWith :: (UnitInfo -> SDoc) -> PackageState -> SDoc +pprPackagesWith pprIPI pkgstate = + vcat (intersperse (text "---") (map pprIPI (listUnitInfoMap pkgstate))) -- | Show simplified package info. -- -- The idea is to only print package id, and any information that might -- be different from the package databases (exposure, trust) -pprPackagesSimple :: DynFlags -> SDoc +pprPackagesSimple :: PackageState -> SDoc pprPackagesSimple = pprPackagesWith pprIPI where pprIPI ipi = let i = installedUnitIdFS (unitId ipi) e = if exposed ipi then text "E" else text " " @@ -2211,3 +2243,8 @@ improveUnitId pkg_map uid = -- in the @hs-boot@ loop-breaker. getUnitInfoMap :: DynFlags -> UnitInfoMap getUnitInfoMap = unitInfoMap . pkgState + +-- | Retrieve the 'PackageState' from 'DynFlags'; used +-- in the @hs-boot@ loop-breaker. +getPackageState :: DynFlags -> PackageState +getPackageState = pkgState ===================================== compiler/GHC/Driver/Packages.hs-boot ===================================== @@ -1,12 +1,15 @@ module GHC.Driver.Packages where import GhcPrelude +import FastString import {-# SOURCE #-} GHC.Driver.Session (DynFlags) import {-# SOURCE #-} GHC.Types.Module(ComponentId, UnitId, InstalledUnitId) data PackageState data UnitInfoMap data PackageDatabase emptyPackageState :: PackageState -componentIdString :: DynFlags -> ComponentId -> Maybe String -displayInstalledUnitId :: DynFlags -> InstalledUnitId -> Maybe String +componentIdString :: ComponentId -> String +mkComponentId :: PackageState -> FastString -> ComponentId +displayInstalledUnitId :: PackageState -> InstalledUnitId -> Maybe String improveUnitId :: UnitInfoMap -> UnitId -> UnitId getUnitInfoMap :: DynFlags -> UnitInfoMap +getPackageState :: DynFlags -> PackageState ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -511,8 +511,9 @@ linkingNeeded dflags staticLink linkables pkg_deps = do -- next, check libraries. XXX this only checks Haskell libraries, -- not extra_libraries or -l things from the command line. + let pkgstate = pkgState dflags let pkg_hslibs = [ (collectLibraryPaths dflags [c], lib) - | Just c <- map (lookupInstalledPackage dflags) pkg_deps, + | Just c <- map (lookupInstalledPackage pkgstate) pkg_deps, lib <- packageHsLibs dflags c ] pkg_libfiles <- mapM (uncurry (findHSLib dflags)) pkg_hslibs ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -247,7 +247,7 @@ import GHC.Types.Module import {-# SOURCE #-} GHC.Driver.Plugins import {-# SOURCE #-} GHC.Driver.Hooks import {-# SOURCE #-} PrelNames ( mAIN ) -import {-# SOURCE #-} GHC.Driver.Packages (PackageState, emptyPackageState, PackageDatabase) +import {-# SOURCE #-} GHC.Driver.Packages (PackageState, emptyPackageState, PackageDatabase, mkComponentId) import GHC.Driver.Phases ( Phase(..), phaseInputExt ) import GHC.Driver.Flags import GHC.Driver.Ways @@ -1959,13 +1959,14 @@ setJsonLogAction d = d { log_action = jsonLogAction } thisComponentId :: DynFlags -> ComponentId thisComponentId dflags = - case thisComponentId_ dflags of - Just cid -> cid + let pkgstate = pkgState dflags + in case thisComponentId_ dflags of + Just (ComponentId raw _) -> mkComponentId pkgstate raw Nothing -> case thisUnitIdInsts_ dflags of Just _ -> throwGhcException $ CmdLineError ("Use of -instantiated-with requires -this-component-id") - Nothing -> ComponentId (unitIdFS (thisPackage dflags)) + Nothing -> mkComponentId pkgstate (unitIdFS (thisPackage dflags)) thisUnitIdInsts :: DynFlags -> [(ModuleName, Module)] thisUnitIdInsts dflags = @@ -2002,7 +2003,7 @@ setUnitIdInsts s d = setComponentId :: String -> DynFlags -> DynFlags setComponentId s d = - d { thisComponentId_ = Just (ComponentId (fsLit s)) } + d { thisComponentId_ = Just (ComponentId (fsLit s) Nothing) } addPluginModuleName :: String -> DynFlags -> DynFlags addPluginModuleName name d = d { pluginModNames = (mkModuleName name) : (pluginModNames d) } ===================================== compiler/GHC/Driver/Types.hs ===================================== @@ -2008,7 +2008,7 @@ mkQualPackage dflags uid -- database! = False | Just pkgid <- mb_pkgid - , searchPackageId dflags pkgid `lengthIs` 1 + , searchPackageId (pkgState dflags) pkgid `lengthIs` 1 -- this says: we are given a package pkg-0.1 at MMM, are there only one -- exposed packages whose package ID is pkg-0.1? = False ===================================== compiler/GHC/Runtime/Linker.hs ===================================== @@ -1248,6 +1248,7 @@ linkPackages' hsc_env new_pks pls = do return $! pls { pkgs_loaded = pkgs' } where dflags = hsc_dflags hsc_env + pkgstate = pkgState dflags link :: [LinkerUnitId] -> [LinkerUnitId] -> IO [LinkerUnitId] link pkgs new_pkgs = @@ -1257,7 +1258,7 @@ linkPackages' hsc_env new_pks pls = do | new_pkg `elem` pkgs -- Already linked = return pkgs - | Just pkg_cfg <- lookupInstalledPackage dflags new_pkg + | Just pkg_cfg <- lookupInstalledPackage pkgstate new_pkg = do { -- Link dependents first pkgs' <- link pkgs (depends pkg_cfg) -- Now link the package itself ===================================== compiler/GHC/Types/Module.hs ===================================== @@ -29,6 +29,7 @@ module GHC.Types.Module -- * The UnitId type ComponentId(..), + ComponentDetails(..), UnitId(..), unitIdFS, unitIdKey, @@ -148,7 +149,8 @@ import Binary import Util import Data.List (sortBy, sort) import Data.Ord -import GHC.PackageDb (BinaryStringRep(..), DbUnitIdModuleRep(..), DbModule(..), DbUnitId(..)) +import Data.Version +import GHC.PackageDb import Fingerprint import qualified Data.ByteString as BS @@ -170,7 +172,7 @@ import qualified FiniteMap as Map import System.FilePath import {-# SOURCE #-} GHC.Driver.Session (DynFlags) -import {-# SOURCE #-} GHC.Driver.Packages (componentIdString, improveUnitId, UnitInfoMap, getUnitInfoMap, displayInstalledUnitId) +import {-# SOURCE #-} GHC.Driver.Packages (improveUnitId, componentIdString, UnitInfoMap, getUnitInfoMap, displayInstalledUnitId, getPackageState) -- Note [The identifier lexicon] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -515,22 +517,39 @@ instance DbUnitIdModuleRep InstalledUnitId ComponentId UnitId ModuleName Module -- multiple components and a 'ComponentId' uniquely identifies a component -- within a package. When a package only has one component, the 'ComponentId' -- coincides with the 'InstalledPackageId' -newtype ComponentId = ComponentId FastString deriving (Eq, Ord) +data ComponentId = ComponentId + { componentIdRaw :: FastString -- ^ Raw + , componentIdDetails :: Maybe ComponentDetails -- ^ Cache of component details retrieved from the DB + } + +instance Eq ComponentId where + a == b = componentIdRaw a == componentIdRaw b + +instance Ord ComponentId where + compare a b = compare (componentIdRaw a) (componentIdRaw b) + +data ComponentDetails = ComponentDetails + { componentPackageName :: String + , componentPackageVersion :: Version + , componentName :: Maybe String + , componentSourcePkdId :: String + } instance BinaryStringRep ComponentId where - fromStringRep = ComponentId . mkFastStringByteString - toStringRep (ComponentId s) = bytesFS s + fromStringRep bs = ComponentId (mkFastStringByteString bs) Nothing + toStringRep (ComponentId s _) = bytesFS s instance Uniquable ComponentId where - getUnique (ComponentId n) = getUnique n + getUnique (ComponentId n _) = getUnique n instance Outputable ComponentId where - ppr cid@(ComponentId fs) = + ppr cid@(ComponentId fs _) = getPprStyle $ \sty -> - sdocWithDynFlags $ \dflags -> - case componentIdString dflags cid of - Just str | not (debugStyle sty) -> text str - _ -> ftext fs + if debugStyle sty + then ftext fs + else text (componentIdString cid) + + {- ************************************************************************ @@ -699,7 +718,7 @@ instance Outputable InstalledUnitId where ppr uid@(InstalledUnitId fs) = getPprStyle $ \sty -> sdocWithDynFlags $ \dflags -> - case displayInstalledUnitId dflags uid of + case displayInstalledUnitId (getPackageState dflags) uid of Just str | not (debugStyle sty) -> text str _ -> ftext fs @@ -745,7 +764,7 @@ fsToInstalledUnitId :: FastString -> InstalledUnitId fsToInstalledUnitId fs = InstalledUnitId fs componentIdToInstalledUnitId :: ComponentId -> InstalledUnitId -componentIdToInstalledUnitId (ComponentId fs) = fsToInstalledUnitId fs +componentIdToInstalledUnitId (ComponentId fs _) = fsToInstalledUnitId fs stringToInstalledUnitId :: String -> InstalledUnitId stringToInstalledUnitId = fsToInstalledUnitId . mkFastString @@ -908,12 +927,12 @@ instance Binary UnitId where _ -> fmap IndefiniteUnitId (get bh) instance Binary ComponentId where - put_ bh (ComponentId fs) = put_ bh fs - get bh = do { fs <- get bh; return (ComponentId fs) } + put_ bh (ComponentId fs _) = put_ bh fs + get bh = do { fs <- get bh; return (ComponentId fs Nothing) } -- | Create a new simple unit identifier (no holes) from a 'ComponentId'. newSimpleUnitId :: ComponentId -> UnitId -newSimpleUnitId (ComponentId fs) = fsToUnitId fs +newSimpleUnitId (ComponentId fs _) = fsToUnitId fs -- | Create a new simple unit identifier from a 'FastString'. Internally, -- this is primarily used to specify wired-in unit identifiers. @@ -1026,7 +1045,7 @@ parseUnitId = parseFullUnitId <++ parseDefiniteUnitId <++ parseSimpleUnitId return (newSimpleUnitId cid) parseComponentId :: ReadP ComponentId -parseComponentId = (ComponentId . mkFastString) `fmap` Parse.munch1 abi_char +parseComponentId = (flip ComponentId Nothing . mkFastString) `fmap` Parse.munch1 abi_char where abi_char c = isAlphaNum c || c `elem` "-_." parseModuleId :: ReadP Module ===================================== compiler/GHC/Types/Module.hs-boot ===================================== @@ -1,13 +1,12 @@ module GHC.Types.Module where import GhcPrelude -import FastString data Module data ModuleName data UnitId data InstalledUnitId -newtype ComponentId = ComponentId FastString +data ComponentId moduleName :: Module -> ModuleName moduleUnitId :: Module -> UnitId ===================================== compiler/main/UnitInfo.hs ===================================== @@ -58,7 +58,10 @@ type UnitInfo = InstalledPackageInfo -- other compact string types, e.g. plain ByteString or Text. newtype SourcePackageId = SourcePackageId FastString deriving (Eq, Ord) -newtype PackageName = PackageName FastString deriving (Eq, Ord) +newtype PackageName = PackageName + { unPackageName :: FastString + } + deriving (Eq, Ord) instance BinaryStringRep SourcePackageId where fromStringRep = SourcePackageId . mkFastStringByteString ===================================== compiler/typecheck/TcBackpack.hs ===================================== @@ -230,9 +230,17 @@ check_inst sig_inst = do -- | Return this list of requirement interfaces that need to be merged -- to form @mod_name@, or @[]@ if this is not a requirement. -requirementMerges :: DynFlags -> ModuleName -> [IndefModule] -requirementMerges dflags mod_name = - fromMaybe [] (Map.lookup mod_name (requirementContext (pkgState dflags))) +requirementMerges :: PackageState -> ModuleName -> [IndefModule] +requirementMerges pkgstate mod_name = + fmap fixupModule $ fromMaybe [] (Map.lookup mod_name (requirementContext pkgstate)) + where + -- update ComponentId cached details as they may have changed since the + -- time the ComponentId was created + fixupModule (IndefModule iud name) = IndefModule iud' name + where + iud' = iud { indefUnitIdComponentId = cid' } + cid = indefUnitIdComponentId iud + cid' = updateComponentId pkgstate cid -- | For a module @modname@ of type 'HscSource', determine the list -- of extra "imports" of other requirements which should be considered part of @@ -265,7 +273,8 @@ findExtraSigImports' hsc_env HsigFile modname = $ moduleFreeHolesPrecise (text "findExtraSigImports") (mkModule (IndefiniteUnitId iuid) mod_name))) where - reqs = requirementMerges (hsc_dflags hsc_env) modname + pkgstate = pkgState (hsc_dflags hsc_env) + reqs = requirementMerges pkgstate modname findExtraSigImports' _ _ _ = return emptyUniqDSet @@ -528,10 +537,11 @@ mergeSignatures let outer_mod = tcg_mod tcg_env inner_mod = tcg_semantic_mod tcg_env mod_name = moduleName (tcg_mod tcg_env) + pkgstate = pkgState dflags -- STEP 1: Figure out all of the external signature interfaces -- we are going to merge in. - let reqs = requirementMerges dflags mod_name + let reqs = requirementMerges pkgstate mod_name addErrCtxt (merge_msg mod_name reqs) $ do @@ -560,7 +570,7 @@ mergeSignatures let insts = indefUnitIdInsts iuid isFromSignaturePackage = let inst_uid = fst (splitUnitIdInsts (IndefiniteUnitId iuid)) - pkg = getInstalledPackageDetails dflags inst_uid + pkg = getInstalledPackageDetails pkgstate inst_uid in null (exposedModules pkg) -- 3(a). Rename the exports according to how the dependency -- was instantiated. The resulting export list will be accurate ===================================== ghc/GHCi/UI.hs ===================================== @@ -2345,7 +2345,8 @@ isSafeModule m = do tallyPkgs dflags deps | not (packageTrustOn dflags) = (S.empty, S.empty) | otherwise = S.partition part deps - where part pkg = trusted $ getInstalledPackageDetails dflags pkg + where part pkg = trusted $ getInstalledPackageDetails pkgstate pkg + pkgstate = pkgState dflags ----------------------------------------------------------------------------- -- :browse ===================================== ghc/Main.hs ===================================== @@ -865,9 +865,9 @@ dumpFastStringStats dflags = do x `pcntOf` y = int ((x * 100) `quot` y) Outputable.<> char '%' showPackages, dumpPackages, dumpPackagesSimple :: DynFlags -> IO () -showPackages dflags = putStrLn (showSDoc dflags (pprPackages dflags)) -dumpPackages dflags = putMsg dflags (pprPackages dflags) -dumpPackagesSimple dflags = putMsg dflags (pprPackagesSimple dflags) +showPackages dflags = putStrLn (showSDoc dflags (pprPackages (pkgState dflags))) +dumpPackages dflags = putMsg dflags (pprPackages (pkgState dflags)) +dumpPackagesSimple dflags = putMsg dflags (pprPackagesSimple (pkgState dflags)) -- ----------------------------------------------------------------------------- -- Frontend plugin support View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e54500c12de051cb9695728d27c812e5160593ee -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e54500c12de051cb9695728d27c812e5160593ee You're receiving 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 Mar 29 21:31:37 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 29 Mar 2020 17:31:37 -0400 Subject: [Git][ghc/ghc][master] testsuite: Remove test that dlopens a PIE object. Message-ID: <5e8113b9d09d0_61677b155d8127110@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 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. - - - - - 4 changed files: - testsuite/tests/dynlibs/Makefile - testsuite/tests/dynlibs/T13702.hs - testsuite/tests/dynlibs/T13702.stdout - − testsuite/tests/dynlibs/T13702a.hs Changes: ===================================== testsuite/tests/dynlibs/Makefile ===================================== @@ -60,6 +60,4 @@ T5373: .PHONY: T13702 T13702: '$(TEST_HC)' -v0 -dynamic -rdynamic -fPIC -pie T13702.hs - '$(TEST_HC)' -v0 -dynamic T13702a.hs - ./T13702 # first make sure executable itself works - ./T13702a # then try dynamically loading it as library + ./T13702 ===================================== testsuite/tests/dynlibs/T13702.hs ===================================== @@ -2,8 +2,3 @@ main :: IO () main = putStrLn "hello world" - -foreign export ccall "hello" hello :: IO () - -hello :: IO () -hello = putStrLn "hello world again" ===================================== testsuite/tests/dynlibs/T13702.stdout ===================================== @@ -1,2 +1 @@ hello world -hello world again ===================================== testsuite/tests/dynlibs/T13702a.hs deleted ===================================== @@ -1,12 +0,0 @@ -{-# LANGUAGE ForeignFunctionInterface #-} - -import Foreign -import System.Posix.DynamicLinker - -main :: IO () -main = do - dl <- dlopen "./T13702" [RTLD_NOW] - funptr <- dlsym dl "hello" :: IO (FunPtr (IO ())) - mkAction funptr - -foreign import ccall "dynamic" mkAction :: FunPtr (IO ()) -> IO () View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7e7cb714173652165b8372c3450f4ccd6a377497 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7e7cb714173652165b8372c3450f4ccd6a377497 You're receiving 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 Mar 29 21:32:13 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 29 Mar 2020 17:32:13 -0400 Subject: [Git][ghc/ghc][master] 2 commits: Correct haddocks for testBit in Data.Bits Message-ID: <5e8113dd4e031_6167116c28dc12742f0@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - 1 changed file: - libraries/base/Data/Bits.hs Changes: ===================================== libraries/base/Data/Bits.hs ===================================== @@ -168,10 +168,14 @@ class Eq a => Bits a where -- | @x \`complementBit\` i@ is the same as @x \`xor\` bit i@ complementBit :: a -> Int -> a - -- | Return 'True' if the @n at th bit of the argument is 1 - -- - -- Can be implemented using `testBitDefault' if @a@ is also an - -- instance of 'Num'. + {-| @x \`testBit\` i@ is the same as @x .&. bit n /= 0@ + + In other words it returns True if the bit at offset @n + is set. + + Can be implemented using `testBitDefault' if @a@ is also an + instance of 'Num'. + -} testBit :: a -> Int -> Bool {-| Return the number of bits in the type of the argument. The actual View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7e7cb714173652165b8372c3450f4ccd6a377497...c916f190b455d9c43459f81c7ee06d06ab3db957 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7e7cb714173652165b8372c3450f4ccd6a377497...c916f190b455d9c43459f81c7ee06d06ab3db957 You're receiving 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 Mar 29 21:32:50 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 29 Mar 2020 17:32:50 -0400 Subject: [Git][ghc/ghc][master] gitlab-ci: Add FreeBSD release job Message-ID: <5e81140278e3b_616776d1c7412769ab@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 64bf7f51 by Ben Gamari at 2020-03-29T17:32:41-04:00 gitlab-ci: Add FreeBSD release job - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -344,6 +344,11 @@ nightly-x86_64-freebsd: extends: .build-x86_64-freebsd stage: full-build +release-x86_64-freebsd: + <<: *release + extends: .build-x86_64-freebsd + stage: full-build + .build-x86_64-freebsd-hadrian: extends: .validate-hadrian stage: full-build View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/64bf7f51064dad9c63728ac8bccdb9cf00bdb420 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/64bf7f51064dad9c63728ac8bccdb9cf00bdb420 You're receiving 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 Mar 29 21:33:29 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 29 Mar 2020 17:33:29 -0400 Subject: [Git][ghc/ghc][master] Run checkNewDataCon before constraint-solving newtype constructors Message-ID: <5e811429efa3b_6167e0e2c94128145c@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 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. - - - - - 4 changed files: - compiler/typecheck/TcTyClsDecls.hs - + testsuite/tests/typecheck/should_fail/T17955.hs - + testsuite/tests/typecheck/should_fail/T17955.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/typecheck/TcTyClsDecls.hs ===================================== @@ -3992,9 +3992,6 @@ checkValidDataCon dflags existential_ok tc con -- Reason: it's really the argument of an equality constraint ; checkValidMonoType orig_res_ty - -- Check all argument types for validity - ; checkValidType ctxt (dataConUserType con) - -- If we are dealing with a newtype, we allow levity polymorphism -- regardless of whether or not UnliftedNewtypes is enabled. A -- later check in checkNewDataCon handles this, producing a @@ -4002,9 +3999,16 @@ checkValidDataCon dflags existential_ok tc con ; unless (isNewTyCon tc) (mapM_ (checkForLevPoly empty) (dataConOrigArgTys con)) - -- Extra checks for newtype data constructors + -- Extra checks for newtype data constructors. Importantly, these + -- checks /must/ come before the call to checkValidType below. This + -- is because checkValidType invokes the constraint solver, and + -- invoking the solver on an ill formed newtype constructor can + -- confuse GHC to the point of panicking. See #17955 for an example. ; when (isNewTyCon tc) (checkNewDataCon con) + -- Check all argument types for validity + ; checkValidType ctxt (dataConUserType con) + -- Check that existentials are allowed if they are used ; checkTc (existential_ok || isVanillaDataCon con) (badExistential con) ===================================== testsuite/tests/typecheck/should_fail/T17955.hs ===================================== @@ -0,0 +1,6 @@ +{-# LANGUAGE FlexibleContexts #-} +module T17955 where + +import Data.Coerce + +newtype T = Coercible () T => T () ===================================== testsuite/tests/typecheck/should_fail/T17955.stderr ===================================== @@ -0,0 +1,6 @@ + +T17955.hs:6:13: error: + • A newtype constructor cannot have a context in its type + T :: Coercible () T => () -> T + • In the definition of data constructor ‘T’ + In the newtype declaration for ‘T’ ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -561,3 +561,4 @@ test('T17566c', normal, compile_fail, ['']) test('T17773', normal, compile_fail, ['']) test('T17021', normal, compile_fail, ['']) test('T17021b', normal, compile_fail, ['']) +test('T17955', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a0d8e92e9c9b67426aa139d6bc46363d8940f992 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a0d8e92e9c9b67426aa139d6bc46363d8940f992 You're receiving 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 Mar 29 21:34:10 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 29 Mar 2020 17:34:10 -0400 Subject: [Git][ghc/ghc][master] Minor cleanup Message-ID: <5e811452a418d_61673f81cca05dd812846a0@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 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. - - - - - 10 changed files: - compiler/GHC/Core/Make.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/PmCheck.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Rename/Expr.hs - compiler/typecheck/TcExpr.hs - compiler/typecheck/TcHsSyn.hs - compiler/typecheck/TcPatSyn.hs - compiler/typecheck/TcSigs.hs Changes: ===================================== compiler/GHC/Core/Make.hs ===================================== @@ -647,7 +647,7 @@ mkBuildExpr :: (MonadFail.MonadFail m, MonadThings m, MonadUnique m) -- the body of that worker -> m CoreExpr mkBuildExpr elt_ty mk_build_inside = do - [n_tyvar] <- newTyVars [alphaTyVar] + n_tyvar <- newTyVar alphaTyVar let n_ty = mkTyVarTy n_tyvar c_ty = mkVisFunTys [elt_ty, n_ty] n_ty [c, n] <- sequence [mkSysLocalM (fsLit "c") c_ty, mkSysLocalM (fsLit "n") n_ty] @@ -657,9 +657,9 @@ mkBuildExpr elt_ty mk_build_inside = do build_id <- lookupId buildName return $ Var build_id `App` Type elt_ty `App` mkLams [n_tyvar, c, n] build_inside where - newTyVars tyvar_tmpls = do - uniqs <- getUniquesM - return (zipWith setTyVarUnique tyvar_tmpls uniqs) + newTyVar tyvar_tmpl = do + uniq <- getUniqueM + return (setTyVarUnique tyvar_tmpl uniq) {- ************************************************************************ ===================================== compiler/GHC/Hs/Pat.hs ===================================== @@ -737,7 +737,7 @@ isIrrefutableHsPat -- since we cannot know until the splice is evaluated. go (SplicePat {}) = False - go (XPat {}) = False + go (XPat nec) = noExtCon nec -- | Is the pattern any of combination of: -- ===================================== compiler/GHC/HsToCore/Arrows.hs ===================================== @@ -1248,7 +1248,7 @@ collectl (L _ pat) bndrs go (CoPat _ _ pat _) = collectl (noLoc pat) bndrs go (ViewPat _ _ pat) = collectl pat bndrs go p@(SplicePat {}) = pprPanic "collectl/go" (ppr p) - go p@(XPat {}) = pprPanic "collectl/go" (ppr p) + go (XPat nec) = noExtCon nec collectEvBinders :: TcEvBinds -> [Id] collectEvBinders (EvBinds bs) = foldr add_ev_bndr [] bs ===================================== compiler/GHC/HsToCore/PmCheck.hs ===================================== @@ -642,7 +642,7 @@ translateMatch fam_insts vars (L match_loc (Match { m_pats = pats, m_grhss = grh grhss' <- mapM (translateLGRHS fam_insts match_loc pats) (grhssGRHSs grhss) -- tracePm "translateMatch" (vcat [ppr pats, ppr pats', ppr grhss, ppr grhss']) return (mkGrdTreeMany pats' grhss') -translateMatch _ _ (L _ (XMatch _)) = panic "translateMatch" +translateMatch _ _ (L _ (XMatch nec)) = noExtCon nec -- ----------------------------------------------------------------------- -- * Transform source guards (GuardStmt Id) to simpler PmGrds @@ -657,7 +657,7 @@ translateLGRHS fam_insts match_loc pats (L _loc (GRHS _ gs _)) = | null gs = L match_loc (sep (map ppr pats)) | otherwise = L grd_loc (sep (map ppr pats) <+> vbar <+> interpp'SP gs) L grd_loc _ = head gs -translateLGRHS _ _ _ (L _ (XGRHS _)) = panic "translateLGRHS" +translateLGRHS _ _ _ (L _ (XGRHS nec)) = noExtCon nec -- | Translate a guard statement to a 'GrdVec' translateGuard :: FamInstEnvs -> GuardStmt GhcTc -> DsM GrdVec ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -753,7 +753,7 @@ instance ( a ~ GhcPass p in toHie $ patScopes Nothing rhsScope NoScope pats , toHie grhss ] - XMatch _ -> [] + XMatch nec -> noExtCon nec instance ( ToHie (Context (Located (IdP a))) ) => ToHie (HsMatchContext a) where @@ -842,7 +842,7 @@ instance ( a ~ GhcPass p ] CoPat _ _ _ _ -> [] - XPat _ -> [] + XPat nec -> noExtCon nec where contextify (PrefixCon args) = PrefixCon $ patScopes rsp scope pscope args contextify (InfixCon a b) = InfixCon a' b' @@ -1039,7 +1039,7 @@ instance ( a ~ GhcPass p [ toHie expr ] Missing _ -> [] - XTupArg _ -> [] + XTupArg nec -> noExtCon nec instance ( a ~ GhcPass p , ToHie (PScoped (LPat a)) @@ -1081,7 +1081,7 @@ instance ( a ~ GhcPass p RecStmt {recS_stmts = stmts} -> [ toHie $ map (RS $ combineScopes scope (mkScope span)) stmts ] - XStmtLR _ -> [] + XStmtLR nec -> noExtCon nec instance ( ToHie (LHsExpr a) , ToHie (PScoped (LPat a)) @@ -1145,7 +1145,7 @@ instance ToHie (RFContext (LFieldOcc GhcRn)) where FieldOcc name _ -> [ toHie $ C (RecField c rhs) (L nspan $ removeDefSrcSpan name) ] - XFieldOcc _ -> [] + XFieldOcc nec -> noExtCon nec instance ToHie (RFContext (LFieldOcc GhcTc)) where toHie (RFC c rhs (L nspan f)) = concatM $ case f of @@ -1153,7 +1153,7 @@ instance ToHie (RFContext (LFieldOcc GhcTc)) where let var' = setVarName var (removeDefSrcSpan $ varName var) in [ toHie $ C (RecField c rhs) (L nspan var') ] - XFieldOcc _ -> [] + XFieldOcc nec -> noExtCon nec instance ToHie (RFContext (Located (AmbiguousFieldOcc GhcRn))) where toHie (RFC c rhs (L nspan afo)) = concatM $ case afo of @@ -1162,7 +1162,7 @@ instance ToHie (RFContext (Located (AmbiguousFieldOcc GhcRn))) where ] Ambiguous _name _ -> [ ] - XAmbiguousFieldOcc _ -> [] + XAmbiguousFieldOcc nec -> noExtCon nec instance ToHie (RFContext (Located (AmbiguousFieldOcc GhcTc))) where toHie (RFC c rhs (L nspan afo)) = concatM $ case afo of @@ -1174,7 +1174,7 @@ instance ToHie (RFContext (Located (AmbiguousFieldOcc GhcTc))) where let var' = setVarName var (removeDefSrcSpan $ varName var) in [ toHie $ C (RecField c rhs) (L nspan var') ] - XAmbiguousFieldOcc _ -> [] + XAmbiguousFieldOcc nec -> noExtCon nec instance ( a ~ GhcPass p , ToHie (PScoped (LPat a)) @@ -1193,7 +1193,7 @@ instance ( a ~ GhcPass p [ toHie $ listScopes NoScope stmts , toHie $ PS Nothing sc NoScope pat ] - toHie (RS _ (XApplicativeArg _)) = pure [] + toHie (RS _ (XApplicativeArg nec)) = noExtCon nec instance (ToHie arg, ToHie rec) => ToHie (HsConDetails arg rec) where toHie (PrefixCon args) = toHie args @@ -1271,7 +1271,7 @@ instance ToHie (TyClGroup GhcRn) where , toHie roles , toHie instances ] - toHie (XTyClGroup _) = pure [] + toHie (XTyClGroup nec) = noExtCon nec instance ToHie (LTyClDecl GhcRn) where toHie (L span decl) = concatM $ makeNode decl span : case decl of @@ -1317,7 +1317,7 @@ instance ToHie (LTyClDecl GhcRn) where context_scope = mkLScope context rhs_scope = foldl1' combineScopes $ map mkScope [ loc deps, loc sigs, loc (bagToList meths), loc typs, loc deftyps] - XTyClDecl _ -> [] + XTyClDecl nec -> noExtCon nec instance ToHie (LFamilyDecl GhcRn) where toHie (L span decl) = concatM $ makeNode decl span : case decl of @@ -1332,7 +1332,7 @@ instance ToHie (LFamilyDecl GhcRn) where rhsSpan = sigSpan `combineScopes` injSpan sigSpan = mkScope $ getLoc sig injSpan = maybe NoScope (mkScope . getLoc) inj - XFamilyDecl _ -> [] + XFamilyDecl nec -> noExtCon nec instance ToHie (FamilyInfo GhcRn) where toHie (ClosedTypeFamily (Just eqns)) = concatM $ @@ -1353,7 +1353,7 @@ instance ToHie (RScoped (LFamilyResultSig GhcRn)) where TyVarSig _ bndr -> [ toHie $ TVS (ResolvedScopes [sc]) NoScope bndr ] - XFamilyResultSig _ -> [] + XFamilyResultSig nec -> noExtCon nec instance ToHie (Located (FunDep (Located Name))) where toHie (L span fd@(lhs, rhs)) = concatM $ @@ -1377,7 +1377,7 @@ instance (ToHie rhs, HasLoc rhs) where scope = combineScopes patsScope rhsScope patsScope = mkScope (loc pats) rhsScope = mkScope (loc rhs) - toHie (XFamEqn _) = pure [] + toHie (XFamEqn nec) = noExtCon nec instance ToHie (LInjectivityAnn GhcRn) where toHie (L span ann) = concatM $ makeNode ann span : case ann of @@ -1393,7 +1393,7 @@ instance ToHie (HsDataDefn GhcRn) where , toHie cons , toHie derivs ] - toHie (XHsDataDefn _) = pure [] + toHie (XHsDataDefn nec) = noExtCon nec instance ToHie (HsDeriving GhcRn) where toHie (L span clauses) = concatM @@ -1408,7 +1408,7 @@ instance ToHie (LHsDerivingClause GhcRn) where , pure $ locOnly ispan , toHie $ map (TS (ResolvedScopes [])) tys ] - XHsDerivingClause _ -> [] + XHsDerivingClause nec -> noExtCon nec instance ToHie (Located (DerivStrategy GhcRn)) where toHie (L span strat) = concatM $ makeNode strat span : case strat of @@ -1446,7 +1446,7 @@ instance ToHie (LConDecl GhcRn) where rhsScope = combineScopes ctxScope argsScope ctxScope = maybe NoScope mkLScope ctx argsScope = condecl_scope dets - XConDecl _ -> [] + XConDecl nec -> noExtCon nec where condecl_scope args = case args of PrefixCon xs -> foldr combineScopes NoScope $ map mkLScope xs InfixCon a b -> combineScopes (mkLScope a) (mkLScope b) @@ -1466,7 +1466,7 @@ instance ( HasLoc thing , toHie $ TS sc a ] where span = loc a - toHie (TS _ (XHsImplicitBndrs _)) = pure [] + toHie (TS _ (XHsImplicitBndrs nec)) = noExtCon nec instance ( HasLoc thing , ToHie (TScoped thing) @@ -1476,7 +1476,7 @@ instance ( HasLoc thing , toHie $ TS sc a ] where span = loc a - toHie (TS _ (XHsWildCardBndrs _)) = pure [] + toHie (TS _ (XHsWildCardBndrs nec)) = noExtCon nec instance ToHie (LStandaloneKindSig GhcRn) where toHie (L sp sig) = concatM [makeNode sig sp, toHie sig] @@ -1487,7 +1487,7 @@ instance ToHie (StandaloneKindSig GhcRn) where [ toHie $ C TyDecl name , toHie $ TS (ResolvedScopes []) typ ] - XStandaloneKindSig _ -> [] + XStandaloneKindSig nec -> noExtCon nec instance ToHie (SigContext (LSig GhcRn)) where toHie (SC (SI styp msp) (L sp sig)) = concatM $ makeNode sig sp : case sig of @@ -1531,7 +1531,7 @@ instance ToHie (SigContext (LSig GhcRn)) where , toHie $ map (C Use) names , toHie $ fmap (C Use) typ ] - XSig _ -> [] + XSig nec -> noExtCon nec instance ToHie (LHsType GhcRn) where toHie x = toHie $ TS (ResolvedScopes []) x @@ -1623,7 +1623,7 @@ instance ToHie (TVScoped (LHsTyVarBndr GhcRn)) where [ toHie $ C (TyVarBind sc tsc) var , toHie kind ] - XTyVarBndr _ -> [] + XTyVarBndr nec -> noExtCon nec instance ToHie (TScoped (LHsQTyVars GhcRn)) where toHie (TS sc (HsQTvs implicits vars)) = concatM $ @@ -1633,7 +1633,7 @@ instance ToHie (TScoped (LHsQTyVars GhcRn)) where where varLoc = loc vars bindings = map (C $ TyVarBind (mkScope varLoc) sc) implicits - toHie (TS _ (XLHsQTyVars _)) = pure [] + toHie (TS _ (XLHsQTyVars nec)) = noExtCon nec instance ToHie (LHsContext GhcRn) where toHie (L span tys) = concatM $ @@ -1647,7 +1647,7 @@ instance ToHie (LConDeclField GhcRn) where [ toHie $ map (RFC RecFieldDecl (getRealSpan $ loc typ)) fields , toHie typ ] - XConDeclField _ -> [] + XConDeclField nec -> noExtCon nec instance ToHie (LHsExpr a) => ToHie (ArithSeqInfo a) where toHie (From expr) = toHie expr @@ -1670,7 +1670,7 @@ instance ToHie (LSpliceDecl GhcRn) where SpliceDecl _ splice _ -> [ toHie splice ] - XSpliceDecl _ -> [] + XSpliceDecl nec -> noExtCon nec instance ToHie (HsBracket a) where toHie _ = pure [] @@ -1728,7 +1728,7 @@ instance ToHie (LRoleAnnotDecl GhcRn) where [ toHie $ C Use var , concatMapM (pure . locOnly . getLoc) roles ] - XRoleAnnotDecl _ -> [] + XRoleAnnotDecl nec -> noExtCon nec instance ToHie (LInstDecl GhcRn) where toHie (L span decl) = concatM $ makeNode decl span : case decl of @@ -1741,7 +1741,7 @@ instance ToHie (LInstDecl GhcRn) where TyFamInstD _ d -> [ toHie $ L span d ] - XInstDecl _ -> [] + XInstDecl nec -> noExtCon nec instance ToHie (LClsInstDecl GhcRn) where toHie (L span decl) = concatM @@ -1775,21 +1775,21 @@ instance ToHie (LDerivDecl GhcRn) where , toHie strat , toHie overlap ] - XDerivDecl _ -> [] + XDerivDecl nec -> noExtCon nec instance ToHie (LFixitySig GhcRn) where toHie (L span sig) = concatM $ makeNode sig span : case sig of FixitySig _ vars _ -> [ toHie $ map (C Use) vars ] - XFixitySig _ -> [] + XFixitySig nec -> noExtCon nec instance ToHie (LDefaultDecl GhcRn) where toHie (L span decl) = concatM $ makeNode decl span : case decl of DefaultDecl _ typs -> [ toHie typs ] - XDefaultDecl _ -> [] + XDefaultDecl nec -> noExtCon nec instance ToHie (LForeignDecl GhcRn) where toHie (L span decl) = concatM $ makeNode decl span : case decl of @@ -1803,7 +1803,7 @@ instance ToHie (LForeignDecl GhcRn) where , toHie $ TS (ResolvedScopes []) sig , toHie fe ] - XForeignDecl _ -> [] + XForeignDecl nec -> noExtCon nec instance ToHie ForeignImport where toHie (CImport (L a _) (L b _) _ _ (L c _)) = pure $ concat $ @@ -1823,14 +1823,14 @@ instance ToHie (LWarnDecls GhcRn) where Warnings _ _ warnings -> [ toHie warnings ] - XWarnDecls _ -> [] + XWarnDecls nec -> noExtCon nec instance ToHie (LWarnDecl GhcRn) where toHie (L span decl) = concatM $ makeNode decl span : case decl of Warning _ vars _ -> [ toHie $ map (C Use) vars ] - XWarnDecl _ -> [] + XWarnDecl nec -> noExtCon nec instance ToHie (LAnnDecl GhcRn) where toHie (L span decl) = concatM $ makeNode decl span : case decl of @@ -1838,7 +1838,7 @@ instance ToHie (LAnnDecl GhcRn) where [ toHie prov , toHie expr ] - XAnnDecl _ -> [] + XAnnDecl nec -> noExtCon nec instance ToHie (Context (Located a)) => ToHie (AnnProvenance a) where toHie (ValueAnnProvenance a) = toHie $ C Use a @@ -1850,10 +1850,10 @@ instance ToHie (LRuleDecls GhcRn) where HsRules _ _ rules -> [ toHie rules ] - XRuleDecls _ -> [] + XRuleDecls nec -> noExtCon nec instance ToHie (LRuleDecl GhcRn) where - toHie (L _ (XRuleDecl _)) = pure [] + toHie (L _ (XRuleDecl nec)) = noExtCon nec toHie (L span r@(HsRule _ rname _ tybndrs bndrs exprA exprB)) = concatM [ makeNode r span , pure $ locOnly $ getLoc rname @@ -1876,7 +1876,7 @@ instance ToHie (RScoped (LRuleBndr GhcRn)) where [ toHie $ C (ValBind RegularBind sc Nothing) var , toHie $ TS (ResolvedScopes [sc]) typ ] - XRuleBndr _ -> [] + XRuleBndr nec -> noExtCon nec instance ToHie (LImportDecl GhcRn) where toHie (L span decl) = concatM $ makeNode decl span : case decl of @@ -1885,7 +1885,7 @@ instance ToHie (LImportDecl GhcRn) where , toHie $ fmap (IEC ImportAs) as , maybe (pure []) goIE hidden ] - XImportDecl _ -> [] + XImportDecl nec -> noExtCon nec where goIE (hiding, (L sp liens)) = concatM $ [ pure $ locOnly sp @@ -1916,7 +1916,7 @@ instance ToHie (IEContext (LIE GhcRn)) where IEGroup _ _ _ -> [] IEDoc _ _ -> [] IEDocNamed _ _ -> [] - XIE _ -> [] + XIE nec -> noExtCon nec instance ToHie (IEContext (LIEWrappedName Name)) where toHie (IEC c (L span iewn)) = concatM $ makeNode iewn span : case iewn of ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -1853,7 +1853,8 @@ isStrictPattern lpat = NPat{} -> True NPlusKPat{} -> True SplicePat{} -> True - _otherwise -> panic "isStrictPattern" + CoPat{} -> panic "isStrictPattern: CoPat" + XPat nec -> noExtCon nec {- Note [ApplicativeDo and refutable patterns] ===================================== compiler/typecheck/TcExpr.hs ===================================== @@ -2231,7 +2231,7 @@ disambiguateRecordBinds record_expr record_rho rbnds res_ty isUnambiguous x = case unLoc (hsRecFieldLbl (unLoc x)) of Unambiguous sel_name _ -> Just (x, sel_name) Ambiguous{} -> Nothing - XAmbiguousFieldOcc{} -> Nothing + XAmbiguousFieldOcc nec -> noExtCon nec -- Look up the possible parents and selector GREs for each field getUpdFieldsParents :: TcM [(LHsRecUpdField GhcRn ===================================== compiler/typecheck/TcHsSyn.hs ===================================== @@ -796,8 +796,7 @@ zonkExpr env (HsTcBracketOut x wrap body bs) zonkExpr env (HsSpliceE _ (XSplice (HsSplicedT s))) = runTopSplice s >>= zonkExpr env -zonkExpr _ (HsSpliceE x s) = WARN( True, ppr s ) -- Should not happen - return (HsSpliceE x s) +zonkExpr _ e@(HsSpliceE _ _) = pprPanic "zonkExpr: HsSpliceE" (ppr e) zonkExpr env (OpApp fixity e1 op e2) = do new_e1 <- zonkLExpr env e1 ===================================== compiler/typecheck/TcPatSyn.hs ===================================== @@ -988,7 +988,7 @@ tcPatToExpr name args pat = go pat go1 p@(AsPat {}) = notInvertible p go1 p@(ViewPat {}) = notInvertible p go1 p@(NPlusKPat {}) = notInvertible p - go1 p@(XPat {}) = notInvertible p + go1 (XPat nec) = noExtCon nec go1 p@(SplicePat _ (HsTypedSplice {})) = notInvertible p go1 p@(SplicePat _ (HsUntypedSplice {})) = notInvertible p go1 p@(SplicePat _ (HsQuasiQuote {})) = notInvertible p ===================================== compiler/typecheck/TcSigs.hs ===================================== @@ -291,7 +291,7 @@ no_anon_wc lty = go lty HsTyLit{} -> True HsTyVar{} -> True HsStarTy{} -> True - XHsType{} -> True -- Core type, which does not have any wildcard + XHsType (NHsCoreTy{}) -> True -- Core type, which does not have any wildcard gos = all go View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/45eb9d8cad254440eaea25676d6788ca13baa2fb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/45eb9d8cad254440eaea25676d6788ca13baa2fb You're receiving 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 Mar 30 05:53:28 2020 From: gitlab at gitlab.haskell.org (=?UTF-8?B?w5ZtZXIgU2luYW4gQcSfYWNhbg==?=) Date: Mon, 30 Mar 2020 01:53:28 -0400 Subject: [Git][ghc/ghc][wip/osa1/lfinfo] 18 commits: Remove unused `ghciTablesNextToCode` from compiler proper Message-ID: <5e818958a53b7_61675cefcac1298934@gitlab.haskell.org.mail> Ömer Sinan Ağacan pushed to branch wip/osa1/lfinfo at Glasgow Haskell Compiler / GHC Commits: 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. - - - - - 8822bbc1 by Ömer Sinan Ağacan at 2020-03-30T08:53:10+03: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. 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% - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC.hs - 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/BlockId.hs - compiler/GHC/Cmm/BlockId.hs-boot - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow.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.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/Ppr.hs - compiler/GHC/Cmm/ProcPoint.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Switch/Implement.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/5484426d737ff9f48686498d0f2f082d8a727069...8822bbc170c2d6779d7c66d6f1aea1bc967babd7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5484426d737ff9f48686498d0f2f082d8a727069...8822bbc170c2d6779d7c66d6f1aea1bc967babd7 You're receiving 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 Mar 30 09:37:07 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 30 Mar 2020 05:37:07 -0400 Subject: [Git][ghc/ghc][wip/T13380] 25 commits: Use export list of Main module in function TcRnDriver.hs:check_main (Fix #16453) Message-ID: <5e81bdc32ee27_6167116c28dc1324779@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T13380 at Glasgow Haskell Compiler / GHC Commits: 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. - - - - - 833ac79d by Sebastian Graf at 2020-03-30T11:36:45+02: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. - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC.hs - 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/BlockId.hs - compiler/GHC/Cmm/BlockId.hs-boot - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow.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.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/Ppr.hs - compiler/GHC/Cmm/ProcPoint.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Switch/Implement.hs - compiler/GHC/Cmm/Utils.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ac492646fe3453a78c3f7e5f5e97d9736f973cda...833ac79d175a652b9036a657a27d0e329b9c77df -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ac492646fe3453a78c3f7e5f5e97d9736f973cda...833ac79d175a652b9036a657a27d0e329b9c77df You're receiving 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 Mar 30 10:24:02 2020 From: gitlab at gitlab.haskell.org (Alp Mestanogullari) Date: Mon, 30 Mar 2020 06:24:02 -0400 Subject: [Git][ghc/ghc][wip/T16296] Re-engineer the binder-swap transformation Message-ID: <5e81c8c2eb5c5_61675cefcac133934@gitlab.haskell.org.mail> Alp Mestanogullari pushed to branch wip/T16296 at Glasgow Haskell Compiler / GHC Commits: e7e4bad0 by Simon Peyton Jones at 2020-03-30T12:22:11+02: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 - - - - - 19 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Op/OccurAnal.hs - compiler/GHC/Core/Op/Simplify.hs - compiler/GHC/Core/Op/Simplify/Utils.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Stg/CSE.hs - compiler/basicTypes/IdInfo.hs - compiler/basicTypes/MkId.hs - testsuite/tests/dependent/should_compile/dynamic-paper.stderr - testsuite/tests/simplCore/should_compile/T17901.stdout - testsuite/tests/simplCore/should_compile/T7360.hs - testsuite/tests/simplCore/should_compile/T7360.stderr Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -69,7 +69,7 @@ module GHC.Core ( maybeUnfoldingTemplate, otherCons, isValueUnfolding, isEvaldUnfolding, isCheapUnfolding, isExpandableUnfolding, isConLikeUnfolding, isCompulsoryUnfolding, - isStableUnfolding, isFragileUnfolding, hasSomeUnfolding, + isStableUnfolding, hasCoreUnfolding, hasSomeUnfolding, isBootUnfolding, canUnfold, neverUnfoldGuidance, isStableSource, @@ -1739,14 +1739,13 @@ neverUnfoldGuidance :: UnfoldingGuidance -> Bool neverUnfoldGuidance UnfNever = True neverUnfoldGuidance _ = False -isFragileUnfolding :: Unfolding -> Bool --- An unfolding is fragile if it mentions free variables or --- is otherwise subject to change. A robust one can be kept. --- See Note [Fragile unfoldings] -isFragileUnfolding (CoreUnfolding {}) = True -isFragileUnfolding (DFunUnfolding {}) = True -isFragileUnfolding _ = False - -- NoUnfolding, BootUnfolding, OtherCon are all non-fragile +hasCoreUnfolding :: Unfolding -> Bool +-- An unfolding "has Core" if it contains a Core expression, which +-- may mention free variables. See Note [Fragile unfoldings] +hasCoreUnfolding (CoreUnfolding {}) = True +hasCoreUnfolding (DFunUnfolding {}) = True +hasCoreUnfolding _ = False + -- NoUnfolding, BootUnfolding, OtherCon have no Core canUnfold :: Unfolding -> Bool canUnfold (CoreUnfolding { uf_guidance = g }) = not (neverUnfoldGuidance g) ===================================== compiler/GHC/Core/FVs.hs ===================================== @@ -35,7 +35,7 @@ module GHC.Core.FVs ( idFVs, idRuleVars, idRuleRhsVars, stableUnfoldingVars, ruleRhsFreeVars, ruleFreeVars, rulesFreeVars, - rulesFreeVarsDSet, + rulesFreeVarsDSet, mkRuleInfo, ruleLhsFreeIds, ruleLhsFreeIdsList, expr_fvs, @@ -469,6 +469,11 @@ rulesFVs = mapUnionFV ruleFVs rulesFreeVarsDSet :: [CoreRule] -> DVarSet rulesFreeVarsDSet rules = fvDVarSet $ rulesFVs 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 ===================================== compiler/GHC/Core/Op/OccurAnal.hs ===================================== @@ -14,10 +14,7 @@ core expression with (hopefully) improved usage information. {-# LANGUAGE CPP, BangPatterns, MultiWayIf, ViewPatterns #-} {-# OPTIONS_GHC -Wno-incomplete-record-updates #-} - -module GHC.Core.Op.OccurAnal ( - occurAnalysePgm, occurAnalyseExpr, occurAnalyseExpr_NoBinderSwap - ) where +module GHC.Core.Op.OccurAnal ( occurAnalysePgm, occurAnalyseExpr ) where #include "HsVersions.h" @@ -30,7 +27,6 @@ import GHC.Core.Utils ( exprIsTrivial, isDefaultAlt, isExpandableApp, import GHC.Core.Arity ( joinRhsArity ) import Id import IdInfo -import Name( localiseName ) import BasicTypes import Module( Module ) import GHC.Core.Coercion @@ -47,14 +43,14 @@ import Unique import UniqFM import UniqSet import Util +import Maybes( orElse, isJust ) import Outputable import Data.List -import Control.Arrow ( second ) {- ************************************************************************ * * - occurAnalysePgm, occurAnalyseExpr, occurAnalyseExpr_NoBinderSwap + occurAnalysePgm, occurAnalyseExpr * * ************************************************************************ @@ -92,8 +88,7 @@ occurAnalysePgm this_mod active_unf active_rule imp_rules binds -- a binding that was actually needed (albeit before its -- definition site). #17724 threw this up. - initial_uds = addManyOccsSet emptyDetails - (rulesFreeVars imp_rules) + initial_uds = addManyOccs emptyDetails (rulesFreeVars imp_rules) -- The RULES declarations keep things alive! -- Note [Preventing loops due to imported functions rules] @@ -117,17 +112,9 @@ occurAnalysePgm this_mod active_unf active_rule imp_rules binds bs_usage occurAnalyseExpr :: CoreExpr -> CoreExpr - -- Do occurrence analysis, and discard occurrence info returned -occurAnalyseExpr = occurAnalyseExpr' True -- do binder swap - -occurAnalyseExpr_NoBinderSwap :: CoreExpr -> CoreExpr -occurAnalyseExpr_NoBinderSwap = occurAnalyseExpr' False -- do not do binder swap - -occurAnalyseExpr' :: Bool -> CoreExpr -> CoreExpr -occurAnalyseExpr' enable_binder_swap expr - = snd (occAnal env expr) - where - env = initOccEnv { occ_binder_swap = enable_binder_swap } +-- Do occurrence analysis, and discard occurrence info returned +occurAnalyseExpr expr + = snd (occAnal initOccEnv expr) {- Note [Plugin rules] ~~~~~~~~~~~~~~~~~~~~~~ @@ -672,38 +659,66 @@ tail call with `n` arguments (counting both value and type arguments). Otherwise 'occ_tail' will be 'NoTailCallInfo'. The tail call info flows bottom-up with the rest of 'OccInfo' until it goes on the binder. -Note [Rules and join points] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [Join points and unfoldings/rules] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + let j2 y = blah + let j x = j2 (x+x) + {-# INLINE [2] j #-} + in case e of { A -> j 1; B -> ...; C -> j 2 } -Things get fiddly with rules. Suppose we have: +Before j is inlined, we'll have occurrences of j2 in +both j's RHS and in its stable unfolding. We want to discover +j2 as a join point. So we must do the adjustRhsUsage thing +on j's RHS. That's why we pass mb_join_arity to calcUnfolding. + +Aame with rules. Suppose we have: let j :: Int -> Int j y = 2 * y - k :: Int -> Int -> Int - {-# RULES "SPEC k 0" k 0 = j #-} + let k :: Int -> Int -> Int + {-# RULES "SPEC k 0" k 0 y = j y #-} k x y = x + 2 * y - in ... - -Now suppose that both j and k appear only as saturated tail calls in the body. -Thus we would like to make them both join points. The rule complicates matters, -though, as its RHS has an unapplied occurrence of j. *However*, if we were to -eta-expand the rule, all would be well: - - {-# RULES "SPEC k 0" forall a. k 0 a = j a #-} - -So conceivably we could notice that a potential join point would have an -"undersaturated" rule and account for it. This would mean we could make -something that's been specialised a join point, for instance. But local bindings -are rarely specialised, and being overly cautious about rules only -costs us anything when, for some `j`: + in case e of { A -> k 1 2; B -> k 3 5; C -> blah } + +We identify k as a join point, and we want j to be a join point too. +Without the RULE it would be, and we don't want the RULE to mess it +up. So provided the join-point arity of k matches the args of the +rule we can allow the tail-cal info from the RHS of the rule to +propagate. + +* Wrinkle for Rec case. In the recursive case we don't know the + join-point arity in advance, when calling occAnalUnfolding and + occAnalRules. (See makeNode.) We don't want to pass Nothing, + because then a recursive joinrec might lose its join-poin-hood + when SpecConstr adds a RULE. So we just make do with the + *current* join-poin-hood, stored in the Id. + + In the non-recursive case things are simple: see occAnalNonRecBind + +* Wrinkle for RULES. Suppose the example was a bit different: + let j :: Int -> Int + j y = 2 * y + k :: Int -> Int -> Int + {-# RULES "SPEC k 0" k 0 = j #-} + k x y = x + 2 * y + in ... + If we eta-expanded the rule all woudl be well, but as it stands the + one arg of the rule don't match the join-point arity of 2. + + Conceivably we could notice that a potential join point would have + an "undersaturated" rule and account for it. This would mean we + could make something that's been specialised a join point, for + instance. But local bindings are rarely specialised, and being + overly cautious about rules only costs us anything when, for some `j`: * Before specialisation, `j` has non-tail calls, so it can't be a join point. * During specialisation, `j` gets specialised and thus acquires rules. * Sometime afterward, the non-tail calls to `j` disappear (as dead code, say), and so now `j` *could* become a join point. -This appears to be very rare in practice. TODO Perhaps we should gather -statistics to be sure. + This appears to be very rare in practice. TODO Perhaps we should gather + statistics to be sure. ------------------------------------------------------------ Note [Adjusting right-hand sides] @@ -767,44 +782,62 @@ occAnalBind env lvl top_env (Rec pairs) body_usage ----------------- occAnalNonRecBind :: OccEnv -> TopLevelFlag -> ImpRuleEdges -> Var -> CoreExpr -> UsageDetails -> (UsageDetails, [CoreBind]) -occAnalNonRecBind env lvl imp_rule_edges binder rhs body_usage - | isTyVar binder -- A type let; we don't gather usage info - = (body_usage, [NonRec binder rhs]) +occAnalNonRecBind env lvl imp_rule_edges bndr rhs body_usage + | isTyVar bndr -- A type let; we don't gather usage info + = (body_usage, [NonRec bndr rhs]) - | not (binder `usedIn` body_usage) -- It's not mentioned + | not (bndr `usedIn` body_usage) -- It's not mentioned = (body_usage, []) | otherwise -- It's mentioned in the body - = (body_usage' `andUDs` rhs_usage', [NonRec tagged_binder rhs']) + = (body_usage' `andUDs` rhs_usage4, [NonRec final_bndr rhs']) where - (body_usage', tagged_binder) = tagNonRecBinder lvl body_usage binder - mb_join_arity = willBeJoinId_maybe tagged_binder + (body_usage', tagged_bndr) = tagNonRecBinder lvl body_usage bndr + occ = idOccInfo tagged_bndr - (bndrs, body) = collectBinders rhs + -- Get the join info from the *new* decision + -- See Note [Join points and unfoldings/rules] + mb_join_arity = willBeJoinId_maybe tagged_bndr + is_join_point = isJust mb_join_arity - (rhs_usage1, bndrs', body') = occAnalNonRecRhs env tagged_binder bndrs body - rhs' = mkLams (markJoinOneShots mb_join_arity bndrs') body' - -- For a /non-recursive/ join point we can mark all - -- its join-lambda as one-shot; and it's a good idea to do so + final_bndr = tagged_bndr `setIdUnfolding` unf' + `setIdSpecialisation` mkRuleInfo rules' + + env1 | is_join_point = env -- See Note [Join point RHSs] + | certainly_inline = env -- See Note [Cascading inlines] + | otherwise = rhsCtxt env + + -- See Note [Sources of one-shot information] + rhs_env = env1 { occ_one_shots = argOneShots dmd } + + (rhs_usage1, rhs') = occAnalRhs rhs_env mb_join_arity rhs -- Unfoldings -- See Note [Unfoldings and join points] - rhs_usage2 = case occAnalUnfolding env NonRecursive binder of - Just unf_usage -> rhs_usage1 `andUDs` unf_usage - Nothing -> rhs_usage1 + unf = idUnfolding bndr + (unf_usage, unf') = occAnalUnfolding rhs_env mb_join_arity unf + rhs_usage2 = rhs_usage1 `andUDs` unf_usage -- Rules -- See Note [Rules are extra RHSs] and Note [Rule dependency info] - rules_w_uds = occAnalRules env mb_join_arity NonRecursive tagged_binder + rules_w_uds = occAnalRules rhs_env mb_join_arity bndr rule_uds = map (\(_, l, r) -> l `andUDs` r) rules_w_uds + rules' = map fstOf3 rules_w_uds rhs_usage3 = foldr andUDs rhs_usage2 rule_uds - rhs_usage4 = case lookupVarEnv imp_rule_edges binder of + rhs_usage4 = case lookupVarEnv imp_rule_edges bndr of Nothing -> rhs_usage3 - Just vs -> addManyOccsSet rhs_usage3 vs + Just vs -> addManyOccs rhs_usage3 vs -- See Note [Preventing loops due to imported functions rules] - -- Final adjustment - rhs_usage' = adjustRhsUsage mb_join_arity NonRecursive bndrs' rhs_usage4 + certainly_inline -- See Note [Cascading inlines] + = case occ of + OneOcc { occ_in_lam = NotInsideLam, occ_one_br = InOneBranch } + -> active && not_stable + _ -> False + + dmd = idDemandInfo bndr + active = isAlwaysActive (idInlineActivation bndr) + not_stable = not (isStableUnfolding (idUnfolding bndr)) ----------------- occAnalRecBind :: OccEnv -> TopLevelFlag -> ImpRuleEdges -> [(Var,CoreExpr)] @@ -866,8 +899,8 @@ occAnalRec env lvl (CyclicSCC details_s) (body_uds, binds) | otherwise -- At this point we always build a single Rec = -- pprTrace "occAnalRec" (vcat - -- [ text "weak_fvs" <+> ppr weak_fvs - -- , text "lb nodes" <+> ppr loop_breaker_nodes]) + -- [ text "weak_fvs" <+> ppr weak_fvs + -- , text "lb nodes" <+> ppr loop_breaker_nodes]) (final_uds, Rec pairs : binds) where @@ -931,10 +964,10 @@ recording inlinings for any Ids which aren't marked as "no-inline" as it goes. -- Return the bindings sorted into a plausible order, and marked with loop breakers. loopBreakNodes depth bndr_set weak_fvs nodes binds = -- pprTrace "loopBreakNodes" (ppr nodes) $ - go (stronglyConnCompFromEdgedVerticesUniqR nodes) binds + go (stronglyConnCompFromEdgedVerticesUniqR nodes) where - go [] binds = binds - go (scc:sccs) binds = loop_break_scc scc (go sccs binds) + go [] = binds + go (scc:sccs) = loop_break_scc scc (go sccs) loop_break_scc scc binds = case scc of @@ -949,7 +982,7 @@ reOrderNodes _ _ _ [] _ = panic "reOrderNodes" reOrderNodes _ _ _ [node] binds = mk_loop_breaker node : binds reOrderNodes depth bndr_set weak_fvs (node : nodes) binds = -- pprTrace "reOrderNodes" (vcat [ text "unchosen" <+> ppr unchosen - -- , text "chosen" <+> ppr chosen_nodes ]) $ + -- , text "chosen" <+> ppr chosen_nodes ]) $ loopBreakNodes new_depth bndr_set weak_fvs unchosen $ (map mk_loop_breaker chosen_nodes ++ binds) where @@ -1148,7 +1181,9 @@ type LetrecNode = Node Unique Details -- Node comes from Digraph -- The Unique key is gotten from the Id data Details = ND { nd_bndr :: Id -- Binder + , nd_rhs :: CoreExpr -- RHS, already occ-analysed + , nd_rhs_bndrs :: [CoreBndr] -- Outer lambdas of RHS -- INVARIANT: (nd_rhs_bndrs nd, _) == -- collectBinders (nd_rhs nd) @@ -1205,7 +1240,7 @@ makeNode env imp_rule_edges bndr_set (bndr, rhs) -- is still deterministic with edges in nondeterministic order as -- explained in Note [Deterministic SCC] in Digraph. where - details = ND { nd_bndr = bndr + details = ND { nd_bndr = bndr' , nd_rhs = rhs' , nd_rhs_bndrs = bndrs' , nd_uds = rhs_usage3 @@ -1214,24 +1249,35 @@ makeNode env imp_rule_edges bndr_set (bndr, rhs) , nd_active_rule_fvs = active_rule_fvs , nd_score = pprPanic "makeNodeDetails" (ppr bndr) } + bndr' = bndr `setIdUnfolding` unf' + `setIdSpecialisation` mkRuleInfo rules' + + -- Get join point info from the *current* decision + -- We don't know what the new decision will be! + -- Using the old decision at least allows us to + -- preserve existing join point, even RULEs are added + -- See Note [Join points and unfoldings/rules] + mb_join_arity = isJoinId_maybe bndr + -- Constructing the edges for the main Rec computation -- See Note [Forming Rec groups] (bndrs, body) = collectBinders rhs - (rhs_usage1, bndrs', body') = occAnalRecRhs env bndrs body - rhs' = mkLams bndrs' body' - rhs_usage2 = foldr andUDs rhs_usage1 rule_uds + rhs_env = rhsCtxt env + (rhs_usage1, bndrs', body') = occAnalLamOrRhs rhs_env bndrs body + rhs' = mkLams bndrs' body' + rhs_usage3 = foldr andUDs rhs_usage1 rule_uds + `andUDs` unf_uds -- Note [Rules are extra RHSs] -- Note [Rule dependency info] - rhs_usage3 = case mb_unf_uds of - Just unf_uds -> rhs_usage2 `andUDs` unf_uds - Nothing -> rhs_usage2 - node_fvs = udFreeVars bndr_set rhs_usage3 + node_fvs = udFreeVars bndr_set rhs_usage3 -- Finding the free variables of the rules is_active = occ_rule_act env :: Activation -> Bool rules_w_uds :: [(CoreRule, UsageDetails, UsageDetails)] - rules_w_uds = occAnalRules env (Just (length bndrs)) Recursive bndr + rules_w_uds = occAnalRules rhs_env mb_join_arity bndr + + rules' = map fstOf3 rules_w_uds rules_w_rhs_fvs :: [(Activation, VarSet)] -- Find the RHS fvs rules_w_rhs_fvs = maybe id (\ids -> ((AlwaysActive, ids):)) @@ -1244,16 +1290,20 @@ makeNode env imp_rule_edges bndr_set (bndr, rhs) , is_active a] -- Finding the usage details of the INLINE pragma (if any) - mb_unf_uds = occAnalUnfolding env Recursive bndr + unf = realIdUnfolding bndr -- realIdUnfolding: Ignore loop-breaker-ness + -- here because that is what we are setting! + (unf_uds, unf') = occAnalUnfolding rhs_env mb_join_arity unf -- Find the "nd_inl" free vars; for the loop-breaker phase - inl_fvs = case mb_unf_uds of - Nothing -> udFreeVars bndr_set rhs_usage1 -- No INLINE, use RHS - Just unf_uds -> udFreeVars bndr_set unf_uds - -- We could check for an *active* INLINE (returning - -- emptyVarSet for an inactive one), but is_active - -- isn't the right thing (it tells about - -- RULE activation), so we'd need more plumbing + -- These are the vars that would become free if the function + -- was inlinined; usually that means the RHS, unless the + -- unfolding is a stable one. + -- Note: We could do this only for functions with an *active* unfolding + -- (returning emptyVarSet for an inactive one), but is_active + -- isn't the right thing (it tells about RULE activation), + -- so we'd need more plumbing + inl_fvs | isStableUnfolding unf = udFreeVars bndr_set unf_uds + | otherwise = udFreeVars bndr_set rhs_usage1 mkLoopBreakerNodes :: OccEnv -> TopLevelFlag -> VarSet @@ -1271,22 +1321,24 @@ mkLoopBreakerNodes :: OccEnv -> TopLevelFlag mkLoopBreakerNodes env lvl bndr_set body_uds details_s = (final_uds, zipWith mk_lb_node details_s bndrs') where - (final_uds, bndrs') = tagRecBinders lvl body_uds - [ ((nd_bndr nd) - ,(nd_uds nd) - ,(nd_rhs_bndrs nd)) - | nd <- details_s ] - mk_lb_node nd@(ND { nd_bndr = bndr, nd_rhs = rhs, nd_inl = inl_fvs }) bndr' - = DigraphNode nd' (varUnique bndr) (nonDetKeysUniqSet lb_deps) + (final_uds, bndrs') + = tagRecBinders lvl body_uds + [ (bndr, uds, rhs_bndrs) + | ND { nd_bndr = bndr, nd_uds = uds, nd_rhs_bndrs = rhs_bndrs } + <- details_s ] + + mk_lb_node nd@(ND { nd_bndr = old_bndr, nd_inl = inl_fvs }) new_bndr + = DigraphNode nd' (varUnique old_bndr) (nonDetKeysUniqSet lb_deps) -- It's OK to use nonDetKeysUniqSet here as -- stronglyConnCompFromEdgedVerticesR is still deterministic with edges -- in nondeterministic order as explained in -- Note [Deterministic SCC] in Digraph. where - nd' = nd { nd_bndr = bndr', nd_score = score } - score = nodeScore env bndr bndr' rhs lb_deps + nd' = nd { nd_bndr = new_bndr, nd_score = score } + score = nodeScore env new_bndr lb_deps nd lb_deps = extendFvs_ rule_fv_env inl_fvs + rule_fv_env :: IdEnv IdSet -- Maps a variable f to the variables from this group -- mentioned in RHS of active rules for f @@ -1301,12 +1353,13 @@ mkLoopBreakerNodes env lvl bndr_set body_uds details_s ------------------------------------------ nodeScore :: OccEnv - -> Id -- Binder has old occ-info (just for loop-breaker-ness) -> Id -- Binder with new occ-info - -> CoreExpr -- RHS -> VarSet -- Loop-breaker dependencies + -> Details -> NodeScore -nodeScore env old_bndr new_bndr bind_rhs lb_deps +nodeScore env new_bndr lb_deps + (ND { nd_bndr = old_bndr, nd_rhs = bind_rhs }) + | not (isId old_bndr) -- A type or coercion variable is never a loop breaker = (100, 0, False) @@ -1324,7 +1377,7 @@ nodeScore env old_bndr new_bndr bind_rhs lb_deps -- where df is the exported dictionary. Then df makes a really -- bad choice for loop breaker - | DFunUnfolding { df_args = args } <- id_unfolding + | DFunUnfolding { df_args = args } <- old_unf -- Never choose a DFun as a loop breaker -- Note [DFuns should not be loop breakers] = (9, length args, is_lb) @@ -1332,13 +1385,13 @@ nodeScore env old_bndr new_bndr bind_rhs lb_deps -- Data structures are more important than INLINE pragmas -- so that dictionary/method recursion unravels - | CoreUnfolding { uf_guidance = UnfWhen {} } <- id_unfolding + | CoreUnfolding { uf_guidance = UnfWhen {} } <- old_unf = mk_score 6 | is_con_app rhs -- Data types help with cases: = mk_score 5 -- Note [Constructor applications] - | isStableUnfolding id_unfolding + | isStableUnfolding old_unf , can_unfold = mk_score 3 @@ -1355,23 +1408,23 @@ nodeScore env old_bndr new_bndr bind_rhs lb_deps mk_score :: Int -> NodeScore mk_score rank = (rank, rhs_size, is_lb) - is_lb = isStrongLoopBreaker (idOccInfo old_bndr) - rhs = case id_unfolding of - CoreUnfolding { uf_src = src, uf_tmpl = unf_rhs } - | isStableSource src - -> unf_rhs - _ -> bind_rhs + -- is_lb: see Note [Loop breakers, node scoring, and stability] + is_lb = isStrongLoopBreaker (idOccInfo old_bndr) + + old_unf = realIdUnfolding old_bndr + can_unfold = canUnfold old_unf + rhs = case old_unf of + CoreUnfolding { uf_src = src, uf_tmpl = unf_rhs } + | isStableSource src + -> unf_rhs + _ -> bind_rhs -- 'bind_rhs' is irrelevant for inlining things with a stable unfolding - rhs_size = case id_unfolding of + rhs_size = case old_unf of CoreUnfolding { uf_guidance = guidance } | UnfIfGoodArgs { ug_size = size } <- guidance -> size _ -> cheapExprSize rhs - can_unfold = canUnfold id_unfolding - id_unfolding = realIdUnfolding old_bndr - -- realIdUnfolding: Ignore loop-breaker-ness here because - -- that is what we are setting! -- Checking for a constructor application -- Cheap and cheerful; the simplifier moves casts out of the way @@ -1508,108 +1561,84 @@ Hence the is_lb field of NodeScore ************************************************************************ -} -occAnalRhs :: OccEnv -> RecFlag -> Id -> [CoreBndr] -> CoreExpr - -> (UsageDetails, [CoreBndr], CoreExpr) - -- Returned usage details covers only the RHS, - -- and *not* the RULE or INLINE template for the Id -occAnalRhs env Recursive _ bndrs body - = occAnalRecRhs env bndrs body -occAnalRhs env NonRecursive id bndrs body - = occAnalNonRecRhs env id bndrs body - -occAnalRecRhs :: OccEnv -> [CoreBndr] -> CoreExpr -- Rhs lambdas, body - -> (UsageDetails, [CoreBndr], CoreExpr) - -- Returned usage details covers only the RHS, - -- and *not* the RULE or INLINE template for the Id -occAnalRecRhs env bndrs body = occAnalLamOrRhs (rhsCtxt env) bndrs body - -occAnalNonRecRhs :: OccEnv - -> Id -> [CoreBndr] -> CoreExpr -- Binder; rhs lams, body - -- Binder is already tagged with occurrence info - -> (UsageDetails, [CoreBndr], CoreExpr) - -- Returned usage details covers only the RHS, - -- and *not* the RULE or INLINE template for the Id -occAnalNonRecRhs env bndr bndrs body - = occAnalLamOrRhs rhs_env bndrs body +occAnalRhs :: OccEnv -> Maybe JoinArity + -> CoreExpr -- RHS + -> (UsageDetails, CoreExpr) +occAnalRhs env mb_join_arity rhs + = (rhs_usage, rhs') where - env1 | is_join_point = env -- See Note [Join point RHSs] - | certainly_inline = env -- See Note [Cascading inlines] - | otherwise = rhsCtxt env - - -- See Note [Sources of one-shot information] - rhs_env = env1 { occ_one_shots = argOneShots dmd } - - certainly_inline -- See Note [Cascading inlines] - = case occ of - OneOcc { occ_in_lam = NotInsideLam, occ_one_br = InOneBranch } - -> active && not_stable - _ -> False - - is_join_point = isAlwaysTailCalled occ - -- Like (isJoinId bndr) but happens one step earlier - -- c.f. willBeJoinId_maybe + (bndrs, body) = collectBinders rhs + (body_usage, bndrs', body') = occAnalLamOrRhs env bndrs body + rhs' = mkLams (markJoinOneShots mb_join_arity bndrs') body' + -- For a /non-recursive/ join point we can mark all + -- its join-lambda as one-shot; and it's a good idea to do so - occ = idOccInfo bndr - dmd = idDemandInfo bndr - active = isAlwaysActive (idInlineActivation bndr) - not_stable = not (isStableUnfolding (idUnfolding bndr)) + -- Final adjustment + rhs_usage = adjustRhsUsage mb_join_arity NonRecursive bndrs' body_usage occAnalUnfolding :: OccEnv - -> RecFlag - -> Id - -> Maybe UsageDetails - -- Just the analysis, not a new unfolding. The unfolding - -- got analysed when it was created and we don't need to - -- update it. -occAnalUnfolding env rec_flag id - = case realIdUnfolding id of -- ignore previous loop-breaker flag - CoreUnfolding { uf_tmpl = rhs, uf_src = src } - | not (isStableSource src) - -> Nothing - | otherwise - -> Just $ markAllMany usage + -> Maybe JoinArity -- See Note [Join points and unfoldings/rules] + -> Unfolding + -> (UsageDetails, Unfolding) +-- Occurrence-analyse a stable unfolding; +-- discard a non-stable one altogether. +occAnalUnfolding env mb_join_arity unf + = case unf of + unf@(CoreUnfolding { uf_tmpl = rhs, uf_src = src }) + | isStableSource src -> (usage, unf') + | otherwise -> (emptyDetails, unf) + where -- For non-Stable unfoldings we leave them undisturbed, but + -- don't count their usage because the simplifier will discard them. + -- We leave them undisturbed because nodeScore uses their size info + -- to guide its decisions. It's ok to leave un-substituted + -- expressions in the tree because all the variables that were in + -- scope remain in scope; there is no cloning etc. + (usage, rhs') = occAnalRhs env mb_join_arity rhs + + unf' | noBinderSwaps env = unf -- Note [Unfoldings and rules] + | otherwise = unf { uf_tmpl = rhs' } + + unf@(DFunUnfolding { df_bndrs = bndrs, df_args = args }) + -> ( final_usage, unf { df_args = args' } ) where - (bndrs, body) = collectBinders rhs - (usage, _, _) = occAnalRhs env rec_flag id bndrs body + env' = env `addInScope` bndrs + (usage, args') = occAnalList env' args + final_usage = zapDetails (delDetailsList usage bndrs) - DFunUnfolding { df_bndrs = bndrs, df_args = args } - -> Just $ zapDetails (delDetailsList usage bndrs) - where - usage = andUDsList (map (fst . occAnal env) args) - - _ -> Nothing + unf -> (emptyDetails, unf) occAnalRules :: OccEnv - -> Maybe JoinArity -- If the binder is (or MAY become) a join - -- point, what its join arity is (or WOULD - -- become). See Note [Rules and join points]. - -> RecFlag - -> Id + -> Maybe JoinArity -- See Note [Join points and unfoldings/rules] + -> Id -- Get rules from here -> [(CoreRule, -- Each (non-built-in) rule UsageDetails, -- Usage details for LHS UsageDetails)] -- Usage details for RHS -occAnalRules env mb_expected_join_arity rec_flag id - = [ (rule, lhs_uds, rhs_uds) | rule at Rule {} <- idCoreRules id - , let (lhs_uds, rhs_uds) = occ_anal_rule rule ] +occAnalRules env mb_join_arity bndr + = map occ_anal_rule (idCoreRules bndr) where - occ_anal_rule (Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs }) - = (lhs_uds, final_rhs_uds) + occ_anal_rule rule@(Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs }) + = (rule', lhs_uds', rhs_uds') where - lhs_uds = addManyOccsSet emptyDetails $ - (exprsFreeVars args `delVarSetList` bndrs) - (rhs_bndrs, rhs_body) = collectBinders rhs - (rhs_uds, _, _) = occAnalRhs env rec_flag id rhs_bndrs rhs_body + env' = env `addInScope` bndrs + rule' | noBinderSwaps env = rule -- Note [Unfoldings and rules] + | otherwise = rule { ru_args = args', ru_rhs = rhs' } + + (lhs_uds, args') = occAnalList env' args + lhs_uds' = markAllMany $ + lhs_uds `delDetailsList` bndrs + + (rhs_uds, rhs') = occAnal env' rhs -- Note [Rules are extra RHSs] -- Note [Rule dependency info] - final_rhs_uds = adjust_tail_info args $ markAllMany $ - (rhs_uds `delDetailsList` bndrs) - occ_anal_rule _ - = (emptyDetails, emptyDetails) - - adjust_tail_info args uds -- see Note [Rules and join points] - = case mb_expected_join_arity of - Just ar | args `lengthIs` ar -> uds - _ -> markAllNonTailCalled uds + rhs_uds' = markAllNonTailCalledIf (not exact_join) $ + markAllMany $ + rhs_uds `delDetailsList` bndrs + + exact_join = exactJoin mb_join_arity args + -- See Note [Join points and unfoldings/rules] + + occ_anal_rule other_rule = (other_rule, emptyDetails, emptyDetails) + {- Note [Join point RHSs] ~~~~~~~~~~~~~~~~~~~~~~~~~ Consider @@ -1622,6 +1651,19 @@ the FloatIn pass knows to float into join point RHSs; and the simplifier does not float things out of join point RHSs. But it's a simple, cheap thing to do. See #14137. +Note [Unfoldings and rules] +~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Generally unfoldings and rules are already occurrence-analysed, so we +don't want to reconstruct their trees; we just want to analyse them to +find how they use their free variables. + +EXCEPT if there is a binder-swap going on, in which case we do want to +produce a new tree. + +So we have a fast-path that keeps the old tree if the occ_bs_env is +empty. This just saves a bit of allocation and reconstruction; not +a big deal. + Note [Cascading inlines] ~~~~~~~~~~~~~~~~~~~~~~~~ By default we use an rhsCtxt for the RHS of a binding. This tells the @@ -1674,6 +1716,12 @@ for the various clauses. ************************************************************************ -} +occAnalList :: OccEnv -> [CoreExpr] -> (UsageDetails, [CoreExpr]) +occAnalList _ [] = (emptyDetails, []) +occAnalList env (e:es) = case occAnal env e of { (uds1, e') -> + case occAnalList env es of { (uds2, es') -> + (uds1 `andUDs` uds2, e' : es') } } + occAnal :: OccEnv -> CoreExpr -> (UsageDetails, -- Gives info only about the "interesting" Ids @@ -1690,7 +1738,7 @@ occAnal env expr@(Var _) = occAnalApp env (expr, [], []) -- weren't used at all. occAnal _ (Coercion co) - = (addManyOccsSet emptyDetails (coVarsOfCo co), Coercion co) + = (addManyOccs emptyDetails (coVarsOfCo co), Coercion co) -- See Note [Gather occurrences of coercion variables] {- @@ -1711,7 +1759,7 @@ occAnal env (Tick tickish body) = (markAllNonTailCalled usage, Tick tickish body') | Breakpoint _ ids <- tickish - = (usage_lam `andUDs` foldr addManyOccs emptyDetails ids, Tick tickish body') + = (usage_lam `andUDs` foldr addManyOcc emptyDetails ids, Tick tickish body') -- never substitute for any of the Ids in a Breakpoint | otherwise @@ -1734,7 +1782,7 @@ occAnal env (Cast expr co) -- usage1: if we see let x = y `cast` co -- then mark y as 'Many' so that we don't -- immediately inline y again. - usage2 = addManyOccsSet usage1 (coVarsOfCo co) + usage2 = addManyOccs usage1 (coVarsOfCo co) -- usage2: see Note [Gather occurrences of coercion variables] in (markAllNonTailCalled usage2, Cast expr' co) } @@ -1762,21 +1810,23 @@ occAnal env (Lam x body) -- Then, the simplifier is careful when partially applying lambdas. occAnal env expr@(Lam _ _) - = case occAnalLamOrRhs env binders body of { (usage, tagged_binders, body') -> + = case occAnalLamOrRhs env bndrs body of { (usage, tagged_bndrs, body') -> let - expr' = mkLams tagged_binders body' + expr' = mkLams tagged_bndrs body' usage1 = markAllNonTailCalled usage - one_shot_gp = all isOneShotBndr tagged_binders - final_usage | one_shot_gp = usage1 - | otherwise = markAllInsideLam usage1 + one_shot_gp = all isOneShotBndr tagged_bndrs + final_usage = markAllInsideLamIf (not one_shot_gp) usage1 in (final_usage, expr') } where - (binders, body) = collectBinders expr + (bndrs, body) = collectBinders expr occAnal env (Case scrut bndr ty alts) - = case occ_anal_scrut scrut alts of { (scrut_usage, scrut') -> - case mapAndUnzip occ_anal_alt alts of { (alts_usage_s, alts') -> + = case occAnal (scrutCtxt env alts) scrut of { (scrut_usage, scrut') -> + let alt_env = addBndrSwap scrut' bndr $ + env { occ_encl = OccVanilla } `addInScope` [bndr] + in + case mapAndUnzip (occAnalAlt alt_env) alts of { (alts_usage_s, alts') -> let alts_usage = foldr orUDs emptyDetails alts_usage_s (alts_usage1, tagged_bndr) = tagLamBinder alts_usage bndr @@ -1784,27 +1834,10 @@ occAnal env (Case scrut bndr ty alts) -- Alts can have tail calls, but the scrutinee can't in total_usage `seq` (total_usage, Case scrut' tagged_bndr ty alts') }} - where - alt_env = mkAltEnv env scrut bndr - occ_anal_alt = occAnalAlt alt_env - - occ_anal_scrut (Var v) (alt1 : other_alts) - | not (null other_alts) || not (isDefaultAlt alt1) - = (mkOneOcc env v IsInteresting 0, Var v) - -- The 'True' says that the variable occurs in an interesting - -- context; the case has at least one non-default alternative - occ_anal_scrut (Tick t e) alts - | t `tickishScopesLike` SoftScope - -- No reason to not look through all ticks here, but only - -- for soft-scoped ticks we can do so without having to - -- update returned occurrence info (see occAnal) - = second (Tick t) $ occ_anal_scrut e alts - - occ_anal_scrut scrut _alts - = occAnal (vanillaCtxt env) scrut -- No need for rhsCtxt occAnal env (Let bind body) - = case occAnal env body of { (body_usage, body') -> + = case occAnal (env `addInScope` bindersOf bind) + body of { (body_usage, body') -> case occAnalBind env NotTopLevel noImpRuleEdges bind body_usage of { (final_usage, new_binds) -> @@ -1845,17 +1878,22 @@ Constructors are rather like lambdas in this way. occAnalApp :: OccEnv -> (Expr CoreBndr, [Arg CoreBndr], [Tickish Id]) -> (UsageDetails, Expr CoreBndr) +-- Naked variables (not applied) end up here too occAnalApp env (Var fun, args, ticks) - | null ticks = (uds, mkApps (Var fun) args') - | otherwise = (uds, mkTicks ticks $ mkApps (Var fun) args') + | null ticks = (all_uds, mkApps fun' args') + | otherwise = (all_uds, mkTicks ticks $ mkApps fun' args') where - uds = fun_uds `andUDs` final_args_uds + (fun', fun_id') = lookupVarEnv (occ_bs_env env) fun + `orElse` (Var fun, fun) + -- See Note [The binder-swap substitution] + + 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 - !final_args_uds - | isRhsEnv env && is_exp = markAllNonTailCalled $ - markAllInsideLam args_uds - | otherwise = markAllNonTailCalled args_uds + !final_args_uds = markAllNonTailCalled $ + markAllInsideLamIf (isRhsEnv env && is_exp) $ + args_uds -- We mark the free vars of the argument of a constructor or PAP -- as "inside-lambda", if it is the RHS of a let(rec). -- This means that nothing gets inlined into a constructor or PAP @@ -1868,7 +1906,11 @@ occAnalApp env (Var fun, args, ticks) n_val_args = valArgCount args n_args = length args - fun_uds = mkOneOcc env fun (if n_val_args > 0 then IsInteresting else NotInteresting) n_args + int_cxt = case occ_encl env of + OccScrut -> IsInteresting + _other | n_val_args > 0 -> IsInteresting + | otherwise -> NotInteresting + is_exp = isExpandableApp fun n_val_args -- See Note [CONLIKE pragma] in BasicTypes -- The definition of is_exp should match that in GHC.Core.Op.Simplify.prepareRhs @@ -1891,11 +1933,6 @@ occAnalApp env (fun, args, ticks) -- onto the context stack. !(args_uds, args') = occAnalArgs env args [] -zapDetailsIf :: Bool -- If this is true - -> UsageDetails -- Then do zapDetails on this - -> UsageDetails -zapDetailsIf True uds = zapDetails uds -zapDetailsIf False uds = uds {- Note [Sources of one-shot information] @@ -1987,9 +2024,12 @@ scrutinised y). occAnalLamOrRhs :: OccEnv -> [CoreBndr] -> CoreExpr -> (UsageDetails, [CoreBndr], CoreExpr) +-- Tags the returned binders with their OccInfo, but does +-- not do any markInsideLam to the returned usage details occAnalLamOrRhs env [] body = case occAnal env body of (body_usage, body') -> (body_usage, [], body') -- RHS of thunk or nullary join point + occAnalLamOrRhs env (bndr:bndrs) body | isTyVar bndr = -- Important: Keep the environment so that we don't inline into an RHS like @@ -1997,6 +2037,7 @@ occAnalLamOrRhs env (bndr:bndrs) body -- (see the beginning of Note [Cascading inlines]). case occAnalLamOrRhs env bndrs body of (body_usage, bndrs', body') -> (body_usage, bndr:bndrs', body') + occAnalLamOrRhs env binders body = case occAnal env_body body of { (body_usage, body') -> let @@ -2005,47 +2046,17 @@ occAnalLamOrRhs env binders body in (final_usage, tagged_binders, body') } where - (env_body, binders') = oneShotGroup env binders + env1 = env `addInScope` binders + (env_body, binders') = oneShotGroup env1 binders -occAnalAlt :: (OccEnv, Maybe (Id, CoreExpr)) - -> CoreAlt - -> (UsageDetails, Alt IdWithOccInfo) -occAnalAlt (env, scrut_bind) (con, bndrs, rhs) - = case occAnal env rhs of { (rhs_usage1, rhs1) -> +occAnalAlt :: OccEnv -> CoreAlt -> (UsageDetails, Alt IdWithOccInfo) +occAnalAlt env (con, bndrs, rhs) + = case occAnal (env `addInScope` bndrs) rhs of { (rhs_usage1, rhs1) -> let (alt_usg, tagged_bndrs) = tagLamBinders rhs_usage1 bndrs - -- See Note [Binders in case alternatives] - (alt_usg', rhs2) = wrapAltRHS env scrut_bind alt_usg tagged_bndrs rhs1 - in - (alt_usg', (con, tagged_bndrs, rhs2)) } - -wrapAltRHS :: OccEnv - -> Maybe (Id, CoreExpr) -- proxy mapping generated by mkAltEnv - -> UsageDetails -- usage for entire alt (p -> rhs) - -> [Var] -- alt binders - -> CoreExpr -- alt RHS - -> (UsageDetails, CoreExpr) -wrapAltRHS env (Just (scrut_var, let_rhs)) alt_usg bndrs alt_rhs - | occ_binder_swap env - , scrut_var `usedIn` alt_usg -- bndrs are not be present in alt_usg so this - -- handles condition (a) in Note [Binder swap] - , not captured -- See condition (b) in Note [Binder swap] - = ( alt_usg' `andUDs` let_rhs_usg - , Let (NonRec tagged_scrut_var let_rhs') alt_rhs ) - where - captured = any (`usedIn` let_rhs_usg) bndrs -- Check condition (b) - - -- The rhs of the let may include coercion variables - -- if the scrutinee was a cast, so we must gather their - -- usage. See Note [Gather occurrences of coercion variables] - -- Moreover, the rhs of the let may mention the case-binder, and - -- we want to gather its occ-info as well - (let_rhs_usg, let_rhs') = occAnal env let_rhs - - (alt_usg', tagged_scrut_var) = tagLamBinder alt_usg scrut_var + in -- See Note [Binders in case alternatives] + (alt_usg, (con, tagged_bndrs, rhs1)) } -wrapAltRHS _ _ alt_usg _ alt_rhs - = (alt_usg, alt_rhs) {- ************************************************************************ @@ -2058,18 +2069,17 @@ wrapAltRHS _ _ alt_usg _ alt_rhs data OccEnv = OccEnv { occ_encl :: !OccEncl -- Enclosing context information , occ_one_shots :: !OneShots -- See Note [OneShots] - , occ_gbl_scrut :: GlobalScruts - - , occ_unf_act :: Id -> Bool -- Which Id unfoldings are active - - , occ_rule_act :: Activation -> Bool -- Which rules are active + , 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] - , occ_binder_swap :: !Bool -- enable the binder_swap - -- See CorePrep Note [Dead code in CorePrep] + -- 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 } -type GlobalScruts = IdSet -- See Note [Binder swap on GlobalId scrutinees] ----------------------------- -- OccEncl is used to control whether to inline into constructor arguments @@ -2079,15 +2089,22 @@ type GlobalScruts = IdSet -- See Note [Binder swap on GlobalId scrutinees] -- z = f (p,q) -- Do inline p,q; it may make a rule fire -- So OccEncl tells enough about the context to know what to do when -- we encounter a constructor application or PAP. +-- +-- OccScrut is used to set the "interesting context" field of OncOcc data OccEncl - = OccRhs -- RHS of let(rec), albeit perhaps inside a type lambda - -- Don't inline into constructor args here - | OccVanilla -- Argument of function, body of lambda, scruintee of case etc. - -- Do inline into constructor args here + = OccRhs -- RHS of let(rec), albeit perhaps inside a type lambda + -- Don't inline into constructor args here + + | OccScrut -- Scrutintee of a case + -- Can inline into constructor args + + | OccVanilla -- Argument of function, body of lambda, etc + -- Do inline into constructor args here instance Outputable OccEncl where ppr OccRhs = text "occRhs" + ppr OccScrut = text "occScrut" ppr OccVanilla = text "occVanilla" -- See note [OneShots] @@ -2097,15 +2114,30 @@ initOccEnv :: OccEnv initOccEnv = OccEnv { occ_encl = OccVanilla , occ_one_shots = [] - , occ_gbl_scrut = emptyVarSet + -- To be conservative, we say that all -- inlines and rules are active , occ_unf_act = \_ -> True , occ_rule_act = \_ -> True - , occ_binder_swap = True } -vanillaCtxt :: OccEnv -> OccEnv -vanillaCtxt env = env { occ_encl = OccVanilla, occ_one_shots = [] } + , occ_bs_env = emptyVarEnv + , occ_bs_rng = emptyVarSet } + +noBinderSwaps :: OccEnv -> Bool +noBinderSwaps (OccEnv { occ_bs_env = bs_env }) = isEmptyVarEnv bs_env + +scrutCtxt :: OccEnv -> [CoreAlt] -> OccEnv +scrutCtxt env alts + | interesting_alts = env { occ_encl = OccScrut, occ_one_shots = [] } + | otherwise = env { occ_encl = OccVanilla, occ_one_shots = [] } + where + interesting_alts = case alts of + [] -> False + [alt] -> not (isDefaultAlt alt) + _ -> True + -- 'interesting_alts' is True if the case has at least one + -- non-default alternative. That in turn influences + -- pre/postInlineUnconditionally. Grep for "occ_int_cxt"! rhsCtxt :: OccEnv -> OccEnv rhsCtxt env = env { occ_encl = OccRhs, occ_one_shots = [] } @@ -2117,8 +2149,15 @@ argCtxt env (one_shots:one_shots_s) = (env { occ_encl = OccVanilla, occ_one_shots = one_shots }, one_shots_s) isRhsEnv :: OccEnv -> Bool -isRhsEnv (OccEnv { occ_encl = OccRhs }) = True -isRhsEnv (OccEnv { occ_encl = OccVanilla }) = False +isRhsEnv (OccEnv { occ_encl = cxt }) = case cxt of + OccRhs -> True + _ -> False + +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_bs_rng = emptyVarSet } + | otherwise = env { occ_bs_env = swap_env `delVarEnvList` bndrs } oneShotGroup :: OccEnv -> [CoreBndr] -> ( OccEnv @@ -2222,14 +2261,14 @@ scrutinee of a case for occurrences of the case-binder: (1) case x of b { pi -> ri } ==> - case x of b { pi -> let x=b in ri } + case x of b { pi -> ri[b/x] } (2) case (x |> co) of b { pi -> ri } ==> - case (x |> co) of b { pi -> let x = b |> sym co in ri } + case (x |> co) of b { pi -> ri[b |> sym co/x] } -In both cases, the trivial 'let' can be eliminated by the -immediately following simplifier pass. +The substitution ri[b/x] etc is done by the occurrence analyser. +See Note [The binder-swap substitution]. There are two reasons for making this swap: @@ -2257,20 +2296,6 @@ There are two reasons for making this swap: The same can happen even if the scrutinee is a variable with a cast: see Note [Case of cast] -In both cases, in a particular alternative (pi -> ri), we only -add the binding if - (a) x occurs free in (pi -> ri) - (ie it occurs in ri, but is not bound in pi) - (b) the pi does not bind b (or the free vars of co) -We need (a) and (b) for the inserted binding to be correct. - -For the alternatives where we inject the binding, we can transfer -all x's OccInfo to b. And that is the point. - -Notice that - * The deliberate shadowing of 'x'. - * That (a) rapidly becomes false, so no bindings are injected. - The reason for doing these transformations /here in the occurrence analyser/ is because it allows us to adjust the OccInfo for 'x' and 'b' as we go. @@ -2279,15 +2304,9 @@ analyser/ is because it allows us to adjust the OccInfo for 'x' and ri; then this transformation makes it occur just once, and hence get inlined right away. - * If instead we do this in the Simplifier, we don't know whether 'x' - is used in ri, so we are forced to pessimistically zap b's OccInfo - even though it is typically dead (ie neither it nor x appear in - the ri). There's nothing actually wrong with zapping it, except - that it's kind of nice to know which variables are dead. My nose - tells me to keep this information as robustly as possible. - -The Maybe (Id,CoreExpr) passed to occAnalAlt is the extra let-binding -{x=b}; it's Nothing if the binder-swap doesn't happen. + * If instead the Simplifier replaces occurrences of x with + occurrences of b, that will mess up b's occurrence info. That in + turn might have consequences. There is a danger though. Consider let v = x +# y @@ -2299,6 +2318,75 @@ same simplifier pass that reduced (f v) to v. I think this is just too bad. CSE will recover some of it. +Note [The binder-swap substitution] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The binder-swap is implemented by the occ_bs_env field of OccEnv. +Given case x |> co of b { alts } +we add [x :-> (b |> sym co)] to the occ_bs_env environment; this is +done by addBndrSwap. Then, at an occurrence of a variable, we look +up in the occ_bs_env to perform the swap. See occAnalApp. + +Some tricky corners: + +* We do the substitution before gathering occurrence info. So in + the above example, an occurrence of x turns into an occurrence + of b, and that's what we gather in the UsageDetails. It's as + if the binder-swap occurred before occurrence analysis. + +* We need care when shadowing. Suppose [x :-> b] is in occ_bs_env, + and we encounter: + - \x. blah + Here we want to delete the x-binding from occ_bs_env + + - \b. blah + This is harder: we really want to delete all bindings that + have 'b' free in the range. That is a bit tiresome to implement, + so we compromise. We keep occ_bs_rng, which is the set of + free vars of rng(occc_bs_env). If a binder shadows any of these + variables, we discard all of occ_bs_env. Safe, if a bit + brutal. NB, however: the simplifer de-shadows the code, so the + next time around this won't happen. + + These checks are implemented in addInScope. + +* The occurrence analyser itself does /not/ do cloning. It could, in + principle, but it'd make it a bit more complicated and there is no + great benefit. The simplifer uses cloning to get a no-shadowing + situation, the care-when-shadowing behaviour above isn't needed for + long. + +* The domain of occ_bs_env can include GlobaIds. Eg + case M.foo of b { alts } + We extend occ_bs_env with [M.foo :-> b]. That's fine. + +* We have to apply the substitution uniformly, including to rules and + unfoldings. + +Historical note +--------------- +We used to do the binder-swap transformation by introducing +a proxy let-binding, thus; + + case x of b { pi -> ri } + ==> + case x of b { pi -> let x = b in ri } + +But that had two problems: + +1. If 'x' is an imported GlobalId, we'd end up with a GlobalId + on the LHS of a let-binding which isn't allowed. We worked + around this for a while by "localising" x, but it turned + out to be very painful #16296, + +2. In CorePrep we use the occurrence analyser to do dead-code + elimination (see Note [Dead code in CorePrep]). But that + occasionally led to an unlifted let-binding + case x of b { DEFAULT -> let x::Int# = b in ... } + which disobeys one of CorePrep's output invariants (no unlifted + let-bindings) -- see #5433. + +Doing a substitution (via occ_bs_env) is much better. + Note [Case of cast] ~~~~~~~~~~~~~~~~~~~ Consider case (x `cast` co) of b { I# -> @@ -2307,25 +2395,12 @@ We'd like to eliminate the inner case. That is the motivation for equation (2) in Note [Binder swap]. When we get to the inner case, we inline x, cancel the casts, and away we go. -Note [Binder swap on GlobalId scrutinees] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When the scrutinee is a GlobalId we must take care in two ways - - i) In order to *know* whether 'x' occurs free in the RHS, we need its - occurrence info. BUT, we don't gather occurrence info for - GlobalIds. That's the reason for the (small) occ_gbl_scrut env in - OccEnv is for: it says "gather occurrence info for these". - - ii) We must call localiseId on 'x' first, in case it's a GlobalId, or - has an External Name. See, for example, SimplEnv Note [Global Ids in - the substitution]. - Note [Zap case binders in proxy bindings] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ From the original case x of cb(dead) { p -> ...x... } we will get - case x of cb(live) { p -> let x = cb in ...x... } + case x of cb(live) { p -> ...cb... } Core Lint never expects to find an *occurrence* of an Id marked as Dead, so we must zap the OccInfo on cb before making the @@ -2396,37 +2471,25 @@ binder-swap unconditionally and still get occurrence analysis information right. -} -mkAltEnv :: OccEnv -> CoreExpr -> Id -> (OccEnv, Maybe (Id, CoreExpr)) --- Does three things: a) makes the occ_one_shots = OccVanilla --- b) extends the GlobalScruts if possible --- c) returns a proxy mapping, binding the scrutinee --- to the case binder, if possible -mkAltEnv env@(OccEnv { occ_gbl_scrut = pe }) scrut case_bndr - = case stripTicksTopE (const True) scrut of - Var v -> add_scrut v case_bndr' - Cast (Var v) co -> add_scrut v (Cast case_bndr' (mkSymCo co)) - -- See Note [Case of cast] - _ -> (env { occ_encl = OccVanilla }, Nothing) +addBndrSwap :: OutExpr -> Id -> OccEnv -> OccEnv +-- See Note [The binder-swap substitution] +addBndrSwap scrut case_bndr + env@(OccEnv { occ_bs_env = swap_env, occ_bs_rng = rng_vars }) + | Just (v, rhs) <- try_swap (stripTicksTopE (const True) scrut) + = env { occ_bs_env = extendVarEnv swap_env v (rhs, case_bndr') + , occ_bs_rng = rng_vars `unionVarSet` exprFreeVars rhs } + | otherwise + = env where - add_scrut v rhs - | isGlobalId v = (env { occ_encl = OccVanilla }, Nothing) - | otherwise = ( env { occ_encl = OccVanilla - , occ_gbl_scrut = pe `extendVarSet` v } - , Just (localise v, rhs) ) - -- ToDO: this isGlobalId stuff is a TEMPORARY FIX - -- to avoid the binder-swap for GlobalIds - -- See #16346 - - case_bndr' = Var (zapIdOccInfo case_bndr) - -- See Note [Zap case binders in proxy bindings] - - -- Localise the scrut_var before shadowing it; we're making a - -- new binding for it, and it might have an External Name, or - -- even be a GlobalId; Note [Binder swap on GlobalId scrutinees] - -- Also we don't want any INLINE or NOINLINE pragmas! - localise scrut_var = mkLocalIdOrCoVar (localiseName (idName scrut_var)) - (idType scrut_var) + try_swap :: OutExpr -> Maybe (OutVar, OutExpr) + try_swap (Var v) = Just (v, Var case_bndr') + try_swap (Cast (Var v) co) = Just (v, Cast (Var case_bndr') (mkSymCo co)) + -- See Note [Case of cast] + try_swap _ = Nothing + + case_bndr' = zapIdOccInfo case_bndr + -- See Note [Zap case binders in proxy bindings] {- ************************************************************************ @@ -2437,7 +2500,6 @@ mkAltEnv env@(OccEnv { occ_gbl_scrut = pe }) scrut case_bndr Note [UsageDetails and zapping] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - On many occasions, we must modify all gathered occurrence data at once. For instance, all occurrences underneath a (non-one-shot) lambda set the 'occ_in_lam' flag to become 'True'. We could use 'mapVarEnv' to do this, but @@ -2476,45 +2538,36 @@ andUDs, orUDs andUDs = combineUsageDetailsWith addOccInfo orUDs = combineUsageDetailsWith orOccInfo -andUDsList :: [UsageDetails] -> UsageDetails -andUDsList = foldl' andUDs emptyDetails - -mkOneOcc :: OccEnv -> Id -> InterestingCxt -> JoinArity -> UsageDetails -mkOneOcc env id int_cxt arity +mkOneOcc ::Id -> InterestingCxt -> JoinArity -> UsageDetails +mkOneOcc id int_cxt arity | isLocalId id - = singleton $ OneOcc { occ_in_lam = NotInsideLam - , occ_one_br = InOneBranch - , occ_int_cxt = int_cxt - , occ_tail = AlwaysTailCalled arity } - | id `elemVarSet` occ_gbl_scrut env - = singleton noOccInfo - + = emptyDetails { ud_env = unitVarEnv id occ_info } | otherwise = emptyDetails where - singleton info = emptyDetails { ud_env = unitVarEnv id info } - -addOneOcc :: UsageDetails -> Id -> OccInfo -> UsageDetails -addOneOcc ud id info - = ud { ud_env = extendVarEnv_C plus_zapped (ud_env ud) id info } - `alterZappedSets` (`delVarEnv` id) - where - plus_zapped old new = doZapping ud id old `addOccInfo` new + occ_info = OneOcc { occ_in_lam = NotInsideLam + , occ_one_br = InOneBranch + , occ_int_cxt = int_cxt + , occ_tail = AlwaysTailCalled arity } -addManyOccsSet :: UsageDetails -> VarSet -> UsageDetails -addManyOccsSet usage id_set = nonDetFoldUniqSet addManyOccs usage id_set - -- It's OK to use nonDetFoldUFM here because addManyOccs commutes +addManyOccId :: UsageDetails -> Id -> UsageDetails +-- Add the non-committal (id :-> noOccInfo) to the usage details +addManyOccId ud id = ud { ud_env = extendVarEnv (ud_env ud) id noOccInfo } -- Add several occurrences, assumed not to be tail calls -addManyOccs :: Var -> UsageDetails -> UsageDetails -addManyOccs v u | isId v = addOneOcc u v noOccInfo - | otherwise = u +addManyOcc :: Var -> UsageDetails -> UsageDetails +addManyOcc v u | isId v = addManyOccId u v + | otherwise = u -- Give a non-committal binder info (i.e noOccInfo) because -- a) Many copies of the specialised thing can appear -- b) We don't want to substitute a BIG expression inside a RULE -- even if that's the only occurrence of the thing -- (Same goes for INLINE.) +addManyOccs :: UsageDetails -> VarSet -> UsageDetails +addManyOccs usage id_set = nonDetFoldUniqSet addManyOcc usage id_set + -- It's OK to use nonDetFoldUFM here because addManyOcc commutes + delDetails :: UsageDetails -> Id -> UsageDetails delDetails ud bndr = ud `alterUsageDetails` (`delVarEnv` bndr) @@ -2538,8 +2591,23 @@ markAllMany ud = ud { ud_z_many = ud_env ud } markAllInsideLam ud = ud { ud_z_in_lam = ud_env ud } markAllNonTailCalled ud = ud { ud_z_no_tail = ud_env ud } +markAllInsideLamIf, markAllNonTailCalledIf :: Bool -> UsageDetails -> UsageDetails + +markAllInsideLamIf True ud = markAllInsideLam ud +markAllInsideLamIf False ud = ud + +markAllNonTailCalledIf True ud = markAllNonTailCalled ud +markAllNonTailCalledIf False ud = ud + + zapDetails = markAllMany . markAllNonTailCalled -- effectively sets to noOccInfo +zapDetailsIf :: Bool -- If this is true + -> UsageDetails -- Then do zapDetails on this + -> UsageDetails +zapDetailsIf True uds = zapDetails uds +zapDetailsIf False uds = uds + lookupDetails :: UsageDetails -> Id -> OccInfo lookupDetails ud id | isCoVar id -- We do not currently gather occurrence info (from types) @@ -2595,14 +2663,17 @@ doZapping ud var occ = doZappingByUnique ud (varUnique var) occ doZappingByUnique :: UsageDetails -> Unique -> OccInfo -> OccInfo -doZappingByUnique ud uniq - = (if | in_subset ud_z_many -> markMany - | in_subset ud_z_in_lam -> markInsideLam - | otherwise -> id) . - (if | in_subset ud_z_no_tail -> markNonTailCalled - | otherwise -> id) +doZappingByUnique (UD { ud_z_many = many + , ud_z_in_lam = in_lam + , ud_z_no_tail = no_tail }) + uniq occ + = occ2 where - in_subset field = uniq `elemVarEnvByKey` field ud + occ1 | uniq `elemVarEnvByKey` many = markMany occ + | uniq `elemVarEnvByKey` in_lam = markInsideLam occ + | otherwise = occ + occ2 | uniq `elemVarEnvByKey` no_tail = markNonTailCalled occ1 + | otherwise = occ1 alterZappedSets :: UsageDetails -> (ZappedSet -> ZappedSet) -> UsageDetails alterZappedSets ud f @@ -2612,8 +2683,7 @@ alterZappedSets ud f alterUsageDetails :: UsageDetails -> (OccInfoEnv -> OccInfoEnv) -> UsageDetails alterUsageDetails ud f - = ud { ud_env = f (ud_env ud) } - `alterZappedSets` f + = ud { ud_env = f (ud_env ud) } `alterZappedSets` f flattenUsageDetails :: UsageDetails -> UsageDetails flattenUsageDetails ud @@ -2623,25 +2693,26 @@ flattenUsageDetails ud ------------------- -- See Note [Adjusting right-hand sides] adjustRhsUsage :: Maybe JoinArity -> RecFlag - -> [CoreBndr] -- Outer lambdas, AFTER occ anal - -> UsageDetails -> UsageDetails + -> [CoreBndr] -- Outer lambdas, AFTER occ anal + -> UsageDetails -- From body of lambda + -> UsageDetails adjustRhsUsage mb_join_arity rec_flag bndrs usage - = maybe_mark_lam (maybe_drop_tails usage) + = markAllInsideLamIf (not one_shot) $ + markAllNonTailCalledIf (not exact_join) $ + usage where - maybe_mark_lam ud | one_shot = ud - | otherwise = markAllInsideLam ud - maybe_drop_tails ud | exact_join = ud - | otherwise = markAllNonTailCalled ud - one_shot = case mb_join_arity of Just join_arity | isRec rec_flag -> False | otherwise -> all isOneShotBndr (drop join_arity bndrs) Nothing -> all isOneShotBndr bndrs - exact_join = case mb_join_arity of - Just join_arity -> bndrs `lengthIs` join_arity - _ -> False + exact_join = exactJoin mb_join_arity bndrs + +exactJoin :: Maybe JoinArity -> [a] -> Bool +exactJoin Nothing _ = False +exactJoin (Just join_arity) args = args `lengthIs` join_arity + -- Remember join_arity includes type binders type IdWithOccInfo = Id @@ -2668,7 +2739,7 @@ tagLamBinder usage bndr bndr' = setBinderOcc (markNonTailCalled occ) bndr -- Don't try to make an argument into a join point usage1 = usage `delDetails` bndr - usage2 | isId bndr = addManyOccsSet usage1 (idUnfoldingVars bndr) + usage2 | isId bndr = addManyOccs usage1 (idUnfoldingVars bndr) -- This is effectively the RHS of a -- non-join-point binding, so it's okay to use -- addManyOccsSet, which assumes no tail calls ===================================== compiler/GHC/Core/Op/Simplify.hs ===================================== @@ -45,7 +45,8 @@ import GHC.Core.Unfold import GHC.Core.Utils import GHC.Core.SimpleOpt ( pushCoTyArg, pushCoValArg , joinPointBinding_maybe, joinPointBindings_maybe ) -import GHC.Core.Rules ( mkRuleInfo, lookupRule, getRules ) +import GHC.Core.Rules ( lookupRule, getRules ) +import GHC.Core.FVs ( mkRuleInfo ) import BasicTypes ( TopLevelFlag(..), isNotTopLevel, isTopLevel, RecFlag(..), Arity ) import MonadUtils ( mapAccumLM, liftIO ) @@ -1422,7 +1423,7 @@ simplLamBndr :: SimplEnv -> InBndr -> SimplM (SimplEnv, OutBndr) -- fw a b x{=(a,b)} = ... -- The "{=(a,b)}" is an unfolding we can't reconstruct otherwise. simplLamBndr env bndr - | isId bndr && isFragileUnfolding old_unf -- Special case + | isId bndr && hasCoreUnfolding old_unf -- Special case = do { (env1, bndr1) <- simplBinder env bndr ; unf' <- simplStableUnfolding env1 NotTopLevel Nothing bndr old_unf (idType bndr1) @@ -2883,7 +2884,7 @@ the unfolding (a,b), and *that* mentions b. If f has a RULE RULE f (p, I# q) = ... we want that rule to match, so we must extend the in-scope env with a suitable unfolding for 'y'. It's *essential* for rule matching; but -it's also good for case-elimintation -- suppose that 'f' was inlined +it's also good for case-elimination -- suppose that 'f' was inlined and did multi-level case analysis, then we'd solve it in one simplifier sweep instead of two. ===================================== compiler/GHC/Core/Op/Simplify/Utils.hs ===================================== @@ -1872,22 +1872,26 @@ Historical note: if you use let-bindings instead of a substitution, beware of th prepareAlts tries these things: -1. Eliminate alternatives that cannot match, including the - DEFAULT alternative. +1. filterAlts: eliminate alternatives that cannot match, including + the DEFAULT alternative. Here "cannot match" includes knowledge + from GADTs -2. If the DEFAULT alternative can match only one possible constructor, - then make that constructor explicit. +2. refineDefaultAlt: if the DEFAULT alternative can match only one + possible constructor, then make that constructor explicit. e.g. case e of x { DEFAULT -> rhs } ===> case e of x { (a,b) -> rhs } where the type is a single constructor type. This gives better code when rhs also scrutinises x or e. + See CoreUtils Note [Refine DEFAULT case alternatives] -3. Returns a list of the constructors that cannot holds in the - DEFAULT alternative (if there is one) +3. combineIdenticalAlts: combine identical alternatives into a DEFAULT. + See CoreUtils Note [Combine identical alternatives], which also + says why we do this on InAlts not on OutAlts -Here "cannot match" includes knowledge from GADTs +4. Returns a list of the constructors that cannot holds in the + DEFAULT alternative (if there is one) It's a good idea to do this stuff before simplifying the alternatives, to avoid simplifying alternatives we know can't happen, and to come up with ===================================== compiler/GHC/Core/Rules.hs ===================================== @@ -17,7 +17,7 @@ module GHC.Core.Rules ( ruleCheckProgram, -- ** Manipulating 'RuleInfo' rules - mkRuleInfo, extendRuleInfo, addRuleInfo, + extendRuleInfo, addRuleInfo, addIdSpecialisations, -- * Misc. CoreRule helpers @@ -278,11 +278,6 @@ pprRulesForUser dflags 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) - extendRuleInfo :: RuleInfo -> [CoreRule] -> RuleInfo extendRuleInfo (RuleInfo rs1 fvs1) rs2 = RuleInfo (rs2 ++ rs1) (rulesFreeVarsDSet rs2 `unionDVarSet` fvs1) ===================================== compiler/GHC/Core/Subst.hs ===================================== @@ -618,7 +618,7 @@ substIdInfo subst new_id info where old_rules = ruleInfo info old_unf = unfoldingInfo info - nothing_to_do = isEmptyRuleInfo old_rules && not (isFragileUnfolding old_unf) + nothing_to_do = isEmptyRuleInfo old_rules && not (hasCoreUnfolding old_unf) ------------------ -- | Substitutes for the 'Id's within an unfolding ===================================== compiler/GHC/Core/Unfold.hs ===================================== @@ -22,9 +22,9 @@ find, unsurprisingly, a Core expression. module GHC.Core.Unfold ( Unfolding, UnfoldingGuidance, -- Abstract types - noUnfolding, mkImplicitUnfolding, + noUnfolding, mkUnfolding, mkCoreUnfolding, - mkTopUnfolding, mkSimpleUnfolding, mkWorkerUnfolding, + mkFinalUnfolding, mkSimpleUnfolding, mkWorkerUnfolding, mkInlineUnfolding, mkInlineUnfoldingWithArity, mkInlinableUnfolding, mkWwInlineRule, mkCompulsoryUnfolding, mkDFunUnfolding, @@ -48,12 +48,12 @@ import GhcPrelude import GHC.Driver.Session import GHC.Core -import GHC.Core.Op.OccurAnal ( occurAnalyseExpr_NoBinderSwap ) +import GHC.Core.Op.OccurAnal ( occurAnalyseExpr ) import GHC.Core.SimpleOpt import GHC.Core.Arity ( manifestArity ) import GHC.Core.Utils import Id -import Demand ( isBottomingSig ) +import Demand ( StrictSig, isBottomingSig ) import GHC.Core.DataCon import Literal import PrimOp @@ -80,14 +80,22 @@ import Data.List ************************************************************************ -} -mkTopUnfolding :: DynFlags -> Bool -> CoreExpr -> Unfolding -mkTopUnfolding dflags is_bottoming rhs - = mkUnfolding dflags InlineRhs True is_bottoming rhs +mkFinalUnfolding :: DynFlags -> UnfoldingSource -> StrictSig -> CoreExpr -> Unfolding +-- "Final" in the sense that this is a GlobalId that will not be further +-- simplified; so the unfolding should be occurrence-analysed +mkFinalUnfolding dflags src strict_sig expr + = mkUnfolding dflags src + True {- Top level -} + (isBottomingSig strict_sig) + expr + +mkCompulsoryUnfolding :: CoreExpr -> Unfolding +mkCompulsoryUnfolding expr -- Used for things that absolutely must be unfolded + = mkCoreUnfolding InlineCompulsory True + (simpleOptExpr unsafeGlobalDynFlags expr) + (UnfWhen { ug_arity = 0 -- Arity of unfolding doesn't matter + , ug_unsat_ok = unSaturatedOk, ug_boring_ok = boringCxtOk }) -mkImplicitUnfolding :: DynFlags -> CoreExpr -> Unfolding --- For implicit Ids, do a tiny bit of optimising first -mkImplicitUnfolding dflags expr - = mkTopUnfolding dflags False (simpleOptExpr dflags expr) -- Note [Top-level flag on inline rules] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -103,7 +111,7 @@ mkDFunUnfolding :: [Var] -> DataCon -> [CoreExpr] -> Unfolding mkDFunUnfolding bndrs con ops = DFunUnfolding { df_bndrs = bndrs , df_con = con - , df_args = map occurAnalyseExpr_NoBinderSwap ops } + , df_args = map occurAnalyseExpr ops } -- See Note [Occurrence analysis of unfoldings] mkWwInlineRule :: DynFlags -> CoreExpr -> Arity -> Unfolding @@ -113,13 +121,6 @@ mkWwInlineRule dflags expr arity (UnfWhen { ug_arity = arity, ug_unsat_ok = unSaturatedOk , ug_boring_ok = boringCxtNotOk }) -mkCompulsoryUnfolding :: CoreExpr -> Unfolding -mkCompulsoryUnfolding expr -- Used for things that absolutely must be unfolded - = mkCoreUnfolding InlineCompulsory True - (simpleOptExpr unsafeGlobalDynFlags expr) - (UnfWhen { ug_arity = 0 -- Arity of unfolding doesn't matter - , ug_unsat_ok = unSaturatedOk, ug_boring_ok = boringCxtOk }) - mkWorkerUnfolding :: DynFlags -> (CoreExpr -> CoreExpr) -> Unfolding -> Unfolding -- See Note [Worker-wrapper for INLINABLE functions] in GHC.Core.Op.WorkWrap mkWorkerUnfolding dflags work_fn @@ -309,20 +310,6 @@ I'm a bit worried that it's possible for the same kind of problem to arise for non-0-ary functions too, but let's wait and see. -} -mkCoreUnfolding :: UnfoldingSource -> Bool -> CoreExpr - -> UnfoldingGuidance -> Unfolding --- Occurrence-analyses the expression before capturing it -mkCoreUnfolding src top_lvl expr guidance - = CoreUnfolding { uf_tmpl = occurAnalyseExpr_NoBinderSwap expr, - -- See Note [Occurrence analysis of unfoldings] - uf_src = src, - uf_is_top = top_lvl, - uf_is_value = exprIsHNF expr, - uf_is_conlike = exprIsConLike expr, - uf_is_work_free = exprIsWorkFree expr, - uf_expandable = exprIsExpandable expr, - uf_guidance = guidance } - mkUnfolding :: DynFlags -> UnfoldingSource -> Bool -- Is top-level -> Bool -- Definitely a bottoming binding @@ -331,21 +318,28 @@ mkUnfolding :: DynFlags -> UnfoldingSource -> Unfolding -- Calculates unfolding guidance -- Occurrence-analyses the expression before capturing it -mkUnfolding dflags src is_top_lvl is_bottoming expr - = CoreUnfolding { uf_tmpl = occurAnalyseExpr_NoBinderSwap expr, +mkUnfolding dflags src top_lvl is_bottoming expr + = mkCoreUnfolding src top_lvl expr guidance + where + is_top_bottoming = top_lvl && is_bottoming + guidance = calcUnfoldingGuidance dflags is_top_bottoming expr + -- NB: *not* (calcUnfoldingGuidance (occurAnalyseExpr expr))! + -- See Note [Calculate unfolding guidance on the non-occ-anal'd expression] + +mkCoreUnfolding :: UnfoldingSource -> Bool -> CoreExpr + -> UnfoldingGuidance -> Unfolding +-- Occurrence-analyses the expression before capturing it +mkCoreUnfolding src top_lvl expr guidance + = CoreUnfolding { uf_tmpl = occurAnalyseExpr expr, -- See Note [Occurrence analysis of unfoldings] uf_src = src, - uf_is_top = is_top_lvl, + uf_is_top = top_lvl, uf_is_value = exprIsHNF expr, uf_is_conlike = exprIsConLike expr, - uf_expandable = exprIsExpandable expr, uf_is_work_free = exprIsWorkFree expr, + uf_expandable = exprIsExpandable expr, uf_guidance = guidance } - where - is_top_bottoming = is_top_lvl && is_bottoming - guidance = calcUnfoldingGuidance dflags is_top_bottoming expr - -- NB: *not* (calcUnfoldingGuidance (occurAnalyseExpr_NoBinderSwap expr))! - -- See Note [Calculate unfolding guidance on the non-occ-anal'd expression] + {- Note [Occurrence analysis of unfoldings] @@ -366,39 +360,6 @@ But more generally, the simplifier is designed on the basis that it is looking at occurrence-analysed expressions, so better ensure that they actually are. -We use occurAnalyseExpr_NoBinderSwap instead of occurAnalyseExpr; -see Note [No binder swap in unfoldings]. - -Note [No binder swap in unfoldings] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The binder swap can temporarily violate Core Lint, by assigning -a LocalId binding to a GlobalId. For example, if A.foo{r872} -is a GlobalId with unique r872, then - - case A.foo{r872} of bar { - K x -> ...(A.foo{r872})... - } - -gets transformed to - - case A.foo{r872} of bar { - K x -> let foo{r872} = bar - in ...(A.foo{r872})... - -This is usually not a problem, because the simplifier will transform -this to: - - case A.foo{r872} of bar { - K x -> ...(bar)... - -However, after occurrence analysis but before simplification, this extra 'let' -violates the Core Lint invariant that we do not have local 'let' bindings for -GlobalIds. That seems (just) tolerable for the occurrence analysis that happens -just before the Simplifier, but not for unfoldings, which are Linted -independently. -As a quick workaround, we disable binder swap in this module. -See #16288 and #16296 for further plans. - Note [Calculate unfolding guidance on the non-occ-anal'd expression] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Notice that we give the non-occur-analysed expression to ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -696,7 +696,7 @@ filterAlts _tycon inst_tys imposs_cons alts impossible_alt _ _ = False -- | Refine the default alternative to a 'DataAlt', if there is a unique way to do so. --- See Note [Refine Default Alts] +-- See Note [Refine DEFAULT case alternatives] refineDefaultAlt :: [Unique] -- ^ Uniques for constructing new binders -> TyCon -- ^ Type constructor of scrutinee's type -> [Type] -- ^ Type arguments of scrutinee's type @@ -739,95 +739,62 @@ refineDefaultAlt us tycon tys imposs_deflt_cons all_alts | otherwise -- The common case = (False, all_alts) -{- Note [Refine Default Alts] - -refineDefaultAlt replaces the DEFAULT alt with a constructor if there is one -possible value it could be. +{- Note [Refine DEFAULT case alternatives] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +refineDefaultAlt replaces the DEFAULT alt with a constructor if there +is one possible value it could be. The simplest example being + foo :: () -> () + foo x = case x of !_ -> () +which rewrites to + foo :: () -> () + foo x = case x of () -> () + +There are two reasons in general why replacing a DEFAULT alternative +with a specific constructor is desirable. + +1. We can simplify inner expressions. For example + + data Foo = Foo1 () + + test :: Foo -> () + test x = case x of + DEFAULT -> mid (case x of + Foo1 x1 -> x1) + + refineDefaultAlt fills in the DEFAULT here with `Foo ip1` and then + x becomes bound to `Foo ip1` so is inlined into the other case + which causes the KnownBranch optimisation to kick in. If we don't + refine DEFAULT to `Foo ip1`, we are left with both case expressions. + +2. combineIdenticalAlts does a better job. For exapple (Simon Jacobi) + data D = C0 | C1 | C2 + + case e of + DEFAULT -> e0 + C0 -> e1 + C1 -> e1 + + When we apply combineIdenticalAlts to this expression, it can't + combine the alts for C0 and C1, as we already have a default case. + But if we apply refineDefaultAlt first, we get + case e of + C0 -> e1 + C1 -> e1 + C2 -> e0 + and combineIdenticalAlts can turn that into + case e of + DEFAULT -> e1 + C2 -> e0 -foo :: () -> () -foo x = case x of !_ -> () - -rewrites to - -foo :: () -> () -foo x = case x of () -> () - -There are two reasons in general why this is desirable. - -1. We can simplify inner expressions - -In this example we can eliminate the inner case by refining the outer case. -If we don't refine it, we are left with both case expressions. - -``` -{-# LANGUAGE BangPatterns #-} -module Test where - -mid x = x -{-# NOINLINE mid #-} - -data Foo = Foo1 () - -test :: Foo -> () -test x = - case x of - !_ -> mid (case x of - Foo1 x1 -> x1) - -``` - -refineDefaultAlt fills in the DEFAULT here with `Foo ip1` and then x -becomes bound to `Foo ip1` so is inlined into the other case which -causes the KnownBranch optimisation to kick in. - - -2. combineIdenticalAlts does a better job - -Simon Jakobi also points out that that combineIdenticalAlts will do a better job -if we refine the DEFAULT first. - -``` -data D = C0 | C1 | C2 - -case e of - DEFAULT -> e0 - C0 -> e1 - C1 -> e1 -``` - -When we apply combineIdenticalAlts to this expression, it can't -combine the alts for C0 and C1, as we already have a default case. - -If we apply refineDefaultAlt first, we get - -``` -case e of - C0 -> e1 - C1 -> e1 - C2 -> e0 -``` - -and combineIdenticalAlts can turn that into - -``` -case e of - DEFAULT -> e1 - C2 -> e0 -``` - -It isn't obvious that refineDefaultAlt does this but if you look at its one call -site in GHC.Core.Op.Simplify.Utils then the `imposs_deflt_cons` argument is -populated with constructors which are matched elsewhere. - --} - - - + It isn't obvious that refineDefaultAlt does this but if you look + at its one call site in GHC.Core.Op.Simplify.Utils then the + `imposs_deflt_cons` argument is populated with constructors which + are matched elsewhere. -{- Note [Combine identical alternatives] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [Combine identical alternatives] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ If several alternatives are identical, merge them into a single DEFAULT alternative. I've occasionally seen this making a big difference: ===================================== compiler/GHC/CoreToStg/Prep.hs ===================================== @@ -347,10 +347,7 @@ The way we fix this is to: * In cloneBndr, drop all unfoldings/rules * In deFloatTop, run a simple dead code analyser on each top-level - RHS to drop the dead local bindings. For that call to OccAnal, we - disable the binder swap, else the occurrence analyser sometimes - introduces new let bindings for cased binders, which lead to the bug - in #5433. + RHS to drop the dead local bindings. The reason we don't just OccAnal the whole output of CorePrep is that the tidier ensures that all top-level binders are GlobalIds, so they @@ -1316,14 +1313,13 @@ deFloatTop :: Floats -> [CoreBind] deFloatTop (Floats _ floats) = foldrOL get [] floats where - get (FloatLet b) bs = occurAnalyseRHSs b : bs - get (FloatCase body var _ _ _) bs - = occurAnalyseRHSs (NonRec var body) : bs + get (FloatLet b) bs = get_bind b : bs + get (FloatCase body var _ _ _) bs = get_bind (NonRec var body) : bs get b _ = pprPanic "corePrepPgm" (ppr b) -- See Note [Dead code in CorePrep] - occurAnalyseRHSs (NonRec x e) = NonRec x (occurAnalyseExpr_NoBinderSwap e) - occurAnalyseRHSs (Rec xes) = Rec [(x, occurAnalyseExpr_NoBinderSwap e) | (x, e) <- xes] + get_bind (NonRec x e) = NonRec x (occurAnalyseExpr e) + get_bind (Rec xes) = Rec [(x, occurAnalyseExpr e) | (x, e) <- xes] --------------------------------------------------------------------------- ===================================== compiler/GHC/Iface/Tidy.hs ===================================== @@ -1239,8 +1239,7 @@ tidyTopIdInfo dflags rhs_tidy_env name orig_rhs tidy_rhs idinfo show_unfold | otherwise = minimal_unfold_info minimal_unfold_info = zapUnfolding unf_info - unf_from_rhs = mkTopUnfolding dflags is_bot tidy_rhs - is_bot = isBottomingSig final_sig + unf_from_rhs = mkFinalUnfolding dflags InlineRhs final_sig tidy_rhs -- NB: do *not* expose the worker if show_unfold is off, -- because that means this thing is a loop breaker or -- marked NOINLINE or something like that ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -63,7 +63,6 @@ import Name import NameEnv import NameSet import GHC.Core.Op.OccurAnal ( occurAnalyseExpr ) -import Demand import Module import UniqFM import UniqSupply @@ -1506,14 +1505,12 @@ tcUnfolding toplvl name _ info (IfCoreUnfold stable if_expr) | otherwise = InlineRhs ; return $ case mb_expr of Nothing -> NoUnfolding - Just expr -> mkUnfolding dflags unf_src - True {- Top level -} - (isBottomingSig strict_sig) - expr + Just expr -> mkFinalUnfolding dflags unf_src strict_sig expr } where -- Strictness should occur before unfolding! strict_sig = strictnessInfo info + tcUnfolding toplvl name _ _ (IfCompulsory if_expr) = do { mb_expr <- tcPragExpr True toplvl name if_expr ; return (case mb_expr of ===================================== compiler/GHC/Stg/CSE.hs ===================================== @@ -93,6 +93,7 @@ import Id import GHC.Stg.Syntax import Outputable import VarEnv +import BasicTypes( isWeakLoopBreaker ) import GHC.Core (AltCon(..)) import Data.List (mapAccumL) import Data.Maybe (fromMaybe) @@ -391,6 +392,7 @@ stgCsePairs env0 ((b,e):pairs) stgCseRhs :: CseEnv -> OutId -> InStgRhs -> (Maybe (OutId, OutStgRhs), CseEnv) stgCseRhs env bndr (StgRhsCon ccs dataCon args) | Just other_bndr <- envLookup dataCon args' env + , not (isWeakLoopBreaker (idOccInfo bndr)) -- See Note [Care with loop breakers] = let env' = addSubst bndr other_bndr env in (Nothing, env') | otherwise @@ -399,6 +401,7 @@ stgCseRhs env bndr (StgRhsCon ccs dataCon args) pair = (bndr, StgRhsCon ccs dataCon args') in (Just pair, env') where args' = substArgs env args + stgCseRhs env bndr (StgRhsClosure ext ccs upd args body) = let (env1, args') = substBndrs env args env2 = forgetCse env1 -- See note [Free variables of an StgClosure] @@ -416,6 +419,21 @@ mkStgCase scrut bndr ty alts | all isBndr alts = scrut isBndr _ = False +{- Note [Care with loop breakers] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When doing CSE on a letrec we must be careful about loop +breakers. Consider + rec { y = K z + ; z = K z } +Now if, somehow (and wrongly)), y and z are both marked as +loop-breakers, we do *not* want to drop the (z = K z) binding +in favour of a substitution (z :-> y). + +I think this bug will only show up if the loop-breaker-ness is done +wrongly (itself a bug), but it still seems better to do the right +thing regardless. +-} + -- Utilities -- | This function short-cuts let-bindings that are now obsolete ===================================== compiler/basicTypes/IdInfo.hs ===================================== @@ -86,7 +86,8 @@ module IdInfo ( import GhcPrelude -import GHC.Core +import GHC.Core hiding( hasCoreUnfolding ) +import GHC.Core( hasCoreUnfolding ) import GHC.Core.Class import {-# SOURCE #-} PrimOp (PrimOp) @@ -567,8 +568,8 @@ zapFragileInfo info@(IdInfo { occInfo = occ, unfoldingInfo = unf }) zapFragileUnfolding :: Unfolding -> Unfolding zapFragileUnfolding unf - | isFragileUnfolding unf = noUnfolding - | otherwise = unf + | hasCoreUnfolding unf = noUnfolding + | otherwise = unf zapUnfolding :: Unfolding -> Unfolding -- Squash all unfolding info, preserving only evaluated-ness ===================================== compiler/basicTypes/MkId.hs ===================================== @@ -42,7 +42,6 @@ module MkId ( import GhcPrelude -import GHC.Core.Rules import TysPrim import TysWiredIn import GHC.Core.Op.ConstantFold @@ -52,7 +51,8 @@ import GHC.Core.FamInstEnv import GHC.Core.Coercion import TcType import GHC.Core.Make -import GHC.Core.Utils ( mkCast, mkDefaultCase ) +import GHC.Core.FVs ( mkRuleInfo ) +import GHC.Core.Utils ( mkCast, mkDefaultCase ) import GHC.Core.Unfold import Literal import GHC.Core.TyCon ===================================== testsuite/tests/dependent/should_compile/dynamic-paper.stderr ===================================== @@ -1,5 +1,5 @@ Simplifier ticks exhausted - When trying UnfoldingDone delta + When trying UnfoldingDone delta1 To increase the limit, use -fsimpl-tick-factor=N (default 100). If you need to increase the limit substantially, please file a @@ -12,4 +12,4 @@ Simplifier ticks exhausted simplifier non-termination has been judged acceptable. To see detailed counts use -ddump-simpl-stats - Total ticks: 140086 + Total ticks: 140082 ===================================== testsuite/tests/simplCore/should_compile/T17901.stdout ===================================== @@ -4,13 +4,11 @@ C -> wombat1 T17901.C = \ (@p) (wombat1 :: T -> p) (x :: T) -> case x of wild { __DEFAULT -> wombat1 wild } - (wombat2 [Occ=Once*!] :: S -> p) - SA _ [Occ=Dead] -> wombat2 wild; - SB -> wombat2 T17901.SB + Tmpl= \ (@p) (wombat2 [Occ=Once!] :: S -> p) (x [Occ=Once] :: S) -> + case x of wild [Occ=Once] { __DEFAULT -> wombat2 wild }}] = \ (@p) (wombat2 :: S -> p) (x :: S) -> case x of wild { __DEFAULT -> wombat2 wild } - (wombat3 [Occ=Once*!] :: W -> p) - WB -> wombat3 T17901.WB; - WA _ [Occ=Dead] -> wombat3 wild + Tmpl= \ (@p) (wombat3 [Occ=Once!] :: W -> p) (x [Occ=Once] :: W) -> + case x of wild [Occ=Once] { __DEFAULT -> wombat3 wild }}] = \ (@p) (wombat3 :: W -> p) (x :: W) -> case x of wild { __DEFAULT -> wombat3 wild } ===================================== testsuite/tests/simplCore/should_compile/T7360.hs ===================================== @@ -6,7 +6,7 @@ module T7360 where import GHC.List as L data Foo = Foo1 | Foo2 | Foo3 !Int - + fun1 :: Foo -> () {-# NOINLINE fun1 #-} fun1 x = case x of @@ -14,7 +14,7 @@ fun1 x = case x of Foo2 -> () Foo3 {} -> () -fun2 x = (fun1 Foo1, -- Keep -ddump-simpl output +fun2 x = (fun1 Foo1, -- Keep -ddump-simpl output -- in a predictable order case x of [] -> L.length x ===================================== testsuite/tests/simplCore/should_compile/T7360.stderr ===================================== @@ -1,7 +1,7 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 114, types: 53, 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[0]] :: Int -> Foo @@ -25,21 +25,13 @@ fun1 [InlPrag=NOINLINE] :: Foo -> () fun1 = \ (x :: Foo) -> case x of { __DEFAULT -> GHC.Tuple.() } -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T7360.fun5 :: () +T7360.fun4 :: () [GblId, Unf=Unf{Src=, TopLvl=True, Value=False, ConLike=False, WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 20 0}] -T7360.fun5 = fun1 T7360.Foo1 +T7360.fun4 = fun1 T7360.Foo1 --- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T7360.fun4 :: Int -[GblId, - Cpr=m1, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] -T7360.fun4 = GHC.Types.I# 0# - --- RHS size: {terms: 16, types: 13, coercions: 0, joins: 0/0} +-- RHS size: {terms: 11, types: 8, coercions: 0, joins: 0/0} fun2 :: forall {a}. [a] -> ((), Int) [GblId, Arity=1, @@ -48,24 +40,18 @@ fun2 :: forall {a}. [a] -> ((), Int) 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) (x [Occ=Once!] :: [a]) -> - (T7360.fun5, - case x of wild [Occ=Once] { - [] -> T7360.fun4; - : _ [Occ=Dead] _ [Occ=Dead] -> - case GHC.List.$wlenAcc @a wild 0# of ww2 [Occ=Once] { __DEFAULT -> - GHC.Types.I# ww2 - } + Tmpl= \ (@a) (x [Occ=Once] :: [a]) -> + (T7360.fun4, + case x of wild [Occ=Once] { __DEFAULT -> + case GHC.List.$wlenAcc @a wild 0# of ww2 [Occ=Once] { __DEFAULT -> + GHC.Types.I# ww2 + } })}] fun2 = \ (@a) (x :: [a]) -> - (T7360.fun5, - case x of wild { - [] -> T7360.fun4; - : ds ds1 -> - case GHC.List.$wlenAcc @a wild 0# of ww2 { __DEFAULT -> - GHC.Types.I# ww2 - } + (T7360.fun4, + case GHC.List.$wlenAcc @a x 0# of ww2 { __DEFAULT -> + GHC.Types.I# ww2 }) -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e7e4bad0d425cb36df6eb6a0368b464aa4af3fc2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e7e4bad0d425cb36df6eb6a0368b464aa4af3fc2 You're receiving 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 Mar 30 10:33:20 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 30 Mar 2020 06:33:20 -0400 Subject: [Git][ghc/ghc][wip/dmdanal-precise-exn] 41 commits: Use export list of Main module in function TcRnDriver.hs:check_main (Fix #16453) Message-ID: <5e81caf060011_6167116c28dc13478a6@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/dmdanal-precise-exn at Glasgow Haskell Compiler / GHC Commits: 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. - - - - - 833ac79d by Sebastian Graf at 2020-03-30T11:36:45+02: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. - - - - - af703a25 by Sebastian Graf at 2020-03-30T11:44:01+02:00 Add ConOrDiv to Divergence and see where it gets us - - - - - 2a735eb6 by Sebastian Graf at 2020-03-30T11:44:01+02:00 Actually use conDiv - - - - - 6858d5a0 by Sebastian Graf at 2020-03-30T12:06:24+02:00 Attempt to make ensureArgs do the right thing - - - - - 07b504de by Sebastian Graf at 2020-03-30T12:06:25+02:00 More pondering over the can of worms I opened - - - - - 9f6860a0 by Sebastian Graf at 2020-03-30T12:16:09+02:00 A bunch of fixes involving the new Divergence lattice - - - - - b1bb112c by Sebastian Graf at 2020-03-30T12:16:10+02:00 typo - - - - - fd547815 by Sebastian Graf at 2020-03-30T12:16:10+02:00 Add strictness signature for a bunch of wired in Ids - - - - - 889d3512 by Sebastian Graf at 2020-03-30T12:18:00+02:00 Accept a bunch of testcase changes - - - - - d7f080df by Sebastian Graf at 2020-03-30T12:20:54+02:00 Rename isBot* to isDeadEnd* - - - - - e5fb08df by Sebastian Graf at 2020-03-30T12:20:54+02:00 Comments - - - - - 19632e7b by Sebastian Graf at 2020-03-30T12:23:16+02:00 Assume that precise exceptions can only be thrown from IO - - - - - cf998fba by Sebastian Graf at 2020-03-30T12:26:13+02:00 Accept new testsuite results - - - - - 0a47e839 by Sebastian Graf at 2020-03-30T12:26:14+02:00 Polish Notes - - - - - 7382b53b by Sebastian Graf at 2020-03-30T12:30:53+02:00 More comments - - - - - 7cf060a5 by Sebastian Graf at 2020-03-30T12:32:27+02:00 Change forcesRealWorld to work like the old IO hack - - - - - c873b3b9 by Sebastian Graf at 2020-03-30T12:33:03+02:00 Revert "Change forcesRealWorld to work like the old IO hack" This reverts commit 516987db1eb32bb231063e1e0fa4ff78178b15c9. - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC.hs - 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/BlockId.hs - compiler/GHC/Cmm/BlockId.hs-boot - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow.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.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/Ppr.hs - compiler/GHC/Cmm/ProcPoint.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Switch/Implement.hs - compiler/GHC/Cmm/Utils.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8ebfdf4fb3f0e1c020b166f11864b30cf7587d28...c873b3b99adb4d4dd3214ae65c21f5c0452853f8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8ebfdf4fb3f0e1c020b166f11864b30cf7587d28...c873b3b99adb4d4dd3214ae65c21f5c0452853f8 You're receiving 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 Mar 30 14:12:47 2020 From: gitlab at gitlab.haskell.org (Andreas Klebinger) Date: Mon, 30 Mar 2020 10:12:47 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/andreask/bump_integer-gmp Message-ID: <5e81fe5faab66_616776d1c7413930bb@gitlab.haskell.org.mail> Andreas Klebinger pushed new branch wip/andreask/bump_integer-gmp at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/andreask/bump_integer-gmp You're receiving 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 Mar 30 14:44:56 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 30 Mar 2020 10:44:56 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T17922 Message-ID: <5e8205e8afe6d_6167e0e2c94141186@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/T17922 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T17922 You're receiving 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 Mar 30 14:48:33 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 30 Mar 2020 10:48:33 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 19 commits: Modules: Types (#13009) Message-ID: <5e8206c129fd9_6167116c28dc1416168@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 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. - - - - - 909fc2d5 by Ryan Scott at 2020-03-30T10:48:16-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. - - - - - d5a3c1f3 by Ryan Scott at 2020-03-30T10:48:16-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. - - - - - 88ccc7b5 by Ömer Sinan Ağacan at 2020-03-30T10:48:22-04:00 Simplify stderrSupportsAnsiColors The combinator andM is used only once, and the code is shorter and simpler if you inline it. - - - - - 7812d98f by Ben Gamari at 2020-03-30T10:48:23-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. - - - - - 58aba3e6 by Andreas Klebinger at 2020-03-30T10:48:24-04:00 Update hadrian index revision. Required in order to build hadrian using ghc-8.10 - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC.hs - 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/BlockId.hs - compiler/GHC/Cmm/BlockId.hs-boot - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow.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.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/Ppr.hs - compiler/GHC/Cmm/ProcPoint.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Switch/Implement.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/06ac69128b5872b5ae84e124be0fbea818ec427e...58aba3e6baffe815f17a331eaa77f37c955fa2be -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/06ac69128b5872b5ae84e124be0fbea818ec427e...58aba3e6baffe815f17a331eaa77f37c955fa2be You're receiving 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 Mar 30 14:57:32 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 30 Mar 2020 10:57:32 -0400 Subject: [Git][ghc/ghc][wip/T17922] Session: Memoize stderrSupportsAnsiColors Message-ID: <5e8208dcb44ec_61673f81cca05dd81425336@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T17922 at Glasgow Haskell Compiler / GHC Commits: 65c66dbe by Ben Gamari at 2020-03-30T10:57:21-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. - - - - - 2 changed files: - compiler/GHC/Driver/Session.hs - compiler/main/SysTools/Terminal.hs Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -1253,7 +1253,6 @@ initDynFlags dflags = do `catchIOError` \_ -> return False ghcNoUnicodeEnv <- lookupEnv "GHC_NO_UNICODE" let useUnicode' = isNothing ghcNoUnicodeEnv && canUseUnicode - canUseColor <- stderrSupportsAnsiColors maybeGhcColorsEnv <- lookupEnv "GHC_COLORS" maybeGhcColoursEnv <- lookupEnv "GHC_COLOURS" let adjustCols (Just env) = Col.parseScheme env @@ -1270,7 +1269,7 @@ initDynFlags dflags = do nextWrapperNum = wrapperNum, useUnicode = useUnicode', useColor = useColor', - canUseColor = canUseColor, + canUseColor = stderrSupportsAnsiColors, colScheme = colScheme', rtldInfo = refRtldInfo, rtccInfo = refRtccInfo ===================================== compiler/main/SysTools/Terminal.hs ===================================== @@ -18,6 +18,8 @@ import qualified Graphics.Win32 as Win32 import qualified System.Win32 as Win32 #endif +import System.IO.Unsafe + #if defined(mingw32_HOST_OS) && !defined(WINAPI) # if defined(i386_HOST_ARCH) # define WINAPI stdcall @@ -28,9 +30,15 @@ import qualified System.Win32 as Win32 # endif #endif +-- | Does the controlling terminal support ANSI color sequences? +-- This memoized to avoid thread-safety issues in ncurses (see #17922). +stderrSupportsAnsiColors :: Bool +stderrSupportsAnsiColors = unsafePerformIO stderrSupportsAnsiColors +{-# NOINLINE stderrSupportsAnsiColors #-} + -- | Check if ANSI escape sequences can be used to control color in stderr. -stderrSupportsAnsiColors :: IO Bool -stderrSupportsAnsiColors = do +stderrSupportsAnsiColors' :: IO Bool +stderrSupportsAnsiColors' = do #if defined(MIN_VERSION_terminfo) queryTerminal stdError `andM` do (termSupportsColors <$> setupTermFromEnv) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/65c66dbeb86849aa92253fb3312b168f21805fc2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/65c66dbeb86849aa92253fb3312b168f21805fc2 You're receiving 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 Mar 30 15:14:53 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 30 Mar 2020 11:14:53 -0400 Subject: [Git][ghc/ghc][wip/T17922] Session: Memoize stderrSupportsAnsiColors Message-ID: <5e820cedc39fe_6167116c28dc1434458@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T17922 at Glasgow Haskell Compiler / GHC Commits: 6bf85e01 by Ben Gamari at 2020-03-30T11:14:43-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. - - - - - 2 changed files: - compiler/GHC/Driver/Session.hs - compiler/main/SysTools/Terminal.hs Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -1253,7 +1253,6 @@ initDynFlags dflags = do `catchIOError` \_ -> return False ghcNoUnicodeEnv <- lookupEnv "GHC_NO_UNICODE" let useUnicode' = isNothing ghcNoUnicodeEnv && canUseUnicode - canUseColor <- stderrSupportsAnsiColors maybeGhcColorsEnv <- lookupEnv "GHC_COLORS" maybeGhcColoursEnv <- lookupEnv "GHC_COLOURS" let adjustCols (Just env) = Col.parseScheme env @@ -1270,7 +1269,7 @@ initDynFlags dflags = do nextWrapperNum = wrapperNum, useUnicode = useUnicode', useColor = useColor', - canUseColor = canUseColor, + canUseColor = stderrSupportsAnsiColors, colScheme = colScheme', rtldInfo = refRtldInfo, rtccInfo = refRtccInfo ===================================== compiler/main/SysTools/Terminal.hs ===================================== @@ -18,6 +18,8 @@ import qualified Graphics.Win32 as Win32 import qualified System.Win32 as Win32 #endif +import System.IO.Unsafe + #if defined(mingw32_HOST_OS) && !defined(WINAPI) # if defined(i386_HOST_ARCH) # define WINAPI stdcall @@ -28,9 +30,15 @@ import qualified System.Win32 as Win32 # endif #endif +-- | Does the controlling terminal support ANSI color sequences? +-- This memoized to avoid thread-safety issues in ncurses (see #17922). +stderrSupportsAnsiColors :: Bool +stderrSupportsAnsiColors = unsafePerformIO stderrSupportsAnsiColors' +{-# NOINLINE stderrSupportsAnsiColors #-} + -- | Check if ANSI escape sequences can be used to control color in stderr. -stderrSupportsAnsiColors :: IO Bool -stderrSupportsAnsiColors = do +stderrSupportsAnsiColors' :: IO Bool +stderrSupportsAnsiColors' = do #if defined(MIN_VERSION_terminfo) queryTerminal stdError `andM` do (termSupportsColors <$> setupTermFromEnv) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6bf85e01e9c3baec32e95a0ff129f69c8b0b6230 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6bf85e01e9c3baec32e95a0ff129f69c8b0b6230 You're receiving 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 Mar 30 15:36:03 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 30 Mar 2020 11:36:03 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T17987 Message-ID: <5e8211e3dc29d_61671196b3f414527e8@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/T17987 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T17987 You're receiving 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 Mar 30 15:38:32 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 30 Mar 2020 11:38:32 -0400 Subject: [Git][ghc/ghc][wip/T17987] testsuite: Don't consider broken tests to stat measurements Message-ID: <5e8212788a549_61671196b3f41458966@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T17987 at Glasgow Haskell Compiler / GHC Commits: 22dbcb37 by Ben Gamari at 2020-03-30T11:38:24-04:00 testsuite: Don't consider broken tests to stat measurements Previously we would add statistics from tests marked as broken to the stats output. This broke in #17987 since the test was considered to be "broken" solely on the basis of its allocations. In later testsuite runs the "broken" allocations metric was then considered to be the baseline and the test started unexpectedly passing. We now ignore metrics that arise from tests marked as broken. Of course, this required that we distinguish between "broken" and merely "expected to fail". I took this opportunity to do a bit of refactoring in our representation of test outcomes. - - - - - 2 changed files: - testsuite/driver/testglobals.py - testsuite/driver/testlib.py Changes: ===================================== testsuite/driver/testglobals.py ===================================== @@ -6,6 +6,7 @@ from my_typing import * from pathlib import Path from perf_notes import MetricChange, PerfStat, Baseline, MetricOracles from datetime import datetime +from enum import Enum # ----------------------------------------------------------------------------- # Configuration info @@ -261,6 +262,20 @@ t = TestRun() def getTestRun() -> TestRun: return t +class ExpectedOutcome(Enum): + """ + Whether we expect a test to pass or why it we expect it to fail. + """ + + # The test should pass + PASS = 'pass' + # The test should fail (e.g. when testing an error message) + FAIL = 'fail' + # The test should fail because it is currently broken + BROKEN = 'broken' + # The test should fail because we are lacking a library it requires + MISSING_LIB = 'missing-lib' + # ----------------------------------------------------------------------------- # Information about the current test @@ -282,7 +297,7 @@ class TestOptions: self.extra_ways = [] # type: List[WayName] # the result we normally expect for this test - self.expect = 'pass' + self.expect = ExpectedOutcome.Pass # type: ExpectedOutcome # override the expected result for certain ways self.expect_fail_for = [] # type: List[WayName] ===================================== testsuite/driver/testlib.py ===================================== @@ -114,7 +114,7 @@ def expect_fail( name, opts ): # The compiler, testdriver, OS or platform is missing a certain # feature, and we don't plan to or can't fix it now or in the # future. - opts.expect = 'fail'; + opts.expect = ExpectedOutcome.FAIL def reqlib( lib ): return lambda name, opts, l=lib: _reqlib (name, opts, l ) @@ -174,28 +174,28 @@ def have_library(lib: str) -> bool: def _reqlib( name, opts, lib ): if not have_library(lib): - opts.expect = 'missing-lib' + opts.expect = ExpectedOutcome.MISSING_LIB def req_haddock( name, opts ): if not config.haddock: - opts.expect = 'missing-lib' + opts.expect = ExpectedOutcome.MISSING_LIB def req_profiling( name, opts ): '''Require the profiling libraries (add 'GhcLibWays += p' to mk/build.mk)''' if not config.have_profiling: - opts.expect = 'fail' + opts.expect = ExpectedOutcome.FAIL def req_shared_libs( name, opts ): if not config.have_shared_libs: - opts.expect = 'fail' + opts.expect = ExpectedOutcome.FAIL def req_interp( name, opts ): if not config.have_interp: - opts.expect = 'fail' + opts.expect = ExpectedOutcome.FAIL def req_rts_linker( name, opts ): if not config.have_RTS_linker: - opts.expect = 'fail' + opts.expect = ExpectedOutcome.FAIL def req_th( name, opts ): """ @@ -210,7 +210,7 @@ def req_th( name, opts ): def req_smp( name, opts ): if not config.have_smp: - opts.expect = 'fail' + opts.expect = ExpectedOutcome.FAIL def ignore_stdout(name, opts): opts.ignore_stdout = True @@ -269,7 +269,7 @@ def expect_broken( bug: IssueNumber ): """ def helper( name: TestName, opts ): record_broken(name, opts, bug) - opts.expect = 'fail'; + opts.expect = ExpectedOutcome.FAIL return helper @@ -291,7 +291,7 @@ def record_broken(name: TestName, opts, bug: IssueNumber): def _expect_pass(way): # Helper function. Not intended for use in .T files. opts = getTestOpts() - return opts.expect == 'pass' and way not in opts.expect_fail_for + return opts.expect == ExpectedOutcome.PASS and way not in opts.expect_fail_for # ----- @@ -869,7 +869,7 @@ def test(name: TestName, executeSetups([thisdir_settings, setup], name, myTestOpts) if name in config.broken_tests: - myTestOpts.expect = 'fail' + myTestOpts.expect = ExpectedOutcome.BROKEN thisTest = lambda watcher: runTest(watcher, myTestOpts, name, func, args) if myTestOpts.alone: @@ -1081,13 +1081,13 @@ def do_test(name: TestName, print_output = config.verbose >= 3) # If user used expect_broken then don't record failures of pre_cmd - if exit_code != 0 and opts.expect not in ['fail']: + if exit_code != 0 and opts.expect not in [ExpectedOutcome.FAIL]: framework_fail(name, way, 'pre_cmd failed: {0}'.format(exit_code)) if_verbose(1, '** pre_cmd was "{0}".'.format(override_options(opts.pre_cmd))) result = func(*[name,way] + args) - if opts.expect not in ['pass', 'fail', 'missing-lib']: + if opts.expect not in [ExpectedOutcome.PASS, ExpectedOutcome.FAIL, ExpectedOutcome.MISSING_LIB]: framework_fail(name, way, 'bad expected ' + opts.expect) try: @@ -1126,7 +1126,7 @@ def do_test(name: TestName, stderr=result.stderr) t.unexpected_failures.append(tr) else: - if opts.expect == 'missing-lib': + if opts.expect == ExpectedOutcome.MISSING_LIB: t.missing_libs.append(TestResult(directory, name, 'missing-lib', way)) else: t.n_expected_failures += 1 @@ -1406,6 +1406,10 @@ def check_stats(name: TestName, stats_file: Path, range_fields: Dict[MetricName, MetricOracles] ) -> PassFail: + if getTestOpts().expect == ExpectedOutcome.BROKEN: + print('Skipping performance metrics test on broken test {}'.format(name)) + return passed() + head_commit = Perf.commit_hash(GitRef('HEAD')) if Perf.inside_git_repo() else None if head_commit is None: return passed() @@ -1958,7 +1962,7 @@ def compare_outputs(way: WayName, elif diff_file: diff_file.open('ab').close() # Make sure the file exists still as # we will try to read it later - if config.accept and (getTestOpts().expect == 'fail' or + if config.accept and (getTestOpts().expect == ExpectedOutcome.FAIL or way in getTestOpts().expect_fail_for): if_verbose(1, 'Test is expected to fail. Not accepting new output.') return False View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/22dbcb375b0dc089671ea34376bf7fe82521597d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/22dbcb375b0dc089671ea34376bf7fe82521597d You're receiving 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 Mar 30 15:39:34 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 30 Mar 2020 11:39:34 -0400 Subject: [Git][ghc/ghc][wip/T17987] testsuite: Don't consider broken tests to stat measurements Message-ID: <5e8212b69c280_6167120434ec145931f@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T17987 at Glasgow Haskell Compiler / GHC Commits: 6bb71de3 by Ben Gamari at 2020-03-30T11:39:25-04:00 testsuite: Don't consider broken tests to stat measurements Previously we would add statistics from tests marked as broken to the stats output. This broke in #17987 since the test was considered to be "broken" solely on the basis of its allocations. In later testsuite runs the "broken" allocations metric was then considered to be the baseline and the test started unexpectedly passing. We now ignore metrics that arise from tests marked as broken. Of course, this required that we distinguish between "broken" and merely "expected to fail". I took this opportunity to do a bit of refactoring in our representation of test outcomes. - - - - - 2 changed files: - testsuite/driver/testglobals.py - testsuite/driver/testlib.py Changes: ===================================== testsuite/driver/testglobals.py ===================================== @@ -6,6 +6,7 @@ from my_typing import * from pathlib import Path from perf_notes import MetricChange, PerfStat, Baseline, MetricOracles from datetime import datetime +from enum import Enum # ----------------------------------------------------------------------------- # Configuration info @@ -261,6 +262,20 @@ t = TestRun() def getTestRun() -> TestRun: return t +class ExpectedOutcome(Enum): + """ + Whether we expect a test to pass or why it we expect it to fail. + """ + + # The test should pass + PASS = 'pass' + # The test should fail (e.g. when testing an error message) + FAIL = 'fail' + # The test should fail because it is currently broken + BROKEN = 'broken' + # The test should fail because we are lacking a library it requires + MISSING_LIB = 'missing-lib' + # ----------------------------------------------------------------------------- # Information about the current test @@ -282,7 +297,7 @@ class TestOptions: self.extra_ways = [] # type: List[WayName] # the result we normally expect for this test - self.expect = 'pass' + self.expect = ExpectedOutcome.PASS # type: ExpectedOutcome # override the expected result for certain ways self.expect_fail_for = [] # type: List[WayName] ===================================== testsuite/driver/testlib.py ===================================== @@ -114,7 +114,7 @@ def expect_fail( name, opts ): # The compiler, testdriver, OS or platform is missing a certain # feature, and we don't plan to or can't fix it now or in the # future. - opts.expect = 'fail'; + opts.expect = ExpectedOutcome.FAIL def reqlib( lib ): return lambda name, opts, l=lib: _reqlib (name, opts, l ) @@ -174,28 +174,28 @@ def have_library(lib: str) -> bool: def _reqlib( name, opts, lib ): if not have_library(lib): - opts.expect = 'missing-lib' + opts.expect = ExpectedOutcome.MISSING_LIB def req_haddock( name, opts ): if not config.haddock: - opts.expect = 'missing-lib' + opts.expect = ExpectedOutcome.MISSING_LIB def req_profiling( name, opts ): '''Require the profiling libraries (add 'GhcLibWays += p' to mk/build.mk)''' if not config.have_profiling: - opts.expect = 'fail' + opts.expect = ExpectedOutcome.FAIL def req_shared_libs( name, opts ): if not config.have_shared_libs: - opts.expect = 'fail' + opts.expect = ExpectedOutcome.FAIL def req_interp( name, opts ): if not config.have_interp: - opts.expect = 'fail' + opts.expect = ExpectedOutcome.FAIL def req_rts_linker( name, opts ): if not config.have_RTS_linker: - opts.expect = 'fail' + opts.expect = ExpectedOutcome.FAIL def req_th( name, opts ): """ @@ -210,7 +210,7 @@ def req_th( name, opts ): def req_smp( name, opts ): if not config.have_smp: - opts.expect = 'fail' + opts.expect = ExpectedOutcome.FAIL def ignore_stdout(name, opts): opts.ignore_stdout = True @@ -269,7 +269,7 @@ def expect_broken( bug: IssueNumber ): """ def helper( name: TestName, opts ): record_broken(name, opts, bug) - opts.expect = 'fail'; + opts.expect = ExpectedOutcome.FAIL return helper @@ -291,7 +291,7 @@ def record_broken(name: TestName, opts, bug: IssueNumber): def _expect_pass(way): # Helper function. Not intended for use in .T files. opts = getTestOpts() - return opts.expect == 'pass' and way not in opts.expect_fail_for + return opts.expect == ExpectedOutcome.PASS and way not in opts.expect_fail_for # ----- @@ -869,7 +869,7 @@ def test(name: TestName, executeSetups([thisdir_settings, setup], name, myTestOpts) if name in config.broken_tests: - myTestOpts.expect = 'fail' + myTestOpts.expect = ExpectedOutcome.BROKEN thisTest = lambda watcher: runTest(watcher, myTestOpts, name, func, args) if myTestOpts.alone: @@ -1081,13 +1081,13 @@ def do_test(name: TestName, print_output = config.verbose >= 3) # If user used expect_broken then don't record failures of pre_cmd - if exit_code != 0 and opts.expect not in ['fail']: + if exit_code != 0 and opts.expect not in [ExpectedOutcome.FAIL]: framework_fail(name, way, 'pre_cmd failed: {0}'.format(exit_code)) if_verbose(1, '** pre_cmd was "{0}".'.format(override_options(opts.pre_cmd))) result = func(*[name,way] + args) - if opts.expect not in ['pass', 'fail', 'missing-lib']: + if opts.expect not in [ExpectedOutcome.PASS, ExpectedOutcome.FAIL, ExpectedOutcome.MISSING_LIB]: framework_fail(name, way, 'bad expected ' + opts.expect) try: @@ -1126,7 +1126,7 @@ def do_test(name: TestName, stderr=result.stderr) t.unexpected_failures.append(tr) else: - if opts.expect == 'missing-lib': + if opts.expect == ExpectedOutcome.MISSING_LIB: t.missing_libs.append(TestResult(directory, name, 'missing-lib', way)) else: t.n_expected_failures += 1 @@ -1406,6 +1406,10 @@ def check_stats(name: TestName, stats_file: Path, range_fields: Dict[MetricName, MetricOracles] ) -> PassFail: + if getTestOpts().expect == ExpectedOutcome.BROKEN: + print('Skipping performance metrics test on broken test {}'.format(name)) + return passed() + head_commit = Perf.commit_hash(GitRef('HEAD')) if Perf.inside_git_repo() else None if head_commit is None: return passed() @@ -1958,7 +1962,7 @@ def compare_outputs(way: WayName, elif diff_file: diff_file.open('ab').close() # Make sure the file exists still as # we will try to read it later - if config.accept and (getTestOpts().expect == 'fail' or + if config.accept and (getTestOpts().expect == ExpectedOutcome.FAIL or way in getTestOpts().expect_fail_for): if_verbose(1, 'Test is expected to fail. Not accepting new output.') return False View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6bb71de325edfa54545d90d13eed1f279784bc2e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6bb71de325edfa54545d90d13eed1f279784bc2e You're receiving 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 Mar 30 15:42:45 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 30 Mar 2020 11:42:45 -0400 Subject: [Git][ghc/ghc][wip/T17987] testsuite: Don't consider broken tests to stat measurements Message-ID: <5e8213754947_61675cefcac146011@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T17987 at Glasgow Haskell Compiler / GHC Commits: a976e400 by Ben Gamari at 2020-03-30T11:42:36-04:00 testsuite: Don't consider broken tests to stat measurements Previously we would add statistics from tests marked as broken to the stats output. This broke in #17987 since the test was considered to be "broken" solely on the basis of its allocations. In later testsuite runs the "broken" allocations metric was then considered to be the baseline and the test started unexpectedly passing. We now ignore metrics that arise from tests marked as broken. Of course, this required that we distinguish between "broken" and merely "expected to fail". I took this opportunity to do a bit of refactoring in our representation of test outcomes. - - - - - 2 changed files: - testsuite/driver/testglobals.py - testsuite/driver/testlib.py Changes: ===================================== testsuite/driver/testglobals.py ===================================== @@ -6,6 +6,7 @@ from my_typing import * from pathlib import Path from perf_notes import MetricChange, PerfStat, Baseline, MetricOracles from datetime import datetime +from enum import Enum # ----------------------------------------------------------------------------- # Configuration info @@ -261,6 +262,20 @@ t = TestRun() def getTestRun() -> TestRun: return t +class ExpectedOutcome(Enum): + """ + Whether we expect a test to pass or why it we expect it to fail. + """ + + # The test should pass + PASS = 'pass' + # The test should fail (e.g. when testing an error message) + FAIL = 'fail' + # The test should fail because it is currently broken + BROKEN = 'broken' + # The test should fail because we are lacking a library it requires + MISSING_LIB = 'missing-lib' + # ----------------------------------------------------------------------------- # Information about the current test @@ -282,7 +297,7 @@ class TestOptions: self.extra_ways = [] # type: List[WayName] # the result we normally expect for this test - self.expect = 'pass' + self.expect = ExpectedOutcome.PASS # type: ExpectedOutcome # override the expected result for certain ways self.expect_fail_for = [] # type: List[WayName] ===================================== testsuite/driver/testlib.py ===================================== @@ -19,7 +19,8 @@ import collections import subprocess from testglobals import config, ghc_env, default_testopts, brokens, t, \ - TestRun, TestResult, TestOptions, PerfMetric + TestRun, TestResult, TestOptions, PerfMetric, \ + ExpectedOutcome from testutil import strip_quotes, lndir, link_or_copy_file, passed, \ failBecause, testing_metrics, \ PassFail @@ -114,7 +115,7 @@ def expect_fail( name, opts ): # The compiler, testdriver, OS or platform is missing a certain # feature, and we don't plan to or can't fix it now or in the # future. - opts.expect = 'fail'; + opts.expect = ExpectedOutcome.FAIL def reqlib( lib ): return lambda name, opts, l=lib: _reqlib (name, opts, l ) @@ -174,28 +175,28 @@ def have_library(lib: str) -> bool: def _reqlib( name, opts, lib ): if not have_library(lib): - opts.expect = 'missing-lib' + opts.expect = ExpectedOutcome.MISSING_LIB def req_haddock( name, opts ): if not config.haddock: - opts.expect = 'missing-lib' + opts.expect = ExpectedOutcome.MISSING_LIB def req_profiling( name, opts ): '''Require the profiling libraries (add 'GhcLibWays += p' to mk/build.mk)''' if not config.have_profiling: - opts.expect = 'fail' + opts.expect = ExpectedOutcome.FAIL def req_shared_libs( name, opts ): if not config.have_shared_libs: - opts.expect = 'fail' + opts.expect = ExpectedOutcome.FAIL def req_interp( name, opts ): if not config.have_interp: - opts.expect = 'fail' + opts.expect = ExpectedOutcome.FAIL def req_rts_linker( name, opts ): if not config.have_RTS_linker: - opts.expect = 'fail' + opts.expect = ExpectedOutcome.FAIL def req_th( name, opts ): """ @@ -210,7 +211,7 @@ def req_th( name, opts ): def req_smp( name, opts ): if not config.have_smp: - opts.expect = 'fail' + opts.expect = ExpectedOutcome.FAIL def ignore_stdout(name, opts): opts.ignore_stdout = True @@ -269,7 +270,7 @@ def expect_broken( bug: IssueNumber ): """ def helper( name: TestName, opts ): record_broken(name, opts, bug) - opts.expect = 'fail'; + opts.expect = ExpectedOutcome.FAIL return helper @@ -291,7 +292,7 @@ def record_broken(name: TestName, opts, bug: IssueNumber): def _expect_pass(way): # Helper function. Not intended for use in .T files. opts = getTestOpts() - return opts.expect == 'pass' and way not in opts.expect_fail_for + return opts.expect == ExpectedOutcome.PASS and way not in opts.expect_fail_for # ----- @@ -869,7 +870,7 @@ def test(name: TestName, executeSetups([thisdir_settings, setup], name, myTestOpts) if name in config.broken_tests: - myTestOpts.expect = 'fail' + myTestOpts.expect = ExpectedOutcome.BROKEN thisTest = lambda watcher: runTest(watcher, myTestOpts, name, func, args) if myTestOpts.alone: @@ -1081,13 +1082,13 @@ def do_test(name: TestName, print_output = config.verbose >= 3) # If user used expect_broken then don't record failures of pre_cmd - if exit_code != 0 and opts.expect not in ['fail']: + if exit_code != 0 and opts.expect not in [ExpectedOutcome.FAIL]: framework_fail(name, way, 'pre_cmd failed: {0}'.format(exit_code)) if_verbose(1, '** pre_cmd was "{0}".'.format(override_options(opts.pre_cmd))) result = func(*[name,way] + args) - if opts.expect not in ['pass', 'fail', 'missing-lib']: + if opts.expect not in [ExpectedOutcome.PASS, ExpectedOutcome.FAIL, ExpectedOutcome.MISSING_LIB]: framework_fail(name, way, 'bad expected ' + opts.expect) try: @@ -1126,7 +1127,7 @@ def do_test(name: TestName, stderr=result.stderr) t.unexpected_failures.append(tr) else: - if opts.expect == 'missing-lib': + if opts.expect == ExpectedOutcome.MISSING_LIB: t.missing_libs.append(TestResult(directory, name, 'missing-lib', way)) else: t.n_expected_failures += 1 @@ -1406,6 +1407,10 @@ def check_stats(name: TestName, stats_file: Path, range_fields: Dict[MetricName, MetricOracles] ) -> PassFail: + if getTestOpts().expect == ExpectedOutcome.BROKEN: + print('Skipping performance metrics test on broken test {}'.format(name)) + return passed() + head_commit = Perf.commit_hash(GitRef('HEAD')) if Perf.inside_git_repo() else None if head_commit is None: return passed() @@ -1958,7 +1963,7 @@ def compare_outputs(way: WayName, elif diff_file: diff_file.open('ab').close() # Make sure the file exists still as # we will try to read it later - if config.accept and (getTestOpts().expect == 'fail' or + if config.accept and (getTestOpts().expect == ExpectedOutcome.FAIL or way in getTestOpts().expect_fail_for): if_verbose(1, 'Test is expected to fail. Not accepting new output.') return False View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a976e40024a0a62d9f9272da5a71c22ba90461bc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a976e40024a0a62d9f9272da5a71c22ba90461bc You're receiving 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 Mar 30 16:06:37 2020 From: gitlab at gitlab.haskell.org (Andreas Klebinger) Date: Mon, 30 Mar 2020 12:06:37 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/andreask/tools_unlines Message-ID: <5e82190dc80d2_61673f81cca05dd814658a@gitlab.haskell.org.mail> Andreas Klebinger pushed new branch wip/andreask/tools_unlines at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/andreask/tools_unlines You're receiving 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 Mar 30 16:08:39 2020 From: gitlab at gitlab.haskell.org (Andreas Klebinger) Date: Mon, 30 Mar 2020 12:08:39 -0400 Subject: [Git][ghc/ghc][wip/andreask/tools_unlines] Turn newlines into spaces for hadrian/ghci. Message-ID: <5e8219871138_61673f81cca05dd814674e9@gitlab.haskell.org.mail> Andreas Klebinger pushed to branch wip/andreask/tools_unlines at Glasgow Haskell Compiler / GHC Commits: 4209209a by Andreas Klebinger at 2020-03-30T18:08:27+02:00 Turn newlines into spaces for hadrian/ghci. The newlines break the command on windows. - - - - - 2 changed files: - hadrian/ghci-cabal - hadrian/ghci-stack Changes: ===================================== hadrian/ghci-cabal ===================================== @@ -2,5 +2,5 @@ set -e -GHC_FLAGS="$GHC_FLAGS $(TERM=dumb CABFLAGS=-v0 "hadrian/build-cabal" tool-args -q --build-root=.hadrian_ghci --flavour=ghc-in-ghci "$@")" +GHC_FLAGS="$GHC_FLAGS $(TERM=dumb CABFLAGS=-v0 "hadrian/build-cabal" tool-args -q --build-root=.hadrian_ghci --flavour=ghc-in-ghci "$@" | tr '\n\r' ' ')" ghci $GHC_FLAGS "$@" -fno-code -fwrite-interface -hidir=.hadrian_ghci/interface -O0 ghc/Main.hs +RTS -A128m ===================================== hadrian/ghci-stack ===================================== @@ -2,5 +2,5 @@ set -e -GHC_FLAGS="$GHC_FLAGS $(TERM=dumb CABFLAGS=-v0 "hadrian/build-stack" tool-args -q --build-root=.hadrian_ghci --flavour=ghc-in-ghci "$@")" +GHC_FLAGS="$GHC_FLAGS $(TERM=dumb CABFLAGS=-v0 "hadrian/build-stack" tool-args -q --build-root=.hadrian_ghci --flavour=ghc-in-ghci "$@" | tr '\n\r' ' ')" stack exec -- ghci $GHC_FLAGS "$@" -fno-code -fwrite-interface -hidir=.hadrian_ghci/interface -O0 ghc/Main.hs +RTS -A128m View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4209209a73a4b9ff4e41a69809adb0c6e932ecc4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4209209a73a4b9ff4e41a69809adb0c6e932ecc4 You're receiving 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 Mar 30 16:13:24 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 30 Mar 2020 12:13:24 -0400 Subject: [Git][ghc/ghc][wip/T17987] testsuite: Don't consider broken tests to stat measurements Message-ID: <5e821aa462d68_61677b155d8146817d@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T17987 at Glasgow Haskell Compiler / GHC Commits: 27c7fd08 by Ben Gamari at 2020-03-30T12:13:17-04:00 testsuite: Don't consider broken tests to stat measurements Previously we would add statistics from tests marked as broken to the stats output. This broke in #17987 since the test was considered to be "broken" solely on the basis of its allocations. In later testsuite runs the "broken" allocations metric was then considered to be the baseline and the test started unexpectedly passing. We now ignore metrics that arise from tests marked as broken. Of course, this required that we distinguish between "broken" and merely "expected to fail". I took this opportunity to do a bit of refactoring in our representation of test outcomes. - - - - - 2 changed files: - testsuite/driver/testglobals.py - testsuite/driver/testlib.py Changes: ===================================== testsuite/driver/testglobals.py ===================================== @@ -6,6 +6,7 @@ from my_typing import * from pathlib import Path from perf_notes import MetricChange, PerfStat, Baseline, MetricOracles from datetime import datetime +from enum import Enum # ----------------------------------------------------------------------------- # Configuration info @@ -261,6 +262,20 @@ t = TestRun() def getTestRun() -> TestRun: return t +class ExpectedOutcome(Enum): + """ + Whether we expect a test to pass or why it we expect it to fail. + """ + + # The test should pass + PASS = 'pass' + # The test should fail (e.g. when testing an error message) + FAIL = 'fail' + # The test should fail because it is currently broken + BROKEN = 'broken' + # The test should fail because we are lacking a library it requires + MISSING_LIB = 'missing-lib' + # ----------------------------------------------------------------------------- # Information about the current test @@ -282,7 +297,7 @@ class TestOptions: self.extra_ways = [] # type: List[WayName] # the result we normally expect for this test - self.expect = 'pass' + self.expect = ExpectedOutcome.PASS # type: ExpectedOutcome # override the expected result for certain ways self.expect_fail_for = [] # type: List[WayName] ===================================== testsuite/driver/testlib.py ===================================== @@ -19,7 +19,8 @@ import collections import subprocess from testglobals import config, ghc_env, default_testopts, brokens, t, \ - TestRun, TestResult, TestOptions, PerfMetric + TestRun, TestResult, TestOptions, PerfMetric, \ + ExpectedOutcome from testutil import strip_quotes, lndir, link_or_copy_file, passed, \ failBecause, testing_metrics, \ PassFail @@ -114,7 +115,7 @@ def expect_fail( name, opts ): # The compiler, testdriver, OS or platform is missing a certain # feature, and we don't plan to or can't fix it now or in the # future. - opts.expect = 'fail'; + opts.expect = ExpectedOutcome.FAIL def reqlib( lib ): return lambda name, opts, l=lib: _reqlib (name, opts, l ) @@ -174,28 +175,28 @@ def have_library(lib: str) -> bool: def _reqlib( name, opts, lib ): if not have_library(lib): - opts.expect = 'missing-lib' + opts.expect = ExpectedOutcome.MISSING_LIB def req_haddock( name, opts ): if not config.haddock: - opts.expect = 'missing-lib' + opts.expect = ExpectedOutcome.MISSING_LIB def req_profiling( name, opts ): '''Require the profiling libraries (add 'GhcLibWays += p' to mk/build.mk)''' if not config.have_profiling: - opts.expect = 'fail' + opts.expect = ExpectedOutcome.FAIL def req_shared_libs( name, opts ): if not config.have_shared_libs: - opts.expect = 'fail' + opts.expect = ExpectedOutcome.FAIL def req_interp( name, opts ): if not config.have_interp: - opts.expect = 'fail' + opts.expect = ExpectedOutcome.FAIL def req_rts_linker( name, opts ): if not config.have_RTS_linker: - opts.expect = 'fail' + opts.expect = ExpectedOutcome.FAIL def req_th( name, opts ): """ @@ -210,7 +211,7 @@ def req_th( name, opts ): def req_smp( name, opts ): if not config.have_smp: - opts.expect = 'fail' + opts.expect = ExpectedOutcome.FAIL def ignore_stdout(name, opts): opts.ignore_stdout = True @@ -269,7 +270,7 @@ def expect_broken( bug: IssueNumber ): """ def helper( name: TestName, opts ): record_broken(name, opts, bug) - opts.expect = 'fail'; + opts.expect = ExpectedOutcome.FAIL return helper @@ -291,7 +292,7 @@ def record_broken(name: TestName, opts, bug: IssueNumber): def _expect_pass(way): # Helper function. Not intended for use in .T files. opts = getTestOpts() - return opts.expect == 'pass' and way not in opts.expect_fail_for + return opts.expect == ExpectedOutcome.PASS and way not in opts.expect_fail_for # ----- @@ -869,7 +870,7 @@ def test(name: TestName, executeSetups([thisdir_settings, setup], name, myTestOpts) if name in config.broken_tests: - myTestOpts.expect = 'fail' + myTestOpts.expect = ExpectedOutcome.BROKEN thisTest = lambda watcher: runTest(watcher, myTestOpts, name, func, args) if myTestOpts.alone: @@ -1081,14 +1082,14 @@ def do_test(name: TestName, print_output = config.verbose >= 3) # If user used expect_broken then don't record failures of pre_cmd - if exit_code != 0 and opts.expect not in ['fail']: + if exit_code != 0 and opts.expect not in [ExpectedOutcome.FAIL]: framework_fail(name, way, 'pre_cmd failed: {0}'.format(exit_code)) if_verbose(1, '** pre_cmd was "{0}".'.format(override_options(opts.pre_cmd))) result = func(*[name,way] + args) - if opts.expect not in ['pass', 'fail', 'missing-lib']: - framework_fail(name, way, 'bad expected ' + opts.expect) + if opts.expect not in [ExpectedOutcome.PASS, ExpectedOutcome.FAIL, ExpectedOutcome.MISSING_LIB]: + framework_fail(name, way, 'bad expected ' + opts.expect.value) try: passFail = result.passFail @@ -1126,7 +1127,7 @@ def do_test(name: TestName, stderr=result.stderr) t.unexpected_failures.append(tr) else: - if opts.expect == 'missing-lib': + if opts.expect == ExpectedOutcome.MISSING_LIB: t.missing_libs.append(TestResult(directory, name, 'missing-lib', way)) else: t.n_expected_failures += 1 @@ -1406,6 +1407,10 @@ def check_stats(name: TestName, stats_file: Path, range_fields: Dict[MetricName, MetricOracles] ) -> PassFail: + if getTestOpts().expect == ExpectedOutcome.BROKEN: + print('Skipping performance metrics test on broken test {}'.format(name)) + return passed() + head_commit = Perf.commit_hash(GitRef('HEAD')) if Perf.inside_git_repo() else None if head_commit is None: return passed() @@ -1958,7 +1963,7 @@ def compare_outputs(way: WayName, elif diff_file: diff_file.open('ab').close() # Make sure the file exists still as # we will try to read it later - if config.accept and (getTestOpts().expect == 'fail' or + if config.accept and (getTestOpts().expect == ExpectedOutcome.FAIL or way in getTestOpts().expect_fail_for): if_verbose(1, 'Test is expected to fail. Not accepting new output.') return False View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/27c7fd08326549339909deda5b64370441d2f45f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/27c7fd08326549339909deda5b64370441d2f45f You're receiving 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 Mar 30 16:45:14 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Mon, 30 Mar 2020 12:45:14 -0400 Subject: [Git][ghc/ghc][wip/tycl-group] 44 commits: Refactoring: use Platform instead of DynFlags when possible Message-ID: <5e82221af3d68_6167e0e2c9414966b2@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/tycl-group at Glasgow Haskell Compiler / GHC Commits: 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. - - - - - 4fc76474 by Vladislav Zavialov at 2020-03-30T19:41:03+03:00 Handle sigs in separate TyClGroups Fixing #12088 implies that we put declarations and definitions in separate TyClGroups. Consider this example: {-# LANGUAGE StandaloneKindSignatures #-} import Data.Kind (Type) type X :: Type data X If the renamer puts type X :: Type and data X into separate TyClGroups, then the type checker must be prepared to handle it. Before this patch, the type checker always assumed that signatures were put into the same TyClGroup as the definition. After this patch, no such assumption is made. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/linters/check-cpp.py - compiler/GHC.hs - 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/BlockId.hs - compiler/GHC/Cmm/BlockId.hs-boot - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow.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.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/Ppr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2d7968dd8b157b9875a5de475887ab15ac666e23...4fc76474432aa891de56cdcdeddff1ddfeda0025 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2d7968dd8b157b9875a5de475887ab15ac666e23...4fc76474432aa891de56cdcdeddff1ddfeda0025 You're receiving 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 Mar 30 16:57:22 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Mon, 30 Mar 2020 12:57:22 -0400 Subject: [Git][ghc/ghc][wip/T17923] 18 commits: Remove unused `ghciTablesNextToCode` from compiler proper Message-ID: <5e8224f25852_61673f8198ee100c1503221@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T17923 at Glasgow Haskell Compiler / GHC Commits: 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. - - - - - cd2884bd by Simon Peyton Jones at 2020-03-30T17:31:14+01: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 - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC.hs - 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/BlockId.hs - compiler/GHC/Cmm/BlockId.hs-boot - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow.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.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/Ppr.hs - compiler/GHC/Cmm/ProcPoint.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Switch/Implement.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/1e135c8aa46f056aa6bdbd5a31d6da0dabdf0c0e...cd2884bdffc8ed0c2fba8d974a4812758767ca82 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1e135c8aa46f056aa6bdbd5a31d6da0dabdf0c0e...cd2884bdffc8ed0c2fba8d974a4812758767ca82 You're receiving 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 Mar 30 16:59:43 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Mon, 30 Mar 2020 12:59:43 -0400 Subject: [Git][ghc/ghc][wip/T17917] 46 commits: Update "GHC differences to the FFI Chapter" in user guide. Message-ID: <5e82257f3d8d8_6167e0e2c9415080f2@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T17917 at Glasgow Haskell Compiler / GHC Commits: 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. - - - - - 4b62b5c8 by Simon Peyton Jones at 2020-03-30T17:59:28+01:00 Avoid useless w/w split This patch is just a tidy-up for the post-strictness-analysis worker wrapper split. Consider f x = x Strictnesss analysis does not lead to a w/w split, so the obvious thing is to leave it 100% alone. But actually, because the RHS is small, we ended up adding a StableUnfolding for it. There is some reason to do this if we choose /not/ do to w/w on the grounds that the function is small. See Note [Don't w/w inline small non-loop-breaker things] But there is no reason if we would not have done w/w anyway. This patch just moves the conditional to later. Easy. This does move soem -ddump-simpl printouts around a bit. I also discovered that the previous code was overwritten an InlineCompulsory with InlineStable, which is utterly wrong. That in turn meant that some default methods (marked InlineCompulsory) were getting their InlineCompulsory squashed. This patch fixes that bug --- but of course that does mean a bit more inlining! - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/linters/check-cpp.py - compiler/GHC.hs - 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/BlockId.hs - compiler/GHC/Cmm/BlockId.hs-boot - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow.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.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/Ppr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/761e957095ebb15cb67ebffca0390c16643511c9...4b62b5c8e6815b4d0451b1cd3d4a873bd1934e3f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/761e957095ebb15cb67ebffca0390c16643511c9...4b62b5c8e6815b4d0451b1cd3d4a873bd1934e3f You're receiving 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 Mar 30 18:07:55 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 30 Mar 2020 14:07:55 -0400 Subject: [Git][ghc/ghc][wip/T17987] 2 commits: testsuite: Refactor representation of expected test outcomes Message-ID: <5e82357ba6e76_61671196b3f4152826b@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T17987 at Glasgow Haskell Compiler / GHC Commits: 7bcd37e5 by Ben Gamari at 2020-03-30T14:06:52-04:00 testsuite: Refactor representation of expected test outcomes This turns the the expected test outcome from a str into a proper enumeration. - - - - - 1de44aa1 by Ben Gamari at 2020-03-30T14:07:32-04:00 testsuite: Don't consider stat measurements from broken tests" Previously we would add statistics from tests marked as broken to the stats output. This broke in #17987 since the test was considered to be "broken" solely on the basis of its allocations. In later testsuite runs the "broken" allocations metric was then considered to be the baseline and the test started unexpectedly passing. We now ignore metrics that arise from tests marked as broken. Of course, this required that we distinguish between "broken" and merely "expected to fail". I took this opportunity to do a bit of refactoring in our representation of test outcomes. - - - - - 2 changed files: - testsuite/driver/testglobals.py - testsuite/driver/testlib.py Changes: ===================================== testsuite/driver/testglobals.py ===================================== @@ -6,6 +6,7 @@ from my_typing import * from pathlib import Path from perf_notes import MetricChange, PerfStat, Baseline, MetricOracles from datetime import datetime +from enum import Enum # ----------------------------------------------------------------------------- # Configuration info @@ -261,6 +262,20 @@ t = TestRun() def getTestRun() -> TestRun: return t +class ExpectedOutcome(Enum): + """ + Whether we expect a test to pass or why it we expect it to fail. + """ + + # The test should pass + PASS = 'pass' + # The test should fail (e.g. when testing an error message) + FAIL = 'fail' + # The test should fail because it is currently broken + BROKEN = 'broken' + # The test should fail because we are lacking a library it requires + MISSING_LIB = 'missing-lib' + # ----------------------------------------------------------------------------- # Information about the current test @@ -282,7 +297,7 @@ class TestOptions: self.extra_ways = [] # type: List[WayName] # the result we normally expect for this test - self.expect = 'pass' + self.expect = ExpectedOutcome.PASS # type: ExpectedOutcome # override the expected result for certain ways self.expect_fail_for = [] # type: List[WayName] ===================================== testsuite/driver/testlib.py ===================================== @@ -19,7 +19,8 @@ import collections import subprocess from testglobals import config, ghc_env, default_testopts, brokens, t, \ - TestRun, TestResult, TestOptions, PerfMetric + TestRun, TestResult, TestOptions, PerfMetric, \ + ExpectedOutcome from testutil import strip_quotes, lndir, link_or_copy_file, passed, \ failBecause, testing_metrics, \ PassFail @@ -114,7 +115,7 @@ def expect_fail( name, opts ): # The compiler, testdriver, OS or platform is missing a certain # feature, and we don't plan to or can't fix it now or in the # future. - opts.expect = 'fail'; + opts.expect = ExpectedOutcome.FAIL def reqlib( lib ): return lambda name, opts, l=lib: _reqlib (name, opts, l ) @@ -174,28 +175,28 @@ def have_library(lib: str) -> bool: def _reqlib( name, opts, lib ): if not have_library(lib): - opts.expect = 'missing-lib' + opts.expect = ExpectedOutcome.MISSING_LIB def req_haddock( name, opts ): if not config.haddock: - opts.expect = 'missing-lib' + opts.expect = ExpectedOutcome.MISSING_LIB def req_profiling( name, opts ): '''Require the profiling libraries (add 'GhcLibWays += p' to mk/build.mk)''' if not config.have_profiling: - opts.expect = 'fail' + opts.expect = ExpectedOutcome.FAIL def req_shared_libs( name, opts ): if not config.have_shared_libs: - opts.expect = 'fail' + opts.expect = ExpectedOutcome.FAIL def req_interp( name, opts ): if not config.have_interp: - opts.expect = 'fail' + opts.expect = ExpectedOutcome.FAIL def req_rts_linker( name, opts ): if not config.have_RTS_linker: - opts.expect = 'fail' + opts.expect = ExpectedOutcome.FAIL def req_th( name, opts ): """ @@ -210,7 +211,7 @@ def req_th( name, opts ): def req_smp( name, opts ): if not config.have_smp: - opts.expect = 'fail' + opts.expect = ExpectedOutcome.FAIL def ignore_stdout(name, opts): opts.ignore_stdout = True @@ -269,7 +270,7 @@ def expect_broken( bug: IssueNumber ): """ def helper( name: TestName, opts ): record_broken(name, opts, bug) - opts.expect = 'fail'; + opts.expect = ExpectedOutcome.FAIL return helper @@ -291,7 +292,7 @@ def record_broken(name: TestName, opts, bug: IssueNumber): def _expect_pass(way): # Helper function. Not intended for use in .T files. opts = getTestOpts() - return opts.expect == 'pass' and way not in opts.expect_fail_for + return opts.expect == ExpectedOutcome.PASS and way not in opts.expect_fail_for # ----- @@ -869,7 +870,7 @@ def test(name: TestName, executeSetups([thisdir_settings, setup], name, myTestOpts) if name in config.broken_tests: - myTestOpts.expect = 'fail' + myTestOpts.expect = ExpectedOutcome.BROKEN thisTest = lambda watcher: runTest(watcher, myTestOpts, name, func, args) if myTestOpts.alone: @@ -1081,14 +1082,14 @@ def do_test(name: TestName, print_output = config.verbose >= 3) # If user used expect_broken then don't record failures of pre_cmd - if exit_code != 0 and opts.expect not in ['fail']: + if exit_code != 0 and opts.expect not in [ExpectedOutcome.FAIL]: framework_fail(name, way, 'pre_cmd failed: {0}'.format(exit_code)) if_verbose(1, '** pre_cmd was "{0}".'.format(override_options(opts.pre_cmd))) result = func(*[name,way] + args) - if opts.expect not in ['pass', 'fail', 'missing-lib']: - framework_fail(name, way, 'bad expected ' + opts.expect) + if opts.expect not in [ExpectedOutcome.PASS, ExpectedOutcome.FAIL, ExpectedOutcome.MISSING_LIB]: + framework_fail(name, way, 'bad expected ' + opts.expect.value) try: passFail = result.passFail @@ -1126,7 +1127,7 @@ def do_test(name: TestName, stderr=result.stderr) t.unexpected_failures.append(tr) else: - if opts.expect == 'missing-lib': + if opts.expect == ExpectedOutcome.MISSING_LIB: t.missing_libs.append(TestResult(directory, name, 'missing-lib', way)) else: t.n_expected_failures += 1 @@ -1406,6 +1407,10 @@ def check_stats(name: TestName, stats_file: Path, range_fields: Dict[MetricName, MetricOracles] ) -> PassFail: + if getTestOpts().expect == ExpectedOutcome.BROKEN: + print('Skipping performance metrics test on broken test {}'.format(name)) + return passed() + head_commit = Perf.commit_hash(GitRef('HEAD')) if Perf.inside_git_repo() else None if head_commit is None: return passed() @@ -1958,7 +1963,7 @@ def compare_outputs(way: WayName, elif diff_file: diff_file.open('ab').close() # Make sure the file exists still as # we will try to read it later - if config.accept and (getTestOpts().expect == 'fail' or + if config.accept and (getTestOpts().expect == ExpectedOutcome.FAIL or way in getTestOpts().expect_fail_for): if_verbose(1, 'Test is expected to fail. Not accepting new output.') return False View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/27c7fd08326549339909deda5b64370441d2f45f...1de44aa1c09ee35b7775354f380f8c9054b1220a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/27c7fd08326549339909deda5b64370441d2f45f...1de44aa1c09ee35b7775354f380f8c9054b1220a You're receiving 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 Mar 30 19:19:07 2020 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Mon, 30 Mar 2020 15:19:07 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/absolute-i-paths Message-ID: <5e82462b4f303_616776d1c7415446d6@gitlab.haskell.org.mail> Matthew Pickering pushed new branch wip/absolute-i-paths at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/absolute-i-paths You're receiving 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 Mar 30 19:46:29 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 30 Mar 2020 15:46:29 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T17977 Message-ID: <5e824c955c65_61676830044155388c@gitlab.haskell.org.mail> Sebastian Graf pushed new branch wip/T17977 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T17977 You're receiving 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 Mar 30 19:48:41 2020 From: gitlab at gitlab.haskell.org (Simon Jakobi) Date: Mon, 30 Mar 2020 15:48:41 -0400 Subject: [Git][ghc/ghc][wip/T16806] 550 commits: Factor out HsSCC/HsCoreAnn/HsTickPragma into HsPragE Message-ID: <5e824d19b1377_61671196b3f4156297b@gitlab.haskell.org.mail> Simon Jakobi pushed to branch wip/T16806 at Glasgow Haskell Compiler / GHC Commits: 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. - - - - - 8ce174b1 by Simon Jakobi at 2020-03-30T21:43:46+02:00 Use the new IntMap.disjoint function Fixes #16806. - - - - - 15 changed files: - .ghcid - .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 - HACKING.md - aclocal.m4 - boot - + compiler/GHC.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f2e3557544e13dc5247c8f8dc1ef2bb3e547e444...8ce174b180ab157b4e4d7d1693ca086d5bf17bf6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f2e3557544e13dc5247c8f8dc1ef2bb3e547e444...8ce174b180ab157b4e4d7d1693ca086d5bf17bf6 You're receiving 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 Mar 30 20:14:46 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 30 Mar 2020 16:14:46 -0400 Subject: [Git][ghc/ghc][master] Expect T4267 to pass Message-ID: <5e825336275f0_6167e0e2c941587316@gitlab.haskell.org.mail> Ben Gamari pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 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. - - - - - 1 changed file: - testsuite/tests/perf/should_run/all.T Changes: ===================================== testsuite/tests/perf/should_run/all.T ===================================== @@ -233,8 +233,7 @@ test('T5949', ['-O']) test('T4267', - [expect_broken(4267), - collect_stats('bytes allocated',10), + [collect_stats('bytes allocated',10), only_ways(['normal'])], compile_and_run, ['-O']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f024b6e385bd1448968b7bf20de05f655c815bae -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f024b6e385bd1448968b7bf20de05f655c815bae You're receiving 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 Mar 30 20:19:36 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 30 Mar 2020 16:19:36 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: Expect T4267 to pass Message-ID: <5e825458ece4_61677b155d815900ee@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 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. - - - - - 13cb3986 by Ryan Scott at 2020-03-30T16:19:16-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. - - - - - 84a45221 by Ryan Scott at 2020-03-30T16:19:17-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. - - - - - f6977781 by Ömer Sinan Ağacan at 2020-03-30T16:19:22-04:00 Simplify stderrSupportsAnsiColors The combinator andM is used only once, and the code is shorter and simpler if you inline it. - - - - - 761c2abd by Ben Gamari at 2020-03-30T16:19:23-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. - - - - - 09ca5098 by Andreas Klebinger at 2020-03-30T16:19:23-04:00 Update hadrian index revision. Required in order to build hadrian using ghc-8.10 - - - - - 28 changed files: - .gitlab-ci.yml - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Op/ConstantFold.hs - compiler/GHC/Core/Op/Specialise.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Types/Unique/Supply.hs - compiler/main/SysTools/Process.hs - compiler/main/SysTools/Terminal.hs - compiler/typecheck/TcRnTypes.hs - compiler/typecheck/TcSMonad.hs - compiler/utils/Binary.hs - compiler/utils/IOEnv.hs - configure.ac - hadrian/cabal.project - hadrian/src/Hadrian/Utilities.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Ghc.hs - libraries/base/Control/Monad/ST/Lazy/Imp.hs - libraries/base/GHC/IO/Encoding.hs - libraries/base/GHC/ST.hs - libraries/base/Text/ParserCombinators/ReadPrec.hs - libraries/ghci/GHCi/TH.hs - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - testsuite/tests/perf/should_run/all.T - + testsuite/tests/polykinds/T17963.hs - + testsuite/tests/polykinds/T17963.stderr - testsuite/tests/polykinds/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: 408eff66aef6ca2b44446c694c5a56d6ca0460cc + DOCKER_REV: 3f731f5d37a156e7ebe10cd32656946083baaf4a # Sequential version number capturing the versions of all tools fetched by # .gitlab/ci.sh. @@ -390,7 +390,7 @@ validate-x86_64-darwin: tags: - x86_64-darwin variables: - GHC_VERSION: 8.6.5 + GHC_VERSION: 8.8.3 CABAL_INSTALL_VERSION: 3.0.0.0 BIN_DIST_PREP_TAR_COMP: "ghc-x86_64-apple-darwin.tar.xz" MACOSX_DEPLOYMENT_TARGET: "10.7" @@ -419,7 +419,7 @@ validate-x86_64-darwin: tags: - x86_64-darwin variables: - GHC_VERSION: 8.6.3 + GHC_VERSION: 8.8.3 MACOSX_DEPLOYMENT_TARGET: "10.7" ac_cv_func_clock_gettime: "no" LANG: "en_US.UTF-8" ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -70,7 +70,6 @@ import GHC.Types.Demand ( splitStrictSig, isBotDiv ) import GHC.Driver.Types import GHC.Driver.Session import Control.Monad -import qualified Control.Monad.Fail as MonadFail import MonadUtils import Data.Foldable ( toList ) import Data.List.NonEmpty ( NonEmpty ) @@ -2249,16 +2248,13 @@ instance Applicative LintM where (<*>) = ap instance Monad LintM where -#if !MIN_VERSION_base(4,13,0) - fail = MonadFail.fail -#endif m >>= k = LintM (\ env errs -> let (res, errs') = unLintM m env errs in case res of Just r -> unLintM (k r) env errs' Nothing -> (Nothing, errs')) -instance MonadFail.MonadFail LintM where +instance MonadFail LintM where fail err = failWithL (text err) instance HasDynFlags LintM where ===================================== compiler/GHC/Core/Make.hs ===================================== @@ -85,7 +85,6 @@ import Util import Data.List import Data.Char ( ord ) -import Control.Monad.Fail as MonadFail ( MonadFail ) infixl 4 `mkCoreApp`, `mkCoreApps` @@ -640,7 +639,7 @@ mkFoldrExpr elt_ty result_ty c n list = do `App` list) -- | Make a 'build' expression applied to a locally-bound worker function -mkBuildExpr :: (MonadFail.MonadFail m, MonadThings m, MonadUnique m) +mkBuildExpr :: (MonadFail m, MonadThings m, MonadUnique m) => Type -- ^ Type of list elements to be built -> ((Id, Type) -> (Id, Type) -> m CoreExpr) -- ^ Function that, given information about the 'Id's -- of the binders for the build worker function, returns ===================================== compiler/GHC/Core/Op/ConstantFold.hs ===================================== @@ -61,7 +61,6 @@ import GHC.Core.Coercion (mkUnbranchedAxInstCo,mkSymCo,Role(..)) import Control.Applicative ( Alternative(..) ) import Control.Monad -import qualified Control.Monad.Fail as MonadFail import Data.Bits as Bits import qualified Data.ByteString as BS import Data.Int @@ -796,11 +795,7 @@ instance Monad RuleM where Nothing -> Nothing Just r -> runRuleM (g r) env iu fn args -#if !MIN_VERSION_base(4,13,0) - fail = MonadFail.fail -#endif - -instance MonadFail.MonadFail RuleM where +instance MonadFail RuleM where fail _ = mzero instance Alternative RuleM where ===================================== compiler/GHC/Core/Op/Specialise.hs ===================================== @@ -50,7 +50,6 @@ import GHC.Types.Unique.DFM import GHC.Core.TyCo.Rep (TyCoBinder (..)) import Control.Monad -import qualified Control.Monad.Fail as MonadFail {- ************************************************************************ @@ -2551,11 +2550,8 @@ instance Monad SpecM where case f y of SpecM z -> z -#if !MIN_VERSION_base(4,13,0) - fail = MonadFail.fail -#endif -instance MonadFail.MonadFail SpecM where +instance MonadFail SpecM where fail str = SpecM $ error str instance MonadUnique SpecM where ===================================== compiler/GHC/Core/Unify.hs ===================================== @@ -46,7 +46,6 @@ import GHC.Types.Unique.FM import GHC.Types.Unique.Set import Control.Monad -import qualified Control.Monad.Fail as MonadFail import Control.Applicative hiding ( empty ) import qualified Control.Applicative @@ -1244,9 +1243,6 @@ instance Applicative UM where (<*>) = ap instance Monad UM where -#if !MIN_VERSION_base(4,13,0) - fail = MonadFail.fail -#endif m >>= k = UM (\state -> do { (state', v) <- unUM m state ; unUM (k v) state' }) @@ -1260,7 +1256,7 @@ instance Alternative UM where instance MonadPlus UM -instance MonadFail.MonadFail UM where +instance MonadFail UM where fail _ = UM (\_ -> SurelyApart) -- failed pattern match initUM :: TvSubstEnv -- subst to extend ===================================== compiler/GHC/Types/Unique/Supply.hs ===================================== @@ -44,7 +44,6 @@ import MonadUtils import Control.Monad import Data.Bits import Data.Char -import Control.Monad.Fail as Fail #include "Unique.h" @@ -156,7 +155,7 @@ instance Applicative UniqSM where (*>) = thenUs_ -- TODO: try to get rid of this instance -instance Fail.MonadFail UniqSM where +instance MonadFail UniqSM where fail = panic -- | Run the 'UniqSM' action, returning the final 'UniqSupply' ===================================== compiler/main/SysTools/Process.hs ===================================== @@ -36,14 +36,10 @@ import FileCleanup -- @process >= 1.6.8.0@). enableProcessJobs :: CreateProcess -> CreateProcess #if defined(MIN_VERSION_process) -#if MIN_VERSION_process(1,6,8) enableProcessJobs opts = opts { use_process_jobs = True } #else enableProcessJobs opts = opts #endif -#else -enableProcessJobs opts = opts -#endif -- Similar to System.Process.readCreateProcessWithExitCode, but stderr is -- inherited from the parent process, and output to stderr is not captured. ===================================== compiler/main/SysTools/Terminal.hs ===================================== @@ -32,20 +32,13 @@ import qualified System.Win32 as Win32 stderrSupportsAnsiColors :: IO Bool stderrSupportsAnsiColors = do #if defined(MIN_VERSION_terminfo) - queryTerminal stdError `andM` do - (termSupportsColors <$> setupTermFromEnv) - `catch` \ (_ :: SetupTermError) -> - pure False - + stderr_available <- queryTerminal stdError + if stderr_available then + fmap termSupportsColors setupTermFromEnv + `catch` \ (_ :: SetupTermError) -> pure False + else + pure False where - - andM :: Monad m => m Bool -> m Bool -> m Bool - andM mx my = do - x <- mx - if x - then my - else pure x - termSupportsColors :: Terminal -> Bool termSupportsColors term = fromMaybe 0 (getCapability term termColors) > 0 ===================================== compiler/typecheck/TcRnTypes.hs ===================================== @@ -124,7 +124,6 @@ import PrelNames ( isUnboundName ) import GHC.Types.CostCentre.State import Control.Monad (ap) -import qualified Control.Monad.Fail as MonadFail import Data.Set ( Set ) import qualified Data.Set as S @@ -1653,14 +1652,11 @@ instance Applicative TcPluginM where (<*>) = ap instance Monad TcPluginM where -#if !MIN_VERSION_base(4,13,0) - fail = MonadFail.fail -#endif TcPluginM m >>= k = TcPluginM (\ ev -> do a <- m ev runTcPluginM (k a) ev) -instance MonadFail.MonadFail TcPluginM where +instance MonadFail TcPluginM where fail x = TcPluginM (const $ fail x) runTcPluginM :: TcPluginM a -> EvBindsVar -> TcM a ===================================== compiler/typecheck/TcSMonad.hs ===================================== @@ -177,7 +177,6 @@ import Maybes import GHC.Core.Map import Control.Monad -import qualified Control.Monad.Fail as MonadFail import MonadUtils import Data.IORef import Data.List ( partition, mapAccumL ) @@ -2699,12 +2698,9 @@ instance Applicative TcS where (<*>) = ap instance Monad TcS where -#if !MIN_VERSION_base(4,13,0) - fail = MonadFail.fail -#endif m >>= k = TcS (\ebs -> unTcS m ebs >>= \r -> unTcS (k r) ebs) -instance MonadFail.MonadFail TcS where +instance MonadFail TcS where fail err = TcS (\_ -> fail err) instance MonadUnique TcS where ===================================== compiler/utils/Binary.hs ===================================== @@ -829,12 +829,10 @@ instance Binary RuntimeRep where put_ bh AddrRep = putByte bh 9 put_ bh FloatRep = putByte bh 10 put_ bh DoubleRep = putByte bh 11 -#if __GLASGOW_HASKELL__ >= 807 put_ bh Int8Rep = putByte bh 12 put_ bh Word8Rep = putByte bh 13 put_ bh Int16Rep = putByte bh 14 put_ bh Word16Rep = putByte bh 15 -#endif #if __GLASGOW_HASKELL__ >= 809 put_ bh Int32Rep = putByte bh 16 put_ bh Word32Rep = putByte bh 17 @@ -855,12 +853,10 @@ instance Binary RuntimeRep where 9 -> pure AddrRep 10 -> pure FloatRep 11 -> pure DoubleRep -#if __GLASGOW_HASKELL__ >= 807 12 -> pure Int8Rep 13 -> pure Word8Rep 14 -> pure Int16Rep 15 -> pure Word16Rep -#endif #if __GLASGOW_HASKELL__ >= 809 16 -> pure Int32Rep 17 -> pure Word32Rep ===================================== compiler/utils/IOEnv.hs ===================================== @@ -43,7 +43,6 @@ import Data.IORef ( IORef, newIORef, readIORef, writeIORef, modifyIORef, import System.IO.Unsafe ( unsafeInterleaveIO ) import System.IO ( fixIO ) import Control.Monad -import qualified Control.Monad.Fail as MonadFail import MonadUtils import Control.Applicative (Alternative(..)) @@ -60,11 +59,8 @@ unIOEnv (IOEnv m) = m instance Monad (IOEnv m) where (>>=) = thenM (>>) = (*>) -#if !MIN_VERSION_base(4,13,0) - fail = MonadFail.fail -#endif -instance MonadFail.MonadFail (IOEnv m) where +instance MonadFail (IOEnv m) where fail _ = failM -- Ignore the string instance Applicative (IOEnv m) where ===================================== configure.ac ===================================== @@ -158,8 +158,8 @@ if test "$WithGhc" = "" then AC_MSG_ERROR([GHC is required.]) fi -FP_COMPARE_VERSIONS([$GhcVersion],[-lt],[8.6], - [AC_MSG_ERROR([GHC version 8.6 or later is required to compile GHC.])]) +FP_COMPARE_VERSIONS([$GhcVersion],[-lt],[8.8], + [AC_MSG_ERROR([GHC version 8.8 or later is required to compile GHC.])]) if test `expr $GhcMinVersion % 2` = "1" then ===================================== hadrian/cabal.project ===================================== @@ -1,7 +1,7 @@ packages: ./ -- This essentially freezes the build plan for hadrian -index-state: 2019-12-16T07:24:23Z +index-state: 2020-03-28T07:24:23Z -- N.B. Compile with -O0 since this is not a performance-critical executable -- and the Cabal takes nearly twice as long to build with -O1. See #16817. ===================================== hadrian/src/Hadrian/Utilities.hs ===================================== @@ -40,7 +40,6 @@ import Data.Char import Data.Dynamic (Dynamic, fromDynamic, toDyn) import Data.Functor import Data.HashMap.Strict (HashMap) -import Data.List (isPrefixOf) import Data.List.Extra import Data.Maybe import Data.Typeable (TypeRep, typeOf) ===================================== hadrian/src/Settings/Builders/Cabal.hs ===================================== @@ -1,6 +1,5 @@ module Settings.Builders.Cabal (cabalBuilderArgs) where -import Hadrian.Builder (getBuilderPath, needBuilder) import Hadrian.Haskell.Cabal import Builder ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -2,8 +2,6 @@ module Settings.Builders.Ghc (ghcBuilderArgs, haddockGhcArgs) where -import Data.List.Extra (splitOn) - import Hadrian.Haskell.Cabal import Hadrian.Haskell.Cabal.Type ===================================== libraries/base/Control/Monad/ST/Lazy/Imp.hs ===================================== @@ -8,7 +8,7 @@ -- Module : Control.Monad.ST.Lazy.Imp -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) --- +-- -- Maintainer : libraries at haskell.org -- Stability : provisional -- Portability : non-portable (requires universal quantification for runST) @@ -44,7 +44,6 @@ import qualified Control.Monad.ST.Unsafe as ST import qualified GHC.ST as GHC.ST import GHC.Base -import qualified Control.Monad.Fail as Fail -- | The lazy @'ST' monad. -- The ST monad allows for destructive updates, but is escapable (unlike IO). @@ -192,7 +191,7 @@ instance Monad (ST s) where unST (k r) new_s -- | @since 4.10 -instance Fail.MonadFail (ST s) where +instance MonadFail (ST s) where fail s = errorWithoutStackTrace s -- | Return the value computed by an 'ST' computation. @@ -205,8 +204,8 @@ runST (ST st) = runRW# (\s -> case st (S# s) of (r, _) -> r) -- inside the computation. -- Note that if @f@ is strict, @'fixST' f = _|_ at . fixST :: (a -> ST s a) -> ST s a -fixST m = ST (\ s -> - let +fixST m = ST (\ s -> + let q@(r,_s') = unST (m r) s in q) -- Why don't we need unsafePerformIO in fixST? We create a thunk, q, @@ -233,7 +232,7 @@ strictToLazyST (GHC.ST.ST m) = ST $ \(S# s) -> (# s', a #) -> (a, S# s') -- See Note [Lazy ST: not producing lazy pairs] -{-| +{-| Convert a lazy 'ST' computation into a strict one. -} lazyToStrictST :: ST s a -> ST.ST s a ===================================== libraries/base/GHC/IO/Encoding.hs ===================================== @@ -107,6 +107,7 @@ utf32be = UTF32.utf32be -- -- @since 4.5.0.0 getLocaleEncoding :: IO TextEncoding +{-# NOINLINE getLocaleEncoding #-} -- | The Unicode encoding of the current locale, but allowing arbitrary -- undecodable bytes to be round-tripped through it. @@ -120,6 +121,7 @@ getLocaleEncoding :: IO TextEncoding -- -- @since 4.5.0.0 getFileSystemEncoding :: IO TextEncoding +{-# NOINLINE getFileSystemEncoding #-} -- | The Unicode encoding of the current locale, but where undecodable -- bytes are replaced with their closest visual match. Used for @@ -127,9 +129,13 @@ getFileSystemEncoding :: IO TextEncoding -- -- @since 4.5.0.0 getForeignEncoding :: IO TextEncoding +{-# NOINLINE getForeignEncoding #-} -- | @since 4.5.0.0 setLocaleEncoding, setFileSystemEncoding, setForeignEncoding :: TextEncoding -> IO () +{-# NOINLINE setLocaleEncoding #-} +{-# NOINLINE setFileSystemEncoding #-} +{-# NOINLINE setForeignEncoding #-} (getLocaleEncoding, setLocaleEncoding) = mkGlobal initLocaleEncoding (getFileSystemEncoding, setFileSystemEncoding) = mkGlobal initFileSystemEncoding @@ -139,9 +145,13 @@ mkGlobal :: a -> (IO a, a -> IO ()) mkGlobal x = unsafePerformIO $ do x_ref <- newIORef x return (readIORef x_ref, writeIORef x_ref) +{-# NOINLINE mkGlobal #-} -- | @since 4.5.0.0 initLocaleEncoding, initFileSystemEncoding, initForeignEncoding :: TextEncoding +{-# NOINLINE initLocaleEncoding #-} +-- N.B. initLocaleEncoding is exported for use in System.IO.localeEncoding. +-- NOINLINE ensures that this result is shared. #if !defined(mingw32_HOST_OS) -- It is rather important that we don't just call Iconv.mkIconvEncoding here ===================================== libraries/base/GHC/ST.hs ===================================== @@ -26,7 +26,7 @@ module GHC.ST ( import GHC.Base import GHC.Show -import qualified Control.Monad.Fail as Fail +import Control.Monad.Fail default () @@ -79,7 +79,7 @@ instance Monad (ST s) where (k2 new_s) }}) -- | @since 4.11.0.0 -instance Fail.MonadFail (ST s) where +instance MonadFail (ST s) where fail s = errorWithoutStackTrace s -- | @since 4.11.0.0 ===================================== libraries/base/Text/ParserCombinators/ReadPrec.hs ===================================== @@ -64,7 +64,7 @@ import qualified Text.ParserCombinators.ReadP as ReadP import GHC.Num( Num(..) ) import GHC.Base -import qualified Control.Monad.Fail as MonadFail +import Control.Monad.Fail -- --------------------------------------------------------------------------- -- The readPrec type @@ -88,8 +88,8 @@ instance Monad ReadPrec where P f >>= k = P (\n -> do a <- f n; let P f' = k a in f' n) -- | @since 4.9.0.0 -instance MonadFail.MonadFail ReadPrec where - fail s = P (\_ -> MonadFail.fail s) +instance MonadFail ReadPrec where + fail s = P (\_ -> fail s) -- | @since 2.01 instance MonadPlus ReadPrec ===================================== libraries/ghci/GHCi/TH.hs ===================================== @@ -97,7 +97,6 @@ import GHCi.RemoteTypes import GHC.Serialized import Control.Exception -import qualified Control.Monad.Fail as Fail import Control.Monad.IO.Class (MonadIO (..)) import Data.Binary import Data.Binary.Put @@ -144,11 +143,8 @@ instance Monad GHCiQ where do (m', s') <- runGHCiQ m s (a, s'') <- runGHCiQ (f m') s' return (a, s'') -#if !MIN_VERSION_base(4,13,0) - fail = Fail.fail -#endif -instance Fail.MonadFail GHCiQ where +instance MonadFail GHCiQ where fail err = GHCiQ $ \s -> throwIO (GHCiQException s err) getState :: GHCiQ QState ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -52,15 +52,13 @@ import Numeric.Natural import Prelude import Foreign.ForeignPtr -import qualified Control.Monad.Fail as Fail - ----------------------------------------------------- -- -- The Quasi class -- ----------------------------------------------------- -class (MonadIO m, Fail.MonadFail m) => Quasi m where +class (MonadIO m, MonadFail m) => Quasi m where qNewName :: String -> m Name -- ^ Fresh names @@ -187,12 +185,9 @@ runQ (Q m) = m instance Monad Q where Q m >>= k = Q (m >>= \x -> unQ (k x)) (>>) = (*>) -#if !MIN_VERSION_base(4,13,0) - fail = Fail.fail -#endif -instance Fail.MonadFail Q where - fail s = report True s >> Q (Fail.fail "Q monad failure") +instance MonadFail Q where + fail s = report True s >> Q (fail "Q monad failure") instance Functor Q where fmap f (Q x) = Q (fmap f x) ===================================== testsuite/tests/perf/should_run/all.T ===================================== @@ -233,8 +233,7 @@ test('T5949', ['-O']) test('T4267', - [expect_broken(4267), - collect_stats('bytes allocated',10), + [collect_stats('bytes allocated',10), only_ways(['normal'])], compile_and_run, ['-O']) ===================================== testsuite/tests/polykinds/T17963.hs ===================================== @@ -0,0 +1,15 @@ +{-# Language DataKinds #-} +{-# Language PolyKinds #-} +{-# Language RankNTypes #-} +{-# Language StandaloneKindSignatures #-} +{-# Language TypeApplications #-} +module T17963 where + +import GHC.Types (Constraint, Type, TYPE, RuntimeRep(..)) + +type Cat :: forall (rep :: RuntimeRep). TYPE rep -> Type +type Cat ob = ob -> ob -> Type + +type Category' :: forall rep (ob :: TYPE rep). Cat @rep ob -> Constraint +class Category' (cat :: Cat @rep ob) where + id' :: forall a. cat a a ===================================== testsuite/tests/polykinds/T17963.stderr ===================================== @@ -0,0 +1,13 @@ + +T17963.hs:15:23: error: + • Couldn't match a lifted type with an unlifted type + ‘rep1’ is a rigid type variable bound by + the class declaration for ‘Category'’ + at T17963.hs:13:27-29 + When matching kinds + k0 :: * + ob :: TYPE rep1 + Expected kind ‘ob’, but ‘a’ has kind ‘k0’ + • In the first argument of ‘cat’, namely ‘a’ + In the type signature: id' :: forall a. cat a a + In the class declaration for ‘Category'’ ===================================== testsuite/tests/polykinds/all.T ===================================== @@ -216,3 +216,4 @@ test('T16263', normal, compile_fail, ['']) test('T16902', normal, compile_fail, ['']) test('CuskFam', normal, compile, ['']) test('T17841', normal, compile_fail, ['']) +test('T17963', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/58aba3e6baffe815f17a331eaa77f37c955fa2be...09ca509813d913eb895a8edac961ed7a6bd644a7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/58aba3e6baffe815f17a331eaa77f37c955fa2be...09ca509813d913eb895a8edac961ed7a6bd644a7 You're receiving 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 Mar 30 20:41:50 2020 From: gitlab at gitlab.haskell.org (Andreas Klebinger) Date: Mon, 30 Mar 2020 16:41:50 -0400 Subject: [Git][ghc/ghc][wip/andreask/tools_unlines] 2 commits: Expect T4267 to pass Message-ID: <5e82598edf7b3_6167e0e2c9416055a6@gitlab.haskell.org.mail> Andreas Klebinger pushed to branch wip/andreask/tools_unlines at Glasgow Haskell Compiler / GHC Commits: 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. - - - - - 4a8d552c by Andreas Klebinger at 2020-03-30T16:41:48-04:00 Turn newlines into spaces for hadrian/ghci. The newlines break the command on windows. - - - - - 3 changed files: - hadrian/ghci-cabal - hadrian/ghci-stack - testsuite/tests/perf/should_run/all.T Changes: ===================================== hadrian/ghci-cabal ===================================== @@ -2,5 +2,5 @@ set -e -GHC_FLAGS="$GHC_FLAGS $(TERM=dumb CABFLAGS=-v0 "hadrian/build-cabal" tool-args -q --build-root=.hadrian_ghci --flavour=ghc-in-ghci "$@")" +GHC_FLAGS="$GHC_FLAGS $(TERM=dumb CABFLAGS=-v0 "hadrian/build-cabal" tool-args -q --build-root=.hadrian_ghci --flavour=ghc-in-ghci "$@" | tr '\n\r' ' ')" ghci $GHC_FLAGS "$@" -fno-code -fwrite-interface -hidir=.hadrian_ghci/interface -O0 ghc/Main.hs +RTS -A128m ===================================== hadrian/ghci-stack ===================================== @@ -2,5 +2,5 @@ set -e -GHC_FLAGS="$GHC_FLAGS $(TERM=dumb CABFLAGS=-v0 "hadrian/build-stack" tool-args -q --build-root=.hadrian_ghci --flavour=ghc-in-ghci "$@")" +GHC_FLAGS="$GHC_FLAGS $(TERM=dumb CABFLAGS=-v0 "hadrian/build-stack" tool-args -q --build-root=.hadrian_ghci --flavour=ghc-in-ghci "$@" | tr '\n\r' ' ')" stack exec -- ghci $GHC_FLAGS "$@" -fno-code -fwrite-interface -hidir=.hadrian_ghci/interface -O0 ghc/Main.hs +RTS -A128m ===================================== testsuite/tests/perf/should_run/all.T ===================================== @@ -233,8 +233,7 @@ test('T5949', ['-O']) test('T4267', - [expect_broken(4267), - collect_stats('bytes allocated',10), + [collect_stats('bytes allocated',10), only_ways(['normal'])], compile_and_run, ['-O']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4209209a73a4b9ff4e41a69809adb0c6e932ecc4...4a8d552c133af58f2f609513c867a44969f7c436 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4209209a73a4b9ff4e41a69809adb0c6e932ecc4...4a8d552c133af58f2f609513c867a44969f7c436 You're receiving 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 Mar 30 20:42:01 2020 From: gitlab at gitlab.haskell.org (Andreas Klebinger) Date: Mon, 30 Mar 2020 16:42:01 -0400 Subject: [Git][ghc/ghc][wip/andreask/bump_integer-gmp] 2 commits: Expect T4267 to pass Message-ID: <5e82599921459_61673f81cca05dd816059e8@gitlab.haskell.org.mail> Andreas Klebinger pushed to branch wip/andreask/bump_integer-gmp at Glasgow Haskell Compiler / GHC Commits: 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. - - - - - 77eaf0a7 by Ben Gamari at 2020-03-30T16:41:57-04:00 integer-gmp: Bump version and add changelog entry - - - - - 3 changed files: - libraries/integer-gmp/changelog.md - libraries/integer-gmp/integer-gmp.cabal - testsuite/tests/perf/should_run/all.T Changes: ===================================== libraries/integer-gmp/changelog.md ===================================== @@ -1,5 +1,11 @@ # Changelog for [`integer-gmp` package](http://hackage.haskell.org/package/integer-gmp) +## 1.0.3.0 *January 2019* + + * Bundled with GHC 8.10.1 + + * Documentation changes + ## 1.0.2.0 *April 2018* * Bundled with GHC 8.4.2 ===================================== libraries/integer-gmp/integer-gmp.cabal ===================================== @@ -1,6 +1,6 @@ cabal-version: 2.0 name: integer-gmp -version: 1.0.2.0 +version: 1.0.3.0 synopsis: Integer library based on GMP license: BSD3 ===================================== testsuite/tests/perf/should_run/all.T ===================================== @@ -233,8 +233,7 @@ test('T5949', ['-O']) test('T4267', - [expect_broken(4267), - collect_stats('bytes allocated',10), + [collect_stats('bytes allocated',10), only_ways(['normal'])], compile_and_run, ['-O']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/904b9a8bc03d74f1a700d667921a6c29ec5e9bc2...77eaf0a7a236bc812d210e912eb52c77de5acb2b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/904b9a8bc03d74f1a700d667921a6c29ec5e9bc2...77eaf0a7a236bc812d210e912eb52c77de5acb2b You're receiving 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 Mar 30 21:05:30 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 30 Mar 2020 17:05:30 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T17962 Message-ID: <5e825f1ac88ba_61677b155d816100a5@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/T17962 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T17962 You're receiving 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 Mar 30 21:08:00 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 30 Mar 2020 17:08:00 -0400 Subject: [Git][ghc/ghc][wip/T17987] Deleted 1 commit: testsuite: Don't consider stat measurements from broken tests" Message-ID: <5e825fb0f40f9_6167683004416132ac@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T17987 at Glasgow Haskell Compiler / GHC WARNING: The push did not contain any new commits, but force pushed to delete the commits and changes below. Deleted commits: 1de44aa1 by Ben Gamari at 2020-03-30T14:07:32-04:00 testsuite: Don't consider stat measurements from broken tests" Previously we would add statistics from tests marked as broken to the stats output. This broke in #17987 since the test was considered to be "broken" solely on the basis of its allocations. In later testsuite runs the "broken" allocations metric was then considered to be the baseline and the test started unexpectedly passing. We now ignore metrics that arise from tests marked as broken. Of course, this required that we distinguish between "broken" and merely "expected to fail". I took this opportunity to do a bit of refactoring in our representation of test outcomes. - - - - - 1 changed file: - testsuite/driver/testlib.py Changes: ===================================== testsuite/driver/testlib.py ===================================== @@ -1407,6 +1407,10 @@ def check_stats(name: TestName, stats_file: Path, range_fields: Dict[MetricName, MetricOracles] ) -> PassFail: + if getTestOpts().expect == ExpectedOutcome.BROKEN: + print('Skipping performance metrics test on broken test {}'.format(name)) + return passed() + head_commit = Perf.commit_hash(GitRef('HEAD')) if Perf.inside_git_repo() else None if head_commit is None: return passed() View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1de44aa1c09ee35b7775354f380f8c9054b1220a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1de44aa1c09ee35b7775354f380f8c9054b1220a You're receiving 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 Mar 30 21:09:48 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 30 Mar 2020 17:09:48 -0400 Subject: [Git][ghc/ghc][wip/T17987] 2 commits: Expect T4267 to pass Message-ID: <5e82601c7b68c_61676830044161507@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T17987 at Glasgow Haskell Compiler / GHC Commits: 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. - - - - - f501d200 by Ben Gamari at 2020-03-30T17:09:41-04:00 testsuite: Refactor representation of expected test outcomes This turns the the expected test outcome from a str into a proper enumeration. - - - - - 3 changed files: - testsuite/driver/testglobals.py - testsuite/driver/testlib.py - testsuite/tests/perf/should_run/all.T Changes: ===================================== testsuite/driver/testglobals.py ===================================== @@ -6,6 +6,7 @@ from my_typing import * from pathlib import Path from perf_notes import MetricChange, PerfStat, Baseline, MetricOracles from datetime import datetime +from enum import Enum # ----------------------------------------------------------------------------- # Configuration info @@ -261,6 +262,20 @@ t = TestRun() def getTestRun() -> TestRun: return t +class ExpectedOutcome(Enum): + """ + Whether we expect a test to pass or why it we expect it to fail. + """ + + # The test should pass + PASS = 'pass' + # The test should fail (e.g. when testing an error message) + FAIL = 'fail' + # The test should fail because it is currently broken + BROKEN = 'broken' + # The test should fail because we are lacking a library it requires + MISSING_LIB = 'missing-lib' + # ----------------------------------------------------------------------------- # Information about the current test @@ -282,7 +297,7 @@ class TestOptions: self.extra_ways = [] # type: List[WayName] # the result we normally expect for this test - self.expect = 'pass' + self.expect = ExpectedOutcome.PASS # type: ExpectedOutcome # override the expected result for certain ways self.expect_fail_for = [] # type: List[WayName] ===================================== testsuite/driver/testlib.py ===================================== @@ -19,7 +19,8 @@ import collections import subprocess from testglobals import config, ghc_env, default_testopts, brokens, t, \ - TestRun, TestResult, TestOptions, PerfMetric + TestRun, TestResult, TestOptions, PerfMetric, \ + ExpectedOutcome from testutil import strip_quotes, lndir, link_or_copy_file, passed, \ failBecause, testing_metrics, \ PassFail @@ -114,7 +115,7 @@ def expect_fail( name, opts ): # The compiler, testdriver, OS or platform is missing a certain # feature, and we don't plan to or can't fix it now or in the # future. - opts.expect = 'fail'; + opts.expect = ExpectedOutcome.FAIL def reqlib( lib ): return lambda name, opts, l=lib: _reqlib (name, opts, l ) @@ -174,28 +175,28 @@ def have_library(lib: str) -> bool: def _reqlib( name, opts, lib ): if not have_library(lib): - opts.expect = 'missing-lib' + opts.expect = ExpectedOutcome.MISSING_LIB def req_haddock( name, opts ): if not config.haddock: - opts.expect = 'missing-lib' + opts.expect = ExpectedOutcome.MISSING_LIB def req_profiling( name, opts ): '''Require the profiling libraries (add 'GhcLibWays += p' to mk/build.mk)''' if not config.have_profiling: - opts.expect = 'fail' + opts.expect = ExpectedOutcome.FAIL def req_shared_libs( name, opts ): if not config.have_shared_libs: - opts.expect = 'fail' + opts.expect = ExpectedOutcome.FAIL def req_interp( name, opts ): if not config.have_interp: - opts.expect = 'fail' + opts.expect = ExpectedOutcome.FAIL def req_rts_linker( name, opts ): if not config.have_RTS_linker: - opts.expect = 'fail' + opts.expect = ExpectedOutcome.FAIL def req_th( name, opts ): """ @@ -210,7 +211,7 @@ def req_th( name, opts ): def req_smp( name, opts ): if not config.have_smp: - opts.expect = 'fail' + opts.expect = ExpectedOutcome.FAIL def ignore_stdout(name, opts): opts.ignore_stdout = True @@ -269,7 +270,7 @@ def expect_broken( bug: IssueNumber ): """ def helper( name: TestName, opts ): record_broken(name, opts, bug) - opts.expect = 'fail'; + opts.expect = ExpectedOutcome.FAIL return helper @@ -291,7 +292,7 @@ def record_broken(name: TestName, opts, bug: IssueNumber): def _expect_pass(way): # Helper function. Not intended for use in .T files. opts = getTestOpts() - return opts.expect == 'pass' and way not in opts.expect_fail_for + return opts.expect == ExpectedOutcome.PASS and way not in opts.expect_fail_for # ----- @@ -869,7 +870,7 @@ def test(name: TestName, executeSetups([thisdir_settings, setup], name, myTestOpts) if name in config.broken_tests: - myTestOpts.expect = 'fail' + myTestOpts.expect = ExpectedOutcome.BROKEN thisTest = lambda watcher: runTest(watcher, myTestOpts, name, func, args) if myTestOpts.alone: @@ -1081,14 +1082,14 @@ def do_test(name: TestName, print_output = config.verbose >= 3) # If user used expect_broken then don't record failures of pre_cmd - if exit_code != 0 and opts.expect not in ['fail']: + if exit_code != 0 and opts.expect not in [ExpectedOutcome.FAIL]: framework_fail(name, way, 'pre_cmd failed: {0}'.format(exit_code)) if_verbose(1, '** pre_cmd was "{0}".'.format(override_options(opts.pre_cmd))) result = func(*[name,way] + args) - if opts.expect not in ['pass', 'fail', 'missing-lib']: - framework_fail(name, way, 'bad expected ' + opts.expect) + if opts.expect not in [ExpectedOutcome.PASS, ExpectedOutcome.FAIL, ExpectedOutcome.MISSING_LIB]: + framework_fail(name, way, 'bad expected ' + opts.expect.value) try: passFail = result.passFail @@ -1126,7 +1127,7 @@ def do_test(name: TestName, stderr=result.stderr) t.unexpected_failures.append(tr) else: - if opts.expect == 'missing-lib': + if opts.expect == ExpectedOutcome.MISSING_LIB: t.missing_libs.append(TestResult(directory, name, 'missing-lib', way)) else: t.n_expected_failures += 1 @@ -1958,7 +1959,7 @@ def compare_outputs(way: WayName, elif diff_file: diff_file.open('ab').close() # Make sure the file exists still as # we will try to read it later - if config.accept and (getTestOpts().expect == 'fail' or + if config.accept and (getTestOpts().expect == ExpectedOutcome.FAIL or way in getTestOpts().expect_fail_for): if_verbose(1, 'Test is expected to fail. Not accepting new output.') return False ===================================== testsuite/tests/perf/should_run/all.T ===================================== @@ -233,8 +233,7 @@ test('T5949', ['-O']) test('T4267', - [expect_broken(4267), - collect_stats('bytes allocated',10), + [collect_stats('bytes allocated',10), only_ways(['normal'])], compile_and_run, ['-O']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7bcd37e53474bf071bd28d4ac69ce2032d8cad1e...f501d2006bdbc778e5f869f7032fc4ee82f9412b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7bcd37e53474bf071bd28d4ac69ce2032d8cad1e...f501d2006bdbc778e5f869f7032fc4ee82f9412b You're receiving 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 Mar 30 21:18:14 2020 From: gitlab at gitlab.haskell.org (Andreas Klebinger) Date: Mon, 30 Mar 2020 17:18:14 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/andreask/hadrian_no_colour Message-ID: <5e82621639e1e_6167e0e2c941622840@gitlab.haskell.org.mail> Andreas Klebinger pushed new branch wip/andreask/hadrian_no_colour at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/andreask/hadrian_no_colour You're receiving 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 Mar 30 21:20:16 2020 From: gitlab at gitlab.haskell.org (Andreas Klebinger) Date: Mon, 30 Mar 2020 17:20:16 -0400 Subject: [Git][ghc/ghc][wip/andreask/hadrian_no_colour] Make hadrian pass on the no-colour setting to GHC. Message-ID: <5e826290ac6e8_61671196b3f416259c7@gitlab.haskell.org.mail> Andreas Klebinger pushed to branch wip/andreask/hadrian_no_colour at Glasgow Haskell Compiler / GHC Commits: 16c45686 by Andreas Klebinger at 2020-03-30T23:20:10+02:00 Make hadrian pass on the no-colour setting to GHC. Fixes #17983. - - - - - 1 changed file: - hadrian/src/Settings/Builders/Ghc.hs Changes: ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -31,9 +31,12 @@ toolArgs = do compileAndLinkHs :: Args compileAndLinkHs = (builder (Ghc CompileHs) ||^ builder (Ghc LinkHs)) ? do ways <- getLibraryWays + useColor <- shakeColor <$> expr getShakeOptions let hasVanilla = elem vanilla ways hasDynamic = elem dynamic ways mconcat [ arg "-Wall" + , not useColor ? builder (Ghc CompileHs) ? + arg "-fdiagnostics-color=never" , (hasVanilla && hasDynamic) ? builder (Ghc CompileHs) ? platformSupportsSharedLibs ? way vanilla ? arg "-dynamic-too" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/16c456862bbba59310c17574ee10cb9b5853c133 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/16c456862bbba59310c17574ee10cb9b5853c133 You're receiving 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 Mar 30 21:23:50 2020 From: gitlab at gitlab.haskell.org (Simon Jakobi) Date: Mon, 30 Mar 2020 17:23:50 -0400 Subject: [Git][ghc/ghc][wip/T16806] Use disjoint for closureGrowth Message-ID: <5e82636611dbf_6167e0e2c941630671@gitlab.haskell.org.mail> Simon Jakobi pushed to branch wip/T16806 at Glasgow Haskell Compiler / GHC Commits: 1cbda2e3 by Simon Jakobi at 2020-03-30T23:23:27+02:00 Use disjoint for closureGrowth - - - - - 3 changed files: - compiler/GHC/Stg/Lift/Analysis.hs - compiler/GHC/Types/Unique/DSet.hs - compiler/GHC/Types/Var/Set.hs Changes: ===================================== compiler/GHC/Stg/Lift/Analysis.hs ===================================== @@ -533,7 +533,7 @@ closureGrowth expander sizer group abs_ids = go go (ClosureSk _ clo_fvs rhs) -- If no binder of the @group@ occurs free in the closure, the lifting -- won't have any effect on it and we can omit the recursive call. - | n_occs == 0 = 0 + | dVarSetDisjointVarSet clo_fvs' group = 0 -- Otherwise, we account the cost of allocating the closure and add it to -- the closure growth of its RHS. | otherwise = mkIntWithInf cost + go rhs @@ -545,7 +545,7 @@ closureGrowth expander sizer group abs_ids = go -- we lift @f@ newbies = abs_ids `minusDVarSet` clo_fvs' -- Lifting @f@ removes @f@ from the closure but adds all @newbies@ - cost = foldDVarSet (\id size -> sizer id + size) 0 newbies - n_occs + cost = foldDVarSet (\id size -> sizer id + size) 0 newbies - n_occs -- TODO: Do we really want a right fold here? Also: no need to do this in deterministic order! go (RhsSk body_dmd body) -- The conservative assumption would be that -- 1. Every RHS with positive growth would be called multiple times, ===================================== compiler/GHC/Types/Unique/DSet.hs ===================================== @@ -26,6 +26,7 @@ module GHC.Types.Unique.DSet ( unionUniqDSets, unionManyUniqDSets, minusUniqDSet, uniqDSetMinusUniqSet, intersectUniqDSets, uniqDSetIntersectUniqSet, + uniqDSetDisjointUniqSet, foldUniqDSet, elementOfUniqDSet, filterUniqDSet, @@ -98,6 +99,10 @@ uniqDSetIntersectUniqSet :: UniqDSet a -> UniqSet b -> UniqDSet a uniqDSetIntersectUniqSet xs ys = UniqDSet (udfmIntersectUFM (getUniqDSet xs) (getUniqSet ys)) +uniqDSetDisjointUniqSet :: UniqDSet a -> UniqSet b -> Bool +uniqDSetDisjointUniqSet xs ys + = disjointUdfmUfm (getUniqDSet xs) (getUniqSet ys) + foldUniqDSet :: (a -> b -> b) -> b -> UniqDSet a -> b foldUniqDSet c n (UniqDSet s) = foldUDFM c n s ===================================== compiler/GHC/Types/Var/Set.hs ===================================== @@ -34,7 +34,7 @@ module GHC.Types.Var.Set ( elemDVarSet, dVarSetElems, subDVarSet, unionDVarSet, unionDVarSets, mapUnionDVarSet, intersectDVarSet, dVarSetIntersectVarSet, - intersectsDVarSet, disjointDVarSet, + intersectsDVarSet, disjointDVarSet, dVarSetDisjointVarSet, isEmptyDVarSet, delDVarSet, delDVarSetList, minusDVarSet, foldDVarSet, filterDVarSet, mapDVarSet, dVarSetMinusVarSet, anyDVarSet, allDVarSet, @@ -274,6 +274,9 @@ dVarSetIntersectVarSet = uniqDSetIntersectUniqSet disjointDVarSet :: DVarSet -> DVarSet -> Bool disjointDVarSet s1 s2 = disjointUDFM (getUniqDSet s1) (getUniqDSet s2) +dVarSetDisjointVarSet :: DVarSet -> VarSet -> Bool +dVarSetDisjointVarSet = uniqDSetDisjointUniqSet + -- | True if non-empty intersection intersectsDVarSet :: DVarSet -> DVarSet -> Bool intersectsDVarSet s1 s2 = not (s1 `disjointDVarSet` s2) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1cbda2e3d6f14769602cdd1bc63276afc3e27ac6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1cbda2e3d6f14769602cdd1bc63276afc3e27ac6 You're receiving 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 Mar 30 21:54:39 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 30 Mar 2020 17:54:39 -0400 Subject: [Git][ghc/ghc][wip/T17977] 2 commits: Expect T4267 to pass Message-ID: <5e826a9f8d65_61671196b3f416425ac@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T17977 at Glasgow Haskell Compiler / GHC Commits: 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. - - - - - 57342858 by Sebastian Graf at 2020-03-30T17:54:36-04:00 PmCheck: Adjust recursion depth for nonVoid 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 default to a much lower recursion limit of 3. Fixes #17977. - - - - - 6 changed files: - compiler/GHC/HsToCore/PmCheck/Oracle.hs - testsuite/tests/perf/should_run/all.T - + testsuite/tests/pmcheck/should_compile/T17977.hs - + testsuite/tests/pmcheck/should_compile/T17977b.hs - + testsuite/tests/pmcheck/should_compile/T17977b.stderr - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== compiler/GHC/HsToCore/PmCheck/Oracle.hs ===================================== @@ -1322,7 +1322,7 @@ checkAllNonVoid rec_ts amb_cs strict_arg_tys = do let rec_max_bound | tys_to_check `lengthExceeds` 1 = 1 | otherwise - = defaultRecTcMaxBound + = 3 rec_ts' = setRecTcMaxBound rec_max_bound rec_ts allM (nonVoid rec_ts' amb_cs) tys_to_check ===================================== testsuite/tests/perf/should_run/all.T ===================================== @@ -233,8 +233,7 @@ test('T5949', ['-O']) test('T4267', - [expect_broken(4267), - collect_stats('bytes allocated',10), + [collect_stats('bytes allocated',10), only_ways(['normal'])], compile_and_run, ['-O']) ===================================== testsuite/tests/pmcheck/should_compile/T17977.hs ===================================== @@ -0,0 +1,33 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +module Bug where + +import Data.Kind +import Data.Type.Equality + +data Nat = Z | S Nat + +data SNat :: Nat -> Type where + SZ :: SNat Z + SS :: SNat n -> SNat (S n) + +type family S' (n :: Nat) :: Nat where + S' n = S n + +data R :: Nat -> Nat -> Nat -> Type where + MkR :: !(R m n o) -> R (S m) n (S o) + +type family NatPlus (m :: Nat) (n :: Nat) :: Nat where + NatPlus Z n = n + NatPlus (S m) n = S' (NatPlus m n) + +f :: forall (m :: Nat) (n :: Nat) (o :: Nat). + SNat m -> SNat n -> SNat o + -> R m n o -> NatPlus m n :~: o +f (SS sm) sn (SS so) (MkR r) + | Refl <- f sm sn so r + = Refl ===================================== testsuite/tests/pmcheck/should_compile/T17977b.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE EmptyCase #-} +module Bug where + +import Data.Kind + +data Nat = Z | S Nat + +data Down :: Nat -> Type where + Down :: !(Down n) -> Down (S n) + +data Up :: Nat -> Type where + Up :: !(Up (S n)) -> Up n + +f :: Down n -> () +f (Down r) = () + +f' :: Down (S (S (S (S Z)))) -> () +f' (Down r) = () + +g :: Up n -> () +g (Up r) = () ===================================== testsuite/tests/pmcheck/should_compile/T17977b.stderr ===================================== @@ -0,0 +1,4 @@ + +T17977b.hs:21:1: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match has inaccessible right hand side + In an equation for ‘f'’: f' (Down r) = ... ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -114,6 +114,10 @@ test('T17703', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17783', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T17977', collect_compiler_stats('bytes allocated',10), compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T17977b', collect_compiler_stats('bytes allocated',10), compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) # Other tests test('pmc001', [], compile, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a2226015e76fed5041aac59433c60e4379f8d73e...5734285808c549ebe505089b0cbf9afe7089e857 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a2226015e76fed5041aac59433c60e4379f8d73e...5734285808c549ebe505089b0cbf9afe7089e857 You're receiving 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 Mar 30 23:23:25 2020 From: gitlab at gitlab.haskell.org (Simon Jakobi) Date: Mon, 30 Mar 2020 19:23:25 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/sjakobi/nondetfolds Message-ID: <5e827f6db5587_6167683004416513fd@gitlab.haskell.org.mail> Simon Jakobi pushed new branch wip/sjakobi/nondetfolds at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/sjakobi/nondetfolds You're receiving 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 Mar 31 01:03:18 2020 From: gitlab at gitlab.haskell.org (Simon Jakobi) Date: Mon, 30 Mar 2020 21:03:18 -0400 Subject: [Git][ghc/ghc][wip/sjakobi/nondetfolds] Delete some evidence bindings more efficiently Message-ID: <5e8296d650216_6167120434ec16603b7@gitlab.haskell.org.mail> Simon Jakobi pushed to branch wip/sjakobi/nondetfolds at Glasgow Haskell Compiler / GHC Commits: fa1d67f1 by Simon Jakobi at 2020-03-31T03:02:51+02:00 Delete some evidence bindings more efficiently (needs refactoring) - - - - - 6 changed files: - compiler/GHC/Types/Unique/DFM.hs - compiler/GHC/Types/Unique/FM.hs - compiler/GHC/Types/Unique/Set.hs - compiler/GHC/Types/Var/Env.hs - compiler/typecheck/TcEvidence.hs - compiler/typecheck/TcSimplify.hs Changes: ===================================== compiler/GHC/Types/Unique/DFM.hs ===================================== @@ -50,7 +50,7 @@ module GHC.Types.Unique.DFM ( equalKeysUDFM, minusUDFM, listToUDFM, - udfmMinusUFM, + udfmMinusUFM, ufmMinusUDFM, partitionUDFM, anyUDFM, allUDFM, pprUniqDFM, pprUDFM, @@ -73,7 +73,7 @@ import Data.Functor.Classes (Eq1 (..)) import Data.List (sortBy) import Data.Function (on) import qualified Data.Semigroup as Semi -import GHC.Types.Unique.FM (UniqFM, listToUFM_Directly, nonDetUFMToList, ufmToIntMap) +import GHC.Types.Unique.FM (UniqFM, listToUFM_Directly, nonDetUFMToList, ufmToIntMap, intMapToUFM) -- Note [Deterministic UniqFM] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -343,6 +343,9 @@ udfmMinusUFM (UDFM x i) y = UDFM (M.difference x (ufmToIntMap y)) i -- M.difference returns a subset of a left set, so `i` is a good upper -- bound. +ufmMinusUDFM :: UniqFM elt1 -> UniqDFM elt2 -> UniqFM elt1 +ufmMinusUDFM x (UDFM y _i) = intMapToUFM (M.difference (ufmToIntMap x) y) + -- | Partition UniqDFM into two UniqDFMs according to the predicate partitionUDFM :: (elt -> Bool) -> UniqDFM elt -> (UniqDFM elt, UniqDFM elt) partitionUDFM p (UDFM m i) = ===================================== compiler/GHC/Types/Unique/FM.hs ===================================== @@ -67,7 +67,7 @@ module GHC.Types.Unique.FM ( lookupWithDefaultUFM, lookupWithDefaultUFM_Directly, nonDetEltsUFM, eltsUFM, nonDetKeysUFM, ufmToSet_Directly, - nonDetUFMToList, ufmToIntMap, + nonDetUFMToList, ufmToIntMap, intMapToUFM, pprUniqFM, pprUFM, pprUFMWithKeys, pluralUFM ) where @@ -359,6 +359,9 @@ instance Traversable NonDetUniqFM where ufmToIntMap :: UniqFM elt -> M.IntMap elt ufmToIntMap (UFM m) = m +intMapToUFM :: M.IntMap elt -> UniqFM elt +intMapToUFM = UFM + -- Determines whether two 'UniqFM's contain the same keys. equalKeysUFM :: UniqFM a -> UniqFM b -> Bool equalKeysUFM (UFM m1) (UFM m2) = liftEq (\_ _ -> True) m1 m2 ===================================== compiler/GHC/Types/Unique/Set.hs ===================================== @@ -25,7 +25,7 @@ module GHC.Types.Unique.Set ( delOneFromUniqSet, delOneFromUniqSet_Directly, delListFromUniqSet, delListFromUniqSet_Directly, unionUniqSets, unionManyUniqSets, - minusUniqSet, uniqSetMinusUFM, + minusUniqSet, uniqSetMinusUFM, uniqSetMinusUDFM, intersectUniqSets, restrictUniqSetToUFM, uniqSetAny, uniqSetAll, @@ -48,6 +48,7 @@ module GHC.Types.Unique.Set ( import GhcPrelude +import GHC.Types.Unique.DFM import GHC.Types.Unique.FM import GHC.Types.Unique import Data.Coerce @@ -111,6 +112,9 @@ restrictUniqSetToUFM (UniqSet s) m = UniqSet (intersectUFM s m) uniqSetMinusUFM :: UniqSet a -> UniqFM b -> UniqSet a uniqSetMinusUFM (UniqSet s) t = UniqSet (minusUFM s t) +uniqSetMinusUDFM :: UniqSet a -> UniqDFM b -> UniqSet a +uniqSetMinusUDFM (UniqSet s) t = UniqSet (ufmMinusUDFM s t) + elementOfUniqSet :: Uniquable a => a -> UniqSet a -> Bool elementOfUniqSet a (UniqSet s) = elemUFM a s ===================================== compiler/GHC/Types/Var/Env.hs ===================================== @@ -33,7 +33,7 @@ module GHC.Types.Var.Env ( extendDVarEnv, extendDVarEnv_C, extendDVarEnvList, lookupDVarEnv, elemDVarEnv, - isEmptyDVarEnv, foldDVarEnv, + isEmptyDVarEnv, foldDVarEnv, nonDetStrictFoldDVarEnv, mapDVarEnv, filterDVarEnv, modifyDVarEnv, alterDVarEnv, @@ -583,6 +583,9 @@ lookupDVarEnv = lookupUDFM foldDVarEnv :: (a -> b -> b) -> b -> DVarEnv a -> b foldDVarEnv = foldUDFM +nonDetStrictFoldDVarEnv :: (b -> a -> b) -> b -> DVarEnv a -> b +nonDetStrictFoldDVarEnv = nonDetStrictFoldUDFM + mapDVarEnv :: (a -> b) -> DVarEnv a -> DVarEnv b mapDVarEnv = mapUDFM ===================================== compiler/typecheck/TcEvidence.hs ===================================== @@ -15,7 +15,9 @@ module TcEvidence ( -- * Evidence bindings TcEvBinds(..), EvBindsVar(..), EvBindMap(..), emptyEvBindMap, extendEvBinds, - lookupEvBind, evBindMapBinds, foldEvBindMap, filterEvBindMap, + lookupEvBind, evBindMapBinds, + foldEvBindMap, nonDetStrictFoldEvBindMap, + filterEvBindMap, isEmptyEvBindMap, EvBind(..), emptyTcEvBinds, isEmptyTcEvBinds, mkGivenEvBind, mkWantedEvBind, evBindVar, isCoEvBindsVar, @@ -496,6 +498,9 @@ evBindMapBinds = foldEvBindMap consBag emptyBag foldEvBindMap :: (EvBind -> a -> a) -> a -> EvBindMap -> a foldEvBindMap k z bs = foldDVarEnv k z (ev_bind_varenv bs) +nonDetStrictFoldEvBindMap :: (a -> EvBind -> a) -> a -> EvBindMap -> a +nonDetStrictFoldEvBindMap k z bs = nonDetStrictFoldDVarEnv k z (ev_bind_varenv bs) + filterEvBindMap :: (EvBind -> Bool) -> EvBindMap -> EvBindMap filterEvBindMap k (EvBindMap { ev_bind_varenv = env }) = EvBindMap { ev_bind_varenv = filterDVarEnv k env } ===================================== compiler/typecheck/TcSimplify.hs ===================================== @@ -1862,11 +1862,11 @@ neededEvVars implic@(Implic { ic_given = givens ; tcvs <- TcS.getTcEvTyCoVars ev_binds_var ; let seeds1 = foldr add_implic_seeds old_needs implics - seeds2 = foldEvBindMap add_wanted seeds1 ev_binds + seeds2 = foldEvBindMap add_wanted seeds1 ev_binds -- TODO seeds3 = seeds2 `unionVarSet` tcvs need_inner = findNeededEvVars ev_binds seeds3 live_ev_binds = filterEvBindMap (needed_ev_bind need_inner) ev_binds - need_outer = foldEvBindMap del_ev_bndr need_inner live_ev_binds + need_outer = varSetMinusEvBindMap need_inner live_ev_binds `delVarSetList` givens ; TcS.setTcEvBindsMap ev_binds_var live_ev_binds @@ -1890,8 +1890,8 @@ neededEvVars implic@(Implic { ic_given = givens | is_given = ev_var `elemVarSet` needed | otherwise = True -- Keep all wanted bindings - del_ev_bndr :: EvBind -> VarSet -> VarSet - del_ev_bndr (EvBind { eb_lhs = v }) needs = delVarSet needs v + varSetMinusEvBindMap :: VarSet -> EvBindMap -> VarSet + varSetMinusEvBindMap vs ebm = uniqSetMinusUDFM vs (ev_bind_varenv ebm) add_wanted :: EvBind -> VarSet -> VarSet add_wanted (EvBind { eb_is_given = is_given, eb_rhs = rhs }) needs @@ -2381,7 +2381,7 @@ floatEqualities skols given_ids ev_binds_var no_given_eqs seed_skols = mkVarSet skols `unionVarSet` mkVarSet given_ids `unionVarSet` foldr add_non_flt_ct emptyVarSet no_float_cts `unionVarSet` - foldEvBindMap add_one_bind emptyVarSet binds + foldEvBindMap add_one_bind emptyVarSet binds -- TODO -- seed_skols: See Note [What prevents a constraint from floating] (1,2,3) -- Include the EvIds of any non-floating constraints View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fa1d67f121cf813dfd7b3e155b8b301e5f9eaeff -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fa1d67f121cf813dfd7b3e155b8b301e5f9eaeff You're receiving 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 Mar 31 01:50:13 2020 From: gitlab at gitlab.haskell.org (Simon Jakobi) Date: Mon, 30 Mar 2020 21:50:13 -0400 Subject: [Git][ghc/ghc][wip/sjakobi/nondetfolds] Use non-deterministic fold to insert wanted evidence bindings Message-ID: <5e82a1d5df3d3_61673f8198ee100c1662368@gitlab.haskell.org.mail> Simon Jakobi pushed to branch wip/sjakobi/nondetfolds at Glasgow Haskell Compiler / GHC Commits: edda58b7 by Simon Jakobi at 2020-03-31T03:49:21+02:00 Use non-deterministic fold to insert wanted evidence bindings - - - - - 1 changed file: - compiler/typecheck/TcSimplify.hs Changes: ===================================== compiler/typecheck/TcSimplify.hs ===================================== @@ -1862,7 +1862,7 @@ neededEvVars implic@(Implic { ic_given = givens ; tcvs <- TcS.getTcEvTyCoVars ev_binds_var ; let seeds1 = foldr add_implic_seeds old_needs implics - seeds2 = foldEvBindMap add_wanted seeds1 ev_binds -- TODO + seeds2 = nonDetStrictFoldEvBindMap (flip add_wanted) seeds1 ev_binds seeds3 = seeds2 `unionVarSet` tcvs need_inner = findNeededEvVars ev_binds seeds3 live_ev_binds = filterEvBindMap (needed_ev_bind need_inner) ev_binds View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/edda58b700ee5b0583cc37f3d2b8bfd0b8a48163 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/edda58b700ee5b0583cc37f3d2b8bfd0b8a48163 You're receiving 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 Mar 31 02:08:20 2020 From: gitlab at gitlab.haskell.org (Simon Jakobi) Date: Mon, 30 Mar 2020 22:08:20 -0400 Subject: [Git][ghc/ghc][wip/sjakobi/nondetfolds] Add and use evBindMapToVarSet Message-ID: <5e82a61485705_6167120434ec16626aa@gitlab.haskell.org.mail> Simon Jakobi pushed to branch wip/sjakobi/nondetfolds at Glasgow Haskell Compiler / GHC Commits: eb7a7b79 by Simon Jakobi at 2020-03-31T04:08:00+02:00 Add and use evBindMapToVarSet - - - - - 3 changed files: - compiler/GHC/Types/Unique/DFM.hs - compiler/typecheck/TcEvidence.hs - compiler/typecheck/TcSimplify.hs Changes: ===================================== compiler/GHC/Types/Unique/DFM.hs ===================================== @@ -359,7 +359,7 @@ delListFromUDFM = foldl' delFromUDFM -- | This allows for lossy conversion from UniqDFM to UniqFM udfmToUfm :: UniqDFM elt -> UniqFM elt udfmToUfm (UDFM m _i) = - listToUFM_Directly [(getUnique k, taggedFst tv) | (k, tv) <- M.toList m] + listToUFM_Directly [(getUnique k, taggedFst tv) | (k, tv) <- M.toList m] -- TODO listToUDFM :: Uniquable key => [(key,elt)] -> UniqDFM elt listToUDFM = foldl' (\m (k, v) -> addToUDFM m k v) emptyUDFM ===================================== compiler/typecheck/TcEvidence.hs ===================================== @@ -19,6 +19,7 @@ module TcEvidence ( foldEvBindMap, nonDetStrictFoldEvBindMap, filterEvBindMap, isEmptyEvBindMap, + evBindMapToVarSet, EvBind(..), emptyTcEvBinds, isEmptyTcEvBinds, mkGivenEvBind, mkWantedEvBind, evBindVar, isCoEvBindsVar, @@ -57,6 +58,8 @@ module TcEvidence ( import GhcPrelude +import GHC.Types.Unique.DFM +import GHC.Types.Unique.FM import GHC.Types.Var import GHC.Core.Coercion.Axiom import GHC.Core.Coercion @@ -505,6 +508,9 @@ filterEvBindMap :: (EvBind -> Bool) -> EvBindMap -> EvBindMap filterEvBindMap k (EvBindMap { ev_bind_varenv = env }) = EvBindMap { ev_bind_varenv = filterDVarEnv k env } +evBindMapToVarSet :: EvBindMap -> VarSet +evBindMapToVarSet (EvBindMap dve) = unsafeUFMToUniqSet (mapUFM evBindVar (udfmToUfm dve)) + instance Outputable EvBindMap where ppr (EvBindMap m) = ppr m ===================================== compiler/typecheck/TcSimplify.hs ===================================== @@ -2381,7 +2381,7 @@ floatEqualities skols given_ids ev_binds_var no_given_eqs seed_skols = mkVarSet skols `unionVarSet` mkVarSet given_ids `unionVarSet` foldr add_non_flt_ct emptyVarSet no_float_cts `unionVarSet` - foldEvBindMap add_one_bind emptyVarSet binds -- TODO + evBindMapToVarSet binds -- seed_skols: See Note [What prevents a constraint from floating] (1,2,3) -- Include the EvIds of any non-floating constraints @@ -2406,9 +2406,6 @@ floatEqualities skols given_ids ev_binds_var no_given_eqs ; return ( flt_eqs, wanteds { wc_simple = remaining_simples } ) } where - add_one_bind :: EvBind -> VarSet -> VarSet - add_one_bind bind acc = extendVarSet acc (evBindVar bind) - add_non_flt_ct :: Ct -> VarSet -> VarSet add_non_flt_ct ct acc | isDerivedCt ct = acc | otherwise = extendVarSet acc (ctEvId ct) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eb7a7b79d5001f351668afb24397554e85583a99 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eb7a7b79d5001f351668afb24397554e85583a99 You're receiving 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 Mar 31 02:11:17 2020 From: gitlab at gitlab.haskell.org (Simon Jakobi) Date: Mon, 30 Mar 2020 22:11:17 -0400 Subject: [Git][ghc/ghc][wip/sjakobi/nondetfolds] Improve udfmToUfm Message-ID: <5e82a6c55d540_61673f81cca05dd81662961@gitlab.haskell.org.mail> Simon Jakobi pushed to branch wip/sjakobi/nondetfolds at Glasgow Haskell Compiler / GHC Commits: cb538d30 by Simon Jakobi at 2020-03-31T04:10:58+02:00 Improve udfmToUfm - - - - - 1 changed file: - compiler/GHC/Types/Unique/DFM.hs Changes: ===================================== compiler/GHC/Types/Unique/DFM.hs ===================================== @@ -73,7 +73,7 @@ import Data.Functor.Classes (Eq1 (..)) import Data.List (sortBy) import Data.Function (on) import qualified Data.Semigroup as Semi -import GHC.Types.Unique.FM (UniqFM, listToUFM_Directly, nonDetUFMToList, ufmToIntMap, intMapToUFM) +import GHC.Types.Unique.FM (UniqFM, nonDetUFMToList, ufmToIntMap, intMapToUFM) -- Note [Deterministic UniqFM] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -358,8 +358,7 @@ delListFromUDFM = foldl' delFromUDFM -- | This allows for lossy conversion from UniqDFM to UniqFM udfmToUfm :: UniqDFM elt -> UniqFM elt -udfmToUfm (UDFM m _i) = - listToUFM_Directly [(getUnique k, taggedFst tv) | (k, tv) <- M.toList m] -- TODO +udfmToUfm (UDFM m _i) = intMapToUFM (M.map taggedFst m) listToUDFM :: Uniquable key => [(key,elt)] -> UniqDFM elt listToUDFM = foldl' (\m (k, v) -> addToUDFM m k v) emptyUDFM View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cb538d30d9f8d774064406bf8748799d2f1ad775 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cb538d30d9f8d774064406bf8748799d2f1ad775 You're receiving 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 Mar 31 07:04:20 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 31 Mar 2020 03:04:20 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: Require GHC 8.8 as the minimum compiler for bootstrapping Message-ID: <5e82eb744a613_61671196b3f4167437d@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 47f5ec5b by Ryan Scott at 2020-03-31T03:03:48-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. - - - - - b4fae1a5 by Ryan Scott at 2020-03-31T03:03:49-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. - - - - - c28d02ca by Ömer Sinan Ağacan at 2020-03-31T03:04:05-04:00 Simplify stderrSupportsAnsiColors The combinator andM is used only once, and the code is shorter and simpler if you inline it. - - - - - c70163b3 by Ben Gamari at 2020-03-31T03:04:06-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. - - - - - bddf80b1 by Andreas Klebinger at 2020-03-31T03:04:07-04:00 Update hadrian index revision. Required in order to build hadrian using ghc-8.10 - - - - - 95da0b37 by Ben Gamari at 2020-03-31T03:04:07-04:00 integer-gmp: Bump version and add changelog entry - - - - - 29 changed files: - .gitlab-ci.yml - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Op/ConstantFold.hs - compiler/GHC/Core/Op/Specialise.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Types/Unique/Supply.hs - compiler/main/SysTools/Process.hs - compiler/main/SysTools/Terminal.hs - compiler/typecheck/TcRnTypes.hs - compiler/typecheck/TcSMonad.hs - compiler/utils/Binary.hs - compiler/utils/IOEnv.hs - configure.ac - hadrian/cabal.project - hadrian/src/Hadrian/Utilities.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Ghc.hs - libraries/base/Control/Monad/ST/Lazy/Imp.hs - libraries/base/GHC/IO/Encoding.hs - libraries/base/GHC/ST.hs - libraries/base/Text/ParserCombinators/ReadPrec.hs - libraries/ghci/GHCi/TH.hs - libraries/integer-gmp/changelog.md - libraries/integer-gmp/integer-gmp.cabal - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - + testsuite/tests/polykinds/T17963.hs - + testsuite/tests/polykinds/T17963.stderr - testsuite/tests/polykinds/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: 408eff66aef6ca2b44446c694c5a56d6ca0460cc + DOCKER_REV: 3f731f5d37a156e7ebe10cd32656946083baaf4a # Sequential version number capturing the versions of all tools fetched by # .gitlab/ci.sh. @@ -390,7 +390,7 @@ validate-x86_64-darwin: tags: - x86_64-darwin variables: - GHC_VERSION: 8.6.5 + GHC_VERSION: 8.8.3 CABAL_INSTALL_VERSION: 3.0.0.0 BIN_DIST_PREP_TAR_COMP: "ghc-x86_64-apple-darwin.tar.xz" MACOSX_DEPLOYMENT_TARGET: "10.7" @@ -419,7 +419,7 @@ validate-x86_64-darwin: tags: - x86_64-darwin variables: - GHC_VERSION: 8.6.3 + GHC_VERSION: 8.8.3 MACOSX_DEPLOYMENT_TARGET: "10.7" ac_cv_func_clock_gettime: "no" LANG: "en_US.UTF-8" ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -70,7 +70,6 @@ import GHC.Types.Demand ( splitStrictSig, isBotDiv ) import GHC.Driver.Types import GHC.Driver.Session import Control.Monad -import qualified Control.Monad.Fail as MonadFail import MonadUtils import Data.Foldable ( toList ) import Data.List.NonEmpty ( NonEmpty ) @@ -2249,16 +2248,13 @@ instance Applicative LintM where (<*>) = ap instance Monad LintM where -#if !MIN_VERSION_base(4,13,0) - fail = MonadFail.fail -#endif m >>= k = LintM (\ env errs -> let (res, errs') = unLintM m env errs in case res of Just r -> unLintM (k r) env errs' Nothing -> (Nothing, errs')) -instance MonadFail.MonadFail LintM where +instance MonadFail LintM where fail err = failWithL (text err) instance HasDynFlags LintM where ===================================== compiler/GHC/Core/Make.hs ===================================== @@ -85,7 +85,6 @@ import Util import Data.List import Data.Char ( ord ) -import Control.Monad.Fail as MonadFail ( MonadFail ) infixl 4 `mkCoreApp`, `mkCoreApps` @@ -640,7 +639,7 @@ mkFoldrExpr elt_ty result_ty c n list = do `App` list) -- | Make a 'build' expression applied to a locally-bound worker function -mkBuildExpr :: (MonadFail.MonadFail m, MonadThings m, MonadUnique m) +mkBuildExpr :: (MonadFail m, MonadThings m, MonadUnique m) => Type -- ^ Type of list elements to be built -> ((Id, Type) -> (Id, Type) -> m CoreExpr) -- ^ Function that, given information about the 'Id's -- of the binders for the build worker function, returns ===================================== compiler/GHC/Core/Op/ConstantFold.hs ===================================== @@ -61,7 +61,6 @@ import GHC.Core.Coercion (mkUnbranchedAxInstCo,mkSymCo,Role(..)) import Control.Applicative ( Alternative(..) ) import Control.Monad -import qualified Control.Monad.Fail as MonadFail import Data.Bits as Bits import qualified Data.ByteString as BS import Data.Int @@ -796,11 +795,7 @@ instance Monad RuleM where Nothing -> Nothing Just r -> runRuleM (g r) env iu fn args -#if !MIN_VERSION_base(4,13,0) - fail = MonadFail.fail -#endif - -instance MonadFail.MonadFail RuleM where +instance MonadFail RuleM where fail _ = mzero instance Alternative RuleM where ===================================== compiler/GHC/Core/Op/Specialise.hs ===================================== @@ -50,7 +50,6 @@ import GHC.Types.Unique.DFM import GHC.Core.TyCo.Rep (TyCoBinder (..)) import Control.Monad -import qualified Control.Monad.Fail as MonadFail {- ************************************************************************ @@ -2551,11 +2550,8 @@ instance Monad SpecM where case f y of SpecM z -> z -#if !MIN_VERSION_base(4,13,0) - fail = MonadFail.fail -#endif -instance MonadFail.MonadFail SpecM where +instance MonadFail SpecM where fail str = SpecM $ error str instance MonadUnique SpecM where ===================================== compiler/GHC/Core/Unify.hs ===================================== @@ -46,7 +46,6 @@ import GHC.Types.Unique.FM import GHC.Types.Unique.Set import Control.Monad -import qualified Control.Monad.Fail as MonadFail import Control.Applicative hiding ( empty ) import qualified Control.Applicative @@ -1244,9 +1243,6 @@ instance Applicative UM where (<*>) = ap instance Monad UM where -#if !MIN_VERSION_base(4,13,0) - fail = MonadFail.fail -#endif m >>= k = UM (\state -> do { (state', v) <- unUM m state ; unUM (k v) state' }) @@ -1260,7 +1256,7 @@ instance Alternative UM where instance MonadPlus UM -instance MonadFail.MonadFail UM where +instance MonadFail UM where fail _ = UM (\_ -> SurelyApart) -- failed pattern match initUM :: TvSubstEnv -- subst to extend ===================================== compiler/GHC/Types/Unique/Supply.hs ===================================== @@ -44,7 +44,6 @@ import MonadUtils import Control.Monad import Data.Bits import Data.Char -import Control.Monad.Fail as Fail #include "Unique.h" @@ -156,7 +155,7 @@ instance Applicative UniqSM where (*>) = thenUs_ -- TODO: try to get rid of this instance -instance Fail.MonadFail UniqSM where +instance MonadFail UniqSM where fail = panic -- | Run the 'UniqSM' action, returning the final 'UniqSupply' ===================================== compiler/main/SysTools/Process.hs ===================================== @@ -36,14 +36,10 @@ import FileCleanup -- @process >= 1.6.8.0@). enableProcessJobs :: CreateProcess -> CreateProcess #if defined(MIN_VERSION_process) -#if MIN_VERSION_process(1,6,8) enableProcessJobs opts = opts { use_process_jobs = True } #else enableProcessJobs opts = opts #endif -#else -enableProcessJobs opts = opts -#endif -- Similar to System.Process.readCreateProcessWithExitCode, but stderr is -- inherited from the parent process, and output to stderr is not captured. ===================================== compiler/main/SysTools/Terminal.hs ===================================== @@ -32,20 +32,13 @@ import qualified System.Win32 as Win32 stderrSupportsAnsiColors :: IO Bool stderrSupportsAnsiColors = do #if defined(MIN_VERSION_terminfo) - queryTerminal stdError `andM` do - (termSupportsColors <$> setupTermFromEnv) - `catch` \ (_ :: SetupTermError) -> - pure False - + stderr_available <- queryTerminal stdError + if stderr_available then + fmap termSupportsColors setupTermFromEnv + `catch` \ (_ :: SetupTermError) -> pure False + else + pure False where - - andM :: Monad m => m Bool -> m Bool -> m Bool - andM mx my = do - x <- mx - if x - then my - else pure x - termSupportsColors :: Terminal -> Bool termSupportsColors term = fromMaybe 0 (getCapability term termColors) > 0 ===================================== compiler/typecheck/TcRnTypes.hs ===================================== @@ -124,7 +124,6 @@ import PrelNames ( isUnboundName ) import GHC.Types.CostCentre.State import Control.Monad (ap) -import qualified Control.Monad.Fail as MonadFail import Data.Set ( Set ) import qualified Data.Set as S @@ -1653,14 +1652,11 @@ instance Applicative TcPluginM where (<*>) = ap instance Monad TcPluginM where -#if !MIN_VERSION_base(4,13,0) - fail = MonadFail.fail -#endif TcPluginM m >>= k = TcPluginM (\ ev -> do a <- m ev runTcPluginM (k a) ev) -instance MonadFail.MonadFail TcPluginM where +instance MonadFail TcPluginM where fail x = TcPluginM (const $ fail x) runTcPluginM :: TcPluginM a -> EvBindsVar -> TcM a ===================================== compiler/typecheck/TcSMonad.hs ===================================== @@ -177,7 +177,6 @@ import Maybes import GHC.Core.Map import Control.Monad -import qualified Control.Monad.Fail as MonadFail import MonadUtils import Data.IORef import Data.List ( partition, mapAccumL ) @@ -2699,12 +2698,9 @@ instance Applicative TcS where (<*>) = ap instance Monad TcS where -#if !MIN_VERSION_base(4,13,0) - fail = MonadFail.fail -#endif m >>= k = TcS (\ebs -> unTcS m ebs >>= \r -> unTcS (k r) ebs) -instance MonadFail.MonadFail TcS where +instance MonadFail TcS where fail err = TcS (\_ -> fail err) instance MonadUnique TcS where ===================================== compiler/utils/Binary.hs ===================================== @@ -829,12 +829,10 @@ instance Binary RuntimeRep where put_ bh AddrRep = putByte bh 9 put_ bh FloatRep = putByte bh 10 put_ bh DoubleRep = putByte bh 11 -#if __GLASGOW_HASKELL__ >= 807 put_ bh Int8Rep = putByte bh 12 put_ bh Word8Rep = putByte bh 13 put_ bh Int16Rep = putByte bh 14 put_ bh Word16Rep = putByte bh 15 -#endif #if __GLASGOW_HASKELL__ >= 809 put_ bh Int32Rep = putByte bh 16 put_ bh Word32Rep = putByte bh 17 @@ -855,12 +853,10 @@ instance Binary RuntimeRep where 9 -> pure AddrRep 10 -> pure FloatRep 11 -> pure DoubleRep -#if __GLASGOW_HASKELL__ >= 807 12 -> pure Int8Rep 13 -> pure Word8Rep 14 -> pure Int16Rep 15 -> pure Word16Rep -#endif #if __GLASGOW_HASKELL__ >= 809 16 -> pure Int32Rep 17 -> pure Word32Rep ===================================== compiler/utils/IOEnv.hs ===================================== @@ -43,7 +43,6 @@ import Data.IORef ( IORef, newIORef, readIORef, writeIORef, modifyIORef, import System.IO.Unsafe ( unsafeInterleaveIO ) import System.IO ( fixIO ) import Control.Monad -import qualified Control.Monad.Fail as MonadFail import MonadUtils import Control.Applicative (Alternative(..)) @@ -60,11 +59,8 @@ unIOEnv (IOEnv m) = m instance Monad (IOEnv m) where (>>=) = thenM (>>) = (*>) -#if !MIN_VERSION_base(4,13,0) - fail = MonadFail.fail -#endif -instance MonadFail.MonadFail (IOEnv m) where +instance MonadFail (IOEnv m) where fail _ = failM -- Ignore the string instance Applicative (IOEnv m) where ===================================== configure.ac ===================================== @@ -158,8 +158,8 @@ if test "$WithGhc" = "" then AC_MSG_ERROR([GHC is required.]) fi -FP_COMPARE_VERSIONS([$GhcVersion],[-lt],[8.6], - [AC_MSG_ERROR([GHC version 8.6 or later is required to compile GHC.])]) +FP_COMPARE_VERSIONS([$GhcVersion],[-lt],[8.8], + [AC_MSG_ERROR([GHC version 8.8 or later is required to compile GHC.])]) if test `expr $GhcMinVersion % 2` = "1" then ===================================== hadrian/cabal.project ===================================== @@ -1,7 +1,7 @@ packages: ./ -- This essentially freezes the build plan for hadrian -index-state: 2019-12-16T07:24:23Z +index-state: 2020-03-28T07:24:23Z -- N.B. Compile with -O0 since this is not a performance-critical executable -- and the Cabal takes nearly twice as long to build with -O1. See #16817. ===================================== hadrian/src/Hadrian/Utilities.hs ===================================== @@ -40,7 +40,6 @@ import Data.Char import Data.Dynamic (Dynamic, fromDynamic, toDyn) import Data.Functor import Data.HashMap.Strict (HashMap) -import Data.List (isPrefixOf) import Data.List.Extra import Data.Maybe import Data.Typeable (TypeRep, typeOf) ===================================== hadrian/src/Settings/Builders/Cabal.hs ===================================== @@ -1,6 +1,5 @@ module Settings.Builders.Cabal (cabalBuilderArgs) where -import Hadrian.Builder (getBuilderPath, needBuilder) import Hadrian.Haskell.Cabal import Builder ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -2,8 +2,6 @@ module Settings.Builders.Ghc (ghcBuilderArgs, haddockGhcArgs) where -import Data.List.Extra (splitOn) - import Hadrian.Haskell.Cabal import Hadrian.Haskell.Cabal.Type ===================================== libraries/base/Control/Monad/ST/Lazy/Imp.hs ===================================== @@ -8,7 +8,7 @@ -- Module : Control.Monad.ST.Lazy.Imp -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) --- +-- -- Maintainer : libraries at haskell.org -- Stability : provisional -- Portability : non-portable (requires universal quantification for runST) @@ -44,7 +44,6 @@ import qualified Control.Monad.ST.Unsafe as ST import qualified GHC.ST as GHC.ST import GHC.Base -import qualified Control.Monad.Fail as Fail -- | The lazy @'ST' monad. -- The ST monad allows for destructive updates, but is escapable (unlike IO). @@ -192,7 +191,7 @@ instance Monad (ST s) where unST (k r) new_s -- | @since 4.10 -instance Fail.MonadFail (ST s) where +instance MonadFail (ST s) where fail s = errorWithoutStackTrace s -- | Return the value computed by an 'ST' computation. @@ -205,8 +204,8 @@ runST (ST st) = runRW# (\s -> case st (S# s) of (r, _) -> r) -- inside the computation. -- Note that if @f@ is strict, @'fixST' f = _|_ at . fixST :: (a -> ST s a) -> ST s a -fixST m = ST (\ s -> - let +fixST m = ST (\ s -> + let q@(r,_s') = unST (m r) s in q) -- Why don't we need unsafePerformIO in fixST? We create a thunk, q, @@ -233,7 +232,7 @@ strictToLazyST (GHC.ST.ST m) = ST $ \(S# s) -> (# s', a #) -> (a, S# s') -- See Note [Lazy ST: not producing lazy pairs] -{-| +{-| Convert a lazy 'ST' computation into a strict one. -} lazyToStrictST :: ST s a -> ST.ST s a ===================================== libraries/base/GHC/IO/Encoding.hs ===================================== @@ -107,6 +107,7 @@ utf32be = UTF32.utf32be -- -- @since 4.5.0.0 getLocaleEncoding :: IO TextEncoding +{-# NOINLINE getLocaleEncoding #-} -- | The Unicode encoding of the current locale, but allowing arbitrary -- undecodable bytes to be round-tripped through it. @@ -120,6 +121,7 @@ getLocaleEncoding :: IO TextEncoding -- -- @since 4.5.0.0 getFileSystemEncoding :: IO TextEncoding +{-# NOINLINE getFileSystemEncoding #-} -- | The Unicode encoding of the current locale, but where undecodable -- bytes are replaced with their closest visual match. Used for @@ -127,9 +129,13 @@ getFileSystemEncoding :: IO TextEncoding -- -- @since 4.5.0.0 getForeignEncoding :: IO TextEncoding +{-# NOINLINE getForeignEncoding #-} -- | @since 4.5.0.0 setLocaleEncoding, setFileSystemEncoding, setForeignEncoding :: TextEncoding -> IO () +{-# NOINLINE setLocaleEncoding #-} +{-# NOINLINE setFileSystemEncoding #-} +{-# NOINLINE setForeignEncoding #-} (getLocaleEncoding, setLocaleEncoding) = mkGlobal initLocaleEncoding (getFileSystemEncoding, setFileSystemEncoding) = mkGlobal initFileSystemEncoding @@ -139,9 +145,13 @@ mkGlobal :: a -> (IO a, a -> IO ()) mkGlobal x = unsafePerformIO $ do x_ref <- newIORef x return (readIORef x_ref, writeIORef x_ref) +{-# NOINLINE mkGlobal #-} -- | @since 4.5.0.0 initLocaleEncoding, initFileSystemEncoding, initForeignEncoding :: TextEncoding +{-# NOINLINE initLocaleEncoding #-} +-- N.B. initLocaleEncoding is exported for use in System.IO.localeEncoding. +-- NOINLINE ensures that this result is shared. #if !defined(mingw32_HOST_OS) -- It is rather important that we don't just call Iconv.mkIconvEncoding here ===================================== libraries/base/GHC/ST.hs ===================================== @@ -26,7 +26,7 @@ module GHC.ST ( import GHC.Base import GHC.Show -import qualified Control.Monad.Fail as Fail +import Control.Monad.Fail default () @@ -79,7 +79,7 @@ instance Monad (ST s) where (k2 new_s) }}) -- | @since 4.11.0.0 -instance Fail.MonadFail (ST s) where +instance MonadFail (ST s) where fail s = errorWithoutStackTrace s -- | @since 4.11.0.0 ===================================== libraries/base/Text/ParserCombinators/ReadPrec.hs ===================================== @@ -64,7 +64,7 @@ import qualified Text.ParserCombinators.ReadP as ReadP import GHC.Num( Num(..) ) import GHC.Base -import qualified Control.Monad.Fail as MonadFail +import Control.Monad.Fail -- --------------------------------------------------------------------------- -- The readPrec type @@ -88,8 +88,8 @@ instance Monad ReadPrec where P f >>= k = P (\n -> do a <- f n; let P f' = k a in f' n) -- | @since 4.9.0.0 -instance MonadFail.MonadFail ReadPrec where - fail s = P (\_ -> MonadFail.fail s) +instance MonadFail ReadPrec where + fail s = P (\_ -> fail s) -- | @since 2.01 instance MonadPlus ReadPrec ===================================== libraries/ghci/GHCi/TH.hs ===================================== @@ -97,7 +97,6 @@ import GHCi.RemoteTypes import GHC.Serialized import Control.Exception -import qualified Control.Monad.Fail as Fail import Control.Monad.IO.Class (MonadIO (..)) import Data.Binary import Data.Binary.Put @@ -144,11 +143,8 @@ instance Monad GHCiQ where do (m', s') <- runGHCiQ m s (a, s'') <- runGHCiQ (f m') s' return (a, s'') -#if !MIN_VERSION_base(4,13,0) - fail = Fail.fail -#endif -instance Fail.MonadFail GHCiQ where +instance MonadFail GHCiQ where fail err = GHCiQ $ \s -> throwIO (GHCiQException s err) getState :: GHCiQ QState ===================================== libraries/integer-gmp/changelog.md ===================================== @@ -1,5 +1,11 @@ # Changelog for [`integer-gmp` package](http://hackage.haskell.org/package/integer-gmp) +## 1.0.3.0 *January 2019* + + * Bundled with GHC 8.10.1 + + * Documentation changes + ## 1.0.2.0 *April 2018* * Bundled with GHC 8.4.2 ===================================== libraries/integer-gmp/integer-gmp.cabal ===================================== @@ -1,6 +1,6 @@ cabal-version: 2.0 name: integer-gmp -version: 1.0.2.0 +version: 1.0.3.0 synopsis: Integer library based on GMP license: BSD3 ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -52,15 +52,13 @@ import Numeric.Natural import Prelude import Foreign.ForeignPtr -import qualified Control.Monad.Fail as Fail - ----------------------------------------------------- -- -- The Quasi class -- ----------------------------------------------------- -class (MonadIO m, Fail.MonadFail m) => Quasi m where +class (MonadIO m, MonadFail m) => Quasi m where qNewName :: String -> m Name -- ^ Fresh names @@ -187,12 +185,9 @@ runQ (Q m) = m instance Monad Q where Q m >>= k = Q (m >>= \x -> unQ (k x)) (>>) = (*>) -#if !MIN_VERSION_base(4,13,0) - fail = Fail.fail -#endif -instance Fail.MonadFail Q where - fail s = report True s >> Q (Fail.fail "Q monad failure") +instance MonadFail Q where + fail s = report True s >> Q (fail "Q monad failure") instance Functor Q where fmap f (Q x) = Q (fmap f x) ===================================== testsuite/tests/polykinds/T17963.hs ===================================== @@ -0,0 +1,15 @@ +{-# Language DataKinds #-} +{-# Language PolyKinds #-} +{-# Language RankNTypes #-} +{-# Language StandaloneKindSignatures #-} +{-# Language TypeApplications #-} +module T17963 where + +import GHC.Types (Constraint, Type, TYPE, RuntimeRep(..)) + +type Cat :: forall (rep :: RuntimeRep). TYPE rep -> Type +type Cat ob = ob -> ob -> Type + +type Category' :: forall rep (ob :: TYPE rep). Cat @rep ob -> Constraint +class Category' (cat :: Cat @rep ob) where + id' :: forall a. cat a a ===================================== testsuite/tests/polykinds/T17963.stderr ===================================== @@ -0,0 +1,13 @@ + +T17963.hs:15:23: error: + • Couldn't match a lifted type with an unlifted type + ‘rep1’ is a rigid type variable bound by + the class declaration for ‘Category'’ + at T17963.hs:13:27-29 + When matching kinds + k0 :: * + ob :: TYPE rep1 + Expected kind ‘ob’, but ‘a’ has kind ‘k0’ + • In the first argument of ‘cat’, namely ‘a’ + In the type signature: id' :: forall a. cat a a + In the class declaration for ‘Category'’ ===================================== testsuite/tests/polykinds/all.T ===================================== @@ -216,3 +216,4 @@ test('T16263', normal, compile_fail, ['']) test('T16902', normal, compile_fail, ['']) test('CuskFam', normal, compile, ['']) test('T17841', normal, compile_fail, ['']) +test('T17963', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/09ca509813d913eb895a8edac961ed7a6bd644a7...95da0b3766223ce5f40ddd9965617bf6776a4ad1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/09ca509813d913eb895a8edac961ed7a6bd644a7...95da0b3766223ce5f40ddd9965617bf6776a4ad1 You're receiving 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 Mar 31 07:16:36 2020 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Tue, 31 Mar 2020 03:16:36 -0400 Subject: [Git][ghc/ghc][wip/absolute-i-paths] Hadrian: Make -i paths absolute Message-ID: <5e82ee549c9ba_61673f8198ee100c16861a8@gitlab.haskell.org.mail> Matthew Pickering pushed to branch wip/absolute-i-paths at Glasgow Haskell Compiler / GHC Commits: 3d0583b1 by Matthew Pickering at 2020-03-31T08:16:25+01: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. - - - - - 1 changed file: - hadrian/src/Settings/Builders/Ghc.hs Changes: ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -13,6 +13,7 @@ import Settings.Builders.Common import Settings.Warnings import qualified Context as Context import Rules.Libffi (libffiName) +import System.Directory ghcBuilderArgs :: Args ghcBuilderArgs = mconcat [ compileAndLinkHs, compileC, findHsDependencies @@ -214,18 +215,19 @@ packageGhcArgs = do includeGhcArgs :: Args includeGhcArgs = do pkg <- getPackage - path <- getBuildPath + path <- exprIO . makeAbsolute =<< getBuildPath context <- getContext srcDirs <- getContextData srcDirs - autogen <- expr $ autogenPath context + abSrcDirs <- exprIO $ mapM makeAbsolute [ (pkgPath pkg -/- dir) | dir <- srcDirs ] + autogen <- exprIO . makeAbsolute =<< expr (autogenPath context) stage <- getStage - libPath <- expr $ stageLibPath stage + libPath <- expr (stageLibPath stage) let cabalMacros = autogen -/- "cabal_macros.h" expr $ need [cabalMacros] mconcat [ arg "-i" , arg $ "-i" ++ path , arg $ "-i" ++ autogen - , pure [ "-i" ++ pkgPath pkg -/- dir | dir <- srcDirs ] + , pure [ "-i" ++ d | d <- abSrcDirs ] , cIncludeArgs , arg $ "-I" ++ libPath , arg $ "-optc-I" ++ libPath View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3d0583b1d6c03a38758dbf2bad9abe37c5cc4b58 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3d0583b1d6c03a38758dbf2bad9abe37c5cc4b58 You're receiving 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 Mar 31 07:36:34 2020 From: gitlab at gitlab.haskell.org (Matthew Pickering) Date: Tue, 31 Mar 2020 03:36:34 -0400 Subject: [Git][ghc/ghc][wip/absolute-i-paths] Hadrian: Make -i paths absolute Message-ID: <5e82f3022c37c_61677b155d81691232@gitlab.haskell.org.mail> Matthew Pickering pushed to branch wip/absolute-i-paths at Glasgow Haskell Compiler / GHC Commits: 636bf8ad by Matthew Pickering at 2020-03-31T08:36:25+01: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. - - - - - 1 changed file: - hadrian/src/Settings/Builders/Ghc.hs Changes: ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -13,6 +13,7 @@ import Settings.Builders.Common import Settings.Warnings import qualified Context as Context import Rules.Libffi (libffiName) +import System.Directory ghcBuilderArgs :: Args ghcBuilderArgs = mconcat [ compileAndLinkHs, compileC, findHsDependencies @@ -214,18 +215,20 @@ packageGhcArgs = do includeGhcArgs :: Args includeGhcArgs = do pkg <- getPackage - path <- getBuildPath + path <- exprIO . makeAbsolute =<< getBuildPath context <- getContext srcDirs <- getContextData srcDirs - autogen <- expr $ autogenPath context + abSrcDirs <- exprIO $ mapM makeAbsolute [ (pkgPath pkg -/- dir) | dir <- srcDirs ] + autogen <- expr (autogenPath context) + cautogen <- exprIO (makeAbsolute autogen) stage <- getStage - libPath <- expr $ stageLibPath stage + libPath <- expr (stageLibPath stage) let cabalMacros = autogen -/- "cabal_macros.h" expr $ need [cabalMacros] mconcat [ arg "-i" , arg $ "-i" ++ path - , arg $ "-i" ++ autogen - , pure [ "-i" ++ pkgPath pkg -/- dir | dir <- srcDirs ] + , arg $ "-i" ++ cautogen + , pure [ "-i" ++ d | d <- abSrcDirs ] , cIncludeArgs , arg $ "-I" ++ libPath , arg $ "-optc-I" ++ libPath View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/636bf8ad7280623bdb2d0f9b49168af9290b406f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/636bf8ad7280623bdb2d0f9b49168af9290b406f You're receiving 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 Mar 31 09:14:13 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 31 Mar 2020 05:14:13 -0400 Subject: [Git][ghc/ghc][wip/T13380] 2 commits: Expect T4267 to pass Message-ID: <5e8309e52c397_6167116c28dc1722466@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T13380 at Glasgow Haskell Compiler / GHC Commits: 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. - - - - - 76a92172 by Sebastian Graf at 2020-03-31T05:14:09-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. - - - - - 6 changed files: - compiler/GHC/Core/Op/Simplify/Utils.hs - compiler/GHC/Types/Demand.hs - compiler/prelude/primops.txt.pp - testsuite/tests/perf/should_run/all.T - + testsuite/tests/stranal/should_run/T17676.hs - testsuite/tests/stranal/should_run/all.T Changes: ===================================== compiler/GHC/Core/Op/Simplify/Utils.hs ===================================== @@ -56,12 +56,13 @@ import GHC.Types.Id import GHC.Types.Id.Info import GHC.Types.Var import GHC.Types.Demand +import GHC.Types.Var.Set +import GHC.Types.Basic +import PrimOp import GHC.Core.Op.Simplify.Monad import GHC.Core.Type hiding( substTy ) import GHC.Core.Coercion hiding( substCo ) import GHC.Core.DataCon ( dataConWorkId, isNullaryRepDataCon ) -import GHC.Types.Var.Set -import GHC.Types.Basic import Util import OrdList ( isNilOL ) import MonadUtils @@ -500,7 +501,9 @@ mkArgInfo env fun rules n_val_args call_cont -- calls to error. But now we are more careful about -- inlining lone variables, so it's ok -- (see GHC.Core.Op.Simplify.Utils.analyseCont) - if isBotDiv result_info then + -- See Note [Precise exceptions and strictness analysis] in Demand.hs + -- for the special case on raiseIO# + if isBotDiv result_info || isPrimOpId_maybe fun == Just RaiseIOOp then map isStrictDmd demands -- Finite => result is bottom else map isStrictDmd demands ++ vanilla_stricts ===================================== compiler/GHC/Types/Demand.hs ===================================== @@ -931,6 +931,53 @@ instance Outputable Divergence where ppr Diverges = char 'b' ppr Dunno = empty +{- Note [Precise vs imprecise exceptions] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +An exception is considered to be /precise/ when it is thrown by the 'raiseIO#' +primop. It follows that all other primops (such as 'raise#' or +division-by-zero) throw /imprecise/ exceptions. Note that the actual type of +the exception thrown doesn't have any impact! + +GHC undertakes some effort not to apply an optimisation that would mask a +/precise/ exception with some other source of nontermination, such as genuine +divergence or an imprecise exception, so that the user can reliably +intercept the precise exception with a catch handler before and after +optimisations. + +See also the wiki page on precise exceptions: +https://gitlab.haskell.org/ghc/ghc/-/wikis/exceptions/precise-exceptions +Section 5 of "Tackling the awkward squad" talks about semantic concerns. +Imprecise exceptions are actually more interesting than precise ones (which are +fairly standard) from the perspective of semantics. See the paper "A Semantics +for Imprecise Exceptions" for more details. + +Note [Precise exceptions and strictness analysis] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +raiseIO# raises a *precise* exception, in contrast to raise# which +raise an *imprecise* exception. See Note [Precise vs imprecise exceptions] +in XXXX. + +Unlike raise# (which returns botDiv), we want raiseIO# to return topDiv. +Here's why. Consider this example from #13380 (similarly #17676): + f x y | x>0 = raiseIO Exc + | y>0 = return 1 + | otherwise = return 2 +Is 'f' strict in 'y'? One might be tempted to say yes! But that plays fast and +loose with the precise exception; after optimisation, (f 42 (error "boom")) +turns from throwing the precise Exc to throwing the imprecise user error +"boom". So, the defaultDmd of raiseIO# should be lazy (topDmd), which can be +achieved by giving it divergence topDiv. + +But if it returns topDiv, the simplifier will fail to discard raiseIO#'s +continuation in + case raiseIO# x s of { (# s', r #) -> } +which we'd like to optimise to + raiseIO# x s +Temporary hack solution: special treatment for raiseIO# in +Simplifier.Utils.mkArgInfo. +-} + + ------------------------------------------------------------------------ -- Combined demand result -- ------------------------------------------------------------------------ ===================================== compiler/prelude/primops.txt.pp ===================================== @@ -2644,27 +2644,12 @@ primop RaiseOverflowOp "raiseOverflow#" GenPrimOp out_of_line = True has_side_effects = True --- raiseIO# needs to be a primop, because exceptions in the IO monad --- must be *precise* - we don't want the strictness analyser turning --- one kind of bottom into another, as it is allowed to do in pure code. --- --- But we *do* want to know that it returns bottom after --- being applied to two arguments, so that this function is strict in y --- f x y | x>0 = raiseIO blah --- | y>0 = return 1 --- | otherwise = return 2 --- --- TODO Check that the above notes on @f@ are valid. The function successfully --- produces an IO exception when compiled without optimization. If we analyze --- it as strict in @y@, won't we change that behavior under optimization? --- I thought the rule was that it was okay to replace one valid imprecise --- exception with another, but not to replace a precise exception with --- an imprecise one (dfeuer, 2017-03-05). - primop RaiseIOOp "raiseIO#" GenPrimOp a -> State# RealWorld -> (# State# RealWorld, b #) with - strictness = { \ _arity -> mkClosedStrictSig [topDmd, topDmd] botDiv } + -- See Note [Precise exceptions and strictness analysis] in Demand.hs + -- for why we give it topDiv + -- strictness = { \ _arity -> mkClosedStrictSig [topDmd, topDmd] topDiv } out_of_line = True has_side_effects = True ===================================== testsuite/tests/perf/should_run/all.T ===================================== @@ -233,8 +233,7 @@ test('T5949', ['-O']) test('T4267', - [expect_broken(4267), - collect_stats('bytes allocated',10), + [collect_stats('bytes allocated',10), only_ways(['normal'])], compile_and_run, ['-O']) ===================================== testsuite/tests/stranal/should_run/T17676.hs ===================================== @@ -0,0 +1,18 @@ +{-# LANGUAGE ScopedTypeVariables #-} +import Data.IORef +import Control.Exception +import Control.Monad + +data Exc = Exc deriving Show + +instance Exception Exc + +-- Recursive instead of NOINLINE because of #17673 +f :: Int -> Int -> IO () +f 0 x = do + let true = sum [0..4] == 10 + when true $ throwIO Exc + x `seq` return () +f n x = f (n-1) (x+1) + +main = f 1 (error "expensive computation") `catch` \(_ :: Exc) -> return () ===================================== testsuite/tests/stranal/should_run/all.T ===================================== @@ -19,7 +19,8 @@ test('T11076', normal, multimod_compile_and_run, ['T11076.hs', 'T11076_prim.cmm' test('T11555a', normal, compile_and_run, ['']) test('T12368', exit_code(1), compile_and_run, ['']) test('T12368a', exit_code(1), compile_and_run, ['']) -test('T13380', [expect_broken(13380), exit_code(1)], compile_and_run, ['']) +test('T13380', exit_code(1), compile_and_run, ['']) 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, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/833ac79d175a652b9036a657a27d0e329b9c77df...76a9217261731c7890feebbb1a006f183c71a61c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/833ac79d175a652b9036a657a27d0e329b9c77df...76a9217261731c7890feebbb1a006f183c71a61c You're receiving 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 Mar 31 09:48:48 2020 From: gitlab at gitlab.haskell.org (Andreas Klebinger) Date: Tue, 31 Mar 2020 05:48:48 -0400 Subject: [Git][ghc/ghc][wip/andreask/hadrian_no_colour] 2 commits: Expect T4267 to pass Message-ID: <5e831200914c0_6167e0e2c941725094@gitlab.haskell.org.mail> Andreas Klebinger pushed to branch wip/andreask/hadrian_no_colour at Glasgow Haskell Compiler / GHC Commits: 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. - - - - - b314e5b6 by Andreas Klebinger at 2020-03-31T05:48:46-04:00 Make hadrian pass on the no-colour setting to GHC. Fixes #17983. - - - - - 2 changed files: - hadrian/src/Settings/Builders/Ghc.hs - testsuite/tests/perf/should_run/all.T Changes: ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -31,9 +31,12 @@ toolArgs = do compileAndLinkHs :: Args compileAndLinkHs = (builder (Ghc CompileHs) ||^ builder (Ghc LinkHs)) ? do ways <- getLibraryWays + useColor <- shakeColor <$> expr getShakeOptions let hasVanilla = elem vanilla ways hasDynamic = elem dynamic ways mconcat [ arg "-Wall" + , not useColor ? builder (Ghc CompileHs) ? + arg "-fdiagnostics-color=never" , (hasVanilla && hasDynamic) ? builder (Ghc CompileHs) ? platformSupportsSharedLibs ? way vanilla ? arg "-dynamic-too" ===================================== testsuite/tests/perf/should_run/all.T ===================================== @@ -233,8 +233,7 @@ test('T5949', ['-O']) test('T4267', - [expect_broken(4267), - collect_stats('bytes allocated',10), + [collect_stats('bytes allocated',10), only_ways(['normal'])], compile_and_run, ['-O']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/16c456862bbba59310c17574ee10cb9b5853c133...b314e5b648e48ac40f1b20b713920c7ea1c31304 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/16c456862bbba59310c17574ee10cb9b5853c133...b314e5b648e48ac40f1b20b713920c7ea1c31304 You're receiving 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 Mar 31 10:02:52 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 31 Mar 2020 06:02:52 -0400 Subject: [Git][ghc/ghc][wip/T17977] PmCheck: Adjust recursion depth for inhabitation test Message-ID: <5e83154ccceb8_61673f8198ee100c1731041@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T17977 at Glasgow Haskell Compiler / GHC Commits: ed58d4fd by Sebastian Graf at 2020-03-31T12:02:22+02: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. - - - - - 5 changed files: - compiler/GHC/HsToCore/PmCheck/Oracle.hs - + testsuite/tests/pmcheck/should_compile/T17977.hs - + testsuite/tests/pmcheck/should_compile/T17977b.hs - + testsuite/tests/pmcheck/should_compile/T17977b.stderr - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== compiler/GHC/HsToCore/PmCheck/Oracle.hs ===================================== @@ -1319,10 +1319,11 @@ checkAllNonVoid :: RecTcChecker -> Delta -> [Type] -> DsM Bool checkAllNonVoid rec_ts amb_cs strict_arg_tys = do let definitely_inhabited = definitelyInhabitedType (delta_ty_st amb_cs) tys_to_check <- filterOutM definitely_inhabited strict_arg_tys + -- See Note [Fuel for the inhabitation test] let rec_max_bound | tys_to_check `lengthExceeds` 1 = 1 | otherwise - = defaultRecTcMaxBound + = 3 rec_ts' = setRecTcMaxBound rec_max_bound rec_ts allM (nonVoid rec_ts' amb_cs) tys_to_check @@ -1342,6 +1343,7 @@ nonVoid rec_ts amb_cs strict_arg_ty = do mb_cands <- inhabitationCandidates amb_cs strict_arg_ty case mb_cands of Right (tc, _, cands) + -- See Note [Fuel for the inhabitation test] | Just rec_ts' <- checkRecTc rec_ts tc -> anyM (cand_is_inhabitable rec_ts' amb_cs) cands -- A strict argument type is inhabitable by a terminating value if @@ -1390,7 +1392,7 @@ definitelyInhabitedType ty_st ty = do null (dataConImplBangs con) -- (2) {- Note [Strict argument type constraints] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In the ConVar case of clause processing, each conlike K traditionally generates two different forms of constraints: @@ -1420,6 +1422,7 @@ say, `K2 undefined` or `K2 (let x = x in x)`.) Since neither the term nor type constraints mentioned above take strict argument types into account, we make use of the `nonVoid` function to determine whether a strict type is inhabitable by a terminating value or not. +We call this the "inhabitation test". `nonVoid ty` returns True when either: 1. `ty` has at least one InhabitationCandidate for which both its term and type @@ -1445,15 +1448,20 @@ determine whether a strict type is inhabitable by a terminating value or not. `nonVoid MyVoid` returns False. The InhabitationCandidate for the MkMyVoid constructor contains Void as a strict argument type, and since `nonVoid Void` returns False, that InhabitationCandidate is discarded, leaving no others. +* Whether or not a type is inhabited is undecidable in general. + See Note [Fuel for the inhabitation test]. +* For some types, inhabitation is evident immediately and we don't need to + perform expensive tests. See Note [Types that are definitely inhabitable]. -* Performance considerations +Note [Fuel for the inhabitation test] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Whether or not a type is inhabited is undecidable in general. As a result, we +can run into infinite loops in `nonVoid`. Therefore, we adopt a fuel-based +approach to prevent that. -We must be careful when recursively calling `nonVoid` on the strict argument -types of an InhabitationCandidate, because doing so naïvely can cause GHC to -fall into an infinite loop. Consider the following example: +Consider the following example: data Abyss = MkAbyss !Abyss - stareIntoTheAbyss :: Abyss -> a stareIntoTheAbyss x = case x of {} @@ -1474,7 +1482,6 @@ stareIntoTheAbyss above. Then again, the same problem occurs with recursive newtypes, like in the following code: newtype Chasm = MkChasm Chasm - gazeIntoTheChasm :: Chasm -> a gazeIntoTheChasm x = case x of {} -- Erroneously warned as non-exhaustive @@ -1498,9 +1505,26 @@ maximum recursion depth to 1 to mitigate the problem. If the branching factor is exactly 1 (i.e., we have a linear chain instead of a tree), then it's okay to stick with a larger maximum recursion depth. +In #17977 we saw that the defaultRecTcMaxBound (100 at the time of writing) was +too large and had detrimental effect on performance of the coverage checker. +Given that we only commit to a best effort anyway, we decided to substantially +decrement the recursion depth to 3, at the cost of precision in some edge cases +like + + data Nat = Z | S Nat + data Down :: Nat -> Type where + Down :: !(Down n) -> Down (S n) + f :: Down (S (S (S (S (S Z))))) -> () + f x = case x of {} + +Since the coverage won't bother to instantiate Down 4 levels deep to see that it +is in fact uninhabited, it will emit a inexhaustivity warning for the case. + +Note [Types that are definitely inhabitable] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Another microoptimization applies to data types like this one: - data S a = ![a] !T + data S a = S ![a] !T Even though there is a strict field of type [a], it's quite silly to call nonVoid on it, since it's "obvious" that it is inhabitable. To make this ===================================== testsuite/tests/pmcheck/should_compile/T17977.hs ===================================== @@ -0,0 +1,33 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +module Bug where + +import Data.Kind +import Data.Type.Equality + +data Nat = Z | S Nat + +data SNat :: Nat -> Type where + SZ :: SNat Z + SS :: SNat n -> SNat (S n) + +type family S' (n :: Nat) :: Nat where + S' n = S n + +data R :: Nat -> Nat -> Nat -> Type where + MkR :: !(R m n o) -> R (S m) n (S o) + +type family NatPlus (m :: Nat) (n :: Nat) :: Nat where + NatPlus Z n = n + NatPlus (S m) n = S' (NatPlus m n) + +f :: forall (m :: Nat) (n :: Nat) (o :: Nat). + SNat m -> SNat n -> SNat o + -> R m n o -> NatPlus m n :~: o +f (SS sm) sn (SS so) (MkR r) + | Refl <- f sm sn so r + = Refl ===================================== testsuite/tests/pmcheck/should_compile/T17977b.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE EmptyCase #-} +module Bug where + +import Data.Kind + +data Nat = Z | S Nat + +data Down :: Nat -> Type where + Down :: !(Down n) -> Down (S n) + +data Up :: Nat -> Type where + Up :: !(Up (S n)) -> Up n + +f :: Down n -> () +f (Down r) = () + +f' :: Down (S (S (S (S Z)))) -> () +f' (Down r) = () + +g :: Up n -> () +g (Up r) = () ===================================== testsuite/tests/pmcheck/should_compile/T17977b.stderr ===================================== @@ -0,0 +1,4 @@ + +T17977b.hs:21:1: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match has inaccessible right hand side + In an equation for ‘f'’: f' (Down r) = ... ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -114,6 +114,10 @@ test('T17703', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17783', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T17977', collect_compiler_stats('bytes allocated',10), compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T17977b', collect_compiler_stats('bytes allocated',10), compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) # Other tests test('pmc001', [], compile, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ed58d4fdcbc7b4fa8fbdf3d638a8d53c444ef4f2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ed58d4fdcbc7b4fa8fbdf3d638a8d53c444ef4f2 You're receiving 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 Mar 31 10:11:56 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 31 Mar 2020 06:11:56 -0400 Subject: [Git][ghc/ghc][wip/dmdanal-precise-exn] 18 commits: Expect T4267 to pass Message-ID: <5e83176c14db_6167120434ec1736315@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/dmdanal-precise-exn at Glasgow Haskell Compiler / GHC Commits: 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. - - - - - 76a92172 by Sebastian Graf at 2020-03-31T05:14:09-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. - - - - - 06c8b080 by Sebastian Graf at 2020-03-31T12:11:40+02:00 Add ConOrDiv to Divergence and see where it gets us - - - - - 2a28d9d0 by Sebastian Graf at 2020-03-31T12:11:40+02:00 Actually use conDiv - - - - - ac5a2e72 by Sebastian Graf at 2020-03-31T12:11:40+02:00 Attempt to make ensureArgs do the right thing - - - - - a8502bba by Sebastian Graf at 2020-03-31T12:11:40+02:00 More pondering over the can of worms I opened - - - - - 29d15c91 by Sebastian Graf at 2020-03-31T12:11:40+02:00 A bunch of fixes involving the new Divergence lattice - - - - - 36c3e06b by Sebastian Graf at 2020-03-31T12:11:40+02:00 typo - - - - - c3b5b44f by Sebastian Graf at 2020-03-31T12:11:40+02:00 Add strictness signature for a bunch of wired in Ids - - - - - d6426b0a by Sebastian Graf at 2020-03-31T12:11:40+02:00 Accept a bunch of testcase changes - - - - - dd3168b2 by Sebastian Graf at 2020-03-31T12:11:40+02:00 Rename isBot* to isDeadEnd* - - - - - 849b89d8 by Sebastian Graf at 2020-03-31T12:11:40+02:00 Comments - - - - - 160183d5 by Sebastian Graf at 2020-03-31T12:11:40+02:00 Assume that precise exceptions can only be thrown from IO - - - - - 5469f5c3 by Sebastian Graf at 2020-03-31T12:11:40+02:00 Accept new testsuite results - - - - - f26c24c3 by Sebastian Graf at 2020-03-31T12:11:40+02:00 Polish Notes - - - - - 556fe9a9 by Sebastian Graf at 2020-03-31T12:11:40+02:00 More comments - - - - - eea13050 by Sebastian Graf at 2020-03-31T12:11:40+02:00 Change forcesRealWorld to work like the old IO hack - - - - - 3e884a2e by Sebastian Graf at 2020-03-31T12:11:40+02:00 Revert "Change forcesRealWorld to work like the old IO hack" This reverts commit 516987db1eb32bb231063e1e0fa4ff78178b15c9. - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Core/Arity.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Op/CallArity.hs - compiler/GHC/Core/Op/DmdAnal.hs - compiler/GHC/Core/Op/FloatIn.hs - compiler/GHC/Core/Op/FloatOut.hs - compiler/GHC/Core/Op/LiberateCase.hs - compiler/GHC/Core/Op/SetLevels.hs - compiler/GHC/Core/Op/Simplify.hs - compiler/GHC/Core/Op/Simplify/Utils.hs - compiler/GHC/Core/Op/SpecConstr.hs - compiler/GHC/Core/Op/WorkWrap/Lib.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Types/Demand.hs - compiler/GHC/Types/Id.hs - compiler/GHC/Types/Id/Info.hs - compiler/GHC/Types/Id/Make.hs - compiler/prelude/primops.txt.pp - testsuite/tests/deSugar/should_compile/T2431.stderr - testsuite/tests/numeric/should_compile/T14170.stdout - testsuite/tests/numeric/should_compile/T14465.stdout - testsuite/tests/numeric/should_compile/T7116.stdout - testsuite/tests/perf/should_run/all.T - testsuite/tests/simplCore/should_compile/T13143.stderr - testsuite/tests/simplCore/should_compile/T13543.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c873b3b99adb4d4dd3214ae65c21f5c0452853f8...3e884a2ea78aa2e98612404642b7acafe46ec97c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c873b3b99adb4d4dd3214ae65c21f5c0452853f8...3e884a2ea78aa2e98612404642b7acafe46ec97c You're receiving 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 Mar 31 10:51:14 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 31 Mar 2020 06:51:14 -0400 Subject: [Git][ghc/ghc][wip/T13380] Preserve precise exceptions in strictness analysis Message-ID: <5e8320a2a45c8_61677b155d8174647a@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T13380 at Glasgow Haskell Compiler / GHC Commits: 17694f57 by Sebastian Graf at 2020-03-31T12:51:03+02: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. - - - - - 5 changed files: - compiler/GHC/Core/Op/Simplify/Utils.hs - compiler/GHC/Types/Demand.hs - compiler/prelude/primops.txt.pp - + testsuite/tests/stranal/should_run/T17676.hs - testsuite/tests/stranal/should_run/all.T Changes: ===================================== compiler/GHC/Core/Op/Simplify/Utils.hs ===================================== @@ -56,12 +56,13 @@ import GHC.Types.Id import GHC.Types.Id.Info import GHC.Types.Var import GHC.Types.Demand +import GHC.Types.Var.Set +import GHC.Types.Basic +import PrimOp import GHC.Core.Op.Simplify.Monad import GHC.Core.Type hiding( substTy ) import GHC.Core.Coercion hiding( substCo ) import GHC.Core.DataCon ( dataConWorkId, isNullaryRepDataCon ) -import GHC.Types.Var.Set -import GHC.Types.Basic import Util import OrdList ( isNilOL ) import MonadUtils @@ -500,7 +501,9 @@ mkArgInfo env fun rules n_val_args call_cont -- calls to error. But now we are more careful about -- inlining lone variables, so it's ok -- (see GHC.Core.Op.Simplify.Utils.analyseCont) - if isBotDiv result_info then + -- See Note [Precise exceptions and strictness analysis] in Demand.hs + -- for the special case on raiseIO# + if isBotDiv result_info || isPrimOpId_maybe fun == Just RaiseIOOp then map isStrictDmd demands -- Finite => result is bottom else map isStrictDmd demands ++ vanilla_stricts ===================================== compiler/GHC/Types/Demand.hs ===================================== @@ -931,6 +931,54 @@ instance Outputable Divergence where ppr Diverges = char 'b' ppr Dunno = empty +{- Note [Precise vs imprecise exceptions] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +An exception is considered to be /precise/ when it is thrown by the 'raiseIO#' +primop. It follows that all other primops (such as 'raise#' or +division-by-zero) throw /imprecise/ exceptions. Note that the actual type of +the exception thrown doesn't have any impact! + +GHC undertakes some effort not to apply an optimisation that would mask a +/precise/ exception with some other source of nontermination, such as genuine +divergence or an imprecise exception, so that the user can reliably +intercept the precise exception with a catch handler before and after +optimisations. + +See also the wiki page on precise exceptions: +https://gitlab.haskell.org/ghc/ghc/wikis/exceptions/precise-exceptions +Section 5 of "Tackling the awkward squad" talks about semantic concerns. +Imprecise exceptions are actually more interesting than precise ones (which are +fairly standard) from the perspective of semantics. See the paper "A Semantics +for Imprecise Exceptions" for more details. + +Note [Precise exceptions and strictness analysis] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +raiseIO# raises a *precise* exception, in contrast to raise# which +raise an *imprecise* exception. See Note [Precise vs imprecise exceptions] +in XXXX. + +Unlike raise# (which returns botDiv), we want raiseIO# to return topDiv. +Here's why. Consider this example from #13380 (similarly #17676): + f x y | x>0 = raiseIO Exc + | y>0 = return 1 + | otherwise = return 2 +Is 'f' strict in 'y'? One might be tempted to say yes! But that plays fast and +loose with the precise exception; after optimisation, (f 42 (error "boom")) +turns from throwing the precise Exc to throwing the imprecise user error +"boom". So, the defaultDmd of raiseIO# should be lazy (topDmd), which can be +achieved by giving it divergence topDiv. + +But if it returns topDiv, the simplifier will fail to discard raiseIO#'s +continuation in + case raiseIO# x s of { (# s', r #) -> } +which we'd like to optimise to + raiseIO# x s +Temporary hack solution: special treatment for raiseIO# in +Simplifier.Utils.mkArgInfo. For the non-hack solution, see +https://gitlab.haskell.org/ghc/ghc/wikis/fixing-precise-exceptions#replacing-hacks-by-principled-program-analyses +-} + + ------------------------------------------------------------------------ -- Combined demand result -- ------------------------------------------------------------------------ ===================================== compiler/prelude/primops.txt.pp ===================================== @@ -2644,27 +2644,12 @@ primop RaiseOverflowOp "raiseOverflow#" GenPrimOp out_of_line = True has_side_effects = True --- raiseIO# needs to be a primop, because exceptions in the IO monad --- must be *precise* - we don't want the strictness analyser turning --- one kind of bottom into another, as it is allowed to do in pure code. --- --- But we *do* want to know that it returns bottom after --- being applied to two arguments, so that this function is strict in y --- f x y | x>0 = raiseIO blah --- | y>0 = return 1 --- | otherwise = return 2 --- --- TODO Check that the above notes on @f@ are valid. The function successfully --- produces an IO exception when compiled without optimization. If we analyze --- it as strict in @y@, won't we change that behavior under optimization? --- I thought the rule was that it was okay to replace one valid imprecise --- exception with another, but not to replace a precise exception with --- an imprecise one (dfeuer, 2017-03-05). - primop RaiseIOOp "raiseIO#" GenPrimOp a -> State# RealWorld -> (# State# RealWorld, b #) with - strictness = { \ _arity -> mkClosedStrictSig [topDmd, topDmd] botDiv } + -- See Note [Precise exceptions and strictness analysis] in Demand.hs + -- for why we give it topDiv + -- strictness = { \ _arity -> mkClosedStrictSig [topDmd, topDmd] topDiv } out_of_line = True has_side_effects = True ===================================== testsuite/tests/stranal/should_run/T17676.hs ===================================== @@ -0,0 +1,18 @@ +{-# LANGUAGE ScopedTypeVariables #-} +import Data.IORef +import Control.Exception +import Control.Monad + +data Exc = Exc deriving Show + +instance Exception Exc + +-- Recursive instead of NOINLINE because of #17673 +f :: Int -> Int -> IO () +f 0 x = do + let true = sum [0..4] == 10 + when true $ throwIO Exc + x `seq` return () +f n x = f (n-1) (x+1) + +main = f 1 (error "expensive computation") `catch` \(_ :: Exc) -> return () ===================================== testsuite/tests/stranal/should_run/all.T ===================================== @@ -19,7 +19,8 @@ test('T11076', normal, multimod_compile_and_run, ['T11076.hs', 'T11076_prim.cmm' test('T11555a', normal, compile_and_run, ['']) test('T12368', exit_code(1), compile_and_run, ['']) test('T12368a', exit_code(1), compile_and_run, ['']) -test('T13380', [expect_broken(13380), exit_code(1)], compile_and_run, ['']) +test('T13380', exit_code(1), compile_and_run, ['']) 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, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/17694f578bc751cf78d64c4bad2f58da4f4c6f7f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/17694f578bc751cf78d64c4bad2f58da4f4c6f7f You're receiving 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 Mar 31 12:48:52 2020 From: gitlab at gitlab.haskell.org (Andreas Klebinger) Date: Tue, 31 Mar 2020 08:48:52 -0400 Subject: [Git][ghc/ghc][wip/andreask/tools_unlines] 2 commits: integer-gmp: Bump version and add changelog entry Message-ID: <5e833c344a089_61673f8198ee100c17536fe@gitlab.haskell.org.mail> Andreas Klebinger pushed to branch wip/andreask/tools_unlines at Glasgow Haskell Compiler / GHC Commits: 904b9a8b by Ben Gamari at 2020-03-30T16:12:04+02:00 integer-gmp: Bump version and add changelog entry - - - - - 27afb40e by Andreas Klebinger at 2020-03-31T14:48:36+02:00 Turn newlines into spaces for hadrian/ghci. The newlines break the command on windows. - - - - - 4 changed files: - hadrian/ghci-cabal - hadrian/ghci-stack - libraries/integer-gmp/changelog.md - libraries/integer-gmp/integer-gmp.cabal Changes: ===================================== hadrian/ghci-cabal ===================================== @@ -2,5 +2,6 @@ set -e -GHC_FLAGS="$GHC_FLAGS $(TERM=dumb CABFLAGS=-v0 "hadrian/build-cabal" tool-args -q --build-root=.hadrian_ghci --flavour=ghc-in-ghci "$@")" +# Replace newlines with spaces, as these otherwise break the ghci invocation on windows. +GHC_FLAGS="$GHC_FLAGS $(TERM=dumb CABFLAGS=-v0 "hadrian/build-cabal" tool-args -q --build-root=.hadrian_ghci --flavour=ghc-in-ghci "$@" | tr '\n\r' ' ')" ghci $GHC_FLAGS "$@" -fno-code -fwrite-interface -hidir=.hadrian_ghci/interface -O0 ghc/Main.hs +RTS -A128m ===================================== hadrian/ghci-stack ===================================== @@ -2,5 +2,6 @@ set -e -GHC_FLAGS="$GHC_FLAGS $(TERM=dumb CABFLAGS=-v0 "hadrian/build-stack" tool-args -q --build-root=.hadrian_ghci --flavour=ghc-in-ghci "$@")" +# Replace newlines with spaces, as these otherwise break the ghci invocation on windows. +GHC_FLAGS="$GHC_FLAGS $(TERM=dumb CABFLAGS=-v0 "hadrian/build-stack" tool-args -q --build-root=.hadrian_ghci --flavour=ghc-in-ghci "$@" | tr '\n\r' ' ')" stack exec -- ghci $GHC_FLAGS "$@" -fno-code -fwrite-interface -hidir=.hadrian_ghci/interface -O0 ghc/Main.hs +RTS -A128m ===================================== libraries/integer-gmp/changelog.md ===================================== @@ -1,5 +1,11 @@ # Changelog for [`integer-gmp` package](http://hackage.haskell.org/package/integer-gmp) +## 1.0.3.0 *January 2019* + + * Bundled with GHC 8.10.1 + + * Documentation changes + ## 1.0.2.0 *April 2018* * Bundled with GHC 8.4.2 ===================================== libraries/integer-gmp/integer-gmp.cabal ===================================== @@ -1,6 +1,6 @@ cabal-version: 2.0 name: integer-gmp -version: 1.0.2.0 +version: 1.0.3.0 synopsis: Integer library based on GMP license: BSD3 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4a8d552c133af58f2f609513c867a44969f7c436...27afb40e8b75d81171ce8f8ab916ef90e0de605c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4a8d552c133af58f2f609513c867a44969f7c436...27afb40e8b75d81171ce8f8ab916ef90e0de605c You're receiving 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 Mar 31 12:49:40 2020 From: gitlab at gitlab.haskell.org (Andreas Klebinger) Date: Tue, 31 Mar 2020 08:49:40 -0400 Subject: [Git][ghc/ghc][wip/andreask/tools_unlines] Turn newlines into spaces for hadrian/ghci. Message-ID: <5e833c647b09b_616776d1c7417554b0@gitlab.haskell.org.mail> Andreas Klebinger pushed to branch wip/andreask/tools_unlines at Glasgow Haskell Compiler / GHC Commits: a9d52538 by Andreas Klebinger at 2020-03-31T14:49:32+02:00 Turn newlines into spaces for hadrian/ghci. The newlines break the command on windows. - - - - - 2 changed files: - hadrian/ghci-cabal - hadrian/ghci-stack Changes: ===================================== hadrian/ghci-cabal ===================================== @@ -2,5 +2,6 @@ set -e -GHC_FLAGS="$GHC_FLAGS $(TERM=dumb CABFLAGS=-v0 "hadrian/build-cabal" tool-args -q --build-root=.hadrian_ghci --flavour=ghc-in-ghci "$@")" +# Replace newlines with spaces, as these otherwise break the ghci invocation on windows. +GHC_FLAGS="$GHC_FLAGS $(TERM=dumb CABFLAGS=-v0 "hadrian/build-cabal" tool-args -q --build-root=.hadrian_ghci --flavour=ghc-in-ghci "$@" | tr '\n\r' ' ')" ghci $GHC_FLAGS "$@" -fno-code -fwrite-interface -hidir=.hadrian_ghci/interface -O0 ghc/Main.hs +RTS -A128m ===================================== hadrian/ghci-stack ===================================== @@ -2,5 +2,6 @@ set -e -GHC_FLAGS="$GHC_FLAGS $(TERM=dumb CABFLAGS=-v0 "hadrian/build-stack" tool-args -q --build-root=.hadrian_ghci --flavour=ghc-in-ghci "$@")" +# Replace newlines with spaces, as these otherwise break the ghci invocation on windows. +GHC_FLAGS="$GHC_FLAGS $(TERM=dumb CABFLAGS=-v0 "hadrian/build-stack" tool-args -q --build-root=.hadrian_ghci --flavour=ghc-in-ghci "$@" | tr '\n\r' ' ')" stack exec -- ghci $GHC_FLAGS "$@" -fno-code -fwrite-interface -hidir=.hadrian_ghci/interface -O0 ghc/Main.hs +RTS -A128m View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a9d525389b3e560e9760ac550bba82656b3b415b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a9d525389b3e560e9760ac550bba82656b3b415b You're receiving 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 Mar 31 12:55:39 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Tue, 31 Mar 2020 08:55:39 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T17979 Message-ID: <5e833dcbd6435_6167120434ec175909c@gitlab.haskell.org.mail> Ryan Scott pushed new branch wip/T17979 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T17979 You're receiving 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 Mar 31 14:22:51 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Tue, 31 Mar 2020 10:22:51 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T17313 Message-ID: <5e83523b28227_61673f8198ee100c1795630@gitlab.haskell.org.mail> Ryan Scott pushed new branch wip/T17313 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T17313 You're receiving 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 Mar 31 14:37:18 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Tue, 31 Mar 2020 10:37:18 -0400 Subject: [Git][ghc/ghc][wip/T17313] Clean up "Eta reduction for data families" Notes Message-ID: <5e83559e211a7_6167e0e2c94180161@gitlab.haskell.org.mail> Ryan Scott pushed to branch wip/T17313 at Glasgow Haskell Compiler / GHC Commits: 0bae7ba2 by Ryan Scott at 2020-03-31T10:36:54-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] - - - - - 7 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/TyCon.hs - compiler/typecheck/TcDeriv.hs - compiler/typecheck/TcInstDcls.hs - compiler/typecheck/TcSplice.hs Changes: ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -245,7 +245,7 @@ ppr_co_ax_branch ppr_rhs fam_tc branch -- Eta-expand LHS and RHS types, because sometimes data family -- instances are eta-reduced. - -- See Note [Eta reduction for data families] in GHC.Core.FamInstEnv. + -- See Note [Eta reduction for data families] in GHC.Core.Coercion.Axiom. (ee_tvs, ee_lhs, ee_rhs) = etaExpandCoAxBranch branch pp_lhs = pprIfaceTypeApp topPrec (toIfaceTyCon fam_tc) ===================================== compiler/GHC/Core/Coercion/Axiom.hs ===================================== @@ -235,7 +235,7 @@ data CoAxBranch , cab_tvs :: [TyVar] -- Bound type variables; not necessarily fresh , cab_eta_tvs :: [TyVar] -- Eta-reduced tyvars -- See Note [CoAxBranch type variables] - -- cab_tvs and cab_lhs may be eta-reduded; see + -- cab_tvs and cab_lhs may be eta-reduced; see -- Note [Eta reduction for data families] , cab_cvs :: [CoVar] -- Bound coercion variables -- Always empty, for now. @@ -443,9 +443,13 @@ looked like (See #9692, #14179, and #15845 for examples of what can go wrong if we don't eta-expand when showing things to the user.) -(See also Note [Newtype eta] in GHC.Core.TyCon. This is notionally separate -and deals with the axiom connecting a newtype with its representation -type; but it too is eta-reduced.) +See also: + +* Note [Newtype eta] in GHC.Core.TyCon. This is notionally separate + and deals with the axiom connecting a newtype with its representation + type; but it too is eta-reduced. +* Note [Implementing eta reduction for data families] in TcInstDcls. This + describes the implementation details of this eta reduction happen. -} instance Eq (CoAxiom br) where ===================================== compiler/GHC/Core/FamInstEnv.hs ===================================== @@ -118,6 +118,7 @@ data FamInst -- See Note [FamInsts and CoAxioms] , fi_tys :: [Type] -- The LHS type patterns -- May be eta-reduced; see Note [Eta reduction for data families] + -- in GHC.Core.Coercion.Axiom , fi_rhs :: Type -- the RHS, with its freshened vars } @@ -132,7 +133,8 @@ Note [Arity of data families] Data family instances might legitimately be over- or under-saturated. Under-saturation has two potential causes: - U1) Eta reduction. See Note [Eta reduction for data families]. + U1) Eta reduction. See Note [Eta reduction for data families] in + GHC.Core.Coercion.Axiom. U2) When the user has specified a return kind instead of written out patterns. Example: @@ -160,8 +162,8 @@ Over-saturation is also possible: However, we require that any over-saturation is eta-reducible. That is, we require that any extra patterns be bare unrepeated type variables; - see Note [Eta reduction for data families]. Accordingly, the FamInst - is never over-saturated. + see Note [Eta reduction for data families] in GHC.Core.Coercion.Axiom. + Accordingly, the FamInst is never over-saturated. Why can we allow such flexibility for data families but not for type families? Because data families can be decomposed -- that is, they are generative and @@ -335,7 +337,7 @@ Then we get a data type for each instance, and an axiom: axiom ax8 a :: T Bool [a] ~ TBoolList a These two axioms for T, one with one pattern, one with two; -see Note [Eta reduction for data families] +see Note [Eta reduction for data families] in GHC.Core.Coercion.Axiom Note [FamInstEnv determinism] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -479,7 +481,7 @@ irrelevant (clause 1 of compatible) or benign (clause 2 of compatible). Note [Compatibility of eta-reduced axioms] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In newtype instances of data families we eta-reduce the axioms, -See Note [Eta reduction for data families] in GHC.Core.FamInstEnv. This means that +See Note [Eta reduction for data families] in GHC.Core.Coercion.Axiom. This means that we sometimes need to test compatibility of two axioms that were eta-reduced to different degrees, e.g.: @@ -1057,7 +1059,7 @@ We handle data families and type families separately here: * For data family instances, though, we need to re-split for each instance, because the breakdown might be different for each instance. Why? Because of eta reduction; see - Note [Eta reduction for data families]. + Note [Eta reduction for data families] in GHC.Core.Coercion.Axiom. -} -- checks if one LHS is dominated by a list of other branches ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -240,7 +240,7 @@ See also Note [Wrappers for data instance tycons] in GHC.Types.Id.Make DataFamInstTyCon T [Int] ax_ti * The axiom ax_ti may be eta-reduced; see - Note [Eta reduction for data families] in GHC.Core.FamInstEnv + Note [Eta reduction for data families] in GHC.Core.Coercion.Axiom * Data family instances may have a different arity than the data family. See Note [Arity of data families] in GHC.Core.FamInstEnv @@ -1100,8 +1100,9 @@ data AlgTyConFlav -- and R:T is the representation TyCon (ie this one) -- and a,b,c are the tyConTyVars of this TyCon -- - -- BUT may be eta-reduced; see FamInstEnv - -- Note [Eta reduction for data families] + -- BUT may be eta-reduced; see + -- Note [Eta reduction for data families] in + -- GHC.Core.Coercion.Axiom -- Cached fields of the CoAxiom, but adjusted to -- use the tyConTyVars of this TyCon ===================================== compiler/typecheck/TcDeriv.hs ===================================== @@ -1312,7 +1312,7 @@ write it out return x = MkT [x] ... etc ... -See Note [Eta reduction for data families] in GHC.Core.FamInstEnv +See Note [Eta reduction for data families] in GHC.Core.Coercion.Axiom %************************************************************************ %* * ===================================== compiler/typecheck/TcInstDcls.hs ===================================== @@ -667,7 +667,7 @@ tcDataFamInstDecl mb_clsinfo new_or_data -- Eta-reduce the axiom if possible - -- Quite tricky: see Note [Eta-reduction for data families] + -- Quite tricky: see Note [Implementing eta reduction for data families] ; let (eta_pats, eta_tcbs) = eta_reduce fam_tc pats eta_tvs = map binderVar eta_tcbs post_eta_qtvs = filterOut (`elem` eta_tvs) qtvs @@ -761,7 +761,7 @@ tcDataFamInstDecl mb_clsinfo ; return (fam_inst, m_deriv_info) } where eta_reduce :: TyCon -> [Type] -> ([Type], [TyConBinder]) - -- See Note [Eta reduction for data families] in GHC.Core.FamInstEnv + -- See Note [Eta reduction for data families] in GHC.Core.Coercion.Axiom -- Splits the incoming patterns into two: the [TyVar] -- are the patterns that can be eta-reduced away. -- e.g. T [a] Int a d c ==> (T [a] Int a, [d,c]) @@ -887,8 +887,8 @@ we actually have a place to put the regeneralised variables. Thus: skolemise away. cf. Inst.deeplySkolemise and TcUnify.tcSkolemise Examples in indexed-types/should_compile/T12369 -Note [Eta-reduction for data families] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [Implementing eta reduction for data families] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider data D :: * -> * -> * -> * -> * @@ -906,7 +906,10 @@ and an axiom to connect them except that we'll eta-reduce the axiom to axiom AxDrep forall a b. D [(a,b]] = Drep a b -There are several fiddly subtleties lurking here + +This is described at some length in Note [Eta reduction for data families] +in GHC.Core.Coercion.Axiom. There are several fiddly subtleties lurking here, +however, so this Note aims to describe these subtleties: * The representation tycon Drep is parameterised over the free variables of the pattern, in no particular order. So there is no ===================================== compiler/typecheck/TcSplice.hs ===================================== @@ -2046,7 +2046,7 @@ reifyFamilyInstance is_poly_tvs (FamInst { fi_flavor = flavor DataFamilyInst rep_tc -> do { let -- eta-expand lhs types, because sometimes data/newtype -- instances are eta-reduced; See #9692 - -- See Note [Eta reduction for data families] in GHC.Core.FamInstEnv + -- See Note [Eta reduction for data families] in GHC.Core.Coercion.Axiom (ee_tvs, ee_lhs, _) = etaExpandCoAxBranch branch fam' = reifyName fam dataCons = tyConDataCons rep_tc View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0bae7ba256acaf48aa7c1d586fdad8e9fc43b4cd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0bae7ba256acaf48aa7c1d586fdad8e9fc43b4cd You're receiving 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 Mar 31 14:54:32 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 31 Mar 2020 10:54:32 -0400 Subject: [Git][ghc/ghc][master] Require GHC 8.8 as the minimum compiler for bootstrapping Message-ID: <5e8359a8b069d_61673f8198ee100c181994@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 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. - - - - - 21 changed files: - .gitlab-ci.yml - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Op/ConstantFold.hs - compiler/GHC/Core/Op/Specialise.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Types/Unique/Supply.hs - compiler/main/SysTools/Process.hs - compiler/typecheck/TcRnTypes.hs - compiler/typecheck/TcSMonad.hs - compiler/utils/Binary.hs - compiler/utils/IOEnv.hs - configure.ac - hadrian/src/Hadrian/Utilities.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Ghc.hs - libraries/base/Control/Monad/ST/Lazy/Imp.hs - libraries/base/GHC/ST.hs - libraries/base/Text/ParserCombinators/ReadPrec.hs - libraries/ghci/GHCi/TH.hs - libraries/template-haskell/Language/Haskell/TH/Syntax.hs 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: 408eff66aef6ca2b44446c694c5a56d6ca0460cc + DOCKER_REV: 3f731f5d37a156e7ebe10cd32656946083baaf4a # Sequential version number capturing the versions of all tools fetched by # .gitlab/ci.sh. @@ -390,7 +390,7 @@ validate-x86_64-darwin: tags: - x86_64-darwin variables: - GHC_VERSION: 8.6.5 + GHC_VERSION: 8.8.3 CABAL_INSTALL_VERSION: 3.0.0.0 BIN_DIST_PREP_TAR_COMP: "ghc-x86_64-apple-darwin.tar.xz" MACOSX_DEPLOYMENT_TARGET: "10.7" @@ -419,7 +419,7 @@ validate-x86_64-darwin: tags: - x86_64-darwin variables: - GHC_VERSION: 8.6.3 + GHC_VERSION: 8.8.3 MACOSX_DEPLOYMENT_TARGET: "10.7" ac_cv_func_clock_gettime: "no" LANG: "en_US.UTF-8" ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -70,7 +70,6 @@ import GHC.Types.Demand ( splitStrictSig, isBotDiv ) import GHC.Driver.Types import GHC.Driver.Session import Control.Monad -import qualified Control.Monad.Fail as MonadFail import MonadUtils import Data.Foldable ( toList ) import Data.List.NonEmpty ( NonEmpty ) @@ -2249,16 +2248,13 @@ instance Applicative LintM where (<*>) = ap instance Monad LintM where -#if !MIN_VERSION_base(4,13,0) - fail = MonadFail.fail -#endif m >>= k = LintM (\ env errs -> let (res, errs') = unLintM m env errs in case res of Just r -> unLintM (k r) env errs' Nothing -> (Nothing, errs')) -instance MonadFail.MonadFail LintM where +instance MonadFail LintM where fail err = failWithL (text err) instance HasDynFlags LintM where ===================================== compiler/GHC/Core/Make.hs ===================================== @@ -85,7 +85,6 @@ import Util import Data.List import Data.Char ( ord ) -import Control.Monad.Fail as MonadFail ( MonadFail ) infixl 4 `mkCoreApp`, `mkCoreApps` @@ -640,7 +639,7 @@ mkFoldrExpr elt_ty result_ty c n list = do `App` list) -- | Make a 'build' expression applied to a locally-bound worker function -mkBuildExpr :: (MonadFail.MonadFail m, MonadThings m, MonadUnique m) +mkBuildExpr :: (MonadFail m, MonadThings m, MonadUnique m) => Type -- ^ Type of list elements to be built -> ((Id, Type) -> (Id, Type) -> m CoreExpr) -- ^ Function that, given information about the 'Id's -- of the binders for the build worker function, returns ===================================== compiler/GHC/Core/Op/ConstantFold.hs ===================================== @@ -61,7 +61,6 @@ import GHC.Core.Coercion (mkUnbranchedAxInstCo,mkSymCo,Role(..)) import Control.Applicative ( Alternative(..) ) import Control.Monad -import qualified Control.Monad.Fail as MonadFail import Data.Bits as Bits import qualified Data.ByteString as BS import Data.Int @@ -796,11 +795,7 @@ instance Monad RuleM where Nothing -> Nothing Just r -> runRuleM (g r) env iu fn args -#if !MIN_VERSION_base(4,13,0) - fail = MonadFail.fail -#endif - -instance MonadFail.MonadFail RuleM where +instance MonadFail RuleM where fail _ = mzero instance Alternative RuleM where ===================================== compiler/GHC/Core/Op/Specialise.hs ===================================== @@ -50,7 +50,6 @@ import GHC.Types.Unique.DFM import GHC.Core.TyCo.Rep (TyCoBinder (..)) import Control.Monad -import qualified Control.Monad.Fail as MonadFail {- ************************************************************************ @@ -2551,11 +2550,8 @@ instance Monad SpecM where case f y of SpecM z -> z -#if !MIN_VERSION_base(4,13,0) - fail = MonadFail.fail -#endif -instance MonadFail.MonadFail SpecM where +instance MonadFail SpecM where fail str = SpecM $ error str instance MonadUnique SpecM where ===================================== compiler/GHC/Core/Unify.hs ===================================== @@ -46,7 +46,6 @@ import GHC.Types.Unique.FM import GHC.Types.Unique.Set import Control.Monad -import qualified Control.Monad.Fail as MonadFail import Control.Applicative hiding ( empty ) import qualified Control.Applicative @@ -1244,9 +1243,6 @@ instance Applicative UM where (<*>) = ap instance Monad UM where -#if !MIN_VERSION_base(4,13,0) - fail = MonadFail.fail -#endif m >>= k = UM (\state -> do { (state', v) <- unUM m state ; unUM (k v) state' }) @@ -1260,7 +1256,7 @@ instance Alternative UM where instance MonadPlus UM -instance MonadFail.MonadFail UM where +instance MonadFail UM where fail _ = UM (\_ -> SurelyApart) -- failed pattern match initUM :: TvSubstEnv -- subst to extend ===================================== compiler/GHC/Types/Unique/Supply.hs ===================================== @@ -44,7 +44,6 @@ import MonadUtils import Control.Monad import Data.Bits import Data.Char -import Control.Monad.Fail as Fail #include "Unique.h" @@ -156,7 +155,7 @@ instance Applicative UniqSM where (*>) = thenUs_ -- TODO: try to get rid of this instance -instance Fail.MonadFail UniqSM where +instance MonadFail UniqSM where fail = panic -- | Run the 'UniqSM' action, returning the final 'UniqSupply' ===================================== compiler/main/SysTools/Process.hs ===================================== @@ -36,14 +36,10 @@ import FileCleanup -- @process >= 1.6.8.0@). enableProcessJobs :: CreateProcess -> CreateProcess #if defined(MIN_VERSION_process) -#if MIN_VERSION_process(1,6,8) enableProcessJobs opts = opts { use_process_jobs = True } #else enableProcessJobs opts = opts #endif -#else -enableProcessJobs opts = opts -#endif -- Similar to System.Process.readCreateProcessWithExitCode, but stderr is -- inherited from the parent process, and output to stderr is not captured. ===================================== compiler/typecheck/TcRnTypes.hs ===================================== @@ -124,7 +124,6 @@ import PrelNames ( isUnboundName ) import GHC.Types.CostCentre.State import Control.Monad (ap) -import qualified Control.Monad.Fail as MonadFail import Data.Set ( Set ) import qualified Data.Set as S @@ -1653,14 +1652,11 @@ instance Applicative TcPluginM where (<*>) = ap instance Monad TcPluginM where -#if !MIN_VERSION_base(4,13,0) - fail = MonadFail.fail -#endif TcPluginM m >>= k = TcPluginM (\ ev -> do a <- m ev runTcPluginM (k a) ev) -instance MonadFail.MonadFail TcPluginM where +instance MonadFail TcPluginM where fail x = TcPluginM (const $ fail x) runTcPluginM :: TcPluginM a -> EvBindsVar -> TcM a ===================================== compiler/typecheck/TcSMonad.hs ===================================== @@ -177,7 +177,6 @@ import Maybes import GHC.Core.Map import Control.Monad -import qualified Control.Monad.Fail as MonadFail import MonadUtils import Data.IORef import Data.List ( partition, mapAccumL ) @@ -2699,12 +2698,9 @@ instance Applicative TcS where (<*>) = ap instance Monad TcS where -#if !MIN_VERSION_base(4,13,0) - fail = MonadFail.fail -#endif m >>= k = TcS (\ebs -> unTcS m ebs >>= \r -> unTcS (k r) ebs) -instance MonadFail.MonadFail TcS where +instance MonadFail TcS where fail err = TcS (\_ -> fail err) instance MonadUnique TcS where ===================================== compiler/utils/Binary.hs ===================================== @@ -829,12 +829,10 @@ instance Binary RuntimeRep where put_ bh AddrRep = putByte bh 9 put_ bh FloatRep = putByte bh 10 put_ bh DoubleRep = putByte bh 11 -#if __GLASGOW_HASKELL__ >= 807 put_ bh Int8Rep = putByte bh 12 put_ bh Word8Rep = putByte bh 13 put_ bh Int16Rep = putByte bh 14 put_ bh Word16Rep = putByte bh 15 -#endif #if __GLASGOW_HASKELL__ >= 809 put_ bh Int32Rep = putByte bh 16 put_ bh Word32Rep = putByte bh 17 @@ -855,12 +853,10 @@ instance Binary RuntimeRep where 9 -> pure AddrRep 10 -> pure FloatRep 11 -> pure DoubleRep -#if __GLASGOW_HASKELL__ >= 807 12 -> pure Int8Rep 13 -> pure Word8Rep 14 -> pure Int16Rep 15 -> pure Word16Rep -#endif #if __GLASGOW_HASKELL__ >= 809 16 -> pure Int32Rep 17 -> pure Word32Rep ===================================== compiler/utils/IOEnv.hs ===================================== @@ -43,7 +43,6 @@ import Data.IORef ( IORef, newIORef, readIORef, writeIORef, modifyIORef, import System.IO.Unsafe ( unsafeInterleaveIO ) import System.IO ( fixIO ) import Control.Monad -import qualified Control.Monad.Fail as MonadFail import MonadUtils import Control.Applicative (Alternative(..)) @@ -60,11 +59,8 @@ unIOEnv (IOEnv m) = m instance Monad (IOEnv m) where (>>=) = thenM (>>) = (*>) -#if !MIN_VERSION_base(4,13,0) - fail = MonadFail.fail -#endif -instance MonadFail.MonadFail (IOEnv m) where +instance MonadFail (IOEnv m) where fail _ = failM -- Ignore the string instance Applicative (IOEnv m) where ===================================== configure.ac ===================================== @@ -158,8 +158,8 @@ if test "$WithGhc" = "" then AC_MSG_ERROR([GHC is required.]) fi -FP_COMPARE_VERSIONS([$GhcVersion],[-lt],[8.6], - [AC_MSG_ERROR([GHC version 8.6 or later is required to compile GHC.])]) +FP_COMPARE_VERSIONS([$GhcVersion],[-lt],[8.8], + [AC_MSG_ERROR([GHC version 8.8 or later is required to compile GHC.])]) if test `expr $GhcMinVersion % 2` = "1" then ===================================== hadrian/src/Hadrian/Utilities.hs ===================================== @@ -40,7 +40,6 @@ import Data.Char import Data.Dynamic (Dynamic, fromDynamic, toDyn) import Data.Functor import Data.HashMap.Strict (HashMap) -import Data.List (isPrefixOf) import Data.List.Extra import Data.Maybe import Data.Typeable (TypeRep, typeOf) ===================================== hadrian/src/Settings/Builders/Cabal.hs ===================================== @@ -1,6 +1,5 @@ module Settings.Builders.Cabal (cabalBuilderArgs) where -import Hadrian.Builder (getBuilderPath, needBuilder) import Hadrian.Haskell.Cabal import Builder ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -2,8 +2,6 @@ module Settings.Builders.Ghc (ghcBuilderArgs, haddockGhcArgs) where -import Data.List.Extra (splitOn) - import Hadrian.Haskell.Cabal import Hadrian.Haskell.Cabal.Type ===================================== libraries/base/Control/Monad/ST/Lazy/Imp.hs ===================================== @@ -8,7 +8,7 @@ -- Module : Control.Monad.ST.Lazy.Imp -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) --- +-- -- Maintainer : libraries at haskell.org -- Stability : provisional -- Portability : non-portable (requires universal quantification for runST) @@ -44,7 +44,6 @@ import qualified Control.Monad.ST.Unsafe as ST import qualified GHC.ST as GHC.ST import GHC.Base -import qualified Control.Monad.Fail as Fail -- | The lazy @'ST' monad. -- The ST monad allows for destructive updates, but is escapable (unlike IO). @@ -192,7 +191,7 @@ instance Monad (ST s) where unST (k r) new_s -- | @since 4.10 -instance Fail.MonadFail (ST s) where +instance MonadFail (ST s) where fail s = errorWithoutStackTrace s -- | Return the value computed by an 'ST' computation. @@ -205,8 +204,8 @@ runST (ST st) = runRW# (\s -> case st (S# s) of (r, _) -> r) -- inside the computation. -- Note that if @f@ is strict, @'fixST' f = _|_ at . fixST :: (a -> ST s a) -> ST s a -fixST m = ST (\ s -> - let +fixST m = ST (\ s -> + let q@(r,_s') = unST (m r) s in q) -- Why don't we need unsafePerformIO in fixST? We create a thunk, q, @@ -233,7 +232,7 @@ strictToLazyST (GHC.ST.ST m) = ST $ \(S# s) -> (# s', a #) -> (a, S# s') -- See Note [Lazy ST: not producing lazy pairs] -{-| +{-| Convert a lazy 'ST' computation into a strict one. -} lazyToStrictST :: ST s a -> ST.ST s a ===================================== libraries/base/GHC/ST.hs ===================================== @@ -26,7 +26,7 @@ module GHC.ST ( import GHC.Base import GHC.Show -import qualified Control.Monad.Fail as Fail +import Control.Monad.Fail default () @@ -79,7 +79,7 @@ instance Monad (ST s) where (k2 new_s) }}) -- | @since 4.11.0.0 -instance Fail.MonadFail (ST s) where +instance MonadFail (ST s) where fail s = errorWithoutStackTrace s -- | @since 4.11.0.0 ===================================== libraries/base/Text/ParserCombinators/ReadPrec.hs ===================================== @@ -64,7 +64,7 @@ import qualified Text.ParserCombinators.ReadP as ReadP import GHC.Num( Num(..) ) import GHC.Base -import qualified Control.Monad.Fail as MonadFail +import Control.Monad.Fail -- --------------------------------------------------------------------------- -- The readPrec type @@ -88,8 +88,8 @@ instance Monad ReadPrec where P f >>= k = P (\n -> do a <- f n; let P f' = k a in f' n) -- | @since 4.9.0.0 -instance MonadFail.MonadFail ReadPrec where - fail s = P (\_ -> MonadFail.fail s) +instance MonadFail ReadPrec where + fail s = P (\_ -> fail s) -- | @since 2.01 instance MonadPlus ReadPrec ===================================== libraries/ghci/GHCi/TH.hs ===================================== @@ -97,7 +97,6 @@ import GHCi.RemoteTypes import GHC.Serialized import Control.Exception -import qualified Control.Monad.Fail as Fail import Control.Monad.IO.Class (MonadIO (..)) import Data.Binary import Data.Binary.Put @@ -144,11 +143,8 @@ instance Monad GHCiQ where do (m', s') <- runGHCiQ m s (a, s'') <- runGHCiQ (f m') s' return (a, s'') -#if !MIN_VERSION_base(4,13,0) - fail = Fail.fail -#endif -instance Fail.MonadFail GHCiQ where +instance MonadFail GHCiQ where fail err = GHCiQ $ \s -> throwIO (GHCiQException s err) getState :: GHCiQ QState ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -52,15 +52,13 @@ import Numeric.Natural import Prelude import Foreign.ForeignPtr -import qualified Control.Monad.Fail as Fail - ----------------------------------------------------- -- -- The Quasi class -- ----------------------------------------------------- -class (MonadIO m, Fail.MonadFail m) => Quasi m where +class (MonadIO m, MonadFail m) => Quasi m where qNewName :: String -> m Name -- ^ Fresh names @@ -187,12 +185,9 @@ runQ (Q m) = m instance Monad Q where Q m >>= k = Q (m >>= \x -> unQ (k x)) (>>) = (*>) -#if !MIN_VERSION_base(4,13,0) - fail = Fail.fail -#endif -instance Fail.MonadFail Q where - fail s = report True s >> Q (Fail.fail "Q monad failure") +instance MonadFail Q where + fail s = report True s >> Q (fail "Q monad failure") instance Functor Q where fmap f (Q x) = Q (fmap f x) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/57b888c0e90be7189285a6b078c30b26d0923809 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/57b888c0e90be7189285a6b078c30b26d0923809 You're receiving 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 Mar 31 14:55:11 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 31 Mar 2020 10:55:11 -0400 Subject: [Git][ghc/ghc][master] Add regression test for #17963 Message-ID: <5e8359cf77a57_6167116c28dc182394e@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 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. - - - - - 3 changed files: - + testsuite/tests/polykinds/T17963.hs - + testsuite/tests/polykinds/T17963.stderr - testsuite/tests/polykinds/all.T Changes: ===================================== testsuite/tests/polykinds/T17963.hs ===================================== @@ -0,0 +1,15 @@ +{-# Language DataKinds #-} +{-# Language PolyKinds #-} +{-# Language RankNTypes #-} +{-# Language StandaloneKindSignatures #-} +{-# Language TypeApplications #-} +module T17963 where + +import GHC.Types (Constraint, Type, TYPE, RuntimeRep(..)) + +type Cat :: forall (rep :: RuntimeRep). TYPE rep -> Type +type Cat ob = ob -> ob -> Type + +type Category' :: forall rep (ob :: TYPE rep). Cat @rep ob -> Constraint +class Category' (cat :: Cat @rep ob) where + id' :: forall a. cat a a ===================================== testsuite/tests/polykinds/T17963.stderr ===================================== @@ -0,0 +1,13 @@ + +T17963.hs:15:23: error: + • Couldn't match a lifted type with an unlifted type + ‘rep1’ is a rigid type variable bound by + the class declaration for ‘Category'’ + at T17963.hs:13:27-29 + When matching kinds + k0 :: * + ob :: TYPE rep1 + Expected kind ‘ob’, but ‘a’ has kind ‘k0’ + • In the first argument of ‘cat’, namely ‘a’ + In the type signature: id' :: forall a. cat a a + In the class declaration for ‘Category'’ ===================================== testsuite/tests/polykinds/all.T ===================================== @@ -216,3 +216,4 @@ test('T16263', normal, compile_fail, ['']) test('T16902', normal, compile_fail, ['']) test('CuskFam', normal, compile, ['']) test('T17841', normal, compile_fail, ['']) +test('T17963', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/33f095511a8fce4c945bbcd4feb3910c854dcb61 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/33f095511a8fce4c945bbcd4feb3910c854dcb61 You're receiving 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 Mar 31 14:55:49 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 31 Mar 2020 10:55:49 -0400 Subject: [Git][ghc/ghc][master] Simplify stderrSupportsAnsiColors Message-ID: <5e8359f55a63a_61675cefcac182773a@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 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. - - - - - 1 changed file: - compiler/main/SysTools/Terminal.hs Changes: ===================================== compiler/main/SysTools/Terminal.hs ===================================== @@ -32,20 +32,13 @@ import qualified System.Win32 as Win32 stderrSupportsAnsiColors :: IO Bool stderrSupportsAnsiColors = do #if defined(MIN_VERSION_terminfo) - queryTerminal stdError `andM` do - (termSupportsColors <$> setupTermFromEnv) - `catch` \ (_ :: SetupTermError) -> - pure False - + stderr_available <- queryTerminal stdError + if stderr_available then + fmap termSupportsColors setupTermFromEnv + `catch` \ (_ :: SetupTermError) -> pure False + else + pure False where - - andM :: Monad m => m Bool -> m Bool -> m Bool - andM mx my = do - x <- mx - if x - then my - else pure x - termSupportsColors :: Terminal -> Bool termSupportsColors term = fromMaybe 0 (getCapability term termColors) > 0 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/09a36e80ecaefcfb60eccda98bd06461d0aeca70 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/09a36e80ecaefcfb60eccda98bd06461d0aeca70 You're receiving 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 Mar 31 14:56:29 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 31 Mar 2020 10:56:29 -0400 Subject: [Git][ghc/ghc][master] base: Ensure that encoding global variables aren't inlined Message-ID: <5e835a1d4bdc1_61673f81cca05dd818340f1@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 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. - - - - - 1 changed file: - libraries/base/GHC/IO/Encoding.hs Changes: ===================================== libraries/base/GHC/IO/Encoding.hs ===================================== @@ -107,6 +107,7 @@ utf32be = UTF32.utf32be -- -- @since 4.5.0.0 getLocaleEncoding :: IO TextEncoding +{-# NOINLINE getLocaleEncoding #-} -- | The Unicode encoding of the current locale, but allowing arbitrary -- undecodable bytes to be round-tripped through it. @@ -120,6 +121,7 @@ getLocaleEncoding :: IO TextEncoding -- -- @since 4.5.0.0 getFileSystemEncoding :: IO TextEncoding +{-# NOINLINE getFileSystemEncoding #-} -- | The Unicode encoding of the current locale, but where undecodable -- bytes are replaced with their closest visual match. Used for @@ -127,9 +129,13 @@ getFileSystemEncoding :: IO TextEncoding -- -- @since 4.5.0.0 getForeignEncoding :: IO TextEncoding +{-# NOINLINE getForeignEncoding #-} -- | @since 4.5.0.0 setLocaleEncoding, setFileSystemEncoding, setForeignEncoding :: TextEncoding -> IO () +{-# NOINLINE setLocaleEncoding #-} +{-# NOINLINE setFileSystemEncoding #-} +{-# NOINLINE setForeignEncoding #-} (getLocaleEncoding, setLocaleEncoding) = mkGlobal initLocaleEncoding (getFileSystemEncoding, setFileSystemEncoding) = mkGlobal initFileSystemEncoding @@ -139,9 +145,13 @@ mkGlobal :: a -> (IO a, a -> IO ()) mkGlobal x = unsafePerformIO $ do x_ref <- newIORef x return (readIORef x_ref, writeIORef x_ref) +{-# NOINLINE mkGlobal #-} -- | @since 4.5.0.0 initLocaleEncoding, initFileSystemEncoding, initForeignEncoding :: TextEncoding +{-# NOINLINE initLocaleEncoding #-} +-- N.B. initLocaleEncoding is exported for use in System.IO.localeEncoding. +-- NOINLINE ensures that this result is shared. #if !defined(mingw32_HOST_OS) -- It is rather important that we don't just call Iconv.mkIconvEncoding here View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/95bccdd034ce4dd2d1bc36db9f1ba5e172550249 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/95bccdd034ce4dd2d1bc36db9f1ba5e172550249 You're receiving 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 Mar 31 14:57:04 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 31 Mar 2020 10:57:04 -0400 Subject: [Git][ghc/ghc][master] Update hadrian index revision. Message-ID: <5e835a40cdbb9_61673f8198ee100c18373b@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - 1 changed file: - hadrian/cabal.project Changes: ===================================== hadrian/cabal.project ===================================== @@ -1,7 +1,7 @@ packages: ./ -- This essentially freezes the build plan for hadrian -index-state: 2019-12-16T07:24:23Z +index-state: 2020-03-28T07:24:23Z -- N.B. Compile with -O0 since this is not a performance-critical executable -- and the Cabal takes nearly twice as long to build with -O1. See #16817. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/982aaa837aed564ae9b418cda8e97d4facff8fb8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/982aaa837aed564ae9b418cda8e97d4facff8fb8 You're receiving 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 Mar 31 14:57:41 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 31 Mar 2020 10:57:41 -0400 Subject: [Git][ghc/ghc][master] integer-gmp: Bump version and add changelog entry Message-ID: <5e835a652506e_61677b155d818404a0@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4b9c5864 by Ben Gamari at 2020-03-31T10:57:32-04:00 integer-gmp: Bump version and add changelog entry - - - - - 2 changed files: - libraries/integer-gmp/changelog.md - libraries/integer-gmp/integer-gmp.cabal Changes: ===================================== libraries/integer-gmp/changelog.md ===================================== @@ -1,5 +1,11 @@ # Changelog for [`integer-gmp` package](http://hackage.haskell.org/package/integer-gmp) +## 1.0.3.0 *January 2019* + + * Bundled with GHC 8.10.1 + + * Documentation changes + ## 1.0.2.0 *April 2018* * Bundled with GHC 8.4.2 ===================================== libraries/integer-gmp/integer-gmp.cabal ===================================== @@ -1,6 +1,6 @@ cabal-version: 2.0 name: integer-gmp -version: 1.0.2.0 +version: 1.0.3.0 synopsis: Integer library based on GMP license: BSD3 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4b9c586472bf99425f7bbcf346472d7c54f05028 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4b9c586472bf99425f7bbcf346472d7c54f05028 You're receiving 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 Mar 31 14:58:35 2020 From: gitlab at gitlab.haskell.org (Andreas Klebinger) Date: Tue, 31 Mar 2020 10:58:35 -0400 Subject: [Git][ghc/ghc][wip/andreask/tools_unlines] 8 commits: Expect T4267 to pass Message-ID: <5e835a9b78af0_61673f81cca05dd81843268@gitlab.haskell.org.mail> Andreas Klebinger pushed to branch wip/andreask/tools_unlines at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - 4edffcbb by Andreas Klebinger at 2020-03-31T10:58:32-04:00 Turn newlines into spaces for hadrian/ghci. The newlines break the command on windows. - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Op/ConstantFold.hs - compiler/GHC/Core/Op/Specialise.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Types/Unique/Supply.hs - compiler/main/SysTools/Process.hs - compiler/main/SysTools/Terminal.hs - compiler/typecheck/TcRnTypes.hs - compiler/typecheck/TcSMonad.hs - compiler/utils/Binary.hs - compiler/utils/IOEnv.hs - configure.ac - hadrian/cabal.project - hadrian/ghci-cabal - hadrian/ghci-stack - hadrian/src/Hadrian/Utilities.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Ghc.hs - libraries/base/Control/Monad/ST/Lazy/Imp.hs - libraries/base/GHC/IO/Encoding.hs - libraries/base/GHC/ST.hs - libraries/base/Text/ParserCombinators/ReadPrec.hs - libraries/ghci/GHCi/TH.hs - libraries/integer-gmp/changelog.md - libraries/integer-gmp/integer-gmp.cabal - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - testsuite/tests/perf/should_run/all.T - + testsuite/tests/polykinds/T17963.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a9d525389b3e560e9760ac550bba82656b3b415b...4edffcbba6c4ff80b02a5e566a0622622baeaa1f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a9d525389b3e560e9760ac550bba82656b3b415b...4edffcbba6c4ff80b02a5e566a0622622baeaa1f You're receiving 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 Mar 31 15:16:45 2020 From: gitlab at gitlab.haskell.org (Josh Meredith) Date: Tue, 31 Mar 2020 11:16:45 -0400 Subject: [Git][ghc/ghc][wip/extensible-interface-files] 29 commits: Use export list of Main module in function TcRnDriver.hs:check_main (Fix #16453) Message-ID: <5e835edd2e90a_6167120434ec1856550@gitlab.haskell.org.mail> Josh Meredith pushed to branch wip/extensible-interface-files at Glasgow Haskell Compiler / GHC Commits: 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. - - - - - a7375c3f by Josh Meredith at 2020-04-01T02:02:13+11:00 Implement extensible interface files - - - - - 09f05b36 by Josh Meredith at 2020-04-01T02:02:45+11:00 Change expected stdout for hi file Docs tests - - - - - 7650d32f by Josh Meredith at 2020-04-01T02:02:45+11:00 Add comment subtitle section for BinData - - - - - 4f714f99 by Josh Meredith at 2020-04-01T02:16:17+11:00 Add some discussion about extensible interfaces to extending_ghc.rst - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC.hs - 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/BlockId.hs - compiler/GHC/Cmm/BlockId.hs-boot - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow.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.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/Ppr.hs - compiler/GHC/Cmm/ProcPoint.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Switch/Implement.hs - compiler/GHC/Cmm/Utils.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/63cef4649a94516a46843cc9ff434bc32a7c6103...4f714f99a87c1c14e09c7f143a4478d34e6f2d73 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/63cef4649a94516a46843cc9ff434bc32a7c6103...4f714f99a87c1c14e09c7f143a4478d34e6f2d73 You're receiving 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 Mar 31 15:48:12 2020 From: gitlab at gitlab.haskell.org (Simon Jakobi) Date: Tue, 31 Mar 2020 11:48:12 -0400 Subject: [Git][ghc/ghc][wip/T16806] 9 commits: Expect T4267 to pass Message-ID: <5e83663c8413c_6167683004418871ab@gitlab.haskell.org.mail> Simon Jakobi pushed to branch wip/T16806 at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - 9de9c188 by Simon Jakobi at 2020-03-31T17:41:29+02:00 Use the new IntMap.disjoint function Fixes #16806. - - - - - 86e210ba by Simon Jakobi at 2020-03-31T17:41:29+02:00 Use disjoint for closureGrowth - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Op/ConstantFold.hs - compiler/GHC/Core/Op/Specialise.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Stg/Lift/Analysis.hs - compiler/GHC/Types/Module.hs - compiler/GHC/Types/Name/Env.hs - compiler/GHC/Types/Name/Occurrence.hs - compiler/GHC/Types/Name/Set.hs - compiler/GHC/Types/Unique/DFM.hs - compiler/GHC/Types/Unique/DSet.hs - compiler/GHC/Types/Unique/FM.hs - compiler/GHC/Types/Unique/Set.hs - compiler/GHC/Types/Unique/Supply.hs - compiler/GHC/Types/Var/Env.hs - compiler/GHC/Types/Var/Set.hs - compiler/ghc.cabal.in - compiler/iface/BuildTyCl.hs - compiler/main/SysTools/Process.hs - compiler/main/SysTools/Terminal.hs - compiler/typecheck/TcHoleErrors.hs - compiler/typecheck/TcRnTypes.hs - compiler/typecheck/TcSMonad.hs - compiler/typecheck/TcSimplify.hs - compiler/utils/Binary.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1cbda2e3d6f14769602cdd1bc63276afc3e27ac6...86e210bac992fdf3691b55e04226c695328c5165 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1cbda2e3d6f14769602cdd1bc63276afc3e27ac6...86e210bac992fdf3691b55e04226c695328c5165 You're receiving 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 Mar 31 15:57:27 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Tue, 31 Mar 2020 11:57:27 -0400 Subject: [Git][ghc/ghc][wip/hadrian-8.10] 25 commits: Remove unused `ghciTablesNextToCode` from compiler proper Message-ID: <5e83686794760_61675cefcac1889867@gitlab.haskell.org.mail> Ryan Scott pushed to branch wip/hadrian-8.10 at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - 394c9c4b by Ryan Scott at 2020-03-31T11:54:19-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. - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC.hs - 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/BlockId.hs - compiler/GHC/Cmm/BlockId.hs-boot - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow.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.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/Ppr.hs - compiler/GHC/Cmm/ProcPoint.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Switch/Implement.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/e0d059e279c337ce4d54f9d6408133c79f050c7c...394c9c4b2a338663656e054767c3f0205732dfcb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e0d059e279c337ce4d54f9d6408133c79f050c7c...394c9c4b2a338663656e054767c3f0205732dfcb You're receiving 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 Mar 31 15:59:37 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 31 Mar 2020 11:59:37 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: Require GHC 8.8 as the minimum compiler for bootstrapping Message-ID: <5e8368e9a753a_61677b155d818915b4@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - a3219806 by Ryan Scott at 2020-03-31T11:59:22-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] - - - - - 8dcbe959 by Ryan Scott at 2020-03-31T11:59:23-04:00 Fix the changelog/@since information for hGetContents'/getContents'/readFile' Fixes #17979. [ci skip] - - - - - f54b3e37 by Sylvain Henry at 2020-03-31T11:59:28-04:00 Kill wORDS_BIGENDIAN and replace it with platformByteOrder (#17957) Metric Decrease: T13035 T1969 - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/Cmm/Info.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToC.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Op/ConstantFold.hs - compiler/GHC/Core/Op/Specialise.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Llvm/Types.hs - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Types/Unique/Supply.hs - compiler/main/SysTools/Process.hs - compiler/main/SysTools/Terminal.hs - compiler/typecheck/TcDeriv.hs - compiler/typecheck/TcInstDcls.hs - compiler/typecheck/TcRnTypes.hs - compiler/typecheck/TcSMonad.hs - compiler/typecheck/TcSplice.hs - compiler/utils/Binary.hs - compiler/utils/IOEnv.hs - configure.ac - distrib/configure.ac.in - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/src/Hadrian/Utilities.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/95da0b3766223ce5f40ddd9965617bf6776a4ad1...f54b3e379e712a2f6b1c8a2ccce0d6b7353486d5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/95da0b3766223ce5f40ddd9965617bf6776a4ad1...f54b3e379e712a2f6b1c8a2ccce0d6b7353486d5 You're receiving 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 Mar 31 16:08:51 2020 From: gitlab at gitlab.haskell.org (Simon Jakobi) Date: Tue, 31 Mar 2020 12:08:51 -0400 Subject: [Git][ghc/ghc][wip/T16806] Remove comments Message-ID: <5e836b139b35e_6167e0e2c941897994@gitlab.haskell.org.mail> Simon Jakobi pushed to branch wip/T16806 at Glasgow Haskell Compiler / GHC Commits: 7cd4c63b by Simon Jakobi at 2020-03-31T18:04:53+02:00 Remove comments - - - - - 1 changed file: - compiler/GHC/Stg/Lift/Analysis.hs Changes: ===================================== compiler/GHC/Stg/Lift/Analysis.hs ===================================== @@ -538,14 +538,14 @@ closureGrowth expander sizer group abs_ids = go -- the closure growth of its RHS. | otherwise = mkIntWithInf cost + go rhs where - n_occs = sizeDVarSet (clo_fvs' `dVarSetIntersectVarSet` group) -- TODO: Try disjoint + n_occs = sizeDVarSet (clo_fvs' `dVarSetIntersectVarSet` group) -- What we close over considering prior lifting decisions clo_fvs' = expander clo_fvs -- Variables that would additionally occur free in the closure body if -- we lift @f@ newbies = abs_ids `minusDVarSet` clo_fvs' -- Lifting @f@ removes @f@ from the closure but adds all @newbies@ - cost = foldDVarSet (\id size -> sizer id + size) 0 newbies - n_occs -- TODO: Do we really want a right fold here? Also: no need to do this in deterministic order! + cost = foldDVarSet (\id size -> sizer id + size) 0 newbies - n_occs go (RhsSk body_dmd body) -- The conservative assumption would be that -- 1. Every RHS with positive growth would be called multiple times, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7cd4c63b5007602a664aa9e8c7c3003021100559 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7cd4c63b5007602a664aa9e8c7c3003021100559 You're receiving 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 Mar 31 16:20:12 2020 From: gitlab at gitlab.haskell.org (Simon Jakobi) Date: Tue, 31 Mar 2020 12:20:12 -0400 Subject: [Git][ghc/ghc][wip/T16806] Use disjointUdfmUfm Message-ID: <5e836dbca0297_6167e0e2c9419125af@gitlab.haskell.org.mail> Simon Jakobi pushed to branch wip/T16806 at Glasgow Haskell Compiler / GHC Commits: f5560faf by Simon Jakobi at 2020-03-31T18:19:53+02:00 Use disjointUdfmUfm - - - - - 1 changed file: - compiler/GHC/Types/Module.hs Changes: ===================================== compiler/GHC/Types/Module.hs ===================================== @@ -991,7 +991,7 @@ renameHoleUnitId' pkg_map env uid = IndefUnitId{ indefUnitIdComponentId = cid , indefUnitIdInsts = insts , indefUnitIdFreeHoles = fh }) - -> if disjointUFM (udfmToUfm (getUniqDSet fh)) env + -> if disjointUdfmUfm (getUniqDSet fh) env then uid -- Functorially apply the substitution to the instantiation, -- then check the 'UnitInfoMap' to see if there is View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f5560fafe329de05317bfee100a9f02fb5e16a13 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f5560fafe329de05317bfee100a9f02fb5e16a13 You're receiving 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 Mar 31 16:23:58 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 31 Mar 2020 12:23:58 -0400 Subject: [Git][ghc/ghc][wip/dmdanal-precise-exn] Performance tweaks for tryClearPreciseException Message-ID: <5e836e9e59cf8_6167e0e2c9419190f7@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/dmdanal-precise-exn at Glasgow Haskell Compiler / GHC Commits: 29822102 by Sebastian Graf at 2020-03-31T18:23:07+02:00 Performance tweaks for tryClearPreciseException Apparently the function wasn't really responsible for regressing T12545. Maybe it's the fact that we have to serialise more stuff to the interface file, I don't know. - - - - - 2 changed files: - compiler/GHC/Core/Op/DmdAnal.hs - compiler/GHC/Types/Demand.hs Changes: ===================================== compiler/GHC/Core/Op/DmdAnal.hs ===================================== @@ -338,9 +338,9 @@ dmdAnalAlt env dmd case_bndr (con,bndrs,rhs) -- precise exception guarantees are off the table. -- See Note [Precise exceptions and strictness analysis] in Demand.hs mayThrowPreciseException :: FamInstEnvs -> Type -> DmdType -> Bool -mayThrowPreciseException _ _ (DmdType _ _ ConOrDiv) = False -mayThrowPreciseException _ _ (DmdType _ _ Diverges) = False -mayThrowPreciseException fam_envs ty _ = forcesRealWorld fam_envs ty +mayThrowPreciseException fam_envs ty dmd_ty + | not (mayThrowPreciseDmdType dmd_ty) = False + | otherwise = pprTrace "mayThrow" (ppr ty) $ forcesRealWorld fam_envs ty -- | Whether a 'seqDmd' on an expression of the given type may force -- @State# RealWorld@, incurring a side-effect (ignoring unsafe shenigans like @@ -374,6 +374,8 @@ forcesRealWorld fam_envs = go initRecTc -- precise excpetions. tryClearPreciseException :: FamInstEnvs -> Type -> StrictSig -> StrictSig tryClearPreciseException fam_envs ty sig@(StrictSig dmd_ty@(DmdType fvs args div)) + | not (mayThrowPreciseDmdType dmd_ty) -- Why bother clearing if there is nothing to clear? + = sig | (arg_tys, res_ty) <- splitPiTys ty , args `equalLength` filter (not . isNamedBinder) arg_tys , mayThrowPreciseException fam_envs res_ty dmd_ty ===================================== compiler/GHC/Types/Demand.hs ===================================== @@ -24,6 +24,7 @@ module GHC.Types.Demand ( DmdType(..), dmdTypeDepth, lubDmdType, bothDmdType, BothDmdArg, mkBothDmdArg, toBothDmdArg, emptyDmdType, botDmdType, mkDmdType, addDemand, + mayThrowPreciseDmdType, DmdEnv, emptyDmdEnv, peelFV, findIdDemand, @@ -1277,6 +1278,11 @@ isTopDmdType (DmdType env [] Dunno) | isEmptyVarEnv env = True isTopDmdType _ = False +mayThrowPreciseDmdType :: DmdType -> Bool +mayThrowPreciseDmdType (DmdType _ _ Dunno) = True +mayThrowPreciseDmdType (DmdType _ _ ExnOrDiv) = True +mayThrowPreciseDmdType _ = False + mkDmdType :: DmdEnv -> [Demand] -> Divergence -> DmdType mkDmdType fv ds res = DmdType fv ds res View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/298221029c18c2b2831c07bda03d2e2954eabf7a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/298221029c18c2b2831c07bda03d2e2954eabf7a You're receiving 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 Mar 31 16:27:56 2020 From: gitlab at gitlab.haskell.org (Simon Jakobi) Date: Tue, 31 Mar 2020 12:27:56 -0400 Subject: [Git][ghc/ghc][wip/T16806] Clarify disjoint in closureGrowth Message-ID: <5e836f8c7b98c_61675cefcac192212e@gitlab.haskell.org.mail> Simon Jakobi pushed to branch wip/T16806 at Glasgow Haskell Compiler / GHC Commits: 7a880b6c by Simon Jakobi at 2020-03-31T18:27:00+02:00 Clarify disjoint in closureGrowth - - - - - 2 changed files: - compiler/GHC/Stg/Lift/Analysis.hs - compiler/GHC/Types/Var/Set.hs Changes: ===================================== compiler/GHC/Stg/Lift/Analysis.hs ===================================== @@ -533,7 +533,7 @@ closureGrowth expander sizer group abs_ids = go go (ClosureSk _ clo_fvs rhs) -- If no binder of the @group@ occurs free in the closure, the lifting -- won't have any effect on it and we can omit the recursive call. - | dVarSetDisjointVarSet clo_fvs' group = 0 + | group `varSetDisjointDVarSet` clo_fvs' = 0 -- Otherwise, we account the cost of allocating the closure and add it to -- the closure growth of its RHS. | otherwise = mkIntWithInf cost + go rhs ===================================== compiler/GHC/Types/Var/Set.hs ===================================== @@ -34,7 +34,7 @@ module GHC.Types.Var.Set ( elemDVarSet, dVarSetElems, subDVarSet, unionDVarSet, unionDVarSets, mapUnionDVarSet, intersectDVarSet, dVarSetIntersectVarSet, - intersectsDVarSet, disjointDVarSet, dVarSetDisjointVarSet, + intersectsDVarSet, disjointDVarSet, varSetDisjointDVarSet, isEmptyDVarSet, delDVarSet, delDVarSetList, minusDVarSet, foldDVarSet, filterDVarSet, mapDVarSet, dVarSetMinusVarSet, anyDVarSet, allDVarSet, @@ -274,8 +274,8 @@ dVarSetIntersectVarSet = uniqDSetIntersectUniqSet disjointDVarSet :: DVarSet -> DVarSet -> Bool disjointDVarSet s1 s2 = disjointUDFM (getUniqDSet s1) (getUniqDSet s2) -dVarSetDisjointVarSet :: DVarSet -> VarSet -> Bool -dVarSetDisjointVarSet = uniqDSetDisjointUniqSet +varSetDisjointDVarSet :: VarSet -> DVarSet -> Bool +varSetDisjointDVarSet vs dvs = uniqDSetDisjointUniqSet dvs vs -- | True if non-empty intersection intersectsDVarSet :: DVarSet -> DVarSet -> Bool View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7a880b6c6b85d2c23c2adef1068c23d475bc235e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7a880b6c6b85d2c23c2adef1068c23d475bc235e You're receiving 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 Mar 31 16:32:51 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 31 Mar 2020 12:32:51 -0400 Subject: [Git][ghc/ghc][wip/absolute-i-paths] 8 commits: Expect T4267 to pass Message-ID: <5e8370b372921_6167665346019276dc@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/absolute-i-paths at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - de7bfdb1 by Matthew Pickering at 2020-03-31T12:32:45-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. - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Op/ConstantFold.hs - compiler/GHC/Core/Op/Specialise.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Types/Unique/Supply.hs - compiler/main/SysTools/Process.hs - compiler/main/SysTools/Terminal.hs - compiler/typecheck/TcRnTypes.hs - compiler/typecheck/TcSMonad.hs - compiler/utils/Binary.hs - compiler/utils/IOEnv.hs - configure.ac - hadrian/cabal.project - hadrian/src/Hadrian/Utilities.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Ghc.hs - libraries/base/Control/Monad/ST/Lazy/Imp.hs - libraries/base/GHC/IO/Encoding.hs - libraries/base/GHC/ST.hs - libraries/base/Text/ParserCombinators/ReadPrec.hs - libraries/ghci/GHCi/TH.hs - libraries/integer-gmp/changelog.md - libraries/integer-gmp/integer-gmp.cabal - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - testsuite/tests/perf/should_run/all.T - + testsuite/tests/polykinds/T17963.hs - + testsuite/tests/polykinds/T17963.stderr - testsuite/tests/polykinds/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: 408eff66aef6ca2b44446c694c5a56d6ca0460cc + DOCKER_REV: 3f731f5d37a156e7ebe10cd32656946083baaf4a # Sequential version number capturing the versions of all tools fetched by # .gitlab/ci.sh. @@ -390,7 +390,7 @@ validate-x86_64-darwin: tags: - x86_64-darwin variables: - GHC_VERSION: 8.6.5 + GHC_VERSION: 8.8.3 CABAL_INSTALL_VERSION: 3.0.0.0 BIN_DIST_PREP_TAR_COMP: "ghc-x86_64-apple-darwin.tar.xz" MACOSX_DEPLOYMENT_TARGET: "10.7" @@ -419,7 +419,7 @@ validate-x86_64-darwin: tags: - x86_64-darwin variables: - GHC_VERSION: 8.6.3 + GHC_VERSION: 8.8.3 MACOSX_DEPLOYMENT_TARGET: "10.7" ac_cv_func_clock_gettime: "no" LANG: "en_US.UTF-8" ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -70,7 +70,6 @@ import GHC.Types.Demand ( splitStrictSig, isBotDiv ) import GHC.Driver.Types import GHC.Driver.Session import Control.Monad -import qualified Control.Monad.Fail as MonadFail import MonadUtils import Data.Foldable ( toList ) import Data.List.NonEmpty ( NonEmpty ) @@ -2249,16 +2248,13 @@ instance Applicative LintM where (<*>) = ap instance Monad LintM where -#if !MIN_VERSION_base(4,13,0) - fail = MonadFail.fail -#endif m >>= k = LintM (\ env errs -> let (res, errs') = unLintM m env errs in case res of Just r -> unLintM (k r) env errs' Nothing -> (Nothing, errs')) -instance MonadFail.MonadFail LintM where +instance MonadFail LintM where fail err = failWithL (text err) instance HasDynFlags LintM where ===================================== compiler/GHC/Core/Make.hs ===================================== @@ -85,7 +85,6 @@ import Util import Data.List import Data.Char ( ord ) -import Control.Monad.Fail as MonadFail ( MonadFail ) infixl 4 `mkCoreApp`, `mkCoreApps` @@ -640,7 +639,7 @@ mkFoldrExpr elt_ty result_ty c n list = do `App` list) -- | Make a 'build' expression applied to a locally-bound worker function -mkBuildExpr :: (MonadFail.MonadFail m, MonadThings m, MonadUnique m) +mkBuildExpr :: (MonadFail m, MonadThings m, MonadUnique m) => Type -- ^ Type of list elements to be built -> ((Id, Type) -> (Id, Type) -> m CoreExpr) -- ^ Function that, given information about the 'Id's -- of the binders for the build worker function, returns ===================================== compiler/GHC/Core/Op/ConstantFold.hs ===================================== @@ -61,7 +61,6 @@ import GHC.Core.Coercion (mkUnbranchedAxInstCo,mkSymCo,Role(..)) import Control.Applicative ( Alternative(..) ) import Control.Monad -import qualified Control.Monad.Fail as MonadFail import Data.Bits as Bits import qualified Data.ByteString as BS import Data.Int @@ -796,11 +795,7 @@ instance Monad RuleM where Nothing -> Nothing Just r -> runRuleM (g r) env iu fn args -#if !MIN_VERSION_base(4,13,0) - fail = MonadFail.fail -#endif - -instance MonadFail.MonadFail RuleM where +instance MonadFail RuleM where fail _ = mzero instance Alternative RuleM where ===================================== compiler/GHC/Core/Op/Specialise.hs ===================================== @@ -50,7 +50,6 @@ import GHC.Types.Unique.DFM import GHC.Core.TyCo.Rep (TyCoBinder (..)) import Control.Monad -import qualified Control.Monad.Fail as MonadFail {- ************************************************************************ @@ -2551,11 +2550,8 @@ instance Monad SpecM where case f y of SpecM z -> z -#if !MIN_VERSION_base(4,13,0) - fail = MonadFail.fail -#endif -instance MonadFail.MonadFail SpecM where +instance MonadFail SpecM where fail str = SpecM $ error str instance MonadUnique SpecM where ===================================== compiler/GHC/Core/Unify.hs ===================================== @@ -46,7 +46,6 @@ import GHC.Types.Unique.FM import GHC.Types.Unique.Set import Control.Monad -import qualified Control.Monad.Fail as MonadFail import Control.Applicative hiding ( empty ) import qualified Control.Applicative @@ -1244,9 +1243,6 @@ instance Applicative UM where (<*>) = ap instance Monad UM where -#if !MIN_VERSION_base(4,13,0) - fail = MonadFail.fail -#endif m >>= k = UM (\state -> do { (state', v) <- unUM m state ; unUM (k v) state' }) @@ -1260,7 +1256,7 @@ instance Alternative UM where instance MonadPlus UM -instance MonadFail.MonadFail UM where +instance MonadFail UM where fail _ = UM (\_ -> SurelyApart) -- failed pattern match initUM :: TvSubstEnv -- subst to extend ===================================== compiler/GHC/Types/Unique/Supply.hs ===================================== @@ -44,7 +44,6 @@ import MonadUtils import Control.Monad import Data.Bits import Data.Char -import Control.Monad.Fail as Fail #include "Unique.h" @@ -156,7 +155,7 @@ instance Applicative UniqSM where (*>) = thenUs_ -- TODO: try to get rid of this instance -instance Fail.MonadFail UniqSM where +instance MonadFail UniqSM where fail = panic -- | Run the 'UniqSM' action, returning the final 'UniqSupply' ===================================== compiler/main/SysTools/Process.hs ===================================== @@ -36,14 +36,10 @@ import FileCleanup -- @process >= 1.6.8.0@). enableProcessJobs :: CreateProcess -> CreateProcess #if defined(MIN_VERSION_process) -#if MIN_VERSION_process(1,6,8) enableProcessJobs opts = opts { use_process_jobs = True } #else enableProcessJobs opts = opts #endif -#else -enableProcessJobs opts = opts -#endif -- Similar to System.Process.readCreateProcessWithExitCode, but stderr is -- inherited from the parent process, and output to stderr is not captured. ===================================== compiler/main/SysTools/Terminal.hs ===================================== @@ -32,20 +32,13 @@ import qualified System.Win32 as Win32 stderrSupportsAnsiColors :: IO Bool stderrSupportsAnsiColors = do #if defined(MIN_VERSION_terminfo) - queryTerminal stdError `andM` do - (termSupportsColors <$> setupTermFromEnv) - `catch` \ (_ :: SetupTermError) -> - pure False - + stderr_available <- queryTerminal stdError + if stderr_available then + fmap termSupportsColors setupTermFromEnv + `catch` \ (_ :: SetupTermError) -> pure False + else + pure False where - - andM :: Monad m => m Bool -> m Bool -> m Bool - andM mx my = do - x <- mx - if x - then my - else pure x - termSupportsColors :: Terminal -> Bool termSupportsColors term = fromMaybe 0 (getCapability term termColors) > 0 ===================================== compiler/typecheck/TcRnTypes.hs ===================================== @@ -124,7 +124,6 @@ import PrelNames ( isUnboundName ) import GHC.Types.CostCentre.State import Control.Monad (ap) -import qualified Control.Monad.Fail as MonadFail import Data.Set ( Set ) import qualified Data.Set as S @@ -1653,14 +1652,11 @@ instance Applicative TcPluginM where (<*>) = ap instance Monad TcPluginM where -#if !MIN_VERSION_base(4,13,0) - fail = MonadFail.fail -#endif TcPluginM m >>= k = TcPluginM (\ ev -> do a <- m ev runTcPluginM (k a) ev) -instance MonadFail.MonadFail TcPluginM where +instance MonadFail TcPluginM where fail x = TcPluginM (const $ fail x) runTcPluginM :: TcPluginM a -> EvBindsVar -> TcM a ===================================== compiler/typecheck/TcSMonad.hs ===================================== @@ -177,7 +177,6 @@ import Maybes import GHC.Core.Map import Control.Monad -import qualified Control.Monad.Fail as MonadFail import MonadUtils import Data.IORef import Data.List ( partition, mapAccumL ) @@ -2699,12 +2698,9 @@ instance Applicative TcS where (<*>) = ap instance Monad TcS where -#if !MIN_VERSION_base(4,13,0) - fail = MonadFail.fail -#endif m >>= k = TcS (\ebs -> unTcS m ebs >>= \r -> unTcS (k r) ebs) -instance MonadFail.MonadFail TcS where +instance MonadFail TcS where fail err = TcS (\_ -> fail err) instance MonadUnique TcS where ===================================== compiler/utils/Binary.hs ===================================== @@ -829,12 +829,10 @@ instance Binary RuntimeRep where put_ bh AddrRep = putByte bh 9 put_ bh FloatRep = putByte bh 10 put_ bh DoubleRep = putByte bh 11 -#if __GLASGOW_HASKELL__ >= 807 put_ bh Int8Rep = putByte bh 12 put_ bh Word8Rep = putByte bh 13 put_ bh Int16Rep = putByte bh 14 put_ bh Word16Rep = putByte bh 15 -#endif #if __GLASGOW_HASKELL__ >= 809 put_ bh Int32Rep = putByte bh 16 put_ bh Word32Rep = putByte bh 17 @@ -855,12 +853,10 @@ instance Binary RuntimeRep where 9 -> pure AddrRep 10 -> pure FloatRep 11 -> pure DoubleRep -#if __GLASGOW_HASKELL__ >= 807 12 -> pure Int8Rep 13 -> pure Word8Rep 14 -> pure Int16Rep 15 -> pure Word16Rep -#endif #if __GLASGOW_HASKELL__ >= 809 16 -> pure Int32Rep 17 -> pure Word32Rep ===================================== compiler/utils/IOEnv.hs ===================================== @@ -43,7 +43,6 @@ import Data.IORef ( IORef, newIORef, readIORef, writeIORef, modifyIORef, import System.IO.Unsafe ( unsafeInterleaveIO ) import System.IO ( fixIO ) import Control.Monad -import qualified Control.Monad.Fail as MonadFail import MonadUtils import Control.Applicative (Alternative(..)) @@ -60,11 +59,8 @@ unIOEnv (IOEnv m) = m instance Monad (IOEnv m) where (>>=) = thenM (>>) = (*>) -#if !MIN_VERSION_base(4,13,0) - fail = MonadFail.fail -#endif -instance MonadFail.MonadFail (IOEnv m) where +instance MonadFail (IOEnv m) where fail _ = failM -- Ignore the string instance Applicative (IOEnv m) where ===================================== configure.ac ===================================== @@ -158,8 +158,8 @@ if test "$WithGhc" = "" then AC_MSG_ERROR([GHC is required.]) fi -FP_COMPARE_VERSIONS([$GhcVersion],[-lt],[8.6], - [AC_MSG_ERROR([GHC version 8.6 or later is required to compile GHC.])]) +FP_COMPARE_VERSIONS([$GhcVersion],[-lt],[8.8], + [AC_MSG_ERROR([GHC version 8.8 or later is required to compile GHC.])]) if test `expr $GhcMinVersion % 2` = "1" then ===================================== hadrian/cabal.project ===================================== @@ -1,7 +1,7 @@ packages: ./ -- This essentially freezes the build plan for hadrian -index-state: 2019-12-16T07:24:23Z +index-state: 2020-03-28T07:24:23Z -- N.B. Compile with -O0 since this is not a performance-critical executable -- and the Cabal takes nearly twice as long to build with -O1. See #16817. ===================================== hadrian/src/Hadrian/Utilities.hs ===================================== @@ -40,7 +40,6 @@ import Data.Char import Data.Dynamic (Dynamic, fromDynamic, toDyn) import Data.Functor import Data.HashMap.Strict (HashMap) -import Data.List (isPrefixOf) import Data.List.Extra import Data.Maybe import Data.Typeable (TypeRep, typeOf) ===================================== hadrian/src/Settings/Builders/Cabal.hs ===================================== @@ -1,6 +1,5 @@ module Settings.Builders.Cabal (cabalBuilderArgs) where -import Hadrian.Builder (getBuilderPath, needBuilder) import Hadrian.Haskell.Cabal import Builder ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -2,8 +2,6 @@ module Settings.Builders.Ghc (ghcBuilderArgs, haddockGhcArgs) where -import Data.List.Extra (splitOn) - import Hadrian.Haskell.Cabal import Hadrian.Haskell.Cabal.Type @@ -13,6 +11,7 @@ import Settings.Builders.Common import Settings.Warnings import qualified Context as Context import Rules.Libffi (libffiName) +import System.Directory ghcBuilderArgs :: Args ghcBuilderArgs = mconcat [ compileAndLinkHs, compileC, findHsDependencies @@ -214,18 +213,20 @@ packageGhcArgs = do includeGhcArgs :: Args includeGhcArgs = do pkg <- getPackage - path <- getBuildPath + path <- exprIO . makeAbsolute =<< getBuildPath context <- getContext srcDirs <- getContextData srcDirs - autogen <- expr $ autogenPath context + abSrcDirs <- exprIO $ mapM makeAbsolute [ (pkgPath pkg -/- dir) | dir <- srcDirs ] + autogen <- expr (autogenPath context) + cautogen <- exprIO (makeAbsolute autogen) stage <- getStage - libPath <- expr $ stageLibPath stage + libPath <- expr (stageLibPath stage) let cabalMacros = autogen -/- "cabal_macros.h" expr $ need [cabalMacros] mconcat [ arg "-i" , arg $ "-i" ++ path - , arg $ "-i" ++ autogen - , pure [ "-i" ++ pkgPath pkg -/- dir | dir <- srcDirs ] + , arg $ "-i" ++ cautogen + , pure [ "-i" ++ d | d <- abSrcDirs ] , cIncludeArgs , arg $ "-I" ++ libPath , arg $ "-optc-I" ++ libPath ===================================== libraries/base/Control/Monad/ST/Lazy/Imp.hs ===================================== @@ -8,7 +8,7 @@ -- Module : Control.Monad.ST.Lazy.Imp -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) --- +-- -- Maintainer : libraries at haskell.org -- Stability : provisional -- Portability : non-portable (requires universal quantification for runST) @@ -44,7 +44,6 @@ import qualified Control.Monad.ST.Unsafe as ST import qualified GHC.ST as GHC.ST import GHC.Base -import qualified Control.Monad.Fail as Fail -- | The lazy @'ST' monad. -- The ST monad allows for destructive updates, but is escapable (unlike IO). @@ -192,7 +191,7 @@ instance Monad (ST s) where unST (k r) new_s -- | @since 4.10 -instance Fail.MonadFail (ST s) where +instance MonadFail (ST s) where fail s = errorWithoutStackTrace s -- | Return the value computed by an 'ST' computation. @@ -205,8 +204,8 @@ runST (ST st) = runRW# (\s -> case st (S# s) of (r, _) -> r) -- inside the computation. -- Note that if @f@ is strict, @'fixST' f = _|_ at . fixST :: (a -> ST s a) -> ST s a -fixST m = ST (\ s -> - let +fixST m = ST (\ s -> + let q@(r,_s') = unST (m r) s in q) -- Why don't we need unsafePerformIO in fixST? We create a thunk, q, @@ -233,7 +232,7 @@ strictToLazyST (GHC.ST.ST m) = ST $ \(S# s) -> (# s', a #) -> (a, S# s') -- See Note [Lazy ST: not producing lazy pairs] -{-| +{-| Convert a lazy 'ST' computation into a strict one. -} lazyToStrictST :: ST s a -> ST.ST s a ===================================== libraries/base/GHC/IO/Encoding.hs ===================================== @@ -107,6 +107,7 @@ utf32be = UTF32.utf32be -- -- @since 4.5.0.0 getLocaleEncoding :: IO TextEncoding +{-# NOINLINE getLocaleEncoding #-} -- | The Unicode encoding of the current locale, but allowing arbitrary -- undecodable bytes to be round-tripped through it. @@ -120,6 +121,7 @@ getLocaleEncoding :: IO TextEncoding -- -- @since 4.5.0.0 getFileSystemEncoding :: IO TextEncoding +{-# NOINLINE getFileSystemEncoding #-} -- | The Unicode encoding of the current locale, but where undecodable -- bytes are replaced with their closest visual match. Used for @@ -127,9 +129,13 @@ getFileSystemEncoding :: IO TextEncoding -- -- @since 4.5.0.0 getForeignEncoding :: IO TextEncoding +{-# NOINLINE getForeignEncoding #-} -- | @since 4.5.0.0 setLocaleEncoding, setFileSystemEncoding, setForeignEncoding :: TextEncoding -> IO () +{-# NOINLINE setLocaleEncoding #-} +{-# NOINLINE setFileSystemEncoding #-} +{-# NOINLINE setForeignEncoding #-} (getLocaleEncoding, setLocaleEncoding) = mkGlobal initLocaleEncoding (getFileSystemEncoding, setFileSystemEncoding) = mkGlobal initFileSystemEncoding @@ -139,9 +145,13 @@ mkGlobal :: a -> (IO a, a -> IO ()) mkGlobal x = unsafePerformIO $ do x_ref <- newIORef x return (readIORef x_ref, writeIORef x_ref) +{-# NOINLINE mkGlobal #-} -- | @since 4.5.0.0 initLocaleEncoding, initFileSystemEncoding, initForeignEncoding :: TextEncoding +{-# NOINLINE initLocaleEncoding #-} +-- N.B. initLocaleEncoding is exported for use in System.IO.localeEncoding. +-- NOINLINE ensures that this result is shared. #if !defined(mingw32_HOST_OS) -- It is rather important that we don't just call Iconv.mkIconvEncoding here ===================================== libraries/base/GHC/ST.hs ===================================== @@ -26,7 +26,7 @@ module GHC.ST ( import GHC.Base import GHC.Show -import qualified Control.Monad.Fail as Fail +import Control.Monad.Fail default () @@ -79,7 +79,7 @@ instance Monad (ST s) where (k2 new_s) }}) -- | @since 4.11.0.0 -instance Fail.MonadFail (ST s) where +instance MonadFail (ST s) where fail s = errorWithoutStackTrace s -- | @since 4.11.0.0 ===================================== libraries/base/Text/ParserCombinators/ReadPrec.hs ===================================== @@ -64,7 +64,7 @@ import qualified Text.ParserCombinators.ReadP as ReadP import GHC.Num( Num(..) ) import GHC.Base -import qualified Control.Monad.Fail as MonadFail +import Control.Monad.Fail -- --------------------------------------------------------------------------- -- The readPrec type @@ -88,8 +88,8 @@ instance Monad ReadPrec where P f >>= k = P (\n -> do a <- f n; let P f' = k a in f' n) -- | @since 4.9.0.0 -instance MonadFail.MonadFail ReadPrec where - fail s = P (\_ -> MonadFail.fail s) +instance MonadFail ReadPrec where + fail s = P (\_ -> fail s) -- | @since 2.01 instance MonadPlus ReadPrec ===================================== libraries/ghci/GHCi/TH.hs ===================================== @@ -97,7 +97,6 @@ import GHCi.RemoteTypes import GHC.Serialized import Control.Exception -import qualified Control.Monad.Fail as Fail import Control.Monad.IO.Class (MonadIO (..)) import Data.Binary import Data.Binary.Put @@ -144,11 +143,8 @@ instance Monad GHCiQ where do (m', s') <- runGHCiQ m s (a, s'') <- runGHCiQ (f m') s' return (a, s'') -#if !MIN_VERSION_base(4,13,0) - fail = Fail.fail -#endif -instance Fail.MonadFail GHCiQ where +instance MonadFail GHCiQ where fail err = GHCiQ $ \s -> throwIO (GHCiQException s err) getState :: GHCiQ QState ===================================== libraries/integer-gmp/changelog.md ===================================== @@ -1,5 +1,11 @@ # Changelog for [`integer-gmp` package](http://hackage.haskell.org/package/integer-gmp) +## 1.0.3.0 *January 2019* + + * Bundled with GHC 8.10.1 + + * Documentation changes + ## 1.0.2.0 *April 2018* * Bundled with GHC 8.4.2 ===================================== libraries/integer-gmp/integer-gmp.cabal ===================================== @@ -1,6 +1,6 @@ cabal-version: 2.0 name: integer-gmp -version: 1.0.2.0 +version: 1.0.3.0 synopsis: Integer library based on GMP license: BSD3 ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -52,15 +52,13 @@ import Numeric.Natural import Prelude import Foreign.ForeignPtr -import qualified Control.Monad.Fail as Fail - ----------------------------------------------------- -- -- The Quasi class -- ----------------------------------------------------- -class (MonadIO m, Fail.MonadFail m) => Quasi m where +class (MonadIO m, MonadFail m) => Quasi m where qNewName :: String -> m Name -- ^ Fresh names @@ -187,12 +185,9 @@ runQ (Q m) = m instance Monad Q where Q m >>= k = Q (m >>= \x -> unQ (k x)) (>>) = (*>) -#if !MIN_VERSION_base(4,13,0) - fail = Fail.fail -#endif -instance Fail.MonadFail Q where - fail s = report True s >> Q (Fail.fail "Q monad failure") +instance MonadFail Q where + fail s = report True s >> Q (fail "Q monad failure") instance Functor Q where fmap f (Q x) = Q (fmap f x) ===================================== testsuite/tests/perf/should_run/all.T ===================================== @@ -233,8 +233,7 @@ test('T5949', ['-O']) test('T4267', - [expect_broken(4267), - collect_stats('bytes allocated',10), + [collect_stats('bytes allocated',10), only_ways(['normal'])], compile_and_run, ['-O']) ===================================== testsuite/tests/polykinds/T17963.hs ===================================== @@ -0,0 +1,15 @@ +{-# Language DataKinds #-} +{-# Language PolyKinds #-} +{-# Language RankNTypes #-} +{-# Language StandaloneKindSignatures #-} +{-# Language TypeApplications #-} +module T17963 where + +import GHC.Types (Constraint, Type, TYPE, RuntimeRep(..)) + +type Cat :: forall (rep :: RuntimeRep). TYPE rep -> Type +type Cat ob = ob -> ob -> Type + +type Category' :: forall rep (ob :: TYPE rep). Cat @rep ob -> Constraint +class Category' (cat :: Cat @rep ob) where + id' :: forall a. cat a a ===================================== testsuite/tests/polykinds/T17963.stderr ===================================== @@ -0,0 +1,13 @@ + +T17963.hs:15:23: error: + • Couldn't match a lifted type with an unlifted type + ‘rep1’ is a rigid type variable bound by + the class declaration for ‘Category'’ + at T17963.hs:13:27-29 + When matching kinds + k0 :: * + ob :: TYPE rep1 + Expected kind ‘ob’, but ‘a’ has kind ‘k0’ + • In the first argument of ‘cat’, namely ‘a’ + In the type signature: id' :: forall a. cat a a + In the class declaration for ‘Category'’ ===================================== testsuite/tests/polykinds/all.T ===================================== @@ -216,3 +216,4 @@ test('T16263', normal, compile_fail, ['']) test('T16902', normal, compile_fail, ['']) test('CuskFam', normal, compile, ['']) test('T17841', normal, compile_fail, ['']) +test('T17963', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/636bf8ad7280623bdb2d0f9b49168af9290b406f...de7bfdb12f665a7a7dcc49f42db9d3f2c895e148 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/636bf8ad7280623bdb2d0f9b49168af9290b406f...de7bfdb12f665a7a7dcc49f42db9d3f2c895e148 You're receiving 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 Mar 31 16:47:53 2020 From: gitlab at gitlab.haskell.org (Alp Mestanogullari) Date: Tue, 31 Mar 2020 12:47:53 -0400 Subject: [Git][ghc/ghc][wip/T16296] 18 commits: Remove unused `ghciTablesNextToCode` from compiler proper Message-ID: <5e8374398f66c_61675cefcac19449fb@gitlab.haskell.org.mail> Alp Mestanogullari pushed to branch wip/T16296 at Glasgow Haskell Compiler / GHC Commits: 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. - - - - - 095afdd9 by Simon Peyton Jones at 2020-03-31T17:48:03+02: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 - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC.hs - 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/BlockId.hs - compiler/GHC/Cmm/BlockId.hs-boot - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow.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.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/Ppr.hs - compiler/GHC/Cmm/ProcPoint.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Switch/Implement.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/e7e4bad0d425cb36df6eb6a0368b464aa4af3fc2...095afdd91e7ceedb345764831b6db9cc36d0038c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e7e4bad0d425cb36df6eb6a0368b464aa4af3fc2...095afdd91e7ceedb345764831b6db9cc36d0038c You're receiving 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 Mar 31 16:47:58 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 31 Mar 2020 12:47:58 -0400 Subject: [Git][ghc/ghc][wip/T17922] 8 commits: Expect T4267 to pass Message-ID: <5e83743ea4e11_61673f81cca05dd819457f0@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T17922 at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - 4066f4e9 by Ben Gamari at 2020-03-31T12:47:54-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. - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Op/ConstantFold.hs - compiler/GHC/Core/Op/Specialise.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Types/Unique/Supply.hs - compiler/main/SysTools/Process.hs - compiler/main/SysTools/Terminal.hs - compiler/typecheck/TcRnTypes.hs - compiler/typecheck/TcSMonad.hs - compiler/utils/Binary.hs - compiler/utils/IOEnv.hs - configure.ac - hadrian/cabal.project - hadrian/src/Hadrian/Utilities.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Ghc.hs - libraries/base/Control/Monad/ST/Lazy/Imp.hs - libraries/base/GHC/IO/Encoding.hs - libraries/base/GHC/ST.hs - libraries/base/Text/ParserCombinators/ReadPrec.hs - libraries/ghci/GHCi/TH.hs - libraries/integer-gmp/changelog.md - libraries/integer-gmp/integer-gmp.cabal - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - testsuite/tests/perf/should_run/all.T - + testsuite/tests/polykinds/T17963.hs - + testsuite/tests/polykinds/T17963.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6bf85e01e9c3baec32e95a0ff129f69c8b0b6230...4066f4e9c2f54770147f1d63d55bbb300edd866c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6bf85e01e9c3baec32e95a0ff129f69c8b0b6230...4066f4e9c2f54770147f1d63d55bbb300edd866c You're receiving 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 Mar 31 16:56:19 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Tue, 31 Mar 2020 12:56:19 -0400 Subject: [Git][ghc/ghc][wip/strict-NoExtCon] 25 commits: Remove unused `ghciTablesNextToCode` from compiler proper Message-ID: <5e837633b5dc4_61675cefcac1958130@gitlab.haskell.org.mail> Ryan Scott pushed to branch wip/strict-NoExtCon at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - 6ae1e0f5 by Ryan Scott at 2020-03-31T12:52:34-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. - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC.hs - 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/BlockId.hs - compiler/GHC/Cmm/BlockId.hs-boot - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow.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.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/Ppr.hs - compiler/GHC/Cmm/ProcPoint.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Switch/Implement.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/66fbd3a2dbbc0e81afde7a8a975012fe5a8abaed...6ae1e0f5e73c0fd3f81e43d347a9c38f63edc23b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/66fbd3a2dbbc0e81afde7a8a975012fe5a8abaed...6ae1e0f5e73c0fd3f81e43d347a9c38f63edc23b You're receiving 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 Mar 31 16:59:20 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 31 Mar 2020 12:59:20 -0400 Subject: [Git][ghc/ghc][wip/refactor-stgcrun-unwinding] 351 commits: Disable two warnings for files that trigger them Message-ID: <5e8376e8a49ee_61673f8198ee100c1963240@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/refactor-stgcrun-unwinding at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - 03fc3a40 by Ben Gamari at 2020-03-31T12:59:14-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. - - - - - 30 changed files: - .ghcid - .gitlab-ci.yml - + .gitlab/ci.sh - − .gitlab/darwin-init.sh - .gitlab/linters/check-cpp.py - .gitlab/merge_request_templates/merge-request.md - − .gitlab/prepare-system.sh - − .gitlab/win32-init.sh - HACKING.md - aclocal.m4 - boot - compiler/main/GHC.hs → compiler/GHC.hs - compiler/ghci/ByteCodeAsm.hs → compiler/GHC/ByteCode/Asm.hs - compiler/ghci/ByteCodeItbls.hs → compiler/GHC/ByteCode/InfoTable.hs - compiler/ghci/ByteCodeInstr.hs → compiler/GHC/ByteCode/Instr.hs - compiler/ghci/ByteCodeLink.hs → compiler/GHC/ByteCode/Linker.hs - compiler/ghci/ByteCodeTypes.hs → compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/BlockId.hs - compiler/GHC/Cmm/BlockId.hs-boot - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/ContFlowOpt.hs - compiler/GHC/Cmm/Dataflow.hs - compiler/GHC/Cmm/Dataflow/Block.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Graph.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/DebugBlock.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9f3945646f2f428df9d8d36bf033593b4986e435...03fc3a407d70ab9fa40f4b68754397c34a81706c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9f3945646f2f428df9d8d36bf033593b4986e435...03fc3a407d70ab9fa40f4b68754397c34a81706c You're receiving 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 Mar 31 17:10:13 2020 From: gitlab at gitlab.haskell.org (Simon Jakobi) Date: Tue, 31 Mar 2020 13:10:13 -0400 Subject: [Git][ghc/ghc][wip/sjakobi/nondetfolds] 11 commits: Require GHC 8.8 as the minimum compiler for bootstrapping Message-ID: <5e837975c9fb3_6167120434ec1972051@gitlab.haskell.org.mail> Simon Jakobi pushed to branch wip/sjakobi/nondetfolds at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - d7de603e by Simon Jakobi at 2020-03-31T19:09:58+02:00 Use non-deterministic strict fold instead of foldDVarSet ...which is O(n log n) - - - - - aef31bb4 by Simon Jakobi at 2020-03-31T19:09:58+02:00 Delete some evidence bindings more efficiently (needs refactoring) - - - - - 37451081 by Simon Jakobi at 2020-03-31T19:09:58+02:00 Use non-deterministic fold to insert wanted evidence bindings - - - - - 623e652b by Simon Jakobi at 2020-03-31T19:09:58+02:00 Add and use evBindMapToVarSet - - - - - 229d2a17 by Simon Jakobi at 2020-03-31T19:09:58+02:00 Improve udfmToUfm - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Op/ConstantFold.hs - compiler/GHC/Core/Op/SetLevels.hs - compiler/GHC/Core/Op/Specialise.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Stg/Lift/Analysis.hs - compiler/GHC/Types/Unique/DFM.hs - compiler/GHC/Types/Unique/DSet.hs - compiler/GHC/Types/Unique/FM.hs - compiler/GHC/Types/Unique/Set.hs - compiler/GHC/Types/Unique/Supply.hs - compiler/GHC/Types/Var/Env.hs - compiler/GHC/Types/Var/Set.hs - compiler/main/SysTools/Process.hs - compiler/main/SysTools/Terminal.hs - compiler/typecheck/TcEvidence.hs - compiler/typecheck/TcRnTypes.hs - compiler/typecheck/TcSMonad.hs - compiler/typecheck/TcSimplify.hs - compiler/typecheck/TcType.hs - compiler/utils/Binary.hs - compiler/utils/IOEnv.hs - configure.ac - hadrian/cabal.project - hadrian/src/Hadrian/Utilities.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Ghc.hs - libraries/base/Control/Monad/ST/Lazy/Imp.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cb538d30d9f8d774064406bf8748799d2f1ad775...229d2a1737b763a440ee04d60aa83994e8a9b4b8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cb538d30d9f8d774064406bf8748799d2f1ad775...229d2a1737b763a440ee04d60aa83994e8a9b4b8 You're receiving 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 Mar 31 17:11:01 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 31 Mar 2020 13:11:01 -0400 Subject: [Git][ghc/ghc][wip/T17962] 9 commits: Expect T4267 to pass Message-ID: <5e8379a5ae0d_61675cefcac19739b8@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T17962 at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - eba58110 by Ben Gamari at 2020-03-31T13:10:00-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. - - - - - 2290eb02 by Ben Gamari at 2020-03-31T13:10:00-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. - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Op/ConstantFold.hs - compiler/GHC/Core/Op/Specialise.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Types/Unique/Supply.hs - compiler/main/SysTools/Process.hs - compiler/main/SysTools/Terminal.hs - compiler/typecheck/TcRnTypes.hs - compiler/typecheck/TcSMonad.hs - compiler/utils/Binary.hs - compiler/utils/IOEnv.hs - configure.ac - hadrian/cabal.project - hadrian/src/Hadrian/Utilities.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Packages.hs - libraries/base/Control/Monad/ST/Lazy/Imp.hs - libraries/base/GHC/IO/Encoding.hs - libraries/base/GHC/ST.hs - libraries/base/Text/ParserCombinators/ReadPrec.hs - libraries/ghci/GHCi/TH.hs - libraries/integer-gmp/changelog.md - libraries/integer-gmp/integer-gmp.cabal - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - testsuite/tests/perf/should_run/all.T - + testsuite/tests/polykinds/T17963.hs - + testsuite/tests/polykinds/T17963.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/71683a9b1cdf7d0439736577ccc46835df82f424...2290eb02cf95e9cfffcb15fc9c593d5ef79c75d9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/71683a9b1cdf7d0439736577ccc46835df82f424...2290eb02cf95e9cfffcb15fc9c593d5ef79c75d9 You're receiving 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 Mar 31 17:14:22 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 31 Mar 2020 13:14:22 -0400 Subject: [Git][ghc/ghc][wip/T17923] 8 commits: Expect T4267 to pass Message-ID: <5e837a6e65cfe_616766534601977556@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T17923 at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - 677b7eaa by Simon Peyton Jones at 2020-03-31T13:14:20-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 - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Op/ConstantFold.hs - compiler/GHC/Core/Op/Specialise.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Types/Unique/Supply.hs - compiler/main/SysTools/Process.hs - compiler/main/SysTools/Terminal.hs - compiler/typecheck/TcRnTypes.hs - compiler/typecheck/TcSMonad.hs - compiler/utils/Binary.hs - compiler/utils/IOEnv.hs - configure.ac - hadrian/cabal.project - hadrian/src/Hadrian/Utilities.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Ghc.hs - libraries/base/Control/Monad/ST/Lazy/Imp.hs - libraries/base/GHC/IO/Encoding.hs - libraries/base/GHC/ST.hs - libraries/base/Text/ParserCombinators/ReadPrec.hs - libraries/ghci/GHCi/TH.hs - libraries/integer-gmp/changelog.md - libraries/integer-gmp/integer-gmp.cabal - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - + testsuite/tests/indexed-types/should_compile/T17923.hs - testsuite/tests/indexed-types/should_compile/all.T - testsuite/tests/perf/should_run/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cd2884bdffc8ed0c2fba8d974a4812758767ca82...677b7eaa88117290ccedd85e7a2e1079d378ba53 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cd2884bdffc8ed0c2fba8d974a4812758767ca82...677b7eaa88117290ccedd85e7a2e1079d378ba53 You're receiving 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 Mar 31 17:36:10 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Tue, 31 Mar 2020 13:36:10 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T17305 Message-ID: <5e837f8a82603_61676830044198869b@gitlab.haskell.org.mail> Ryan Scott pushed new branch wip/T17305 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T17305 You're receiving 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 Mar 31 18:19:51 2020 From: gitlab at gitlab.haskell.org (Simon Jakobi) Date: Tue, 31 Mar 2020 14:19:51 -0400 Subject: [Git][ghc/ghc][wip/sjakobi/nondetfolds] Convert some existing non-det folds to be strict Message-ID: <5e8389c778d92_61675cefcac200231b@gitlab.haskell.org.mail> Simon Jakobi pushed to branch wip/sjakobi/nondetfolds at Glasgow Haskell Compiler / GHC Commits: d058ecc3 by Simon Jakobi at 2020-03-31T20:19:24+02:00 Convert some existing non-det folds to be strict - - - - - 13 changed files: - compiler/GHC/CmmToAsm/Reg/Graph/SpillClean.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/Op/OccurAnal.hs - compiler/GHC/Core/Op/SetLevels.hs - compiler/GHC/Core/Op/Specialise.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/HsToCore/Usage.hs - compiler/GHC/Rename/Source.hs - compiler/GHC/Types/Unique/FM.hs - compiler/GHC/Types/Unique/Set.hs - compiler/typecheck/TcEvidence.hs - compiler/utils/GraphOps.hs Changes: ===================================== compiler/GHC/CmmToAsm/Reg/Graph/SpillClean.hs ===================================== @@ -554,8 +554,8 @@ delAssoc :: (Uniquable a) delAssoc a m | Just aSet <- lookupUFM m a , m1 <- delFromUFM m a - = nonDetFoldUniqSet (\x m -> delAssoc1 x a m) m1 aSet - -- It's OK to use nonDetFoldUFM here because deletion is commutative + = nonDetStrictFoldUniqSet (\m x -> delAssoc1 x a m) m1 aSet + -- It's OK to use nonDetStrictFoldUFM here because deletion is commutative | otherwise = m ===================================== compiler/GHC/Core/FamInstEnv.hs ===================================== @@ -378,8 +378,8 @@ famInstEnvElts fi = [elt | FamIE elts <- eltsUDFM fi, elt <- elts] -- See Note [FamInstEnv determinism] famInstEnvSize :: FamInstEnv -> Int -famInstEnvSize = nonDetFoldUDFM (\(FamIE elt) sum -> sum + length elt) 0 - -- It's OK to use nonDetFoldUDFM here since we're just computing the +famInstEnvSize = nonDetStrictFoldUDFM (\sum (FamIE elt) -> sum + length elt) 0 + -- It's OK to use nonDetStrictFoldUDFM here since we're just computing the -- size. familyInstances :: (FamInstEnv, FamInstEnv) -> TyCon -> [FamInst] ===================================== compiler/GHC/Core/Op/OccurAnal.hs ===================================== @@ -2204,8 +2204,8 @@ extendFvs env s = (s `unionVarSet` extras, extras `subVarSet` s) where extras :: VarSet -- env(s) - extras = nonDetFoldUFM unionVarSet emptyVarSet $ - -- It's OK to use nonDetFoldUFM here because unionVarSet commutes + extras = nonDetStrictFoldUFM unionVarSet emptyVarSet $ + -- It's OK to use nonDetStrictFoldUFM here because unionVarSet commutes intersectUFM_C (\x _ -> x) env (getUniqSet s) {- @@ -2502,8 +2502,8 @@ addOneOcc ud id info plus_zapped old new = doZapping ud id old `addOccInfo` new addManyOccsSet :: UsageDetails -> VarSet -> UsageDetails -addManyOccsSet usage id_set = nonDetFoldUniqSet addManyOccs usage id_set - -- It's OK to use nonDetFoldUFM here because addManyOccs commutes +addManyOccsSet usage id_set = nonDetStrictFoldUniqSet (flip addManyOccs) usage id_set + -- It's OK to use nonDetStrictFoldUFM here because addManyOccs commutes -- Add several occurrences, assumed not to be tail calls addManyOccs :: Var -> UsageDetails -> UsageDetails ===================================== compiler/GHC/Core/Op/SetLevels.hs ===================================== @@ -83,7 +83,7 @@ import GHC.Types.Id import GHC.Types.Id.Info import GHC.Types.Var import GHC.Types.Var.Set -import GHC.Types.Unique.Set ( nonDetFoldUniqSet ) +import GHC.Types.Unique.Set ( nonDetStrictFoldUniqSet ) import GHC.Types.Unique.DSet ( getUniqDSet ) import GHC.Types.Var.Env import GHC.Types.Literal ( litIsTrivial ) @@ -1469,11 +1469,11 @@ isFunction (_, AnnLam b e) | isId b = True isFunction _ = False countFreeIds :: DVarSet -> Int -countFreeIds = nonDetFoldUDFM add 0 . getUniqDSet - -- It's OK to use nonDetFoldUDFM here because we're just counting things. +countFreeIds = nonDetStrictFoldUDFM add 0 . getUniqDSet + -- It's OK to use nonDetStrictFoldUDFM here because we're just counting things. where - add :: Var -> Int -> Int - add v n | isId v = n+1 + add :: Int -> Var -> Int + add n v | isId v = n+1 | otherwise = n {- @@ -1586,7 +1586,7 @@ maxFvLevel max_me env var_set maxFvLevel' :: (Var -> Bool) -> LevelEnv -> TyCoVarSet -> Level -- Same but for TyCoVarSet maxFvLevel' max_me env var_set - = nonDetFoldUniqSet (maxIn max_me env) tOP_LEVEL var_set + = nonDetStrictFoldUniqSet (flip (maxIn max_me env)) tOP_LEVEL var_set maxIn :: (Var -> Bool) -> LevelEnv -> InVar -> Level -> Level maxIn max_me (LE { le_lvl_env = lvl_env, le_env = id_env }) in_var lvl ===================================== compiler/GHC/Core/Op/Specialise.hs ===================================== @@ -2177,8 +2177,8 @@ unionCallInfoSet (CIS f calls1) (CIS _ calls2) = callDetailsFVs :: CallDetails -> VarSet callDetailsFVs calls = - nonDetFoldUDFM (unionVarSet . callInfoFVs) emptyVarSet calls - -- It's OK to use nonDetFoldUDFM here because we forget the ordering + nonDetStrictFoldUDFM (flip (unionVarSet . callInfoFVs)) emptyVarSet calls + -- It's OK to use nonDetStrictFoldUDFM here because we forget the ordering -- immediately by converting to a nondeterministic set. callInfoFVs :: CallInfoSet -> VarSet ===================================== compiler/GHC/Core/TyCo/FVs.hs ===================================== @@ -441,7 +441,7 @@ deepCoVarFolder = TyCoFolder { tcf_view = noView closeOverKinds :: TyCoVarSet -> TyCoVarSet -- For each element of the input set, -- add the deep free variables of its kind -closeOverKinds vs = nonDetFoldVarSet do_one vs vs +closeOverKinds vs = nonDetFoldVarSet do_one vs vs -- TODO? where do_one v acc = appEndo (deep_ty (varType v)) acc ===================================== compiler/GHC/Core/Unify.hs ===================================== @@ -658,8 +658,8 @@ niSubstTvSet :: TvSubstEnv -> TyCoVarSet -> TyCoVarSet -- remembering that the substitution isn't necessarily idempotent -- This is used in the occurs check, before extending the substitution niSubstTvSet tsubst tvs - = nonDetFoldUniqSet (unionVarSet . get) emptyVarSet tvs - -- It's OK to nonDetFoldUFM here because we immediately forget the + = nonDetStrictFoldUniqSet (flip (unionVarSet . get)) emptyVarSet tvs + -- It's OK to nonDetStrictFoldUFM here because we immediately forget the -- ordering by creating a set. where get tv ===================================== compiler/GHC/HsToCore/Usage.hs ===================================== @@ -260,7 +260,7 @@ mk_mod_usage_info pit hsc_env this_mod direct_imports used_names -- ent_map groups together all the things imported and used -- from a particular module ent_map :: ModuleEnv [OccName] - ent_map = nonDetFoldUniqSet add_mv emptyModuleEnv used_names + ent_map = nonDetFoldUniqSet add_mv emptyModuleEnv used_names -- TODO? -- nonDetFoldUFM is OK here. If you follow the logic, we sort by OccName -- in ent_hashs where ===================================== compiler/GHC/Rename/Source.hs ===================================== @@ -1422,11 +1422,11 @@ depAnalTyClDecls rdr_env kisig_fv_env ds_w_fvs toParents :: GlobalRdrEnv -> NameSet -> NameSet toParents rdr_env ns - = nonDetFoldUniqSet add emptyNameSet ns - -- It's OK to use nonDetFoldUFM because we immediately forget the + = nonDetStrictFoldUniqSet add emptyNameSet ns + -- It's OK to use nonDetStrictFoldUFM because we immediately forget the -- ordering by creating a set where - add n s = extendNameSet s (getParent rdr_env n) + add s n = extendNameSet s (getParent rdr_env n) getParent :: GlobalRdrEnv -> Name -> Name getParent rdr_env n ===================================== compiler/GHC/Types/Unique/FM.hs ===================================== @@ -56,7 +56,7 @@ module GHC.Types.Unique.FM ( intersectUFM_C, disjointUFM, equalKeysUFM, - nonDetFoldUFM, foldUFM, nonDetFoldUFM_Directly, + nonDetFoldUFM, nonDetStrictFoldUFM, foldUFM, nonDetFoldUFM_Directly, anyUFM, allUFM, seqEltsUFM, mapUFM, mapUFM_Directly, elemUFM, elemUFM_Directly, @@ -321,6 +321,9 @@ nonDetKeysUFM (UFM m) = map getUnique $ M.keys m nonDetFoldUFM :: (elt -> a -> a) -> a -> UniqFM elt -> a nonDetFoldUFM k z (UFM m) = M.foldr k z m +nonDetStrictFoldUFM :: (a -> elt -> a) -> a -> UniqFM elt -> a +nonDetStrictFoldUFM k z (UFM m) = M.foldl' k z m + -- See Note [Deterministic UniqFM] to learn about nondeterminism. -- If you use this please provide a justification why it doesn't introduce -- nondeterminism. ===================================== compiler/GHC/Types/Unique/Set.hs ===================================== @@ -43,6 +43,7 @@ module GHC.Types.Unique.Set ( nonDetEltsUniqSet, nonDetKeysUniqSet, nonDetFoldUniqSet, + nonDetStrictFoldUniqSet, nonDetFoldUniqSet_Directly ) where @@ -166,6 +167,9 @@ nonDetKeysUniqSet = nonDetKeysUFM . getUniqSet' nonDetFoldUniqSet :: (elt -> a -> a) -> a -> UniqSet elt -> a nonDetFoldUniqSet c n (UniqSet s) = nonDetFoldUFM c n s +nonDetStrictFoldUniqSet :: (a -> elt -> a) -> a -> UniqSet elt -> a +nonDetStrictFoldUniqSet c n (UniqSet s) = nonDetStrictFoldUFM c n s + -- See Note [Deterministic UniqFM] to learn about nondeterminism. -- If you use this please provide a justification why it doesn't introduce -- nondeterminism. ===================================== compiler/typecheck/TcEvidence.hs ===================================== @@ -862,12 +862,12 @@ findNeededEvVars ev_binds seeds = transCloVarSet also_needs seeds where also_needs :: VarSet -> VarSet - also_needs needs = nonDetFoldUniqSet add emptyVarSet needs - -- It's OK to use nonDetFoldUFM here because we immediately + also_needs needs = nonDetStrictFoldUniqSet add emptyVarSet needs + -- It's OK to use nonDetStrictFoldUFM here because we immediately -- forget about the ordering by creating a set - add :: Var -> VarSet -> VarSet - add v needs + add :: VarSet -> Var -> VarSet + add needs v | Just ev_bind <- lookupEvBind ev_binds v , EvBind { eb_is_given = is_given, eb_rhs = rhs } <- ev_bind , is_given ===================================== compiler/utils/GraphOps.hs ===================================== @@ -63,7 +63,7 @@ addNode k node graph = let -- add back conflict edges from other nodes to this one map_conflict = - nonDetFoldUniqSet + nonDetFoldUniqSet -- TODO? -- It's OK to use nonDetFoldUFM here because the -- operation is commutative (adjustUFM_C (\n -> n { nodeConflicts = @@ -73,7 +73,7 @@ addNode k node graph -- add back coalesce edges from other nodes to this one map_coalesce = - nonDetFoldUniqSet + nonDetFoldUniqSet -- TODO? -- It's OK to use nonDetFoldUFM here because the -- operation is commutative (adjustUFM_C (\n -> n { nodeCoalesce = @@ -476,7 +476,7 @@ freezeNode k else node -- panic "GraphOps.freezeNode: edge to freeze wasn't in the coalesce set" -- If the edge isn't actually in the coelesce set then just ignore it. - fm2 = nonDetFoldUniqSet (adjustUFM_C (freezeEdge k)) fm1 + fm2 = nonDetFoldUniqSet (adjustUFM_C (freezeEdge k)) fm1 -- TODO? -- It's OK to use nonDetFoldUFM here because the operation -- is commutative $ nodeCoalesce node View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d058ecc3bb567581d6d2a01d9cd8878b22fd9464 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d058ecc3bb567581d6d2a01d9cd8878b22fd9464 You're receiving 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 Mar 31 22:09:18 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Tue, 31 Mar 2020 18:09:18 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T17966 Message-ID: <5e83bf8e95863_616776d1c7420430e0@gitlab.haskell.org.mail> Simon Peyton Jones pushed new branch wip/T17966 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T17966 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: