<commit_before>(in-package :lem)

(export '(buffer-output-stream
          make-buffer-output-stream
          minibuffer-input-stream
          make-minibuffer-input-stream))

(defclass buffer-output-stream (trivial-gray-streams:fundamental-output-stream)
  ((buffer
    :initarg :buffer
    :accessor buffer-output-stream-buffer)
   (linum
    :initarg :linum
    :accessor buffer-output-stream-linum)
   (column
    :initarg :column
    :accessor buffer-output-stream-column)))

(defun make-buffer-output-stream (buffer &optional point)
  (make-instance 'buffer-output-stream
                 :buffer buffer
                 :linum (if point
                            (point-linum point)
                            1)
                 :column (if point
                             (point-column point)
                             0)))

(defun buffer-output-stream-point (stream)
  (make-point (buffer-output-stream-linum stream)
              (buffer-output-stream-column stream)))

(defmethod stream-element-type ((stream buffer-output-stream))
  'line)

(defmethod trivial-gray-streams:stream-line-column ((stream buffer-output-stream))
  nil)

(defmethod trivial-gray-streams:stream-fresh-line ((stream buffer-output-stream))
  (unless (zerop (buffer-output-stream-column stream))
    (trivial-gray-streams:stream-terpri stream)))

(defmethod trivial-gray-streams:stream-write-byte ((stream buffer-output-stream) byte)
  (trivial-gray-streams:stream-write-char stream (code-char byte)))

(defmethod trivial-gray-streams:stream-write-char ((stream buffer-output-stream) char)
  (prog1 char
    (buffer-insert-char (buffer-output-stream-buffer stream)
                        (buffer-output-stream-linum stream)
                        (buffer-output-stream-column stream)
                        char)
    (if (char= char #\newline)
        (progn
          (incf (buffer-output-stream-linum stream))
          (setf (buffer-output-stream-column stream) 0))
        (incf (buffer-output-stream-column stream)))))

(defun %write-string-to-buffer-stream (stream string start end &key)
  (let ((string (subseq string start end)))
    (loop :for c :across string :do
       (trivial-gray-streams:stream-write-char stream c))
    string))

(defun %write-octets-to-buffer-stream (stream octets start end &key)
  (let ((octets (subseq octets start end)))
    (loop :for c :across octets :do
       (trivial-gray-streams:stream-write-byte stream c))
    octets))

(defmethod trivial-gray-streams:stream-write-sequence
    ((stream buffer-output-stream)
     sequence start end &key)
  (print (type-of sequence))
  (etypecase sequence
    (string
     (%write-string-to-buffer-stream stream sequence start end))
    ((array (unsigned-byte 8) (*))
     (%write-octets-to-buffer-stream stream sequence start end))))

(defmethod trivial-gray-streams:stream-write-string
    ((stream buffer-output-stream)
     (string string)
     &optional (start 0) end)
  (map 'string
       (lambda (c)
         (trivial-gray-streams:stream-write-char stream c))
       (subseq string start end)))

(defmethod trivial-gray-streams:stream-terpri ((stream buffer-output-stream))
  (prog1 (buffer-insert-newline (buffer-output-stream-buffer stream)
                                (buffer-output-stream-linum stream)
                                (buffer-output-stream-column stream))
    (window-update-all)
    (incf (buffer-output-stream-linum stream))
    (setf (buffer-output-stream-column stream) 0)))

<commit_msg>fix #8 buffer-output-streamへの文字列の書き込み速度を改善<commit_after>(in-package :lem)

(export '(buffer-output-stream
          make-buffer-output-stream
          minibuffer-input-stream
          make-minibuffer-input-stream))

(defclass buffer-output-stream (trivial-gray-streams:fundamental-output-stream)
  ((buffer
    :initarg :buffer
    :accessor buffer-output-stream-buffer)
   (linum
    :initarg :linum
    :accessor buffer-output-stream-linum)
   (column
    :initarg :column
    :accessor buffer-output-stream-column)))

(defun make-buffer-output-stream (buffer &optional point)
  (make-instance 'buffer-output-stream
                 :buffer buffer
                 :linum (if point
                            (point-linum point)
                            1)
                 :column (if point
                             (point-column point)
                             0)))

(defun buffer-output-stream-point (stream)
  (make-point (buffer-output-stream-linum stream)
              (buffer-output-stream-column stream)))

(defmethod stream-element-type ((stream buffer-output-stream))
  'line)

(defmethod trivial-gray-streams:stream-line-column ((stream buffer-output-stream))
  nil)

(defmethod trivial-gray-streams:stream-fresh-line ((stream buffer-output-stream))
  (unless (zerop (buffer-output-stream-column stream))
    (trivial-gray-streams:stream-terpri stream)))

(defmethod trivial-gray-streams:stream-write-byte ((stream buffer-output-stream) byte)
  (trivial-gray-streams:stream-write-char stream (code-char byte)))

(defmethod trivial-gray-streams:stream-write-char ((stream buffer-output-stream) char)
  (prog1 char
    (buffer-insert-char (buffer-output-stream-buffer stream)
                        (buffer-output-stream-linum stream)
                        (buffer-output-stream-column stream)
                        char)
    (if (char= char #\newline)
        (progn
          (incf (buffer-output-stream-linum stream))
          (setf (buffer-output-stream-column stream) 0))
        (incf (buffer-output-stream-column stream)))))

(defun %write-string-to-buffer-stream (stream string start end &key)
  (let ((strings
         (split-string (subseq string start end)
                       #\newline)))
    (do ((s strings (cdr s)))
        ((null s))
      (buffer-insert-line (buffer-output-stream-buffer stream)
                          (buffer-output-stream-linum stream)
                          (buffer-output-stream-column stream)
                          (car s))
      (cond ((cdr s)
             (incf (buffer-output-stream-linum stream))
             (setf (buffer-output-stream-column stream) 0))
            (t
             (incf (buffer-output-stream-column stream) (length (car s))))))
    string))

(defun %write-octets-to-buffer-stream (stream octets start end &key)
  (let ((octets (subseq octets start end)))
    (loop :for c :across octets :do
       (trivial-gray-streams:stream-write-byte stream c))
    octets))

(defmethod trivial-gray-streams:stream-write-sequence
    ((stream buffer-output-stream)
     sequence start end &key)
  (etypecase sequence
    (string
     (%write-string-to-buffer-stream stream sequence start end))
    ((array (unsigned-byte 8) (*))
     (%write-octets-to-buffer-stream stream sequence start end))))

(defmethod trivial-gray-streams:stream-write-string
    ((stream buffer-output-stream)
     (string string)
     &optional (start 0) end)
  (%write-string-to-buffer-stream stream string start end))

(defmethod trivial-gray-streams:stream-terpri ((stream buffer-output-stream))
  (prog1 (buffer-insert-newline (buffer-output-stream-buffer stream)
                                (buffer-output-stream-linum stream)
                                (buffer-output-stream-column stream))
    (window-update-all)
    (incf (buffer-output-stream-linum stream))
    (setf (buffer-output-stream-column stream) 0)))


{'fraction_non_alphanumeric': 0.12449365379422091, 'fraction_numerical': 0.0024304617877396704, 'mean_word_length': 2.480733082706767, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 3, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2505019', 'n_tokens_mistral': 2224, 'n_tokens_neox': 2182, 'n_words': 473}