1 files changed, 145 insertions, 0 deletions
diff --git a/testsuite/tests/typecheck/should_compile/tc192.hs b/testsuite/tests/typecheck/should_compile/tc192.hs
new file mode 100644
index 0000000000..3337954ade
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/tc192.hs
@@ -0,0 +1,145 @@
+{-# LANGUAGE Arrows, CPP, TypeOperators #-}
+
+-- Test infix type notation and arrow notation
+
+module Test where
+
+import Prelude hiding (id,(.))
+import Control.Category
+import Control.Arrow
+
+-- For readability, I use infix notation for arrow types.  I'd prefer the
+-- following, but GHC doesn't allow operators like "-=>" as type
+-- variables.
+-- 
+-- comp1 :: Arrow (-=>) => b-=>c -> c-=>d -> b-=>d
+
+
+comp1 :: Arrow (~>) => b~>c -> c~>d -> b~>d
+comp1 f g = proc x -> do
+            b <- f -< x
+            g -< b
+
+-- arrowp produces
+-- comp1 f g = (f >>> g)
+
+comp :: Arrow (~>) => (b~>c, c~>d)~>(b~>d)
+comp = arr (uncurry (>>>))
+
+-- app :: Arrow (~>) => (b c, b)~>c
+
+type R = Float
+type I = Int
+
+z1,z2 :: Arrow (~>) => I~>(R~>R)
+z1 = undefined 
+z2 = z1
+
+z3 :: Arrow (~>) => (I,I)~>(R~>R,R~>R)
+z3 = z1 *** z2
+
+z4 :: Arrow (~>) => (I,I)~>(R~>R)
+z4 = z3 >>> comp
+
+comp4,comp5 :: Arrow (~>) =>
+  b~>(c~>d) -> e~>(d~>f) -> (b,e)~>(c~>f)
+
+comp4 g f = proc (b,e) -> do
+            g' <- g -< b
+            f' <- f -< e
+            returnA -< (g' >>> f')
+
+comp5 g f = (g *** f) >>> comp
+
+lam,lam2 :: Arrow (~>) => (e,b)~>c -> e~>(b~>c)
+
+lam f = arr $ \ e -> arr (pair e) >>> f
+
+pair a b = (a,b)
+
+-- I got the definition lam above by starting with
+
+lam2 f = proc e ->
+         returnA -< (proc b -> do
+                     c <- f -< (e,b)
+                     returnA -< c)
+
+-- I desugared with  the arrows preprocessor, removed extra parens and
+-- renamed "arr" (~>) "pure", (~>) get
+-- 
+--  lam f = pure (\ e -> pure (\ b -> (e, b)) >>> f)
+
+-- Note that lam is arrow curry
+
+-- curry :: ((e,b) -> c) -> (e -> b -> c)
+
+-- All equivalent:
+
+curry1 f e b = f (e,b)
+
+curry2 f = \ e -> \ b -> f (e,b)
+
+curry3 f = \ e -> f . (\ b -> (e,b))
+
+curry4 f = \ e -> f . (pair e)
+
+
+
+comp6 :: Arrow (~>) => b~>(c~>d) -> e~>(d~>f)
+                  -> b~>(e~>(c~>f))
+comp6 g f = lam $ comp5 g f 
+
+-- What about uncurrying?
+
+-- uncurryA :: Arrow (~>) => b~>(c~>d)
+--                     -> (b,c)~>d
+-- uncurryA f = proc (b,c) -> do
+--              f' <- f -< b
+--              returnA -< f' c
+
+-- Why "lam" instead of "curryA" (good name also): so I can use Arrows
+-- lambda notation, similar (~>)
+
+compF g f = \ b e -> g b . f e
+
+-- But I haven't figured out how (~>).
+
+-- comp7 :: Arrow (~>) => b~>(c~>d) -> e~>(d~>f)
+--                   -> b~>(e~>(c~>f))
+-- comp7 g f = proc b -> proc e -> do
+--             g' <- g -< b
+--             f' <- f -< e
+--             returnA -< (g' >>> f')
+
+-- Try "(| lam \ b -> ... |)" in the FOP arrows chapter
+-- cmd ::= form exp cmd1 ... cmdn.  Parens if nec
+
+-- (| lam (\ b -> undefined) |)
+
+-- Oh!  The arrow syntax allows bindings with *infix* operators.  And I
+-- don't know how (~>) finish comp7.
+
+-- Uncurried forms:
+
+comp8 :: Arrow (~>) => (b,c)~>d -> (e,d)~>k -> (b,c,e)~>k
+comp8 g f = proc (b,c,e) -> do
+            d <- g -< (b,c)
+            f -< (e,d)
+
+-- This looks like straightforward~>translation.  With insertions of
+-- curry & uncurry operators, it'd probably be easy (~>) handle curried
+-- definitions as well.
+
+-- Simpler example, for experimentation
+
+comp9 :: Arrow (~>) => (c,d)~>e -> b~>d -> (b,c)~>e
+comp9 g f = proc (b,c) -> do
+            d <- f -< b
+            g -< (c,d)
+ 
+-- Desugared:
+
+comp9' :: Arrow (~>) => (c,d)~>e -> b~>d -> (b,c)~>e
+comp9' g f = first f >>> arr (\ (d,c) -> (c,d)) >>> g
+
+