diff --git a/src/CHANGELOG b/src/CHANGELOG index 9d9f710c6..3354a182d 100644 --- a/src/CHANGELOG +++ b/src/CHANGELOG @@ -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 diff --git a/src/c/all_symbols.d b/src/c/all_symbols.d index e265303b1..74bdac01b 100644 --- a/src/c/all_symbols.d +++ b/src/c/all_symbols.d @@ -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) { diff --git a/src/c/file.d b/src/c/file.d index 1da8041b8..d9bbf8458 100644 --- a/src/c/file.d +++ b/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); diff --git a/src/c/main.d b/src/c/main.d index 5d5203d06..dd27358c3 100644 --- a/src/c/main.d +++ b/src/c/main.d @@ -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); diff --git a/src/c/package.d b/src/c/package.d index bbd6010bb..e80947b91 100644 --- a/src/c/package.d +++ b/src/c/package.d @@ -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); } diff --git a/src/c/print.d b/src/c/print.d index 59723744f..56efd3688 100644 --- a/src/c/print.d +++ b/src/c/print.d @@ -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); diff --git a/src/c/read.d b/src/c/read.d index e6033f0b8..e982efb6e 100644 --- a/src/c/read.d +++ b/src/c/read.d @@ -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); diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h index 8216fc5cb..1cecda1b0 100644 --- a/src/c/symbols_list.h +++ b/src/c/symbols_list.h @@ -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}}; diff --git a/src/c/symbols_list2.h b/src/c/symbols_list2.h index be4f36c5e..1ef127dbc 100644 --- a/src/c/symbols_list2.h +++ b/src/c/symbols_list2.h @@ -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}}; diff --git a/src/clos/streams.lsp b/src/clos/streams.lsp index b8ae96184..e0949f9c1 100644 --- a/src/clos/streams.lsp +++ b/src/clos/streams.lsp @@ -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) diff --git a/src/h/external.h b/src/h/external.h index fbbae67c8..b503a0225 100644 --- a/src/h/external.h +++ b/src/h/external.h @@ -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 diff --git a/src/lsp/config.lsp.in b/src/lsp/config.lsp.in index d56ee104e..9e02b7f2d 100644 --- a/src/lsp/config.lsp.in +++ b/src/lsp/config.lsp.in @@ -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: () diff --git a/src/lsp/pprint.lsp b/src/lsp/pprint.lsp index fdde7399f..cbfc3d31d 100644 --- a/src/lsp/pprint.lsp +++ b/src/lsp/pprint.lsp @@ -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)