defstruct-dot-ps.lisp

;; --- src/defines.lispから抜粋 --- ;;

(def-ps-definer defstruct.ps (name-and-options &rest slot-description)
  `(defstruct ,name-and-options ,@slot-description))

;; ついでにdefunとdefvar
(def-ps-definer defun.ps (name args &body body)
  `(defun ,name ,args ,@body))

(def-ps-definer defvar.ps (name initial-value)
  `(defvar ,name ,initial-value))

;; --- src/package.lispから抜粋 --- ;;

;; ダメなコード
;; (defun make-ps-definer (kind name body) 
;;   (let ((register-name (symbolicate '_ kind '_ name)))
;;     (register-ps-func register-name)
;;     `(defun ,register-name ()
;;        (ps. ,body))))

(defun make-ps-definer (kind name body) 
  (let ((register-name (symbolicate '_ kind '_ name)))
    `(progn (register-ps-func ',register-name)
            (defun ,register-name ()
              (ps. ,body)))))

(defun parse-name (name)
  (if (consp name)
      (parse-name (car name))
      name))

(defmacro def-ps-definer (def-name (name &rest rest-args) &body body)
  `(defmacro ,def-name (,name ,@rest-args)
     (make-ps-definer ',def-name (parse-name ,name)
                      ,@body)))