Text handling experiments

(in-package :cl-user)

(defpackage :perchar-vs-buffering
  (:use :cl))

(in-package :perchar-vs-buffering)

(defparameter *special-char* #\\)
(defparameter *commenting-char* #\%)


(defun run-perchar ()
  (loop :for c = (read-char *standard-input* nil nil)
        :for i :upfrom 0
        :with slist = (list)
        :with clist = (list)
        :with status = :normal
        :while c
        :do (ecase status
              (:normal
               (if (char-equal c *special-char*)
                   (push i slist)
                   (when (char-equal c *commenting-char*)
                     (push i clist)
                     (setf status :commenting))))
              (:commenting
               (when (char-equal c #\Newline)
                 (setf status :normal))))
        :finally (return (values i slist clist))))


(defvar *x*)

(defparameter *buffer-size*
  4096)

(defun gather-spindexes (buffer collection s start end)
  (macrolet (($geti (start)
               `(position *special-char* buffer
                          :start ,start
                          :end end)))
    (loop :with p = ($geti start)
          :while p
          :do (progn (push (+ p s)
                           collection)
                     (setf p (when (/= p end)
                               ($geti (1+ p)))))))
  collection)

(defun gather-indexes (buffer scoll ccoll s start end status)
  (macrolet (($geti (start &optional (char '*commenting-char*))
               `(position ,char buffer
                          :start ,start
                          :end end)))
    (block loop
      (let ((start1 (if status ; or nil or :commenting
                        (let ((np ($geti start #\Newline)))
                          (if np
                              (progn (setf status nil)
                                     np)
                              (return-from loop)))
                        start)))
        (loop :for p = ($geti start1)
              :while p
              :do (progn (push (+ p s)
                               ccoll)
                         (setf scoll (gather-spindexes buffer scoll s start1 p))
                         (let ((np ($geti p #\Newline)))
                           (if np
                               (setf start1 np)
                               (progn (setf status :commenting)
                                      (return-from loop))))))
       (setf scoll (gather-spindexes buffer scoll s start1 end)))))
  (values scoll ccoll status))

(defun run-with-buffering ()
  (let ((b (make-string *buffer-size*))
        (s 0)
        (status nil))
    (loop :for len = (read-sequence b
                                    *standard-input*)
          :while (plusp len)
          :with slist = (list)
          :with clist = (list)
          :do (multiple-value-bind (slist2 clist2 status2)
                  (gather-indexes b slist clist s 0 len status)
                (setf slist slist2
                      clist clist2
                      status status2)
                (incf s len))
          :finally (return (values s slist clist)))))