From a4504dc1a3f818bc83c4ecd466e691dd70c3f04a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Sun, 1 Mar 2026 20:51:00 +0100 Subject: [PATCH] reader: move the general-purpose reader from read.d to reader.d --- src/c/Makefile.in | 2 +- src/c/read.d | 354 ---------------------------------------- src/c/reader.d | 360 +++++++++++++++++++++++++++++++++++++++++ src/c/reader/rtab_cl.d | 18 --- src/h/internal.h | 20 +++ 5 files changed, 381 insertions(+), 373 deletions(-) create mode 100644 src/c/reader.d diff --git a/src/c/Makefile.in b/src/c/Makefile.in index 2b6881774..438913ce0 100644 --- a/src/c/Makefile.in +++ b/src/c/Makefile.in @@ -70,7 +70,7 @@ WRITER_OBJS = print.o printer/float_to_digits.o printer/float_to_string.o printer/write_list.o printer/write_code.o printer/write_sse.o \ printer/print_unreadable.o -READER_OBJS = readtable.o read.o \ +READER_OBJS = readtable.o reader.o read.o \ reader/rtab_cl.o reader/parse_integer.o reader/parse_number.o STREAM_OBJS = stream.o file.o streams/strm_os.o streams/strm_clos.o \ diff --git a/src/c/read.d b/src/c/read.d index 58aa2de1f..660bed163 100644 --- a/src/c/read.d +++ b/src/c/read.d @@ -25,30 +25,8 @@ #include #include -#undef _complex - -static cl_object dispatch_macro_character(cl_object table, cl_object strm, int c, bool signal_error); - #define read_suppress (ecl_symbol_value(@'*read-suppress*') != ECL_NIL) -#ifdef ECL_UNICODE -# define TOKEN_STRING_DIM(s) ((s)->string.dim) -# define TOKEN_STRING_FILLP(s) ((s)->string.fillp) -# define TOKEN_STRING_CHAR(s,n) ((s)->string.self[n]) -# define TOKEN_STRING_CHAR_SET(s,n,c) (s)->string.self[n]=(c) -# define TOKEN_STRING_CHAR_CMP(s,n,c) ((s)->string.self[n]==(c)) -#else -# define TOKEN_STRING_DIM(s) ((s)->base_string.dim) -# define TOKEN_STRING_FILLP(s) ((s)->base_string.fillp) -# define TOKEN_STRING_CHAR(s,n) ((s)->base_string.self[n]) -# define TOKEN_STRING_CHAR_SET(s,n,c) ((s)->base_string.self[n]=(c)) -# define TOKEN_STRING_CHAR_CMP(s,n,c) ((s)->base_string.self[n]==(c)) -#endif - -#define ECL_READ_ONLY_TOKEN 1 -#define ECL_READ_RETURN_IGNORABLE 3 -#define ECL_READ_LIST_DOT 4 - cl_object si_get_buffer_string() { @@ -102,55 +80,6 @@ si_put_buffer_string(cl_object string) @(return); } -/* - Returns OBJNULL if no dispatch function is defined and signal_error is false. - */ -static cl_object -dispatch_macro_character(cl_object table, cl_object in, int c, bool signal_error) -{ - cl_object arg; - int d; - c = ecl_read_char_noeof(in); - d = ecl_digitp(c, 10); - if (d >= 0) { - cl_fixnum i = 0; - do { - i = 10*i + d; - c = ecl_read_char_noeof(in); - d = ecl_digitp(c, 10); - } while (d >= 0); - arg = ecl_make_fixnum(i); - } else { - arg = ECL_NIL; - } - { - cl_object dc = ECL_CODE_CHAR(c); - cl_object fun = ecl_gethash_safe(dc, table, ECL_NIL); - unlikely_if (Null(fun)) { - if (signal_error) { - FEreader_error("No dispatch function defined " - "for character ~S", - in, 1, dc); - } else { - return OBJNULL; - } - } - return _ecl_funcall4(fun, in, dc, arg); - } -} - -cl_object -ecl_dispatch_reader_fun(cl_object in, cl_object dc) -{ - cl_object readtable = ecl_current_readtable(); - cl_object dispatch_table; - int c = ecl_char_code(dc); - ecl_readtable_get(readtable, c, &dispatch_table); - unlikely_if (!ECL_HASH_TABLE_P(dispatch_table)) - FEreader_error("~C is not a dispatching macro character", in, 1, dc); - return dispatch_macro_character(dispatch_table, in, c, TRUE); -} - static cl_object patch_sharp(const cl_env_ptr env, cl_object x); cl_object @@ -186,289 +115,6 @@ ecl_read_object_non_recursive(cl_object in) return x; } -/* - * This routine inverts the case of the characters in the buffer which - * were not escaped. ESCAPE_LIST is a list of intevals of characters - * that were escaped, as in ({(low-limit . high-limit)}*). The list - * goes from the last interval to the first one, in reverse order, - * and thus we run the buffer from the end to the beginning. - */ -static void -invert_buffer_case(cl_object x, cl_object escape_list, int sign) -{ - cl_fixnum high_limit, low_limit; - cl_fixnum i = TOKEN_STRING_FILLP(x)-1; - do { - if (escape_list != ECL_NIL) { - cl_object escape_interval = CAR(escape_list); - high_limit = ecl_fixnum(CAR(escape_interval)); - low_limit = ecl_fixnum(CDR(escape_interval)); - escape_list = CDR(escape_list); - } else { - high_limit = low_limit = -1; - } - for (; i > high_limit; i--) { - /* The character is not escaped */ - int c = TOKEN_STRING_CHAR(x,i); - if (ecl_upper_case_p(c) && (sign < 0)) { - c = ecl_char_downcase(c); - } else if (ecl_lower_case_p(c) && (sign > 0)) { - c = ecl_char_upcase(c); - } - TOKEN_STRING_CHAR_SET(x,i,c); - } - for (; i > low_limit; i--) { - /* The character is within an escaped interval */ - ; - } - } while (i >= 0); -} - -cl_object -ecl_read_object_with_delimiter(cl_object in, int delimiter, int flags, - enum ecl_chattrib a) -{ - cl_object x, token; - int c, base; - cl_object p; - cl_index length, i; - int colon, intern_flag; - bool external_symbol; - cl_env_ptr the_env = ecl_process_env(); - cl_object rtbl = ecl_current_readtable(); - enum ecl_readtable_case read_case = rtbl->readtable.read_case; - cl_object escape_list; /* intervals of escaped characters */ - cl_fixnum upcase; /* # uppercase characters - # downcase characters */ - cl_fixnum count; /* number of unescaped characters */ - bool suppress = read_suppress; - if (a != cat_constituent) { - c = 0; - goto LOOP; - } - BEGIN: - do { - c = ecl_read_char(in); - if (c == delimiter) { - the_env->nvalues = 0; - return OBJNULL; - } - if (c == EOF) - FEend_of_file(in); - a = ecl_readtable_get(rtbl, c, &x); - } while (a == cat_whitespace); - if ((a == cat_terminating || a == cat_non_terminating) && - (flags != ECL_READ_ONLY_TOKEN)) { - cl_object o; - if (ECL_HASH_TABLE_P(x)) { - if (suppress) { - o = dispatch_macro_character(x, in, c, FALSE); - if (o == OBJNULL) - goto BEGIN; - } else { - o = dispatch_macro_character(x, in, c, TRUE); - } - } else { - o = _ecl_funcall3(x, in, ECL_CODE_CHAR(c)); - } - if (the_env->nvalues == 0) { - if (flags == ECL_READ_RETURN_IGNORABLE) - return ECL_NIL; - goto BEGIN; - } - unlikely_if (the_env->nvalues > 1) { - FEerror("The readmacro ~S returned ~D values.", - 2, x, ecl_make_fixnum(the_env->nvalues)); - } - return o; - } - LOOP: - p = escape_list = ECL_NIL; - upcase = count = length = 0; - external_symbol = colon = 0; - token = si_get_buffer_string(); - for (;;) { - if (c == ':' && (flags != ECL_READ_ONLY_TOKEN) && - a == cat_constituent) { - colon++; - goto NEXT; - } - if (colon > 2) { - while (colon--) { - ecl_string_push_extend(token, ':'); - length++; - } - } else if (colon) { - external_symbol = (colon == 1); - TOKEN_STRING_CHAR_SET(token,length,'\0'); - /* If the readtable case was :INVERT and all non-escaped characters - * had the same case, we revert their case. */ - if (read_case == ecl_case_invert && count != 0) { - if (upcase == count) { - invert_buffer_case(token, escape_list, -1); - } else if (upcase == -count) { - invert_buffer_case(token, escape_list, +1); - } - } - if (length == 0) { - p = cl_core.keyword_package; - external_symbol = 0; - } else { - p = ecl_find_package_nolock(token); - } - if (Null(p) && !suppress) { - /* When loading binary files, we sometimes must create - symbols whose package has not yet been maked. We - allow it, but later on in ecl_init_module we make sure that - all referenced packages have been properly built. - */ - cl_object name = cl_copy_seq(token); - unlikely_if (Null(the_env->packages_to_be_created_p)) { - FEerror("There is no package with the name ~A.", 1, name); - } - p = _ecl_package_to_be_created(the_env, name); - } - TOKEN_STRING_FILLP(token) = length = 0; - upcase = count = colon = 0; - escape_list = ECL_NIL; - } - if (a == cat_single_escape) { - c = ecl_read_char_noeof(in); - a = cat_constituent; - if (read_case == ecl_case_invert) { - escape_list = CONS(CONS(ecl_make_fixnum(length), - ecl_make_fixnum(length-1)), - escape_list); - } else { - escape_list = ECL_T; - } - ecl_string_push_extend(token, c); - length++; - goto NEXT; - } - if (a == cat_multiple_escape) { - cl_index begin = length; - for (;;) { - c = ecl_read_char_noeof(in); - a = ecl_readtable_get(rtbl, c, NULL); - if (a == cat_single_escape) { - c = ecl_read_char_noeof(in); - a = cat_constituent; - } else if (a == cat_multiple_escape) - break; - ecl_string_push_extend(token, c); - length++; - } - if (read_case == ecl_case_invert) { - escape_list = CONS(CONS(ecl_make_fixnum(begin), - ecl_make_fixnum(length-1)), - escape_list); - } else { - escape_list = ECL_T; - } - goto NEXT; - } - if (a == cat_whitespace || a == cat_terminating) { - ecl_unread_char(c, in); - break; - } - unlikely_if (ecl_invalid_character_p(c) && !suppress) { - FEreader_error("Found invalid character ~:C", in, 1, ECL_CODE_CHAR(c)); - } - if (read_case != ecl_case_preserve) { - if (ecl_upper_case_p(c)) { - upcase++; - count++; - if (read_case == ecl_case_downcase) - c = ecl_char_downcase(c); - } else if (ecl_lower_case_p(c)) { - upcase--; - count++; - if (read_case == ecl_case_upcase) - c = ecl_char_upcase(c); - } - } - ecl_string_push_extend(token, c); - length++; - NEXT: - c = ecl_read_char(in); - if (c == EOF) - break; - a = ecl_readtable_get(rtbl, c, NULL); - } - - if (suppress) { - x = ECL_NIL; - goto OUTPUT; - } - - /* If there are some escaped characters, it must be a symbol */ - if ((flags == ECL_READ_ONLY_TOKEN) || p != ECL_NIL || - escape_list != ECL_NIL || length == 0) - goto SYMBOL; - - /* The case in which the buffer is full of dots has to be especial cased */ - if (length == 1 && TOKEN_STRING_CHAR_CMP(token,0,'.')) { - if (flags == ECL_READ_LIST_DOT) { - x = @'si::.'; - goto OUTPUT; - } else { - FEreader_error("Dots appeared illegally.", in, 0); - } - } else { - int i; - for (i = 0; i < length; i++) { - if (!TOKEN_STRING_CHAR_CMP(token,i,'.')) - goto MAYBE_NUMBER; - } - FEreader_error("Dots appeared illegally.", in, 0); - } - - MAYBE_NUMBER: - /* Here we try to parse a number from the content of the buffer */ - base = ecl_current_read_base(); - if ((base <= 10) && ecl_alpha_char_p(TOKEN_STRING_CHAR(token,0))) - goto SYMBOL; - x = ecl_parse_number(token, 0, TOKEN_STRING_FILLP(token), &i, base); - unlikely_if (x == ECL_NIL) - FEreader_error("Syntax error when reading number.~%Offending string: ~S.", - in, 1, token); - if (x != OBJNULL && length == i) - goto OUTPUT; - SYMBOL: - if (flags == ECL_READ_ONLY_TOKEN) { - the_env->nvalues = 1; - return token; - } - - /*TOKEN_STRING_CHAR_SET(token,length,'\0');*/ - /* If the readtable case was :INVERT and all non-escaped characters - * had the same case, we revert their case. */ - if (read_case == ecl_case_invert && count != 0) { - if (upcase == count) { - invert_buffer_case(token, escape_list, -1); - } else if (upcase == -count) { - invert_buffer_case(token, escape_list, +1); - } - } - if (external_symbol) { - x = ecl_find_symbol(token, p, &intern_flag); - unlikely_if (intern_flag != ECL_EXTERNAL) { - FEreader_error("Cannot find the external symbol ~A in ~S.", in, - 2, cl_copy_seq(token), p); - } - } else { - if (p == ECL_NIL) { - p = ecl_current_package(); - } - /* INV: cl_make_symbol() copies the string */ - x = ecl_intern(token, p, &intern_flag); - } - OUTPUT: - si_put_buffer_string(token); - the_env->nvalues = 1; - return x; -} - /* ecl_read_object(in) reads an object from stream in. This routine corresponds to COMMON Lisp function READ. diff --git a/src/c/reader.d b/src/c/reader.d new file mode 100644 index 000000000..0b0a8039f --- /dev/null +++ b/src/c/reader.d @@ -0,0 +1,360 @@ +/* -*- Mode: C; c-basic-offset: 2; indent-tabs-mode: nil -*- */ +/* vim: set filetype=c tabstop=2 shiftwidth=2 expandtab: */ + +/* + * read.d - reader + * + * Copyright (c) 1984 Taiichi Yuasa and Masami Hagiya + * Copyright (c) 1990 Giuseppe Attardi + * Copyright (c) 2001 Juan Jose Garcia Ripoll + * + * See file 'LICENSE' for the copyright details. + * + */ + +#define ECL_INCLUDE_MATH_H +#include +#include +#include /* for assert() */ +#include +#include +#include +#include +#include +#include +#include +#include + +#define read_suppress (ecl_symbol_value(@'*read-suppress*') != ECL_NIL) + +/* + * This routine inverts the case of the characters in the buffer which + * were not escaped. ESCAPE_LIST is a list of intevals of characters + * that were escaped, as in ({(low-limit . high-limit)}*). The list + * goes from the last interval to the first one, in reverse order, + * and thus we run the buffer from the end to the beginning. + */ +static void +invert_buffer_case(cl_object x, cl_object escape_list, int sign) +{ + cl_fixnum high_limit, low_limit; + cl_fixnum i = TOKEN_STRING_FILLP(x)-1; + do { + if (escape_list != ECL_NIL) { + cl_object escape_interval = CAR(escape_list); + high_limit = ecl_fixnum(CAR(escape_interval)); + low_limit = ecl_fixnum(CDR(escape_interval)); + escape_list = CDR(escape_list); + } else { + high_limit = low_limit = -1; + } + for (; i > high_limit; i--) { + /* The character is not escaped */ + int c = TOKEN_STRING_CHAR(x,i); + if (ecl_upper_case_p(c) && (sign < 0)) { + c = ecl_char_downcase(c); + } else if (ecl_lower_case_p(c) && (sign > 0)) { + c = ecl_char_upcase(c); + } + TOKEN_STRING_CHAR_SET(x,i,c); + } + for (; i > low_limit; i--) { + /* The character is within an escaped interval */ + ; + } + } while (i >= 0); +} + +/* + Returns OBJNULL if no dispatch function is defined and signal_error is false. + */ +static cl_object +dispatch_macro_character(cl_object table, cl_object in, int c, bool signal_error) +{ + cl_object arg; + int d; + c = ecl_read_char_noeof(in); + d = ecl_digitp(c, 10); + if (d >= 0) { + cl_fixnum i = 0; + do { + i = 10*i + d; + c = ecl_read_char_noeof(in); + d = ecl_digitp(c, 10); + } while (d >= 0); + arg = ecl_make_fixnum(i); + } else { + arg = ECL_NIL; + } + { + cl_object dc = ECL_CODE_CHAR(c); + cl_object fun = ecl_gethash_safe(dc, table, ECL_NIL); + unlikely_if (Null(fun)) { + if (signal_error) { + FEreader_error("No dispatch function defined " + "for character ~S", + in, 1, dc); + } else { + return OBJNULL; + } + } + return _ecl_funcall4(fun, in, dc, arg); + } +} + +cl_object +ecl_dispatch_reader_fun(cl_object in, cl_object dc) +{ + cl_object readtable = ecl_current_readtable(); + cl_object dispatch_table; + int c = ecl_char_code(dc); + ecl_readtable_get(readtable, c, &dispatch_table); + unlikely_if (!ECL_HASH_TABLE_P(dispatch_table)) + FEreader_error("~C is not a dispatching macro character", in, 1, dc); + return dispatch_macro_character(dispatch_table, in, c, TRUE); +} + +cl_object +ecl_read_object_with_delimiter(cl_object in, int delimiter, int flags, + enum ecl_chattrib a) +{ + cl_object x, token; + int c, base; + cl_object p; + cl_index length, i; + int colon, intern_flag; + bool external_symbol; + cl_env_ptr the_env = ecl_process_env(); + cl_object rtbl = ecl_current_readtable(); + enum ecl_readtable_case read_case = rtbl->readtable.read_case; + cl_object escape_list; /* intervals of escaped characters */ + cl_fixnum upcase; /* # uppercase characters - # downcase characters */ + cl_fixnum count; /* number of unescaped characters */ + bool suppress = read_suppress; + if (a != cat_constituent) { + c = 0; + goto LOOP; + } + BEGIN: + do { + c = ecl_read_char(in); + if (c == delimiter) { + the_env->nvalues = 0; + return OBJNULL; + } + if (c == EOF) + FEend_of_file(in); + a = ecl_readtable_get(rtbl, c, &x); + } while (a == cat_whitespace); + if ((a == cat_terminating || a == cat_non_terminating) && + (flags != ECL_READ_ONLY_TOKEN)) { + cl_object o; + if (ECL_HASH_TABLE_P(x)) { + if (suppress) { + o = dispatch_macro_character(x, in, c, FALSE); + if (o == OBJNULL) + goto BEGIN; + } else { + o = dispatch_macro_character(x, in, c, TRUE); + } + } else { + o = _ecl_funcall3(x, in, ECL_CODE_CHAR(c)); + } + if (the_env->nvalues == 0) { + if (flags == ECL_READ_RETURN_IGNORABLE) + return ECL_NIL; + goto BEGIN; + } + unlikely_if (the_env->nvalues > 1) { + FEerror("The readmacro ~S returned ~D values.", + 2, x, ecl_make_fixnum(the_env->nvalues)); + } + return o; + } + LOOP: + p = escape_list = ECL_NIL; + upcase = count = length = 0; + external_symbol = colon = 0; + token = si_get_buffer_string(); + for (;;) { + if (c == ':' && (flags != ECL_READ_ONLY_TOKEN) && + a == cat_constituent) { + colon++; + goto NEXT; + } + if (colon > 2) { + while (colon--) { + ecl_string_push_extend(token, ':'); + length++; + } + } else if (colon) { + external_symbol = (colon == 1); + TOKEN_STRING_CHAR_SET(token,length,'\0'); + /* If the readtable case was :INVERT and all non-escaped characters + * had the same case, we revert their case. */ + if (read_case == ecl_case_invert && count != 0) { + if (upcase == count) { + invert_buffer_case(token, escape_list, -1); + } else if (upcase == -count) { + invert_buffer_case(token, escape_list, +1); + } + } + if (length == 0) { + p = cl_core.keyword_package; + external_symbol = 0; + } else { + p = ecl_find_package_nolock(token); + } + if (Null(p) && !suppress) { + /* When loading binary files, we sometimes must create + symbols whose package has not yet been maked. We + allow it, but later on in ecl_init_module we make sure that + all referenced packages have been properly built. + */ + cl_object name = cl_copy_seq(token); + unlikely_if (Null(the_env->packages_to_be_created_p)) { + FEerror("There is no package with the name ~A.", 1, name); + } + p = _ecl_package_to_be_created(the_env, name); + } + TOKEN_STRING_FILLP(token) = length = 0; + upcase = count = colon = 0; + escape_list = ECL_NIL; + } + if (a == cat_single_escape) { + c = ecl_read_char_noeof(in); + a = cat_constituent; + if (read_case == ecl_case_invert) { + escape_list = CONS(CONS(ecl_make_fixnum(length), + ecl_make_fixnum(length-1)), + escape_list); + } else { + escape_list = ECL_T; + } + ecl_string_push_extend(token, c); + length++; + goto NEXT; + } + if (a == cat_multiple_escape) { + cl_index begin = length; + for (;;) { + c = ecl_read_char_noeof(in); + a = ecl_readtable_get(rtbl, c, NULL); + if (a == cat_single_escape) { + c = ecl_read_char_noeof(in); + a = cat_constituent; + } else if (a == cat_multiple_escape) + break; + ecl_string_push_extend(token, c); + length++; + } + if (read_case == ecl_case_invert) { + escape_list = CONS(CONS(ecl_make_fixnum(begin), + ecl_make_fixnum(length-1)), + escape_list); + } else { + escape_list = ECL_T; + } + goto NEXT; + } + if (a == cat_whitespace || a == cat_terminating) { + ecl_unread_char(c, in); + break; + } + unlikely_if (ecl_invalid_character_p(c) && !suppress) { + FEreader_error("Found invalid character ~:C", in, 1, ECL_CODE_CHAR(c)); + } + if (read_case != ecl_case_preserve) { + if (ecl_upper_case_p(c)) { + upcase++; + count++; + if (read_case == ecl_case_downcase) + c = ecl_char_downcase(c); + } else if (ecl_lower_case_p(c)) { + upcase--; + count++; + if (read_case == ecl_case_upcase) + c = ecl_char_upcase(c); + } + } + ecl_string_push_extend(token, c); + length++; + NEXT: + c = ecl_read_char(in); + if (c == EOF) + break; + a = ecl_readtable_get(rtbl, c, NULL); + } + + if (suppress) { + x = ECL_NIL; + goto OUTPUT; + } + + /* If there are some escaped characters, it must be a symbol */ + if ((flags == ECL_READ_ONLY_TOKEN) || p != ECL_NIL || + escape_list != ECL_NIL || length == 0) + goto SYMBOL; + + /* The case in which the buffer is full of dots has to be especial cased */ + if (length == 1 && TOKEN_STRING_CHAR_CMP(token,0,'.')) { + if (flags == ECL_READ_LIST_DOT) { + x = @'si::.'; + goto OUTPUT; + } else { + FEreader_error("Dots appeared illegally.", in, 0); + } + } else { + int i; + for (i = 0; i < length; i++) { + if (!TOKEN_STRING_CHAR_CMP(token,i,'.')) + goto MAYBE_NUMBER; + } + FEreader_error("Dots appeared illegally.", in, 0); + } + + MAYBE_NUMBER: + /* Here we try to parse a number from the content of the buffer */ + base = ecl_current_read_base(); + if ((base <= 10) && ecl_alpha_char_p(TOKEN_STRING_CHAR(token,0))) + goto SYMBOL; + x = ecl_parse_number(token, 0, TOKEN_STRING_FILLP(token), &i, base); + unlikely_if (x == ECL_NIL) + FEreader_error("Syntax error when reading number.~%Offending string: ~S.", + in, 1, token); + if (x != OBJNULL && length == i) + goto OUTPUT; + SYMBOL: + if (flags == ECL_READ_ONLY_TOKEN) { + the_env->nvalues = 1; + return token; + } + + /*TOKEN_STRING_CHAR_SET(token,length,'\0');*/ + /* If the readtable case was :INVERT and all non-escaped characters + * had the same case, we revert their case. */ + if (read_case == ecl_case_invert && count != 0) { + if (upcase == count) { + invert_buffer_case(token, escape_list, -1); + } else if (upcase == -count) { + invert_buffer_case(token, escape_list, +1); + } + } + if (external_symbol) { + x = ecl_find_symbol(token, p, &intern_flag); + unlikely_if (intern_flag != ECL_EXTERNAL) { + FEreader_error("Cannot find the external symbol ~A in ~S.", in, + 2, cl_copy_seq(token), p); + } + } else { + if (p == ECL_NIL) { + p = ecl_current_package(); + } + /* INV: cl_make_symbol() copies the string */ + x = ecl_intern(token, p, &intern_flag); + } + OUTPUT: + si_put_buffer_string(token); + the_env->nvalues = 1; + return x; +} diff --git a/src/c/reader/rtab_cl.d b/src/c/reader/rtab_cl.d index f90abda7d..d49cc99e5 100644 --- a/src/c/reader/rtab_cl.d +++ b/src/c/reader/rtab_cl.d @@ -20,24 +20,6 @@ #define read_suppress (ecl_symbol_value(@'*read-suppress*') != ECL_NIL) -#ifdef ECL_UNICODE -# define TOKEN_STRING_DIM(s) ((s)->string.dim) -# define TOKEN_STRING_FILLP(s) ((s)->string.fillp) -# define TOKEN_STRING_CHAR(s,n) ((s)->string.self[n]) -# define TOKEN_STRING_CHAR_SET(s,n,c) (s)->string.self[n]=(c) -# define TOKEN_STRING_CHAR_CMP(s,n,c) ((s)->string.self[n]==(c)) -#else -# define TOKEN_STRING_DIM(s) ((s)->base_string.dim) -# define TOKEN_STRING_FILLP(s) ((s)->base_string.fillp) -# define TOKEN_STRING_CHAR(s,n) ((s)->base_string.self[n]) -# define TOKEN_STRING_CHAR_SET(s,n,c) ((s)->base_string.self[n]=(c)) -# define TOKEN_STRING_CHAR_CMP(s,n,c) ((s)->base_string.self[n]==(c)) -#endif - -#define ECL_READ_ONLY_TOKEN 1 -#define ECL_READ_RETURN_IGNORABLE 3 -#define ECL_READ_LIST_DOT 4 - static cl_object right_parenthesis_reader(cl_object in, cl_object character) { diff --git a/src/h/internal.h b/src/h/internal.h index 62cfeac56..9992e5737 100755 --- a/src/h/internal.h +++ b/src/h/internal.h @@ -560,6 +560,26 @@ write_char_increment_column(cl_object strm, ecl_character c) extern cl_object ecl_off_t_to_integer(ecl_off_t offset); extern ecl_off_t ecl_integer_to_off_t(cl_object offset); +/* read.d */ + +#ifdef ECL_UNICODE +# define TOKEN_STRING_DIM(s) ((s)->string.dim) +# define TOKEN_STRING_FILLP(s) ((s)->string.fillp) +# define TOKEN_STRING_CHAR(s,n) ((s)->string.self[n]) +# define TOKEN_STRING_CHAR_SET(s,n,c) (s)->string.self[n]=(c) +# define TOKEN_STRING_CHAR_CMP(s,n,c) ((s)->string.self[n]==(c)) +#else +# define TOKEN_STRING_DIM(s) ((s)->base_string.dim) +# define TOKEN_STRING_FILLP(s) ((s)->base_string.fillp) +# define TOKEN_STRING_CHAR(s,n) ((s)->base_string.self[n]) +# define TOKEN_STRING_CHAR_SET(s,n,c) ((s)->base_string.self[n]=(c)) +# define TOKEN_STRING_CHAR_CMP(s,n,c) ((s)->base_string.self[n]==(c)) +#endif + +#define ECL_READ_ONLY_TOKEN 1 +#define ECL_READ_RETURN_IGNORABLE 3 +#define ECL_READ_LIST_DOT 4 + /* format.d */ #ifndef ECL_CMU_FORMAT