Hash :
7fcf6783
Author :
Thomas de Grivel
Date :
2023-06-19T19:39:03
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98
;; cl-facts
;; Copyright 2011, 2023 Thomas de Grivel <thodg@kmx.io>
;;
;; Permission is hereby granted to use this software granted
;; the above copyright notice and this permission paragraph
;; are included in all copies and substantial portions of this
;; software.
;;
;; THIS SOFTWARE IS PROVIDED "AS-IS" WITHOUT ANY GUARANTEE OF
;; PURPOSE AND PERFORMANCE. IN NO EVENT WHATSOEVER SHALL THE
;; AUTHOR BE CONSIDERED LIABLE FOR THE USE AND PERFORMANCE OF
;; THIS SOFTWARE.
(in-package :facts)
;; Database
(defclass db ()
((index-spo :initform (make-index #'compare-facts-spo)
:reader db-index-spo)
(index-pos :initform (make-index #'compare-facts-pos)
:reader db-index-pos)
(index-osp :initform (make-index #'compare-facts-osp)
:reader db-index-osp)))
(defgeneric db-fact (db fact))
(defgeneric db-indexes-insert (db fact))
(defgeneric db-indexes-delete (db fact))
(defmethod db-fact ((db db) fact)
(index-get (db-index-spo db) fact))
;; Database operations on indexes
(eval-when (:compile-toplevel :load-toplevel :execute)
(setf (rollback-function 'db-indexes-insert) 'db-indexes-delete)
(setf (rollback-function 'db-indexes-delete) 'db-indexes-insert))
(defmethod db-indexes-insert ((db db) fact)
(with-rollback*
(index-insert (db-index-spo db) fact)
(index-insert (db-index-pos db) fact)
(index-insert (db-index-osp db) fact)
(log-transaction-operation db-indexes-insert db fact))
fact)
(defmethod db-indexes-delete ((db db) fact)
(with-rollback*
(index-delete (db-index-spo db) fact)
(index-delete (db-index-pos db) fact)
(index-delete (db-index-osp db) fact)
(log-transaction-operation db-indexes-delete db fact))
fact)
;; High level database operations
(defvar *db* (make-instance 'db))
(setf *transaction-vars* nil)
(transaction-var *db* '*db*)
(defun clear-package (package)
(let ((pkg (typecase package
(package package)
(t (find-package package)))))
(do-symbols (sym pkg)
(unintern sym pkg))))
(defun clear-db ()
(setf *db* (make-instance 'db))
(setf *transaction-vars* nil)
(transaction-var *db* '*db*)
(clear-package :facts.anon))
(defun db-get (s p o &optional (db *db*))
(db-fact db (make-fact/v s p o)))
(defun db-insert (subject predicate object &optional (db *db*))
(let ((fact (make-fact/v subject predicate object)))
(or (db-fact db fact)
(db-indexes-insert db fact))))
(defun db-delete (fact &optional (db *db*))
(let ((fact (db-fact db fact)))
(when fact
(db-indexes-delete db fact))))
(defmacro db-each ((var-s var-p var-o) (tree &key start end) &body body)
(let ((g!fact (gensym "FACT-")))
`(index-each (,tree *db*)
(lambda (,g!fact)
(let ((,var-s (fact/v-subject ,g!fact))
(,var-p (fact/v-predicate ,g!fact))
(,var-o (fact/v-object ,g!fact)))
,@body
(values)))
,@(when start `(:start ,start))
,@(when end `(:end ,end)))))