1 (in-package :sequence-dico
)
3 ;;; Store an object associated with the sequence in the sequence dictionary.
4 ;;; If a prefix of sequence already names an object in the dictionary
5 ;;; the existing object is removed.
7 (defgeneric (setf dico-object
) (object sequence-dico sequence
))
9 ;;; Search for a sequence in a sequence dictionary.
10 ;;; This function returns three values: The first value
11 ;;; is the object associated with the sequence, or nil
12 ;;; if no such object exists. The second value is a boolean
13 ;;; which is t if the first value is the object associated with
14 ;;; the sequence and nil otherwise. The third value is t
15 ;;; if the sequence is a (not necessarily proper) prefix of a sequence
16 ;;; that has an associated object and nil otherwise.
18 (defgeneric dico-object
(sequence-dico sequence
))
20 (defclass sequence-dico
() ())
22 (defclass standard-sequence-dico
(sequence-dico)
23 ((table :initarg
:table
:reader table
)))
25 (defun make-sequence-dico (&key
(test #'eql
))
26 (make-instance 'standard-sequence-dico
27 :table
(make-hash-table :test test
)))
29 (defmethod (setf dico-object
) (object (sequence-dico standard-sequence-dico
) sequence
)
30 (assert (not (null sequence
)))
31 (loop for subseq on sequence
33 and table
= (table sequence-dico
) then
(gethash elem table
)
34 do
(unless (hash-table-p (gethash elem table
))
35 (setf (gethash elem table
)
36 (make-hash-table :test
(hash-table-test (table sequence-dico
)))))
37 finally
(setf (gethash elem table
) object
)))
39 (defmethod dico-object (sequence-dico sequence
)
40 (assert (not (null sequence
)))
41 (loop for subseq on sequence
43 for table-or-obj
= (gethash elem
(table sequence-dico
))
44 then
(gethash elem table-or-obj
)
45 while
(hash-table-p table-or-obj
)
46 finally
(cond ((null table-or-obj
) (return (values nil nil nil
)))
47 ((hash-table-p table-or-obj
) (return (values nil nil t
)))
48 ((null (cdr subseq
)) (return (values table-or-obj t t
)))
49 (t (return (values nil nil nil
))))))