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, :$default!) {
  99. $attr.container_descriptor.set_default(nqp::decont($default));
  100. }
  101. multi sub trait_mod:<is>(Attribute:D $attr, :$box_target!) {
  102. $attr.set_box_target();
  103. }
  104. multi sub trait_mod:<is>(Attribute:D $attr, :$DEPRECATED!) {
  105. # need to add a COMPOSE phaser to the class, that will add an ENTER phaser
  106. # to the (possibly auto-generated) accessor method.
  107. }
  108. multi sub trait_mod:<is>(Attribute:D $attr, :$leading_docs!) {
  109. Rakudo::Internals.SET_LEADING_DOCS($attr, $leading_docs);
  110. }
  111. multi sub trait_mod:<is>(Attribute:D $attr, :$trailing_docs!) {
  112. Rakudo::Internals.SET_TRAILING_DOCS($attr, $trailing_docs);
  113. }
  114. multi sub trait_mod:<is>(Routine:D $r, |c ) {
  115. my $subtype = c.hash.keys[0];
  116. $subtype eq 'cached'
  117. ?? X::Experimental.new(
  118. feature => "the 'is cached' trait",
  119. use => "cached",
  120. ).throw
  121. !! X::Comp::Trait::Unknown.new(
  122. file => $?FILE,
  123. line => $?LINE,
  124. type => 'is',
  125. subtype => $subtype,
  126. declaring => ' ' ~ lc( $r.^name ),
  127. highexpect => ('rw raw hidden-from-backtrace hidden-from-USAGE',
  128. 'pure default DEPRECATED inlinable nodal',
  129. 'prec equiv tighter looser assoc leading_docs trailing_docs' ),
  130. ).throw;
  131. }
  132. multi sub trait_mod:<is>(Routine:D $r, :$rw!) {
  133. $r.set_rw();
  134. }
  135. multi sub trait_mod:<is>(Routine:D $r, :$raw!) {
  136. $r.set_rw(); # for now, until we have real raw handling
  137. }
  138. multi sub trait_mod:<is>(Routine:D $r, :$default!) {
  139. $r does role { method default(--> True) { } }
  140. }
  141. multi sub trait_mod:<is>(Routine:D $r, :$DEPRECATED!) {
  142. my $new := nqp::istype($DEPRECATED,Bool)
  143. ?? "something else"
  144. !! $DEPRECATED;
  145. $r.add_phaser( 'ENTER', -> { DEPRECATED($new) } );
  146. }
  147. multi sub trait_mod:<is>(Routine:D $r, Mu :$inlinable!) {
  148. $r.set_inline_info(nqp::decont($inlinable));
  149. }
  150. multi sub trait_mod:<is>(Routine:D $r, :$onlystar!) {
  151. $r.set_onlystar();
  152. }
  153. multi sub trait_mod:<is>(Routine:D $r, :prec(%spec)!) {
  154. my role Precedence {
  155. has %!prec;
  156. proto method prec(|) { * }
  157. multi method prec() is raw { %!prec }
  158. multi method prec(Str:D $key) {
  159. nqp::ifnull(
  160. nqp::atkey(nqp::getattr(%!prec,Map,'$!storage'),$key),
  161. ''
  162. )
  163. }
  164. }
  165. if nqp::istype($r, Precedence) {
  166. for %spec {
  167. $r.prec.{.key} := .value;
  168. }
  169. }
  170. else {
  171. $r.^mixin(Precedence);
  172. nqp::bindattr(nqp::decont($r), $r.WHAT, '%!prec', %spec);
  173. }
  174. 0;
  175. }
  176. # three other trait_mod sub for equiv/tighter/looser in operators.pm
  177. multi sub trait_mod:<is>(Routine $r, :&equiv!) {
  178. nqp::can(&equiv, 'prec')
  179. ?? trait_mod:<is>($r, :prec(&equiv.prec))
  180. !! die "Routine given to equiv does not appear to be an operator";
  181. $r.prec<assoc>:delete;
  182. }
  183. multi sub trait_mod:<is>(Routine $r, :&tighter!) {
  184. die "Routine given to tighter does not appear to be an operator"
  185. unless nqp::can(&tighter, 'prec');
  186. if !nqp::can($r, 'prec') || ($r.prec<prec> // "") !~~ /<[@:]>/ {
  187. trait_mod:<is>($r, :prec(&tighter.prec))
  188. }
  189. $r.prec<prec> := $r.prec<prec>.subst(/\=/, '@=');
  190. $r.prec<assoc>:delete;
  191. }
  192. multi sub trait_mod:<is>(Routine $r, :&looser!) {
  193. die "Routine given to looser does not appear to be an operator"
  194. unless nqp::can(&looser, 'prec');
  195. if !nqp::can($r, 'prec') || ($r.prec<prec> // "") !~~ /<[@:]>/ {
  196. trait_mod:<is>($r, :prec(&looser.prec))
  197. }
  198. $r.prec<prec> := $r.prec<prec>.subst(/\=/, ':=');
  199. $r.prec<assoc>:delete;
  200. }
  201. multi sub trait_mod:<is>(Routine $r, :$assoc!) {
  202. trait_mod:<is>($r, :prec({ :$assoc }))
  203. }
  204. # Since trait_mod:<is> to set onlystar isn't there at the
  205. # point we wrote its proto, we do it manually here.
  206. BEGIN &trait_mod:<is>.set_onlystar();
  207. multi sub trait_mod:<is>(Parameter:D $param, |c ) {
  208. X::Comp::Trait::Unknown.new(
  209. file => $?FILE,
  210. line => $?LINE,
  211. type => 'is',
  212. subtype => c.hash.keys[0],
  213. declaring => ' parameter',
  214. highexpect => <rw readonly copy required raw leading_docs trailing_docs>,
  215. ).throw;
  216. }
  217. multi sub trait_mod:<is>(Parameter:D $param, :$readonly!) {
  218. # This is the default.
  219. }
  220. multi sub trait_mod:<is>(Parameter:D $param, :$rw!) {
  221. $param.set_rw();
  222. }
  223. multi sub trait_mod:<is>(Parameter:D $param, :$copy!) {
  224. $param.set_copy();
  225. }
  226. multi sub trait_mod:<is>(Parameter:D $param, :$required!) {
  227. $param.set_required();
  228. }
  229. multi sub trait_mod:<is>(Parameter:D $param, :$raw!) {
  230. $param.set_raw();
  231. }
  232. multi sub trait_mod:<is>(Parameter:D $param, :$onearg!) {
  233. $param.set_onearg();
  234. }
  235. multi sub trait_mod:<is>(Parameter:D $param, :$leading_docs!) {
  236. Rakudo::Internals.SET_LEADING_DOCS($param, $leading_docs);
  237. }
  238. multi sub trait_mod:<is>(Parameter:D $param, :$trailing_docs!) {
  239. Rakudo::Internals.SET_TRAILING_DOCS($param, $trailing_docs);
  240. }
  241. # Declare these, as setting mainline doesn't get them automatically (as the
  242. # Mu/Any/Scalar are not loaded).
  243. my $!;
  244. my $/;
  245. my $_;
  246. multi sub trait_mod:<is>(Routine:D \r, :$export!) {
  247. my $to_export := r.multi ?? r.dispatcher !! r;
  248. my $exp_name := '&' ~ r.name;
  249. my @tags = flat 'ALL', (nqp::istype($export,Pair) ?? $export.key() !!
  250. nqp::istype($export,Positional) ?? @($export)>>.key !!
  251. 'DEFAULT');
  252. Rakudo::Internals.EXPORT_SYMBOL($exp_name, @tags, $to_export);
  253. }
  254. multi sub trait_mod:<is>(Mu:U \type, :$export!) {
  255. my $exp_name := type.^shortname;
  256. my @tags = flat 'ALL', (nqp::istype($export,Pair) ?? $export.key !!
  257. nqp::istype($export,Positional) ?? @($export)>>.key !!
  258. 'DEFAULT');
  259. Rakudo::Internals.EXPORT_SYMBOL($exp_name, @tags, type);
  260. if nqp::istype(type.HOW, Metamodel::EnumHOW) {
  261. type.^set_export_callback( {
  262. for type.^enum_values.keys -> $value_name {
  263. Rakudo::Internals.EXPORT_SYMBOL(
  264. $value_name, @tags, type.WHO{$value_name});
  265. }
  266. });
  267. }
  268. }
  269. # for constants
  270. multi sub trait_mod:<is>(Mu \sym, :$export!, :$SYMBOL!) {
  271. my @tags = flat 'ALL', (nqp::istype($export,Pair) ?? $export.key !!
  272. nqp::istype($export,Positional) ?? @($export)>>.key !!
  273. 'DEFAULT');
  274. Rakudo::Internals.EXPORT_SYMBOL($SYMBOL, @tags, sym);
  275. }
  276. multi sub trait_mod:<is>(Block:D $r, :$leading_docs!) {
  277. Rakudo::Internals.SET_LEADING_DOCS($r, $leading_docs);
  278. }
  279. multi sub trait_mod:<is>(Block:D $r, :$trailing_docs!) {
  280. Rakudo::Internals.SET_TRAILING_DOCS($r, $trailing_docs);
  281. }
  282. # this should be identical to Mu:D, :leading_docs, otherwise the fallback Block:D, |c
  283. # will catch it and declare "leading_docs" to be an unknown trait. This is why
  284. # we need this redundant form in spite of having a Block:D candidate above
  285. multi sub trait_mod:<is>(Routine:D $r, :$leading_docs!) {
  286. Rakudo::Internals.SET_LEADING_DOCS($r, $leading_docs);
  287. }
  288. multi sub trait_mod:<is>(Routine:D $r, :$trailing_docs!) {
  289. Rakudo::Internals.SET_TRAILING_DOCS($r, $trailing_docs);
  290. }
  291. multi sub trait_mod:<is>(Mu:U $docee, :$leading_docs!) {
  292. Rakudo::Internals.SET_LEADING_DOCS($docee, $leading_docs);
  293. }
  294. multi sub trait_mod:<is>(Mu:U $docee, :$trailing_docs!) {
  295. Rakudo::Internals.SET_TRAILING_DOCS($docee.HOW, $trailing_docs);
  296. }
  297. proto sub trait_mod:<does>(|) { * }
  298. multi sub trait_mod:<does>(Mu:U $doee, Mu:U $role) {
  299. if $role.HOW.archetypes.composable() {
  300. $doee.^add_role($role)
  301. }
  302. elsif $role.HOW.archetypes.composalizable() {
  303. $doee.^add_role($role.HOW.composalize($role))
  304. }
  305. else {
  306. X::Composition::NotComposable.new(
  307. target-name => $doee.^name,
  308. composer => $role,
  309. ).throw;
  310. }
  311. }
  312. proto sub trait_mod:<of>(|) { * }
  313. multi sub trait_mod:<of>(Mu:U $target, Mu:U $type) {
  314. # XXX Ensure we can do this, die if not.
  315. $target.^set_of($type);
  316. }
  317. multi sub trait_mod:<of>(Routine:D $target, Mu:U $type) {
  318. my $sig := $target.signature;
  319. X::Redeclaration.new(what => 'return type for', symbol => $target,
  320. postfix => " (previous return type was {$sig.returns.^name})").throw
  321. if $sig.has_returns;
  322. $sig.set_returns($type);
  323. $target.^mixin(Callable.^parameterize($type))
  324. }
  325. multi sub trait_mod:<is>(Routine:D $r, :$hidden-from-backtrace!) {
  326. $r.^mixin( role { method is-hidden-from-backtrace(--> True) { } } );
  327. }
  328. multi sub trait_mod:<is>(Routine:D $r, :$hidden-from-USAGE!) {
  329. $r.^mixin( role {
  330. method is-hidden-from-USAGE(--> True) { }
  331. });
  332. }
  333. multi sub trait_mod:<is>(Routine:D $r, :$pure!) {
  334. $r.^mixin( role {
  335. method IS_PURE(--> True) { }
  336. });
  337. }
  338. multi sub trait_mod:<is>(Routine:D $r, :$nodal!) {
  339. $r.^mixin( role {
  340. method nodal(--> True) { }
  341. });
  342. }
  343. proto sub trait_mod:<returns>(|) { * }
  344. multi sub trait_mod:<returns>(Routine:D $target, Mu:U $type) {
  345. my $sig := $target.signature;
  346. X::Redeclaration.new(what => 'return type for', symbol => $target,
  347. postfix => " (previous return type was {$sig.returns.^name})").throw
  348. if $sig.has_returns;
  349. $sig.set_returns($type);
  350. $target.^mixin(Callable.^parameterize($type))
  351. }
  352. proto sub trait_mod:<handles>(|) { * }
  353. multi sub trait_mod:<handles>(Attribute:D $target, $thunk) {
  354. $target does role {
  355. has $.handles;
  356. method set_handles($expr) {
  357. $!handles := $expr;
  358. }
  359. method add_delegator_method($attr: $pkg, $meth_name, $call_name) {
  360. my $meth := method (|c) is rw {
  361. $attr.get_value(self)."$call_name"(|c)
  362. };
  363. $meth.set_name($meth_name);
  364. $pkg.^add_method($meth_name, $meth);
  365. }
  366. method apply_handles($attr: Mu $pkg) {
  367. sub applier($expr) {
  368. if $expr.defined() {
  369. if nqp::istype($expr,Str) {
  370. self.add_delegator_method($pkg, $expr, $expr);
  371. }
  372. elsif nqp::istype($expr,Pair) {
  373. self.add_delegator_method($pkg, $expr.key, $expr.value);
  374. }
  375. elsif nqp::istype($expr,Positional) {
  376. for $expr.list {
  377. applier($_);
  378. }
  379. 0;
  380. }
  381. elsif $expr.isa(Whatever) {
  382. $pkg.^add_fallback(
  383. -> $obj, $name {
  384. so $attr.get_value($obj).can($name);
  385. },
  386. -> $obj, $name {
  387. -> $self, |c {
  388. $attr.get_value($self)."$name"(|c)
  389. }
  390. });
  391. }
  392. elsif $expr.isa(HyperWhatever) {
  393. $pkg.^add_fallback(
  394. -> $obj, $name { True },
  395. -> $obj, $name {
  396. -> $self, |c {
  397. $attr.get_value($self)."$name"(|c)
  398. }
  399. });
  400. }
  401. else {
  402. $pkg.^add_fallback(
  403. -> $obj, $name {
  404. ?($name ~~ $expr)
  405. },
  406. -> $obj, $name {
  407. -> $self, |c {
  408. $attr.get_value($self)."$name"(|c)
  409. }
  410. });
  411. }
  412. }
  413. else {
  414. $pkg.^add_fallback(
  415. -> $obj, $name {
  416. ?$expr.can($name)
  417. },
  418. -> $obj, $name {
  419. -> $self, |c {
  420. $attr.get_value($self)."$name"(|c)
  421. }
  422. });
  423. }
  424. }
  425. applier($!handles);
  426. }
  427. };
  428. $target.set_handles($thunk());
  429. }
  430. multi sub trait_mod:<handles>(Method:D $m, &thunk) {
  431. my $pkg := $m.signature.params[0].type;
  432. my $call_name := $m.name;
  433. for flat thunk() -> $meth_name {
  434. my $meth := method (|c) is rw {
  435. self."$call_name"()."$meth_name"(|c);
  436. }
  437. $meth.set_name($meth_name);
  438. $pkg.^add_method($meth_name, $meth);
  439. }
  440. 0;
  441. }
  442. proto sub trait_mod:<will>(|) { * }
  443. multi sub trait_mod:<will>(Attribute:D $attr, |c ) {
  444. X::Comp::Trait::Unknown.new(
  445. file => $?FILE,
  446. line => $?LINE,
  447. type => 'will',
  448. subtype => c.hash.keys[0],
  449. declaring => 'n attribute',
  450. highexpect => <lazy>,
  451. ).throw;
  452. }
  453. multi sub trait_mod:<will>(Attribute $attr, Block :$build!) { # internal usage
  454. $attr.set_build($build)
  455. }
  456. proto sub trait_mod:<trusts>(|) { * }
  457. multi sub trait_mod:<trusts>(Mu:U $truster, Mu:U $trustee) {
  458. $truster.^add_trustee($trustee);
  459. }
  460. proto sub trait_mod:<hides>(|) { * }
  461. multi sub trait_mod:<hides>(Mu:U $child, Mu:U $parent) {
  462. if $parent.HOW.archetypes.inheritable() {
  463. $child.^add_parent($parent, :hides);
  464. }
  465. elsif $parent.HOW.archetypes.inheritalizable() {
  466. $child.^add_parent($parent.^inheritalize, :hides)
  467. }
  468. else {
  469. X::Inheritance::Unsupported.new(
  470. :child-typename($child.^name),
  471. :$parent,
  472. ).throw;
  473. }
  474. }