~ubuntu-branches/ubuntu/raring/rakudo/raring

~ "\x[410,411,412,413,414,415,416,417,418,419,41A,41B,41C,41D,41E,41F,420,421,422,423,424,425,426,427,428,429,42A,42B,42C,42D,42E,42F,410]" # cyrillic uppercase

115

~ "\x[430,431,432,433,434,435,436,437,438,439,43A,43B,43C,43D,43E,43F,440,441,442,443,444,445,446,447,448,449,44A,44B,44C,44D,44E,44F,430]" # cyrillic lowercase

116

~ "\x[660,661,662,663,664,665,666,667,668,669,660]" # arabic-indic digits

117

~ "\x[966,967,968,969,96A,96B,96C,96D,96E,96F,966]" # devanagari digits

118

~ "\x[9E6,9E7,9E8,9E9,9EA,9EB,9EC,9ED,9EE,9EF,9E6]" # bengali digits

119

~ "\x[A66,A67,A68,A69,A6A,A6B,A6C,A6D,A6E,A6F,A66]" # gurmukhi digits

120

~ "\x[AE6,AE7,AE8,AE9,AEA,AEB,AEC,AED,AEE,AEF,AE6]" # gujarati digits

121

~ "\x[B66,B67,B68,B69,B6A,B6B,B6C,B6D,B6E,B6F,B66]" # oriya digits

122

~ "\x[FF10,FF11,FF12,FF13,FF14,FF15,FF16,FF17,FF18,FF19,FF10]" # fullwidth digits

123

~ "\x[2070,2071,00B2,00B3,2074,2075,2076,2077,2078,2079]" # superscripts

124

~ "\x[2080,2081,2082,2083,2084,2085,2086,2087,2088,2089]" # subscripts

125

~ "\x[2160,2161,2162,2163,2164,2165,2166,2167,2168,2169,216a,216b,2160]" # clock roman uc

126

~ "\x[2170,2171,2172,2173,2174,2175,2176,2177,2178,2179,217a,217b,2170]" # clock roman lc

~ "\x[2680,2681,2682,2683,2684,2685,2680]"; # die faces

127

~ "\x[2460,2461,2462,2463,2464,2465,2466,2467,2468,2469,246A,246B,246C,246D,246E,246F,2470,2471,2472,2473,2460]" # circled digits 1..20

128

~ "\x[2474,2475,2476,2477,2478,2479,247A,247B,247C,247D,247E,247F,2480,2481,2482,2483,2484,2485,2486,2487,2474]" # parenthesized digits 1..20

129

~ "\x[249C,249D,249E,249F,24A0,24A1,24A2,24A3,24A4,24A5,24A6,24A7,24A8,24A9,24AA,24AB,24AC,24AD,24AE,24AF,24B0,24B1,24B2,24B3,24B4,24B5,249C]" # parenthesized latin lc

130

~ "\x[2680,2681,2682,2683,2684,2685,2680]" # die faces

131

~ "\x[2776,2777,2778,2779,277A,277B,277C,277D,277E,277F,2776]"; # dingbat negative circled 1..10

132

133

# digit to extend the string with if carried past first rangechar position

134

my $carrydigit := nqp::hash(

135

'0', '1', # arabic

136

"\x0660", "\x0661", # arabic-indic

137

"\x0966", "\x0967", # devanagari

138

"\x09E6", "\x09E7", # bengali

139

"\x0A66", "\x0A67", # gurmukhi

140

"\x0AE6", "\x0AE7", # gujarati

141

"\x0B66", "\x0B67", # oriya

142

"\xFF10", "\xFF11", # fullwidth XXX: should be treated as digit?

143

"\x2070", "\x2071", # superscripts XXX: should be treated as digit?

144

"\x2080", "\x2081", # subscripts XXX: should be treated as digit?

145

);

146

# calculate the beginning and ending positions of <!after '.'><rangechar+>

147

my sub RANGEPOS(str $str) {

148

my int $pos = nqp::chars($str);

147

199

$r1 = $r1 - 1;

148

200

# extend string if carried past first rangechar position

149

201

$str = pir::replace__Ssiis($str, $r0, 0,

150

$ch1 eq '0' ?? '1' !! $ch1) # XXX other digits?

202

nqp::existskey($carrydigit, $ch1)

203

?? nqp::atkey($carrydigit, $ch1)

204

!! $ch1)

151

205

if $r1 < $r0;

152

206

}

153

207

$str;

154

208

}

155

209

156

multi method Numeric(Str:D: :$strict) {

157

return nqp::p6box_n(pir::set__Ns('NaN')) if self eq 'NaN';

210

211

# TODO:

212

# * Additional numeric styles:

213

# + fractions in [] radix notation: :100[10,'.',53]

214

# * Performance tuning

215

# * Fix remaining XXXX

216

217

multi method Numeric(Str:D: :$strict = True) {

158

218

my str $str = nqp::unbox_s(self);

159

219

my int $eos = nqp::chars($str);

160

my Int $int;

161

my Int $frac = 0;

162

my Int $base = 0;

163

# skip leading whitespace

164

my int $pos = pir::find_not_cclass__Iisii(pir::const::CCLASS_WHITESPACE, $str, 0, $eos);

165

166

my $tailfail =

167

-> { fail(X::Str::Numeric.new(

168

source => self,

169

:$pos,

170

reason => 'trailing characters after number',

171

)) if nqp::islt_i(

172

pir::find_not_cclass__Iisii(pir::const::CCLASS_WHITESPACE,

173

$str, $pos, $eos),

174

$eos);

175

176

};

177

# objects for managing the parse and results

178

my Mu $parse;

179

my $result;

180

181

# get any leading +/- sign

182

my int $ch = nqp::islt_i($pos, $eos) && nqp::ord($str, $pos);

183

my int $neg = nqp::iseq_i($ch, 45);

184

$pos = nqp::add_i($pos, 1) if nqp::iseq_i($ch, 45) || nqp::iseq_i($ch, 43);

185

186

# handle 0x, 0d, etc. prefixes, if present

187

my str $rpref = nqp::substr($str, $pos, 2);

188

my int $radix =

189

nqp::iseq_s($rpref, '0x') ?? 16

190

!! nqp::iseq_s($rpref, '0d') ?? 10

191

!! nqp::iseq_s($rpref, '0o') ?? 8

192

!! nqp::iseq_s($rpref, '0b') ?? 2

193

!! 0;

194

if $radix {

195

$parse := nqp::radix_I($radix, $str, nqp::add_i($pos, 2), $neg, Int);

196

$pos = nqp::atpos($parse, 2);

197

fail "missing digits after radix prefix" if nqp::islt_i($pos, 0);

198

return nqp::atpos($parse, 0) unless $tailfail();

199

} elsif nqp::iseq_s(nqp::substr($str, $pos, 1), ':') {

200

# a string of form :16<DEAD_BEEF>

201

$pos = nqp::add_i($pos, 1);

202

$parse := nqp::radix_I(10, $str, $pos, 0, Int);

203

$radix = nqp::atpos($parse, 0);

204

$pos = nqp::atpos($parse, 2);

205

fail "not a number" if nqp::iseq_i($pos, -1);

206

fail "malformed radix number, expecting '<' after the base"

207

unless nqp::iseq_s(nqp::substr($str, $pos, 1), '<');

208

$pos = nqp::add_i($pos, 1);

209

$parse := nqp::radix_I($radix, $str, $pos, $neg, Int);

210

$pos = nqp::atpos($parse, 2);

211

fail "malformed radix number" if nqp::iseq_i($pos, -1);

212

fail "malformed radix number, expecting '>' after the body"

213

unless nqp::iseq_s(nqp::substr($str, $pos, 1), '>');

214

$pos = nqp::add_i($pos, 1);

215

return nqp::atpos($parse, 0) unless $tailfail();

216

}

217

218

# handle 'Inf'

219

if nqp::iseq_s(nqp::substr($str, $pos, 3), 'Inf') {

220

$pos = nqp::add_n($pos, 3);

221

return ($neg ?? -$Inf !! $Inf) unless $tailfail();

222

}

223

224

# We have some sort of number, get leading integer part

225

# First check if leading character is '.' ...

226

$ch = nqp::islt_i($pos, $eos) && nqp::ord($str, $pos);

227

if nqp::iseq_i($ch, 46) {

228

$int = 0;

229

}

230

else {

231

my int $p = $pos;

232

$parse := nqp::radix_I(10, $str, $pos, $neg, Int);

233

$pos = nqp::atpos($parse, 2);

234

# XXX: return 0 if ...

235

# We should really fail here instead of returning 0,

236

# but we need to first need to figure out better ways

237

# to handle failure results.

220

221

# S02:3276-3277: Ignore leading and trailing whitespace

222

my int $pos = nqp::findnotcclass(pir::const::CCLASS_WHITESPACE,

223

$str, 0, $eos);

224

my int $end = nqp::sub_i($eos, 1);

225

226

$end = nqp::sub_i($end, 1)

227

while nqp::isge_i($end, $pos)

228

&& nqp::iscclass(pir::const::CCLASS_WHITESPACE, $str, $end);

229

230

# Return 0 if no non-whitespace characters in string

231

return 0 if nqp::islt_i($end, $pos);

232

233

# Reset end-of-string after trimming

234

$eos = nqp::add_i($end, 1);

235

236

# Fail all the way out when parse failures occur

237

my &parse_fail := -> $msg {

238

fail X::Str::Numeric.new(

239

source => self,

240

pos => $p,

241

reason => 'does not look like a number',

242

) if $strict && nqp::iseq_i($p, 0) && nqp::islt_i($pos, 0);

243

return 0 if nqp::iseq_i($p, 0) && nqp::islt_i($pos, 0);

244

fail "malformed numeric string" if nqp::islt_i($pos, 0);

245

$int = nqp::atpos($parse, 0);

246

}

247

248

# if there's a slash, get a denominator and make a Rat

249

$ch = nqp::islt_i($pos, $eos) && nqp::ord($str, $pos);

250

if nqp::iseq_i($ch, 47) {

251

$parse := nqp::radix_I(10, $str, nqp::add_i($pos, 1), 0, Int);

252

$pos = nqp::atpos($parse, 2);

253

fail "Slash must be followed by denominator" if nqp::islt_i($pos, 0);

254

return Rat.new($int, nqp::atpos($parse, 0))

255

unless $tailfail();

256

}

257

258

# check for decimal fraction or number

259

# parse an optional decimal point and value

260

if nqp::iseq_i($ch, 46) {

261

$parse := nqp::radix_I(10, $str, nqp::add_i($pos, 1), nqp::add_i(4,$neg), Int);

262

$pos = nqp::atpos($parse, 2);

263

fail "Decimal point must be followed by digit" if nqp::islt_i($pos, 0);

264

$frac = nqp::atpos($parse, 0);

265

$base = nqp::atpos($parse, 1);

266

$ch = nqp::islt_i($pos, $eos) && nqp::ord($str, $pos);

267

}

268

269

# handle exponent if 'E' or 'e' are present

270

if nqp::iseq_i($ch, 69) || nqp::iseq_i($ch, 101) {

271

$parse := nqp::radix(10, $str, nqp::add_i($pos, 1), 2);

272

$pos = nqp::atpos($parse, 2);

273

fail "'E' or 'e' must be followed by integer" if nqp::islt_i($pos, 0);

274

my num $exp = nqp::atpos($parse, 0);

275

my num $coef = $frac ?? nqp::add_n($int, nqp::div_n($frac, $base)) !! $int;

276

return nqp::p6box_n(nqp::mul_n($coef, nqp::pow_n(10, $exp)))

277

unless $tailfail();

278

}

279

280

# if we got a decimal point above, it's a Rat

281

if $base {

282

my Int $numerator = $int * $base + $frac;

283

return Rat.new($numerator, $base)

284

unless $tailfail();

285

}

286

287

$int unless $tailfail();

239

source => self,

240

reason => $msg,

241

:$pos,

242

);

243

};

244

245

my sub parse-simple-number () {

246

# Handle NaN here, to make later parsing simpler

247

if nqp::iseq_s(nqp::substr($str, $pos, 3), 'NaN') {

248

$pos = nqp::add_i($pos, 3);

249

return nqp::p6box_n(pir::set__Ns('NaN'));

250

}

251

252

# Handle any leading +/- sign

253

my int $ch = nqp::ord($str, $pos);

254

my int $neg = nqp::iseq_i($ch, 45); # '-'

255

if nqp::iseq_i($ch, 45) || nqp::iseq_i($ch, 43) { # '-', '+'

256

$pos = nqp::add_i($pos, 1);

257

$ch = nqp::islt_i($pos, $eos) && nqp::ord($str, $pos);

258

}

259

260

# nqp::radix_I parse results, and helper values

261

my Mu $parse;

262

my str $prefix;

263

my int $radix;

264

my int $p;

265

266

my sub parse-int-frac-exp () {

267

# Integer part, if any

268

my Int:D $int := 0;

269

if nqp::isne_i($ch, 46) { # '.'

270

$parse := nqp::radix_I($radix, $str, $pos, $neg, Int);

271

$p = nqp::atpos($parse, 2);

272

parse_fail "base-$radix number must begin with valid digits or '.'"

273

if nqp::iseq_i($p, -1);

274

$pos = $p;

275

276

$int := nqp::atpos($parse, 0);

277

$ch = nqp::islt_i($pos, $eos) && nqp::ord($str, $pos);

278

}

279

280

# Fraction, if any

281

my Int:D $frac := 0;

282

my Int:D $base := 0;

283

if nqp::iseq_i($ch, 46) { # '.'

284

$pos = nqp::add_i($pos, 1);

285

$parse := nqp::radix_I($radix, $str, $pos,

286

nqp::add_i($neg, 4), Int);

287

$p = nqp::atpos($parse, 2);

288

parse_fail 'radix point must be followed by one or more valid digits'

289

if nqp::iseq_i($p, -1);

290

$pos = $p;

291

292

$frac := nqp::atpos($parse, 0);

293

$base := nqp::atpos($parse, 1);

294

$ch = nqp::islt_i($pos, $eos) && nqp::ord($str, $pos);

295

}

296

297

# Exponent, if 'E' or 'e' are present (forces return type Num)

298

if nqp::iseq_i($ch, 69) || nqp::iseq_i($ch, 101) { # 'E', 'e'

299

parse_fail "'E' or 'e' style exponent only allowed on decimal (base-10) numbers, not base-$radix"

300

unless nqp::iseq_i($radix, 10);

301

302

$pos = nqp::add_i($pos, 1);

303

$parse := nqp::radix_I(10, $str, $pos, 2, Int);

304

$p = nqp::atpos($parse, 2);

305

parse_fail "'E' or 'e' must be followed by decimal (base-10) integer"

306

if nqp::iseq_i($p, -1);

307

$pos = $p;

308

309

my num $exp = nqp::atpos($parse, 0);

310

my num $coef = $frac ?? nqp::add_n($int, nqp::div_n($frac, $base)) !! $int;

311

return nqp::p6box_n(nqp::mul_n($coef, nqp::pow_n(10, $exp)));

312

}

313

314

# Multiplier with exponent, if single '*' is present

315

# (but skip if current token is '**', as otherwise we

316

# get recursive multiplier parsing stupidity)

317

if nqp::iseq_i($ch, 42)

318

&& nqp::isne_s(substr($str, $pos, 2), '**') { # '*'

319

$pos = nqp::add_i($pos, 1);

320

my $mult_base := parse-simple-number();

321

322

parse_fail "'*' multiplier base must be an integer"

323

unless $mult_base.WHAT === Int;

324

parse_fail "'*' multiplier base must be followed by '**' and exponent"

325

unless nqp::iseq_s(nqp::substr($str, $pos, 2), '**');

326

327

$pos = nqp::add_i($pos, 2);

328

my $mult_exp := parse-simple-number();

329

330

parse_fail "'**' multiplier exponent must be an integer"

331

unless $mult_exp.WHAT === Int;

332

333

my $mult := $mult_base ** $mult_exp;

334

$int := $int * $mult;

335

$frac := $frac * $mult;

336

}

337

338

# Return an Int if there was no radix point

339

return $int unless $base;

340

341

# Otherwise, return a Rat

342

my Int:D $numerator := $int * $base + $frac;

343

return Rat.new($numerator, $base);

344

}

345

346

# Look for radix specifiers

347

if nqp::iseq_i($ch, 58) { # ':'

348

# A string of the form :16<FE_ED.F0_0D> or :60[12,34,56]

349

$pos = nqp::add_i($pos, 1);

350

$parse := nqp::radix_I(10, $str, $pos, 0, Int);

351

$p = nqp::atpos($parse, 2);

352

parse_fail "radix (in decimal) expected after ':'"

353

if nqp::iseq_i($p, -1);

354

$pos = $p;

355

356

$radix = nqp::atpos($parse, 0);

357

$ch = nqp::islt_i($pos, $eos) && nqp::ord($str, $pos);

358

if nqp::iseq_i($ch, 60) { # '<'

359

$pos = nqp::add_i($pos, 1);

360

361

my $result := parse-int-frac-exp();

362

363

parse_fail "malformed ':$radix<>' style radix number, expecting '>' after the body"

364

unless nqp::islt_i($pos, $eos)

365

&& nqp::iseq_i(nqp::ord($str, $pos), 62); # '>'

366

367

$pos = nqp::add_i($pos, 1);

368

return $result;

369

}

370

elsif nqp::iseq_i($ch, 171) { # '«'

371

$pos = nqp::add_i($pos, 1);

372

373

my $result := parse-int-frac-exp();

374

375

parse_fail "malformed ':$radix«»' style radix number, expecting '»' after the body"

376

unless nqp::islt_i($pos, $eos)

377

&& nqp::iseq_i(nqp::ord($str, $pos), 187); # '»'

378

379

$pos = nqp::add_i($pos, 1);

380

return $result;

381

}

382

elsif nqp::iseq_i($ch, 91) { # '['

383

$pos = nqp::add_i($pos, 1);

384

my Int:D $result := 0;

385

my Int:D $digit := 0;

386

while nqp::islt_i($pos, $eos)

387

&& nqp::isne_i(nqp::ord($str, $pos), 93) { # ']'

388

$parse := nqp::radix_I(10, $str, $pos, 0, Int);

389

$p = nqp::atpos($parse, 2);

390

parse_fail "malformed ':$radix[]' style radix number, expecting comma separated decimal values after opening '['"

391

if nqp::iseq_i($p, -1);

392

$pos = $p;

393

394

$digit := nqp::atpos($parse, 0);

395

parse_fail "digit is larger than {$radix - 1} in ':$radix[]' style radix number"

396

if $digit >= $radix;

397

398

$result := $result * $radix + $digit;

399

$pos = nqp::add_i($pos, 1)

400

if nqp::islt_i($pos, $eos)

401

&& nqp::iseq_i(nqp::ord($str, $pos), 44); # ','

402

}

403

parse_fail "malformed ':$radix[]' style radix number, expecting ']' after the body"

404

unless nqp::islt_i($pos, $eos)

405

&& nqp::iseq_i(nqp::ord($str, $pos), 93); # ']'

406

$pos = nqp::add_i($pos, 1);

407

408

# XXXX: Handle fractions!

409

# XXXX: Handle exponents!

410

return $neg ?? -$result !! $result;

411

}

412

else {

413

parse_fail "malformed ':$radix' style radix number, expecting '<' or '[' after the base";

414

}

415

}

416

elsif nqp::iseq_i($ch, 48) # '0'

417

and $radix = nqp::index(' b o d x',

418

nqp::substr($str, nqp::add_i($pos, 1), 1))

419

and nqp::isge_i($radix, 2) {

420

# A string starting with 0x, 0d, 0o, or 0b,

421

# followed by one optional '_'

422

$pos = nqp::add_i($pos, 2);

423

$pos = nqp::add_i($pos, 1)

424

if nqp::islt_i($pos, $eos)

425

&& nqp::iseq_i(nqp::ord($str, $pos), 95); # '_'

426

427

return parse-int-frac-exp();

428

}

429

elsif nqp::iseq_s(nqp::substr($str, $pos, 3), 'Inf') {

430

# 'Inf'

431

$pos = nqp::add_i($pos, 3);

432

return $neg ?? -$Inf !! $Inf;

433

}

434

else {

435

# Last chance: a simple decimal number

436

$radix = 10;

437

return parse-int-frac-exp();

438

}

439

}

440

441

my sub parse-real () {

442

# Parse a simple number or a Rat numerator

443

my $result := parse-simple-number();

444

return $result if nqp::iseq_i($pos, $eos);

445

446

# Check for '/' indicating Rat denominator

447

if nqp::iseq_i(nqp::ord($str, $pos), 47) { # '/'

448

$pos = nqp::add_i($pos, 1);

449

parse_fail "denominator expected after '/'"

450

unless nqp::islt_i($pos, $eos);

451

452

my $denom := parse-simple-number();

453

454

$result := $result.WHAT === Int && $denom.WHAT === Int

455

?? Rat.new($result, $denom)

456

!! $result / $denom;

457

}

458

459

return $result;

460

}

461

462

# Parse a real number, magnitude of a pure imaginary number,

463

# or real part of a complex number

464

my $result := parse-real();

465

return $result if nqp::iseq_i($pos, $eos);

466

467

# Check for 'i' or '\\i' indicating first parsed number was

468

# the magnitude of a pure imaginary number

469

if nqp::iseq_i(nqp::ord($str, $pos), 105) { # 'i'

470

$pos = nqp::add_i($pos, 1);

471

$result := Complex.new(0, $result);

472

}

473

elsif nqp::iseq_s(nqp::substr($str, $pos, 2), '\\i') {

474

$pos = nqp::add_i($pos, 2);

475

$result := Complex.new(0, $result);

476

}

477

# Check for '+' or '-' indicating first parsed number was

478

# the real part of a complex number

479

elsif nqp::iseq_i(nqp::ord($str, $pos), 45) # '-'

480

|| nqp::iseq_i(nqp::ord($str, $pos), 43) { # '+'

481

# Don't move $pos -- we want parse-real() to see the sign

482

my $im := parse-real();

483

parse_fail "imaginary part of complex number must be followed by 'i' or '\\i'"

484

unless nqp::islt_i($pos, $eos);

485

486

if nqp::iseq_i(nqp::ord($str, $pos), 105) { # 'i'

487

$pos = nqp::add_i($pos, 1);

488

}

489

elsif nqp::iseq_s(nqp::substr($str, $pos, 2), '\\i') {

490

$pos = nqp::add_i($pos, 2);

491

}

492

else {

493

parse_fail "imaginary part of complex number must be followed by 'i' or '\\i'"

494

}

495

496

$result := Complex.new($result, $im);

497

}

498

499

# Check for trailing garbage

500

parse_fail "trailing characters after number"

501

if nqp::islt_i($pos, $eos);

502

503

return $result;

288

504

}

289

505

290

506

my %esc = (

295

511

multi method gist(Str:D:) { self }

296

512

multi method perl(Str:D:) {

297

513

my $result = '"';

514

my $icu = $*VM<config><has_icu>;

298

515

for ^self.chars -> $i {

299

516

my $ch = self.substr($i, 1);

300

$result ~= %esc{$ch} // (pir::is_cclass__Iisi(

301

pir::const::CCLASS_PRINTING,

302

nqp::unbox_s($ch), 0)

303

?? $ch

304

!! $ch.ord.fmt('\x[%x]'));

517

$result ~= %esc{$ch}

518

// ( ((!$icu && $ch.ord >= 256)

519

|| nqp::iscclass( pir::const::CCLASS_PRINTING,

520

nqp::unbox_s($ch), 0))

521

?? $ch

522

!! $ch.ord.fmt('\x[%x]')

523

);

305

524

}

306

525

$result ~ '"'

307

526

}

317

536

!! self.match(:g, :$x, $pat).map: { .Str }

318

537

}

319

538

320

# TODO: should be private

321

proto method ll-match(Str:D: $, *%) {*}

322

multi method ll-match(Str:D: Regex:D $pat, *%opts) {

323

my $match := $pat(Cursor.'!cursor_init'(self, |%opts)).MATCH;

324

# next line written this way for reasons of circularity sawing

325

Cursor.HOW.find_private_method(Cursor, 'set_last_match')(Cursor, $match) if $match;

326

$match

327

}

328

multi method ll-match(Str:D: Cool:D $pat, *%opts) {

329

my Int $from = %opts<p> // %opts<c> // 0;

330

my $idx = self.index($pat, $from);

331

$idx.defined

332

?? Match.new(orig => self, from => $idx, to => ($idx + $pat.chars))

333

!! Match.new(orig => self, from => 0, to => -3);

334

}

335

method match-list(Str:D: $pat, :$g, :$ov, :$ex, *%opts) {

336

if $ex && nqp::istype($pat, Callable) {

337

gather {

338

my $m := self.ll-match($pat, |%opts);

339

if $m {

340

take $m;

341

while $m := $m.CURSOR.'!cursor_next'().MATCH {

342

# next line written this way for reasons of circularity sawing

343

Cursor.HOW.find_private_method(Cursor, 'set_last_match')(Cursor, $m);

344

take $m;

345

}

346

}

347

}

348

}

349

elsif $ov || $ex {

350

gather {

351

my $m := self.ll-match($pat, |%opts);

352

while $m {

353

last if $m.to > self.chars;

354

take $m;

355

$m := self.ll-match($pat, :c($m.from + 1));

356

}

357

}

358

}

359

elsif $g {

360

gather {

361

my $m := self.ll-match($pat, |%opts);

362

if $m {

363

take $m;

364

while $m := self.ll-match($pat, :c($m.to == $m.from ?? $m.to + 1 !! $m.to)) {

365

last if $m.to > self.chars;

366

take $m;

367

}

368

}

369

}

370

}

371

else {

372

(self.ll-match($pat, |%opts),).list;

373

}

374

}

375

multi method match(Str:D: $pat, :continue(:$c), :pos(:$p), :global(:$g), :overlap(:$ov), :exhaustive(:$ex), :$x, :st(:nd(:rd(:$nth)))) {

539

method match($pat,

540

:continue(:$c), :pos(:$p),

541

:global(:$g), :overlap(:$ov), :exhaustive(:$ex),

542

:st(:nd(:rd(:th(:$nth)))), :$x) {

376

543

my %opts;

377

if $c.defined {

378

%opts<c> = $c

379

}

380

elsif !$p.defined {

381

%opts<c> = 0;

382

}

383

%opts<p> = $p if $p.defined;

384

my @matches := self.match-list($pat, :g($g || $x || $nth), :$ov, :$ex, |%opts);

544

if $p.defined { %opts<p> = $p }

545

else { %opts<c> = $c // 0; }

546

my $patrx := $pat ~~ Code ?? $pat !! / $pat: /;

547

my $cur := $patrx(Cursor.'!cursor_init'(self, |%opts));

548

549

%opts<ov> = $ov if $ov;

550

%opts<ex> = $ex if $ex;

551

552

my @matches := gather {

553

while $cur.pos >= 0 {

554

take $cur.MATCH_SAVE;

555

$cur := $cur.'!cursor_more'(|%opts);

556

}

557

}

558

my $multi = $g || $ov || $ex;

559

385

560

if $nth.defined {

386

if nqp::istype($nth, Positional) {

387

my @nth-monotonic := gather {

388

my $max = 0;

389

for $nth.list {

390

if $_ > $max {

391

# note that $nth is 1-based, but our array

392

# indexes are 0-based. Hence the - 1

393

take $_ - 1;

394

$max = $_;

395

}

396

}

561

$multi = Positional.ACCEPTS($nth);

562

my @nlist := $nth.list;

563

my @src := @matches;

564

@matches := gather {

565

my $max = 0;

566

while @nlist {

567

my $n = shift @nlist;

568

fail "Attempt to retrieve negative match :nth($n)" if $n < 1;

569

if $n > $max { take @src[$n-1]; $max = $n; }

397

570

}

398

@matches := @matches[@nth-monotonic].list;

399

}

400

else {

401

return () if $nth < 1;

402

@matches := @matches[$nth - 1].defined

403

?? (@matches[$nth - 1], ).list

404

!! ().list;

405

571

}

406

572

}

573

407

574

if $x.defined {

575

$multi = True;

408

576

if nqp::istype($x, Int) {

409

@matches.gimme($x) == $x

410

?? @matches[^$x]

411

!! ().list;

577

@matches := @matches.gimme($x) >= $x

578

?? @matches[^$x]

579

!! ().list

412

580

}

413

581

elsif nqp::istype($x, Range) {

414

my $real-max := $x.excludes_max ?? $x.max - 1 !! $x.max;

415

@matches.gimme($real-max) ~~ $x

416

?? @matches[^$real-max].list

417

!! ().list;

582

my $min = $x.min.ceiling;

583

my $max = $x.max;

584

$min++ while $min <= $max && $min !~~ $x;

585

if @matches.gimme($min) >= $min && $min ~~ $x {

586

my @src := @matches;

587

@matches := gather {

588

my $n = 0;

589

while @src && ($n < $min || $n+1 ~~ $x) {

590

take @src.shift;

591

$n++;

592

}

593

}

594

}

595

else { @matches := ().list }

418

596

}

597

elsif nqp::istype($x, Whatever) { }

419

598

else {

420

die "Invalid argument to :x, must be Int or Range, got type {$x.^name}";

599

X::Str::Match::x.new(got => $x).fail;

600

}

601

}

421

602

422

}

423

}

424

else {

425

@matches.gimme(2) == 1 ?? @matches[0] !! @matches;

426

}

603

$multi ?? @matches !! (@matches[0] // $cur.MATCH_SAVE);

427

604

}

428

605

429

430

431

606

multi method subst($matcher, $replacement,

432

607

:ii(:$samecase), :ss(:$samespace),

433

608

:$SET_CALLER_DOLLAR_SLASH, *%options) {

537

712

538

713

method trim-leading(Str:D:) {

539

714

my str $str = nqp::unbox_s(self);

540

my int $pos = pir::find_not_cclass__IiSii(

715

my int $pos = nqp::findnotcclass(

541

716

pir::const::CCLASS_WHITESPACE,

542

717

$str, 0, nqp::chars($str));

543

718

nqp::p6box_s(nqp::substr($str, $pos));

555

730

method trim(Str:D:) {

556

731

my str $str = nqp::unbox_s(self);

557

732

my int $pos = nqp::chars($str) - 1;

558

my int $left = pir::find_not_cclass__IiSii(

733

my int $left = nqp::findnotcclass(

559

734

pir::const::CCLASS_WHITESPACE, $str, 0, $pos + 1);

560

735

$pos = $pos - 1

561

736

while nqp::isge_i($pos, $left)

569

744

570

745

method encode(Str:D $encoding = 'utf8') {

571

746

my $buf := Buf.new;

572

pir::set__vPs(nqp::getattr($buf, Buf, '$!buffer'),

573

pir::trans_encoding__ssi(

574

nqp::unbox_s(self),

575

pir::find_encoding__is(nqp::unbox_s(PARROT_ENCODING($encoding)))

576

)

577

);

747

my $bb := pir::new__Ps('ByteBuffer');

748

pir::set__vPS($bb, pir::trans_encoding__SSI(

749

nqp::unbox_s(self),

750

pir::find_encoding__IS(nqp::unbox_s(PARROT_ENCODING($encoding)))

751

));

752

nqp::bindattr_s($buf, Buf, '$!buffer', $bb.get_string('binary'));

578

753

$buf;

579

754

}

580

755

581

method capitalize(Str:D:) {

756

method capitalize(Str:D:) is DEPRECATED {

582

757

self.subst(:g, rx/\w+/, -> $_ { .Str.lc.ucfirst });

583

758

}

584

759

method wordcase(Str:D: :&filter = &tclc, :$where = True) {

760

self.subst(:g, / [<:L> \w* ] +% <['\-]> /, -> $m {

761

my Str $s = $m.Str;

762

$s ~~ $where ?? filter($s) !! $s;

763

});

764

}

585

765

586

766

my class LSM {

587

767

has Str $!source;

611

791

}

612

792

}

613

793

614

proto method triage_substitution(|$) {*}

794

proto method triage_substitution(|) {*}

615

795

multi method triage_substitution($_ where { .key ~~ Regex }) {

616

796

my $key = .key;

617

797

return unless $!source.substr($!index) ~~ $key;

626

806

}

627

807

628

808

multi method triage_substitution($_) {

629

die "Don't know how to handle a {.WHAT.gist} as a substitution key";

809

X::Str::Trans::IllegalKey.new(key => $_).throw;

630

810

}

631

811

632

proto method increment_index(|$) {*}

812

proto method increment_index(|) {*}

633

813

multi method increment_index(Regex $s) {

634

814

$!source.substr($!index) ~~ $s;

635

815

$!index = $!next_match + $/.chars;

673

853

674

854

my $lsm = LSM.new(:source(self));

675

855

for (@changes) -> $p {

676

die "$p.perl() is not a Pair" unless $p ~~ Pair;

856

X::Str::Trans::InvalidArg.new(got => $p).throw unless $p ~~ Pair;

677

857

if $p.key ~~ Regex {

678

858

$lsm.add_substitution($p.key, $p.value);

679

859

}

774

954

$_<indent-chars>».key.join ~ ' ' x ($pos - $outdent) ~ $_<rest>;

775

955

}).join;

776

956

}

777

}

778

779

780

multi prefix:<~>(Str:D \$a) { $a }

781

782

multi infix:<~>(Str:D \$a, Str:D \$b) {

783

nqp::p6box_s(nqp::concat_s(nqp::unbox_s($a), nqp::unbox_s($b)))

784

}

785

786

multi infix:<x>(Str:D $s, Int:D $repetition) {

787

$repetition <= 0

957

958

method codes(Str:D:) returns Int:D {

959

nqp::p6box_i(nqp::chars(nqp::unbox_s(self)))

960

}

961

962

method tclc(Str:D:) returns Str:D {

963

nqp::p6box_s(nqp::tclc(nqp::unbox_s(self)))

964

}

965

966

method path(Str:D:) returns IO::Path:D {

967

IO::Path.new(self)

968

}

969

}

970

971

972

multi prefix:<~>(Str:D \a) returns Str:D { a }

973

multi prefix:<~>(str $a) returns str { $a }

974

975

multi infix:<~>(Str:D \a, Str:D \b) returns Str:D {

976

nqp::p6box_s(nqp::concat_s(nqp::unbox_s(a), nqp::unbox_s(b)))

977

}

978

multi infix:<~>(str $a, str $b) returns str { nqp::concat_s($a, $b) }

979

980

multi infix:<x>(Str:D $s, Int:D $repetition) returns Str:D {

981

$repetition < 0

788

982

?? ''

789

983

!! nqp::p6box_s(nqp::x(nqp::unbox_s($s), nqp::unbox_i($repetition)))

790

984

}

791

792

multi infix:<cmp>(Str:D \$a, Str:D \$b) {

793

Order.(nqp::p6box_i(nqp::cmp_s(nqp::unbox_s($a), nqp::unbox_s($b))))

794

}

795

796

multi infix:<===>(Str:D \$a, Str:D \$b) {

797

nqp::p6bool(nqp::iseq_s(nqp::unbox_s($a), nqp::unbox_s($b)))

798

}

799

800

multi infix:<leg>(Str:D \$a, Str:D \$b) {

801

Order.(nqp::p6box_i(nqp::cmp_s(nqp::unbox_s($a), nqp::unbox_s($b))))

802

}

803

804

multi infix:<eq>(Str:D \$a, Str:D \$b) {

805

nqp::p6bool(nqp::iseq_s(nqp::unbox_s($a), nqp::unbox_s($b)))

806

}

807

808

multi infix:<lt>(Str:D \$a, Str:D \$b) {

809

nqp::p6bool(nqp::islt_s(nqp::unbox_s($a), nqp::unbox_s($b)))

810

}

811

812

multi infix:<le>(Str:D \$a, Str:D \$b) {

813

nqp::p6bool(nqp::isle_s(nqp::unbox_s($a), nqp::unbox_s($b)))

814

}

815

816

multi infix:<gt>(Str:D \$a, Str:D \$b) {

817

nqp::p6bool(nqp::isgt_s(nqp::unbox_s($a), nqp::unbox_s($b)))

818

}

819

820

multi infix:<ge>(Str:D \$a, Str:D \$b) {

821

nqp::p6bool(nqp::isge_s(nqp::unbox_s($a), nqp::unbox_s($b)))

822

}

823

824

825

multi infix:<~|>(Str:D \$a, Str:D \$b) {

826

nqp::p6box_s(pir::bors__SSS(nqp::unbox_s($a), nqp::unbox_s($b)))

827

}

828

829

multi infix:<~&>(Str:D \$a, Str:D \$b) {

830

nqp::p6box_s(pir::bands__SSS(nqp::unbox_s($a), nqp::unbox_s($b)))

831

}

832

833

multi infix:<~^>(Str:D \$a, Str:D \$b) {

834

nqp::p6box_s(pir::bxors__SSS(nqp::unbox_s($a), nqp::unbox_s($b)))

835

}

836

837

multi prefix:<~^>(Str \$a) {

985

multi infix:<x>(str $s, int $repetition) returns str {

986

nqp::if(nqp::islt_i($repetition, 0), '', nqp::x($s, $repetition))

987

}

988

989

multi infix:<cmp>(Str:D \a, Str:D \b) returns Order:D {

990

Order.(nqp::p6box_i(nqp::cmp_s(nqp::unbox_s(a), nqp::unbox_s(b))))

991

}

992

multi infix:<cmp>(str $a, str $b) returns Order:D {

993

Order.(nqp::p6box_i(nqp::cmp_s($a, $b)))

994

}

995

996

multi infix:<===>(Str:D \a, Str:D \b) returns Bool:D {

997

nqp::p6bool(nqp::iseq_s(nqp::unbox_s(a), nqp::unbox_s(b)))

998

}

999

multi infix:<===>(str $a, str $b) returns Bool:D {

1000

nqp::p6bool(nqp::iseq_s($a, $b))

1001

}

1002

1003

multi infix:<leg>(Str:D \a, Str:D \b) returns Order:D {

1004

Order.(nqp::p6box_i(nqp::cmp_s(nqp::unbox_s(a), nqp::unbox_s(b))))

1005

}

1006

multi infix:<leg>(str $a, str $b) returns Order:D {

1007

Order.(nqp::p6box_i(nqp::cmp_s($a, $b)))

1008

}

1009

1010

multi infix:<eq>(Str:D \a, Str:D \b) returns Bool:D {

1011

nqp::p6bool(nqp::iseq_s(nqp::unbox_s(a), nqp::unbox_s(b)))

1012

}

1013

multi infix:<eq>(str $a, str $b) returns Bool:D {

1014

nqp::p6bool(nqp::iseq_s($a, $b))

1015

}

1016

1017

multi infix:<lt>(Str:D \a, Str:D \b) returns Bool:D {

1018

nqp::p6bool(nqp::islt_s(nqp::unbox_s(a), nqp::unbox_s(b)))

1019

}

1020

multi infix:<lt>(str $a, str $b) returns Bool:D {

1021

nqp::p6bool(nqp::islt_s($a, $b))

1022

}

1023

1024

multi infix:<le>(Str:D \a, Str:D \b) returns Bool:D {

1025

nqp::p6bool(nqp::isle_s(nqp::unbox_s(a), nqp::unbox_s(b)))

1026

}

1027

multi infix:<le>(str $a, str $b) returns Bool:D {

1028

nqp::p6bool(nqp::isle_s($a, $b))

1029

}

1030

1031

multi infix:<gt>(Str:D \a, Str:D \b) returns Bool:D {

1032

nqp::p6bool(nqp::isgt_s(nqp::unbox_s(a), nqp::unbox_s(b)))

1033

}

1034

multi infix:<gt>(str $a, str $b) returns Bool:D {

1035

nqp::p6bool(nqp::isgt_s($a, $b))

1036

}

1037

1038

multi infix:<ge>(Str:D \a, Str:D \b) returns Bool:D {

1039

nqp::p6bool(nqp::isge_s(nqp::unbox_s(a), nqp::unbox_s(b)))

1040

}

1041

multi infix:<le>(str $a, str $b) returns Bool:D {

1042

nqp::p6bool(nqp::isle_s($a, $b))

1043

}

1044

1045

multi infix:<~|>(Str:D \a, Str:D \b) returns Str:D {

1046

nqp::p6box_s(nqp::bitor_s(nqp::unbox_s(a), nqp::unbox_s(b)))

1047

}

1048

multi infix:<~|>(str $a, str $b) returns str { nqp::bitor_s($a, $b) }

1049

1050

multi infix:<~&>(Str:D \a, Str:D \b) returns Str:D {

1051

nqp::p6box_s(nqp::bitand_s(nqp::unbox_s(a), nqp::unbox_s(b)))

1052

}

1053

multi infix:<~&>(str $a, str $b) returns str { nqp::bitand_s($a, $b) }

1054

1055

multi infix:<~^>(Str:D \a, Str:D \b) returns Str:D {

1056

nqp::p6box_s(nqp::bitxor_s(nqp::unbox_s(a), nqp::unbox_s(b)))

1057

}

1058

multi infix:<~^>(str $a, str $b) returns str { nqp::bitxor_s($a, $b) }

1059

1060

multi prefix:<~^>(Str \a) {

838

1061

fail "prefix:<~^> NYI"; # XXX

839

1062

}

840

1063

841

multi sub ords(Str $s) {

1064

multi sub ords(Str $s) returns List:D {

842

1065

my Int $c = $s.chars;

843

1066

my str $ns = nqp::unbox_s($s);

844

1067

(^$c).map: { nqp::p6box_i(nqp::ord(nqp::substr($ns, $_, 1))) }

845

1068

}

846

1069

847

1070

# TODO: Cool variants

848

sub trim (Str:D $s) { $s.trim }

849

sub trim-leading (Str:D $s) { $s.trim-leading }

850

sub trim-trailing(Str:D $s) { $s.trim-trailing }

1071

sub trim (Str:D $s) returns Str:D { $s.trim }

1072

sub trim-leading (Str:D $s) returns Str:D { $s.trim-leading }

1073

sub trim-trailing(Str:D $s) returns Str:D { $s.trim-trailing }

851

1074

852

1075

# the opposite of Real.base, used for :16($hex_str)

853

sub unbase(Int:D $base, Str:D $str) {

1076

sub unbase(Int:D $base, Str:D $str) returns Numeric:D {

854

1077

my Str $prefix = $str.substr(0, 2);

855

1078

if $base <= 10 && $prefix eq any(<0x 0d 0o 0b>)

856

1079

or $base <= 24 && $prefix eq any <0o 0x>

861

1084

":{$base}<$str>".Numeric;

862

1085

}

863

1086

}

1087

# for :16[1, 2, 3]

1088

sub unbase_bracket($base, @a) {

1089

my $v = 0;

1090

my $denom = 1;

1091

my Bool $seen-dot = False;

1092

for @a {

1093

if $seen-dot {

1094

die "Only one decimal dot allowed" if $_ eq '.';

1095

$denom *= $base;

1096

$v += $_ / $denom

1097

}

1098

elsif $_ eq '.' {

1099

$seen-dot = True;

1100

}

1101

else {

1102

$v = $v * $base + $_;

1103

}

1104

}

1105

$v;

1106

}

864

1107

865

sub chrs(*@c) {

1108

sub chrs(*@c) returns Str:D {

866

1109

@c.map({.chr}).join('');

867

1110

}

1111

1112

sub substr-rw($s is rw, $from = 0, $chars = $s.chars - $from) {

1113

my Str $substr = $s.substr($from, $chars);

1114

Proxy.new(

1115

FETCH => sub ($) { $substr },

1116

STORE => sub ($, $new) {

1117

$s = $s.substr(0, $from)

1118

~ $new

1119

~ $s.substr($from + $chars);

1120

}

1121

);

1122

}

1123

1124

multi sub tclc(Str:D $s) returns Str:D {

1125

nqp::p6box_s(nqp::tclc(nqp::unbox_s($s)));

1126

}

Older »