From 691d0f012ad7656dad94ceae5c7e5b11b0055c0b Mon Sep 17 00:00:00 2001 From: "Tarn W. Burton" Date: Sun, 19 Nov 2023 12:29:49 -0500 Subject: [PATCH] Add gray-streams:stream-file-length support --- src/org/armedbear/lisp/Autoload.java | 1 - src/org/armedbear/lisp/GrayStream.java | 9 ++++ src/org/armedbear/lisp/Stream.java | 9 ++++ src/org/armedbear/lisp/file_length.java | 54 ------------------- src/org/armedbear/lisp/gray-streams-java.lisp | 10 ++++ src/org/armedbear/lisp/gray-streams.lisp | 17 +++++- 6 files changed, 44 insertions(+), 56 deletions(-) delete mode 100644 src/org/armedbear/lisp/file_length.java diff --git a/src/org/armedbear/lisp/Autoload.java b/src/org/armedbear/lisp/Autoload.java index e9b1592f3..0bc5d1235 100644 --- a/src/org/armedbear/lisp/Autoload.java +++ b/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"); diff --git a/src/org/armedbear/lisp/GrayStream.java b/src/org/armedbear/lisp/GrayStream.java index 9938b4b1e..47c766d56 100644 --- a/src/org/armedbear/lisp/GrayStream.java +++ b/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"); } } diff --git a/src/org/armedbear/lisp/Stream.java b/src/org/armedbear/lisp/Stream.java index 1f200aa92..1f72e39a5 100644 --- a/src/org/armedbear/lisp/Stream.java +++ b/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") { diff --git a/src/org/armedbear/lisp/file_length.java b/src/org/armedbear/lisp/file_length.java deleted file mode 100644 index 8d177eb8b..000000000 --- a/src/org/armedbear/lisp/file_length.java +++ /dev/null @@ -1,54 +0,0 @@ -/* - * file_length.java - * - * Copyright (C) 2004 Peter Graves - * $Id$ - * - * This program is free software; you can redistribute it and/or - * modify it under the terms of the GNU General Public License - * as published by the Free Software Foundation; either version 2 - * of the License, or (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - * - * As a special exception, the copyright holders of this library give you - * permission to link this library with independent modules to produce an - * executable, regardless of the license terms of these independent - * modules, and to copy and distribute the resulting executable under - * terms of your choice, provided that you also meet, for each linked - * independent module, the terms and conditions of the license of that - * module. An independent module is a module which is not derived from - * or based on this library. If you modify this library, you may extend - * this exception to your version of the library, but you are not - * obligated to do so. If you do not wish to do so, delete this - * exception statement from your version. - */ - -package org.armedbear.lisp; - -import static org.armedbear.lisp.Lisp.*; - -public final class file_length extends Primitive -{ - private file_length() - { - super("file-length", "stream"); - } - - // ### file-length - // file-length stream => length - @Override - public LispObject execute(LispObject arg) - { - return checkStream(arg).fileLength(); - } - - private static final Primitive FILE_LENGTH = new file_length(); -} diff --git a/src/org/armedbear/lisp/gray-streams-java.lisp b/src/org/armedbear/lisp/gray-streams-java.lisp index b4467bc88..64bbcd2c7 100644 --- a/src/org/armedbear/lisp/gray-streams-java.lisp +++ b/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 diff --git a/src/org/armedbear/lisp/gray-streams.lisp b/src/org/armedbear/lisp/gray-streams.lisp index 304f76d1a..29f1a3734 100644 --- a/src/org/armedbear/lisp/gray-streams.lisp +++ b/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)))