From ce475250191d01307114cdbceeb95cad8db6b482 Mon Sep 17 00:00:00 2001 From: Pauan Date: Wed, 5 Jul 2017 12:56:53 -1000 Subject: [PATCH 1/9] Adding in red black trees --- lib/std/data/red-black-tree.kk | 220 +++++++++++++++++++++++++++++++++ 1 file changed, 220 insertions(+) create mode 100644 lib/std/data/red-black-tree.kk diff --git a/lib/std/data/red-black-tree.kk b/lib/std/data/red-black-tree.kk new file mode 100644 index 000000000..a8edc6757 --- /dev/null +++ b/lib/std/data/red-black-tree.kk @@ -0,0 +1,220 @@ +/*--------------------------------------------------------------------------- + Copyright 2017 Microsoft Corporation. + + This is free software; you can redistribute it and/or modify it under the + terms of the Apache License, Version 2.0. A copy of the License can be + found in the file "license.txt" at the root of this distribution. +---------------------------------------------------------------------------*/ + +// Adapted from https://github.com/sweirich/dth/blob/b888942f33425a871d46105862683e8950d15b23/examples/red-black/RedBlack.lhs +// TODO unit tests +module std/data/red-black-tree + +type color { + Red + Black +} + +abstract type tree { + Empty + Node(left: tree, value: a, right: tree, color: color) +} + + +fun color(tree: tree): color { + match (tree) { + Empty -> Black + Node(_, _, _, color) -> color + } +} + + +public val empty: forall tree = Empty + + +public fun single(value: a): tree { + Node(empty, value, empty, Black) +} + + +// This is unsafe because it's possible to use different compare functions on the same tree +public fun unsafe-lookup(tree: tree, key: b, compare: (b, a) -> order): maybe { + match (tree) { + Node(left, value, right, _) -> + match (compare(key, value)) { + Lt -> unsafe-lookup(left, key, compare) + Eq -> Just(value) + Gt -> unsafe-lookup(right, key, compare) + } + + Empty -> + Nothing + } +} + + +fun to-list1(tree: tree, acc: list): list { + match (tree) { + Node(left, value, right, _) -> + to-list1(left, Cons(value, to-list1(right, acc))) + + Empty -> acc + } +} + +public fun to-list(tree: tree): list { + to-list1(tree, []) +} + + +// TODO should this be called unsafe ? +public fun from-list(list: list, compare: (a, a) -> order): tree { + list.foldl(empty) fun(l, r) { + unsafe-insert(l, r, compare) + } +} + + +fun balance(tree: tree): tree { + match (tree) { + Node(Node(Node(a, x, b, Red), y, c, Red), z, d, Black) -> + Node(Node(a, x, b, Black), y, Node(c, z, d, Black), Red) + + Node(Node(a, x, Node(b, y, c, Red), Red), z, d, Black) -> + Node(Node(a, x, b, Black), y, Node(c, z, d, Black), Red) + + Node(a, x, Node(Node(b, y, c, Red), z, d, Red), Black) -> + Node(Node(a, x, b, Black), y, Node(c, z, d, Black), Red) + + Node(a, x, Node(b, y, Node(c, z, d, Red), Red), Black) -> + Node(Node(a, x, b, Black), y, Node(c, z, d, Black), Red) + + a -> a + } +} + +fun balance-left(left: tree, value: a, right: tree): tree { + match (left) { + Node(a, x, b, Red) -> + Node(Node(a, x, b, Black), value, right, Red) + + _ -> match (right) { + Node(a, y, b, Black) -> + balance(Node(left, value, Node(a, y, b, Red), Black)) + + Node(Node(a, y, b, Black), z, c, Red) -> + Node(Node(left, value, a, Black), y, balance(Node(b, z, redden(c), Black)), Red) + + a -> a // TODO This should never happen + } + } +} + +fun balance-right(left: tree, value: a, right: tree): tree { + match (right) { + Node(b, y, c, Red) -> + Node(left, value, Node(b, y, c, Black), Red) + + _ -> match (left) { + Node(a, x, b, Black) -> + balance(Node(Node(a, x, b, Red), value, right, Black)) + + Node(a, x, Node(b, y, c, Black), Red) -> + Node(balance(Node(redden(a), x, b, Black)), y, Node(c, value, right, Black), Red) + + a -> a // TODO This should never happen + } + } +} + +// TODO remove the div effect +fun unsafe-merge(left: tree, right: tree): div tree { + // TODO replace this with multi-pattern matching + match ((left, right)) { + (Empty, _) -> right + (_, Empty) -> left + + (Node(a, x, b, Red), Node(c, y, d, Red)) -> + match (unsafe-merge(b, c)) { + Node(b1, z, c1, Red) -> Node(Node(a, x, b1, Red), z, Node(c1, y, d, Red), Red) + bc -> Node(a, x, Node(bc, y, d, Red), Red) + } + + (Node(a, x, b, Black), Node(c, y, d, Black)) -> + match (unsafe-merge(b, c)) { + Node(b1, z, c1, Red) -> Node(Node(a, x, b1, Black), z, Node(c1, y, d, Black), Red) + bc -> balance-left(a, x, Node(bc, y, d, Black)) + } + + (_, Node(b, x, c, Red)) -> + Node(unsafe-merge(left, b), x, c, Red) + + (Node(a, x, b, Red), _) -> + Node(a, x, unsafe-merge(b, right), Red) + + _ -> left // TODO remove this after Koka's exhaustiveness checker is fixed + } +} + + +fun blacken(tree: tree): tree { + match (tree) { + Node(left, value, right, Red) -> Node(left, value, right, Black) + a -> a + } +} + +fun redden(tree: tree): tree { + match (tree) { + Node(left, value, right, Black) -> Node(left, value, right, Red) + a -> a // TODO This should never happen + } +} + + +fun unsafe-insert1(tree: tree, value: a, compare: (a, a) -> order): tree { + match (tree) { + Node(left, middle, right, color) -> + match (compare(value, middle)) { + Lt -> balance(Node(unsafe-insert1(left, value, compare), middle, right, color)) + Eq -> Node(left, value, right, color) // TODO return the Node unchanged if value is equal to middle + Gt -> balance(Node(left, middle, unsafe-insert1(right, value, compare), color)) + } + + Empty -> Node(empty, value, empty, Red) + } +} + +// This is unsafe because it's possible to use different compare functions on the same tree +public fun unsafe-insert(tree: tree, value: a, compare: (a, a) -> order): tree { + blacken(unsafe-insert1(tree, value, compare)) +} + + +// TODO remove the div effect +fun unsafe-remove1(tree: tree, value: a, compare: (a, a) -> order): div tree { + match (tree) { + Node(left, middle, right, _) -> + match (compare(value, middle)) { + Lt -> match (left) { + Node(_, _, _, Black) -> balance-left(unsafe-remove1(left, value, compare), middle, right) + _ -> Node(unsafe-remove1(left, value, compare), middle, right, Red) + } + + Eq -> unsafe-merge(left, right) + + Gt -> match (right) { + Node(_, _, _, Black) -> balance-right(left, middle, unsafe-remove1(right, value, compare)) + _ -> Node(left, middle, unsafe-remove1(right, value, compare), Red) + } + } + + Empty -> tree + } +} + +// TODO remove the div effect +// This is unsafe because it's possible to use different compare functions on the same tree +public fun unsafe-remove(tree: tree, value: a, compare: (a, a) -> order): div tree { + blacken(unsafe-remove1(tree, value, compare)) +} From 10f9ae12f8d9211eea1874ca896f5ba8225a0d6c Mon Sep 17 00:00:00 2001 From: Pauan Date: Thu, 6 Jul 2017 14:02:57 -1000 Subject: [PATCH 2/9] Adding in unreachable function to core --- lib/std/core.kk | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/lib/std/core.kk b/lib/std/core.kk index e47034a6a..1a8ae1969 100644 --- a/lib/std/core.kk +++ b/lib/std/core.kk @@ -160,6 +160,7 @@ type exception type open exception-info { Error Assert + Unreachable Todo Range Pattern( location : string, definition : string ) @@ -2583,7 +2584,11 @@ fun assert( message : string, condition : bool ) : () { if (!condition) unsafe-noexn{ throw(message,Assert) } } -fun todo( message : string ) : () { +fun unreachable() : a { + unsafe-noexn{ throw("BUG: this should never happen",Unreachable) } +} + +fun todo( message : string ) : a { unsafe-noexn{ throw(message,Todo) } } From 6e824cac621d06837647d14fc83f58d7e582aa22 Mon Sep 17 00:00:00 2001 From: Pauan Date: Thu, 6 Jul 2017 14:03:50 -1000 Subject: [PATCH 3/9] Various improvements and bug fixes to red-black-tree.kk --- lib/std/data/red-black-tree.kk | 100 ++++++++++++++++++++------------- 1 file changed, 60 insertions(+), 40 deletions(-) diff --git a/lib/std/data/red-black-tree.kk b/lib/std/data/red-black-tree.kk index a8edc6757..8c8f37369 100644 --- a/lib/std/data/red-black-tree.kk +++ b/lib/std/data/red-black-tree.kk @@ -53,24 +53,31 @@ public fun unsafe-lookup(tree: tree, key: b, compare: (b, a) -> order): maybe } -fun to-list1(tree: tree, acc: list): list { +public fun foldl(tree: tree, initial: b, fn: (b, a) -> e b): e b { match (tree) { - Node(left, value, right, _) -> - to-list1(left, Cons(value, to-list1(right, acc))) + Node(left, value, right, _) -> foldl(right, fn(foldl(left, initial, fn), value), fn) + Empty -> initial + } +} - Empty -> acc + +public fun foldr(tree: tree, initial: b, fn: (a, b) -> e b): e b { + match (tree) { + Node(left, value, right, _) -> foldr(left, fn(value, foldr(right, initial, fn)), fn) + Empty -> initial } } + public fun to-list(tree: tree): list { - to-list1(tree, []) + tree.foldr([], Cons) } // TODO should this be called unsafe ? public fun from-list(list: list, compare: (a, a) -> order): tree { list.foldl(empty) fun(l, r) { - unsafe-insert(l, r, compare) + unsafe-insert(l, r, compare, True) } } @@ -105,7 +112,7 @@ fun balance-left(left: tree, value: a, right: tree): tree { Node(Node(a, y, b, Black), z, c, Red) -> Node(Node(left, value, a, Black), y, balance(Node(b, z, redden(c), Black)), Red) - a -> a // TODO This should never happen + _ -> unreachable() } } } @@ -122,37 +129,44 @@ fun balance-right(left: tree, value: a, right: tree): tree { Node(a, x, Node(b, y, c, Black), Red) -> Node(balance(Node(redden(a), x, b, Black)), y, Node(c, value, right, Black), Red) - a -> a // TODO This should never happen + _ -> unreachable() } } } -// TODO remove the div effect -fun unsafe-merge(left: tree, right: tree): div tree { - // TODO replace this with multi-pattern matching - match ((left, right)) { - (Empty, _) -> right - (_, Empty) -> left +fun unsafe-merge(left: tree, right: tree): tree { + // TODO replace this with multi-pattern matching ? + match (left) { + Empty -> right - (Node(a, x, b, Red), Node(c, y, d, Red)) -> - match (unsafe-merge(b, c)) { - Node(b1, z, c1, Red) -> Node(Node(a, x, b1, Red), z, Node(c1, y, d, Red), Red) - bc -> Node(a, x, Node(bc, y, d, Red), Red) - } + Node(a, x, b, Red) -> match (right) { + Empty -> left - (Node(a, x, b, Black), Node(c, y, d, Black)) -> - match (unsafe-merge(b, c)) { - Node(b1, z, c1, Red) -> Node(Node(a, x, b1, Black), z, Node(c1, y, d, Black), Red) - bc -> balance-left(a, x, Node(bc, y, d, Black)) - } + Node(c, y, d, Red) -> + match (unsafe-merge(b, c)) { + Node(b1, z, c1, Red) -> Node(Node(a, x, b1, Red), z, Node(c1, y, d, Red), Red) + bc -> Node(a, x, Node(bc, y, d, Red), Red) + } - (_, Node(b, x, c, Red)) -> - Node(unsafe-merge(left, b), x, c, Red) + _ -> Node(a, x, unsafe-merge(b, right), Red) + } + + Node(a, x, b, Black) -> match (right) { + Empty -> left - (Node(a, x, b, Red), _) -> - Node(a, x, unsafe-merge(b, right), Red) + Node(c, y, d, Black) -> + match (unsafe-merge(b, c)) { + Node(b1, z, c1, Red) -> Node(Node(a, x, b1, Black), z, Node(c1, y, d, Black), Red) + bc -> balance-left(a, x, Node(bc, y, d, Black)) + } - _ -> left // TODO remove this after Koka's exhaustiveness checker is fixed + Node(b1, x1, c, Red) -> + Node(unsafe-merge(left, b1), x1, c, Red) + + _ -> unreachable() // TODO remove this after Koka's exhaustiveness checker is fixed + } + + _ -> unreachable() // TODO remove this after Koka's exhaustiveness checker is fixed } } @@ -167,18 +181,26 @@ fun blacken(tree: tree): tree { fun redden(tree: tree): tree { match (tree) { Node(left, value, right, Black) -> Node(left, value, right, Red) - a -> a // TODO This should never happen + _ -> unreachable() } } -fun unsafe-insert1(tree: tree, value: a, compare: (a, a) -> order): tree { +fun unsafe-insert1(tree: tree, value: a, compare: (a, a) -> order, replace: bool): tree { match (tree) { Node(left, middle, right, color) -> match (compare(value, middle)) { - Lt -> balance(Node(unsafe-insert1(left, value, compare), middle, right, color)) - Eq -> Node(left, value, right, color) // TODO return the Node unchanged if value is equal to middle - Gt -> balance(Node(left, middle, unsafe-insert1(right, value, compare), color)) + Lt -> balance(Node(unsafe-insert1(left, value, compare, replace), middle, right, color)) + + Gt -> balance(Node(left, middle, unsafe-insert1(right, value, compare, replace), color)) + + Eq -> if (replace) { + // TODO in this situation we should avoid balancing, because the structure hasn't changed + Node(left, value, right, color) // TODO return the Node unchanged if value is equal to middle + } else { + // TODO in this situation we should immediately return all the way to the root, because nothing has changed + tree + } } Empty -> Node(empty, value, empty, Red) @@ -186,13 +208,12 @@ fun unsafe-insert1(tree: tree, value: a, compare: (a, a) -> order): tree { } // This is unsafe because it's possible to use different compare functions on the same tree -public fun unsafe-insert(tree: tree, value: a, compare: (a, a) -> order): tree { - blacken(unsafe-insert1(tree, value, compare)) +public fun unsafe-insert(tree: tree, value: a, compare: (a, a) -> order, replace: bool): tree { + blacken(unsafe-insert1(tree, value, compare, replace)) } -// TODO remove the div effect -fun unsafe-remove1(tree: tree, value: a, compare: (a, a) -> order): div tree { +fun unsafe-remove1(tree: tree, value: a, compare: (a, a) -> order): tree { match (tree) { Node(left, middle, right, _) -> match (compare(value, middle)) { @@ -213,8 +234,7 @@ fun unsafe-remove1(tree: tree, value: a, compare: (a, a) -> order): div tree< } } -// TODO remove the div effect // This is unsafe because it's possible to use different compare functions on the same tree -public fun unsafe-remove(tree: tree, value: a, compare: (a, a) -> order): div tree { +public fun unsafe-remove(tree: tree, value: a, compare: (a, a) -> order): tree { blacken(unsafe-remove1(tree, value, compare)) } From 3cd141a286cf0b546b9639888a83cd6bcd9130b3 Mon Sep 17 00:00:00 2001 From: Pauan Date: Thu, 6 Jul 2017 14:03:58 -1000 Subject: [PATCH 4/9] Adding in set.kk --- lib/std/data/set.kk | 103 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 103 insertions(+) create mode 100644 lib/std/data/set.kk diff --git a/lib/std/data/set.kk b/lib/std/data/set.kk new file mode 100644 index 000000000..b450be913 --- /dev/null +++ b/lib/std/data/set.kk @@ -0,0 +1,103 @@ +/*--------------------------------------------------------------------------- + Copyright 2017 Microsoft Corporation. + + This is free software; you can redistribute it and/or modify it under the + terms of the Apache License, Version 2.0. A copy of the License can be + found in the file "license.txt" at the root of this distribution. +---------------------------------------------------------------------------*/ + +// TODO unit tests +module std/data/set + +import red-black-tree + + +abstract struct set( + compare: (a, a) -> order, + tree: tree +) + +public fun from-list(list: list, compare: (a, a) -> order): set { + Set(compare, from-list(list, compare)) +} + +public fun to-list(set: set): list { + to-list(set.tree) +} + +public fun empty(compare: (a, a) -> order): set { + Set(compare, empty) +} + +public fun has?(set: set, value: a): bool { + // TODO this can be implemented faster + bool(unsafe-lookup(set.tree, value, set.compare)) +} + +public fun insert(set: set, value: a): set { + set(tree = unsafe-insert(set.tree, value, set.compare, True)) +} + +// TODO remove the div effect +public fun remove(set: set, value: a): div set { + set(tree = unsafe-remove(set.tree, value, set.compare)) +} + +// TODO remove the div effect +public fun exclude(set: set, exclude: set): div set { + val compare = set.compare + set( + tree = exclude.tree.foldl(set.tree) fun(old, value) { + unsafe-remove(old, value, compare) + } + ) +} + +public fun intersection-right(left: set, right: set): set { + val compare = right.compare + right( + tree = right.tree.foldl(empty) fun(old, value) { + if (left.has?(value)) { + unsafe-insert(old, value, compare, True) + } else { + old + } + } + ) +} + +public fun intersection-left(left: set, right: set): set { + intersection-right(right, left) +} + +// TODO remove the div effect +public fun difference-left(left: set, right: set): div set { + // TODO implement this more efficiently + union-left(exclude(left, right), exclude(right, left)) +} + +// TODO remove the div effect +public fun difference-right(left: set, right: set): div set { + // TODO implement this more efficiently + union-right(exclude(left, right), exclude(right, left)) +} + +public fun union-left(left: set, right: set): set { + val compare = left.compare + left( + tree = right.tree.foldl(left.tree) fun(old, value) { + // If a value exists in both `left` and `right` it will prefer the value from `left` + unsafe-insert(old, value, compare, False) + } + ) +} + +public fun union-right(left: set, right: set): set { + val compare = right.compare + right( + tree = left.tree.foldl(right.tree) fun(old, value) { + // If a value exists in both `left` and `right` it will prefer the value from `right` + unsafe-insert(old, value, compare, False) + } + ) +} From 14491546899db39e13c4e2efea4a18cfe4d80ba2 Mon Sep 17 00:00:00 2001 From: Pauan Date: Thu, 6 Jul 2017 14:42:49 -1000 Subject: [PATCH 5/9] 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 { } -fun color(tree: tree): color { - match (tree) { - Empty -> Black - Node(_, _, _, color) -> color - } -} - - public val empty: forall tree = Empty @@ -38,7 +30,7 @@ public fun single(value: a): tree { // This is unsafe because it's possible to use different compare functions on the same tree -public fun unsafe-lookup(tree: tree, key: b, compare: (b, a) -> order): maybe { +public fun unsafe-lookup(tree: tree, key: b, compare: (b, a) -> e order): e maybe { match (tree) { Node(left, value, right, _) -> match (compare(key, value)) { @@ -53,6 +45,21 @@ public fun unsafe-lookup(tree: tree, key: b, compare: (b, a) -> order): maybe } +// TODO implement this more efficiently +public fun find-first(tree: tree, fn: (a) -> e maybe): e maybe { + 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, 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, initial: b, fn: (a, b) -> e b): e b { } +public fun map(tree: tree, fn: (a) -> e b): e tree { + 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): list { tree.foldr([], Cons) } // TODO should this be called unsafe ? -public fun from-list(list: list, compare: (a, a) -> order): tree { +public fun from-list(list: list, compare: (a, a) -> e order): e tree { list.foldl(empty) fun(l, r) { unsafe-insert(l, r, compare, True) } @@ -186,7 +202,7 @@ fun redden(tree: tree): tree { } -fun unsafe-insert1(tree: tree, value: a, compare: (a, a) -> order, replace: bool): tree { +fun unsafe-insert1(tree: tree, value: a, compare: (a, a) -> e order, replace: bool): e tree { match (tree) { Node(left, middle, right, color) -> match (compare(value, middle)) { @@ -208,12 +224,12 @@ fun unsafe-insert1(tree: tree, 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, value: a, compare: (a, a) -> order, replace: bool): tree { +public fun unsafe-insert(tree: tree, value: a, compare: (a, a) -> e order, replace: bool): e tree { blacken(unsafe-insert1(tree, value, compare, replace)) } -fun unsafe-remove1(tree: tree, value: a, compare: (a, a) -> order): tree { +fun unsafe-remove1(tree: tree, value: a, compare: (a, a) -> e order): e tree { match (tree) { Node(left, middle, right, _) -> match (compare(value, middle)) { @@ -235,6 +251,6 @@ fun unsafe-remove1(tree: tree, value: a, compare: (a, a) -> order): tree { } // This is unsafe because it's possible to use different compare functions on the same tree -public fun unsafe-remove(tree: tree, value: a, compare: (a, a) -> order): tree { +public fun unsafe-remove(tree: tree, value: a, compare: (a, a) -> e order): e tree { 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, value: a): set { set(tree = unsafe-insert(set.tree, value, set.compare, True)) } -// TODO remove the div effect -public fun remove(set: set, value: a): div set { +public fun remove(set: set, value: a): set { set(tree = unsafe-remove(set.tree, value, set.compare)) } -// TODO remove the div effect -public fun exclude(set: set, exclude: set): div set { +public fun exclude(set: set, exclude: set): set { val compare = set.compare set( tree = exclude.tree.foldl(set.tree) fun(old, value) { @@ -70,14 +72,12 @@ public fun intersection-left(left: set, right: set): set { intersection-right(right, left) } -// TODO remove the div effect -public fun difference-left(left: set, right: set): div set { +public fun difference-left(left: set, right: set): set { // TODO implement this more efficiently union-left(exclude(left, right), exclude(right, left)) } -// TODO remove the div effect -public fun difference-right(left: set, right: set): div set { +public fun difference-right(left: set, right: set): set { // TODO implement this more efficiently union-right(exclude(left, right), exclude(right, left)) } @@ -101,3 +101,13 @@ public fun union-right(left: set, right: set): set { } ) } + +public fun subset-of?(smaller: set, bigger: set): bool { + smaller.tree.find-first fun(value) { + if (bigger.has?(value)) { + Nothing + } else { + Just(False) + } + }.default(True) +} From d827072567a2936499298d9279845ff1425ee0f5 Mon Sep 17 00:00:00 2001 From: Pauan Date: Mon, 10 Jul 2017 18:37:56 -1000 Subject: [PATCH 6/9] Renaming set.kk to sorted-set.kk --- lib/std/data/{set.kk => sorted-set.kk} | 32 +++++++++++++------------- 1 file changed, 16 insertions(+), 16 deletions(-) rename lib/std/data/{set.kk => sorted-set.kk} (68%) diff --git a/lib/std/data/set.kk b/lib/std/data/sorted-set.kk similarity index 68% rename from lib/std/data/set.kk rename to lib/std/data/sorted-set.kk index 23f961c87..cc0c83463 100644 --- a/lib/std/data/set.kk +++ b/lib/std/data/sorted-set.kk @@ -11,42 +11,42 @@ // TODO power set // TODO cartesian product // TODO maybe allow for compare functions with effects -module std/data/set +module std/data/sorted-set import red-black-tree -abstract struct set( +abstract struct sorted-set( compare: (a, a) -> order, tree: tree ) -public fun from-list(list: list, compare: (a, a) -> order): set { +public fun from-list(list: list, compare: (a, a) -> order): sorted-set { Set(compare, from-list(list, compare)) } -public fun to-list(set: set): list { +public fun to-list(set: sorted-set): list { to-list(set.tree) } -public fun empty(compare: (a, a) -> order): set { +public fun empty(compare: (a, a) -> order): sorted-set { Set(compare, empty) } -public fun has?(set: set, value: a): bool { +public fun has?(set: sorted-set, value: a): bool { // TODO this can be implemented faster bool(unsafe-lookup(set.tree, value, set.compare)) } -public fun insert(set: set, value: a): set { +public fun insert(set: sorted-set, value: a): sorted-set { set(tree = unsafe-insert(set.tree, value, set.compare, True)) } -public fun remove(set: set, value: a): set { +public fun remove(set: sorted-set, value: a): sorted-set { set(tree = unsafe-remove(set.tree, value, set.compare)) } -public fun exclude(set: set, exclude: set): set { +public fun exclude(set: sorted-set, exclude: sorted-set): sorted-set { val compare = set.compare set( tree = exclude.tree.foldl(set.tree) fun(old, value) { @@ -55,7 +55,7 @@ public fun exclude(set: set, exclude: set): set { ) } -public fun intersection-right(left: set, right: set): set { +public fun intersection-right(left: sorted-set, right: sorted-set): sorted-set { val compare = right.compare right( tree = right.tree.foldl(empty) fun(old, value) { @@ -68,21 +68,21 @@ public fun intersection-right(left: set, right: set): set { ) } -public fun intersection-left(left: set, right: set): set { +public fun intersection-left(left: sorted-set, right: sorted-set): sorted-set { intersection-right(right, left) } -public fun difference-left(left: set, right: set): set { +public fun difference-left(left: sorted-set, right: sorted-set): sorted-set { // TODO implement this more efficiently union-left(exclude(left, right), exclude(right, left)) } -public fun difference-right(left: set, right: set): set { +public fun difference-right(left: sorted-set, right: sorted-set): sorted-set { // TODO implement this more efficiently union-right(exclude(left, right), exclude(right, left)) } -public fun union-left(left: set, right: set): set { +public fun union-left(left: sorted-set, right: sorted-set): sorted-set { val compare = left.compare left( tree = right.tree.foldl(left.tree) fun(old, value) { @@ -92,7 +92,7 @@ public fun union-left(left: set, right: set): set { ) } -public fun union-right(left: set, right: set): set { +public fun union-right(left: sorted-set, right: sorted-set): sorted-set { val compare = right.compare right( tree = left.tree.foldl(right.tree) fun(old, value) { @@ -102,7 +102,7 @@ public fun union-right(left: set, right: set): set { ) } -public fun subset-of?(smaller: set, bigger: set): bool { +public fun subset-of?(smaller: sorted-set, bigger: sorted-set): bool { smaller.tree.find-first fun(value) { if (bigger.has?(value)) { Nothing From 6a96ce2f07a582577e12341b87e362bbce10aba7 Mon Sep 17 00:00:00 2001 From: Pauan Date: Mon, 10 Jul 2017 18:39:42 -1000 Subject: [PATCH 7/9] Fixing some errors --- lib/std/data/sorted-set.kk | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/std/data/sorted-set.kk b/lib/std/data/sorted-set.kk index cc0c83463..800266821 100644 --- a/lib/std/data/sorted-set.kk +++ b/lib/std/data/sorted-set.kk @@ -22,7 +22,7 @@ abstract struct sorted-set( ) public fun from-list(list: list, compare: (a, a) -> order): sorted-set { - Set(compare, from-list(list, compare)) + Sorted-set(compare, from-list(list, compare)) } public fun to-list(set: sorted-set): list { @@ -30,7 +30,7 @@ public fun to-list(set: sorted-set): list { } public fun empty(compare: (a, a) -> order): sorted-set { - Set(compare, empty) + Sorted-set(compare, empty) } public fun has?(set: sorted-set, value: a): bool { From 05196486c9aa2edc1beecf5981751ab43aaccfaa Mon Sep 17 00:00:00 2001 From: Pauan Date: Mon, 10 Jul 2017 19:18:14 -1000 Subject: [PATCH 8/9] Adding in std/data/sorted-dict.kk --- lib/std/data/red-black-tree.kk | 32 ++++++------ lib/std/data/sorted-dict.kk | 94 ++++++++++++++++++++++++++++++++++ lib/std/data/sorted-set.kk | 10 ++-- 3 files changed, 115 insertions(+), 21 deletions(-) create mode 100644 lib/std/data/sorted-dict.kk diff --git a/lib/std/data/red-black-tree.kk b/lib/std/data/red-black-tree.kk index 5ef0b15ad..ec09dff8c 100644 --- a/lib/std/data/red-black-tree.kk +++ b/lib/std/data/red-black-tree.kk @@ -91,9 +91,9 @@ public fun to-list(tree: tree): list { // TODO should this be called unsafe ? -public fun from-list(list: list, compare: (a, a) -> e order): e tree { +public fun from-list(list: list, map: (a) -> e b, compare: (b, a) -> e order): e tree { list.foldl(empty) fun(l, r) { - unsafe-insert(l, r, compare, True) + unsafe-insert(l, map(r), r, compare, True) } } @@ -202,13 +202,13 @@ fun redden(tree: tree): tree { } -fun unsafe-insert1(tree: tree, value: a, compare: (a, a) -> e order, replace: bool): e tree { +fun unsafe-insert1(tree: tree, key: b, value: a, compare: (b, a) -> e order, replace: bool): e tree { match (tree) { Node(left, middle, right, color) -> - match (compare(value, middle)) { - Lt -> balance(Node(unsafe-insert1(left, value, compare, replace), middle, right, color)) + match (compare(key, middle)) { + Lt -> balance(Node(unsafe-insert1(left, key, value, compare, replace), middle, right, color)) - Gt -> balance(Node(left, middle, unsafe-insert1(right, value, compare, replace), color)) + Gt -> balance(Node(left, middle, unsafe-insert1(right, key, value, compare, replace), color)) Eq -> if (replace) { // TODO in this situation we should avoid balancing, because the structure hasn't changed @@ -224,25 +224,25 @@ fun unsafe-insert1(tree: tree, value: a, compare: (a, a) -> e order, replace: } // This is unsafe because it's possible to use different compare functions on the same tree -public fun unsafe-insert(tree: tree, value: a, compare: (a, a) -> e order, replace: bool): e tree { - blacken(unsafe-insert1(tree, value, compare, replace)) +public fun unsafe-insert(tree: tree, key: b, value: a, compare: (b, a) -> e order, replace: bool): e tree { + blacken(unsafe-insert1(tree, key, value, compare, replace)) } -fun unsafe-remove1(tree: tree, value: a, compare: (a, a) -> e order): e tree { +fun unsafe-remove1(tree: tree, key: b, compare: (b, a) -> e order): e tree { match (tree) { Node(left, middle, right, _) -> - match (compare(value, middle)) { + match (compare(key, middle)) { Lt -> match (left) { - Node(_, _, _, Black) -> balance-left(unsafe-remove1(left, value, compare), middle, right) - _ -> Node(unsafe-remove1(left, value, compare), middle, right, Red) + Node(_, _, _, Black) -> balance-left(unsafe-remove1(left, key, compare), middle, right) + _ -> Node(unsafe-remove1(left, key, compare), middle, right, Red) } Eq -> unsafe-merge(left, right) Gt -> match (right) { - Node(_, _, _, Black) -> balance-right(left, middle, unsafe-remove1(right, value, compare)) - _ -> Node(left, middle, unsafe-remove1(right, value, compare), Red) + Node(_, _, _, Black) -> balance-right(left, middle, unsafe-remove1(right, key, compare)) + _ -> Node(left, middle, unsafe-remove1(right, key, compare), Red) } } @@ -251,6 +251,6 @@ fun unsafe-remove1(tree: tree, value: a, compare: (a, a) -> e order): e tree< } // This is unsafe because it's possible to use different compare functions on the same tree -public fun unsafe-remove(tree: tree, value: a, compare: (a, a) -> e order): e tree { - blacken(unsafe-remove1(tree, value, compare)) +public fun unsafe-remove(tree: tree, key: b, compare: (b, a) -> e order): e tree { + blacken(unsafe-remove1(tree, key, compare)) } diff --git a/lib/std/data/sorted-dict.kk b/lib/std/data/sorted-dict.kk new file mode 100644 index 000000000..d88e4a4ee --- /dev/null +++ b/lib/std/data/sorted-dict.kk @@ -0,0 +1,94 @@ +/*--------------------------------------------------------------------------- + Copyright 2017 Microsoft Corporation. + + This is free software; you can redistribute it and/or modify it under the + terms of the Apache License, Version 2.0. A copy of the License can be + found in the file "license.txt" at the root of this distribution. +---------------------------------------------------------------------------*/ + +// TODO unit tests +// TODO maybe allow for compare functions with effects +// TODO maybe add in the other functions from sorted-set +module std/data/sorted-dict + +import red-black-tree + + +abstract struct sorted-dict( + compare: (k, (k, a)) -> order, + tree: tree<(k, a)> +) + +fun from-compare(compare: (k, k) -> order): ((k, (k, a)) -> order) { + (fun(k1, v2) { + match (v2) { + (k2, _) -> compare(k1, k2) + } + }) +} + +public fun from-list(list: list<(k, a)>, compare: (k, k) -> order): sorted-dict { + val compare2 = from-compare(compare) + Sorted-dict(compare2, from-list(list, fst, compare2)) +} + +public fun to-list(dict: sorted-dict): list<(k, a)> { + to-list(dict.tree) +} + +public fun empty(compare: (k, k) -> order): sorted-dict { + Sorted-dict(from-compare(compare), empty) +} + +public fun get(dict: sorted-dict, key: k): maybe { + unsafe-lookup(dict.tree, key, dict.compare).map(snd) +} + +public fun has?(dict: sorted-dict, key: k): bool { + // TODO this can be implemented faster + bool(get(dict, key)) +} + +public fun set(dict: sorted-dict, key: k, value: a): sorted-dict { + dict(tree = unsafe-insert(dict.tree, key, (key, value), dict.compare, True)) +} + +public fun remove(dict: sorted-dict, key: k): sorted-dict { + dict(tree = unsafe-remove(dict.tree, key, dict.compare)) +} + +public fun merge-left(left: sorted-dict, right: sorted-dict): sorted-dict { + val compare = left.compare + left( + tree = right.tree.foldl(left.tree) fun(old, a) { + match (a) { + // If a value exists in both `left` and `right` it will prefer the value from `left` + (key, _) -> unsafe-insert(old, key, a, compare, False) + } + } + ) +} + +public fun merge-right(left: sorted-dict, right: sorted-dict): sorted-dict { + val compare = right.compare + right( + tree = left.tree.foldl(right.tree) fun(old, a) { + match (a) { + // If a value exists in both `left` and `right` it will prefer the value from `right` + (key, _) -> unsafe-insert(old, key, a, compare, False) + } + } + ) +} + +public fun subset-of?(smaller: sorted-dict, bigger: sorted-dict): bool { + smaller.tree.find-first fun(a) { + match (a) { + (key, _) -> if (bigger.has?(key)) { + Nothing + } else { + Just(False) + } + } + }.default(True) +} diff --git a/lib/std/data/sorted-set.kk b/lib/std/data/sorted-set.kk index 800266821..19fd1c5be 100644 --- a/lib/std/data/sorted-set.kk +++ b/lib/std/data/sorted-set.kk @@ -22,7 +22,7 @@ abstract struct sorted-set( ) public fun from-list(list: list, compare: (a, a) -> order): sorted-set { - Sorted-set(compare, from-list(list, compare)) + Sorted-set(compare, from-list(list, id, compare)) } public fun to-list(set: sorted-set): list { @@ -39,7 +39,7 @@ public fun has?(set: sorted-set, value: a): bool { } public fun insert(set: sorted-set, value: a): sorted-set { - set(tree = unsafe-insert(set.tree, value, set.compare, True)) + set(tree = unsafe-insert(set.tree, value, value, set.compare, True)) } public fun remove(set: sorted-set, value: a): sorted-set { @@ -60,7 +60,7 @@ public fun intersection-right(left: sorted-set, right: sorted-set): sorted right( tree = right.tree.foldl(empty) fun(old, value) { if (left.has?(value)) { - unsafe-insert(old, value, compare, True) + unsafe-insert(old, value, value, compare, True) } else { old } @@ -87,7 +87,7 @@ public fun union-left(left: sorted-set, right: sorted-set): sorted-set left( tree = right.tree.foldl(left.tree) fun(old, value) { // If a value exists in both `left` and `right` it will prefer the value from `left` - unsafe-insert(old, value, compare, False) + unsafe-insert(old, value, value, compare, False) } ) } @@ -97,7 +97,7 @@ public fun union-right(left: sorted-set, right: sorted-set): sorted-set right( tree = left.tree.foldl(right.tree) fun(old, value) { // If a value exists in both `left` and `right` it will prefer the value from `right` - unsafe-insert(old, value, compare, False) + unsafe-insert(old, value, value, compare, False) } ) } From 156b741a0ebb61813cb1b8c61c1c409ac768cc47 Mon Sep 17 00:00:00 2001 From: Pauan Date: Mon, 10 Jul 2017 23:36:41 -1000 Subject: [PATCH 9/9] Adding in [] lookup syntax for sorted-dict --- lib/std/data/sorted-dict.kk | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/lib/std/data/sorted-dict.kk b/lib/std/data/sorted-dict.kk index d88e4a4ee..fcffeddc3 100644 --- a/lib/std/data/sorted-dict.kk +++ b/lib/std/data/sorted-dict.kk @@ -40,13 +40,19 @@ public fun empty(compare: (k, k) -> order): sorted-dict { Sorted-dict(from-compare(compare), empty) } -public fun get(dict: sorted-dict, key: k): maybe { +public fun [](dict: sorted-dict, key: k): maybe { unsafe-lookup(dict.tree, key, dict.compare).map(snd) } +// TODO inline this +// TODO maybe it shouldn't include this ? +public fun [](dict: sorted-dict, key: k, value: a): sorted-dict { + set(dict, key, value) +} + public fun has?(dict: sorted-dict, key: k): bool { // TODO this can be implemented faster - bool(get(dict, key)) + bool(dict[key]) } public fun set(dict: sorted-dict, key: k, value: a): sorted-dict {