mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-03-11 07:20:29 -07:00
Code Issues Projects Releases Packages Wiki Activity

reader: move the general-purpose reader from read.d to reader.d

Browse source
This commit is contained in:
Daniel Kochmański 2026-03-01 20:51:00 +01:00
parent 8af28af3ef
commit a4504dc1a3
5 changed files with 381 additions and 373 deletions
Download patch file Download diff file Expand all files Collapse all files

2
src/c/Makefile.in
View file

@ -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 \

354
src/c/read.d
View file

@ -25,30 +25,8 @@
#include <ecl/ecl-inl.h>
#include <ecl/bytecodes.h>
#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.

360
src/c/reader.d Normal file
View file

@ -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 <ecl/ecl.h>
#include <ecl/number.h>
#include <assert.h> /* for assert() */
#include <stdio.h>
#include <limits.h>
#include <float.h>
#include <string.h>
#include <stdlib.h>
#include <ecl/internal.h>
#include <ecl/ecl-inl.h>
#include <ecl/bytecodes.h>
#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;
}

18
src/c/reader/rtab_cl.d
View file

@ -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)
{

20
src/h/internal.h
View file

@ -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