1. my role Baggy does QuantHash {
  2. # A Bag/BagHash/Mix/MixHash consists of a single hash with Pairs.
  3. # The keys of the hash, are the .WHICH strings of the original object key.
  4. # The values are Pairs containing the original object key and value.
  5. has %!elems; # key.WHICH => (key,value)
  6. # The Baggy role takes care of all mutable and immutable aspects that are
  7. # shared between Bag,BagHash,Mix,MixHash. Any specific behaviour for
  8. # mutable and immutable aspects of Mix/MixHash need to live in Mixy.
  9. # Immutables aspects of Bag/Mix, need to live to Bag/Mix respectively.
  10. #--- private methods
  11. method !WHICH() {
  12. self.^name
  13. ~ '|'
  14. ~ self.keys.sort.map( { $_.WHICH ~ '(' ~ self.AT-KEY($_) ~ ')' } );
  15. }
  16. method SANITY(\elems --> Nil) {
  17. nqp::stmts(
  18. (my $low := nqp::create(IterationBuffer)),
  19. (my $iter := nqp::iterator(elems)),
  20. nqp::while(
  21. $iter,
  22. nqp::if(
  23. nqp::isle_I(
  24. nqp::getattr(nqp::iterval(nqp::shift($iter)),Pair,'$!value'),
  25. 0
  26. ),
  27. nqp::stmts(
  28. nqp::if(
  29. nqp::islt_I(
  30. nqp::getattr(nqp::iterval($iter),Pair,'$!value'),
  31. 0
  32. ),
  33. nqp::push($low,nqp::getattr(nqp::iterval($iter),Pair,'$!key'))
  34. ),
  35. nqp::deletekey(elems,nqp::iterkey_s($iter))
  36. )
  37. )
  38. ),
  39. nqp::if(
  40. nqp::elems($low),
  41. X::AdHoc.new( payload =>
  42. "Found negative values for "
  43. ~ nqp::p6bindattrinvres(nqp::create(List),List,'$!reified',$low)
  44. ~ " in "
  45. ~ self.^name
  46. ).throw,
  47. Nil
  48. )
  49. )
  50. }
  51. method !LISTIFY(&formatter, str $joiner) {
  52. nqp::if(
  53. (my $raw := self.raw_hash) && nqp::elems($raw),
  54. nqp::stmts(
  55. (my $list := nqp::setelems(nqp::list_s,nqp::elems($raw))),
  56. (my $iter := nqp::iterator($raw)),
  57. (my int $i = -1),
  58. nqp::while(
  59. $iter,
  60. nqp::bindpos_s($list,($i = nqp::add_i($i,1)),
  61. formatter(
  62. (my $pair := nqp::iterval(nqp::shift($iter))).key,
  63. $pair.value
  64. )
  65. )
  66. ),
  67. nqp::p6box_s(nqp::join($joiner,$list))
  68. ),
  69. ""
  70. )
  71. }
  72. #--- interface methods
  73. method SET-SELF(Baggy:D: \elems) {
  74. nqp::stmts(
  75. nqp::if(
  76. nqp::elems(elems),
  77. # need to have allocated %!elems
  78. nqp::bindattr(%!elems,Map,'$!storage',elems),
  79. ),
  80. self
  81. )
  82. }
  83. multi method ACCEPTS(Baggy:U: $other) {
  84. $other.^does(self)
  85. }
  86. multi method ACCEPTS(Baggy:D: Mu $other) {
  87. $other (<+) self && self (<+) $other
  88. }
  89. multi method ACCEPTS(Baggy:D: Baggy:D $other --> Bool:D) {
  90. nqp::p6bool(
  91. nqp::unless(
  92. nqp::eqaddr(self,$other),
  93. nqp::if(
  94. (%!elems.elems
  95. == nqp::getattr($other,$other.WHAT,'%!elems').elems),
  96. nqp::stmts(
  97. (my $iter := nqp::iterator(
  98. nqp::getattr(%!elems,Map,'$!storage'))),
  99. (my $oelems := nqp::getattr(
  100. nqp::getattr($other,$other.WHAT,'%!elems'),Map,'$!storage')),
  101. nqp::while(
  102. $iter,
  103. nqp::unless(
  104. (nqp::existskey($oelems,nqp::iterkey_s(nqp::shift($iter)))
  105. && nqp::getattr(nqp::iterval($iter),Pair,'$!value')
  106. == nqp::getattr(nqp::atkey(
  107. $oelems,nqp::iterkey_s($iter)),Pair,'$!value')),
  108. return False
  109. )
  110. ),
  111. 1
  112. )
  113. )
  114. )
  115. )
  116. }
  117. multi method AT-KEY(Baggy:D: \k) { # exception: ro version for Bag/Mix
  118. nqp::if(
  119. (my $raw := self.raw_hash),
  120. nqp::getattr(
  121. nqp::ifnull(
  122. nqp::atkey($raw,k.WHICH),
  123. BEGIN nqp::p6bindattrinvres(nqp::create(Pair),Pair,'$!value',0)
  124. ),
  125. Pair,
  126. '$!value'
  127. ),
  128. 0
  129. )
  130. }
  131. multi method DELETE-KEY(Baggy:D: \k) {
  132. nqp::if(
  133. (my $raw := self.raw_hash)
  134. && nqp::existskey($raw,(my $which := k.WHICH)),
  135. nqp::stmts(
  136. (my $value :=
  137. nqp::getattr(nqp::atkey($raw,$which),Pair,'$!value')),
  138. nqp::deletekey($raw,$which),
  139. $value
  140. ),
  141. 0
  142. )
  143. }
  144. multi method EXISTS-KEY(Baggy:D: \k) {
  145. nqp::p6bool(
  146. (my $raw := self.raw_hash) && nqp::existskey($raw,k.WHICH)
  147. )
  148. }
  149. #--- object creation methods
  150. multi method new(Baggy:_: +@args) {
  151. nqp::stmts(
  152. Rakudo::QuantHash.ADD-ITERATOR-TO-BAG(
  153. (my $elems := nqp::create(Rakudo::Internals::IterationSet)),
  154. (my $iterator := @args.iterator)
  155. ),
  156. nqp::create(self).SET-SELF($elems)
  157. )
  158. }
  159. method new-from-pairs(*@pairs) {
  160. nqp::stmts(
  161. (my $elems := nqp::create(Rakudo::Internals::IterationSet)),
  162. (my $iterator := @pairs.iterator),
  163. nqp::until(
  164. nqp::eqaddr(
  165. (my $pulled := nqp::decont($iterator.pull-one)),
  166. IterationEnd
  167. ),
  168. nqp::if(
  169. nqp::istype($pulled,Pair),
  170. nqp::stmts(
  171. (my int $seen-pair = 1),
  172. nqp::if(
  173. nqp::existskey(
  174. $elems,
  175. (my $which := nqp::getattr($pulled,Pair,'$!key').WHICH)
  176. ),
  177. nqp::stmts(
  178. (my $pair := nqp::atkey($elems,$which)),
  179. nqp::bindattr(
  180. $pair,
  181. Pair,
  182. '$!value',
  183. nqp::getattr($pair,Pair,'$!value')
  184. + nqp::getattr($pulled,Pair,'$!value')
  185. )
  186. ),
  187. nqp::bindkey(
  188. $elems,
  189. $which,
  190. nqp::p6bindattrinvres(
  191. nqp::clone($pulled),
  192. Pair,
  193. '$!value',
  194. nqp::decont(nqp::getattr($pulled,Pair,'$!value'))
  195. )
  196. )
  197. )
  198. ),
  199. nqp::if(
  200. nqp::existskey(
  201. $elems,
  202. ($which := $pulled.WHICH)
  203. ),
  204. nqp::stmts(
  205. ($pair := nqp::atkey($elems,$which)),
  206. nqp::bindattr(
  207. $pair,
  208. Pair,
  209. '$!value',
  210. nqp::getattr($pair,Pair,'$!value') + 1
  211. )
  212. ),
  213. nqp::bindkey($elems,$which,Pair.new($pulled,1))
  214. )
  215. )
  216. ),
  217. nqp::if($seen-pair && nqp::elems($elems),self.SANITY($elems)),
  218. nqp::create(self).SET-SELF($elems)
  219. )
  220. }
  221. #--- iterator methods
  222. multi method iterator(Baggy:D:) {
  223. Rakudo::Iterator.Mappy-values(%!elems)
  224. }
  225. multi method keys(Baggy:D:) {
  226. Seq.new(class :: does Rakudo::Iterator::Mappy {
  227. method pull-one() {
  228. $!iter
  229. ?? nqp::iterval(nqp::shift($!iter)).key
  230. !! IterationEnd
  231. }
  232. method push-all($target --> IterationEnd) {
  233. nqp::while( # doesn't sink
  234. $!iter,
  235. $target.push(nqp::iterval(nqp::shift($!iter)).key)
  236. )
  237. }
  238. }.new(%!elems))
  239. }
  240. multi method kv(Baggy:D:) {
  241. Seq.new(Rakudo::Iterator.Mappy-kv-from-pairs(%!elems))
  242. }
  243. multi method values(Baggy:D:) {
  244. Seq.new(class :: does Rakudo::Iterator::Mappy {
  245. method pull-one() is raw {
  246. nqp::if(
  247. $!iter,
  248. nqp::getattr(nqp::iterval(nqp::shift($!iter)),Pair,'$!value'),
  249. IterationEnd
  250. )
  251. }
  252. method push-all($target --> IterationEnd) {
  253. nqp::while( # doesn't sink
  254. $!iter,
  255. $target.push(
  256. nqp::getattr(
  257. nqp::iterval(nqp::shift($!iter)),
  258. Pair,
  259. '$!value'
  260. )
  261. )
  262. )
  263. }
  264. }.new(%!elems))
  265. }
  266. multi method antipairs(Baggy:D:) {
  267. Seq.new(class :: does Rakudo::Iterator::Mappy {
  268. method pull-one() {
  269. nqp::if(
  270. $!iter,
  271. nqp::iterval(nqp::shift($!iter)).antipair,
  272. IterationEnd
  273. )
  274. }
  275. method push-all($target --> IterationEnd) {
  276. nqp::while(
  277. $!iter,
  278. $target.push(nqp::iterval(nqp::shift($!iter)).antipair),
  279. )
  280. }
  281. }.new(%!elems))
  282. }
  283. proto method kxxv(|) { * }
  284. multi method kxxv(Baggy:D:) {
  285. Seq.new(class :: does Rakudo::Iterator::Mappy {
  286. has Mu $!key;
  287. has int $!times;
  288. method pull-one() is raw {
  289. nqp::if(
  290. $!times,
  291. nqp::stmts(
  292. ($!times = nqp::sub_i($!times,1)),
  293. $!key
  294. ),
  295. nqp::if(
  296. $!iter,
  297. nqp::stmts(
  298. ($!key := nqp::getattr(
  299. (my $pair := nqp::iterval(nqp::shift($!iter))),
  300. Pair,
  301. '$!key'
  302. )),
  303. ($!times =
  304. nqp::sub_i(nqp::getattr($pair,Pair,'$!value'),1)),
  305. $!key
  306. ),
  307. IterationEnd
  308. )
  309. )
  310. }
  311. method skip-one() { # the default skip-one, too difficult to handle
  312. nqp::not_i(nqp::eqaddr(self.pull-one,IterationEnd))
  313. }
  314. method push-all($target --> IterationEnd) {
  315. nqp::while(
  316. $!iter,
  317. nqp::stmts(
  318. ($!key := nqp::getattr(
  319. (my $pair := nqp::iterval(nqp::shift($!iter))),
  320. Pair,
  321. '$!key'
  322. )),
  323. ($!times =
  324. nqp::add_i(nqp::getattr($pair,Pair,'$!value'),1)),
  325. nqp::while( # doesn't sink
  326. ($!times = nqp::sub_i($!times,1)),
  327. $target.push($!key)
  328. )
  329. )
  330. )
  331. }
  332. }.new(%!elems))
  333. }
  334. multi method invert(Baggy:D:) {
  335. Seq.new(Rakudo::Iterator.Invert(%!elems.values.iterator))
  336. }
  337. #--- introspection methods
  338. multi method WHICH(Baggy:D:) { self!WHICH }
  339. multi method elems(Baggy:D: --> Int:D) { %!elems.elems }
  340. multi method Bool(Baggy:D: --> Bool:D) { %!elems.Bool }
  341. method HASHIFY(\type) {
  342. nqp::stmts(
  343. (my $hash := Hash.^parameterize(type,Any).new),
  344. (my $descriptor := nqp::getattr($hash,Hash,'$!descriptor')),
  345. nqp::if(
  346. (my $raw := self.raw_hash) && nqp::elems($raw),
  347. nqp::stmts(
  348. (my $storage := nqp::clone($raw)),
  349. (my $iter := nqp::iterator($storage)),
  350. nqp::while(
  351. $iter,
  352. nqp::bindkey(
  353. $storage,
  354. nqp::iterkey_s(nqp::shift($iter)),
  355. nqp::p6bindattrinvres(
  356. nqp::clone(nqp::iterval($iter)),
  357. Pair,
  358. '$!value',
  359. (nqp::p6scalarfromdesc($descriptor) =
  360. nqp::getattr(nqp::iterval($iter),Pair,'$!value'))
  361. )
  362. )
  363. ),
  364. nqp::bindattr($hash,Map,'$!storage',$storage)
  365. )
  366. ),
  367. $hash
  368. )
  369. }
  370. multi method hash(Baggy:D: --> Hash:D) { self.HASHIFY(Any) }
  371. multi method Hash(Baggy:D: --> Hash:D) { self.HASHIFY(UInt) }
  372. method default(Baggy:D: --> 0) { }
  373. multi method Str(Baggy:D: --> Str:D) {
  374. self!LISTIFY(-> \k,\v {v==1 ?? k.gist !! "{k.gist}({v})"}, ' ')
  375. }
  376. multi method gist(Baggy:D: --> Str:D) {
  377. my str $name = nqp::unbox_s(self.^name);
  378. ( nqp::chars($name) == 3 ?? nqp::lc($name) !! "$name.new" )
  379. ~ '('
  380. ~ self!LISTIFY(-> \k,\v {v==1 ?? k.gist !! "{k.gist}({v})"}, ', ')
  381. ~ ')'
  382. }
  383. multi method perl(Baggy:D: --> Str:D) {
  384. '('
  385. ~ self!LISTIFY( -> \k,\v {"{k.perl}=>{v}"}, ',')
  386. ~ ").{self.^name}"
  387. }
  388. #--- selection methods
  389. proto method grabpairs (|) { * }
  390. multi method grabpairs(Baggy:D:) {
  391. nqp::if(
  392. (my $raw := self.raw_hash) && nqp::elems($raw),
  393. nqp::stmts(
  394. (my $iter := Rakudo::QuantHash.ROLL($raw)),
  395. (my $pair := nqp::iterval($iter)),
  396. nqp::deletekey($raw,nqp::iterkey_s($iter)),
  397. $pair
  398. ),
  399. Nil
  400. )
  401. }
  402. multi method grabpairs(Baggy:D: Callable:D $calculate) {
  403. self.grabpairs( $calculate(self.elems) )
  404. }
  405. multi method grabpairs(Baggy:D: Whatever $) {
  406. self.grabpairs(Inf)
  407. }
  408. multi method grabpairs(Baggy:D: $count) {
  409. Seq.new(class :: does Rakudo::QuantHash::Pairs {
  410. method pull-one() is raw {
  411. nqp::if(
  412. nqp::elems($!picked),
  413. nqp::stmts(
  414. (my $pair := nqp::atkey(
  415. $!elems,
  416. (my $key := nqp::pop_s($!picked))
  417. )),
  418. nqp::deletekey($!elems,$key),
  419. $pair
  420. ),
  421. IterationEnd
  422. )
  423. }
  424. }.new(self.raw_hash, $count))
  425. }
  426. proto method pickpairs(|) { * }
  427. multi method pickpairs(Baggy:D:) {
  428. nqp::if(
  429. (my $raw := self.raw_hash) && nqp::elems($raw),
  430. nqp::iterval(Rakudo::QuantHash.ROLL($raw)),
  431. Nil
  432. )
  433. }
  434. multi method pickpairs(Baggy:D: Callable:D $calculate) {
  435. self.pickpairs( $calculate(self.total) )
  436. }
  437. multi method pickpairs(Baggy:D: Whatever $) {
  438. self.pickpairs(Inf)
  439. }
  440. multi method pickpairs(Baggy:D: $count) {
  441. Seq.new(class :: does Rakudo::QuantHash::Pairs {
  442. method pull-one() is raw {
  443. nqp::if(
  444. nqp::elems($!picked),
  445. nqp::atkey($!elems,nqp::pop_s($!picked)),
  446. IterationEnd
  447. )
  448. }
  449. }.new(self.raw_hash, $count))
  450. }
  451. proto method grab(|) { * }
  452. multi method grab(Baggy:D: |c) {
  453. X::Immutable.new( method => 'grab', typename => self.^name ).throw;
  454. }
  455. proto method pick(|) { * }
  456. multi method pick(Baggy:D:) { self.roll }
  457. multi method pick(Baggy:D: Callable:D $calculate) {
  458. self.pick( $calculate(self.total) )
  459. }
  460. multi method pick(Baggy:D: Whatever) { self.pick(Inf) }
  461. multi method pick(Baggy:D: $count) {
  462. Seq.new(nqp::if(
  463. (my $todo = Rakudo::QuantHash.TODO($count))
  464. && (my $raw := self.raw_hash)
  465. && (my int $elems = nqp::elems($raw)),
  466. nqp::stmts(
  467. (my $pairs := nqp::setelems(nqp::list,$elems)),
  468. (my $iter := nqp::iterator($raw)),
  469. (my int $i = -1),
  470. nqp::while(
  471. nqp::islt_i(($i = nqp::add_i($i,1)),$elems),
  472. nqp::bindpos($pairs,$i,Pair.new(
  473. nqp::getattr(
  474. (my $pair := nqp::iterval(nqp::shift($iter))),Pair,'$!key'),
  475. nqp::assign(nqp::p6scalarfromdesc(nqp::null),
  476. nqp::getattr($pair,Pair,'$!value'))
  477. ))
  478. ),
  479. self!ROLLPICKGRABN(nqp::if($todo == Inf,self.total,$todo),$pairs)
  480. ),
  481. Rakudo::Iterator.Empty
  482. ))
  483. }
  484. proto method roll(|) { * }
  485. multi method roll(Baggy:D:) {
  486. nqp::if(
  487. (my $raw := self.raw_hash) && nqp::elems($raw),
  488. nqp::getattr(
  489. nqp::iterval(Rakudo::QuantHash.BAG-ROLL($raw,self.total)),
  490. Pair,
  491. '$!key'
  492. ),
  493. Nil
  494. )
  495. }
  496. multi method roll(Baggy:D: Whatever) { self.roll(Inf) }
  497. multi method roll(Baggy:D: $count) {
  498. Seq.new(nqp::if(
  499. $count < 1,
  500. Rakudo::Iterator.Empty,
  501. nqp::if(
  502. $count == Inf,
  503. Rakudo::Iterator.Roller(self),
  504. self!ROLLPICKGRABN($count.Int, %!elems.values, :keep)
  505. )
  506. ))
  507. }
  508. method !ROLLPICKGRABN(Int() $count, @pairs, :$keep) { # N times
  509. class :: does Iterator {
  510. has Int $!total;
  511. has int $!elems;
  512. has $!pairs;
  513. has int $!todo;
  514. has int $!keep;
  515. method !SET-SELF($!total, \pairs, \keep, \todo) {
  516. $!elems = pairs.elems; # reifies
  517. $!pairs := nqp::getattr(pairs,List,'$!reified');
  518. $!todo = todo;
  519. $!keep = +?keep;
  520. self
  521. }
  522. method new(\total,\pairs,\keep,\count) {
  523. nqp::create(self)!SET-SELF(
  524. total, pairs, keep, keep ?? count !! (total min count))
  525. }
  526. method pull-one() {
  527. if $!todo {
  528. $!todo = nqp::sub_i($!todo,1);
  529. my Int $rand = $!total.rand.Int;
  530. my Int $seen = 0;
  531. my int $i = -1;
  532. nqp::while(
  533. nqp::islt_i(($i = nqp::add_i($i,1)),$!elems),
  534. ($seen = $seen + nqp::atpos($!pairs,$i).value),
  535. nqp::if(
  536. $seen > $rand,
  537. nqp::stmts(
  538. nqp::unless(
  539. $!keep,
  540. nqp::stmts(
  541. --(nqp::atpos($!pairs,$i)).value,
  542. --$!total,
  543. )
  544. ),
  545. return nqp::atpos($!pairs,$i).key
  546. )
  547. )
  548. );
  549. }
  550. IterationEnd
  551. }
  552. }.new(self.total,@pairs,$keep,$count)
  553. }
  554. #--- classification method
  555. proto method classify-list(|) { * }
  556. multi method classify-list( &test, \list) {
  557. fail X::Cannot::Lazy.new(:action<classify>) if list.is-lazy;
  558. my \iter = (nqp::istype(list, Iterable) ?? list !! list.list).iterator;
  559. while (my $value := iter.pull-one) !=:= IterationEnd {
  560. my $tested := test($value);
  561. if nqp::istype($tested, Iterable) { # multi-level classify
  562. X::Invalid::ComputedValue.new(
  563. :name<mapper>,
  564. :method<classify-list>,
  565. :value<an Iterable item>,
  566. :reason(self.^name ~ ' cannot be nested and so does not '
  567. ~ 'support multi-level classification'),
  568. ).throw;
  569. }
  570. else {
  571. self{$tested}++;
  572. }
  573. }
  574. self;
  575. }
  576. multi method classify-list( %test, |c ) {
  577. self.classify-list( { %test{$^a} }, |c );
  578. }
  579. multi method classify-list( @test, |c ) {
  580. self.classify-list( { @test[$^a] }, |c );
  581. }
  582. multi method classify-list(&test, **@list, |c) {
  583. self.classify-list(&test, @list, |c);
  584. }
  585. proto method categorize-list(|) { * }
  586. multi method categorize-list( &test, \list ) {
  587. fail X::Cannot::Lazy.new(:action<categorize>) if list.is-lazy;
  588. my \iter = (nqp::istype(list, Iterable) ?? list !! list.list).iterator;
  589. my $value := iter.pull-one;
  590. unless $value =:= IterationEnd {
  591. my $tested := test($value);
  592. # multi-level categorize
  593. if nqp::istype($tested[0],Iterable) {
  594. X::Invalid::ComputedValue.new(
  595. :name<mapper>,
  596. :method<categorize-list>,
  597. :value<a nested Iterable item>,
  598. :reason(self.^name ~ ' cannot be nested and so does not '
  599. ~ 'support multi-level categorization'),
  600. ).throw;
  601. }
  602. # simple categorize
  603. else {
  604. loop {
  605. self{$_}++ for @$tested;
  606. last if ($value := iter.pull-one) =:= IterationEnd;
  607. nqp::istype(($tested := test($value))[0], Iterable)
  608. and X::Invalid::ComputedValue.new(
  609. :name<mapper>,
  610. :method<categorize-list>,
  611. :value('an item with different number of elements '
  612. ~ 'in it than previous items'),
  613. :reason('all values need to have the same number '
  614. ~ 'of elements. Mixed-level classification is '
  615. ~ 'not supported.'),
  616. ).throw;
  617. };
  618. }
  619. }
  620. self;
  621. }
  622. multi method categorize-list( %test, |c ) {
  623. self.categorize-list( { %test{$^a} }, |c );
  624. }
  625. multi method categorize-list( @test, |c ) {
  626. self.categorize-list( { @test[$^a] }, |c );
  627. }
  628. multi method categorize-list( &test, **@list, |c ) {
  629. self.categorize-list( &test, @list, |c );
  630. }
  631. #--- coercion methods
  632. method !SETIFY(\type) {
  633. nqp::if(
  634. (my $raw := self.raw_hash) && nqp::elems($raw),
  635. nqp::stmts(
  636. (my $elems := nqp::clone($raw)),
  637. (my $iter := nqp::iterator($elems)),
  638. nqp::while(
  639. $iter,
  640. nqp::bindkey(
  641. $elems,
  642. nqp::iterkey_s(nqp::shift($iter)),
  643. nqp::getattr(nqp::iterval($iter),Pair,'$!key'),
  644. )
  645. ),
  646. nqp::create(type).SET-SELF($elems)
  647. ),
  648. nqp::if(
  649. nqp::eqaddr(type,Set),
  650. set(),
  651. nqp::create(type)
  652. )
  653. )
  654. }
  655. multi method Set(Baggy:D:) { self!SETIFY(Set) }
  656. multi method SetHash(Baggy:D:) { self!SETIFY(SetHash) }
  657. method !BAGGIFY(\type) {
  658. nqp::if(
  659. (my $raw := self.raw_hash) && nqp::elems($raw),
  660. nqp::stmts( # something to coerce
  661. (my $elems := nqp::clone($raw)),
  662. (my $iter := nqp::iterator($elems)),
  663. nqp::while(
  664. $iter,
  665. nqp::if(
  666. nqp::isgt_i(
  667. (my $value := nqp::getattr(
  668. nqp::iterval(nqp::shift($iter)),
  669. Pair,
  670. '$!value'
  671. ).Int
  672. ), # .Int also deconts
  673. 0
  674. ),
  675. nqp::bindkey( # ok to keep value.Int
  676. $elems,
  677. nqp::iterkey_s($iter),
  678. nqp::p6bindattrinvres(
  679. nqp::clone(nqp::iterval($iter)),
  680. Pair,
  681. '$!value',
  682. $value
  683. )
  684. ),
  685. nqp::deletekey( # we don't do <= 0 in bags
  686. $elems,
  687. nqp::iterkey_s($iter)
  688. )
  689. )
  690. ),
  691. nqp::create(type).SET-SELF($elems),
  692. ),
  693. nqp::if( # nothing to coerce
  694. nqp::istype(type,Bag),
  695. bag(),
  696. nqp::create(BagHash)
  697. )
  698. )
  699. }
  700. multi method Bag(Baggy:D:) { self!BAGGIFY(Bag) }
  701. multi method BagHash(Baggy:D:) { self!BAGGIFY(BagHash) }
  702. method !MIXIFY(\type) {
  703. nqp::if(
  704. (my $raw := self.raw_hash) && nqp::elems($raw),
  705. nqp::stmts( # something to coerce
  706. (my $elems := nqp::clone($raw)),
  707. (my $iter := nqp::iterator($elems)),
  708. nqp::while(
  709. $iter,
  710. nqp::bindkey(
  711. $elems,
  712. nqp::iterkey_s(nqp::shift($iter)),
  713. nqp::p6bindattrinvres(
  714. nqp::clone(nqp::iterval($iter)),
  715. Pair,
  716. '$!value',
  717. nqp::getattr(nqp::iterval($iter),Pair,'$!value')
  718. )
  719. )
  720. ),
  721. nqp::create(type).SET-SELF($elems)
  722. ),
  723. nqp::if( # nothing to coerce
  724. nqp::istype(type,Mix),
  725. mix(),
  726. nqp::create(MixHash)
  727. )
  728. )
  729. }
  730. multi method Mix(Baggy:D:) { self!MIXIFY(Mix) }
  731. multi method MixHash(Baggy:D:) { self!MIXIFY(MixHash) }
  732. method clone() {
  733. nqp::if(
  734. (my $raw := self.raw_hash) && nqp::elems($raw),
  735. nqp::stmts( # something to clone
  736. (my $elems := nqp::clone($raw)),
  737. (my $iter := nqp::iterator($elems)),
  738. nqp::while(
  739. $iter,
  740. nqp::bindkey(
  741. $elems,
  742. nqp::iterkey_s(nqp::shift($iter)),
  743. nqp::p6bindattrinvres(
  744. nqp::clone(nqp::iterval($iter)),
  745. Pair,
  746. '$!value',
  747. nqp::clone(nqp::getattr(nqp::iterval($iter),Pair,'$!value'))
  748. )
  749. )
  750. ),
  751. nqp::create(self).SET-SELF($elems)
  752. ),
  753. nqp::create(self) # nothing to clone
  754. )
  755. }
  756. method raw_hash() is raw { nqp::getattr(%!elems,Map,'$!storage') }
  757. }
  758. multi sub infix:<eqv>(Baggy:D \a, Baggy:D \b) {
  759. nqp::p6bool(
  760. nqp::unless(
  761. nqp::eqaddr(a,b),
  762. nqp::eqaddr(a.WHAT,b.WHAT)
  763. && nqp::getattr(nqp::decont(a),a.WHAT,'%!elems')
  764. eqv nqp::getattr(nqp::decont(b),b.WHAT,'%!elems')
  765. )
  766. )
  767. }