Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Lots of updates to Set, KeySet, Bag, and KeyBag.

Coercion operators added, simpler .new (as per spec), and corresponding operators tweaked.  This set of chances is not yet complete, there will be more soon.
  • Loading branch information...
commit db4190b7b7d8b1183e57c4f6e2aaadab2c3b8d85 1 parent 6314dd4
@colomon colomon authored
Showing with 53 additions and 55 deletions.
  1. +53 −55 lib/CORE.setting
View
108 lib/CORE.setting
@@ -2183,24 +2183,19 @@ class Set does Associative {
method Bool { %!elems.Bool }
method Numeric { %!elems.Numeric }
method hash { %!elems.hash }
+ method Set { self }
+ method KeySet { KeySet.new(self.keys) }
+ method Bag { bag self.keys }
+ method KeyBag { KeyBag.new(self.keys) }
+
method at_key($k) { ?(%!elems{$k} // False) }
method exists_key($k) { self.exists($k) }
# Constructor
method new(*@args --> Set) {
my %e;
- sub register-arg($arg) {
- given $arg {
- when Pair { %e{.key} = True; }
- when Set | KeySet { for .keys -> $key { %e{$key} = True; } }
- when Associative { for .pairs -> $p { register-arg($p); } }
- when Positional { for .list -> $p { register-arg($p); } }
- default { %e{$_} = True; }
- }
- }
-
for @args {
- register-arg($_);
+ %e{$_} = True;
}
self.bless(*, :elems(%e));
}
@@ -2240,59 +2235,59 @@ sub set(*@args --> Set) {
constant term:<∅> = set();
proto sub infix:<∈>($, $ --> Bool) is equiv(&infix:<==>) {*}
-multi sub infix:<∈>($a, Any $b --> Bool) { $a ∈ Set($b) }
+multi sub infix:<∈>($a, Any $b --> Bool) { $a ∈ $b.Set }
multi sub infix:<∈>($a, Set $b --> Bool) { $b.exists($a) }
only sub infix:<(elem)>($a, $b --> Bool) is iffy { $a ∈ $b }
only sub infix:<∉>($a, $b --> Bool) is equiv(&infix:<==>) { $a !∈ $b }
proto sub infix:<∋>($, $ --> Bool) is equiv(&infix:<==>) {*}
-multi sub infix:<∋>(Any $a, $b --> Bool) { Set($a) ∋ $b }
+multi sub infix:<∋>(Any $a, $b --> Bool) { $a.Set ∋ $b }
multi sub infix:<∋>(Set $a, $b --> Bool) { $a.exists($b) }
only sub infix:<(cont)>($a, $b --> Bool) is iffy { $a ∋ $b }
only sub infix:<∌>($a, $b --> Bool) is equiv(&infix:<==>) { $a !∋ $b }
proto sub infix:<∪>($, $ --> Set) is equiv(&infix:<|>) {*}
-multi sub infix:<∪>(Any $a, Any $b --> Set) { Set($a)Set($b) }
+multi sub infix:<∪>(Any $a, Any $b --> Set) { $a.Set$b.Set }
multi sub infix:<∪>(Set $a, Set $b --> Set) { Set.new: $a.keys, $b.keys }
only sub infix:<(|)>($a, $b) is equiv(&infix:<|>) { $a ∪ $b }
proto sub infix:<∩>($, $ --> Set) is equiv(&infix:<&>) {*}
-multi sub infix:<∩>(Any $a, Any $b --> Set) { Set($a)Set($b) }
+multi sub infix:<∩>(Any $a, Any $b --> Set) { $a.Set$b.Set }
multi sub infix:<∩>(Set $a, Set $b --> Set) { Set.new: $a.keys.grep: -> $k { ?$b{$k} } }
only sub infix:<(&)>($a, $b) is equiv(&infix:<&>) { $a ∩ $b }
proto sub infix:<(-)>($, $ --> Set) is equiv(&infix:<^>) {*}
-multi sub infix:<(-)>(Any $a, Any $b --> Set) { Set($a) (-) Set($b) }
+multi sub infix:<(-)>(Any $a, Any $b --> Set) { $a.Set (-) $b.Set }
multi sub infix:<(-)>(Set $a, Set $b --> Set) { Set.new: $a.keys.grep: * ∉ $b }
proto sub infix:<(^)>($, $ --> Set) is equiv(&infix:<^>) {*}
-multi sub infix:<(^)>(Any $a, Any $b --> Set) { Set($a) (^) Set($b) }
+multi sub infix:<(^)>(Any $a, Any $b --> Set) { $a.Set (^) $b.Set }
multi sub infix:<(^)>(Set $a, Set $b --> Set) { ($a (-) $b) ∪ ($b (-) $a) }
# TODO: polymorphic eqv
-# multi sub infix:<eqv>(Any $a, Any $b --> Bool) { Set($a) eqv Set($b) }
+# multi sub infix:<eqv>(Any $a, Any $b --> Bool) { $a.Set eqv $b.Set }
# multi sub infix:<eqv>(Set $a, Set $b --> Bool) { $a == $b and so $a.keys.all ∈ $b }
proto sub infix:<⊆>($, $ --> Bool) is equiv(&infix:<==>) {*}
-multi sub infix:<⊆>(Any $a, Any $b --> Bool) { Set($a)Set($b) }
+multi sub infix:<⊆>(Any $a, Any $b --> Bool) { $a.Set$b.Set }
multi sub infix:<⊆>(Set $a, Set $b --> Bool) { $a <= $b and so $a.keys.all ∈ $b }
only sub infix:['(<=)']($a, $b --> Bool) is equiv(&infix:<==>) { $a ⊆ $b }
only sub infix:<⊈>($a, $b --> Bool) is equiv(&infix:<==>) { $a !⊆ $b }
proto sub infix:<⊂>($, $ --> Bool) is equiv(&infix:<==>) {*}
-multi sub infix:<⊂>(Any $a, Any $b --> Bool) { Set($a)Set($b) }
+multi sub infix:<⊂>(Any $a, Any $b --> Bool) { $a.Set$b.Set }
multi sub infix:<⊂>(Set $a, Set $b --> Bool) { $a < $b and so $a.keys.all ∈ $b }
only sub infix:['(<)']($a, $b --> Bool) is equiv(&infix:<==>) { $a ⊂ $b }
only sub infix:<⊄>($a, $b --> Bool) is equiv(&infix:<==>) { $a !⊂ $b }
proto sub infix:<⊇>($, $ --> Bool) is equiv(&infix:<==>) {*}
-multi sub infix:<⊇>(Any $a, Any $b --> Bool) { Set($a)Set($b) }
+multi sub infix:<⊇>(Any $a, Any $b --> Bool) { $a.Set$b.Set }
multi sub infix:<⊇>(Set $a, Set $b --> Bool) { $a >= $b and so $b.keys.all ∈ $a }
only sub infix:['(>=)']($a, $b --> Bool) is equiv(&infix:<==>) { $a ⊇ $b }
only sub infix:<⊉>($a, $b --> Bool) is equiv(&infix:<==>) { $a !⊇ $b }
proto sub infix:<⊃>($, $ --> Bool) is equiv(&infix:<==>) {*}
-multi sub infix:<⊃>(Any $a, Any $b --> Bool) { Set($a)Set($b) }
+multi sub infix:<⊃>(Any $a, Any $b --> Bool) { $a.Set$b.Set }
multi sub infix:<⊃>(Set $a, Set $b --> Bool) { $a > $b and so $b.keys.all ∈ $a }
only sub infix:['(>)']($a, $b --> Bool) is equiv(&infix:<==>) { $a ⊃ $b }
only sub infix:<⊅>($a, $b --> Bool) is equiv(&infix:<==>) { $a !⊃ $b }
@@ -2308,6 +2303,11 @@ class KeySet does Associative {
method Bool { %!elems.Bool }
method Numeric { %!elems.Numeric }
method hash { %!elems.hash }
+ method Set { set self.keys }
+ method KeySet { self }
+ method Bag { bag self.keys }
+ method KeyBag { KeyBag.new(self.keys) }
+
method at_key($k) {
Proxy.new(FETCH => { %!elems{$k}:exists ?? True !! False },
STORE => -> $, $value { if $value { %!elems{$k} = True } else { %!elems{$k}:delete }});
@@ -2318,18 +2318,8 @@ class KeySet does Associative {
# Constructor
method new(*@args --> KeySet) {
my %e;
- sub register-arg($arg) {
- given $arg {
- when Pair { %e{.key} = True; }
- when Set | KeySet { for .keys -> $key { %e{$key} = True; } }
- when Associative { for .pairs -> $p { register-arg($p); } }
- when Positional { for .list -> $p { register-arg($p); } }
- default { %e{$_} = True; }
- }
- }
-
for @args {
- register-arg($_);
+ %e{$_} = True;
}
self.bless(*, :elems(%e));
}
@@ -2359,24 +2349,19 @@ class Bag does Associative does Baggy {
method Bool { %!elems.Bool }
method Numeric { self.elems }
method hash { %!elems.hash }
+ method Set { set self.keys }
+ method KeySet { KeySet.new(self.keys) }
+ method Bag { self }
+ method KeyBag { KeyBag.new-from-pairs(self.hash) }
+
method at_key($k) { +(%!elems{$k} // 0) }
method exists_key($k) { self.exists($k) }
# Constructor
method new(*@args --> Bag) {
my %e;
- sub register-arg($arg) {
- given $arg {
- when Pair { if .value { if %e{.key}:exists { %e{.key} += .value } else { %e{.key} = .value } } }
- when Set | KeySet { for .keys -> $key { %e{$key}++; } }
- when Associative { for .pairs -> $p { register-arg($p) } }
- when Positional { for .list -> $p { register-arg($p) } }
- default { %e{$_}++; }
- }
- }
-
for @args {
- register-arg($_);
+ %e{$_}++;
}
self.bless(*, :elems(%e));
}
@@ -2397,7 +2382,7 @@ class Bag does Associative does Baggy {
method Str() { self.defined ?? %!elems.pairs.map({ $_.key xx $_.value }).flat.join(" ") !! nextsame }
method gist() { self.defined ?? "bag({ self.pairs>>.gist.join(', ') })" !! "(Bag)" }
- method perl() { self.defined ?? 'Bag.new(' ~ %!elems.perl ~ ')' !! "Bag" }
+ method perl() { self.defined ?? '(' ~ %!elems.perl ~ ').Bag' !! "Bag" }
method iterator() { %!elems.pairs.iterator }
method list() { %!elems.keys }
@@ -2411,22 +2396,30 @@ sub bag(*@a) {
Bag.new(|@a);
}
-multi sub infix:<∪>(Baggy $a, Any $b --> Bag) { $a ∪ bag($b) }
-multi sub infix:<∪>(Any $a, Baggy $b --> Bag) { bag($a) ∪ $b }
-multi sub infix:<∪>(Baggy $a, Baggy $b --> Bag) { bag((set($a) ∪ set($b)).map({ ; $_ => $a{$_} max $b{$_} })) }
+multi sub infix:<∪>(Baggy $a, Any $b --> Bag) { $a ∪ $b.Bag }
+multi sub infix:<∪>(Any $a, Baggy $b --> Bag) { $a.Bag ∪ $b }
+multi sub infix:<∪>(Baggy $a, Baggy $b --> Bag) {
+ Bag.new-from-pairs(($a.Set ∪ $b.Set).map({ ; $_ => $a{$_} max $b{$_} }))
+}
-multi sub infix:<∩>(Baggy $a, Any $b --> Bag) { $a ∩ bag($b) }
-multi sub infix:<∩>(Any $a, Baggy $b --> Bag) { bag($a) ∩ $b }
-multi sub infix:<∩>(Baggy $a, Baggy $b --> Bag) { bag((set($a) ∪ set($b)).map({ ; $_ => $a{$_} min $b{$_} })) }
+multi sub infix:<∩>(Baggy $a, Any $b --> Bag) { $a ∩ $b.Bag }
+multi sub infix:<∩>(Any $a, Baggy $b --> Bag) { $a.Bag ∩ $b }
+multi sub infix:<∩>(Baggy $a, Baggy $b --> Bag) {
+ Bag.new-from-pairs(($a.Set ∪ $b.Set).map({ ; $_ => $a{$_} min $b{$_} }))
+}
proto sub infix:<⊍>($, $ --> Bag) is equiv(&infix:<&>) {*}
-multi sub infix:<⊍>(Any $a, Any $b --> Bag) { bag($a) ⊍ bag($b) }
-multi sub infix:<⊍>(Bag $a, Bag $b --> Bag) { bag((set($a) ∪ set($b)).map({ ; $_ => $a{$_} * $b{$_} })) }
+multi sub infix:<⊍>(Any $a, Any $b --> Bag) { $a.Bag ⊍ $b.Bag }
+multi sub infix:<⊍>(Bag $a, Bag $b --> Bag) {
+ Bag.new-from-pairs(($a.Set ∪ $b.Set).map({ ; $_ => $a{$_} * $b{$_} }))
+}
only sub infix:<(.)>($a, $b --> Bag) is equiv(&infix:<&>) { $a ⊍ $b }
proto sub infix:<⊎>($, $ --> Bag) is equiv(&infix:<&>) {*}
-multi sub infix:<⊎>(Any $a, Any $b --> Bag) { bag($a) ⊎ bag($b) }
-multi sub infix:<⊎>(Bag $a, Bag $b --> Bag) { bag((set($a) ∪ set($b)).map({ ; $_ => $a{$_} + $b{$_} })) }
+multi sub infix:<⊎>(Any $a, Any $b --> Bag) { $a.Bag ⊎ $b.Bag }
+multi sub infix:<⊎>(Bag $a, Bag $b --> Bag) {
+ Bag.new-from-pairs(($a.Set ∪ $b.Set).map({ ; $_ => $a{$_} + $b{$_} }))
+}
only sub infix:<(+)>($a, $b --> Bag) is equiv(&infix:<&>) { $a ⊎ $b }
proto sub infix:<≼>($, $ --> Bool) is equiv(&infix:<==>) {*}
@@ -2446,6 +2439,11 @@ class KeyBag does Associative does Baggy {
method Bool { %!elems.Bool }
method Numeric { self.elems }
method hash { %!elems.hash }
+ method Set { set self.keys }
+ method KeySet { KeySet.new(self.keys) }
+ method Bag { Bag.new-from-pairs(self.hash) }
+ method KeyBag { self }
+
method at_key($k) {
Proxy.new(FETCH => { %!elems{$k}:exists ?? %!elems{$k} !! 0 },
STORE => -> $, $value { if $value > 0 { %!elems{$k} = $value } else { %!elems{$k}:delete }});
Please sign in to comment.
Something went wrong with that request. Please try again.