1. # the uses of add_I in this class are a trick to make bigints work right
  2. my class IntStr is Int is Str {
  3. method new(Int:D $i, Str:D $s) {
  4. my \SELF = nqp::add_I($i, 0, self);
  5. nqp::bindattr_s(SELF, Str, '$!value', $s);
  6. SELF;
  7. }
  8. multi method ACCEPTS(IntStr:D: Any:D \a) {
  9. nqp::if(
  10. nqp::istype(a, Numeric),
  11. self.Int.ACCEPTS(a),
  12. nqp::if(
  13. nqp::istype(a, Str),
  14. self.Str.ACCEPTS(a),
  15. self.Str.ACCEPTS(a) && self.Int.ACCEPTS(a)))
  16. }
  17. multi method Numeric(IntStr:D:) { self.Int }
  18. multi method Numeric(IntStr:U:) {
  19. self.Mu::Numeric; # issue warning;
  20. 0
  21. }
  22. multi method Real(IntStr:D:) { self.Int }
  23. multi method Real(IntStr:U:) {
  24. self.Mu::Real; # issue warning;
  25. 0
  26. }
  27. method Int(IntStr:D:) { nqp::add_I(self, 0, Int) }
  28. multi method Str(IntStr:D:) { nqp::getattr_s(self, Str, '$!value') }
  29. multi method perl(IntStr:D:) { self.^name ~ '.new(' ~ self.Int.perl ~ ', ' ~ self.Str.perl ~ ')' }
  30. }
  31. my class NumStr is Num is Str {
  32. method new(Num $n, Str $s) {
  33. my \SELF = nqp::create(self);
  34. nqp::bindattr_n(SELF, Num, '$!value', $n);
  35. nqp::bindattr_s(SELF, Str, '$!value', $s);
  36. SELF;
  37. }
  38. multi method ACCEPTS(NumStr:D: Any:D \a) {
  39. nqp::if(
  40. nqp::istype(a, Numeric),
  41. self.Num.ACCEPTS(a),
  42. nqp::if(
  43. nqp::istype(a, Str),
  44. self.Str.ACCEPTS(a),
  45. self.Str.ACCEPTS(a) && self.Num.ACCEPTS(a)))
  46. }
  47. multi method Numeric(NumStr:D:) { self.Num }
  48. multi method Numeric(NumStr:U:) {
  49. self.Mu::Numeric; # issue warning;
  50. 0e0
  51. }
  52. multi method Real(NumStr:D:) { self.Num }
  53. multi method Real(NumStr:U:) {
  54. self.Mu::Real; # issue warning;
  55. 0e0
  56. }
  57. method Num(NumStr:D:) { nqp::getattr_n(self, Num, '$!value') }
  58. multi method Str(NumStr:D:) { nqp::getattr_s(self, Str, '$!value') }
  59. multi method perl(NumStr:D:) { self.^name ~ '.new(' ~ self.Num.perl ~ ', ' ~ self.Str.perl ~ ')' }
  60. }
  61. my class RatStr is Rat is Str {
  62. method new(Rat $r, Str $s) {
  63. my \SELF = nqp::create(self);
  64. nqp::bindattr(SELF, Rat, '$!numerator', $r.numerator);
  65. nqp::bindattr(SELF, Rat, '$!denominator', $r.denominator);
  66. nqp::bindattr_s(SELF, Str, '$!value', $s);
  67. SELF;
  68. }
  69. multi method ACCEPTS(RatStr:D: Any:D \a) {
  70. nqp::if(
  71. nqp::istype(a, Numeric),
  72. self.Rat.ACCEPTS(a),
  73. nqp::if(
  74. nqp::istype(a, Str),
  75. self.Str.ACCEPTS(a),
  76. self.Str.ACCEPTS(a) && self.Rat.ACCEPTS(a)))
  77. }
  78. method succ(RatStr:D: --> Rat:D) {
  79. nqp::p6bindattrinvres(
  80. nqp::p6bindattrinvres(nqp::create(Rat), Rat, '$!numerator',
  81. nqp::add_I(
  82. nqp::getattr(self, Rat, '$!numerator'),
  83. nqp::getattr(self, Rat, '$!denominator'), Int)),
  84. Rat, '$!denominator', nqp::getattr(self, Rat, '$!denominator'))
  85. }
  86. method pred(RatStr:D: --> Rat:D) {
  87. nqp::p6bindattrinvres(
  88. nqp::p6bindattrinvres(nqp::create(Rat), Rat, '$!numerator',
  89. nqp::sub_I(
  90. nqp::getattr(self, Rat, '$!numerator'),
  91. nqp::getattr(self, Rat, '$!denominator'), Int)),
  92. Rat, '$!denominator', nqp::getattr(self, Rat, '$!denominator'))
  93. }
  94. method Capture(RatStr:D:) { self.Mu::Capture }
  95. multi method Numeric(RatStr:D:) { self.Rat }
  96. multi method Numeric(RatStr:U:) {
  97. self.Mu::Numeric; # issue warning;
  98. 0.0
  99. }
  100. multi method Real(RatStr:D:) { self.Rat }
  101. multi method Real(RatStr:U:) {
  102. self.Mu::Real; # issue warning;
  103. 0.0
  104. }
  105. method Rat(RatStr:D:) { Rat.new(nqp::getattr(self, Rat, '$!numerator'), nqp::getattr(self, Rat, '$!denominator')) }
  106. multi method Str(RatStr:D:) { nqp::getattr_s(self, Str, '$!value') }
  107. multi method perl(RatStr:D:) { self.^name ~ '.new(' ~ self.Rat.perl ~ ', ' ~ self.Str.perl ~ ')' }
  108. }
  109. my class ComplexStr is Complex is Str {
  110. method new(Complex $c, Str $s) {
  111. my \SELF = nqp::create(self);
  112. nqp::bindattr_n(SELF, Complex, '$!re', $c.re);
  113. nqp::bindattr_n(SELF, Complex, '$!im', $c.im);
  114. nqp::bindattr_s(SELF, Str, '$!value', $s);
  115. SELF;
  116. }
  117. multi method ACCEPTS(ComplexStr:D: Any:D \a) {
  118. nqp::if(
  119. nqp::istype(a, Numeric),
  120. self.Complex.ACCEPTS(a),
  121. nqp::if(
  122. nqp::istype(a, Str),
  123. self.Str.ACCEPTS(a),
  124. self.Str.ACCEPTS(a) && self.Complex.ACCEPTS(a)))
  125. }
  126. method Capture(ComplexStr:D:) { self.Mu::Capture }
  127. multi method Numeric(ComplexStr:D:) { self.Complex }
  128. multi method Numeric(ComplexStr:U:) {
  129. self.Mu::Numeric; # issue warning;
  130. <0+0i>
  131. }
  132. multi method Real(ComplexStr:D:) { self.Complex.Real }
  133. multi method Real(ComplexStr:U:) {
  134. self.Mu::Real; # issue warning;
  135. <0+0i>.Real
  136. }
  137. method Complex(ComplexStr:D:) { Complex.new(nqp::getattr_n(self, Complex, '$!re'), nqp::getattr_n(self, Complex, '$!im')) }
  138. multi method Str(ComplexStr:D:) { nqp::getattr_s(self, Str, '$!value') }
  139. multi method perl(ComplexStr:D:) { self.^name ~ '.new(' ~ self.Complex.perl ~ ', ' ~ self.Str.perl ~ ')' }
  140. }
  141. # we define cmp ops for these allomorphic types as numeric first, then Str. If
  142. # you want just one half of the cmp, you'll need to coerce the args
  143. multi sub infix:<cmp>(IntStr:D $a, IntStr:D $b) { $a.Int cmp $b.Int || $a.Str cmp $b.Str }
  144. multi sub infix:<cmp>(IntStr:D $a, RatStr:D $b) { $a.Int cmp $b.Rat || $a.Str cmp $b.Str }
  145. multi sub infix:<cmp>(IntStr:D $a, NumStr:D $b) { $a.Int cmp $b.Num || $a.Str cmp $b.Str }
  146. multi sub infix:<cmp>(IntStr:D $a, ComplexStr:D $b) { $a.Int cmp $b.Complex || $a.Str cmp $b.Str }
  147. multi sub infix:<cmp>(RatStr:D $a, IntStr:D $b) { $a.Rat cmp $b.Int || $a.Str cmp $b.Str }
  148. multi sub infix:<cmp>(RatStr:D $a, RatStr:D $b) { $a.Rat cmp $b.Rat || $a.Str cmp $b.Str }
  149. multi sub infix:<cmp>(RatStr:D $a, NumStr:D $b) { $a.Rat cmp $b.Num || $a.Str cmp $b.Str }
  150. multi sub infix:<cmp>(RatStr:D $a, ComplexStr:D $b) { $a.Rat cmp $b.Complex || $a.Str cmp $b.Str }
  151. multi sub infix:<cmp>(NumStr:D $a, IntStr:D $b) { $a.Num cmp $b.Int || $a.Str cmp $b.Str }
  152. multi sub infix:<cmp>(NumStr:D $a, RatStr:D $b) { $a.Num cmp $b.Rat || $a.Str cmp $b.Str }
  153. multi sub infix:<cmp>(NumStr:D $a, NumStr:D $b) { $a.Num cmp $b.Num || $a.Str cmp $b.Str }
  154. multi sub infix:<cmp>(NumStr:D $a, ComplexStr:D $b) { $a.Num cmp $b.Complex || $a.Str cmp $b.Str }
  155. multi sub infix:<cmp>(ComplexStr:D $a, IntStr:D $b) { $a.Complex cmp $b.Int || $a.Str cmp $b.Str }
  156. multi sub infix:<cmp>(ComplexStr:D $a, RatStr:D $b) { $a.Complex cmp $b.Rat || $a.Str cmp $b.Str }
  157. multi sub infix:<cmp>(ComplexStr:D $a, NumStr:D $b) { $a.Complex cmp $b.Num || $a.Str cmp $b.Str }
  158. multi sub infix:<cmp>(ComplexStr:D $a, ComplexStr:D $b) { $a.Complex cmp $b.Complex || $a.Str cmp $b.Str }
  159. multi sub infix:<eqv>(IntStr:D $a, IntStr:D $b) { $a.Int eqv $b.Int && $a.Str eqv $b.Str }
  160. multi sub infix:<eqv>(IntStr:D $a, RatStr:D $b --> False) {}
  161. multi sub infix:<eqv>(IntStr:D $a, NumStr:D $b --> False) {}
  162. multi sub infix:<eqv>(IntStr:D $a, ComplexStr:D $b --> False) {}
  163. multi sub infix:<eqv>(RatStr:D $a, IntStr:D $b --> False) {}
  164. multi sub infix:<eqv>(RatStr:D $a, RatStr:D $b) { $a.Rat eqv $b.Rat && $a.Str eqv $b.Str }
  165. multi sub infix:<eqv>(RatStr:D $a, NumStr:D $b --> False) {}
  166. multi sub infix:<eqv>(RatStr:D $a, ComplexStr:D $b --> False) {}
  167. multi sub infix:<eqv>(NumStr:D $a, IntStr:D $b --> False) {}
  168. multi sub infix:<eqv>(NumStr:D $a, RatStr:D $b --> False) {}
  169. multi sub infix:<eqv>(NumStr:D $a, NumStr:D $b) { $a.Num eqv $b.Num && $a.Str eqv $b.Str }
  170. multi sub infix:<eqv>(NumStr:D $a, ComplexStr:D $b --> False) {}
  171. multi sub infix:<eqv>(ComplexStr:D $a, IntStr:D $b --> False) {}
  172. multi sub infix:<eqv>(ComplexStr:D $a, RatStr:D $b --> False) {}
  173. multi sub infix:<eqv>(ComplexStr:D $a, NumStr:D $b --> False) {}
  174. multi sub infix:<eqv>(ComplexStr:D $a, ComplexStr:D $b) { $a.Complex eqv $b.Complex && $a.Str eqv $b.Str }
  175. multi sub infix:<===>(IntStr:D $a, IntStr:D $b) {
  176. $a.Int === $b.Int && $a.Str === $b.Str
  177. }
  178. multi sub infix:<===>(RatStr:D $a, RatStr:D $b) {
  179. $a.Rat === $b.Rat && $a.Str === $b.Str
  180. }
  181. multi sub infix:<===>(NumStr:D $a, NumStr:D $b) {
  182. $a.Num === $b.Num && $a.Str === $b.Str
  183. }
  184. multi sub infix:<===>(ComplexStr:D $a, ComplexStr:D $b) {
  185. $a.Complex === $b.Complex && $a.Str === $b.Str
  186. }
  187. multi sub val(*@maybevals) {
  188. @maybevals.list.map({ val($_) }).eager;
  189. }
  190. multi sub val(Mu) {
  191. warn "Value of type Mu uselessly passed to val()";
  192. Mu
  193. }
  194. # if Slip, preserve slipness
  195. multi sub val(List:D $maybevals) {
  196. nqp::stmts(
  197. (my $output := val(|$maybevals)),
  198. nqp::if(
  199. nqp::istype($maybevals, Slip),
  200. $output.Slip,
  201. $output
  202. )
  203. )
  204. }
  205. multi sub val(Pair:D \ww-thing) is raw {
  206. # this is a Pair object possible in «» constructs; just pass it through. We
  207. # capture this specially from the below sub to avoid emitting a warning
  208. # whenever an affected «» construct is being processed.
  209. ww-thing
  210. }
  211. multi sub val(\one-thing) {
  212. warn "Value of type {one-thing.WHAT.perl} uselessly passed to val()";
  213. one-thing;
  214. }
  215. multi sub val(Str:D $MAYBEVAL, :$val-or-fail) {
  216. # TODO:
  217. # * Additional numeric styles:
  218. # + fractions in [] radix notation: :100[10,'.',53]
  219. # * Performance tuning
  220. # * Fix remaining XXXX
  221. my str $str = nqp::unbox_s($MAYBEVAL);
  222. my int $eos = nqp::chars($str);
  223. return IntStr.new(0,"") unless $eos; # handle ""
  224. # S02:3276-3277: Ignore leading and trailing whitespace
  225. my int $pos = nqp::findnotcclass(nqp::const::CCLASS_WHITESPACE,
  226. $str, 0, $eos);
  227. my int $end = nqp::sub_i($eos, 1);
  228. $end = nqp::sub_i($end, 1)
  229. while nqp::isge_i($end, $pos)
  230. && nqp::iscclass(nqp::const::CCLASS_WHITESPACE, $str, $end);
  231. # Fail all the way out when parse failures occur. Return the original
  232. # string, or a failure if we're Str.Numeric
  233. my &parse_fail := -> \msg {
  234. $val-or-fail
  235. ?? fail X::Str::Numeric.new(:source($MAYBEVAL),:reason(msg),:$pos)
  236. !! return $MAYBEVAL
  237. }
  238. # Str.Numeric should handle blank string before val()
  239. parse_fail "Empty string not properly caught before val()" if nqp::islt_i($end, $pos);
  240. # Reset end-of-string after trimming
  241. $eos = nqp::add_i($end, 1);
  242. # return an appropriate type when we've found a number. Allomorphic unless
  243. # Str.Numeric is calling
  244. my &parse_win := -> \newval {
  245. $val-or-fail
  246. ?? return newval
  247. !! nqp::istype(newval, Num)
  248. ?? return NumStr.new(newval, $MAYBEVAL)
  249. !! nqp::istype(newval, Rat)
  250. ?? return RatStr.new(newval, $MAYBEVAL)
  251. !! nqp::istype(newval, Complex)
  252. ?? return ComplexStr.new(newval, $MAYBEVAL)
  253. !! nqp::istype(newval, Int)
  254. ?? return IntStr.new(newval, $MAYBEVAL)
  255. !! die "Unknown type {newval.^name} found in val() processing"
  256. }
  257. my sub parse-simple-number() {
  258. # Handle NaN here, to make later parsing simpler
  259. if nqp::eqat($str,'NaN',$pos) {
  260. $pos = nqp::add_i($pos, 3);
  261. return nqp::p6box_n(nqp::nan());
  262. }
  263. # Handle any leading +/-/− sign
  264. my int $ch = nqp::ord($str, $pos);
  265. my int $neg = nqp::iseq_i($ch, 45) || nqp::iseq_i($ch, 8722); # '-', '−'
  266. if $neg || nqp::iseq_i($ch, 43) { # '-', '−', '+'
  267. $pos = nqp::add_i($pos, 1);
  268. $ch = nqp::islt_i($pos, $eos) && nqp::ord($str, $pos);
  269. }
  270. # nqp::radix_I parse results, and helper values
  271. my Mu $parse;
  272. my str $prefix;
  273. my int $radix;
  274. my int $p;
  275. my sub parse-int-frac-exp() {
  276. # Integer part, if any
  277. my Int $int := 0;
  278. if nqp::isne_i($ch, 46) { # '.'
  279. parse_fail "Cannot convert radix of $radix (max 36)"
  280. if nqp::isgt_i($radix, 36);
  281. $parse := nqp::radix_I($radix, $str, $pos, $neg, Int);
  282. $p = nqp::atpos($parse, 2);
  283. parse_fail "base-$radix number must begin with valid digits or '.'"
  284. if nqp::iseq_i($p, -1);
  285. $pos = $p;
  286. $int := nqp::atpos($parse, 0);
  287. nqp::isge_i($pos, $eos)
  288. ?? return $int
  289. !! ($ch = nqp::ord($str, $pos));
  290. }
  291. # Fraction, if any
  292. my Int $frac := 0;
  293. my Int $base := 0;
  294. if nqp::iseq_i($ch, 46) { # '.'
  295. $pos = nqp::add_i($pos, 1);
  296. $parse := nqp::radix_I($radix, $str, $pos,
  297. nqp::add_i($neg, 4), Int);
  298. $p = nqp::atpos($parse, 2);
  299. parse_fail 'radix point must be followed by one or more valid digits'
  300. if nqp::iseq_i($p, -1);
  301. $pos = $p;
  302. $frac := nqp::atpos($parse, 0);
  303. $base := nqp::atpos($parse, 1);
  304. $ch = nqp::islt_i($pos, $eos) && nqp::ord($str, $pos);
  305. }
  306. # Exponent, if 'E' or 'e' are present (forces return type Num)
  307. if nqp::iseq_i($ch, 69) || nqp::iseq_i($ch, 101) { # 'E', 'e'
  308. parse_fail "'E' or 'e' style exponent only allowed on decimal (base-10) numbers, not base-$radix"
  309. unless nqp::iseq_i($radix, 10);
  310. $pos = nqp::add_i($pos, 1);
  311. # handle the sign
  312. # XXX TODO: teach radix_I to handle '−' (U+2212) minus?
  313. my int $ch = nqp::islt_i($pos, $eos) && nqp::ord($str, $pos);
  314. my int $neg-e = nqp::if(
  315. nqp::iseq_i($ch, 43), # '+'
  316. nqp::stmts(($pos = nqp::add_i($pos, 1)), 0),
  317. nqp::if( # '-', '−'
  318. nqp::iseq_i($ch, 45) || nqp::iseq_i($ch, 8722),
  319. nqp::stmts(($pos = nqp::add_i($pos, 1)), 1),
  320. 0,
  321. )
  322. );
  323. $parse := nqp::radix_I(10, $str, $pos, $neg-e, Int);
  324. $p = nqp::atpos($parse, 2);
  325. parse_fail "'E' or 'e' must be followed by decimal (base-10) integer"
  326. if nqp::iseq_i($p, -1);
  327. $pos = $p;
  328. return nqp::p6box_n(nqp::mul_n(
  329. $frac ?? nqp::add_n( $int.Num, nqp::div_n($frac.Num, $base.Num) )
  330. !! $int.Num,
  331. nqp::pow_n(10e0, nqp::atpos($parse, 0).Num)
  332. )) # if we have a zero, handle the sign correctly
  333. || nqp::if(nqp::iseq_i($neg, 1), -0e0, 0e0);
  334. }
  335. # Multiplier with exponent, if single '*' is present
  336. # (but skip if current token is '**', as otherwise we
  337. # get recursive multiplier parsing stupidity)
  338. if nqp::iseq_i($ch, 42)
  339. && nqp::isne_s(substr($str, $pos, 2), '**') { # '*'
  340. $pos = nqp::add_i($pos, 1);
  341. my $mult_base := parse-simple-number();
  342. parse_fail "'*' multiplier base must be an integer"
  343. unless nqp::istype($mult_base, Int);
  344. parse_fail "'*' multiplier base must be followed by '**' and exponent"
  345. unless nqp::eqat($str,'**',$pos);
  346. $pos = nqp::add_i($pos, 2);
  347. my $mult_exp := parse-simple-number();
  348. parse_fail "'**' multiplier exponent must be an integer"
  349. unless nqp::istype($mult_exp, Int);
  350. my $mult := $mult_base ** $mult_exp;
  351. $int := $int * $mult;
  352. $frac := $frac * $mult;
  353. }
  354. # Return an Int if there was no radix point, otherwise, return a Rat
  355. nqp::unless($base, $int, Rat.new($int * $base + $frac, $base));
  356. }
  357. # Look for radix specifiers
  358. if nqp::iseq_i($ch, 58) { # ':'
  359. # A string of the form :16<FE_ED.F0_0D> or :60[12,34,56]
  360. $pos = nqp::add_i($pos, 1);
  361. $parse := nqp::radix_I(10, $str, $pos, 0, Int);
  362. $p = nqp::atpos($parse, 2);
  363. parse_fail "radix (in decimal) expected after ':'"
  364. if nqp::iseq_i($p, -1);
  365. $pos = $p;
  366. $radix = nqp::atpos($parse, 0);
  367. $ch = nqp::islt_i($pos, $eos) && nqp::ord($str, $pos);
  368. if nqp::iseq_i($ch, 60) { # '<'
  369. $pos = nqp::add_i($pos, 1);
  370. my $result := parse-int-frac-exp();
  371. parse_fail "malformed ':$radix<>' style radix number, expecting '>' after the body"
  372. unless nqp::islt_i($pos, $eos)
  373. && nqp::iseq_i(nqp::ord($str, $pos), 62); # '>'
  374. $pos = nqp::add_i($pos, 1);
  375. return $result;
  376. }
  377. elsif nqp::iseq_i($ch, 171) { # '«'
  378. $pos = nqp::add_i($pos, 1);
  379. my $result := parse-int-frac-exp();
  380. parse_fail "malformed ':$radix«»' style radix number, expecting '»' after the body"
  381. unless nqp::islt_i($pos, $eos)
  382. && nqp::iseq_i(nqp::ord($str, $pos), 187); # '»'
  383. $pos = nqp::add_i($pos, 1);
  384. return $result;
  385. }
  386. elsif nqp::iseq_i($ch, 91) { # '['
  387. $pos = nqp::add_i($pos, 1);
  388. my Int $result := 0;
  389. my Int $digit := 0;
  390. while nqp::islt_i($pos, $eos)
  391. && nqp::isne_i(nqp::ord($str, $pos), 93) { # ']'
  392. $parse := nqp::radix_I(10, $str, $pos, 0, Int);
  393. $p = nqp::atpos($parse, 2);
  394. parse_fail "malformed ':$radix[]' style radix number, expecting comma separated decimal values after opening '['"
  395. if nqp::iseq_i($p, -1);
  396. $pos = $p;
  397. $digit := nqp::atpos($parse, 0);
  398. parse_fail "digit is larger than {$radix - 1} in ':$radix[]' style radix number"
  399. if nqp::isge_i($digit, $radix);
  400. $result := $result * $radix + $digit;
  401. $pos = nqp::add_i($pos, 1)
  402. if nqp::islt_i($pos, $eos)
  403. && nqp::iseq_i(nqp::ord($str, $pos), 44); # ','
  404. }
  405. parse_fail "malformed ':$radix[]' style radix number, expecting ']' after the body"
  406. unless nqp::islt_i($pos, $eos)
  407. && nqp::iseq_i(nqp::ord($str, $pos), 93); # ']'
  408. $pos = nqp::add_i($pos, 1);
  409. # XXXX: Handle fractions!
  410. # XXXX: Handle exponents!
  411. return $neg ?? -$result !! $result;
  412. }
  413. else {
  414. parse_fail "malformed ':$radix' style radix number, expecting '<' or '[' after the base";
  415. }
  416. }
  417. elsif nqp::iseq_i($ch, 48) # '0'
  418. and $radix = nqp::index(' b o d x',
  419. nqp::substr($str, nqp::add_i($pos, 1), 1))
  420. and nqp::isge_i($radix, 2) {
  421. # A string starting with 0x, 0d, 0o, or 0b,
  422. # followed by one optional '_'
  423. $pos = nqp::add_i($pos, 2);
  424. $pos = nqp::add_i($pos, 1)
  425. if nqp::islt_i($pos, $eos)
  426. && nqp::iseq_i(nqp::ord($str, $pos), 95); # '_'
  427. parse-int-frac-exp();
  428. }
  429. elsif nqp::eqat($str,'Inf',$pos) {
  430. # 'Inf'
  431. $pos = nqp::add_i($pos, 3);
  432. $neg ?? -Inf !! Inf;
  433. }
  434. else {
  435. # Last chance: a simple decimal number
  436. $radix = 10;
  437. parse-int-frac-exp();
  438. }
  439. }
  440. my sub parse-real() {
  441. # Parse a simple number or a Rat numerator
  442. my $result := parse-simple-number();
  443. return $result if nqp::iseq_i($pos, $eos);
  444. # Check for '/' indicating Rat denominator
  445. if nqp::iseq_i(nqp::ord($str, $pos), 47) { # '/'
  446. $pos = nqp::add_i($pos, 1);
  447. parse_fail "denominator expected after '/'"
  448. unless nqp::islt_i($pos, $eos);
  449. my $denom := parse-simple-number();
  450. $result := nqp::istype($result, Int) && nqp::istype($denom, Int)
  451. ?? Rat.new($result, $denom)
  452. !! $result / $denom;
  453. }
  454. $result;
  455. }
  456. # Parse a real number, magnitude of a pure imaginary number,
  457. # or real part of a complex number
  458. my $result := parse-real();
  459. parse_win $result if nqp::iseq_i($pos, $eos);
  460. # Check for 'i' or '\\i' indicating first parsed number was
  461. # the magnitude of a pure imaginary number
  462. if nqp::iseq_i(nqp::ord($str, $pos), 105) { # 'i'
  463. parse_fail "Imaginary component of 'NaN' or 'Inf' must be followed by \\i"
  464. if nqp::isnanorinf($result.Num);
  465. $pos = nqp::add_i($pos, 1);
  466. $result := Complex.new(0, $result);
  467. }
  468. elsif nqp::eqat($str,'\\i',$pos) {
  469. $pos = nqp::add_i($pos, 2);
  470. $result := Complex.new(0, $result);
  471. }
  472. # Check for '+' or '-' indicating first parsed number was
  473. # the real part of a complex number
  474. elsif nqp::iseq_i(nqp::ord($str, $pos), 45) # '-'
  475. || nqp::iseq_i(nqp::ord($str, $pos), 43) # '+'
  476. || nqp::iseq_i(nqp::ord($str, $pos), 8722) { # '−'
  477. # Don't move $pos -- we want parse-real() to see the sign
  478. my $im := parse-real();
  479. parse_fail "imaginary part of complex number must be followed by 'i' or '\\i'"
  480. unless nqp::islt_i($pos, $eos);
  481. if nqp::iseq_i(nqp::ord($str, $pos), 105) { # 'i'
  482. parse_fail "Imaginary component of 'NaN' or 'Inf' must be followed by \\i"
  483. if nqp::isnanorinf($im.Num);
  484. $pos = nqp::add_i($pos, 1);
  485. }
  486. elsif nqp::eqat($str,'\\i',$pos) {
  487. $pos = nqp::add_i($pos, 2);
  488. }
  489. else {
  490. parse_fail "imaginary part of complex number must be followed by 'i' or '\\i'"
  491. }
  492. $result := Complex.new($result, $im);
  493. }
  494. # Check for trailing garbage
  495. parse_fail "trailing characters after number"
  496. if nqp::islt_i($pos, $eos);
  497. parse_win $result;
  498. }