From f68e220655a54385ea4073b9a990c377308163bb Mon Sep 17 00:00:00 2001
From: Pauan <pcxunlimited@gmail.com>
Date: Thu, 6 Jul 2017 14:42:49 -1000
Subject: [PATCH] Adding in subset-of? function

---
 lib/std/data/red-black-tree.kk | 44 +++++++++++++++++++++++-----------
 lib/std/data/set.kk            | 26 +++++++++++++-------
 2 files changed, 48 insertions(+), 22 deletions(-)

diff --git a/lib/std/data/red-black-tree.kk b/lib/std/data/red-black-tree.kk
index 8c8f37369..5ef0b15ad 100644
--- a/lib/std/data/red-black-tree.kk
+++ b/lib/std/data/red-black-tree.kk
@@ -21,14 +21,6 @@ abstract type tree<a> {
 }
 
 
-fun color(tree: tree<a>): color {
-  match (tree) {
-    Empty -> Black
-    Node(_, _, _, color) -> color
-  }
-}
-
-
 public val empty: forall<a> tree<a> = Empty
 
 
@@ -38,7 +30,7 @@ public fun single(value: a): tree<a> {
 
 
 // This is unsafe because it's possible to use different compare functions on the same tree
-public fun unsafe-lookup(tree: tree<a>, key: b, compare: (b, a) -> order): maybe<a> {
+public fun unsafe-lookup(tree: tree<a>, key: b, compare: (b, a) -> e order): e maybe<a> {
   match (tree) {
     Node(left, value, right, _) ->
       match (compare(key, value)) {
@@ -53,6 +45,21 @@ public fun unsafe-lookup(tree: tree<a>, key: b, compare: (b, a) -> order): maybe
 }
 
 
+// TODO implement this more efficiently
+public fun find-first(tree: tree<a>, fn: (a) -> e maybe<b>): e maybe<b> {
+  match (tree) {
+    Node(left, value, right, _) -> match (find-first(left, fn)) {
+      Nothing -> match (fn(value)) {
+        Nothing -> find-first(right, fn)
+        a -> a
+      }
+      a -> a
+    }
+    Empty -> Nothing
+  }
+}
+
+
 public fun foldl(tree: tree<a>, initial: b, fn: (b, a) -> e b): e b {
   match (tree) {
     Node(left, value, right, _) -> foldl(right, fn(foldl(left, initial, fn), value), fn)
@@ -69,13 +76,22 @@ public fun foldr(tree: tree<a>, initial: b, fn: (a, b) -> e b): e b {
 }
 
 
+public fun map(tree: tree<a>, fn: (a) -> e b): e tree<b> {
+  match (tree) {
+    // TODO this can be parallelized
+    Node(left, value, right, color) -> Node(map(left, fn), fn(value), map(right, fn), color)
+    Empty -> empty
+  }
+}
+
+
 public fun to-list(tree: tree<a>): list<a> {
   tree.foldr([], Cons)
 }
 
 
 // TODO should this be called unsafe ?
-public fun from-list(list: list<a>, compare: (a, a) -> order): tree<a> {
+public fun from-list(list: list<a>, compare: (a, a) -> e order): e tree<a> {
   list.foldl(empty) fun(l, r) {
     unsafe-insert(l, r, compare, True)
   }
@@ -186,7 +202,7 @@ fun redden(tree: tree<a>): tree<a> {
 }
 
 
-fun unsafe-insert1(tree: tree<a>, value: a, compare: (a, a) -> order, replace: bool): tree<a> {
+fun unsafe-insert1(tree: tree<a>, value: a, compare: (a, a) -> e order, replace: bool): e tree<a> {
   match (tree) {
     Node(left, middle, right, color) ->
       match (compare(value, middle)) {
@@ -208,12 +224,12 @@ fun unsafe-insert1(tree: tree<a>, value: a, compare: (a, a) -> order, replace: b
 }
 
 // This is unsafe because it's possible to use different compare functions on the same tree
-public fun unsafe-insert(tree: tree<a>, value: a, compare: (a, a) -> order, replace: bool): tree<a> {
+public fun unsafe-insert(tree: tree<a>, value: a, compare: (a, a) -> e order, replace: bool): e tree<a> {
   blacken(unsafe-insert1(tree, value, compare, replace))
 }
 
 
-fun unsafe-remove1(tree: tree<a>, value: a, compare: (a, a) -> order): tree<a> {
+fun unsafe-remove1(tree: tree<a>, value: a, compare: (a, a) -> e order): e tree<a> {
   match (tree) {
     Node(left, middle, right, _) ->
       match (compare(value, middle)) {
@@ -235,6 +251,6 @@ fun unsafe-remove1(tree: tree<a>, value: a, compare: (a, a) -> order): tree<a> {
 }
 
 // This is unsafe because it's possible to use different compare functions on the same tree
-public fun unsafe-remove(tree: tree<a>, value: a, compare: (a, a) -> order): tree<a> {
+public fun unsafe-remove(tree: tree<a>, value: a, compare: (a, a) -> e order): e tree<a> {
   blacken(unsafe-remove1(tree, value, compare))
 }
diff --git a/lib/std/data/set.kk b/lib/std/data/set.kk
index b450be913..23f961c87 100644
--- a/lib/std/data/set.kk
+++ b/lib/std/data/set.kk
@@ -7,6 +7,10 @@
 ---------------------------------------------------------------------------*/
 
 // TODO unit tests
+// TODO disjoint unions
+// TODO power set
+// TODO cartesian product
+// TODO maybe allow for compare functions with effects
 module std/data/set
 
 import red-black-tree
@@ -38,13 +42,11 @@ public fun insert(set: set<a>, value: a): set<a> {
   set(tree = unsafe-insert(set.tree, value, set.compare, True))
 }
 
-// TODO remove the div effect
-public fun remove(set: set<a>, value: a): div set<a> {
+public fun remove(set: set<a>, value: a): set<a> {
   set(tree = unsafe-remove(set.tree, value, set.compare))
 }
 
-// TODO remove the div effect
-public fun exclude(set: set<a>, exclude: set<a>): div set<a> {
+public fun exclude(set: set<a>, exclude: set<a>): set<a> {
   val compare = set.compare
   set(
     tree = exclude.tree.foldl(set.tree) fun(old, value) {
@@ -70,14 +72,12 @@ public fun intersection-left(left: set<a>, right: set<a>): set<a> {
   intersection-right(right, left)
 }
 
-// TODO remove the div effect
-public fun difference-left(left: set<a>, right: set<a>): div set<a> {
+public fun difference-left(left: set<a>, right: set<a>): set<a> {
   // TODO implement this more efficiently
   union-left(exclude(left, right), exclude(right, left))
 }
 
-// TODO remove the div effect
-public fun difference-right(left: set<a>, right: set<a>): div set<a> {
+public fun difference-right(left: set<a>, right: set<a>): set<a> {
   // TODO implement this more efficiently
   union-right(exclude(left, right), exclude(right, left))
 }
@@ -101,3 +101,13 @@ public fun union-right(left: set<a>, right: set<a>): set<a> {
     }
   )
 }
+
+public fun subset-of?(smaller: set<a>, bigger: set<a>): bool {
+  smaller.tree.find-first fun(value) {
+    if (bigger.has?(value)) {
+      Nothing
+    } else {
+      Just(False)
+    }
+  }.default(True)
+}