SHARE
TWEET

Text handling experiments

a guest Oct 11th, 2017 76 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
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
Top