1. # This file implements the following set operators:
  2. # (-) set difference (ASCII)
  3. # ∖ set difference
  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( # elems in $a
  15. (my $braw := $b.RAW-HASH) && nqp::elems($braw),
  16. nqp::create(Set).SET-SELF( # both have elems
  17. Rakudo::QuantHash.SUB-SET-FROM-SET($araw, $braw)
  18. ),
  19. $a.Set, # no elems in $b
  20. ),
  21. set() # no elems in $a
  22. )
  23. }
  24. multi sub infix:<(-)>(Setty:D $a, Map:D $b) {
  25. nqp::if(
  26. (my $araw := $a.RAW-HASH) && nqp::elems($araw),
  27. nqp::create(Set).SET-SELF( # elems in $a
  28. nqp::if(
  29. (my $braw := nqp::getattr(nqp::decont($b),Map,'$!storage'))
  30. && nqp::elems($braw),
  31. Rakudo::QuantHash.SUB-MAP-FROM-SET($araw, $b), # both have elems
  32. nqp::clone($araw) # no elems in $b
  33. )
  34. ),
  35. set() # no elems in $a
  36. )
  37. }
  38. multi sub infix:<(-)>(Setty:D $a, Iterable:D $b) {
  39. nqp::if(
  40. (my $iterator := $b.iterator).is-lazy,
  41. Failure.new(X::Cannot::Lazy.new(:action('difference'),:what<set>)),
  42. nqp::if(
  43. (my $raw := $a.RAW-HASH) && nqp::elems($raw),
  44. nqp::create(Set).SET-SELF(
  45. Rakudo::QuantHash.SUB-PAIRS-FROM-SET($raw, $iterator)
  46. ),
  47. set()
  48. )
  49. )
  50. }
  51. multi sub infix:<(-)>(Mixy:D $a, Mixy:D $b) { # needed as tie-breaker
  52. Rakudo::QuantHash.DIFFERENCE-MIXY-QUANTHASH($a, $b)
  53. }
  54. multi sub infix:<(-)>(Mixy:D $a, QuantHash:D $b) {
  55. Rakudo::QuantHash.DIFFERENCE-MIXY-QUANTHASH($a, $b)
  56. }
  57. multi sub infix:<(-)>(QuantHash:D $a, Mixy:D $b) {
  58. Rakudo::QuantHash.DIFFERENCE-MIXY-QUANTHASH($a.Mix, $b)
  59. }
  60. multi sub infix:<(-)>(Mixy:D $a, Map:D $b) {
  61. Rakudo::QuantHash.DIFFERENCE-MIXY-QUANTHASH($a, $b.Set)
  62. }
  63. multi sub infix:<(-)>(Mixy:D $a, Any:D $b) { # also Iterable
  64. Rakudo::QuantHash.DIFFERENCE-MIXY-QUANTHASH($a, $b.Set)
  65. }
  66. multi sub infix:<(-)>(Any:D $a, Mixy:D $b) {
  67. Rakudo::QuantHash.DIFFERENCE-MIXY-QUANTHASH($a.Mix, $b)
  68. }
  69. multi sub infix:<(-)>(Baggy:D $a, Mixy:D $b) { # needed as tie-breaker
  70. Rakudo::QuantHash.DIFFERENCE-MIXY-QUANTHASH($a.Mix, $b)
  71. }
  72. multi sub infix:<(-)>(Baggy:D $a, Baggy:D $b) { # needed as tie-breaker
  73. Rakudo::QuantHash.DIFFERENCE-BAGGY-QUANTHASH($a, $b)
  74. }
  75. multi sub infix:<(-)>(Baggy:D $a, QuantHash:D $b) {
  76. Rakudo::QuantHash.DIFFERENCE-BAGGY-QUANTHASH($a, $b)
  77. }
  78. multi sub infix:<(-)>(QuantHash:D $a, Baggy:D $b) {
  79. Rakudo::QuantHash.DIFFERENCE-BAGGY-QUANTHASH($a.Bag, $b)
  80. }
  81. multi sub infix:<(-)>(Baggy:D $a, Map:D $b) {
  82. Rakudo::QuantHash.DIFFERENCE-BAGGY-QUANTHASH($a, $b.Set)
  83. }
  84. multi sub infix:<(-)>(Baggy:D $a, Any:D $b) { # also Iterable
  85. Rakudo::QuantHash.DIFFERENCE-BAGGY-QUANTHASH($a, $b.Set)
  86. }
  87. multi sub infix:<(-)>(Any $a, Baggy:D $b) {
  88. Rakudo::QuantHash.DIFFERENCE-BAGGY-QUANTHASH($a.Bag, $b)
  89. }
  90. multi sub infix:<(-)>(Any $a, Map:D $b) { infix:<(-)>($a.Set, $b) }
  91. multi sub infix:<(-)>(Any $a, Iterable:D $b) { infix:<(-)>($a.Set, $b) }
  92. multi sub infix:<(-)>(Any $, Failure:D $b) { $b.throw }
  93. multi sub infix:<(-)>(Failure:D $a, Any $) { $a.throw }
  94. multi sub infix:<(-)>(Any $a, Any $b) { infix:<(-)>($a.Set,$b.Set) }
  95. multi sub infix:<(-)>(**@p) {
  96. sub subtract(Mu \elems, Mu \iter, \clone, \value --> Nil) {
  97. nqp::stmts(
  98. (my $pair := nqp::ifnull(
  99. nqp::atkey(elems, nqp::iterkey_s(iter)),
  100. nqp::bindkey(
  101. elems,
  102. nqp::iterkey_s(iter),
  103. nqp::if(
  104. clone,
  105. nqp::p6bindattrinvres(
  106. nqp::clone(nqp::iterval(iter)),
  107. Pair,
  108. '$!value',
  109. 0
  110. ),
  111. Pair.new(nqp::iterval(iter),0)
  112. )
  113. )
  114. )),
  115. nqp::bindattr($pair,Pair,'$!value',
  116. nqp::getattr($pair,Pair,'$!value') - value
  117. )
  118. )
  119. }
  120. nqp::if(
  121. (my $params := @p.iterator).is-lazy,
  122. Failure.new(X::Cannot::Lazy.new(:action('difference'))), # bye bye
  123. nqp::stmts( # fixed list of things to diff
  124. (my $type := nqp::if(
  125. nqp::istype((my $p := $params.pull-one),Mixy),
  126. Mix,
  127. nqp::if(nqp::istype($p,Baggy),Bag,Set)
  128. )),
  129. (my $elems := nqp::if(
  130. nqp::istype($p,Baggy),
  131. nqp::if( # already have a Baggy, clone
  132. (my $raw := $p.RAW-HASH),
  133. Rakudo::QuantHash.BAGGY-CLONE($raw),
  134. nqp::create(Rakudo::Internals::IterationSet)
  135. ),
  136. nqp::unless( # something else, Mix it!
  137. $p.Set.Mix.RAW-HASH,
  138. nqp::create(Rakudo::Internals::IterationSet)
  139. )
  140. )),
  141. nqp::until(
  142. nqp::eqaddr(($p := $params.pull-one),IterationEnd),
  143. nqp::if( # not done parsing
  144. nqp::istype($p,Baggy),
  145. nqp::stmts( # Mixy/Baggy semantics apply
  146. nqp::unless( # upgrade type if needed
  147. nqp::istype($type,Mix),
  148. ($type := nqp::if(nqp::istype($p,Mixy),Mix,Bag))
  149. ),
  150. nqp::if(
  151. ($raw := $p.RAW-HASH) && (my $iter := nqp::iterator($raw)),
  152. nqp::while( # something to process
  153. $iter,
  154. subtract(
  155. $elems,
  156. nqp::shift($iter),
  157. 1,
  158. nqp::getattr(nqp::iterval($iter),Pair,'$!value')
  159. )
  160. )
  161. )
  162. ),
  163. nqp::stmts( # not a Baggy/Mixy, assume Set
  164. ($raw := nqp::if(nqp::istype($p,Setty),$p,$p.Set).RAW-HASH)
  165. && ($iter := nqp::iterator($raw)),
  166. nqp::while( # something to process
  167. $iter,
  168. subtract($elems, nqp::shift($iter), 0, 1)
  169. )
  170. )
  171. )
  172. ),
  173. ($iter := nqp::iterator($elems)), # start post-processing
  174. nqp::if(
  175. nqp::istype($type,Set),
  176. nqp::while( # need to create a Set
  177. $iter,
  178. nqp::if(
  179. nqp::getattr(nqp::iterval(nqp::shift($iter)),Pair,'$!value') > 0,
  180. nqp::bindkey(
  181. $elems,
  182. nqp::iterkey_s($iter),
  183. nqp::getattr(nqp::iterval($iter),Pair,'$!key')
  184. ),
  185. nqp::deletekey($elems,nqp::iterkey_s($iter))
  186. )
  187. ),
  188. nqp::if(
  189. nqp::istype($type,Mix),
  190. nqp::while( # convert to Mix semantics
  191. $iter,
  192. nqp::unless(
  193. nqp::getattr(nqp::iterval(nqp::shift($iter)),Pair,'$!value'),
  194. nqp::deletekey($elems,nqp::iterkey_s($iter)) # not valid in Mix
  195. )
  196. ),
  197. nqp::while( # convert to Bag semantics
  198. $iter,
  199. nqp::unless(
  200. nqp::getattr(nqp::iterval(nqp::shift($iter)),Pair,'$!value') >0,
  201. nqp::deletekey($elems,nqp::iterkey_s($iter)) # not valid in Bag
  202. )
  203. )
  204. )
  205. ),
  206. nqp::create($type).SET-SELF($elems)
  207. )
  208. )
  209. }
  210. # U+2216 SET MINUS
  211. my constant &infix:<∖> := &infix:<(-)>;