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