From f4b8d8e58b82b29b3cc765c44045b86d6ec44054 Mon Sep 17 00:00:00 2001 From: Uko Kokņevičs Date: Sat, 18 Oct 2025 07:31:03 +0300 Subject: Utilise alexandria:with-gensyms --- src/enum.lisp | 24 +++++++++++++++++++----- src/hash-tables.lisp | 12 ++++++++++-- src/tg/method-macros.lisp | 7 +++---- src/tg/type-macros.lisp | 30 +++++++++++++----------------- 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 (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 (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))))) -- cgit v1.2.3