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