Utilise alexandria:with-gensyms

4 files changed, 45 insertions, 28 deletions

diff --git a/src/enum.lisp b/src/enum.lisp
index 8943a90..a047c1d 100644
--- a/src/enum.lisp
+++ b/src/enum.lisp
@@ -1,7 +1,9 @@
 ;; SPDX-License-Identifier: EUPL-1.2
 ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
 (defpackage :ukkoclot/enum
+  (:documentation "Macro for generating an enum type.")
   (:use :c2cl :iterate)
+  (:import-from :alexandria :with-gensyms)
   (:import-from :ukkoclot/serializing :fixup-value :parse-value)
   (:import-from :string-case :string-case)
   (:local-nicknames
@@ -13,33 +15,38 @@
   (defstruct (field (:constructor make-field%)) name string)
 
   (defun make-field (name string)
+    "Better constructor for `field'."
     (make-field% :name name :string string))
 
   (defun parse-field-specs (field-specs)
+    "Parse a list of field specs into a list of fields."
     (iter (for field-spec in field-specs)
       (collect (apply #'make-field field-spec))))
 
   (defun emit-defconst (field)
+    "Emit the `defconstant' statement for a specific field."
     `(defconstant ,(field-name field) ',(field-name field)))
 
   (defun emit-deftype (name fields)
+    "Emit the `deftype' statement for the enum."
     `(deftype ,name ()
        '(member ,@(iter (for field in fields) (collect (field-name field))))))
 
   (defun emit-fixup-method (field)
-    (let ((arg (gensym "ARG")))
+    "Emit the `fixup-value' specialization for the enum."
+    (with-gensyms (arg)
       `(defmethod fixup-value ((,arg (eql ',(field-name field))))
          ,(field-string field))))
 
   (defun emit-jzon-write-method (field)
-    (let ((writer (gensym "WRITER"))
-          (arg (gensym "ARG")))
+    "Emit the `json:write-value' specialization for the enum."
+    (with-gensyms (arg writer)
       `(defmethod jzon:write-value ((,writer jzon:writer) (,arg (eql ',(field-name field))))
          (jzon:write-value ,writer ,(field-string field)))))
 
   (defun emit-parse-value (name fields)
-    (let ((type (gensym "TYPE"))
-          (source (gensym "SOURCE")))
+    "Emit the `parse-value' specialization for the enum."
+    (with-gensyms (source type)
       `(defmethod parse-value ((,type (eql ',name)) ,source)
          ;; nil in, nil out
          (when ,source
@@ -48,6 +55,13 @@
                  (collect `(,(field-string field) ,(field-name field))))))))))
 
 (defmacro define-enum (name &body field-specs)
+  "Define a new enumeration type.
+
+FIELD-SPECS := FIELD-SPEC*
+FIELD-SPEC := (FIELD-NAME FIELD-SERIALIZATION)
+
+FIELD-NAME is the symbol name of the field.
+FIELD-SERIALIZATION is the string serialization of the field."
   (let ((fields (parse-field-specs field-specs)))
     `(progn
        ,@(iter (for field in fields)
diff --git a/src/hash-tables.lisp b/src/hash-tables.lisp
index 9e41b26..d3b66dd 100644
--- a/src/hash-tables.lisp
+++ b/src/hash-tables.lisp
@@ -1,19 +1,24 @@
 ;; SPDX-License-Identifier: EUPL-1.2
 ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
 (defpackage :ukkoclot/hash-tables
+  (:documentation "Utilities for dealing with hash tables.")
   (:use :c2cl)
+  (:import-from :alexandria :with-gensyms)
   (:export :alist->hash-table :gethash-lazy :plist->hash-table))
 (in-package :ukkoclot/hash-tables)
 
 (defun alist->hash-table (alist &rest args &key &allow-other-keys)
+  "Turn an association list into a hash table.
+
+All key arguments are passed on to `make-hash-table'."
   (let ((ht (apply #'make-hash-table args)))
     (loop for (key . value) in alist do
       (setf (gethash key ht) value))
     ht))
 
 (defmacro gethash-lazy (key hash-table default-lazy)
-  (let ((unique (gensym "UNIQUE-"))
-        (res (gensym "RES-")))
+  "`gethash' alternative with lazily evaluated default value."
+  (with-gensyms (res unique)
     `(let* ((,unique ',unique)
             (,res (gethash ,key ,hash-table ,unique)))
        (if (eq ,res ,unique)
@@ -21,6 +26,9 @@
            ,res))))
 
 (defun plist->hash-table (plist &rest args &key &allow-other-keys)
+  "Turn a property list into a hash table.
+
+All key arguments are passed on to `make-hash-table'."
   (let ((ht (apply #'make-hash-table args)))
     (loop for (key value) on plist by #'cddr do
       (setf (gethash key ht) value))
diff --git a/src/tg/method-macros.lisp b/src/tg/method-macros.lisp
index 215b2ab..b924e15 100644
--- a/src/tg/method-macros.lisp
+++ b/src/tg/method-macros.lisp
@@ -3,6 +3,7 @@
 (defpackage :ukkoclot/tg/method-macros
   (:documentation "Macros for easy defining TG methods.")
   (:use :c2cl :iterate)
+  (:import-from :alexandria :with-gensyms)
   (:import-from :com.dieggsy.f-string :enable-f-strings)
   (:import-from :serapeum :take)
   (:import-from :ukkoclot/state :bot)
@@ -51,13 +52,11 @@
     `(,(param-name param) ,(param-default param)))
 
   (defun emit-defun (name return-type params method)
-    (let ((revparams (reverse params))
-          (args (gensym "ARGS"))
-          (bot (gensym "BOT")))
+    (with-gensyms (args bot)
       `(defun ,name (,bot &key ,@(iter (for param in params) ; lint:suppress lambda-list-invalid
                                        (collect (emit-defun-arg param))))
          (let (,args)
-           ,@(iter (for param in revparams)
+           ,@(iter (for param in (reverse params))
                    (collect (if (param-skip-if-default param)
                                 `(unless (equal ,(param-name param)
                                                 ,(param-default param))
diff --git a/src/tg/type-macros.lisp b/src/tg/type-macros.lisp
index 390781f..5f99cba 100644
--- a/src/tg/type-macros.lisp
+++ b/src/tg/type-macros.lisp
@@ -3,6 +3,7 @@
 (defpackage :ukkoclot/tg/type-macros
   (:documentation "Macros for easy defining TG types.")
   (:use :c2cl :iterate)
+  (:import-from :alexandria :with-gensyms)
   (:import-from :com.dieggsy.f-string :enable-f-strings)
   (:import-from :ukkoclot/serializing :parse-value)
   (:import-from :ukkoclot/hash-tables :gethash-lazy)
@@ -54,7 +55,7 @@
     `(list ,(field-hash-key field) ,value ',(field-type field)))
 
   (defun emit-collect-nondefault-fields (name fields obj collector)
-    (let ((value (gensym "VALUE")))
+    (with-gensyms (value)
       (iter (for field in (reverse fields))
             (collect
                 (if (field-skip-if-default field)
@@ -70,8 +71,7 @@
     `(gethash-lazy ,(field-hash-key field) ,source ,(field-default field)))
 
   (defun emit-jzon-coerced-fields (name fields)
-    (let ((obj (gensym "OBJ"))
-          (result (gensym "RESULT")))
+    (with-gensyms (obj result)
       `(defmethod jzon:coerced-fields ((,obj ,name))
          (let (,result)
            ,@(emit-collect-nondefault-fields
@@ -85,9 +85,8 @@
       (parse-value ',(field-type field) ,(emit-gethash field source))))
 
   (defun emit-parse-value (name fields)
-    (let ((type-sym (gensym "TYPE-SYM"))
-          (source (gensym "SOURCE")))
-      `(defmethod parse-value ((,type-sym (eql ',name)) ,source)
+    (with-gensyms (source type)
+      `(defmethod parse-value ((,type (eql ',name)) ,source)
          (let (,@(iter (for field in fields)
                        (collect (emit-let-gethash field source))))
            (,(type-constructor name)
@@ -95,10 +94,7 @@
                     (appending (emit-constructor-args field))))))))
 
   (defun emit-printer (name printer-name fields)
-    (let ((obj (gensym "OBJ"))
-          (stream (gensym "STREAM"))
-          (depth (gensym "DEPTH"))
-          (pprint-args (gensym "PPRINT-ARGS")))
+    (with-gensyms (depth obj pprint-args stream)
       `(defun ,printer-name (,obj ,stream ,depth) ; lint:suppress lambda-list-invalid
          (declare (ignore ,depth))
          (let (,pprint-args)
@@ -117,10 +113,10 @@
     `(,(field-name field) ,(field-default field) :type ,(field-type field))))
 
 (defmacro define-tg-type (name &body field-specs)
-  (let ((fields (parse-field-specs field-specs))
-        (printer-name (gensym "PRINTER")))
-    `(progn
-       ,(emit-struct name printer-name fields)
-       ,(emit-printer name printer-name fields)
-       ,(emit-parse-value name fields)
-       ,(emit-jzon-coerced-fields name fields))))
+  (let ((fields (parse-field-specs field-specs)))
+    (with-gensyms (printer)
+      `(progn
+         ,(emit-struct name printer fields)
+         ,(emit-printer name printer fields)
+         ,(emit-parse-value name fields)
+         ,(emit-jzon-coerced-fields name fields)))))