[commit: ghc] wip/type-app: Preserve yet more synonyms (720b6eb)
git at git.haskell.org
git at git.haskell.org
Fri Aug 7 12:06:35 UTC 2015
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/type-app
Link : http://ghc.haskell.org/trac/ghc/changeset/720b6ebc64aa56dae7dc5528f63aee849c82832a/ghc
>---------------------------------------------------------------
commit 720b6ebc64aa56dae7dc5528f63aee849c82832a
Author: Richard Eisenberg <eir at cis.upenn.edu>
Date: Wed Aug 5 08:16:58 2015 -0400
Preserve yet more synonyms
>---------------------------------------------------------------
720b6ebc64aa56dae7dc5528f63aee849c82832a
compiler/typecheck/TcUnify.hs | 2 +-
.../tests/typecheck/should_fail/tcfail068.stderr | 112 +++++++++++++--------
2 files changed, 72 insertions(+), 42 deletions(-)
diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs
index 764bb6a..7bee699 100644
--- a/compiler/typecheck/TcUnify.hs
+++ b/compiler/typecheck/TcUnify.hs
@@ -725,7 +725,7 @@ tc_sub_type_ds eq_orig inst_orig ctxt ty_actual ty_expected
-- polymorphic. So instantiate away. This is needed for e.g. test
-- typecheck/should_compile/T4284.
| otherwise
- -> do { (wrap, rho_a) <- deeplyInstantiate inst_orig ty_a
+ -> do { (wrap, rho_a) <- deeplyInstantiate inst_orig ty_actual
; cow <- uType eq_orig rho_a ty_expected
; return (coToHsWrapper cow <.> wrap) } }
diff --git a/testsuite/tests/typecheck/should_fail/tcfail068.stderr b/testsuite/tests/typecheck/should_fail/tcfail068.stderr
index d7c8ed7..1cb2b7f 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail068.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail068.stderr
@@ -1,13 +1,13 @@
-tcfail068.hs:14:9:
+tcfail068.hs:14:9: error:
Couldn't match type ‘s1’ with ‘s’
- ‘s1’ is a rigid type variable bound by
- a type expected by the context: ST s1 (IndTree s a)
- at tcfail068.hs:13:9
- ‘s’ is a rigid type variable bound by
- the type signature for:
- itgen :: Constructed a => (Int, Int) -> a -> IndTree s a
- at tcfail068.hs:11:10
+ ‘s1’ is a rigid type variable bound by
+ a type expected by the context: ST s1 (IndTree s a)
+ at tcfail068.hs:13:9
+ ‘s’ is a rigid type variable bound by
+ the type signature for:
+ itgen :: Constructed a => (Int, Int) -> a -> IndTree s a
+ at tcfail068.hs:11:10
Expected type: ST s1 (IndTree s a)
Actual type: ST s1 (STArray s1 (Int, Int) a)
Relevant bindings include
@@ -16,17 +16,19 @@ tcfail068.hs:14:9:
In the first argument of ‘runST’, namely
‘(newSTArray ((1, 1), n) x)’
In the expression: runST (newSTArray ((1, 1), n) x)
+ In an equation for ‘itgen’:
+ itgen n x = runST (newSTArray ((1, 1), n) x)
-tcfail068.hs:19:21:
+tcfail068.hs:19:21: error:
Couldn't match type ‘s’ with ‘s1’
- ‘s’ is a rigid type variable bound by
- the type signature for:
- itiap :: Constructed a =>
- (Int, Int) -> (a -> a) -> IndTree s a -> IndTree s a
- at tcfail068.hs:16:10
- ‘s1’ is a rigid type variable bound by
- a type expected by the context: ST s1 (IndTree s a)
- at tcfail068.hs:18:9
+ ‘s’ is a rigid type variable bound by
+ the type signature for:
+ itiap :: Constructed a =>
+ (Int, Int) -> (a -> a) -> IndTree s a -> IndTree s a
+ at tcfail068.hs:16:10
+ ‘s1’ is a rigid type variable bound by
+ a type expected by the context: ST s1 (IndTree s a)
+ at tcfail068.hs:18:9
Expected type: STArray s1 (Int, Int) a
Actual type: IndTree s a
Relevant bindings include
@@ -35,17 +37,20 @@ tcfail068.hs:19:21:
(bound at tcfail068.hs:17:1)
In the first argument of ‘readSTArray’, namely ‘arr’
In the first argument of ‘(>>=)’, namely ‘readSTArray arr i’
+ In the first argument of ‘runST’, namely
+ ‘(readSTArray arr i
+ >>= \ val -> writeSTArray arr i (f val) >> return arr)’
-tcfail068.hs:24:36:
+tcfail068.hs:24:36: error:
Couldn't match type ‘s’ with ‘s1’
- ‘s’ is a rigid type variable bound by
- the type signature for:
- itrap :: Constructed a =>
- ((Int, Int), (Int, Int)) -> (a -> a) -> IndTree s a -> IndTree s a
- at tcfail068.hs:23:10
- ‘s1’ is a rigid type variable bound by
- a type expected by the context: ST s1 (IndTree s a)
- at tcfail068.hs:24:29
+ ‘s’ is a rigid type variable bound by
+ the type signature for:
+ itrap :: Constructed a =>
+ ((Int, Int), (Int, Int)) -> (a -> a) -> IndTree s a -> IndTree s a
+ at tcfail068.hs:23:10
+ ‘s1’ is a rigid type variable bound by
+ a type expected by the context: ST s1 (IndTree s a)
+ at tcfail068.hs:24:29
Expected type: ST s1 (IndTree s a)
Actual type: ST s (IndTree s a)
Relevant bindings include
@@ -59,23 +64,34 @@ tcfail068.hs:24:36:
(bound at tcfail068.hs:24:1)
In the first argument of ‘runST’, namely ‘(itrap' i k)’
In the expression: runST (itrap' i k)
+ In an equation for ‘itrap’:
+ itrap ((i, k), (j, l)) f arr
+ = runST (itrap' i k)
+ where
+ itrap' i k
+ = if k > l then return arr else (itrapsnd i k >> itrap' i (k + 1))
+ itrapsnd i k
+ = if i > j then
+ return arr
+ else
+ (readSTArray arr (i, k) >>= \ val -> ...)
-tcfail068.hs:36:46:
+tcfail068.hs:36:46: error:
Couldn't match type ‘s’ with ‘s1’
- ‘s’ is a rigid type variable bound by
- the type signature for:
- itrapstate :: Constructed b =>
- ((Int, Int), (Int, Int))
- -> (a -> b -> (a, b))
- -> ((Int, Int) -> c -> a)
- -> (a -> c)
- -> c
- -> IndTree s b
- -> (c, IndTree s b)
- at tcfail068.hs:34:15
- ‘s1’ is a rigid type variable bound by
- a type expected by the context: ST s1 (c, IndTree s b)
- at tcfail068.hs:36:40
+ ‘s’ is a rigid type variable bound by
+ the type signature for:
+ itrapstate :: Constructed b =>
+ ((Int, Int), (Int, Int))
+ -> (a -> b -> (a, b))
+ -> ((Int, Int) -> c -> a)
+ -> (a -> c)
+ -> c
+ -> IndTree s b
+ -> (c, IndTree s b)
+ at tcfail068.hs:34:15
+ ‘s1’ is a rigid type variable bound by
+ a type expected by the context: ST s1 (c, IndTree s b)
+ at tcfail068.hs:36:40
Expected type: ST s1 (c, IndTree s b)
Actual type: ST s (c, IndTree s b)
Relevant bindings include
@@ -94,3 +110,17 @@ tcfail068.hs:36:46:
(bound at tcfail068.hs:36:1)
In the first argument of ‘runST’, namely ‘(itrapstate' i k s)’
In the expression: runST (itrapstate' i k s)
+ In an equation for ‘itrapstate’:
+ itrapstate ((i, k), (j, l)) f c d s arr
+ = runST (itrapstate' i k s)
+ where
+ itrapstate' i k s
+ = if k > l then
+ return (s, arr)
+ else
+ (itrapstatesnd i k s >>= \ (s, arr) -> ...)
+ itrapstatesnd i k s
+ = if i > j then
+ return (s, arr)
+ else
+ (readSTArray arr (i, k) >>= \ val -> ...)
More information about the ghc-commits
mailing list