/usr/share/common-lisp/source/spatial-trees/basedefs.lisp is in cl-spatial-trees 0.2-6.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 | ;;; The base definitions for protocol classes and functions for
;;; spatial trees.
(in-package "SPATIAL-TREES-IMPL")
(defclass spatial-tree ()
((root-node :initarg :root-node :accessor root-node)
(rectfun :initarg :rectfun :reader rectfun)
(max-per-node :initform 7 :reader max-per-node)
(min-per-node :initform 3 :reader min-per-node)))
(defmethod print-object ((o spatial-tree) s)
(print-unreadable-object (o s :type t)
(format s "~1I~_~W" (root-node o))))
(defclass spatial-tree-node ()
((mbr :initarg :mbr)
(children :initarg :children :accessor children)
(parent :initarg :parent :accessor parent)))
(defmethod print-object ((o spatial-tree-node) s)
(print-unreadable-object (o s :type t)
(when (slot-boundp o 'mbr)
(format s "~W " (slot-value o 'mbr)))
(format s "~1I~_~W" (children o))))
(defclass spatial-tree-leaf-node (spatial-tree-node)
((children :initarg :records :accessor records)))
(define-condition internal-error (simple-error) ()
(:report
(lambda (c s)
(format s "~@<SPATIAL-TREES internal error: ~
please report how you got this.~2I~_~?~@:>"
(simple-condition-format-control c)
(simple-condition-format-arguments c)))))
(defmacro check (form control &rest args)
`(assert ,form ()
'internal-error :format-control ,control :format-arguments (list ,@args)))
(define-condition protocol-error (error)
((function :initarg :function :reader protocol-error-function)
(tree :initarg :tree :reader protocol-error-tree))
(:report
(lambda (c s)
(format s "~@<SPATIAL-TREES protocol error: ~S is unimplemented for ~
tree ~S.~@:>"
(protocol-error-function c)
(protocol-error-tree c)))))
(defmacro define-protocol-function (name lambda-list)
(let ((method-lambda-list (loop for x in lambda-list
if (eq x 'tree) collect '(tree spatial-tree)
else collect x)))
`(defgeneric ,name ,lambda-list
(:method ,method-lambda-list
(error 'protocol-error :function ',name :tree tree)))))
(define-protocol-function search (object tree))
(define-protocol-function insert (object tree))
(define-protocol-function delete (object tree))
(define-protocol-function choose-leaf (r tree))
(define-protocol-function split-node (tree new node))
(defgeneric make-spatial-tree (kind &rest initargs &key &allow-other-keys))
(defgeneric check-consistency (tree)
(:method-combination progn))
|