1. my role Setty does QuantHash {
  2. has Rakudo::Internals::IterationSet $!elems; # key.WHICH => key
  3. # helper sub to create Set from iterator, check for laziness
  4. sub create-from-iterator(\type, \iterator --> Setty:D) {
  5. nqp::if(
  6. iterator.is-lazy,
  7. Failure.new(X::Cannot::Lazy.new(:action<coerce>,:what(type.^name))),
  8. nqp::create(type).SET-SELF(
  9. Rakudo::QuantHash.ADD-ITERATOR-TO-SET(
  10. nqp::create(Rakudo::Internals::IterationSet), iterator
  11. )
  12. )
  13. )
  14. }
  15. multi method new(Setty: --> Setty:D) { nqp::create(self) }
  16. multi method new(Setty: \value --> Setty:D) {
  17. nqp::if(
  18. nqp::istype(value,Iterable) && nqp::not_i(nqp::iscont(value)),
  19. create-from-iterator(self, value.iterator),
  20. nqp::stmts(
  21. nqp::bindkey(
  22. (my $elems := nqp::create(Rakudo::Internals::IterationSet)),
  23. value.WHICH,
  24. nqp::decont(value)
  25. ),
  26. nqp::create(self).SET-SELF($elems)
  27. )
  28. )
  29. }
  30. multi method new(Setty: **@args --> Setty:D) {
  31. create-from-iterator(self, @args.iterator)
  32. }
  33. method new-from-pairs(*@pairs --> Setty:D) {
  34. nqp::if(
  35. (my $iterator := @pairs.iterator).is-lazy,
  36. Failure.new(X::Cannot::Lazy.new(:action<coerce>,:what(self.^name))),
  37. nqp::create(self).SET-SELF(
  38. Rakudo::QuantHash.ADD-PAIRS-TO-SET(
  39. nqp::create(Rakudo::Internals::IterationSet), $iterator
  40. )
  41. )
  42. )
  43. }
  44. method default(--> False) { }
  45. multi method keys(Setty:D:) {
  46. Seq.new(Rakudo::Iterator.Mappy-values($!elems))
  47. }
  48. method elems(Setty:D: --> Int:D) {
  49. nqp::istrue($!elems) && nqp::elems($!elems)
  50. }
  51. method total(Setty:D: --> Int:D) {
  52. nqp::istrue($!elems) && nqp::elems($!elems)
  53. }
  54. multi method antipairs(Setty:D:) {
  55. Seq.new(class :: does Rakudo::Iterator::Mappy {
  56. method pull-one() {
  57. nqp::if(
  58. $!iter,
  59. Pair.new(True,nqp::iterval(nqp::shift($!iter))),
  60. IterationEnd
  61. )
  62. }
  63. }.new($!elems))
  64. }
  65. multi method minpairs(Setty:D:) { self.pairs }
  66. multi method maxpairs(Setty:D:) { self.pairs }
  67. multi method Bool(Setty:D: --> Bool:D) {
  68. nqp::p6bool($!elems && nqp::elems($!elems))
  69. }
  70. method HASHIFY(\type) {
  71. nqp::stmts(
  72. (my $hash := Hash.^parameterize(type,Any).new),
  73. (my $descriptor := nqp::getattr($hash,Hash,'$!descriptor')),
  74. nqp::if(
  75. $!elems && nqp::elems($!elems),
  76. nqp::stmts(
  77. (my $storage := nqp::clone($!elems)),
  78. (my $iter := nqp::iterator($storage)),
  79. nqp::while(
  80. $iter,
  81. nqp::bindkey(
  82. $storage,
  83. nqp::iterkey_s(nqp::shift($iter)),
  84. Pair.new(
  85. nqp::iterval($iter),
  86. (nqp::p6scalarfromdesc($descriptor) = True)
  87. )
  88. )
  89. ),
  90. nqp::bindattr($hash,Map,'$!storage',$storage)
  91. )
  92. ),
  93. $hash
  94. )
  95. }
  96. multi method hash(Setty:D: --> Hash:D) { self.HASHIFY(Any) }
  97. multi method Hash(Setty:D: --> Hash:D) { self.HASHIFY(Bool) }
  98. multi method ACCEPTS(Setty:U: \other) { other.^does(self) }
  99. multi method ACCEPTS(Setty:D: Setty:D \other) {
  100. nqp::p6bool(
  101. nqp::unless(
  102. nqp::eqaddr(self,other),
  103. nqp::if( # not same object
  104. $!elems,
  105. nqp::if( # something on left
  106. (my $oraw := other.RAW-HASH),
  107. nqp::if( # something on both sides
  108. nqp::iseq_i(nqp::elems($!elems),nqp::elems($oraw)),
  109. nqp::stmts( # same size
  110. (my $iter := nqp::iterator($!elems)),
  111. nqp::while(
  112. $iter,
  113. nqp::unless(
  114. nqp::existskey($oraw,nqp::iterkey_s(nqp::shift($iter))),
  115. return False # missing key, we're done
  116. )
  117. ),
  118. True # all keys identical
  119. )
  120. )
  121. ),
  122. # true -> both empty
  123. nqp::isfalse(
  124. ($oraw := other.RAW-HASH) && nqp::elems($oraw)
  125. )
  126. )
  127. )
  128. )
  129. }
  130. multi method ACCEPTS(Setty:D: \other) { self.ACCEPTS(other.Set) }
  131. multi method Str(Setty:D $ : --> Str:D) {
  132. nqp::join(" ",Rakudo::QuantHash.RAW-VALUES-MAP(self, *.Str))
  133. }
  134. multi method gist(Setty:D $ : --> Str:D) {
  135. nqp::concat(
  136. nqp::concat(
  137. nqp::if(
  138. nqp::istype(self,Set),
  139. 'set(',
  140. nqp::concat(self.^name,'(')
  141. ),
  142. nqp::join(" ",
  143. Rakudo::Sorting.MERGESORT-str(
  144. Rakudo::QuantHash.RAW-VALUES-MAP(self, *.gist)
  145. )
  146. )
  147. ),
  148. ')'
  149. )
  150. }
  151. multi method perl(Setty:D $ : --> Str:D) {
  152. nqp::if(
  153. nqp::eqaddr(self,set()),
  154. 'set()',
  155. nqp::concat(
  156. nqp::concat(self.^name,'.new('),
  157. nqp::concat(
  158. nqp::join(",",Rakudo::QuantHash.RAW-VALUES-MAP(self, *.perl)),
  159. ')'
  160. )
  161. )
  162. )
  163. }
  164. proto method grab(|) {*}
  165. proto method grabpairs(|) {*}
  166. proto method pick(|) {*}
  167. multi method pick(Setty:D:) { self.roll }
  168. multi method pick(Setty:D: Callable:D $calculate) {
  169. self.pick( $calculate(self.elems) )
  170. }
  171. multi method pick(Setty:D: Whatever $) {
  172. self.pick(Inf)
  173. }
  174. multi method pick(Setty:D: $count) {
  175. Seq.new(class :: does Rakudo::QuantHash::Pairs {
  176. method pull-one() is raw {
  177. nqp::if(
  178. nqp::elems($!picked),
  179. nqp::atkey($!elems,nqp::pop_s($!picked)),
  180. IterationEnd
  181. )
  182. }
  183. }.new($!elems, $count))
  184. }
  185. proto method pickpairs(|) {*}
  186. multi method pickpairs(Setty:D:) { Pair.new(self.roll,True) }
  187. multi method pickpairs(Setty:D: Callable:D $calculate) {
  188. self.pickpairs( $calculate(self.elems) )
  189. }
  190. multi method pickpairs(Setty:D: Whatever $) {
  191. self.pickpairs(Inf)
  192. }
  193. multi method pickpairs(Setty:D: $count) {
  194. Seq.new(class :: does Rakudo::QuantHash::Pairs {
  195. method pull-one() is raw {
  196. nqp::if(
  197. nqp::elems($!picked),
  198. Pair.new(nqp::atkey($!elems,nqp::pop_s($!picked)),True),
  199. IterationEnd
  200. )
  201. }
  202. }.new($!elems, $count))
  203. }
  204. proto method roll(|) {*}
  205. multi method roll(Setty:D:) {
  206. nqp::if(
  207. $!elems,
  208. nqp::iterval(Rakudo::QuantHash.ROLL($!elems)),
  209. Nil
  210. )
  211. }
  212. multi method roll(Setty:D: Callable:D $calculate) {
  213. self.roll($calculate(self.elems))
  214. }
  215. multi method roll(Setty:D: Whatever) {
  216. self.roll(Inf)
  217. }
  218. multi method roll(Setty:D: $count) {
  219. Seq.new(nqp::if(
  220. (my $todo = Rakudo::QuantHash.TODO($count))
  221. && $!elems
  222. && (my int $elems = nqp::elems($!elems)),
  223. nqp::stmts(
  224. (my $keys := Rakudo::QuantHash.RAW-KEYS(self)),
  225. nqp::if(
  226. $todo == Inf,
  227. Rakudo::Iterator.Callable(
  228. { nqp::atkey($!elems,nqp::atpos_s($keys,nqp::rand_n($elems))) },
  229. True
  230. ),
  231. Rakudo::Iterator.Callable( {
  232. nqp::if(
  233. $todo,
  234. nqp::stmts(
  235. --$todo,
  236. nqp::atkey(
  237. $!elems,
  238. nqp::atpos_s($keys,nqp::rand_n($elems))
  239. )
  240. ),
  241. IterationEnd
  242. )
  243. } )
  244. )
  245. ),
  246. Rakudo::Iterator.Empty
  247. ))
  248. }
  249. multi method EXISTS-KEY(Setty:D: \k --> Bool:D) {
  250. nqp::p6bool($!elems && nqp::existskey($!elems,k.WHICH))
  251. }
  252. multi method Bag(Setty:D:) {
  253. nqp::if(
  254. $!elems && nqp::elems($!elems),
  255. nqp::create(Bag).SET-SELF(Rakudo::QuantHash.SET-BAGGIFY($!elems)),
  256. bag()
  257. )
  258. }
  259. multi method BagHash(Setty:D:) {
  260. nqp::if(
  261. $!elems && nqp::elems($!elems),
  262. nqp::create(BagHash).SET-SELF(Rakudo::QuantHash.SET-BAGGIFY($!elems)),
  263. nqp::create(BagHash)
  264. )
  265. }
  266. multi method Mix(Setty:D:) {
  267. nqp::if(
  268. $!elems && nqp::elems($!elems),
  269. nqp::create(Mix).SET-SELF(Rakudo::QuantHash.SET-BAGGIFY($!elems)),
  270. mix()
  271. )
  272. }
  273. multi method MixHash(Setty:D:) {
  274. nqp::if(
  275. $!elems && nqp::elems($!elems),
  276. nqp::create(MixHash).SET-SELF(Rakudo::QuantHash.SET-BAGGIFY($!elems)),
  277. nqp::create(MixHash)
  278. )
  279. }
  280. method RAW-HASH() is raw { $!elems }
  281. # TODO: WHICH will require the capability for >1 pointer in ObjAt
  282. }
  283. multi sub infix:<eqv>(Setty:D \a, Setty:D \b --> Bool:D) {
  284. nqp::p6bool(
  285. nqp::eqaddr(a,b) || (nqp::eqaddr(a.WHAT,b.WHAT) && a.ACCEPTS(b))
  286. )
  287. }