From bc6e31f926544497868c13d5b0cc2b2328b837f6 Mon Sep 17 00:00:00 2001 From: "Tarn W. Burton" Date: Thu, 25 Jan 2024 13:32:05 -0500 Subject: [PATCH 1/2] Add generic pathname/truename --- src/c/file.d | 126 ++++++++++++++++++++++++++++++++++++++++++- src/c/pathname.d | 27 +++------- src/c/symbols_list.h | 2 + src/c/unixfsys.d | 3 ++ src/clos/streams.lsp | 43 ++++++++++++++- src/cmp/cmpmain.lsp | 1 + src/h/external.h | 2 + src/h/object.h | 3 ++ 8 files changed, 185 insertions(+), 22 deletions(-) diff --git a/src/c/file.d b/src/c/file.d index 0a96562b8..995775b1d 100644 --- a/src/c/file.d +++ b/src/c/file.d @@ -1403,6 +1403,18 @@ clos_stream_column(cl_object strm) return Null(col)? -1 : ecl_to_size(ecl_floor1(col)); } +static cl_object +clos_stream_pathname(cl_object strm) +{ + return _ecl_funcall2(@'gray::pathname', strm); +} + +static cl_object +clos_stream_truename(cl_object strm) +{ + return _ecl_funcall2(@'gray::truename', strm); +} + static cl_object clos_stream_close(cl_object strm) { @@ -1440,6 +1452,10 @@ const struct ecl_file_ops clos_stream_ops = { clos_stream_set_position, clos_stream_string_length, clos_stream_column, + + clos_stream_pathname, + clos_stream_truename, + clos_stream_close }; #endif /* ECL_CLOS_STREAMS */ @@ -1542,6 +1558,10 @@ const struct ecl_file_ops str_out_ops = { str_out_set_position, str_out_string_length, generic_column, + + not_a_file_stream, + not_a_file_stream, + generic_close }; @@ -1731,6 +1751,10 @@ const struct ecl_file_ops str_in_ops = { str_in_set_position, not_output_string_length, unknown_column, + + not_a_file_stream, + not_a_file_stream, + generic_close }; @@ -1928,6 +1952,10 @@ const struct ecl_file_ops two_way_ops = { generic_set_position, not_file_string_length, two_way_column, + + not_a_file_stream, + not_a_file_stream, + two_way_close }; @@ -2122,6 +2150,10 @@ const struct ecl_file_ops broadcast_ops = { broadcast_set_position, broadcast_string_length, broadcast_column, + + not_a_file_stream, + not_a_file_stream, + broadcast_close }; @@ -2308,6 +2340,10 @@ const struct ecl_file_ops echo_ops = { generic_set_position, not_file_string_length, echo_column, + + not_a_file_stream, + not_a_file_stream, + echo_close }; @@ -2455,6 +2491,10 @@ const struct ecl_file_ops concatenated_ops = { generic_set_position, not_output_string_length, unknown_column, + + not_a_file_stream, + not_a_file_stream, + concatenated_close }; @@ -2640,6 +2680,18 @@ synonym_column(cl_object strm) return ecl_file_column(SYNONYM_STREAM_STREAM(strm)); } +static cl_object +synonym_pathname(cl_object strm) +{ + return ecl_stream_pathname(SYNONYM_STREAM_STREAM(strm)); +} + +static cl_object +synonym_truename(cl_object strm) +{ + return ecl_stream_truename(SYNONYM_STREAM_STREAM(strm)); +} + const struct ecl_file_ops synonym_ops = { synonym_write_byte8, synonym_read_byte8, @@ -2671,6 +2723,10 @@ const struct ecl_file_ops synonym_ops = { synonym_set_position, synonym_string_length, synonym_column, + + synonym_pathname, + synonym_truename, + generic_close }; @@ -3165,6 +3221,18 @@ io_file_write_vector(cl_object strm, cl_object data, cl_index start, cl_index en return generic_write_vector(strm, data, start, end); } +static cl_object +io_file_pathname(cl_object strm) +{ + return IO_STREAM_FILENAME(strm); +} + +static cl_object +io_file_truename(cl_object strm) +{ + return cl_truename(IO_STREAM_FILENAME(strm)); +} + const struct ecl_file_ops io_file_ops = { io_file_write_byte8, io_file_read_byte8, @@ -3196,6 +3264,10 @@ const struct ecl_file_ops io_file_ops = { io_file_set_position, file_string_length, generic_column, + + io_file_pathname, + io_file_truename, + io_file_close }; @@ -3230,6 +3302,10 @@ const struct ecl_file_ops output_file_ops = { io_file_set_position, file_string_length, generic_column, + + io_file_pathname, + io_file_truename, + io_file_close }; @@ -3264,6 +3340,10 @@ const struct ecl_file_ops input_file_ops = { io_file_set_position, not_output_string_length, unknown_column, + + io_file_pathname, + io_file_truename, + io_file_close }; @@ -3851,6 +3931,10 @@ const struct ecl_file_ops io_stream_ops = { io_stream_set_position, file_string_length, generic_column, + + io_file_pathname, + io_file_truename, + io_stream_close }; @@ -3885,6 +3969,10 @@ const struct ecl_file_ops output_stream_ops = { io_stream_set_position, file_string_length, generic_column, + + io_file_pathname, + io_file_truename, + io_stream_close }; @@ -3919,6 +4007,10 @@ const struct ecl_file_ops input_stream_ops = { io_stream_set_position, not_output_string_length, unknown_column, + + io_file_pathname, + io_file_truename, + io_stream_close }; @@ -4065,6 +4157,9 @@ const struct ecl_file_ops winsock_stream_io_ops = { file_string_length, generic_column, + not_a_file_stream, + not_a_file_stream, + winsock_stream_close }; @@ -4100,6 +4195,9 @@ const struct ecl_file_ops winsock_stream_output_ops = { file_string_length, generic_column, + not_a_file_stream, + not_a_file_stream, + winsock_stream_close }; @@ -4135,6 +4233,9 @@ const struct ecl_file_ops winsock_stream_input_ops = { not_output_string_length, unknown_column, + not_a_file_stream, + not_a_file_stream, + winsock_stream_close }; #endif @@ -4241,6 +4342,9 @@ const struct ecl_file_ops wcon_stream_io_ops = { file_string_length, generic_column, + io_file_pathname, + io_file_truename, + generic_close, }; @@ -4434,7 +4538,7 @@ ecl_make_stream_from_FILE(cl_object fname, void *f, enum ecl_smmode smm, FEerror("Not a valid mode ~D for ecl_make_stream_from_FILE", 1, ecl_make_fixnum(smm)); } set_stream_elt_type(stream, byte_size, flags, external_format); - IO_STREAM_FILENAME(stream) = fname; /* not really used */ + IO_STREAM_FILENAME(stream) = fname; stream->stream.column = 0; IO_STREAM_FILE(stream) = f; stream->stream.last_op = 0; @@ -4713,6 +4817,10 @@ const struct ecl_file_ops seq_in_ops = { seq_in_set_position, not_output_string_length, unknown_column, + + not_a_file_stream, + not_a_file_stream, + generic_close }; @@ -4919,6 +5027,10 @@ const struct ecl_file_ops seq_out_ops = { seq_out_set_position, not_output_string_length, generic_column, + + not_a_file_stream, + not_a_file_stream, + generic_close }; @@ -5138,6 +5250,18 @@ ecl_interactive_stream_p(cl_object strm) return stream_dispatch_table(strm)->interactive_p(strm); } +cl_object +ecl_stream_pathname(cl_object strm) +{ + return stream_dispatch_table(strm)->pathname(strm); +} + +cl_object +ecl_stream_truename(cl_object strm) +{ + return stream_dispatch_table(strm)->truename(strm); +} + /* * ecl_read_char(s) tries to read a character from the stream S. It outputs * either the code of the character read, or EOF. Whe compiled with diff --git a/src/c/pathname.d b/src/c/pathname.d index 3f1c93a66..bbe3793fe 100644 --- a/src/c/pathname.d +++ b/src/c/pathname.d @@ -746,27 +746,14 @@ cl_pathname(cl_object x) x = cl_parse_namestring(1, x); case t_pathname: break; - case t_stream: - switch ((enum ecl_smmode)x->stream.mode) { - case ecl_smm_input: - case ecl_smm_output: - case ecl_smm_probe: - case ecl_smm_io: - case ecl_smm_input_file: - case ecl_smm_output_file: - case ecl_smm_io_file: - x = IO_STREAM_FILENAME(x); - goto L; - case ecl_smm_synonym: - x = SYNONYM_STREAM_STREAM(x); - goto L; - default: - ;/* Fall through to error message */ + default: + if (!Null(cl_streamp(x))) { + x = ecl_stream_pathname(x); + } else { + const char *type = "(OR FILE-STREAM STRING PATHNAME)"; + FEwrong_type_only_arg(@[pathname], x, ecl_read_from_cstring(type)); } - default: { - const char *type = "(OR FILE-STREAM STRING PATHNAME)"; - FEwrong_type_only_arg(@[pathname], x, ecl_read_from_cstring(type)); - } + break; } @(return x); } diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h index f335bad26..d14df8b0b 100644 --- a/src/c/symbols_list.h +++ b/src/c/symbols_list.h @@ -1848,6 +1848,8 @@ cl_symbols[] = { {SYS_ "APPLY-FROM-STACK-FRAME" ECL_FUN("si_apply_from_stack_frame", si_apply_from_stack_frame, 2) ECL_VAR(SI_ORDINARY, OBJNULL)}, #ifdef ECL_CLOS_STREAMS +{GRAY_ "PATHNAME" ECL_FUN(NULL, NULL, -1) ECL_VAR(GRAY_ORDINARY, OBJNULL)}, +{GRAY_ "TRUENAME" ECL_FUN(NULL, NULL, -1) ECL_VAR(GRAY_ORDINARY, OBJNULL)}, {GRAY_ "CLOSE" ECL_FUN(NULL, NULL, -1) ECL_VAR(GRAY_ORDINARY, OBJNULL)}, {GRAY_ "STREAMP" ECL_FUN(NULL, NULL, -1) ECL_VAR(GRAY_ORDINARY, OBJNULL)}, {GRAY_ "INPUT-STREAM-P" ECL_FUN(NULL, NULL, 1) ECL_VAR(GRAY_ORDINARY, OBJNULL)}, diff --git a/src/c/unixfsys.d b/src/c/unixfsys.d index f83f53d6c..326b1bcb2 100644 --- a/src/c/unixfsys.d +++ b/src/c/unixfsys.d @@ -460,6 +460,9 @@ file_truename(cl_object pathname, cl_object filename, int flags) cl_object cl_truename(cl_object orig_pathname) { + if (!Null(cl_streamp(orig_pathname))) + @(return ecl_stream_truename(orig_pathname)); + cl_object pathname = make_absolute_pathname(orig_pathname); cl_object base_dir = make_base_pathname(pathname); cl_object dir; diff --git a/src/clos/streams.lsp b/src/clos/streams.lsp index 60a6a6cf0..c09eb79c4 100644 --- a/src/clos/streams.lsp +++ b/src/clos/streams.lsp @@ -225,6 +225,14 @@ error is signaled. That is, users must add methods to explicitly decline by returning NIL.")) +(defgeneric pathname (pathspec) + (:documentation + "Returns the pathname denoted by pathspec.")) + +(defgeneric truename (pathspec) + (:documentation + "truename tries to find the file indicated by filespec and returns its truename.")) + ;;; ;;; Our class hierarchy looks like the one from Gray streams @@ -773,12 +781,45 @@ (si:file-stream-fd stream)) +;;; PATHNAME + +(defmethod pathname ((pathspec string)) + (cl:pathname pathspec)) + +(defmethod pathname ((pathspec cl:pathname)) + pathspec) + +(defmethod pathname ((pathspec ansi-stream)) + (cl:pathname pathspec)) + +(defmethod pathname (pathspec) + (error 'type-error :datum pathspec + :expected-type '(or string cl:pathname file-stream))) + + +;;; TRUENAME + +(defmethod truename ((filespec string)) + (cl:truename filespec)) + +(defmethod truename ((filespec cl:pathname)) + (cl:truename filespec)) + +(defmethod truename ((filespec ansi-stream)) + (cl:truename filespec)) + +(defmethod truename (filespec) + (error 'type-error :datum filespec + :expected-type '(or string cl:pathname file-stream))) + + ;;; Setup (eval-when (:compile-toplevel :execute) (defconstant +conflicting-symbols+ '(cl:close cl:stream-element-type cl:input-stream-p - cl:open-stream-p cl:output-stream-p cl:streamp))) + cl:open-stream-p cl:output-stream-p cl:streamp + cl:pathname cl:truename))) (let ((p (find-package "GRAY"))) (export '(nil) p) diff --git a/src/cmp/cmpmain.lsp b/src/cmp/cmpmain.lsp index f5b822ec9..80f85616e 100644 --- a/src/cmp/cmpmain.lsp +++ b/src/cmp/cmpmain.lsp @@ -20,6 +20,7 @@ (type nil type-supplied-p) (system-p nil) &allow-other-keys) + (setf name (pathname name)) (let* ((format '()) (extension '())) (unless type-supplied-p diff --git a/src/h/external.h b/src/h/external.h index 3a909974d..57193b60a 100755 --- a/src/h/external.h +++ b/src/h/external.h @@ -740,6 +740,8 @@ extern ECL_API cl_object ecl_file_position_set(cl_object strm, cl_object disp); extern ECL_API cl_object ecl_file_length(cl_object strm); extern ECL_API cl_object ecl_file_string_length(cl_object strm, cl_object string); extern ECL_API int ecl_file_column(cl_object strm); +extern ECL_API cl_object ecl_stream_pathname(cl_object strm); +extern ECL_API cl_object ecl_stream_truename(cl_object strm); extern ECL_API cl_fixnum ecl_normalize_stream_element_type(cl_object element); extern ECL_API cl_object ecl_make_stream_from_FILE(cl_object fname, void *fd, enum ecl_smmode smm, cl_fixnum byte_size, int flags, cl_object external_format); extern ECL_API cl_object ecl_make_stream_from_fd(cl_object fname, int fd, enum ecl_smmode smm, cl_fixnum byte_size, int flags, cl_object external_format); diff --git a/src/h/object.h b/src/h/object.h index 5c14796f6..e2159df97 100644 --- a/src/h/object.h +++ b/src/h/object.h @@ -600,6 +600,9 @@ struct ecl_file_ops { cl_object (*string_length)(cl_object strm, cl_object string); int (*column)(cl_object strm); + cl_object (*pathname)(cl_object strm); + cl_object (*truename)(cl_object strm); + cl_object (*close)(cl_object strm); }; From 47c26639559ecf0b1a55f560b8fe278216b903a4 Mon Sep 17 00:00:00 2001 From: "Tarn W. Burton" Date: Thu, 25 Jan 2024 14:06:37 -0500 Subject: [PATCH 2/2] Update changelog for generic pathname/truename --- CHANGELOG | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG b/CHANGELOG index 8a605b86c..3904053a0 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -40,6 +40,7 @@ ~cl:file-length~. 3) ~gray:stream-file-string-length~ which allows Gray streams to implement ~cl:file-string-length~. + 4) Generic versions of ~cl:pathname~ and ~cl:truename~. - Various bug fixes for Gray streams. * 23.9.9 changes since 21.2.1