Guest User

Text handling experiments

a guest
Oct 11th, 2017
106
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1.  
  2. (in-package :cl-user)
  3.  
  4. (defpackage :perchar-vs-buffering
  5.   (:use :cl))
  6.  
  7. (in-package :perchar-vs-buffering)
  8.  
  9. (defparameter *special-char* #\\)
  10. (defparameter *commenting-char* #\%)
  11.  
  12.  
  13. (defun run-perchar ()
  14.   (loop :for c = (read-char *standard-input* nil nil)
  15.         :for i :upfrom 0
  16.         :with slist = (list)
  17.         :with clist = (list)
  18.         :with status = :normal
  19.         :while c
  20.         :do (ecase status
  21.               (:normal
  22.                (if (char-equal c *special-char*)
  23.                    (push i slist)
  24.                    (when (char-equal c *commenting-char*)
  25.                      (push i clist)
  26.                      (setf status :commenting))))
  27.               (:commenting
  28.                (when (char-equal c #\Newline)
  29.                  (setf status :normal))))
  30.         :finally (return (values i slist clist))))
  31.  
  32.  
  33. (defvar *x*)
  34.  
  35. (defparameter *buffer-size*
  36.   4096)
  37.  
  38. (defun gather-spindexes (buffer collection s start end)
  39.   (macrolet (($geti (start)
  40.                `(position *special-char* buffer
  41.                           :start ,start
  42.                           :end end)))
  43.     (loop :with p = ($geti start)
  44.           :while p
  45.           :do (progn (push (+ p s)
  46.                            collection)
  47.                      (setf p (when (/= p end)
  48.                                ($geti (1+ p)))))))
  49.   collection)
  50.  
  51. (defun gather-indexes (buffer scoll ccoll s start end status)
  52.   (macrolet (($geti (start &optional (char '*commenting-char*))
  53.                `(position ,char buffer
  54.                           :start ,start
  55.                           :end end)))
  56.     (block loop
  57.       (let ((start1 (if status ; or nil or :commenting
  58.                         (let ((np ($geti start #\Newline)))
  59.                           (if np
  60.                               (progn (setf status nil)
  61.                                      np)
  62.                               (return-from loop)))
  63.                         start)))
  64.         (loop :for p = ($geti start1)
  65.               :while p
  66.               :do (progn (push (+ p s)
  67.                                ccoll)
  68.                          (setf scoll (gather-spindexes buffer scoll s start1 p))
  69.                          (let ((np ($geti p #\Newline)))
  70.                            (if np
  71.                                (setf start1 np)
  72.                                (progn (setf status :commenting)
  73.                                       (return-from loop))))))
  74.        (setf scoll (gather-spindexes buffer scoll s start1 end)))))
  75.   (values scoll ccoll status))
  76.  
  77. (defun run-with-buffering ()
  78.   (let ((b (make-string *buffer-size*))
  79.         (s 0)
  80.         (status nil))
  81.     (loop :for len = (read-sequence b
  82.                                     *standard-input*)
  83.           :while (plusp len)
  84.           :with slist = (list)
  85.           :with clist = (list)
  86.           :do (multiple-value-bind (slist2 clist2 status2)
  87.                   (gather-indexes b slist clist s 0 len status)
  88.                 (setf slist slist2
  89.                       clist clist2
  90.                       status status2)
  91.                 (incf s len))
  92.           :finally (return (values s slist clist)))))
RAW Paste Data