1. my class Match is Capture is Cool {
  2. has $.orig;
  3. has int $.from;
  4. has int $.to;
  5. has $.CURSOR;
  6. has $.made;
  7. # new/!SET-SELF here only for performance reasons
  8. method !SET-SELF($!orig,$from,$to,$!CURSOR,$!made) {
  9. $!from = $from // 0; # cannot assign to int in sig
  10. $!to = $to // 0; # cannot assign to int in sig
  11. self;
  12. }
  13. method new(:$orig,:$from,:$to,:$CURSOR,:$made) {
  14. nqp::create(self)!SET-SELF($orig,$from,$to,$CURSOR,$made);
  15. }
  16. multi method WHICH (Match:D:) {
  17. self.Mu::WHICH # skip Capture's as Match is not a value type
  18. }
  19. method ast(Match:D:) { $!made }
  20. multi method Str(Match:D:) {
  21. nqp::if(
  22. nqp::isgt_i($!to,$!from),
  23. nqp::substr($!CURSOR.target,$!from,nqp::sub_i($!to,$!from)),
  24. ''
  25. )
  26. }
  27. multi method Numeric(Match:D:) {
  28. self.Str.Numeric
  29. }
  30. multi method Bool(Match:D:) {
  31. nqp::p6bool(nqp::isge_i($!to,$!from))
  32. }
  33. multi method ACCEPTS(Match:D: Any $) { self }
  34. method prematch(Match:D:) {
  35. nqp::substr($!CURSOR.target,0,$!from)
  36. }
  37. method postmatch(Match:D:) {
  38. nqp::substr($!CURSOR.target,$!to)
  39. }
  40. method caps(Match:D:) {
  41. my @caps;
  42. for self.pairs -> $p {
  43. if nqp::istype($p.value,Array) {
  44. @caps.push: $p.key => $_ for $p.value.list
  45. } elsif $p.value.DEFINITE {
  46. @caps.push: $p
  47. }
  48. }
  49. @caps.sort: -> $a { $a.value.from +< 32 + $a.value.to }
  50. }
  51. method chunks(Match:D:) {
  52. my $prev = $!from;
  53. gather {
  54. for self.caps {
  55. if .value.from > $prev {
  56. take '~' => substr($!orig,$prev, .value.from - $prev)
  57. }
  58. take $_;
  59. $prev = .value.to;
  60. }
  61. take '~' => substr($!orig,$prev, $!to - $prev) if $prev < $!to;
  62. }
  63. }
  64. multi method perl(Match:D:) {
  65. my %attrs;
  66. %attrs.ASSIGN-KEY("orig", self.orig.perl);
  67. %attrs.ASSIGN-KEY("from", self.from.perl);
  68. %attrs.ASSIGN-KEY("to", self.to.perl );
  69. %attrs.ASSIGN-KEY("ast", self.ast.perl );
  70. %attrs.ASSIGN-KEY("list", self.list.perl);
  71. %attrs.ASSIGN-KEY("hash", self.hash.perl);
  72. 'Match.new('
  73. ~ %attrs.fmt('%s => %s', ', ')
  74. ~ ')'
  75. }
  76. multi method gist (Match:D: $d = 0) {
  77. return "#<failed match>" unless self;
  78. my $s = ' ' x ($d + 1);
  79. my $r = ("=> " if $d) ~ "\x[FF62]{self}\x[FF63]\n";
  80. for @.caps {
  81. $r ~= $s ~ (.key // '?') ~ ' ' ~ .value.gist($d + 1)
  82. }
  83. $d == 0 ?? $r.chomp !! $r;
  84. }
  85. method make(Match:D: Mu \made) {
  86. $!made := made;
  87. nqp::bindattr(
  88. nqp::decont(self.CURSOR),
  89. Cursor,
  90. '$!made',
  91. made
  92. );
  93. }
  94. }
  95. multi sub infix:<eqv>(Match:D $a, Match:D $b) {
  96. $a =:= $b
  97. ||
  98. [&&] (
  99. $a.to eqv $b.to,
  100. $a.from eqv $b.from,
  101. $a.orig eqv $b.orig,
  102. $a.made eqv $b.made,
  103. $a.list eqv $b.list,
  104. $a.hash eqv $b.hash
  105. );
  106. }
  107. sub make(Mu \made) {
  108. my $slash := nqp::getlexcaller('$/');
  109. nqp::bindattr( nqp::decont($slash), Match, '$!made', made );
  110. nqp::bindattr( nqp::decont($slash.CURSOR), Cursor, '$!made', made );
  111. }