1. my role Setty does QuantHash {
  2. has $!elems; # key.WHICH => key
  3. multi method new(Setty: --> Setty:D) { nqp::create(self) }
  4. multi method new(Setty: +@args --> Setty:D) {
  5. nqp::if(
  6. (my $iterator := @args.iterator).is-lazy,
  7. Failure.new(X::Cannot::Lazy.new(:action<coerce>,:what<Set>)),
  8. nqp::stmts(
  9. (my $elems := nqp::create(Rakudo::Internals::IterationSet)),
  10. (my $iter := @args.iterator),
  11. nqp::until(
  12. nqp::eqaddr((my $pulled := $iter.pull-one),IterationEnd),
  13. nqp::bindkey($elems,$pulled.WHICH,$pulled)
  14. ),
  15. nqp::create(self).SET-SELF($elems)
  16. )
  17. )
  18. }
  19. method new-from-pairs(*@pairs --> Setty:D) {
  20. nqp::if(
  21. (my $iterator := @pairs.iterator).is-lazy,
  22. Failure.new(X::Cannot::Lazy.new(:action<coerce>,:what<Set>)),
  23. nqp::create(self).SET-SELF(
  24. self.fill_IterationSet(
  25. nqp::create(Rakudo::Internals::IterationSet),$iterator
  26. )
  27. )
  28. )
  29. }
  30. method fill_IterationSet(\elems,\iterator) {
  31. nqp::stmts(
  32. nqp::until(
  33. nqp::eqaddr(
  34. (my $pulled := iterator.pull-one),
  35. IterationEnd
  36. ),
  37. nqp::if(
  38. nqp::istype($pulled,Pair),
  39. nqp::if(
  40. nqp::getattr(nqp::decont($pulled),Pair,'$!value'),
  41. nqp::bindkey(
  42. elems,
  43. nqp::getattr(nqp::decont($pulled),Pair,'$!key').WHICH,
  44. nqp::getattr(nqp::decont($pulled),Pair,'$!key')
  45. )
  46. ),
  47. nqp::bindkey(elems,$pulled.WHICH,$pulled)
  48. )
  49. ),
  50. elems
  51. )
  52. }
  53. method default(--> False) { }
  54. multi method keys(Setty:D:) {
  55. Seq.new(Rakudo::Iterator.Mappy-values(self.hll_hash))
  56. }
  57. method elems(Setty:D: --> Int:D) {
  58. nqp::istrue($!elems) && nqp::elems($!elems)
  59. }
  60. method total(Setty:D: --> Int:D) {
  61. nqp::istrue($!elems) && nqp::elems($!elems)
  62. }
  63. multi method antipairs(Setty:D:) {
  64. Seq.new(class :: does Rakudo::Iterator::Mappy {
  65. method pull-one() {
  66. nqp::if(
  67. $!iter,
  68. Pair.new(True,nqp::iterval(nqp::shift($!iter))),
  69. IterationEnd
  70. )
  71. }
  72. }.new(self.hll_hash))
  73. }
  74. multi method minpairs(Setty:D:) { self.pairs }
  75. multi method maxpairs(Setty:D:) { self.pairs }
  76. multi method Bool(Setty:D:) {
  77. nqp::p6bool(nqp::istrue($!elems) && nqp::elems($!elems))
  78. }
  79. method HASHIFY(\type) {
  80. nqp::stmts(
  81. (my $hash := Hash.^parameterize(type,Any).new),
  82. (my $descriptor := nqp::getattr($hash,Hash,'$!descriptor')),
  83. nqp::if(
  84. $!elems && nqp::elems($!elems),
  85. nqp::stmts(
  86. (my $storage := nqp::clone($!elems)),
  87. (my $iter := nqp::iterator($storage)),
  88. nqp::while(
  89. $iter,
  90. nqp::bindkey(
  91. $storage,
  92. nqp::iterkey_s(nqp::shift($iter)),
  93. Pair.new(
  94. nqp::iterval($iter),
  95. (nqp::p6scalarfromdesc($descriptor) = True)
  96. )
  97. )
  98. ),
  99. nqp::bindattr($hash,Map,'$!storage',$storage)
  100. )
  101. ),
  102. $hash
  103. )
  104. }
  105. multi method hash(Setty:D: --> Hash:D) { self.HASHIFY(Any) }
  106. multi method Hash(Setty:D: --> Hash:D) { self.HASHIFY(Bool) }
  107. multi method ACCEPTS(Setty:U: $other) {
  108. $other.^does(self)
  109. }
  110. multi method ACCEPTS(Setty:D: Seq:D \seq) {
  111. self.ACCEPTS(seq.list)
  112. }
  113. multi method ACCEPTS(Setty:D: $other) {
  114. $other (<=) self && self (<=) $other
  115. }
  116. multi method Str(Setty:D $ : --> Str:D) { ~ self.hll_hash.values }
  117. multi method gist(Setty:D $ : --> Str:D) {
  118. my $name := self.^name;
  119. ( $name eq 'Set' ?? 'set' !! "$name.new" )
  120. ~ '('
  121. ~ self.hll_hash.values.map( {.gist} ).join(', ')
  122. ~ ')';
  123. }
  124. multi method perl(Setty:D $ : --> Str:D) {
  125. my $name := self.^name;
  126. ( $name eq 'Set' ?? 'set' !! "$name.new" )
  127. ~ '('
  128. ~ self.hll_hash.values.map( {.perl} ).join(',')
  129. ~ ')';
  130. }
  131. proto method grab(|) { * }
  132. proto method grabpairs(|) { * }
  133. proto method pick(|) { * }
  134. multi method pick(Setty:D:) { self.roll }
  135. multi method pick(Setty:D: Callable:D $calculate) {
  136. self.pick( $calculate(self.elems) )
  137. }
  138. multi method pick(Setty:D: Whatever $) {
  139. self.pick(Inf)
  140. }
  141. multi method pick(Setty:D: $count) {
  142. Seq.new(class :: does Rakudo::QuantHash::Pairs {
  143. method pull-one() is raw {
  144. nqp::if(
  145. nqp::elems($!picked),
  146. nqp::atkey($!elems,nqp::pop_s($!picked)),
  147. IterationEnd
  148. )
  149. }
  150. }.new($!elems, $count))
  151. }
  152. proto method pickpairs(|) { * }
  153. multi method pickpairs(Setty:D:) { Pair.new(self.roll,True) }
  154. multi method pickpairs(Setty:D: Callable:D $calculate) {
  155. self.pickpairs( $calculate(self.elems) )
  156. }
  157. multi method pickpairs(Setty:D: Whatever $) {
  158. self.pickpairs(Inf)
  159. }
  160. multi method pickpairs(Setty:D: $count) {
  161. Seq.new(class :: does Rakudo::QuantHash::Pairs {
  162. method pull-one() is raw {
  163. nqp::if(
  164. nqp::elems($!picked),
  165. Pair.new(nqp::atkey($!elems,nqp::pop_s($!picked)),True),
  166. IterationEnd
  167. )
  168. }
  169. }.new($!elems, $count))
  170. }
  171. proto method roll(|) { * }
  172. multi method roll(Setty:D:) {
  173. nqp::if(
  174. $!elems,
  175. nqp::iterval(Rakudo::QuantHash.ROLL($!elems)),
  176. Nil
  177. )
  178. }
  179. multi method roll(Setty:D: Callable:D $calculate) {
  180. self.roll($calculate(self.elems))
  181. }
  182. multi method roll(Setty:D: Whatever) {
  183. self.roll(Inf)
  184. }
  185. multi method roll(Setty:D: $count) {
  186. Seq.new(nqp::if(
  187. (my $todo = Rakudo::QuantHash.TODO($count))
  188. && $!elems
  189. && (my int $elems = nqp::elems($!elems)),
  190. nqp::stmts(
  191. (my $keys := self.raw_keys),
  192. nqp::if(
  193. $todo == Inf,
  194. Rakudo::Iterator.Callable(
  195. { nqp::atkey($!elems,nqp::atpos_s($keys,nqp::rand_n($elems))) },
  196. True
  197. ),
  198. Rakudo::Iterator.Callable( {
  199. nqp::if(
  200. $todo,
  201. nqp::stmts(
  202. --$todo,
  203. nqp::atkey(
  204. $!elems,
  205. nqp::atpos_s($keys,nqp::rand_n($elems))
  206. )
  207. ),
  208. IterationEnd
  209. )
  210. } )
  211. )
  212. ),
  213. Rakudo::Iterator.Empty
  214. ))
  215. }
  216. multi method EXISTS-KEY(Setty:D: \k --> Bool:D) {
  217. nqp::p6bool($!elems && nqp::existskey($!elems,k.WHICH))
  218. }
  219. method !BAGGIFY(\type) {
  220. nqp::if(
  221. $!elems,
  222. nqp::stmts(
  223. (my $elems := nqp::clone($!elems)),
  224. (my $iter := nqp::iterator($elems)),
  225. nqp::while(
  226. $iter,
  227. nqp::bindkey(
  228. $elems,
  229. nqp::iterkey_s(nqp::shift($iter)),
  230. Pair.new(nqp::decont(nqp::iterval($iter)),1)
  231. )
  232. ),
  233. nqp::create(type).SET-SELF($elems)
  234. ),
  235. nqp::create(type)
  236. )
  237. }
  238. multi method Bag(Setty:D:) { self!BAGGIFY(Bag) }
  239. multi method BagHash(Setty:D:) { self!BAGGIFY(BagHash) }
  240. multi method Mix(Setty:D:) { self!BAGGIFY(Mix) }
  241. multi method MixHash(Setty:D:) { self!BAGGIFY(MixHash) }
  242. method raw_hash() is raw { $!elems }
  243. method hll_hash() is raw {
  244. nqp::p6bindattrinvres(nqp::create(Hash),Map,'$!storage',$!elems)
  245. }
  246. # TODO: WHICH will require the capability for >1 pointer in ObjAt
  247. }