refactor(3p/lisp/mime4cl): use trivial-gray-streams r/3676

This should be a net positive for portability and lets us drop some of
the CMUCL cruft (which we don't test anyway, CMU support may have
regressed regardless).

Change-Id: I85664d82d211177da1db9eebea65c956295b09f7
Reviewed-on: https://cl.tvl.fyi/c/depot/+/5067
Tested-by: BuildkiteCI
Reviewed-by: sterni <sternenseemann@systemli.org>

4 files changed, 16 insertions, 51 deletions

diff --git a/third_party/lisp/mime4cl/default.nix b/third_party/lisp/mime4cl/default.nix
index 5165774074c1..a14d695c298e 100644
--- a/third_party/lisp/mime4cl/default.nix
+++ b/third_party/lisp/mime4cl/default.nix
@@ -8,6 +8,7 @@ depot.nix.buildLisp.library {
   deps = [
     depot.third_party.lisp.sclf
     depot.third_party.lisp.npg
+    depot.third_party.lisp.trivial-gray-streams
   ];
 
   srcs = [
diff --git a/third_party/lisp/mime4cl/mime4cl.asd b/third_party/lisp/mime4cl/mime4cl.asd
index 2761a00d5283..6528f115d47a 100644
--- a/third_party/lisp/mime4cl/mime4cl.asd
+++ b/third_party/lisp/mime4cl/mime4cl.asd
@@ -1,6 +1,7 @@
 ;;;  mime4cl.asd --- system definition
 
 ;;;  Copyright (C) 2005-2007, 2010 by Walter C. Pelissero
+;;;  Copyright (C) 2022 by The TVL Authors
 
 ;;;  Author: Walter C. Pelissero <walter@pelissero.de>
 ;;;  Project: mime4cl
@@ -20,11 +21,6 @@
 
 (in-package :cl-user)
 
-#+(and cmu (not gray-streams))
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ext:without-package-locks
-    (load "library:subsystems/gray-streams-library")))
-
 (defpackage :mime4cl-system
   (:use :common-lisp :asdf))
 
@@ -40,7 +36,7 @@
     "A collection of Common Lisp primitives to forge and handle
 MIME mail contents."
     :licence "LGPL"
-    :depends-on (:npg :sclf)
+    :depends-on (:npg :sclf :trivial-gray-streams)
     :components
     ((:file "package")
      (:file "mime" :depends-on ("package" "endec" "streams"))
diff --git a/third_party/lisp/mime4cl/package.lisp b/third_party/lisp/mime4cl/package.lisp
index fc5d9627f9e5..b1217a0b6818 100644
--- a/third_party/lisp/mime4cl/package.lisp
+++ b/third_party/lisp/mime4cl/package.lisp
@@ -1,6 +1,7 @@
 ;;;  package.lisp --- package declaration
 
 ;;;  Copyright (C) 2005-2007, 2010 by Walter C. Pelissero
+;;;  Copyright (C) 2022 The TVL Authors
 
 ;;;  Author: Walter C. Pelissero <walter@pelissero.de>
 ;;;  Project: mime4cl
@@ -22,9 +23,7 @@
 
 (defpackage :mime4cl
   (:nicknames :mime)
-  (:use :common-lisp :npg :sclf
-        ;; for Gray streams
-        #+cmu :extensions #+sbcl :sb-gray)
+  (:use :common-lisp :npg :sclf :trivial-gray-streams)
   ;; this is stuff that comes from SCLF and clashes with CMUCL's EXT
   ;; package
   (:shadowing-import-from :sclf
diff --git a/third_party/lisp/mime4cl/streams.lisp b/third_party/lisp/mime4cl/streams.lisp
index 087207ce5341..4fce60d5aac3 100644
--- a/third_party/lisp/mime4cl/streams.lisp
+++ b/third_party/lisp/mime4cl/streams.lisp
@@ -1,12 +1,12 @@
- ;;; eds.lisp --- En/De-coding Streams
+;;; streams.lisp --- En/De-coding Streams
 
- ;;; Copyright (C) 2012 by Walter C. Pelissero
- ;;; Copyright (C) 2021 by the TVL Authors
+;;; Copyright (C) 2012 by Walter C. Pelissero
+;;; Copyright (C) 2021-2022 by the TVL Authors
 
- ;;; Author: Walter C. Pelissero <walter@pelissero.de>
- ;;; Project: mime4cl
+;;; Author: Walter C. Pelissero <walter@pelissero.de>
+;;; Project: mime4cl
 
-#+cmu (ext:file-comment "$Module: eds.lisp")
+#+cmu (ext:file-comment "$Module: streams.lisp")
 
 ;;; This library is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU Lesser General Public License
@@ -23,39 +23,6 @@
 
 (in-package :mime4cl)
 
-#+cmu
-(eval-when (:load-toplevel :compile-toplevel :execute)
-  ;; CMUCL doesn't provide the STREAM-FILE-POSITION method in its
-  ;; implementation of Gray streams.  We patch it in ourselves.
-  (defgeneric stream-file-position (stream &optional position))
-  (defun my-file-position (stream &optional position)
-    (stream-file-position stream position))
-  (defvar *original-file-position-function*
-    (prog1
-        (symbol-function 'file-position)
-      (setf (symbol-function 'file-position) (symbol-function 'my-file-position))))
-  (defmethod stream-file-position (stream &optional position)
-    (if position
-        (funcall *original-file-position-function* stream position)
-        (funcall *original-file-position-function* stream)))
-
-  ;; oddly CMUCL doesn't seem to provide a default for STREAM-READ-SEQUENCE
-  (defmacro make-read-sequence (stream-type element-reader)
-    `(defmethod stream-read-sequence ((stream ,stream-type) seq &optional start end)
-       (unless start
-         (setf start 0))
-       (unless end
-         (setf end (length seq)))
-       (loop
-          for i from start below end
-          for b = (,element-reader stream)
-          until (eq b :eof)
-          do (setf (elt seq i) b)
-          finally (return i))))
-
-  (make-read-sequence fundamental-binary-input-stream stream-read-byte)
-  (make-read-sequence fundamental-character-input-stream stream-read-char))
-
 (defclass coder-stream-mixin ()
   ((real-stream :type stream
                 :initarg :stream
@@ -63,9 +30,11 @@
    (dont-close :initform nil
                :initarg :dont-close)))
 
-(defmethod stream-file-position ((stream coder-stream-mixin) &optional position)
-  (apply #'file-position (remove nil (list (slot-value stream 'real-stream)
-                                           position))))
+(defmethod stream-file-position ((stream coder-stream-mixin))
+  (file-position (slot-value stream 'real-stream)))
+
+(defmethod (setf stream-file-position) (newval (stream coder-stream-mixin))
+  (file-position (slot-value stream 'real-stream) newval))
 
 (defclass coder-input-stream-mixin (fundamental-binary-input-stream coder-stream-mixin)
   ())