1. my role Setty does QuantHash {
  2. has %!elems; # key.WHICH => key
  3. method !SET-SELF(%!elems) { self }
  4. multi method new(Setty: +@args --> Setty:D) {
  5. nqp::stmts(
  6. (my $elems := nqp::hash),
  7. (my $iter := @args.iterator),
  8. nqp::until(
  9. nqp::eqaddr((my $pulled := $iter.pull-one),IterationEnd),
  10. nqp::bindkey($elems,$pulled.WHICH,$pulled)
  11. ),
  12. nqp::create(self)!SET-SELF($elems)
  13. )
  14. }
  15. method new-from-pairs(*@pairs --> Setty:D) {
  16. nqp::stmts(
  17. (my $elems := nqp::hash),
  18. (my $iter := @pairs.iterator),
  19. nqp::until(
  20. nqp::eqaddr((my $pulled := $iter.pull-one),IterationEnd),
  21. nqp::if(
  22. nqp::istype($pulled,Pair),
  23. nqp::if(
  24. $pulled.value,
  25. nqp::bindkey($elems,$pulled.key.WHICH,$pulled.key)
  26. ),
  27. nqp::bindkey($elems,$pulled.WHICH,$pulled)
  28. )
  29. ),
  30. nqp::create(self)!SET-SELF($elems)
  31. )
  32. }
  33. method default(--> False) { }
  34. multi method keys(Setty:D:) {
  35. Seq.new(Rakudo::Iterator.Mappy-values(%!elems))
  36. }
  37. method elems(Setty:D: --> Int:D) { %!elems.elems }
  38. method total(Setty:D: --> Int:D) { %!elems.elems }
  39. multi method antipairs(Setty:D:) {
  40. Seq.new(class :: does Rakudo::Iterator::Mappy {
  41. method pull-one() {
  42. nqp::if(
  43. $!iter,
  44. Pair.new(True,nqp::iterval(nqp::shift($!iter))),
  45. IterationEnd
  46. )
  47. }
  48. }.new(%!elems))
  49. }
  50. multi method minpairs(Setty:D:) { self.pairs }
  51. multi method maxpairs(Setty:D:) { self.pairs }
  52. multi method Bool(Setty:D:) { %!elems.Bool }
  53. multi method hash(Setty:D: --> Hash:D) {
  54. my \e = Hash.^parameterize(Bool, Any).new;
  55. e{$_} = True for %!elems.values;
  56. e;
  57. }
  58. multi method ACCEPTS(Setty:U: $other) {
  59. $other.^does(self)
  60. }
  61. multi method ACCEPTS(Setty:D: Seq:D \seq) {
  62. self.ACCEPTS(seq.list)
  63. }
  64. multi method ACCEPTS(Setty:D: $other) {
  65. $other (<=) self && self (<=) $other
  66. }
  67. multi method Str(Setty:D $ : --> Str:D) { ~ %!elems.values }
  68. multi method gist(Setty:D $ : --> Str:D) {
  69. my $name := self.^name;
  70. ( $name eq 'Set' ?? 'set' !! "$name.new" )
  71. ~ '('
  72. ~ %!elems.values.map( {.gist} ).join(', ')
  73. ~ ')';
  74. }
  75. multi method perl(Setty:D $ : --> Str:D) {
  76. my $name := self.^name;
  77. ( $name eq 'Set' ?? 'set' !! "$name.new" )
  78. ~ '('
  79. ~ %!elems.values.map( {.perl} ).join(',')
  80. ~ ')';
  81. }
  82. proto method grab(|) { * }
  83. multi method grab(Setty:D:) {
  84. %!elems.DELETE-KEY(%!elems.keys.pick)
  85. }
  86. multi method grab(Setty:D: Callable:D $calculate) {
  87. self.grab($calculate(%!elems.elems))
  88. }
  89. multi method grab(Setty:D: $count) {
  90. (%!elems{ %!elems.keys.pick($count) }:delete).cache;
  91. }
  92. proto method grabpairs(|) { * }
  93. multi method grabpairs(Setty:D:) {
  94. Pair.new(%!elems.DELETE-KEY(%!elems.keys.pick),True)
  95. }
  96. multi method grabpairs(Setty:D: Callable:D $calculate) {
  97. self.grabpairs($calculate(%!elems.elems))
  98. }
  99. multi method grabpairs(Setty:D: $count) {
  100. (%!elems{ %!elems.keys.pick($count) }:delete).map( { ($_=>True) } );
  101. }
  102. proto method pick(|) { * }
  103. multi method pick(Setty:D:) { %!elems.values.pick() }
  104. multi method pick(Setty:D: Callable:D $calculate) {
  105. %!elems.values.pick($calculate(%!elems.elems))
  106. }
  107. multi method pick(Setty:D: $count) { %!elems.values.pick($count) }
  108. proto method roll(|) { * }
  109. multi method roll(Setty:D:) { %!elems.values.roll() }
  110. multi method roll(Setty:D: $count) { %!elems.values.roll($count) }
  111. multi method EXISTS-KEY(Setty:D: \k --> Bool:D) {
  112. nqp::p6bool(
  113. %!elems.elems && nqp::existskey(%!elems, nqp::unbox_s(k.WHICH))
  114. );
  115. }
  116. method Bag { Bag.new( %!elems.values ) }
  117. method BagHash { BagHash.new( %!elems.values ) }
  118. method Mix { Mix.new( %!elems.values ) }
  119. method MixHash { MixHash.new( %!elems.values ) }
  120. # TODO: WHICH will require the capability for >1 pointer in ObjAt
  121. }