diff options
| author | 2025-10-23 10:17:00 +0300 | |
|---|---|---|
| committer | 2025-10-23 10:32:36 +0300 | |
| commit | fec434a4e2d0ff65510581e461d87a945d25759a (patch) | |
| tree | 676891233e6121f8801f4751d3e2d1ca7ad4e09c /src/enum.lisp | |
| parent | Use alexandria's make-keyword & symbolicate (diff) | |
| download | ukkoclot-fec434a4e2d0ff65510581e461d87a945d25759a.tar.gz ukkoclot-fec434a4e2d0ff65510581e461d87a945d25759a.tar.xz ukkoclot-fec434a4e2d0ff65510581e461d87a945d25759a.zip | |
Use serapeum's -> & defsubst
Diffstat (limited to 'src/enum.lisp')
| -rw-r--r-- | src/enum.lisp | 13 |
1 files changed, 12 insertions, 1 deletions
diff --git a/src/enum.lisp b/src/enum.lisp index b7cce15..3599174 100644 --- a/src/enum.lisp +++ b/src/enum.lisp | |||
| @@ -4,8 +4,9 @@ | |||
| 4 | (:documentation "Macro for generating an enum type.") | 4 | (:documentation "Macro for generating an enum type.") |
| 5 | (:use :c2cl :iterate) | 5 | (:use :c2cl :iterate) |
| 6 | (:import-from :alexandria :with-gensyms) | 6 | (:import-from :alexandria :with-gensyms) |
| 7 | (:import-from :ukkoclot/src/serializing :fixup-value :parse-value) | 7 | (:import-from :serapeum :->) |
| 8 | (:import-from :string-case :string-case) | 8 | (:import-from :string-case :string-case) |
| 9 | (:import-from :ukkoclot/src/serializing :fixup-value :parse-value) | ||
| 9 | (:local-nicknames | 10 | (:local-nicknames |
| 10 | (:jzon :com.inuoe.jzon)) | 11 | (:jzon :com.inuoe.jzon)) |
| 11 | (:export :define-enum)) | 12 | (:export :define-enum)) |
| @@ -14,36 +15,46 @@ | |||
| 14 | (eval-when (:compile-toplevel :load-toplevel :execute) | 15 | (eval-when (:compile-toplevel :load-toplevel :execute) |
| 15 | (defstruct (field (:constructor make-field%)) name string) | 16 | (defstruct (field (:constructor make-field%)) name string) |
| 16 | 17 | ||
| 18 | (-> make-field (symbol string) field) | ||
| 17 | (defun make-field (name string) | 19 | (defun make-field (name string) |
| 18 | "Better constructor for `field'." | 20 | "Better constructor for `field'." |
| 19 | (make-field% :name name :string string)) | 21 | (make-field% :name name :string string)) |
| 20 | 22 | ||
| 23 | ;; TODO: list-of-fields, list-of-field-specs | ||
| 24 | (-> parse-field-specs (list) list) | ||
| 21 | (defun parse-field-specs (field-specs) | 25 | (defun parse-field-specs (field-specs) |
| 22 | "Parse a list of field specs into a list of fields." | 26 | "Parse a list of field specs into a list of fields." |
| 23 | (iter (for field-spec in field-specs) | 27 | (iter (for field-spec in field-specs) |
| 24 | (collect (apply #'make-field field-spec)))) | 28 | (collect (apply #'make-field field-spec)))) |
| 25 | 29 | ||
| 30 | (-> emit-defconst (field) list) | ||
| 26 | (defun emit-defconst (field) | 31 | (defun emit-defconst (field) |
| 27 | "Emit the `defconstant' statement for a specific field." | 32 | "Emit the `defconstant' statement for a specific field." |
| 28 | `(defconstant ,(field-name field) ',(field-name field))) | 33 | `(defconstant ,(field-name field) ',(field-name field))) |
| 29 | 34 | ||
| 35 | ;; TODO: list-of-fields | ||
| 36 | (-> emit-deftype (symbol list) list) | ||
| 30 | (defun emit-deftype (name fields) | 37 | (defun emit-deftype (name fields) |
| 31 | "Emit the `deftype' statement for the enum." | 38 | "Emit the `deftype' statement for the enum." |
| 32 | `(deftype ,name () | 39 | `(deftype ,name () |
| 33 | '(member ,@(iter (for field in fields) (collect (field-name field)))))) | 40 | '(member ,@(iter (for field in fields) (collect (field-name field)))))) |
| 34 | 41 | ||
| 42 | (-> emit-fixup-method (field) list) | ||
| 35 | (defun emit-fixup-method (field) | 43 | (defun emit-fixup-method (field) |
| 36 | "Emit the `fixup-value' specialization for the enum." | 44 | "Emit the `fixup-value' specialization for the enum." |
| 37 | (with-gensyms (arg) | 45 | (with-gensyms (arg) |
| 38 | `(defmethod fixup-value ((,arg (eql ',(field-name field)))) | 46 | `(defmethod fixup-value ((,arg (eql ',(field-name field)))) |
| 39 | ,(field-string field)))) | 47 | ,(field-string field)))) |
| 40 | 48 | ||
| 49 | (-> emit-jzon-write-method (field) list) | ||
| 41 | (defun emit-jzon-write-method (field) | 50 | (defun emit-jzon-write-method (field) |
| 42 | "Emit the `json:write-value' specialization for the enum." | 51 | "Emit the `json:write-value' specialization for the enum." |
| 43 | (with-gensyms (arg writer) | 52 | (with-gensyms (arg writer) |
| 44 | `(defmethod jzon:write-value ((,writer jzon:writer) (,arg (eql ',(field-name field)))) | 53 | `(defmethod jzon:write-value ((,writer jzon:writer) (,arg (eql ',(field-name field)))) |
| 45 | (jzon:write-value ,writer ,(field-string field))))) | 54 | (jzon:write-value ,writer ,(field-string field))))) |
| 46 | 55 | ||
| 56 | ;; TODO: list-of-fields | ||
| 57 | (-> emit-parse-value (symbol list) list) | ||
| 47 | (defun emit-parse-value (name fields) | 58 | (defun emit-parse-value (name fields) |
| 48 | "Emit the `parse-value' specialization for the enum." | 59 | "Emit the `parse-value' specialization for the enum." |
| 49 | (with-gensyms (source type) | 60 | (with-gensyms (source type) |