1. proto sub infix:<(elem)>($, $ --> Bool:D) is pure {*}
  2. multi sub infix:<(elem)>(Str:D $a, Map:D $b --> Bool:D) {
  3. nqp::p6bool($b.AT-KEY($a))
  4. }
  5. multi sub infix:<(elem)>(Any $a, Map:D $b --> Bool:D) {
  6. nqp::p6bool(
  7. (my $storage := nqp::getattr(nqp::decont($b),Map,'$!storage'))
  8. && nqp::elems($storage) # haz a haystack
  9. && nqp::not_i(nqp::eqaddr($b.keyof,Str(Any))) # is object hash
  10. && nqp::getattr(
  11. nqp::ifnull(
  12. nqp::atkey($storage,$a.WHICH), # exists
  13. BEGIN # provide virtual value False # did not exist
  14. nqp::p6bindattrinvres(nqp::create(Pair),Pair,'$!value',False)
  15. ),
  16. Pair,
  17. '$!value'
  18. )
  19. )
  20. }
  21. multi sub infix:<(elem)>(Any $a, Iterable:D $b --> Bool:D) {
  22. nqp::stmts(
  23. (my str $needle = $a.WHICH),
  24. (my $iterator := $b.iterator),
  25. nqp::until(
  26. nqp::eqaddr((my $pulled := $iterator.pull-one),IterationEnd),
  27. nqp::if(
  28. nqp::iseq_s($needle,$pulled.WHICH),
  29. return True
  30. )
  31. ),
  32. False
  33. )
  34. }
  35. multi sub infix:<(elem)>(Any $a, QuantHash:D $b --> Bool:D) {
  36. nqp::p6bool(
  37. (my $elems := $b.raw_hash) && nqp::existskey($elems,$a.WHICH)
  38. )
  39. }
  40. multi sub infix:<(elem)>(Any $a, Any $b --> Bool:D) {
  41. $a (elem) $b.Set(:view);
  42. }
  43. # U+2208 ELEMENT OF
  44. only sub infix:<∈>($a, $b --> Bool:D) is pure {
  45. $a (elem) $b;
  46. }
  47. # U+2209 NOT AN ELEMENT OF
  48. only sub infix:<∉>($a, $b --> Bool:D) is pure {
  49. $a !(elem) $b;
  50. }
  51. only sub infix:<(cont)>($a, $b --> Bool:D) is pure { $b (elem) $a }
  52. # U+220B CONTAINS AS MEMBER
  53. only sub infix:<∋>($a, $b --> Bool:D) is pure {
  54. $b (elem) $a;
  55. }
  56. # U+220C DOES NOT CONTAIN AS MEMBER
  57. only sub infix:<∌>($a, $b --> Bool:D) is pure {
  58. not $b (elem) $a;
  59. }
  60. proto sub infix:<(|)>(|) is pure { * }
  61. multi sub infix:<(|)>() { set() }
  62. multi sub infix:<(|)>(QuantHash:D $a) { $a } # Set/Bag/Mix
  63. multi sub infix:<(|)>(SetHash:D $a) { $a.Set }
  64. multi sub infix:<(|)>(BagHash:D $a) { $a.Bag }
  65. multi sub infix:<(|)>(MixHash:D $a) { $a.Mix }
  66. multi sub infix:<(|)>(Any $a) { $a.Set } # also for Iterable/Map
  67. multi sub infix:<(|)>(Setty:D $a, Setty:D $b) {
  68. nqp::if(
  69. (my $araw := $a.raw_hash) && nqp::elems($araw),
  70. nqp::if( # first has elems
  71. (my $braw := $b.raw_hash) && nqp::elems($braw),
  72. nqp::stmts( # second has elems
  73. (my $elems := nqp::clone($araw)),
  74. (my $iter := nqp::iterator($braw)),
  75. nqp::while( # loop over keys of second
  76. $iter,
  77. nqp::bindkey( # bind into clone of first
  78. $elems,
  79. nqp::iterkey_s(nqp::shift($iter)),
  80. nqp::iterval($iter)
  81. )
  82. ),
  83. nqp::create(Set).SET-SELF($elems) # make it a Set
  84. ),
  85. $a.Set # no second, so first
  86. ),
  87. nqp::if( # no first
  88. ($braw := $b.raw_hash) && nqp::elems($braw),
  89. $b.Set, # but second
  90. set() # both empty
  91. )
  92. )
  93. }
  94. multi sub infix:<(|)>(Mixy:D $a, Mixy:D $b) {
  95. nqp::if(
  96. (my $araw := $a.raw_hash) && nqp::elems($araw),
  97. nqp::if( # first has elems
  98. (my $braw := $b.raw_hash) && nqp::elems($braw),
  99. nqp::stmts( # second has elems
  100. (my $elems := nqp::clone($araw)),
  101. (my $iter := nqp::iterator($braw)),
  102. nqp::while( # loop over keys of second
  103. $iter,
  104. nqp::if(
  105. nqp::existskey(
  106. $araw,
  107. (my $key := nqp::iterkey_s(nqp::shift($iter)))
  108. ),
  109. nqp::if( # must use HLL < because values can be bignums
  110. nqp::getattr(
  111. nqp::decont(nqp::atkey($araw,$key)),Pair,'$!value')
  112. < nqp::getattr(
  113. nqp::decont(nqp::atkey($braw,$key)),Pair,'$!value'),
  114. nqp::bindkey($elems,$key,nqp::atkey($braw,$key))
  115. ),
  116. nqp::bindkey($elems,$key,nqp::atkey($braw,$key))
  117. )
  118. ),
  119. nqp::create(Mix).SET-SELF($elems) # make it a Mix
  120. ),
  121. $a.Mix # no second, so first
  122. ),
  123. nqp::if( # no first
  124. ($braw := $b.raw_hash) && nqp::elems($braw),
  125. $b.Mix, # but second
  126. mix() # both empty
  127. )
  128. )
  129. }
  130. multi sub infix:<(|)>(Mixy:D $a, Baggy:D $b) { infix:<(|)>($a, $b.Mix) }
  131. multi sub infix:<(|)>(Baggy:D $a, Mixy:D $b) { infix:<(|)>($a.Mix, $b) }
  132. multi sub infix:<(|)>(Baggy:D $a, Baggy:D $b) {
  133. nqp::if(
  134. (my $araw := $a.raw_hash) && nqp::elems($araw),
  135. nqp::if( # first has elems
  136. (my $braw := $b.raw_hash) && nqp::elems($braw),
  137. nqp::stmts( # second has elems
  138. (my $elems := nqp::clone($araw)),
  139. (my $iter := nqp::iterator($braw)),
  140. nqp::while( # loop over keys of second
  141. $iter,
  142. nqp::if(
  143. nqp::existskey(
  144. $araw,
  145. (my $key := nqp::iterkey_s(nqp::shift($iter)))
  146. ),
  147. nqp::if(
  148. nqp::islt_i(
  149. nqp::getattr(
  150. nqp::decont(nqp::atkey($araw,$key)),Pair,'$!value'),
  151. nqp::getattr(
  152. nqp::decont(nqp::atkey($braw,$key)),Pair,'$!value')
  153. ),
  154. nqp::bindkey($elems,$key,nqp::atkey($braw,$key))
  155. ),
  156. nqp::bindkey($elems,$key,nqp::atkey($braw,$key))
  157. )
  158. ),
  159. nqp::create(Bag).SET-SELF($elems) # make it a Bag
  160. ),
  161. $a.Bag # no second, so first
  162. ),
  163. nqp::if( # no first
  164. ($braw := $b.raw_hash) && nqp::elems($braw),
  165. $b.Bag, # but second
  166. bag() # both empty
  167. )
  168. )
  169. }
  170. multi sub infix:<(|)>(Map:D $a, Map:D $b) {
  171. nqp::if(
  172. nqp::eqaddr($a.keyof,Str(Any)) && nqp::eqaddr($b.keyof,Str(Any)),
  173. nqp::stmts( # both ordinary Str hashes
  174. (my $elems := nqp::create(Rakudo::Internals::IterationSet)),
  175. nqp::if(
  176. (my $raw := nqp::getattr(nqp::decont($a),Map,'$!storage'))
  177. && (my $iter := nqp::iterator($raw)),
  178. nqp::while(
  179. $iter,
  180. nqp::if(
  181. nqp::iterval(nqp::shift($iter)),
  182. nqp::bindkey(
  183. $elems,nqp::iterkey_s($iter).WHICH,nqp::iterkey_s($iter))
  184. )
  185. )
  186. ),
  187. nqp::if(
  188. ($raw := nqp::getattr(nqp::decont($b),Map,'$!storage'))
  189. && ($iter := nqp::iterator($raw)),
  190. nqp::while(
  191. $iter,
  192. nqp::if(
  193. nqp::iterval(nqp::shift($iter)),
  194. nqp::bindkey(
  195. $elems,nqp::iterkey_s($iter).WHICH,nqp::iterkey_s($iter))
  196. )
  197. )
  198. ),
  199. nqp::create(Set).SET-SELF($elems),
  200. ),
  201. $a.Set (|) $b.Set # object hash(es), coerce!
  202. )
  203. }
  204. multi sub infix:<(|)>(Iterable:D $a, Iterable:D $b) {
  205. nqp::if(
  206. (my $aiterator := $a.flat.iterator).is-lazy
  207. || (my $biterator := $b.flat.iterator).is-lazy,
  208. Failure.new(X::Cannot::Lazy.new(:action<union>,:what<set>)),
  209. nqp::create(Set).SET-SELF(
  210. Set.fill_IterationSet(
  211. Set.fill_IterationSet(
  212. nqp::create(Rakudo::Internals::IterationSet),
  213. $aiterator
  214. ),
  215. $biterator
  216. )
  217. )
  218. )
  219. }
  220. multi sub infix:<(|)>(**@p) {
  221. return set() unless @p;
  222. if Rakudo::Internals.ANY_DEFINED_TYPE(@p, Mixy) {
  223. my $mixhash = nqp::istype(@p[0], MixHash)
  224. ?? MixHash.new-from-pairs(@p.shift.pairs)
  225. !! @p.shift.MixHash;
  226. for @p.map(*.Mix(:view)) -> $mix {
  227. for $mix.keys {
  228. # Handle negative weights: don't take max for keys that are zero
  229. $mixhash{$_} ?? ($mixhash{$_} max= $mix{$_})
  230. !! $mixhash{$_} = $mix{$_}
  231. }
  232. }
  233. $mixhash.Mix(:view);
  234. }
  235. elsif Rakudo::Internals.ANY_DEFINED_TYPE(@p, Baggy) {
  236. my $baghash = nqp::istype(@p[0], BagHash)
  237. ?? BagHash.new-from-pairs(@p.shift.pairs)
  238. !! @p.shift.BagHash;
  239. for @p.map(*.Bag(:view)) -> $bag {
  240. $baghash{$_} max= $bag{$_} for $bag.keys;
  241. }
  242. $baghash.Bag(:view);
  243. }
  244. else {
  245. Set.new( @p.map(*.Set(:view).keys.Slip) );
  246. }
  247. }
  248. # U+222A UNION
  249. only sub infix:<∪>(|p) is pure {
  250. infix:<(|)>(|p);
  251. }
  252. proto sub infix:<(&)>(|) is pure { * }
  253. multi sub infix:<(&)>() { set() }
  254. multi sub infix:<(&)>(QuantHash:D $a) { $a } # Set/Bag/Mix
  255. multi sub infix:<(&)>(SetHash:D $a) { $a.Set }
  256. multi sub infix:<(&)>(BagHash:D $a) { $a.Bag }
  257. multi sub infix:<(&)>(MixHash:D $a) { $a.Mix }
  258. multi sub infix:<(&)>(Any $a) { $a.Set } # also for Iterable/Map
  259. multi sub infix:<(&)>(Setty:D $a, Setty:D $b) {
  260. nqp::if(
  261. (my $araw := $a.raw_hash) && nqp::elems($araw)
  262. && (my $braw := $b.raw_hash) && nqp::elems($braw),
  263. nqp::stmts( # both have elems
  264. nqp::if(
  265. nqp::islt_i(nqp::elems($araw),nqp::elems($braw)),
  266. nqp::stmts( # $a smallest, iterate over it
  267. (my $iter := nqp::iterator($araw)),
  268. (my $base := $braw)
  269. ),
  270. nqp::stmts( # $b smallest, iterate over that
  271. ($iter := nqp::iterator($braw)),
  272. ($base := $araw)
  273. )
  274. ),
  275. (my $elems := nqp::create(Rakudo::Internals::IterationSet)),
  276. nqp::while(
  277. $iter,
  278. nqp::if( # bind if in both
  279. nqp::existskey($base,nqp::iterkey_s(nqp::shift($iter))),
  280. nqp::bindkey($elems,nqp::iterkey_s($iter),nqp::iterval($iter))
  281. )
  282. ),
  283. nqp::create(Set).SET-SELF($elems)
  284. ),
  285. set() # one/neither has elems
  286. )
  287. }
  288. multi sub infix:<(&)>(Mixy:D $a, Mixy:D $b) {
  289. nqp::if(
  290. (my $araw := $a.raw_hash) && nqp::elems($araw)
  291. && (my $braw := $b.raw_hash) && nqp::elems($braw),
  292. nqp::stmts( # both have elems
  293. nqp::if(
  294. nqp::islt_i(nqp::elems($araw),nqp::elems($braw)),
  295. nqp::stmts( # $a smallest, iterate over it
  296. (my $iter := nqp::iterator($araw)),
  297. (my $base := $braw)
  298. ),
  299. nqp::stmts( # $b smallest, iterate over that
  300. ($iter := nqp::iterator($braw)),
  301. ($base := $araw)
  302. )
  303. ),
  304. (my $elems := nqp::create(Rakudo::Internals::IterationSet)),
  305. nqp::while(
  306. $iter,
  307. nqp::if( # bind if in both
  308. nqp::existskey($base,nqp::iterkey_s(nqp::shift($iter))),
  309. nqp::bindkey(
  310. $elems,
  311. nqp::iterkey_s($iter),
  312. nqp::if(
  313. nqp::getattr(
  314. nqp::decont(nqp::iterval($iter)),
  315. Pair,
  316. '$!value'
  317. ) < nqp::getattr( # must be HLL comparison
  318. nqp::atkey($base,nqp::iterkey_s($iter)),
  319. Pair,
  320. '$!value'
  321. ),
  322. nqp::iterval($iter),
  323. nqp::atkey($base,nqp::iterkey_s($iter))
  324. )
  325. )
  326. )
  327. ),
  328. nqp::if(
  329. nqp::elems($elems),
  330. nqp::create(Mix).SET-SELF($elems), # overlap, so make it a Mix
  331. mix() # nothing to see here
  332. )
  333. ),
  334. mix() # one/neither has elems
  335. )
  336. }
  337. multi sub infix:<(&)>(Mixy:D $a, Baggy:D $b) { infix:<(&)>($a, $b.Mix) }
  338. multi sub infix:<(&)>(Baggy:D $a, Mixy:D $b) { infix:<(&)>($a.Mix, $b) }
  339. multi sub infix:<(&)>(Baggy:D $a, Baggy:D $b) {
  340. nqp::if(
  341. (my $araw := $a.raw_hash) && nqp::elems($araw)
  342. && (my $braw := $b.raw_hash) && nqp::elems($braw),
  343. nqp::stmts( # both have elems
  344. nqp::if(
  345. nqp::islt_i(nqp::elems($araw),nqp::elems($braw)),
  346. nqp::stmts( # $a smallest, iterate over it
  347. (my $iter := nqp::iterator($araw)),
  348. (my $base := $braw)
  349. ),
  350. nqp::stmts( # $b smallest, iterate over that
  351. ($iter := nqp::iterator($braw)),
  352. ($base := $araw)
  353. )
  354. ),
  355. (my $elems := nqp::create(Rakudo::Internals::IterationSet)),
  356. nqp::while(
  357. $iter,
  358. nqp::if( # bind if in both
  359. nqp::existskey(
  360. $base,
  361. nqp::iterkey_s(nqp::shift($iter))
  362. ),
  363. nqp::bindkey(
  364. $elems,
  365. nqp::iterkey_s($iter),
  366. nqp::if(
  367. nqp::isle_i(
  368. nqp::getattr(
  369. nqp::decont(nqp::iterval($iter)),
  370. Pair,
  371. '$!value'
  372. ),
  373. nqp::getattr(
  374. nqp::atkey($base,nqp::iterkey_s($iter)),
  375. Pair,
  376. '$!value'
  377. )
  378. ),
  379. nqp::iterval($iter),
  380. nqp::atkey($base,nqp::iterkey_s($iter))
  381. )
  382. )
  383. )
  384. ),
  385. nqp::if(
  386. nqp::elems($elems),
  387. nqp::create(Bag).SET-SELF($elems), # overlap, so make it a Bag
  388. bag() # nothing to see here
  389. )
  390. ),
  391. bag() # one/neither has elems
  392. )
  393. }
  394. multi sub infix:<(&)>(Map:D $a, Map:D $b) {
  395. nqp::if(
  396. nqp::eqaddr($a.keyof,Str(Any)) && nqp::eqaddr($b.keyof,Str(Any)),
  397. nqp::if( # both ordinary Str hashes
  398. (my $araw := nqp::getattr(nqp::decont($a),Map,'$!storage'))
  399. && nqp::elems($araw)
  400. && (my $braw := nqp::getattr(nqp::decont($b),Map,'$!storage'))
  401. && nqp::elems($braw),
  402. nqp::stmts( # both are initialized
  403. nqp::if(
  404. nqp::islt_i(nqp::elems($araw),nqp::elems($braw)),
  405. nqp::stmts( # $a smallest, iterate over it
  406. (my $iter := nqp::iterator($araw)),
  407. (my $base := $braw)
  408. ),
  409. nqp::stmts( # $b smallest, iterate over that
  410. ($iter := nqp::iterator($braw)),
  411. ($base := $araw)
  412. )
  413. ),
  414. (my $elems := nqp::create(Rakudo::Internals::IterationSet)),
  415. nqp::while(
  416. $iter,
  417. nqp::if( # create if in both
  418. nqp::existskey(
  419. $base,
  420. nqp::iterkey_s(nqp::shift($iter))
  421. ),
  422. nqp::bindkey(
  423. $elems,nqp::iterkey_s($iter).WHICH,nqp::iterkey_s($iter))
  424. )
  425. ),
  426. nqp::create(Set).SET-SELF($elems)
  427. ),
  428. set() # one/neither has elems
  429. ),
  430. $a.Set (&) $b.Set # object hash(es), coerce!
  431. )
  432. }
  433. multi sub infix:<(&)>(Iterable:D $a, Iterable:D $b) {
  434. nqp::if(
  435. (my $aiterator := $a.flat.iterator).is-lazy
  436. || (my $biterator := $b.flat.iterator).is-lazy,
  437. Failure.new(X::Cannot::Lazy.new(:action<intersect>,:what<set>)),
  438. nqp::if( # won't hang
  439. nqp::elems(my $base := Set.fill_IterationSet(
  440. nqp::create(Rakudo::Internals::IterationSet),
  441. $aiterator
  442. )),
  443. nqp::stmts( # have something to look up in
  444. (my $elems := nqp::create(Rakudo::Internals::IterationSet)),
  445. nqp::until(
  446. nqp::eqaddr((my $pulled := $biterator.pull-one),IterationEnd),
  447. nqp::if(
  448. nqp::existskey($base,(my $which := $pulled.WHICH)),
  449. nqp::bindkey($elems,$which,$pulled)
  450. )
  451. ),
  452. nqp::create(Set).SET-SELF($elems)
  453. ),
  454. set() # nothing to look up in, bye!
  455. )
  456. )
  457. }
  458. multi sub infix:<(&)>(**@p) {
  459. return set() unless @p;
  460. if Rakudo::Internals.ANY_DEFINED_TYPE(@p, Mixy) {
  461. my $mixhash = nqp::istype(@p[0], MixHash)
  462. ?? MixHash.new-from-pairs(@p.shift.pairs)
  463. !! @p.shift.MixHash;
  464. for @p.map(*.Mix(:view)) -> $mix {
  465. $mix{$_}
  466. ?? ($mixhash{$_} min= $mix{$_})
  467. !! $mixhash.DELETE-KEY($_)
  468. for $mixhash.keys;
  469. }
  470. $mixhash.Mix(:view);
  471. }
  472. elsif Rakudo::Internals.ANY_DEFINED_TYPE(@p,Baggy) {
  473. my $baghash = nqp::istype(@p[0], BagHash)
  474. ?? BagHash.new-from-pairs(@p.shift.pairs)
  475. !! @p.shift.BagHash;
  476. for @p.map(*.Bag(:view)) -> $bag {
  477. $bag{$_}
  478. ?? ($baghash{$_} min= $bag{$_})
  479. !! $baghash.DELETE-KEY($_)
  480. for $baghash.keys;
  481. }
  482. $baghash.Bag(:view);
  483. }
  484. else {
  485. my $sethash = nqp::istype(@p[0], SetHash)
  486. ?? SetHash.new(@p.shift.keys)
  487. !! @p.shift.SetHash;
  488. for @p.map(*.Set(:view)) -> $set {
  489. $set{$_} || $sethash.DELETE-KEY($_) for $sethash.keys;
  490. }
  491. $sethash.Set(:view);
  492. }
  493. }
  494. # U+2229 INTERSECTION
  495. only sub infix:<∩>(|p) is pure {
  496. infix:<(&)>(|p);
  497. }
  498. proto sub infix:<(-)>(|) is pure { * }
  499. multi sub infix:<(-)>() { set() }
  500. multi sub infix:<(-)>(QuantHash:D $a) { $a } # Set/Bag/Mix
  501. multi sub infix:<(-)>(SetHash:D $a) { $a.Set }
  502. multi sub infix:<(-)>(BagHash:D $a) { $a.Bag }
  503. multi sub infix:<(-)>(MixHash:D $a) { $a.Mix }
  504. multi sub infix:<(-)>(Any $a) { $a.Set } # also for Iterable/Map
  505. multi sub infix:<(-)>(**@p) {
  506. return set() unless @p;
  507. if Rakudo::Internals.ANY_DEFINED_TYPE(@p,Mixy) {
  508. my $mixhash = nqp::istype(@p[0], MixHash)
  509. ?? MixHash.new-from-pairs(@p.shift.pairs)
  510. !! @p.shift.MixHash;
  511. for @p.map(*.Mix(:view)) -> $mix {
  512. $mix{$_} < $mixhash{$_}
  513. ?? ($mixhash{$_} -= $mix{$_})
  514. !! $mixhash.DELETE-KEY($_)
  515. for $mixhash.keys;
  516. }
  517. $mixhash.Mix(:view);
  518. }
  519. elsif Rakudo::Internals.ANY_DEFINED_TYPE(@p,Baggy) {
  520. my $baghash = nqp::istype(@p[0], BagHash)
  521. ?? BagHash.new-from-pairs(@p.shift.pairs)
  522. !! @p.shift.BagHash;
  523. for @p.map(*.Bag(:view)) -> $bag {
  524. $bag{$_} < $baghash{$_}
  525. ?? ($baghash{$_} -= $bag{$_})
  526. !! $baghash.DELETE-KEY($_)
  527. for $baghash.keys;
  528. }
  529. $baghash.Bag(:view);
  530. }
  531. else {
  532. my $sethash = nqp::istype(@p[0],SetHash)
  533. ?? SetHash.new(@p.shift.keys)
  534. !! @p.shift.SetHash;
  535. for @p.map(*.Set(:view)) -> $set {
  536. $set{$_} && $sethash.DELETE-KEY($_) for $sethash.keys;
  537. }
  538. $sethash.Set(:view);
  539. }
  540. }
  541. # U+2216 SET MINUS
  542. only sub infix:<∖>(|p) is pure {
  543. infix:<(-)>(|p);
  544. }
  545. proto sub infix:<(^)>(|) is pure { * }
  546. multi sub infix:<(^)>() { set() }
  547. multi sub infix:<(^)>(QuantHash:D $a) { $a } # Set/Bag/Mix
  548. multi sub infix:<(^)>(SetHash:D $a) { $a.Set }
  549. multi sub infix:<(^)>(BagHash:D $a) { $a.Bag }
  550. multi sub infix:<(^)>(MixHash:D $a) { $a.Mix }
  551. multi sub infix:<(^)>(Any $a) { $a.Set } # also for Iterable/Map
  552. multi sub infix:<(^)>(Setty:D $a, Setty:D $b) {
  553. nqp::if(
  554. (my $araw := $a.raw_hash) && nqp::elems($araw),
  555. nqp::if(
  556. (my $braw := $b.raw_hash) && nqp::elems($braw),
  557. nqp::stmts( # both are initialized
  558. nqp::if(
  559. nqp::islt_i(nqp::elems($araw),nqp::elems($braw)),
  560. nqp::stmts( # $a smallest, iterate over it
  561. (my $iter := nqp::iterator($araw)),
  562. (my $elems := nqp::clone($braw))
  563. ),
  564. nqp::stmts( # $b smallest, iterate over that
  565. ($iter := nqp::iterator($braw)),
  566. ($elems := nqp::clone($araw))
  567. )
  568. ),
  569. nqp::while(
  570. $iter,
  571. nqp::if( # remove if in both
  572. nqp::existskey($elems,nqp::iterkey_s(nqp::shift($iter))),
  573. nqp::deletekey($elems,nqp::iterkey_s($iter)),
  574. nqp::bindkey($elems,nqp::iterkey_s($iter),nqp::iterval($iter))
  575. )
  576. ),
  577. nqp::create(Set).SET-SELF($elems)
  578. ),
  579. nqp::if(nqp::istype($a,Set),$a,$a.Set) # $b empty, so $a
  580. ),
  581. nqp::if(nqp::istype($b,Set),$b,$b.Set) # $a empty, so $b
  582. )
  583. }
  584. multi sub infix:<(^)>(Mixy:D $a, Mixy:D $b) {
  585. nqp::if(
  586. (my $araw := $a.raw_hash) && nqp::elems($araw),
  587. nqp::if(
  588. (my $braw := $b.raw_hash) && nqp::elems($braw),
  589. nqp::stmts( # both are initialized
  590. nqp::if(
  591. nqp::islt_i(nqp::elems($araw),nqp::elems($braw)),
  592. nqp::stmts( # $a smallest, iterate over it
  593. (my $iter := nqp::iterator(my $base := $araw)),
  594. (my $elems := nqp::clone($braw))
  595. ),
  596. nqp::stmts( # $b smallest, iterate over that
  597. ($iter := nqp::iterator($base := $braw)),
  598. ($elems := nqp::clone($araw))
  599. )
  600. ),
  601. nqp::while(
  602. $iter,
  603. nqp::if( # remove if in both
  604. nqp::existskey($elems,nqp::iterkey_s(nqp::shift($iter))),
  605. nqp::if(
  606. (my $diff := nqp::getattr(nqp::iterval($iter),Pair,'$!value')
  607. - nqp::getattr(
  608. nqp::atkey($elems,nqp::iterkey_s($iter)),
  609. Pair,
  610. '$!value'
  611. )
  612. ),
  613. nqp::bindkey(
  614. $elems,
  615. nqp::iterkey_s($iter),
  616. nqp::p6bindattrinvres(
  617. nqp::clone(nqp::iterval($iter)),Pair,'$!value',abs($diff)
  618. )
  619. ),
  620. nqp::deletekey($elems,nqp::iterkey_s($iter))
  621. ),
  622. nqp::bindkey(
  623. $elems,
  624. nqp::iterkey_s($iter),
  625. nqp::clone(nqp::iterval($iter))
  626. )
  627. )
  628. ),
  629. nqp::if(
  630. nqp::elems($elems),
  631. nqp::create(Mix).SET-SELF($elems), # difference, so make it a Mix
  632. mix() # nothing to see here
  633. )
  634. ),
  635. nqp::if(nqp::istype($a,Mix),$a,$a.Mix) # $b empty, so $a
  636. ),
  637. nqp::if(nqp::istype($b,Mix),$b,$b.Mix) # $a empty, so $b
  638. )
  639. }
  640. multi sub infix:<(^)>(Mixy:D $a, Baggy:D $b) { infix:<(^)>($a, $b.Mix) }
  641. multi sub infix:<(^)>(Baggy:D $a, Mixy:D $b) { infix:<(^)>($a.Mix, $b) }
  642. multi sub infix:<(^)>(Baggy:D $a, Baggy:D $b) {
  643. nqp::if(
  644. (my $araw := $a.raw_hash) && nqp::elems($araw),
  645. nqp::if(
  646. (my $braw := $b.raw_hash) && nqp::elems($braw),
  647. nqp::stmts( # both are initialized
  648. nqp::if(
  649. nqp::islt_i(nqp::elems($araw),nqp::elems($braw)),
  650. nqp::stmts( # $a smallest, iterate over it
  651. (my $iter := nqp::iterator(my $base := $araw)),
  652. (my $elems := nqp::clone($braw))
  653. ),
  654. nqp::stmts( # $b smallest, iterate over that
  655. ($iter := nqp::iterator($base := $braw)),
  656. ($elems := nqp::clone($araw))
  657. )
  658. ),
  659. nqp::while(
  660. $iter,
  661. nqp::if( # remove if in both
  662. nqp::existskey($elems,nqp::iterkey_s(nqp::shift($iter))),
  663. nqp::if(
  664. (my int $diff = nqp::sub_i(
  665. nqp::getattr(nqp::iterval($iter),Pair,'$!value'),
  666. nqp::getattr(
  667. nqp::atkey($elems,nqp::iterkey_s($iter)),
  668. Pair,
  669. '$!value'
  670. )
  671. )),
  672. nqp::bindkey(
  673. $elems,
  674. nqp::iterkey_s($iter),
  675. nqp::p6bindattrinvres(
  676. nqp::clone(nqp::iterval($iter)),
  677. Pair,
  678. '$!value',
  679. nqp::abs_i($diff)
  680. )
  681. ),
  682. nqp::deletekey($elems,nqp::iterkey_s($iter))
  683. ),
  684. nqp::bindkey($elems,nqp::iterkey_s($iter),nqp::iterval($iter))
  685. )
  686. ),
  687. nqp::if(
  688. nqp::elems($elems),
  689. nqp::create(Bag).SET-SELF($elems), # difference, so make it a Bag
  690. bag() # nothing to see here
  691. )
  692. ),
  693. nqp::if(nqp::istype($a,Bag),$a,$a.Bag) # $b empty, so $a
  694. ),
  695. nqp::if(nqp::istype($b,Bag),$b,$b.Bag) # $a empty, so $b
  696. )
  697. }
  698. multi sub infix:<(^)>(Map:D $a, Map:D $b) {
  699. nqp::if(
  700. nqp::eqaddr($a.keyof,Str(Any)) && nqp::eqaddr($b.keyof,Str(Any)),
  701. nqp::if( # both ordinary Str hashes
  702. (my $araw := nqp::getattr(nqp::decont($a),Map,'$!storage'))
  703. && nqp::elems($araw),
  704. nqp::if( # $a has elems
  705. (my $braw := nqp::getattr(nqp::decont($b),Map,'$!storage'))
  706. && nqp::elems($braw),
  707. nqp::stmts( # $b also, need to check both
  708. (my $elems := nqp::create(Rakudo::Internals::IterationSet)),
  709. (my $iter := nqp::iterator($araw)),
  710. nqp::while( # check $a's keys in $b
  711. $iter,
  712. nqp::unless(
  713. nqp::existskey($braw,nqp::iterkey_s(nqp::shift($iter))),
  714. nqp::bindkey(
  715. $elems,nqp::iterkey_s($iter).WHICH,nqp::iterkey_s($iter)
  716. )
  717. )
  718. ),
  719. ($iter := nqp::iterator($braw)),
  720. nqp::while( # check $b's keys in $a
  721. $iter,
  722. nqp::unless(
  723. nqp::existskey($araw,nqp::iterkey_s(nqp::shift($iter))),
  724. nqp::bindkey(
  725. $elems,nqp::iterkey_s($iter).WHICH,nqp::iterkey_s($iter)
  726. )
  727. )
  728. ),
  729. nqp::create(Set).SET-SELF($elems)
  730. ),
  731. $a.Set # no $b, so $a
  732. ),
  733. $b.Set # no $a, so $b
  734. ),
  735. $a.Set (^) $b.Set # object hash(es), coerce!
  736. )
  737. }
  738. multi sub infix:<(^)>(Iterable:D $a, Iterable:D $b) {
  739. nqp::if(
  740. (my $aiterator := $a.flat.iterator).is-lazy
  741. || (my $biterator := $b.flat.iterator).is-lazy,
  742. Failure.new(X::Cannot::Lazy.new(:action('symmetric diff'),:what<set>)),
  743. nqp::stmts(
  744. (my $elems := Set.fill_IterationSet(
  745. nqp::create(Rakudo::Internals::IterationSet),
  746. $aiterator
  747. )),
  748. nqp::until(
  749. nqp::eqaddr((my $pulled := $biterator.pull-one),IterationEnd),
  750. nqp::if(
  751. nqp::existskey($elems,(my $WHICH := $pulled.WHICH)),
  752. nqp::deletekey($elems,$WHICH),
  753. nqp::bindkey($elems,$WHICH,$pulled)
  754. )
  755. ),
  756. nqp::create(Set).SET-SELF($elems)
  757. )
  758. )
  759. }
  760. multi sub infix:<(^)>(**@p) is pure {
  761. return set() unless my $chain = @p.elems;
  762. if $chain == 1 {
  763. return @p[0];
  764. } elsif $chain == 2 {
  765. my ($a, $b) = @p;
  766. my $mixy-or-baggy = False;
  767. if nqp::istype($a, Mixy) || nqp::istype($b, Mixy) {
  768. ($a, $b) = $a.MixHash, $b.MixHash;
  769. $mixy-or-baggy = True;
  770. } elsif nqp::istype($a, Baggy) || nqp::istype($b, Baggy) {
  771. ($a, $b) = $a.BagHash, $b.BagHash;
  772. $mixy-or-baggy = True;
  773. }
  774. return $mixy-or-baggy
  775. # the set formula is not symmetric for bag/mix. this is.
  776. ?? ($a (-) $b) (+) ($b (-) $a)
  777. # set formula for the two-arg set.
  778. !! ($a (|) $b) (-) ($b (&) $a);
  779. } else {
  780. if Rakudo::Internals.ANY_DEFINED_TYPE(@p,Mixy)
  781. || Rakudo::Internals.ANY_DEFINED_TYPE(@p,Baggy) {
  782. my $head;
  783. while (@p) {
  784. my ($a, $b);
  785. if $head.defined {
  786. ($a, $b) = $head, @p.shift;
  787. } else {
  788. ($a, $b) = @p.shift, @p.shift;
  789. }
  790. if nqp::istype($a, Mixy) || nqp::istype($b, Mixy) {
  791. ($a, $b) = $a.MixHash, $b.MixHash;
  792. } elsif nqp::istype($a, Baggy) || nqp::istype($b, Baggy) {
  793. ($a, $b) = $a.BagHash, $b.BagHash;
  794. }
  795. $head = ($a (-) $b) (+) ($b (-) $a);
  796. }
  797. return $head;
  798. } else {
  799. return ([(+)] @p>>.Bag).grep(*.value == 1).Set;
  800. }
  801. }
  802. }
  803. # U+2296 CIRCLED MINUS
  804. only sub infix:<⊖>($a, $b) is pure {
  805. $a (^) $b;
  806. }
  807. multi sub infix:<eqv>(Setty:D \a, Setty:D \b) {
  808. nqp::p6bool(
  809. nqp::unless(
  810. nqp::eqaddr(a,b),
  811. nqp::eqaddr(a.WHAT,b.WHAT) && a.hll_hash eqv b.hll_hash
  812. )
  813. )
  814. }
  815. proto sub infix:<<(<=)>>($, $ --> Bool:D) is pure {*}
  816. multi sub infix:<<(<=)>>(Setty:D $a, Setty:D $b --> Bool:D) {
  817. Rakudo::QuantHash.SET-IS-SUBSET($a,$b)
  818. }
  819. multi sub infix:<<(<=)>>(Setty:D $a, QuantHash:D $b --> Bool:D) {
  820. Rakudo::QuantHash.SET-IS-SUBSET($a,$b)
  821. }
  822. multi sub infix:<<(<=)>>(QuantHash:D $a, Setty:D $b --> Bool:D) {
  823. Rakudo::QuantHash.SET-IS-SUBSET($a,$b)
  824. }
  825. multi sub infix:<<(<=)>>(Mixy:D $a, Mixy:D $b --> Bool:D) {
  826. Rakudo::QuantHash.MIX-IS-SUBSET($a,$b)
  827. }
  828. multi sub infix:<<(<=)>>(Mixy:D $a, Baggy:D $b --> Bool:D) {
  829. Rakudo::QuantHash.MIX-IS-SUBSET($a,$b)
  830. }
  831. multi sub infix:<<(<=)>>(Baggy:D $a, Mixy:D $b --> Bool:D) {
  832. Rakudo::QuantHash.MIX-IS-SUBSET($a,$b)
  833. }
  834. multi sub infix:<<(<=)>>(Baggy:D $a, Baggy:D $b --> Bool:D) {
  835. nqp::stmts(
  836. nqp::unless(
  837. nqp::eqaddr(nqp::decont($a),nqp::decont($b)),
  838. nqp::if(
  839. (my $araw := $a.raw_hash)
  840. && nqp::elems($araw),
  841. nqp::if( # number of elems in B *always* >= A
  842. (my $braw := $b.raw_hash)
  843. && nqp::isle_i(nqp::elems($araw),nqp::elems($braw))
  844. && (my $iter := nqp::iterator($araw)),
  845. nqp::while( # number of elems in B >= A
  846. $iter,
  847. nqp::unless(
  848. nqp::getattr(nqp::iterval(nqp::shift($iter)),Pair,'$!value')
  849. <= # value in A should be less or equal than B
  850. nqp::getattr(
  851. nqp::ifnull(
  852. nqp::atkey($braw,nqp::iterkey_s($iter)),
  853. BEGIN # provide virtual value 0
  854. nqp::p6bindattrinvres(nqp::create(Pair),Pair,'$!value',0)
  855. ),
  856. Pair,
  857. '$!value'
  858. ),
  859. return False
  860. )
  861. ),
  862. return False # number of elems in B smaller than A
  863. )
  864. )
  865. ),
  866. True
  867. )
  868. }
  869. multi sub infix:<<(<=)>>(Map:D $a, Map:D $b --> Bool:D) {
  870. # don't need to check for object hashes, just checking keys is ok
  871. nqp::stmts(
  872. nqp::unless(
  873. nqp::eqaddr(nqp::decont($a),nqp::decont($b)),
  874. nqp::if(
  875. (my $araw := nqp::getattr(nqp::decont($a),Map,'$!storage'))
  876. && nqp::elems($araw),
  877. nqp::if( # number of elems in B *always* >= A
  878. (my $braw := nqp::getattr(nqp::decont($b),Map,'$!storage'))
  879. && nqp::isle_i(nqp::elems($araw),nqp::elems($braw))
  880. && (my $iter := nqp::iterator($araw)),
  881. nqp::while( # number of elems in B >= A
  882. $iter,
  883. nqp::unless(
  884. nqp::existskey($braw,nqp::iterkey_s(nqp::shift($iter))),
  885. return False # elem in A doesn't exist in B
  886. )
  887. ),
  888. return False # number of elems in B smaller than A
  889. )
  890. )
  891. ),
  892. True
  893. )
  894. }
  895. multi sub infix:<<(<=)>>(Any $a, Any $b --> Bool:D) {
  896. nqp::if(
  897. nqp::eqaddr(nqp::decont($a),nqp::decont($b)),
  898. True, # X (<=) X is always True
  899. $a.Set(:view) (<=) $b.Set(:view)
  900. )
  901. }
  902. # U+2286 SUBSET OF OR EQUAL TO
  903. only sub infix:<⊆>($a, $b --> Bool:D) is pure {
  904. $a (<=) $b;
  905. }
  906. # U+2288 NEITHER A SUBSET OF NOR EQUAL TO
  907. only sub infix:<⊈>($a, $b --> Bool:D) is pure {
  908. not $a (<=) $b;
  909. }
  910. proto sub infix:<<(<)>>($, $ --> Bool:D) is pure {*}
  911. multi sub infix:<<(<)>>(Setty:D $a, Setty:D $b --> Bool:D) {
  912. nqp::if(
  913. nqp::eqaddr(nqp::decont($a),nqp::decont($b)),
  914. False, # X is never a true subset of itself
  915. nqp::if(
  916. (my $braw := $b.raw_hash) && nqp::elems($braw),
  917. nqp::if(
  918. (my $araw := $a.raw_hash) && nqp::elems($araw),
  919. nqp::if(
  920. nqp::islt_i(nqp::elems($araw),nqp::elems($braw))
  921. && (my $iter := nqp::iterator($araw)),
  922. nqp::stmts( # A has fewer elems than B
  923. nqp::while(
  924. $iter,
  925. nqp::unless(
  926. nqp::existskey($braw,nqp::iterkey_s(nqp::shift($iter))),
  927. return False # elem in A doesn't exist in B
  928. )
  929. ),
  930. True # all elems in A exist in B
  931. ),
  932. False # number of elems in B smaller or equal to A
  933. ),
  934. True, # no elems in A, and elems in B
  935. ),
  936. False # can never have fewer elems in A than in B
  937. )
  938. )
  939. }
  940. multi sub infix:<<(<)>>(Mixy:D $a, Baggy:D $b --> Bool:D) {
  941. infix:<<(<)>>($a, $b.Mix)
  942. }
  943. multi sub infix:<<(<)>>(Baggy:D $a, Mixy:D $b --> Bool:D) {
  944. infix:<<(<)>>($a.Mix, $b)
  945. }
  946. multi sub infix:<<(<)>>(Mixy:D $a, Mixy:D $b --> Bool:D) {
  947. nqp::if(
  948. nqp::eqaddr(nqp::decont($a),nqp::decont($b)),
  949. False, # X is never a true subset of itself
  950. nqp::if(
  951. (my $araw := $a.raw_hash) && nqp::elems($araw),
  952. nqp::if( # elems in A
  953. (my $braw := $b.raw_hash) && nqp::elems($braw),
  954. nqp::stmts( # elems in A and B
  955. (my $iter := nqp::iterator($araw)),
  956. nqp::while( # check all values in A with B
  957. $iter,
  958. nqp::unless(
  959. nqp::getattr(nqp::iterval(nqp::shift($iter)),Pair,'$!value')
  960. < # value in A should be less than (virtual) B
  961. nqp::getattr(
  962. nqp::ifnull(
  963. nqp::atkey($braw,nqp::iterkey_s($iter)),
  964. BEGIN # provide virtual value 0
  965. nqp::p6bindattrinvres(nqp::create(Pair),Pair,'$!value',0)
  966. ),
  967. Pair,
  968. '$!value'
  969. ),
  970. return False
  971. )
  972. ),
  973. ($iter := nqp::iterator($braw)),
  974. nqp::while( # check all values in B with A
  975. $iter,
  976. nqp::unless(
  977. nqp::getattr(nqp::iterval(nqp::shift($iter)),Pair,'$!value')
  978. > # value in B should be more than (virtual) A
  979. nqp::getattr(
  980. nqp::ifnull(
  981. nqp::atkey($araw,nqp::iterkey_s($iter)),
  982. BEGIN # provide virtual value 0
  983. nqp::p6bindattrinvres(nqp::create(Pair),Pair,'$!value',0)
  984. ),
  985. Pair,
  986. '$!value'
  987. ),
  988. return False
  989. )
  990. ),
  991. True # all checks worked out, so ok
  992. ),
  993. # nothing in B, all elems in A should be < 0
  994. Rakudo::QuantHash.MIX-ALL-NEGATIVE($araw)
  995. ),
  996. nqp::if( # nothing in A
  997. ($braw := $b.raw_hash) && nqp::elems($braw),
  998. # something in B, all elems in B should be > 0
  999. Rakudo::QuantHash.MIX-ALL-POSITIVE($braw),
  1000. False # nothing in A nor B
  1001. )
  1002. )
  1003. )
  1004. }
  1005. multi sub infix:<<(<)>>(Baggy:D $a, Baggy:D $b --> Bool:D) {
  1006. nqp::if(
  1007. nqp::eqaddr($a,$b),
  1008. False, # X is never a true subset of itself
  1009. nqp::if(
  1010. (my $braw := $b.raw_hash) && nqp::elems($braw),
  1011. nqp::if(
  1012. (my $araw := $a.raw_hash) && nqp::elems($araw),
  1013. nqp::if(
  1014. nqp::islt_i(nqp::elems($araw),nqp::elems($braw))
  1015. && (my $iter := nqp::iterator($araw)),
  1016. nqp::stmts( # A has fewer elems than B
  1017. nqp::while(
  1018. $iter,
  1019. nqp::unless(
  1020. nqp::getattr(nqp::iterval(nqp::shift($iter)),Pair,'$!value')
  1021. <
  1022. nqp::getattr(
  1023. nqp::ifnull(
  1024. nqp::atkey($braw,nqp::iterkey_s($iter)),
  1025. BEGIN nqp::p6bindattrinvres( # virtual 0
  1026. nqp::create(Pair),Pair,'$!value',0)
  1027. ),
  1028. Pair,
  1029. '$!value'
  1030. ),
  1031. return False # elem in A not in B or same or more in B
  1032. )
  1033. ),
  1034. True # all elems in A exist in B and are less
  1035. ),
  1036. False # number of elems in B smaller or equal to A
  1037. ),
  1038. True # elems in B, no elems in A
  1039. ),
  1040. False # can never have fewer elems in A than in B
  1041. )
  1042. )
  1043. }
  1044. multi sub infix:<<(<)>>(Map:D $a, Map:D $b --> Bool:D) {
  1045. # don't need to check for object hashes, just checking keys is ok
  1046. nqp::if(
  1047. nqp::eqaddr(nqp::decont($a),nqp::decont($b)),
  1048. False, # X is never a true subset of itself
  1049. nqp::if(
  1050. (my $braw := nqp::getattr(nqp::decont($b),Map,'$!storage'))
  1051. && nqp::elems($braw),
  1052. nqp::if(
  1053. (my $araw := nqp::getattr(nqp::decont($a),Map,'$!storage'))
  1054. && nqp::islt_i(nqp::elems($araw),nqp::elems($braw))
  1055. && (my $iter := nqp::iterator($araw)),
  1056. nqp::stmts( # A has fewer elems than B
  1057. nqp::while(
  1058. $iter,
  1059. nqp::unless(
  1060. nqp::existskey($braw,nqp::iterkey_s(nqp::shift($iter))),
  1061. return False # elem in A doesn't exist in B
  1062. )
  1063. ),
  1064. True # all elems in A exist in B
  1065. ),
  1066. False # number of elems in B smaller or equal to A
  1067. ),
  1068. False # can never have fewer elems in A than in B
  1069. )
  1070. )
  1071. }
  1072. multi sub infix:<<(<)>>(Any $a, Any $b --> Bool:D) {
  1073. nqp::if(
  1074. nqp::eqaddr(nqp::decont($a),nqp::decont($b)),
  1075. False, # X (<) X is always False
  1076. $a.Set(:view) (<) $b.Set(:view)
  1077. )
  1078. }
  1079. # U+2282 SUBSET OF
  1080. only sub infix:<⊂>($a, $b --> Bool:D) is pure {
  1081. $a (<) $b;
  1082. }
  1083. # U+2284 NOT A SUBSET OF
  1084. only sub infix:<⊄>($a, $b --> Bool:D) is pure {
  1085. not $a (<) $b;
  1086. }
  1087. only sub infix:<<(>=)>>(Any $a, Any $b --> Bool:D) {
  1088. $b (<=) $a
  1089. }
  1090. # U+2287 SUPERSET OF OR EQUAL TO
  1091. only sub infix:<⊇>($a, $b --> Bool:D) is pure {
  1092. $b (<=) $a
  1093. }
  1094. # U+2289 NEITHER A SUPERSET OF NOR EQUAL TO
  1095. only sub infix:<⊉>($a, $b --> Bool:D) is pure {
  1096. not $b (<=) $a
  1097. }
  1098. only sub infix:<<(>)>>(Any $a, Any $b --> Bool:D) {
  1099. $b (<) $a
  1100. }
  1101. # U+2283 SUPERSET OF
  1102. only sub infix:<⊃>($a, $b --> Bool:D) is pure {
  1103. $b (<) $a
  1104. }
  1105. # U+2285 NOT A SUPERSET OF
  1106. only sub infix:<⊅>($a, $b --> Bool:D) is pure {
  1107. not $b (<) $a
  1108. }
  1109. proto sub infix:<(.)>(|) is pure { * }
  1110. multi sub infix:<(.)>() { bag() }
  1111. multi sub infix:<(.)>(Bag:D $a) { $a }
  1112. multi sub infix:<(.)>(Mix:D $a) { $a }
  1113. multi sub infix:<(.)>(MixHash:D $a) { $a.Mix }
  1114. multi sub infix:<(.)>(Any $a) { $a.Bag }
  1115. multi sub infix:<(.)>(Setty:D $a, Setty:D $b) {
  1116. nqp::if(
  1117. (my $elems := $a.Bag.raw_hash) && nqp::elems($elems),
  1118. nqp::stmts(
  1119. Rakudo::QuantHash.MULTIPLY-SET-TO-BAG($elems,$b.raw_hash),
  1120. nqp::if(
  1121. nqp::elems($elems),
  1122. nqp::create(Bag).SET-SELF($elems),
  1123. bag()
  1124. )
  1125. ),
  1126. bag()
  1127. )
  1128. }
  1129. multi sub infix:<(.)>(Mixy:D $a, Mixy:D $b) {
  1130. nqp::if(
  1131. (my $elems := Rakudo::QuantHash.BAGGY-CLONE-RAW($a.raw_hash))
  1132. && nqp::elems($elems),
  1133. nqp::stmts(
  1134. Rakudo::QuantHash.MULTIPLY-MIX-TO-MIX($elems,$b.raw_hash),
  1135. nqp::if(
  1136. nqp::elems($elems),
  1137. nqp::create(Mix).SET-SELF($elems),
  1138. mix()
  1139. )
  1140. ),
  1141. mix()
  1142. )
  1143. }
  1144. multi sub infix:<(.)>(Mixy:D $a, Baggy:D $b) { infix:<(.)>($a, $b.Mix) }
  1145. multi sub infix:<(.)>(Baggy:D $a, Mixy:D $b) { infix:<(.)>($a.Mix, $b) }
  1146. multi sub infix:<(.)>(Baggy:D $a, Baggy:D $b) {
  1147. nqp::if(
  1148. (my $elems := Rakudo::QuantHash.BAGGY-CLONE-RAW($a.raw_hash))
  1149. && nqp::elems($elems),
  1150. nqp::stmts(
  1151. Rakudo::QuantHash.MULTIPLY-BAG-TO-BAG($elems,$b.raw_hash),
  1152. nqp::if(
  1153. nqp::elems($elems),
  1154. nqp::create(Bag).SET-SELF($elems),
  1155. bag()
  1156. )
  1157. ),
  1158. bag()
  1159. )
  1160. }
  1161. multi sub infix:<(.)>(Any:D $a, Any:D $b) { $a.Bag (.) $b.Bag }
  1162. multi sub infix:<(.)>(**@p) is pure {
  1163. return bag() unless @p;
  1164. if Rakudo::Internals.ANY_DEFINED_TYPE(@p,Mixy) {
  1165. my $mixhash = nqp::istype(@p[0], MixHash)
  1166. ?? MixHash.new-from-pairs(@p.shift.pairs)
  1167. !! @p.shift.MixHash;
  1168. for @p.map(*.Mix(:view)) -> $mix {
  1169. $mix{$_}
  1170. ?? ($mixhash{$_} *= $mix{$_})
  1171. !! $mixhash.DELETE-KEY($_)
  1172. for $mixhash.keys;
  1173. }
  1174. $mixhash.Mix(:view);
  1175. }
  1176. else { # go Baggy by default
  1177. my $baghash = nqp::istype(@p[0], BagHash)
  1178. ?? BagHash.new-from-pairs(@p.shift.pairs)
  1179. !! @p.shift.BagHash;
  1180. for @p.map(*.Bag(:view)) -> $bag {
  1181. $bag{$_}
  1182. ?? ($baghash{$_} *= $bag{$_})
  1183. !! $baghash.DELETE-KEY($_)
  1184. for $baghash.keys;
  1185. }
  1186. $baghash.Bag(:view);
  1187. }
  1188. }
  1189. # U+228D MULTISET MULTIPLICATION
  1190. only sub infix:<⊍>(|p) is pure {
  1191. infix:<(.)>(|p);
  1192. }
  1193. proto sub infix:<(+)>(|) is pure { * }
  1194. multi sub infix:<(+)>() { bag() }
  1195. multi sub infix:<(+)>(Bag:D $a) { $a }
  1196. multi sub infix:<(+)>(Mix:D $a) { $a }
  1197. multi sub infix:<(+)>(MixHash:D $a) { $a.Mix }
  1198. multi sub infix:<(+)>(Any $a) { $a.Bag }
  1199. multi sub infix:<(+)>(Setty:D $a, Setty:D $b) {
  1200. nqp::stmts(
  1201. Rakudo::QuantHash.ADD-SET-TO-BAG(
  1202. (my $elems := nqp::create(Rakudo::Internals::IterationSet)),
  1203. $a.raw_hash
  1204. ),
  1205. Rakudo::QuantHash.ADD-SET-TO-BAG($elems,$b.raw_hash),
  1206. nqp::if(
  1207. nqp::elems($elems),
  1208. nqp::create(Bag).SET-SELF($elems),
  1209. bag()
  1210. )
  1211. )
  1212. }
  1213. multi sub infix:<(+)>(Mixy:D $a, Mixy:D $b) {
  1214. nqp::stmts(
  1215. Rakudo::QuantHash.ADD-MIX-TO-MIX(
  1216. (my $elems := nqp::create(Rakudo::Internals::IterationSet)),
  1217. $a.raw_hash
  1218. ),
  1219. Rakudo::QuantHash.ADD-MIX-TO-MIX($elems,$b.raw_hash),
  1220. nqp::if(
  1221. nqp::elems($elems),
  1222. nqp::create(Mix).SET-SELF($elems),
  1223. mix()
  1224. )
  1225. )
  1226. }
  1227. multi sub infix:<(+)>(Mixy:D $a, Baggy:D $b) { infix:<(+)>($a, $b.Mix) }
  1228. multi sub infix:<(+)>(Baggy:D $a, Mixy:D $b) { infix:<(+)>($a.Mix, $b) }
  1229. multi sub infix:<(+)>(Baggy:D $a, Baggy:D $b) {
  1230. nqp::stmts(
  1231. Rakudo::QuantHash.ADD-BAG-TO-BAG(
  1232. (my $elems := nqp::create(Rakudo::Internals::IterationSet)),
  1233. $a.raw_hash
  1234. ),
  1235. Rakudo::QuantHash.ADD-BAG-TO-BAG($elems,$b.raw_hash),
  1236. nqp::if(
  1237. nqp::elems($elems),
  1238. nqp::create(Bag).SET-SELF($elems),
  1239. bag()
  1240. )
  1241. )
  1242. }
  1243. multi sub infix:<(+)>(Any:D $a, Any:D $b) { $a.Bag (+) $b.Bag }
  1244. multi sub infix:<(+)>(**@p) is pure {
  1245. return bag() unless @p;
  1246. if Rakudo::Internals.ANY_DEFINED_TYPE(@p,Mixy) {
  1247. my $mixhash = nqp::istype(@p[0], MixHash)
  1248. ?? MixHash.new-from-pairs(@p.shift.pairs)
  1249. !! @p.shift.MixHash;
  1250. for @p.map(*.Mix(:view)) -> $mix {
  1251. $mixhash{$_} += $mix{$_} for $mix.keys;
  1252. }
  1253. $mixhash.Mix(:view);
  1254. }
  1255. else { # go Baggy by default
  1256. my $baghash = nqp::istype(@p[0], BagHash)
  1257. ?? BagHash.new-from-pairs(@p.shift.pairs)
  1258. !! @p.shift.BagHash;
  1259. for @p.map(*.Bag(:view)) -> $bag {
  1260. $baghash{$_} += $bag{$_} for $bag.keys;
  1261. }
  1262. $baghash.Bag(:view);
  1263. }
  1264. }
  1265. # U+228E MULTISET UNION
  1266. only sub infix:<⊎>(|p) is pure {
  1267. infix:<(+)>(|p);
  1268. }
  1269. proto sub infix:<<(<+)>>($, $ --> Bool:D) is pure {*}
  1270. multi sub infix:<<(<+)>>(Setty:D \a, QuantHash:D \b --> Bool:D) {
  1271. nqp::if(
  1272. (my $a := a.raw_hash),
  1273. nqp::if(
  1274. (my $b := b.raw_hash) && nqp::isge_i(nqp::elems($b),nqp::elems($a)),
  1275. nqp::stmts(
  1276. (my $iter := nqp::iterator($a)),
  1277. nqp::while(
  1278. $iter && nqp::existskey($b,nqp::iterkey_s(nqp::shift($iter))),
  1279. nqp::null
  1280. ),
  1281. nqp::p6bool(nqp::isfalse($iter))
  1282. ),
  1283. False
  1284. ),
  1285. True
  1286. )
  1287. }
  1288. multi sub infix:<<(<+)>>(Mixy:D \a, Baggy:D \b --> Bool:D) {
  1289. nqp::if(
  1290. (my $a := a.raw_hash),
  1291. nqp::if(
  1292. (my $b := b.raw_hash) && nqp::isge_i(nqp::elems($b),nqp::elems($a)),
  1293. nqp::stmts(
  1294. (my $iter := nqp::iterator($a)),
  1295. nqp::while(
  1296. $iter,
  1297. nqp::if(
  1298. nqp::not_i(nqp::existskey(
  1299. $b,
  1300. (my $key := nqp::iterkey_s(nqp::shift($iter)))
  1301. )) ||
  1302. nqp::getattr(nqp::decont(nqp::atkey($a,$key)),Pair,'$!value')
  1303. > nqp::getattr(nqp::decont(nqp::atkey($b,$key)),Pair,'$!value'),
  1304. (return False)
  1305. )
  1306. ),
  1307. True
  1308. ),
  1309. False
  1310. ),
  1311. True
  1312. )
  1313. }
  1314. multi sub infix:<<(<+)>>(Baggy:D \a, Baggy:D \b --> Bool:D) {
  1315. nqp::if(
  1316. (my $a := a.raw_hash),
  1317. nqp::if(
  1318. (my $b := b.raw_hash) && nqp::isge_i(nqp::elems($b),nqp::elems($a)),
  1319. nqp::stmts(
  1320. (my $iter := nqp::iterator($a)),
  1321. nqp::while(
  1322. $iter,
  1323. nqp::if(
  1324. nqp::not_i(nqp::existskey(
  1325. $b,
  1326. (my $key := nqp::iterkey_s(nqp::shift($iter)))
  1327. )) ||
  1328. nqp::isgt_i(
  1329. nqp::getattr(nqp::decont(nqp::atkey($a,$key)),Pair,'$!value'),
  1330. nqp::getattr(nqp::decont(nqp::atkey($b,$key)),Pair,'$!value')
  1331. ),
  1332. (return False)
  1333. )
  1334. ),
  1335. True
  1336. ),
  1337. False
  1338. ),
  1339. True
  1340. )
  1341. }
  1342. multi sub infix:<<(<+)>>(QuantHash:U $a, QuantHash:U $b --> True ) {}
  1343. multi sub infix:<<(<+)>>(QuantHash:U $a, QuantHash:D $b --> True ) {}
  1344. multi sub infix:<<(<+)>>(QuantHash:D $a, QuantHash:U $b --> Bool:D ) {
  1345. not $a.elems
  1346. }
  1347. multi sub infix:<<(<+)>>(QuantHash:D $a, QuantHash:D $b --> Bool:D ) {
  1348. return False if $a.AT-KEY($_) > $b.AT-KEY($_) for $a.keys;
  1349. True
  1350. }
  1351. multi sub infix:<<(<+)>>(Any $a, Any $b --> Bool:D) {
  1352. if nqp::istype($a, Mixy) or nqp::istype($b, Mixy) {
  1353. $a.Mix(:view) (<+) $b.Mix(:view);
  1354. } else {
  1355. $a.Bag(:view) (<+) $b.Bag(:view);
  1356. }
  1357. }
  1358. # U+227C PRECEDES OR EQUAL TO
  1359. only sub infix:<≼>($a, $b --> Bool:D) is pure {
  1360. $a (<+) $b;
  1361. }
  1362. # $a (>+) $b === $a R(<+) $b
  1363. only sub infix:<<(>+)>>($a, $b --> Bool:D) is pure {
  1364. $b (<+) $a
  1365. }
  1366. # U+227D SUCCEEDS OR EQUAL TO
  1367. only sub infix:<≽>($a, $b --> Bool:D) is pure {
  1368. $b (<+) $a;
  1369. }
  1370. proto sub set(|) { * }
  1371. multi sub set() { BEGIN nqp::create(Set) }
  1372. multi sub set(*@a --> Set:D) { Set.new(@a) }
  1373. proto sub bag(|) { * }
  1374. multi sub bag() { BEGIN nqp::create(Bag) }
  1375. multi sub bag(*@a --> Bag:D) { Bag.new(@a) }
  1376. proto sub mix(|) { * }
  1377. multi sub mix() { BEGIN nqp::create(Mix) }
  1378. multi sub mix(*@a --> Mix:D) { Mix.new(@a) }