1. my role Real { ... }
  2. my class Rakudo::QuantHash {
  3. # a Pair with the value 0
  4. my $p0 := nqp::p6bindattrinvres(nqp::create(Pair),Pair,'$!value',0);
  5. # Specialized role for .kv methods on QuantHashes: copied methods
  6. # from Quanty because of visibility issues wrt to $!elems and $!iter :-(
  7. our role Quanty-kv does Iterator {
  8. has $!elems;
  9. has $!iter;
  10. has $!on;
  11. method SET-SELF(\elems) {
  12. nqp::stmts(
  13. ($!elems := elems),
  14. ($!iter := nqp::iterator(elems)),
  15. self
  16. )
  17. }
  18. method new(\quanthash) {
  19. nqp::if(
  20. (my $elems := quanthash.RAW-HASH) && nqp::elems($elems),
  21. nqp::create(self).SET-SELF($elems),
  22. Rakudo::Iterator.Empty # nothing to iterate
  23. )
  24. }
  25. method skip-one() {
  26. nqp::if(
  27. $!on,
  28. nqp::not_i($!on = 0),
  29. nqp::if(
  30. $!iter,
  31. nqp::stmts(
  32. nqp::shift($!iter),
  33. ($!on = 1)
  34. )
  35. )
  36. )
  37. }
  38. method count-only() {
  39. nqp::add_i(nqp::elems($!elems),nqp::elems($!elems))
  40. }
  41. method bool-only(--> True) { }
  42. method sink-all(--> IterationEnd) { $!iter := nqp::null }
  43. }
  44. our role Pairs does Iterator {
  45. has $!elems;
  46. has $!picked;
  47. method !SET-SELF(\elems,\count) {
  48. nqp::stmts(
  49. ($!elems := elems),
  50. ($!picked := Rakudo::QuantHash.PICK-N(elems, count)),
  51. self
  52. )
  53. }
  54. method new(Mu \elems, \count) {
  55. nqp::if(
  56. (my $todo := Rakudo::QuantHash.TODO(count))
  57. && elems
  58. && nqp::elems(elems),
  59. nqp::create(self)!SET-SELF(elems, $todo),
  60. Rakudo::Iterator.Empty
  61. )
  62. }
  63. }
  64. # Return the iterator state of a randomly selected entry in a
  65. # given IterationSet
  66. method ROLL(Mu \elems) {
  67. nqp::stmts(
  68. (my int $i = nqp::add_i(nqp::rand_n(nqp::elems(elems)),1)),
  69. (my $iter := nqp::iterator(elems)),
  70. nqp::while(
  71. nqp::shift($iter) && ($i = nqp::sub_i($i,1)),
  72. nqp::null
  73. ),
  74. $iter
  75. )
  76. }
  77. # Return a list_s of N keys of the given IterationSet in random order.
  78. method PICK-N(Mu \elems, \count) {
  79. nqp::stmts(
  80. (my int $elems = nqp::elems(elems)),
  81. (my int $count = nqp::if(count > $elems,$elems,count)),
  82. (my $keys := nqp::setelems(nqp::list_s,$elems)),
  83. (my $iter := nqp::iterator(elems)),
  84. (my int $i = -1),
  85. nqp::while(
  86. nqp::islt_i(($i = nqp::add_i($i,1)),$elems),
  87. nqp::bindpos_s($keys,$i,nqp::iterkey_s(nqp::shift($iter)))
  88. ),
  89. (my $picked := nqp::setelems(nqp::list_s,$count)),
  90. ($i = -1),
  91. nqp::while(
  92. nqp::islt_i(($i = nqp::add_i($i,1)),$count),
  93. nqp::stmts(
  94. nqp::bindpos_s($picked,$i,
  95. nqp::atpos_s($keys,(my int $pick = $elems.rand.floor))
  96. ),
  97. nqp::bindpos_s($keys,$pick,
  98. nqp::atpos_s($keys,($elems = nqp::sub_i($elems,1)))
  99. )
  100. )
  101. ),
  102. $picked
  103. )
  104. }
  105. # Return number of items to be done if > 0, or 0 if < 1, or throw if NaN
  106. method TODO(\count) is raw {
  107. nqp::if(
  108. count < 1,
  109. 0,
  110. nqp::if(
  111. count == Inf,
  112. count,
  113. nqp::if(
  114. nqp::istype((my $todo := count.Int),Failure),
  115. $todo.throw,
  116. $todo
  117. )
  118. )
  119. )
  120. }
  121. # Return an nqp::list_s of all keys of a QuantHash
  122. method RAW-KEYS(\quanthash) is raw {
  123. nqp::if(
  124. (my $elems := quanthash.RAW-HASH)
  125. && (my $iter := nqp::iterator($elems)),
  126. nqp::stmts(
  127. (my $keys := nqp::setelems(nqp::list_s,nqp::elems($elems))),
  128. (my int $i = -1),
  129. nqp::while(
  130. $iter,
  131. nqp::bindpos_s(
  132. $keys,
  133. ($i = nqp::add_i($i,1)),
  134. nqp::iterkey_s(nqp::shift($iter))
  135. )
  136. ),
  137. $keys
  138. ),
  139. nqp::list_s
  140. )
  141. }
  142. # Return an nqp::list_s of all values of a QuantHash, mapped to a str
  143. method RAW-VALUES-MAP(\quanthash, &mapper) is raw {
  144. nqp::if(
  145. (my $elems := quanthash.RAW-HASH)
  146. && (my $iter := nqp::iterator($elems)),
  147. nqp::stmts(
  148. (my $values := nqp::setelems(nqp::list_s,nqp::elems($elems))),
  149. (my int $i = -1),
  150. nqp::while(
  151. $iter,
  152. nqp::bindpos_s(
  153. $values,
  154. ($i = nqp::add_i($i,1)),
  155. mapper(nqp::iterval(nqp::shift($iter)))
  156. )
  157. ),
  158. $values
  159. ),
  160. nqp::list_s
  161. )
  162. }
  163. # Return an nqp::list_s of all keys in a Baggy with the weight
  164. # joined with a null-byte inbetween.
  165. method BAGGY-RAW-KEY-VALUES(\baggy) is raw {
  166. nqp::if(
  167. (my $elems := baggy.RAW-HASH)
  168. && (my $iter := nqp::iterator($elems)),
  169. nqp::stmts(
  170. (my $list := nqp::setelems(nqp::list_s,nqp::elems($elems))),
  171. (my int $i = -1),
  172. nqp::while(
  173. $iter,
  174. nqp::stmts(
  175. nqp::shift($iter),
  176. nqp::bindpos_s(
  177. $list,
  178. ($i = nqp::add_i($i,1)),
  179. nqp::concat(
  180. nqp::iterkey_s($iter),
  181. nqp::concat(
  182. '\0',
  183. nqp::getattr(nqp::iterval($iter),Pair,'$!value').Str
  184. )
  185. )
  186. )
  187. )
  188. ),
  189. $list
  190. ),
  191. nqp::list_s
  192. )
  193. }
  194. # Create intersection of 2 Baggies, default to given empty type
  195. method INTERSECT-BAGGIES(\a,\b,\empty) {
  196. nqp::if(
  197. (my $araw := a.RAW-HASH) && nqp::elems($araw)
  198. && (my $braw := b.RAW-HASH) && nqp::elems($braw),
  199. nqp::stmts( # both have elems
  200. nqp::if(
  201. nqp::islt_i(nqp::elems($araw),nqp::elems($braw)),
  202. nqp::stmts( # $a smallest, iterate over it
  203. (my $iter := nqp::iterator($araw)),
  204. (my $base := $braw)
  205. ),
  206. nqp::stmts( # $b smallest, iterate over that
  207. ($iter := nqp::iterator($braw)),
  208. ($base := $araw)
  209. )
  210. ),
  211. (my $elems := nqp::create(Rakudo::Internals::IterationSet)),
  212. nqp::while(
  213. $iter,
  214. nqp::if( # bind if in both
  215. nqp::existskey($base,nqp::iterkey_s(nqp::shift($iter))),
  216. nqp::bindkey(
  217. $elems,
  218. nqp::iterkey_s($iter),
  219. nqp::if(
  220. nqp::getattr(
  221. nqp::decont(nqp::iterval($iter)),
  222. Pair,
  223. '$!value'
  224. ) < nqp::getattr( # must be HLL comparison
  225. nqp::atkey($base,nqp::iterkey_s($iter)),
  226. Pair,
  227. '$!value'
  228. ),
  229. nqp::iterval($iter),
  230. nqp::atkey($base,nqp::iterkey_s($iter))
  231. )
  232. )
  233. )
  234. ),
  235. nqp::create(empty.WHAT).SET-SELF($elems),
  236. ),
  237. empty # one/neither has elems
  238. )
  239. }
  240. # create a deep clone of the given IterSet with baggy
  241. method BAGGY-CLONE(\raw) {
  242. nqp::stmts(
  243. (my $elems := nqp::clone(raw)),
  244. (my $iter := nqp::iterator($elems)),
  245. nqp::while(
  246. $iter,
  247. nqp::bindkey(
  248. $elems,
  249. nqp::iterkey_s(nqp::shift($iter)),
  250. nqp::p6bindattrinvres(
  251. nqp::clone(nqp::iterval($iter)),
  252. Pair,
  253. '$!value',
  254. nqp::getattr(nqp::iterval($iter),Pair,'$!value')
  255. )
  256. )
  257. ),
  258. $elems
  259. )
  260. }
  261. #--- Set/SetHash related methods
  262. # Create an IterationSet with baggy semantics from IterationSet with
  263. # Setty semantics.
  264. method SET-BAGGIFY(\raw) {
  265. nqp::stmts(
  266. (my $elems := nqp::clone(raw)),
  267. (my $iter := nqp::iterator($elems)),
  268. nqp::while(
  269. $iter,
  270. nqp::bindkey(
  271. $elems,
  272. nqp::iterkey_s(nqp::shift($iter)),
  273. Pair.new(nqp::decont(nqp::iterval($iter)),1)
  274. )
  275. ),
  276. $elems
  277. )
  278. }
  279. # add to given IterationSet with setty semantics the values of iterator
  280. method ADD-ITERATOR-TO-SET(\elems,Mu \iterator) {
  281. nqp::stmts(
  282. nqp::until(
  283. nqp::eqaddr(
  284. (my $pulled := nqp::decont(iterator.pull-one)),
  285. IterationEnd
  286. ),
  287. nqp::bindkey(elems,$pulled.WHICH,$pulled)
  288. ),
  289. elems
  290. )
  291. }
  292. # Add to IterationSet with setty semantics the values of the given
  293. # iterator while checking for Pairs (only include if value is trueish)
  294. method ADD-PAIRS-TO-SET(\elems,Mu \iterator) {
  295. nqp::stmts(
  296. nqp::until(
  297. nqp::eqaddr((my $pulled := iterator.pull-one),IterationEnd),
  298. nqp::if(
  299. nqp::istype($pulled,Pair),
  300. nqp::if(
  301. nqp::getattr(nqp::decont($pulled),Pair,'$!value'),
  302. nqp::bindkey(
  303. elems,
  304. nqp::getattr(nqp::decont($pulled),Pair,'$!key').WHICH,
  305. nqp::getattr(nqp::decont($pulled),Pair,'$!key')
  306. )
  307. ),
  308. nqp::bindkey(elems,$pulled.WHICH,$pulled)
  309. )
  310. ),
  311. elems
  312. )
  313. }
  314. # Add to given IterationSet with setty semantics the keys of given Map
  315. method ADD-MAP-TO-SET(\elems, \map) {
  316. nqp::stmts(
  317. nqp::if(
  318. (my $raw := nqp::getattr(nqp::decont(map),Map,'$!storage'))
  319. && (my $iter := nqp::iterator($raw)),
  320. nqp::if(
  321. nqp::eqaddr(map.keyof,Str(Any)),
  322. nqp::while( # normal Map
  323. $iter,
  324. nqp::if(
  325. nqp::iterval(nqp::shift($iter)),
  326. nqp::bindkey(
  327. elems,nqp::iterkey_s($iter).WHICH,nqp::iterkey_s($iter))
  328. )
  329. ),
  330. nqp::while( # object hash
  331. $iter,
  332. nqp::if(
  333. nqp::getattr(
  334. nqp::decont(nqp::iterval(nqp::shift($iter))),
  335. Pair,
  336. '$!value'
  337. ),
  338. nqp::bindkey(
  339. elems,
  340. nqp::iterkey_s($iter),
  341. nqp::getattr(nqp::iterval($iter),Pair,'$!key')
  342. )
  343. )
  344. )
  345. )
  346. ),
  347. elems
  348. )
  349. }
  350. # coerce a Map to an IterationSet with setty semantics
  351. method COERCE-MAP-TO-SET(\map) {
  352. # Once object hashes have IterationSets, we could optimize the
  353. # object hash case by cloning the object hash, rather than creating
  354. # an empty IterationSet. Until then, this is just a wrapper.
  355. Rakudo::QuantHash.ADD-MAP-TO-SET(
  356. nqp::create(Rakudo::Internals::IterationSet),
  357. map
  358. )
  359. }
  360. # remove set elements from set, stop when the result is the empty Set
  361. method SUB-SET-FROM-SET(\aelems, \belems) {
  362. nqp::stmts( # both have elems
  363. (my $elems := nqp::clone(aelems)),
  364. (my $iter := nqp::iterator(belems)),
  365. nqp::while(
  366. $iter && nqp::elems($elems),
  367. nqp::deletekey($elems,nqp::iterkey_s(nqp::shift($iter)))
  368. ),
  369. $elems
  370. )
  371. }
  372. # remove hash elements from set, stop if the result is the empty Set
  373. method SUB-MAP-FROM-SET(\aelems, \map) {
  374. nqp::stmts(
  375. (my $elems := nqp::clone(aelems)),
  376. nqp::if(
  377. (my $storage := nqp::getattr(nqp::decont(map),Map,'$!storage'))
  378. && (my $iter := nqp::iterator($storage)),
  379. nqp::if(
  380. nqp::eqaddr(map.keyof,Str(Any)),
  381. nqp::while( # normal Map
  382. $iter && nqp::elems($elems),
  383. nqp::if(
  384. nqp::iterval(nqp::shift($iter)),
  385. nqp::deletekey($elems,nqp::iterkey_s($iter).WHICH)
  386. )
  387. ),
  388. nqp::while( # object hash
  389. $iter && nqp::elems($elems),
  390. nqp::if(
  391. nqp::getattr(nqp::iterval(nqp::shift($iter)),Pair,'$!value'),
  392. nqp::deletekey($elems,nqp::iterkey_s($iter))
  393. )
  394. )
  395. )
  396. ),
  397. $elems
  398. )
  399. }
  400. # remove iterator elements from set using Pair semantics, stops pulling
  401. # from the iterator as soon as the result is the empty set.
  402. method SUB-PAIRS-FROM-SET(\elems, \iterator) {
  403. nqp::stmts(
  404. (my $elems := nqp::clone(elems)),
  405. nqp::until(
  406. nqp::eqaddr( # end of iterator?
  407. (my $pulled := iterator.pull-one),
  408. IterationEnd
  409. ) || nqp::not_i(nqp::elems($elems)), # nothing left to remove?
  410. nqp::if(
  411. nqp::istype($pulled,Pair),
  412. nqp::if( # must check for thruthiness
  413. nqp::getattr($pulled,Pair,'$!value'),
  414. nqp::deletekey($elems,nqp::getattr($pulled,Pair,'$!key').WHICH)
  415. ),
  416. nqp::deletekey($elems,$pulled.WHICH) # attempt to remove
  417. )
  418. ),
  419. $elems
  420. )
  421. }
  422. #--- Bag/BagHash related methods
  423. # Calculate total of value of a Bag(Hash). Takes a (possibly
  424. # uninitialized) IterationSet in Bag format.
  425. method BAG-TOTAL(Mu \elems) {
  426. nqp::if(
  427. elems && nqp::elems(elems),
  428. nqp::stmts(
  429. (my Int $total := 0),
  430. (my $iter := nqp::iterator(elems)),
  431. nqp::while(
  432. $iter,
  433. $total := nqp::add_I(
  434. $total,
  435. nqp::getattr(nqp::iterval(nqp::shift($iter)),Pair,'$!value'),
  436. Int
  437. )
  438. ),
  439. $total
  440. ),
  441. 0
  442. )
  443. }
  444. # Return random iterator item from a given Bag(Hash). Takes an
  445. # initialized IterationSet with at least 1 element in Bag format,
  446. # and the total value of values in the Bag.
  447. method BAG-ROLL(\elems, \total) {
  448. nqp::stmts(
  449. (my Int $rand := total.rand.Int),
  450. (my Int $seen := 0),
  451. (my $iter := nqp::iterator(elems)),
  452. nqp::while(
  453. $iter &&
  454. nqp::isle_I(
  455. ($seen := nqp::add_I(
  456. $seen,
  457. nqp::getattr(nqp::iterval(nqp::shift($iter)),Pair,'$!value'),
  458. Int
  459. )),
  460. $rand
  461. ),
  462. nqp::null
  463. ),
  464. $iter
  465. )
  466. }
  467. # Return random object from a given BagHash. Takes an initialized
  468. # IterationSet with at least 1 element in Bag format, and the total
  469. # value of values in the Bag. Decrements the count of the iterator
  470. # found, completely removes it when going to 0.
  471. method BAG-GRAB(\elems, \total) {
  472. nqp::stmts(
  473. (my $iter := Rakudo::QuantHash.BAG-ROLL(elems,total)),
  474. nqp::if(
  475. (my $value := nqp::getattr(nqp::iterval($iter),Pair,'$!value')) == 1,
  476. nqp::stmts( # going to 0, so remove
  477. (my $object := nqp::getattr(nqp::iterval($iter),Pair,'$!key')),
  478. nqp::deletekey(elems,nqp::iterkey_s($iter)),
  479. $object
  480. ),
  481. nqp::stmts(
  482. nqp::bindattr(
  483. nqp::iterval($iter),
  484. Pair,
  485. '$!value',
  486. $value - 1
  487. ),
  488. nqp::getattr(nqp::iterval($iter),Pair,'$!key')
  489. )
  490. )
  491. )
  492. }
  493. method BAGGY-CLONE-RAW(Mu \baggy) {
  494. nqp::if(
  495. baggy && nqp::elems(baggy),
  496. nqp::stmts( # something to coerce
  497. (my $elems := nqp::clone(baggy)),
  498. (my $iter := nqp::iterator($elems)),
  499. nqp::while(
  500. $iter,
  501. nqp::bindkey(
  502. $elems,
  503. nqp::iterkey_s(nqp::shift($iter)),
  504. nqp::p6bindattrinvres(
  505. nqp::clone(nqp::iterval($iter)),
  506. Pair,
  507. '$!value',
  508. nqp::getattr(nqp::iterval($iter),Pair,'$!value')
  509. )
  510. )
  511. ),
  512. $elems
  513. ),
  514. baggy
  515. )
  516. }
  517. method ADD-BAG-TO-BAG(\elems,Mu \bag) {
  518. nqp::stmts(
  519. nqp::if(
  520. bag && nqp::elems(bag),
  521. nqp::stmts(
  522. (my $iter := nqp::iterator(bag)),
  523. nqp::while(
  524. $iter,
  525. nqp::if(
  526. nqp::existskey(elems,nqp::iterkey_s(nqp::shift($iter))),
  527. nqp::stmts(
  528. (my $pair := nqp::atkey(elems,nqp::iterkey_s($iter))),
  529. nqp::bindattr($pair,Pair,'$!value',
  530. nqp::getattr($pair,Pair,'$!value')
  531. + nqp::getattr(nqp::iterval($iter),Pair,'$!value')
  532. )
  533. ),
  534. nqp::bindkey(elems,nqp::iterkey_s($iter),
  535. nqp::clone(nqp::iterval($iter))
  536. )
  537. )
  538. )
  539. )
  540. ),
  541. elems
  542. )
  543. }
  544. method ADD-ITERATOR-TO-BAG(\elems,Mu \iterator) {
  545. nqp::stmts(
  546. nqp::until(
  547. nqp::eqaddr((my $pulled := iterator.pull-one),IterationEnd),
  548. nqp::if(
  549. nqp::existskey(elems,(my $WHICH := $pulled.WHICH)),
  550. nqp::stmts(
  551. (my $pair := nqp::atkey(elems,$WHICH)),
  552. nqp::bindattr($pair,Pair,'$!value',
  553. nqp::add_i(nqp::getattr($pair,Pair,'$!value'),1)
  554. )
  555. ),
  556. nqp::bindkey(elems,$WHICH,Pair.new($pulled,1))
  557. )
  558. ),
  559. elems
  560. )
  561. }
  562. # Add to given IterationSet with baggy semantics the keys of given Map
  563. method ADD-MAP-TO-BAG(\elems, \map) {
  564. nqp::stmts(
  565. nqp::if(
  566. (my $raw := nqp::getattr(nqp::decont(map),Map,'$!storage'))
  567. && (my $iter := nqp::iterator($raw)),
  568. nqp::if(
  569. nqp::eqaddr(map.keyof,Str(Any)),
  570. nqp::while( # ordinary Map
  571. $iter,
  572. nqp::if(
  573. nqp::istype(
  574. (my $value := nqp::iterval(nqp::shift($iter)).Int),
  575. Int
  576. ),
  577. nqp::if( # a valid Int
  578. $value > 0,
  579. nqp::if( # and a positive one at that
  580. nqp::existskey(
  581. elems,
  582. (my $which := nqp::iterkey_s($iter).WHICH)
  583. ),
  584. nqp::stmts( # seen before, add value
  585. (my $pair := nqp::atkey(elems,$which)),
  586. nqp::bindattr(
  587. $pair,
  588. Pair,
  589. '$!value',
  590. nqp::getattr($pair,Pair,'$!value') + $value
  591. )
  592. ),
  593. nqp::bindkey( # new, create new Pair
  594. elems,
  595. $which,
  596. Pair.new(nqp::iterkey_s($iter),$value)
  597. )
  598. )
  599. ),
  600. $value.throw # huh? let the world know
  601. )
  602. ),
  603. nqp::while( # object hash
  604. $iter,
  605. nqp::if(
  606. nqp::istype(
  607. ($value := nqp::getattr(
  608. nqp::iterval(nqp::shift($iter)),Pair,'$!value'
  609. ).Int),
  610. Int
  611. ),
  612. nqp::if( # a valid Int
  613. $value > 0,
  614. nqp::if( # and a positive one at that
  615. nqp::existskey(elems,nqp::iterkey_s($iter)),
  616. nqp::stmts( # seen before, add value
  617. ($pair := nqp::atkey(elems,nqp::iterkey_s($iter))),
  618. nqp::bindattr(
  619. $pair,
  620. Pair,
  621. '$!value',
  622. nqp::getattr($pair,Pair,'$!value') + $value
  623. )
  624. ),
  625. nqp::bindkey( # new, create new Pair
  626. elems,
  627. nqp::iterkey_s($iter),
  628. nqp::p6bindattrinvres(
  629. nqp::clone(nqp::iterval($iter)),
  630. Pair,
  631. '$!value',
  632. $value
  633. )
  634. )
  635. )
  636. ),
  637. $value.throw # huh? let the world know
  638. )
  639. )
  640. )
  641. ),
  642. elems
  643. )
  644. }
  645. # Coerce the given Map to an IterationSet with baggy semantics.
  646. method COERCE-MAP-TO-BAG(\map) {
  647. nqp::if(
  648. (my $storage := nqp::getattr(nqp::decont(map),Map,'$!storage'))
  649. && (my $iter := nqp::iterator($storage)),
  650. nqp::if( # something to coerce
  651. nqp::eqaddr(map.keyof,Str(Any)),
  652. nqp::stmts( # ordinary Map
  653. (my $elems := nqp::create(Rakudo::Internals::IterationSet)),
  654. nqp::while(
  655. $iter,
  656. nqp::if(
  657. nqp::istype(
  658. (my $value := nqp::iterval(nqp::shift($iter)).Int),
  659. Int
  660. ),
  661. nqp::if( # a valid Int
  662. $value > 0,
  663. nqp::bindkey( # and a positive one at that
  664. $elems,
  665. nqp::iterkey_s($iter).WHICH,
  666. Pair.new(nqp::iterkey_s($iter),$value)
  667. )
  668. ),
  669. $value.throw # huh? let the world know
  670. )
  671. ),
  672. $elems
  673. ),
  674. nqp::stmts( # object hash
  675. # once object hashes have IterationSets inside them, we can
  676. # make this an nqp::clone for more performance, which would
  677. # pre-populate the IterationSet with the right keys off the
  678. # bat.
  679. ($elems := nqp::create(Rakudo::Internals::IterationSet)),
  680. nqp::while(
  681. $iter,
  682. nqp::if(
  683. nqp::istype(
  684. ($value := nqp::getattr(
  685. nqp::iterval(nqp::shift($iter)),Pair,'$!value'
  686. ).Int),
  687. Int
  688. ),
  689. nqp::if( # a valid Int
  690. $value > 0,
  691. nqp::bindkey( # and a positive one at that
  692. $elems,
  693. nqp::iterkey_s($iter),
  694. nqp::p6bindattrinvres(
  695. nqp::clone(nqp::iterval($iter)),
  696. Pair,
  697. '$!value',
  698. $value
  699. )
  700. )
  701. ),
  702. $value.throw # huh? let the world know
  703. )
  704. ),
  705. $elems
  706. )
  707. ),
  708. nqp::create(Rakudo::Internals::IterationSet) # nothing to coerce
  709. )
  710. }
  711. # Add to given IterationSet with baggy semantics the values of the given
  712. # iterator while checking for Pairs with numeric values.
  713. method ADD-PAIRS-TO-BAG(\elems,Mu \iterator) {
  714. nqp::stmts(
  715. nqp::until(
  716. nqp::eqaddr(
  717. (my $pulled := nqp::decont(iterator.pull-one)),
  718. IterationEnd
  719. ),
  720. nqp::if(
  721. nqp::istype($pulled,Pair),
  722. nqp::if( # we have a Pair
  723. nqp::istype(
  724. (my $value :=
  725. nqp::decont(nqp::getattr($pulled,Pair,'$!value')).Int),
  726. Int
  727. ),
  728. nqp::if( # is a (coerced) Int
  729. $value > 0,
  730. nqp::if( # and a positive one at that
  731. nqp::existskey(
  732. elems,
  733. (my $which := nqp::getattr($pulled,Pair,'$!key').WHICH)
  734. ),
  735. nqp::stmts( # seen before, add value
  736. (my $pair := nqp::atkey(elems,$which)),
  737. nqp::bindattr(
  738. $pair,
  739. Pair,
  740. '$!value',
  741. nqp::getattr($pair,Pair,'$!value') + $value
  742. )
  743. ),
  744. nqp::bindkey( # new, create new Pair
  745. elems,
  746. $which,
  747. nqp::p6bindattrinvres(
  748. nqp::clone($pulled),
  749. Pair,
  750. '$!value',
  751. $value
  752. )
  753. )
  754. )
  755. ),
  756. $value.throw # value cannot be made Int, so throw
  757. ),
  758. nqp::if( # not a Pair
  759. nqp::existskey(
  760. elems,
  761. ($which := $pulled.WHICH)
  762. ),
  763. nqp::stmts(
  764. ($pair := nqp::atkey(elems,$which)),
  765. nqp::bindattr( # seen before, so increment
  766. $pair,
  767. Pair,
  768. '$!value',
  769. nqp::getattr($pair,Pair,'$!value') + 1
  770. )
  771. ),
  772. nqp::bindkey( # new, create new Pair
  773. elems,$which,Pair.new($pulled,1))
  774. )
  775. )
  776. ),
  777. elems # we're done, return what we got so far
  778. )
  779. }
  780. # Take the given IterationSet with baggy semantics, and add the other
  781. # IterationSet with setty semantics to it. Return the given IterationSet.
  782. method ADD-SET-TO-BAG(\elems,Mu \set) {
  783. nqp::stmts(
  784. nqp::if(
  785. set && nqp::elems(set),
  786. nqp::stmts(
  787. (my $iter := nqp::iterator(set)),
  788. nqp::while(
  789. $iter,
  790. nqp::if(
  791. nqp::existskey(elems,nqp::iterkey_s(nqp::shift($iter))),
  792. nqp::stmts(
  793. (my $pair := nqp::atkey(elems,nqp::iterkey_s($iter))),
  794. nqp::bindattr($pair,Pair,'$!value',
  795. nqp::getattr($pair,Pair,'$!value') + 1
  796. )
  797. ),
  798. nqp::bindkey(elems,nqp::iterkey_s($iter),
  799. Pair.new(nqp::iterval($iter), 1)
  800. )
  801. )
  802. )
  803. )
  804. ),
  805. elems
  806. )
  807. }
  808. method MULTIPLY-BAG-TO-BAG(\elems,Mu \bag) {
  809. nqp::stmts(
  810. (my $iter := nqp::iterator(elems)),
  811. nqp::if(
  812. bag && nqp::elems(bag),
  813. nqp::while(
  814. $iter,
  815. nqp::if(
  816. nqp::existskey(bag,nqp::iterkey_s(nqp::shift($iter))),
  817. nqp::stmts(
  818. (my $pair := nqp::iterval($iter)),
  819. nqp::bindattr($pair,Pair,'$!value',
  820. nqp::mul_i(
  821. nqp::getattr($pair,Pair,'$!value'),
  822. nqp::getattr(
  823. nqp::atkey(bag,nqp::iterkey_s($iter)),
  824. Pair,
  825. '$!value'
  826. )
  827. )
  828. )
  829. ),
  830. nqp::deletekey(elems,nqp::iterkey_s($iter))
  831. )
  832. ),
  833. nqp::while( # nothing to match against, so reset
  834. $iter,
  835. nqp::deletekey(elems,nqp::iterkey_s(nqp::shift($iter)))
  836. )
  837. ),
  838. elems
  839. )
  840. }
  841. method MULTIPLY-SET-TO-BAG(\elems,Mu \set) {
  842. nqp::stmts(
  843. (my $iter := nqp::iterator(elems)),
  844. nqp::if(
  845. set && nqp::elems(set),
  846. nqp::while(
  847. $iter,
  848. nqp::unless(
  849. nqp::existskey(set,nqp::iterkey_s(nqp::shift($iter))),
  850. nqp::deletekey(elems,nqp::iterkey_s($iter))
  851. )
  852. ),
  853. nqp::while( # nothing to match against, so reset
  854. $iter,
  855. nqp::deletekey(elems,nqp::iterkey_s(nqp::shift($iter)))
  856. )
  857. ),
  858. elems
  859. )
  860. }
  861. # set difference Baggy IterSet from Bag IterSet, both assumed to have elems
  862. method SUB-BAGGY-FROM-BAG(\aelems, \belems) {
  863. nqp::stmts(
  864. (my $elems := nqp::create(Rakudo::Internals::IterationSet)),
  865. (my $iter := nqp::iterator(aelems)),
  866. nqp::while(
  867. $iter,
  868. nqp::if(
  869. (my $value :=
  870. nqp::getattr(nqp::iterval(nqp::shift($iter)),Pair,'$!value')
  871. - nqp::getattr(
  872. nqp::ifnull(nqp::atkey(belems,nqp::iterkey_s($iter)),$p0),
  873. Pair,
  874. '$!value'
  875. )
  876. ) > 0,
  877. nqp::bindkey(
  878. $elems,
  879. nqp::iterkey_s($iter),
  880. nqp::p6bindattrinvres(
  881. nqp::clone(nqp::iterval($iter)),Pair,'$!value',$value
  882. )
  883. )
  884. )
  885. ),
  886. $elems
  887. )
  888. }
  889. # set difference Setty IterSet from Bag IterSet, both assumed to have elems
  890. method SUB-SETTY-FROM-BAG(\aelems, \belems) {
  891. nqp::stmts(
  892. (my $elems := nqp::create(Rakudo::Internals::IterationSet)),
  893. (my $iter := nqp::iterator(aelems)),
  894. nqp::while(
  895. $iter,
  896. nqp::if(
  897. (my $value :=
  898. nqp::getattr(nqp::iterval(nqp::shift($iter)),Pair,'$!value')
  899. - nqp::existskey(belems,nqp::iterkey_s($iter))
  900. ) > 0,
  901. nqp::bindkey(
  902. $elems,
  903. nqp::iterkey_s($iter),
  904. nqp::p6bindattrinvres(
  905. nqp::clone(nqp::iterval($iter)),Pair,'$!value',$value
  906. )
  907. )
  908. )
  909. ),
  910. $elems
  911. )
  912. }
  913. # set difference of a Baggy and a QuantHash
  914. method DIFFERENCE-BAGGY-QUANTHASH(\a, \b) {
  915. nqp::if(
  916. (my $araw := a.RAW-HASH) && nqp::elems($araw),
  917. nqp::if(
  918. (my $braw := b.RAW-HASH) && nqp::elems($braw),
  919. nqp::create(Bag).SET-SELF(
  920. nqp::if(
  921. nqp::istype(b,Setty),
  922. self.SUB-SETTY-FROM-BAG($araw, $braw),
  923. self.SUB-BAGGY-FROM-BAG($araw, $braw)
  924. )
  925. ),
  926. a.Bag
  927. ),
  928. nqp::if(
  929. nqp::istype(b,Failure),
  930. b.throw,
  931. bag()
  932. )
  933. )
  934. }
  935. #--- Mix/MixHash related methods
  936. # Calculate total of values of a Mix(Hash). Takes a (possibly
  937. # uninitialized) IterationSet in Mix format.
  938. method MIX-TOTAL(Mu \elems) {
  939. nqp::if(
  940. elems && nqp::elems(elems),
  941. nqp::stmts(
  942. (my $total := 0),
  943. (my $iter := nqp::iterator(elems)),
  944. nqp::while(
  945. $iter,
  946. $total := $total
  947. + nqp::getattr(nqp::iterval(nqp::shift($iter)),Pair,'$!value')
  948. ),
  949. $total
  950. ),
  951. 0
  952. )
  953. }
  954. # Calculate total of positive value of a Mix(Hash). Takes a
  955. # (possibly uninitialized) IterationSet in Mix format.
  956. method MIX-TOTAL-POSITIVE(Mu \elems) {
  957. nqp::if(
  958. elems && nqp::elems(elems),
  959. nqp::stmts(
  960. (my $total := 0),
  961. (my $iter := nqp::iterator(elems)),
  962. nqp::while(
  963. $iter,
  964. nqp::if(
  965. 0 < (my $value :=
  966. nqp::getattr(nqp::iterval(nqp::shift($iter)),Pair,'$!value')),
  967. ($total := $total + $value)
  968. )
  969. ),
  970. $total
  971. ),
  972. 0
  973. )
  974. }
  975. # Return random iterator item from a given Mix(Hash). Takes an
  976. # initialized IterationSet with at least 1 element in Mix format,
  977. # and the total value of values in the Mix.
  978. method MIX-ROLL(\elems, \total) {
  979. nqp::stmts(
  980. (my $rand := total.rand),
  981. (my Real $seen := 0),
  982. (my $iter := nqp::iterator(elems)),
  983. nqp::while(
  984. $iter && (
  985. 0 > (my $value := # negative values ignored
  986. nqp::getattr(nqp::iterval(nqp::shift($iter)),Pair,'$!value'))
  987. || $rand > ($seen := $seen + $value) # positive values add up
  988. ),
  989. nqp::null
  990. ),
  991. $iter
  992. )
  993. }
  994. # Given an IterationSet in baggy/mixy format considered to contain the
  995. # final result, add the other IterationSet using Mix semantics and return
  996. # the first IterationSet.
  997. method ADD-MIX-TO-MIX(\elems, Mu \mix) {
  998. nqp::stmts(
  999. nqp::if(
  1000. mix && nqp::elems(mix),
  1001. nqp::stmts(
  1002. (my $iter := nqp::iterator(mix)),
  1003. nqp::while(
  1004. $iter,
  1005. nqp::if(
  1006. nqp::isnull((my $pair :=
  1007. nqp::atkey(elems,nqp::iterkey_s(nqp::shift($iter)))
  1008. )),
  1009. nqp::bindkey( # doesn't exist on left, create
  1010. elems,
  1011. nqp::iterkey_s($iter),
  1012. nqp::p6bindattrinvres(
  1013. nqp::clone(nqp::iterval($iter)),
  1014. Pair,
  1015. '$!value',
  1016. nqp::getattr(nqp::iterval($iter),Pair,'$!value')
  1017. )
  1018. ),
  1019. nqp::if( # exists on left, update
  1020. (my $value := nqp::getattr($pair,Pair,'$!value')
  1021. + nqp::getattr(nqp::iterval($iter),Pair,'$!value')),
  1022. nqp::bindattr($pair,Pair,'$!value',$value), # valid for Mix
  1023. nqp::deletekey(elems,nqp::iterkey_s($iter)) # bye bye
  1024. )
  1025. )
  1026. )
  1027. )
  1028. ),
  1029. elems
  1030. )
  1031. }
  1032. # Add to given IterationSet with mixy semantics the keys of given Map
  1033. method ADD-MAP-TO-MIX(\elems, \map) {
  1034. nqp::stmts(
  1035. nqp::if(
  1036. (my $raw := nqp::getattr(nqp::decont(map),Map,'$!storage'))
  1037. && (my $iter := nqp::iterator($raw)),
  1038. nqp::if(
  1039. nqp::eqaddr(map.keyof,Str(Any)),
  1040. nqp::while( # normal Map
  1041. $iter,
  1042. nqp::if(
  1043. nqp::istype(
  1044. (my $value := nqp::iterval(nqp::shift($iter)).Real),
  1045. Real
  1046. ),
  1047. nqp::if( # a valid Real
  1048. $value,
  1049. nqp::if( # and not 0
  1050. nqp::existskey(
  1051. elems,
  1052. (my $which := nqp::iterkey_s($iter).WHICH)
  1053. ),
  1054. nqp::if( # seen before: add value, remove if sum 0
  1055. ($value := nqp::getattr(
  1056. (my $pair := nqp::atkey(elems,$which)),
  1057. Pair,
  1058. '$!value'
  1059. ) + $value),
  1060. nqp::bindattr($pair,Pair,'$!value',$value), # okidoki
  1061. nqp::deletekey(elems,$which) # alas, bye
  1062. ),
  1063. nqp::bindkey( # new, create new Pair
  1064. elems,
  1065. $which,
  1066. Pair.new(nqp::iterkey_s($iter),$value)
  1067. )
  1068. )
  1069. ),
  1070. $value.throw # huh? let the world know
  1071. )
  1072. ),
  1073. nqp::while( # object hash
  1074. $iter,
  1075. nqp::if(
  1076. nqp::istype(
  1077. ($value := nqp::getattr(
  1078. nqp::iterval(nqp::shift($iter)),Pair,'$!value'
  1079. ).Real),
  1080. Real
  1081. ),
  1082. nqp::if( # a valid Real
  1083. $value,
  1084. nqp::if( # and not 0
  1085. nqp::existskey(elems,nqp::iterkey_s($iter)),
  1086. nqp::if( # seen before: add value, remove if sum 0
  1087. ($value := nqp::getattr(
  1088. ($pair := nqp::atkey(elems,nqp::iterkey_s($iter))),
  1089. Pair,
  1090. '$!value'
  1091. ) + $value),
  1092. nqp::bindattr($pair,Pair,'$!value',$value), # okidoki
  1093. nqp::deletekey(elems,nqp::iterkey_s($iter)) # alas, bye
  1094. ),
  1095. nqp::bindkey( # new, create new Pair
  1096. elems,
  1097. nqp::iterkey_s($iter),
  1098. nqp::p6bindattrinvres(
  1099. nqp::clone(nqp::iterval($iter)),
  1100. Pair,
  1101. '$!value',
  1102. nqp::getattr(nqp::iterval($iter),Pair,'$!value')
  1103. )
  1104. )
  1105. )
  1106. ),
  1107. $value.throw # huh? let the world know
  1108. )
  1109. )
  1110. )
  1111. ),
  1112. elems
  1113. )
  1114. }
  1115. # Add to given IterationSet with mixy semantics the values of the given
  1116. # iterator while checking for Pairs with numeric values.
  1117. method ADD-PAIRS-TO-MIX(\elems,Mu \iterator) is raw {
  1118. nqp::stmts(
  1119. nqp::until(
  1120. nqp::eqaddr(
  1121. (my $pulled := nqp::decont(iterator.pull-one)),
  1122. IterationEnd
  1123. ),
  1124. nqp::if(
  1125. nqp::istype($pulled,Pair),
  1126. nqp::if( # got a Pair
  1127. (my $value :=
  1128. nqp::decont(nqp::getattr($pulled,Pair,'$!value'))),
  1129. nqp::if( # non-zero value
  1130. nqp::istype($value,Num) && nqp::isnanorinf($value),
  1131. X::OutOfRange.new( # NaN or -Inf or Inf, we're done
  1132. what => 'Value',
  1133. got => $value,
  1134. range => '-Inf^..^Inf'
  1135. ).throw,
  1136. nqp::stmts( # apparently valid
  1137. nqp::unless(
  1138. nqp::istype(($value := $value.Real),Real),
  1139. $value.throw # not a Real value, so throw Failure
  1140. ),
  1141. nqp::if( # valid Real value
  1142. nqp::existskey(
  1143. elems,
  1144. (my $which := nqp::getattr($pulled,Pair,'$!key').WHICH)
  1145. ),
  1146. nqp::if( # seen before, add value
  1147. ($value := nqp::getattr(
  1148. (my $pair := nqp::atkey(elems,$which)),
  1149. Pair,
  1150. '$!value'
  1151. ) + $value),
  1152. nqp::bindattr($pair,Pair,'$!value',$value), # non-zero
  1153. nqp::deletekey(elems,$which) # zero
  1154. ),
  1155. nqp::bindkey( # new, create new Pair
  1156. elems,
  1157. $which,
  1158. nqp::p6bindattrinvres(
  1159. nqp::clone($pulled),
  1160. Pair,
  1161. '$!value',
  1162. $value
  1163. )
  1164. )
  1165. )
  1166. )
  1167. )
  1168. ),
  1169. nqp::if( # not a Pair
  1170. nqp::existskey(
  1171. elems,
  1172. ($which := $pulled.WHICH)
  1173. ),
  1174. nqp::stmts(
  1175. ($pair := nqp::atkey(elems,$which)),
  1176. nqp::bindattr( # seen before, so increment
  1177. $pair,
  1178. Pair,
  1179. '$!value',
  1180. nqp::getattr($pair,Pair,'$!value') + 1
  1181. )
  1182. ),
  1183. nqp::bindkey( # new, create new Pair
  1184. elems,$which,Pair.new($pulled,1))
  1185. )
  1186. )
  1187. ),
  1188. elems # we're done, return what we got so far
  1189. )
  1190. }
  1191. # Take the given IterationSet with mixy semantics, and add the other
  1192. # IterationSet with setty semantics to it. Return the given IterationSet.
  1193. method ADD-SET-TO-MIX(\elems,Mu \set) {
  1194. nqp::stmts(
  1195. nqp::if(
  1196. set && nqp::elems(set),
  1197. nqp::stmts(
  1198. (my $iter := nqp::iterator(set)),
  1199. nqp::while(
  1200. $iter,
  1201. nqp::if(
  1202. nqp::existskey(elems,nqp::iterkey_s(nqp::shift($iter))),
  1203. nqp::if(
  1204. (my $value := nqp::getattr(
  1205. (my $pair := nqp::atkey(elems,nqp::iterkey_s($iter))),
  1206. Pair,
  1207. '$!value'
  1208. ) + 1),
  1209. nqp::bindattr($pair,Pair,'$!value',$value), # still valid
  1210. nqp::deletekey(elems,nqp::iterkey_s($iter)) # not, byebye
  1211. ),
  1212. nqp::bindkey(elems,nqp::iterkey_s($iter), # new key
  1213. Pair.new(nqp::iterval($iter), 1)
  1214. )
  1215. )
  1216. )
  1217. )
  1218. ),
  1219. elems
  1220. )
  1221. }
  1222. # Coerce the given Map to an IterationSet with mixy semantics.
  1223. method COERCE-MAP-TO-MIX(\map) {
  1224. nqp::if(
  1225. (my $storage := nqp::getattr(nqp::decont(map),Map,'$!storage'))
  1226. && (my $iter := nqp::iterator($storage)),
  1227. nqp::if( # something to coerce
  1228. nqp::eqaddr(map.keyof,Str(Any)),
  1229. nqp::stmts( # ordinary Map
  1230. (my $elems := nqp::create(Rakudo::Internals::IterationSet)),
  1231. nqp::while(
  1232. $iter,
  1233. nqp::if(
  1234. nqp::istype(
  1235. (my $value := nqp::iterval(nqp::shift($iter)).Real),
  1236. Real
  1237. ),
  1238. nqp::if( # a valid Real
  1239. $value,
  1240. nqp::bindkey( # and not 0
  1241. $elems,
  1242. nqp::iterkey_s($iter).WHICH,
  1243. Pair.new(nqp::iterkey_s($iter),$value)
  1244. )
  1245. ),
  1246. $value.throw # huh? let the world know
  1247. )
  1248. ),
  1249. $elems
  1250. ),
  1251. nqp::stmts( # object hash
  1252. # once object hashes have IterationSets inside them, we can
  1253. # make this an nqp::clone for more performance, which would
  1254. # pre-populate the IterationSet with the right keys off the
  1255. # bat.
  1256. ($elems := nqp::create(Rakudo::Internals::IterationSet)),
  1257. nqp::while(
  1258. $iter,
  1259. nqp::if(
  1260. nqp::istype(
  1261. ($value := nqp::getattr(
  1262. nqp::iterval(nqp::shift($iter)),Pair,'$!value'
  1263. ).Real),
  1264. Real
  1265. ),
  1266. nqp::if( # a valid Real
  1267. $value,
  1268. nqp::bindkey( # and not 0
  1269. $elems,
  1270. nqp::iterkey_s($iter),
  1271. nqp::p6bindattrinvres(
  1272. nqp::clone(nqp::iterval($iter)),
  1273. Pair,
  1274. '$!value',
  1275. $value
  1276. )
  1277. )
  1278. ),
  1279. $value.throw # huh? let the world know
  1280. )
  1281. ),
  1282. $elems
  1283. )
  1284. ),
  1285. nqp::create(Rakudo::Internals::IterationSet) # nothing to coerce
  1286. )
  1287. }
  1288. method MULTIPLY-MIX-TO-MIX(\elems,Mu \mix --> Nil) {
  1289. nqp::stmts(
  1290. (my $iter := nqp::iterator(elems)),
  1291. nqp::if(
  1292. mix && nqp::elems(mix),
  1293. nqp::while(
  1294. $iter,
  1295. nqp::if(
  1296. nqp::existskey(mix,nqp::iterkey_s(nqp::shift($iter))),
  1297. nqp::stmts(
  1298. (my $pair := nqp::iterval($iter)),
  1299. nqp::bindattr($pair,Pair,'$!value',
  1300. nqp::getattr($pair,Pair,'$!value')
  1301. * nqp::getattr(
  1302. nqp::atkey(mix,nqp::iterkey_s($iter)),
  1303. Pair,
  1304. '$!value'
  1305. )
  1306. )
  1307. ),
  1308. nqp::deletekey(elems,nqp::iterkey_s($iter))
  1309. )
  1310. ),
  1311. nqp::while( # nothing to match against, so reset
  1312. $iter,
  1313. nqp::deletekey(elems,nqp::iterkey_s(nqp::shift($iter)))
  1314. )
  1315. )
  1316. )
  1317. }
  1318. method MIX-CLONE-ALL-POSITIVE(\elems) {
  1319. nqp::stmts(
  1320. (my $iter := nqp::iterator(my $clone := nqp::clone(elems))),
  1321. nqp::while(
  1322. $iter,
  1323. nqp::stmts(
  1324. nqp::shift($iter),
  1325. nqp::bindkey(
  1326. $clone,
  1327. nqp::iterkey_s($iter),
  1328. nqp::p6bindattrinvres(
  1329. nqp::clone(nqp::iterval($iter)),
  1330. Pair,
  1331. '$!value',
  1332. abs(nqp::getattr(nqp::iterval($iter),Pair,'$!value'))
  1333. )
  1334. )
  1335. )
  1336. ),
  1337. $clone
  1338. )
  1339. }
  1340. method MIX-ALL-POSITIVE(\elems) {
  1341. nqp::stmts(
  1342. (my $iter := nqp::iterator(elems)),
  1343. nqp::while(
  1344. $iter,
  1345. nqp::unless(
  1346. nqp::getattr(nqp::iterval(nqp::shift($iter)),Pair,'$!value') > 0,
  1347. return False
  1348. )
  1349. ),
  1350. True
  1351. )
  1352. }
  1353. method MIX-ALL-NEGATIVE(\elems) {
  1354. nqp::stmts(
  1355. (my $iter := nqp::iterator(elems)),
  1356. nqp::while(
  1357. $iter,
  1358. nqp::unless(
  1359. nqp::getattr(nqp::iterval(nqp::shift($iter)),Pair,'$!value') < 0,
  1360. return False
  1361. )
  1362. ),
  1363. True
  1364. )
  1365. }
  1366. method MIX-IS-SUBSET($a,$b) {
  1367. nqp::if(
  1368. nqp::eqaddr(nqp::decont($a),nqp::decont($b)),
  1369. True, # X is always a subset of itself
  1370. nqp::if(
  1371. (my $araw := $a.RAW-HASH) && (my $iter := nqp::iterator($araw)),
  1372. nqp::if( # elems in A
  1373. (my $braw := $b.RAW-HASH) && nqp::elems($braw),
  1374. nqp::stmts( # elems in A and B
  1375. nqp::while( # check all values in A with B
  1376. $iter,
  1377. nqp::unless(
  1378. nqp::getattr(nqp::iterval(nqp::shift($iter)),Pair,'$!value')
  1379. <= # value in A should be less or equal than B
  1380. nqp::getattr(
  1381. nqp::ifnull(nqp::atkey($braw,nqp::iterkey_s($iter)),$p0),
  1382. Pair,
  1383. '$!value'
  1384. ),
  1385. return False
  1386. )
  1387. ),
  1388. ($iter := nqp::iterator($braw)),
  1389. nqp::while( # check all values in B with A
  1390. $iter,
  1391. nqp::unless(
  1392. nqp::getattr(nqp::iterval(nqp::shift($iter)),Pair,'$!value')
  1393. >= # value in B should be more or equal than A
  1394. nqp::getattr(
  1395. nqp::ifnull(nqp::atkey($araw,nqp::iterkey_s($iter)),$p0),
  1396. Pair,
  1397. '$!value'
  1398. ),
  1399. return False
  1400. )
  1401. ),
  1402. True # all checks worked out, so ok
  1403. ),
  1404. # nothing in B, all elems in A should be < 0
  1405. Rakudo::QuantHash.MIX-ALL-NEGATIVE($araw)
  1406. ),
  1407. nqp::if(
  1408. ($braw := $b.RAW-HASH) && nqp::elems($braw),
  1409. # nothing in A, all elems in B should be >= 0
  1410. Rakudo::QuantHash.MIX-ALL-POSITIVE($braw),
  1411. True # nothing in A nor B
  1412. )
  1413. )
  1414. )
  1415. }
  1416. # Return whether first Baggy is a proper subset of the second Baggy,
  1417. # using Mixy semantics
  1418. method MIX-IS-PROPER-SUBSET($a,$b) {
  1419. nqp::if(
  1420. nqp::eqaddr(nqp::decont($a),nqp::decont($b)),
  1421. False, # X is never a true subset of itself
  1422. nqp::if(
  1423. (my $araw := $a.RAW-HASH) && (my $iter := nqp::iterator($araw)),
  1424. nqp::if( # elems in A
  1425. (my $braw := $b.RAW-HASH) && nqp::elems($braw),
  1426. nqp::stmts( # elems in A and B
  1427. (my int $less),
  1428. nqp::while( # check all values in A with B
  1429. $iter,
  1430. nqp::if(
  1431. (my $left := nqp::getattr(
  1432. nqp::iterval(nqp::shift($iter)),
  1433. Pair,
  1434. '$!value'
  1435. ))
  1436. > # value in A should be <= than B
  1437. (my $right := nqp::getattr(
  1438. nqp::ifnull(nqp::atkey($braw,nqp::iterkey_s($iter)),$p0),
  1439. Pair,
  1440. '$!value'
  1441. )),
  1442. (return False), # too many on left, we're done
  1443. nqp::unless($less,$less = $left < $right)
  1444. )
  1445. ),
  1446. ($iter := nqp::iterator($braw)),
  1447. nqp::while( # check all values in B with A
  1448. $iter,
  1449. nqp::if(
  1450. ($left := nqp::getattr(
  1451. nqp::ifnull(
  1452. nqp::atkey($araw,nqp::iterkey_s(nqp::shift($iter))),
  1453. $p0
  1454. ),
  1455. Pair,
  1456. '$!value'
  1457. ))
  1458. > # value in A should be <= than B
  1459. ($right := nqp::getattr(
  1460. nqp::iterval($iter),Pair,'$!value'
  1461. )),
  1462. (return False),
  1463. nqp::unless($less,$less = $left < $right)
  1464. )
  1465. ),
  1466. nqp::p6bool($less) # all checks worked out so far
  1467. ),
  1468. # nothing in B, all elems in A should be < 0
  1469. Rakudo::QuantHash.MIX-ALL-NEGATIVE($araw)
  1470. ),
  1471. nqp::if( # nothing in A
  1472. ($braw := $b.RAW-HASH) && nqp::elems($braw),
  1473. # something in B, all elems in B should be > 0
  1474. Rakudo::QuantHash.MIX-ALL-POSITIVE($braw),
  1475. False # nothing in A nor B
  1476. )
  1477. )
  1478. )
  1479. }
  1480. # set difference QuantHash IterSet from Mix IterSet, both assumed to have
  1481. # elems. 3rd parameter is 1 for Setty, 0 for Baggy semantics
  1482. method SUB-QUANTHASH-FROM-MIX(\aelems, \belems, \issetty) {
  1483. nqp::stmts(
  1484. (my $elems := nqp::create(Rakudo::Internals::IterationSet)),
  1485. (my $iter := nqp::iterator(belems)),
  1486. nqp::while( # subtract all righthand keys
  1487. $iter,
  1488. nqp::bindkey(
  1489. $elems,
  1490. nqp::iterkey_s(nqp::shift($iter)),
  1491. nqp::if(
  1492. issetty,
  1493. Pair.new(
  1494. nqp::iterval($iter),
  1495. nqp::getattr(
  1496. nqp::ifnull(nqp::atkey(aelems,nqp::iterkey_s($iter)),$p0),
  1497. Pair,
  1498. '$!value'
  1499. ) - 1
  1500. ),
  1501. nqp::p6bindattrinvres(
  1502. nqp::clone(nqp::iterval($iter)),
  1503. Pair,
  1504. '$!value',
  1505. nqp::getattr(
  1506. nqp::ifnull(nqp::atkey(aelems,nqp::iterkey_s($iter)),$p0),
  1507. Pair,
  1508. '$!value'
  1509. ) - nqp::getattr(nqp::iterval($iter),Pair,'$!value')
  1510. )
  1511. )
  1512. )
  1513. ),
  1514. ($iter := nqp::iterator(aelems)),
  1515. nqp::while( # vivify all untouched lefthand keys
  1516. $iter,
  1517. nqp::if(
  1518. nqp::existskey($elems,nqp::iterkey_s(nqp::shift($iter))),
  1519. nqp::unless( # was touched
  1520. nqp::getattr(
  1521. nqp::atkey($elems,nqp::iterkey_s($iter)),
  1522. Pair,
  1523. '$!value'
  1524. ),
  1525. nqp::deletekey($elems,nqp::iterkey_s($iter)) # but no value
  1526. ),
  1527. nqp::bindkey( # not touched, add it
  1528. $elems,
  1529. nqp::iterkey_s($iter),
  1530. nqp::p6bindattrinvres(
  1531. nqp::clone(nqp::iterval($iter)),
  1532. Pair,
  1533. '$!value',
  1534. nqp::getattr(nqp::iterval($iter),Pair,'$!value')
  1535. )
  1536. )
  1537. )
  1538. ),
  1539. $elems
  1540. )
  1541. }
  1542. # set difference of a Mixy and a QuantHash
  1543. method DIFFERENCE-MIXY-QUANTHASH(\a, \b) {
  1544. nqp::if(
  1545. (my $araw := a.RAW-HASH) && nqp::elems($araw),
  1546. nqp::if(
  1547. (my $braw := b.RAW-HASH) && nqp::elems($braw),
  1548. nqp::create(Mix).SET-SELF(
  1549. self.SUB-QUANTHASH-FROM-MIX($araw, $braw, nqp::istype(b,Setty)),
  1550. ),
  1551. a.Mix
  1552. ),
  1553. nqp::if(
  1554. nqp::istype(b,Failure),
  1555. b.throw,
  1556. nqp::if(
  1557. ($braw := b.RAW-HASH) && nqp::elems($braw),
  1558. nqp::stmts(
  1559. (my $elems := nqp::clone($braw)),
  1560. (my $iter := nqp::iterator($braw)),
  1561. nqp::while(
  1562. $iter,
  1563. nqp::bindkey( # clone with negated value
  1564. $elems,
  1565. nqp::iterkey_s(nqp::shift($iter)),
  1566. nqp::p6bindattrinvres(
  1567. nqp::clone(nqp::iterval($iter)),
  1568. Pair,
  1569. '$!value',
  1570. - nqp::getattr(nqp::iterval($iter),Pair,'$!value')
  1571. )
  1572. )
  1573. ),
  1574. nqp::create(Mix).SET-SELF($elems)
  1575. ),
  1576. mix()
  1577. )
  1578. )
  1579. )
  1580. }
  1581. }