commit 426b515da81d4c68333b233c4ee4395ac6d94373
Author: Tomas Hlavaty <tom@logand.com>
Date: Sat, 10 Aug 2013 19:01:04 +0200
initial commit
Diffstat:
| A | .gitignore | | | 1 | + |
| A | cl-rw.asd | | | 38 | ++++++++++++++++++++++++++++++++++++++ |
| A | rw.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
