1. my class X::Constructor::Positional { ... }
  2. my class X::Method::NotFound { ... }
  3. my class X::Method::InvalidQualifier { ... }
  4. my class X::Attribute::Required { ... }
  5. # We use a sentinel value to mark the end of an iteration.
  6. my constant IterationEnd = nqp::create(Mu);
  7. my class Mu { # declared in BOOTSTRAP
  8. method self { self }
  9. method sink(--> Nil) { }
  10. proto method ACCEPTS(|) { * }
  11. multi method ACCEPTS(Mu:U: Any \topic) {
  12. nqp::p6bool(nqp::istype(topic, self))
  13. }
  14. multi method ACCEPTS(Mu:U: Mu:U \topic) {
  15. nqp::p6bool(nqp::istype(topic, self))
  16. }
  17. method WHERE() {
  18. nqp::p6box_i(nqp::where(self))
  19. }
  20. proto method WHICH(|) {*}
  21. multi method WHICH(Mu:U:) {
  22. nqp::box_s(
  23. nqp::concat(
  24. nqp::concat(nqp::unbox_s(self.^name), '|U'),
  25. nqp::objectid(self)
  26. ),
  27. ObjAt
  28. )
  29. }
  30. multi method WHICH(Mu:D:) {
  31. nqp::box_s(
  32. nqp::concat(
  33. nqp::concat(nqp::unbox_s(self.^name), '|'),
  34. nqp::objectid(self)
  35. ),
  36. ObjAt
  37. )
  38. }
  39. proto method iterator(|) { * }
  40. multi method iterator(Mu:) {
  41. my $buf := nqp::create(IterationBuffer);
  42. $buf.push(Mu);
  43. # note: cannot use R:I.OneValue, as that doesn't (and shouldn't)
  44. # take Mu for the value to produce, as Mu is used to indicate
  45. # exhaustion.
  46. Rakudo::Iterator.ReifiedList($buf)
  47. }
  48. proto method split(|) { * }
  49. proto method splice(|) is nodal { * }
  50. method emit {
  51. emit self;
  52. }
  53. method take {
  54. take self;
  55. }
  56. method return-rw(|) { # same code as control.pm's return-rw
  57. my $list := RETURN-LIST(nqp::p6argvmarray());
  58. nqp::throwpayloadlexcaller(nqp::const::CONTROL_RETURN, $list);
  59. $list;
  60. }
  61. method return(|) { # same code as control.pm's return
  62. my $list := RETURN-LIST(nqp::p6argvmarray());
  63. nqp::throwpayloadlexcaller(nqp::const::CONTROL_RETURN, nqp::p6recont_ro($list));
  64. $list;
  65. }
  66. proto method WHY(|) { * }
  67. multi method WHY(Mu:) {
  68. my Mu $why;
  69. if nqp::can(self.HOW, 'WHY') {
  70. $why := self.HOW.WHY;
  71. }
  72. if $why.defined && !$.defined #`(ie. we're a type object) {
  73. $why.set_docee(self);
  74. }
  75. $why // Any
  76. }
  77. method set_why($why) {
  78. self.HOW.set_why($why);
  79. }
  80. proto method Bool() {*}
  81. multi method Bool(Mu:U: --> False) { }
  82. multi method Bool(Mu:D:) { self.defined }
  83. method so() { self.Bool }
  84. method not() { self ?? False !! True }
  85. method defined() {
  86. nqp::p6bool(nqp::isconcrete(self))
  87. }
  88. proto method new(|) { * }
  89. multi method new(*%) {
  90. nqp::invokewithcapture(nqp::findmethod(self, 'bless'), nqp::usecapture())
  91. }
  92. multi method new($, *@) {
  93. X::Constructor::Positional.new(:type( self )).throw();
  94. }
  95. proto method is-lazy (|) { * }
  96. multi method is-lazy(Mu: --> False) { }
  97. method CREATE() {
  98. nqp::create(self)
  99. }
  100. method bless(*%attrinit) {
  101. nqp::create(self).BUILDALL(%attrinit);
  102. }
  103. proto method BUILDALL(|) { * }
  104. # This candidate provided for those modules that rely on the old
  105. # BUILDALL interface, such as Inline::Perl5
  106. multi method BUILDALL(@positional,%attrinit) {
  107. self.BUILDALL(%attrinit)
  108. }
  109. multi method BUILDALL(%attrinit) {
  110. my $init := nqp::getattr(%attrinit,Map,'$!storage');
  111. # Get the build plan. Note that we do this "low level" to
  112. # avoid the NQP type getting mapped to a Rakudo one, which
  113. # would get expensive.
  114. my $build_plan :=
  115. nqp::findmethod(self.HOW,'BUILDALLPLAN')(self.HOW, self);
  116. my int $count = nqp::elems($build_plan);
  117. my int $i = -1;
  118. my $task;
  119. my $build;
  120. my int $code;
  121. my int $int;
  122. my num $num;
  123. my str $str;
  124. nqp::while(
  125. nqp::islt_i($i = nqp::add_i($i,1),$count),
  126. nqp::if( # 0 # Custom BUILD call.
  127. nqp::iseq_i(($code = nqp::atpos(
  128. ($task := nqp::atpos($build_plan,$i)),0
  129. )),0),
  130. nqp::if(
  131. nqp::istype(
  132. ($build := nqp::atpos($task,1)(self,|%attrinit)),Failure),
  133. return $build
  134. ),
  135. nqp::if( # 1
  136. nqp::iseq_i($code,1),
  137. nqp::if(
  138. nqp::existskey($init,nqp::atpos($task,2)),
  139. (nqp::getattr(self,nqp::atpos($task,1),nqp::atpos($task,3))
  140. = %attrinit.AT-KEY(nqp::p6box_s(nqp::atpos($task,2))))
  141. ),
  142. nqp::if( # 2
  143. nqp::iseq_i($code,2),
  144. nqp::if(
  145. nqp::existskey($init,nqp::atpos($task,2)),
  146. (nqp::getattr(self,nqp::atpos($task,1),nqp::atpos($task,3))
  147. = %attrinit.AT-KEY(nqp::p6box_s(nqp::atpos($task,2)))),
  148. nqp::bindattr(self,nqp::atpos($task,1),nqp::atpos($task,3),
  149. nqp::list)
  150. ),
  151. nqp::if( # 3
  152. nqp::iseq_i($code,3),
  153. nqp::if(
  154. nqp::existskey($init,nqp::atpos($task,2)),
  155. (nqp::getattr(self,nqp::atpos($task,1),nqp::atpos($task,3))
  156. = %attrinit.AT-KEY(nqp::p6box_s(nqp::atpos($task,2)))),
  157. nqp::bindattr(self,nqp::atpos($task,1),nqp::atpos($task,3),
  158. nqp::hash)
  159. ),
  160. nqp::if( # 4
  161. nqp::iseq_i($code,4),
  162. nqp::unless(
  163. nqp::attrinited(self,
  164. nqp::atpos($task,1),
  165. nqp::atpos($task,2)
  166. ),
  167. nqp::stmts(
  168. (my \attr := nqp::getattr(self,
  169. nqp::atpos($task,1),
  170. nqp::atpos($task,2)
  171. )),
  172. (attr = nqp::atpos($task,3)(self,attr))
  173. )
  174. ),
  175. nqp::if( # 5
  176. nqp::iseq_i($code,5),
  177. nqp::if(
  178. nqp::existskey($init,nqp::atpos($task,2)),
  179. nqp::bindattr_i(self,
  180. nqp::atpos($task,1),
  181. nqp::atpos($task,3),
  182. nqp::decont(%attrinit.AT-KEY(
  183. nqp::p6box_s(nqp::atpos($task,2))
  184. ))
  185. )
  186. ),
  187. nqp::if( # 6
  188. nqp::iseq_i($code,6),
  189. nqp::if(
  190. nqp::existskey($init,nqp::atpos($task,2)),
  191. nqp::bindattr_n(self,
  192. nqp::atpos($task,1),
  193. nqp::atpos($task,3),
  194. nqp::decont(%attrinit.AT-KEY(
  195. nqp::p6box_s(nqp::atpos($task,2))
  196. ))
  197. )
  198. ),
  199. nqp::if( # 7
  200. nqp::iseq_i($code,7),
  201. nqp::if(
  202. nqp::existskey($init,nqp::atpos($task,2)),
  203. nqp::bindattr_s(self,
  204. nqp::atpos($task,1),
  205. nqp::atpos($task,3),
  206. nqp::decont(%attrinit.AT-KEY(
  207. nqp::p6box_s(nqp::atpos($task,2))
  208. ))
  209. )
  210. ),
  211. nqp::if( # 8
  212. nqp::iseq_i($code,8),
  213. nqp::if(
  214. nqp::iseq_i($int = nqp::getattr_i(self,
  215. nqp::atpos($task,1),
  216. nqp::atpos($task,2)
  217. ), 0),
  218. nqp::bindattr_i(self,
  219. nqp::atpos($task,1),
  220. nqp::atpos($task,2),
  221. (nqp::atpos($task,3)(self,$int))
  222. )
  223. ),
  224. nqp::if( # 9
  225. nqp::iseq_i($code,9),
  226. nqp::if(
  227. nqp::iseq_n($num = nqp::getattr_n(self,
  228. nqp::atpos($task,1),
  229. nqp::atpos($task,2)
  230. ), 0e0),
  231. nqp::bindattr_n(self,
  232. nqp::atpos($task,1),
  233. nqp::atpos($task,2),
  234. (nqp::atpos($task,3)(self,$num))
  235. )
  236. ),
  237. nqp::if( # 10
  238. nqp::iseq_i($code,10),
  239. nqp::if(
  240. nqp::isnull_s($str = nqp::getattr_s(self,
  241. nqp::atpos($task,1),
  242. nqp::atpos($task,2)
  243. )),
  244. nqp::bindattr_s(self,
  245. nqp::atpos($task,1),
  246. nqp::atpos($task,2),
  247. (nqp::atpos($task,3)(self,$str))
  248. )
  249. ),
  250. nqp::if( # 11
  251. nqp::iseq_i($code,11),
  252. nqp::unless(
  253. nqp::attrinited(self,
  254. nqp::atpos($task,1),
  255. nqp::atpos($task,2)
  256. ),
  257. X::Attribute::Required.new(
  258. name => nqp::atpos($task,2),
  259. why => nqp::atpos($task,3)
  260. ).throw
  261. ),
  262. nqp::if( # 12
  263. nqp::iseq_i($code,12),
  264. nqp::bindattr(self,
  265. nqp::atpos($task,1),
  266. nqp::atpos($task,2),
  267. (nqp::atpos($task,3)())
  268. ),
  269. nqp::if( # 13
  270. nqp::isne_i($code,13), # no-op
  271. die("Invalid BUILDALL plan")
  272. )
  273. ))))))))))))));
  274. self
  275. }
  276. method BUILD_LEAST_DERIVED(%attrinit) {
  277. my $init := nqp::getattr(%attrinit,Map,'$!storage');
  278. # Get the build plan for just this class.
  279. my $build_plan := nqp::findmethod(self.HOW,'BUILDPLAN')(self.HOW,self);
  280. my int $count = nqp::elems($build_plan);
  281. my int $i = -1;
  282. my $task;
  283. my $build;
  284. my int $code;
  285. my int $int;
  286. my num $num;
  287. my str $str;
  288. nqp::while(
  289. nqp::islt_i($i = nqp::add_i($i,1),$count),
  290. nqp::if( # 0 # Custom BUILD call.
  291. nqp::iseq_i(($code = nqp::atpos(
  292. ($task := nqp::atpos($build_plan,$i)),0
  293. )),0),
  294. nqp::if(
  295. nqp::istype(
  296. ($build := nqp::atpos($task,1)(self,|%attrinit)),Failure),
  297. return $build
  298. ),
  299. nqp::if( # 1
  300. nqp::iseq_i($code,1),
  301. nqp::if(
  302. nqp::existskey($init,nqp::atpos($task,2)),
  303. (nqp::getattr(self,nqp::atpos($task,1),nqp::atpos($task,3))
  304. = nqp::decont(
  305. %attrinit.AT-KEY(nqp::p6box_s(nqp::atpos($task,2)))
  306. )
  307. )
  308. ),
  309. nqp::if( # 2
  310. nqp::iseq_i($code,2),
  311. nqp::if(
  312. nqp::existskey($init,nqp::atpos($task,2)),
  313. (nqp::getattr(self,nqp::atpos($task,1),nqp::atpos($task,3))
  314. = nqp::decont(
  315. %attrinit.AT-KEY(nqp::p6box_s(nqp::atpos($task,2)))
  316. )
  317. ),
  318. nqp::bindattr(self,nqp::atpos($task,1),nqp::atpos($task,3),
  319. nqp::list)
  320. ),
  321. nqp::if( # 3
  322. nqp::iseq_i($code,3),
  323. nqp::if(
  324. nqp::existskey($init,nqp::atpos($task,2)),
  325. (nqp::getattr(self,nqp::atpos($task,1),nqp::atpos($task,3))
  326. = nqp::decont(
  327. %attrinit.AT-KEY(nqp::p6box_s(nqp::atpos($task,2)))
  328. )
  329. ),
  330. nqp::bindattr(self,nqp::atpos($task,1),nqp::atpos($task,3),
  331. nqp::hash)
  332. ),
  333. nqp::if( # 4
  334. nqp::iseq_i($code,4),
  335. nqp::unless(
  336. nqp::attrinited(self,
  337. nqp::atpos($task,1),
  338. nqp::atpos($task,2)
  339. ),
  340. nqp::stmts(
  341. (my \attr := nqp::getattr(self,
  342. nqp::atpos($task,1),
  343. nqp::atpos($task,2)
  344. )),
  345. (attr = nqp::atpos($task,3)(self,attr))
  346. )
  347. ),
  348. nqp::if( # 5
  349. nqp::iseq_i($code,5),
  350. nqp::if(
  351. nqp::existskey($init,nqp::atpos($task,2)),
  352. nqp::bindattr_i(self,
  353. nqp::atpos($task,1),
  354. nqp::atpos($task,3),
  355. nqp::decont(%attrinit.AT-KEY(
  356. nqp::p6box_s(nqp::atpos($task,2))
  357. ))
  358. )
  359. ),
  360. nqp::if( # 6
  361. nqp::iseq_i($code,6),
  362. nqp::if(
  363. nqp::existskey($init,nqp::atpos($task,2)),
  364. nqp::bindattr_n(self,
  365. nqp::atpos($task,1),
  366. nqp::atpos($task,3),
  367. nqp::decont(%attrinit.AT-KEY(
  368. nqp::p6box_s(nqp::atpos($task,2))
  369. ))
  370. )
  371. ),
  372. nqp::if( # 7
  373. nqp::iseq_i($code,7),
  374. nqp::if(
  375. nqp::existskey($init,nqp::atpos($task,2)),
  376. nqp::bindattr_s(self,
  377. nqp::atpos($task,1),
  378. nqp::atpos($task,3),
  379. nqp::decont(%attrinit.AT-KEY(
  380. nqp::p6box_s(nqp::atpos($task,2))
  381. ))
  382. )
  383. ),
  384. nqp::if( # 8
  385. nqp::iseq_i($code,8),
  386. nqp::if(
  387. nqp::iseq_i($int = nqp::getattr_i(self,
  388. nqp::atpos($task,1),
  389. nqp::atpos($task,2)
  390. ), 0),
  391. nqp::bindattr_i(self,
  392. nqp::atpos($task,1),
  393. nqp::atpos($task,2),
  394. (nqp::atpos($task,3)(self,$int))
  395. )
  396. ),
  397. nqp::if( # 9
  398. nqp::iseq_i($code,9),
  399. nqp::if(
  400. nqp::iseq_n($num = nqp::getattr_n(self,
  401. nqp::atpos($task,1),
  402. nqp::atpos($task,2)
  403. ), 0e0),
  404. nqp::bindattr_n(self,
  405. nqp::atpos($task,1),
  406. nqp::atpos($task,2),
  407. (nqp::atpos($task,3)(self,$num))
  408. )
  409. ),
  410. nqp::if( # 10
  411. nqp::iseq_i($code,10),
  412. nqp::if(
  413. nqp::isnull_s($str = nqp::getattr_s(self,
  414. nqp::atpos($task,1),
  415. nqp::atpos($task,2)
  416. )),
  417. nqp::bindattr_s(self,
  418. nqp::atpos($task,1),
  419. nqp::atpos($task,2),
  420. (nqp::atpos($task,3)(self,$str))
  421. )
  422. ),
  423. nqp::if( # 13
  424. nqp::iseq_i($code,13),
  425. # Force vivification, for the sake of meta-object
  426. # mix-ins at compile time ending up with correctly
  427. # shared containers.
  428. nqp::getattr(self,
  429. nqp::atpos($task,1),
  430. nqp::atpos($task,2)
  431. ),
  432. die("Invalid BUILD_LEAST_DERIVED plan")
  433. )
  434. ))))))))))));
  435. self
  436. }
  437. proto method Numeric(|) { * }
  438. multi method Numeric(Mu:U \v:) {
  439. warn "Use of uninitialized value of type {self.^name} in numeric context";
  440. 0
  441. }
  442. proto method Real(|) { * }
  443. multi method Real(Mu:U \v:) {
  444. warn "Use of uninitialized value of type {self.^name} in numeric context";
  445. 0
  446. }
  447. proto method Str(|) { * }
  448. multi method Str(Mu:U \v:) {
  449. my $name = (defined($*VAR_NAME) ?? $*VAR_NAME !! try v.VAR.?name) // '';
  450. $name ~= ' ' if $name ne '';
  451. warn "Use of uninitialized value {$name}of type {self.^name} in string"
  452. ~ " context.\nMethods .^name, .perl, .gist, or .say can be"
  453. ~ " used to stringify it to something meaningful.";
  454. ''
  455. }
  456. multi method Str(Mu:D:) {
  457. nqp::if(
  458. nqp::eqaddr(self,IterationEnd),
  459. "IterationEnd",
  460. self.^name ~ '<' ~ nqp::tostr_I(nqp::objectid(self)) ~ '>'
  461. )
  462. }
  463. proto method Stringy(|) { * }
  464. multi method Stringy(Mu:U \v:) {
  465. my $*VAR_NAME = try v.VAR.?name;
  466. self.Str
  467. }
  468. multi method Stringy(Mu:D $:) { self.Str }
  469. method item(Mu \item:) is raw { item }
  470. proto method say(|) { * }
  471. multi method say() { say(self) }
  472. method print() { print(self) }
  473. method put() { put(self) }
  474. method note() { note(self) }
  475. method gistseen(Mu:D \SELF: $id, $gist, *%named) {
  476. if nqp::not_i(nqp::isnull(nqp::getlexdyn('$*gistseen'))) {
  477. my \sems := $*gistseen;
  478. my str $WHICH = nqp::unbox_s(self.WHICH);
  479. if nqp::existskey(sems,$WHICH) && nqp::atkey(sems,$WHICH) {
  480. nqp::bindkey(sems,$WHICH,2);
  481. "{$id}_{nqp::objectid(SELF)}";
  482. }
  483. else {
  484. nqp::bindkey(sems,$WHICH,1);
  485. my $result := $gist(|%named);
  486. my int $value = nqp::atkey(sems,$WHICH);
  487. nqp::deletekey(sems,$WHICH);
  488. $value == 2
  489. ?? "(\\{$id}_{nqp::objectid(SELF)} = $result)"
  490. !! $result
  491. }
  492. }
  493. else {
  494. my $*gistseen := nqp::hash("TOP",1);
  495. SELF.gistseen($id,$gist,|%named)
  496. }
  497. }
  498. proto method gist(|) { * }
  499. multi method gist(Mu:U:) { '(' ~ self.^shortname ~ ')' }
  500. multi method gist(Mu:D:) { self.perl }
  501. method perlseen(Mu:D \SELF: $id, $perl, *%named) {
  502. my $sigil = nqp::iseq_s($id, 'Array') ?? '@'
  503. !! nqp::iseq_s($id, 'Hash') ?? '%' !! '\\';
  504. if nqp::not_i(nqp::isnull(nqp::getlexdyn('$*perlseen'))) {
  505. my \sems := $*perlseen;
  506. my str $WHICH = nqp::unbox_s(self.WHICH);
  507. if nqp::existskey(sems,$WHICH) && nqp::atkey(sems,$WHICH) {
  508. nqp::bindkey(sems,$WHICH,2);
  509. $sigil x nqp::isne_s($sigil, '\\') ~ "{$id}_{nqp::objectid(SELF)}";
  510. }
  511. else {
  512. nqp::bindkey(sems,$WHICH,1);
  513. my $result := $perl(|%named);
  514. my int $value = nqp::atkey(sems,$WHICH);
  515. nqp::deletekey(sems,$WHICH);
  516. $value == 2
  517. ?? nqp::iseq_s($sigil, '\\')
  518. ?? "(my {$sigil}{$id}_{nqp::objectid(SELF)} = $result)"
  519. !! "((my {$sigil}{$id}_{nqp::objectid(SELF)}) = $result)"
  520. !! $result
  521. }
  522. }
  523. else {
  524. my $*perlseen := nqp::hash("TOP",1);
  525. SELF.perlseen($id,$perl,|%named)
  526. }
  527. }
  528. proto method perl(|) { * }
  529. multi method perl(Mu:U:) { self.^name }
  530. multi method perl(Mu:D:) {
  531. nqp::if(
  532. nqp::eqaddr(self,IterationEnd),
  533. "IterationEnd",
  534. self.perlseen(self.^name, {
  535. my @attrs;
  536. for self.^attributes().flat.grep: { .has_accessor } -> $attr {
  537. my $name := substr($attr.Str,2);
  538. @attrs.push: $name ~ ' => ' ~ $attr.get_value(self).perl
  539. }
  540. self.^name ~ '.new' ~ ('(' ~ @attrs.join(', ') ~ ')' if @attrs)
  541. })
  542. )
  543. }
  544. proto method DUMP(|) { * }
  545. multi method DUMP(Mu:U:) { self.perl }
  546. multi method DUMP(Mu:D: :$indent-step = 4, :%ctx?) {
  547. return DUMP(self, :$indent-step) unless %ctx;
  548. my Mu $attrs := nqp::list();
  549. for self.^attributes.flat -> $attr {
  550. my str $name = $attr.name;
  551. my str $acc_name = nqp::substr($name, 2, nqp::chars($name) - 2);
  552. my str $build_name = $attr.has_accessor ?? $acc_name !! $name;
  553. my Mu $value;
  554. if $attr.has_accessor {
  555. $value := self."$acc_name"();
  556. }
  557. elsif nqp::can($attr, 'get_value') {
  558. $value := $attr.get_value(self);
  559. }
  560. elsif nqp::can($attr, 'package') {
  561. my Mu $decont := nqp::decont(self);
  562. my Mu $package := $attr.package;
  563. $value := do given nqp::p6box_i(nqp::objprimspec($attr.type)) {
  564. when 0 { nqp::getattr( $decont, $package, $name) }
  565. when 1 { nqp::p6box_i(nqp::getattr_i($decont, $package, $name)) }
  566. when 2 { nqp::p6box_n(nqp::getattr_n($decont, $package, $name)) }
  567. when 3 { nqp::p6box_s(nqp::getattr_s($decont, $package, $name)) }
  568. };
  569. }
  570. else {
  571. next;
  572. }
  573. nqp::push($attrs, $build_name);
  574. nqp::push($attrs, $value);
  575. }
  576. self.DUMP-OBJECT-ATTRS($attrs, :$indent-step, :%ctx);
  577. }
  578. method DUMP-PIECES(@pieces: $before, $after = ')', :$indent = @pieces > 1, :$indent-step) {
  579. $indent ?? $before ~ "\n" ~ @pieces.join(",\n").indent($indent-step) ~ "\n" ~ $after
  580. !! $before ~ @pieces.join(', ') ~ $after;
  581. }
  582. method DUMP-OBJECT-ATTRS(|args (*@args, :$indent-step, :%ctx, :$flags?)) {
  583. my Mu $attrs := nqp::clone(nqp::captureposarg(nqp::usecapture(), 1));
  584. my str $where = nqp::base_I(nqp::where(self), 16);
  585. my str $before = ($flags if defined $flags) ~ self.^name ~ '<' ~ %ctx{$where} ~ '>(';
  586. my @pieces;
  587. while $attrs {
  588. my str $name = nqp::shift($attrs);
  589. my Mu $value := nqp::shift($attrs);
  590. @pieces.push: ':' ~ $name ~ '(' ~ DUMP($value, :$indent-step, :%ctx) ~ ')';
  591. }
  592. @pieces.DUMP-PIECES($before, :$indent-step);
  593. }
  594. proto method isa(|) { * }
  595. multi method isa(Mu \SELF: Mu $type) {
  596. nqp::p6bool(SELF.^isa($type.WHAT))
  597. }
  598. multi method isa(Mu \SELF: Str:D $name) {
  599. my @mro = SELF.^mro;
  600. my int $mro_count = @mro.elems;
  601. my int $i = -1;
  602. return True
  603. if @mro[$i].^name eq $name
  604. while nqp::islt_i(++$i,$mro_count);
  605. False
  606. }
  607. method does(Mu \SELF: Mu $type) {
  608. nqp::p6bool(nqp::istype(SELF, $type.WHAT))
  609. }
  610. method can(Mu \SELF: $name) {
  611. SELF.^can($name)
  612. }
  613. proto method clone (|) { * }
  614. multi method clone(Mu:U: *%twiddles) {
  615. %twiddles and die 'Cannot set attribute values when cloning a type object';
  616. self
  617. }
  618. multi method clone(Mu:D: *%twiddles) {
  619. my $cloned := nqp::clone(self);
  620. if %twiddles.elems {
  621. for self.^attributes.flat -> $attr {
  622. my $name := $attr.name;
  623. my $package := $attr.package;
  624. nqp::bindattr($cloned, $package, $name,
  625. nqp::clone(nqp::getattr($cloned, $package, $name).VAR)
  626. ) if nqp::attrinited(self, $package, $name)
  627. and nqp::not_i(nqp::objprimspec($attr.type));
  628. my $acc_name := substr($name,2);
  629. nqp::getattr($cloned, $package, $name) =
  630. nqp::decont(%twiddles{$acc_name})
  631. if $attr.has_accessor && %twiddles.EXISTS-KEY($acc_name);
  632. }
  633. }
  634. else {
  635. for self.^attributes.flat -> $attr {
  636. unless nqp::objprimspec($attr.type) {
  637. my $name := $attr.name;
  638. my $package := $attr.package;
  639. if nqp::attrinited(self, $package, $name) {
  640. my $attr_val := nqp::getattr($cloned, $package, $name);
  641. nqp::bindattr($cloned,
  642. $package, $name, nqp::clone($attr_val.VAR))
  643. if nqp::iscont($attr_val);
  644. }
  645. }
  646. }
  647. }
  648. $cloned
  649. }
  650. method Capture() {
  651. my $attrs := nqp::hash;
  652. for self.^attributes.flat -> $attr {
  653. if $attr.has_accessor {
  654. my str $name = substr($attr.name,2);
  655. nqp::bindkey($attrs,$name,self."$name"())
  656. unless nqp::existskey($attrs,$name);
  657. }
  658. }
  659. my $capture := nqp::create(Capture);
  660. nqp::bindattr($capture,Capture,'%!hash',$attrs) if nqp::elems($attrs);
  661. $capture
  662. }
  663. # XXX TODO: Handle positional case.
  664. method dispatch:<var>(Mu \SELF: $var, |c) is raw {
  665. $var(SELF, |c)
  666. }
  667. method dispatch:<::>(Mu \SELF: $name, Mu $type, |c) is raw {
  668. unless nqp::istype(SELF, $type) {
  669. X::Method::InvalidQualifier.new(
  670. method => $name,
  671. invocant => SELF,
  672. qualifier-type => $type,
  673. ).throw;
  674. }
  675. self.^find_method_qualified($type, $name)(SELF, |c)
  676. }
  677. method dispatch:<!>(Mu \SELF: \name, Mu \type, |c) is raw {
  678. my $meth := type.^find_private_method(name);
  679. $meth ??
  680. $meth(SELF, |c) !!
  681. X::Method::NotFound.new(
  682. invocant => SELF,
  683. method => '!' ~ name,
  684. typename => type.^name,
  685. :private,
  686. ).throw;
  687. }
  688. method dispatch:<.=>(\mutate: Str() $name, |c) is raw {
  689. $/ := nqp::getlexcaller('$/');
  690. mutate = mutate."$name"(|c)
  691. }
  692. method dispatch:<.?>(Mu \SELF: Str() $name, |c) is raw {
  693. nqp::can(SELF,$name) ??
  694. SELF."$name"(|c) !!
  695. Nil
  696. }
  697. method dispatch:<.+>(Mu \SELF: $name, |c) {
  698. my @result := SELF.dispatch:<.*>($name, |c);
  699. if @result.elems == 0 {
  700. X::Method::NotFound.new(
  701. invocant => SELF,
  702. method => $name,
  703. typename => SELF.^name,
  704. ).throw;
  705. }
  706. @result
  707. }
  708. method dispatch:<.*>(Mu \SELF: \name, |c) {
  709. my @mro = SELF.^mro;
  710. my int $mro_count = @mro.elems;
  711. my $results := nqp::create(IterationBuffer);
  712. my int $i = -1;
  713. while nqp::islt_i(++$i,$mro_count) {
  714. my $obj = @mro[$i];
  715. my $meth = ($obj.^method_table){name};
  716. $meth = ($obj.^submethod_table){name} if !$meth && $i == 0;
  717. nqp::push($results,$meth(SELF, |c)) if $meth;
  718. }
  719. nqp::p6bindattrinvres(nqp::create(List),List,'$!reified',$results)
  720. }
  721. method dispatch:<hyper>(Mu \SELF: Str() $name, |c) {
  722. nqp::if(
  723. nqp::can(List,$name) && nqp::can(List.can($name).AT-POS(0),"nodal"),
  724. nqp::if(
  725. c,
  726. HYPER( sub (\obj) is nodal { obj."$name"(|c) }, SELF ),
  727. HYPER( sub (\obj) is nodal { obj."$name"() }, SELF )
  728. ),
  729. nqp::if(
  730. c,
  731. HYPER( -> \obj { obj."$name"(|c) }, SELF ),
  732. HYPER( -> \obj { obj."$name"() }, SELF )
  733. )
  734. )
  735. }
  736. method WALK(:$name!, :$canonical, :$ascendant, :$descendant, :$preorder, :$breadth,
  737. :$super, :$omit, :$include) {
  738. # First, build list of classes in the order we'll need them.
  739. my @classes;
  740. if $super {
  741. @classes = self.^parents(:local);
  742. }
  743. elsif $breadth {
  744. my @search_list = self.WHAT;
  745. while @search_list {
  746. append @classes, @search_list;
  747. my @new_search_list;
  748. for @search_list -> $current {
  749. for flat $current.^parents(:local) -> $next {
  750. unless @new_search_list.grep({ $^c.WHAT =:= $next.WHAT }) {
  751. push @new_search_list, $next;
  752. }
  753. }
  754. }
  755. @search_list = @new_search_list;
  756. }
  757. } elsif $ascendant | $preorder {
  758. sub build_ascendent(Mu $class) {
  759. unless @classes.grep({ $^c.WHAT =:= $class.WHAT }) {
  760. push @classes, $class;
  761. for flat $class.^parents(:local) {
  762. build_ascendent($^parent);
  763. }
  764. }
  765. }
  766. build_ascendent(self.WHAT);
  767. } elsif $descendant {
  768. sub build_descendent(Mu $class) {
  769. unless @classes.grep({ $^c.WHAT =:= $class.WHAT }) {
  770. for flat $class.^parents(:local) {
  771. build_descendent($^parent);
  772. }
  773. push @classes, $class;
  774. }
  775. }
  776. build_descendent(self.WHAT);
  777. } else {
  778. # Canonical, the default (just whatever the meta-class says) with us
  779. # on the start.
  780. @classes = self.^mro();
  781. }
  782. # Now we have classes, build method list.
  783. my @methods;
  784. for @classes -> $class {
  785. if (!defined($include) || $include.ACCEPTS($class)) &&
  786. (!defined($omit) || !$omit.ACCEPTS($class)) {
  787. try {
  788. for flat $class.^methods(:local) -> $method {
  789. my $check_name = $method.?name;
  790. if $check_name.defined && $check_name eq $name {
  791. @methods.push($method);
  792. }
  793. }
  794. 0;
  795. }
  796. }
  797. }
  798. @methods;
  799. }
  800. }
  801. proto sub defined(Mu) is pure { * }
  802. multi sub defined(Mu \x) { x.defined }
  803. proto sub infix:<~~>(Mu \topic, Mu \matcher) { * }
  804. multi sub infix:<~~>(Mu \topic, Mu \matcher) {
  805. matcher.ACCEPTS(topic).Bool;
  806. }
  807. proto sub infix:<!~~>(Mu \topic, Mu \matcher) { * }
  808. multi sub infix:<!~~>(Mu \topic, Mu \matcher) {
  809. matcher.ACCEPTS(topic).not;
  810. }
  811. proto sub infix:<=:=>(Mu $?, Mu $?) is pure { * }
  812. multi sub infix:<=:=>($?) { Bool::True }
  813. multi sub infix:<=:=>(Mu \a, Mu \b) {
  814. nqp::p6bool(nqp::eqaddr(a, b));
  815. }
  816. proto sub infix:<eqv>(Any $?, Any $?) is pure { * }
  817. multi sub infix:<eqv>($?) { Bool::True }
  818. # Last ditch snapshot semantics. We shouldn't come here too often, so
  819. # please do not change this to be faster but wronger. (Instead, add
  820. # specialized multis for datatypes that can be tested piecemeal.)
  821. multi sub infix:<eqv>(Any:U \a, Any:U \b) {
  822. nqp::p6bool(nqp::eqaddr(nqp::decont(a),nqp::decont(b)))
  823. }
  824. multi sub infix:<eqv>(Any:D \a, Any:U \b) { False }
  825. multi sub infix:<eqv>(Any:U \a, Any:D \b) { False }
  826. multi sub infix:<eqv>(Any:D \a, Any:D \b) {
  827. nqp::p6bool(
  828. nqp::eqaddr(a,b)
  829. || (nqp::eqaddr(a.WHAT,b.WHAT) && nqp::iseq_s(a.perl,b.perl))
  830. )
  831. }
  832. multi sub infix:<eqv>(Iterable:D \a, Iterable:D \b) {
  833. nqp::p6bool(
  834. nqp::unless(
  835. nqp::eqaddr(a,b), # identity
  836. nqp::if(
  837. nqp::eqaddr(a.WHAT,b.WHAT), # same type
  838. nqp::if(
  839. nqp::iseq_i((my int $elems = a.elems),b.elems), # same # elems
  840. nqp::stmts(
  841. (my int $i = -1),
  842. nqp::while(
  843. nqp::islt_i(($i = nqp::add_i($i,1)),$elems) # not exhausted
  844. && a.AT-POS($i) eqv b.AT-POS($i), # still same
  845. nqp::null
  846. ),
  847. nqp::iseq_i($i,$elems) # exhausted = success!
  848. )
  849. )
  850. )
  851. )
  852. )
  853. }
  854. sub DUMP(|args (*@args, :$indent-step = 4, :%ctx?)) {
  855. my Mu $capture := nqp::usecapture();
  856. my Mu $topic := nqp::captureposarg($capture, 0);
  857. return "\x25b6" ~ DUMP(nqp::decont($topic), :$indent-step, :%ctx)
  858. if nqp::iscont($topic);
  859. return '(null)' if nqp::isnull($topic);
  860. my str $type = $topic.^name;
  861. my str $where = nqp::base_I(nqp::where($topic), 16);
  862. if %ctx{$where} -> $obj_num {
  863. nqp::istype($topic, Bool) ?? $topic.DUMP(:$indent-step, :%ctx) !!
  864. nqp::isconcrete($topic) ?? '=' ~ $type ~ '<' ~ $obj_num ~ '>' !!
  865. nqp::can($topic, 'DUMP') ?? $topic.DUMP(:$indent-step, :%ctx) !!
  866. $type;
  867. }
  868. else {
  869. my int $obj_num = %ctx.elems + 1;
  870. %ctx{$where} = $obj_num;
  871. if nqp::islist($topic) {
  872. my str $id = $type ~ '<' ~ $obj_num ~ '>';
  873. my @pieces;
  874. $topic := nqp::clone($topic);
  875. while $topic {
  876. my Mu $x := nqp::shift($topic);
  877. @pieces.push: DUMP($x, :$indent-step, :%ctx);
  878. }
  879. @pieces.DUMP-PIECES($id ~ '(', :$indent-step);
  880. }
  881. elsif nqp::ishash($topic) {
  882. my str $id = $type ~ '<' ~ $obj_num ~ '>';
  883. my @pieces;
  884. {
  885. for $topic.pairs {
  886. @pieces.push: $_.key ~ ' => ' ~ DUMP($_.value, :$indent-step, :%ctx);
  887. }
  888. CATCH { default { @pieces.push: '...' } }
  889. }
  890. @pieces.DUMP-PIECES($id ~ '(', :$indent-step);
  891. }
  892. elsif nqp::can($topic, 'DUMP') {
  893. $topic.DUMP(:$indent-step, :%ctx);
  894. }
  895. else {
  896. given nqp::p6box_i(nqp::captureposprimspec($capture, 0)) {
  897. when 0 { $type ~ '<' ~ $obj_num ~ '>(...)' }
  898. when 1 { nqp::captureposarg_i($capture, 0).DUMP(:$indent-step, :%ctx) }
  899. when 2 { nqp::captureposarg_n($capture, 0).DUMP(:$indent-step, :%ctx) }
  900. when 3 { nqp::captureposarg_s($capture, 0).DUMP(:$indent-step, :%ctx) }
  901. }
  902. }
  903. }
  904. }
  905. # U+2212 minus (forward call to regular minus)
  906. proto sub infix:<−>(|) is pure { * }
  907. multi sub infix:<−>(|c) { infix:<->(|c) }
  908. proto sub prefix:<−>(|) is pure { * }
  909. multi sub prefix:<−>(|c) { prefix:<->(|c) }
  910. # These must collapse Junctions
  911. proto sub so(Mu $) {*}
  912. multi sub so(Mu $x) { ?$x }
  913. proto sub not(Mu $) {*}
  914. multi sub not(Mu $x) { !$x }
  915. Metamodel::ClassHOW.exclude_parent(Mu);