blob: 59167d2e74c515c5464f0326b42d3d7093ff16ac (
plain)
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
|
(.module:
[lux #*
[control
[equivalence (#+ Equivalence)]
[monad (#+ do Monad)]]
[data
["." maybe]
[number
["." nat ("nat/." interval)]]
[collection
[tree
["." finger (#+ Tree)]]]]])
(type: #export Priority Nat)
(type: #export (Queue a)
(Maybe (Tree Priority a)))
(def: #export max Priority nat/top)
(def: #export min Priority nat/bottom)
(def: #export empty
Queue
#.None)
(def: #export (peek queue)
(All [a] (-> (Queue a) (Maybe a)))
(do maybe.monad
[fingers queue]
(wrap (maybe.assume (finger.search (n/= (finger.tag fingers)) fingers)))))
(def: #export (size queue)
(All [a] (-> (Queue a) Nat))
(case queue
#.None
0
(#.Some fingers)
(loop [node (get@ #finger.node fingers)]
(case node
(#finger.Leaf _ _)
1
(#finger.Branch _ left right)
(n/+ (recur left) (recur right))))))
(def: #export (member? Equivalence<a> queue member)
(All [a] (-> (Equivalence a) (Queue a) a Bit))
(case queue
#.None
#0
(#.Some fingers)
(loop [node (get@ #finger.node fingers)]
(case node
(#finger.Leaf _ reference)
(:: Equivalence<a> = reference member)
(#finger.Branch _ left right)
(or (recur left)
(recur right))))))
(def: #export (pop queue)
(All [a] (-> (Queue a) (Queue a)))
(do maybe.monad
[fingers queue
#let [highest-priority (finger.tag fingers)]
node' (loop [node (get@ #finger.node fingers)]
(case node
(#finger.Leaf priority reference)
(if (n/= highest-priority priority)
#.None
(#.Some node))
(#finger.Branch priority left right)
(if (n/= highest-priority (finger.tag (set@ #finger.node left fingers)))
(case (recur left)
#.None
(#.Some right)
(#.Some =left)
(|> (finger.branch (set@ #finger.node =left fingers)
(set@ #finger.node right fingers))
(get@ #finger.node)
#.Some))
(case (recur right)
#.None
(#.Some left)
(#.Some =right)
(|> (finger.branch (set@ #finger.node left fingers)
(set@ #finger.node =right fingers))
(get@ #finger.node)
#.Some))
)))]
(wrap (set@ #finger.node node' fingers))))
(def: #export (push priority value queue)
(All [a] (-> Priority a (Queue a) (Queue a)))
(let [addition {#finger.monoid nat.maximum
#finger.node (#finger.Leaf priority value)}]
(case queue
#.None
(#.Some addition)
(#.Some fingers)
(#.Some (finger.branch fingers addition)))))
|
