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