Skip to content

Commit e5d206f

Browse files
committed
Adding missing files
1 parent dae76bc commit e5d206f

File tree

9 files changed

+813
-0
lines changed

9 files changed

+813
-0
lines changed

lib/Comparable.fram

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,5 @@
1+
(* This file is part of DBL, released under MIT license.
2+
* See LICENSE for details.
3+
*)
4+
5+
pub data Comparable = Eq| Noteq

lib/Ordered.fram

Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,14 @@
1+
(* This file is part of DBL, released under MIT license.
2+
* See LICENSE for details.
3+
*)
4+
5+
import open Comparable
6+
7+
pub data Ordered =
8+
| Less
9+
| Equal
10+
| Greater
11+
12+
pub let ordToComp elem = match elem with | Equal => Eq | _ => Noteq end
13+
14+
pub method toComparable {self : Ordered} = ordToComp self

lib/OrderedMapSignature.fram

Lines changed: 63 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,63 @@
1+
(* This file is part of DBL, released under MIT license.
2+
* See LICENSE for details.
3+
*)
4+
import open RedBlackTree
5+
6+
pub data OrderedMap Key = Map of {
7+
T
8+
, empty : {type Val} -> Tree (T Val)
9+
, singleton : {type Val} -> Key -> Val -> [] Tree (T Val)
10+
, method isEmpty : {type Val} -> Tree (T Val) -> [] Bool
11+
, method insert : {type Val} -> Tree (T Val) ->
12+
Key -> Val -> [] Tree (T Val)
13+
, method insert' : {type Val} -> Tree (T Val) ->
14+
Key -> Val -> [] (Pair (Tree (T Val)) Bool)
15+
, method remove : {type Val} -> Tree (T Val) ->
16+
Key -> [] Tree (T Val)
17+
, method remove' : {type Val} -> Tree (T Val) ->
18+
Key -> [] (Pair (Tree (T Val)) Bool)
19+
, method member : {type Val} -> Tree (T Val) -> Key -> [] Bool
20+
, method find : {type Val} -> Tree (T Val) -> Key -> [] Option Val
21+
, method operate : {type Val} -> Tree (T Val) -> Key ->
22+
(Unit -> [] Option Val) -> (Val -> [] Option Val) ->
23+
[] (Pair (Pair (Option Val) (Option Val)) (Tree (T Val)))
24+
, method foldl : {type Val, type A} -> Tree (T Val) ->
25+
(Key -> Val -> A -> [] A) -> A -> [] A
26+
, method foldr : {type Val, type A} -> Tree (T Val) ->
27+
(Key -> Val -> A -> [] A) -> A -> [] A
28+
, method toList : {type Val} -> Tree (T Val) -> [] List (Pair Key Val)
29+
, method toValueList : {type Val} -> Tree (T Val) -> [] List Val
30+
, method domain : {type Val} -> Tree (T Val) -> [] List Key
31+
, method map : {type Val, type A} -> Tree (T Val) ->
32+
(Val -> [] A) -> [] Tree (T A)
33+
, method map2 : {type Val, type A} -> Tree (T Val) ->
34+
(Key -> [] A) -> [] Tree (T A)
35+
(* , method map3 : {type Val, type A} -> (Val -> [] A) ->
36+
Tree (T Val) -> [] Tree (T A) *)
37+
, method app : {type Val} -> Tree (T Val) ->
38+
(Key -> Val -> [] Unit) -> [] Unit
39+
, method union : {type Val} -> Tree (T Val) -> Tree (T Val) ->
40+
(Key -> Val -> Val -> [] Val) -> [] Tree (T Val)
41+
, method partion : {type Val} -> Tree (T Val) -> Key ->
42+
[] (Pair (Pair (Tree (T Val)) (Option Val)) (Tree (T Val)))
43+
, method partionLt : {type Val} -> Tree (T Val) -> Key ->
44+
[] Pair (Tree (T Val)) (Tree (T Val))
45+
, method partionGt : {type Val} -> Tree (T Val) -> Key ->
46+
[] Pair (Tree (T Val)) (Tree (T Val))
47+
, method rangeii : {type Val} -> Tree (T Val) -> Key -> Key ->
48+
[] Tree (T Val)
49+
, method rangeie : {type Val} -> Tree (T Val) -> Key -> Key ->
50+
[] Tree (T Val)
51+
, method rangeei : {type Val} -> Tree (T Val) -> Key -> Key ->
52+
[] Tree (T Val)
53+
, method rangeee : {type Val} -> Tree (T Val) -> Key -> Key ->
54+
[] Tree (T Val)
55+
, method least : {type Val} -> Tree (T Val) -> [] Option (T Val)
56+
, method greatest : {type Val} -> Tree (T Val) -> [] Option (T Val)
57+
, method leastGt : {type Val} -> Tree (T Val) -> Key -> [] Option (T Val)
58+
, method leastGeq : {type Val} -> Tree (T Val) -> Key -> [] Option (T Val)
59+
, method greatestLt : {type Val} -> Tree (T Val) ->
60+
Key -> [] Option (T Val)
61+
, method greatestLeq : {type Val} -> Tree (T Val) ->
62+
Key -> [] Option (T Val)
63+
}

lib/OrderedSet.fram

Lines changed: 232 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,232 @@
1+
(* This file is part of DBL, released under MIT license.
2+
* See LICENSE for details.
3+
*)
4+
5+
import open RedBlackTree
6+
import open OrderedSetSignature
7+
8+
data rec Q Val = Nil | E of Val , Q Val | T of Tree Val , Q Val
9+
10+
let rec eqMain eq qs1 qs2 =
11+
match (qs1,qs2) with
12+
| (Nil,Nil) => True
13+
| (Nil, E _ _) => False
14+
| (E _ _, Nil) => False
15+
| (T Leaf rest, _) => eqMain eq rest qs2
16+
| (_, T Leaf rest) => eqMain eq qs1 rest
17+
| (T (Node _ _ left elem right) rest, _) =>
18+
eqMain eq (T left (E elem (T right rest))) qs2
19+
| (_, T (Node _ _ left elem right) rest) =>
20+
eqMain eq qs1 (T left (E elem (T right rest)))
21+
| (E elem1 rest1, E elem2 rest2) =>
22+
match eq elem1 elem2 with
23+
| Noteq => False
24+
| Eq => eqMain eq rest1 rest2
25+
end
26+
end
27+
28+
let rec subsetMain comp qs1 qs2 =
29+
match (qs1,qs2) with
30+
| (Nil,_) => True
31+
| (E _ _ , Nil) => False
32+
| (T Leaf rest, _) => subsetMain comp rest qs2
33+
| (_ , T Leaf rest) => subsetMain comp qs1 rest
34+
| (T (Node _ _ left elem right) rest, _) =>
35+
subsetMain comp (T left (E elem (T right rest))) qs2
36+
| (_, T (Node _ _ left elem right) rest) =>
37+
subsetMain comp qs1 (T left (E elem (T right rest)))
38+
| (E elem1 rest1, E elem2 rest2) =>
39+
match comp elem1 elem2 with
40+
| Less => False
41+
| Equal => subsetMain comp rest1 rest2
42+
| Greater => subsetMain comp qs1 rest2
43+
end
44+
end
45+
46+
let partionLt compare = fn tree key1 => let (_,left,right) =
47+
split (fn key2 => match compare key1 key2 with
48+
| Greater => Greater | _ => Less end) tree in (left,right)
49+
50+
let partionGt compare = fn tree key1 => let (_, left,right) =
51+
split (fn key2 => match compare key1 key2 with
52+
| Less => Less | _ => Greater end) tree in (left,right)
53+
54+
let rec least tree =
55+
match tree with
56+
| Leaf => None
57+
| Node _ _ Leaf x _ => Some x
58+
| Node _ _ left _ _ => least left
59+
end
60+
61+
let rec greatest tree =
62+
match tree with
63+
| Leaf => None
64+
| Node _ _ _ x Leaf => Some x
65+
| Node _ _ _ _ right => greatest right
66+
end
67+
68+
pub let makeOrderedSet {Val} (compare : Val -> Val -> [] Ordered) = Set {
69+
T = Tree Val
70+
, empty = Leaf
71+
, method isEmpty =
72+
(fn tree => match tree with
73+
| Leaf => True
74+
| _ => False
75+
end)
76+
, method singletonSet = fn elem => Node Black 1 Leaf elem Leaf
77+
, singleton = fn elem => Node Black 1 Leaf elem Leaf
78+
, method insert = fn tree elem =>
79+
match search (fn val => compare elem val) tree [] with
80+
| (Leaf,zipper) => zipRed elem Leaf Leaf zipper
81+
| (Node _ _ _ _ _,_) => tree
82+
end
83+
, method remove = fn tree elem =>
84+
match search (fn val => compare elem val) tree [] with
85+
| (Leaf,_) => tree
86+
| (Node color _ left _ right,zipper) => delete color left right zipper
87+
end
88+
, method member = fn tree elem => let rec search tree elem =
89+
match tree with
90+
| Leaf => False
91+
| Node _ _ left val right =>
92+
match compare elem val with
93+
| Less => search left elem
94+
| Greater => search right elem
95+
| Equal => True
96+
end
97+
end in search tree elem
98+
, method foldl = fn tree func acc => let rec foldl tree func acc =
99+
match tree with
100+
| Leaf => acc
101+
| Node _ _ left val right =>
102+
foldl right func (func val (foldl left func acc))
103+
end in foldl tree func acc
104+
, method foldr = fn tree func acc => let rec foldr tree func acc =
105+
match tree with
106+
| Leaf => acc
107+
| Node _ _ left val right =>
108+
foldr left func (func val (foldr right func acc))
109+
end in foldr tree func acc
110+
, method toList = fn tree => let rec toList tree acc =
111+
match tree with
112+
| Leaf => acc
113+
| Node _ _ left val right =>
114+
toList left (val :: toList right acc)
115+
end in toList tree []
116+
, method union = fn tree1 tree2 => let rec union tree1 tree2 =
117+
match tree1 with
118+
| Leaf => tree2
119+
| Node _ _ left1 key1 right1 =>
120+
match tree2 with
121+
| Leaf => tree1
122+
| Node _ _ _ _ _ =>
123+
let (_,left2,right2) = split (fn key2 => compare key1 key2) tree2
124+
in join_val key1 (union left1 left2) (union right1 right2)
125+
end
126+
end in union tree1 tree2
127+
, method intersection = fn tree1 tree2 => let rec intersection tree1 tree2 =
128+
match tree1 with
129+
| Leaf => Leaf
130+
| Node _ _ left1 key1 right1 =>
131+
match tree2 with
132+
| Leaf => Leaf
133+
| _ => let (value_out, left2, right2) =
134+
split (fn key2 => compare key1 key2) tree2
135+
in let left = intersection left1 left2
136+
in let right = intersection right1 right2
137+
in match value_out with
138+
| Some _ => join_val key1 left right
139+
| None => join left right
140+
end
141+
end
142+
end in intersection tree1 tree2
143+
, method diffrence = fn tree1 tree2 => let rec diffrence tree1 tree2 =
144+
match tree1 with
145+
| Leaf => Leaf
146+
| Node _ _ left1 key1 right1 =>
147+
match tree2 with
148+
| Leaf => tree1
149+
| _ => let (value_out, left2, right2) =
150+
split (fn key2 => compare key1 key2) tree2
151+
in let left = diffrence left1 left2
152+
in let right = diffrence right1 right2
153+
in match value_out with
154+
| Some _ => join left right
155+
| None => join_val key1 left right
156+
end
157+
end
158+
end in diffrence tree1 tree2
159+
, method eq = fn set1 set2 =>
160+
eqMain (fn e1 e2 => (compare e1 e2).toComparable) (T set1 Nil) (T set2 Nil)
161+
, method subset = fn set1 set2 => subsetMain compare (T set1 Nil) (T set2 Nil)
162+
, method partionLt = partionLt compare
163+
, method partionGt = partionGt compare
164+
, method rangeii = fn tree left right =>
165+
let (_, tree') = partionLt compare tree left in
166+
let (tree'',_) = partionGt compare tree' right in tree''
167+
, method rangeei = fn tree left right =>
168+
let (_, tree') = partionGt compare tree left in
169+
let (tree'',_) = partionGt compare tree' right in tree''
170+
, method rangeie = fn tree left right =>
171+
let (_, tree') = partionLt compare tree left in
172+
let (tree'',_) = partionLt compare tree' right in tree''
173+
, method rangeee = fn tree left right =>
174+
let (_, tree') = partionGt compare tree left in
175+
let (tree'',_) = partionLt compare tree' right in tree''
176+
, method least = fn tree => least tree
177+
, method greatest = fn tree => greatest tree
178+
, method leastGt = fn tree val => let rec leastGt tree val =
179+
match tree with
180+
| Leaf => None
181+
| Node _ _ left key right =>
182+
match compare val key with
183+
| Less => let x = leastGt left val in
184+
match x with
185+
| None => Some key
186+
| _ => x
187+
end
188+
| Equal => least right
189+
| Greater => leastGt right val
190+
end
191+
end in leastGt tree val
192+
, method leastGeq = fn tree val => let rec leastGeq tree val =
193+
match tree with
194+
| Leaf => None
195+
| Node _ _ left key right =>
196+
match compare val key with
197+
| Less => match leastGeq left val with
198+
| None => Some key
199+
| x => x
200+
end
201+
| Equal => Some val
202+
| Greater => leastGeq right val
203+
end
204+
end in leastGeq tree val
205+
, method greatestLt = fn tree val => let rec greatestLt tree val =
206+
match tree with
207+
| Leaf => None
208+
| Node _ _ left key right =>
209+
match compare val key with
210+
| Less => greatestLt left val
211+
| Equal => greatest left
212+
| Greater => match greatestLt right val with
213+
| None => Some key
214+
| x => x
215+
end
216+
end
217+
end in greatestLt tree val
218+
, method greatestLeq = fn tree val =>
219+
let rec greatestLeq tree val =
220+
match tree with
221+
| Leaf => None
222+
| Node _ _ left key right =>
223+
match compare val key with
224+
| Less => greatestLeq left val
225+
| Equal => Some val
226+
| Greater => match greatestLeq right val with
227+
| None => Some key
228+
| x => x
229+
end
230+
end
231+
end in greatestLeq tree val
232+
}

lib/OrderedSetSignature.fram

Lines changed: 34 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,34 @@
1+
(* This file is part of DBL, released under MIT license.
2+
* See LICENSE for details.
3+
*)
4+
5+
pub data OrderedSet Val = Set of {
6+
T
7+
, empty : T
8+
, method isEmpty : T -> [] Bool
9+
, singleton : Val -> [] T
10+
, method insert : T -> Val -> [] T
11+
, method remove : T -> Val -> [] T
12+
, method singletonSet : Val -> [] T
13+
, method member : T -> Val -> [] Bool
14+
, method foldl : {type A} -> T -> (Val -> A -> [] A) -> A -> [] A
15+
, method foldr : {type A} -> T -> (Val -> A -> [] A) -> A -> [] A
16+
, method toList : T -> [] List Val
17+
, method union : T -> T -> [] T
18+
, method intersection : T -> T -> [] T
19+
, method diffrence : T -> T -> [] T
20+
, method eq : T -> T -> [] Bool
21+
, method subset : T -> T -> [] Bool
22+
, method partionLt : T -> Val -> [] (Pair T T)
23+
, method partionGt : T -> Val -> [] (Pair T T)
24+
, method rangeii : T -> Val -> Val -> [] T
25+
, method rangeei : T -> Val -> Val -> [] T
26+
, method rangeie : T -> Val -> Val -> [] T
27+
, method rangeee : T -> Val -> Val -> [] T
28+
, method least : T -> [] Option Val
29+
, method greatest : T -> [] Option Val
30+
, method leastGt : T -> Val -> [] Option Val
31+
, method leastGeq : T -> Val -> [] Option Val
32+
, method greatestLt : T -> Val -> [] Option Val
33+
, method greatestLeq : T -> Val -> [] Option Val
34+
}

0 commit comments

Comments
 (0)