
I have a quick question on the current (GHCi, version 7.4.0.20111219) implementation of arrow notation. Consider the code below: ---- {-# LANGUAGE Arrows,Rank2Types #-} import Control.Arrow -- cmdcomb :: Arrow a => (a (env,x) x) -> a (env,x) x -- cmdcomb aegg = aegg cmdcomb :: Arrow a => (forall x . a (env,x) x) -> a (env,x) x cmdcomb aegg = aegg myarr :: Arrow a => a (Int,Bool) Bool myarr = proc (i,b) -> do (|cmdcomb (\g -> returnA -< g) |) 'x' -- (| (cmdcomb (arr snd)) |) 'x' returnA -< False ---- This code generates the error below (but using either of the commented sections instead gets it to typecheck): ../MyDev/FPF3/saturday/dm.hs:13:13: Couldn't match expected type `t0 t1 t2' with actual type `forall x. a0 (env0, x) x' Expected type: t0 t1 t2 -> a (a1, t4) t3 Actual type: (forall x. a0 (env0, x) x) -> a0 (env0, x0) x0 In the expression: cmdcomb In the expression: proc (i, b) -> do { (|cmdcomb ((\ g -> returnA -< g))|) 'x'; returnA -< False } Failed, modules loaded: none. Is this a bug or a limitation in the current implementation? --Ben