Skip to content

Embed URL

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
defbinstruct first try
(defun read-bytes (n &optional (in *standard-input*))
(apply #'+ (loop for i from 0 to (1- n)
collect (ash (read-byte in) (* 8 (- n (1+ i)))))))
(defmacro remove-keywords (form)
(cond ((null form) '())
((integerp form)
`(read-bytes ,form stream))
((and (consp form) (keywordp (first form)))
(case (first form)
((:list)
`(loop for s from 0 to (1- ,(third form))
collect (remove-keywords ,(second form))))
((:vector)
`(coerce (loop for s from 0 to (1- ,(third form))
collect (remove-keywords ,(second form)))
'vector))
((:struct)
`(,(intern (concatenate 'string "READ-" (string (second form)))) stream))))
(t form)))
(defmacro defbinstruct (name &body attributes)
(labels ((make-reader-name (name-symbol)
(intern (concatenate 'string "READ-" (string name-symbol)))))
(if (and (keywordp (first attributes))
(eql (first attributes) :custom))
(let ((attributes (second attributes))
(body (cddr attributes)))
`(progn
(defstruct ,name
,@attributes)
(defun ,(make-reader-name name) (stream)
,@body)))
(let ((attr-struct-names (remove-if-not #'identity
(mapcar (lambda (attr)
(unless (keywordp (first attr))
(first attr)))
attributes))))
`(progn
(defstruct ,name
,@attr-struct-names)
(defun ,(make-reader-name name) (stream)
(let* (,@(mapcar (lambda (attr)
(destructuring-bind (attr-name . bytes)
(if (keywordp (first attr))
(cons (caadr attr) (cadadr attr))
(cons (first attr) (second attr)))
`(,attr-name ,(if (integerp bytes)
`(read-bytes ,bytes stream)
`(remove-keywords ,bytes)))))
attributes))
(,(intern (concatenate 'string "MAKE-" (string name)))
,@(mapcan (lambda (name) (list (intern (string name) "KEYWORD") name))
attr-struct-names)))))))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.