(defmacro it-null/not-conds (test)
(loop for null/not in '(null identity)
 for ok in '(nil T)
 collecting `((,null/not ,test) (values it ,ok))))

(defmacro a-captive (form) `(locally (declare (local it)) (setf it ,form)))

(defmacro its-all-cond-you (condition.responses)
 `(let ((it)) (declare (local it))
   (cond ,@condition.responses
        (t (error "Unhandled condition")))))

(block definitions
(defmethod k-get ((obj cons) name)
 `(let ((obj ',obj) (name ',name))
   (declare (local name))
 ,#{ `(its-all-cond-you
     ,#{ `(it-null/not-conds
         ,#{ `(a-captive (assoc name obj)) } ) } ) }))
(defmethod k-get-by-id ((obj cons) id) (rassoc id obj))
(defmethod make-next-id-genie ((obj cons))
 (let ((try-id 0))
  (lambda ()
   (loop while (k-get-by-id obj try-id)
    do (incf try-id) finally (return try-id)))))

(defmethod k-add ((obj cons) name)
 (let ((id-er (make-next-id-genie obj)))
  (push (cons name (funcall id-er)) obj)))

(defmethod k-add-with-id ((obj cons) name id)
 (push (cons name id) obj)))

(block ad-hoc-tests
'(let ((k (pairlis nil nil))) (k-get k "foo")))

You are viewing proxied material from tilde.institute. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.