;;;--------------------------------------------------------------------------
;;; Locatives.
-(export '(loc locp))
-(defstruct (loc (:predicate locp) (:constructor make-loc (reader writer)))
+(export '(locative locativep))
+(defstruct (locative (:predicate locativep)
+ (:constructor make-locative (reader writer))
+ (:conc-name loc-))
"Locative data type. See `locf' and `ref'."
(reader nil :type function)
(writer nil :type function))
(valtmps valforms newtmps setform getform)
(get-setf-expansion place env)
`(let* (,@(mapcar #'list valtmps valforms))
- (make-loc (lambda () ,getform)
- (lambda (,@newtmps) ,setform)))))
+ (make-locative (lambda () ,getform)
+ (lambda (,@newtmps) ,setform)))))
(export 'ref)
(declaim (inline ref (setf ref)))
except where overridden by INITARGS."
(apply #'copy-instance-using-class (class-of object) object initargs))
+(export 'find-eql-specialized-method)
+(defun find-eql-specialized-method (function arg object)
+ "Return a method defined on FUNCTION whose ARGth argument is
+ `eql'-specialized on OBJECT."
+ (find-if (lambda (method)
+ (let ((spec (nth arg (method-specializers method))))
+ (and spec
+ (typep spec 'eql-specializer)
+ (eq (eql-specializer-object spec) object))))
+ (generic-function-methods function)))
+
(export '(generic-function-methods method-specializers
eql-specializer eql-specializer-object))
and return the result of appending all of the resulting lists."
(reduce #'append (apply #'mapcar function list more-lists) :from-end t))
+(export 'cross-product)
+(defun cross-product (&rest pieces)
+ "Return the cross product of the PIECES.
+
+ Each arguments may be a list, or a (non-nil) atom, which is equivalent to
+ a singleton list containing just that atom. Return a list of all possible
+ lists which can be constructed by taking one item from each argument list
+ in turn, in an arbitrary order."
+ (reduce (lambda (piece tails)
+ (mapcan (lambda (tail)
+ (mapcar (lambda (head)
+ (cons head tail))
+ (if (listp piece) piece
+ (list piece))))
+ tails))
+ pieces
+ :from-end t
+ :initial-value '(nil)))
+
(export 'distinguished-point-shortest-paths)
(defun distinguished-point-shortest-paths (root neighbours-func)
"Moderately efficient shortest-paths-from-root computation.