Move derive-* macros to dedicated packages

derive/equality.lisp

@@ -0,0 +1,37 @@
+(defpackage #:meta-definitions.derive.equality
+  (:use #:cl)
+  (:import-from #:meta-definitions #:declarations)
+  (:export #:derive-equality))
+
+(in-package #:meta-definitions.derive.equality)
+
+(defmacro derive-equality (class-name)
+  (let ((spec (gethash (symbol-name class-name) declarations)))
+    (destructuring-bind (class-spec slots-spec)
+	spec
+      (declare (ignore class-spec))
+      (let* ((slots (cdr slots-spec))
+	     (check-pairs (mapcar (lambda (slot)
+				    (let* ((slot-name (car slot))
+					   (attrs (cdr slot))
+					   (slot-type (getf attrs :type))
+					   (is-nullable (member 'null (uiop:ensure-list slot-type)))
+					   (eq-fn (getf attrs :equality-fn))
+					   (slot-eq (if eq-fn eq-fn ''equal))
+					   (base `(funcall ,slot-eq
+							   (slot-value a ',slot-name)
+							   (slot-value b ',slot-name))))
+				      (if is-nullable
+					  `(if (and (not (equal (slot-value a ',slot-name) :null))
+						    (not (equal (slot-value b ',slot-name) :null)))
+					       ,base
+					       (funcall 'equal
+							(slot-value a ',slot-name)
+							(slot-value b ',slot-name)))
+					  base)))
+				  slots))
+	     (eq-name (intern (string-upcase (concatenate 'string (symbol-name class-name) "=")))))
+	`(progn
+	   (defun ,eq-name (a b)
+	     (and ,@check-pairs))
+	   (export ',eq-name))))))

derive/print-object.lisp

@@ -0,0 +1,18 @@
+(defpackage #:meta-definitions.derive.print-object
+  (:use #:cl)
+  (:import-from #:meta-definitions #:declarations)
+  (:export #:derive-print-object))
+
+(in-package #:meta-definitions.derive.print-object)
+
+(defmacro derive-print-object (class-name)
+  "Defines a print-object method for the given class."
+  (let ((spec (gethash (symbol-name class-name) declarations)))
+    (destructuring-bind (class-spec slots-spec)
+	spec
+      (let* ((slots (mapcar #'car (cdr slots-spec))))
+	`(defmethod print-object ((object ,class-name) stream)
+	   (format stream "#<~A~%" ',(caadr class-spec))
+	   (dolist (slot ',slots)
+	     (format stream "  ~A: ~A~%" slot (slot-value object slot)))
+	   (format stream ">"))))))

derive/readers.lisp

@@ -0,0 +1,30 @@
+(defpackage #:meta-definitions.derive.readers
+  (:use #:cl)
+  (:import-from #:meta-definitions #:declarations)
+  (:export #:derive-readers))
+
+(in-package #:meta-definitions.derive.readers)
+
+(defmacro derive-readers (class-name)
+  (let ((spec (gethash (symbol-name class-name) declarations)))
+    (destructuring-bind (class-spec slots-spec)
+	spec
+      (declare (ignore class-spec))
+      (let ((slots (cdr slots-spec)))
+	`(progn
+	   ,@(mapcar (lambda (slot)
+		       (destructuring-bind (slot-name &rest attrs)
+			   slot
+			 (declare (ignore attrs))
+			 (let* ((sym-name (string-upcase
+					   (concatenate
+					    'string
+					    (symbol-name class-name)
+					    "-"
+					    (symbol-name slot-name))))
+				(reader-name (intern sym-name)))
+			   `(progn
+			      (defun ,reader-name (obj)
+				(slot-value obj ',slot-name))
+			      (export ',reader-name)))))
+		     slots))))))

meta-definitions.derive.equality.asd

@@ -0,0 +1,8 @@
+(in-package :cl-user)
+
+(asdf:defsystem #:meta-definitions.derive.equality
+  :license "Unlicense"
+  :author "Bruno Dias"
+  :serial t
+  :depends-on (#:meta-definitions)
+  :components ((:file "derive/equality")))

meta-definitions.derive.print-object.asd

@@ -0,0 +1,8 @@
+(in-package :cl-user)
+
+(asdf:defsystem #:meta-definitions.derive.print-object
+  :license "Unlicense"
+  :author "Bruno Dias"
+  :serial t
+  :depends-on (#:meta-definitions)
+  :components ((:file "derive/print-object")))

meta-definitions.derive.readers.asd

@@ -0,0 +1,8 @@
+(in-package :cl-user)
+
+(asdf:defsystem #:meta-definitions.derive.readers
+  :license "Unlicense"
+  :author "Bruno Dias"
+  :serial t
+  :depends-on (#:meta-definitions)
+  :components ((:file "derive/readers")))

meta-definitions.derives.asd

@@ -0,0 +1,8 @@
+(in-package :cl-user)
+
+(asdf:defsystem #:meta-definitions.derives
+  :license "Unlicense"
+  :author "Bruno Dias"
+  :depends-on (#:meta-definitions.derive.readers
+               #:meta-definitions.derive.print-object
+               #:meta-definitions.derive.equality))

package.lisp

@@ -3,9 +3,6 @@
   (:export
    #:declarations
    #:define-class
-   #:derive-readers
-   #:derive-print-object
-   #:derive-equality
    #:define-from
    #:define))
 
@@ -58,73 +55,6 @@
 	       ,slots)
 	     (closer-mop:ensure-finalized (find-class ',(caadr class-spec)))))))))
 
-(defmacro derive-readers (class-name)
-  (let ((spec (gethash (symbol-name class-name) declarations)))
-    (destructuring-bind (class-spec slots-spec)
-	spec
-      (declare (ignore class-spec))
-      (let ((slots (cdr slots-spec)))
-	`(progn
-	   ,@(mapcar (lambda (slot)
-		       (destructuring-bind (slot-name &rest attrs)
-			   slot
-			 (declare (ignore attrs))
-			 (let* ((sym-name (string-upcase
-					   (concatenate
-					    'string
-					    (symbol-name class-name)
-					    "-"
-					    (symbol-name slot-name))))
-				(reader-name (intern sym-name)))
-			   `(progn
-			      (defun ,reader-name (obj)
-				(slot-value obj ',slot-name))
-			      (export ',reader-name)))))
-		     slots))))))
-
-(defmacro derive-print-object (class-name)
-  "Defines a print-object method for the given class."
-  (let ((spec (gethash (symbol-name class-name) declarations)))
-    (destructuring-bind (class-spec slots-spec)
-	spec
-      (let* ((slots (mapcar #'car (cdr slots-spec))))
-	`(defmethod print-object ((object ,class-name) stream)
-	   (format stream "#<~A~%" ',(caadr class-spec))
-	   (dolist (slot ',slots)
-	     (format stream "  ~A: ~A~%" slot (slot-value object slot)))
-	   (format stream ">"))))))
-
-(defmacro derive-equality (class-name)
-  (let ((spec (gethash (symbol-name class-name) declarations)))
-    (destructuring-bind (class-spec slots-spec)
-	spec
-      (declare (ignore class-spec))
-      (let* ((slots (cdr slots-spec))
-	     (check-pairs (mapcar (lambda (slot)
-				    (let* ((slot-name (car slot))
-					   (attrs (cdr slot))
-					   (slot-type (getf attrs :type))
-					   (is-nullable (member 'null (uiop:ensure-list slot-type)))
-					   (eq-fn (getf attrs :equality-fn))
-					   (slot-eq (if eq-fn eq-fn ''equal))
-					   (base `(funcall ,slot-eq
-							   (slot-value a ',slot-name)
-							   (slot-value b ',slot-name))))
-				      (if is-nullable
-					  `(if (and (not (equal (slot-value a ',slot-name) :null))
-						    (not (equal (slot-value b ',slot-name) :null)))
-					       ,base
-					       (funcall 'equal
-							(slot-value a ',slot-name)
-							(slot-value b ',slot-name)))
-					  base)))
-				  slots))
-	     (eq-name (intern (string-upcase (concatenate 'string (symbol-name class-name) "=")))))
-	`(progn
-	   (defun ,eq-name (a b)
-	     (and ,@check-pairs))
-	   (export ',eq-name))))))
-
 (defmacro define-from (class-name name selected-slots &optional extra-slots)
   (let ((spec (gethash (symbol-name class-name) declarations)))
     (destructuring-bind (class-spec slots-spec)

readme.md

@@ -41,9 +41,9 @@ Meta is library to create infinite types and derivations.
 ;;                :type local-time:timestamp)
 ;;    (deleted-at :type (or local-time:timestamp null))))
 
-(meta:derive-readers user)
-(meta:derive-equality user)
-(meta:derive-print-object user)
+(meta-definitions.derive.readers:derive-readers user)
+(meta-definitions.derive.equality:derive-equality user)
+(meta-definitions.derive.print-object:derive-print-object user)
 
 ;; create a input type create user 
 
@@ -54,8 +54,8 @@ Meta is library to create infinite types and derivations.
 ;; (defclass create-user ()
 ;;   ((name :type string)))
 
-(meta:derive-readers create-user)
-(meta:derive-print-object create-user)
+(meta-definitions.derive.readers:derive-readers create-user)
+(meta-definitions.derive.print-object:derive-print-object create-user)
 (derive-validation create-user)
 ```