Add generic pathname/truename

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

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);
 }

src/c/symbols_list.h

@@ -1846,6 +1846,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)},

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;

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)

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

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);

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);
 };