Add support for Gray stream implementation of interactive-stream-p

CHANGES

@@ -7,6 +7,23 @@ Unreleased
 <https://github.com/armedbear/abcl/>
 <https://gitlab.common-lisp.net/abcl/abcl/>
 
+* [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

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
@@ -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()");;
   }
@@ -300,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");

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)

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

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

@@ -6,19 +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. 
-(defun java/element-type (object)
+;;;; 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
+           (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)))
+
+(defun java/output-stream-p (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)))))
+            (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-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
+           (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-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)))
@@ -57,20 +99,23 @@
     (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 #'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)))
 
 (defun java/fresh-line (object)
   (let* ((method

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)