#:g1: ファイルなスロット

Posted 2020-12-12 12:27:46 GMT

allocate-instance Advent Calendar 2020 12日目の記事です。

アドベントカレンダー折り返し地点で既にネタがブチ切れなのですが、どうにかネタを捻り出していきたいと思います。

今回は、スロットのストレージをOSのファイルとして読み書きしてみることにしました。

“objstore”ディレクトリの直下がクラス名、次にインスタンスのディレクトリがあり、その直下にスロットのファイルが配置されます。
アロケートのタイミングでファイルの読み書きをしなくても、スロットの読み書きでフックをかければ似たようなことはできるのですが、ファイルの確保はallocate-instanceが担当する方が素直かなと思いました。
一応論理パスを利用してファイル名との直接のマッピングは避けています。

非常に簡易的な永続化の方法ですが、案外使えるかも?

実装

(defpackage "8a202ea6-99d1-523d-969b-dbf5fb19ffa5" 
  (:use c2cl slotted-objects))

(cl:in-package "8a202ea6-99d1-523d-969b-dbf5fb19ffa5")

(setf (logical-pathname-translations "objstore") `(("**;*.*.*" "/tmp/**/*.*")))

(defclass file-slots-class (slotted-class) ())

(defclass file-slots-objects (slotted-object) () (:metaclass file-slots-class))

(defun openo (path) (open path :direction :output :if-does-not-exist :create :if-exists :supersede))

(defmethod allocate-instance ((class file-slots-class) &rest initargs) (allocate-slotted-instance (class-wrapper class) (let* ((instance-name (gensym (string (class-name class)))) (files (mapcar (lambda (s) (ensure-directories-exist (make-pathname :host "objstore" :directory `(:absolute ,(string (class-name class)) ,(string instance-name)) :name (string (slot-definition-name s))))) (class-slots class)))) (dolist (f files files) (with-open-stream (out (openo f)) (print nil out))))))

(defmethod slot-value-using-class ((class file-slots-class) instance (slotd slot-definition)) (with-open-file (in (elt (instance-slots instance) (slot-definition-location slotd))) (read in)))

(defmethod (setf slot-value-using-class) (value (class file-slots-class) instance (slotd slot-definition)) (with-open-stream (out (openo (elt (instance-slots instance) (slot-definition-location slotd)))) (print value out) (terpri out) value))

動作

(defclass foo (file-slots-objects)
  ((a :initform 0)
   (b :initform 1)
   (c :initform 2))
  (:metaclass file-slots-class))

(defclass bar (foo) ((d :initform 3)) (:metaclass file-slots-class))

(let ((obj (make-instance 'bar))) (setf (slot-value obj 'd) "こんにちは"))

$ ls /tmp/bar
bar17928740

$ cat /tmp/bar/*/*

0

1

2

"こんにちは"


HTML generated by 3bmd in LispWorks 7.0.0

comments powered by Disqus