summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRichard Eisenberg <rae@cs.brynmawr.edu>2017-12-26 14:23:40 -0500
committerRichard Eisenberg <rae@cs.brynmawr.edu>2017-12-26 14:28:51 -0500
commit722a6584bb338bc77ad978d14113b3b8e6a45cab (patch)
tree43890bade684c914ebb0aeb53b9025b75aec47a3
parente19b6464cc8ea498775074a680f91d3e5b5636d3 (diff)
downloadhaskell-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.hs7
-rw-r--r--testsuite/tests/typecheck/should_fail/T14618.hs11
-rw-r--r--testsuite/tests/typecheck/should_fail/T14618.stderr23
-rw-r--r--testsuite/tests/typecheck/should_fail/all.T1
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, [''])