// read_complex(). // General includes. #include "cl_sysdep.h" // Specification. #include "cln/complex_io.h" // Implementation. #include #include #include "cln/input.h" #include "cln/real_io.h" #include "cln/float_io.h" #include "cln/rational_io.h" #include "cln/integer_io.h" #include "cln/integer.h" #include "cl_I.h" #include "cl_F.h" #include "cl_C.h" #include "cln/exception.h" #undef floor #include #define floor cln_floor namespace cln { // Step forward over all digits, to the end of string or to the next non-digit. static const char * skip_digits (const char * ptr, const char * string_limit, unsigned int base) { for ( ; ptr != string_limit; ptr++) { var char ch = *ptr; if ((ch >= '0') && (ch <= '9')) if (ch < '0' + (int)base) continue; else break; else { if (base <= 10) break; if (((ch >= 'A') && (ch < 'A'-10+(int)base)) || ((ch >= 'a') && (ch < 'a'-10+(int)base)) ) continue; else break; } } return ptr; } // Finish reading the "+yi" part of "x+yi" when "x" has already been read. static const cl_N read_complex_number_rest (const cl_read_flags& flags, const char * string_rest, const char * string, const char * string_limit, const char * * end_of_parse, const cl_R& x); #define at_end_of_parse(ptr) \ if (end_of_parse) \ { *end_of_parse = (ptr); } \ else \ { if ((ptr) != string_limit) { throw read_number_junk_exception((ptr),string,string_limit); } } const cl_N read_complex (const cl_read_flags& flags, const char * string, const char * string_limit, const char * * end_of_parse) { // If no string_limit is given, it defaults to the end of the string. if (!string_limit) string_limit = string + ::strlen(string); if (flags.syntax & syntax_rational) { // Check for rational number syntax. var unsigned int rational_base = flags.rational_base; var const char * ptr = string; if (flags.lsyntax & lsyntax_commonlisp) { if (ptr == string_limit) goto not_rational_syntax; if (*ptr == '#') { // Check for #b, #o, #x, #nR syntax. ptr++; if (ptr == string_limit) goto not_rational_syntax; switch (*ptr) { case 'b': case 'B': rational_base = 2; break; case 'o': case 'O': rational_base = 8; break; case 'x': case 'X': rational_base = 16; break; default: var const char * base_end_ptr = skip_digits(ptr,string_limit,10); if (base_end_ptr == ptr) goto not_rational_syntax; if (base_end_ptr == string_limit) goto not_rational_syntax; if (!((*base_end_ptr == 'r') || (*base_end_ptr == 'R'))) goto not_rational_syntax; var cl_I base = read_integer(10,0,ptr,0,base_end_ptr-ptr); if (!((base >= 2) && (base <= 36))) { std::ostringstream buf; fprint(buf, "Base must be an integer in the range from 2 to 36, not "); fprint(buf, base); throw runtime_exception(buf.str()); } rational_base = FN_to_UV(base); ptr = base_end_ptr; break; } ptr++; } } var const char * ptr_after_prefix = ptr; var cl_signean sign = 0; if (ptr == string_limit) goto not_rational_syntax; switch (*ptr) { case '-': sign = ~sign; case '+': ptr++; default: break; } var const char * ptr_after_sign = ptr; if (flags.syntax & syntax_integer) { // Check for integer syntax: {'+'|'-'|} {digit}+ {'.'|} // Allow final dot only in Common Lisp syntax if there was no # prefix. if ((flags.lsyntax & lsyntax_commonlisp) && (ptr_after_prefix == string)) { ptr = skip_digits(ptr_after_sign,string_limit,10); if (ptr != ptr_after_sign) if (ptr != string_limit) if (*ptr == '.') { ptr++; if ((ptr == string_limit) || !(((*ptr >= '0') && (*ptr <= '9')) || ((*ptr >= 'A') && (*ptr <= 'Z') && (*ptr != 'I')) || ((*ptr >= 'a') && (*ptr <= 'z') && (*ptr != 'i')) || (*ptr == '.') || (*ptr == '_') || (*ptr == '/'))) return read_complex_number_rest(flags,ptr,string,string_limit,end_of_parse, read_integer(10,sign,ptr_after_sign,0,ptr-ptr_after_sign)); } } ptr = skip_digits(ptr_after_sign,string_limit,rational_base); if ((ptr == string_limit) || !(((*ptr >= '0') && (*ptr <= '9')) || ((*ptr >= 'A') && (*ptr <= 'Z') && (*ptr != 'I')) || ((*ptr >= 'a') && (*ptr <= 'z') && (*ptr != 'i')) || (*ptr == '.') || (*ptr == '_') || (*ptr == '/'))) return read_complex_number_rest(flags,ptr,string,string_limit,end_of_parse, read_integer(rational_base,sign,ptr_after_sign,0,ptr-ptr_after_sign)); } if (flags.syntax & syntax_ratio) { // Check for ratio syntax: {'+'|'-'|} {digit}+ '/' {digit}+ ptr = skip_digits(ptr_after_sign,string_limit,rational_base); if (ptr != ptr_after_sign) if (ptr != string_limit) if (*ptr == '/') { var const char * ptr_at_slash = ptr; ptr = skip_digits(ptr_at_slash+1,string_limit,rational_base); if (ptr != ptr_at_slash+1) if ((ptr == string_limit) || !(((*ptr >= '0') && (*ptr <= '9')) || ((*ptr >= 'A') && (*ptr <= 'Z') && (*ptr != 'I')) || ((*ptr >= 'a') && (*ptr <= 'z') && (*ptr != 'i')) || (*ptr == '.') || (*ptr == '_') || (*ptr == '/'))) return read_complex_number_rest(flags,ptr,string,string_limit,end_of_parse, read_rational(rational_base,sign,ptr_after_sign,0,ptr_at_slash-ptr_after_sign,ptr-ptr_after_sign)); } } } not_rational_syntax: if (flags.syntax & syntax_float) { // Check for floating-point number syntax: // {'+'|'-'|} {digit}+ {'.' {digit}* | } expo {'+'|'-'|} {digit}+ // {'+'|'-'|} {digit}* '.' {digit}+ expo {'+'|'-'|} {digit}+ // {'+'|'-'|} {digit}* '.' {digit}+ var const char * ptr = string; var const unsigned int float_base = 10; var cl_signean sign = 0; if (ptr == string_limit) goto not_float_syntax; switch (*ptr) { case '-': sign = ~sign; case '+': ptr++; default: break; } var const char * ptr_after_sign = ptr; var const char * ptr_after_intpart = skip_digits(ptr_after_sign,string_limit,float_base); var cl_boolean have_dot = cl_false; var const char * ptr_before_fracpart = ptr_after_intpart; var const char * ptr_after_fracpart = ptr_after_intpart; ptr = ptr_after_intpart; if (ptr != string_limit) if (*ptr == '.') { have_dot = cl_true; ptr_before_fracpart = ptr+1; ptr_after_fracpart = skip_digits(ptr_before_fracpart,string_limit,float_base); } ptr = ptr_after_fracpart; var char exponent_marker; var cl_boolean have_exponent; var const char * ptr_in_exponent = ptr; var const char * ptr_after_exponent = ptr; if ((ptr == string_limit) || !(((*ptr >= '0') && (*ptr <= '9')) || ((*ptr >= 'A') && (*ptr <= 'Z') && (*ptr != 'I')) || ((*ptr >= 'a') && (*ptr <= 'z') && (*ptr != 'i')) || (*ptr == '.') || (*ptr == '/'))) { // No exponent. have_exponent = cl_false; // Must have at least one fractional part digit. if (ptr_after_fracpart == ptr_before_fracpart) goto not_float_syntax; exponent_marker = 'E'; } else { have_exponent = cl_true; // Must have at least one digit. if (ptr_after_sign == ptr_after_intpart) if (ptr_after_fracpart == ptr_before_fracpart) goto not_float_syntax; exponent_marker = ((*ptr >= 'a') && (*ptr <= 'z') ? *ptr - 'a' + 'A' : *ptr); switch (exponent_marker) { case 'E': case 'S': case 'F': case 'D': case 'L': break; default: goto not_float_syntax; } } if (have_exponent) { ptr++; if (ptr == string_limit) goto not_float_syntax; switch (*ptr) { case '-': case '+': ptr++; default: break; } ptr_in_exponent = ptr; ptr_after_exponent = skip_digits(ptr_in_exponent,string_limit,10); if (ptr_after_exponent == ptr_in_exponent) goto not_float_syntax; } ptr = ptr_after_exponent; var const char * ptr_after_prec = ptr; var float_format_t prec; if ((ptr != string_limit) && (*ptr == '_')) { ptr++; ptr_after_prec = skip_digits(ptr,string_limit,10); if (ptr_after_prec == ptr) goto not_float_syntax; var cl_I prec1 = digits_to_I(ptr,ptr_after_prec-ptr,10); var uintC prec2 = cl_I_to_ulong(prec1); prec = (float_base==10 ? float_format(prec2) : (float_format_t)((uintC)((1+prec2)*::log((double)float_base)*1.442695041)+1) ); } else { switch (exponent_marker) { case 'S': prec = float_format_sfloat; break; case 'F': prec = float_format_ffloat; break; case 'D': prec = float_format_dfloat; break; case 'L': prec = flags.float_flags.default_lfloat_format; break; case 'E': prec = flags.float_flags.default_float_format; break; default: NOTREACHED } if (flags.float_flags.mantissa_dependent_float_format) { // Count the number of significant digits. ptr = ptr_after_sign; while (ptr < ptr_after_fracpart && (*ptr == '0' || *ptr == '.')) ptr++; var uintC num_significant_digits = (ptr_after_fracpart - ptr) - (ptr_before_fracpart > ptr ? 1 : 0); var uintC prec2 = (num_significant_digits>=2 ? num_significant_digits-2 : 0); var float_format_t precx = (float_base==10 ? float_format(prec2) : (float_format_t)((uintC)((1+prec2)*::log((double)float_base)*1.442695041)+1) ); if ((uintC)precx > (uintC)prec) prec = precx; } } floatformatcase(prec , if (!(flags.syntax & syntax_sfloat)) goto not_float_syntax; , if (!(flags.syntax & syntax_ffloat)) goto not_float_syntax; , if (!(flags.syntax & syntax_dfloat)) goto not_float_syntax; , unused len; if (!(flags.syntax & syntax_lfloat)) goto not_float_syntax; ); return read_complex_number_rest(flags,ptr_after_prec,string,string_limit,end_of_parse, read_float(float_base,prec,sign,ptr_after_sign,0,ptr_after_fracpart-ptr_after_sign,ptr_after_exponent-ptr_after_sign,ptr_before_fracpart-ptr_after_sign)); } not_float_syntax: if ((flags.syntax & syntax_complex) && (flags.lsyntax & lsyntax_commonlisp)) { // Check for complex number syntax: // '#' {'C'|'c'} '(' realpart {' '}+ imagpart ')' var const char * ptr = string; if (ptr == string_limit) goto not_complex_syntax; if (!(*ptr == '#')) goto not_complex_syntax; ptr++; if (ptr == string_limit) goto not_complex_syntax; if (!((*ptr == 'C') || (*ptr == 'c'))) goto not_complex_syntax; ptr++; // Modified flags for parsing the realpart and imagpart: var cl_read_flags flags_for_parts = flags; flags_for_parts.syntax = (cl_read_syntax_t)((flags_for_parts.syntax & ~syntax_complex) | syntax_maybe_bad); var const char * end_of_part; if (ptr == string_limit) goto not_complex_syntax; if (!(*ptr == '(')) goto not_complex_syntax; ptr++; var cl_R realpart = read_real(flags_for_parts,ptr,string_limit,&end_of_part); if (end_of_part == ptr) goto not_complex_syntax; ptr = end_of_part; if (ptr == string_limit) goto not_complex_syntax; if (!(*ptr == ' ')) goto not_complex_syntax; ptr++; while ((ptr != string_limit) && (*ptr == ' ')) { ptr++; } var cl_R imagpart = read_real(flags_for_parts,ptr,string_limit,&end_of_part); if (end_of_part == ptr) goto not_complex_syntax; ptr = end_of_part; if (ptr == string_limit) goto not_complex_syntax; if (!(*ptr == ')')) goto not_complex_syntax; ptr++; at_end_of_parse(ptr); return complex(realpart,imagpart); } not_complex_syntax: if (flags.syntax & syntax_maybe_bad) { ASSERT(end_of_parse); *end_of_parse = string; return 0; // dummy return } throw read_number_bad_syntax_exception(string,string_limit); } static const cl_N read_complex_number_rest (const cl_read_flags& flags, const char * string_rest, const char * string, const char * string_limit, const char * * end_of_parse, const cl_R& x) { unused string; if ((flags.syntax & syntax_complex) && (flags.lsyntax & lsyntax_algebraic)) { // Finish reading the "+yi" part of "x+yi". // We allow "y" to begin with a '-'. // We also allow the '+' to be replaced by '-', but in this case // "y" may not begin with a '-'. // We also allow the syntax "xi" (implicit realpart = 0). var const char * ptr = string_rest; if (ptr == string_limit) goto not_complex_syntax; if ((*ptr == 'i') || (*ptr == 'I')) { ptr++; at_end_of_parse(ptr); return complex(0,x); } switch (*ptr) { case '+': ptr++; case '-': break; default: goto not_complex_syntax; } // Modified flags for parsing the imagpart: var cl_read_flags flags_for_part = flags; flags_for_part.syntax = (cl_read_syntax_t)((flags_for_part.syntax & ~syntax_complex) | syntax_maybe_bad); var const char * end_of_part; var const cl_R& realpart = x; var cl_R imagpart = read_real(flags_for_part,ptr,string_limit,&end_of_part); if (end_of_part == ptr) goto not_complex_syntax; ptr = end_of_part; if (ptr == string_limit) goto not_complex_syntax; if (!((*ptr == 'i') || (*ptr == 'I'))) goto not_complex_syntax; ptr++; at_end_of_parse(ptr); return complex(realpart,imagpart); } not_complex_syntax: at_end_of_parse(string_rest); return x; } } // namespace cln