cl-rw

Layered streams for Common Lisp
git clone https://logand.com/git/cl-rw.git/
Log | Files | Refs

commit 426b515da81d4c68333b233c4ee4395ac6d94373
Author: Tomas Hlavaty <tom@logand.com>
Date:   Sat, 10 Aug 2013 19:01:04 +0200

initial commit

Diffstat:
A.gitignore | 1+
Acl-rw.asd | 38++++++++++++++++++++++++++++++++++++++
Arw.lisp | 171+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
3 files changed, 210 insertions(+), 0 deletions(-)

diff --git a/.gitignore b/.gitignore @@ -0,0 +1 @@ +*~ diff --git a/cl-rw.asd b/cl-rw.asd @@ -0,0 +1,38 @@ +;;; -*- lisp; -*- + +;;; Copyright (C) 2013 Tomas Hlavaty <tom@logand.com> +;;; +;;; Permission is hereby granted, free of charge, to any person +;;; obtaining a copy of this software and associated documentation +;;; files (the "Software"), to deal in the Software without +;;; restriction, including without limitation the rights to use, copy, +;;; modify, merge, publish, distribute, sublicense, and/or sell copies +;;; of the Software, and to permit persons to whom the Software is +;;; furnished to do so, subject to the following conditions: +;;; +;;; The above copyright notice and this permission notice shall be +;;; included in all copies or substantial portions of the Software. +;;; +;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT +;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, +;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER +;;; DEALINGS IN THE SOFTWARE. + +(defpackage :cl-rw-system + (:use :asdf :cl)) + +(in-package :cl-rw-system) + +(asdf:defsystem :cl-rw + :description "cl-rw -- Composable readers and writers for Common Lisp." + :version "" + :author "Tomas Hlavaty" + :maintainer "Tomas Hlavaty" + :licence "MIT" + :depends-on () + :serial t + :components ((:file "rw"))) diff --git a/rw.lisp b/rw.lisp @@ -0,0 +1,171 @@ +;;; Copyright (C) 2013 Tomas Hlavaty <tom@logand.com> +;;; +;;; Permission is hereby granted, free of charge, to any person +;;; obtaining a copy of this software and associated documentation +;;; files (the "Software"), to deal in the Software without +;;; restriction, including without limitation the rights to use, copy, +;;; modify, merge, publish, distribute, sublicense, and/or sell copies +;;; of the Software, and to permit persons to whom the Software is +;;; furnished to do so, subject to the following conditions: +;;; +;;; The above copyright notice and this permission notice shall be +;;; included in all copies or substantial portions of the Software. +;;; +;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT +;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, +;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER +;;; DEALINGS IN THE SOFTWARE. + +(defpackage :rw + (:use :cl) + (:export :byte-reader + :byte-writer + :char-reader + :char-writer + :copy + :next + :next-octets + :next-u16 + :next-u32 + :next-u8 + :peek + :peek-reader + :search-reader + :skip + :reader + :till + :write-octets + :write-u32 + :write-u16 + :write-u8)) + +(in-package :rw) + +(defun next (reader) + (funcall reader)) + +(defun peek (reader) + (funcall reader 'peek)) + +(defmacro let? (k v &body body) + `(let ((,k ,v)) + (when ,k ,@body))) + +(defun reader (x) + (etypecase x + (list (lambda () (pop x))) + (vector (let ((i 0) + (n (length x))) + (lambda () + (when (< i n) + (prog1 (aref x i) + (incf i)))))))) + +(defun char-reader (stream) + (lambda () (read-char stream nil nil))) + +(defun byte-reader (stream) + (lambda () (read-byte stream nil nil))) + +(defun skip (reader n) + (dotimes (i n reader) + (next reader))) + +(defun till (reader &optional markers) + (let (x) + (loop + until (member (setq x (next reader)) (or markers '(nil))) + collect x))) + +;;(till (skip (reader '(0 1 2 3 4)) 1) '(3)) +;;(till (skip (reader #(0 1 2 3 4)) 1) '(3)) +;;(with-open-file (s "printers.html") (till (char-reader s) '(#\>))) + +(defun peek-reader (reader) + (let (x) + (lambda (&optional msg) + (ecase msg + (peek (or x (setq x (next reader)))) + ((nil) (prog1 (if x x (next reader)) + (setq x nil))))))) + +(defun search-reader (reader needle) + (let ((all (till reader)) ;; TODO optimize? use kmp algorithm + (start 0)) + (lambda () + (let? i (search needle all :start2 start) + (setq start (1+ i)) + (values i all))))) + +#+nil +(with-open-file (s "printers.html") + (till (search-reader (char-reader s) '#.(coerce "/printers/" 'list)))) + +(defun next-u8 (reader) + (let? x (next reader) + (assert (<= 0 x 255)) + x)) + +(defun next-u16 (reader) ;; TODO little endian + (let? x (next-u8 reader) + (let? y (next-u8 reader) + (logior (ash x 8) y)))) + +(defun next-u32 (reader) ;; TODO little endian + (let? x (next-u16 reader) + (let? y (next-u16 reader) + (logior (ash x 16) y)))) + +(defun next-octets (reader n) + (let ((z (make-array n + :element-type '(unsigned-byte 8) + :initial-element 0))) + (dotimes (i n z) + (let ((x (next-u8 reader))) + (if (zerop i) + (unless x (return-from next-octets nil)) + (assert x)) + (setf (aref z i) x))))) + +;; TODO next-u64|128 +;; TODO next-s8|16|32|64|128 + +(defun char-writer (stream) + (lambda (x) + (write-char x stream))) + +(defun byte-writer (stream) + (lambda (x) + (write-byte x stream))) + +(defun write-u8 (writer x) + (assert (<= 0 x 255)) + (funcall writer x)) + +(defun write-u16 (writer x) ;; TODO little endian + (assert (<= 0 x 65535)) + (write-u8 writer (ash x -8)) + (write-u8 writer (logand #xff x))) + +(defun write-u32 (writer x) ;; TODO little endian + (assert (<= 0 x #.(1- (expt 2 32)))) + (write-u16 writer (ash x -16)) + (write-u16 writer (logand #xffff x))) + +(defun copy (reader writer) + (do (x) + ((not (setq x (next-u8 reader)))) + (write-u8 writer x))) + +(defun write-octets (writer x) + (etypecase x + (stream (copy (byte-reader x) writer)) + (list (dolist (i x) (write-u8 writer i))) + (vector (dotimes (i (length x)) (write-u8 writer (aref x i)))))) + +;; TODO write-u64|128 +;; TODO write-s8|16|32|64|128