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