mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-01-02 07:30:55 -08:00
New package GRAY for Gray Streams. CLOSE, STREAMP, STREAM-ELEMENT-TYPE, {OPEN,INPUT,OUTPUT}-STREAM-P defined as generic functions in that package. SHADOWING-IMPORT sets the package of an imported symbol
This commit is contained in:
jgarcia
parent
bc7e1e8f49
commit
190a9489dc
13 changed files with 196 additions and 138 deletions
|
|
@ -55,6 +55,19 @@ ECL 0.9k:
|
|||
|
||||
- Ported CMUCL's profiler as a contributed package.
|
||||
|
||||
- Gray streams are now implemented in a separate package, called GRAY, which
|
||||
exports symbols such as FUNDAMENTAL-STREAM or STREAM-READ-CHAR.
|
||||
|
||||
- The functions CLOSE, {OPEN,INPUT,OUTPUT}-STREAM-P, STREAM-P and
|
||||
STREAM-ELEMENT-TYPE are now offered in two flavors. The versions exported by
|
||||
the COMMON-LISP package are ordinary functions, the versions in the GRAY
|
||||
package are generic functions that can be specialized to new classes. The
|
||||
ordinary functions will invoke the generic version when passed a generic
|
||||
stream. Note that, for instance, CL:CLOSE and GRAY:CLOSE are not the same
|
||||
symbol. This means you might need to shadow-import the symbols associated to
|
||||
generic versions in the packages where methods on these functions are
|
||||
defined.
|
||||
|
||||
* CLOS:
|
||||
|
||||
- When caching generic function calls, ECL now uses a thread-local hash table
|
||||
|
|
|
|||
|
|
@ -7,6 +7,7 @@
|
|||
#define CL_PACKAGE 0
|
||||
#define SI_PACKAGE 4
|
||||
#define EXT_PACKAGE SI_PACKAGE
|
||||
#define GRAY_PACKAGE 32
|
||||
#define KEYWORD_PACKAGE 8
|
||||
#define MP_PACKAGE 12
|
||||
#define CLOS_PACKAGE 16
|
||||
|
|
@ -32,6 +33,7 @@
|
|||
#define CLOS_ORDINARY CLOS_PACKAGE | ORDINARY_SYMBOL
|
||||
#define CLOS_SPECIAL CLOS_PACKAGE | SPECIAL_SYMBOL
|
||||
#define KEYWORD KEYWORD_PACKAGE | CONSTANT_SYMBOL
|
||||
#define GRAY_ORDINARY GRAY_PACKAGE | ORDINARY_SYMBOL
|
||||
|
||||
#include "symbols_list.h"
|
||||
|
||||
|
|
@ -176,7 +178,7 @@ make_this_symbol(int i, cl_object s, int code, const char *name,
|
|||
case CONSTANT_SYMBOL: stp = stp_constant; break;
|
||||
case FORM_SYMBOL: form = 1; stp = stp_ordinary;
|
||||
}
|
||||
switch (code & 28) {
|
||||
switch (code & ~(int)3) {
|
||||
case CL_PACKAGE: package = cl_core.lisp_package; break;
|
||||
case SI_PACKAGE: package = cl_core.system_package; break;
|
||||
case KEYWORD_PACKAGE: package = cl_core.keyword_package; break;
|
||||
|
|
@ -185,6 +187,9 @@ make_this_symbol(int i, cl_object s, int code, const char *name,
|
|||
#endif
|
||||
#ifdef CLOS
|
||||
case CLOS_PACKAGE: package = cl_core.clos_package; break;
|
||||
#endif
|
||||
#ifdef ECL_CLOS_STREAMS
|
||||
case GRAY_PACKAGE: package = cl_core.gray_package; break;
|
||||
#endif
|
||||
}
|
||||
s->symbol.t = t_symbol;
|
||||
|
|
@ -203,8 +208,14 @@ make_this_symbol(int i, cl_object s, int code, const char *name,
|
|||
ecl_sethash(s->symbol.name, package->pack.external, s);
|
||||
ECL_SET(s, s);
|
||||
} else {
|
||||
int intern_flag;
|
||||
ECL_SET(s, value);
|
||||
cl_import2(s, package);
|
||||
if (ecl_find_symbol(s->symbol.name, package, &intern_flag) != Cnil
|
||||
&& intern_flag == INHERITED) {
|
||||
ecl_shadowing_import(s, package);
|
||||
} else {
|
||||
cl_import2(s, package);
|
||||
}
|
||||
cl_export2(s, package);
|
||||
}
|
||||
if (!(s->symbol.isform = form) && fun) {
|
||||
|
|
|
|||
37
src/c/file.d
37
src/c/file.d
|
|
@ -87,7 +87,7 @@ ecl_input_stream_p(cl_object strm)
|
|||
BEGIN:
|
||||
#ifdef ECL_CLOS_STREAMS
|
||||
if (type_of(strm) == t_instance)
|
||||
return !Null(funcall(2, @'ext::stream-input-p', strm));
|
||||
return !Null(funcall(2, @'gray::input-stream-p', strm));
|
||||
#endif
|
||||
if (type_of(strm) != t_stream)
|
||||
FEtype_error_stream(strm);
|
||||
|
|
@ -135,7 +135,7 @@ ecl_output_stream_p(cl_object strm)
|
|||
BEGIN:
|
||||
#ifdef ECL_CLOS_STREAMS
|
||||
if (type_of(strm) == t_instance)
|
||||
return !Null(funcall(2, @'ext::stream-output-p', strm));
|
||||
return !Null(funcall(2, @'gray::output-stream-p', strm));
|
||||
#endif
|
||||
if (type_of(strm) != t_stream)
|
||||
FEtype_error_stream(strm);
|
||||
|
|
@ -185,7 +185,7 @@ cl_stream_element_type(cl_object strm)
|
|||
BEGIN:
|
||||
#ifdef ECL_CLOS_STREAMS
|
||||
if (type_of(strm) == t_instance)
|
||||
return funcall(2, @'ext::stream-elt-type', strm);
|
||||
return funcall(2, @'gray::stream-element-type', strm);
|
||||
#endif
|
||||
if (type_of(strm) != t_stream)
|
||||
FEtype_error_stream(strm);
|
||||
|
|
@ -516,7 +516,7 @@ static void flush_output_stream_binary(cl_object strm);
|
|||
@
|
||||
#ifdef ECL_CLOS_STREAMS
|
||||
if (type_of(strm) == t_instance) {
|
||||
return funcall(2, @'ext::stream-close', strm);
|
||||
return funcall(2, @'gray::close', strm);
|
||||
}
|
||||
#endif
|
||||
if (type_of(strm) != t_stream)
|
||||
|
|
@ -675,7 +675,7 @@ ecl_write_byte(cl_object c, cl_object strm)
|
|||
BEGIN:
|
||||
#ifdef ECL_CLOS_STREAMS
|
||||
if (type_of(strm) == t_instance) {
|
||||
funcall(3, @'ext::stream-write-byte', strm, c);
|
||||
funcall(3, @'gray::stream-write-byte', strm, c);
|
||||
return;
|
||||
}
|
||||
#endif
|
||||
|
|
@ -922,7 +922,7 @@ ecl_read_byte(cl_object strm)
|
|||
BEGIN:
|
||||
#ifdef ECL_CLOS_STREAMS
|
||||
if (type_of(strm) == t_instance) {
|
||||
return funcall(2, @'ext::stream-read-byte', strm);
|
||||
return funcall(2, @'gray::stream-read-byte', strm);
|
||||
}
|
||||
#endif
|
||||
if (type_of(strm) != t_stream)
|
||||
|
|
@ -1060,7 +1060,7 @@ ecl_read_char(cl_object strm)
|
|||
BEGIN:
|
||||
#ifdef ECL_CLOS_STREAMS
|
||||
if (type_of(strm) == t_instance) {
|
||||
cl_object c = funcall(2, @'ext::stream-read-char', strm);
|
||||
cl_object c = funcall(2, @'gray::stream-read-char', strm);
|
||||
return CHARACTERP(c)? CHAR_CODE(c) : EOF;
|
||||
}
|
||||
#endif
|
||||
|
|
@ -1176,7 +1176,7 @@ ecl_peek_char(cl_object strm)
|
|||
BEGIN:
|
||||
#ifdef ECL_CLOS_STREAMS
|
||||
if (type_of(strm) == t_instance) {
|
||||
cl_object c = funcall(2, @'ext::stream-peek-char', strm);
|
||||
cl_object c = funcall(2, @'gray::stream-peek-char', strm);
|
||||
return CHARACTERP(c)? CHAR_CODE(c) : EOF;
|
||||
}
|
||||
#endif
|
||||
|
|
@ -1285,7 +1285,7 @@ ecl_unread_char(int c, cl_object strm)
|
|||
BEGIN:
|
||||
#ifdef ECL_CLOS_STREAMS
|
||||
if (type_of(strm) == t_instance) {
|
||||
funcall(3, @'ext::stream-unread-char', strm, CODE_CHAR(c));
|
||||
funcall(3, @'gray::stream-unread-char', strm, CODE_CHAR(c));
|
||||
return;
|
||||
}
|
||||
#endif
|
||||
|
|
@ -1369,7 +1369,7 @@ ecl_write_char(int c, cl_object strm)
|
|||
BEGIN:
|
||||
#ifdef ECL_CLOS_STREAMS
|
||||
if (type_of(strm) == t_instance) {
|
||||
funcall(3, @'ext::stream-write-char', strm, CODE_CHAR(c));
|
||||
funcall(3, @'gray::stream-write-char', strm, CODE_CHAR(c));
|
||||
return c;
|
||||
}
|
||||
#endif
|
||||
|
|
@ -1650,7 +1650,7 @@ ecl_force_output(cl_object strm)
|
|||
BEGIN:
|
||||
#ifdef ECL_CLOS_STREAMS
|
||||
if (type_of(strm) == t_instance) {
|
||||
funcall(2, @'ext::stream-force-output', strm);
|
||||
funcall(2, @'gray::stream-force-output', strm);
|
||||
return;
|
||||
}
|
||||
#endif
|
||||
|
|
@ -1717,7 +1717,7 @@ ecl_clear_input(cl_object strm)
|
|||
BEGIN:
|
||||
#ifdef ECL_CLOS_STREAMS
|
||||
if (type_of(strm) == t_instance) {
|
||||
funcall(2, @'ext::stream-clear-input', strm);
|
||||
funcall(2, @'gray::stream-clear-input', strm);
|
||||
return;
|
||||
}
|
||||
#endif
|
||||
|
|
@ -1791,7 +1791,7 @@ ecl_clear_output(cl_object strm)
|
|||
BEGIN:
|
||||
#ifdef ECL_CLOS_STREAMS
|
||||
if (type_of(strm) == t_instance) {
|
||||
funcall(2, @'ext::stream-clear-output',strm);
|
||||
funcall(2, @'gray::stream-clear-output',strm);
|
||||
return;
|
||||
}
|
||||
#endif
|
||||
|
|
@ -1954,7 +1954,7 @@ ecl_listen_stream(cl_object strm)
|
|||
BEGIN:
|
||||
#ifdef ECL_CLOS_STREAMS
|
||||
if (type_of(strm) == t_instance) {
|
||||
cl_object flag = funcall(2, @'ext::stream-listen', strm);
|
||||
cl_object flag = funcall(2, @'gray::stream-listen', strm);
|
||||
return !(flag == Cnil);
|
||||
}
|
||||
#endif
|
||||
|
|
@ -2310,7 +2310,7 @@ ecl_file_column(cl_object strm)
|
|||
BEGIN:
|
||||
#ifdef ECL_CLOS_STREAMS
|
||||
if (type_of(strm) == t_instance) {
|
||||
cl_object col = funcall(2, @'ext::stream-line-column', strm);
|
||||
cl_object col = funcall(2, @'gray::stream-line-column', strm);
|
||||
/* FIXME! The Gray streams specifies NIL is a valid
|
||||
* value but means "unknown". Should we make it
|
||||
* zero? */
|
||||
|
|
@ -2565,10 +2565,7 @@ cl_streamp(cl_object strm)
|
|||
{
|
||||
#ifdef ECL_CLOS_STREAMS
|
||||
if (type_of(strm) == t_instance) {
|
||||
cl_object this_class = CLASS_OF(strm);
|
||||
cl_object stream_class = cl_find_class(1, @'stream');
|
||||
cl_object test = funcall(3, @'si::subclassp', this_class, stream_class);
|
||||
@(return (Null(test)? Cnil : Ct))
|
||||
return funcall(2, @'gray::streamp', strm);
|
||||
}
|
||||
#endif
|
||||
@(return ((type_of(strm) == t_stream) ? Ct : Cnil))
|
||||
|
|
@ -2787,7 +2784,7 @@ cl_interactive_stream_p(cl_object strm)
|
|||
t = type_of(strm);
|
||||
#ifdef ECL_CLOS_STREAMS
|
||||
if (t == t_instance)
|
||||
return funcall(2, @'ext::stream-interactive-p', strm);
|
||||
return funcall(2, @'gray::stream-interactive-p', strm);
|
||||
#endif
|
||||
if (t != t_stream)
|
||||
FEtype_error_stream(strm);
|
||||
|
|
|
|||
|
|
@ -268,6 +268,11 @@ cl_boot(int argc, char **argv)
|
|||
CONS(make_constant_base_string("MULTIPROCESSING"), Cnil),
|
||||
CONS(cl_core.lisp_package, Cnil));
|
||||
#endif
|
||||
#ifdef ECL_CLOS_STREAMS
|
||||
cl_core.gray_package = ecl_make_package(make_constant_base_string("GRAY"),
|
||||
Cnil,
|
||||
CONS(cl_core.lisp_package, Cnil));
|
||||
#endif
|
||||
|
||||
Cnil->symbol.hpack = cl_core.lisp_package;
|
||||
cl_import2(Cnil, cl_core.lisp_package);
|
||||
|
|
|
|||
|
|
@ -652,6 +652,8 @@ ecl_shadowing_import(cl_object s, cl_object p)
|
|||
}
|
||||
p->pack.shadowings = CONS(s, p->pack.shadowings);
|
||||
ecl_sethash(s->symbol.name, p->pack.internal, s);
|
||||
if (Null(s->symbol.hpack))
|
||||
s->symbol.hpack = p;
|
||||
OUTPUT:
|
||||
PACKAGE_UNLOCK(p);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1846,7 +1846,7 @@ potential_number_p(cl_object strng, int base)
|
|||
strm = stream_or_default_output(strm);
|
||||
#ifdef ECL_CLOS_STREAMS
|
||||
if (type_of(strm) != t_stream)
|
||||
funcall(5, @'ext::stream-write-string', strm, strng, start, end);
|
||||
funcall(5, @'gray::stream-write-string', strm, strng, start, end);
|
||||
else
|
||||
#endif
|
||||
si_do_write_sequence(strng, strm, start, end);
|
||||
|
|
@ -1874,7 +1874,7 @@ potential_number_p(cl_object strng, int base)
|
|||
strm = stream_or_default_output(strm);
|
||||
#ifdef ECL_CLOS_STREAMS
|
||||
if (type_of(strm) != t_stream) {
|
||||
return funcall(2, @'ext::stream-fresh-line', strm);
|
||||
return funcall(2, @'gray::stream-fresh-line', strm);
|
||||
}
|
||||
#endif
|
||||
if (ecl_file_column(strm) == 0)
|
||||
|
|
@ -1889,7 +1889,7 @@ potential_number_p(cl_object strng, int base)
|
|||
strm = stream_or_default_output(strm);
|
||||
#ifdef ECL_CLOS_STREAMS
|
||||
if (type_of(strm) != t_stream) {
|
||||
return funcall(2, @'ext::stream-finish-output', strm);
|
||||
return funcall(2, @'gray::stream-finish-output', strm);
|
||||
}
|
||||
#endif
|
||||
ecl_force_output(strm);
|
||||
|
|
@ -1921,7 +1921,7 @@ cl_write_byte(cl_object integer, cl_object binary_output_stream)
|
|||
@
|
||||
#ifdef ECL_CLOS_STREAMS
|
||||
if (type_of(stream) != t_stream)
|
||||
return funcall(5, @'ext::stream-write-sequence', stream, sequence, start, end);
|
||||
return funcall(5, @'gray::stream-write-sequence', stream, sequence, start, end);
|
||||
else
|
||||
#endif
|
||||
return si_do_write_sequence(sequence, stream, start, end);
|
||||
|
|
@ -1965,7 +1965,7 @@ ecl_terpri(cl_object strm)
|
|||
strm = stream_or_default_output(strm);
|
||||
#ifdef ECL_CLOS_STREAMS
|
||||
if (type_of(strm) != t_stream) {
|
||||
return funcall(2, @'ext::stream-terpri', strm);
|
||||
return funcall(2, @'gray::stream-terpri', strm);
|
||||
}
|
||||
#endif
|
||||
ecl_write_char('\n', strm);
|
||||
|
|
|
|||
|
|
@ -1503,7 +1503,7 @@ do_read_delimited_list(int d, cl_object in, bool proper_list)
|
|||
strm = stream_or_default_input(strm);
|
||||
#ifdef ECL_CLOS_STREAMS
|
||||
if (type_of(strm) != t_stream) {
|
||||
return funcall(2, @'ext::stream-read-line', strm);
|
||||
return funcall(2, @'gray::stream-read-line', strm);
|
||||
}
|
||||
#endif
|
||||
token = si_get_buffer_string();
|
||||
|
|
@ -1607,7 +1607,7 @@ do_read_delimited_list(int d, cl_object in, bool proper_list)
|
|||
strm = stream_or_default_input(strm);
|
||||
#ifdef ECL_CLOS_STREAMS
|
||||
if (type_of(strm) != t_stream) {
|
||||
cl_object output = funcall(2,@'ext::stream-read-char-no-hang', strm);
|
||||
cl_object output = funcall(2,@'gray::stream-read-char-no-hang', strm);
|
||||
if (output == @':eof')
|
||||
goto END_OF_FILE;
|
||||
@(return output);
|
||||
|
|
@ -1700,7 +1700,7 @@ CANNOT_PARSE: FEparse_error("Cannot parse an integer in the string ~S.",
|
|||
@
|
||||
#ifdef ECL_CLOS_STREAMS
|
||||
if (type_of(stream) != t_stream)
|
||||
return funcall(5, @'ext::stream-read-sequence', stream, sequence, start, end);
|
||||
return funcall(5, @'gray::stream-read-sequence', stream, sequence, start, end);
|
||||
else
|
||||
#endif
|
||||
return si_do_read_sequence(sequence, stream, start, end);
|
||||
|
|
|
|||
|
|
@ -15,6 +15,7 @@
|
|||
#define SYS_ "SI::"
|
||||
#define MP_ "MP::"
|
||||
#define KEY_ ":"
|
||||
#define GRAY_ "GRAY::"
|
||||
struct {
|
||||
const char *name, *translation;
|
||||
}
|
||||
|
|
@ -24,6 +25,7 @@ struct {
|
|||
#define SYS_
|
||||
#define MP_
|
||||
#define KEY_
|
||||
#define GRAY_
|
||||
cl_symbol_initializer
|
||||
#endif
|
||||
cl_symbols[] = {
|
||||
|
|
@ -1225,43 +1227,6 @@ cl_symbols[] = {
|
|||
{SYS_ "*PROFILE-ARRAY*", SI_SPECIAL, NULL, -1, OBJNULL},
|
||||
#endif
|
||||
|
||||
#ifdef ECL_CLOS_STREAMS
|
||||
#ifdef ECL_GRAY_STREAMS
|
||||
{EXT_ "ANSI-STREAM-CLOSE", EXT_ORDINARY, si_ansi_stream_close, -1, OBJNULL},
|
||||
{EXT_ "ANSI-STREAM-ELEMENT-TYPE", EXT_ORDINARY, si_ansi_stream_element_type, 1, OBJNULL},
|
||||
{EXT_ "ANSI-STREAM-INPUT-STREAM-P", EXT_ORDINARY, si_ansi_stream_input_stream_p, 1, OBJNULL},
|
||||
{EXT_ "ANSI-STREAM-OUTPUT-STREAM-P", EXT_ORDINARY, si_ansi_stream_output_stream_p, 1, OBJNULL},
|
||||
{EXT_ "ANSI-STREAM-OPEN-STREAM-P", EXT_ORDINARY, si_ansi_stream_open_stream_p, 1, OBJNULL},
|
||||
#else
|
||||
{EXT_ "STREAM-CLOSE", EXT_ORDINARY, NULL, -1, OBJNULL},
|
||||
{EXT_ "STREAM-ELT-TYPE", EXT_ORDINARY, NULL, 1, OBJNULL},
|
||||
{EXT_ "STREAM-INPUT-P", EXT_ORDINARY, NULL, 1, OBJNULL},
|
||||
{EXT_ "STREAM-OUTPUT-P", EXT_ORDINARY, NULL, 1, OBJNULL},
|
||||
{EXT_ "STREAM-OPEN-P", EXT_ORDINARY, NULL, 1, OBJNULL},
|
||||
#endif
|
||||
{EXT_ "STREAM-CLEAR-INPUT", EXT_ORDINARY, NULL, -1, OBJNULL},
|
||||
{EXT_ "STREAM-CLEAR-OUTPUT", EXT_ORDINARY, NULL, -1, OBJNULL},
|
||||
{EXT_ "STREAM-FINISH-OUTPUT", EXT_ORDINARY, NULL, -1, OBJNULL},
|
||||
{EXT_ "STREAM-FORCE-OUTPUT", EXT_ORDINARY, NULL, -1, OBJNULL},
|
||||
{EXT_ "STREAM-FRESH-LINE", EXT_ORDINARY, NULL, -1, OBJNULL},
|
||||
{EXT_ "STREAM-INTERACTIVE-P", EXT_ORDINARY, NULL, -1, OBJNULL},
|
||||
{EXT_ "STREAM-LINE-COLUMN", EXT_ORDINARY, NULL, -1, OBJNULL},
|
||||
{EXT_ "STREAM-LISTEN", EXT_ORDINARY, NULL, -1, OBJNULL},
|
||||
{EXT_ "STREAM-PEEK-CHAR", EXT_ORDINARY, NULL, -1, OBJNULL},
|
||||
{EXT_ "STREAM-READ-BYTE", EXT_ORDINARY, NULL, -1, OBJNULL},
|
||||
{EXT_ "STREAM-READ-CHAR", EXT_ORDINARY, NULL, -1, OBJNULL},
|
||||
{EXT_ "STREAM-READ-CHAR-NO-HANG", EXT_ORDINARY, NULL, -1, OBJNULL},
|
||||
{EXT_ "STREAM-READ-LINE", EXT_ORDINARY, NULL, -1, OBJNULL},
|
||||
{EXT_ "STREAM-READ-SEQUENCE", EXT_ORDINARY, NULL, -1, OBJNULL},
|
||||
{EXT_ "STREAM-START-LINE-P", EXT_ORDINARY, NULL, -1, OBJNULL},
|
||||
{EXT_ "STREAM-TERPRI", EXT_ORDINARY, NULL, -1, OBJNULL},
|
||||
{EXT_ "STREAM-UNREAD-CHAR", EXT_ORDINARY, NULL, -1, OBJNULL},
|
||||
{EXT_ "STREAM-WRITE-BYTE", EXT_ORDINARY, NULL, -1, OBJNULL},
|
||||
{EXT_ "STREAM-WRITE-CHAR", EXT_ORDINARY, NULL, -1, OBJNULL},
|
||||
{EXT_ "STREAM-WRITE-SEQUENCE", EXT_ORDINARY, NULL, -1, OBJNULL},
|
||||
{EXT_ "STREAM-WRITE-STRING", EXT_ORDINARY, NULL, -1, OBJNULL},
|
||||
#endif
|
||||
|
||||
#ifdef PDE
|
||||
{SYS_ "*RECORD-SOURCE-PATHNAME-P*", SI_SPECIAL, NULL, -1, OBJNULL},
|
||||
{SYS_ "*SOURCE-PATHNAME*", SI_SPECIAL, NULL, -1, Cnil},
|
||||
|
|
@ -1681,6 +1646,46 @@ cl_symbols[] = {
|
|||
{SYS_ "FRAME", SI_ORDINARY, NULL, -1, OBJNULL},
|
||||
{SYS_ "APPLY-FROM-STACK-FRAME", SI_ORDINARY, si_apply_from_stack_frame, 2, OBJNULL},
|
||||
|
||||
#ifdef ECL_CLOS_STREAMS
|
||||
{GRAY_ "CLOSE", GRAY_ORDINARY, NULL, -1, OBJNULL},
|
||||
{GRAY_ "STREAMP", GRAY_ORDINARY, NULL, -1, OBJNULL},
|
||||
{GRAY_ "INPUT-STREAM-P", GRAY_ORDINARY, NULL, 1, OBJNULL},
|
||||
{GRAY_ "OUTPUT-STREAM-P", GRAY_ORDINARY, NULL, 1, OBJNULL},
|
||||
{GRAY_ "OPEN-STREAM-P", GRAY_ORDINARY, NULL, 1, OBJNULL},
|
||||
{GRAY_ "STREAM-ADVANCE-TO-COLUMN", GRAY_ORDINARY, NULL, -1, OBJNULL},
|
||||
{GRAY_ "STREAM-CLEAR-INPUT", GRAY_ORDINARY, NULL, -1, OBJNULL},
|
||||
{GRAY_ "STREAM-CLEAR-OUTPUT", GRAY_ORDINARY, NULL, -1, OBJNULL},
|
||||
{GRAY_ "STREAM-ELEMENT-TYPE", GRAY_ORDINARY, NULL, 1, OBJNULL},
|
||||
{GRAY_ "STREAM-FINISH-OUTPUT", GRAY_ORDINARY, NULL, -1, OBJNULL},
|
||||
{GRAY_ "STREAM-FORCE-OUTPUT", GRAY_ORDINARY, NULL, -1, OBJNULL},
|
||||
{GRAY_ "STREAM-FRESH-LINE", GRAY_ORDINARY, NULL, -1, OBJNULL},
|
||||
{GRAY_ "STREAM-INTERACTIVE-P", GRAY_ORDINARY, NULL, -1, OBJNULL},
|
||||
{GRAY_ "STREAM-LINE-COLUMN", GRAY_ORDINARY, NULL, -1, OBJNULL},
|
||||
{GRAY_ "STREAM-LISTEN", GRAY_ORDINARY, NULL, -1, OBJNULL},
|
||||
{GRAY_ "STREAM-PEEK-CHAR", GRAY_ORDINARY, NULL, -1, OBJNULL},
|
||||
{GRAY_ "STREAM-READ-BYTE", GRAY_ORDINARY, NULL, -1, OBJNULL},
|
||||
{GRAY_ "STREAM-READ-CHAR", GRAY_ORDINARY, NULL, -1, OBJNULL},
|
||||
{GRAY_ "STREAM-READ-CHAR-NO-HANG", GRAY_ORDINARY, NULL, -1, OBJNULL},
|
||||
{GRAY_ "STREAM-READ-LINE", GRAY_ORDINARY, NULL, -1, OBJNULL},
|
||||
{GRAY_ "STREAM-READ-SEQUENCE", GRAY_ORDINARY, NULL, -1, OBJNULL},
|
||||
{GRAY_ "STREAM-START-LINE-P", GRAY_ORDINARY, NULL, -1, OBJNULL},
|
||||
{GRAY_ "STREAM-TERPRI", GRAY_ORDINARY, NULL, -1, OBJNULL},
|
||||
{GRAY_ "STREAM-UNREAD-CHAR", GRAY_ORDINARY, NULL, -1, OBJNULL},
|
||||
{GRAY_ "STREAM-WRITE-BYTE", GRAY_ORDINARY, NULL, -1, OBJNULL},
|
||||
{GRAY_ "STREAM-WRITE-CHAR", GRAY_ORDINARY, NULL, -1, OBJNULL},
|
||||
{GRAY_ "STREAM-WRITE-SEQUENCE", GRAY_ORDINARY, NULL, -1, OBJNULL},
|
||||
{GRAY_ "STREAM-WRITE-STRING", GRAY_ORDINARY, NULL, -1, OBJNULL},
|
||||
{GRAY_ "FUNDAMENTAL-STREAM", GRAY_ORDINARY, NULL, -1, OBJNULL},
|
||||
{GRAY_ "FUNDAMENTAL-INPUT-STREAM", GRAY_ORDINARY, NULL, -1, OBJNULL},
|
||||
{GRAY_ "FUNDAMENTAL-OUTPUT-STREAM", GRAY_ORDINARY, NULL, -1, OBJNULL},
|
||||
{GRAY_ "FUNDAMENTAL-CHARACTER-STREAM", GRAY_ORDINARY, NULL, -1, OBJNULL},
|
||||
{GRAY_ "FUNDAMENTAL-BINARY-STREAM", GRAY_ORDINARY, NULL, -1, OBJNULL},
|
||||
{GRAY_ "FUNDAMENTAL-CHARACTER-INPUT-STREAM", GRAY_ORDINARY, NULL, -1, OBJNULL},
|
||||
{GRAY_ "FUNDAMENTAL-CHARACTER-OUTPUT-STREAM", GRAY_ORDINARY, NULL, -1, OBJNULL},
|
||||
{GRAY_ "FUNDAMENTAL-BINARY-INPUT-STREAM", GRAY_ORDINARY, NULL, -1, OBJNULL},
|
||||
{GRAY_ "FUNDAMENTAL-BINARY-OUTPUT-STREAM", GRAY_ORDINARY, NULL, -1, OBJNULL},
|
||||
#endif
|
||||
|
||||
/* Tag for end of list */
|
||||
{NULL, CL_ORDINARY, NULL, -1, OBJNULL}};
|
||||
|
||||
|
|
|
|||
|
|
@ -15,6 +15,7 @@
|
|||
#define SYS_ "SI::"
|
||||
#define MP_ "MP::"
|
||||
#define KEY_ ":"
|
||||
#define GRAY_ "GRAY::"
|
||||
struct {
|
||||
const char *name, *translation;
|
||||
}
|
||||
|
|
@ -24,6 +25,7 @@ struct {
|
|||
#define SYS_
|
||||
#define MP_
|
||||
#define KEY_
|
||||
#define GRAY_
|
||||
cl_symbol_initializer
|
||||
#endif
|
||||
cl_symbols[] = {
|
||||
|
|
@ -1225,43 +1227,6 @@ cl_symbols[] = {
|
|||
{SYS_ "*PROFILE-ARRAY*",NULL},
|
||||
#endif
|
||||
|
||||
#ifdef ECL_CLOS_STREAMS
|
||||
#ifdef ECL_GRAY_STREAMS
|
||||
{EXT_ "ANSI-STREAM-CLOSE","si_ansi_stream_close"},
|
||||
{EXT_ "ANSI-STREAM-ELEMENT-TYPE","si_ansi_stream_element_type"},
|
||||
{EXT_ "ANSI-STREAM-INPUT-STREAM-P","si_ansi_stream_input_stream_p"},
|
||||
{EXT_ "ANSI-STREAM-OUTPUT-STREAM-P","si_ansi_stream_output_stream_p"},
|
||||
{EXT_ "ANSI-STREAM-OPEN-STREAM-P","si_ansi_stream_open_stream_p"},
|
||||
#else
|
||||
{EXT_ "STREAM-CLOSE",NULL},
|
||||
{EXT_ "STREAM-ELT-TYPE",NULL},
|
||||
{EXT_ "STREAM-INPUT-P",NULL},
|
||||
{EXT_ "STREAM-OUTPUT-P",NULL},
|
||||
{EXT_ "STREAM-OPEN-P",NULL},
|
||||
#endif
|
||||
{EXT_ "STREAM-CLEAR-INPUT",NULL},
|
||||
{EXT_ "STREAM-CLEAR-OUTPUT",NULL},
|
||||
{EXT_ "STREAM-FINISH-OUTPUT",NULL},
|
||||
{EXT_ "STREAM-FORCE-OUTPUT",NULL},
|
||||
{EXT_ "STREAM-FRESH-LINE",NULL},
|
||||
{EXT_ "STREAM-INTERACTIVE-P",NULL},
|
||||
{EXT_ "STREAM-LINE-COLUMN",NULL},
|
||||
{EXT_ "STREAM-LISTEN",NULL},
|
||||
{EXT_ "STREAM-PEEK-CHAR",NULL},
|
||||
{EXT_ "STREAM-READ-BYTE",NULL},
|
||||
{EXT_ "STREAM-READ-CHAR",NULL},
|
||||
{EXT_ "STREAM-READ-CHAR-NO-HANG",NULL},
|
||||
{EXT_ "STREAM-READ-LINE",NULL},
|
||||
{EXT_ "STREAM-READ-SEQUENCE",NULL},
|
||||
{EXT_ "STREAM-START-LINE-P",NULL},
|
||||
{EXT_ "STREAM-TERPRI",NULL},
|
||||
{EXT_ "STREAM-UNREAD-CHAR",NULL},
|
||||
{EXT_ "STREAM-WRITE-BYTE",NULL},
|
||||
{EXT_ "STREAM-WRITE-CHAR",NULL},
|
||||
{EXT_ "STREAM-WRITE-SEQUENCE",NULL},
|
||||
{EXT_ "STREAM-WRITE-STRING",NULL},
|
||||
#endif
|
||||
|
||||
#ifdef PDE
|
||||
{SYS_ "*RECORD-SOURCE-PATHNAME-P*",NULL},
|
||||
{SYS_ "*SOURCE-PATHNAME*",NULL},
|
||||
|
|
@ -1681,6 +1646,46 @@ cl_symbols[] = {
|
|||
{SYS_ "FRAME",NULL},
|
||||
{SYS_ "APPLY-FROM-STACK-FRAME","si_apply_from_stack_frame"},
|
||||
|
||||
#ifdef ECL_CLOS_STREAMS
|
||||
{GRAY_ "CLOSE",NULL},
|
||||
{GRAY_ "STREAMP",NULL},
|
||||
{GRAY_ "INPUT-STREAM-P",NULL},
|
||||
{GRAY_ "OUTPUT-STREAM-P",NULL},
|
||||
{GRAY_ "OPEN-STREAM-P",NULL},
|
||||
{GRAY_ "STREAM-ADVANCE-TO-COLUMN",NULL},
|
||||
{GRAY_ "STREAM-CLEAR-INPUT",NULL},
|
||||
{GRAY_ "STREAM-CLEAR-OUTPUT",NULL},
|
||||
{GRAY_ "STREAM-ELEMENT-TYPE",NULL},
|
||||
{GRAY_ "STREAM-FINISH-OUTPUT",NULL},
|
||||
{GRAY_ "STREAM-FORCE-OUTPUT",NULL},
|
||||
{GRAY_ "STREAM-FRESH-LINE",NULL},
|
||||
{GRAY_ "STREAM-INTERACTIVE-P",NULL},
|
||||
{GRAY_ "STREAM-LINE-COLUMN",NULL},
|
||||
{GRAY_ "STREAM-LISTEN",NULL},
|
||||
{GRAY_ "STREAM-PEEK-CHAR",NULL},
|
||||
{GRAY_ "STREAM-READ-BYTE",NULL},
|
||||
{GRAY_ "STREAM-READ-CHAR",NULL},
|
||||
{GRAY_ "STREAM-READ-CHAR-NO-HANG",NULL},
|
||||
{GRAY_ "STREAM-READ-LINE",NULL},
|
||||
{GRAY_ "STREAM-READ-SEQUENCE",NULL},
|
||||
{GRAY_ "STREAM-START-LINE-P",NULL},
|
||||
{GRAY_ "STREAM-TERPRI",NULL},
|
||||
{GRAY_ "STREAM-UNREAD-CHAR",NULL},
|
||||
{GRAY_ "STREAM-WRITE-BYTE",NULL},
|
||||
{GRAY_ "STREAM-WRITE-CHAR",NULL},
|
||||
{GRAY_ "STREAM-WRITE-SEQUENCE",NULL},
|
||||
{GRAY_ "STREAM-WRITE-STRING",NULL},
|
||||
{GRAY_ "FUNDAMENTAL-STREAM",NULL},
|
||||
{GRAY_ "FUNDAMENTAL-INPUT-STREAM",NULL},
|
||||
{GRAY_ "FUNDAMENTAL-OUTPUT-STREAM",NULL},
|
||||
{GRAY_ "FUNDAMENTAL-CHARACTER-STREAM",NULL},
|
||||
{GRAY_ "FUNDAMENTAL-BINARY-STREAM",NULL},
|
||||
{GRAY_ "FUNDAMENTAL-CHARACTER-INPUT-STREAM",NULL},
|
||||
{GRAY_ "FUNDAMENTAL-CHARACTER-OUTPUT-STREAM",NULL},
|
||||
{GRAY_ "FUNDAMENTAL-BINARY-INPUT-STREAM",NULL},
|
||||
{GRAY_ "FUNDAMENTAL-BINARY-OUTPUT-STREAM",NULL},
|
||||
#endif
|
||||
|
||||
/* Tag for end of list */
|
||||
{NULL,NULL}};
|
||||
|
||||
|
|
|
|||
|
|
@ -10,7 +10,7 @@
|
|||
;;;; See file '../Copyright' for full details.
|
||||
;;;; The CLOS IO library.
|
||||
|
||||
(in-package "SI")
|
||||
(in-package "GRAY")
|
||||
|
||||
;;;
|
||||
;;; This is the generic function interface for CLOS streams.
|
||||
|
|
@ -41,13 +41,13 @@
|
|||
"This is like CL:CLEAR-OUTPUT, but for Gray streams: clear the given
|
||||
output STREAM. The default method does nothing."))
|
||||
|
||||
(defgeneric stream-close (stream &key abort)
|
||||
(defgeneric close (stream &key abort)
|
||||
(:documentation
|
||||
"Close the given STREAM. No more I/O may be performed, but
|
||||
inquiries may still be made. If :ABORT is true, an attempt is made
|
||||
to clean up the side effects of having created the stream."))
|
||||
|
||||
(defgeneric stream-elt-type (stream)
|
||||
(defgeneric stream-element-type (stream)
|
||||
(:documentation
|
||||
"Return a type specifier for the kind of object returned by the
|
||||
STREAM. The class FUNDAMENTAL-CHARACTER-STREAM provides a default method
|
||||
|
|
@ -71,9 +71,12 @@
|
|||
otherwise. Used by FRESH-LINE. The default method uses
|
||||
STREAM-START-LINE-P and STREAM-TERPRI."))
|
||||
|
||||
(defgeneric stream-input-p (stream)
|
||||
(defgeneric input-stream-p (stream)
|
||||
(:documentation "Can STREAM perform input operations?"))
|
||||
|
||||
(defgeneric stream-p (stream)
|
||||
(:documentation "Is this object a STREAM?"))
|
||||
|
||||
(defgeneric stream-interactive-p (stream)
|
||||
(:documentation "Is stream interactive (For instance, a tty)?"))
|
||||
|
||||
|
|
@ -95,13 +98,13 @@
|
|||
define their own method since it will usually be trivial and will
|
||||
always be more efficient than the default method."))
|
||||
|
||||
(defgeneric stream-open-p (stream)
|
||||
(defgeneric open-stream-p (stream)
|
||||
(:documentation
|
||||
"Return true if STREAM is not closed. A default method is provided
|
||||
by class FUNDAMENTAL-STREAM which returns true if CLOSE has not been
|
||||
called on the stream."))
|
||||
|
||||
(defgeneric stream-output-p (stream)
|
||||
(defgeneric output-stream-p (stream)
|
||||
(:documentation "Can STREAM perform output operations?"))
|
||||
|
||||
(defgeneric stream-peek-char (stream)
|
||||
|
|
@ -211,7 +214,7 @@
|
|||
;;;
|
||||
|
||||
(defclass fundamental-stream (standard-object stream)
|
||||
((open-p :initform t :accessor stream-open-p))
|
||||
((open-p :initform t :accessor open-stream-p))
|
||||
(:documentation "the base class for all CLOS streams"))
|
||||
|
||||
(defclass fundamental-input-stream (fundamental-stream) nil)
|
||||
|
|
@ -277,21 +280,30 @@
|
|||
|
||||
;; CLOSE
|
||||
|
||||
(defmethod stream-close ((stream fundamental-stream) &key abort)
|
||||
(defmethod close ((stream fundamental-stream) &key abort)
|
||||
(declare (ignore abort))
|
||||
(setf (stream-open-p stream) nil)
|
||||
(setf (open-stream-p stream) nil)
|
||||
t)
|
||||
|
||||
(defmethod close ((stream stream) &key abort)
|
||||
(cl:close stream :abort abort))
|
||||
|
||||
(defmethod close ((non-stream t) &key abort)
|
||||
(declare (ignore abort))
|
||||
(error 'type-error :datum non-stream :expected-type 'stream))
|
||||
|
||||
;; STREAM-ELEMENT-TYPE
|
||||
|
||||
(defmethod stream-elt-type ((stream fundamental-character-stream))
|
||||
(defmethod stream-element-type ((stream fundamental-character-stream))
|
||||
'character)
|
||||
|
||||
(defmethod stream-elt-type ((stream stream))
|
||||
(bug-or-error stream 'stream-elt-type))
|
||||
(defmethod stream-element-type ((stream fundamental-stream))
|
||||
(bug-or-error stream 'stream-element-type))
|
||||
|
||||
(defmethod stream-elt-type ((non-stream t))
|
||||
(defmethod stream-element-type ((stream stream))
|
||||
(cl:stream-element-type stream))
|
||||
|
||||
(defmethod stream-element-type ((non-stream t))
|
||||
(error 'type-error :datum non-stream :expected-type 'stream))
|
||||
|
||||
|
||||
|
|
@ -325,16 +337,16 @@
|
|||
|
||||
;; INPUT-STREAM-P
|
||||
|
||||
(defmethod stream-input-p ((stream fundamental-stream))
|
||||
(defmethod input-stream-p ((stream fundamental-stream))
|
||||
nil)
|
||||
|
||||
(defmethod stream-input-p ((stream fundamental-input-stream))
|
||||
(defmethod input-stream-p ((stream fundamental-input-stream))
|
||||
t)
|
||||
|
||||
(defmethod stream-input-p ((stream stream))
|
||||
(bug-or-error stream 'stream-input-p))
|
||||
(defmethod input-stream-p ((stream stream))
|
||||
(cl:input-stream-p stream))
|
||||
|
||||
(defmethod stream-input-p ((non-stream t))
|
||||
(defmethod input-stream-p ((non-stream t))
|
||||
(error 'type-error :datum non-stream :expected-type 'stream))
|
||||
|
||||
|
||||
|
|
@ -363,28 +375,25 @@
|
|||
|
||||
;; OPEN-STREAM-P
|
||||
|
||||
(defmethod stream-open-p ((stream fundamental-stream))
|
||||
(stream-open-p stream))
|
||||
(defmethod open-stream-p ((stream stream))
|
||||
(cl:open-stream-p stream))
|
||||
|
||||
(defmethod stream-open-p ((stream stream))
|
||||
(bug-or-error stream 'open-stream-p))
|
||||
|
||||
(defmethod stream-open-p ((non-stream t))
|
||||
(defmethod open-stream-p ((non-stream t))
|
||||
(error 'type-error :datum non-stream :expected-type 'stream))
|
||||
|
||||
|
||||
;; OUTPUT-STREAM-P
|
||||
|
||||
(defmethod stream-output-p ((stream fundamental-stream))
|
||||
(defmethod output-stream-p ((stream fundamental-stream))
|
||||
nil)
|
||||
|
||||
(defmethod stream-output-p ((stream fundamental-output-stream))
|
||||
(defmethod output-stream-p ((stream fundamental-output-stream))
|
||||
t)
|
||||
|
||||
(defmethod stream-output-p ((stream stream))
|
||||
(bug-or-error stream 'stream-output-p))
|
||||
(defmethod output-stream-p ((stream stream))
|
||||
(cl:output-stream-p stream))
|
||||
|
||||
(defmethod stream-output-p ((non-stream t))
|
||||
(defmethod output-stream-p ((non-stream t))
|
||||
(error 'type-error :datum non-stream :expected-type 'stream))
|
||||
|
||||
|
||||
|
|
@ -452,6 +461,14 @@
|
|||
(eql (stream-line-column stream) 0))
|
||||
|
||||
|
||||
;; STREAM-P
|
||||
|
||||
(defmethod streamp ((stream stream))
|
||||
t)
|
||||
|
||||
(defmethod streamp ((no-stream t))
|
||||
nil)
|
||||
|
||||
;; WRITE-BYTE
|
||||
|
||||
(defmethod stream-write-byte ((stream stream) integer)
|
||||
|
|
|
|||
|
|
@ -143,6 +143,9 @@ struct cl_core_struct {
|
|||
#ifdef CLOS
|
||||
cl_object clos_package;
|
||||
#endif
|
||||
#ifdef ECL_CLOS_STREAMS
|
||||
cl_object gray_package;
|
||||
#endif
|
||||
#ifdef ECL_THREADS
|
||||
cl_object mp_package;
|
||||
#endif
|
||||
|
|
|
|||
|
|
@ -24,7 +24,7 @@ Returns, as a string, the location of the machine on which ECL runs."
|
|||
(defun lisp-implementation-version ()
|
||||
"Args:()
|
||||
Returns the version of your ECL as a string."
|
||||
"@PACKAGE_VERSION@ (CVS 2008-03-16 21:23)")
|
||||
"@PACKAGE_VERSION@ (CVS 2008-03-17 17:51)")
|
||||
|
||||
(defun machine-type ()
|
||||
"Args: ()
|
||||
|
|
|
|||
|
|
@ -30,7 +30,7 @@
|
|||
|
||||
(defconstant default-line-length 80)
|
||||
|
||||
(defclass pretty-stream (fundamental-character-output-stream) (
|
||||
(defclass pretty-stream (gray:fundamental-character-output-stream) (
|
||||
;;
|
||||
;; Where the output is going to finally go.
|
||||
;;
|
||||
|
|
@ -128,14 +128,14 @@
|
|||
|
||||
;;;; Stream interface routines.
|
||||
|
||||
(defmethod ext::stream-write-char ((stream pretty-stream) char)
|
||||
(defmethod gray::stream-write-char ((stream pretty-stream) char)
|
||||
(pretty-out stream char))
|
||||
|
||||
(defmethod ext::stream-force-output ((stream pretty-stream))
|
||||
(defmethod gray::stream-force-output ((stream pretty-stream))
|
||||
;(force-pretty-output stream)
|
||||
)
|
||||
|
||||
(defmethod ext::stream-clear-output ((stream pretty-stream))
|
||||
(defmethod gray::stream-clear-output ((stream pretty-stream))
|
||||
(clear-output (pretty-stream-target stream)))
|
||||
|
||||
(defun pretty-out (stream char)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue