1. # This test file tests the following set operators:
  2. # (^) set symmetric difference (Texas)
  3. # ⊖ set symmetric 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(
  15. (my $braw := $b.RAW-HASH) && nqp::elems($braw),
  16. nqp::stmts( # both are initialized
  17. nqp::if(
  18. nqp::islt_i(nqp::elems($araw),nqp::elems($braw)),
  19. nqp::stmts( # $a smallest, iterate over it
  20. (my $iter := nqp::iterator($araw)),
  21. (my $elems := nqp::clone($braw))
  22. ),
  23. nqp::stmts( # $b smallest, iterate over that
  24. ($iter := nqp::iterator($braw)),
  25. ($elems := nqp::clone($araw))
  26. )
  27. ),
  28. nqp::while(
  29. $iter,
  30. nqp::if( # remove if in both
  31. nqp::existskey($elems,nqp::iterkey_s(nqp::shift($iter))),
  32. nqp::deletekey($elems,nqp::iterkey_s($iter)),
  33. nqp::bindkey($elems,nqp::iterkey_s($iter),nqp::iterval($iter))
  34. )
  35. ),
  36. nqp::create(Set).SET-SELF($elems)
  37. ),
  38. nqp::if(nqp::istype($a,Set),$a,$a.Set) # $b empty, so $a
  39. ),
  40. nqp::if(nqp::istype($b,Set),$b,$b.Set) # $a empty, so $b
  41. )
  42. }
  43. multi sub infix:<(^)>(Setty:D $a, Mixy:D $b) { $a.Mix (^) $b }
  44. multi sub infix:<(^)>(Setty:D $a, Baggy:D $b) { $a.Bag (^) $b }
  45. multi sub infix:<(^)>(Mixy:D $a, Mixy:D $b) {
  46. nqp::if(
  47. (my $araw := $a.RAW-HASH) && nqp::elems($araw),
  48. nqp::if(
  49. (my $braw := $b.RAW-HASH) && nqp::elems($braw),
  50. nqp::stmts( # both are initialized
  51. nqp::if(
  52. nqp::islt_i(nqp::elems($araw),nqp::elems($braw)),
  53. nqp::stmts( # $a smallest, iterate over it
  54. (my $iter := nqp::iterator(my $base := $araw)),
  55. (my $elems := nqp::clone($braw))
  56. ),
  57. nqp::stmts( # $b smallest, iterate over that
  58. ($iter := nqp::iterator($base := $braw)),
  59. ($elems := nqp::clone($araw))
  60. )
  61. ),
  62. nqp::while(
  63. $iter,
  64. nqp::if(
  65. nqp::existskey($elems,nqp::iterkey_s(nqp::shift($iter))),
  66. nqp::if(
  67. (my $diff := nqp::getattr(nqp::iterval($iter),Pair,'$!value')
  68. - nqp::getattr(
  69. nqp::atkey($elems,nqp::iterkey_s($iter)),
  70. Pair,
  71. '$!value'
  72. )
  73. ),
  74. nqp::bindkey(
  75. $elems,
  76. nqp::iterkey_s($iter),
  77. nqp::p6bindattrinvres(
  78. nqp::clone(nqp::iterval($iter)),Pair,'$!value',abs($diff)
  79. )
  80. ),
  81. nqp::deletekey($elems,nqp::iterkey_s($iter))
  82. ),
  83. nqp::bindkey(
  84. $elems,
  85. nqp::iterkey_s($iter),
  86. nqp::clone(nqp::iterval($iter))
  87. )
  88. )
  89. ),
  90. nqp::create(Mix).SET-SELF($elems)
  91. ),
  92. nqp::create(Mix).SET-SELF( # $b empty, so $a
  93. Rakudo::QuantHash.MIX-CLONE-ALL-POSITIVE($araw)
  94. )
  95. ),
  96. nqp::if(
  97. ($braw := $b.RAW-HASH) && nqp::elems($braw),
  98. nqp::create(Mix).SET-SELF( # $a empty, so $b
  99. Rakudo::QuantHash.MIX-CLONE-ALL-POSITIVE($braw)
  100. ),
  101. mix()
  102. )
  103. )
  104. }
  105. multi sub infix:<(^)>(Mixy:D $a, Baggy:D $b) { $a (^) $b.Mix }
  106. multi sub infix:<(^)>(Mixy:D $a, Setty:D $b) { $a (^) $b.Mix }
  107. multi sub infix:<(^)>(Baggy:D $a, Mixy:D $b) { $a.Mix (^) $b }
  108. multi sub infix:<(^)>(Baggy:D $a, Baggy:D $b) {
  109. nqp::if(
  110. (my $araw := $a.RAW-HASH) && nqp::elems($araw),
  111. nqp::if(
  112. (my $braw := $b.RAW-HASH) && nqp::elems($braw),
  113. nqp::stmts( # both are initialized
  114. nqp::if(
  115. nqp::islt_i(nqp::elems($araw),nqp::elems($braw)),
  116. nqp::stmts( # $a smallest, iterate over it
  117. (my $iter := nqp::iterator(my $base := $araw)),
  118. (my $elems := nqp::clone($braw))
  119. ),
  120. nqp::stmts( # $b smallest, iterate over that
  121. ($iter := nqp::iterator($base := $braw)),
  122. ($elems := nqp::clone($araw))
  123. )
  124. ),
  125. nqp::while(
  126. $iter,
  127. nqp::if( # remove if in both
  128. nqp::existskey($elems,nqp::iterkey_s(nqp::shift($iter))),
  129. nqp::if(
  130. (my int $diff = nqp::sub_i(
  131. nqp::getattr(nqp::iterval($iter),Pair,'$!value'),
  132. nqp::getattr(
  133. nqp::atkey($elems,nqp::iterkey_s($iter)),
  134. Pair,
  135. '$!value'
  136. )
  137. )),
  138. nqp::bindkey(
  139. $elems,
  140. nqp::iterkey_s($iter),
  141. nqp::p6bindattrinvres(
  142. nqp::clone(nqp::iterval($iter)),
  143. Pair,
  144. '$!value',
  145. nqp::abs_i($diff)
  146. )
  147. ),
  148. nqp::deletekey($elems,nqp::iterkey_s($iter))
  149. ),
  150. nqp::bindkey($elems,nqp::iterkey_s($iter),nqp::iterval($iter))
  151. )
  152. ),
  153. nqp::create(Bag).SET-SELF($elems)
  154. ),
  155. nqp::if(nqp::istype($a,Bag),$a,$a.Bag) # $b empty, so $a
  156. ),
  157. nqp::if(nqp::istype($b,Bag),$b,$b.Bag) # $a empty, so $b
  158. )
  159. }
  160. multi sub infix:<(^)>(Baggy:D $a, Setty:D $b) { $a (^) $b.Bag }
  161. multi sub infix:<(^)>(Map:D $a, Map:D $b) {
  162. nqp::if(
  163. nqp::elems((my $elems := Rakudo::QuantHash.COERCE-MAP-TO-SET($a))),
  164. nqp::if( # $a has elems
  165. (my $raw := nqp::getattr(nqp::decont($b),Map,'$!storage'))
  166. && (my $iter := nqp::iterator($raw)),
  167. nqp::stmts(
  168. nqp::if( # both have elems
  169. nqp::eqaddr($b.keyof,Str(Any)),
  170. nqp::while( # ordinary hash
  171. $iter,
  172. nqp::if(
  173. nqp::iterval(nqp::shift($iter)),
  174. nqp::if( # should be checked
  175. nqp::existskey(
  176. $elems,
  177. (my $which := nqp::iterkey_s($iter).WHICH)
  178. ),
  179. nqp::deletekey($elems,$which), # remove existing
  180. nqp::bindkey($elems,$which,nqp::iterkey_s($iter)) # add new
  181. )
  182. )
  183. ),
  184. nqp::while( # object hash
  185. $iter,
  186. nqp::if(
  187. nqp::getattr(nqp::iterval(nqp::shift($iter)),Pair,'$!value'),
  188. nqp::if( # should be checked
  189. nqp::existskey($elems,nqp::iterkey_s($iter)),
  190. nqp::deletekey($elems,nqp::iterkey_s($iter)),# remove existing
  191. nqp::bindkey( # add new
  192. $elems,
  193. nqp::iterkey_s($iter),
  194. nqp::getattr(nqp::iterval($iter),Pair,'$!key')
  195. )
  196. )
  197. )
  198. )
  199. ),
  200. nqp::create(Set).SET-SELF($elems) # done
  201. ),
  202. nqp::create(Set).SET-SELF($elems) # nothing right, so make left
  203. ),
  204. $b.Set # nothing left, coerce right
  205. )
  206. }
  207. multi sub infix:<(^)>(Failure:D $a, Any $b) { $a.throw }
  208. multi sub infix:<(^)>(Any $a, Failure:D $b) { $b.throw }
  209. multi sub infix:<(^)>(Any $a, Any $b) {
  210. nqp::if(
  211. nqp::istype($a,Mixy) || nqp::istype($b,Mixy),
  212. infix:<(^)>($a.Mix, $b.Mix),
  213. nqp::if(
  214. nqp::istype($a,Baggy) || nqp::istype($b,Baggy),
  215. infix:<(^)>($a.Bag, $b.Bag),
  216. infix:<(^)>($a.Set, $b.Set)
  217. )
  218. )
  219. }
  220. multi sub infix:<(^)>(**@p) {
  221. # positions / size in minmax info
  222. my constant COUNT = 0;
  223. my constant LOWEST = 1;
  224. my constant HIGHEST = 2;
  225. my constant SIZE = 3;
  226. # basic minmax for new keys
  227. my $init-minmax := nqp::setelems(nqp::create(IterationBuffer),SIZE);
  228. nqp::bindpos($init-minmax,COUNT,1);
  229. # handle key that has been seen before for given value
  230. sub handle-existing(Mu \elems, Mu \iter, \value --> Nil) {
  231. nqp::stmts(
  232. (my $minmax := nqp::getattr(
  233. nqp::atkey(elems,nqp::iterkey_s(iter)),Pair,'$!value')
  234. ),
  235. nqp::bindpos($minmax,COUNT,nqp::add_i(nqp::atpos($minmax,COUNT),1)),
  236. nqp::if(
  237. value > nqp::atpos($minmax,HIGHEST),
  238. nqp::stmts(
  239. nqp::bindpos($minmax,LOWEST,nqp::atpos($minmax,HIGHEST)),
  240. nqp::bindpos($minmax,HIGHEST,value)
  241. ),
  242. nqp::if(
  243. nqp::not_i(nqp::defined(nqp::atpos($minmax,LOWEST)))
  244. || value > nqp::atpos($minmax,LOWEST),
  245. nqp::bindpos($minmax,LOWEST,value)
  246. )
  247. )
  248. )
  249. }
  250. # handle key that has not yet been seen
  251. sub handle-new(Mu \elems, Mu \iter, \pair, \value) {
  252. nqp::stmts(
  253. (my $minmax := nqp::clone($init-minmax)),
  254. nqp::bindpos($minmax,HIGHEST,value),
  255. nqp::bindkey(
  256. elems,
  257. nqp::iterkey_s(iter),
  258. nqp::p6bindattrinvres(pair,Pair,'$!value',$minmax)
  259. )
  260. )
  261. }
  262. nqp::if(
  263. (my $params := @p.iterator).is-lazy,
  264. Failure.new(X::Cannot::Lazy.new(:action('symmetric diff'))), # bye bye
  265. nqp::stmts( # fixed list of things to diff
  266. (my $elems := nqp::create(Rakudo::Internals::IterationSet)),
  267. (my $type := Set),
  268. (my int $pseen = 0),
  269. nqp::until(
  270. nqp::eqaddr((my $p := $params.pull-one),IterationEnd),
  271. nqp::stmts( # not done parsing
  272. ($pseen = nqp::add_i($pseen,1)),
  273. nqp::if(
  274. nqp::istype($p,Baggy),
  275. nqp::stmts( # Mixy/Baggy semantics apply
  276. nqp::unless(
  277. nqp::istype($type,Mix),
  278. ($type := nqp::if(nqp::istype($p,Mixy),Mix,Bag))
  279. ),
  280. nqp::if(
  281. (my $raw := $p.RAW-HASH) && (my $iter := nqp::iterator($raw)),
  282. nqp::stmts( # something to process
  283. nqp::while(
  284. $iter,
  285. nqp::if(
  286. nqp::existskey(
  287. $elems,
  288. nqp::iterkey_s(nqp::shift($iter))
  289. ),
  290. handle-existing( # seen this element before
  291. $elems,
  292. $iter,
  293. nqp::getattr(nqp::iterval($iter),Pair,'$!value')
  294. ),
  295. handle-new( # new element
  296. $elems,
  297. $iter,
  298. nqp::clone(nqp::iterval($iter)),
  299. nqp::getattr(nqp::iterval($iter),Pair,'$!value')
  300. )
  301. )
  302. )
  303. )
  304. )
  305. ),
  306. nqp::stmts( # not a Baggy/Mixy, assume Set
  307. ($raw := nqp::if(nqp::istype($p,Setty),$p,$p.Set).RAW-HASH)
  308. && ($iter := nqp::iterator($raw)),
  309. nqp::while( # something to process
  310. $iter,
  311. nqp::if(
  312. nqp::existskey($elems,nqp::iterkey_s(nqp::shift($iter))),
  313. handle-existing( # seen this element before
  314. $elems,
  315. $iter,
  316. nqp::istrue(nqp::iterval($iter))
  317. ),
  318. handle-new( # new element
  319. $elems,
  320. $iter,
  321. nqp::p6bindattrinvres(
  322. nqp::create(Pair),Pair,'$!key',nqp::iterval($iter)),
  323. nqp::istrue(nqp::iterval($iter))
  324. )
  325. )
  326. )
  327. )
  328. )
  329. )
  330. ),
  331. ($iter := nqp::iterator($elems)), # start post-processing
  332. nqp::if(
  333. nqp::istype($type,Set),
  334. nqp::while( # need to create a Set
  335. $iter,
  336. nqp::if(
  337. nqp::ifnull(
  338. nqp::atpos(
  339. nqp::getattr(nqp::iterval(nqp::shift($iter)),Pair,'$!value'),
  340. LOWEST
  341. ),
  342. 0
  343. ) == 1,
  344. nqp::deletekey($elems,nqp::iterkey_s($iter)), # seen > 1
  345. nqp::bindkey( # only once
  346. $elems, # convert to
  347. nqp::iterkey_s($iter), # Setty format
  348. nqp::getattr(nqp::iterval($iter),Pair,'$!key')
  349. )
  350. )
  351. ),
  352. nqp::if(
  353. nqp::istype($type,Mix),
  354. nqp::while( # convert to Mixy semantics
  355. $iter,
  356. nqp::stmts(
  357. (my $minmax :=
  358. nqp::getattr(nqp::iterval(nqp::shift($iter)),Pair,'$!value')),
  359. nqp::if(
  360. nqp::islt_i(nqp::atpos($minmax,COUNT),$pseen),
  361. handle-existing($elems,$iter,0) # absentee == value 0 seen
  362. ),
  363. nqp::if(
  364. nqp::ifnull(nqp::atpos($minmax,LOWEST),0)
  365. == nqp::atpos($minmax,HIGHEST),
  366. nqp::deletekey($elems,nqp::iterkey_s($iter)), # top 2 same
  367. nqp::bindattr( # there's a
  368. nqp::iterval($iter), # difference
  369. Pair, # so convert
  370. '$!value',
  371. nqp::atpos($minmax,HIGHEST)
  372. - nqp::ifnull(nqp::atpos($minmax,LOWEST),0)
  373. )
  374. )
  375. )
  376. ),
  377. nqp::while( # convert to Baggy semantics
  378. $iter,
  379. nqp::if(
  380. nqp::ifnull(
  381. nqp::atpos(
  382. ($minmax := nqp::getattr(
  383. nqp::iterval(nqp::shift($iter)),Pair,'$!value')),
  384. LOWEST
  385. ),
  386. 0
  387. ) == nqp::atpos($minmax,HIGHEST),
  388. nqp::deletekey($elems,nqp::iterkey_s($iter)), # top 2 same
  389. nqp::bindattr( # there's a
  390. nqp::iterval($iter), # difference
  391. Pair, # so convert
  392. '$!value',
  393. nqp::atpos($minmax,HIGHEST)
  394. - nqp::ifnull(nqp::atpos($minmax,LOWEST),0)
  395. )
  396. )
  397. )
  398. )
  399. ),
  400. nqp::create($type).SET-SELF($elems)
  401. )
  402. )
  403. }
  404. # U+2296 CIRCLED MINUS
  405. my constant &infix:<⊖> := &infix:<(^)>;