summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--compiler/GHC/Builtin/Names.hs7
-rw-r--r--compiler/GHC/Builtin/Types.hs27
-rw-r--r--compiler/GHC/Core/Coercion.hs1
-rw-r--r--compiler/GHC/Core/Type.hs18
-rw-r--r--compiler/GHC/Driver/Main.hs4
-rw-r--r--compiler/GHC/Hs/Binds.hs7
-rw-r--r--compiler/GHC/Hs/Type.hs5
-rw-r--r--compiler/GHC/HsToCore/Binds.hs7
-rw-r--r--compiler/GHC/HsToCore/PmCheck.hs2
-rw-r--r--compiler/GHC/Iface/Load.hs2
-rw-r--r--compiler/GHC/Rename/Splice.hs4
-rw-r--r--compiler/GHC/Tc/Errors.hs567
-rw-r--r--compiler/GHC/Tc/Errors/Hole.hs4
-rw-r--r--compiler/GHC/Tc/Gen/Arrow.hs15
-rw-r--r--compiler/GHC/Tc/Gen/Bind.hs148
-rw-r--r--compiler/GHC/Tc/Gen/Default.hs4
-rw-r--r--compiler/GHC/Tc/Gen/Expr.hs288
-rw-r--r--compiler/GHC/Tc/Gen/Expr.hs-boot30
-rw-r--r--compiler/GHC/Tc/Gen/Foreign.hs2
-rw-r--r--compiler/GHC/Tc/Gen/HsType.hs831
-rw-r--r--compiler/GHC/Tc/Gen/Match.hs75
-rw-r--r--compiler/GHC/Tc/Gen/Pat.hs52
-rw-r--r--compiler/GHC/Tc/Gen/Rule.hs2
-rw-r--r--compiler/GHC/Tc/Gen/Sig.hs16
-rw-r--r--compiler/GHC/Tc/Gen/Splice.hs12
-rw-r--r--compiler/GHC/Tc/Module.hs9
-rw-r--r--compiler/GHC/Tc/Solver.hs203
-rw-r--r--compiler/GHC/Tc/Solver/Canonical.hs112
-rw-r--r--compiler/GHC/Tc/Solver/Flatten.hs2
-rw-r--r--compiler/GHC/Tc/TyCl.hs91
-rw-r--r--compiler/GHC/Tc/TyCl/Instance.hs40
-rw-r--r--compiler/GHC/Tc/TyCl/PatSyn.hs6
-rw-r--r--compiler/GHC/Tc/Types/Constraint.hs48
-rw-r--r--compiler/GHC/Tc/Types/Origin.hs17
-rw-r--r--compiler/GHC/Tc/Utils/Env.hs39
-rw-r--r--compiler/GHC/Tc/Utils/Instantiate.hs150
-rw-r--r--compiler/GHC/Tc/Utils/Monad.hs15
-rw-r--r--compiler/GHC/Tc/Utils/TcMType.hs53
-rw-r--r--compiler/GHC/Tc/Utils/TcType.hs41
-rw-r--r--compiler/GHC/Tc/Utils/Unify.hs767
-rw-r--r--compiler/GHC/Tc/Validity.hs4
-rw-r--r--compiler/GHC/Types/Var.hs15
-rw-r--r--docs/users_guide/8.12.1-notes.rst7
-rw-r--r--docs/users_guide/exts/rank_polymorphism.rst62
-rw-r--r--ghc/GHCi/UI.hs5
m---------libraries/Cabal0
-rw-r--r--libraries/base/tests/T9681.stderr2
m---------libraries/haskeline0
-rw-r--r--testsuite/tests/ado/T13242a.stderr3
-rw-r--r--testsuite/tests/ado/ado002.stderr12
-rw-r--r--testsuite/tests/ado/ado004.stderr10
-rw-r--r--testsuite/tests/annotations/should_fail/annfail06.hs6
-rw-r--r--testsuite/tests/arrows/should_fail/T5380.stderr4
-rw-r--r--testsuite/tests/backpack/should_fail/bkpfail24.stderr7
-rw-r--r--testsuite/tests/boxy/Base1.stderr14
-rw-r--r--testsuite/tests/deSugar/should_compile/T10662.stderr2
-rw-r--r--testsuite/tests/dependent/should_compile/dynamic-paper.stderr2
-rw-r--r--testsuite/tests/dependent/should_fail/BadTelescope5.stderr6
-rw-r--r--testsuite/tests/dependent/should_fail/T11407.stderr2
-rw-r--r--testsuite/tests/dependent/should_fail/T11471.stderr4
-rw-r--r--testsuite/tests/dependent/should_fail/T13780a.stderr3
-rw-r--r--testsuite/tests/dependent/should_fail/T14066.stderr10
-rw-r--r--testsuite/tests/dependent/should_fail/T14066d.stderr4
-rw-r--r--testsuite/tests/dependent/should_fail/T14066e.stderr5
-rw-r--r--testsuite/tests/dependent/should_fail/T16326_Fail10.stderr2
-rw-r--r--testsuite/tests/dependent/should_fail/T17131.stderr5
-rw-r--r--testsuite/tests/dependent/should_fail/T17541.stderr5
-rw-r--r--testsuite/tests/dependent/should_fail/TypeSkolEscape.stderr4
-rw-r--r--testsuite/tests/deriving/should_fail/T1496.stderr15
-rw-r--r--testsuite/tests/deriving/should_fail/T5498.stderr16
-rw-r--r--testsuite/tests/deriving/should_fail/T7148.stderr10
-rw-r--r--testsuite/tests/deriving/should_fail/T8984.stderr14
-rw-r--r--testsuite/tests/determinism/determ004/determ004.hs4
-rw-r--r--testsuite/tests/gadt/T3169.stderr10
-rw-r--r--testsuite/tests/gadt/T3651.stderr8
-rw-r--r--testsuite/tests/gadt/T7558.stderr6
-rw-r--r--testsuite/tests/gadt/gadt-escape1.stderr7
-rw-r--r--testsuite/tests/gadt/rw.stderr4
-rw-r--r--testsuite/tests/ghci.debugger/scripts/T14628.stderr11
-rw-r--r--testsuite/tests/ghci/scripts/Defer02.stderr20
-rw-r--r--testsuite/tests/ghci/scripts/T10508.stderr7
-rw-r--r--testsuite/tests/ghci/scripts/T12005.script4
-rw-r--r--testsuite/tests/ghci/scripts/T12447.stdout4
-rw-r--r--testsuite/tests/ghci/scripts/T16767.stdout4
-rw-r--r--testsuite/tests/ghci/scripts/T2976.stdout4
-rw-r--r--testsuite/tests/ghci/scripts/T8357.stdout6
-rw-r--r--testsuite/tests/ghci/scripts/T8649.stderr13
-rw-r--r--testsuite/tests/ghci/scripts/T8959b.stderr2
-rw-r--r--testsuite/tests/ghci/scripts/ghci012.stdout2
-rw-r--r--testsuite/tests/ghci/scripts/ghci051.stderr15
-rw-r--r--testsuite/tests/ghci/scripts/ghci052.stderr54
-rw-r--r--testsuite/tests/ghci/scripts/ghci053.stderr28
-rw-r--r--testsuite/tests/ghci/scripts/ghci061.stderr14
-rw-r--r--testsuite/tests/ghci/scripts/ghci064.stdout32
-rw-r--r--testsuite/tests/ghci/should_fail/T16287.stderr4
-rw-r--r--testsuite/tests/ghci/should_run/T13456.stdout4
-rw-r--r--testsuite/tests/hiefile/should_run/HieQueries.stdout4
-rw-r--r--testsuite/tests/indexed-types/should_compile/PushedInAsGivens.stderr3
-rw-r--r--testsuite/tests/indexed-types/should_compile/Simple14.hs10
-rw-r--r--testsuite/tests/indexed-types/should_compile/Simple14.stderr30
-rw-r--r--testsuite/tests/indexed-types/should_compile/T10806.stderr4
-rw-r--r--testsuite/tests/indexed-types/should_compile/T12538.stderr7
-rw-r--r--testsuite/tests/indexed-types/should_compile/T17923.hs6
-rw-r--r--testsuite/tests/indexed-types/should_fail/ExtraTcsUntch.stderr6
-rw-r--r--testsuite/tests/indexed-types/should_fail/NoMatchErr.stderr7
-rw-r--r--testsuite/tests/indexed-types/should_fail/Overlap6.stderr4
-rw-r--r--testsuite/tests/indexed-types/should_fail/SimpleFail16.stderr15
-rw-r--r--testsuite/tests/indexed-types/should_fail/SimpleFail5a.stderr4
-rw-r--r--testsuite/tests/indexed-types/should_fail/SimpleFail5b.stderr12
-rw-r--r--testsuite/tests/indexed-types/should_fail/T13674.stderr20
-rw-r--r--testsuite/tests/indexed-types/should_fail/T13784.stderr20
-rw-r--r--testsuite/tests/indexed-types/should_fail/T14246.stderr10
-rw-r--r--testsuite/tests/indexed-types/should_fail/T14369.stderr7
-rw-r--r--testsuite/tests/indexed-types/should_fail/T14904.stderr2
-rw-r--r--testsuite/tests/indexed-types/should_fail/T15870.stderr3
-rw-r--r--testsuite/tests/indexed-types/should_fail/T1897b.stderr7
-rw-r--r--testsuite/tests/indexed-types/should_fail/T1900.stderr7
-rw-r--r--testsuite/tests/indexed-types/should_fail/T2239.hs10
-rw-r--r--testsuite/tests/indexed-types/should_fail/T2544.stderr7
-rw-r--r--testsuite/tests/indexed-types/should_fail/T2627b.stderr14
-rw-r--r--testsuite/tests/indexed-types/should_fail/T2664.stderr4
-rw-r--r--testsuite/tests/indexed-types/should_fail/T2693.stderr19
-rw-r--r--testsuite/tests/indexed-types/should_fail/T3330a.stderr9
-rw-r--r--testsuite/tests/indexed-types/should_fail/T3330c.stderr4
-rw-r--r--testsuite/tests/indexed-types/should_fail/T4093a.stderr4
-rw-r--r--testsuite/tests/indexed-types/should_fail/T4093b.stderr4
-rw-r--r--testsuite/tests/indexed-types/should_fail/T4099.stderr6
-rw-r--r--testsuite/tests/indexed-types/should_fail/T4174.stderr4
-rw-r--r--testsuite/tests/indexed-types/should_fail/T4179.stderr14
-rw-r--r--testsuite/tests/indexed-types/should_fail/T4272.stderr11
-rw-r--r--testsuite/tests/indexed-types/should_fail/T5439.stderr10
-rw-r--r--testsuite/tests/indexed-types/should_fail/T5934.stderr5
-rw-r--r--testsuite/tests/indexed-types/should_fail/T6123.stderr3
-rw-r--r--testsuite/tests/indexed-types/should_fail/T7010.stderr7
-rw-r--r--testsuite/tests/indexed-types/should_fail/T7354.stderr7
-rw-r--r--testsuite/tests/indexed-types/should_fail/T7729.stderr7
-rw-r--r--testsuite/tests/indexed-types/should_fail/T7729a.stderr7
-rw-r--r--testsuite/tests/indexed-types/should_fail/T7967.stderr7
-rw-r--r--testsuite/tests/indexed-types/should_fail/T8227.stderr10
-rw-r--r--testsuite/tests/indexed-types/should_fail/T8518.stderr11
-rw-r--r--testsuite/tests/indexed-types/should_fail/T9036.stderr9
-rw-r--r--testsuite/tests/indexed-types/should_fail/T9171.stderr8
-rw-r--r--testsuite/tests/indexed-types/should_fail/T9662.stderr16
-rw-r--r--testsuite/tests/module/mod180.stderr12
-rw-r--r--testsuite/tests/overloadedlists/should_fail/overloadedlistsfail03.stderr4
-rw-r--r--testsuite/tests/overloadedlists/should_fail/overloadedlistsfail05.stderr4
-rw-r--r--testsuite/tests/parser/should_compile/T2245.stderr6
-rw-r--r--testsuite/tests/parser/should_fail/T8501c.stderr2
-rw-r--r--testsuite/tests/parser/should_fail/readFail003.stderr4
-rw-r--r--testsuite/tests/parser/should_fail/readFail032.stderr13
-rw-r--r--testsuite/tests/parser/should_fail/readFail048.stderr13
-rw-r--r--testsuite/tests/partial-sigs/should_compile/DataFamilyInstanceLHS.stderr4
-rw-r--r--testsuite/tests/partial-sigs/should_compile/Defaulting2MROff.stderr6
-rw-r--r--testsuite/tests/partial-sigs/should_compile/Defaulting2MROn.stderr6
-rw-r--r--testsuite/tests/partial-sigs/should_compile/Either.stderr6
-rw-r--r--testsuite/tests/partial-sigs/should_compile/EveryNamed.stderr6
-rw-r--r--testsuite/tests/partial-sigs/should_compile/ExtraConstraints3.stderr8
-rw-r--r--testsuite/tests/partial-sigs/should_compile/SimpleGen.stderr6
-rw-r--r--testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr12
-rw-r--r--testsuite/tests/partial-sigs/should_compile/T10403.stderr20
-rw-r--r--testsuite/tests/partial-sigs/should_compile/T11670.stderr12
-rw-r--r--testsuite/tests/partial-sigs/should_compile/T14643.stderr4
-rw-r--r--testsuite/tests/partial-sigs/should_compile/T16728a.stderr20
-rw-r--r--testsuite/tests/partial-sigs/should_compile/TypeFamilyInstanceLHS.stderr4
-rw-r--r--testsuite/tests/partial-sigs/should_compile/Uncurry.stderr6
-rw-r--r--testsuite/tests/partial-sigs/should_compile/UncurryNamed.stderr6
-rw-r--r--testsuite/tests/partial-sigs/should_compile/WarningWildcardInstantiations.stderr20
-rw-r--r--testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInPatternSplice.stderr8
-rw-r--r--testsuite/tests/partial-sigs/should_fail/NamedExtraConstraintsWildcard.stderr8
-rw-r--r--testsuite/tests/partial-sigs/should_fail/NamedWildcardExplicitForall.stderr4
-rw-r--r--testsuite/tests/partial-sigs/should_fail/NamedWildcardsNotInMonotype.stderr10
-rw-r--r--testsuite/tests/partial-sigs/should_fail/PatBind3.stderr8
-rw-r--r--testsuite/tests/partial-sigs/should_fail/T10615.stderr28
-rw-r--r--testsuite/tests/partial-sigs/should_fail/T14040a.stderr57
-rw-r--r--testsuite/tests/partial-sigs/should_fail/T14584.stderr7
-rw-r--r--testsuite/tests/partial-sigs/should_fail/T14584a.stderr8
-rw-r--r--testsuite/tests/partial-sigs/should_fail/TidyClash.stderr12
-rw-r--r--testsuite/tests/partial-sigs/should_fail/TidyClash2.stderr42
-rw-r--r--testsuite/tests/partial-sigs/should_fail/WildcardInstantiations.stderr14
-rw-r--r--testsuite/tests/partial-sigs/should_fail/WildcardsInPatternAndExprSig.stderr46
-rw-r--r--testsuite/tests/partial-sigs/should_run/T15415.stderr16
-rw-r--r--testsuite/tests/partial-sigs/should_run/T15415.stdout4
-rw-r--r--testsuite/tests/patsyn/should_compile/T17775-singleton.hs18
-rw-r--r--testsuite/tests/patsyn/should_compile/all.T1
-rw-r--r--testsuite/tests/patsyn/should_fail/T11010.stderr4
-rw-r--r--testsuite/tests/patsyn/should_fail/T11039.stderr4
-rw-r--r--testsuite/tests/patsyn/should_fail/T14552.stderr4
-rw-r--r--testsuite/tests/patsyn/should_fail/T15685.stderr10
-rw-r--r--testsuite/tests/patsyn/should_fail/T15695.stderr11
-rw-r--r--testsuite/tests/patsyn/should_fail/mono.stderr4
-rw-r--r--testsuite/tests/perf/compiler/T10547.stderr10
-rw-r--r--testsuite/tests/perf/compiler/T16473.hs2
-rw-r--r--testsuite/tests/polykinds/KindVType.stderr4
-rw-r--r--testsuite/tests/polykinds/T10503.hs7
-rw-r--r--testsuite/tests/polykinds/T10503.stderr17
-rw-r--r--testsuite/tests/polykinds/T11142.stderr17
-rw-r--r--testsuite/tests/polykinds/T12444.stderr4
-rw-r--r--testsuite/tests/polykinds/T12593.stderr9
-rw-r--r--testsuite/tests/polykinds/T14172.stderr10
-rw-r--r--testsuite/tests/polykinds/T14265.stderr18
-rw-r--r--testsuite/tests/polykinds/T14520.stderr1
-rw-r--r--testsuite/tests/polykinds/T14555.stderr3
-rw-r--r--testsuite/tests/polykinds/T14563.stderr3
-rw-r--r--testsuite/tests/polykinds/T14580.stderr3
-rw-r--r--testsuite/tests/polykinds/T14846.stderr36
-rw-r--r--testsuite/tests/polykinds/T15881.stderr2
-rw-r--r--testsuite/tests/polykinds/T16244.stderr2
-rw-r--r--testsuite/tests/polykinds/T16245.stderr2
-rw-r--r--testsuite/tests/polykinds/T17841.stderr3
-rw-r--r--testsuite/tests/polykinds/T17963.stderr9
-rw-r--r--testsuite/tests/polykinds/T7224.stderr6
-rw-r--r--testsuite/tests/polykinds/T7230.stderr4
-rw-r--r--testsuite/tests/polykinds/T7278.stderr5
-rw-r--r--testsuite/tests/polykinds/T7328.stderr2
-rw-r--r--testsuite/tests/polykinds/T7594.stderr4
-rw-r--r--testsuite/tests/polykinds/T7805.stderr10
-rw-r--r--testsuite/tests/polykinds/T8616.stderr15
-rw-r--r--testsuite/tests/polykinds/T9017.stderr10
-rw-r--r--testsuite/tests/polykinds/T9144.stderr4
-rw-r--r--testsuite/tests/polykinds/T9222.hs3
-rw-r--r--testsuite/tests/polykinds/T9222.stderr17
-rw-r--r--testsuite/tests/polykinds/T9569.hs30
-rw-r--r--testsuite/tests/polykinds/all.T4
-rw-r--r--testsuite/tests/quantified-constraints/T15290a.stderr10
-rw-r--r--testsuite/tests/quantified-constraints/T15290b.stderr4
-rw-r--r--testsuite/tests/quantified-constraints/T15918.stderr4
-rw-r--r--testsuite/tests/rebindable/DoParamM.stderr8
-rw-r--r--testsuite/tests/rename/should_fail/T2993.stderr2
-rw-r--r--testsuite/tests/saks/should_fail/saks007_fail.stderr4
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail019.stderr4
-rw-r--r--testsuite/tests/saks/should_fail/saks_fail020.stderr4
-rw-r--r--testsuite/tests/simplCore/should_compile/T17930.stderr2
-rw-r--r--testsuite/tests/simplCore/should_compile/rule2.stderr3
-rw-r--r--testsuite/tests/simplCore/should_compile/simpl017.stderr8
-rw-r--r--testsuite/tests/simplCore/should_compile/spec004.stderr4
-rw-r--r--testsuite/tests/th/T10945.stderr7
-rw-r--r--testsuite/tests/th/T11452.stderr8
-rw-r--r--testsuite/tests/th/T15321.stderr2
-rw-r--r--testsuite/tests/th/T16976.stderr2
-rw-r--r--testsuite/tests/th/T17380.stderr30
-rw-r--r--testsuite/tests/th/T7276.stderr6
-rw-r--r--testsuite/tests/th/T7276a.stdout8
-rw-r--r--testsuite/tests/th/T8577.stderr4
-rw-r--r--testsuite/tests/th/overloaded/TH_overloaded_constraints_fail.stderr4
-rw-r--r--testsuite/tests/typecheck/bug1465/bug1465.stderr14
-rw-r--r--testsuite/tests/typecheck/should_compile/FD3.stderr6
-rw-r--r--testsuite/tests/typecheck/should_compile/T10072.stderr2
-rw-r--r--testsuite/tests/typecheck/should_compile/T10283.hs2
-rw-r--r--testsuite/tests/typecheck/should_compile/T10390.hs2
-rw-r--r--testsuite/tests/typecheck/should_compile/T11254.stderr4
-rw-r--r--testsuite/tests/typecheck/should_compile/T11305.hs3
-rw-r--r--testsuite/tests/typecheck/should_compile/T12082.hs3
-rw-r--r--testsuite/tests/typecheck/should_compile/T12427a.hs1
-rw-r--r--testsuite/tests/typecheck/should_compile/T12427a.stderr15
-rw-r--r--testsuite/tests/typecheck/should_compile/T13381.stderr10
-rw-r--r--testsuite/tests/typecheck/should_compile/T13585a.hs5
-rw-r--r--testsuite/tests/typecheck/should_compile/T13651.stderr6
-rw-r--r--testsuite/tests/typecheck/should_compile/T14488.hs2
-rw-r--r--testsuite/tests/typecheck/should_compile/T15368.stderr7
-rw-r--r--testsuite/tests/typecheck/should_compile/T15370.stderr8
-rw-r--r--testsuite/tests/typecheck/should_compile/T1634.hs2
-rw-r--r--testsuite/tests/typecheck/should_compile/T17007.hs2
-rw-r--r--testsuite/tests/typecheck/should_compile/T17775-view-pats.hs52
-rw-r--r--testsuite/tests/typecheck/should_compile/T17775-viewpats-a.hs35
-rw-r--r--testsuite/tests/typecheck/should_compile/T17775-viewpats-b.hs7
-rw-r--r--testsuite/tests/typecheck/should_compile/T17775-viewpats-b.stderr10
-rw-r--r--testsuite/tests/typecheck/should_compile/T17775-viewpats-c.hs8
-rw-r--r--testsuite/tests/typecheck/should_compile/T17775-viewpats-c.stderr11
-rw-r--r--testsuite/tests/typecheck/should_compile/T17775-viewpats-d.hs7
-rw-r--r--testsuite/tests/typecheck/should_compile/T17775-viewpats-d.stderr12
-rw-r--r--testsuite/tests/typecheck/should_compile/T2494.stderr8
-rw-r--r--testsuite/tests/typecheck/should_compile/T3692.hs5
-rw-r--r--testsuite/tests/typecheck/should_compile/T4284.hs6
-rw-r--r--testsuite/tests/typecheck/should_compile/T7220a.hs4
-rw-r--r--testsuite/tests/typecheck/should_compile/T7220a.stderr14
-rw-r--r--testsuite/tests/typecheck/should_compile/T9569a.hs4
-rw-r--r--testsuite/tests/typecheck/should_compile/T9569a.stderr8
-rw-r--r--testsuite/tests/typecheck/should_compile/T9569b.hs8
-rw-r--r--testsuite/tests/typecheck/should_compile/T9834.hs2
-rw-r--r--testsuite/tests/typecheck/should_compile/T9834.stderr42
-rw-r--r--testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnifySig.hs3
-rw-r--r--testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr88
-rw-r--r--testsuite/tests/typecheck/should_compile/all.T11
-rw-r--r--testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr4
-rw-r--r--testsuite/tests/typecheck/should_compile/tc145.hs2
-rw-r--r--testsuite/tests/typecheck/should_compile/tc160.hs4
-rw-r--r--testsuite/tests/typecheck/should_compile/tc208.hs2
-rw-r--r--testsuite/tests/typecheck/should_compile/tc210.hs6
-rw-r--r--testsuite/tests/typecheck/should_compile/tc211.stderr87
-rw-r--r--testsuite/tests/typecheck/should_compile/twins.hs2
-rw-r--r--testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr6
-rw-r--r--testsuite/tests/typecheck/should_fail/ExpandSynsFail1.stderr21
-rw-r--r--testsuite/tests/typecheck/should_fail/ExpandSynsFail2.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/ExpandSynsFail3.stderr21
-rw-r--r--testsuite/tests/typecheck/should_fail/ExpandSynsFail4.stderr13
-rw-r--r--testsuite/tests/typecheck/should_fail/FrozenErrorTests.stderr9
-rw-r--r--testsuite/tests/typecheck/should_fail/LevPolyBounded.stderr6
-rw-r--r--testsuite/tests/typecheck/should_fail/T10194.stderr6
-rw-r--r--testsuite/tests/typecheck/should_fail/T10619.stderr44
-rw-r--r--testsuite/tests/typecheck/should_fail/T10715b.stderr16
-rw-r--r--testsuite/tests/typecheck/should_fail/T10971d.stderr9
-rw-r--r--testsuite/tests/typecheck/should_fail/T11514.stderr5
-rw-r--r--testsuite/tests/typecheck/should_fail/T11672.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/T12170a.stderr10
-rw-r--r--testsuite/tests/typecheck/should_fail/T12373.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/T12563.stderr5
-rw-r--r--testsuite/tests/typecheck/should_fail/T12589.stderr5
-rw-r--r--testsuite/tests/typecheck/should_fail/T12648.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/T12906.stderr7
-rw-r--r--testsuite/tests/typecheck/should_fail/T12921.stderr2
-rw-r--r--testsuite/tests/typecheck/should_fail/T13292.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/T13311.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/T13320.stderr3
-rw-r--r--testsuite/tests/typecheck/should_fail/T13530.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/T13610.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/T13909.stderr2
-rw-r--r--testsuite/tests/typecheck/should_fail/T14605.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/T14618.stderr10
-rw-r--r--testsuite/tests/typecheck/should_fail/T14884.stderr8
-rw-r--r--testsuite/tests/typecheck/should_fail/T14904a.stderr2
-rw-r--r--testsuite/tests/typecheck/should_fail/T14904b.stderr2
-rw-r--r--testsuite/tests/typecheck/should_fail/T15330.stderr12
-rw-r--r--testsuite/tests/typecheck/should_fail/T15361.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/T15438.hs4
-rw-r--r--testsuite/tests/typecheck/should_fail/T15438.stderr11
-rw-r--r--testsuite/tests/typecheck/should_fail/T15629.stderr42
-rw-r--r--testsuite/tests/typecheck/should_fail/T15648.stderr14
-rw-r--r--testsuite/tests/typecheck/should_fail/T15801.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/T16074.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/T16204c.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/T16517.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/T17077.stderr2
-rw-r--r--testsuite/tests/typecheck/should_fail/T17775.hs15
-rw-r--r--testsuite/tests/typecheck/should_fail/T17775.stderr7
-rw-r--r--testsuite/tests/typecheck/should_fail/T18127a.stderr18
-rw-r--r--testsuite/tests/typecheck/should_fail/T1899.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/T2414.stderr6
-rw-r--r--testsuite/tests/typecheck/should_fail/T2534.stderr12
-rw-r--r--testsuite/tests/typecheck/should_fail/T2714.hs2
-rw-r--r--testsuite/tests/typecheck/should_fail/T2714.stderr17
-rw-r--r--testsuite/tests/typecheck/should_fail/T3102.hs4
-rw-r--r--testsuite/tests/typecheck/should_fail/T3406.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/T3592.stderr12
-rw-r--r--testsuite/tests/typecheck/should_fail/T3613.stderr8
-rw-r--r--testsuite/tests/typecheck/should_fail/T3950.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/T502.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/T5246.stderr17
-rw-r--r--testsuite/tests/typecheck/should_fail/T6001.stderr18
-rw-r--r--testsuite/tests/typecheck/should_fail/T6069.stderr21
-rw-r--r--testsuite/tests/typecheck/should_fail/T7264.stderr7
-rw-r--r--testsuite/tests/typecheck/should_fail/T7368.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/T7368a.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/T7696.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/T7734.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/T7851.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/T7856.stderr20
-rw-r--r--testsuite/tests/typecheck/should_fail/T7869.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/T8030.stderr10
-rw-r--r--testsuite/tests/typecheck/should_fail/T8034.stderr7
-rw-r--r--testsuite/tests/typecheck/should_fail/T8044.stderr16
-rw-r--r--testsuite/tests/typecheck/should_fail/T8142.stderr16
-rw-r--r--testsuite/tests/typecheck/should_fail/T8428.stderr7
-rw-r--r--testsuite/tests/typecheck/should_fail/T8450.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/T8603.stderr7
-rw-r--r--testsuite/tests/typecheck/should_fail/T9201.stderr6
-rw-r--r--testsuite/tests/typecheck/should_fail/T9260.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/T9318.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/T9605.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/T9612.stderr37
-rw-r--r--testsuite/tests/typecheck/should_fail/T9774.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/T9858e.stderr15
-rw-r--r--testsuite/tests/typecheck/should_fail/TcCoercibleFail.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/TcMultiWayIfFail.stderr40
-rw-r--r--testsuite/tests/typecheck/should_fail/UnliftedNewtypesInfinite.stderr7
-rw-r--r--testsuite/tests/typecheck/should_fail/UnliftedNewtypesInstanceFail.stderr8
-rw-r--r--testsuite/tests/typecheck/should_fail/UnliftedNewtypesMismatchedKindRecord.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/VtaFail.hs4
-rw-r--r--testsuite/tests/typecheck/should_fail/VtaFail.stderr33
-rw-r--r--testsuite/tests/typecheck/should_fail/all.T3
-rw-r--r--testsuite/tests/typecheck/should_fail/mc19.stderr10
-rw-r--r--testsuite/tests/typecheck/should_fail/mc21.stderr10
-rw-r--r--testsuite/tests/typecheck/should_fail/mc22.stderr12
-rw-r--r--testsuite/tests/typecheck/should_fail/mc23.stderr7
-rw-r--r--testsuite/tests/typecheck/should_fail/mc24.stderr8
-rw-r--r--testsuite/tests/typecheck/should_fail/mc25.stderr6
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail001.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail002.stderr2
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail004.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail005.stderr3
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail014.stderr2
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail016.stderr7
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail033.stderr2
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail065.stderr7
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail068.stderr16
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail069.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail076.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail103.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail104.stderr11
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail119.stderr10
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail122.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail132.stderr6
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail140.stderr8
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail165.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail168.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail174.stderr15
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail178.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail179.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail182.stderr10
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail186.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail189.stderr7
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail191.stderr10
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail193.stderr10
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail199.stderr11
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail201.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail206.stderr31
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail207.stderr24
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail225.stderr3
-rw-r--r--testsuite/tests/typecheck/should_run/IPRun.hs2
-rw-r--r--testsuite/tests/typecheck/should_run/IPRun.stdout2
-rw-r--r--testsuite/tests/typecheck/should_run/KindInvariant.stderr3
-rw-r--r--testsuite/tests/typecheck/should_run/T13838.stderr5
-rw-r--r--testsuite/tests/typecheck/should_run/T7861.stderr10
-rw-r--r--testsuite/tests/typecheck/should_run/Typeable1.stderr3
-rwxr-xr-xtestsuite/tests/typecheck/should_run/all.T2
-rw-r--r--testsuite/tests/typecheck/should_run/tcrun035.hs6
-rw-r--r--testsuite/tests/typecheck/should_run/tcrun042.hs2
-rw-r--r--testsuite/tests/typecheck/should_run/tcrun042.stderr6
-rw-r--r--testsuite/tests/warnings/should_fail/CaretDiagnostics1.stderr13
m---------utils/haddock0
429 files changed, 3985 insertions, 3323 deletions
diff --git a/compiler/GHC/Builtin/Names.hs b/compiler/GHC/Builtin/Names.hs
index 9eb5061b64..8d7cecafdf 100644
--- a/compiler/GHC/Builtin/Names.hs
+++ b/compiler/GHC/Builtin/Names.hs
@@ -743,8 +743,7 @@ toInteger_RDR = nameRdrName toIntegerName
toRational_RDR = nameRdrName toRationalName
fromIntegral_RDR = nameRdrName fromIntegralName
-stringTy_RDR, fromString_RDR :: RdrName
-stringTy_RDR = tcQual_RDR gHC_BASE (fsLit "String")
+fromString_RDR :: RdrName
fromString_RDR = nameRdrName fromStringName
fromList_RDR, fromListN_RDR, toList_RDR :: RdrName
@@ -1680,11 +1679,13 @@ addrPrimTyConKey, arrayPrimTyConKey, arrayArrayPrimTyConKey, boolTyConKey,
mutableByteArrayPrimTyConKey, orderingTyConKey, mVarPrimTyConKey,
ratioTyConKey, rationalTyConKey, realWorldTyConKey, stablePtrPrimTyConKey,
stablePtrTyConKey, eqTyConKey, heqTyConKey,
- smallArrayPrimTyConKey, smallMutableArrayPrimTyConKey :: Unique
+ smallArrayPrimTyConKey, smallMutableArrayPrimTyConKey,
+ stringTyConKey :: Unique
addrPrimTyConKey = mkPreludeTyConUnique 1
arrayPrimTyConKey = mkPreludeTyConUnique 3
boolTyConKey = mkPreludeTyConUnique 4
byteArrayPrimTyConKey = mkPreludeTyConUnique 5
+stringTyConKey = mkPreludeTyConUnique 6
charPrimTyConKey = mkPreludeTyConUnique 7
charTyConKey = mkPreludeTyConUnique 8
doublePrimTyConKey = mkPreludeTyConUnique 9
diff --git a/compiler/GHC/Builtin/Types.hs b/compiler/GHC/Builtin/Types.hs
index d51f2243ca..eed9420aa6 100644
--- a/compiler/GHC/Builtin/Types.hs
+++ b/compiler/GHC/Builtin/Types.hs
@@ -39,7 +39,7 @@ module GHC.Builtin.Types (
-- * Char
charTyCon, charDataCon, charTyCon_RDR,
- charTy, stringTy, charTyConName,
+ charTy, stringTy, charTyConName, stringTyCon_RDR,
-- * Double
doubleTyCon, doubleDataCon, doubleTy, doubleTyConName,
@@ -221,6 +221,7 @@ wiredInTyCons = [ -- Units are not treated like other tuples, because they
, anyTyCon
, boolTyCon
, charTyCon
+ , stringTyCon
, doubleTyCon
, floatTyCon
, intTyCon
@@ -301,11 +302,12 @@ coercibleTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Coercib
coercibleDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "MkCoercible") coercibleDataConKey coercibleDataCon
coercibleSCSelIdName = mkWiredInIdName gHC_TYPES (fsLit "coercible_sel") coercibleSCSelIdKey coercibleSCSelId
-charTyConName, charDataConName, intTyConName, intDataConName :: Name
-charTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Char") charTyConKey charTyCon
-charDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "C#") charDataConKey charDataCon
-intTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Int") intTyConKey intTyCon
-intDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "I#") intDataConKey intDataCon
+charTyConName, charDataConName, intTyConName, intDataConName, stringTyConName :: Name
+charTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Char") charTyConKey charTyCon
+charDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "C#") charDataConKey charDataCon
+stringTyConName = mkWiredInTyConName UserSyntax gHC_BASE (fsLit "String") stringTyConKey stringTyCon
+intTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Int") intTyConKey intTyCon
+intDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "I#") intDataConKey intDataCon
boolTyConName, falseDataConName, trueDataConName :: Name
boolTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Bool") boolTyConKey boolTyCon
@@ -507,13 +509,14 @@ vecElemDataConNames = zipWith3Lazy mk_special_dc_name
mk_special_dc_name :: FastString -> Unique -> DataCon -> Name
mk_special_dc_name fs u dc = mkWiredInDataConName UserSyntax gHC_TYPES fs u dc
-boolTyCon_RDR, false_RDR, true_RDR, intTyCon_RDR, charTyCon_RDR,
+boolTyCon_RDR, false_RDR, true_RDR, intTyCon_RDR, charTyCon_RDR, stringTyCon_RDR,
intDataCon_RDR, listTyCon_RDR, consDataCon_RDR :: RdrName
boolTyCon_RDR = nameRdrName boolTyConName
false_RDR = nameRdrName falseDataConName
true_RDR = nameRdrName trueDataConName
intTyCon_RDR = nameRdrName intTyConName
charTyCon_RDR = nameRdrName charTyConName
+stringTyCon_RDR = nameRdrName stringTyConName
intDataCon_RDR = nameRdrName intDataConName
listTyCon_RDR = nameRdrName listTyConName
consDataCon_RDR = nameRdrName consDataConName
@@ -1402,7 +1405,15 @@ charDataCon :: DataCon
charDataCon = pcDataCon charDataConName [] [charPrimTy] charTyCon
stringTy :: Type
-stringTy = mkListTy charTy -- convenience only
+stringTy = mkTyConApp stringTyCon []
+
+stringTyCon :: TyCon
+-- We have this wired-in so that Haskell literal strings
+-- get type String (in hsLitType), which in turn influences
+-- inferred types and error messages
+stringTyCon = buildSynTyCon stringTyConName
+ [] liftedTypeKind []
+ (mkListTy charTy)
intTy :: Type
intTy = mkTyConTy intTyCon
diff --git a/compiler/GHC/Core/Coercion.hs b/compiler/GHC/Core/Coercion.hs
index 9aa8ea5e2c..b5e7770ed3 100644
--- a/compiler/GHC/Core/Coercion.hs
+++ b/compiler/GHC/Core/Coercion.hs
@@ -262,6 +262,7 @@ tidyCoAxBndrsForUser :: TidyEnv -> [Var] -> (TidyEnv, [Var])
-- forall a _1 _2. F _1 [a] _2 = ...
--
-- This is a rather disgusting function
+-- See Note [Wildcard names] in GHC.Tc.Gen.HsType
tidyCoAxBndrsForUser init_env tcvs
= (tidy_env, reverse tidy_bndrs)
where
diff --git a/compiler/GHC/Core/Type.hs b/compiler/GHC/Core/Type.hs
index f06ae70a4e..4c9f99a6a7 100644
--- a/compiler/GHC/Core/Type.hs
+++ b/compiler/GHC/Core/Type.hs
@@ -112,7 +112,7 @@ module GHC.Core.Type (
isCoercionTy_maybe, isForAllTy,
isForAllTy_ty, isForAllTy_co,
isPiTy, isTauTy, isFamFreeTy,
- isCoVarType,
+ isCoVarType, isAtomicTy,
isValidJoinPointType,
tyConAppNeedsKindSig,
@@ -812,7 +812,7 @@ mkAppTy ty1 ty2 = AppTy ty1 ty2
-- Here Id is partially applied in the type sig for Foo,
-- but once the type synonyms are expanded all is well
--
- -- Moreover in GHC.Tc.Types.tcInferApps we build up a type
+ -- Moreover in GHC.Tc.Types.tcInferTyApps we build up a type
-- (T t1 t2 t3) one argument at a type, thus forming
-- (T t1), (T t1 t2), etc
@@ -1875,6 +1875,20 @@ isTauTy (ForAllTy {}) = False
isTauTy (CastTy ty _) = isTauTy ty
isTauTy (CoercionTy _) = False -- Not sure about this
+isAtomicTy :: Type -> Bool
+-- True if the type is just a single token, and can be printed compactly
+-- Used when deciding how to lay out type error messages; see the
+-- call in GHC.Tc.Errors
+isAtomicTy (TyVarTy {}) = True
+isAtomicTy (LitTy {}) = True
+isAtomicTy (TyConApp _ []) = True
+
+isAtomicTy ty | isLiftedTypeKind ty = True
+ -- 'Type' prints compactly as *
+ -- See GHC.Iface.Type.ppr_kind_type
+
+isAtomicTy _ = False
+
{-
%************************************************************************
%* *
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index 960b7d9c51..4c86f17ac1 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -1434,7 +1434,7 @@ hscGenHardCode hsc_env cgguts location output_filename = do
------------------ Code output -----------------------
rawcmms0 <- {-# SCC "cmmToRawCmm" #-}
- lookupHook cmmToRawCmmHook
+ lookupHook (\x -> cmmToRawCmmHook x)
(\dflg _ -> cmmToRawCmm dflg) dflags dflags (Just this_mod) cmms
let dump a = do
@@ -1506,7 +1506,7 @@ hscCompileCmmFile hsc_env filename output_filename = runHsc hsc_env $ do
unless (null cmmgroup) $
dumpIfSet_dyn dflags Opt_D_dump_cmm "Output Cmm"
FormatCMM (ppr cmmgroup)
- rawCmms <- lookupHook cmmToRawCmmHook
+ rawCmms <- lookupHook (\x -> cmmToRawCmmHook x)
(\dflgs _ -> cmmToRawCmm dflgs) dflags dflags Nothing (Stream.yield cmmgroup)
_ <- codeOutput dflags cmm_mod output_filename no_loc NoStubs [] []
rawCmms
diff --git a/compiler/GHC/Hs/Binds.hs b/compiler/GHC/Hs/Binds.hs
index 0f4a16c98e..25bcae6ce6 100644
--- a/compiler/GHC/Hs/Binds.hs
+++ b/compiler/GHC/Hs/Binds.hs
@@ -738,8 +738,9 @@ ppr_monobind (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dictvars
= sdocOption sdocPrintTypecheckerElaboration $ \case
False -> pprLHsBinds val_binds
True -> -- Show extra information (bug number: #10662)
- hang (text "AbsBinds" <+> brackets (interpp'SP tyvars)
- <+> brackets (interpp'SP dictvars))
+ hang (text "AbsBinds"
+ <+> sep [ brackets (interpp'SP tyvars)
+ , brackets (interpp'SP dictvars) ])
2 $ braces $ vcat
[ text "Exports:" <+>
brackets (sep (punctuate comma (map ppr exports)))
@@ -751,7 +752,7 @@ ppr_monobind (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dictvars
instance OutputableBndrId p => Outputable (ABExport (GhcPass p)) where
ppr (ABE { abe_wrap = wrap, abe_poly = gbl, abe_mono = lcl, abe_prags = prags })
- = vcat [ ppr gbl <+> text "<=" <+> ppr lcl
+ = vcat [ sep [ ppr gbl, nest 2 (text "<=" <+> ppr lcl) ]
, nest 2 (pprTcSpecPrags prags)
, pprIfTc @p $ nest 2 (text "wrap:" <+> ppr wrap) ]
diff --git a/compiler/GHC/Hs/Type.hs b/compiler/GHC/Hs/Type.hs
index 43e131ce0c..8dfc317cd9 100644
--- a/compiler/GHC/Hs/Type.hs
+++ b/compiler/GHC/Hs/Type.hs
@@ -213,8 +213,8 @@ A wildcard in a type can be
* An anonymous wildcard,
written '_'
In HsType this is represented by HsWildCardTy.
- The renamer leaves it untouched, and it is later given fresh meta tyvars in
- the typechecker.
+ The renamer leaves it untouched, and it is later given a fresh
+ meta tyvar in the typechecker.
* A named wildcard,
written '_a', '_foo', etc
@@ -597,6 +597,7 @@ data HsTyVarBndr flag pass
flag
(Located (IdP pass))
-- See Note [Located RdrNames] in GHC.Hs.Expr
+
| KindedTyVar
(XKindedTyVar pass)
flag
diff --git a/compiler/GHC/HsToCore/Binds.hs b/compiler/GHC/HsToCore/Binds.hs
index e24eb50d51..4c30aed8ff 100644
--- a/compiler/GHC/HsToCore/Binds.hs
+++ b/compiler/GHC/HsToCore/Binds.hs
@@ -160,6 +160,7 @@ dsHsBind dflags b@(FunBind { fun_id = L loc fun
matchWrapper
(mkPrefixFunRhs (L loc (idName fun)))
Nothing matches
+
; core_wrap <- dsHsWrapper co_fn
; let body' = mkOptTickBox tick body
rhs = core_wrap (mkLams args body')
@@ -197,7 +198,11 @@ dsHsBind dflags (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dicts
, abs_exports = exports
, abs_ev_binds = ev_binds
, abs_binds = binds, abs_sig = has_sig })
- = do { ds_binds <- addTyCsDs FromSource (listToBag dicts) (dsLHsBinds binds)
+ = do { ds_binds <- addTyCsDs FromSource (listToBag dicts) $
+ dsLHsBinds binds
+ -- addTyCsDs: push type constraints deeper
+ -- for inner pattern match check
+ -- See Check, Note [Type and Term Equality Propagation]
; ds_ev_binds <- dsTcEvBinds_s ev_binds
diff --git a/compiler/GHC/HsToCore/PmCheck.hs b/compiler/GHC/HsToCore/PmCheck.hs
index f9de7c8282..ef56c35845 100644
--- a/compiler/GHC/HsToCore/PmCheck.hs
+++ b/compiler/GHC/HsToCore/PmCheck.hs
@@ -27,7 +27,7 @@ import GHC.Prelude
import GHC.HsToCore.PmCheck.Types
import GHC.HsToCore.PmCheck.Oracle
import GHC.HsToCore.PmCheck.Ppr
-import GHC.Types.Basic (Origin, isGenerated)
+import GHC.Types.Basic (Origin(..), isGenerated)
import GHC.Core (CoreExpr, Expr(Var,App))
import GHC.Data.FastString (unpackFS, lengthFS)
import GHC.Driver.Session
diff --git a/compiler/GHC/Iface/Load.hs b/compiler/GHC/Iface/Load.hs
index ef69e97605..f21dc1e7a1 100644
--- a/compiler/GHC/Iface/Load.hs
+++ b/compiler/GHC/Iface/Load.hs
@@ -529,7 +529,7 @@ loadInterface doc_str mod from
; -- invoke plugins with *full* interface, not final_iface, to ensure
-- that plugins have access to declarations, etc.
- res <- withPlugins dflags interfaceLoadAction iface
+ res <- withPlugins dflags (\p -> interfaceLoadAction p) iface
; return (Succeeded res)
}}}}
diff --git a/compiler/GHC/Rename/Splice.hs b/compiler/GHC/Rename/Splice.hs
index 78d943bed8..eaee84119b 100644
--- a/compiler/GHC/Rename/Splice.hs
+++ b/compiler/GHC/Rename/Splice.hs
@@ -48,7 +48,7 @@ import GHC.Driver.Hooks
import GHC.Builtin.Names.TH ( quoteExpName, quotePatName, quoteDecName, quoteTypeName
, decsQTyConName, expQTyConName, patQTyConName, typeQTyConName, )
-import {-# SOURCE #-} GHC.Tc.Gen.Expr ( tcCheckExpr )
+import {-# SOURCE #-} GHC.Tc.Gen.Expr ( tcCheckPolyExpr )
import {-# SOURCE #-} GHC.Tc.Gen.Splice
( runMetaD
, runMetaE
@@ -324,7 +324,7 @@ runRnSplice flavour run_meta ppr_res splice
; meta_exp_ty <- tcMetaTy meta_ty_name
; zonked_q_expr <- zonkTopLExpr =<<
tcTopSpliceExpr Untyped
- (tcCheckExpr the_expr meta_exp_ty)
+ (tcCheckPolyExpr the_expr meta_exp_ty)
-- Run the expression
; mod_finalizers_ref <- newTcRef []
diff --git a/compiler/GHC/Tc/Errors.hs b/compiler/GHC/Tc/Errors.hs
index e2a7f5f251..41bc8cd269 100644
--- a/compiler/GHC/Tc/Errors.hs
+++ b/compiler/GHC/Tc/Errors.hs
@@ -221,6 +221,7 @@ report_unsolved type_errors expr_holes
, text "Wanted:" <+> ppr wanted ]
; warn_redundant <- woptM Opt_WarnRedundantConstraints
+ ; exp_syns <- goptM Opt_PrintExpandedSynonyms
; let err_ctxt = CEC { cec_encl = []
, cec_tidy = tidy_env
, cec_defer_type_errors = type_errors
@@ -234,6 +235,7 @@ report_unsolved type_errors expr_holes
-- See #15539 and c.f. setting ic_status
-- in GHC.Tc.Solver.setImplicationStatus
, cec_warn_redundant = warn_redundant
+ , cec_expand_syns = exp_syns
, cec_binds = binds_var }
; tc_lvl <- getTcLevel
@@ -337,6 +339,7 @@ data ReportErrCtxt
, cec_out_of_scope_holes :: HoleChoice -- Out of scope holes
, cec_warn_redundant :: Bool -- True <=> -Wredundant-constraints
+ , cec_expand_syns :: Bool -- True <=> -fprint-expanded-synonyms
, cec_suppress :: Bool -- True <=> More important errors have occurred,
-- so create bindings if need be, but
@@ -351,6 +354,7 @@ instance Outputable ReportErrCtxt where
, cec_type_holes = th
, cec_out_of_scope_holes = osh
, cec_warn_redundant = wr
+ , cec_expand_syns = es
, cec_suppress = sup })
= text "CEC" <+> braces (vcat
[ text "cec_binds" <+> equals <+> ppr bvar
@@ -359,6 +363,7 @@ instance Outputable ReportErrCtxt where
, text "cec_type_holes" <+> equals <+> ppr th
, text "cec_out_of_scope_holes" <+> equals <+> ppr osh
, text "cec_warn_redundant" <+> equals <+> ppr wr
+ , text "cec_expand_syns" <+> equals <+> ppr es
, text "cec_suppress" <+> equals <+> ppr sup ])
-- | Returns True <=> the ReportErrCtxt indicates that something is deferred
@@ -403,7 +408,7 @@ previously suppressed. (e.g. partial-sigs/should_fail/T14584)
-}
reportImplic :: ReportErrCtxt -> Implication -> TcM ()
-reportImplic ctxt implic@(Implic { ic_skols = tvs, ic_telescope = m_telescope
+reportImplic ctxt implic@(Implic { ic_skols = tvs
, ic_given = given
, ic_wanted = wanted, ic_binds = evb
, ic_status = status, ic_info = info
@@ -417,10 +422,12 @@ reportImplic ctxt implic@(Implic { ic_skols = tvs, ic_telescope = m_telescope
| otherwise
= do { traceTc "reportImplic" (ppr implic')
+ ; when bad_telescope $ reportBadTelescope ctxt tcl_env info tvs
+ -- Do /not/ use the tidied tvs because then are in the
+ -- wrong order, so tidying will rename things wrongly
; reportWanteds ctxt' tc_lvl wanted
; when (cec_warn_redundant ctxt) $
- warnRedundantConstraints ctxt' tcl_env info' dead_givens
- ; when bad_telescope $ reportBadTelescope ctxt tcl_env m_telescope tvs }
+ warnRedundantConstraints ctxt' tcl_env info' dead_givens }
where
tcl_env = ic_env implic
insoluble = isInsolubleStatus status
@@ -492,8 +499,8 @@ warnRedundantConstraints ctxt env info ev_vars
improving pred -- (transSuperClasses p) does not include p
= any isImprovementPred (pred : transSuperClasses pred)
-reportBadTelescope :: ReportErrCtxt -> TcLclEnv -> Maybe SDoc -> [TcTyVar] -> TcM ()
-reportBadTelescope ctxt env (Just telescope) skols
+reportBadTelescope :: ReportErrCtxt -> TcLclEnv -> SkolemInfo -> [TcTyVar] -> TcM ()
+reportBadTelescope ctxt env (ForAllSkol _ telescope) skols
= do { msg <- mkErrorReport ctxt env (important doc)
; reportError msg }
where
@@ -503,8 +510,8 @@ reportBadTelescope ctxt env (Just telescope) skols
sorted_tvs = scopedSort skols
-reportBadTelescope _ _ Nothing skols
- = pprPanic "reportBadTelescope" (ppr skols)
+reportBadTelescope _ _ skol_info skols
+ = pprPanic "reportBadTelescope" (ppr skol_info $$ ppr skols)
{- Note [Redundant constraints in instance decls]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -752,8 +759,7 @@ mkGivenErrorReporter ctxt cts
report = important inaccessible_msg `mappend`
mk_relevant_bindings binds_msg
- ; err <- mkEqErr_help dflags ctxt report ct'
- Nothing ty1 ty2
+ ; err <- mkEqErr_help dflags ctxt report ct' ty1 ty2
; traceTc "mkGivenErrorReporter" (ppr ct)
; reportWarning (Reason Opt_WarnInaccessibleCode) err }
@@ -1126,7 +1132,7 @@ mkIrredErr ctxt cts
; let orig = ctOrigin ct1
msg = couldNotDeduce (getUserGivens ctxt) (map ctPred cts, orig)
; mkErrorMsgFromCt ctxt ct1 $
- important msg `mappend` mk_relevant_bindings binds_msg }
+ msg `mappend` mk_relevant_bindings binds_msg }
where
(ct1:_) = cts
@@ -1276,14 +1282,14 @@ mkIPErr ctxt cts
preds = map ctPred cts
givens = getUserGivens ctxt
msg | null givens
- = addArising orig $
+ = important $ addArising orig $
sep [ text "Unbound implicit parameter" <> plural cts
, nest 2 (pprParendTheta preds) ]
| otherwise
= couldNotDeduce givens (preds, orig)
; mkErrorMsgFromCt ctxt ct1 $
- important msg `mappend` mk_relevant_bindings binds_msg }
+ msg `mappend` mk_relevant_bindings binds_msg }
where
(ct1:_) = cts
@@ -1356,56 +1362,17 @@ mkEqErr1 ctxt ct -- Wanted or derived;
= do { (ctxt, binds_msg, ct) <- relevantBindings True ctxt ct
; rdr_env <- getGlobalRdrEnv
; fam_envs <- tcGetFamInstEnvs
- ; exp_syns <- goptM Opt_PrintExpandedSynonyms
- ; let (keep_going, is_oriented, wanted_msg)
- = mk_wanted_extra (ctLoc ct) exp_syns
- coercible_msg = case ctEqRel ct of
+ ; let coercible_msg = case ctEqRel ct of
NomEq -> empty
ReprEq -> mkCoercibleExplanation rdr_env fam_envs ty1 ty2
; dflags <- getDynFlags
- ; traceTc "mkEqErr1" (ppr ct $$ pprCtOrigin (ctOrigin ct) $$ ppr keep_going)
- ; let report = mconcat [important wanted_msg, important coercible_msg,
- mk_relevant_bindings binds_msg]
- ; if keep_going
- then mkEqErr_help dflags ctxt report ct is_oriented ty1 ty2
- else mkErrorMsgFromCt ctxt ct report }
+ ; traceTc "mkEqErr1" (ppr ct $$ pprCtOrigin (ctOrigin ct))
+ ; let report = mconcat [ important coercible_msg
+ , mk_relevant_bindings binds_msg]
+ ; mkEqErr_help dflags ctxt report ct ty1 ty2 }
where
(ty1, ty2) = getEqPredTys (ctPred ct)
- -- If the types in the error message are the same as the types
- -- we are unifying, don't add the extra expected/actual message
- mk_wanted_extra :: CtLoc -> Bool -> (Bool, Maybe SwapFlag, SDoc)
- mk_wanted_extra loc expandSyns
- = case ctLocOrigin loc of
- orig@TypeEqOrigin {} -> mkExpectedActualMsg ty1 ty2 orig
- t_or_k expandSyns
- where
- t_or_k = ctLocTypeOrKind_maybe loc
-
- KindEqOrigin cty1 mb_cty2 sub_o sub_t_or_k
- -> (True, Nothing, msg1 $$ msg2)
- where
- sub_what = case sub_t_or_k of Just KindLevel -> text "kinds"
- _ -> text "types"
- msg1 = sdocOption sdocPrintExplicitCoercions $ \printExplicitCoercions ->
- case mb_cty2 of
- Just cty2
- | printExplicitCoercions
- || not (cty1 `pickyEqType` cty2)
- -> hang (text "When matching" <+> sub_what)
- 2 (vcat [ ppr cty1 <+> dcolon <+>
- ppr (tcTypeKind cty1)
- , ppr cty2 <+> dcolon <+>
- ppr (tcTypeKind cty2) ])
- _ -> text "When matching the kind of" <+> quotes (ppr cty1)
- msg2 = case sub_o of
- TypeEqOrigin {}
- | Just cty2 <- mb_cty2 ->
- thdOf3 (mkExpectedActualMsg cty1 cty2 sub_o sub_t_or_k
- expandSyns)
- _ -> empty
- _ -> (True, Nothing, empty)
-
-- | This function tries to reconstruct why a "Coercible ty1 ty2" constraint
-- is left over.
mkCoercibleExplanation :: GlobalRdrEnv -> FamInstEnvs
@@ -1453,76 +1420,43 @@ mkCoercibleExplanation rdr_env fam_envs ty1 ty2
| otherwise
= False
-{-
--- | Make a listing of role signatures for all the parameterised tycons
--- used in the provided types
-
-
--- SLPJ Jun 15: I could not convince myself that these hints were really
--- useful. Maybe they are, but I think we need more work to make them
--- actually helpful.
-mkRoleSigs :: Type -> Type -> SDoc
-mkRoleSigs ty1 ty2
- = ppUnless (null role_sigs) $
- hang (text "Relevant role signatures:")
- 2 (vcat role_sigs)
- where
- tcs = nameEnvElts $ tyConsOfType ty1 `plusNameEnv` tyConsOfType ty2
- role_sigs = mapMaybe ppr_role_sig tcs
-
- ppr_role_sig tc
- | null roles -- if there are no parameters, don't bother printing
- = Nothing
- | isBuiltInSyntax (tyConName tc) -- don't print roles for (->), etc.
- = Nothing
- | otherwise
- = Just $ hsep $ [text "type role", ppr tc] ++ map ppr roles
- where
- roles = tyConRoles tc
--}
-
mkEqErr_help :: DynFlags -> ReportErrCtxt -> Report
-> Ct
- -> Maybe SwapFlag -- Nothing <=> not sure
-> TcType -> TcType -> TcM ErrMsg
-mkEqErr_help dflags ctxt report ct oriented ty1 ty2
+mkEqErr_help dflags ctxt report ct ty1 ty2
| Just (tv1, _) <- tcGetCastedTyVar_maybe ty1
- = mkTyVarEqErr dflags ctxt report ct oriented tv1 ty2
+ = mkTyVarEqErr dflags ctxt report ct tv1 ty2
| Just (tv2, _) <- tcGetCastedTyVar_maybe ty2
- = mkTyVarEqErr dflags ctxt report ct swapped tv2 ty1
+ = mkTyVarEqErr dflags ctxt report ct tv2 ty1
| otherwise
- = reportEqErr ctxt report ct oriented ty1 ty2
- where
- swapped = fmap flipSwap oriented
+ = reportEqErr ctxt report ct ty1 ty2
reportEqErr :: ReportErrCtxt -> Report
-> Ct
- -> Maybe SwapFlag -- Nothing <=> not sure
-> TcType -> TcType -> TcM ErrMsg
-reportEqErr ctxt report ct oriented ty1 ty2
+reportEqErr ctxt report ct ty1 ty2
= mkErrorMsgFromCt ctxt ct (mconcat [misMatch, report, eqInfo])
- where misMatch = important $ misMatchOrCND ctxt ct oriented ty1 ty2
- eqInfo = important $ mkEqInfoMsg ct ty1 ty2
+ where
+ misMatch = misMatchOrCND False ctxt ct ty1 ty2
+ eqInfo = mkEqInfoMsg ct ty1 ty2
mkTyVarEqErr, mkTyVarEqErr'
:: DynFlags -> ReportErrCtxt -> Report -> Ct
- -> Maybe SwapFlag -> TcTyVar -> TcType -> TcM ErrMsg
+ -> TcTyVar -> TcType -> TcM ErrMsg
-- tv1 and ty2 are already tidied
-mkTyVarEqErr dflags ctxt report ct oriented tv1 ty2
+mkTyVarEqErr dflags ctxt report ct tv1 ty2
= do { traceTc "mkTyVarEqErr" (ppr ct $$ ppr tv1 $$ ppr ty2)
- ; mkTyVarEqErr' dflags ctxt report ct oriented tv1 ty2 }
+ ; mkTyVarEqErr' dflags ctxt report ct tv1 ty2 }
-mkTyVarEqErr' dflags ctxt report ct oriented tv1 ty2
- | not insoluble_occurs_check -- See Note [Occurs check wins]
- , isUserSkolem ctxt tv1 -- ty2 won't be a meta-tyvar, or else the thing would
- -- be oriented the other way round;
- -- see GHC.Tc.Solver.Canonical.canEqTyVarTyVar
+mkTyVarEqErr' dflags ctxt report ct tv1 ty2
+ | isUserSkolem ctxt tv1 -- ty2 won't be a meta-tyvar; we would have
+ -- swapped in Solver.Canonical.canEqTyVarHomo
|| isTyVarTyVar tv1 && not (isTyVarTy ty2)
|| ctEqRel ct == ReprEq
- -- the cases below don't really apply to ReprEq (except occurs check)
+ -- The cases below don't really apply to ReprEq (except occurs check)
= mkErrorMsgFromCt ctxt ct $ mconcat
- [ important $ misMatchOrCND ctxt ct oriented ty1 ty2
- , important $ extraTyVarEqInfo ctxt tv1 ty2
+ [ headline_msg
+ , extraTyVarEqInfo ctxt tv1 ty2
, report
]
@@ -1531,11 +1465,7 @@ mkTyVarEqErr' dflags ctxt report ct oriented tv1 ty2
-- function; it's not insoluble (because in principle F could reduce)
-- but we have certainly been unable to solve it
-- See Note [Occurs check error] in GHC.Tc.Solver.Canonical
- = do { let main_msg = addArising (ctOrigin ct) $
- hang (text "Occurs check: cannot construct the infinite" <+> what <> colon)
- 2 (sep [ppr ty1, char '~', ppr ty2])
-
- extra2 = important $ mkEqInfoMsg ct ty1 ty2
+ = do { let extra2 = mkEqInfoMsg ct ty1 ty2
interesting_tyvars = filter (not . noFreeVarsOfType . tyVarKind) $
filter isTyVar $
@@ -1549,17 +1479,16 @@ mkTyVarEqErr' dflags ctxt report ct oriented tv1 ty2
tyvar_binding tv = ppr tv <+> dcolon <+> ppr (tyVarKind tv)
; mkErrorMsgFromCt ctxt ct $
- mconcat [important main_msg, extra2, extra3, report] }
+ mconcat [headline_msg, extra2, extra3, report] }
| MTVU_Bad <- occ_check_expand
= do { let msg = vcat [ text "Cannot instantiate unification variable"
<+> quotes (ppr tv1)
- , hang (text "with a" <+> what <+> text "involving polytypes:") 2 (ppr ty2)
- , nest 2 (text "GHC doesn't yet support impredicative polymorphism") ]
+ , hang (text "with a" <+> what <+> text "involving polytypes:") 2 (ppr ty2) ]
-- Unlike the other reports, this discards the old 'report_important'
-- instead of augmenting it. This is because the details are not likely
-- to be helpful since this is just an unimplemented feature.
- ; mkErrorMsgFromCt ctxt ct $ report { report_important = [msg] } }
+ ; mkErrorMsgFromCt ctxt ct $ mconcat [ headline_msg, important msg, report ] }
-- If the immediately-enclosing implication has 'tv' a skolem, and
-- we know by now its an InferSkol kind of skolem, then presumably
@@ -1569,8 +1498,8 @@ mkTyVarEqErr' dflags ctxt report ct oriented tv1 ty2
, Implic { ic_skols = skols } <- implic
, tv1 `elem` skols
= mkErrorMsgFromCt ctxt ct $ mconcat
- [ important $ misMatchMsg ct oriented ty1 ty2
- , important $ extraTyVarEqInfo ctxt tv1 ty2
+ [ misMatchMsg ctxt ct ty1 ty2
+ , extraTyVarEqInfo ctxt tv1 ty2
, report
]
@@ -1579,7 +1508,7 @@ mkTyVarEqErr' dflags ctxt report ct oriented tv1 ty2
, Implic { ic_skols = skols, ic_info = skol_info } <- implic
, let esc_skols = filter (`elemVarSet` (tyCoVarsOfType ty2)) skols
, not (null esc_skols)
- = do { let msg = important $ misMatchMsg ct oriented ty1 ty2
+ = do { let msg = misMatchMsg ctxt ct ty1 ty2
esc_doc = sep [ text "because" <+> what <+> text "variable" <> plural esc_skols
<+> pprQuotedList esc_skols
, text "would escape" <+>
@@ -1607,7 +1536,7 @@ mkTyVarEqErr' dflags ctxt report ct oriented tv1 ty2
, Implic { ic_given = given, ic_tclvl = lvl, ic_info = skol_info } <- implic
= ASSERT2( not (isTouchableMetaTyVar lvl tv1)
, ppr tv1 $$ ppr lvl ) -- See Note [Error messages for untouchables]
- do { let msg = important $ misMatchMsg ct oriented ty1 ty2
+ do { let msg = misMatchMsg ctxt ct ty1 ty2
tclvl_extra = important $
nest 2 $
sep [ quotes (ppr tv1) <+> text "is untouchable"
@@ -1615,33 +1544,38 @@ mkTyVarEqErr' dflags ctxt report ct oriented tv1 ty2
, nest 2 $ text "bound by" <+> ppr skol_info
, nest 2 $ text "at" <+>
ppr (tcl_loc (ic_env implic)) ]
- tv_extra = important $ extraTyVarEqInfo ctxt tv1 ty2
- add_sig = important $ suggestAddSig ctxt ty1 ty2
+ tv_extra = extraTyVarEqInfo ctxt tv1 ty2
+ add_sig = suggestAddSig ctxt ty1 ty2
; mkErrorMsgFromCt ctxt ct $ mconcat
[msg, tclvl_extra, tv_extra, add_sig, report] }
| otherwise
- = reportEqErr ctxt report ct oriented (mkTyVarTy tv1) ty2
+ = reportEqErr ctxt report ct (mkTyVarTy tv1) ty2
-- This *can* happen (#6123, and test T2627b)
-- Consider an ambiguous top-level constraint (a ~ F a)
-- Not an occurs check, because F is a type function.
where
+ headline_msg = misMatchOrCND insoluble_occurs_check ctxt ct ty1 ty2
+
ty1 = mkTyVarTy tv1
occ_check_expand = occCheckForErrors dflags tv1 ty2
insoluble_occurs_check = isInsolubleOccursCheck (ctEqRel ct) tv1 ty2
- what = case ctLocTypeOrKind_maybe (ctLoc ct) of
- Just KindLevel -> text "kind"
- _ -> text "type"
+ what = text $ levelString $
+ ctLocTypeOrKind_maybe (ctLoc ct) `orElse` TypeLevel
-mkEqInfoMsg :: Ct -> TcType -> TcType -> SDoc
+levelString :: TypeOrKind -> String
+levelString TypeLevel = "type"
+levelString KindLevel = "kind"
+
+mkEqInfoMsg :: Ct -> TcType -> TcType -> Report
-- Report (a) ambiguity if either side is a type function application
-- e.g. F a0 ~ Int
-- (b) warning about injectivity if both sides are the same
-- type function application F a ~ F b
-- See Note [Non-injective type functions]
mkEqInfoMsg ct ty1 ty2
- = tyfun_msg $$ ambig_msg
+ = important (tyfun_msg $$ ambig_msg)
where
mb_fun1 = isTyFun_maybe ty1
mb_fun2 = isTyFun_maybe ty2
@@ -1669,29 +1603,34 @@ isUserSkolem ctxt tv
is_user_skol_info (InferSkol {}) = False
is_user_skol_info _ = True
-misMatchOrCND :: ReportErrCtxt -> Ct
- -> Maybe SwapFlag -> TcType -> TcType -> SDoc
+misMatchOrCND :: Bool -> ReportErrCtxt -> Ct
+ -> TcType -> TcType -> Report
-- If oriented then ty1 is actual, ty2 is expected
-misMatchOrCND ctxt ct oriented ty1 ty2
- | null givens ||
- (isRigidTy ty1 && isRigidTy ty2) ||
- isGivenCt ct
- -- If the equality is unconditionally insoluble
- -- or there is no context, don't report the context
- = misMatchMsg ct oriented ty1 ty2
+misMatchOrCND insoluble_occurs_check ctxt ct ty1 ty2
+ | insoluble_occurs_check -- See Note [Insoluble occurs check]
+ || (isRigidTy ty1 && isRigidTy ty2)
+ || isGivenCt ct
+ || null givens
+ = -- If the equality is unconditionally insoluble
+ -- or there is no context, don't report the context
+ misMatchMsg ctxt ct ty1 ty2
+
| otherwise
- = couldNotDeduce givens ([eq_pred], orig)
+ = mconcat [ couldNotDeduce givens ([eq_pred], orig)
+ , important $ mk_supplementary_ea_msg ctxt level ty1 ty2 orig ]
where
ev = ctEvidence ct
eq_pred = ctEvPred ev
orig = ctEvOrigin ev
+ level = ctLocTypeOrKind_maybe (ctEvLoc ev) `orElse` TypeLevel
givens = [ given | given <- getUserGivens ctxt, not (ic_no_eqs given)]
-- Keep only UserGivens that have some equalities.
-- See Note [Suppress redundant givens during error reporting]
-couldNotDeduce :: [UserGiven] -> (ThetaType, CtOrigin) -> SDoc
+couldNotDeduce :: [UserGiven] -> (ThetaType, CtOrigin) -> Report
couldNotDeduce givens (wanteds, orig)
- = vcat [ addArising orig (text "Could not deduce:" <+> pprTheta wanteds)
+ = important $
+ vcat [ addArising orig (text "Could not deduce:" <+> pprTheta wanteds)
, vcat (pp_givens givens)]
pp_givens :: [UserGiven] -> [SDoc]
@@ -1763,11 +1702,11 @@ addition to superclasses (see Note [Remove redundant provided dicts]
in GHC.Tc.TyCl.PatSyn).
-}
-extraTyVarEqInfo :: ReportErrCtxt -> TcTyVar -> TcType -> SDoc
+extraTyVarEqInfo :: ReportErrCtxt -> TcTyVar -> TcType -> Report
-- Add on extra info about skolem constants
-- NB: The types themselves are already tidied
extraTyVarEqInfo ctxt tv1 ty2
- = extraTyVarInfo ctxt tv1 $$ ty_extra ty2
+ = important (extraTyVarInfo ctxt tv1 $$ ty_extra ty2)
where
ty_extra ty = case tcGetCastedTyVar_maybe ty of
Just (tv, _) -> extraTyVarInfo ctxt tv
@@ -1781,15 +1720,15 @@ extraTyVarInfo ctxt tv
RuntimeUnk {} -> quotes (ppr tv) <+> text "is an interactive-debugger skolem"
MetaTv {} -> empty
-suggestAddSig :: ReportErrCtxt -> TcType -> TcType -> SDoc
+suggestAddSig :: ReportErrCtxt -> TcType -> TcType -> Report
-- See Note [Suggest adding a type signature]
suggestAddSig ctxt ty1 ty2
| null inferred_bndrs
- = empty
+ = mempty
| [bndr] <- inferred_bndrs
- = text "Possible fix: add a type signature for" <+> quotes (ppr bndr)
+ = important $ text "Possible fix: add a type signature for" <+> quotes (ppr bndr)
| otherwise
- = text "Possible fix: add type signatures for some or all of" <+> (ppr inferred_bndrs)
+ = important $ text "Possible fix: add type signatures for some or all of" <+> (ppr inferred_bndrs)
where
inferred_bndrs = nub (get_inf ty1 ++ get_inf ty2)
get_inf ty | Just tv <- tcGetTyVar_maybe ty
@@ -1800,47 +1739,55 @@ suggestAddSig ctxt ty1 ty2
= []
--------------------
-misMatchMsg :: Ct -> Maybe SwapFlag -> TcType -> TcType -> SDoc
+misMatchMsg :: ReportErrCtxt -> Ct -> TcType -> TcType -> Report
-- Types are already tidy
-- If oriented then ty1 is actual, ty2 is expected
-misMatchMsg ct oriented ty1 ty2
- | Just NotSwapped <- oriented
- = misMatchMsg ct (Just IsSwapped) ty2 ty1
-
- -- These next two cases are when we're about to report, e.g., that
- -- 'LiftedRep doesn't match 'VoidRep. Much better just to say
- -- lifted vs. unlifted
- | isLiftedRuntimeRep ty1
- = lifted_vs_unlifted
-
- | isLiftedRuntimeRep ty2
- = lifted_vs_unlifted
-
- | otherwise -- So now we have Nothing or (Just IsSwapped)
- -- For some reason we treat Nothing like IsSwapped
- = addArising orig $
- pprWithExplicitKindsWhenMismatch ty1 ty2 (ctOrigin ct) $
+misMatchMsg ctxt ct ty1 ty2
+ = important $
+ addArising orig $
+ pprWithExplicitKindsWhenMismatch ty1 ty2 orig $
+ sep [ case orig of
+ TypeEqOrigin {} -> tk_eq_msg ctxt ct ty1 ty2 orig
+ KindEqOrigin {} -> tk_eq_msg ctxt ct ty1 ty2 orig
+ _ -> headline_eq_msg False ct ty1 ty2
+ , sameOccExtra ty2 ty1 ]
+ where
+ orig = ctOrigin ct
+
+headline_eq_msg :: Bool -> Ct -> Type -> Type -> SDoc
+-- Generates the main "Could't match 't1' against 't2'
+-- headline message
+headline_eq_msg add_ea ct ty1 ty2
+
+ | (isLiftedRuntimeRep ty1 && isUnliftedRuntimeRep ty2) ||
+ (isLiftedRuntimeRep ty2 && isUnliftedRuntimeRep ty1)
+ = text "Couldn't match a lifted type with an unlifted type"
+
+ | isAtomicTy ty1 || isAtomicTy ty2
+ = -- Print with quotes
sep [ text herald1 <+> quotes (ppr ty1)
, nest padding $
- text herald2 <+> quotes (ppr ty2)
- , sameOccExtra ty2 ty1 ]
+ text herald2 <+> quotes (ppr ty2) ]
+
+ | otherwise
+ = -- Print with vertical layout
+ vcat [ text herald1 <> colon <+> ppr ty1
+ , nest padding $
+ text herald2 <> colon <+> ppr ty2 ]
where
herald1 = conc [ "Couldn't match"
- , if is_repr then "representation of" else ""
- , if is_oriented then "expected" else ""
+ , if is_repr then "representation of" else ""
+ , if add_ea then "expected" else ""
, what ]
herald2 = conc [ "with"
- , if is_repr then "that of" else ""
- , if is_oriented then ("actual " ++ what) else "" ]
+ , if is_repr then "that of" else ""
+ , if add_ea then ("actual " ++ what) else "" ]
+
padding = length herald1 - length herald2
is_repr = case ctEqRel ct of { ReprEq -> True; NomEq -> False }
- is_oriented = isJust oriented
- orig = ctOrigin ct
- what = case ctLocTypeOrKind_maybe (ctLoc ct) of
- Just KindLevel -> "kind"
- _ -> "type"
+ what = levelString (ctLocTypeOrKind_maybe (ctLoc ct) `orElse` TypeLevel)
conc :: [String] -> String
conc = foldr1 add_space
@@ -1850,114 +1797,49 @@ misMatchMsg ct oriented ty1 ty2
| null s2 = s1
| otherwise = s1 ++ (' ' : s2)
- lifted_vs_unlifted
- = addArising orig $
- text "Couldn't match a lifted type with an unlifted type"
--- | Prints explicit kinds (with @-fprint-explicit-kinds@) in an 'SDoc' when a
--- type mismatch occurs to due invisible kind arguments.
---
--- This function first checks to see if the 'CtOrigin' argument is a
--- 'TypeEqOrigin', and if so, uses the expected/actual types from that to
--- check for a kind mismatch (as these types typically have more surrounding
--- types and are likelier to be able to glean information about whether a
--- mismatch occurred in an invisible argument position or not). If the
--- 'CtOrigin' is not a 'TypeEqOrigin', fall back on the actual mismatched types
--- themselves.
-pprWithExplicitKindsWhenMismatch :: Type -> Type -> CtOrigin
- -> SDoc -> SDoc
-pprWithExplicitKindsWhenMismatch ty1 ty2 ct
- = pprWithExplicitKindsWhen show_kinds
- where
- (act_ty, exp_ty) = case ct of
- TypeEqOrigin { uo_actual = act
- , uo_expected = exp } -> (act, exp)
- _ -> (ty1, ty2)
- show_kinds = tcEqTypeVis act_ty exp_ty
- -- True when the visible bit of the types look the same,
- -- so we want to show the kinds in the displayed type
-
-mkExpectedActualMsg :: Type -> Type -> CtOrigin -> Maybe TypeOrKind -> Bool
- -> (Bool, Maybe SwapFlag, SDoc)
--- NotSwapped means (actual, expected), IsSwapped is the reverse
--- First return val is whether or not to print a herald above this msg
-mkExpectedActualMsg ty1 ty2 ct@(TypeEqOrigin { uo_actual = act
+tk_eq_msg :: ReportErrCtxt
+ -> Ct -> Type -> Type -> CtOrigin -> SDoc
+tk_eq_msg ctxt ct ty1 ty2 orig@(TypeEqOrigin { uo_actual = act
, uo_expected = exp
- , uo_thing = maybe_thing })
- m_level printExpanded
- | KindLevel <- level, occurs_check_error = (True, Nothing, empty)
- | isUnliftedTypeKind act, isLiftedTypeKind exp = (False, Nothing, msg2)
- | isLiftedTypeKind act, isUnliftedTypeKind exp = (False, Nothing, msg3)
- | tcIsLiftedTypeKind exp = (False, Nothing, msg4)
- | Just msg <- num_args_msg = (False, Nothing, msg $$ msg1)
- | KindLevel <- level, Just th <- maybe_thing = (False, Nothing, msg5 th)
- | act `pickyEqType` ty1, exp `pickyEqType` ty2 = (True, Just NotSwapped, empty)
- | exp `pickyEqType` ty1, act `pickyEqType` ty2 = (True, Just IsSwapped, empty)
- | otherwise = (True, Nothing, msg1)
- where
- level = m_level `orElse` TypeLevel
+ , uo_thing = mb_thing })
+ -- We can use the TypeEqOrigin to
+ -- improve the error message quite a lot
+
+ | isUnliftedTypeKind act, isLiftedTypeKind exp
+ = sep [ text "Expecting a lifted type, but"
+ , thing_msg mb_thing (text "an") (text "unlifted") ]
+
+ | isLiftedTypeKind act, isUnliftedTypeKind exp
+ = sep [ text "Expecting an unlifted type, but"
+ , thing_msg mb_thing (text "a") (text "lifted") ]
+
+ | tcIsLiftedTypeKind exp
+ = maybe_num_args_msg $$
+ sep [ text "Expected a type, but"
+ , case mb_thing of
+ Nothing -> text "found something with kind"
+ Just thing -> quotes thing <+> text "has kind"
+ , quotes (pprWithTYPE act) ]
+
+ | Just nargs_msg <- num_args_msg
+ = nargs_msg $$
+ mk_ea_msg ctxt (Just ct) level orig
+
+ | -- pprTrace "check" (ppr ea_looks_same $$ ppr exp $$ ppr act $$ ppr ty1 $$ ppr ty2) $
+ ea_looks_same ty1 ty2 exp act
+ = mk_ea_msg ctxt (Just ct) level orig
+
+ | otherwise -- The mismatched types are /inside/ exp and act
+ = vcat [ headline_eq_msg False ct ty1 ty2
+ , mk_ea_msg ctxt Nothing level orig ]
- occurs_check_error
- | Just tv <- tcGetTyVar_maybe ty1
- , tv `elemVarSet` tyCoVarsOfType ty2
- = True
- | Just tv <- tcGetTyVar_maybe ty2
- , tv `elemVarSet` tyCoVarsOfType ty1
- = True
- | otherwise
- = False
-
- sort = case level of
- TypeLevel -> text "type"
- KindLevel -> text "kind"
-
- msg1 = case level of
- KindLevel
- | Just th <- maybe_thing
- -> msg5 th
-
- _ | not (act `pickyEqType` exp)
- -> pprWithExplicitKindsWhenMismatch ty1 ty2 ct $
- vcat [ text "Expected" <+> sort <> colon <+> ppr exp
- , text " Actual" <+> sort <> colon <+> ppr act
- , if printExpanded then expandedTys else empty ]
-
- | otherwise
- -> empty
-
- thing_msg = case maybe_thing of
- Just thing -> \_ levity ->
- quotes thing <+> text "is" <+> levity
- Nothing -> \vowel levity ->
- text "got a" <>
- (if vowel then char 'n' else empty) <+>
- levity <+>
- text "type"
- msg2 = sep [ text "Expecting a lifted type, but"
- , thing_msg True (text "unlifted") ]
- msg3 = sep [ text "Expecting an unlifted type, but"
- , thing_msg False (text "lifted") ]
- msg4 = maybe_num_args_msg $$
- sep [ text "Expected a type, but"
- , maybe (text "found something with kind")
- (\thing -> quotes thing <+> text "has kind")
- maybe_thing
- , quotes (pprWithTYPE act) ]
-
- msg5 th = pprWithExplicitKindsWhenMismatch ty1 ty2 ct $
- hang (text "Expected" <+> kind_desc <> comma)
- 2 (text "but" <+> quotes th <+> text "has kind" <+>
- quotes (ppr act))
- where
- kind_desc | tcIsConstraintKind exp = text "a constraint"
-
- -- TYPE t0
- | Just arg <- kindRep_maybe exp
- , tcIsTyVarTy arg = sdocOption sdocPrintExplicitRuntimeReps $ \case
- True -> text "kind" <+> quotes (ppr exp)
- False -> text "a type"
+ where
+ ct_loc = ctLoc ct
+ level = ctLocTypeOrKind_maybe ct_loc `orElse` TypeLevel
- | otherwise = text "kind" <+> quotes (ppr exp)
+ thing_msg (Just thing) _ levity = quotes thing <+> text "is" <+> levity
+ thing_msg Nothing an levity = text "got" <+> an <+> levity <+> text "type"
num_args_msg = case level of
KindLevel
@@ -1970,7 +1852,7 @@ mkExpectedActualMsg ty1 ty2 ct@(TypeEqOrigin { uo_actual = act
case n_act - n_exp of
n | n > 0 -- we don't know how many args there are, so don't
-- recommend removing args that aren't
- , Just thing <- maybe_thing
+ , Just thing <- mb_thing
-> Just $ text "Expecting" <+> speakN (abs n) <+>
more <+> quotes thing
where
@@ -1981,25 +1863,125 @@ mkExpectedActualMsg ty1 ty2 ct@(TypeEqOrigin { uo_actual = act
_ -> Nothing
- maybe_num_args_msg = case num_args_msg of
- Nothing -> empty
- Just m -> m
+ maybe_num_args_msg = num_args_msg `orElse` empty
count_args ty = count isVisibleBinder $ fst $ splitPiTys ty
- expandedTys =
- ppUnless (expTy1 `pickyEqType` exp && expTy2 `pickyEqType` act) $ vcat
- [ text "Type synonyms expanded:"
- , text "Expected type:" <+> ppr expTy1
- , text " Actual type:" <+> ppr expTy2
- ]
+tk_eq_msg ctxt ct ty1 ty2
+ (KindEqOrigin cty1 mb_cty2 sub_o mb_sub_t_or_k)
+ = vcat [ headline_eq_msg False ct ty1 ty2
+ , supplementary_msg ]
+ where
+ sub_t_or_k = mb_sub_t_or_k `orElse` TypeLevel
+ sub_whats = text (levelString sub_t_or_k) <> char 's'
+ -- "types" or "kinds"
+
+ supplementary_msg
+ = sdocOption sdocPrintExplicitCoercions $ \printExplicitCoercions ->
+ case mb_cty2 of
+ Just cty2
+ | printExplicitCoercions
+ || not (cty1 `pickyEqType` cty2)
+ -> vcat [ hang (text "When matching" <+> sub_whats)
+ 2 (vcat [ ppr cty1 <+> dcolon <+>
+ ppr (tcTypeKind cty1)
+ , ppr cty2 <+> dcolon <+>
+ ppr (tcTypeKind cty2) ])
+ , mk_supplementary_ea_msg ctxt sub_t_or_k cty1 cty2 sub_o ]
+ _ -> text "When matching the kind of" <+> quotes (ppr cty1)
+
+tk_eq_msg _ _ _ _ _ = panic "typeeq_mismatch_msg"
+
+ea_looks_same :: Type -> Type -> Type -> Type -> Bool
+-- True if the faulting types (ty1, ty2) look the same as
+-- the expected/actual types (exp, act).
+-- If so, we don't want to redundantly report the latter
+ea_looks_same ty1 ty2 exp act
+ = (act `looks_same` ty1 && exp `looks_same` ty2) ||
+ (exp `looks_same` ty1 && act `looks_same` ty2)
+ where
+ looks_same t1 t2 = t1 `pickyEqType` t2
+ || t1 `eqType` liftedTypeKind && t2 `eqType` liftedTypeKind
+ -- pickyEqType is sensitive to synonyms, so only replies True
+ -- when the types really look the same. However,
+ -- (TYPE 'LiftedRep) and Type both print the same way.
+
+mk_supplementary_ea_msg :: ReportErrCtxt -> TypeOrKind
+ -> Type -> Type -> CtOrigin -> SDoc
+mk_supplementary_ea_msg ctxt level ty1 ty2 orig
+ | TypeEqOrigin { uo_expected = exp, uo_actual = act } <- orig
+ , not (ea_looks_same ty1 ty2 exp act)
+ = mk_ea_msg ctxt Nothing level orig
+ | otherwise
+ = empty
+
+mk_ea_msg :: ReportErrCtxt -> Maybe Ct -> TypeOrKind -> CtOrigin -> SDoc
+-- Constructs a "Couldn't match" message
+-- The (Maybe Ct) says whether this is the main top-level message (Just)
+-- or a supplementary message (Nothing)
+mk_ea_msg ctxt at_top level
+ (TypeEqOrigin { uo_actual = act, uo_expected = exp, uo_thing = mb_thing })
+ | Just thing <- mb_thing
+ , KindLevel <- level
+ = hang (text "Expected" <+> kind_desc <> comma)
+ 2 (text "but" <+> quotes thing <+> text "has kind" <+>
+ quotes (ppr act))
+
+ | otherwise
+ = vcat [ case at_top of
+ Just ct -> headline_eq_msg True ct exp act
+ Nothing -> supplementary_ea_msg
+ , ppWhen expand_syns expandedTys ]
+
+ where
+ supplementary_ea_msg = vcat [ text "Expected:" <+> ppr exp
+ , text " Actual:" <+> ppr act ]
+
+ kind_desc | tcIsConstraintKind exp = text "a constraint"
+ | Just arg <- kindRep_maybe exp -- TYPE t0
+ , tcIsTyVarTy arg = sdocOption sdocPrintExplicitRuntimeReps $ \case
+ True -> text "kind" <+> quotes (ppr exp)
+ False -> text "a type"
+ | otherwise = text "kind" <+> quotes (ppr exp)
+
+ expand_syns = cec_expand_syns ctxt
+
+ expandedTys = ppUnless (expTy1 `pickyEqType` exp && expTy2 `pickyEqType` act) $ vcat
+ [ text "Type synonyms expanded:"
+ , text "Expected type:" <+> ppr expTy1
+ , text " Actual type:" <+> ppr expTy2 ]
(expTy1, expTy2) = expandSynonymsToMatch exp act
-mkExpectedActualMsg _ _ _ _ _ = panic "mkExpectedAcutalMsg"
+mk_ea_msg _ _ _ _ = empty
+
+-- | Prints explicit kinds (with @-fprint-explicit-kinds@) in an 'SDoc' when a
+-- type mismatch occurs to due invisible kind arguments.
+--
+-- This function first checks to see if the 'CtOrigin' argument is a
+-- 'TypeEqOrigin', and if so, uses the expected/actual types from that to
+-- check for a kind mismatch (as these types typically have more surrounding
+-- types and are likelier to be able to glean information about whether a
+-- mismatch occurred in an invisible argument position or not). If the
+-- 'CtOrigin' is not a 'TypeEqOrigin', fall back on the actual mismatched types
+-- themselves.
+pprWithExplicitKindsWhenMismatch :: Type -> Type -> CtOrigin
+ -> SDoc -> SDoc
+pprWithExplicitKindsWhenMismatch ty1 ty2 ct
+ = pprWithExplicitKindsWhen show_kinds
+ where
+ (act_ty, exp_ty) = case ct of
+ TypeEqOrigin { uo_actual = act
+ , uo_expected = exp } -> (act, exp)
+ _ -> (ty1, ty2)
+ show_kinds = tcEqTypeVis act_ty exp_ty
+ -- True when the visible bit of the types look the same,
+ -- so we want to show the kinds in the displayed type
+
+
-{- Note [Insoluble occurs check wins]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+{- Note [Insoluble occurs check]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider [G] a ~ [a], [W] a ~ [a] (#13674). The Given is insoluble
so we don't use it for rewriting. The Wanted is also insoluble, and
we don't solve it from the Given. It's very confusing to say
@@ -2009,7 +1991,8 @@ And indeed even thinking about the Givens is silly; [W] a ~ [a] is
just as insoluble as Int ~ Bool.
Conclusion: if there's an insoluble occurs check (isInsolubleOccursCheck)
-then report it first.
+then report it directly, not in the "cannot deduce X from Y" form.
+This is done in misMatchOrCND (via the insoluble_occurs_check arg)
(NB: there are potentially-soluble ones, like (a ~ F a b), and we don't
want to be as draconian with them.)
diff --git a/compiler/GHC/Tc/Errors/Hole.hs b/compiler/GHC/Tc/Errors/Hole.hs
index 0639e79073..7c0eaa7912 100644
--- a/compiler/GHC/Tc/Errors/Hole.hs
+++ b/compiler/GHC/Tc/Errors/Hole.hs
@@ -43,7 +43,7 @@ import Data.Graph ( graphFromEdges, topSort )
import GHC.Tc.Solver ( simpl_top, runTcSDeriveds )
-import GHC.Tc.Utils.Unify ( tcSubType_NC )
+import GHC.Tc.Utils.Unify ( tcSubTypeSigma )
import GHC.HsToCore.Docs ( extractDocs )
import qualified Data.Map as Map
@@ -933,7 +933,7 @@ tcCheckHoleFit (TypedHole {..}) hole_ty ty = discardErrs $
-- imp is the innermost implication
(imp:_) -> return (ic_tclvl imp)
; (wrap, wanted) <- setTcLevel innermost_lvl $ captureConstraints $
- tcSubType_NC ExprSigCtxt ty hole_ty
+ tcSubTypeSigma ExprSigCtxt ty hole_ty
; traceTc "Checking hole fit {" empty
; traceTc "wanteds are: " $ ppr wanted
; if isEmptyWC wanted && isEmptyBag th_relevant_cts
diff --git a/compiler/GHC/Tc/Gen/Arrow.hs b/compiler/GHC/Tc/Gen/Arrow.hs
index ef60b3cea7..c21a885970 100644
--- a/compiler/GHC/Tc/Gen/Arrow.hs
+++ b/compiler/GHC/Tc/Gen/Arrow.hs
@@ -14,7 +14,8 @@ module GHC.Tc.Gen.Arrow ( tcProc ) where
import GHC.Prelude
-import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcLExpr, tcInferRho, tcSyntaxOp, tcCheckId, tcCheckExpr )
+import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcCheckMonoExpr, tcInferRho, tcSyntaxOp
+ , tcCheckId, tcCheckPolyExpr )
import GHC.Hs
import GHC.Tc.Gen.Match
@@ -161,7 +162,7 @@ tc_cmd env in_cmd@(HsCmdLamCase x matches) (stk, res_ty)
return (mkHsCmdWrap (mkWpCastN co) (HsCmdLamCase x matches'))
tc_cmd env (HsCmdIf x NoSyntaxExprRn pred b1 b2) res_ty -- Ordinary 'if'
- = do { pred' <- tcLExpr pred (mkCheckExpType boolTy)
+ = do { pred' <- tcCheckMonoExpr pred boolTy
; b1' <- tcCmd env b1 res_ty
; b2' <- tcCmd env b2 res_ty
; return (HsCmdIf x NoSyntaxExprTc pred' b1' b2')
@@ -179,7 +180,7 @@ tc_cmd env (HsCmdIf x fun@(SyntaxExprRn {}) pred b1 b2) res_ty -- Rebindable syn
; (pred', fun')
<- tcSyntaxOp IfOrigin fun (map synKnownType [pred_ty, r_ty, r_ty])
(mkCheckExpType r_ty) $ \ _ ->
- tcLExpr pred (mkCheckExpType pred_ty)
+ tcCheckMonoExpr pred pred_ty
; b1' <- tcCmd env b1 res_ty
; b2' <- tcCmd env b2 res_ty
@@ -206,9 +207,9 @@ tc_cmd env cmd@(HsCmdArrApp _ fun arg ho_app lr) (_, res_ty)
= addErrCtxt (cmdCtxt cmd) $
do { arg_ty <- newOpenFlexiTyVarTy
; let fun_ty = mkCmdArrTy env arg_ty res_ty
- ; fun' <- select_arrow_scope (tcLExpr fun (mkCheckExpType fun_ty))
+ ; fun' <- select_arrow_scope (tcCheckMonoExpr fun fun_ty)
- ; arg' <- tcLExpr arg (mkCheckExpType arg_ty)
+ ; arg' <- tcCheckMonoExpr arg arg_ty
; return (HsCmdArrApp fun_ty fun' arg' ho_app lr) }
where
@@ -233,7 +234,7 @@ tc_cmd env cmd@(HsCmdApp x fun arg) (cmd_stk, res_ty)
= addErrCtxt (cmdCtxt cmd) $
do { arg_ty <- newOpenFlexiTyVarTy
; fun' <- tcCmd env fun (mkPairTy arg_ty cmd_stk, res_ty)
- ; arg' <- tcLExpr arg (mkCheckExpType arg_ty)
+ ; arg' <- tcCheckMonoExpr arg arg_ty
; return (HsCmdApp x fun' arg') }
-------------------------------------------
@@ -310,7 +311,7 @@ tc_cmd env cmd@(HsCmdArrForm x expr f fixity cmd_args) (cmd_stk, res_ty)
; let e_ty = mkInfForAllTy alphaTyVar $
mkVisFunTys cmd_tys $
mkCmdArrTy env (mkPairTy alphaTy cmd_stk) res_ty
- ; expr' <- tcCheckExpr expr e_ty
+ ; expr' <- tcCheckPolyExpr expr e_ty
; return (HsCmdArrForm x expr' f fixity cmd_args') }
where
diff --git a/compiler/GHC/Tc/Gen/Bind.hs b/compiler/GHC/Tc/Gen/Bind.hs
index 1870531f60..bd9d14e2d4 100644
--- a/compiler/GHC/Tc/Gen/Bind.hs
+++ b/compiler/GHC/Tc/Gen/Bind.hs
@@ -23,8 +23,9 @@ where
import GHC.Prelude
import {-# SOURCE #-} GHC.Tc.Gen.Match ( tcGRHSsPat, tcMatchesFun )
-import {-# SOURCE #-} GHC.Tc.Gen.Expr ( tcLExpr )
+import {-# SOURCE #-} GHC.Tc.Gen.Expr ( tcCheckMonoExpr )
import {-# SOURCE #-} GHC.Tc.TyCl.PatSyn ( tcPatSynDecl, tcPatSynBuilderBind )
+
import GHC.Core (Tickish (..))
import GHC.Types.CostCentre (mkUserCC, CCFlavour(DeclCC))
import GHC.Driver.Session
@@ -354,7 +355,7 @@ tcLocalBinds (HsIPBinds x (IPBinds _ ip_binds)) thing_inside
= do { ty <- newOpenFlexiTyVarTy
; let p = mkStrLitTy $ hsIPNameFS ip
; ip_id <- newDict ipClass [ p, ty ]
- ; expr' <- tcLExpr expr (mkCheckExpType ty)
+ ; expr' <- tcCheckMonoExpr expr ty
; let d = toDict ipClass p ty `fmap` expr'
; return (ip_id, (IPBind noExtField (Right ip_id) d)) }
tc_ip_bind _ (IPBind _ (Right {}) _) = panic "tc_ip_bind"
@@ -389,22 +390,25 @@ tcValBinds top_lvl binds sigs thing_inside
-- It's easier to do so now, once for all the SCCs together
-- because a single signature f,g :: <type>
-- might relate to more than one SCC
- ; (poly_ids, sig_fn) <- tcAddPatSynPlaceholders patsyns $
+ (poly_ids, sig_fn) <- tcAddPatSynPlaceholders patsyns $
tcTySigs sigs
- -- Extend the envt right away with all the Ids
- -- declared with complete type signatures
- -- Do not extend the TcBinderStack; instead
- -- we extend it on a per-rhs basis in tcExtendForRhs
- ; tcExtendSigIds top_lvl poly_ids $ do
- { (binds', (extra_binds', thing)) <- tcBindGroups top_lvl sig_fn prag_fn binds $ do
- { thing <- thing_inside
- -- See Note [Pattern synonym builders don't yield dependencies]
- -- in GHC.Rename.Bind
- ; patsyn_builders <- mapM tcPatSynBuilderBind patsyns
- ; let extra_binds = [ (NonRecursive, builder) | builder <- patsyn_builders ]
- ; return (extra_binds, thing) }
- ; return (binds' ++ extra_binds', thing) }}
+ -- Extend the envt right away with all the Ids
+ -- declared with complete type signatures
+ -- Do not extend the TcBinderStack; instead
+ -- we extend it on a per-rhs basis in tcExtendForRhs
+ -- See Note [Relevant bindings and the binder stack]
+ ; tcExtendSigIds top_lvl poly_ids $
+ do { (binds', (extra_binds', thing))
+ <- tcBindGroups top_lvl sig_fn prag_fn binds $
+ do { thing <- thing_inside
+ -- See Note [Pattern synonym builders don't yield dependencies]
+ -- in GHC.Rename.Bind
+ ; patsyn_builders <- mapM tcPatSynBuilderBind patsyns
+ ; let extra_binds = [ (NonRecursive, builder)
+ | builder <- patsyn_builders ]
+ ; return (extra_binds, thing) }
+ ; return (binds' ++ extra_binds', thing) }}
where
patsyns = getPatSynBinds binds
prag_fn = mkPragEnv sigs (foldr (unionBags . snd) emptyBag binds)
@@ -686,50 +690,60 @@ tcPolyCheck prag_fn
(CompleteSig { sig_bndr = poly_id
, sig_ctxt = ctxt
, sig_loc = sig_loc })
- (L loc (FunBind { fun_id = (L nm_loc name)
- , fun_matches = matches }))
- = setSrcSpan sig_loc $
- do { traceTc "tcPolyCheck" (ppr poly_id $$ ppr sig_loc)
- ; (tv_prs, theta, tau) <- tcInstType tcInstSkolTyVars poly_id
- -- See Note [Instantiate sig with fresh variables]
+ (L bind_loc (FunBind { fun_id = L nm_loc name
+ , fun_matches = matches }))
+ = do { traceTc "tcPolyCheck" (ppr poly_id $$ ppr sig_loc)
; mono_name <- newNameAt (nameOccName name) nm_loc
- ; ev_vars <- newEvVars theta
- ; let mono_id = mkLocalId mono_name tau
- skol_info = SigSkol ctxt (idType poly_id) tv_prs
- skol_tvs = map snd tv_prs
-
- ; (ev_binds, (co_fn, matches'))
- <- checkConstraints skol_info skol_tvs ev_vars $
- tcExtendBinderStack [TcIdBndr mono_id NotTopLevel] $
- tcExtendNameTyVarEnv tv_prs $
- setSrcSpan loc $
- tcMatchesFun (L nm_loc mono_name) matches (mkCheckExpType tau)
+ ; (wrap_gen, (wrap_res, matches'))
+ <- setSrcSpan sig_loc $ -- Sets the binding location for the skolems
+ tcSkolemiseScoped ctxt (idType poly_id) $ \rho_ty ->
+ -- Unwraps multiple layers; e.g
+ -- f :: forall a. Eq a => forall b. Ord b => blah
+ -- NB: tcSkolemise makes fresh type variables
+ -- See Note [Instantiate sig with fresh variables]
+
+ let mono_id = mkLocalId mono_name rho_ty in
+ tcExtendBinderStack [TcIdBndr mono_id NotTopLevel] $
+ -- Why mono_id in the BinderStack?
+ -- See Note [Relevant bindings and the binder stack]
+
+ setSrcSpan bind_loc $
+ tcMatchesFun (L nm_loc mono_name) matches
+ (mkCheckExpType rho_ty)
+
+ -- We make a funny AbsBinds, abstracting over nothing,
+ -- just so we haev somewhere to put the SpecPrags.
+ -- Otherwise we could just use the FunBind
+ -- Hence poly_id2 is just a clone of poly_id;
+ -- We re-use mono-name, but we could equally well use a fresh one
; let prag_sigs = lookupPragEnv prag_fn name
- ; spec_prags <- tcSpecPrags poly_id prag_sigs
+ poly_id2 = mkLocalId mono_name (idType poly_id)
+ ; spec_prags <- tcSpecPrags poly_id prag_sigs
; poly_id <- addInlinePrags poly_id prag_sigs
; mod <- getModule
- ; tick <- funBindTicks nm_loc mono_id mod prag_sigs
- ; let bind' = FunBind { fun_id = L nm_loc mono_id
+ ; tick <- funBindTicks nm_loc poly_id mod prag_sigs
+
+ ; let bind' = FunBind { fun_id = L nm_loc poly_id2
, fun_matches = matches'
- , fun_ext = co_fn
+ , fun_ext = wrap_gen <.> wrap_res
, fun_tick = tick }
export = ABE { abe_ext = noExtField
, abe_wrap = idHsWrapper
, abe_poly = poly_id
- , abe_mono = mono_id
+ , abe_mono = poly_id2
, abe_prags = SpecPrags spec_prags }
- abs_bind = L loc $
+ abs_bind = L bind_loc $
AbsBinds { abs_ext = noExtField
- , abs_tvs = skol_tvs
- , abs_ev_vars = ev_vars
- , abs_ev_binds = [ev_binds]
+ , abs_tvs = []
+ , abs_ev_vars = []
+ , abs_ev_binds = []
, abs_exports = [export]
- , abs_binds = unitBag (L loc bind')
+ , abs_binds = unitBag (L bind_loc bind')
, abs_sig = True }
; return (unitBag abs_bind, [poly_id]) }
@@ -862,7 +876,7 @@ mkExport prag_fn insoluble qtvs theta
-- an ambiguous type and have AllowAmbiguousType
-- e..g infer x :: forall a. F a -> Int
else addErrCtxtM (mk_impedance_match_msg mono_info sel_poly_ty poly_ty) $
- tcSubType_NC sig_ctxt sel_poly_ty poly_ty
+ tcSubTypeSigma sig_ctxt sel_poly_ty poly_ty
; warn_missing_sigs <- woptM Opt_WarnMissingLocalSignatures
; when warn_missing_sigs $
@@ -943,8 +957,12 @@ chooseInferredQuantifiers inferred_theta tau_tvs qtvs
, sig_inst_theta = annotated_theta
, sig_inst_skols = annotated_tvs }))
= -- Choose quantifiers for a partial type signature
- do { psig_qtvbndr_prs <- zonkTyVarTyVarPairs annotated_tvs
- ; let psig_qtv_prs = mapSnd binderVar psig_qtvbndr_prs
+ do { let (psig_qtv_nms, psig_qtv_bndrs) = unzip annotated_tvs
+ ; psig_qtv_bndrs <- mapM zonkInvisTVBinder psig_qtv_bndrs
+ ; let psig_qtvs = map binderVar psig_qtv_bndrs
+ psig_qtv_set = mkVarSet psig_qtvs
+ psig_qtv_prs = psig_qtv_nms `zip` psig_qtvs
+
-- Check whether the quantified variables of the
-- partial signature have been unified together
@@ -958,17 +976,14 @@ chooseInferredQuantifiers inferred_theta tau_tvs qtvs
; mapM_ report_mono_sig_tv_err [ n | (n,tv) <- psig_qtv_prs
, not (tv `elem` qtvs) ]
- ; let psig_qtvbndrs = map snd psig_qtvbndr_prs
- psig_qtvs = mkVarSet (map snd psig_qtv_prs)
-
; annotated_theta <- zonkTcTypes annotated_theta
- ; (free_tvs, my_theta) <- choose_psig_context psig_qtvs annotated_theta wcx
+ ; (free_tvs, my_theta) <- choose_psig_context psig_qtv_set annotated_theta wcx
- ; let keep_me = free_tvs `unionVarSet` psig_qtvs
+ ; let keep_me = free_tvs `unionVarSet` psig_qtv_set
final_qtvs = [ mkTyVarBinder vis tv
| tv <- qtvs -- Pulling from qtvs maintains original order
, tv `elemVarSet` keep_me
- , let vis = case lookupVarBndr tv psig_qtvbndrs of
+ , let vis = case lookupVarBndr tv psig_qtv_bndrs of
Just spec -> spec
Nothing -> InferredSpec ]
@@ -1454,17 +1469,7 @@ tcExtendTyVarEnvFromSig sig_inst thing_inside
thing_inside
tcExtendIdBinderStackForRhs :: [MonoBindInfo] -> TcM a -> TcM a
--- Extend the TcBinderStack for the RHS of the binding, with
--- the monomorphic Id. That way, if we have, say
--- f = \x -> blah
--- and something goes wrong in 'blah', we get a "relevant binding"
--- looking like f :: alpha -> beta
--- This applies if 'f' has a type signature too:
--- f :: forall a. [a] -> [a]
--- f x = True
--- We can't unify True with [a], and a relevant binding is f :: [a] -> [a]
--- If we had the *polymorphic* version of f in the TcBinderStack, it
--- would not be reported as relevant, because its type is closed
+-- See Note [Relevant bindings and the binder stack]
tcExtendIdBinderStackForRhs infos thing_inside
= tcExtendBinderStack [ TcIdBndr mono_id NotTopLevel
| MBI { mbi_mono_id = mono_id } <- infos ]
@@ -1480,7 +1485,22 @@ getMonoBindInfo tc_binds
get_info (TcPatBind infos _ _ _) rest = infos ++ rest
-{- Note [Typechecking pattern bindings]
+{- Note [Relevant bindings and the binder stack]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+When typecking a binding we extend the TcBinderStack for the RHS of
+the binding, with the /monomorphic/ Id. That way, if we have, say
+ f = \x -> blah
+and something goes wrong in 'blah', we get a "relevant binding"
+looking like f :: alpha -> beta
+This applies if 'f' has a type signature too:
+ f :: forall a. [a] -> [a]
+ f x = True
+We can't unify True with [a], and a relevant binding is f :: [a] -> [a]
+If we had the *polymorphic* version of f in the TcBinderStack, it
+would not be reported as relevant, because its type is closed.
+(See TcErrors.relevantBindings.)
+
+Note [Typechecking pattern bindings]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Look at:
- typecheck/should_compile/ExPat
diff --git a/compiler/GHC/Tc/Gen/Default.hs b/compiler/GHC/Tc/Gen/Default.hs
index ab5e021653..9f31d7938a 100644
--- a/compiler/GHC/Tc/Gen/Default.hs
+++ b/compiler/GHC/Tc/Gen/Default.hs
@@ -70,8 +70,8 @@ tcDefaults decls@(L locn (DefaultDecl _ _) : _)
tc_default_ty :: [Class] -> LHsType GhcRn -> TcM Type
tc_default_ty deflt_clss hs_ty
- = do { (ty, _kind) <- solveEqualities $
- tcLHsType hs_ty
+ = do { ty <- solveEqualities $
+ tcInferLHsType hs_ty
; ty <- zonkTcTypeToType ty -- establish Type invariants
; checkValidType DefaultDeclCtxt ty
diff --git a/compiler/GHC/Tc/Gen/Expr.hs b/compiler/GHC/Tc/Gen/Expr.hs
index 2d6b25df10..b4c3b6275c 100644
--- a/compiler/GHC/Tc/Gen/Expr.hs
+++ b/compiler/GHC/Tc/Gen/Expr.hs
@@ -13,20 +13,15 @@
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
--- | Typecheck an expression
module GHC.Tc.Gen.Expr
- ( tcCheckExpr
- , tcLExpr, tcLExprNC, tcExpr
- , tcInferSigma
- , tcInferRho, tcInferRhoNC
- , tcSyntaxOp, tcSyntaxOpGen
- , SyntaxOpType(..)
- , synKnownType
- , tcCheckId
- , addAmbiguousNameErr
- , getFixedTyVars
- )
-where
+ ( tcCheckPolyExpr,
+ tcCheckMonoExpr, tcCheckMonoExprNC, tcMonoExpr, tcMonoExprNC,
+ tcInferSigma, tcInferRho, tcInferRhoNC,
+ tcExpr,
+ tcSyntaxOp, tcSyntaxOpGen, SyntaxOpType(..), synKnownType,
+ tcCheckId,
+ addAmbiguousNameErr,
+ getFixedTyVars ) where
#include "HsVersions.h"
@@ -101,25 +96,35 @@ import qualified Data.Set as Set
************************************************************************
-}
-tcCheckExpr, tcCheckExprNC
+
+tcCheckPolyExpr, tcCheckPolyExprNC
:: LHsExpr GhcRn -- Expression to type check
-> TcSigmaType -- Expected type (could be a polytype)
-> TcM (LHsExpr GhcTc) -- Generalised expr with expected type
--- tcCheckExpr is a convenient place (frequent but not too frequent)
+-- tcCheckPolyExpr is a convenient place (frequent but not too frequent)
-- place to add context information.
-- The NC version does not do so, usually because the caller wants
-- to do so himself.
-tcCheckExpr expr res_ty
+tcCheckPolyExpr expr res_ty = tcPolyExpr expr (mkCheckExpType res_ty)
+tcCheckPolyExprNC expr res_ty = tcPolyExprNC expr (mkCheckExpType res_ty)
+
+-- These versions take an ExpType
+tcPolyExpr, tcPolyExprNC
+ :: LHsExpr GhcRn -> ExpSigmaType
+ -> TcM (LHsExpr GhcTcId)
+
+tcPolyExpr expr res_ty
= addExprCtxt expr $
- tcCheckExprNC expr res_ty
+ do { traceTc "tcPolyExpr" (ppr res_ty)
+ ; tcPolyExprNC expr res_ty }
-tcCheckExprNC (L loc expr) res_ty
+tcPolyExprNC (L loc expr) res_ty
= setSrcSpan loc $
- do { traceTc "tcCheckExprNC" (ppr res_ty)
- ; (wrap, expr') <- tcSkolemise GenSigCtxt res_ty $ \ _ res_ty ->
- tcExpr expr (mkCheckExpType res_ty)
+ do { traceTc "tcPolyExprNC" (ppr res_ty)
+ ; (wrap, expr') <- tcSkolemiseET GenSigCtxt res_ty $ \ res_ty ->
+ tcExpr expr res_ty
; return $ L loc (mkHsWrap wrap expr') }
---------------
@@ -134,6 +139,30 @@ tcInferSigma le@(L loc expr)
; return (L loc (applyHsArgs fun args), ty) }
---------------
+tcCheckMonoExpr, tcCheckMonoExprNC
+ :: LHsExpr GhcRn -- Expression to type check
+ -> TcRhoType -- Expected type
+ -- Definitely no foralls at the top
+ -> TcM (LHsExpr GhcTcId)
+tcCheckMonoExpr expr res_ty = tcMonoExpr expr (mkCheckExpType res_ty)
+tcCheckMonoExprNC expr res_ty = tcMonoExprNC expr (mkCheckExpType res_ty)
+
+tcMonoExpr, tcMonoExprNC
+ :: LHsExpr GhcRn -- Expression to type check
+ -> ExpRhoType -- Expected type
+ -- Definitely no foralls at the top
+ -> TcM (LHsExpr GhcTcId)
+
+tcMonoExpr expr res_ty
+ = addExprCtxt expr $
+ tcMonoExprNC expr res_ty
+
+tcMonoExprNC (L loc expr) res_ty
+ = setSrcSpan loc $
+ do { expr' <- tcExpr expr res_ty
+ ; return (L loc expr') }
+
+---------------
tcInferRho, tcInferRhoNC :: LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcRhoType)
-- Infer a *rho*-type. The return type is always instantiated.
tcInferRho le = addExprCtxt le (tcInferRhoNC le)
@@ -144,15 +173,11 @@ tcInferRhoNC (L loc expr)
; return (L loc expr', rho) }
-{-
-************************************************************************
+{- *********************************************************************
* *
tcExpr: the main expression typechecker
* *
-************************************************************************
-
-NB: The res_ty is always deeply skolemised.
--}
+********************************************************************* -}
tcLExpr, tcLExprNC
:: LHsExpr GhcRn -- Expression to type check
@@ -241,7 +266,7 @@ tcExpr e@(HsOverLabel _ mb_fromLabel l) res_ty
(mkEmptyWildCardBndrs (L loc (HsTyLit noExtField (HsStrTy NoSourceText l))))
tcExpr (HsLam x match) res_ty
- = do { (match', wrap) <- tcMatchLambda herald match_ctxt match res_ty
+ = do { (wrap, match') <- tcMatchLambda herald match_ctxt match res_ty
; return (mkHsWrap wrap (HsLam x match')) }
where
match_ctxt = MC { mc_what = LambdaExpr, mc_body = tcBody }
@@ -252,7 +277,7 @@ tcExpr (HsLam x match) res_ty
text "has"]
tcExpr e@(HsLamCase x matches) res_ty
- = do { (matches', wrap)
+ = do { (wrap, matches')
<- tcMatchLambda msg match_ctxt matches res_ty
-- The laziness annotation is because we don't want to fail here
-- if there are multiple arguments
@@ -335,7 +360,7 @@ tcExpr expr@(OpApp fix arg1 op arg2) res_ty
; let doc = text "The first argument of ($) takes"
orig1 = lexprCtOrigin arg1
; (wrap_arg1, [arg2_sigma], op_res_ty) <-
- matchActualFunTys doc orig1 (Just (unLoc arg1)) 1 arg1_ty
+ matchActualFunTysRho doc orig1 (Just (unLoc arg1)) 1 arg1_ty
-- We have (arg1 $ arg2)
-- So: arg1_ty = arg2_ty -> op_res_ty
@@ -351,7 +376,7 @@ tcExpr expr@(OpApp fix arg1 op arg2) res_ty
(tcTypeKind arg2_sigma) liftedTypeKind
-- Ignore the evidence. arg2_sigma must have type * or #,
-- because we know (arg2_sigma -> op_res_ty) is well-kinded
- -- (because otherwise matchActualFunTys would fail)
+ -- (because otherwise matchActualFunTysRho would fail)
-- So this 'unifyKind' will either succeed with Refl, or will
-- produce an insoluble constraint * ~ #, which we'll report later.
@@ -385,7 +410,8 @@ tcExpr expr@(OpApp fix arg1 op arg2) res_ty
; (op', op_ty) <- tcInferRhoNC op
; (wrap_fun, [arg1_ty, arg2_ty], op_res_ty)
- <- matchActualFunTys (mk_op_msg op) fn_orig (Just (unLoc op)) 2 op_ty
+ <- matchActualFunTysRho (mk_op_msg op) fn_orig
+ (Just (unLoc op)) 2 op_ty
-- You might think we should use tcInferApp here, but there is
-- too much impedance-matching, because tcApp may return wrappers as
-- well as type-checked arguments.
@@ -405,12 +431,13 @@ tcExpr expr@(OpApp fix arg1 op arg2) res_ty
tcExpr expr@(SectionR x op arg2) res_ty
= do { (op', op_ty) <- tcInferRhoNC op
; (wrap_fun, [arg1_ty, arg2_ty], op_res_ty)
- <- matchActualFunTys (mk_op_msg op) fn_orig (Just (unLoc op)) 2 op_ty
- ; wrap_res <- tcSubTypeHR SectionOrigin (Just expr)
- (mkVisFunTy arg1_ty op_res_ty) res_ty
+ <- matchActualFunTysRho (mk_op_msg op) fn_orig
+ (Just (unLoc op)) 2 op_ty
; arg2' <- tcArg (unLoc op) arg2 arg2_ty 2
- ; return ( mkHsWrap wrap_res $
- SectionR x (mkLHsWrap wrap_fun op') arg2' ) }
+ ; let expr' = SectionR x (mkLHsWrap wrap_fun op') arg2'
+ act_res_ty = mkVisFunTy arg1_ty op_res_ty
+ ; tcWrapResultMono expr expr' act_res_ty res_ty }
+
where
fn_orig = lexprCtOrigin op
-- It's important to use the origin of 'op', so that call-stacks
@@ -424,13 +451,12 @@ tcExpr expr@(SectionL x arg1 op) res_ty
| otherwise = 2
; (wrap_fn, (arg1_ty:arg_tys), op_res_ty)
- <- matchActualFunTys (mk_op_msg op) fn_orig (Just (unLoc op))
- n_reqd_args op_ty
- ; wrap_res <- tcSubTypeHR SectionOrigin (Just expr)
- (mkVisFunTys arg_tys op_res_ty) res_ty
+ <- matchActualFunTysRho (mk_op_msg op) fn_orig
+ (Just (unLoc op)) n_reqd_args op_ty
; arg1' <- tcArg (unLoc op) arg1 arg1_ty 1
- ; return ( mkHsWrap wrap_res $
- SectionL x arg1' (mkLHsWrap wrap_fn op') ) }
+ ; let expr' = SectionL x arg1' (mkLHsWrap wrap_fn op')
+ act_res_ty = mkVisFunTys arg_tys op_res_ty
+ ; tcWrapResultMono expr expr' act_res_ty res_ty }
where
fn_orig = lexprCtOrigin op
-- It's important to use the origin of 'op', so that call-stacks
@@ -460,19 +486,19 @@ tcExpr expr@(ExplicitTuple x tup_args boxity) res_ty
; arg_tys <- case boxity of
{ Boxed -> newFlexiTyVarTys arity liftedTypeKind
; Unboxed -> replicateM arity newOpenFlexiTyVarTy }
- ; let actual_res_ty
- = mkVisFunTys [ty | (ty, (L _ (Missing _))) <- arg_tys `zip` tup_args]
- (mkTupleTy1 boxity arg_tys)
- -- See Note [Don't flatten tuples from HsSyn] in GHC.Core.Make
-
- ; wrap <- tcSubTypeHR (Shouldn'tHappenOrigin "ExpTuple")
- (Just expr)
- actual_res_ty res_ty
-- Handle tuple sections where
; tup_args1 <- tcTupArgs tup_args arg_tys
- ; return $ mkHsWrap wrap (ExplicitTuple x tup_args1 boxity) }
+ ; let expr' = ExplicitTuple x tup_args1 boxity
+ act_res_ty = mkVisFunTys [ty | (ty, (L _ (Missing _)))
+ <- arg_tys `zip` tup_args]
+ (mkTupleTy1 boxity arg_tys)
+ -- See Note [Don't flatten tuples from HsSyn] in GHC.Core.Make
+
+ ; traceTc "ExplicitTuple" (ppr act_res_ty $$ ppr res_ty)
+
+ ; tcWrapResultMono expr expr' act_res_ty res_ty }
tcExpr (ExplicitSum _ alt arity expr) res_ty
= do { let sum_tc = sumTyCon arity
@@ -480,7 +506,7 @@ tcExpr (ExplicitSum _ alt arity expr) res_ty
; (coi, arg_tys) <- matchExpectedTyConApp sum_tc res_ty
; -- Drop levity vars, we don't care about them here
let arg_tys' = drop arity arg_tys
- ; expr' <- tcCheckExpr expr (arg_tys' `getNth` (alt - 1))
+ ; expr' <- tcCheckPolyExpr expr (arg_tys' `getNth` (alt - 1))
; return $ mkHsWrapCo coi (ExplicitSum arg_tys' alt arity expr' ) }
-- This will see the empty list only when -XOverloadedLists.
@@ -502,7 +528,7 @@ tcExpr (ExplicitList _ witness exprs) res_ty
; return (exprs', elt_ty) }
; return $ ExplicitList elt_ty (Just fln') exprs' }
- where tc_elt elt_ty expr = tcCheckExpr expr elt_ty
+ where tc_elt elt_ty expr = tcCheckPolyExpr expr elt_ty
{-
************************************************************************
@@ -527,6 +553,13 @@ tcExpr (HsCase x scrut matches) res_ty
--
-- But now, in the GADT world, we need to typecheck the scrutinee
-- first, to get type info that may be refined in the case alternatives
+
+ -- Typecheck the scrutinee. We use tcInferRho but tcInferSigma
+ -- would also be possible (tcMatchesCase accepts sigma-types)
+ -- Interesting litmus test: do these two behave the same?
+ -- case id of {..}
+ -- case (\v -> v) of {..}
+ -- This design choice is discussed in #17790
(scrut', scrut_ty) <- tcInferRho scrut
; traceTc "HsCase" (ppr scrut_ty)
@@ -550,9 +583,9 @@ tcExpr (HsIf x fun@(SyntaxExprRn {}) pred b1 b2) res_ty
= do { ((pred', b1', b2'), fun')
<- tcSyntaxOp IfOrigin fun [SynAny, SynAny, SynAny] res_ty $
\ [pred_ty, b1_ty, b2_ty] ->
- do { pred' <- tcCheckExpr pred pred_ty
- ; b1' <- tcCheckExpr b1 b1_ty
- ; b2' <- tcCheckExpr b2 b2_ty
+ do { pred' <- tcCheckPolyExpr pred pred_ty
+ ; b1' <- tcCheckPolyExpr b1 b1_ty
+ ; b2' <- tcCheckPolyExpr b2 b2_ty
; return (pred', b1', b2') }
; return (HsIf x fun' pred' b1' b2') }
@@ -591,7 +624,7 @@ tcExpr (HsStatic fvs expr) res_ty
addErrCtxt (hang (text "In the body of a static form:")
2 (ppr expr)
) $
- tcCheckExprNC expr expr_ty
+ tcCheckPolyExprNC expr expr_ty
-- Check that the free variables of the static form are closed.
-- It's OK to use nonDetEltsUniqSet here as the only side effects of
@@ -637,25 +670,26 @@ tcExpr expr@(RecordCon { rcon_con_name = L loc con_name
; checkMissingFields con_like rbinds
; (con_expr, con_sigma) <- tcInferId con_name
- ; (con_wrap, con_tau) <-
- topInstantiate (OccurrenceOf con_name) con_sigma
+ ; (con_wrap, con_tau) <- topInstantiate orig con_sigma
-- a shallow instantiation should really be enough for
-- a data constructor.
; let arity = conLikeArity con_like
Right (arg_tys, actual_res_ty) = tcSplitFunTysN arity con_tau
- ; case conLikeWrapId_maybe con_like of
- Nothing -> nonBidirectionalErr (conLikeName con_like)
- Just con_id -> do {
- res_wrap <- tcSubTypeHR (Shouldn'tHappenOrigin "RecordCon")
- (Just expr) actual_res_ty res_ty
- ; rbinds' <- tcRecordBinds con_like arg_tys rbinds
- ; return $
- mkHsWrap res_wrap $
- RecordCon { rcon_ext = RecordConTc
- { rcon_con_like = con_like
- , rcon_con_expr = mkHsWrap con_wrap con_expr }
- , rcon_con_name = L loc con_id
- , rcon_flds = rbinds' } } }
+ ; case conLikeWrapId_maybe con_like of {
+ Nothing -> nonBidirectionalErr (conLikeName con_like) ;
+ Just con_id ->
+
+ do { rbinds' <- tcRecordBinds con_like arg_tys rbinds
+ ; let rcon_tc = RecordConTc
+ { rcon_con_like = con_like
+ , rcon_con_expr = mkHsWrap con_wrap con_expr }
+ expr' = RecordCon { rcon_ext = rcon_tc
+ , rcon_con_name = L loc con_id
+ , rcon_flds = rbinds' }
+
+ ; tcWrapResultMono expr expr' actual_res_ty res_ty } } }
+ where
+ orig = OccurrenceOf con_name
{-
Note [Type of a record update]
@@ -906,8 +940,6 @@ tcExpr expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = rbnds }) res_ty
scrut_ty = TcType.substTy scrut_subst con1_res_ty
con1_arg_tys' = map (TcType.substTy result_subst) con1_arg_tys
- ; wrap_res <- tcSubTypeHR (exprCtOrigin expr)
- (Just expr) rec_res_ty res_ty
; co_scrut <- unifyType (Just (unLoc record_expr)) record_rho scrut_ty
-- NB: normal unification is OK here (as opposed to subsumption),
-- because for this to work out, both record_rho and scrut_ty have
@@ -937,16 +969,16 @@ tcExpr expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = rbnds }) res_ty
; req_wrap <- instCallConstraints RecordUpdOrigin req_theta'
-- Phew!
- ; return $
- mkHsWrap wrap_res $
- RecordUpd { rupd_expr
- = mkLHsWrap fam_co (mkLHsWrapCo co_scrut record_expr')
- , rupd_flds = rbinds'
- , rupd_ext = RecordUpdTc
- { rupd_cons = relevant_cons
- , rupd_in_tys = scrut_inst_tys
- , rupd_out_tys = result_inst_tys
- , rupd_wrap = req_wrap }} }
+ ; let upd_tc = RecordUpdTc { rupd_cons = relevant_cons
+ , rupd_in_tys = scrut_inst_tys
+ , rupd_out_tys = result_inst_tys
+ , rupd_wrap = req_wrap }
+ expr' = RecordUpd { rupd_expr = mkLHsWrap fam_co $
+ mkLHsWrapCo co_scrut record_expr'
+ , rupd_flds = rbinds'
+ , rupd_ext = upd_tc }
+
+ ; tcWrapResult expr expr' rec_res_ty res_ty }
tcExpr e@(HsRecFld _ f) res_ty
= tcCheckRecSelId e f res_ty
@@ -1038,7 +1070,7 @@ tcArithSeq :: Maybe (SyntaxExpr GhcRn) -> ArithSeqInfo GhcRn -> ExpRhoType
tcArithSeq witness seq@(From expr) res_ty
= do { (wrap, elt_ty, wit') <- arithSeqEltType witness res_ty
- ; expr' <- tcCheckExpr expr elt_ty
+ ; expr' <- tcCheckPolyExpr expr elt_ty
; enum_from <- newMethodFromName (ArithSeqOrigin seq)
enumFromName [elt_ty]
; return $ mkHsWrap wrap $
@@ -1046,8 +1078,8 @@ tcArithSeq witness seq@(From expr) res_ty
tcArithSeq witness seq@(FromThen expr1 expr2) res_ty
= do { (wrap, elt_ty, wit') <- arithSeqEltType witness res_ty
- ; expr1' <- tcCheckExpr expr1 elt_ty
- ; expr2' <- tcCheckExpr expr2 elt_ty
+ ; expr1' <- tcCheckPolyExpr expr1 elt_ty
+ ; expr2' <- tcCheckPolyExpr expr2 elt_ty
; enum_from_then <- newMethodFromName (ArithSeqOrigin seq)
enumFromThenName [elt_ty]
; return $ mkHsWrap wrap $
@@ -1055,8 +1087,8 @@ tcArithSeq witness seq@(FromThen expr1 expr2) res_ty
tcArithSeq witness seq@(FromTo expr1 expr2) res_ty
= do { (wrap, elt_ty, wit') <- arithSeqEltType witness res_ty
- ; expr1' <- tcCheckExpr expr1 elt_ty
- ; expr2' <- tcCheckExpr expr2 elt_ty
+ ; expr1' <- tcCheckPolyExpr expr1 elt_ty
+ ; expr2' <- tcCheckPolyExpr expr2 elt_ty
; enum_from_to <- newMethodFromName (ArithSeqOrigin seq)
enumFromToName [elt_ty]
; return $ mkHsWrap wrap $
@@ -1064,9 +1096,9 @@ tcArithSeq witness seq@(FromTo expr1 expr2) res_ty
tcArithSeq witness seq@(FromThenTo expr1 expr2 expr3) res_ty
= do { (wrap, elt_ty, wit') <- arithSeqEltType witness res_ty
- ; expr1' <- tcCheckExpr expr1 elt_ty
- ; expr2' <- tcCheckExpr expr2 elt_ty
- ; expr3' <- tcCheckExpr expr3 elt_ty
+ ; expr1' <- tcCheckPolyExpr expr1 elt_ty
+ ; expr2' <- tcCheckPolyExpr expr2 elt_ty
+ ; expr3' <- tcCheckPolyExpr expr3 elt_ty
; eft <- newMethodFromName (ArithSeqOrigin seq)
enumFromThenToName [elt_ty]
; return $ mkHsWrap wrap $
@@ -1251,13 +1283,11 @@ tcInferApp expr
Nothing -> thing_inside -- Don't set the location twice
Just loc -> setSrcSpan loc thing_inside
----------------------
tcInferApp_finish
:: HsExpr GhcRn -- Renamed function
-> HsExpr GhcTc -> TcSigmaType -- Function and its type
-> [LHsExprArgIn] -- Arguments
-> TcM (HsExpr GhcTc, [LHsExprArgOut], TcSigmaType)
-
tcInferApp_finish rn_fun tc_fun fun_sigma rn_args
= do { (tc_args, actual_res_ty) <- tcArgs rn_fun fun_sigma rn_args
; return (tc_fun, tc_args, actual_res_ty) }
@@ -1364,9 +1394,9 @@ tcArgs fun orig_fun_ty orig_args
_ -> ty_app_err upsilon_ty hs_ty_arg }
go n so_far fun_ty (HsEValArg loc arg : args)
- = do { (wrap, [arg_ty], res_ty)
- <- matchActualFunTysPart herald fun_orig (Just fun)
- n_val_args so_far 1 fun_ty
+ = do { (wrap, arg_ty, res_ty)
+ <- matchActualFunTySigma herald fun_orig (Just fun)
+ (n_val_args, so_far) fun_ty
; arg' <- tcArg fun arg arg_ty n
; (args', inner_res_ty) <- go (n+1) (arg_ty:so_far) res_ty args
; return ( addArgWrap wrap $ HsEValArg loc arg' : args'
@@ -1465,13 +1495,12 @@ tcArg :: HsExpr GhcRn -- The function (for error messages)
-> Int -- # of argument
-> TcM (LHsExpr GhcTc) -- Resulting argument
tcArg fun arg ty arg_no
- = addErrCtxt (funAppCtxt fun arg arg_no) $
- do { traceTc "tcArg {" $
- vcat [ text "arg #" <> ppr arg_no <+> dcolon <+> ppr ty
- , text "arg:" <+> ppr arg ]
- ; arg' <- tcCheckExprNC arg ty
- ; traceTc "tcArg }" empty
- ; return arg' }
+ = addErrCtxt (funAppCtxt fun arg arg_no) $
+ do { traceTc "tcArg" $
+ vcat [ ppr arg_no <+> text "of" <+> ppr fun
+ , text "arg type:" <+> ppr ty
+ , text "arg:" <+> ppr arg ]
+ ; tcCheckPolyExprNC arg ty }
----------------
tcTupArgs :: [LHsTupArg GhcRn] -> [TcSigmaType] -> TcM [LHsTupArg GhcTc]
@@ -1479,7 +1508,7 @@ tcTupArgs args tys
= ASSERT( equalLength args tys ) mapM go (args `zip` tys)
where
go (L l (Missing {}), arg_ty) = return (L l (Missing arg_ty))
- go (L l (Present x expr), arg_ty) = do { expr' <- tcCheckExpr expr arg_ty
+ go (L l (Present x expr), arg_ty) = do { expr' <- tcCheckPolyExpr expr arg_ty
; return (L l (Present x expr')) }
---------------------------
@@ -1536,7 +1565,7 @@ tcSynArgE :: CtOrigin
-- ^ returns a wrapper :: (type of right shape) "->" (type passed in)
tcSynArgE orig sigma_ty syn_ty thing_inside
= do { (skol_wrap, (result, ty_wrapper))
- <- tcSkolemise GenSigCtxt sigma_ty $ \ _ rho_ty ->
+ <- tcSkolemise GenSigCtxt sigma_ty $ \ rho_ty ->
go rho_ty syn_ty
; return (result, skol_wrap <.> ty_wrapper) }
where
@@ -1554,11 +1583,11 @@ tcSynArgE orig sigma_ty syn_ty thing_inside
; return (result, mkWpCastN list_co) }
go rho_ty (SynFun arg_shape res_shape)
- = do { ( ( ( (result, arg_ty, res_ty)
- , res_wrapper ) -- :: res_ty_out "->" res_ty
- , arg_wrapper1, [], arg_wrapper2 ) -- :: arg_ty "->" arg_ty_out
- , match_wrapper ) -- :: (arg_ty -> res_ty) "->" rho_ty
- <- matchExpectedFunTys herald 1 (mkCheckExpType rho_ty) $
+ = do { ( match_wrapper -- :: (arg_ty -> res_ty) "->" rho_ty
+ , ( ( (result, arg_ty, res_ty)
+ , res_wrapper ) -- :: res_ty_out "->" res_ty
+ , arg_wrapper1, [], arg_wrapper2 ) ) -- :: arg_ty "->" arg_ty_out
+ <- matchExpectedFunTys herald GenSigCtxt 1 (mkCheckExpType rho_ty) $
\ [arg_ty] res_ty ->
do { arg_tc_ty <- expTypeToType arg_ty
; res_tc_ty <- expTypeToType res_ty
@@ -1604,7 +1633,8 @@ tcSynArgA :: CtOrigin
-- and a wrapper to be applied to the overall expression
tcSynArgA orig sigma_ty arg_shapes res_shape thing_inside
= do { (match_wrapper, arg_tys, res_ty)
- <- matchActualFunTys herald orig Nothing (length arg_shapes) sigma_ty
+ <- matchActualFunTysRho herald orig Nothing
+ (length arg_shapes) sigma_ty
-- match_wrapper :: sigma_ty "->" (arg_tys -> res_ty)
; ((result, res_wrapper), arg_wrappers)
<- tc_syn_args_e arg_tys arg_shapes $ \ arg_results ->
@@ -1634,7 +1664,7 @@ tcSynArgA orig sigma_ty arg_shapes res_shape thing_inside
= do { result <- thing_inside [res_ty]
; return (result, idHsWrapper) }
tc_syn_arg res_ty SynRho thing_inside
- = do { (inst_wrap, rho_ty) <- deeplyInstantiate orig res_ty
+ = do { (inst_wrap, rho_ty) <- topInstantiate orig res_ty
-- inst_wrap :: res_ty "->" rho_ty
; result <- thing_inside [rho_ty]
; return (result, inst_wrap) }
@@ -1648,7 +1678,7 @@ tcSynArgA orig sigma_ty arg_shapes res_shape thing_inside
tc_syn_arg _ (SynFun {}) _
= pprPanic "tcSynArgA hits a SynFun" (ppr orig)
tc_syn_arg res_ty (SynType the_ty) thing_inside
- = do { wrap <- tcSubTypeO orig GenSigCtxt res_ty the_ty
+ = do { wrap <- tcSubType orig GenSigCtxt res_ty the_ty
; result <- thing_inside []
; return (result, wrap) }
@@ -1687,22 +1717,10 @@ in the other order, the extra signature in f2 is reqd.
tcExprSig :: LHsExpr GhcRn -> TcIdSigInfo -> TcM (LHsExpr GhcTc, TcType)
tcExprSig expr (CompleteSig { sig_bndr = poly_id, sig_loc = loc })
= setSrcSpan loc $ -- Sets the location for the implication constraint
- do { (tv_prs, theta, tau) <- tcInstType tcInstSkolTyVars poly_id
- ; given <- newEvVars theta
- ; traceTc "tcExprSig: CompleteSig" $
- vcat [ text "poly_id:" <+> ppr poly_id <+> dcolon <+> ppr (idType poly_id)
- , text "tv_prs:" <+> ppr tv_prs ]
-
- ; let skol_info = SigSkol ExprSigCtxt (idType poly_id) tv_prs
- skol_tvs = map snd tv_prs
- ; (ev_binds, expr') <- checkConstraints skol_info skol_tvs given $
- tcExtendNameTyVarEnv tv_prs $
- tcCheckExprNC expr tau
-
- ; let poly_wrap = mkWpTyLams skol_tvs
- <.> mkWpLams given
- <.> mkWpLet ev_binds
- ; return (mkLHsWrap poly_wrap expr', idType poly_id) }
+ do { let poly_ty = idType poly_id
+ ; (wrap, expr') <- tcSkolemiseScoped ExprSigCtxt poly_ty $ \rho_ty ->
+ tcCheckMonoExprNC expr rho_ty
+ ; return (mkLHsWrap wrap expr', poly_ty) }
tcExprSig expr sig@(PartialSig { psig_name = name, sig_loc = loc })
= setSrcSpan loc $ -- Sets the location for the implication constraint
@@ -1711,7 +1729,7 @@ tcExprSig expr sig@(PartialSig { psig_name = name, sig_loc = loc })
do { sig_inst <- tcInstSig sig
; expr' <- tcExtendNameTyVarEnv (mapSnd binderVar $ sig_inst_skols sig_inst) $
tcExtendNameTyVarEnv (sig_inst_wcs sig_inst) $
- tcCheckExprNC expr (sig_inst_tau sig_inst)
+ tcCheckPolyExprNC expr (sig_inst_tau sig_inst)
; return (expr', sig_inst) }
-- See Note [Partial expression signatures]
; let tau = sig_inst_tau sig_inst
@@ -1735,7 +1753,7 @@ tcExprSig expr sig@(PartialSig { psig_name = name, sig_loc = loc })
then return idHsWrapper -- Fast path; also avoids complaint when we infer
-- an ambiguous type and have AllowAmbiguousType
-- e..g infer x :: forall a. F a -> Int
- else tcSubType_NC ExprSigCtxt inferred_sigma my_sigma
+ else tcSubTypeSigma ExprSigCtxt inferred_sigma my_sigma
; traceTc "tcExpSig" (ppr qtvs $$ ppr givens $$ ppr inferred_sigma $$ ppr my_sigma)
; let poly_wrap = wrap
@@ -2476,7 +2494,7 @@ tcRecordField :: ConLike -> Assoc Name Type
tcRecordField con_like flds_w_tys (L loc (FieldOcc sel_name lbl)) rhs
| Just field_ty <- assocMaybe flds_w_tys sel_name
= addErrCtxt (fieldCtxt field_lbl) $
- do { rhs' <- tcCheckExprNC rhs field_ty
+ do { rhs' <- tcCheckPolyExprNC rhs field_ty
; let field_id = mkUserLocal (nameOccName sel_name)
(nameUnique sel_name)
field_ty loc
@@ -2584,7 +2602,7 @@ addFunResCtxt has_args fun fun_res_ty env_ty
-- function types]
(_, _, fun_tau) = tcSplitNestedSigmaTys fun_res'
-- No need to call tcSplitNestedSigmaTys here, since env_ty is
- -- an ExpRhoTy, i.e., it's already deeply instantiated.
+ -- an ExpRhoTy, i.e., it's already instantiated.
(_, _, env_tau) = tcSplitSigmaTy env'
(args_fun, res_fun) = tcSplitFunTys fun_tau
(args_env, res_env) = tcSplitFunTys env_tau
diff --git a/compiler/GHC/Tc/Gen/Expr.hs-boot b/compiler/GHC/Tc/Gen/Expr.hs-boot
index d9138a4d7e..1f26ef242a 100644
--- a/compiler/GHC/Tc/Gen/Expr.hs-boot
+++ b/compiler/GHC/Tc/Gen/Expr.hs-boot
@@ -6,16 +6,26 @@ import GHC.Tc.Types ( TcM )
import GHC.Tc.Types.Origin ( CtOrigin )
import GHC.Hs.Extension ( GhcRn, GhcTcId )
-tcCheckExpr :: LHsExpr GhcRn -> TcSigmaType -> TcM (LHsExpr GhcTcId)
-
-tcLExpr, tcLExprNC
- :: LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTcId)
-tcExpr :: HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTcId)
-
-tcInferRho, tcInferRhoNC
- :: LHsExpr GhcRn-> TcM (LHsExpr GhcTcId, TcRhoType)
-
-tcInferSigma :: LHsExpr GhcRn-> TcM (LHsExpr GhcTcId, TcSigmaType)
+tcCheckPolyExpr ::
+ LHsExpr GhcRn
+ -> TcSigmaType
+ -> TcM (LHsExpr GhcTcId)
+
+tcMonoExpr, tcMonoExprNC ::
+ LHsExpr GhcRn
+ -> ExpRhoType
+ -> TcM (LHsExpr GhcTcId)
+tcCheckMonoExpr, tcCheckMonoExprNC ::
+ LHsExpr GhcRn
+ -> TcRhoType
+ -> TcM (LHsExpr GhcTcId)
+
+tcExpr :: HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTcId)
+
+tcInferSigma :: LHsExpr GhcRn -> TcM (LHsExpr GhcTcId, TcSigmaType)
+
+tcInferRho, tcInferRhoNC ::
+ LHsExpr GhcRn -> TcM (LHsExpr GhcTcId, TcRhoType)
tcSyntaxOp :: CtOrigin
-> SyntaxExprRn
diff --git a/compiler/GHC/Tc/Gen/Foreign.hs b/compiler/GHC/Tc/Gen/Foreign.hs
index 8163e6820d..06febcef33 100644
--- a/compiler/GHC/Tc/Gen/Foreign.hs
+++ b/compiler/GHC/Tc/Gen/Foreign.hs
@@ -388,7 +388,7 @@ tcFExport fo@(ForeignExport { fd_name = L loc nm, fd_sig_ty = hs_ty, fd_fe = spe
= addErrCtxt (foreignDeclCtxt fo) $ do
sig_ty <- tcHsSigType (ForSigCtxt nm) hs_ty
- rhs <- tcCheckExpr (nlHsVar nm) sig_ty
+ rhs <- tcCheckPolyExpr (nlHsVar nm) sig_ty
(norm_co, norm_sig_ty, gres) <- normaliseFfiType sig_ty
diff --git a/compiler/GHC/Tc/Gen/HsType.hs b/compiler/GHC/Tc/Gen/HsType.hs
index cdbaab115b..1cd4e27c8d 100644
--- a/compiler/GHC/Tc/Gen/HsType.hs
+++ b/compiler/GHC/Tc/Gen/HsType.hs
@@ -31,8 +31,8 @@ module GHC.Tc.Gen.HsType (
bindExplicitTKBndrs_Q_Tv, bindExplicitTKBndrs_Q_Skol,
ContextKind(..),
- -- Type checking type and class decls
- bindTyClTyVars,
+ -- Type checking type and class decls, and instances thereof
+ bindTyClTyVars, tcFamTyPats,
etaExpandAlgTyCon, tcbVisibilities,
-- tyvars
@@ -46,13 +46,11 @@ module GHC.Tc.Gen.HsType (
tcNamedWildCardBinders,
tcHsLiftedType, tcHsOpenType,
tcHsLiftedTypeNC, tcHsOpenTypeNC,
- tcLHsType, tcLHsTypeUnsaturated, tcCheckLHsType,
- tcHsMbContext, tcHsContext, tcLHsPredType, tcInferApps,
+ tcInferLHsType, tcInferLHsTypeUnsaturated, tcCheckLHsType,
+ tcHsMbContext, tcHsContext, tcLHsPredType,
failIfEmitsConstraints,
solveEqualities, -- useful re-export
- typeLevelMode, kindLevelMode,
-
kindGeneralizeAll, kindGeneralizeSome, kindGeneralizeNone,
-- Sort-checking kinds
@@ -115,6 +113,7 @@ import GHC.Driver.Session
import qualified GHC.LanguageExtensions as LangExt
import GHC.Data.Maybe
+import GHC.Data.Bag( unitBag )
import Data.List ( find )
import Control.Monad
@@ -159,6 +158,91 @@ checking until step (3).
Check types AND do validity checking
* *
************************************************************************
+
+Note [Keeping implicitly quantified variables in order]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+When the user implicitly quantifies over variables (say, in a type
+signature), we need to come up with some ordering on these variables.
+This is done by bumping the TcLevel, bringing the tyvars into scope,
+and then type-checking the thing_inside. The constraints are all
+wrapped in an implication, which is then solved. Finally, we can
+zonk all the binders and then order them with scopedSort.
+
+It's critical to solve before zonking and ordering in order to uncover
+any unifications. You might worry that this eager solving could cause
+trouble elsewhere. I don't think it will. Because it will solve only
+in an increased TcLevel, it can't unify anything that was mentioned
+elsewhere. Additionally, we require that the order of implicitly
+quantified variables is manifest by the scope of these variables, so
+we're not going to learn more information later that will help order
+these variables.
+
+Note [Recipe for checking a signature]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Checking a user-written signature requires several steps:
+
+ 1. Generate constraints.
+ 2. Solve constraints.
+ 3. Promote tyvars and/or kind-generalize.
+ 4. Zonk.
+ 5. Check validity.
+
+There may be some surprises in here:
+
+Step 2 is necessary for two reasons: most signatures also bring
+implicitly quantified variables into scope, and solving is necessary
+to get these in the right order (see Note [Keeping implicitly
+quantified variables in order]). Additionally, solving is necessary in
+order to kind-generalize correctly: otherwise, we do not know which
+metavariables are left unsolved.
+
+Step 3 is done by a call to candidateQTyVarsOfType, followed by a call to
+kindGeneralize{All,Some,None}. Here, we have to deal with the fact that
+metatyvars generated in the type may have a bumped TcLevel, because explicit
+foralls raise the TcLevel. To avoid these variables from ever being visible in
+the surrounding context, we must obey the following dictum:
+
+ Every metavariable in a type must either be
+ (A) generalized, or
+ (B) promoted, or See Note [Promotion in signatures]
+ (C) a cause to error See Note [Naughty quantification candidates] in GHC.Tc.Utils.TcMType
+
+The kindGeneralize functions do not require pre-zonking; they zonk as they
+go.
+
+If you are actually doing kind-generalization, you need to bump the level
+before generating constraints, as we will only generalize variables with
+a TcLevel higher than the ambient one.
+
+After promoting/generalizing, we need to zonk again because both
+promoting and generalizing fill in metavariables.
+
+Note [Promotion in signatures]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+If an unsolved metavariable in a signature is not generalized
+(because we're not generalizing the construct -- e.g., pattern
+sig -- or because the metavars are constrained -- see kindGeneralizeSome)
+we need to promote to maintain (WantedTvInv) of Note [TcLevel and untouchable type variables]
+in GHC.Tc.Utils.TcType. Note that promotion is identical in effect to generalizing
+and the reinstantiating with a fresh metavariable at the current level.
+So in some sense, we generalize *all* variables, but then re-instantiate
+some of them.
+
+Here is an example of why we must promote:
+ foo (x :: forall a. a -> Proxy b) = ...
+
+In the pattern signature, `b` is unbound, and will thus be brought into
+scope. We do not know its kind: it will be assigned kappa[2]. Note that
+kappa is at TcLevel 2, because it is invented under a forall. (A priori,
+the kind kappa might depend on `a`, so kappa rightly has a higher TcLevel
+than the surrounding context.) This kappa cannot be solved for while checking
+the pattern signature (which is not kind-generalized). When we are checking
+the *body* of foo, though, we need to unify the type of x with the argument
+type of bar. At this point, the ambient TcLevel is 1, and spotting a
+matavariable with level 2 would violate the (WantedTvInv) invariant of
+Note [TcLevel and untouchable type variables]. So, instead of kind-generalizing,
+we promote the metavariable to level 1. This is all done in kindGeneralizeNone.
+
-}
funsSigCtxt :: [Located Name] -> UserTypeCtxt
@@ -213,19 +297,21 @@ kcClassSigType skol_info names (HsIB { hsib_ext = sig_vars
<- pushTcLevelM $
solveLocalEqualitiesX "kcClassSigType" $
bindImplicitTKBndrs_Skol sig_vars $
- tc_lhs_type typeLevelMode hs_ty liftedTypeKind
+ tcLHsType hs_ty liftedTypeKind
- ; emitResidualTvConstraint skol_info Nothing spec_tkvs
- tc_lvl wanted }
+ ; emitResidualTvConstraint skol_info spec_tkvs tc_lvl wanted }
tcClassSigType :: SkolemInfo -> [Located Name] -> LHsSigType GhcRn -> TcM Type
-- Does not do validity checking
tcClassSigType skol_info names sig_ty
= addSigCtxt (funsSigCtxt names) (hsSigType sig_ty) $
- snd <$> tc_hs_sig_type skol_info sig_ty (TheKind liftedTypeKind)
+ do { (implic, ty) <- tc_hs_sig_type skol_info sig_ty (TheKind liftedTypeKind)
+ ; emitImplication implic
+ ; return ty }
-- Do not zonk-to-Type, nor perform a validity check
-- We are in a knot with the class and associated types
-- Zonking and validity checking is done by tcClassDecl
+ --
-- No need to fail here if the type has an error:
-- If we're in the kind-checking phase, the solveEqualities
-- in kcTyClGroup catches the error
@@ -247,46 +333,36 @@ tcHsSigType ctxt sig_ty
do { traceTc "tcHsSigType {" (ppr sig_ty)
-- Generalise here: see Note [Kind generalisation]
- ; (insol, ty) <- tc_hs_sig_type skol_info sig_ty
- (expectedKindInCtxt ctxt)
- ; ty <- zonkTcType ty
+ ; (implic, ty) <- tc_hs_sig_type skol_info sig_ty (expectedKindInCtxt ctxt)
- ; when insol failM
- -- See Note [Fail fast if there are insoluble kind equalities] in GHC.Tc.Solver
+ -- Spit out the implication (and perhaps fail fast)
+ -- See Note [Failure in local type signatures] in GHC.Tc.Solver
+ ; emitFlatConstraints (mkImplicWC (unitBag implic))
+ ; ty <- zonkTcType ty
; checkValidType ctxt ty
; traceTc "end tcHsSigType }" (ppr ty)
; return ty }
where
skol_info = SigTypeSkol ctxt
--- Does validity checking and zonking.
-tcStandaloneKindSig :: LStandaloneKindSig GhcRn -> TcM (Name, Kind)
-tcStandaloneKindSig (L _ kisig) = case kisig of
- StandaloneKindSig _ (L _ name) ksig ->
- let ctxt = StandaloneKindSigCtxt name in
- addSigCtxt ctxt (hsSigType ksig) $
- do { kind <- tcTopLHsType kindLevelMode ksig (expectedKindInCtxt ctxt)
- ; checkValidType ctxt kind
- ; return (name, kind) }
-
tc_hs_sig_type :: SkolemInfo -> LHsSigType GhcRn
- -> ContextKind -> TcM (Bool, TcType)
+ -> ContextKind -> TcM (Implication, TcType)
-- Kind-checks/desugars an 'LHsSigType',
-- solve equalities,
-- and then kind-generalizes.
-- This will never emit constraints, as it uses solveEqualities internally.
-- No validity checking or zonking
--- Returns also a Bool indicating whether the type induced an insoluble constraint;
--- True <=> constraint is insoluble
+-- Returns also an implication for the unsolved constraints
tc_hs_sig_type skol_info hs_sig_type ctxt_kind
| HsIB { hsib_ext = sig_vars, hsib_body = hs_ty } <- hs_sig_type
= do { (tc_lvl, (wanted, (spec_tkvs, ty)))
<- pushTcLevelM $
solveLocalEqualitiesX "tc_hs_sig_type" $
+ -- See Note [Failure in local type signatures]
bindImplicitTKBndrs_Skol sig_vars $
do { kind <- newExpectedKind ctxt_kind
- ; tc_lhs_type typeLevelMode hs_ty kind }
+ ; tcLHsType hs_ty kind }
-- Any remaining variables (unsolved in the solveLocalEqualities)
-- should be in the global tyvars, and therefore won't be quantified
@@ -301,18 +377,67 @@ tc_hs_sig_type skol_info hs_sig_type ctxt_kind
; let should_gen = not . (`elemVarSet` constrained)
; kvs <- kindGeneralizeSome should_gen ty1
- ; emitResidualTvConstraint skol_info Nothing (kvs ++ spec_tkvs)
- tc_lvl wanted
- ; return (insolubleWC wanted, mkInfForAllTys kvs ty1) }
+ -- Build an implication for any as-yet-unsolved kind equalities
+ -- See Note [Skolem escape in type signatures]
+ ; implic <- buildTvImplication skol_info (kvs ++ spec_tkvs) tc_lvl wanted
+
+ ; return (implic, mkInfForAllTys kvs ty1) }
+
+{- Note [Skolem escape in type signatures]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+tcHsSigType is tricky. Consider (T11142)
+ foo :: forall b. (forall k (a :: k). SameKind a b) -> ()
+This is ill-kinded becuase of a nested skolem-escape.
+
+That will show up as an un-solvable constraint in the implication
+returned by buildTvImplication in tc_hs_sig_type. See Note [Skolem
+escape prevention] in GHC.Tc.Utils.TcType for why it is unsolvable
+(the unification variable for b's kind is untouchable).
+
+Then, in GHC.Tc.Solver.emitFlatConstraints (called from tcHsSigType)
+we'll try to float out the constraint, be unable to do so, and fail.
+See GHC.Tc.Solver Note [Failure in local type signatures] for more
+detail on this.
+
+The separation between tcHsSigType and tc_hs_sig_type is because
+tcClassSigType wants to use the latter, but *not* fail fast, because
+there are skolems from the class decl which are in scope; but it's fine
+not to because tcClassDecl1 has a solveEqualities wrapped around all
+the tcClassSigType calls.
+
+That's why tcHsSigType does emitFlatConstraints (which fails fast) but
+tcClassSigType just does emitImplication (which does not). Ugh.
+
+c.f. see also Note [Skolem escape and forall-types]. The difference
+is that we don't need to simplify at a forall type, only at the
+top level of a signature.
+-}
+
+-- Does validity checking and zonking.
+tcStandaloneKindSig :: LStandaloneKindSig GhcRn -> TcM (Name, Kind)
+tcStandaloneKindSig (L _ kisig) = case kisig of
+ StandaloneKindSig _ (L _ name) ksig ->
+ let ctxt = StandaloneKindSigCtxt name in
+ addSigCtxt ctxt (hsSigType ksig) $
+ do { let mode = mkMode KindLevel
+ ; kind <- tc_top_lhs_type mode ksig (expectedKindInCtxt ctxt)
+ ; checkValidType ctxt kind
+ ; return (name, kind) }
+
-tcTopLHsType :: TcTyMode -> LHsSigType GhcRn -> ContextKind -> TcM Type
+tcTopLHsType :: LHsSigType GhcRn -> ContextKind -> TcM Type
+tcTopLHsType hs_ty ctxt_kind
+ = tc_top_lhs_type (mkMode TypeLevel) hs_ty ctxt_kind
+
+tc_top_lhs_type :: TcTyMode -> LHsSigType GhcRn -> ContextKind -> TcM Type
-- tcTopLHsType is used for kind-checking top-level HsType where
-- we want to fully solve /all/ equalities, and report errors
-- Does zonking, but not validity checking because it's used
-- for things (like deriving and instances) that aren't
-- ordinary types
-tcTopLHsType mode hs_sig_type ctxt_kind
+-- Used for both types and kinds
+tc_top_lhs_type mode hs_sig_type ctxt_kind
| HsIB { hsib_ext = sig_vars, hsib_body = hs_ty } <- hs_sig_type
= do { traceTc "tcTopLHsType {" (ppr hs_ty)
; (spec_tkvs, ty)
@@ -340,7 +465,7 @@ tcHsDeriv :: LHsSigType GhcRn -> TcM ([TyVar], Class, [Type], [Kind])
tcHsDeriv hs_ty
= do { ty <- checkNoErrs $ -- Avoid redundant error report
-- with "illegal deriving", below
- tcTopLHsType typeLevelMode hs_ty AnyKind
+ tcTopLHsType hs_ty AnyKind
; let (tvs, pred) = splitForAllTys ty
(kind_args, _) = splitFunTys (tcTypeKind pred)
; case getClassPredTys_maybe pred of
@@ -369,7 +494,7 @@ tcDerivStrategy mb_lds
tc_deriv_strategy AnyclassStrategy = boring_case AnyclassStrategy
tc_deriv_strategy NewtypeStrategy = boring_case NewtypeStrategy
tc_deriv_strategy (ViaStrategy ty) = do
- ty' <- checkNoErrs $ tcTopLHsType typeLevelMode ty AnyKind
+ ty' <- checkNoErrs $ tcTopLHsType ty AnyKind
let (via_tvs, via_pred) = splitForAllTys ty'
pure (ViaStrategy via_pred, via_tvs)
@@ -387,7 +512,7 @@ tcHsClsInstType user_ctxt hs_inst_ty
-- eagerly avoids follow-on errors when checkValidInstance
-- sees an unsolved coercion hole
inst_ty <- checkNoErrs $
- tcTopLHsType typeLevelMode hs_inst_ty (TheKind constraintKind)
+ tcTopLHsType hs_inst_ty (TheKind constraintKind)
; checkValidInstance user_ctxt hs_inst_ty inst_ty
; return inst_ty }
@@ -397,14 +522,15 @@ tcHsTypeApp :: LHsWcType GhcRn -> Kind -> TcM Type
-- See Note [Recipe for checking a signature] in GHC.Tc.Gen.HsType
tcHsTypeApp wc_ty kind
| HsWC { hswc_ext = sig_wcs, hswc_body = hs_ty } <- wc_ty
- = do { ty <- solveLocalEqualities "tcHsTypeApp" $
+ = do { mode <- mkHoleMode TypeLevel HM_VTA
+ -- HM_VTA: See Note [Wildcards in visible type application]
+ ; ty <- addTypeCtxt hs_ty $
+ solveLocalEqualities "tcHsTypeApp" $
-- We are looking at a user-written type, very like a
-- signature so we want to solve its equalities right now
- unsetWOptM Opt_WarnPartialTypeSignatures $
- setXOptM LangExt.PartialTypeSignatures $
- -- See Note [Wildcards in visible type application]
tcNamedWildCardBinders sig_wcs $ \ _ ->
- tcCheckLHsType hs_ty (TheKind kind)
+ tc_lhs_type mode hs_ty kind
+
-- We do not kind-generalize type applications: we just
-- instantiate with exactly what the user says.
-- See Note [No generalization in type application]
@@ -448,6 +574,31 @@ There is also the possibility of mentioning a wildcard
-}
+tcFamTyPats :: TyCon
+ -> HsTyPats GhcRn -- Patterns
+ -> TcM (TcType, TcKind) -- (lhs_type, lhs_kind)
+-- Check the LHS of a type/data family instance
+-- e.g. type instance F ty1 .. tyn = ...
+-- Used for both type and data families
+tcFamTyPats fam_tc hs_pats
+ = do { traceTc "tcFamTyPats {" $
+ vcat [ ppr fam_tc, text "arity:" <+> ppr fam_arity ]
+
+ ; mode <- mkHoleMode TypeLevel HM_FamPat
+ -- HM_FamPat: See Note [Wildcards in family instances] in
+ -- GHC.Rename.Module
+ ; let fun_ty = mkTyConApp fam_tc []
+ ; (fam_app, res_kind) <- tcInferTyApps mode lhs_fun fun_ty hs_pats
+
+ ; traceTc "End tcFamTyPats }" $
+ vcat [ ppr fam_tc, text "res_kind:" <+> ppr res_kind ]
+
+ ; return (fam_app, res_kind) }
+ where
+ fam_name = tyConName fam_tc
+ fam_arity = tyConArity fam_tc
+ lhs_fun = noLoc (HsTyVar noExtField NotPromoted (noLoc fam_name))
+
{-
************************************************************************
* *
@@ -465,38 +616,38 @@ tcHsOpenType ty = addTypeCtxt ty $ tcHsOpenTypeNC ty
tcHsLiftedType ty = addTypeCtxt ty $ tcHsLiftedTypeNC ty
tcHsOpenTypeNC ty = do { ek <- newOpenTypeKind
- ; tc_lhs_type typeLevelMode ty ek }
-tcHsLiftedTypeNC ty = tc_lhs_type typeLevelMode ty liftedTypeKind
+ ; tcLHsType ty ek }
+tcHsLiftedTypeNC ty = tcLHsType ty liftedTypeKind
-- Like tcHsType, but takes an expected kind
tcCheckLHsType :: LHsType GhcRn -> ContextKind -> TcM TcType
tcCheckLHsType hs_ty exp_kind
= addTypeCtxt hs_ty $
do { ek <- newExpectedKind exp_kind
- ; tc_lhs_type typeLevelMode hs_ty ek }
+ ; tcLHsType hs_ty ek }
-tcLHsType :: LHsType GhcRn -> TcM (TcType, TcKind)
+tcInferLHsType :: LHsType GhcRn -> TcM TcType
-- Called from outside: set the context
-tcLHsType ty = addTypeCtxt ty (tc_infer_lhs_type typeLevelMode ty)
-
--- Like tcLHsType, but use it in a context where type synonyms and type families
--- do not need to be saturated, like in a GHCi :kind call
-tcLHsTypeUnsaturated :: LHsType GhcRn -> TcM (TcType, TcKind)
-tcLHsTypeUnsaturated hs_ty
- | Just (hs_fun_ty, hs_args) <- splitHsAppTys (unLoc hs_ty)
+tcInferLHsType hs_ty
= addTypeCtxt hs_ty $
- do { (fun_ty, _ki) <- tcInferAppHead mode hs_fun_ty
- ; tcInferApps_nosat mode hs_fun_ty fun_ty hs_args }
- -- Notice the 'nosat'; do not instantiate trailing
- -- invisible arguments of a type family.
- -- See Note [Dealing with :kind]
+ do { (ty, _kind) <- tc_infer_lhs_type (mkMode TypeLevel) hs_ty
+ ; return ty }
- | otherwise
+-- Used to check the argument of GHCi :kind
+-- Allow and report wildcards, e.g. :kind T _
+-- Do not saturate family applications: see Note [Dealing with :kind]
+tcInferLHsTypeUnsaturated :: LHsType GhcRn -> TcM (TcType, TcKind)
+tcInferLHsTypeUnsaturated hs_ty
= addTypeCtxt hs_ty $
- tc_infer_lhs_type mode hs_ty
-
- where
- mode = typeLevelMode
+ do { mode <- mkHoleMode TypeLevel HM_Sig -- Allow and report holes
+ ; case splitHsAppTys (unLoc hs_ty) of
+ Just (hs_fun_ty, hs_args)
+ -> do { (fun_ty, _ki) <- tcInferTyAppHead mode hs_fun_ty
+ ; tcInferTyApps_nosat mode hs_fun_ty fun_ty hs_args }
+ -- Notice the 'nosat'; do not instantiate trailing
+ -- invisible arguments of a type family.
+ -- See Note [Dealing with :kind]
+ Nothing -> tc_infer_lhs_type mode hs_ty }
{- Note [Dealing with :kind]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -507,7 +658,7 @@ Consider this GHCi command
We will only get the 'forall' if we /refrain/ from saturating those
invisible binders. But generally we /do/ saturate those invisible
-binders (see tcInferApps), and we want to do so for nested application
+binders (see tcInferTyApps), and we want to do so for nested application
even in GHCi. Consider for example (#16287)
ghci> type family F :: k
ghci> data T :: (forall k. k) -> Type
@@ -515,7 +666,7 @@ even in GHCi. Consider for example (#16287)
We want to reject this. It's just at the very top level that we want
to switch off saturation.
-So tcLHsTypeUnsaturated does a little special case for top level
+So tcInferLHsTypeUnsaturated does a little special case for top level
applications. Actually the common case is a bare variable, as above.
@@ -538,21 +689,46 @@ concern things that the renamer can't handle.
-- grow, at least to include the distinction between patterns and
-- not-patterns.
--
--- To find out where the mode is used, search for 'mode_level'
-data TcTyMode = TcTyMode { mode_level :: TypeOrKind }
-
-typeLevelMode :: TcTyMode
-typeLevelMode = TcTyMode { mode_level = TypeLevel }
-
-kindLevelMode :: TcTyMode
-kindLevelMode = TcTyMode { mode_level = KindLevel }
+-- To find out where the mode is used, search for 'mode_tyki'
+--
+-- This data type is purely local, not exported from this module
+data TcTyMode
+ = TcTyMode { mode_tyki :: TypeOrKind
+
+ -- See Note [Levels for wildcards]
+ -- Nothing <=> no wildcards expected
+ , mode_holes :: Maybe (TcLevel, HoleMode)
+ }
+
+-- HoleMode says how to treat the occurrences
+-- of anonymous wildcards; see tcAnonWildCardOcc
+data HoleMode = HM_Sig -- Partial type signatures: f :: _ -> Int
+ | HM_FamPat -- Family instances: F _ Int = Bool
+ | HM_VTA -- Visible type and kind application:
+ -- f @(Maybe _)
+ -- Maybe @(_ -> _)
+
+mkMode :: TypeOrKind -> TcTyMode
+mkMode tyki = TcTyMode { mode_tyki = tyki, mode_holes = Nothing }
+
+mkHoleMode :: TypeOrKind -> HoleMode -> TcM TcTyMode
+mkHoleMode tyki hm
+ = do { lvl <- getTcLevel
+ ; return (TcTyMode { mode_tyki = tyki
+ , mode_holes = Just (lvl,hm) }) }
--- switch to kind level
kindLevel :: TcTyMode -> TcTyMode
-kindLevel mode = mode { mode_level = KindLevel }
+kindLevel mode = mode { mode_tyki = KindLevel }
+
+instance Outputable HoleMode where
+ ppr HM_Sig = text "HM_Sig"
+ ppr HM_FamPat = text "HM_FamPat"
+ ppr HM_VTA = text "HM_VTA"
instance Outputable TcTyMode where
- ppr = ppr . mode_level
+ ppr (TcTyMode { mode_tyki = tyki, mode_holes = hm })
+ = text "TcTyMode" <+> braces (sep [ ppr tyki <> comma
+ , ppr hm ])
{-
Note [Bidirectional type checking]
@@ -627,11 +803,12 @@ tc_infer_hs_type mode (HsParTy _ t)
tc_infer_hs_type mode ty
| Just (hs_fun_ty, hs_args) <- splitHsAppTys ty
- = do { (fun_ty, _ki) <- tcInferAppHead mode hs_fun_ty
- ; tcInferApps mode hs_fun_ty fun_ty hs_args }
+ = do { (fun_ty, _ki) <- tcInferTyAppHead mode hs_fun_ty
+ ; tcInferTyApps mode hs_fun_ty fun_ty hs_args }
tc_infer_hs_type mode (HsKindSig _ ty sig)
- = do { sig' <- tcLHsKindSig KindSigCtxt sig
+ = do { let mode' = mode { mode_tyki = KindLevel }
+ ; sig' <- tc_lhs_kind_sig mode' KindSigCtxt sig
-- We must typecheck the kind signature, and solve all
-- its equalities etc; from this point on we may do
-- things like instantiate its foralls, so it needs
@@ -665,6 +842,10 @@ tc_infer_hs_type mode other_ty
; return (ty', kv) }
------------------------------------------
+tcLHsType :: LHsType GhcRn -> TcKind -> TcM TcType
+tcLHsType hs_ty exp_kind
+ = tc_lhs_type (mkMode TypeLevel) hs_ty exp_kind
+
tc_lhs_type :: TcTyMode -> LHsType GhcRn -> TcKind -> TcM TcType
tc_lhs_type mode (L span ty) exp_kind
= setSrcSpan span $
@@ -718,18 +899,25 @@ tc_hs_type mode (HsOpTy _ ty1 (L _ op) ty2) exp_kind
tc_hs_type mode forall@(HsForAllTy { hst_fvf = fvf, hst_bndrs = hs_tvs
, hst_body = ty }) exp_kind
= do { (tclvl, wanted, (inv_tv_bndrs, ty'))
- <- pushLevelAndCaptureConstraints $
- bindExplicitTKBndrs_Skol hs_tvs $
+ <- pushLevelAndCaptureConstraints $
+ bindExplicitTKBndrs_Skol_M mode hs_tvs $
+ -- The _M variant passes on the mode from the type, to
+ -- any wildards in kind signatures on the forall'd variables
+ -- e.g. f :: _ -> Int -> forall (a :: _). blah
tc_lhs_type mode ty exp_kind
- -- Do not kind-generalise here! See Note [Kind generalisation]
- -- Why exp_kind? See Note [Body kind of HsForAllTy]
- ; let skol_info = ForAllSkol (ppr forall)
- m_telescope = Just (sep (map ppr hs_tvs))
+ -- Why exp_kind? See Note [Body kind of HsForAllTy]
- ; tv_bndrs <- mapM construct_bndr inv_tv_bndrs
+ -- Do not kind-generalise here! See Note [Kind generalisation]
- ; emitResidualTvConstraint skol_info m_telescope (binderVars tv_bndrs) tclvl wanted
+ ; let skol_info = ForAllSkol (ppr forall) (sep (map ppr hs_tvs))
+ skol_tvs = binderVars inv_tv_bndrs
+ ; implic <- buildTvImplication skol_info skol_tvs tclvl wanted
+ ; emitImplication implic
+ -- /Always/ emit this implication even if wanted is empty
+ -- We need the implication so that we check for a bad telescope
+ -- See Note [Skolem escape and forall-types]
+ ; tv_bndrs <- mapM construct_bndr inv_tv_bndrs
; return (mkForAllTys tv_bndrs ty') }
where
construct_bndr :: TcInvisTVBinder -> TcM TcTyVarBinder
@@ -846,7 +1034,7 @@ tc_hs_type mode rn_ty@(HsExplicitTupleTy _ tys) exp_kind
--------- Constraint types
tc_hs_type mode rn_ty@(HsIParamTy _ (L _ n) ty) exp_kind
- = do { MASSERT( isTypeLevel (mode_level mode) )
+ = do { MASSERT( isTypeLevel (mode_tyki mode) )
; ty' <- tc_lhs_type mode ty liftedTypeKind
; let n' = mkStrLitTy $ hsIPNameFS n
; ipClass <- tcLookupClass ipClassName
@@ -875,7 +1063,7 @@ tc_hs_type mode ty@(HsAppKindTy{}) ek = tc_infer_hs_type_ek mode ty ek
tc_hs_type mode ty@(HsOpTy {}) ek = tc_infer_hs_type_ek mode ty ek
tc_hs_type mode ty@(HsKindSig {}) ek = tc_infer_hs_type_ek mode ty ek
tc_hs_type mode ty@(XHsType (NHsCoreTy{})) ek = tc_infer_hs_type_ek mode ty ek
-tc_hs_type _ wc@(HsWildCardTy _) ek = tcAnonWildCardOcc wc ek
+tc_hs_type mode ty@(HsWildCardTy _) ek = tcAnonWildCardOcc mode ty ek
{-
Note [Variable Specificity and Forall Visibility]
@@ -903,7 +1091,7 @@ Note [VarBndrs, TyCoVarBinders, TyConBinders, and visibility] in TyCoRep.
------------------------------------------
tc_fun_type :: TcTyMode -> LHsType GhcRn -> LHsType GhcRn -> TcKind
-> TcM TcType
-tc_fun_type mode ty1 ty2 exp_kind = case mode_level mode of
+tc_fun_type mode ty1 ty2 exp_kind = case mode_tyki mode of
TypeLevel ->
do { arg_k <- newOpenTypeKind
; res_k <- newOpenTypeKind
@@ -917,46 +1105,10 @@ tc_fun_type mode ty1 ty2 exp_kind = case mode_level mode of
; checkExpectedKind (HsFunTy noExtField ty1 ty2) (mkVisFunTy ty1' ty2')
liftedTypeKind exp_kind }
----------------------------
-tcAnonWildCardOcc :: HsType GhcRn -> Kind -> TcM TcType
-tcAnonWildCardOcc wc exp_kind
- = do { wc_tv <- newWildTyVar -- The wildcard's kind will be an un-filled-in meta tyvar
-
- ; part_tysig <- xoptM LangExt.PartialTypeSignatures
- ; warning <- woptM Opt_WarnPartialTypeSignatures
-
- ; unless (part_tysig && not warning) $
- emitAnonTypeHole wc_tv
- -- Why the 'unless' guard?
- -- See Note [Wildcards in visible kind application]
-
- ; checkExpectedKind wc (mkTyVarTy wc_tv)
- (tyVarKind wc_tv) exp_kind }
-
-{- Note [Wildcards in visible kind application]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-There are cases where users might want to pass in a wildcard as a visible kind
-argument, for instance:
-
-data T :: forall k1 k2. k1 → k2 → Type where
- MkT :: T a b
-x :: T @_ @Nat False n
-x = MkT
-
-So we should allow '@_' without emitting any hole constraints, and
-regardless of whether PartialTypeSignatures is enabled or not. But how would
-the typechecker know which '_' is being used in VKA and which is not when it
-calls emitNamedTypeHole in tcHsPartialSigType on all HsWildCardBndrs?
-The solution then is to neither rename nor include unnamed wildcards in HsWildCardBndrs,
-but instead give every anonymous wildcard a fresh wild tyvar in tcAnonWildCardOcc.
-And whenever we see a '@', we automatically turn on PartialTypeSignatures and
-turn off hole constraint warnings, and do not call emitAnonTypeHole
-under these conditions.
-See related Note [Wildcards in visible type application] here and
-Note [The wildcard story for types] in GHC.Hs.Type
+{- Note [Skolem escape and forall-types]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+See also Note [Checking telescopes].
-Note [Skolem escape and forall-types]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider
f :: forall a. (forall kb (b :: kb). Proxy '[a, b]) -> ()
@@ -970,11 +1122,19 @@ 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
+buildTvImplication/emitImplication 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.
+Note that
+
+* We don't need to /simplify/ the constraints here
+ because we aren't generalising. We just capture them.
+
+* We can't use emitResidualTvConstraint, because that has a fast-path
+ for empty constraints. We can't take that fast path here, because
+ we must do the bad-telescope check even if there are no inner wanted
+ constraints. See Note [Checking telescopes] in
+ GHC.Tc.Types.Constraint. Lacking this check led to #16247.
-}
{- *********************************************************************
@@ -1117,14 +1277,14 @@ splitHsAppTys hs_ty
go f as = (f, as)
---------------------------
-tcInferAppHead :: TcTyMode -> LHsType GhcRn -> TcM (TcType, TcKind)
+tcInferTyAppHead :: TcTyMode -> LHsType GhcRn -> TcM (TcType, TcKind)
-- Version of tc_infer_lhs_type specialised for the head of an
-- application. In particular, for a HsTyVar (which includes type
--- constructors, it does not zoom off into tcInferApps and family
+-- constructors, it does not zoom off into tcInferTyApps and family
-- saturation
-tcInferAppHead mode (L _ (HsTyVar _ _ (L _ tv)))
+tcInferTyAppHead mode (L _ (HsTyVar _ _ (L _ tv)))
= tcTyVar mode tv
-tcInferAppHead mode ty
+tcInferTyAppHead mode ty
= tc_infer_lhs_type mode ty
---------------------------
@@ -1135,24 +1295,24 @@ tcInferAppHead mode ty
-- These kinds should be used to instantiate invisible kind variables;
-- they come from an enclosing class for an associated type/data family.
--
--- tcInferApps also arranges to saturate any trailing invisible arguments
+-- tcInferTyApps also arranges to saturate any trailing invisible arguments
-- of a type-family application, which is usually the right thing to do
--- tcInferApps_nosat does not do this saturation; it is used only
+-- tcInferTyApps_nosat does not do this saturation; it is used only
-- by ":kind" in GHCi
-tcInferApps, tcInferApps_nosat
+tcInferTyApps, tcInferTyApps_nosat
:: TcTyMode
-> LHsType GhcRn -- ^ Function (for printing only)
-> TcType -- ^ Function
-> [LHsTypeArg GhcRn] -- ^ Args
-> TcM (TcType, TcKind) -- ^ (f args, args, result kind)
-tcInferApps mode hs_ty fun hs_args
- = do { (f_args, res_k) <- tcInferApps_nosat mode hs_ty fun hs_args
+tcInferTyApps mode hs_ty fun hs_args
+ = do { (f_args, res_k) <- tcInferTyApps_nosat mode hs_ty fun hs_args
; saturateFamApp f_args res_k }
-tcInferApps_nosat mode orig_hs_ty fun orig_hs_args
- = do { traceTc "tcInferApps {" (ppr orig_hs_ty $$ ppr orig_hs_args)
+tcInferTyApps_nosat mode orig_hs_ty fun orig_hs_args
+ = do { traceTc "tcInferTyApps {" (ppr orig_hs_ty $$ ppr orig_hs_args)
; (f_args, res_k) <- go_init 1 fun orig_hs_args
- ; traceTc "tcInferApps }" (ppr f_args <+> dcolon <+> ppr res_k)
+ ; traceTc "tcInferTyApps }" (ppr f_args <+> dcolon <+> ppr res_k)
; return (f_args, res_k) }
where
@@ -1205,21 +1365,18 @@ tcInferApps_nosat mode orig_hs_ty fun orig_hs_args
Anon InvisArg _ -> instantiate ki_binder inner_ki
Named (Bndr _ Specified) -> -- Visible kind application
- do { traceTc "tcInferApps (vis kind app)"
+ do { traceTc "tcInferTyApps (vis kind app)"
(vcat [ ppr ki_binder, ppr hs_ki_arg
, ppr (tyBinderType ki_binder)
, ppr subst ])
; let exp_kind = substTy subst $ tyBinderType ki_binder
-
+ ; arg_mode <- mkHoleMode KindLevel HM_VTA
+ -- HM_VKA: see Note [Wildcards in visible kind application]
; ki_arg <- addErrCtxt (funAppCtxt orig_hs_ty hs_ki_arg n) $
- unsetWOptM Opt_WarnPartialTypeSignatures $
- setXOptM LangExt.PartialTypeSignatures $
- -- Urgh! see Note [Wildcards in visible kind application]
- -- ToDo: must kill this ridiculous messing with DynFlags
- tc_lhs_type (kindLevel mode) hs_ki_arg exp_kind
+ tc_lhs_type arg_mode hs_ki_arg exp_kind
- ; traceTc "tcInferApps (vis kind app)" (ppr exp_kind)
+ ; traceTc "tcInferTyApps (vis kind app)" (ppr exp_kind)
; (subst', fun') <- mkAppTyM subst fun ki_binder ki_arg
; go (n+1) fun' subst' inner_ki hs_args }
@@ -1241,7 +1398,7 @@ tcInferApps_nosat mode orig_hs_ty fun orig_hs_args
-- "normal" case
| otherwise
- -> do { traceTc "tcInferApps (vis normal app)"
+ -> do { traceTc "tcInferTyApps (vis normal app)"
(vcat [ ppr ki_binder
, ppr arg
, ppr (tyBinderType ki_binder)
@@ -1249,7 +1406,7 @@ tcInferApps_nosat mode orig_hs_ty fun orig_hs_args
; let exp_kind = substTy subst $ tyBinderType ki_binder
; arg' <- addErrCtxt (funAppCtxt orig_hs_ty arg n) $
tc_lhs_type mode arg exp_kind
- ; traceTc "tcInferApps (vis normal app) 2" (ppr exp_kind)
+ ; traceTc "tcInferTyApps (vis normal app) 2" (ppr exp_kind)
; (subst', fun') <- mkAppTyM subst fun ki_binder arg'
; go (n+1) fun' subst' inner_ki args }
@@ -1263,7 +1420,7 @@ tcInferApps_nosat mode orig_hs_ty fun orig_hs_args
-- This zonk is essential, to expose the fruits
-- of matchExpectedFunKind to the 'go' loop
- ; traceTc "tcInferApps (no binder)" $
+ ; traceTc "tcInferTyApps (no binder)" $
vcat [ ppr fun <+> dcolon <+> ppr fun_ki
, ppr arrows_needed
, ppr co
@@ -1272,7 +1429,7 @@ tcInferApps_nosat mode orig_hs_ty fun orig_hs_args
-- Use go_init to establish go's INVARIANT
where
instantiate ki_binder inner_ki
- = do { traceTc "tcInferApps (need to instantiate)"
+ = do { traceTc "tcInferTyApps (need to instantiate)"
(vcat [ ppr ki_binder, ppr subst])
; (subst', arg') <- tcInstInvisibleTyBinder subst ki_binder
; go n (mkAppTy fun arg') subst' inner_ki all_args }
@@ -1375,7 +1532,7 @@ The way in which tcTypeKind can crash is in applications
if 'a' is a type variable whose kind doesn't have enough arrows
or foralls. (The crash is in piResultTys.)
-The loop in tcInferApps has to be very careful to maintain the (PKTI).
+The loop in tcInferTyApps has to be very careful to maintain the (PKTI).
For example, suppose
kappa is a unification variable
We have already unified kappa := Type
@@ -1387,7 +1544,7 @@ If we call tcTypeKind on that, we'll crash, because the (un-zonked)
kind of 'a' is just kappa, not an arrow kind. So we must zonk first.
So the type inference engine is very careful when building applications.
-This happens in tcInferApps. Suppose we are kind-checking the type (a Int),
+This happens in tcInferTyApps. Suppose we are kind-checking the type (a Int),
where (a :: kappa). Then in tcInferApps we'll run out of binders on
a's kind, so we'll call matchExpectedFunKind, and unify
kappa := kappa1 -> kappa2, with evidence co :: kappa ~ (kappa1 ~ kappa2)
@@ -1530,10 +1687,10 @@ tcHsMbContext Nothing = return []
tcHsMbContext (Just cxt) = tcHsContext cxt
tcHsContext :: LHsContext GhcRn -> TcM [PredType]
-tcHsContext = tc_hs_context typeLevelMode
+tcHsContext cxt = tc_hs_context (mkMode TypeLevel) cxt
tcLHsPredType :: LHsType GhcRn -> TcM PredType
-tcLHsPredType = tc_lhs_pred typeLevelMode
+tcLHsPredType pred = tc_lhs_pred (mkMode TypeLevel) pred
tc_hs_context :: TcTyMode -> LHsContext GhcRn -> TcM [PredType]
tc_hs_context mode ctxt = mapM (tc_lhs_pred mode) (unLoc ctxt)
@@ -1553,7 +1710,7 @@ tcTyVar mode name -- Could be a tyvar, a tycon, or a datacon
ATcTyCon tc_tc
-> do { -- See Note [GADT kind self-reference]
- unless (isTypeLevel (mode_level mode))
+ unless (isTypeLevel (mode_tyki mode))
(promotionErr name TyConPE)
; check_tc tc_tc
; return (mkTyConTy tc_tc, tyConKind tc_tc) }
@@ -1584,7 +1741,7 @@ tcTyVar mode name -- Could be a tyvar, a tycon, or a datacon
where
check_tc :: TyCon -> TcM ()
check_tc tc = do { data_kinds <- xoptM LangExt.DataKinds
- ; unless (isTypeLevel (mode_level mode) ||
+ ; unless (isTypeLevel (mode_tyki mode) ||
data_kinds ||
isKindTyCon tc) $
promotionErr name NoDataKindsTC }
@@ -1731,8 +1888,6 @@ in the e2 example, we'll desugar the type, zonking the kind unification
variables as we go. When we encounter the unconstrained kappa, we
want to default it to '*', not to (Any *).
-Help functions for type applications
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-}
addTypeCtxt :: LHsType GhcRn -> TcM a -> TcM a
@@ -1744,98 +1899,12 @@ addTypeCtxt (L _ ty) thing
where
doc = text "In the type" <+> quotes (ppr ty)
-{-
-************************************************************************
+
+{- *********************************************************************
* *
Type-variable binders
-%* *
-%************************************************************************
-
-Note [Keeping implicitly quantified variables in order]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-When the user implicitly quantifies over variables (say, in a type
-signature), we need to come up with some ordering on these variables.
-This is done by bumping the TcLevel, bringing the tyvars into scope,
-and then type-checking the thing_inside. The constraints are all
-wrapped in an implication, which is then solved. Finally, we can
-zonk all the binders and then order them with scopedSort.
-
-It's critical to solve before zonking and ordering in order to uncover
-any unifications. You might worry that this eager solving could cause
-trouble elsewhere. I don't think it will. Because it will solve only
-in an increased TcLevel, it can't unify anything that was mentioned
-elsewhere. Additionally, we require that the order of implicitly
-quantified variables is manifest by the scope of these variables, so
-we're not going to learn more information later that will help order
-these variables.
-
-Note [Recipe for checking a signature]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Checking a user-written signature requires several steps:
-
- 1. Generate constraints.
- 2. Solve constraints.
- 3. Promote tyvars and/or kind-generalize.
- 4. Zonk.
- 5. Check validity.
-
-There may be some surprises in here:
-
-Step 2 is necessary for two reasons: most signatures also bring
-implicitly quantified variables into scope, and solving is necessary
-to get these in the right order (see Note [Keeping implicitly
-quantified variables in order]). Additionally, solving is necessary in
-order to kind-generalize correctly: otherwise, we do not know which
-metavariables are left unsolved.
-
-Step 3 is done by a call to candidateQTyVarsOfType, followed by a call to
-kindGeneralize{All,Some,None}. Here, we have to deal with the fact that
-metatyvars generated in the type may have a bumped TcLevel, because explicit
-foralls raise the TcLevel. To avoid these variables from ever being visible in
-the surrounding context, we must obey the following dictum:
-
- Every metavariable in a type must either be
- (A) generalized, or
- (B) promoted, or See Note [Promotion in signatures]
- (C) a cause to error See Note [Naughty quantification candidates] in GHC.Tc.Utils.TcMType
-
-The kindGeneralize functions do not require pre-zonking; they zonk as they
-go.
-
-If you are actually doing kind-generalization, you need to bump the level
-before generating constraints, as we will only generalize variables with
-a TcLevel higher than the ambient one.
-
-After promoting/generalizing, we need to zonk again because both
-promoting and generalizing fill in metavariables.
-
-Note [Promotion in signatures]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-If an unsolved metavariable in a signature is not generalized
-(because we're not generalizing the construct -- e.g., pattern
-sig -- or because the metavars are constrained -- see kindGeneralizeSome)
-we need to promote to maintain (WantedTvInv) of Note [TcLevel and untouchable type variables]
-in GHC.Tc.Utils.TcType. Note that promotion is identical in effect to generalizing
-and the reinstantiating with a fresh metavariable at the current level.
-So in some sense, we generalize *all* variables, but then re-instantiate
-some of them.
-
-Here is an example of why we must promote:
- foo (x :: forall a. a -> Proxy b) = ...
-
-In the pattern signature, `b` is unbound, and will thus be brought into
-scope. We do not know its kind: it will be assigned kappa[2]. Note that
-kappa is at TcLevel 2, because it is invented under a forall. (A priori,
-the kind kappa might depend on `a`, so kappa rightly has a higher TcLevel
-than the surrounding context.) This kappa cannot be solved for while checking
-the pattern signature (which is not kind-generalized). When we are checking
-the *body* of foo, though, we need to unify the type of x with the argument
-type of bar. At this point, the ambient TcLevel is 1, and spotting a
-matavariable with level 2 would violate the (WantedTvInv) invariant of
-Note [TcLevel and untouchable type variables]. So, instead of kind-generalizing,
-we promote the metavariable to level 1. This is all done in kindGeneralizeNone.
-
--}
+* *
+********************************************************************* -}
tcNamedWildCardBinders :: [Name]
-> ([(Name, TcTyVar)] -> TcM a)
@@ -1844,22 +1913,119 @@ tcNamedWildCardBinders :: [Name]
-- plain wildcards _ are anonymous and dealt with by HsWildCardTy
-- Soe Note [The wildcard story for types] in GHC.Hs.Type
tcNamedWildCardBinders wc_names thing_inside
- = do { wcs <- mapM (const newWildTyVar) wc_names
+ = do { wcs <- mapM newNamedWildTyVar wc_names
; let wc_prs = wc_names `zip` wcs
; tcExtendNameTyVarEnv wc_prs $
thing_inside wc_prs }
-newWildTyVar :: TcM TcTyVar
+newNamedWildTyVar :: Name -> TcM TcTyVar
-- ^ New unification variable '_' for a wildcard
-newWildTyVar
+newNamedWildTyVar _name -- Currently ignoring the "_x" wildcard name used in the type
= do { kind <- newMetaKindVar
- ; uniq <- newUnique
; details <- newMetaDetails TauTv
- ; let name = mkSysTvName uniq (fsLit "_")
- tyvar = mkTcTyVar name kind details
+ ; wc_name <- newMetaTyVarName (fsLit "w") -- See Note [Wildcard names]
+ ; let tyvar = mkTcTyVar wc_name kind details
; traceTc "newWildTyVar" (ppr tyvar)
; return tyvar }
+---------------------------
+tcAnonWildCardOcc :: TcTyMode -> HsType GhcRn -> Kind -> TcM TcType
+tcAnonWildCardOcc (TcTyMode { mode_holes = Just (hole_lvl, hole_mode) })
+ ty exp_kind
+ -- hole_lvl: see Note [Checking partial type signatures]
+ -- esp the bullet on nested forall types
+ = do { kv_details <- newTauTvDetailsAtLevel hole_lvl
+ ; kv_name <- newMetaTyVarName (fsLit "k")
+ ; wc_details <- newTauTvDetailsAtLevel hole_lvl
+ ; wc_name <- newMetaTyVarName (fsLit wc_nm)
+ ; let kv = mkTcTyVar kv_name liftedTypeKind kv_details
+ wc_kind = mkTyVarTy kv
+ wc_tv = mkTcTyVar wc_name wc_kind wc_details
+
+ ; traceTc "tcAnonWildCardOcc" (ppr hole_lvl <+> ppr emit_holes)
+ ; when emit_holes $
+ emitAnonTypeHole wc_tv
+ -- Why the 'when' guard?
+ -- See Note [Wildcards in visible kind application]
+
+ -- You might think that this would always just unify
+ -- wc_kind with exp_kind, so we could avoid even creating kv
+ -- But the level numbers might not allow that unification,
+ -- so we have to do it properly (T14140a)
+ ; checkExpectedKind ty (mkTyVarTy wc_tv) wc_kind exp_kind }
+ where
+ -- See Note [Wildcard names]
+ wc_nm = case hole_mode of
+ HM_Sig -> "w"
+ HM_FamPat -> "_"
+ HM_VTA -> "w"
+
+ emit_holes = case hole_mode of
+ HM_Sig -> True
+ HM_FamPat -> False
+ HM_VTA -> False
+
+tcAnonWildCardOcc mode ty _
+-- mode_holes is Nothing. Should not happen, because renamer
+-- should already have rejected holes in unexpected places
+ = pprPanic "tcWildCardOcc" (ppr mode $$ ppr ty)
+
+{- Note [Wildcard names]
+~~~~~~~~~~~~~~~~~~~~~~~~
+So we hackily use the mode_holes flag to control the name used
+for wildcards:
+
+* For proper holes (whether in a visible type application (VTA) or no),
+ we rename the '_' to 'w'. This is so that we see variables like 'w0'
+ or 'w1' in error messages, a vast improvement upon '_0' and '_1'. For
+ example, we prefer
+ Found type wildcard ‘_’ standing for ‘w0’
+ over
+ Found type wildcard ‘_’ standing for ‘_1’
+
+ Even in the VTA case, where we do not emit an error to be printed, we
+ want to do the renaming, as the variables may appear in other,
+ non-wildcard error messages.
+
+* However, holes in the left-hand sides of type families ("type
+ patterns") stand for type variables which we do not care to name --
+ much like the use of an underscore in an ordinary term-level
+ pattern. When we spot these, we neither wish to generate an error
+ message nor to rename the variable. We don't rename the variable so
+ that we can pretty-print a type family LHS as, e.g.,
+ F _ Int _ = ...
+ and not
+ F w1 Int w2 = ...
+
+ See also Note [Wildcards in family instances] in
+ GHC.Rename.Module. The choice of HM_FamPat is made in
+ tcFamTyPats. There is also some unsavory magic, relying on that
+ underscore, in GHC.Core.Coercion.tidyCoAxBndrsForUser.
+
+Note [Wildcards in visible kind application]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+There are cases where users might want to pass in a wildcard as a visible kind
+argument, for instance:
+
+data T :: forall k1 k2. k1 → k2 → Type where
+ MkT :: T a b
+x :: T @_ @Nat False n
+x = MkT
+
+So we should allow '@_' without emitting any hole constraints, and
+regardless of whether PartialTypeSignatures is enabled or not. But how
+would the typechecker know which '_' is being used in VKA and which is
+not when it calls emitNamedTypeHole in
+tcHsPartialSigType on all HsWildCardBndrs? The solution is to neither
+rename nor include unnamed wildcards in HsWildCardBndrs, but instead
+give every anonymous wildcard a fresh wild tyvar in tcAnonWildCardOcc.
+
+And whenever we see a '@', we set mode_holes to HM_VKA, so that
+we do not call emitAnonTypeHole in tcAnonWildCardOcc.
+See related Note [Wildcards in visible type application] here and
+Note [The wildcard story for types] in GHC.Hs.Type
+-}
+
{- *********************************************************************
* *
Kind inference for type declarations
@@ -2703,8 +2869,17 @@ bindExplicitTKBndrs_Skol, bindExplicitTKBndrs_Tv
-> TcM a
-> TcM ([VarBndr TyVar flag], a)
-bindExplicitTKBndrs_Skol = bindExplicitTKBndrsX (tcHsTyVarBndr newSkolemTyVar)
-bindExplicitTKBndrs_Tv = bindExplicitTKBndrsX (tcHsTyVarBndr cloneTyVarTyVar)
+bindExplicitTKBndrs_Skol_M, bindExplicitTKBndrs_Tv_M
+ :: (OutputableBndrFlag flag)
+ => TcTyMode
+ -> [LHsTyVarBndr flag GhcRn]
+ -> TcM a
+ -> TcM ([VarBndr TyVar flag], a)
+
+bindExplicitTKBndrs_Skol = bindExplicitTKBndrsX (tcHsTyVarBndr (mkMode KindLevel) newSkolemTyVar)
+bindExplicitTKBndrs_Skol_M mode = bindExplicitTKBndrsX (tcHsTyVarBndr (kindLevel mode) newSkolemTyVar)
+bindExplicitTKBndrs_Tv = bindExplicitTKBndrsX (tcHsTyVarBndr (mkMode KindLevel) cloneTyVarTyVar)
+bindExplicitTKBndrs_Tv_M mode = bindExplicitTKBndrsX (tcHsTyVarBndr (kindLevel mode) cloneTyVarTyVar)
-- newSkolemTyVar: see Note [Non-cloning for tyvar binders]
-- cloneTyVarTyVar: see Note [Cloning for tyvar binders]
@@ -2752,13 +2927,13 @@ bindExplicitTKBndrsX tc_tv hs_tvs thing_inside
; return ((Bndr tv (hsTyVarBndrFlag hs_tv)):tvs, res) }
-----------------
-tcHsTyVarBndr :: (Name -> Kind -> TcM TyVar)
+tcHsTyVarBndr :: TcTyMode -> (Name -> Kind -> TcM TyVar)
-> HsTyVarBndr flag GhcRn -> TcM TcTyVar
-tcHsTyVarBndr new_tv (UserTyVar _ _ (L _ tv_nm))
+tcHsTyVarBndr _ new_tv (UserTyVar _ _ (L _ tv_nm))
= do { kind <- newMetaKindVar
; new_tv tv_nm kind }
-tcHsTyVarBndr new_tv (KindedTyVar _ _ (L _ tv_nm) lhs_kind)
- = do { kind <- tcLHsKindSig (TyVarBndrKindCtxt tv_nm) lhs_kind
+tcHsTyVarBndr mode new_tv (KindedTyVar _ _ (L _ tv_nm) lhs_kind)
+ = do { kind <- tc_lhs_kind_sig mode (TyVarBndrKindCtxt tv_nm) lhs_kind
; new_tv tv_nm kind }
-----------------
@@ -2861,15 +3036,14 @@ kindGeneralizeSome should_gen kind_or_type
; let (to_promote, dvs') = partitionCandidates dvs (not . should_gen)
- ; (_, promoted) <- promoteTyVarSet (dVarSetToVarSet to_promote)
+ ; _ <- promoteTyVarSet to_promote
; qkvs <- quantifyTyVars dvs'
; traceTc "kindGeneralizeSome }" $
vcat [ text "Kind or type:" <+> ppr kind_or_type
, text "dvs:" <+> ppr dvs
, text "dvs':" <+> ppr dvs'
- , text "to_promote:" <+> pprTyVars (dVarSetElems to_promote)
- , text "promoted:" <+> pprTyVars (nonDetEltsUniqSet promoted)
+ , text "to_promote:" <+> ppr to_promote
, text "qkvs:" <+> pprTyVars qkvs ]
; return qkvs }
@@ -3046,6 +3220,7 @@ data DataSort
checkDataKindSig :: DataSort -> Kind -> TcM ()
checkDataKindSig data_sort kind = do
dflags <- getDynFlags
+ traceTc "checkDataKindSig" (ppr kind)
checkTc (is_TYPE_or_Type dflags || is_kind_var) (err_msg dflags)
where
pp_dec :: SDoc
@@ -3211,19 +3386,20 @@ tcHsPartialSigType ctxt sig_ty
, hsib_body = hs_ty } <- ib_ty
, (explicit_hs_tvs, L _ hs_ctxt, hs_tau) <- splitLHsSigmaTyInvis hs_ty
= addSigCtxt ctxt hs_ty $
- do { (implicit_tvs, (explicit_tvbndrs, (wcs, wcx, theta, tau)))
+ do { mode <- mkHoleMode TypeLevel HM_Sig
+ ; (implicit_tvs, (explicit_tvbndrs, (wcs, wcx, theta, tau)))
<- solveLocalEqualities "tcHsPartialSigType" $
- -- This solveLocalEqualiltes fails fast if there are
- -- insoluble equalities. See GHC.Tc.Solver
- -- Note [Fail fast if there are insoluble kind equalities]
+ -- See Note [Failure in local type signatures]
tcNamedWildCardBinders sig_wcs $ \ wcs ->
- bindImplicitTKBndrs_Tv implicit_hs_tvs $
- bindExplicitTKBndrs_Tv explicit_hs_tvs $
+ bindImplicitTKBndrs_Tv implicit_hs_tvs $
+ bindExplicitTKBndrs_Tv_M mode explicit_hs_tvs $
do { -- Instantiate the type-class context; but if there
-- is an extra-constraints wildcard, just discard it here
- (theta, wcx) <- tcPartialContext hs_ctxt
+ (theta, wcx) <- tcPartialContext mode hs_ctxt
- ; tau <- tcHsOpenType hs_tau
+ ; ek <- newOpenTypeKind
+ ; tau <- addTypeCtxt hs_tau $
+ tc_lhs_type mode hs_tau ek
; return (wcs, wcx, theta, tau) }
@@ -3241,10 +3417,12 @@ tcHsPartialSigType ctxt sig_ty
; mapM_ emitNamedTypeHole wcs
-- Zonk, so that any nested foralls can "see" their occurrences
- -- See Note [Checking partial type signatures], in
- -- the bullet on Nested foralls.
- ; theta <- mapM zonkTcType theta
- ; tau <- zonkTcType tau
+ -- See Note [Checking partial type signatures], and in particular
+ -- Note [Levels for wildcards]
+ ; implicit_tvbndrs <- mapM zonkInvisTVBinder implicit_tvbndrs
+ ; explicit_tvbndrs <- mapM zonkInvisTVBinder explicit_tvbndrs
+ ; theta <- mapM zonkTcType theta
+ ; tau <- zonkTcType tau
-- We return a proper (Name,InvisTVBinder) environment, to be sure that
-- we bring the right name into scope in the function body.
@@ -3259,16 +3437,16 @@ tcHsPartialSigType ctxt sig_ty
; traceTc "tcHsPartialSigType" (ppr tv_prs)
; return (wcs, wcx, tv_prs, theta, tau) }
-tcPartialContext :: HsContext GhcRn -> TcM (TcThetaType, Maybe TcType)
-tcPartialContext hs_theta
+tcPartialContext :: TcTyMode -> HsContext GhcRn -> TcM (TcThetaType, Maybe TcType)
+tcPartialContext mode hs_theta
| Just (hs_theta1, hs_ctxt_last) <- snocView hs_theta
- , L wc_loc wc@(HsWildCardTy _) <- ignoreParens hs_ctxt_last
+ , L wc_loc ty@(HsWildCardTy _) <- ignoreParens hs_ctxt_last
= do { wc_tv_ty <- setSrcSpan wc_loc $
- tcAnonWildCardOcc wc constraintKind
- ; theta <- mapM tcLHsPredType hs_theta1
+ tcAnonWildCardOcc mode ty constraintKind
+ ; theta <- mapM (tc_lhs_pred mode) hs_theta1
; return (theta, Just wc_tv_ty) }
| otherwise
- = do { theta <- mapM tcLHsPredType hs_theta
+ = do { theta <- mapM (tc_lhs_pred mode) hs_theta
; return (theta, Nothing) }
{- Note [Checking partial type signatures]
@@ -3312,29 +3490,48 @@ we do the following
g x = True
It's really as if we'd written two distinct signatures.
-* 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
+* Nested foralls. See Note [Levels for wildcards]
+
+* Just as for ordinary signatures, we must solve local equalities and
+ 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 [Levels for wildcards]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider
+ f :: forall b. (forall a. a -> _) -> b
+We do /not/ allow the "_" to be instantiated to 'a'; although we do
+(as before) allow it to be instantiated to the (top level) 'b'.
+Why not? Suppose
+ f x = (x True, x 'c')
+
+During typecking the RHS we must instantiate that (forall a. a -> _),
+so we must know /precisely/ where all the a's are; they must not be
+hidden under (possibly-not-yet-filled-in) unification variables!
+
+We achieve this as follows:
+
+- For /named/ wildcards such sas
+ g :: forall b. (forall la. a -> _x) -> b
+ there is no problem: we create them at the outer level (ie the
+ ambient level of teh signature itself), and push the level when we
+ go inside a forall. So now the unification variable for the "_x"
+ can't unify with skolem 'a'.
+
+- For /anonymous/ wildcards, such as 'f' above, we carry the ambient
+ level of the signature to the hole in the TcLevel part of the
+ mode_holes field of TcTyMode. Then, in tcAnonWildCardOcc we us that
+ level (and /not/ the level ambient at the occurrence of "_") to
+ create the unification variable for the wildcard. That is the sole
+ purpose of the TcLevel in the mode_holes field: to transport the
+ ambient level of the signature down to the anonymous wildcard
+ occurrences.
+
Note [Extra-constraint holes in partial type signatures]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider
@@ -3399,14 +3596,16 @@ tcHsPatSigType ctxt
, hsps_body = hs_ty })
= addSigCtxt ctxt hs_ty $
do { sig_tkv_prs <- mapM new_implicit_tv sig_ns
+ ; mode <- mkHoleMode TypeLevel HM_Sig
; (wcs, sig_ty)
- <- solveLocalEqualities "tcHsPatSigType" $
- -- Always solve local equalities if possible,
- -- else casts get in the way of deep skolemisation
- -- (#16033)
+ <- addTypeCtxt hs_ty $
+ solveLocalEqualities "tcHsPatSigType" $
+ -- See Note [Failure in local type signatures]
+ -- and c.f #16033
tcNamedWildCardBinders sig_wcs $ \ wcs ->
tcExtendNameTyVarEnv sig_tkv_prs $
- do { sig_ty <- tcHsOpenType hs_ty
+ do { ek <- newOpenTypeKind
+ ; sig_ty <- tc_lhs_type mode hs_ty ek
; return (wcs, sig_ty) }
; mapM_ emitNamedTypeHole wcs
@@ -3509,10 +3708,15 @@ It does sort checking and desugaring at the same time, in one single pass.
tcLHsKindSig :: UserTypeCtxt -> LHsKind GhcRn -> TcM Kind
tcLHsKindSig ctxt hs_kind
+ = tc_lhs_kind_sig (mkMode KindLevel) ctxt hs_kind
+
+tc_lhs_kind_sig :: TcTyMode -> UserTypeCtxt -> LHsKind GhcRn -> TcM Kind
+tc_lhs_kind_sig mode ctxt hs_kind
-- See Note [Recipe for checking a signature] in GHC.Tc.Gen.HsType
-- Result is zonked
- = do { kind <- solveLocalEqualities "tcLHsKindSig" $
- tc_lhs_kind kindLevelMode hs_kind
+ = do { kind <- addErrCtxt (text "In the kind" <+> quotes (ppr hs_kind)) $
+ solveLocalEqualities "tcLHsKindSig" $
+ tc_lhs_type mode hs_kind liftedTypeKind
; traceTc "tcLHsKindSig" (ppr hs_kind $$ ppr kind)
-- No generalization:
; kindGeneralizeNone kind
@@ -3528,11 +3732,6 @@ tcLHsKindSig ctxt hs_kind
; traceTc "tcLHsKindSig2" (ppr kind)
; return kind }
-tc_lhs_kind :: TcTyMode -> LHsKind GhcRn -> TcM Kind
-tc_lhs_kind mode k
- = addErrCtxt (text "In the kind" <+> quotes (ppr k)) $
- tc_lhs_type (kindLevel mode) k liftedTypeKind
-
promotionErr :: Name -> PromotionErr -> TcM a
promotionErr name err
= failWithTc (hang (pprPECategory err <+> quotes (ppr name) <+> text "cannot be used here")
diff --git a/compiler/GHC/Tc/Gen/Match.hs b/compiler/GHC/Tc/Gen/Match.hs
index 350be10236..b9eaad4adb 100644
--- a/compiler/GHC/Tc/Gen/Match.hs
+++ b/compiler/GHC/Tc/Gen/Match.hs
@@ -36,9 +36,10 @@ where
import GHC.Prelude
-import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcSyntaxOp, tcInferRhoNC, tcInferRho
- , tcCheckId, tcLExpr, tcLExprNC, tcExpr
- , tcCheckExpr )
+import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcSyntaxOp, tcInferRho, tcInferRhoNC
+ , tcMonoExpr, tcMonoExprNC, tcExpr
+ , tcCheckMonoExpr, tcCheckMonoExprNC
+ , tcCheckPolyExpr, tcCheckId )
import GHC.Types.Basic (LexicalFixity(..))
import GHC.Hs
@@ -79,17 +80,11 @@ import Control.Arrow ( second )
@FunMonoBind@. The second argument is the name of the function, which
is used in error messages. It checks that all the equations have the
same number of arguments before using @tcMatches@ to do the work.
-
-Note [Polymorphic expected type for tcMatchesFun]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-tcMatchesFun may be given a *sigma* (polymorphic) type
-so it must be prepared to use tcSkolemise to skolemise it.
-See Note [sig_tau may be polymorphic] in GHC.Tc.Gen.Pat.
-}
tcMatchesFun :: Located Name
-> MatchGroup GhcRn (LHsExpr GhcRn)
- -> ExpSigmaType -- Expected type of function
+ -> ExpRhoType -- Expected type of function
-> TcM (HsWrapper, MatchGroup GhcTcId (LHsExpr GhcTcId))
-- Returns type of body
tcMatchesFun fn@(L _ fun_name) matches exp_ty
@@ -102,20 +97,17 @@ tcMatchesFun fn@(L _ fun_name) matches exp_ty
traceTc "tcMatchesFun" (ppr fun_name $$ ppr exp_ty)
; checkArgs fun_name matches
- ; (wrap_gen, (wrap_fun, group))
- <- tcSkolemiseET (FunSigCtxt fun_name True) exp_ty $ \ exp_rho ->
- -- Note [Polymorphic expected type for tcMatchesFun]
- do { (matches', wrap_fun)
- <- matchExpectedFunTys herald arity exp_rho $
- \ pat_tys rhs_ty ->
- tcMatches match_ctxt pat_tys rhs_ty matches
- ; return (wrap_fun, matches') }
- ; return (wrap_gen <.> wrap_fun, group) }
+ ; matchExpectedFunTys herald ctxt arity exp_ty $ \ pat_tys rhs_ty ->
+ -- NB: exp_type may be polymorphic, but
+ -- matchExpectedFunTys can cope with that
+ tcMatches match_ctxt pat_tys rhs_ty matches }
where
- arity = matchGroupArity matches
+ arity = matchGroupArity matches
herald = text "The equation(s) for"
<+> quotes (ppr fun_name) <+> text "have"
- what = FunRhs { mc_fun = fn, mc_fixity = Prefix, mc_strictness = strictness }
+ ctxt = GenSigCtxt -- Was: FunSigCtxt fun_name True
+ -- But that's wrong for f :: Int -> forall a. blah
+ what = FunRhs { mc_fun = fn, mc_fixity = Prefix, mc_strictness = strictness }
match_ctxt = MC { mc_what = what, mc_body = tcBody }
strictness
| [L _ match] <- unLoc $ mg_alts matches
@@ -144,10 +136,10 @@ tcMatchesCase ctxt scrut_ty matches res_ty
tcMatchLambda :: SDoc -- see Note [Herald for matchExpectedFunTys] in GHC.Tc.Utils.Unify
-> TcMatchCtxt HsExpr
-> MatchGroup GhcRn (LHsExpr GhcRn)
- -> ExpRhoType -- deeply skolemised
- -> TcM (MatchGroup GhcTcId (LHsExpr GhcTcId), HsWrapper)
+ -> ExpRhoType
+ -> TcM (HsWrapper, MatchGroup GhcTcId (LHsExpr GhcTcId))
tcMatchLambda herald match_ctxt match res_ty
- = matchExpectedFunTys herald n_pats res_ty $ \ pat_tys rhs_ty ->
+ = matchExpectedFunTys herald GenSigCtxt n_pats res_ty $ \ pat_tys rhs_ty ->
tcMatches match_ctxt pat_tys rhs_ty match
where
n_pats | isEmptyMatchGroup match = 1 -- must be lambda-case
@@ -332,7 +324,7 @@ tcDoStmts ctxt _ _ = pprPanic "tcDoStmts" (pprStmtContext ctxt)
tcBody :: LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTcId)
tcBody body res_ty
= do { traceTc "tcBody" (ppr res_ty)
- ; tcLExpr body res_ty
+ ; tcMonoExpr body res_ty
}
{-
@@ -412,7 +404,7 @@ tcStmtsAndThen ctxt stmt_chk (L loc stmt : stmts) res_ty thing_inside
tcGuardStmt :: TcExprStmtChecker
tcGuardStmt _ (BodyStmt _ guard _ _) res_ty thing_inside
- = do { guard' <- tcLExpr guard (mkCheckExpType boolTy)
+ = do { guard' <- tcCheckMonoExpr guard boolTy
; thing <- thing_inside res_ty
; return (BodyStmt boolTy guard' noSyntaxExpr noSyntaxExpr, thing) }
@@ -445,21 +437,21 @@ tcLcStmt :: TyCon -- The list type constructor ([])
-> TcExprStmtChecker
tcLcStmt _ _ (LastStmt x body noret _) elt_ty thing_inside
- = do { body' <- tcLExprNC body elt_ty
+ = do { body' <- tcMonoExprNC body elt_ty
; thing <- thing_inside (panic "tcLcStmt: thing_inside")
; return (LastStmt x body' noret noSyntaxExpr, thing) }
-- A generator, pat <- rhs
tcLcStmt m_tc ctxt (BindStmt _ pat rhs) elt_ty thing_inside
= do { pat_ty <- newFlexiTyVarTy liftedTypeKind
- ; rhs' <- tcLExpr rhs (mkCheckExpType $ mkTyConApp m_tc [pat_ty])
+ ; rhs' <- tcCheckMonoExpr rhs (mkTyConApp m_tc [pat_ty])
; (pat', thing) <- tcCheckPat (StmtCtxt ctxt) pat pat_ty $
thing_inside elt_ty
; return (mkTcBindStmt pat' rhs', thing) }
-- A boolean guard
tcLcStmt _ _ (BodyStmt _ rhs _ _) elt_ty thing_inside
- = do { rhs' <- tcLExpr rhs (mkCheckExpType boolTy)
+ = do { rhs' <- tcCheckMonoExpr rhs boolTy
; thing <- thing_inside elt_ty
; return (BodyStmt boolTy rhs' noSyntaxExpr noSyntaxExpr, thing) }
@@ -517,7 +509,7 @@ tcLcStmt m_tc ctxt (TransStmt { trS_form = form, trS_stmts = stmts
by_arrow $
poly_arg_ty `mkVisFunTy` poly_res_ty
- ; using' <- tcCheckExpr using using_poly_ty
+ ; using' <- tcCheckPolyExpr using using_poly_ty
; let final_using = fmap (mkHsWrap (WpTyApp tup_ty)) using'
-- 'stmts' returns a result of type (m1_ty tuple_ty),
@@ -559,7 +551,7 @@ tcMcStmt _ (LastStmt x body noret return_op) res_ty thing_inside
= do { (body', return_op')
<- tcSyntaxOp MCompOrigin return_op [SynRho] res_ty $
\ [a_ty] ->
- tcLExprNC body (mkCheckExpType a_ty)
+ tcCheckMonoExprNC body a_ty
; thing <- thing_inside (panic "tcMcStmt: thing_inside")
; return (LastStmt x body' noret return_op', thing) }
@@ -575,7 +567,7 @@ tcMcStmt ctxt (BindStmt xbsrn pat rhs) res_ty thing_inside
<- tcSyntaxOp MCompOrigin (xbsrn_bindOp xbsrn)
[SynRho, SynFun SynAny SynRho] res_ty $
\ [rhs_ty, pat_ty, new_res_ty] ->
- do { rhs' <- tcLExprNC rhs (mkCheckExpType rhs_ty)
+ do { rhs' <- tcCheckMonoExprNC rhs rhs_ty
; (pat', thing) <- tcCheckPat (StmtCtxt ctxt) pat pat_ty $
thing_inside (mkCheckExpType new_res_ty)
; return (rhs', pat', thing, new_res_ty) }
@@ -607,7 +599,7 @@ tcMcStmt _ (BodyStmt _ rhs then_op guard_op) res_ty thing_inside
<- tcSyntaxOp MCompOrigin guard_op [SynAny]
(mkCheckExpType rhs_ty) $
\ [test_ty] ->
- tcLExpr rhs (mkCheckExpType test_ty)
+ tcCheckMonoExpr rhs test_ty
; thing <- thing_inside (mkCheckExpType new_res_ty)
; return (thing, rhs', rhs_ty, guard_op') }
; return (BodyStmt rhs_ty rhs' then_op' guard_op', thing) }
@@ -667,8 +659,7 @@ tcMcStmt ctxt (TransStmt { trS_stmts = stmts, trS_bndrs = bindersMap
(mkCheckExpType using_arg_ty) $ \res_ty' -> do
{ by' <- case by of
Nothing -> return Nothing
- Just e -> do { e' <- tcLExpr e
- (mkCheckExpType by_e_ty)
+ Just e -> do { e' <- tcCheckMonoExpr e by_e_ty
; return (Just e') }
-- Find the Ids (and hence types) of all old binders
@@ -693,7 +684,7 @@ tcMcStmt ctxt (TransStmt { trS_stmts = stmts, trS_bndrs = bindersMap
--------------- Typecheck the 'fmap' function -------------
; fmap_op' <- case form of
ThenForm -> return noExpr
- _ -> fmap unLoc . tcCheckExpr (noLoc fmap_op) $
+ _ -> fmap unLoc . tcCheckPolyExpr (noLoc fmap_op) $
mkInfForAllTy alphaTyVar $
mkInfForAllTy betaTyVar $
(alphaTy `mkVisFunTy` betaTy)
@@ -703,7 +694,7 @@ tcMcStmt ctxt (TransStmt { trS_stmts = stmts, trS_bndrs = bindersMap
--------------- Typecheck the 'using' function -------------
-- using :: ((a,b,c)->t) -> m1 (a,b,c) -> m2 (n (a,b,c))
- ; using' <- tcCheckExpr using using_poly_ty
+ ; using' <- tcCheckPolyExpr using using_poly_ty
; let final_using = fmap (mkHsWrap (WpTyApp tup_ty)) using'
--------------- Building the bindersMap ----------------
@@ -765,7 +756,7 @@ tcMcStmt ctxt (ParStmt _ bndr_stmts_s mzip_op bind_op) res_ty thing_inside
(m_ty `mkAppTy` betaTy)
`mkVisFunTy`
(m_ty `mkAppTy` mkBoxedTupleTy [alphaTy, betaTy])
- ; mzip_op' <- unLoc `fmap` tcCheckExpr (noLoc mzip_op) mzip_ty
+ ; mzip_op' <- unLoc `fmap` tcCheckPolyExpr (noLoc mzip_op) mzip_ty
-- type dummies since we don't know all binder types yet
; id_tys_s <- (mapM . mapM) (const (newFlexiTyVarTy liftedTypeKind))
@@ -827,7 +818,7 @@ tcMcStmt _ stmt _ _
tcDoStmt :: TcExprStmtChecker
tcDoStmt _ (LastStmt x body noret _) res_ty thing_inside
- = do { body' <- tcLExprNC body res_ty
+ = do { body' <- tcMonoExprNC body res_ty
; thing <- thing_inside (panic "tcDoStmt: thing_inside")
; return (LastStmt x body' noret noSyntaxExpr, thing) }
@@ -840,7 +831,7 @@ tcDoStmt ctxt (BindStmt xbsrn pat rhs) res_ty thing_inside
((rhs', pat', new_res_ty, thing), bind_op')
<- tcSyntaxOp DoOrigin (xbsrn_bindOp xbsrn) [SynRho, SynFun SynAny SynRho] res_ty $
\ [rhs_ty, pat_ty, new_res_ty] ->
- do { rhs' <- tcLExprNC rhs (mkCheckExpType rhs_ty)
+ do { rhs' <- tcCheckMonoExprNC rhs rhs_ty
; (pat', thing) <- tcCheckPat (StmtCtxt ctxt) pat pat_ty $
thing_inside (mkCheckExpType new_res_ty)
; return (rhs', pat', new_res_ty, thing) }
@@ -873,7 +864,7 @@ tcDoStmt _ (BodyStmt _ rhs then_op _) res_ty thing_inside
; ((rhs', rhs_ty, thing), then_op')
<- tcSyntaxOp DoOrigin then_op [SynRho, SynRho] res_ty $
\ [rhs_ty, new_res_ty] ->
- do { rhs' <- tcLExprNC rhs (mkCheckExpType rhs_ty)
+ do { rhs' <- tcCheckMonoExprNC rhs rhs_ty
; thing <- thing_inside (mkCheckExpType new_res_ty)
; return (rhs', rhs_ty, thing) }
; return (BodyStmt rhs_ty rhs' then_op' noSyntaxExpr, thing) }
@@ -1043,7 +1034,7 @@ tcApplicativeStmts ctxt pairs rhs_ty thing_inside
}, pat_ty, exp_ty)
= setSrcSpan (combineSrcSpans (getLoc pat) (getLoc rhs)) $
addErrCtxt (pprStmtInCtxt ctxt (mkRnBindStmt pat rhs)) $
- do { rhs' <- tcLExprNC rhs (mkCheckExpType exp_ty)
+ do { rhs' <- tcCheckMonoExprNC rhs exp_ty
; (pat', _) <- tcCheckPat (StmtCtxt ctxt) pat pat_ty $
return ()
; fail_op' <- fmap join . forM fail_op $ \fail ->
diff --git a/compiler/GHC/Tc/Gen/Pat.hs b/compiler/GHC/Tc/Gen/Pat.hs
index 58f64f84ae..4e30d4bc33 100644
--- a/compiler/GHC/Tc/Gen/Pat.hs
+++ b/compiler/GHC/Tc/Gen/Pat.hs
@@ -30,7 +30,7 @@ where
import GHC.Prelude
-import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcSyntaxOp, tcSyntaxOpGen, tcInferSigma )
+import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcSyntaxOp, tcSyntaxOpGen, tcInferRho )
import GHC.Hs
import GHC.Tc.Utils.Zonk
@@ -397,43 +397,51 @@ tc_pat pat_ty penv ps_pat thing_inside = case ps_pat of
res) }
ViewPat _ expr pat -> do
- {
- -- We use tcInferRho here.
- -- If we have a view function with types like:
- -- blah -> forall b. burble
- -- then simple-subsumption means that 'forall b' won't be instantiated
- -- so we can typecheck the inner pattern with that type
- -- An exotic example:
- -- pair :: forall a. a -> forall b. b -> (a,b)
- -- f (pair True -> x) = ...here (x :: forall b. b -> (Bool,b))
- --
- -- TEMPORARY: pending simple subsumption, use tcInferSigma
- -- When removing this, remove it from Expr.hs-boot too
- ; (expr',expr_ty) <- tcInferSigma expr
+ { (expr',expr_ty) <- tcInferRho expr
+ -- Note [View patterns and polymorphism]
-- Expression must be a function
; let expr_orig = lexprCtOrigin expr
herald = text "A view pattern expression expects"
- ; (expr_wrap1, [inf_arg_ty], inf_res_ty)
- <- matchActualFunTys herald expr_orig (Just (unLoc expr)) 1 expr_ty
- -- expr_wrap1 :: expr_ty "->" (inf_arg_ty -> inf_res_ty)
+ ; (expr_wrap1, inf_arg_ty, inf_res_sigma)
+ <- matchActualFunTySigma herald expr_orig (Just (unLoc expr)) (1,[]) expr_ty
+ -- See Note [View patterns and polymorphism]
+ -- expr_wrap1 :: expr_ty "->" (inf_arg_ty -> inf_res_sigma)
-- Check that overall pattern is more polymorphic than arg type
; expr_wrap2 <- tc_sub_type penv pat_ty inf_arg_ty
-- expr_wrap2 :: pat_ty "->" inf_arg_ty
- -- Pattern must have inf_res_ty
- ; (pat', res) <- tc_lpat (mkCheckExpType inf_res_ty) penv pat thing_inside
+ -- Pattern must have inf_res_sigma
+ ; (pat', res) <- tc_lpat (mkCheckExpType inf_res_sigma) penv pat thing_inside
; pat_ty <- readExpType pat_ty
; let expr_wrap2' = mkWpFun expr_wrap2 idHsWrapper
- pat_ty inf_res_ty doc
- -- expr_wrap2' :: (inf_arg_ty -> inf_res_ty) "->"
- -- (pat_ty -> inf_res_ty)
+ pat_ty inf_res_sigma doc
+ -- expr_wrap2' :: (inf_arg_ty -> inf_res_sigma) "->"
+ -- (pat_ty -> inf_res_sigma)
expr_wrap = expr_wrap2' <.> expr_wrap1
doc = text "When checking the view pattern function:" <+> (ppr expr)
; return (ViewPat pat_ty (mkLHsWrap expr_wrap expr') pat', res)}
+{- Note [View patterns and polymorphism]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider this exotic example:
+ pair :: forall a. Bool -> a -> forall b. b -> (a,b)
+
+ f :: Int -> blah
+ f (pair True -> x) = ...here (x :: forall b. b -> (Int,b))
+
+The expresion (pair True) should have type
+ pair True :: Int -> forall b. b -> (Int,b)
+so that it is ready to consume the incoming Int. It should be an
+arrow type (t1 -> t2); hence using (tcInferRho expr).
+
+Then, when taking that arrow apart we want to get a *sigma* type
+(forall b. b->(Int,b)), because that's what we want to bind 'x' to.
+Fortunately that's what matchExpectedFunTySigma returns anyway.
+-}
+
-- Type signatures in patterns
-- See Note [Pattern coercions] below
SigPat _ pat sig_ty -> do
diff --git a/compiler/GHC/Tc/Gen/Rule.hs b/compiler/GHC/Tc/Gen/Rule.hs
index c788f15437..63377c74d5 100644
--- a/compiler/GHC/Tc/Gen/Rule.hs
+++ b/compiler/GHC/Tc/Gen/Rule.hs
@@ -199,7 +199,7 @@ generateRuleConstraints ty_bndrs tm_bndrs lhs rhs
do { -- See Note [Solve order for RULES]
((lhs', rule_ty), lhs_wanted) <- captureConstraints (tcInferRho lhs)
; (rhs', rhs_wanted) <- captureConstraints $
- tcLExpr rhs (mkCheckExpType rule_ty)
+ tcCheckMonoExpr rhs rule_ty
; let all_lhs_wanted = bndr_wanted `andWC` lhs_wanted
; return (id_bndrs, lhs', all_lhs_wanted, rhs', rhs_wanted, rule_ty) } }
diff --git a/compiler/GHC/Tc/Gen/Sig.hs b/compiler/GHC/Tc/Gen/Sig.hs
index fb313d9297..2ac2823fb5 100644
--- a/compiler/GHC/Tc/Gen/Sig.hs
+++ b/compiler/GHC/Tc/Gen/Sig.hs
@@ -635,6 +635,7 @@ to connect the two, something like
This wrapper is put in the TcSpecPrag, in the ABExport record of
the AbsBinds.
+
f :: (Eq a, Ix b) => a -> b -> Bool
{-# SPECIALISE f :: (Ix p, Ix q) => Int -> (p,q) -> Bool #-}
f = <poly_rhs>
@@ -674,12 +675,13 @@ delicate, but works.
Some wrinkles
-1. We don't use full-on tcSubType, because that does co and contra
- variance and that in turn will generate too complex a LHS for the
- RULE. So we use a single invocation of skolemise /
- topInstantiate in tcSpecWrapper. (Actually I think that even
- the "deeply" stuff may be too much, because it introduces lambdas,
- though I think it can be made to work without too much trouble.)
+1. In tcSpecWrapper, rather than calling tcSubType, we directly call
+ skolemise/instantiate. That is mainly because of wrinkle (2).
+
+ Historical note: in the past, tcSubType did co/contra stuff, which
+ could generate too complex a LHS for the RULE, which was another
+ reason for not using tcSubType. But that reason has gone away
+ with simple subsumption (#17775).
2. We need to take care with type families (#5821). Consider
type instance F Int = Bool
@@ -775,7 +777,7 @@ tcSpecWrapper :: UserTypeCtxt -> TcType -> TcType -> TcM HsWrapper
-- See Note [Handling SPECIALISE pragmas], wrinkle 1
tcSpecWrapper ctxt poly_ty spec_ty
= do { (sk_wrap, inst_wrap)
- <- tcSkolemise ctxt spec_ty $ \ _ spec_tau ->
+ <- tcSkolemise ctxt spec_ty $ \ spec_tau ->
do { (inst_wrap, tau) <- topInstantiate orig poly_ty
; _ <- unifyType Nothing spec_tau tau
-- Deliberately ignore the evidence
diff --git a/compiler/GHC/Tc/Gen/Splice.hs b/compiler/GHC/Tc/Gen/Splice.hs
index 8a7b1b0c7f..f1233c55ed 100644
--- a/compiler/GHC/Tc/Gen/Splice.hs
+++ b/compiler/GHC/Tc/Gen/Splice.hs
@@ -288,7 +288,7 @@ tcPendingSplice m_var (PendingRnSplice flavour splice_name expr)
= do { meta_ty <- tcMetaTy meta_ty_name
-- Expected type of splice, e.g. m Exp
; let expected_type = mkAppTy m_var meta_ty
- ; expr' <- tcCheckExpr expr expected_type
+ ; expr' <- tcCheckPolyExpr expr expected_type
; return (PendingTcSplice splice_name expr') }
where
meta_ty_name = case flavour of
@@ -618,7 +618,7 @@ tcNestedSplice pop_stage (TcPending ps_var lie_var q@(QuoteWrapper _ m_var)) spl
; meta_exp_ty <- tcTExpTy m_var res_ty
; expr' <- setStage pop_stage $
setConstraintVar lie_var $
- tcLExpr expr (mkCheckExpType meta_exp_ty)
+ tcCheckMonoExpr expr meta_exp_ty
; untypeq <- tcLookupId unTypeQName
; let expr'' = mkHsApp
(mkLHsWrap (applyQuoteWrapper q)
@@ -647,7 +647,7 @@ tcTopSplice expr res_ty
-- Top level splices must still be of type Q (TExp a)
; meta_exp_ty <- tcTExpTy q_type res_ty
; q_expr <- tcTopSpliceExpr Typed $
- tcLExpr expr (mkCheckExpType meta_exp_ty)
+ tcCheckMonoExpr expr meta_exp_ty
; lcl_env <- getLclEnv
; let delayed_splice
= DelayedSplice lcl_env expr res_ty q_expr
@@ -684,7 +684,7 @@ runTopSplice (DelayedSplice lcl_env orig_expr res_ty q_expr)
captureConstraints $
addErrCtxt (spliceResultDoc zonked_q_expr) $ do
{ (exp3, _fvs) <- rnLExpr expr2
- ; tcLExpr exp3 (mkCheckExpType zonked_ty)}
+ ; tcCheckMonoExpr exp3 zonked_ty }
; ev <- simplifyTop wcs
; return $ unLoc (mkHsDictLet (EvBinds ev) res)
}
@@ -717,7 +717,7 @@ tcTopSpliceExpr :: SpliceType -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
-- Note that set the level to Splice, regardless of the original level,
-- before typechecking the expression. For example:
-- f x = $( ...$(g 3) ... )
--- The recursive call to tcCheckExpr will simply expand the
+-- The recursive call to tcCheckPolyExpr will simply expand the
-- inner escape before dealing with the outer one
tcTopSpliceExpr isTypedSplice tc_action
@@ -1438,7 +1438,7 @@ reifyInstances th_nm th_tys
<- pushTcLevelM_ $
solveEqualities $ -- Avoid error cascade if there are unsolved
bindImplicitTKBndrs_Skol tv_names $
- fst <$> tcLHsType rn_ty
+ tcInferLHsType rn_ty
; ty <- zonkTcTypeToType ty
-- Substitute out the meta type variables
-- In particular, the type might have kind
diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs
index 267a36cd89..300a870709 100644
--- a/compiler/GHC/Tc/Module.hs
+++ b/compiler/GHC/Tc/Module.hs
@@ -1781,11 +1781,11 @@ check_main dflags tcg_env explicit_mod_hdr export_ies
; res_ty <- newFlexiTyVarTy liftedTypeKind
; let io_ty = mkTyConApp ioTyCon [res_ty]
skol_info = SigSkol (FunSigCtxt main_name False) io_ty []
+ main_expr_rn = L loc (HsVar noExtField (L loc main_name))
; (ev_binds, main_expr)
<- checkConstraints skol_info [] [] $
addErrCtxt mainCtxt $
- tcLExpr (L loc (HsVar noExtField (L loc main_name)))
- (mkCheckExpType io_ty)
+ tcCheckMonoExpr main_expr_rn io_ty
-- See Note [Root-main Id]
-- Construct the binding
@@ -2476,6 +2476,7 @@ data TcRnExprMode = TM_Inst -- ^ Instantiate the type fully (:type)
| TM_Default -- ^ Default the type eagerly (:type +d)
-- | tcRnExpr just finds the type of an expression
+-- for :type
tcRnExpr :: HscEnv
-> TcRnExprMode
-> LHsExpr GhcPs
@@ -2590,7 +2591,7 @@ tcRnType hsc_env flexi normalise rdr_type
solveEqualities $
tcNamedWildCardBinders wcs $ \ wcs' ->
do { mapM_ emitNamedTypeHole wcs'
- ; tcLHsTypeUnsaturated rn_type }
+ ; tcInferLHsTypeUnsaturated rn_type }
-- Do kind generalisation; see Note [Kind-generalise in tcRnType]
; kvs <- kindGeneralizeAll kind
@@ -2623,7 +2624,7 @@ considers this example, with -fprint-explicit-foralls enabled:
In this mode, we report the type that would be inferred if a variable
were assigned to expression e, without applying the monomorphism restriction.
- This means we deeply instantiate the type and then regeneralize, as discussed
+ This means we instantiate the type and then regeneralize, as discussed
in #11376.
> :type foo @Int
diff --git a/compiler/GHC/Tc/Solver.hs b/compiler/GHC/Tc/Solver.hs
index b1017de024..8736206188 100644
--- a/compiler/GHC/Tc/Solver.hs
+++ b/compiler/GHC/Tc/Solver.hs
@@ -16,8 +16,7 @@ module GHC.Tc.Solver(
simpl_top,
- promoteTyVar,
- promoteTyVarSet,
+ promoteTyVarSet, emitFlatConstraints,
-- For Rules we need these
solveWanteds, solveWantedsAndDrop,
@@ -65,7 +64,6 @@ import Control.Monad
import Data.Foldable ( toList )
import Data.List ( partition )
import Data.List.NonEmpty ( NonEmpty(..) )
-import GHC.Data.Maybe ( isJust )
{-
*********************************************************************************
@@ -162,27 +160,143 @@ simplifyTop wanteds
-- should generally bump the TcLevel to make sure that this run of the solver
-- doesn't affect anything lying around.
solveLocalEqualities :: String -> TcM a -> TcM a
+-- Note [Failure in local type signatures]
solveLocalEqualities callsite thing_inside
= do { (wanted, res) <- solveLocalEqualitiesX callsite thing_inside
- ; emitConstraints wanted
+ ; emitFlatConstraints wanted
+ ; return res }
- -- See Note [Fail fast if there are insoluble kind equalities]
- ; when (insolubleWC wanted) $
- failM
+emitFlatConstraints :: WantedConstraints -> TcM ()
+-- See Note [Failure in local type signatures]
+emitFlatConstraints wanted
+ = do { wanted <- TcM.zonkWC wanted
+ ; case floatKindEqualities wanted of
+ Nothing -> do { traceTc "emitFlatConstraints: failing" (ppr wanted)
+ ; emitConstraints wanted -- So they get reported!
+ ; failM }
+ Just (simples, holes)
+ -> do { _ <- promoteTyVarSet (tyCoVarsOfCts simples)
+ ; traceTc "emitFlatConstraints:" $
+ vcat [ text "simples:" <+> ppr simples
+ , text "holes: " <+> ppr holes ]
+ ; emitHoles holes -- Holes don't need promotion
+ ; emitSimples simples } }
+
+floatKindEqualities :: WantedConstraints -> Maybe (Bag Ct, Bag Hole)
+-- Float out all the constraints from the WantedConstraints,
+-- Return Nothing if any constraints can't be floated (captured
+-- by skolems), or if there is an insoluble constraint, or
+-- IC_Telescope telescope error
+floatKindEqualities wc = float_wc emptyVarSet wc
+ where
+ float_wc :: TcTyCoVarSet -> WantedConstraints -> Maybe (Bag Ct, Bag Hole)
+ float_wc trapping_tvs (WC { wc_simple = simples
+ , wc_impl = implics
+ , wc_holes = holes })
+ | all is_floatable simples
+ = do { (inner_simples, inner_holes)
+ <- flatMapBagPairM (float_implic trapping_tvs) implics
+ ; return ( simples `unionBags` inner_simples
+ , holes `unionBags` inner_holes) }
+ | otherwise
+ = Nothing
+ where
+ is_floatable ct
+ | insolubleEqCt ct = False
+ | otherwise = tyCoVarsOfCt ct `disjointVarSet` trapping_tvs
+
+ float_implic :: TcTyCoVarSet -> Implication -> Maybe (Bag Ct, Bag Hole)
+ float_implic trapping_tvs (Implic { ic_wanted = wanted, ic_no_eqs = no_eqs
+ , ic_skols = skols, ic_status = status })
+ | isInsolubleStatus status
+ = Nothing -- A short cut /plus/ we must keep track of IC_BadTelescope
+ | otherwise
+ = do { (simples, holes) <- float_wc new_trapping_tvs wanted
+ ; when (not (isEmptyBag simples) && not no_eqs) $
+ Nothing
+ -- If there are some constraints to float out, but we can't
+ -- because we don't float out past local equalities
+ -- (c.f GHC.Tc.Solver.approximateWC), then fail
+ ; return (simples, holes) }
+ where
+ new_trapping_tvs = trapping_tvs `extendVarSetList` skols
- ; return res }
-{- Note [Fail fast if there are insoluble kind equalities]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Rather like in simplifyInfer, fail fast if there is an insoluble
-constraint. Otherwise we'll just succeed in kind-checking a nonsense
-type, with a cascade of follow-up errors.
+{- Note [Failure in local type signatures]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+When kind checking a type signature, we like to fail fast if we can't
+solve all the kind equality constraints: see Note [Fail fast on kind
+errors]. But what about /local/ type signatures, mentioning in-scope
+type variables for which there might be given equalities. Here's
+an example (T15076b):
+
+ class (a ~ b) => C a b
+ data SameKind :: k -> k -> Type where { SK :: SameKind a b }
+
+ bar :: forall (a :: Type) (b :: Type).
+ C a b => Proxy a -> Proxy b -> ()
+ bar _ _ = const () (undefined :: forall (x :: a) (y :: b). SameKind x y)
+
+Consider the type singature on 'undefined'. It's ill-kinded unless
+a~b. But the superclass of (C a b) means that indeed (a~b). So all
+should be well. BUT it's hard to see that when kind-checking the signature
+for undefined. We want to emit a residual (a~b) constraint, to solve
+later.
+
+Another possiblity is that we might have something like
+ F alpha ~ [Int]
+where alpha is bound further out, which might become soluble
+"later" when we learn more about alpha. So we want to emit
+those residual constraints.
+
+BUT it's no good simply wrapping all unsolved constraints from
+a type signature in an implication constraint to solve later. The
+problem is that we are going to /use/ that signature, including
+instantiate it. Say we have
+ f :: forall a. (forall b. blah) -> blah2
+ f x = <body>
+To typecheck the definition of f, we have to instantiate those
+foralls. Moreover, any unsolved kind equalities will be coercion
+holes in the type. If we naively wrap them in an implication like
+ forall a. (co1:k1~k2, forall b. co2:k3~k4)
+hoping to solve it later, we might end up filling in the holes
+co1 and co2 with coercions involving 'a' and 'b' -- but by now
+we've instantiated the type. Chaos!
+
+Moreover, the unsolved constraints might be skolem-escpae things, and
+if we proceed with f bound to a nonsensical type, we get a cascade of
+follow-up errors. For example polykinds/T12593, T15577, and many others.
+
+So here's the plan:
-For example polykinds/T12593, T15577, and many others.
+* solveLocalEqualitiesX: try to solve the constraints (solveLocalEqualitiesX)
-Take care to ensure that you emit the insoluble constraints before
-failing, because they are what will ultimately lead to the error
-messsage!
+* buildTvImplication: build an implication for the residual, unsolved
+ constraint
+
+* emitFlatConstraints: try to float out every unsolved equalities
+ inside that implication, in the hope that it constrains only global
+ type variables, not the locally-quantified ones.
+
+ * If we fail, or find an insoluble constraint, emit the implication,
+ so that the errors will be reported, and fail.
+
+ * If we succeed in floating all the equalities, promote them and
+ re-emit them as flat constraint, not wrapped at all (since they
+ don't mention any of the quantified variables.
+
+* Note that this float-and-promote step means that anonymous
+ wildcards get floated to top level, as we want; see
+ Note [Checking partial type signatures] in GHC.Tc.Gen.HsType.
+
+All this is done:
+
+* in solveLocalEqualities, where there is no kind-generalisation
+ to complicate matters.
+
+* in GHC.Tc.Gen.HsType.tcHsSigType, where quantification intervenes.
+
+See also #18062, #11506
-}
solveLocalEqualitiesX :: String -> TcM a -> TcM (WantedConstraints, a)
@@ -867,7 +981,6 @@ mkResidualConstraints rhs_tclvl ev_binds_var
return $ unitBag $
implic1 { ic_tclvl = rhs_tclvl
, ic_skols = qtvs
- , ic_telescope = Nothing
, ic_given = full_theta_vars
, ic_wanted = inner_wanted
, ic_binds = ev_binds_var
@@ -1168,7 +1281,7 @@ defaultTyVarsAndSimplify rhs_tclvl mono_tvs candidates
= do { -- Promote any tyvars that we cannot generalise
-- See Note [Promote momomorphic tyvars]
; traceTc "decideMonoTyVars: promotion:" (ppr mono_tvs)
- ; (prom, _) <- promoteTyVarSet mono_tvs
+ ; any_promoted <- promoteTyVarSet mono_tvs
-- Default any kind/levity vars
; DV {dv_kvs = cand_kvs, dv_tvs = cand_tvs}
@@ -1186,7 +1299,7 @@ defaultTyVarsAndSimplify rhs_tclvl mono_tvs candidates
; case () of
_ | some_default -> simplify_cand candidates
- | prom -> mapM TcM.zonkTcType candidates
+ | any_promoted -> mapM TcM.zonkTcType candidates
| otherwise -> return candidates
}
where
@@ -1789,9 +1902,9 @@ setImplicationStatus implic@(Implic { ic_status = status
checkBadTelescope :: Implication -> TcS Bool
-- True <=> the skolems form a bad telescope
-- See Note [Checking telescopes] in GHC.Tc.Types.Constraint
-checkBadTelescope (Implic { ic_telescope = m_telescope
- , ic_skols = skols })
- | isJust m_telescope
+checkBadTelescope (Implic { ic_info = info
+ , ic_skols = skols })
+ | ForAllSkol {} <- info
= do{ skols <- mapM TcS.zonkTyCoVarKind skols
; return (go emptyVarSet (reverse skols))}
@@ -2063,7 +2176,7 @@ we'll get more Givens (a unification is like adding a Given) to
allow the implication to make progress.
-}
-promoteTyVar :: TcTyVar -> TcM (Bool, TcTyVar)
+promoteTyVar :: TcTyVar -> TcM Bool
-- When we float a constraint out of an implication we must restore
-- invariant (WantedInv) in Note [TcLevel and untouchable type variables] in GHC.Tc.Utils.TcType
-- Return True <=> we did some promotion
@@ -2075,16 +2188,16 @@ promoteTyVar tv
then do { cloned_tv <- TcM.cloneMetaTyVar tv
; let rhs_tv = setMetaTyVarTcLevel cloned_tv tclvl
; TcM.writeMetaTyVar tv (mkTyVarTy rhs_tv)
- ; return (True, rhs_tv) }
- else return (False, tv) }
+ ; return True }
+ else return False }
-- Returns whether or not *any* tyvar is defaulted
-promoteTyVarSet :: TcTyVarSet -> TcM (Bool, TcTyVarSet)
+promoteTyVarSet :: TcTyVarSet -> TcM Bool
promoteTyVarSet tvs
- = do { (bools, tyvars) <- mapAndUnzipM promoteTyVar (nonDetEltsUniqSet tvs)
- -- non-determinism is OK because order of promotion doesn't matter
+ = do { bools <- mapM promoteTyVar (nonDetEltsUniqSet tvs)
+ -- Non-determinism is OK because order of promotion doesn't matter
- ; return (or bools, mkVarSet tyvars) }
+ ; return (or bools) }
promoteTyVarTcS :: TcTyVar -> TcS ()
-- When we float a constraint out of an implication we must restore
@@ -2122,7 +2235,7 @@ approximateWC float_past_equalities wc
float_wc :: TcTyCoVarSet -> WantedConstraints -> Cts
float_wc trapping_tvs (WC { wc_simple = simples, wc_impl = implics })
= filterBag (is_floatable trapping_tvs) simples `unionBags`
- do_bag (float_implic trapping_tvs) implics
+ concatMapBag (float_implic trapping_tvs) implics
where
float_implic :: TcTyCoVarSet -> Implication -> Cts
@@ -2134,9 +2247,6 @@ approximateWC float_past_equalities wc
where
new_trapping_tvs = trapping_tvs `extendVarSetList` ic_skols imp
- do_bag :: (a -> Bag c) -> Bag a -> Bag c
- do_bag f = foldr (unionBags.f) emptyBag
-
is_floatable skol_tvs ct
| isGivenCt ct = False
| insolubleEqCt ct = False
@@ -2419,21 +2529,20 @@ floatEqualities skols given_ids ev_binds_var no_given_eqs
| otherwise = acc
-- Identify which equalities are candidates for floating
- -- Float out alpha ~ ty, or ty ~ alpha which might be unified outside
+ -- Float out alpha ~ ty which might be unified outside
-- See Note [Which equalities to float]
is_float_eq_candidate ct
| pred <- ctPred ct
, EqPred NomEq ty1 ty2 <- classifyPredType pred
- = case (tcGetTyVar_maybe ty1, tcGetTyVar_maybe ty2) of
- (Just tv1, _) -> float_tv_eq_candidate tv1 ty2
- (_, Just tv2) -> float_tv_eq_candidate tv2 ty1
- _ -> False
- | otherwise = False
-
- float_tv_eq_candidate tv1 ty2 -- See Note [Which equalities to float]
- = isMetaTyVar tv1
- && (not (isTyVarTyVar tv1) || isTyVarTy ty2)
+ = float_eq ty1 ty2 || float_eq ty2 ty1
+ | otherwise
+ = False
+ float_eq ty1 ty2
+ = case getTyVar_maybe ty1 of
+ Just tv1 -> isMetaTyVar tv1
+ && (not (isTyVarTyVar tv1) || isTyVarTy ty2)
+ Nothing -> False
{- Note [Float equalities from under a skolem binding]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -2470,6 +2579,12 @@ happen. In particular, float out equalities that are:
case, floating out won't help either, and it may affect grouping
of error messages.
+ NB: generally we won't see (ty ~ alpha), with alpha on the right because
+ of Note [Unification variables on the left] in GHC.Tc.Utils.Unify.
+ But if we start with (F tys ~ alpha), it will orient as (fmv ~ alpha),
+ and unflatten back to (F tys ~ alpha). So we must look for alpha on
+ the right too. Example T4494.
+
* Nominal. No point in floating (alpha ~R# ty), because we do not
unify representational equalities even if alpha is touchable.
See Note [Do not unify representational equalities] in GHC.Tc.Solver.Interact.
diff --git a/compiler/GHC/Tc/Solver/Canonical.hs b/compiler/GHC/Tc/Solver/Canonical.hs
index 4e828c919c..2fc8664450 100644
--- a/compiler/GHC/Tc/Solver/Canonical.hs
+++ b/compiler/GHC/Tc/Solver/Canonical.hs
@@ -904,22 +904,23 @@ It is conceivable to do a better job at tracking whether or not a type
is flattened, but this is left as future work. (Mar '15)
-Note [FunTy and decomposing tycon applications]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-When can_eq_nc' attempts to decompose a tycon application we haven't yet zonked.
-This means that we may very well have a FunTy containing a type of some unknown
-kind. For instance, we may have,
+Note [Decomposing FunTy]
+~~~~~~~~~~~~~~~~~~~~~~~~
+can_eq_nc' may attempt to decompose a FunTy that is un-zonked. This
+means that we may very well have a FunTy containing a type of some
+unknown kind. For instance, we may have,
FunTy (a :: k) Int
-Where k is a unification variable. tcRepSplitTyConApp_maybe panics in the event
-that it sees such a type as it cannot determine the RuntimeReps which the (->)
-is applied to. Consequently, it is vital that we instead use
-tcRepSplitTyConApp_maybe', which simply returns Nothing in such a case.
-
-When this happens can_eq_nc' will fail to decompose, zonk, and try again.
+Where k is a unification variable. So the calls to getRuntimeRep_maybe may
+fail (returning Nothing). In that case we'll fall through, zonk, and try again.
Zonking should fill the variable k, meaning that decomposition will succeed the
second time around.
+
+Also note that we require the AnonArgFlag to match. This will stop
+us decomposing
+ (Int -> Bool) ~ (Show a => blah)
+It's as if we treat (->) and (=>) as different type constructors.
-}
canEqNC :: CtEvidence -> EqRel -> Type -> Type -> TcS (StopOrContinue Ct)
@@ -1003,13 +1004,26 @@ can_eq_nc' _flat _rdr_env _envs ev eq_rel ty1@(LitTy l1) _ (LitTy l2) _
= do { setEvBindIfWanted ev (evCoercion $ mkReflCo (eqRelRole eq_rel) ty1)
; stopWith ev "Equal LitTy" }
--- Try to decompose type constructor applications
--- Including FunTy (s -> t)
-can_eq_nc' _flat _rdr_env _envs ev eq_rel ty1 _ ty2 _
- --- See Note [FunTy and decomposing type constructor applications].
- | Just (tc1, tys1) <- repSplitTyConApp_maybe ty1
- , Just (tc2, tys2) <- repSplitTyConApp_maybe ty2
- , not (isTypeFamilyTyCon tc1)
+-- Decompose FunTy: (s -> t) and (c => t)
+-- NB: don't decompose (Int -> blah) ~ (Show a => blah)
+can_eq_nc' _flat _rdr_env _envs ev eq_rel
+ (FunTy { ft_af = af1, ft_arg = ty1a, ft_res = ty1b }) _
+ (FunTy { ft_af = af2, ft_arg = ty2a, ft_res = ty2b }) _
+ | af1 == af2 -- Don't decompose (Int -> blah) ~ (Show a => blah)
+ , Just ty1a_rep <- getRuntimeRep_maybe ty1a -- getRutimeRep_maybe:
+ , Just ty1b_rep <- getRuntimeRep_maybe ty1b -- see Note [Decomposing FunTy]
+ , Just ty2a_rep <- getRuntimeRep_maybe ty2a
+ , Just ty2b_rep <- getRuntimeRep_maybe ty2b
+ = canDecomposableTyConAppOK ev eq_rel funTyCon
+ [ty1a_rep, ty1b_rep, ty1a, ty1b]
+ [ty2a_rep, ty2b_rep, ty2a, ty2b]
+
+-- Decompose type constructor applications
+-- NB: e have expanded type synonyms already
+can_eq_nc' _flat _rdr_env _envs ev eq_rel
+ (TyConApp tc1 tys1) _
+ (TyConApp tc2 tys2) _
+ | not (isTypeFamilyTyCon tc1)
, not (isTypeFamilyTyCon tc2)
= canTyConApp ev eq_rel tc1 tys1 tc2 tys2
@@ -1452,15 +1466,13 @@ canTyConApp :: CtEvidence -> EqRel
-> TyCon -> [TcType]
-> TcS (StopOrContinue Ct)
-- See Note [Decomposing TyConApps]
+-- Neither tc1 nor tc2 is a saturated funTyCon
canTyConApp ev eq_rel tc1 tys1 tc2 tys2
| tc1 == tc2
, tys1 `equalLength` tys2
= do { inerts <- getTcSInerts
; if can_decompose inerts
- then do { traceTcS "canTyConApp"
- (ppr ev $$ ppr eq_rel $$ ppr tc1 $$ ppr tys1 $$ ppr tys2)
- ; canDecomposableTyConAppOK ev eq_rel tc1 tys1 tys2
- ; stopWith ev "Decomposed TyConApp" }
+ then canDecomposableTyConAppOK ev eq_rel tc1 tys1 tys2
else canEqFailure ev eq_rel ty1 ty2 }
-- See Note [Skolem abstract data] (at tyConSkolem)
@@ -1476,6 +1488,10 @@ canTyConApp ev eq_rel tc1 tys1 tc2 tys2
| otherwise
= canEqHardFailure ev ty1 ty2
where
+ -- Reconstruct the types for error messages. This would do
+ -- the wrong thing (from a pretty printing point of view)
+ -- for functions, because we've lost the AnonArgFlag; but
+ -- in fact we never call canTyConApp on a saturated FunTyCon
ty1 = mkTyConApp tc1 tys1
ty2 = mkTyConApp tc2 tys2
@@ -1673,30 +1689,35 @@ Conclusion:
canDecomposableTyConAppOK :: CtEvidence -> EqRel
-> TyCon -> [TcType] -> [TcType]
- -> TcS ()
+ -> TcS (StopOrContinue Ct)
-- Precondition: tys1 and tys2 are the same length, hence "OK"
canDecomposableTyConAppOK ev eq_rel tc tys1 tys2
= ASSERT( tys1 `equalLength` tys2 )
- case ev of
- CtDerived {}
- -> unifyDeriveds loc tc_roles tys1 tys2
-
- CtWanted { ctev_dest = dest }
- -- new_locs and tc_roles are both infinite, so
- -- we are guaranteed that cos has the same length
- -- as tys1 and tys2
- -> do { cos <- zipWith4M unifyWanted new_locs tc_roles tys1 tys2
- ; setWantedEq dest (mkTyConAppCo role tc cos) }
-
- CtGiven { ctev_evar = evar }
- -> do { let ev_co = mkCoVarCo evar
- ; given_evs <- newGivenEvVars loc $
- [ ( mkPrimEqPredRole r ty1 ty2
- , evCoercion $ mkNthCo r i ev_co )
- | (r, ty1, ty2, i) <- zip4 tc_roles tys1 tys2 [0..]
- , r /= Phantom
- , not (isCoercionTy ty1) && not (isCoercionTy ty2) ]
- ; emitWorkNC given_evs }
+ do { traceTcS "canDecomposableTyConAppOK"
+ (ppr ev $$ ppr eq_rel $$ ppr tc $$ ppr tys1 $$ ppr tys2)
+ ; case ev of
+ CtDerived {}
+ -> unifyDeriveds loc tc_roles tys1 tys2
+
+ CtWanted { ctev_dest = dest }
+ -- new_locs and tc_roles are both infinite, so
+ -- we are guaranteed that cos has the same length
+ -- as tys1 and tys2
+ -> do { cos <- zipWith4M unifyWanted new_locs tc_roles tys1 tys2
+ ; setWantedEq dest (mkTyConAppCo role tc cos) }
+
+ CtGiven { ctev_evar = evar }
+ -> do { let ev_co = mkCoVarCo evar
+ ; given_evs <- newGivenEvVars loc $
+ [ ( mkPrimEqPredRole r ty1 ty2
+ , evCoercion $ mkNthCo r i ev_co )
+ | (r, ty1, ty2, i) <- zip4 tc_roles tys1 tys2 [0..]
+ , r /= Phantom
+ , not (isCoercionTy ty1) && not (isCoercionTy ty2) ]
+ ; emitWorkNC given_evs }
+
+ ; stopWith ev "Decomposed TyConApp" }
+
where
loc = ctEvLoc ev
role = eqRelRole eq_rel
@@ -1747,7 +1768,8 @@ canEqHardFailure :: CtEvidence
-> TcType -> TcType -> TcS (StopOrContinue Ct)
-- See Note [Make sure that insolubles are fully rewritten]
canEqHardFailure ev ty1 ty2
- = do { (s1, co1) <- flatten FM_SubstOnly ev ty1
+ = do { traceTcS "canEqHardFailure" (ppr ty1 $$ ppr ty2)
+ ; (s1, co1) <- flatten FM_SubstOnly ev ty1
; (s2, co2) <- flatten FM_SubstOnly ev ty2
; new_ev <- rewriteEqEvidence ev NotSwapped s1 s2 co1 co2
; continueWith (mkIrredCt InsolubleCIS new_ev) }
@@ -2007,7 +2029,7 @@ canEqTyVarHomo ev eq_rel swapped tv1 ps_xi1 xi2 _
-- this guarantees (TyEq:TV)
| Just (tv2, co2) <- tcGetCastedTyVar_maybe xi2
- , swapOverTyVars tv1 tv2
+ , swapOverTyVars (isGiven ev) tv1 tv2
= do { traceTcS "canEqTyVar swapOver" (ppr tv1 $$ ppr tv2 $$ ppr swapped)
; let role = eqRelRole eq_rel
sym_co2 = mkTcSymCo co2
diff --git a/compiler/GHC/Tc/Solver/Flatten.hs b/compiler/GHC/Tc/Solver/Flatten.hs
index ecfa9afa3a..6916357691 100644
--- a/compiler/GHC/Tc/Solver/Flatten.hs
+++ b/compiler/GHC/Tc/Solver/Flatten.hs
@@ -1175,7 +1175,7 @@ flatten_one (TyConApp tc tys)
-- _ -> fmode
= flatten_ty_con_app tc tys
-flatten_one ty@(FunTy _ ty1 ty2)
+flatten_one ty@(FunTy { ft_arg = ty1, ft_res = ty2 })
= do { (xi1,co1) <- flatten_one ty1
; (xi2,co2) <- flatten_one ty2
; role <- getRole
diff --git a/compiler/GHC/Tc/TyCl.hs b/compiler/GHC/Tc/TyCl.hs
index 144021caea..98550132c5 100644
--- a/compiler/GHC/Tc/TyCl.hs
+++ b/compiler/GHC/Tc/TyCl.hs
@@ -2313,18 +2313,18 @@ newtype instance T [a] :: <kind> where ... -- See Point 5
2. Where these kinds come from: Return kinds are processed through several
different code paths:
- data/newtypes: The return kind is part of the TyCon kind, gotten either
+ Data/newtypes: The return kind is part of the TyCon kind, gotten either
by checkInitialKind (standalone kind signature / CUSK) or
inferInitialKind. It is extracted by bindTyClTyVars in tcTyClDecl1. It is
then passed to tcDataDefn.
- families: The return kind is either written in a standalone signature
+ Families: The return kind is either written in a standalone signature
or extracted from a family declaration in getInitialKind.
If a family declaration is missing a result kind, it is assumed to be
Type. This assumption is in getInitialKind for CUSKs or
get_fam_decl_initial_kind for non-signature & non-CUSK cases.
- instances: The data family already has a known kind. The return kind
+ Instances: The data family already has a known kind. The return kind
of an instance is then calculated by applying the data family tycon
to the patterns provided, as computed by the typeKind lhs_ty in the
end of tcDataFamInstHeader. In the case of an instance written in GADT
@@ -2350,10 +2350,9 @@ newtype instance T [a] :: <kind> where ... -- See Point 5
4. Datatype return kind restriction: A data/data-instance return kind must end
in a type that, after type-synonym expansion, yields `TYPE LiftedRep`. By
"end in", we mean we strip any foralls and function arguments off before
- checking: this remaining part of the type is returned from
- etaExpandAlgTyCon. Note that we do *not* do type family reduction here.
- Examples:
+ checking: this remaining part of the type is returned from etaExpandAlgTyCon.
+ Examples:
data T1 :: Type -- good
data T2 :: Bool -> Type -- good
data T3 :: Bool -> forall k. Type -- strange, but still accepted
@@ -2361,27 +2360,38 @@ newtype instance T [a] :: <kind> where ... -- See Point 5
data T5 :: Bool -- bad
data T6 :: Type -> Bool -- bad
+ Exactly the same applies to data instance (but not data family)
+ declarations. Examples
+ data instance D1 :: Type -- good
+ data instance D2 :: Boool -> Type -- good
+
+ We can "look through" type synonyms
+ type Star = Type
+ data T7 :: Bool -> Star -- good (synonym expansion ok)
type Arrow = (->)
- data T7 :: Arrow Bool Type -- good
+ data T8 :: Arrow Bool Type -- good (ditto)
+ But we specifically do *not* do type family reduction here.
type family ARROW where
ARROW = (->)
- data T8 :: ARROW Bool Type -- bad
-
- type Star = Type
- data T9 :: Bool -> Star -- good
+ data T9 :: ARROW Bool Type -- bad
type family F a where
F Int = Bool
F Bool = Type
data T10 :: Bool -> F Bool -- bad
+ The /principle/ here is that in the TyCon for a data type or data instance,
+ we must be able to lay out all the type-variable binders, one by one, until
+ we reach (TYPE xx). There is no place for a cast here. We could add one,
+ but let's not!
+
This check is done in checkDataKindSig. For data declarations, this
call is in tcDataDefn; for data instances, this call is in tcDataFamInstDecl.
- However, because data instances in GADT syntax can have two return kinds (see
- point (2) above), we must check both return kinds. The user-written return
- kind is checked in tc_kind_sig within tcDataFamInstHeader. Examples:
+4a Because data instances in GADT syntax can have two return kinds (see
+ point (2) above), we must check both return kinds. The user-written return
+ kind is checked by the call to checkDataKindSig in tcDataFamInstDecl. Examples:
data family D (a :: Nat) :: k -- good (see Point 6)
@@ -2906,36 +2916,11 @@ tcTyFamInstEqnGuts fam_tc mb_clsinfo imp_vars exp_bndrs hs_pats hs_rhs_ty
; return (qtvs, pats, rhs_ty) }
-----------------
-tcFamTyPats :: TyCon
- -> HsTyPats GhcRn -- Patterns
- -> TcM (TcType, TcKind) -- (lhs_type, lhs_kind)
--- Used for both type and data families
-tcFamTyPats fam_tc hs_pats
- = do { traceTc "tcFamTyPats {" $
- vcat [ ppr fam_tc, text "arity:" <+> ppr fam_arity ]
-
- ; let fun_ty = mkTyConApp fam_tc []
-
- ; (fam_app, res_kind) <- unsetWOptM Opt_WarnPartialTypeSignatures $
- setXOptM LangExt.PartialTypeSignatures $
- -- See Note [Wildcards in family instances] in
- -- GHC.Rename.Module
- tcInferApps typeLevelMode lhs_fun fun_ty hs_pats
-
- ; traceTc "End tcFamTyPats }" $
- vcat [ ppr fam_tc, text "res_kind:" <+> ppr res_kind ]
-
- ; return (fam_app, res_kind) }
- where
- fam_name = tyConName fam_tc
- fam_arity = tyConArity fam_tc
- lhs_fun = noLoc (HsTyVar noExtField NotPromoted (noLoc fam_name))
-
unravelFamInstPats :: TcType -> [TcType]
-- Decompose fam_app to get the argument patterns
--
-- We expect fam_app to look like (F t1 .. tn)
--- tcInferApps is capable of returning ((F ty1 |> co) ty2),
+-- tcFamTyPats is capable of returning ((F ty1 |> co) ty2),
-- but that can't happen here because we already checked the
-- arity of F matches the number of pattern
unravelFamInstPats fam_app
@@ -4749,20 +4734,20 @@ badDataConTyCon data_con res_ty_tmpl
$+$ hang (text "Suggestion: instead use this type signature:")
2 (ppr (dataConName data_con) <+> dcolon <+> ppr suggested_ty)
- -- To construct a type that GHC would accept (suggested_ty), we:
- --
- -- 1) Find the existentially quantified type variables and the class
- -- predicates from the datacon. (NB: We don't need the universally
- -- quantified type variables, since rejigConRes won't substitute them in
- -- the result type if it fails, as in this scenario.)
- -- 2) Split apart the return type (which is headed by a forall or a
- -- context) using tcSplitNestedSigmaTys, collecting the type variables
- -- and class predicates we find, as well as the rho type lurking
- -- underneath the nested foralls and contexts.
- -- 3) Smash together the type variables and class predicates from 1) and
- -- 2), and prepend them to the rho type from 2).
- (tvs, theta, rho) = tcSplitNestedSigmaTys (dataConUserType data_con)
+ -- To construct a type that GHC would accept (suggested_ty), we
+ -- simply drag all the foralls and (=>) contexts to the front
+ -- of the type.
suggested_ty = mkSpecSigmaTy tvs theta rho
+ (tvs, theta, rho) = go (dataConUserType data_con)
+
+ go :: Type -> ([TyVar],ThetaType,Type)
+ -- The returned Type has no foralls or =>, even to the right of an (->)
+ go ty | null arg_tys = (tvs1, theta1, rho1)
+ | otherwise = (tvs1 ++ tvs2, theta1 ++ theta2, mkVisFunTys arg_tys rho2)
+ where
+ (tvs1, theta1, rho1) = tcSplitNestedSigmaTys ty
+ (arg_tys, ty2) = tcSplitFunTys rho1
+ (tvs2, theta2, rho2) = go ty2
badGadtDecl :: Name -> SDoc
badGadtDecl tc_name
diff --git a/compiler/GHC/Tc/TyCl/Instance.hs b/compiler/GHC/Tc/TyCl/Instance.hs
index 734ec05512..4c43d91f3e 100644
--- a/compiler/GHC/Tc/TyCl/Instance.hs
+++ b/compiler/GHC/Tc/TyCl/Instance.hs
@@ -699,8 +699,10 @@ tcDataFamInstDecl mb_clsinfo tv_skol_env
-- we did it before the "extra" tvs from etaExpandAlgTyCon
-- would always be eta-reduced
--
- -- See also Note [Datatype return kinds] in GHC.Tc.TyCl
; (extra_tcbs, final_res_kind) <- etaExpandAlgTyCon full_tcbs res_kind
+
+ -- Check the result kind; it may come from a user-written signature.
+ -- See Note [Datatype return kinds] in GHC.Tc.TyCl point 4(a)
; checkDataKindSig (DataInstanceSort new_or_data) final_res_kind
; let extra_pats = map (mkTyVarTy . binderVar) extra_tcbs
all_pats = pats `chkAppend` extra_pats
@@ -847,7 +849,8 @@ tcDataFamInstHeader
-- Here the "header" is the bit before the "where"
tcDataFamInstHeader mb_clsinfo fam_tc imp_vars mb_bndrs fixity
hs_ctxt hs_pats m_ksig hs_cons new_or_data
- = do { (imp_tvs, (exp_tvs, (stupid_theta, lhs_ty, lhs_applied_kind)))
+ = do { traceTc "tcDataFamInstHeader {" (ppr fam_tc <+> ppr hs_pats)
+ ; (imp_tvs, (exp_tvs, (stupid_theta, lhs_ty, res_kind)))
<- pushTcLevelM_ $
solveEqualities $
bindImplicitTKBndrs_Q_Skol imp_vars $
@@ -872,10 +875,15 @@ tcDataFamInstHeader mb_clsinfo fam_tc imp_vars mb_bndrs fixity
; let lhs_applied_ty = lhs_ty `mkTcAppTys` lhs_extra_args
hs_lhs = nlHsTyConApp fixity (getName fam_tc) hs_pats
; _ <- unifyKind (Just (unLoc hs_lhs)) lhs_applied_kind res_kind
+ -- Check that the result kind of the TyCon applied to its args
+ -- is compatible with the explicit signature (or Type, if there
+ -- is none)
+ ; traceTc "tcDataFamInstHeader" $
+ vcat [ ppr fam_tc, ppr m_ksig, ppr lhs_applied_kind, ppr res_kind ]
; return ( stupid_theta
, lhs_applied_ty
- , lhs_applied_kind ) }
+ , res_kind ) }
-- See GHC.Tc.TyCl Note [Generalising in tcFamTyPatsGuts]
-- This code (and the stuff immediately above) is very similar
@@ -888,10 +896,15 @@ tcDataFamInstHeader mb_clsinfo fam_tc imp_vars mb_bndrs fixity
; qtvs <- quantifyTyVars dvs
-- Zonk the patterns etc into the Type world
- ; (ze, qtvs) <- zonkTyBndrs qtvs
- ; lhs_ty <- zonkTcTypeToTypeX ze lhs_ty
- ; stupid_theta <- zonkTcTypesToTypesX ze stupid_theta
- ; lhs_applied_kind <- zonkTcTypeToTypeX ze lhs_applied_kind
+ ; (ze, qtvs) <- zonkTyBndrs qtvs
+ ; lhs_ty <- zonkTcTypeToTypeX ze lhs_ty
+ ; stupid_theta <- zonkTcTypesToTypesX ze stupid_theta
+ ; res_kind <- zonkTcTypeToTypeX ze res_kind
+
+ -- We check that res_kind is OK with checkDataKindSig in
+ -- tcDataFamInstDecl, after eta-expansion. We need to check that
+ -- it's ok because res_kind can come from a user-written kind signature.
+ -- See Note [Datatype return kinds], point (4a)
-- Check that type patterns match the class instance head
-- The call to splitTyConApp_maybe here is just an inlining of
@@ -899,7 +912,8 @@ tcDataFamInstHeader mb_clsinfo fam_tc imp_vars mb_bndrs fixity
; pats <- case splitTyConApp_maybe lhs_ty of
Just (_, pats) -> pure pats
Nothing -> pprPanic "tcDataFamInstHeader" (ppr lhs_ty)
- ; return (qtvs, pats, lhs_applied_kind, stupid_theta) }
+
+ ; return (qtvs, pats, res_kind, stupid_theta) }
where
fam_name = tyConName fam_tc
data_ctxt = DataKindCtxt fam_name
@@ -920,11 +934,7 @@ tcDataFamInstHeader mb_clsinfo fam_tc imp_vars mb_bndrs fixity
; lvl <- getTcLevel
; (subst, _tvs') <- tcInstSkolTyVarsAt lvl False emptyTCvSubst tvs
-- Perhaps surprisingly, we don't need the skolemised tvs themselves
- ; let final_kind = substTy subst inner_kind
- ; checkDataKindSig (DataInstanceSort new_or_data) $
- snd $ tcSplitPiTys final_kind
- -- See Note [Datatype return kinds], end of point (4)
- ; return final_kind }
+ ; return (substTy subst inner_kind) }
{- Note [Result kind signature for a data family instance]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -932,7 +942,7 @@ The expected type might have a forall at the type. Normally, we
can't skolemise in kinds because we don't have type-level lambda.
But here, we're at the top-level of an instance declaration, so
we actually have a place to put the regeneralised variables.
-Thus: skolemise away. cf. Inst.deeplySkolemise and GHC.Tc.Utils.Unify.tcSkolemise
+Thus: skolemise away. cf. GHC.Tc.Utils.Unify.tcSkolemise
Examples in indexed-types/should_compile/T12369
Note [Implementing eta reduction for data families]
@@ -1781,7 +1791,7 @@ tcMethodBodyHelp hs_sig_fn sel_id local_meth_id meth_bind
-- The instance-sig is the focus here; the class-meth-sig
-- is fixed (#18036)
; hs_wrap <- addErrCtxtM (methSigCtxt sel_name sig_ty local_meth_ty) $
- tcSubType_NC ctxt sig_ty local_meth_ty
+ tcSubTypeSigma ctxt sig_ty local_meth_ty
; return (sig_ty, hs_wrap) }
; inner_meth_name <- newName (nameOccName sel_name)
diff --git a/compiler/GHC/Tc/TyCl/PatSyn.hs b/compiler/GHC/Tc/TyCl/PatSyn.hs
index 957506c7c5..a785fbbb7a 100644
--- a/compiler/GHC/Tc/TyCl/PatSyn.hs
+++ b/compiler/GHC/Tc/TyCl/PatSyn.hs
@@ -431,9 +431,9 @@ tcCheckPatSynDecl psb@PSB{ psb_id = lname@(L _ name), psb_args = details
= do { -- Look up the variable actually bound by lpat
-- and check that it has the expected type
arg_id <- tcLookupId arg_name
- ; wrap <- tcSubType_NC GenSigCtxt
- (idType arg_id)
- (substTyUnchecked subst arg_ty)
+ ; wrap <- tcSubTypeSigma GenSigCtxt
+ (idType arg_id)
+ (substTyUnchecked subst arg_ty)
-- Why do we need tcSubType here?
-- See Note [Pattern synonyms and higher rank types]
; return (mkLHsWrap wrap $ nlHsVar arg_id) }
diff --git a/compiler/GHC/Tc/Types/Constraint.hs b/compiler/GHC/Tc/Types/Constraint.hs
index 908a23ff26..3f01a7d03a 100644
--- a/compiler/GHC/Tc/Types/Constraint.hs
+++ b/compiler/GHC/Tc/Types/Constraint.hs
@@ -29,7 +29,7 @@ module GHC.Tc.Types.Constraint (
WantedConstraints(..), insolubleWC, emptyWC, isEmptyWC,
isSolvedWC, andWC, unionsWC, mkSimpleWC, mkImplicWC,
- addInsols, insolublesOnly, addSimples, addImplics, addHole,
+ addInsols, dropMisleading, addSimples, addImplics, addHoles,
tyCoVarsOfWC, dropDerivedWC, dropDerivedSimples,
tyCoVarsOfWCList, insolubleCt, insolubleEqCt,
isDroppableCt, insolubleImplic,
@@ -961,19 +961,24 @@ addInsols :: WantedConstraints -> Bag Ct -> WantedConstraints
addInsols wc cts
= wc { wc_simple = wc_simple wc `unionBags` cts }
-addHole :: WantedConstraints -> Hole -> WantedConstraints
-addHole wc hole
- = wc { wc_holes = hole `consBag` wc_holes wc }
+addHoles :: WantedConstraints -> Bag Hole -> WantedConstraints
+addHoles wc holes
+ = wc { wc_holes = holes `unionBags` wc_holes wc }
-insolublesOnly :: WantedConstraints -> WantedConstraints
--- Keep only the definitely-insoluble constraints
-insolublesOnly (WC { wc_simple = simples, wc_impl = implics, wc_holes = holes })
- = WC { wc_simple = filterBag insolubleCt simples
- , wc_impl = mapBag implic_insols_only implics
+dropMisleading :: WantedConstraints -> WantedConstraints
+-- Drop misleading constraints; really just class constraints
+-- See Note [Constraints and errors] in GHC.Tc.Utils.Monad
+dropMisleading (WC { wc_simple = simples, wc_impl = implics, wc_holes = holes })
+ = WC { wc_simple = filterBag keep_ct simples
+ , wc_impl = mapBag drop_implic implics
, wc_holes = filterBag isOutOfScopeHole holes }
where
- implic_insols_only implic
- = implic { ic_wanted = insolublesOnly (ic_wanted implic) }
+ drop_implic implic
+ = implic { ic_wanted = dropMisleading (ic_wanted implic) }
+ keep_ct ct
+ = case classifyPredType (ctPred ct) of
+ ClassPred {} -> False
+ _ -> True
isSolvedStatus :: ImplicStatus -> Bool
isSolvedStatus (IC_Solved {}) = True
@@ -1100,9 +1105,6 @@ data Implication
ic_info :: SkolemInfo, -- See Note [Skolems in an implication]
-- See Note [Shadowing in a constraint]
- ic_telescope :: Maybe SDoc, -- User-written telescope, if there is one
- -- See Note [Checking telescopes]
-
ic_given :: [EvVar], -- Given evidence variables
-- (order does not matter)
-- See Invariant (GivenInv) in GHC.Tc.Utils.TcType
@@ -1153,7 +1155,6 @@ implicationPrototype
-- The rest have sensible default values
, ic_skols = []
- , ic_telescope = Nothing
, ic_given = []
, ic_wanted = emptyWC
, ic_no_eqs = False
@@ -1228,17 +1229,18 @@ all at once, creating one implication constraint for the lot:
variables (ic_skols). This is done in setImplicationStatus.
* This check is only necessary if the implication was born from a
- user-written signature. If, say, it comes from checking a pattern
- match that binds existentials, where the type of the data constructor
- is known to be valid (it in tcConPat), no need for the check.
+ 'forall' in a user-written signature (the HsForAllTy case in
+ GHC.Tc.Gen.HsType. If, say, it comes from checking a pattern match
+ that binds existentials, where the type of the data constructor is
+ known to be valid (it in tcConPat), no need for the check.
- So the check is done if and only if ic_telescope is (Just blah).
+ So the check is done if and only if ic_info is ForAllSkol
-* If ic_telesope is (Just d), the d::SDoc displays the original,
- user-written type variables.
+* If ic_info is (ForAllSkol dt dvs), the dvs::SDoc displays the
+ original, user-written type variables.
-* Be careful /NOT/ to discard an implication with non-Nothing
- ic_telescope, even if ic_wanted is empty. We must give the
+* Be careful /NOT/ to discard an implication with a ForAllSkol
+ ic_info, even if ic_wanted is empty. We must give the
constraint solver a chance to make that bad-telescope test! Hence
the extra guard in emitResidualTvConstraint; see #16247
diff --git a/compiler/GHC/Tc/Types/Origin.hs b/compiler/GHC/Tc/Types/Origin.hs
index 381cdd03ba..b453633c65 100644
--- a/compiler/GHC/Tc/Types/Origin.hs
+++ b/compiler/GHC/Tc/Types/Origin.hs
@@ -125,7 +125,7 @@ data UserTypeCtxt
pprUserTypeCtxt :: UserTypeCtxt -> SDoc
pprUserTypeCtxt (FunSigCtxt n _) = text "the type signature for" <+> quotes (ppr n)
pprUserTypeCtxt (InfSigCtxt n) = text "the inferred type for" <+> quotes (ppr n)
-pprUserTypeCtxt (RuleSigCtxt n) = text "a RULE for" <+> quotes (ppr n)
+pprUserTypeCtxt (RuleSigCtxt n) = text "the type signature for" <+> quotes (ppr n)
pprUserTypeCtxt ExprSigCtxt = text "an expression type signature"
pprUserTypeCtxt KindSigCtxt = text "a kind signature"
pprUserTypeCtxt (StandaloneKindSigCtxt n) = text "a standalone kind signature for" <+> quotes (ppr n)
@@ -184,7 +184,10 @@ data SkolemInfo
-- like SigSkol, but when we're kind-checking the *type*
-- hence, we have less info
- | ForAllSkol SDoc -- Bound by a user-written "forall".
+ | ForAllSkol -- Bound by a user-written "forall".
+ SDoc -- Shows the entire forall type
+ SDoc -- Shows just the binders, used when reporting a bad telescope
+ -- See Note [Checking telescopes] in GHC.Tc.Types.Constraint
| DerivSkol Type -- Bound by a 'deriving' clause;
-- the type is the instance we are trying to derive
@@ -242,7 +245,7 @@ pprSkolInfo :: SkolemInfo -> SDoc
-- Complete the sentence "is a rigid type variable bound by..."
pprSkolInfo (SigSkol cx ty _) = pprSigSkolInfo cx ty
pprSkolInfo (SigTypeSkol cx) = pprUserTypeCtxt cx
-pprSkolInfo (ForAllSkol doc) = quotes doc
+pprSkolInfo (ForAllSkol pt _) = quotes pt
pprSkolInfo (IPSkol ips) = text "the implicit-parameter binding" <> plural ips <+> text "for"
<+> pprWithCommas ppr ips
pprSkolInfo (DerivSkol pred) = text "the deriving clause for" <+> quotes (ppr pred)
@@ -306,8 +309,8 @@ is fine. We could do more, but it doesn't seem worth it.
Note [SigSkol SkolemInfo]
~~~~~~~~~~~~~~~~~~~~~~~~~
-Suppose we (deeply) skolemise a type
- f :: forall a. a -> forall b. b -> a
+Suppose we skolemise a type
+ f :: forall a. Eq a => forall b. b -> a
Then we'll instantiate [a :-> a', b :-> b'], and with the instantiated
a' -> b' -> a.
But when, in an error message, we report that "b is a rigid type
@@ -321,8 +324,8 @@ in the right place. So we proceed as follows:
* Then when tidying in GHC.Tc.Utils.TcMType.tidySkolemInfo, we first tidy a' to
whatever it tidies to, say a''; and then we walk over the type
replacing the binder a by the tidied version a'', to give
- forall a''. a'' -> forall b''. b'' -> a''
- We need to do this under function arrows, to match what deeplySkolemise
+ forall a''. Eq a'' => forall b''. b'' -> a''
+ We need to do this under (=>) arrows, to match what topSkolemise
does.
* Typically a'' will have a nice pretty name like "a", but the point is
diff --git a/compiler/GHC/Tc/Utils/Env.hs b/compiler/GHC/Tc/Utils/Env.hs
index 8c2a60ba50..2563ff7348 100644
--- a/compiler/GHC/Tc/Utils/Env.hs
+++ b/compiler/GHC/Tc/Utils/Env.hs
@@ -593,24 +593,29 @@ tc_extend_local_env top_lvl extra_env thing_inside
-- that are bound together with extra_env and should not be regarded
-- as free in the types of extra_env.
= do { traceTc "tc_extend_local_env" (ppr extra_env)
- ; env0 <- getLclEnv
- ; let env1 = tcExtendLocalTypeEnv env0 extra_env
; stage <- getStage
- ; let env2 = extend_local_env (top_lvl, thLevel stage) extra_env env1
- ; setLclEnv env2 thing_inside }
- where
- extend_local_env :: (TopLevelFlag, ThLevel) -> [(Name, TcTyThing)] -> TcLclEnv -> TcLclEnv
- -- Extend the local LocalRdrEnv and Template Haskell staging env simultaneously
- -- Reason for extending LocalRdrEnv: after running a TH splice we need
- -- to do renaming.
- extend_local_env thlvl pairs env@(TcLclEnv { tcl_rdr = rdr_env
- , tcl_th_bndrs = th_bndrs })
- = env { tcl_rdr = extendLocalRdrEnvList rdr_env
- [ n | (n, _) <- pairs, isInternalName n ]
- -- The LocalRdrEnv contains only non-top-level names
- -- (GlobalRdrEnv handles the top level)
- , tcl_th_bndrs = extendNameEnvList th_bndrs -- We only track Ids in tcl_th_bndrs
- [(n, thlvl) | (n, ATcId {}) <- pairs] }
+ ; env0@(TcLclEnv { tcl_rdr = rdr_env
+ , tcl_th_bndrs = th_bndrs
+ , tcl_env = lcl_type_env }) <- getLclEnv
+
+ ; let thlvl = (top_lvl, thLevel stage)
+
+ env1 = env0 { tcl_rdr = extendLocalRdrEnvList rdr_env
+ [ n | (n, _) <- extra_env, isInternalName n ]
+ -- The LocalRdrEnv contains only non-top-level names
+ -- (GlobalRdrEnv handles the top level)
+
+ , tcl_th_bndrs = extendNameEnvList th_bndrs
+ [(n, thlvl) | (n, ATcId {}) <- extra_env]
+ -- We only track Ids in tcl_th_bndrs
+
+ , tcl_env = extendNameEnvList lcl_type_env extra_env }
+
+ -- tcl_rdr and tcl_th_bndrs: extend the local LocalRdrEnv and
+ -- Template Haskell staging env simultaneously. Reason for extending
+ -- LocalRdrEnv: after running a TH splice we need to do renaming.
+
+ ; setLclEnv env1 thing_inside }
tcExtendLocalTypeEnv :: TcLclEnv -> [(Name, TcTyThing)] -> TcLclEnv
tcExtendLocalTypeEnv lcl_env@(TcLclEnv { tcl_env = lcl_type_env }) tc_ty_things
diff --git a/compiler/GHC/Tc/Utils/Instantiate.hs b/compiler/GHC/Tc/Utils/Instantiate.hs
index ea8ffd912b..df9cf982ee 100644
--- a/compiler/GHC/Tc/Utils/Instantiate.hs
+++ b/compiler/GHC/Tc/Utils/Instantiate.hs
@@ -10,10 +10,9 @@
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
--- | The @Inst@ type: dictionaries or method instances
module GHC.Tc.Utils.Instantiate (
- deeplySkolemise,
- topInstantiate, topInstantiateInferred, deeplyInstantiate,
+ topSkolemise,
+ topInstantiate, topInstantiateInferred,
instCall, instDFunType, instStupidTheta, instTyVarsWith,
newWanted, newWanteds,
@@ -36,11 +35,10 @@ module GHC.Tc.Utils.Instantiate (
import GHC.Prelude
-import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcCheckExpr, tcSyntaxOp )
+import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcCheckPolyExpr, tcSyntaxOp )
import {-# SOURCE #-} GHC.Tc.Utils.Unify( unifyType, unifyKind )
import GHC.Types.Basic ( IntegralLit(..), SourceText(..) )
-import GHC.Data.FastString
import GHC.Hs
import GHC.Tc.Utils.Zonk
import GHC.Tc.Utils.Monad
@@ -117,66 +115,62 @@ newMethodFromName origin name ty_args
{-
************************************************************************
* *
- Deep instantiation and skolemisation
+ Instantiation and skolemisation
* *
************************************************************************
-Note [Deep skolemisation]
-~~~~~~~~~~~~~~~~~~~~~~~~~
-deeplySkolemise decomposes and skolemises a type, returning a type
-with all its arrows visible (ie not buried under foralls)
+Note [Skolemisation]
+~~~~~~~~~~~~~~~~~~~~
+topSkolemise decomposes and skolemises a type, returning a type
+with no top level foralls or (=>)
Examples:
- deeplySkolemise (Int -> forall a. Ord a => blah)
- = ( wp, [a], [d:Ord a], Int -> blah )
- where wp = \x:Int. /\a. \(d:Ord a). <hole> x
+ topSkolemise (forall a. Ord a => a -> a)
+ = ( wp, [a], [d:Ord a], a->a )
+ where wp = /\a. \(d:Ord a). <hole> a d
- deeplySkolemise (forall a. Ord a => Maybe a -> forall b. Eq b => blah)
- = ( wp, [a,b], [d1:Ord a,d2:Eq b], Maybe a -> blah )
- where wp = /\a.\(d1:Ord a).\(x:Maybe a)./\b.\(d2:Ord b). <hole> x
+ topSkolemise (forall a. Ord a => forall b. Eq b => a->b->b)
+ = ( wp, [a,b], [d1:Ord a,d2:Eq b], a->b->b )
+ where wp = /\a.\(d1:Ord a)./\b.\(d2:Ord b). <hole> a d1 b d2
+
+This second example is the reason for the recursive 'go'
+function in topSkolemise: we must remove successive layers
+of foralls and (=>).
In general,
- if deeplySkolemise ty = (wrap, tvs, evs, rho)
+ if topSkolemise ty = (wrap, tvs, evs, rho)
and e :: rho
then wrap e :: ty
- and 'wrap' binds tvs, evs
+ and 'wrap' binds {tvs, evs}
-ToDo: this eta-abstraction plays fast and loose with termination,
- because it can introduce extra lambdas. Maybe add a `seq` to
- fix this
-}
-deeplySkolemise :: TcSigmaType
- -> TcM ( HsWrapper
- , [(Name,TyVar)] -- All skolemised variables
- , [EvVar] -- All "given"s
- , TcRhoType )
-
-deeplySkolemise ty
- = go init_subst ty
+topSkolemise :: TcSigmaType
+ -> TcM ( HsWrapper
+ , [(Name,TyVar)] -- All skolemised variables
+ , [EvVar] -- All "given"s
+ , TcRhoType )
+-- See Note [Skolemisation]
+topSkolemise ty
+ = go init_subst idHsWrapper [] [] ty
where
init_subst = mkEmptyTCvSubst (mkInScopeSet (tyCoVarsOfType ty))
- go subst ty
- | Just (arg_tys, tvs, theta, ty') <- tcDeepSplitSigmaTy_maybe ty
- = do { let arg_tys' = substTys subst arg_tys
- ; ids1 <- newSysLocalIds (fsLit "dk") arg_tys'
- ; (subst', tvs1) <- tcInstSkolTyVarsX subst tvs
+ -- Why recursive? See Note [Skolemisation]
+ go subst wrap tv_prs ev_vars ty
+ | (tvs, theta, inner_ty) <- tcSplitSigmaTy ty
+ , not (null tvs && null theta)
+ = do { (subst', tvs1) <- tcInstSkolTyVarsX subst tvs
; ev_vars1 <- newEvVars (substTheta subst' theta)
- ; (wrap, tvs_prs2, ev_vars2, rho) <- go subst' ty'
- ; let tv_prs1 = map tyVarName tvs `zip` tvs1
- ; return ( mkWpLams ids1
- <.> mkWpTyLams tvs1
- <.> mkWpLams ev_vars1
- <.> wrap
- <.> mkWpEvVarApps ids1
- , tv_prs1 ++ tvs_prs2
- , ev_vars1 ++ ev_vars2
- , mkVisFunTys arg_tys' rho ) }
+ ; go subst'
+ (wrap <.> mkWpTyLams tvs1 <.> mkWpLams ev_vars1)
+ (tv_prs ++ (map tyVarName tvs `zip` tvs1))
+ (ev_vars ++ ev_vars1)
+ inner_ty }
| otherwise
- = return (idHsWrapper, [], [], substTy subst ty)
+ = return (wrap, tv_prs, ev_vars, substTy subst ty)
-- substTy is a quick no-op on an empty substitution
-- | Instantiate all outer type variables
@@ -185,6 +179,7 @@ topInstantiate :: CtOrigin -> TcSigmaType -> TcM (HsWrapper, TcRhoType)
-- if topInstantiate ty = (wrap, rho)
-- and e :: ty
-- then wrap e :: rho (that is, wrap :: ty "->" rho)
+-- NB: always returns a rho-type, with no top-level forall or (=>)
topInstantiate = top_instantiate True
-- | Instantiate all outer 'Inferred' binders
@@ -195,13 +190,16 @@ topInstantiateInferred :: CtOrigin -> TcSigmaType
-- if topInstantiate ty = (wrap, rho)
-- and e :: ty
-- then wrap e :: rho
+-- NB: may return a sigma-type
topInstantiateInferred = top_instantiate False
top_instantiate :: Bool -- True <=> instantiate *all* variables
-- False <=> instantiate only the inferred ones
-> CtOrigin -> TcSigmaType -> TcM (HsWrapper, TcRhoType)
top_instantiate inst_all orig ty
- | not (null binders && null theta)
+ | (binders, phi) <- tcSplitForAllVarBndrs ty
+ , (theta, rho) <- tcSplitPhiTy phi
+ , not (null binders && null theta)
= do { let (inst_bndrs, leave_bndrs) = span should_inst binders
(inst_theta, leave_theta)
| null leave_bndrs = (theta, [])
@@ -226,7 +224,7 @@ top_instantiate inst_all orig ty
, text "theta:" <+> ppr inst_theta' ])
; (wrap2, rho2) <-
- if null leave_bndrs
+ if null leave_bndrs -- NB: if inst_all is True then leave_bndrs = []
-- account for types like forall a. Num a => forall b. Ord b => ...
then top_instantiate inst_all orig sigma'
@@ -238,67 +236,11 @@ top_instantiate inst_all orig ty
| otherwise = return (idHsWrapper, ty)
where
- (binders, phi) = tcSplitForAllVarBndrs ty
- (theta, rho) = tcSplitPhiTy phi
should_inst bndr
| inst_all = True
| otherwise = binderArgFlag bndr == Inferred
-deeplyInstantiate :: CtOrigin -> TcSigmaType -> TcM (HsWrapper, TcRhoType)
--- Int -> forall a. a -> a ==> (\x:Int. [] x alpha) :: Int -> alpha
--- In general if
--- if deeplyInstantiate ty = (wrap, rho)
--- and e :: ty
--- then wrap e :: rho
--- That is, wrap :: ty ~> rho
---
--- If you don't need the HsWrapper returned from this function, consider
--- using tcSplitNestedSigmaTys in GHC.Tc.Utils.TcType, which is a pure alternative that
--- only computes the returned TcRhoType.
-
-deeplyInstantiate orig ty =
- deeply_instantiate orig
- (mkEmptyTCvSubst (mkInScopeSet (tyCoVarsOfType ty)))
- ty
-
-deeply_instantiate :: CtOrigin
- -> TCvSubst
- -> TcSigmaType -> TcM (HsWrapper, TcRhoType)
--- Internal function to deeply instantiate that builds on an existing subst.
--- It extends the input substitution and applies the final substitution to
--- the types on return. See #12549.
-
-deeply_instantiate orig subst ty
- | Just (arg_tys, tvs, theta, rho) <- tcDeepSplitSigmaTy_maybe ty
- = do { (subst', tvs') <- newMetaTyVarsX subst tvs
- ; let arg_tys' = substTys subst' arg_tys
- theta' = substTheta subst' theta
- ; ids1 <- newSysLocalIds (fsLit "di") arg_tys'
- ; wrap1 <- instCall orig (mkTyVarTys tvs') theta'
- ; traceTc "Instantiating (deeply)" (vcat [ text "origin" <+> pprCtOrigin orig
- , text "type" <+> ppr ty
- , text "with" <+> ppr tvs'
- , text "args:" <+> ppr ids1
- , text "theta:" <+> ppr theta'
- , text "subst:" <+> ppr subst'])
- ; (wrap2, rho2) <- deeply_instantiate orig subst' rho
- ; return (mkWpLams ids1
- <.> wrap2
- <.> wrap1
- <.> mkWpEvVarApps ids1,
- mkVisFunTys arg_tys' rho2) }
-
- | otherwise
- = do { let ty' = substTy subst ty
- ; traceTc "deeply_instantiate final subst"
- (vcat [ text "origin:" <+> pprCtOrigin orig
- , text "type:" <+> ppr ty
- , text "new type:" <+> ppr ty'
- , text "subst:" <+> ppr subst ])
- ; return (idHsWrapper, ty') }
-
-
instTyVarsWith :: CtOrigin -> [TyVar] -> [TcType] -> TcM TCvSubst
-- Use this when you want to instantiate (forall a b c. ty) with
-- types [ta, tb, tc], but when the kinds of 'a' and 'ta' might
@@ -639,7 +581,7 @@ tcSyntaxName orig ty (std_nm, user_nm_expr) = do
-- same type as the standard one.
-- Tiresome jiggling because tcCheckSigma takes a located expression
span <- getSrcSpanM
- expr <- tcCheckExpr (L span user_nm_expr) sigma1
+ expr <- tcCheckPolyExpr (L span user_nm_expr) sigma1
return (std_nm, unLoc expr)
syntaxNameCtxt :: HsExpr GhcRn -> CtOrigin -> Type -> TidyEnv
diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs
index 2fc741ce6f..d7fbd2e095 100644
--- a/compiler/GHC/Tc/Utils/Monad.hs
+++ b/compiler/GHC/Tc/Utils/Monad.hs
@@ -98,7 +98,8 @@ module GHC.Tc.Utils.Monad(
chooseUniqueOccTc,
getConstraintVar, setConstraintVar,
emitConstraints, emitStaticConstraints, emitSimple, emitSimples,
- emitImplication, emitImplications, emitInsoluble, emitHole,
+ emitImplication, emitImplications, emitInsoluble,
+ emitHole, emitHoles,
discardConstraints, captureConstraints, tryCaptureConstraints,
pushLevelAndCaptureConstraints,
pushTcLevelM_, pushTcLevelM, pushTcLevelsM,
@@ -1145,7 +1146,7 @@ askNoErrs thing_inside
; addMessages msgs
; case mb_res of
- Nothing -> do { emitConstraints (insolublesOnly lie)
+ Nothing -> do { emitConstraints (dropMisleading lie)
; failM }
Just res -> do { emitConstraints lie
@@ -1167,7 +1168,7 @@ tryCaptureConstraints thing_inside
-- See Note [Constraints and errors]
; let lie_to_keep = case mb_res of
- Nothing -> insolublesOnly lie
+ Nothing -> dropMisleading lie
Just {} -> lie
; return (mb_res, lie_to_keep) }
@@ -1589,7 +1590,13 @@ emitHole :: Hole -> TcM ()
emitHole hole
= do { traceTc "emitHole" (ppr hole)
; lie_var <- getConstraintVar
- ; updTcRef lie_var (`addHole` hole) }
+ ; updTcRef lie_var (`addHoles` unitBag hole) }
+
+emitHoles :: Bag Hole -> TcM ()
+emitHoles holes
+ = do { traceTc "emitHoles" (ppr holes)
+ ; lie_var <- getConstraintVar
+ ; updTcRef lie_var (`addHoles` holes) }
-- | Throw out any constraints emitted by the thing_inside
discardConstraints :: TcM a -> TcM a
diff --git a/compiler/GHC/Tc/Utils/TcMType.hs b/compiler/GHC/Tc/Utils/TcMType.hs
index d06307263d..97267a8641 100644
--- a/compiler/GHC/Tc/Utils/TcMType.hs
+++ b/compiler/GHC/Tc/Utils/TcMType.hs
@@ -27,7 +27,8 @@ module GHC.Tc.Utils.TcMType (
newFmvTyVar, newFskTyVar,
readMetaTyVar, writeMetaTyVar, writeMetaTyVarRef,
- newMetaDetails, isFilledMetaTyVar_maybe, isFilledMetaTyVar, isUnfilledMetaTyVar,
+ newTauTvDetailsAtLevel, newMetaDetails, newMetaTyVarName,
+ isFilledMetaTyVar_maybe, isFilledMetaTyVar, isUnfilledMetaTyVar,
--------------------------------
-- Expected types
@@ -70,7 +71,7 @@ module GHC.Tc.Utils.TcMType (
zonkTidyTcType, zonkTidyTcTypes, zonkTidyOrigin,
tidyEvVar, tidyCt, tidyHole, tidySkolemInfo,
zonkTcTyVar, zonkTcTyVars,
- zonkTcTyVarToTyVar, zonkTyVarTyVarPairs,
+ zonkTcTyVarToTyVar, zonkInvisTVBinder,
zonkTyCoVarsAndFV, zonkTcTypeAndFV, zonkDTyCoVarSetAndFV,
zonkTyCoVarsAndFVList,
candidateQTyVarsOfType, candidateQTyVarsOfKind,
@@ -81,7 +82,7 @@ module GHC.Tc.Utils.TcMType (
zonkTcType, zonkTcTypes, zonkCo,
zonkTyCoVarKind, zonkTyCoVarKindBinder,
- zonkEvVar, zonkWC, zonkSimples,
+ zonkEvVar, zonkWC, zonkImplication, zonkSimples,
zonkId, zonkCoVar,
zonkCt, zonkSkolemInfo,
@@ -119,7 +120,6 @@ import GHC.Builtin.Types
import GHC.Builtin.Types.Prim
import GHC.Types.Var.Env
import GHC.Types.Name.Env
-import GHC.Builtin.Names
import GHC.Utils.Misc
import GHC.Utils.Outputable
import GHC.Data.FastString
@@ -144,18 +144,13 @@ import qualified Data.Semigroup as Semi
************************************************************************
-}
-mkKindName :: Unique -> Name
-mkKindName unique = mkSystemName unique kind_var_occ
-
-kind_var_occ :: OccName -- Just one for all MetaKindVars
- -- They may be jiggled by tidying
-kind_var_occ = mkOccName tvName "k"
-
newMetaKindVar :: TcM TcKind
newMetaKindVar
= do { details <- newMetaDetails TauTv
- ; uniq <- newUnique
- ; let kv = mkTcTyVar (mkKindName uniq) liftedTypeKind details
+ ; name <- newMetaTyVarName (fsLit "k")
+ -- All MetaKindVars are called "k"
+ -- They may be jiggled by tidying
+ ; let kv = mkTcTyVar name liftedTypeKind details
; traceTc "newMetaKindVar" (ppr kv)
; return (mkTyVarTy kv) }
@@ -834,6 +829,13 @@ newMetaDetails info
, mtv_ref = ref
, mtv_tclvl = tclvl }) }
+newTauTvDetailsAtLevel :: TcLevel -> TcM TcTyVarDetails
+newTauTvDetailsAtLevel tclvl
+ = do { ref <- newMutVar Flexi
+ ; return (MetaTv { mtv_info = TauTv
+ , mtv_ref = ref
+ , mtv_tclvl = tclvl }) }
+
cloneMetaTyVar :: TcTyVar -> TcM TcTyVar
cloneMetaTyVar tv
= ASSERT( isTcTyVar tv )
@@ -1060,18 +1062,15 @@ new_meta_tv_x info subst tv
-- is not yet fixed so leaving as unchecked for now.
-- OLD NOTE:
-- Unchecked because we call newMetaTyVarX from
- -- tcInstTyBinder, which is called from tcInferApps
+ -- tcInstTyBinder, which is called from tcInferTyApps
-- which does not yet take enough trouble to ensure
-- the in-scope set is right; e.g. #12785 trips
-- if we use substTy here
newMetaTyVarTyAtLevel :: TcLevel -> TcKind -> TcM TcType
newMetaTyVarTyAtLevel tc_lvl kind
- = do { ref <- newMutVar Flexi
- ; name <- newMetaTyVarName (fsLit "p")
- ; let details = MetaTv { mtv_info = TauTv
- , mtv_ref = ref
- , mtv_tclvl = tc_lvl }
+ = do { details <- newTauTvDetailsAtLevel tc_lvl
+ ; name <- newMetaTyVarName (fsLit "p")
; return (mkTyVarTy (mkTcTyVar name kind details)) }
{- *********************************************************************
@@ -1254,13 +1253,14 @@ instance Outputable CandidatesQTvs where
candidateKindVars :: CandidatesQTvs -> TyVarSet
candidateKindVars dvs = dVarSetToVarSet (dv_kvs dvs)
-partitionCandidates :: CandidatesQTvs -> (TyVar -> Bool) -> (DTyVarSet, CandidatesQTvs)
+partitionCandidates :: CandidatesQTvs -> (TyVar -> Bool) -> (TyVarSet, CandidatesQTvs)
+-- The selected TyVars are returned as a non-deterministic TyVarSet
partitionCandidates dvs@(DV { dv_kvs = kvs, dv_tvs = tvs }) pred
= (extracted, dvs { dv_kvs = rest_kvs, dv_tvs = rest_tvs })
where
(extracted_kvs, rest_kvs) = partitionDVarSet pred kvs
(extracted_tvs, rest_tvs) = partitionDVarSet pred tvs
- extracted = extracted_kvs `unionDVarSet` extracted_tvs
+ extracted = dVarSetToVarSet extracted_kvs `unionVarSet` dVarSetToVarSet extracted_tvs
-- | Gathers free variables to use as quantification candidates (in
-- 'quantifyTyVars'). This might output the same var
@@ -2218,12 +2218,9 @@ zonkTcTyVarToTyVar tv
(ppr tv $$ ppr ty)
; return tv' }
-zonkTyVarTyVarPairs :: [(Name,VarBndr TcTyVar Specificity)] -> TcM [(Name,VarBndr TcTyVar Specificity)]
-zonkTyVarTyVarPairs prs
- = mapM do_one prs
- where
- do_one (nm, Bndr tv spec) = do { tv' <- zonkTcTyVarToTyVar tv
- ; return (nm, Bndr tv' spec) }
+zonkInvisTVBinder :: VarBndr TcTyVar spec -> TcM (VarBndr TyVar spec)
+zonkInvisTVBinder (Bndr tv spec) = do { tv' <- zonkTcTyVarToTyVar tv
+ ; return (Bndr tv' spec) }
-- zonkId is used *during* typechecking just to zonk the Id's type
zonkId :: TcId -> TcM TcId
@@ -2342,7 +2339,7 @@ tidySigSkol env cx ty tv_prs
where
(env', tv') = tidy_tv_bndr env tv
- tidy_ty env ty@(FunTy _ arg res)
+ tidy_ty env ty@(FunTy InvisArg arg res) -- Look under c => t
= ty { ft_arg = tidyType env arg, ft_res = tidy_ty env res }
tidy_ty env ty = tidyType env ty
diff --git a/compiler/GHC/Tc/Utils/TcType.hs b/compiler/GHC/Tc/Utils/TcType.hs
index fb1d6f432b..c1d7af0120 100644
--- a/compiler/GHC/Tc/Utils/TcType.hs
+++ b/compiler/GHC/Tc/Utils/TcType.hs
@@ -67,7 +67,7 @@ module GHC.Tc.Utils.TcType (
tcSplitAppTy_maybe, tcSplitAppTy, tcSplitAppTys, tcRepSplitAppTy_maybe,
tcRepGetNumAppTys,
tcGetCastedTyVar_maybe, tcGetTyVar_maybe, tcGetTyVar,
- tcSplitSigmaTy, tcSplitNestedSigmaTys, tcDeepSplitSigmaTy_maybe,
+ tcSplitSigmaTy, tcSplitNestedSigmaTys,
---------------------------------
-- Predicates.
@@ -412,7 +412,7 @@ mkCheckExpType = Check
-- This is defined here to avoid defining it in GHC.Tc.Gen.Expr boot file.
data SyntaxOpType
= SynAny -- ^ Any type
- | SynRho -- ^ A rho type, deeply skolemised or instantiated as appropriate
+ | SynRho -- ^ A rho type, skolemised or instantiated as appropriate
| SynList -- ^ A list type. You get back the element type of the list
| SynFun SyntaxOpType SyntaxOpType
-- ^ A function.
@@ -431,11 +431,12 @@ mkSynFunTys arg_tys res_ty = foldr SynFun (SynType res_ty) arg_tys
{-
Note [TcRhoType]
~~~~~~~~~~~~~~~~
-A TcRhoType has no foralls or contexts at the top, or to the right of an arrow
- YES (forall a. a->a) -> Int
+A TcRhoType has no foralls or contexts at the top
NO forall a. a -> Int
NO Eq a => a -> a
- NO Int -> forall a. a -> Int
+ YES a -> a
+ YES (forall a. a->a) -> Int
+ YES Int -> forall a. a -> Int
************************************************************************
@@ -1273,35 +1274,19 @@ tcSplitSigmaTy ty = case tcSplitForAllTys ty of
-- if you instead called @tcSplitNestedSigmaTys@ on the type, it would return
-- @([s,t,a,b,f], [Each s t a b, Applicative f], (a -> f b) -> s -> f t)@.
tcSplitNestedSigmaTys :: Type -> ([TyVar], ThetaType, Type)
--- NB: This is basically a pure version of deeplyInstantiate (from Inst) that
+-- NB: This is basically a pure version of topInstantiate (from Inst) that
-- doesn't compute an HsWrapper.
tcSplitNestedSigmaTys ty
-- If there's a forall, split it apart and try splitting the rho type
-- underneath it.
- | Just (arg_tys, tvs1, theta1, rho1) <- tcDeepSplitSigmaTy_maybe ty
+ | (tvs1, theta1, rho1) <- tcSplitSigmaTy ty
+ , not (null tvs1 && null theta1)
= let (tvs2, theta2, rho2) = tcSplitNestedSigmaTys rho1
- in (tvs1 ++ tvs2, theta1 ++ theta2, mkVisFunTys arg_tys rho2)
+ in (tvs1 ++ tvs2, theta1 ++ theta2, rho2)
-- If there's no forall, we're done.
| otherwise = ([], [], ty)
-----------------------
-tcDeepSplitSigmaTy_maybe
- :: TcSigmaType -> Maybe ([TcType], [TyVar], ThetaType, TcSigmaType)
--- Looks for a *non-trivial* quantified type, under zero or more function arrows
--- By "non-trivial" we mean either tyvars or constraints are non-empty
-
-tcDeepSplitSigmaTy_maybe ty
- | Just (arg_ty, res_ty) <- tcSplitFunTy_maybe ty
- , Just (arg_tys, tvs, theta, rho) <- tcDeepSplitSigmaTy_maybe res_ty
- = Just (arg_ty:arg_tys, tvs, theta, rho)
-
- | (tvs, theta, rho) <- tcSplitSigmaTy ty
- , not (null tvs && null theta)
- = Just ([], tvs, theta, rho)
-
- | otherwise = Nothing
-
------------------------
tcTyConAppTyCon :: Type -> TyCon
tcTyConAppTyCon ty
= case tcTyConAppTyCon_maybe ty of
@@ -1997,9 +1982,9 @@ isSigmaTy _ = False
isRhoTy :: TcType -> Bool -- True of TcRhoTypes; see Note [TcRhoType]
isRhoTy ty | Just ty' <- tcView ty = isRhoTy ty'
-isRhoTy (ForAllTy {}) = False
-isRhoTy (FunTy { ft_af = VisArg, ft_res = r }) = isRhoTy r
-isRhoTy _ = True
+isRhoTy (ForAllTy {}) = False
+isRhoTy (FunTy { ft_af = InvisArg }) = False
+isRhoTy _ = True
-- | Like 'isRhoTy', but also says 'True' for 'Infer' types
isRhoExpTy :: ExpType -> Bool
diff --git a/compiler/GHC/Tc/Utils/Unify.hs b/compiler/GHC/Tc/Utils/Unify.hs
index 7c14e56319..8ca3ae7723 100644
--- a/compiler/GHC/Tc/Utils/Unify.hs
+++ b/compiler/GHC/Tc/Utils/Unify.hs
@@ -13,11 +13,11 @@
-- | Type subsumption and unification
module GHC.Tc.Utils.Unify (
-- Full-blown subsumption
- tcWrapResult, tcWrapResultO, tcSkolemise, tcSkolemiseET,
- tcSubTypeHR, tcSubTypeO, tcSubType_NC, tcSubTypeDS,
- tcSubTypeDS_NC_O, tcSubTypePat,
+ tcWrapResult, tcWrapResultO, tcWrapResultMono,
+ tcSkolemise, tcSkolemiseScoped, tcSkolemiseET,
+ tcSubType, tcSubTypeSigma, tcSubTypePat,
checkConstraints, checkTvConstraints,
- buildImplicationFor, emitResidualTvConstraint,
+ buildImplicationFor, buildTvImplication, emitResidualTvConstraint,
-- Various unifications
unifyType, unifyKind,
@@ -31,7 +31,7 @@ module GHC.Tc.Utils.Unify (
matchExpectedTyConApp,
matchExpectedAppTy,
matchExpectedFunTys,
- matchActualFunTys, matchActualFunTysPart,
+ matchActualFunTysRho, matchActualFunTySigma,
matchExpectedFunKind,
metaTyVarUpdateOK, occCheckForErrors, MetaTyVarUpdateResult(..)
@@ -48,6 +48,7 @@ import GHC.Core.TyCo.Ppr( debugPprType )
import GHC.Tc.Utils.TcMType
import GHC.Tc.Utils.Monad
import GHC.Tc.Utils.TcType
+import GHC.Tc.Utils.Env
import GHC.Core.Type
import GHC.Core.Coercion
import GHC.Tc.Types.Evidence
@@ -70,7 +71,6 @@ import GHC.Utils.Misc
import qualified GHC.LanguageExtensions as LangExt
import GHC.Utils.Outputable as Outputable
-import Data.Maybe( isNothing )
import Control.Monad
import Control.Arrow ( second )
@@ -139,34 +139,46 @@ passed in.
-}
-- Use this one when you have an "expected" type.
+-- This function skolemises at each polytype.
matchExpectedFunTys :: forall a.
SDoc -- See Note [Herald for matchExpectedFunTys]
+ -> UserTypeCtxt
-> Arity
- -> ExpRhoType -- deeply skolemised
+ -> ExpRhoType -- Skolemised
-> ([ExpSigmaType] -> ExpRhoType -> TcM a)
- -- must fill in these ExpTypes here
- -> TcM (a, HsWrapper)
+ -> TcM (HsWrapper, a)
-- If matchExpectedFunTys n ty = (_, wrap)
-- then wrap : (t1 -> ... -> tn -> ty_r) ~> ty,
-- where [t1, ..., tn], ty_r are passed to the thing_inside
-matchExpectedFunTys herald arity orig_ty thing_inside
+matchExpectedFunTys herald ctx arity orig_ty thing_inside
= case orig_ty of
Check ty -> go [] arity ty
_ -> defer [] arity orig_ty
where
- go acc_arg_tys 0 ty
- = do { result <- thing_inside (reverse acc_arg_tys) (mkCheckExpType ty)
- ; return (result, idHsWrapper) }
+ -- Skolemise any foralls /before/ the zero-arg case
+ -- so that we guarantee to return a rho-type
+ go acc_arg_tys n ty
+ | (tvs, theta, _) <- tcSplitSigmaTy ty
+ , not (null tvs && null theta)
+ = do { (wrap_gen, (wrap_res, result)) <- tcSkolemise ctx ty $ \ty' ->
+ go acc_arg_tys n ty'
+ ; return (wrap_gen <.> wrap_res, result) }
+
+ -- No more args; do this /before/ tcView, so
+ -- that we do not unnecessarily unwrap synonyms
+ go acc_arg_tys 0 rho_ty
+ = do { result <- thing_inside (reverse acc_arg_tys) (mkCheckExpType rho_ty)
+ ; return (idHsWrapper, result) }
go acc_arg_tys n ty
| Just ty' <- tcView ty = go acc_arg_tys n ty'
go acc_arg_tys n (FunTy { ft_af = af, ft_arg = arg_ty, ft_res = res_ty })
= ASSERT( af == VisArg )
- do { (result, wrap_res) <- go (mkCheckExpType arg_ty : acc_arg_tys)
+ do { (wrap_res, result) <- go (mkCheckExpType arg_ty : acc_arg_tys)
(n-1) res_ty
- ; return ( result
- , mkWpFun idHsWrapper wrap_res arg_ty res_ty doc ) }
+ ; let fun_wrap = mkWpFun idHsWrapper wrap_res arg_ty res_ty doc
+ ; return ( fun_wrap, result ) }
where
doc = text "When inferring the argument type of a function with type" <+>
quotes (ppr orig_ty)
@@ -197,7 +209,7 @@ matchExpectedFunTys herald arity orig_ty thing_inside
defer acc_arg_tys n (mkCheckExpType ty)
------------
- defer :: [ExpSigmaType] -> Arity -> ExpRhoType -> TcM (a, HsWrapper)
+ defer :: [ExpSigmaType] -> Arity -> ExpRhoType -> TcM (HsWrapper, a)
defer acc_arg_tys n fun_ty
= do { more_arg_tys <- replicateM n newInferExpType
; res_ty <- newInferExpType
@@ -205,9 +217,9 @@ matchExpectedFunTys herald arity orig_ty thing_inside
; more_arg_tys <- mapM readExpType more_arg_tys
; res_ty <- readExpType res_ty
; let unif_fun_ty = mkVisFunTys more_arg_tys res_ty
- ; wrap <- tcSubTypeDS AppOrigin GenSigCtxt unif_fun_ty fun_ty
+ ; wrap <- tcSubType AppOrigin ctx unif_fun_ty fun_ty
-- Not a good origin at all :-(
- ; return (result, wrap) }
+ ; return (wrap, result) }
------------
mk_ctxt :: [ExpSigmaType] -> TcType -> TidyEnv -> TcM (TidyEnv, MsgDoc)
@@ -220,36 +232,54 @@ matchExpectedFunTys herald arity orig_ty thing_inside
-- Like 'matchExpectedFunTys', but used when you have an "actual" type,
-- for example in function application
-matchActualFunTys :: SDoc -- See Note [Herald for matchExpectedFunTys]
- -> CtOrigin
- -> Maybe (HsExpr GhcRn) -- the thing with type TcSigmaType
- -> Arity
- -> TcSigmaType
- -> TcM (HsWrapper, [TcSigmaType], TcSigmaType)
--- If matchActualFunTys n ty = (wrap, [t1,..,tn], ty_r)
--- then wrap : ty ~> (t1 -> ... -> tn -> ty_r)
-matchActualFunTys herald ct_orig mb_thing n_val_args_wanted fun_ty
- = matchActualFunTysPart herald ct_orig mb_thing
- n_val_args_wanted []
- n_val_args_wanted fun_ty
-
--- | Variant of 'matchActualFunTys' that works when supplied only part
--- (that is, to the right of some arrows) of the full function type
-matchActualFunTysPart
+matchActualFunTysRho :: SDoc -- See Note [Herald for matchExpectedFunTys]
+ -> CtOrigin
+ -> Maybe (HsExpr GhcRn) -- the thing with type TcSigmaType
+ -> Arity
+ -> TcSigmaType
+ -> TcM (HsWrapper, [TcSigmaType], TcRhoType)
+-- If matchActualFunTysRho n ty = (wrap, [t1,..,tn], res_ty)
+-- then wrap : ty ~> (t1 -> ... -> tn -> res_ty)
+-- and res_ty is a RhoType
+-- NB: the returned type is top-instantiated; it's a RhoType
+matchActualFunTysRho herald ct_orig mb_thing n_val_args_wanted fun_ty
+ = go n_val_args_wanted [] fun_ty
+ where
+ go 0 _ fun_ty
+ = do { (wrap, rho) <- topInstantiate ct_orig fun_ty
+ ; return (wrap, [], rho) }
+ go n so_far fun_ty
+ = do { (wrap_fun1, arg_ty1, res_ty1) <- matchActualFunTySigma
+ herald ct_orig mb_thing
+ (n_val_args_wanted, so_far)
+ fun_ty
+ ; (wrap_res, arg_tys, res_ty) <- go (n-1) (arg_ty1:so_far) res_ty1
+ ; let wrap_fun2 = mkWpFun idHsWrapper wrap_res arg_ty1 res_ty doc
+ ; return (wrap_fun2 <.> wrap_fun1, arg_ty1:arg_tys, res_ty) }
+ where
+ doc = text "When inferring the argument type of a function with type" <+>
+ quotes (ppr fun_ty)
+
+-- | matchActualFunTySigm does looks for just one function arrow
+-- returning an uninstantiated sigma-type
+matchActualFunTySigma
:: SDoc -- See Note [Herald for matchExpectedFunTys]
-> CtOrigin
- -> Maybe (HsExpr GhcRn) -- The thing with type TcSigmaType
- -> Arity -- Total number of value args in the call
- -> [TcSigmaType] -- Types of values args to which function has
- -- been applied already (reversed)
- -> Arity -- Number of new value args wanted
- -> TcSigmaType -- Type to analyse
- -> TcM (HsWrapper, [TcSigmaType], TcSigmaType)
+ -> Maybe (HsExpr GhcRn) -- The thing with type TcSigmaType
+ -> (Arity, [TcSigmaType]) -- Total number of value args in the call, and
+ -- types of values args to which function has
+ -- been applied already (reversed)
+ -- Both are used only for error messages)
+ -> TcSigmaType -- Type to analyse
+ -> TcM (HsWrapper, TcSigmaType, TcSigmaType)
-- See Note [matchActualFunTys error handling] for all these arguments
-matchActualFunTysPart herald ct_orig mb_thing
- n_val_args_in_call arg_tys_so_far
- n_val_args_wanted fun_ty
- = go n_val_args_wanted arg_tys_so_far fun_ty
+
+-- If (wrap, arg_ty, res_ty) = matchActualFunTySigma ... fun_ty
+-- then wrap :: fun_ty ~> (arg_ty -> res_ty)
+-- and NB: res_ty is an (uninstantiated) SigmaType
+
+matchActualFunTySigma herald ct_orig mb_thing err_info fun_ty
+ = go fun_ty
-- Does not allocate unnecessary meta variables: if the input already is
-- a function, we just take it apart. Not only is this efficient,
-- it's important for higher rank: the argument might be of form
@@ -264,52 +294,28 @@ matchActualFunTysPart herald ct_orig mb_thing
-- in elsewhere).
where
- -- This function has a bizarre mechanic: it accumulates arguments on
- -- the way down and also builds an argument list on the way up. Why:
- -- 1. The returns args list and the accumulated args list might be different.
- -- The accumulated args include all the arg types for the function,
- -- including those from before this function was called. The returned
- -- list should include only those arguments produced by this call of
- -- matchActualFunTys
- --
- -- 2. The HsWrapper can be built only on the way up. It seems (more)
- -- bizarre to build the HsWrapper but not the arg_tys.
- --
- -- Refactoring is welcome.
- go :: Arity
- -> [TcSigmaType] -- Types of value args to which the function has
- -- been applied so far (reversed)
- -- Used only for error messages
- -> TcSigmaType -- the remainder of the type as we're processing
- -> TcM (HsWrapper, [TcSigmaType], TcSigmaType)
- go 0 _ ty = return (idHsWrapper, [], ty)
-
- go n so_far ty
+ go :: TcSigmaType -- The remainder of the type as we're processing
+ -> TcM (HsWrapper, TcSigmaType, TcSigmaType)
+ go ty | Just ty' <- tcView ty = go ty'
+
+ go ty
| not (null tvs && null theta)
= do { (wrap1, rho) <- topInstantiate ct_orig ty
- ; (wrap2, arg_tys, res_ty) <- go n so_far rho
- ; return (wrap2 <.> wrap1, arg_tys, res_ty) }
+ ; (wrap2, arg_ty, res_ty) <- go rho
+ ; return (wrap2 <.> wrap1, arg_ty, res_ty) }
where
(tvs, theta, _) = tcSplitSigmaTy ty
- go n so_far ty
- | Just ty' <- tcView ty = go n so_far ty'
-
- go n so_far (FunTy { ft_af = af, ft_arg = arg_ty, ft_res = res_ty })
+ go (FunTy { ft_af = af, ft_arg = arg_ty, ft_res = res_ty })
= ASSERT( af == VisArg )
- do { (wrap_res, tys, ty_r) <- go (n-1) (arg_ty:so_far) res_ty
- ; return ( mkWpFun idHsWrapper wrap_res arg_ty ty_r doc
- , arg_ty : tys, ty_r ) }
- where
- doc = text "When inferring the argument type of a function with type" <+>
- quotes (ppr fun_ty)
+ return (idHsWrapper, arg_ty, res_ty)
- go n so_far ty@(TyVarTy tv)
+ go ty@(TyVarTy tv)
| isMetaTyVar tv
= do { cts <- readMetaTyVar tv
; case cts of
- Indirect ty' -> go n so_far ty'
- Flexi -> defer n ty }
+ Indirect ty' -> go ty'
+ Flexi -> defer ty }
-- In all other cases we bale out into ordinary unification
-- However unlike the meta-tyvar case, we are sure that the
@@ -326,22 +332,23 @@ matchActualFunTysPart herald ct_orig mb_thing
--
-- But in that case we add specialized type into error context
-- anyway, because it may be useful. See also #9605.
- go n so_far ty = addErrCtxtM (mk_ctxt so_far ty) (defer n ty)
+ go ty = addErrCtxtM (mk_ctxt ty) (defer ty)
------------
- defer n fun_ty
- = do { arg_tys <- replicateM n newOpenFlexiTyVarTy
- ; res_ty <- newOpenFlexiTyVarTy
- ; let unif_fun_ty = mkVisFunTys arg_tys res_ty
+ defer fun_ty
+ = do { arg_ty <- newOpenFlexiTyVarTy
+ ; res_ty <- newOpenFlexiTyVarTy
+ ; let unif_fun_ty = mkVisFunTy arg_ty res_ty
; co <- unifyType mb_thing fun_ty unif_fun_ty
- ; return (mkWpCastN co, arg_tys, res_ty) }
+ ; return (mkWpCastN co, arg_ty, res_ty) }
------------
- mk_ctxt :: [TcType] -> TcType -> TidyEnv -> TcM (TidyEnv, MsgDoc)
- mk_ctxt arg_tys res_ty env
+ mk_ctxt :: TcType -> TidyEnv -> TcM (TidyEnv, MsgDoc)
+ mk_ctxt res_ty env
= do { (env', ty) <- zonkTidyTcType env $
- mkVisFunTys (reverse arg_tys) res_ty
+ mkVisFunTys (reverse arg_tys_so_far) res_ty
; return (env', mk_fun_tys_msg herald ty n_val_args_in_call) }
+ (n_val_args_in_call, arg_tys_so_far) = err_info
mk_fun_tys_msg :: SDoc -> TcType -> Arity -> SDoc
mk_fun_tys_msg herald ty n_args_in_call
@@ -491,95 +498,51 @@ a place expecting a value of type expected_ty. I.e. that
actual ty is more polymorphic than expected_ty
-It returns a coercion function
+It returns a wrapper function
co_fn :: actual_ty ~ expected_ty
which takes an HsExpr of type actual_ty into one of type
expected_ty.
-
-These functions do not actually check for subsumption. They check if
-expected_ty is an appropriate annotation to use for something of type
-actual_ty. This difference matters when thinking about visible type
-application. For example,
-
- forall a. a -> forall b. b -> b
- DOES NOT SUBSUME
- forall a b. a -> b -> b
-
-because the type arguments appear in a different order. (Neither does
-it work the other way around.) BUT, these types are appropriate annotations
-for one another. Because the user directs annotations, it's OK if some
-arguments shuffle around -- after all, it's what the user wants.
-Bottom line: none of this changes with visible type application.
-
-There are a number of wrinkles (below).
-
-Notice that Wrinkle 1 and 2 both require eta-expansion, which technically
-may increase termination. We just put up with this, in exchange for getting
-more predictable type inference.
-
-Wrinkle 1: Note [Deep skolemisation]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-We want (forall a. Int -> a -> a) <= (Int -> forall a. a->a)
-(see section 4.6 of "Practical type inference for higher rank types")
-So we must deeply-skolemise the RHS before we instantiate the LHS.
-
-That is why tc_sub_type starts with a call to tcSkolemise (which does the
-deep skolemisation), and then calls the DS variant (which assumes
-that expected_ty is deeply skolemised)
-
-Wrinkle 2: Note [Co/contra-variance of subsumption checking]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Consider g :: (Int -> Int) -> Int
- f1 :: (forall a. a -> a) -> Int
- f1 = g
-
- f2 :: (forall a. a -> a) -> Int
- f2 x = g x
-f2 will typecheck, and it would be odd/fragile if f1 did not.
-But f1 will only typecheck if we have that
- (Int->Int) -> Int <= (forall a. a->a) -> Int
-And that is only true if we do the full co/contravariant thing
-in the subsumption check. That happens in the FunTy case of
-tcSubTypeDS_NC_O, and is the sole reason for the WpFun form of
-HsWrapper.
-
-Another powerful reason for doing this co/contra stuff is visible
-in #9569, involving instantiation of constraint variables,
-and again involving eta-expansion.
-
-Wrinkle 3: Note [Higher rank types]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Consider tc150:
- f y = \ (x::forall a. a->a). blah
-The following happens:
-* We will infer the type of the RHS, ie with a res_ty = alpha.
-* Then the lambda will split alpha := beta -> gamma.
-* And then we'll check tcSubType IsSwapped beta (forall a. a->a)
-
-So it's important that we unify beta := forall a. a->a, rather than
-skolemising the type.
-}
--- | Call this variant when you are in a higher-rank situation and
--- you know the right-hand type is deeply skolemised.
-tcSubTypeHR :: CtOrigin -- ^ of the actual type
- -> Maybe (HsExpr GhcRn) -- ^ If present, it has type ty_actual
- -> TcSigmaType -> ExpRhoType -> TcM HsWrapper
-tcSubTypeHR orig = tcSubTypeDS_NC_O orig GenSigCtxt
+-----------------
+-- tcWrapResult needs both un-type-checked (for origins and error messages)
+-- and type-checked (for wrapping) expressions
+tcWrapResult :: HsExpr GhcRn -> HsExpr GhcTcId -> TcSigmaType -> ExpRhoType
+ -> TcM (HsExpr GhcTcId)
+tcWrapResult rn_expr = tcWrapResultO (exprCtOrigin rn_expr) rn_expr
+
+tcWrapResultO :: CtOrigin -> HsExpr GhcRn -> HsExpr GhcTcId -> TcSigmaType -> ExpRhoType
+ -> TcM (HsExpr GhcTcId)
+tcWrapResultO orig rn_expr expr actual_ty res_ty
+ = do { traceTc "tcWrapResult" (vcat [ text "Actual: " <+> ppr actual_ty
+ , text "Expected:" <+> ppr res_ty ])
+ ; wrap <- tcSubTypeNC orig GenSigCtxt (Just rn_expr) actual_ty res_ty
+ ; return (mkHsWrap wrap expr) }
+
+tcWrapResultMono :: HsExpr GhcRn -> HsExpr GhcTcId
+ -> TcRhoType -- Actual -- a rho-type not a sigma-type
+ -> ExpRhoType -- Expected
+ -> TcM (HsExpr GhcTcId)
+-- A version of tcWrapResult to use when the actual type is a
+-- rho-type, so nothing to instantiate; just go straight to unify.
+-- It means we don't need to pass in a CtOrigin
+tcWrapResultMono rn_expr expr act_ty res_ty
+ = ASSERT2( isRhoTy act_ty, ppr act_ty $$ ppr rn_expr )
+ do { co <- case res_ty of
+ Infer inf_res -> fillInferResult act_ty inf_res
+ Check exp_ty -> unifyType (Just rn_expr) act_ty exp_ty
+ ; return (mkHsWrapCo co expr) }
------------------------
tcSubTypePat :: CtOrigin -> UserTypeCtxt
-> ExpSigmaType -> TcSigmaType -> TcM HsWrapper
+-- Used in patterns; polarity is backwards compared
+-- to tcSubType
-- If wrap = tc_sub_type_et t1 t2
-- => wrap :: t1 ~> t2
-tcSubTypePat orig ctxt (Check ty_actual) ty_expected
- = tc_sub_tc_type eq_orig orig ctxt ty_actual ty_expected
- where
- eq_orig = TypeEqOrigin { uo_actual = ty_expected
- , uo_expected = ty_actual
- , uo_thing = Nothing
- , uo_visible = True }
+tcSubTypePat inst_orig ctxt (Check ty_actual) ty_expected
+ = tc_sub_type unifyTypeET inst_orig ctxt ty_actual ty_expected
tcSubTypePat _ _ (Infer inf_res) ty_expected
= do { co <- fillInferResult ty_expected inf_res
@@ -587,106 +550,72 @@ tcSubTypePat _ _ (Infer inf_res) ty_expected
; return (mkWpCastN (mkTcSymCo co)) }
-------------------------
-tcSubTypeO :: CtOrigin -- ^ of the actual type
- -> UserTypeCtxt -- ^ of the expected type
- -> TcSigmaType
- -> ExpRhoType
- -> TcM HsWrapper
-tcSubTypeO orig ctxt ty_actual ty_expected
+---------------
+tcSubType :: CtOrigin -> UserTypeCtxt
+ -> TcSigmaType -- Actual
+ -> ExpRhoType -- Expected
+ -> TcM HsWrapper
+-- Checks that 'actual' is more polymorphic than 'expected'
+tcSubType orig ctxt ty_actual ty_expected
= addSubTypeCtxt ty_actual ty_expected $
- do { traceTc "tcSubTypeDS_O" (vcat [ pprCtOrigin orig
- , pprUserTypeCtxt ctxt
- , ppr ty_actual
- , ppr ty_expected ])
- ; tcSubTypeDS_NC_O orig ctxt Nothing ty_actual ty_expected }
-
-addSubTypeCtxt :: TcType -> ExpType -> TcM a -> TcM a
-addSubTypeCtxt ty_actual ty_expected thing_inside
- | isRhoTy ty_actual -- If there is no polymorphism involved, the
- , isRhoExpTy ty_expected -- TypeEqOrigin stuff (added by the _NC functions)
- = thing_inside -- gives enough context by itself
- | otherwise
- = addErrCtxtM mk_msg thing_inside
- where
- mk_msg tidy_env
- = do { (tidy_env, ty_actual) <- zonkTidyTcType tidy_env ty_actual
- -- might not be filled if we're debugging. ugh.
- ; mb_ty_expected <- readExpType_maybe ty_expected
- ; (tidy_env, ty_expected) <- case mb_ty_expected of
- Just ty -> second mkCheckExpType <$>
- zonkTidyTcType tidy_env ty
- Nothing -> return (tidy_env, ty_expected)
- ; ty_expected <- readExpType ty_expected
- ; (tidy_env, ty_expected) <- zonkTidyTcType tidy_env ty_expected
- ; let msg = vcat [ hang (text "When checking that:")
- 4 (ppr ty_actual)
- , nest 2 (hang (text "is more polymorphic than:")
- 2 (ppr ty_expected)) ]
- ; return (tidy_env, msg) }
+ do { traceTc "tcSubType" (vcat [pprUserTypeCtxt ctxt, ppr ty_actual, ppr ty_expected])
+ ; tcSubTypeNC orig ctxt Nothing ty_actual ty_expected }
+
+tcSubTypeNC :: CtOrigin -- Used when instantiating
+ -> UserTypeCtxt -- Used when skolemising
+ -> Maybe (HsExpr GhcRn) -- The expression that has type 'actual' (if known)
+ -> TcSigmaType -- Actual type
+ -> ExpRhoType -- Expected type
+ -> TcM HsWrapper
+tcSubTypeNC inst_orig ctxt m_thing ty_actual res_ty
+ = case res_ty of
+ Infer inf_res -> instantiateAndFillInferResult inst_orig ty_actual inf_res
+ Check ty_expected -> tc_sub_type (unifyType m_thing) inst_orig ctxt
+ ty_actual ty_expected
---------------
--- The "_NC" variants do not add a typechecker-error context;
--- the caller is assumed to do that
-
-tcSubType_NC :: UserTypeCtxt -> TcSigmaType -> TcSigmaType -> TcM HsWrapper
+tcSubTypeSigma :: UserTypeCtxt -> TcSigmaType -> TcSigmaType -> TcM HsWrapper
+-- External entry point, but no ExpTypes on either side
-- Checks that actual <= expected
-- Returns HsWrapper :: actual ~ expected
-tcSubType_NC ctxt ty_actual ty_expected
- = do { traceTc "tcSubType_NC" (vcat [pprUserTypeCtxt ctxt, ppr ty_actual, ppr ty_expected])
- ; tc_sub_tc_type origin origin ctxt ty_actual ty_expected }
+tcSubTypeSigma ctxt ty_actual ty_expected
+ = tc_sub_type (unifyType Nothing) eq_orig ctxt ty_actual ty_expected
where
- origin = TypeEqOrigin { uo_actual = ty_actual
- , uo_expected = ty_expected
- , uo_thing = Nothing
- , uo_visible = True }
-
-tcSubTypeDS :: CtOrigin -> UserTypeCtxt -> TcSigmaType -> ExpRhoType -> TcM HsWrapper
--- Just like tcSubType, but with the additional precondition that
--- ty_expected is deeply skolemised (hence "DS")
-tcSubTypeDS orig ctxt ty_actual ty_expected
- = addSubTypeCtxt ty_actual ty_expected $
- do { traceTc "tcSubTypeDS_NC" (vcat [pprUserTypeCtxt ctxt, ppr ty_actual, ppr ty_expected])
- ; tcSubTypeDS_NC_O orig ctxt Nothing ty_actual ty_expected }
-
-tcSubTypeDS_NC_O :: CtOrigin -- origin used for instantiation only
- -> UserTypeCtxt
- -> Maybe (HsExpr GhcRn)
- -> TcSigmaType -> ExpRhoType -> TcM HsWrapper
--- Just like tcSubType, but with the additional precondition that
--- ty_expected is deeply skolemised
-tcSubTypeDS_NC_O inst_orig ctxt m_thing ty_actual ty_expected
- = case ty_expected of
- Infer inf_res -> instantiateAndFillInferResult inst_orig ty_actual inf_res
- Check ty -> tc_sub_type_ds eq_orig inst_orig ctxt ty_actual ty
- where
- eq_orig = TypeEqOrigin { uo_actual = ty_actual, uo_expected = ty
- , uo_thing = ppr <$> m_thing
- , uo_visible = True }
+ eq_orig = TypeEqOrigin { uo_actual = ty_actual
+ , uo_expected = ty_expected
+ , uo_thing = Nothing
+ , uo_visible = True }
---------------
-tc_sub_tc_type :: CtOrigin -- used when calling uType
- -> CtOrigin -- used when instantiating
- -> UserTypeCtxt -> TcSigmaType -> TcSigmaType -> TcM HsWrapper
+tc_sub_type :: (TcType -> TcType -> TcM TcCoercionN) -- How to unify
+ -> CtOrigin -- Used when instantiating
+ -> UserTypeCtxt -- Used when skolemising
+ -> TcSigmaType -- Actual; a sigma-type
+ -> TcSigmaType -- Expected; also a sigma-type
+ -> TcM HsWrapper
+-- Checks that actual_ty is more polymorphic than expected_ty
-- If wrap = tc_sub_type t1 t2
-- => wrap :: t1 ~> t2
-tc_sub_tc_type eq_orig inst_orig ctxt ty_actual ty_expected
+tc_sub_type unify inst_orig ctxt ty_actual ty_expected
| definitely_poly ty_expected -- See Note [Don't skolemise unnecessarily]
, not (possibly_poly ty_actual)
- = do { traceTc "tc_sub_tc_type (drop to equality)" $
+ = do { traceTc "tc_sub_type (drop to equality)" $
vcat [ text "ty_actual =" <+> ppr ty_actual
, text "ty_expected =" <+> ppr ty_expected ]
; mkWpCastN <$>
- uType TypeLevel eq_orig ty_actual ty_expected }
+ unify ty_actual ty_expected }
| otherwise -- This is the general case
- = do { traceTc "tc_sub_tc_type (general case)" $
+ = do { traceTc "tc_sub_type (general case)" $
vcat [ text "ty_actual =" <+> ppr ty_actual
, text "ty_expected =" <+> ppr ty_expected ]
- ; (sk_wrap, inner_wrap) <- tcSkolemise ctxt ty_expected $
- \ _ sk_rho ->
- tc_sub_type_ds eq_orig inst_orig ctxt
- ty_actual sk_rho
+
+ ; (sk_wrap, inner_wrap)
+ <- tcSkolemise ctxt ty_expected $ \ sk_rho ->
+ do { (wrap, rho_a) <- topInstantiate inst_orig ty_actual
+ ; cow <- unify rho_a sk_rho
+ ; return (mkWpCastN cow <.> wrap) }
+
; return (sk_wrap <.> inner_wrap) }
where
possibly_poly ty
@@ -705,6 +634,31 @@ tc_sub_tc_type eq_orig inst_orig ctxt ty_actual ty_expected
| otherwise
= False
+------------------------
+addSubTypeCtxt :: TcType -> ExpType -> TcM a -> TcM a
+addSubTypeCtxt ty_actual ty_expected thing_inside
+ | isRhoTy ty_actual -- If there is no polymorphism involved, the
+ , isRhoExpTy ty_expected -- TypeEqOrigin stuff (added by the _NC functions)
+ = thing_inside -- gives enough context by itself
+ | otherwise
+ = addErrCtxtM mk_msg thing_inside
+ where
+ mk_msg tidy_env
+ = do { (tidy_env, ty_actual) <- zonkTidyTcType tidy_env ty_actual
+ -- might not be filled if we're debugging. ugh.
+ ; mb_ty_expected <- readExpType_maybe ty_expected
+ ; (tidy_env, ty_expected) <- case mb_ty_expected of
+ Just ty -> second mkCheckExpType <$>
+ zonkTidyTcType tidy_env ty
+ Nothing -> return (tidy_env, ty_expected)
+ ; ty_expected <- readExpType ty_expected
+ ; (tidy_env, ty_expected) <- zonkTidyTcType tidy_env ty_expected
+ ; let msg = vcat [ hang (text "When checking that:")
+ 4 (ppr ty_actual)
+ , nest 2 (hang (text "is more polymorphic than:")
+ 2 (ppr ty_expected)) ]
+ ; return (tidy_env, msg) }
+
{- Note [Don't skolemise unnecessarily]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Suppose we are trying to solve
@@ -740,98 +694,9 @@ accept (e.g. #13752). So the test (which is only to improve
error message) is very conservative:
* ty_actual is /definitely/ monomorphic
* ty_expected is /definitely/ polymorphic
--}
-
----------------
-tc_sub_type_ds :: CtOrigin -- used when calling uType
- -> CtOrigin -- used when instantiating
- -> UserTypeCtxt -> TcSigmaType -> TcRhoType -> TcM HsWrapper
--- If wrap = tc_sub_type_ds t1 t2
--- => wrap :: t1 ~> t2
--- Here is where the work actually happens!
--- Precondition: ty_expected is deeply skolemised
-tc_sub_type_ds eq_orig inst_orig ctxt ty_actual ty_expected
- = do { traceTc "tc_sub_type_ds" $
- vcat [ text "ty_actual =" <+> ppr ty_actual
- , text "ty_expected =" <+> ppr ty_expected ]
- ; go ty_actual ty_expected }
- where
- go ty_a ty_e | Just ty_a' <- tcView ty_a = go ty_a' ty_e
- | Just ty_e' <- tcView ty_e = go ty_a ty_e'
- go (TyVarTy tv_a) ty_e
- = do { lookup_res <- lookupTcTyVar tv_a
- ; case lookup_res of
- Filled ty_a' ->
- do { traceTc "tcSubTypeDS_NC_O following filled act meta-tyvar:"
- (ppr tv_a <+> text "-->" <+> ppr ty_a')
- ; tc_sub_type_ds eq_orig inst_orig ctxt ty_a' ty_e }
- Unfilled _ -> unify }
-
- -- Historical note (Sept 16): there was a case here for
- -- go ty_a (TyVarTy alpha)
- -- which, in the impredicative case unified alpha := ty_a
- -- where th_a is a polytype. Not only is this probably bogus (we
- -- simply do not have decent story for impredicative types), but it
- -- caused #12616 because (also bizarrely) 'deriving' code had
- -- -XImpredicativeTypes on. I deleted the entire case.
-
- go (FunTy { ft_af = VisArg, ft_arg = act_arg, ft_res = act_res })
- (FunTy { ft_af = VisArg, ft_arg = exp_arg, ft_res = exp_res })
- = -- See Note [Co/contra-variance of subsumption checking]
- do { res_wrap <- tc_sub_type_ds eq_orig inst_orig ctxt act_res exp_res
- ; arg_wrap <- tc_sub_tc_type eq_orig given_orig GenSigCtxt exp_arg act_arg
- -- GenSigCtxt: See Note [Setting the argument context]
- ; return (mkWpFun arg_wrap res_wrap exp_arg exp_res doc) }
- -- arg_wrap :: exp_arg ~> act_arg
- -- res_wrap :: act-res ~> exp_res
- where
- given_orig = GivenOrigin (SigSkol GenSigCtxt exp_arg [])
- doc = text "When checking that" <+> quotes (ppr ty_actual) <+>
- text "is more polymorphic than" <+> quotes (ppr ty_expected)
-
- go ty_a ty_e
- | let (tvs, theta, _) = tcSplitSigmaTy ty_a
- , not (null tvs && null theta)
- = do { (in_wrap, in_rho) <- topInstantiate inst_orig ty_a
- ; body_wrap <- tc_sub_type_ds
- (eq_orig { uo_actual = in_rho
- , uo_expected = ty_expected })
- inst_orig ctxt in_rho ty_e
- ; return (body_wrap <.> in_wrap) }
-
- | otherwise -- Revert to unification
- = inst_and_unify
- -- It's still possible that ty_actual has nested foralls. Instantiate
- -- these, as there's no way unification will succeed with them in.
- -- See typecheck/should_compile/T11305 for an example of when this
- -- is important. The problem is that we're checking something like
- -- a -> forall b. b -> b <= alpha beta gamma
- -- where we end up with alpha := (->)
-
- inst_and_unify = do { (wrap, rho_a) <- deeplyInstantiate inst_orig ty_actual
-
- -- If we haven't recurred through an arrow, then
- -- the eq_orig will list ty_actual. In this case,
- -- we want to update the origin to reflect the
- -- instantiation. If we *have* recurred through
- -- an arrow, it's better not to update.
- ; let eq_orig' = case eq_orig of
- TypeEqOrigin { uo_actual = orig_ty_actual }
- | orig_ty_actual `tcEqType` ty_actual
- , not (isIdHsWrapper wrap)
- -> eq_orig { uo_actual = rho_a }
- _ -> eq_orig
-
- ; cow <- uType TypeLevel eq_orig' rho_a ty_expected
- ; return (mkWpCastN cow <.> wrap) }
-
-
- -- use versions without synonyms expanded
- unify = mkWpCastN <$> uType TypeLevel eq_orig ty_actual ty_expected
-
-{- Note [Settting the argument context]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Note [Settting the argument context]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider we are doing the ambiguity check for the (bogus)
f :: (forall a b. C b => a -> a) -> Int
@@ -857,24 +722,6 @@ to a UserTypeCtxt of GenSigCtxt. Why?
See Note [When to build an implication]
-}
------------------
--- needs both un-type-checked (for origins) and type-checked (for wrapping)
--- expressions
-tcWrapResult :: HsExpr GhcRn -> HsExpr GhcTcId -> TcSigmaType -> ExpRhoType
- -> TcM (HsExpr GhcTcId)
-tcWrapResult rn_expr = tcWrapResultO (exprCtOrigin rn_expr) rn_expr
-
--- | Sometimes we don't have a @HsExpr Name@ to hand, and this is more
--- convenient.
-tcWrapResultO :: CtOrigin -> HsExpr GhcRn -> HsExpr GhcTcId -> TcSigmaType -> ExpRhoType
- -> TcM (HsExpr GhcTcId)
-tcWrapResultO orig rn_expr expr actual_ty res_ty
- = do { traceTc "tcWrapResult" (vcat [ text "Actual: " <+> ppr actual_ty
- , text "Expected:" <+> ppr res_ty ])
- ; cow <- tcSubTypeDS_NC_O orig GenSigCtxt
- (Just rn_expr) actual_ty res_ty
- ; return (mkHsWrap cow expr) }
-
{- **********************************************************************
%* *
@@ -896,7 +743,7 @@ instantiateAndFillInferResult :: CtOrigin -> TcType -> InferResult -> TcM HsWrap
-- => wrap :: t1 ~> t2
-- See Note [Instantiation of InferResult]
instantiateAndFillInferResult orig ty inf_res
- = do { (wrap, rho) <- deeplyInstantiate orig ty
+ = do { (wrap, rho) <- topInstantiate orig ty
; co <- fillInferResult rho inf_res
; return (mkWpCastN co <.> wrap) }
@@ -1090,48 +937,64 @@ the thinking.
* *
********************************************************************* -}
--- | Take an "expected type" and strip off quantifiers to expose the
--- type underneath, binding the new skolems for the @thing_inside@.
--- The returned 'HsWrapper' has type @specific_ty -> expected_ty@.
-tcSkolemise :: UserTypeCtxt -> TcSigmaType
- -> ([TcTyVar] -> TcType -> TcM result)
- -- ^ These are only ever used for scoped type variables.
- -> TcM (HsWrapper, result)
- -- ^ The expression has type: spec_ty -> expected_ty
+{- Note [Skolemisation]
+~~~~~~~~~~~~~~~~~~~~~~~
+tcSkolemise takes "expected type" and strip off quantifiers to expose the
+type underneath, binding the new skolems for the 'thing_inside'
+The returned 'HsWrapper' has type (specific_ty -> expected_ty).
+
+Note that for a nested type like
+ forall a. Eq a => forall b. Ord b => blah
+we still only build one implication constraint
+ forall a b. (Eq a, Ord b) => <constraints>
+This is just an optimisation, but it's why we use topSkolemise to
+build the pieces from all the layers, before making a single call
+to checkConstraints.
+
+tcSkolemiseScoped is very similar, but differs in two ways:
+
+* It deals specially with just the outer forall, bringing those
+ type variables into lexical scope. To my surprise, I found that
+ doing this regardless (in tcSkolemise) caused a non-trivial (1%-ish)
+ perf hit on the compiler.
+
+* It always calls checkConstraints, even if there are no skolem
+ variables at all. Reason: there might be nested deferred errors
+ that must not be allowed to float to top level.
+ See Note [When to build an implication] below.
+-}
+
+tcSkolemise, tcSkolemiseScoped
+ :: UserTypeCtxt -> TcSigmaType
+ -> (TcType -> TcM result)
+ -> TcM (HsWrapper, result)
+ -- ^ The wrapper has type: spec_ty ~> expected_ty
+
+tcSkolemiseScoped ctxt expected_ty thing_inside
+ = do { (wrap, tv_prs, given, rho_ty) <- topSkolemise expected_ty
+ ; let skol_tvs = map snd tv_prs
+ skol_info = SigSkol ctxt expected_ty tv_prs
+
+ ; (ev_binds, res)
+ <- checkConstraints skol_info skol_tvs given $
+ tcExtendNameTyVarEnv tv_prs $
+ thing_inside rho_ty
+
+ ; return (wrap <.> mkWpLet ev_binds, res) }
tcSkolemise ctxt expected_ty thing_inside
- -- We expect expected_ty to be a forall-type
- -- If not, the call is a no-op
- = do { traceTc "tcSkolemise" Outputable.empty
- ; (wrap, tv_prs, given, rho') <- deeplySkolemise expected_ty
-
- ; lvl <- getTcLevel
- ; when debugIsOn $
- traceTc "tcSkolemise" $ vcat [
- ppr lvl,
- text "expected_ty" <+> ppr expected_ty,
- text "inst tyvars" <+> ppr tv_prs,
- text "given" <+> ppr given,
- text "inst type" <+> ppr rho' ]
-
- -- Generally we must check that the "forall_tvs" haven't been constrained
- -- The interesting bit here is that we must include the free variables
- -- of the expected_ty. Here's an example:
- -- runST (newVar True)
- -- Here, if we don't make a check, we'll get a type (ST s (MutVar s Bool))
- -- for (newVar True), with s fresh. Then we unify with the runST's arg type
- -- forall s'. ST s' a. That unifies s' with s, and a with MutVar s Bool.
- -- So now s' isn't unconstrained because it's linked to a.
- --
- -- However [Oct 10] now that the untouchables are a range of
- -- TcTyVars, all this is handled automatically with no need for
- -- extra faffing around
+ | isRhoTy expected_ty -- Short cut for common case
+ = do { res <- thing_inside expected_ty
+ ; return (idHsWrapper, res) }
+ | otherwise
+ = do { (wrap, tv_prs, given, rho_ty) <- topSkolemise expected_ty
- ; let tvs' = map snd tv_prs
+ ; let skol_tvs = map snd tv_prs
skol_info = SigSkol ctxt expected_ty tv_prs
- ; (ev_binds, result) <- checkConstraints skol_info tvs' given $
- thing_inside tvs' rho'
+ ; (ev_binds, result)
+ <- checkConstraints skol_info skol_tvs given $
+ thing_inside rho_ty
; return (wrap <.> mkWpLet ev_binds, result) }
-- The ev_binds returned by checkConstraints is very
@@ -1144,7 +1007,8 @@ tcSkolemiseET :: UserTypeCtxt -> ExpSigmaType
tcSkolemiseET _ et@(Infer {}) thing_inside
= (idHsWrapper, ) <$> thing_inside et
tcSkolemiseET ctxt (Check ty) thing_inside
- = tcSkolemise ctxt ty $ \_ -> thing_inside . mkCheckExpType
+ = tcSkolemise ctxt ty $ \rho_ty ->
+ thing_inside (mkCheckExpType rho_ty)
checkConstraints :: SkolemInfo
-> [TcTyVar] -- Skolems
@@ -1162,7 +1026,7 @@ checkConstraints skol_info skol_tvs given thing_inside
; emitImplications implics
; return (ev_binds, result) }
- else -- Fast path. We check every function argument with tcCheckExpr,
+ else -- Fast path. We check every function argument with tcCheckPolyExpr,
-- which uses tcSkolemise and hence checkConstraints.
-- So this fast path is well-exercised
do { res <- thing_inside
@@ -1175,38 +1039,33 @@ checkTvConstraints :: SkolemInfo
checkTvConstraints skol_info skol_tvs thing_inside
= do { (tclvl, wanted, result) <- pushLevelAndCaptureConstraints thing_inside
- ; emitResidualTvConstraint skol_info Nothing skol_tvs tclvl wanted
+ ; emitResidualTvConstraint skol_info skol_tvs tclvl wanted
; return result }
-emitResidualTvConstraint :: SkolemInfo -> Maybe SDoc -> [TcTyVar]
+emitResidualTvConstraint :: SkolemInfo -> [TcTyVar]
-> TcLevel -> WantedConstraints -> TcM ()
-emitResidualTvConstraint skol_info m_telescope skol_tvs tclvl wanted
+emitResidualTvConstraint skol_info skol_tvs tclvl wanted
| isEmptyWC wanted
- , isNothing m_telescope || skol_tvs `lengthAtMost` 1
- -- If m_telescope is (Just d), we must do the bad-telescope check,
- -- so we must /not/ discard the implication even if there are no
- -- wanted constraints. See Note [Checking telescopes] in GHC.Tc.Types.Constraint.
- -- Lacking this check led to #16247
= return ()
| otherwise
- = do { ev_binds <- newNoTcEvBinds
+ = do { implic <- buildTvImplication skol_info skol_tvs tclvl wanted
+ ; emitImplication implic }
+
+buildTvImplication :: SkolemInfo -> [TcTyVar]
+ -> TcLevel -> WantedConstraints -> TcM Implication
+buildTvImplication skol_info skol_tvs tclvl wanted
+ = do { ev_binds <- newNoTcEvBinds -- Used for equalities only, so all the constraints
+ -- are solved by filling in coercion holes, not
+ -- by creating a value-level evidence binding
; implic <- newImplication
- ; let status | insolubleWC wanted = IC_Insoluble
- | otherwise = IC_Unsolved
- -- If the inner constraints are insoluble,
- -- we should mark the outer one similarly,
- -- so that insolubleWC works on the outer one
-
- ; emitImplication $
- implic { ic_status = status
- , ic_tclvl = tclvl
- , ic_skols = skol_tvs
- , ic_no_eqs = True
- , ic_telescope = m_telescope
- , ic_wanted = wanted
- , ic_binds = ev_binds
- , ic_info = skol_info } }
+
+ ; return (implic { ic_tclvl = tclvl
+ , ic_skols = skol_tvs
+ , ic_no_eqs = True
+ , ic_wanted = wanted
+ , ic_binds = ev_binds
+ , ic_info = skol_info }) }
implicationNeeded :: SkolemInfo -> [TcTyVar] -> [EvVar] -> TcM Bool
-- See Note [When to build an implication]
@@ -1319,21 +1178,35 @@ unifyType :: Maybe (HsExpr GhcRn) -- ^ If present, has type 'ty1'
-> TcTauType -> TcTauType -> TcM TcCoercionN
-- Actual and expected types
-- Returns a coercion : ty1 ~ ty2
-unifyType thing ty1 ty2 = traceTc "utype" (ppr ty1 $$ ppr ty2 $$ ppr thing) >>
- uType TypeLevel origin ty1 ty2
+unifyType thing ty1 ty2
+ = uType TypeLevel origin ty1 ty2
where
- origin = TypeEqOrigin { uo_actual = ty1, uo_expected = ty2
- , uo_thing = ppr <$> thing
- , uo_visible = True } -- always called from a visible context
+ origin = TypeEqOrigin { uo_actual = ty1
+ , uo_expected = ty2
+ , uo_thing = ppr <$> thing
+ , uo_visible = True }
+
+unifyTypeET :: TcTauType -> TcTauType -> TcM CoercionN
+-- Like unifyType, but swap expected and actual in error messages
+-- This is used when typechecking patterns
+unifyTypeET ty1 ty2
+ = uType TypeLevel origin ty1 ty2
+ where
+ origin = TypeEqOrigin { uo_actual = ty2 -- NB swapped
+ , uo_expected = ty1 -- NB swapped
+ , uo_thing = Nothing
+ , uo_visible = True }
+
unifyKind :: Maybe (HsType GhcRn) -> TcKind -> TcKind -> TcM CoercionN
-unifyKind thing ty1 ty2 = traceTc "ukind" (ppr ty1 $$ ppr ty2 $$ ppr thing) >>
- uType KindLevel origin ty1 ty2
- where origin = TypeEqOrigin { uo_actual = ty1, uo_expected = ty2
- , uo_thing = ppr <$> thing
- , uo_visible = True } -- also always from a visible context
+unifyKind thing ty1 ty2
+ = uType KindLevel origin ty1 ty2
+ where
+ origin = TypeEqOrigin { uo_actual = ty1
+ , uo_expected = ty2
+ , uo_thing = ppr <$> thing
+ , uo_visible = True }
----------------
{-
%************************************************************************
@@ -1639,7 +1512,7 @@ uUnfilledVar1 origin t_or_k swapped tv1 ty2
go tv2 | tv1 == tv2 -- Same type variable => no-op
= return (mkNomReflCo (mkTyVarTy tv1))
- | swapOverTyVars tv1 tv2 -- Distinct type variables
+ | swapOverTyVars False tv1 tv2 -- Distinct type variables
-- Swap meta tyvar to the left if poss
= do { tv1 <- zonkTyCoVarKind tv1
-- We must zonk tv1's kind because that might
@@ -1696,8 +1569,12 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2
defer = unSwap swapped (uType_defer t_or_k origin) ty1 ty2
-swapOverTyVars :: TcTyVar -> TcTyVar -> Bool
-swapOverTyVars tv1 tv2
+swapOverTyVars :: Bool -> TcTyVar -> TcTyVar -> Bool
+swapOverTyVars is_given tv1 tv2
+ -- See Note [Unification variables on the left]
+ | not is_given, pri1 == 0, pri2 > 0 = True
+ | not is_given, pri2 == 0, pri1 > 0 = False
+
-- Level comparison: see Note [TyVar/TyVar orientation]
| lvl1 `strictlyDeeperThan` lvl2 = False
| lvl2 `strictlyDeeperThan` lvl1 = True
@@ -1786,6 +1663,24 @@ So we look for a positive reason to swap, using a three-step test:
Uniques. See Note [Eliminate younger unification variables]
(which also explains why we don't do this any more)
+Note [Unification variables on the left]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+For wanteds, but not givens, swap (skolem ~ meta-tv) regardless of
+level, so that the unification variable is on the left.
+
+* We /don't/ want this for Givens because if we ave
+ [G] a[2] ~ alpha[1]
+ [W] Bool ~ a[2]
+ we want to rewrite the wanted to Bool ~ alpha[1],
+ so we can float the constraint and solve it.
+
+* But for Wanteds putting the unification variable on
+ the left means an easier job when floating, and when
+ reporting errors -- just fewer cases to consider.
+
+ In particular, we get better skolem-escape messages:
+ see #18114
+
Note [Deeper level on the left]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The most important thing is that we want to put tyvars with
diff --git a/compiler/GHC/Tc/Validity.hs b/compiler/GHC/Tc/Validity.hs
index 4f6b4f5887..32dfc16ea3 100644
--- a/compiler/GHC/Tc/Validity.hs
+++ b/compiler/GHC/Tc/Validity.hs
@@ -27,7 +27,7 @@ import GHC.Prelude
import GHC.Data.Maybe
-- friends:
-import GHC.Tc.Utils.Unify ( tcSubType_NC )
+import GHC.Tc.Utils.Unify ( tcSubTypeSigma )
import GHC.Tc.Solver ( simplifyAmbiguityCheck )
import GHC.Tc.Instance.Class ( matchGlobalInst, ClsInstResult(..), InstanceWhat(..), AssocInstInfo(..) )
import GHC.Core.TyCo.FVs
@@ -216,7 +216,7 @@ checkAmbiguity ctxt ty
; allow_ambiguous <- xoptM LangExt.AllowAmbiguousTypes
; (_wrap, wanted) <- addErrCtxt (mk_msg allow_ambiguous) $
captureConstraints $
- tcSubType_NC ctxt ty ty
+ tcSubTypeSigma ctxt ty ty
; simplifyAmbiguityCheck ty wanted
; traceTc "Done ambiguity check for" (ppr ty) }
diff --git a/compiler/GHC/Types/Var.hs b/compiler/GHC/Types/Var.hs
index 8cd9a06a06..b08001c6e2 100644
--- a/compiler/GHC/Types/Var.hs
+++ b/compiler/GHC/Types/Var.hs
@@ -541,11 +541,12 @@ is all about surface syntax. Therefore, they are kept as separate data types.
-- Variable Binder
--
-- VarBndr is polymorphic in both var and visibility fields.
--- Currently there are six different uses of 'VarBndr':
--- * Var.TyVarBinder = VarBndr TyVar ArgFlag
--- * Var.TyCoVarBinder = VarBndr TyCoVar ArgFlag
--- * TyCon.TyConBinder = VarBndr TyVar TyConBndrVis
--- * TyCon.TyConTyCoBinder = VarBndr TyCoVar TyConBndrVis
+-- Currently there are sevenv different uses of 'VarBndr':
+-- * Var.TyVarBinder = VarBndr TyVar ArgFlag
+-- * Var.InvisTVBinder = VarBndr TyVar Specificity
+-- * Var.TyCoVarBinder = VarBndr TyCoVar ArgFlag
+-- * TyCon.TyConBinder = VarBndr TyVar TyConBndrVis
+-- * TyCon.TyConTyCoBinder = VarBndr TyCoVar TyConBndrVis
-- * IfaceType.IfaceForAllBndr = VarBndr IfaceBndr ArgFlag
-- * IfaceType.IfaceTyConBinder = VarBndr IfaceBndr TyConBndrVis
data VarBndr var argf = Bndr var argf
@@ -559,8 +560,8 @@ data VarBndr var argf = Bndr var argf
--
-- A 'TyVarBinder' is a binder with only TyVar
type TyCoVarBinder = VarBndr TyCoVar ArgFlag
-type TyVarBinder = VarBndr TyVar ArgFlag
-type InvisTVBinder = VarBndr TyVar Specificity
+type TyVarBinder = VarBndr TyVar ArgFlag
+type InvisTVBinder = VarBndr TyVar Specificity
tyVarSpecToBinders :: [VarBndr a Specificity] -> [VarBndr a ArgFlag]
tyVarSpecToBinders = map tyVarSpecToBinder
diff --git a/docs/users_guide/8.12.1-notes.rst b/docs/users_guide/8.12.1-notes.rst
index 8f5d5db439..38b20df1f8 100644
--- a/docs/users_guide/8.12.1-notes.rst
+++ b/docs/users_guide/8.12.1-notes.rst
@@ -89,6 +89,13 @@ Language
This change prepares the way for `Quick Look impredicativity
<https://gitlab.haskell.org/ghc/ghc/issues/18126>`_.
+* GHC now implements simplified subsumption, as described in `GHC Proposal #287 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0287-simplify-subsumption.rst>`__.
+ This change simplifies the type system, and prevents the possiblity of GHC
+ silently changing the semantics of user programs, but it does mean that some libraries
+ may need eta-expansion to typecheck. More info here: :ref:`simple-subsumption`.
+
+ This change also prepares the way for Quick Look impredicativity.
+
* GHC now allows users to manually define the specificity of type variable
binders. By marking a variable with braces ``{tyvar}`` or ``{tyvar :: kind}``,
it becomes inferred despite appearing in a type signature. This feature
diff --git a/docs/users_guide/exts/rank_polymorphism.rst b/docs/users_guide/exts/rank_polymorphism.rst
index 32447228c7..e85e4e2989 100644
--- a/docs/users_guide/exts/rank_polymorphism.rst
+++ b/docs/users_guide/exts/rank_polymorphism.rst
@@ -112,23 +112,11 @@ example: ::
Since GHC 8.0 declarations such as ``MkSwizzle'`` will cause an out-of-scope
error.
-As for type signatures, implicit quantification happens for
-non-overloaded types too. So if you write this: ::
-
- f :: (a -> a) -> a
-
-it's just as if you had written this: ::
-
- f :: forall a. (a -> a) -> a
-
-That is, since the type variable ``a`` isn't in scope, it's implicitly
-universally quantified.
-
You construct values of types ``T1, MonadT, Swizzle`` by applying the
constructor to suitable values, just as usual. For example, ::
a1 :: T Int
- a1 = T1 (\xy->x) 3
+ a1 = T1 (\x y->x) 3
a2, a3 :: Swizzle
a2 = MkSwizzle sort
@@ -142,7 +130,7 @@ constructor to suitable values, just as usual. For example, ::
in
MkMonad r b
- mkTs :: (forall b. b -> b -> b) -> a -> [T a]
+ mkTs :: (forall b. b -> b -> b) -> a -> a -> [T a]
mkTs f x y = [T1 f x, T1 f y]
The type of the argument can, as usual, be more general than the type
@@ -169,6 +157,52 @@ In the function ``h`` we use the record selectors ``return`` and
``MonadT`` data structure, rather than using pattern matching.
+.. _simple-subsumption:
+
+Subsumption
+-------------
+
+Suppose: ::
+
+ f1 :: (forall a b. Int -> a -> b -> b) -> Bool
+ g1 :: forall x y. Int -> y -> x -> x
+
+ f2 :: (forall a. (Eq a, Show a) => a -> a) -> Bool
+ g2 :: forall x. (Show x, Eq x) => Int -> a -> b -> b
+
+then ``f1 g1`` and ``f2 g2`` are both well typed, despite the
+different order of type variables and constraints. What happens is that the
+argument is instantiated, and then re-generalised to match the type expected
+by the function.
+
+But this instantiation and re-generalisation happens only at the top level
+of a type. In particular, none of this happens if the foralls are underneath an arrow.
+For example: ::
+
+ f3 :: (Int -> forall a b. a -> b -> b) -> Bool
+ g3a :: Int -> forall x y. x -> y -> y
+ g3b :: forall x. Int -> forall y. x -> y -> y
+ g3c :: Int -> forall x y. y -> x -> x
+
+ f4 :: (Int -> forall a. (Eq a, Show a) => a -> a) -> Bool
+ g4 :: Int -> forall x. (Show x, Eq x) => x -> x) -> Bool
+
+Then the application ``f3 g3a`` is well-typed, becuase ``g3a`` has a type that matches the type
+expected by ``f3``. But ``f3 g3b`` is not well typed, because the foralls are in different places.
+Nor is ``f3 g3c``, where the foralls are in the same place but the variables are in a different order.
+Similarly ``f4 g4`` is not well typed, becuase the constraints appear in a different order.
+
+These examples can be made to typecheck by eta-expansion. For example ``f3 (\x -> g3b x)``
+is well typed, and similarly ``f3 (\x -> g3c x)`` and ``f4 (\x -> g4 x)``.
+
+Historical note. Earlier versions of GHC allowed these now-rejected applications, by inserting
+automatic eta-expansions, as described in Section 4.6 of `Practical type inference for arbitrary-aank types <https://www.microsoft.com/en-us/research/publication/practical-type-inference-for-arbitrary-rank-types/>`__, where it is
+called "deep skolemisation".
+But these automatic eta-expansions may silently change the semantics of the user's program,
+and deep skolemisation was removed from the language by
+`GHC Proposal #287 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0287-simplify-subsumption.rst>`__.
+This proposal has many more examples.
+
.. _higher-rank-type-inference:
Type inference
diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index 51084c8e8a..3db323c9a3 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -62,6 +62,7 @@ import GHC.Unit.State ( unitIsTrusted, unsafeGetUnitInfo, getInstalledPackageDet
import GHC.Iface.Syntax ( showToHeader )
import GHC.Core.Ppr.TyThing
import GHC.Builtin.Names
+import GHC.Builtin.Types( stringTyCon_RDR )
import GHC.Types.Name.Reader as RdrName ( getGRE_NameQualifier_maybes, getRdrName )
import GHC.Types.SrcLoc as SrcLoc
import qualified GHC.Parser.Lexer as Lexer
@@ -1671,7 +1672,7 @@ defineMacro overwrite s = do
step <- getGhciStepIO
expr <- GHC.parseExpr definition
-- > ghciStepIO . definition :: String -> IO String
- let stringTy = nlHsTyVar stringTy_RDR
+ let stringTy = nlHsTyVar stringTyCon_RDR
ioM = nlHsTyVar (getRdrName ioTyConName) `nlHsAppTy` stringTy
body = nlHsVar compose_RDR `mkHsApp` (nlHsPar step)
`mkHsApp` (nlHsPar expr)
@@ -1739,7 +1740,7 @@ cmdCmd str = handleSourceError GHC.printException $ do
getGhciStepIO :: GHC.GhcMonad m => m (LHsExpr GhcPs)
getGhciStepIO = do
ghciTyConName <- GHC.getGHCiMonad
- let stringTy = nlHsTyVar stringTy_RDR
+ let stringTy = nlHsTyVar stringTyCon_RDR
ghciM = nlHsTyVar (getRdrName ghciTyConName) `nlHsAppTy` stringTy
ioM = nlHsTyVar (getRdrName ioTyConName) `nlHsAppTy` stringTy
body = nlHsVar (getRdrName ghciStepIoMName)
diff --git a/libraries/Cabal b/libraries/Cabal
-Subproject b744cde70820841f4cfd0626bf99292f5e7edba
+Subproject 8dc7f0db292ff1a5b1316127e3652d06ab51f3a
diff --git a/libraries/base/tests/T9681.stderr b/libraries/base/tests/T9681.stderr
index c3a2f2c3c7..58b4bc7371 100644
--- a/libraries/base/tests/T9681.stderr
+++ b/libraries/base/tests/T9681.stderr
@@ -1,5 +1,5 @@
T9681.hs:3:9: error:
- • No instance for (Num [Char]) arising from a use of ‘+’
+ • No instance for (Num String) arising from a use of ‘+’
• In the expression: 1 + "\n"
In an equation for ‘foo’: foo = 1 + "\n"
diff --git a/libraries/haskeline b/libraries/haskeline
-Subproject 463fc49d17bfab846cceba48bccc02ef285e6cb
+Subproject 3d3e7c18a44fa904f004e5eac0e666e396f1b3f
diff --git a/testsuite/tests/ado/T13242a.stderr b/testsuite/tests/ado/T13242a.stderr
index 9e32035ebb..5e6bc9899d 100644
--- a/testsuite/tests/ado/T13242a.stderr
+++ b/testsuite/tests/ado/T13242a.stderr
@@ -1,7 +1,8 @@
T13242a.hs:10:5: error:
• Couldn't match expected type ‘a0’ with actual type ‘a’
- ‘a’ is a rigid type variable bound by
+ because type variable ‘a’ would escape its scope
+ This (rigid, skolem) type variable is bound by
a pattern with constructor: A :: forall a. Eq a => a -> T,
in a pattern binding in
a 'do' block
diff --git a/testsuite/tests/ado/ado002.stderr b/testsuite/tests/ado/ado002.stderr
index d7c0b6da68..3402d0df55 100644
--- a/testsuite/tests/ado/ado002.stderr
+++ b/testsuite/tests/ado/ado002.stderr
@@ -1,7 +1,7 @@
ado002.hs:8:8: error:
- • Couldn't match expected type ‘Char -> IO b0’
- with actual type ‘IO Char’
+ • Couldn't match expected type: Char -> IO b0
+ with actual type: IO Char
• The function ‘getChar’ is applied to one value argument,
but its type ‘IO Char’ has none
In a stmt of a 'do' block: y <- getChar 'a'
@@ -12,8 +12,8 @@ ado002.hs:8:8: error:
ado002.hs:9:3: error:
• Couldn't match type ‘()’ with ‘Int’
- Expected type: IO Int
- Actual type: IO ()
+ Expected: IO Int
+ Actual: IO ()
• In a stmt of a 'do' block: print (x, y)
In the expression:
do x <- getChar
@@ -43,8 +43,8 @@ ado002.hs:15:13: error:
return (y, x)
ado002.hs:23:9: error:
- • Couldn't match expected type ‘Char -> IO t0’
- with actual type ‘IO Char’
+ • Couldn't match expected type: Char -> IO a0
+ with actual type: IO Char
• The function ‘getChar’ is applied to one value argument,
but its type ‘IO Char’ has none
In a stmt of a 'do' block: x5 <- getChar x4
diff --git a/testsuite/tests/ado/ado004.stderr b/testsuite/tests/ado/ado004.stderr
index 47024fdfd1..2ac9b26388 100644
--- a/testsuite/tests/ado/ado004.stderr
+++ b/testsuite/tests/ado/ado004.stderr
@@ -22,9 +22,9 @@ TYPE SIGNATURES
(Functor f, Num t, Num b) =>
(t -> f b) -> f b
test2d ::
- forall {f :: * -> *} {t1} {b} {t2}.
- (Functor f, Num t1, Num b) =>
- (t1 -> f t2) -> f b
+ forall {f :: * -> *} {t} {b} {a}.
+ (Functor f, Num t, Num b) =>
+ (t -> f a) -> f b
test3 ::
forall {m :: * -> *} {t1} {t2} {a}.
(Monad m, Num t1) =>
@@ -42,5 +42,5 @@ TYPE SIGNATURES
(Monad m, Num (m a)) =>
(m a -> m (m a)) -> p -> m a
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-prim-0.6.1,
- integer-gmp-1.0.2.0]
+Dependent packages: [base-4.14.0.0, ghc-prim-0.6.1,
+ integer-gmp-1.0.3.0]
diff --git a/testsuite/tests/annotations/should_fail/annfail06.hs b/testsuite/tests/annotations/should_fail/annfail06.hs
index 1362f1956e..6fc5ae2cf2 100644
--- a/testsuite/tests/annotations/should_fail/annfail06.hs
+++ b/testsuite/tests/annotations/should_fail/annfail06.hs
@@ -11,8 +11,8 @@ import Data.Typeable
deriving instance Typeable InstancesInWrongModule
instance Data InstancesInWrongModule where
- gfoldl = undefined
- gunfold = undefined
+ gfoldl k z = undefined
+ gunfold k z = undefined
{-# ANN module InstancesInWrongModule #-}
@@ -20,4 +20,4 @@ instance Data InstancesInWrongModule where
data Foo = Bar
{-# ANN f InstancesInWrongModule #-}
-f x = x \ No newline at end of file
+f x = x
diff --git a/testsuite/tests/arrows/should_fail/T5380.stderr b/testsuite/tests/arrows/should_fail/T5380.stderr
index 8b1c81af99..a116513014 100644
--- a/testsuite/tests/arrows/should_fail/T5380.stderr
+++ b/testsuite/tests/arrows/should_fail/T5380.stderr
@@ -17,13 +17,13 @@ T5380.hs:7:27: error:
T5380.hs:7:34: error:
• Couldn't match type ‘not_unit’ with ‘()’
+ Expected: () -> not_unit
+ Actual: () -> ()
‘not_unit’ is a rigid type variable bound by
the type signature for:
testB :: forall not_bool not_unit.
not_bool -> (() -> ()) -> () -> not_unit
at T5380.hs:6:1-49
- Expected type: () -> not_unit
- Actual type: () -> ()
• In the expression: f
In the command: f -< ()
In the expression: proc () -> if b then f -< () else f -< ()
diff --git a/testsuite/tests/backpack/should_fail/bkpfail24.stderr b/testsuite/tests/backpack/should_fail/bkpfail24.stderr
index 484ebf144b..65a79bf119 100644
--- a/testsuite/tests/backpack/should_fail/bkpfail24.stderr
+++ b/testsuite/tests/backpack/should_fail/bkpfail24.stderr
@@ -24,9 +24,8 @@ bkpfail24.bkp:14:15: error:
f :: a -> b (bound at bkpfail24.bkp:14:9)
bkpfail24.bkp:19:15: error:
- • Couldn't match expected type ‘{H2.T}’
- with actual type ‘{H1.T}’
- NB: ‘{H1.T}’ is defined at bkpfail24.bkp:4:9-14
- ‘{H2.T}’ is defined at bkpfail24.bkp:6:9-14
+ • Couldn't match expected type ‘{H2.T}’ with actual type ‘{H1.T}’
+ NB: ‘{H2.T}’ is defined at bkpfail24.bkp:6:9-14
+ ‘{H1.T}’ is defined at bkpfail24.bkp:4:9-14
• In the expression: x
In an equation for ‘g’: g x = x
diff --git a/testsuite/tests/boxy/Base1.stderr b/testsuite/tests/boxy/Base1.stderr
index 75a8e0cfe2..e9b2144533 100644
--- a/testsuite/tests/boxy/Base1.stderr
+++ b/testsuite/tests/boxy/Base1.stderr
@@ -1,15 +1,17 @@
Base1.hs:20:13: error:
- • Couldn't match type ‘a0 -> a0’ with ‘forall a. a -> a’
- Expected type: MEither Sid b
- Actual type: MEither (a0 -> a0) b
+ • Couldn't match type: a0 -> a0
+ with: forall a. a -> a
+ Expected: MEither Sid b
+ Actual: MEither (a0 -> a0) b
• In the expression: MLeft fid
In an equation for ‘test1’: test1 fid = MLeft fid
Base1.hs:25:39: error:
- • Couldn't match type ‘a1 -> a1’ with ‘forall a. a -> a’
- Expected type: Maybe (Sid, Sid)
- Actual type: Maybe (a1 -> a1, a2 -> a2)
+ • Couldn't match type: a1 -> a1
+ with: forall a. a -> a
+ Expected: Maybe (Sid, Sid)
+ Actual: Maybe (a1 -> a1, a2 -> a2)
• In the expression: Just (x, y)
In a case alternative: MRight y -> Just (x, y)
In the expression:
diff --git a/testsuite/tests/deSugar/should_compile/T10662.stderr b/testsuite/tests/deSugar/should_compile/T10662.stderr
index f27fc977b6..6a5cc457fc 100644
--- a/testsuite/tests/deSugar/should_compile/T10662.stderr
+++ b/testsuite/tests/deSugar/should_compile/T10662.stderr
@@ -1,5 +1,5 @@
T10662.hs:3:3: warning: [-Wunused-do-bind (in -Wall)]
- A do-notation statement discarded a result of type ‘[Char]’
+ A do-notation statement discarded a result of type ‘String’
Suppress this warning by saying
‘_ <- return $ let a = "hello" in a’
diff --git a/testsuite/tests/dependent/should_compile/dynamic-paper.stderr b/testsuite/tests/dependent/should_compile/dynamic-paper.stderr
index 89b88f45ab..44af3fd5f7 100644
--- a/testsuite/tests/dependent/should_compile/dynamic-paper.stderr
+++ b/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: 138082
+ Total ticks: 136724
diff --git a/testsuite/tests/dependent/should_fail/BadTelescope5.stderr b/testsuite/tests/dependent/should_fail/BadTelescope5.stderr
index 57b2ee7876..d2ec36e5df 100644
--- a/testsuite/tests/dependent/should_fail/BadTelescope5.stderr
+++ b/testsuite/tests/dependent/should_fail/BadTelescope5.stderr
@@ -1,6 +1,10 @@
BadTelescope5.hs:10:81: error:
- • Expected kind ‘k1’, but ‘d’ has kind ‘Proxy a1’
+ • Expected kind ‘k’, but ‘d’ has kind ‘Proxy a’
+ ‘k’ is a rigid type variable bound by
+ ‘forall a k (b :: k) (c :: Proxy b) (d :: Proxy a).
+ Proxy c -> SameKind b d’
+ at BadTelescope5.hs:10:17
• In the second argument of ‘SameKind’, namely ‘d’
In the type signature:
bar :: forall a k (b :: k) (c :: Proxy b) (d :: Proxy a).
diff --git a/testsuite/tests/dependent/should_fail/T11407.stderr b/testsuite/tests/dependent/should_fail/T11407.stderr
index b07aa2bbd8..df87248f2e 100644
--- a/testsuite/tests/dependent/should_fail/T11407.stderr
+++ b/testsuite/tests/dependent/should_fail/T11407.stderr
@@ -1,6 +1,6 @@
T11407.hs:10:40: error:
- • Occurs check: cannot construct the infinite kind: k0 ~ x a
+ • Expected kind ‘x a’, but ‘a’ has kind ‘k0’
• In the second argument of ‘UhOh’, namely ‘(a :: x a)’
In the data instance declaration for ‘UhOh’
• Type variable kinds:
diff --git a/testsuite/tests/dependent/should_fail/T11471.stderr b/testsuite/tests/dependent/should_fail/T11471.stderr
index 640ae6c754..7772850564 100644
--- a/testsuite/tests/dependent/should_fail/T11471.stderr
+++ b/testsuite/tests/dependent/should_fail/T11471.stderr
@@ -4,8 +4,8 @@ T11471.hs:15:10: error:
When matching types
a :: *
Int# :: TYPE 'IntRep
- Expected type: Proxy a
- Actual type: Proxy Int#
+ Expected: Proxy a
+ Actual: Proxy Int#
• In the first argument of ‘f’, namely ‘(undefined :: Proxy Int#)’
In the expression: f (undefined :: Proxy Int#) 3#
In an equation for ‘bad’: bad = f (undefined :: Proxy Int#) 3#
diff --git a/testsuite/tests/dependent/should_fail/T13780a.stderr b/testsuite/tests/dependent/should_fail/T13780a.stderr
index 3b113bd89e..5253ed0dbd 100644
--- a/testsuite/tests/dependent/should_fail/T13780a.stderr
+++ b/testsuite/tests/dependent/should_fail/T13780a.stderr
@@ -1,6 +1,7 @@
T13780a.hs:9:40: error:
- • Expected kind ‘Foo a’, but ‘MkFoo’ has kind ‘Foo Bool’
+ • Couldn't match kind ‘a’ with ‘Bool’
+ Expected kind ‘Foo a’, but ‘MkFoo’ has kind ‘Foo Bool’
• In the second argument of ‘(~)’, namely ‘MkFoo’
In the definition of data constructor ‘SMkFoo’
In the data instance declaration for ‘Sing’
diff --git a/testsuite/tests/dependent/should_fail/T14066.stderr b/testsuite/tests/dependent/should_fail/T14066.stderr
index a6780ff75f..d958f9a519 100644
--- a/testsuite/tests/dependent/should_fail/T14066.stderr
+++ b/testsuite/tests/dependent/should_fail/T14066.stderr
@@ -1,6 +1,10 @@
T14066.hs:15:59: error:
- • Expected kind ‘k2’, but ‘b’ has kind ‘k3’
+ • Expected kind ‘k0’, but ‘b’ has kind ‘k’
+ because kind variable ‘k’ would escape its scope
+ This (rigid, skolem) kind variable is bound by
+ ‘forall k (b :: k). SameKind a b’
+ at T14066.hs:15:29-59
• In the second argument of ‘SameKind’, namely ‘b’
In the type signature: g :: forall k (b :: k). SameKind a b
In the expression:
@@ -8,6 +12,4 @@ T14066.hs:15:59: error:
g :: forall k (b :: k). SameKind a b
g = undefined
in ()
- • Relevant bindings include
- x :: Proxy a (bound at T14066.hs:15:4)
- f :: Proxy a -> () (bound at T14066.hs:15:1)
+ • Relevant bindings include x :: Proxy a (bound at T14066.hs:15:4)
diff --git a/testsuite/tests/dependent/should_fail/T14066d.stderr b/testsuite/tests/dependent/should_fail/T14066d.stderr
index 289c7a121a..169897c416 100644
--- a/testsuite/tests/dependent/should_fail/T14066d.stderr
+++ b/testsuite/tests/dependent/should_fail/T14066d.stderr
@@ -1,6 +1,8 @@
T14066d.hs:11:35: error:
• Couldn't match type ‘b1’ with ‘b’
+ Expected: (Proxy a, Proxy c, b1)
+ Actual: (Proxy a, Proxy c, b)
‘b1’ is a rigid type variable bound by
a type expected by the context:
forall c b1 (a :: c). (Proxy a, Proxy c, b1)
@@ -9,8 +11,6 @@ T14066d.hs:11:35: error:
the type signature for:
f :: forall b. b -> (Proxy Maybe, ())
at T14066d.hs:10:1-37
- Expected type: (Proxy a, Proxy c, b1)
- Actual type: (Proxy a, Proxy c, b)
• In the first argument of ‘g’, namely ‘y’
In the expression: g y
In the expression: (fstOf3 y :: Proxy Maybe, g y)
diff --git a/testsuite/tests/dependent/should_fail/T14066e.stderr b/testsuite/tests/dependent/should_fail/T14066e.stderr
index ee903d6b4c..b103b16187 100644
--- a/testsuite/tests/dependent/should_fail/T14066e.stderr
+++ b/testsuite/tests/dependent/should_fail/T14066e.stderr
@@ -1,6 +1,11 @@
T14066e.hs:13:65: error:
• Expected a type, but ‘c'’ has kind ‘k1’
+ ‘k1’ is a rigid type variable bound by
+ the type signature for:
+ j :: forall {k1} {k2} (c :: k1) (b :: k2).
+ Proxy a -> Proxy b -> Proxy c -> Proxy b
+ at T14066e.hs:12:5-61
• In the kind ‘c'’
In the first argument of ‘Proxy’, namely ‘(b' :: c')’
In an expression type signature: Proxy (b' :: c')
diff --git a/testsuite/tests/dependent/should_fail/T16326_Fail10.stderr b/testsuite/tests/dependent/should_fail/T16326_Fail10.stderr
index bceccb1dcd..4ef380e5ba 100644
--- a/testsuite/tests/dependent/should_fail/T16326_Fail10.stderr
+++ b/testsuite/tests/dependent/should_fail/T16326_Fail10.stderr
@@ -3,5 +3,5 @@ T16326_Fail10.hs:12:18: error:
• Illegal visible, dependent quantification in the type of a term:
forall a -> a -> a
(GHC does not yet support this)
- • In a RULE for ‘x’: forall a -> a -> a
+ • In the type signature for ‘x’: forall a -> a -> a
When checking the transformation rule "flurmp"
diff --git a/testsuite/tests/dependent/should_fail/T17131.stderr b/testsuite/tests/dependent/should_fail/T17131.stderr
index dd250ed414..daad6ac054 100644
--- a/testsuite/tests/dependent/should_fail/T17131.stderr
+++ b/testsuite/tests/dependent/should_fail/T17131.stderr
@@ -1,7 +1,10 @@
T17131.hs:12:34: error:
- • Expected kind ‘TYPE ('TupleRep (TypeReps xs))’,
+ • Couldn't match kind: TypeReps xs
+ with: '[ 'LiftedRep]
+ Expected kind ‘TYPE ('TupleRep (TypeReps xs))’,
but ‘(# a #)’ has kind ‘TYPE ('TupleRep '[ 'LiftedRep])’
+ The type variable ‘xs’ is ambiguous
• In the type ‘(# a #)’
In the type family declaration for ‘Tuple#’
NB: Type ‘Tuple#’ was inferred to use visible dependent quantification.
diff --git a/testsuite/tests/dependent/should_fail/T17541.stderr b/testsuite/tests/dependent/should_fail/T17541.stderr
index e17206c734..d0ea673a2b 100644
--- a/testsuite/tests/dependent/should_fail/T17541.stderr
+++ b/testsuite/tests/dependent/should_fail/T17541.stderr
@@ -1,7 +1,8 @@
T17541.hs:20:17: error:
- • Expected kind ‘TYPE (Rep rep)’,
- but ‘Int#’ has kind ‘TYPE 'IntRep’
+ • Couldn't match kind ‘Rep rep’ with ‘'IntRep’
+ Expected kind ‘TYPE (Rep rep)’, but ‘Int#’ has kind ‘TYPE 'IntRep’
+ The type variable ‘rep’ is ambiguous
• In the type ‘Int#’
In the type family declaration for ‘Unboxed’
NB: Type ‘Unboxed’ was inferred to use visible dependent quantification.
diff --git a/testsuite/tests/dependent/should_fail/TypeSkolEscape.stderr b/testsuite/tests/dependent/should_fail/TypeSkolEscape.stderr
index e2ef266914..a919095337 100644
--- a/testsuite/tests/dependent/should_fail/TypeSkolEscape.stderr
+++ b/testsuite/tests/dependent/should_fail/TypeSkolEscape.stderr
@@ -1,5 +1,9 @@
TypeSkolEscape.hs:9:52: error:
• Expected kind ‘k0’, but ‘a’ has kind ‘TYPE v’
+ because kind variable ‘v’ would escape its scope
+ This (rigid, skolem) kind variable is bound by
+ ‘forall (v :: RuntimeRep) (a :: TYPE v). a’
+ at TypeSkolEscape.hs:9:12-52
• In the type ‘forall (v :: RuntimeRep) (a :: TYPE v). a’
In the type declaration for ‘Bad’
diff --git a/testsuite/tests/deriving/should_fail/T1496.stderr b/testsuite/tests/deriving/should_fail/T1496.stderr
index c560f5fe0f..6183819bc4 100644
--- a/testsuite/tests/deriving/should_fail/T1496.stderr
+++ b/testsuite/tests/deriving/should_fail/T1496.stderr
@@ -1,9 +1,10 @@
T1496.hs:10:32: error:
- Couldn't match representation of type ‘c Int’ with that of ‘c Moo’
- arising from the coercion of the method ‘isInt’
- from type ‘forall (c :: * -> *). c Int -> c Int’
- to type ‘forall (c :: * -> *). c Int -> c Moo’
- NB: We cannot know what roles the parameters to ‘c’ have;
- we must assume that the role is nominal
- When deriving the instance for (IsInt Moo)
+ • Couldn't match representation of type: c Int
+ with that of: c Moo
+ arising from the coercion of the method ‘isInt’
+ from type ‘forall (c :: * -> *). c Int -> c Int’
+ to type ‘forall (c :: * -> *). c Int -> c Moo’
+ NB: We cannot know what roles the parameters to ‘c’ have;
+ we must assume that the role is nominal
+ • When deriving the instance for (IsInt Moo)
diff --git a/testsuite/tests/deriving/should_fail/T5498.stderr b/testsuite/tests/deriving/should_fail/T5498.stderr
index ce87ef1867..1960487c38 100644
--- a/testsuite/tests/deriving/should_fail/T5498.stderr
+++ b/testsuite/tests/deriving/should_fail/T5498.stderr
@@ -1,10 +1,10 @@
T5498.hs:30:39: error:
- Couldn't match representation of type ‘c a’
- with that of ‘c (Down a)’
- arising from the coercion of the method ‘intIso’
- from type ‘forall (c :: * -> *). c a -> c Int’
- to type ‘forall (c :: * -> *). c (Down a) -> c Int’
- NB: We cannot know what roles the parameters to ‘c’ have;
- we must assume that the role is nominal
- When deriving the instance for (IntIso (Down a))
+ • Couldn't match representation of type: c a
+ with that of: c (Down a)
+ arising from the coercion of the method ‘intIso’
+ from type ‘forall (c :: * -> *). c a -> c Int’
+ to type ‘forall (c :: * -> *). c (Down a) -> c Int’
+ NB: We cannot know what roles the parameters to ‘c’ have;
+ we must assume that the role is nominal
+ • When deriving the instance for (IntIso (Down a))
diff --git a/testsuite/tests/deriving/should_fail/T7148.stderr b/testsuite/tests/deriving/should_fail/T7148.stderr
index ee42cc91f1..487d2da622 100644
--- a/testsuite/tests/deriving/should_fail/T7148.stderr
+++ b/testsuite/tests/deriving/should_fail/T7148.stderr
@@ -1,14 +1,20 @@
T7148.hs:27:40: error:
- • Occurs check: cannot construct the infinite type: b ~ Tagged a b
+ • Couldn't match type ‘b’ with ‘Tagged a b’
arising from the coercion of the method ‘iso2’
from type ‘forall b1. SameType b1 () -> SameType b1 b’
to type ‘forall b1. SameType b1 () -> SameType b1 (Tagged a b)’
+ ‘b’ is a rigid type variable bound by
+ the deriving clause for ‘IsoUnit (Tagged a b)’
+ at T7148.hs:27:40-46
• When deriving the instance for (IsoUnit (Tagged a b))
T7148.hs:27:40: error:
- • Occurs check: cannot construct the infinite type: b ~ Tagged a b
+ • Couldn't match type ‘b’ with ‘Tagged a b’
arising from the coercion of the method ‘iso1’
from type ‘forall b1. SameType () b1 -> SameType b b1’
to type ‘forall b1. SameType () b1 -> SameType (Tagged a b) b1’
+ ‘b’ is a rigid type variable bound by
+ the deriving clause for ‘IsoUnit (Tagged a b)’
+ at T7148.hs:27:40-46
• When deriving the instance for (IsoUnit (Tagged a b))
diff --git a/testsuite/tests/deriving/should_fail/T8984.stderr b/testsuite/tests/deriving/should_fail/T8984.stderr
index 1cdc425293..9908f70f0a 100644
--- a/testsuite/tests/deriving/should_fail/T8984.stderr
+++ b/testsuite/tests/deriving/should_fail/T8984.stderr
@@ -1,9 +1,9 @@
T8984.hs:7:46: error:
- Couldn't match representation of type ‘cat a (N cat a Int)’
- with that of ‘cat a (cat a Int)’
- arising from the coercion of the method ‘app’
- from type ‘cat a (cat a Int)’ to type ‘N cat a (N cat a Int)’
- NB: We cannot know what roles the parameters to ‘cat a’ have;
- we must assume that the role is nominal
- When deriving the instance for (C (N cat a))
+ • Couldn't match representation of type: cat a (N cat a Int)
+ with that of: cat a (cat a Int)
+ arising from the coercion of the method ‘app’
+ from type ‘cat a (cat a Int)’ to type ‘N cat a (N cat a Int)’
+ NB: We cannot know what roles the parameters to ‘cat a’ have;
+ we must assume that the role is nominal
+ • When deriving the instance for (C (N cat a))
diff --git a/testsuite/tests/determinism/determ004/determ004.hs b/testsuite/tests/determinism/determ004/determ004.hs
index 643fa0769d..97d268f1fa 100644
--- a/testsuite/tests/determinism/determ004/determ004.hs
+++ b/testsuite/tests/determinism/determ004/determ004.hs
@@ -302,13 +302,13 @@ sFoldr1 sF (SCons sX (SCons sWild_1627448474 sWild_1627448476))
sXs
= applySing
(applySing
- (singFun2 (undefined :: Proxy (:$)) SCons) wild_1627448474_afeF)
+ (singFun2 (undefined :: Proxy (:$)) (\ x y -> SCons x y)) wild_1627448474_afeF)
wild_1627448476_afeG
in
applySing
(applySing f_afeD x_afeE)
(applySing
- (applySing (singFun2 (undefined :: Proxy Foldr1Sym0) sFoldr1) f_afeD)
+ (applySing (singFun2 (undefined :: Proxy Foldr1Sym0) (\x y -> sFoldr1 x y)) f_afeD)
sXs)
in lambda_afeC sF sX sWild_1627448474 sWild_1627448476
sFoldr1 _ SNil = undefined
diff --git a/testsuite/tests/gadt/T3169.stderr b/testsuite/tests/gadt/T3169.stderr
index d0f650b9ab..5770e03c70 100644
--- a/testsuite/tests/gadt/T3169.stderr
+++ b/testsuite/tests/gadt/T3169.stderr
@@ -1,8 +1,12 @@
T3169.hs:13:22: error:
- • Occurs check: cannot construct the infinite type: elt ~ Map b elt
- Expected type: Map a (Map b elt)
- Actual type: Map (a, b) elt
+ • Couldn't match type ‘elt’ with ‘Map b elt’
+ Expected: Map a (Map b elt)
+ Actual: Map (a, b) elt
+ ‘elt’ is a rigid type variable bound by
+ the type signature for:
+ lookup :: forall elt. (a, b) -> Map (a, b) elt -> Maybe elt
+ at T3169.hs:12:3-8
• In the second argument of ‘lookup’, namely ‘m’
In the expression: lookup a m :: Maybe (Map b elt)
In the expression:
diff --git a/testsuite/tests/gadt/T3651.stderr b/testsuite/tests/gadt/T3651.stderr
index 62e3bf16d7..cd235748bb 100644
--- a/testsuite/tests/gadt/T3651.stderr
+++ b/testsuite/tests/gadt/T3651.stderr
@@ -1,14 +1,14 @@
T3651.hs:11:15: error:
• Couldn't match type ‘()’ with ‘Bool’
- Expected type: a
- Actual type: ()
+ Expected: a
+ Actual: ()
• In the expression: ()
In an equation for ‘unsafe1’: unsafe1 B U = ()
T3651.hs:14:15: error:
• Couldn't match type ‘()’ with ‘Bool’
- Expected type: a
- Actual type: ()
+ Expected: a
+ Actual: ()
• In the expression: ()
In an equation for ‘unsafe2’: unsafe2 B U = ()
diff --git a/testsuite/tests/gadt/T7558.stderr b/testsuite/tests/gadt/T7558.stderr
index 29d7fa65a3..c8b9ec4223 100644
--- a/testsuite/tests/gadt/T7558.stderr
+++ b/testsuite/tests/gadt/T7558.stderr
@@ -1,6 +1,10 @@
T7558.hs:8:18: error:
- • Occurs check: cannot construct the infinite type: a ~ Maybe a
+ • Couldn't match expected type ‘a’ with actual type ‘Maybe a’
+ ‘a’ is a rigid type variable bound by
+ the type signature for:
+ f :: forall a. T a a -> Bool
+ at T7558.hs:7:1-18
• In the expression: y
In the first argument of ‘seq’, namely ‘[x, y]’
In the expression: [x, y] `seq` True
diff --git a/testsuite/tests/gadt/gadt-escape1.stderr b/testsuite/tests/gadt/gadt-escape1.stderr
index 41322f9cbc..19aa501a4c 100644
--- a/testsuite/tests/gadt/gadt-escape1.stderr
+++ b/testsuite/tests/gadt/gadt-escape1.stderr
@@ -1,16 +1,17 @@
gadt-escape1.hs:19:58: error:
• Couldn't match type ‘p’ with ‘ExpGADT Int’
+ Expected: p
+ Actual: ExpGADT t
‘p’ is untouchable
inside the constraints: t ~ Int
bound by a pattern with constructor: ExpInt :: Int -> ExpGADT Int,
in a case alternative
at gadt-escape1.hs:19:43-50
‘p’ is a rigid type variable bound by
- the inferred type of weird1 :: p at gadt-escape1.hs:19:1-58
+ the inferred type of weird1 :: p
+ at gadt-escape1.hs:19:1-58
Possible fix: add a type signature for ‘weird1’
- Expected type: p
- Actual type: ExpGADT t
• In the expression: a
In a case alternative: Hidden (ExpInt _) a -> a
In the expression:
diff --git a/testsuite/tests/gadt/rw.stderr b/testsuite/tests/gadt/rw.stderr
index 067595f2d7..fe6ba1edee 100644
--- a/testsuite/tests/gadt/rw.stderr
+++ b/testsuite/tests/gadt/rw.stderr
@@ -15,12 +15,12 @@ rw.hs:14:47: error:
rw.hs:19:43: error:
• Couldn't match type ‘a’ with ‘Bool’
+ Expected: a -> IO ()
+ Actual: Bool -> IO ()
‘a’ is a rigid type variable bound by
the type signature for:
readBool :: forall a. T a -> IORef a -> IO ()
at rw.hs:16:1-34
- Expected type: a -> IO ()
- Actual type: Bool -> IO ()
• In the second argument of ‘(>>=)’, namely ‘(print . not)’
In the expression: readIORef ref >>= (print . not)
In a case alternative: ~(Lb x) -> readIORef ref >>= (print . not)
diff --git a/testsuite/tests/ghci.debugger/scripts/T14628.stderr b/testsuite/tests/ghci.debugger/scripts/T14628.stderr
index 276d63ff38..8990cdb97b 100644
--- a/testsuite/tests/ghci.debugger/scripts/T14628.stderr
+++ b/testsuite/tests/ghci.debugger/scripts/T14628.stderr
@@ -1,12 +1,13 @@
-<interactive>:4:7:
- Couldn't match type ‘m’ with ‘(,) a0’
+
+<interactive>:4:7: error:
+ • Couldn't match type ‘m’ with ‘(,) a0’
+ Expected: (a0, ((), Int))
+ Actual: m ((), Int)
‘m’ is untouchable
inside the constraints: ()
bound by the inferred type of it :: ((), Int)
at <interactive>:4:1-25
‘m’ is an interactive-debugger skolem
- Expected type: (a0, ((), Int))
- Actual type: m ((), Int)
- In the second argument of ‘($)’, namely ‘runStateT _result 0’
+ • In the second argument of ‘($)’, namely ‘runStateT _result 0’
In the expression: snd $ runStateT _result 0
In an equation for ‘it’: it = snd $ runStateT _result 0
diff --git a/testsuite/tests/ghci/scripts/Defer02.stderr b/testsuite/tests/ghci/scripts/Defer02.stderr
index 0defd52b38..c25cc4b81f 100644
--- a/testsuite/tests/ghci/scripts/Defer02.stderr
+++ b/testsuite/tests/ghci/scripts/Defer02.stderr
@@ -1,8 +1,8 @@
Defer01.hs:11:40: warning: [-Wdeferred-type-errors (in -Wdefault)]
• Couldn't match type ‘Char’ with ‘[Char]’
- Expected type: String
- Actual type: Char
+ Expected: String
+ Actual: Char
• In the first argument of ‘putStr’, namely ‘','’
In the second argument of ‘(>>)’, namely ‘putStr ','’
In the expression: putStr "Hello World" >> putStr ','
@@ -60,16 +60,16 @@ Defer01.hs:47:7: warning: [-Wdeferred-type-errors (in -Wdefault)]
In an equation for ‘k’: k x = x
Defer01.hs:50:5: warning: [-Wdeferred-type-errors (in -Wdefault)]
- • Couldn't match expected type ‘IO a0’
- with actual type ‘Char -> IO ()’
+ • Couldn't match expected type: IO a0
+ with actual type: Char -> IO ()
• Probable cause: ‘putChar’ is applied to too few arguments
In the first argument of ‘(>>)’, namely ‘putChar’
In the expression: putChar >> putChar 'p'
In an equation for ‘l’: l = putChar >> putChar 'p'
*** Exception: Defer01.hs:11:40: error:
• Couldn't match type ‘Char’ with ‘[Char]’
- Expected type: String
- Actual type: Char
+ Expected: String
+ Actual: Char
• In the first argument of ‘putStr’, namely ‘','’
In the second argument of ‘(>>)’, namely ‘putStr ','’
In the expression: putStr "Hello World" >> putStr ','
@@ -87,8 +87,8 @@ Defer01.hs:50:5: warning: [-Wdeferred-type-errors (in -Wdefault)]
<interactive>:10:11: error:
• Couldn't match type ‘Bool’ with ‘Int’
- Expected type: C Int
- Actual type: C Bool
+ Expected: C Int
+ Actual: C Bool
• In the first argument of ‘c’, namely ‘(C2 True)’
In the first argument of ‘print’, namely ‘(c (C2 True))’
In the expression: print (c (C2 True))
@@ -140,8 +140,8 @@ Defer01.hs:50:5: warning: [-Wdeferred-type-errors (in -Wdefault)]
In the expression: print (k 2)
In an equation for ‘it’: it = print (k 2)
*** Exception: Defer01.hs:50:5: error:
- • Couldn't match expected type ‘IO a0’
- with actual type ‘Char -> IO ()’
+ • Couldn't match expected type: IO a0
+ with actual type: Char -> IO ()
• Probable cause: ‘putChar’ is applied to too few arguments
In the first argument of ‘(>>)’, namely ‘putChar’
In the expression: putChar >> putChar 'p'
diff --git a/testsuite/tests/ghci/scripts/T10508.stderr b/testsuite/tests/ghci/scripts/T10508.stderr
index 365bf9fcae..f7931e48e2 100644
--- a/testsuite/tests/ghci/scripts/T10508.stderr
+++ b/testsuite/tests/ghci/scripts/T10508.stderr
@@ -1,8 +1,9 @@
<interactive>:1:8: error:
- • Couldn't match type ‘a0 -> a0’ with ‘[Char]’
- Expected type: IO Prelude.String
- Actual type: IO (a0 -> a0)
+ • Couldn't match type: a0 -> a0
+ with: [Char]
+ Expected: IO Prelude.String
+ Actual: IO (a0 -> a0)
• In the expression: return id
In the second argument of ‘(.)’, namely ‘(\ _ -> return id)’
In the expression:
diff --git a/testsuite/tests/ghci/scripts/T12005.script b/testsuite/tests/ghci/scripts/T12005.script
index a86e7d5e8e..4be674ede8 100644
--- a/testsuite/tests/ghci/scripts/T12005.script
+++ b/testsuite/tests/ghci/scripts/T12005.script
@@ -1,8 +1,8 @@
-:set -XKindSignatures -XRank2Types -XConstraintKinds -XAllowAmbiguousTypes -XInstanceSigs
+:set -XKindSignatures -XRank2Types -XConstraintKinds -XAllowAmbiguousTypes
import Data.Kind
class Defer (p :: Constraint) where defer :: (p => r) -> r
-instance Defer () where defer :: r -> r; defer = id
+instance Defer () where defer x = x
:i Defer
diff --git a/testsuite/tests/ghci/scripts/T12447.stdout b/testsuite/tests/ghci/scripts/T12447.stdout
index 7a64e1546d..6c469eeef3 100644
--- a/testsuite/tests/ghci/scripts/T12447.stdout
+++ b/testsuite/tests/ghci/scripts/T12447.stdout
@@ -1,3 +1,3 @@
deferEither @(_ ~ _)
- :: (Typeable _1, Typeable _2) =>
- proxy (_1 ~ _2) -> ((_1 ~ _2) => r) -> Either String r
+ :: (Typeable w1, Typeable w2) =>
+ proxy (w1 ~ w2) -> ((w1 ~ w2) => r) -> Either String r
diff --git a/testsuite/tests/ghci/scripts/T16767.stdout b/testsuite/tests/ghci/scripts/T16767.stdout
index 340ed6ee80..5cd96f96a7 100644
--- a/testsuite/tests/ghci/scripts/T16767.stdout
+++ b/testsuite/tests/ghci/scripts/T16767.stdout
@@ -1,2 +1,2 @@
-'Proxy @_ :: forall {k} {_ :: k}. Proxy @{k} _
-= 'Proxy @{k} @_
+'Proxy @_ :: forall {k} {w :: k}. Proxy @{k} w
+= 'Proxy @{k} @w
diff --git a/testsuite/tests/ghci/scripts/T2976.stdout b/testsuite/tests/ghci/scripts/T2976.stdout
index 9c977a2cb3..8d8edae907 100644
--- a/testsuite/tests/ghci/scripts/T2976.stdout
+++ b/testsuite/tests/ghci/scripts/T2976.stdout
@@ -1,6 +1,6 @@
test :: Int = 0
test = 0
test :: Int = 0
-test :: [Char] = _
+test :: String = _
test = "test"
-test :: [Char] = "test"
+test :: String = "test"
diff --git a/testsuite/tests/ghci/scripts/T8357.stdout b/testsuite/tests/ghci/scripts/T8357.stdout
index 7975d1f1a1..2f2cf22b47 100644
--- a/testsuite/tests/ghci/scripts/T8357.stdout
+++ b/testsuite/tests/ghci/scripts/T8357.stdout
@@ -1,3 +1,3 @@
-foo :: Rec '["foo" ::: [Char]]
-bar :: Rec '["bar" ::: [Char]]
-both :: Rec '["foo" ::: [Char], "bar" ::: [Char]]
+foo :: Rec '["foo" ::: String]
+bar :: Rec '["bar" ::: String]
+both :: Rec '["foo" ::: [Char], "bar" ::: String]
diff --git a/testsuite/tests/ghci/scripts/T8649.stderr b/testsuite/tests/ghci/scripts/T8649.stderr
index aa40d50c2e..96afa36a54 100644
--- a/testsuite/tests/ghci/scripts/T8649.stderr
+++ b/testsuite/tests/ghci/scripts/T8649.stderr
@@ -1,9 +1,8 @@
<interactive>:4:4: error:
- Couldn't match expected type ‘Ghci1.X’
- with actual type ‘X’
- NB: ‘X’ is defined at <interactive>:3:1-25
- ‘Ghci1.X’ is defined at <interactive>:1:1-14
- In the first argument of ‘f’, namely ‘(Y 3)’
- In the expression: f (Y 3)
- In an equation for ‘it’: it = f (Y 3)
+ • Couldn't match expected type ‘Ghci1.X’ with actual type ‘X’
+ NB: ‘Ghci1.X’ is defined at <interactive>:1:1-14
+ ‘X’ is defined at <interactive>:3:1-25
+ • In the first argument of ‘f’, namely ‘(Y 3)’
+ In the expression: f (Y 3)
+ In an equation for ‘it’: it = f (Y 3)
diff --git a/testsuite/tests/ghci/scripts/T8959b.stderr b/testsuite/tests/ghci/scripts/T8959b.stderr
index a814d2e5cb..971261ba40 100644
--- a/testsuite/tests/ghci/scripts/T8959b.stderr
+++ b/testsuite/tests/ghci/scripts/T8959b.stderr
@@ -10,7 +10,7 @@ T8959b.hs:8:7: error:
In an equation for ‘bar’: bar = proc x -> do return ⤙ x
T8959b.hs:10:7: error:
- • Couldn't match expected type ‘(∀ a2. a2 → a2) → a1’
+ • Couldn't match expected type ‘(∀ a. a → a) → a1’
with actual type ‘()’
• In the expression: () ∷ (∀ a. a → a) → a
In an equation for ‘baz’: baz = () ∷ (∀ a. a → a) → a
diff --git a/testsuite/tests/ghci/scripts/ghci012.stdout b/testsuite/tests/ghci/scripts/ghci012.stdout
index 0fc695c4d1..32ceac8b06 100644
--- a/testsuite/tests/ghci/scripts/ghci012.stdout
+++ b/testsuite/tests/ghci/scripts/ghci012.stdout
@@ -1 +1 @@
-($$$) :: [a -> c] -> [a] -> [c] -- Defined at <interactive>:1:8
+($$$) :: [b -> c] -> [b] -> [c] -- Defined at <interactive>:1:8
diff --git a/testsuite/tests/ghci/scripts/ghci051.stderr b/testsuite/tests/ghci/scripts/ghci051.stderr
index 6d28081344..9407837580 100644
--- a/testsuite/tests/ghci/scripts/ghci051.stderr
+++ b/testsuite/tests/ghci/scripts/ghci051.stderr
@@ -1,10 +1,9 @@
<interactive>:6:9: error:
- Couldn't match type ‘T’
- with ‘Ghci1.T’
- NB: ‘Ghci1.T’ is defined at <interactive>:2:1-14
- ‘T’ is defined at <interactive>:5:1-16
- Expected type: T'
- Actual type: T
- In the expression: C :: T'
- In an equation for ‘c’: c = C :: T'
+ • Couldn't match type ‘T’ with ‘Ghci1.T’
+ Expected: T'
+ Actual: T
+ NB: ‘Ghci1.T’ is defined at <interactive>:2:1-14
+ ‘T’ is defined at <interactive>:5:1-16
+ • In the expression: C :: T'
+ In an equation for ‘c’: c = C :: T'
diff --git a/testsuite/tests/ghci/scripts/ghci052.stderr b/testsuite/tests/ghci/scripts/ghci052.stderr
index 224726f822..047ab5e966 100644
--- a/testsuite/tests/ghci/scripts/ghci052.stderr
+++ b/testsuite/tests/ghci/scripts/ghci052.stderr
@@ -1,35 +1,35 @@
<interactive>:8:4: error:
- Couldn't match expected type ‘Ghci1.Planet’
- with actual type ‘Planet’
- NB: ‘Planet’ is defined at <interactive>:7:1-36
- ‘Ghci1.Planet’ is defined at <interactive>:4:1-37
- In the first argument of ‘pn’, namely ‘Mercury’
- In the expression: pn Mercury
- In an equation for ‘it’: it = pn Mercury
+ • Couldn't match expected type ‘Ghci1.Planet’
+ with actual type ‘Planet’
+ NB: ‘Ghci1.Planet’ is defined at <interactive>:4:1-37
+ ‘Planet’ is defined at <interactive>:7:1-36
+ • In the first argument of ‘pn’, namely ‘Mercury’
+ In the expression: pn Mercury
+ In an equation for ‘it’: it = pn Mercury
<interactive>:9:4: error:
- Couldn't match expected type ‘Ghci1.Planet’
- with actual type ‘Planet’
- NB: ‘Planet’ is defined at <interactive>:7:1-36
- ‘Ghci1.Planet’ is defined at <interactive>:4:1-37
- In the first argument of ‘pn’, namely ‘Venus’
- In the expression: pn Venus
- In an equation for ‘it’: it = pn Venus
+ • Couldn't match expected type ‘Ghci1.Planet’
+ with actual type ‘Planet’
+ NB: ‘Ghci1.Planet’ is defined at <interactive>:4:1-37
+ ‘Planet’ is defined at <interactive>:7:1-36
+ • In the first argument of ‘pn’, namely ‘Venus’
+ In the expression: pn Venus
+ In an equation for ‘it’: it = pn Venus
<interactive>:10:4: error:
- Couldn't match expected type ‘Ghci1.Planet’
- with actual type ‘Planet’
- NB: ‘Planet’ is defined at <interactive>:7:1-36
- ‘Ghci1.Planet’ is defined at <interactive>:4:1-37
- In the first argument of ‘pn’, namely ‘Mars’
- In the expression: pn Mars
- In an equation for ‘it’: it = pn Mars
+ • Couldn't match expected type ‘Ghci1.Planet’
+ with actual type ‘Planet’
+ NB: ‘Ghci1.Planet’ is defined at <interactive>:4:1-37
+ ‘Planet’ is defined at <interactive>:7:1-36
+ • In the first argument of ‘pn’, namely ‘Mars’
+ In the expression: pn Mars
+ In an equation for ‘it’: it = pn Mars
<interactive>:12:44: error:
- Couldn't match expected type ‘Planet’
- with actual type ‘Ghci1.Planet’
- NB: ‘Ghci1.Planet’ is defined at <interactive>:4:1-37
- ‘Planet’ is defined at <interactive>:7:1-36
- In the pattern: Earth
- In an equation for ‘pn’: pn Earth = "E"
+ • Couldn't match expected type ‘Planet’
+ with actual type ‘Ghci1.Planet’
+ NB: ‘Planet’ is defined at <interactive>:7:1-36
+ ‘Ghci1.Planet’ is defined at <interactive>:4:1-37
+ • In the pattern: Earth
+ In an equation for ‘pn’: pn Earth = "E"
diff --git a/testsuite/tests/ghci/scripts/ghci053.stderr b/testsuite/tests/ghci/scripts/ghci053.stderr
index 76d5ae2548..d2cd0a6a68 100644
--- a/testsuite/tests/ghci/scripts/ghci053.stderr
+++ b/testsuite/tests/ghci/scripts/ghci053.stderr
@@ -1,18 +1,18 @@
<interactive>:9:12: error:
- Couldn't match expected type ‘Ghci1.Planet’
- with actual type ‘Planet’
- NB: ‘Planet’ is defined at <interactive>:7:1-41
- ‘Ghci1.Planet’ is defined at <interactive>:4:1-49
- In the second argument of ‘(==)’, namely ‘Mercury’
- In the expression: mercury == Mercury
- In an equation for ‘it’: it = mercury == Mercury
+ • Couldn't match expected type ‘Ghci1.Planet’
+ with actual type ‘Planet’
+ NB: ‘Ghci1.Planet’ is defined at <interactive>:4:1-49
+ ‘Planet’ is defined at <interactive>:7:1-41
+ • In the second argument of ‘(==)’, namely ‘Mercury’
+ In the expression: mercury == Mercury
+ In an equation for ‘it’: it = mercury == Mercury
<interactive>:11:10: error:
- Couldn't match expected type ‘Planet’
- with actual type ‘Ghci1.Planet’
- NB: ‘Ghci1.Planet’ is defined at <interactive>:4:1-49
- ‘Planet’ is defined at <interactive>:7:1-41
- In the second argument of ‘(==)’, namely ‘Earth’
- In the expression: Venus == Earth
- In an equation for ‘it’: it = Venus == Earth
+ • Couldn't match expected type ‘Planet’
+ with actual type ‘Ghci1.Planet’
+ NB: ‘Planet’ is defined at <interactive>:7:1-41
+ ‘Ghci1.Planet’ is defined at <interactive>:4:1-49
+ • In the second argument of ‘(==)’, namely ‘Earth’
+ In the expression: Venus == Earth
+ In an equation for ‘it’: it = Venus == Earth
diff --git a/testsuite/tests/ghci/scripts/ghci061.stderr b/testsuite/tests/ghci/scripts/ghci061.stderr
index 1ba00c5609..27dac2cb77 100644
--- a/testsuite/tests/ghci/scripts/ghci061.stderr
+++ b/testsuite/tests/ghci/scripts/ghci061.stderr
@@ -1,16 +1,18 @@
<interactive>:1:2: error:
- • Couldn't match type ‘IO String’ with ‘Int -> IO String’
- Expected type: [String] -> Int -> IO String
- Actual type: [String] -> IO String
+ • Couldn't match type: IO String
+ with: Int -> IO String
+ Expected: [String] -> Int -> IO String
+ Actual: [String] -> IO String
• In the expression: (two_args) :: [String] -> Int -> IO String
In an equation for ‘_compileParsedExpr’:
_compileParsedExpr = (two_args) :: [String] -> Int -> IO String
<interactive>:1:2: error:
- • Couldn't match type ‘IO String’ with ‘Int -> IO String’
- Expected type: [String] -> Int -> IO String
- Actual type: [String] -> IO String
+ • Couldn't match type: IO String
+ with: Int -> IO String
+ Expected: [String] -> Int -> IO String
+ Actual: [String] -> IO String
• In the expression: (two_args) :: [String] -> Int -> IO String
In an equation for ‘_compileParsedExpr’:
_compileParsedExpr = (two_args) :: [String] -> Int -> IO String
diff --git a/testsuite/tests/ghci/scripts/ghci064.stdout b/testsuite/tests/ghci/scripts/ghci064.stdout
index e3fe5a9804..9190a68e67 100644
--- a/testsuite/tests/ghci/scripts/ghci064.stdout
+++ b/testsuite/tests/ghci/scripts/ghci064.stdout
@@ -6,25 +6,25 @@ instance GHC.Base.MonadPlus Maybe -- Defined in ‘GHC.Base’
instance MonadFail Maybe -- Defined in ‘Control.Monad.Fail’
instance Foldable Maybe -- Defined in ‘Data.Foldable’
instance Traversable Maybe -- Defined in ‘Data.Traversable’
-instance Eq _ => Eq (Maybe _) -- Defined in ‘GHC.Maybe’
-instance Semigroup _ => Monoid (Maybe _) -- Defined in ‘GHC.Base’
-instance Ord _ => Ord (Maybe _) -- Defined in ‘GHC.Maybe’
-instance Semigroup _ => Semigroup (Maybe _)
+instance Eq w => Eq (Maybe w) -- Defined in ‘GHC.Maybe’
+instance Semigroup w => Monoid (Maybe w) -- Defined in ‘GHC.Base’
+instance Ord w => Ord (Maybe w) -- Defined in ‘GHC.Maybe’
+instance Semigroup w => Semigroup (Maybe w)
-- Defined in ‘GHC.Base’
-instance Show _ => Show (Maybe _) -- Defined in ‘GHC.Show’
-instance Read _ => Read (Maybe _) -- Defined in ‘GHC.Read’
-instance GHC.Generics.Generic (Maybe _)
+instance Show w => Show (Maybe w) -- Defined in ‘GHC.Show’
+instance Read w => Read (Maybe w) -- Defined in ‘GHC.Read’
+instance GHC.Generics.Generic (Maybe w)
-- Defined in ‘GHC.Generics’
-instance GHC.Generics.SingKind _ => GHC.Generics.SingKind (Maybe _)
+instance GHC.Generics.SingKind w => GHC.Generics.SingKind (Maybe w)
-- Defined in ‘GHC.Generics’
-instance Eq _ => Eq [_] -- Defined in ‘GHC.Classes’
-instance Monoid [_] -- Defined in ‘GHC.Base’
-instance Ord _ => Ord [_] -- Defined in ‘GHC.Classes’
-instance Semigroup [_] -- Defined in ‘GHC.Base’
-instance Show _ => Show [_] -- Defined in ‘GHC.Show’
-instance Read _ => Read [_] -- Defined in ‘GHC.Read’
-instance GHC.Generics.Generic [_] -- Defined in ‘GHC.Generics’
-instance [safe] MyShow _ => MyShow [_]
+instance Eq w => Eq [w] -- Defined in ‘GHC.Classes’
+instance Monoid [w] -- Defined in ‘GHC.Base’
+instance Ord w => Ord [w] -- Defined in ‘GHC.Classes’
+instance Semigroup [w] -- Defined in ‘GHC.Base’
+instance Show w => Show [w] -- Defined in ‘GHC.Show’
+instance Read w => Read [w] -- Defined in ‘GHC.Read’
+instance GHC.Generics.Generic [w] -- Defined in ‘GHC.Generics’
+instance [safe] MyShow w => MyShow [w]
-- Defined at ghci064.hs:7:10
instance Monoid [T] -- Defined in ‘GHC.Base’
instance Semigroup [T] -- Defined in ‘GHC.Base’
diff --git a/testsuite/tests/ghci/should_fail/T16287.stderr b/testsuite/tests/ghci/should_fail/T16287.stderr
index 8b0f882ab7..df162c1b1b 100644
--- a/testsuite/tests/ghci/should_fail/T16287.stderr
+++ b/testsuite/tests/ghci/should_fail/T16287.stderr
@@ -4,6 +4,8 @@
<interactive>:1:4: error:
• Expected kind ‘forall k. k’, but ‘F2’ has kind ‘k0’
+ Cannot instantiate unification variable ‘k0’
+ with a kind involving polytypes: forall k. k
• In the first argument of ‘T2’, namely ‘F2’
In the type ‘T2 F2’
@@ -12,6 +14,8 @@
<interactive>:1:11: error:
• Expected kind ‘forall k. k’, but ‘F2’ has kind ‘k0’
+ Cannot instantiate unification variable ‘k0’
+ with a kind involving polytypes: forall k. k
• In the first argument of ‘T2’, namely ‘F2’
In the first argument of ‘Maybe’, namely ‘(T2 F2)’
In the type ‘Maybe (T2 F2)’
diff --git a/testsuite/tests/ghci/should_run/T13456.stdout b/testsuite/tests/ghci/should_run/T13456.stdout
index 8bfc0283fd..7d354f4355 100644
--- a/testsuite/tests/ghci/should_run/T13456.stdout
+++ b/testsuite/tests/ghci/should_run/T13456.stdout
@@ -3,8 +3,8 @@ macro 'type' overwrites builtin command. Use ':def!' to overwrite.
macro 'ty' overwrites builtin command. Use ':def!' to overwrite.
I'm a macro
I'm a macro
-macro :: p -> IO [Char]
-macro :: p -> IO [Char]
+macro :: p -> IO String
+macro :: p -> IO String
macro 'test' is already defined. Use ':def!' to overwrite.
the following macros are defined:
test
diff --git a/testsuite/tests/hiefile/should_run/HieQueries.stdout b/testsuite/tests/hiefile/should_run/HieQueries.stdout
index 59bfb1d19d..98f0466815 100644
--- a/testsuite/tests/hiefile/should_run/HieQueries.stdout
+++ b/testsuite/tests/hiefile/should_run/HieQueries.stdout
@@ -19,7 +19,7 @@ At point (31,9), we found:
|
`- ┌
│ $dC at HieQueries.hs:31:1-13, of type: C a
- │ is an evidence variable bound by a type signature
+ │ is an evidence variable bound by a HsWrapper
│ with scope: LocalScope HieQueries.hs:31:1-13
│ bound at: HieQueries.hs:31:1-13
│ Defined at <no location info>
@@ -74,7 +74,7 @@ At point (37,9), we found:
|
+- ┌
| │ $dShow at HieQueries.hs:37:1-22, of type: Show x
- | │ is an evidence variable bound by a type signature
+ | │ is an evidence variable bound by a HsWrapper
| │ with scope: LocalScope HieQueries.hs:37:1-22
| │ bound at: HieQueries.hs:37:1-22
| │ Defined at <no location info>
diff --git a/testsuite/tests/indexed-types/should_compile/PushedInAsGivens.stderr b/testsuite/tests/indexed-types/should_compile/PushedInAsGivens.stderr
index 5b6863c740..5ba9df0d1a 100644
--- a/testsuite/tests/indexed-types/should_compile/PushedInAsGivens.stderr
+++ b/testsuite/tests/indexed-types/should_compile/PushedInAsGivens.stderr
@@ -22,7 +22,8 @@ PushedInAsGivens.hs:10:31: error:
bar :: a -> (a, Int) (bound at PushedInAsGivens.hs:9:1)
PushedInAsGivens.hs:11:15: error:
- • Couldn't match type ‘F Int’ with ‘[a]’
+ • Couldn't match type: F Int
+ with: [a]
arising from a use of ‘foo’
• In the expression: foo y
In the expression: (y, foo y)
diff --git a/testsuite/tests/indexed-types/should_compile/Simple14.hs b/testsuite/tests/indexed-types/should_compile/Simple14.hs
index 0a47a649a5..dba26194f1 100644
--- a/testsuite/tests/indexed-types/should_compile/Simple14.hs
+++ b/testsuite/tests/indexed-types/should_compile/Simple14.hs
@@ -5,21 +5,23 @@ module Simple14 where
data EQ_ x y = EQ_
-- Nov 2014: actually eqE has an ambiguous type
+-- Apr 2020: now it doesn't again
eqE :: EQ_ x y -> (x~y => EQ_ z z) -> p
-eqE = error "eqE"
+eqE x y = error "eqE"
eqI :: EQ_ x x
eqI = error "eqI"
ntI :: (forall p. EQ_ x y -> p) -> EQ_ x y
-ntI = error "ntI"
+ntI x = error "ntI"
foo :: forall m n. EQ_ (Maybe m) (Maybe n)
-foo = ntI (`eqE` (eqI :: EQ_ m n))
+foo = ntI (\x -> x `eqE` (eqI :: EQ_ m n))
+
-- Alternative
-- foo = ntI (\eq -> eq `eqE` (eqI :: EQ_ m n))
-- eq :: EQ_ (Maybe m) (Maybe n)
-- Need (Maybe m ~ Maybe n) => EQ_ m n ~ EQ_ zeta zeta
-- which reduces to (m~n) => m ~ zeta
--- but then we are stuck \ No newline at end of file
+-- but then we are stuck
diff --git a/testsuite/tests/indexed-types/should_compile/Simple14.stderr b/testsuite/tests/indexed-types/should_compile/Simple14.stderr
index 4c61d95cc9..6159b08898 100644
--- a/testsuite/tests/indexed-types/should_compile/Simple14.stderr
+++ b/testsuite/tests/indexed-types/should_compile/Simple14.stderr
@@ -1,17 +1,21 @@
-Simple14.hs:8:8: error:
- • Couldn't match type ‘z0’ with ‘z’
+Simple14.hs:19:27: error:
+ • Couldn't match type ‘z0’ with ‘n’
+ Expected: EQ_ z0 z0
+ Actual: EQ_ m n
‘z0’ is untouchable
- inside the constraints: x ~ y
+ inside the constraints: Maybe m ~ Maybe n
bound by a type expected by the context:
- (x ~ y) => EQ_ z0 z0
- at Simple14.hs:8:8-39
- ‘z’ is a rigid type variable bound by
+ (Maybe m ~ Maybe n) => EQ_ z0 z0
+ at Simple14.hs:19:26-41
+ ‘n’ is a rigid type variable bound by
the type signature for:
- eqE :: forall x y z p. EQ_ x y -> ((x ~ y) => EQ_ z z) -> p
- at Simple14.hs:8:8-39
- Expected type: EQ_ z0 z0
- Actual type: EQ_ z z
- • In the ambiguity check for ‘eqE’
- To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
- In the type signature: eqE :: EQ_ x y -> (x ~ y => EQ_ z z) -> p
+ foo :: forall m n. EQ_ (Maybe m) (Maybe n)
+ at Simple14.hs:18:1-42
+ • In the second argument of ‘eqE’, namely ‘(eqI :: EQ_ m n)’
+ In the expression: x `eqE` (eqI :: EQ_ m n)
+ In the first argument of ‘ntI’, namely
+ ‘(\ x -> x `eqE` (eqI :: EQ_ m n))’
+ • Relevant bindings include
+ x :: EQ_ (Maybe m) (Maybe n) (bound at Simple14.hs:19:13)
+ foo :: EQ_ (Maybe m) (Maybe n) (bound at Simple14.hs:19:1)
diff --git a/testsuite/tests/indexed-types/should_compile/T10806.stderr b/testsuite/tests/indexed-types/should_compile/T10806.stderr
index c78a10bd7b..96284e6c75 100644
--- a/testsuite/tests/indexed-types/should_compile/T10806.stderr
+++ b/testsuite/tests/indexed-types/should_compile/T10806.stderr
@@ -1,7 +1,7 @@
T10806.hs:11:32: error:
- • Couldn't match expected type ‘Char -> Bool’
- with actual type ‘IO ()’
+ • Couldn't match expected type: Char -> Bool
+ with actual type: IO ()
• The function ‘print’ is applied to two value arguments,
but its type ‘Char -> IO ()’ has only one
In the expression: print 'x' 'y'
diff --git a/testsuite/tests/indexed-types/should_compile/T12538.stderr b/testsuite/tests/indexed-types/should_compile/T12538.stderr
index ca106246e7..7a26b9c483 100644
--- a/testsuite/tests/indexed-types/should_compile/T12538.stderr
+++ b/testsuite/tests/indexed-types/should_compile/T12538.stderr
@@ -3,10 +3,11 @@ T12538.hs:37:8: error:
• Could not deduce: a' ~ Tagged Int a
from the context: (TagImpl a a', b ~ DF a')
bound by the instance declaration at T12538.hs:36:10-46
+ Expected: a -> b
+ Actual: a -> DF (Tagged Int a)
‘a'’ is a rigid type variable bound by
- the instance declaration at T12538.hs:36:10-46
- Expected type: a -> b
- Actual type: a -> DF (Tagged Int a)
+ the instance declaration
+ at T12538.hs:36:10-46
• In the expression: DF . tag
In an equation for ‘df’: df = DF . tag
In the instance declaration for ‘ToDF a b’
diff --git a/testsuite/tests/indexed-types/should_compile/T17923.hs b/testsuite/tests/indexed-types/should_compile/T17923.hs
index 8c34024864..a6840ff616 100644
--- a/testsuite/tests/indexed-types/should_compile/T17923.hs
+++ b/testsuite/tests/indexed-types/should_compile/T17923.hs
@@ -38,7 +38,7 @@ data ShowCharSym0 :: E ~> E ~> E
sShow_tuple :: SLambda Sym4
sShow_tuple
- = applySing (singFun2 @Sym3 und)
+ = applySing (singFun2 @Sym3 (\x -> und x))
(und (singFun2 @Sym3
- (und (applySing (singFun2 @Sym3 und)
- (applySing (singFun2 @ShowCharSym0 und) und)))))
+ (\y -> und (applySing (singFun2 @Sym3 (\x -> und x))
+ (applySing (singFun2 @ShowCharSym0 (\x -> und x)) und)) y)))
diff --git a/testsuite/tests/indexed-types/should_fail/ExtraTcsUntch.stderr b/testsuite/tests/indexed-types/should_fail/ExtraTcsUntch.stderr
index 5bc6aca64c..63f24fa268 100644
--- a/testsuite/tests/indexed-types/should_fail/ExtraTcsUntch.stderr
+++ b/testsuite/tests/indexed-types/should_fail/ExtraTcsUntch.stderr
@@ -1,6 +1,7 @@
ExtraTcsUntch.hs:23:18: error:
- • Couldn't match expected type ‘F Int’ with actual type ‘[p]’
+ • Couldn't match expected type: F Int
+ with actual type: [p]
• In the first argument of ‘h’, namely ‘[x]’
In the expression: h [x]
In an equation for ‘g1’: g1 _ = h [x]
@@ -9,7 +10,8 @@ ExtraTcsUntch.hs:23:18: error:
f :: p -> ((), ((), ())) (bound at ExtraTcsUntch.hs:21:1)
ExtraTcsUntch.hs:25:38: error:
- • Couldn't match expected type ‘F Int’ with actual type ‘[[a0]]’
+ • Couldn't match expected type: F Int
+ with actual type: [[a0]]
The type variable ‘a0’ is ambiguous
• In the first argument of ‘h’, namely ‘[[undefined]]’
In the expression: h [[undefined]]
diff --git a/testsuite/tests/indexed-types/should_fail/NoMatchErr.stderr b/testsuite/tests/indexed-types/should_fail/NoMatchErr.stderr
index 9eab513529..1f155bbea0 100644
--- a/testsuite/tests/indexed-types/should_fail/NoMatchErr.stderr
+++ b/testsuite/tests/indexed-types/should_fail/NoMatchErr.stderr
@@ -1,8 +1,9 @@
NoMatchErr.hs:19:7: error:
- • Couldn't match type ‘Memo d0’ with ‘Memo d’
- Expected type: Memo d a -> Memo d a
- Actual type: Memo d0 a -> Memo d0 a
+ • Couldn't match type: Memo d0
+ with: Memo d
+ Expected: Memo d a -> Memo d a
+ Actual: Memo d0 a -> Memo d0 a
NB: ‘Memo’ is a non-injective type family
The type variable ‘d0’ is ambiguous
• In the ambiguity check for ‘f’
diff --git a/testsuite/tests/indexed-types/should_fail/Overlap6.stderr b/testsuite/tests/indexed-types/should_fail/Overlap6.stderr
index c0b1d64889..b1aaea25b1 100644
--- a/testsuite/tests/indexed-types/should_fail/Overlap6.stderr
+++ b/testsuite/tests/indexed-types/should_fail/Overlap6.stderr
@@ -1,12 +1,12 @@
Overlap6.hs:15:7: error:
• Couldn't match type ‘x’ with ‘And x 'True’
+ Expected: Proxy (And x 'True)
+ Actual: Proxy x
‘x’ is a rigid type variable bound by
the type signature for:
g :: forall (x :: Bool). Proxy x -> Proxy (And x 'True)
at Overlap6.hs:14:1-34
- Expected type: Proxy (And x 'True)
- Actual type: Proxy x
• In the expression: x
In an equation for ‘g’: g x = x
• Relevant bindings include
diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail16.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail16.stderr
index fa635378a4..df131da8a3 100644
--- a/testsuite/tests/indexed-types/should_fail/SimpleFail16.stderr
+++ b/testsuite/tests/indexed-types/should_fail/SimpleFail16.stderr
@@ -1,9 +1,10 @@
SimpleFail16.hs:10:12: error:
- Couldn't match expected type ‘p0 a0’ with actual type ‘F ()’
- The type variables ‘p0’, ‘a0’ are ambiguous
- In the first argument of ‘foo’, namely ‘(undefined :: F ())’
- In the expression: foo (undefined :: F ())
- In an equation for ‘bar’: bar = foo (undefined :: F ())
- Relevant bindings include
- bar :: p0 a0 (bound at SimpleFail16.hs:10:1)
+ • Couldn't match expected type: p0 a0
+ with actual type: F ()
+ The type variables ‘p0’, ‘a0’ are ambiguous
+ • In the first argument of ‘foo’, namely ‘(undefined :: F ())’
+ In the expression: foo (undefined :: F ())
+ In an equation for ‘bar’: bar = foo (undefined :: F ())
+ • Relevant bindings include
+ bar :: p0 a0 (bound at SimpleFail16.hs:10:1)
diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail5a.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail5a.stderr
index 69a7170504..c437d95501 100644
--- a/testsuite/tests/indexed-types/should_fail/SimpleFail5a.stderr
+++ b/testsuite/tests/indexed-types/should_fail/SimpleFail5a.stderr
@@ -1,12 +1,12 @@
SimpleFail5a.hs:31:11: error:
• Couldn't match type ‘a’ with ‘Int’
+ Expected: S3 a
+ Actual: S3 Int
‘a’ is a rigid type variable bound by
the type signature for:
bar3wrong :: forall a. S3 a -> a
at SimpleFail5a.hs:30:1-22
- Expected type: S3 a
- Actual type: S3 Int
• In the pattern: D3Int
In an equation for ‘bar3wrong’: bar3wrong D3Int = 1
• Relevant bindings include
diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail5b.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail5b.stderr
index 0dfd570cc0..7398ef0fe8 100644
--- a/testsuite/tests/indexed-types/should_fail/SimpleFail5b.stderr
+++ b/testsuite/tests/indexed-types/should_fail/SimpleFail5b.stderr
@@ -1,7 +1,7 @@
-SimpleFail5b.hs:31:12:
- Couldn't match type ‘Char’ with ‘Int’
- Expected type: S3 Int
- Actual type: S3 Char
- In the pattern: D3Char
- In an equation for ‘bar3wrong'’: bar3wrong' D3Char = 'a'
+SimpleFail5b.hs:31:12: error:
+ • Couldn't match type ‘Char’ with ‘Int’
+ Expected: S3 Int
+ Actual: S3 Char
+ • In the pattern: D3Char
+ In an equation for ‘bar3wrong'’: bar3wrong' D3Char = 'a'
diff --git a/testsuite/tests/indexed-types/should_fail/T13674.stderr b/testsuite/tests/indexed-types/should_fail/T13674.stderr
index 53a7cb705c..55798b1189 100644
--- a/testsuite/tests/indexed-types/should_fail/T13674.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T13674.stderr
@@ -1,8 +1,12 @@
T13674.hs:56:21: error:
- • Occurs check: cannot construct the infinite type: m ~ Lcm m m
- Expected type: GF m
- Actual type: GF (Lcm m m)
+ • Couldn't match type ‘m’ with ‘Lcm m m’
+ Expected: GF m
+ Actual: GF (Lcm m m)
+ ‘m’ is a rigid type variable bound by
+ the type signature for:
+ bar :: forall (m :: Nat). KnownNat m => GF m -> GF m -> GF m
+ at T13674.hs:55:1-44
• In the first argument of ‘(-)’, namely ‘foo x y’
In the expression:
foo x y - foo y x \\ lcmNat @m @m \\ Sub @() (lcmIsIdempotent @m)
@@ -15,9 +19,13 @@ T13674.hs:56:21: error:
bar :: GF m -> GF m -> GF m (bound at T13674.hs:56:1)
T13674.hs:56:31: error:
- • Occurs check: cannot construct the infinite type: m ~ Lcm m m
- Expected type: GF m
- Actual type: GF (Lcm m m)
+ • Couldn't match type ‘m’ with ‘Lcm m m’
+ Expected: GF m
+ Actual: GF (Lcm m m)
+ ‘m’ is a rigid type variable bound by
+ the type signature for:
+ bar :: forall (m :: Nat). KnownNat m => GF m -> GF m -> GF m
+ at T13674.hs:55:1-44
• In the first argument of ‘(\\)’, namely ‘foo y x’
In the first argument of ‘(\\)’, namely ‘foo y x \\ lcmNat @m @m’
In the second argument of ‘(-)’, namely
diff --git a/testsuite/tests/indexed-types/should_fail/T13784.stderr b/testsuite/tests/indexed-types/should_fail/T13784.stderr
index 63edf0482f..11b1a188f2 100644
--- a/testsuite/tests/indexed-types/should_fail/T13784.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T13784.stderr
@@ -1,11 +1,11 @@
T13784.hs:29:28: error:
• Couldn't match type ‘as’ with ‘a : Divide a as’
+ Expected: Product (Divide a (a : as))
+ Actual: Product as1
‘as’ is a rigid type variable bound by
the instance declaration
at T13784.hs:25:10-30
- Expected type: Product (Divide a (a : as))
- Actual type: Product as1
• In the expression: as
In the expression: (a, as)
In an equation for ‘divide’: divide (a :* as) = (a, as)
@@ -14,10 +14,10 @@ T13784.hs:29:28: error:
(bound at T13784.hs:29:5)
T13784.hs:33:24: error:
- • Couldn't match type ‘Product (a : as0)’
- with ‘(b, Product (Divide b (a : as)))’
- Expected type: (b, Product (Divide b (a : as)))
- Actual type: Product (a1 : as0)
+ • Couldn't match type: Product (a : as0)
+ with: (b, Product (Divide b (a : as)))
+ Expected: (b, Product (Divide b (a : as)))
+ Actual: Product (a1 : as0)
• In the expression: a :* divide as
In an equation for ‘divide’: divide (a :* as) = a :* divide as
In the instance declaration for ‘Divideable b (a : as)’
@@ -26,10 +26,10 @@ T13784.hs:33:24: error:
(bound at T13784.hs:33:5)
T13784.hs:33:29: error:
- • Couldn't match type ‘(a0, Product (Divide a0 as))’
- with ‘Product as0’
- Expected type: Product as0
- Actual type: (a0, Product (Divide a0 as1))
+ • Couldn't match type: (a0, Product (Divide a0 as))
+ with: Product as0
+ Expected: Product as0
+ Actual: (a0, Product (Divide a0 as1))
• In the second argument of ‘(:*)’, namely ‘divide as’
In the expression: a :* divide as
In an equation for ‘divide’: divide (a :* as) = a :* divide as
diff --git a/testsuite/tests/indexed-types/should_fail/T14246.stderr b/testsuite/tests/indexed-types/should_fail/T14246.stderr
index fcc2605527..d6bfde7b5b 100644
--- a/testsuite/tests/indexed-types/should_fail/T14246.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T14246.stderr
@@ -5,20 +5,24 @@ T14246.hs:18:5: error:
In the type family declaration for ‘KLN’
T14246.hs:22:27: error:
- • Expected kind ‘Vect (KLN f) L’,
+ • Couldn't match kind: 'S (KLN (f t))
+ with: KLN f
+ Expected kind ‘Vect (KLN f) L’,
but ‘Cons (Label (t :: v)) l’ has kind ‘Vect ('S (KLN (f t))) (*)’
• In the second argument of ‘Reveal’, namely
‘(Cons (Label (t :: v)) l)’
In the type family declaration for ‘Reveal’
T14246.hs:22:67: error:
- • Expected kind ‘Vect (KLN (f t)) L’,
+ • Couldn't match kind ‘*’ with ‘L’
+ Expected kind ‘Vect (KLN (f t)) L’,
but ‘l’ has kind ‘Vect (KLN (f t)) (*)’
• In the second argument of ‘Reveal’, namely ‘l’
In the type ‘Reveal (f t) l’
In the type family declaration for ‘Reveal’
T14246.hs:23:24: error:
- • Expected kind ‘Vect (KLN a) L’, but ‘Nil’ has kind ‘Vect 'Z L’
+ • Couldn't match kind ‘'Z’ with ‘KLN a’
+ Expected kind ‘Vect (KLN a) L’, but ‘Nil’ has kind ‘Vect 'Z L’
• In the second argument of ‘Reveal’, namely ‘Nil’
In the type family declaration for ‘Reveal’
diff --git a/testsuite/tests/indexed-types/should_fail/T14369.stderr b/testsuite/tests/indexed-types/should_fail/T14369.stderr
index accd2d9b01..d31a77b2fa 100644
--- a/testsuite/tests/indexed-types/should_fail/T14369.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T14369.stderr
@@ -1,8 +1,9 @@
T14369.hs:29:5: error:
- • Couldn't match type ‘Demote a’ with ‘Demote a1’
- Expected type: Sing x -> Maybe (Demote a1)
- Actual type: Sing x -> Demote (Maybe a)
+ • Couldn't match type: Demote a
+ with: Demote a1
+ Expected: Sing x -> Maybe (Demote a1)
+ Actual: Sing x -> Demote (Maybe a)
• In the expression: fromSing
In an equation for ‘f’: f = fromSing
• Relevant bindings include
diff --git a/testsuite/tests/indexed-types/should_fail/T14904.stderr b/testsuite/tests/indexed-types/should_fail/T14904.stderr
index dd5506c855..8a7142d350 100644
--- a/testsuite/tests/indexed-types/should_fail/T14904.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T14904.stderr
@@ -1,6 +1,8 @@
T14904.hs:8:8: error:
• Expected kind ‘forall (a :: k1). g a’, but ‘f’ has kind ‘k0’
+ Cannot instantiate unification variable ‘k0’
+ with a kind involving polytypes: forall (a :: k1). g a
• In the first argument of ‘F’, namely
‘((f :: forall a. g a) :: forall a. g a)’
In the type family declaration for ‘F’
diff --git a/testsuite/tests/indexed-types/should_fail/T15870.stderr b/testsuite/tests/indexed-types/should_fail/T15870.stderr
index 4acacbab50..2cba04fd97 100644
--- a/testsuite/tests/indexed-types/should_fail/T15870.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T15870.stderr
@@ -1,6 +1,7 @@
T15870.hs:32:34: error:
- • Expected kind ‘Optic a’, but ‘g2’ has kind ‘Optic b’
+ • Couldn't match kind ‘k’ with ‘*’
+ Expected kind ‘Optic a’, but ‘g2’ has kind ‘Optic b’
• In the second argument of ‘Get’, namely ‘g2’
In the type ‘Get a g2’
In the type instance declaration for ‘Get’
diff --git a/testsuite/tests/indexed-types/should_fail/T1897b.stderr b/testsuite/tests/indexed-types/should_fail/T1897b.stderr
index a2055816ae..9048b59770 100644
--- a/testsuite/tests/indexed-types/should_fail/T1897b.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T1897b.stderr
@@ -1,8 +1,9 @@
T1897b.hs:16:1: error:
- • Couldn't match type ‘Depend a’ with ‘Depend a0’
- Expected type: t (Depend a) -> Bool
- Actual type: t (Depend a0) -> Bool
+ • Couldn't match type: Depend a0
+ with: Depend a
+ Expected: t (Depend a) -> Bool
+ Actual: t (Depend a0) -> Bool
NB: ‘Depend’ is a non-injective type family
The type variable ‘a0’ is ambiguous
• In the ambiguity check for the inferred type for ‘isValid’
diff --git a/testsuite/tests/indexed-types/should_fail/T1900.stderr b/testsuite/tests/indexed-types/should_fail/T1900.stderr
index 4b144f85f6..a9fb9051e8 100644
--- a/testsuite/tests/indexed-types/should_fail/T1900.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T1900.stderr
@@ -1,8 +1,9 @@
T1900.hs:7:3: error:
- • Couldn't match type ‘Depend s0’ with ‘Depend s’
- Expected type: Depend s -> Depend s
- Actual type: Depend s0 -> Depend s0
+ • Couldn't match type: Depend s0
+ with: Depend s
+ Expected: Depend s -> Depend s
+ Actual: Depend s0 -> Depend s0
NB: ‘Depend’ is a non-injective type family
The type variable ‘s0’ is ambiguous
• In the ambiguity check for ‘trans’
diff --git a/testsuite/tests/indexed-types/should_fail/T2239.hs b/testsuite/tests/indexed-types/should_fail/T2239.hs
index 0d675b175c..c64021c070 100644
--- a/testsuite/tests/indexed-types/should_fail/T2239.hs
+++ b/testsuite/tests/indexed-types/should_fail/T2239.hs
@@ -45,11 +45,11 @@ simpleTF = id :: (forall b. b~Bool => b->b)
-- Actually these two do not involve impredicative instantiation,
-- so they now succeed
-complexFD = id :: (forall b. MyEq b Bool => b->b)
- -> (forall c. MyEq c Bool => c->c)
+complexFD = (\x -> x) :: (forall b. MyEq b Bool => b->b)
+ -> (forall c. MyEq c Bool => c->c)
-complexTF = id :: (forall b. b~Bool => b->b)
- -> (forall c. c~Bool => c->c)
+complexTF = (\x -> x) :: (forall b. b~Bool => b->b)
+ -> (forall c. c~Bool => c->c)
{- For example, here is how the subsumption check works for complexTF
when type-checking the expression
@@ -65,4 +65,4 @@ complexTF = id :: (forall b. b~Bool => b->b)
b~Bool |-3 alpha[3] ~ b->b, (forall c. c~Bool => c->c) <= a
And this is perfectly soluble. alpha is touchable; and c is instantiated.
--} \ No newline at end of file
+-}
diff --git a/testsuite/tests/indexed-types/should_fail/T2544.stderr b/testsuite/tests/indexed-types/should_fail/T2544.stderr
index 6b1a6bd075..40409c10cc 100644
--- a/testsuite/tests/indexed-types/should_fail/T2544.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T2544.stderr
@@ -1,8 +1,9 @@
T2544.hs:19:18: error:
- • Couldn't match type ‘IxMap i0’ with ‘IxMap l’
- Expected type: IxMap l [Int]
- Actual type: IxMap i0 [Int]
+ • Couldn't match type: IxMap i0
+ with: IxMap l
+ Expected: IxMap l [Int]
+ Actual: IxMap i0 [Int]
NB: ‘IxMap’ is a non-injective type family
The type variable ‘i0’ is ambiguous
• In the first argument of ‘BiApp’, namely ‘empty’
diff --git a/testsuite/tests/indexed-types/should_fail/T2627b.stderr b/testsuite/tests/indexed-types/should_fail/T2627b.stderr
index 63f11b97f1..b69883ab88 100644
--- a/testsuite/tests/indexed-types/should_fail/T2627b.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T2627b.stderr
@@ -1,8 +1,18 @@
T2627b.hs:20:24: error:
- • Occurs check: cannot construct the infinite type:
- b0 ~ Dual (Dual b0)
+ • Could not deduce: Dual (Dual b0) ~ b0
arising from a use of ‘conn’
+ from the context: (Dual a ~ b, Dual b ~ a)
+ bound by the type signature for:
+ conn :: forall a b.
+ (Dual a ~ b, Dual b ~ a) =>
+ Comm a -> Comm b -> (Int, Int)
+ at T2627b.hs:19:1-66
+ or from: a ~ R c d
+ bound by a pattern with constructor:
+ Rd :: forall c d. (c -> Comm d) -> Comm (R c d),
+ in an equation for ‘conn’
+ at T2627b.hs:20:7-10
The type variable ‘b0’ is ambiguous
• In the expression: conn undefined undefined
In an equation for ‘conn’:
diff --git a/testsuite/tests/indexed-types/should_fail/T2664.stderr b/testsuite/tests/indexed-types/should_fail/T2664.stderr
index f52703865f..64fa851258 100644
--- a/testsuite/tests/indexed-types/should_fail/T2664.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T2664.stderr
@@ -7,8 +7,8 @@ T2664.hs:31:9: error:
((a :*: b) ~ Dual c, c ~ Dual (a :*: b)) =>
IO (PChan (a :*: b), PChan c)
at T2664.hs:23:5-12
- Expected type: IO (PChan (a :*: b), PChan c)
- Actual type: IO (PChan (a :*: b), PChan (Dual b :+: Dual a))
+ Expected: IO (PChan (a :*: b), PChan c)
+ Actual: IO (PChan (a :*: b), PChan (Dual b :+: Dual a))
NB: ‘Dual’ is a non-injective type family
• In a stmt of a 'do' block:
return
diff --git a/testsuite/tests/indexed-types/should_fail/T2693.stderr b/testsuite/tests/indexed-types/should_fail/T2693.stderr
index f9485d1d42..57d4303849 100644
--- a/testsuite/tests/indexed-types/should_fail/T2693.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T2693.stderr
@@ -1,6 +1,7 @@
T2693.hs:12:15: error:
- • Couldn't match expected type ‘(a8, b1)’ with actual type ‘TFn a6’
+ • Couldn't match expected type: (a8, b1)
+ with actual type: TFn a6
The type variables ‘a6’, ‘a8’, ‘b1’ are ambiguous
• In the first argument of ‘fst’, namely ‘x’
In the first argument of ‘(+)’, namely ‘fst x’
@@ -8,7 +9,8 @@ T2693.hs:12:15: error:
• Relevant bindings include n :: a8 (bound at T2693.hs:12:7)
T2693.hs:12:23: error:
- • Couldn't match expected type ‘(a8, b2)’ with actual type ‘TFn a7’
+ • Couldn't match expected type: (a8, b2)
+ with actual type: TFn a7
The type variables ‘a7’, ‘a8’, ‘b2’ are ambiguous
• In the first argument of ‘fst’, namely ‘x’
In the second argument of ‘(+)’, namely ‘fst x’
@@ -16,7 +18,8 @@ T2693.hs:12:23: error:
• Relevant bindings include n :: a8 (bound at T2693.hs:12:7)
T2693.hs:19:15: error:
- • Couldn't match expected type ‘(a5, b0)’ with actual type ‘TFn a2’
+ • Couldn't match expected type: (a5, b0)
+ with actual type: TFn a2
The type variables ‘a2’, ‘a5’, ‘b0’ are ambiguous
• In the first argument of ‘fst’, namely ‘x’
In the first argument of ‘(+)’, namely ‘fst x’
@@ -24,7 +27,8 @@ T2693.hs:19:15: error:
• Relevant bindings include n :: a5 (bound at T2693.hs:19:7)
T2693.hs:19:23: error:
- • Couldn't match expected type ‘(a4, a5)’ with actual type ‘TFn a3’
+ • Couldn't match expected type: (a4, a5)
+ with actual type: TFn a3
The type variables ‘a3’, ‘a4’, ‘a5’ are ambiguous
• In the first argument of ‘snd’, namely ‘x’
In the second argument of ‘(+)’, namely ‘snd x’
@@ -32,9 +36,10 @@ T2693.hs:19:23: error:
• Relevant bindings include n :: a5 (bound at T2693.hs:19:7)
T2693.hs:29:20: error:
- • Couldn't match type ‘TFn a0’ with ‘PVR a1’
- Expected type: () -> Maybe (PVR a1)
- Actual type: () -> Maybe (TFn a0)
+ • Couldn't match type: TFn a0
+ with: PVR a1
+ Expected: () -> Maybe (PVR a1)
+ Actual: () -> Maybe (TFn a0)
The type variables ‘a0’, ‘a1’ are ambiguous
• In the first argument of ‘mapM’, namely ‘g’
In a stmt of a 'do' block: pvs <- mapM g undefined
diff --git a/testsuite/tests/indexed-types/should_fail/T3330a.stderr b/testsuite/tests/indexed-types/should_fail/T3330a.stderr
index dfc2e4223d..1fba198ab7 100644
--- a/testsuite/tests/indexed-types/should_fail/T3330a.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T3330a.stderr
@@ -2,14 +2,13 @@
T3330a.hs:19:34: error:
• Couldn't match type ‘ix’
with ‘r ix1 -> Writer [AnyF s] (r'0 ix1)’
+ Expected: (s0 ix0 -> ix1) -> r ix1 -> Writer [AnyF s] (r'0 ix1)
+ Actual: s ix
‘ix’ is a rigid type variable bound by
the type signature for:
children :: forall (s :: * -> *) ix (r :: * -> *).
s ix -> PF s r ix -> [AnyF s]
at T3330a.hs:18:1-43
- Expected type: (s0 ix0 -> ix1)
- -> r ix1 -> Writer [AnyF s] (r'0 ix1)
- Actual type: s ix
• In the first argument of ‘hmapM’, namely ‘p’
In the first argument of ‘execWriter’, namely ‘(hmapM p collect x)’
In the expression: execWriter (hmapM p collect x)
@@ -21,13 +20,13 @@ T3330a.hs:19:34: error:
T3330a.hs:19:44: error:
• Couldn't match type ‘ix’
with ‘r0 ix0 -> Writer [AnyF s0] (r0 ix0)’
+ Expected: PF s r (r0 ix0 -> Writer [AnyF s0] (r0 ix0))
+ Actual: PF s r ix
‘ix’ is a rigid type variable bound by
the type signature for:
children :: forall (s :: * -> *) ix (r :: * -> *).
s ix -> PF s r ix -> [AnyF s]
at T3330a.hs:18:1-43
- Expected type: PF s r (r0 ix0 -> Writer [AnyF s0] (r0 ix0))
- Actual type: PF s r ix
• In the third argument of ‘hmapM’, namely ‘x’
In the first argument of ‘execWriter’, namely ‘(hmapM p collect x)’
In the expression: execWriter (hmapM p collect x)
diff --git a/testsuite/tests/indexed-types/should_fail/T3330c.stderr b/testsuite/tests/indexed-types/should_fail/T3330c.stderr
index 943dbb148b..9222e6fffe 100644
--- a/testsuite/tests/indexed-types/should_fail/T3330c.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T3330c.stderr
@@ -4,8 +4,8 @@ T3330c.hs:25:43: error:
When matching types
f1 :: * -> *
f1 x :: *
- Expected type: Der ((->) x) (f1 x)
- Actual type: R f1
+ Expected: Der ((->) x) (f1 x)
+ Actual: R f1
• In the first argument of ‘plug’, namely ‘rf’
In the first argument of ‘Inl’, namely ‘(plug rf df x)’
In the expression: Inl (plug rf df x)
diff --git a/testsuite/tests/indexed-types/should_fail/T4093a.stderr b/testsuite/tests/indexed-types/should_fail/T4093a.stderr
index 826fe1934a..81d9c404ed 100644
--- a/testsuite/tests/indexed-types/should_fail/T4093a.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T4093a.stderr
@@ -5,12 +5,12 @@ T4093a.hs:8:8: error:
bound by the type signature for:
hang :: forall e. (Foo e ~ Maybe e) => Foo e
at T4093a.hs:7:1-34
+ Expected: Foo e
+ Actual: Maybe ()
‘e’ is a rigid type variable bound by
the type signature for:
hang :: forall e. (Foo e ~ Maybe e) => Foo e
at T4093a.hs:7:1-34
- Expected type: Foo e
- Actual type: Maybe ()
• In the expression: Just ()
In an equation for ‘hang’: hang = Just ()
• Relevant bindings include hang :: Foo e (bound at T4093a.hs:8:1)
diff --git a/testsuite/tests/indexed-types/should_fail/T4093b.stderr b/testsuite/tests/indexed-types/should_fail/T4093b.stderr
index 195b113ede..367c904e4f 100644
--- a/testsuite/tests/indexed-types/should_fail/T4093b.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T4093b.stderr
@@ -9,6 +9,8 @@ T4093b.hs:31:13: error:
EitherCO x (A C C n) (A C O n) ~ A C x n) =>
Block n e x -> A e x n
at T4093b.hs:(19,1)-(22,26)
+ Expected: EitherCO e (A C O n) (A O O n)
+ Actual: (MaybeC C (n C O), MaybeC O (n O C))
‘e’ is a rigid type variable bound by
the type signature for:
blockToNodeList :: forall (n :: * -> * -> *) e x.
@@ -16,8 +18,6 @@ T4093b.hs:31:13: error:
EitherCO x (A C C n) (A C O n) ~ A C x n) =>
Block n e x -> A e x n
at T4093b.hs:(19,1)-(22,26)
- Expected type: EitherCO e (A C O n) (A O O n)
- Actual type: (MaybeC C (n C O), MaybeC O (n O C))
• In the expression: (JustC n, NothingC)
In an equation for ‘f’: f n _ = (JustC n, NothingC)
In an equation for ‘blockToNodeList’:
diff --git a/testsuite/tests/indexed-types/should_fail/T4099.stderr b/testsuite/tests/indexed-types/should_fail/T4099.stderr
index acc2ed29ae..5ed4d36640 100644
--- a/testsuite/tests/indexed-types/should_fail/T4099.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T4099.stderr
@@ -1,6 +1,7 @@
T4099.hs:11:30: error:
- • Couldn't match expected type ‘T a0’ with actual type ‘T b’
+ • Couldn't match expected type: T a0
+ with actual type: T b
NB: ‘T’ is a non-injective type family
The type variable ‘a0’ is ambiguous
• In the second argument of ‘foo’, namely ‘x’
@@ -12,7 +13,8 @@ T4099.hs:11:30: error:
bar1 :: b -> T b -> Int (bound at T4099.hs:11:1)
T4099.hs:14:30: error:
- • Couldn't match expected type ‘T a1’ with actual type ‘Maybe b’
+ • Couldn't match expected type: T a1
+ with actual type: Maybe b
The type variable ‘a1’ is ambiguous
• In the second argument of ‘foo’, namely ‘x’
In the expression: foo (error "urk") x
diff --git a/testsuite/tests/indexed-types/should_fail/T4174.stderr b/testsuite/tests/indexed-types/should_fail/T4174.stderr
index ccc88ced1e..ae962edf36 100644
--- a/testsuite/tests/indexed-types/should_fail/T4174.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T4174.stderr
@@ -1,14 +1,14 @@
T4174.hs:44:12: error:
• Couldn't match type ‘b’ with ‘RtsSpinLock’
+ Expected: m (Field (Way (GHC6'8 minor) n t p) a b)
+ Actual: m (Field (WayOf m) SmStep RtsSpinLock)
‘b’ is a rigid type variable bound by
the type signature for:
testcase :: forall (m :: * -> *) minor n t p a b.
Monad m =>
m (Field (Way (GHC6'8 minor) n t p) a b)
at T4174.hs:43:1-63
- Expected type: m (Field (Way (GHC6'8 minor) n t p) a b)
- Actual type: m (Field (WayOf m) SmStep RtsSpinLock)
• In the expression: sync_large_objects
In an equation for ‘testcase’: testcase = sync_large_objects
• Relevant bindings include
diff --git a/testsuite/tests/indexed-types/should_fail/T4179.stderr b/testsuite/tests/indexed-types/should_fail/T4179.stderr
index 2f0d5e3644..4665a1a321 100644
--- a/testsuite/tests/indexed-types/should_fail/T4179.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T4179.stderr
@@ -1,12 +1,12 @@
T4179.hs:26:16: error:
- • Couldn't match type ‘A2 (x (A2 (FCon x) -> A3 (FCon x)))’
- with ‘A2 (FCon x)’
- Expected type: x (A2 (FCon x) -> A3 (FCon x))
- -> A2 (FCon x) -> A3 (FCon x)
- Actual type: x (A2 (FCon x) -> A3 (FCon x))
- -> A2 (x (A2 (FCon x) -> A3 (FCon x)))
- -> A3 (x (A2 (FCon x) -> A3 (FCon x)))
+ • Couldn't match type: A2 (x (A2 (FCon x) -> A3 (FCon x)))
+ with: A2 (FCon x)
+ Expected: x (A2 (FCon x) -> A3 (FCon x))
+ -> A2 (FCon x) -> A3 (FCon x)
+ Actual: x (A2 (FCon x) -> A3 (FCon x))
+ -> A2 (x (A2 (FCon x) -> A3 (FCon x)))
+ -> A3 (x (A2 (FCon x) -> A3 (FCon x)))
NB: ‘A2’ is a non-injective type family
• In the first argument of ‘foldDoC’, namely ‘op’
In the expression: foldDoC op
diff --git a/testsuite/tests/indexed-types/should_fail/T4272.stderr b/testsuite/tests/indexed-types/should_fail/T4272.stderr
index f0c5ab57f0..69df514c0f 100644
--- a/testsuite/tests/indexed-types/should_fail/T4272.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T4272.stderr
@@ -1,9 +1,12 @@
T4272.hs:15:26: error:
- • Occurs check: cannot construct the infinite type:
- a ~ TermFamily a a
- Expected type: TermFamily a (TermFamily a a)
- Actual type: TermFamily a a
+ • Couldn't match type ‘a’ with ‘TermFamily a a’
+ Expected: TermFamily a (TermFamily a a)
+ Actual: TermFamily a a
+ ‘a’ is a rigid type variable bound by
+ the type signature for:
+ laws :: forall a b. TermLike a => TermFamily a a -> b
+ at T4272.hs:14:1-53
• In the first argument of ‘terms’, namely
‘(undefined :: TermFamily a a)’
In the second argument of ‘prune’, namely
diff --git a/testsuite/tests/indexed-types/should_fail/T5439.stderr b/testsuite/tests/indexed-types/should_fail/T5439.stderr
index f712d47f0e..5dcce91edb 100644
--- a/testsuite/tests/indexed-types/should_fail/T5439.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T5439.stderr
@@ -1,8 +1,8 @@
T5439.hs:82:33: error:
- • Couldn't match expected type ‘Attempt (HElemOf rs)’
- with actual type ‘Attempt (HHead (HDrop n0 l0))
- -> Attempt (HElemOf l0)’
+ • Couldn't match expected type: Attempt (HElemOf rs)
+ with actual type: Attempt (HHead (HDrop n0 l0))
+ -> Attempt (HElemOf l0)
• In the second argument of ‘($)’, namely
‘inj $ Failure (e :: SomeException)’
In a stmt of a 'do' block:
@@ -21,8 +21,8 @@ T5439.hs:82:33: error:
(bound at T5439.hs:61:3)
T5439.hs:82:39: error:
- • Couldn't match expected type ‘Peano n0’
- with actual type ‘Attempt α0’
+ • Couldn't match expected type: Peano n0
+ with actual type: Attempt α0
• In the second argument of ‘($)’, namely
‘Failure (e :: SomeException)’
In the second argument of ‘($)’, namely
diff --git a/testsuite/tests/indexed-types/should_fail/T5934.stderr b/testsuite/tests/indexed-types/should_fail/T5934.stderr
index e7448a9722..48f8bacef5 100644
--- a/testsuite/tests/indexed-types/should_fail/T5934.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T5934.stderr
@@ -1,7 +1,8 @@
T5934.hs:12:7: error:
- • Cannot instantiate unification variable ‘a0’
+ • Couldn't match expected type ‘(forall s. GenST s) -> Int’
+ with actual type ‘a0’
+ Cannot instantiate unification variable ‘a0’
with a type involving polytypes: (forall s. GenST s) -> Int
- GHC doesn't yet support impredicative polymorphism
• In the expression: 0
In an equation for ‘run’: run = 0
diff --git a/testsuite/tests/indexed-types/should_fail/T6123.stderr b/testsuite/tests/indexed-types/should_fail/T6123.stderr
index 0ae1a5e3c1..eafd27c454 100644
--- a/testsuite/tests/indexed-types/should_fail/T6123.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T6123.stderr
@@ -1,7 +1,6 @@
T6123.hs:10:14: error:
- • Occurs check: cannot construct the infinite type: a0 ~ Id a0
- arising from a use of ‘cid’
+ • Couldn't match type ‘a0’ with ‘Id a0’ arising from a use of ‘cid’
The type variable ‘a0’ is ambiguous
• In the expression: cid undefined
In an equation for ‘cundefined’: cundefined = cid undefined
diff --git a/testsuite/tests/indexed-types/should_fail/T7010.stderr b/testsuite/tests/indexed-types/should_fail/T7010.stderr
index 0da40f7a69..12f443df7d 100644
--- a/testsuite/tests/indexed-types/should_fail/T7010.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T7010.stderr
@@ -1,8 +1,9 @@
T7010.hs:53:27: error:
- • Couldn't match type ‘IO Float’ with ‘Serial (IO Float)’
- Expected type: (Float, ValueTuple Vector)
- Actual type: (Float, ValueTuple Float)
+ • Couldn't match type: IO Float
+ with: Serial (IO Float)
+ Expected: (Float, ValueTuple Vector)
+ Actual: (Float, ValueTuple Float)
• In the first argument of ‘withArgs’, namely ‘plug’
In the expression: withArgs plug
In an equation for ‘filterFormants’: filterFormants = withArgs plug
diff --git a/testsuite/tests/indexed-types/should_fail/T7354.stderr b/testsuite/tests/indexed-types/should_fail/T7354.stderr
index b7b70b8f4e..1a20e096f1 100644
--- a/testsuite/tests/indexed-types/should_fail/T7354.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T7354.stderr
@@ -1,9 +1,8 @@
T7354.hs:28:11: error:
- • Occurs check: cannot construct the infinite type:
- p ~ Base t (Prim [p] p)
- Expected type: Prim [p] p -> Base t (Prim [p] p)
- Actual type: Prim [p] p -> p
+ • Couldn't match type ‘p’ with ‘Base t (Prim [p] p)’
+ Expected: Prim [p] p -> Base t (Prim [p] p)
+ Actual: Prim [p] p -> p
• In the first argument of ‘ana’, namely ‘alg’
In the expression: ana alg
In an equation for ‘foo’: foo = ana alg
diff --git a/testsuite/tests/indexed-types/should_fail/T7729.stderr b/testsuite/tests/indexed-types/should_fail/T7729.stderr
index b209c9c4b7..baf93df666 100644
--- a/testsuite/tests/indexed-types/should_fail/T7729.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T7729.stderr
@@ -1,8 +1,9 @@
T7729.hs:36:14: error:
- • Couldn't match type ‘BasePrimMonad m’ with ‘t0 (BasePrimMonad m)’
- Expected type: t0 (BasePrimMonad m) a -> Rand m a
- Actual type: BasePrimMonad (Rand m) a -> Rand m a
+ • Couldn't match type: BasePrimMonad m
+ with: t0 (BasePrimMonad m)
+ Expected: t0 (BasePrimMonad m) a -> Rand m a
+ Actual: BasePrimMonad (Rand m) a -> Rand m a
The type variable ‘t0’ is ambiguous
• In the first argument of ‘(.)’, namely ‘liftPrim’
In the expression: liftPrim . lift
diff --git a/testsuite/tests/indexed-types/should_fail/T7729a.stderr b/testsuite/tests/indexed-types/should_fail/T7729a.stderr
index e5a6289d96..60be4271ed 100644
--- a/testsuite/tests/indexed-types/should_fail/T7729a.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T7729a.stderr
@@ -1,8 +1,9 @@
T7729a.hs:36:26: error:
- • Couldn't match type ‘BasePrimMonad m’ with ‘t0 (BasePrimMonad m)’
- Expected type: BasePrimMonad (Rand m) a
- Actual type: t0 (BasePrimMonad m) a
+ • Couldn't match type: BasePrimMonad m
+ with: t0 (BasePrimMonad m)
+ Expected: BasePrimMonad (Rand m) a
+ Actual: t0 (BasePrimMonad m) a
The type variable ‘t0’ is ambiguous
• In the first argument of ‘liftPrim’, namely ‘(lift x)’
In the expression: liftPrim (lift x)
diff --git a/testsuite/tests/indexed-types/should_fail/T7967.stderr b/testsuite/tests/indexed-types/should_fail/T7967.stderr
index 63d2ba8328..8a7e419a5d 100644
--- a/testsuite/tests/indexed-types/should_fail/T7967.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T7967.stderr
@@ -1,7 +1,8 @@
T7967.hs:33:26: error:
- • Couldn't match type ‘h0 : t0’ with ‘'[]’
- Expected type: Index n l
- Actual type: Index 'Zero (h0 : t0)
+ • Couldn't match type: h0 : t0
+ with: '[]
+ Expected: Index n l
+ Actual: Index 'Zero (h0 : t0)
• In the expression: IZero
In an equation for ‘sNatToIndex’: sNatToIndex SZero HNil = IZero
diff --git a/testsuite/tests/indexed-types/should_fail/T8227.stderr b/testsuite/tests/indexed-types/should_fail/T8227.stderr
index f86ac68d95..99d1763163 100644
--- a/testsuite/tests/indexed-types/should_fail/T8227.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T8227.stderr
@@ -1,10 +1,10 @@
T8227.hs:17:27: error:
- • Couldn't match type ‘Scalar (V a)’
- with ‘Scalar (V a) -> Scalar (V a)’
- Expected type: Scalar (V a)
- Actual type: Scalar (V (Scalar (V a) -> Scalar (V a)))
- -> Scalar (V (Scalar (V a) -> Scalar (V a)))
+ • Couldn't match type: Scalar (V a)
+ with: Scalar (V a) -> Scalar (V a)
+ Expected: Scalar (V a)
+ Actual: Scalar (V (Scalar (V a) -> Scalar (V a)))
+ -> Scalar (V (Scalar (V a) -> Scalar (V a)))
• In the expression: arcLengthToParam eps eps
In an equation for ‘absoluteToParam’:
absoluteToParam eps seg = arcLengthToParam eps eps
diff --git a/testsuite/tests/indexed-types/should_fail/T8518.stderr b/testsuite/tests/indexed-types/should_fail/T8518.stderr
index b18202fec9..1f244f9ee2 100644
--- a/testsuite/tests/indexed-types/should_fail/T8518.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T8518.stderr
@@ -1,7 +1,7 @@
T8518.hs:14:18: error:
- • Couldn't match expected type ‘Z c -> B c -> Maybe (F c)’
- with actual type ‘F c’
+ • Couldn't match expected type: Z c -> B c -> Maybe (F c)
+ with actual type: F c
• The function ‘rpt’ is applied to four value arguments,
but its type ‘Int -> c -> F c’ has only two
In the expression: rpt (4 :: Int) c z b
@@ -18,9 +18,10 @@ T8518.hs:14:18: error:
callCont :: c -> Z c -> B c -> Maybe (F c) (bound at T8518.hs:14:1)
T8518.hs:16:9: error:
- • Couldn't match type ‘F t1’ with ‘Z t1 -> B t1 -> F t1’
- Expected type: t -> t1 -> F t1
- Actual type: t -> t1 -> Z t1 -> B t1 -> F t1
+ • Couldn't match type: F t1
+ with: Z t1 -> B t1 -> F t1
+ Expected: t -> t1 -> F t1
+ Actual: t -> t1 -> Z t1 -> B t1 -> F t1
• In an equation for ‘callCont’:
callCont c z b
= rpt (4 :: Int) c z b
diff --git a/testsuite/tests/indexed-types/should_fail/T9036.stderr b/testsuite/tests/indexed-types/should_fail/T9036.stderr
index 151dfb7f2d..0f783738ba 100644
--- a/testsuite/tests/indexed-types/should_fail/T9036.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T9036.stderr
@@ -1,9 +1,10 @@
T9036.hs:18:17: error:
- • Couldn't match type ‘Curried t0 [t0]’ with ‘Curried t [t]’
- Expected type: Maybe (GetMonad t after) -> Curried t [t]
- Actual type: Maybe (GetMonad t0 after) -> Curried t0 [t0]
- NB: ‘Curried’ is a non-injective type family
+ • Couldn't match type: GetMonad t0
+ with: GetMonad t
+ Expected: Maybe (GetMonad t after) -> Curried t [t]
+ Actual: Maybe (GetMonad t0 after) -> Curried t0 [t0]
+ NB: ‘GetMonad’ is a non-injective type family
The type variable ‘t0’ is ambiguous
• In the ambiguity check for ‘simpleLogger’
To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
diff --git a/testsuite/tests/indexed-types/should_fail/T9171.stderr b/testsuite/tests/indexed-types/should_fail/T9171.stderr
index 320a6add8d..6922be8ade 100644
--- a/testsuite/tests/indexed-types/should_fail/T9171.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T9171.stderr
@@ -1,9 +1,9 @@
T9171.hs:10:20: error:
- • Couldn't match expected type ‘GetParam
- @(*) @k2 @(*) Base (GetParam @(*) @(*) @k2 Base Int)’
- with actual type ‘GetParam
- @(*) @k20 @(*) Base (GetParam @(*) @(*) @k20 Base Int)’
+ • Couldn't match expected type: GetParam
+ @(*) @k2 @(*) Base (GetParam @(*) @(*) @k2 Base Int)
+ with actual type: GetParam
+ @(*) @k20 @(*) Base (GetParam @(*) @(*) @k20 Base Int)
NB: ‘GetParam’ is a non-injective type family
The type variable ‘k20’ is ambiguous
• In the ambiguity check for an expression type signature
diff --git a/testsuite/tests/indexed-types/should_fail/T9662.stderr b/testsuite/tests/indexed-types/should_fail/T9662.stderr
index 4f35d92b5e..04acdc653d 100644
--- a/testsuite/tests/indexed-types/should_fail/T9662.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T9662.stderr
@@ -1,17 +1,17 @@
T9662.hs:49:8: error:
- • Couldn't match type ‘k’ with ‘Int’
- ‘k’ is a rigid type variable bound by
+ • Couldn't match type ‘n’ with ‘Int’
+ Expected: Exp (((sh :. k) :. m) :. n)
+ -> Exp (((sh :. k) :. m) :. n)
+ Actual: Exp
+ (Tuple (((Atom a0 :. Atom Int) :. Atom Int) :. Atom Int))
+ -> Exp
+ (Plain (((Unlifted (Atom a0) :. Exp Int) :. Exp Int) :. Exp Int))
+ ‘n’ is a rigid type variable bound by
the type signature for:
test :: forall sh k m n.
Shape (((sh :. k) :. m) :. n) -> Shape (((sh :. m) :. n) :. k)
at T9662.hs:46:1-50
- Expected type: Exp (((sh :. m) :. n) :. k)
- -> Exp (((sh :. m) :. n) :. k)
- Actual type: Exp
- (Tuple (((Atom a0 :. Atom Int) :. Atom Int) :. Atom Int))
- -> Exp
- (Plain (((Unlifted (Atom a0) :. Exp Int) :. Exp Int) :. Exp Int))
• In the first argument of ‘backpermute’, namely
‘(modify
(atom :. atom :. atom :. atom)
diff --git a/testsuite/tests/module/mod180.stderr b/testsuite/tests/module/mod180.stderr
index f76cfc8480..1518a63e82 100644
--- a/testsuite/tests/module/mod180.stderr
+++ b/testsuite/tests/module/mod180.stderr
@@ -1,8 +1,8 @@
mod180.hs:8:5: error:
- Couldn't match expected type ‘T’
- with actual type ‘main:Mod180_A.T’
- NB: ‘main:Mod180_A.T’ is defined at Mod180_A.hs:3:1-10
- ‘T’ is defined at Mod180_B.hs:3:1-10
- In the expression: x
- In an equation for ‘z’: z = x
+ • Couldn't match expected type ‘T’
+ with actual type ‘main:Mod180_A.T’
+ NB: ‘T’ is defined at Mod180_B.hs:3:1-10
+ ‘main:Mod180_A.T’ is defined at Mod180_A.hs:3:1-10
+ • In the expression: x
+ In an equation for ‘z’: z = x
diff --git a/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail03.stderr b/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail03.stderr
index 4d55087e18..3ff4cb3678 100644
--- a/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail03.stderr
+++ b/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail03.stderr
@@ -1,8 +1,8 @@
overloadedlistsfail03.hs:3:28: error:
• Couldn't match type ‘[Char]’ with ‘Char’
- Expected type: GHC.Exts.Item [Char]
- Actual type: [Char]
+ Expected: GHC.Exts.Item [Char]
+ Actual: String
• In the expression: "b"
In the first argument of ‘length’, namely ‘(['a', "b"] :: [Char])’
In the first argument of ‘print’, namely
diff --git a/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail05.stderr b/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail05.stderr
index edd0c7fcef..6f0045a462 100644
--- a/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail05.stderr
+++ b/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail05.stderr
@@ -1,8 +1,8 @@
overloadedlistsfail05.hs:3:24: error:
• Couldn't match type ‘Char’ with ‘Int’
- Expected type: GHC.Exts.Item [Int]
- Actual type: Char
+ Expected: GHC.Exts.Item [Int]
+ Actual: Char
• In the expression: 'a'
In the first argument of ‘length’, namely
‘(['a' .. (10 :: Int)] :: [Int])’
diff --git a/testsuite/tests/parser/should_compile/T2245.stderr b/testsuite/tests/parser/should_compile/T2245.stderr
index b823c00ed0..8e48cfb189 100644
--- a/testsuite/tests/parser/should_compile/T2245.stderr
+++ b/testsuite/tests/parser/should_compile/T2245.stderr
@@ -13,10 +13,10 @@ T2245.hs:5:10: warning: [-Wmissing-methods (in -Wdefault)]
T2245.hs:7:27: warning: [-Wtype-defaults (in -Wall)]
• Defaulting the following constraints to type ‘T’
- (Ord a0) arising from a use of ‘<’ at T2245.hs:7:27
- (Fractional a0)
+ (Ord b0) arising from a use of ‘<’ at T2245.hs:7:27
+ (Fractional b0)
arising from the literal ‘1e400’ at T2245.hs:7:29-33
- (Read a0) arising from a use of ‘read’ at T2245.hs:7:38-41
+ (Read b0) arising from a use of ‘read’ at T2245.hs:7:38-41
• In the first argument of ‘(.)’, namely ‘(< 1e400)’
In the second argument of ‘(.)’, namely ‘(< 1e400) . read’
In the second argument of ‘($)’, namely ‘show . (< 1e400) . read’
diff --git a/testsuite/tests/parser/should_fail/T8501c.stderr b/testsuite/tests/parser/should_fail/T8501c.stderr
index b12b53e8ad..3b02432822 100644
--- a/testsuite/tests/parser/should_fail/T8501c.stderr
+++ b/testsuite/tests/parser/should_fail/T8501c.stderr
@@ -1,6 +1,6 @@
T8501c.hs:4:7: error:
• Variable not in scope:
- mdo :: (String -> IO ()) -> [Char] -> IO ()
+ mdo :: (String -> IO ()) -> String -> IO ()
• Perhaps you meant ‘mod’ (imported from Prelude)
Perhaps you meant to use RecursiveDo
diff --git a/testsuite/tests/parser/should_fail/readFail003.stderr b/testsuite/tests/parser/should_fail/readFail003.stderr
index 933f16179a..dbcc63f419 100644
--- a/testsuite/tests/parser/should_fail/readFail003.stderr
+++ b/testsuite/tests/parser/should_fail/readFail003.stderr
@@ -1,7 +1,7 @@
readFail003.hs:4:27: error:
- • Occurs check: cannot construct the infinite type:
- a ~ (a, [a1], [a2])
+ • Couldn't match expected type ‘(a, [a1], [a2])’
+ with actual type ‘a’
• In the expression: a
In a pattern binding:
~(a, b, c)
diff --git a/testsuite/tests/parser/should_fail/readFail032.stderr b/testsuite/tests/parser/should_fail/readFail032.stderr
index 7cd106d69a..c845203048 100644
--- a/testsuite/tests/parser/should_fail/readFail032.stderr
+++ b/testsuite/tests/parser/should_fail/readFail032.stderr
@@ -1,11 +1,10 @@
-readFail032.hs:25:38:
- Couldn't match type ‘Char’ with ‘[Char]’
- Expected type: [[Char]]
- Actual type: [Char]
- In the second argument of ‘(:)’, namely ‘"Type error on line 25"’
+readFail032.hs:25:38: error:
+ • Couldn't match type ‘Char’ with ‘[Char]’
+ Expected: [String]
+ Actual: String
+ • In the second argument of ‘(:)’, namely ‘"Type error on line 25"’
In the expression:
- "Type error on line 25" : "Type error on line 25"
+ "Type error on line 25" : "Type error on line 25"
In an equation for ‘type_error’:
type_error = "Type error on line 25" : "Type error on line 25"
-
diff --git a/testsuite/tests/parser/should_fail/readFail048.stderr b/testsuite/tests/parser/should_fail/readFail048.stderr
index 62276db0c9..b1d7ab4dd2 100644
--- a/testsuite/tests/parser/should_fail/readFail048.stderr
+++ b/testsuite/tests/parser/should_fail/readFail048.stderr
@@ -1,11 +1,10 @@
-readFail048.hs:25:38:
- Couldn't match type ‘Char’ with ‘[Char]’
- Expected type: [[Char]]
- Actual type: [Char]
- In the second argument of ‘(:)’, namely ‘"Type error on line 25"’
+readFail048.hs:25:38: error:
+ • Couldn't match type ‘Char’ with ‘[Char]’
+ Expected: [String]
+ Actual: String
+ • In the second argument of ‘(:)’, namely ‘"Type error on line 25"’
In the expression:
- "Type error on line 25" : "Type error on line 25"
+ "Type error on line 25" : "Type error on line 25"
In an equation for ‘type_error’:
type_error = "Type error on line 25" : "Type error on line 25"
-
diff --git a/testsuite/tests/partial-sigs/should_compile/DataFamilyInstanceLHS.stderr b/testsuite/tests/partial-sigs/should_compile/DataFamilyInstanceLHS.stderr
index 7a7a36472b..6672efb7ac 100644
--- a/testsuite/tests/partial-sigs/should_compile/DataFamilyInstanceLHS.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/DataFamilyInstanceLHS.stderr
@@ -15,5 +15,5 @@ DATA CONSTRUCTORS
FAMILY INSTANCES
data instance Sing _ -- Defined at DataFamilyInstanceLHS.hs:8:15
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-prim-0.6.1,
- integer-gmp-1.0.2.0]
+Dependent packages: [base-4.14.0.0, ghc-prim-0.6.1,
+ integer-gmp-1.0.3.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/Defaulting2MROff.stderr b/testsuite/tests/partial-sigs/should_compile/Defaulting2MROff.stderr
index 4332d07a03..441bfa5720 100644
--- a/testsuite/tests/partial-sigs/should_compile/Defaulting2MROff.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/Defaulting2MROff.stderr
@@ -1,5 +1,5 @@
TYPE SIGNATURES
- bravo :: forall {_}. Num _ => _
+ bravo :: forall {w}. Num w => w
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-prim-0.6.1,
- integer-gmp-1.0.2.0]
+Dependent packages: [base-4.14.0.0, ghc-prim-0.6.1,
+ integer-gmp-1.0.3.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/Defaulting2MROn.stderr b/testsuite/tests/partial-sigs/should_compile/Defaulting2MROn.stderr
index 4332d07a03..441bfa5720 100644
--- a/testsuite/tests/partial-sigs/should_compile/Defaulting2MROn.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/Defaulting2MROn.stderr
@@ -1,5 +1,5 @@
TYPE SIGNATURES
- bravo :: forall {_}. Num _ => _
+ bravo :: forall {w}. Num w => w
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-prim-0.6.1,
- integer-gmp-1.0.2.0]
+Dependent packages: [base-4.14.0.0, ghc-prim-0.6.1,
+ integer-gmp-1.0.3.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/Either.stderr b/testsuite/tests/partial-sigs/should_compile/Either.stderr
index f5f54d209e..6e48357b33 100644
--- a/testsuite/tests/partial-sigs/should_compile/Either.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/Either.stderr
@@ -1,5 +1,5 @@
TYPE SIGNATURES
- barry :: forall {_}. _ -> (Either [Char] _, Either [Char] _)
+ barry :: forall {w}. w -> (Either String w, Either String w)
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-prim-0.6.1,
- integer-gmp-1.0.2.0]
+Dependent packages: [base-4.14.0.0, ghc-prim-0.6.1,
+ integer-gmp-1.0.3.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/EveryNamed.stderr b/testsuite/tests/partial-sigs/should_compile/EveryNamed.stderr
index 28c25b80b6..eff1cb3577 100644
--- a/testsuite/tests/partial-sigs/should_compile/EveryNamed.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/EveryNamed.stderr
@@ -1,5 +1,5 @@
TYPE SIGNATURES
- every :: forall {_}. (_ -> Bool) -> [_] -> Bool
+ every :: forall {w}. (w -> Bool) -> [w] -> Bool
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-prim-0.6.1,
- integer-gmp-1.0.2.0]
+Dependent packages: [base-4.14.0.0, ghc-prim-0.6.1,
+ integer-gmp-1.0.3.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/ExtraConstraints3.stderr b/testsuite/tests/partial-sigs/should_compile/ExtraConstraints3.stderr
index 09a6ce2a17..73b2c3058f 100644
--- a/testsuite/tests/partial-sigs/should_compile/ExtraConstraints3.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/ExtraConstraints3.stderr
@@ -132,12 +132,12 @@ TYPE SIGNATURES
(P.Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
max :: forall {a}. Ord a => a -> a -> a
- maxBound :: forall {_}. Bounded _ => _
+ maxBound :: forall {w}. Bounded w => w
maximum ::
forall {t :: * -> *} {a}. (P.Foldable t, Ord a) => t a -> a
maybe :: forall {b} {a}. b -> (a -> b) -> Maybe a -> b
min :: forall {a}. Ord a => a -> a -> a
- minBound :: forall {_}. Bounded _ => _
+ minBound :: forall {w}. Bounded w => w
minimum ::
forall {t :: * -> *} {a}. (P.Foldable t, Ord a) => t a -> a
mod :: forall {a}. Integral a => a -> a -> a
@@ -149,7 +149,7 @@ TYPE SIGNATURES
odd :: forall {a}. Integral a => a -> Bool
or :: forall {t :: * -> *}. P.Foldable t => t Bool -> Bool
otherwise :: Bool
- pi :: forall {_}. Floating _ => _
+ pi :: forall {w}. Floating w => w
pred :: forall {a}. Enum a => a -> a
print :: forall {a}. Show a => a -> IO ()
product ::
@@ -219,7 +219,7 @@ TYPE SIGNATURES
toRational :: forall {a}. Real a => a -> Rational
truncate :: forall {a} {b}. (RealFrac a, Integral b) => a -> b
uncurry :: forall {a} {b} {c}. (a -> b -> c) -> (a, b) -> c
- undefined :: forall {_}. _
+ undefined :: forall {w}. w
unlines :: [String] -> String
until :: forall {a}. (a -> Bool) -> (a -> a) -> a -> a
unwords :: [String] -> String
diff --git a/testsuite/tests/partial-sigs/should_compile/SimpleGen.stderr b/testsuite/tests/partial-sigs/should_compile/SimpleGen.stderr
index 49e98e3b0d..0bb722daf6 100644
--- a/testsuite/tests/partial-sigs/should_compile/SimpleGen.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/SimpleGen.stderr
@@ -1,5 +1,5 @@
TYPE SIGNATURES
- bar :: forall {_}. _ -> Bool
+ bar :: forall {w}. w -> Bool
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-prim-0.6.1,
- integer-gmp-1.0.2.0]
+Dependent packages: [base-4.14.0.0, ghc-prim-0.6.1,
+ integer-gmp-1.0.3.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr b/testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr
index 298aa30c40..ea48244e0c 100644
--- a/testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr
@@ -7,9 +7,9 @@ SplicesUsed.hs:7:15: warning: [-Wpartial-type-signatures (in -Wdefault)]
In the type signature: maybeBool :: (_)
SplicesUsed.hs:8:14: warning: [-Wpartial-type-signatures (in -Wdefault)]
- • Found type wildcard ‘_a’ standing for ‘_’
- Where: ‘_’ is a rigid type variable bound by
- the inferred type of <expression> :: _ -> _
+ • Found type wildcard ‘_a’ standing for ‘w’
+ Where: ‘w’ is a rigid type variable bound by
+ the inferred type of <expression> :: w -> w
at SplicesUsed.hs:8:14-23
• In an expression type signature: _a -> _a
In the expression: id :: _a -> _a
@@ -72,9 +72,9 @@ SplicesUsed.hs:16:2: warning: [-Wpartial-type-signatures (in -Wdefault)]
• In the type signature: foo :: _ => _
SplicesUsed.hs:18:2: warning: [-Wpartial-type-signatures (in -Wdefault)]
- • Found type wildcard ‘_b’ standing for ‘_’
- Where: ‘_’ is a rigid type variable bound by
- the inferred type of bar :: Bool -> _ -> (Bool, _)
+ • Found type wildcard ‘_b’ standing for ‘w’
+ Where: ‘w’ is a rigid type variable bound by
+ the inferred type of bar :: Bool -> w -> (Bool, w)
at SplicesUsed.hs:18:2-11
• In the type signature: bar :: _a -> _b -> (_a, _b)
diff --git a/testsuite/tests/partial-sigs/should_compile/T10403.stderr b/testsuite/tests/partial-sigs/should_compile/T10403.stderr
index fcc5e38e87..e59a28a99d 100644
--- a/testsuite/tests/partial-sigs/should_compile/T10403.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/T10403.stderr
@@ -2,22 +2,22 @@
T10403.hs:15:7: warning: [-Wpartial-type-signatures (in -Wdefault)]
• Found type wildcard ‘_’ standing for ‘Functor f’
Where: ‘f’ is a rigid type variable bound by
- the inferred type of h1 :: Functor f => (a -> b) -> f a -> H f
+ the inferred type of h1 :: Functor f => (a -> a1) -> f a -> H f
at T10403.hs:17:1-41
• In the type signature: h1 :: _ => _
T10403.hs:15:12: warning: [-Wpartial-type-signatures (in -Wdefault)]
- • Found type wildcard ‘_’ standing for ‘(a -> b) -> f a -> H f’
- Where: ‘b’, ‘a’, ‘f’ are rigid type variables bound by
- the inferred type of h1 :: Functor f => (a -> b) -> f a -> H f
+ • Found type wildcard ‘_’ standing for ‘(a -> a1) -> f a -> H f’
+ Where: ‘a1’, ‘a’, ‘f’ are rigid type variables bound by
+ the inferred type of h1 :: Functor f => (a -> a1) -> f a -> H f
at T10403.hs:17:1-41
• In the type signature: h1 :: _ => _
T10403.hs:19:7: warning: [-Wpartial-type-signatures (in -Wdefault)]
- • Found type wildcard ‘_’ standing for ‘(a -> b) -> f0 a -> H f0’
+ • Found type wildcard ‘_’ standing for ‘(a -> a1) -> f0 a -> H f0’
Where: ‘f0’ is an ambiguous type variable
- ‘b’, ‘a’ are rigid type variables bound by
- the inferred type of h2 :: (a -> b) -> f0 a -> H f0
+ ‘a1’, ‘a’ are rigid type variables bound by
+ the inferred type of h2 :: (a -> a1) -> f0 a -> H f0
at T10403.hs:22:1-41
• In the type signature: h2 :: _
@@ -26,7 +26,7 @@ T10403.hs:22:15: warning: [-Wdeferred-type-errors (in -Wdefault)]
prevents the constraint ‘(Functor f0)’ from being solved.
Relevant bindings include
b :: f0 a (bound at T10403.hs:22:6)
- h2 :: (a -> b) -> f0 a -> H f0 (bound at T10403.hs:22:1)
+ h2 :: (a -> a1) -> f0 a -> H f0 (bound at T10403.hs:22:1)
Probable fix: use a type annotation to specify what ‘f0’ should be.
These potential instances exist:
instance Functor IO -- Defined in ‘GHC.Base’
@@ -41,13 +41,13 @@ T10403.hs:22:15: warning: [-Wdeferred-type-errors (in -Wdefault)]
T10403.hs:28:8: warning: [-Wdeferred-type-errors (in -Wdefault)]
• Couldn't match type ‘f0’ with ‘B t’
+ Expected: H (B t)
+ Actual: H f0
because type variable ‘t’ would escape its scope
This (rigid, skolem) type variable is bound by
the type signature for:
app2 :: forall t. H (B t)
at T10403.hs:27:1-15
- Expected type: H (B t)
- Actual type: H f0
• In the expression: h2 (H . I) (B ())
In an equation for ‘app2’: app2 = h2 (H . I) (B ())
• Relevant bindings include
diff --git a/testsuite/tests/partial-sigs/should_compile/T11670.stderr b/testsuite/tests/partial-sigs/should_compile/T11670.stderr
index 1a0e7df6ef..87e36e5fc5 100644
--- a/testsuite/tests/partial-sigs/should_compile/T11670.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/T11670.stderr
@@ -9,9 +9,9 @@ T11670.hs:10:42: warning: [-Wpartial-type-signatures (in -Wdefault)]
peek :: Ptr a -> IO CLong (bound at T11670.hs:10:1)
T11670.hs:13:40: warning: [-Wpartial-type-signatures (in -Wdefault)]
- • Found type wildcard ‘_’ standing for ‘Storable _’
- Where: ‘_’ is a rigid type variable bound by
- the inferred type of <expression> :: Storable _ => IO _
+ • Found type wildcard ‘_’ standing for ‘Storable w’
+ Where: ‘w’ is a rigid type variable bound by
+ the inferred type of <expression> :: Storable w => IO w
at T11670.hs:13:40-48
• In an expression type signature: _ => IO _
In the expression: peekElemOff undefined 0 :: _ => IO _
@@ -22,9 +22,9 @@ T11670.hs:13:40: warning: [-Wpartial-type-signatures (in -Wdefault)]
peek2 :: Ptr a -> IO CLong (bound at T11670.hs:13:1)
T11670.hs:13:48: warning: [-Wpartial-type-signatures (in -Wdefault)]
- • Found type wildcard ‘_’ standing for ‘_’
- Where: ‘_’ is a rigid type variable bound by
- the inferred type of <expression> :: Storable _ => IO _
+ • Found type wildcard ‘_’ standing for ‘w’
+ Where: ‘w’ is a rigid type variable bound by
+ the inferred type of <expression> :: Storable w => IO w
at T11670.hs:13:40-48
• In the first argument of ‘IO’, namely ‘_’
In the type ‘IO _’
diff --git a/testsuite/tests/partial-sigs/should_compile/T14643.stderr b/testsuite/tests/partial-sigs/should_compile/T14643.stderr
index c5f204e799..60288670fb 100644
--- a/testsuite/tests/partial-sigs/should_compile/T14643.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/T14643.stderr
@@ -1,8 +1,8 @@
T14643.hs:5:18: warning: [-Wpartial-type-signatures (in -Wdefault)]
• Found type wildcard ‘_’ standing for ‘()’
- • In the type signature: af :: (Num a, _) => a -> a
+ • In the type signature: ag :: (Num a, _) => a -> a
T14643.hs:5:18: warning: [-Wpartial-type-signatures (in -Wdefault)]
• Found type wildcard ‘_’ standing for ‘()’
- • In the type signature: ag :: (Num a, _) => a -> a
+ • In the type signature: af :: (Num a, _) => a -> a
diff --git a/testsuite/tests/partial-sigs/should_compile/T16728a.stderr b/testsuite/tests/partial-sigs/should_compile/T16728a.stderr
index 50785ebc1c..a23c189c4b 100644
--- a/testsuite/tests/partial-sigs/should_compile/T16728a.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/T16728a.stderr
@@ -1,20 +1,20 @@
T16728a.hs:4:22: warning: [-Wpartial-type-signatures (in -Wdefault)]
- • Found type wildcard ‘_’ standing for ‘_’
- Where: ‘_’ is a rigid type variable bound by
+ • Found type wildcard ‘_’ standing for ‘w’
+ Where: ‘w’ is a rigid type variable bound by
the inferred types of
- g :: a -> _
- h :: a -> _
+ g :: a -> w
+ h :: a -> w
at T16728a.hs:(5,1)-(7,9)
• In the type ‘a -> _’
- In the type signature: g :: forall a. a -> _
+ In the type signature: h :: forall a. a -> _
T16728a.hs:4:22: warning: [-Wpartial-type-signatures (in -Wdefault)]
- • Found type wildcard ‘_’ standing for ‘_’
- Where: ‘_’ is a rigid type variable bound by
+ • Found type wildcard ‘_’ standing for ‘w’
+ Where: ‘w’ is a rigid type variable bound by
the inferred types of
- g :: a -> _
- h :: a -> _
+ g :: a -> w
+ h :: a -> w
at T16728a.hs:(5,1)-(7,9)
• In the type ‘a -> _’
- In the type signature: h :: forall a. a -> _
+ In the type signature: g :: forall a. a -> _
diff --git a/testsuite/tests/partial-sigs/should_compile/TypeFamilyInstanceLHS.stderr b/testsuite/tests/partial-sigs/should_compile/TypeFamilyInstanceLHS.stderr
index a079ea0342..2010018e05 100644
--- a/testsuite/tests/partial-sigs/should_compile/TypeFamilyInstanceLHS.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/TypeFamilyInstanceLHS.stderr
@@ -12,5 +12,5 @@ FAMILY INSTANCES
type instance F Bool _ = Bool
-- Defined at TypeFamilyInstanceLHS.hs:8:15
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-prim-0.6.1,
- integer-gmp-1.0.2.0]
+Dependent packages: [base-4.14.0.0, ghc-prim-0.6.1,
+ integer-gmp-1.0.3.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/Uncurry.stderr b/testsuite/tests/partial-sigs/should_compile/Uncurry.stderr
index 0499a2eb93..f83b50d0e7 100644
--- a/testsuite/tests/partial-sigs/should_compile/Uncurry.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/Uncurry.stderr
@@ -1,5 +1,5 @@
TYPE SIGNATURES
- unc :: forall {_1} {_2} {_3}. (_1 -> _2 -> _3) -> (_1, _2) -> _3
+ unc :: forall {w1} {w2} {w3}. (w1 -> w2 -> w3) -> (w1, w2) -> w3
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-prim-0.6.1,
- integer-gmp-1.0.2.0]
+Dependent packages: [base-4.14.0.0, ghc-prim-0.6.1,
+ integer-gmp-1.0.3.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/UncurryNamed.stderr b/testsuite/tests/partial-sigs/should_compile/UncurryNamed.stderr
index 62ae68aef0..f83b50d0e7 100644
--- a/testsuite/tests/partial-sigs/should_compile/UncurryNamed.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/UncurryNamed.stderr
@@ -1,5 +1,5 @@
TYPE SIGNATURES
- unc :: forall {a} {b} {_}. (a -> b -> _) -> (a, b) -> _
+ unc :: forall {w1} {w2} {w3}. (w1 -> w2 -> w3) -> (w1, w2) -> w3
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-prim-0.6.1,
- integer-gmp-1.0.2.0]
+Dependent packages: [base-4.14.0.0, ghc-prim-0.6.1,
+ integer-gmp-1.0.3.0]
diff --git a/testsuite/tests/partial-sigs/should_compile/WarningWildcardInstantiations.stderr b/testsuite/tests/partial-sigs/should_compile/WarningWildcardInstantiations.stderr
index 8cfb1f2fe0..fcefb13b71 100644
--- a/testsuite/tests/partial-sigs/should_compile/WarningWildcardInstantiations.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/WarningWildcardInstantiations.stderr
@@ -1,9 +1,9 @@
TYPE SIGNATURES
- bar :: forall {t} {_}. t -> (t -> _) -> _
+ bar :: forall {t} {w}. t -> (t -> w) -> w
foo :: forall {a}. (Show a, Enum a) => a -> String
Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-prim-0.6.1,
- integer-gmp-1.0.2.0]
+Dependent packages: [base-4.14.0.0, ghc-prim-0.6.1,
+ integer-gmp-1.0.3.0]
WarningWildcardInstantiations.hs:5:14: warning: [-Wpartial-type-signatures (in -Wdefault)]
• Found type wildcard ‘_a’ standing for ‘a’
@@ -27,23 +27,23 @@ WarningWildcardInstantiations.hs:5:30: warning: [-Wpartial-type-signatures (in -
WarningWildcardInstantiations.hs:8:8: warning: [-Wpartial-type-signatures (in -Wdefault)]
• Found type wildcard ‘_’ standing for ‘t’
Where: ‘t’ is a rigid type variable bound by
- the inferred type of bar :: t -> (t -> _) -> _
+ the inferred type of bar :: t -> (t -> w) -> w
at WarningWildcardInstantiations.hs:9:1-13
• In the type ‘_ -> _ -> _’
In the type signature: bar :: _ -> _ -> _
WarningWildcardInstantiations.hs:8:13: warning: [-Wpartial-type-signatures (in -Wdefault)]
- • Found type wildcard ‘_’ standing for ‘t -> _’
- Where: ‘t’, ‘_’ are rigid type variables bound by
- the inferred type of bar :: t -> (t -> _) -> _
+ • Found type wildcard ‘_’ standing for ‘t -> w’
+ Where: ‘t’, ‘w’ are rigid type variables bound by
+ the inferred type of bar :: t -> (t -> w) -> w
at WarningWildcardInstantiations.hs:9:1-13
• In the type ‘_ -> _ -> _’
In the type signature: bar :: _ -> _ -> _
WarningWildcardInstantiations.hs:8:18: warning: [-Wpartial-type-signatures (in -Wdefault)]
- • Found type wildcard ‘_’ standing for ‘_’
- Where: ‘_’ is a rigid type variable bound by
- the inferred type of bar :: t -> (t -> _) -> _
+ • Found type wildcard ‘_’ standing for ‘w’
+ Where: ‘w’ is a rigid type variable bound by
+ the inferred type of bar :: t -> (t -> w) -> w
at WarningWildcardInstantiations.hs:9:1-13
• In the type ‘_ -> _ -> _’
In the type signature: bar :: _ -> _ -> _
diff --git a/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInPatternSplice.stderr b/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInPatternSplice.stderr
index 2a83a36cc2..e42e098ef3 100644
--- a/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInPatternSplice.stderr
+++ b/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInPatternSplice.stderr
@@ -1,13 +1,13 @@
ExtraConstraintsWildcardInPatternSplice.hs:5:6: error:
- • Found type wildcard ‘_’ standing for ‘_’
- Where: ‘_’ is a rigid type variable bound by
- the inferred type of foo :: _ -> ()
+ • Found type wildcard ‘_’ standing for ‘w’
+ Where: ‘w’ is a rigid type variable bound by
+ the inferred type of foo :: w -> ()
at ExtraConstraintsWildcardInPatternSplice.hs:5:1-29
To use the inferred type, enable PartialTypeSignatures
• In a pattern type signature: _
In the pattern: _ :: _
In an equation for ‘foo’: foo (_ :: _) = ()
• Relevant bindings include
- foo :: _ -> ()
+ foo :: w -> ()
(bound at ExtraConstraintsWildcardInPatternSplice.hs:5:1)
diff --git a/testsuite/tests/partial-sigs/should_fail/NamedExtraConstraintsWildcard.stderr b/testsuite/tests/partial-sigs/should_fail/NamedExtraConstraintsWildcard.stderr
index 84d61eda91..146b0146eb 100644
--- a/testsuite/tests/partial-sigs/should_fail/NamedExtraConstraintsWildcard.stderr
+++ b/testsuite/tests/partial-sigs/should_fail/NamedExtraConstraintsWildcard.stderr
@@ -1,11 +1,11 @@
NamedExtraConstraintsWildcard.hs:5:1: error:
- • Could not deduce: _0
- from the context: (Eq a, _)
+ • Could not deduce: w0
+ from the context: (Eq a, w)
bound by the inferred type for ‘foo’:
- forall a {_ :: Constraint}. (Eq a, _) => a -> a
+ forall a {w :: Constraint}. (Eq a, w) => a -> a
at NamedExtraConstraintsWildcard.hs:5:1-15
• In the ambiguity check for the inferred type for ‘foo’
To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
When checking the inferred type
- foo :: forall a {_ :: Constraint}. (Eq a, _) => a -> a
+ foo :: forall a {w :: Constraint}. (Eq a, w) => a -> a
diff --git a/testsuite/tests/partial-sigs/should_fail/NamedWildcardExplicitForall.stderr b/testsuite/tests/partial-sigs/should_fail/NamedWildcardExplicitForall.stderr
index 4c22dc62b9..e366651f7d 100644
--- a/testsuite/tests/partial-sigs/should_fail/NamedWildcardExplicitForall.stderr
+++ b/testsuite/tests/partial-sigs/should_fail/NamedWildcardExplicitForall.stderr
@@ -1,12 +1,12 @@
NamedWildcardExplicitForall.hs:8:7: error:
• Couldn't match type ‘_a’ with ‘Bool’
+ Expected: _a -> _a
+ Actual: Bool -> Bool
‘_a’ is a rigid type variable bound by
the type signature for:
foo :: forall _a. _a -> _a
at NamedWildcardExplicitForall.hs:7:1-27
- Expected type: _a -> _a
- Actual type: Bool -> Bool
• In the expression: not
In an equation for ‘foo’: foo = not
• Relevant bindings include
diff --git a/testsuite/tests/partial-sigs/should_fail/NamedWildcardsNotInMonotype.stderr b/testsuite/tests/partial-sigs/should_fail/NamedWildcardsNotInMonotype.stderr
index 6a1d0edbb4..423fe1b040 100644
--- a/testsuite/tests/partial-sigs/should_fail/NamedWildcardsNotInMonotype.stderr
+++ b/testsuite/tests/partial-sigs/should_fail/NamedWildcardsNotInMonotype.stderr
@@ -1,12 +1,12 @@
NamedWildcardsNotInMonotype.hs:5:1: error:
- • Could not deduce (Eq _0)
- from the context: (Show a, Eq _, Eq a)
+ • Could not deduce (Eq w0)
+ from the context: (Show a, Eq w, Eq a)
bound by the inferred type for ‘foo’:
- forall {a} {_}. (Show a, Eq _, Eq a) => a -> a -> String
+ forall {a} {w}. (Show a, Eq w, Eq a) => a -> a -> String
at NamedWildcardsNotInMonotype.hs:5:1-33
- The type variable ‘_0’ is ambiguous
+ The type variable ‘w0’ is ambiguous
• In the ambiguity check for the inferred type for ‘foo’
To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
When checking the inferred type
- foo :: forall {a} {_}. (Show a, Eq _, Eq a) => a -> a -> String
+ foo :: forall {a} {w}. (Show a, Eq w, Eq a) => a -> a -> String
diff --git a/testsuite/tests/partial-sigs/should_fail/PatBind3.stderr b/testsuite/tests/partial-sigs/should_fail/PatBind3.stderr
index 8ca3dcd540..e4c368c6e1 100644
--- a/testsuite/tests/partial-sigs/should_fail/PatBind3.stderr
+++ b/testsuite/tests/partial-sigs/should_fail/PatBind3.stderr
@@ -1,9 +1,9 @@
PatBind3.hs:6:12: error:
- • Couldn't match type ‘(Bool, _)’ with ‘Char’
- Expected type: Maybe ((Bool, _) -> Char)
- Actual type: Maybe ((Bool, _) -> (Bool, _))
+ • Couldn't match type ‘(Bool, w)’ with ‘Char’
+ Expected: Maybe ((Bool, w) -> Char)
+ Actual: Maybe ((Bool, w) -> (Bool, w))
• In the expression: Just id
In a pattern binding: Just foo = Just id
• Relevant bindings include
- foo :: (Bool, _) -> Char (bound at PatBind3.hs:6:6)
+ foo :: (Bool, w) -> Char (bound at PatBind3.hs:6:6)
diff --git a/testsuite/tests/partial-sigs/should_fail/T10615.stderr b/testsuite/tests/partial-sigs/should_fail/T10615.stderr
index b474e3dda7..9cd93c24a7 100644
--- a/testsuite/tests/partial-sigs/should_fail/T10615.stderr
+++ b/testsuite/tests/partial-sigs/should_fail/T10615.stderr
@@ -1,36 +1,36 @@
T10615.hs:4:7: error:
- • Found type wildcard ‘_’ standing for ‘a1’
- Where: ‘a1’ is an ambiguous type variable
+ • Found type wildcard ‘_’ standing for ‘w1’
+ Where: ‘w1’ is an ambiguous type variable
To use the inferred type, enable PartialTypeSignatures
• In the type ‘_ -> f’
In the type signature: f1 :: _ -> f
T10615.hs:5:6: error:
- • Couldn't match type ‘f’ with ‘b1 -> a1’
+ • Couldn't match type ‘f’ with ‘b1 -> w1’
+ Expected: w1 -> f
+ Actual: w1 -> b1 -> w1
‘f’ is a rigid type variable bound by
- the inferred type of f1 :: a1 -> f
+ the inferred type of f1 :: w1 -> f
at T10615.hs:4:1-12
- Expected type: a1 -> f
- Actual type: a1 -> b1 -> a1
• In the expression: const
In an equation for ‘f1’: f1 = const
- • Relevant bindings include f1 :: a1 -> f (bound at T10615.hs:5:1)
+ • Relevant bindings include f1 :: w1 -> f (bound at T10615.hs:5:1)
T10615.hs:7:7: error:
- • Found type wildcard ‘_’ standing for ‘a0’
- Where: ‘a0’ is an ambiguous type variable
+ • Found type wildcard ‘_’ standing for ‘w0’
+ Where: ‘w0’ is an ambiguous type variable
To use the inferred type, enable PartialTypeSignatures
• In the type ‘_ -> _f’
In the type signature: f2 :: _ -> _f
T10615.hs:8:6: error:
- • Couldn't match type ‘_f’ with ‘b0 -> a0’
+ • Couldn't match type ‘_f’ with ‘b0 -> w0’
+ Expected: w0 -> _f
+ Actual: w0 -> b0 -> w0
‘_f’ is a rigid type variable bound by
- the inferred type of f2 :: a0 -> _f
+ the inferred type of f2 :: w0 -> _f
at T10615.hs:7:1-13
- Expected type: a0 -> _f
- Actual type: a0 -> b0 -> a0
• In the expression: const
In an equation for ‘f2’: f2 = const
- • Relevant bindings include f2 :: a0 -> _f (bound at T10615.hs:8:1)
+ • Relevant bindings include f2 :: w0 -> _f (bound at T10615.hs:8:1)
diff --git a/testsuite/tests/partial-sigs/should_fail/T14040a.stderr b/testsuite/tests/partial-sigs/should_fail/T14040a.stderr
index 1d122cf590..be667ec3a6 100644
--- a/testsuite/tests/partial-sigs/should_fail/T14040a.stderr
+++ b/testsuite/tests/partial-sigs/should_fail/T14040a.stderr
@@ -1,20 +1,45 @@
-T14040a.hs:21:18: error:
- • Cannot generalise type; skolem ‘z’ would escape its scope
- if I tried to quantify (_1 :: WeirdList z) in this type:
- forall a1 (wl :: WeirdList a1)
- (p :: forall x. x -> WeirdList x -> *).
- Sing @(WeirdList a1) wl
- -> (forall y. p @x0 _0 ('WeirdNil @x0))
- -> (forall z (x :: z) (xs :: WeirdList (WeirdList z)).
- Sing @z x
- -> Sing @(WeirdList (WeirdList z)) xs
- -> p @(WeirdList z) _1 xs
- -> p @z _2 ('WeirdCons @z x xs))
- -> p @a1 _3 wl
- (Indeed, I sometimes struggle even printing this correctly,
- due to its ill-scoped nature.)
- • In the type signature:
+T14040a.hs:26:46: error:
+ • Couldn't match kind ‘k1’ with ‘WeirdList z’
+ Expected kind ‘WeirdList k1’,
+ but ‘xs’ has kind ‘WeirdList (WeirdList z)’
+ because kind variable ‘z’ would escape its scope
+ This (rigid, skolem) kind variable is bound by
+ ‘forall (z :: Type) (x :: z) (xs :: WeirdList (WeirdList z)).
+ Sing x -> Sing xs -> p _ xs -> p _ (WeirdCons x xs)’
+ at T14040a.hs:(25,19)-(27,41)
+ • In the second argument of ‘p’, namely ‘xs’
+ In the type ‘Sing wl
+ -> (forall (y :: Type). p _ WeirdNil)
+ -> (forall (z :: Type) (x :: z) (xs :: WeirdList (WeirdList z)).
+ Sing x -> Sing xs -> p _ xs -> p _ (WeirdCons x xs))
+ -> p _ wl’
+ In the type signature:
+ elimWeirdList :: forall (a :: Type)
+ (wl :: WeirdList a)
+ (p :: forall (x :: Type). x -> WeirdList x -> Type).
+ Sing wl
+ -> (forall (y :: Type). p _ WeirdNil)
+ -> (forall (z :: Type) (x :: z) (xs :: WeirdList (WeirdList z)).
+ Sing x -> Sing xs -> p _ xs -> p _ (WeirdCons x xs))
+ -> p _ wl
+
+T14040a.hs:27:27: error:
+ • Couldn't match kind ‘k0’ with ‘z’
+ Expected kind ‘WeirdList k0’,
+ but ‘WeirdCons x xs’ has kind ‘WeirdList z’
+ because kind variable ‘z’ would escape its scope
+ This (rigid, skolem) kind variable is bound by
+ ‘forall (z :: Type) (x :: z) (xs :: WeirdList (WeirdList z)).
+ Sing x -> Sing xs -> p _ xs -> p _ (WeirdCons x xs)’
+ at T14040a.hs:(25,19)-(27,41)
+ • In the second argument of ‘p’, namely ‘(WeirdCons x xs)’
+ In the type ‘Sing wl
+ -> (forall (y :: Type). p _ WeirdNil)
+ -> (forall (z :: Type) (x :: z) (xs :: WeirdList (WeirdList z)).
+ Sing x -> Sing xs -> p _ xs -> p _ (WeirdCons x xs))
+ -> p _ wl’
+ In the type signature:
elimWeirdList :: forall (a :: Type)
(wl :: WeirdList a)
(p :: forall (x :: Type). x -> WeirdList x -> Type).
diff --git a/testsuite/tests/partial-sigs/should_fail/T14584.stderr b/testsuite/tests/partial-sigs/should_fail/T14584.stderr
index 372ca3fba2..ced11e50a2 100644
--- a/testsuite/tests/partial-sigs/should_fail/T14584.stderr
+++ b/testsuite/tests/partial-sigs/should_fail/T14584.stderr
@@ -11,7 +11,12 @@ T14584.hs:56:41: warning: [-Wdeferred-type-errors (in -Wdefault)]
act @_ @_ @act (fromSing @m (sing @m @a :: Sing _))
T14584.hs:56:50: warning: [-Wdeferred-type-errors (in -Wdefault)]
- • Expected kind ‘m1’, but ‘a’ has kind ‘*’
+ • Could not deduce: m1 ~ *
+ from the context: (Action act, Monoid a, Good m1)
+ bound by the instance declaration at T14584.hs:54:10-89
+ ‘m1’ is a rigid type variable bound by
+ the instance declaration
+ at T14584.hs:54:10-89
• In the type ‘a’
In the second argument of ‘fromSing’, namely
‘(sing @m @a :: Sing _)’
diff --git a/testsuite/tests/partial-sigs/should_fail/T14584a.stderr b/testsuite/tests/partial-sigs/should_fail/T14584a.stderr
index 8c98b76ae2..9d7ab35dd5 100644
--- a/testsuite/tests/partial-sigs/should_fail/T14584a.stderr
+++ b/testsuite/tests/partial-sigs/should_fail/T14584a.stderr
@@ -6,6 +6,10 @@ T14584a.hs:12:5: warning: [-Wdeferred-type-errors (in -Wdefault)]
T14584a.hs:12:9: warning: [-Wdeferred-type-errors (in -Wdefault)]
• Expected a type, but ‘m’ has kind ‘k2’
+ ‘k2’ is a rigid type variable bound by
+ the type signature for:
+ f :: forall {k2} (m :: k2). ()
+ at T14584a.hs:11:1-17
• In the type ‘m’
In the expression: id @m :: _
In an equation for ‘f’: f = id @m :: _
@@ -23,6 +27,10 @@ T14584a.hs:12:14: warning: [-Wpartial-type-signatures (in -Wdefault)]
T14584a.hs:15:17: warning: [-Wdeferred-type-errors (in -Wdefault)]
• Expected a type, but ‘m’ has kind ‘k2’
+ ‘k2’ is a rigid type variable bound by
+ the type signature for:
+ g :: forall {k2} (m :: k2). ()
+ at T14584a.hs:14:1-17
• In the type ‘m’
In the expression: id @m
In an equation for ‘h’: h = id @m
diff --git a/testsuite/tests/partial-sigs/should_fail/TidyClash.stderr b/testsuite/tests/partial-sigs/should_fail/TidyClash.stderr
index 6ec4c440cc..fbbfc6e4c9 100644
--- a/testsuite/tests/partial-sigs/should_fail/TidyClash.stderr
+++ b/testsuite/tests/partial-sigs/should_fail/TidyClash.stderr
@@ -1,17 +1,17 @@
TidyClash.hs:8:19: error:
- • Found type wildcard ‘_’ standing for ‘_’
- Where: ‘_’ is a rigid type variable bound by
- the inferred type of bar :: w_ -> (w_, _ -> _1)
+ • Found type wildcard ‘_’ standing for ‘w’
+ Where: ‘w’ is a rigid type variable bound by
+ the inferred type of bar :: w_ -> (w_, w -> w1)
at TidyClash.hs:9:1-28
To use the inferred type, enable PartialTypeSignatures
• In the type ‘w_ -> (w_, _ -> _)’
In the type signature: bar :: w_ -> (w_, _ -> _)
TidyClash.hs:8:24: error:
- • Found type wildcard ‘_’ standing for ‘_1’
- Where: ‘_1’ is a rigid type variable bound by
- the inferred type of bar :: w_ -> (w_, _ -> _1)
+ • Found type wildcard ‘_’ standing for ‘w1’
+ Where: ‘w1’ is a rigid type variable bound by
+ the inferred type of bar :: w_ -> (w_, w -> w1)
at TidyClash.hs:9:1-28
To use the inferred type, enable PartialTypeSignatures
• In the type ‘w_ -> (w_, _ -> _)’
diff --git a/testsuite/tests/partial-sigs/should_fail/TidyClash2.stderr b/testsuite/tests/partial-sigs/should_fail/TidyClash2.stderr
index a2c63ecbbc..7e6b1da683 100644
--- a/testsuite/tests/partial-sigs/should_fail/TidyClash2.stderr
+++ b/testsuite/tests/partial-sigs/should_fail/TidyClash2.stderr
@@ -1,26 +1,26 @@
TidyClash2.hs:13:20: error:
- • Found type wildcard ‘_’ standing for ‘_’
- Where: ‘_’ is a rigid type variable bound by
- the inferred type of barry :: _ -> _1 -> t
+ • Found type wildcard ‘_’ standing for ‘w’
+ Where: ‘w’ is a rigid type variable bound by
+ the inferred type of barry :: w -> w1 -> t
at TidyClash2.hs:14:1-40
To use the inferred type, enable PartialTypeSignatures
• In the type ‘_ -> _ -> t’
In the type signature: barry :: forall t. _ -> _ -> t
TidyClash2.hs:13:25: error:
- • Found type wildcard ‘_’ standing for ‘_1’
- Where: ‘_1’ is a rigid type variable bound by
- the inferred type of barry :: _ -> _1 -> t
+ • Found type wildcard ‘_’ standing for ‘w1’
+ Where: ‘w1’ is a rigid type variable bound by
+ the inferred type of barry :: w -> w1 -> t
at TidyClash2.hs:14:1-40
To use the inferred type, enable PartialTypeSignatures
• In the type ‘_ -> _ -> t’
In the type signature: barry :: forall t. _ -> _ -> t
TidyClash2.hs:14:13: error:
- • Found type wildcard ‘_’ standing for ‘_’
- Where: ‘_’ is a rigid type variable bound by
- the inferred type of barry :: _ -> _1 -> t
+ • Found type wildcard ‘_’ standing for ‘w’
+ Where: ‘w’ is a rigid type variable bound by
+ the inferred type of barry :: w -> w1 -> t
at TidyClash2.hs:14:1-40
To use the inferred type, enable PartialTypeSignatures
• In a pattern type signature: _
@@ -28,12 +28,12 @@ TidyClash2.hs:14:13: error:
In an equation for ‘barry’:
barry (x :: _) (y :: _) = undefined :: _
• Relevant bindings include
- barry :: _ -> _1 -> t (bound at TidyClash2.hs:14:1)
+ barry :: w -> w1 -> t (bound at TidyClash2.hs:14:1)
TidyClash2.hs:14:22: error:
- • Found type wildcard ‘_’ standing for ‘_1’
- Where: ‘_1’ is a rigid type variable bound by
- the inferred type of barry :: _ -> _1 -> t
+ • Found type wildcard ‘_’ standing for ‘w1’
+ Where: ‘w1’ is a rigid type variable bound by
+ the inferred type of barry :: w -> w1 -> t
at TidyClash2.hs:14:1-40
To use the inferred type, enable PartialTypeSignatures
• In a pattern type signature: _
@@ -41,13 +41,13 @@ TidyClash2.hs:14:22: error:
In an equation for ‘barry’:
barry (x :: _) (y :: _) = undefined :: _
• Relevant bindings include
- x :: _ (bound at TidyClash2.hs:14:8)
- barry :: _ -> _1 -> t (bound at TidyClash2.hs:14:1)
+ x :: w (bound at TidyClash2.hs:14:8)
+ barry :: w -> w1 -> t (bound at TidyClash2.hs:14:1)
TidyClash2.hs:14:40: error:
- • Found type wildcard ‘_’ standing for ‘_2’
- Where: ‘_2’ is a rigid type variable bound by
- the inferred type of <expression> :: _2
+ • Found type wildcard ‘_’ standing for ‘w2’
+ Where: ‘w2’ is a rigid type variable bound by
+ the inferred type of <expression> :: w2
at TidyClash2.hs:14:40
To use the inferred type, enable PartialTypeSignatures
• In an expression type signature: _
@@ -55,6 +55,6 @@ TidyClash2.hs:14:40: error:
In an equation for ‘barry’:
barry (x :: _) (y :: _) = undefined :: _
• Relevant bindings include
- y :: _1 (bound at TidyClash2.hs:14:17)
- x :: _ (bound at TidyClash2.hs:14:8)
- barry :: _ -> _1 -> t (bound at TidyClash2.hs:14:1)
+ y :: w1 (bound at TidyClash2.hs:14:17)
+ x :: w (bound at TidyClash2.hs:14:8)
+ barry :: w -> w1 -> t (bound at TidyClash2.hs:14:1)
diff --git a/testsuite/tests/partial-sigs/should_fail/WildcardInstantiations.stderr b/testsuite/tests/partial-sigs/should_fail/WildcardInstantiations.stderr
index a6c21368c2..a7e31fd8c9 100644
--- a/testsuite/tests/partial-sigs/should_fail/WildcardInstantiations.stderr
+++ b/testsuite/tests/partial-sigs/should_fail/WildcardInstantiations.stderr
@@ -24,25 +24,25 @@ WildcardInstantiations.hs:5:30: error:
WildcardInstantiations.hs:8:8: error:
• Found type wildcard ‘_’ standing for ‘t’
Where: ‘t’ is a rigid type variable bound by
- the inferred type of bar :: t -> (t -> _) -> _
+ the inferred type of bar :: t -> (t -> w) -> w
at WildcardInstantiations.hs:9:1-13
To use the inferred type, enable PartialTypeSignatures
• In the type ‘_ -> _ -> _’
In the type signature: bar :: _ -> _ -> _
WildcardInstantiations.hs:8:13: error:
- • Found type wildcard ‘_’ standing for ‘t -> _’
- Where: ‘t’, ‘_’ are rigid type variables bound by
- the inferred type of bar :: t -> (t -> _) -> _
+ • Found type wildcard ‘_’ standing for ‘t -> w’
+ Where: ‘t’, ‘w’ are rigid type variables bound by
+ the inferred type of bar :: t -> (t -> w) -> w
at WildcardInstantiations.hs:9:1-13
To use the inferred type, enable PartialTypeSignatures
• In the type ‘_ -> _ -> _’
In the type signature: bar :: _ -> _ -> _
WildcardInstantiations.hs:8:18: error:
- • Found type wildcard ‘_’ standing for ‘_’
- Where: ‘_’ is a rigid type variable bound by
- the inferred type of bar :: t -> (t -> _) -> _
+ • Found type wildcard ‘_’ standing for ‘w’
+ Where: ‘w’ is a rigid type variable bound by
+ the inferred type of bar :: t -> (t -> w) -> w
at WildcardInstantiations.hs:9:1-13
To use the inferred type, enable PartialTypeSignatures
• In the type ‘_ -> _ -> _’
diff --git a/testsuite/tests/partial-sigs/should_fail/WildcardsInPatternAndExprSig.stderr b/testsuite/tests/partial-sigs/should_fail/WildcardsInPatternAndExprSig.stderr
index d75a630d04..726b43898e 100644
--- a/testsuite/tests/partial-sigs/should_fail/WildcardsInPatternAndExprSig.stderr
+++ b/testsuite/tests/partial-sigs/should_fail/WildcardsInPatternAndExprSig.stderr
@@ -1,34 +1,34 @@
WildcardsInPatternAndExprSig.hs:4:18: error:
- • Found type wildcard ‘_a’ standing for ‘_’
- Where: ‘_’ is a rigid type variable bound by
- the inferred type of bar :: Maybe [_] -> _ -> [_]
+ • Found type wildcard ‘_a’ standing for ‘w’
+ Where: ‘w’ is a rigid type variable bound by
+ the inferred type of bar :: Maybe [w] -> w -> [w]
at WildcardsInPatternAndExprSig.hs:4:1-68
To use the inferred type, enable PartialTypeSignatures
• In a pattern type signature: _a
In the pattern: x :: _a
In the pattern: [x :: _a]
• Relevant bindings include
- bar :: Maybe [_] -> _ -> [_]
+ bar :: Maybe [w] -> w -> [w]
(bound at WildcardsInPatternAndExprSig.hs:4:1)
WildcardsInPatternAndExprSig.hs:4:25: error:
- • Found type wildcard ‘_’ standing for ‘[_]’
- Where: ‘_’ is a rigid type variable bound by
- the inferred type of bar :: Maybe [_] -> _ -> [_]
+ • Found type wildcard ‘_’ standing for ‘[w]’
+ Where: ‘w’ is a rigid type variable bound by
+ the inferred type of bar :: Maybe [w] -> w -> [w]
at WildcardsInPatternAndExprSig.hs:4:1-68
To use the inferred type, enable PartialTypeSignatures
• In a pattern type signature: _
In the pattern: [x :: _a] :: _
In the pattern: Just ([x :: _a] :: _)
• Relevant bindings include
- bar :: Maybe [_] -> _ -> [_]
+ bar :: Maybe [w] -> w -> [w]
(bound at WildcardsInPatternAndExprSig.hs:4:1)
WildcardsInPatternAndExprSig.hs:4:38: error:
- • Found type wildcard ‘_b’ standing for ‘_’
- Where: ‘_’ is a rigid type variable bound by
- the inferred type of bar :: Maybe [_] -> _ -> [_]
+ • Found type wildcard ‘_b’ standing for ‘w’
+ Where: ‘w’ is a rigid type variable bound by
+ the inferred type of bar :: Maybe [w] -> w -> [w]
at WildcardsInPatternAndExprSig.hs:4:1-68
To use the inferred type, enable PartialTypeSignatures
• In a pattern type signature: Maybe [_b]
@@ -37,13 +37,13 @@ WildcardsInPatternAndExprSig.hs:4:38: error:
bar (Just ([x :: _a] :: _) :: Maybe [_b]) (z :: _c)
= [x, z] :: [_d]
• Relevant bindings include
- bar :: Maybe [_] -> _ -> [_]
+ bar :: Maybe [w] -> w -> [w]
(bound at WildcardsInPatternAndExprSig.hs:4:1)
WildcardsInPatternAndExprSig.hs:4:49: error:
- • Found type wildcard ‘_c’ standing for ‘_’
- Where: ‘_’ is a rigid type variable bound by
- the inferred type of bar :: Maybe [_] -> _ -> [_]
+ • Found type wildcard ‘_c’ standing for ‘w’
+ Where: ‘w’ is a rigid type variable bound by
+ the inferred type of bar :: Maybe [w] -> w -> [w]
at WildcardsInPatternAndExprSig.hs:4:1-68
To use the inferred type, enable PartialTypeSignatures
• In a pattern type signature: _c
@@ -52,14 +52,14 @@ WildcardsInPatternAndExprSig.hs:4:49: error:
bar (Just ([x :: _a] :: _) :: Maybe [_b]) (z :: _c)
= [x, z] :: [_d]
• Relevant bindings include
- x :: _ (bound at WildcardsInPatternAndExprSig.hs:4:13)
- bar :: Maybe [_] -> _ -> [_]
+ x :: w (bound at WildcardsInPatternAndExprSig.hs:4:13)
+ bar :: Maybe [w] -> w -> [w]
(bound at WildcardsInPatternAndExprSig.hs:4:1)
WildcardsInPatternAndExprSig.hs:4:66: error:
- • Found type wildcard ‘_d’ standing for ‘_’
- Where: ‘_’ is a rigid type variable bound by
- the inferred type of bar :: Maybe [_] -> _ -> [_]
+ • Found type wildcard ‘_d’ standing for ‘w’
+ Where: ‘w’ is a rigid type variable bound by
+ the inferred type of bar :: Maybe [w] -> w -> [w]
at WildcardsInPatternAndExprSig.hs:4:1-68
To use the inferred type, enable PartialTypeSignatures
• In an expression type signature: [_d]
@@ -68,7 +68,7 @@ WildcardsInPatternAndExprSig.hs:4:66: error:
bar (Just ([x :: _a] :: _) :: Maybe [_b]) (z :: _c)
= [x, z] :: [_d]
• Relevant bindings include
- z :: _ (bound at WildcardsInPatternAndExprSig.hs:4:44)
- x :: _ (bound at WildcardsInPatternAndExprSig.hs:4:13)
- bar :: Maybe [_] -> _ -> [_]
+ z :: w (bound at WildcardsInPatternAndExprSig.hs:4:44)
+ x :: w (bound at WildcardsInPatternAndExprSig.hs:4:13)
+ bar :: Maybe [w] -> w -> [w]
(bound at WildcardsInPatternAndExprSig.hs:4:1)
diff --git a/testsuite/tests/partial-sigs/should_run/T15415.stderr b/testsuite/tests/partial-sigs/should_run/T15415.stderr
index a43f80e6bd..1070a07ca8 100644
--- a/testsuite/tests/partial-sigs/should_run/T15415.stderr
+++ b/testsuite/tests/partial-sigs/should_run/T15415.stderr
@@ -1,8 +1,8 @@
<interactive>:1:7: error:
- • Found type wildcard ‘_’ standing for ‘_0 :: k0’
+ • Found type wildcard ‘_’ standing for ‘w0 :: k0’
Where: ‘k0’ is an ambiguous type variable
- ‘_0’ is an ambiguous type variable
+ ‘w0’ is an ambiguous type variable
To use the inferred type, enable PartialTypeSignatures
• In the first argument of ‘Proxy’, namely ‘_’
In the type ‘Proxy _’
@@ -15,16 +15,16 @@
In the type ‘Proxy (Maybe :: _)’
<interactive>:1:11: error:
- • Found type wildcard ‘_’ standing for ‘_0’
- Where: ‘_0’ is an ambiguous type variable
+ • Found type wildcard ‘_’ standing for ‘w0’
+ Where: ‘w0’ is an ambiguous type variable
To use the inferred type, enable PartialTypeSignatures
• In the first argument of ‘Dependent’, namely ‘_’
In the type ‘Dependent _’
<interactive>:1:7: warning: [-Wpartial-type-signatures (in -Wdefault)]
- • Found type wildcard ‘_’ standing for ‘_0 :: k0’
+ • Found type wildcard ‘_’ standing for ‘w0 :: k0’
Where: ‘k0’ is an ambiguous type variable
- ‘_0’ is an ambiguous type variable
+ ‘w0’ is an ambiguous type variable
• In the first argument of ‘Proxy’, namely ‘_’
In the type ‘Proxy _’
@@ -35,7 +35,7 @@
In the type ‘Proxy (Maybe :: _)’
<interactive>:1:11: warning: [-Wpartial-type-signatures (in -Wdefault)]
- • Found type wildcard ‘_’ standing for ‘_0’
- Where: ‘_0’ is an ambiguous type variable
+ • Found type wildcard ‘_’ standing for ‘w0’
+ Where: ‘w0’ is an ambiguous type variable
• In the first argument of ‘Dependent’, namely ‘_’
In the type ‘Dependent _’
diff --git a/testsuite/tests/partial-sigs/should_run/T15415.stdout b/testsuite/tests/partial-sigs/should_run/T15415.stdout
index 17af08faea..709da2f17c 100644
--- a/testsuite/tests/partial-sigs/should_run/T15415.stdout
+++ b/testsuite/tests/partial-sigs/should_run/T15415.stdout
@@ -1,6 +1,6 @@
Proxy _ :: *
Proxy (Maybe :: _) :: *
-Dependent _ :: _ -> *
+Dependent _ :: w -> *
Proxy _ :: *
Proxy (Maybe :: _) :: *
-Dependent _ :: _ -> *
+Dependent _ :: w -> *
diff --git a/testsuite/tests/patsyn/should_compile/T17775-singleton.hs b/testsuite/tests/patsyn/should_compile/T17775-singleton.hs
new file mode 100644
index 0000000000..651dff583a
--- /dev/null
+++ b/testsuite/tests/patsyn/should_compile/T17775-singleton.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ViewPatterns #-}
+module Bug where
+
+-- Ryan Scott (on MR !2600) said this failed
+
+type T = forall a. a -> ()
+
+toT :: () -> T
+toT x _ = x
+
+pattern ToT :: T -> ()
+pattern ToT{x} <- (toT -> x)
+
+-- f (toT -> (x::T)) = True
+
diff --git a/testsuite/tests/patsyn/should_compile/all.T b/testsuite/tests/patsyn/should_compile/all.T
index 6ef1928768..75be0c68b2 100644
--- a/testsuite/tests/patsyn/should_compile/all.T
+++ b/testsuite/tests/patsyn/should_compile/all.T
@@ -78,3 +78,4 @@ test('T14394', normal, ghci_script, ['T14394.script'])
test('T14498', normal, compile, [''])
test('T16682', [extra_files(['T16682.hs', 'T16682a.hs'])],
multimod_compile, ['T16682', '-v0 -fwarn-incomplete-patterns -fno-code'])
+test('T17775-singleton', normal, compile, [''])
diff --git a/testsuite/tests/patsyn/should_fail/T11010.stderr b/testsuite/tests/patsyn/should_fail/T11010.stderr
index 6e3aae58f5..28216760ee 100644
--- a/testsuite/tests/patsyn/should_fail/T11010.stderr
+++ b/testsuite/tests/patsyn/should_fail/T11010.stderr
@@ -1,13 +1,13 @@
T11010.hs:9:36: error:
• Couldn't match type ‘a1’ with ‘Int’
+ Expected: a -> b
+ Actual: a1 -> b
‘a1’ is a rigid type variable bound by
a pattern with constructor:
Fun :: forall a b. String -> (a -> b) -> Expr a -> Expr b,
in a pattern synonym declaration
at T11010.hs:9:26-36
- Expected type: a -> b
- Actual type: a1 -> b
• In the declaration for pattern synonym ‘IntFun’
• Relevant bindings include
x :: Expr a1 (bound at T11010.hs:9:36)
diff --git a/testsuite/tests/patsyn/should_fail/T11039.stderr b/testsuite/tests/patsyn/should_fail/T11039.stderr
index 14d67a2bb2..f8f4d35768 100644
--- a/testsuite/tests/patsyn/should_fail/T11039.stderr
+++ b/testsuite/tests/patsyn/should_fail/T11039.stderr
@@ -1,10 +1,10 @@
T11039.hs:8:15: error:
• Couldn't match type ‘f’ with ‘A’
+ Expected: f a
+ Actual: A a
‘f’ is a rigid type variable bound by
the signature for pattern synonym ‘Q’
at T11039.hs:7:1-38
- Expected type: f a
- Actual type: A a
• In the pattern: A a
In the declaration for pattern synonym ‘Q’
diff --git a/testsuite/tests/patsyn/should_fail/T14552.stderr b/testsuite/tests/patsyn/should_fail/T14552.stderr
index b9b6b8448b..34ee266cdd 100644
--- a/testsuite/tests/patsyn/should_fail/T14552.stderr
+++ b/testsuite/tests/patsyn/should_fail/T14552.stderr
@@ -1,8 +1,8 @@
T14552.hs:22:9: error:
• Cannot generalise type; skolem ‘k’ would escape its scope
- if I tried to quantify (aa0 :: k) in this type:
- forall k (w :: k --> *). Exp a0 (F @k @(*) w aa0)
+ if I tried to quantify (t0 :: k) in this type:
+ forall k (w :: k --> *). Exp a0 (F @k @(*) w t0)
(Indeed, I sometimes struggle even printing this correctly,
due to its ill-scoped nature.)
• In the declaration for pattern synonym ‘FOO’
diff --git a/testsuite/tests/patsyn/should_fail/T15685.stderr b/testsuite/tests/patsyn/should_fail/T15685.stderr
index 7f01ebc479..37627b852b 100644
--- a/testsuite/tests/patsyn/should_fail/T15685.stderr
+++ b/testsuite/tests/patsyn/should_fail/T15685.stderr
@@ -1,6 +1,11 @@
T15685.hs:13:24: error:
• Couldn't match kind ‘a1’ with ‘[k0]’
+ When matching types
+ f :: a1 -> *
+ NP a0 :: [k0] -> *
+ Expected: f a2
+ Actual: NP a0 b0
‘a1’ is untouchable
inside the constraints: as ~ (a2 : as1)
bound by a pattern with constructor:
@@ -12,11 +17,6 @@ T15685.hs:13:24: error:
the inferred type of HereNil :: NS f as
at T15685.hs:13:9-15
Possible fix: add a type signature for ‘HereNil’
- When matching types
- f :: a1 -> *
- NP a0 :: [k0] -> *
- Expected type: f a2
- Actual type: NP a0 b0
• In the pattern: Nil
In the pattern: Here Nil
In the declaration for pattern synonym ‘HereNil’
diff --git a/testsuite/tests/patsyn/should_fail/T15695.stderr b/testsuite/tests/patsyn/should_fail/T15695.stderr
index 6ef415ad9b..2e834c6d08 100644
--- a/testsuite/tests/patsyn/should_fail/T15695.stderr
+++ b/testsuite/tests/patsyn/should_fail/T15695.stderr
@@ -13,6 +13,8 @@ T15695.hs:39:14: warning: [-Wdeferred-type-errors (in -Wdefault)]
a3 -> ApplyT kind a b,
in an equation for ‘from'’
at T15695.hs:39:8-21
+ Expected: a4
+ Actual: Either (NA 'VO) a3
‘a2’ is a rigid type variable bound by
a pattern with pattern synonym:
ASSO :: forall kind (a :: kind) (b :: Ctx kind).
@@ -24,8 +26,6 @@ T15695.hs:39:14: warning: [-Wdeferred-type-errors (in -Wdefault)]
a3 -> ApplyT kind a b,
in an equation for ‘from'’
at T15695.hs:39:8-21
- Expected type: a4
- Actual type: Either (NA 'VO) a3
• In the pattern: Left a
In the pattern: ASSO (Left a)
In an equation for ‘from'’: from' (ASSO (Left a)) = Here (a :* Nil)
@@ -34,9 +34,10 @@ T15695.hs:39:14: warning: [-Wdeferred-type-errors (in -Wdefault)]
(bound at T15695.hs:39:1)
T15695.hs:40:26: warning: [-Wdeferred-type-errors (in -Wdefault)]
- • Couldn't match type ‘a0 : as0’ with ‘'[]’
- Expected type: NS (NP NA) '[ '[ 'VO]]
- Actual type: NS (NP NA) ('[ 'VO] : a0 : as0)
+ • Couldn't match type: a0 : as0
+ with: '[]
+ Expected: NS (NP NA) '[ '[ 'VO]]
+ Actual: NS (NP NA) ('[ 'VO] : a0 : as0)
• In the expression: There (Here undefined)
In an equation for ‘from'’:
from' (ASSO (Right b)) = There (Here undefined)
diff --git a/testsuite/tests/patsyn/should_fail/mono.stderr b/testsuite/tests/patsyn/should_fail/mono.stderr
index 8f370ce2f0..264579f91b 100644
--- a/testsuite/tests/patsyn/should_fail/mono.stderr
+++ b/testsuite/tests/patsyn/should_fail/mono.stderr
@@ -1,8 +1,8 @@
mono.hs:7:4: error:
• Couldn't match type ‘Bool’ with ‘Int’
- Expected type: [Bool]
- Actual type: [Int]
+ Expected: [Bool]
+ Actual: [Int]
• In the pattern: Single x
In an equation for ‘f’: f (Single x) = x
diff --git a/testsuite/tests/perf/compiler/T10547.stderr b/testsuite/tests/perf/compiler/T10547.stderr
index f0935d55f0..bd07bc120e 100644
--- a/testsuite/tests/perf/compiler/T10547.stderr
+++ b/testsuite/tests/perf/compiler/T10547.stderr
@@ -1,11 +1,11 @@
-T10547.hs:35:25:
- Couldn't match type ‘Bool’ with ‘Char’
- Expected type: (T12, Char)
- Actual type: (S12, Bool)
+T10547.hs:35:25: error:
+ • Couldn't match type ‘Bool’ with ‘Char’
+ Expected: (T12, Char)
+ Actual: (S12, Bool)
Type synonyms expanded:
Expected type: (Int, Char)
Actual type: (Int, Bool)
- In the second argument of ‘f’, namely ‘b’
+ • In the second argument of ‘f’, namely ‘b’
In the second argument of ‘const’, namely ‘(f a b)’
In the expression: const 1 (f a b)
diff --git a/testsuite/tests/perf/compiler/T16473.hs b/testsuite/tests/perf/compiler/T16473.hs
index 8a9751e306..14dc7412f2 100644
--- a/testsuite/tests/perf/compiler/T16473.hs
+++ b/testsuite/tests/perf/compiler/T16473.hs
@@ -48,7 +48,7 @@ instance Functor (Semantic f) where
{-# INLINE fmap #-}
instance Applicative (Semantic f) where
- pure a = Semantic $ const $ pure a
+ pure a = Semantic (\x -> const (pure a) x)
{-# INLINE pure #-}
Semantic f <*> Semantic a = Semantic $ \k -> f k <*> a k
{-# INLINE (<*>) #-}
diff --git a/testsuite/tests/polykinds/KindVType.stderr b/testsuite/tests/polykinds/KindVType.stderr
index feb1417675..bf8c99c03b 100644
--- a/testsuite/tests/polykinds/KindVType.stderr
+++ b/testsuite/tests/polykinds/KindVType.stderr
@@ -1,7 +1,7 @@
KindVType.hs:8:8: error:
• Couldn't match type ‘Int’ with ‘Maybe’
- Expected type: Proxy Maybe
- Actual type: Proxy Int
+ Expected: Proxy Maybe
+ Actual: Proxy Int
• In the expression: Proxy :: Proxy Int
In an equation for ‘foo’: foo = (Proxy :: Proxy Int)
diff --git a/testsuite/tests/polykinds/T10503.hs b/testsuite/tests/polykinds/T10503.hs
index 2b9900652f..d352ce720f 100644
--- a/testsuite/tests/polykinds/T10503.hs
+++ b/testsuite/tests/polykinds/T10503.hs
@@ -1,9 +1,10 @@
{-# LANGUAGE RankNTypes, PolyKinds, DataKinds, TypeFamilies #-}
module GHCBug where
+import Data.Kind
data Proxy p = Proxy
-data KProxy (a :: *) = KProxy
+data KProxy (a :: Type) = KProxy
-h :: forall k r . (Proxy ('KProxy :: KProxy k) ~ Proxy ('KProxy :: KProxy *) => r) -> r
-h = undefined
+h :: forall k r . (Proxy ('KProxy :: KProxy k) ~ Proxy ('KProxy :: KProxy Type) => r) -> r
+h x = undefined
diff --git a/testsuite/tests/polykinds/T10503.stderr b/testsuite/tests/polykinds/T10503.stderr
deleted file mode 100644
index 0895bdba26..0000000000
--- a/testsuite/tests/polykinds/T10503.stderr
+++ /dev/null
@@ -1,17 +0,0 @@
-
-T10503.hs:8:6: error:
- • Could not deduce: k ~ *
- from the context: Proxy 'KProxy ~ Proxy 'KProxy
- bound by a type expected by the context:
- (Proxy 'KProxy ~ Proxy 'KProxy) => r
- at T10503.hs:8:6-87
- ‘k’ is a rigid type variable bound by
- the type signature for:
- h :: forall k r. ((Proxy 'KProxy ~ Proxy 'KProxy) => r) -> r
- at T10503.hs:8:6-87
- • In the ambiguity check for ‘h’
- To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
- In the type signature:
- h :: forall k r.
- (Proxy ('KProxy :: KProxy k) ~ Proxy ('KProxy :: KProxy (*)) => r)
- -> r
diff --git a/testsuite/tests/polykinds/T11142.stderr b/testsuite/tests/polykinds/T11142.stderr
index 4f5c5fcf29..780bbdc63f 100644
--- a/testsuite/tests/polykinds/T11142.stderr
+++ b/testsuite/tests/polykinds/T11142.stderr
@@ -1,17 +1,10 @@
T11142.hs:9:49: error:
- • Expected kind ‘k1’, but ‘b’ has kind ‘k0’
+ • Expected kind ‘k’, but ‘b’ has kind ‘k0’
+ because kind variable ‘k’ would escape its scope
+ This (rigid, skolem) kind variable is bound by
+ ‘forall k (a :: k). SameKind a b’
+ at T11142.hs:9:19-49
• In the second argument of ‘SameKind’, namely ‘b’
In the type signature:
foo :: forall b. (forall k (a :: k). SameKind a b) -> ()
-
-T11142.hs:10:7: error:
- • Cannot instantiate unification variable ‘a0’
- with a type involving polytypes:
- (forall k1 (a :: k1). SameKind a b) -> ()
- GHC doesn't yet support impredicative polymorphism
- • In the expression: undefined
- In an equation for ‘foo’: foo = undefined
- • Relevant bindings include
- foo :: (forall k1 (a :: k1). SameKind a b) -> ()
- (bound at T11142.hs:10:1)
diff --git a/testsuite/tests/polykinds/T12444.stderr b/testsuite/tests/polykinds/T12444.stderr
index 0ebd2986cf..0a75b049ec 100644
--- a/testsuite/tests/polykinds/T12444.stderr
+++ b/testsuite/tests/polykinds/T12444.stderr
@@ -1,13 +1,13 @@
T12444.hs:19:11: error:
• Couldn't match type ‘b’ with ‘'Succ (c :+: b)’
+ Expected: SNat ('Succ (c :+: b))
+ Actual: SNat b
‘b’ is a rigid type variable bound by
the type signature for:
foo :: forall (c :: Nat) (b :: Nat).
SNat ('Succ c) -> SNat b -> SNat ('Succ (c :+: b))
at T12444.hs:18:1-55
- Expected type: SNat ('Succ (c :+: b))
- Actual type: SNat b
• In the expression: x
In an equation for ‘foo’: foo _ x = x
• Relevant bindings include
diff --git a/testsuite/tests/polykinds/T12593.stderr b/testsuite/tests/polykinds/T12593.stderr
index fcf194ba50..5ce7b07187 100644
--- a/testsuite/tests/polykinds/T12593.stderr
+++ b/testsuite/tests/polykinds/T12593.stderr
@@ -1,9 +1,16 @@
+T12593.hs:11:16: error:
+ • Expected kind ‘k0 -> k1 -> *’, but ‘Free k k1 k2 p’ has kind ‘*’
+ • In the type signature:
+ run :: k2 q =>
+ Free k k1 k2 p a b
+ -> (forall (c :: k) (d :: k1). p c d -> q c d) -> q a b
+
T12593.hs:12:31: error:
• Expecting one more argument to ‘k’
Expected a type, but
‘k’ has kind
- ‘((k0 -> Constraint) -> k1 -> *) -> Constraint’
+ ‘((k2 -> Constraint) -> k3 -> *) -> Constraint’
• In the kind ‘k’
In the type signature:
run :: k2 q =>
diff --git a/testsuite/tests/polykinds/T14172.stderr b/testsuite/tests/polykinds/T14172.stderr
index 6a0d3927eb..d27f45bb9c 100644
--- a/testsuite/tests/polykinds/T14172.stderr
+++ b/testsuite/tests/polykinds/T14172.stderr
@@ -11,12 +11,10 @@ T14172.hs:6:46: error:
In the type ‘(a -> f b) -> g a -> f (h _)’
T14172.hs:7:19: error:
- • Occurs check: cannot construct the infinite type: a ~ g'0 a
- Expected type: (f'0 a -> f (f'0 b))
- -> Compose f'0 g'0 a -> f (h a')
- Actual type: (Unwrapped (Compose f'0 g'0 a)
- -> f (Unwrapped (h a')))
- -> Compose f'0 g'0 a -> f (h a')
+ • Couldn't match type ‘a’ with ‘g'0 a’
+ Expected: (f'0 a -> f (f'0 b)) -> Compose f'0 g'0 a -> f (h a')
+ Actual: (Unwrapped (Compose f'0 g'0 a) -> f (Unwrapped (h a')))
+ -> Compose f'0 g'0 a -> f (h a')
• In the first argument of ‘(.)’, namely ‘_Wrapping Compose’
In the expression: _Wrapping Compose . traverse
In an equation for ‘traverseCompose’:
diff --git a/testsuite/tests/polykinds/T14265.stderr b/testsuite/tests/polykinds/T14265.stderr
index fa951ad920..cf3ab9acf3 100644
--- a/testsuite/tests/polykinds/T14265.stderr
+++ b/testsuite/tests/polykinds/T14265.stderr
@@ -1,8 +1,8 @@
T14265.hs:7:12: error:
- • Found type wildcard ‘_’ standing for ‘_ :: k’
- Where: ‘k’, ‘_’ are rigid type variables bound by
- the inferred type of f :: proxy _ -> ()
+ • Found type wildcard ‘_’ standing for ‘w :: k’
+ Where: ‘k’, ‘w’ are rigid type variables bound by
+ the inferred type of f :: proxy w -> ()
at T14265.hs:8:1-8
To use the inferred type, enable PartialTypeSignatures
• In the first argument of ‘proxy’, namely ‘_’
@@ -10,9 +10,9 @@ T14265.hs:7:12: error:
In the type signature: f :: proxy _ -> ()
T14265.hs:10:15: error:
- • Found type wildcard ‘_’ standing for ‘_’
- Where: ‘_’ is a rigid type variable bound by
- the inferred type of foo :: StateT _ _1 ()
+ • Found type wildcard ‘_’ standing for ‘w’
+ Where: ‘w’ is a rigid type variable bound by
+ the inferred type of foo :: StateT w w1 ()
at T14265.hs:11:1-15
To use the inferred type, enable PartialTypeSignatures
• In the first argument of ‘StateT’, namely ‘_’
@@ -20,9 +20,9 @@ T14265.hs:10:15: error:
In the type signature: foo :: StateT _ _ ()
T14265.hs:10:17: error:
- • Found type wildcard ‘_’ standing for ‘_1 :: * -> *’
- Where: ‘_1’ is a rigid type variable bound by
- the inferred type of foo :: StateT _ _1 ()
+ • Found type wildcard ‘_’ standing for ‘w1 :: * -> *’
+ Where: ‘w1’ is a rigid type variable bound by
+ the inferred type of foo :: StateT w w1 ()
at T14265.hs:11:1-15
To use the inferred type, enable PartialTypeSignatures
• In the second argument of ‘StateT’, namely ‘_’
diff --git a/testsuite/tests/polykinds/T14520.stderr b/testsuite/tests/polykinds/T14520.stderr
index b8a1ed1bf0..20e1b5cf33 100644
--- a/testsuite/tests/polykinds/T14520.stderr
+++ b/testsuite/tests/polykinds/T14520.stderr
@@ -2,5 +2,6 @@
T14520.hs:15:24: error:
• Expected kind ‘bat w w’,
but ‘Id’ has kind ‘XXX @a0 @(*) (XXX @a0 @(a0 ~>> *) kat0 b0) b0’
+ The type variables ‘kat0’, ‘b0’ are ambiguous
• In the first argument of ‘Sing’, namely ‘(Id :: bat w w)’
In the type signature: sId :: Sing w -> Sing (Id :: bat w w)
diff --git a/testsuite/tests/polykinds/T14555.stderr b/testsuite/tests/polykinds/T14555.stderr
index 66fb55ae4f..3861872124 100644
--- a/testsuite/tests/polykinds/T14555.stderr
+++ b/testsuite/tests/polykinds/T14555.stderr
@@ -1,6 +1,7 @@
T14555.hs:12:34: error:
- • Expected kind ‘TYPE rep’, but ‘a -> b’ has kind ‘*’
+ • Couldn't match kind ‘rep’ with ‘'GHC.Types.LiftedRep’
+ Expected kind ‘TYPE rep’, but ‘a -> b’ has kind ‘*’
• In the second argument of ‘Exp’, namely ‘(a -> b)’
In the type ‘Exp xs (a -> b)’
In the definition of data constructor ‘Lam’
diff --git a/testsuite/tests/polykinds/T14563.stderr b/testsuite/tests/polykinds/T14563.stderr
index 1265ec0e3a..2d81507659 100644
--- a/testsuite/tests/polykinds/T14563.stderr
+++ b/testsuite/tests/polykinds/T14563.stderr
@@ -1,6 +1,7 @@
T14563.hs:9:39: error:
- • Expected kind ‘TYPE rep -> TYPE rep''’,
+ • Couldn't match kind ‘rep''’ with ‘'GHC.Types.LiftedRep’
+ Expected kind ‘TYPE rep -> TYPE rep''’,
but ‘h’ has kind ‘TYPE rep -> *’
• In the second argument of ‘Lan’, namely ‘h’
In the type ‘Lan g h a’
diff --git a/testsuite/tests/polykinds/T14580.stderr b/testsuite/tests/polykinds/T14580.stderr
index 8658a8484a..154e191f7e 100644
--- a/testsuite/tests/polykinds/T14580.stderr
+++ b/testsuite/tests/polykinds/T14580.stderr
@@ -1,6 +1,7 @@
T14580.hs:8:32: error:
- • Expected kind ‘Cat a’, but ‘iso :: cat a b’ has kind ‘cat a b’
+ • Couldn't match kind ‘b’ with ‘a -> *’
+ Expected kind ‘Cat a’, but ‘iso :: cat a b’ has kind ‘cat a b’
• In the first argument of ‘ISO’, namely ‘(iso :: cat a b)’
In the type ‘ISO (iso :: cat a b)’
In the type declaration for ‘<-->’
diff --git a/testsuite/tests/polykinds/T14846.stderr b/testsuite/tests/polykinds/T14846.stderr
index edb19408b2..2d49b819a0 100644
--- a/testsuite/tests/polykinds/T14846.stderr
+++ b/testsuite/tests/polykinds/T14846.stderr
@@ -1,6 +1,8 @@
T14846.hs:38:8: error:
• Couldn't match type ‘ríki’ with ‘Hom riki’
+ Expected: ríki a a
+ Actual: Hom riki a a
‘ríki’ is a rigid type variable bound by
the type signature for:
i :: forall {k5} {k6} {cls3 :: k6 -> Constraint} (xx :: k5)
@@ -8,8 +10,6 @@ T14846.hs:38:8: error:
StructI xx a =>
ríki a a
at T14846.hs:38:8-48
- Expected type: ríki a a
- Actual type: Hom riki a a
• When checking that instance signature for ‘i’
is more general than its signature in the class
Instance sig: forall {k1} {k2} {cls :: k2 -> Constraint} (xx :: k1)
@@ -22,35 +22,13 @@ T14846.hs:38:8: error:
ríki a a
In the instance declaration for ‘Category (Hom riki)’
-T14846.hs:39:12: error:
- • Could not deduce (StructI xx1 structured0)
- arising from a use of ‘struct’
- from the context: Category riki
- bound by the instance declaration at T14846.hs:37:10-65
- or from: StructI xx a
- bound by the type signature for:
- i :: forall {k5} {k6} {cls3 :: k6 -> Constraint} (xx :: k5)
- (a :: Struct cls3).
- StructI xx a =>
- Hom riki a a
- at T14846.hs:38:8-48
- The type variables ‘xx1’, ‘structured0’ are ambiguous
- Relevant bindings include
- i :: Hom riki a a (bound at T14846.hs:39:3)
- These potential instance exist:
- instance forall k (xx :: k) (cls :: k -> Constraint)
- (structured :: Struct cls).
- (Structured xx cls ~ structured, cls xx) =>
- StructI xx structured
- -- Defined at T14846.hs:28:10
- • In the expression: struct :: AStruct (Structured a cls)
- In the expression: case struct :: AStruct (Structured a cls) of
- In an equation for ‘i’:
- i = case struct :: AStruct (Structured a cls) of
-
T14846.hs:39:44: error:
- • Expected kind ‘Struct cls3 -> Constraint’,
+ • Couldn't match kind ‘k4’ with ‘Struct cls3’
+ Expected kind ‘Struct cls3 -> Constraint’,
but ‘cls’ has kind ‘k4 -> Constraint’
+ ‘k4’ is a rigid type variable bound by
+ the instance declaration
+ at T14846.hs:37:10-65
• In the second argument of ‘Structured’, namely ‘cls’
In the first argument of ‘AStruct’, namely ‘(Structured a cls)’
In an expression type signature: AStruct (Structured a cls)
diff --git a/testsuite/tests/polykinds/T15881.stderr b/testsuite/tests/polykinds/T15881.stderr
index 8f395735db..47cc5abf5c 100644
--- a/testsuite/tests/polykinds/T15881.stderr
+++ b/testsuite/tests/polykinds/T15881.stderr
@@ -1,6 +1,6 @@
T15881.hs:8:18: error:
- • Occurs check: cannot construct the infinite kind: k0 ~ k0 -> *
+ • Expected kind ‘k0’, but ‘n’ has kind ‘k0 -> *’
• In the first argument of ‘n’, namely ‘n’
In the kind ‘n n’
In the data type declaration for ‘A’
diff --git a/testsuite/tests/polykinds/T16244.stderr b/testsuite/tests/polykinds/T16244.stderr
index d261a70ba3..6b932ad285 100644
--- a/testsuite/tests/polykinds/T16244.stderr
+++ b/testsuite/tests/polykinds/T16244.stderr
@@ -1,6 +1,6 @@
T16244.hs:11:18: error:
- • Couldn't match kind ‘k1’ with ‘k’
+ • Expected kind ‘k’, but ‘b’ has kind ‘k1’
‘k1’ is a rigid type variable bound by
the class declaration for ‘C’
at T16244.hs:11:26
diff --git a/testsuite/tests/polykinds/T16245.stderr b/testsuite/tests/polykinds/T16245.stderr
index e478fe4e5f..4f7cc415c2 100644
--- a/testsuite/tests/polykinds/T16245.stderr
+++ b/testsuite/tests/polykinds/T16245.stderr
@@ -1,6 +1,6 @@
T16245.hs:11:36: error:
- • Couldn't match kind ‘k1’ with ‘k’
+ • Expected kind ‘k’, but ‘b’ has kind ‘k1’
‘k1’ is a rigid type variable bound by
the class declaration for ‘C’
at T16245.hs:11:45
diff --git a/testsuite/tests/polykinds/T17841.stderr b/testsuite/tests/polykinds/T17841.stderr
index 6157f55399..11243a4322 100644
--- a/testsuite/tests/polykinds/T17841.stderr
+++ b/testsuite/tests/polykinds/T17841.stderr
@@ -1,6 +1,9 @@
T17841.hs:7:45: error:
• Expected a type, but ‘t’ has kind ‘k2’
+ ‘k2’ is a rigid type variable bound by
+ the class declaration for ‘Foo’
+ at T17841.hs:7:17
• In the kind ‘t’
In the first argument of ‘Proxy’, namely ‘(a :: t)’
In the type signature: foo :: Proxy (a :: t)
diff --git a/testsuite/tests/polykinds/T17963.stderr b/testsuite/tests/polykinds/T17963.stderr
index 84201e0de4..5cade1ded2 100644
--- a/testsuite/tests/polykinds/T17963.stderr
+++ b/testsuite/tests/polykinds/T17963.stderr
@@ -1,13 +1,12 @@
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
+ • Couldn't match kind ‘rep1’ with ‘'LiftedRep’
When matching kinds
k0 :: *
ob :: TYPE rep1
- Expected kind ‘ob’, but ‘a’ has kind ‘k0’
+ ‘rep1’ is a rigid type variable bound by
+ the class declaration for ‘Category'’
+ at T17963.hs:13:27-29
• In the first argument of ‘cat’, namely ‘a’
In the type signature: id' :: forall a. cat a a
In the class declaration for ‘Category'’
diff --git a/testsuite/tests/polykinds/T7224.stderr b/testsuite/tests/polykinds/T7224.stderr
index 774a4bce69..c9d2236206 100644
--- a/testsuite/tests/polykinds/T7224.stderr
+++ b/testsuite/tests/polykinds/T7224.stderr
@@ -1,12 +1,18 @@
T7224.hs:6:19: error:
• Expected kind ‘i’, but ‘i’ has kind ‘*’
+ ‘i’ is a rigid type variable bound by
+ the class declaration for ‘PMonad'’
+ at T7224.hs:5:21
• In the first argument of ‘m’, namely ‘i’
In the type signature: ret' :: a -> m i i a
In the class declaration for ‘PMonad'’
T7224.hs:7:14: error:
• Expected kind ‘i’, but ‘i’ has kind ‘*’
+ ‘i’ is a rigid type variable bound by
+ the class declaration for ‘PMonad'’
+ at T7224.hs:5:21
• In the first argument of ‘m’, namely ‘i’
In the type signature:
bind' :: m i j a -> (a -> m j k b) -> m i k b
diff --git a/testsuite/tests/polykinds/T7230.stderr b/testsuite/tests/polykinds/T7230.stderr
index 5c5055ea2a..f59e44d5cd 100644
--- a/testsuite/tests/polykinds/T7230.stderr
+++ b/testsuite/tests/polykinds/T7230.stderr
@@ -19,8 +19,8 @@ T7230.hs:48:32: error:
Sing x -> Sing xs -> Sing (x : xs),
in an equation for ‘crash’
at T7230.hs:48:17-26
- Expected type: SBool (Increasing xs)
- Actual type: SBool (x :<<= x1)
+ Expected: SBool (Increasing xs)
+ Actual: SBool (x :<<= x1)
• In the expression: x %:<<= y
In an equation for ‘crash’:
crash (SCons x (SCons y xs)) = x %:<<= y
diff --git a/testsuite/tests/polykinds/T7278.stderr b/testsuite/tests/polykinds/T7278.stderr
index 37b00a7a70..5f4ff6d18f 100644
--- a/testsuite/tests/polykinds/T7278.stderr
+++ b/testsuite/tests/polykinds/T7278.stderr
@@ -1,5 +1,8 @@
T7278.hs:9:43: error:
- • Expected kind ‘* -> * -> *’, but ‘t’ has kind ‘k1’
+ • Expected kind ‘* -> * -> *’, but ‘t’ has kind ‘k’
+ ‘k’ is a rigid type variable bound by
+ the type signature for ‘f’
+ at T7278.hs:9:1-49
• In the type signature:
f :: (C (t :: k) (TF t)) => TF t p1 p0 -> t p1 p0
diff --git a/testsuite/tests/polykinds/T7328.stderr b/testsuite/tests/polykinds/T7328.stderr
index 76f81555dd..d1ba591512 100644
--- a/testsuite/tests/polykinds/T7328.stderr
+++ b/testsuite/tests/polykinds/T7328.stderr
@@ -1,6 +1,6 @@
T7328.hs:8:34: error:
- • Occurs check: cannot construct the infinite kind: k1 ~ k0 -> k1
+ • Expected kind ‘k1’, but ‘f’ has kind ‘k0 -> k1’
• In the first argument of ‘Foo’, namely ‘f’
In the first argument of ‘Proxy’, namely ‘(Foo f)’
In the type signature: foo :: a ~ f i => Proxy (Foo f)
diff --git a/testsuite/tests/polykinds/T7594.stderr b/testsuite/tests/polykinds/T7594.stderr
index 5632e97707..ea5484d464 100644
--- a/testsuite/tests/polykinds/T7594.stderr
+++ b/testsuite/tests/polykinds/T7594.stderr
@@ -1,6 +1,8 @@
T7594.hs:37:12: error:
• Couldn't match type ‘b’ with ‘IO ()’
+ Expected: a -> b
+ Actual: a -> IO ()
‘b’ is untouchable
inside the constraints: (:&:) c0 Real a
bound by a type expected by the context:
@@ -10,8 +12,6 @@ T7594.hs:37:12: error:
the inferred type of bar2 :: b
at T7594.hs:37:1-19
Possible fix: add a type signature for ‘bar2’
- Expected type: a -> b
- Actual type: a -> IO ()
• In the first argument of ‘app’, namely ‘print’
In the expression: app print q2
In an equation for ‘bar2’: bar2 = app print q2
diff --git a/testsuite/tests/polykinds/T7805.stderr b/testsuite/tests/polykinds/T7805.stderr
index 9ca48645be..869ecc9200 100644
--- a/testsuite/tests/polykinds/T7805.stderr
+++ b/testsuite/tests/polykinds/T7805.stderr
@@ -1,6 +1,8 @@
T7805.hs:7:21: error:
- Expected kind ‘forall a. a -> a’, but ‘x’ has kind ‘k0’
- In the first argument of ‘HR’, namely ‘x’
- In the first argument of ‘F’, namely ‘(HR x)’
- In the type instance declaration for ‘F’
+ • Expected kind ‘forall a. a -> a’, but ‘x’ has kind ‘k0’
+ Cannot instantiate unification variable ‘k0’
+ with a kind involving polytypes: forall a. a -> a
+ • In the first argument of ‘HR’, namely ‘x’
+ In the first argument of ‘F’, namely ‘(HR x)’
+ In the type instance declaration for ‘F’
diff --git a/testsuite/tests/polykinds/T8616.stderr b/testsuite/tests/polykinds/T8616.stderr
index 2a8b6482aa..653f3beb1a 100644
--- a/testsuite/tests/polykinds/T8616.stderr
+++ b/testsuite/tests/polykinds/T8616.stderr
@@ -1,24 +1,15 @@
T8616.hs:8:16: error:
• Couldn't match kind ‘k1’ with ‘*’
+ When matching types
+ Any :: k1
+ Proxy kproxy :: *
‘k1’ is a rigid type variable bound by
the type signature for:
withSomeSing :: forall k1 (kproxy :: k1). Proxy kproxy
at T8616.hs:7:1-52
- When matching types
- a0 :: *
- Any :: k1
• In the expression: undefined :: (Any :: k)
In an equation for ‘withSomeSing’:
withSomeSing = undefined :: (Any :: k)
• Relevant bindings include
withSomeSing :: Proxy kproxy (bound at T8616.hs:8:1)
-
-T8616.hs:8:30: error:
- • Expected a type, but ‘Any :: k’ has kind ‘k1’
- • In an expression type signature: (Any :: k)
- In the expression: undefined :: (Any :: k)
- In an equation for ‘withSomeSing’:
- withSomeSing = undefined :: (Any :: k)
- • Relevant bindings include
- withSomeSing :: Proxy kproxy (bound at T8616.hs:8:1)
diff --git a/testsuite/tests/polykinds/T9017.stderr b/testsuite/tests/polykinds/T9017.stderr
index 8acf58c9b5..2fc5bb1792 100644
--- a/testsuite/tests/polykinds/T9017.stderr
+++ b/testsuite/tests/polykinds/T9017.stderr
@@ -1,17 +1,17 @@
T9017.hs:8:7: error:
• Couldn't match kind ‘k2’ with ‘*’
+ When matching types
+ a0 :: * -> * -> *
+ a :: k2 -> k3 -> *
+ Expected: a b (m b)
+ Actual: a0 b0 (m0 b0)
‘k2’ is a rigid type variable bound by
the type signature for:
foo :: forall {k2} {k3} (a :: k2 -> k3 -> *) (b :: k2)
(m :: k2 -> k3).
a b (m b)
at T9017.hs:7:1-16
- When matching types
- a0 :: * -> * -> *
- a :: k2 -> k3 -> *
- Expected type: a b (m b)
- Actual type: a0 a1 (m0 a1)
• In the expression: arr return
In an equation for ‘foo’: foo = arr return
• Relevant bindings include
diff --git a/testsuite/tests/polykinds/T9144.stderr b/testsuite/tests/polykinds/T9144.stderr
index f58a57254b..dc3e13ed11 100644
--- a/testsuite/tests/polykinds/T9144.stderr
+++ b/testsuite/tests/polykinds/T9144.stderr
@@ -1,8 +1,8 @@
T9144.hs:34:26: error:
• Couldn't match type ‘Integer’ with ‘FooTerm’
- Expected type: DemoteRep @Nat ('KProxy @Nat)
- Actual type: DemoteRep @Foo ('KProxy @Foo)
+ Expected: DemoteRep @Nat ('KProxy @Nat)
+ Actual: DemoteRep @Foo ('KProxy @Foo)
• In the first argument of ‘toSing’, namely ‘n’
In the expression: toSing n
In the expression:
diff --git a/testsuite/tests/polykinds/T9222.hs b/testsuite/tests/polykinds/T9222.hs
index 3af1458427..d033b4016f 100644
--- a/testsuite/tests/polykinds/T9222.hs
+++ b/testsuite/tests/polykinds/T9222.hs
@@ -10,5 +10,8 @@ import Data.Proxy
-- So this program is erroneous. (But the original ticket was
-- a crash, and that's still fixed!)
+-- Apr 2020: with simple subsumption (#17775), the type isn't
+-- ambiguous any more
+
data Want :: (i,j) -> Type where
Want :: (a ~ '(b,c) => Proxy b) -> Want a
diff --git a/testsuite/tests/polykinds/T9222.stderr b/testsuite/tests/polykinds/T9222.stderr
deleted file mode 100644
index c8e98be09a..0000000000
--- a/testsuite/tests/polykinds/T9222.stderr
+++ /dev/null
@@ -1,17 +0,0 @@
-
-T9222.hs:14:3: error:
- • Couldn't match type ‘c0’ with ‘c’
- ‘c0’ is untouchable
- inside the constraints: a ~ '(b0, c0)
- bound by a type expected by the context:
- (a ~ '(b0, c0)) => Proxy b0
- at T9222.hs:14:3-43
- ‘c’ is a rigid type variable bound by
- the type of the constructor ‘Want’:
- forall {k1} {j1} (a :: (k1, j1)) (b :: k1) (c :: j1).
- ((a ~ '(b, c)) => Proxy b) -> Want a
- at T9222.hs:14:3-43
- • In the ambiguity check for ‘Want’
- To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
- In the definition of data constructor ‘Want’
- In the data type declaration for ‘Want’
diff --git a/testsuite/tests/polykinds/T9569.hs b/testsuite/tests/polykinds/T9569.hs
index 634d742803..112037461a 100644
--- a/testsuite/tests/polykinds/T9569.hs
+++ b/testsuite/tests/polykinds/T9569.hs
@@ -9,18 +9,42 @@ data Proxy (c :: Constraint)
class Deferrable (c :: Constraint) where
defer :: Proxy c -> (c => a) -> a
-deferPair :: (Deferrable c1, Deferrable c2) =>
- Proxy (c1,c2) -> ((c1,c2) => a) -> a
+deferPair :: (Deferrable c1, Deferrable c2)
+ => Proxy (c1,c2) -> (((c1,c2) :: Constraint) => a) -> a
+ -- NB: ((c1,c2) :: Constraint) => blah
+ -- is different form
+ -- (c1,c2) => blah
+ -- The former has dict, the latter has two
deferPair _ _ = undefined
instance (Deferrable c1, Deferrable c2) => Deferrable (c1,c2) where
-- defer p f = deferPair p f -- Succeeds
defer = deferPair -- Fails
+{- Notes Apr 2020.
+~~~~~~~~~~~~~~~~~
+Note the careful type for deferPair! You can also say
+
+deferPair :: (Deferrable c1, Deferrable c2, d ~ (c1,c2))
+ => Proxy (c1,c2) -> (d => a) -> a
+
+but NOT
+
+deferPair :: (Deferrable c1, Deferrable c2)
+ => Proxy (c1,c2) -> ((c1,c2) => a) -> a
+
+The point is that
+ (c1,c2) => a
+is short for
+ c1 => c2 => a
+-}
+
{-
[G] Deferrable c1, Deferrable c2
- [W] Proxy (c1,c2) -> ((c1,c2) => a) -> a ~ Proxy (c1x,c2x) -> ((c1x,c2x) => ax) -> ax
+ [W] Proxy (c1,c2) -> ((c1,c2) => a) -> a
+ ~
+ Proxy (c1x,c2x) -> ((c1x,c2x) => ax) -> ax
[w] Deferrable c1x
[w] Deferrable c2x
-}
diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T
index 87ee448e32..592c6b2fec 100644
--- a/testsuite/tests/polykinds/all.T
+++ b/testsuite/tests/polykinds/all.T
@@ -97,7 +97,7 @@ test('T8705', normal, compile, [''])
test('T8985', normal, compile, [''])
test('T9106', normal, compile_fail, [''])
test('T9144', normal, compile_fail, [''])
-test('T9222', normal, compile_fail, [''])
+test('T9222', normal, compile, [''])
test('T9264', normal, compile, [''])
test('T9263', normal, makefile_test, [])
test('T9063', normal, compile, [''])
@@ -114,7 +114,7 @@ test('PolyInstances', normal, compile, [''])
test('T10041', normal, compile, [''])
test('T10451', normal, compile_fail, [''])
test('T10516', normal, compile_fail, [''])
-test('T10503', normal, compile_fail, [''])
+test('T10503', normal, compile, [''])
test('T10570', normal, compile_fail, [''])
test('T10670', normal, compile, [''])
test('T10670a', normal, compile, [''])
diff --git a/testsuite/tests/quantified-constraints/T15290a.stderr b/testsuite/tests/quantified-constraints/T15290a.stderr
index 2efd784f31..7513fa4f9b 100644
--- a/testsuite/tests/quantified-constraints/T15290a.stderr
+++ b/testsuite/tests/quantified-constraints/T15290a.stderr
@@ -1,21 +1,19 @@
T15290a.hs:25:12: error:
- • Couldn't match representation of type ‘m (Int, IntStateT m a1)’
- with that of ‘m (Int, StateT Int m a1)’
+ • Couldn't match representation of type: m (Int, IntStateT m a1)
+ with that of: m (Int, StateT Int m a1)
arising from a use of ‘coerce’
NB: We cannot know what roles the parameters to ‘m’ have;
we must assume that the role is nominal
• In the expression:
coerce
@(forall a. StateT Int m (StateT Int m a) -> StateT Int m a)
- @(forall a. IntStateT m (IntStateT m a) -> IntStateT m a)
- join
+ @(forall a. IntStateT m (IntStateT m a) -> IntStateT m a) join
In an equation for ‘join’:
join
= coerce
@(forall a. StateT Int m (StateT Int m a) -> StateT Int m a)
- @(forall a. IntStateT m (IntStateT m a) -> IntStateT m a)
- join
+ @(forall a. IntStateT m (IntStateT m a) -> IntStateT m a) join
In the instance declaration for ‘Monad (IntStateT m)’
• Relevant bindings include
join :: IntStateT m (IntStateT m a) -> IntStateT m a
diff --git a/testsuite/tests/quantified-constraints/T15290b.stderr b/testsuite/tests/quantified-constraints/T15290b.stderr
index 7dc1852c6d..1c96359d96 100644
--- a/testsuite/tests/quantified-constraints/T15290b.stderr
+++ b/testsuite/tests/quantified-constraints/T15290b.stderr
@@ -1,7 +1,7 @@
T15290b.hs:28:49: error:
- • Couldn't match representation of type ‘f (m b)’
- with that of ‘f (T1 m b)’
+ • Couldn't match representation of type: f (m b)
+ with that of: f (T1 m b)
arising from the coercion of the method ‘traverse'’
from type ‘forall (f :: * -> *) a b.
Applicative' f =>
diff --git a/testsuite/tests/quantified-constraints/T15918.stderr b/testsuite/tests/quantified-constraints/T15918.stderr
index fa06b0e3f4..4ee54563c5 100644
--- a/testsuite/tests/quantified-constraints/T15918.stderr
+++ b/testsuite/tests/quantified-constraints/T15918.stderr
@@ -1,7 +1,7 @@
T15918.hs:19:19: error:
- • Expected kind ‘(k0 -> *) -> Constraint’,
- but ‘[]’ has kind ‘* -> *’
+ • Couldn't match kind ‘*’ with ‘k0 -> *’
+ Expected kind ‘(k0 -> *) -> Constraint’, but ‘[]’ has kind ‘* -> *’
• In the first argument of ‘Build’, namely ‘[]’
In an expression type signature: Build [] a
In the expression: rev :: Build [] a
diff --git a/testsuite/tests/rebindable/DoParamM.stderr b/testsuite/tests/rebindable/DoParamM.stderr
index 8d3764067e..41b56ecb07 100644
--- a/testsuite/tests/rebindable/DoParamM.stderr
+++ b/testsuite/tests/rebindable/DoParamM.stderr
@@ -7,8 +7,8 @@ DoParamM.hs:146:25: error:
DoParamM.hs:286:28: error:
• Couldn't match type ‘Unlocked’ with ‘Locked’
- Expected type: LIO Locked Locked ()
- Actual type: LIO Unlocked Locked ()
+ Expected: LIO Locked Locked ()
+ Actual: LIO Unlocked Locked ()
• In a stmt of a 'do' block: tlock2_do
In the expression:
do tlock2_do
@@ -20,8 +20,8 @@ DoParamM.hs:286:28: error:
DoParamM.hs:302:37: error:
• Couldn't match type ‘Locked’ with ‘Unlocked’
- Expected type: LIO Unlocked Unlocked ()
- Actual type: LIO Locked Unlocked ()
+ Expected: LIO Unlocked Unlocked ()
+ Actual: LIO Locked Unlocked ()
• In a stmt of a 'do' block: unlock
In the expression:
do tlock2_do
diff --git a/testsuite/tests/rename/should_fail/T2993.stderr b/testsuite/tests/rename/should_fail/T2993.stderr
index 4cae65ae88..4542ffeaf0 100644
--- a/testsuite/tests/rename/should_fail/T2993.stderr
+++ b/testsuite/tests/rename/should_fail/T2993.stderr
@@ -1,4 +1,4 @@
T2993.hs:7:13: error:
- • Variable not in scope: (<**>) :: t -> (b -> b) -> t1
+ • Variable not in scope: (<**>) :: t -> (a -> a) -> t1
• Perhaps you meant ‘<*>’ (imported from Prelude)
diff --git a/testsuite/tests/saks/should_fail/saks007_fail.stderr b/testsuite/tests/saks/should_fail/saks007_fail.stderr
index 431b5dede9..367cb8e022 100644
--- a/testsuite/tests/saks/should_fail/saks007_fail.stderr
+++ b/testsuite/tests/saks/should_fail/saks007_fail.stderr
@@ -1,8 +1,8 @@
saks007_fail.hs:15:10: error:
• Couldn't match kind ‘'True’ with ‘'False’
- Expected kind: G (*)
- Actual kind: F (*)
+ Expected: G (*)
+ Actual: F (*)
• In the type ‘X Integer String’
In the definition of data constructor ‘MkX’
In the data declaration for ‘X’
diff --git a/testsuite/tests/saks/should_fail/saks_fail019.stderr b/testsuite/tests/saks/should_fail/saks_fail019.stderr
index 5bdb26a933..30882c15ec 100644
--- a/testsuite/tests/saks/should_fail/saks_fail019.stderr
+++ b/testsuite/tests/saks/should_fail/saks_fail019.stderr
@@ -1,6 +1,6 @@
saks_fail019.hs:9:1: error:
• Couldn't match kind ‘a’ with ‘*’
- Expected kind: a -> *
- Actual kind: * -> *
+ Expected: a -> *
+ Actual: * -> *
• In the data type declaration for ‘T’
diff --git a/testsuite/tests/saks/should_fail/saks_fail020.stderr b/testsuite/tests/saks/should_fail/saks_fail020.stderr
index 7f4f33f631..c71b772786 100644
--- a/testsuite/tests/saks/should_fail/saks_fail020.stderr
+++ b/testsuite/tests/saks/should_fail/saks_fail020.stderr
@@ -1,6 +1,10 @@
saks_fail020.hs:9:49: error:
• Expected kind ‘k’, but ‘a’ has kind ‘k0’
+ because kind variable ‘k’ would escape its scope
+ This (rigid, skolem) kind variable is bound by
+ ‘forall (k :: Type) -> Proxy (a :: k)’
+ at saks_fail020.hs:9:20-55
• In the first argument of ‘Proxy’, namely ‘(a :: k)’
In a standalone kind signature for ‘Foo2’:
() -> forall (k :: Type) -> Proxy (a :: k)
diff --git a/testsuite/tests/simplCore/should_compile/T17930.stderr b/testsuite/tests/simplCore/should_compile/T17930.stderr
index 7b24d169f2..a9fe475265 100644
--- a/testsuite/tests/simplCore/should_compile/T17930.stderr
+++ b/testsuite/tests/simplCore/should_compile/T17930.stderr
@@ -1,2 +1,2 @@
-$sfoo :: (?b::Bool) => [Char] -> [Char]
+$sfoo :: (?b::Bool) => String -> [Char]
$sfoo
diff --git a/testsuite/tests/simplCore/should_compile/rule2.stderr b/testsuite/tests/simplCore/should_compile/rule2.stderr
index 35bcec7835..7a27514454 100644
--- a/testsuite/tests/simplCore/should_compile/rule2.stderr
+++ b/testsuite/tests/simplCore/should_compile/rule2.stderr
@@ -10,13 +10,12 @@
==================== Grand total simplifier statistics ====================
-Total ticks: 11
+Total ticks: 10
1 PreInlineUnconditionally 1 f
1 UnfoldingDone 1 Roman.bar
1 RuleFired 1 foo/bar
1 LetFloatFromLet 1
-1 EtaReduction 1 ds
6 BetaReduction
1 f
1 a
diff --git a/testsuite/tests/simplCore/should_compile/simpl017.stderr b/testsuite/tests/simplCore/should_compile/simpl017.stderr
index 5a82506164..96c8e1ea2d 100644
--- a/testsuite/tests/simplCore/should_compile/simpl017.stderr
+++ b/testsuite/tests/simplCore/should_compile/simpl017.stderr
@@ -1,9 +1,9 @@
simpl017.hs:50:15: error:
- • Couldn't match type ‘[E m i] -> E' v0 m a’
- with ‘forall v. [E m i] -> E' v m a’
- Expected type: E m (forall v. [E m i] -> E' v m a)
- Actual type: E' RValue m ([E m i] -> E' v0 m a)
+ • Couldn't match type: [E m i] -> E' v0 m a
+ with: forall v. [E m i] -> E' v m a
+ Expected: E m (forall v. [E m i] -> E' v m a)
+ Actual: E' RValue m ([E m i] -> E' v0 m a)
• In the expression:
E (do let ix :: [E m i] -> m i
ix [i] = runE i
diff --git a/testsuite/tests/simplCore/should_compile/spec004.stderr b/testsuite/tests/simplCore/should_compile/spec004.stderr
index f140da9977..825319bcb6 100644
--- a/testsuite/tests/simplCore/should_compile/spec004.stderr
+++ b/testsuite/tests/simplCore/should_compile/spec004.stderr
@@ -5,7 +5,7 @@ Result size of Specialise
-- RHS size: {terms: 14, types: 12, coercions: 0, joins: 0/0}
$sfoo [InlPrag=NOINLINE[0]] :: Int -> [Char]
-[LclId]
+[LclId, Arity=1]
$sfoo
= \ (y :: Int) ->
GHC.Base.build
@@ -25,7 +25,7 @@ foo [InlPrag=NOINLINE[0]] :: forall a. () -> Show a => a -> String
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [0 30 0] 150 40},
RULES: "SPEC foo @Int" [0]
- forall (dk :: ()) ($dShow :: Show Int). foo @Int dk $dShow = $sfoo]
+ forall (ds :: ()) ($dShow :: Show Int). foo @Int ds $dShow = $sfoo]
foo
= \ (@a) _ [Occ=Dead] ($dShow :: Show a) (y :: a) ->
GHC.Base.build
diff --git a/testsuite/tests/th/T10945.stderr b/testsuite/tests/th/T10945.stderr
index 765be1fa80..09e1afa877 100644
--- a/testsuite/tests/th/T10945.stderr
+++ b/testsuite/tests/th/T10945.stderr
@@ -1,8 +1,9 @@
T10945.hs:7:4: error:
- • Couldn't match type ‘[Dec]’ with ‘TExp DecsQ’
- Expected type: Q (TExp DecsQ)
- Actual type: Q [Dec]
+ • Couldn't match type: [Dec]
+ with: TExp DecsQ
+ Expected: Q (TExp DecsQ)
+ Actual: Q [Dec]
• In the expression:
return
[SigD
diff --git a/testsuite/tests/th/T11452.stderr b/testsuite/tests/th/T11452.stderr
index 0649997ff1..88e9af57fc 100644
--- a/testsuite/tests/th/T11452.stderr
+++ b/testsuite/tests/th/T11452.stderr
@@ -7,9 +7,13 @@ T11452.hs:6:12: error:
In an equation for ‘impred’: impred = $$([|| \ _ -> () ||])
T11452.hs:6:14: error:
- • Cannot instantiate unification variable ‘p0’
+ • Couldn't match type ‘p0’ with ‘forall a. a -> a’
+ Expected: Language.Haskell.TH.Syntax.Q
+ (Language.Haskell.TH.Syntax.TExp ((forall a. a -> a) -> ()))
+ Actual: Language.Haskell.TH.Syntax.Q
+ (Language.Haskell.TH.Syntax.TExp (p0 -> ()))
+ Cannot instantiate unification variable ‘p0’
with a type involving polytypes: forall a. a -> a
- GHC doesn't yet support impredicative polymorphism
• In the Template Haskell quotation [|| \ _ -> () ||]
In the expression: [|| \ _ -> () ||]
In the Template Haskell splice $$([|| \ _ -> () ||])
diff --git a/testsuite/tests/th/T15321.stderr b/testsuite/tests/th/T15321.stderr
index 825e01b0f4..3054f02afc 100644
--- a/testsuite/tests/th/T15321.stderr
+++ b/testsuite/tests/th/T15321.stderr
@@ -1,6 +1,6 @@
T15321.hs:9:9: error:
- • Found hole: _ :: [Char] -> Language.Haskell.TH.Lib.Internal.ExpQ
+ • Found hole: _ :: String -> Language.Haskell.TH.Lib.Internal.ExpQ
• In the expression: _
In the expression: _ "baz"
In the untyped splice: $(_ "baz")
diff --git a/testsuite/tests/th/T16976.stderr b/testsuite/tests/th/T16976.stderr
index 7fe46fb5eb..19584153c0 100644
--- a/testsuite/tests/th/T16976.stderr
+++ b/testsuite/tests/th/T16976.stderr
@@ -1,5 +1,5 @@
T16976.aNumber :: forall {p_0 :: *} . GHC.Num.Num p_0 => p_0
-T16976.aString :: [GHC.Types.Char]
+T16976.aString :: GHC.Base.String
T16976.MkT1 :: forall (s_0 :: *) . T16976.T s_0
T16976.MkT2 :: forall (s_0 :: *) . T16976.T s_0
T16976.T :: * -> *
diff --git a/testsuite/tests/th/T17380.stderr b/testsuite/tests/th/T17380.stderr
index 358e7f34f2..3773c76400 100644
--- a/testsuite/tests/th/T17380.stderr
+++ b/testsuite/tests/th/T17380.stderr
@@ -1,39 +1,41 @@
T17380.hs:9:7: error:
- • Couldn't match expected type ‘Solo (Maybe String)’
- with actual type ‘Maybe [Char]’
+ • Couldn't match expected type: Solo (Maybe String)
+ with actual type: Maybe String
• In the expression: Just "wat"
In an equation for ‘foo’: foo = Just "wat"
T17380.hs:12:8: error:
- • Couldn't match expected type ‘Maybe String’
- with actual type ‘Solo (Maybe [Char])’
+ • Couldn't match expected type: Maybe String
+ with actual type: Solo (Maybe String)
• In the expression: Solo Just "wat"
In an equation for ‘bar’: bar = (Solo Just "wat")
T17380.hs:15:6: error:
- • Couldn't match expected type ‘Solo (Maybe String)’
- with actual type ‘Maybe [Char]’
+ • Couldn't match expected type: Solo (Maybe String)
+ with actual type: Maybe String
• In the pattern: Just "wat"
In an equation for ‘baz’: baz (Just "wat") = Just "frerf"
T17380.hs:18:7: error:
- • Couldn't match expected type ‘Maybe String’
- with actual type ‘Solo (Maybe [Char])’
+ • Couldn't match expected type: Maybe String
+ with actual type: Solo (Maybe String)
• In the pattern: Solo(Just "wat")
In an equation for ‘quux’: quux (Solo(Just "wat")) = Just "frerf"
T17380.hs:21:8: error:
- • Couldn't match type ‘Maybe String’ with ‘'Solo (Maybe String)’
- Expected type: Proxy ('Solo (Maybe String))
- Actual type: Proxy (Maybe String)
+ • Couldn't match type: Maybe String
+ with: 'Solo (Maybe String)
+ Expected: Proxy ('Solo (Maybe String))
+ Actual: Proxy (Maybe String)
• In the expression: Proxy :: Proxy (Maybe String)
In an equation for ‘quuz’: quuz = Proxy :: Proxy (Maybe String)
T17380.hs:24:8: error:
- • Couldn't match type ‘'Solo (Maybe String)’ with ‘Maybe String’
- Expected type: Proxy (Maybe String)
- Actual type: Proxy ('Solo (Maybe String))
+ • Couldn't match type: 'Solo (Maybe String)
+ with: Maybe String
+ Expected: Proxy (Maybe String)
+ Actual: Proxy ('Solo (Maybe String))
• In the expression: Proxy :: Proxy ('Solo Maybe String)
In an equation for ‘fred’:
fred = Proxy :: Proxy ('Solo Maybe String)
diff --git a/testsuite/tests/th/T7276.stderr b/testsuite/tests/th/T7276.stderr
index 10a592f4a5..9ab73ad4cd 100644
--- a/testsuite/tests/th/T7276.stderr
+++ b/testsuite/tests/th/T7276.stderr
@@ -2,8 +2,8 @@
T7276.hs:6:8: error:
• Couldn't match type ‘[Language.Haskell.TH.Syntax.Dec]’
with ‘Language.Haskell.TH.Syntax.Exp’
- Expected type: Language.Haskell.TH.Lib.Internal.ExpQ
- Actual type: Language.Haskell.TH.Syntax.Q
- Language.Haskell.TH.Lib.Internal.Decs
+ Expected: Language.Haskell.TH.Lib.Internal.ExpQ
+ Actual: Language.Haskell.TH.Syntax.Q
+ Language.Haskell.TH.Lib.Internal.Decs
• In the expression: [d| y = 3 |]
In the untyped splice: $([d| y = 3 |])
diff --git a/testsuite/tests/th/T7276a.stdout b/testsuite/tests/th/T7276a.stdout
index 048d305562..33b418477a 100644
--- a/testsuite/tests/th/T7276a.stdout
+++ b/testsuite/tests/th/T7276a.stdout
@@ -1,8 +1,8 @@
<interactive>:3:9: warning: [-Wdeferred-type-errors (in -Wdefault)]
• Couldn't match type ‘[Dec]’ with ‘Exp’
- Expected type: Q Exp
- Actual type: Q Language.Haskell.TH.Lib.Internal.Decs
+ Expected: Q Exp
+ Actual: Q Language.Haskell.TH.Lib.Internal.Decs
• In the expression: [d| a = () |] :: Q Exp
In an equation for ‘x’: x = [d| a = () |] :: Q Exp
@@ -10,8 +10,8 @@
• Exception when trying to run compile-time code:
<interactive>:3:9: error:
• Couldn't match type ‘[Dec]’ with ‘Exp’
- Expected type: Q Exp
- Actual type: Q Language.Haskell.TH.Lib.Internal.Decs
+ Expected: Q Exp
+ Actual: Q Language.Haskell.TH.Lib.Internal.Decs
• In the expression: [d| a = () |] :: Q Exp
In an equation for ‘x’: x = [d| a = () |] :: Q Exp
(deferred type error)
diff --git a/testsuite/tests/th/T8577.stderr b/testsuite/tests/th/T8577.stderr
index b6ff05a0a4..595338e07e 100644
--- a/testsuite/tests/th/T8577.stderr
+++ b/testsuite/tests/th/T8577.stderr
@@ -1,8 +1,8 @@
T8577.hs:9:11: error:
• Couldn't match type ‘Int’ with ‘Bool’
- Expected type: Q (TExp (A Bool))
- Actual type: Q (TExp (A Int))
+ Expected: Q (TExp (A Bool))
+ Actual: Q (TExp (A Int))
• In the expression: y
In the Template Haskell splice $$(y)
In the expression: $$(y)
diff --git a/testsuite/tests/th/overloaded/TH_overloaded_constraints_fail.stderr b/testsuite/tests/th/overloaded/TH_overloaded_constraints_fail.stderr
index d76db558c6..965b441735 100644
--- a/testsuite/tests/th/overloaded/TH_overloaded_constraints_fail.stderr
+++ b/testsuite/tests/th/overloaded/TH_overloaded_constraints_fail.stderr
@@ -1,8 +1,8 @@
TH_overloaded_constraints_fail.hs:20:14: error:
• Couldn't match type ‘Identity’ with ‘Q’
- Expected type: Q Exp
- Actual type: Identity Exp
+ Expected: Q Exp
+ Actual: Identity Exp
• In the expression: idQ
In the expression:
[| $(idQ) $(qq) |]
diff --git a/testsuite/tests/typecheck/bug1465/bug1465.stderr b/testsuite/tests/typecheck/bug1465/bug1465.stderr
index 4e31c7f195..e4f5b10732 100644
--- a/testsuite/tests/typecheck/bug1465/bug1465.stderr
+++ b/testsuite/tests/typecheck/bug1465/bug1465.stderr
@@ -1,9 +1,9 @@
C.hs:6:11: error:
- Couldn't match expected type ‘bug1465-1.0:A.T’
- with actual type ‘A.T’
- NB: ‘A.T’ is defined in ‘A’ in package ‘bug1465-2.0’
- ‘bug1465-1.0:A.T’ is defined in ‘A’ in package ‘bug1465-1.0’
- In the expression: B2.f
- In the expression: [B1.f, B2.f]
- In an equation for ‘x’: x = [B1.f, B2.f]
+ • Couldn't match expected type ‘bug1465-1.0:A.T’
+ with actual type ‘A.T’
+ NB: ‘bug1465-1.0:A.T’ is defined in ‘A’ in package ‘bug1465-1.0’
+ ‘A.T’ is defined in ‘A’ in package ‘bug1465-2.0’
+ • In the expression: B2.f
+ In the expression: [B1.f, B2.f]
+ In an equation for ‘x’: x = [B1.f, B2.f]
diff --git a/testsuite/tests/typecheck/should_compile/FD3.stderr b/testsuite/tests/typecheck/should_compile/FD3.stderr
index 85728da0a6..d7ac728b6c 100644
--- a/testsuite/tests/typecheck/should_compile/FD3.stderr
+++ b/testsuite/tests/typecheck/should_compile/FD3.stderr
@@ -1,9 +1,13 @@
FD3.hs:15:15: error:
- • Occurs check: cannot construct the infinite type: a ~ (String, a)
+ • Couldn't match type ‘a’ with ‘(String, a)’
arising from a functional dependency between:
constraint ‘MkA (String, a) a’ arising from a use of ‘mkA’
instance ‘MkA a1 a1’ at FD3.hs:12:10-16
+ ‘a’ is a rigid type variable bound by
+ the type signature for:
+ translate :: forall a. (String, a) -> A a
+ at FD3.hs:14:1-31
• In the expression: mkA a
In an equation for ‘translate’: translate a = mkA a
• Relevant bindings include
diff --git a/testsuite/tests/typecheck/should_compile/T10072.stderr b/testsuite/tests/typecheck/should_compile/T10072.stderr
index ad7fe2602a..71a93c9573 100644
--- a/testsuite/tests/typecheck/should_compile/T10072.stderr
+++ b/testsuite/tests/typecheck/should_compile/T10072.stderr
@@ -6,5 +6,5 @@ T10072.hs:3:31: error:
at T10072.hs:3:1-47
To use the inferred type, enable PartialTypeSignatures
• In the type ‘a -> _’
- In a RULE for ‘f’: a -> _
+ In the type signature for ‘f’: a -> _
When checking the transformation rule "map/empty"
diff --git a/testsuite/tests/typecheck/should_compile/T10283.hs b/testsuite/tests/typecheck/should_compile/T10283.hs
index e623b1cb0a..8c5b8e2f5a 100644
--- a/testsuite/tests/typecheck/should_compile/T10283.hs
+++ b/testsuite/tests/typecheck/should_compile/T10283.hs
@@ -20,4 +20,4 @@ wrapIdComp f = runIdComp . f . liftOuter
class Applicative p => ApplicativeFix p where
afix :: (forall q. Applicative q => (Comp p q) a -> (Comp p q) a) -> p a
- afix = wrapIdComp
+ afix f = wrapIdComp f
diff --git a/testsuite/tests/typecheck/should_compile/T10390.hs b/testsuite/tests/typecheck/should_compile/T10390.hs
index e0648c9554..facb26a26d 100644
--- a/testsuite/tests/typecheck/should_compile/T10390.hs
+++ b/testsuite/tests/typecheck/should_compile/T10390.hs
@@ -6,7 +6,7 @@ class ApPair r where
apPair :: (forall a . (ApPair a, Num a) => Maybe a) -> Maybe r
instance (ApPair a, ApPair b) => ApPair (a,b) where
- apPair = apPair'
+ apPair x = apPair' x
apPair' :: (ApPair b, ApPair c)
=> (forall a . (Num a, ApPair a) => Maybe a) -> Maybe (b,c)
diff --git a/testsuite/tests/typecheck/should_compile/T11254.stderr b/testsuite/tests/typecheck/should_compile/T11254.stderr
index a7466b78b9..10132d2cb8 100644
--- a/testsuite/tests/typecheck/should_compile/T11254.stderr
+++ b/testsuite/tests/typecheck/should_compile/T11254.stderr
@@ -6,8 +6,8 @@ T11254.hs:16:10: warning: [-Wdeferred-type-errors (in -Wdefault)]
T11254.hs:18:12: warning: [-Wdeferred-type-errors (in -Wdefault)]
• Couldn't match type ‘GHC.Real.Ratio Integer’ with ‘Int’
- Expected type: Rational -> Frac Rational
- Actual type: Rational -> Rational
+ Expected: Rational -> Frac Rational
+ Actual: Rational -> Rational
• When checking that instance signature for ‘embed’
is more general than its signature in the class
Instance sig: Rational -> Rational
diff --git a/testsuite/tests/typecheck/should_compile/T11305.hs b/testsuite/tests/typecheck/should_compile/T11305.hs
index 14cb955ed5..ee138a017c 100644
--- a/testsuite/tests/typecheck/should_compile/T11305.hs
+++ b/testsuite/tests/typecheck/should_compile/T11305.hs
@@ -54,4 +54,5 @@ instance ProfunctorComonad Tambara where
yon ~(x,~(y,z)) = ((x,y),z)
instance Profunctor p => Strong (Tambara p) where
- first' = runTambara . produplicate
+ first' = (\x -> runTambara x) . produplicate
+ -- Simple subsumption (#17775) requires eta expansion here
diff --git a/testsuite/tests/typecheck/should_compile/T12082.hs b/testsuite/tests/typecheck/should_compile/T12082.hs
index 7aa4196737..0f001beabb 100644
--- a/testsuite/tests/typecheck/should_compile/T12082.hs
+++ b/testsuite/tests/typecheck/should_compile/T12082.hs
@@ -6,4 +6,5 @@ import Data.Typeable (Typeable)
import Control.Monad.ST (RealWorld)
f :: forall a. (forall b. Typeable b => b -> a) -> a
-f = undefined :: (RealWorld -> a) -> a
+f x = (undefined :: (RealWorld -> a) -> a) x
+ -- Simple subsumption (#17775) requires eta expansion here
diff --git a/testsuite/tests/typecheck/should_compile/T12427a.hs b/testsuite/tests/typecheck/should_compile/T12427a.hs
index cffab89749..56c7513012 100644
--- a/testsuite/tests/typecheck/should_compile/T12427a.hs
+++ b/testsuite/tests/typecheck/should_compile/T12427a.hs
@@ -36,5 +36,6 @@ h2 y = case y of T1 _ v -> v
-- Fails in 7.10 (head exploded)
-- Fails in 8.0.1 (ditto)
-- Succeeds in 8.2
+-- Fails in 8.12 (simple subsumption)
x3 :: (forall a. a->a) -> Int
T1 _ x3 = undefined
diff --git a/testsuite/tests/typecheck/should_compile/T12427a.stderr b/testsuite/tests/typecheck/should_compile/T12427a.stderr
index efc87a1fc3..b9c3969bf0 100644
--- a/testsuite/tests/typecheck/should_compile/T12427a.stderr
+++ b/testsuite/tests/typecheck/should_compile/T12427a.stderr
@@ -12,8 +12,19 @@ T12427a.hs:17:29: error:
h11 :: T -> p (bound at T12427a.hs:17:1)
T12427a.hs:28:6: error:
- • Cannot instantiate unification variable ‘p0’
+ • Couldn't match expected type ‘p0’
+ with actual type ‘(forall b. [b] -> [b]) -> Int’
+ Cannot instantiate unification variable ‘p0’
with a type involving polytypes: (forall b. [b] -> [b]) -> Int
- GHC doesn't yet support impredicative polymorphism
• In the pattern: T1 _ x1
In a pattern binding: T1 _ x1 = undefined
+
+T12427a.hs:41:6: error:
+ • Couldn't match type ‘b’ with ‘[b]’
+ Expected: (forall b. [b] -> [b]) -> Int
+ Actual: (forall a. a -> a) -> Int
+ ‘b’ is a rigid type variable bound by
+ the type [b] -> [b]
+ at T12427a.hs:41:1-19
+ • In the pattern: T1 _ x3
+ In a pattern binding: T1 _ x3 = undefined
diff --git a/testsuite/tests/typecheck/should_compile/T13381.stderr b/testsuite/tests/typecheck/should_compile/T13381.stderr
index 9c8eab6e67..7f250eaec1 100644
--- a/testsuite/tests/typecheck/should_compile/T13381.stderr
+++ b/testsuite/tests/typecheck/should_compile/T13381.stderr
@@ -1,14 +1,8 @@
T13381.hs:21:23: error:
• Couldn't match type ‘Exp Int’ with ‘Int’
- Expected type: Exp Int -> Iter (Exp Int) (Exp Char)
- Actual type: Int -> Iter (Exp Int) (Exp Char)
+ Expected: Int -> Iter Int (Exp Char)
+ Actual: Int -> Iter (Exp Int) (Exp Char)
• In the first argument of ‘iterLoop’, namely ‘f’
In the first argument of ‘fromExp’, namely ‘(iterLoop f init)’
In the expression: fromExp (iterLoop f init)
-
-T13381.hs:21:25: error:
- • Couldn't match expected type ‘Exp Int’ with actual type ‘Int’
- • In the second argument of ‘iterLoop’, namely ‘init’
- In the first argument of ‘fromExp’, namely ‘(iterLoop f init)’
- In the expression: fromExp (iterLoop f init)
diff --git a/testsuite/tests/typecheck/should_compile/T13585a.hs b/testsuite/tests/typecheck/should_compile/T13585a.hs
index 0652ece370..3f72a45ea3 100644
--- a/testsuite/tests/typecheck/should_compile/T13585a.hs
+++ b/testsuite/tests/typecheck/should_compile/T13585a.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE KindSignatures, RankNTypes, TypeFamilies, MultiParamTypeClasses, FlexibleInstances,UndecidableInstances #-}
+{-# LANGUAGE ScopedTypeVariables, KindSignatures, RankNTypes, TypeFamilies, MultiParamTypeClasses, FlexibleInstances,UndecidableInstances #-}
module T13585a where
@@ -78,5 +78,6 @@ au k = withIso k $ \ sa bt f -> fmap sa (f bt)
{-# INLINE au #-}
ala :: (Functor f, Rewrapping s t) => (Unwrapped s -> s) -> ((Unwrapped t -> t) -> f s) -> f (Unwrapped s)
-ala = au . _Wrapping
+ala = au . (\x -> _Wrapping x)
+ -- Simple subsumption (#17775) requires eta expansion here
{-# INLINE ala #-}
diff --git a/testsuite/tests/typecheck/should_compile/T13651.stderr b/testsuite/tests/typecheck/should_compile/T13651.stderr
index 6b6c64302f..150291c210 100644
--- a/testsuite/tests/typecheck/should_compile/T13651.stderr
+++ b/testsuite/tests/typecheck/should_compile/T13651.stderr
@@ -8,6 +8,12 @@ T13651.hs:11:8: error:
(F cr cu ~ Bar h (Bar r u), F cu cs ~ Bar (Foo h) (Bar u s)) =>
Bar h (Bar r u) -> Bar (Foo h) (Bar u s) -> Foo (cr -> cs)
at T13651.hs:(11,8)-(13,65)
+ Expected: forall cr cu h r u cs s.
+ (F cr cu ~ Bar h (Bar r u), F cu cs ~ Bar (Foo h) (Bar u s)) =>
+ Bar h (Bar r u) -> Bar (Foo h) (Bar u s) -> Foo (cr -> cs)
+ Actual: forall cr cu h r u cs s.
+ (F cr cu ~ Bar h (Bar r u), F cu cs ~ Bar (Foo h) (Bar u s)) =>
+ Bar h (Bar r u) -> Bar (Foo h) (Bar u s) -> Foo (cr -> cs)
• In the ambiguity check for ‘foo’
To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
In the type signature:
diff --git a/testsuite/tests/typecheck/should_compile/T14488.hs b/testsuite/tests/typecheck/should_compile/T14488.hs
index a4a12841b7..04c295b706 100644
--- a/testsuite/tests/typecheck/should_compile/T14488.hs
+++ b/testsuite/tests/typecheck/should_compile/T14488.hs
@@ -7,4 +7,4 @@ type Lens' s a = forall f. Functor f => (a -> f a) -> s -> f s
data T a = MkT { _tfield :: Eq a => a }
tfield :: Eq a => Lens' (T a) a
-tfield f t = MkT <$> f (_tfield t)
+tfield f t = (\x -> MkT x) <$> f (_tfield t)
diff --git a/testsuite/tests/typecheck/should_compile/T15368.stderr b/testsuite/tests/typecheck/should_compile/T15368.stderr
index 693779e1f5..7f022744c4 100644
--- a/testsuite/tests/typecheck/should_compile/T15368.stderr
+++ b/testsuite/tests/typecheck/should_compile/T15368.stderr
@@ -15,9 +15,10 @@ T15368.hs:11:15: warning: [-Wtyped-holes (in -Wdefault)]
trigger :: a -> b -> (F a b, F b a) (bound at T15368.hs:11:1)
T15368.hs:11:15: warning: [-Wdeferred-type-errors (in -Wdefault)]
- • Couldn't match type ‘F b a’ with ‘F b0 a0’
- Expected type: (F a b, F b a)
- Actual type: (F a b, F b0 a0)
+ • Couldn't match type: F b a
+ with: F b0 a0
+ Expected: (F a b, F b a)
+ Actual: (F a b, F b0 a0)
NB: ‘F’ is a non-injective type family
The type variables ‘b0’, ‘a0’ are ambiguous
• In the expression: _ `transitive` trigger _ _
diff --git a/testsuite/tests/typecheck/should_compile/T15370.stderr b/testsuite/tests/typecheck/should_compile/T15370.stderr
index ec0ff67482..f359155dbd 100644
--- a/testsuite/tests/typecheck/should_compile/T15370.stderr
+++ b/testsuite/tests/typecheck/should_compile/T15370.stderr
@@ -1,6 +1,8 @@
T15370.hs:14:10: warning: [-Wdeferred-type-errors (in -Wdefault)]
• Couldn't match type ‘n’ with ‘j’
+ Expected: n :~: j
+ Actual: n :~: n
‘n’ is a rigid type variable bound by
the type signature for:
mkRefl :: forall {k} (n :: k) (j :: k). n :~: j
@@ -9,8 +11,6 @@ T15370.hs:14:10: warning: [-Wdeferred-type-errors (in -Wdefault)]
the type signature for:
mkRefl :: forall {k} (n :: k) (j :: k). n :~: j
at T15370.hs:13:1-17
- Expected type: n :~: j
- Actual type: n :~: n
• In the expression: Refl
In an equation for ‘mkRefl’: mkRefl = Refl
• Relevant bindings include
@@ -18,8 +18,8 @@ T15370.hs:14:10: warning: [-Wdeferred-type-errors (in -Wdefault)]
T15370.hs:20:13: warning: [-Wdeferred-type-errors (in -Wdefault)]
• Couldn't match type ‘S r’ with ‘()’
- Expected type: ()
- Actual type: S r
+ Expected: ()
+ Actual: S r
• In the expression: no + _
In a case alternative: Refl -> no + _
In the expression: case mkRefl @x @y of { Refl -> no + _ }
diff --git a/testsuite/tests/typecheck/should_compile/T1634.hs b/testsuite/tests/typecheck/should_compile/T1634.hs
index b4c6f2b561..a8fdd9f8eb 100644
--- a/testsuite/tests/typecheck/should_compile/T1634.hs
+++ b/testsuite/tests/typecheck/should_compile/T1634.hs
@@ -3,4 +3,4 @@
module T1634 where
t1 :: a -> (forall b. b -> (a,b))
-t1 = (,)
+t1 x = (,) x
diff --git a/testsuite/tests/typecheck/should_compile/T17007.hs b/testsuite/tests/typecheck/should_compile/T17007.hs
index 21b7639dd0..0b2b0f28a2 100644
--- a/testsuite/tests/typecheck/should_compile/T17007.hs
+++ b/testsuite/tests/typecheck/should_compile/T17007.hs
@@ -10,4 +10,4 @@ get (x :: ItemColID a b) = x :: ItemColID a b
type family ItemColID' a b where ItemColID' a b = Int -- Discards a,b
get' :: ItemColID' a b -> ItemColID' a b
-get' (x :: ItemColID' a b) = x :: ItemColID' a b
+get' (x :: ItemColID' p q) = x :: ItemColID' a b
diff --git a/testsuite/tests/typecheck/should_compile/T17775-view-pats.hs b/testsuite/tests/typecheck/should_compile/T17775-view-pats.hs
new file mode 100644
index 0000000000..8ffd704d9c
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T17775-view-pats.hs
@@ -0,0 +1,52 @@
+{-# LANGUAGE RankNTypes, ViewPatterns #-}
+
+module ViewPats where
+
+ex1 :: forall a. a -> a -> Int -> Eq a => Bool
+-- Accept; we skolemise over three args
+ex1 x ((== x) -> result) _ = result
+
+{-
+ex2 :: forall a. a -> a -> Int -> Eq a => Bool
+-- Reject: only skolemise over two args
+ex2 x ((== x) -> result) = \ _ -> result
+
+ex3 :: forall a. a -> a -> Int -> Eq a => Bool
+-- Reject: only skolemise over two args
+-- const (result :: Bool) :: b -> Eq a => Bool
+ex3 x ((== x) -> result) = const result
+-}
+
+ex4 :: forall a. a -> a -> Int -> Eq a => Bool
+-- Accept
+ex4 x y _ = x == y
+
+ex5 :: forall a. a -> a -> Int -> Eq a => Bool
+-- Accept
+ex5 x y = \ _ -> x == y
+
+{-
+ex6 :: forall a. a -> a -> Int -> Eq a => Bool
+-- Reject. Needs (const (bla :: Bool)) :: Int -> Eq a => Bool
+ex6 x y = const (x == y)
+-}
+
+ex7 :: forall a. a -> a -> Eq a => Bool
+-- Accept
+ex7 x ((== x) -> result) = result
+
+ex8 :: forall a. a -> a -> Eq a => Bool
+-- Accept
+ex8 x y = x == y
+
+ex9 :: forall a. a -> Eq a => a -> Bool
+-- Accept
+ex9 x ((== x) -> result) = result
+
+ex10 :: forall a. a -> Eq a => a -> Bool
+-- Accept
+ex10 x y = x == y
+
+ex11 :: forall a. a -> Eq a => a -> Bool
+-- Accept
+ex11 x = (== x)
diff --git a/testsuite/tests/typecheck/should_compile/T17775-viewpats-a.hs b/testsuite/tests/typecheck/should_compile/T17775-viewpats-a.hs
new file mode 100644
index 0000000000..96deb25631
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T17775-viewpats-a.hs
@@ -0,0 +1,35 @@
+{-# LANGUAGE RankNTypes, ViewPatterns #-}
+
+module ViewPats where
+
+ex1 :: forall a. a -> a -> Int -> Eq a => Bool
+-- Accept; we skolemise over three args
+ex1 x ((== x) -> result) _ = result
+
+ex4 :: forall a. a -> a -> Int -> Eq a => Bool
+-- Accept
+ex4 x y _ = x == y
+
+ex5 :: forall a. a -> a -> Int -> Eq a => Bool
+-- Accept
+ex5 x y = \ _ -> x == y
+
+ex7 :: forall a. a -> a -> Eq a => Bool
+-- Accept
+ex7 x ((== x) -> result) = result
+
+ex8 :: forall a. a -> a -> Eq a => Bool
+-- Accept
+ex8 x y = x == y
+
+ex9 :: forall a. a -> Eq a => a -> Bool
+-- Accept
+ex9 x ((== x) -> result) = result
+
+ex10 :: forall a. a -> Eq a => a -> Bool
+-- Accept
+ex10 x y = x == y
+
+ex11 :: forall a. a -> Eq a => a -> Bool
+-- Accept
+ex11 x = (== x)
diff --git a/testsuite/tests/typecheck/should_compile/T17775-viewpats-b.hs b/testsuite/tests/typecheck/should_compile/T17775-viewpats-b.hs
new file mode 100644
index 0000000000..18a6ec8da6
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T17775-viewpats-b.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE RankNTypes, ViewPatterns #-}
+
+module ViewPats where
+
+ex2 :: forall a. a -> a -> Int -> Eq a => Bool
+-- Reject: only skolemise over two args
+ex2 x ((== x) -> result) = \ _ -> result
diff --git a/testsuite/tests/typecheck/should_compile/T17775-viewpats-b.stderr b/testsuite/tests/typecheck/should_compile/T17775-viewpats-b.stderr
new file mode 100644
index 0000000000..e631106dd0
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T17775-viewpats-b.stderr
@@ -0,0 +1,10 @@
+
+T17775-viewpats-b.hs:7:9: error:
+ • No instance for (Eq a) arising from a use of ‘==’
+ Possible fix:
+ add (Eq a) to the context of
+ the type signature for:
+ ex2 :: forall a. a -> a -> Int -> Eq a => Bool
+ • In the expression: == x
+ In the pattern: (== x) -> result
+ In an equation for ‘ex2’: ex2 x ((== x) -> result) = \ _ -> result
diff --git a/testsuite/tests/typecheck/should_compile/T17775-viewpats-c.hs b/testsuite/tests/typecheck/should_compile/T17775-viewpats-c.hs
new file mode 100644
index 0000000000..78b4e9d0b5
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T17775-viewpats-c.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE RankNTypes, ViewPatterns #-}
+
+module ViewPats where
+
+ex3 :: forall a. a -> a -> Int -> Eq a => Bool
+-- Reject: only skolemise over two args
+-- const (result :: Bool) :: b -> Eq a => Bool
+ex3 x ((== x) -> result) = const result
diff --git a/testsuite/tests/typecheck/should_compile/T17775-viewpats-c.stderr b/testsuite/tests/typecheck/should_compile/T17775-viewpats-c.stderr
new file mode 100644
index 0000000000..a0456c5a70
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T17775-viewpats-c.stderr
@@ -0,0 +1,11 @@
+
+T17775-viewpats-c.hs:8:28: error:
+ • Couldn't match type ‘Bool’ with ‘Eq a => Bool’
+ Expected: Int -> Eq a => Bool
+ Actual: Int -> Bool
+ • In the expression: const result
+ In an equation for ‘ex3’: ex3 x ((== x) -> result) = const result
+ • Relevant bindings include
+ x :: a (bound at T17775-viewpats-c.hs:8:5)
+ ex3 :: a -> a -> Int -> Eq a => Bool
+ (bound at T17775-viewpats-c.hs:8:1)
diff --git a/testsuite/tests/typecheck/should_compile/T17775-viewpats-d.hs b/testsuite/tests/typecheck/should_compile/T17775-viewpats-d.hs
new file mode 100644
index 0000000000..3a133d7930
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T17775-viewpats-d.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE RankNTypes, ViewPatterns #-}
+
+module ViewPats where
+
+ex6 :: forall a. a -> a -> Int -> Eq a => Bool
+-- Reject. Needs (const (bla :: Bool)) :: Int -> Eq a => Bool
+ex6 x y = const (x == y)
diff --git a/testsuite/tests/typecheck/should_compile/T17775-viewpats-d.stderr b/testsuite/tests/typecheck/should_compile/T17775-viewpats-d.stderr
new file mode 100644
index 0000000000..e270cecc25
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T17775-viewpats-d.stderr
@@ -0,0 +1,12 @@
+
+T17775-viewpats-d.hs:7:11: error:
+ • Couldn't match type ‘Bool’ with ‘Eq a => Bool’
+ Expected: Int -> Eq a => Bool
+ Actual: Int -> Bool
+ • In the expression: const (x == y)
+ In an equation for ‘ex6’: ex6 x y = const (x == y)
+ • Relevant bindings include
+ y :: a (bound at T17775-viewpats-d.hs:7:7)
+ x :: a (bound at T17775-viewpats-d.hs:7:5)
+ ex6 :: a -> a -> Int -> Eq a => Bool
+ (bound at T17775-viewpats-d.hs:7:1)
diff --git a/testsuite/tests/typecheck/should_compile/T2494.stderr b/testsuite/tests/typecheck/should_compile/T2494.stderr
index 5cf4fde746..8e427c5ac8 100644
--- a/testsuite/tests/typecheck/should_compile/T2494.stderr
+++ b/testsuite/tests/typecheck/should_compile/T2494.stderr
@@ -1,14 +1,14 @@
T2494.hs:15:14: error:
• Couldn't match type ‘b’ with ‘a’
+ Expected: Maybe (m a) -> Maybe (m a)
+ Actual: Maybe (m b) -> Maybe (m b)
‘b’ is a rigid type variable bound by
the RULE "foo/foo"
at T2494.hs:(12,1)-(15,33)
‘a’ is a rigid type variable bound by
the RULE "foo/foo"
at T2494.hs:(12,1)-(15,33)
- Expected type: Maybe (m a) -> Maybe (m a)
- Actual type: Maybe (m b) -> Maybe (m b)
• In the first argument of ‘foo’, namely ‘g’
In the second argument of ‘foo’, namely ‘(foo g x)’
In the expression: foo f (foo g x)
@@ -21,14 +21,14 @@ T2494.hs:15:14: error:
T2494.hs:15:30: error:
• Couldn't match type ‘b’ with ‘a’
+ Expected: Maybe (m b) -> Maybe (m a)
+ Actual: Maybe (m b) -> Maybe (m b)
‘b’ is a rigid type variable bound by
the RULE "foo/foo"
at T2494.hs:(12,1)-(15,33)
‘a’ is a rigid type variable bound by
the RULE "foo/foo"
at T2494.hs:(12,1)-(15,33)
- Expected type: Maybe (m b) -> Maybe (m a)
- Actual type: Maybe (m b) -> Maybe (m b)
• In the second argument of ‘(.)’, namely ‘g’
In the first argument of ‘foo’, namely ‘(f . g)’
In the expression: foo (f . g) x
diff --git a/testsuite/tests/typecheck/should_compile/T3692.hs b/testsuite/tests/typecheck/should_compile/T3692.hs
index 5be093f55f..4d5a61074f 100644
--- a/testsuite/tests/typecheck/should_compile/T3692.hs
+++ b/testsuite/tests/typecheck/should_compile/T3692.hs
@@ -7,5 +7,8 @@ type Foo a b = () -> (Bar a => a)
class Bar a where {}
+boo :: Foo p q
+boo x = undefined
+
foo :: Foo a b
-foo = id (undefined :: Foo p q)
+foo y = id (\x -> boo x) y
diff --git a/testsuite/tests/typecheck/should_compile/T4284.hs b/testsuite/tests/typecheck/should_compile/T4284.hs
index 2d5164a487..5e1b9ceb5f 100644
--- a/testsuite/tests/typecheck/should_compile/T4284.hs
+++ b/testsuite/tests/typecheck/should_compile/T4284.hs
@@ -2,11 +2,11 @@
module Test where
foo :: () -> forall b. b
-foo = undefined
+foo x = undefined
-works = id foo
+works = id (\x -> foo x)
-fails = (id) foo
+fails = (id) (\x -> foo x)
-- works type checks, but fails fails with the following error
-- message:
diff --git a/testsuite/tests/typecheck/should_compile/T7220a.hs b/testsuite/tests/typecheck/should_compile/T7220a.hs
index 4739626fa5..2ea0150f29 100644
--- a/testsuite/tests/typecheck/should_compile/T7220a.hs
+++ b/testsuite/tests/typecheck/should_compile/T7220a.hs
@@ -23,5 +23,7 @@ f :: (forall b. (C a b, TF b ~ Y) => b) -> X
-- g = f
-- Now we fail in all ways!
-f _ = undefined
+-- But with simple subsumption (#17775) we
+-- no longer get an ambiguity check here
+f _ = undefined
diff --git a/testsuite/tests/typecheck/should_compile/T7220a.stderr b/testsuite/tests/typecheck/should_compile/T7220a.stderr
deleted file mode 100644
index 2b311c1111..0000000000
--- a/testsuite/tests/typecheck/should_compile/T7220a.stderr
+++ /dev/null
@@ -1,14 +0,0 @@
-
-T7220a.hs:17:6: error:
- • Could not deduce (C a b)
- from the context: (C a0 b, TF b ~ Y)
- bound by a type expected by the context:
- forall b. (C a0 b, TF b ~ Y) => b
- at T7220a.hs:17:6-44
- Possible fix:
- add (C a b) to the context of
- a type expected by the context:
- forall b. (C a0 b, TF b ~ Y) => b
- • In the ambiguity check for ‘f’
- To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
- In the type signature: f :: (forall b. (C a b, TF b ~ Y) => b) -> X
diff --git a/testsuite/tests/typecheck/should_compile/T9569a.hs b/testsuite/tests/typecheck/should_compile/T9569a.hs
index 3205cb1b4e..0eeb4c40a7 100644
--- a/testsuite/tests/typecheck/should_compile/T9569a.hs
+++ b/testsuite/tests/typecheck/should_compile/T9569a.hs
@@ -5,7 +5,7 @@ g :: (Int -> Int) -> Int
g f = f 4
f1 :: (forall a. a -> a) -> Int
+-- Fails; needs eta-expansion
+-- cf T9569b
f1 = g
-f2 :: (forall a. a -> a) -> Int
-f2 x = g x
diff --git a/testsuite/tests/typecheck/should_compile/T9569a.stderr b/testsuite/tests/typecheck/should_compile/T9569a.stderr
new file mode 100644
index 0000000000..57d44a0f2a
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T9569a.stderr
@@ -0,0 +1,8 @@
+
+T9569a.hs:10:6: error:
+ • Couldn't match type: Int -> Int
+ with: forall a. a -> a
+ Expected: (forall a. a -> a) -> Int
+ Actual: (Int -> Int) -> Int
+ • In the expression: g
+ In an equation for ‘f1’: f1 = g
diff --git a/testsuite/tests/typecheck/should_compile/T9569b.hs b/testsuite/tests/typecheck/should_compile/T9569b.hs
new file mode 100644
index 0000000000..67ddf21d73
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T9569b.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE RankNTypes #-}
+module T9569a where
+
+g :: (Int -> Int) -> Int
+g f = f 4
+
+f2 :: (forall a. a -> a) -> Int
+f2 f = g f
diff --git a/testsuite/tests/typecheck/should_compile/T9834.hs b/testsuite/tests/typecheck/should_compile/T9834.hs
index c16e395f8c..728de2b8ed 100644
--- a/testsuite/tests/typecheck/should_compile/T9834.hs
+++ b/testsuite/tests/typecheck/should_compile/T9834.hs
@@ -20,4 +20,4 @@ wrapIdComp f = runIdComp . f . liftOuter
class Applicative p => ApplicativeFix p where
afix :: (forall q. Applicative q => (Comp p q) a -> (Comp p q) a) -> p a
- afix = wrapIdComp \ No newline at end of file
+ afix f = wrapIdComp f
diff --git a/testsuite/tests/typecheck/should_compile/T9834.stderr b/testsuite/tests/typecheck/should_compile/T9834.stderr
index 52f207d511..5963781325 100644
--- a/testsuite/tests/typecheck/should_compile/T9834.stderr
+++ b/testsuite/tests/typecheck/should_compile/T9834.stderr
@@ -1,40 +1,46 @@
-T9834.hs:23:10: warning: [-Wdeferred-type-errors (in -Wdefault)]
- • Occurs check: cannot construct the infinite type: p ~ (->) (p a0)
- Expected type: (forall (q :: * -> *).
- Applicative q =>
- Comp p q a -> Comp p q a)
- -> p a
- Actual type: (forall (q :: * -> *).
- Applicative q =>
- Nat (Comp p q) (Comp p q))
- -> p a0 -> p a0
- • In the expression: wrapIdComp
- In an equation for ‘afix’: afix = wrapIdComp
+T9834.hs:23:12: warning: [-Wdeferred-type-errors (in -Wdefault)]
+ • Couldn't match type ‘p’ with ‘(->) (p a0)’
+ Expected: p a
+ Actual: p a0 -> p a0
+ ‘p’ is a rigid type variable bound by
+ the class declaration for ‘ApplicativeFix’
+ at T9834.hs:21:39
+ • In the expression: wrapIdComp f
+ In an equation for ‘afix’: afix f = wrapIdComp f
• Relevant bindings include
+ f :: forall (q :: * -> *).
+ Applicative q =>
+ Comp p q a -> Comp p q a
+ (bound at T9834.hs:23:8)
afix :: (forall (q :: * -> *).
Applicative q =>
Comp p q a -> Comp p q a)
-> p a
(bound at T9834.hs:23:3)
-T9834.hs:23:10: warning: [-Wdeferred-type-errors (in -Wdefault)]
+T9834.hs:23:23: warning: [-Wdeferred-type-errors (in -Wdefault)]
• Couldn't match type ‘a1’ with ‘a’
+ Expected: Comp p q a1 -> Comp p q a1
+ Actual: Comp p q a -> Comp p q a
‘a1’ is a rigid type variable bound by
a type expected by the context:
forall (q :: * -> *). Applicative q => Nat (Comp p q) (Comp p q)
- at T9834.hs:23:10-19
+ at T9834.hs:23:23
‘a’ is a rigid type variable bound by
the type signature for:
afix :: forall a.
(forall (q :: * -> *). Applicative q => Comp p q a -> Comp p q a)
-> p a
at T9834.hs:22:11-74
- Expected type: Comp p q a1 -> Comp p q a1
- Actual type: Comp p q a -> Comp p q a
- • In the expression: wrapIdComp
- In an equation for ‘afix’: afix = wrapIdComp
+ • In the first argument of ‘wrapIdComp’, namely ‘f’
+ In the expression: wrapIdComp f
+ In an equation for ‘afix’: afix f = wrapIdComp f
• Relevant bindings include
+ f :: forall (q :: * -> *).
+ Applicative q =>
+ Comp p q a -> Comp p q a
+ (bound at T9834.hs:23:8)
afix :: (forall (q :: * -> *).
Applicative q =>
Comp p q a -> Comp p q a)
diff --git a/testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnifySig.hs b/testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnifySig.hs
index 9f5b984025..a7645a0b3e 100644
--- a/testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnifySig.hs
+++ b/testsuite/tests/typecheck/should_compile/UnliftedNewtypesUnifySig.hs
@@ -14,7 +14,10 @@ import GHC.Exts (Int#,Word#,RuntimeRep(IntRep))
import GHC.Exts (TYPE)
type KindOf (a :: TYPE k) = k
+
data family D (a :: TYPE r) :: TYPE r
+
newtype instance D a = MkWordD Word#
+
newtype instance D a :: TYPE (KindOf a) where
MkIntD :: forall (a :: TYPE 'IntRep). Int# -> D a
diff --git a/testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr b/testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr
index e422b8629e..119c6b91e5 100644
--- a/testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr
+++ b/testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr
@@ -42,29 +42,29 @@ abstract_refinement_hole_fits.hs:4:5: warning: [-Wtyped-holes (in -Wdefault)]
where pure :: forall (f :: * -> *) a. Applicative f => a -> f a
($!) (_ :: [Integer] -> Integer)
where ($!) :: forall a b. (a -> b) -> a -> b
- curry (_ :: (a2, [Integer]) -> Integer) (_ :: a2)
+ curry (_ :: (t0, [Integer]) -> Integer) (_ :: t0)
where curry :: forall a b c. ((a, b) -> c) -> a -> b -> c
(.) (_ :: b1 -> Integer) (_ :: [Integer] -> b1)
where (.) :: forall b c a. (b -> c) -> (a -> b) -> a -> c
- flip (_ :: [Integer] -> b7 -> Integer) (_ :: b7)
+ flip (_ :: [Integer] -> t0 -> Integer) (_ :: t0)
where flip :: forall a b c. (a -> b -> c) -> b -> a -> c
- (>>=) (_ :: [Integer] -> a11) (_ :: a11 -> [Integer] -> Integer)
+ (>>=) (_ :: [Integer] -> a8) (_ :: a8 -> [Integer] -> Integer)
where (>>=) :: forall (m :: * -> *) a b.
Monad m =>
m a -> (a -> m b) -> m b
- (>>) (_ :: [Integer] -> a10) (_ :: [Integer] -> Integer)
+ (>>) (_ :: [Integer] -> a7) (_ :: [Integer] -> Integer)
where (>>) :: forall (m :: * -> *) a b.
Monad m =>
m a -> m b -> m b
- fmap (_ :: a12 -> Integer) (_ :: [Integer] -> a12)
+ fmap (_ :: a9 -> Integer) (_ :: [Integer] -> a9)
where fmap :: forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f a -> f b
- (<*>) (_ :: [Integer] -> a8 -> Integer) (_ :: [Integer] -> a8)
+ (<*>) (_ :: [Integer] -> a5 -> Integer) (_ :: [Integer] -> a5)
where (<*>) :: forall (f :: * -> *) a b.
Applicative f =>
f (a -> b) -> f a -> f b
- (*>) (_ :: [Integer] -> a7) (_ :: [Integer] -> Integer)
+ (*>) (_ :: [Integer] -> a4) (_ :: [Integer] -> Integer)
where (*>) :: forall (f :: * -> *) a b.
Applicative f =>
f a -> f b -> f b
@@ -72,7 +72,7 @@ abstract_refinement_hole_fits.hs:4:5: warning: [-Wtyped-holes (in -Wdefault)]
where (<$>) :: forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f a -> f b
- (=<<) (_ :: a9 -> [Integer] -> Integer) (_ :: [Integer] -> a9)
+ (=<<) (_ :: a6 -> [Integer] -> Integer) (_ :: [Integer] -> a6)
where (=<<) :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> m a -> m b
@@ -84,15 +84,15 @@ abstract_refinement_hole_fits.hs:4:5: warning: [-Wtyped-holes (in -Wdefault)]
where (<$) :: forall (f :: * -> *) a b.
Functor f =>
a -> f b -> f a
- id (_ :: t1 -> [Integer] -> Integer) (_ :: t1)
+ id (_ :: t0 -> [Integer] -> Integer) (_ :: t0)
where id :: forall a. a -> a
- head (_ :: [t1 -> [Integer] -> Integer]) (_ :: t1)
+ head (_ :: [t0 -> [Integer] -> Integer]) (_ :: t0)
where head :: forall a. [a] -> a
- last (_ :: [t1 -> [Integer] -> Integer]) (_ :: t1)
+ last (_ :: [t0 -> [Integer] -> Integer]) (_ :: t0)
where last :: forall a. [a] -> a
- fst (_ :: (t1 -> [Integer] -> Integer, b2)) (_ :: t1)
+ fst (_ :: (t0 -> [Integer] -> Integer, b2)) (_ :: t0)
where fst :: forall a b. (a, b) -> a
- snd (_ :: (a3, t1 -> [Integer] -> Integer)) (_ :: t1)
+ snd (_ :: (a2, t0 -> [Integer] -> Integer)) (_ :: t0)
where snd :: forall a b. (a, b) -> b
id (_ :: [Integer] -> Integer)
where id :: forall a. a -> a
@@ -108,19 +108,19 @@ abstract_refinement_hole_fits.hs:4:5: warning: [-Wtyped-holes (in -Wdefault)]
where fst :: forall a b. (a, b) -> a
snd (_ :: (a0, [Integer] -> Integer))
where snd :: forall a b. (a, b) -> b
- const (_ :: [Integer] -> Integer) (_ :: b6)
+ const (_ :: [Integer] -> Integer) (_ :: t0)
where const :: forall a b. a -> b -> a
- seq (_ :: a13) (_ :: [Integer] -> Integer)
+ seq (_ :: t2) (_ :: [Integer] -> Integer)
where seq :: forall a b. a -> b -> b
- ($) (_ :: a5 -> [Integer] -> Integer) (_ :: a5)
+ ($) (_ :: t0 -> [Integer] -> Integer) (_ :: t0)
where ($) :: forall a b. (a -> b) -> a -> b
- return (_ :: [Integer] -> Integer) (_ :: t1)
+ return (_ :: [Integer] -> Integer) (_ :: t0)
where return :: forall (m :: * -> *) a. Monad m => a -> m a
- pure (_ :: [Integer] -> Integer) (_ :: t1)
+ pure (_ :: [Integer] -> Integer) (_ :: t0)
where pure :: forall (f :: * -> *) a. Applicative f => a -> f a
- uncurry (_ :: a4 -> b3 -> [Integer] -> Integer) (_ :: (a4, b3))
+ uncurry (_ :: a3 -> b3 -> [Integer] -> Integer) (_ :: (a3, b3))
where uncurry :: forall a b c. (a -> b -> c) -> (a, b) -> c
- ($!) (_ :: a6 -> [Integer] -> Integer) (_ :: a6)
+ ($!) (_ :: t0 -> [Integer] -> Integer) (_ :: t0)
where ($!) :: forall a b. (a -> b) -> a -> b
abstract_refinement_hole_fits.hs:7:5: warning: [-Wtyped-holes (in -Wdefault)]
@@ -158,31 +158,31 @@ abstract_refinement_hole_fits.hs:7:5: warning: [-Wtyped-holes (in -Wdefault)]
where pure :: forall (f :: * -> *) a. Applicative f => a -> f a
($!) (_ :: Integer -> [Integer] -> Integer)
where ($!) :: forall a b. (a -> b) -> a -> b
- curry (_ :: (a2, Integer) -> [Integer] -> Integer) (_ :: a2)
+ curry (_ :: (t0, Integer) -> [Integer] -> Integer) (_ :: t0)
where curry :: forall a b c. ((a, b) -> c) -> a -> b -> c
(.) (_ :: b1 -> [Integer] -> Integer) (_ :: Integer -> b1)
where (.) :: forall b c a. (b -> c) -> (a -> b) -> a -> c
- flip (_ :: Integer -> b7 -> [Integer] -> Integer) (_ :: b7)
+ flip (_ :: Integer -> t0 -> [Integer] -> Integer) (_ :: t0)
where flip :: forall a b c. (a -> b -> c) -> b -> a -> c
- (>>=) (_ :: Integer -> a11)
- (_ :: a11 -> Integer -> [Integer] -> Integer)
+ (>>=) (_ :: Integer -> a8)
+ (_ :: a8 -> Integer -> [Integer] -> Integer)
where (>>=) :: forall (m :: * -> *) a b.
Monad m =>
m a -> (a -> m b) -> m b
- (>>) (_ :: Integer -> a10) (_ :: Integer -> [Integer] -> Integer)
+ (>>) (_ :: Integer -> a7) (_ :: Integer -> [Integer] -> Integer)
where (>>) :: forall (m :: * -> *) a b.
Monad m =>
m a -> m b -> m b
- fmap (_ :: a12 -> [Integer] -> Integer) (_ :: Integer -> a12)
+ fmap (_ :: a9 -> [Integer] -> Integer) (_ :: Integer -> a9)
where fmap :: forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f a -> f b
- (<*>) (_ :: Integer -> a8 -> [Integer] -> Integer)
- (_ :: Integer -> a8)
+ (<*>) (_ :: Integer -> a5 -> [Integer] -> Integer)
+ (_ :: Integer -> a5)
where (<*>) :: forall (f :: * -> *) a b.
Applicative f =>
f (a -> b) -> f a -> f b
- (*>) (_ :: Integer -> a7) (_ :: Integer -> [Integer] -> Integer)
+ (*>) (_ :: Integer -> a4) (_ :: Integer -> [Integer] -> Integer)
where (*>) :: forall (f :: * -> *) a b.
Applicative f =>
f a -> f b -> f b
@@ -190,8 +190,8 @@ abstract_refinement_hole_fits.hs:7:5: warning: [-Wtyped-holes (in -Wdefault)]
where (<$>) :: forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> f a -> f b
- (=<<) (_ :: a9 -> Integer -> [Integer] -> Integer)
- (_ :: Integer -> a9)
+ (=<<) (_ :: a6 -> Integer -> [Integer] -> Integer)
+ (_ :: Integer -> a6)
where (=<<) :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> m a -> m b
@@ -203,15 +203,15 @@ abstract_refinement_hole_fits.hs:7:5: warning: [-Wtyped-holes (in -Wdefault)]
where (<$) :: forall (f :: * -> *) a b.
Functor f =>
a -> f b -> f a
- id (_ :: t1 -> Integer -> [Integer] -> Integer) (_ :: t1)
+ id (_ :: t0 -> Integer -> [Integer] -> Integer) (_ :: t0)
where id :: forall a. a -> a
- head (_ :: [t1 -> Integer -> [Integer] -> Integer]) (_ :: t1)
+ head (_ :: [t0 -> Integer -> [Integer] -> Integer]) (_ :: t0)
where head :: forall a. [a] -> a
- last (_ :: [t1 -> Integer -> [Integer] -> Integer]) (_ :: t1)
+ last (_ :: [t0 -> Integer -> [Integer] -> Integer]) (_ :: t0)
where last :: forall a. [a] -> a
- fst (_ :: (t1 -> Integer -> [Integer] -> Integer, b2)) (_ :: t1)
+ fst (_ :: (t0 -> Integer -> [Integer] -> Integer, b2)) (_ :: t0)
where fst :: forall a b. (a, b) -> a
- snd (_ :: (a3, t1 -> Integer -> [Integer] -> Integer)) (_ :: t1)
+ snd (_ :: (a2, t0 -> Integer -> [Integer] -> Integer)) (_ :: t0)
where snd :: forall a b. (a, b) -> b
id (_ :: Integer -> [Integer] -> Integer)
where id :: forall a. a -> a
@@ -228,18 +228,18 @@ abstract_refinement_hole_fits.hs:7:5: warning: [-Wtyped-holes (in -Wdefault)]
where fst :: forall a b. (a, b) -> a
snd (_ :: (a0, Integer -> [Integer] -> Integer))
where snd :: forall a b. (a, b) -> b
- const (_ :: Integer -> [Integer] -> Integer) (_ :: b6)
+ const (_ :: Integer -> [Integer] -> Integer) (_ :: t0)
where const :: forall a b. a -> b -> a
- seq (_ :: a13) (_ :: Integer -> [Integer] -> Integer)
+ seq (_ :: t2) (_ :: Integer -> [Integer] -> Integer)
where seq :: forall a b. a -> b -> b
- ($) (_ :: a5 -> Integer -> [Integer] -> Integer) (_ :: a5)
+ ($) (_ :: t0 -> Integer -> [Integer] -> Integer) (_ :: t0)
where ($) :: forall a b. (a -> b) -> a -> b
- return (_ :: Integer -> [Integer] -> Integer) (_ :: t1)
+ return (_ :: Integer -> [Integer] -> Integer) (_ :: t0)
where return :: forall (m :: * -> *) a. Monad m => a -> m a
- pure (_ :: Integer -> [Integer] -> Integer) (_ :: t1)
+ pure (_ :: Integer -> [Integer] -> Integer) (_ :: t0)
where pure :: forall (f :: * -> *) a. Applicative f => a -> f a
- uncurry (_ :: a4 -> b3 -> Integer -> [Integer] -> Integer)
- (_ :: (a4, b3))
+ uncurry (_ :: a3 -> b3 -> Integer -> [Integer] -> Integer)
+ (_ :: (a3, b3))
where uncurry :: forall a b c. (a -> b -> c) -> (a, b) -> c
- ($!) (_ :: a6 -> Integer -> [Integer] -> Integer) (_ :: a6)
+ ($!) (_ :: t0 -> Integer -> [Integer] -> Integer) (_ :: t0)
where ($!) :: forall a b. (a -> b) -> a -> b
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index 3189595fc3..b4ac6c9916 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -422,7 +422,8 @@ test('TcStaticPointers02', normal, compile, [''])
test('T8762', normal, compile, [''])
test('MutRec', normal, compile, [''])
test('T8856', normal, compile, [''])
-test('T9569a', normal, compile, [''])
+test('T9569a', normal, compile_fail, [''])
+test('T9569b', normal, compile, [''])
test('T9117', normal, compile, [''])
test('T9117_2', normal, compile, [''])
test('T9117_3', normal, compile, [''])
@@ -430,7 +431,7 @@ test('T9708', expect_broken(9708), compile, [''])
test('T9404', normal, compile, [''])
test('T9404b', normal, compile, [''])
test('T7220', normal, compile, [''])
-test('T7220a', normal, compile_fail, [''])
+test('T7220a', normal, compile, [''])
test('T9151', normal, compile, [''])
test('T9497a', normal, compile, ['-fdefer-typed-holes'])
test('T9497b', normal, compile, ['-fdefer-typed-holes -fno-warn-typed-holes'])
@@ -684,7 +685,7 @@ test('UnliftedNewtypesUnifySig', normal, compile, [''])
test('UnliftedNewtypesForall', normal, compile, [''])
test('UnlifNewUnify', normal, compile, [''])
test('UnliftedNewtypesLPFamily', normal, compile, [''])
-test('UnliftedNewtypesDifficultUnification', normal, compile, [''])
+test('UnliftedNewtypesDifficultUnification', when(compiler_debugged(), expect_broken(18300)), compile, [''])
test('T16832', normal, ghci_script, ['T16832.script'])
test('T16995', normal, compile, [''])
test('T17007', normal, compile, [''])
@@ -711,3 +712,7 @@ test('T18129', expect_broken(18129), compile, [''])
test('T18185', normal, compile, [''])
test('ExplicitSpecificityA1', normal, compile, [''])
test('ExplicitSpecificityA2', normal, compile, [''])
+test('T17775-viewpats-a', normal, compile, [''])
+test('T17775-viewpats-b', normal, compile_fail, [''])
+test('T17775-viewpats-c', normal, compile_fail, [''])
+test('T17775-viewpats-d', normal, compile_fail, [''])
diff --git a/testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr b/testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr
index eb4b02f34e..8ea32fcde6 100644
--- a/testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr
+++ b/testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr
@@ -1,6 +1,6 @@
subsumption_sort_hole_fits.hs:2:5: warning: [-Wtyped-holes (in -Wdefault)]
- • Found hole: _ :: [Char] -> [String]
+ • Found hole: _ :: String -> [String]
• In the expression: _
In the expression: _ "hello, world"
In an equation for ‘f’: f = _ "hello, world"
@@ -22,7 +22,7 @@ subsumption_sort_hole_fits.hs:2:5: warning: [-Wtyped-holes (in -Wdefault)]
(imported from ‘Prelude’ at subsumption_sort_hole_fits.hs:1:1
(and originally defined in ‘GHC.List’))
mempty :: forall a. Monoid a => a
- with mempty @([Char] -> [String])
+ with mempty @(String -> [String])
(imported from ‘Prelude’ at subsumption_sort_hole_fits.hs:1:1
(and originally defined in ‘GHC.Base’))
fail :: forall (m :: * -> *) a. MonadFail m => String -> m a
diff --git a/testsuite/tests/typecheck/should_compile/tc145.hs b/testsuite/tests/typecheck/should_compile/tc145.hs
index 8ab4a56321..9d1ada71a6 100644
--- a/testsuite/tests/typecheck/should_compile/tc145.hs
+++ b/testsuite/tests/typecheck/should_compile/tc145.hs
@@ -9,7 +9,7 @@ module ShouldCompile where
-- implicit parameter to give
-- r :: (?param::a) => a
r :: Int -> ((?param :: a) => a)
- r = error "urk"
+ r _ = error "urk"
-- The unboxed tuple is OK because it is
-- used on the right hand end of an arrow
diff --git a/testsuite/tests/typecheck/should_compile/tc160.hs b/testsuite/tests/typecheck/should_compile/tc160.hs
index 2425221aee..28e1b9e76b 100644
--- a/testsuite/tests/typecheck/should_compile/tc160.hs
+++ b/testsuite/tests/typecheck/should_compile/tc160.hs
@@ -7,8 +7,8 @@ module ShouldCompile where
type Foo x = forall a. a -> x
foo :: Foo (Foo ())
--- foo :: forall a b. a -> b -> ()
+-- foo :: forall a. a -> forall b. b -> ()
-- NOT forall a. a -> a -> ()
-foo = undefined
+foo x = undefined
baz = foo 'c' True
diff --git a/testsuite/tests/typecheck/should_compile/tc208.hs b/testsuite/tests/typecheck/should_compile/tc208.hs
index 8d9bb3636e..254eb82264 100644
--- a/testsuite/tests/typecheck/should_compile/tc208.hs
+++ b/testsuite/tests/typecheck/should_compile/tc208.hs
@@ -11,4 +11,4 @@ module ShouldCompile where
type PPDoc = (?env :: Int) => Char
f :: Char -> PPDoc
-f = succ
+f x = succ x
diff --git a/testsuite/tests/typecheck/should_compile/tc210.hs b/testsuite/tests/typecheck/should_compile/tc210.hs
index b4a377f761..9a0de89d4e 100644
--- a/testsuite/tests/typecheck/should_compile/tc210.hs
+++ b/testsuite/tests/typecheck/should_compile/tc210.hs
@@ -3,10 +3,10 @@
module ShouldCompile where
f :: forall a. a -> forall b. b -> Int
-f = error "urk"
+f x = error "urk"
-- Both these should be ok, but an early GHC 6.6 failed
-g1 = [ (+) :: Int -> Int -> Int, f ]
-g2 = [ f, (+) :: Int -> Int -> Int ]
+g1 = [ (+) :: Int -> Int -> Int, \x -> f x ]
+g2 = [ \x -> f x, (+) :: Int -> Int -> Int ]
diff --git a/testsuite/tests/typecheck/should_compile/tc211.stderr b/testsuite/tests/typecheck/should_compile/tc211.stderr
index ccc3da6fb0..bbffa16943 100644
--- a/testsuite/tests/typecheck/should_compile/tc211.stderr
+++ b/testsuite/tests/typecheck/should_compile/tc211.stderr
@@ -1,10 +1,11 @@
-tc211.hs:20:8: error:
- • Couldn't match expected type ‘forall a. a -> a’
- with actual type ‘a9 -> a9’
- • In the expression:
- (:) ::
- (forall a. a -> a) -> [forall a. a -> a] -> [forall a. a -> a]
+tc211.hs:21:17: error:
+ • Couldn't match expected type: a -> a
+ with actual type: forall a. a -> a
+ • In the first argument of ‘(:) ::
+ (forall a. a -> a)
+ -> [forall a. a -> a] -> [forall a. a -> a]’, namely
+ ‘(head foo)’
In the expression:
((:) ::
(forall a. a -> a) -> [forall a. a -> a] -> [forall a. a -> a])
@@ -14,77 +15,3 @@ tc211.hs:20:8: error:
= ((:) ::
(forall a. a -> a) -> [forall a. a -> a] -> [forall a. a -> a])
(head foo) foo
-
-tc211.hs:25:8: error:
- • Couldn't match type ‘a1 -> a1’ with ‘forall a. a -> a’
- Expected type: [forall a. a -> a]
- Actual type: [a1 -> a1]
- • In the expression: (head foo) : (tail foo)
- In an equation for ‘barr’: barr = (head foo) : (tail foo)
-
-tc211.hs:25:20: error:
- • Couldn't match type ‘forall a. a -> a’ with ‘a1 -> a1’
- Expected type: [a1 -> a1]
- Actual type: [forall a. a -> a]
- • In the second argument of ‘(:)’, namely ‘(tail foo)’
- In the expression: (head foo) : (tail foo)
- In an equation for ‘barr’: barr = (head foo) : (tail foo)
-
-tc211.hs:62:18: error:
- • Couldn't match expected type ‘forall a. a -> a’
- with actual type ‘a6 -> a6’
- • In the expression:
- Cons ::
- (forall a. a -> a)
- -> List (forall a. a -> a) -> List (forall a. a -> a)
- In an equation for ‘cons’:
- cons
- = Cons ::
- (forall a. a -> a)
- -> List (forall a. a -> a) -> List (forall a. a -> a)
- In the expression:
- let
- cons
- = Cons ::
- (forall a. a -> a)
- -> List (forall a. a -> a) -> List (forall a. a -> a)
- in cons (\ x -> x) Nil
-
-tc211.hs:68:8: error:
- • Couldn't match expected type ‘forall a. a -> a’
- with actual type ‘a0 -> a0’
- • In the expression:
- Cons ::
- ((forall a. a -> a)
- -> List (forall a. a -> a) -> List (forall a. a -> a))
- In the expression:
- (Cons ::
- ((forall a. a -> a)
- -> List (forall a. a -> a) -> List (forall a. a -> a)))
- (\ x -> x) Nil
- In an equation for ‘xs2’:
- xs2
- = (Cons ::
- ((forall a. a -> a)
- -> List (forall a. a -> a) -> List (forall a. a -> a)))
- (\ x -> x) Nil
-
-tc211.hs:76:9: error:
- • Couldn't match type ‘forall a11. a11 -> a11’ with ‘a10 -> a10’
- Expected type: List (forall a. a -> a)
- -> (forall a. a -> a) -> a10 -> a10
- Actual type: List (a10 -> a10) -> (a10 -> a10) -> a10 -> a10
- • In the expression:
- foo2 ::
- List (forall a. a -> a) -> (forall a. a -> a) -> (forall a. a -> a)
- In the expression:
- (foo2 ::
- List (forall a. a -> a)
- -> (forall a. a -> a) -> (forall a. a -> a))
- xs1 (\ x -> x)
- In an equation for ‘bar4’:
- bar4
- = (foo2 ::
- List (forall a. a -> a)
- -> (forall a. a -> a) -> (forall a. a -> a))
- xs1 (\ x -> x)
diff --git a/testsuite/tests/typecheck/should_compile/twins.hs b/testsuite/tests/typecheck/should_compile/twins.hs
index 99c77aa796..31d967aa59 100644
--- a/testsuite/tests/typecheck/should_compile/twins.hs
+++ b/testsuite/tests/typecheck/should_compile/twins.hs
@@ -22,7 +22,7 @@ gzip f x y
else Nothing
gzipWithM :: Monad m => GenericQ (GenericM m) -> GenericQ (GenericM m)
-gzipWithM _ = error "urk"
+gzipWithM _ _ = error "urk"
orElse :: Maybe a -> Maybe a -> Maybe a
orElse = error "urk"
diff --git a/testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr b/testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr
index 1c108f719b..116a18f42f 100644
--- a/testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr
+++ b/testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr
@@ -225,7 +225,7 @@ valid_hole_fits.hs:38:10: warning: [-Wtyped-holes (in -Wdefault)]
(and originally defined in ‘GHC.Base’))
valid_hole_fits.hs:41:8: warning: [-Wtyped-holes (in -Wdefault)]
- • Found hole: _ :: [Char] -> IO ()
+ • Found hole: _ :: String -> IO ()
• In the expression: _
In the expression: _ "hello, world"
In an equation for ‘main’: main = _ "hello, world"
@@ -242,7 +242,7 @@ valid_hole_fits.hs:41:8: warning: [-Wtyped-holes (in -Wdefault)]
(imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40
(and originally defined in ‘System.IO’))
print :: forall a. Show a => a -> IO ()
- with print @[Char]
+ with print @String
(imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40
(and originally defined in ‘System.IO’))
fail :: forall (m :: * -> *) a. MonadFail m => String -> m a
@@ -250,6 +250,6 @@ valid_hole_fits.hs:41:8: warning: [-Wtyped-holes (in -Wdefault)]
(imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40
(and originally defined in ‘Control.Monad.Fail’))
mempty :: forall a. Monoid a => a
- with mempty @([Char] -> IO ())
+ with mempty @(String -> IO ())
(imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40
(and originally defined in ‘GHC.Base’))
diff --git a/testsuite/tests/typecheck/should_fail/ExpandSynsFail1.stderr b/testsuite/tests/typecheck/should_fail/ExpandSynsFail1.stderr
index 0d5a9109a4..f592741d6f 100644
--- a/testsuite/tests/typecheck/should_fail/ExpandSynsFail1.stderr
+++ b/testsuite/tests/typecheck/should_fail/ExpandSynsFail1.stderr
@@ -1,11 +1,12 @@
+
ExpandSynsFail1.hs:4:31: error:
- Couldn't match type ‘Bool’ with ‘Int’
- Expected type: Foo
- Actual type: Bar
- Type synonyms expanded:
- Expected type: Int
- Actual type: Bool
- In the second argument of ‘(==)’, namely ‘(False :: Bar)’
- In the second argument of ‘($)’, namely
- ‘(1 :: Foo) == (False :: Bar)’
- In the expression: print $ (1 :: Foo) == (False :: Bar)
+ • Couldn't match type ‘Bool’ with ‘Int’
+ Expected: Foo
+ Actual: Bar
+ Type synonyms expanded:
+ Expected type: Int
+ Actual type: Bool
+ • In the second argument of ‘(==)’, namely ‘(False :: Bar)’
+ In the second argument of ‘($)’, namely
+ ‘(1 :: Foo) == (False :: Bar)’
+ In the expression: print $ (1 :: Foo) == (False :: Bar)
diff --git a/testsuite/tests/typecheck/should_fail/ExpandSynsFail2.stderr b/testsuite/tests/typecheck/should_fail/ExpandSynsFail2.stderr
index 49e262cd3c..24aca978e3 100644
--- a/testsuite/tests/typecheck/should_fail/ExpandSynsFail2.stderr
+++ b/testsuite/tests/typecheck/should_fail/ExpandSynsFail2.stderr
@@ -1,8 +1,8 @@
ExpandSynsFail2.hs:19:37: error:
• Couldn't match type ‘Int’ with ‘Bool’
- Expected type: ST s Foo
- Actual type: MyBarST s
+ Expected: ST s Foo
+ Actual: MyBarST s
Type synonyms expanded:
Expected type: ST s Int
Actual type: ST s Bool
diff --git a/testsuite/tests/typecheck/should_fail/ExpandSynsFail3.stderr b/testsuite/tests/typecheck/should_fail/ExpandSynsFail3.stderr
index 65d91351f5..5179c4ddc1 100644
--- a/testsuite/tests/typecheck/should_fail/ExpandSynsFail3.stderr
+++ b/testsuite/tests/typecheck/should_fail/ExpandSynsFail3.stderr
@@ -1,11 +1,12 @@
+
ExpandSynsFail3.hs:21:8: error:
- Couldn't match type ‘Int’ with ‘Bool’
- Expected type: T (T3, T5, Int)
- Actual type: T (T5, T3, Bool)
- Type synonyms expanded:
- Expected type: T (T3, T3, Int)
- Actual type: T (T3, T3, Bool)
- In the first argument of ‘f’, namely
- ‘(undefined :: T (T5, T3, Bool))’
- In the expression: f (undefined :: T (T5, T3, Bool))
- In an equation for ‘a’: a = f (undefined :: T (T5, T3, Bool))
+ • Couldn't match type ‘Bool’ with ‘Int’
+ Expected: T (T3, T5, Int)
+ Actual: T (T5, T3, Bool)
+ Type synonyms expanded:
+ Expected type: T (T3, T3, Int)
+ Actual type: T (T3, T3, Bool)
+ • In the first argument of ‘f’, namely
+ ‘(undefined :: T (T5, T3, Bool))’
+ In the expression: f (undefined :: T (T5, T3, Bool))
+ In an equation for ‘a’: a = f (undefined :: T (T5, T3, Bool))
diff --git a/testsuite/tests/typecheck/should_fail/ExpandSynsFail4.stderr b/testsuite/tests/typecheck/should_fail/ExpandSynsFail4.stderr
index bae53ce104..d11f72a758 100644
--- a/testsuite/tests/typecheck/should_fail/ExpandSynsFail4.stderr
+++ b/testsuite/tests/typecheck/should_fail/ExpandSynsFail4.stderr
@@ -1,7 +1,8 @@
+
ExpandSynsFail4.hs:11:22: error:
- Couldn't match type ‘Bool’ with ‘Int’
- Expected type: T Int
- Actual type: T Bool
- In the first argument of ‘f’, namely ‘(undefined :: T Bool)’
- In the second argument of ‘($)’, namely ‘f (undefined :: T Bool)’
- In the expression: putStrLn $ f (undefined :: T Bool)
+ • Couldn't match type ‘Bool’ with ‘Int’
+ Expected: T Int
+ Actual: T Bool
+ • In the first argument of ‘f’, namely ‘(undefined :: T Bool)’
+ In the second argument of ‘($)’, namely ‘f (undefined :: T Bool)’
+ In the expression: putStrLn $ f (undefined :: T Bool)
diff --git a/testsuite/tests/typecheck/should_fail/FrozenErrorTests.stderr b/testsuite/tests/typecheck/should_fail/FrozenErrorTests.stderr
index 613d92b837..255b3ad702 100644
--- a/testsuite/tests/typecheck/should_fail/FrozenErrorTests.stderr
+++ b/testsuite/tests/typecheck/should_fail/FrozenErrorTests.stderr
@@ -1,7 +1,6 @@
FrozenErrorTests.hs:26:9: error:
- • Occurs check: cannot construct the infinite type: a ~ [a]
- arising from a use of ‘goo1’
+ • Couldn't match type ‘a’ with ‘[a]’ arising from a use of ‘goo1’
• In the expression: goo1 False undefined
In an equation for ‘test1’: test1 = goo1 False undefined
• Relevant bindings include
@@ -21,7 +20,8 @@ FrozenErrorTests.hs:30:9: error:
In an equation for ‘test3’: test3 = goo1 False (goo2 undefined)
FrozenErrorTests.hs:45:15: error:
- • Couldn't match type ‘T2 c c’ with ‘M (T2 (T2 c c) c)’
+ • Couldn't match type: T2 c c
+ with: M (T2 (T2 c c) c)
arising from a use of ‘goo3’
• In the first argument of ‘goo4’, namely ‘(goo3 False undefined)’
In the expression: goo4 (goo3 False undefined)
@@ -30,7 +30,8 @@ FrozenErrorTests.hs:45:15: error:
test4 :: T2 (T2 c c) c (bound at FrozenErrorTests.hs:45:1)
FrozenErrorTests.hs:46:9: error:
- • Couldn't match type ‘T2 c c’ with ‘M (T2 (T2 c c) c)’
+ • Couldn't match type: T2 c c
+ with: M (T2 (T2 c c) c)
arising from a use of ‘goo3’
• In the expression: goo3 False (goo4 undefined)
In an equation for ‘test5’: test5 = goo3 False (goo4 undefined)
diff --git a/testsuite/tests/typecheck/should_fail/LevPolyBounded.stderr b/testsuite/tests/typecheck/should_fail/LevPolyBounded.stderr
index afa8330765..114d3e962d 100644
--- a/testsuite/tests/typecheck/should_fail/LevPolyBounded.stderr
+++ b/testsuite/tests/typecheck/should_fail/LevPolyBounded.stderr
@@ -1,10 +1,16 @@
LevPolyBounded.hs:10:15: error:
• Expected a type, but ‘a’ has kind ‘TYPE r’
+ ‘r’ is a rigid type variable bound by
+ the class declaration for ‘XBounded’
+ at LevPolyBounded.hs:9:27
• In the type signature: LevPolyBounded.minBound :: a
In the class declaration for ‘XBounded’
LevPolyBounded.hs:11:15: error:
• Expected a type, but ‘a’ has kind ‘TYPE r’
+ ‘r’ is a rigid type variable bound by
+ the class declaration for ‘XBounded’
+ at LevPolyBounded.hs:9:27
• In the type signature: LevPolyBounded.maxBound :: a
In the class declaration for ‘XBounded’
diff --git a/testsuite/tests/typecheck/should_fail/T10194.stderr b/testsuite/tests/typecheck/should_fail/T10194.stderr
index aeaad79440..60374ffe16 100644
--- a/testsuite/tests/typecheck/should_fail/T10194.stderr
+++ b/testsuite/tests/typecheck/should_fail/T10194.stderr
@@ -1,7 +1,9 @@
T10194.hs:7:8: error:
- • Cannot instantiate unification variable ‘b0’
+ • Couldn't match type ‘b0’ with ‘X’
+ Expected: (X -> c) -> (a -> X) -> a -> c
+ Actual: (b0 -> c) -> (a -> b0) -> a -> c
+ Cannot instantiate unification variable ‘b0’
with a type involving polytypes: X
- GHC doesn't yet support impredicative polymorphism
• In the expression: (.)
In an equation for ‘comp’: comp = (.)
diff --git a/testsuite/tests/typecheck/should_fail/T10619.stderr b/testsuite/tests/typecheck/should_fail/T10619.stderr
index 9d34750675..481a08a20c 100644
--- a/testsuite/tests/typecheck/should_fail/T10619.stderr
+++ b/testsuite/tests/typecheck/should_fail/T10619.stderr
@@ -1,8 +1,11 @@
T10619.hs:9:15: error:
- • Couldn't match type ‘forall a. a -> a’ with ‘b -> b’
- Expected type: (b -> b) -> b -> b
- Actual type: (forall a. a -> a) -> b -> b
+ • Couldn't match type ‘p’ with ‘forall b. b -> b’
+ Expected: p -> p
+ Actual: (forall a. a -> a) -> forall b. b -> b
+ ‘p’ is a rigid type variable bound by
+ the inferred type of foo :: p1 -> p -> p
+ at T10619.hs:(8,1)-(10,20)
• In the expression:
(\ x -> x) :: (forall a. a -> a) -> forall b. b -> b
In the expression:
@@ -17,12 +20,15 @@ T10619.hs:9:15: error:
else
\ y -> y
• Relevant bindings include
- foo :: p -> (b -> b) -> b -> b (bound at T10619.hs:8:1)
+ foo :: p1 -> p -> p (bound at T10619.hs:8:1)
T10619.hs:14:15: error:
- • Couldn't match type ‘forall a. a -> a’ with ‘b -> b’
- Expected type: (b -> b) -> b -> b
- Actual type: (forall a. a -> a) -> b -> b
+ • Couldn't match type ‘p’ with ‘forall a. a -> a’
+ Expected: p -> p
+ Actual: (forall a. a -> a) -> forall b. b -> b
+ ‘p’ is a rigid type variable bound by
+ the inferred type of bar :: p1 -> p -> p
+ at T10619.hs:(12,1)-(14,66)
• In the expression:
(\ x -> x) :: (forall a. a -> a) -> forall b. b -> b
In the expression:
@@ -37,26 +43,32 @@ T10619.hs:14:15: error:
else
((\ x -> x) :: (forall a. a -> a) -> forall b. b -> b)
• Relevant bindings include
- bar :: p -> (b -> b) -> b -> b (bound at T10619.hs:12:1)
+ bar :: p1 -> p -> p (bound at T10619.hs:12:1)
T10619.hs:16:13: error:
- • Couldn't match type ‘forall a. a -> a’ with ‘b -> b’
- Expected type: (b -> b) -> b -> b
- Actual type: (forall a. a -> a) -> b -> b
+ • Couldn't match type ‘p’ with ‘forall b. b -> b’
+ Expected: p -> p
+ Actual: (forall a. a -> a) -> forall b. b -> b
+ ‘p’ is a rigid type variable bound by
+ the inferred type of baz :: Bool -> p -> p
+ at T10619.hs:(16,1)-(17,19)
• In the expression:
(\ x -> x) :: (forall a. a -> a) -> forall b. b -> b
In an equation for ‘baz’:
baz True = (\ x -> x) :: (forall a. a -> a) -> forall b. b -> b
• Relevant bindings include
- baz :: Bool -> (b -> b) -> b -> b (bound at T10619.hs:16:1)
+ baz :: Bool -> p -> p (bound at T10619.hs:16:1)
T10619.hs:20:14: error:
- • Couldn't match type ‘forall a. a -> a’ with ‘b -> b’
- Expected type: (b -> b) -> b -> b
- Actual type: (forall a. a -> a) -> b -> b
+ • Couldn't match type ‘p’ with ‘forall a. a -> a’
+ Expected: p -> p
+ Actual: (forall a. a -> a) -> forall b. b -> b
+ ‘p’ is a rigid type variable bound by
+ the inferred type of quux :: Bool -> p -> p
+ at T10619.hs:(19,1)-(20,64)
• In the expression:
(\ x -> x) :: (forall a. a -> a) -> forall b. b -> b
In an equation for ‘quux’:
quux True = (\ x -> x) :: (forall a. a -> a) -> forall b. b -> b
• Relevant bindings include
- quux :: Bool -> (b -> b) -> b -> b (bound at T10619.hs:19:1)
+ quux :: Bool -> p -> p (bound at T10619.hs:19:1)
diff --git a/testsuite/tests/typecheck/should_fail/T10715b.stderr b/testsuite/tests/typecheck/should_fail/T10715b.stderr
index 8c7f370273..99875bbcf5 100644
--- a/testsuite/tests/typecheck/should_fail/T10715b.stderr
+++ b/testsuite/tests/typecheck/should_fail/T10715b.stderr
@@ -1,8 +1,12 @@
T10715b.hs:7:7: error:
- Occurs check: cannot construct the infinite type: b ~ [b]
- arising from a use of ‘coerce’
- In the first argument of ‘asTypeOf’, namely ‘coerce’
- In the expression: coerce `asTypeOf` head
- In an equation for ‘foo’: foo = coerce `asTypeOf` head
- Relevant bindings include foo :: [b] -> b (bound at T10715b.hs:7:1)
+ • Couldn't match representation of type ‘b’ with that of ‘[b]’
+ arising from a use of ‘coerce’
+ ‘b’ is a rigid type variable bound by
+ the inferred type of foo :: [b] -> b
+ at T10715b.hs:7:1-28
+ • In the first argument of ‘asTypeOf’, namely ‘coerce’
+ In the expression: coerce `asTypeOf` head
+ In an equation for ‘foo’: foo = coerce `asTypeOf` head
+ • Relevant bindings include
+ foo :: [b] -> b (bound at T10715b.hs:7:1)
diff --git a/testsuite/tests/typecheck/should_fail/T10971d.stderr b/testsuite/tests/typecheck/should_fail/T10971d.stderr
index 5cf339bd8d..93dce724d0 100644
--- a/testsuite/tests/typecheck/should_fail/T10971d.stderr
+++ b/testsuite/tests/typecheck/should_fail/T10971d.stderr
@@ -1,18 +1,21 @@
T10971d.hs:4:14: error:
- • Couldn't match expected type ‘[a0]’ with actual type ‘Maybe a2’
+ • Couldn't match expected type: [a0]
+ with actual type: Maybe a3
• In the first argument of ‘f’, namely ‘(Just 1)’
In the second argument of ‘($)’, namely ‘f (Just 1)’
In a stmt of a 'do' block: print $ f (Just 1)
T10971d.hs:5:19: error:
- • Couldn't match expected type ‘[b1]’ with actual type ‘Maybe a3’
+ • Couldn't match expected type: [b0]
+ with actual type: Maybe a4
• In the second argument of ‘g’, namely ‘(Just 5)’
In the second argument of ‘($)’, namely ‘g (+ 1) (Just 5)’
In a stmt of a 'do' block: print $ g (+ 1) (Just 5)
T10971d.hs:6:23: error:
- • Couldn't match expected type ‘[b0]’ with actual type ‘Maybe a1’
+ • Couldn't match expected type: [a2]
+ with actual type: Maybe a1
• In the second argument of ‘h’, namely ‘Nothing’
In the second argument of ‘($)’, namely ‘h (const 5) Nothing’
In a stmt of a 'do' block: print $ h (const 5) Nothing
diff --git a/testsuite/tests/typecheck/should_fail/T11514.stderr b/testsuite/tests/typecheck/should_fail/T11514.stderr
index 62acf15b73..dd940a36b1 100644
--- a/testsuite/tests/typecheck/should_fail/T11514.stderr
+++ b/testsuite/tests/typecheck/should_fail/T11514.stderr
@@ -1,8 +1,9 @@
T11514.hs:6:7: error:
- • Cannot instantiate unification variable ‘a0’
+ • Couldn't match expected type ‘(Show a => a -> a) -> ()’
+ with actual type ‘a0’
+ Cannot instantiate unification variable ‘a0’
with a type involving polytypes: (Show a => a -> a) -> ()
- GHC doesn't yet support impredicative polymorphism
• In the expression: undefined
In an equation for ‘foo’: foo = undefined
• Relevant bindings include
diff --git a/testsuite/tests/typecheck/should_fail/T11672.stderr b/testsuite/tests/typecheck/should_fail/T11672.stderr
index 16eb31042f..a0f8d7e36c 100644
--- a/testsuite/tests/typecheck/should_fail/T11672.stderr
+++ b/testsuite/tests/typecheck/should_fail/T11672.stderr
@@ -4,8 +4,8 @@ T11672.hs:9:10: error:
When matching types
a0 :: Symbol
Int -> Bool :: *
- Expected type: Proxy a0
- Actual type: Proxy (Int -> Bool)
+ Expected: Proxy a0
+ Actual: Proxy (Int -> Bool)
• In the first argument of ‘f’, namely
‘(Proxy :: Proxy (Int -> Bool))’
In the expression: f (Proxy :: Proxy (Int -> Bool))
diff --git a/testsuite/tests/typecheck/should_fail/T12170a.stderr b/testsuite/tests/typecheck/should_fail/T12170a.stderr
index c1e4bdcecb..a8f349df43 100644
--- a/testsuite/tests/typecheck/should_fail/T12170a.stderr
+++ b/testsuite/tests/typecheck/should_fail/T12170a.stderr
@@ -1,9 +1,9 @@
-T12170a.hs:20:7: error:
+T12170a.hs:20:35: error:
• Couldn't match type ‘Ref m0’ with ‘IORef’
- Expected type: IO (Ref m0 (f0 ()))
- Actual type: IO (Ref IO (f0 ()))
+ Expected: IORef (f0 ()) -> m0 (f0 ())
+ Actual: Ref m0 (f0 ()) -> m0 (f0 ())
The type variable ‘m0’ is ambiguous
- • In the first argument of ‘(>>=)’, namely ‘newRef (pure ())’
+ • In the second argument of ‘(.)’, namely ‘readRef’
+ In the second argument of ‘(>>=)’, namely ‘join . readRef’
In the expression: newRef (pure ()) >>= join . readRef
- In an equation for ‘foo’: foo = newRef (pure ()) >>= join . readRef \ No newline at end of file
diff --git a/testsuite/tests/typecheck/should_fail/T12373.stderr b/testsuite/tests/typecheck/should_fail/T12373.stderr
index a2568d75f9..20137fbdad 100644
--- a/testsuite/tests/typecheck/should_fail/T12373.stderr
+++ b/testsuite/tests/typecheck/should_fail/T12373.stderr
@@ -4,8 +4,8 @@ T12373.hs:10:19: error:
When matching types
a0 :: *
MVar# RealWorld a1 :: TYPE 'UnliftedRep
- Expected type: (# State# RealWorld, a0 #)
- Actual type: (# State# RealWorld, MVar# RealWorld a1 #)
+ Expected: (# State# RealWorld, a0 #)
+ Actual: (# State# RealWorld, MVar# RealWorld a1 #)
• In the expression: newMVar# rw
In the first argument of ‘IO’, namely ‘(\ rw -> newMVar# rw)’
In the first argument of ‘(>>)’, namely ‘IO (\ rw -> newMVar# rw)’
diff --git a/testsuite/tests/typecheck/should_fail/T12563.stderr b/testsuite/tests/typecheck/should_fail/T12563.stderr
index e6619aa1da..f141a23e96 100644
--- a/testsuite/tests/typecheck/should_fail/T12563.stderr
+++ b/testsuite/tests/typecheck/should_fail/T12563.stderr
@@ -1,8 +1,9 @@
T12563.hs:7:15: error:
- • Cannot instantiate unification variable ‘p0’
+ • Couldn't match expected type ‘(forall a. f0 a) -> f0 r0’
+ with actual type ‘p0’
+ Cannot instantiate unification variable ‘p0’
with a type involving polytypes: (forall a. f0 a) -> f0 r0
- GHC doesn't yet support impredicative polymorphism
• In the first argument of ‘foo’, namely ‘g’
In the expression: foo g
In the expression: \ g -> foo g
diff --git a/testsuite/tests/typecheck/should_fail/T12589.stderr b/testsuite/tests/typecheck/should_fail/T12589.stderr
index 80ea5edb80..5f359090d9 100644
--- a/testsuite/tests/typecheck/should_fail/T12589.stderr
+++ b/testsuite/tests/typecheck/should_fail/T12589.stderr
@@ -2,10 +2,11 @@
T12589.hs:13:3: error: Variable not in scope: (&) :: t0 -> t1 -> t
T12589.hs:13:5: error:
- • Cannot instantiate unification variable ‘t1’
+ • Couldn't match expected type ‘t1’
+ with actual type ‘(forall a. Bounded a => f0 a) -> h0 f0 xs0’
+ Cannot instantiate unification variable ‘t1’
with a type involving polytypes:
(forall a. Bounded a => f0 a) -> h0 f0 xs0
- GHC doesn't yet support impredicative polymorphism
• In the second argument of ‘(&)’, namely ‘hcpure (Proxy @Bounded)’
In the expression: minBound & hcpure (Proxy @Bounded)
In an equation for ‘a’: a = minBound & hcpure (Proxy @Bounded)
diff --git a/testsuite/tests/typecheck/should_fail/T12648.stderr b/testsuite/tests/typecheck/should_fail/T12648.stderr
index 227bc6773e..f13b6c1cd0 100644
--- a/testsuite/tests/typecheck/should_fail/T12648.stderr
+++ b/testsuite/tests/typecheck/should_fail/T12648.stderr
@@ -1,12 +1,12 @@
T12648.hs:76:2: error:
• Couldn't match type ‘a’ with ‘()’
+ Expected: m a
+ Actual: m ()
‘a’ is a rigid type variable bound by
the type signature for:
f :: forall (m :: * -> *) a. MonadBaseUnlift m IO => m a
at T12648.hs:71:1-34
- Expected type: m a
- Actual type: m ()
• In a stmt of a 'do' block: return ()
In the expression:
do _ <- askUnliftBase
diff --git a/testsuite/tests/typecheck/should_fail/T12906.stderr b/testsuite/tests/typecheck/should_fail/T12906.stderr
index c74fd97bbc..f1f245c912 100644
--- a/testsuite/tests/typecheck/should_fail/T12906.stderr
+++ b/testsuite/tests/typecheck/should_fail/T12906.stderr
@@ -3,8 +3,9 @@ T12906.hs:1:1: error:
The IO action ‘main’ is not defined in module ‘Main’
T12906.hs:2:7: error:
- • Couldn't match type ‘IO ()’ with ‘[Char]’
- Expected type: String
- Actual type: IO ()
+ • Couldn't match type: IO ()
+ with: [Char]
+ Expected: String
+ Actual: IO ()
• In the expression: print (reverse s + 1)
In an equation for ‘x’: x s = print (reverse s + 1)
diff --git a/testsuite/tests/typecheck/should_fail/T12921.stderr b/testsuite/tests/typecheck/should_fail/T12921.stderr
index d38ccf22b9..f10faf2751 100644
--- a/testsuite/tests/typecheck/should_fail/T12921.stderr
+++ b/testsuite/tests/typecheck/should_fail/T12921.stderr
@@ -10,7 +10,7 @@ T12921.hs:4:1: error:
instance Data.Data.Data Ordering -- Defined in ‘Data.Data’
instance Data.Data.Data Integer -- Defined in ‘Data.Data’
...plus 15 others
- ...plus 47 instances involving out-of-scope types
+ ...plus 50 instances involving out-of-scope types
(use -fprint-potential-instances to see them all)
• In the annotation:
{-# ANN module "HLint: ignore Reduce duplication" #-}
diff --git a/testsuite/tests/typecheck/should_fail/T13292.stderr b/testsuite/tests/typecheck/should_fail/T13292.stderr
index adb2738e69..217c5d4a39 100644
--- a/testsuite/tests/typecheck/should_fail/T13292.stderr
+++ b/testsuite/tests/typecheck/should_fail/T13292.stderr
@@ -17,7 +17,7 @@ T13292a.hs:4:12: warning: [-Wdeferred-type-errors (in -Wdefault)]
T13292.hs:6:1: warning: [-Wdeferred-type-errors (in -Wdefault)]
• Couldn't match type ‘GHC.Types.Any’ with ‘IO’
- Expected type: IO ()
- Actual type: GHC.Types.Any ()
+ Expected: IO ()
+ Actual: GHC.Types.Any ()
• In the expression: main
When checking the type of the IO action ‘main’
diff --git a/testsuite/tests/typecheck/should_fail/T13311.stderr b/testsuite/tests/typecheck/should_fail/T13311.stderr
index d739d2173c..e858a6037e 100644
--- a/testsuite/tests/typecheck/should_fail/T13311.stderr
+++ b/testsuite/tests/typecheck/should_fail/T13311.stderr
@@ -1,7 +1,7 @@
T13311.hs:9:3: error:
- • Couldn't match expected type ‘IO a0’
- with actual type ‘Maybe a1 -> Maybe b0’
+ • Couldn't match expected type: IO a0
+ with actual type: Maybe a1 -> Maybe b0
• Probable cause: ‘f’ is applied to too few arguments
In a stmt of a 'do' block: f
In the expression:
diff --git a/testsuite/tests/typecheck/should_fail/T13320.stderr b/testsuite/tests/typecheck/should_fail/T13320.stderr
index afafdb3074..4442069d15 100644
--- a/testsuite/tests/typecheck/should_fail/T13320.stderr
+++ b/testsuite/tests/typecheck/should_fail/T13320.stderr
@@ -1,6 +1,7 @@
T13320.hs:32:21: error:
- • Couldn't match type ‘X_Var ξ’ with ‘TermX ξ’
+ • Couldn't match type: X_Var ξ
+ with: TermX ξ
arising from a use of ‘genTerm’
• In the first argument of ‘sized’, namely ‘genTerm’
In the expression: sized genTerm
diff --git a/testsuite/tests/typecheck/should_fail/T13530.stderr b/testsuite/tests/typecheck/should_fail/T13530.stderr
index 139c1b0f34..4b540f297c 100644
--- a/testsuite/tests/typecheck/should_fail/T13530.stderr
+++ b/testsuite/tests/typecheck/should_fail/T13530.stderr
@@ -4,7 +4,7 @@ T13530.hs:11:7: error:
When matching types
a0 :: *
Int# :: TYPE 'IntRep
- Expected type: (# Int#, Int# #)
- Actual type: (# Int#, a0 #)
+ Expected: (# Int#, Int# #)
+ Actual: (# Int#, a0 #)
• In the expression: g x
In an equation for ‘f’: f x = g x
diff --git a/testsuite/tests/typecheck/should_fail/T13610.stderr b/testsuite/tests/typecheck/should_fail/T13610.stderr
index 0755ce9371..c04687988c 100644
--- a/testsuite/tests/typecheck/should_fail/T13610.stderr
+++ b/testsuite/tests/typecheck/should_fail/T13610.stderr
@@ -4,8 +4,8 @@ T13610.hs:11:15: error:
When matching types
a :: *
Weak# () :: TYPE 'UnliftedRep
- Expected type: (# State# RealWorld, a #)
- Actual type: (# State# RealWorld, Weak# () #)
+ Expected: (# State# RealWorld, a #)
+ Actual: (# State# RealWorld, Weak# () #)
• In the expression: mkWeakNoFinalizer# double () s
In the first argument of ‘IO’, namely
‘(\ s -> mkWeakNoFinalizer# double () s)’
diff --git a/testsuite/tests/typecheck/should_fail/T13909.stderr b/testsuite/tests/typecheck/should_fail/T13909.stderr
index 599be5a445..0cbae70733 100644
--- a/testsuite/tests/typecheck/should_fail/T13909.stderr
+++ b/testsuite/tests/typecheck/should_fail/T13909.stderr
@@ -1,5 +1,7 @@
T13909.hs:11:18: error:
• Expected kind ‘k0’, but ‘Hm’ has kind ‘forall k -> k -> *’
+ Cannot instantiate unification variable ‘k0’
+ with a kind involving polytypes: forall k -> k -> *
• In the first argument of ‘HasName’, namely ‘Hm’
In the instance declaration for ‘HasName Hm’
diff --git a/testsuite/tests/typecheck/should_fail/T14605.stderr b/testsuite/tests/typecheck/should_fail/T14605.stderr
index 09181c6ee8..04d8b5a67d 100644
--- a/testsuite/tests/typecheck/should_fail/T14605.stderr
+++ b/testsuite/tests/typecheck/should_fail/T14605.stderr
@@ -1,8 +1,8 @@
T14605.hs:14:13: error:
- • Couldn't match representation of type ‘x1’ with that of ‘()’
+ • Couldn't match representation of type ‘x’ with that of ‘()’
arising from a use of ‘coerce’
- ‘x1’ is a rigid type variable bound by
+ ‘x’ is a rigid type variable bound by
the type ()
at T14605.hs:14:1-49
• In the expression: coerce @(forall x. ()) @(forall x. x)
diff --git a/testsuite/tests/typecheck/should_fail/T14618.stderr b/testsuite/tests/typecheck/should_fail/T14618.stderr
index 8faa64c25e..2faf4a925b 100644
--- a/testsuite/tests/typecheck/should_fail/T14618.stderr
+++ b/testsuite/tests/typecheck/should_fail/T14618.stderr
@@ -1,16 +1,12 @@
T14618.hs:6:14: error:
- • Couldn't match type ‘a’ with ‘b’
- ‘a’ is a rigid type variable bound by
- the type signature for:
- safeCoerce :: forall a b. a -> b
- at T14618.hs:5:1-20
+ • Couldn't match type ‘b’ with ‘forall c. a’
+ Expected: a -> b
+ Actual: a -> forall c. a
‘b’ is a rigid type variable bound by
the type signature for:
safeCoerce :: forall a b. a -> b
at T14618.hs:5:1-20
- Expected type: a -> b
- Actual type: b -> b
• In the expression: f'
In an equation for ‘safeCoerce’:
safeCoerce
diff --git a/testsuite/tests/typecheck/should_fail/T14884.stderr b/testsuite/tests/typecheck/should_fail/T14884.stderr
index cb85da14a5..f454bb5625 100644
--- a/testsuite/tests/typecheck/should_fail/T14884.stderr
+++ b/testsuite/tests/typecheck/should_fail/T14884.stderr
@@ -1,6 +1,6 @@
T14884.hs:4:5: error:
- • Found hole: _ :: (a0 -> IO ()) -> [Char] -> IO ()
+ • Found hole: _ :: (a0 -> IO ()) -> String -> IO ()
Where: ‘a0’ is an ambiguous type variable
• In the expression: _
In the expression: _ print "abc"
@@ -20,15 +20,15 @@ T14884.hs:4:5: error:
(imported from ‘Prelude’ at T14884.hs:1:8-13
(and originally defined in ‘Data.Foldable’))
($) :: forall a b. (a -> b) -> a -> b
- with ($) @'GHC.Types.LiftedRep @[Char] @(IO ())
+ with ($) @'GHC.Types.LiftedRep @String @(IO ())
(imported from ‘Prelude’ at T14884.hs:1:8-13
(and originally defined in ‘GHC.Base’))
($!) :: forall a b. (a -> b) -> a -> b
- with ($!) @'GHC.Types.LiftedRep @[Char] @(IO ())
+ with ($!) @'GHC.Types.LiftedRep @String @(IO ())
(imported from ‘Prelude’ at T14884.hs:1:8-13
(and originally defined in ‘GHC.Base’))
id :: forall a. a -> a
- with id @([Char] -> IO ())
+ with id @(String -> IO ())
(imported from ‘Prelude’ at T14884.hs:1:8-13
(and originally defined in ‘GHC.Base’))
diff --git a/testsuite/tests/typecheck/should_fail/T14904a.stderr b/testsuite/tests/typecheck/should_fail/T14904a.stderr
index ea92de3465..c0e2b84a80 100644
--- a/testsuite/tests/typecheck/should_fail/T14904a.stderr
+++ b/testsuite/tests/typecheck/should_fail/T14904a.stderr
@@ -1,5 +1,7 @@
T14904a.hs:9:6: error:
• Expected kind ‘forall (a :: k1). g a’, but ‘f’ has kind ‘k0’
+ Cannot instantiate unification variable ‘k0’
+ with a kind involving polytypes: forall (a :: k1). g a
• In the first argument of ‘F’, namely ‘(f :: forall a. g a)’
In the type family declaration for ‘F’
diff --git a/testsuite/tests/typecheck/should_fail/T14904b.stderr b/testsuite/tests/typecheck/should_fail/T14904b.stderr
index fff6942af1..83a9ec15fa 100644
--- a/testsuite/tests/typecheck/should_fail/T14904b.stderr
+++ b/testsuite/tests/typecheck/should_fail/T14904b.stderr
@@ -1,6 +1,8 @@
T14904b.hs:9:7: error:
• Expected kind ‘forall (a :: k1). g a’, but ‘f’ has kind ‘k0’
+ Cannot instantiate unification variable ‘k0’
+ with a kind involving polytypes: forall (a :: k1). g a
• In the first argument of ‘F’, namely
‘((f :: forall a. g a) :: forall a. g a)’
In the type family declaration for ‘F’
diff --git a/testsuite/tests/typecheck/should_fail/T15330.stderr b/testsuite/tests/typecheck/should_fail/T15330.stderr
index cef80452a1..c2bf2447cc 100644
--- a/testsuite/tests/typecheck/should_fail/T15330.stderr
+++ b/testsuite/tests/typecheck/should_fail/T15330.stderr
@@ -1,13 +1,17 @@
T15330.hs:11:6: error:
- • Couldn't match expected type ‘Proxy (T 'True)’
- with actual type ‘[Char]’
+ • Couldn't match type: [Char]
+ with: Proxy (T 'True)
+ Expected: Proxy (T 'True)
+ Actual: String
• In the expression: "foo"
In an equation for ‘f1’: f1 = "foo"
T15330.hs:15:6: error:
- • Couldn't match expected type ‘Proxy (t 'True)’
- with actual type ‘[Char]’
+ • Couldn't match type: [Char]
+ with: Proxy (t 'True)
+ Expected: Proxy (t 'True)
+ Actual: String
• In the expression: "foo"
In an equation for ‘f2’: f2 = "foo"
• Relevant bindings include
diff --git a/testsuite/tests/typecheck/should_fail/T15361.stderr b/testsuite/tests/typecheck/should_fail/T15361.stderr
index 4b8c23ebf2..1520bc3982 100644
--- a/testsuite/tests/typecheck/should_fail/T15361.stderr
+++ b/testsuite/tests/typecheck/should_fail/T15361.stderr
@@ -6,6 +6,8 @@ T15361.hs:13:13: error:
HRefl :: forall {k1} (a :: k1). a :~~: a,
in an equation for ‘foo’
at T15361.hs:13:5-9
+ Expected: a :~~: c
+ Actual: a :~~: a
‘a’ is a rigid type variable bound by
the type signature for:
foo :: forall a b c. (a :~~: b) -> a :~~: c
@@ -14,8 +16,6 @@ T15361.hs:13:13: error:
the type signature for:
foo :: forall a b c. (a :~~: b) -> a :~~: c
at T15361.hs:(11,1)-(12,27)
- Expected type: a :~~: c
- Actual type: a :~~: a
• In the expression: HRefl
In an equation for ‘foo’: foo HRefl = HRefl
• Relevant bindings include
diff --git a/testsuite/tests/typecheck/should_fail/T15438.hs b/testsuite/tests/typecheck/should_fail/T15438.hs
index 0f995389a0..975afa3e9e 100644
--- a/testsuite/tests/typecheck/should_fail/T15438.hs
+++ b/testsuite/tests/typecheck/should_fail/T15438.hs
@@ -4,5 +4,7 @@ module T15438 where
class C a b
+-- With simple subsumption (#17775) we
+-- no longer get an ambiguity check here
foo :: (forall a b. C a b => b -> b) -> Int
-foo = error "urk"
+foo x = error "urk"
diff --git a/testsuite/tests/typecheck/should_fail/T15438.stderr b/testsuite/tests/typecheck/should_fail/T15438.stderr
deleted file mode 100644
index 473d5dcc98..0000000000
--- a/testsuite/tests/typecheck/should_fail/T15438.stderr
+++ /dev/null
@@ -1,11 +0,0 @@
-
-T15438.hs:7:8: error:
- • Could not deduce (C a0 b)
- from the context: C a b
- bound by a type expected by the context:
- forall a b. C a b => b -> b
- at T15438.hs:7:8-43
- The type variable ‘a0’ is ambiguous
- • In the ambiguity check for ‘foo’
- To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
- In the type signature: foo :: (forall a b. C a b => b -> b) -> Int
diff --git a/testsuite/tests/typecheck/should_fail/T15629.stderr b/testsuite/tests/typecheck/should_fail/T15629.stderr
index ac307ed9d5..09d59fdf62 100644
--- a/testsuite/tests/typecheck/should_fail/T15629.stderr
+++ b/testsuite/tests/typecheck/should_fail/T15629.stderr
@@ -1,39 +1,19 @@
T15629.hs:26:37: error:
- • Expected kind ‘x1 ~> F x1 ab1’,
- but ‘F1Sym :: x ~> F x z’ has kind ‘x1 ~> F x1 z1’
+ • Couldn't match kind ‘z’ with ‘ab’
+ Expected kind ‘x ~> F x ab’,
+ but ‘F1Sym :: x ~> F x z’ has kind ‘x ~> F x z’
+ ‘z’ is a rigid type variable bound by
+ ‘forall z ab.
+ Proxy ((Comp (F1Sym :: x ~> F x z) F2Sym) :: F x ab ~> F x ab)’
+ at T15629.hs:26:17
+ ‘ab’ is a rigid type variable bound by
+ ‘forall z ab.
+ Proxy ((Comp (F1Sym :: x ~> F x z) F2Sym) :: F x ab ~> F x ab)’
+ at T15629.hs:26:19-20
• In the first argument of ‘Comp’, namely ‘(F1Sym :: x ~> F x z)’
In the first argument of ‘Proxy’, namely
‘((Comp (F1Sym :: x ~> F x z) F2Sym) :: F x ab ~> F x ab)’
In the type signature:
g :: forall z ab.
Proxy ((Comp (F1Sym :: x ~> F x z) F2Sym) :: F x ab ~> F x ab)
-
-T15629.hs:27:9: error:
- • Couldn't match kind ‘z1’ with ‘ab1’
- ‘z1’ is a rigid type variable bound by
- the type signature for:
- g :: forall z1 ab1. Proxy (Comp F1Sym F2Sym)
- at T15629.hs:26:5-84
- ‘ab1’ is a rigid type variable bound by
- the type signature for:
- g :: forall z1 ab1. Proxy (Comp F1Sym F2Sym)
- at T15629.hs:26:5-84
- When matching types
- f0 :: x ~> F x ab
- F1Sym :: TyFun x1 (F x1 z1) -> *
- Expected type: Proxy (Comp F1Sym F2Sym)
- Actual type: Proxy (Comp f0 F2Sym)
- • In the expression: sg Proxy Proxy
- In an equation for ‘g’: g = sg Proxy Proxy
- In an equation for ‘f’:
- f _
- = ()
- where
- g ::
- forall z ab.
- Proxy ((Comp (F1Sym :: x ~> F x z) F2Sym) :: F x ab ~> F x ab)
- g = sg Proxy Proxy
- • Relevant bindings include
- g :: Proxy (Comp F1Sym F2Sym) (bound at T15629.hs:27:5)
- f :: Proxy x1 -> () (bound at T15629.hs:24:1)
diff --git a/testsuite/tests/typecheck/should_fail/T15648.stderr b/testsuite/tests/typecheck/should_fail/T15648.stderr
index 192d8d15e8..7de4bc9e18 100644
--- a/testsuite/tests/typecheck/should_fail/T15648.stderr
+++ b/testsuite/tests/typecheck/should_fail/T15648.stderr
@@ -1,9 +1,9 @@
T15648.hs:23:21: error:
- • Couldn't match type ‘(a0 GHC.Prim.~# b0) -> JankyEquality a0 b0’
- with ‘JankyEquality a a’
- Expected type: JankyEquality a b
- Actual type: (a0 GHC.Prim.~# b0) -> JankyEquality a0 b0
+ • Couldn't match type: (a0 GHC.Prim.~# b0) -> JankyEquality a0 b0
+ with: JankyEquality a a
+ Expected: JankyEquality a b
+ Actual: (a0 GHC.Prim.~# b0) -> JankyEquality a0 b0
• Probable cause: ‘Jank’ is applied to too few arguments
In the expression: Jank
In an equation for ‘legitToJank’: legitToJank Legit = Jank
@@ -12,9 +12,9 @@ T15648.hs:23:21: error:
(bound at T15648.hs:23:1)
T15648.hs:30:10: error:
- • Couldn't match expected type ‘(a GHC.Prim.~# b)
- -> b GHC.Prim.~# a’
- with actual type ‘b GHC.Prim.~# a’
+ • Couldn't match expected type: (a GHC.Prim.~# b)
+ -> b GHC.Prim.~# a
+ with actual type: b GHC.Prim.~# a
• In the expression: unJank $ legitToJank $ mkLegit @b @a
In an equation for ‘ueqSym’:
ueqSym = unJank $ legitToJank $ mkLegit @b @a
diff --git a/testsuite/tests/typecheck/should_fail/T15801.stderr b/testsuite/tests/typecheck/should_fail/T15801.stderr
index e74972332c..2209d72ab8 100644
--- a/testsuite/tests/typecheck/should_fail/T15801.stderr
+++ b/testsuite/tests/typecheck/should_fail/T15801.stderr
@@ -1,6 +1,6 @@
T15801.hs:52:10: error:
- • Couldn't match representation of type ‘UnOp op_a -> UnOp b’
- with that of ‘op_a --> b’
+ • Couldn't match representation of type: UnOp op_a -> UnOp b
+ with that of: op_a --> b
arising from the superclasses of an instance declaration
• In the instance declaration for ‘OpRíki (Op (*))’
diff --git a/testsuite/tests/typecheck/should_fail/T16074.stderr b/testsuite/tests/typecheck/should_fail/T16074.stderr
index cd04542641..10b263efcb 100644
--- a/testsuite/tests/typecheck/should_fail/T16074.stderr
+++ b/testsuite/tests/typecheck/should_fail/T16074.stderr
@@ -1,6 +1,8 @@
T16074.hs:10:7: error:
• Couldn't match type ‘a’ with ‘b’
+ Expected: TYPE a :~: TYPE b
+ Actual: TYPE a :~: TYPE a
‘a’ is a rigid type variable bound by
the type signature for:
foo :: * :~: *
@@ -9,8 +11,6 @@ T16074.hs:10:7: error:
the type signature for:
foo :: * :~: *
at T16074.hs:9:1-24
- Expected type: TYPE a :~: TYPE b
- Actual type: TYPE a :~: TYPE a
• In the expression: Refl
In an equation for ‘foo’: foo = Refl
• Relevant bindings include
diff --git a/testsuite/tests/typecheck/should_fail/T16204c.stderr b/testsuite/tests/typecheck/should_fail/T16204c.stderr
index 48d63785ad..6ad532a4ea 100644
--- a/testsuite/tests/typecheck/should_fail/T16204c.stderr
+++ b/testsuite/tests/typecheck/should_fail/T16204c.stderr
@@ -4,8 +4,8 @@ T16204c.hs:16:8: error:
When matching types
a0 :: Rep
a :: *
- Expected type: Sing a
- Actual type: Sing a0
+ Expected: Sing a
+ Actual: Sing a0
• In the first argument of ‘id’, namely ‘sTo’
In the expression: id sTo
In an equation for ‘x’: x = id sTo
diff --git a/testsuite/tests/typecheck/should_fail/T16517.stderr b/testsuite/tests/typecheck/should_fail/T16517.stderr
index 8d20665afc..1e17286cff 100644
--- a/testsuite/tests/typecheck/should_fail/T16517.stderr
+++ b/testsuite/tests/typecheck/should_fail/T16517.stderr
@@ -1,6 +1,10 @@
T16517.hs:5:29: error:
• Expected kind ‘k’, but ‘a’ has kind ‘k0’
+ because kind variable ‘k’ would escape its scope
+ This (rigid, skolem) kind variable is bound by
+ the class declaration for ‘C’
+ at T16517.hs:5:22-35
• In the first argument of ‘Proxy’, namely ‘(a :: k)’
In the type signature: m :: Proxy (a :: k)
In the class declaration for ‘C’
diff --git a/testsuite/tests/typecheck/should_fail/T17077.stderr b/testsuite/tests/typecheck/should_fail/T17077.stderr
index 3d05adc3c3..3f27d19c70 100644
--- a/testsuite/tests/typecheck/should_fail/T17077.stderr
+++ b/testsuite/tests/typecheck/should_fail/T17077.stderr
@@ -1,5 +1,7 @@
T17077.hs:7:13: error:
• Expected kind ‘forall (k :: k1). a’, but ‘z’ has kind ‘k0’
+ Cannot instantiate unification variable ‘k0’
+ with a kind involving polytypes: forall (k2 :: k1). a
• In the first argument of ‘Proxy’, namely ‘(z :: forall k. a)’
In the type signature: t :: Proxy (z :: forall k. a)
diff --git a/testsuite/tests/typecheck/should_fail/T17775.hs b/testsuite/tests/typecheck/should_fail/T17775.hs
new file mode 100644
index 0000000000..b10f0725f5
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T17775.hs
@@ -0,0 +1,15 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RankNTypes #-}
+
+module T1 where
+
+
+
+g :: Int -> Char
+
+g _ = 'a'
+
+
+
+f :: Int -> Show Int => ()
+f = g
diff --git a/testsuite/tests/typecheck/should_fail/T17775.stderr b/testsuite/tests/typecheck/should_fail/T17775.stderr
new file mode 100644
index 0000000000..2dc0448ab8
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T17775.stderr
@@ -0,0 +1,7 @@
+
+T17775.hs:15:5: error:
+ • Couldn't match type ‘Char’ with ‘Show Int => ()’
+ Expected: Int -> Show Int => ()
+ Actual: Int -> Char
+ • In the expression: g
+ In an equation for ‘f’: f = g
diff --git a/testsuite/tests/typecheck/should_fail/T18127a.stderr b/testsuite/tests/typecheck/should_fail/T18127a.stderr
index ee354f7467..60dcb3e121 100644
--- a/testsuite/tests/typecheck/should_fail/T18127a.stderr
+++ b/testsuite/tests/typecheck/should_fail/T18127a.stderr
@@ -1,31 +1,33 @@
T18127a.hs:5:5: error:
- • Cannot instantiate unification variable ‘a1’
+ • Couldn't match expected type ‘(forall a. a) -> ()’
+ with actual type ‘a1’
+ Cannot instantiate unification variable ‘a1’
with a type involving polytypes: (forall a. a) -> ()
- GHC doesn't yet support impredicative polymorphism
• In the expression: undefined
In an equation for ‘a’: a = undefined
T18127a.hs:8:5: error:
- • Cannot instantiate unification variable ‘a3’
+ • Couldn't match expected type ‘(Show a => a) -> ()’
+ with actual type ‘a3’
+ Cannot instantiate unification variable ‘a3’
with a type involving polytypes: (Show a => a) -> ()
- GHC doesn't yet support impredicative polymorphism
• In the expression: undefined
In an equation for ‘b’: b = undefined
• Relevant bindings include
b :: (Show a => a) -> () (bound at T18127a.hs:8:1)
T18127a.hs:12:5: error:
- • Cannot instantiate unification variable ‘a0’
+ • Couldn't match expected type ‘C -> ()’ with actual type ‘a0’
+ Cannot instantiate unification variable ‘a0’
with a type involving polytypes: C -> ()
- GHC doesn't yet support impredicative polymorphism
• In the expression: undefined
In an equation for ‘c’: c = undefined
T18127a.hs:16:5: error:
- • Cannot instantiate unification variable ‘a2’
+ • Couldn't match expected type ‘D a -> ()’ with actual type ‘a2’
+ Cannot instantiate unification variable ‘a2’
with a type involving polytypes: D a -> ()
- GHC doesn't yet support impredicative polymorphism
• In the expression: undefined
In an equation for ‘d’: d = undefined
• Relevant bindings include
diff --git a/testsuite/tests/typecheck/should_fail/T1899.stderr b/testsuite/tests/typecheck/should_fail/T1899.stderr
index 9fe71027c0..eb84cba7b4 100644
--- a/testsuite/tests/typecheck/should_fail/T1899.stderr
+++ b/testsuite/tests/typecheck/should_fail/T1899.stderr
@@ -1,12 +1,12 @@
T1899.hs:14:36: error:
• Couldn't match type ‘a’ with ‘Proposition a0’
+ Expected: [Proposition a0]
+ Actual: [a]
‘a’ is a rigid type variable bound by
the type signature for:
transRHS :: forall a. [a] -> Int -> Constraint a
at T1899.hs:9:2-39
- Expected type: [Proposition a0]
- Actual type: [a]
• In the first argument of ‘Auxiliary’, namely ‘varSet’
In the first argument of ‘Prop’, namely ‘(Auxiliary varSet)’
In the expression: Prop (Auxiliary varSet)
diff --git a/testsuite/tests/typecheck/should_fail/T2414.stderr b/testsuite/tests/typecheck/should_fail/T2414.stderr
index bbbf5fce6a..1d89247489 100644
--- a/testsuite/tests/typecheck/should_fail/T2414.stderr
+++ b/testsuite/tests/typecheck/should_fail/T2414.stderr
@@ -1,8 +1,8 @@
T2414.hs:9:13: error:
- • Occurs check: cannot construct the infinite type: b0 ~ (Bool, b0)
- Expected type: b0 -> Maybe (Bool, b0)
- Actual type: (Bool, b0) -> Maybe (Bool, b0)
+ • Couldn't match type ‘b0’ with ‘(Bool, b0)’
+ Expected: b0 -> Maybe (Bool, b0)
+ Actual: b0 -> Maybe b0
• In the first argument of ‘unfoldr’, namely ‘Just’
In the expression: unfoldr Just
In an equation for ‘f’: f = unfoldr Just
diff --git a/testsuite/tests/typecheck/should_fail/T2534.stderr b/testsuite/tests/typecheck/should_fail/T2534.stderr
index 4e469f3cfd..24cee873c8 100644
--- a/testsuite/tests/typecheck/should_fail/T2534.stderr
+++ b/testsuite/tests/typecheck/should_fail/T2534.stderr
@@ -1,9 +1,9 @@
-T2534.hs:3:13: error:
- • Couldn't match type ‘[b]’ with ‘a0 -> [b]’
- Expected type: [a0] -> [b] -> [b]
- Actual type: [a0] -> (a0 -> [b]) -> [b]
- • In the first argument of ‘foldr’, namely ‘(>>=)’
+T2534.hs:3:19: error:
+ • Couldn't match expected type: a -> a -> b
+ with actual type: [a0]
+ • In the second argument of ‘foldr’, namely ‘[]’
In the expression: foldr (>>=) [] []
In an equation for ‘foo’: foo = foldr (>>=) [] []
- • Relevant bindings include foo :: [b] (bound at T2534.hs:3:1)
+ • Relevant bindings include
+ foo :: a -> a -> b (bound at T2534.hs:3:1)
diff --git a/testsuite/tests/typecheck/should_fail/T2714.hs b/testsuite/tests/typecheck/should_fail/T2714.hs
index 52d67e38ec..7f6a12fb2c 100644
--- a/testsuite/tests/typecheck/should_fail/T2714.hs
+++ b/testsuite/tests/typecheck/should_fail/T2714.hs
@@ -5,7 +5,7 @@
module T2714 where
f :: ((a -> b) -> b) -> (forall c. c -> a)
-f = ffmap
+f x = ffmap x
ffmap :: Functor f => (p->q) -> f p -> f q
ffmap = error "urk"
diff --git a/testsuite/tests/typecheck/should_fail/T2714.stderr b/testsuite/tests/typecheck/should_fail/T2714.stderr
index 9b3fc34c52..215ad495cf 100644
--- a/testsuite/tests/typecheck/should_fail/T2714.stderr
+++ b/testsuite/tests/typecheck/should_fail/T2714.stderr
@@ -1,13 +1,14 @@
-T2714.hs:8:5: error:
+T2714.hs:8:7: error:
• Couldn't match type ‘c’ with ‘f0 (a -> b)’
+ Expected: c -> a
+ Actual: f0 (a -> b) -> f0 b
‘c’ is a rigid type variable bound by
- the type signature for:
- f :: ((a -> b) -> b) -> forall c. c -> a
- at T2714.hs:8:1-9
- Expected type: ((a -> b) -> b) -> c -> a
- Actual type: ((a -> b) -> b) -> f0 (a -> b) -> f0 b
- • In the expression: ffmap
- In an equation for ‘f’: f = ffmap
+ a type expected by the context:
+ forall c. c -> a
+ at T2714.hs:8:1-13
+ • In the expression: ffmap x
+ In an equation for ‘f’: f x = ffmap x
• Relevant bindings include
+ x :: (a -> b) -> b (bound at T2714.hs:8:3)
f :: ((a -> b) -> b) -> forall c. c -> a (bound at T2714.hs:8:1)
diff --git a/testsuite/tests/typecheck/should_fail/T3102.hs b/testsuite/tests/typecheck/should_fail/T3102.hs
index 910ac06ee9..f7d9dad344 100644
--- a/testsuite/tests/typecheck/should_fail/T3102.hs
+++ b/testsuite/tests/typecheck/should_fail/T3102.hs
@@ -8,8 +8,8 @@ f :: (forall a. a -> String) -> Int
f _ = 3
result :: Int
-result = f t
-
+result = f (\x -> t x)
+ -- Simple subsumption (#17775) requires eta expansion here
-- This should work.
-- Elaborated result = f (/\a. \x:a. t @a (\p::Int. x))
diff --git a/testsuite/tests/typecheck/should_fail/T3406.stderr b/testsuite/tests/typecheck/should_fail/T3406.stderr
index 69834d15f6..70fffee3ac 100644
--- a/testsuite/tests/typecheck/should_fail/T3406.stderr
+++ b/testsuite/tests/typecheck/should_fail/T3406.stderr
@@ -1,8 +1,8 @@
T3406.hs:11:28: error:
• Couldn't match type ‘Int’ with ‘a -> ItemColID a b’
- Expected type: a -> ItemColID a b
- Actual type: ItemColID a1 b1
+ Expected: a -> ItemColID a b
+ Actual: ItemColID a1 b1
• In the expression: x :: ItemColID a b
In an equation for ‘get’:
get (x :: ItemColID a b) = x :: ItemColID a b
diff --git a/testsuite/tests/typecheck/should_fail/T3592.stderr b/testsuite/tests/typecheck/should_fail/T3592.stderr
index ab03985faa..bc3f774ecc 100644
--- a/testsuite/tests/typecheck/should_fail/T3592.stderr
+++ b/testsuite/tests/typecheck/should_fail/T3592.stderr
@@ -1,12 +1,14 @@
T3592.hs:8:5: error:
- • No instance for (Show a) arising from a use of ‘show’
- Possible fix:
- add (Show a) to the context of
- the type signature for:
- f :: forall a. T a -> String
+ • Couldn't match type ‘a0’ with ‘T a’
+ Expected: T a -> String
+ Actual: a0 -> String
+ Cannot instantiate unification variable ‘a0’
+ with a type involving polytypes: T a
• In the expression: show
In an equation for ‘f’: f = show
+ • Relevant bindings include
+ f :: T a -> String (bound at T3592.hs:8:1)
T3592.hs:11:7: error:
• No instance for (Show a) arising from a use of ‘show’
diff --git a/testsuite/tests/typecheck/should_fail/T3613.stderr b/testsuite/tests/typecheck/should_fail/T3613.stderr
index a221a95c17..8183ff981e 100644
--- a/testsuite/tests/typecheck/should_fail/T3613.stderr
+++ b/testsuite/tests/typecheck/should_fail/T3613.stderr
@@ -1,8 +1,8 @@
T3613.hs:14:20: error:
• Couldn't match type ‘IO’ with ‘Maybe’
- Expected type: Maybe b
- Actual type: IO b
+ Expected: Maybe b
+ Actual: IO b
• In the first argument of ‘fooThen’, namely ‘(bar >> undefined)’
In the expression: fooThen (bar >> undefined)
In the expression:
@@ -10,8 +10,8 @@ T3613.hs:14:20: error:
T3613.hs:17:24: error:
• Couldn't match type ‘IO’ with ‘Maybe’
- Expected type: Maybe ()
- Actual type: IO ()
+ Expected: Maybe ()
+ Actual: IO ()
• In a stmt of a 'do' block: bar
In the first argument of ‘fooThen’, namely
‘(do bar
diff --git a/testsuite/tests/typecheck/should_fail/T3950.stderr b/testsuite/tests/typecheck/should_fail/T3950.stderr
index e0a3526000..f71fd5d501 100644
--- a/testsuite/tests/typecheck/should_fail/T3950.stderr
+++ b/testsuite/tests/typecheck/should_fail/T3950.stderr
@@ -4,8 +4,8 @@ T3950.hs:15:8: error:
When matching types
w :: (* -> * -> *) -> *
Sealed :: (* -> *) -> *
- Expected type: Maybe (w (Id p))
- Actual type: Maybe (Sealed (Id p0 x0))
+ Expected: Maybe (w (Id p))
+ Actual: Maybe (Sealed (Id p0 x0))
• In the expression: Just rp'
In an equation for ‘rp’:
rp _
diff --git a/testsuite/tests/typecheck/should_fail/T502.stderr b/testsuite/tests/typecheck/should_fail/T502.stderr
index ba5f6d157a..dd6b97d132 100644
--- a/testsuite/tests/typecheck/should_fail/T502.stderr
+++ b/testsuite/tests/typecheck/should_fail/T502.stderr
@@ -1,7 +1,7 @@
T502.hs:8:11: error:
- • Couldn't match expected type ‘(a0, Int)’
- with actual type ‘(# Int, Int #)’
+ • Couldn't match expected type: (a0, Int)
+ with actual type: (# Int, Int #)
• In the first argument of ‘snd’, namely ‘foo’
In the expression: snd foo
In an equation for ‘bar’:
diff --git a/testsuite/tests/typecheck/should_fail/T5246.stderr b/testsuite/tests/typecheck/should_fail/T5246.stderr
index 54d340cc5e..ea4185af33 100644
--- a/testsuite/tests/typecheck/should_fail/T5246.stderr
+++ b/testsuite/tests/typecheck/should_fail/T5246.stderr
@@ -1,11 +1,10 @@
T5246.hs:11:10: error:
- Couldn't match type ‘[Char]’ with ‘Int’
- arising from a functional dependency between constraints:
- ‘?x::Int’ arising from a use of ‘foo’ at T5246.hs:11:10-12
- ‘?x::[Char]’
- arising from the implicit-parameter binding for ?x
- at T5246.hs:(10,7)-(11,12)
- In the expression: foo
- In the expression: let ?x = "hello" in foo
- In an equation for ‘bar’: bar = let ?x = "hello" in foo
+ • Couldn't match type ‘[Char]’ with ‘Int’
+ arising from a functional dependency between constraints:
+ ‘?x::Int’ arising from a use of ‘foo’ at T5246.hs:11:10-12
+ ‘?x::String’
+ arising from the implicit-parameter binding for ?x at T5246.hs:(10,7)-(11,12)
+ • In the expression: foo
+ In the expression: let ?x = "hello" in foo
+ In an equation for ‘bar’: bar = let ?x = "hello" in foo
diff --git a/testsuite/tests/typecheck/should_fail/T6001.stderr b/testsuite/tests/typecheck/should_fail/T6001.stderr
index 57d55dc336..a7a8274923 100644
--- a/testsuite/tests/typecheck/should_fail/T6001.stderr
+++ b/testsuite/tests/typecheck/should_fail/T6001.stderr
@@ -1,10 +1,10 @@
-T6001.hs:8:18:
- Couldn't match type ‘Integer’ with ‘Int’
- Expected type: Integer -> DayKind
- Actual type: Int -> DayKind
- When checking that instance signature for ‘fromInteger’
- is more general than its signature in the class
- Instance sig: Int -> DayKind
- Class sig: Integer -> DayKind
- In the instance declaration for ‘Num DayKind’
+T6001.hs:8:18: error:
+ • Couldn't match type ‘Int’ with ‘Integer’
+ Expected: Integer -> DayKind
+ Actual: Int -> DayKind
+ • When checking that instance signature for ‘fromInteger’
+ is more general than its signature in the class
+ Instance sig: Int -> DayKind
+ Class sig: Integer -> DayKind
+ In the instance declaration for ‘Num DayKind’
diff --git a/testsuite/tests/typecheck/should_fail/T6069.stderr b/testsuite/tests/typecheck/should_fail/T6069.stderr
index e2d3ef4d91..c70939fee5 100644
--- a/testsuite/tests/typecheck/should_fail/T6069.stderr
+++ b/testsuite/tests/typecheck/should_fail/T6069.stderr
@@ -1,24 +1,27 @@
T6069.hs:13:15: error:
- • Couldn't match type ‘ST s0 Int’ with ‘forall s. ST s a0’
- Expected type: ST s0 Int -> a0
- Actual type: (forall s. ST s a0) -> a0
+ • Couldn't match type: forall s. ST s b0
+ with: ST s0 Int
+ Expected: ST s0 Int -> b0
+ Actual: (forall s. ST s b0) -> b0
• In the second argument of ‘(.)’, namely ‘runST’
In the expression: print . runST
In the expression: (print . runST) fourty_two
T6069.hs:14:15: error:
- • Couldn't match type ‘ST s1 Int’ with ‘forall s. ST s a1’
- Expected type: ST s1 Int -> a1
- Actual type: (forall s. ST s a1) -> a1
+ • Couldn't match type: forall s. ST s b1
+ with: ST s1 Int
+ Expected: ST s1 Int -> b1
+ Actual: (forall s. ST s b1) -> b1
• In the second argument of ‘(.)’, namely ‘runST’
In the first argument of ‘($)’, namely ‘(print . runST)’
In the expression: (print . runST) $ fourty_two
T6069.hs:15:16: error:
- • Couldn't match type ‘ST s2 Int’ with ‘forall s. ST s a2’
- Expected type: ST s2 Int -> a2
- Actual type: (forall s. ST s a2) -> a2
+ • Couldn't match type: forall s. ST s b2
+ with: ST s2 Int
+ Expected: ST s2 Int -> b2
+ Actual: (forall s. ST s b2) -> b2
• In the second argument of ‘(.)’, namely ‘runST’
In the first argument of ‘($)’, namely ‘(print . runST)’
In the expression: (print . runST) $
diff --git a/testsuite/tests/typecheck/should_fail/T7264.stderr b/testsuite/tests/typecheck/should_fail/T7264.stderr
index 71c99c5614..4d2a153306 100644
--- a/testsuite/tests/typecheck/should_fail/T7264.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7264.stderr
@@ -1,10 +1,11 @@
T7264.hs:13:19: error:
• Couldn't match type ‘a’ with ‘forall r. r -> String’
+ Expected: a -> Foo
+ Actual: (forall r. r -> String) -> Foo
‘a’ is a rigid type variable bound by
- the inferred type of mkFoo2 :: a -> Maybe Foo at T7264.hs:13:1-32
- Expected type: a -> Foo
- Actual type: (forall r. r -> String) -> Foo
+ the inferred type of mkFoo2 :: a -> Maybe Foo
+ at T7264.hs:13:1-32
• In the first argument of ‘mmap’, namely ‘Foo’
In the expression: mmap Foo (Just val)
In an equation for ‘mkFoo2’: mkFoo2 val = mmap Foo (Just val)
diff --git a/testsuite/tests/typecheck/should_fail/T7368.stderr b/testsuite/tests/typecheck/should_fail/T7368.stderr
index 54c12f76f7..ef100b1fa4 100644
--- a/testsuite/tests/typecheck/should_fail/T7368.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7368.stderr
@@ -4,8 +4,8 @@ T7368.hs:3:10: error:
When matching types
b0 :: *
Maybe :: * -> *
- Expected type: a0 -> b0
- Actual type: c0 Maybe
+ Expected: a0 -> b0
+ Actual: c0 Maybe
• In the first argument of ‘b’, namely ‘(l Nothing)’
In the expression: b (l Nothing)
In an equation for ‘f’: f = b (l Nothing)
diff --git a/testsuite/tests/typecheck/should_fail/T7368a.stderr b/testsuite/tests/typecheck/should_fail/T7368a.stderr
index 93b8b04378..2fcb92f209 100644
--- a/testsuite/tests/typecheck/should_fail/T7368a.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7368a.stderr
@@ -4,8 +4,8 @@ T7368a.hs:8:6: error:
When matching types
f :: * -> *
Bad :: (* -> *) -> *
- Expected type: f (Bad f)
- Actual type: Bad w0
+ Expected: f (Bad f)
+ Actual: Bad w0
• In the pattern: Bad x
In an equation for ‘fun’: fun (Bad x) = True
• Relevant bindings include
diff --git a/testsuite/tests/typecheck/should_fail/T7696.stderr b/testsuite/tests/typecheck/should_fail/T7696.stderr
index 41f2296797..945312094d 100644
--- a/testsuite/tests/typecheck/should_fail/T7696.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7696.stderr
@@ -1,7 +1,7 @@
T7696.hs:7:6: error:
• Couldn't match type ‘m0 a0’ with ‘()’
- Expected type: ((), w ())
- Actual type: (m0 a0, t0 m0)
+ Expected: ((), w ())
+ Actual: (m0 a0, t0 m0)
• In the expression: f1
In an equation for ‘f2’: f2 = f1
diff --git a/testsuite/tests/typecheck/should_fail/T7734.stderr b/testsuite/tests/typecheck/should_fail/T7734.stderr
index 05002109ab..bf199cb4c2 100644
--- a/testsuite/tests/typecheck/should_fail/T7734.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7734.stderr
@@ -1,6 +1,6 @@
T7734.hs:4:13: error:
- • Occurs check: cannot construct the infinite type: t ~ t -> t1
+ • Couldn't match expected type ‘t’ with actual type ‘t -> t1’
• In the first argument of ‘x’, namely ‘x’
In the expression: x x
In an equation for ‘f’: x `f` y = x x
@@ -9,7 +9,7 @@ T7734.hs:4:13: error:
f :: (t -> t1) -> p -> t1 (bound at T7734.hs:4:3)
T7734.hs:5:13: error:
- • Occurs check: cannot construct the infinite type: t ~ t -> t1
+ • Couldn't match expected type ‘t’ with actual type ‘t -> t1’
• In the first argument of ‘x’, namely ‘x’
In the expression: x x
In an equation for ‘&’: (&) x y = x x
diff --git a/testsuite/tests/typecheck/should_fail/T7851.stderr b/testsuite/tests/typecheck/should_fail/T7851.stderr
index 0e1964e35c..289df8ad40 100644
--- a/testsuite/tests/typecheck/should_fail/T7851.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7851.stderr
@@ -1,7 +1,7 @@
T7851.hs:5:10: error:
- • Couldn't match expected type ‘IO a0’
- with actual type ‘a1 -> IO ()’
+ • Couldn't match expected type: IO a0
+ with actual type: a1 -> IO ()
• Probable cause: ‘print’ is applied to too few arguments
In a stmt of a 'do' block: print
In the expression:
diff --git a/testsuite/tests/typecheck/should_fail/T7856.stderr b/testsuite/tests/typecheck/should_fail/T7856.stderr
index e6fe2bd42f..a5a3a4bff1 100644
--- a/testsuite/tests/typecheck/should_fail/T7856.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7856.stderr
@@ -1,11 +1,11 @@
-T7856.hs:4:7:
- Couldn't match expected type ‘String -> IO ()’
- with actual type ‘IO ()’
- Possible cause: ‘sequence_’ is applied to too many arguments
- In the expression: sequence_ lst
- In an equation for ‘tmp’:
- tmp
- = sequence_ lst
- where
- lst = [putStrLn "hi"]
+T7856.hs:4:7: error:
+ • Couldn't match expected type: String -> IO ()
+ with actual type: IO ()
+ • Possible cause: ‘sequence_’ is applied to too many arguments
+ In the expression: sequence_ lst
+ In an equation for ‘tmp’:
+ tmp
+ = sequence_ lst
+ where
+ lst = [putStrLn "hi"]
diff --git a/testsuite/tests/typecheck/should_fail/T7869.stderr b/testsuite/tests/typecheck/should_fail/T7869.stderr
index 7e01868526..15e9cc4658 100644
--- a/testsuite/tests/typecheck/should_fail/T7869.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7869.stderr
@@ -1,6 +1,8 @@
T7869.hs:3:12: error:
• Couldn't match type ‘b1’ with ‘b’
+ Expected: [a1] -> b1
+ Actual: [a] -> b
‘b1’ is a rigid type variable bound by
an expression type signature:
forall a1 b1. [a1] -> b1
@@ -8,8 +10,6 @@ T7869.hs:3:12: error:
‘b’ is a rigid type variable bound by
the inferred type of f :: [a] -> b
at T7869.hs:3:1-27
- Expected type: [a1] -> b1
- Actual type: [a] -> b
• In the expression: f x
In the expression: (\ x -> f x) :: [a] -> b
In an equation for ‘f’: f = (\ x -> f x) :: [a] -> b
diff --git a/testsuite/tests/typecheck/should_fail/T8030.stderr b/testsuite/tests/typecheck/should_fail/T8030.stderr
index c1ff38b685..623eabbdbc 100644
--- a/testsuite/tests/typecheck/should_fail/T8030.stderr
+++ b/testsuite/tests/typecheck/should_fail/T8030.stderr
@@ -1,6 +1,7 @@
T8030.hs:9:3: error:
- • Couldn't match expected type ‘Pr a’ with actual type ‘Pr a0’
+ • Couldn't match expected type: Pr a
+ with actual type: Pr a0
NB: ‘Pr’ is a non-injective type family
The type variable ‘a0’ is ambiguous
• In the ambiguity check for ‘op1’
@@ -10,9 +11,10 @@ T8030.hs:9:3: error:
In the class declaration for ‘C’
T8030.hs:10:3: error:
- • Couldn't match type ‘Pr a0’ with ‘Pr a’
- Expected type: Pr a -> Pr a -> Pr a
- Actual type: Pr a0 -> Pr a0 -> Pr a0
+ • Couldn't match type: Pr a0
+ with: Pr a
+ Expected: Pr a -> Pr a -> Pr a
+ Actual: Pr a0 -> Pr a0 -> Pr a0
NB: ‘Pr’ is a non-injective type family
The type variable ‘a0’ is ambiguous
• In the ambiguity check for ‘op2’
diff --git a/testsuite/tests/typecheck/should_fail/T8034.stderr b/testsuite/tests/typecheck/should_fail/T8034.stderr
index cce73f355a..8f64538554 100644
--- a/testsuite/tests/typecheck/should_fail/T8034.stderr
+++ b/testsuite/tests/typecheck/should_fail/T8034.stderr
@@ -1,8 +1,9 @@
T8034.hs:6:3: error:
- • Couldn't match type ‘F a0’ with ‘F a’
- Expected type: F a -> F a
- Actual type: F a0 -> F a0
+ • Couldn't match type: F a0
+ with: F a
+ Expected: F a -> F a
+ Actual: F a0 -> F a0
NB: ‘F’ is a non-injective type family
The type variable ‘a0’ is ambiguous
• In the ambiguity check for ‘foo’
diff --git a/testsuite/tests/typecheck/should_fail/T8044.stderr b/testsuite/tests/typecheck/should_fail/T8044.stderr
index 78ef035af8..2069f5f281 100644
--- a/testsuite/tests/typecheck/should_fail/T8044.stderr
+++ b/testsuite/tests/typecheck/should_fail/T8044.stderr
@@ -1,9 +1,9 @@
-T8044.hs:16:13:
- Couldn't match type ‘Frob a’ with ‘Char’
- Expected type: X (Frob a)
- Actual type: X Char
- In the expression: XChar
- In an equation for ‘frob’: frob _ = XChar
- Relevant bindings include
- frob :: X a -> X (Frob a) (bound at T8044.hs:15:1)
+T8044.hs:16:13: error:
+ • Couldn't match type ‘Frob a’ with ‘Char’
+ Expected: X (Frob a)
+ Actual: X Char
+ • In the expression: XChar
+ In an equation for ‘frob’: frob _ = XChar
+ • Relevant bindings include
+ frob :: X a -> X (Frob a) (bound at T8044.hs:15:1)
diff --git a/testsuite/tests/typecheck/should_fail/T8142.stderr b/testsuite/tests/typecheck/should_fail/T8142.stderr
index 25d60d1aff..a9f4590e44 100644
--- a/testsuite/tests/typecheck/should_fail/T8142.stderr
+++ b/testsuite/tests/typecheck/should_fail/T8142.stderr
@@ -1,8 +1,9 @@
T8142.hs:6:10: error:
- • Couldn't match type ‘Nu ((,) a0)’ with ‘c -> f c’
- Expected type: (c -> f c) -> c -> f c
- Actual type: Nu ((,) a0) -> Nu g0
+ • Couldn't match type: Nu ((,) a0)
+ with: c -> f c
+ Expected: (c -> f c) -> c -> f c
+ Actual: Nu ((,) a0) -> Nu f0
The type variable ‘a0’ is ambiguous
• In the expression: h
In an equation for ‘tracer’:
@@ -14,11 +15,12 @@ T8142.hs:6:10: error:
tracer :: (c -> f c) -> c -> f c (bound at T8142.hs:6:1)
T8142.hs:6:57: error:
- • Couldn't match type ‘Nu ((,) a)’ with ‘g (Nu ((,) a))’
- Expected type: Nu ((,) a) -> (a, g (Nu ((,) a)))
- Actual type: Nu ((,) a) -> (a, Nu ((,) a))
+ • Couldn't match type: Nu ((,) a)
+ with: f1 (Nu ((,) a))
+ Expected: Nu ((,) a) -> (a, f1 (Nu ((,) a)))
+ Actual: Nu ((,) a) -> (a, Nu ((,) a))
• In the second argument of ‘(.)’, namely ‘out’
In the expression: (\ (_, b) -> ((outI . fmap h) b)) . out
In an equation for ‘h’: h = (\ (_, b) -> ((outI . fmap h) b)) . out
• Relevant bindings include
- h :: Nu ((,) a) -> Nu g (bound at T8142.hs:6:18)
+ h :: Nu ((,) a) -> Nu f1 (bound at T8142.hs:6:18)
diff --git a/testsuite/tests/typecheck/should_fail/T8428.stderr b/testsuite/tests/typecheck/should_fail/T8428.stderr
index ce83c3efe5..2668bb45fd 100644
--- a/testsuite/tests/typecheck/should_fail/T8428.stderr
+++ b/testsuite/tests/typecheck/should_fail/T8428.stderr
@@ -1,8 +1,9 @@
T8428.hs:11:19: error:
- • Couldn't match type ‘(forall s. ST s) a’ with ‘forall s. ST s a’
- Expected type: IdentityT (forall s. ST s) a -> forall s. ST s a
- Actual type: IdentityT (forall s. ST s) a -> (forall s. ST s) a
+ • Couldn't match type: (forall s. ST s) a
+ with: forall s. ST s a
+ Expected: IdentityT (forall s. ST s) a -> forall s. ST s a
+ Actual: IdentityT (forall s. ST s) a -> (forall s. ST s) a
• In the second argument of ‘(.)’, namely ‘runIdentityT’
In the expression: runST . runIdentityT
In an equation for ‘runIdST’: runIdST = runST . runIdentityT
diff --git a/testsuite/tests/typecheck/should_fail/T8450.stderr b/testsuite/tests/typecheck/should_fail/T8450.stderr
index 7503f4d37e..a75d0703c6 100644
--- a/testsuite/tests/typecheck/should_fail/T8450.stderr
+++ b/testsuite/tests/typecheck/should_fail/T8450.stderr
@@ -1,12 +1,12 @@
T8450.hs:8:20: error:
• Couldn't match type ‘a’ with ‘Bool’
+ Expected: Either Bool ()
+ Actual: Either a ()
‘a’ is a rigid type variable bound by
the type signature for:
run :: forall a. a
at T8450.hs:7:1-18
- Expected type: Either Bool ()
- Actual type: Either a ()
• In the second argument of ‘($)’, namely
‘(undefined :: Either a ())’
In the expression: runEffect $ (undefined :: Either a ())
diff --git a/testsuite/tests/typecheck/should_fail/T8603.stderr b/testsuite/tests/typecheck/should_fail/T8603.stderr
index 29c5d9df12..4776253f52 100644
--- a/testsuite/tests/typecheck/should_fail/T8603.stderr
+++ b/testsuite/tests/typecheck/should_fail/T8603.stderr
@@ -1,8 +1,9 @@
T8603.hs:33:17: error:
- • Couldn't match type ‘RV a1’ with ‘StateT s RV a0’
- Expected type: [a2] -> StateT s RV a0
- Actual type: t0 ((->) [a1]) (RV a1)
+ • Couldn't match type: RV a1
+ with: StateT s RV a0
+ Expected: [a2] -> StateT s RV a0
+ Actual: t0 ((->) [a1]) (RV a1)
• The function ‘lift’ is applied to two value arguments,
but its type ‘([a1] -> RV a1) -> t0 ((->) [a1]) (RV a1)’
has only one
diff --git a/testsuite/tests/typecheck/should_fail/T9201.stderr b/testsuite/tests/typecheck/should_fail/T9201.stderr
index 5e8f0173c5..16a183bef0 100644
--- a/testsuite/tests/typecheck/should_fail/T9201.stderr
+++ b/testsuite/tests/typecheck/should_fail/T9201.stderr
@@ -1,6 +1,12 @@
T9201.hs:6:17: error:
• Expected kind ‘x’, but ‘a’ has kind ‘y’
+ ‘y’ is a rigid type variable bound by
+ the class declaration for ‘MonoidalCCC’
+ at T9201.hs:5:30
+ ‘x’ is a rigid type variable bound by
+ the class declaration for ‘MonoidalCCC’
+ at T9201.hs:5:25
• In the first argument of ‘f’, namely ‘a’
In the second argument of ‘d’, namely ‘(f a)’
In the type signature: ret :: d a (f a)
diff --git a/testsuite/tests/typecheck/should_fail/T9260.stderr b/testsuite/tests/typecheck/should_fail/T9260.stderr
index f55f474904..2a6c0ac16c 100644
--- a/testsuite/tests/typecheck/should_fail/T9260.stderr
+++ b/testsuite/tests/typecheck/should_fail/T9260.stderr
@@ -1,8 +1,8 @@
T9260.hs:12:14: error:
• Couldn't match type ‘1’ with ‘0’
- Expected type: Fin 0
- Actual type: Fin (0 + 1)
+ Expected: Fin 0
+ Actual: Fin (0 + 1)
• In the first argument of ‘Fsucc’, namely ‘Fzero’
In the expression: Fsucc Fzero
In an equation for ‘test’: test = Fsucc Fzero
diff --git a/testsuite/tests/typecheck/should_fail/T9318.stderr b/testsuite/tests/typecheck/should_fail/T9318.stderr
index c637788a7e..0a87c4a1e2 100644
--- a/testsuite/tests/typecheck/should_fail/T9318.stderr
+++ b/testsuite/tests/typecheck/should_fail/T9318.stderr
@@ -1,7 +1,7 @@
T9318.hs:12:5: error:
• Couldn't match type ‘Bool’ with ‘Char’
- Expected type: F Int
- Actual type: Char
+ Expected: F Int
+ Actual: Char
• In the pattern: 'x'
In an equation for ‘bar’: bar 'x' = ()
diff --git a/testsuite/tests/typecheck/should_fail/T9605.stderr b/testsuite/tests/typecheck/should_fail/T9605.stderr
index 683265c26b..6132c9538e 100644
--- a/testsuite/tests/typecheck/should_fail/T9605.stderr
+++ b/testsuite/tests/typecheck/should_fail/T9605.stderr
@@ -1,8 +1,8 @@
T9605.hs:7:6: error:
• Couldn't match type ‘Bool’ with ‘m Bool’
- Expected type: t0 -> m Bool
- Actual type: t0 -> Bool
+ Expected: t0 -> m Bool
+ Actual: t0 -> Bool
• In the result of a function call
In the expression: f1 undefined
In an equation for ‘f2’: f2 = f1 undefined
diff --git a/testsuite/tests/typecheck/should_fail/T9612.stderr b/testsuite/tests/typecheck/should_fail/T9612.stderr
index 462edc3e2d..26cea79487 100644
--- a/testsuite/tests/typecheck/should_fail/T9612.stderr
+++ b/testsuite/tests/typecheck/should_fail/T9612.stderr
@@ -1,20 +1,21 @@
T9612.hs:16:9: error:
- Couldn't match type ‘[(Int, a)]’ with ‘(Int, a)’
- arising from a functional dependency between:
- constraint ‘MonadWriter (Int, a) (WriterT [(Int, a)] Identity)’
- arising from a use of ‘tell’
- instance ‘MonadWriter w (WriterT w m)’ at T9612.hs:20:10-59
- In a stmt of a 'do' block: tell (n, x)
- In the expression:
- do tell (n, x)
- return (1, y)
- In an equation for ‘f’:
- f y (n, x)
- = do tell (n, x)
- return (1, y)
- Relevant bindings include
- x :: a (bound at T9612.hs:14:8)
- y :: a (bound at T9612.hs:14:3)
- f :: a -> (Int, a) -> Writer [(Int, a)] (Int, a)
- (bound at T9612.hs:14:1)
+ • Couldn't match type: [(Int, a)]
+ with: (Int, a)
+ arising from a functional dependency between:
+ constraint ‘MonadWriter (Int, a) (WriterT [(Int, a)] Identity)’
+ arising from a use of ‘tell’
+ instance ‘MonadWriter w (WriterT w m)’ at T9612.hs:20:10-59
+ • In a stmt of a 'do' block: tell (n, x)
+ In the expression:
+ do tell (n, x)
+ return (1, y)
+ In an equation for ‘f’:
+ f y (n, x)
+ = do tell (n, x)
+ return (1, y)
+ • Relevant bindings include
+ x :: a (bound at T9612.hs:14:8)
+ y :: a (bound at T9612.hs:14:3)
+ f :: a -> (Int, a) -> Writer [(Int, a)] (Int, a)
+ (bound at T9612.hs:14:1)
diff --git a/testsuite/tests/typecheck/should_fail/T9774.stderr b/testsuite/tests/typecheck/should_fail/T9774.stderr
index 28b1b58c4c..da75c339b8 100644
--- a/testsuite/tests/typecheck/should_fail/T9774.stderr
+++ b/testsuite/tests/typecheck/should_fail/T9774.stderr
@@ -1,8 +1,8 @@
T9774.hs:5:17: error:
• Couldn't match type ‘Char’ with ‘[Char]’
- Expected type: String
- Actual type: Char
+ Expected: String
+ Actual: Char
• In the first argument of ‘putStrLn’, namely ‘(assert True 'a')’
In the expression: putStrLn (assert True 'a')
In an equation for ‘foo’: foo = putStrLn (assert True 'a')
diff --git a/testsuite/tests/typecheck/should_fail/T9858e.stderr b/testsuite/tests/typecheck/should_fail/T9858e.stderr
index 04e08000ca..f397723a02 100644
--- a/testsuite/tests/typecheck/should_fail/T9858e.stderr
+++ b/testsuite/tests/typecheck/should_fail/T9858e.stderr
@@ -1,9 +1,10 @@
T9858e.hs:9:8: error:
- Couldn't match type ‘Eq Int => Int’ with ‘a0 b0’
- Expected type: Proxy (a0 b0)
- Actual type: Proxy (Eq Int => Int)
- In the first argument of ‘i’, namely
- ‘(Proxy :: Proxy (Eq Int => Int))’
- In the expression: i (Proxy :: Proxy (Eq Int => Int))
- In an equation for ‘j’: j = i (Proxy :: Proxy (Eq Int => Int))
+ • Couldn't match type: Eq Int => Int
+ with: a0 b0
+ Expected: Proxy (a0 b0)
+ Actual: Proxy (Eq Int => Int)
+ • In the first argument of ‘i’, namely
+ ‘(Proxy :: Proxy (Eq Int => Int))’
+ In the expression: i (Proxy :: Proxy (Eq Int => Int))
+ In an equation for ‘j’: j = i (Proxy :: Proxy (Eq Int => Int))
diff --git a/testsuite/tests/typecheck/should_fail/TcCoercibleFail.stderr b/testsuite/tests/typecheck/should_fail/TcCoercibleFail.stderr
index f4e1d02eee..4370b606ca 100644
--- a/testsuite/tests/typecheck/should_fail/TcCoercibleFail.stderr
+++ b/testsuite/tests/typecheck/should_fail/TcCoercibleFail.stderr
@@ -7,8 +7,8 @@ TcCoercibleFail.hs:11:8: error:
In an equation for ‘foo1’: foo1 = coerce $ one :: ()
TcCoercibleFail.hs:14:8: error:
- • Couldn't match representation of type ‘m Int’
- with that of ‘m Age’
+ • Couldn't match representation of type: m Int
+ with that of: m Age
arising from a use of ‘coerce’
NB: We cannot know what roles the parameters to ‘m’ have;
we must assume that the role is nominal
diff --git a/testsuite/tests/typecheck/should_fail/TcMultiWayIfFail.stderr b/testsuite/tests/typecheck/should_fail/TcMultiWayIfFail.stderr
index 70ac94f060..487cfee88f 100644
--- a/testsuite/tests/typecheck/should_fail/TcMultiWayIfFail.stderr
+++ b/testsuite/tests/typecheck/should_fail/TcMultiWayIfFail.stderr
@@ -1,16 +1,28 @@
-TcMultiWayIfFail.hs:6:24:
- Couldn't match expected type ‘Int’ with actual type ‘[Char]’
- In the expression: "2"
- In the expression:
- if | True -> 1 :: Int | False -> "2" | otherwise -> [3 :: Int]
- In an equation for ‘x1’:
- x1 = if | True -> 1 :: Int | False -> "2" | otherwise -> [3 :: Int]
+TcMultiWayIfFail.hs:6:24: error:
+ • Couldn't match type ‘[Char]’ with ‘Int’
+ Expected: Int
+ Actual: String
+ • In the expression: "2"
+ In the expression:
+ if | True -> 1 :: Int
+ | False -> "2"
+ | otherwise -> [3 :: Int]
+ In an equation for ‘x1’:
+ x1
+ = if | True -> 1 :: Int
+ | False -> "2"
+ | otherwise -> [3 :: Int]
-TcMultiWayIfFail.hs:7:24:
- Couldn't match expected type ‘Int’ with actual type ‘[Int]’
- In the expression: [3 :: Int]
- In the expression:
- if | True -> 1 :: Int | False -> "2" | otherwise -> [3 :: Int]
- In an equation for ‘x1’:
- x1 = if | True -> 1 :: Int | False -> "2" | otherwise -> [3 :: Int]
+TcMultiWayIfFail.hs:7:24: error:
+ • Couldn't match expected type ‘Int’ with actual type ‘[Int]’
+ • In the expression: [3 :: Int]
+ In the expression:
+ if | True -> 1 :: Int
+ | False -> "2"
+ | otherwise -> [3 :: Int]
+ In an equation for ‘x1’:
+ x1
+ = if | True -> 1 :: Int
+ | False -> "2"
+ | otherwise -> [3 :: Int]
diff --git a/testsuite/tests/typecheck/should_fail/UnliftedNewtypesInfinite.stderr b/testsuite/tests/typecheck/should_fail/UnliftedNewtypesInfinite.stderr
index bf50beed5e..9725a779e7 100644
--- a/testsuite/tests/typecheck/should_fail/UnliftedNewtypesInfinite.stderr
+++ b/testsuite/tests/typecheck/should_fail/UnliftedNewtypesInfinite.stderr
@@ -1,7 +1,10 @@
UnliftedNewtypesInfinite.hs:9:20: error:
- • Occurs check: cannot construct the infinite kind:
- t0 ~ 'GHC.Types.TupleRep '[ 'GHC.Types.IntRep, t0]
+ • Couldn't match kind ‘t0’
+ with ‘'GHC.Types.TupleRep '[ 'GHC.Types.IntRep, t0]’
+ Expected kind ‘TYPE t0’,
+ but ‘(# Int#, Foo #)’ has kind ‘TYPE
+ ('GHC.Types.TupleRep '[ 'GHC.Types.IntRep, t0])’
• In the type ‘(# Int#, Foo #)’
In the definition of data constructor ‘FooC’
In the newtype declaration for ‘Foo’
diff --git a/testsuite/tests/typecheck/should_fail/UnliftedNewtypesInstanceFail.stderr b/testsuite/tests/typecheck/should_fail/UnliftedNewtypesInstanceFail.stderr
index 3fb2814dab..0a49414c33 100644
--- a/testsuite/tests/typecheck/should_fail/UnliftedNewtypesInstanceFail.stderr
+++ b/testsuite/tests/typecheck/should_fail/UnliftedNewtypesInstanceFail.stderr
@@ -1,5 +1,7 @@
-UnliftedNewtypesInstanceFail.hs:13:3:
- Expected kind ‘TYPE 'WordRep’,
+
+UnliftedNewtypesInstanceFail.hs:13:3: error:
+ • Couldn't match kind ‘'IntRep’ with ‘'WordRep’
+ Expected kind ‘TYPE 'WordRep’,
but ‘Bar Bool’ has kind ‘TYPE 'IntRep’
- In the newtype instance declaration for ‘Bar’
+ • In the newtype instance declaration for ‘Bar’
In the instance declaration for ‘Foo Bool’
diff --git a/testsuite/tests/typecheck/should_fail/UnliftedNewtypesMismatchedKindRecord.stderr b/testsuite/tests/typecheck/should_fail/UnliftedNewtypesMismatchedKindRecord.stderr
index c8386e663f..f30d8b8fe8 100644
--- a/testsuite/tests/typecheck/should_fail/UnliftedNewtypesMismatchedKindRecord.stderr
+++ b/testsuite/tests/typecheck/should_fail/UnliftedNewtypesMismatchedKindRecord.stderr
@@ -1,7 +1,7 @@
UnliftedNewtypesMismatchedKindRecord.hs:11:23: error:
- • Expected kind ‘TYPE 'IntRep’,
- but ‘Word#’ has kind ‘TYPE 'WordRep’
+ • Couldn't match kind ‘'WordRep’ with ‘'IntRep’
+ Expected kind ‘TYPE 'IntRep’, but ‘Word#’ has kind ‘TYPE 'WordRep’
• In the type ‘Word#’
In the definition of data constructor ‘FooC’
In the newtype declaration for ‘Foo’
diff --git a/testsuite/tests/typecheck/should_fail/VtaFail.hs b/testsuite/tests/typecheck/should_fail/VtaFail.hs
index 250f9e273e..42e584ce0a 100644
--- a/testsuite/tests/typecheck/should_fail/VtaFail.hs
+++ b/testsuite/tests/typecheck/should_fail/VtaFail.hs
@@ -14,7 +14,9 @@ answer_constraint_fail = addOne @Bool 5
answer_lambda = (\x -> x) @Int 12
pair :: forall a. a -> forall b. b -> (a, b)
-pair = (,)
+pair x = (,) x
+-- Without this eta-expansion, the two have
+-- different types under simple subsumption (#17775)
a = pair 3 @Int @Bool True
diff --git a/testsuite/tests/typecheck/should_fail/VtaFail.stderr b/testsuite/tests/typecheck/should_fail/VtaFail.stderr
index a9958016ce..87a2bea3fe 100644
--- a/testsuite/tests/typecheck/should_fail/VtaFail.stderr
+++ b/testsuite/tests/typecheck/should_fail/VtaFail.stderr
@@ -13,66 +13,67 @@ VtaFail.hs:14:17: error:
In an equation for ‘answer_lambda’:
answer_lambda = (\ x -> x) @Int 12
-VtaFail.hs:19:5: error:
+VtaFail.hs:21:5: error:
• Cannot apply expression of type ‘Int -> (a0, Int)’
to a visible type argument ‘Bool’
• In the expression: pair 3 @Int @Bool True
In an equation for ‘a’: a = pair 3 @Int @Bool True
-VtaFail.hs:26:15: error:
+VtaFail.hs:28:15: error:
• Expected kind ‘* -> *’, but ‘Int’ has kind ‘*’
• In the type ‘Int’
In the expression: first @Int F
In an equation for ‘fInt’: fInt = first @Int F
-VtaFail.hs:33:18: error:
+VtaFail.hs:35:18: error:
• Couldn't match type ‘Int’ with ‘Bool’
- Expected type: Proxy Bool
- Actual type: Proxy Int
+ Expected: Proxy Bool
+ Actual: Proxy Int
• In the second argument of ‘foo’, namely ‘(P :: Proxy Int)’
In the expression: foo @Bool (P :: Proxy Int)
In an equation for ‘baz’: baz = foo @Bool (P :: Proxy Int)
-VtaFail.hs:40:17: error:
- • Expected kind ‘* -> k0 -> *’, but ‘Maybe’ has kind ‘* -> *’
+VtaFail.hs:42:17: error:
+ • Couldn't match kind ‘*’ with ‘k0 -> *’
+ Expected kind ‘* -> k0 -> *’, but ‘Maybe’ has kind ‘* -> *’
• In the type ‘Maybe’
In the expression: too @Maybe T
In an equation for ‘threeBad’: threeBad = too @Maybe T
-VtaFail.hs:41:27: error:
+VtaFail.hs:43:27: error:
• Couldn't match type ‘Either’ with ‘(->)’
- Expected type: Three (->)
- Actual type: Three Either
+ Expected: Three (->)
+ Actual: Three Either
• In the second argument of ‘too’, namely ‘(T :: Three Either)’
In the expression: too @(->) (T :: Three Either)
In an equation for ‘threeWorse’:
threeWorse = too @(->) (T :: Three Either)
-VtaFail.hs:46:5: error:
+VtaFail.hs:48:5: error:
• Cannot apply expression of type ‘Int -> Int -> Int’
to a visible type argument ‘Int’
• In the expression: plus @Int 5 7
In an equation for ‘b’: b = plus @Int 5 7
-VtaFail.hs:47:5: error:
+VtaFail.hs:49:5: error:
• Cannot apply expression of type ‘Int -> Int -> Int’
to a visible type argument ‘Rational’
• In the expression: plus @Rational 5 10
In an equation for ‘c’: c = plus @Rational 5 10
-VtaFail.hs:48:5: error:
+VtaFail.hs:50:5: error:
• Cannot apply expression of type ‘Int -> Int -> Int’
to a visible type argument ‘Int’
• In the expression: (+) @Int @Int @Int 12 14
In an equation for ‘d’: d = (+) @Int @Int @Int 12 14
-VtaFail.hs:51:5: error:
+VtaFail.hs:53:5: error:
• Cannot apply expression of type ‘Int -> String’
to a visible type argument ‘Float’
• In the expression: show @Int @Float (read "5")
In an equation for ‘e’: e = show @Int @Float (read "5")
-VtaFail.hs:52:11: error:
+VtaFail.hs:54:11: error:
• Cannot apply expression of type ‘String -> Int’
to a visible type argument ‘Bool’
• In the first argument of ‘show’, namely
@@ -80,7 +81,7 @@ VtaFail.hs:52:11: error:
In the expression: show (read @Int @Bool @Float "3")
In an equation for ‘f’: f = show (read @Int @Bool @Float "3")
-VtaFail.hs:57:12: error:
+VtaFail.hs:59:12: error:
• Expecting one more argument to ‘Maybe’
Expected a type, but ‘Maybe’ has kind ‘* -> *’
• In the type ‘Maybe’
diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T
index d97c6f96e1..0b4e6b70d7 100644
--- a/testsuite/tests/typecheck/should_fail/all.T
+++ b/testsuite/tests/typecheck/should_fail/all.T
@@ -483,7 +483,7 @@ test('T14904b', normal, compile_fail, [''])
test('T15067', normal, compile_fail, [''])
test('T15330', normal, compile_fail, [''])
test('T15361', normal, compile_fail, [''])
-test('T15438', normal, compile_fail, [''])
+test('T15438', normal, compile, [''])
test('T15515', normal, compile_fail, [''])
test('T15523', normal, compile_fail, ['-O'])
test('T15527', normal, compile_fail, [''])
@@ -561,6 +561,7 @@ test('T17566c', normal, compile_fail, [''])
test('T17773', normal, compile_fail, [''])
test('T17021', normal, compile_fail, [''])
test('T17021b', normal, compile_fail, [''])
+test('T17775', normal, compile_fail, [''])
test('T17955', normal, compile_fail, [''])
test('T17173', normal, compile_fail, [''])
test('T18127a', normal, compile_fail, [''])
diff --git a/testsuite/tests/typecheck/should_fail/mc19.stderr b/testsuite/tests/typecheck/should_fail/mc19.stderr
index 1b9682e6c8..5d19a388af 100644
--- a/testsuite/tests/typecheck/should_fail/mc19.stderr
+++ b/testsuite/tests/typecheck/should_fail/mc19.stderr
@@ -1,8 +1,12 @@
mc19.hs:10:31: error:
- • Occurs check: cannot construct the infinite type: a ~ [a]
- Expected type: [a] -> [a]
- Actual type: [a] -> [[a]]
+ • Couldn't match type ‘a’ with ‘[a]’
+ Expected: [a] -> [a]
+ Actual: [a] -> [[a]]
+ ‘a’ is a rigid type variable bound by
+ a type expected by the context:
+ forall {a}. [a] -> [a]
+ at mc19.hs:10:31-35
• In the expression: inits
In a stmt of a monad comprehension: then inits
In the expression: [x | x <- [3, 2, 1], then inits]
diff --git a/testsuite/tests/typecheck/should_fail/mc21.stderr b/testsuite/tests/typecheck/should_fail/mc21.stderr
index 014628f94a..abad9f6a20 100644
--- a/testsuite/tests/typecheck/should_fail/mc21.stderr
+++ b/testsuite/tests/typecheck/should_fail/mc21.stderr
@@ -1,8 +1,12 @@
mc21.hs:12:26: error:
- • Occurs check: cannot construct the infinite type: a ~ [a]
- Expected type: [a] -> [[a]]
- Actual type: [[a]] -> [[a]]
+ • Couldn't match type ‘a’ with ‘[a]’
+ Expected: [a] -> [[a]]
+ Actual: [a] -> [a]
+ ‘a’ is a rigid type variable bound by
+ a type expected by the context:
+ forall {a}. [a] -> [[a]]
+ at mc21.hs:12:26-31
• In the expression: take 5
In a stmt of a monad comprehension: then group using take 5
In the expression:
diff --git a/testsuite/tests/typecheck/should_fail/mc22.stderr b/testsuite/tests/typecheck/should_fail/mc22.stderr
index 40a754a9c5..50dbf5425b 100644
--- a/testsuite/tests/typecheck/should_fail/mc22.stderr
+++ b/testsuite/tests/typecheck/should_fail/mc22.stderr
@@ -1,11 +1,15 @@
mc22.hs:10:26: error:
- • Occurs check: cannot construct the infinite type: a ~ t a
- Expected type: [a] -> [t a]
- Actual type: [t a] -> [t a]
+ • Couldn't match type ‘a’ with ‘t a’
+ Expected: [a] -> [t a]
+ Actual: [a] -> [a]
+ ‘a’ is a rigid type variable bound by
+ a type expected by the context:
+ forall {a}. [a] -> [t a]
+ at mc22.hs:10:26-31
• In the expression: take 5
In a stmt of a monad comprehension: then group using take 5
In the expression:
[x + 1 | x <- ["Hello", "World"], then group using take 5]
• Relevant bindings include
- foo :: [t [Char]] (bound at mc22.hs:8:1)
+ foo :: [t String] (bound at mc22.hs:8:1)
diff --git a/testsuite/tests/typecheck/should_fail/mc23.stderr b/testsuite/tests/typecheck/should_fail/mc23.stderr
index 2f3ae27a98..b9029f1635 100644
--- a/testsuite/tests/typecheck/should_fail/mc23.stderr
+++ b/testsuite/tests/typecheck/should_fail/mc23.stderr
@@ -1,8 +1,9 @@
mc23.hs:9:29: error:
- • Couldn't match type ‘[a0]’ with ‘[a] -> m a’
- Expected type: (a -> b) -> [a] -> m a
- Actual type: [a0] -> [a0]
+ • Couldn't match type: [a0]
+ with: a -> b
+ Expected: (a -> b) -> [a] -> m a
+ Actual: [a0] -> [a0]
• Possible cause: ‘take’ is applied to too many arguments
In the expression: take 5
In a stmt of a monad comprehension: then take 5 by x
diff --git a/testsuite/tests/typecheck/should_fail/mc24.stderr b/testsuite/tests/typecheck/should_fail/mc24.stderr
index 06a9c51690..e40a0c6e72 100644
--- a/testsuite/tests/typecheck/should_fail/mc24.stderr
+++ b/testsuite/tests/typecheck/should_fail/mc24.stderr
@@ -1,11 +1,11 @@
mc24.hs:10:31: error:
- • Couldn't match type ‘[a1]’ with ‘[a] -> m [a]’
- Expected type: (a -> a0) -> [a] -> m [a]
- Actual type: [a1] -> [a1]
+ • Couldn't match type: [a1]
+ with: a -> a0
+ Expected: (a -> a0) -> [a] -> m [a]
+ Actual: [a1] -> [a1]
• Possible cause: ‘take’ is applied to too many arguments
In the expression: take 2
In a stmt of a monad comprehension: then group by x using take 2
In the expression:
[GHC.List.length x | x <- [1 .. 10], then group by x using take 2]
- • Relevant bindings include foo :: m Int (bound at mc24.hs:8:1)
diff --git a/testsuite/tests/typecheck/should_fail/mc25.stderr b/testsuite/tests/typecheck/should_fail/mc25.stderr
index 5c29197f04..f4e992f9e7 100644
--- a/testsuite/tests/typecheck/should_fail/mc25.stderr
+++ b/testsuite/tests/typecheck/should_fail/mc25.stderr
@@ -1,8 +1,8 @@
mc25.hs:9:46: error:
- • Couldn't match type ‘a -> t1’ with ‘Int’
- Expected type: (a -> t1) -> [a] -> [t a]
- Actual type: Int -> [t a] -> [t a]
+ • Couldn't match type ‘Int’ with ‘a -> t1’
+ Expected: (a -> t1) -> [a] -> [t a]
+ Actual: Int -> [a] -> [a]
• In the expression: take
In a stmt of a monad comprehension: then group by x using take
In the expression: [x | x <- [1 .. 10], then group by x using take]
diff --git a/testsuite/tests/typecheck/should_fail/tcfail001.stderr b/testsuite/tests/typecheck/should_fail/tcfail001.stderr
index 2d4caf2ac7..7f49c869ee 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail001.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail001.stderr
@@ -1,7 +1,7 @@
tcfail001.hs:9:2: error:
- • Couldn't match expected type ‘[a]’
- with actual type ‘[a0] -> [a1]’
+ • Couldn't match expected type: [a]
+ with actual type: [a0] -> [a1]
• The equation(s) for ‘op’ have one value argument,
but its type ‘[a]’ has none
In the instance declaration for ‘A [a]’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail002.stderr b/testsuite/tests/typecheck/should_fail/tcfail002.stderr
index d72a34065e..664c910533 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail002.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail002.stderr
@@ -1,6 +1,6 @@
tcfail002.hs:4:7: error:
- • Occurs check: cannot construct the infinite type: p ~ [p]
+ • Couldn't match expected type ‘p’ with actual type ‘[p]’
• In the expression: z
In an equation for ‘c’: c z = z
• Relevant bindings include
diff --git a/testsuite/tests/typecheck/should_fail/tcfail004.stderr b/testsuite/tests/typecheck/should_fail/tcfail004.stderr
index 9d6657e651..0d4f700910 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail004.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail004.stderr
@@ -1,7 +1,7 @@
tcfail004.hs:3:9: error:
- • Couldn't match expected type ‘(a, b)’
- with actual type ‘(a0, b0, c0)’
+ • Couldn't match expected type: (a, b)
+ with actual type: (a0, b0, c0)
• In the expression: (1, 2, 3)
In a pattern binding: (f, g) = (1, 2, 3)
• Relevant bindings include
diff --git a/testsuite/tests/typecheck/should_fail/tcfail005.stderr b/testsuite/tests/typecheck/should_fail/tcfail005.stderr
index d206505cdc..8da93af1e2 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail005.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail005.stderr
@@ -1,6 +1,7 @@
tcfail005.hs:3:9: error:
- • Couldn't match expected type ‘[a]’ with actual type ‘(a0, Char)’
+ • Couldn't match expected type: [a]
+ with actual type: (a0, Char)
• In the expression: (1, 'a')
In a pattern binding: (h : i) = (1, 'a')
• Relevant bindings include
diff --git a/testsuite/tests/typecheck/should_fail/tcfail014.stderr b/testsuite/tests/typecheck/should_fail/tcfail014.stderr
index f506bff6f8..65b217ef1f 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail014.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail014.stderr
@@ -1,6 +1,6 @@
tcfail014.hs:5:33: error:
- • Occurs check: cannot construct the infinite type: t4 ~ t4 -> t5
+ • Couldn't match expected type ‘t4’ with actual type ‘t4 -> t5’
• In the first argument of ‘z’, namely ‘z’
In the expression: z z
In an equation for ‘h’: h z = z z
diff --git a/testsuite/tests/typecheck/should_fail/tcfail016.stderr b/testsuite/tests/typecheck/should_fail/tcfail016.stderr
index 20b9e0fa36..9f38cd6461 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail016.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail016.stderr
@@ -1,7 +1,8 @@
tcfail016.hs:8:1: error:
- • Couldn't match type ‘Expr a’ with ‘(a, Expr a)’
- Expected type: AnnExpr a -> [[Char]]
- Actual type: Expr a -> [[Char]]
+ • Couldn't match type: Expr a
+ with: (a, Expr a)
+ Expected: AnnExpr a -> [[Char]]
+ Actual: Expr a -> [[Char]]
• Relevant bindings include
g :: AnnExpr a -> [[Char]] (bound at tcfail016.hs:8:1)
diff --git a/testsuite/tests/typecheck/should_fail/tcfail033.stderr b/testsuite/tests/typecheck/should_fail/tcfail033.stderr
index bc346c2aac..a1c5e7d7d0 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail033.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail033.stderr
@@ -1,6 +1,6 @@
tcfail033.hs:4:12: error:
- • Occurs check: cannot construct the infinite type: a ~ (a, b)
+ • Couldn't match expected type ‘(a, b)’ with actual type ‘a’
• In the expression: x
In the expression: [x | (x, y) <- buglet]
In an equation for ‘buglet’: buglet = [x | (x, y) <- buglet]
diff --git a/testsuite/tests/typecheck/should_fail/tcfail065.stderr b/testsuite/tests/typecheck/should_fail/tcfail065.stderr
index c1f3283daa..9be21918cb 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail065.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail065.stderr
@@ -1,14 +1,15 @@
tcfail065.hs:29:18: error:
• Couldn't match type ‘x1’ with ‘x’
+ Expected: X x
+ Actual: X x1
‘x1’ is a rigid type variable bound by
the type signature for:
setX :: forall x1. x1 -> X x -> X x
at tcfail065.hs:29:3-6
‘x’ is a rigid type variable bound by
- the instance declaration at tcfail065.hs:28:10-19
- Expected type: X x
- Actual type: X x1
+ the instance declaration
+ at tcfail065.hs:28:10-19
• In the expression: X x
In an equation for ‘setX’: setX x (X _) = X x
In the instance declaration for ‘HasX (X x)’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail068.stderr b/testsuite/tests/typecheck/should_fail/tcfail068.stderr
index 299fc7b8a7..c7b7630e04 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail068.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail068.stderr
@@ -1,6 +1,8 @@
tcfail068.hs:14:9: error:
• Couldn't match type ‘s1’ with ‘s’
+ Expected: GHC.ST.ST s1 (IndTree s a)
+ Actual: GHC.ST.ST s1 (STArray s1 (Int, Int) a)
‘s1’ is a rigid type variable bound by
a type expected by the context:
forall s1. GHC.ST.ST s1 (IndTree s a)
@@ -11,8 +13,6 @@ tcfail068.hs:14:9: error:
Constructed a =>
(Int, Int) -> a -> IndTree s a
at tcfail068.hs:11:1-55
- Expected type: GHC.ST.ST s1 (IndTree s a)
- Actual type: GHC.ST.ST s1 (STArray s1 (Int, Int) a)
• In the first argument of ‘runST’, namely
‘(newSTArray ((1, 1), n) x)’
In the expression: runST (newSTArray ((1, 1), n) x)
@@ -24,6 +24,8 @@ tcfail068.hs:14:9: error:
tcfail068.hs:19:9: error:
• Couldn't match type ‘s1’ with ‘s’
+ Expected: GHC.ST.ST s1 (IndTree s a)
+ Actual: GHC.ST.ST s (IndTree s a)
‘s1’ is a rigid type variable bound by
a type expected by the context:
forall s1. GHC.ST.ST s1 (IndTree s a)
@@ -34,8 +36,6 @@ tcfail068.hs:19:9: error:
Constructed a =>
(Int, Int) -> (a -> a) -> IndTree s a -> IndTree s a
at tcfail068.hs:16:1-75
- Expected type: GHC.ST.ST s1 (IndTree s a)
- Actual type: GHC.ST.ST s (IndTree s a)
• In the first argument of ‘runST’, namely
‘(readSTArray arr i
>>= \ val -> writeSTArray arr i (f val) >> return arr)’
@@ -55,6 +55,8 @@ tcfail068.hs:19:9: error:
tcfail068.hs:24:36: error:
• Couldn't match type ‘s1’ with ‘s’
+ Expected: GHC.ST.ST s1 (IndTree s a)
+ Actual: GHC.ST.ST s (IndTree s a)
‘s1’ is a rigid type variable bound by
a type expected by the context:
forall s1. GHC.ST.ST s1 (IndTree s a)
@@ -65,8 +67,6 @@ tcfail068.hs:24:36: error:
Constructed a =>
((Int, Int), (Int, Int)) -> (a -> a) -> IndTree s a -> IndTree s a
at tcfail068.hs:23:1-87
- Expected type: GHC.ST.ST s1 (IndTree s a)
- Actual type: GHC.ST.ST s (IndTree s a)
• In the first argument of ‘runST’, namely ‘(itrap' i k)’
In the expression: runST (itrap' i k)
In an equation for ‘itrap’:
@@ -92,6 +92,8 @@ tcfail068.hs:24:36: error:
tcfail068.hs:36:46: error:
• Couldn't match type ‘s1’ with ‘s’
+ Expected: GHC.ST.ST s1 (c, IndTree s b)
+ Actual: GHC.ST.ST s (c, IndTree s b)
‘s1’ is a rigid type variable bound by
a type expected by the context:
forall s1. GHC.ST.ST s1 (c, IndTree s b)
@@ -108,8 +110,6 @@ tcfail068.hs:36:46: error:
-> IndTree s b
-> (c, IndTree s b)
at tcfail068.hs:(34,1)-(35,62)
- Expected type: GHC.ST.ST s1 (c, IndTree s b)
- Actual type: GHC.ST.ST s (c, IndTree s b)
• In the first argument of ‘runST’, namely ‘(itrapstate' i k s)’
In the expression: runST (itrapstate' i k s)
In an equation for ‘itrapstate’:
diff --git a/testsuite/tests/typecheck/should_fail/tcfail069.stderr b/testsuite/tests/typecheck/should_fail/tcfail069.stderr
index fcaf3e9542..a7c996ce84 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail069.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail069.stderr
@@ -1,7 +1,7 @@
tcfail069.hs:21:7: error:
- • Couldn't match expected type ‘([Int], [Int])’
- with actual type ‘[a0]’
+ • Couldn't match expected type: ([Int], [Int])
+ with actual type: [a0]
• In the pattern: []
In a case alternative: [] -> error "foo"
In the expression: case (list1, list2) of { [] -> error "foo" }
diff --git a/testsuite/tests/typecheck/should_fail/tcfail076.stderr b/testsuite/tests/typecheck/should_fail/tcfail076.stderr
index 52fcebb927..47432ae851 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail076.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail076.stderr
@@ -1,6 +1,8 @@
tcfail076.hs:18:82: error:
• Couldn't match type ‘res1’ with ‘res’
+ Expected: m res1
+ Actual: m res
‘res1’ is a rigid type variable bound by
a type expected by the context:
forall res1. (b -> m res1) -> m res1
@@ -9,8 +11,6 @@ tcfail076.hs:18:82: error:
a type expected by the context:
forall res. (a -> m res) -> m res
at tcfail076.hs:18:35-96
- Expected type: m res1
- Actual type: m res
• In the expression: cont a
In the first argument of ‘KContT’, namely ‘(\ cont' -> cont a)’
In the expression: KContT (\ cont' -> cont a)
diff --git a/testsuite/tests/typecheck/should_fail/tcfail103.stderr b/testsuite/tests/typecheck/should_fail/tcfail103.stderr
index 2192d8a7f6..84c9c8b0b6 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail103.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail103.stderr
@@ -1,6 +1,8 @@
tcfail103.hs:15:13: error:
• Couldn't match type ‘s’ with ‘t’
+ Expected: ST s Int
+ Actual: ST t Int
‘s’ is a rigid type variable bound by
the type signature for:
g :: forall s. ST s Int
@@ -9,8 +11,6 @@ tcfail103.hs:15:13: error:
the type signature for:
f :: forall t. ST t Int
at tcfail103.hs:10:1-12
- Expected type: ST s Int
- Actual type: ST t Int
• In the expression: readSTRef v
In an equation for ‘g’: g = readSTRef v
In the expression:
diff --git a/testsuite/tests/typecheck/should_fail/tcfail104.stderr b/testsuite/tests/typecheck/should_fail/tcfail104.stderr
index 6516dcbd3a..9844b53268 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail104.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail104.stderr
@@ -1,8 +1,9 @@
tcfail104.hs:14:12: error:
- • Couldn't match type ‘forall a. a -> a’ with ‘Char -> Char’
- Expected type: (Char -> Char) -> Char -> Char
- Actual type: (forall a. a -> a) -> Char -> Char
+ • Couldn't match type: forall a. a -> a
+ with: Char -> Char
+ Expected: (Char -> Char) -> Char -> Char
+ Actual: (forall a. a -> a) -> Char -> Char
• In the expression: \ (x :: forall a. a -> a) -> x
In the expression:
if v then (\ (x :: forall a. a -> a) -> x) else (\ x -> x)
@@ -10,8 +11,8 @@ tcfail104.hs:14:12: error:
(if v then (\ (x :: forall a. a -> a) -> x) else (\ x -> x)) id 'c'
tcfail104.hs:22:15: error:
- • Couldn't match expected type ‘Char -> Char’
- with actual type ‘forall a. a -> a’
+ • Couldn't match expected type: Char -> Char
+ with actual type: forall a. a -> a
• When checking that the pattern signature: forall a. a -> a
fits the type of its context: Char -> Char
In the pattern: x :: forall a. a -> a
diff --git a/testsuite/tests/typecheck/should_fail/tcfail119.stderr b/testsuite/tests/typecheck/should_fail/tcfail119.stderr
index 5c22aefc4e..d23ab1f537 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail119.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail119.stderr
@@ -1,5 +1,7 @@
-tcfail119.hs:11:8:
- Couldn't match expected type ‘Bool’ with actual type ‘[Char]’
- In the pattern: "Foo"
- In an equation for ‘b’: b x "Foo" = ()
+tcfail119.hs:11:8: error:
+ • Couldn't match type ‘Bool’ with ‘[Char]’
+ Expected: Bool
+ Actual: String
+ • In the pattern: "Foo"
+ In an equation for ‘b’: b x "Foo" = ()
diff --git a/testsuite/tests/typecheck/should_fail/tcfail122.stderr b/testsuite/tests/typecheck/should_fail/tcfail122.stderr
index 0ac1419e7d..39507bdbeb 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail122.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail122.stderr
@@ -4,8 +4,8 @@ tcfail122.hs:8:9: error:
When matching types
c0 :: (* -> *) -> *
a :: * -> *
- Expected type: a b
- Actual type: c0 d0
+ Expected: a b
+ Actual: c0 d0
• In the expression:
undefined :: forall (c :: (* -> *) -> *) (d :: * -> *). c d
In the expression:
diff --git a/testsuite/tests/typecheck/should_fail/tcfail132.stderr b/testsuite/tests/typecheck/should_fail/tcfail132.stderr
index 2e0a13c844..92f7c2ab52 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail132.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail132.stderr
@@ -1,13 +1,15 @@
tcfail132.hs:17:37: error:
- • Expected kind ‘* -> * -> * -> *’,
+ • Couldn't match kind ‘*’ with ‘* -> *’
+ Expected kind ‘* -> * -> * -> *’,
but ‘Object f' f t’ has kind ‘* -> * -> *’
• In the first argument of ‘T’, namely ‘(Object f' f t)’
In the type ‘T (Object f' f t) (DUnit t)’
In the type declaration for ‘LiftObject’
tcfail132.hs:17:53: error:
- • Expected kind ‘* -> * -> * -> *’,
+ • Couldn't match kind ‘*’ with ‘* -> *’
+ Expected kind ‘* -> * -> * -> *’,
but ‘DUnit t’ has kind ‘* -> * -> *’
• In the second argument of ‘T’, namely ‘(DUnit t)’
In the type ‘T (Object f' f t) (DUnit t)’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail140.stderr b/testsuite/tests/typecheck/should_fail/tcfail140.stderr
index c0049d0e19..8de86280e1 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail140.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail140.stderr
@@ -17,14 +17,14 @@ tcfail140.hs:12:10: error:
rot :: p -> t (bound at tcfail140.hs:12:1)
tcfail140.hs:14:15: error:
- • Couldn't match expected type ‘t -> b’ with actual type ‘Int’
+ • Couldn't match expected type ‘a -> b’ with actual type ‘Int’
• The operator ‘f’ takes two value arguments,
- but its type ‘Int -> Int’ has only one
+ but its type ‘Int -> Int’ has only one
In the first argument of ‘map’, namely ‘(3 `f`)’
In the expression: map (3 `f`) xs
• Relevant bindings include
- xs :: [t] (bound at tcfail140.hs:14:5)
- bot :: [t] -> [b] (bound at tcfail140.hs:14:1)
+ xs :: [a] (bound at tcfail140.hs:14:5)
+ bot :: [a] -> [b] (bound at tcfail140.hs:14:1)
tcfail140.hs:16:8: error:
• The constructor ‘Just’ should have 1 argument, but has been given none
diff --git a/testsuite/tests/typecheck/should_fail/tcfail165.stderr b/testsuite/tests/typecheck/should_fail/tcfail165.stderr
index 19fe79bb78..b1f173f447 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail165.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail165.stderr
@@ -1,7 +1,7 @@
tcfail165.hs:19:23: error:
- • Couldn't match expected type ‘forall a. Show a => a -> String’
- with actual type ‘b0 -> String’
+ • Couldn't match expected type: forall a. Show a => a -> String
+ with actual type: b0 -> String
• In the second argument of ‘putMVar’, namely
‘(show :: forall b. Show b => b -> String)’
In a stmt of a 'do' block:
diff --git a/testsuite/tests/typecheck/should_fail/tcfail168.stderr b/testsuite/tests/typecheck/should_fail/tcfail168.stderr
index 4ec71aaa1d..59972c2aa4 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail168.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail168.stderr
@@ -1,7 +1,7 @@
tcfail168.hs:7:11: error:
- • Couldn't match expected type ‘IO a0’
- with actual type ‘Char -> IO ()’
+ • Couldn't match expected type: IO a0
+ with actual type: Char -> IO ()
• Probable cause: ‘putChar’ is applied to too few arguments
In a stmt of a 'do' block: putChar
In the expression:
diff --git a/testsuite/tests/typecheck/should_fail/tcfail174.stderr b/testsuite/tests/typecheck/should_fail/tcfail174.stderr
index 724535145c..5747a270ef 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail174.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail174.stderr
@@ -1,21 +1,22 @@
tcfail174.hs:9:5: error:
- • Couldn't match type ‘a0 -> a0’ with ‘forall a. a -> a’
- Expected type: Capture (forall a. a -> a)
- Actual type: Capture (a0 -> a0)
+ • Couldn't match type: a0 -> a0
+ with: forall a. a -> a
+ Expected: Capture (forall a. a -> a)
+ Actual: Capture (a0 -> a0)
• In the expression: Base id
In an equation for ‘g’: g = Base id
tcfail174.hs:16:14: error:
• Couldn't match type ‘a1’ with ‘a’
+ Expected: Capture (forall x. x -> a)
+ Actual: Capture (forall a. a -> a)
‘a1’ is a rigid type variable bound by
the type a -> a
at tcfail174.hs:16:1-14
‘a’ is a rigid type variable bound by
the inferred type of h1 :: Capture a
at tcfail174.hs:16:1-14
- Expected type: Capture (forall x. x -> a)
- Actual type: Capture (forall a. a -> a)
• In the first argument of ‘Capture’, namely ‘g’
In the expression: Capture g
In an equation for ‘h1’: h1 = Capture g
@@ -24,6 +25,8 @@ tcfail174.hs:16:14: error:
tcfail174.hs:19:14: error:
• Couldn't match type ‘a’ with ‘b’
+ Expected: Capture (forall x. x -> b)
+ Actual: Capture (forall a. a -> a)
‘a’ is a rigid type variable bound by
the type a -> a
at tcfail174.hs:1:1
@@ -31,8 +34,6 @@ tcfail174.hs:19:14: error:
the type signature for:
h2 :: forall b. Capture b
at tcfail174.hs:18:1-15
- Expected type: Capture (forall x. x -> b)
- Actual type: Capture (forall a. a -> a)
• In the first argument of ‘Capture’, namely ‘g’
In the expression: Capture g
In an equation for ‘h2’: h2 = Capture g
diff --git a/testsuite/tests/typecheck/should_fail/tcfail178.stderr b/testsuite/tests/typecheck/should_fail/tcfail178.stderr
index 98df425424..d9f1b455c0 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail178.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail178.stderr
@@ -1,8 +1,8 @@
tcfail178.hs:15:7: error:
• Couldn't match type ‘()’ with ‘[a]’
- Expected type: Bool -> [a]
- Actual type: Bool -> ()
+ Expected: Bool -> [a]
+ Actual: Bool -> ()
• In the first argument of ‘a’, namely ‘y’
In the expression: a y
In an equation for ‘c’: c = a y
diff --git a/testsuite/tests/typecheck/should_fail/tcfail179.stderr b/testsuite/tests/typecheck/should_fail/tcfail179.stderr
index 7d16288b1f..a0c124590f 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail179.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail179.stderr
@@ -1,6 +1,8 @@
tcfail179.hs:14:41: error:
• Couldn't match type ‘x’ with ‘s’
+ Expected: x -> s
+ Actual: x -> x
‘x’ is a rigid type variable bound by
a pattern with constructor:
T :: forall s x. (s -> (x -> s) -> (x, s, Int)) -> T s,
@@ -10,8 +12,6 @@ tcfail179.hs:14:41: error:
the type signature for:
run :: forall s. T s -> Int
at tcfail179.hs:12:1-17
- Expected type: x -> s
- Actual type: s -> s
• In the second argument of ‘g’, namely ‘id’
In the expression: g x id
In a pattern binding: (x, _, b) = g x id
diff --git a/testsuite/tests/typecheck/should_fail/tcfail182.stderr b/testsuite/tests/typecheck/should_fail/tcfail182.stderr
index e57c3c1672..12dbb6efa8 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail182.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail182.stderr
@@ -1,10 +1,10 @@
tcfail182.hs:9:3: error:
- • Couldn't match expected type ‘Prelude.Maybe a’
- with actual type ‘Maybe a0’
- NB: ‘Maybe’ is defined at tcfail182.hs:6:1-18
- ‘Prelude.Maybe’
- is defined in ‘GHC.Maybe’ in package ‘base-4.13.0.0’
+ • Couldn't match expected type: Prelude.Maybe a
+ with actual type: Maybe a0
+ NB: ‘Prelude.Maybe’
+ is defined in ‘GHC.Maybe’ in package ‘base-4.14.0.0’
+ ‘Maybe’ is defined at tcfail182.hs:6:1-18
• In the pattern: Foo
In an equation for ‘f’: f Foo = 3
• Relevant bindings include
diff --git a/testsuite/tests/typecheck/should_fail/tcfail186.stderr b/testsuite/tests/typecheck/should_fail/tcfail186.stderr
index 9b38bca915..5d931076f7 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail186.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail186.stderr
@@ -1,8 +1,8 @@
tcfail186.hs:7:9: error:
• Couldn't match type ‘[Char]’ with ‘Int’
- Expected type: PhantomSyn a0
- Actual type: [Char]
+ Expected: PhantomSyn a0
+ Actual: String
• In the first argument of ‘f’, namely ‘"hoo"’
In the expression: f "hoo"
In an equation for ‘foo’: foo = f "hoo"
diff --git a/testsuite/tests/typecheck/should_fail/tcfail189.stderr b/testsuite/tests/typecheck/should_fail/tcfail189.stderr
index f33d1e37f6..108a7ad973 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail189.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail189.stderr
@@ -1,8 +1,9 @@
tcfail189.hs:10:31: error:
- • Couldn't match type ‘[a1]’ with ‘[a] -> [[a]]’
- Expected type: (a -> a0) -> [a] -> [[a]]
- Actual type: [a1] -> [a1]
+ • Couldn't match type: [a1]
+ with: a -> a0
+ Expected: (a -> a0) -> [a] -> [[a]]
+ Actual: [a1] -> [a1]
• Possible cause: ‘take’ is applied to too many arguments
In the expression: take 2
In a stmt of a list comprehension: then group by x using take 2
diff --git a/testsuite/tests/typecheck/should_fail/tcfail191.stderr b/testsuite/tests/typecheck/should_fail/tcfail191.stderr
index 125c2d8393..fd874653b0 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail191.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail191.stderr
@@ -1,8 +1,12 @@
tcfail191.hs:11:26: error:
- • Occurs check: cannot construct the infinite type: a ~ [a]
- Expected type: [a] -> [[a]]
- Actual type: [[a]] -> [[a]]
+ • Couldn't match type ‘a’ with ‘[a]’
+ Expected: [a] -> [[a]]
+ Actual: [a] -> [a]
+ ‘a’ is a rigid type variable bound by
+ a type expected by the context:
+ forall {a}. [a] -> [[a]]
+ at tcfail191.hs:11:26-31
• In the expression: take 5
In a stmt of a list comprehension: then group using take 5
In the expression:
diff --git a/testsuite/tests/typecheck/should_fail/tcfail193.stderr b/testsuite/tests/typecheck/should_fail/tcfail193.stderr
index 028e2f0232..cf4813c9f2 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail193.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail193.stderr
@@ -1,8 +1,12 @@
tcfail193.hs:10:31: error:
- • Occurs check: cannot construct the infinite type: a ~ [a]
- Expected type: [a] -> [a]
- Actual type: [a] -> [[a]]
+ • Couldn't match type ‘a’ with ‘[a]’
+ Expected: [a] -> [a]
+ Actual: [a] -> [[a]]
+ ‘a’ is a rigid type variable bound by
+ a type expected by the context:
+ forall {a}. [a] -> [a]
+ at tcfail193.hs:10:31-35
• In the expression: inits
In a stmt of a list comprehension: then inits
In the expression: [x | x <- [3, 2, 1], then inits]
diff --git a/testsuite/tests/typecheck/should_fail/tcfail199.stderr b/testsuite/tests/typecheck/should_fail/tcfail199.stderr
index 4833c769f9..50fc8e5f44 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail199.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail199.stderr
@@ -1,5 +1,8 @@
-tcfail199.hs:5:1:
- Couldn't match expected type ‘IO t0’ with actual type ‘[Char]’
- In the expression: main
- When checking the type of the IO action ‘main’
+tcfail199.hs:5:1: error:
+ • Couldn't match type: [Char]
+ with: IO t0
+ Expected: IO t0
+ Actual: String
+ • In the expression: main
+ When checking the type of the IO action ‘main’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail201.stderr b/testsuite/tests/typecheck/should_fail/tcfail201.stderr
index 77349e29f4..dd1385fc90 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail201.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail201.stderr
@@ -1,14 +1,14 @@
tcfail201.hs:17:56: error:
• Couldn't match type ‘a’ with ‘HsDoc id0’
+ Expected: c a
+ Actual: c (HsDoc id0)
‘a’ is a rigid type variable bound by
the type signature for:
gfoldl' :: forall (c :: * -> *) a.
(forall a1 b. c (a1 -> b) -> a1 -> c b)
-> (forall g. g -> c g) -> a -> c a
at tcfail201.hs:15:1-85
- Expected type: c a
- Actual type: c (HsDoc id0)
• In the expression: z DocEmpty
In a case alternative: DocEmpty -> z DocEmpty
In the expression: case hsDoc of { DocEmpty -> z DocEmpty }
diff --git a/testsuite/tests/typecheck/should_fail/tcfail206.stderr b/testsuite/tests/typecheck/should_fail/tcfail206.stderr
index 7c97fc02af..cfb5161100 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail206.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail206.stderr
@@ -1,26 +1,27 @@
tcfail206.hs:5:5: error:
• Couldn't match type ‘Bool’ with ‘Int’
- Expected type: Bool -> (Int, Bool)
- Actual type: Int -> (Int, Bool)
+ Expected: Bool -> (Int, Bool)
+ Actual: Bool -> (Bool, Bool)
• In the expression: (, True)
In an equation for ‘a’: a = (, True)
tcfail206.hs:8:5: error:
- • Couldn't match type ‘(t1, Int)’ with ‘Bool -> (Int, Bool)’
- Expected type: Int -> Bool -> (Int, Bool)
- Actual type: Int -> (t1, Int)
+ • Couldn't match type: (t1, Int)
+ with: Bool -> (Int, Bool)
+ Expected: Int -> Bool -> (Int, Bool)
+ Actual: Int -> (t1, Int)
• In the expression: (1,)
In an equation for ‘b’: b = (1,)
tcfail206.hs:11:5: error:
• Couldn't match type ‘a’ with ‘Bool’
+ Expected: a -> (a, Bool)
+ Actual: a -> (Bool, a)
‘a’ is a rigid type variable bound by
the type signature for:
c :: forall a. a -> (a, Bool)
at tcfail206.hs:10:1-19
- Expected type: a -> (a, Bool)
- Actual type: Bool -> (a, Bool)
• In the expression: (True || False,)
In an equation for ‘c’: c = (True || False,)
• Relevant bindings include
@@ -28,27 +29,27 @@ tcfail206.hs:11:5: error:
tcfail206.hs:14:5: error:
• Couldn't match type ‘Bool’ with ‘Int’
- Expected type: Bool -> (# Int, Bool #)
- Actual type: Int -> (# Int, Bool #)
+ Expected: Bool -> (# Int, Bool #)
+ Actual: Bool -> (# Bool, Bool #)
• In the expression: (# , True #)
In an equation for ‘d’: d = (# , True #)
tcfail206.hs:17:5: error:
- • Couldn't match type ‘(# t0, Int #)’
- with ‘Bool -> (# Int, Bool #)’
- Expected type: Int -> Bool -> (# Int, Bool #)
- Actual type: Int -> (# t0, Int #)
+ • Couldn't match type: (# t0, Int #)
+ with: Bool -> (# Int, Bool #)
+ Expected: Int -> Bool -> (# Int, Bool #)
+ Actual: Int -> (# t0, Int #)
• In the expression: (# 1, #)
In an equation for ‘e’: e = (# 1, #)
tcfail206.hs:20:5: error:
• Couldn't match type ‘a’ with ‘Bool’
+ Expected: a -> (# a, Bool #)
+ Actual: a -> (# Bool, a #)
‘a’ is a rigid type variable bound by
the type signature for:
f :: forall a. a -> (# a, Bool #)
at tcfail206.hs:19:1-21
- Expected type: a -> (# a, Bool #)
- Actual type: Bool -> (# a, Bool #)
• In the expression: (# True || False, #)
In an equation for ‘f’: f = (# True || False, #)
• Relevant bindings include
diff --git a/testsuite/tests/typecheck/should_fail/tcfail207.stderr b/testsuite/tests/typecheck/should_fail/tcfail207.stderr
index 986d7d5740..eb6fb1db15 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail207.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail207.stderr
@@ -1,14 +1,14 @@
-tcfail207.hs:5:7:
- Couldn't match expected type ‘[Int] -> [Int]’
- with actual type ‘[a1]’
- Possible cause: ‘take’ is applied to too many arguments
- In the expression: take x []
- In an equation for ‘f’: f x = take x []
+tcfail207.hs:5:7: error:
+ • Couldn't match expected type: [Int] -> [Int]
+ with actual type: [a1]
+ • Possible cause: ‘take’ is applied to too many arguments
+ In the expression: take x []
+ In an equation for ‘f’: f x = take x []
-tcfail207.hs:9:5:
- Couldn't match expected type ‘[Int]’
- with actual type ‘[a0] -> [a0]’
- Probable cause: ‘take’ is applied to too few arguments
- In the expression: take 3
- In an equation for ‘g’: g = take 3
+tcfail207.hs:9:5: error:
+ • Couldn't match expected type: [Int]
+ with actual type: [a0] -> [a0]
+ • Probable cause: ‘take’ is applied to too few arguments
+ In the expression: take 3
+ In an equation for ‘g’: g = take 3
diff --git a/testsuite/tests/typecheck/should_fail/tcfail225.stderr b/testsuite/tests/typecheck/should_fail/tcfail225.stderr
index 5a3ba3681f..8bfca4cb48 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail225.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail225.stderr
@@ -1,6 +1,7 @@
tcfail225.hs:9:19: error:
- • Expected kind ‘k -> *’, but ‘Maybe’ has kind ‘* -> *’
+ • Couldn't match kind ‘k’ with ‘*’
+ Expected kind ‘k -> *’, but ‘Maybe’ has kind ‘* -> *’
• In the first argument of ‘T’, namely ‘Maybe’
In the type ‘T Maybe (m a)’
In the definition of data constructor ‘MkT’
diff --git a/testsuite/tests/typecheck/should_run/IPRun.hs b/testsuite/tests/typecheck/should_run/IPRun.hs
index 0d2a8d76c6..6c3c88ff95 100644
--- a/testsuite/tests/typecheck/should_run/IPRun.hs
+++ b/testsuite/tests/typecheck/should_run/IPRun.hs
@@ -15,7 +15,7 @@ f2 () = let ?x = 5 in \() -> ?x
-- should always return 5
f3 :: () -> ((?x :: Int) => Int)
--- Deep skolemisation means that the local x=5 still wins
+-- Simple subsumption means that the x=0 from main wins
f3 = let ?x = 5 in \() -> ?x
main = let ?x = 0 in
diff --git a/testsuite/tests/typecheck/should_run/IPRun.stdout b/testsuite/tests/typecheck/should_run/IPRun.stdout
index e558e3cc3a..978f5752d6 100644
--- a/testsuite/tests/typecheck/should_run/IPRun.stdout
+++ b/testsuite/tests/typecheck/should_run/IPRun.stdout
@@ -1,4 +1,4 @@
5
5
5
-5
+0
diff --git a/testsuite/tests/typecheck/should_run/KindInvariant.stderr b/testsuite/tests/typecheck/should_run/KindInvariant.stderr
index 4f6cfffb7f..9d404ae088 100644
--- a/testsuite/tests/typecheck/should_run/KindInvariant.stderr
+++ b/testsuite/tests/typecheck/should_run/KindInvariant.stderr
@@ -1,6 +1,7 @@
<interactive>:1:3: error:
- • Expected kind ‘* -> *’,
+ • Couldn't match a lifted type with an unlifted type
+ Expected kind ‘* -> *’,
but ‘State#’ has kind ‘* -> TYPE ('TupleRep '[])’
• In the first argument of ‘T’, namely ‘State#’
In the type ‘T State#’
diff --git a/testsuite/tests/typecheck/should_run/T13838.stderr b/testsuite/tests/typecheck/should_run/T13838.stderr
index b2129f7d13..a8de8b16d3 100644
--- a/testsuite/tests/typecheck/should_run/T13838.stderr
+++ b/testsuite/tests/typecheck/should_run/T13838.stderr
@@ -1,5 +1,6 @@
-T13838.exe: T13838.hs:6:1: error:
- • Couldn't match expected type ‘IO t0’ with actual type ‘() -> ()’
+T13838: T13838.hs:6:1: error:
+ • Couldn't match expected type: IO t0
+ with actual type: () -> ()
• Probable cause: ‘main’ is applied to too few arguments
In the expression: main
When checking the type of the IO action ‘main’
diff --git a/testsuite/tests/typecheck/should_run/T7861.stderr b/testsuite/tests/typecheck/should_run/T7861.stderr
index 4a1c030d7c..f65b01e217 100644
--- a/testsuite/tests/typecheck/should_run/T7861.stderr
+++ b/testsuite/tests/typecheck/should_run/T7861.stderr
@@ -1,7 +1,11 @@
T7861: T7861.hs:10:5: error:
- • Occurs check: cannot construct the infinite type: a ~ [a]
- Expected type: (forall b. a) -> a
- Actual type: (forall b. a) -> [a]
+ • Couldn't match type ‘a’ with ‘[a]’
+ Expected: (forall b. a) -> a
+ Actual: (forall b. a) -> [a]
+ ‘a’ is a rigid type variable bound by
+ the type signature for:
+ f :: forall a. (forall b. a) -> a
+ at T7861.hs:9:1-23
• In the expression: doA
In an equation for ‘f’: f = doA
• Relevant bindings include
diff --git a/testsuite/tests/typecheck/should_run/Typeable1.stderr b/testsuite/tests/typecheck/should_run/Typeable1.stderr
index ec16681592..3ded9c03ed 100644
--- a/testsuite/tests/typecheck/should_run/Typeable1.stderr
+++ b/testsuite/tests/typecheck/should_run/Typeable1.stderr
@@ -1,6 +1,7 @@
Typeable1.hs:22:5: error: [-Winaccessible-code (in -Wdefault), -Werror=inaccessible-code]
- • Couldn't match type ‘ComposeK’ with ‘a3 b3’
+ • Couldn't match type: ComposeK
+ with: a3 b3
Inaccessible code in
a pattern with pattern synonym:
App :: forall k2 (t :: k2).
diff --git a/testsuite/tests/typecheck/should_run/all.T b/testsuite/tests/typecheck/should_run/all.T
index 4cd7a1b73c..5afc7e3725 100755
--- a/testsuite/tests/typecheck/should_run/all.T
+++ b/testsuite/tests/typecheck/should_run/all.T
@@ -58,7 +58,7 @@ test('tcrun038', [extra_files(['TcRun038_B.hs'])], multimod_compile_and_run, ['t
test('tcrun039', normal, compile_and_run, [''])
test('tcrun040', normal, compile_and_run, [''])
test('tcrun041', omit_ways(['ghci']), compile_and_run, [''])
-test('tcrun042', normal, compile_fail, [''])
+test('tcrun042', normal, compile, [''])
test('tcrun043', normal, compile_and_run, [''])
test('tcrun044', normal, compile_and_run, [''])
test('tcrun045', normal, compile_fail, [''])
diff --git a/testsuite/tests/typecheck/should_run/tcrun035.hs b/testsuite/tests/typecheck/should_run/tcrun035.hs
index ee9f27bb7b..9106557ede 100644
--- a/testsuite/tests/typecheck/should_run/tcrun035.hs
+++ b/testsuite/tests/typecheck/should_run/tcrun035.hs
@@ -6,11 +6,15 @@
-- Now it breaks the impredicativity story
-- (id {a}) . (id {a}) :: a -> a
-- And (forall m. Monad m => m a) /~ IO a
+--
+-- Apr 20: with simple subsumption this fails. So I
+-- I eta-expanded foo, but leaving the (id . id)
+-- composition.
module Main(main) where
foo :: (forall m. Monad m => m a) -> IO a
-foo = id . id
+foo x = (id . id) x
main :: IO ()
main = foo (return ())
diff --git a/testsuite/tests/typecheck/should_run/tcrun042.hs b/testsuite/tests/typecheck/should_run/tcrun042.hs
index 3b51d36c22..ba809a16ba 100644
--- a/testsuite/tests/typecheck/should_run/tcrun042.hs
+++ b/testsuite/tests/typecheck/should_run/tcrun042.hs
@@ -5,6 +5,8 @@
-- failing, which is OK. We don't really support impredicative
-- polymorphism!
--
+-- Apr 20: Works again. NB: the ImpredicativeTypes flag
+--
-- The test was added by Max in 5e8ff849, apparently to test tuple sections
module Main where
diff --git a/testsuite/tests/typecheck/should_run/tcrun042.stderr b/testsuite/tests/typecheck/should_run/tcrun042.stderr
deleted file mode 100644
index 52d9b29693..0000000000
--- a/testsuite/tests/typecheck/should_run/tcrun042.stderr
+++ /dev/null
@@ -1,6 +0,0 @@
-
-tcrun042.hs:13:5: error:
- • Couldn't match expected type ‘forall c. c -> c -> c’
- with actual type ‘b0 -> b0 -> b0’
- • In the expression: (, "Hello" ++ "World",)
- In an equation for ‘e’: e = (, "Hello" ++ "World",)
diff --git a/testsuite/tests/warnings/should_fail/CaretDiagnostics1.stderr b/testsuite/tests/warnings/should_fail/CaretDiagnostics1.stderr
index 6d02807207..aa02b8655a 100644
--- a/testsuite/tests/warnings/should_fail/CaretDiagnostics1.stderr
+++ b/testsuite/tests/warnings/should_fail/CaretDiagnostics1.stderr
@@ -18,8 +18,8 @@ CaretDiagnostics1.hs:(5,3)-(7,16): error:
CaretDiagnostics1.hs:8:3-45: error:
• Couldn't match type ‘[Char]’ with ‘()’
- Expected type: IO ()
- Actual type: IO [Char]
+ Expected: IO ()
+ Actual: IO String
• In a stmt of a 'do' block: pure ("this is not an IO" + ())
In the expression:
do 10000000000000000000000000000000000000 + 2 + (3 :: Int)
@@ -35,7 +35,9 @@ CaretDiagnostics1.hs:8:3-45: error:
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
CaretDiagnostics1.hs:8:31-44: error:
- • Couldn't match expected type ‘[Char]’ with actual type ‘()’
+ • Couldn't match type ‘()’ with ‘[Char]’
+ Expected: String
+ Actual: ()
• In the second argument of ‘(+)’, namely ‘()’
In the first argument of ‘pure’, namely
‘("this is not an IO" + ())’
@@ -45,7 +47,10 @@ CaretDiagnostics1.hs:8:31-44: error:
| ^^^^^^^^^^^^^^
CaretDiagnostics1.hs:13:7-11: error:
- • Couldn't match expected type ‘a1 -> a1’ with actual type ‘[Char]’
+ • Couldn't match type: a1 -> a1
+ with: [Char]
+ Expected: a1 -> a1
+ Actual: String
• In the pattern: "γηξ"
In a case alternative: "γηξ" -> () '0'
In the expression: case id of { "γηξ" -> () '0' }
diff --git a/utils/haddock b/utils/haddock
-Subproject 60c85324ae083e2ac3d6180c0f20db5cdb31168
+Subproject 792b82861a8abd03579a281dfdcbbb708166899