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