1. my class DateTime { ... }
  2. my role IO { ... }
  3. my class IO::Handle { ... }
  4. my class IO::Path { ... }
  5. my class Rakudo::Metaops { ... }
  6. my class List::Reifier { ... }
  7. my class X::Assignment::ToShaped { ... }
  8. my class X::Cannot::Lazy { ... }
  9. my class X::IllegalDimensionInShape { ... }
  10. my class X::IllegalOnFixedDimensionArray { ... }
  11. my class X::Localizer::NoContainer { ... }
  12. my class X::Str::Sprintf::Directives::BadType { ... }
  13. my class X::Str::Sprintf::Directives::Count { ... }
  14. my class X::Str::Sprintf::Directives::Unsupported { ... }
  15. my class X::TypeCheck { ... }
  16. my class Rakudo::Internals {
  17. # for use in nqp::splice
  18. my $empty := nqp::list;
  19. our class CompilerServices {
  20. has Mu $!compiler;
  21. has Mu $!current-match;
  22. method generate_accessor(str $name, Mu \package_type, str $attr_name, Mu \type, int $rw) {
  23. $!compiler.generate_accessor(
  24. $!current-match, $name, package_type, $attr_name, type, $rw);
  25. }
  26. method generate_buildplan_executor(Mu \obj, Mu \buildplan) {
  27. $!compiler.generate_buildplan_executor(
  28. $!current-match, obj, buildplan)
  29. }
  30. }
  31. # rotate nqp list to another given list without using push/pop
  32. method RotateListToList(\from,\n,\to) {
  33. nqp::stmts(
  34. (my $from := nqp::getattr(from,List,'$!reified')),
  35. nqp::if((my int $elems = nqp::elems($from)),
  36. nqp::stmts(
  37. (my $to := nqp::getattr(to,List,'$!reified')),
  38. (my int $i = -1),
  39. (my int $j = nqp::mod_i(nqp::sub_i(nqp::sub_i($elems,1),n),$elems)),
  40. nqp::if(nqp::islt_i($j,0),($j = nqp::add_i($j,$elems))),
  41. nqp::while(
  42. nqp::islt_i(($i = nqp::add_i($i,1)),$elems),
  43. nqp::bindpos(
  44. $to,
  45. ($j = nqp::mod_i(nqp::add_i($j,1),$elems)),
  46. nqp::atpos($from,$i)
  47. ),
  48. ),
  49. ),
  50. ),
  51. to
  52. )
  53. }
  54. method RANGE-AS-ints ($range, $exception) {
  55. # Convert a Range to min/max values that can fit into an `int`
  56. # Treats values smaller than int.Range.min as int.Range.min
  57. # Treats values larger than int.Range.max as int.Range.max
  58. # Throws $exception for non-Numeric ranges or ranges with any NaN endpoints
  59. # If $exception is a Str, calls `die $exception`
  60. my $min := $range.min;
  61. my $max := $range.max;
  62. nqp::unless(
  63. nqp::istype($min, Numeric) && nqp::isfalse($min.isNaN)
  64. && nqp::istype($max, Numeric) && nqp::isfalse($max.isNaN),
  65. nqp::if(nqp::istype($exception, Str), die($exception), $exception.throw));
  66. # Get rid of Infs
  67. $min := Int($min + $range.excludes-min) // -2**63;
  68. $max := Int($max - $range.excludes-max) // 2**63-1;
  69. # we have isbig_I, but it tells whether the value is above max int32 value
  70. nqp::if( nqp::islt_I(nqp::decont($min), -2**63),
  71. $min = -2**63);
  72. nqp::if( nqp::isgt_I(nqp::decont($max), 2**63-1),
  73. $max = 2**63-1);
  74. ($min, $max);
  75. }
  76. method SET_LEADING_DOCS($obj, $docs) {
  77. my $current_why := $obj.WHY;
  78. if $current_why {
  79. my $end := nqp::elems($*POD_BLOCKS) - 1;
  80. my $i := $end;
  81. while $i >= 0 {
  82. if $docs === nqp::atpos($*POD_BLOCKS, $i) {
  83. nqp::splice($*POD_BLOCKS, $empty, $i, 1);
  84. last;
  85. }
  86. $i := $i - 1;
  87. }
  88. $current_why._add_leading(~$docs);
  89. } else {
  90. $obj.set_why($docs);
  91. }
  92. }
  93. method SET_TRAILING_DOCS($obj, $docs) {
  94. my $current_why := $obj.WHY;
  95. if $current_why {
  96. $current_why._add_trailing(~$docs);
  97. } else {
  98. $obj.set_why($docs);
  99. $*POD_BLOCKS.push($docs);
  100. }
  101. }
  102. method EXPORT_SYMBOL(\exp_name, @tags, Mu \sym) {
  103. my @export_packages = $*EXPORT;
  104. for flat nqp::hllize(@*PACKAGES) {
  105. unless .WHO.EXISTS-KEY('EXPORT') {
  106. .WHO<EXPORT> := Metamodel::PackageHOW.new_type(:name('EXPORT'));
  107. .WHO<EXPORT>.^compose;
  108. }
  109. @export_packages.append: .WHO<EXPORT>;
  110. }
  111. for @export_packages -> $p {
  112. for @tags -> $tag {
  113. my $install_in;
  114. if $p.WHO.EXISTS-KEY($tag) {
  115. $install_in := $p.WHO.{$tag};
  116. }
  117. else {
  118. $install_in := Metamodel::PackageHOW.new_type(:name($tag));
  119. $install_in.^compose;
  120. $p.WHO{$tag} := $install_in;
  121. }
  122. if $install_in.WHO.EXISTS-KEY(exp_name) {
  123. unless ($install_in.WHO){exp_name} =:= sym {
  124. X::Export::NameClash.new(symbol => exp_name).throw;
  125. }
  126. }
  127. $install_in.WHO{exp_name} := sym;
  128. }
  129. }
  130. 0;
  131. }
  132. method createENV(int $bind) {
  133. nqp::stmts(
  134. (my $hash := nqp::hash),
  135. (my $iter := nqp::iterator(nqp::getenvhash)),
  136. nqp::while(
  137. $iter,
  138. nqp::bindkey(
  139. $hash,
  140. nqp::iterkey_s(nqp::shift($iter)),
  141. nqp::if(
  142. $bind,
  143. val(nqp::iterval($iter)),
  144. nqp::p6scalarfromdesc(nqp::null) = val(nqp::iterval($iter))
  145. )
  146. )
  147. ),
  148. nqp::p6bindattrinvres(
  149. nqp::create(nqp::if($bind,Map,Hash)),Map,'$!storage',$hash
  150. )
  151. )
  152. }
  153. # Helper method for prefix:<let>/prefix:<temp>, which really do the same
  154. # thing apart from where they store data. Takes the IterationBuffer in
  155. # which to save data, the container to be inspected, and the type of op
  156. # for any error messaging.
  157. method TEMP-LET(\restore, \cont, str $localizer) is raw {
  158. nqp::stmts(
  159. (my int $i = nqp::elems(restore)),
  160. nqp::while(
  161. nqp::isgt_i($i,0),
  162. nqp::if(
  163. nqp::eqaddr(nqp::atpos(restore,($i = nqp::sub_i($i,2))),cont),
  164. (return-rw cont)
  165. )
  166. ),
  167. nqp::if(
  168. nqp::istype(cont,Failure),
  169. cont.exception.throw,
  170. nqp::stmts(
  171. nqp::push(restore,cont),
  172. nqp::if(
  173. nqp::iscont(cont),
  174. nqp::push(restore,nqp::decont(cont)),
  175. nqp::if(
  176. nqp::istype(cont,Array),
  177. nqp::push(restore,cont.clone),
  178. nqp::if(
  179. nqp::istype(cont,Hash),
  180. nqp::push(restore,
  181. nqp::p6bindattrinvres(
  182. Hash.^parameterize(Mu,Mu).new,
  183. Hash, '$!descriptor',
  184. nqp::getattr(cont, Hash, '$!descriptor')).STORE: cont),
  185. nqp::stmts(
  186. nqp::pop(restore), # lose the erroneously pushed value
  187. X::Localizer::NoContainer.new(:$localizer).throw
  188. )
  189. )
  190. )
  191. )
  192. )
  193. ),
  194. cont
  195. )
  196. }
  197. # fast whitespace trim: str to trim, str to store trimmed str
  198. method TRIM(\string, \trimmed --> Nil) {
  199. my int $pos = nqp::chars(string) - 1;
  200. my int $left =
  201. nqp::findnotcclass(nqp::const::CCLASS_WHITESPACE, string, 0, $pos + 1);
  202. $pos = $pos - 1
  203. while nqp::isge_i($pos, $left)
  204. && nqp::iscclass(nqp::const::CCLASS_WHITESPACE, string, $pos);
  205. trimmed = nqp::islt_i($pos, $left)
  206. ?? ''
  207. !! nqp::substr(string, $left, $pos + 1 - $left);
  208. Nil
  209. }
  210. # fast key:value split: Str to split, str to store key, str to store value
  211. method KEY_COLON_VALUE(Str $command, \key, \value --> Nil) {
  212. my str $str = nqp::unbox_s($command);
  213. my int $index = nqp::index($str,':');
  214. if nqp::isgt_i($index,0) {
  215. self.TRIM(nqp::substr($str,0,$index),key);
  216. self.TRIM(nqp::substr($str,$index + 1,nqp::chars($str) - $index),value);
  217. }
  218. elsif nqp::islt_i($index,0) {
  219. self.TRIM($str,key);
  220. value = '';
  221. }
  222. else {
  223. key = '';
  224. self.TRIM(nqp::substr($str,1,nqp::chars($str) - 1),value);
  225. }
  226. Nil
  227. }
  228. # key space value split: Str to split, str to store key, str to store value
  229. method KEY_SPACE_VALUE(Str $command, \key, \value --> Nil) {
  230. my str $str = nqp::unbox_s($command);
  231. my int $index = nqp::index($str,' ');
  232. if nqp::isgt_i($index,0) {
  233. key = nqp::substr($str,0,$index);
  234. value = nqp::substr($str,$index + 1,nqp::chars($str) - $index);
  235. }
  236. elsif nqp::islt_i($index,0) {
  237. key = $str;
  238. value = '';
  239. }
  240. else {
  241. key = '';
  242. value = nqp::substr($str,1,nqp::chars($str) - 1);
  243. }
  244. Nil
  245. }
  246. my $encodings := nqp::hash(
  247. # fast mapping for identicals
  248. 'utf8', 'utf8',
  249. 'utf16', 'utf16',
  250. 'utf32', 'utf32',
  251. 'ascii', 'ascii',
  252. 'iso-8859-1', 'iso-8859-1',
  253. 'windows-1252', 'windows-1252',
  254. 'windows-1251', 'windows-1251',
  255. # windows without dash
  256. 'windows1251', 'windows-1251',
  257. 'windows1252', 'windows-1252',
  258. # utf with dash
  259. 'utf-8', 'utf8',
  260. 'utf-16', 'utf16',
  261. 'utf-32', 'utf32',
  262. # according to http://de.wikipedia.org/wiki/ISO-8859-1
  263. 'iso_8859-1:1987', 'iso-8859-1',
  264. 'iso_8859-1', 'iso-8859-1',
  265. 'iso-ir-100', 'iso-8859-1',
  266. 'latin1', 'iso-8859-1',
  267. 'latin-1', 'iso-8859-1',
  268. 'csisolatin1', 'iso-8859-1',
  269. 'l1', 'iso-8859-1',
  270. 'ibm819', 'iso-8859-1',
  271. 'cp819', 'iso-8859-1',
  272. );
  273. method NORMALIZE_ENCODING(Str:D \encoding) {
  274. my str $key = nqp::unbox_s(encoding);
  275. if nqp::existskey($encodings,$key) {
  276. nqp::atkey($encodings,$key)
  277. }
  278. else {
  279. my str $lc = nqp::lc($key);
  280. nqp::existskey($encodings,$lc)
  281. ?? nqp::atkey($encodings,$lc)
  282. !! nqp::lc($key)
  283. }
  284. }
  285. # 1 if all elements of given type, otherwise 0
  286. method ALL_TYPE(\values,\type) {
  287. nqp::if(
  288. (my int $elems = values.elems), # reifies
  289. nqp::stmts(
  290. (my $values := nqp::getattr(values,List,'$!reified')),
  291. (my int $i = -1),
  292. nqp::while(
  293. nqp::islt_i(($i = nqp::add_i($i,1)),$elems)
  294. && nqp::istype(nqp::atpos($values,$i),type),
  295. nqp::null
  296. ),
  297. nqp::iseq_i($i,$elems)
  298. )
  299. )
  300. }
  301. # 1 if all elems defined && type, otherwise 0
  302. method ALL_DEFINED_TYPE(\values,\type) {
  303. nqp::if(
  304. (my int $elems = values.elems), # reifies
  305. nqp::stmts(
  306. (my $values := nqp::getattr(values,List,'$!reified')),
  307. (my int $i = -1),
  308. nqp::while(
  309. nqp::islt_i(($i = nqp::add_i($i,1)),$elems)
  310. && nqp::istype(nqp::atpos($values,$i),type)
  311. && nqp::defined(nqp::atpos($values,$i)),
  312. nqp::null
  313. ),
  314. nqp::iseq_i($i,$elems)
  315. )
  316. )
  317. }
  318. # 1 if any element of defined && type, otherwise 0
  319. method ANY_DEFINED_TYPE(\values,\type) {
  320. nqp::if(
  321. (my int $elems = values.elems), # reifies
  322. nqp::stmts(
  323. (my $values := nqp::getattr(values,List,'$!reified')),
  324. (my int $i = -1),
  325. nqp::until(
  326. nqp::iseq_i(($i = nqp::add_i($i,1)),$elems)
  327. || (nqp::istype(nqp::atpos($values,$i),type)
  328. && nqp::defined(nqp::atpos($values,$i))),
  329. nqp::null
  330. ),
  331. nqp::isne_i($i,$elems)
  332. )
  333. )
  334. }
  335. method TRANSPOSE(Str:D $string, Str:D $original, Str:D $final) {
  336. nqp::join($final,nqp::split($original,$string))
  337. }
  338. method TRANSPOSE-ONE(Str:D $string, Str:D $original, Str:D $final) {
  339. nqp::if(
  340. nqp::iseq_i((my int $index = nqp::index($string, $original)), -1),
  341. $string,
  342. nqp::concat(
  343. nqp::substr($string,0,$index),
  344. nqp::concat(
  345. $final,
  346. nqp::substr($string,nqp::add_i($index,nqp::chars($original)))
  347. )
  348. )
  349. )
  350. }
  351. my constant \SHAPE-STORAGE-ROOT := do {
  352. my Mu $root := nqp::newtype(nqp::knowhow(), 'Uninstantiable');
  353. nqp::setparameterizer($root, -> $, $key {
  354. my $dims := $key.elems.pred;
  355. my $type := $key.AT-POS(1);
  356. my $dim_type := nqp::newtype($key.AT-POS(0), 'MultiDimArray');
  357. nqp::composetype($dim_type, nqp::hash('array',
  358. nqp::hash('dimensions', $dims, 'type', $type)));
  359. nqp::settypehll($dim_type, 'perl6');
  360. $dim_type
  361. });
  362. nqp::settypehll($root, 'perl6');
  363. $root
  364. }
  365. method SHAPED-ARRAY-STORAGE(\spec, Mu \meta-obj, Mu \type) {
  366. nqp::stmts(
  367. (my $types := nqp::list(meta-obj)), # meta + type of each dimension
  368. (my $dims := nqp::list_i), # elems per dimension
  369. nqp::if(
  370. nqp::istype(spec,List),
  371. nqp::stmts( # potentially more than 1 dim
  372. (my $spec := nqp::getattr(nqp::decont(spec),List,'$!reified')),
  373. (my int $elems = nqp::elems($spec)),
  374. (my int $i = -1),
  375. nqp::while(
  376. nqp::islt_i(($i = nqp::add_i($i,1)),$elems),
  377. nqp::if(
  378. nqp::istype((my $dim := nqp::atpos($spec,$i)),Whatever),
  379. X::NYI.new(feature => 'Jagged array shapes').throw,
  380. nqp::if(
  381. nqp::isbig_I(nqp::decont($dim := nqp::decont($dim.Int)))
  382. || nqp::isle_i($dim,0),
  383. X::IllegalDimensionInShape.new(:$dim).throw,
  384. nqp::stmts(
  385. nqp::push($types,type),
  386. nqp::push_i($dims,$dim)
  387. )
  388. )
  389. )
  390. )
  391. ),
  392. nqp::stmts( # only 1 dim
  393. nqp::push($types,type),
  394. nqp::push_i($dims,spec.Int)
  395. )
  396. ),
  397. nqp::setdimensions(
  398. nqp::create(nqp::parameterizetype(SHAPE-STORAGE-ROOT,$types)),
  399. $dims
  400. )
  401. )
  402. }
  403. our role ShapedArrayCommon {
  404. method !illegal($operation) {
  405. X::IllegalOnFixedDimensionArray.new(:$operation).throw
  406. }
  407. proto method pop(::?CLASS:D: |) { self!illegal("pop") }
  408. proto method shift(::?CLASS:D: |) { self!illegal("shift") }
  409. proto method splice(::?CLASS:D: |) { self!illegal("splice") }
  410. proto method push(|c) is nodal {
  411. self.DEFINITE ?? self!illegal("push") !! self.Any::push(|c)
  412. }
  413. proto method append(|c) is nodal {
  414. self.DEFINITE ?? self!illegal("append") !! self.Any::append(|c)
  415. }
  416. proto method unshift(|c) is nodal {
  417. self.DEFINITE ?? self!illegal("unshift") !! self.Any::unshift(|c)
  418. }
  419. proto method prepend(|c) is nodal {
  420. self.DEFINITE ?? self!illegal("prepend") !! self.Any::prepend(|c)
  421. }
  422. multi method STORE(::?CLASS:D: Slip:D \slip) {
  423. nqp::if(
  424. nqp::eqaddr(slip,Empty),
  425. (die "Cannot Empty a shaped array as its size is fixed"),
  426. self.STORE(slip.List)
  427. )
  428. }
  429. # illegal unless overridden for 1dimmed case
  430. method reverse(::?CLASS:D: |) { self!illegal("reverse") }
  431. method rotate(::?CLASS:D: |) { self!illegal("rotate") }
  432. multi method values(::?CLASS:D:) { Seq.new(self.iterator) }
  433. multi method keys(::?CLASS:D:) {
  434. Seq.new(Rakudo::Iterator.ShapeIndex(self.shape))
  435. }
  436. multi method invert(::?CLASS:D:) {
  437. Seq.new(Rakudo::Iterator.Invert(self.pairs.iterator))
  438. }
  439. # These work on the flat view
  440. method roll(|c) { self.flat.roll(|c) }
  441. method pick(|c) { self.flat.pick(|c) }
  442. method permutations(|c) { self.flat.permutations(|c) }
  443. method combinations(|c) { self.flat.combinations(|c) }
  444. method join(|c) { self.flat.join(|c) }
  445. method sort(|c) { self.flat.sort(|c) }
  446. multi method gist(::?CLASS:D:) {
  447. self.gistseen('Array', { self!gist([], self.shape) })
  448. }
  449. method !gist(@path, @dims) {
  450. if @dims.elems == 1 {
  451. '[' ~ (^@dims[0]).map({ self.AT-POS(|@path, $_).gist }).join(' ') ~ ']';
  452. }
  453. else {
  454. my @nextdims = @dims[1..^@dims.elems];
  455. '[' ~ (^@dims[0]).map({ self!gist((flat @path, $_), @nextdims) }).join(' ') ~ ']';
  456. }
  457. }
  458. multi method perl(::?CLASS:D \SELF:) {
  459. SELF.perlseen('Array', {
  460. self.^name
  461. ~ '.new(:shape'
  462. ~ nqp::decont(self.shape).perl
  463. ~ ', '
  464. ~ self!perl([], self.shape)
  465. ~ ')'
  466. ~ (nqp::iscont(SELF) ?? '.item' !! '')
  467. })
  468. }
  469. method !perl(@path, @dims) {
  470. if @dims.elems == 1 {
  471. '[' ~
  472. (^@dims[0]).map({ nqp::decont(self.AT-POS(|@path, $_)).perl }).join(', ') ~
  473. ',' x (@dims[0] == 1 && nqp::istype(self.AT-POS(|@path, 0), Iterable)) ~
  474. ']'
  475. }
  476. else {
  477. my @nextdims = @dims[1..^@dims.elems];
  478. '[' x (@path.elems > 0) ~
  479. (^@dims[0]).map({ self!perl((flat @path, $_), @nextdims) }).join(', ') ~
  480. ',' x (@dims[0] == 1) ~
  481. ']' x (@path.elems > 0)
  482. }
  483. }
  484. multi method Slip() {
  485. Slip.from-iterator(self.iterator)
  486. }
  487. proto method AT-POS(|) is raw {*}
  488. multi method AT-POS(::?CLASS:U: |c) is raw {
  489. self.Any::AT-POS(|c)
  490. }
  491. multi method AT-POS(::?CLASS:D:) is raw {
  492. die "Must specify at least one index with {self.^name}.AT-POS"
  493. }
  494. proto method ASSIGN-POS(|) {*}
  495. multi method ASSIGN-POS(::?CLASS:U: |c) {
  496. self.Any::ASSIGN-POS(|c)
  497. }
  498. multi method ASSIGN-POS(::?CLASS:D:) {
  499. die "Must specify at least one index and a value with {self.^name}.ASSIGN-POS"
  500. }
  501. multi method ASSIGN-POS(::?CLASS:D: $) {
  502. die "Must specify at least one index and a value with {self.^name}.ASSIGN-POS"
  503. }
  504. proto method EXISTS-POS(|) {*}
  505. multi method EXISTS-POS(::?CLASS:U: |c) {
  506. self.Any::EXISTS-POS(|c)
  507. }
  508. multi method EXISTS-POS(::?CLASS:D:) {
  509. die "Must specify at least one index with {self.^name}.EXISTS-POS"
  510. }
  511. }
  512. our class SupplySequencer {
  513. has &!on-data-ready;
  514. has &!on-completed;
  515. has &!on-error;
  516. has $!buffer;
  517. has int $!buffer-start-seq;
  518. has int $!done-target;
  519. has int $!bust;
  520. has $!lock;
  521. submethod BUILD(
  522. :&!on-data-ready!, :&!on-completed!, :&!on-error! --> Nil) {
  523. $!buffer := nqp::list();
  524. $!buffer-start-seq = 0;
  525. $!done-target = -1;
  526. $!bust = 0;
  527. $!lock := Lock::Async.new;
  528. }
  529. method process(Mu \seq, Mu \data, Mu \err) {
  530. $!lock.protect: {
  531. if err {
  532. &!on-error(err);
  533. $!bust = 1;
  534. }
  535. elsif nqp::isconcrete(data) {
  536. my int $insert-pos = seq - $!buffer-start-seq;
  537. nqp::bindpos($!buffer, $insert-pos, data);
  538. self!emit-events();
  539. }
  540. else {
  541. $!done-target = seq;
  542. self!emit-events();
  543. }
  544. }
  545. }
  546. method !emit-events() {
  547. unless $!bust {
  548. until nqp::elems($!buffer) == 0 || nqp::isnull(nqp::atpos($!buffer, 0)) {
  549. &!on-data-ready(nqp::shift($!buffer));
  550. $!buffer-start-seq = $!buffer-start-seq + 1;
  551. }
  552. if $!buffer-start-seq == $!done-target {
  553. &!on-completed();
  554. }
  555. }
  556. }
  557. }
  558. my int $sprintfHandlerInitialized = 0;
  559. method initialize-sprintf-handler(--> Nil) {
  560. class SprintfHandler {
  561. method mine($x) { nqp::reprname($x) eq "P6opaque"; }
  562. proto method int(|) {*}
  563. multi method int(Mu:D \n) { n.Int }
  564. multi method int(Mu:U \n) { n.Numeric.Int }
  565. proto method float(|) {*}
  566. multi method float(Numeric:D \n) { n }
  567. multi method float(Mu \n) { n.Numeric }
  568. }
  569. unless $sprintfHandlerInitialized {
  570. nqp::sprintfaddargumenthandler(SprintfHandler.new);
  571. $sprintfHandlerInitialized = 1;
  572. }
  573. }
  574. method SHORT-GIST(\thing) {
  575. nqp::if(
  576. nqp::isgt_i(nqp::chars(my str $gist = thing.gist), 23),
  577. nqp::concat(nqp::substr($gist, 0, 20), '...'),
  578. $gist);
  579. }
  580. method SUBSTR-START-OOR(\from,\max) {
  581. Failure.new(X::OutOfRange.new(
  582. :what('Start argument to substr'),
  583. :got(from.gist),
  584. :range("0.." ~ max),
  585. :comment( nqp::istype(from, Callable) || -from > max
  586. ?? ''
  587. !! "use *-{abs from} if you want to index relative to the end"),
  588. ))
  589. }
  590. method SUBSTR-CHARS-OOR(\chars) {
  591. Failure.new(X::OutOfRange.new(
  592. :what('Number of characters argument to substr'),
  593. :got(chars.gist),
  594. :range<0..^Inf>,
  595. :comment("use *-{abs chars} if you want to index relative to the end"),
  596. ))
  597. }
  598. my $IS-WIN = do {
  599. my str $os = Rakudo::Internals.TRANSPOSE(nqp::lc(
  600. nqp::atkey(nqp::backendconfig,'osname')
  601. )," ","");
  602. nqp::p6bool(
  603. nqp::iseq_s($os,'mswin32')
  604. || nqp::iseq_s($os,'mingw')
  605. || nqp::iseq_s($os,'msys')
  606. || nqp::iseq_s($os,'cygwin')
  607. )
  608. }
  609. method IS-WIN() { $IS-WIN }
  610. method NUMERIC-ENV-KEY(\key) {
  611. %*ENV.EXISTS-KEY(key)
  612. ?? %*ENV.AT-KEY(key)
  613. ?? +%*ENV.AT-KEY(key)
  614. !! 0
  615. !! Nil
  616. }
  617. method error-rcgye() { # red clear green yellow eject
  618. self.NUMERIC-ENV-KEY("RAKUDO_ERROR_COLOR") // !self.IS-WIN
  619. ?? ("\e[31m", "\e[0m", "\e[32m", "\e[33m", "\x[23CF]")
  620. !! ("", "", "", "", "<HERE>");
  621. }
  622. my num $init-time-num = nqp::time_n;
  623. method INITTIME() is raw { $init-time-num }
  624. my $init-thread := nqp::currentthread();
  625. method INITTHREAD() { $init-thread }
  626. my $escapes := nqp::hash(
  627. "\0", '\0',
  628. '$', '\$',
  629. '@', '\@',
  630. '%', '\%',
  631. '&', '\&',
  632. '{', '\{',
  633. "\b", '\b',
  634. "\x0A", '\n',
  635. "\r", '\r',
  636. "\t", '\t',
  637. '"', '\"',
  638. '\\', '\\\\',
  639. );
  640. method PERLIFY-STR(Str \string) {
  641. sub char-to-escapes(Str $char) is pure {
  642. '\x[' ~ $char.NFC.list.map({.base: 16}).join(',') ~ ']'
  643. }
  644. # Under NFG-supporting implementations, must be sure that any leading
  645. # combiners are escaped, otherwise they will be combined onto the "
  646. # under concatenation closure, which ruins round-tripping. Also handle
  647. # the \r\n grapheme correctly.
  648. my str $to-escape = nqp::unbox_s(string);
  649. my str $escaped = '';
  650. my int $chars = nqp::chars($to-escape);
  651. my int $i = -1;
  652. while ($i = $i + 1) < $chars {
  653. my str $char = nqp::substr($to-escape, $i, 1);
  654. my int $ord = nqp::ord($char);
  655. $escaped ~= nqp::isge_i($ord,256)
  656. && +uniprop($ord,'Canonical_Combining_Class')
  657. ?? char-to-escapes($char)
  658. !! nqp::iseq_s($char,"\r\n") ?? '\r\n' !!
  659. nqp::existskey($escapes,$char)
  660. ?? nqp::atkey($escapes,$char)
  661. !! nqp::iscclass(nqp::const::CCLASS_PRINTING,$char,0)
  662. ?? $char
  663. !! char-to-escapes($char);
  664. }
  665. $escaped
  666. }
  667. # easy access to compile options
  668. my Mu $compiling-options := nqp::atkey(%*COMPILING, '%?OPTIONS');
  669. # running with --ll-exception
  670. method LL-EXCEPTION() {
  671. nqp::existskey($compiling-options, 'll-exception')
  672. ?? '--ll-exception'
  673. !! Empty
  674. }
  675. # running with --profile
  676. method PROFILE() {
  677. nqp::existskey($compiling-options, 'profile')
  678. ?? '--profile'
  679. !! Empty
  680. }
  681. # running with --optimize=X
  682. method OPTIMIZE() {
  683. nqp::existskey($compiling-options, 'optimize')
  684. ?? '--optimize=' ~ nqp::atkey($compiling-options, 'optimize')
  685. !! Empty
  686. }
  687. # whatever specified with -I
  688. method INCLUDE() {
  689. nqp::existskey($compiling-options,'I')
  690. ?? do {
  691. my $I := nqp::atkey($compiling-options,'I');
  692. nqp::islist($I) ?? $I !! nqp::list($I)
  693. }
  694. !! nqp::list()
  695. }
  696. method PRECOMP-EXT() { "moarvm" }
  697. method PRECOMP-TARGET() { "mbc" }
  698. method get-local-timezone-offset() {
  699. my $utc = time;
  700. my Mu $fia := nqp::p6decodelocaltime(nqp::unbox_i($utc));
  701. DateTime.new(
  702. :year(nqp::atpos_i($fia,5)),
  703. :month(nqp::atpos_i($fia,4)),
  704. :day(nqp::atpos_i($fia,3)),
  705. :hour(nqp::atpos_i($fia,2)),
  706. :minute(nqp::atpos_i($fia,1)),
  707. :second(nqp::atpos_i($fia,0)),
  708. ).posix(True) - $utc;
  709. }
  710. # Keep track of the differences between TAI and UTC for internal use.
  711. # The "BEGIN" and "END" comments are for tools/update-tai-utc.pl.
  712. #
  713. # Some handy tables:
  714. # http://tf.nist.gov/pubs/bulletin/leapsecond.htm
  715. # http://hpiers.obspm.fr/eop-pc/earthor/utc/TAI-UTC_tab.html
  716. my int $initial-offset = 10;
  717. # TAI - UTC at the Unix epoch (1970-01-01T00:00:00Z).
  718. my $dates := nqp::list_s(
  719. #BEGIN leap-second-dates
  720. '1972-06-30',
  721. '1972-12-31',
  722. '1973-12-31',
  723. '1974-12-31',
  724. '1975-12-31',
  725. '1976-12-31',
  726. '1977-12-31',
  727. '1978-12-31',
  728. '1979-12-31',
  729. '1981-06-30',
  730. '1982-06-30',
  731. '1983-06-30',
  732. '1985-06-30',
  733. '1987-12-31',
  734. '1989-12-31',
  735. '1990-12-31',
  736. '1992-06-30',
  737. '1993-06-30',
  738. '1994-06-30',
  739. '1995-12-31',
  740. '1997-06-30',
  741. '1998-12-31',
  742. '2005-12-31',
  743. '2008-12-31',
  744. '2012-06-30',
  745. '2015-06-30',
  746. '2016-12-31',
  747. #END leap-second-dates
  748. );
  749. # our %leap-seconds =
  750. # @leap-second-dates Z=> $initial-offset + 1 .. *;
  751. # So for any date $d in @leap-second-dates, $d 23:59:00 UTC
  752. # is the leap second that made (or will make) UTC
  753. # %leap-seconds{$d} seconds behind TAI.
  754. # Ambiguous POSIX times.
  755. my $posixes := nqp::list_i(
  756. #BEGIN leap-second-posix
  757. 78796800,
  758. 94694400,
  759. 126230400,
  760. 157766400,
  761. 189302400,
  762. 220924800,
  763. 252460800,
  764. 283996800,
  765. 315532800,
  766. 362793600,
  767. 394329600,
  768. 425865600,
  769. 489024000,
  770. 567993600,
  771. 631152000,
  772. 662688000,
  773. 709948800,
  774. 741484800,
  775. 773020800,
  776. 820454400,
  777. 867715200,
  778. 915148800,
  779. 1136073600,
  780. 1230768000,
  781. 1341100800,
  782. 1435708800,
  783. 1483228800,
  784. #END leap-second-posix
  785. );
  786. my int $elems = nqp::elems($dates);
  787. method is-leap-second-date(\date) {
  788. nqp::p6bool(
  789. nqp::stmts(
  790. (my str $date = date),
  791. (my int $i = -1),
  792. nqp::while(
  793. nqp::islt_i(($i = nqp::add_i($i,1)),$elems)
  794. && nqp::isgt_s($date,nqp::atpos_s($dates,$i)),
  795. nqp::null
  796. ),
  797. nqp::islt_i($i,$elems) && nqp::iseq_s($date,nqp::atpos_s($dates,$i))
  798. )
  799. )
  800. }
  801. method tai-from-posix(\posix, int $prefer-leap-second) {
  802. nqp::stmts(
  803. (my int $p = posix.floor),
  804. (my int $i = -1),
  805. nqp::while(
  806. nqp::islt_i(($i = nqp::add_i($i,1)),$elems)
  807. && nqp::isgt_i($p,nqp::atpos_i($posixes,$i)),
  808. nqp::null
  809. ),
  810. posix + nqp::add_i(
  811. nqp::add_i($initial-offset,$i),
  812. nqp::islt_i($i,$elems)
  813. && nqp::not_i($prefer-leap-second)
  814. && nqp::iseq_i($p,nqp::atpos_i($posixes,$i))
  815. )
  816. )
  817. }
  818. method posix-from-tai(\tai) {
  819. nqp::stmts(
  820. (my int $t = tai.floor - $initial-offset),
  821. (my int $i = -1),
  822. nqp::while(
  823. nqp::islt_i(($i = nqp::add_i($i,1)),$elems)
  824. && nqp::islt_i(nqp::atpos_i($posixes,$i),nqp::sub_i($t,$i)),
  825. nqp::null
  826. ),
  827. (tai - nqp::add_i($initial-offset,$i),
  828. nqp::p6bool(
  829. nqp::islt_i($i,$elems)
  830. && nqp::iseq_i(nqp::atpos_i($posixes,$i),nqp::sub_i($t,$i))
  831. )
  832. )
  833. )
  834. }
  835. my $initializers;
  836. #nqp::print("running mainline\n");
  837. #method INITIALIZERS() { $initializers }
  838. method REGISTER-DYNAMIC(Str:D \name, &code, Str $version = '6.c' --> Nil) {
  839. #nqp::say('Registering ' ~ name);
  840. nqp::stmts(
  841. (my str $with = nqp::concat($version, nqp::concat("\0", name))),
  842. nqp::if(
  843. nqp::existskey(
  844. nqp::unless($initializers,$initializers := nqp::hash),
  845. $with
  846. ),
  847. (die "Already have initializer for '{name}' ('$version')"),
  848. nqp::bindkey($initializers,$with,&code)
  849. ),
  850. nqp::unless( # first come, first kept
  851. nqp::existskey($initializers,nqp::unbox_s(name)),
  852. nqp::bindkey($initializers,nqp::unbox_s(name),&code)
  853. )
  854. )
  855. }
  856. method INITIALIZE-DYNAMIC(str \name) is raw {
  857. #nqp::say('Initializing ' ~ name);
  858. nqp::stmts(
  859. (my str $with = nqp::concat(
  860. nqp::getcomp('perl6').language_version, nqp::concat("\0", name))),
  861. nqp::if(
  862. nqp::existskey(
  863. nqp::unless($initializers,$initializers := nqp::hash),
  864. $with
  865. ),
  866. nqp::atkey($initializers,$with)(),
  867. nqp::if(
  868. nqp::existskey($initializers,name),
  869. nqp::atkey($initializers,name)(),
  870. Failure.new(X::Dynamic::NotFound.new(:name(name)))
  871. )
  872. )
  873. )
  874. }
  875. method EXPAND-LITERAL-RANGE(Str:D \x,$list) {
  876. my str $s = nqp::unbox_s(x);
  877. my int $chars = nqp::chars($s);
  878. my Mu $result := nqp::list();
  879. my int $start = 1;
  880. my int $found = nqp::index($s,'..',$start);
  881. # found and not at the end without trail
  882. while nqp::isne_i($found,-1) && nqp::isne_i($found,$chars-2) {
  883. if $found - $start -> $unsplit {
  884. nqp::splice(
  885. $result,
  886. nqp::split("",nqp::substr($s,$start - 1,$unsplit)),
  887. nqp::elems($result),
  888. 0
  889. )
  890. }
  891. # add the range excluding last (may be begin point next range)
  892. my int $from = nqp::ordat($s,$found - 1) - 1;
  893. my int $to = nqp::ordat($s,$found + 2);
  894. nqp::push($result,nqp::chr($from))
  895. while nqp::islt_i($from = $from + 1,$to);
  896. # look for next range
  897. $found = nqp::index($s,'..',$start = $found + 3);
  898. }
  899. # add final bits
  900. nqp::splice(
  901. $result,
  902. nqp::split("",nqp::substr($s,$start - 1)),
  903. nqp::elems($result),
  904. 0
  905. ) if nqp::isle_i($start,$chars);
  906. $list ?? $result !! nqp::join("",$result)
  907. }
  908. my int $VERBATIM-EXCEPTION = 0;
  909. method VERBATIM-EXCEPTION($set?) {
  910. my int $value = $VERBATIM-EXCEPTION;
  911. $VERBATIM-EXCEPTION = $set if defined($set);
  912. $value
  913. }
  914. method MAKE-ABSOLUTE-PATH(Str:D $path, Str:D $abspath) {
  915. if $path.ord == 47 { # 4x faster substr($path,0,1) eq "/"
  916. $path
  917. }
  918. elsif $path.substr-eq(":",1) { # assume C: something
  919. if $path.substr-eq("/",2) { # assume C:/ like prefix
  920. $path
  921. }
  922. elsif !$abspath.starts-with(substr($path,0,2)) {
  923. die "Can not set relative dir from different roots";
  924. }
  925. else {
  926. $abspath ~ substr($path,2)
  927. }
  928. }
  929. else { # assume relative path
  930. $abspath ~ $path;
  931. }
  932. }
  933. method MAKE-BASENAME(Str:D \abspath) {
  934. my str $abspath = nqp::unbox_s(abspath);
  935. my int $offset = nqp::rindex($abspath,'/');
  936. nqp::iseq_i($offset,-1)
  937. ?? abspath
  938. !! nqp::p6box_s(nqp::substr($abspath,$offset + 1));
  939. }
  940. my $clean-parts-nul := nqp::hash( '..', 1, '.', 1, '', 1);
  941. method MAKE-CLEAN-PARTS(Str:D \abspath) {
  942. my str $abspath = nqp::unbox_s(abspath);
  943. my $parts := nqp::split('/',$abspath);
  944. # handle //unc/ on win
  945. if nqp::iseq_s(nqp::atpos($parts,1),'') # //
  946. && nqp::iseq_s(nqp::atpos($parts,0),'') { # and no C: like stuff
  947. my str $front = nqp::join('/',nqp::list( # collapse to '//unc/'
  948. nqp::atpos($parts,0),
  949. nqp::atpos($parts,1),
  950. nqp::atpos($parts,2),
  951. ));
  952. nqp::splice($parts,nqp::list($front),0,3); # and replace
  953. }
  954. # front part cleanup
  955. nqp::splice($parts,$empty,1,1)
  956. while nqp::existskey($clean-parts-nul,nqp::atpos($parts,1));
  957. # recursive ".." and "." handling
  958. sub updirs($index is copy) {
  959. # the end
  960. if $index == 1 {
  961. nqp::splice($parts,$empty,1,1);
  962. 1
  963. }
  964. # something to check
  965. elsif nqp::atpos($parts,$index - 1) -> $part {
  966. if nqp::iseq_i(nqp::ord($part),46) { # substr($part,0,1) eq '.'
  967. if nqp::iseq_s($part,'..') {
  968. updirs($index - 1);
  969. }
  970. elsif nqp::iseq_s($part,'.') {
  971. nqp::splice($parts,$empty,$index,1);
  972. updirs($index - 1);
  973. }
  974. else {
  975. nqp::splice($parts,$empty,--$index,2);
  976. $index;
  977. }
  978. }
  979. else {
  980. nqp::splice($parts,$empty,--$index,2);
  981. $index;
  982. }
  983. }
  984. # nul, just ignore
  985. else {
  986. nqp::splice($parts,$empty,$index,1);
  987. updirs($index);
  988. }
  989. }
  990. # back part cleanup
  991. my int $checks = nqp::elems($parts) - 1;
  992. while nqp::isgt_i($checks,1) {
  993. if nqp::atpos($parts,$checks) -> $part {
  994. nqp::iseq_s($part,'..')
  995. ?? ($checks = updirs($checks))
  996. !! nqp::iseq_s($part,'.')
  997. ?? nqp::splice($parts,$empty,$checks--,1)
  998. !! --$checks;
  999. }
  1000. else {
  1001. nqp::splice($parts,$empty,$checks--,1);
  1002. }
  1003. }
  1004. # need / at the end
  1005. nqp::push($parts,"");
  1006. $parts
  1007. }
  1008. method REMOVE-ROOT(Str:D \root, Str:D \path) {
  1009. my str $root = nqp::unbox_s(root);
  1010. my str $path = nqp::unbox_s(path);
  1011. nqp::eqat($path,$root,0)
  1012. ?? nqp::p6box_s(nqp::substr($path,nqp::chars($root)))
  1013. !! path;
  1014. }
  1015. method DIR-RECURSE(
  1016. \abspath,
  1017. Mu :$dir = -> str $elem { nqp::not_i(nqp::eqat($elem,'.',0)) },
  1018. Mu :$file = True
  1019. ) {
  1020. Seq.new(class :: does Iterator {
  1021. has str $!abspath;
  1022. has $!handle;
  1023. has $!dir;
  1024. has $!file,
  1025. has str $!dir-sep;
  1026. has $!todo;
  1027. has $!seen;
  1028. method !SET-SELF(\abspath,$!dir,$!file) {
  1029. nqp::stmts(
  1030. ($!abspath = abspath),
  1031. ($!handle := nqp::opendir($!abspath)),
  1032. ($!dir-sep = $*SPEC.dir-sep),
  1033. ($!todo := nqp::list_s),
  1034. ($!seen := nqp::hash($!abspath,1)),
  1035. ($!abspath = nqp::concat($!abspath,$!dir-sep)),
  1036. self
  1037. )
  1038. }
  1039. method new(\abspath,\dir,\file) {
  1040. nqp::if(
  1041. nqp::stat(abspath,nqp::const::STAT_EXISTS)
  1042. && nqp::stat(abspath,nqp::const::STAT_ISDIR),
  1043. nqp::create(self)!SET-SELF(abspath,dir,file),
  1044. Rakudo::Iterator.Empty
  1045. )
  1046. }
  1047. method !next() {
  1048. nqp::while(
  1049. nqp::isnull_s(my str $elem = nqp::nextfiledir($!handle))
  1050. || nqp::iseq_i(nqp::chars($elem),0),
  1051. nqp::stmts(
  1052. nqp::closedir($!handle),
  1053. nqp::if(
  1054. nqp::elems($!todo),
  1055. nqp::stmts(
  1056. ($!abspath = nqp::pop_s($!todo)),
  1057. ($!handle := nqp::opendir($!abspath)),
  1058. ($!abspath = nqp::concat($!abspath,$!dir-sep))
  1059. ),
  1060. return ''
  1061. )
  1062. )
  1063. );
  1064. $elem
  1065. }
  1066. method pull-one() {
  1067. nqp::while(
  1068. nqp::chars(my str $entry = self!next),
  1069. nqp::if(
  1070. nqp::stat(
  1071. (my str $path = nqp::concat($!abspath,$entry)),
  1072. nqp::const::STAT_EXISTS
  1073. ),
  1074. nqp::if(
  1075. nqp::stat($path,nqp::const::STAT_ISREG)
  1076. && $!file.ACCEPTS($entry),
  1077. (return $path),
  1078. nqp::if(
  1079. nqp::stat($path,nqp::const::STAT_ISDIR)
  1080. && $!dir.ACCEPTS($entry),
  1081. nqp::stmts(
  1082. nqp::if(
  1083. nqp::fileislink($path),
  1084. $path = IO::Path.new(
  1085. $path,:CWD($!abspath)).resolve.absolute
  1086. ),
  1087. nqp::unless(
  1088. nqp::existskey($!seen,$path),
  1089. nqp::stmts(
  1090. nqp::bindkey($!seen,$path,1),
  1091. nqp::push_s($!todo,$path)
  1092. )
  1093. )
  1094. )
  1095. )
  1096. )
  1097. )
  1098. );
  1099. IterationEnd
  1100. }
  1101. }.new(abspath,$dir,$file))
  1102. }
  1103. method FILETEST-E(Str:D \abspath) {
  1104. nqp::stat(nqp::unbox_s(abspath),nqp::const::STAT_EXISTS)
  1105. }
  1106. method FILETEST-LE(Str:D \abspath) {
  1107. nqp::lstat(nqp::unbox_s(abspath),nqp::const::STAT_EXISTS)
  1108. }
  1109. method FILETEST-D(Str:D \abspath) {
  1110. my int $d = nqp::stat(nqp::unbox_s(abspath),nqp::const::STAT_ISDIR);
  1111. nqp::isge_i($d,0)
  1112. ?? $d
  1113. !! Failure.new(X::IO::Unknown.new(:trying<d>))
  1114. }
  1115. method FILETEST-F(Str:D \abspath) {
  1116. my int $f = nqp::stat(nqp::unbox_s(abspath),nqp::const::STAT_ISREG);
  1117. nqp::isge_i($f,0)
  1118. ?? $f
  1119. !! Failure.new(X::IO::Unknown.new(:trying<f>))
  1120. }
  1121. method FILETEST-S(Str:D \abspath) {
  1122. nqp::stat(nqp::unbox_s(abspath),nqp::const::STAT_FILESIZE)
  1123. }
  1124. method FILETEST-L(Str:D \abspath) {
  1125. my int $l = nqp::fileislink(nqp::unbox_s(abspath));
  1126. nqp::isge_i($l,0)
  1127. ?? $l
  1128. !! Failure.new(X::IO::Unknown.new(:trying<l>))
  1129. }
  1130. method FILETEST-R(Str:D \abspath) {
  1131. my int $r = nqp::filereadable(nqp::unbox_s(abspath));
  1132. nqp::isge_i($r,0)
  1133. ?? $r
  1134. !! Failure.new(X::IO::Unknown.new(:trying<r>))
  1135. }
  1136. method FILETEST-W(Str:D \abspath) {
  1137. my int $w = nqp::filewritable(nqp::unbox_s(abspath));
  1138. nqp::isge_i($w,0)
  1139. ?? $w
  1140. !! Failure.new(X::IO::Unknown.new(:trying<w>))
  1141. }
  1142. method FILETEST-RW(Str:D \abspath) {
  1143. my str $abspath = nqp::unbox_s(abspath);
  1144. my int $r = nqp::filereadable($abspath);
  1145. my int $w = nqp::filewritable($abspath);
  1146. nqp::isge_i($r,0)
  1147. ?? nqp::isge_i($w,0)
  1148. ?? nqp::bitand_i($r,$w)
  1149. !! Failure.new(X::IO::Unknown.new(:trying<w>))
  1150. !! Failure.new(X::IO::Unknown.new(:trying<r>))
  1151. }
  1152. method FILETEST-X(Str:D \abspath) {
  1153. my int $x = nqp::fileexecutable(nqp::unbox_s(abspath));
  1154. nqp::isge_i($x,0)
  1155. ?? $x
  1156. !! Failure.new(X::IO::Unknown.new(:trying<x>))
  1157. }
  1158. method FILETEST-RWX(Str:D \abspath) {
  1159. my str $abspath = nqp::unbox_s(abspath);
  1160. my int $r = nqp::filereadable($abspath);
  1161. my int $w = nqp::filewritable($abspath);
  1162. my int $x = nqp::fileexecutable($abspath);
  1163. nqp::isge_i($r,0)
  1164. ?? nqp::isge_i($w,0)
  1165. ?? nqp::isge_i($x,0)
  1166. ?? nqp::bitand_i(nqp::bitand_i($r,$w),$x)
  1167. !! Failure.new(X::IO::Unknown.new(:trying<x>))
  1168. !! Failure.new(X::IO::Unknown.new(:trying<w>))
  1169. !! Failure.new(X::IO::Unknown.new(:trying<r>))
  1170. }
  1171. method FILETEST-Z(Str:D \abspath) {
  1172. nqp::iseq_i(
  1173. nqp::stat(nqp::unbox_s(abspath),nqp::const::STAT_FILESIZE),0)
  1174. }
  1175. method FILETEST-MODIFIED(Str:D \abspath) {
  1176. nqp::stat_time(nqp::unbox_s(abspath), nqp::const::STAT_MODIFYTIME)
  1177. }
  1178. method FILETEST-ACCESSED(Str:D \abspath) {
  1179. nqp::stat_time(nqp::unbox_s(abspath), nqp::const::STAT_ACCESSTIME)
  1180. }
  1181. method FILETEST-CHANGED(Str:D \abspath) {
  1182. nqp::stat_time(nqp::unbox_s(abspath), nqp::const::STAT_CHANGETIME)
  1183. }
  1184. method HANDLE-NQP-SPRINTF-ERRORS(Mu \exception) {
  1185. my $vmex := nqp::getattr(nqp::decont(exception), Exception, '$!ex');
  1186. my \payload := nqp::getpayload($vmex);
  1187. if nqp::elems(payload) == 1 {
  1188. if nqp::existskey(payload, 'BAD_TYPE_FOR_DIRECTIVE') {
  1189. X::Str::Sprintf::Directives::BadType.new:
  1190. type => nqp::atkey(nqp::atkey(payload, 'BAD_TYPE_FOR_DIRECTIVE'), 'TYPE'),
  1191. directive => nqp::atkey(nqp::atkey(payload, 'BAD_TYPE_FOR_DIRECTIVE'), 'DIRECTIVE'),
  1192. }
  1193. elsif nqp::existskey(payload, 'BAD_DIRECTIVE') {
  1194. X::Str::Sprintf::Directives::Unsupported.new:
  1195. directive => nqp::atkey(nqp::atkey(payload, 'BAD_DIRECTIVE'), 'DIRECTIVE'),
  1196. sequence => nqp::atkey(nqp::atkey(payload, 'BAD_DIRECTIVE'), 'SEQUENCE'),
  1197. }
  1198. elsif nqp::existskey(payload, 'DIRECTIVES_COUNT') {
  1199. X::Str::Sprintf::Directives::Count.new:
  1200. args-have => nqp::atkey(nqp::atkey(payload, 'DIRECTIVES_COUNT'), 'ARGS_HAVE'),
  1201. args-used => nqp::atkey(nqp::atkey(payload, 'DIRECTIVES_COUNT'), 'ARGS_USED'),
  1202. }
  1203. else { exception }
  1204. }
  1205. else { exception }
  1206. }
  1207. #- start of generated part of succ/pred ---------------------------------------
  1208. #- Generated on 2016-08-10T14:19:20+02:00 by tools/build/makeMAGIC_INC_DEC.pl6
  1209. #- PLEASE DON'T CHANGE ANYTHING BELOW THIS LINE
  1210. # normal increment magic chars & incremented char at same index
  1211. my $succ-nlook = '012345678ABCDEFGHIJKLMNOPQRSTUVWXYabcdefghijklmnopqrstuvwxyΑΒΓΔΕΖΗΘΙΚΛΜΝΞΟΠΡΣΤΥΦΧΨαβγδεζηθικλμνξοπρστυφχψאבגדהוזחטיךכלםמןנסעףפץצקרשАБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮабвгдежзийклмнопрстуфхцчшщъыьэю٠١٢٣٤٥٦٧٨۰۱۲۳۴۵۶۷۸߀߁߂߃߄߅߆߇߈०१२३४५६७८০১২৩৪৫৬৭৮੦੧੨੩੪੫੬੭੮૦૧૨૩૪૫૬૭૮୦୧୨୩୪୫୬୭୮௦௧௨௩௪௫௬௭௮౦౧౨౩౪౫౬౭౮೦೧೨೩೪೫೬೭೮൦൧൨൩൪൫൬൭൮෦෧෨෩෪෫෬෭෮๐๑๒๓๔๕๖๗๘໐໑໒໓໔໕໖໗໘༠༡༢༣༤༥༦༧༨၀၁၂၃၄၅၆၇၈႐႑႒႓႔႕႖႗႘០១២៣៤៥៦៧៨᠐᠑᠒᠓᠔᠕᠖᠗᠘᥆᥇᥈᥉᥊᥋᥌᥍᥎᧐᧑᧒᧓᧔᧕᧖᧗᧘᪀᪁᪂᪃᪄᪅᪆᪇᪈᪐᪑᪒᪓᪔᪕᪖᪗᪘᭐᭑᭒᭓᭔᭕᭖᭗᭘᮰᮱᮲᮳᮴᮵᮶᮷᮸᱀᱁᱂᱃᱄᱅᱆᱇᱈᱐᱑᱒᱓᱔᱕᱖᱗᱘⁰ⁱ⁲⁳⁴⁵⁶⁷⁸₀₁₂₃₄₅₆₇₈ⅠⅡⅢⅣⅤⅥⅦⅧⅨⅩⅪⅰⅱⅲⅳⅴⅵⅶⅷⅸⅹⅺ①②③④⑤⑥⑦⑧⑨⑩⑪⑫⑬⑭⑮⑯⑰⑱⑲⑴⑵⑶⑷⑸⑹⑺⑻⑼⑽⑾⑿⒀⒁⒂⒃⒄⒅⒆⒜⒝⒞⒟⒠⒡⒢⒣⒤⒥⒦⒧⒨⒩⒪⒫⒬⒭⒮⒯⒰⒱⒲⒳⒴▁▂▃▄▅▆▇⚀⚁⚂⚃⚄❶❷❸❹❺❻❼❽❾꘠꘡꘢꘣꘤꘥꘦꘧꘨꣐꣑꣒꣓꣔꣕꣖꣗꣘꣠꣡꣢꣣꣤꣥꣦꣧꣨꤀꤁꤂꤃꤄꤅꤆꤇꤈꧐꧑꧒꧓꧔꧕꧖꧗꧘꧰꧱꧲꧳꧴꧵꧶꧷꧸꩐꩑꩒꩓꩔꩕꩖꩗꩘꯰꯱꯲꯳꯴꯵꯶꯷꯸012345678🍺🐪';
  1212. my $succ-nchrs = '123456789BCDEFGHIJKLMNOPQRSTUVWXYZbcdefghijklmnopqrstuvwxyzΒΓΔΕΖΗΘΙΚΛΜΝΞΟΠΡΣΤΥΦΧΨΩβγδεζηθικλμνξοπρστυφχψωבגדהוזחטיךכלםמןנסעףפץצקרשתБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯбвгдежзийклмнопрстуфхцчшщъыьэюя١٢٣٤٥٦٧٨٩۱۲۳۴۵۶۷۸۹߁߂߃߄߅߆߇߈߉१२३४५६७८९১২৩৪৫৬৭৮৯੧੨੩੪੫੬੭੮੯૧૨૩૪૫૬૭૮૯୧୨୩୪୫୬୭୮୯௧௨௩௪௫௬௭௮௯౧౨౩౪౫౬౭౮౯೧೨೩೪೫೬೭೮೯൧൨൩൪൫൬൭൮൯෧෨෩෪෫෬෭෮෯๑๒๓๔๕๖๗๘๙໑໒໓໔໕໖໗໘໙༡༢༣༤༥༦༧༨༩၁၂၃၄၅၆၇၈၉႑႒႓႔႕႖႗႘႙១២៣៤៥៦៧៨៩᠑᠒᠓᠔᠕᠖᠗᠘᠙᥇᥈᥉᥊᥋᥌᥍᥎᥏᧑᧒᧓᧔᧕᧖᧗᧘᧙᪁᪂᪃᪄᪅᪆᪇᪈᪉᪑᪒᪓᪔᪕᪖᪗᪘᪙᭑᭒᭓᭔᭕᭖᭗᭘᭙᮱᮲᮳᮴᮵᮶᮷᮸᮹᱁᱂᱃᱄᱅᱆᱇᱈᱉᱑᱒᱓᱔᱕᱖᱗᱘᱙ⁱ⁲⁳⁴⁵⁶⁷⁸⁹₁₂₃₄₅₆₇₈₉ⅡⅢⅣⅤⅥⅦⅧⅨⅩⅪⅫⅱⅲⅳⅴⅵⅶⅷⅸⅹⅺⅻ②③④⑤⑥⑦⑧⑨⑩⑪⑫⑬⑭⑮⑯⑰⑱⑲⑳⑵⑶⑷⑸⑹⑺⑻⑼⑽⑾⑿⒀⒁⒂⒃⒄⒅⒆⒇⒝⒞⒟⒠⒡⒢⒣⒤⒥⒦⒧⒨⒩⒪⒫⒬⒭⒮⒯⒰⒱⒲⒳⒴⒵▂▃▄▅▆▇█⚁⚂⚃⚄⚅❷❸❹❺❻❼❽❾❿꘡꘢꘣꘤꘥꘦꘧꘨꘩꣑꣒꣓꣔꣕꣖꣗꣘꣙꣡꣢꣣꣤꣥꣦꣧꣨꣩꤁꤂꤃꤄꤅꤆꤇꤈꤉꧑꧒꧓꧔꧕꧖꧗꧘꧙꧱꧲꧳꧴꧵꧶꧷꧸꧹꩑꩒꩓꩔꩕꩖꩗꩘꩙꯱꯲꯳꯴꯵꯶꯷꯸꯹123456789🍻🐫';
  1213. # magic increment chars at boundary & incremented char at same index
  1214. my $succ-blook = '9ZzΩωתЯя٩۹߉९৯੯૯୯௯౯೯൯෯๙໙༩၉႙៩᠙᥏᧙᪉᪙᭙᮹᱉᱙⁹₉Ⅻⅻ⑳⒇⒵█⚅❿꘩꣙꣩꤉꧙꧹꩙꯹9🍻🐫';
  1215. my $succ-bchrs = '10AAaaΑΑααאאААаа١٠۱۰߁߀१०১০੧੦૧૦୧୦௧௦౧౦೧೦൧൦෧෦๑๐໑໐༡༠၁၀႑႐១០᠑᠐᥇᥆᧑᧐᪁᪀᪑᪐᭑᭐᮱᮰᱁᱀᱐᱐ⁱ⁰₁₀ⅠⅠⅰⅰ①①⑴⑴⒜⒜▁▁⚀⚀❶❶꘡꘠꣐꣐꣠꣠꤁꤀꧑꧐꧱꧰꩑꩐꯱꯰10🍻🍺🐫🐪';
  1216. # normal decrement magic chars & incremented char at same index
  1217. my $pred-nlook = '123456789BCDEFGHIJKLMNOPQRSTUVWXYZbcdefghijklmnopqrstuvwxyzΒΓΔΕΖΗΘΙΚΛΜΝΞΟΠΡΣΤΥΦΧΨΩβγδεζηθικλμνξοπρστυφχψωבגדהוזחטיךכלםמןנסעףפץצקרשתБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯбвгдежзийклмнопрстуфхцчшщъыьэюя١٢٣٤٥٦٧٨٩۱۲۳۴۵۶۷۸۹߁߂߃߄߅߆߇߈߉१२३४५६७८९১২৩৪৫৬৭৮৯੧੨੩੪੫੬੭੮੯૧૨૩૪૫૬૭૮૯୧୨୩୪୫୬୭୮୯௧௨௩௪௫௬௭௮௯౧౨౩౪౫౬౭౮౯೧೨೩೪೫೬೭೮೯൧൨൩൪൫൬൭൮൯෧෨෩෪෫෬෭෮෯๑๒๓๔๕๖๗๘๙໑໒໓໔໕໖໗໘໙༡༢༣༤༥༦༧༨༩၁၂၃၄၅၆၇၈၉႑႒႓႔႕႖႗႘႙១២៣៤៥៦៧៨៩᠑᠒᠓᠔᠕᠖᠗᠘᠙᥇᥈᥉᥊᥋᥌᥍᥎᥏᧑᧒᧓᧔᧕᧖᧗᧘᧙᪁᪂᪃᪄᪅᪆᪇᪈᪉᪑᪒᪓᪔᪕᪖᪗᪘᪙᭑᭒᭓᭔᭕᭖᭗᭘᭙᮱᮲᮳᮴᮵᮶᮷᮸᮹᱁᱂᱃᱄᱅᱆᱇᱈᱉᱑᱒᱓᱔᱕᱖᱗᱘᱙ⁱ⁲⁳⁴⁵⁶⁷⁸⁹₁₂₃₄₅₆₇₈₉ⅡⅢⅣⅤⅥⅦⅧⅨⅩⅪⅫⅱⅲⅳⅴⅵⅶⅷⅸⅹⅺⅻ②③④⑤⑥⑦⑧⑨⑩⑪⑫⑬⑭⑮⑯⑰⑱⑲⑳⑵⑶⑷⑸⑹⑺⑻⑼⑽⑾⑿⒀⒁⒂⒃⒄⒅⒆⒇⒝⒞⒟⒠⒡⒢⒣⒤⒥⒦⒧⒨⒩⒪⒫⒬⒭⒮⒯⒰⒱⒲⒳⒴⒵▂▃▄▅▆▇█⚁⚂⚃⚄⚅❷❸❹❺❻❼❽❾❿꘡꘢꘣꘤꘥꘦꘧꘨꘩꣑꣒꣓꣔꣕꣖꣗꣘꣙꣡꣢꣣꣤꣥꣦꣧꣨꣩꤁꤂꤃꤄꤅꤆꤇꤈꤉꧑꧒꧓꧔꧕꧖꧗꧘꧙꧱꧲꧳꧴꧵꧶꧷꧸꧹꩑꩒꩓꩔꩕꩖꩗꩘꩙꯱꯲꯳꯴꯵꯶꯷꯸꯹123456789🍻🐫';
  1218. my $pred-nchrs = '012345678ABCDEFGHIJKLMNOPQRSTUVWXYabcdefghijklmnopqrstuvwxyΑΒΓΔΕΖΗΘΙΚΛΜΝΞΟΠΡΣΤΥΦΧΨαβγδεζηθικλμνξοπρστυφχψאבגדהוזחטיךכלםמןנסעףפץצקרשАБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮабвгдежзийклмнопрстуфхцчшщъыьэю٠١٢٣٤٥٦٧٨۰۱۲۳۴۵۶۷۸߀߁߂߃߄߅߆߇߈०१२३४५६७८০১২৩৪৫৬৭৮੦੧੨੩੪੫੬੭੮૦૧૨૩૪૫૬૭૮୦୧୨୩୪୫୬୭୮௦௧௨௩௪௫௬௭௮౦౧౨౩౪౫౬౭౮೦೧೨೩೪೫೬೭೮൦൧൨൩൪൫൬൭൮෦෧෨෩෪෫෬෭෮๐๑๒๓๔๕๖๗๘໐໑໒໓໔໕໖໗໘༠༡༢༣༤༥༦༧༨၀၁၂၃၄၅၆၇၈႐႑႒႓႔႕႖႗႘០១២៣៤៥៦៧៨᠐᠑᠒᠓᠔᠕᠖᠗᠘᥆᥇᥈᥉᥊᥋᥌᥍᥎᧐᧑᧒᧓᧔᧕᧖᧗᧘᪀᪁᪂᪃᪄᪅᪆᪇᪈᪐᪑᪒᪓᪔᪕᪖᪗᪘᭐᭑᭒᭓᭔᭕᭖᭗᭘᮰᮱᮲᮳᮴᮵᮶᮷᮸᱀᱁᱂᱃᱄᱅᱆᱇᱈᱐᱑᱒᱓᱔᱕᱖᱗᱘⁰ⁱ⁲⁳⁴⁵⁶⁷⁸₀₁₂₃₄₅₆₇₈ⅠⅡⅢⅣⅤⅥⅦⅧⅨⅩⅪⅰⅱⅲⅳⅴⅵⅶⅷⅸⅹⅺ①②③④⑤⑥⑦⑧⑨⑩⑪⑫⑬⑭⑮⑯⑰⑱⑲⑴⑵⑶⑷⑸⑹⑺⑻⑼⑽⑾⑿⒀⒁⒂⒃⒄⒅⒆⒜⒝⒞⒟⒠⒡⒢⒣⒤⒥⒦⒧⒨⒩⒪⒫⒬⒭⒮⒯⒰⒱⒲⒳⒴▁▂▃▄▅▆▇⚀⚁⚂⚃⚄❶❷❸❹❺❻❼❽❾꘠꘡꘢꘣꘤꘥꘦꘧꘨꣐꣑꣒꣓꣔꣕꣖꣗꣘꣠꣡꣢꣣꣤꣥꣦꣧꣨꤀꤁꤂꤃꤄꤅꤆꤇꤈꧐꧑꧒꧓꧔꧕꧖꧗꧘꧰꧱꧲꧳꧴꧵꧶꧷꧸꩐꩑꩒꩓꩔꩕꩖꩗꩘꯰꯱꯲꯳꯴꯵꯶꯷꯸012345678🍺🐪';
  1219. # magic decrement chars at boundary & incremented char at same index
  1220. my $pred-blook = '0AaΑαאАа٠۰߀०০੦૦୦௦౦೦൦෦๐໐༠၀႐០᠐᥆᧐᪀᪐᭐᮰᱀᱐⁰₀Ⅰⅰ①⑴⒜▁⚀❶꘠꣐꣠꤀꧐꧰꩐꯰0🍺🐪';
  1221. my $pred-bchrs = '9ZzΩωתЯя٩۹߉९৯੯૯୯௯౯೯൯෯๙໙༩၉႙៩᠙᥏᧙᪉᪙᭙᮹᱉᱙⁹₉Ⅻⅻ⑳⒇⒵█⚅❿꘩꣙꣩꤉꧙꧹꩙꯹9🍻🐫';
  1222. #- PLEASE DON'T CHANGE ANYTHING ABOVE THIS LINE
  1223. #- end of generated part of succ/pred -----------------------------------------
  1224. # number of chars that should be considered for magic .succ/.pred
  1225. method POSSIBLE-MAGIC-CHARS(str \string) {
  1226. # only look at stuff before the last period
  1227. my int $i = nqp::index(string,".");
  1228. nqp::iseq_i($i,-1) ?? nqp::chars(string) !! $i
  1229. }
  1230. # return -1 if string cannot support .succ, else index of last char
  1231. method CAN-SUCC-INDEX(str \string, int \chars) {
  1232. my int $i = chars;
  1233. Nil while nqp::isge_i($i = nqp::sub_i($i,1),0)
  1234. && nqp::iseq_i(nqp::index($succ-nlook,nqp::substr(string,$i,1)),-1)
  1235. && nqp::iseq_i(nqp::index($succ-blook,nqp::substr(string,$i,1)),-1);
  1236. $i
  1237. }
  1238. # next logical string frontend, hopefully inlineable (pos >= 0)
  1239. method SUCC(str \string, int \pos) {
  1240. my int $at = nqp::index($succ-nlook,nqp::substr(string,pos,1));
  1241. nqp::iseq_i($at,-1)
  1242. ?? SUCC-NOT-SO-SIMPLE(string,pos)
  1243. !! nqp::replace(string,pos,1,nqp::substr($succ-nchrs,$at,1))
  1244. }
  1245. # slow path for next logical string
  1246. sub SUCC-NOT-SO-SIMPLE(str \string, int \pos) {
  1247. # nothing magical going on
  1248. my int $at = nqp::index($succ-blook,nqp::substr(string,pos,1));
  1249. if nqp::iseq_i($at,-1) {
  1250. string
  1251. }
  1252. # we have a boundary
  1253. else {
  1254. # initial change
  1255. my int $i = pos;
  1256. my str $str = nqp::replace(string,$i,1,
  1257. nqp::substr($succ-bchrs,nqp::add_i($at,$at),2));
  1258. # until we run out of chars to check
  1259. while nqp::isge_i($i = nqp::sub_i($i,1),0) {
  1260. # not an easy magical
  1261. $at = nqp::index($succ-nlook,nqp::substr($str,$i,1));
  1262. if nqp::iseq_i($at,-1) {
  1263. # done if not a boundary magical either
  1264. $at = nqp::index($succ-blook,nqp::substr($str,$i,1));
  1265. return $str if nqp::iseq_i($at,-1);
  1266. # eat first of last magical, and continue
  1267. $str = nqp::replace($str,$i,2,
  1268. nqp::substr($succ-bchrs,nqp::add_i($at,$at),2));
  1269. }
  1270. # normal magical, eat first of last magical, and we're done
  1271. else {
  1272. return nqp::replace($str,$i,2,
  1273. nqp::substr($succ-nchrs,$at,1));
  1274. }
  1275. }
  1276. $str
  1277. }
  1278. }
  1279. # previous logical string frontend, hopefully inlineable
  1280. method PRED(str \string, int \pos) {
  1281. my int $at = nqp::index($pred-nlook,nqp::substr(string,pos,1));
  1282. nqp::iseq_i($at,-1)
  1283. ?? PRED-NOT-SO-SIMPLE(string,pos)
  1284. !! nqp::replace(string,pos,1,nqp::substr($pred-nchrs,$at,1))
  1285. }
  1286. # slow path for previous logical string
  1287. sub PRED-NOT-SO-SIMPLE(str \string, int \pos) {
  1288. # nothing magical going on
  1289. my int $at = nqp::index($pred-blook,nqp::substr(string,pos,1));
  1290. if nqp::iseq_i($at,-1) {
  1291. string
  1292. }
  1293. # we have a boundary
  1294. else {
  1295. # initial change
  1296. my int $i = pos;
  1297. my str $str = nqp::replace(string,$i,1,
  1298. nqp::substr($pred-bchrs,$at,1));
  1299. # until we run out of chars to check
  1300. while nqp::isge_i($i = nqp::sub_i($i,1),0) {
  1301. # not an easy magical
  1302. $at = nqp::index($pred-nlook,nqp::substr($str,$i,1));
  1303. if nqp::iseq_i($at,-1) {
  1304. # not a boundary magical either
  1305. $at = nqp::index($pred-blook,nqp::substr($str,$i,1));
  1306. nqp::iseq_i($at,-1)
  1307. ?? fail('Decrement out of range')
  1308. !! ($str = nqp::replace($str,$i,1,
  1309. nqp::substr($pred-bchrs,$at,1)))
  1310. }
  1311. # normal magical, update, and we're done
  1312. else {
  1313. return nqp::replace($str,$i,1,
  1314. nqp::substr($pred-nchrs,$at,1))
  1315. }
  1316. }
  1317. Failure.new('Decrement out of range')
  1318. }
  1319. }
  1320. method WALK-AT-POS(\target,\indices) is raw {
  1321. my $target := target;
  1322. my $indices := nqp::getattr(indices,List,'$!reified');
  1323. my int $elems = nqp::elems($indices);
  1324. my int $i = -1;
  1325. $target := $target.AT-POS(nqp::atpos($indices,$i))
  1326. while nqp::islt_i(++$i,$elems);
  1327. $target
  1328. }
  1329. proto method coremap(|) {*}
  1330. multi method coremap(\op, Associative \h, Bool :$deep) {
  1331. my @keys = h.keys;
  1332. hash @keys Z self.coremap(op, h{@keys}, :$deep)
  1333. }
  1334. multi method coremap(\op, \obj, Bool :$deep) {
  1335. my \iterable = obj.DEFINITE && nqp::istype(obj, Iterable)
  1336. ?? obj
  1337. !! obj.list;
  1338. my \result := class :: does SlippyIterator {
  1339. has &!block;
  1340. has $!source;
  1341. method new(&block, $source) {
  1342. my $iter := nqp::create(self);
  1343. nqp::bindattr($iter, self, '&!block', &block);
  1344. nqp::bindattr($iter, self, '$!source', $source);
  1345. $iter
  1346. }
  1347. method is-lazy() {
  1348. $!source.is-lazy
  1349. }
  1350. method pull-one() is raw {
  1351. my int $redo = 1;
  1352. my $value;
  1353. my $result;
  1354. if $!slipping && nqp::not_i(nqp::eqaddr(($result := self.slip-one),IterationEnd)) {
  1355. $result
  1356. }
  1357. elsif nqp::eqaddr(($value := $!source.pull-one),IterationEnd) {
  1358. $value
  1359. }
  1360. else {
  1361. nqp::while(
  1362. $redo,
  1363. nqp::stmts(
  1364. $redo = 0,
  1365. nqp::handle(
  1366. nqp::stmts(
  1367. nqp::if(
  1368. $deep,
  1369. nqp::if(
  1370. nqp::istype($value, Iterable) && $value.DEFINITE,
  1371. ($result := Rakudo::Internals.coremap(&!block, $value, :$deep).item),
  1372. ($result := &!block($value))
  1373. ),
  1374. ($result := &!block($value))
  1375. ),
  1376. nqp::if(
  1377. nqp::istype($result, Slip),
  1378. nqp::stmts(
  1379. ($result := self.start-slip($result)),
  1380. nqp::if(
  1381. nqp::eqaddr($result, IterationEnd),
  1382. nqp::stmts(
  1383. ($value := $!source.pull-one()),
  1384. ($redo = 1 unless nqp::eqaddr($value, IterationEnd))
  1385. ))
  1386. ))
  1387. ),
  1388. 'NEXT', nqp::stmts(
  1389. ($value := $!source.pull-one()),
  1390. nqp::eqaddr($value, IterationEnd)
  1391. ?? ($result := IterationEnd)
  1392. !! ($redo = 1)),
  1393. 'REDO', $redo = 1,
  1394. 'LAST', ($result := IterationEnd))),
  1395. :nohandler);
  1396. $result
  1397. }
  1398. }
  1399. }.new(op, iterable.iterator);
  1400. my $type = nqp::istype(obj, List) ?? obj.WHAT !! List; # keep subtypes of List
  1401. my \buffer := IterationBuffer.new;
  1402. result.push-all(buffer);
  1403. my \retval = $type.new;
  1404. nqp::bindattr(retval, List, '$!reified', buffer);
  1405. nqp::iscont(obj) ?? retval.item !! retval;
  1406. }
  1407. method INFIX_COMMA_SLIP_HELPER(\reified, \future) {
  1408. nqp::stmts(
  1409. (my $list :=
  1410. nqp::p6bindattrinvres(nqp::create(List),List,'$!reified',reified)),
  1411. nqp::bindattr($list,List,'$!todo',
  1412. my $todo:= nqp::create(List::Reifier)),
  1413. nqp::bindattr($todo,List::Reifier,'$!reified',reified),
  1414. nqp::bindattr($todo,List::Reifier,'$!future',nqp::getattr(future,List,'$!reified')),
  1415. nqp::bindattr($todo,List::Reifier,'$!reification-target',reified),
  1416. $list
  1417. )
  1418. }
  1419. }
  1420. # expose the number of bits a native int has
  1421. my constant $?BITS = nqp::isgt_i(nqp::add_i(2147483648, 1), 0) ?? 64 !! 32;
  1422. { # setting up END phaser handling
  1423. my int $the-end-is-done;
  1424. my $the-end-locker = Lock.new;
  1425. # END handling, returns trueish if END handling already done/in progress
  1426. nqp::bindcurhllsym('&THE_END', {
  1427. unless $the-end-is-done {
  1428. $the-end-locker.protect: {
  1429. unless $the-end-is-done {
  1430. my $end := nqp::getcurhllsym('@END_PHASERS');
  1431. my @exceptions;
  1432. while nqp::elems($end) { # run all END blocks
  1433. quietly {
  1434. my $result := nqp::shift($end)();
  1435. nqp::isfalse(nqp::isnull($result))
  1436. && nqp::can($result, 'sink') && $result.sink;
  1437. CATCH { default { @exceptions.push($_) } }
  1438. }
  1439. }
  1440. # close all open files
  1441. IO::Handle.^find_private_method(
  1442. 'close-all-open-handles'
  1443. )(IO::Handle);
  1444. if @exceptions {
  1445. note "Some exceptions were thrown in END blocks:";
  1446. note " $_.^name(): $_.message()" for @exceptions;
  1447. }
  1448. nqp::not_i(($the-end-is-done = 1)); # we're really done now
  1449. }
  1450. }
  1451. }
  1452. } );
  1453. }
  1454. # we need this to run *after* the mainline of Rakudo::Internals has run
  1455. Rakudo::Internals.REGISTER-DYNAMIC: '&*EXIT', {
  1456. PROCESS::<&EXIT> := sub exit($status) {
  1457. state $exit = $status; # first call to exit sets value
  1458. nqp::getcurhllsym('&THE_END')()
  1459. ?? $exit
  1460. !! nqp::exit(nqp::unbox_i($exit.Int))
  1461. }
  1462. }
  1463. proto sub exit(|) {*}
  1464. multi sub exit() { &*EXIT(0) }
  1465. multi sub exit(Int(Any) $status) { &*EXIT($status) }