Adding missing files

lib/Comparable.fram

@@ -0,0 +1,5 @@
+(* This file is part of DBL, released under MIT license.
+ * See LICENSE for details.
+*)
+
+pub data Comparable = Eq| Noteq

lib/Ordered.fram

@@ -0,0 +1,14 @@
+(* This file is part of DBL, released under MIT license.
+ * See LICENSE for details.
+*)
+
+import open Comparable
+
+pub data Ordered = 
+| Less
+| Equal
+| Greater
+
+pub let ordToComp elem = match elem with | Equal => Eq | _ => Noteq end
+
+pub method toComparable {self : Ordered} = ordToComp self

lib/OrderedMapSignature.fram

@@ -0,0 +1,63 @@
+(* This file is part of DBL, released under MIT license.
+ * See LICENSE for details.
+*)
+import open RedBlackTree
+
+pub data OrderedMap Key = Map of {
+    T
+    , empty : {type Val} -> Tree (T Val)
+    , singleton : {type Val} -> Key -> Val -> [] Tree (T Val)
+    , method isEmpty : {type Val} -> Tree (T Val) -> [] Bool
+    , method insert : {type Val} -> Tree (T Val) -> 
+        Key -> Val -> [] Tree (T Val)
+    , method insert' : {type Val} -> Tree (T Val) -> 
+        Key -> Val -> [] (Pair (Tree (T Val)) Bool)
+    , method remove : {type Val} -> Tree (T Val) -> 
+        Key -> [] Tree (T Val)
+    , method remove' : {type Val} -> Tree (T Val) ->
+        Key -> [] (Pair (Tree (T Val)) Bool)
+    , method member : {type Val} -> Tree (T Val) -> Key -> [] Bool
+    , method find : {type Val} -> Tree (T Val) -> Key -> [] Option Val
+    , method operate : {type Val} -> Tree (T Val) -> Key ->
+        (Unit -> [] Option Val) -> (Val -> [] Option Val) -> 
+        [] (Pair (Pair (Option Val) (Option Val)) (Tree (T Val)))
+    , method foldl : {type Val, type A} -> Tree (T Val) -> 
+        (Key -> Val -> A -> [] A) -> A -> [] A
+    , method foldr : {type Val, type A} -> Tree (T Val) -> 
+        (Key -> Val -> A -> [] A) -> A -> [] A
+    , method toList : {type Val} -> Tree (T Val) -> [] List (Pair Key Val)
+    , method toValueList : {type Val} -> Tree (T Val) -> [] List Val
+    , method domain : {type Val} -> Tree (T Val) -> [] List Key
+    , method map : {type Val, type A} -> Tree (T Val) -> 
+        (Val -> [] A) -> [] Tree (T A)
+    , method map2 : {type Val, type A} -> Tree (T Val) -> 
+        (Key -> [] A) -> [] Tree (T A)
+(*  , method map3 : {type Val, type A} -> (Val -> [] A) -> 
+        Tree (T Val) -> [] Tree (T A) *)
+    , method app : {type Val} -> Tree (T Val) -> 
+        (Key -> Val -> [] Unit) -> [] Unit
+    , method union : {type Val} -> Tree (T Val) -> Tree (T Val) ->
+        (Key -> Val -> Val -> [] Val) -> [] Tree (T Val)
+    , method partion : {type Val} -> Tree (T Val) -> Key ->
+        [] (Pair (Pair (Tree (T Val)) (Option Val)) (Tree (T Val)))
+    , method partionLt : {type Val} -> Tree (T Val) -> Key ->
+        [] Pair (Tree (T Val)) (Tree (T Val))
+    , method partionGt : {type Val} -> Tree (T Val) -> Key ->
+        [] Pair (Tree (T Val)) (Tree (T Val))
+    , method rangeii : {type Val} -> Tree (T Val) -> Key -> Key ->
+        [] Tree (T Val)
+    , method rangeie : {type Val} -> Tree (T Val) -> Key -> Key ->
+        [] Tree (T Val)
+    , method rangeei : {type Val} -> Tree (T Val) -> Key -> Key ->
+        [] Tree (T Val)
+    , method rangeee : {type Val} -> Tree (T Val) -> Key -> Key ->
+        [] Tree (T Val)
+    , method least : {type Val} -> Tree (T Val) -> [] Option (T Val)
+    , method greatest : {type Val} -> Tree (T Val) -> [] Option (T Val)
+    , method leastGt : {type Val} -> Tree (T Val) -> Key -> [] Option (T Val)
+    , method leastGeq : {type Val} -> Tree (T Val) -> Key -> [] Option (T Val)
+    , method greatestLt : {type Val} -> Tree (T Val) -> 
+        Key -> [] Option (T Val)
+    , method greatestLeq : {type Val} -> Tree (T Val) ->
+        Key -> [] Option (T Val) 
+}

lib/OrderedSet.fram

@@ -0,0 +1,232 @@
+(* This file is part of DBL, released under MIT license.
+ * See LICENSE for details.
+*)
+
+import open RedBlackTree
+import open OrderedSetSignature
+
+data rec Q Val = Nil | E of Val , Q Val | T of Tree Val , Q Val
+
+let rec eqMain eq qs1 qs2 = 
+    match (qs1,qs2) with
+    | (Nil,Nil) => True
+    | (Nil, E _ _) => False
+    | (E _ _, Nil) => False
+    | (T Leaf rest, _) => eqMain eq rest qs2
+    | (_, T Leaf rest) => eqMain eq qs1 rest
+    | (T (Node _ _ left elem right) rest, _) =>
+        eqMain eq (T left (E elem (T right rest))) qs2
+    | (_, T (Node _ _ left elem right) rest) =>
+        eqMain eq qs1 (T left (E elem (T right rest)))
+    | (E elem1 rest1, E elem2 rest2) => 
+        match eq elem1 elem2 with
+        | Noteq => False
+        | Eq => eqMain eq rest1 rest2
+        end
+    end
+
+let rec subsetMain comp qs1 qs2 = 
+    match (qs1,qs2) with
+    | (Nil,_) => True
+    | (E _ _ , Nil) => False
+    | (T Leaf rest, _) => subsetMain comp rest qs2
+    | (_ , T Leaf rest) => subsetMain comp qs1 rest
+    | (T (Node _ _ left elem right) rest, _) =>
+        subsetMain comp (T left (E elem (T right rest))) qs2
+    | (_, T (Node _ _ left elem right) rest) =>
+        subsetMain comp qs1 (T left (E elem (T right rest)))
+    | (E elem1 rest1, E elem2 rest2) => 
+        match comp elem1 elem2 with
+        | Less => False
+        | Equal => subsetMain comp rest1 rest2
+        | Greater => subsetMain comp qs1 rest2
+        end
+    end
+
+let partionLt compare = fn tree key1 => let (_,left,right) = 
+        split (fn key2 => match compare key1 key2 with 
+        | Greater => Greater | _ => Less end) tree in (left,right)
+
+let partionGt compare = fn tree key1 => let (_, left,right) =
+        split (fn key2 => match compare key1 key2 with 
+        | Less => Less | _ => Greater end)  tree in (left,right)
+
+let rec least tree = 
+        match tree with 
+        | Leaf => None
+        | Node _ _ Leaf x _ => Some x
+        | Node _ _ left _ _ => least left
+        end
+
+let rec greatest tree = 
+        match tree with 
+        | Leaf => None
+        | Node _ _ _ x Leaf => Some x
+        | Node _ _ _ _ right => greatest right
+        end
+
+pub let makeOrderedSet {Val} (compare : Val -> Val -> [] Ordered) = Set {
+    T = Tree Val
+    , empty = Leaf
+    , method isEmpty = 
+        (fn tree => match tree with 
+        | Leaf => True 
+        | _ => False 
+        end)
+    , method singletonSet = fn elem =>  Node Black 1 Leaf elem Leaf
+    , singleton = fn elem =>  Node Black 1 Leaf elem Leaf
+    , method insert = fn tree elem => 
+        match search (fn val => compare elem val) tree [] with 
+        | (Leaf,zipper) => zipRed elem Leaf Leaf zipper
+        | (Node _ _ _ _ _,_) => tree
+        end
+    , method remove = fn tree elem => 
+        match search (fn val => compare elem val) tree [] with 
+        | (Leaf,_) => tree
+        | (Node color _ left _ right,zipper) => delete color left right zipper
+        end 
+    , method member = fn tree elem => let rec search tree elem = 
+        match tree with
+        | Leaf => False
+        | Node _ _ left val right => 
+            match compare elem val with
+            | Less => search left elem
+            | Greater => search right elem
+            | Equal => True
+            end
+        end in search tree elem
+    , method foldl = fn tree func acc => let rec foldl tree func acc =
+        match tree with
+        | Leaf => acc
+        | Node _ _ left val right => 
+          foldl right func (func val (foldl left func acc))
+        end in foldl tree func acc
+    , method foldr = fn tree func acc => let rec foldr tree func acc =
+        match tree with 
+        | Leaf => acc
+        | Node _ _ left val right =>
+          foldr left func (func val (foldr right func acc))
+        end in foldr tree func acc
+    , method toList = fn tree => let rec toList tree acc =
+        match tree with 
+        | Leaf => acc
+        | Node _ _ left val right => 
+            toList left (val :: toList right acc)
+        end in toList tree []
+    , method union = fn tree1 tree2 => let rec union tree1 tree2 =
+        match tree1 with
+        | Leaf => tree2
+        | Node _ _ left1 key1 right1 => 
+          match tree2 with
+          | Leaf => tree1
+          | Node _ _ _ _ _ => 
+            let (_,left2,right2) = split (fn key2 => compare key1 key2) tree2 
+            in join_val key1 (union left1 left2) (union right1 right2) 
+          end
+        end in union tree1 tree2
+    , method intersection = fn tree1 tree2 => let rec intersection tree1 tree2 =
+        match tree1 with
+        | Leaf => Leaf
+        | Node _ _ left1 key1 right1 => 
+            match tree2 with
+            | Leaf => Leaf
+            | _ => let (value_out, left2, right2) = 
+            split (fn key2 => compare key1 key2) tree2 
+            in let left = intersection left1 left2 
+            in let right = intersection right1 right2
+            in match value_out with
+                | Some _ => join_val key1 left right
+                | None => join left right
+            end
+            end
+        end in intersection tree1 tree2
+    , method diffrence = fn tree1 tree2 => let rec diffrence tree1 tree2 = 
+        match tree1 with
+        | Leaf => Leaf
+        | Node _ _ left1 key1 right1 => 
+            match tree2 with 
+            | Leaf => tree1 
+            | _ => let (value_out, left2, right2) =
+            split (fn key2 => compare key1 key2) tree2
+            in let left = diffrence left1 left2
+            in let right = diffrence right1 right2
+            in match value_out with
+                | Some _ => join left right
+                | None => join_val key1 left right
+                end
+            end
+        end in diffrence tree1 tree2
+    , method eq = fn set1 set2 => 
+    eqMain (fn e1 e2 => (compare e1 e2).toComparable) (T set1 Nil) (T set2 Nil)
+    , method subset = fn set1 set2 => subsetMain compare (T set1 Nil) (T set2 Nil)
+    , method partionLt = partionLt compare
+    , method partionGt = partionGt compare
+    , method rangeii = fn tree left right => 
+    let (_, tree') = partionLt compare tree left in
+    let (tree'',_) = partionGt compare tree' right in tree''
+    , method rangeei = fn tree left right =>
+    let (_, tree') = partionGt compare tree left in
+    let (tree'',_) = partionGt compare tree' right in tree''
+    , method rangeie = fn tree left right =>
+    let (_, tree') = partionLt compare tree left in
+    let (tree'',_) = partionLt compare tree' right in tree''
+    , method rangeee = fn tree left right =>
+    let (_, tree') = partionGt compare tree left in
+    let (tree'',_) = partionLt compare tree' right in tree''
+    , method least = fn tree => least tree
+    , method greatest = fn tree => greatest tree
+    , method leastGt = fn tree val => let rec leastGt tree val = 
+        match tree with
+        | Leaf => None
+        | Node _ _ left key right => 
+            match compare val key with
+            | Less => let x = leastGt left val in
+                match x with
+                | None => Some key
+                | _ => x
+                end
+            | Equal => least right
+            | Greater => leastGt right val
+            end
+        end in leastGt tree val
+    , method leastGeq = fn tree val => let rec leastGeq tree val =
+        match tree with 
+        | Leaf => None
+        | Node _ _ left key right => 
+            match compare val key with
+            | Less => match leastGeq left val with 
+                | None => Some key 
+                | x => x 
+                end
+            | Equal => Some val
+            | Greater => leastGeq right val
+            end
+        end in leastGeq tree val
+    , method greatestLt = fn tree val => let rec greatestLt tree val =
+        match tree with 
+        | Leaf => None
+        | Node _ _ left key right => 
+            match compare val key with
+            | Less => greatestLt left val
+            | Equal => greatest left
+            | Greater => match greatestLt right val with 
+                | None => Some key 
+                | x => x
+                end
+            end
+        end in greatestLt tree val 
+    , method greatestLeq = fn tree val =>
+        let rec greatestLeq tree val = 
+        match tree with
+        | Leaf => None
+        | Node _ _ left key right => 
+            match compare val key with
+            | Less => greatestLeq left val
+            | Equal => Some val
+            | Greater => match greatestLeq right val with
+                | None => Some key
+                | x => x
+                end
+            end
+        end in greatestLeq tree val
+}

lib/OrderedSetSignature.fram

@@ -0,0 +1,34 @@
+(* This file is part of DBL, released under MIT license.
+ * See LICENSE for details.
+*)
+
+pub data OrderedSet Val = Set of {
+    T
+    , empty : T
+    , method isEmpty : T -> [] Bool
+    , singleton : Val -> [] T
+    , method insert : T -> Val -> [] T
+    , method remove : T -> Val -> [] T
+    , method singletonSet : Val -> [] T 
+    , method member : T -> Val -> [] Bool
+    , method foldl : {type A} -> T -> (Val -> A -> [] A) -> A -> [] A
+    , method foldr : {type A} -> T -> (Val -> A -> [] A) -> A -> [] A
+    , method toList : T -> [] List Val
+    , method union : T -> T -> [] T
+    , method intersection : T -> T -> [] T
+    , method diffrence : T -> T -> [] T
+    , method eq : T -> T -> [] Bool
+    , method subset : T -> T -> [] Bool
+    , method partionLt : T -> Val -> [] (Pair T T)
+    , method partionGt : T -> Val -> [] (Pair T T)
+    , method rangeii : T -> Val -> Val -> [] T
+    , method rangeei : T -> Val -> Val -> [] T
+    , method rangeie : T -> Val -> Val -> [] T
+    , method rangeee : T -> Val -> Val -> [] T
+    , method least : T -> [] Option Val
+    , method greatest : T -> [] Option Val
+    , method leastGt : T -> Val -> [] Option Val
+    , method leastGeq : T -> Val -> [] Option Val
+    , method greatestLt : T -> Val -> [] Option Val
+    , method greatestLeq : T -> Val -> [] Option Val 
+}