Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

added ring buffer implementation

added lisp reader heredoc implementation based on ring buffers
  • Loading branch information...
commit f0883e054c7180b872f2732417c28b15e76a725a 1 parent 92617a0
@e-user authored
Showing with 157 additions and 0 deletions.
  1. +59 −0 src/heredoc.lisp
  2. +98 −0 src/ring-buffer.lisp
View
59 src/heredoc.lisp
@@ -0,0 +1,59 @@
+;;;; evol - heredoc.lisp
+;;;; Copyright (C) 2010 Alexander Kahl <e-user@fsfe.org>
+;;;; This file is part of evol.
+;;;; evol is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 3 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; evol is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+(in-package :evol)
+
+(defun read-until-match (stream terminal)
+ "read-until-match stream terminal => string
+
+Read characters from STREAM until a sequence equal to string TERMINAL is read.
+Return all characters read as string omitting TERMINAL itself. Signal error upon
+EOF."
+ (with-output-to-string (out)
+ (do* ((match-length (length terminal))
+ (buffer (new-ring-buffer match-length))
+ (buffer-char nil)
+ (char (read-char stream t :eof t)
+ (or (setf buffer-char (ring-buffer-next buffer))
+ (read-char stream t :eof t)))
+ (match-pos 0))
+ ((eql char :eof))
+ (cond ((char= char (char terminal match-pos))
+ (when (= (incf match-pos) match-length)
+ (return))
+ (unless buffer-char
+ (ring-buffer-insert buffer char)))
+ ((zerop match-pos)
+ (write-char char out)
+ (when buffer-char
+ (ring-buffer-pop buffer)))
+ (t
+ (unless buffer-char
+ (ring-buffer-insert buffer char))
+ (write-char (ring-buffer-pop buffer) out)
+ (setf match-pos 0))))))
+
+(defun read-heredoc (stream char arg)
+ "read-heredoc stream char arg => string
+
+Return string from STREAM up to the point where the string read first until CHAR
+is encountered. All evaluation is completely turned off so no quoting is
+required at all.
+Example: #>eof>Write whatever (you) \"want\"!eof => Write whatever (you) \"want\"!"
+ (declare (ignore arg))
+ (read-until-match stream (read-until-match stream (string char))))
+
+(set-dispatch-macro-character #\# #\> #'read-heredoc)
View
98 src/ring-buffer.lisp
@@ -0,0 +1,98 @@
+;;;; evol - ring-buffer.lisp
+;;;; Copyright (C) 2010 Alexander Kahl <e-user@fsfe.org>
+;;;; This file is part of evol.
+;;;; evol is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 3 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; evol is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+(in-package :evol)
+
+;;; Operations on ring buffers, as described by Paul Graham in ANSI Common Lisp.
+(defstruct ring-buffer
+ "Structure defining ring buffers utilizing a simple VECTOR of fixed size and
+four indices:
+START: Index of first live value
+END: Index of last live value
+USED: Beginning of current match
+NEW: End of current match"
+ vector (start -1) (used -1) (new -1) (end -1))
+
+(defun new-ring-buffer (length)
+ "new-ring-buffer length => ring-buffer
+
+Create a new RING-BUFFER containing a simple character vector of fixed size
+LENGTH."
+ (make-ring-buffer :vector (make-array length :element-type 'character)))
+
+(defun rbref (buffer index)
+ "rbref buffer index => character or #\Nul
+
+Return character stored at INDEX in ring BUFFER."
+ (char (ring-buffer-vector buffer)
+ (mod index (length (ring-buffer-vector buffer)))))
+
+(defun (setf rbref) (value buffer index)
+ "setf (rbref buffer index) value => value
+
+SETF for RBREF. If INDEX > LENGTH of BUFFER, start over at the beginning."
+ (setf (char (ring-buffer-vector buffer)
+ (mod index (length (ring-buffer-vector buffer))))
+ value))
+
+(defun ring-buffer-insert (buffer value)
+ "ring-buffer-insert buffer value => value
+
+Increment END of BUFFER inserting VALUE at the new index."
+ (setf (rbref buffer (incf (ring-buffer-end buffer)))
+ value))
+
+(defun ring-buffer-reset (buffer)
+ "ring-buffer-reset buffer => end-index
+
+Reset match beginning/end indices USED and NEW in BUFFER to START and END."
+ (setf (ring-buffer-used buffer) (ring-buffer-start buffer)
+ (ring-buffer-new buffer) (ring-buffer-end buffer)))
+
+(defun ring-buffer-pop (buffer)
+ "ring-buffer-pop buffer => character
+
+Increment START of BUFFER returning VALUE at the new index. Additionally, reset
+the BUFFER match indices."
+ (prog1
+ (rbref buffer (incf (ring-buffer-start buffer)))
+ (ring-buffer-reset buffer)))
+
+(defun ring-buffer-next (buffer)
+ "ring-buffer-next buffer => character or nil
+
+Return next match character incrementing USED in BUFFER or simply NIL if none
+are left."
+ (when (< (ring-buffer-used buffer) (ring-buffer-new buffer))
+ (rbref buffer (incf (ring-buffer-used buffer)))))
+
+(defun ring-buffer-clear (buffer)
+ "ring-buffer-clear buffer => -1
+
+Reset all indices of BUFFER to their initial state."
+ (setf (ring-buffer-start buffer) -1
+ (ring-buffer-used buffer) -1
+ (ring-buffer-new buffer) -1
+ (ring-buffer-end buffer) -1))
+
+(defun ring-buffer-flush (buffer)
+ "ring-buffer-flush buffer => string
+
+Flush all unused characters in BUFFER."
+ (with-output-to-string (out)
+ (do ((index (1+ (ring-buffer-used buffer)) (1+ index)))
+ ((> index (ring-buffer-end buffer)))
+ (write-char (rbref buffer index) out))))
Please sign in to comment.
Something went wrong with that request. Please try again.