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