File: basedefs.lisp

package info (click to toggle)
cl-spatial-trees 0.2-4
  • links: PTS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 148 kB
  • ctags: 117
  • sloc: lisp: 1,197; makefile: 30
file content (67 lines) | stat: -rw-r--r-- 2,527 bytes parent folder | download | duplicates (4)
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))