diff options
author | Jan Stolarek <jan.stolarek@p.lodz.pl> | 2014-04-19 06:58:07 +0200 |
---|---|---|
committer | Jan Stolarek <jan.stolarek@p.lodz.pl> | 2014-04-19 11:20:51 +0200 |
commit | 1d2ffb6ab1ef973c85f893b5ea4a72cfa59ce484 (patch) | |
tree | 5f698d69fe2383300f51e71e824e86dad6cc8508 | |
parent | 41f5b7e3e0648302b9c5dc485917a391d21d15a1 (diff) | |
download | haskell-1d2ffb6ab1ef973c85f893b5ea4a72cfa59ce484.tar.gz |
Validate inferred theta. Fixes #8883
This checks that all the required extensions are enabled for the
inferred type signature.
Updates binary and vector submodules.
19 files changed, 47 insertions, 9 deletions
diff --git a/compiler/llvmGen/LlvmCodeGen.hs b/compiler/llvmGen/LlvmCodeGen.hs index d0f343fa92..61e7e39a49 100644 --- a/compiler/llvmGen/LlvmCodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen.hs @@ -2,6 +2,7 @@ -- | This is the top-level module in the LLVM code generator. -- +{-# LANGUAGE TypeFamilies #-} module LlvmCodeGen ( llvmCodeGen, llvmFixupAsm ) where #include "HsVersions.h" diff --git a/compiler/nativeGen/RegAlloc/Liveness.hs b/compiler/nativeGen/RegAlloc/Liveness.hs index 6dd4cec0de..b0e763a6f0 100644 --- a/compiler/nativeGen/RegAlloc/Liveness.hs +++ b/compiler/nativeGen/RegAlloc/Liveness.hs @@ -5,6 +5,7 @@ -- (c) The University of Glasgow 2004-2013 -- ----------------------------------------------------------------------------- +{-# LANGUAGE FlexibleContexts, TypeFamilies #-} module RegAlloc.Liveness ( RegSet, RegMap, emptyRegMap, diff --git a/compiler/nativeGen/X86/Instr.hs b/compiler/nativeGen/X86/Instr.hs index 8284270be1..75e5b9e737 100644 --- a/compiler/nativeGen/X86/Instr.hs +++ b/compiler/nativeGen/X86/Instr.hs @@ -9,6 +9,7 @@ #include "HsVersions.h" #include "nativeGen/NCG.h" +{-# LANGUAGE TypeFamilies #-} module X86.Instr (Instr(..), Operand(..), PrefetchVariant(..), JumpDest, getJumpDestBlockId, canShortcut, shortcutStatics, shortcutJump, i386_insert_ffrees, allocMoreStack, diff --git a/compiler/typecheck/TcBinds.lhs b/compiler/typecheck/TcBinds.lhs index d46e441130..17f124b0d8 100644 --- a/compiler/typecheck/TcBinds.lhs +++ b/compiler/typecheck/TcBinds.lhs @@ -54,6 +54,7 @@ import FastString import Type(mkStrLitTy) import Class(classTyCon) import PrelNames(ipClassName) +import TcValidity (checkValidTheta) import Control.Monad @@ -562,6 +563,10 @@ tcPolyInfer rec_tc prag_fn tc_sig_fn mono closed bind_list simplifyInfer closed mono name_taus wanted ; theta <- zonkTcThetaType (map evVarPred givens) + -- We need to check inferred theta for validity. The reason is that we + -- might have inferred theta that requires language extension that is + -- not turned on. See #8883. Example can be found in the T8883 testcase. + ; checkValidTheta (InfSigCtxt (fst . head $ name_taus)) theta ; exports <- checkNoErrs $ mapM (mkExport prag_fn qtvs theta) mono_infos ; loc <- getSrcSpanM diff --git a/compiler/typecheck/TcSMonad.lhs b/compiler/typecheck/TcSMonad.lhs index b7faf153ca..51f4945564 100644 --- a/compiler/typecheck/TcSMonad.lhs +++ b/compiler/typecheck/TcSMonad.lhs @@ -1,5 +1,6 @@ \begin{code} -- Type definitions for the constraint solver +{-# LANGUAGE TypeFamilies #-} module TcSMonad ( -- Canonical constraints, definition is now in TcRnTypes diff --git a/libraries/binary b/libraries/binary -Subproject 2799c25d85b4627200f2e4dcb30d2128488780c +Subproject 2647d42f19bedae46c020fc3af029073f5690d5 diff --git a/libraries/vector b/libraries/vector -Subproject 9baab444a57c4a225ee247fea27187d1892d90b +Subproject a6049abce040713e9a5f175887cf70d12b9057c diff --git a/testsuite/tests/indexed-types/should_compile/ColInference6.hs b/testsuite/tests/indexed-types/should_compile/ColInference6.hs index 9273632e2b..bc15aa1dbf 100644 --- a/testsuite/tests/indexed-types/should_compile/ColInference6.hs +++ b/testsuite/tests/indexed-types/should_compile/ColInference6.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeFamilies, FlexibleContexts #-} module ColInference6 where diff --git a/testsuite/tests/indexed-types/should_compile/IndTypesPerf.hs b/testsuite/tests/indexed-types/should_compile/IndTypesPerf.hs index 4edcd03988..30c92c3a88 100644 --- a/testsuite/tests/indexed-types/should_compile/IndTypesPerf.hs +++ b/testsuite/tests/indexed-types/should_compile/IndTypesPerf.hs @@ -2,6 +2,8 @@ -- This used lots of memory, and took a long time to compile, with GHC 6.12: -- http://www.haskell.org/pipermail/glasgow-haskell-users/2010-May/018835.html +{-# LANGUAGE FlexibleContexts, TypeFamilies #-} + module IndTypesPerf where import IndTypesPerfMerge diff --git a/testsuite/tests/indexed-types/should_compile/IndTypesPerfMerge.hs b/testsuite/tests/indexed-types/should_compile/IndTypesPerfMerge.hs index 18ed35bdc1..dbba60d595 100644 --- a/testsuite/tests/indexed-types/should_compile/IndTypesPerfMerge.hs +++ b/testsuite/tests/indexed-types/should_compile/IndTypesPerfMerge.hs @@ -1,7 +1,7 @@ {-# LANGUAGE EmptyDataDecls, TypeFamilies, UndecidableInstances, ScopedTypeVariables, OverlappingInstances, TypeOperators, FlexibleInstances, NoMonomorphismRestriction, - MultiParamTypeClasses #-} + MultiParamTypeClasses, FlexibleContexts #-} module IndTypesPerfMerge where data a :* b = a :* b diff --git a/testsuite/tests/perf/should_run/T2902_A.hs b/testsuite/tests/perf/should_run/T2902_A.hs index c0939104f3..cb2cec990c 100644 --- a/testsuite/tests/perf/should_run/T2902_A.hs +++ b/testsuite/tests/perf/should_run/T2902_A.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE UnicodeSyntax #-} +{-# LANGUAGE UnicodeSyntax, FlexibleContexts #-} module Main (main) where diff --git a/testsuite/tests/perf/should_run/T2902_B.hs b/testsuite/tests/perf/should_run/T2902_B.hs index c6558c625b..65cb1a6a90 100644 --- a/testsuite/tests/perf/should_run/T2902_B.hs +++ b/testsuite/tests/perf/should_run/T2902_B.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE UnicodeSyntax #-} +{-# LANGUAGE UnicodeSyntax, FlexibleContexts #-} module Main (main) where diff --git a/testsuite/tests/perf/should_run/T5113.hs b/testsuite/tests/perf/should_run/T5113.hs index e87bcb6cad..6ad6750aab 100644 --- a/testsuite/tests/perf/should_run/T5113.hs +++ b/testsuite/tests/perf/should_run/T5113.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE BangPatterns, FlexibleContexts #-} module Main where import Data.Array.Base (unsafeRead, unsafeWrite) diff --git a/testsuite/tests/rebindable/DoRestrictedM.hs b/testsuite/tests/rebindable/DoRestrictedM.hs index dea2b1ea03..2e982c1532 100644 --- a/testsuite/tests/rebindable/DoRestrictedM.hs +++ b/testsuite/tests/rebindable/DoRestrictedM.hs @@ -1,5 +1,5 @@ {-# LANGUAGE RebindableSyntax, MultiParamTypeClasses, - FlexibleInstances #-} + FlexibleInstances, FlexibleContexts #-} -- Tests of the do-notation for the restricted monads -- We demonstrate that all ordinary monads are restricted monads, diff --git a/testsuite/tests/typecheck/should_compile/tc168.hs b/testsuite/tests/typecheck/should_compile/tc168.hs index 0aa56d169a..bd515331c4 100644 --- a/testsuite/tests/typecheck/should_compile/tc168.hs +++ b/testsuite/tests/typecheck/should_compile/tc168.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts #-} -- We want to get the type -- g :: forall a b c. C a (b,c) => a -> b diff --git a/testsuite/tests/typecheck/should_compile/tc231.hs b/testsuite/tests/typecheck/should_compile/tc231.hs index 304748994b..a7270ef769 100644 --- a/testsuite/tests/typecheck/should_compile/tc231.hs +++ b/testsuite/tests/typecheck/should_compile/tc231.hs @@ -1,5 +1,5 @@ {-# OPTIONS_GHC -ddump-types #-} -{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-} +{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleContexts #-} -- See Trac #1456 diff --git a/testsuite/tests/typecheck/should_fail/T8883.hs b/testsuite/tests/typecheck/should_fail/T8883.hs new file mode 100644 index 0000000000..5b0fc5922c --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T8883.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE TypeFamilies #-} + +-- Trac #8883 + +module T8883 where + +type family PF a :: * -> * + +class Regular a where + from :: a -> PF a a + +-- For fold we infer following type signature: +-- +-- fold :: (Functor (PF a), Regular a) => (PF a b -> b) -> a -> b +-- +-- However, this signature requires FlexibleContexts since the first +-- type-class constraint is not of the form (class type-variable) nor +-- (class (type-variable type1 type2 ... typen)). Since this extension +-- is not enabled compilation should fail. +fold f = f . fmap (fold f) . from diff --git a/testsuite/tests/typecheck/should_fail/T8883.stderr b/testsuite/tests/typecheck/should_fail/T8883.stderr new file mode 100644 index 0000000000..0ea136869b --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T8883.stderr @@ -0,0 +1,7 @@ + + +T8883.hs:17:1: + Non type-variable argument in the constraint: Functor (PF a) + (Use FlexibleContexts to permit this) + In the context: (Regular a, Functor (PF a)) + While checking the inferred type for ‘fold’ diff --git a/testsuite/tests/typecheck/should_fail/tcfail093.hs b/testsuite/tests/typecheck/should_fail/tcfail093.hs index 9c2d8ea80a..1f2063a1c2 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail093.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail093.hs @@ -1,5 +1,5 @@ {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, - FlexibleInstances, UndecidableInstances #-} + FlexibleInstances, UndecidableInstances, FlexibleContexts #-} -- UndecidableInstances now needed because the Coverage Condition fails module ShouldFail where |