Why copy and paste when the computer can do it?

binary.lisp

@@ -4,7 +4,6 @@
 
 ;;; "binary" goes here. Hacks and glory await!
 
-
 (defun octets (stream length)
   "Read length bytes from the stream."
   (let ((bin (make-array length :element-type '(unsigned-byte 8))))
@@ -40,36 +39,6 @@ provided."
 (defun write-uint (stream n size &key (endian :little))
   (write-sequence (uint-to-bytes n size :endian endian) stream))
 
-(defmacro define-unsigned-reader (const-name)
-  (let ((docstring
-         (format nil
-                 "Read an unsigned ~A-bit integer from a stream."
-                 (subseq  (format nil "~A" const-name) 1))))
-    `(export (defun ,(intern (format nil "READ-~A" const-name))
-         (stream &key (endian :little))
-       ,docstring
-       (read-uint stream ,const-name :endian endian)))))
-
-(defmacro define-unsigned-writer (const-name)
-  (let ((docstring
-         (format nil
-                 "Write an unsigned ~A-bit integer to a stream."
-                 (subseq  (format nil "~A" const-name) 1))))
-    `(defun ,(intern (format nil "WRITE-~A" const-name))
-         (stream n &key (endian :little))
-       ,docstring
-       (write-uint stream n ,const-name :endian endian))))
-
-(defmacro defunsigned (const-name size)
-  `(progn
-     (defconstant ,const-name ,size)
-     (define-unsigned-reader ,const-name)
-     (define-unsigned-writer ,const-name)))
-
-(defunsigned U32 4)
-(defunsigned U16 2)
-(defunsigned U8 1)
-
 (defun twos-complement (n size)
   (if (zerop (logand (ash 1 (* (- size 1) 8)) n))
       n
@@ -93,32 +62,47 @@ integer."
   (write-sequence (int-to-bytes n size :endian endian)
 		  stream))
 
-(defmacro define-signed-reader (const-name)
+(defmacro define-reader (const-name)
-  (let ((docstring
+  (let* ((signed (equal #\I (elt (symbol-name const-name) 0)))
+	 (docstring
          (format nil
-                 "Read a signed ~A-bit integer from a stream."
+                 "Read ~A ~Asigned ~A-bit integer from a stream."
-                 (subseq  (format nil "~A" const-name) 1))))
+		 (if signed "a" "an")
-    `(defun ,(intern (format nil "READ-~A" const-name))
+		 (if signed "" "un")
+		 (subseq (symbol-name const-name) 1))))
+    `(export
+      (defun ,(intern (format nil "READ-~A" const-name))
 	  (stream &key (endian :little))
 	,docstring
-       (read-int stream ,const-name :endian endian))))
+	(,(if signed 'read-int 'read-uint) stream ,const-name :endian endian)))))
 
-(defmacro define-signed-writer (const-name)
+(defmacro define-writer (const-name)
-  (let ((docstring
+  (let* ((signed (equal #\I (elt (symbol-name const-name) 0)))
+	 (docstring
          (format nil
-                 "Write a signed ~A-bit integer to a stream."
+                 "Write ~A ~Asigned ~A-bit integer to a stream."
-                 (subseq  (format nil "~A" const-name) 1))))
+		 (if signed "a" "an")
-    `(defun ,(intern (format nil "WRITE-~A" const-name))
+		 (if signed "" "un")
+		 (subseq (symbol-name const-name) 1))))
+    `(export
+      (defun ,(intern (format nil "WRITE-~A" const-name))
 	  (stream n &key (endian :little))
 	,docstring
-       (write-int stream n ,const-name :endian endian))))
+	(,(if signed 'write-int 'write-uint) stream n ,const-name :endian endian)))))
 
-(defmacro defsigned (const-name size)
+(defmacro define-type (const-name)
+  (let ((size (/ (parse-integer (subseq (symbol-name const-name) 1)) 8)))
    `(progn
       (defconstant ,const-name ,size)
-     (define-signed-reader ,const-name)
+      (export ',const-name :binary)
-     (define-signed-writer ,const-name)))
+      (define-reader ,const-name)
+      (define-writer ,const-name))))
 
-(defsigned I32 4)
+(define-type U64)
-(defsigned I16 2)
+(define-type I64)
-(defsigned I8 1)
+(define-type U32)
+(define-type I32)
+(define-type U16)
+(define-type I16)
+(define-type U8)
+(define-type I8)

package.lisp

@@ -6,24 +6,5 @@
 	   #:uint-from-bytes
 	   #:uint-to-bytes
 	   #:int-from-bytes
-	   #:int-to-bytes
+	   #:int-to-bytes))
-	   #:read-u32
-	   #:write-u32
-	   #:read-u16
-	   #:write-u16
-	   #:read-u8
-	   #:write-u8
-	   #:read-i32
-	   #:write-i32
-	   #:read-i16
-	   #:write-i16
-	   #:read-i8
-	   #:write-i8
-	   #:U32
-	   #:U16
-	   #:U8
-	   #:I32
-	   #:I16
-	   #:I8
-	   ))