From fec434a4e2d0ff65510581e461d87a945d25759a Mon Sep 17 00:00:00 2001
From: Uko Kokņevičs
Date: Thu, 23 Oct 2025 10:17:00 +0300
Subject: Use serapeum's -> & defsubst

---
 src/tg/type-macros.lisp | 28 +++++++++++++++++++++++++---
 1 file changed, 25 insertions(+), 3 deletions(-)

(limited to 'src/tg/type-macros.lisp')

diff --git a/src/tg/type-macros.lisp b/src/tg/type-macros.lisp
index ea35f48..02437ec 100644
--- a/src/tg/type-macros.lisp
+++ b/src/tg/type-macros.lisp
@@ -5,6 +5,7 @@
   (:use :c2cl :iterate)
   (:import-from :alexandria :make-keyword :symbolicate :with-gensyms)
   (:import-from :com.dieggsy.f-string :enable-f-strings)
+  (:import-from :serapeum :->)
   (:import-from :str)
   (:import-from :ukkoclot/src/serializing :parse-value)
   (:import-from :ukkoclot/src/hash-tables :gethash-lazy)
@@ -22,6 +23,7 @@
   (defparameter +unique+ (gensym))
 
   ;; TODO: Fix optional-and-key !
+  (-> make-field (symbol t &optional t &key (:skip-if-default boolean)) field)
   (defun make-field (name type          ; lint:suppress avoid-optional-and-key
                      &optional (default +unique+)
                      &key (skip-if-default (not (eq default +unique+))))
@@ -33,28 +35,36 @@
                    :default default
                    :skip-if-default skip-if-default)))
 
+  (-> type-constructor (symbol) symbol)
   (defun type-constructor (name)
     (symbolicate "MAKE-" name))
 
+  (-> field-accessor (symbol field) symbol)
   (defun field-accessor (name field)
     (symbolicate name "-" (field-name field)))
 
+  (-> field-hash-key (field) string)
   (defun field-hash-key (field)
     (str:snake-case (field-name field)))
 
+  (-> field-keyword (field) keyword)
   (defun field-keyword (field)
     (make-keyword (field-name field)))
 
+  ;; TODO: list-of-fields, list-of-field-specs
+  (-> parse-field-specs (list) list)
   (defun parse-field-specs (field-specs)
     (iter (for field-spec in field-specs)
           (collect (apply #'make-field field-spec))))
 
-  (defun emit-append-to-pprint-args (field value pprint-args)
-    `(setf ,pprint-args (list* ',(field-name field) ,value ,pprint-args)))
-
+  (-> emit-coerced-field (field (or symbol list)) list)
   (defun emit-coerced-field (field value)
     `(list ,(field-hash-key field) ,value ',(field-type field)))
 
+  ;; TODO: list-of-fields
+  (-> emit-collect-nondefault-fields
+      (symbol list symbol (function (field (or symbol list)) list))
+      list)
   (defun emit-collect-nondefault-fields (name fields obj collector)
     (with-gensyms (value)
       (iter (for field in (reverse fields))
@@ -65,12 +75,16 @@
                          ,(funcall collector field value)))
                     (funcall collector field (list (field-accessor name field) obj)))))))
 
+  (-> emit-constructor-args (field) list)
   (defun emit-constructor-args (field)
     `(,(field-keyword field) ,(field-name field)))
 
+  (-> emit-gethash (field symbol) list)
   (defun emit-gethash (field source)
     `(gethash-lazy ,(field-hash-key field) ,source ,(field-default field)))
 
+  ;; TODO: list-of-fields
+  (-> emit-jzon-coerced-fields (symbol list) list)
   (defun emit-jzon-coerced-fields (name fields)
     (with-gensyms (obj result)
       `(defmethod jzon:coerced-fields ((,obj ,name))
@@ -81,10 +95,13 @@
                 `(push ,(emit-coerced-field field value) ,result)))
            ,result))))
 
+  (-> emit-let-gethash (field symbol) list)
   (defun emit-let-gethash (field source)
     `(,(field-name field)
       (parse-value ',(field-type field) ,(emit-gethash field source))))
 
+  ;; TODO: list-of-fields
+  (-> emit-parse-value (symbol list) list)
   (defun emit-parse-value (name fields)
     (with-gensyms (source type)
       `(defmethod parse-value ((,type (eql ',name)) ,source)
@@ -94,6 +111,8 @@
             ,@(iter (for field in fields)
                     (appending (emit-constructor-args field))))))))
 
+  ;; TODO: list-of-fields
+  (-> emit-printer (symbol symbol list) list)
   (defun emit-printer (name printer-name fields)
     (with-gensyms (depth obj pprint-args stream)
       `(defun ,printer-name (,obj ,stream ,depth) ; lint:suppress lambda-list-invalid
@@ -105,11 +124,14 @@
                 `(setf ,pprint-args (list* ',(field-name field) ,value ,pprint-args))))
            (format ,stream "~A~<[~;~@{~_~1I~W = ~W~^, ~}~;]~:>" ',name ,pprint-args)))))
 
+  ;; TODO: list-of-fields
+  (-> emit-struct (symbol symbol list) list)
   (defun emit-struct (name printer-name fields)
     `(defstruct (,name (:print-function ,printer-name))
        ,@(iter (for field in fields)
                (collect (emit-struct-field field)))))
 
+  (-> emit-struct-field (field) list)
   (defun emit-struct-field (field)
     `(,(field-name field) ,(field-default field) :type ,(field-type field))))
 
-- 
cgit v1.2.3