Validate inferred theta. Fixes #8883
authorJan Stolarek <jan.stolarek@p.lodz.pl>
Sat, 19 Apr 2014 04:58:07 +0000 (06:58 +0200)
committerJan Stolarek <jan.stolarek@p.lodz.pl>
Sat, 19 Apr 2014 09:20:51 +0000 (11:20 +0200)
This checks that all the required extensions are enabled for the
inferred type signature.

Updates binary and vector submodules.

19 files changed:
compiler/llvmGen/LlvmCodeGen.hs
compiler/nativeGen/RegAlloc/Liveness.hs
compiler/nativeGen/X86/Instr.hs
compiler/typecheck/TcBinds.lhs
compiler/typecheck/TcSMonad.lhs
libraries/binary
libraries/vector
testsuite/tests/indexed-types/should_compile/ColInference6.hs
testsuite/tests/indexed-types/should_compile/IndTypesPerf.hs
testsuite/tests/indexed-types/should_compile/IndTypesPerfMerge.hs
testsuite/tests/perf/should_run/T2902_A.hs
testsuite/tests/perf/should_run/T2902_B.hs
testsuite/tests/perf/should_run/T5113.hs
testsuite/tests/rebindable/DoRestrictedM.hs
testsuite/tests/typecheck/should_compile/tc168.hs
testsuite/tests/typecheck/should_compile/tc231.hs
testsuite/tests/typecheck/should_fail/T8883.hs [new file with mode: 0644]
testsuite/tests/typecheck/should_fail/T8883.stderr [new file with mode: 0644]
testsuite/tests/typecheck/should_fail/tcfail093.hs

index d0f343f..61e7e39 100644 (file)
@@ -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"
index 6dd4cec..b0e763a 100644 (file)
@@ -5,6 +5,7 @@
 -- (c) The University of Glasgow 2004-2013
 --
 -----------------------------------------------------------------------------
+{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
 module RegAlloc.Liveness (
         RegSet,
         RegMap, emptyRegMap,
index 8284270..75e5b9e 100644 (file)
@@ -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,
index d46e441..17f124b 100644 (file)
@@ -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
index b7faf15..51f4945 100644 (file)
@@ -1,5 +1,6 @@
 \begin{code}
 -- Type definitions for the constraint solver
+{-# LANGUAGE TypeFamilies #-}
 module TcSMonad (
 
        -- Canonical constraints, definition is now in TcRnTypes
index 2799c25..2647d42 160000 (submodule)
@@ -1 +1 @@
-Subproject commit 2799c25d85b4627200f2e4dcb30d2128488780c3
+Subproject commit 2647d42f19bedae46c020fc3af029073f5690d5b
index 9baab44..a6049ab 160000 (submodule)
@@ -1 +1 @@
-Subproject commit 9baab444a57c4a225ee247fea27187d1892d90bf
+Subproject commit a6049abce040713e9a5f175887cf70d12b9057c6
index 9273632..bc15aa1 100644 (file)
@@ -1,4 +1,4 @@
-{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeFamilies, FlexibleContexts #-}
 
 module ColInference6  where 
 
index 4edcd03..30c92c3 100644 (file)
@@ -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
index 18ed35b..dbba60d 100644 (file)
@@ -1,7 +1,7 @@
 {-# LANGUAGE EmptyDataDecls, TypeFamilies, UndecidableInstances,
              ScopedTypeVariables, OverlappingInstances, TypeOperators,
              FlexibleInstances, NoMonomorphismRestriction,
-             MultiParamTypeClasses #-}
+             MultiParamTypeClasses, FlexibleContexts #-}
 module IndTypesPerfMerge where
 
 data a :* b = a :* b
index c093910..cb2cec9 100644 (file)
@@ -1,5 +1,5 @@
 
-{-# LANGUAGE UnicodeSyntax #-}
+{-# LANGUAGE UnicodeSyntax, FlexibleContexts #-}
 
 module Main (main) where
 
index c6558c6..65cb1a6 100644 (file)
@@ -1,5 +1,5 @@
 
-{-# LANGUAGE UnicodeSyntax #-}
+{-# LANGUAGE UnicodeSyntax, FlexibleContexts #-}
 
 module Main (main) where
 
index e87bcb6..6ad6750 100644 (file)
@@ -1,4 +1,4 @@
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE BangPatterns, FlexibleContexts #-}
 module Main where
 
 import Data.Array.Base (unsafeRead, unsafeWrite)
index dea2b1e..2e982c1 100644 (file)
@@ -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,
index 0aa56d1..bd51533 100644 (file)
@@ -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
index 3047489..a7270ef 100644 (file)
@@ -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 (file)
index 0000000..5b0fc59
--- /dev/null
@@ -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 (file)
index 0000000..0ea1368
--- /dev/null
@@ -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’
index 9c2d8ea..1f2063a 100644 (file)
@@ -1,5 +1,5 @@
 {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,
-             FlexibleInstances, UndecidableInstances #-}
+             FlexibleInstances, UndecidableInstances, FlexibleContexts #-}
 -- UndecidableInstances now needed because the Coverage Condition fails
 
 module ShouldFail where