1. # for errors
  2. my class X::Inheritance::Unsupported { ... }
  3. my class X::Inheritance::UnknownParent { ... }
  4. my class X::Export::NameClash { ... }
  5. my class X::Composition::NotComposable { ... }
  6. my class X::Import::MissingSymbols { ... }
  7. my class X::Redeclaration { ... }
  8. my class X::Inheritance::SelfInherit { ... }
  9. my class X::Comp::Trait::Unknown { ... }
  10. my class X::Experimental { ... }
  11. my class Pod::Block::Declarator { ... }
  12. proto sub trait_mod:<is>(|) {*}
  13. multi sub trait_mod:<is>(Mu:U $child, Mu:U $parent) {
  14. if $parent.HOW.archetypes.inheritable() {
  15. $child.^add_parent($parent);
  16. }
  17. elsif $parent.HOW.archetypes.inheritalizable() {
  18. if my @required-methods = $parent.^methods.grep({$_.yada}) {
  19. my $type = $child.HOW.archetypes.inheritable()
  20. ?? 'Class '
  21. !! $child.HOW.archetypes.inheritalizable()
  22. ?? 'Role '
  23. !! '';
  24. die $type ~ "{$child.^name} can't pun role {$parent.^name} because it has required methods: "
  25. ~ @required-methods.map({$_.name}).join(', ') ~ '. Did you mean to use "does" instead?';
  26. }
  27. else {
  28. $child.^add_parent($parent.^inheritalize)
  29. }
  30. }
  31. else {
  32. X::Inheritance::Unsupported.new(
  33. :child-typename($child.^name),
  34. :$parent,
  35. ).throw;
  36. }
  37. }
  38. multi sub trait_mod:<is>(Mu:U $child, :$DEPRECATED!) {
  39. # add COMPOSE phaser for this child, which will add an ENTER phaser to an
  40. # existing "new" method, or create a "new" method with a call to DEPRECATED
  41. # and a nextsame.
  42. }
  43. multi sub trait_mod:<is>(Mu:U $type, :$rw!) {
  44. $type.^set_rw;
  45. }
  46. multi sub trait_mod:<is>(Mu:U $type, :$nativesize!) {
  47. $type.^set_nativesize($nativesize);
  48. }
  49. multi sub trait_mod:<is>(Mu:U $type, :$ctype!) {
  50. $type.^set_ctype($ctype);
  51. }
  52. multi sub trait_mod:<is>(Mu:U $type, :$unsigned!) {
  53. $type.^set_unsigned($unsigned);
  54. }
  55. multi sub trait_mod:<is>(Mu:U $type, :$hidden!) {
  56. $type.^set_hidden;
  57. }
  58. multi sub trait_mod:<is>(Mu:U $type, Mu :$array_type!) {
  59. $type.^set_array_type($array_type);
  60. }
  61. multi sub trait_mod:<is>(Mu:U $type, *%fail) {
  62. if %fail.keys[0] !eq $type.^name {
  63. X::Inheritance::UnknownParent.new(
  64. :child($type.^name),
  65. :parent(%fail.keys[0]),
  66. :suggestions([])
  67. ).throw;
  68. } else {
  69. X::Inheritance::SelfInherit.new(
  70. :name(%fail.keys[0])
  71. ).throw;
  72. }
  73. }
  74. multi sub trait_mod:<is>(Attribute:D $attr, |c ) {
  75. X::Comp::Trait::Unknown.new(
  76. file => $?FILE,
  77. line => $?LINE,
  78. type => 'is',
  79. subtype => c.hash.keys[0],
  80. declaring => 'n attribute',
  81. highexpect => <rw readonly box_target leading_docs trailing_docs>,
  82. ).throw;
  83. }
  84. multi sub trait_mod:<is>(Attribute:D $attr, :$rw!) {
  85. $attr.set_rw();
  86. warn "useless use of 'is rw' on $attr.name()" unless $attr.has_accessor;
  87. }
  88. multi sub trait_mod:<is>(Attribute:D $attr, :$readonly!) {
  89. $attr.set_readonly();
  90. warn "useless use of 'is readonly' on $attr.name()" unless $attr.has_accessor;
  91. }
  92. multi sub trait_mod:<is>(Attribute $attr, :$required!) {
  93. die "'is required' must be Cool" unless nqp::istype($required,Cool);
  94. $attr.set_required(
  95. nqp::istype($required,Bool) ?? +$required !! $required
  96. );
  97. }
  98. multi sub trait_mod:<is>(Attribute $attr, Mu :$default!) {
  99. $attr.container_descriptor.set_default(nqp::decont($default));
  100. $attr.container = nqp::decont($default) if nqp::iscont($attr.container);
  101. }
  102. multi sub trait_mod:<is>(Attribute:D $attr, :$box_target!) {
  103. $attr.set_box_target();
  104. }
  105. multi sub trait_mod:<is>(Attribute:D $attr, :$DEPRECATED!) {
  106. # need to add a COMPOSE phaser to the class, that will add an ENTER phaser
  107. # to the (possibly auto-generated) accessor method.
  108. }
  109. multi sub trait_mod:<is>(Attribute:D $attr, :$leading_docs!) {
  110. Rakudo::Internals.SET_LEADING_DOCS($attr, $leading_docs);
  111. }
  112. multi sub trait_mod:<is>(Attribute:D $attr, :$trailing_docs!) {
  113. Rakudo::Internals.SET_TRAILING_DOCS($attr, $trailing_docs);
  114. }
  115. multi sub trait_mod:<is>(Routine:D $r, |c ) {
  116. my $subtype = c.hash.keys[0];
  117. $subtype eq 'cached'
  118. ?? X::Experimental.new(
  119. feature => "the 'is cached' trait",
  120. use => "cached",
  121. ).throw
  122. !! X::Comp::Trait::Unknown.new(
  123. file => $?FILE,
  124. line => $?LINE,
  125. type => 'is',
  126. subtype => $subtype,
  127. declaring => ' ' ~ lc( $r.^name ),
  128. highexpect => ('rw raw hidden-from-backtrace hidden-from-USAGE',
  129. 'pure default DEPRECATED inlinable nodal',
  130. 'prec equiv tighter looser assoc leading_docs trailing_docs' ),
  131. ).throw;
  132. }
  133. multi sub trait_mod:<is>(Routine:D $r, :$rw!) {
  134. $r.set_rw();
  135. }
  136. multi sub trait_mod:<is>(Routine:D $r, :$raw!) {
  137. $r.set_rw(); # for now, until we have real raw handling
  138. }
  139. multi sub trait_mod:<is>(Routine:D $r, :$default!) {
  140. $r.^mixin: role { method default(--> True) { } }
  141. }
  142. multi sub trait_mod:<is>(Routine:D $r, :$DEPRECATED!) {
  143. my $new := nqp::istype($DEPRECATED,Bool)
  144. ?? "something else"
  145. !! $DEPRECATED;
  146. $r.add_phaser( 'ENTER', -> { DEPRECATED($new) } );
  147. }
  148. multi sub trait_mod:<is>(Routine:D $r, Mu :$inlinable!) {
  149. $r.set_inline_info(nqp::decont($inlinable));
  150. }
  151. multi sub trait_mod:<is>(Routine:D $r, :$onlystar!) {
  152. $r.set_onlystar();
  153. }
  154. multi sub trait_mod:<is>(Routine:D $r, :prec(%spec)!) {
  155. my role Precedence {
  156. has %!prec;
  157. proto method prec(|) {*}
  158. multi method prec() is raw { %!prec }
  159. multi method prec(Str:D $key) {
  160. nqp::ifnull(
  161. nqp::atkey(nqp::getattr(%!prec,Map,'$!storage'),$key),
  162. ''
  163. )
  164. }
  165. }
  166. if nqp::istype($r, Precedence) {
  167. for %spec {
  168. $r.prec.{.key} := .value;
  169. }
  170. }
  171. else {
  172. $r.^mixin(Precedence);
  173. nqp::bindattr(nqp::decont($r), $r.WHAT, '%!prec', %spec);
  174. }
  175. 0;
  176. }
  177. # three other trait_mod sub for equiv/tighter/looser in operators.pm6
  178. multi sub trait_mod:<is>(Routine $r, :&equiv!) {
  179. nqp::can(&equiv, 'prec')
  180. ?? trait_mod:<is>($r, :prec(&equiv.prec))
  181. !! die "Routine given to equiv does not appear to be an operator";
  182. $r.prec<assoc>:delete;
  183. }
  184. multi sub trait_mod:<is>(Routine $r, :&tighter!) {
  185. die "Routine given to tighter does not appear to be an operator"
  186. unless nqp::can(&tighter, 'prec');
  187. if !nqp::can($r, 'prec') || ($r.prec<prec> // "") !~~ /<[@:]>/ {
  188. trait_mod:<is>($r, :prec(&tighter.prec))
  189. }
  190. $r.prec<prec> && ($r.prec<prec> := $r.prec<prec>.subst: '=', '@=');
  191. $r.prec<assoc>:delete;
  192. }
  193. multi sub trait_mod:<is>(Routine $r, :&looser!) {
  194. die "Routine given to looser does not appear to be an operator"
  195. unless nqp::can(&looser, 'prec');
  196. if !nqp::can($r, 'prec') || ($r.prec<prec> // "") !~~ /<[@:]>/ {
  197. trait_mod:<is>($r, :prec(&looser.prec))
  198. }
  199. $r.prec<prec> && ($r.prec<prec> := $r.prec<prec>.subst: '=', ':=');
  200. $r.prec<assoc>:delete;
  201. }
  202. multi sub trait_mod:<is>(Routine $r, :$assoc!) {
  203. trait_mod:<is>($r, :prec({ :$assoc }))
  204. }
  205. # Since trait_mod:<is> to set onlystar isn't there at the
  206. # point we wrote its proto, we do it manually here.
  207. BEGIN &trait_mod:<is>.set_onlystar();
  208. multi sub trait_mod:<is>(Parameter:D $param, |c ) {
  209. X::Comp::Trait::Unknown.new(
  210. file => $?FILE,
  211. line => $?LINE,
  212. type => 'is',
  213. subtype => c.hash.keys[0],
  214. declaring => ' parameter',
  215. highexpect => <rw readonly copy required raw leading_docs trailing_docs>,
  216. ).throw;
  217. }
  218. multi sub trait_mod:<is>(Parameter:D $param, :$readonly!) {
  219. # This is the default.
  220. }
  221. multi sub trait_mod:<is>(Parameter:D $param, :$rw!) {
  222. $param.set_rw();
  223. }
  224. multi sub trait_mod:<is>(Parameter:D $param, :$copy!) {
  225. $param.set_copy();
  226. }
  227. multi sub trait_mod:<is>(Parameter:D $param, :$required!) {
  228. $param.set_required();
  229. }
  230. multi sub trait_mod:<is>(Parameter:D $param, :$raw!) {
  231. $param.set_raw();
  232. }
  233. multi sub trait_mod:<is>(Parameter:D $param, :$onearg!) {
  234. $param.set_onearg();
  235. }
  236. multi sub trait_mod:<is>(Parameter:D $param, :$leading_docs!) {
  237. Rakudo::Internals.SET_LEADING_DOCS($param, $leading_docs);
  238. }
  239. multi sub trait_mod:<is>(Parameter:D $param, :$trailing_docs!) {
  240. Rakudo::Internals.SET_TRAILING_DOCS($param, $trailing_docs);
  241. }
  242. # Declare these, as setting mainline doesn't get them automatically (as the
  243. # Mu/Any/Scalar are not loaded).
  244. my $!;
  245. my $/;
  246. my $_;
  247. multi sub trait_mod:<is>(Routine:D \r, :$export!, :$SYMBOL = '&' ~ r.name) {
  248. my $to_export := r.multi ?? r.dispatcher !! r;
  249. my @tags = flat 'ALL', (
  250. nqp::istype($export,Pair)
  251. ?? $export.key()
  252. !! nqp::istype($export,Positional)
  253. ?? @($export)>>.key
  254. !! nqp::istype($export,Bool) && $export
  255. ?? 'DEFAULT'
  256. !! die "Invalid value '$export.gist()' of type "
  257. ~ "'$export.^name()' in trait 'is export'. Use a Pair "
  258. ~ 'or a list of Pairs, with keys as tag names.'
  259. );
  260. Rakudo::Internals.EXPORT_SYMBOL(nqp::decont($SYMBOL), @tags, $to_export);
  261. }
  262. multi sub trait_mod:<is>(Mu:U \type, :$export!) {
  263. my $exp_name := type.^shortname;
  264. my @tags = flat 'ALL', (
  265. nqp::istype($export,Pair)
  266. ?? $export.key()
  267. !! nqp::istype($export,Positional)
  268. ?? @($export)>>.key
  269. !! nqp::istype($export,Bool) && $export
  270. ?? 'DEFAULT'
  271. !! die "Invalid value '$export.gist()' of type "
  272. ~ "'$export.^name()' in trait 'is export'. Use a Pair "
  273. ~ 'or a list of Pairs, with keys as tag names.'
  274. );
  275. Rakudo::Internals.EXPORT_SYMBOL($exp_name, @tags, type);
  276. if nqp::istype(type.HOW, Metamodel::EnumHOW) {
  277. type.^set_export_callback( {
  278. for type.^enum_values.keys -> $value_name {
  279. Rakudo::Internals.EXPORT_SYMBOL(
  280. $value_name, @tags, type.WHO{$value_name});
  281. }
  282. });
  283. }
  284. }
  285. # for constants
  286. multi sub trait_mod:<is>(Mu \sym, :$export!, :$SYMBOL!) {
  287. my @tags = flat 'ALL', (
  288. nqp::istype($export,Pair)
  289. ?? $export.key()
  290. !! nqp::istype($export,Positional)
  291. ?? @($export)>>.key
  292. !! nqp::istype($export,Bool) && $export
  293. ?? 'DEFAULT'
  294. !! die "Invalid value '$export.gist()' of type "
  295. ~ "'$export.^name()' in trait 'is export'. Use a Pair "
  296. ~ 'or a list of Pairs, with keys as tag names.'
  297. );
  298. Rakudo::Internals.EXPORT_SYMBOL($SYMBOL, @tags, sym);
  299. }
  300. multi sub trait_mod:<is>(Block:D $r, :$leading_docs!) {
  301. Rakudo::Internals.SET_LEADING_DOCS($r, $leading_docs);
  302. }
  303. multi sub trait_mod:<is>(Block:D $r, :$trailing_docs!) {
  304. Rakudo::Internals.SET_TRAILING_DOCS($r, $trailing_docs);
  305. }
  306. # this should be identical to Mu:D, :leading_docs, otherwise the fallback Block:D, |c
  307. # will catch it and declare "leading_docs" to be an unknown trait. This is why
  308. # we need this redundant form in spite of having a Block:D candidate above
  309. multi sub trait_mod:<is>(Routine:D $r, :$leading_docs!) {
  310. Rakudo::Internals.SET_LEADING_DOCS($r, $leading_docs);
  311. }
  312. multi sub trait_mod:<is>(Routine:D $r, :$trailing_docs!) {
  313. Rakudo::Internals.SET_TRAILING_DOCS($r, $trailing_docs);
  314. }
  315. multi sub trait_mod:<is>(Mu:U $docee, :$leading_docs!) {
  316. Rakudo::Internals.SET_LEADING_DOCS($docee, $leading_docs);
  317. }
  318. multi sub trait_mod:<is>(Mu:U $docee, :$trailing_docs!) {
  319. Rakudo::Internals.SET_TRAILING_DOCS($docee.HOW, $trailing_docs);
  320. }
  321. proto sub trait_mod:<does>(|) {*}
  322. multi sub trait_mod:<does>(Mu:U $doee, Mu:U $role) {
  323. if $role.HOW.archetypes.composable() {
  324. $doee.^add_role($role)
  325. }
  326. elsif $role.HOW.archetypes.composalizable() {
  327. $doee.^add_role($role.HOW.composalize($role))
  328. }
  329. else {
  330. X::Composition::NotComposable.new(
  331. target-name => $doee.^name,
  332. composer => $role,
  333. ).throw;
  334. }
  335. }
  336. proto sub trait_mod:<of>(|) {*}
  337. multi sub trait_mod:<of>(Mu:U $target, Mu:U $type) {
  338. # XXX Ensure we can do this, die if not.
  339. $target.^set_of($type);
  340. }
  341. multi sub trait_mod:<of>(Routine:D $target, Mu:U $type) {
  342. my $sig := $target.signature;
  343. X::Redeclaration.new(what => 'return type for', symbol => $target,
  344. postfix => " (previous return type was {$sig.returns.^name})").throw
  345. if $sig.has_returns;
  346. $sig.set_returns($type);
  347. $target.^mixin(Callable.^parameterize($type))
  348. }
  349. multi sub trait_mod:<is>(Routine:D $r, :$hidden-from-backtrace!) {
  350. $r.^mixin( role is-hidden-from-backtrace {
  351. method is-hidden-from-backtrace(--> True) { }
  352. }) if $hidden-from-backtrace;
  353. }
  354. multi sub trait_mod:<is>(Routine:D $r, :$hidden-from-USAGE!) {
  355. $r.^mixin( role is-hidden-from-USAGE {
  356. method is-hidden-from-USAGE(--> True) { }
  357. }) if $hidden-from-USAGE;
  358. }
  359. multi sub trait_mod:<is>(Routine:D $r, :$pure!) {
  360. $r.^mixin( role is-pure {
  361. method is-pure (--> True) { }
  362. }) if $pure;
  363. }
  364. multi sub trait_mod:<is>(Routine:D $r, :$nodal!) {
  365. $r.^mixin( role is-nodal {
  366. method nodal(--> True) { }
  367. }) if $nodal;
  368. }
  369. proto sub trait_mod:<returns>(|) {*}
  370. multi sub trait_mod:<returns>(Routine:D $target, Mu:U $type) {
  371. my $sig := $target.signature;
  372. X::Redeclaration.new(what => 'return type for', symbol => $target,
  373. postfix => " (previous return type was {$sig.returns.^name})").throw
  374. if $sig.has_returns;
  375. $sig.set_returns($type);
  376. $target.^mixin(Callable.^parameterize($type))
  377. }
  378. proto sub trait_mod:<handles>(|) {*}
  379. multi sub trait_mod:<handles>(Attribute:D $target, $thunk) {
  380. $target does role {
  381. has $.handles;
  382. method set_handles($expr) {
  383. $!handles := $expr;
  384. }
  385. method add_delegator_method($attr: $pkg, $meth_name, $call_name) {
  386. my $meth := method (|c) is rw {
  387. $attr.get_value(self)."$call_name"(|c)
  388. };
  389. $meth.set_name($meth_name);
  390. $pkg.^add_method($meth_name, $meth);
  391. }
  392. method apply_handles($attr: Mu $pkg) {
  393. sub applier($expr) {
  394. if $expr.defined() {
  395. if nqp::istype($expr,Str) {
  396. self.add_delegator_method($pkg, $expr, $expr);
  397. }
  398. elsif nqp::istype($expr,Pair) {
  399. self.add_delegator_method($pkg, $expr.key, $expr.value);
  400. }
  401. elsif nqp::istype($expr,Positional) {
  402. for $expr.list {
  403. applier($_);
  404. }
  405. 0;
  406. }
  407. elsif nqp::istype($expr, Whatever) {
  408. $pkg.^add_fallback(
  409. -> $obj, $name {
  410. so $attr.get_value($obj).can($name);
  411. },
  412. -> $obj, $name {
  413. -> $self, |c {
  414. $attr.get_value($self)."$name"(|c)
  415. }
  416. });
  417. }
  418. elsif nqp::istype($expr, HyperWhatever) {
  419. $pkg.^add_fallback(
  420. -> $obj, $name { True },
  421. -> $obj, $name {
  422. -> $self, |c {
  423. $attr.get_value($self)."$name"(|c)
  424. }
  425. });
  426. }
  427. else {
  428. $pkg.^add_fallback(
  429. -> $obj, $name {
  430. ?($name ~~ $expr)
  431. },
  432. -> $obj, $name {
  433. -> $self, |c {
  434. $attr.get_value($self)."$name"(|c)
  435. }
  436. });
  437. }
  438. }
  439. else {
  440. $pkg.^add_fallback(
  441. -> $obj, $name {
  442. ?$expr.can($name)
  443. },
  444. -> $obj, $name {
  445. -> $self, |c {
  446. $attr.get_value($self)."$name"(|c)
  447. }
  448. });
  449. }
  450. }
  451. applier($!handles);
  452. }
  453. };
  454. $target.set_handles($thunk());
  455. }
  456. multi sub trait_mod:<handles>(Method:D $m, &thunk) {
  457. my $pkg := $m.signature.params[0].type;
  458. my $call_name := $m.name;
  459. for flat thunk() -> $meth_name {
  460. my $meth := method (|c) is rw {
  461. self."$call_name"()."$meth_name"(|c);
  462. }
  463. $meth.set_name($meth_name);
  464. $pkg.^add_method($meth_name, $meth);
  465. }
  466. 0;
  467. }
  468. proto sub trait_mod:<will>(|) {*}
  469. multi sub trait_mod:<will>(Attribute:D $attr, |c ) {
  470. X::Comp::Trait::Unknown.new(
  471. file => $?FILE,
  472. line => $?LINE,
  473. type => 'will',
  474. subtype => c.hash.keys[0],
  475. declaring => 'n attribute',
  476. highexpect => <lazy>,
  477. ).throw;
  478. }
  479. multi sub trait_mod:<will>(Attribute $attr, Mu :$build!) { # internal usage
  480. $attr.set_build($build)
  481. }
  482. proto sub trait_mod:<trusts>(|) {*}
  483. multi sub trait_mod:<trusts>(Mu:U $truster, Mu:U $trustee) {
  484. $truster.^add_trustee($trustee);
  485. }
  486. proto sub trait_mod:<hides>(|) {*}
  487. multi sub trait_mod:<hides>(Mu:U $child, Mu:U $parent) {
  488. if $parent.HOW.archetypes.inheritable() {
  489. $child.^add_parent($parent, :hides);
  490. }
  491. elsif $parent.HOW.archetypes.inheritalizable() {
  492. $child.^add_parent($parent.^inheritalize, :hides)
  493. }
  494. else {
  495. X::Inheritance::Unsupported.new(
  496. :child-typename($child.^name),
  497. :$parent,
  498. ).throw;
  499. }
  500. }