(defun sympair-cons (name car cdr) (unless (symbolp cdr) (signal 'wrong-type-argument (list 'symbolp cdr))) (let ((vec [t])) (aset vec 0 (or cdr 0)) (if (intern-soft name vec) (error "Duplicate name `%s'" name) (let ((sym (intern name vec))) (set sym car) (aset vec 0 t) sym)))) (defun sympair-car (pair) (symbol-value pair)) (defun sympair-cdr (pair) (unless (and pair (symbolp pair)) (signal 'wrong-type-argument (list 'sympairp pair))) (defvar *return?) (let ((vec [t]) *return?) (aset vec 0 pair) (prog1 (catch 'return (mapatoms (lambda (pair) (defvar *return?) (if *return? (throw 'return pair) (setq *return? t))) vec) nil) (aset vec 0 t)))) (defun sympair-cadr (x) (sympair-car (sympair-cdr x))) (defun sympair-cddr (x) (sympair-cdr (sympair-cdr x))) (defun sympair-caddr (x) (sympair-car (sympair-cdr (sympair-cdr x)))) (defun sympair-cdddr (x) (sympair-cdr (sympair-cdr (sympair-cdr x)))) (let* ((one (sympair-cons "one" 1 (sympair-cons "x" 2 (sympair-cons "y" 3 nil)))) (two (sympair-cons "two" 2 (sympair-cdr one)))) (set (sympair-cdr two) "magic") (vector one two (list (sympair-car one) (sympair-cadr one) (sympair-caddr one)) (list (sympair-car two) (sympair-cadr two) (sympair-caddr two)))) ;; => [one two ;; (1 "magic" 3) ;; (2 "magic" 3)]