Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

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...
commit f0c5c2d7b90614f899b62ef4279cac8fec9fcca4 1 parent 7b678c3
Jonathan Worthington authored
4  src/Perl6/Actions.pm
@@ -3196,6 +3196,10 @@ class Perl6::Actions is HLL::Actions {
3196 3196
     method term:sym<rand>($/) {
3197 3197
         make QAST::Op.new( :op('call'), :name('&rand'), :node($/) );
3198 3198
     }
  3199
+    
  3200
+    method term:sym<∅>($/) {
  3201
+        make QAST::Op.new( :op('call'), :name('&set'), :node($/) );
  3202
+    }
3199 3203
 
3200 3204
     sub make_yada($name, $/) {
3201 3205
 	    my $past := $<args>.ast;
28  src/Perl6/Grammar.pm
@@ -2048,6 +2048,8 @@ grammar Perl6::Grammar is HLL::Grammar {
2048 2048
         '{*}' <?ENDSTMT>
2049 2049
         [ <?{ $*MULTINESS eq 'proto' }> || <.panic: '{*} may only appear in proto'> ]
2050 2050
     }
  2051
+    
  2052
+    token term:sym<∅> { <sym> }
2051 2053
 
2052 2054
     token args {
2053 2055
         | '(' <semiarglist> ')'
@@ -2629,6 +2631,25 @@ grammar Perl6::Grammar is HLL::Grammar {
2629 2631
         | <?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")>
2630 2632
         | <?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")>
2631 2633
     }
  2634
+    
  2635
+    token infix:sym«∈»      { <sym>  <O('%chaining')> }
  2636
+    token infix:sym«(elem)» { <sym>  <O('%chaining')> }
  2637
+    token infix:sym«∉»      { <sym>  <O('%chaining')> }
  2638
+    token infix:sym«∋»      { <sym>  <O('%chaining')> }
  2639
+    token infix:sym«(cont)» { <sym>  <O('%chaining')> }
  2640
+    token infix:sym«∌»      { <sym>  <O('%chaining')> }
  2641
+    token infix:sym«⊆»      { <sym>  <O('%chaining')> }
  2642
+    token infix:sym«(<=)»   { <sym>  <O('%chaining')> }
  2643
+    token infix:sym«⊈»      { <sym>  <O('%chaining')> }
  2644
+    token infix:sym«⊂»      { <sym>  <O('%chaining')> }
  2645
+    token infix:sym«(<)»    { <sym>  <O('%chaining')> }
  2646
+    token infix:sym«⊄»      { <sym>  <O('%chaining')> }
  2647
+    token infix:sym«⊇»      { <sym>  <O('%chaining')> }
  2648
+    token infix:sym«(>=)»   { <sym>  <O('%chaining')> }
  2649
+    token infix:sym«⊉»      { <sym>  <O('%chaining')> }
  2650
+    token infix:sym«⊃»      { <sym>  <O('%chaining')> }
  2651
+    token infix:sym«(>)»    { <sym>  <O('%chaining')> }
  2652
+    token infix:sym«⊅»      { <sym>  <O('%chaining')> }
2632 2653
 
2633 2654
     token infix:sym<&&>   { <sym>  <O('%tight_and, :pasttype<if>')> }
2634 2655
 
@@ -2696,6 +2717,13 @@ grammar Perl6::Grammar is HLL::Grammar {
2696 2717
     token infix:sym<...>  { <sym>  <O('%list_infix')> }
2697 2718
     token infix:sym<...^> { <sym>  <O('%list_infix')> }
2698 2719
     # token term:sym<...>   { <sym> <args>? <O(|%list_prefix)> }
  2720
+    
  2721
+    token infix:sym<∪>    { <sym>  <O('%list_infix')> }
  2722
+    token infix:sym<(|)>  { <sym>  <O('%list_infix')> }
  2723
+    token infix:sym<∩>    { <sym>  <O('%list_infix')> }
  2724
+    token infix:sym<(&)>  { <sym>  <O('%list_infix')> }
  2725
+    token infix:sym<(-)>  { <sym>  <O('%list_infix')> }
  2726
+    token infix:sym<(^)>  { <sym>  <O('%list_infix')> }
2699 2727
 
2700 2728
     token infix:sym<?>    { <sym> {} <!before '?'> <?before <-[;]>*?':'> <.obs('?: for the conditional operator', '??!!')> <O('%conditional')> }
2701 2729
 
8  src/core/Bag.pm
@@ -50,6 +50,14 @@ sub bag(*@a) returns Bag {
50 50
     Bag.new(|@a);
51 51
 }
52 52
 
  53
+multi sub infix:<∪>(Baggy $a, Any $b --> Bag) { $a ∪ bag($b) }
  54
+multi sub infix:<∪>(Any $a, Baggy $b --> Bag) { bag($a) ∪ $b }
  55
+multi sub infix:<∪>(Baggy $a, Baggy $b --> Bag) { bag((set($a) ∪ set($b)).map({ ; $_ => $a{$_} max $b{$_} })) }
  56
+
  57
+multi sub infix:<∩>(Baggy $a, Any $b --> Bag) { $a ∩ bag($b) }
  58
+multi sub infix:<∩>(Any $a, Baggy $b --> Bag) { bag($a) ∩ $b }
  59
+multi sub infix:<∩>(Baggy $a, Baggy $b --> Bag) { bag((set($a) ∪ set($b)).map({ ; $_ => $a{$_} min $b{$_} })) }
  60
+
53 61
 my class KeyBag does Associative does Baggy {
54 62
     has %!elems; # should be UInt
55 63
 
54  src/core/Set.pm
@@ -60,6 +60,60 @@ sub set(*@args) {
60 60
     Set.new(@args);
61 61
 }
62 62
 
  63
+proto sub infix:<∈>($, $ --> Bool) {*}
  64
+multi sub infix:<∈>($a, Any $b --> Bool) { $a ∈ Set($b) }
  65
+multi sub infix:<∈>($a, Set $b --> Bool) { $b.exists($a) }
  66
+only sub infix:<(elem)>($a, $b --> Bool) { $a ∈ $b }
  67
+only sub infix:<∉>($a, $b --> Bool) { $a !∈ $b }
  68
+
  69
+proto sub infix:<∋>($, $ --> Bool) {*}
  70
+multi sub infix:<∋>(Any $a, $b --> Bool) { Set($a) ∋ $b }
  71
+multi sub infix:<∋>(Set $a, $b --> Bool) { $a.exists($b) }
  72
+only sub infix:<(cont)>($a, $b --> Bool) { $a ∋ $b }
  73
+only sub infix:<∌>($a, $b --> Bool) { $a !∋ $b }
  74
+
  75
+proto sub infix:<∪>($, $ --> Set) {*}
  76
+multi sub infix:<∪>(Any $a, Any $b --> Set) { Set($a) ∪ Set($b) }
  77
+multi sub infix:<∪>(Set $a, Set $b --> Set) { Set.new: $a.keys, $b.keys }
  78
+only sub infix:<(|)>($a, $b) { $a ∪ $b }
  79
+
  80
+proto sub infix:<∩>($, $ --> Set) {*}
  81
+multi sub infix:<∩>(Any $a, Any $b --> Set) { Set($a) ∩ Set($b) }
  82
+multi sub infix:<∩>(Set $a, Set $b --> Set) { Set.new: $a.keys.grep: -> $k { ?$b{$k} } }
  83
+only sub infix:<(&)>($a, $b) { $a ∩ $b }
  84
+
  85
+proto sub infix:<(-)>($, $ --> Set) {*}
  86
+multi sub infix:<(-)>(Any $a, Any $b --> Set) { Set($a) (-) Set($b) }
  87
+multi sub infix:<(-)>(Set $a, Set $b --> Set) { Set.new: $a.keys.grep: * ∉ $b }
  88
+
  89
+proto sub infix:<(^)>($, $ --> Set) {*}
  90
+multi sub infix:<(^)>(Any $a, Any $b --> Set) { Set($a) (^) Set($b) }
  91
+multi sub infix:<(^)>(Set $a, Set $b --> Set) { ($a (-) $b) ∪ ($b (-) $a) }
  92
+
  93
+proto sub infix:<⊆>($, $ --> Bool) {*}
  94
+multi sub infix:<⊆>(Any $a, Any $b --> Bool) { Set($a) ⊆ Set($b) }
  95
+multi sub infix:<⊆>(Set $a, Set $b --> Bool) { $a <= $b and so $a.keys.all ∈ $b }
  96
+only sub infix:«(<=)»($a, $b --> Bool) { $a ⊆ $b }
  97
+only sub infix:<⊈>($a, $b --> Bool) { $a !⊆ $b }
  98
+
  99
+proto sub infix:<⊂>($, $ --> Bool) {*}
  100
+multi sub infix:<⊂>(Any $a, Any $b --> Bool) { Set($a) ⊂ Set($b) }
  101
+multi sub infix:<⊂>(Set $a, Set $b --> Bool) { $a < $b and so $a.keys.all ∈ $b }
  102
+only sub infix:«(<)»($a, $b --> Bool) { $a ⊂ $b }
  103
+only sub infix:<⊄>($a, $b --> Bool) { $a !⊂ $b }
  104
+
  105
+proto sub infix:<⊇>($, $ --> Bool) {*}
  106
+multi sub infix:<⊇>(Any $a, Any $b --> Bool) { Set($a) ⊇ Set($b) }
  107
+multi sub infix:<⊇>(Set $a, Set $b --> Bool) { $a >= $b and so $b.keys.all ∈ $a }
  108
+only sub infix:«(>=)»($a, $b --> Bool) { $a ⊇ $b }
  109
+only sub infix:<⊉>($a, $b --> Bool) { $a !⊇ $b }
  110
+
  111
+proto sub infix:<⊃>($, $ --> Bool) {*}
  112
+multi sub infix:<⊃>(Any $a, Any $b --> Bool) { Set($a) ⊃ Set($b) }
  113
+multi sub infix:<⊃>(Set $a, Set $b --> Bool) { $a > $b and so $b.keys.all ∈ $a }
  114
+only sub infix:«(>)»($a, $b --> Bool) { $a ⊃ $b }
  115
+only sub infix:<⊅>($a, $b --> Bool) { $a !⊃ $b }
  116
+
63 117
 my class KeySet is Iterable does Associative {
64 118
     has %!elems;
65 119
 

0 notes on commit f0c5c2d

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