From b9a12d7b7f92cd18220982dbe24a661419a1dc2d Mon Sep 17 00:00:00 2001 From: "Tarn W. Burton" Date: Mon, 20 Nov 2023 19:45:03 -0500 Subject: [PATCH 1/7] Add support for Gray stream implementation of interactive-stream-p Also make the Java methods isInputStream, isOutputStream, isCharacterStream and isBinaryStream, sOpen call the appropriate Gray stream methods versus assuming specific inheritance. --- src/org/armedbear/lisp/GrayStream.java | 74 +++++++------------ src/org/armedbear/lisp/gray-streams-java.lisp | 44 +++++++++++ src/org/armedbear/lisp/gray-streams.lisp | 10 +++ 3 files changed, 81 insertions(+), 47 deletions(-) diff --git a/src/org/armedbear/lisp/GrayStream.java b/src/org/armedbear/lisp/GrayStream.java index 47c766d56..75c2560fa 100644 --- a/src/org/armedbear/lisp/GrayStream.java +++ b/src/org/armedbear/lisp/GrayStream.java @@ -35,59 +35,49 @@ public GrayStream findOrCreate(LispObject o) { return wrappedStream; } - // + // // do what we can for Java code that wants to determine our valence(s) // + public static final Symbol INPUT_STREAM_P + = PACKAGE_GRAY_STREAMS_JAVA.addExternalSymbol("JAVA/INPUT-STREAM-P"); public boolean isInputStream() { - Function SUBTYPEP - = (Function)Symbol.SUBTYPEP.getSymbolFunction(); - Package pkg - = getCurrentPackage().findPackage("GRAY-STREAMS"); - Symbol fundamentalInputStream - = (Symbol) pkg.findSymbol("FUNDAMENTAL-INPUT-STREAM"); - if (SUBTYPEP.execute(clos.typeOf(), fundamentalInputStream).equals(T)) { - return true; - } - return false; + Function f = checkFunction(INPUT_STREAM_P.getSymbolFunction()); + return f.execute(clos).getBooleanValue(); } + public static final Symbol OUTPUT_STREAM_P + = PACKAGE_GRAY_STREAMS_JAVA.addExternalSymbol("JAVA/OUTPUT-STREAM-P"); public boolean isOutputStream() { - Function SUBTYPEP - = (Function)Symbol.SUBTYPEP.getSymbolFunction(); - Package pkg - = getCurrentPackage().findPackage("GRAY-STREAMS"); - Symbol s - = (Symbol) pkg.findSymbol("FUNDAMENTAL-OUTPUT-STREAM"); - if (SUBTYPEP.execute(clos.typeOf(), s).equals(T)) { - return true; - } - return false; + Function f = checkFunction(OUTPUT_STREAM_P.getSymbolFunction()); + return f.execute(clos).getBooleanValue(); + } + + public static final Symbol INTERACTIVE_STREAM_P + = PACKAGE_GRAY_STREAMS_JAVA.addExternalSymbol("JAVA/INTERACTIVE-STREAM-P"); + public boolean isInteractive() { + Function f = checkFunction(INTERACTIVE_STREAM_P.getSymbolFunction()); + return f.execute(clos).getBooleanValue(); + } + + public static final Symbol OPEN_STREAM_P + = PACKAGE_GRAY_STREAMS_JAVA.addExternalSymbol("JAVA/OPEN-STREAM-P"); + public boolean isOpen() { + Function f = checkFunction(OPEN_STREAM_P.getSymbolFunction()); + return f.execute(clos).getBooleanValue(); } public boolean isCharacterStream() { Function SUBTYPEP = (Function)Symbol.SUBTYPEP.getSymbolFunction(); Package pkg - = getCurrentPackage().findPackage("GRAY-STREAMS"); + = getCurrentPackage().findPackage("COMMON-LISP"); Symbol s - = (Symbol) pkg.findSymbol("FUNDAMENTAL-CHARACTER-STREAM"); - if (SUBTYPEP.execute(clos.typeOf(), s).equals(T)) { - return true; - } - return false; + = (Symbol) pkg.findSymbol("CHARACTER"); + return SUBTYPEP.execute(getElementType(), s).getBooleanValue(); } public boolean isBinaryStream() { - Function SUBTYPEP - = (Function)Symbol.SUBTYPEP.getSymbolFunction(); - Package pkg - = getCurrentPackage().findPackage("GRAY-STREAMS"); - Symbol s - = (Symbol) pkg.findSymbol("FUNDAMENTAL-BINARY-STREAM"); - if (SUBTYPEP.execute(clos.typeOf(), s).equals(T)) { - return true; - } - return false; + return !isCharacterStream(); } public boolean isCharacterInputStream() { @@ -251,11 +241,6 @@ public int getCharPos() { // unimplemented interfaces of parent class // // we stub these to return Lisp-side errors - public boolean isInteractive() { - simple_error("unimplemented isInteractive()"); - return false; // unreached - } - public void setInteractive(boolean b) { simple_error("unimplemented setInteractive(boolean)"); } @@ -274,11 +259,6 @@ public void setExternalFormat(LispObject format) { simple_error("unimplemented setExternalFormat()"); } - public boolean isOpen() { - simple_error("unimplemented isOpen()"); - return false; // unreached - } - public void setOpen(boolean b) { simple_error("unimplemented setOpen()");; } diff --git a/src/org/armedbear/lisp/gray-streams-java.lisp b/src/org/armedbear/lisp/gray-streams-java.lisp index 64bbcd2c7..d76cae030 100644 --- a/src/org/armedbear/lisp/gray-streams-java.lisp +++ b/src/org/armedbear/lisp/gray-streams-java.lisp @@ -7,6 +7,50 @@ ;;;; N.b. The function symbols seemingly have to be unique across all ;;;; packages for this to work, hence the "java/…" prefixes. +(defun java/input-stream-p (object) + (let* ((method + (find-method #'gray-streams::gray-input-stream-p + '() + (list + (class-of object)) + nil)) + (method-function + (mop:method-function method))) + (funcall method-function `(,object) nil))) + +(defun java/output-stream-p (object) + (let* ((method + (find-method #'gray-streams::gray-output-stream-p + '() + (list + (class-of object)) + nil)) + (method-function + (mop:method-function method))) + (funcall method-function `(,object) nil))) + +(defun java/interactive-stream-p (object) + (let* ((method + (find-method #'gray-streams::gray-interactive-stream-p + '() + (list + (class-of object)) + nil)) + (method-function + (mop:method-function method))) + (funcall method-function `(,object) nil))) + +(defun java/open-stream-p (object) + (let* ((method + (find-method #'gray-streams::gray-open-stream-p + '() + (list + (class-of object)) + nil)) + (method-function + (mop:method-function method))) + (funcall method-function `(,object) nil))) + (defun java/element-type (object) (let* ((method (or diff --git a/src/org/armedbear/lisp/gray-streams.lisp b/src/org/armedbear/lisp/gray-streams.lisp index 72793eae7..28a6b94f0 100644 --- a/src/org/armedbear/lisp/gray-streams.lisp +++ b/src/org/armedbear/lisp/gray-streams.lisp @@ -182,6 +182,7 @@ #'(lambda (s) (and (input-stream-p s) (eql (stream-element-type s) 'character)))) (defvar *ansi-input-stream-p* #'cl::input-stream-p) (defvar *ansi-output-stream-p* #'cl::output-stream-p) +(defvar *ansi-interactive-stream-p* #'cl::interactive-stream-p) (defvar *ansi-open-stream-p* #'cl::open-stream-p) (defvar *ansi-streamp* #'cl::streamp) (defvar *ansi-read-sequence* #'cl::read-sequence) @@ -208,6 +209,7 @@ (defgeneric gray-input-stream-p (stream)) (defgeneric gray-input-character-stream-p (stream)) ;; # fb 1.01 (defgeneric gray-output-stream-p (stream)) +(defgeneric gray-interactive-stream-p (stream)) (defgeneric gray-stream-element-type (stream)) (defmethod gray-close ((stream fundamental-stream) &key abort) @@ -221,6 +223,10 @@ (defmethod gray-streamp ((s fundamental-stream)) s) +(defmethod gray-interactive-stream-p (stream) + (declare (ignore stream)) + nil) + (defclass fundamental-input-stream (fundamental-stream) ()) (defmethod gray-input-character-stream-p (s) ;; # fb 1.01 @@ -605,6 +611,9 @@ (defmethod gray-output-stream-p (stream) (funcall *ansi-output-stream-p* stream)) +(defmethod gray-interactive-stream-p (stream) + (funcall *ansi-interactive-stream-p* stream)) + (defmethod gray-open-stream-p (stream) (funcall *ansi-open-stream-p* stream)) @@ -687,6 +696,7 @@ (setf (symbol-function 'common-lisp::input-stream-p) #'gray-input-stream-p) (setf (symbol-function 'common-lisp::input-character-stream-p) #'gray-input-character-stream-p) ;; # fb 1.01 (setf (symbol-function 'common-lisp::output-stream-p) #'gray-output-stream-p) +(setf (symbol-function 'common-lisp::interactive-stream-p) #'gray-interactive-stream-p) (setf (symbol-function 'common-lisp::open-stream-p) #'gray-open-stream-p) (setf (symbol-function 'common-lisp::streamp) #'gray-streamp) (setf (symbol-function 'common-lisp::read-sequence) #'gray-read-sequence) From 7b83a3eb91bf0e276ecbcc61cc78c67a948f4481 Mon Sep 17 00:00:00 2001 From: "Tarn W. Burton" Date: Mon, 27 Nov 2023 09:02:43 -0500 Subject: [PATCH 2/7] Update CHANGES for recent Gray stream additions --- CHANGES | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/CHANGES b/CHANGES index a978f8d73..493b4e071 100644 --- a/CHANGES +++ b/CHANGES @@ -7,6 +7,23 @@ Unreleased +* [r15743] (Tarn W. Burton) Add support for implementing + CL:INTERACTIVE-STREAM-P in for Gray streams. This is done via by + making CL:INTERACTIVE-STREAM-P a generic function when the Gray + streams module is required. + +* [r15742] (Tarn W. Burton) Add support for stream specific line + lengths. This is done via the GRAY-STREAMS:STREAM-LINE-LENGTH + generic function which is only used when CL:*PRINT-RIGHT-MARGIN* is + NIL. The pretty printer and format have been updated to respect + these line lengths. + +* [r15741] (Tarn W. Burton) Add some missing default methods in the + Gray streams module. + +* [r15739] (Tarn W. Burton) Add support for implementing + CL:FILE-LENGTH in for Gray streams. This is done via the + GRAY-STREAMS:STREAM-FILE-LENGTH generic function. Version 1.9.2 From 154b6c931165fd34816c7b9bd3539e9a24900afa Mon Sep 17 00:00:00 2001 From: Mark Evenson Date: Thu, 30 Nov 2023 11:51:41 +0100 Subject: [PATCH 3/7] Lisp.checkStream() coercion works for GRAY-STREAM subclasses --- src/org/armedbear/lisp/Lisp.java | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/src/org/armedbear/lisp/Lisp.java b/src/org/armedbear/lisp/Lisp.java index 3c0dec995..839e95bad 100644 --- a/src/org/armedbear/lisp/Lisp.java +++ b/src/org/armedbear/lisp/Lisp.java @@ -1858,12 +1858,15 @@ public static final Stream checkStream(LispObject obj) if (obj instanceof Stream) { return (Stream) obj; } - if (obj.typep(Symbol.STREAM).equal(T)) { - Stream result = GrayStream.findOrCreate(obj); - return result; + if (obj instanceof StandardObject) { + Function subtypep = checkFunction(Symbol.SUBTYPEP.getSymbolFunction()); + if (subtypep.execute(obj.typeOf(), Symbol.STREAM).equals(T)) { + Stream result = GrayStream.findOrCreate(obj); + return result; + } } return (Stream) // Not reached. - type_error(obj, Symbol.STREAM); + type_error(obj, Symbol.STREAM); } public static final Stream checkCharacterInputStream(LispObject obj) From 6ec431ba9c2306766a0ed71a862ca641377a4df0 Mon Sep 17 00:00:00 2001 From: Mark Evenson Date: Thu, 30 Nov 2023 11:52:43 +0100 Subject: [PATCH 4/7] Add autoloads for missing GrayStream functions Every Java-side function usually needs an explicit static autoload call. --- src/org/armedbear/lisp/GrayStream.java | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/org/armedbear/lisp/GrayStream.java b/src/org/armedbear/lisp/GrayStream.java index 75c2560fa..cce8d0f10 100644 --- a/src/org/armedbear/lisp/GrayStream.java +++ b/src/org/armedbear/lisp/GrayStream.java @@ -4,8 +4,8 @@ import static org.armedbear.lisp.Lisp.*; /** - The Java stub for Gray streams which wraps the reference of the CLOS - object corresponding to the stream. + The Java proxy for Gray streams which wraps the reference of the + CLOS object corresponding to the stream. */ public class GrayStream extends Stream @@ -280,6 +280,10 @@ public void _clearInput() { // TODO figure out why we can't add these to autoloads.lisp static { + Autoload.autoloadFile(GrayStream.INPUT_STREAM_P, "gray-streams-java"); + Autoload.autoloadFile(GrayStream.OUTPUT_STREAM_P, "gray-streams-java"); + Autoload.autoloadFile(GrayStream.INTERACTIVE_STREAM_P, "gray-streams-java"); + Autoload.autoloadFile(GrayStream.OPEN_STREAM_P, "gray-streams-java"); Autoload.autoloadFile(GrayStream.ELEMENT_TYPE, "gray-streams-java"); Autoload.autoloadFile(GrayStream.FORCE_OUTPUT, "gray-streams-java"); Autoload.autoloadFile(GrayStream.WRITE_STRING, "gray-streams-java"); From f4e4cf8897a09b6961883cbd2aa8435f6129dc82 Mon Sep 17 00:00:00 2001 From: Mark Evenson Date: Thu, 30 Nov 2023 11:54:28 +0100 Subject: [PATCH 5/7] Find most specialized method, defaulting GRAY-STREAM if none --- src/org/armedbear/lisp/gray-streams-java.lisp | 83 +++++++++---------- 1 file changed, 37 insertions(+), 46 deletions(-) diff --git a/src/org/armedbear/lisp/gray-streams-java.lisp b/src/org/armedbear/lisp/gray-streams-java.lisp index d76cae030..361fb714e 100644 --- a/src/org/armedbear/lisp/gray-streams-java.lisp +++ b/src/org/armedbear/lisp/gray-streams-java.lisp @@ -6,63 +6,61 @@ ;;;; these methods. ;;;; N.b. The function symbols seemingly have to be unique across all -;;;; packages for this to work, hence the "java/…" prefixes. +;;;; packages for this to work, hence the "java/…" prefixes. + +(defun find-method-or-nil (method specialization) + "Either return the method object for generic METHOD with a one argument + SPECIALIZATION or nil if it doesn't exist" + (find-method method '() (list specialization) nil)) + (defun java/input-stream-p (object) (let* ((method - (find-method #'gray-streams::gray-input-stream-p - '() - (list - (class-of object)) - nil)) + (or + (find-method-or-nil #'gray-streams::gray-input-stream-p + (class-of object)) + (find-method-or-nil #'gray-streams::gray-input-stream-p + (find-class 'gray-streams:fundamental-input-stream)))) (method-function (mop:method-function method))) - (funcall method-function `(,object) nil))) + (funcall method-function `(,object) nil))) (defun java/output-stream-p (object) (let* ((method - (find-method #'gray-streams::gray-output-stream-p - '() - (list - (class-of object)) - nil)) + (or + (find-method-or-nil #'gray-streams::gray-output-stream-p + (class-of object)) + (find-method-or-nil #'gray-streams::gray-output-stream-p + (find-class 'gray-streams:fundamental-output-stream)))) (method-function (mop:method-function method))) (funcall method-function `(,object) nil))) (defun java/interactive-stream-p (object) (let* ((method - (find-method #'gray-streams::gray-interactive-stream-p - '() - (list - (class-of object)) - nil)) + (find-method-or-nil #'gray-streams::gray-interactive-stream-p + (class-of object))) (method-function (mop:method-function method))) (funcall method-function `(,object) nil))) (defun java/open-stream-p (object) (let* ((method - (find-method #'gray-streams::gray-open-stream-p - '() - (list - (class-of object)) - nil)) + (or + (find-method-or-nil #'gray-streams::gray-open-stream-p + (class-of object)) + (find-method-or-nil #'gray-streams::gray-open-stream-p + (find-class 'gray-streams:fundamental-stream)))) (method-function (mop:method-function method))) (funcall method-function `(,object) nil))) (defun java/element-type (object) (let* ((method - (or - (find-method #'gray-streams:stream-element-type - '() - (list - (class-of object)) - nil) - (find-method #'gray-streams::gray-stream-element-type - '() - (list - (class-of object))))) + (or + (find-method-or-nil #'gray-streams:stream-element-type + (class-of object)) + (find-method-or-nil #'gray-streams::gray-stream-element-type + (class-of object)))) (method-function (mop:method-function method))) (funcall method-function `(,object) nil))) @@ -101,20 +99,13 @@ (funcall method-function `(,object ,char) nil))) (defun java/write-chars (object string start end) ; The defaults for start and end are 0 and nil, respectively. - (flet ((find-method-or-nil (specialized-on-class) - (find-method #'gray-streams:stream-write-sequence - '() - (list - specialized-on-class - (find-class t)) - nil))) - (let* ((method - (or - (find-method-or-nil (class-of object)) - (find-method-or-nil (find-class 'gray-streams:fundamental-character-output-stream)))) - (method-function - (mop:method-function method))) - (funcall method-function `(,object ,string ,start ,end) nil)))) + (let* ((method + (or + (find-method-or-nil (class-of object)) + (find-method-or-nil (find-class 'gray-streams:fundamental-character-output-stream)))) + (method-function + (mop:method-function method))) + (funcall method-function `(,object ,string ,start ,end) nil))) (defun java/fresh-line (object) (let* ((method From a5c9095c12cd77190b83db7426fb8a4d24e50010 Mon Sep 17 00:00:00 2001 From: Mark Evenson Date: Thu, 30 Nov 2023 11:55:35 +0100 Subject: [PATCH 6/7] Stream.is{Input,Output}Stream works for all cases --- src/org/armedbear/lisp/TwoWayStream.java | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/src/org/armedbear/lisp/TwoWayStream.java b/src/org/armedbear/lisp/TwoWayStream.java index 8083c98ef..58f430ca8 100644 --- a/src/org/armedbear/lisp/TwoWayStream.java +++ b/src/org/armedbear/lisp/TwoWayStream.java @@ -228,16 +228,15 @@ public LispObject execute(LispObject first, LispObject second) { final Stream in = checkStream(first); - final Stream out = checkStream(second); - if (!in.isInputStream() - && !(in instanceof GrayStream)) { - return type_error(in, list(Symbol.SATISFIES, - Symbol.INPUT_STREAM_P)); + if (!in.isInputStream()) { + return type_error(in, list(Symbol.SATISFIES, + Symbol.INPUT_STREAM_P)); } - if (!out.isOutputStream() - && !(out instanceof GrayStream)) { + + final Stream out = checkStream(second); + if (!out.isOutputStream()) { return type_error(out, list(Symbol.SATISFIES, - Symbol.OUTPUT_STREAM_P)); + Symbol.OUTPUT_STREAM_P)); } return new TwoWayStream(in, out); } From 2f3cd57b0128a81e2b8e738585d3a870b2e3a1f4 Mon Sep 17 00:00:00 2001 From: "Tarn W. Burton" Date: Thu, 30 Nov 2023 10:12:30 -0500 Subject: [PATCH 7/7] Fix call to find-method --- src/org/armedbear/lisp/gray-streams-java.lisp | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/src/org/armedbear/lisp/gray-streams-java.lisp b/src/org/armedbear/lisp/gray-streams-java.lisp index 361fb714e..e1f5f5eb9 100644 --- a/src/org/armedbear/lisp/gray-streams-java.lisp +++ b/src/org/armedbear/lisp/gray-streams-java.lisp @@ -101,8 +101,18 @@ (defun java/write-chars (object string start end) ; The defaults for start and end are 0 and nil, respectively. (let* ((method (or - (find-method-or-nil (class-of object)) - (find-method-or-nil (find-class 'gray-streams:fundamental-character-output-stream)))) + (find-method #'gray-streams:stream-write-sequence + '() + (list + (class-of object) + (find-class t)) + nil) + (find-method #'gray-streams:stream-write-sequence + '() + (list + (find-class 'gray-streams:fundamental-character-output-stream) + (find-class t)) + nil))) (method-function (mop:method-function method))) (funcall method-function `(,object ,string ,start ,end) nil)))