1. my class X::Routine::Unwrap { ... }
  2. my role HardRoutine {
  3. method soft(--> False) { }
  4. }
  5. my role SoftRoutine {
  6. method soft(--> True) { }
  7. }
  8. my class Routine { # declared in BOOTSTRAP
  9. # class Routine is Block
  10. # has @!dispatchees;
  11. # has Mu $!dispatcher_cache;
  12. # has Mu $!dispatcher;
  13. # has int $!rw;
  14. # has Mu $!inline_info;
  15. # has int $!yada;
  16. # has Mu $!package;
  17. # has int $!onlystar;
  18. # has @!dispatch_order;
  19. # has Mu $!dispatch_cache;
  20. method onlystar() { nqp::p6bool($!onlystar) }
  21. method candidates() {
  22. self.is_dispatcher ??
  23. nqp::hllize(@!dispatchees) !!
  24. (self,)
  25. }
  26. method cando(Capture $c) {
  27. my $disp;
  28. if self.is_dispatcher {
  29. $disp := self;
  30. }
  31. else {
  32. $disp := nqp::create(self);
  33. nqp::bindattr($disp, Routine, '@!dispatchees', nqp::list(self));
  34. }
  35. # Call this lexical sub to get rid of 'self' in the signature.
  36. sub checker(|) {
  37. nqp::hllize($disp.find_best_dispatchee(nqp::usecapture(), 1))
  38. }
  39. checker(|$c);
  40. }
  41. method multi() {
  42. self.dispatcher.defined
  43. }
  44. multi method perl(Routine:D:) {
  45. my $perl = ( self.^name ~~ m/^\w+/ ).lc;
  46. if self.name() -> $n {
  47. $perl ~= " $n";
  48. }
  49. $perl ~= ' ' ~ substr(self.signature().perl,1); # lose colon prefix
  50. $perl ~= ' { #`(' ~ self.WHICH ~ ') ... }';
  51. $perl
  52. }
  53. method soft( --> Nil ) { }
  54. method wrap(&wrapper) {
  55. my class WrapHandle {
  56. has $!dispatcher;
  57. has $!wrapper;
  58. method restore() {
  59. nqp::p6bool($!dispatcher.remove($!wrapper));
  60. }
  61. }
  62. my role Wrapped {
  63. has $!dispatcher;
  64. method UNSHIFT_WRAPPER(&wrapper) {
  65. # Add candidate.
  66. $!dispatcher := WrapDispatcher.new()
  67. unless nqp::isconcrete($!dispatcher);
  68. $!dispatcher.add(&wrapper);
  69. # Return a handle.
  70. my $handle := nqp::create(WrapHandle);
  71. nqp::bindattr($handle, WrapHandle, '$!dispatcher', $!dispatcher);
  72. nqp::bindattr($handle, WrapHandle, '$!wrapper', &wrapper);
  73. $handle
  74. }
  75. method CALL-ME(|c) is raw {
  76. $!dispatcher.enter(|c);
  77. }
  78. method soft(--> True) { }
  79. }
  80. # We can't wrap a hardened routine (that is, one that's been
  81. # marked inlinable).
  82. if nqp::istype(self, HardRoutine) {
  83. die "Cannot wrap a HardRoutine, since it may have been inlined; " ~
  84. "use the 'soft' pragma to avoid marking routines as hard.";
  85. }
  86. # If we're not wrapped already, do the initial dispatcher
  87. # creation.
  88. unless nqp::istype(self, Wrapped) {
  89. my $orig = self.clone();
  90. self does Wrapped;
  91. self.UNSHIFT_WRAPPER($orig);
  92. }
  93. # Add this wrapper.
  94. self.UNSHIFT_WRAPPER(&wrapper);
  95. }
  96. method unwrap($handle) {
  97. $handle.can('restore') && $handle.restore() ||
  98. X::Routine::Unwrap.new.throw
  99. }
  100. method yada() {
  101. nqp::p6bool(nqp::getattr_i(self, Routine, '$!yada'))
  102. }
  103. method package() { $!package }
  104. method leave(*@) {
  105. X::NYI.new(:feature("{self.^name}.leave()")).throw;
  106. }
  107. }