Add gray-streams:stream-file-length support

src/org/armedbear/lisp/Autoload.java

@@ -404,7 +404,6 @@ public LispObject execute(LispObject arg)
         autoload("exp", "MathFunctions");
         autoload("expt", "MathFunctions");
         autoload("file-author", "file_author");
-        autoload("file-length", "file_length");
         autoload("file-string-length", "file_string_length");
         autoload("file-write-date", "file_write_date");
         autoload("float", "FloatFunctions");

src/org/armedbear/lisp/GrayStream.java

@@ -231,6 +231,14 @@ public long _getFilePosition() {
     return result.longValue();
   }
 
+  public static final Symbol FILE_LENGTH
+    = PACKAGE_GRAY_STREAMS_JAVA.addExternalSymbol("JAVA/FILE-LENGTH");
+  @Override
+  public LispObject fileLength() {
+    Function f = checkFunction(FILE_LENGTH.getSymbolFunction());
+    return f.execute(clos);
+  }
+
   public static final Symbol LINE_COLUMN
     = PACKAGE_GRAY_STREAMS_JAVA.addExternalSymbol("JAVA/LINE-COLUMN");
   public int getCharPos() {
@@ -305,6 +313,7 @@ public void _clearInput() {
     Autoload.autoloadFile(GrayStream.WRITE_BYTE, "gray-streams-java");
     Autoload.autoloadFile(GrayStream.FINISH_OUTPUT, "gray-streams-java");
     Autoload.autoloadFile(GrayStream.FILE_POSITION, "gray-streams-java");
+    Autoload.autoloadFile(GrayStream.FILE_LENGTH, "gray-streams-java");
     Autoload.autoloadFile(GrayStream.LINE_COLUMN, "gray-streams-java");
   }
 }

src/org/armedbear/lisp/Stream.java

@@ -2646,6 +2646,15 @@ public LispObject execute(LispObject first, LispObject second)
         }
     };
 
+    // ### file-length
+    private static final Primitive FILE_LENGTH =
+    new Primitive("file-length", "stream") {
+        @Override
+        public LispObject execute(LispObject arg) {
+            return checkStream(arg).fileLength();
+        }
+    };
+
     // ### stream-line-number
     private static final Primitive STREAM_LINE_NUMBER =
     new Primitive("stream-line-number", PACKAGE_SYS, false, "stream") {

src/org/armedbear/lisp/gray-streams-java.lisp

@@ -154,6 +154,16 @@
            (mop:method-function method)))
     (funcall method-function `(,object) nil)))
 
+(defun java/file-length (object)
+  (let* ((method
+           (find-method #'gray-streams:stream-file-length
+                        '()
+                        (list
+                         (class-of object))))
+         (method-function
+           (mop:method-function method)))
+    (funcall method-function `(,object) nil)))
+
 (defun java/line-column (object)
   (let* ((method
            (find-method #'gray-streams:stream-line-column

src/org/armedbear/lisp/gray-streams.lisp

@@ -150,6 +150,7 @@
    "STREAM-READ-SEQUENCE"
    "STREAM-WRITE-SEQUENCE"
    "STREAM-FILE-POSITION"
+   "STREAM-FILE-LENGTH"
    "STREAM-ELEMENT-TYPE"
    "FUNDAMENTAL-BINARY-INPUT-STREAM"
    "FUNDAMENTAL-BINARY-OUTPUT-STREAM"))
@@ -188,6 +189,7 @@
 (defvar *ansi-two-way-stream-input-stream* #'cl:two-way-stream-input-stream)
 (defvar *ansi-two-way-stream-output-stream* #'cl:two-way-stream-output-stream)
 (defvar *ansi-file-position* #'cl:file-position)
+(defvar *ansi-file-length* #'cl:file-length)
 
 (defun ansi-streamp (stream)
   (not
@@ -609,7 +611,18 @@
       (if (ansi-streamp stream)
           (funcall *ansi-file-position* stream)
           (stream-file-position stream))))
-
+
+(defgeneric stream-file-length (stream)
+  (:method (stream)
+    (error 'type-error
+           :datum stream
+           :expected-type 'file-stream)))
+
+(defun gray-file-length (stream)
+  (if (ansi-streamp stream)
+      (funcall *ansi-file-length* stream)
+      (stream-file-length stream)))
+
 #|
 (defstruct (two-way-stream-g (:include stream))
   input-stream output-stream)
@@ -659,6 +672,7 @@
 (setf (symbol-function 'common-lisp::read-sequence) #'gray-read-sequence)
 (setf (symbol-function 'common-lisp::write-sequence) #'gray-write-sequence)
 (setf (symbol-function 'common-lisp::file-position) #'gray-file-position)
+(setf (symbol-function 'common-lisp::file-length) #'gray-file-length)
 (setf (symbol-function 'common-lisp::listen) #'gray-listen)
 
 (dolist (e '((common-lisp::read-char gray-read-char)
@@ -689,6 +703,7 @@
              (common-lisp::read-sequence gray-read-sequence)
              (common-lisp::write-sequence gray-write-sequence)
              (common-lisp::file-position gray-file-position)
+             (common-lisp::file-length gray-file-length)
              (common-lisp::listen gray-listen)))
   (sys::put (car e) 'sys::source (cl:get (second e) 'sys::source)))