mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-01-24 05:21:20 -08:00
114 lines
2.9 KiB
C
114 lines
2.9 KiB
C
/* -*- mode: c; c-basic-offset: 8 -*- */
|
|
/*
|
|
Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
|
|
Copyright (c) 1990, Giuseppe Attardi.
|
|
Copyright (c) 2001, Juan Jose Garcia Ripoll.
|
|
|
|
ECL is free software; you can redistribute it and/or
|
|
modify it under the terms of the GNU Library General Public
|
|
License as published by the Free Software Foundation; either
|
|
version 2 of the License, or (at your option) any later version.
|
|
|
|
See file '../../Copyright' for full details.
|
|
*/
|
|
|
|
#include <ecl/ecl.h>
|
|
#include <ecl/number.h>
|
|
#include <ecl/internal.h>
|
|
|
|
#define basep(d) (d <= 36)
|
|
|
|
cl_object
|
|
ecl_parse_integer(cl_object str, cl_index start, cl_index end,
|
|
cl_index *ep, unsigned int radix)
|
|
{
|
|
int sign, d;
|
|
cl_object integer_part, output;
|
|
cl_index i, c;
|
|
|
|
if (start >= end || !basep(radix)) {
|
|
*ep = start;
|
|
return OBJNULL;
|
|
}
|
|
sign = 1;
|
|
c = ecl_char(str, start);
|
|
if (c == '+') {
|
|
start++;
|
|
} else if (c == '-') {
|
|
sign = -1;
|
|
start++;
|
|
}
|
|
integer_part = _ecl_big_register0();
|
|
_ecl_big_set_ui(integer_part, 0);
|
|
for (i = start; i < end; i++) {
|
|
c = ecl_char(str, i);
|
|
d = ecl_digitp(c, radix);
|
|
if (d < 0) {
|
|
break;
|
|
}
|
|
_ecl_big_mul_ui(integer_part, integer_part, radix);
|
|
_ecl_big_add_ui(integer_part, integer_part, d);
|
|
}
|
|
if (sign < 0) {
|
|
_ecl_big_complement(integer_part, integer_part);
|
|
}
|
|
output = _ecl_big_register_normalize(integer_part);
|
|
*ep = i;
|
|
return (i == start)? OBJNULL : output;
|
|
}
|
|
|
|
@(defun parse_integer (strng
|
|
&key (start MAKE_FIXNUM(0))
|
|
end
|
|
(radix MAKE_FIXNUM(10))
|
|
junk_allowed
|
|
&aux x)
|
|
cl_index s, e, ep;
|
|
cl_object rtbl = ecl_current_readtable();
|
|
@ {
|
|
unlikely_if (!ECL_STRINGP(strng)) {
|
|
FEwrong_type_nth_arg(@[parse-integer], 1, strng, @[string]);
|
|
}
|
|
unlikely_if (!FIXNUMP(radix) ||
|
|
ecl_fixnum_lower(radix, MAKE_FIXNUM(2)) ||
|
|
ecl_fixnum_greater(radix, MAKE_FIXNUM(36)))
|
|
{
|
|
FEerror("~S is an illegal radix.", 1, radix);
|
|
}
|
|
{
|
|
cl_index_pair p =
|
|
ecl_vector_start_end(@[parse-integer], strng, start, end);
|
|
s = p.start;
|
|
e = p.end;
|
|
}
|
|
while (s < e &&
|
|
ecl_readtable_get(rtbl, ecl_char(strng, s), NULL) == cat_whitespace) {
|
|
s++;
|
|
}
|
|
if (s >= e) {
|
|
if (junk_allowed != Cnil)
|
|
@(return Cnil MAKE_FIXNUM(s))
|
|
else
|
|
goto CANNOT_PARSE;
|
|
}
|
|
x = ecl_parse_integer(strng, s, e, &ep, fix(radix));
|
|
if (x == OBJNULL) {
|
|
if (junk_allowed != Cnil) {
|
|
@(return Cnil MAKE_FIXNUM(ep));
|
|
} else {
|
|
goto CANNOT_PARSE;
|
|
}
|
|
}
|
|
if (junk_allowed != Cnil) {
|
|
@(return x MAKE_FIXNUM(ep));
|
|
}
|
|
for (s = ep; s < e; s++) {
|
|
unlikely_if (ecl_readtable_get(rtbl, ecl_char(strng, s), NULL)
|
|
!= cat_whitespace)
|
|
{
|
|
CANNOT_PARSE: FEparse_error("Cannot parse an integer in the string ~S.",
|
|
Cnil, 1, strng);
|
|
}
|
|
}
|
|
@(return x MAKE_FIXNUM(e));
|
|
} @)
|