Commit 398c3d02 authored by Simon Peyton Jones's avatar Simon Peyton Jones

Wibbles from new arrow typechecking code

Refactored to solve Trac #5609
parent 69db014b
......@@ -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, [''])
......
{-# 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) ->
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment