summaryrefslogtreecommitdiff
path: root/src/enum.lisp
diff options
context:
space:
mode:
authorGravatar Uko Kokņevičs2025-10-23 10:17:00 +0300
committerGravatar Uko Kokņevičs2025-10-23 10:32:36 +0300
commitfec434a4e2d0ff65510581e461d87a945d25759a (patch)
tree676891233e6121f8801f4751d3e2d1ca7ad4e09c /src/enum.lisp
parentUse alexandria's make-keyword & symbolicate (diff)
downloadukkoclot-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.lisp13
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)