gistfile1.cl

;;; struct の slot に obj.slot でアクセスする。

(require "struct")
(require "symbol-macrolet")

(defun keyword (name)
  (intern (string name) :keyword))

(defun %slot-value (object slot-name)
  (si:*slot-value object slot-name))

(defsetf %slot-value si:*set-slot-value)


(defparameter *dot-notation-regexp*
  (compile-regexp "^\\(.+\\)\\.\\([^\\.]+\\)$"))

(defun dot-notation-p (symbol)
  (and (symbolp symbol)
       (string-match *dot-notation-regexp* (symbol-name symbol))))

(defun parse-dot-notation (form)
  (when (dot-notation-p form)
    (values (intern (match-string 1) (symbol-package form))
            (keyword (match-string 2)))))

(defun expand-dot-notation (form)
  (multiple-value-bind (object slot)
      (parse-dot-notation form)
    `(%slot-value
      ,(if (dot-notation-p object)
           (expand-dot-notation object)
         object)
      ,slot)))


(defmacro with-dot-notation (&body body)
  `(symbol-macrolet
       (,@(remove-if #'null
            (mapcar (lambda (atom)
                      (when (dot-notation-p atom)
                        `(,atom ,(expand-dot-notation atom))))
              (flatten body))))
     ,@body))


;;; 使ってみる

(defstruct person
  id name address age job)
=> #<structure-definition: person>

(setq he  (make-person :id 0 :name "ひー" :address "he@example.com" :age 11 :job "魔法使い")
      she (make-person :id 1 :name "しー" :address "she@example.com" :age 12 :job "気象予報士"))
=> #S(person id 1 name "しー" address "she@example.com" age 12 job "気象予報士")

(with-dot-notation
 (let ((his he) (her she))
   (format t "~:{~A <~A> （~A ~D歳）~%~}"
     (list (list his.name his.address his.job his.age)
           (list her.name her.address her.job her.age)))))
;; ひー <he@example.com> （魔法使い 11歳）
;; しー <she@example.com> （気象予報士 12歳）
=> nil

(with-dot-notation
 (setf he.name "山田太郎"
       she.name "山田花子")
 (values he she))
=> #S(person id 0 name "山田太郎" address "he@example.com" age 11 job "魔法使い")
=> #S(person id 1 name "山田花子" address "she@example.com" age 12 job "気象予報士")