Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
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)
`(loop for s from 0 to (1- ,(third form))
collect (remove-keywords ,(second form))))
`(coerce (loop for s from 0 to (1- ,(third form))
collect (remove-keywords ,(second form)))
`(,(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)))
(defstruct ,name
(defun ,(make-reader-name name) (stream)
(let ((attr-struct-names (remove-if-not #'identity
(mapcar (lambda (attr)
(unless (keywordp (first attr))
(first attr)))
(defstruct ,name
(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)))))
(,(intern (concatenate 'string "MAKE-" (string name)))
,@(mapcan (lambda (name) (list (intern (string name) "KEYWORD") name))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment