1. my class BagHash does Baggy {
  2. #--- interface methods
  3. multi method WHICH(BagHash:D:) { self.Mu::WHICH }
  4. multi method AT-KEY(BagHash:D: \k) is raw {
  5. Proxy.new(
  6. FETCH => {
  7. nqp::if(
  8. (my $raw := self.raw_hash)
  9. && nqp::existskey($raw,(my $which := k.WHICH)),
  10. nqp::getattr(nqp::atkey($raw,$which),Pair,'$!value'),
  11. 0
  12. )
  13. },
  14. STORE => -> $, Int() $value {
  15. nqp::if(
  16. nqp::istype($value,Failure), # RT 128927
  17. $value.throw,
  18. nqp::if(
  19. (my $raw := self.raw_hash),
  20. nqp::if( # allocated hash
  21. nqp::existskey($raw,(my $which := k.WHICH)),
  22. nqp::if( # existing element
  23. nqp::isgt_i($value,0),
  24. nqp::bindattr(
  25. nqp::atkey($raw,$which),
  26. Pair,
  27. '$!value',
  28. nqp::decont($value)
  29. ),
  30. nqp::stmts(
  31. nqp::deletekey($raw,$which),
  32. 0
  33. )
  34. ),
  35. nqp::if(
  36. nqp::isgt_i($value,0), # new
  37. nqp::bindkey($raw,$which,Pair.new(k,nqp::decont($value)))
  38. )
  39. ),
  40. nqp::if( # no hash allocated yet
  41. nqp::isgt_i($value,0),
  42. nqp::bindkey(
  43. nqp::bindattr(%!elems,Map,'$!storage',
  44. nqp::create(Rakudo::Internals::IterationSet)),
  45. k.WHICH,
  46. Pair.new(k,nqp::decont($value))
  47. )
  48. )
  49. )
  50. )
  51. }
  52. )
  53. }
  54. #--- object creation methods
  55. multi method new(BagHash:_:) { nqp::create(self) }
  56. #--- introspection methods
  57. method total() { Rakudo::QuantHash.BAG-TOTAL(self.raw_hash) }
  58. multi method Bag(BagHash:D: :$view) {
  59. nqp::if(
  60. (my $raw := self.raw_hash) && nqp::elems($raw),
  61. nqp::p6bindattrinvres(
  62. nqp::create(Bag),Bag,'%!elems',
  63. nqp::if($view,%!elems,%!elems.clone)
  64. ),
  65. bag()
  66. )
  67. }
  68. multi method BagHash(BagHash:D:) { self }
  69. multi method Mix(BagHash:D:) {
  70. nqp::if(
  71. (my $raw := self.raw_hash) && nqp::elems($raw),
  72. nqp::p6bindattrinvres(nqp::create(Mix),Mix,'%!elems',%!elems.clone),
  73. mix()
  74. )
  75. }
  76. #--- iterator methods
  77. sub proxy(Mu \iter,Mu \storage) is raw {
  78. # We are only sure that the key exists when the Proxy
  79. # is made, but we cannot be sure of its existence when
  80. # either the FETCH or STORE block is executed. So we
  81. # still need to check for existence, and handle the case
  82. # where we need to (re-create) the key and value. The
  83. # logic is therefore basically the same as in AT-KEY,
  84. # except for tests for allocated storage and .WHICH
  85. # processing.
  86. nqp::stmts(
  87. (my $which := nqp::iterkey_s(iter)),
  88. # save object for potential recreation
  89. (my $object := nqp::getattr(nqp::iterval(iter),Pair,'$!key')),
  90. Proxy.new(
  91. FETCH => {
  92. nqp::if(
  93. nqp::existskey(storage,$which),
  94. nqp::getattr(nqp::atkey(storage,$which),Pair,'$!value'),
  95. 0
  96. )
  97. },
  98. STORE => -> $, Int() $value {
  99. nqp::if(
  100. nqp::istype($value,Failure), # RT 128927
  101. $value.throw,
  102. nqp::if(
  103. nqp::existskey(storage,$which),
  104. nqp::if( # existing element
  105. nqp::isgt_i($value,0),
  106. nqp::bindattr( # value ok
  107. nqp::atkey(storage,$which),
  108. Pair,
  109. '$!value',
  110. nqp::decont($value)
  111. ),
  112. nqp::stmts( # goodbye!
  113. nqp::deletekey(storage,$which),
  114. 0
  115. )
  116. ),
  117. nqp::if( # where did it go?
  118. nqp::isgt_i($value,0),
  119. nqp::bindkey(
  120. storage,
  121. $which,
  122. Pair.new($object,nqp::decont($value))
  123. )
  124. )
  125. )
  126. )
  127. }
  128. )
  129. )
  130. }
  131. multi method iterator(BagHash:D:) { # also .pairs
  132. class :: does Rakudo::Iterator::Mappy {
  133. method pull-one() is raw {
  134. nqp::if(
  135. $!iter,
  136. nqp::p6bindattrinvres(
  137. nqp::clone(nqp::iterval(nqp::shift($!iter))),
  138. Pair,
  139. '$!value',
  140. proxy($!iter,$!storage)
  141. ),
  142. IterationEnd
  143. )
  144. }
  145. method push-all($target --> IterationEnd) {
  146. nqp::while( # doesn't sink
  147. $!iter,
  148. $target.push(nqp::iterval(nqp::shift($!iter)))
  149. )
  150. }
  151. }.new(%!elems)
  152. }
  153. multi method values(BagHash:D:) {
  154. Seq.new(class :: does Rakudo::Iterator::Mappy {
  155. method pull-one() is raw {
  156. nqp::if(
  157. $!iter,
  158. proxy(nqp::shift($!iter),$!storage),
  159. IterationEnd
  160. )
  161. }
  162. # same as Baggy.values
  163. method push-all($target --> IterationEnd) {
  164. nqp::while( # doesn't sink
  165. $!iter,
  166. $target.push(nqp::getattr(
  167. nqp::iterval(nqp::shift($!iter)),Pair,'$!value'))
  168. )
  169. }
  170. }.new(%!elems))
  171. }
  172. multi method kv(BagHash:D:) {
  173. Seq.new(class :: does Rakudo::Iterator::Mappy-kv-from-pairs {
  174. method pull-one() is raw {
  175. nqp::if(
  176. $!on,
  177. nqp::stmts(
  178. ($!on = 0),
  179. proxy($!iter,$!storage)
  180. ),
  181. nqp::if(
  182. $!iter,
  183. nqp::stmts(
  184. ($!on = 1),
  185. nqp::getattr(
  186. nqp::iterval(nqp::shift($!iter)),Pair,'$!key')
  187. ),
  188. IterationEnd
  189. )
  190. )
  191. }
  192. }.new(%!elems))
  193. }
  194. #---- selection methods
  195. multi method grab(BagHash:D:) {
  196. nqp::if(
  197. (my $raw := self.raw_hash) && nqp::elems($raw),
  198. Rakudo::QuantHash.BAG-GRAB($raw,self.total),
  199. Nil
  200. )
  201. }
  202. multi method grab(BagHash:D: Callable:D $calculate) {
  203. self.grab( $calculate(self.total) )
  204. }
  205. multi method grab(BagHash:D: Whatever) { self.grab(Inf) }
  206. multi method grab(BagHash:D: $count) {
  207. Seq.new(nqp::if(
  208. (my $todo = Rakudo::QuantHash.TODO($count))
  209. && (my $raw := self.raw_hash)
  210. && nqp::elems($raw),
  211. nqp::stmts(
  212. (my Int $total = self.total),
  213. nqp::if($todo > $total,$todo = $total),
  214. Rakudo::Iterator.Callable( {
  215. nqp::if(
  216. $todo,
  217. nqp::stmts(
  218. --$todo,
  219. Rakudo::QuantHash.BAG-GRAB($raw,$total--)
  220. ),
  221. IterationEnd
  222. )
  223. } )
  224. ),
  225. Rakudo::Iterator.Empty
  226. ))
  227. }
  228. }