Function: majutsu-template-define-type

majutsu-template-define-type is a function defined in majutsu-template.el.

Signature

(majutsu-template-define-type NAME &rest PLIST)

Documentation

Register template type NAME with optional metadata PLIST.

Recognised keys: :doc (string), :converts or :converts-to (list).

Source Code

;; Defined in /nix/store/jagqw3nms546pad0gxi5f3wsckk6pji7-emacs-packages-deps/share/emacs/site-lisp/majutsu-template.el
;;;; Type and callable metadata

(eval-and-compile
  (cl-defstruct (majutsu-template--type
                 (:constructor majutsu-template--make-type))
    "Metadata describing a template value type."
    name
    doc
    converts-to)

  (defvar majutsu-template--type-registry (make-hash-table :test #'eq)
    "Registry of known template types keyed by symbol.")

  (defun majutsu-template--normalize-converts (value)
    "Normalize VALUE describing type conversions into a canonical list.
Accepts nil, a list of symbols, or a list of (TYPE . STATUS) pairs."
    (cond
     ((null value) nil)
     ((and (listp value) (consp (car value)) (symbolp (caar value)))
      value)
     ((listp value)
      (mapcar (lambda (type) (cons type 'yes)) value))
     ((symbolp value)
      (list (cons value 'yes)))
     (t
      (user-error "majutsu-template: invalid :converts specification %S" value))))

  (defun majutsu-template-define-type (name &rest plist)
    "Register template type NAME with optional metadata PLIST.
Recognised keys: :doc (string), :converts or :converts-to (list)."
    (cl-check-type name symbol)
    (let* ((doc (plist-get plist :doc))
           (raw-converts (or (plist-get plist :converts)
                             (plist-get plist :converts-to)))
           (converts-to (majutsu-template--normalize-converts raw-converts)))
      (puthash name
               (majutsu-template--make-type
                :name name
                :doc doc
                :converts-to converts-to)
               majutsu-template--type-registry)))

  (defun majutsu-template--lookup-type (name)
    "Return registered type metadata for NAME or nil."
    (gethash name majutsu-template--type-registry))

  (defun majutsu-template--type-ref-normalize (type)
    "Normalize TYPE into a minimal internal type reference."
    (cond
     ((null type) 'Unknown)
     ((and (consp type) (memq (car type) '(:list :option :lambda)))
      (pcase (car type)
        (:list (list :list (majutsu-template--type-ref-normalize (cadr type))))
        (:option (list :option (majutsu-template--type-ref-normalize (cadr type))))
        (:lambda (list :lambda
                       (mapcar #'majutsu-template--type-ref-normalize (cadr type))
                       (majutsu-template--type-ref-normalize (caddr type))))))
     ((or (keywordp type) (symbolp type)) type)
     ((stringp type) (intern type))
     (t 'Unknown)))

  (defun majutsu-template--type-ref-base-type (type)
    "Return nominal base type symbol for TYPE reference."
    (setq type (majutsu-template--type-ref-normalize type))
    (cond
     ((symbolp type)
      (pcase type
        (:self 'Template)
        (:element 'Template)
        (:option-value 'Template)
        (_ type)))
     ((consp type)
      (pcase (car type)
        (:list 'List)
        (:option 'Option)
        (:lambda 'Lambda)
        (_ 'Unknown)))
     (t 'Unknown)))

  (defun majutsu-template--type-ref-dispatch-fragment (type)
    "Return canonical dispatch-name fragment derived from TYPE reference."
    (setq type (majutsu-template--type-ref-normalize type))
    (pcase type
      ((pred symbolp)
       (symbol-name (majutsu-template--type-ref-base-type type)))
      (`(:list ,inner)
       (concat (majutsu-template--type-ref-dispatch-fragment inner) "List"))
      (`(:option ,inner)
       (concat (majutsu-template--type-ref-dispatch-fragment inner) "Opt"))
      (`(:lambda . ,_)
       "Lambda")
      (_
       (symbol-name (majutsu-template--type-ref-base-type type)))))

  (defun majutsu-template--type-ref-dispatch-kind (type)
    "Return internal dispatch kind symbol derived from TYPE reference."
    (intern (majutsu-template--type-ref-dispatch-fragment type))))