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