Permalink
Browse files

Wibbles from new arrow typechecking code

Refactored to solve Trac #5609
  • Loading branch information...
1 parent 7e08249 commit 3458e253105142e96c94bf95c9807b60a05dec75 @simonpj simonpj committed Mar 4, 2013
@@ -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]
@@ -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, [''])
@@ -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) "***"
@@ -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) ->

0 comments on commit 3458e25

Please sign in to comment.