From f0883e054c7180b872f2732417c28b15e76a725a Mon Sep 17 00:00:00 2001 From: Alexander Kahl Date: Sun, 7 Feb 2010 22:30:56 +0100 Subject: [PATCH] added ring buffer implementation added lisp reader heredoc implementation based on ring buffers --- src/heredoc.lisp | 59 ++++++++++++++++++++++++++ src/ring-buffer.lisp | 98 ++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 157 insertions(+) create mode 100644 src/heredoc.lisp create mode 100644 src/ring-buffer.lisp diff --git a/src/heredoc.lisp b/src/heredoc.lisp new file mode 100644 index 0000000..25f4414 --- /dev/null +++ b/src/heredoc.lisp @@ -0,0 +1,59 @@ +;;;; evol - heredoc.lisp +;;;; Copyright (C) 2010 Alexander Kahl +;;;; 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 . + +(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) diff --git a/src/ring-buffer.lisp b/src/ring-buffer.lisp new file mode 100644 index 0000000..7e0b3b9 --- /dev/null +++ b/src/ring-buffer.lisp @@ -0,0 +1,98 @@ +;;;; evol - ring-buffer.lisp +;;;; Copyright (C) 2010 Alexander Kahl +;;;; 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 . + +(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))))