diff options
Diffstat (limited to 'testsuite/tests/typecheck/should_compile/tc192.hs')
-rw-r--r-- | testsuite/tests/typecheck/should_compile/tc192.hs | 145 |
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 + + |