[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: Add a missing zonk in tcHsPartialType
Marge Bot
gitlab at gitlab.haskell.org
Sat Apr 18 09:49:43 UTC 2020
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
5a7cdf21 by Simon Peyton Jones at 2020-04-18T05:49:32-04:00
Add a missing zonk in tcHsPartialType
I omitted a vital zonk when refactoring tcHsPartialType in
commit 48fb3482f8cbc8a4b37161021e846105f980eed4
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Wed Jun 5 08:55:17 2019 +0100
Fix typechecking of partial type signatures
This patch fixes it and adds commentary to explain why.
Fixes #18008
- - - - -
324b5d2c by Ben Gamari at 2020-04-18T05:49:33-04:00
gitlab-ci: Bump FreeBSD bootstrap compiler to 8.10.1
- - - - -
2ec2b610 by Ben Gamari at 2020-04-18T05:49:33-04:00
gitlab-ci: Enable FreeBSD job for so-labelled MRs
- - - - -
d14ef0a6 by Ben Gamari at 2020-04-18T05:49:33-04:00
gitlab-ci: Use rules syntax for conditional jobs
- - - - -
345d3282 by Ben Gamari at 2020-04-18T05:49:33-04:00
Bump hsc2hs submodule
- - - - -
45186e46 by Ömer Sinan Ağacan at 2020-04-18T05:49:35-04:00
Improve prepForeignCall error reporting
Show parameters and description of the error code when ffi_prep_cif
fails.
This may be helpful for debugging #17018.
- - - - -
8 changed files:
- .gitlab-ci.yml
- .gitlab/ci.sh
- compiler/GHC/Tc/Gen/HsType.hs
- libraries/ghci/GHCi/FFI.hsc
- + testsuite/tests/partial-sigs/should_compile/T18008.hs
- + testsuite/tests/partial-sigs/should_compile/T18008.stderr
- testsuite/tests/partial-sigs/should_compile/all.T
- utils/hsc2hs
Changes:
=====================================
.gitlab-ci.yml
=====================================
@@ -26,19 +26,18 @@ stages:
- testing # head.hackage correctness and compiler performance testing
- deploy # push documentation
-# N.B.Don't run on wip/ branches, instead on run on merge requests.
-.only-default: &only-default
- only:
- - master
- - /ghc-[0-9]+\.[0-9]+/
- - merge_requests
- - tags
- - web
+workflow:
+ # N.B.Don't run on wip/ branches, instead on run on merge requests.
+ rules:
+ - if: $CI_MERGE_REQUEST_ID
+ - if: $CI_COMMIT_TAG
+ - if: '$CI_COMMIT_BRANCH == "master"'
+ - if: '$CI_COMMIT_BRANCH =~ /ghc-[0.9]+\.[0-9]+/'
+ - if: '$CI_PIPELINE_SOURCE == "web"'
.nightly: &nightly
- only:
- variables:
- - $NIGHTLY
+ rules:
+ - if: $NIGHTLY
artifacts:
when: always
expire_in: 8 weeks
@@ -50,9 +49,8 @@ stages:
artifacts:
when: always
expire_in: 1 year
- only:
- variables:
- - $RELEASE == "yes"
+ rules:
+ - if: '$RELEASE == "yes"'
############################################################
# Runner Tags
@@ -86,13 +84,11 @@ ghc-linters:
dependencies: []
tags:
- lint
- only:
- refs:
- - merge_requests
+ rules:
+ - if: $CI_MERGE_REQUEST_ID
# Run mypy Python typechecker on linter scripts.
lint-linters:
- <<: *only-default
stage: lint
image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV"
script:
@@ -103,7 +99,6 @@ lint-linters:
# Check that .T files all parse by listing broken tests.
lint-testsuite:
- <<: *only-default
stage: lint
image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV"
script:
@@ -114,7 +109,6 @@ lint-testsuite:
# Run mypy Python typechecker on testsuite driver
typecheck-testsuite:
- <<: *only-default
stage: lint
image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV"
script:
@@ -127,7 +121,6 @@ typecheck-testsuite:
# accommodate, e.g., haddock changes not yet upstream) but not on `master` or
# Marge jobs.
.lint-submods:
- <<: *only-default
stage: lint
image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV"
script:
@@ -140,25 +133,14 @@ typecheck-testsuite:
tags:
- lint
-lint-submods-marge:
+lint-submods:
extends: .lint-submods
- only:
- refs:
- - merge_requests
- variables:
- - "$CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/"
-
-lint-submods-mr:
- extends: .lint-submods
- # Allow failure since any necessary submodule patches may not be upstreamed
- # yet.
- allow_failure: true
- only:
- refs:
- - merge_requests
- except:
- variables:
- - "$CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/"
+ # Allow failure on merge requests since any necessary submodule patches may
+ # not be upstreamed yet.
+ rules:
+ - if: '$CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/'
+ allow_failure: false
+ - allow_failure: true
lint-submods-branch:
extends: .lint-submods
@@ -166,13 +148,11 @@ lint-submods-branch:
- "echo Linting submodule changes between $CI_COMMIT_BEFORE_SHA..$CI_COMMIT_SHA"
- git submodule foreach git remote update
- submodchecker . $(git rev-list $CI_COMMIT_BEFORE_SHA..$CI_COMMIT_SHA)
- only:
- refs:
- - master
- - /ghc-[0-9]+\.[0-9]+/
+ rules:
+ - if: '$CI_COMMIT_BRANCH == "master"'
+ - if: '$CI_COMMIT_BRANCH =~ /ghc-[0.9]+\.[0-9]+/'
.lint-changelogs:
- <<: *only-default
stage: lint
image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV"
dependencies: []
@@ -185,15 +165,13 @@ lint-changelogs:
extends: .lint-changelogs
# Allow failure since this isn't a final release.
allow_failure: true
- only:
- refs:
- - /ghc-[0-9]+\.[0-9]+/
+ rules:
+ - if: '$CI_COMMIT_BRANCH =~ /ghc-[0.9]+\.[0-9]+/'
lint-release-changelogs:
extends: .lint-changelogs
- only:
- refs:
- - /ghc-[0-9]+\.[0-9]+\.[0-9]+-.*/
+ rules:
+ - if: '$CI_COMMIT_BRANCH =~ /ghc-[0.9]+\.[0-9]+/'
############################################################
@@ -201,7 +179,6 @@ lint-release-changelogs:
############################################################
.validate-hadrian:
- <<: *only-default
variables:
FLAVOUR: "validate"
script:
@@ -250,7 +227,6 @@ validate-x86_64-linux-deb9-unreg-hadrian:
TEST_ENV: "x86_64-linux-deb9-unreg-hadrian"
hadrian-ghc-in-ghci:
- <<: *only-default
stage: quick-build
image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV"
before_script:
@@ -283,7 +259,6 @@ hadrian-ghc-in-ghci:
############################################################
.validate:
- <<: *only-default
variables:
TEST_TYPE: test
MAKE_ARGS: "-Werror"
@@ -317,8 +292,8 @@ hadrian-ghc-in-ghci:
# 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
+ GHC_VERSION: 8.10.1
+ CABAL_INSTALL_VERSION: 3.2.0.0
BIN_DIST_PREP_TAR_COMP: "ghc-x86_64-portbld-freebsd.tar.xz"
TEST_ENV: "x86_64-freebsd"
BUILD_FLAVOUR: "validate"
@@ -334,10 +309,12 @@ hadrian-ghc-in-ghci:
- cabal-cache
- toolchain
-# Disabled due to lack of builder capacity
-.validate-x86_64-freebsd:
+# Conditional due to lack of builder capacity
+validate-x86_64-freebsd:
extends: .build-x86_64-freebsd
stage: full-build
+ rules:
+ - if: '$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/'
nightly-x86_64-freebsd:
<<: *nightly
@@ -414,7 +391,6 @@ validate-x86_64-darwin:
# Disabled because of OS X CI capacity
.validate-x86_64-darwin-hadrian:
- <<: *only-default
stage: full-build
tags:
- x86_64-darwin
@@ -777,7 +753,6 @@ 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:
@@ -951,7 +926,6 @@ nightly-i386-windows:
# See Note [Cleanup after shell executor]
cleanup-darwin:
- <<: *only-default
stage: cleanup
tags:
- x86_64-darwin
@@ -973,7 +947,6 @@ cleanup-darwin:
############################################################
doc-tarball:
- <<: *only-default
stage: packaging
tags:
- x86_64-linux
@@ -1013,10 +986,10 @@ source-tarball:
tags:
- x86_64-linux
image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV"
- when: always
dependencies: []
- only:
- - tags
+ rules:
+ - if: $CI_COMMIT_TAG
+ when: always
artifacts:
paths:
- ghc-*.tar.xz
@@ -1043,7 +1016,6 @@ source-tarball:
# pipeline.
.hackage:
- <<: *only-default
stage: testing
image: ghcci/x86_64-linux-deb9:0.2
tags:
@@ -1060,9 +1032,8 @@ hackage:
hackage-label:
extends: .hackage
- only:
- variables:
- - $CI_MERGE_REQUEST_LABELS =~ /.*user-facing.*/
+ rules:
+ - if: '$CI_MERGE_REQUEST_LABELS =~ /.*user-facing.*/'
nightly-hackage:
<<: *nightly
@@ -1077,11 +1048,10 @@ perf-nofib:
dependencies:
- validate-x86_64-linux-deb9-dwarf
image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV"
- only:
- refs:
- - merge_requests
- - master
- - /ghc-[0-9]+\.[0-9]+/
+ rules:
+ - if: $CI_MERGE_REQUEST_ID
+ - if: '$CI_COMMIT_BRANCH == "master"'
+ - if: '$CI_COMMIT_BRANCH =~ /ghc-[0.9]+\.[0-9]+/'
tags:
- x86_64-linux
script:
@@ -1130,8 +1100,8 @@ pages:
<meta http-equiv="refresh" content="1; url=doc/">
EOF
- cp -f index.html public/doc
- only:
- - master
+ rules:
+ - if: '$CI_COMMIT_BRANCH == "master"'
artifacts:
paths:
- public
=====================================
.gitlab/ci.sh
=====================================
@@ -139,12 +139,6 @@ function set_toolchain_paths() {
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
=====================================
compiler/GHC/Tc/Gen/HsType.hs
=====================================
@@ -732,6 +732,7 @@ tc_hs_type mode forall@(HsForAllTy { hst_fvf = fvf, hst_bndrs = hs_tvs
m_telescope = Just (sep (map ppr hs_tvs))
; emitResidualTvConstraint skol_info m_telescope tvs' tclvl wanted
+ -- See Note [Skolem escape and forall-types]
; return (mkForAllTys bndrs ty') }
@@ -920,6 +921,26 @@ under these conditions.
See related Note [Wildcards in visible type application] here and
Note [The wildcard story for types] in GHC.Hs.Types
+Note [Skolem escape and forall-types]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider
+ f :: forall a. (forall kb (b :: kb). Proxy '[a, b]) -> ()
+
+The Proxy '[a,b] forces a and b to have the same kind. But a's
+kind must be bound outside the 'forall a', and hence escapes.
+We discover this by building an implication constraint for
+each forall. So the inner implication constraint will look like
+ forall kb (b::kb). kb ~ ka
+where ka is a's kind. We can't unify these two, /even/ if ka is
+unification variable, because it would be untouchable inside
+this inner implication.
+
+That's what the pushLevelAndCaptureConstraints, plus subsequent
+emitResidualTvConstraint is all about, when kind-checking
+HsForAllTy.
+
+Note that we don't need to /simplify/ the constraints here
+because we aren't generalising. We just capture them.
-}
{- *********************************************************************
@@ -2819,10 +2840,13 @@ kindGeneralizeAll ty = do { traceTc "kindGeneralizeAll" empty
; kindGeneralizeSome (const True) ty }
-- | Specialized version of 'kindGeneralizeSome', but where no variables
--- can be generalized. Use this variant when it is unknowable whether metavariables
--- might later be constrained.
--- See Note [Recipe for checking a signature] for why and where this
--- function is needed.
+-- can be generalized, but perhaps some may neeed to be promoted.
+-- Use this variant when it is unknowable whether metavariables might
+-- later be constrained.
+--
+-- To see why this promotion is needed, see
+-- Note [Recipe for checking a signature], and especially
+-- Note [Promotion in signatures].
kindGeneralizeNone :: TcType -- needn't be zonked
-> TcM ()
kindGeneralizeNone ty
@@ -3160,7 +3184,7 @@ tcHsPartialSigType ctxt sig_ty
; return (wcs, wcx, theta, tau) }
- -- No kind-generalization here:
+ -- No kind-generalization here, but perhaps some promotion
; kindGeneralizeNone (mkSpecForAllTys implicit_tvs $
mkSpecForAllTys explicit_tvs $
mkPhiTy theta $
@@ -3171,6 +3195,14 @@ tcHsPartialSigType ctxt sig_ty
-- See Note [Extra-constraint holes in partial type signatures]
; emitNamedWildCardHoleConstraints wcs
+ -- Zonk, so that any nested foralls can "see" their occurrences
+ -- See Note [Checking partial type signatures], in
+ -- the bullet on Nested foralls.
+ ; implicit_tvs <- mapM zonkTcTyVarToTyVar implicit_tvs
+ ; explicit_tvs <- mapM zonkTcTyVarToTyVar explicit_tvs
+ ; theta <- mapM zonkTcType theta
+ ; tau <- zonkTcType tau
+
-- We return a proper (Name,TyVar) environment, to be sure that
-- we bring the right name into scope in the function body.
-- Test case: partial-sigs/should_compile/LocalDefinitionBug
@@ -3179,7 +3211,7 @@ tcHsPartialSigType ctxt sig_ty
-- NB: checkValidType on the final inferred type will be
-- done later by checkInferredPolyId. We can't do it
- -- here because we don't have a complete tuype to check
+ -- here because we don't have a complete type to check
; traceTc "tcHsPartialSigType" (ppr tv_prs)
; return (wcs, wcx, tv_prs, theta, tau) }
@@ -3198,12 +3230,31 @@ tcPartialContext hs_theta
{- Note [Checking partial type signatures]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-See also Note [Recipe for checking a signature]
+This Note is about tcHsPartialSigType. See also
+Note [Recipe for checking a signature]
When we have a partial signature like
- f,g :: forall a. a -> _
+ f :: forall a. a -> _
we do the following
+* tcHsPartialSigType does not make quantified type (forall a. blah)
+ and then instantiate it -- it makes no sense to instantiate a type
+ with wildcards in it. Rather, tcHsPartialSigType just returns the
+ 'a' and the 'blah' separately.
+
+ Nor, for the same reason, do we push a level in tcHsPartialSigType.
+
+* We instantiate 'a' to a unification variable, a TyVarTv, and /not/
+ a skolem; hence the "_Tv" in bindExplicitTKBndrs_Tv. Consider
+ f :: forall a. a -> _
+ g :: forall b. _ -> b
+ f = g
+ g = f
+ They are typechecked as a recursive group, with monomorphic types,
+ so 'a' and 'b' will get unified together. Very like kind inference
+ for mutually recursive data types (sans CUSKs or SAKS); see
+ Note [Cloning for tyvar binders] in GHC.Tc.Gen.HsType
+
* In GHC.Tc.Gen.Sig.tcUserSigType we return a PartialSig, which (unlike
the companion CompleteSig) contains the original, as-yet-unchecked
source-code LHsSigWcType
@@ -3218,12 +3269,28 @@ we do the following
g x = True
It's really as if we'd written two distinct signatures.
-* Note that we don't make quantified type (forall a. blah) and then
- instantiate it -- it makes no sense to instantiate a type with
- wildcards in it. Rather, tcHsPartialSigType just returns the
- 'a' and the 'blah' separately.
-
- Nor, for the same reason, do we push a level in tcHsPartialSigType.
+* Nested foralls. Consider
+ f :: forall b. (forall a. a -> _) -> b
+ We do /not/ allow the "_" to be instantiated to 'a'; but we do
+ (as before) allow it to be instantiated to the (top level) 'b'.
+ Why not? Because suppose
+ f x = (x True, x 'c')
+ We must instantiate that (forall a. a -> _) when typechecking
+ f's body, so we must know precisely where all the a's are; they
+ must not be hidden under (filled-in) unification variables!
+
+ We achieve this in the usual way: we push a level at a forall,
+ so now the unification variable for the "_" can't unify with
+ 'a'.
+
+* Just as for ordinary signatures, we must zonk the type after
+ kind-checking it, to ensure that all the nested forall binders can
+ see their occurrenceds
+
+ Just as for ordinary signatures, this zonk also gets any Refl casts
+ out of the way of instantiation. Example: #18008 had
+ foo :: (forall a. (Show a => blah) |> Refl) -> _
+ and that Refl cast messed things up. See #18062.
Note [Extra-constraint holes in partial type signatures]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
libraries/ghci/GHCi/FFI.hsc
=====================================
@@ -58,15 +58,29 @@ prepForeignCall cconv arg_types result_type = do
cif <- mallocBytes (#const sizeof(ffi_cif))
let abi = convToABI cconv
r <- ffi_prep_cif cif abi (fromIntegral n_args) (ffiType result_type) arg_arr
- if (r /= fFI_OK)
- then throwIO (ErrorCall ("prepForeignCallFailed: " ++ show r))
- else return (castPtr cif)
+ if r /= fFI_OK then
+ throwIO $ ErrorCall $ concat
+ [ "prepForeignCallFailed: ", strError r,
+ "(cconv: ", show cconv,
+ " arg tys: ", show arg_types,
+ " res ty: ", show result_type, ")" ]
+ else
+ return (castPtr cif)
freeForeignCallInfo :: Ptr C_ffi_cif -> IO ()
freeForeignCallInfo p = do
free ((#ptr ffi_cif, arg_types) p)
free p
+strError :: C_ffi_status -> String
+strError r
+ | r == fFI_BAD_ABI
+ = "invalid ABI (FFI_BAD_ABI)"
+ | r == fFI_BAD_TYPEDEF
+ = "invalid type description (FFI_BAD_TYPEDEF)"
+ | otherwise
+ = "unknown error: " ++ show r
+
convToABI :: FFIConv -> C_ffi_abi
convToABI FFICCall = fFI_DEFAULT_ABI
#if defined(mingw32_HOST_OS) && defined(i386_HOST_ARCH)
@@ -108,12 +122,10 @@ foreign import ccall "&ffi_type_float" ffi_type_float :: Ptr C_ffi_type
foreign import ccall "&ffi_type_double" ffi_type_double :: Ptr C_ffi_type
foreign import ccall "&ffi_type_pointer"ffi_type_pointer :: Ptr C_ffi_type
-fFI_OK :: C_ffi_status
-fFI_OK = (#const FFI_OK)
---fFI_BAD_ABI :: C_ffi_status
---fFI_BAD_ABI = (#const FFI_BAD_ABI)
---fFI_BAD_TYPEDEF :: C_ffi_status
---fFI_BAD_TYPEDEF = (#const FFI_BAD_TYPEDEF)
+fFI_OK, fFI_BAD_ABI, fFI_BAD_TYPEDEF :: C_ffi_status
+fFI_OK = (#const FFI_OK)
+fFI_BAD_ABI = (#const FFI_BAD_ABI)
+fFI_BAD_TYPEDEF = (#const FFI_BAD_TYPEDEF)
fFI_DEFAULT_ABI :: C_ffi_abi
fFI_DEFAULT_ABI = (#const FFI_DEFAULT_ABI)
=====================================
testsuite/tests/partial-sigs/should_compile/T18008.hs
=====================================
@@ -0,0 +1,7 @@
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE PartialTypeSignatures #-}
+module Bug where
+
+f :: (forall a. Show a => a -> String) -> _
+f s = s ()
+
=====================================
testsuite/tests/partial-sigs/should_compile/T18008.stderr
=====================================
@@ -0,0 +1,5 @@
+
+T18008.hs:5:43: warning: [-Wpartial-type-signatures (in -Wdefault)]
+ • Found type wildcard ‘_’ standing for ‘String’
+ • In the type ‘(forall a. Show a => a -> String) -> _’
+ In the type signature: f :: (forall a. Show a => a -> String) -> _
=====================================
testsuite/tests/partial-sigs/should_compile/all.T
=====================================
@@ -95,3 +95,4 @@ test('T16334', normal, compile, [''])
test('T16728', normal, compile, [''])
test('T16728a', normal, compile, [''])
test('T16728b', normal, compile, [''])
+test('T18008', normal, compile, [''])
=====================================
utils/hsc2hs
=====================================
@@ -1 +1 @@
-Subproject commit dff4ed1acf9ebbdd004fc833a474dc8c16a90f5b
+Subproject commit 24100ea521596922d3edc8370b3d9f7b845ae4cf
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/37c89c05908dcdb692a5839509357bace3183bba...45186e464a3f5a6d302debc930ef3376959ab707
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/37c89c05908dcdb692a5839509357bace3183bba...45186e464a3f5a6d302debc930ef3376959ab707
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200418/bb6028d9/attachment-0001.html>
More information about the ghc-commits
mailing list