aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source')
-rw-r--r--stdlib/source/lux/data/coll/ordered/dict.lux (renamed from stdlib/source/lux/data/coll/ordered.lux)387
-rw-r--r--stdlib/source/lux/data/coll/ordered/set.lux86
2 files changed, 314 insertions, 159 deletions
diff --git a/stdlib/source/lux/data/coll/ordered.lux b/stdlib/source/lux/data/coll/ordered/dict.lux
index 5a9794f85..714f14b5d 100644
--- a/stdlib/source/lux/data/coll/ordered.lux
+++ b/stdlib/source/lux/data/coll/ordered/dict.lux
@@ -3,7 +3,7 @@
(lux (control monad
eq
[order #+ Order])
- (data (coll [list "" Monad<List> "L/" Monoid<List> Fold<List>])
+ (data (coll [list "L/" Monad<List> Monoid<List> Fold<List>])
["p" product]
["M" maybe #+ Functor<Maybe>])
[macro]
@@ -14,16 +14,18 @@
(type: Color #Red #Black)
-(type: (Node a)
+(type: (Node k v)
{#color Color
- #value a
- #left (Maybe (Node a))
- #right (Maybe (Node a))})
+ #key k
+ #value v
+ #left (Maybe (Node k v))
+ #right (Maybe (Node k v))})
(do-template [<create> <color>]
- [(def: (<create> value left right)
- (All [a] (-> a (Maybe (Node a)) (Maybe (Node a)) (Node a)))
+ [(def: (<create> key value left right)
+ (All [k v] (-> k v (Maybe (Node k v)) (Maybe (Node k v)) (Node k v)))
{#color <color>
+ #key key
#value value
#left left
#right right})]
@@ -32,47 +34,82 @@
[black #Black]
)
-(type: #export (Set a)
- {#order (Order a)
- #root (Maybe (Node a))})
+(type: #export (Dict k v)
+ {#order (Order k)
+ #root (Maybe (Node k v))})
-(def: #export (new Order<a>)
- (All [a] (-> (Order a) (Set a)))
- {#order Order<a>
+(def: #export (new Order<k>)
+ (All [k v] (-> (Order k) (Dict k v)))
+ {#order Order<k>
#root #;None})
-(def: #export (member? tree elem)
- (All [a] (-> (Set a) a Bool))
- (let [(^open "T/") (get@ #order tree)]
- (loop [node (get@ #root tree)]
+## TODO: Doing inneficient access of Order functions due to compiler bug.
+## TODO: Must improve it as soon as bug is fixed.
+(def: #export (get key dict)
+ (All [k v] (-> k (Dict k v) (Maybe v)))
+ (let [## (^open "T/") (get@ #order dict)
+ ]
+ (loop [node (get@ #root dict)]
+ (case node
+ #;None
+ #;None
+
+ (#;Some node)
+ (let [node-key (get@ #key node)]
+ (cond (:: dict = node-key key)
+ ## (T/= node-key key)
+ (#;Some (get@ #value node))
+
+ (:: dict < node-key key)
+ ## (T/< node-key key)
+ (recur (get@ #left node))
+
+ ## (T/> (get@ #key node) key)
+ (recur (get@ #right node))))
+ ))))
+
+(def: #export (contains? key dict)
+ (All [k v] (-> k (Dict k v) Bool))
+ (let [## (^open "T/") (get@ #order dict)
+ ]
+ (loop [node (get@ #root dict)]
(case node
#;None
false
(#;Some node)
- (or (T/= elem (get@ #value node))
- (recur (get@ #left node))
- (recur (get@ #right node)))))))
+ (let [node-key (get@ #key node)]
+ (or (:: dict = node-key key)
+ ## (T/= node-key key)
+ (if (:: dict < node-key key)
+ ## (T/< node-key key)
+ (recur (get@ #left node))
+ (recur (get@ #right node)))))))))
(do-template [<name> <side>]
- [(def: #export (<name> tree)
- (All [a] (-> (Set a) (Maybe a)))
- (loop [node (get@ #root tree)]
- (case node
- #;None
- #;None
+ [(def: #export (<name> dict)
+ (All [k v] (-> (Dict k v) (Maybe v)))
+ (case (get@ #root dict)
+ #;None
+ #;None
- (#;Some node)
- (recur (get@ <side> node)))))]
+ (#;Some node)
+ (loop [node node]
+ (case (get@ <side> node)
+ #;None
+ (#;Some (get@ #value node))
+
+ (#;Some side)
+ (recur side)))))]
[min #left]
[max #right]
)
(do-template [<name> <op>]
- [(def: #export (<name> tree)
- (All [a] (-> (Set a) Nat))
- (loop [node (get@ #root tree)]
+ [(def: #export (<name> dict)
+ (All [k v] (-> (Dict k v) Nat))
+ (loop [node (get@ #root dict)]
(case node
#;None
+0
@@ -87,7 +124,7 @@
(do-template [<name> <other-color> <self-color> <no-change>]
[(def: (<name> self)
- (All [a] (-> (Node a) (Node a)))
+ (All [k v] (-> (Node k v) (Node k v)))
(case (get@ #color self)
<other-color>
(set@ #color <self-color> self)
@@ -101,9 +138,10 @@
)
(def: (balance-left-add parent self)
- (All [a] (-> (Node a) (Node a) (Node a)))
+ (All [k v] (-> (Node k v) (Node k v) (Node k v)))
(with-expansions
- [<default-behavior> (as-is (black (get@ #value parent)
+ [<default-behavior> (as-is (black (get@ #key parent)
+ (get@ #value parent)
(#;Some self)
(get@ #right parent)))]
(case (get@ #color self)
@@ -111,9 +149,11 @@
(case (get@ #left self)
(^multi (#;Some left)
[(get@ #color left) #Red])
- (red (get@ #value self)
+ (red (get@ #key self)
+ (get@ #value self)
(#;Some (blacken left))
- (#;Some (black (get@ #value parent)
+ (#;Some (black (get@ #key parent)
+ (get@ #value parent)
(get@ #right self)
(get@ #right parent))))
@@ -121,11 +161,14 @@
(case (get@ #right self)
(^multi (#;Some right)
[(get@ #color right) #Red])
- (red (get@ #value right)
- (#;Some (black (get@ #value self)
+ (red (get@ #key right)
+ (get@ #value right)
+ (#;Some (black (get@ #key self)
+ (get@ #value self)
(get@ #left self)
(get@ #left right)))
- (#;Some (black (get@ #value parent)
+ (#;Some (black (get@ #key parent)
+ (get@ #value parent)
(get@ #right right)
(get@ #right parent))))
@@ -137,9 +180,10 @@
)))
(def: (balance-right-add parent self)
- (All [a] (-> (Node a) (Node a) (Node a)))
+ (All [k v] (-> (Node k v) (Node k v) (Node k v)))
(with-expansions
- [<default-behavior> (as-is (black (get@ #value parent)
+ [<default-behavior> (as-is (black (get@ #key parent)
+ (get@ #value parent)
(get@ #left parent)
(#;Some self)))]
(case (get@ #color self)
@@ -147,8 +191,10 @@
(case (get@ #right self)
(^multi (#;Some right)
[(get@ #color right) #Red])
- (red (get@ #value self)
- (#;Some (black (get@ #value parent)
+ (red (get@ #key self)
+ (get@ #value self)
+ (#;Some (black (get@ #key parent)
+ (get@ #value parent)
(get@ #left parent)
(get@ #left self)))
(#;Some (blacken right)))
@@ -157,11 +203,14 @@
(case (get@ #left self)
(^multi (#;Some left)
[(get@ #color left) #Red])
- (red (get@ #value left)
- (#;Some (black (get@ #value parent)
+ (red (get@ #key left)
+ (get@ #value left)
+ (#;Some (black (get@ #key parent)
+ (get@ #value parent)
(get@ #left parent)
(get@ #left left)))
- (#;Some (black (get@ #value self)
+ (#;Some (black (get@ #key self)
+ (get@ #value self)
(get@ #right left)
(get@ #right self))))
@@ -173,38 +222,38 @@
)))
(def: (add-left addition center)
- (All [a] (-> (Node a) (Node a) (Node a)))
+ (All [k v] (-> (Node k v) (Node k v) (Node k v)))
(case (get@ #color center)
#Red
- (red (get@ #value center) (#;Some addition) (get@ #right center))
+ (red (get@ #key center) (get@ #value center) (#;Some addition) (get@ #right center))
#Black
(balance-left-add center addition)
))
(def: (add-right addition center)
- (All [a] (-> (Node a) (Node a) (Node a)))
+ (All [k v] (-> (Node k v) (Node k v) (Node k v)))
(case (get@ #color center)
#Red
- (red (get@ #value center) (get@ #left center) (#;Some addition))
+ (red (get@ #key center) (get@ #value center) (get@ #left center) (#;Some addition))
#Black
(balance-right-add center addition)
))
-(def: #export (add elem tree)
- (All [a] (-> a (Set a) (Set a)))
- (let [(^open "T/") (get@ #order tree)
- root' (loop [?root (get@ #root tree)]
+(def: #export (put key value dict)
+ (All [k v] (-> k v (Dict k v) (Dict k v)))
+ (let [(^open "T/") (get@ #order dict)
+ root' (loop [?root (get@ #root dict)]
(case ?root
#;None
- (#;Some (red elem #;None #;None))
+ (#;Some (red key value #;None #;None))
(#;Some root)
- (let [reference (get@ #value root)]
+ (let [reference (get@ #key root)]
(with-expansions
[<sides> (do-template [<comp> <tag> <add>]
- [(<comp> reference elem)
+ [(<comp> reference key)
(let [side-root (get@ <tag> root)
outcome (recur side-root)]
(if (is side-root outcome)
@@ -217,82 +266,90 @@
)]
(cond <sides>
- ## (T/= reference elem)
+ ## (T/= reference key)
?root
)))
))]
- (set@ #root root' tree)))
+ (set@ #root root' dict)))
-(def: (left-balance value ?left ?right)
- (All [a] (-> a (Maybe (Node a)) (Maybe (Node a)) (Node a)))
+(def: (left-balance key value ?left ?right)
+ (All [k v] (-> k v (Maybe (Node k v)) (Maybe (Node k v)) (Node k v)))
(case ?left
(^multi (#;Some left)
[(get@ #color left) #Red]
[(get@ #left left) (#;Some left.left)]
[(get@ #color left.left) #Red])
- (red (get@ #value left)
+ (red (get@ #key left)
+ (get@ #value left)
(#;Some (blacken left.left))
- (#;Some (black value (get@ #right left) ?right)))
+ (#;Some (black key value (get@ #right left) ?right)))
(^multi (#;Some left)
[(get@ #color left) #Red]
[(get@ #right left) (#;Some left.right)]
[(get@ #color left.right) #Red])
- (red (get@ #value left.right)
- (#;Some (black (get@ #value left)
+ (red (get@ #key left.right)
+ (get@ #value left.right)
+ (#;Some (black (get@ #key left)
+ (get@ #value left)
(get@ #left left)
(get@ #left left.right)))
- (#;Some (black value
+ (#;Some (black key value
(get@ #right left.right)
?right)))
_
- (black value ?left ?right)))
+ (black key value ?left ?right)))
-(def: (right-balance value ?left ?right)
- (All [a] (-> a (Maybe (Node a)) (Maybe (Node a)) (Node a)))
+(def: (right-balance key value ?left ?right)
+ (All [k v] (-> k v (Maybe (Node k v)) (Maybe (Node k v)) (Node k v)))
(case ?right
(^multi (#;Some right)
[(get@ #color right) #Red]
[(get@ #right right) (#;Some right.right)]
[(get@ #color right.right) #Red])
- (red (get@ #value right)
- (#;Some (black value ?left (get@ #left right)))
+ (red (get@ #key right)
+ (get@ #value right)
+ (#;Some (black key value ?left (get@ #left right)))
(#;Some (blacken right.right)))
(^multi (#;Some right)
[(get@ #color right) #Red]
[(get@ #left right) (#;Some right.left)]
[(get@ #color right.left) #Red])
- (red (get@ #value right.left)
- (#;Some (black value ?left (get@ #left right.left)))
- (#;Some (black (get@ #value right)
+ (red (get@ #key right.left)
+ (get@ #value right.left)
+ (#;Some (black key value ?left (get@ #left right.left)))
+ (#;Some (black (get@ #key right)
+ (get@ #value right)
(get@ #right right.left)
(get@ #right right))))
_
- (black value ?left ?right)))
+ (black key value ?left ?right)))
-(def: (balance-left-remove value ?left ?right)
- (All [a] (-> a (Maybe (Node a)) (Maybe (Node a)) (Node a)))
+(def: (balance-left-remove key value ?left ?right)
+ (All [k v] (-> k v (Maybe (Node k v)) (Maybe (Node k v)) (Node k v)))
(case ?left
(^multi (#;Some left)
[(get@ #color left) #Red])
- (red value (#;Some (blacken left)) ?right)
+ (red key value (#;Some (blacken left)) ?right)
_
(case ?right
(^multi (#;Some right)
[(get@ #color right) #Black])
- (right-balance value ?left (#;Some (redden right)))
+ (right-balance key value ?left (#;Some (redden right)))
(^multi (#;Some right)
[(get@ #color right) #Red]
[(get@ #left right) (#;Some right.left)]
[(get@ #color right.left) #Black])
- (red (get@ #value right.left)
- (#;Some (black value ?left (get@ #left right.left)))
- (#;Some (right-balance (get@ #value right)
+ (red (get@ #key right.left)
+ (get@ #value right.left)
+ (#;Some (black key value ?left (get@ #left right.left)))
+ (#;Some (right-balance (get@ #key right)
+ (get@ #value right)
(get@ #right right.left)
(:: Functor<Maybe> map redden (get@ #right right)))))
@@ -300,35 +357,37 @@
(error! error-message))
))
-(def: (balance-right-remove value ?left ?right)
- (All [a] (-> a (Maybe (Node a)) (Maybe (Node a)) (Node a)))
+(def: (balance-right-remove key value ?left ?right)
+ (All [k v] (-> k v (Maybe (Node k v)) (Maybe (Node k v)) (Node k v)))
(case ?right
(^multi (#;Some right)
[(get@ #color right) #Red])
- (red value ?left (#;Some (blacken right)))
+ (red key value ?left (#;Some (blacken right)))
_
(case ?left
(^multi (#;Some left)
[(get@ #color left) #Black])
- (left-balance value (#;Some (redden left)) ?right)
+ (left-balance key value (#;Some (redden left)) ?right)
(^multi (#;Some left)
[(get@ #color left) #Red]
[(get@ #right left) (#;Some left.right)]
[(get@ #color left.right) #Black])
- (red (get@ #value left.right)
- (#;Some (left-balance (get@ #value left)
+ (red (get@ #key left.right)
+ (get@ #value left.right)
+ (#;Some (left-balance (get@ #key left)
+ (get@ #value left)
(:: Functor<Maybe> map redden (get@ #left left))
(get@ #left left.right)))
- (#;Some (black value (get@ #right left.right) ?right)))
+ (#;Some (black key value (get@ #right left.right) ?right)))
_
(error! error-message)
)))
(def: (prepend ?left ?right)
- (All [a] (-> (Maybe (Node a)) (Maybe (Node a)) (Maybe (Node a))))
+ (All [k v] (-> (Maybe (Node k v)) (Maybe (Node k v)) (Maybe (Node k v))))
(case [?left ?right]
[#;None _]
?right
@@ -343,29 +402,36 @@
[fused (prepend (get@ #right left) (get@ #right right))]
(case (get@ #color fused)
#Red
- (wrap (red (get@ #value fused)
- (#;Some (red (get@ #value left)
+ (wrap (red (get@ #key fused)
+ (get@ #value fused)
+ (#;Some (red (get@ #key left)
+ (get@ #value left)
(get@ #left left)
(get@ #left fused)))
- (#;Some (red (get@ #value right)
+ (#;Some (red (get@ #key right)
+ (get@ #value right)
(get@ #right fused)
(get@ #right right)))))
#Black
- (wrap (red (get@ #value left)
+ (wrap (red (get@ #key left)
+ (get@ #value left)
(get@ #left left)
- (#;Some (red (get@ #value right)
+ (#;Some (red (get@ #key right)
+ (get@ #value right)
(#;Some fused)
(get@ #right right)))))))
[#Red #Black]
- (#;Some (red (get@ #value left)
+ (#;Some (red (get@ #key left)
+ (get@ #value left)
(get@ #left left)
(prepend (get@ #right left)
?right)))
[#Black #Red]
- (#;Some (red (get@ #value right)
+ (#;Some (red (get@ #key right)
+ (get@ #value right)
(prepend ?left
(get@ #left right))
(get@ #right right)))
@@ -375,38 +441,44 @@
[fused (prepend (get@ #right left) (get@ #left right))]
(case (get@ #color fused)
#Red
- (wrap (red (get@ #value fused)
- (#;Some (black (get@ #value left)
+ (wrap (red (get@ #key fused)
+ (get@ #value fused)
+ (#;Some (black (get@ #key left)
+ (get@ #value left)
(get@ #left left)
(get@ #left fused)))
- (#;Some (black (get@ #value right)
+ (#;Some (black (get@ #key right)
+ (get@ #value right)
(get@ #right fused)
(get@ #right right)))))
#Black
- (wrap (balance-left-remove (get@ #value left)
+ (wrap (balance-left-remove (get@ #key left)
+ (get@ #value left)
(get@ #left left)
- (#;Some (black (get@ #value right)
+ (#;Some (black (get@ #key right)
+ (get@ #value right)
(#;Some fused)
(get@ #right right)))))
))
)))
-(def: #export (remove elem tree)
- (All [a] (-> a (Set a) (Set a)))
- (let [(^open "T/") (get@ #order tree)
- [?root found?] (loop [?root (get@ #root tree)]
+(def: #export (remove key dict)
+ (All [k v] (-> k (Dict k v) (Dict k v)))
+ (let [(^open "T/") (get@ #order dict)
+ [?root found?] (loop [?root (get@ #root dict)]
(case ?root
#;None
[#;None false]
(#;Some root)
- (let [root-val (get@ #value root)]
- (if (T/= root-val elem)
+ (let [root-key (get@ #key root)
+ root-val (get@ #value root)]
+ (if (T/= root-key key)
[(prepend (get@ #left root)
(get@ #right root))
true]
- (let [go-left? (T/< root-val elem)]
+ (let [go-left? (T/< root-key key)]
(case (recur (if go-left?
(get@ #left root)
(get@ #right root)))
@@ -418,20 +490,20 @@
(case (get@ #left root)
(^multi (#;Some left)
[(get@ #color left) #Black])
- [(#;Some (balance-left-remove root-val side-outcome (get@ #right root)))
+ [(#;Some (balance-left-remove root-key root-val side-outcome (get@ #right root)))
false]
_
- [(#;Some (red root-val side-outcome (get@ #right root)))
+ [(#;Some (red root-key root-val side-outcome (get@ #right root)))
false])
(case (get@ #right root)
(^multi (#;Some right)
[(get@ #color right) #Black])
- [(#;Some (balance-right-remove root-val (get@ #left root) side-outcome))
+ [(#;Some (balance-right-remove root-key root-val (get@ #left root) side-outcome))
false]
_
- [(#;Some (red root-val (get@ #left root) side-outcome))
+ [(#;Some (red root-key root-val (get@ #left root) side-outcome))
false])
)))
))
@@ -439,55 +511,52 @@
(case ?root
#;None
(if found?
- (set@ #root ?root tree)
- tree)
+ (set@ #root ?root dict)
+ dict)
(#;Some root)
- (set@ #root (#;Some (blacken root)) tree)
+ (set@ #root (#;Some (blacken root)) dict)
)))
-(def: #export (from-list Order<a> list)
- (All [a] (-> (Order a) (List a) (Set a)))
- (L/fold add (new Order<a>) list))
+(def: #export (from-list Order<l> list)
+ (All [k v] (-> (Order k) (List [k v]) (Dict k v)))
+ (L/fold (function [[key value] dict]
+ (put key value dict))
+ (new Order<l>)
+ list))
+
+(do-template [<name> <type> <output>]
+ [(def: #export (<name> dict)
+ (All [k v] (-> (Dict k v) (List <type>)))
+ (loop [node (get@ #root dict)]
+ (case node
+ #;None
+ (list)
-(def: #export (to-list tree)
- (All [a] (-> (Set a) (List a)))
- (loop [node (get@ #root tree)]
- (case node
- #;None
- (list)
-
- (#;Some node')
- ($_ L/append
- (recur (get@ #left node'))
- (list (get@ #value node'))
- (recur (get@ #right node'))))))
-
-(def: #export (union left right)
- (All [a] (-> (Set a) (Set a) (Set a)))
- (L/fold add right (to-list left)))
-
-(def: #export (intersection left right)
- (All [a] (-> (Set a) (Set a) (Set a)))
- (|> (to-list right)
- (list;filter (member? left))
- (from-list (get@ #order right))))
-
-(def: #export (difference param subject)
- (All [a] (-> (Set a) (Set a) (Set a)))
- (|> (to-list subject)
- (list;filter (. not (member? param)))
- (from-list (get@ #order subject))))
-
-(def: #export (sub? super sub)
- (All [a] (-> (Set a) (Set a) Bool))
- (list;every? (member? super) (to-list sub)))
-
-(def: #export (super? sub super)
- (All [a] (-> (Set a) (Set a) Bool))
- (sub? super sub))
-
-(struct: #export Eq<Set> (All [a] (Eq (Set a)))
+ (#;Some node')
+ ($_ L/append
+ (recur (get@ #left node'))
+ (list <output>)
+ (recur (get@ #right node'))))))]
+
+ [entries [k v] [(get@ #key node') (get@ #value node')]]
+ [keys k (get@ #key node')]
+ [values v (get@ #value node')]
+ )
+
+(struct: #export (Eq<Dict> Eq<v>) (All [k v] (-> (Eq v) (Eq (Dict k v))))
(def: (= reference sample)
- (:: (list;Eq<List> (:: sample eq))
- = (to-list reference) (to-list sample))))
+ (let [Eq<k> (:: sample eq)]
+ (loop [entriesR (entries reference)
+ entriesS (entries sample)]
+ (case [entriesR entriesS]
+ [#;Nil #;Nil]
+ true
+
+ [(#;Cons [keyR valueR] entriesR') (#;Cons [keyS valueS] entriesS')]
+ (and (:: Eq<k> = keyR keyS)
+ (:: Eq<v> = valueR valueS)
+ (recur entriesR' entriesS'))
+
+ _
+ false)))))
diff --git a/stdlib/source/lux/data/coll/ordered/set.lux b/stdlib/source/lux/data/coll/ordered/set.lux
new file mode 100644
index 000000000..1ee2861e8
--- /dev/null
+++ b/stdlib/source/lux/data/coll/ordered/set.lux
@@ -0,0 +1,86 @@
+(;module:
+ lux
+ (lux (control monad
+ eq
+ [order #+ Order])
+ (data (coll [list "" Monad<List> "L/" Monoid<List> Fold<List>]
+ (ordered ["d" dict]))
+ ["p" product]
+ ["M" maybe #+ Functor<Maybe>])
+ [macro]
+ (macro [code]
+ ["s" syntax #+ syntax: Syntax])))
+
+(type: #export (Set a)
+ (d;Dict a a))
+
+(def: #export new
+ (All [a] (-> (Order a) (Set a)))
+ d;new)
+
+(def: #export (member? set elem)
+ (All [a] (-> (Set a) a Bool))
+ (d;contains? elem set))
+
+(do-template [<name> <alias>]
+ [(def: #export (<name> set)
+ (All [a] (-> (Set a) (Maybe a)))
+ (<alias> set))]
+
+ [min d;min]
+ [max d;max]
+ )
+
+(do-template [<name> <alias>]
+ [(def: #export (<name> set)
+ (All [a] (-> (Set a) Nat))
+ (<alias> set))]
+
+ [size d;size]
+ [depth d;depth]
+ )
+
+(def: #export (add elem set)
+ (All [a] (-> a (Set a) (Set a)))
+ (d;put elem elem set))
+
+(def: #export (remove elem set)
+ (All [a] (-> a (Set a) (Set a)))
+ (d;remove elem set))
+
+(def: #export (from-list Order<a> list)
+ (All [a] (-> (Order a) (List a) (Set a)))
+ (L/fold add (new Order<a>) list))
+
+(def: #export (to-list set)
+ (All [a] (-> (Set a) (List a)))
+ (d;keys set))
+
+(def: #export (union left right)
+ (All [a] (-> (Set a) (Set a) (Set a)))
+ (L/fold add right (to-list left)))
+
+(def: #export (intersection left right)
+ (All [a] (-> (Set a) (Set a) (Set a)))
+ (|> (to-list right)
+ (list;filter (member? left))
+ (from-list (get@ #d;order right))))
+
+(def: #export (difference param subject)
+ (All [a] (-> (Set a) (Set a) (Set a)))
+ (|> (to-list subject)
+ (list;filter (. not (member? param)))
+ (from-list (get@ #d;order subject))))
+
+(def: #export (sub? super sub)
+ (All [a] (-> (Set a) (Set a) Bool))
+ (list;every? (member? super) (to-list sub)))
+
+(def: #export (super? sub super)
+ (All [a] (-> (Set a) (Set a) Bool))
+ (sub? super sub))
+
+(struct: #export Eq<Set> (All [a] (Eq (Set a)))
+ (def: (= reference sample)
+ (:: (list;Eq<List> (:: sample eq))
+ = (to-list reference) (to-list sample))))