1. my class Range { ... }
  2. my class Match { ... }
  3. my class X::Cannot::Capture { ... }
  4. my class X::Str::InvalidCharName { ... }
  5. my class X::Str::Numeric { ... }
  6. my class X::Str::Match::x { ... }
  7. my class X::Str::Subst::Adverb { ... }
  8. my class X::Str::Trans::IllegalKey { ... }
  9. my class X::Str::Trans::InvalidArg { ... }
  10. my class X::Numeric::Confused { ... }
  11. my class X::Syntax::Number::RadixOutOfRange { ... }
  12. my constant $?TABSTOP = 8;
  13. my class Str does Stringy { # declared in BOOTSTRAP
  14. # class Str is Cool
  15. # has str $!value is box_target;
  16. my $empty := nqp::list; # for nqp::splice
  17. multi method WHY('Life, the Universe and Everything': --> 42) { }
  18. multi method WHICH(Str:D:) {
  19. nqp::box_s(
  20. nqp::concat(
  21. nqp::if(
  22. nqp::eqaddr(self.WHAT,Str),
  23. 'Str|',
  24. nqp::concat(nqp::unbox_s(self.^name), '|')
  25. ),
  26. $!value
  27. ),
  28. ValueObjAt
  29. )
  30. }
  31. submethod BUILD(Str() :$value = '' --> Nil) {
  32. nqp::bindattr_s(self, Str, '$!value', nqp::unbox_s($value))
  33. }
  34. multi method Bool(Str:D:) {
  35. nqp::p6bool(nqp::chars($!value));
  36. }
  37. method Capture() { die X::Cannot::Capture.new: :what(self) }
  38. multi method Str(Str:D:) { self }
  39. multi method Stringy(Str:D:) { self }
  40. multi method DUMP(Str:D:) { self.perl }
  41. method Int(Str:D:) {
  42. nqp::if(
  43. nqp::isge_i(
  44. nqp::findnotcclass(
  45. nqp::const::CCLASS_NUMERIC,$!value,0,nqp::chars($!value)),
  46. nqp::chars($!value)
  47. )
  48. # Compare Str.chars == Str.codes to filter out any combining characters
  49. && nqp::iseq_i(
  50. nqp::chars($!value),
  51. nqp::codes($!value)
  52. )
  53. ,
  54. nqp::atpos(nqp::radix_I(10,$!value,0,0,Int),0), # all numeric chars
  55. nqp::if(
  56. nqp::istype((my $numeric := self.Numeric),Failure),
  57. $numeric,
  58. $numeric.Int
  59. )
  60. )
  61. }
  62. method Num(Str:D:) {
  63. nqp::if(
  64. nqp::istype((my $numeric := self.Numeric),Failure),
  65. $numeric,
  66. $numeric.Num || nqp::if(
  67. # handle sign of zero. While self.Numeric will give correctly
  68. # signed zero for nums in strings, it won't for other types,
  69. # and since this method is `Num` we want to return proper zero.
  70. # Find first non-whitespace char and check whether it is one
  71. # of the minuses.
  72. nqp::chars(self)
  73. && (
  74. nqp::iseq_i(
  75. (my $ch := nqp::ord(
  76. nqp::substr(
  77. self,
  78. nqp::findnotcclass(
  79. nqp::const::CCLASS_WHITESPACE, self, 0,
  80. nqp::sub_i(nqp::chars(self), 1)
  81. ),
  82. 1,
  83. )
  84. )),
  85. 45, # '-' minus
  86. ) || nqp::iseq_i($ch, 8722) # '−' minus
  87. ),
  88. -0e0,
  89. 0e0
  90. )
  91. )
  92. }
  93. multi method ACCEPTS(Str:D: Str:D \other) {
  94. nqp::p6bool(nqp::iseq_s(nqp::unbox_s(other),$!value));
  95. }
  96. multi method ACCEPTS(Str:D: Any:D \other) {
  97. nqp::p6bool(nqp::iseq_s(nqp::unbox_s(other.Str),$!value));
  98. }
  99. method chomp(Str:D:) {
  100. nqp::if(
  101. (nqp::isge_i((my int $chars = nqp::sub_i(nqp::chars($!value),1)),0)
  102. && nqp::iscclass(nqp::const::CCLASS_NEWLINE,$!value,$chars)),
  103. nqp::p6box_s(nqp::substr($!value,0,$chars)),
  104. self
  105. )
  106. }
  107. multi method chop(Str:D:) {
  108. nqp::if(
  109. nqp::isgt_i(nqp::chars($!value),0),
  110. nqp::p6box_s(
  111. nqp::substr($!value,0,nqp::sub_i(nqp::chars($!value),1))),
  112. ''
  113. )
  114. }
  115. multi method chop(Str:D: Int() $chopping) {
  116. my Int $chars = nqp::chars($!value) - $chopping;
  117. $chars > 0 ?? nqp::p6box_s(nqp::substr($!value,0,$chars)) !! '';
  118. }
  119. # TODO Use coercer in 1 candidate when RT131014
  120. proto method starts-with(|) {*}
  121. multi method starts-with(Str:D: Cool:D $needle) {self.starts-with: $needle.Str}
  122. multi method starts-with(Str:D: Str:D $needle) {
  123. nqp::p6bool(nqp::eqat(self, $needle, 0))
  124. }
  125. # TODO Use coercer in 1 candidate when RT131014
  126. proto method ends-with(|) {*}
  127. multi method ends-with(Str:D: Cool:D $suffix) {self.ends-with: $suffix.Str}
  128. multi method ends-with(Str:D: Str:D $suffix) {
  129. nqp::p6bool(nqp::eqat(
  130. $!value,
  131. nqp::getattr($suffix,Str,'$!value'),
  132. nqp::chars($!value) - nqp::chars(nqp::getattr($suffix,Str,'$!value'))
  133. ))
  134. }
  135. # TODO Use coercer in 1 candidate when RT131014
  136. proto method substr-eq(|) {*}
  137. multi method substr-eq(Str:D: Cool:D $needle) {self.substr-eq: $needle.Str}
  138. multi method substr-eq(Str:D: Str:D $needle) {
  139. nqp::p6bool(nqp::eqat($!value,nqp::getattr($needle,Str,'$!value'),0))
  140. }
  141. multi method substr-eq(Str:D: Cool:D $needle, Int:D $pos) {self.substr-eq: $needle.Str, $pos.Int}
  142. multi method substr-eq(Str:D: Str:D $needle, Int:D $pos) {
  143. nqp::p6bool(
  144. nqp::if(
  145. (nqp::isge_i($pos,0) && nqp::islt_i($pos,nqp::chars($!value))),
  146. nqp::eqat($!value,nqp::getattr($needle,Str,'$!value'),$pos)
  147. )
  148. )
  149. }
  150. # TODO Use coercer in 1 candidate when RT131014
  151. proto method contains(|) {*}
  152. multi method contains(Str:D: Cool:D $needle) {self.contains: $needle.Str}
  153. multi method contains(Str:D: Str:D $needle) {
  154. nqp::p6bool(nqp::isne_i(
  155. nqp::index($!value,nqp::getattr($needle,Str,'$!value'),0),-1
  156. ))
  157. }
  158. multi method contains(Str:D: Cool:D $needle, Int(Cool:D) $pos) {self.contains: $needle.Str, $pos}
  159. multi method contains(Str:D: Str:D $needle, Int:D $pos) {
  160. nqp::p6bool(
  161. nqp::if(
  162. (nqp::isge_i($pos,0) && nqp::islt_i($pos,nqp::chars($!value))),
  163. nqp::isne_i(
  164. nqp::index($!value,nqp::getattr($needle,Str,'$!value'),$pos),-1)
  165. )
  166. )
  167. }
  168. # TODO Use coercer in 1 candidate when RT131014
  169. proto method indices(|) {*}
  170. multi method indices(Str:D: Cool:D $needle, *%pars) {self.indices: $needle.Str, |%pars}
  171. multi method indices(Str:D: Str:D $needle, :$overlap) {
  172. nqp::stmts(
  173. (my $need := nqp::getattr($needle,Str,'$!value')),
  174. (my int $add = nqp::if($overlap,1,nqp::chars($need) || 1)),
  175. (my $indices := nqp::create(IterationBuffer)),
  176. (my int $pos),
  177. (my int $i),
  178. nqp::while(
  179. nqp::isge_i(($i = nqp::index($!value,$need,$pos)),0),
  180. nqp::stmts(
  181. nqp::push($indices,nqp::p6box_i($i)),
  182. ($pos = nqp::add_i($i,$add))
  183. )
  184. ),
  185. nqp::p6bindattrinvres(nqp::create(List),List,'$!reified',$indices)
  186. )
  187. }
  188. multi method indices(Str:D: Cool:D $needle, Cool:D $start, *%pars) {self.indices: $needle.Str, $start.Int, |%pars}
  189. multi method indices(Str:D: Str:D $needle, Int:D $start, :$overlap) {
  190. nqp::stmts(
  191. (my int $pos = $start),
  192. nqp::if(
  193. nqp::isgt_i($pos,nqp::chars($!value)),
  194. nqp::create(List), # position after string, always empty List
  195. nqp::stmts(
  196. (my $need := nqp::getattr($needle,Str,'$!value')),
  197. (my int $add = nqp::if($overlap,1,nqp::chars($need) || 1)),
  198. (my $indices := nqp::create(IterationBuffer)),
  199. (my int $i),
  200. nqp::while(
  201. nqp::isge_i(($i = nqp::index($!value,$need,$pos)),0),
  202. nqp::stmts(
  203. nqp::push($indices,nqp::p6box_i($i)),
  204. ($pos = nqp::add_i($i,$add))
  205. )
  206. ),
  207. nqp::p6bindattrinvres(nqp::create(List),List,'$!reified',$indices)
  208. )
  209. )
  210. )
  211. }
  212. # TODO Use coercer in 1 candidate when RT131014
  213. proto method index(|) {*}
  214. multi method index(Str:D: Cool:D $needle) {self.index: $needle.Str}
  215. multi method index(Str:D: Str:D $needle) {
  216. nqp::if(
  217. nqp::islt_i((my int $i =
  218. nqp::index($!value,nqp::getattr($needle,Str,'$!value'))),
  219. 0
  220. ),
  221. Nil,
  222. nqp::p6box_i($i)
  223. )
  224. }
  225. multi method index(Str:D: Cool:D $needle, Cool:D $pos) {self.index: $needle.Str, $pos.Int}
  226. multi method index(Str:D: Str:D $needle, Int:D $pos) {
  227. nqp::if(
  228. nqp::isbig_I(nqp::decont($pos)),
  229. Failure.new(X::OutOfRange.new(
  230. :what("Position in index"),
  231. :got($pos),
  232. :range("0..{self.chars}")
  233. )),
  234. nqp::if(
  235. nqp::islt_i($pos,0),
  236. Failure.new(X::OutOfRange.new(
  237. :what("Position in index"),
  238. :got($pos),
  239. :range("0..{self.chars}")
  240. )),
  241. nqp::if(
  242. nqp::islt_i((my int $i = nqp::index(
  243. $!value,nqp::getattr($needle,Str,'$!value'),$pos
  244. )),0),
  245. Nil,
  246. nqp::p6box_i($i)
  247. )
  248. )
  249. )
  250. }
  251. # TODO Use coercer in 1 candidate when RT131014
  252. proto method rindex(|) {*}
  253. multi method rindex(Str:D: Cool:D $needle) {self.rindex: $needle.Str}
  254. multi method rindex(Str:D: Str:D $needle) {
  255. nqp::if(
  256. nqp::islt_i((my int $i =
  257. nqp::rindex($!value,nqp::getattr($needle,Str,'$!value'))),
  258. 0
  259. ),
  260. Nil,
  261. nqp::p6box_i($i)
  262. )
  263. }
  264. multi method rindex(Str:D: Cool:D $needle, Cool:D $pos) {self.rindex: $needle.Str, $pos.Int}
  265. multi method rindex(Str:D: Str:D $needle, Int:D $pos) {
  266. nqp::if(
  267. nqp::isbig_I(nqp::decont($pos)),
  268. Failure.new(X::OutOfRange.new(
  269. :what("Position in rindex"),
  270. :got($pos),
  271. :range("0..{self.chars}")
  272. )),
  273. nqp::if(
  274. nqp::islt_i($pos,0),
  275. Failure.new(X::OutOfRange.new(
  276. :what("Position in rindex"),
  277. :got($pos),
  278. :range("0..{self.chars}")
  279. )),
  280. nqp::if(
  281. nqp::islt_i((my int $i = nqp::rindex(
  282. $!value,nqp::getattr($needle,Str,'$!value'),$pos
  283. )),0),
  284. Nil,
  285. nqp::p6box_i($i)
  286. )
  287. )
  288. )
  289. }
  290. method pred(Str:D:) {
  291. (my int $chars = Rakudo::Internals.POSSIBLE-MAGIC-CHARS(self))
  292. ?? Rakudo::Internals.PRED(self,$chars - 1)
  293. !! self
  294. }
  295. method succ(Str:D:) {
  296. (my int $chars = Rakudo::Internals.POSSIBLE-MAGIC-CHARS(self))
  297. ?? Rakudo::Internals.SUCC(self,$chars - 1)
  298. !! self
  299. }
  300. multi method Numeric(Str:D:) {
  301. # Handle special empty string
  302. self.trim eq ""
  303. ?? 0
  304. !! val(self, :val-or-fail)
  305. }
  306. multi method gist(Str:D:) { self }
  307. multi method perl(Str:D:) {
  308. '"' ~ Rakudo::Internals.PERLIFY-STR(self) ~ '"'
  309. }
  310. proto method comb(|) {*}
  311. multi method comb(Str:D:) {
  312. Seq.new(class :: does Iterator {
  313. has str $!str;
  314. has int $!chars;
  315. has int $!pos;
  316. method !SET-SELF(\string) {
  317. nqp::stmts(
  318. ($!str = nqp::unbox_s(string)),
  319. ($!chars = nqp::chars($!str)),
  320. ($!pos = -1),
  321. self
  322. )
  323. }
  324. method new(\string) {
  325. nqp::if(
  326. string,
  327. nqp::create(self)!SET-SELF(string),
  328. Rakudo::Iterator.Empty
  329. )
  330. }
  331. method pull-one() {
  332. nqp::if(
  333. nqp::islt_i(($!pos = nqp::add_i($!pos,1)),$!chars),
  334. nqp::p6box_s(nqp::substr($!str,$!pos,1)),
  335. IterationEnd
  336. )
  337. }
  338. method count-only() { nqp::p6box_i($!chars) }
  339. method bool-only(--> True) { }
  340. }.new(self));
  341. }
  342. multi method comb(Str:D: Int:D $size is copy, $limit = *) {
  343. my int $inf = nqp::istype($limit,Whatever) || $limit == Inf;
  344. return self.comb if $size <= 1 && $inf;
  345. $size = 1 if $size < 1;
  346. Seq.new(class :: does Iterator {
  347. has str $!str;
  348. has int $!chars;
  349. has int $!size;
  350. has int $!pos;
  351. has int $!max;
  352. has int $!todo;
  353. method !SET-SELF(\string,\size,\limit,\inf) {
  354. nqp::stmts(
  355. ($!str = nqp::unbox_s(string)),
  356. ($!chars = nqp::chars($!str)),
  357. ($!size = 1 max size),
  358. ($!pos = -size),
  359. ($!max = 1 + floor( ( $!chars - 1 ) / $!size )),
  360. ($!todo = (inf ?? $!max !! (0 max limit)) + 1),
  361. self
  362. )
  363. }
  364. method new(\string,\size,\limit,\inf) {
  365. nqp::if(
  366. string,
  367. nqp::create(self)!SET-SELF(string,size,limit,inf),
  368. Rakudo::Iterator.Empty
  369. )
  370. }
  371. method pull-one() {
  372. ($!todo = $!todo - 1) && ($!pos = $!pos + $!size) < $!chars
  373. ?? nqp::p6box_s(nqp::substr($!str, $!pos, $!size))
  374. !! IterationEnd
  375. }
  376. method push-all($target --> IterationEnd) {
  377. my int $todo = $!todo;
  378. my int $pos = $!pos;
  379. my int $size = $!size;
  380. my int $chars = $!chars;
  381. $target.push(nqp::p6box_s(nqp::substr($!str, $pos, $size)))
  382. while ($todo = $todo - 1 ) && ($pos = $pos + $size) < $chars;
  383. $!pos = $!chars;
  384. }
  385. method count-only() { $!max }
  386. method bool-only(--> True) { }
  387. }.new(self,$size,$limit,$inf))
  388. }
  389. multi method comb(Str:D: Str $pat) {
  390. return self.comb(1) unless $pat;
  391. Seq.new(class :: does Iterator {
  392. has str $!str;
  393. has str $!pat;
  394. has int $!pos;
  395. method !SET-SELF(\string, \pat) {
  396. $!str = nqp::unbox_s(string);
  397. $!pat = nqp::unbox_s(pat);
  398. self
  399. }
  400. method new(\string, \pat) { nqp::create(self)!SET-SELF(string,pat) }
  401. method pull-one() {
  402. my int $found = nqp::index($!str, $!pat, $!pos);
  403. if $found < 0 {
  404. IterationEnd
  405. }
  406. else {
  407. $!pos = $found + 1;
  408. nqp::p6box_s($!pat)
  409. }
  410. }
  411. }.new(self, $pat));
  412. }
  413. multi method comb(Str:D: Str $pat, $limit) {
  414. return self.comb($pat)
  415. if nqp::istype($limit,Whatever) || $limit == Inf;
  416. return self.comb(1, $limit) unless $pat;
  417. Seq.new(class :: does Iterator {
  418. has str $!str;
  419. has str $!pat;
  420. has int $!pos;
  421. has int $!todo;
  422. method !SET-SELF(\string, \pat, \limit) {
  423. $!str = nqp::unbox_s(string);
  424. $!pat = nqp::unbox_s(pat);
  425. $!todo = nqp::unbox_i(limit.Int);
  426. self
  427. }
  428. method new(\string, \pat, \limit) {
  429. nqp::create(self)!SET-SELF(string, pat, limit)
  430. }
  431. method pull-one() {
  432. my int $found = nqp::index($!str, $!pat, $!pos);
  433. if $found < 0 || $!todo == 0 {
  434. IterationEnd
  435. }
  436. else {
  437. $!pos = $found + 1;
  438. $!todo = $!todo - 1;
  439. nqp::p6box_s($!pat)
  440. }
  441. }
  442. }.new(self, $pat, $limit));
  443. }
  444. multi method comb(Str:D: Regex:D $pattern, :$match) {
  445. Seq.new(nqp::if(
  446. $match,
  447. self.match($pattern, :g),
  448. self.match($pattern, :g, :as(Str))
  449. ).iterator)
  450. }
  451. multi method comb(Str:D: Regex:D $pattern, $limit, :$match) {
  452. nqp::if(
  453. nqp::istype($limit,Whatever) || $limit == Inf,
  454. self.comb($pattern, :$match),
  455. Seq.new(nqp::if(
  456. $match,
  457. self.match($pattern, :x(1..$limit)),
  458. self.match($pattern, :x(1..$limit), :as(Str))
  459. ).iterator)
  460. )
  461. }
  462. # cache cursor initialization lookup
  463. my $cursor-init := Match.^lookup("!cursor_init");
  464. my \CURSOR-GLOBAL := Match.^lookup("CURSOR_MORE" ); # :g
  465. my \CURSOR-OVERLAP := Match.^lookup("CURSOR_OVERLAP"); # :ov
  466. my \CURSOR-EXHAUSTIVE := Match.^lookup("CURSOR_NEXT" ); # :ex
  467. my \POST-MATCH := Match.^lookup("MATCH" ); # Match object
  468. my \POST-STR := Match.^lookup("STR" ); # Str object
  469. # iterate with post-processing
  470. class POST-ITERATOR does Iterator {
  471. has Mu $!cursor; # cannot put these 3 lines in role
  472. has Mu $!move;
  473. has Mu $!post;
  474. method !SET-SELF(\cursor,\move,\post) {
  475. $!cursor := cursor;
  476. $!move := move;
  477. $!post := post;
  478. self
  479. }
  480. method new(\c,\t,\p) { nqp::create(self)!SET-SELF(c,t,p) }
  481. method pull-one() is raw {
  482. nqp::if(
  483. nqp::isge_i(nqp::getattr_i($!cursor,Match,'$!pos'),0),
  484. nqp::stmts(
  485. (my $pulled := $!cursor),
  486. ($!cursor := $!move($!cursor)),
  487. $!post($pulled)
  488. ),
  489. IterationEnd
  490. )
  491. }
  492. method skip-one() is raw {
  493. nqp::if(
  494. nqp::isge_i(nqp::getattr_i($!cursor,Match,'$!pos'),0),
  495. ($!cursor := $!move($!cursor)),
  496. )
  497. }
  498. method push-all($target --> IterationEnd) {
  499. nqp::while(
  500. nqp::isge_i(nqp::getattr_i($!cursor,Match,'$!pos'),0),
  501. nqp::stmts(
  502. $target.push($!post($!cursor)),
  503. ($!cursor := $!move($!cursor))
  504. )
  505. )
  506. }
  507. }
  508. # iterate returning Matches
  509. class CURSOR-ITERATOR does Iterator {
  510. has Mu $!cursor;
  511. has Mu $!move;
  512. method !SET-SELF(\cursor,\move) {
  513. $!cursor := cursor;
  514. $!move := move;
  515. self
  516. }
  517. method new(\c,\t) { nqp::create(self)!SET-SELF(c,t) }
  518. method pull-one() is raw {
  519. nqp::if(
  520. nqp::isge_i(nqp::getattr_i($!cursor,Match,'$!pos'),0),
  521. nqp::stmts(
  522. (my $pulled := $!cursor),
  523. ($!cursor := $!move($!cursor)),
  524. $pulled
  525. ),
  526. IterationEnd
  527. )
  528. }
  529. method skip-one() is raw {
  530. nqp::if(
  531. nqp::isge_i(nqp::getattr_i($!cursor,Match,'$!pos'),0),
  532. ($!cursor := $!move($!cursor)),
  533. )
  534. }
  535. method push-all($target --> IterationEnd) {
  536. nqp::while(
  537. nqp::isge_i(nqp::getattr_i($!cursor,Match,'$!pos'),0),
  538. nqp::stmts(
  539. $target.push($!cursor),
  540. ($!cursor := $!move($!cursor))
  541. )
  542. )
  543. }
  544. }
  545. # Look for short/long named parameter and remove it from the hash
  546. sub fetch-short-long(\opts, str $short, str $long, \store --> Nil) {
  547. nqp::if(
  548. nqp::existskey(opts,$short),
  549. nqp::stmts(
  550. (store = nqp::atkey(opts,$short)),
  551. nqp::deletekey(opts,$short)
  552. ),
  553. nqp::if(
  554. nqp::existskey(opts,$long),
  555. nqp::stmts(
  556. (store = nqp::atkey(opts,$long)),
  557. nqp::deletekey(opts,$long)
  558. )
  559. )
  560. )
  561. }
  562. # Look for named parameters, do not remove from hash
  563. sub fetch-all-of(\opts, @names, \store --> Nil) {
  564. nqp::stmts(
  565. (my int $elems = @names.elems), # reifies
  566. (my $list := nqp::getattr(@names,List,'$!reified')),
  567. (my int $i = -1),
  568. nqp::while(
  569. nqp::islt_i(($i = nqp::add_i($i,1)),$elems),
  570. nqp::if(
  571. nqp::existskey(opts,nqp::unbox_s(nqp::atpos($list,$i))),
  572. (store = nqp::atkey(opts,nqp::unbox_s(nqp::atpos($list,$i)))),
  573. )
  574. )
  575. )
  576. }
  577. sub die-before-first($got) {
  578. die "Attempt to retrieve before :1st match -- :nth({
  579. $got // $got.^name
  580. })"
  581. }
  582. # All of these !match methods take a nqp::getlexcaller value for the $/
  583. # to be set as the first parameter. The second parameter is usually
  584. # the Match object to be used (or something from which a Match can
  585. # be made).
  586. # Generic fallback for matching with a pattern
  587. method !match-pattern(\slash, $pattern, str $name, $value, \opts) {
  588. nqp::stmts(
  589. (my $opts := nqp::getattr(opts,Map,'$!storage')),
  590. nqp::bindkey($opts,$name,$value),
  591. fetch-short-long($opts, "p", "pos", my $p),
  592. fetch-short-long($opts, "c", "continue", my $c),
  593. nqp::unless(nqp::defined($c), $c = 0),
  594. nqp::if(
  595. nqp::elems($opts),
  596. nqp::if(
  597. nqp::defined($p),
  598. self!match-cursor(slash,
  599. $pattern($cursor-init(Match,self,:$p)), '', 0, $opts),
  600. self!match-cursor(slash,
  601. $pattern($cursor-init(Match,self,:$c)), '', 0, $opts)
  602. ),
  603. nqp::if(
  604. nqp::defined($p),
  605. self!match-one(slash,
  606. $pattern($cursor-init(Match,self,:$p))),
  607. self!match-one(slash,
  608. $pattern($cursor-init(Match,self,:$c)))
  609. )
  610. )
  611. )
  612. }
  613. # Generic fallback for matching with a cursor. This is typically
  614. # called if more than one named parameter was specified. Arguments
  615. # 3/4 are the initial named parameter matched: instead of flattening
  616. # the named parameter into another slurpy hash, we pass the name and
  617. # the value as extra parameters, and add it back in the hash with
  618. # named parameters.
  619. method !match-cursor(\slash, \cursor, str $name, $value, \opts) {
  620. nqp::stmts(
  621. (my $opts := nqp::getattr(opts,Map,'$!storage')),
  622. nqp::if(
  623. nqp::chars($name),
  624. nqp::bindkey($opts,$name,$value)
  625. ),
  626. fetch-short-long($opts, "ex", "exhaustive", my $ex),
  627. fetch-short-long($opts, "ov", "overlap", my $ov),
  628. (my \move := nqp::if($ex, CURSOR-EXHAUSTIVE,
  629. nqp::if($ov, CURSOR-OVERLAP, CURSOR-GLOBAL))),
  630. fetch-short-long($opts, "as", "as", my $as),
  631. (my \post := nqp::if(nqp::istype($as,Str), POST-STR, POST-MATCH)),
  632. fetch-short-long($opts, "g", "global", my $g),
  633. nqp::if(
  634. nqp::elems($opts),
  635. nqp::stmts(
  636. fetch-short-long($opts, "x", "x", my $x),
  637. fetch-all-of($opts, <st nd rd th nth>, my $nth),
  638. nqp::if(
  639. nqp::defined($nth),
  640. nqp::if(
  641. nqp::defined($x), # :nth && :x
  642. self!match-x(slash,
  643. self!match-nth(slash, cursor,
  644. move, post, $nth, nqp::hash).iterator, $x),
  645. self!match-nth(slash, cursor,
  646. move, post, $nth, nqp::hash) # nth
  647. ),
  648. nqp::if(
  649. nqp::defined($x),
  650. self!match-x(slash, # :x
  651. POST-ITERATOR.new(cursor, move, post), $x),
  652. nqp::if( # only :ex|ov|g
  653. $ex || $ov || $g,
  654. self!match-list(slash, cursor, move, post),
  655. self!match-one(slash, cursor)
  656. )
  657. )
  658. )
  659. ),
  660. nqp::if( # only :ex|ov|g
  661. $ex || $ov || $g,
  662. self!match-list(slash, cursor, move, post),
  663. self!match-one(slash, cursor)
  664. )
  665. )
  666. )
  667. }
  668. # Match object at given position
  669. method !match-one(\slash, \cursor) {
  670. nqp::decont(slash = nqp::if(
  671. nqp::isge_i(nqp::getattr_i(cursor,Match,'$!pos'),0),
  672. cursor.MATCH,
  673. Nil
  674. ))
  675. }
  676. # Some object at given position
  677. method !match-as-one(\slash, \cursor, \as) {
  678. nqp::decont(slash = nqp::if(
  679. nqp::isge_i(nqp::getattr_i(cursor,Match,'$!pos'),0),
  680. nqp::if(nqp::istype(as,Str), POST-STR, POST-MATCH)(cursor),
  681. Nil
  682. ))
  683. }
  684. # Create list from the appropriate Sequence given the move
  685. method !match-list(\slash, \cursor, \move, \post) {
  686. nqp::decont(slash = nqp::if(
  687. nqp::isge_i(nqp::getattr_i(cursor,Match,'$!pos'),0),
  688. Seq.new(POST-ITERATOR.new(cursor, move, post)).list,
  689. List.new,
  690. ))
  691. }
  692. # Handle matching of the nth match specification.
  693. method !match-nth(\slash, \cursor, \move, \post, $nth, %opts) {
  694. nqp::if(
  695. nqp::elems(nqp::getattr(%opts,Map,'$!storage')),
  696. self!match-cursor(slash, cursor, 'nth', $nth, %opts),
  697. nqp::if(
  698. nqp::defined($nth),
  699. nqp::if(
  700. nqp::istype($nth,Whatever),
  701. self!match-last(slash, cursor, move),
  702. nqp::if(
  703. nqp::istype($nth,Numeric),
  704. nqp::if(
  705. $nth == Inf,
  706. self!match-last(slash, cursor, move),
  707. nqp::if(
  708. $nth < 1,
  709. die-before-first($nth),
  710. self!match-nth-int(slash, cursor, move, post, $nth.Int)
  711. )
  712. ),
  713. nqp::if(
  714. nqp::istype($nth,WhateverCode),
  715. nqp::if(
  716. nqp::iseq_i((my int $tail = abs($nth(-1))),1),
  717. self!match-last(slash, cursor, move),
  718. self!match-nth-tail(slash, cursor, move, $tail)
  719. ),
  720. nqp::if(
  721. nqp::istype($nth,Callable),
  722. self!match-nth-int(slash,
  723. cursor, move, post, $nth()),
  724. self!match-nth-iterator(slash,
  725. POST-ITERATOR.new(cursor, move, post),
  726. $nth.iterator)
  727. )
  728. )
  729. )
  730. ),
  731. self!match-one(slash, cursor)
  732. )
  733. )
  734. }
  735. # Give back the nth match found
  736. method !match-nth-int(\slash, \cursor, \move, \post, int $nth) {
  737. nqp::decont(slash = nqp::if(
  738. nqp::isge_i(nqp::getattr_i(cursor,Match,'$!pos'),0),
  739. nqp::if(
  740. nqp::eqaddr(
  741. (my $pulled := POST-ITERATOR.new(cursor, move, post)
  742. .skip-at-least-pull-one(nqp::sub_i($nth,1))),
  743. IterationEnd
  744. ),
  745. Nil, # not enough matches
  746. $pulled # found it!
  747. ),
  748. Nil # no matches whatsoever
  749. ))
  750. }
  751. # Give back the N-tail match found
  752. method !match-nth-tail(\slash, \cursor, \move, int $tail) {
  753. nqp::decont(slash = nqp::if(
  754. nqp::eqaddr((my $pulled :=
  755. Rakudo::Iterator.LastNValues(
  756. CURSOR-ITERATOR.new(cursor, move),
  757. $tail, 'match', 1).pull-one),
  758. IterationEnd
  759. ),
  760. Nil,
  761. $pulled.MATCH
  762. ))
  763. }
  764. # Give last value of given iterator, or Nil if none
  765. method !match-last(\slash, \cursor, \move) {
  766. nqp::decont(slash = nqp::if(
  767. nqp::eqaddr((my $pulled :=
  768. Rakudo::Iterator.LastValue(
  769. CURSOR-ITERATOR.new(cursor, move),
  770. 'match')),
  771. IterationEnd
  772. ),
  773. Nil,
  774. $pulled.MATCH
  775. ))
  776. }
  777. # These !match methods take an iterator instead of a cursor.
  778. # Give list with matches found given a range with :nth
  779. method !match-nth-range(\slash, \iterator, $min, $max) {
  780. nqp::decont(slash = nqp::stmts(
  781. (my int $skip = $min),
  782. nqp::if(
  783. nqp::islt_i($skip,1),
  784. die-before-first($min),
  785. nqp::stmts(
  786. nqp::while(
  787. nqp::isgt_i($skip,1) && iterator.skip-one,
  788. ($skip = nqp::sub_i($skip,1))
  789. ),
  790. nqp::if(
  791. nqp::iseq_i($skip,1),
  792. nqp::if( # did not exhaust while skipping
  793. $max == Inf, # * is Inf in N..*
  794. nqp::stmts( # open ended
  795. (my $matches := nqp::create(IterationBuffer)),
  796. nqp::until(
  797. nqp::eqaddr(
  798. (my $pulled := iterator.pull-one),
  799. IterationEnd
  800. ),
  801. nqp::push($matches,$pulled)
  802. ),
  803. nqp::p6bindattrinvres(
  804. nqp::create(List),List,'$!reified',$matches)
  805. ),
  806. nqp::stmts( # upto the max index
  807. (my int $todo = $max - $min + 1),
  808. ($matches :=
  809. nqp::setelems(nqp::create(IterationBuffer),$todo)),
  810. (my int $i = -1),
  811. nqp::until(
  812. nqp::iseq_i(($i = nqp::add_i($i,1)),$todo)
  813. || nqp::eqaddr(
  814. ($pulled := iterator.pull-one),IterationEnd),
  815. nqp::bindpos($matches,$i,$pulled)
  816. ),
  817. nqp::if(
  818. nqp::iseq_i($i,$todo),
  819. nqp::p6bindattrinvres( # found all values
  820. nqp::create(List),List,'$!reified',$matches),
  821. Empty # no match, since not all values
  822. )
  823. )
  824. ),
  825. Empty # exhausted while skipping
  826. )
  827. )
  828. )
  829. ))
  830. }
  831. # Give list with matches found given an iterator with :nth
  832. method !match-nth-iterator(\slash, \source, \indexes) {
  833. nqp::decont(slash = nqp::stmts(
  834. Seq.new(Rakudo::Iterator.MonotonicIndexes(
  835. source, indexes, 1,
  836. -> $got,$next {
  837. nqp::if(
  838. $next == 1,
  839. die-before-first($got),
  840. (die "Attempt to fetch match #$got after #{$next - 1}")
  841. )
  842. }
  843. )).list
  844. ))
  845. }
  846. # Give list with matches found given an iterator with :x
  847. method !match-x(\slash, \iterator, $x) {
  848. nqp::if(
  849. nqp::istype($x,Whatever),
  850. Seq.new(iterator).list,
  851. nqp::if(
  852. nqp::istype($x,Numeric),
  853. nqp::if(
  854. $x == Inf,
  855. Seq.new(iterator).list,
  856. nqp::if(
  857. nqp::istype($x,Int),
  858. self!match-x-range(slash, iterator, $x, $x),
  859. nqp::stmts(
  860. (my int $xint = $x.Int),
  861. self!match-x-range(slash, iterator, $xint, $xint)
  862. )
  863. )
  864. ),
  865. nqp::if(
  866. nqp::istype($x,Range),
  867. self!match-x-range(slash, iterator, $x.min, $x.max),
  868. nqp::stmts(
  869. (slash = Nil),
  870. Failure.new(X::Str::Match::x.new(:got($x)))
  871. )
  872. )
  873. )
  874. )
  875. }
  876. # Give list with matches found given a range with :x
  877. method !match-x-range(\slash, \iterator, $min, $max) {
  878. nqp::decont(slash = nqp::stmts(
  879. (my int $todo = nqp::if($max == Inf, 0x7fffffff, $max)),
  880. (my $matches := nqp::create(IterationBuffer)),
  881. nqp::until(
  882. nqp::islt_i(($todo = nqp::sub_i($todo,1)), 0) ||
  883. nqp::eqaddr((my $pulled := iterator.pull-one),IterationEnd),
  884. nqp::push($matches,$pulled)
  885. ),
  886. nqp::if(
  887. nqp::elems($matches) >= $min,
  888. nqp::p6bindattrinvres(
  889. nqp::create(List),List,'$!reified',$matches),
  890. ()
  891. )
  892. ))
  893. }
  894. proto method match(|) { $/ := nqp::getlexcaller('$/'); {*} }
  895. multi method match(Cool:D $pattern, |c) {
  896. $/ := nqp::getlexcaller('$/');
  897. self.match(/ "$pattern": /,|c)
  898. }
  899. # All of these .match candidates take a single required named parameter
  900. # so that handling specification of a single named parameter can be much
  901. # quicker. Unfortunately, we cannot cheaply do MMD on an empty slurpy
  902. # hash, which would make things much more simple.
  903. multi method match(Regex:D $pattern, :continue(:$c)!, *%_) {
  904. nqp::if(
  905. nqp::elems(nqp::getattr(%_,Map,'$!storage')),
  906. self!match-pattern(nqp::getlexcaller('$/'), $pattern, 'c', $c, %_),
  907. self!match-one(nqp::getlexcaller('$/'),
  908. $pattern($cursor-init(Match,self,:$c)))
  909. )
  910. }
  911. multi method match(Regex:D $pattern, :pos(:$p)!, *%_) {
  912. nqp::if(
  913. nqp::elems(nqp::getattr(%_,Map,'$!storage')),
  914. self!match-pattern(nqp::getlexcaller('$/'), $pattern, 'p', $p, %_),
  915. nqp::if(
  916. nqp::defined($p),
  917. self!match-one(nqp::getlexcaller('$/'),
  918. $pattern($cursor-init(Match,self,:$p))),
  919. self!match-one(nqp::getlexcaller('$/'),
  920. $pattern($cursor-init(Match,self,:0c)))
  921. )
  922. )
  923. }
  924. multi method match(Regex:D $pattern, :global(:$g)!, *%_) {
  925. nqp::if(
  926. nqp::elems(nqp::getattr(%_,Map,'$!storage')),
  927. self!match-cursor(nqp::getlexcaller('$/'),
  928. $pattern($cursor-init(Match,self,:0c)), 'g', $g, %_),
  929. nqp::if(
  930. $g,
  931. self!match-list(nqp::getlexcaller('$/'),
  932. $pattern($cursor-init(Match,self,:0c)),
  933. CURSOR-GLOBAL, POST-MATCH),
  934. self!match-one(nqp::getlexcaller('$/'),
  935. $pattern($cursor-init(Match,self,:0c)))
  936. )
  937. )
  938. }
  939. multi method match(Regex:D $pattern, :overlap(:$ov)!, *%_) {
  940. nqp::if(
  941. nqp::elems(nqp::getattr(%_,Map,'$!storage')),
  942. self!match-cursor(nqp::getlexcaller('$/'),
  943. $pattern($cursor-init(Match,self,:0c)), 'ov', $ov, %_),
  944. nqp::if(
  945. $ov,
  946. self!match-list(nqp::getlexcaller('$/'),
  947. $pattern($cursor-init(Match,self,:0c)),
  948. CURSOR-OVERLAP, POST-MATCH),
  949. self!match-one(nqp::getlexcaller('$/'),
  950. $pattern($cursor-init(Match,self,:0c)))
  951. )
  952. )
  953. }
  954. multi method match(Regex:D $pattern, :exhaustive(:$ex)!, *%_) {
  955. nqp::if(
  956. nqp::elems(nqp::getattr(%_,Map,'$!storage')),
  957. self!match-cursor(nqp::getlexcaller('$/'),
  958. $pattern($cursor-init(Match,self,:0c)), 'ex', $ex, %_),
  959. nqp::if(
  960. $ex,
  961. self!match-list(nqp::getlexcaller('$/'),
  962. $pattern($cursor-init(Match,self,:0c)),
  963. CURSOR-EXHAUSTIVE, POST-MATCH),
  964. self!match-one(nqp::getlexcaller('$/'),
  965. $pattern($cursor-init(Match,self,:0c)))
  966. )
  967. )
  968. }
  969. multi method match(Regex:D $pattern, :$x!, *%_) {
  970. nqp::if(
  971. nqp::elems(nqp::getattr(%_,Map,'$!storage')),
  972. self!match-cursor(nqp::getlexcaller('$/'),
  973. $pattern($cursor-init(Match,self,:0c)), 'x', $x, %_),
  974. nqp::if(
  975. nqp::defined($x),
  976. self!match-x(nqp::getlexcaller('$/'),
  977. POST-ITERATOR.new($pattern($cursor-init(Match,self,:0c)),
  978. CURSOR-GLOBAL, POST-MATCH
  979. ), $x),
  980. self!match-one(nqp::getlexcaller('$/'),
  981. $pattern($cursor-init(Match,self,:0c)), $x)
  982. )
  983. )
  984. }
  985. multi method match(Regex:D $pattern, :$st!, *%_) {
  986. self!match-nth(nqp::getlexcaller('$/'),
  987. $pattern($cursor-init(Match,self,:0c)),
  988. CURSOR-GLOBAL, POST-MATCH, $st, %_)
  989. }
  990. multi method match(Regex:D $pattern, :$nd!, *%_) {
  991. self!match-nth(nqp::getlexcaller('$/'),
  992. $pattern($cursor-init(Match,self,:0c)),
  993. CURSOR-GLOBAL, POST-MATCH, $nd, %_)
  994. }
  995. multi method match(Regex:D $pattern, :$rd!, *%_) {
  996. self!match-nth(nqp::getlexcaller('$/'),
  997. $pattern($cursor-init(Match,self,:0c)),
  998. CURSOR-GLOBAL, POST-MATCH, $rd, %_)
  999. }
  1000. multi method match(Regex:D $pattern, :$th!, *%_) {
  1001. self!match-nth(nqp::getlexcaller('$/'),
  1002. $pattern($cursor-init(Match,self,:0c)),
  1003. CURSOR-GLOBAL, POST-MATCH, $th, %_)
  1004. }
  1005. multi method match(Regex:D $pattern, :$nth!, *%_) {
  1006. self!match-nth(nqp::getlexcaller('$/'),
  1007. $pattern($cursor-init(Match,self,:0c)),
  1008. CURSOR-GLOBAL, POST-MATCH, $nth, %_)
  1009. }
  1010. multi method match(Regex:D $pattern, :$as!, *%_) {
  1011. nqp::if(
  1012. nqp::elems(nqp::getattr(%_,Map,'$!storage')),
  1013. self!match-cursor(nqp::getlexcaller('$/'),
  1014. $pattern($cursor-init(Match,self,:0c)), 'as', $as, %_),
  1015. self!match-as-one(nqp::getlexcaller('$/'),
  1016. $pattern($cursor-init(Match,self,:0c)), $as)
  1017. )
  1018. }
  1019. multi method match(Regex:D $pattern, *%_) {
  1020. nqp::if(
  1021. nqp::elems(nqp::getattr(%_,Map,'$!storage')),
  1022. self!match-cursor(nqp::getlexcaller('$/'),
  1023. $pattern($cursor-init(Match,self,:0c)), '', 0, %_),
  1024. self!match-one(nqp::getlexcaller('$/'),
  1025. $pattern($cursor-init(Match,self,:0c)))
  1026. )
  1027. }
  1028. proto method subst-mutate(|) {
  1029. $/ := nqp::getlexcaller('$/');
  1030. {*}
  1031. }
  1032. multi method subst-mutate(
  1033. Str:D $self is rw: Any:D $matcher, $replacement,
  1034. :ii(:$samecase), :ss(:$samespace), :mm(:$samemark), *%options
  1035. ) {
  1036. my $global = %options<g> || %options<global>;
  1037. my \caller_dollar_slash := nqp::getlexcaller('$/');
  1038. my $SET_DOLLAR_SLASH = nqp::istype($matcher, Regex);
  1039. my $word_by_word = so $samespace || %options<s> || %options<sigspace>;
  1040. my \matches := %options
  1041. ?? self.match($matcher, |%options)
  1042. !! self.match($matcher); # 30% faster
  1043. nqp::if(
  1044. nqp::istype(matches, Failure) || nqp::isfalse(matches),
  1045. nqp::stmts(
  1046. $SET_DOLLAR_SLASH && (try caller_dollar_slash = $/),
  1047. matches),
  1048. nqp::stmts(
  1049. ($self = $self!APPLY-MATCHES: matches, $replacement,
  1050. caller_dollar_slash, $SET_DOLLAR_SLASH, $word_by_word,
  1051. $samespace, $samecase, $samemark),
  1052. $SET_DOLLAR_SLASH && (try caller_dollar_slash = matches),
  1053. matches))
  1054. }
  1055. proto method subst(|) {
  1056. $/ := nqp::getlexcaller('$/');
  1057. {*}
  1058. }
  1059. multi method subst(Str:D: Str:D $original, Str:D $final, *%options) {
  1060. nqp::if(
  1061. (my $opts := nqp::getattr(%options,Map,'$!storage'))
  1062. && nqp::isgt_i(nqp::elems($opts),1),
  1063. self!SUBST(nqp::getlexcaller('$/'),$original,$final,|%options),
  1064. nqp::if(
  1065. nqp::elems($opts),
  1066. nqp::if( # one named
  1067. nqp::atkey($opts,'g') || nqp::atkey($opts,'global'),
  1068. Rakudo::Internals.TRANSPOSE(self, $original, $final),
  1069. nqp::if( # no trueish g/global
  1070. nqp::existskey($opts,'g') || nqp::existskey($opts,'global'),
  1071. Rakudo::Internals.TRANSPOSE-ONE(self, $original, $final),
  1072. self!SUBST(nqp::getlexcaller('$/'),$original,$final,|%options)
  1073. )
  1074. ),
  1075. Rakudo::Internals.TRANSPOSE-ONE(self, $original, $final) # no nameds
  1076. )
  1077. )
  1078. }
  1079. multi method subst(Str:D: $matcher, $replacement, *%options) {
  1080. self!SUBST(nqp::getlexcaller('$/'), $matcher, $replacement, |%options)
  1081. }
  1082. method !SUBST(Str:D: \caller_dollar_slash, $matcher, $replacement,
  1083. :global(:$g), :ii(:$samecase), :ss(:$samespace), :mm(:$samemark),
  1084. *%options
  1085. ) {
  1086. X::Str::Subst::Adverb.new(:name($_), :got(%options{$_})).throw
  1087. if %options{$_} for <ov ex>;
  1088. my $SET_DOLLAR_SLASH = nqp::istype($matcher, Regex);
  1089. my $word_by_word = so $samespace || %options<s> || %options<sigspace>;
  1090. my \matches := %options
  1091. ?? self.match($matcher, :$g, |%options)
  1092. !! self.match($matcher, :$g); # 30% faster
  1093. nqp::if(
  1094. nqp::istype(matches, Failure),
  1095. nqp::stmts(
  1096. $SET_DOLLAR_SLASH && (try caller_dollar_slash = Nil),
  1097. matches),
  1098. nqp::if(
  1099. matches,
  1100. nqp::stmts(
  1101. (my \res := self!APPLY-MATCHES: matches, $replacement,
  1102. caller_dollar_slash, $SET_DOLLAR_SLASH, $word_by_word,
  1103. $samespace, $samecase, $samemark),
  1104. $SET_DOLLAR_SLASH && (try caller_dollar_slash = matches),
  1105. res),
  1106. nqp::stmts(
  1107. $SET_DOLLAR_SLASH && (try caller_dollar_slash = matches),
  1108. self)))
  1109. }
  1110. # NOTE: this method is also called by s/// op in src/Perl6/Actions.nqp
  1111. method !APPLY-MATCHES(\matches,$replacement,\cds,\SDS,\word_by_word,\space,\case,\mark) {
  1112. my \callable := nqp::istype($replacement,Callable);
  1113. my int $prev;
  1114. my str $str = nqp::unbox_s(self);
  1115. my Mu $result := nqp::list_s();
  1116. # need to do something special
  1117. if SDS || space || case || mark || callable {
  1118. my \noargs := callable ?? $replacement.count == 0 !! False;
  1119. my \fancy := space || case || mark || word_by_word;
  1120. my \case-and-mark := case && mark;
  1121. for flat matches -> $m {
  1122. try cds = $m if SDS;
  1123. nqp::push_s(
  1124. $result,nqp::substr($str,$prev,nqp::unbox_i($m.from) - $prev)
  1125. );
  1126. if fancy {
  1127. my $mstr := $m.Str;
  1128. my $it := ~(callable
  1129. ?? (noargs ?? $replacement() !! $replacement($m))
  1130. !! $replacement
  1131. );
  1132. if word_by_word { # all spacers delegated to word-by-word
  1133. my &filter :=
  1134. case-and-mark
  1135. ?? -> $w,$p { $w.samemark($p).samecase($p) }
  1136. !! case
  1137. ?? -> $w,$p { $w.samecase($p) }
  1138. !! -> $w,$p { $w.samemark($p) }
  1139. nqp::push_s($result,nqp::unbox_s(
  1140. $it.word-by-word($mstr,&filter,:samespace(?space))
  1141. ) );
  1142. }
  1143. elsif case-and-mark {
  1144. nqp::push_s($result,nqp::unbox_s(
  1145. $it.samecase($mstr).samemark($mstr)
  1146. ) );
  1147. }
  1148. elsif case {
  1149. nqp::push_s($result,nqp::unbox_s($it.samecase(~$m)));
  1150. }
  1151. else { # mark
  1152. nqp::push_s($result,nqp::unbox_s($it.samemark(~$m)));
  1153. }
  1154. }
  1155. else {
  1156. nqp::push_s($result,nqp::unbox_s( ~(callable
  1157. ?? (noargs ?? $replacement() !! $replacement($m))
  1158. !! $replacement
  1159. ) ) );
  1160. }
  1161. $prev = nqp::unbox_i($m.to);
  1162. }
  1163. nqp::push_s($result,nqp::substr($str,$prev));
  1164. nqp::p6box_s(nqp::join('',$result));
  1165. }
  1166. # simple string replacement
  1167. else {
  1168. for flat matches -> $m {
  1169. nqp::push_s(
  1170. $result,nqp::substr($str,$prev,nqp::unbox_i($m.from) - $prev)
  1171. );
  1172. $prev = nqp::unbox_i($m.to);
  1173. }
  1174. nqp::push_s($result,nqp::substr($str,$prev));
  1175. nqp::p6box_s(nqp::join(nqp::unbox_s(~$replacement),$result));
  1176. }
  1177. }
  1178. multi method ords(Str:D:) { self.NFC.list }
  1179. proto method lines(|) {*}
  1180. multi method lines(Str:D: :$count!) {
  1181. # we should probably deprecate this feature
  1182. $count ?? self.lines.elems !! self.lines;
  1183. }
  1184. multi method lines(Str:D: $limit) {
  1185. nqp::istype($limit,Whatever) || $limit == Inf
  1186. ?? self.lines
  1187. !! self.lines.head($limit)
  1188. }
  1189. multi method lines(Str:D:) {
  1190. Seq.new(class :: does Iterator {
  1191. has str $!str;
  1192. has int $!chars;
  1193. has int $!pos;
  1194. method !SET-SELF(\string) {
  1195. $!str = nqp::unbox_s(string);
  1196. $!chars = nqp::chars($!str);
  1197. $!pos = 0;
  1198. self
  1199. }
  1200. method new(\string) { nqp::create(self)!SET-SELF(string) }
  1201. method pull-one() {
  1202. my int $left;
  1203. return IterationEnd if ($left = $!chars - $!pos) <= 0;
  1204. my int $nextpos = nqp::findcclass(
  1205. nqp::const::CCLASS_NEWLINE, $!str, $!pos, $left);
  1206. my str $found = nqp::substr($!str, $!pos, $nextpos - $!pos);
  1207. $!pos = $nextpos + 1;
  1208. $found;
  1209. }
  1210. method push-all($target --> IterationEnd) {
  1211. my int $left;
  1212. my int $nextpos;
  1213. while ($left = $!chars - $!pos) > 0 {
  1214. $nextpos = nqp::findcclass(
  1215. nqp::const::CCLASS_NEWLINE, $!str, $!pos, $left);
  1216. $target.push(nqp::substr($!str, $!pos, $nextpos - $!pos));
  1217. $!pos = $nextpos + 1;
  1218. }
  1219. }
  1220. }.new(self));
  1221. }
  1222. method !ensure-split-sanity(\v,\k,\kv,\p) {
  1223. # cannot combine these
  1224. my int $any = ?v + ?k + ?kv + ?p;
  1225. X::Adverb.new(
  1226. what => 'split',
  1227. source => 'Str',
  1228. nogo => (:v(v),:k(k),:kv(kv),:p(p)).grep(*.value).map(*.key),
  1229. ).throw if nqp::isgt_i($any,1);
  1230. $any
  1231. }
  1232. method !ensure-limit-sanity(\limit --> Nil) {
  1233. X::TypeCheck.new(
  1234. operation => 'split ($limit argument)',
  1235. expected => 'any Real type (non-NaN) or Whatever',
  1236. got => limit.perl,
  1237. ).throw if limit === NaN;
  1238. limit = Inf if nqp::istype(limit,Whatever);
  1239. }
  1240. method parse-base(Str:D: Int:D $radix) {
  1241. fail X::Syntax::Number::RadixOutOfRange.new(:$radix)
  1242. unless 2 <= $radix <= 36; # (0..9,"a".."z").elems == 36
  1243. # do not modify $!value directly as that affects other same strings
  1244. my ($value, $sign, $sign-offset) = $!value, 1, 0;
  1245. given $value.substr(0,1) {
  1246. when '-'|'−' { $sign = -1; $sign-offset = 1 }
  1247. when '+' { $sign-offset = 1 }
  1248. }
  1249. if $value.contains('.') { # fractional
  1250. my ($whole, $fract) = $value.split: '.', 2;
  1251. my $w-parsed := nqp::radix_I($radix, $whole, $sign-offset, 0, Int);
  1252. my $f-parsed := nqp::radix_I($radix, $fract, 0, 0, Int);
  1253. # Whole part did not parse in its entirety
  1254. fail X::Str::Numeric.new(
  1255. :source($value),
  1256. :pos($w-parsed[2] max $sign-offset),
  1257. :reason("malformed base-$radix number"),
  1258. ) unless $w-parsed[2] == nqp::chars($whole)
  1259. or nqp::chars($whole) == $sign-offset; # or have no whole part
  1260. # Fractional part did not parse in its entirety
  1261. fail X::Str::Numeric.new(
  1262. :source($value),
  1263. :pos(
  1264. ($w-parsed[2] max $sign-offset)
  1265. + 1 # decimal dot
  1266. + ($f-parsed[2] max 0)
  1267. ),
  1268. :reason("malformed base-$radix number"),
  1269. ) unless $f-parsed[2] == nqp::chars($fract);
  1270. $sign * ($w-parsed[0] + $f-parsed[0]/$f-parsed[1]);
  1271. }
  1272. else { # Int
  1273. my $parsed := nqp::radix_I($radix, $value, $sign-offset, 0, Int);
  1274. # Did not parse the number in its entirety
  1275. fail X::Str::Numeric.new(
  1276. :source($value),
  1277. :pos($parsed[2] max $sign-offset),
  1278. :reason("malformed base-$radix number"),
  1279. ) unless $parsed[2] == nqp::chars($value);
  1280. $sign * $parsed[0];
  1281. }
  1282. }
  1283. multi method split(Str:D: Regex:D $pat, $limit is copy = Inf;;
  1284. :$v is copy, :$k, :$kv, :$p, :$skip-empty) {
  1285. my int $any = self!ensure-split-sanity($v,$k,$kv,$p);
  1286. self!ensure-limit-sanity($limit);
  1287. return Seq.new(Rakudo::Iterator.Empty) if $limit <= 0;
  1288. my \matches = $limit == Inf
  1289. ?? self.match($pat, :g)
  1290. !! self.match($pat, :x(1..$limit-1));
  1291. my str $str = nqp::unbox_s(self);
  1292. my int $elems = +matches; # make sure all reified
  1293. return Seq.new(Rakudo::Iterator.OneValue(self)) unless $elems;
  1294. my $matches := nqp::getattr(matches,List,'$!reified');
  1295. my $result := nqp::create(IterationBuffer);
  1296. my int $i = -1;
  1297. my int $pos;
  1298. my int $found;
  1299. if $any || $skip-empty {
  1300. my int $notskip = !$skip-empty;
  1301. my int $next;
  1302. while nqp::islt_i(++$i,$elems) {
  1303. my $match := nqp::decont(nqp::atpos($matches,$i));
  1304. $found = nqp::getattr_i($match,Match,'$!from');
  1305. $next = $match.to;
  1306. if $notskip {
  1307. nqp::push($result,
  1308. nqp::substr($str,$pos,nqp::sub_i($found,$pos)));
  1309. }
  1310. elsif nqp::sub_i($found,$pos) -> $chars {
  1311. nqp::push($result,
  1312. nqp::substr($str,$pos,$chars));
  1313. }
  1314. nqp::if(
  1315. $any,
  1316. nqp::if(
  1317. $v,
  1318. nqp::push($result,$match), # v
  1319. nqp::if(
  1320. $k,
  1321. nqp::push($result,0), # k
  1322. nqp::if(
  1323. $kv,
  1324. nqp::stmts(
  1325. nqp::push($result,0), # kv
  1326. nqp::push($result,$match) # kv
  1327. ),
  1328. nqp::push($result, Pair.new(0,$match)) # $p
  1329. )
  1330. )
  1331. )
  1332. );
  1333. $pos = $next;
  1334. }
  1335. nqp::push($result,nqp::substr($str,$pos))
  1336. if $notskip || nqp::islt_i($pos,nqp::chars($str));
  1337. }
  1338. else {
  1339. my $match;
  1340. nqp::setelems($result,$elems + 1);
  1341. while nqp::islt_i(++$i,$elems) {
  1342. $match := nqp::decont(nqp::atpos($matches,$i));
  1343. $found = nqp::getattr_i($match,Match,'$!from');
  1344. nqp::bindpos($result,$i,
  1345. nqp::substr($str,$pos,nqp::sub_i($found,$pos)));
  1346. $pos = $match.to;
  1347. }
  1348. nqp::bindpos($result,$i,nqp::substr($str,$pos));
  1349. }
  1350. Seq.new(Rakudo::Iterator.ReifiedList($result))
  1351. }
  1352. multi method split(Str:D: Str(Cool) $match;;
  1353. :$v is copy, :$k, :$kv, :$p, :$skip-empty) {
  1354. my int $any = self!ensure-split-sanity($v,$k,$kv,$p);
  1355. # nothing to work with
  1356. my str $needle = nqp::unbox_s($match);
  1357. my int $chars = nqp::chars($needle);
  1358. return Seq.new($chars && !$skip-empty
  1359. ?? Rakudo::Iterator.OneValue(self)
  1360. !! Rakudo::Iterator.Empty
  1361. ) unless self.chars;
  1362. # split really, really fast in NQP, also supports ""
  1363. my $matches := nqp::split($needle,nqp::unbox_s(self));
  1364. # interleave the necessary strings if needed
  1365. if $chars {
  1366. if $any {
  1367. my $match-list :=
  1368. $v ?? nqp::list($needle)
  1369. !! $k ?? nqp::list(0)
  1370. !! $kv ?? nqp::list(0,$needle)
  1371. !! nqp::list(Pair.new(0,$needle)); # $p
  1372. if $match-list {
  1373. my int $i = nqp::elems($matches);
  1374. if $skip-empty {
  1375. nqp::splice($matches,$match-list,$i,
  1376. nqp::not_i(nqp::isne_i(
  1377. nqp::chars(nqp::atpos($matches,$i)),0)))
  1378. while $i = nqp::sub_i($i,1);
  1379. nqp::splice($matches,$empty,0,1)
  1380. unless nqp::chars(nqp::atpos($matches,0));
  1381. }
  1382. else {
  1383. nqp::splice($matches,$match-list,$i,0)
  1384. while $i = nqp::sub_i($i,1);
  1385. }
  1386. }
  1387. }
  1388. elsif $skip-empty {
  1389. my int $i = nqp::elems($matches);
  1390. my $match-list := nqp::list;
  1391. while nqp::isge_i($i = nqp::sub_i($i,1),0) {
  1392. nqp::splice($matches,$match-list,$i,1)
  1393. if nqp::iseq_i(nqp::chars(nqp::atpos($matches,$i)),0);
  1394. }
  1395. }
  1396. }
  1397. # single chars need empty before/after, unless inhibited
  1398. elsif !$skip-empty {
  1399. nqp::unshift($matches,"");
  1400. nqp::push($matches,"");
  1401. }
  1402. Seq.new(Rakudo::Iterator.ReifiedList($matches))
  1403. }
  1404. multi method split(Str:D: Str(Cool) $match, $limit is copy = Inf;;
  1405. :$v is copy, :$k, :$kv, :$p, :$skip-empty) {
  1406. my int $any = self!ensure-split-sanity($v,$k,$kv,$p);
  1407. self!ensure-limit-sanity($limit);
  1408. return Seq.new(Rakudo::Iterator.Empty) if $limit <= 0;
  1409. # nothing to work with
  1410. my int $chars = $match.chars;
  1411. if !self.chars {
  1412. return $chars ?? self.list !! ();
  1413. }
  1414. # nothing to do
  1415. elsif $limit == 1 {
  1416. return self.list;
  1417. }
  1418. # want them all
  1419. elsif $limit == Inf {
  1420. return self.split($match,:$v,:$k,:$kv,:$p,:$skip-empty);
  1421. }
  1422. # we have something to split on
  1423. elsif $chars {
  1424. # let the multi-needle handler handle all nameds
  1425. return self.split(($match,),$limit,:$v,:$k,:$kv,:$p,:$skip-empty)
  1426. if $any || $skip-empty;
  1427. # make the sequence
  1428. Seq.new(class :: does Iterator {
  1429. has str $!string;
  1430. has int $!chars;
  1431. has str $!match;
  1432. has int $!match-chars;
  1433. has int $!todo;
  1434. has int $!pos;
  1435. method !SET-SELF(\string, \match, \todo) {
  1436. $!string = nqp::unbox_s(string);
  1437. $!chars = nqp::chars($!string);
  1438. $!match = nqp::unbox_s(match);
  1439. $!match-chars = nqp::chars($!match);
  1440. $!todo = todo - 1;
  1441. self
  1442. }
  1443. method new(\string,\match,\todo) {
  1444. nqp::create(self)!SET-SELF(string,match,todo)
  1445. }
  1446. method !last-part() is raw {
  1447. my str $string = nqp::substr($!string,$!pos);
  1448. $!pos = $!chars + 1;
  1449. $!todo = 0;
  1450. nqp::p6box_s($string)
  1451. }
  1452. method !next-part(int $found) is raw {
  1453. my str $string =
  1454. nqp::substr($!string,$!pos, $found - $!pos);
  1455. $!pos = $found + $!match-chars;
  1456. nqp::p6box_s($string);
  1457. }
  1458. method pull-one() is raw {
  1459. if $!todo {
  1460. $!todo = $!todo - 1;
  1461. my int $found = nqp::index($!string,$!match,$!pos);
  1462. nqp::islt_i($found,0)
  1463. ?? nqp::isle_i($!pos,$!chars)
  1464. ?? self!last-part
  1465. !! IterationEnd
  1466. !! self!next-part($found);
  1467. }
  1468. else {
  1469. nqp::isle_i($!pos,$!chars)
  1470. ?? self!last-part
  1471. !! IterationEnd
  1472. }
  1473. }
  1474. method push-all($target --> IterationEnd) {
  1475. while $!todo {
  1476. $!todo = $!todo - 1;
  1477. my int $found = nqp::index($!string,$!match,$!pos);
  1478. nqp::islt_i($found,0)
  1479. ?? ($!todo = 0)
  1480. !! $target.push(self!next-part($found));
  1481. }
  1482. $target.push(self!last-part) if nqp::isle_i($!pos,$!chars);
  1483. }
  1484. method sink-all(--> IterationEnd) { }
  1485. }.new(self,$match,$limit));
  1486. }
  1487. # just separate chars
  1488. else {
  1489. Seq.new(class :: does Iterator {
  1490. has str $!string;
  1491. has int $!todo;
  1492. has int $!chars;
  1493. has int $!pos;
  1494. has int $!first;
  1495. has int $!last;
  1496. method !SET-SELF(\string, \todo, \skip-empty) {
  1497. $!string = nqp::unbox_s(string);
  1498. $!chars = nqp::chars($!string);
  1499. $!todo = todo;
  1500. $!first = !skip-empty;
  1501. if $!todo > $!chars + 2 { # will return all chars
  1502. $!todo = $!chars + 1;
  1503. $!last = !skip-empty;
  1504. }
  1505. else {
  1506. $!todo = $!todo - 1;
  1507. $!last = !skip-empty && ($!todo == $!chars + 1);
  1508. }
  1509. self
  1510. }
  1511. method new(\string,\todo,\skip-empty) {
  1512. nqp::create(self)!SET-SELF(string,todo,skip-empty)
  1513. }
  1514. method pull-one() is raw {
  1515. if $!first { # do empty string first
  1516. $!first = 0;
  1517. $!todo = $!todo - 1;
  1518. ""
  1519. }
  1520. elsif $!todo { # next char
  1521. $!todo = $!todo - 1;
  1522. nqp::p6box_s(nqp::substr($!string,$!pos++,1))
  1523. }
  1524. elsif $!last { # do final empty string
  1525. $!last = 0;
  1526. ""
  1527. }
  1528. elsif nqp::islt_i($!pos,$!chars) { # do rest of string
  1529. my str $rest = nqp::substr($!string,$!pos);
  1530. $!pos = $!chars;
  1531. nqp::p6box_s($rest)
  1532. }
  1533. else {
  1534. IterationEnd
  1535. }
  1536. }
  1537. method push-all($target --> IterationEnd) {
  1538. $target.push("") if $!first;
  1539. $!todo = $!todo - 1;
  1540. while $!todo {
  1541. $target.push(
  1542. nqp::p6box_s(nqp::substr($!string,$!pos++,1)));
  1543. $!todo = $!todo - 1;
  1544. }
  1545. $target.push( nqp::p6box_s(nqp::substr($!string,$!pos)))
  1546. if nqp::islt_i($!pos,$!chars);
  1547. $target.push("") if $!last;
  1548. }
  1549. method count-only() { nqp::p6box_i($!todo + $!first + $!last) }
  1550. method bool-only() { nqp::p6bool($!todo + $!first + $!last) }
  1551. method sink-all(--> IterationEnd) { }
  1552. }.new(self,$limit,$skip-empty));
  1553. }
  1554. }
  1555. multi method split(Str:D: @needles, $parts is copy = Inf;;
  1556. :$v is copy, :$k, :$kv, :$p, :$skip-empty) {
  1557. my int $any = self!ensure-split-sanity($v,$k,$kv,$p);
  1558. # must all be Cool, otherwise we'll just use a regex
  1559. return self.split(rx/ @needles /,:$v,:$k,:$kv,:$p,:$skip-empty) # / hl
  1560. unless Rakudo::Internals.ALL_TYPE(@needles,Cool);
  1561. self!ensure-limit-sanity($parts);
  1562. return Seq.new(Rakudo::Iterator.Empty) if $parts <= 0;
  1563. my int $limit = $parts.Int
  1564. unless nqp::istype($parts,Whatever) || $parts == Inf;
  1565. my str $str = nqp::unbox_s(self);
  1566. my $positions := nqp::list;
  1567. my $needles := nqp::list_s;
  1568. my $needle-chars := nqp::list_i;
  1569. my $needles-seen := nqp::hash;
  1570. my int $tried;
  1571. my int $fired;
  1572. # search using all needles
  1573. my int $index = 0;
  1574. for @needles -> $needle {
  1575. my str $need = nqp::unbox_s($needle.DEFINITE ?? $needle.Str !! "");
  1576. my int $chars = nqp::chars($need);
  1577. nqp::push_s($needles,$need);
  1578. nqp::push_i($needle-chars,$chars);
  1579. # search for this needle if there is one, and not done before
  1580. nqp::if(
  1581. nqp::isgt_i($chars,0)
  1582. && nqp::not_i(nqp::existskey($needles-seen,$need)),
  1583. nqp::stmts(
  1584. nqp::bindkey($needles-seen,$need,1),
  1585. (my int $pos),
  1586. (my int $i),
  1587. (my int $seen = nqp::elems($positions)),
  1588. nqp::if(
  1589. nqp::isgt_i($limit,0), # 0 = no limit
  1590. nqp::stmts(
  1591. (my int $todo = $limit),
  1592. nqp::while(
  1593. nqp::isge_i(($todo = nqp::sub_i($todo,1)),0)
  1594. && nqp::isge_i($i = nqp::index($str,$need,$pos),0),
  1595. nqp::stmts(
  1596. nqp::push($positions,nqp::list_i($i,$index)),
  1597. ($pos = nqp::add_i($i,1)),
  1598. )
  1599. )
  1600. ),
  1601. nqp::while(
  1602. nqp::isge_i($i = nqp::index($str,$need,$pos),0),
  1603. nqp::stmts(
  1604. nqp::push($positions,nqp::list_i($i,$index)),
  1605. ($pos = nqp::add_i($i,1))
  1606. )
  1607. )
  1608. ),
  1609. ($tried = nqp::add_i($tried,1)),
  1610. ($fired =
  1611. nqp::add_i($fired,nqp::isge_i(nqp::elems($positions),$seen)))
  1612. )
  1613. );
  1614. $index = nqp::add_i($index, 1);
  1615. }
  1616. # no needle tried, assume we want chars
  1617. return self.split("",$limit) if nqp::not_i($tried);
  1618. # sort by position if more than one needle fired
  1619. $positions := nqp::getattr(
  1620. Rakudo::Sorting.MERGESORT-REIFIED-LIST-WITH(
  1621. nqp::p6bindattrinvres(
  1622. nqp::create(List),List,'$!reified',$positions
  1623. ),
  1624. -> \a, \b {
  1625. nqp::cmp_i(
  1626. nqp::atpos_i(a,0),
  1627. nqp::atpos_i(b,0)
  1628. ) || nqp::cmp_i(
  1629. nqp::atpos_i($needle-chars,nqp::atpos_i(b,1)),
  1630. nqp::atpos_i($needle-chars,nqp::atpos_i(a,1))
  1631. )
  1632. }
  1633. ),
  1634. List,
  1635. '$!reified'
  1636. ) if nqp::isgt_i($fired,1);
  1637. # remove elements we don't want
  1638. if nqp::isgt_i($limit,0) {
  1639. nqp::stmts(
  1640. (my int $limited = 1), # split one less than entries returned
  1641. (my int $elems = nqp::elems($positions)),
  1642. (my int $pos),
  1643. (my int $i = -1),
  1644. nqp::while(
  1645. nqp::islt_i(($i = nqp::add_i($i,1)),$elems)
  1646. && nqp::islt_i($limited,$limit),
  1647. nqp::if(
  1648. nqp::isge_i( # not hidden by other needle
  1649. nqp::atpos_i(nqp::atpos($positions,$i),0),
  1650. $pos
  1651. ),
  1652. nqp::stmts(
  1653. ($limited = nqp::add_i($limited,1)),
  1654. ($pos = nqp::add_i(
  1655. nqp::atpos_i(nqp::atpos($positions,$i),0),
  1656. nqp::atpos_i($needle-chars,
  1657. nqp::atpos_i(nqp::atpos($positions,$i),1))
  1658. ))
  1659. )
  1660. )
  1661. ),
  1662. nqp::if(
  1663. nqp::islt_i($i,$elems),
  1664. nqp::splice($positions,$empty,
  1665. $i,nqp::sub_i(nqp::elems($positions),$i))
  1666. )
  1667. )
  1668. }
  1669. # create the final result
  1670. my int $skip = ?$skip-empty;
  1671. my int $pos = 0;
  1672. my $result := nqp::create(IterationBuffer);
  1673. if $any {
  1674. nqp::stmts(
  1675. (my int $i = -1),
  1676. (my int $elems = nqp::elems($positions)),
  1677. nqp::while(
  1678. nqp::islt_i(($i = nqp::add_i($i,1)),$elems),
  1679. nqp::if(
  1680. nqp::isge_i( # not hidden by other needle
  1681. (my int $from = nqp::atpos_i(
  1682. (my $pair := nqp::atpos($positions,$i)),0)
  1683. ),
  1684. $pos
  1685. ),
  1686. nqp::stmts(
  1687. (my int $needle-index = nqp::atpos_i($pair,1)),
  1688. nqp::unless(
  1689. $skip && nqp::iseq_i($from,$pos),
  1690. nqp::push($result,
  1691. nqp::substr($str,$pos,nqp::sub_i($from,$pos)))
  1692. ),
  1693. nqp::if($k || $kv,
  1694. nqp::push($result,nqp::clone($needle-index))
  1695. ),
  1696. nqp::if($v || $kv,
  1697. nqp::push($result,nqp::atpos_s($needles,$needle-index))
  1698. ),
  1699. nqp::if($p,
  1700. nqp::push($result,Pair.new(
  1701. $needle-index,nqp::atpos_s($needles,$needle-index)))
  1702. ),
  1703. ($pos = nqp::add_i(
  1704. $from,
  1705. nqp::atpos_i($needle-chars,$needle-index)
  1706. ))
  1707. )
  1708. )
  1709. )
  1710. )
  1711. }
  1712. else {
  1713. nqp::stmts(
  1714. (my int $i = -1),
  1715. (my int $elems = nqp::elems($positions)),
  1716. nqp::while(
  1717. nqp::islt_i(($i = nqp::add_i($i,1)),$elems),
  1718. nqp::if(
  1719. nqp::isge_i( # not hidden by other needle
  1720. (my int $from = nqp::atpos_i(
  1721. (my $pair := nqp::atpos($positions,$i)),0)
  1722. ),
  1723. $pos
  1724. ),
  1725. nqp::stmts(
  1726. nqp::unless(
  1727. $skip && nqp::iseq_i($from,$pos),
  1728. nqp::push($result,
  1729. nqp::substr($str,$pos,nqp::sub_i($from,$pos))),
  1730. ),
  1731. ($pos = nqp::add_i($from,
  1732. nqp::atpos_i($needle-chars,nqp::atpos_i($pair,1))
  1733. ))
  1734. )
  1735. )
  1736. )
  1737. )
  1738. }
  1739. nqp::push($result,nqp::substr($str,$pos))
  1740. unless $skip && nqp::iseq_i($pos,nqp::chars($str));
  1741. Seq.new(Rakudo::Iterator.ReifiedList($result))
  1742. }
  1743. # Note that in these same* methods, as used by s/LHS/RHS/, the
  1744. # pattern is actually the original string matched by LHS, while the
  1745. # invocant "original" is really the replacement RHS part. Confusing...
  1746. method samecase(Str:D: Str:D $pattern) {
  1747. nqp::if(
  1748. nqp::chars(nqp::unbox_s($pattern)), # something to work with
  1749. nqp::stmts(
  1750. (my $result := nqp::list_s),
  1751. (my $cases := nqp::getattr($pattern,Str,'$!value')),
  1752. (my int $base-chars = nqp::chars($!value)),
  1753. (my int $cases-chars = nqp::if(
  1754. nqp::isgt_i(nqp::chars($cases),$base-chars),
  1755. $base-chars,
  1756. nqp::chars($cases)
  1757. )),
  1758. (my int $i = 0),
  1759. (my int $j = 0),
  1760. (my int $prev-case = nqp::if( # set up initial case
  1761. nqp::iscclass(nqp::const::CCLASS_LOWERCASE,$cases,0),
  1762. -1,
  1763. nqp::iscclass(nqp::const::CCLASS_UPPERCASE,$cases,0)
  1764. )),
  1765. nqp::while( # other chars in pattern
  1766. nqp::islt_i(($i = nqp::add_i($i,1)),$cases-chars),
  1767. nqp::stmts(
  1768. (my int $case = nqp::if( # -1 =lc, 1 = uc, 0 = else
  1769. nqp::iscclass(nqp::const::CCLASS_LOWERCASE,$cases,$i),
  1770. -1,
  1771. nqp::iscclass(nqp::const::CCLASS_UPPERCASE,$cases,$i)
  1772. )),
  1773. nqp::if(
  1774. nqp::isne_i($case,$prev-case),
  1775. nqp::stmts( # seen a change
  1776. nqp::push_s($result,nqp::if(
  1777. nqp::iseq_i($prev-case,-1), # coming from lc
  1778. nqp::lc(nqp::substr($!value,$j,nqp::sub_i($i,$j))),
  1779. nqp::if(
  1780. nqp::iseq_i($prev-case,1), # coming from uc
  1781. nqp::uc(nqp::substr($!value,$j,nqp::sub_i($i,$j))),
  1782. nqp::substr($!value,$j,nqp::sub_i($i,$j))
  1783. )
  1784. )),
  1785. ($prev-case = $case),
  1786. ($j = $i)
  1787. )
  1788. )
  1789. )
  1790. ),
  1791. nqp::if( # something left
  1792. nqp::islt_i($j,$base-chars),
  1793. nqp::push_s($result,nqp::if(
  1794. nqp::iseq_i($prev-case,-1), # must become lc
  1795. nqp::lc(nqp::substr($!value,$j,nqp::sub_i($base-chars,$j))),
  1796. nqp::if(
  1797. nqp::iseq_i($prev-case,1), # must become uc
  1798. nqp::uc(nqp::substr($!value,$j,nqp::sub_i($base-chars,$j))),
  1799. nqp::substr($!value,$j,nqp::sub_i($base-chars,$j))
  1800. )
  1801. ))
  1802. ),
  1803. nqp::join("",$result) # wrap it up
  1804. ),
  1805. self # nothing to be done
  1806. )
  1807. }
  1808. method samemark(Str:D: Str:D $pattern) {
  1809. nqp::if(
  1810. nqp::chars(nqp::unbox_s($pattern)), # something to work with
  1811. nqp::stmts(
  1812. (my $base := nqp::split("",$!value)),
  1813. (my $marks := nqp::split("",nqp::unbox_s($pattern))),
  1814. (my int $base-elems = nqp::elems($base)),
  1815. (my int $marks-elems = nqp::elems($marks) min $base-elems),
  1816. (my $result := nqp::setelems(nqp::list_s,$base-elems)),
  1817. (my int $i = -1),
  1818. nqp::while( # for all marks
  1819. nqp::islt_i(($i = nqp::add_i($i,1)),$marks-elems),
  1820. nqp::bindpos_s($result,$i, # store the result of:
  1821. nqp::stmts(
  1822. (my $marks-nfd := nqp::strtocodes( # char + accents of mark
  1823. nqp::atpos($marks,$i),
  1824. nqp::const::NORMALIZE_NFD,
  1825. nqp::create(NFD)
  1826. )),
  1827. nqp::shift_i($marks-nfd), # lose the char
  1828. (my $marks-base := nqp::strtocodes( # char + accents of base
  1829. nqp::atpos($base,$i),
  1830. nqp::const::NORMALIZE_NFD,
  1831. nqp::create(NFD)
  1832. )),
  1833. nqp::strfromcodes( # join base+rest of marks
  1834. nqp::splice(
  1835. $marks-base,
  1836. $marks-nfd,
  1837. 1,
  1838. nqp::sub_i(nqp::elems($marks-base),1)
  1839. )
  1840. )
  1841. )
  1842. )
  1843. ),
  1844. ($i = nqp::sub_i($i,1)),
  1845. nqp::while( # remaining base chars
  1846. nqp::islt_i(($i = nqp::add_i($i,1)),$base-elems),
  1847. nqp::bindpos_s($result,$i, # store the result of:
  1848. nqp::stmts(
  1849. ($marks-base := nqp::strtocodes( # char+all accents of base
  1850. nqp::atpos($base,$i),
  1851. nqp::const::NORMALIZE_NFD,
  1852. nqp::create(NFD)
  1853. )),
  1854. nqp::strfromcodes( # join base+rest of marks
  1855. nqp::splice(
  1856. $marks-base,
  1857. $marks-nfd, # NOTE: state of last iteration previous loop
  1858. 1,
  1859. nqp::sub_i(nqp::elems($marks-base),1)
  1860. )
  1861. )
  1862. )
  1863. )
  1864. ),
  1865. nqp::join("",$result) # wrap it up
  1866. ),
  1867. self # nothing to be done
  1868. )
  1869. }
  1870. method samespace(Str:D: Str:D $pattern) { self.word-by-word($pattern, :samespace) }
  1871. method word-by-word(Str:D: Str:D $pattern, &filter?, Bool :$samespace) {
  1872. my str $str = nqp::unbox_s(self);
  1873. my str $pat = nqp::unbox_s($pattern);
  1874. my Mu $ret := nqp::list_s;
  1875. my int $chars = nqp::chars($str);
  1876. my int $pos = 0;
  1877. my int $nextpos;
  1878. my int $patchars = nqp::chars($pat);
  1879. my int $patpos = 0;
  1880. my int $patnextpos;
  1881. my int $left;
  1882. my $patword;
  1883. # Still something to look for?
  1884. while ($left = $chars - $pos) > 0 {
  1885. $nextpos = nqp::findcclass(
  1886. nqp::const::CCLASS_WHITESPACE, $str, $pos, $left);
  1887. $patnextpos = nqp::findcclass(nqp::const::CCLASS_WHITESPACE, $pat, $patpos, $patchars - $patpos);
  1888. if &filter {
  1889. # We latch on last pattern word if pattern runs out of words first.
  1890. $patword := nqp::p6box_s(nqp::substr($pat, $patpos, $patnextpos - $patpos)) if $patpos < $patchars;
  1891. nqp::push_s($ret, nqp::unbox_s(filter(nqp::substr($str, $pos, $nextpos - $pos), $patword)));
  1892. }
  1893. else {
  1894. nqp::push_s($ret, nqp::substr($str, $pos, $nextpos - $pos));
  1895. }
  1896. # Did we have the last word?
  1897. last if $nextpos >= $chars;
  1898. $pos = nqp::findnotcclass( nqp::const::CCLASS_WHITESPACE,
  1899. $str, $nextpos, $chars - $nextpos);
  1900. if $patnextpos >= $patchars { # No more pat space, just copy original space.
  1901. nqp::push_s($ret,
  1902. nqp::substr($str, $nextpos, $pos - $nextpos));
  1903. $patpos = $patnextpos;
  1904. }
  1905. else { # Traverse pat space, use if wanted
  1906. $patpos = nqp::findnotcclass( nqp::const::CCLASS_WHITESPACE,
  1907. $pat, $patnextpos, $patchars - $patnextpos);
  1908. if $samespace { # Carry over pattern space?
  1909. nqp::push_s($ret,
  1910. nqp::substr($pat, $patnextpos, $patpos - $patnextpos));
  1911. }
  1912. else { # Nope, just use original space.
  1913. nqp::push_s($ret,
  1914. nqp::substr($str, $nextpos, $pos - $nextpos));
  1915. }
  1916. }
  1917. }
  1918. nqp::join("",$ret)
  1919. }
  1920. method trim-leading(Str:D:) {
  1921. my str $str = nqp::unbox_s(self);
  1922. my int $pos = nqp::findnotcclass(
  1923. nqp::const::CCLASS_WHITESPACE,
  1924. $str, 0, nqp::chars($str));
  1925. $pos ?? nqp::p6box_s(nqp::substr($str, $pos)) !! self;
  1926. }
  1927. method trim-trailing(Str:D:) {
  1928. my str $str = nqp::unbox_s(self);
  1929. my int $pos = nqp::chars($str) - 1;
  1930. $pos = $pos - 1
  1931. while nqp::isge_i($pos, 0)
  1932. && nqp::iscclass(nqp::const::CCLASS_WHITESPACE, $str, $pos);
  1933. nqp::islt_i($pos, 0) ?? '' !! nqp::p6box_s(nqp::substr($str, 0, $pos + 1));
  1934. }
  1935. method trim(Str:D:) {
  1936. my str $str = nqp::unbox_s(self);
  1937. my int $pos = nqp::chars($str) - 1;
  1938. my int $left = nqp::findnotcclass(
  1939. nqp::const::CCLASS_WHITESPACE, $str, 0, $pos + 1);
  1940. $pos = $pos - 1
  1941. while nqp::isge_i($pos, $left)
  1942. && nqp::iscclass(nqp::const::CCLASS_WHITESPACE, $str, $pos);
  1943. nqp::islt_i($pos, $left) ?? '' !! nqp::p6box_s(nqp::substr($str, $left, $pos + 1 - $left));
  1944. }
  1945. proto method words(|) {*}
  1946. multi method words(Str:D: :$autoderef!) { # in Actions.postprocess_words
  1947. my @list := self.words.List;
  1948. return @list == 1 ?? @list[0] !! @list;
  1949. }
  1950. multi method words(Str:D: $limit) {
  1951. nqp::istype($limit,Whatever) || $limit == Inf
  1952. ?? self.words
  1953. !! self.words.head($limit)
  1954. }
  1955. multi method words(Str:D:) {
  1956. Seq.new(class :: does Iterator {
  1957. has str $!str;
  1958. has int $!chars;
  1959. has int $!pos;
  1960. method !SET-SELF(\string) {
  1961. $!str = nqp::unbox_s(string);
  1962. $!chars = nqp::chars($!str);
  1963. $!pos = nqp::findnotcclass(
  1964. nqp::const::CCLASS_WHITESPACE, $!str, 0, $!chars);
  1965. self
  1966. }
  1967. method new(\string) { nqp::create(self)!SET-SELF(string) }
  1968. method pull-one() {
  1969. my int $left;
  1970. my int $nextpos;
  1971. if ($left = $!chars - $!pos) > 0 {
  1972. $nextpos = nqp::findcclass(
  1973. nqp::const::CCLASS_WHITESPACE, $!str, $!pos, $left);
  1974. my str $found =
  1975. nqp::substr($!str, $!pos, $nextpos - $!pos);
  1976. $!pos = nqp::findnotcclass( nqp::const::CCLASS_WHITESPACE,
  1977. $!str, $nextpos, $!chars - $nextpos);
  1978. return nqp::p6box_s($found);
  1979. }
  1980. IterationEnd
  1981. }
  1982. method push-all($target --> IterationEnd) {
  1983. my int $left;
  1984. my int $nextpos;
  1985. while ($left = $!chars - $!pos) > 0 {
  1986. $nextpos = nqp::findcclass(
  1987. nqp::const::CCLASS_WHITESPACE, $!str, $!pos, $left);
  1988. $target.push(nqp::p6box_s(
  1989. nqp::substr($!str, $!pos, $nextpos - $!pos)
  1990. ));
  1991. $!pos = nqp::findnotcclass( nqp::const::CCLASS_WHITESPACE,
  1992. $!str, $nextpos, $!chars - $nextpos);
  1993. }
  1994. }
  1995. }.new(self));
  1996. }
  1997. proto method encode(|) {*}
  1998. multi method encode(Str:D $encoding = 'utf8', :$replacement, Bool() :$translate-nl = False, :$strict) {
  1999. Encoding::Registry.find($encoding)
  2000. .encoder(:$replacement, :$translate-nl, :$strict)
  2001. .encode-chars(self)
  2002. }
  2003. method NFC() {
  2004. nqp::strtocodes(nqp::unbox_s(self), nqp::const::NORMALIZE_NFC, nqp::create(NFC))
  2005. }
  2006. method NFD() {
  2007. nqp::strtocodes(nqp::unbox_s(self), nqp::const::NORMALIZE_NFD, nqp::create(NFD))
  2008. }
  2009. method NFKC() {
  2010. nqp::strtocodes(nqp::unbox_s(self), nqp::const::NORMALIZE_NFKC, nqp::create(NFKC))
  2011. }
  2012. method NFKD() {
  2013. nqp::strtocodes(nqp::unbox_s(self), nqp::const::NORMALIZE_NFKD, nqp::create(NFKD))
  2014. }
  2015. method wordcase(Str:D: :&filter = &tclc, Mu :$where = True) {
  2016. self.subst(:g, / [<:L> \w* ] +% <['\-]> /, -> $m { # ' highlighting
  2017. my Str $s = $m.Str;
  2018. $s ~~ $where ?? filter($s) !! $s;
  2019. });
  2020. }
  2021. proto method trans(|) { $/ := nqp::getlexcaller('$/'); {*} }
  2022. multi method trans(Str:D: Pair:D \what, *%n) {
  2023. my $from = what.key;
  2024. my $to = what.value;
  2025. $/ := nqp::getlexcaller('$/');
  2026. return self.trans((what,), |%n)
  2027. if !nqp::istype($from,Str) # from not a string
  2028. || !$from.defined # or a type object
  2029. || !nqp::istype($to,Str) # or to not a string
  2030. || !$to.defined # or a type object
  2031. || %n; # or any named params passed
  2032. # from 1 char
  2033. return Rakudo::Internals.TRANSPOSE(self, $from, substr($to,0,1))
  2034. if $from.chars == 1;
  2035. my str $sfrom = Rakudo::Internals.EXPAND-LITERAL-RANGE($from,0);
  2036. my str $str = nqp::unbox_s(self);
  2037. my str $chars = nqp::chars($str);
  2038. my Mu $result := nqp::list_s();
  2039. my str $check;
  2040. my int $i = -1;
  2041. # something to convert to
  2042. if $to.chars -> $tochars {
  2043. nqp::setelems($result,$chars);
  2044. # all convert to one char
  2045. if $tochars == 1 {
  2046. my str $sto = nqp::unbox_s($to);
  2047. while nqp::islt_i(++$i,$chars) {
  2048. $check = nqp::substr($str,$i,1);
  2049. nqp::bindpos_s(
  2050. $result, $i, nqp::iseq_i(nqp::index($sfrom,$check),-1)
  2051. ?? $check
  2052. !! $sto
  2053. );
  2054. }
  2055. }
  2056. # multiple chars to convert to
  2057. else {
  2058. my str $sto = Rakudo::Internals.EXPAND-LITERAL-RANGE($to,0);
  2059. my int $sfl = nqp::chars($sfrom);
  2060. my int $found;
  2061. # repeat until mapping complete
  2062. $sto = $sto ~ $sto while nqp::islt_i(nqp::chars($sto),$sfl);
  2063. while nqp::islt_i(++$i,$chars) {
  2064. $check = nqp::substr($str,$i,1);
  2065. $found = nqp::index($sfrom,$check);
  2066. nqp::bindpos_s($result, $i, nqp::iseq_i($found,-1)
  2067. ?? $check
  2068. !! nqp::substr($sto,$found,1)
  2069. );
  2070. }
  2071. }
  2072. }
  2073. # just remove
  2074. else {
  2075. while nqp::islt_i(++$i,$chars) {
  2076. $check = nqp::substr($str,$i,1);
  2077. nqp::push_s($result, $check)
  2078. if nqp::iseq_i(nqp::index($sfrom,$check),-1);
  2079. }
  2080. }
  2081. nqp::p6box_s(nqp::join('',$result));
  2082. }
  2083. my class LSM {
  2084. has str $!source;
  2085. has $!substitutions;
  2086. has int $!squash;
  2087. has int $!complement;
  2088. has str $!prev_result;
  2089. has int $!index;
  2090. has int $!next_match;
  2091. has int $!substitution_length;
  2092. has $!first_substitution; # need this one for :c with arrays
  2093. has $!next_substitution;
  2094. has $!match_obj;
  2095. has $!last_match_obj;
  2096. has str $!unsubstituted_text;
  2097. has str $!substituted_text;
  2098. method !SET-SELF(\source,\substitutions,\squash,\complement) {
  2099. $!source = nqp::unbox_s(source);
  2100. $!substitutions := nqp::getattr(substitutions,List,'$!reified');
  2101. $!squash = ?squash;
  2102. $!complement = ?complement;
  2103. $!prev_result = '';
  2104. self
  2105. }
  2106. method new(\source,\substitutions,\squash,\complement) {
  2107. nqp::create(self)!SET-SELF(source,substitutions,squash,complement)
  2108. }
  2109. method !compare_substitution(
  2110. $substitution, int $pos, int $length --> Nil
  2111. ) {
  2112. if nqp::isgt_i($!next_match,$pos)
  2113. || nqp::iseq_i($!next_match,$pos)
  2114. && nqp::islt_i($!substitution_length,$length) {
  2115. $!next_match = $pos;
  2116. $!substitution_length = $length;
  2117. $!next_substitution = $substitution;
  2118. $!match_obj = $!last_match_obj;
  2119. }
  2120. }
  2121. method !increment_index($s --> Nil) {
  2122. $/ := nqp::getlexcaller('$/');
  2123. if nqp::istype($s,Regex) {
  2124. $!index = $!next_match + (
  2125. substr($!source,$!index) ~~ $s ?? $/.chars !! 0
  2126. );
  2127. $!last_match_obj = $/;
  2128. }
  2129. else {
  2130. $!index = $!next_match
  2131. + nqp::chars(nqp::istype($s,Str) ?? $s !! $s.Str);
  2132. }
  2133. }
  2134. # note: changes outer $/
  2135. method get_next_substitution_result {
  2136. my $value = $!complement
  2137. ?? $!first_substitution.value
  2138. !! $!next_substitution.value;
  2139. my $outer_slash := nqp::getlexcaller('$/');
  2140. $/ := nqp::getlexcaller('$/');
  2141. $outer_slash = $!match_obj;
  2142. my str $result = nqp::istype($value,Callable)
  2143. ?? $value().Str
  2144. !! nqp::istype($value,Str)
  2145. ?? $value
  2146. !! $value.Str;
  2147. my str $orig_result = $result;
  2148. $result = ''
  2149. if $!squash
  2150. && nqp::chars($!prev_result)
  2151. && nqp::iseq_s($!prev_result,$result)
  2152. && nqp::iseq_s($!unsubstituted_text,'');
  2153. $!prev_result = $orig_result;
  2154. $result
  2155. }
  2156. method next_substitution() {
  2157. $/ := nqp::getlexcaller('$/');
  2158. $!next_match = nqp::chars($!source);
  2159. $!first_substitution = nqp::atpos($!substitutions,0)
  2160. unless nqp::defined($!first_substitution);
  2161. # triage substitutions left to do
  2162. my $todo := nqp::list;
  2163. my $iter := nqp::iterator($!substitutions);
  2164. while $iter {
  2165. my $this := nqp::shift($iter);
  2166. my $key := $this.key;
  2167. if nqp::istype($key,Regex) {
  2168. if $!source.match($key, :continue($!index)) -> \m {
  2169. $!last_match_obj = $/;
  2170. self!compare_substitution($this, m.from, m.to - m.from);
  2171. nqp::push($todo,$this);
  2172. }
  2173. }
  2174. elsif nqp::istype($key,Cool) {
  2175. my str $skey = nqp::istype($key,Str) ?? $key !! $key.Str;
  2176. my int $pos = nqp::index($!source,$skey,$!index);
  2177. if nqp::isge_i($pos,0) {
  2178. self!compare_substitution($this,$pos,nqp::chars($skey));
  2179. nqp::push($todo,$this);
  2180. }
  2181. }
  2182. else {
  2183. X::Str::Trans::IllegalKey.new(key => $this).throw;
  2184. }
  2185. }
  2186. $!substitutions := $todo;
  2187. $!unsubstituted_text =
  2188. nqp::substr($!source,$!index,$!next_match - $!index);
  2189. if $!next_substitution.defined {
  2190. if $!complement {
  2191. my $oldidx = $!index;
  2192. if nqp::chars($!unsubstituted_text) -> \todo {
  2193. my $result = self.get_next_substitution_result;
  2194. self!increment_index($!next_substitution.key);
  2195. $!substituted_text = nqp::substr(
  2196. $!source,
  2197. $oldidx + todo,
  2198. $!index - $oldidx - todo,
  2199. );
  2200. $!unsubstituted_text = $!squash
  2201. ?? $result
  2202. !! $result x todo;
  2203. }
  2204. else {
  2205. return if $!next_match == nqp::chars($!source);
  2206. my $result = self.get_next_substitution_result;
  2207. self!increment_index($!next_substitution.key);
  2208. $!substituted_text = '';
  2209. $!unsubstituted_text =
  2210. nqp::substr($!source,$oldidx,$!index - $oldidx);
  2211. }
  2212. }
  2213. else {
  2214. return if $!next_match == nqp::chars($!source);
  2215. $!substituted_text = self.get_next_substitution_result;
  2216. self!increment_index($!next_substitution.key);
  2217. }
  2218. }
  2219. nqp::islt_i($!next_match,nqp::chars($!source))
  2220. && nqp::elems($!substitutions)
  2221. }
  2222. method result() {
  2223. $/ := nqp::getlexcaller('$/');
  2224. my Mu $result := nqp::list_s;
  2225. while self.next_substitution {
  2226. nqp::push_s($result,$!unsubstituted_text);
  2227. nqp::push_s($result,$!substituted_text);
  2228. }
  2229. nqp::push_s($result,$!unsubstituted_text);
  2230. nqp::p6box_s(nqp::join('', $result))
  2231. }
  2232. }
  2233. multi method trans(Str:D:
  2234. *@changes, :c(:$complement), :s(:$squash), :d(:$delete)) {
  2235. # nothing to do
  2236. return self unless self.chars;
  2237. $/ := nqp::getlexcaller('$/');
  2238. my sub myflat(*@s) {
  2239. @s.map: { nqp::istype($_, Iterable) ?? .list.Slip !! $_ }
  2240. }
  2241. my sub expand($s) {
  2242. nqp::istype($s,Iterable) || nqp::istype($s,Positional)
  2243. ?? (my @ = myflat($s.list).Slip)
  2244. !! Rakudo::Internals.EXPAND-LITERAL-RANGE($s,1)
  2245. }
  2246. my int $just-strings = !$complement && !$squash;
  2247. my int $just-chars = $just-strings;
  2248. my $needles := nqp::list;
  2249. my $pins := nqp::list;
  2250. my $substitutions := nqp::list;
  2251. for @changes -> $p {
  2252. X::Str::Trans::InvalidArg.new(got => $p).throw
  2253. unless nqp::istype($p,Pair);
  2254. my $key := $p.key;
  2255. my $value := $p.value;
  2256. if nqp::istype($key,Regex) {
  2257. $just-strings = 0;
  2258. nqp::push($substitutions,$p);
  2259. }
  2260. elsif nqp::istype($value,Callable) {
  2261. $just-strings = 0;
  2262. nqp::push($substitutions,Pair.new($_,$value)) for expand $key;
  2263. }
  2264. else {
  2265. my $from := nqp::getattr(expand($key), List,'$!reified');
  2266. my $to := nqp::getattr(expand($value),List,'$!reified');
  2267. my $from-elems = nqp::elems($from);
  2268. my $to-elems = nqp::elems($to);
  2269. my $padding = $delete
  2270. ?? ''
  2271. !! $to-elems
  2272. ?? nqp::atpos($to,$to-elems - 1)
  2273. !! '';
  2274. my int $i = -1;
  2275. while nqp::islt_i($i = $i + 1,$from-elems) {
  2276. my $key := nqp::atpos($from,$i);
  2277. my $value := nqp::islt_i($i,$to-elems)
  2278. ?? nqp::atpos($to,$i)
  2279. !! $padding;
  2280. nqp::push($substitutions,Pair.new($key,$value));
  2281. if $just-strings {
  2282. if nqp::istype($key,Str) && nqp::istype($value,Str) {
  2283. $key := nqp::unbox_s($key);
  2284. $just-chars = 0 if nqp::isgt_i(nqp::chars($key),1);
  2285. nqp::push($needles,$key);
  2286. nqp::push($pins,nqp::unbox_s($value));
  2287. }
  2288. else {
  2289. $just-strings = 0;
  2290. }
  2291. }
  2292. }
  2293. }
  2294. }
  2295. # can do special cases for just strings
  2296. if $just-strings {
  2297. # only need to go through string once
  2298. if $just-chars {
  2299. my $lookup := nqp::hash;
  2300. my int $elems = nqp::elems($needles);
  2301. my int $i = -1;
  2302. nqp::bindkey($lookup,
  2303. nqp::atpos($needles,$i),nqp::atpos($pins,$i))
  2304. while nqp::islt_i($i = $i + 1,$elems);
  2305. my $result := nqp::split("",nqp::unbox_s(self));
  2306. $i = -1;
  2307. $elems = nqp::elems($result);
  2308. nqp::bindpos($result,$i,
  2309. nqp::atkey($lookup,nqp::atpos($result,$i)))
  2310. if nqp::existskey($lookup,nqp::atpos($result,$i))
  2311. while nqp::islt_i($i = $i + 1,$elems);
  2312. nqp::join("",$result)
  2313. }
  2314. # use multi-needle split with in-place mapping
  2315. else {
  2316. nqp::stmts(
  2317. (my $iterator := self.split($needles,:k).iterator),
  2318. (my $strings := nqp::list_s($iterator.pull-one)),
  2319. nqp::until(
  2320. nqp::eqaddr((my $i := $iterator.pull-one),IterationEnd),
  2321. nqp::stmts(
  2322. nqp::push_s($strings,nqp::atpos($pins,$i)),
  2323. nqp::push_s($strings,$iterator.pull-one)
  2324. )
  2325. ),
  2326. nqp::join("",$strings)
  2327. )
  2328. }
  2329. }
  2330. # alas, need to use more complex route
  2331. else {
  2332. LSM.new(self,$substitutions,$squash,$complement).result;
  2333. }
  2334. }
  2335. method parse-names(Str:D:) {
  2336. # XXX TODO: issue deprecation warning in 6.d; remove in 6.e
  2337. self.uniparse
  2338. }
  2339. method uniparse(Str:D:) {
  2340. my \names := nqp::split(',', self);
  2341. my int $elems = nqp::elems(names);
  2342. my int $i = -1;
  2343. my str $res = '';
  2344. nqp::while(
  2345. nqp::islt_i( ($i = nqp::add_i($i,1)), $elems ),
  2346. ($res = nqp::concat($res,
  2347. nqp::unless(
  2348. nqp::getstrfromname(nqp::atpos(names, $i).trim),
  2349. X::Str::InvalidCharName.new(
  2350. :name(nqp::atpos(names, $i).trim)
  2351. ).fail
  2352. ))),
  2353. );
  2354. $res
  2355. }
  2356. proto method indent($) {*}
  2357. # Zero indent does nothing
  2358. multi method indent(Int() $steps where { $_ == 0 }) {
  2359. self;
  2360. }
  2361. # Positive indent does indent
  2362. multi method indent(Int() $steps where { $_ > 0 }) {
  2363. # We want to keep trailing \n so we have to .comb explicitly instead of .lines
  2364. self.comb(/:r ^^ \N* \n?/).map({
  2365. given $_.Str {
  2366. when /^ \n? $ / {
  2367. $_;
  2368. }
  2369. # Use the existing space character if they're all the same
  2370. # (but tabs are done slightly differently)
  2371. when /^(\t+) ([ \S .* | $ ])/ {
  2372. $0 ~ "\t" x ($steps div $?TABSTOP) ~
  2373. ' ' x ($steps mod $?TABSTOP) ~ $1
  2374. }
  2375. when /^(\h) $0* [ \S | $ ]/ {
  2376. $0 x $steps ~ $_
  2377. }
  2378. # Otherwise we just insert spaces after the existing leading space
  2379. default {
  2380. $_ ~~ /^(\h*) (.*)$/;
  2381. $0 ~ (' ' x $steps) ~ $1
  2382. }
  2383. }
  2384. }).join;
  2385. }
  2386. # Negative indent (de-indent)
  2387. multi method indent(Int() $steps where { $_ < 0 }) {
  2388. de-indent(self, $steps);
  2389. }
  2390. # Whatever indent (de-indent)
  2391. multi method indent(Whatever $steps) {
  2392. de-indent(self, $steps);
  2393. }
  2394. sub de-indent($obj, $steps) {
  2395. # Loop through all lines to get as much info out of them as possible
  2396. my @lines = $obj.comb(/:r ^^ \N* \n?/).map({
  2397. # Split the line into indent and content
  2398. my ($indent, $rest) = @($_ ~~ /^(\h*) (.*)$/);
  2399. # Split the indent into characters and annotate them
  2400. # with their visual size
  2401. my $indent-size = 0;
  2402. my @indent-chars = $indent.comb.map(-> $char {
  2403. my $width = $char eq "\t"
  2404. ?? $?TABSTOP - ($indent-size mod $?TABSTOP)
  2405. !! 1;
  2406. $indent-size += $width;
  2407. $char => $width;
  2408. }).eager;
  2409. { :$indent-size, :@indent-chars, :rest(~$rest) };
  2410. });
  2411. # Figure out the amount * should de-indent by, we also use this for warnings
  2412. my $common-prefix = min @lines.grep({ .<indent-size> || .<rest> ~~ /\S/}).map({ $_<indent-size> });
  2413. return $obj if $common-prefix === Inf;
  2414. # Set the actual de-indent amount here
  2415. my Int $de-indent = nqp::istype($steps,Whatever)
  2416. ?? $common-prefix
  2417. !! -$steps;
  2418. warn "Asked to remove $de-indent spaces, but the shortest indent is $common-prefix spaces"
  2419. if $de-indent > $common-prefix;
  2420. # Work forwards from the left end of the indent whitespace, removing
  2421. # array elements up to # (or over, in the case of tab-explosion)
  2422. # the specified de-indent amount.
  2423. @lines.map(-> $l {
  2424. my $pos = 0;
  2425. while $l<indent-chars> and $pos < $de-indent {
  2426. if $l<indent-chars>.shift.key eq "\t" {
  2427. $pos -= $pos % $?TABSTOP;
  2428. $pos += $?TABSTOP;
  2429. } else {
  2430. ++$pos
  2431. }
  2432. }
  2433. if $l<indent-chars> and $pos % $?TABSTOP {
  2434. my $check = $?TABSTOP - $pos % $?TABSTOP;
  2435. $check = $l<indent-chars>[lazy 0..^$check].first(*.key eq "\t",:k);
  2436. with $check {
  2437. $l<indent-chars>.shift for 0..$check;
  2438. $pos -= $pos % $?TABSTOP;
  2439. $pos += $?TABSTOP;
  2440. }
  2441. }
  2442. $l<indent-chars>».key.join ~ ' ' x ($pos - $de-indent) ~ $l<rest>;
  2443. }).join;
  2444. }
  2445. multi method substr(Str:D:) {
  2446. die "Must at least specify a 'from' value with 'substr'"
  2447. }
  2448. multi method substr(Str:D: Int:D \start) {
  2449. nqp::if(
  2450. nqp::islt_i((my int $from = nqp::unbox_i(start)),0)
  2451. || nqp::isgt_i($from,nqp::chars($!value)),
  2452. Rakudo::Internals.SUBSTR-START-OOR($from,nqp::chars($!value)),
  2453. nqp::substr($!value,$from)
  2454. )
  2455. }
  2456. multi method substr(Str:D: Int:D \start, Int:D \want) {
  2457. nqp::if(
  2458. nqp::islt_i((my int $from = nqp::unbox_i(start)),0)
  2459. || nqp::isgt_i($from,nqp::chars($!value)),
  2460. Rakudo::Internals.SUBSTR-START-OOR($from,nqp::chars($!value)),
  2461. nqp::if(
  2462. nqp::islt_i((my int $chars = nqp::unbox_i(want)),0),
  2463. Rakudo::Internals.SUBSTR-CHARS-OOR($chars),
  2464. nqp::substr($!value,$from,$chars)
  2465. )
  2466. )
  2467. }
  2468. multi method substr(Str:D: Int:D \start, Callable:D \want) {
  2469. nqp::if(
  2470. nqp::islt_i((my int $from = nqp::unbox_i(start)),0)
  2471. || nqp::isgt_i($from,nqp::chars($!value)),
  2472. Rakudo::Internals.SUBSTR-START-OOR($from,nqp::chars($!value)),
  2473. nqp::if(
  2474. nqp::islt_i((my int $chars = (want)(nqp::chars($!value) - $from)),0),
  2475. Rakudo::Internals.SUBSTR-CHARS-OOR($chars),
  2476. nqp::substr($!value,$from,$chars)
  2477. )
  2478. )
  2479. }
  2480. multi method substr(Str:D: Callable:D \start) {
  2481. nqp::if(
  2482. nqp::islt_i((my int $from = (start)(nqp::chars($!value))),0)
  2483. || nqp::isgt_i($from,nqp::chars($!value)),
  2484. Rakudo::Internals.SUBSTR-START-OOR($from,nqp::chars($!value)),
  2485. nqp::substr($!value,$from)
  2486. )
  2487. }
  2488. multi method substr(Str:D: Callable:D \start, Int:D \want) {
  2489. nqp::if(
  2490. nqp::islt_i((my int $from = (start)(nqp::chars($!value))),0)
  2491. || nqp::isgt_i($from,nqp::chars($!value)),
  2492. Rakudo::Internals.SUBSTR-START-OOR($from,nqp::chars($!value)),
  2493. nqp::if(
  2494. nqp::islt_i((my int $chars = nqp::unbox_i(want)),0),
  2495. Rakudo::Internals.SUBSTR-CHARS-OOR($chars),
  2496. nqp::substr($!value,$from,$chars)
  2497. )
  2498. )
  2499. }
  2500. multi method substr(Str:D: Callable:D \start, Callable:D \want) {
  2501. nqp::if(
  2502. nqp::islt_i((my int $from = (start)(nqp::chars($!value))),0)
  2503. || nqp::isgt_i($from,nqp::chars($!value)),
  2504. Rakudo::Internals.SUBSTR-START-OOR($from,nqp::chars($!value)),
  2505. nqp::if(
  2506. nqp::islt_i((my int $chars = (want)(nqp::chars($!value) - $from)),0),
  2507. Rakudo::Internals.SUBSTR-CHARS-OOR($chars),
  2508. nqp::substr($!value,$from,$chars)
  2509. )
  2510. )
  2511. }
  2512. multi method substr(Str:D: Range:D \start) {
  2513. nqp::if(
  2514. nqp::islt_i((my int $from = start.min + start.excludes-min),0)
  2515. || nqp::isgt_i($from,nqp::chars($!value)),
  2516. Rakudo::Internals.SUBSTR-START-OOR($from,nqp::chars($!value)),
  2517. nqp::if(
  2518. start.max == Inf,
  2519. nqp::substr($!value,$from),
  2520. nqp::substr($!value,$from,start.max - start.excludes-max - $from + 1)
  2521. )
  2522. )
  2523. }
  2524. multi method substr(Str:D: Regex:D, $) {
  2525. die "You cannot use a Regex on 'substr', did you mean 'subst'?" # GH 1314
  2526. }
  2527. multi method substr(Str:D: \start) {
  2528. self.substr(start.Int)
  2529. }
  2530. multi method substr(Str:D: \start, \want) {
  2531. nqp::istype(want,Whatever) || want == Inf
  2532. ?? self.substr(start)
  2533. !! self.substr(start.Int,want.Int)
  2534. }
  2535. multi method substr-rw(Str:D \SELF: \start, $want = Inf) is rw {
  2536. my int $max = nqp::chars($!value);
  2537. my int $from = nqp::istype(start,Callable)
  2538. ?? (start)($max)
  2539. !! nqp::istype(start,Range)
  2540. ?? start.min + start.excludes-min
  2541. !! start.Int;
  2542. return Rakudo::Internals.SUBSTR-START-OOR($from,$max)
  2543. if nqp::islt_i($from,0) || nqp::isgt_i($from,$max);
  2544. my int $chars = nqp::istype(start,Range)
  2545. ?? start.max == Inf
  2546. ?? nqp::sub_i($max,$from)
  2547. !! start.max - start.excludes-max - $from + 1
  2548. !! nqp::istype($want,Whatever) || $want == Inf
  2549. ?? nqp::sub_i($max,$from)
  2550. !! nqp::istype($want,Callable)
  2551. ?? $want(nqp::sub_i($max,$from))
  2552. !! $want.Int;
  2553. nqp::islt_i($chars,0)
  2554. ?? Rakudo::Internals.SUBSTR-CHARS-OOR($chars)
  2555. !! Proxy.new(
  2556. FETCH => sub ($) { # need to access updated HLL Str
  2557. nqp::substr(nqp::unbox_s(SELF),$from,$chars)
  2558. },
  2559. STORE => sub ($, Str() $new) {
  2560. SELF = nqp::p6box_s( # need to make it a new HLL Str
  2561. nqp::concat(
  2562. nqp::substr($!value,0,$from),
  2563. nqp::concat(
  2564. nqp::unbox_s($new),
  2565. nqp::substr($!value,nqp::add_i($from,$chars))
  2566. )
  2567. )
  2568. )
  2569. }
  2570. )
  2571. }
  2572. proto method codes(|) {*}
  2573. multi method codes(Str:D: --> Int:D) {
  2574. nqp::codes(self)
  2575. }
  2576. multi method codes(Str:U: --> Int:D) {
  2577. self.Str; # generate undefined warning
  2578. 0
  2579. }
  2580. proto method chars(|) {*}
  2581. multi method chars(Str:D: --> Int:D) {
  2582. nqp::p6box_i(nqp::chars($!value))
  2583. }
  2584. multi method chars(Str:U: --> Int:D) {
  2585. self.Str; # generate undefined warning
  2586. 0
  2587. }
  2588. proto method uc(|) {*}
  2589. multi method uc(Str:D:) {
  2590. nqp::p6box_s(nqp::uc($!value));
  2591. }
  2592. multi method uc(Str:U:) {
  2593. self.Str;
  2594. }
  2595. proto method lc(|) {*}
  2596. multi method lc(Str:D:) {
  2597. nqp::p6box_s(nqp::lc($!value));
  2598. }
  2599. multi method lc(Str:U:) {
  2600. self.Str;
  2601. }
  2602. proto method tc(|) {*}
  2603. multi method tc(Str:D:) {
  2604. nqp::p6box_s(nqp::tc(nqp::substr($!value,0,1)) ~ nqp::substr($!value,1));
  2605. }
  2606. multi method tc(Str:U:) {
  2607. self.Str
  2608. }
  2609. proto method fc(|) {*}
  2610. multi method fc(Str:D:) {
  2611. nqp::p6box_s(nqp::fc($!value));
  2612. }
  2613. multi method fc(Str:U:) {
  2614. self.Str;
  2615. }
  2616. proto method tclc(|) {*}
  2617. multi method tclc(Str:D:) {
  2618. nqp::p6box_s(nqp::tclc($!value))
  2619. }
  2620. multi method tclc(Str:U:) {
  2621. self.Str
  2622. }
  2623. proto method flip(|) {*}
  2624. multi method flip(Str:D:) {
  2625. nqp::p6box_s(nqp::flip($!value))
  2626. }
  2627. multi method flip(Str:U:) {
  2628. self.Str
  2629. }
  2630. proto method ord(|) {*}
  2631. multi method ord(Str:D: --> Int:D) {
  2632. nqp::chars($!value)
  2633. ?? nqp::p6box_i(nqp::ord($!value))
  2634. !! Nil;
  2635. }
  2636. multi method ord(Str:U: --> Nil) { }
  2637. }
  2638. multi sub prefix:<~>(Str:D \a) { a.Str }
  2639. multi sub prefix:<~>(str $a --> str) { $a }
  2640. multi sub infix:<~>(Str:D \a, Str:D \b --> Str:D) {
  2641. nqp::p6box_s(nqp::concat(nqp::unbox_s(a), nqp::unbox_s(b)))
  2642. }
  2643. multi sub infix:<~>(str $a, str $b --> str) { nqp::concat($a, $b) }
  2644. multi sub infix:<~>(Any:D \a, Str:D \b) {
  2645. nqp::p6box_s(nqp::concat(nqp::unbox_s(a.Stringy), nqp::unbox_s(b)))
  2646. }
  2647. multi sub infix:<~>(Str:D \a, Any:D \b) {
  2648. nqp::p6box_s(nqp::concat(nqp::unbox_s(a), nqp::unbox_s(b.Stringy)))
  2649. }
  2650. multi sub infix:<~>(*@args) { @args.join }
  2651. multi sub infix:<x>(Str:D $s, Bool:D $repetition --> Str:D) {
  2652. nqp::if($repetition, $s, '')
  2653. }
  2654. multi sub infix:<x>(Str:D $s, Int:D $repetition --> Str:D) {
  2655. nqp::if(nqp::islt_i($repetition, 1), '', nqp::x($s, $repetition))
  2656. }
  2657. multi sub infix:<x>(str $s, int $repetition --> str) {
  2658. nqp::if(nqp::islt_i($repetition, 1), '', nqp::x($s, $repetition))
  2659. }
  2660. multi sub infix:<cmp>(Str:D \a, Str:D \b --> Order:D) {
  2661. ORDER(nqp::cmp_s(nqp::unbox_s(a), nqp::unbox_s(b)))
  2662. }
  2663. multi sub infix:<cmp>(str $a, str $b --> Order:D) {
  2664. ORDER(nqp::cmp_s($a, $b))
  2665. }
  2666. multi sub infix:<===>(Str:D \a, Str:D \b --> Bool:D) {
  2667. nqp::p6bool(
  2668. nqp::eqaddr(a.WHAT,b.WHAT)
  2669. && nqp::iseq_s(nqp::unbox_s(a), nqp::unbox_s(b))
  2670. )
  2671. }
  2672. multi sub infix:<===>(str $a, str $b --> Bool:D) {
  2673. nqp::p6bool(nqp::iseq_s($a, $b))
  2674. }
  2675. multi sub infix:<leg>(Str:D \a, Str:D \b --> Order:D) {
  2676. ORDER(nqp::cmp_s(nqp::unbox_s(a), nqp::unbox_s(b)))
  2677. }
  2678. multi sub infix:<leg>(str $a, str $b --> Order:D) {
  2679. ORDER(nqp::cmp_s($a, $b))
  2680. }
  2681. multi sub infix:<eq>(Str:D \a, Str:D \b --> Bool:D) {
  2682. nqp::p6bool(nqp::iseq_s(nqp::unbox_s(a), nqp::unbox_s(b)))
  2683. }
  2684. multi sub infix:<eq>(str $a, str $b --> Bool:D) {
  2685. nqp::p6bool(nqp::iseq_s($a, $b))
  2686. }
  2687. multi sub infix:<ne>(Str:D \a, Str:D \b --> Bool:D) {
  2688. nqp::p6bool(nqp::isne_s(nqp::unbox_s(a), nqp::unbox_s(b)))
  2689. }
  2690. multi sub infix:<ne>(str $a, str $b --> Bool:D) {
  2691. nqp::p6bool(nqp::isne_s($a, $b))
  2692. }
  2693. multi sub infix:<lt>(Str:D \a, Str:D \b --> Bool:D) {
  2694. nqp::p6bool(nqp::islt_s(nqp::unbox_s(a), nqp::unbox_s(b)))
  2695. }
  2696. multi sub infix:<lt>(str $a, str $b --> Bool:D) {
  2697. nqp::p6bool(nqp::islt_s($a, $b))
  2698. }
  2699. multi sub infix:<le>(Str:D \a, Str:D \b --> Bool:D) {
  2700. nqp::p6bool(nqp::isle_s(nqp::unbox_s(a), nqp::unbox_s(b)))
  2701. }
  2702. multi sub infix:<le>(str $a, str $b --> Bool:D) {
  2703. nqp::p6bool(nqp::isle_s($a, $b))
  2704. }
  2705. multi sub infix:<gt>(Str:D \a, Str:D \b --> Bool:D) {
  2706. nqp::p6bool(nqp::isgt_s(nqp::unbox_s(a), nqp::unbox_s(b)))
  2707. }
  2708. multi sub infix:<gt>(str $a, str $b --> Bool:D) {
  2709. nqp::p6bool(nqp::isgt_s($a, $b))
  2710. }
  2711. multi sub infix:<ge>(Str:D \a, Str:D \b --> Bool:D) {
  2712. nqp::p6bool(nqp::isge_s(nqp::unbox_s(a), nqp::unbox_s(b)))
  2713. }
  2714. multi sub infix:<le>(str $a, str $b --> Bool:D) {
  2715. nqp::p6bool(nqp::isle_s($a, $b))
  2716. }
  2717. multi sub infix:<~|>(Str:D \a, Str:D \b --> Str:D) {
  2718. nqp::p6box_s(nqp::bitor_s(nqp::unbox_s(a), nqp::unbox_s(b)))
  2719. }
  2720. multi sub infix:<~|>(str $a, str $b --> str) { nqp::bitor_s($a, $b) }
  2721. multi sub infix:<~&>(Str:D \a, Str:D \b --> Str:D) {
  2722. nqp::p6box_s(nqp::bitand_s(nqp::unbox_s(a), nqp::unbox_s(b)))
  2723. }
  2724. multi sub infix:<~&>(str $a, str $b --> str) { nqp::bitand_s($a, $b) }
  2725. multi sub infix:<~^>(Str:D \a, Str:D \b --> Str:D) {
  2726. nqp::p6box_s(nqp::bitxor_s(nqp::unbox_s(a), nqp::unbox_s(b)))
  2727. }
  2728. multi sub infix:<~^>(str $a, str $b --> str) { nqp::bitxor_s($a, $b) }
  2729. multi sub prefix:<~^>(Str \a) {
  2730. Failure.new("prefix:<~^> NYI") # XXX
  2731. }
  2732. # XXX: String-wise shifts NYI
  2733. multi sub infix:«~>»(Str:D \a, Int:D \b --> Str:D) {
  2734. X::NYI.new(feature => "infix:«~>»").throw;
  2735. }
  2736. multi sub infix:«~>»(str $a, int $b) {
  2737. X::NYI.new(feature => "infix:«~>»").throw;
  2738. }
  2739. multi sub infix:«~<»(Str:D \a, Int:D \b --> Str:D) {
  2740. X::NYI.new(feature => "infix:«~<»").throw;
  2741. }
  2742. multi sub infix:«~<»(str $a, int $b) {
  2743. X::NYI.new(feature => "infix:«~<»").throw;
  2744. }
  2745. proto sub trim(|) {*}
  2746. multi sub trim(Cool:D $s --> Str:D) { $s.trim }
  2747. proto sub trim-leading(|) {*}
  2748. multi sub trim-leading (Cool:D $s --> Str:D) { $s.trim-leading }
  2749. proto sub trim-trailing(|) {*}
  2750. multi sub trim-trailing(Cool:D $s --> Str:D) { $s.trim-trailing }
  2751. # the opposite of Real.base, used for :16($hex_str)
  2752. proto sub UNBASE (|) {*}
  2753. multi sub UNBASE(Int:D $base, Any:D $num) {
  2754. X::Numeric::Confused.new(:$num, :$base).throw;
  2755. }
  2756. multi sub UNBASE(Int:D $base, Str:D $str) {
  2757. my Str $ch = substr($str, 0, 1);
  2758. if $ch eq '0' {
  2759. $ch = substr($str, 1, 1);
  2760. if $base <= 11 && $ch eq any(<x d o b>)
  2761. or $base <= 24 && $ch eq any <o x>
  2762. or $base <= 33 && $ch eq 'x' {
  2763. $str.Numeric;
  2764. } else {
  2765. ":{$base}<$str>".Numeric;
  2766. }
  2767. } elsif $ch eq ':' && substr($str, 1, 1) ~~ ('1'..'9') {
  2768. $str.Numeric;
  2769. } else {
  2770. ":{$base}<$str>".Numeric;
  2771. }
  2772. }
  2773. # for :16[1, 2, 3]
  2774. sub UNBASE_BRACKET($base, @a) {
  2775. my $v = 0;
  2776. my $denom = 1;
  2777. my Bool $seen-dot = False;
  2778. for @a {
  2779. if $seen-dot {
  2780. die "Only one decimal dot allowed" if $_ eq '.';
  2781. $denom *= $base;
  2782. $v += $_ / $denom
  2783. }
  2784. elsif $_ eq '.' {
  2785. $seen-dot = True;
  2786. }
  2787. else {
  2788. $v = $v * $base + $_;
  2789. }
  2790. }
  2791. $v;
  2792. }
  2793. proto sub infix:<unicmp>(|) is pure {*}
  2794. proto sub infix:<coll>(|) {*}
  2795. multi sub infix:<unicmp>(Str:D \a, Str:D \b --> Order:D) {
  2796. ORDER(
  2797. nqp::unicmp_s(
  2798. nqp::unbox_s(a), nqp::unbox_s(b), 85,0,0))
  2799. }
  2800. multi sub infix:<unicmp>(Pair:D \a, Pair:D \b) {
  2801. (a.key unicmp b.key) || (a.value unicmp b.value)
  2802. }
  2803. multi sub infix:<coll>(Str:D \a, Str:D \b --> Order:D) {
  2804. ORDER(
  2805. nqp::unicmp_s(
  2806. nqp::unbox_s(a), nqp::unbox_s(b), $*COLLATION.collation-level,0,0))
  2807. }
  2808. multi sub infix:<coll>(Cool:D \a, Cool:D \b --> Order:D) {
  2809. ORDER(
  2810. nqp::unicmp_s(
  2811. nqp::unbox_s(a.Str), nqp::unbox_s(b.Str), $*COLLATION.collation-level,0,0))
  2812. }
  2813. multi sub infix:<coll>(Pair:D \a, Pair:D \b) {
  2814. (a.key coll b.key) || (a.value coll b.value)
  2815. }
  2816. proto sub chrs(|) {*}
  2817. multi sub chrs(*@c --> Str:D) { @c.chrs }
  2818. proto sub parse-base(|) {*}
  2819. multi sub parse-base(Str:D $str, Int:D $radix) { $str.parse-base($radix) }
  2820. proto sub substr(|) {*}
  2821. multi sub substr(\what) { what.substr }
  2822. multi sub substr(\what, \from) { what.substr(from) }
  2823. multi sub substr(\what, \from, \chars) { what.substr(from,chars) }
  2824. proto sub substr-rw(|) {*}
  2825. multi sub substr-rw(\what) { what.substr-rw }
  2826. multi sub substr-rw(\what, \from) { what.substr-rw(from) }
  2827. multi sub substr-rw(\what, \from, \chars) { what.substr-rw(from,chars) }
  2828. multi sub infix:<eqv>(Str:D \a, Str:D \b) {
  2829. nqp::p6bool(
  2830. nqp::unless(
  2831. nqp::eqaddr(nqp::decont(a),nqp::decont(b)),
  2832. nqp::eqaddr(a.WHAT,b.WHAT) && nqp::iseq_s(a,b)
  2833. )
  2834. )
  2835. }
  2836. proto sub samemark(|) {*}
  2837. multi sub samemark($s, $pat) { $s.samemark($pat) }
  2838. sub parse-names(Str:D \names) {
  2839. # XXX TODO: issue deprecation warning in 6.d; remove in 6.e
  2840. names.uniparse
  2841. }
  2842. proto sub uniparse(|) {*}
  2843. multi sub uniparse(Str:D \names) { names.uniparse }