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