diff options
author | Richard Eisenberg <rae@cs.brynmawr.edu> | 2017-12-26 14:23:40 -0500 |
---|---|---|
committer | Richard Eisenberg <rae@cs.brynmawr.edu> | 2017-12-26 14:28:51 -0500 |
commit | 722a6584bb338bc77ad978d14113b3b8e6a45cab (patch) | |
tree | 43890bade684c914ebb0aeb53b9025b75aec47a3 | |
parent | e19b6464cc8ea498775074a680f91d3e5b5636d3 (diff) | |
download | haskell-722a6584bb338bc77ad978d14113b3b8e6a45cab.tar.gz |
Fix #14618 by applying a subst in deeplyInstantiate
Previously, we were inexplicably not applying an instantiating
substitution to arguments in non-prenex types. It's amazing this
has been around for so long! I guess there aren't a lot of non-prenex
types around.
test case: typecheck/should_fail/T14618
-rw-r--r-- | compiler/typecheck/Inst.hs | 7 | ||||
-rw-r--r-- | testsuite/tests/typecheck/should_fail/T14618.hs | 11 | ||||
-rw-r--r-- | testsuite/tests/typecheck/should_fail/T14618.stderr | 23 | ||||
-rw-r--r-- | testsuite/tests/typecheck/should_fail/all.T | 1 |
4 files changed, 39 insertions, 3 deletions
diff --git a/compiler/typecheck/Inst.hs b/compiler/typecheck/Inst.hs index 6d656fefc3..9da96c4cc0 100644 --- a/compiler/typecheck/Inst.hs +++ b/compiler/typecheck/Inst.hs @@ -257,8 +257,9 @@ deeply_instantiate :: CtOrigin deeply_instantiate orig subst ty | Just (arg_tys, tvs, theta, rho) <- tcDeepSplitSigmaTy_maybe ty = do { (subst', tvs') <- newMetaTyVarsX subst tvs - ; ids1 <- newSysLocalIds (fsLit "di") (substTys subst' arg_tys) - ; let theta' = substTheta subst' theta + ; 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 @@ -271,7 +272,7 @@ deeply_instantiate orig subst ty <.> wrap2 <.> wrap1 <.> mkWpEvVarApps ids1, - mkFunTys arg_tys rho2) } + mkFunTys arg_tys' rho2) } | otherwise = do { let ty' = substTy subst ty diff --git a/testsuite/tests/typecheck/should_fail/T14618.hs b/testsuite/tests/typecheck/should_fail/T14618.hs new file mode 100644 index 0000000000..da30d7ad85 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14618.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE RankNTypes #-} + +module T14618 where + +safeCoerce :: a -> b +safeCoerce = f' + where + f :: d -> forall c. d + f x = x + + f' = f diff --git a/testsuite/tests/typecheck/should_fail/T14618.stderr b/testsuite/tests/typecheck/should_fail/T14618.stderr new file mode 100644 index 0000000000..8faa64c25e --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14618.stderr @@ -0,0 +1,23 @@ + +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 + ‘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 + = f' + where + f :: d -> forall c. d + f x = x + f' = f + • Relevant bindings include + safeCoerce :: a -> b (bound at T14618.hs:6:1) diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index 553e10af88..b1a0e757ae 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -462,3 +462,4 @@ test('T14325', normal, compile_fail, ['']) test('T14350', normal, compile_fail, ['']) test('T14390', normal, compile_fail, ['']) test('MissingExportList03', normal, compile_fail, ['']) +test('T14618', normal, compile_fail, ['']) |