Add gray:stream-file-length

This commit is contained in:
Tarn W. Burton 2023-11-12 16:06:01 -05:00 committed by Marius Gerbershagen
parent 26d95e8d4f
commit 45af71be53
3 changed files with 21 additions and 1 deletions

View file

@ -1313,7 +1313,11 @@ clos_stream_element_type(cl_object strm)
return _ecl_funcall2(@'gray::stream-element-type', strm);
}
#define clos_stream_length not_a_file_stream
static cl_object
clos_stream_length(cl_object strm)
{
return _ecl_funcall2(@'gray::stream-file-length', strm);
}
static cl_object
clos_stream_get_position(cl_object strm)

View file

@ -1856,6 +1856,7 @@ cl_symbols[] = {
{GRAY_ "STREAM-CLEAR-OUTPUT" ECL_FUN(NULL, NULL, -1) ECL_VAR(GRAY_ORDINARY, OBJNULL)},
{GRAY_ "STREAM-ELEMENT-TYPE" ECL_FUN(NULL, NULL, 1) ECL_VAR(GRAY_ORDINARY, OBJNULL)},
{GRAY_ "STREAM-FILE-DESCRIPTOR" ECL_FUN(NULL, NULL, -1) ECL_VAR(GRAY_ORDINARY, OBJNULL)},
{GRAY_ "STREAM-FILE-LENGTH" ECL_FUN(NULL, NULL, -1) ECL_VAR(GRAY_ORDINARY, OBJNULL)},
{GRAY_ "STREAM-FILE-POSITION" ECL_FUN(NULL, NULL, -1) ECL_VAR(GRAY_ORDINARY, OBJNULL)},
{GRAY_ "STREAM-FINISH-OUTPUT" ECL_FUN(NULL, NULL, -1) ECL_VAR(GRAY_ORDINARY, OBJNULL)},
{GRAY_ "STREAM-FORCE-OUTPUT" ECL_FUN(NULL, NULL, -1) ECL_VAR(GRAY_ORDINARY, OBJNULL)},

View file

@ -203,6 +203,10 @@
(:documentation
"This is like CL:FILE-POSITION, but for Gray streams."))
(defgeneric stream-file-length (stream &optional position)
(:documentation
"This is like CL:FILE-LENGTH, but for Gray streams."))
(defgeneric stream-file-descriptor (stream &optional direction)
(:documentation
"Return the file-descriptor underlaying STREAM, or NIL if not
@ -593,6 +597,14 @@
(declare (ignore stream position))
nil)
;; FILE-LENGTH
(defmethod stream-file-length ((stream ansi-stream))
(file-length stream))
(defmethod stream-file-length ((stream t))
(error 'type-error :datum stream :expected-type 'file-stream))
;; STREAM-P
(defmethod streamp ((stream stream))
@ -821,6 +833,9 @@ them so."
(%redefine-cl-functions 'cl:file-position
'gray:stream-file-position
gray-package)
(%redefine-cl-functions 'cl:file-length
'gray:stream-file-length
gray-package)
(si::package-lock "COMMON-LISP" x)
nil))