1. # This file implements the following set operators:
2. # (&) intersection (ASCII)
3. # ∩ intersection
5. proto sub infix:<(&)>(|) is pure {*}
6. multi sub infix:<(&)>() { set() }
7. multi sub infix:<(&)>(QuantHash:D $a) { $a } # Set/Bag/Mix
8. multi sub infix:<(&)>(SetHash:D $a) { $a.Set }
9. multi sub infix:<(&)>(BagHash:D $a) { $a.Bag }
10. multi sub infix:<(&)>(MixHash:D $a) { $a.Mix }
11. multi sub infix:<(&)>(Any $a) { $a.Set } # also for Iterable/Map
13. multi sub infix:<(&)>(Setty:D $a, Setty:D $b) {
14. nqp::if(
15. (my $araw := $a.RAW-HASH) && nqp::elems($araw)
16. && (my $braw := $b.RAW-HASH) && nqp::elems($braw),
17. nqp::stmts( # both have elems
18. nqp::if(
19. nqp::islt_i(nqp::elems($araw),nqp::elems($braw)),
20. nqp::stmts( # $a smallest, iterate over it
21. (my $iter := nqp::iterator($araw)),
22. (my $base := $braw)
23. ),
24. nqp::stmts( # $b smallest, iterate over that
25. ($iter := nqp::iterator($braw)),
26. ($base := $araw)
27. )
28. ),
29. (my $elems := nqp::create(Rakudo::Internals::IterationSet)),
30. nqp::while(
31. $iter,
32. nqp::if( # bind if in both
33. nqp::existskey($base,nqp::iterkey_s(nqp::shift($iter))),
34. nqp::bindkey($elems,nqp::iterkey_s($iter),nqp::iterval($iter))
35. )
36. ),
37. nqp::create(Set).SET-SELF($elems)
38. ),
39. set() # one/neither has elems
40. )
41. }
42. multi sub infix:<(&)>(Setty:D $a, Baggy:D $b) {
43. Rakudo::QuantHash.INTERSECT-BAGGIES($a.Bag, $b, bag())
44. }
45. multi sub infix:<(&)>(Baggy:D $a, Setty:D $b) {
46. Rakudo::QuantHash.INTERSECT-BAGGIES($a, $b.Bag, bag())
47. }
48. multi sub infix:<(&)>(Setty:D $a, Mixy:D $b) {
49. Rakudo::QuantHash.INTERSECT-BAGGIES($a.Mix, $b, mix())
50. }
51. multi sub infix:<(&)>(Mixy:D $a, Setty:D $b) {
52. Rakudo::QuantHash.INTERSECT-BAGGIES($a, $b.Mix, mix())
53. }
54. multi sub infix:<(&)>(Baggy:D $a, Baggy:D $b) {
55. Rakudo::QuantHash.INTERSECT-BAGGIES($a, $b, bag())
56. }
57. multi sub infix:<(&)>(Mixy:D $a, Baggy:D $b) {
58. Rakudo::QuantHash.INTERSECT-BAGGIES($a, $b, mix())
59. }
60. multi sub infix:<(&)>(Baggy:D $a, Mixy:D $b) {
61. Rakudo::QuantHash.INTERSECT-BAGGIES($a, $b, mix())
62. }
63. multi sub infix:<(&)>(Mixy:D $a, Mixy:D $b) {
64. Rakudo::QuantHash.INTERSECT-BAGGIES($a, $b, mix())
65. }
66. multi sub infix:<(&)>(Baggy:D $a, Any:D $b) {
67. nqp::if(
68. nqp::istype((my $bbag := $b.Bag),Bag),
69. Rakudo::QuantHash.INTERSECT-BAGGIES($a, $bbag, bag()),
70. $bbag.throw
71. )
72. }
73. multi sub infix:<(&)>(Any:D $a, Baggy:D $b) {
74. infix:<(&)>($b, $a)
75. }
76. multi sub infix:<(&)>(Mixy:D $a, Any:D $b) {
77. nqp::if(
78. nqp::istype((my $bmix := $b.Mix),Mix),
79. Rakudo::QuantHash.INTERSECT-BAGGIES($a, $bmix, mix()),
80. $bmix.throw
81. )
82. }
83. multi sub infix:<(&)>(Any:D $a, Mixy:D $b) {
84. infix:<(&)>($b, $a)
85. }
87. multi sub infix:<(&)>(Map:D $a, Map:D $b) {
88. nqp::if(
89. nqp::eqaddr($a.keyof,Str(Any)) && nqp::eqaddr($b.keyof,Str(Any)),
90. nqp::if( # both ordinary Str hashes
91. (my $araw := nqp::getattr(nqp::decont($a),Map,'$!storage'))
92. && nqp::elems($araw)
93. && (my $braw := nqp::getattr(nqp::decont($b),Map,'$!storage'))
94. && nqp::elems($braw),
95. nqp::stmts( # both are initialized
96. nqp::if(
97. nqp::islt_i(nqp::elems($araw),nqp::elems($braw)),
98. nqp::stmts( # $a smallest, iterate over it
99. (my $iter := nqp::iterator($araw)),
100. (my $base := $braw)
101. ),
102. nqp::stmts( # $b smallest, iterate over that
103. ($iter := nqp::iterator($braw)),
104. ($base := $araw)
105. )
106. ),
107. (my $elems := nqp::create(Rakudo::Internals::IterationSet)),
108. nqp::while(
109. $iter,
110. nqp::if( # create if in both
111. nqp::existskey(
112. $base,
113. nqp::iterkey_s(nqp::shift($iter))
114. ),
115. nqp::bindkey(
116. $elems,nqp::iterkey_s($iter).WHICH,nqp::iterkey_s($iter))
117. )
118. ),
119. nqp::create(Set).SET-SELF($elems)
120. ),
121. set() # one/neither has elems
122. ),
123. infix:<(&)>($a.Set, $b.Set) # object hash(es), coerce!
124. )
125. }
127. multi sub infix:<(&)>(Any $, Failure:D $b) { $b.throw }
128. multi sub infix:<(&)>(Failure:D $a, Any $) { $a.throw }
129. multi sub infix:<(&)>(Any $a, Any $b) { infix:<(&)>($a.Set,$b.Set) }
131. multi sub infix:<(&)>(**@p) {
132. my $result = @p.shift;
133. $result = $result (&) @p.shift while @p;
134. $result
135. }
137. # U+2229 INTERSECTION
138. my constant &infix:<∩> := &infix:<(&)>;