| Paste number 60612: | macros |
| Pasted by: | johnny |
| 5 days, 2 hours ago | |
| None | |
| Paste contents: |
| my custom macro syntax: (define-binary-class ether () ((dst :initarg :dst :binary-type (raw-bytes :length 6) :documentation "Destination ethernet address." :initform nil) (src :initarg :src :binary-type (raw-bytes :length 6) :documentation "Source ethernet address." :initform nil) (type :initarg :type :binary-type (raw-bytes :length 2) :documentation "Ethernet type." :initform nil))) generates this: (PROGN (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE) (SETF (GET 'ETHER 'SLOTS) '(DST SRC TYPE)) (SETF (GET 'ETHER 'SUPERCLASSES) 'NIL)) (DEFCLASS ETHER NIL ((DST :INITARG :DST :DOCUMENTATION "Destination ethernet address." :INITFORM NIL) (SRC :INITARG :SRC :DOCUMENTATION "Source ethernet address." :INITFORM NIL) (TYPE :INITARG :TYPE :DOCUMENTATION "Ethernet type." :INITFORM NIL))) (DEFMETHOD READ-OBJECT PROGN ((#:OBJECTVAR ETHER) #:STREAMVAR) (WITH-SLOTS (DST SRC TYPE) #:OBJECTVAR (SETF DST (READ-VALUE 'RAW-BYTES #:STREAMVAR :LENGTH 6)) (SETF SRC (READ-VALUE 'RAW-BYTES #:STREAMVAR :LENGTH 6)) (SETF TYPE (READ-VALUE 'RAW-BYTES #:STREAMVAR :LENGTH 2)))) (DEFMETHOD WRITE-OBJECT PROGN ((#:OBJECTVAR ETHER) #:STREAMVAR) (WITH-SLOTS (DST SRC TYPE) #:OBJECTVAR (WRITE-VALUE 'RAW-BYTES #:STREAMVAR DST :LENGTH 6) (WRITE-VALUE 'RAW-BYTES #:STREAMVAR SRC :LENGTH 6) (WRITE-VALUE 'RAW-BYTES #:STREAMVAR TYPE :LENGTH 2)))) and is this: (defmacro define-binary-class (name (&rest superclasses) slots &rest options) "Define a class with additional :BINARY-TYPE property for every slot." (with-gensyms (objectvar streamvar) `(progn (eval-when (:compile-toplevel :load-toplevel :execute) (setf (get ',name 'slots) ',(mapcar #'first slots)) (setf (get ',name 'superclasses) ',superclasses)) (defclass ,name ,superclasses ,(mapcar #'generate-defclass-slot slots) ,@options) (defmethod read-object progn ((,objectvar ,name) ,streamvar) (with-slots ,(new-class-all-slots slots superclasses) ,objectvar ,@(mapcar #'(lambda (x) (generate-read-value x streamvar)) slots))) (defmethod write-object progn ((,objectvar ,name) ,streamvar) (with-slots ,(new-class-all-slots slots superclasses) ,objectvar ,@(mapcar #'(lambda (x) (generate-write-value x streamvar)) slots)))))) |
This paste has no annotations.