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