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.
armedbear · Nov 21, 2023 · b9a12d7 · b9a12d7
1 parent 6ae3f67
commit b9a12d7
Show file tree

Hide file tree

Showing 3 changed files with 81 additions and 47 deletions.
diff --git 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
@@ -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
@@ -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)