1 import "JavaBuiltin" as Java
\r
3 main = foldl Java.iadd (0 :: Integer) (concat (concat (Single (1 :: Integer))
\r
4 (Single (2 :: Integer))) (Single (3 :: Integer)))
\r
6 data Digit a = Digit1 a
\r
10 data Node a = Node2 a a | Node3 a a a
\r
11 data FingerTree a = Empty | Single a | Deep (Digit a) (FingerTree (Node a)) (Digit a)
\r
13 insertL :: a -> FingerTree a -> FingerTree a
\r
14 insertL a Empty = Single a
\r
15 insertL a (Single b) = Deep (Digit1 a) Empty (Digit1 b)
\r
16 insertL a (Deep (Digit1 b) m r) = Deep (Digit2 a b) m r
\r
17 insertL a (Deep (Digit2 b c) m r) = Deep (Digit3 a b c) m r
\r
18 insertL a (Deep (Digit3 b c d) m r) = Deep (Digit4 a b c d) m r
\r
19 insertL a (Deep (Digit4 b c d e) m r) = Deep (Digit2 a b) (insertL (Node3 c d e) m) r
\r
21 insertR :: FingerTree a -> a -> FingerTree a
\r
22 insertR Empty a = Single a
\r
23 insertR (Single a) b = Deep (Digit1 a) Empty (Digit1 b)
\r
24 insertR (Deep l m (Digit1 a)) b = Deep l m (Digit2 a b)
\r
25 insertR (Deep l m (Digit2 a b)) c = Deep l m (Digit3 a b c)
\r
26 insertR (Deep l m (Digit3 a b c)) d = Deep l m (Digit4 a b c d)
\r
27 insertR (Deep l m (Digit4 a b c d)) e = Deep l (insertR m (Node3 a b c)) (Digit2 d e)
\r
29 foldl :: (a -> b -> a) -> a -> FingerTree b -> a
\r
30 foldl f init Empty = init
\r
31 foldl f init (Single x) = f init x
\r
32 foldl f init (Deep l m r) = foldlD (foldl foldlN (foldlD init l) m) r
\r
34 foldlD init (Digit1 a) = f init a
\r
35 foldlD init (Digit2 a b) = f (f init a) b
\r
36 foldlD init (Digit3 a b c) = f (f (f init a) b) c
\r
37 foldlD init (Digit4 a b c d) = f (f (f (f init a) b) c) d
\r
39 foldlN init (Node2 a b) = f (f init a) b
\r
40 foldlN init (Node3 a b c) = f (f (f init a) b) c
\r
42 data View a = Nil | Cons a (FingerTree a)
\r
44 viewL :: FingerTree a -> View a
\r
46 viewL (Single a) = Cons a Empty
\r
47 viewL (Deep (Digit1 a) m r) = Cons a tail
\r
49 tail = match viewL m with
\r
50 Nil -> digitToFingerTree r
\r
51 Cons h t -> Deep (nodeToDigit h) t r
\r
52 viewL (Deep (Digit2 a b) m r) = Cons a (Deep (Digit1 a) m r)
\r
53 viewL (Deep (Digit3 a b c) m r) = Cons a (Deep (Digit2 a b) m r)
\r
54 viewL (Deep (Digit4 a b c d) m r) = Cons a (Deep (Digit3 a b c) m r)
\r
56 concat :: FingerTree a -> FingerTree a -> FingerTree a
\r
59 concat (Single a) b = insertL a b
\r
60 concat a (Single b) = insertR a b
\r
61 concat (Deep l1 m1 r1) (Deep l2 m2 r2) = Deep l1 mm r2
\r
63 mm = concatAux m1 (digitsToNodes r1 l2) m2
\r
65 // --- Implementation details -------------------------------------------------
\r
67 digitToFingerTree :: Digit a -> FingerTree a
\r
68 digitToFingerTree (Digit1 a) = Single a
\r
69 digitToFingerTree (Digit2 a b) = Deep (Digit1 a) Empty (Digit1 b)
\r
70 digitToFingerTree (Digit3 a b c) = Deep (Digit2 a b) Empty (Digit1 c)
\r
71 digitToFingerTree (Digit4 a b c d) = Deep (Digit2 a b) Empty (Digit2 c d)
\r
73 nodeToDigit :: Node a -> Digit a
\r
74 nodeToDigit (Node2 a b) = Digit2 a b
\r
75 nodeToDigit (Node3 a b c) = Digit3 a b c
\r
77 concatAux :: FingerTree a -> Digit a -> FingerTree a -> FingerTree a
\r
78 concatAux Empty ds a = insertLD ds a
\r
79 concatAux a ds Empty = insertRD a ds
\r
80 concatAux (Single a) ds b = insertL a (insertLD ds b)
\r
81 concatAux a ds (Single b) = insertR (insertRD a ds) b
\r
82 concatAux (Deep l1 m1 r1) ds (Deep l2 m2 r2) = Deep l1 mm r2
\r
84 mm = concatAux m1 (digitsToNodes3 r1 ds r2) m2
\r
86 insertLD :: Digit a -> FingerTree a -> FingerTree a
\r
87 insertLD (Digit1 a) t = insertL a t
\r
88 insertLD (Digit2 a b) t = insertL a (insertL b t)
\r
89 insertLD (Digit3 a b c) t = insertL a (insertL b (insertL c t))
\r
90 insertLD (Digit4 a b c d) t = insertL a (insertL b (insertL c (insertL d t)))
\r
92 insertRD :: FingerTree a -> Digit a -> FingerTree a
\r
93 insertRD t (Digit1 a) = insertR t a
\r
94 insertRD t (Digit2 a b) = insertR (insertR t a) b
\r
95 insertRD t (Digit3 a b c) = insertR (insertR (insertR t a) b) c
\r
96 insertRD t (Digit4 a b c d) = insertR (insertR (insertR (insertR t a) b) c) d
\r
98 digitsToNodes :: Digit a -> Digit a -> Digit (Node a)
\r
99 digitsToNodes (Digit1 a) x = dd1 a x
\r
100 digitsToNodes (Digit2 a b) x = dd2 a b x
\r
101 digitsToNodes (Digit3 a b c) x = dd3 a b c x
\r
102 digitsToNodes (Digit4 a b c d) x = dd4 a b c d x
\r
104 digitsToNodes3 :: Digit a -> Digit a -> Digit a -> Digit (Node a)
\r
105 digitsToNodes3 (Digit1 a) x y = ddd1 a x y
\r
106 digitsToNodes3 (Digit2 a b) x y = ddd2 a b x y
\r
107 digitsToNodes3 (Digit3 a b c) x y = ddd3 a b c x y
\r
108 digitsToNodes3 (Digit4 a b c d) x y = ddd4 a b c d x y
\r
110 d2 a b = Digit1 (Node2 a b)
\r
111 d3 a b c = Digit1 (Node3 a b c)
\r
112 d4 a b c d = Digit2 (Node2 a b) (Node2 c d)
\r
113 d5 a b c d e = Digit2 (Node3 a b c) (Node2 d e)
\r
114 d6 a b c d e f = Digit2 (Node3 a b c) (Node3 d e f)
\r
115 d7 a b c d e f g = Digit3 (Node3 a b c) (Node2 d e) (Node2 f g)
\r
116 d8 a b c d e f g h = Digit3 (Node3 a b c) (Node3 d e f) (Node2 g h)
\r
117 d9 a b c d e f g h i = Digit3 (Node3 a b c) (Node3 d e f) (Node3 g h i)
\r
118 d10 a b c d e f g h i j = Digit4 (Node3 a b c) (Node3 d e f) (Node2 g h) (Node2 i j)
\r
119 d11 a b c d e f g h i j k = Digit4 (Node3 a b c) (Node3 d e f) (Node3 g h i) (Node2 j k)
\r
120 d12 a b c d e f g h i j k l = Digit4 (Node3 a b c) (Node3 d e f) (Node3 g h i) (Node3 j k l)
\r
122 dd1 a (Digit1 b) = d2 a b
\r
123 dd1 a (Digit2 b c) = d3 a b c
\r
124 dd1 a (Digit3 b c d) = d4 a b c d
\r
125 dd1 a (Digit4 b c d e) = d5 a b c d e
\r
126 dd2 a b (Digit1 c) = d3 a b c
\r
127 dd2 a b (Digit2 c d) = d4 a b c d
\r
128 dd2 a b (Digit3 c d e) = d5 a b c d e
\r
129 dd2 a b (Digit4 c d e f) = d6 a b c d e f
\r
130 dd3 a b c (Digit1 d) = d4 a b c d
\r
131 dd3 a b c (Digit2 d e) = d5 a b c d e
\r
132 dd3 a b c (Digit3 d e f) = d6 a b c d e f
\r
133 dd3 a b c (Digit4 d e f g) = d7 a b c d e f g
\r
134 dd4 a b c d (Digit1 e) = d5 a b c d e
\r
135 dd4 a b c d (Digit2 e f) = d6 a b c d e f
\r
136 dd4 a b c d (Digit3 e f g) = d7 a b c d e f g
\r
137 dd4 a b c d (Digit4 e f g h) = d8 a b c d e f g h
\r
138 dd5 a b c d e (Digit1 f) = d6 a b c d e f
\r
139 dd5 a b c d e (Digit2 f g) = d7 a b c d e f g
\r
140 dd5 a b c d e (Digit3 f g h) = d8 a b c d e f g h
\r
141 dd5 a b c d e (Digit4 f g h i) = d9 a b c d e f g h i
\r
142 dd6 a b c d e f (Digit1 g) = d7 a b c d e f g
\r
143 dd6 a b c d e f (Digit2 g h) = d8 a b c d e f g h
\r
144 dd6 a b c d e f (Digit3 g h i) = d9 a b c d e f g h i
\r
145 dd6 a b c d e f (Digit4 g h i j) = d10 a b c d e f g h i j
\r
146 dd7 a b c d e f g (Digit1 h) = d8 a b c d e f g h
\r
147 dd7 a b c d e f g (Digit2 h i) = d9 a b c d e f g h i
\r
148 dd7 a b c d e f g (Digit3 h i j) = d10 a b c d e f g h i j
\r
149 dd7 a b c d e f g (Digit4 h i j k) = d11 a b c d e f g h i j k
\r
150 dd8 a b c d e f g h (Digit1 i) = d9 a b c d e f g h i
\r
151 dd8 a b c d e f g h (Digit2 i j) = d10 a b c d e f g h i j
\r
152 dd8 a b c d e f g h (Digit3 i j k) = d11 a b c d e f g h i j k
\r
153 dd8 a b c d e f g h (Digit4 i j k l) = d12 a b c d e f g h i j k l
\r
155 ddd1 a (Digit1 b) y = dd2 a b y
\r
156 ddd1 a (Digit2 b c) y = dd3 a b c y
\r
157 ddd1 a (Digit3 b c d) y = dd4 a b c d y
\r
158 ddd1 a (Digit4 b c d e) y = dd5 a b c d e y
\r
159 ddd2 a b (Digit1 c) y = dd3 a b c y
\r
160 ddd2 a b (Digit2 c d) y = dd4 a b c d y
\r
161 ddd2 a b (Digit3 c d e) y = dd5 a b c d e y
\r
162 ddd2 a b (Digit4 c d e f) y = dd6 a b c d e f y
\r
163 ddd3 a b c (Digit1 d) y = dd4 a b c d y
\r
164 ddd3 a b c (Digit2 d e) y = dd5 a b c d e y
\r
165 ddd3 a b c (Digit3 d e f) y = dd6 a b c d e f y
\r
166 ddd3 a b c (Digit4 d e f g) y = dd7 a b c d e f g y
\r
167 ddd4 a b c d (Digit1 e) y = dd5 a b c d e y
\r
168 ddd4 a b c d (Digit2 e f) y = dd6 a b c d e f y
\r
169 ddd4 a b c d (Digit3 e f g) y = dd7 a b c d e f g y
\r
170 ddd4 a b c d (Digit4 e f g h) y = dd8 a b c d e f g h y
\r