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