Skip to content
Browse files

Initial stab at porting of set operations from Niecza's CORE.setting.…

… Doesn't pass set.t yet, but worse somehow slows down CORE.setting parse quite a bit. Pushing this to allow @other to investigate either issue; need to resolve whether the ops even belong in core before this is merged also.
  • Loading branch information...
1 parent 7b678c3 commit f0c5c2d7b90614f899b62ef4279cac8fec9fcca4 @jnthn jnthn committed Jul 31, 2012
Showing with 94 additions and 0 deletions.
  1. +4 −0 src/Perl6/Actions.pm
  2. +28 −0 src/Perl6/Grammar.pm
  3. +8 −0 src/core/Bag.pm
  4. +54 −0 src/core/Set.pm
View
4 src/Perl6/Actions.pm
@@ -3196,6 +3196,10 @@ class Perl6::Actions is HLL::Actions {
method term:sym<rand>($/) {
make QAST::Op.new( :op('call'), :name('&rand'), :node($/) );
}
+
+ method term:sym<∅>($/) {
+ make QAST::Op.new( :op('call'), :name('&set'), :node($/) );
+ }
sub make_yada($name, $/) {
my $past := $<args>.ast;
View
28 src/Perl6/Grammar.pm
@@ -2048,6 +2048,8 @@ grammar Perl6::Grammar is HLL::Grammar {
'{*}' <?ENDSTMT>
[ <?{ $*MULTINESS eq 'proto' }> || <.panic: '{*} may only appear in proto'> ]
}
+
+ token term:sym<> { <sym> }
token args {
| '(' <semiarglist> ')'
@@ -2629,6 +2631,25 @@ grammar Perl6::Grammar is HLL::Grammar {
| <?before \h* [ 'Bool::'? 'True' && <.longname> ] > <.panic("Smartmatch against True always matches; if you mean to test the topic for truthiness, use :so or *.so or ?* instead")>
| <?before \h* [ 'Bool::'? 'False' && <.longname> ] > <.panic("Smartmatch against False always fails; if you mean to test the topic for truthiness, use :!so or *.not or !* instead")>
}
+
+ token infix:sym«» { <sym> <O('%chaining')> }
+ token infix:sym«(elem)» { <sym> <O('%chaining')> }
+ token infix:sym«» { <sym> <O('%chaining')> }
+ token infix:sym«» { <sym> <O('%chaining')> }
+ token infix:sym«(cont)» { <sym> <O('%chaining')> }
+ token infix:sym«» { <sym> <O('%chaining')> }
+ token infix:sym«» { <sym> <O('%chaining')> }
+ token infix:sym«(<=)» { <sym> <O('%chaining')> }
+ token infix:sym«» { <sym> <O('%chaining')> }
+ token infix:sym«» { <sym> <O('%chaining')> }
+ token infix:sym«(<)» { <sym> <O('%chaining')> }
+ token infix:sym«» { <sym> <O('%chaining')> }
+ token infix:sym«» { <sym> <O('%chaining')> }
+ token infix:sym«(>=)» { <sym> <O('%chaining')> }
+ token infix:sym«» { <sym> <O('%chaining')> }
+ token infix:sym«» { <sym> <O('%chaining')> }
+ token infix:sym«(>)» { <sym> <O('%chaining')> }
+ token infix:sym«» { <sym> <O('%chaining')> }
token infix:sym<&&> { <sym> <O('%tight_and, :pasttype<if>')> }
@@ -2696,6 +2717,13 @@ grammar Perl6::Grammar is HLL::Grammar {
token infix:sym<...> { <sym> <O('%list_infix')> }
token infix:sym<...^> { <sym> <O('%list_infix')> }
# token term:sym<...> { <sym> <args>? <O(|%list_prefix)> }
+
+ token infix:sym<> { <sym> <O('%list_infix')> }
+ token infix:sym<(|)> { <sym> <O('%list_infix')> }
+ token infix:sym<> { <sym> <O('%list_infix')> }
+ token infix:sym<(&)> { <sym> <O('%list_infix')> }
+ token infix:sym<(-)> { <sym> <O('%list_infix')> }
+ token infix:sym<(^)> { <sym> <O('%list_infix')> }
token infix:sym<?> { <sym> {} <!before '?'> <?before <-[;]>*?':'> <.obs('?: for the conditional operator', '??!!')> <O('%conditional')> }
View
8 src/core/Bag.pm
@@ -50,6 +50,14 @@ sub bag(*@a) returns Bag {
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 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{$_} })) }
+
my class KeyBag does Associative does Baggy {
has %!elems; # should be UInt
View
54 src/core/Set.pm
@@ -60,6 +60,60 @@ sub set(*@args) {
Set.new(@args);
}
+proto sub infix:<∈>($, $ --> Bool) {*}
+multi sub infix:<∈>($a, Any $b --> Bool) { $a Set($b) }
+multi sub infix:<∈>($a, Set $b --> Bool) { $b.exists($a) }
+only sub infix:<(elem)>($a, $b --> Bool) { $a $b }
+only sub infix:<∉>($a, $b --> Bool) { $a ! $b }
+
+proto sub infix:<∋>($, $ --> Bool) {*}
+multi sub infix:<∋>(Any $a, $b --> Bool) { Set($a) $b }
+multi sub infix:<∋>(Set $a, $b --> Bool) { $a.exists($b) }
+only sub infix:<(cont)>($a, $b --> Bool) { $a $b }
+only sub infix:<∌>($a, $b --> Bool) { $a ! $b }
+
+proto sub infix:<∪>($, $ --> Set) {*}
+multi sub infix:<∪>(Any $a, Any $b --> Set) { Set($a) Set($b) }
+multi sub infix:<∪>(Set $a, Set $b --> Set) { Set.new: $a.keys, $b.keys }
+only sub infix:<(|)>($a, $b) { $a $b }
+
+proto sub infix:<∩>($, $ --> Set) {*}
+multi sub infix:<∩>(Any $a, Any $b --> Set) { Set($a) Set($b) }
+multi sub infix:<∩>(Set $a, Set $b --> Set) { Set.new: $a.keys.grep: -> $k { ?$b{$k} } }
+only sub infix:<(&)>($a, $b) { $a $b }
+
+proto sub infix:<(-)>($, $ --> Set) {*}
+multi sub infix:<(-)>(Any $a, Any $b --> Set) { Set($a) (-) Set($b) }
+multi sub infix:<(-)>(Set $a, Set $b --> Set) { Set.new: $a.keys.grep: * $b }
+
+proto sub infix:<(^)>($, $ --> Set) {*}
+multi sub infix:<(^)>(Any $a, Any $b --> Set) { Set($a) (^) Set($b) }
+multi sub infix:<(^)>(Set $a, Set $b --> Set) { ($a (-) $b) ($b (-) $a) }
+
+proto sub infix:<⊆>($, $ --> Bool) {*}
+multi sub infix:<⊆>(Any $a, Any $b --> Bool) { Set($a) Set($b) }
+multi sub infix:<⊆>(Set $a, Set $b --> Bool) { $a <= $b and so $a.keys.all $b }
+only sub infix:«(<=)»($a, $b --> Bool) { $a $b }
+only sub infix:<⊈>($a, $b --> Bool) { $a ! $b }
+
+proto sub infix:<⊂>($, $ --> Bool) {*}
+multi sub infix:<⊂>(Any $a, Any $b --> Bool) { Set($a) Set($b) }
+multi sub infix:<⊂>(Set $a, Set $b --> Bool) { $a < $b and so $a.keys.all $b }
+only sub infix:«(<)»($a, $b --> Bool) { $a $b }
+only sub infix:<⊄>($a, $b --> Bool) { $a ! $b }
+
+proto sub infix:<⊇>($, $ --> Bool) {*}
+multi sub infix:<⊇>(Any $a, Any $b --> Bool) { Set($a) Set($b) }
+multi sub infix:<⊇>(Set $a, Set $b --> Bool) { $a >= $b and so $b.keys.all $a }
+only sub infix:«(>=)»($a, $b --> Bool) { $a $b }
+only sub infix:<⊉>($a, $b --> Bool) { $a ! $b }
+
+proto sub infix:<⊃>($, $ --> Bool) {*}
+multi sub infix:<⊃>(Any $a, Any $b --> Bool) { Set($a) Set($b) }
+multi sub infix:<⊃>(Set $a, Set $b --> Bool) { $a > $b and so $b.keys.all $a }
+only sub infix:«(>)»($a, $b --> Bool) { $a $b }
+only sub infix:<⊅>($a, $b --> Bool) { $a ! $b }
+
my class KeySet is Iterable does Associative {
has %!elems;

0 comments on commit f0c5c2d

Please sign in to comment.
Something went wrong with that request. Please try again.