Implementing caar, cadr, cdar and friends.

* lib.c (init): Call cadr_init.

* lisplib.c (dl_table, set_dlt_entries, dlt_register): Externalize.

* lisplib.h (dl_table, set_dlt_entries, dlt_register): Declared.

* Makefile (OBJS): Add cadr.o.

* cadr.c: New file.

* cadr.h: New file.

* gencadr.txr: New file.

* share/txr/stdlib/cadr.tl: New file.

* txr.1: Document cadr accessors.

10 files changed, 1903 insertions, 6 deletions

diff --git a/ChangeLog b/ChangeLog
index b15a3860..4fec345a 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,27 @@
 2015-07-21  Kaz Kylheku  <kaz@kylheku.com>
 
+	Implementing caar, cadr, cdar and friends.
+
+	* lib.c (init): Call cadr_init.
+
+	* lisplib.c (dl_table, set_dlt_entries, dlt_register): Externalize.
+
+	* lisplib.h (dl_table, set_dlt_entries, dlt_register): Declared.
+
+	* Makefile (OBJS): Add cadr.o.
+
+	* cadr.c: New file.
+
+	* cadr.h: New file.
+
+	* gencadr.txr: New file.
+
+	* share/txr/stdlib/cadr.tl: New file.
+
+	* txr.1: Document cadr accessors.
+
+2015-07-21  Kaz Kylheku  <kaz@kylheku.com>
+
 	* share/txr/stdlib/place.tl (defplace cdr): Change deletion
 	semantics so that (del (cdr x)) is symmetric with (del (car x)).
 
diff --git a/Makefile b/Makefile
index 35ffcdf4..09e3c242 100644
--- a/Makefile
+++ b/Makefile
@@ -46,7 +46,7 @@ EXTRA_OBJS-y :=
 
 OBJS := txr.o lex.yy.o y.tab.o match.o lib.o regex.o gc.o unwind.o stream.o
 OBJS += arith.o hash.o utf8.o filter.o eval.o parser.o rand.o combi.o sysif.o
-OBJS += lisplib.o
+OBJS += lisplib.o cadr.o
 OBJS-$(debug_support) += debug.o
 OBJS-$(have_syslog) += syslog.o
 OBJS-$(have_glob) += glob.o
diff --git a/cadr.c b/cadr.c
new file mode 100644
index 00000000..057e4f57
--- /dev/null
+++ b/cadr.c
@@ -0,0 +1,486 @@
+/* Copyright 2009-2015
+ * Kaz Kylheku <kaz@kylheku.com>
+ * Vancouver, Canada
+ * All rights reserved.
+ *
+ * Redistribution of this software in source and binary forms, with or without
+ * modification, is permitted provided that the following two conditions are met.
+ *
+ * Use of this software in any manner constitutes agreement with the disclaimer
+ * which follows the two conditions.
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ *    notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ *    notice, this list of conditions and the following disclaimer in
+ *    the documentation and/or other materials provided with the
+ *    distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
+ * WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL THE
+ * COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DAMAGES, HOWEVER CAUSED,
+ * AND UNDER ANY THEORY OF LIABILITY, ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+#include <stdio.h>
+#include <string.h>
+#include <dirent.h>
+#include <stdarg.h>
+#include <stdlib.h>
+#include <setjmp.h>
+#include <limits.h>
+#include <signal.h>
+#include "config.h"
+#include "lib.h"
+#include "gc.h"
+#include "signal.h"
+#include "unwind.h"
+#include "eval.h"
+#include "stream.h"
+#include "lisplib.h"
+#include "txr.h"
+#include "cadr.h"
+
+val caar(val cons)
+{
+  return car(car(cons));
+}
+
+val cadr(val cons)
+{
+  return car(cdr(cons));
+}
+
+val cdar(val cons)
+{
+  return cdr(car(cons));
+}
+
+val cddr(val cons)
+{
+  return cdr(cdr(cons));
+}
+
+val caaar(val cons)
+{
+  return car(car(car(cons)));
+}
+
+val caadr(val cons)
+{
+  return car(car(cdr(cons)));
+}
+
+val cadar(val cons)
+{
+  return car(cdr(car(cons)));
+}
+
+val caddr(val cons)
+{
+  return car(cdr(cdr(cons)));
+}
+
+val cdaar(val cons)
+{
+  return cdr(car(car(cons)));
+}
+
+val cdadr(val cons)
+{
+  return cdr(car(cdr(cons)));
+}
+
+val cddar(val cons)
+{
+  return cdr(cdr(car(cons)));
+}
+
+val cdddr(val cons)
+{
+  return cdr(cdr(cdr(cons)));
+}
+
+val caaaar(val cons)
+{
+  return car(car(car(car(cons))));
+}
+
+val caaadr(val cons)
+{
+  return car(car(car(cdr(cons))));
+}
+
+val caadar(val cons)
+{
+  return car(car(cdr(car(cons))));
+}
+
+val caaddr(val cons)
+{
+  return car(car(cdr(cdr(cons))));
+}
+
+val cadaar(val cons)
+{
+  return car(cdr(car(car(cons))));
+}
+
+val cadadr(val cons)
+{
+  return car(cdr(car(cdr(cons))));
+}
+
+val caddar(val cons)
+{
+  return car(cdr(cdr(car(cons))));
+}
+
+val cadddr(val cons)
+{
+  return car(cdr(cdr(cdr(cons))));
+}
+
+val cdaaar(val cons)
+{
+  return cdr(car(car(car(cons))));
+}
+
+val cdaadr(val cons)
+{
+  return cdr(car(car(cdr(cons))));
+}
+
+val cdadar(val cons)
+{
+  return cdr(car(cdr(car(cons))));
+}
+
+val cdaddr(val cons)
+{
+  return cdr(car(cdr(cdr(cons))));
+}
+
+val cddaar(val cons)
+{
+  return cdr(cdr(car(car(cons))));
+}
+
+val cddadr(val cons)
+{
+  return cdr(cdr(car(cdr(cons))));
+}
+
+val cdddar(val cons)
+{
+  return cdr(cdr(cdr(car(cons))));
+}
+
+val cddddr(val cons)
+{
+  return cdr(cdr(cdr(cdr(cons))));
+}
+
+val caaaaar(val cons)
+{
+  return car(car(car(car(car(cons)))));
+}
+
+val caaaadr(val cons)
+{
+  return car(car(car(car(cdr(cons)))));
+}
+
+val caaadar(val cons)
+{
+  return car(car(car(cdr(car(cons)))));
+}
+
+val caaaddr(val cons)
+{
+  return car(car(car(cdr(cdr(cons)))));
+}
+
+val caadaar(val cons)
+{
+  return car(car(cdr(car(car(cons)))));
+}
+
+val caadadr(val cons)
+{
+  return car(car(cdr(car(cdr(cons)))));
+}
+
+val caaddar(val cons)
+{
+  return car(car(cdr(cdr(car(cons)))));
+}
+
+val caadddr(val cons)
+{
+  return car(car(cdr(cdr(cdr(cons)))));
+}
+
+val cadaaar(val cons)
+{
+  return car(cdr(car(car(car(cons)))));
+}
+
+val cadaadr(val cons)
+{
+  return car(cdr(car(car(cdr(cons)))));
+}
+
+val cadadar(val cons)
+{
+  return car(cdr(car(cdr(car(cons)))));
+}
+
+val cadaddr(val cons)
+{
+  return car(cdr(car(cdr(cdr(cons)))));
+}
+
+val caddaar(val cons)
+{
+  return car(cdr(cdr(car(car(cons)))));
+}
+
+val caddadr(val cons)
+{
+  return car(cdr(cdr(car(cdr(cons)))));
+}
+
+val cadddar(val cons)
+{
+  return car(cdr(cdr(cdr(car(cons)))));
+}
+
+val caddddr(val cons)
+{
+  return car(cdr(cdr(cdr(cdr(cons)))));
+}
+
+val cdaaaar(val cons)
+{
+  return cdr(car(car(car(car(cons)))));
+}
+
+val cdaaadr(val cons)
+{
+  return cdr(car(car(car(cdr(cons)))));
+}
+
+val cdaadar(val cons)
+{
+  return cdr(car(car(cdr(car(cons)))));
+}
+
+val cdaaddr(val cons)
+{
+  return cdr(car(car(cdr(cdr(cons)))));
+}
+
+val cdadaar(val cons)
+{
+  return cdr(car(cdr(car(car(cons)))));
+}
+
+val cdadadr(val cons)
+{
+  return cdr(car(cdr(car(cdr(cons)))));
+}
+
+val cdaddar(val cons)
+{
+  return cdr(car(cdr(cdr(car(cons)))));
+}
+
+val cdadddr(val cons)
+{
+  return cdr(car(cdr(cdr(cdr(cons)))));
+}
+
+val cddaaar(val cons)
+{
+  return cdr(cdr(car(car(car(cons)))));
+}
+
+val cddaadr(val cons)
+{
+  return cdr(cdr(car(car(cdr(cons)))));
+}
+
+val cddadar(val cons)
+{
+  return cdr(cdr(car(cdr(car(cons)))));
+}
+
+val cddaddr(val cons)
+{
+  return cdr(cdr(car(cdr(cdr(cons)))));
+}
+
+val cdddaar(val cons)
+{
+  return cdr(cdr(cdr(car(car(cons)))));
+}
+
+val cdddadr(val cons)
+{
+  return cdr(cdr(cdr(car(cdr(cons)))));
+}
+
+val cddddar(val cons)
+{
+  return cdr(cdr(cdr(cdr(car(cons)))));
+}
+
+val cdddddr(val cons)
+{
+  return cdr(cdr(cdr(cdr(cdr(cons)))));
+}
+
+static val cadr_register(val set_fun)
+{
+  funcall1(set_fun, nil);
+  reg_fun(intern(lit("caar"), user_package), func_n1(caar));
+  reg_fun(intern(lit("cadr"), user_package), func_n1(cadr));
+  reg_fun(intern(lit("cdar"), user_package), func_n1(cdar));
+  reg_fun(intern(lit("cddr"), user_package), func_n1(cddr));
+  reg_fun(intern(lit("caaar"), user_package), func_n1(caaar));
+  reg_fun(intern(lit("caadr"), user_package), func_n1(caadr));
+  reg_fun(intern(lit("cadar"), user_package), func_n1(cadar));
+  reg_fun(intern(lit("caddr"), user_package), func_n1(caddr));
+  reg_fun(intern(lit("cdaar"), user_package), func_n1(cdaar));
+  reg_fun(intern(lit("cdadr"), user_package), func_n1(cdadr));
+  reg_fun(intern(lit("cddar"), user_package), func_n1(cddar));
+  reg_fun(intern(lit("cdddr"), user_package), func_n1(cdddr));
+  reg_fun(intern(lit("caaaar"), user_package), func_n1(caaaar));
+  reg_fun(intern(lit("caaadr"), user_package), func_n1(caaadr));
+  reg_fun(intern(lit("caadar"), user_package), func_n1(caadar));
+  reg_fun(intern(lit("caaddr"), user_package), func_n1(caaddr));
+  reg_fun(intern(lit("cadaar"), user_package), func_n1(cadaar));
+  reg_fun(intern(lit("cadadr"), user_package), func_n1(cadadr));
+  reg_fun(intern(lit("caddar"), user_package), func_n1(caddar));
+  reg_fun(intern(lit("cadddr"), user_package), func_n1(cadddr));
+  reg_fun(intern(lit("cdaaar"), user_package), func_n1(cdaaar));
+  reg_fun(intern(lit("cdaadr"), user_package), func_n1(cdaadr));
+  reg_fun(intern(lit("cdadar"), user_package), func_n1(cdadar));
+  reg_fun(intern(lit("cdaddr"), user_package), func_n1(cdaddr));
+  reg_fun(intern(lit("cddaar"), user_package), func_n1(cddaar));
+  reg_fun(intern(lit("cddadr"), user_package), func_n1(cddadr));
+  reg_fun(intern(lit("cdddar"), user_package), func_n1(cdddar));
+  reg_fun(intern(lit("cddddr"), user_package), func_n1(cddddr));
+  reg_fun(intern(lit("caaaaar"), user_package), func_n1(caaaaar));
+  reg_fun(intern(lit("caaaadr"), user_package), func_n1(caaaadr));
+  reg_fun(intern(lit("caaadar"), user_package), func_n1(caaadar));
+  reg_fun(intern(lit("caaaddr"), user_package), func_n1(caaaddr));
+  reg_fun(intern(lit("caadaar"), user_package), func_n1(caadaar));
+  reg_fun(intern(lit("caadadr"), user_package), func_n1(caadadr));
+  reg_fun(intern(lit("caaddar"), user_package), func_n1(caaddar));
+  reg_fun(intern(lit("caadddr"), user_package), func_n1(caadddr));
+  reg_fun(intern(lit("cadaaar"), user_package), func_n1(cadaaar));
+  reg_fun(intern(lit("cadaadr"), user_package), func_n1(cadaadr));
+  reg_fun(intern(lit("cadadar"), user_package), func_n1(cadadar));
+  reg_fun(intern(lit("cadaddr"), user_package), func_n1(cadaddr));
+  reg_fun(intern(lit("caddaar"), user_package), func_n1(caddaar));
+  reg_fun(intern(lit("caddadr"), user_package), func_n1(caddadr));
+  reg_fun(intern(lit("cadddar"), user_package), func_n1(cadddar));
+  reg_fun(intern(lit("caddddr"), user_package), func_n1(caddddr));
+  reg_fun(intern(lit("cdaaaar"), user_package), func_n1(cdaaaar));
+  reg_fun(intern(lit("cdaaadr"), user_package), func_n1(cdaaadr));
+  reg_fun(intern(lit("cdaadar"), user_package), func_n1(cdaadar));
+  reg_fun(intern(lit("cdaaddr"), user_package), func_n1(cdaaddr));
+  reg_fun(intern(lit("cdadaar"), user_package), func_n1(cdadaar));
+  reg_fun(intern(lit("cdadadr"), user_package), func_n1(cdadadr));
+  reg_fun(intern(lit("cdaddar"), user_package), func_n1(cdaddar));
+  reg_fun(intern(lit("cdadddr"), user_package), func_n1(cdadddr));
+  reg_fun(intern(lit("cddaaar"), user_package), func_n1(cddaaar));
+  reg_fun(intern(lit("cddaadr"), user_package), func_n1(cddaadr));
+  reg_fun(intern(lit("cddadar"), user_package), func_n1(cddadar));
+  reg_fun(intern(lit("cddaddr"), user_package), func_n1(cddaddr));
+  reg_fun(intern(lit("cdddaar"), user_package), func_n1(cdddaar));
+  reg_fun(intern(lit("cdddadr"), user_package), func_n1(cdddadr));
+  reg_fun(intern(lit("cddddar"), user_package), func_n1(cddddar));
+  reg_fun(intern(lit("cdddddr"), user_package), func_n1(cdddddr));
+  load(format(nil, lit("~a/cadr.tl"), stdlib_path, nao));
+  return nil;
+}
+
+static val cadr_set_entries(val dlt, val fun)
+{
+  val name[] = {
+    lit("caar"),
+    lit("cadr"),
+    lit("cdar"),
+    lit("cddr"),
+    lit("caaar"),
+    lit("caadr"),
+    lit("cadar"),
+    lit("caddr"),
+    lit("cdaar"),
+    lit("cdadr"),
+    lit("cddar"),
+    lit("cdddr"),
+    lit("caaaar"),
+    lit("caaadr"),
+    lit("caadar"),
+    lit("caaddr"),
+    lit("cadaar"),
+    lit("cadadr"),
+    lit("caddar"),
+    lit("cadddr"),
+    lit("cdaaar"),
+    lit("cdaadr"),
+    lit("cdadar"),
+    lit("cdaddr"),
+    lit("cddaar"),
+    lit("cddadr"),
+    lit("cdddar"),
+    lit("cddddr"),
+    lit("caaaaar"),
+    lit("caaaadr"),
+    lit("caaadar"),
+    lit("caaaddr"),
+    lit("caadaar"),
+    lit("caadadr"),
+    lit("caaddar"),
+    lit("caadddr"),
+    lit("cadaaar"),
+    lit("cadaadr"),
+    lit("cadadar"),
+    lit("cadaddr"),
+    lit("caddaar"),
+    lit("caddadr"),
+    lit("cadddar"),
+    lit("caddddr"),
+    lit("cdaaaar"),
+    lit("cdaaadr"),
+    lit("cdaadar"),
+    lit("cdaaddr"),
+    lit("cdadaar"),
+    lit("cdadadr"),
+    lit("cdaddar"),
+    lit("cdadddr"),
+    lit("cddaaar"),
+    lit("cddaadr"),
+    lit("cddadar"),
+    lit("cddaddr"),
+    lit("cdddaar"),
+    lit("cdddadr"),
+    lit("cddddar"),
+    lit("cdddddr"),
+    nil
+  };
+
+  set_dlt_entries(dlt, name, fun);
+  return nil;
+}
+
+void cadr_init(void)
+{
+  dlt_register(dl_table, cadr_register, cadr_set_entries);
+}
diff --git a/cadr.h b/cadr.h
new file mode 100644
index 00000000..f080da2b
--- /dev/null
+++ b/cadr.h
@@ -0,0 +1,88 @@
+/* Copyright 2009-2015
+ * Kaz Kylheku <kaz@kylheku.com>
+ * Vancouver, Canada
+ * All rights reserved.
+ *
+ * Redistribution of this software in source and binary forms, with or without
+ * modification, is permitted provided that the following two conditions are met.
+ *
+ * Use of this software in any manner constitutes agreement with the disclaimer
+ * which follows the two conditions.
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ *    notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ *    notice, this list of conditions and the following disclaimer in
+ *    the documentation and/or other materials provided with the
+ *    distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
+ * WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL THE
+ * COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DAMAGES, HOWEVER CAUSED,
+ * AND UNDER ANY THEORY OF LIABILITY, ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+val caar(val);
+val cadr(val);
+val cdar(val);
+val cddr(val);
+val caaar(val);
+val caadr(val);
+val cadar(val);
+val caddr(val);
+val cdaar(val);
+val cdadr(val);
+val cddar(val);
+val cdddr(val);
+val caaaar(val);
+val caaadr(val);
+val caadar(val);
+val caaddr(val);
+val cadaar(val);
+val cadadr(val);
+val caddar(val);
+val cadddr(val);
+val cdaaar(val);
+val cdaadr(val);
+val cdadar(val);
+val cdaddr(val);
+val cddaar(val);
+val cddadr(val);
+val cdddar(val);
+val cddddr(val);
+val caaaaar(val);
+val caaaadr(val);
+val caaadar(val);
+val caaaddr(val);
+val caadaar(val);
+val caadadr(val);
+val caaddar(val);
+val caadddr(val);
+val cadaaar(val);
+val cadaadr(val);
+val cadadar(val);
+val cadaddr(val);
+val caddaar(val);
+val caddadr(val);
+val cadddar(val);
+val caddddr(val);
+val cdaaaar(val);
+val cdaaadr(val);
+val cdaadar(val);
+val cdaaddr(val);
+val cdadaar(val);
+val cdadadr(val);
+val cdaddar(val);
+val cdadddr(val);
+val cddaaar(val);
+val cddaadr(val);
+val cddadar(val);
+val cddaddr(val);
+val cdddaar(val);
+val cdddadr(val);
+val cddddar(val);
+val cdddddr(val);
+
+void cadr_init(void);
diff --git a/gencadr.txr b/gencadr.txr
new file mode 100644
index 00000000..f21386fd
--- /dev/null
+++ b/gencadr.txr
@@ -0,0 +1,109 @@
+@(bind ad @(append-each* ((i (range 2 5))) (rperm "ad" i)))
+@(do
+   (defun compile-ad (string arg)
+     (casequal string
+       ("" arg)
+       (t `c@[string 0]r(@(compile-ad [string 1..:] arg))`))))
+@(next "lib.c")
+@(collect)
+@{c-copyright}
+@(until)
+
+@(end)
+@(next "share/txr/stdlib/place.tl")
+@(collect)
+@{tl-copyright}
+@(until)
+
+@(end)
+@(output "cadr.c")
+@{c-copyright "\n"}
+
+#include <stdio.h>
+#include <string.h>
+#include <dirent.h>
+#include <stdarg.h>
+#include <stdlib.h>
+#include <setjmp.h>
+#include <limits.h>
+#include <signal.h>
+#include "config.h"
+#include "lib.h"
+#include "gc.h"
+#include "signal.h"
+#include "unwind.h"
+#include "eval.h"
+#include "stream.h"
+#include "lisplib.h"
+#include "txr.h"
+#include "cadr.h"
+@  (repeat)
+
+val c@{ad}r(val cons)
+{
+  return @(compile-ad ad 'cons);
+}
+@  (end)
+
+static val cadr_register(val set_fun)
+{
+  funcall1(set_fun, nil);
+@  (repeat)
+  reg_fun(intern(lit("c@{ad}r"), user_package), func_n1(c@{ad}r));
+@  (end)
+  load(format(nil, lit("~a/cadr.tl"), stdlib_path, nao));
+  return nil;
+}
+
+static val cadr_set_entries(val dlt, val fun)
+{
+  val name[] = {
+@  (repeat)
+    lit("c@{ad}r"),
+@  (end)
+    nil
+  };
+
+  set_dlt_entries(dlt, name, fun);
+  return nil;
+}
+
+void cadr_init(void)
+{
+  dlt_register(dl_table, cadr_register, cadr_set_entries);
+}
+@(end)
+@(output "cadr.h")
+@{c-copyright "\n"}
+
+@  (repeat)
+val c@{ad}r(val);
+@  (end)
+
+void cadr_init(void);
+@(end)
+@(output "share/txr/stdlib/cadr.tl")
+@{tl-copyright "\n"}
+@  (repeat)
+
+(defplace (c@{ad}r cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (c@{ad [1..:]}r ,cell)))
+         (macrolet ((,getter () ^(c@{ad [0]}r ,',cell-sym))
+                    (,setter (val) ^(sys:rplac@{ad [0]} ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplac@{ad [0]} (c@{ad [1..:]}r ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(c@{ad [1..:]}r ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         @(if (equal [ad 0] #\a)
+                            `(prog1 (car ,tmp) (,csetter (cdr ,tmp)))`
+                            `(prog1 (cdr ,tmp) (,csetter (car ,tmp)))`))))))
+       ,body)))
+@  (end)
+@(end)
diff --git a/lib.c b/lib.c
index 7ce96c50..eba06a71 100644
--- a/lib.c
+++ b/lib.c
@@ -60,6 +60,7 @@
 #include "parser.h"
 #include "syslog.h"
 #include "glob.h"
+#include "cadr.h"
 #include "txr.h"
 
 #define max(a, b) ((a) > (b) ? (a) : (b))
@@ -7450,6 +7451,7 @@ void init(const wchar_t *pn, mem_t *(*oom)(mem_t *, size_t),
 #if HAVE_GLOB
   glob_init();
 #endif
+  cadr_init();
 
   gc_state(gc_save);
 }
diff --git a/lisplib.c b/lisplib.c
index bc00b6a1..7fc92021 100644
--- a/lisplib.c
+++ b/lisplib.c
@@ -38,9 +38,9 @@
 #include "txr.h"
 #include "lisplib.h"
 
-static val dl_table;
+val dl_table;
 
-static void set_dlt_entries(val dlt, val *name, val fun)
+void set_dlt_entries(val dlt, val *name, val fun)
 {
   for (; *name; name++) {
     val sym = intern(*name, user_package);
@@ -126,9 +126,9 @@ static val txr_case_instantiate(val set_fun)
   return nil;
 }
 
-static val dlt_register(val dlt,
-                        val (*instantiate)(val),
-                        val (*set_entries)(val, val))
+val dlt_register(val dlt,
+                 val (*instantiate)(val),
+                 val (*set_entries)(val, val))
 {
   return set_entries(dl_table, func_f0(func_f1(dlt, set_entries), instantiate));
 }
diff --git a/lisplib.h b/lisplib.h
index e947296e..1e5ce485 100644
--- a/lisplib.h
+++ b/lisplib.h
@@ -24,5 +24,11 @@
  * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  */
 
+extern val dl_table;
+
 void lisplib_init(void);
 val lisplib_try_load(val sym);
+void set_dlt_entries(val dlt, val *name, val fun);
+val dlt_register(val dlt,
+                 val (*instantiate)(val),
+                 val (*set_entries)(val, val));
diff --git a/share/txr/stdlib/cadr.tl b/share/txr/stdlib/cadr.tl
new file mode 100644
index 00000000..7516094d
--- /dev/null
+++ b/share/txr/stdlib/cadr.tl
@@ -0,0 +1,1104 @@
+;; Copyright 2015
+;; Kaz Kylheku <kaz@kylheku.com>
+;; Vancouver, Canada
+;; All rights reserved.
+;;
+;; Redistribution of this software in source and binary forms, with or without
+;; modification, is permitted provided that the following two conditions are met.
+;;
+;; Use of this software in any manner constitutes agreement with the disclaimer
+;; which follows the two conditions.
+;;
+;; 1. Redistributions of source code must retain the above copyright
+;;    notice, this list of conditions and the following disclaimer.
+;; 2. Redistributions in binary form must reproduce the above copyright
+;;    notice, this list of conditions and the following disclaimer in
+;;    the documentation and/or other materials provided with the
+;;    distribution.
+;;
+;; THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
+;; WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
+;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL THE
+;; COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DAMAGES, HOWEVER CAUSED,
+;; AND UNDER ANY THEORY OF LIABILITY, ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(defplace (caar cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (car ,cell)))
+         (macrolet ((,getter () ^(car ,',cell-sym))
+                    (,setter (val) ^(sys:rplaca ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplaca (car ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(car ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (car ,tmp) (,csetter (cdr ,tmp))))))))
+       ,body)))
+
+(defplace (cadr cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (cdr ,cell)))
+         (macrolet ((,getter () ^(car ,',cell-sym))
+                    (,setter (val) ^(sys:rplaca ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplaca (cdr ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(cdr ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (car ,tmp) (,csetter (cdr ,tmp))))))))
+       ,body)))
+
+(defplace (cdar cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (car ,cell)))
+         (macrolet ((,getter () ^(cdr ,',cell-sym))
+                    (,setter (val) ^(sys:rplacd ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplacd (car ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(car ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (cdr ,tmp) (,csetter (car ,tmp))))))))
+       ,body)))
+
+(defplace (cddr cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (cdr ,cell)))
+         (macrolet ((,getter () ^(cdr ,',cell-sym))
+                    (,setter (val) ^(sys:rplacd ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplacd (cdr ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(cdr ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (cdr ,tmp) (,csetter (car ,tmp))))))))
+       ,body)))
+
+(defplace (caaar cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (caar ,cell)))
+         (macrolet ((,getter () ^(car ,',cell-sym))
+                    (,setter (val) ^(sys:rplaca ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplaca (caar ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(caar ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (car ,tmp) (,csetter (cdr ,tmp))))))))
+       ,body)))
+
+(defplace (caadr cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (cadr ,cell)))
+         (macrolet ((,getter () ^(car ,',cell-sym))
+                    (,setter (val) ^(sys:rplaca ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplaca (cadr ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(cadr ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (car ,tmp) (,csetter (cdr ,tmp))))))))
+       ,body)))
+
+(defplace (cadar cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (cdar ,cell)))
+         (macrolet ((,getter () ^(car ,',cell-sym))
+                    (,setter (val) ^(sys:rplaca ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplaca (cdar ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(cdar ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (car ,tmp) (,csetter (cdr ,tmp))))))))
+       ,body)))
+
+(defplace (caddr cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (cddr ,cell)))
+         (macrolet ((,getter () ^(car ,',cell-sym))
+                    (,setter (val) ^(sys:rplaca ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplaca (cddr ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(cddr ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (car ,tmp) (,csetter (cdr ,tmp))))))))
+       ,body)))
+
+(defplace (cdaar cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (caar ,cell)))
+         (macrolet ((,getter () ^(cdr ,',cell-sym))
+                    (,setter (val) ^(sys:rplacd ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplacd (caar ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(caar ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (cdr ,tmp) (,csetter (car ,tmp))))))))
+       ,body)))
+
+(defplace (cdadr cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (cadr ,cell)))
+         (macrolet ((,getter () ^(cdr ,',cell-sym))
+                    (,setter (val) ^(sys:rplacd ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplacd (cadr ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(cadr ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (cdr ,tmp) (,csetter (car ,tmp))))))))
+       ,body)))
+
+(defplace (cddar cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (cdar ,cell)))
+         (macrolet ((,getter () ^(cdr ,',cell-sym))
+                    (,setter (val) ^(sys:rplacd ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplacd (cdar ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(cdar ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (cdr ,tmp) (,csetter (car ,tmp))))))))
+       ,body)))
+
+(defplace (cdddr cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (cddr ,cell)))
+         (macrolet ((,getter () ^(cdr ,',cell-sym))
+                    (,setter (val) ^(sys:rplacd ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplacd (cddr ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(cddr ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (cdr ,tmp) (,csetter (car ,tmp))))))))
+       ,body)))
+
+(defplace (caaaar cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (caaar ,cell)))
+         (macrolet ((,getter () ^(car ,',cell-sym))
+                    (,setter (val) ^(sys:rplaca ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplaca (caaar ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(caaar ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (car ,tmp) (,csetter (cdr ,tmp))))))))
+       ,body)))
+
+(defplace (caaadr cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (caadr ,cell)))
+         (macrolet ((,getter () ^(car ,',cell-sym))
+                    (,setter (val) ^(sys:rplaca ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplaca (caadr ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(caadr ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (car ,tmp) (,csetter (cdr ,tmp))))))))
+       ,body)))
+
+(defplace (caadar cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (cadar ,cell)))
+         (macrolet ((,getter () ^(car ,',cell-sym))
+                    (,setter (val) ^(sys:rplaca ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplaca (cadar ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(cadar ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (car ,tmp) (,csetter (cdr ,tmp))))))))
+       ,body)))
+
+(defplace (caaddr cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (caddr ,cell)))
+         (macrolet ((,getter () ^(car ,',cell-sym))
+                    (,setter (val) ^(sys:rplaca ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplaca (caddr ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(caddr ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (car ,tmp) (,csetter (cdr ,tmp))))))))
+       ,body)))
+
+(defplace (cadaar cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (cdaar ,cell)))
+         (macrolet ((,getter () ^(car ,',cell-sym))
+                    (,setter (val) ^(sys:rplaca ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplaca (cdaar ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(cdaar ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (car ,tmp) (,csetter (cdr ,tmp))))))))
+       ,body)))
+
+(defplace (cadadr cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (cdadr ,cell)))
+         (macrolet ((,getter () ^(car ,',cell-sym))
+                    (,setter (val) ^(sys:rplaca ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplaca (cdadr ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(cdadr ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (car ,tmp) (,csetter (cdr ,tmp))))))))
+       ,body)))
+
+(defplace (caddar cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (cddar ,cell)))
+         (macrolet ((,getter () ^(car ,',cell-sym))
+                    (,setter (val) ^(sys:rplaca ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplaca (cddar ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(cddar ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (car ,tmp) (,csetter (cdr ,tmp))))))))
+       ,body)))
+
+(defplace (cadddr cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (cdddr ,cell)))
+         (macrolet ((,getter () ^(car ,',cell-sym))
+                    (,setter (val) ^(sys:rplaca ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplaca (cdddr ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(cdddr ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (car ,tmp) (,csetter (cdr ,tmp))))))))
+       ,body)))
+
+(defplace (cdaaar cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (caaar ,cell)))
+         (macrolet ((,getter () ^(cdr ,',cell-sym))
+                    (,setter (val) ^(sys:rplacd ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplacd (caaar ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(caaar ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (cdr ,tmp) (,csetter (car ,tmp))))))))
+       ,body)))
+
+(defplace (cdaadr cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (caadr ,cell)))
+         (macrolet ((,getter () ^(cdr ,',cell-sym))
+                    (,setter (val) ^(sys:rplacd ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplacd (caadr ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(caadr ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (cdr ,tmp) (,csetter (car ,tmp))))))))
+       ,body)))
+
+(defplace (cdadar cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (cadar ,cell)))
+         (macrolet ((,getter () ^(cdr ,',cell-sym))
+                    (,setter (val) ^(sys:rplacd ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplacd (cadar ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(cadar ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (cdr ,tmp) (,csetter (car ,tmp))))))))
+       ,body)))
+
+(defplace (cdaddr cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (caddr ,cell)))
+         (macrolet ((,getter () ^(cdr ,',cell-sym))
+                    (,setter (val) ^(sys:rplacd ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplacd (caddr ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(caddr ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (cdr ,tmp) (,csetter (car ,tmp))))))))
+       ,body)))
+
+(defplace (cddaar cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (cdaar ,cell)))
+         (macrolet ((,getter () ^(cdr ,',cell-sym))
+                    (,setter (val) ^(sys:rplacd ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplacd (cdaar ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(cdaar ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (cdr ,tmp) (,csetter (car ,tmp))))))))
+       ,body)))
+
+(defplace (cddadr cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (cdadr ,cell)))
+         (macrolet ((,getter () ^(cdr ,',cell-sym))
+                    (,setter (val) ^(sys:rplacd ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplacd (cdadr ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(cdadr ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (cdr ,tmp) (,csetter (car ,tmp))))))))
+       ,body)))
+
+(defplace (cdddar cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (cddar ,cell)))
+         (macrolet ((,getter () ^(cdr ,',cell-sym))
+                    (,setter (val) ^(sys:rplacd ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplacd (cddar ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(cddar ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (cdr ,tmp) (,csetter (car ,tmp))))))))
+       ,body)))
+
+(defplace (cddddr cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (cdddr ,cell)))
+         (macrolet ((,getter () ^(cdr ,',cell-sym))
+                    (,setter (val) ^(sys:rplacd ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplacd (cdddr ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(cdddr ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (cdr ,tmp) (,csetter (car ,tmp))))))))
+       ,body)))
+
+(defplace (caaaaar cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (caaaar ,cell)))
+         (macrolet ((,getter () ^(car ,',cell-sym))
+                    (,setter (val) ^(sys:rplaca ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplaca (caaaar ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(caaaar ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (car ,tmp) (,csetter (cdr ,tmp))))))))
+       ,body)))
+
+(defplace (caaaadr cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (caaadr ,cell)))
+         (macrolet ((,getter () ^(car ,',cell-sym))
+                    (,setter (val) ^(sys:rplaca ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplaca (caaadr ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(caaadr ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (car ,tmp) (,csetter (cdr ,tmp))))))))
+       ,body)))
+
+(defplace (caaadar cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (caadar ,cell)))
+         (macrolet ((,getter () ^(car ,',cell-sym))
+                    (,setter (val) ^(sys:rplaca ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplaca (caadar ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(caadar ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (car ,tmp) (,csetter (cdr ,tmp))))))))
+       ,body)))
+
+(defplace (caaaddr cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (caaddr ,cell)))
+         (macrolet ((,getter () ^(car ,',cell-sym))
+                    (,setter (val) ^(sys:rplaca ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplaca (caaddr ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(caaddr ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (car ,tmp) (,csetter (cdr ,tmp))))))))
+       ,body)))
+
+(defplace (caadaar cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (cadaar ,cell)))
+         (macrolet ((,getter () ^(car ,',cell-sym))
+                    (,setter (val) ^(sys:rplaca ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplaca (cadaar ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(cadaar ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (car ,tmp) (,csetter (cdr ,tmp))))))))
+       ,body)))
+
+(defplace (caadadr cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (cadadr ,cell)))
+         (macrolet ((,getter () ^(car ,',cell-sym))
+                    (,setter (val) ^(sys:rplaca ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplaca (cadadr ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(cadadr ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (car ,tmp) (,csetter (cdr ,tmp))))))))
+       ,body)))
+
+(defplace (caaddar cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (caddar ,cell)))
+         (macrolet ((,getter () ^(car ,',cell-sym))
+                    (,setter (val) ^(sys:rplaca ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplaca (caddar ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(caddar ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (car ,tmp) (,csetter (cdr ,tmp))))))))
+       ,body)))
+
+(defplace (caadddr cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (cadddr ,cell)))
+         (macrolet ((,getter () ^(car ,',cell-sym))
+                    (,setter (val) ^(sys:rplaca ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplaca (cadddr ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(cadddr ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (car ,tmp) (,csetter (cdr ,tmp))))))))
+       ,body)))
+
+(defplace (cadaaar cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (cdaaar ,cell)))
+         (macrolet ((,getter () ^(car ,',cell-sym))
+                    (,setter (val) ^(sys:rplaca ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplaca (cdaaar ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(cdaaar ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (car ,tmp) (,csetter (cdr ,tmp))))))))
+       ,body)))
+
+(defplace (cadaadr cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (cdaadr ,cell)))
+         (macrolet ((,getter () ^(car ,',cell-sym))
+                    (,setter (val) ^(sys:rplaca ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplaca (cdaadr ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(cdaadr ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (car ,tmp) (,csetter (cdr ,tmp))))))))
+       ,body)))
+
+(defplace (cadadar cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (cdadar ,cell)))
+         (macrolet ((,getter () ^(car ,',cell-sym))
+                    (,setter (val) ^(sys:rplaca ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplaca (cdadar ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(cdadar ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (car ,tmp) (,csetter (cdr ,tmp))))))))
+       ,body)))
+
+(defplace (cadaddr cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (cdaddr ,cell)))
+         (macrolet ((,getter () ^(car ,',cell-sym))
+                    (,setter (val) ^(sys:rplaca ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplaca (cdaddr ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(cdaddr ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (car ,tmp) (,csetter (cdr ,tmp))))))))
+       ,body)))
+
+(defplace (caddaar cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (cddaar ,cell)))
+         (macrolet ((,getter () ^(car ,',cell-sym))
+                    (,setter (val) ^(sys:rplaca ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplaca (cddaar ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(cddaar ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (car ,tmp) (,csetter (cdr ,tmp))))))))
+       ,body)))
+
+(defplace (caddadr cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (cddadr ,cell)))
+         (macrolet ((,getter () ^(car ,',cell-sym))
+                    (,setter (val) ^(sys:rplaca ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplaca (cddadr ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(cddadr ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (car ,tmp) (,csetter (cdr ,tmp))))))))
+       ,body)))
+
+(defplace (cadddar cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (cdddar ,cell)))
+         (macrolet ((,getter () ^(car ,',cell-sym))
+                    (,setter (val) ^(sys:rplaca ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplaca (cdddar ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(cdddar ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (car ,tmp) (,csetter (cdr ,tmp))))))))
+       ,body)))
+
+(defplace (caddddr cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (cddddr ,cell)))
+         (macrolet ((,getter () ^(car ,',cell-sym))
+                    (,setter (val) ^(sys:rplaca ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplaca (cddddr ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(cddddr ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (car ,tmp) (,csetter (cdr ,tmp))))))))
+       ,body)))
+
+(defplace (cdaaaar cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (caaaar ,cell)))
+         (macrolet ((,getter () ^(cdr ,',cell-sym))
+                    (,setter (val) ^(sys:rplacd ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplacd (caaaar ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(caaaar ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (cdr ,tmp) (,csetter (car ,tmp))))))))
+       ,body)))
+
+(defplace (cdaaadr cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (caaadr ,cell)))
+         (macrolet ((,getter () ^(cdr ,',cell-sym))
+                    (,setter (val) ^(sys:rplacd ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplacd (caaadr ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(caaadr ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (cdr ,tmp) (,csetter (car ,tmp))))))))
+       ,body)))
+
+(defplace (cdaadar cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (caadar ,cell)))
+         (macrolet ((,getter () ^(cdr ,',cell-sym))
+                    (,setter (val) ^(sys:rplacd ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplacd (caadar ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(caadar ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (cdr ,tmp) (,csetter (car ,tmp))))))))
+       ,body)))
+
+(defplace (cdaaddr cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (caaddr ,cell)))
+         (macrolet ((,getter () ^(cdr ,',cell-sym))
+                    (,setter (val) ^(sys:rplacd ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplacd (caaddr ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(caaddr ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (cdr ,tmp) (,csetter (car ,tmp))))))))
+       ,body)))
+
+(defplace (cdadaar cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (cadaar ,cell)))
+         (macrolet ((,getter () ^(cdr ,',cell-sym))
+                    (,setter (val) ^(sys:rplacd ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplacd (cadaar ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(cadaar ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (cdr ,tmp) (,csetter (car ,tmp))))))))
+       ,body)))
+
+(defplace (cdadadr cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (cadadr ,cell)))
+         (macrolet ((,getter () ^(cdr ,',cell-sym))
+                    (,setter (val) ^(sys:rplacd ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplacd (cadadr ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(cadadr ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (cdr ,tmp) (,csetter (car ,tmp))))))))
+       ,body)))
+
+(defplace (cdaddar cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (caddar ,cell)))
+         (macrolet ((,getter () ^(cdr ,',cell-sym))
+                    (,setter (val) ^(sys:rplacd ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplacd (caddar ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(caddar ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (cdr ,tmp) (,csetter (car ,tmp))))))))
+       ,body)))
+
+(defplace (cdadddr cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (cadddr ,cell)))
+         (macrolet ((,getter () ^(cdr ,',cell-sym))
+                    (,setter (val) ^(sys:rplacd ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplacd (cadddr ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(cadddr ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (cdr ,tmp) (,csetter (car ,tmp))))))))
+       ,body)))
+
+(defplace (cddaaar cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (cdaaar ,cell)))
+         (macrolet ((,getter () ^(cdr ,',cell-sym))
+                    (,setter (val) ^(sys:rplacd ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplacd (cdaaar ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(cdaaar ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (cdr ,tmp) (,csetter (car ,tmp))))))))
+       ,body)))
+
+(defplace (cddaadr cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (cdaadr ,cell)))
+         (macrolet ((,getter () ^(cdr ,',cell-sym))
+                    (,setter (val) ^(sys:rplacd ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplacd (cdaadr ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(cdaadr ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (cdr ,tmp) (,csetter (car ,tmp))))))))
+       ,body)))
+
+(defplace (cddadar cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (cdadar ,cell)))
+         (macrolet ((,getter () ^(cdr ,',cell-sym))
+                    (,setter (val) ^(sys:rplacd ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplacd (cdadar ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(cdadar ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (cdr ,tmp) (,csetter (car ,tmp))))))))
+       ,body)))
+
+(defplace (cddaddr cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (cdaddr ,cell)))
+         (macrolet ((,getter () ^(cdr ,',cell-sym))
+                    (,setter (val) ^(sys:rplacd ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplacd (cdaddr ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(cdaddr ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (cdr ,tmp) (,csetter (car ,tmp))))))))
+       ,body)))
+
+(defplace (cdddaar cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (cddaar ,cell)))
+         (macrolet ((,getter () ^(cdr ,',cell-sym))
+                    (,setter (val) ^(sys:rplacd ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplacd (cddaar ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(cddaar ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (cdr ,tmp) (,csetter (car ,tmp))))))))
+       ,body)))
+
+(defplace (cdddadr cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (cddadr ,cell)))
+         (macrolet ((,getter () ^(cdr ,',cell-sym))
+                    (,setter (val) ^(sys:rplacd ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplacd (cddadr ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(cddadr ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (cdr ,tmp) (,csetter (car ,tmp))))))))
+       ,body)))
+
+(defplace (cddddar cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (cdddar ,cell)))
+         (macrolet ((,getter () ^(cdr ,',cell-sym))
+                    (,setter (val) ^(sys:rplacd ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplacd (cdddar ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(cdddar ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (cdr ,tmp) (,csetter (car ,tmp))))))))
+       ,body)))
+
+(defplace (cdddddr cell) body
+  (getter setter
+    (with-gensyms (cell-sym)
+      ^(rlet ((,cell-sym (cddddr ,cell)))
+         (macrolet ((,getter () ^(cdr ,',cell-sym))
+                    (,setter (val) ^(sys:rplacd ,',cell-sym ,val)))
+           ,body))))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:rplacd (cddddr ,',cell) ,val)))
+      ,body))
+  (deleter
+    ^(macrolet ((,deleter ()
+                  (with-gensyms (tmp)
+                    (with-update-expander (cgetter csetter) '(cddddr ,cell) nil
+                      ^(let ((,tmp (,cgetter)))
+                         (prog1 (cdr ,tmp) (,csetter (car ,tmp))))))))
+       ,body)))
diff --git a/txr.1 b/txr.1
index 7123f898..2cebedce 100644
--- a/txr.1
+++ b/txr.1
@@ -14171,6 +14171,86 @@ then
 .code nil
 is returned.
 
+.coNP Accessors @, caar @, cadr @, cdar @, cddr ... @ cdddddr
+.synb
+.mets (caar << object )
+.mets (cadr << object )
+.mets (cdar << object )
+.mets (cddr << object )
+.mets ...
+.mets (cdddr << object )
+.mets (set (caar << object ) << new-value )
+.mets (set (cadr << object ) << new-value )
+.mets ...
+.syne
+.desc
+The
+.I a-d accessors
+provide a shorthand notation for accessing two to five
+levels deep into a cons-cell-based tree structure. For instance, the
+the equivalent of the nested function call expression
+.cblk
+.meti (car (car (cdr << object )))
+.cble
+can be achieved using the single function call
+.cblk
+.meti (caadr << object ).
+The symbol names of the a-d accessors are a generalization of the words
+"car" and "cdr". They encodes the pattern of
+.code car
+and
+.code cdr
+traversal of the structure using a sequence of the the letters
+.code a
+and
+.code d
+placed between
+.code c
+and
+.codn r .
+The traversal is encoded in right-to-left order, so that
+.code cadr
+indicates a traversal of the
+.code cdr
+link, followed by the
+.codn car .
+This order corresponds to the nested function call notation, which also
+encodes the traversal right-to-left. The following diagram illustrates
+the straightforward relationship:
+.cblk
+  (cdr (car (cdr x)))
+    ^    ^    ^
+    |   /     |
+    |  /     /
+    | / ____/
+    || /
+  (cdadr x)
+.cble
+
+\*(TL provides all possible a-d accessors up to five levels deep, from
+.code caar
+all the way through
+.codn cdddddr .
+
+Expressions involving a-d accessors are places. For example,
+.code (caddr x)
+denotes the same place as
+.codn (car (cddr x)) ,
+and
+.code (cdadr x)
+denotes the same place as
+.codn (cdr (cadr x)) .
+
+The a-d accessor places support deletion, with semantics derived from
+the deletion semantics of the
+.code car
+and
+.code cdr
+places. For example,
+.code (del (caddr x))
+means the same as
+.code (del (car (cddr x))) .
+
 .coNP Functions @ flatten and @ flatten*
 .synb
 .mets (flatten << list )