1. # This file implements the following set operators:
  2. # (|) union (ASCII)
  3. # ∪ union
  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. nqp::if( # first has elems
  15. (my $braw := $b.RAW-HASH) && nqp::elems($braw),
  16. nqp::stmts( # second has elems
  17. (my $elems := nqp::clone($araw)),
  18. (my $iter := nqp::iterator($braw)),
  19. nqp::while( # loop over keys of second
  20. $iter,
  21. nqp::bindkey( # bind into clone of first
  22. $elems,
  23. nqp::iterkey_s(nqp::shift($iter)),
  24. nqp::iterval($iter)
  25. )
  26. ),
  27. nqp::create(Set).SET-SELF($elems) # make it a Set
  28. ),
  29. $a.Set # no second, so first
  30. ),
  31. nqp::if( # no first
  32. ($braw := $b.RAW-HASH) && nqp::elems($braw),
  33. $b.Set, # but second
  34. set() # both empty
  35. )
  36. )
  37. }
  38. multi sub infix:<(|)>(Setty:D $a, Mixy:D $b) { $a.Mix (|) $b }
  39. multi sub infix:<(|)>(Setty:D $a, Baggy:D $b) { $a.Bag (|) $b }
  40. multi sub infix:<(|)>(Mixy:D $a, Mixy:D $b) {
  41. nqp::if(
  42. (my $araw := $a.RAW-HASH) && nqp::elems($araw),
  43. nqp::if( # first has elems
  44. (my $braw := $b.RAW-HASH) && nqp::elems($braw),
  45. nqp::stmts( # second has elems
  46. (my $elems := nqp::clone($araw)),
  47. (my $iter := nqp::iterator($braw)),
  48. nqp::while( # loop over keys of second
  49. $iter,
  50. nqp::if(
  51. nqp::existskey(
  52. $araw,
  53. (my $key := nqp::iterkey_s(nqp::shift($iter)))
  54. ),
  55. nqp::if( # must use HLL < because values can be bignums
  56. nqp::getattr(
  57. nqp::decont(nqp::atkey($araw,$key)),Pair,'$!value')
  58. < nqp::getattr(
  59. nqp::decont(nqp::atkey($braw,$key)),Pair,'$!value'),
  60. nqp::bindkey($elems,$key,nqp::atkey($braw,$key))
  61. ),
  62. nqp::bindkey($elems,$key,nqp::atkey($braw,$key))
  63. )
  64. ),
  65. nqp::create(Mix).SET-SELF($elems) # make it a Mix
  66. ),
  67. $a.Mix # no second, so first
  68. ),
  69. nqp::if( # no first
  70. ($braw := $b.RAW-HASH) && nqp::elems($braw),
  71. $b.Mix, # but second
  72. mix() # both empty
  73. )
  74. )
  75. }
  76. multi sub infix:<(|)>(Mixy:D $a, Baggy:D $b) { $a (|) $b.Mix }
  77. multi sub infix:<(|)>(Mixy:D $a, Setty:D $b) { $a (|) $b.Mix }
  78. multi sub infix:<(|)>(Baggy:D $a, Mixy:D $b) { $a.Mix (|) $b }
  79. multi sub infix:<(|)>(Baggy:D $a, Baggy:D $b) {
  80. nqp::if(
  81. (my $araw := $a.RAW-HASH) && nqp::elems($araw),
  82. nqp::if( # first has elems
  83. (my $braw := $b.RAW-HASH) && nqp::elems($braw),
  84. nqp::stmts( # second has elems
  85. (my $elems := nqp::clone($araw)),
  86. (my $iter := nqp::iterator($braw)),
  87. nqp::while( # loop over keys of second
  88. $iter,
  89. nqp::if(
  90. nqp::existskey(
  91. $araw,
  92. (my $key := nqp::iterkey_s(nqp::shift($iter)))
  93. ),
  94. nqp::if(
  95. nqp::islt_i(
  96. nqp::getattr(
  97. nqp::decont(nqp::atkey($araw,$key)),Pair,'$!value'),
  98. nqp::getattr(
  99. nqp::decont(nqp::atkey($braw,$key)),Pair,'$!value')
  100. ),
  101. nqp::bindkey($elems,$key,nqp::atkey($braw,$key))
  102. ),
  103. nqp::bindkey($elems,$key,nqp::atkey($braw,$key))
  104. )
  105. ),
  106. nqp::create(Bag).SET-SELF($elems) # make it a Bag
  107. ),
  108. $a.Bag # no second, so first
  109. ),
  110. nqp::if( # no first
  111. ($braw := $b.RAW-HASH) && nqp::elems($braw),
  112. $b.Bag, # but second
  113. bag() # both empty
  114. )
  115. )
  116. }
  117. multi sub infix:<(|)>(Baggy:D $a, Setty:D $b) { $a (|) $b.Bag }
  118. multi sub infix:<(|)>(Map:D $a, Map:D $b) {
  119. nqp::create(Set).SET-SELF(
  120. Rakudo::QuantHash.ADD-MAP-TO-SET(
  121. Rakudo::QuantHash.COERCE-MAP-TO-SET($a),
  122. $b
  123. )
  124. )
  125. }
  126. multi sub infix:<(|)>(Iterable:D $a, Iterable:D $b) {
  127. nqp::if(
  128. (my $aiterator := $a.flat.iterator).is-lazy
  129. || (my $biterator := $b.flat.iterator).is-lazy,
  130. Failure.new(X::Cannot::Lazy.new(:action<union>,:what<set>)),
  131. nqp::create(Set).SET-SELF(
  132. Rakudo::QuantHash.ADD-PAIRS-TO-SET(
  133. Rakudo::QuantHash.ADD-PAIRS-TO-SET(
  134. nqp::create(Rakudo::Internals::IterationSet),
  135. $aiterator
  136. ),
  137. $biterator
  138. )
  139. )
  140. )
  141. }
  142. multi sub infix:<(|)>(Failure:D $a, Any $b) { $a.throw }
  143. multi sub infix:<(|)>(Any $a, Failure:D $b) { $b.throw }
  144. multi sub infix:<(|)>(Any $a, Any $b) {
  145. nqp::if(
  146. nqp::istype($a,Mixy) || nqp::istype($b,Mixy),
  147. infix:<(|)>($a.Mix, $b.Mix),
  148. nqp::if(
  149. nqp::istype($a,Baggy) || nqp::istype($b,Baggy),
  150. infix:<(|)>($a.Bag, $b.Bag),
  151. infix:<(|)>($a.Set, $b.Set)
  152. )
  153. )
  154. }
  155. multi sub infix:<(|)>(**@p) {
  156. my $result = @p.shift;
  157. $result = $result (|) @p.shift while @p;
  158. $result
  159. }
  160. # U+222A UNION
  161. my constant &infix:<∪> := &infix:<(|)>;