Wibbles from new arrow typechecking code

Refactored to solve Trac #5609

4 files changed, 8 insertions, 26 deletions

diff --git a/testsuite/tests/arrows/should_compile/T5283.hs b/testsuite/tests/arrows/should_compile/T5283.hs
index 9216d3cd67..2878208415 100644
--- a/testsuite/tests/arrows/should_compile/T5283.hs
+++ b/testsuite/tests/arrows/should_compile/T5283.hs
@@ -6,13 +6,13 @@ module T where
 import Prelude
 import Control.Arrow
 
-mapAC :: Arrow arr => Integer -> arr (env, b) c -> arr (env, [b]) [c]  
-mapAC n farr = go 1
+mapAC :: Arrow arr => Int -> arr (env, (b,())) c -> arr (env, ([b],())) [c]  
+mapAC n farr = go 0
   where
-    go i | i == succ n = arr (\(_env, []) -> [])
-         | otherwise = proc ~(env, b : bs) ->
-             do c  <- farr -< (env, b)
-                cs <- go (succ i) -< (env, bs)
+    go i | i == n = arr (\(_env, ([], ())) -> [])
+         | otherwise = proc ~(env, (b : bs, ())) ->
+             do c  <- farr -< (env, (b, ()))
+                cs <- go (i+1) -< (env, (bs, ()))
                 returnA -< c : cs
 
 t :: Arrow arr => arr [a] [a]
diff --git a/testsuite/tests/arrows/should_compile/all.T b/testsuite/tests/arrows/should_compile/all.T
index 0a1e6516ce..5535e63ccc 100644
--- a/testsuite/tests/arrows/should_compile/all.T
+++ b/testsuite/tests/arrows/should_compile/all.T
@@ -3,7 +3,6 @@ setTestOpts(only_compiler_types(['ghc']))
 test('arrowapply1', normal, compile, [''])
 test('arrowapply2', normal, compile, [''])
 test('arrowapply3', normal, compile, [''])
-test('arrowapply4', normal, compile, [''])
 test('arrowapply5', normal, compile, [''])
 test('arrowcase1', normal, compile, [''])
 test('arrowdo1', normal, compile, [''])
diff --git a/testsuite/tests/arrows/should_compile/arrowapply4.hs b/testsuite/tests/arrows/should_compile/arrowapply4.hs
deleted file mode 100644
index af0dac4cee..0000000000
--- a/testsuite/tests/arrows/should_compile/arrowapply4.hs
+++ /dev/null
@@ -1,17 +0,0 @@
-{-# LANGUAGE Arrows #-}
-
-module ShouldCompile where
-
--- example from Sebastian Boldt <Sebastian.Boldt@arcor.de>:
---	(f -< a) b  ===  f -< (a,b)
-
-import Control.Arrow
-
-mshowA :: (Arrow a, Show b) => a (b, String) String
-mshowA = proc (x,s) -> returnA -< s ++ show x ++ s
-
-f :: Arrow a => a Int String
-f = proc x -> (mshowA -< x) "***"
-
-g :: ArrowApply a => a Int String
-g = proc x -> (mshowA -<< x) "***"
diff --git a/testsuite/tests/arrows/should_compile/arrowform1.hs b/testsuite/tests/arrows/should_compile/arrowform1.hs
index a282d71ed7..70b9669ef1 100644
--- a/testsuite/tests/arrows/should_compile/arrowform1.hs
+++ b/testsuite/tests/arrows/should_compile/arrowform1.hs
@@ -4,8 +4,8 @@ module ShouldCompile where
 
 import Control.Arrow
 
-handle :: ArrowPlus a => a b c -> a (b,String) c -> a b c
-handle f h = proc b -> (f -< b) <+> (h -< (b,""))
+handle :: ArrowPlus a => a (b,s) c -> a (b,(String,s)) c -> a (b,s) c
+handle f h = proc (b,s) -> (f -< (b,s)) <+> (h -< (b,("FAIL",s)))
 
 f :: ArrowPlus a => a (Int,Int) String
 f = proc (x,y) ->