1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
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
|
