1. my class Pair does Associative {
  2. has $.key is default(Nil);
  3. has $.value is rw is default(Nil);
  4. has Mu $!WHICH;
  5. proto method new(|) {*}
  6. # This candidate is needed because it currently JITS better
  7. multi method new(Pair: Cool:D \key, Mu \value) {
  8. my \p := nqp::p6bindattrinvres(
  9. nqp::create(self),Pair,'$!key',nqp::decont(key));
  10. nqp::bindattr(p,Pair,'$!value',value);
  11. p
  12. }
  13. multi method new(Pair: Mu \key, Mu \value) {
  14. my \p := nqp::p6bindattrinvres(
  15. nqp::create(self),Pair,'$!key',nqp::decont(key));
  16. nqp::bindattr(p,Pair,'$!value',value);
  17. p
  18. }
  19. multi method new(Pair: Mu :$key!, Mu :$value!) {
  20. my \p := nqp::p6bindattrinvres(
  21. nqp::create(self),Pair,'$!key',$key);
  22. nqp::bindattr(p,Pair,'$!value',$value);
  23. p
  24. }
  25. multi method clone(Pair:D:) {
  26. nqp::p6bindattrinvres(self.Mu::clone, Pair, '$!WHICH', nqp::null)
  27. }
  28. multi method WHICH(Pair:D:) {
  29. nqp::unless(
  30. $!WHICH,
  31. ($!WHICH := nqp::if(
  32. nqp::iscont($!value)
  33. || nqp::not_i(nqp::istype((my $VALUE := $!value.WHICH),ValueObjAt)),
  34. self.Mu::WHICH,
  35. nqp::box_s(
  36. nqp::concat(
  37. nqp::if(
  38. nqp::eqaddr(self.WHAT,Pair),
  39. 'Pair|',
  40. nqp::concat(self.^name,'|')
  41. ),
  42. nqp::sha1(nqp::concat(nqp::concat($!key.WHICH,"\0"),$VALUE))
  43. ),
  44. ValueObjAt
  45. )
  46. ))
  47. )
  48. }
  49. multi method ACCEPTS(Pair:D: %h) {
  50. $!value.ACCEPTS(%h.AT-KEY($!key));
  51. }
  52. multi method ACCEPTS(Pair:D: Pair:D $p) {
  53. $!value.ACCEPTS(nqp::getattr(nqp::decont($p),Pair,'$!value'));
  54. }
  55. multi method ACCEPTS(Pair:D: Mu $other) {
  56. $other."$!key"().Bool === $!value.Bool
  57. }
  58. method Pair() { self }
  59. method antipair(Pair:D:) { self.new($!value,$!key) }
  60. method freeze(Pair:D:) { $!value := nqp::decont($!value) }
  61. method iterator(Pair:D:) {
  62. Rakudo::Iterator.OneValue(self)
  63. }
  64. multi method keys(Pair:D:) {
  65. Seq.new(Rakudo::Iterator.OneValue($!key))
  66. }
  67. multi method kv(Pair:D:) {
  68. Seq.new(Rakudo::Iterator.TwoValues($!key,$!value))
  69. }
  70. multi method values(Pair:D:) {
  71. Seq.new(Rakudo::Iterator.OneValue($!value))
  72. }
  73. multi method pairs(Pair:D:) {
  74. Seq.new(Rakudo::Iterator.OneValue(self))
  75. }
  76. multi method antipairs(Pair:D:) {
  77. Seq.new(Rakudo::Iterator.OneValue(self.new($!value,$!key)))
  78. }
  79. multi method invert(Pair:D:) {
  80. Seq.new(Rakudo::Iterator.Invert(self.iterator))
  81. }
  82. multi method Str(Pair:D:) { $!key ~ "\t" ~ $!value }
  83. multi method gist(Pair:D:) {
  84. self.gistseen('Pair', {
  85. nqp::istype($!key, Pair)
  86. ?? '(' ~ $!key.gist ~ ') => ' ~ $!value.gist
  87. !! $!key.gist ~ ' => ' ~ $!value.gist;
  88. })
  89. }
  90. multi method perl(Pair:D: :$arglist) {
  91. self.perlseen('Pair', -> :$arglist {
  92. nqp::istype($!key, Str) && nqp::isconcrete($!key)
  93. ?? !$arglist && $!key ~~ /^ [<alpha>\w*] +% <[\-']> $/
  94. ?? nqp::istype($!value,Bool) && nqp::isconcrete($!value)
  95. ?? ':' ~ '!' x !$!value ~ $!key
  96. !! ':' ~ $!key ~ '(' ~ $!value.perl ~ ')'
  97. !! $!key.perl ~ ' => ' ~ $!value.perl
  98. !! nqp::istype($!key, Numeric)
  99. && nqp::isconcrete($!key)
  100. && !(nqp::istype($!key,Num) && nqp::isnanorinf($!key))
  101. ?? $!key.perl ~ ' => ' ~ $!value.perl
  102. !! '(' ~ $!key.perl ~ ') => ' ~ $!value.perl
  103. }, :$arglist)
  104. }
  105. method fmt($format = "%s\t%s") {
  106. sprintf($format, $!key, $!value);
  107. }
  108. multi method AT-KEY(Pair:D: $key) { $key eq $!key ?? $!value !! Nil }
  109. multi method EXISTS-KEY(Pair:D: $key) { $key eq $!key }
  110. method FLATTENABLE_LIST() { nqp::list() }
  111. method FLATTENABLE_HASH() { nqp::hash($!key.Str, $!value) }
  112. }
  113. multi sub infix:<eqv>(Pair:D \a, Pair:D \b) {
  114. nqp::p6bool(
  115. nqp::eqaddr(a,b)
  116. || (nqp::eqaddr(a.WHAT,b.WHAT)
  117. && a.key eqv b.key
  118. && a.value eqv b.value)
  119. )
  120. }
  121. multi sub infix:<cmp>(Pair:D \a, Pair:D \b) {
  122. (a.key cmp b.key) || (a.value cmp b.value)
  123. }
  124. proto sub infix:«=>»(|) is pure {*}
  125. multi sub infix:«=>»(Mu $key, Mu \value) { Pair.new($key, value) }
  126. proto sub pair(|) is pure {*}
  127. multi sub pair(Mu $key, \value) { Pair.new($key, value) }