file layout: moving share/txr/stdlib to stdlib.

This affects run-time also. Txr installations where the
executable is not in directory ending in ${bindir}
will look for stdlib rather than share/txr/stdlib,
relative to the determined installation directory.

* txr.c (sysroot_init): If we detect relative to the short
name, or fall back on the program directory, use stdlib
rather than share/txr/stdlib as the stdlib_path.

* INSTALL: Update some installation notes not to refer to
share/txr/stdlib but stdlib.

* Makefile (STDLIB_SRCS): Refer to stdlib, not
share/txr/stdlib.
(clean): In unconfigured mode, remove the old share/txr/stdlib
entirely.  Remove .tlo files from stdlib.
(install): Install lib materials from stdlib.

* txr.1: Updated documentation under Deployment Directory Structure.

* share/txr/stdlib/{asm,awk,build,cadr}.tl:
Renamed to stdlib/{asm,awk,build,cadr}.tl.

* share/txr/stdlib/{compiler,conv,copy-file,debugger}.tl:
Renamed to stdlib/{compiler,conv,copy-file,debugger}.tl.

* share/txr/stdlib/{defset,doc-lookup,doc-syms,doloop}.tl:
Renamed to stdlib/{defset,doc-lookup,doc-syms,doloop}.tl.

* share/txr/stdlib/{each-prod,error,except,ffi}.tl:
Renamed to stdlib/{each-prod,error,except,ffi}.tl.

* share/txr/stdlib/{getopts,getput,hash,ifa}.tl:
Renamed to stdlib/{getopts,getput,hash,ifa}.tl.

* share/txr/stdlib/{keyparams,match,op,optimize}.tl:
Renamed to stdlib/{keyparams,match,op,optimize}.tl.

* share/txr/stdlib/{package,param,path-test,pic}.tl:
Renamed to stdlib/{package,param,path-test,pic}.tl.

* share/txr/stdlib/{place,pmac,quips,save-exe}.tl:
Renamed to stdlib/{place,pmac,quips,save-exe}.tl.

* share/txr/stdlib/{socket,stream-wrap,struct,tagbody}.tl:
Renamed to stdlib/{socket,stream-wrap,struct,tagbody}.tl.

* share/txr/stdlib/{termios,trace,txr-case,type}.tl:
Renamed to stdlib/{termios,trace,txr-case,type}.tl.

* share/txr/stdlib/{ver,vm-param,with-resources,with-stream}.tl:
Renamed to stdlib/{ver,vm-param,with-resources,with-stream}.tl.

* share/txr/stdlib/yield.tl: Renamed to stdlib/yield.tl.

* share/txr/stdlib/{txr-case,ver}.txr:
Renamed to stdlib/{txr-case,ver}.txr.

* gencadr.txr: Update to stdlib/place.tl.

* genman.txr: Update to stdlib/cadr.tl.

47 files changed, 0 insertions, 13822 deletions

diff --git a/share/txr/stdlib/asm.tl b/share/txr/stdlib/asm.tl
deleted file mode 100644
index 624ddff6..00000000
--- a/share/txr/stdlib/asm.tl
+++ /dev/null
@@ -1,782 +0,0 @@
-;; Copyright 2018-2021
-;; Kaz Kylheku <kaz@kylheku.com>
-;; Vancouver, Canada
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are met:
-;;
-;; 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 BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(load "vm-param")
-
-(defstruct oc-base nil
-  (:static deprecated nil)
-  (:method synerr (me fmt . args)
-    (error `opcode @{me.symbol}: @fmt` . args))
-
-  (:method chk-arg-count (me n syntax)
-    (when (neq (length (rest syntax)) n)
-      me.(synerr "~s arguments required; ~s is invalid"
-                 n syntax)))
-
-  (:method chk-arg-count-min (me n syntax)
-    (when (< (length (rest syntax)) n)
-      me.(synerr "~s arguments required; ~s is invalid"
-                 n syntax)))
-
-  (:method backpatch (me asm at offs)
-    (asm-error `@{me.symbol} doesn't backpatch`)))
-
-(compile-only
-  (defstruct assembler nil
-    buf
-    bstr
-    (max-treg 0)
-    (labdef (hash))
-    (labref (hash))
-    (:static imm-width (relate '(si mi bi) '(10 16 32)))
-    (:static sign-bits (relate '(fixnum bignum chr) '(1 1 0)))
-    (:static operand-name (relate '(si mi bi l r rs d ds n o)
-                                  '("small immediate"
-                                    "medium immediate"
-                                    "big immediate"
-                                    "label"
-                                    "register operand"
-                                    "register small operand"
-                                    "register destination operand"
-                                    "register small destination operand"
-                                    "integer"
-                                    "any object")))))
-
-(defmeth assembler :postinit (me)
-  (cond
-    (me.buf (set me.bstr (make-buf-stream me.buf)))
-    (me.bstr (set me.buf (get-buf-from-stream me.bstr)))
-    (t (set me.bstr (make-buf-stream)
-            me.buf (get-buf-from-stream me.bstr)))))
-
-(defmeth assembler cur-pos (me)
-  (seek-stream me.bstr 0 :from-current))
-
-(defmeth assembler set-pos (me pos)
-  (seek-stream me.bstr pos :from-start))
-
-(defmeth assembler lookup-label (me sym oc)
-  (condlet
-    (((n [me.labdef sym])) n)
-    (t (push (cons oc (trunc me.(cur-pos) 4)) [me.labref sym])
-       0)))
-
-(defmeth assembler define-label (me sym)
-  (let* ((pos me.(cur-pos))
-         (ins (trunc pos 4)))
-    (set [me.labdef sym] ins)
-    (each ((entry (del [me.labref sym])))
-      (tree-bind (oc . offs) entry
-        me.(set-pos (* 4 offs))
-        oc.(backpatch me (* 4 offs) ins)))
-    me.(set-pos pos)
-    ins))
-
-(defmeth assembler read-buf (me bytes)
-  (let ((buf (make-buf bytes)))
-    (when (neql (fill-buf buf 0 me.bstr) bytes)
-      (asm-error "read past instruction block"))
-    buf))
-
-(defmeth assembler put-word (me word)
-  (let* ((buf (make-buf 0)))
-    (buf-put-u32 buf 0 word)
-    (put-buf buf 0 me.bstr)))
-
-(defmeth assembler put-insn (me code extension operand)
-  (let ((word (logior (ash code 26) (ash extension 16) operand))
-        (buf (make-buf 0)))
-    (buf-put-u32 buf 0 word)
-    (put-buf buf 0 me.bstr)))
-
-(defmeth assembler put-pair (me op1 op2)
-  (let ((word (logior (ash op1 16) op2))
-        (buf (make-buf 0)))
-    (buf-put-u32 buf 0 word)
-    (put-buf buf 0 me.bstr)))
-
-(defmeth assembler get-word (me)
-  (let* ((buf me.(read-buf (sizeof uint32))))
-    (buf-get-u32 buf 0)))
-
-(defmeth assembler get-insn (me)
-  (let* ((buf me.(read-buf (sizeof uint32)))
-         (word (buf-get-u32 buf 0)))
-    (list (ash word -26)
-          (logtrunc (ash word -16) 10)
-          (logtrunc word 16))))
-
-(defmeth assembler get-pair (me)
-  (let* ((buf me.(read-buf (sizeof uint32)))
-         (word (buf-get-u32 buf 0)))
-    (list (ash word -16) (logtrunc word 16))))
-
-(defmeth assembler immediate-fits-type (me arg operand-type)
-  (and (member (typeof arg)
-               '(fixnum chr))
-       (<= (+ (width arg)
-              [me.sign-bits (typeof arg)]
-              2)
-           [me.imm-width operand-type])))
-
-(defmeth assembler parse-args (me oc syntax pattern)
-  (mapcar (lambda (type arg n)
-            (let ((parg (caseql type
-                          ((si mi bi)
-                           (when me.(immediate-fits-type arg type)
-                             arg))
-                          (l (cond
-                               ((is-label arg) me.(lookup-label arg oc))
-                               ((integerp arg) arg)))
-                          (n (if (integerp arg) arg))
-                          (o arg)
-                          ((r rs d ds)
-                           (cond
-                             ((null arg) 0)
-                             ((consp arg)
-                              (parse-compound-operand arg))
-                             ((symbolp arg)
-                              (parse-operand (symbol-name arg)))))
-                          (t (asm-error "invalid arg type spec ~s" type)))))
-              (unless (or parg (eq type 'o))
-                oc.(synerr "argument ~a of ~s invalid; ~a expected"
-                           n syntax [me.operand-name type]))
-              (when (and (member type '(d ds))
-                         (or (zerop parg)))
-                oc.(synerr "argument ~a of ~s cannot be destination"
-                           n syntax))
-              (when (and (member type '(rs ds))
-                         (not (small-op-p parg)))
-                oc.(synerr "argument ~a of ~s isn't a small register"
-                           n syntax))
-              (when (and (member type '(r rs d ds)) (< parg %lev-size%))
-                (set me.max-treg (max parg me.max-treg)))
-              parg))
-          pattern (rest syntax) (range 1)))
-
-(defmeth assembler asm-one (me syntax)
-  (let ((oc (cond
-              ((is-label syntax) [%oc-hash% 'label])
-              ((consp syntax) [%oc-hash% (car syntax)]))))
-    (unless oc
-      (asm-error "invalid instruction ~s" syntax))
-    oc.(asm me syntax)))
-
-(defmeth assembler asm (me insns)
-  (each ((i insns))
-    me.(asm-one i))
-  (unless (empty me.labref)
-    (asm-error "dangling label references"))
-  (whenlet ((n (cdr [find-max me.labdef : cdr])))
-    (unless (< -1 n (len me.buf))
-      (asm-error "labels outside of code"))))
-
-(defmeth assembler dis-one (me)
-  (tree-bind (code extension operand) me.(get-insn)
-    (let ((oc [%oc-hash% code]))
-      oc.(dis me extension operand))))
-
-(defmeth assembler dis (me)
-  me.(set-pos 0)
-  (build
-    (while (< me.(cur-pos) (len me.buf))
-      (add me.(dis-one)))))
-
-(defmeth assembler dis-listing (me : (stream *stdout*))
-  (let ((p 0)
-        (c 0)
-        (l (len me.buf)))
-    me.(set-pos p)
-    (while (< p l)
-      (let* ((dis me.(dis-one))
-             (dis-txt (cat-str [mapcar tostringp dis] " "))
-             (q me.(cur-pos)))
-        (inc c)
-        me.(set-pos p)
-        (format t "~,5d: ~,08X ~a\n" (trunc p 4) me.(get-word) dis-txt)
-        (while (< (inc p 4) q)
-          (format t "~,5d: ~,08X\n" (trunc p 4) me.(get-word)))
-        me.(set-pos q)
-        (set p q)))
-    c))
-
-(defvarl %oc-list-builder% (new list-builder))
-
-(defvarl %oc-hash% (hash))
-
-(defparml %oc-code% 0)
-
-(defun asm-error (msg . args)
-  (error `~s: @msg` 'assembler . args))
-
-(defun register-opcode (oc)
-  %oc-list-builder%.(add oc)
-  (set [%oc-hash% oc.symbol] oc)
-  (set [%oc-hash% oc.code] oc))
-
-(defun is-label (obj)
-  (or (keywordp obj)
-      (and (symbolp obj)
-           (not (symbol-package obj)))))
-
-(defun parse-compound-operand (cons)
-  (tree-case cons
-    ((sym arg)
-     (when (< -1 arg %lev-size%)
-       (caseq sym
-         ((t) arg)
-         (d (+ arg %lev-size%)))))
-    ((sym arg1 arg2)
-     (when (and (<= 0 arg1 %max-v-lev%)
-                (<= 0 arg2 %max-lev-idx%))
-       (caseq sym
-         (v (+ (* (ssucc arg1) %lev-size%) arg2)))))))
-
-(defun parse-operand (str)
-  (cond
-    ((r^$ #/t[0-9A-Fa-f][0-9A-Fa-f]?[0-9A-Fa-f]?/ str)
-     (int-str [str 1..:] 16))
-    ((r^$ #/d[0-9A-Fa-f][0-9A-Fa-f]?[0-9A-Fa-f]?/ str)
-     (+ %lev-size% (int-str [str 1..:] 16)))
-    ((r^$ #/v[0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f]/ str)
-       (let ((lv (int-str [`0@{str[1..:]}` -5..-3] 16))
-             (ix (int-str [str -3..:] 16)))
-         (+ (* %lev-size% (ssucc lv)) ix)))))
-
-(eval-only
-  (defmacro with-lev-idx ((lev-var idx-var) val-expr . body)
-    (with-gensyms (val-var)
-      ^(let* ((,val-var ,val-expr)
-              (,lev-var (ash ,val-var (- %lev-bits%)))
-              (,idx-var (logtrunc ,val-var %lev-bits%)))
-         ,*body))))
-
-(defun operand-to-sym (val)
-  (with-lev-idx (lv ix) val
-    (caseql lv
-      (0 (if (zerop ix)
-           nil
-           (intern (fmt "t~s" ix))))
-      (1 (intern (fmt "d~s" ix)))
-      (t (intern (fmt "v~,02X~,03X" (ppred lv) ix))))))
-
-(defun operand-to-exp (val)
-  (with-lev-idx (lv ix) val
-    (caseql lv
-      (0 (if (zerop ix)
-           nil
-           ^(t ,ix)))
-      (1 ^(d ,ix))
-      (t ^(v ,(ppred lv) ,ix)))))
-
-(defun bits-to-obj (bits width)
-  (let ((tag (logtrunc bits 2))
-        (val (ash bits -2)))
-    (caseq tag
-      (1 (sign-extend val (- width 2)))
-      (2 (chr-int val))
-      (t (error "~s: bad immediate operand: ~x" 'assembler bits)))))
-
-(defun small-op-p (val)
-  (with-lev-idx (lv ix) val
-    (and (<= 0 ix %max-sm-lev-idx%)
-         (<= 0 lv %max-sm-lev%))))
-
-(defun enc-small-op (val)
-  (with-lev-idx (lv ix) val
-    (logior (ash lv %sm-lev-bits%) ix)))
-
-(defun small-op-to-sym (sval)
-  (let ((lv (ash sval (- %sm-lev-bits%)))
-        (ix (logtrunc sval %sm-lev-bits%)))
-    (operand-to-sym (+ (* lv %lev-size%) ix))))
-
-(defstruct backpatch-low16 nil
-  (:method backpatch (me asm at offs)
-    (tree-bind (hi lo) asm.(get-pair)
-      asm.(set-pos at)
-      asm.(put-pair hi offs))))
-
-(defstruct backpatch-high16 nil
-  (:method backpatch (me asm at offs)
-    (tree-bind (hi lo) asm.(get-pair)
-      asm.(set-pos at)
-      asm.(put-pair offs lo))))
-
-(defvarl %backpatch-low16% (new backpatch-low16))
-(defvarl %backpatch-high16% (new backpatch-high16))
-
-(eval-only
-  (defmacro defopcode (class symbol code . slot-defs)
-    ^(symacrolet ((auto (pinc %oc-code%)))
-       (defstruct ,class oc-base
-         (:static symbol ',symbol)
-         (:static code ,code)
-         ,*slot-defs)
-       (register-opcode (new ,class))))
-
-  (defmacro defopcode-derived (class symbol code orig-class)
-    ^(symacrolet ((auto (pinc %oc-code%)))
-       (defstruct ,class ,orig-class
-         (:static symbol ',symbol)
-         (:static code ,code))
-       (register-opcode (new ,class))))
-
-  (defmacro defopcode-alias (alias-symbol orig-symbol)
-    ^(let ((oc [%oc-hash% ',orig-symbol]))
-       (set [%oc-hash% ',alias-symbol] oc))))
-
-(defopcode op-label label nil
-  (:method asm (me asm syntax)
-    (unless (is-label syntax)
-      asm.(synerr "label must be keyword or gensym"))
-    asm.(define-label syntax))
-
-  (:method dis (me asm extension operand)))
-
-(defopcode op-noop noop auto
-  (:method asm (me asm syntax)
-    me.(chk-arg-count 0 syntax)
-    asm.(put-insn me.code 0 0))
-
-  (:method dis (me asm extension operand)
-    ^(,me.symbol)))
-
-(defopcode op-frame frame auto
-  (:method asm (me asm syntax)
-    me.(chk-arg-count 2 syntax)
-    (tree-bind (lev size) asm.(parse-args me syntax '(n n))
-      (unless (<= 2 lev %max-v-lev%)
-        me.(synerr "level must range from 2 to ~a"
-                   %max-v-lev%))
-      (unless (<= 0 size %lev-size%)
-        me.(synerr "size must range from 0 to ~a"
-                   %lev-size%))
-      asm.(put-insn me.code lev size)))
-  (:method dis (me asm lev size)
-    ^(,me.symbol ,lev ,size)))
-
-(defopcode-derived op-sframe sframe auto op-frame)
-
-(defopcode-derived op-dframe dframe auto op-frame)
-
-(defopcode op-end end auto
-  (:method asm (me asm syntax)
-    me.(chk-arg-count 1 syntax)
-    (let ((res (car asm.(parse-args me syntax '(r)))))
-      asm.(put-insn me.code 0 res)))
-  (:method dis (me asm extension res)
-    ^(,me.symbol ,(operand-to-sym res))))
-
-(defopcode-alias jend end)
-
-(defopcode-derived op-prof prof auto op-end)
-
-(defopcode op-call call auto
-  (:method asm (me asm syntax)
-    me.(chk-arg-count-min 2 syntax)
-    (let* ((nargs (pred (len syntax)))
-           (syn-pat (repeat '(r) (succ nargs)))
-           (funargs (ppred nargs))
-           (args asm.(parse-args me syntax syn-pat)))
-      asm.(put-insn me.code funargs (pop args))
-      (while args
-        (let ((x (pop args))
-              (y (or (pop args) 0)))
-          asm.(put-pair y x)))))
-
-  (:method dis (me asm funargs arg0)
-    (build
-      (add me.symbol)
-      (add (operand-to-sym arg0))
-      (inc funargs 1)
-      (while (> funargs 0)
-        (dec funargs 2)
-        (tree-bind (y x) asm.(get-pair)
-          (add (operand-to-sym x))
-          (unless (minusp funargs)
-            (add (operand-to-sym y))))))))
-
-(defopcode-derived op-apply apply auto op-call)
-
-(defopcode op-gcall gcall auto
-  (:method asm (me asm syntax)
-    me.(chk-arg-count-min 2 syntax)
-    (let* ((nargs (pred (len syntax)))
-           (syn-pat (list* 'r 'n (repeat '(r) (sssucc nargs))))
-           (funargs (ppred nargs))
-           (args asm.(parse-args me syntax syn-pat)))
-      asm.(put-insn me.code funargs (pop args))
-      (while args
-        (let ((x (pop args))
-              (y (or (pop args) 0)))
-          asm.(put-pair y x)))))
-
-  (:method dis (me asm funargs arg0)
-    (let ((first t))
-      (build
-        (add me.symbol)
-        (add (operand-to-sym arg0))
-        (inc funargs 1)
-        (while (> funargs 0)
-          (dec funargs 2)
-          (tree-bind (y x) asm.(get-pair)
-            (add (if (zap first) x (operand-to-sym x)))
-            (unless (minusp funargs)
-              (add (operand-to-sym y)))))))))
-
-(defopcode-derived op-gapply gapply auto op-gcall)
-
-(defopcode op-movrs movrs auto
-  (:method asm (me asm syntax)
-    me.(chk-arg-count 2 syntax)
-    (tree-bind (dst src) asm.(parse-args me syntax '(d rs))
-      asm.(put-insn me.code (enc-small-op src) dst)))
-
-  (:method dis (me asm src dst)
-    ^(,me.symbol ,(operand-to-sym dst) ,(small-op-to-sym src))))
-
-(defopcode op-movsr movsr auto
-  (:method asm (me asm syntax)
-    me.(chk-arg-count 2 syntax)
-    (tree-bind (dst src) asm.(parse-args me syntax '(ds r))
-      asm.(put-insn me.code (enc-small-op dst) src)))
-
-  (:method dis (me asm dst src)
-    ^(,me.symbol ,(small-op-to-sym dst) ,(operand-to-sym src))))
-
-(defopcode op-movrr movrr auto
-  (:method asm (me asm syntax)
-    me.(chk-arg-count 2 syntax)
-    (tree-bind (dst src) asm.(parse-args me syntax '(d r))
-      asm.(put-insn me.code 0 dst)
-      asm.(put-pair 0 src)))
-
-  (:method dis (me asm extension dst)
-    (let ((src (cadr asm.(get-pair))))
-      ^(,me.symbol ,(operand-to-sym dst) ,(operand-to-sym src)))))
-
-(defopcode op-mov-pseudo mov nil
-  (:method asm (me asm syntax)
-    (tree-bind (dst src) asm.(parse-args me syntax '(d r))
-      (let ((real [%oc-hash% (cond
-                               ((small-op-p dst) 'movsr)
-                               ((small-op-p src) 'movrs)
-                               (t 'movrr))]))
-        real.(asm asm syntax)))))
-
-(defopcode op-jmp jmp auto
-  (:method asm (me asm syntax)
-    me.(chk-arg-count 1 syntax)
-    (let ((dst (car asm.(parse-args me syntax '(l)))))
-      asm.(put-insn me.code (ash dst -16) (logtrunc dst 16))))
-
-  (:method backpatch (me asm at dst)
-    asm.(put-insn me.code (ash dst -16) (logtrunc dst 16)))
-
-  (:method dis (me asm high16 low16)
-    ^(,me.symbol ,(logior (ash high16 16) low16))))
-
-(defopcode op-if if auto
-  (:method asm (me asm syntax)
-    me.(chk-arg-count 2 syntax)
-    (tree-bind (reg dst) asm.(parse-args me syntax '(r l))
-      asm.(put-insn me.code (ash dst -16) (logtrunc dst 16))
-      asm.(put-pair 0 reg)))
-
-  (:method backpatch (me asm at dst)
-    asm.(put-insn me.code (ash dst -16) (logtrunc dst 16)))
-
-  (:method dis (me asm high16 low16)
-    (let ((dst (logior (ash high16 16) low16))
-          (reg (cadr asm.(get-pair))))
-      ^(,me.symbol ,(operand-to-sym reg) ,dst))))
-
-(defopcode op-ifq ifq auto
-  (:method asm (me asm syntax)
-    me.(chk-arg-count 3 syntax)
-    (tree-bind (lreg rreg dst) asm.(parse-args me syntax '(r r l))
-      asm.(put-insn me.code (ash dst -16) (logtrunc dst 16))
-      asm.(put-pair lreg rreg)))
-
-  (:method backpatch (me asm at dst)
-    asm.(put-insn me.code (ash dst -16) (logtrunc dst 16)))
-
-  (:method dis (me asm high16 low16)
-    (let ((dst (logior (ash high16 16) low16)))
-      (tree-bind (lreg rreg) asm.(get-pair)
-      ^(,me.symbol ,(operand-to-sym lreg) ,(operand-to-sym rreg) ,dst)))))
-
-(defopcode-derived op-ifql ifql auto op-ifq)
-
-(defopcode op-swtch swtch auto
-  (:method asm (me asm syntax)
-    me.(chk-arg-count-min 1 syntax)
-    (let* ((args asm.(parse-args me syntax '(r)))
-           (lbls (cddr syntax))
-           (tblsz (len lbls)))
-      asm.(put-insn me.code tblsz (car args))
-      (while lbls
-        (let ((x asm.(lookup-label (pop lbls) %backpatch-low16%))
-              (y (if lbls
-                   asm.(lookup-label (pop lbls) %backpatch-high16%)
-                   0)))
-          asm.(put-pair y x)))))
-
-  (:method dis (me asm tblsz switch-val)
-    (build
-      (add me.symbol)
-      (add (operand-to-sym switch-val))
-      (while (> tblsz 0)
-        (dec tblsz 2)
-        (tree-bind (y x) asm.(get-pair)
-          (add x)
-          (unless (minusp tblsz)
-            (add y)))))))
-
-(defopcode-derived op-uwprot uwprot auto op-jmp)
-
-(defopcode op-block block auto
-  (:method asm (me asm syntax)
-    me.(chk-arg-count 3 syntax)
-    (tree-bind (outreg blname exitpt) asm.(parse-args me syntax '(d r l))
-      asm.(put-insn me.code (ash exitpt -16) (logtrunc exitpt 16))
-      asm.(put-pair outreg blname)))
-
-  (:method backpatch (me asm at exitpt)
-    asm.(put-insn me.code (ash exitpt -16) (logtrunc exitpt 16)))
-
- (:method dis (me asm high16 low16)
-   (let ((exitpt (logior (ash high16 16) low16)))
-     (tree-bind (outreg blname) asm.(get-pair)
-       ^(,me.symbol ,(operand-to-sym outreg) ,(operand-to-sym blname)
-                    ,exitpt)))))
-
-(defopcode op-retsr retsr auto
-  (:method asm (me asm syntax)
-    me.(chk-arg-count 2 syntax)
-    (tree-bind (name reg) asm.(parse-args me syntax '(rs r))
-      asm.(put-insn me.code (enc-small-op name) reg)))
-
-  (:method dis (me asm name reg)
-    ^(,me.symbol ,(small-op-to-sym name) ,(operand-to-sym reg))))
-
-(defopcode op-retrs retrs auto
-  (:method asm (me asm syntax)
-    me.(chk-arg-count 2 syntax)
-    (tree-bind (name reg) asm.(parse-args me syntax '(r rs))
-      asm.(put-insn me.code (enc-small-op reg) name)))
-
-  (:method dis (me asm reg name)
-    ^(,me.symbol ,(operand-to-sym name) ,(small-op-to-sym reg))))
-
-(defopcode op-retrr retrr auto
-  (:method asm (me asm syntax)
-    me.(chk-arg-count 2 syntax)
-    (tree-bind (name reg) asm.(parse-args me syntax '(r r))
-      asm.(put-insn me.code 0 reg)
-      asm.(put-pair 0 name)))
-
-  (:method dis (me asm extension reg)
-    (let ((name (cadr asm.(get-pair))))
-      ^(,me.symbol ,(operand-to-sym name) ,(operand-to-sym reg)))))
-
-(defopcode op-ret-pseudo ret nil
-  (:method asm (me asm syntax)
-    me.(chk-arg-count 2 syntax)
-    (tree-bind (name reg) asm.(parse-args me syntax '(r r))
-      (let ((real [%oc-hash% (cond
-                               ((small-op-p name) 'retsr)
-                               ((small-op-p reg) 'retrs)
-                               (t 'retrr))]))
-        real.(asm asm syntax)))))
-
-(defopcode-derived op-abscsr abscsr auto op-retsr)
-
-(defopcode op-catch catch auto
-  (:method asm (me asm syntax)
-    me.(chk-arg-count 5 syntax)
-    (tree-bind (sym args catch-syms desc dst)
-               asm.(parse-args me syntax '(d d r r l))
-      asm.(put-insn me.code (ash dst -16) (logtrunc dst 16))
-      asm.(put-pair sym args)
-      asm.(put-pair desc catch-syms)))
-
-  (:method backpatch (me asm at dst)
-    asm.(put-insn me.code (ash dst -16) (logtrunc dst 16)))
-
- (:method dis (me asm high16 low16)
-   (let ((dst (logior (ash high16 16) low16)))
-     (tree-bind (sym args) asm.(get-pair)
-       (tree-bind (desc catch-syms) asm.(get-pair)
-         ^(,me.symbol ,(operand-to-sym sym) ,(operand-to-sym args)
-                      ,(operand-to-sym catch-syms)
-                      ,(operand-to-sym desc) ,dst))))))
-
-(defopcode op-handle handle auto
-  (:method asm (me asm syntax)
-    me.(chk-arg-count 2 syntax)
-    (tree-bind (fun handle-syms) asm.(parse-args me syntax '(r r))
-      asm.(put-insn me.code 0 fun)
-      asm.(put-pair fun handle-syms)))
-
- (:method dis (me asm extension fun)
-     (let ((handle-syms (cadr asm.(get-pair))))
-       ^(,me.symbol ,(operand-to-sym fun) ,(operand-to-sym handle-syms)))))
-
-(defopcode op-getv getv auto
-  (:method asm (me asm syntax)
-    me.(chk-arg-count 2 syntax)
-    (tree-bind (reg name) asm.(parse-args me syntax '(d r))
-      (unless (small-op-p name)
-        asm.(asm-one ^(mov (t 1) ,(operand-to-exp name)))
-        (set name 1))
-      asm.(put-insn me.code (enc-small-op name) reg)))
-  (:method dis (me asm name reg)
-    ^(,me.symbol ,(operand-to-sym reg) ,(small-op-to-sym name))))
-
-(defopcode-derived op-oldgetf oldgetf auto op-getv)
-
-(defopcode-derived op-getl1 getl1 auto op-getv)
-
-(defopcode-derived op-getvb getvb auto op-getv)
-
-(defopcode-derived op-getfb getfb auto op-getv)
-
-(defopcode-derived op-getl1b getl1b auto op-getv)
-
-(defopcode op-setv setv auto
-  (:method asm (me asm syntax)
-    me.(chk-arg-count 2 syntax)
-    (tree-bind (reg name) asm.(parse-args me syntax '(r r))
-      (unless (small-op-p name)
-        asm.(asm-one ^(mov (t 1) ,(operand-to-exp name)))
-        (set name 1))
-      asm.(put-insn me.code (enc-small-op name) reg)))
-  (:method dis (me asm name reg)
-    ^(,me.symbol ,(operand-to-sym reg) ,(small-op-to-sym name))))
-
-(defopcode-derived op-setl1 setl1 auto op-setv)
-
-(defopcode-derived op-bindv bindv auto op-setv)
-
-(defopcode op-close close auto
-  (:method asm (me asm syntax)
-    me.(chk-arg-count-min 6 syntax)
-    (let* ((syn-pat (repeat '(d) (- (length syntax) 7))))
-      (tree-bind (reg frsize ntreg dst fix req vari . regs)
-                 asm.(parse-args me syntax ^(d n n l n n o,*syn-pat))
-        (unless (<= 0 frsize %lev-size%)
-          me.(synerr "frame size must be 0 to ~a" %lev-size%))
-        asm.(put-insn me.code (ash dst -16) (logtrunc dst 16))
-        asm.(put-pair (logior (ash (if vari 1 0) %lev-bits%) frsize) reg)
-        asm.(put-pair req fix)
-        asm.(put-pair 0 ntreg)
-        (unless (eql fix (- (len regs) (if vari 1 0)))
-          me.(synerr "wrong number of registers"))
-        (while regs
-          (let ((x (pop regs))
-                (y (or (pop regs) 0)))
-            asm.(put-pair y x))))))
-
-  (:method backpatch (me asm at dst)
-    asm.(put-insn me.code (ash dst -16) (logtrunc dst 16)))
-
-  (:method dis (me asm high16 low16)
-    (let ((dst (logior (ash high16 16) low16)))
-      (tree-bind (vari-frsize reg) asm.(get-pair)
-        (let ((vari (bit vari-frsize %lev-bits%)))
-          (tree-bind (req fix) asm.(get-pair)
-            (tree-bind (ign ntreg) asm.(get-pair)
-              (build
-                (add me.symbol (operand-to-sym reg)
-                     (logtrunc vari-frsize %lev-bits%)
-                     ntreg dst fix req vari)
-                (when vari
-                  (inc fix))
-                (while (> fix 0)
-                  (dec fix 2)
-                  (tree-bind (y x) asm.(get-pair)
-                    (add (operand-to-sym x))
-                    (unless (minusp fix)
-                      (add (operand-to-sym y)))))))))))))
-
-(defopcode op-getlx getlx auto
-  (:method asm (me asm syntax)
-    me.(chk-arg-count 2 syntax)
-    (tree-bind (dst idx) asm.(parse-args me syntax '(d n))
-      (cond
-        ((small-op-p dst)
-         asm.(put-insn me.code (enc-small-op dst) idx))
-        (t asm.(put-insn me.code (enc-small-op 1) idx)
-           asm.(asm-one ^(mov ,(operand-to-exp dst) t1))))))
-  (:method dis (me asm dst idx)
-    ^(,me.symbol ,(small-op-to-sym dst) ,idx)))
-
-(defopcode op-setlx setlx auto
-  (:method asm (me asm syntax)
-    me.(chk-arg-count 2 syntax)
-    (tree-bind (src idx) asm.(parse-args me syntax '(r n))
-      (cond
-        ((small-op-p src)
-         asm.(put-insn me.code (enc-small-op src) idx))
-        (t asm.(asm-one ^(mov t1 ,(operand-to-exp src)))
-           asm.(put-insn me.code (enc-small-op 1) idx)))))
-  (:method dis (me asm src idx)
-    ^(,me.symbol ,(small-op-to-sym src) ,idx)))
-
-(defopcode-derived op-getf getf auto op-getlx)
-
-(defun disassemble-cdf (code data funv *stdout*)
-  (let ((asm (new assembler buf code)))
-    (put-line "data:")
-    (mapdo (do format t "~5d: ~s\n" @1 @2) (range 0) data)
-    (put-line "syms:")
-    (mapdo (do format t "~5d: ~s\n" @1 @2) (range 0) funv)
-    (put-line "code:")
-    (let ((ninsn asm.(dis-listing)))
-      (put-line "instruction count:")
-      (format t "~5d\n" ninsn))))
-
-(defun disassemble (obj : (stream *stdout*))
-  (symacrolet ((self 'vm-disassemble-obj))
-    (typecase obj
-      (vm-desc (disassemble-cdf (vm-desc-bytecode obj)
-                                (vm-desc-datavec obj)
-                                (vm-desc-symvec obj)
-                                stream))
-      (fun (unless (vm-fun-p obj)
-             (error "~s: not a vm function: ~s" self obj))
-           (let* ((clo (func-get-env obj))
-                  (desc (sys:vm-closure-desc clo))
-                  (ip (sys:vm-closure-entry clo)))
-             (disassemble desc stream)
-             (put-line "entry point:")
-             (format stream "~5d\n" ip)))
-      (t (iflet ((fun (symbol-function obj)))
-           (disassemble fun stream)
-           (error "~s: not a compiled object: ~s" self obj))))
-    obj))
diff --git a/share/txr/stdlib/awk.tl b/share/txr/stdlib/awk.tl
deleted file mode 100644
index f94d6b9a..00000000
--- a/share/txr/stdlib/awk.tl
+++ /dev/null
@@ -1,518 +0,0 @@
-;; Copyright 2016-2021
-;; Kaz Kylheku <kaz@kylheku.com>
-;; Vancouver, Canada
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are met:
-;;
-;; 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 BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(load "conv")
-
-(defstruct sys:awk-state ()
-  (rs "\n") krs
-  fs ft kfs
-  fw fw-prev fw-ranges
-  (ofs " ")
-  (ors "\n")
-  (inputs)
-  (output *stdout*)
-  (file-num 0)
-  file-name
-  (file-rec-num 0)
-  (rec-num 0)
-  rec orig-rec fields nf
-  rng-vec (rng-n 0)
-  par-mode par-mode-fs par-mode-prev-fs
-  (streams (hash :equal-based))
-  (:fini (self)
-    (dohash (k v self.streams)
-      (close-stream v)))
-  (:postinit (self)
-    (set self.inputs (or self.inputs (zap *args*) (list *stdin*)))
-    (if (plusp self.rng-n)
-      (set self.rng-vec (vector self.rng-n)))
-    (unless (streamp self.output)
-      (let ((stream (open-file self.output "w")))
-        (set [self.streams ^(:outf ,self.output)] stream
-             self.output stream)))))
-
-(defstruct sys:awk-compile-time ()
-  inputs output name lets
-  begin-file-actions end-file-actions
-  begin-actions end-actions
-  cond-actions
-  (nranges 0)
-  (rng-rec-temp (gensym))
-  (rng-vec-temp (gensym))
-  rng-expr-temps
-  rng-exprs
-  outer-env)
-
-(defmeth sys:awk-state rec-to-f (self)
-  (cond
-    (self.fw
-      (unless (eq self.fw-prev self.fw)
-        (let ((ranges (reduce-left
-                        (tb ((list . sum) item)
-                          (let ((ns (+ sum item)))
-                            ^((,*list #R(,sum ,ns)) . ,ns)))
-                        self.fw '(nil . 0))))
-        (set self.fw-prev self.fw
-             self.fw-ranges (car ranges))))
-      (let ((i 0) end
-            (l (length self.rec)))
-        (set self.fields
-             (build (each ((r self.fw-ranges))
-                      (set end (to r))
-                      (if (>= (from r) l)
-                        (return nil))
-                      (add [self.rec r])
-                      (inc i))
-               (if (< end l)
-                 (add [self.rec end..:])))
-             self.nf i)))
-    (self.fs
-      (when self.ft
-        (awk-error "both fs and ft set"))
-      (if (and (not self.kfs) (equal self.rec ""))
-        (set self.fields nil
-             self.nf 0)
-        (let ((eff-fs (if self.par-mode
-                        (if (equal self.fs self.par-mode-prev-fs)
-                          self.par-mode-fs
-                          (set self.par-mode-prev-fs self.fs
-                               self.par-mode-fs
-                               (regex-compile ^(or ,(if (regexp self.fs)
-                                                      (regex-source self.fs)
-                                                      self.fs)
-                                                   "\n"))))
-                        self.fs)))
-          (set self.fields (split-str self.rec eff-fs self.kfs)
-               self.nf (length self.fields)))))
-    (self.ft
-      (set self.fields (tok-str self.rec self.ft self.kfs)
-           self.nf (length self.fields)))
-    ((set self.fields (tok-str self.rec #/[^ \t\n]+/ self.kfs)
-          self.nf (length self.fields)))))
-
-(defmeth sys:awk-state f-to-rec (self)
-  (set self.rec `@{self.fields self.ofs}`))
-
-(defmeth sys:awk-state nf-to-f (self)
-  (set self.fields (take self.nf (append self.fields (repeat '("")))))
-  self.(f-to-rec))
-
-(defmeth sys:awk-state loop (aws func beg-file-func end-file-func)
-  (whilet ((in (pop aws.inputs)))
-    (block :awk-file
-      (inc aws.file-num)
-      (set aws.file-name (if (streamp in)
-                           (stream-get-prop in :name)
-                           in))
-      (when beg-file-func
-        [beg-file-func aws])
-      (let* ((*stdin* (cond
-                        ((streamp in) in)
-                        ((listp in) (make-strlist-input-stream in))
-                        ((open-file in))))
-             (noted-rs (not aws.rs))
-             (noted-krs (not aws.krs))
-             (cached-rr nil))
-        (flet ((get-rec-reader (*stdin*)
-                 (cond
-                   ((and (equal noted-rs aws.rs) (eq noted-krs aws.krs))
-                    cached-rr)
-                   (t
-                     (set noted-rs aws.rs noted-krs aws.krs)
-                     (set cached-rr
-                          (cond
-                            ((and (equal aws.rs "\n") (not aws.krs))
-                               (set aws.par-mode nil)
-                               (lambda () (get-line *stdin*)))
-                            ((null aws.rs)
-                               (set aws.par-mode t)
-                               (let ((rin (record-adapter #/\n[ \n\t]*\n/))
-                                     (flag t))
-                                 (lambda ()
-                                   (let ((r (get-line rin)))
-                                     (cond
-                                       (flag
-                                         (set flag nil)
-                                         (if (equal r "")
-                                           (get-line rin)
-                                           r))
-                                       (t r))))))
-                            (t
-                              (set aws.par-mode nil)
-                              (let ((rin (record-adapter
-                                           (if (regexp aws.rs) aws.rs
-                                             (regex-compile ^(compound, aws.rs)))
-                                           *stdin*
-                                           aws.krs)))
-                                (lambda () (get-line rin))))))))))
-          (set aws.file-rec-num 0)
-          (unwind-protect
-            (whilet ((rr (get-rec-reader *stdin*))
-                     (rec (call rr)))
-              (set aws.rec rec aws.orig-rec rec)
-              (inc aws.rec-num)
-              (inc aws.file-rec-num)
-              (while* (eq :awk-again (block* :awk-rec [func aws]))
-                aws.(rec-to-f)))
-            (when end-file-func
-              [end-file-func aws])))))))
-
-(defmeth sys:awk-state prn (self . args)
-  (cond
-    (args (for ((a args) next) (a) ((set a next))
-            (put-string `@(car a)`)
-            (put-string (if (set next (cdr a)) self.ofs self.ors))))
-    (t (put-string self.rec)
-       (put-string self.ors))))
-
-(defmeth sys:awk-state ensure-stream (self kind path mode)
-  (hash-update-1 self.streams
-                 ^(,kind ,path)
-                 (do or @1 (caseq kind
-                             ((:inf :outf) (open-file path mode))
-                             ((:inp :outp) (open-command path mode))))
-                 nil))
-
-(defmeth sys:awk-state close-or-flush (self stream kind path val)
-  (cond
-    ((eq val :close) (whenlet ((s (del [self.streams ^(,kind ,path)])))
-                       (close-stream s)))
-    ((memq kind '(:outf outp)) (flush-stream stream) val)
-    (val)))
-
-(defun awk-error (msg . args)
-  (throwf 'eval-error `~s: @msg` 'awk . args))
-
-(defun sys:awk-test (val rec)
-  (caseq (typeof val)
-    ((regex fun) (call val rec))
-    (t val)))
-
-(defun sys:awk%--rng (rng-vec idx from-val to-val)
-  (placelet ((state (vecref rng-vec idx)))
-    (caseq state
-      (nil (cond
-             ((and from-val to-val) nil)
-             (from-val (set state :mid) nil)))
-      (:mid (cond
-              (to-val (set state nil) (not from-val))
-              (from-val nil)
-              (t (set state t))))
-      (t (cond
-           (to-val (set (vecref rng-vec idx) nil) t)
-           (t t))))))
-
-(defun sys:awk%--rng- (rng-vec idx from-val to-val)
-  (placelet ((state (vecref rng-vec idx)))
-    (caseq state
-      (nil (cond
-             ((and from-val to-val) nil)
-             (from-val (set state :mid) nil)))
-      (:mid (cond
-              (to-val (set state nil))
-              (from-val nil)
-              (t (set state t))))
-      (t (cond
-           (to-val (set (vecref rng-vec idx) nil))
-           (t t))))))
-
-(defun sys:awk%rng+ (rng-vec idx from-val to-val)
-  (placelet ((state (vecref rng-vec idx)))
-    (caseq state
-      (nil (cond
-             ((and from-val to-val) (set state :end) t)
-             (from-val (set state t))))
-      (:end (cond
-              (to-val t)
-              (from-val (set state t))
-              (t (set state nil) nil)))
-      (t (cond
-           (to-val (set state :end) t)
-           (t t))))))
-
-(defun sys:awk%-rng+ (rng-vec idx from-val to-val)
-  (placelet ((state (vecref rng-vec idx)))
-    (caseq state
-      (nil (cond
-             ((and from-val to-val) (set state :end) nil)
-             (from-val (set state t) nil)))
-      (:end (cond
-              (to-val t)
-              (from-val (set state t) nil)
-              (t (set state nil) nil)))
-      (t (cond
-           (to-val (set state :end) t)
-           (t t))))))
-
-(defun sys:awk%--rng+ (rng-vec idx from-val to-val)
-  (placelet ((state (vecref rng-vec idx)))
-    (caseq state
-      (nil (cond
-             ((and from-val to-val) (set state :mid) nil)
-             (from-val (set state :mid) nil)))
-      (:mid (cond
-              (to-val (set state :end) (not from-val))
-              (from-val nil)
-              (t (set state t))))
-      (:end (cond
-              (to-val t)
-              (from-val (set state t) nil)
-              (t (set state nil) nil)))
-      (t (cond
-           (to-val (set state :end) t)
-           (t t))))))
-
-(defmacro sys:awk-redir (aws-sym stream-var kind mode path body)
-  (with-gensyms (res-sym)
-    ^(let ((,res-sym ,path)
-           (,stream-var (qref ,aws-sym (ensure-stream ,kind ,res-sym ,mode))))
-       ,(if body
-          ^(qref ,aws-sym (close-or-flush ,stream-var ,kind ,res-sym
-                                          (progn ,*body)))
-          stream-var))))
-
-(defun sys:awk-expander (outer-env clauses)
-  (let ((awc (new sys:awk-compile-time outer-env outer-env)))
-    (each ((cl clauses))
-      (tree-case cl
-        ((pattern . actions) (caseql pattern
-                               (:inputs
-                                 (when awc.inputs
-                                   (awk-error "duplicate :input clauses"))
-                                 (set awc.inputs actions))
-                               (:output
-                                 (when awc.output
-                                   (awk-error "duplicate :output clauses"))
-                                 (when (or (atom actions) (cdr actions))
-                                   (awk-error "bad :output syntax"))
-                                 (set awc.output (car actions)))
-                               (:name
-                                 (when awc.name
-                                   (awk-error "duplicate :name clauses"))
-                                 (when (or (atom actions) (cdr actions))
-                                   (awk-error "bad :name syntax"))
-                                 (set awc.name (car actions)))
-                               (:let (push actions awc.lets))
-                               (:begin (push actions awc.begin-actions))
-                               (:set (push ^((set ,*actions)) awc.begin-actions))
-                               (:end (push actions awc.end-actions))
-                               (:begin-file (push actions awc.begin-file-actions))
-                               (:set-file (push ^((set ,*actions)) awc.begin-actions))
-                               (:end-file (push actions awc.end-file-actions))
-                               (t (push (if actions
-                                          cl
-                                          ^(,pattern (prn)))
-                                        awc.cond-actions))))
-        (junk (awk-error "bad clause syntax ~s" junk))))
-    (set awc.lets [apply append (nreverse awc.lets)]
-         awc.begin-actions [apply append (nreverse awc.begin-actions)]
-         awc.end-actions [apply append (nreverse awc.end-actions)]
-         awc.begin-file-actions [apply append (nreverse awc.begin-file-actions)]
-         awc.end-file-actions [apply append (nreverse awc.end-file-actions)]
-         awc.cond-actions (nreverse awc.cond-actions))
-    awc))
-
-(defun sys:awk-code-move-check (awc aws-sym mainform subform
-                                suspicious-vars kind)
-  (when suspicious-vars
-    (compile-warning mainform "~!form ~s\n\
-                               is moved out of the apparent scope\n\
-                               and thus cannot refer to ~a ~s"
-                     subform kind suspicious-vars)))
-
-(defmacro sys:awk-mac-let (awc aws-sym . body)
-  ^(symacrolet ((rec (usr:rslot ,aws-sym 'rec 'rec-to-f))
-                (orec (usr:rslot ,aws-sym 'orig-rec 'rec-to-f))
-                (f (usr:rslot ,aws-sym 'fields 'f-to-rec))
-                (nf (usr:rslot ,aws-sym 'nf 'nf-to-f))
-                (nr (qref ,aws-sym rec-num))
-                (fnr (qref ,aws-sym file-rec-num))
-                (arg (qref ,aws-sym file-num))
-                (fname (qref ,aws-sym file-name))
-                (rs (qref ,aws-sym rs))
-                (krs (qref ,aws-sym krs))
-                (fs (qref ,aws-sym fs))
-                (ft (qref ,aws-sym ft))
-                (fw (qref ,aws-sym fw))
-                (kfs (qref ,aws-sym kfs))
-                (ofs (qref ,aws-sym ofs))
-                (ors (qref ,aws-sym ors)))
-     (macrolet ((next () '(return-from :awk-rec))
-                (again () '(return-from :awk-rec :awk-again))
-                (next-file () '(return-from :awk-file))
-                (sys:rng-if (form from-expr to-expr :env e)
-                  ^(sys:rng-impl ,form
-                                 (sys:awk-test ,from-expr ,(qref ,awc rng-rec-temp))
-                                 (sys:awk-test ,to-expr ,(qref ,awc rng-rec-temp))))
-                (sys:rng-impl (form from-expr to-expr :env e)
-                  (let* ((style (car form))
-                         (ix (pinc (qref ,awc nranges)))
-                         (rng-temp (gensym))
-                         (from-expr-ex (expand from-expr e))
-                         (from-expr-val (gensym))
-                         (to-expr-ex (expand to-expr e))
-                         (to-expr-val (gensym))
-                         (vec-temp (qref ,awc rng-vec-temp))
-                         (emul-broken (and (plusp sys:compat) (<= sys:compat 177)))
-                         (rng-fun
-                           (caseq style
-                             (--rng 'sys:awk%--rng)
-                             (--rng- 'sys:awk%--rng-)
-                             (rng+ 'sys:awk%rng+)
-                             (-rng+ 'sys:awk%-rng+)
-                             (--rng+ 'sys:awk%--rng+)))
-                         (state (gensym)))
-                    (tree-bind ((from-expr-ex fe-fv fe-ff fe-ev fe-ef)
-                                (to-expr-ex te-fv te-ff te-ev te-ef)
-                                (from-expr-orig to-expr-orig))
-                               (list
-                                 (expand-with-free-refs from-expr e ,awc.outer-env)
-                                 (expand-with-free-refs to-expr e ,awc.outer-env)
-                                 (list (cadr form) (caddr form)))
-                      (sys:awk-code-move-check ,awc ',aws-sym
-                                               form from-expr-orig
-                                               (diff fe-ev fe-fv)
-                                               'variables)
-                      (sys:awk-code-move-check ,awc ',aws-sym
-                                               form from-expr-orig
-                                               (diff fe-ef fe-ff)
-                                               'functions)
-                      (sys:awk-code-move-check ,awc ',aws-sym
-                                               form to-expr-orig
-                                               (diff te-ev te-fv)
-                                               'variables)
-                      (sys:awk-code-move-check ,awc ',aws-sym
-                                               form to-expr-orig
-                                               (diff te-ef te-ff)
-                                               'functions)
-                      (push rng-temp (qref ,awc rng-expr-temps))
-                      (caseq style
-                        ((--rng --rng- rng+ -rng+ --rng+)
-                         (push
-                           ^(,rng-fun ,vec-temp ,ix ,from-expr-ex ,to-expr-ex)
-                           (qref ,awc rng-exprs)))
-                        (t (push
-                             ^(placelet ((,state (vecref ,(qref ,awc rng-vec-temp) ,ix)))
-                                (let ((,to-expr-val ,to-expr-ex))
-                                  (caseq ,state
-                                    (nil (let ((,from-expr-val ,from-expr-ex))
-                                           (cond
-                                             ((and ,from-expr-val ,to-expr-val)
-                                              ,(if (and (eq style 'rng) (not emul-broken)) t))
-                                             (,from-expr-val (set ,state t)
-                                                             ,(if (memq style '(rng rng-)) t)))))
-                                    (t (cond
-                                         (,to-expr-val (set ,state nil)
-                                                       ,(if (memq style '(rng -rng)) t))
-                                         (t t))))))
-                             (qref ,awc rng-exprs))))
-                      rng-temp)))
-                (rng (:form form from-expr to-expr) ^(sys:rng-if ,form ,from-expr ,to-expr))
-                (-rng (:form form from-expr to-expr) ^(sys:rng-if ,form ,from-expr ,to-expr))
-                (rng- (:form form from-expr to-expr) ^(sys:rng-if ,form ,from-expr ,to-expr))
-                (-rng- (:form form from-expr to-expr) ^(sys:rng-if ,form ,from-expr ,to-expr))
-                (--rng (:form form from-expr to-expr) ^(sys:rng-if ,form ,from-expr ,to-expr))
-                (--rng- (:form form from-expr to-expr) ^(sys:rng-if ,form ,from-expr ,to-expr))
-                (rng+ (:form form from-expr to-expr) ^(sys:rng-if ,form ,from-expr ,to-expr))
-                (-rng+ (:form form from-expr to-expr) ^(sys:rng-if ,form ,from-expr ,to-expr))
-                (--rng+ (:form form from-expr to-expr) ^(sys:rng-if ,form ,from-expr ,to-expr))
-                (ff (. opip-args)
-                  ^(symacrolet ((f (usr:rslot ,',aws-sym 'fields 'f-to-rec)))
-                     (set f [(opip ,*opip-args) f])))
-                (mf (. opip-args)
-                  ^(symacrolet ((f (usr:rslot ,',aws-sym 'fields 'f-to-rec)))
-                     (set f (mapcar (opip ,*opip-args) f))))
-                (fconv (. conv-args)
-                  ^(set f (sys:conv (,*conv-args) f)))
-                (-> (path . body)
-                  ^(sys:awk-redir ,',aws-sym *stdout* :outf "w" ,path ,body))
-                (->> (path . body)
-                  ^(sys:awk-redir ,',aws-sym *stdout* :apf "a" ,path ,body))
-                (<- (path . body)
-                  ^(sys:awk-redir ,',aws-sym *stdin* :inf "r" ,path ,body))
-                (!> (path . body)
-                  ^(sys:awk-redir ,',aws-sym *stdout* :outp "w" ,path ,body))
-                (<! (path . body)
-                  ^(sys:awk-redir ,',aws-sym *stdin* :inp "r" ,path ,body)))
-       ,*body)))
-
-(defmacro sys:awk-fun-let (aws-sym . body)
-  ^(flet ((prn (. args)
-            (qref ,aws-sym (prn . args))))
-     ,*body))
-
-(defun sys:awk-fun-shadowing-env (up-env)
-  (make-env nil '((prn . sys:special)) up-env))
-
-(defmacro awk (:env outer-env . clauses)
-  (let ((awc (sys:awk-expander outer-env clauses)))
-    (with-gensyms (aws-sym awk-begf-fun awk-fun awk-endf-fun awk-retval)
-      (let* ((p-actions-xform-unex (mapcar (aret ^(when (sys:awk-test ,@1 rec)
-                                                    ,*@rest))
-                                           awc.cond-actions))
-             (p-actions-xform (expand
-                                ^(sys:awk-mac-let ,awc ,aws-sym
-                                   ,*p-actions-xform-unex)
-                                (sys:awk-fun-shadowing-env outer-env))))
-        ^(block ,(or awc.name 'awk)
-           (let* (,*awc.lets ,awk-retval
-                  (,aws-sym (new sys:awk-state
-                                 ,*(if awc.inputs ^(inputs (list ,*awc.inputs)))
-                                 ,*(if awc.output ^(output ,awc.output))
-                                 rng-n (macro-time (qref ,awc nranges)))))
-             (sys:awk-mac-let ,awc ,aws-sym
-               (sys:awk-fun-let ,aws-sym
-                 (let* (,*(if awc.output
-                            ^((*stdout* (qref ,aws-sym output))))
-                        ,*(if (and awc.cond-actions awc.begin-file-actions)
-                            ^((,awk-begf-fun (lambda (,aws-sym)
-                                 ,*awc.begin-file-actions))))
-                        ,*(if (and awc.cond-actions awc.end-file-actions)
-                            ^((,awk-endf-fun (lambda (,aws-sym)
-                                ,*awc.end-file-actions))))
-                        ,*(if (or awc.cond-actions awc.begin-file-actions
-                                  awc.end-file-actions awc.end-actions)
-                            ^((,awk-fun (lambda (,aws-sym)
-                                          ,(if awc.rng-exprs
-                                             ^(let* ((,awc.rng-rec-temp rec)
-                                                     (,awc.rng-vec-temp (qref ,aws-sym rng-vec))
-                                                     ,*(nreverse
-                                                         (zip awc.rng-expr-temps
-                                                              awc.rng-exprs)))
-                                                ,p-actions-xform)
-                                             p-actions-xform))))))
-                   ,*awc.begin-actions
-                     (unwind-protect
-                       ,(if (or awc.cond-actions awc.begin-file-actions
-                                awc.end-file-actions awc.end-actions)
-                          ^(qref ,aws-sym (loop ,awk-fun
-                                            ,(if awc.begin-file-actions
-                                               awk-begf-fun)
-                                            ,(if awc.end-file-actions
-                                               awk-endf-fun))))
-                       (set ,awk-retval (progn ,*awc.end-actions))
-                       (call-finalizers ,aws-sym))
-                     ,awk-retval)))))))))
diff --git a/share/txr/stdlib/build.tl b/share/txr/stdlib/build.tl
deleted file mode 100644
index 1b27d17b..00000000
--- a/share/txr/stdlib/build.tl
+++ /dev/null
@@ -1,141 +0,0 @@
-;; Copyright 2016-2021
-;; Kaz Kylheku <kaz@kylheku.com>
-;; Vancouver, Canada
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are met:
-;;
-;; 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 BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(defstruct list-builder ()
-  head tail
-
-  (:postinit (bc)
-    (set bc.head (cons nil bc.head)
-         bc.tail bc.head))
-
-  (:method add (self . items)
-    (let ((st self.tail))
-      (rplacd st (append (cdr st) nil))
-      (let ((tl (last st)))
-        (usr:rplacd tl (append (cdr tl) items))
-        (set self.tail tl)))
-    self)
-
-  (:method add* (self . items)
-    (let ((h self.head))
-      (usr:rplacd h (append items (cdr h))))
-    self)
-
-  (:method pend (self . lists)
-    (when lists
-      (let ((st self.tail))
-        (rplacd st (append (cdr st) nil))
-        (let* ((tl (last st))
-               (cp (tailp tl (car (last lists))))
-               (nl [apply append lists]))
-          (usr:rplacd tl (append (cdr tl) (if cp (copy-list nl) nl)))
-          (set self.tail tl)))
-      self))
-
-  (:method pend* (self . lists)
-    (let* ((h self.head)
-           (pf [apply append (append lists (list (cdr h)))]))
-      (usr:rplacd h pf)
-      (set self.tail h))
-    self)
-
-  (:method ncon (self . lists)
-    (when lists
-      (let* ((tl (last self.tail))
-             (nl [apply nconc lists]))
-        (usr:rplacd tl (nconc (cdr tl) nl))
-        (set self.tail tl))
-      self))
-
-  (:method ncon* (self . lists)
-    (let* ((h self.head)
-           (pf [apply nconc (append lists (list (cdr h)))]))
-      (usr:rplacd h pf)
-      (if (eq self.tail h)
-        (set self.tail pf)))
-    self)
-
-  (:method get (self)
-    (cdr self.head))
-
-  (:method del (self)
-    (whenlet ((hd self.head)
-              (chd (cdr self.head)))
-      (when (eq self.tail chd)
-        (set self.tail hd))
-      (prog1 (car chd) (usr:rplacd hd (cdr chd)))))
-
-  (:method del* (self)
-    (whenlet ((hd self.head)
-              (chd (cdr self.head)))
-      (if (cdr chd)
-        (let* ((tl self.tail)
-               (l2 (nthlast 2 tl)))
-          (if (cdr l2)
-            (prog1
-              (cadr l2)
-              (usr:rplacd l2 nil))
-            (let* ((l10 (nthlast 10 hd))
-                   (l2 (nthlast 2 l10)))
-              (prog1
-                (cadr l2)
-                (usr:rplacd l2 nil)
-                (set self.tail l10)))))
-        (prog1
-          (car chd)
-          (usr:rplacd hd nil)
-          (set self.tail hd))))))
-
-(defun sys:list-builder-flets (lb-form)
-  (nconc
-    (collect-each ((op '(add add* pend pend* ncon ncon*)))
-      ^(,op (. args)
-         (qref ,lb-form (,op . args))
-         nil))
-    ^((get ()
-        (qref ,lb-form (get)))
-      (del* ()
-        (qref ,lb-form (del*)))
-      (do-del ()
-        (qref ,lb-form (del))))))
-
-(defun build-list (: init)
-  (new list-builder head init))
-
-(defun sys:build-expander (forms return-get)
-  (with-gensyms (name)
-    ^(let ((,name (new list-builder)))
-       (flet ,(sys:list-builder-flets name)
-         (macrolet ((del (:form f : (expr nil expr-p))
-                      (if expr-p f '(do-del))))
-           ,*forms
-           ,*(if return-get ^((qref ,name (get)))))))))
-
-(defmacro build (. forms)
-  (sys:build-expander forms t))
-
-(defmacro buildn (. forms)
-  (sys:build-expander forms nil))
diff --git a/share/txr/stdlib/cadr.tl b/share/txr/stdlib/cadr.tl
deleted file mode 100644
index 6648b145..00000000
--- a/share/txr/stdlib/cadr.tl
+++ /dev/null
@@ -1,1107 +0,0 @@
-;; This file is generated by gencadr.txr
-
-;; Copyright 2015-2021
-;; Kaz Kylheku <kaz@kylheku.com>
-;; Vancouver, Canada
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are met:
-;;
-;; 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 BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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)
-      ^(let ((,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/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl
deleted file mode 100644
index c30ebbd6..00000000
--- a/share/txr/stdlib/compiler.tl
+++ /dev/null
@@ -1,2394 +0,0 @@
-;; Copyright 2018-2021
-;; Kaz Kylheku <kaz@kylheku.com>
-;; Vancouver, Canada
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are met:
-;;
-;; 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 BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(load "vm-param")
-(load "optimize")
-
-(compile-only
-  (load-for (struct sys:param-parser-base "param")))
-
-(defstruct (frag oreg code : fvars ffuns pars) nil
-  oreg
-  code
-  pars
-  fvars
-  ffuns)
-
-(defstruct binding nil
-  sym
-  loc
-  used
-  sys:env)
-
-(defstruct vbinding binding)
-
-(defstruct fbinding binding
-  pars)
-
-(defstruct blockinfo nil
-  sym
-  used
-  sys:env)
-
-(defstruct sys:env nil
-  vb
-  fb
-  bb
-  up
-  co
-  lev
-  (v-cntr 0)
-
-  (:postinit (me)
-    (unless me.lev
-      (set me.lev (succ (or me.up.?lev 0))))
-    (unless (or me.co (null me.up))
-      (set me.co me.up.co))
-    me.co.(new-env me))
-
-  (:method lookup-var (me sym)
-    (condlet
-      (((cell (assoc sym me.vb)))
-       (cdr cell))
-      (((up me.up)) up.(lookup-var sym))
-      (t nil)))
-
-  (:method lookup-fun (me sym : mark-used)
-    (condlet
-      (((cell (assoc sym me.fb)))
-       (let ((bi (cdr cell)))
-         (if mark-used (set bi.used t))
-         bi))
-      (((up me.up)) up.(lookup-fun sym mark-used))
-      (t nil)))
-
-  (:method lookup-lisp1 (me sym : mark-used)
-    (condlet
-      (((cell (or (assoc sym me.vb)
-                  (assoc sym me.fb))))
-       (let ((bi (cdr cell)))
-         (if mark-used (set bi.used t))
-         bi))
-      (((up me.up)) up.(lookup-lisp1 sym mark-used))
-      (t nil)))
-
-  (:method lookup-block (me sym : mark-used)
-    (condlet
-      (((cell (assoc sym me.bb)))
-       (let ((bi (cdr cell)))
-         (if mark-used (set bi.used t))
-         bi))
-      (((up me.up)) up.(lookup-block sym mark-used))
-      (t nil)))
-
-  (:method extend-var (me sym)
-    (when (assoc sym me.vb)
-      (compile-error me.co.last-form "duplicate variable: ~s" sym))
-    (let* ((loc ^(v ,(ppred me.lev) ,(pinc me.v-cntr)))
-           (bn (new vbinding sym sym loc loc env me)))
-      (set me.vb (acons sym bn me.vb))))
-
-  (:method extend-var* (me sym)
-    (let* ((loc ^(v ,(ppred me.lev) ,(pinc me.v-cntr)))
-           (bn (new vbinding sym sym loc loc env me)))
-      (set me.vb (acons sym bn me.vb))))
-
-  (:method extend-fun (me sym)
-    (when (assoc sym me.fb)
-      (compile-error me.co.last-form "duplicate function ~s" sym))
-    (let* ((loc ^(v ,(ppred me.lev) ,(pinc me.v-cntr)))
-           (bn (new fbinding sym sym loc loc env me)))
-      (set me.fb (acons sym bn me.fb))))
-
-  (:method rename-var (me from-sym to-sym)
-    (iflet ((cell (assoc from-sym me.vb)))
-      (rplaca cell to-sym)
-      (let ((bn (cdr cell)))
-        (set bn.sym to-sym))))
-
-  (:method out-of-scope (me reg)
-    (if (eq (car reg) 'v)
-      (let ((lev (ssucc (cadr reg))))
-        (< me.lev lev))))
-
-  (:method extend-block (me sym)
-    (let* ((bn (new blockinfo sym sym env me)))
-      (set me.bb (acons sym bn me.bb)))))
-
-(defstruct closure-spy ()
-  env
-  cap-vars
-
-  (:method captured (me vbin sym)
-    (when (eq vbin.env me.env)
-      (pushnew sym me.cap-vars))))
-
-(defstruct access-spy ()
-  closure-spies
-
-  (:method accessed (me vbin sym)
-    (each ((spy me.closure-spies))
-      (when (neq spy me)
-        spy.(captured vbin sym))))
-
-  (:method assigned (me vbin sym)
-    (each ((spy me.closure-spies))
-      (when (neq spy me)
-        spy.(captured vbin sym)))))
-
-(compile-only
-  (defstruct compiler nil
-    (treg-cntr 2)
-    (dreg-cntr 0)
-    (sidx-cntr 0)
-    (nlev 2)
-    (loop-nest 0)
-    (tregs nil)
-    (discards nil)
-    (dreg (hash :eql-based))
-    (data (hash :eql-based))
-    (sidx (hash :eql-based))
-    (stab (hash :eql-based))
-    datavec
-    symvec
-    lt-frags
-    last-form
-    closure-spies
-    access-spies
-
-    (:method snapshot (me)
-      (let ((snap (copy me)))
-        (set snap.dreg (copy me.dreg)
-             snap.data (copy me.data)
-             snap.sidx (copy me.sidx)
-             snap.stab (copy me.stab))
-        snap))
-
-    (:method restore (me snap)
-      (replace-struct me snap))))
-
-
-(eval-only
-  (defmacro compile-in-toplevel (me . body)
-    (with-gensyms (saved-tregs saved-treg-cntr saved-nlev saved-discards)
-      ^(let* ((,saved-tregs (qref ,me tregs))
-              (,saved-treg-cntr (qref ,me treg-cntr))
-              (,saved-discards (qref ,me discards)))
-         (unwind-protect
-           (progn
-             (set (qref ,me tregs) nil
-                  (qref ,me treg-cntr) 2
-                  (qref ,me discards) nil)
-             (prog1
-               (progn ,*body)
-               (qref ,me (check-treg-leak))))
-           (set (qref ,me tregs) ,saved-tregs
-                (qref ,me treg-cntr) ,saved-treg-cntr
-                (qref ,me discards) ,saved-discards)))))
-
-  (defmacro compile-with-fresh-tregs (me . body)
-    (with-gensyms (saved-tregs saved-treg-cntr saved-discards)
-      ^(let* ((,saved-tregs (qref ,me tregs))
-              (,saved-treg-cntr (qref ,me treg-cntr))
-              (,saved-discards (qref ,me discards)))
-         (unwind-protect
-           (progn
-             (set (qref ,me tregs) nil
-                  (qref ,me treg-cntr) 2
-                  (qref ,me discards) nil)
-             (prog1
-               (progn ,*body)
-               (qref ,me (check-treg-leak))))
-           (set (qref ,me tregs) ,saved-tregs
-                (qref ,me treg-cntr) ,saved-treg-cntr
-                (qref ,me discards) ,saved-discards)))))
-
-  (defun with-spy (me flag spy spy-expr body push-meth pop-meth)
-    ^(let ((,spy (if ,flag ,spy-expr)))
-       (unwind-protect
-         (progn
-           (if ,spy (qref ,me (,push-meth ,spy)))
-           ,*body)
-         (if ,spy (qref ,me (,pop-meth ,spy))))))
-
-  (defmacro with-closure-spy (me flag spy spy-expr . body)
-    (with-spy me flag spy spy-expr body 'push-closure-spy 'pop-closure-spy))
-
-  (defmacro with-access-spy (me flag spy spy-expr . body)
-    (with-spy me flag spy spy-expr body 'push-access-spy 'pop-access-spy)))
-
-(defvarl %gcall-op% (relate '(apply usr:apply call) '(gapply gapply gcall)))
-
-(defvarl %call-op% (relate '(apply usr:apply call) '(apply apply call)))
-
-(defvarl %test-funs-pos% '(eq eql))
-
-(defvarl %test-funs-neg% '(neq neql))
-
-(defvarl %test-funs-ops% '(ifq ifql))
-
-(defvarl %test-funs% (append %test-funs-pos% %test-funs-neg%))
-
-(defvarl %test-inv% (relate %test-funs-neg% %test-funs-pos%))
-
-(defvarl %test-opcode% (relate %test-funs-pos% %test-funs-ops%))
-
-(defvarl %block-using-funs% '(sys:capture-cont return* sys:abscond* match-fun
-                              eval load compile compile-file compile-toplevel))
-
-(defvarl %nary-ops% '(< > <= => = + - * /))
-
-(defvarl %bin-ops% '(b< b> b<= b=> b= b+ b- b* b/))
-
-(defvarl %bin-op% (relate %nary-ops% %bin-ops% nil))
-
-(defvarl %const-foldable-funs%
-  '(+ - * / sum prod abs trunc mod zerop nzerop plusp minusp evenp oddp
-    > < >= <= = /= wrap wrap* expt exptmod isqrt square gcd lcm floor ceil
-    round trunc-rem floor-rem ceil-rem round-rem sin cos tan asin acos atan
-    atan2 sinh cosh tanh asinh acosh atanh log log10 log2 exp sqrt
-    logand logior logxor logtest lognot logtrunc sign-extend ash bit mask
-    width logcount bitset cum-norm-dist inv-cum-norm n-choose-k n-perm-k
-    fixnump bignump floatp integerp numberp signum bignum-len divides sys:bits
-    digpow digits poly rpoly b< b> b<= b=> b= b+ b- b* b/ neg
-    pred ppred ppred pppred succ ssucc ssucc sssucc
-    car cdr caar cadr cdar cddr caaar caadr cadar caddr cdaar cdadr cddar cdddr
-    caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr cdaaar cdaadr
-    cdadar cdaddr cddaar cddadr cdddar cddddr caaaaar caaaadr caaadar caaaddr
-    caadaar caadadr caaddar caadddr cadaaar cadaadr cadadar cadaddr caddaar
-    caddadr cadddar caddddr cdaaaar cdaaadr cdaadar cdaaddr cdadaar cdadadr
-    cdaddar cdadddr cddaaar cddaadr cddadar cddaddr cdddaar cdddadr cddddar
-    cdddddr cons first rest sub-list identity typeof atom null false true have
-    consp listp endp proper-listp length-list second third fourth fifth
-    sixth seventh eighth ninth tenth conses ldiff nthcdr nth tailp
-    memq memql memqual rmemq rmemql rmemqual countq countql countqual
-    posq posql posqual rposq rposql rposqual eq eql equal meq meql mequal
-    neq neql nequal max min clamp bracket take drop uniq if or and progn
-    prog1 prog2 nilf tf tostring tostringp display-width sys:fmt-simple
-    sys:fmt-flex join join-with sys:fmt-join packagep
-    symbolp keywordp bindable stringp length-str
-    coded-length cmp-str string-lt str= str< str> str<= str>= int-str
-    flo-str num-str int-flo flo-int tofloat toint tointz less greater
-    lequal gequal chrp chr-isalnum chr-isalnum chr-isalpha chr-isascii
-    chr-iscntrl chr-isdigit chr-digit chr-isgraph chr-islower chr-isprint
-    chr-ispunct chr-isspace chr-isblank chr-isunisp chr-isupper chr-isxdigit
-    chr-xdigit chr-toupper chr-tolower num-chr int-chr chr-num chr-int
-    chr-str span-str compl-span-str break-str vectorp length-vec size-vec
-    assq assql assoc rassq rassql rassoc prop memp length len empty ref
-    rangep from to in-range in-range* nullify))
-
-(defvarl %const-foldable% (hash-list %const-foldable-funs% :eq-based))
-
-(defvarl %effect-free-funs%
-  '(append append* revappend list list* zip interpose copy-list reverse
-   flatten flatten* flatcar flatcar* tuples remq remql remqual
-   keepq keepq keepqual remq* remql* remq* make-sym gensym
-   mkstring copy-str upcase-str downcase-str cat-str split-str spl
-   split-str-set sspl tok-str tok tok-where list-str trim-str
-   get-lines lazy-str length-str-> length-str->= length-str-<
-   length-str-<= vector vec vector-list list-vector list-vec
-   copy-vec sub-vec cat-vec acons acons-new aconsql-new alist-remove
-   copy-cons copy-tree copy-alist plist-to-alist improper-plist-to-alist
-   merge sort shuffle list-seq vec-seq str-seq copy sub seq-begin
-   iter-begin rcons make-like nullify symbol-value symbol-function
-   symbol-macro boundp fboundp mboundp special-operator-p special-var-p
-   copy-fun func-get-form func-get-name func-get-env functionp
-   interp-fun-p vm-fun-p fun-fixparam-count fun-optparam-count
-   fun-variadic sys:ctx-form sys:ctx-name range range* rlist rlist*
-   repeat pad weave promisep rperm perm comb rcomb source-loc
-   source-loc-str macro-ancestor cptr-int cptr-obj cptr-buf
-   int-cptr cptrp cptr-type cptr-size-hint))
-
-(defvarl %effect-free% (hash-uni %const-foldable%
-                                 (hash-list %effect-free-funs% :eq-based)))
-
-
-(defvarl %functional-funs%
-  '(chain chand juxt andf orf notf iff iffi dup flipargs if or and
-    progn prog1 prog2 retf apf ipf callf mapf tf nilf umethod uslot))
-
-(defvarl %functional% (hash-list %functional-funs% :eq-based))
-
-(defvarl assumed-fun)
-
-(defvar *in-compilation-unit* nil)
-
-(defvar *dedup*)
-
-(defvar *unchecked-calls*)
-
-(defvarl %param-info% (hash :eq-based :weak-keys))
-
-(defvar *load-time*)
-
-;; 0 - no optimization
-;; 1 - constant folding, algebraics.
-;; 2 - block elimination, frame elimination
-;; 3 - lambda/combinator lifting
-;; 4 - control-flow: jump-threading, dead code
-;; 5 - data-flow: dead registers, useless regisers
-;; 6 - more expensive size or speed optimizations
-(defvar usr:*opt-level* 6)
-
-(defun dedup (obj)
-  (cond
-    ((null obj) nil)
-    ((null *dedup*) obj)
-    ((or (stringp obj) (bignump obj))
-     (or [*dedup* obj] (set [*dedup* obj] obj)))
-    (t obj)))
-
-(defun null-reg (reg)
-  (equal reg '(t 0)))
-
-(defmeth compiler get-dreg (me obj)
-  (let ((dobj (dedup obj)))
-    (condlet
-      ((((null dobj))) '(t 0))
-      (((dreg [me.dreg dobj])) dreg)
-      ((((< me.dreg-cntr %lev-size%)))
-       (let ((dreg ^(d ,(pinc me.dreg-cntr))))
-        (set [me.data (cadr dreg)] dobj)
-        (set [me.dreg dobj] dreg)))
-      (t (compile-error me.last-form "code too complex: too many literals")))))
-
-(defmeth compiler alloc-dreg (me)
-  (if (< me.dreg-cntr %lev-size%)
-    (let ((dreg ^(d ,(pinc me.dreg-cntr))))
-      (set [me.data (cadr dreg)] nil)
-      dreg)
-    (compile-error me.last-form "code too complex: too many literals")))
-
-(defmeth compiler get-sidx (me atom)
-  (iflet ((sidx [me.sidx atom]))
-    sidx
-    (let* ((sidx (pinc me.sidx-cntr)))
-      (set [me.stab sidx] atom)
-      (set [me.sidx atom] sidx))))
-
-(defmeth compiler get-datavec (me)
-  (or me.datavec
-      (set me.datavec (vec-list [mapcar me.data (range* 0 me.dreg-cntr)]))))
-
-(defmeth compiler get-symvec (me)
-  (or me.symvec
-      (set me.symvec (vec-list [mapcar me.stab (range* 0 me.sidx-cntr)]))))
-
-(defmeth compiler alloc-treg (me)
-  (cond
-    (me.tregs (pop me.tregs))
-    ((< me.treg-cntr %lev-size%) ^(t ,(pinc me.treg-cntr)))
-    (t (compile-error me.last-form "code too complex: out of registers"))))
-
-(defmeth compiler alloc-new-treg (me)
-  (cond
-    ((< me.treg-cntr %lev-size%) ^(t ,(pinc me.treg-cntr)))
-    (t (compile-error me.last-form "code too complex: out of registers"))))
-
-(defmeth compiler alloc-discard-treg (me)
-  (let ((treg me.(alloc-treg)))
-    (push treg me.discards)
-    treg))
-
-(defmeth compiler free-treg (me treg)
-  (when (and (eq t (car treg)) (neq 0 (cadr treg)))
-    (when me.discards
-      (set me.discards (remqual treg me.discards)))
-    (push treg me.tregs)))
-
-(defmeth compiler free-tregs (me tregs)
-  (mapdo (meth me free-treg) tregs))
-
-(defmeth compiler unalloc-reg-count (me)
-  (- %lev-size% me.treg-cntr))
-
-(defmeth compiler maybe-alloc-treg (me given)
-  (if (and (eq t (car given)) (not (member given me.discards)))
-    given
-    me.(alloc-treg)))
-
-(defmeth compiler maybe-free-treg (me treg given)
-  (when (nequal treg given)
-    me.(free-treg treg)))
-
-(defmeth compiler check-treg-leak (me)
-  (let ((balance (- (ppred me.treg-cntr) (len me.tregs))))
-    (unless (zerop balance)
-      (error "t-register leak in compiler: ~s outstanding" balance))))
-
-(defmeth compiler maybe-mov (me to-reg from-reg)
-  (if (and (nequal to-reg from-reg) (not (member to-reg me.discards)))
-    ^((mov ,to-reg ,from-reg))))
-
-(defmeth compiler new-env (me env)
-  (when (>= env.lev me.nlev)
-    (unless (<= env.lev %max-lev%)
-      (compile-error me.last-form
-                     "code too complex: lexical nesting too deep"))
-    (set me.nlev (succ env.lev))))
-
-(defmeth compiler push-closure-spy (me spy)
-  (push spy me.closure-spies))
-
-(defmeth compiler pop-closure-spy (me spy)
-  (let ((top (pop me.closure-spies)))
-    (unless top
-      (error "closure spy stack bug in compiler"))
-    (unless (eq top spy)
-      (error "closure spy stack balance problem in compiler"))))
-
-(defmeth compiler push-access-spy (me spy)
-  (push spy me.access-spies))
-
-(defmeth compiler pop-access-spy (me spy)
-  (let ((top (pop me.access-spies)))
-    (unless top
-      (error "access spy stack bug in compiler"))
-    (unless (eq top spy)
-      (error "access spy stack balance problem in compiler"))))
-
-(defmeth compiler compile (me oreg env form)
-  (set me.last-form form)
-  (cond
-    ((symbolp form)
-     (if (bindable form)
-       me.(comp-var oreg env form)
-       me.(comp-atom oreg form)))
-    ((atom form) me.(comp-atom oreg form))
-    (t (let ((sym (car form)))
-         (cond
-           ((bindable sym)
-            (caseq sym
-              (quote me.(comp-atom oreg (cadr form)))
-              (sys:setq me.(comp-setq oreg env form))
-              (sys:lisp1-setq me.(comp-lisp1-setq oreg env form))
-              (sys:setqf me.(comp-setqf oreg env form))
-              (cond me.(comp-cond oreg env form))
-              (if me.(comp-if oreg env form))
-              (switch me.(comp-switch oreg env form))
-              (unwind-protect me.(comp-unwind-protect oreg env form))
-              ((block block* sys:blk) me.(comp-block oreg env form))
-              ((return-from sys:abscond-from) me.(comp-return-from oreg env form))
-              (return me.(comp-return oreg env form))
-              (handler-bind me.(comp-handler-bind oreg env form))
-              (sys:catch me.(comp-catch oreg env form))
-              ((let let*) me.(comp-let oreg env form))
-              ((sys:fbind sys:lbind) me.(comp-fbind oreg env form))
-              (lambda me.(comp-lambda oreg env form))
-              (fun me.(comp-fun oreg env form))
-              (sys:for-op me.(comp-for oreg env form))
-              (sys:each-op me.(compile oreg env (expand-each form env)))
-              ((progn eval-only compile-only) me.(comp-progn oreg env (cdr form)))
-              (and me.(compile oreg env (expand-and form)))
-              (or me.(comp-or oreg env form))
-              (prog1 me.(comp-prog1 oreg env form))
-              (sys:quasi me.(comp-quasi oreg env form))
-              (dohash me.(compile oreg env (expand-dohash form)))
-              (tree-bind me.(comp-tree-bind oreg env form))
-              (mac-param-bind me.(comp-mac-param-bind oreg env form))
-              (mac-env-param-bind me.(comp-mac-env-param-bind oreg env form))
-              (tree-case me.(comp-tree-case oreg env form))
-              (sys:lisp1-value me.(comp-lisp1-value oreg env form))
-              (dwim me.(comp-dwim oreg env form))
-              (prof me.(comp-prof oreg env form))
-              (defvarl me.(compile oreg env (expand-defvarl form)))
-              (defun me.(compile oreg env (expand-defun form)))
-              (defmacro me.(compile oreg env (expand-defmacro form)))
-              (defsymacro me.(compile oreg env (expand-defsymacro form)))
-              (sys:upenv me.(compile oreg env.up (cadr form)))
-              (sys:dvbind me.(compile oreg env (caddr form)))
-              (sys:load-time-lit me.(comp-load-time-lit oreg env form))
-              ;; compiler-only special operators:
-              (ift me.(comp-ift oreg env form))
-              ;; specially treated functions
-              ((call apply usr:apply) me.(comp-apply-call oreg env form))
-              ;; error cases
-              ((macrolet symacrolet macro-time)
-               (compile-error form "unexpanded ~s encountered" sym))
-              ((sys:var sys:expr)
-               (compile-error form "meta with no meaning: ~s " form))
-              ((usr:qquote usr:unquote usr:splice
-                           sys:qquote sys:unquote sys:splice)
-               (compile-error form "unexpanded quasiquote encountered"))
-              ;; function call
-              ((+ *) me.(comp-arith-form oreg env form))
-              ((- /) me.(comp-arith-neg-form oreg env form))
-              (t me.(comp-fun-form oreg env form))))
-           ((and (consp sym)
-                 (eq (car sym) 'lambda)) me.(compile oreg env ^(call ,*form)))
-           (t (compile-error form "invalid operator")))))))
-
-(defmeth compiler comp-atom (me oreg form)
-  (cond
-    ((null form) (new (frag '(t 0) nil)))
-    (t (let ((dreg me.(get-dreg form)))
-         (new (frag dreg nil))))))
-
-(defmeth compiler comp-var (me oreg env sym)
-  (let ((vbin env.(lookup-var sym)))
-    (cond
-      (vbin
-        (each ((spy me.access-spies))
-          spy.(accessed vbin sym))
-        (new (frag vbin.loc nil (list sym))))
-      ((special-var-p sym)
-       (let ((dreg me.(get-dreg sym)))
-         (new (frag oreg ^((getv ,oreg ,dreg)) (list sym)))))
-      (t (new (frag oreg ^((getlx ,oreg ,me.(get-sidx sym))) (list sym)))))))
-
-(defmeth compiler comp-setq (me oreg env form)
-  (mac-param-bind form (op sym value) form
-    (let* ((bind env.(lookup-var sym))
-           (spec (special-var-p sym))
-           (vloc (cond
-                   (bind bind.loc)
-                   (spec me.(get-dreg sym))
-                   (t me.(get-sidx sym))))
-           (vfrag me.(compile (if bind vloc oreg) env value)))
-      (when bind
-        (each ((spy me.access-spies))
-          spy.(assigned bind sym)))
-      (new (frag vfrag.oreg
-                 ^(,*vfrag.code
-                   ,*(if bind
-                       me.(maybe-mov vloc vfrag.oreg)
-                       (if spec
-                         ^((setv ,vfrag.oreg ,vloc))
-                         ^((setlx ,vfrag.oreg ,me.(get-sidx sym))))))
-                 (uni (list sym) vfrag.fvars)
-                 vfrag.ffuns)))))
-
-(defmeth compiler comp-lisp1-setq (me oreg env form)
-  (mac-param-bind form (op sym val) form
-    (let ((bind env.(lookup-lisp1 sym)))
-      (cond
-        ((typep bind 'fbinding)
-         (compile-error form "assignment to lexical function binding"))
-        ((null bind)
-         (let ((vfrag me.(compile oreg env val))
-               (l1loc me.(get-dreg sym)))
-           (new (frag vfrag.oreg
-                      ^(,*vfrag.code
-                        (setl1 ,vfrag.oreg ,l1loc))
-                      (uni (list sym) vfrag.fvars)
-                      vfrag.ffuns))))
-        (t (each ((spy me.access-spies))
-             spy.(assigned bind sym))
-          me.(compile oreg env ^(sys:setq ,sym ,val)))))))
-
-(defmeth compiler comp-setqf (me oreg env form)
-  (mac-param-bind form (op sym val) form
-    (if env.(lookup-fun sym)
-      (compile-error form "assignment to lexical function binding")
-      (let ((vfrag me.(compile oreg env val))
-            (fname me.(get-dreg sym))
-            (rplcd me.(get-sidx 'usr:rplacd))
-            (treg me.(alloc-treg)))
-        me.(free-treg treg)
-        (new (frag vfrag.oreg
-                   ^(,*vfrag.code
-                      (getfb ,treg ,fname)
-                      (gcall ,treg ,rplcd ,treg ,vfrag.oreg))
-                   vfrag.fvars
-                   (uni (list sym) vfrag.ffuns)))))))
-
-(defmeth compiler comp-cond (me oreg env form)
-  (tree-case form
-    ((op) me.(comp-atom oreg nil))
-    ((op (test) . more) me.(compile oreg env ^(or ,test (cond ,*more))))
-    ((op (test . forms) . more) me.(compile oreg env
-                                            ^(if ,test
-                                               (progn ,*forms)
-                                               (cond ,*more))))
-    ((op atom . more)
-     (compile-error form "atom in cond syntax; pair expected"))
-    ((op . atom)
-     (compile-error form "trailing atom in cond syntax"))))
-
-(defmeth compiler comp-if (me oreg env form)
-  (match-case (cdr form)
-    (@(require ((@(and @(or equal nequal) @op) @a @b) . @rest)
-               (or (eql-comparable a)
-                   (eql-comparable b)))
-      (let* ((pos (eq op 'equal))
-             (cf (if (or (eq-comparable a)
-                         (eq-comparable b))
-                   (if pos 'eq 'neq)
-                   (if pos'eql 'neql))))
-        me.(compile oreg env ^(if (,cf ,a ,b) ,*rest))))
-    (((not (@(and @(or eq eql equal) @op) . @eargs)) . @args)
-     (let ((nop (caseq op (eq 'neq) (eql 'neql) (equal 'nequal))))
-       me.(comp-if oreg env ^(if (,nop ,*eargs) ,*args))))
-    ((@(constantp @test) @then @else)
-     me.(compile oreg env (if (eval test) then else)))
-    ((@(constantp @test) @then)
-     me.(compile oreg env (if (eval test) then)))
-    ((@(constantp @test))
-     me.(compile oreg env nil))
-    (((@(member @op %test-funs%) @a @b) . @rest)
-     me.(compile oreg env ^(ift ,op ,a ,b ,*rest)))
-    ((@test @then @else)
-     (let* ((te-oreg me.(maybe-alloc-treg oreg))
-            (lelse (gensym "l"))
-            (lskip (gensym "l"))
-            (te-frag me.(compile te-oreg env test))
-            (th-frag me.(compile oreg env then))
-            (el-frag me.(compile oreg env else)))
-       me.(maybe-free-treg te-oreg oreg)
-       (new (frag oreg
-                  ^(,*te-frag.code
-                     (if ,te-frag.oreg ,lelse)
-                     ,*th-frag.code
-                     ,*me.(maybe-mov oreg th-frag.oreg)
-                     (jmp ,lskip)
-                     ,lelse
-                     ,*el-frag.code
-                     ,*me.(maybe-mov oreg el-frag.oreg)
-                     ,lskip)
-                  (uni te-frag.fvars (uni th-frag.fvars el-frag.fvars))
-                  (uni te-frag.ffuns (uni th-frag.ffuns el-frag.ffuns))))))
-    ((@test @then)
-     (let* ((lskip (gensym "l"))
-            (te-oreg me.(maybe-alloc-treg oreg))
-            (te-frag me.(compile te-oreg env test))
-            (th-frag me.(compile oreg env then)))
-       me.(maybe-free-treg te-oreg oreg)
-       (new (frag oreg
-                  ^(,*te-frag.code
-                     ,*me.(maybe-mov oreg te-frag.oreg)
-                     (if ,te-frag.oreg ,lskip)
-                     ,*th-frag.code
-                     ,*me.(maybe-mov oreg th-frag.oreg)
-                     ,lskip)
-                  (uni te-frag.fvars th-frag.fvars)
-                  (uni te-frag.ffuns th-frag.ffuns)))))
-    ((@test)
-     (let ((te-frag me.(compile oreg env test)))
-       (new (frag oreg
-                  ^(,*te-frag.code
-                     (mov ,oreg nil))
-                  te-frag.fvars
-                  te-frag.ffuns))))
-    (() me.(compile oreg env nil))
-    (@else (compile-error form "excess argument forms"))))
-
-(defmeth compiler comp-ift (me oreg env form)
-  (mac-param-bind form (op fun left right : then else) form
-    (when (member fun %test-funs-neg%)
-      (set fun [%test-inv% fun])
-      (swap then else))
-    (if (and (constantp left) (constantp right))
-      me.(compile oreg env (if (call fun (eval left) (eval right)) then else))
-      (let* ((opcode [%test-opcode% fun])
-             (le-oreg me.(alloc-treg))
-             (ri-oreg me.(alloc-treg))
-             (lelse (gensym "l"))
-             (lskip (gensym "l"))
-             (le-frag me.(compile le-oreg env left))
-             (ri-frag me.(compile ri-oreg env right))
-             (th-frag me.(compile oreg env then))
-             (el-frag me.(compile oreg env else)))
-        me.(free-treg le-oreg)
-        me.(free-treg ri-oreg)
-        (new (frag oreg
-                   ^(,*le-frag.code
-                     ,*ri-frag.code
-                     (,opcode ,le-frag.oreg ,ri-frag.oreg ,lelse)
-                     ,*th-frag.code
-                     ,*me.(maybe-mov oreg th-frag.oreg)
-                      (jmp ,lskip)
-                     ,lelse
-                     ,*el-frag.code
-                     ,*me.(maybe-mov oreg el-frag.oreg)
-                     ,lskip)
-                   (uni (uni le-frag.fvars ri-frag.fvars)
-                        (uni th-frag.fvars el-frag.fvars))
-                   (uni (uni le-frag.ffuns ri-frag.ffuns)
-                        (uni th-frag.ffuns el-frag.ffuns))))))))
-
-(defmeth compiler comp-switch (me oreg env form)
-  (mac-param-bind form (op idx-form cases-vec) form
-    (let* ((ncases (len cases-vec))
-           (cs (and (plusp ncases) (conses [cases-vec 0])))
-           (shared (and cs
-                        (let ((c cs)
-                              (d (cdr (list-vec cases-vec))))
-                          (whilet ((m (if d (memq (pop d) c))))
-                            (set c m))
-                          (null d))))
-           (cases (if shared
-                    (let ((cs-nil ^(,*cs nil)))
-                      (vec-list [mapcar ldiff cs-nil (cdr cs-nil)]))
-                    cases-vec))
-           (lend (gensym "l"))
-           (clabels (mapcar (ret (gensym "l")) cases))
-           (treg me.(maybe-alloc-treg oreg))
-           (ifrag me.(compile treg env idx-form))
-           (seen (unless shared (hash :eql-based)))
-           last-cfrag
-           (cfrags (collect-each ((cs cases)
-                                  (lb clabels)
-                                  (i (range 1)))
-                     (iflet ((seen-lb (and seen [seen cs])))
-                       (progn
-                         (set [clabels (pred i)] seen-lb)
-                         (new (frag oreg nil)))
-                       (let ((cfrag me.(comp-progn oreg env cs)))
-                         (when (eq i ncases)
-                           (set last-cfrag cfrag))
-                         (unless shared
-                           (set [seen cs] lb))
-                         (new (frag oreg
-                                    ^(,lb
-                                       ,*cfrag.code
-                                       ,*(unless shared
-                                           ^(,*me.(maybe-mov oreg cfrag.oreg)
-                                              ,*(unless (= i ncases)
-                                                  ^((jmp ,lend))))))
-                                    cfrag.fvars cfrag.ffuns)))))))
-      me.(maybe-free-treg treg oreg)
-      (new (frag oreg
-                 ^(,*ifrag.code
-                   (swtch ,ifrag.oreg ,*(list-vec clabels))
-                   ,*(mappend .code cfrags)
-                   ,*(when (and shared last-cfrag)
-                       me.(maybe-mov oreg last-cfrag.oreg))
-                   ,lend)
-                 (uni ifrag.fvars [reduce-left uni cfrags nil .fvars])
-                 (uni ifrag.ffuns [reduce-left uni cfrags nil .ffuns]))))))
-
-(defmeth compiler comp-unwind-protect (me oreg env form)
-  (mac-param-bind form (op prot-form . cleanup-body) form
-    (let* ((treg me.(alloc-treg))
-           (pfrag me.(compile oreg env prot-form))
-           (cfrag me.(comp-progn treg env cleanup-body))
-           (lclean (gensym "l")))
-      me.(free-treg treg)
-      (cond
-        ((null pfrag.code)
-         (new (frag pfrag.oreg
-                    cfrag.code
-                    cfrag.fvars
-                    cfrag.ffuns)))
-        ((null cfrag.code) pfrag)
-        (t (new (frag pfrag.oreg
-                      ^((uwprot ,lclean)
-                        ,*pfrag.code
-                        (end nil)
-                        ,lclean
-                        ,*cfrag.code
-                        (end nil))
-                      (uni pfrag.fvars pfrag.fvars)
-                      (uni cfrag.fvars cfrag.fvars))))))))
-
-(defmeth compiler comp-block (me oreg env form)
-  (mac-param-bind form (op name . body) form
-    (let* ((star (and name (eq op 'block*)))
-           (nenv (unless star
-                   (new env up env lev env.lev co me)))
-           (binfo (unless star
-                    (cdar nenv.(extend-block name))))
-           (treg (if star me.(maybe-alloc-treg oreg)))
-           (nfrag (if star me.(compile treg env name)))
-           (nreg (if star nfrag.oreg me.(get-dreg name)))
-           (bfrag me.(comp-progn oreg (or nenv env) body))
-           (lskip (gensym "l")))
-      (when treg
-        me.(maybe-free-treg treg oreg))
-      (if (and (>= *opt-level* 2)
-               (not star)
-               (not binfo.used)
-               (if (eq op 'sys:blk)
-                 [all bfrag.ffuns [orf system-symbol-p (op eq name)]]
-                 [all bfrag.ffuns system-symbol-p])
-               [none bfrag.ffuns (op member @1 %block-using-funs%)])
-        bfrag
-        (new (frag oreg
-                   ^(,*(if nfrag nfrag.code)
-                      (block ,oreg ,nreg ,lskip)
-                      ,*bfrag.code
-                      ,*me.(maybe-mov oreg bfrag.oreg)
-                      (end ,oreg)
-                      ,lskip)
-                   bfrag.fvars
-                   bfrag.ffuns))))))
-
-(defmeth compiler comp-return-from (me oreg env form)
-  (mac-param-bind form (op name : value) form
-    (let* ((nreg (if (null name)
-                   nil
-                   me.(get-dreg name)))
-           (opcode (if (eq op 'return-from) 'ret 'abscsr))
-           (vfrag me.(compile oreg env value))
-           (binfo env.(lookup-block name t)))
-      (new (frag oreg
-                 ^(,*vfrag.code
-                   (,opcode ,nreg ,vfrag.oreg))
-                 vfrag.fvars
-                 vfrag.ffuns)))))
-
-(defmeth compiler comp-return (me oreg env form)
-  (mac-param-bind form (op : value) form
-    me.(comp-return-from oreg env ^(return-from nil ,value))))
-
-(defmeth compiler comp-handler-bind (me oreg env form)
-  (mac-param-bind form (op func-form ex-syms . body) form
-    (let* ((freg me.(maybe-alloc-treg oreg))
-           (ffrag me.(compile freg env func-form))
-           (sreg me.(get-dreg ex-syms))
-           (bfrag me.(comp-progn oreg env body)))
-      me.(maybe-free-treg freg oreg)
-      (new (frag bfrag.oreg
-                 ^(,*ffrag.code
-                   (handle ,ffrag.oreg ,sreg)
-                   ,*bfrag.code
-                   (end ,bfrag.oreg))
-                 (uni ffrag.fvars bfrag.fvars)
-                 (uni ffrag.ffuns bfrag.ffuns))))))
-
-(defmeth compiler comp-catch (me oreg env form)
-  (mac-param-bind form (op symbols try-expr desc-expr . clauses) form
-    (with-gensyms (ex-sym-var ex-args-var)
-      (let* ((nenv (new env up env co me))
-             (esvb (cdar nenv.(extend-var ex-sym-var)))
-             (eavb (cdar nenv.(extend-var ex-args-var)))
-             (tfrag me.(compile oreg nenv try-expr))
-             (dfrag me.(compile oreg nenv desc-expr))
-             (coreg (if (equal tfrag.oreg '(t 0)) oreg tfrag.oreg))
-             (lhand (gensym "l"))
-             (lhend (gensym "l"))
-             (treg me.(alloc-treg))
-             (nclauses (len clauses))
-             (cfrags (collect-each ((cl clauses)
-                                    (i (range 1)))
-                       (mac-param-bind form (sym params . body) cl
-                         (let* ((cl-src ^(apply (lambda ,params ,*body)
-                                                ,ex-sym-var ,ex-args-var))
-                                (cfrag me.(compile coreg nenv (expand cl-src)))
-                                (lskip (gensym "l")))
-                           (new (frag coreg
-                                      ^((gcall ,treg
-                                               ,me.(get-sidx 'exception-subtype-p)
-                                               ,esvb.loc
-                                               ,me.(get-dreg sym))
-                                        (if ,treg ,lskip)
-                                        ,*cfrag.code
-                                        ,*me.(maybe-mov coreg cfrag.oreg)
-                                        ,*(unless (eql i nclauses)
-                                            ^((jmp ,lhend)))
-                                        ,lskip)
-                                      cfrag.fvars
-                                      cfrag.ffuns)))))))
-        me.(free-treg treg)
-        (new (frag coreg
-                   ^((frame ,nenv.lev ,nenv.v-cntr)
-                     ,*dfrag.code
-                     (catch ,esvb.loc ,eavb.loc
-                            ,me.(get-dreg symbols) ,dfrag.oreg ,lhand)
-                     ,*tfrag.code
-                     ,*me.(maybe-mov coreg tfrag.oreg)
-                     (jmp ,lhend)
-                     ,lhand
-                     ,*(mappend .code cfrags)
-                     ,lhend
-                     (end ,coreg)
-                     (end ,coreg))
-                   (uni tfrag.fvars [reduce-left uni cfrags nil .fvars])
-                   (uni tfrag.ffuns [reduce-left uni cfrags nil .ffuns])))))))
-
-(defmeth compiler eliminate-frame (me code env)
-  (if (>= me.(unalloc-reg-count) (len env.vb))
-    (let ((trhash (hash))
-          (vbhash (hash))
-          (vlev (ppred env.lev))
-          (tregs nil))
-      (each ((cell env.vb))
-        (tree-bind (sym . vbind) cell
-          (let ((treg me.(alloc-new-treg)))
-            (set [trhash vbind.loc] treg)
-            (set [vbhash vbind.loc] vbind)
-            (push treg tregs))))
-      (let ((ncode (append-each ((insns (conses code)))
-                     (match-case insns
-                       (((frame @lev @size) . @rest)
-                        ^((frame ,(pred lev) ,size)))
-                       (((dframe @lev @size) . @rest)
-                        ^((dframe ,(pred lev) ,size)))
-                       (((@op . @args) . @rest)
-                        (let ((nargs (mapcar (lambda-match
-                                               ((@(as arg (v @lev @idx)))
-                                                (or [trhash arg]
-                                                    (if (> lev vlev)
-                                                      ^(v ,(pred lev) ,idx)
-                                                      arg)))
-                                               ((@arg) arg))
-                                             args)))
-                          ^((,op ,*nargs))))
-                       ((@else . @rest) (list else))))))
-        (dohash (loc treg trhash)
-          (let ((vb [vbhash loc]))
-            (set vb.loc treg)
-            me.(free-treg treg)))
-        (if (plusp me.loop-nest)
-          (append (mapcar (ret ^(mov ,@1 (t 0))) (nreverse tregs)) ncode)
-          ncode)))
-    code))
-
-(defmeth compiler comp-let (me oreg env form)
-  (mac-param-bind form (sym raw-vis . body) form
-    (let* ((vis (mapcar [iffi atom list] raw-vis))
-           (specials [keep-if special-var-p vis car])
-           (lexsyms [remove-if special-var-p [mapcar car vis]])
-           allsyms
-           (specials-occur [find-if special-var-p vis car])
-           (treg (if specials-occur me.(alloc-treg)))
-           (frsize (len lexsyms))
-           (seq (eq sym 'let*))
-           (nenv (new env up env co me))
-           (fenv (if seq nenv (new env up env co me))))
-      (with-closure-spy me (and (not specials-occur)
-                                (>= *opt-level* 2))
-                        cspy (new closure-spy env nenv)
-        (unless seq
-          (each ((lsym lexsyms))
-            nenv.(extend-var lsym)))
-        (let* (ffuns fvars
-               (code (build
-                       (add ^(,(if specials-occur 'dframe 'frame)
-                              ,nenv.lev ,frsize))
-                       (each ((vi vis))
-                         (tree-bind (sym : form) vi
-                           (push sym allsyms)
-                           (cond
-                             ((special-var-p sym)
-                              (let ((frag me.(compile treg fenv form))
-                                    (dreg me.(get-dreg sym)))
-                                (pend frag.code)
-                                (add ^(bindv ,frag.oreg ,dreg))
-                                (set ffuns (uni ffuns frag.ffuns)
-                                     fvars (uni fvars
-                                                (if seq
-                                                  (diff frag.fvars
-                                                        (cdr allsyms))
-                                                  frag.fvars)))))
-                             (form
-                               (let* ((tmp (if seq (gensym)))
-                                      (bind (if seq
-                                              (cdar nenv.(extend-var tmp))
-                                              nenv.(lookup-var sym)))
-                                      (frag me.(compile bind.loc fenv form)))
-                                 (when seq
-                                   fenv.(rename-var tmp sym))
-                                 (pend frag.code)
-                                 (unless (null-reg frag.oreg)
-                                   (pend me.(maybe-mov bind.loc frag.oreg)))
-                                 (set ffuns (uni ffuns frag.ffuns)
-                                      fvars (uni fvars
-                                                 (if seq
-                                                   (diff frag.fvars
-                                                         (cdr allsyms))
-                                                   frag.fvars)))))
-                             (t (if seq nenv.(extend-var* sym))))))))
-               (bfrag me.(comp-progn oreg nenv body))
-               (boreg (if env.(out-of-scope bfrag.oreg) oreg bfrag.oreg))
-               (code (append code bfrag.code
-                             me.(maybe-mov boreg bfrag.oreg)
-                             ^((end ,boreg)))))
-          (when (and cspy (null cspy.cap-vars))
-            (set code me.(eliminate-frame [code 1..-1] nenv)))
-          (when treg
-            me.(free-treg treg))
-          (new (frag boreg
-                     code
-                     (uni (diff bfrag.fvars allsyms) fvars)
-                     (uni ffuns bfrag.ffuns))))))))
-
-(defmeth compiler comp-fbind (me oreg env form)
-  (mac-param-bind form (sym raw-fis . body) form
-    (let* ((fis (mapcar [iffi atom list] raw-fis))
-           (lexfuns [mapcar car fis])
-           (frsize (len lexfuns))
-           (rec (eq sym 'sys:lbind))
-           (eenv (unless rec (new env up env co me)))
-           (nenv (new env up env co me)))
-      (each ((lfun lexfuns))
-        nenv.(extend-fun lfun))
-      (let* (ffuns fvars
-             (ffrags (collect-each ((fi fis))
-                       (tree-bind (sym : form) fi
-                         (let* ((bind nenv.(lookup-fun sym))
-                                (frag me.(compile bind.loc
-                                                  (if rec nenv eenv)
-                                                  form)))
-                           (set bind.pars frag.pars)
-                           (list bind
-                                 (new (frag frag.oreg
-                                            (append frag.code
-                                                    me.(maybe-mov bind.loc frag.oreg))
-                                            frag.fvars
-                                            frag.ffuns)))))))
-             (bfrag me.(comp-progn oreg nenv body))
-             (boreg (if env.(out-of-scope bfrag.oreg) oreg bfrag.oreg)))
-        (set ffrags (append-each ((bf ffrags))
-                      (tree-bind (bind ff) bf
-                        (when bind.used
-                          (set ffuns (uni ffuns ff.ffuns)
-                               fvars (uni fvars ff.fvars))
-                          (list ff)))))
-        (new (frag boreg
-                   (append ^((frame ,nenv.lev ,frsize))
-                           (mappend .code ffrags)
-                           bfrag.code
-                           me.(maybe-mov boreg bfrag.oreg)
-                           ^((end ,boreg)))
-                   (uni fvars bfrag.fvars)
-                   (uni (diff bfrag.ffuns lexfuns)
-                        (if rec (diff ffuns lexfuns) ffuns))))))))
-
-(defmeth compiler comp-lambda-impl (me oreg env form)
-  (mac-param-bind form (op par-syntax . body) form
-    (with-access-spy me me.closure-spies
-                     spy (new access-spy
-                              closure-spies me.closure-spies)
-      (compile-with-fresh-tregs me
-        (let* ((*load-time* nil)
-               (pars (new (fun-param-parser par-syntax form)))
-               (need-frame (or (plusp pars.nfix) pars.rest))
-               (nenv (if need-frame (new env up env co me) env))
-               lexsyms fvars specials need-dframe)
-          (when (> pars.nfix %max-lambda-fixed-args%)
-            (compile-warning form "~s arguments in a lambda (max is ~s)"
-                             pars.nfix %max-lambda-fixed-args%))
-          (flet ((spec-sub (sym)
-                   (cond
-                     ((special-var-p sym)
-                      (let ((sub (gensym)))
-                        (push (cons sym sub) specials)
-                        (set need-dframe t)
-                        nenv.(extend-var sub)
-                        sub))
-                     (t
-                       (push sym lexsyms)
-                       nenv.(extend-var sym)
-                       sym))))
-            (let* ((req-pars (collect-each ((rp pars.req))
-                               (spec-sub rp)))
-                   (opt-pars (collect-each ((op pars.opt))
-                               (tree-bind (var-sym : init-form have-sym) op
-                                 (list (spec-sub var-sym)
-                                       init-form
-                                       (if have-sym (spec-sub have-sym))))))
-                   (rest-par (when pars.rest (spec-sub pars.rest)))
-                   (allsyms req-pars))
-              (upd specials nreverse)
-              (with-closure-spy me (and (not specials)
-                                        (>= *opt-level* 2))
-                                cspy (new closure-spy env nenv)
-                (let* ((col-reg (if opt-pars me.(get-dreg :)))
-                       (tee-reg (if opt-pars me.(get-dreg t)))
-                       (ifrags (collect-each ((op opt-pars))
-                                 (tree-bind (var-sym init-form have-sym) op
-                                   (let* ((vbind nenv.(lookup-var var-sym))
-                                          (ifrag me.(compile vbind.loc nenv init-form)))
-                                     (set fvars (uni fvars
-                                                     (diff ifrag.fvars allsyms)))
-                                     (push var-sym allsyms)
-                                     (push have-sym allsyms)
-                                     ifrag))))
-                       (opt-code (append-each ((op opt-pars)
-                                               (ifrg ifrags))
-                                   (tree-bind (var-sym init-form have-sym) op
-                                     (let ((vbind nenv.(lookup-var var-sym))
-                                           (have-bind nenv.(lookup-var have-sym))
-                                           (lskip (gensym "l")))
-                                       ^(,*(if have-sym
-                                             ^((mov ,have-bind.loc ,tee-reg)))
-                                          (ifq ,vbind.loc ,col-reg ,lskip)
-                                          ,*(if have-sym
-                                              ^((mov ,have-bind.loc nil)))
-                                          ,*ifrg.code
-                                          ,*me.(maybe-mov vbind.loc ifrg.oreg)
-                                          ,lskip
-                                          ,*(whenlet ((spec-sub [find var-sym specials : cdr]))
-                                              (set specials [remq var-sym specials cdr])
-                                              ^((bindv ,vbind.loc ,me.(get-dreg (car spec-sub)))))
-                                          ,*(whenlet ((spec-sub [find have-sym specials : cdr]))
-                                              (set specials [remq have-sym specials cdr])
-                                              ^((bindv ,have-bind.loc ,me.(get-dreg (car spec-sub))))))))))
-                       (benv (if need-dframe (new env up nenv co me) nenv))
-                       (btreg me.(alloc-treg))
-                       (bfrag me.(comp-progn btreg benv body))
-                       (boreg (if env.(out-of-scope bfrag.oreg) btreg bfrag.oreg))
-                       (lskip (gensym "l"))
-                       (frsize (if need-frame nenv.v-cntr 0))
-                       (code ^((close ,oreg ,frsize ,me.treg-cntr ,lskip
-                                      ,pars.nfix ,pars.nreq ,(if rest-par t nil)
-                                      ,*(collect-each ((rp req-pars))
-                                          nenv.(lookup-var rp).loc)
-                                      ,*(collect-each ((op opt-pars))
-                                          nenv.(lookup-var (car op)).loc)
-                                      ,*(if rest-par
-                                          (list nenv.(lookup-var rest-par).loc)))
-                               ,*(if need-dframe
-                                   ^((dframe ,benv.lev 0)))
-                               ,*(if specials
-                                   (collect-each ((vs specials))
-                                     (tree-bind (special . gensym) vs
-                                       (let ((sub-bind nenv.(lookup-var gensym))
-                                             (dreg me.(get-dreg special)))
-                                         ^(bindv ,sub-bind.loc ,dreg)))))
-                               ,*opt-code
-                               ,*bfrag.code
-                               ,*(if need-dframe
-                                   ^((end ,boreg)))
-                               ,*me.(maybe-mov boreg bfrag.oreg)
-                               (jend ,boreg)
-                               ,lskip)))
-                  me.(free-treg btreg)
-                  (when (and cspy (plusp frsize) (null cspy.cap-vars))
-                    (when-match ((close @reg @frsize @nreg . @irest) . @crest)
-                                me.(eliminate-frame code nenv)
-                      (set code ^((close ,reg 0 ,me.treg-cntr ,*irest)
-                                  ,*crest))))
-                  (new (frag oreg code
-                             (uni fvars (diff bfrag.fvars lexsyms))
-                             (uni [reduce-left uni ifrags nil .ffuns]
-                                  bfrag.ffuns)
-                             pars)))))))))))
-
-(defmeth compiler comp-lambda (me oreg env form)
-  (if (or *load-time* (< *opt-level* 3))
-    me.(comp-lambda-impl oreg env form)
-    (let* ((snap me.(snapshot))
-           (lambda-frag me.(comp-lambda-impl oreg env form))
-           (ok-lift-var-pov (all lambda-frag.fvars
-                                 (lambda (sym)
-                                   (not env.(lookup-var sym)))))
-           (ok-lift-fun-pov (all lambda-frag.ffuns
-                                 (lambda (sym)
-                                   (not env.(lookup-fun sym))))))
-      (cond
-        ((and ok-lift-var-pov ok-lift-fun-pov)
-         me.(restore snap)
-         me.(compile oreg env ^(sys:load-time-lit nil ,form)))
-        (t lambda-frag)))))
-
-(defmeth compiler comp-fun (me oreg env form)
-  (mac-param-bind form (op arg) form
-    (let ((fbin env.(lookup-fun arg t)))
-      (cond
-        (fbin (new (frag fbin.loc nil nil (list arg))))
-        ((and (consp arg) (eq (car arg) 'lambda))
-         me.(compile oreg env arg))
-        (t (new (frag oreg ^((getf ,oreg ,me.(get-sidx arg)))
-                      nil (list arg))))))))
-
-(defmeth compiler comp-progn (me oreg env args)
-  (let* (ffuns fvars
-         (lead-forms (butlastn 1 args))
-         (last-form (nthlast 1 args))
-         (eff-lead-forms (remove-if [orf constantp symbolp] lead-forms))
-         (forms (append eff-lead-forms last-form))
-         (nargs (len forms))
-         lastfrag
-         (oreg-discard me.(alloc-discard-treg))
-         (code (build
-                 (each ((form forms)
-                        (n (range 1)))
-                   (let ((islast (eql n nargs)))
-                     (let ((frag me.(compile (if islast oreg oreg-discard)
-                                             env form)))
-                       (when islast
-                         (set lastfrag frag))
-                       (set fvars (uni fvars frag.fvars))
-                       (set ffuns (uni ffuns frag.ffuns))
-                       (pend frag.code)))))))
-    me.(free-treg oreg-discard)
-    (new (frag (if lastfrag lastfrag.oreg ^(t 0)) code fvars ffuns))))
-
-(defmeth compiler comp-or (me oreg env form)
-  (tree-case (simplify-or form)
-    ((op) me.(compile oreg env nil))
-    ((op arg) me.(compile oreg env arg))
-    ((op . args)
-     (let* (ffuns fvars
-            (nargs (len args))
-            lastfrag
-            (lout (gensym "l"))
-            (treg me.(maybe-alloc-treg oreg))
-            (code (build
-                    (each ((form args)
-                           (n (range 1)))
-                      (let ((islast (eql n nargs)))
-                        (let ((frag me.(compile treg env form)))
-                          (when islast
-                            (set lastfrag frag))
-                          (pend frag.code
-                                me.(maybe-mov treg frag.oreg))
-                          (unless islast
-                            (add ^(ifq ,treg (t 0) ,lout)))
-                          (set fvars (uni fvars frag.fvars))
-                          (set ffuns (uni ffuns frag.ffuns))))))))
-       me.(maybe-free-treg treg oreg)
-       (new (frag oreg
-                  (append code ^(,lout
-                                 ,*me.(maybe-mov oreg treg)))
-                  fvars ffuns))))))
-
-(defmeth compiler comp-prog1 (me oreg env form)
-  (tree-case form
-    ((prog1 fi . re) (let* ((igreg me.(alloc-discard-treg))
-                            (fireg me.(maybe-alloc-treg oreg))
-                            (fi-frag me.(compile fireg env fi))
-                            (re-frag me.(comp-progn igreg env
-                                                    (append re '(nil)))))
-                       me.(maybe-free-treg fireg oreg)
-                       me.(free-treg igreg)
-                       (new (frag fireg
-                                  (append fi-frag.code
-                                          me.(maybe-mov fireg fi-frag.oreg)
-                                          re-frag.code)
-                                  (uni fi-frag.fvars re-frag.fvars)
-                                  (uni fi-frag.ffuns re-frag.ffuns)))))
-    ((prog1 fi) me.(compile oreg env fi))
-    ((prog1) me.(compile oreg env nil))))
-
-(defmeth compiler comp-quasi (me oreg env form)
-  (let ((qexp (expand-quasi form)))
-    me.(compile oreg env (expand qexp))))
-
-(defmeth compiler comp-arith-form (me oreg env form)
-  (if (plusp *opt-level*)
-    (let ((rform (reduce-constant env form)))
-      (tree-case rform
-        ((op . args)
-         (let* ((pargs [partition-by constantp args])
-                (fargs (append-each ((pa pargs))
-                         (if (and (constantp (car pa))
-                                  (all pa [chain eval integerp]))
-                           (list (eval ^(,op ,*pa)))
-                           pa))))
-           me.(comp-fun-form oreg env ^(,op ,*fargs))))
-        (else me.(compile oreg env rform))))
-    me.(comp-fun-form oreg env form)))
-
-(defmeth compiler comp-arith-neg-form (me oreg env form)
-  (if (> (len form) 3)
-    (tree-bind (nop . args) form
-      (let ((op (caseq nop (- '+) (/ '*)))
-            (a1 (car args)))
-        (if (and (eq nop '-)
-                 (constantp a1))
-          me.(comp-arith-form oreg env
-                              ^(,op (- ,a1) ,*(cdr args)))
-          me.(comp-fun-form oreg env
-                            ^(,nop ,(car args) (,op ,*(cdr args)))))))
-    me.(comp-fun-form oreg env form)))
-
-(defmeth compiler comp-fun-form (me oreg env form)
-  (let* ((olev *opt-level*)
-         (sym (car form))
-         (nargs (len (cdr form)))
-         (fbin env.(lookup-fun sym t))
-         (pars (or fbin.?pars
-                   (get-param-info sym))))
-    (if pars
-      (param-check form nargs pars)
-      (push (cons form nargs) *unchecked-calls*))
-
-    (when (null fbin)
-      (when (plusp olev)
-        (match-case form
-          ((equal @a @b)
-           (cond
-             ((or (eq-comparable a)
-                  (eq-comparable b))
-              (set form ^(eq ,a ,b)))
-             ((or (eql-comparable a)
-                  (eql-comparable b))
-              (set form ^(eql ,a ,b)))))
-          ((not (@(and @(or eq eql equal) @op) @a @b))
-           (let ((nop (caseq op (eq 'neq) (eql 'neql) (equal 'nequal))))
-             (return-from comp-fun-form me.(compile oreg env ^(,nop ,a ,b)))))
-          ((@(or append cons list list*) . @args)
-           (set form (reduce-lisp form)))
-          ((@(@bin [%bin-op% @sym]) @a @b)
-           (set form ^(,bin ,a ,b)))
-          ((- @a)
-           (set form ^(neg ,a)))
-          ((@(or identity + * min max) @a)
-           (return-from comp-fun-form me.(compile oreg env a)))))
-
-      (when (plusp olev)
-        (tree-case form
-          ((sym . args)
-           (set form (reduce-constant env form)))))
-
-      (when (or (atom form) (special-operator-p (car form)))
-        (return-from comp-fun-form me.(compile oreg env form))))
-
-    (tree-bind (sym . args) form
-      (let* ((fbind env.(lookup-fun sym t)))
-        (macrolet ((comp-fun ()
-                      'me.(comp-call-impl oreg env (if fbind 'call 'gcall)
-                                          (if fbind fbind.loc me.(get-sidx sym))
-                                          args sym)))
-          (if (and (>= olev 3)
-                   (not fbind)
-                   (not *load-time*)
-                   [%functional% sym])
-            (let* ((snap me.(snapshot))
-                   (cfrag (comp-fun))
-                   (ok-lift-var-pov (null cfrag.fvars))
-                   (ok-lift-fun-pov (all cfrag.ffuns
-                                         (lambda (sym)
-                                           (and (not env.(lookup-fun sym))
-                                                (eq (symbol-package sym)
-                                                    user-package))))))
-              (cond
-                ((and ok-lift-var-pov ok-lift-fun-pov)
-                 me.(restore snap)
-                 me.(compile oreg env ^(sys:load-time-lit nil ,form)))
-                (t (pushnew sym cfrag.ffuns)
-                   cfrag)))
-            (let ((cfrag (comp-fun)))
-              (pushnew sym cfrag.ffuns)
-              cfrag)))))))
-
-(defmeth compiler comp-apply-call (me oreg env form)
-  (let ((olev *opt-level*))
-    (tree-bind (sym . oargs) form
-      (let ((args (if (plusp olev)
-                    [mapcar (op reduce-constant env) oargs]
-                    oargs)))
-        (let ((gopcode [%gcall-op% sym])
-              (opcode [%call-op% sym]))
-          (cond
-            ((and (plusp olev)
-                  (eq sym 'call)
-                  [all args constantp]
-                  (let ((op (eval (car args))))
-                    (or [%const-foldable% op]
-                        (not (bindable op)))))
-             me.(compile oreg env ^(quote ,(eval form))))
-            (t (tree-case (car args)
-                 ((op arg . more)
-                  (caseq op
-                    (fun (cond
-                           (more (compile-error form "excess args in fun form"))
-                           ((bindable arg)
-                            (let ((fbind env.(lookup-fun arg t)))
-                              me.(comp-call-impl oreg env (if fbind opcode gopcode)
-                                                 (if fbind fbind.loc me.(get-sidx arg))
-                                                 (cdr args) arg)))
-                           ((and (consp arg) (eq (car arg) 'lambda))
-                            me.(comp-fun-form oreg env ^(,sym ,arg ,*(cdr args))))
-                           (t :)))
-                    (lambda me.(comp-inline-lambda oreg env opcode
-                                                   (car args) (cdr args)))
-                    (t :)))
-                 (arg me.(comp-call oreg env
-                                    (if (eq sym 'usr:apply) 'apply sym) args))))))))))
-
-(defmeth compiler comp-call (me oreg env opcode args)
-  (tree-bind (fform . fargs) args
-    (let* ((foreg me.(maybe-alloc-treg oreg))
-           (ffrag me.(compile foreg env fform))
-           (cfrag me.(comp-call-impl oreg env opcode ffrag.oreg fargs)))
-      me.(maybe-free-treg foreg oreg)
-      (new (frag cfrag.oreg
-                 (append ffrag.code
-                         cfrag.code)
-                 (uni ffrag.fvars cfrag.fvars)
-                 (uni ffrag.ffuns cfrag.ffuns))))))
-
-(defmeth compiler comp-call-impl (me oreg env opcode freg args : extra-ffun)
-  (let* ((aoregs nil)
-         (afrags (collect-each ((arg args))
-                   (let* ((aoreg me.(alloc-treg))
-                          (afrag me.(compile aoreg env arg)))
-                     (if (nequal afrag.oreg aoreg)
-                       me.(free-treg aoreg)
-                       (push aoreg aoregs))
-                     afrag)))
-         (fvars [reduce-left uni afrags nil .fvars])
-         (ffuns [reduce-left uni afrags nil .ffuns]))
-    me.(free-tregs aoregs)
-    (when extra-ffun
-      (pushnew extra-ffun ffuns))
-    (new (frag oreg
-               ^(,*(mappend .code afrags)
-                 (,opcode ,oreg ,freg ,*(mapcar .oreg afrags)))
-               fvars ffuns))))
-
-(defmeth compiler comp-inline-lambda (me oreg env opcode lambda args)
-  (let ((reg-args args) apply-list-arg)
-    (when (eql opcode 'apply)
-      (unless args
-        (compile-error lambda "apply requires arguments"))
-      (set reg-args (butlast args)
-           apply-list-arg (car (last args))))
-    me.(compile oreg env (expand (lambda-apply-transform lambda
-                                                         reg-args
-                                                         apply-list-arg
-                                                         nil)))))
-
-(defmeth compiler comp-for (me oreg env form)
-  (mac-param-bind form (op inits (: (test nil test-p) . rets) incs . body) form
-    (let* ((treg me.(alloc-treg))
-           (ifrag me.(comp-progn treg env inits))
-           (*load-time* nil)
-           (dummy (inc me.loop-nest))
-           (tfrag (if test-p me.(compile treg env test)))
-           (rfrag me.(comp-progn oreg env rets))
-           (nfrag me.(comp-progn treg env incs))
-           (bfrag me.(comp-progn treg env body))
-           (dummy (dec me.loop-nest))
-           (lback (gensym "l"))
-           (lskip (gensym "l"))
-           (frags (build
-                    (add ifrag)
-                    (if test-p (add tfrag))
-                    (add rfrag nfrag bfrag))))
-      me.(free-treg treg)
-      (new (frag rfrag.oreg
-                 ^(,*ifrag.code
-                   ,lback
-                   ,*(if test-p
-                      ^(,*tfrag.code
-                        (if ,tfrag.oreg ,lskip)))
-                   ,*bfrag.code
-                   ,*nfrag.code
-                   (jmp ,lback)
-                   ,*(if test-p
-                       ^(,lskip
-                         ,*rfrag.code)))
-                   [reduce-left uni frags nil .fvars]
-                   [reduce-left uni frags nil .ffuns])))))
-
-(defmeth compiler comp-tree-bind (me oreg env form)
-  (tree-bind (op params obj . body) form
-    (with-gensyms (obj-var)
-      (let ((expn (expand ^(let ((,obj-var ,obj))
-                             ,(expand-bind-mac-params ^',form
-                                                      ^',(rlcp ^(,(car form))
-                                                               form)
-                                                      params nil
-                                                      obj-var t nil body)))))
-        me.(compile oreg env expn)))))
-
-(defmeth compiler comp-mac-param-bind (me oreg env form)
-  (mac-param-bind form (op context params obj . body) form
-    (with-gensyms (obj-var form-var)
-      (let ((expn (expand ^(let* ((,obj-var ,obj)
-                                  (,form-var ,context))
-                             ,(expand-bind-mac-params form-var
-                                                      form-var
-                                                      params nil
-                                                      obj-var t nil body)))))
-        me.(compile oreg env expn)))))
-
-(defmeth compiler comp-mac-env-param-bind (me oreg env form)
-  (mac-param-bind form (op context menv params obj . body) form
-    (with-gensyms (obj-var form-var)
-      (let ((expn (expand ^(let* ((,obj-var ,obj)
-                                  (,form-var ,context))
-                             ,(expand-bind-mac-params form-var
-                                                      form-var
-                                                      params menv
-                                                      obj-var t nil body)))))
-        me.(compile oreg env expn)))))
-
-(defmeth compiler comp-tree-case (me oreg env form)
-  (mac-param-bind form (op obj . cases) form
-    (let* ((ncases (len cases))
-           (nenv (new env up env co me))
-           (obj-immut-var (cdar nenv.(extend-var (gensym))))
-           (obj-var (cdar nenv.(extend-var (gensym))))
-           (err-blk (gensym))
-           (lout (gensym "l"))
-           (ctx-form ^',form)
-           (err-form ^',(rlcp ^(,(car form)) form))
-           (treg me.(maybe-alloc-treg oreg))
-           (objfrag me.(compile treg env obj))
-           (cfrags (collect-each ((c cases)
-                                  (i (range 1)))
-                     (mac-param-bind form (params . body) c
-                       (let* ((src (expand ^(block ,err-blk
-                                              (set ,obj-var.sym
-                                                   ,obj-immut-var.sym)
-                                              ,(expand-bind-mac-params
-                                                 ctx-form err-form
-                                                 params nil obj-var.sym :
-                                                 err-blk
-                                                 body))))
-                              (lerrtest (gensym "l"))
-                              (lnext (gensym "l"))
-                              (cfrag me.(compile treg nenv src)))
-                         (new (frag treg
-                                    ^(,*cfrag.code
-                                       ,*me.(maybe-mov treg cfrag.oreg)
-                                       (ifq ,treg ,me.(get-dreg :) ,lout))
-                                    cfrag.fvars
-                                    cfrag.ffuns))))))
-           (allfrags (cons objfrag cfrags)))
-      me.(maybe-free-treg treg oreg)
-      (new (frag oreg
-                 ^(,*objfrag.code
-                   (frame ,nenv.lev ,nenv.v-cntr)
-                   ,*me.(maybe-mov obj-immut-var.loc objfrag.oreg)
-                   ,*(mappend .code cfrags)
-                   (mov ,treg nil)
-                   ,lout
-                   ,*me.(maybe-mov oreg treg)
-                   (end ,oreg))
-                 [reduce-left uni allfrags nil .fvars]
-                 [reduce-left uni allfrags nil .ffuns])))))
-
-(defmeth compiler comp-lisp1-value (me oreg env form)
-  (mac-param-bind form (op arg) form
-    (cond
-      ((bindable arg)
-       (let ((bind env.(lookup-lisp1 arg t)))
-         (cond
-           (bind
-             (each ((spy me.access-spies))
-               spy.(accessed bind arg))
-             (new (frag bind.loc
-                        nil
-                        (if (typep bind 'vbinding) (list arg))
-                        (if (typep bind 'fbinding) (list arg)))))
-           ((not (boundp arg))
-            (pushnew arg assumed-fun)
-            (new (frag oreg
-                       ^((getf ,oreg ,me.(get-sidx arg)))
-                       nil
-                       (list arg))))
-           ((special-var-p arg)
-            (new (frag oreg
-                       ^((getv ,oreg ,me.(get-dreg arg)))
-                       (list arg)
-                       nil)))
-           (t (new (frag oreg
-                       ^((getlx ,oreg ,me.(get-sidx arg)))
-                       (list arg)
-                       nil))))))
-      (t me.(compile oreg env arg)))))
-
-(defmeth compiler comp-dwim (me oreg env form)
-  (mac-param-bind form (op obj . args) form
-    (let* ((l1-exprs (cdr form))
-           (fun (car l1-exprs))
-           (bind env.(lookup-lisp1 fun nil)))
-      me.(compile oreg env
-                  (if (and (symbolp fun)
-                           (not bind)
-                           (not (boundp fun)))
-                    (progn
-                      (pushnew fun assumed-fun)
-                      ^(,fun ,*(mapcar [iffi bindable (op list 'sys:lisp1-value)] (cdr l1-exprs))))
-                    ^(call ,*(mapcar [iffi bindable (op list 'sys:lisp1-value)] l1-exprs)))))))
-
-(defmeth compiler comp-prof (me oreg env form)
-  (mac-param-bind form (op . forms) form
-    (let ((bfrag me.(comp-progn oreg env forms)))
-      (new (frag oreg
-                 ^((prof ,oreg)
-                   ,*bfrag.code
-                   (end ,bfrag.oreg))
-                 bfrag.fvars bfrag.ffuns)))))
-
-(defun misleading-ref-check (frag env form)
-  (each ((v frag.fvars))
-    (when env.(lookup-var v)
-      (compile-warning form "cannot refer to lexical variable ~s" v)))
-  (each ((f frag.ffuns))
-    (when env.(lookup-fun f)
-      (compile-warning form "cannot refer to lexical function ~s" f))))
-
-(defmeth compiler comp-load-time-lit (me oreg env form)
-  (mac-param-bind form (op loaded-p exp) form
-    (cond
-      (loaded-p me.(compile oreg env ^(quote ,exp)))
-      ((or *load-time* (constantp exp)) me.(compile oreg env exp))
-      (t (compile-in-toplevel me
-           (let* ((*load-time* t)
-                  (dreg me.(alloc-dreg))
-                  (exp me.(compile dreg (new env co me) exp))
-                  (lt-frag (new (frag dreg
-                                      ^(,*exp.code
-                                         ,*me.(maybe-mov dreg exp.oreg))
-                                      exp.fvars
-                                      exp.ffuns
-                                      exp.pars))))
-             (misleading-ref-check exp env form)
-             (push lt-frag me.lt-frags)
-             (new (frag dreg nil nil nil exp.pars))))))))
-
-(defmeth compiler optimize (me insns)
-  (let ((olev *opt-level*))
-    (if (>= olev 4)
-      (let* ((lt-dregs (mapcar .oreg me.lt-frags))
-             (bb (new (basic-blocks insns lt-dregs me.(get-symvec)))))
-        (when (>= olev 4)
-          bb.(thread-jumps)
-          bb.(elim-dead-code))
-        (when (>= olev 5)
-          bb.(calc-liveness)
-          bb.(peephole))
-        (cond
-          ((>= olev 6)
-           bb.(merge-jump-thunks)
-           bb.(late-peephole bb.(get-insns)))
-          (t bb.(get-insns))))
-      insns)))
-
-(defun true-const-p (arg)
-  (and arg (constantp arg)))
-
-(defun eq-comparable (arg)
-  (and (constantp arg)
-       [[orf fixnump chrp symbolp] (eval arg)]))
-
-(defun eql-comparable (arg)
-  (and (constantp arg)
-       [[orf symbolp chrp numberp] (eval arg)]))
-
-(defun expand-and (form)
-  (match-case form
-    ((and) t)
-    ((and @a) a)
-    ((and @(true-const-p) . @rest) (expand-and ^(and ,*rest)))
-    ((and nil . @rest) nil)
-    ((and @a . @rest) ^(if ,a ,(expand-and ^(and ,*rest))))
-    (@else else)))
-
-(defun flatten-or (form)
-  (match-case form
-    ((or . @args) ^(or ,*[mappend [chain flatten-or cdr] args]))
-    (@else ^(or ,else))))
-
-(defun reduce-or (form)
-  (match-case form
-    ((or) form)
-    ((or @a) form)
-    ((or nil . @rest) (reduce-or ^(or ,*rest)))
-    ((or @(true-const-p @c) . @rest) ^(or ,c))
-    ((or @a . @rest) ^(or ,a ,*(cdr (reduce-or ^(or ,*rest)))))
-    (@else else)))
-
-(defun simplify-or (form)
-  (reduce-or (flatten-or form)))
-
-(defmacro fixed-point (eqfn sym exp)
-  (with-gensyms (osym)
-    ^(let (,osym)
-       (while* (not (,eqfn ,osym ,sym))
-         (set ,osym ,sym
-              ,sym ,exp))
-       ,sym)))
-
-(defun reduce-lisp (form)
-  (fixed-point equal form
-    (rlcp
-      (match-case form
-        ((append (list . @largs) . @aargs)
-         ^(list* ,*largs (append ,*aargs)))
-        ((@(or append list*) @arg) arg)
-        (@(require (list* . @(listp @args))
-                   (equal '(nil) (last args)))
-          ^(list ,*(butlastn 1 args)))
-        (@(with (list* . @(listp @args))
-                ((@(and @op @(or list list*)) . @largs)) (last args))
-          ^(,op ,*(butlast args) ,*largs))
-        (@(with (list* . @(listp @args))
-                ((append . @aargs)) (last args))
-          ^(list* ,*(butlast args) ,(reduce-lisp ^(append ,*aargs))))
-        ((@(or append list list*)) nil)
-        ((cons @a @b)
-         (let* ((lstar ^(list* ,a ,b))
-                (rstar (reduce-lisp lstar)))
-           (if (eq lstar rstar) form rstar)))
-        ((cons @a (cons @b @c))
-         ^(list* ,a ,b ,c))
-        ((cons @a (@(and @op @(or list list*)) . @args))
-         ^(,op ,a ,*args))
-        (@else else))
-      form)))
-
-(defun reduce-constant (env form)
-  (if (consp form)
-    (tree-bind (op . args) form
-      (if (and [%const-foldable% op]
-               (not env.(lookup-fun op)))
-        (let ((cargs [mapcar (op reduce-constant env) args]))
-          (if [all cargs constantp]
-            ^(quote ,(eval (rlcp ^(,op ,*cargs) form)))
-            (rlcp ^(,op ,*cargs) form)))
-        form))
-    form))
-
-(defun expand-quasi-mods (obj mods : form)
-  (let (plist num sep rng-ix scalar-ix-p flex gens)
-    (flet ((get-sym (exp)
-             (let ((gen (gensym)))
-               (push (list gen exp) gens)
-               gen)))
-      (for () (mods) ((pop mods))
-        (let ((mel (car mods)))
-          (cond
-            ((keywordp mel)
-             (set plist mods)
-             (return))
-            ((integerp mel)
-             (when num
-               (compile-error form "duplicate modifier (width/alignment): ~s"
-                              num))
-             (set num mel))
-            ((stringp mel)
-             (when sep
-               (compile-error form "duplicate modifier (separator): ~s"
-                              num))
-             (set sep mel))
-            ((atom mel)
-             (push (get-sym mel) flex))
-            (t
-              (caseq (car mel)
-                (dwim
-                  (when rng-ix
-                    (compile-error form "duplicate modifier (range/index): ~s"
-                                   mel))
-                  (unless (consp (cdr mel))
-                    (compile-error form "missing argument in range/index: ~s"
-                                   mel))
-                  (unless (null (cddr mel))
-                    (compile-error form "excess args in range/index: ~s"
-                                   num))
-                  (let ((arg (cadr mel)))
-                    (cond
-                      ((and (consp arg) (eq (car arg) 'range))
-                       (set rng-ix (get-sym ^(rcons ,(cadr arg) ,(caddr arg)))))
-                      (t
-                        (set rng-ix (get-sym arg))
-                        (set scalar-ix-p t)))))
-                (sys:expr (push (get-sym flex) (cadr mel)))
-                (t (push (get-sym mel) flex)))))))
-      (let ((mcount (+ (if num 1 0)
-                       (if sep 1 0)
-                       (if rng-ix 1 0)
-                       (len flex))))
-        (when (> mcount 3)
-          (compile-error form "too many formatting modifiers"))
-        ^(alet ,(nreverse gens)
-           ,(if flex
-              ^(sys:fmt-flex ,obj ',plist
-                             ,*(remq nil (list* num sep
-                                                (if scalar-ix-p
-                                                  ^(rcons ,rng-ix nil)
-                                                  rng-ix)
-                                                (nreverse flex))))
-              (cond
-                (plist ^(sys:fmt-simple ,obj ,num ,sep, rng-ix ',plist))
-                (rng-ix ^(sys:fmt-simple ,obj ,num ,sep, rng-ix))
-                (sep ^(sys:fmt-simple ,obj ,num ,sep))
-                (num ^(sys:fmt-simple ,obj ,num))
-                (t ^(sys:fmt-simple ,obj ,num)))))))))
-
-(defun expand-quasi-args (form)
-  (append-each ((el (cdr form)))
-    (cond
-      ((consp el)
-       (caseq (car el)
-         (sys:var (mac-param-bind form (sym exp : mods) el
-                    (list (expand-quasi-mods exp mods))))
-         (sys:quasi (expand-quasi-args el))
-         (t (list ^(sys:fmt-simple ,el)))))
-      ((bindable el)
-       (list ^(sys:fmt-simple ,el)))
-      (t
-        (list el)))))
-
-(defun expand-quasi (form)
-  (let ((qa (expand-quasi-args form)))
-    (cond
-      ((cdr qa) ^(sys:fmt-join ,*qa))
-      (qa (car qa))
-      (t '(mkstring 0)))))
-
-(defun expand-dohash (form)
-  (mac-param-bind form (op (key-var val-var hash-form : res-form) . body) form
-    (with-gensyms (iter-var cell-var)
-      ^(let (,key-var ,val-var (,iter-var (hash-begin ,hash-form)) ,cell-var)
-         (block nil
-           (sys:for-op ((sys:setq ,cell-var (hash-next ,iter-var)))
-                       (,cell-var ,res-form)
-                       ((sys:setq ,cell-var (hash-next ,iter-var)))
-              (sys:setq ,key-var (car ,cell-var))
-              (sys:setq ,val-var (cdr ,cell-var))
-              ,*body))))))
-
-(defun expand-each (form env)
-  (mac-param-bind form (op each-type vars . body) form
-    (when (eq vars t)
-      (set vars [mapcar car env.vb]))
-    (let* ((gens (mapcar (ret (gensym)) vars))
-           (out (if (member each-type '(collect-each append-each))
-                  (gensym)))
-           (accum (if out (gensym))))
-      ^(let* (,*(mapcar (ret ^(,@1 (iter-begin ,@2))) gens vars)
-               ,*(if accum ^((,out (cons nil nil)) (,accum ,out))))
-         (block nil
-           (sys:for-op ()
-                       ((and ,*(mapcar (op list 'iter-more) gens))
-                        ,*(if accum (if (eq each-type 'collect-each)
-                                      ^((cdr ,out))
-                                      ^((sys:apply (fun append) ,out)))))
-                       (,*(mapcar (ret ^(sys:setq ,@1 (iter-step ,@1))) gens))
-             ,*(mapcar (ret ^(sys:setq ,@1 (iter-item ,@2))) vars gens)
-             ,*(caseq each-type
-                 ((collect-each append-each)
-                    ^((rplacd ,accum (cons (progn ,*body) nil))
-                      (sys:setq ,accum (cdr ,accum))))
-                 (t body))))))))
-
-(defun expand-bind-mac-params (ctx-form err-form params menv-var
-                               obj-var strict err-block body)
-  (let (gen-stk stmt vars)
-    (labels ((get-gen ()
-               (or (pop gen-stk) (gensym)))
-             (put-gen (g)
-               (push g gen-stk))
-             (expand-rec (par-syntax obj-var check-var)
-               (labels ((emit-stmt (form)
-                          (when form
-                            (if check-var
-                              (push ^(when ,check-var ,form) stmt)
-                              (push form stmt))))
-                        (emit-var (sym init-form)
-                          (push (if stmt
-                                  (prog1
-                                    ^(,sym (progn ,*(nreverse stmt)
-                                             ,(if check-var
-                                                ^(when ,check-var ,init-form)
-                                                init-form)))
-                                    (set stmt nil))
-                                  ^(,sym ,(if check-var
-                                            ^(when ,check-var ,init-form)
-                                            init-form)))
-                            vars)))
-                 (let ((pars (new (mac-param-parser par-syntax ctx-form))))
-                   (progn
-                     (cond
-                       ((eq strict t)
-                        (emit-stmt
-                          ^(sys:bind-mac-check ,err-form ',par-syntax
-                                               ,obj-var ,pars.nreq
-                                               ,(unless pars.rest
-                                                  pars.nfix))))
-                       ((null strict))
-                       ((symbolp strict)
-                        (emit-stmt
-                          (let ((len-expr ^(if (consp ,obj-var)
-                                             (len ,obj-var) 0)))
-                            (if pars.rest
-                              ^(unless (<= ,pars.nreq ,len-expr)
-                                 (return-from ,err-block ',strict))
-                              ^(unless (<= ,pars.nreq ,len-expr ,pars.nfix)
-                                 (return-from ,err-block ',strict)))))))
-                     (each ((k pars.key))
-                       (tree-bind (key . sym) k
-                         (caseq key
-                           (:whole (emit-var sym obj-var))
-                           (:form (emit-var sym ctx-form))
-                           (:env (emit-var sym menv-var)))))
-                     (each ((p pars.req))
-                       (cond
-                         ((listp p)
-                           (let ((curs (get-gen)))
-                             (emit-stmt ^(set ,curs (car ,obj-var)))
-                             (emit-stmt ^(set ,obj-var (cdr ,obj-var)))
-                             (expand-rec p curs check-var)
-                             (put-gen curs)))
-                         (t
-                           (emit-var p ^(car ,obj-var))
-                           (emit-stmt ^(set ,obj-var (cdr ,obj-var))))))
-                     (each ((o pars.opt))
-                       (tree-bind (p : init-form pres-p) o
-                         (cond
-                           ((listp p)
-                             (let* ((curs (get-gen))
-                                    (stmt ^(cond
-                                            (,obj-var
-                                              (set ,curs (car ,obj-var))
-                                              (set ,obj-var (cdr ,obj-var))
-                                              ,*(if pres-p '(t)))
-                                            (t
-                                              (set ,curs ,init-form)
-                                              ,*(if pres-p '(nil))))))
-                               (if pres-p
-                                 (emit-var pres-p stmt)
-                                 (emit-stmt stmt))
-                               (let ((cv (gensym)))
-                                 (emit-var cv curs)
-                                 (expand-rec p curs cv)
-                                 (put-gen curs))))
-                           (t
-                             (cond
-                               (pres-p
-                                 (emit-var p nil)
-                                 (emit-var pres-p
-                                           ^(cond
-                                              (,obj-var
-                                                (set ,p (car ,obj-var))
-                                                (set ,obj-var (cdr ,obj-var))
-                                                ,(if pres-p t))
-                                              (t
-                                                ,(if init-form
-                                                   ^(set ,p ,init-form))
-                                                ,(if pres-p nil)))))
-                               (t
-                                 (emit-var p ^(if ,obj-var
-                                                (prog1
-                                                  (car ,obj-var)
-                                                  (set ,obj-var (cdr ,obj-var)))
-                                                (if ,init-form ,init-form)))))))))
-                     (when pars.rest
-                       (emit-var pars.rest obj-var)))))))
-      (expand-rec params obj-var nil)
-      (when stmt
-        (push ^(,(gensym) (progn ,*(nreverse stmt))) vars))
-      ^(let* (,*gen-stk ,*(nreverse vars))
-         ,*body))))
-
-(defun expand-defvarl (form)
-  (mac-param-bind form (op sym : value) form
-    (with-gensyms (cell)
-      (if value
-        ^(let ((,cell (sys:rt-defv ',sym)))
-           (if ,cell
-             (usr:rplacd ,cell ,value))
-           ',sym)
-        ^(progn (sys:rt-defv ',sym) ',sym)))))
-
-(defun expand-defun (form)
-  (mac-param-bind form (op name args . body) form
-    (flet ((mklambda (block-name block-sym)
-             ^(lambda ,args (,block-sym ,block-name ,*body))))
-      (cond
-        ((bindable name)
-         ^(sys:rt-defun ',name ,(mklambda name 'sys:blk)))
-        ((consp name)
-         (caseq (car name)
-           (meth
-             (mac-param-bind form (meth type slot) name
-               ^(sys:define-method ',type ',slot ,(mklambda slot 'block))))
-           (macro
-             (mac-param-bind form (macro sym) name
-               ^(sys:rt-defmacro ',sym ',name ,(mklambda sym 'sys:blk))))
-           (t (compile-error form "~s isn't a valid compound function name"
-                             name))))
-        (t (compile-error form "~s isn't a valid function name" name))))))
-
-(defun expand-defmacro (form)
-  (mac-param-bind form (op name mac-args . body) form
-    (with-gensyms (form menv spine-iter)
-      (let ((exp-lam ^(lambda (,form ,menv)
-                        (let ((,spine-iter (cdr ,form)))
-                          ,(expand (expand-bind-mac-params form form mac-args
-                                                           menv spine-iter
-                                                           t nil
-                                     ^((sys:set-macro-ancestor
-                                         (block ,name ,*body)
-                                         ,form))))))))
-        ^(progn
-           (sys:rt-defmacro ',name '(macro ,name) ,exp-lam)
-           ',name)))))
-
-(defun expand-defsymacro (form)
-  (mac-param-bind form (op name def) form
-    ^(sys:rt-defsymacro ',name ',def)))
-
-(defun lambda-apply-transform (lm-expr fix-arg-exprs apply-list-expr recursed)
-  (if (and (not recursed)
-           apply-list-expr
-           (constantp apply-list-expr))
-    (let* ((apply-list-val (eval apply-list-expr))
-           (apply-atom (nthlast 0 apply-list-val))
-           (apply-fixed (butlastn 0 apply-list-val)))
-      (lambda-apply-transform lm-expr (append fix-arg-exprs
-                                              (mapcar (ret ^',@1) apply-fixed))
-                              ^',apply-atom t))
-    (mac-param-bind lm-expr (lambda lm-args . lm-body) lm-expr
-      (let* ((pars (new (fun-param-parser lm-args lm-expr)))
-             (fix-vals (mapcar (ret (gensym)) fix-arg-exprs))
-             (ign-sym (gensym))
-             (al-val (gensym))
-             (shadow-p (let ((all-vars (append pars.req pars.(opt-syms)
-                                               (if pars.rest (list pars.rest)))))
-                         (or (isec all-vars fix-arg-exprs)
-                             (member apply-list-expr all-vars)))))
-        ^(,(if shadow-p 'let 'alet) ,(zip fix-vals fix-arg-exprs)
-           (let* ,(build
-                    (if apply-list-expr
-                      (add ^(,al-val ,apply-list-expr)))
-                    (while (and fix-vals pars.req)
-                      (add ^(,(pop pars.req) ,(pop fix-vals))))
-                    (while (and fix-vals pars.opt)
-                      (tree-bind (var-sym : init-form have-sym) (pop pars.opt)
-                        (add ^(,var-sym ,(pop fix-vals)))
-                        (if have-sym
-                          (add ^(,have-sym t)))))
-                    (cond
-                      ((and (null pars.req)
-                            (null pars.opt))
-                       (if fix-vals
-                         (if pars.rest
-                           (add ^(,pars.rest
-                                   (list*
-                                     ,*(nthcdr pars.nfix
-                                               ^(,*fix-arg-exprs ,apply-list-expr)))))
-                           (lambda-too-many-args lm-expr))
-                         (when (or pars.rest apply-list-expr)
-                           (add ^(,(or pars.rest ign-sym) ,apply-list-expr)))))
-                      ((and fix-vals apply-list-expr)
-                       (lambda-too-many-args lm-expr))
-                      (apply-list-expr
-                        (when pars.req
-                          (add ^(,ign-sym (if (< (len ,al-val) ,(len pars.req))
-                                            (lambda-short-apply-list)))))
-                        (while pars.req
-                          (add ^(,(pop pars.req) (pop ,al-val))))
-                        (while pars.opt
-                          (tree-bind (var-sym : init-form have-sym) (pop pars.opt)
-                            (cond
-                              (have-sym
-                                (add ^(,var-sym (if ,al-val
-                                                  (car ,al-val)
-                                                  ,init-form)))
-                                (add ^(,have-sym (when ,al-val
-                                                   (pop ,al-val)
-                                                   t))))
-                              (t (add ^(,var-sym (if ,al-val
-                                                   (pop ,al-val)
-                                                   ,init-form)))))))
-                        (when pars.rest
-                          (add ^(,pars.rest ,al-val))))
-                      (pars.req
-                        (lambda-too-few-args lm-expr))
-                      (pars.opt
-                        (while pars.opt
-                          (tree-bind (var-sym : init-form have-sym) (pop pars.opt)
-                            (add ^(,var-sym ,init-form))
-                            (if have-sym
-                              (add ^(,have-sym)))))
-                        (when pars.rest
-                          (add ^(,pars.rest))))))
-             ,*lm-body))))))
-
-(defun system-symbol-p (sym)
-  (member (symbol-package sym)
-          (load-time (list user-package system-package))))
-
-(defun usr:compile-toplevel (exp : (expanded-p nil))
-  (let ((co (new compiler))
-        (as (new assembler))
-        (*dedup* (or *dedup* (hash)))
-        (*opt-level* (or *opt-level* 0)))
-    (let* ((*load-time* t)
-           (oreg co.(alloc-treg))
-           (xexp (if expanded-p
-                   exp
-                   (unwind-protect
-                     (expand* exp)
-                     (unless *load-recursive*
-                       (release-deferred-warnings)))))
-           (frag co.(compile oreg (new env co co) xexp)))
-      co.(free-treg oreg)
-      co.(check-treg-leak)
-      as.(asm co.(optimize ^(,*(mappend .code (nreverse co.lt-frags))
-                             ,*frag.code
-                             (jend ,frag.oreg))))
-      (vm-make-desc co.nlev (succ as.max-treg) as.buf co.(get-datavec) co.(get-symvec)))))
-
-(defun get-param-info (sym)
-  (whenlet ((fun (symbol-function sym)))
-    (or [%param-info% fun]
-        (set [%param-info% fun]
-             (new param-info fun fun)))))
-
-(defun param-check (form nargs pars)
-  (cond
-    ((< nargs pars.nreq)
-     (compile-warning form "too few arguments: needs ~s, given ~s"
-                      pars.nreq nargs))
-    (pars.rest)
-    ((> nargs pars.nfix)
-     (compile-warning form "too many arguments: max ~s, given ~s"
-                      pars.nfix nargs))))
-
-(defun compiler-emit-warnings ()
-  (let ((warn-fun [keep-if boundp (zap assumed-fun)]))
-    (when warn-fun
-      (usr:catch
-        (throw 'warning
-               `uses of @{warn-fun ", "} compiled as functions,\
-               \ then defined as vars`)
-        (continue ()))))
-  (each ((uc (zap *unchecked-calls*)))
-    (when-match (@(as form (@sym . @args)) . @nargs) uc
-      (whenlet ((fun (symbol-function sym)))
-        (param-check form nargs (get-param-info sym))))))
-
-(defvarl %file-suff-rx% #/[.][^\\\/.]+/)
-
-(defvar *emit*)
-
-(defvar *eval*)
-
-(defvarl %big-endian% (equal (ffi-put 1 (ffi uint32)) #b'00000001'))
-
-(defvarl %tlo-ver% ^(7 0 ,%big-endian%))
-
-(defvarl %package-manip% '(make-package delete-package
-                           use-package unuse-package
-                           set-package-fallback-list
-                           intern unintern rehome-sym
-                           use-sym unuse-sym))
-
-(defun open-compile-streams (in-path out-path test-fn)
-  (let* ((parent (or *load-path* ""))
-         (sep [path-sep-chars 0])
-         (in-path (if (and (pure-rel-path-p in-path) (not (empty parent)))
-                    `@(dir-name parent)@sep@{in-path}`
-                    in-path))
-         (rsuff (r$ %file-suff-rx% in-path))
-         (suff (if rsuff [in-path rsuff]))
-         (ip-nosuff (if rsuff [in-path 0..(from rsuff)] in-path))
-         in-stream out-stream)
-    (cond
-      ((ends-with ".txr" in-path)
-       (error "~s: cannot compile TXR files" 'compile-file))
-      ((ends-with ".tl" in-path)
-       (set in-stream (ignerr (open-file in-path))
-            out-path (or out-path `@{in-path [0..-3]}.tlo`)))
-      (t
-        (set in-stream (or (ignerr (open-file `@{in-path}.tl`))
-                           (ignerr (open-file in-path)))
-             out-path (or out-path `@{in-path}.tlo`))))
-
-    (unless in-stream
-      (error "~s: unable to open input file ~s" 'compile-file in-path))
-
-    (unless [test-fn in-stream out-path]
-      (close-stream in-stream)
-      (return-from open-compile-streams nil))
-
-    (set out-stream (ignerr (open-file out-path "w")))
-
-    (unless out-stream
-      (close-stream in-stream)
-      (error "~s: unable to open output file ~s" 'compile-file out-path))
-
-    (list in-stream out-stream out-path)))
-
-(defun list-from-vm-desc (vd)
-  (list (sys:vm-desc-nlevels vd)
-        (sys:vm-desc-nregs vd)
-        (sys:vm-desc-bytecode vd)
-        (copy (sys:vm-desc-datavec vd))
-        (sys:vm-desc-symvec vd)))
-
-(defmacro usr:with-compilation-unit (. body)
-  (with-gensyms (rec)
-    ^(let* ((,rec *in-compilation-unit*)
-            (*in-compilation-unit* t)
-            (sys:*load-recursive* t)
-            (*dedup* (or *dedup* (hash))))
-       (unwind-protect
-         (progn ,*body)
-         (unless ,rec
-           (release-deferred-warnings)
-           (compiler-emit-warnings))))))
-
-(defun dump-to-tlo (out-stream out)
-  (let* ((*print-circle* t)
-         (*package* (sys:make-anon-package))
-         (out-forms (split* out.(get) (op where (op eq :fence)))))
-    (prinl %tlo-ver% out-stream)
-    [mapdo (op prinl @1 out-stream) out-forms]
-    (delete-package *package*)))
-
-(defun propagate-perms (in-stream out-stream)
-  (let ((sti (stat in-stream)))
-    (when (plusp (logand sti.mode s-ixusr))
-      (let ((mode "+x")
-            (suid (if (plusp (logand sti.mode s-isuid)) ",u+s"))
-            (sgid (if (and (plusp (logand sti.mode s-isgid))
-                           (plusp (logand sti.mode s-ixgrp))) ",g+s")))
-        (when (or suid sgid)
-          (let ((sto (stat out-stream)))
-            (set mode (append mode
-                              (if (eql sti.uid sto.uid) suid)
-                              (if (eql sti.gid sto.gid) sgid)))))
-        (chmod out-stream mode)))))
-
-(defun compile-file-conditionally (in-path out-path test-fn)
-  (whenlet ((success nil)
-            (perms nil)
-            (streams (open-compile-streams in-path out-path test-fn)))
-    (with-resources ((in-stream (car streams) (close-stream in-stream))
-                     (out-stream (cadr streams) (progn
-                                                  (when perms
-                                                    (propagate-perms in-stream
-                                                                     out-stream))
-                                                  (close-stream out-stream)
-                                                  (unless success
-                                                    (remove-path (caddr streams))))))
-      (let* ((err-ret (gensym))
-             (*package* *package*)
-             (*emit* t)
-             (*eval* t)
-             (*load-path* (stream-get-prop (car streams) :name))
-             (*rec-source-loc* t)
-             (out (new list-builder)))
-        (with-compilation-unit
-          (iflet ((line (get-line in-stream))
-                  ((starts-with "#!" line)))
-            (progn
-              (set line `@line `)
-              (upd line (regsub #/--lisp[^\-]/ (ret `--compiled@[@1 -1]`)))
-              (put-line (butlast line) out-stream)
-              (set perms t))
-            (seek-stream in-stream 0 :from-start))
-          (labels ((compile-form (unex-form)
-                     (let* ((form (macroexpand unex-form))
-                            (sym (if (consp form) (car form))))
-                       (caseq sym
-                         (progn [mapdo compile-form (cdr form)])
-                         (compile-only (let ((*eval* nil))
-                                         [mapdo compile-form (cdr form)]))
-                         (eval-only (let ((*emit* nil))
-                                      [mapdo compile-form (cdr form)]))
-                         (sys:load-time-lit
-                           (if (cadr form)
-                             (compile-form ^(quote ,(caddr form)))
-                             (compile-form (caddr form))))
-                         (t (when (and (or *eval* *emit*)
-                                       (not (constantp form)))
-                              (let* ((vm-desc (compile-toplevel form))
-                                     (flat-vd (list-from-vm-desc vm-desc))
-                                     (fence (member sym %package-manip%)))
-                                (when *eval*
-                                  (let ((pa *package-alist*))
-                                    (sys:vm-execute-toplevel vm-desc)
-                                    (when (neq pa *package-alist*)
-                                      (set fence t))))
-                                (when (and *emit* (consp form))
-                                  out.(add flat-vd)
-                                  (when fence
-                                    out.(add :fence))))))))))
-            (unwind-protect
-              (whilet ((obj (read in-stream *stderr* err-ret))
-                       ((neq obj err-ret)))
-                (compile-form obj))
-              (dump-to-tlo out-stream out))
-
-            (when (parse-errors in-stream)
-              (error "~s: compilation of ~s failed" 'compile-file
-                     (stream-get-prop in-stream :name))))
-          (flush-stream out-stream)
-          (set success t))))))
-
-(defun usr:compile-file (in-path : out-path)
-  [compile-file-conditionally in-path out-path tf])
-
-(defun usr:compile-update-file (in-path : out-path)
-  [compile-file-conditionally in-path out-path [mapf path-newer fstat identity]])
-
-(defun usr:dump-compiled-objects (out-stream . compiled-objs)
-  (symacrolet ((self 'dump-compiled-objects))
-    (let ((out (new list-builder)))
-      (flet ((vm-from-fun (fun)
-               (unless (vm-fun-p fun)
-                 (error "~s: not a vm function: ~s" self fun))
-               (sys:vm-closure-desc (func-get-env fun))))
-        (each ((obj compiled-objs))
-          (let* ((vm-desc (typecase obj
-                            (vm-desc obj)
-                            (fun (vm-from-fun obj))
-                            (t (iflet ((fun (symbol-function obj)))
-                                 (vm-from-fun fun)
-                                 (error "~s: not a compiled object: ~s"
-                                        self obj)))))
-                 (symvec (sys:vm-desc-symvec vm-desc)))
-            out.(add (list-from-vm-desc vm-desc))
-            (when (isec symvec %package-manip%)
-              out.(add :fence)))))
-      (dump-to-tlo out-stream out))))
-
-(defun sys:env-to-let (env form)
-  (when env
-    (let ((vb (env-vbindings env))
-          (fb (env-fbindings env))
-          (up (env-next env)))
-      (when vb
-        (set form ^(let ,(mapcar (tb ((a . d)) ^(,a ',d)) vb) ,form)))
-      (when fb
-        (let (lbind fbind)
-          (each ((pair fb))
-            (tree-bind (a . d) pair
-              (let* ((fun-p (interp-fun-p d))
-                     (fe (if fun-p (func-get-env d)))
-                     (lb-p (and fe (eq fe env)))
-                     (fb-p (and fe (eq fe up))))
-                (cond
-                  (lb-p (push ^(,a ,(func-get-form d)) lbind))
-                  (fb-p (push ^(,a ,(func-get-form d)) fbind))
-                  (t (push ^(,a ',d) fbind))))))
-          (when lbind
-            (set form ^(sys:lbind ,(nreverse lbind) ,form)))
-          (when fbind
-            (set form ^(sys:fbind ,(nreverse fbind) ,form)))))
-      (if up
-        (set form (sys:env-to-let up form)))))
-  form)
-
-(defun usr:compile (obj)
-  (typecase obj
-    (fun (tree-bind (indicator args . body) (func-get-form obj)
-           (let* ((form (sys:env-to-let (func-get-env obj)
-                                        ^(lambda ,args ,*body)))
-                  (vm-desc (compile-toplevel form t)))
-             (vm-execute-toplevel vm-desc))))
-    (t (condlet
-         (((fun (symbol-function obj)))
-          (tree-bind (indicator args . body) (func-get-form fun)
-            (let* ((form (sys:env-to-let (func-get-env fun)
-                                         ^(lambda ,args ,*body)))
-                   (vm-desc (compile-toplevel form t))
-                   (comp-fun (vm-execute-toplevel vm-desc)))
-              (set (symbol-function obj) comp-fun))))
-         (t (error "~s: cannot compile ~s" 'compile obj))))))
diff --git a/share/txr/stdlib/conv.tl b/share/txr/stdlib/conv.tl
deleted file mode 100644
index 5cd799f3..00000000
--- a/share/txr/stdlib/conv.tl
+++ /dev/null
@@ -1,98 +0,0 @@
-;; Copyright 2016-2021
-;; Kaz Kylheku <kaz@kylheku.com>
-;; Vancouver, Canada
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are met:
-;;
-;; 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 BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(defun sys:conv-let (. body)
-  ^(flet ((usr:i (arg : radix)
-            (toint arg radix))
-          (usr:o (arg)
-            (toint arg 8))
-          (usr:x (arg)
-            (toint arg 16))
-          (usr:b (arg)
-            (toint arg 2))
-          (usr:c (arg)
-            (toint arg #\c))
-          (usr:r (arg)
-            (tofloat arg))
-          (usr:iz (arg : radix)
-            (tointz arg radix))
-          (usr:oz (arg)
-            (tointz arg 8))
-          (usr:xz (arg)
-            (tointz arg 16))
-          (usr:bz (arg)
-            (tointz arg 2))
-          (usr:cz (arg)
-            (tointz arg #\c))
-          (usr:rz (arg)
-            (tofloatz arg)))
-     ,*body))
-
-(defun sys:do-conv (lfl mfl tfl nm list)
-  (while (and list lfl)
-    (set (car list) (call (car lfl) (car list)))
-    (set list (cdr list))
-    (set lfl (cdr lfl)))
-  (dotimes (i nm)
-    (unless list
-      (return))
-    (when mfl
-      (set (car list) (call (car mfl) (car list)))
-      (set mfl (cdr mfl)))
-    (set list (cdr list)))
-  (while (and list tfl)
-    (set (car list) (call (car tfl) (car list)))
-    (set list (cdr list))
-    (set tfl (cdr tfl))))
-
-(defun sys:conv-expand (form specs list-sym)
-  (mac-param-bind form (lead : mid trail)
-                       (split* (mapcar [iff (op eq :)
-                                            identity
-                                            [iff (op eq '-)
-                                                 (retf '(fun identity)) 
-                                                 (ret ^[identity ,@1])]]
-                                       specs)
-                               (op where (op eq :)))
-    (let ((nl (length lead))
-          (nt (length trail)))
-      (with-gensyms (i nm lfl mfl tfl)
-        (sys:conv-let
-          ^(let* ((,nm (- (length ,list-sym) ,(+ nl nt)))
-                  (,lfl (list ,*lead))
-                  (,mfl (if (plusp ,nm) (repeat (list ,*mid))))
-                  (,tfl (list ,*trail)))
-             (sys:do-conv ,lfl ,mfl ,tfl ,nm ,list-sym)))))))
-
-(defmacro sys:conv (:form form (. specs) list-expr)
-  (cond
-    ((null specs) list-expr)
-    ((atom specs)
-     (throwf 'eval-error "~s: invalid conversion list: ~s" 'conv specs))
-    (t (with-gensyms (list-sym)
-         ^(let ((,list-sym ,list-expr))
-            ,(sys:conv-expand form specs list-sym)
-            ,list-sym)))))
diff --git a/share/txr/stdlib/copy-file.tl b/share/txr/stdlib/copy-file.tl
deleted file mode 100644
index 28460b72..00000000
--- a/share/txr/stdlib/copy-file.tl
+++ /dev/null
@@ -1,251 +0,0 @@
-;; Copyright 2018-2021
-;; Kaz Kylheku <kaz@kylheku.com>
-;; Vancouver, Canada
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are met:
-;;
-;; 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 BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(eval-only
-  (defsymacro copy-size 65536))
-
-(defstruct copy-path-opts ()
-  perms times owner symlinks (euid (geteuid)))
-
-(defstruct copy-path-stack-node ()
-  path stat new-p)
-
-(defun make-copy-path-opts (opt-list)
-  (if opt-list
-    (let (opts)
-      (each ((opt opt-list))
-        (if (structp opt)
-          (set opts opt)
-          (progn
-            (unless opts
-              (set opts (new copy-path-opts)))
-            (caseql opt
-              (:perms (set opts.perms t))
-              (:times (set opts.times t))
-              (:owner (set opts.owner t))
-              (:symlinks (set opts.symlinks t))
-              (:all (set opts.perms t
-                         opts.times t
-                         opts.owner t
-                         opts.symlinks t))
-              (t (error "~s: unrecognized option ~s" 'copy-path opt))))))
-      opts)
-    (load-time (new copy-path-opts))))
-
-(defun copy-file (from-path to-path : preserve-perms preserve-times)
-  (with-resources ((buf (make-buf copy-size)
-                        (buf-set-length buf 0) (buf-trim buf))
-                   (ist (open-file from-path "b") (close-stream ist))
-                   (ista (fstat ist))
-                   (ost (if (path-dir-p ista)
-                          (throwf 'path-permission `~s: ~a is a directory`
-                                  'copy-file from-path)
-                          (open-file to-path "wb"))
-                        (close-stream ost)))
-    (while (eql (len buf) copy-size)
-      (fill-buf-adjust buf 0 ist)
-      (put-buf buf 0 ost))
-    (when preserve-perms
-      (chmod ost ista.mode))
-    (when preserve-times
-      (flush-stream ost)
-      (utimes ost
-              ista.atime (or ista.atime-nsec 0)
-              ista.mtime (or ista.mtime-nsec 0)))
-    nil))
-
-(defun copy-files (paths dest-dir : preserve-perms preserve-times)
-  (each ((path paths))
-    (while t
-      (catch**
-        (return (copy-file path (path-cat dest-dir (base-name path))
-                           preserve-perms preserve-times))
-        (skip `skip copying @path` (exc . args) (return))
-        (retry `retry copying @path` (exc . args))))))
-
-(defun do-tweak-obj (to-path st opts link-p)
-  (when (and opts.perms (not link-p))
-    (chmod to-path st.mode))
-  (when opts.times
-    (lutimes to-path
-             st.atime (or st.atime-nsec 0)
-             st.mtime (or st.mtime-nsec 0)))
-  (when (and opts.owner
-             (or (zerop opts.euid)
-                 (and (path-mine-p st)
-                      (path-my-group-p st))))
-    (lchown to-path st.uid st.gid)))
-
-(defun do-copy-obj (from-path to-path st opts)
-  (let ((type (logand st.mode s-ifmt))
-        (initial-perms (if opts.perms #o700 #o777))
-        (tweak t))
-    (caseql* type
-      (s-ifreg
-        (copy-file from-path to-path opts.perms opts.times))
-      (s-ifsock
-        (mknod to-path (logior type initial-perms)))
-      (s-ififo
-        (mkfifo to-path initial-perms))
-      (s-iflnk
-        (if opts.symlinks
-          (symlink (readlink from-path) to-path)
-          (progn
-            (do-copy-obj from-path to-path (stat from-path) opts)
-            (set tweak nil))))
-      ((s-ifblk s-ifchr)
-       (mknod to-path (logior type initial-perms) st.rdev))
-      (s-ifdir
-        (ensure-dir to-path)))
-    (when tweak
-      (do-tweak-obj to-path st opts (eq type s-iflnk)))))
-
-(defun copy-path-rec (from-dir to-dir . opt-list)
-  (let* ((opts (make-copy-path-opts opt-list))
-         (dir-stack nil))
-    (unwind-protect
-      (ftw from-dir
-           (lambda (path type stat . rest)
-             (while t
-               (catch**
-                 (let* ((rel-path (let ((p [path (len from-dir)..:]))
-                                    (if (pure-rel-path-p p) p [p 1..:])))
-                        (tgt-path (path-cat to-dir rel-path)))
-                   (unless (starts-with from-dir path)
-                     (error "~s: problem with directory traversal" 'copy-path))
-                   (caseql* type
-                     ((ftw-dnr ftw-ns) (error "~s: unable to access ~s"
-                                              'copy-path path))
-                     (ftw-d (let ((new-p (ensure-dir tgt-path)))
-                              (whilet ((top (car dir-stack))
-                                       ((and top
-                                             (not (starts-with tgt-path
-                                                               top.path)))))
-                                (do-tweak-obj top.path top.stat opts nil)
-                                (pop dir-stack))
-                              (push (new copy-path-stack-node
-                                         path tgt-path
-                                         stat stat
-                                         new-p new-p)
-                                    dir-stack)))
-                     (t (iflet ((cur (car dir-stack)))
-                          (unless cur.new-p
-                            (remove-path tgt-path)))
-                        (do-copy-obj path tgt-path stat opts)))
-                   (return))
-                 (skip `skip copying @path` (exc . args) (return))
-                 (retry `retry copying @path` (exc . args)))))
-           ftw-phys)
-      (whilet ((top (pop dir-stack)))
-        (do-tweak-obj top.path top.stat opts nil)))))
-
-(defun remove-path-rec (path)
-  (ftw path
-       (lambda (path type stat . rest)
-         (while t
-           (catch**
-             (return
-               (caseql* type
-                 ((ftw-dnr ftw-ns) (error "~s: unable to access ~s"
-                                          'remove-rec path))
-                 (ftw-dp (rmdir path))
-                 (t (remove-path path))))
-             (skip `skip removing @path` (exc . args) (return))
-             (retry `retry copying @path` (exc . args)))))
-       (logior ftw-phys ftw-depth)))
-
-(defun chmod-rec (path perm)
-  (ftw path
-       (lambda (path type stat . rest)
-         (while t
-           (catch**
-             (return
-               (caseql* type
-                 ((ftw-dnr ftw-ns) (error "~s: unable to access ~s"
-                                          'remove-rec path))
-                 (ftw-sl)
-                 (t (chmod path perm))))
-             (skip `skip chmod @path` (exc . args) (return))
-             (retry `retry chmod @path` (exc . args)))))
-       (logior ftw-phys)))
-
-(defun chown-rec (path uid gid)
-  (ftw path
-       (lambda (path type stat . rest)
-         (while t
-           (catch**
-             (return
-               (caseql* type
-                 ((ftw-dnr ftw-ns) (error "~s: unable to access ~s"
-                                          'remove-rec path))
-                 (t (lchown path uid gid))))
-             (skip `skip chown @path` (exc . args) (return))
-             (retry `retry chown @path` (exc . args)))))
-       (logior ftw-phys)))
-
-(defun touch (path : ref-path)
-  (with-stream (s (or (ignerr (open-file path "mn")) (open-file path "n")))
-    (if ref-path
-      (let ((rst (stat ref-path)))
-        (utimes s 0 nil rst.mtime rst.mtime-nsec))
-      (utimes s 0 nil 0 t))))
-
-(defun rel-path (from to)
-  (unless (eq (abs-path-p from) (abs-path-p to))
-    (error "~s: mixture of absolute and relative paths ~s ~s given"
-           'rel-path from to))
-
-  (macrolet ((if-windows (then : else)
-               (if (find #\\ path-sep-chars) then else)))
-    (if-windows
-      (when-match `@{fdrv #/[A-Za-z0-9]+:/}@nil` from
-        (when-match `@{tdrv #/[A-Za-z0-9]+:/}@nil` to
-          (unless (equal fdrv tdrv)
-            (error "~s: paths on different drives ~s ~s given"
-                   'rel-path from to)))))
-
-    (flet ((canon (comp)
-             (let (out)
-               (each ((c comp))
-                 (casequal c
-                   (".." (if (and out (nequal (car out) ".."))
-                           (pop out)
-                           (push c out)))
-                   (("." ""))
-                   (t (push c out))))
-               (nreverse out))))
-      (let* ((fcomp (canon (spl path-sep-chars from)))
-             (tcomp (canon (spl path-sep-chars to)))
-             (ncommon (mismatch fcomp tcomp)))
-        (cond
-          ((null ncommon) ".")
-          ((find ".." (nthcdr ncommon fcomp))
-           (error "~s: from path uses ... to escapes common prefix: ~s ~s"
-                  'rel-path from to))
-          (t (let ((nup (- (len fcomp) ncommon))
-                   (down [tcomp ncommon..:]))
-               (cat-str (append (repeat '("..") nup) down)
-                        [path-sep-chars 0]))))))))
diff --git a/share/txr/stdlib/debugger.tl b/share/txr/stdlib/debugger.tl
deleted file mode 100644
index 8102eb24..00000000
--- a/share/txr/stdlib/debugger.tl
+++ /dev/null
@@ -1,102 +0,0 @@
-;; Copyright 2019-2021
-;; Kaz Kylheku <kaz@kylheku.com>
-;; Vancouver, Canada
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are met:
-;;
-;; 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 BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(defmacro with-disabled-debugging (. forms)
-  (let ((state (gensym)))
-    ^(let ((,state (dbg-clear dbg-all)))
-       (unwind-protect
-         (progn ,*forms)
-         (dbg-restore ,state)))))
-
-(defun make-command-env (command-table)
-  (let ((env (make-env )))
-    (mapdo (ado env-vbind env @1 ^(,@2)) command-table)
-    env))
-
-(defparml %dbg-commands% '((usr:? debugger-help "list command summary")
-                           (usr:bt print-backtrace "print backtrace")))
-
-(defparml %dbg-command-env% (make-command-env %dbg-commands%))
-
-(defun debugger-help ()
-  (mapdo (ap pprinl `@{@1 15} @3`) %dbg-commands%))
-
-(defmeth fcall-frame loc (fr))
-
-(defmeth fcall-frame print-trace (fr pr-fr nx-fr prefix)
-  (let* ((fun fr.fun)
-         (args fr.args)
-         (name (if (functionp fun)
-                 (func-get-name fun)))
-         (loc (if nx-fr nx-fr.(loc)))
-         (kind
-           (cond
-             ((interp-fun-p fun) "I")
-             ((vm-fun-p fun) "V")
-             ((functionp fun) "C")
-             (t "O"))))
-    (put-string `@prefix @kind:@(if loc `(@loc):`)`)
-    (prinl ^[,(or name fun) ,*args])))
-
-(defmeth eval-frame loc (fr)
-  (source-loc-str fr.form))
-
-(defmeth eval-frame print-trace (fr pr-fr nx-fr prefix)
-  (when (or (null nx-fr)
-            (and (typep pr-fr 'fcall-frame)
-                 (not (interp-fun-p pr-fr.fun))
-                 (not (vm-fun-p pr-fr.fun))))
-    (let* ((form fr.form)
-           (sym (if (consp form) (car form)))
-           (loc (source-loc-str form)))
-      (when sym
-        (put-string `@prefix E:@(if loc `(@loc):`)`)
-        (prinl (if (eq sym 'dwim)
-                 ^[,(cadr form)]
-                 ^(,sym)))))))
-
-(defmeth expand-frame print-trace (fr pr-fr nx-fr prefix)
-  (let* ((form fr.form)
-         (loc (source-loc-str form)))
-    (put-string `@prefix X:@(if loc `(@loc):`)`)
-    (prinl form)))
-
-(defmeth expand-frame loc (fr)
-  (source-loc-str fr.form))
-
-(defun print-backtrace (: (*stdout* *stdout*) (prefix ""))
-  (with-resources ((imode (set-indent-mode *stdout* indent-foff)
-                          (set-indent-mode *stdout* imode))
-                   (depth (set-max-depth *stdout* 2)
-                          (set-max-depth *stdout* depth))
-                   (length (set-max-length *stdout* 10)
-                           (set-max-length *stdout* length)))
-    (window-mapdo 1 nil (lambda (pr el nx) el.(print-trace pr nx prefix))
-                  (find-frames-by-mask (logior uw-fcall uw-eval uw-expand)))))
-
-(defun debugger ()
-  (with-disabled-debugging
-    (sys:repl nil *stdin* *stdout* %dbg-command-env%)))
diff --git a/share/txr/stdlib/defset.tl b/share/txr/stdlib/defset.tl
deleted file mode 100644
index 15b44411..00000000
--- a/share/txr/stdlib/defset.tl
+++ /dev/null
@@ -1,130 +0,0 @@
-;; Copyright 2019-2021
-;; Kaz Kylheku <kaz@kylheku.com>
-;; Vancouver, Canada
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are met:
-;;
-;; 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 BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-
-(compile-only
-  (load-for (struct sys:param-parser-base "param")))
-
-(defun mac-env-flatten (env)
-  (when env
-    (let ((lexvars [mapcar car
-                           [keep-if (op eq 'sys:special)
-                                    (env-vbindings env) cdr]]))
-      (append (mac-env-flatten (env-next env)) lexvars))))
-
-(defun analyze-params (params)
-  (let* ((env (gensym))
-         (lam ^(lambda ,params
-                (macrolet ((,env (:env e)
-                             (set (symbol-value ',env) e)))
-                  (,env))))
-         (explam (expand lam))
-         (syms (mac-env-flatten (symbol-value env))))
-    (list (cadr explam) syms)))
-
-(defun defset-expander-simple (macform get-fun set-fun)
-  (with-gensyms (getter setter params)
-    ^(defplace (,get-fun . ,params) body
-       (,getter ,setter
-          (let ((pgens (mapcar (ret (gensym)) ,params)))
-            ^(alet ,(zip pgens (list ,*params))
-               (macrolet ((,,getter () ^(,',',get-fun ,*',pgens))
-                          (,,setter (val) ^(,',',set-fun ,*',pgens ,val)))
-                 ,body)))))))
-
-(defun defset-expander (env macform name params newval setform)
-  (with-gensyms (getter setter args gpf-pairs gpr-pairs ext-pairs
-                 pgens rgens egens all-pairs agens nvsym)
-    (let* ((ap (analyze-params params))
-           (exp-params (car ap))
-           (total-syms (cadr ap))
-           (fp (new fun-param-parser form macform syntax exp-params))
-           (fixpars (append fp.req fp.(opt-syms)))
-           (restpar (if (symbol-package fp.rest) fp.rest))
-           (extsyms [keep-if symbol-package
-                             (diff total-syms (cons restpar fixpars))])
-           (xsetform ^^(alet ((,',nvsym ,,newval))
-                         ,,(expand ^(symacrolet ((,newval ',nvsym))
-                                      ,setform)
-                                   env))))
-      ^(defplace (,name . ,args) body
-         (,getter ,setter
-           (tree-bind ,params ,args
-             (let* ((,gpf-pairs (mapcar (op (fun list) (gensym)) (list ,*fixpars)))
-                    (,gpr-pairs (if ',restpar
-                                  (if (consp ,restpar)
-                                    (mapcar (op (fun list) (gensym)) ,restpar)
-                                    (list (list (gensym) ,restpar)))))
-                    (,ext-pairs (mapcar (op (fun list) (gensym)) (list ,*extsyms)))
-                    (,pgens (mapcar (fun car) ,gpf-pairs))
-                    (,rgens (mapcar (fun car) ,gpr-pairs))
-                    (,egens (mapcar (fun car) ,ext-pairs))
-                    (,all-pairs (append ,gpf-pairs ,gpr-pairs ,ext-pairs))
-                    (,agens (collect-each ((a ,args))
-                             (let ((p (pos a ,all-pairs (fun eq) (fun cadr))))
-                               (if p
-                                 (car (del [,all-pairs p]))
-                                 a)))))
-               ^(alet (,*,gpf-pairs ,*,gpr-pairs ,*,ext-pairs)
-                  ,(expand ^(symacrolet (,*(zip ',fixpars
-                                                (mapcar (ret ^',@1) ,pgens))
-                                         ,*(zip ',extsyms
-                                                (mapcar (ret ^',@1) ,egens))
-                                         ,*(if ,gpr-pairs
-                                             (if (consp ,restpar)
-                                               ^((,',restpar ',,rgens))
-                                               ^((,',restpar ',(car ,rgens))))))
-                              (macrolet ((,,getter () ^(,',',name ,',*,agens))
-                                         (,,setter (,',newval)
-                                            ,',xsetform))
-                                ,body))
-                           ,env)))))))))
-
-(defmacro usr:defset (:env e :form mf . args)
-  (tree-case args
-    ((name (. params) newval setform)
-     (defset-expander e mf . args))
-    ((get-fun set-fun)
-     (defset-expander-simple mf get-fun set-fun))
-    (x (compile-error mf "invalid syntax"))))
-
-(defset sub-list (list : (from 0) (to t)) items
-  ^(progn (set ,list (replace-list ,list ,items ,from ,to)) ,items))
-
-(defset sub-vec (vec : (from 0) (to t)) items
-  ^(progn (replace-vec ,vec ,items ,from ,to) ,items))
-
-(defset sub-str (str : (from 0) (to t)) items
-  ^(progn (replace-str ,str ,items ,from ,to) ,items))
-
-(defset left (node) nleft
-  ^(progn (set-left ,node ,nleft) ,nleft))
-
-(defset right (node) nright
-  ^(progn (set-right ,node ,nright) ,nright))
-
-(defset key (node) nkey
-  ^(progn (set-key ,node ,nkey) ,nkey))
diff --git a/share/txr/stdlib/doc-lookup.tl b/share/txr/stdlib/doc-lookup.tl
deleted file mode 100644
index f1d0d380..00000000
--- a/share/txr/stdlib/doc-lookup.tl
+++ /dev/null
@@ -1,49 +0,0 @@
-(load "doc-syms")
-
-(defvarl usr:*doc-url* "https://www.nongnu.org/txr/txr-manpage.html")
-
-(defvar os-symbol
-  (if (ignerr (dlsym (dlopen "libandroid.so") "AAsset_close"))
-    :android
-    (let ((u (uname)))
-      [(orf (iff (f^ #/Linux/) (ret :linux))
-            (iff (f^ #/SunOS/)
-                 (ret (if (<= 5 (int-str u.release))
-                        :solaris10
-                        :solaris)))
-            (iff (f^ #/CYGWIN/) (ret :cygwin))
-            (iff (f^ #/CYGNAL/) (ret :cygnal))
-            (iff (f^ #/Darwin/) (ret :macos))
-            (ret :unknown))
-       u.sysname])))
-
-(caseql os-symbol
-  ((:linux :macos :solaris :solaris10 :android)
-   (defun open-url (url)
-     (if (zerop (run (caseql os-symbol
-                       ((:linux :solaris :android) "xdg-open")
-                       (:solaris10 "/usr/dt/bin/sdtwebclient")
-                       (:macos "open"))
-                     (list url)))
-       t
-       (error `~s:  failed to open ~s` 'open-url url))))
-  ((:cygwin :cygnal)
-   (with-dyn-lib "shell32.dll"
-     (deffi shell-execute "ShellExecuteW"
-            cptr (cptr wstr wstr wstr wstr int))
-     (defun open-url (url)
-       (let ((hinst (shell-execute cptr-null "open" url nil nil 0)))
-         (if (> (int-cptr hinst) 32)
-           t
-           (error `~s: failed to open ~s` 'open-url url))))))
-  (t (defun open-url (url) (error "~s: not implemented" 'open-url))))
-
-(defun usr:doc (: sym)
-  (iflet ((str (typecase sym
-                 (null sym)
-                 (sym (let ((*package* (find-package "pub")))
-                        (tostring sym)))
-                 (t (tostringp sym))))
-          (tag (if str [doc-syms str] "")))
-    (open-url `@{*doc-url*}#@tag`)
-    (error "~s: ~s not found in symbol index" 'doc sym)))
diff --git a/share/txr/stdlib/doc-syms.tl b/share/txr/stdlib/doc-syms.tl
deleted file mode 100644
index 5bf473ee..00000000
--- a/share/txr/stdlib/doc-syms.tl
+++ /dev/null
@@ -1,2084 +0,0 @@
-(defparml doc-syms
-  (hash-from-pairs
-    '(("!>" "N-02B10DF9")
-      ("%e%" "N-03F0FA9E")
-      ("%pi%" "N-03F0FA9E")
-      ("*" "N-022396F7")
-      ("*-1" "N-02B67C9B")
-      ("*-2" "N-02B67C9B")
-      ("*-20" "N-02B67C9B")
-      ("*0" "N-03F9BE17")
-      ("*1" "N-03F9BE17")
-      ("*2" "N-03F9BE17")
-      ("*99" "N-03F9BE17")
-      ("*args*" "N-03DEE18A")
-      ("*args-eff*" "N-03DEE18A")
-      ("*args-full*" "N-03DEE18A")
-      ("*doc-url*" "N-0003D10B")
-      ("*expand" "N-00E0F5F5")
-      ("*filters*" "N-00E6A902")
-      ("*gensym-counter*" "N-0387B1B1")
-      ("*hash-seed*" "N-0041D85A")
-      ("*listener-greedy-eval-p*" "N-002B819C")
-      ("*listener-hist-len*" "N-007B676F")
-      ("*listener-multi-line-p*" "N-02C5CACF")
-      ("*listener-pprint-p*" "N-01E7ACFE")
-      ("*listener-sel-inclusive-p*" "N-02E4924F")
-      ("*load-path*" "N-01D1DB58")
-      ("*match-macro*" "N-012A473F")
-      ("*n" "N-02E7AE5A")
-      ("*opt-level*" "N-03F68BBC")
-      ("*package*" "N-000CBBA0")
-      ("*package-alist*" "N-00E20381")
-      ("*param-macro*" "N-03B67ED8")
-      ("*place-clobber-expander*" "N-01A2C58A")
-      ("*place-delete-expander*" "N-01A2C58A")
-      ("*place-macro*" "N-01B680E6")
-      ("*place-update-expander*" "N-01A2C58A")
-      ("*pprint-flo-format*" "N-02B252AA")
-      ("*print-base*" "N-01DD07CC")
-      ("*print-circle*" "N-01FC9977")
-      ("*print-flo-digits*" "N-00F41F6C")
-      ("*print-flo-format*" "N-02B252AA")
-      ("*print-flo-precision*" "N-02E97D03")
-      ("*r" "N-03A7AE5A")
-      ("*random-state*" "N-033875AD")
-      ("*random-warmup*" "N-010348CD")
-      ("*read-unknown-structs*" "N-0174F337")
-      ("*rec-source-loc*" "N-014AFEA9")
-      ("*stddebug*" "N-006566FB")
-      ("*stderr*" "N-006566FB")
-      ("*stdin*" "N-006566FB")
-      ("*stdlog*" "N-02841215")
-      ("*stdnull*" "N-006566FB")
-      ("*stdout*" "N-006566FB")
-      ("*trace-output*" "N-0067A6AC")
-      ("*tree-fun-whitelist*" "N-025AB9C9")
-      ("*unhandled-hook*" "N-02B4A4FB")
-      ("*v" "N-0367AE5A")
-      ("+" "D-0045")
-      ("-" "D-004B")
-      ("--" "N-0234C408")
-      ("--args" "N-03FCDE42")
-      ("--eargs" "N-03FCDE42")
-      ("--rng" "N-00BEA6DF")
-      ("--rng+" "N-00BEA6DF")
-      ("--rng-" "N-00BEA6DF")
-      ("->" "N-02B10DF9")
-      ("->>" "N-02B10DF9")
-      ("-C" "N-036F1A29")
-      ("-rng" "N-00BEA6DF")
-      ("-rng+" "N-00BEA6DF")
-      ("-rng-" "N-00BEA6DF")
-      (".." "N-0217A971")
-      ("..." "D-0035")
-      ("/" "D-004A")
-      ("//" "N-0054C409")
-      ("/=" "N-003BE40C")
-      (":key" "N-01697547")
-      (":match" "N-03B92C0D")
-      ("<" "D-0058")
-      ("<!" "N-02B10DF9")
-      ("<-" "N-02B10DF9")
-      ("<=" "D-001E")
-      ("=" "D-0078")
-      (">" "D-0061")
-      (">=" "D-0054")
-      ("TXR_COMPAT" "N-03F5D03D")
-      ("abort" "N-02F934F6")
-      ("abs" "D-0017")
-      ("abs-path-p" "N-00477B23")
-      ("accept" "D-0044")
-      ("acons" "N-02E9343D")
-      ("acons-new" "N-0371BAFA")
-      ("aconsql-new" "N-01E315BD")
-      ("acos" "D-0028")
-      ("acosh" "D-0042")
-      ("add" "N-03244398")
-      ("add*" "N-03244398")
-      ("addrinfo" "N-0110E961")
-      ("ado" "N-00BE749A")
-      ("af-inet" "N-0228EAE0")
-      ("af-inet6" "N-0228EAE0")
-      ("af-unix" "N-0228EAE0")
-      ("again" "N-000CD1AE")
-      ("ai-addrconfig" "N-020DFFDE")
-      ("ai-all" "N-020DFFDE")
-      ("ai-numerichost" "N-020DFFDE")
-      ("ai-numericserv" "N-020DFFDE")
-      ("ai-passive" "N-020DFFDE")
-      ("ai-v4mapped" "N-020DFFDE")
-      ("alet" "N-008215E0")
-      ("align" "N-01C7BC08")
-      ("alignof" "N-000F730E")
-      ("alist-nremove" "N-000CD07F")
-      ("alist-remove" "N-001A53C4")
-      ("all" "D-0055")
-      ("all*" "N-00F6E2A2")
-      ("allocate-struct" "N-03168BF2")
-      ("and" "D-0069")
-      ("andf" "N-01E7D2AD")
-      ("ap" "N-00BE749A")
-      ("apf" "N-012A7E6A")
-      ("append" "N-0014162F")
-      ("append*" "N-01143C2A")
-      ("append-each" "N-0105F01D")
-      ("append-each*" "N-0105F01D")
-      ("append-each-prod" "N-02CA3C70")
-      ("append-each-prod*" "N-02660E4F")
-      ("append-match-products" "N-026DC56D")
-      ("append-matches" "N-026DC56D")
-      ("apply" "N-026C3723")
-      ("aret" "N-008216A8")
-      ("arg" "N-02133AA5")
-      ("array" "N-0117BE95")
-      ("arraysize" "N-002129D6")
-      ("as" "N-028B26DD")
-      ("ash" "D-0064")
-      ("asin" "D-003D")
-      ("asinh" "D-0004")
-      ("assert" "D-0060")
-      ("assoc" "N-00E9306D")
-      ("assq" "N-00123702")
-      ("assql" "N-00123702")
-      ("at-exit-call" "N-003EEEF5")
-      ("at-exit-do-not-call" "N-003EEEF5")
-      ("atan" "D-0051")
-      ("atan2" "D-000A")
-      ("atanh" "D-0024")
-      ("atom" "N-0076C7BE")
-      ("awk" "D-0059")
-      ("base-name" "N-02C01721")
-      ("base64-decode" "N-01B05083")
-      ("base64-decode-buf" "N-01B05083")
-      ("base64-encode" "N-01B05083")
-      ("base64-stream-dec" "N-03BEDB34")
-      ("base64-stream-enc" "N-03BEDB34")
-      ("base64url-decode" "N-02D46C3D")
-      ("base64url-decode-buf" "N-02D46C3D")
-      ("base64url-encode" "N-02D46C3D")
-      ("base64url-stream-dec" "N-016A14B3")
-      ("base64url-stream-enc" "N-016A14B3")
-      ("bchar" "N-0008D7DC")
-      ("bignum-len" "N-020294AB")
-      ("bignump" "N-03E9D6E1")
-      ("bind" "D-006E")
-      ("bindable" "N-0222F2E3")
-      ("bit" "D-004D")
-      ("bitset" "D-0038")
-      ("blkcnt-t" "N-01D716FE")
-      ("blksize-t" "N-01D716FE")
-      ("block" "D-0070")
-      ("block*" "N-02F60DCE")
-      ("bool" "D-002D")
-      ("boundp" "N-01FBF828")
-      ("bracket" "N-02400F97")
-      ("break-str" "N-00A9DB25")
-      ("brkint" "N-02391683")
-      ("bs0" "N-03BD477F")
-      ("bs1" "N-03BD477F")
-      ("bsdly" "N-03BD477F")
-      ("bstr" "N-00C6B7C4")
-      ("bstr-d" "N-00C6B7C4")
-      ("buf" "D-005F")
-      ("buf-alloc-size" "N-013A3727")
-      ("buf-carray" "N-0022F54E")
-      ("buf-d" "D-0014")
-      ("buf-get-" "N-0095470A")
-      ("buf-get-char" "N-03E9074A")
-      ("buf-get-cptr" "N-00E90766")
-      ("buf-get-double" "N-006C6EB9")
-      ("buf-get-float" "N-001D239A")
-      ("buf-get-i16" "N-02E7C970")
-      ("buf-get-i32" "N-0127C970")
-      ("buf-get-i64" "N-03C7C972")
-      ("buf-get-i8" "N-0013E55F")
-      ("buf-get-int" "N-03C7C985")
-      ("buf-get-long" "N-02190DE0")
-      ("buf-get-short" "N-031CE896")
-      ("buf-get-u16" "N-02E7C960")
-      ("buf-get-u32" "N-0127C960")
-      ("buf-get-u64" "N-03C7C962")
-      ("buf-get-u8" "N-0013E556")
-      ("buf-get-uchar" "N-03BCF5D1")
-      ("buf-get-uint" "N-030913C8")
-      ("buf-get-ulong" "N-020CEF9D")
-      ("buf-get-ushort" "N-035691E9")
-      ("buf-int" "N-0291625A")
-      ("buf-list" "N-03E81617")
-      ("buf-put-" "N-035546D9")
-      ("buf-put-buf" "N-009FC934")
-      ("buf-put-char" "N-00690748")
-      ("buf-put-cptr" "N-03690764")
-      ("buf-put-double" "N-006A81D9")
-      ("buf-put-float" "N-001D2408")
-      ("buf-put-i16" "N-019FC970")
-      ("buf-put-i32" "N-035FC973")
-      ("buf-put-i64" "N-007FC973")
-      ("buf-put-i8" "N-002F655F")
-      ("buf-put-int" "N-007FC982")
-      ("buf-put-long" "N-00990DE3")
-      ("buf-put-short" "N-031CE904")
-      ("buf-put-u16" "N-019FC960")
-      ("buf-put-u32" "N-035FC963")
-      ("buf-put-u64" "N-007FC963")
-      ("buf-put-u8" "N-002F6556")
-      ("buf-put-uchar" "N-03BCF627")
-      ("buf-put-uint" "N-018913CB")
-      ("buf-put-ulong" "N-020CF007")
-      ("buf-put-ushort" "N-035696C9")
-      ("buf-set-length" "N-01208847")
-      ("buf-str" "N-012BF6AD")
-      ("buf-trim" "N-0057FBE2")
-      ("buf-uint" "N-0291625A")
-      ("bufp" "N-02C6CEE4")
-      ("build" "N-01346AAA")
-      ("build-list" "N-0315C467")
-      ("buildn" "N-01346AAA")
-      ("butlast" "N-026BB6FA")
-      ("butlastn" "N-01E2C334")
-      ("caar" "N-00209CEE")
-      ("cadr" "N-00209CEE")
-      ("call" "N-0386C775")
-      ("call-clobber-expander" "N-0223827D")
-      ("call-delete-expander" "N-021E7CC3")
-      ("call-finalizers" "N-02AF83A0")
-      ("call-super-fun" "N-0223E999")
-      ("call-super-method" "N-016185D1")
-      ("call-update-expander" "N-03B6BCE9")
-      ("callf" "N-00192C21")
-      ("car" "D-0023")
-      ("carray" "N-0139F9ED")
-      ("carray-blank" "N-00DD8DF1")
-      ("carray-buf" "N-00D75AD6")
-      ("carray-buf-sync" "N-02F23E0F")
-      ("carray-cptr" "N-03E001C5")
-      ("carray-dup" "N-00058922")
-      ("carray-free" "N-0010030E")
-      ("carray-get" "N-028920F5")
-      ("carray-getz" "N-028920F5")
-      ("carray-int" "N-02403ED4")
-      ("carray-list" "N-00E825E0")
-      ("carray-own" "N-00058922")
-      ("carray-pun" "N-0057639E")
-      ("carray-put" "N-02890B44")
-      ("carray-putz" "N-02890B44")
-      ("carray-ref" "N-001F5BCA")
-      ("carray-refset" "N-000127F9")
-      ("carray-replace" "N-01AAF602")
-      ("carray-set-length" "N-00705BC4")
-      ("carray-sub" "N-03DF5BC5")
-      ("carray-type" "N-030FEDE6")
-      ("carray-uint" "N-02403ED4")
-      ("carray-vec" "N-00E825E0")
-      ("carrayp" "N-027E7FFC")
-      ("caseq" "N-017EB9A1")
-      ("caseq*" "N-02FB71A2")
-      ("caseql" "N-017EB9A1")
-      ("caseql*" "N-02FB71A2")
-      ("casequal" "N-017EB9A1")
-      ("casequal*" "N-02FB71A2")
-      ("cases" "N-039458F2")
-      ("cat" "N-03336E1B")
-      ("cat-str" "N-00B6ACE3")
-      ("cat-streams" "N-020BF082")
-      ("cat-vec" "N-01AEB28B")
-      ("catch" "D-0011")
-      ("catch*" "N-0211F3D3")
-      ("catch**" "N-0211F3D3")
-      ("catch-frame" "N-0233BAE3")
-      ("catenated-stream-p" "N-021EE493")
-      ("catenated-stream-push" "N-0050A46A")
-      ("cbaud" "N-01B1B5DF")
-      ("cbaudex" "N-01B1B5DF")
-      ("cdar" "N-00209CEE")
-      ("cdddddr" "N-00209CEE")
-      ("cddr" "N-00209CEE")
-      ("cdr" "D-0077")
-      ("ceil" "D-007C")
-      ("ceil-rem" "N-02DE978F")
-      ("ceil1" "N-02C8FF28")
-      ("chain" "N-00C53CF7")
-      ("chand" "N-00C53CF7")
-      ("char" "N-0008D7DC")
-      ("chdir" "N-03D941C3")
-      ("chmod" "N-00F941E5")
-      ("chmod-rec" "N-02D8298E")
-      ("choose" "N-039458F2")
-      ("chown" "N-003B491C")
-      ("chown-rec" "N-02D8298E")
-      ("chr" "N-02D5D09D")
-      ("chr-digit" "N-01ED5020")
-      ("chr-int" "N-000AEC8B")
-      ("chr-isalnum" "N-01B18DF0")
-      ("chr-isalpha" "N-00F18E1B")
-      ("chr-isascii" "N-0171941F")
-      ("chr-isblank" "N-0251A159")
-      ("chr-iscntrl" "N-02A1A5A8")
-      ("chr-isdigit" "N-01ED5020")
-      ("chr-isgraph" "N-00617BD5")
-      ("chr-islower" "N-02BB58D0")
-      ("chr-isprint" "N-001B5076")
-      ("chr-ispunct" "N-011B4F35")
-      ("chr-isspace" "N-002B4C59")
-      ("chr-isunisp" "N-00DB3D75")
-      ("chr-isupper" "N-02BB451C")
-      ("chr-isxdigit" "N-021C89F4")
-      ("chr-str" "N-0378FEF2")
-      ("chr-str-set" "N-01743140")
-      ("chr-tolower" "N-015A58D0")
-      ("chr-toupper" "N-015A451C")
-      ("chr-xdigit" "N-021C89F4")
-      ("chrp" "N-02C6CEED")
-      ("clamp" "N-03B940D4")
-      ("clear-cflags" "N-02061924")
-      ("clear-dirty" "N-03AB857D")
-      ("clear-error" "D-000C")
-      ("clear-iflags" "N-02061924")
-      ("clear-lflags" "N-02061924")
-      ("clear-oflags" "N-02061924")
-      ("clear-struct" "N-03A968CA")
-      ("clearhash" "N-00836D97")
-      ("clocal" "N-01B1B5DF")
-      ("clock-t" "N-03258244")
-      ("clockid-t" "N-01D716FE")
-      ("close" "D-0016")
-      ("close-stream" "N-00596930")
-      ("closedir" "N-01FEE88A")
-      ("closelog" "N-02CEE7EA")
-      ("closure" "N-0216EF16")
-      ("cmp-str" "N-0143A273")
-      ("cmspar" "N-01B1B5DF")
-      ("coded-length" "N-0167F423")
-      ("coll" "D-005A")
-      ("collect" "D-0030")
-      ("collect-each" "N-0105F01D")
-      ("collect-each*" "N-0105F01D")
-      ("collect-each-prod" "N-02CA3C70")
-      ("collect-each-prod*" "N-02660E4F")
-      ("comb" "N-02E6CEDD")
-      ("command-get" "N-0062A33B")
-      ("command-get-buf" "N-00FA177D")
-      ("command-get-json" "N-028645A2")
-      ("command-get-jsons" "N-028645A2")
-      ("command-get-lines" "N-0062A33B")
-      ("command-get-string" "N-0062A33B")
-      ("command-put" "N-024D65F3")
-      ("command-put-buf" "N-02AE3A31")
-      ("command-put-json" "N-029045AE")
-      ("command-put-jsons" "N-029045AE")
-      ("command-put-lines" "N-024D65F3")
-      ("command-put-string" "N-024D65F3")
-      ("compare-swap" "N-02933F2A")
-      ("compile" "N-009542C1")
-      ("compile-defr-warning" "N-0205E7AF")
-      ("compile-error" "N-032EA7D7")
-      ("compile-file" "N-0211BE68")
-      ("compile-only" "N-030BF4F5")
-      ("compile-toplevel" "N-00DE8B13")
-      ("compile-update-file" "N-0211BE68")
-      ("compile-warning" "N-032EA7D7")
-      ("compl-span-str" "N-0171717F")
-      ("cond" "N-016C9E24")
-      ("conda" "N-025CC33C")
-      ("condlet" "N-03272DC8")
-      ("cons" "N-02D6CEDA")
-      ("conses" "N-00BBCCAA")
-      ("conses*" "N-00BBCCAA")
-      ("consp" "N-01B94132")
-      ("constantp" "N-0172F00A")
-      ("contains" "N-010AB2D7")
-      ("copy" "N-0036CED9")
-      ("copy-alist" "N-037A7464")
-      ("copy-buf" "N-00BE75E1")
-      ("copy-carray" "N-006593D0")
-      ("copy-cons" "N-037EBB77")
-      ("copy-file" "N-019D6582")
-      ("copy-files" "N-019D6582")
-      ("copy-fun" "N-003E7671")
-      ("copy-hash" "N-030E3A4A")
-      ("copy-list" "N-006ED237")
-      ("copy-path-rec" "N-034734A3")
-      ("copy-search-tree" "N-01EBE427")
-      ("copy-str" "N-02FE763D")
-      ("copy-struct" "N-032B3FDC")
-      ("copy-tnode" "N-018A17C0")
-      ("copy-tree" "N-015EB85E")
-      ("copy-tree-iter" "N-025C3140")
-      ("copy-vec" "N-010E7635")
-      ("cos" "D-0021")
-      ("cosh" "D-0080")
-      ("count-if" "N-00BBC726")
-      ("count-until-match" "N-00EFD668")
-      ("countq" "N-01DF131F")
-      ("countql" "N-01DF131F")
-      ("countqual" "N-01DF131F")
-      ("cptr" "D-0013")
-      ("cptr-buf" "N-037139E3")
-      ("cptr-cast" "N-01A212ED")
-      ("cptr-free" "N-02B1FBEF")
-      ("cptr-get" "N-00513A70")
-      ("cptr-int" "N-015139D6")
-      ("cptr-null" "N-01CB17AB")
-      ("cptr-obj" "N-013139D1")
-      ("cptr-put" "N-00513A38")
-      ("cptr-size-hint" "N-024CD90F")
-      ("cptr-type" "N-03B1F90C")
-      ("cptr-zap" "N-00913A85")
-      ("cptrp" "N-02B9289A")
-      ("cr0" "N-03BD477F")
-      ("cr1" "N-03BD477F")
-      ("cr2" "N-03BD477F")
-      ("cr3" "N-03BD477F")
-      ("crc32" "N-01D92859")
-      ("crc32-stream" "N-0119CE1D")
-      ("crdly" "N-03BD477F")
-      ("cread" "N-01B1B5DF")
-      ("crtscts" "N-01B1B5DF")
-      ("crypt" "N-00F928CE")
-      ("cs5" "N-01B1B5DF")
-      ("cs6" "N-01B1B5DF")
-      ("cs7" "N-01B1B5DF")
-      ("cs8" "N-01B1B5DF")
-      ("csize" "N-01B1B5DF")
-      ("cstopb" "N-01B1B5DF")
-      ("cum-norm-dist" "N-03AB449B")
-      ("cxr" "N-01DA4F04")
-      ("cyr" "N-01DA4F04")
-      ("daemon" "N-017C3515")
-      ("data" "N-03B6EA7D")
-      ("dec" "N-03A0AABD")
-      ("defer-warning" "N-001106AB")
-      ("defex" "D-005E")
-      ("deffi" "N-00DCE51D")
-      ("deffi-cb" "N-00C54FC8")
-      ("deffi-cb-unsafe" "N-00C54FC8")
-      ("deffi-struct" "N-0040FFE6")
-      ("deffi-sym" "N-02B237BB")
-      ("deffi-union" "N-0040FFE6")
-      ("deffi-var" "N-03C237C9")
-      ("deffilter" "N-00BDE41F")
-      ("define-accessor" "N-03C5F850")
-      ("define-modify-macro" "N-006E03C4")
-      ("define-option-struct" "N-0126C738")
-      ("define-param-expander" "N-019F25A5")
-      ("define-place-macro" "N-02C3089A")
-      ("defmacro" "N-02CAEF0B")
-      ("defmatch" "N-0049315A")
-      ("defmeth" "N-0047C7E8")
-      ("defpackage" "N-033951A2")
-      ("defparm" "N-039DD0E7")
-      ("defparml" "N-03F36A75")
-      ("defplace" "N-00F92066")
-      ("defset" "N-0157E559")
-      ("defstruct" "N-021CC672")
-      ("defsymacro" "N-0080256D")
-      ("defun" "N-00B44934")
-      ("defun-match" "N-02BF0F8C")
-      ("defvar" "N-039DD0E7")
-      ("defvarl" "N-03F36A75")
-      ("del" "D-0022")
-      ("del*" "N-0166445C")
-      ("delay" "N-00DCE524")
-      ("delete-package" "N-02E687F3")
-      ("derived" "N-0151798B")
-      ("dev-t" "N-01D716FE")
-      ("diff" "N-0385B074")
-      ("digits" "N-03CC559E")
-      ("digpow" "N-030C5561")
-      ("dir-name" "N-02C01721")
-      ("dirent" "N-036FE5B4")
-      ("dirstat" "N-02507FF2")
-      ("disassemble" "N-0289A0F1")
-      ("display-width" "N-0263C039")
-      ("divides" "N-02A088B3")
-      ("dlclose" "N-033F7DE5")
-      ("dlopen" "N-037C4BFE")
-      ("dlsym" "N-01B1E865")
-      ("dlsym-checked" "N-029063A0")
-      ("dlvsym" "N-01B1E865")
-      ("dlvsym-checked" "N-029063A0")
-      ("do" "D-0072")
-      ("doc" "N-0097F54C")
-      ("dohash" "N-039105E8")
-      ("doloop" "N-01FF4DDB")
-      ("doloop*" "N-01FF4DDB")
-      ("dotimes" "N-02D31F8C")
-      ("double" "N-03237030")
-      ("downcase-str" "N-03DA541E")
-      ("drop" "N-01C6C906")
-      ("drop-until" "N-011E5936")
-      ("drop-while" "N-011E5936")
-      ("dt-blk" "N-02D8CAF4")
-      ("dt-chr" "N-02D8CAF4")
-      ("dt-dir" "N-02D8CAF4")
-      ("dt-fifo" "N-02D8CAF4")
-      ("dt-lnk" "N-02D8CAF4")
-      ("dt-reg" "N-02D8CAF4")
-      ("dt-sock" "N-02D8CAF4")
-      ("dt-unknown" "N-02D8CAF4")
-      ("dump-compiled-objects" "N-02FE7607")
-      ("dump-deferred-warnings" "N-0335651E")
-      ("dup" "N-0387F549")
-      ("dupfd" "N-01F91AEF")
-      ("dwim" "D-001F")
-      ("e2big" "N-036B1BDB")
-      ("eacces" "N-036B1BDB")
-      ("each" "N-0105F01D")
-      ("each*" "N-0105F01D")
-      ("each-match" "N-01CB9595")
-      ("each-match-product" "N-01CB9595")
-      ("each-prod" "N-02CA3C70")
-      ("each-prod*" "N-02660E4F")
-      ("eaddrinuse" "N-036B1BDB")
-      ("eaddrnotavail" "N-036B1BDB")
-      ("eafnosupport" "N-036B1BDB")
-      ("eagain" "N-036B1BDB")
-      ("ealready" "N-036B1BDB")
-      ("ebadf" "N-036B1BDB")
-      ("ebadmsg" "N-036B1BDB")
-      ("ebusy" "N-036B1BDB")
-      ("ecanceled" "N-036B1BDB")
-      ("echild" "N-036B1BDB")
-      ("echo" "N-0072FF5E")
-      ("echoctl" "N-0072FF5E")
-      ("echoe" "N-0072FF5E")
-      ("echok" "N-0072FF5E")
-      ("echoke" "N-0072FF5E")
-      ("echonl" "N-0072FF5E")
-      ("echoprt" "N-0072FF5E")
-      ("econnaborted" "N-036B1BDB")
-      ("econnrefused" "N-036B1BDB")
-      ("econnreset" "N-036B1BDB")
-      ("edeadlk" "N-036B1BDB")
-      ("edestaddrreq" "N-036B1BDB")
-      ("edom" "N-036B1BDB")
-      ("edquot" "N-036B1BDB")
-      ("eexist" "N-036B1BDB")
-      ("efault" "N-036B1BDB")
-      ("efbig" "N-036B1BDB")
-      ("ehostunreach" "N-036B1BDB")
-      ("eidrm" "N-036B1BDB")
-      ("eighth" "N-01B0FA33")
-      ("eilseq" "N-036B1BDB")
-      ("einprogress" "N-036B1BDB")
-      ("eintr" "N-036B1BDB")
-      ("einval" "N-036B1BDB")
-      ("eio" "N-036B1BDB")
-      ("eisconn" "N-036B1BDB")
-      ("eisdir" "N-036B1BDB")
-      ("elemsize" "N-01D55CC4")
-      ("elemtype" "D-0006")
-      ("eloop" "N-036B1BDB")
-      ("emfile" "N-036B1BDB")
-      ("emlink" "N-036B1BDB")
-      ("empty" "N-004918EB")
-      ("emsgsize" "N-036B1BDB")
-      ("emultihop" "N-036B1BDB")
-      ("enametoolong" "N-036B1BDB")
-      ("end" "N-037C6608")
-      ("endgrent" "N-02CAC7FB")
-      ("endp" "N-00C6C858")
-      ("endpwent" "N-0377C43A")
-      ("ends-with" "N-004955D4")
-      ("enetdown" "N-036B1BDB")
-      ("enetreset" "N-036B1BDB")
-      ("enetunreach" "N-036B1BDB")
-      ("enfile" "N-036B1BDB")
-      ("enobufs" "N-036B1BDB")
-      ("enodata" "N-036B1BDB")
-      ("enodev" "N-036B1BDB")
-      ("enoent" "N-036B1BDB")
-      ("enoexec" "N-036B1BDB")
-      ("enolck" "N-036B1BDB")
-      ("enolink" "N-036B1BDB")
-      ("enomem" "N-036B1BDB")
-      ("enomsg" "N-036B1BDB")
-      ("enoprotoopt" "N-036B1BDB")
-      ("enospc" "N-036B1BDB")
-      ("enosr" "N-036B1BDB")
-      ("enostr" "N-036B1BDB")
-      ("enosys" "N-036B1BDB")
-      ("enotconn" "N-036B1BDB")
-      ("enotdir" "N-036B1BDB")
-      ("enotempty" "N-036B1BDB")
-      ("enotrecoverable" "N-036B1BDB")
-      ("enotsock" "N-036B1BDB")
-      ("enotsup" "N-036B1BDB")
-      ("enotty" "N-036B1BDB")
-      ("ensure-dir" "N-00C543B8")
-      ("enum" "N-01CDE57C")
-      ("enumed" "N-01096D60")
-      ("env" "N-0267F548")
-      ("env-fbind" "N-03389BE3")
-      ("env-fbindings" "N-0018DCDC")
-      ("env-hash" "N-011814B5")
-      ("env-next" "N-0018DCDC")
-      ("env-vbind" "N-03389BE3")
-      ("env-vbindings" "N-0018DCDC")
-      ("enxio" "N-036B1BDB")
-      ("eopnotsupp" "N-036B1BDB")
-      ("eoverflow" "N-036B1BDB")
-      ("eownerdead" "N-036B1BDB")
-      ("eperm" "N-036B1BDB")
-      ("epipe" "N-036B1BDB")
-      ("eproto" "N-036B1BDB")
-      ("eprotonosupport" "N-036B1BDB")
-      ("eprototype" "N-036B1BDB")
-      ("eq" "N-02550B35")
-      ("eql" "N-02550B35")
-      ("equal" "D-007A")
-      ("equot" "N-02ACCDDF")
-      ("erange" "N-036B1BDB")
-      ("erofs" "N-036B1BDB")
-      ("errno" "N-03A7137C")
-      ("error" "N-015466AD")
-      ("espipe" "N-036B1BDB")
-      ("esrch" "N-036B1BDB")
-      ("estale" "N-036B1BDB")
-      ("etime" "N-036B1BDB")
-      ("etimedout" "N-036B1BDB")
-      ("etxtbsy" "N-036B1BDB")
-      ("eval" "N-0286C8B8")
-      ("eval-only" "N-030BF4F5")
-      ("evenp" "D-001C")
-      ("ewouldblock" "N-036B1BDB")
-      ("exception-subtype-map" "N-03ABFA6D")
-      ("exception-subtype-p" "N-02E7F869")
-      ("exdev" "N-036B1BDB")
-      ("exec" "N-02D6C913")
-      ("exit" "N-0006C92F")
-      ("exit*" "N-03592671")
-      ("exp" "D-0036")
-      ("expand" "N-00E0F5F5")
-      ("expand-left" "N-00E168FE")
-      ("expand-right" "N-023B6B64")
-      ("expand-with-free-refs" "N-0334827B")
-      ("expt" "D-0076")
-      ("exptmod" "D-0037")
-      ("extproc" "N-0072FF5E")
-      ("f" "N-003BDFA9")
-      ("f$" "N-000B5ACD")
-      ("f-dupfd" "N-025E55E7")
-      ("f-dupfd-cloexec" "N-025E55E7")
-      ("f-getfd" "N-025E55E7")
-      ("f-getfl" "N-025E55E7")
-      ("f-getlk" "N-025E55E7")
-      ("f-rdlck" "N-0137046C")
-      ("f-setfd" "N-025E55E7")
-      ("f-setfl" "N-025E55E7")
-      ("f-setlk" "N-025E55E7")
-      ("f-setlkw" "N-025E55E7")
-      ("f-unlck" "N-0137046C")
-      ("f-wrlck" "N-0137046C")
-      ("f^" "N-000B5ACD")
-      ("f^$" "N-000B5ACD")
-      ("false" "N-03C679D2")
-      ("fboundp" "N-01FBF828")
-      ("fcntl" "N-03793032")
-      ("fconv" "N-018CCE37")
-      ("fd-cloexec" "N-021805C2")
-      ("ff" "N-006B6E54")
-      ("ff0" "N-03BD477F")
-      ("ff1" "N-03BD477F")
-      ("ffdly" "N-03BD477F")
-      ("ffi" "N-020F3A1C")
-      ("ffi-alignof" "N-00061B61")
-      ("ffi-arraysize" "N-03DC1AED")
-      ("ffi-call" "N-023DCFF9")
-      ("ffi-elemsize" "N-00DF8E15")
-      ("ffi-elemtype" "N-02DF8E12")
-      ("ffi-get" "N-023305C7")
-      ("ffi-in" "N-037AAB17")
-      ("ffi-make-call-desc" "N-01A96E1C")
-      ("ffi-make-closure" "N-0095DF58")
-      ("ffi-offsetof" "N-0318DA0C")
-      ("ffi-out" "N-02330623")
-      ("ffi-put" "N-0000F6A9")
-      ("ffi-put-into" "N-0000F6A9")
-      ("ffi-size" "N-00CDBB53")
-      ("ffi-type-compile" "N-02940F9A")
-      ("ffi-type-operator-p" "N-00E31038")
-      ("ffi-type-p" "N-01EE962E")
-      ("ffi-typedef" "N-0094D6D7")
-      ("fifth" "N-01B0FA33")
-      ("file-append" "N-000CCA8A")
-      ("file-append-buf" "N-02AE3A31")
-      ("file-append-lines" "N-000CCA8A")
-      ("file-append-string" "N-000CCA8A")
-      ("file-get" "N-02238370")
-      ("file-get-buf" "N-00FA177D")
-      ("file-get-json" "N-03C963BD")
-      ("file-get-jsons" "N-03C963BD")
-      ("file-get-lines" "N-02238370")
-      ("file-get-string" "N-02238370")
-      ("file-put" "N-0041C2E5")
-      ("file-put-buf" "N-02AE3A31")
-      ("file-put-json" "D-002A")
-      ("file-put-jsons" "D-007D")
-      ("file-put-lines" "N-0041C2E5")
-      ("file-put-string" "N-0041C2E5")
-      ("fileno" "N-008ACF75")
-      ("fill-buf" "D-0026")
-      ("fill-buf-adjust" "N-00D142E1")
-      ("fill-carray" "N-00737951")
-      ("fill-obj" "N-0039A1D1")
-      ("fill-vec" "N-03C9A237")
-      ("filter" "N-00B50006")
-      ("filter-equal" "N-03136087")
-      ("filter-string-tree" "N-00C9EEB0")
-      ("finalize" "N-01230613")
-      ("finally" "D-0079")
-      ("find" "N-005431FF")
-      ("find-frame" "N-02B97226")
-      ("find-frames" "N-02B97226")
-      ("find-if" "N-005431FF")
-      ("find-max" "N-02BB4231")
-      ("find-min" "N-02BB4231")
-      ("find-package" "N-0250826D")
-      ("find-struct-type" "N-01E5EEA7")
-      ("find-symbol" "N-01EA8B50")
-      ("find-symbol-fb" "N-01EA8B50")
-      ("first" "N-02D60463")
-      ("fixnum-max" "N-02A6CE24")
-      ("fixnum-min" "N-02A6CE24")
-      ("fixnump" "N-03E9D6E1")
-      ("flatcar" "N-01FF2F12")
-      ("flatcar*" "N-01FF2F12")
-      ("flatten" "D-000D")
-      ("flatten*" "N-0226672B")
-      ("flet" "N-0209307D")
-      ("flip" "N-0042153F")
-      ("flipargs" "N-02D06BA4")
-      ("flo-dig" "N-00998CE7")
-      ("flo-down" "N-013A1643")
-      ("flo-epsilon" "N-0085F231")
-      ("flo-get-round-mode" "N-0085ACA3")
-      ("flo-int" "N-03F852CF")
-      ("flo-max" "N-0085F231")
-      ("flo-max-dig" "N-01A2123A")
-      ("flo-min" "N-0085F231")
-      ("flo-near" "N-013A1643")
-      ("flo-set-round-mode" "N-0085ACA3")
-      ("flo-str" "N-028043AE")
-      ("flo-up" "N-013A1643")
-      ("flo-zero" "N-013A1643")
-      ("float" "N-03237030")
-      ("floatp" "N-03E9D6E1")
-      ("flock" "N-004E5B3E")
-      ("floor" "D-0029")
-      ("floor-rem" "N-02DE978F")
-      ("floor1" "N-01ED20D1")
-      ("flow" "N-02B2153E")
-      ("flush" "N-02390935")
-      ("flush-stream" "N-03999913")
-      ("flusho" "N-0072FF5E")
-      ("fmakunbound" "N-02964FC0")
-      ("fmt" "N-0347F537")
-      ("fname" "N-039E5F67")
-      ("fnm-casefold" "N-0330E15A")
-      ("fnm-extmatch" "N-0330E15A")
-      ("fnm-leading-dir" "N-0330E15A")
-      ("fnm-noescape" "N-0330E15A")
-      ("fnm-pathname" "N-0330E15A")
-      ("fnm-period" "N-0330E15A")
-      ("fnmatch" "N-03F8FF75")
-      ("fnr" "N-02E33A82")
-      ("for" "N-031372ED")
-      ("for*" "N-031372ED")
-      ("force" "N-0307223D")
-      ("force-break" "N-03B5FB1D")
-      ("forget" "N-02A1EE04")
-      ("fork" "N-0365C3E1")
-      ("format" "N-011ACA52")
-      ("fourth" "N-01B0FA33")
-      ("fr$" "N-031971BD")
-      ("fr^" "N-031971BD")
-      ("fr^$" "N-031971BD")
-      ("frame" "N-0233BAE3")
-      ("freeform" "N-00334C65")
-      ("from" "N-00AED1A7")
-      ("from-list" "N-01FFD230")
-      ("frr" "N-031971BD")
-      ("fs" "N-03B6902C")
-      ("fsblkcnt-t" "N-01D716FE")
-      ("fsfilcnt-t" "N-01D716FE")
-      ("fstat" "N-006DE1CC")
-      ("ft" "N-03B6902C")
-      ("ftw" "N-0057F54E")
-      ("ftw-actionretval" "N-01A802F2")
-      ("ftw-chdir" "N-01A802F2")
-      ("ftw-continue" "N-03853999")
-      ("ftw-d" "N-02ED8B51")
-      ("ftw-depth" "N-01A802F2")
-      ("ftw-dnr" "N-02ED8B51")
-      ("ftw-dp" "N-02ED8B51")
-      ("ftw-f" "N-02ED8B51")
-      ("ftw-mount" "N-01A802F2")
-      ("ftw-ns" "N-02ED8B51")
-      ("ftw-phys" "N-01A802F2")
-      ("ftw-skip-siblings" "N-03853999")
-      ("ftw-skip-subtree" "N-03853999")
-      ("ftw-sl" "N-02ED8B51")
-      ("ftw-sln" "N-02ED8B51")
-      ("ftw-stop" "N-03853999")
-      ("fun" "N-006E109C")
-      ("fun-fixparam-count" "N-015852B6")
-      ("fun-optparam-count" "N-015852B6")
-      ("fun-variadic" "N-02AA3799")
-      ("func-get-env" "N-009538DB")
-      ("func-get-form" "N-00722170")
-      ("func-get-name" "N-03F222DA")
-      ("functionp" "N-00F6F5F8")
-      ("fuzz" "N-03CAE17D")
-      ("fw" "N-0357AE6F")
-      ("gather" "D-002B")
-      ("gcd" "N-03D44645")
-      ("gen" "N-0323BEBD")
-      ("gen-hash-seed" "N-002CFA72")
-      ("generate" "N-02F671F4")
-      ("gensym" "N-03AA7FBB")
-      ("gequal" "N-00A3E42D")
-      ("get" "N-03D9F55D")
-      ("get-buf-from-stream" "N-02954B48")
-      ("get-byte" "D-0063")
-      ("get-char" "D-0066")
-      ("get-error" "D-0033")
-      ("get-error-str" "D-0010")
-      ("get-fd" "N-011D42AB")
-      ("get-frames" "N-010405DA")
-      ("get-hash-userdata" "N-030B41A7")
-      ("get-indent" "N-024E9FD8")
-      ("get-indent-mode" "N-03F3170C")
-      ("get-json" "N-014295FE")
-      ("get-jsons" "N-0124D378")
-      ("get-line" "D-0018")
-      ("get-line-as-buf" "N-007FD2F9")
-      ("get-lines" "N-00B65D06")
-      ("get-list-from-stream" "N-021DF087")
-      ("get-obj" "N-0315B229")
-      ("get-prop" "N-00663AE2")
-      ("get-sig-handler" "N-02E1B6FA")
-      ("get-stack-limit" "N-02492D13")
-      ("get-string" "N-00BE9AAC")
-      ("get-string-from-stream" "N-037412EE")
-      ("getaddrinfo" "N-0363FE99")
-      ("getegid" "N-00125C22")
-      ("getenv" "N-002E0364")
-      ("geteuid" "N-00125C22")
-      ("getgid" "N-00125C22")
-      ("getgrent" "N-02CAC7FB")
-      ("getgrgid" "N-03E5634E")
-      ("getgrnam" "N-03556394")
-      ("getgroups" "N-030FEE9B")
-      ("gethash" "N-0203B5FA")
-      ("getitimer" "N-02DE107D")
-      ("getopts" "N-01A5A2FF")
-      ("getpid" "N-02D7B5A3")
-      ("getppid" "N-02D7B5A3")
-      ("getpwent" "N-0377C43A")
-      ("getpwnam" "N-03552854")
-      ("getpwuid" "N-03E528C6")
-      ("getresgid" "N-03D37234")
-      ("getresuid" "N-03D37234")
-      ("getuid" "N-00125C22")
-      ("gid-t" "N-01D716FE")
-      ("ginterate" "N-02F671F4")
-      ("giterate" "N-02F671F4")
-      ("glob" "N-00E6C7DE")
-      ("glob-altdirfunc" "N-0188409B")
-      ("glob-brace" "N-0188409B")
-      ("glob-err" "N-0188409B")
-      ("glob-mark" "N-0188409B")
-      ("glob-nocheck" "N-0188409B")
-      ("glob-noescape" "N-0188409B")
-      ("glob-nomagic" "N-0188409B")
-      ("glob-nosort" "N-0188409B")
-      ("glob-onlydir" "N-0188409B")
-      ("glob-period" "N-0188409B")
-      ("glob-tilde" "N-0188409B")
-      ("glob-tilde-check" "N-0188409B")
-      ("go" "N-007E0D96")
-      ("go-cbreak" "N-03DCB007")
-      ("go-raw" "N-03DCB007")
-      ("grade" "N-00091853")
-      ("greater" "N-02AC1F73")
-      ("group" "N-03DE71BA")
-      ("group-by" "N-02F6F229")
-      ("group-reduce" "N-001A208F")
-      ("gun" "N-0323BEBD")
-      ("handle" "N-03F7D8B5")
-      ("handle*" "N-03F7D8B5")
-      ("handle-frame" "N-0233BAE3")
-      ("handler-bind" "N-00A4ECC9")
-      ("hash" "D-0001")
-      ("hash-begin" "N-0225209D")
-      ("hash-construct" "N-017E6F4C")
-      ("hash-count" "N-00766C80")
-      ("hash-diff" "N-02235BB2")
-      ("hash-eql" "N-0000455E")
-      ("hash-equal" "N-0000455E")
-      ("hash-from-alist" "N-017E6F4C")
-      ("hash-from-pairs" "N-017E6F4C")
-      ("hash-invert" "N-01D4F138")
-      ("hash-isec" "N-02235BB2")
-      ("hash-keys-of" "N-02FBE776")
-      ("hash-list" "N-02EE9235")
-      ("hash-next" "N-0225209D")
-      ("hash-peek" "N-0225209D")
-      ("hash-proper-subset" "N-024ACBBB")
-      ("hash-reset" "N-0225209D")
-      ("hash-revget" "N-02FBE776")
-      ("hash-subset" "N-024ACBBB")
-      ("hash-symdiff" "N-02235BB2")
-      ("hash-uni" "N-02235BB2")
-      ("hash-update" "N-02DBCCC8")
-      ("hash-update-1" "N-03EF9A2C")
-      ("hash-userdata" "N-038C1CEB")
-      ("hash-zip" "N-02767282")
-      ("hash_alist" "N-01BD56A5")
-      ("hash_keys" "N-01BD56A5")
-      ("hash_pairs" "N-01BD56A5")
-      ("hash_values" "N-01BD56A5")
-      ("hashp" "N-00B947EC")
-      ("have" "N-00373D97")
-      ("hlet" "N-01348099")
-      ("hlet*" "N-01348099")
-      ("html-decode" "N-01263EAE")
-      ("html-encode" "N-01263EAE")
-      ("html-encode*" "N-01263EAE")
-      ("hupcl" "N-01B1B5DF")
-      ("iapply" "N-026C3723")
-      ("icanon" "N-0072FF5E")
-      ("icrnl" "N-02391683")
-      ("id-t" "N-01D716FE")
-      ("identity" "N-004834CC")
-      ("identity*" "N-004834CC")
-      ("ido." "N-00BE749A")
-      ("iexten" "N-0072FF5E")
-      ("if" "D-001D")
-      ("if-match" "N-00CFBF5E")
-      ("ifa" "N-018F39B0")
-      ("iff" "N-000E3A74")
-      ("iffi" "N-000E3A74")
-      ("iflet" "N-02DA21F6")
-      ("ignbrk" "N-02391683")
-      ("igncr" "N-02391683")
-      ("ignerr" "N-007287AC")
-      ("ignpar" "N-02391683")
-      ("ignwarn" "N-02552A58")
-      ("imaxbel" "N-02391683")
-      ("improper-plist-to-alist" "N-006E31B5")
-      ("in" "N-016BE41C")
-      ("in-package" "D-0073")
-      ("in-range" "N-02C56FB6")
-      ("in-range*" "N-02C56FB6")
-      ("in6addr-any" "N-026A2C3B")
-      ("in6addr-loopback" "N-026A2C3B")
-      ("in6addr-str" "N-02456270")
-      ("inaddr-any" "N-026A2C3B")
-      ("inaddr-loopback" "N-026A2C3B")
-      ("inaddr-str" "N-02456270")
-      ("inc" "N-03A0AABD")
-      ("inc-indent" "N-024E9FD8")
-      ("include" "N-01A2ECA0")
-      ("indent-code" "N-00512FDD")
-      ("indent-data" "N-00512FDD")
-      ("indent-foff" "N-00512FDD")
-      ("indent-off" "N-00512FDD")
-      ("inhash" "N-0161147E")
-      ("inlcr" "N-02391683")
-      ("ino-t" "N-01D716FE")
-      ("inpck" "N-02391683")
-      ("int" "N-018C7C8C")
-      ("int-buf" "N-00DCFA5F")
-      ("int-carray" "N-00797A01")
-      ("int-chr" "N-000AEC8B")
-      ("int-cptr" "N-01768FB9")
-      ("int-flo" "N-03F852CF")
-      ("int-ptr-t" "N-03258244")
-      ("int-str" "N-028043AE")
-      ("int16" "N-03D0AA7B")
-      ("int32" "N-03D0AA7B")
-      ("int64" "N-03D0AA7B")
-      ("int8" "N-0131FBF2")
-      ("integerp" "N-03E9D6E1")
-      ("intern" "N-02722B58")
-      ("intern-fb" "N-02722B58")
-      ("interp-fun-p" "N-00AC0CF7")
-      ("interpose" "N-0030734D")
-      ("inv-cum-norm" "N-0036EAFB")
-      ("invoke-catch" "N-0337FC1B")
-      ("ip" "N-00BE749A")
-      ("ipf" "N-012A7E6A")
-      ("iread" "N-03FE5500")
-      ("isatty" "N-03709E8A")
-      ("isec" "N-0385B074")
-      ("isig" "N-0072FF5E")
-      ("isqrt" "D-0039")
-      ("istrip" "N-02391683")
-      ("iter-begin" "D-002E")
-      ("iter-item" "D-0005")
-      ("iter-more" "D-003E")
-      ("iter-reset" "D-0020")
-      ("iter-step" "D-0071")
-      ("iterable" "N-01156AE3")
-      ("itimer-prof" "N-02B7882A")
-      ("itimer-real" "N-02B7882A")
-      ("itimer-virtual" "N-02B7882A")
-      ("iuclc" "N-02391683")
-      ("iutf8" "N-02391683")
-      ("ixany" "N-02391683")
-      ("ixoff" "N-02391683")
-      ("ixon" "N-02391683")
-      ("join" "N-00B6ACE3")
-      ("join-with" "N-00B6ACE3")
-      ("json" "N-0222106A")
-      ("juxt" "N-0106CD7F")
-      ("keep-if" "N-01413802")
-      ("keep-if*" "N-01413802")
-      ("keep-match-products" "N-01A846D2")
-      ("keep-matches" "N-01A846D2")
-      ("keepq" "N-00583609")
-      ("keepql" "N-00583609")
-      ("keepqual" "N-00583609")
-      ("key" "N-020D5C1D")
-      ("key-t" "N-01D716FE")
-      ("keyword-package" "N-0383342A")
-      ("keywordp" "N-01405F25")
-      ("kfs" "N-02D33A30")
-      ("kill" "N-0386CCD5")
-      ("krs" "N-02D33A4D")
-      ("labels" "N-0209307D")
-      ("lambda" "D-002C")
-      ("lambda-match" "N-031E43FF")
-      ("lambda-set" "N-02FEBA97")
-      ("last" "D-0043")
-      ("lazy-str" "N-02AFF63D")
-      ("lazy-str-force" "N-03269DEF")
-      ("lazy-str-force-upto" "N-0212FED6")
-      ("lazy-str-get-trailing-list" "N-012701D6")
-      ("lazy-stream-cons" "N-00B65D06")
-      ("lazy-stringp" "N-0381BB2A")
-      ("lchown" "N-003B491C")
-      ("lcm" "N-03D44645")
-      ("lcons" "N-013CC637")
-      ("lcons-car" "N-03598F4D")
-      ("lcons-cdr" "N-03598F4D")
-      ("lcons-fun" "N-02E1BA6F")
-      ("lconsp" "N-02E217A2")
-      ("ldiff" "N-02193773")
-      ("ldo" "N-03EF3A27")
-      ("left" "N-020D5C1D")
-      ("len" "N-03AD172A")
-      ("length" "D-0049")
-      ("length-buf" "N-0026D89A")
-      ("length-carray" "N-03FF97BD")
-      ("length-list" "N-01F8186A")
-      ("length-str" "N-03E6D841")
-      ("length-str-<" "N-016D8C45")
-      ("length-str-<=" "N-016D8C45")
-      ("length-str->" "N-016D8C45")
-      ("length-str->=" "N-016D8C45")
-      ("length-vec" "N-03D6D851")
-      ("lequal" "N-00A3E42D")
-      ("less" "N-01D6CEA1")
-      ("let" "N-013AF20B")
-      ("let*" "N-013AF20B")
-      ("lexical-fun-p" "N-007B1A53")
-      ("lexical-lisp1-binding" "N-02D124AB")
-      ("lexical-var-p" "N-007B1A53")
-      ("lib-version" "N-032F57D4")
-      ("line" "N-02D5D09D")
-      ("link" "N-009EF0C8")
-      ("list" "N-0206CE91")
-      ("list*" "N-03593DE9")
-      ("list-builder" "N-018F6666")
-      ("list-carray" "N-03EB1E3D")
-      ("list-seq" "N-02F0880D")
-      ("list-str" "N-0236023D")
-      ("list-vec" "N-00460235")
-      ("listp" "N-03F70343")
-      ("lnew" "N-0230059D")
-      ("lnew*" "N-021E6FDC")
-      ("load" "D-0081")
-      ("load-for" "N-0020A085")
-      ("load-time" "D-0048")
-      ("loff-t" "N-01D716FE")
-      ("log" "D-0047")
-      ("log-alert" "N-035D75EC")
-      ("log-auth" "N-0116F48F")
-      ("log-authpriv" "N-0116F48F")
-      ("log-cons" "N-02371913")
-      ("log-crit" "N-035D75EC")
-      ("log-daemon" "N-0116F48F")
-      ("log-debug" "N-035D75EC")
-      ("log-emerg" "N-035D75EC")
-      ("log-err" "N-035D75EC")
-      ("log-info" "N-035D75EC")
-      ("log-ndelay" "N-02371913")
-      ("log-notice" "N-035D75EC")
-      ("log-nowait" "N-02371913")
-      ("log-odelay" "N-02371913")
-      ("log-perror" "N-02371913")
-      ("log-pid" "N-02371913")
-      ("log-user" "N-0116F48F")
-      ("log-warning" "N-035D75EC")
-      ("log10" "D-0052")
-      ("log2" "D-0074")
-      ("logand" "D-000E")
-      ("logcount" "D-003B")
-      ("logior" "D-004C")
-      ("lognot" "D-0012")
-      ("lognot1" "N-019541E2")
-      ("logtest" "N-00B1548A")
-      ("logtrunc" "D-0075")
-      ("logxor" "N-02D5AF97")
-      ("long" "N-018C7C8C")
-      ("long-suffix" "N-00A3183A")
-      ("longlong" "N-02299408")
-      ("lop" "N-017F3A22")
-      ("lset" "N-008216EC")
-      ("lstat" "N-006DE1CC")
-      ("lutimes" "N-00E96FCF")
-      ("m$" "N-02F44ECE")
-      ("m^" "N-02F44ECE")
-      ("m^$" "N-02F44ECE")
-      ("mac-env-param-bind" "N-021A9008")
-      ("mac-param-bind" "N-021A9008")
-      ("macro-ancestor" "N-00519E96")
-      ("macro-form-p" "N-02AC86DE")
-      ("macro-time" "N-0264A0BD")
-      ("macroexpand" "N-02ED5471")
-      ("macroexpand-1" "N-02ED5471")
-      ("macroexpand-1-lisp1" "N-01E62179")
-      ("macroexpand-lisp1" "N-01E62179")
-      ("macrolet" "N-00AC12C0")
-      ("major" "N-02F0F482")
-      ("make-buf" "N-011445E1")
-      ("make-buf-stream" "N-03F5647C")
-      ("make-byte-input-stream" "N-03F54E14")
-      ("make-catenated-stream" "N-020BF082")
-      ("make-env" "N-01144687")
-      ("make-hash" "N-026D4158")
-      ("make-lazy-cons" "N-038B9EC2")
-      ("make-lazy-struct" "N-01C734D9")
-      ("make-like" "N-01C1D23C")
-      ("make-package" "N-02512A9A")
-      ("make-random-state" "N-032BEE6C")
-      ("make-similar-hash" "N-030E3A4A")
-      ("make-similar-tree" "N-030D1EF5")
-      ("make-string-byte-input-stream" "N-022937CD")
-      ("make-string-input-stream" "N-00F0B9B0")
-      ("make-string-output-stream" "N-0144BF51")
-      ("make-strlist-input-stream" "N-01737CF9")
-      ("make-strlist-output-stream" "N-00F363E0")
-      ("make-struct" "N-002B3F64")
-      ("make-struct-delegate-stream" "N-03FB1671")
-      ("make-struct-type" "N-022EEF2D")
-      ("make-sym" "N-0084463A")
-      ("make-time" "N-007C486E")
-      ("make-time-utc" "N-007C486E")
-      ("make-trie" "N-03C1B843")
-      ("make-union" "N-010A23C0")
-      ("make-zstruct" "N-03855D2D")
-      ("makedev" "N-02F0F482")
-      ("makunbound" "N-01FA4070")
-      ("mapcar" "N-0202F92F")
-      ("mapcar*" "N-0202F92F")
-      ("mapdo" "N-03A943EE")
-      ("mapf" "N-0026CEF1")
-      ("maphash" "N-03E6917D")
-      ("mappend" "N-0202F92F")
-      ("mappend*" "N-0202F92F")
-      ("maprend" "N-015987D7")
-      ("maprod" "N-015987D7")
-      ("maprodo" "N-015987D7")
-      ("mask" "N-0056CEF1")
-      ("match-case" "N-012DEAC3")
-      ("match-fun" "N-033F766A")
-      ("match-regex" "N-02E3A26F")
-      ("match-regex-right" "N-019430C5")
-      ("match-regst" "N-02E3A26F")
-      ("match-regst-right" "N-019430C5")
-      ("match-str" "N-03FF771E")
-      ("match-str-tree" "N-01859E7F")
-      ("max" "N-023C3643")
-      ("maybe" "N-039458F2")
-      ("mboundp" "N-01FBF828")
-      ("md5" "N-019F97A2")
-      ("md5-begin" "N-025F32FD")
-      ("md5-end" "N-025F32FD")
-      ("md5-hash" "N-025F32FD")
-      ("md5-stream" "N-006C94B6")
-      ("mdo" "N-028DBD1B")
-      ("member" "N-0176FBE7")
-      ("member-if" "N-0176FBE7")
-      ("memp" "N-03C6CE65")
-      ("memq" "N-0387CD82")
-      ("memql" "N-0387CD82")
-      ("memqual" "N-0387CD82")
-      ("meq" "N-020A0042")
-      ("meql" "N-020A0042")
-      ("mequal" "N-020A0042")
-      ("merge" "D-005B")
-      ("merge-delete-package" "N-0160EA2C")
-      ("meth" "N-02C216C3")
-      ("method" "N-022200C1")
-      ("mf" "N-036B6E55")
-      ("min" "N-023C3643")
-      ("minor" "N-02F0F482")
-      ("minusp" "D-0050")
-      ("mismatch" "N-03164F4F")
-      ("mkdir" "N-00C543B8")
-      ("mkdtemp" "N-026E4871")
-      ("mkfifo" "N-0091FD43")
-      ("mknod" "N-00F93A39")
-      ("mkstemp" "N-026E0471")
-      ("mkstring" "N-033DD796")
-      ("mlet" "N-008216E0")
-      ("mmakunbound" "N-02964FC0")
-      ("mod" "D-0040")
-      ("mode-t" "N-01D716FE")
-      ("multi" "N-034946BA")
-      ("multi-sort" "N-0132852F")
-      ("n-choose-k" "N-02ACFDE6")
-      ("n-perm-k" "N-02ACFDE6")
-      ("name" "N-01557906")
-      ("ncon" "N-022F6E60")
-      ("ncon*" "N-022F6E60")
-      ("nconc" "N-0014162F")
-      ("neg" "N-02C9F5F9")
-      ("neq" "N-0216A942")
-      ("neql" "N-0216A942")
-      ("nequal" "N-0216A942")
-      ("new" "N-0230059D")
-      ("new*" "N-021E6FDC")
-      ("nexpand-left" "N-00E168FE")
-      ("next" "D-006D")
-      ("next-file" "N-00839D2F")
-      ("nf" "N-0267AE6D")
-      ("nil" "N-015134D8")
-      ("nilf" "N-032070EB")
-      ("ninth" "N-01B0FA33")
-      ("nl0" "N-03BD477F")
-      ("nl1" "N-03BD477F")
-      ("nldly" "N-03BD477F")
-      ("nlink-t" "N-01D716FE")
-      ("noflsh" "N-0072FF5E")
-      ("none" "D-006C")
-      ("not" "D-006A")
-      ("notf" "N-0026CE18")
-      ("nr" "N-03A7AE6D")
-      ("nreconc" "N-012FF2DC")
-      ("nreverse" "N-03D8471B")
-      ("nshuffle" "N-01F12561")
-      ("nsort" "N-01FE5176")
-      ("nth" "N-0039F3FB")
-      ("nthcdr" "N-03D71D22")
-      ("nthlast" "N-02FC66FA")
-      ("null" "N-03C679D2")
-      ("nullify" "D-0008")
-      ("num-str" "N-028043AE")
-      ("numberp" "N-03E9D6E1")
-      ("nzerop" "N-0197FF9D")
-      ("o-accmode" "N-034BF6C9")
-      ("o-append" "N-034BF6C9")
-      ("o-async" "N-034BF6C9")
-      ("o-cloexec" "N-034BF6C9")
-      ("o-creat" "N-034BF6C9")
-      ("o-direct" "N-034BF6C9")
-      ("o-directory" "N-034BF6C9")
-      ("o-noatime" "N-034BF6C9")
-      ("o-noctty" "N-034BF6C9")
-      ("o-nofollow" "N-034BF6C9")
-      ("o-nonblock" "N-034BF6C9")
-      ("o-path" "N-034BF6C9")
-      ("o-rdonly" "N-034BF6C9")
-      ("o-rdwr" "N-034BF6C9")
-      ("o-sync" "N-034BF6C9")
-      ("o-trunc" "N-034BF6C9")
-      ("o-wronly" "N-034BF6C9")
-      ("oand" "N-01937C5A")
-      ("obtain" "N-01556613")
-      ("obtain*" "N-0102F0EB")
-      ("obtain*-block" "N-0102F0EB")
-      ("obtain-block" "N-01C791D0")
-      ("ocrnl" "N-03BD477F")
-      ("oddp" "D-003A")
-      ("ofdel" "N-03BD477F")
-      ("off-t" "N-01D716FE")
-      ("offsetof" "N-013D0A5C")
-      ("ofill" "N-03BD477F")
-      ("ofs" "N-02D33AA0")
-      ("olcuc" "N-03BD477F")
-      ("onlcr" "N-03BD477F")
-      ("onlret" "N-03BD477F")
-      ("onocr" "N-03BD477F")
-      ("op" "N-0068EA9D")
-      ("open-command" "N-02B03D38")
-      ("open-directory" "N-0221AE09")
-      ("open-file" "N-02B8FBBD")
-      ("open-fileno" "N-02BEAF24")
-      ("open-files" "N-018C5606")
-      ("open-files*" "N-018C5606")
-      ("open-process" "N-02B03D38")
-      ("open-socket" "N-026B766B")
-      ("open-socket-pair" "N-01A7ECBB")
-      ("open-tail" "N-0348F89A")
-      ("opendir" "N-024AA6F4")
-      ("openlog" "N-037AA654")
-      ("opip" "N-01937C5A")
-      ("opost" "N-03BD477F")
-      ("opt" "N-0047F5AB")
-      ("opt-desc" "N-03FC5092")
-      ("opthelp" "N-016C6171")
-      ("opts" "N-01D911E8")
-      ("or" "D-001A")
-      ("orec" "N-0003ED2C")
-      ("orf" "N-01E7D2AD")
-      ("ors" "N-02D33A3D")
-      ("output" "N-0159EBE7")
-      ("package-alist" "N-017F684C")
-      ("package-fallback-list" "N-027A535C")
-      ("package-foreign-symbols" "N-030C06F5")
-      ("package-local-symbols" "N-030C06F5")
-      ("package-name" "N-038581D9")
-      ("package-symbols" "N-03AF0206")
-      ("packagep" "N-007A478F")
-      ("pad" "N-0247F5FA")
-      ("parenb" "N-01B1B5DF")
-      ("parmrk" "N-02391683")
-      ("parodd" "N-01B1B5DF")
-      ("parse-errors" "N-00F843D4")
-      ("partition" "N-0142889E")
-      ("partition*" "N-03951D7A")
-      ("partition-by" "N-000167DF")
-      ("passwd" "N-036B0636")
-      ("path-blkdev-p" "N-00198FC7")
-      ("path-cat" "N-0033B27E")
-      ("path-chrdev-p" "N-00198FC7")
-      ("path-dir-empty" "N-01EFC15D")
-      ("path-dir-p" "N-00198FC7")
-      ("path-executable-to-me-p" "N-014A4B85")
-      ("path-exists-p" "N-03C41AE2")
-      ("path-file-p" "N-00198FC7")
-      ("path-mine-p" "N-020F44B5")
-      ("path-my-group-p" "N-020F44B5")
-      ("path-newer" "N-0155004F")
-      ("path-older" "N-0155004F")
-      ("path-pipe-p" "N-00198FC7")
-      ("path-private-to-me-p" "N-03B3F844")
-      ("path-read-writable-to-me-p" "N-028A5109")
-      ("path-readable-to-me-p" "N-02933008")
-      ("path-same-object" "N-0103E27B")
-      ("path-sep-chars" "N-03985DE5")
-      ("path-setgid-p" "N-02FBA677")
-      ("path-setuid-p" "N-02FBA677")
-      ("path-sock-p" "N-00198FC7")
-      ("path-sticky-p" "N-02FBA677")
-      ("path-strictly-private-to-me-p" "N-03B3F844")
-      ("path-symlink-p" "N-00198FC7")
-      ("path-writable-to-me-p" "N-02033190")
-      ("pdec" "N-00E4BC37")
-      ("pend" "N-03975507")
-      ("pend*" "N-03975507")
-      ("pendin" "N-0072FF5E")
-      ("perm" "N-0176D3A1")
-      ("pic" "N-02AF39D2")
-      ("pid-t" "N-01D716FE")
-      ("pinc" "N-00E4BC37")
-      ("pipe" "N-03F6D390")
-      ("placelet" "N-0393C970")
-      ("placelet*" "N-0393C970")
-      ("plist-to-alist" "N-006E31B5")
-      ("plusp" "D-0068")
-      ("poll" "N-0386D39D")
-      ("poly" "N-026201AD")
-      ("pop" "N-017F39D2")
-      ("portable-abs-path-p" "N-00477B23")
-      ("pos" "N-02C2BBDB")
-      ("pos-if" "N-02C2BBDB")
-      ("pos-max" "N-027D45DD")
-      ("pos-min" "N-027D45DD")
-      ("posq" "N-00A2B785")
-      ("posql" "N-00A2B785")
-      ("posqual" "N-00A2B785")
-      ("pppred" "N-038E636C")
-      ("ppred" "N-038E636C")
-      ("pprinl" "N-02FCCE0D")
-      ("pprint" "N-02FCCE0D")
-      ("pprof" "N-018C92AB")
-      ("pred" "N-038E636C")
-      ("prinl" "N-02FCCE0D")
-      ("print" "D-0046")
-      ("prn" "N-01E7F5F7")
-      ("prod" "N-0163FFE2")
-      ("prof" "N-004C9B10")
-      ("prog" "N-018A4BA9")
-      ("prog*" "N-018A4BA9")
-      ("prog1" "N-03F7A8B8")
-      ("prog2" "N-03A0E48C")
-      ("progn" "N-03F7A8B8")
-      ("promisep" "N-00C7553F")
-      ("prop" "N-01C6D406")
-      ("proper-list-p" "N-03F70343")
-      ("pset" "N-008211EC")
-      ("ptr" "N-027B04D0")
-      ("ptr-in" "N-00A494BF")
-      ("ptr-in-d" "N-01D7AC98")
-      ("ptr-out" "N-03D4DF7E")
-      ("ptr-out-d" "N-02036BEC")
-      ("ptr-out-s" "N-02D36BEC")
-      ("ptrdiff-t" "N-03258244")
-      ("pure-rel-path-p" "N-019DEA44")
-      ("purge-deferred-warning" "N-0077C4FE")
-      ("push" "N-01C211C1")
-      ("pushhash" "N-022660B2")
-      ("pushnew" "N-02C37AB0")
-      ("put-buf" "D-007F")
-      ("put-byte" "D-002F")
-      ("put-carray" "N-00737951")
-      ("put-char" "D-0003")
-      ("put-json" "N-009C27EF")
-      ("put-jsonl" "N-009C27EF")
-      ("put-jsons" "N-0124CAE6")
-      ("put-line" "N-012163C3")
-      ("put-lines" "N-0367B282")
-      ("put-obj" "N-025DB229")
-      ("put-string" "D-007B")
-      ("put-strings" "N-0367B282")
-      ("pwd" "N-0047F5F6")
-      ("qquote" "N-01665185")
-      ("qref" "D-006F")
-      ("quip" "N-03C6D422")
-      ("quote" "N-0163F998")
-      ("r$" "N-03BBB0C5")
-      ("r-atan2" "N-03BBA063")
-      ("r-ceil" "N-0399208F")
-      ("r-expt" "N-00192012")
-      ("r-floor" "N-00BBC669")
-      ("r-lognot" "N-00495055")
-      ("r-logtrunc" "N-02439AC4")
-      ("r-mod" "N-02F8C918")
-      ("r-round" "N-031D7670")
-      ("r-trunc" "N-02CD7330")
-      ("r^" "N-03BBB0C5")
-      ("r^$" "N-03BBB0C5")
-      ("raise" "N-0108FFCE")
-      ("rand" "N-03A57C86")
-      ("random" "N-03A57C86")
-      ("random-fixnum" "N-03A57C86")
-      ("random-float" "N-01572D27")
-      ("random-state-get-vec" "N-005C0F98")
-      ("random-state-p" "N-00C9A749")
-      ("range" "N-033BE5A1")
-      ("range*" "N-033BE5A1")
-      ("range-regex" "N-0250D465")
-      ("rangep" "N-00DDB00B")
-      ("rassoc" "N-03B49598")
-      ("rassq" "N-03B49598")
-      ("rassql" "N-03B49598")
-      ("rcomb" "N-02D9003C")
-      ("rcons" "N-02E9003D")
-      ("read" "N-03FE5500")
-      ("read-until-match" "N-001D3F81")
-      ("readdir" "N-0289D074")
-      ("readlink" "N-0338B219")
-      ("real-time-stream-p" "N-0121FDEB")
-      ("realpath" "N-0168BEB4")
-      ("rebind" "N-019F9FB7")
-      ("rec" "N-0003ED2C")
-      ("recip" "N-01B8BAB0")
-      ("record-adapter" "N-009C0AC4")
-      ("reduce-left" "N-00FB426F")
-      ("reduce-right" "N-00FB426F")
-      ("ref" "N-01A419FB")
-      ("refset" "N-01A419FB")
-      ("regex-compile" "N-0168C611")
-      ("regex-from-trie" "N-00E48912")
-      ("regex-parse" "N-01C9C361")
-      ("regex-prefix-match" "N-02CE60DF")
-      ("regex-source" "N-0218BD2B")
-      ("regexp" "N-03DDC533")
-      ("register-exception-subtypes" "N-005EB97F")
-      ("register-tentative-def" "N-033CBAA9")
-      ("regsub" "N-03BDC5F6")
-      ("rehome-sym" "N-03627360")
-      ("reject" "N-031DC0F2")
-      ("rel-path" "N-016892B4")
-      ("relate" "N-032DBF7E")
-      ("release-deferred-warnings" "N-012F0BE9")
-      ("remhash" "N-0029C57A")
-      ("remove-if" "N-01413802")
-      ("remove-if*" "N-01413802")
-      ("remove-path" "N-014AF3F7")
-      ("remove-path-rec" "N-03E81B3A")
-      ("remq" "N-000ECD82")
-      ("remq*" "N-00B85CD2")
-      ("remql" "N-000ECD82")
-      ("remql*" "N-00B85CD2")
-      ("remqual" "N-000ECD82")
-      ("remqual*" "N-00B85CD2")
-      ("rename-path" "N-016EF40C")
-      ("rep" "D-004F")
-      ("repeat" "D-006B")
-      ("replace" "N-035991E1")
-      ("replace-buf" "N-01C59E4E")
-      ("replace-list" "N-03E43DA2")
-      ("replace-str" "N-02059F0A")
-      ("replace-struct" "N-01A8343B")
-      ("replace-tree-iter" "N-01225FF3")
-      ("replace-vec" "N-01F59E62")
-      ("require" "D-007E")
-      ("reset-struct" "N-002A609F")
-      ("rest" "N-02288559")
-      ("ret" "N-033F39EF")
-      ("retf" "N-0026CB20")
-      ("return" "N-03E500DF")
-      ("return*" "N-0309887F")
-      ("return-from" "N-03E500DF")
-      ("revappend" "N-012FF2DC")
-      ("reverse" "N-03D8471B")
-      ("rfind" "N-0301CDB6")
-      ("rfind-if" "N-0301CDB6")
-      ("right" "N-020D5C1D")
-      ("rlcp" "N-024EB211")
-      ("rlcp-tree" "N-024EB211")
-      ("rlet" "N-008212A0")
-      ("rlist" "N-02FD60D0")
-      ("rlist*" "N-02FD60D0")
-      ("rmdir" "N-03D90503")
-      ("rmember" "N-0188A56C")
-      ("rmember-if" "N-0188A56C")
-      ("rmemq" "N-0188A56C")
-      ("rmemql" "N-0188A56C")
-      ("rmemqual" "N-0188A56C")
-      ("rmismatch" "N-008F3C16")
-      ("rng" "N-00BEA6DF")
-      ("rng+" "N-00BEA6DF")
-      ("rng-" "N-00BEA6DF")
-      ("rotate" "N-0166291D")
-      ("round" "D-0002")
-      ("round-rem" "N-02DE978F")
-      ("round1" "N-03EA1351")
-      ("rperm" "N-0188EBDE")
-      ("rplaca" "D-004E")
-      ("rplacd" "D-0009")
-      ("rpoly" "N-026201AD")
-      ("rpos" "N-01F68300")
-      ("rpos-if" "N-01F68300")
-      ("rposq" "N-01F68300")
-      ("rposql" "N-01F68300")
-      ("rposqual" "N-01F68300")
-      ("rr" "N-03BBB0C5")
-      ("rra" "N-0177F5FF")
-      ("rs" "N-0397AE68")
-      ("rsearch" "N-03405F7D")
-      ("rtld-deepbind" "N-0083A22A")
-      ("rtld-global" "N-0083A22A")
-      ("rtld-lazy" "N-0083A22A")
-      ("rtld-local" "N-0083A22A")
-      ("rtld-nodelete" "N-0083A22A")
-      ("rtld-noload" "N-0083A22A")
-      ("rtld-now" "N-0083A22A")
-      ("run" "N-0158244A")
-      ("s-ifblk" "N-03F32D57")
-      ("s-iflnk" "N-03F32D57")
-      ("s-ifmt" "N-03F32D57")
-      ("s-ifreg" "N-03F32D57")
-      ("s-ixoth" "N-03F32D57")
-      ("save-exe" "N-02850687")
-      ("sbit" "N-011F2878")
-      ("scan" "N-03E989D0")
-      ("scan-until-match" "N-00EFD668")
-      ("search" "N-015D8676")
-      ("search-regex" "N-0250D465")
-      ("search-regst" "N-0250D465")
-      ("search-str" "N-0257180F")
-      ("search-str-tree" "N-02783DAA")
-      ("second" "N-01B0FA33")
-      ("seek" "N-0136D6A2")
-      ("seek-cur" "N-01D6E4D8")
-      ("seek-end" "N-01D6E4D8")
-      ("seek-set" "N-01D6E4D8")
-      ("seek-stream" "N-031B5075")
-      ("select" "N-031D7F72")
-      ("self-path" "N-03561A65")
-      ("seq-begin" "N-0068A845")
-      ("seq-next" "N-02E3D643")
-      ("seq-reset" "N-01CA6912")
-      ("seqp" "N-03C6CAE0")
-      ("set" "D-0015")
-      ("set-cflags" "N-02061924")
-      ("set-hash-userdata" "N-030B40A7")
-      ("set-iflags" "N-02061924")
-      ("set-indent" "N-024E9FD8")
-      ("set-indent-mode" "N-03F3170C")
-      ("set-key" "N-033F7D05")
-      ("set-left" "N-033F7D05")
-      ("set-lflags" "N-02061924")
-      ("set-max-depth" "N-027D3FB4")
-      ("set-max-length" "N-031FA9E5")
-      ("set-oflags" "N-02061924")
-      ("set-package-fallback-list" "N-027A535C")
-      ("set-prop" "N-03663AE4")
-      ("set-right" "N-033F7D05")
-      ("set-sig-handler" "N-02E1B6FA")
-      ("set-stack-limit" "N-02492D13")
-      ("setegid" "N-03897D65")
-      ("setenv" "N-002E0364")
-      ("seteuid" "N-03897D65")
-      ("setgid" "N-03897D65")
-      ("setgrent" "N-02CAC7FB")
-      ("setgroups" "N-030FEE97")
-      ("sethash" "N-0025A17A")
-      ("setitimer" "N-02DE107D")
-      ("setlogmask" "N-0085DB47")
-      ("setpwent" "N-0377C43A")
-      ("setresgid" "N-027671E8")
-      ("setresuid" "N-027671E8")
-      ("setuid" "N-03897D65")
-      ("seventh" "N-01B0FA33")
-      ("sh" "N-0158244A")
-      ("sha256" "N-019F97A2")
-      ("sha256-begin" "N-03B36E53")
-      ("sha256-end" "N-03B36E53")
-      ("sha256-hash" "N-03B36E53")
-      ("sha256-stream" "N-006C94B6")
-      ("shift" "N-01AC8471")
-      ("short" "N-018C7C8C")
-      ("short-suffix" "N-00A3183A")
-      ("shuffle" "N-01F12561")
-      ("shut-rd" "N-028953A4")
-      ("shut-rdwr" "N-028953A4")
-      ("shut-wr" "N-028953A4")
-      ("sig-abrt" "N-0176430F")
-      ("sig-alrm" "N-0176430F")
-      ("sig-atomic-t" "N-03258244")
-      ("sig-bus" "N-0176430F")
-      ("sig-check" "N-0360A99A")
-      ("sig-chld" "N-0176430F")
-      ("sig-cont" "N-0176430F")
-      ("sig-fpe" "N-0176430F")
-      ("sig-hup" "N-0176430F")
-      ("sig-ill" "N-0176430F")
-      ("sig-int" "N-0176430F")
-      ("sig-io" "N-0176430F")
-      ("sig-iot" "N-0176430F")
-      ("sig-kill" "N-0176430F")
-      ("sig-lost" "N-0176430F")
-      ("sig-pipe" "N-0176430F")
-      ("sig-poll" "N-0176430F")
-      ("sig-prof" "N-0176430F")
-      ("sig-pwr" "N-0176430F")
-      ("sig-quit" "N-0176430F")
-      ("sig-segv" "N-0176430F")
-      ("sig-stkflt" "N-0176430F")
-      ("sig-stop" "N-0176430F")
-      ("sig-sys" "N-0176430F")
-      ("sig-term" "N-0176430F")
-      ("sig-trap" "N-0176430F")
-      ("sig-tstp" "N-0176430F")
-      ("sig-ttin" "N-0176430F")
-      ("sig-ttou" "N-0176430F")
-      ("sig-urg" "N-0176430F")
-      ("sig-usr1" "N-0176430F")
-      ("sig-usr2" "N-0176430F")
-      ("sig-vtalrm" "N-0176430F")
-      ("sig-winch" "N-0176430F")
-      ("sig-xcpu" "N-0176430F")
-      ("sig-xfsz" "N-0176430F")
-      ("sign-extend" "D-0031")
-      ("signum" "D-000F")
-      ("sin" "D-000B")
-      ("sinh" "D-0067")
-      ("sixth" "N-01B0FA33")
-      ("size-t" "N-03258244")
-      ("size-vec" "N-01000634")
-      ("sizeof" "N-0235DCAE")
-      ("skip" "N-021FCB7C")
-      ("slet" "N-00821260")
-      ("slot" "N-0326F62D")
-      ("slotp" "N-00B90177")
-      ("slots" "N-00E90177")
-      ("slotset" "N-02657437")
-      ("sme" "N-008C6621")
-      ("sock-accept" "N-00AF0FE8")
-      ("sock-bind" "N-02B052CF")
-      ("sock-connect" "N-00E5DFD4")
-      ("sock-dgram" "N-01D17D22")
-      ("sock-family" "N-0323EB36")
-      ("sock-listen" "N-02F624A8")
-      ("sock-peer" "N-015ABEC7")
-      ("sock-recv-timeout" "N-03DF15F2")
-      ("sock-send-timeout" "N-03DF15F2")
-      ("sock-set-peer" "N-01FE18ED")
-      ("sock-shutdown" "N-0222BA70")
-      ("sock-stream" "N-01D17D22")
-      ("sock-type" "N-0323EB36")
-      ("sockaddr" "N-02C48759")
-      ("sockaddr-in" "N-01DD05D9")
-      ("sockaddr-in6" "N-013DD169")
-      ("sockaddr-un" "N-01DD05D2")
-      ("some" "D-0041")
-      ("sort" "N-01FE5176")
-      ("sort-group" "N-01E65DDC")
-      ("source-loc" "N-0370CD69")
-      ("source-loc-str" "N-0370CD69")
-      ("span-str" "N-0394CA3A")
-      ("special-operator-p" "N-01E259AD")
-      ("special-var-p" "N-00833473")
-      ("spl" "N-03C7F5FA")
-      ("splice" "N-03BC798C")
-      ("split" "N-02FD4882")
-      ("split*" "N-02FD4882")
-      ("split-str" "N-000386B4")
-      ("split-str-set" "N-0296195B")
-      ("sqrt" "D-0027")
-      ("square" "D-0032")
-      ("ssize-t" "N-01D716FE")
-      ("sspl" "N-0296195B")
-      ("sssucc" "N-038E636C")
-      ("ssucc" "N-038E636C")
-      ("starts-with" "N-004955D4")
-      ("stat" "D-005C")
-      ("static-slot" "N-02C47D17")
-      ("static-slot-ensure" "N-02E71F31")
-      ("static-slot-home" "N-01F88B0D")
-      ("static-slot-p" "N-032FD510")
-      ("static-slot-set" "N-0017D1B5")
-      ("stdlib" "N-008E4BC2")
-      ("str" "N-00C6B7C4")
-      ("str-buf" "N-012BF6AD")
-      ("str-d" "N-00C6B7C4")
-      ("str-in6addr" "N-01FF658D")
-      ("str-in6addr-net" "N-00918411")
-      ("str-inaddr" "N-01FF658D")
-      ("str-inaddr-net" "N-00918411")
-      ("str-seq" "N-02F0880D")
-      ("str<" "N-01AA954A")
-      ("str<=" "N-01AA954A")
-      ("str=" "N-01AA954A")
-      ("str>" "N-01AA954A")
-      ("str>=" "N-01AA954A")
-      ("stream-get-prop" "N-005268C8")
-      ("stream-set-prop" "N-005268C8")
-      ("stream-wrap" "N-00FE2393")
-      ("streamp" "N-02BB4421")
-      ("strerror" "N-02A1DB65")
-      ("string-decode" "N-033502F8")
-      ("string-encode" "N-033502F8")
-      ("string-extend" "N-03D5358A")
-      ("string-lt" "N-03ABBED1")
-      ("stringp" "N-00BB392B")
-      ("strsignal" "N-00234BED")
-      ("struct" "D-001B")
-      ("struct-from-args" "N-01515451")
-      ("struct-from-plist" "N-01515451")
-      ("struct-get-initfun" "N-03946F2A")
-      ("struct-get-postinitfun" "N-03946F2A")
-      ("struct-set-initfun" "N-00946F18")
-      ("struct-set-postinitfun" "N-00946F18")
-      ("struct-type" "N-02C33D76")
-      ("struct-type-name" "N-00088BD7")
-      ("struct-type-p" "N-00717410")
-      ("structp" "N-01BB3FB3")
-      ("sub" "N-01D9F42F")
-      ("sub-buf" "N-000FFE37")
-      ("sub-list" "N-038E3E1D")
-      ("sub-str" "N-03CFFEF2")
-      ("sub-tree" "N-0398FBE2")
-      ("sub-vec" "N-03BFFF0A")
-      ("subtypep" "N-00699D3B")
-      ("succ" "N-038E636C")
-      ("sum" "N-0163FFE2")
-      ("super" "N-03D8EEEE")
-      ("super-method" "N-02AC8367")
-      ("suspend" "N-02E7852D")
-      ("swap" "N-0042131D")
-      ("symacrolet" "N-00321AB1")
-      ("symbol-function" "N-00004DDC")
-      ("symbol-macro" "N-00004DDC")
-      ("symbol-name" "N-035D3BBF")
-      ("symbol-package" "N-02AB2428")
-      ("symbol-value" "N-00004DDC")
-      ("symbolp" "N-01C0BF69")
-      ("symdiff" "N-0385B074")
-      ("symlink" "N-009EF0C8")
-      ("sys:abscond*" "N-02DF20E5")
-      ("sys:abscond-from" "N-02E20FE2")
-      ("sys:capture-cont" "N-02199305")
-      ("sys:gc" "N-01C75157")
-      ("sys:gc-set-delta" "N-02C0C748")
-      ("syslog" "N-02075291")
-      ("system-package" "N-0383342A")
-      ("t" "N-015134D8")
-      ("tab0" "N-03BD477F")
-      ("tab1" "N-03BD477F")
-      ("tab2" "N-03BD477F")
-      ("tab3" "N-03BD477F")
-      ("tabdly" "N-03BD477F")
-      ("tagbody" "N-007E0D96")
-      ("tailp" "N-00B8D7B5")
-      ("take" "N-00F6D433")
-      ("take-until" "N-01E42C4C")
-      ("take-while" "N-01E42C4C")
-      ("tan" "D-003C")
-      ("tanh" "D-0062")
-      ("tb" "N-02AB6E53")
-      ("tc" "N-029B6E53")
-      ("tcdrain" "N-01AC4760")
-      ("tcflow" "N-03081D51")
-      ("tcflush" "N-034C4A4D")
-      ("tcgetattr" "N-013D13CA")
-      ("tciflush" "N-0279ED46")
-      ("tcioff" "N-02173FF9")
-      ("tcioflush" "N-0279ED46")
-      ("tcion" "N-02173FF9")
-      ("tcoflush" "N-0279ED46")
-      ("tcooff" "N-02173FF9")
-      ("tcoon" "N-02173FF9")
-      ("tcsadrain" "N-02C6ECF5")
-      ("tcsaflush" "N-02C6ECF5")
-      ("tcsanow" "N-02C6ECF5")
-      ("tcsendbreak" "N-033C365C")
-      ("tcsetattr" "N-013D13CA")
-      ("tentative-def-exists" "N-0186D1B7")
-      ("tenth" "N-01B0FA33")
-      ("termios" "N-039CD619")
-      ("test-clear" "N-036C7E9E")
-      ("test-clear-dirty" "N-03AB857D")
-      ("test-dec" "N-01A4228F")
-      ("test-dirty" "N-03AB857D")
-      ("test-inc" "N-01A4228F")
-      ("test-neq-set-indent-mode" "N-01A1F89C")
-      ("test-set" "N-036C7E9E")
-      ("test-set-indent-mode" "N-01A1F89C")
-      ("tf" "N-032070EB")
-      ("third" "N-01B0FA33")
-      ("throw" "D-0053")
-      ("throwf" "N-015466AD")
-      ("time" "D-0034")
-      ("time-fields-local" "N-00789418")
-      ("time-fields-utc" "N-00789418")
-      ("time-local" "N-001284ED")
-      ("time-nsec" "N-03B6DB3D")
-      ("time-parse" "D-0065")
-      ("time-parse-local" "N-00207C99")
-      ("time-parse-utc" "N-00207C99")
-      ("time-string" "N-007B1819")
-      ("time-string-local" "N-00F192AD")
-      ("time-string-utc" "N-00F192AD")
-      ("time-struct-local" "N-00B758FD")
-      ("time-struct-utc" "N-00B758FD")
-      ("time-t" "N-03258244")
-      ("time-usec" "N-03B6DB3D")
-      ("time-utc" "N-001284ED")
-      ("tmpfile" "N-00FF7C41")
-      ("tnode" "N-0008DDFB")
-      ("tnodep" "N-00D8534F")
-      ("to" "N-00AED1A7")
-      ("tofloat" "N-01DBC9D7")
-      ("tofloatz" "N-03E2D4B8")
-      ("toint" "N-01DBC9D7")
-      ("tointz" "N-03E2D4B8")
-      ("tojson" "N-017848BD")
-      ("tok" "N-0117F60C")
-      ("tok-str" "N-0225F28F")
-      ("tok-where" "N-0225F28F")
-      ("tostop" "N-0072FF5E")
-      ("tostring" "N-02FCCE0D")
-      ("tostringp" "N-02FCCE0D")
-      ("touch" "N-0038DD42")
-      ("tprint" "N-0217DE45")
-      ("trace" "N-02833733")
-      ("trailer" "D-0057")
-      ("transpose" "N-03AA85AD")
-      ("tree" "N-02F6D50B")
-      ("tree-begin" "N-02887FCA")
-      ("tree-bind" "N-021A9008")
-      ("tree-case" "N-03D834A5")
-      ("tree-clear" "N-03C88274")
-      ("tree-delete" "N-022035DF")
-      ("tree-delete-node" "N-00772FAE")
-      ("tree-find" "N-0149BC05")
-      ("tree-insert" "N-0114FF9E")
-      ("tree-insert-node" "N-008B4AD9")
-      ("tree-lookup" "N-01D63E47")
-      ("tree-lookup-node" "N-03FE4877")
-      ("tree-next" "N-02443382")
-      ("tree-peek" "N-02443382")
-      ("tree-reset" "N-002A407C")
-      ("tree-root" "N-0149BF2D")
-      ("treep" "N-03B8E442")
-      ("trie-add" "N-0006C677")
-      ("trie-compress" "N-00026B83")
-      ("trie-lookup-begin" "N-02D16290")
-      ("trie-lookup-feed-char" "N-014E6D7B")
-      ("trie-value-at" "N-012A1BAD")
-      ("trim-left" "N-00CF29CC")
-      ("trim-right" "N-00CF29CC")
-      ("trim-str" "N-00E6E63B")
-      ("true" "N-00373D97")
-      ("trunc" "D-005D")
-      ("trunc-rem" "N-02DE978F")
-      ("trunc1" "N-02E91F51")
-      ("truncate" "N-0032FBF3")
-      ("truncate-stream" "N-009F5B3F")
-      ("try" "N-0328371B")
-      ("tuples" "N-00C801EF")
-      ("txr-case" "N-03813122")
-      ("txr-exe-path" "N-014C116E")
-      ("txr-if" "N-00355D4E")
-      ("txr-parse" "N-02AC7FB4")
-      ("txr-version" "N-032F57D4")
-      ("txr-when" "N-02311DCA")
-      ("typecase" "N-0384D122")
-      ("typedef" "N-01BE95E8")
-      ("typeof" "N-01F81275")
-      ("typep" "N-03B8D9EE")
-      ("ubit" "N-011F2878")
-      ("uchar" "N-0008D7DC")
-      ("uid-t" "N-01D716FE")
-      ("uint" "N-018C7C8C")
-      ("uint-buf" "N-00DCFA5F")
-      ("uint-carray" "N-00797A01")
-      ("uint-ptr-t" "N-03258244")
-      ("uint16" "N-03D0AA7B")
-      ("uint32" "N-03D0AA7B")
-      ("uint64" "N-03D0AA7B")
-      ("uint8" "N-0131FBF2")
-      ("ulong" "N-018C7C8C")
-      ("ulonglong" "N-02299408")
-      ("umask" "N-0068D92E")
-      ("umeth" "N-02ECA31C")
-      ("umethod" "N-000BCBC5")
-      ("uname" "N-0308D954")
-      ("unget-byte" "D-0007")
-      ("unget-char" "D-0056")
-      ("uni" "N-0385B074")
-      ("unintern" "N-01B6BFC2")
-      ("union" "N-01C78B86")
-      ("union-get" "N-02FA4F0C")
-      ("union-in" "N-02258991")
-      ("union-members" "N-008912E4")
-      ("union-out" "N-02258991")
-      ("union-put" "N-02FA4EBC")
-      ("uniq" "N-03B6D456")
-      ("unique" "N-0028147F")
-      ("unless" "N-017EFAB6")
-      ("unquote" "N-036B313D")
-      ("unsetenv" "N-002E0364")
-      ("until" "D-0025")
-      ("until*" "N-01F7BF0B")
-      ("untrace" "N-02833733")
-      ("unuse-package" "N-024BF63F")
-      ("unuse-sym" "N-01AF42B7")
-      ("unwind-protect" "N-03162B0C")
-      ("upcase-str" "N-029EEA82")
-      ("upd" "N-033F39DC")
-      ("update" "N-0327B17E")
-      ("uref" "N-03A211AB")
-      ("url-decode" "N-0388DB26")
-      ("url-encode" "N-0388DB26")
-      ("use" "N-004834CC")
-      ("use-package" "N-024BF63F")
-      ("use-sym" "N-01747674")
-      ("user-package" "N-0383342A")
-      ("ushort" "N-018C7C8C")
-      ("usl" "N-00BF39DD")
-      ("usleep" "N-00D79773")
-      ("uslot" "N-01F8E0A1")
-      ("utimes" "N-00E96FCF")
-      ("utsname" "N-003D12F6")
-      ("val" "N-00DB04DD")
-      ("vdiscard" "N-01812D70")
-      ("vec" "N-0297F5F5")
-      ("vec-carray" "N-03EB1E3D")
-      ("vec-list" "N-03295612")
-      ("vec-push" "N-01693B82")
-      ("vec-seq" "N-02F0880D")
-      ("vec-set-length" "N-01723847")
-      ("vecref" "N-001963BF")
-      ("vector" "N-02B6C6F1")
-      ("vectorp" "N-03B9C3E5")
-      ("veof" "N-01812D70")
-      ("veol" "N-01812D70")
-      ("veol2" "N-01812D70")
-      ("verase" "N-01812D70")
-      ("vintr" "N-01812D70")
-      ("vkill" "N-01812D70")
-      ("vlnext" "N-01812D70")
-      ("vm-fun-p" "N-00B99FC5")
-      ("vmin" "N-01812D70")
-      ("void" "N-013DE1A3")
-      ("vquit" "N-01812D70")
-      ("vreprint" "N-01812D70")
-      ("vstart" "N-01812D70")
-      ("vstop" "N-01812D70")
-      ("vsusp" "N-01812D70")
-      ("vswtc" "N-01812D70")
-      ("vt0" "N-03BD477F")
-      ("vt1" "N-03BD477F")
-      ("vtdly" "N-03BD477F")
-      ("vtime" "N-01812D70")
-      ("vwerase" "N-01812D70")
-      ("w-coredump" "N-0243C575")
-      ("w-exitstatus" "N-0243C575")
-      ("w-ifexited" "N-0243C575")
-      ("w-ifsignaled" "N-0243C575")
-      ("w-ifstopped" "N-0243C575")
-      ("w-stopsig" "N-0243C575")
-      ("w-termsig" "N-0243C575")
-      ("wait" "N-0365C3E1")
-      ("weave" "N-0208F32F")
-      ("when" "N-017EFAB6")
-      ("when-match" "N-00CFBF5E")
-      ("whena" "N-005C93DF")
-      ("whenlet" "N-02DA21F6")
-      ("where" "N-0208F1DE")
-      ("while" "N-01026F48")
-      ("while*" "N-01F7BF0B")
-      ("while-match" "N-015B0AD0")
-      ("while-match-case" "N-007220BC")
-      ("while-true-match-case" "N-007220BC")
-      ("whilet" "N-0154DC75")
-      ("width" "D-0019")
-      ("width-check" "N-01A9EA49")
-      ("window-map" "N-015AFD48")
-      ("window-mapdo" "N-015AFD48")
-      ("window-mappend" "N-015AFD48")
-      ("wint-t" "N-03258244")
-      ("with" "N-03098987")
-      ("with-clobber-expander" "N-0181ED4C")
-      ("with-compilation-unit" "N-013AAB51")
-      ("with-delete-expander" "N-02A6E020")
-      ("with-dyn-lib" "N-023E0D2C")
-      ("with-gensyms" "N-034F045B")
-      ("with-hash-iter" "N-001B79C0")
-      ("with-in-buf-stream" "N-01150550")
-      ("with-in-string-byte-stream" "N-00FD832E")
-      ("with-in-string-stream" "N-004ED7A0")
-      ("with-objects" "N-00AECEBA")
-      ("with-out-buf-stream" "N-01150550")
-      ("with-out-string-stream" "N-0001C63C")
-      ("with-out-strlist-stream" "N-024F86B3")
-      ("with-resources" "N-012CE06E")
-      ("with-slots" "N-00C411A2")
-      ("with-stream" "N-013E33A2")
-      ("with-update-expander" "N-006EA023")
-      ("wrap" "N-026DDCEC")
-      ("wrap*" "N-026DDCEC")
-      ("wstr" "N-032DB6DC")
-      ("wstr-d" "N-032DB6DC")
-      ("xcase" "N-0072FF5E")
-      ("yield" "N-02AE5C1E")
-      ("yield-from" "N-01556613")
-      ("zap" "N-037F3A8C")
-      ("zarray" "N-017039ED")
-      ("zchar" "N-0008D7DC")
-      ("zero-fill" "N-016D3BB5")
-      ("zerop" "D-003F")
-      ("zip" "N-03AA85AD")
-      ("znew" "N-00B1FC38"))))
diff --git a/share/txr/stdlib/doloop.tl b/share/txr/stdlib/doloop.tl
deleted file mode 100644
index 56540d9e..00000000
--- a/share/txr/stdlib/doloop.tl
+++ /dev/null
@@ -1,54 +0,0 @@
-;; Copyright 2017-2021
-;; Kaz Kylheku <kaz@kylheku.com>
-;; Vancouver, Canada
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are met:
-;;
-;; 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 BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(defun sys:expand-doloop (f vars cexp body)
-  (let ((xvars (mapcar (tc
-                         (((:whole w v i s . r))
-                          (if r (compile-error f "excess elements in ~s" w) w))
-                         (((:whole w v i . r))
-                          (if r
-                            (compile-error f "bad variable clause syntax ~s" w)
-                            ^(,v ,i ,i)))
-                         (((:whole w v . r))
-                          (if r
-                            (compile-error f "bad variable clause syntax ~s" w)
-                            ^(,v nil ,v)))
-                         ((v) ^(,v nil ,v)))
-                       vars))
-        (pllel (eq (car f) 'doloop)))
-    ^(,(if pllel 'for 'for*)
-       ,(mapcar (aret ^(,@1 ,@2)) xvars)
-       ,cexp
-       ((,(if pllel 'pset 'set) ,*(mappend (ado unless (eq @1 @3)
-                                             ^(,@1 ,@3))
-                                           xvars)))
-       (tagbody ,*body))))
-
-(defmacro doloop (:form f vars cexp . body)
-  (sys:expand-doloop f vars cexp body))
-
-(defmacro doloop* (:form f vars cexp . body)
-  (sys:expand-doloop f vars cexp body))
diff --git a/share/txr/stdlib/each-prod.tl b/share/txr/stdlib/each-prod.tl
deleted file mode 100644
index 7b7150c0..00000000
--- a/share/txr/stdlib/each-prod.tl
+++ /dev/null
@@ -1,75 +0,0 @@
-;; Copyright 2020-2021
-;; Kaz Kylheku <kaz@kylheku.com>
-;; Vancouver, Canada
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are met:
-;;
-;; 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 BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(defun sys:vars-check (form vars)
-  (unless (listp vars)
-    (compile-error form "~s is expected to be variable binding syntax" vars))
-  (whenlet ((bad (find-if [notf consp] vars)))
-    (compile-error form "~s isn't a var-initform pair" bad)))
-
-(defun sys:bindable-check (form syms)
-  (whenlet ((bad (find-if [notf bindable] syms)))
-    (compile-error form "~s isn't a bindable symbol" bad)))
-
-(defun sys:expand-each-prod (form vars body)
-  (sys:vars-check form vars)
-  (let ((syms [mapcar car vars])
-        (inits [mapcar cadr vars]))
-    (sys:bindable-check form syms)
-    (let ((fun (caseq (car form)
-                 (each-prod 'maprodo)
-                 (collect-each-prod 'maprod)
-                 (append-each-prod 'maprend))))
-      ^(,fun (lambda (,*syms) ,*body) ,*inits))))
-
-(defun sys:expand-each-prod* (form vars body)
-  (sys:vars-check form vars)
-  (let* ((each-prod-op (caseq (car form)
-                         (each-prod* 'each-prod)
-                         (collect-each-prod* 'collect-each-prod)
-                         (append-each-prod* 'append-each-prod)))
-         (syms [mapcar car vars])
-         (inits [mapcar cadr vars]))
-    ^(let* ,vars
-       (,each-prod-op ,(zip syms syms) ,*body))))
-
-(defmacro each-prod (:form f vars . body)
-  (sys:expand-each-prod f vars body))
-
-(defmacro collect-each-prod (:form f vars . body)
-  (sys:expand-each-prod f vars body))
-
-(defmacro append-each-prod (:form f vars . body)
-  (sys:expand-each-prod f vars body))
-
-(defmacro each-prod* (:form f vars . body)
-  (sys:expand-each-prod* f vars body))
-
-(defmacro collect-each-prod* (:form f vars . body)
-  (sys:expand-each-prod* f vars body))
-
-(defmacro append-each-prod* (:form f vars . body)
-  (sys:expand-each-prod* f vars body))
diff --git a/share/txr/stdlib/error.tl b/share/txr/stdlib/error.tl
deleted file mode 100644
index 7f70391e..00000000
--- a/share/txr/stdlib/error.tl
+++ /dev/null
@@ -1,95 +0,0 @@
-;; Copyright 2017-2021
-;; Kaz Kylheku <kaz@kylheku.com>
-;; Vancouver, Canada
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are met:
-;;
-;; 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 BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(defun sys:dig (ctx)
-  (whilet ((form (sys:ctx-form ctx))
-           (anc (unless (source-loc form)
-                  (macro-ancestor form))))
-    (set ctx anc))
-  ctx)
-
-(defun sys:loc (ctx)
-  (source-loc-str (sys:ctx-form ctx)))
-
-(defun compile-error (ctx fmt . args)
-  (let* ((nctx (sys:dig ctx))
-         (loc (sys:loc nctx))
-         (name (sys:ctx-name nctx)))
-    (let ((msg (fmt `@loc: ~s: @fmt` name . args)))
-      (when (and *load-recursive*
-                 (null (find-frame 'error 'catch-frame)))
-        (dump-deferred-warnings *stderr*)
-        (put-line msg *stderr*))
-      (throw 'eval-error msg))))
-
-(defun compile-warning (ctx fmt . args)
-  (let* ((nctx (sys:dig ctx))
-         (loc (sys:loc nctx))
-         (name (sys:ctx-name nctx)))
-    (usr:catch
-      (throwf 'warning `@loc: warning: ~s: @fmt` name . args)
-      (continue ()))))
-
-(defun compile-defr-warning (ctx tag fmt . args)
-  (let* ((nctx (sys:dig ctx))
-         (loc (sys:loc nctx))
-         (name (sys:ctx-name nctx)))
-    (usr:catch
-      (throw 'defr-warning (fmt `@loc: warning: ~s: @fmt` name . args)  tag)
-      (continue ()))))
-
-(defun sys:bind-mac-error (ctx-form params obj too-few-p)
-  (cond
-    ((atom obj)
-     (compile-error ctx-form "extra element ~s not matched by params ~a"
-                    obj params))
-    ((null obj)
-     (compile-error ctx-form "params ~a require arguments" params))
-    (t (compile-error ctx-form "too ~a elements in ~s for params ~a"
-                      (if too-few-p "few" "many")
-                      obj params))))
-
-(defun sys:bind-mac-check (ctx-form params obj req fix)
-  (if (and obj (atom obj))
-    (compile-error ctx-form "extra element ~s not matched by params ~a"
-                   obj params)
-    (let ((l (len obj)))
-      (iflet ((problem (cond
-                         ((< l req) "few")
-                         ((and fix (> l fix)) "many"))))
-        (if (zerop l)
-          (compile-error ctx-form "params ~a require arguments" params)
-          (compile-error ctx-form "too ~a elements in ~s for params ~a"
-                         problem obj params))))))
-
-(defun lambda-too-many-args (form)
-  (compile-error form "excess arguments given"))
-
-(defun lambda-too-few-args (form)
-  (compile-error form "inufficient arguments given"))
-
-(defun lambda-short-apply-list ()
-  (throwf 'eval-error "~s: applied argument list too short" 'lambda))
diff --git a/share/txr/stdlib/except.tl b/share/txr/stdlib/except.tl
deleted file mode 100644
index 60f2fe51..00000000
--- a/share/txr/stdlib/except.tl
+++ /dev/null
@@ -1,88 +0,0 @@
-;; Copyright 2015-2021
-;; Kaz Kylheku <kaz@kylheku.com>
-;; Vancouver, Canada
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are met:
-;;
-;; 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 BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(defun sys:handle-bad-syntax (item)
-  (throwf 'eval-error "~s: bad clause syntax: ~s" 'handle item))
-
-(defmacro usr:catch (:form form :env e try-form . catch-clauses)
-  (let ((catch-syms [mapcar car catch-clauses])
-        (sys-catch-clauses (mapcar (do mac-param-bind @1 (type args . body) @1
-                                     (tree-bind (args-ex . body-ex)
-                                                (sys:expand-params args body
-                                                                   e nil form)
-                                       ^(,type (,(gensym) ,*args-ex) ,*body-ex)))
-                                   catch-clauses)))
-    ^(sys:catch ,catch-syms ,try-form nil ,*sys-catch-clauses)))
-
-(defmacro catch* (try-form . catch-clauses)
-  (let ((catch-syms [mapcar car catch-clauses]))
-    ^(sys:catch ,catch-syms ,try-form nil ,*catch-clauses)))
-
-(defmacro catch** (:env menv try-form . catch-clauses)
-  (let ((catch-syms [mapcar car catch-clauses])
-        sys-catch-clauses descs)
-    (each ((cl catch-clauses))
-      (mac-param-bind cl (type desc args . body) cl
-        (push ^(,type ,args ,*body) sys-catch-clauses)
-        (push desc descs)))
-    (sys:setq sys-catch-clauses (nreverse sys-catch-clauses))
-    (sys:setq descs (nreverse descs))
-    (let ((desc-expr (if [all descs (op constantp @1 menv)]
-                       ^'(,*[mapcar eval descs])
-                       ^(list ,*descs))))
-      ^(sys:catch ,catch-syms ,try-form ,desc-expr ,*sys-catch-clauses))))
-
-(defun sys:expand-handle (form try-form handle-clauses)
-  (let* ((oper (car form))
-         (exc-sym (gensym))
-         (exc-args (gensym))
-         (syms-fragments (collect-each ((hc handle-clauses))
-                          (tree-case hc
-                            ((name arglist . body)
-                             (unless (symbolp name)
-                               (sys:handle-bad-syntax hc))
-                             (list name ^(apply (lambda ,arglist ,*body)
-                                                ,*(if (or (eq oper 'handle*)
-                                                          (and (plusp sys:compat)
-                                                               (<= 161 sys:compat)))
-                                                    ^(,exc-sym))
-                                                ,exc-args)))
-                            (else (sys:handle-bad-syntax hc))))))
-    ^(handler-bind (lambda (,exc-sym . ,exc-args)
-                     (cond
-                       ,*(mapcar (aret ^((exception-subtype-p ,exc-sym ',@1) ,@2))
-                                 syms-fragments)))
-                   ,[mapcar car syms-fragments]
-                   ,try-form)))
-
-(defmacro handle (:form form try-form . handle-clauses)
-  (sys:expand-handle form try-form handle-clauses))
-
-(defmacro handle* (:form form try-form . handle-clauses)
-  (sys:expand-handle form try-form handle-clauses))
-
-(defmacro ignwarn (. forms)
-  ^(handler-bind (lambda (exc-sym . args) (throw 'continue)) (warning) ,*forms))
diff --git a/share/txr/stdlib/ffi.tl b/share/txr/stdlib/ffi.tl
deleted file mode 100644
index dbf7888c..00000000
--- a/share/txr/stdlib/ffi.tl
+++ /dev/null
@@ -1,181 +0,0 @@
-;; Copyright 2017-2021
-;; Kaz Kylheku <kaz@kylheku.com>
-;; Vancouver, Canada
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are met:
-;;
-;; 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 BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(defmacro sys:dlib-expr (spec)
-  (typecase spec
-    (null ^(dlopen))
-    (str ^(dlopen ,spec rtld-now))
-    (t spec)))
-
-(defmacro with-dyn-lib (lib . body)
-  (let ((keep-var (gensym "lib-")))
-    ^(prog1
-       (defvarl ,keep-var (sys:dlib-expr ,lib))
-       (symacrolet ((sys:ffi-lib ,keep-var))
-         ,*body))))
-
-(defun sys:with-dyn-lib-check (f e ref)
-  (when (eq (macroexpand 'sys:ffi-lib e) 'sys:ffi-lib)
-    (compile-warning f "simple ref ~s requires ~s"
-                     ref 'with-dyn-lib)))
-
-(defun sys:expand-sym-ref (f e exp)
-  (cond
-    ((stringp exp)
-       (sys:with-dyn-lib-check f e exp)
-       ^(dlsym-checked sys:ffi-lib ,exp))
-    ((and (consp exp) (stringp (car exp)))
-       (mac-param-bind f (sym ver) exp
-         (sys:with-dyn-lib-check f e exp)
-         ^(dlvsym-checked sys:ffi-lib ,sym ,ver)))
-    (t exp)))
-
-(defun sys:analyze-argtypes (form argtypes)
-  (tree-bind (: ftypes vtypes) (split* argtypes (op where (op eq :)))
-    (when vtypes
-      (when (null ftypes)
-        (compile-error form "variadic with zero fixed arguments not allowed"))
-      (set vtypes
-           (collect-each ((vt vtypes))
-             (caseq vt
-               ((float) 'double)
-               ((be-float le-float)
-                (compile-error form "variadic argument cannot be of type ~s"
-                               vt))))))
-    (list* (+ (len ftypes) (len vtypes)) (len ftypes) (append ftypes vtypes))))
-
-
-(defmacro deffi (:form f :env e name fun-expr rettype argtypes)
-  (let ((fun-ref (sys:expand-sym-ref f e fun-expr))
-        (ret-type-sym (gensym "ret-type-"))
-        (arg-types-sym (gensym "arg-types-"))
-        (call-desc-sym (gensym "call-desc-"))
-        (fun-sym (gensym "ffi-fun-")))
-    (tree-bind (nargs nfixed . argtypes) (sys:analyze-argtypes f argtypes)
-      (let ((arg-syms (take nargs (gun (gensym)))))
-        ^(progn
-           (defvarl ,ret-type-sym (ffi-type-compile ',rettype))
-           (defvarl ,arg-types-sym [mapcar ffi-type-compile ',argtypes])
-           (defvarl ,call-desc-sym (ffi-make-call-desc ,nargs ,nfixed
-                                                       ,ret-type-sym
-                                                       ,arg-types-sym
-                                                       ',name))
-           (defvarl ,fun-sym ,fun-ref)
-           (defun ,name ,arg-syms
-             (ffi-call ,fun-sym ,call-desc-sym ,*arg-syms)))))))
-
-(defmacro deffi-type (name type-expr)
-  ^(ffi-typedef ',name (ffi-type-compile ',type-expr)))
-
-(defmacro typedef (name type-expr)
-  ^(ffi-typedef ',name (ffi-type-compile ',type-expr)))
-
-(defun sys:deffi-cb-expander (f name rettype argtypes safe-p abort-retval)
-  (let ((ret-type-sym (gensym "ret-type-"))
-        (arg-types-sym (gensym "arg-types-"))
-        (call-desc-sym (gensym "call-desc-"))
-        (fun-sym (gensym "fun-")))
-    (tree-bind (nargs nvariadic . argtypes) (sys:analyze-argtypes f argtypes)
-      ^(progn
-         (defvarl ,ret-type-sym (ffi-type-compile ',rettype))
-         (defvarl ,arg-types-sym [mapcar ffi-type-compile ',argtypes])
-         (defvarl ,call-desc-sym (ffi-make-call-desc ,nargs ,nvariadic
-                                                     ,ret-type-sym
-                                                     ,arg-types-sym
-                                                     ',name))
-         (defun ,name (,fun-sym)
-           [ffi-make-closure ,fun-sym ,call-desc-sym ,safe-p ,abort-retval])))))
-
-(defmacro deffi-cb (:form f name rettype argtypes : abort-retval)
-  (sys:deffi-cb-expander f name rettype argtypes t abort-retval))
-
-(defmacro deffi-cb-unsafe (:form f name rettype argtypes)
-  (sys:deffi-cb-expander f name rettype argtypes nil nil))
-
-(defmacro deffi-sym (:form f :env e name var-expr : type-sym)
-  (let ((var-ref (sys:expand-sym-ref f e var-expr)))
-    ^(defparml ,name ,(if type-sym
-                        ^(cptr-cast ',type-sym ,var-ref)
-                        var-ref))))
-
-(defmacro deffi-var (:form f :env e name var-expr type)
-  (let ((var-ref (sys:expand-sym-ref f e var-expr))
-        (type-sym (gensym "type-"))
-        (var-sym (gensym "var-")))
-    ^(progn
-       (defvarl ,type-sym (ffi ,type))
-       (defvarl ,var-sym (carray-cptr ,var-ref ,type-sym 1))
-       (defsymacro ,name (carray-ref ,var-sym 0)))))
-
-(defmacro deffi-struct (name . body)
-  ^(typedef ,name (struct ,name ,*body)))
-
-(defmacro deffi-union (name . body)
-  ^(typedef ,name (union ,name ,*body)))
-
-(defmacro sizeof (type : (obj nil obj-p) :env menv)
-  (if obj-p
-    (if (constantp obj menv)
-      (sys:dyn-size (ffi-type-compile type) obj)
-      ^(sys:dyn-size (load-time (ffi-type-compile ',type)) ,obj))
-    (ffi-size (ffi-type-compile type))))
-
-(defmacro alignof (type)
-  (ffi-alignof (ffi-type-compile type)))
-
-(defmacro offsetof (struct memb)
-  (ffi-offsetof (ffi-type-compile struct) memb))
-
-(defmacro arraysize (arr)
-  (ffi-arraysize (ffi-type-compile arr)))
-
-(defmacro elemtype (type)
-  ^(ffi-elemtype (ffi-type-compile ',type)))
-
-(defmacro elemsize (type)
-  (ffi-elemsize (ffi-type-compile type)))
-
-(defmacro ffi (type)
-  ^(ffi-type-compile ',type))
-
-(define-accessor carray-ref carray-refset)
-
-(defset carray-sub (carray : (from 0) (to t)) items
-  (with-gensyms (it)
-    ^(alet ((,it ,items))
-       (progn (carray-replace ,carray ,it ,from ,to) ,it))))
-
-(defset sub-buf (buf : (from 0) (to t)) items
-  (with-gensyms (it)
-    ^(alet ((,it ,items))
-       (progn (replace-buf ,buf ,it ,from ,to) ,it))))
-
-(defmacro znew (type . pairs)
-  (if (oddp (length pairs))
-    (throwf 'eval-error "~s: slot initform arguments must occur pairwise"
-            'znew))
-  (let ((qpairs (mappend (aret ^(',@1 ,@2)) (tuples 2 pairs))))
-    ^(make-zstruct (ffi ,type) ,*qpairs)))
diff --git a/share/txr/stdlib/getopts.tl b/share/txr/stdlib/getopts.tl
deleted file mode 100644
index 99ce9f9b..00000000
--- a/share/txr/stdlib/getopts.tl
+++ /dev/null
@@ -1,407 +0,0 @@
-;; Copyright 2016-2021
-;; Kaz Kylheku <kaz@kylheku.com>
-;; Vancouver, Canada
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are met:
-;;
-;; 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 BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(defex opt-error error)
-
-(defstruct opt-desc nil
-  short
-  long
-  helptext
-  arg-p
-  (type :bool)
-  (:static valid-types '(:bool :dec :hex :oct :cint :float :str :text))
-  (:postinit (me)
-    me.(check)
-    (set me.arg-p (neq me.type :bool))))
-
-(defstruct (sys:opt-parsed name arg desc : eff-type) nil
-  name
-  arg  ;; string, integer, real, ...
-  desc ;; opt-desc
-  eff-type
-  cumul
-  (:postinit (me) me.(convert-type)))
-
-(defstruct opts nil
-  (opt-hash (hash :equal-based)) ;; string to sys:opt-parsed
-  in-args
-  out-args)
-
-(defstruct sys:opt-processor nil
-  od-list
-  (od-hash (hash :equal-based)) ;; string to opt-desc
-  opts
-  (:postinit (me)
-    me.(build-hash)))
-
-(defun sys:opt-err (. args)
-  (throwf 'opt-error . args))
-
-(defun getopts-error (msg . args)
-  (error `~s: @msg` 'getopts . args))
-
-(defun sys:opt-dash (name)
-  `@(if (> (length name) 1) "-")-@name`)
-
-(defmeth opt-desc basic-type-p (me type)
-  (or (functionp type) (fboundp type) (member type me.valid-types)))
-
-(defmeth opt-desc list-type-p (me type)
-  (tree-case type
-    ((indicator btype) (and (eq indicator 'list)
-                            me.(basic-type-p btype)))
-    (x nil)))
-
-(defmeth opt-desc cumul-type-p (me type)
-  (tree-case type
-    ((indicator btype) (and (eq indicator 'usr:cumul)
-                            (or me.(basic-type-p btype)
-                                me.(list-type-p btype))))
-    (x nil)))
-
-(defmeth opt-desc check (me)
-  (unless (or me.(basic-type-p me.type)
-              me.(list-type-p me.type)
-              me.(cumul-type-p me.type))
-    (getopts-error "invalid option type specifier ~s"
-                   me.type))
-  (when me.long
-    (when (< (length me.long) 2)
-      (getopts-error "long option ~a has a short name" me.long))
-    (when (eql [me.long 0] #\-)
-      (getopts-error "long option ~a starts with - character" me.long)))
-  (when me.short
-    (when (neq (length me.short) 1)
-      (getopts-error "short option ~a not one character long" me.short))
-    (when (eql [me.short 0] #\-)
-      (getopts-error "short option ~a starts with - character" me.short))))
-
-(defmeth sys:opt-parsed convert-type (me)
-  (let ((name (sys:opt-dash me.name))
-        (type (or me.eff-type me.desc.type)))
-    (when (and (neq type :bool)
-               (eq me.arg :explicit-no))
-      (sys:opt-err "Non-Boolean option ~a explicitly specified as false" name))
-    (caseql type
-      (:bool
-        (set me.arg (neq me.arg :explicit-no)))
-      (:dec (set me.arg
-                 (or (and (r^$ #/[+\-]?\d+/ me.arg) (int-str me.arg))
-                     (sys:opt-err "option ~a needs decimal integer arg, not ~a"
-                              name me.arg))))
-      (:hex (set me.arg
-                 (or (and (r^$ #/[+\-]?[\da-fA-F]+/ me.arg) (int-str me.arg 16))
-                     (sys:opt-err "option ~a needs hexadecimal integer arg, not ~a"
-                              name me.arg))))
-      (:oct (set me.arg
-                 (or (and (r^$ #/[+\-]?[0-7]+/ me.arg) (int-str me.arg 8))
-                     (sys:opt-err "option ~a needs octal integer arg, not ~a"
-                              name me.arg))))
-      (:cint (set me.arg
-                  (cond
-                    ((r^$ #/[+\-]?0x[\da-fA-F]+/ me.arg)
-                     (int-str (regsub #/0x/ "" me.arg) 16))
-                    ((r^$ #/[+\-]?0[0-7]+/ me.arg)
-                     (int-str me.arg 8))
-                    ((r^$ #/[+\-]?0[\da-fA-F]+/ me.arg)
-                     (sys:opt-err "option ~a argument ~a non octal, but leading 0"
-                              name me.arg))
-                    ((r^$ #/[+\-]?\d+/ me.arg)
-                     (int-str me.arg))
-                    (t (sys:opt-err "option ~a needs C style numeric arg, not ~a"
-                                name me.arg)))))
-      (:float (set me.arg
-                   (cond
-                     ([[chand (orf (f^$ #/[+\-]?\d+[.]?([Ee][+\-]?\d+)?/)
-                                   (f^$ #/[+\-]?\d*[.]?\d+([Ee][+\-]?\d+)?/))
-                              flo-str] me.arg])
-                     (t (sys:opt-err "option ~a needs floating-point arg, not ~a"
-                                 name me.arg)))))
-      (:str (set me.arg
-                 (or (ignerr (read `"@{me.arg}"`))
-                     (sys:opt-err "option ~a needs string lit syntax, ~a given"
-                              name me.arg))))
-      (:text)
-      (t (cond
-           ((and (consp type) (eq (car type) 'list))
-              (let* ((rec-type (cadr type))
-                     (pieces (split-str me.arg #/,/))
-                     (sub-opts (mapcar (do new (sys:opt-parsed me.name @1
-                                                               me.desc
-                                                               rec-type))
-                                       pieces)))
-                (set me.arg (mapcar (usl arg) sub-opts))))
-           ((and (consp type) (eq (car type) 'cumul))
-              (let* ((rec-type (cadr type))
-                     (sub-opt (new (sys:opt-parsed me.name me.arg
-                                                   me.desc rec-type))))
-                (set me.arg sub-opt.arg
-                     me.cumul t)))
-           ((or (symbolp type) (functionp type))
-              (set me.arg (call type me.arg))))))))
-
-(defmeth opts lambda (me key : dfl)
-  (iflet ((o [me.opt-hash key])) o.arg dfl))
-
-(defmeth opts lambda-set (me key val)
-  (iflet ((o [me.opt-hash key]))
-    (set o.arg val)
-    (error "opts: cannot set option ~s to ~s: no such option" key val)))
-
-(defmeth opts add-opt (me opt)
-  (when opt.cumul
-    (let* ((old-opt [me.opt-hash (or opt.desc.long
-                                     opt.desc.short)])
-           (old-arg (if old-opt old-opt.arg)))
-      (set opt.arg (cons opt.arg old-arg))))
-  (whenlet ((n opt.desc.short))
-    (set [me.opt-hash n] opt))
-  (whenlet ((n opt.desc.long))
-    (set [me.opt-hash n] opt)))
-
-(defmeth sys:opt-processor build-hash (me)
-  (each ((od me.od-list))
-    (unless (or od.long od.short)
-      (error "opt-processor: no short or long name in option ~s" od))
-    (each ((str (list od.long od.short)))
-      (when (and str [me.od-hash str])
-        (error "opt-processor: duplicate option ~s" str))
-      (set [me.od-hash str] od))))
-
-(defmeth sys:opt-processor parse-long (me opt : arg)
-  (iflet ((ieq (unless (stringp arg) (break-str opt "="))))
-    (let ((oname [opt 0..ieq])
-          (arg [opt (succ ieq)..:]))
-      me.(parse-long oname arg))
-    (let ((od [me.od-hash opt])
-          (opts me.opts))
-      (cond
-        ((null od)
-           (sys:opt-err "unrecognized option: --~a" opt))
-        ((and arg od.arg-p)
-           opts.(add-opt (new (sys:opt-parsed opt arg od))))
-        ((stringp arg)
-           (sys:opt-err "option --~a doesn't take an argument" opt))
-        (od.arg-p
-           (iflet ((arg (pop opts.out-args)))
-             opts.(add-opt (new (sys:opt-parsed opt arg od)))
-             (sys:opt-err "option --~a requires an argument" opt)))
-        (t opts.(add-opt (new (sys:opt-parsed opt arg od))))))))
-
-(defmeth sys:opt-processor parse-shorts (me oarg)
-  (each ((o (split-str oarg #//)))
-    (iflet ((opts me.opts)
-            (od [me.od-hash o]))
-      (let ((arg (when od.arg-p
-                   (when (> (length oarg) 1)
-                     (sys:opt-err "argument -~a includes -~a, which does not clump"
-                                  oarg o))
-                 (unless opts.out-args
-                   (sys:opt-err "option -~a requires an argument" o))
-                 (pop opts.out-args))))
-        opts.(add-opt (new (sys:opt-parsed o arg od))))
-      (sys:opt-err "unrecognized option: -~a" o))))
-
-(defmeth sys:opt-processor parse-opts (me args)
-  (let ((opts me.opts))
-    (whilet ((arg (pop opts.out-args)))
-      (cond
-        ((equal "--" arg) (return))
-        ((r^ #/--no-/ arg) me.(parse-long [arg 5..:] :explicit-no))
-        ((r^ #/--/ arg) me.(parse-long [arg 2..:]))
-        ((r^ #/-.+/ arg) me.(parse-shorts [arg 1..:]))
-        (t (push arg opts.out-args)
-           (return))))
-    opts))
-
-(defun sys:wdwrap (string columns)
-  (let ((words (tok-str string #/\S+/))
-        line)
-    (build
-      (whilet ((word (pop words))
-               (wpart (cond
-                        ((and word (r^$ #/\w+[\w\-]*\w[.,;:!?"]?/ word))
-                           (split-str word #/-/))
-                        (word (list word))))
-               (wpart-orig wpart))
-        (whilet ((wp0 (eq wpart wpart-orig))
-                 (wp (pop wpart))
-                 (w (if wp `@wp@(if wpart "-")`)))
-          (cond
-            ((not line)
-               (set line w))
-            ((> (+ (length line) (length w) 1) columns)
-               (add line)
-               (set line w))
-            (t (set line `@line@(if wp0 " ")@w`)))))
-      (if line
-        (add line)))))
-
-(defun opt (short long : (type :bool) helptext)
-  (new opt-desc short short long long helptext helptext type type))
-
-(defun getopts (opt-desc-list args)
-  (let* ((opts (new opts in-args args out-args args))
-         (opr (new sys:opt-processor od-list opt-desc-list opts opts)))
-    opr.(parse-opts args)))
-
-(defun opthelp (opt-desc-list : (stream *stdout*))
-  (let ((sorted [nsort (copy-list (remove-if (op null @1.helptext)
-                                             opt-desc-list)) :
-                       (do if @1.long @1.long @1.short)])
-        (undocumented (keep-if (op null @1.helptext) opt-desc-list)))
-    (put-line "\nOptions:\n")
-    (each ((od sorted))
-      (let* ((type (if (and (consp od.type) (eq (car od.type) 'cumul))
-                     (cadr od.type)
-                     od.type))
-             (tstr (cond
-                     ((keywordp type) (upcase-str (symbol-name type)))
-                     ((and (consp type) (eq (car type) 'list))
-                        (let ((ts (upcase-str (symbol-name (cadr type)))))
-                          `@ts[,@ts...]`))
-                     (t "ARG")))
-             (long (if od.long
-                     `--@{od.long}@(if od.arg-p `=@tstr`)`))
-             (short (if od.short
-                      `-@{od.short}@(if od.arg-p ` @tstr`)`))
-             (ls (cond
-                   ((and long short) `@{long 21} (@short)`)
-                   (long long)
-                   (short `@{"" 21}  @short`)))
-             (lines (if od.helptext  (sys:wdwrap od.helptext 43))))
-        (put-line `  @{ls 34}@(pop lines)`)
-        (while lines
-          (put-line `  @{"" 34}@(pop lines)`))))
-    (put-line)
-    (when undocumented
-      (put-line "Undocumented options:\n")
-      (let* ((undoc-str `@{[mapcar sys:opt-dash
-                                   (flatten (mappend (op list @1.short @1.long)
-                                                     undocumented))] ", "}`))
-        (each ((line (sys:wdwrap undoc-str 75)))
-          (put-line `    @line`)))
-      (put-line))
-    (put-line "Notes:\n")
-    (let* ((have-short (some sorted (usl short)))
-           (have-long (some sorted (usl long)))
-           (have-arg-p (some sorted (usl arg-p)))
-           (have-bool (some sorted (op eq @1.type :bool)))
-           (texts (list (if have-short
-                          "Short options can be invoked with long syntax: \ \
-                           for example, --a can be used when -a exists.\ \
-                           Short no-argument options can be clumped into\ \
-                           one argument as exemplified by -xyz.")
-                        (if have-bool
-                          (if have-arg-p
-                            "Options that take no argument are Boolean:"
-                            (if undocumented
-                              "All documented options are Boolean:"
-                              "All options are Boolean:")))
-                        (if have-bool
-                          "they are true when present, false when absent.")
-                        (if (and have-bool have-arg-p)
-                          "The --no- prefix can explicitly specify \ \
-                           Boolean options as false: if a Boolean option\ \
-                           X exists,\ \
-                           --no-X specifies it as false. This is useful\ \
-                           for making false those options which default\ \
-                           to true. "
-                          "The --no- prefix can explicitly specify \ \
-                           options as false: if an X option exists,\ \
-                           --no-X specifies it as false. This is useful\ \
-                           for making false those options which default\ \
-                           to true. ")
-                        (if (not have-long)
-                          "Note the double dash on --no.")
-                        (if (and have-short have-long)
-                          "The --no- prefix can be applied to a short\ \
-                           or long option name.")
-                        (if have-arg-p
-                          "The argument to a long option can be given in one\ \
-                           argument as --option=arg or as a separate\ \
-                           argument using --option arg.")
-                        "The special argument -- can be used where an option\ \
-                        may appear. It means \"end of options\": the\ \
-                        arguments which follow are not treated as options\ \
-                        even if they look like options.")))
-      (mapdo (do put-line `  @1`)
-             (sys:wdwrap `@{(flatten texts)}` 77)))
-    (put-line)
-    (whenlet ((types (keep-if [andf keywordp (op neq :bool)]
-                              (uniq (mapcar (usl type) sorted)))))
-      (put-line "Type legend:\n")
-      (each ((ty types))
-        (iflet ((ln (caseql ty
-                      (:dec   "  DEC    - Decimal integer: -123, 0, 5, +73")
-                      (:hex   "  HEX    - Hexadecimal integer -EF, 2D0, +9A")
-                      (:oct   "  OCT    - Octal integer: -773, 5677, +326")
-                      (:cint  "  CINT   - C-style integer: leading 0 octal,\
-                              \ leading 0x hex, else decimal;\n\
-                              \           leading sign allowed: -0777, 0xFDC, +123")
-                      (:float "  FLOAT  - Floating-point: -1.3e+03, +5, 3.3,\
-                              \ 3., .5, .12e9, 53.e-3, 3e-015")
-                      (:str   "  STR    - String with embedded escapes, valid\
-                              \ as TXR Lisp string literals\n\
-                              \           syntax: foo, foo\\tbar, abc\\nxyz")
-                      (:text  "  TEXT   - Unprocessed text"))))
-           (put-line ln)))
-    (put-line))))
-
-
-(defstruct sys:option-base nil
-  in-args
-  out-args
-  (:static slot-hash)
-  (:static opt-desc-list)
-  (:method add-opt (me opt)
-    (let* ((sl [me.slot-hash (or opt.desc.long opt.desc.short)])
-           (arg (if opt.cumul
-                  (cons opt.arg (slot me sl))
-                  opt.arg)))
-      (slotset me sl arg)))
-  (:method getopts (me args)
-    (set me.in-args args me.out-args args)
-    (let ((opr (new sys:opt-processor od-list me.opt-desc-list opts me)))
-      opr.(parse-opts args)))
-  (:method opthelp (me : (stream *stdout*))
-    (opthelp me.opt-desc-list stream)))
-
-(defmacro define-option-struct (name super-spec . opts)
-  (let* ((slots (mapcar (tb ((short long . rest))
-                          (or long short))
-                        opts))
-         (supers (if (and super-spec (atom super-spec))
-                   (list super-spec)
-                   super-spec)))
-    ^(defstruct ,name (,*supers sys:option-base)
-       ,*slots
-       (:static slot-hash #H(() ,*(mapcar [juxt symbol-name identity] slots)))
-       (:static opt-desc-list ',(mapcar (tb ((short long . rest))
-                                          (opt (if short (symbol-name short))
-                                               (if long (symbol-name long))
-                                               . rest))
-                                        opts)))))
diff --git a/share/txr/stdlib/getput.tl b/share/txr/stdlib/getput.tl
deleted file mode 100644
index 13ffba4b..00000000
--- a/share/txr/stdlib/getput.tl
+++ /dev/null
@@ -1,188 +0,0 @@
-;; Copyright 2016-2021
-;; Kaz Kylheku <kaz@kylheku.com>
-;; Vancouver, Canada
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are met:
-;;
-;; 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 BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(defun sys:get-buf-common (s bytes seek)
-  (let ((b (make-buf 0 0 (min bytes 4096)))
-        (o 0))
-    (when (plusp seek)
-      (unless (ignerr (seek-stream s seek :from-current))
-        (let ((b (make-buf (min seek 4096)))
-              (c 0))
-          (while (< c seek)
-            (let ((p (fill-buf b 0 s)))
-              (if (zerop p)
-                (return))
-              (inc c p))))))
-    (while (or (null bytes) (< (len b) bytes))
-      (let ((p (fill-buf-adjust b o s)))
-        (when (= p o)
-          (return))
-        (set o p)
-        (when (eql p (buf-alloc-size b))
-          (buf-set-length b (min (+ p p) bytes)))))
-    b))
-
-(defun get-jsons (: (s *stdin*))
-  (when (stringp s)
-    (set s (make-string-byte-input-stream s)))
-  (build
-    (catch*
-      (while t
-        (add (get-json s)))
-      (syntax-error (type . args)
-        (if (parse-errors s)
-          (throw type . args))))))
-
-(defun put-jsons (list : (s *stdout*) flat-p)
-  (each ((obj list))
-    (put-jsonl obj s flat-p))
-  t)
-
-(defun file-get (name)
-  (with-stream (s (open-file name))
-    (read s)))
-
-(defun file-put (name obj)
-  (with-stream (s (open-file name "w"))
-    (prinl obj s)))
-
-(defun file-append (name obj)
-  (with-stream (s (open-file name "a"))
-    (prinl obj s)))
-
-(defun file-get-string (name)
-  (with-stream (s (open-file name))
-    (get-string s)))
-
-(defun file-put-string (name string)
-  (with-stream (s (open-file name "w"))
-    (put-string string s)))
-
-(defun file-append-string (name string)
-  (with-stream (s (open-file name "a"))
-    (put-string string s)))
-
-(defun file-get-lines (name)
-  (get-lines (open-file name)))
-
-(defun file-put-lines (name lines)
-  (with-stream (s (open-file name "w"))
-    (put-lines lines s)))
-
-(defun file-append-lines (name lines)
-  (with-stream (s (open-file name "a"))
-    (put-lines lines s)))
-
-(defun file-get-buf (name : bytes (seek 0))
-  (with-stream (s (open-file name "rb"))
-    (sys:get-buf-common s bytes seek)))
-
-(defun file-put-buf (name buf : (seek 0))
-  (with-stream (s (open-file name "wb"))
-    (unless (zerop seek)
-      (seek-stream s seek :from-current))
-    (put-buf buf 0 s)))
-
-(defun file-place-buf (name buf : (seek 0))
-  (with-stream (s (open-file name "mb"))
-    (unless (zerop seek)
-      (seek-stream s seek :from-current))
-    (put-buf buf 0 s)))
-
-(defun file-append-buf (name buf)
-  (with-stream (s (open-file name "ab"))
-    (put-buf buf 0 s)))
-
-(defun file-get-json (name)
-  (with-stream (s (open-file name))
-    (get-json s)))
-
-(defun file-put-json (name obj : flat-p)
-  (with-stream (s (open-file name "w"))
-    (put-jsonl obj s flat-p)))
-
-(defun file-append-json (name obj : flat-p)
-  (with-stream (s (open-file name "a"))
-    (put-jsonl obj s flat-p)))
-
-(defun file-get-jsons (name)
-  (with-stream (s (open-file name))
-    (get-jsons s)))
-
-(defun file-put-jsons (name seq : flat-p)
-  (with-stream (s (open-file name "w"))
-    (put-jsons seq s flat-p)))
-
-(defun file-append-jsons (name seq : flat-p)
-  (with-stream (s (open-file name "a"))
-    (put-jsons s seq flat-p)))
-
-(defun command-get (cmd)
-  (with-stream (s (open-command cmd))
-    (read s)))
-
-(defun command-put (cmd obj)
-  (with-stream (s (open-command cmd "w"))
-    (prinl obj s)))
-
-(defun command-get-string (cmd)
-  (with-stream (s (open-command cmd))
-    (get-string s)))
-
-(defun command-put-string (cmd string)
-  (with-stream (s (open-command cmd "w"))
-    (put-string string s)))
-
-(defun command-get-lines (cmd)
-  (get-lines (open-command cmd)))
-
-(defun command-put-lines (cmd lines)
-  (with-stream (s (open-command cmd "w"))
-    (put-lines lines s)))
-
-(defun command-get-buf (cmd : bytes (skip 0))
-  (with-stream (s (open-command cmd "rb"))
-    (sys:get-buf-common s bytes skip)))
-
-(defun command-put-buf (cmd buf)
-  (with-stream (s (open-command cmd "wb"))
-    (put-buf buf 0 s)))
-
-(defun command-get-json (cmd)
-  (with-stream (s (open-command cmd))
-    (get-json s)))
-
-(defun command-put-json (cmd obj : flat-p)
-  (with-stream (s (open-command cmd "w"))
-    (put-jsonl obj s flat-p)))
-
-(defun command-get-jsons (cmd)
-  (with-stream (s (open-command cmd))
-    (get-jsons s)))
-
-(defun command-put-jsons (cmd seq : flat-p)
-  (with-stream (s (open-command cmd "w"))
-    (put-jsons seq s flat-p)))
diff --git a/share/txr/stdlib/hash.tl b/share/txr/stdlib/hash.tl
deleted file mode 100644
index b9010500..00000000
--- a/share/txr/stdlib/hash.tl
+++ /dev/null
@@ -1,42 +0,0 @@
-;; Copyright 2015-2021
-;; Kaz Kylheku <kaz@kylheku.com>
-;; Vancouver, Canada
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are met:
-;;
-;; 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 BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(defmacro with-hash-iter ((name hash-form : key val) . body)
-  (let ((hash (gensym))
-        (iter (gensym))
-        (next (gensym)))
-    ^(let* ((,hash ,hash-form)
-            (,iter (hash-begin ,hash))
-            ,*(if key ^((,key)))
-            ,*(if val ^((,val))))
-       (flet ((,name ()
-                ,(if (not (or key val))
-                   ^(hash-next ,iter)
-                   ^(let ((,next (hash-next ,iter)))
-                      ,*(if key ^((set ,key (car ,next))))
-                      ,*(if val ^((set ,val (cdr ,next))))
-                      ,next))))
-         ,*body))))
diff --git a/share/txr/stdlib/ifa.tl b/share/txr/stdlib/ifa.tl
deleted file mode 100644
index f643cf92..00000000
--- a/share/txr/stdlib/ifa.tl
+++ /dev/null
@@ -1,82 +0,0 @@
-;; Copyright 2015-2021
-;; Kaz Kylheku <kaz@kylheku.com>
-;; Vancouver, Canada
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are met:
-;;
-;; 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 BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(defmacro ifa (:env e :form f test then : else)
-  (flet ((candidate-p (form)
-           (not (or (constantp form e) (symbolp form)))))
-    (cond
-      ((or (atom test) (null (cdr test))) ^(let ((it ,test))
-                                             (if it ,then ,else)))
-      ((member (first test) '(not null false))
-       (unless (eql (length test) 2)
-         (compile-error f "wrong number of arguments to ~s" (first test)))
-       ^(ifa ,(second test) ,else ,then))
-      (t (let* ((sym (first test))
-                (args (if (eq 'dwim sym) (cddr test) (cdr test)))
-                (n-candidate-args [count-if candidate-p args])
-                (pos-candidate (or [pos-if candidate-p args] 0)))
-           (unless (or (lexical-fun-p e sym)
-                       (and (or (functionp (symbol-function sym))
-                                (eq sym 'dwim)
-                                (null (symbol-function sym)))))
-             (compile-error f "test expression must be \
-                              \ a simple function call"))
-           (when (> n-candidate-args 1)
-             (compile-error f "ambiguous situation: \
-                              \ not clear what can be \"it\""))
-           (iflet ((it-form (macroexpand [args pos-candidate] e))
-                   (is-place (place-form-p it-form e)))
-             (let ((before-it [args 0..pos-candidate])
-                   (after-it [args (succ pos-candidate)..:]))
-               (let* ((btemps (mapcar (ret (gensym)) before-it))
-                      (atemps (mapcar (ret (gensym)) after-it)))
-                 ^(let (,*(zip btemps before-it))
-                    (placelet ((it ,it-form))
-                      (let (,*(zip atemps after-it))
-                        (if (,sym ,*(if (eq 'dwim sym) ^(,(second test)))
-                                  ,*btemps it ,*atemps)
-                          ,then ,else))))))
-             (let* ((temps (mapcar (ret (gensym)) args))
-                    (it-temp [temps pos-candidate]))
-               ^(let* (,*(zip temps args) (it ,it-temp))
-                  (if (,sym ,*(if (eq 'dwim sym) ^(,(second test)))
-                            ,*temps) ,then ,else)))))))))
-
-(defmacro whena (test . body)
-  ^(ifa ,test (progn ,*body)))
-
-(defun sys:if-to-cond (f if-oper cond-oper pairs)
-  (tree-case pairs
-    (((test . forms) . rest) ^(,if-oper ,test (progn ,*forms)
-                                        (,cond-oper ,*rest)))
-    (() ())
-    (else (compile-error f "bad syntax: ~s" pairs))))
-
-(defmacro conda (:form f . pairs)
-  (sys:if-to-cond f 'ifa 'conda pairs))
-
-(defmacro condlet (:form f . pairs)
-  (sys:if-to-cond f 'iflet 'condlet pairs))
diff --git a/share/txr/stdlib/keyparams.tl b/share/txr/stdlib/keyparams.tl
deleted file mode 100644
index e1eba2d0..00000000
--- a/share/txr/stdlib/keyparams.tl
+++ /dev/null
@@ -1,90 +0,0 @@
-;; Copyright 2017-2021
-;; Kaz Kylheku <kaz@kylheku.com>
-;; Vancouver, Canada
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are met:
-;;
-;; 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 BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(defun sys:extract-keys (keys args)
-  (build
-    (each ((k keys))
-      (iflet ((f (memp (car k) args)))
-        (add (cadr f))
-        (add (cdr k))))))
-
-(defun sys:extract-keys-p (keys args)
-  (build
-    (each ((k keys))
-      (add (if (memp k args) t)))))
-
-(defun sys:build-key-list-expr (key-params menv)
-  (let ((exprs (collect-each ((kp key-params))
-                 (let ((kw (intern (symbol-name (first kp)) 'keyword))
-                       (ex (second kp)))
-                   (if (constantp ex menv)
-                     ^(quote (,kw . ,(second kp)))
-                     ^(cons ,kw ,(second kp)))))))
-    (if [all exprs (op eq 'quote) car]
-      ^(quote ,[mapcar cadr exprs])
-      ^(list ,*exprs))))
-
-(define-param-expander :key (param body menv form)
-  (let* ((excluding-rest (butlastn 0 param))
-         (key-start (memq '-- excluding-rest))
-         (rest-param (or (nthlast 0 param) (gensym)))
-         (before-key (ldiff excluding-rest key-start))
-         (key-params-raw (butlastn 0 (cdr key-start)))
-         (key-params [mapcar [iffi atom (op list @1)] key-params-raw])
-         (eff-param (append before-key rest-param)))
-    (each ((key-spec key-params))
-      (tree-case key-spec
-        ((sym init var-p . junk)
-         (when (consp junk)
-           (compile-error form "superfluous forms in ~s" key-spec))
-         (when junk
-           (compile-error form "invalid dotted form ~s" key-spec))
-         (unless (bindable var-p)
-           (compile-error form "~s isn't a bindable symbol" var-p))
-         :)
-        ((sym init . more)
-         (unless (listp more)
-           (compile-error form "invalid dotted form ~s" key-spec))
-         :)
-        ((sym . more)
-         (unless (listp more)
-           (compile-error form "invalid dotted form ~s" key-spec))
-         (unless (bindable sym)
-           (compile-error form "~s isn't a bindable symbol" sym)))))
-    (let* ((key-params-p [keep-if third key-params])
-           (key-vars [mapcar first key-params])
-           (key-vars-p [mapcar third key-params-p])
-           (keys (sys:build-key-list-expr key-params menv))
-           (keys-p (mapcar (op intern (symbol-name (first @1)) 'keyword)
-                           key-params-p)))
-      (list eff-param
-            ^(tree-bind ,key-vars
-                        (sys:extract-keys ,keys ,rest-param)
-               ,*(if keys-p
-                   ^((tree-bind ,key-vars-p
-                                (sys:extract-keys-p ',keys-p ,rest-param)
-                        ,*body))
-                   body))))))
diff --git a/share/txr/stdlib/match.tl b/share/txr/stdlib/match.tl
deleted file mode 100644
index 3502688b..00000000
--- a/share/txr/stdlib/match.tl
+++ /dev/null
@@ -1,1070 +0,0 @@
-;; Copyright 2021
-;; Kaz Kylheku <kaz@kylheku.com>
-;; Vancouver, Canada
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are met:
-;;
-;; 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 BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(defvar *match-form*)
-
-(defvar *match-macro* (hash))
-
-(defstruct match-guard ()
-  temps
-  vars
-  var-exprs
-  pure-temps
-  pure-temp-exprs
-  (guard-expr t)
-  (test-expr t)
-
-  (:method assignments (me)
-    (mapcar (op list 'set) me.vars me.var-exprs))
-
-  (:method lets (me)
-    (zip me.pure-temps me.pure-temp-exprs))
-
-  (:method wrap-expr (g exp)
-    (let ((lets g.(lets))
-          (temps g.temps))
-      (if (neq t g.test-expr)
-        (set exp ^(if ,g.test-expr ,exp)))
-      (cond
-        ((and lets temps)
-         (set exp ^(alet ,lets
-                     (let ,temps
-                       ,*g.(assignments)
-                       ,exp))))
-        (lets
-          (set exp ^(alet ,lets
-                      ,*g.(assignments)
-                      ,exp)))
-        (temps
-          (set exp ^(let ,temps
-                      ,*g.(assignments)
-                      ,exp)))
-        (t
-          (set exp ^(progn ,*g.(assignments)
-                      ,exp))))
-      (when (neq t g.guard-expr)
-        (set exp ^(if ,g.guard-expr ,exp)))
-      exp)))
-
-(defstruct guard-disjunction ()
-  guard-chains
-  sub-patterns
-  all-vars
-
-  (:method wrap-expr (g exp)
-    (let* ((vars [mapcar get-vars g.guard-chains])
-           (back-vars (cons nil
-                            (reverse
-                              [mapcar (ap append) (conses (reverse vars))])))
-           (branches (collect-each ((gc g.guard-chains)
-                                    (v vars)
-                                    (bv back-vars))
-                       ^(progn
-                          (set ,*(mappend (ret ^(,@1 nil)) (diff bv v)))
-                          ,(reduce-right (umeth wrap-expr) gc t)))))
-      (set exp ^(when (or ,*branches)
-                  ,exp))
-      exp)))
-
-(defstruct compiled-match ()
-  pattern
-  obj-var
-  guard-chain
-
-  (:method get-vars (me)
-    (uniq (get-vars me.guard-chain)))
-
-  (:method wrap-guards (me . forms)
-    (reduce-right (umeth wrap-expr) me.guard-chain ^(progn ,*forms)))
-
-  (:method add-guard-pre (me guard)
-    (push guard me.guard-chain))
-
-  (:method add-guards-pre (me . guards)
-    (set me.guard-chain
-         (append guards
-                 me.guard-chain)))
-
-  (:method add-guards-post (me . guards)
-    (set me.guard-chain
-         (append me.guard-chain
-                 guards))))
-
-(defstruct var-list ()
-  vars
-  menv
-
-  (:method exists (me sym) (or (member sym me.vars)
-                               (lexical-var-p me.menv sym)
-                               (boundp sym)))
-  (:method record (me sym) (push sym me.vars))
-  (:method merge (me copy) (each ((v copy.vars)) (pushnew v me.vars))))
-
-(defun get-vars (guard-chain)
-  (append-each ((g guard-chain))
-    (typecase g
-      (match-guard
-        g.vars)
-      (guard-disjunction
-        (append-each ((gc g.guard-chains)) (get-vars gc)))
-      (t (compile-error *match-form*
-                        "internal error: bad guard ~s" g)))))
-
-(defun compile-struct-match (struct-pat obj-var var-list)
-  (mac-param-bind *match-form* (op required-type . pairs) struct-pat
-    (let* ((loose-p (not (bindable required-type)))
-           (slot-pairs (plist-to-alist pairs))
-           (required-slots [mapcar car slot-pairs])
-           (slot-gensyms [mapcar gensym required-slots])
-           (type-gensym (if loose-p
-                          (gensym "type-")))
-           (slot-patterns [mapcar cdr slot-pairs])
-           (slot-matches [mapcar (lop compile-match var-list)
-                                 slot-patterns slot-gensyms])
-           (type-match (if loose-p
-                         (compile-match required-type type-gensym var-list)))
-           (slot-val-exprs [mapcar (ret ^(slot ,obj-var ',@1)) required-slots])
-           (guard0 (if loose-p
-                     (list (new match-guard
-                                pure-temps (list type-gensym)
-                                pure-temp-exprs (list ^(struct-type ,obj-var))
-                                guard-expr ^(structp ,obj-var)))))
-           (guard1 (list (new match-guard
-                              pure-temps slot-gensyms
-                              pure-temp-exprs slot-val-exprs
-                              guard-expr (if loose-p
-                                           ^(and ,*(mapcar
-                                                     (ret ^(slotp ,type-gensym
-                                                                  ',@1))
-                                               required-slots))
-                                     ^(subtypep (typeof ,obj-var)
-                                                ',required-type))))))
-      (unless loose-p
-        (let ((type (find-struct-type required-type)))
-          (if type
-            (each ((slot required-slots))
-              (unless (slotp type slot)
-                (compile-defr-warning *match-form* ^(slot . ,slot)
-                                      "~s has no slot ~s"
-                                      required-type slot)))
-            (compile-defr-warning *match-form* ^(struct-type . ,required-type)
-                                  "no such struct type: ~s"
-                                  required-type))))
-      (new compiled-match
-           pattern struct-pat
-           obj-var obj-var
-           guard-chain (append guard0
-                               type-match.?guard-chain
-                               guard1
-                               (mappend .guard-chain slot-matches))))))
-
-(defun compile-var-match (sym obj-var var-list)
-  (cond
-    ((null sym)
-       (new compiled-match
-            obj-var obj-var))
-    ((not (bindable sym))
-       (compile-error *match-form* "~s is not a bindable symbol" sym))
-    ((not var-list.(exists sym))
-       var-list.(record sym)
-       (new compiled-match
-            pattern sym
-            obj-var obj-var
-            guard-chain (if sym (list (new match-guard
-                                           vars (list sym)
-                                           var-exprs (list obj-var))))))
-    (t (new compiled-match
-            pattern sym
-            obj-var obj-var
-            guard-chain (list (new match-guard
-                                   guard-expr ^(equal ,obj-var ,sym)))))))
-
-(defun compile-new-var-match (sym obj-var var-list)
-  (cond
-    ((null sym)
-       (new compiled-match
-            obj-var obj-var))
-    ((not (bindable sym))
-       (compile-error *match-form* "~s is not a bindable symbol" sym))
-    (t var-list.(record sym)
-       (new compiled-match
-            pattern sym
-            obj-var obj-var
-            guard-chain (if sym (list (new match-guard
-                                           vars (list sym)
-                                           var-exprs (list obj-var))))))))
-
-(defun compile-vec-match (vec-pat obj-var var-list)
-  (let* ((elem-gensyms (mapcar (op gensym `elem-@1-`) (range* 0 (len vec-pat))))
-         (elem-exprs (mapcar (ret ^[,obj-var ,@1]) (range* 0 (len vec-pat))))
-         (elem-matches (list-vec [mapcar (lop compile-match var-list)
-                                         vec-pat elem-gensyms])) 
-         (pruned-triple (multi (op keep-if .guard-chain @1 third)
-                               elem-gensyms
-                               elem-exprs
-                               elem-matches))
-         (guard (new match-guard
-                     pure-temps (first pruned-triple)
-                     pure-temp-exprs (second pruned-triple)
-                     guard-expr ^(and (vectorp ,obj-var)
-                                      (eql (len ,obj-var) ,(len vec-pat))))))
-    (new compiled-match
-         pattern vec-pat
-         obj-var obj-var
-         guard-chain (cons guard (mappend .guard-chain elem-matches)))))
-
-(defun compile-range-match (range-expr obj-var var-list)
-  (let ((from (from range-expr))
-        (to (to range-expr)))
-    (let* ((from-match (compile-match from (gensym "from") var-list))
-           (to-match (compile-match to (gensym "to") var-list))
-           (guard (new match-guard
-                       guard-expr ^(rangep ,obj-var)
-                       pure-temps (list from-match.obj-var to-match.obj-var)
-                       pure-temp-exprs (list ^(from ,obj-var) ^(to ,obj-var)))))
-      (new compiled-match
-           pattern range-expr
-           obj-var obj-var
-           guard-chain (cons guard (append from-match.guard-chain
-                                           to-match.guard-chain))))))
-
-(defun compile-atom-match (atom obj-var var-list)
-  (flet ((compile-as-atom ()
-           (new compiled-match
-                pattern atom
-                obj-var obj-var
-                guard-chain (list (new match-guard
-                                       guard-expr ^(equal ,obj-var ',atom))))))
-    (typecase atom
-      (vec (if (non-triv-pat-p atom)
-             (compile-vec-match atom obj-var var-list)
-             (compile-as-atom)))
-      (range (if (non-triv-pat-p atom)
-               (compile-range-match atom obj-var var-list)
-               (compile-as-atom)))
-      (t (compile-as-atom)))))
-
-(defun compile-predicate-match (exp obj-var var-list)
-  (let ((head (car exp)))
-    (if (and (consp head) (eq (car head) 'sys:var))
-      (tree-case exp
-        (((sv rvar) (op . args))
-         (let* ((avar
-                  (condlet
-                    (((vm (member-if [andf consp (op eq (car @1) 'sys:var)]
-                                     args)))
-                     (let ((sym (cadar vm)))
-                       (set args (append (ldiff args vm)
-                                         (list sym)
-                                         (cdr vm)))
-                       sym))
-                    (((vm (memq 'sys:var args)))
-                     (let ((sym (cadr vm)))
-                       (set args (append (ldiff args vm) sym))
-                       sym))))
-                (res-var (gensym "res-"))
-                (arg-var (if avar avar (gensym "obj-"))))
-           (unless avar
-             (set args (append args (list arg-var))))
-           (let* ((guard (new match-guard
-                              pure-temps (list res-var)
-                              pure-temp-exprs ^((alet ((,arg-var ,obj-var))
-                                                  (,op ,*args)))
-                              test-expr res-var))
-                  (avar-match (compile-var-match avar obj-var var-list))
-                  (rvar-match (compile-var-match rvar res-var var-list)))
-             (new compiled-match
-                  pattern exp
-                  obj-var obj-var
-                  guard-chain  (append avar-match.guard-chain
-                                       (list guard)
-                                       rvar-match.guard-chain)))))
-        (els (compile-error *match-form* "invalid predicate syntax: ~s" exp)))
-      (compile-predicate-match (list '@nil exp) obj-var var-list))))
-
-(defun compile-cons-structure (cons-pat obj-var var-list)
-  (mac-param-bind *match-form* (car . cdr) cons-pat
-    (let* ((car-gensym (gensym))
-           (cdr-gensym (gensym))
-           (car-match (compile-match car car-gensym var-list))
-           (cdr-match (if (consp cdr)
-                        (caseq (car cdr)
-                          ((sys:expr sys:var sys:quasi)
-                             (compile-match cdr cdr-gensym var-list))
-                          (t (compile-cons-structure cdr cdr-gensym var-list)))
-                        (compile-atom-match cdr cdr-gensym var-list)))
-           (guard (new match-guard
-                       pure-temps (append (if car-match.guard-chain
-                                            (list car-gensym))
-                                          (if cdr-match.guard-chain
-                                            (list cdr-gensym)))
-                       pure-temp-exprs (append (if car-match.guard-chain
-                                                 ^((car ,obj-var)))
-                                               (if cdr-match.guard-chain
-                                                 ^((cdr ,obj-var))))
-                       guard-expr ^(consp ,obj-var))))
-      (new compiled-match
-           pattern cons-pat
-           obj-var obj-var
-           guard-chain (cons guard (append car-match.guard-chain
-                                           cdr-match.guard-chain))))))
-
-(defun compile-require-match (exp obj-var var-list)
-  (mac-param-bind *match-form* (op match . conditions) exp
-    (let ((match (compile-match match obj-var var-list)))
-      match.(add-guards-post (new match-guard
-                                  guard-expr ^(and ,*conditions)))
-      match)))
-
-(defun compile-as-match (exp obj-var var-list)
-  (mac-param-bind *match-form* (op sym pat) exp
-    (let ((var-match (compile-new-var-match sym obj-var var-list))
-          (pat-match (compile-match pat obj-var var-list)))
-      (new compiled-match
-           pattern exp
-           obj-var obj-var
-           guard-chain (append var-match.guard-chain
-                               pat-match.guard-chain)))))
-
-(defun compile-with-match (exp obj-var var-list)
-  (tree-case exp
-    ((op main-pat side-pat-var side-expr)
-       (let* ((side-var (gensym))
-              (side-pat (if (or (null side-pat-var) (bindable side-pat-var))
-                          ^(sys:var ,side-pat-var)
-                          side-pat-var))
-              (main-match (compile-match main-pat obj-var var-list))
-              (side-match (compile-match side-pat side-var var-list))
-              (guard (new match-guard
-                          pure-temps (list side-var)
-                          pure-temp-exprs (list side-expr))))
-         (new compiled-match
-              pattern exp
-              obj-var obj-var
-              guard-chain (append main-match.guard-chain
-                                  (list guard)
-                                  side-match.guard-chain))))
-    ((op side-pat-var side-expr)
-       (compile-with-match ^(,op @nil ,side-pat-var ,side-expr) obj-var var-list))
-    (x (compile-error *match-form* "bad syntax: ~s" exp))))
-
-(defun compile-loop-match (exp obj-var var-list)
-  (mac-param-bind *match-form* (op match) exp
-    (let* ((no-vac-p (memq op '(coll usr:all*)))
-           (some-p (eq op 'some))
-           (coll-p (eq op 'coll))
-           (item-var (gensym "item-"))
-           (in-vars var-list.vars)
-           (cm (compile-match match item-var var-list))
-           (loop-success-p-var (gensym "loop-success-p-"))
-           (loop-continue-p-var (gensym "loop-terminate-p"))
-           (loop-iterated-var (if no-vac-p (gensym "loop-iterated-p")))
-           (matched-p-var (gensym "matched-p-"))
-           (iter-var (gensym "iter-"))
-           (cm-vars cm.(get-vars))
-           (collect-vars (diff cm-vars in-vars))
-           (collect-gens [mapcar gensym collect-vars])
-           (loop ^(for ((,iter-var (iter-begin ,obj-var))
-                        (,loop-continue-p-var t)
-                        ,*(if no-vac-p ^((,loop-iterated-var nil))))
-                       ((and ,loop-continue-p-var (iter-more ,iter-var))
-                        ,(cond
-                           (some-p ^(not ,loop-continue-p-var))
-                           (no-vac-p ^(and ,loop-iterated-var
-                                         ,loop-continue-p-var))
-                           (t loop-continue-p-var)))
-                       ((set ,iter-var (iter-step ,iter-var)))
-                    (let ((,cm.obj-var (iter-item ,iter-var))
-                          ,matched-p-var
-                          ,*(unless some-p cm-vars))
-                      ,cm.(wrap-guards
-                            ^(progn
-                               (set ,matched-p-var t)
-                               ,*(if no-vac-p
-                                   ^((set ,loop-iterated-var t)))
-                               ,*(unless some-p
-                                   (mapcar (ret ^(push ,@1 ,@2))
-                                           collect-vars
-                                           collect-gens))))
-                      ,(unless coll-p ^(,(if some-p 'when 'unless)
-                                         ,matched-p-var
-                                         (set ,loop-continue-p-var nil))))))
-           (guard0 (new match-guard
-                        vars cm-vars
-                        temps (unless some-p collect-gens)
-                        guard-expr ^(seqp ,obj-var)))
-           (guard1 (new match-guard
-                        vars (list loop-success-p-var)
-                        var-exprs (list loop)
-                        test-expr (if some-p
-                                    loop-success-p-var
-                                    ^(when ,loop-success-p-var
-                                       ,*(mapcar (ret ^(set ,@1 (nreverse ,@2)))
-                                                 collect-vars collect-gens)
-                                       t)))))
-      (new compiled-match
-           pattern exp
-           obj-var obj-var
-           guard-chain (list guard0 guard1)))))
-
-(defun compile-or-match (par-pat obj-var var-list)
-  (mac-param-bind *match-form* (op . pats) par-pat
-    (let* ((var-lists (mapcar (ret (copy var-list)) pats))
-           (par-matches (mapcar (op compile-match @1 obj-var @2)
-                                pats var-lists))
-           (dj-guard (new guard-disjunction
-                          guard-chains (mapcar .guard-chain par-matches)
-                          sub-patterns par-matches)))
-      (each ((vl var-lists))
-        var-list.(merge vl))
-      (new compiled-match
-           pattern par-pat
-           obj-var obj-var
-           guard-chain (list dj-guard)))))
-
-(defun compile-and-match (and-pat obj-var var-list)
-  (mac-param-bind *match-form* (op . pats) and-pat
-    (let* ((par-matches (mapcar (lop compile-match obj-var var-list) pats)))
-      (new compiled-match
-           pattern and-pat
-           obj-var obj-var
-           guard-chain (mappend .guard-chain par-matches)))))
-
-(defun compile-not-match (pattern obj-var var-list)
-  (mac-param-bind *match-form* (op pattern) pattern
-    (let* ((pm (compile-match pattern obj-var var-list))
-           (guard (new match-guard
-                       guard-expr ^(not (let ,pm.(get-vars)
-                                          ,pm.(wrap-guards t))))))
-      (new compiled-match
-           pattern pattern
-           obj-var obj-var
-           guard-chain (list guard)))))
-
-(defun compile-hash-match (hash-expr obj-var var-list)
-  (mac-param-bind *match-form* (op . pairs) hash-expr
-    (let* ((hash-alist-var (gensym "hash-alist-"))
-           (hash-alt-val ^',(gensym "alt"))
-           (need-alist-p nil)
-           (hash-keys-var (gensym "hash-keys-"))
-           (need-keys-p nil)
-           (hash-matches
-             (collect-each ((pair pairs))
-               (mac-param-bind *match-form* (key : (val nil val-p)) pair
-                 (let ((key-pat-p (non-triv-pat-p key))
-                       (val-pat-p (non-triv-pat-p val))
-                       (key-var-sym (var-pat-p key)))
-                   (cond
-                     ((and (not val-p) key-var-sym var-list.(exists key-var-sym))
-                      (let ((guard (new match-guard
-                                        test-expr ^(inhash ,obj-var
-                                                           ,key-var-sym))))
-                        (new compiled-match
-                             guard-chain (list guard))))
-                     ((and (not val-p) (not key-pat-p))
-                      (let ((guard (new match-guard
-                                        test-expr ^(inhash ,obj-var
-                                                           ',key))))
-                        (new compiled-match
-                             guard-chain (list guard))))
-                     ((not val-p)
-                      (set need-keys-p t)
-                      (compile-match key hash-keys-var var-list))
-                     ((and key-var-sym var-list.(exists key-var-sym))
-                       (let ((vm (compile-match val (gensym "val") var-list)))
-                         vm.(add-guards-pre
-                              (new match-guard
-                                   vars (list vm.obj-var)
-                                   var-exprs ^((gethash ,obj-var ,key-var-sym
-                                                        ,hash-alt-val))
-                                   test-expr ^(neq ,vm.obj-var
-                                                   ,hash-alt-val)))
-                         vm))
-                     ((and key-pat-p val-pat-p)
-                      (set need-alist-p t)
-                      (compile-match ^@(coll (,key . ,val))
-                                     hash-alist-var var-list))
-                     (key-pat-p
-                       (let ((km (compile-match key (gensym "keys")
-                                                var-list)))
-                         km.(add-guards-pre
-                              (new match-guard
-                                   pure-temps (list km.obj-var)
-                                   pure-temp-exprs ^((hash-keys-of ,obj-var
-                                                       ',val))))
-                         km))
-                     (t
-                       (let ((vm (compile-match val (gensym "val") var-list)))
-                         vm.(add-guards-pre
-                              (new match-guard
-                                   pure-temps (list vm.obj-var)
-                                   pure-temp-exprs ^((gethash ,obj-var ',key
-                                                              ,hash-alt-val))
-                                   test-expr ^(neq ,vm.obj-var ,hash-alt-val)))
-                         vm)))))))
-           (guard (new match-guard
-                       guard-expr ^(hashp ,obj-var)
-                       vars (append
-                              (if need-alist-p
-                                (list hash-alist-var))
-                              (if need-keys-p
-                                (list hash-keys-var)))
-                       var-exprs (append
-                                   (if need-alist-p
-                                     (list ^(hash-alist ,obj-var)))
-                                   (if need-keys-p
-                                     (list ^(hash-keys ,obj-var)))))))
-      (new compiled-match
-           pattern hash-expr
-           obj-var obj-var
-           guard-chain (cons guard (mappend .guard-chain hash-matches))))))
-
-(defun compile-scan-match (scan-syntax obj-var var-list)
-  (mac-param-bind *match-form* (op pattern) scan-syntax
-    (with-gensyms (iter found-p cont-p success-p)
-      (let* ((cm (compile-match pattern iter var-list))
-             (loop ^(for ((,iter ,obj-var) (,cont-p t) ,found-p)
-                         (,cont-p ,found-p)
-                         ((cond
-                            ((null ,cont-p))
-                            ((consp ,iter) (set ,iter (cdr ,iter)))
-                            (t (zap ,cont-p))))
-                       ,cm.(wrap-guards ^(set ,found-p t ,cont-p nil))))
-             (guard (new match-guard
-                         vars (cons success-p cm.(get-vars))
-                         var-exprs (list loop)
-                         test-expr success-p)))
-      (new compiled-match
-           pattern scan-syntax
-           obj-var obj-var
-           guard-chain (list guard))))))
-
-(defun compile-exprs-match (exprs-syntax uexprs var-list)
-  (let ((upats (cdr exprs-syntax))
-        (utemps (mapcar (ret (gensym)) uexprs)))
-    (tree-bind (pats temps exprs) (multi-sort (list upats utemps uexprs)
-                                              [list less]
-                                              [list non-triv-pat-p])
-      (let* ((matches (mapcar (op compile-match @1 @2 var-list)
-                              pats temps)))
-        (new compiled-match
-             pattern exprs-syntax
-             obj-var nil
-             guard-chain (cons (new match-guard
-                                    pure-temps utemps
-                                    pure-temp-exprs uexprs)
-                               (mappend .guard-chain matches)))))))
-
-(defun compile-match (pat : (obj-var (gensym)) (var-list (new var-list)))
-  (cond
-    ((consp pat)
-       (caseq (car pat)
-         (sys:expr
-           (let ((exp (cadr pat)))
-             (if (consp exp)
-               (let ((op (car exp)))
-                 (caseq op
-                   (struct (compile-struct-match exp obj-var var-list))
-                   (require (compile-require-match exp obj-var var-list))
-                   (usr:as (compile-as-match exp obj-var var-list))
-                   (usr:with (compile-with-match exp obj-var var-list))
-                   (all (compile-loop-match exp obj-var var-list))
-                   (usr:all* (compile-loop-match exp obj-var var-list))
-                   (some (compile-loop-match exp obj-var var-list))
-                   (coll (compile-loop-match exp obj-var var-list))
-                   (or (compile-or-match exp obj-var var-list))
-                   (and (compile-and-match exp obj-var var-list))
-                   (not (compile-not-match exp obj-var var-list))
-                   (hash (compile-hash-match exp obj-var var-list))
-                   (usr:scan (compile-scan-match exp obj-var var-list))
-                   (exprs (compile-exprs-match exp obj-var var-list))
-                   (t (iflet ((xfun [*match-macro* op]))
-                        (let* ((var-env (make-env (mapcar (lop cons
-                                                               'sys:special)
-                                                          var-list.vars)
-                                                  nil var-list.menv))
-                               (xexp [xfun exp var-env]))
-                          (if (neq xexp exp)
-                            (compile-match xexp obj-var var-list)
-                            (compile-predicate-match exp obj-var var-list)))
-                        (compile-predicate-match exp obj-var var-list)))))
-               (compile-error *match-form*
-                              "unrecognized pattern syntax ~s" pat))))
-         (sys:var (compile-var-match (cadr pat) obj-var var-list))
-         (sys:quasi (compile-match (expand-quasi-match (cdr pat) var-list)
-                                   obj-var var-list))
-         (sys:qquote (compile-match (transform-qquote (cadr pat))
-                                    obj-var var-list))
-         (t (if (non-triv-pat-p pat)
-              (compile-cons-structure pat obj-var var-list)
-              (compile-atom-match pat obj-var var-list)))))
-    (t (compile-atom-match pat obj-var var-list))))
-
-(defun get-var-list (env)
-  (new var-list menv env))
-
-(defmacro when-match (:form *match-form* :env e pat obj . body)
-  (let ((cm (compile-match pat : (get-var-list e))))
-    ^(alet ((,cm.obj-var ,obj))
-       (let ,cm.(get-vars)
-         ,cm.(wrap-guards . body)))))
-
-(defmacro if-match (:form *match-form* :env e pat obj then : else)
-  (let ((cm (compile-match pat : (get-var-list e)))
-        (result (gensym "result-")))
-    ^(alet ((,cm.obj-var ,obj))
-       (let* (,result ,*cm.(get-vars))
-         (if ,cm.(wrap-guards
-                   ^(set ,result ,then)
-                   t)
-           ,result
-           ,else)))))
-
-(defmacro while-match (:form *match-form* :env e pat obj . body)
-  (let ((cm (compile-match pat : (get-var-list e))))
-    ^(for ()
-          ((alet ((,cm.obj-var ,obj))
-             (let ,cm.(get-vars)
-               ,cm.(wrap-guards ^(progn ,*body t)))))
-          ())))
-
-(defmacro match-case (:form *match-form* :env e obj . clauses)
-  (unless [all clauses [andf proper-listp [chain len plusp]]]
-    (compile-error *match-form* "bad clause syntax"))
-  (let* ((matched-p-temp (gensym "matched-p-"))
-         (result-temp (gensym "result-"))
-         (objvar (gensym "obj-"))
-         (var-list (get-var-list e))
-         (clause-matches [mapcar (op compile-match (car @1)
-                                     objvar (copy var-list))
-                                 clauses])
-         (nclauses (len clauses))
-         (clause-code (collect-each ((cl clauses)
-                                     (cm clause-matches))
-                        (mac-param-bind *match-form* (match . forms) cl
-                          ^(let (,*cm.(get-vars))
-                             ,cm.(wrap-guards ^(set ,result-temp
-                                                    (progn ,*forms))
-                                              t))))))
-    ^(alet ((,objvar ,obj))
-       (let (,result-temp)
-         (or ,*clause-code)
-         ,result-temp))))
-
-(defmacro while-match-case (:form *match-form* :env e obj . clauses)
-  (unless [all clauses [andf proper-listp [chain len plusp]]]
-    (compile-error *match-form* "bad clause syntax"))
-  ^(for ()
-        ((match-case ,obj
-           ,*(mapcar (ret ^(,(car @1) ,*(cdr @1) t)) clauses)))
-        ()))
-
-(defmacro while-true-match-case (:form *match-form* :env e obj . clauses)
-  (unless [all clauses [andf proper-listp [chain len plusp]]]
-    (compile-error *match-form* "bad clause syntax"))
-  ^(for ()
-        ((match-case ,obj
-           (nil)
-           ,*(mapcar (ret ^(,(car @1) ,*(cdr @1) t)) clauses)))
-        ()))
-
-(defmacro when-exprs-match (:form *match-form* :env e pats exprs . forms)
-  (let ((em (compile-match ^@(exprs ,*pats) exprs (get-var-list e))))
-    ^(let* (,*em.(get-vars))
-       ,em.(wrap-guards . forms))))
-
-(defstruct lambda-clause ()
-  orig-syntax
-  fixed-patterns
-  variadic-pattern
-  nfixed
-  forms
-
-  (:postinit (me)
-    (set me.nfixed (len me.fixed-patterns))))
-
-(defun parse-lambda-match-clause (clause)
-  (mac-param-bind *match-form* (args . body) clause
-    (cond
-      ((atom args) (new lambda-clause
-                          orig-syntax args
-                          variadic-pattern args
-                          forms body))
-      ((proper-list-p args)
-       (let* ((vpos (pos-if (lop meq 'sys:expr 'sys:var 'sys:quasi) args)))
-         (tree-bind (fixed-pats . variadic-pat) (split args vpos)
-           (new lambda-clause
-                orig-syntax args
-                fixed-patterns fixed-pats
-                variadic-pattern (car variadic-pat)
-                forms body))))
-      (t (new lambda-clause
-              orig-syntax args
-              fixed-patterns (butlast args 0)
-              variadic-pattern (last args 0)
-              forms body)))))
-
-(defun expand-lambda-match (clauses)
-  (let* ((parsed-clauses [mapcar parse-lambda-match-clause clauses])
-         (max-args (or [find-max parsed-clauses : .nfixed].?nfixed 0))
-         (min-args (or [find-min parsed-clauses : .nfixed].?nfixed 0))
-         (variadic [some parsed-clauses .variadic-pattern])
-         (fix-arg-temps (mapcar (op gensym `arg-@1`)
-                                (range* 0 min-args)))
-         (opt-arg-temps (mapcar (op gensym `arg-@1`)
-                                (range* min-args max-args)))
-         (rest-temp (if variadic (gensym `rest`)))
-         (present-p-temps (mapcar (op gensym `have-@1`)
-                                  (range* min-args max-args)))
-         (arg-temps (append fix-arg-temps opt-arg-temps))
-         (present-vec (vec-list (append (repeat '(t) min-args)
-                                        present-p-temps)))
-         (result-temp (gensym "result"))
-         (nclauses (len parsed-clauses))
-         (ex-clauses (collect-each ((pc parsed-clauses))
-                       (let* ((vp pc.variadic-pattern)
-                              (exp ^(when-exprs-match
-                                      (,*pc.fixed-patterns
-                                        ,*(if vp (list vp)))
-                                      (,*[arg-temps 0..pc.nfixed]
-                                        ,*(if vp
-                                            ^((list* ,*[arg-temps pc.nfixed..:]
-                                                     ,rest-temp))))
-                                      (set ,result-temp (progn ,*pc.forms))
-                                      t)))
-                         (sys:set-macro-ancestor exp pc.orig-syntax)
-                         (when (> pc.nfixed min-args)
-                           (set exp ^(when ,[present-vec (pred pc.nfixed)]
-                                        ,exp)))
-                         (when (< pc.nfixed max-args)
-                           (set exp ^(unless ,[present-vec pc.nfixed]
-                                        ,exp)))
-                         (when (and variadic (not vp) (= pc.nfixed max-args))
-                           (set exp ^(unless ,rest-temp
-                                       ,exp)))
-                         exp))))
-    ^(lambda (,*fix-arg-temps
-              ,*(if opt-arg-temps
-                  (cons : (mapcar (ret ^(,@1 nil ,@2))
-                                  opt-arg-temps present-p-temps)))
-              . ,rest-temp)
-       (let (,result-temp)
-         (or ,*ex-clauses)
-         ,result-temp))))
-
-(defmacro lambda-match (:form *match-form* . clauses)
-  (expand-lambda-match clauses))
-
-(defmacro defun-match (:form *match-form* name . clauses)
-  (tree-bind (lambda args . body) (expand-lambda-match clauses)
-    ^(defun ,name ,args . ,body)))
-
-(define-param-expander :match (params clauses menv form)
-  (let ((*match-form* form))
-    (unless (proper-list-p params)
-      (compile-error form
-                     "~s is incompatible with dotted parameter lists"
-                     :match))
-    (when (find : params)
-      (compile-error form
-                     "~s is incompatible with optional parameters"
-                     :match))
-    (tree-bind (lambda lparams . body) (expand-lambda-match clauses)
-      (let ((dashdash (member '-- params)))
-        (cons (append (ldiff params dashdash)
-                      (butlastn 0 lparams)
-                      dashdash
-                      (nthlast 0 lparams))
-              body)))))
-
-(defmacro defmatch (name destructuring-args . body)
-  (with-gensyms (name-dummy args)
-    ^(progn
-       (sethash *match-macro* ',name
-                (lambda (,args vars-env)
-                  (mac-env-param-bind *match-form* vars-env
-                                     (,name-dummy ,*destructuring-args)
-                                     ,args ,*body)))
-       ',name)))
-
-(defun check (f op pat)
-  (if (or (not (listp pat))
-          (meq (car pat) 'sys:expr 'sys:var 'sys:quasi))
-    (compile-error f "~s: list pattern expected, not ~s" op pat)
-    pat))
-
-(defun check-end (f op pat)
-  (if (and (listp pat)
-           (meq (car pat) 'sys:expr 'sys:var 'sys:quasi))
-    (compile-error f "~s: list or atom pattern expected, not ~s" op pat)
-    pat))
-
-(defun check-sym (f op sym : nil-ok)
-  (cond
-    ((bindable sym) sym)
-    ((and (null sym) nil-ok) sym)
-    (t (compile-error f "~s: bindable symbol expected, not ~s" op sym))))
-
-(defun loosen (f pat)
-  (if (proper-list-p pat)
-    (append pat '@nil)
-    pat))
-
-(defun pat-len (f pat)
-  (if (consp pat)
-    (let ((var-op-pos (pos-if (op meq 'sys:var 'sys:expr 'sys:quasi)
-                              (butlastn 0 pat))))
-      (if var-op-pos var-op-pos (len pat)))
-    0))
-
-(defmatch sme (:form f sta mid end : (mvar (gensym)) eobj)
-  (let* ((psta (loosen f (check f 'sme sta)))
-         (pmid (loosen f (check f 'sme mid)))
-         (pend (check-end f 'sme end))
-         (lsta (pat-len f psta))
-         (lmid (pat-len f pmid))
-         (lend (pat-len f pend))
-         (obj (gensym)))
-    ^@(as ,(check-sym f 'sme obj)
-          @(and ,psta
-                @(with @(scan @(as ,(check-sym f 'sme mvar) ,pmid))
-                       (nthcdr ,lsta ,obj))
-                @(with @(as ,(check-sym f 'sme eobj t) ,pend)
-                       (nthlast ,lend (nthcdr ,lmid ,mvar)))))))
-
-(defmatch end (:form f end : evar)
-  (let* ((pend (check-end f 'end end))
-         (lend (pat-len f pend))
-         (obj (gensym)))
-    ^@(as ,(check-sym f 'end obj)
-          @(with @(as ,(check-sym f 'end evar t) ,pend)
-                 (nthlast ,lend ,obj)))))
-
-(defun non-triv-pat-p (syntax) t)
-
-(defun non-triv-pat-p (syntax)
-  (match-case syntax
-    ((@(eq 'sys:expr) (@(bindable) . @nil)) t)
-    ((@(eq 'sys:var) @(or @(bindable) nil) . @nil) t)
-    ((@(eq 'sys:quasi) . @(some @(consp))) t)
-    ((@(eq 'sys:qquote) @nil) t)
-    ((@pat . @rest) (or (non-triv-pat-p pat)
-                        (non-triv-pat-p rest)))
-    (#R(@from @to) (or (non-triv-pat-p from)
-                       (non-triv-pat-p to)))
-    (@(some @(non-triv-pat-p)) t)))
-
-(defun var-pat-p (syntax)
-  (when-match (@(eq 'sys:var) @(bindable @sym) . @nil) syntax
-    sym))
-
-(defun expand-quasi-match (args var-list)
-  (labels ((bound-p (vlist vars sym)
-             (cond
-               ((bindable sym) (or (member sym vars) vlist.(exists sym)))
-               ((null sym) nil)
-               ((compile-error *match-form* "bindable symbol expected, not ~s"
-                               sym))))
-           (normalize (args)
-             (mapcar (do if-match (@(eq 'sys:var) @sym nil) @1
-                       ^(sys:var ,sym)
-                       @1)
-                     args))
-           (quasi-match (vlist args vars str pos)
-             (match-case args
-               ;; `text`
-               ((@(stringp @txt))
-                (list ^@(require @nil (match-str ,str ,txt ,pos))))
-               ;; `txt@...`
-               ((@(stringp @txt) . @rest)
-                (with-gensyms (npos)
-                  (cons ^@(require @(with ,npos (+ ,pos (len ,txt)))
-                            (match-str ,str ,txt ,pos))
-                        (quasi-match vlist rest vars str npos))))
-               ;; `@var` (existing binding)
-               (((@(eq 'sys:var) @(bound-p vlist vars @sym) . @nil))
-                (list ^@(require @nil (match-str ,str (sys:quasi ,(car args))
-                                                 ,pos))))
-               ;; `@var@...` (existing binding)
-               ((@(as avar (@(eq 'sys:var) @(bound-p vlist vars @sym) . @nil))
-                 . @rest)
-                (with-gensyms (txt len npos)
-                  (list* ^@(with ,txt (sys:quasi ,avar))
-                         ^@(with ,len (len ,txt))
-                         ^@(with ,npos (+ ,pos ,len))
-                         ^@(require @nil
-                             (match-str ,str ,txt ,pos))
-                         (quasi-match vlist rest vars str npos))))
-               ;; `@var` (new binding)
-               (((@(eq 'sys:var) @sym))
-                (list ^@(with ,sym (sub-str ,str ,pos t))))
-               ;; `@{var #/rx/}` (new binding)
-               (((@(eq 'sys:var) @sym (@(regexp @reg))))
-                (list ^@(require @(with ,sym (sub-str ,str ,pos t))
-                          (m^$ ,reg ,sym))))
-               ;; `@{var #/rx/}@...` (new binding)
-               (((@(eq 'sys:var) @sym (@(regexp @reg))) . @rest)
-                (with-gensyms (len npos)
-                  (list* ^@(require @(with ,len (match-regex ,str ,reg ,pos))
-                            ,len)
-                         ^@(with ,npos (+ ,pos ,len))
-                         ^@(with ,sym (sub-str ,str ,pos ,npos))
-                         (quasi-match vlist rest (cons sym vars) str npos))))
-               ;; `@{var 123}` (new binding)
-               (((@(eq 'sys:var) @sym (@(integerp @len))))
-                (unless (plusp len)
-                  (compile-error *match-form*
-                                 "variable ~s: positive integer required,\ \
-                                  not ~a" sym))
-                (with-gensyms (npos)
-                  (list ^@(require @(with ,npos (+ ,pos ,len))
-                            (eql ,npos (len ,str)))
-                        ^@(with ,sym (sub-str ,str ,pos t)))))
-               ;; `@{var 123}@...`` (new binding)
-               (((@(eq 'sys:var) @sym (@(integerp @len))) . @rest)
-                (unless (plusp len)
-                  (compile-error *match-form*
-                                 "variable ~s: positive integer required,\ \
-                                  not ~a" sym))
-                (with-gensyms (npos)
-                  (list* ^@(require @(with ,npos (+ ,pos ,len))
-                             (<= ,npos (len ,str)))
-                         ^@(with ,sym (sub-str ,str ,pos ,npos))
-                         (quasi-match vlist rest (cons sym vars) str npos))))
-               ;; `@{var}txt` (new binding)
-               (((@(eq 'sys:var) @sym) @(stringp @txt))
-                (with-gensyms (len end)
-                  (list ^@(require @(with ,end (search-str ,str ,txt ,pos))
-                           ,end (eql (+ ,end ,(len txt)) (len ,str)))
-                        ^@(with ,sym (sub-str ,str ,pos ,end)))))
-               ;; `@{var}txt...` (new binding)
-               (((@(eq 'sys:var) @sym) @(stringp @txt) . @rest)
-                (with-gensyms (len end npos)
-                  (list* ^@(require @(with ,end (search-str ,str ,txt ,pos))
-                            ,end)
-                         ^@(with ,npos (+ ,end ,(len txt)))
-                         ^@(with ,sym (sub-str ,str ,pos ,end))
-                         (quasi-match vlist rest (cons sym vars) str npos))))
-               ;; `@var0@var1` (unbound followed by bound)
-               (((@(eq 'sys:var) @sym)
-                 @(as bvar (@(eq 'sys:var) @(bound-p vlist vars @bsym) . @mods)))
-                (with-gensyms (txt end)
-                  (list ^@(with ,txt (sys:quasi ,bvar))
-                        ^@(require @(with ,end (search-str ,str ,txt ,pos))
-                           ,end (eql (+ , end (len ,txt)) (len ,str)))
-                        ^@(with ,sym (sub-str ,str ,pos ,end)))))
-               ;; `@var0@var1...` (unbound followed by bound)
-               (((@(eq 'sys:var) @sym)
-                 @(as bvar (@(eq 'sys:var) @(bound-p vlist vars @bsym) . @mods))
-                 . @rest)
-                (with-gensyms (txt end npos)
-                  (list* ^@(with ,txt (sys:quasi ,bvar))
-                         ^@(require @(with ,end (search-str ,str ,txt ,pos))
-                            ,end)
-                         ^@(with ,npos (+ ,end (len ,txt)))
-                         ^@(with ,sym (sub-str ,str ,pos ,end))
-                         (quasi-match vlist rest (cons sym vars) str npos))))
-               ;; `@{var whatever}@...`(new binding, unsupported modifiers)
-               (((@(eq 'sys:var) @sym @mods . @nil) . @rest)
-                (compile-error *match-form*
-                               "variable ~s: unsupported modifiers ~s"
-                               sym mods))
-
-               ;; `@var0@var1` (unbound followed by unbound)
-               (((@(eq 'sys:var) @sym0)
-                 (@(eq 'sys:var) @sym1 . @mods)
-                 . @rest)
-                (compile-error *match-form*
-                               "consecutive unbound variables ~s and ~s"
-                               sym0 sym1))
-               ((@bad . @rest) (compile-error *match-form*
-                                              "unsupported syntax ~s"
-                                              ^(sys:quasi ,bad)))
-               (@else (compile-error *match-form* "bad quasiliteral syntax")))))
-
-    (with-gensyms (str pos)
-      ^@(and @(require (sys:var ,str)
-                (stringp ,str))
-             @(with ,pos 0)
-             ,*(quasi-match var-list (normalize args) nil str pos)))))
-
-(defun transform-qquote (syn)
-  (match-case syn
-    ((sys:hash-lit nil . @(coll (@key @val)))
-     ^@(hash ,*(zip [mapcar transform-qquote key]
-                    [mapcar transform-qquote val])))
-    ((sys:struct-lit @type . @args)
-     ^@(struct ,(transform-qquote type)
-               ,*[mapcar transform-qquote args]))
-    ((sys:vector-lit @elems)
-     ^#(,*[mapcar transform-qquote elems]))
-    ((json quote @arg) (transform-qquote arg))
-    ((sys:unquote @pat) (if (symbolp pat)
-                          ^(sys:var ,pat)
-                          ^(sys:expr ,pat)))
-    ((sys:hash-lit @(have) . @nil)
-     (compile-error *match-form*
-                    "only equal hash tables supported"))
-    ((@(or sys:qquote) . @nil)
-     (compile-error *match-form*
-                    "pattern-matching quasiquote doesn't support nesting"))
-    ((sys:splice . @nil)
-     (compile-error *match-form*
-                    "pattern-matching quasiquote doesn't support splicing"))
-    ((@ca . @cd) (cons (transform-qquote ca)
-                       (transform-qquote cd)))
-    (@else else)))
-
-(defun each-match-expander (f pat-seq-list body fun)
-  (unless (and (proper-list-p pat-seq-list)
-               (evenp (len pat-seq-list)))
-    (compile-error f "pattern-sequence arguments must form pairs"))
-  (let ((pat-seq-pairs (tuples 2 pat-seq-list)))
-    (each ((pair pat-seq-pairs))
-      (unless (and (proper-list-p pair)
-                   (eql 2 (length pair)))
-        (compile-error f "invalid pattern-sequence pair ~s" pair)))
-    (let* ((pats [mapcar car pat-seq-pairs])
-           (seqs [mapcar cadr pat-seq-pairs]))
-       ^(,fun (lambda-match ((,*pats) (progn ,*body))) ,*seqs))))
-
-(defmacro each-match (:form f pat-seq-pairs . body)
-  (each-match-expander f pat-seq-pairs body 'mapdo))
-
-(defmacro append-matches (:form f pat-seq-pairs . body)
-  (each-match-expander f pat-seq-pairs body 'mappend))
-
-(defmacro keep-matches (:form f pat-seq-pairs . body)
-  (each-match-expander f pat-seq-pairs ^((list (progn ,*body))) 'mappend))
-
-(defmacro each-match-product (:form f pat-seq-pairs . body)
-  (each-match-expander f pat-seq-pairs body 'maprodo))
-
-(defmacro append-match-products (:form f pat-seq-pairs . body)
-  (each-match-expander f pat-seq-pairs body 'maprend))
-
-(defmacro keep-match-products (:form f pat-seq-pairs . body)
-  (each-match-expander f pat-seq-pairs ^((list (progn ,*body))) 'maprend))
diff --git a/share/txr/stdlib/op.tl b/share/txr/stdlib/op.tl
deleted file mode 100644
index 182055f0..00000000
--- a/share/txr/stdlib/op.tl
+++ /dev/null
@@ -1,203 +0,0 @@
-;; Copyright 2017-2021
-;; Kaz Kylheku <kaz@kylheku.com>
-;; Vancouver, Canada
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are met:
-;;
-;; 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 BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(defvar sys:*op-ctx*)
-
-(sys:make-struct-type
-  'sys:op-ctx nil nil '(form gens up meta rec recvar) nil
-  (lambda (me)
-    (slotset me 'up sys:*op-ctx*)
-    (slotset me 'meta (gensym "meta-")))
-  nil nil)
-
-(defun sys:ensure-op-arg (ctx n)
-  (let ((ag (slot ctx 'gens)))
-    (when (> n 1024)
-      ['compile-error (slot ctx 'form)
-                      "@~a calls for function with too many arguments" n])
-    (for ((i (len ag)) (l))
-         ((<= i n)
-          (sys:setq ag (append ag (nreverse l)))
-          (slotset ctx 'gens ag)
-          [ag n])
-         ((sys:setq i (succ i)))
-      (sys:setq l (cons (gensym `arg-@(if (plusp i) i "rest")-`) l)))))
-
-(defun sys:op-meta-p (expr)
-  (tree-case expr
-    ((x y . r) (and (null r)
-                    (cond
-                      ((eq x 'sys:expr) (sys:op-meta-p y))
-                      ((eq x 'sys:var) (or (integerp y)
-                                           (eq y 'rest))))))))
-
-(defun sys:op-rec-p (expr)
-  (tree-case expr
-    ((x (y . r)) (and (eq x 'sys:expr) (eq y 'usr:rec)))))
-
-(defun sys:op-ensure-rec (ctx : recvar)
-  (when recvar
-    (slotset ctx 'recvar t))
-  (or (slot ctx 'rec) (slotset ctx 'rec (gensym "rec-"))))
-
-(defun sys:op-alpha-rename (f e op-args do-nested-metas)
-  (let* ((ctx sys:*op-ctx*)
-         (code ^(macrolet ((sys:expr (:form f arg)
-                             (let ((ctx ,ctx))
-                               (cond
-                                 ((and (slot ctx 'up)
-                                       (or (sys:op-meta-p arg)
-                                           (sys:op-rec-p arg)
-                                           (equal arg '(sys:var usr:rec))))
-                                  ^(,(slot (slot ctx 'up) 'meta) (quote ,arg)))
-                                 ((sys:op-rec-p f)
-                                  ^(,(sys:op-ensure-rec ctx) ,*(rest arg)))
-                                 (t f))))
-                           (sys:var (:form f arg . mods)
-                             (cond
-                               ((sys:op-meta-p f)
-                                (unless (integerp arg)
-                                  (sys:setq arg 0))
-                                (sys:ensure-op-arg ,ctx arg))
-                               ((equal f '(sys:var usr:rec))
-                                (sys:op-ensure-rec ,ctx t))
-                               (t f)))
-                           ,*(if do-nested-metas
-                               ^((,(slot ctx 'meta) ((quote arg)) arg))))
-                  ,op-args)))
-    (expand code e)))
-
-(eval-only
-  (defmacro op-ignerr (x)
-    ^(sys:catch (error) ,x () (error (. args)))))
-
-(defun sys:op-expand (f e args)
-  (unless args
-    ['compile-error f "arguments required"])
-  (let* ((compat (and (plusp sys:compat) (<= sys:compat 225)))
-         (ctx (make-struct 'sys:op-ctx ^(form ,f)))
-         (do-gen)
-         (sys:*op-ctx* ctx)
-         (sym (car f))
-         (syntax-0 (if (eq sym 'do) args ^[,*args]))
-         (syntax-1 (if (or (null syntax-0) (neq sym 'do) compat)
-                     (sys:op-alpha-rename f e syntax-0 nil)
-                     (or (op-ignerr (sys:op-alpha-rename f e syntax-0 nil))
-                         (let ((syn (sys:op-alpha-rename
-                                      f e (append syntax-0
-                                                  (list (sys:setq do-gen
-                                                                  (gensym))))
-                                      nil)))
-                           (when (slot ctx 'gens)
-                             (sys:op-alpha-rename f e syntax-0 nil))
-                           syn))))
-         (syntax-2 (sys:op-alpha-rename f e syntax-1 t))
-         (metas (slot ctx 'gens))
-         (rec (slot ctx 'rec))
-         (recvar (slot ctx 'recvar))
-         (rest-sym (sys:ensure-op-arg ctx 0))
-         (lambda-interior (let ((fargs (tree-case syntax-2
-                                         ((a b . fa) fa))))
-                            (cond
-                              ((and (eq sym 'lop) fargs)
-                               (let ((fargs-l1 (mapcar (lambda (farg)
-                                                         ^(sys:l1-val ,farg))
-                                                       fargs)))
-                                 ;; no cadr here to avoid circular autoload
-                                 ^[sys:apply ,(car (cdr syntax-2))
-                                             (append ,rest-sym (list ,*fargs-l1))]))
-                              (metas syntax-2)
-                              ((eq sym 'do)
-                               (cond
-                                 (compat syntax-2)
-                                 (do-gen
-                                   (let ((arg1 (sys:ensure-op-arg ctx 1)))
-                                     ^(symacrolet ((,do-gen ,arg1))
-                                        ,syntax-2)))
-                                 (t (let ((arg1 (sys:ensure-op-arg ctx 1)))
-                                      (append syntax-2 (list arg1))))))
-                              (t (append syntax-2 rest-sym))))))
-    (let ((metas (slot ctx 'gens)))
-      (cond
-        (recvar ^(sys:lbind ((,rec (lambda (,*(cdr metas) . ,rest-sym)
-                                     (let ((,rec (fun ,rec)))
-                                       ,lambda-interior))))
-                   (fun ,rec)))
-        (rec ^(sys:lbind ((,rec (lambda (,*(cdr metas) . ,rest-sym)
-                                  ,lambda-interior)))
-                (fun ,rec)))
-        (t ^(lambda (,*(cdr metas) . ,rest-sym)
-              ,lambda-interior))))))
-
-(defmacro op (:form f :env e . args)
-  (sys:op-expand f e args))
-
-(defmacro do (:form f :env e . args)
-  (sys:op-expand f e args))
-
-(defmacro lop (:form f :env e . args)
-  (sys:op-expand f e args))
-
-(defmacro ldo (op . args)
-  ^(do ,op @1 ,*args))
-
-(defmacro ap (. args)
-  ^(apf (op ,*args)))
-
-(defmacro ip (. args)
-  ^(ipf (op ,*args)))
-
-(defmacro ado (. args)
-  ^(apf (do ,*args)))
-
-(defmacro ido (. args)
-  ^(ipf (do ,*args)))
-
-(defmacro ret (. args)
-  ^(op identity (progn @rest ,*args)))
-
-(defmacro aret (. args)
-  ^(ap identity (progn @rest ,*args)))
-
-(defun sys:opip-expand (e clauses)
-  (collect-each ((c clauses))
-    (if (atom c)
-      c
-      (let ((sym (car c)))
-        (if (member sym '(dwim uref qref))
-          c
-          (let ((opdo (if (or (special-operator-p (car c))
-                              (macro-form-p c e)) 'do 'op)))
-            ^(,opdo ,*c)))))))
-
-(defmacro opip (:env e . clauses)
-  ^[chain ,*(sys:opip-expand e clauses)])
-
-(defmacro oand (:env e . clauses)
-  ^[chand ,*(sys:opip-expand e clauses)])
-
-(defmacro flow (val . opip-args)
-  ^(call (opip ,*opip-args) ,val))
diff --git a/share/txr/stdlib/optimize.tl b/share/txr/stdlib/optimize.tl
deleted file mode 100644
index b011c568..00000000
--- a/share/txr/stdlib/optimize.tl
+++ /dev/null
@@ -1,606 +0,0 @@
-;; Copyright 2021
-;; Kaz Kylheku <kaz@kylheku.com>
-;; Vancouver, Canada
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are met:
-;;
-;; 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 BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(compile-only
-  (defstruct live-info nil
-    (defined 0)
-    (used 0)
-    def)
-
-  (defstruct basic-block (live-info)
-    live
-    label
-    next
-    links
-    rlinks
-    insns
-
-    (:method print (bl stream pretty-p)
-       (put-string "#S" stream)
-       (print ^(basic-block live ,bl.live
-                            label ,bl.label
-                            insns ,bl.insns
-                            links ,(mapcar .label bl.links)
-                            rlinks ,(mapcar .label bl.rlinks)
-                            next ,bl.next) stream)))
-
-  (defstruct (basic-blocks insns lt-dregs symvec) nil
-    insns
-    lt-dregs
-    symvec
-    root
-    (hash (hash))
-    (li-hash (hash :eq-based))
-    list
-    rescan
-    recalc
-    reelim
-    (:static start (gensym "start-"))
-    (:static jump-ops '(jmp if ifq ifql close swtch ret abscsr
-                        uwprot catch block jend))
-
-    (:postinit (bb)
-      (let* ((insns (early-peephole (dedup-labels (cons bb.start bb.insns))))
-             (cuts (merge [where symbolp insns]
-                          [where [andf consp
-                                       (op memq (car @1) bb.jump-ops)]
-                                 (cons nil insns)]))
-             (parts (partition insns cuts))
-             (lparts (mapcar [iff [chain car symbolp]
-                                  use
-                                  (op cons (gensym))]
-                             parts)))
-        (set bb.list (mapcar (do new basic-block
-                               insns @1 label (car @1))
-                             lparts))
-        (mapdo (do set [bb.hash @1.label] @1) bb.list))
-      bb.(link-graph))
-
-    (:method get-insns (bb)
-      [mappend .insns bb.list])
-
-    (:method cut-block (bb bl at insns)
-      (let* ((nlabel (gensym "nl"))
-             (ltail (cdr (memq bl bb.list)))
-             (nbl (new basic-block
-                       label nlabel
-                       insns (cons nlabel at))))
-        (set bb.list (append (ldiff bb.list ltail) (list nbl) ltail))
-        (set bl.insns (ldiff insns at))
-        (set [bb.hash nlabel] nbl)
-        (pushnew bl bb.rescan)
-        (pushnew nbl bb.rescan)
-        nbl))
-
-    (:method next-block (bb bl)
-      (let ((ltail (memq bl bb.list)))
-        (iflet ((next (cdr ltail)))
-          (car next))))
-
-    (:method join-block (bb bl nxbl)
-      (when (eql (car nxbl.insns) nxbl.label)
-        (pop nxbl.insns))
-      (set bl.insns (append bl.insns nxbl.insns))
-      (set bl.next nxbl.next)
-      (set bl.links nxbl.links)
-      (set bb.list (remq nxbl bb.list))
-      (del [bb.hash nxbl.label])
-      (each ((nx bl.links))
-        (upd nx.rlinks (remq nxbl))
-        (pushnew bl nx.rlinks)))))
-
-(defmacro rewrite-case (sym list . cases)
-  ^(rewrite (lambda (,sym)
-              (match-case ,sym
-                ,*cases))
-            ,list))
-
-(defmeth basic-blocks link-graph (bb)
-  (set bb.root (car bb.list))
-  (each ((bl bb.list))
-    (let* ((code bl.insns)
-           (tail (last code))
-           (linsn (car tail))
-           (link-next t)
-           (nxbl (cadr (memq bl bb.list))))
-      (set bl.next nxbl)
-      (match-case linsn
-        ((jmp @jlabel)
-         (set bl.links (list [bb.hash jlabel])
-              bl.next nil))
-        ((if @nil @jlabel)
-         (set bl.links (list [bb.hash jlabel])))
-        ((@(or ifq ifql) @nil @nil @jlabel)
-         (set bl.links (list [bb.hash jlabel])))
-        ((close @nil @nil @nil @jlabel . @nil)
-         (set bl.links (list [bb.hash jlabel])
-              link-next nil))
-        ((swtch @nil . @jlabels)
-         (set bl.links [mapcar bb.hash (uniq jlabels)]
-              bl.next nil))
-        ((catch @nil @nil @nil @nil @hlabel)
-         (set bl.links (list [bb.hash hlabel])))
-        ((block @nil @nil @slabel)
-         (set bl.links (list [bb.hash slabel])))
-        ((uwprot @clabel)
-         (set bl.links (list [bb.hash clabel])))
-        ((@(or abscsr ret jend) . @nil)
-         (set bl.next nil)))
-      (if (and bl.next link-next)
-        (pushnew bl.next bl.links))
-      (each ((nxbl bl.links))
-        (pushnew bl nxbl.rlinks)))))
-
-(defmeth basic-blocks local-liveness (bb bl)
-  (set bl.live nil)
-  (labels ((regnum (reg)
-             (when-match (t @num) reg num))
-           (regnums (regs)
-             (mappend (do when-match
-                        (t @num) @1 (list num)) regs))
-           (def (li insn def)
-             (set li (copy li)
-                  li.def def
-                  [bb.li-hash insn] li)
-             (let* ((dn (regnum def))
-                    (dmask (if dn (mask dn))))
-               (cond
-                 (dn (new live-info
-                          used (logand li.used (lognot dmask))
-                          defined (logior li.defined dmask)))
-                 (t (set [bb.li-hash insn] li)))))
-           (refs (li insn . refs)
-             (set [bb.li-hash insn] li)
-             (let* ((rn (regnums refs))
-                    (rmask (mask . rn)))
-               (new live-info
-                    used (logior li.used rmask)
-                    defined (logand li.defined (lognot rmask)))))
-           (def-ref (li insn def . refs)
-             (set li (copy li)
-                  li.def def
-                  [bb.li-hash insn] li)
-             (let* ((rn (regnums refs))
-                    (dn (regnum def))
-                    (dmask (if dn (mask dn)))
-                    (rmask (mask . rn)))
-               (cond
-                 (dn (new live-info
-                          used (logior (logand li.used (lognot dmask)) rmask)
-                          defined (logior (logand li.defined (lognot rmask)) dmask)))
-                 (t (set [bb.li-hash insn] li)
-                    (new live-info
-                         used (logior li.used rmask)
-                         defined (logand li.defined (lognot rmask)))))))
-           (liveness (insns)
-             (if (null insns)
-               (new live-info used 0)
-               (let* ((li (liveness (cdr insns)))
-                      (insn (car insns)))
-                 (match-case insn
-                   ((@(or end jend prof) @reg)
-                    (refs li insn reg))
-                   ((@(or apply call) @def . @refs)
-                    (def-ref li insn def . refs))
-                   ((@(or gapply gcall) @def @fidx . @refs)
-                    (def-ref li insn def . refs))
-                   ((mov @def @ref)
-                    (def-ref li insn def ref))
-                   ((if @reg . @nil)
-                    (refs li insn reg))
-                   ((@(or ifq ifql) @reg @creg . @nil)
-                    (refs li insn reg creg))
-                   ((swtch @reg . @nil)
-                    (refs li insn reg))
-                   ((block @reg @nreg . @nil)
-                    (refs li insn reg nreg))
-                   ((@(or ret abscsr) @nreg @reg)
-                    (refs li insn reg nreg))
-                   ((catch @esreg @eareg @syreg @descreg . @nil)
-                    (refs li insn esreg eareg syreg descreg))
-                   ((handle @funreg @syreg)
-                    (refs li insn funreg syreg))
-                   ((@(or getv getvb getfb getl1b getlx getf) @def . @nil)
-                    (def li insn def))
-                   ((@(or setv setl1 setlx bindv) @reg . @nil)
-                    (refs li insn reg))
-                   ((close @reg . @nil)
-                    (def li insn reg))
-                   ((@op . @nil)
-                    (caseq op
-                      ((end jend prof or apply call or gapply gcall mov if
-                        ifq ifql swtch block ret abscsr catch handle getv
-                        getvb getfb getl1b getlx getf setl1 setlx bindv close)
-                       (error `wrongly handled @insn instruction`))
-                      (t (set [bb.li-hash insn] li))))
-                   (@else (set [bb.li-hash insn] li)))))))
-    (let ((li (liveness bl.insns)))
-      (set bl.used li.used
-           bl.defined li.defined))))
-
-(defmeth basic-blocks calc-liveness (bb : (blist bb.list))
-  (each ((bl blist))
-    bb.(local-liveness bl))
-  (let (changed)
-    (while* changed
-      (let ((visited (hash :eq-based)))
-        (labels ((upd-used (bl insns live)
-                   (tree-case insns
-                     ((fi . re)
-                      (let* ((live (upd-used bl re live))
-                             (lif [bb.li-hash fi]))
-                        (set live (logand live (lognot lif.defined)))
-                        (set lif.used (logior live lif.used))
-                        live))
-                     (else live)))
-                 (visit (bl)
-                   (unless [visited bl]
-                     (set [visited bl] t)
-                     (when bl.next
-                       (visit bl.next))
-                     (let ((used 0)
-                           (old-live (or bl.live 0)))
-                       (each ((nx bl.links))
-                         (visit nx)
-                         (set used (logior used nx.used)))
-                       (when (neql (set bl.live (logior used old-live))
-                                   old-live)
-                         (let ((live-in (logand (upd-used bl bl.insns bl.live)
-                                                (lognot bl.defined))))
-                           (set bl.used (logior live-in bl.used)))
-                         (set changed t))))))
-          (set changed nil)
-          (visit bb.root))))))
-
-(defmeth basic-blocks thread-jumps-block (bb code)
-  (let* ((tail (last code))
-         (oinsn (car tail))
-         (insn oinsn)
-         (ninsn oinsn))
-    (while* (nequal ninsn insn)
-      (set insn ninsn
-           ninsn (match-case insn
-                   (@(require (if @(as reg (d @dn)) @jlabel)
-                              (not (memqual reg bb.lt-dregs)))
-                    nil)
-                   ((if (t 0) @jlabel)
-                    ^(jmp ,jlabel))
-                   ((jmp @jlabel)
-                    (let ((jinsns [bb.hash jlabel].insns))
-                      (match-case jinsns
-                        ((@jlabel
-                           (jmp @(and @jjlabel @(not @jlabel))) . @nil)
-                         ^(jmp ,jjlabel))
-                        (@jelse insn))))
-                   ((if @reg @jlabel)
-                    (let ((jinsns [bb.hash jlabel].insns))
-                      (match-case jinsns
-                        ((@jlabel
-                           (if @reg
-                             @(and @jjlabel @(not @jlabel))) . @nil)
-                         ^(if ,reg ,jjlabel))
-                        ((@jlabel
-                           (jmp @(and @jjlabel @(not @jlabel))) . @nil)
-                         ^(if ,reg ,jjlabel))
-                        ((@jlabel
-                           (ifq @reg (t 0) @jjlabel) . @jrest)
-                         (let ((xbl (if jrest
-                                      bb.(cut-block [bb.hash jlabel] jrest jinsns)
-                                      bb.(next-block [bb.hash jlabel]))))
-                           (if xbl
-                             ^(if ,reg ,xbl.label)
-                             insn)))
-                        (@jelse insn))))
-                   ((ifq @reg @creg @jlabel)
-                    (let ((jinsns [bb.hash jlabel].insns))
-                      (match-case jinsns
-                        ((@jlabel
-                           (ifq @reg @creg
-                                @(and @jjlabel @(not @jlabel))) . @nil)
-                         ^(ifq ,reg ,creg ,jjlabel))
-                        ((@(require @jlabel (equal creg '(t 0)))
-                           (if @reg
-                                @(and @jjlabel @(not @jlabel))) . @jrest)
-                         (let ((xbl (if jrest
-                                      bb.(cut-block [bb.hash jlabel] jrest jinsns)
-                                      bb.(next-block [bb.hash jlabel]))))
-                           (if xbl
-                             ^(ifq ,reg ,creg ,xbl.label)
-                             insn)))
-                        ((@jlabel
-                           (jmp @(and @jjlabel @(not @jlabel))) . @nil)
-                         ^(ifq ,reg ,creg ,jjlabel))
-                        (@jelse insn))))
-                   ((close @reg @frsize @ntregs @jlabel . @cargs)
-                    (let ((jinsns [bb.hash jlabel].insns))
-                      (match-case jinsns
-                        ((@jlabel
-                           (jmp @(and @jjlabel @(not @jlabel))) . @nil)
-                         ^(close ,reg ,frsize ,ntregs ,jjlabel ,*cargs))
-                        (@jelse insn))))
-                   (@else else))))
-    (cond
-      ((null ninsn) (ldiff code tail))
-      ((nequal ninsn oinsn) (append (ldiff code tail) (list ninsn)))
-      (t code))))
-
-(defun subst (x y list)
-  (mapcar (lambda (item)
-            (if (equal item x) y item))
-          list))
-
-(defun subst-preserve (x y bb li list)
-  (let ((sub (subst x y list)))
-    (cond
-      ((equal sub list) list)
-      (t (set [bb.li-hash sub] li) sub))))
-
-(defmeth basic-blocks peephole-block (bb bl code)
-  (labels ((dead-treg (insn n)
-             (let ((li [bb.li-hash insn]))
-               (and li (not (bit li.used n)))))
-           (only-locally-used-treg (insn n)
-             (let ((li [bb.li-hash insn]))
-               (and li (bit li.used n) (not (bit bl.live n))))))
-    (rewrite-case insns code
-      ;; dead t-reg
-      (@(require ((@(or mov getlx getv getf getfb) (t @n) . @nil) . @nil)
-                 (dead-treg (car insns) n))
-        (pushnew bl bb.rescan)
-        (set bb.recalc t)
-        (cdr insns))
-      (@(require ((close (t @n) @nil @nil @jlabel . @nil) . @nil)
-                 (dead-treg (car insns) n))
-        (pushnew bl bb.rescan)
-        (set bb.recalc t
-             bb.reelim t)
-        ^((jmp ,jlabel) ,*(cdr insns)))
-      (@(require ((@(or gcall gapply) (t @n) @idx . @nil) . @nil)
-                 (dead-treg (car insns) n)
-                 [%effect-free% [bb.symvec idx]])
-        (pushnew bl bb.rescan)
-        (set bb.recalc t)
-        (cdr insns))
-      ;; unnecessary copying t-reg
-      (@(require ((mov @(as dst (t @n)) @src) . @rest)
-                 (only-locally-used-treg (car insns) n)
-                 (or (neq (car src) 'v)
-                     (none rest [andf [chain car (op eq 'end)]
-                                      [chain bb.li-hash .used (lop bit n)]]))
-                 (not (find dst rest : [chain bb.li-hash .def]))
-                 (not (find src rest : [chain bb.li-hash .def])))
-        (pushnew bl bb.rescan)
-        (labels ((rename (insns n dst src)
-                   (tree-case insns
-                     ((fi . re)
-                      (cons (subst-preserve dst src bb [bb.li-hash fi] fi)
-                            (rename (cdr insns) n dst src)))
-                     (else else))))
-          (rename (cdr insns) n dst src)))
-      ;; wasteful moves
-      (((mov @reg0 @nil) (mov @reg0 @nil) . @nil)
-       (cdr insns))
-      (((mov @reg0 @reg1) (mov reg1 @reg0) . @rest)
-       ^(,(car insns) ,*rest))
-      ;; frame reduction
-      (((@(or frame dframe) @lev @size)
-        (@(or call gcall mov)
-          . @(require @(coll (v @vlev @nil))
-                      (none vlev (op eql (ppred lev)))))
-        . @rest)
-       ^(,(cadr insns) ,(car insns) ,*rest))
-      (((@(or frame dframe) . @nil)
-        (if (t @reg) @jlabel))
-       (let ((jinsns [bb.hash jlabel].insns))
-         (match-case jinsns
-           ((@jlabel
-              (end (t @reg)) . @jrest)
-            (let* ((xbl (if jrest
-                           bb.(cut-block [bb.hash jlabel] jrest jinsns)
-                           bb.(next-block [bb.hash jlabel])))
-                   (ybl bb.(next-block bl))
-                   (yinsns ybl.insns))
-              (cond
-                ((and xbl ybl)
-                 (set ybl.insns ^(,ybl.label ,(car insns) ,*(cdr yinsns)))
-                 (pushnew ybl bb.rescan)
-                 ^((if (t ,reg) ,xbl.label)))
-                (t insns))))
-           (@jelse insns))))
-      (@(require ((if @(as reg (d @dn)) @jlabel) . @nil)
-                 (not (memqual reg bb.lt-dregs)))
-        nil)
-      (@(require ((ifq @(as reg (d @dn)) (t 0) @jlabel) . @nil)
-                 (not (memqual reg bb.lt-dregs)))
-        ^((jmp ,jlabel)))
-      (((jmp @jlabel) . @rest)
-       (let* ((jinsns (cdr [bb.hash jlabel].insns))
-              (oinsns (match-case jinsns
-                        (((jend @nil) . @nil)
-                         ^(,(car jinsns) ,*rest))
-                        ((@nil (jend @nil) . @nil)
-                         ^(,(car jinsns) ,(cadr jinsns) ,*rest))
-                        (@else insns))))
-         (when (neq insns oinsns)
-           (pushnew bl bb.rescan)
-           (set bb.recalc t
-                bl.next nil
-                bl.links nil))
-         oinsns))
-      (@else insns))))
-
-(defmeth basic-blocks peephole (bb)
-  (each ((bl bb.list))
-    (set bl.insns bb.(peephole-block bl bl.insns)))
-  (whilet ((rescan bb.rescan))
-    (set bb.rescan nil)
-    (when bb.recalc
-      bb.(calc-liveness rescan)
-      (set bb.recalc nil))
-    (each ((bl rescan))
-      (set bl.insns bb.(peephole-block bl bl.insns))))
- (when bb.reelim
-   bb.(elim-dead-code)))
-
-(defmeth basic-blocks thread-jumps (bb)
-  (each ((bl bb.list))
-    (set bl.insns bb.(thread-jumps-block bl.insns))))
-
-(defmeth basic-blocks elim-next-jump (bb bl)
-  (let* ((tail (last bl.insns))
-         (linsn (car tail)))
-    (when-match (jmp @jlabel) linsn
-      (let ((nxbl bb.(next-block bl)))
-        (when (eql nxbl.?label jlabel)
-          (set bl.insns (butlast bl.insns)))))))
-
-(defmeth basic-blocks join-blocks (bb)
-  (labels ((joinbl (list)
-             (tree-case list
-               ((bl nxbl . rest)
-                (cond
-                  ((and (eq bl.next nxbl)
-                        (eq (car bl.links) nxbl)
-                        (null (cdr bl.links))
-                        (null (cdr nxbl.rlinks)))
-                   bb.(join-block bl nxbl)
-                   (joinbl (cons bl rest)))
-                  (t (cons bl (joinbl (cdr list))))))
-               (else else))))
-    (set bb.list (joinbl bb.list))))
-
-(defmeth basic-blocks elim-dead-code (bb)
-  (each ((bl bb.list))
-    (set bl.links nil)
-    (set bl.rlinks nil))
-  bb.(link-graph)
-  (let* ((visited (hash :eq-based)))
-    (labels ((visit (bl)
-               (when (test-set [visited bl])
-                 (when bl.next
-                   (visit bl.next))
-                 [mapcar visit bl.links])))
-      (for ((bl bb.root)) (bl) ((set bl bl.next))
-        (visit bl))
-      (visit bb.root))
-    (set bb.list [keep-if visited bb.list])
-    (each ((bl bb.list))
-      bb.(elim-next-jump bl)))
-  bb.(join-blocks))
-
-(defmeth basic-blocks merge-jump-thunks (bb)
-  (let* ((candidates (mappend [andf [chain .links len (op eql 1)]
-                                    [chain .insns len (lop < 4)]
-                                    [chain .insns last car
-                                           [iff consp
-                                                [chain car (op eq 'jmp)]]]
-                                    list]
-                              bb.list))
-         (hash (group-by [chain .insns cdr] candidates)))
-    (dohash (insns bls hash)
-      (when (cdr bls)
-        (whenlet ((keep (or (keep-if (op some @1.rlinks (op eq @@1) .next) bls)
-                            (list (car bls))))
-                  (leader (car keep)))
-          (whenlet ((dupes (diff bls keep)))
-            (each ((bl dupes))
-              (each ((pbl bl.rlinks))
-                (let* ((code pbl.insns)
-                       (tail (last code))
-                       (lins (car tail))
-                       (sins (subst bl.label leader.label lins)))
-                  (set pbl.insns (append (ldiff code tail) (list sins))))))
-            (set bb.list (remove-if (lop memq dupes) bb.list))))))))
-
-(defmeth basic-blocks late-peephole (bb code)
-  (rewrite-case insns code
-    (((if @reg @lab1)
-      @lab2
-      (jmp @lab3)
-      @lab1
-      . @rest)
-     (let* ((bl [bb.hash lab2]))
-       (if (some bl.rlinks (op eq bb) .next)
-         insns
-         ^((ifq ,reg (t 0) ,lab3)
-           ,lab1
-           ,*rest))))
-    (((mov (t @tn) (d @dn))
-      (jmp @lab3)
-      @lab1
-      (mov (t @tn) (t 0))
-      (jmp @lab3)
-      @lab2
-      (mov (t @tn) (t 0))
-      @(symbolp @lab3)
-      (ifq (t @tn) (t 0) @lab4)
-      . @rest)
-     (let ((lab5 (gensym "nl")))
-       ^((mov (t ,tn) (d ,dn))
-         (jmp ,lab4)
-         ,lab1
-         ,lab2
-         (mov (t ,tn) (t 0))
-         (jmp ,lab5)
-         ,lab3
-         (ifq (t ,tn) (t 0) ,lab4)
-         ,lab5
-         ,*rest)))
-    (@else else)))
-
-(defun rewrite (fun list)
-  (build
-    (while* list
-      (let ((nlist [fun list]))
-        (if (eq list nlist)
-          (if list (add (pop list)))
-          (set list nlist))))))
-
-(defun dedup-labels (insns)
-  (rewrite-case tail insns
-    ((@(symbolp @label0) @(symbolp @label1) . @rest)
-     (set insns (mapcar [iffi listp (op subst label1 label0)]
-                        (remq label1 insns)))
-     (cons label0 rest))
-    (@else tail))
-  insns)
-
-(defun early-peephole (code)
-  (rewrite-case insns code
-    (((mov (t @t1) (d @d1))
-      (jmp @lab2)
-      @(symbolp @lab1)
-      (mov (t @t1) (t 0))
-      @lab2
-      (ifq (t @t1) (t 0) @lab3)
-      . @rest)
-    ^((mov (t ,t1) (d ,d1))
-      (jmp ,lab3)
-      ,lab1
-      (mov (t ,t1) (t 0))
-      ,lab2
-      ,*rest))
-    (@else else)))
diff --git a/share/txr/stdlib/package.tl b/share/txr/stdlib/package.tl
deleted file mode 100644
index 63c13f5e..00000000
--- a/share/txr/stdlib/package.tl
+++ /dev/null
@@ -1,91 +0,0 @@
-;; Copyright 2016-2021
-;; Kaz Kylheku <kaz@kylheku.com>
-;; Vancouver, Canada
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are met:
-;;
-;; 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 BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(defun sys:name-str (kind sym-or-string)
-  (cond
-    ((symbolp sym-or-string) (symbol-name sym-or-string))
-    ((stringp sym-or-string) sym-or-string)
-    (t (throw 'eval-error "~s: ~s isn't a valid ~a name"
-              'defpackage sym-or-string kind))))
-
-(defmacro defpackage (name . clauses)
-  (let* ((pkg (gensym "pkg-"))
-         (nstr (sys:name-str 'package name))
-         (exp-clauses (append-each ((c clauses))
-                        (tree-case c
-                          ((keyword package . rest)
-                            (caseql keyword
-                              (:use-from
-                                ^((let ((p (find-package ',package)))
-                                    (unless p
-                                      (throwf 'eval-error
-                                              "~s: no such package: ~s"
-                                              'defpackage ',package))
-                                    (each ((n ',(mapcar (op sys:name-str 'symbol)
-                                                        rest)))
-                                      (let ((s (intern n p)))
-                                        (unless (eq (symbol-package s) p)
-                                          (throwf 'eval-error
-                                                  "~s: won't use non-local ~s from ~s"
-                                                  'defpackage s p))
-                                        (use-sym s ,pkg))))))
-                              (t :)))
-                          ((keyword . rest)
-                            (caseql keyword
-                              (:use
-                                (if rest ^((use-package ',rest ,pkg))))
-                              (:use-syms
-                                ^((each ((s ',rest))
-                                    (use-sym s ,pkg))))
-                              (:local
-                                ^((each ((n ',(mapcar (op sys:name-str 'symbol)
-                                                      rest)))
-                                    (let ((s (intern n ,pkg)))
-                                      (unless (eq (symbol-package s) ,pkg)
-                                        (unuse-sym s ,pkg)
-                                        (intern n ,pkg))))))
-                              (:fallback
-                                (if rest ^((set-package-fallback-list ,pkg
-                                                                      ',rest))))
-                              (:use-from
-                                 (throwf 'eval-error
-                                         "~s: :use-from clause needs package argument"
-                                          'defpackage))
-                              (t :)))
-                          (atom
-                            (throwf 'eval-error "~s: invalid clause: ~s"
-                                    'defpackage atom))))))
-    ^(let ((,pkg (or (find-package ,nstr)
-                     (make-package ,nstr))))
-       ,*exp-clauses
-       ,pkg)))
-
-(defmacro in-package (pkg)
-  (unless (or (symbolp pkg) (stringp pkg))
-    (throwf 'eval-error "~s: ~s isn't a package name" 'in-package pkg))
-  ^(set *package* (or (find-package ',pkg)
-                      (throwf 'eval-error "~s: no such package: ~s"
-                              'in-package ',pkg))))
diff --git a/share/txr/stdlib/param.tl b/share/txr/stdlib/param.tl
deleted file mode 100644
index 0551e9ce..00000000
--- a/share/txr/stdlib/param.tl
+++ /dev/null
@@ -1,81 +0,0 @@
-;; Copyright 2019-2021
-;; Kaz Kylheku <kaz@kylheku.com>
-;; Vancouver, Canada
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are met:
-;;
-;; 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 BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(compile-only
-  (defstruct param-parser-base nil
-    syntax form
-    rest req opt key
-    nreq nopt nfix
-
-    (:postinit (me)
-      (let* ((rest (nthlast 0 me.syntax))
-             (fixed (ldiff me.syntax rest))
-             nonkey key)
-        (cond
-          (me.mac-param-p
-            (while fixed
-              (let ((pp (pop fixed)))
-                (caseq pp
-                  ((:env :whole :form)
-                   (unless fixed
-                     (compile-error me.form "~s requires argument" pp))
-                   (push (cons pp (pop fixed)) key))
-                  (t (push pp nonkey)))))
-            (set nonkey (nreverse nonkey)
-                 key (nreverse key)))
-          (t (set nonkey fixed)))
-        (tree-bind (: rp opt) (split* nonkey (op where (op eq :)))
-          (set me.rest rest
-               me.req rp
-               me.opt (mapcar [iffi atom list] opt)
-               me.key key
-               me.nreq (len rp)
-               me.nopt (len opt)
-               me.nfix (+ me.nreq me.nopt)))))
-
-    (:method opt-syms (me)
-      (build
-        (each ((o me.opt))
-          (caseql (len o)
-            ((1 2) (add (car o)))
-            (3 (add (car o) (caddr o))))))))
-
-  (defstruct (fun-param-parser syntax form) param-parser-base
-    (mac-param-p nil))
-
-  (defstruct (mac-param-parser syntax form) param-parser-base
-    (mac-param-p t))
-
-  (defstruct (param-info fun) nil
-    fun
-    nreq nopt nfix rest
-    (:postinit (me)
-      (let* ((fix (fun-fixparam-count me.fun))
-             (opt (fun-optparam-count me.fun)))
-        (set me.nreq (- fix opt)
-             me.nopt opt
-             me.nfix fix
-             me.rest (fun-variadic me.fun))))))
diff --git a/share/txr/stdlib/path-test.tl b/share/txr/stdlib/path-test.tl
deleted file mode 100644
index fb132f7f..00000000
--- a/share/txr/stdlib/path-test.tl
+++ /dev/null
@@ -1,187 +0,0 @@
-;; Copyright 2015-2021
-;; Kaz Kylheku <kaz@kylheku.com>
-;; Vancouver, Canada
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are met:
-;;
-;; 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 BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(defun sys:do-path-test (statfun path testfun)
-  [testfun (if (typep path 'stat)
-             path
-             (ignerr [statfun path]))])
-
-(eval-only
-  (defmacro sys:path-test ((sym statfun path) . body)
-    ^[sys:do-path-test ,statfun ,path
-       (lambda (,sym) (when ,sym ,*body))]))
-
-(defun sys:path-test-type (statfun path code)
-  (sys:path-test (s statfun path)
-    (eql (logand s.mode s-ifmt) code)))
-
-(defun sys:path-test-mode (statfun path mask)
-  (sys:path-test (s statfun path)
-    (plusp (logand s.mode mask))))
-
-(defun path-exists-p (path)
-  (sys:path-test (s stat path) t))
-
-(defun path-file-p (path)
-  [sys:path-test-type stat path s-ifreg])
-
-(defun path-dir-p (path)
-  [sys:path-test-type stat path s-ifdir])
-
-(defun path-symlink-p (path)
-  [sys:path-test-type lstat path s-iflnk])
-
-(defun path-blkdev-p (path)
-  [sys:path-test-type stat path s-ifblk])
-
-(defun path-chrdev-p (path)
-  [sys:path-test-type stat path s-ifchr])
-
-(defun path-sock-p (path)
-  [sys:path-test-type stat path s-ifsock])
-
-(defun path-pipe-p (path)
-  [sys:path-test-type stat path s-ififo])
-
-(defun path-setgid-p (path)
-  [sys:path-test-mode stat path s-isgid])
-
-(defun path-setuid-p (path)
-  [sys:path-test-mode stat path s-isuid])
-
-(defun path-sticky-p (path)
-  [sys:path-test-mode stat path s-isvtx])
-
-(defun path-mine-p (path)
-  (sys:path-test (s stat path)
-    (= s.uid (geteuid))))
-
-(defun path-my-group-p (path)
-  (sys:path-test (s stat path)
-    (let ((g s.gid))
-      (or (= g (getegid))
-          (find g (getgroups))))))
-
-;; umask, gmask and omask must test identical permissions
-;; multiple permissions may be tested, but not a combination
-;; of x with any other permission.
-(defun sys:path-access (path umask gmask omask)
-  (sys:path-test (s stat path)
-    (let ((m s.mode)
-          (euid (geteuid)))
-      (cond
-        ((zerop euid) (or (zerop (logand umask s-ixusr))
-                          (plusp (logand m (logior umask gmask omask)))))
-        ((= euid s.uid) (= umask (logand m umask)))
-        ((let ((g s.gid))
-           (or (= g (getegid))
-               (find g (getgroups))))
-         (= gmask (logand m gmask)))
-        (t (= omask (logand m omask)))))))
-
-(defun path-executable-to-me-p (path)
-  (sys:path-access path s-ixusr s-ixgrp s-ixoth))
-
-(defun path-writable-to-me-p (path)
-  (sys:path-access path s-iwusr s-iwgrp s-iwoth))
-
-(defun path-readable-to-me-p (path)
-  (sys:path-access path s-irusr s-irgrp s-iroth))
-
-(defun path-read-writable-to-me-p (path)
-  (sys:path-access path
-                   (logior s-irusr s-iwusr)
-                   (logior s-irgrp s-iwgrp)
-                   (logior s-iroth s-iwoth)))
-
-(defun path-private-to-me-p (path)
-  (sys:path-test (s stat path)
-    (let ((m s.mode)
-          (euid (geteuid)))
-      (mlet ((g (getgrgid s.gid))
-             (name (let ((pw (getpwuid euid)))
-                     (if pw pw.name)))
-             (suname (let ((pw (getpwuid 0)))
-                       (if pw pw.name))))
-        (and (or (zerop s.uid)
-                 (eql euid s.uid))
-             (zerop (logand m s-iwoth))
-             (or (zerop (logand m s-iwgrp))
-                 (null g.mem)
-                 (and (all g.mem (orf (op equal name)
-                                      (op equal suname))))))))))
-
-(defun path-strictly-private-to-me-p (path)
-  (sys:path-test (s stat path)
-    (let ((m s.mode)
-          (euid (geteuid)))
-      (mlet ((g (getgrgid s.gid))
-             (name (let ((pw (getpwuid euid)))
-                     (if pw pw.name)))
-             (suname (let ((pw (getpwuid 0)))
-                       (if pw pw.name))))
-        (and (or (zerop s.uid)
-                 (eql euid s.uid))
-             (zerop (logand m (logior s-iroth s-iwoth)))
-             (or (zerop (logand m (logior s-irgrp s-iwgrp)))
-                 (null g.mem)
-                 (and (all g.mem (orf (op equal name)
-                                      (op equal suname))))))))))
-
-
-(defmacro sys:path-examine ((sym statfun path) . body)
-  ^[sys:do-path-test ,statfun ,path
-     (lambda (,sym) ,*body)])
-
-(defun path-newer (path-0 path-1)
-  (sys:path-examine (s0 stat path-0)
-    (sys:path-examine (s1 stat path-1)
-      (if s0
-        (or (null s1)
-            (let ((mt0 s0.mtime)
-                  (mt1 s1.mtime))
-              (or (> mt0 mt1)
-                  (and (= mt0 mt1)
-                       (> s0.mtime-nsec s1.mtime-nsec)))))))))
-
-(defun path-older (path-0 path-1)
-  (path-newer path-1 path-0))
-
-(defun path-same-object (path-0 path-1)
-  (sys:path-examine (s0 stat path-0)
-    (sys:path-examine (s1 stat path-1)
-      (and s0 s1
-           (eql s0.dev s1.dev)
-           (eql s0.ino s1.ino)))))
-
-(defun path-dir-empty (path)
-  (when (path-dir-p path)
-    (let ((name (if (stringp path) path path.path)))
-      (with-stream (ds (open-directory name))
-        (for (ent) ((set ent (get-line ds)) t) ()
-          (casequal ent
-            (("." ".."))
-            (t (return nil))))))))
diff --git a/share/txr/stdlib/pic.tl b/share/txr/stdlib/pic.tl
deleted file mode 100644
index 6c2c8048..00000000
--- a/share/txr/stdlib/pic.tl
+++ /dev/null
@@ -1,119 +0,0 @@
-;; Copyright 2021
-;; Kaz Kylheku <kaz@kylheku.com>
-;; Vancouver, Canada
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are met:
-;;
-;; 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 BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(defun expand-pic-num (fmt val)
-  (let* ((zero (or (starts-with "0" fmt)
-                   (starts-with "+0" fmt)
-                   (starts-with "-0" fmt)))
-         (plus (eql [fmt 0] #\+))
-         (minus (eql [fmt 0] #\-))
-         (exc (pos #\! fmt))
-         (dot (or exc (pos #\. fmt)))
-         (fmt (if (and exc (eq #\! [fmt -1])) [fmt 0..-1] fmt))
-         (int (if dot [fmt 0..dot] fmt))
-         (fra (if dot [fmt (succ dot)..:] "")))
-    (let ((code (if (or minus plus (not zero))
-                  ^(fmt ,`~@(len fmt),@(if plus "+")@(if zero "0")@(len fra)f`
-                        ,val)
-                  ^(fmt ,`~@(len fmt),-0@(len fra)f`
-                        ,val))))
-      (if exc
-        (with-gensyms (str)
-          ^(let ((,str ,code))
-             (if (> (len ,str) ,(len fmt))
-               ,(mkstring (len fmt) #\#)
-               ,str)))
-        code))))
-
-(defun expand-pic-align (chr fmt val)
-  ^(fmt ,`~@(if chr chr)@(len fmt)a` ,val))
-
-(defun pic-join-opt (join-form)
-  (labels ((et (str) (regsub #/\~/ "~~" str)))
-    (match-case join-form
-      ((join @(stringp @s) (fmt `@fmt` . @args) . @rest)
-       (pic-join-opt ^(join (fmt ,`@(et s)@fmt` ,*args) ,*rest)))
-      ((join (fmt `@fmt` . @args) @(stringp @s) . @rest)
-       (pic-join-opt ^(join (fmt ,`@fmt@(et s)` ,*args) ,*rest)))
-      ((join (fmt `@fmt1` . @args1) (fmt `@fmt2` . @args2) . @rest)
-       (pic-join-opt ^(join (fmt ,`@fmt1@fmt2` ,*args1 ,*args2) ,*rest)))
-      ((join @(stringp @s1) @(stringp @s2) . @rest)
-       (pic-join-opt ^(join ,`@s1@s2` ,*rest)))
-      ((join "" @item . @rest)
-       (pic-join-opt ^(join ,item ,*rest)))
-      ((join @item "" . @rest)
-       (pic-join-opt ^(join ,item ,*rest)))
-      ((join @item) item)
-      (@else else))))
-
-(defun expand-pic (f fmt val)
-  (unless (stringp fmt)
-    (compile-error f "~s is required to be a format string" fmt))
-  (cond
-    ([m^$ #/\~[~#<>\|\-+0.!]/ fmt] [fmt 1..2])
-    ([m^$ #/\~./ fmt] (compile-error f "unrecognized escape sequence ~a" fmt))
-    ([m^$ #/\~/ fmt] (compile-error f "incomplete ~~ escape"))
-    ([m^$ #/[+\-]?0?#+([.!]#+|!)?/ fmt] (expand-pic-num fmt val))
-    ([m^$ #/<+/ fmt] (expand-pic-align "<" fmt val))
-    ([m^$ #/>+/ fmt] (expand-pic-align nil fmt val))
-    ([m^$ #/\|+/ fmt] (expand-pic-align "^" fmt val))
-    (t (compile-error f "unrecognized format string ~s" fmt))))
-
-(defmacro pic (:form f :env e bigfmt . args)
-  (let* ((regex #/[+\-]?0?#+([.!]#+|!)?| \
-                  <+| \
-                  >+| \
-                  \|+| \
-                  \~.|\~/))
-    (labels ((pic-compile-string (fmtstr)
-               (let ((items (collect-each ((piece (tok regex t fmtstr)))
-                              (cond
-                                ((m^$ regex piece)
-                                 (cond
-                                   ((starts-with "~" piece)
-                                    (expand-pic f piece nil))
-                                   (args
-                                     (expand-pic f piece (pop args)))
-                                   (t (compile-error
-                                        f "insufficient arguments for format"))))
-                                (t piece)))))
-                 (pic-join-opt ^(join ,*items)))))
-      (match-case bigfmt
-        (@(stringp @s)
-           (let ((out (pic-compile-string s)))
-             (if args
-               (compile-warning f "excess arguments"))
-             out))
-        ((@(or sys:quasi) . @qargs)
-           (let ((nqargs (build (each ((q qargs))
-                                  (if (stringp q)
-                                    (add (pic-compile-string q))
-                                    (add q))))))
-             (if args
-               (compile-warning f "excess arguments"))
-             ^(sys:quasi ,*nqargs)))
-        (@else (compile-error
-                 f "~s is required to be a string or quasiliteral" else))))))
diff --git a/share/txr/stdlib/place.tl b/share/txr/stdlib/place.tl
deleted file mode 100644
index 3ee0ea8c..00000000
--- a/share/txr/stdlib/place.tl
+++ /dev/null
@@ -1,971 +0,0 @@
-;; Copyright 2015-2021
-;; Kaz Kylheku <kaz@kylheku.com>
-;; Vancouver, Canada
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are met:
-;;
-;; 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 BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(defvar *place-clobber-expander* (hash))
-(defvar *place-update-expander* (hash))
-(defvar *place-delete-expander* (hash))
-(defvar *place-macro* (hash))
-(defvar sys:*pl-env* nil)
-(defvar sys:*pl-form* nil)
-
-(defun sys:eval-err (. params)
-  (throwf 'eval-error . params))
-
-(defun sys:sym-update-expander (getter-name setter-name
-                                place-expr op-body)
-  ^(macrolet ((,getter-name () ',place-expr)
-              (,setter-name (val-expr) ^(sys:setq ,',place-expr
-                                                  ,val-expr)))
-     ,op-body))
-
-(defun sys:sym-clobber-expander (simple-setter-name
-                                 place-expr op-body)
-  ^(macrolet ((,simple-setter-name (val-expr)
-                 ^(sys:setq ,',place-expr ,val-expr)))
-     ,op-body))
-
-(defun sys:sym-delete-expander (deleter-name
-                                place-expr . op-body)
-  ^(macrolet ((,deleter-name (:env env)
-                (when (lexical-var-p env ',place-expr)
-                  (sys:eval-err "~s is a lexical variable, thus not deletable"
-                                ',place-expr))
-                ^(prog1
-                   (symbol-value ',',place-expr)
-                   (makunbound ',',place-expr))))
-     ,*op-body))
-
-(defun sys:get-place-macro (sym)
-  (or [*place-macro* sym]
-      (progn (sys:try-load sym) [*place-macro* sym])))
-
-(defun sys:pl-expand (unex-place env)
-  (while t
-    (let ((place unex-place)
-          pm-expander)
-      (while (and (consp place)
-                  (sys:setq pm-expander (sys:get-place-macro (car place)))
-                  (sys:setq place (sys:set-macro-ancestor [pm-expander place] place))
-                  (neq place unex-place))
-        (sys:setq unex-place place))
-      (sys:setq place (macroexpand-1 place env))
-      (when (or (eq place unex-place)
-                (null place)
-                (and (atom place) (not (symbolp place))))
-        (return-from sys:pl-expand place))
-      (sys:setq unex-place place))))
-
-(defun place-form-p (unex-place env)
-  (let ((place (sys:pl-expand unex-place env)))
-    (or (bindable place)
-        (and (consp place) [*place-update-expander* (car place)] t))))
-
-(defun get-update-expander (place)
-  (cond
-    ((symbolp place) (fun sys:sym-update-expander))
-    ((consp place) (or [*place-update-expander* (car place)]
-                       (sys:eval-err "~s is not an assignable place" place)))
-    (t (sys:eval-err "form ~s is not syntax denoting an assignable place" place))))
-
-(defun get-clobber-expander (place)
-  (cond
-    ((symbolp place) (fun sys:sym-clobber-expander))
-    ((consp place) (or [*place-clobber-expander* (car place)]
-                       (iflet ((fun [*place-update-expander* (car place)]))
-                          (op apply fun (gensym) @1 @2 @rest))
-                       (sys:eval-err "~s is not an assignable place" place)))
-    (t (sys:eval-err "form ~s is not syntax denoting an assignable place" place))))
-
-(defun get-delete-expander (place)
-  (cond
-    ((symbolp place) (fun sys:sym-delete-expander))
-    ((consp place) (or [*place-delete-expander* (car place)]
-                       (sys:eval-err "~s is not a deletable place" place)))
-    (t (sys:eval-err "form ~s is not syntax denoting a deletable place" place))))
-
-(defun sys:r-s-let-expander (bindings body e letsym pred)
-  (let ((exp-bindings (mapcar (aret ^(,@1 ,(macroexpand @2 e))) bindings)))
-    (let ((renames [keep-if pred exp-bindings second])
-          (regular [remove-if pred exp-bindings second]))
-    (cond ((and renames regular)
-            ^(symacrolet ,renames
-               (,letsym ,regular ,*body)))
-          (renames ^(symacrolet ,renames ,*body))
-          (regular ^(,letsym ,regular ,*body))
-          (t ^(progn ,*body))))))
-
-(defmacro rlet (bindings :env e . body)
-  [sys:r-s-let-expander bindings body e 'let constantp])
-
-(defmacro slet (bindings :env e . body)
-  (sys:r-s-let-expander bindings body e 'let [orf constantp bindable]))
-
-(defmacro alet (bindings :env e . body)
-  (let ((exp-bindings (mapcar (aret ^(,@1 ,(macroexpand @2 e))) bindings)))
-    (if [some exp-bindings constantp second]
-      [sys:r-s-let-expander exp-bindings body e 'alet constantp]
-      ^(,(if [all exp-bindings bindable second]
-           'symacrolet 'let)
-         ,exp-bindings ,*body))))
-
-(defmacro with-gensyms (syms . body)
-  ^(let ,(zip syms (repeat '((gensym)))) ,*body))
-
-(defun sys:propagate-ancestor (to-tree from-form . syms)
-  (unless (macro-ancestor to-tree)
-    (tree-case to-tree
-      ((a . d)
-       (when (memq a syms)
-         (sys:set-macro-ancestor to-tree from-form))
-       (sys:propagate-ancestor a from-form . syms)
-       (sys:propagate-ancestor d from-form . syms))))
-  to-tree)
-
-(defun call-update-expander (getter setter unex-place env body)
-  (sys:propagate-ancestor body unex-place getter setter)
-  (let* ((place (sys:pl-expand unex-place env))
-         (expander (get-update-expander place))
-         (sys:*pl-env* env)
-         (sys:*pl-form* unex-place)
-         (expansion [expander getter setter place body])
-         (expansion-ex (expand expansion env)))
-    (sys:propagate-ancestor expansion-ex place getter setter)))
-
-(defun call-clobber-expander (ssetter unex-place env body)
-  (sys:propagate-ancestor body unex-place ssetter)
-  (let* ((place (sys:pl-expand unex-place env))
-         (expander (get-clobber-expander place))
-         (sys:*pl-env* env)
-         (sys:*pl-form* unex-place)
-         (expansion [expander ssetter place body])
-         (expansion-ex (expand expansion env)))
-    (sys:propagate-ancestor expansion-ex place ssetter)))
-
-(defun call-delete-expander (deleter unex-place env body)
-  (sys:propagate-ancestor body unex-place deleter)
-  (let* ((place (sys:pl-expand unex-place env))
-         (expander (get-delete-expander place))
-         (sys:*pl-env* env)
-         (sys:*pl-form* unex-place)
-         (expansion [expander deleter place body])
-         (expansion-ex (expand expansion env)))
-    (sys:propagate-ancestor expansion-ex place deleter)))
-
-(defmacro with-update-expander ((getter setter) unex-place env body)
-  ^(with-gensyms (,getter ,setter)
-     (call-update-expander ,getter ,setter ,unex-place ,env ,body)))
-
-(defmacro with-clobber-expander ((ssetter) unex-place env body)
-  ^(with-gensyms (,ssetter)
-     (call-clobber-expander ,ssetter ,unex-place ,env ,body)))
-
-(defmacro with-delete-expander ((deleter) unex-place env body)
-  ^(with-gensyms (,deleter)
-     (call-delete-expander ,deleter ,unex-place ,env ,body)))
-
-(defmacro set (:env env . place-value-pairs)
-  (let ((assign-forms (mapcar (tb ((place : (value nil value-present-p)))
-                                (unless value-present-p
-                                  (sys:eval-err "set: arguments must be pairs"))
-                                (with-clobber-expander (ssetter) place env
-                                   ^(,ssetter ,value)))
-                              (tuples 2 place-value-pairs))))
-    (if (cdr assign-forms)
-      ^(progn ,*assign-forms)
-      (car assign-forms))))
-
-(defmacro pset (:env env . place-value-pairs)
-  (let ((len (length place-value-pairs)))
-    (cond
-      ((oddp len) (sys:eval-err "pset: arguments must be pairs"))
-      ((<= len 2) ^(set ,*place-value-pairs))
-      (t (let* ((pvtgs (mapcar (tb ((a b))
-                                 (list a b (gensym) (gensym) (gensym)))
-                               (tuples 2 place-value-pairs)))
-                (ls (reduce-left (tb ((lets stores) (place value temp getter setter))
-                                     (list ^((,temp ,value) ,*lets)
-                                           ^((,setter ,temp) ,*stores)))
-                                 pvtgs '(nil nil)))
-                (lets (first ls))
-                (stores (second ls))
-                (body-form ^(rlet (,*lets) ,*stores)))
-           (reduce-left (tb (accum-form (place value temp getter setter))
-                          (call-update-expander getter setter
-                                                place env accum-form))
-                        pvtgs body-form))))))
-
-(defmacro zap (place : (new-val nil) :env env)
-  (with-update-expander (getter setter) place env
-    ^(prog1 (,getter) (,setter ,new-val))))
-
-(defmacro flip (place :env env)
-  (with-update-expander (getter setter) place env
-    ^(,setter (not (,getter)))))
-
-(defmacro inc (place : (delta 1) :env env)
-  (with-update-expander (getter setter) place env
-    (caseql delta
-      (0 place)
-      (1 ^(,setter (succ (,getter))))
-      (2 ^(,setter (ssucc (,getter))))
-      (3 ^(,setter (sssucc (,getter))))
-      (t ^(,setter (+ (,getter) ,delta))))))
-
-(defmacro dec (place : (delta 1) :env env)
-  (with-update-expander (getter setter) place env
-    (caseql delta
-      (0 place)
-      (1 ^(,setter (pred (,getter))))
-      (2 ^(,setter (ppred (,getter))))
-      (3 ^(,setter (pppred (,getter))))
-      (t ^(,setter (- (,getter) ,delta))))))
-
-(defmacro pinc (place : (delta 1) :env env)
-  (with-gensyms (oldval)
-    (with-update-expander (getter setter) place env
-      (caseql delta
-        (0 place)
-        (1 ^(let ((,oldval (,getter))) (,setter (succ ,oldval)) ,oldval))
-        (2 ^(let ((,oldval (,getter))) (,setter (ssucc ,oldval)) ,oldval))
-        (3 ^(let ((,oldval (,getter))) (,setter (sssucc ,oldval)) ,oldval))
-        (t ^(let ((,oldval (,getter))) (,setter (+ ,oldval, delta)) ,oldval))))))
-
-(defmacro pdec (place : (delta 1) :env env)
-  (with-gensyms (oldval)
-    (with-update-expander (getter setter) place env
-      (caseql delta
-        (0 place)
-        (1 ^(let ((,oldval (,getter))) (,setter (pred ,oldval)) ,oldval))
-        (2 ^(let ((,oldval (,getter))) (,setter (ppred ,oldval)) ,oldval))
-        (3 ^(let ((,oldval (,getter))) (,setter (pppred ,oldval)) ,oldval))
-        (t ^(let ((,oldval (,getter))) (,setter (- ,oldval, delta)) ,oldval))))))
-
-(defmacro swap (place-0 place-1 :env env)
-  (with-gensyms (tmp)
-    (with-update-expander (getter-0 setter-0) place-0 env
-      (with-update-expander (getter-1 setter-1) place-1 env
-        ^(let ((,tmp (,getter-0)))
-           (,setter-0 (,getter-1))
-           (,setter-1 ,tmp))))))
-
-(defmacro push (new-item place :env env)
-  (with-gensyms (new-sym)
-    ^(alet ((,new-sym ,new-item))
-       ,(with-update-expander (getter setter) place env
-          ^(,setter (cons ,new-sym (,getter)))))))
-
-(defmacro pop (place :env env)
-  (with-gensyms (tmp)
-    (with-update-expander (getter setter) place env
-      ^(alet ((,tmp (,getter)))
-         (prog1 (car ,tmp) (,setter (cdr ,tmp)))))))
-
-(defmacro pushnew (new-item place :env env :
-                            (testfun :)
-                            (keyfun :))
-  (with-update-expander (getter setter) place env
-    (with-gensyms (new-item-sym old-list-sym)
-      ^(rlet ((,new-item-sym ,new-item))
-         ,(with-update-expander (getter setter) place env
-            ^(let ((,old-list-sym (,getter)))
-               (if (member ,new-item-sym ,old-list-sym ,testfun ,keyfun)
-                 ,old-list-sym
-                 (,setter (cons ,new-item-sym ,old-list-sym)))))))))
-
-(defmacro shift (:form f :env env . places)
-  (tree-case places
-    (() (compile-error f "need at least two arguments"))
-    ((place) (compile-error f "need at least two arguments"))
-    ((place newvalue)
-     (with-update-expander (getter setter) place env
-        ^(prog1 (,getter) (,setter ,newvalue))))
-    ((place . others)
-      (with-update-expander (getter setter) place env
-        ^(prog1 (,getter) (,setter (shift ,*others)))))))
-
-(defmacro rotate (:env env . places)
-  (tree-case places
-    (() ())
-    ((fplace) fplace)
-    ((fplace . rplaces)
-     (with-gensyms (tmp)
-       (with-update-expander (getter-f setter-f) fplace env
-         ^(let ((,tmp (,getter-f)))
-            (,setter-f (shift ,*rplaces ,tmp))
-            ,tmp))))))
-
-(defmacro test-set (:env env place)
-  (with-update-expander (getter setter) place env
-    ^(unless (,getter)
-       (,setter t))))
-
-(defmacro test-clear (:env env place)
-  (with-update-expander (getter setter) place env
-    ^(when (,getter)
-       (,setter nil)
-       t)))
-
-(defmacro compare-swap (:env env comp-fun place comp-val store-val)
-  (with-update-expander (getter setter) place env
-    ^(when (,comp-fun (,getter) ,comp-val)
-       (,setter ,store-val)
-       t)))
-
-(defmacro test-inc (place : (delta 1) (upfrom-val 0))
-  ^(eql (pinc ,place ,delta) ,upfrom-val))
-
-(defmacro test-dec (place : (delta 1) (downto-val 0))
-  ^(eql (dec ,place ,delta) ,downto-val))
-
-(defmacro del (place :env env)
-  (with-delete-expander (deleter) place env
-    ^(,deleter)))
-
-(defmacro lset (:form f . places-source)
-  (let ((places (butlast places-source))
-        (source (last places-source))
-        (orig (gensym))
-        (iter (gensym)))
-    (unless places
-      (compile-error f "require one or more places followed by expression"))
-    ^(let* ((,orig ,(car source))
-            (,iter ,orig))
-       ,*(butlast (mappend (ret ^((set ,@1 (car ,iter)) (set ,iter (cdr ,iter))))
-                           places))
-       ,orig)))
-
-(defmacro upd (place . opip-args)
-  (with-gensyms (pl)
-    ^(placelet ((,pl ,place))
-       (set ,pl (call (opip ,*opip-args) ,pl)))))
-
-(defmacro defplace (place-destructuring-args body-sym
-                    (getter-sym setter-sym update-body) :
-                    ((ssetter-sym clobber-body))
-                    ((deleter-sym delete-body)))
-  (let ((name (car place-destructuring-args))
-        (args (cdr place-destructuring-args)))
-    (unless (and name
-                 (symbolp name)
-                 (not (keywordp name))
-                 (not (eq t name)))
-      (compile-error sys:*pl-form* "~s cannot be used as a place name" name))
-    (with-gensyms (place)
-      ^(progn
-         (sethash *place-update-expander* ',name
-           (lambda (,getter-sym ,setter-sym ,place ,body-sym)
-             (tree-bind ,args (cdr ,place)
-                ,update-body)))
-         ,*(if ssetter-sym
-            ^((sethash *place-clobber-expander* ',name
-                (lambda (,ssetter-sym ,place ,body-sym)
-                  (tree-bind ,args (cdr ,place)
-                     ,clobber-body)))))
-         ,*(if deleter-sym
-             ^((sethash *place-delete-expander* ',name
-                 (lambda (,deleter-sym ,place ,body-sym)
-                   (tree-bind ,args (cdr ,place)
-                      ,delete-body)))))
-         ',name))))
-
-(defmacro define-place-macro (name place-destructuring-args . body)
-  (with-gensyms (name-dummy args)
-    ^(progn
-       (sethash *place-macro* ',name
-                (lambda (,args)
-                  (mac-param-bind ,args
-                                  (,name-dummy ,*place-destructuring-args)
-                                  ,args ,*body)))
-       ',name)))
-
-(defplace (sys:var arg) body
-  (getter setter
-    ^(macrolet ((,getter () ^(sys:var ,',arg))
-                (,setter (val) ^(sys:setq ,'(sys:var ,arg) ,val)))
-       ,body)))
-
-(defplace (sys:l1-val arg) body
-  (getter setter
-    ^(macrolet ((,getter () ^(sys:l1-val ,',arg))
-                (,setter (val) ^(sys:l1-setq ,',arg ,val)))
-         ,body))
-  (ssetter
-    ^(macrolet ((,ssetter (val) ^(sys:l1-setq ,',arg ,val)))
-       ,body)))
-
-(defplace (sys:lisp1-value arg) body
-  (getter setter
-    ^(macrolet ((,getter () ^(sys:lisp1-value ,',arg))
-                (,setter (val) ^(sys:lisp1-setq ,',arg ,val)))
-         ,body))
-  (ssetter
-    ^(macrolet ((,ssetter (val) ^(sys:lisp1-setq ,',arg ,val)))
-       ,body)))
-
-(defplace (car cell) body
-  (getter setter
-    (with-gensyms (cell-sym)
-      ^(slet ((,cell-sym ,cell))
-         (macrolet ((,getter () ^(car ,',cell-sym))
-                    (,setter (val) ^(sys:rplaca ,',cell-sym ,val)))
-           ,body))))
-  (ssetter
-    ^(macrolet ((,ssetter (val) ^(sys:rplaca ,',cell ,val)))
-      ,body))
-  (deleter
-    ^(macrolet ((,deleter () ^(pop ,',cell)))
-       ,body)))
-
-(defplace (cdr cell) body
-  (getter setter
-    (with-gensyms (cell-sym)
-      ^(slet ((,cell-sym ,cell))
-         (macrolet ((,getter () ^(cdr ,',cell-sym))
-                    (,setter (val) ^(sys:rplacd ,',cell-sym ,val)))
-           ,body))))
-  (ssetter
-    ^(macrolet ((,ssetter (val) ^(sys:rplacd ,',cell ,val)))
-       ,body))
-  (deleter
-    ^(macrolet ((,deleter ()
-                  (with-gensyms (tmp)
-                    (with-update-expander (cgetter csetter) ',cell nil
-                      ^(let ((,tmp (,cgetter)))
-                         (prog1 (cdr ,tmp) (,csetter (car ,tmp))))))))
-       ,body)))
-
-(defplace (nthcdr index list) body
-  (getter setter
-    (with-gensyms (index-sym list-sym sentinel-head-sym parent-cell-sym)
-      (if (place-form-p list sys:*pl-env*)
-        (with-update-expander (lgetter lsetter) list sys:*pl-env*
-          ^(alet ((,index-sym ,index)
-                  (,list-sym (,lgetter)))
-             (let* ((,sentinel-head-sym (cons nil ,list-sym))
-                    (,parent-cell-sym (nthcdr ,index-sym ,sentinel-head-sym)))
-               (macrolet ((,getter () ^(cdr ,',parent-cell-sym))
-                          (,setter (val)
-                            ^(prog1 (sys:rplacd ,',parent-cell-sym ,val)
-                                    (,',lsetter (cdr ,',sentinel-head-sym)))))
-                 ,body))))
-        ^(alet ((,index-sym ,index)
-                (,list-sym ,list))
-           (let ((,parent-cell-sym (nthcdr (pred ,index-sym) ,list-sym)))
-             (macrolet ((,getter () ^(cdr ,',parent-cell-sym))
-                        (,setter (val)
-                          ^(sys:rplacd ,',parent-cell-sym ,val)))
-               ,body)))))))
-
-(defplace (nthlast index list) body
-  (getter setter
-    (with-gensyms (index-sym list-sym sentinel-head-sym parent-cell-sym)
-      (if (place-form-p list sys:*pl-env*)
-        (with-update-expander (lgetter lsetter) list sys:*pl-env*
-          ^(alet ((,index-sym ,index)
-                  (,list-sym (,lgetter)))
-             (let* ((,sentinel-head-sym (cons nil ,list-sym))
-                    (,parent-cell-sym (nthlast (succ ,index-sym)
-                                               ,sentinel-head-sym)))
-               (macrolet ((,getter () ^(cdr ,',parent-cell-sym))
-                          (,setter (val)
-                            ^(prog1 (sys:rplacd ,',parent-cell-sym ,val)
-                                    (,',lsetter (cdr ,',sentinel-head-sym)))))
-                 ,body))))
-        ^(alet ((,index-sym index)
-                (,list-sym ,list))
-           (let ((,parent-cell-sym (nthlast (succ ,index-sym) ,list-sym)))
-             (macrolet ((,getter () ^(cdr ,',parent-cell-sym))
-                        (,setter (val)
-                          ^(sys:rplacd ,',parent-cell-sym ,val)))
-               ,body)))))))
-
-(defplace (butlastn num list) body
-  (getter setter
-    (with-gensyms (num-sym list-sym head-sym tail-sym val-sym)
-      (with-update-expander (lgetter lsetter) list sys:*pl-env*
-        ^(alet ((,num-sym ,num)
-                (,list-sym (,lgetter)))
-           (let* ((,tail-sym (nthlast ,num-sym ,list-sym))
-                  (,head-sym (ldiff ,list-sym ,tail-sym)))
-             (macrolet ((,getter () ,head-sym)
-                        (,setter (val)
-                           ^(alet ((,',val-sym ,val))
-                              (progn (,',lsetter (append ,',val-sym
-                                                         ,',tail-sym))
-                                     ,',val-sym))))
-               ,body)))))))
-
-(defplace (vecref vector index :whole args) body
-  (getter setter
-    (with-gensyms (vec-sym ind-sym)
-      ^(alet ((,vec-sym ,vector)
-              (,ind-sym ,index))
-         (macrolet ((,getter () ^(vecref ,',vec-sym ,',ind-sym))
-                    (,setter (val) ^(refset ,',vec-sym ,',ind-sym ,val)))
-            ,body))))
-  (ssetter
-    ^(macrolet ((,ssetter (val) ^(refset ,*',args ,val)))
-       ,body))
-  (deleter
-    (with-gensyms (vec-sym ind-sym)
-      ^(alet ((,vec-sym ,vector)
-              (,ind-sym ,index))
-         (macrolet ((,deleter ()
-                       ^(prog1 (vecref ,',vec-sym ,',ind-sym)
-                               (replace-vec ,',vec-sym nil
-                                            ,',ind-sym (succ ,',ind-sym)))))
-           ,body)))))
-
-(defplace (chr-str string index :whole args) body
-  (getter setter
-    (with-gensyms (str-sym ind-sym)
-      ^(alet ((,str-sym ,string)
-              (,ind-sym ,index))
-         (macrolet ((,getter () ^(chr-str ,',str-sym ,',ind-sym))
-                    (,setter (val) ^(chr-str-set ,',str-sym ,',ind-sym ,val)))
-            ,body))))
-  (ssetter
-    ^(macrolet ((,ssetter (val) ^(chr-str-set ,*',args ,val)))
-       ,body))
-  (deleter
-    (with-gensyms (str-sym ind-sym)
-      ^(alet ((,str-sym ,string)
-              (,ind-sym ,index))
-         (macrolet ((,deleter ()
-                       ^(prog1 (chr-str ,',str-sym ,',ind-sym)
-                               (replace-str ,',str-sym nil
-                                            ,',ind-sym (succ ,',ind-sym)))))
-           ,body)))))
-
-(defplace (ref seq index :whole args) body
-  (getter setter
-    (with-gensyms (seq-sym ind-sym)
-      ^(alet ((,seq-sym ,seq)
-              (,ind-sym ,index))
-         (macrolet ((,getter () ^(ref ,',seq-sym ,',ind-sym))
-                    (,setter (val) ^(refset ,',seq-sym ,',ind-sym ,val)))
-            ,body))))
-  (ssetter
-    ^(macrolet ((,ssetter (val) ^(refset ,*',args ,val)))
-       ,body))
-  (deleter
-    (with-gensyms (seq-sym ind-sym)
-      ^(alet ((,seq-sym ,seq)
-              (,ind-sym ,index))
-         (macrolet ((,deleter ()
-                       ^(prog1 (ref ,',seq-sym ,',ind-sym)
-                               (replace ,',seq-sym nil
-                                        ,',ind-sym (succ ,',ind-sym)))))
-           ,body)))))
-
-(defplace (sub seq :whole args : (from 0) (to t)) body
-  (getter setter
-    (with-gensyms (seq-sym from-sym to-sym v-sym)
-      (with-update-expander (seq-getter seq-setter) seq sys:*pl-env*
-        ^(alet ((,seq-sym (,seq-getter))
-                (,from-sym ,from)
-                (,to-sym ,to))
-           (macrolet ((,getter () ^(sub ,',seq-sym ,',from-sym ,',to-sym))
-                      (,setter (val)
-                        ^(alet ((,',v-sym ,val))
-                           (,',seq-setter (replace ,',seq-sym ,',v-sym
-                                                   ,',from-sym ,',to-sym))
-                           ,',v-sym)))
-              ,body)))))
-  (ssetter
-    (with-gensyms (seq-sym from-sym to-sym v-sym)
-      (with-update-expander (seq-getter seq-setter) seq sys:*pl-env*
-        ^(macrolet ((,ssetter (val)
-                     ^(alet ((,',seq-sym (,',seq-getter))
-                             (,',from-sym ,',from)
-                             (,',to-sym ,',to)
-                             (,',v-sym ,val))
-                        (,',seq-setter (replace ,',seq-sym ,',v-sym
-                                                ,',from-sym ,',to-sym))
-                        ,',v-sym)))
-        ,body))))
-  (deleter
-    (with-gensyms (seq-sym from-sym to-sym)
-      (with-update-expander (seq-getter seq-setter) seq sys:*pl-env*
-        ^(alet ((,seq-sym (,seq-getter))
-                (,from-sym ,from)
-                (,to-sym ,to))
-           (macrolet ((,deleter ()
-                         ^(prog1
-                            (sub ,',seq-sym ,',from-sym ,',to-sym)
-                            (,',seq-setter (replace ,',seq-sym nil
-                                                    ,',from-sym ,',to-sym)))))
-             ,body))))))
-
-(defplace (gethash hash key : (default nil have-default-p)) body
-  (getter setter
-    (with-gensyms (entry-sym)
-      ^(let ((,entry-sym (inhash ,hash ,key ,default)))
-         (macrolet ((,getter () ^(cdr ,',entry-sym))
-                    (,setter (val) ^(sys:rplacd ,',entry-sym ,val)))
-            ,body))))
-  nil
-  (deleter
-    ^(macrolet ((,deleter ()
-                  (if ,have-default-p
-                    (with-gensyms (entry-sym
-                                   dfl-sym)
-                      ^(alet ((,entry-sym (inhash ,',hash ,',key))
-                              (,dfl-sym ,',default))
-                         (if ,entry-sym
-                           (remhash ,',hash ,',key)
-                           ,dfl-sym)))
-                    ^(remhash ,',hash ,',key))))
-       ,body)))
-
-(defplace (hash-userdata hash) body
-  (getter setter
-    (with-gensyms (hash-sym)
-      ^(slet ((,hash-sym ,hash))
-         (macrolet ((,getter () ^(hash-userdata ,',hash-sym))
-                    (,setter (val) ^(set-hash-userdata ,',hash-sym ,val)))
-            ,body))))
-  (ssetter
-    ^(macrolet ((,ssetter (val)
-                  ^(set-hash-userdata ,',hash ,val)))
-      ,body)))
-
-(defplace (dwim obj-place :env env . args) body
-  (getter setter
-    (with-gensyms (ogetter-sym osetter-sym obj-sym newval-sym)
-      (let ((arg-syms (mapcar (ret (gensym)) args)))
-        (if (place-form-p obj-place sys:*pl-env*)
-          (with-update-expander (ogetter-sym osetter-sym)
-                                ^(sys:l1-val ,obj-place) sys:*pl-env*
-            ^(rlet ((,obj-sym (,ogetter-sym))
-                    ,*(mapcar (ret ^(,@1 (sys:l1-val ,@2))) arg-syms args))
-               (macrolet ((,getter ()
-                            '[,obj-sym ,*arg-syms])
-                          (,setter (val)
-                            ^(rlet ((,',newval-sym ,val))
-                               (,',osetter-sym
-                                 (sys:dwim-set t ,',obj-sym
-                                               ,*',arg-syms ,',newval-sym))
-                               ,',newval-sym)))
-                 ,body)))
-          ^(rlet ((,obj-sym ,obj-place)
-                  ,*(mapcar (ret ^(,@1 (sys:l1-val ,@2))) arg-syms args))
-             (macrolet ((,getter ()
-                          '[,obj-sym ,*arg-syms])
-                        (,setter (val)
-                          ^(rlet ((,',newval-sym ,val))
-                             (sys:dwim-set nil ,',obj-sym
-                                           ,*',arg-syms ,',newval-sym)
-                             ,',newval-sym)))
-               ,body))))))
-  (ssetter
-    (with-gensyms (osetter-sym ogetter-sym obj-sym newval-sym)
-      (let ((arg-syms (mapcar (ret (gensym)) args)))
-        (if (place-form-p obj-place sys:*pl-env*)
-          (with-update-expander (ogetter-sym osetter-sym)
-                                ^(sys:l1-val ,obj-place) sys:*pl-env*
-            ^(macrolet ((,ssetter (val)
-                         ^(rlet ((,',obj-sym (,',ogetter-sym))
-                                 ,*(mapcar (ret ^(,@1 (sys:l1-val ,@2)))
-                                           ',arg-syms ',args)
-                                 (,',newval-sym ,val))
-                            (,',osetter-sym
-                              (sys:dwim-set t ,',obj-sym
-                                            ,*',arg-syms
-                                            ,',newval-sym))
-                            ,',newval-sym)))
-                 ,body))
-          ^(macrolet ((,ssetter (val)
-                       ^(rlet ((,',obj-sym ,',obj-place)
-                               ,*(mapcar (ret ^(,@1 (sys:l1-val ,@2)))
-                                         ',arg-syms ',args)
-                               (,',newval-sym ,val))
-                          (sys:dwim-set nil ,',obj-sym
-                                        ,*',arg-syms
-                                        ,',newval-sym)
-                          ,',newval-sym)))
-               ,body)))))
-
-  (deleter
-    (with-gensyms (osetter-sym ogetter-sym obj-sym oldval-sym)
-      (let ((arg-syms (mapcar (ret (gensym)) args)))
-        (if (place-form-p obj-place sys:*pl-env*)
-          (with-update-expander (ogetter-sym osetter-sym)
-                                ^(sys:l1-val ,obj-place) sys:*pl-env*
-            ^(macrolet ((,deleter ()
-                         ^(rlet ((,',obj-sym (,',ogetter-sym))
-                                 ,*(mapcar (ret ^(,@1 (sys:l1-val ,@2)))
-                                           ',arg-syms ',args))
-                            (let ((,',oldval-sym [,',obj-sym ,*',arg-syms]))
-                              (progn
-                                (,',osetter-sym
-                                  (sys:dwim-del t ,',obj-sym ,*',arg-syms))
-                                ,',oldval-sym)))))
-                 ,body))
-            ^(macrolet ((,deleter ()
-                         ^(rlet ((,',obj-sym ,',obj-place)
-                                 ,*(mapcar (ret ^(,@1 (sys:l1-val ,@2)))
-                                           ',arg-syms ',args))
-                            (let ((,',oldval-sym [,',obj-sym ,*',arg-syms]))
-                              (progn
-                                (sys:dwim-del nil ,',obj-sym ,*',arg-syms)
-                                ,',oldval-sym)))))
-                 ,body))))))
-
-(defplace (force promise) body
-  (getter setter
-    (with-gensyms (promise-sym)
-      ^(rlet ((,promise-sym ,promise))
-          (macrolet ((,getter ()
-                        ^(force ,',promise-sym))
-                     (,setter (val)
-                        ^(set (car (cdr ,',promise-sym)) ,val)))
-            ,body))))
-  (ssetter
-    (with-gensyms (promise-sym)
-      ^(rlet ((,promise-sym ,promise))
-         (macrolet ((,ssetter (val)
-                      ^(prog1
-                         (set (car (cdr ,',promise-sym)) ,val)
-                         (set (car ,',promise-sym) 'sys:promise-forced))))
-           ,body)))))
-
-(defplace (errno) body
-  (getter setter
-    ^(macrolet ((,getter () '(errno))
-                (,setter (val-expr)
-                   (with-gensyms (val-sym)
-                     ^(slet ((,val-sym ,val-expr))
-                         (progn (errno ,val-sym) ,val-sym)))))
-       ,body)))
-
-(defplace (fun sym) body
-  (getter setter
-    ^(macrolet ((,getter () ^(fun ,',sym))
-                (,setter (val) ^(sys:setqf ,',sym ,val)))
-       ,body))
-  nil
-  (deleter
-    ^(macrolet ((,deleter (:env env)
-                   (when (lexical-fun-p env ',sym)
-                     (compile-error ',sys:*pl-form*
-                                    "~s is a lexical function, \
-                                    \ thus not deletable"))
-                    ^(fmakunbound ',',sym)))
-       ,body)))
-
-(defun sys:get-fun-getter-setter (sym : f)
-  (tree-case sym
-    ((type struct slot)
-      (if (eq type 'meth)
-        (caseql slot
-          (:init (cons (op struct-get-initfun struct)
-                       (op struct-set-initfun struct)))
-          (:postinit (cons (op struct-get-postinitfun struct)
-                           (op struct-set-postinitfun struct)))
-          (t (cons (op static-slot struct slot)
-                   (op static-slot-ensure struct slot))))
-        :))
-    ((type sym)
-      (if (eq type 'macro)
-        (let ((cell (or (gethash sys:top-mb sym)
-                        (sethash sys:top-mb sym (cons sym nil)))))
-          (cons (op cdr)
-                (op sys:rplacd cell)))
-        :))
-    ((op . rest)
-     (if (eq op 'lambda)
-       (compile-error f "cannot assign to lambda")
-       (compile-error f "invalid function syntax ~s" sym)))
-    (else
-      (let ((cell (or (gethash sys:top-fb sym)
-                      (sethash sys:top-fb sym (cons sym nil)))))
-        (cons (op cdr)
-              (op sys:rplacd cell))))))
-
-(defplace (symbol-function sym-expr) body
-  (getter setter
-    (with-gensyms (gs-sym)
-      ^(let ((,gs-sym (sys:get-fun-getter-setter ,sym-expr ',sys:*pl-form*)))
-          (macrolet ((,getter () ^(call (car ,',gs-sym)))
-                     (,setter (val) ^(call (cdr ,',gs-sym) ,val)))
-            ,body))))
-  nil
-  (deleter
-    ^(macrolet ((,deleter () ^(fmakunbound ,',sym-expr)))
-       ,body)))
-
-(defun sys:get-mb (f sym)
-  (or (gethash sys:top-mb sym)
-      (compile-error f "unbound macro ~s" sym)))
-
-(defplace (symbol-macro sym-expr) body
-  (getter setter
-    (with-gensyms (binding-sym)
-      ^(let ((,binding-sym (sys:get-mb ',sys:*pl-form* ,sym-expr)))
-          (macrolet ((,getter () ^(cdr ,',binding-sym))
-                     (,setter (val) ^(sys:rplacd ,',binding-sym ,val)))
-            ,body))))
-  nil
-  (deleter
-    ^(macrolet ((,deleter () ^(mmakunbound ,',sym-expr)))
-       ,body)))
-
-(defun sys:get-vb (sym)
-  (or (gethash sys:top-vb sym)
-      (sethash sys:top-vb sym (cons sym nil))))
-
-(defplace (symbol-value sym-expr) body
-  (getter setter
-    (with-gensyms (binding-sym)
-      ^(let ((,binding-sym (sys:get-vb ,sym-expr)))
-          (macrolet ((,getter () ^(cdr ,',binding-sym))
-                     (,setter (val) ^(sys:rplacd ,',binding-sym ,val)))
-            ,body))))
-  nil
-  (deleter
-    ^(macrolet ((,deleter () ^(makunbound ,',sym-expr)))
-       ,body)))
-
-(defplace (slot struct sym) body
-  (getter setter
-    (with-gensyms (struct-sym slot-sym)
-      ^(alet ((,struct-sym ,struct)
-              (,slot-sym ,sym))
-         (macrolet ((,getter () ^(slot ,',struct-sym ,',slot-sym))
-                    (,setter (val) ^(slotset ,',struct-sym ,',slot-sym ,val)))
-           ,body))))
-  (ssetter
-    ^(macrolet ((,ssetter (val) ^(slotset ,',struct ,',sym ,val)))
-      ,body)))
-
-(defmacro define-modify-macro (name lambda-list function)
-  (let ((cleaned-lambda-list (mapcar [iffi consp car]
-                                     (remql : lambda-list))))
-    (with-gensyms (place-sym args-sym)
-      ^(defmacro ,name (:env env ,place-sym ,*lambda-list)
-         (with-update-expander (getter setter) ,place-sym env
-           ^(,setter (,',function (,getter) ,,*cleaned-lambda-list)))))))
-
-(defmacro sys:placelet-1 (((sym place)) :env env . body)
-  (with-gensyms (tmp-place pl-getter pl-setter)
-    (unwind-protect
-      (progn
-        ;; This temporary proxy place installed into the
-        ;; *place-update-expander* hash, and the forced expansion
-        ;; of the symacrolet form are necessary for correctness.
-        ;; If we don't perform that expand, then the temporary proxy
-        ;; place is not used, and sym ends up being an alias
-        ;; for the getter form (,',pl-getter) of the original place.
-        ;; Then, placelet will only work for places whose getter forms
-        ;; themselves places. This is not required in general. A (foo ...)
-        ;; place can, for instance, use (get-foo ...) and (set-foo ...)
-        ;; getters and setters, where (get-foo ...) is not a place.
-        ;; If sym turns into a symbol macro for a (get-foo ...) form,
-        ;; uses of sym as a place will fail due to get-foo not being a place.
-       (sethash *place-update-expander* tmp-place
-                 (lambda (tmp-getter tmp-setter tmp-place tmp-body)
-                   ^(macrolet ((,tmp-getter () ^(,',pl-getter))
-                               (,tmp-setter (val) ^(,',pl-setter ,val)))
-                      ,tmp-body)))
-        (call-update-expander pl-getter pl-setter place env
-          ^(macrolet ((,tmp-place () ^(,',pl-getter)))
-             ,(expand ^(symacrolet ((,sym (,tmp-place)))
-                         ,*body) env))))
-      (remhash *place-update-expander* tmp-place))))
-
-(defmacro placelet* (:form f sym-place-pairs . body)
-  (tree-case sym-place-pairs
-    (() ^(progn ,*body))
-    (((sym place)) ^(sys:placelet-1 ((,sym ,place)) ,*body))
-    (((sym place) . rest-pairs) ^(sys:placelet-1 ((,sym ,place))
-                                   (placelet* (,*rest-pairs) ,*body)))
-    (obj (compile-error f "bad syntax: ~s" obj))))
-
-(defmacro placelet (:form f sym-place-pairs . body)
-  (unless (all sym-place-pairs
-               [andf consp (opip length (= 2)) (oand first bindable)])
-    (compile-error f "bad syntax: ~s" sym-place-pairs))
-  (tree-bind (: syms places) (transpose sym-place-pairs)
-     (let ((temps (mapcar (ret (gensym)) syms)))
-       ^(placelet* (,*(zip temps places))
-          (symacrolet (,*(zip syms temps))
-            ,*body)))))
-
-(defun sys:register-simple-accessor (get-fun set-fun)
-  (sethash *place-update-expander* get-fun
-           (lambda (getter setter place body)
-             (let* ((args (cdr place))
-                    (temps (mapcar (ret (gensym)) args)))
-               ^(let (,(zip temps args))
-                  (macrolet ((,getter () ^(,',get-fun ,*',temps))
-                             (,setter (val)
-                               ^(,',set-fun ,*',temps ,val)))
-                    ,body)))))
-  (sethash *place-clobber-expander* get-fun
-           (lambda (ssetter place body)
-             ^(macrolet ((,ssetter (val)
-                               ^(,',set-fun ,*(cdr ',place) ,val)))
-                ,body)))
-  get-fun)
-
-(defmacro define-accessor (get-fun set-fun)
-  ^(sys:register-simple-accessor ',get-fun ',set-fun))
-
-(define-place-macro first (obj) ^(car ,obj))
-(define-place-macro rest (obj) ^(cdr ,obj))
-(define-place-macro second (obj) ^(ref ,obj 1))
-(define-place-macro third (obj) ^(ref ,obj 2))
-(define-place-macro fourth (obj) ^(ref ,obj 3))
-(define-place-macro fifth (obj) ^(ref ,obj 4))
-(define-place-macro sixth (obj) ^(ref ,obj 5))
-(define-place-macro seventh (obj) ^(ref ,obj 6))
-(define-place-macro eighth (obj) ^(ref ,obj 7))
-(define-place-macro ninth (obj) ^(ref ,obj 8))
-(define-place-macro tenth (obj) ^(ref ,obj 9))
-
-(define-place-macro last (:env e obj : (n nil have-n))
-  (cond
-    ((and have-n (constantp n e) (not (plusp n)))
-     ^(sub ,obj t t))
-    ((and have-n (constantp n e))
-     ^(sub ,obj ,(- n) t))
-    (have-n
-     ^(sub ,obj (- (max ,n 0)) t))
-    (t ^(sub ,obj -1 t))))
-
-(define-place-macro butlast (:env e obj : (n nil have-n))
-  (cond
-    ((and have-n (constantp n e) (not (plusp n)))
-     obj)
-    ((and have-n (constantp n e))
-     ^(sub ,obj 0 ,(- n)))
-    (have-n
-     ^(sub ,obj 0 (- (max ,n 0))))
-    (t ^(sub ,obj 0 -1))))
-
-(define-place-macro nth (index obj)
-  ^(car (nthcdr ,index ,obj)))
diff --git a/share/txr/stdlib/pmac.tl b/share/txr/stdlib/pmac.tl
deleted file mode 100644
index e439220c..00000000
--- a/share/txr/stdlib/pmac.tl
+++ /dev/null
@@ -1,34 +0,0 @@
-;; Copyright 2017-2021
-;; Kaz Kylheku <kaz@kylheku.com>
-;; Vancouver, Canada
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are met:
-;;
-;; 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 BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(defmacro define-param-expander (keyword
-                                  (parms body : (env (gensym)) (form (gensym)))
-                                . forms)
-  ^(progn
-     (set [*param-macro* ,keyword]
-          (lambda (,parms ,body ,env ,form)
-            ,*forms))
-     ,keyword))
diff --git a/share/txr/stdlib/quips.tl b/share/txr/stdlib/quips.tl
deleted file mode 100644
index 4b787209..00000000
--- a/share/txr/stdlib/quips.tl
+++ /dev/null
@@ -1,95 +0,0 @@
-;; Copyright 2020-2021
-;; Kaz Kylheku <kaz@kylheku.com>
-;; Vancouver, Canada
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are met:
-;;
-;; 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 BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(defvarl sys:%quips%
-  #("TXR was taped live before a studio audience. The laughter is genuine."
-    "Exclusive of recycled stuffing, TXR contains new materials only."
-    "TXR is not a toy, but should be kept within easy reach of children."
-    "Do not remove this label until TXR is delivered to the consumer."
-    "Remove TXR any time for a complete refund of your disk space."
-    "Store TXR in a cool, dry storage device. Keep out of direct sunlight."
-    "Do not operate heavy equipment or motor vehicles while using TXR."
-    "Use full-strength TXR for tough tasks, or dilute with shell scripts."
-    "TXR causes vomiting if accidentally ingested; no need to induce such."
-    "If unwanted side effects persist, discontinue imperative programming."
-    "TXR works even if the application surface is not free of dirt and grease."
-    "TXR may be used in areas that are not necessarily well ventilated."
-    "TXR's button pops up when original seal is broken."
-    "TXR is tested on nothing but animals (so to speak)."
-    "Disclaimer: TXR has been found to cure cancer in lab mice only."
-    "Garbage collection is on Tuesdays: bring unwanted pointers to curb by 7:30."
-    "Warning: may explode if heated, cooled or maintained at room temperature."
-    "TXR is made with 75% post-consumer recycled cons cells."
-    "Poke a few holes in TXR with a fork before heating in the microwave."
-    "Caution: objects in heap are farther from reality than they appear."
-    "TXR doesn't really whip the llama's ass so much as the lambda's."
-    "TXR is recommended for either internal or external use. Whatever, y'know?"
-    "TXR is enteric coated to release over 24 hours of lasting relief."
-    "TXR contains many small parts, unsuitable for children under 12 months."
-    "TXR is packaged by the byte; contents may compress during shipping."
-    "Discontinue coding TXR if experiencing dizziness or shortness of breath."
-    "Self-assembly keeps TXR costs low; but ask about our installation service!"
-    "Some mild discoloration of syntax highlighting may occur with age."
-    "TXR is made with equipment not contaminated by peanuts ... r-r-right?"
-    "TXR is believed by fools to be free of defects in workmanship and materials."
-    "Adults using TXR should be closely supervised by children."
-    "TXR may be worn in seven different ways, in any weather."
-    "TXR is light and portable; take it camping, or to the Bahamas."
-    "Psst! The complimentary Allen key that comes with TXR is inpired by IKEA."
-    "Ethically produced using volunteer geek labor in a first world country."
-    "Program contains violence and coarse language, demanding user indiscretion."
-    "TXR is written, directed and produced by, not to mention starring, Kaz."
-    "Emergency exits are located in the standard library."
-    "Your history may used for automatic recommendations, like 'stick to Python'."
-    "Without the generosity of users like you, this program would exist just fine."
-    "TXR's no-spray organic production means every bug is carefully removed by hand."
-    "Upgrade to TXR Pro for a one-time fee of learning Lisp!"
-    "When transferring between containers, do not siphon TXR by mouth."
-    "Use TXR only as directed. Unless you are intelligent, curious and creative."
-    "Reminder: your account balance of 37 closing parentheses is past due."
-    "Check with your physician before commencing any strenuous Lisp program."
-    "Apply today for a TXR credit card, and get 1MB off your next allocation."
-    "Join TXR Rewards now, and get 15000 closing parentheses you can use anywhere."
-    "TXR's car insurance now offers cdr coverage for bumper-to-bumper protection."
-    "Please listen carefully to the following spec, as our Lisp has changed."
-    "If TXR were TV, it would require music by Mike Post and Peter Carpenter."
-    "TXR was set to appear on the cover of SI. Yeah, no. Learned about the jinx."
-    "  |E|\n|V A N|\n  |S|\n  |T|"
-    "Lispが好き、とても好き、私はLispの...全てにいつも...夢中なの。"
-    "こんな広い分野の中、私が愛する...言語なら、やはり...Lispだけ。"
-    "This area is under 24 hour TTY surveillance."
-    "Imitation is the benignest form of forgery."
-    "This could be the year of the TXR desktop; I can feel it!"
-    ))
-
-(defparml sys:%quip-rand-state% (make-random-state))
-
-(defvarl sys:%shuffled-quips%)
-
-(defun quip ()
-  (unless sys:%shuffled-quips%
-    (set sys:%shuffled-quips% (shuffle sys:%quips% sys:%quip-rand-state%)))
-  (pop sys:%shuffled-quips%))
diff --git a/share/txr/stdlib/save-exe.tl b/share/txr/stdlib/save-exe.tl
deleted file mode 100644
index e645c10a..00000000
--- a/share/txr/stdlib/save-exe.tl
+++ /dev/null
@@ -1,38 +0,0 @@
-;; Copyright 2019-2021
-;; Kaz Kylheku <kaz@kylheku.com>
-;; Vancouver, Canada
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are met:
-;;
-;; 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 BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(defun save-exe (path string)
-  (let* ((fbuf (file-get-buf txr-exe-path))
-         (bs (make-buf-stream fbuf))
-         (pre (progn
-                (stream-set-prop bs :byte-oriented t)
-                (scan-until-match #/@\(txr\)/ bs)))
-         (sbuf (ffi-put string (ffi (zarray 128 char)))))
-    (unless pre
-      (throwf 'error "~s: ~a isn't a TXR executable" 'save-txr-exe path))
-    (put-buf sbuf 0 bs)
-    (file-put-buf path fbuf)
-    (chmod path #o766)))
diff --git a/share/txr/stdlib/socket.tl b/share/txr/stdlib/socket.tl
deleted file mode 100644
index 58f81e61..00000000
--- a/share/txr/stdlib/socket.tl
+++ /dev/null
@@ -1,273 +0,0 @@
-;; Copyright 2016-2021
-;; Kaz Kylheku <kaz@kylheku.com>
-;; Vancouver, Canada
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are met:
-;;
-;; 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 BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(defstruct sockaddr nil
-  (:static family nil))
-
-(defstruct sockaddr-in sockaddr
-  (addr 0) (port 0)
-  (prefix 32)
-  (:static family af-inet))
-
-(defstruct sockaddr-in6 sockaddr
-  (addr 0) (port 0) (flow-info 0) (scope-id 0)
-  (prefix 128)
-  (:static family af-inet6))
-
-(defstruct sockaddr-un sockaddr
-  path
-  (:static family af-unix))
-
-(defstruct addrinfo nil
-  (flags 0)
-  (family 0)
-  (socktype 0)
-  (protocol 0)
-  (canonname 0))
-
-(defvarl shut-rd 0)
-(defvarl shut-wr 1)
-(defvarl shut-rdwr 2)
-
-(defun str-inaddr (addr : port)
-  (let ((d (logand addr #xFF))
-        (c (logand (ash addr -8) #xFF))
-        (b (logand (ash addr -16) #xFF))
-        (a         (ash addr -24))
-        (p (if port `:@port` "")))
-    (if (or (> a 255) (minusp a))
-      (throwf 'eval-error "~s: ~a out of range for IPv4 address"
-              'str-inaddr addr)
-      `@a.@b.@c.@d@p`)))
-
-
-(defun sys:in6addr-condensed-text (numeric-pieces)
-  (let* ((str (cat-str [mapcar (op fmt "~x") numeric-pieces] ":"))
-         (zr (rra #/0(:0)+/ str))
-         (lp [pos-max zr : [callf - to from]])
-         (lr [zr lp]))
-    (when lp
-      (del [str lr]))
-    (cond
-      ((equal "" str) "::")
-      ((starts-with ":" str) `:@str`)
-      ((ends-with ":" str) `@str:`)
-      (t str))))
-
-(defun str-in6addr (addr : port)
-  (let ((str (if (and (<= (width addr) 48)
-                      (= (ash addr -32) #xFFFF))
-               `::ffff:@(str-inaddr (logtrunc addr 32))`
-               (let* ((pieces (let ((count 8))
-                                (nexpand-left (lambda (val)
-                                                (if (minusp (dec count))
-                                                  (unless (zerop val)
-                                                    (throwf 'eval-error
-                                                            "~s: \
-                                                            \ ~a out of range \
-                                                            \ for IPv6 address"
-                                                            'str-in6addr
-                                                            addr))
-                                                  (cons (logand val #xFFFF)
-                                                        (ash val -16))))
-                                              addr))))
-                 (sys:in6addr-condensed-text pieces)))))
-    (if port
-      `[@str]:@port`
-      str)))
-
-(defun sys:str-inaddr-net-impl (addr wextra : weff)
-  (let ((mask addr))
-    (set mask (logior mask (ash mask 1)))
-    (set mask (logior mask (ash mask 2)))
-    (set mask (logior mask (ash mask 4)))
-    (set mask (logior mask (ash mask 8)))
-    (set mask (logior mask (ash mask 16)))
-    (let* ((w (- 32 (width (lognot mask 32))))
-           (d (logand addr #xFF))
-           (c (logand (ash addr -8) #xFF))
-           (b (logand (ash addr -16) #xFF))
-           (a         (ash addr -24))
-           (we (or weff (+ w wextra))))
-      (cond
-        ((or (> a 255) (minusp a))
-         (throwf 'eval-error "~s: ~a out of range for IPv4 address"
-                 'str-inaddr-net addr))
-        ((> w 24) `@a.@b.@c.@d/@we`)
-        ((> w 16) `@a.@b.@c/@we`)
-        ((> w 8) `@a.@b/@we`)
-        (t `@a/@we`)))))
-
-(defun str-inaddr-net (addr : width)
-  (sys:str-inaddr-net-impl addr 0 width))
-
-(defun str-in6addr-net (addr : width)
-  (if (and (<= (width addr) 48)
-           (= (ash addr -32) #xFFFF))
-    `::ffff:@(sys:str-inaddr-net-impl (logtrunc addr 32) 96 width)`
-    (let ((mask addr))
-      (set mask (logior mask (ash mask 1)))
-      (set mask (logior mask (ash mask 2)))
-      (set mask (logior mask (ash mask 4)))
-      (set mask (logior mask (ash mask 8)))
-      (set mask (logior mask (ash mask 16)))
-      (set mask (logior mask (ash mask 32)))
-      (set mask (logior mask (ash mask 64)))
-      (let* ((w (- 128 (width (lognot mask 128))))
-             (pieces (let ((count 8))
-                       (nexpand-left (lambda (val)
-                                       (if (minusp (dec count))
-                                         (unless (zerop val)
-                                           (throwf 'eval-error
-                                                   "~s: \
-                                                   \ ~a out of range \
-                                                   \ for IPv6 address"
-                                                   'str-in6addr-net
-                                                   addr))
-                                           (cons (logand val #xFFFF)
-                                                 (ash val -16))))
-                                       addr)))
-             (cand-prefix [pieces 0..(trunc (+ w 15) 16)])
-             (prefix (if (search cand-prefix '(0 0)) pieces cand-prefix)))
-        `@(sys:in6addr-condensed-text prefix)/@(or width w)`))))
-
-(defun inaddr-str (str)
-  (labels ((invalid ()
-             (error "~s: invalid address ~s" 'inaddr-str str))
-           (mkaddr (octets port)
-             (unless [all octets (op <= 0 @1 255)]
-               (invalid))
-             (unless (<= 0 port 65535)
-               (invalid))
-             (new sockaddr-in
-                  addr (+ (ash (pop octets) 24)
-                          (ash (pop octets) 16)
-                          (ash (pop octets) 8)
-                          (car octets))
-                  port port))
-           (mkaddr-pf (octets prefix port)
-             (unless [all octets (op <= 0 @1 255)]
-               (invalid))
-             (unless (<= 0 prefix 32)
-               (invalid))
-             (unless (<= 0 port 65535)
-               (invalid))
-             (let* ((addr (+ (ash (or (pop octets) 0) 24)
-                             (ash (or (pop octets) 0) 16)
-                             (ash (or (pop octets) 0) 8)
-                             (or (car octets) 0))))
-               (new sockaddr-in
-                    addr (logand addr (ash -1 (- 32 prefix)))
-                    port port
-                    prefix prefix))))
-    (cond
-      ((r^$ #/\d+\.\d+\.\d+\.\d+:\d+/ str)
-       (tree-bind (addr port) (split* str (rpos #\: str))
-         (mkaddr [mapcar toint (spl #\. addr)] (toint port))))
-      ((r^$ #/\d+\.\d+\.\d+\.\d+(:\d+)?/ str)
-       (mkaddr [mapcar toint (spl #\. str)] 0))
-      ((r^$ #/\d+(\.\d+(\.\d+(\.\d+)?)?)?\/\d+/ str)
-       (tree-bind (addr prefix) (spl #\/ str)
-         (mkaddr-pf [mapcar toint (spl #\. addr)] (toint prefix) 0)))
-      ((r^$ #/\d+(\.\d+(\.\d+(\.\d+)?)?)?\/\d+:\d+/ str)
-       (tree-bind (addr prefix port) (split-str-set str ":/")
-         (mkaddr-pf [mapcar toint (spl #\. addr)] (toint prefix) (toint port))))
-      (t (invalid)))))
-
-(defun in6addr-str (str)
-  (labels ((invalid ()
-             (error "~s: invalid address ~s" 'in6addr-str str))
-           (mkaddr-full (pieces)
-             (unless [all pieces (op <= 0 @1 #xffff)]
-               (invalid))
-             (unless (eql 8 (length pieces))
-               (invalid))
-             (new sockaddr-in6
-                  addr (reduce-left (op + @2 (ash @1 16)) pieces)))
-           (mkaddr-brev (pieces-x pieces-y)
-             (let ((len-x (len pieces-x))
-                   (len-y (len pieces-y)))
-               (unless (<= (+ len-x len-y) 7)
-                 (invalid))
-               (let* ((val-x (reduce-left (op + @2 (ash @1 16)) pieces-x 0))
-                      (val-y (reduce-left (op + @2 (ash @1 16)) pieces-y 0))
-                      (addr (cond
-                              ((null pieces-x) val-y)
-                              ((null pieces-y) (ash val-x (* 16 (- 8 len-x))))
-                              (t (+ val-y
-                                    (ash val-x (* 16 (- 8 len-x))))))))
-                 (new sockaddr-in6
-                      addr addr))))
-           (str-to-pieces (str)
-              (unless (empty str)
-                [mapcar (lop toint 16) (spl #\: str)]))
-           (octets-to-pieces (octets)
-             (unless [all octets (op <= 0 @1 255)]
-               (invalid))
-             (list (+ (ash (pop octets) 8)
-                      (pop octets))
-                   (+ (ash (pop octets) 8)
-                      (pop octets)))))
-    (cond
-      ((r^$ #/\[.*\]:\d+/ str)
-       (tree-bind (addr-str port-str) (split* str (rpos #\: str))
-         (let ((addr (in6addr-str [addr-str 1..-1]))
-               (port (toint port-str)))
-           (unless (<= 0 port 65535)
-             (invalid))
-           (set addr.port port)
-           addr)))
-      ((r^$ #/[^\/]+\/\d+/ str)
-       (tree-bind (addr-str prefix-str) (split* str (rpos #\/ str))
-         (let ((addr (in6addr-str addr-str))
-               (prefix (toint prefix-str)))
-           (unless (<= 0 prefix 128)
-             (invalid))
-           (upd addr.addr (logand (ash -1 (- 128 prefix))))
-           (set addr.prefix prefix)
-           addr)))
-      ((r^$ #/[\da-fA-F]*(:[\da-fA-F]*)*/ str)
-       (upd str (regsub #/::/ "@"))
-       (let* ((str-splat (regsub #/::/ "@" str))
-              (maj-pieces (spl #\@ str-splat)))
-         (caseql (len maj-pieces)
-           (1 (mkaddr-full (str-to-pieces (car maj-pieces))))
-           (2 (mkaddr-brev (str-to-pieces (car maj-pieces))
-                           (str-to-pieces (cadr maj-pieces))))
-           (t (invalid)))))
-      ((r^$ #/::0*[fF][fF][fF][fF]:\d+\.\d+\.\d+\.\d+/ str)
-       (let* ((bigsplit (split* str (rpos #\: str)))
-              (4part (cadr bigsplit))
-              (octets [mapcar toint (spl #\. 4part)])
-              (pieces (cons #xffff (octets-to-pieces octets))))
-         (mkaddr-brev nil pieces)))
-      (t (invalid)))))
-
-(defplace (sock-peer sock) body
-  (getter setter
-    ^(macrolet ((,getter () ^(sock-peer ',',sock))
-                (,setter (val) ^(sock-set-peer ,',sock ,val)))
-       ,body)))
diff --git a/share/txr/stdlib/stream-wrap.tl b/share/txr/stdlib/stream-wrap.tl
deleted file mode 100644
index 042af813..00000000
--- a/share/txr/stdlib/stream-wrap.tl
+++ /dev/null
@@ -1,68 +0,0 @@
-;; Copyright 2017-2021
-;; Kaz Kylheku <kaz@kylheku.com>
-;; Vancouver, Canada
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are met:
-;;
-;; 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 BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(defstruct stream-wrap nil
-  stream
-  (:method put-string (me str)
-    (put-string str me.stream))
-  (:method put-char (me chr)
-    (put-char chr me.stream))
-  (:method put-byte (me byte)
-    (put-byte byte me.stream))
-  (:method get-line (me)
-    (get-line me.stream))
-  (:method get-char (me)
-    (get-char me.stream))
-  (:method get-byte (me)
-    (get-byte me.stream))
-  (:method unget-char (me chr)
-    (unget-char chr me.stream))
-  (:method unget-byte (me byte)
-    (unget-byte byte me.stream))
-  (:method put-buf (me buf pos)
-    (put-buf buf pos me.stream))
-  (:method fill-buf (me buf pos)
-    (fill-buf buf pos me.stream))
-  (:method close (me)
-    (close-stream me.stream))
-  (:method flush (me)
-    (flush-stream me.stream))
-  (:method seek (me offs whence)
-    (seek-stream me.stream offs whence))
-  (:method truncate (me len)
-    (truncate-stream me.stream len))
-  (:method get-prop (me sym)
-    (stream-get-prop me.stream sym))
-  (:method set-prop (me sym nval)
-    (stream-set-prop me.stream sym nval))
-  (:method get-error (me)
-    (get-error me.stream))
-  (:method get-error-str (me)
-    (get-error-str me.stream))
-  (:method clear-error (me)
-    (clear-error me.stream))
-  (:method get-fd (me)
-    (fileno me.stream)))
diff --git a/share/txr/stdlib/struct.tl b/share/txr/stdlib/struct.tl
deleted file mode 100644
index bd62637f..00000000
--- a/share/txr/stdlib/struct.tl
+++ /dev/null
@@ -1,378 +0,0 @@
-;; Copyright 2015-2021
-;; Kaz Kylheku <kaz@kylheku.com>
-;; Vancouver, Canada
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are met:
-;;
-;; 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 BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(defun sys:bad-slot-syntax (form arg)
-  (compile-error form "bad slot syntax ~s" arg))
-
-(defun sys:prune-missing-inits (slot-init-forms)
-  (remove-if (tb ((kind name : (init-form nil init-form-present)))
-               (and (member kind '(:static :instance :function))
-                    (not init-form-present)))
-             slot-init-forms))
-
-(defmacro defstruct (:form form name-spec super-spec . slot-specs)
-  (tree-bind (name args) (tree-case name-spec
-                           ((atom . args) (list atom args))
-                           (atom (list atom nil)))
-    (unless (bindable name)
-      (compile-error form "~s isn't a bindable symbol" name))
-    (unless (proper-listp slot-specs)
-      (compile-error form "bad syntax: dotted form"))
-    (let* ((instance-init-form nil)
-           (instance-postinit-form nil)
-           (instance-fini-form nil)
-           (slot-init-forms (collect-each ((slot slot-specs))
-                              (tree-case slot
-                                ((word name args . body)
-                                 (caseq word
-                                   (:method
-                                     (when (not args)
-                                       (compile-error form
-                                                      "method ~s needs \
-                                                      \ at least one parameter"
-                                                      name))
-                                     ^(:function ,name
-                                        (lambda ,args
-                                              (block ,name ,*body))))
-                                   (:function ^(,word ,name
-                                                 (lambda ,args
-                                                   (block ,name
-                                                     ,*body))))
-                                   ((:static :instance)
-                                     (when body
-                                       (sys:bad-slot-syntax form slot))
-                                     ^(,word ,name ,args))
-                                   (t :)))
-                                ((word (arg) . body)
-                                 (caseq word
-                                   (:init
-                                     (unless (bindable arg)
-                                       (sys:bad-slot-syntax form slot))
-                                     (when instance-init-form
-                                       (compile-error form
-                                                      "duplicate :init"))
-                                     (set instance-init-form
-                                          (cons arg body))
-                                     ^(,word nil nil))
-                                   (:postinit
-                                     (unless (bindable arg)
-                                       (sys:bad-slot-syntax form slot))
-                                     (when instance-postinit-form
-                                       (compile-error form
-                                                      "duplicate :postinit"))
-                                     (set instance-postinit-form
-                                          (cons arg body))
-                                     ^(,word nil nil))
-                                   (:fini
-                                     (unless (bindable arg)
-                                       (sys:bad-slot-syntax form slot))
-                                     (when instance-fini-form
-                                       (compile-error form
-                                                      "duplicate :fini"))
-                                     (set instance-fini-form
-                                          (cons arg body))
-                                     ^(,word nil nil))
-                                   (t (when body
-                                        (sys:bad-slot-syntax form slot))
-                                      :)))
-                                ((word name)
-                                   (caseq word
-                                     ((:static)
-                                      ^(,word ,name))
-                                     ((:instance)
-                                      ^(,word ,name nil))
-                                     ((:method :function)
-                                      (sys:bad-slot-syntax form slot))
-                                     (t ^(:instance ,word ,name))))
-                                ((name)
-                                  ^(:instance ,name nil))
-                                (name
-                                  ^(:instance ,name nil)))))
-           (supers (if (and super-spec (atom super-spec))
-                     (list super-spec)
-                     super-spec))
-           (stat-si-forms [keep-if (op member @1 '(:static :function))
-                                   slot-init-forms car])
-           (pruned-si-forms (sys:prune-missing-inits stat-si-forms))
-           (func-si-forms [keep-if (op eq :function) pruned-si-forms car])
-           (val-si-forms [keep-if (op eq :static) pruned-si-forms car])
-           (inst-si-forms [keep-if (op eq :instance) slot-init-forms car])
-           (stat-slots [mapcar second stat-si-forms])
-           (inst-slots [mapcar second inst-si-forms]))
-      (whenlet ((bad [find-if [notf bindable]
-                              (append stat-slots inst-slots)]))
-        (compile-error form
-                       (if (symbolp bad)
-                         "slot name ~s isn't a bindable symbol"
-                         "invalid slot specifier syntax: ~s")
-                       bad))
-      (each ((s supers))
-        (or (find-struct-type s)
-            (compile-defr-warning form ^(struct-type . ,s)
-                                  "inheritance base ~s \
-                                  \ does not name a struct type"
-                                  s)))
-      (let ((arg-sym (gensym))
-            (type-sym (gensym)))
-        (register-tentative-def ^(struct-type . ,name))
-        (each ((s stat-slots))
-          (register-tentative-def ^(slot . ,s)))
-        (each ((s inst-slots))
-          (register-tentative-def ^(slot . ,s)))
-        ^(sys:make-struct-type
-           ',name ',supers ',stat-slots ',inst-slots
-           ,(if (or func-si-forms val-si-forms)
-               ^(lambda (,arg-sym)
-                  ,*(mapcar (aret ^(when (static-slot-p ,arg-sym ',@2)
-                                     (static-slot-set ,arg-sym ',@2 ,@3)))
-                            (append func-si-forms val-si-forms))))
-           ,(if (or inst-si-forms instance-init-form instance-fini-form)
-              ^(lambda (,arg-sym)
-                 ,*(if (cdr instance-fini-form)
-                     ^((finalize ,arg-sym (lambda (,(car instance-fini-form))
-                                            ,*(cdr instance-fini-form))
-                                 t)))
-                 ,*(if inst-si-forms
-                     ^((let ((,type-sym (struct-type ,arg-sym)))
-                         ,*(mapcar (aret ^(unless (static-slot-p ,type-sym ',@2)
-                                            (slotset ,arg-sym ',@2 ,@3)))
-                                   inst-si-forms))))
-                 ,*(if (cdr instance-init-form)
-                     ^((let ((,(car instance-init-form) ,arg-sym))
-                         ,*(cdr instance-init-form))))))
-           ,(when args
-              (when (> (countql : args) 1)
-                (compile-error form
-                               "multiple colons in boa syntax"))
-              (let ((col-pos (posq : args)))
-                (let ((req-args [args 0..col-pos])
-                      (opt-args (if col-pos [args (succ col-pos)..:])))
-                  (let ((r-gens (mapcar (ret (gensym)) req-args))
-                        (o-gens (mapcar (ret (gensym)) opt-args))
-                        (p-gens (mapcar (ret (gensym)) opt-args)))
-                    ^(lambda (,arg-sym ,*r-gens
-                              ,*(if opt-args '(:))
-                              ,*(if opt-args
-                                  (mapcar (ret ^(,@1 nil ,@2))
-                                          o-gens p-gens)))
-                       ,*(mapcar (ret ^(slotset ,arg-sym ',@1 ,@2))
-                                 req-args r-gens)
-                       ,*(mapcar (ret ^(if ,@3
-                                         (slotset ,arg-sym ',@1 ,@2)))
-                                 opt-args o-gens p-gens))))))
-           ,(if instance-postinit-form
-              ^(lambda (,arg-sym)
-                 ,*(if (cdr instance-postinit-form)
-                     ^((let ((,(car instance-postinit-form) ,arg-sym))
-                         ,*(cdr instance-postinit-form)))))))))))
-
-(defmacro sys:struct-lit (name . plist)
-  ^(sys:make-struct-lit ',name ',plist))
-
-(defun sys:check-slot (form slot)
-  (unless (or (sys:slot-types slot)
-              (sys:static-slot-types slot))
-    (compile-defr-warning form ^(slot . ,slot)
-                          "symbol ~s isn't the name of a struct slot"
-                          slot))
-  slot)
-
-(defun sys:check-struct (form stype)
-  (unless (find-struct-type stype)
-    (compile-defr-warning form ^(struct-type . ,stype)
-                          "~s does not name a struct type"
-                          stype)))
-
-(defmacro qref (:form form obj . refs)
-  (when (null refs)
-    (throwf 'eval-error "~s: bad syntax" 'qref))
-  (tree-case obj
-    ((a b) (if (eq a 't)
-             (let ((s (gensym)))
-               ^(slet ((,s ,b))
-                  (if ,s (qref ,s ,*refs))))
-             :))
-    (x (tree-case refs
-         (() ())
-         (((pref sym) . more)
-           (if (eq pref t)
-             (let ((s (gensym)))
-               ^(let ((,s (qref ,obj ,sym)))
-                  (if ,s (qref ,s ,*more))))
-             :))
-         (((dw sym . args))
-          (if (eq dw 'dwim)
-            (let ((osym (gensym)))
-              (sys:check-slot form sym)
-              ^(slet ((,osym ,obj))
-                 ,(if (and (plusp sys:compat) (<= sys:compat 251))
-                    ^[(slot ,osym ',sym) ,*args]
-                    ^[(slot ,osym ',sym) ,osym ,*args])))
-            :))
-         (((dw sym . args) . more)
-          (if (eq dw 'dwim)
-            (let ((osym (gensym)))
-              (sys:check-slot form sym)
-              ^(qref (slet ((,osym ,obj))
-                       ,(if (and (plusp sys:compat) (<= sys:compat 251))
-                          ^[(slot ,osym ',sym) ,*args]
-                          ^[(slot ,osym ',sym) ,osym ,*args])) ,*more))
-            :))
-         (((sym . args))
-          (let ((osym (gensym)))
-            (sys:check-slot form sym)
-            ^(slet ((,osym ,obj))
-               (call (slot ,osym ',sym) ,osym ,*args))))
-         (((sym . args) . more)
-          (let ((osym (gensym)))
-            (sys:check-slot form sym)
-            ^(qref (slet ((,osym ,obj))
-                     (call (slot ,osym ',sym) ,osym ,*args)) ,*more)))
-         ((sym)
-          (sys:check-slot form sym)
-          ^(slot ,obj ',sym))
-         ((sym . more)
-          (sys:check-slot form sym)
-          ^(qref (slot ,obj ',sym) ,*more))
-         (obj (throwf 'eval-error "~s: bad syntax: ~s" 'qref refs))))))
-
-(defmacro uref (. args)
-  (cond
-    ((null args) (throwf 'eval-error "~s: bad syntax" 'uref))
-    ((null (cdr args))
-     (if (consp (car args))
-       ^(umeth ,*(car args))
-       ^(usl ,(car args))))
-    ((eq t (car args))
-     (with-gensyms (ovar)
-       ^(lambda (,ovar) (qref (t ,ovar) ,*(cdr args)))))
-    (t (with-gensyms (ovar)
-         ^(lambda (,ovar) (qref ,ovar ,*args))))))
-
-(defun sys:new-type (op form type)
-  (caseq op
-    ((new lnew) (sys:check-struct form type) ^',type)
-    (t type)))
-
-(defun sys:new-expander (op form spec pairs)
-  (when (oddp (length pairs))
-    (compile-error form "slot initform arguments must occur pairwise"))
-  (let ((qpairs (mappend (aret ^(',@1 ,@2)) (tuples 2 pairs))))
-    (tree-case spec
-      ((texpr . args)
-       (let ((type (sys:new-type op form texpr)))
-         (caseq op
-           ((new new*) (if qpairs
-                         ^(make-struct ,type (list ,*qpairs) ,*args)
-                         ^(struct-from-args ,type ,*args)))
-           ((lnew lnew*) ^(make-lazy-struct ,type
-                                            (lambda ()
-                                              (cons (list ,*qpairs)
-                                                    (list ,*args))))))))
-      (texpr
-        (let ((type (sys:new-type op form texpr)))
-          (caseq op
-            ((new new*) ^(struct-from-plist ,type ,*qpairs))
-            ((lnew lnew*) ^(make-lazy-struct ,type
-                                             (lambda ()
-                                               (list (list ,*qpairs)))))))))))
-
-(defmacro new (:form form spec . pairs)
-  (sys:new-expander (car form) form spec pairs))
-
-(defmacro new* (:form form spec . pairs)
-  (sys:new-expander (car form) form spec pairs))
-
-(defmacro lnew (:form form spec . pairs)
-  (sys:new-expander (car form) form spec pairs))
-
-(defmacro lnew* (:form form spec . pairs)
-  (sys:new-expander (car form) form spec pairs))
-
-(defmacro meth (obj slot . bound-args)
-  ^[(fun method) ,obj ',slot ,*bound-args])
-
-(defmacro usl (:form form slot)
-  (sys:check-slot form slot)
-  ^(uslot ',slot))
-
-(defmacro umeth (:form form slot . bound-args)
-  (sys:check-slot form slot)
-  ^[(fun umethod) ',slot ,*bound-args])
-
-(defun sys:define-method (type-sym name fun)
-  (caseq name
-    (:init (struct-set-initfun type-sym fun))
-    (:postinit (struct-set-postinitfun type-sym fun))
-    (t (static-slot-ensure type-sym name fun)))
-  ^(meth ,type-sym ,name))
-
-(defmacro defmeth (:form form type-sym name arglist . body)
-  (cond
-    ((not (bindable type-sym))
-      (compile-error form "~s isn't a valid struct name" type-sym))
-    ((not (find-struct-type type-sym))
-      (compile-defr-warning form ^(struct-type . ,type-sym)
-                            "definition of struct ~s not seen here" type-sym)))
-  (register-tentative-def ^(slot . ,name))
-  ^(sys:define-method ',type-sym ',name (lambda ,arglist
-                                          (block ,name ,*body))))
-
-(defmacro with-slots ((. slot-specs) obj-expr . body)
-  (with-gensyms (obj-sym)
-    ^(let ((,obj-sym ,obj-expr))
-       (symacrolet (,*(mapcar [iff consp
-                                   (aret ^(,@1 (slot ,obj-sym ',@2)))
-                                   (ret ^(,@1 (slot ,obj-sym ',@1)))]
-                              slot-specs))
-         ,*body))))
-
-(defun sys:rslotset (struct sym meth-sym val)
-  (prog1
-    (slotset struct sym val)
-    (call (umethod meth-sym) struct)))
-
-(defmacro usr:rslot (struct sym meth-sym)
-  ^(slot ,struct ,sym))
-
-(define-place-macro usr:rslot (struct sym meth-sym)
-  ^(sys:rslot ,struct ,sym ,meth-sym))
-
-(defplace (sys:rslot struct sym meth-sym) body
-  (getter setter
-    (with-gensyms (struct-sym slot-sym meth-slot-sym)
-      ^(slet ((,struct-sym ,struct)
-              (,slot-sym ,sym)
-              (,meth-slot-sym ,meth-sym))
-         (macrolet ((,getter () ^(slot ,',struct-sym ,',slot-sym))
-                    (,setter (val) ^(sys:rslotset ,',struct-sym ,',slot-sym
-                                                  ,',meth-slot-sym ,val)))
-           ,body))))
-  (ssetter
-    ^(macrolet ((,ssetter (val) ^(progn
-                                   (sys:rslotset ,',struct ,',sym
-                                             ,',meth-sym ,val))))
-       ,body)))
diff --git a/share/txr/stdlib/tagbody.tl b/share/txr/stdlib/tagbody.tl
deleted file mode 100644
index ed670871..00000000
--- a/share/txr/stdlib/tagbody.tl
+++ /dev/null
@@ -1,72 +0,0 @@
-;; Copyright 2016-2021
-;; Kaz Kylheku <kaz@kylheku.com>
-;; Vancouver, Canada
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are met:
-;;
-;; 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 BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(defmacro tagbody (:env env . forms)
-  (when forms
-    (let* ((tb-id (gensym "tb-id-"))
-           (next-var (gensym "next-"))
-           (bblocks (partition forms (op where [orf symbolp integerp chrp])))
-           (start-lbl (if bblocks [[orf symbolp integerp chrp] (caar bblocks)])))
-      (unless start-lbl
-        (push (gensym "entry-") (car bblocks)))
-      (if (and (not start-lbl) (not (cdr bblocks)))
-        ^(progn nil ,*forms nil)
-        (let* ((lbls [mapcar car bblocks])
-               (forms [mapcar cdr bblocks])
-               ;; This trickery transform the individually labeled form
-               ;; blocks into branches, such that each branch falls through
-               ;; to the next one thanks to substructure sharing.
-               (threaded-1 (mapcar (op member-if true) (conses forms)))
-               (threaded-2 [apply nconc forms]) ;; important side effect
-               (codes [mapcar car threaded-1]))
-          (unless (eql (length (uniq lbls)) (length lbls))
-            (throwf 'eval-error "~s: duplicate labels occur" 'tagbody))
-          (let* ((basic-code ^(let ((,tb-id (gensym "tb-dyn-id-"))
-                                    (,next-var 0))
-                                (sys:for-op ()
-                                            (,next-var)
-                                            ((set ,next-var
-                                                  (block* ,tb-id
-                                                    (sys:switch ,next-var #(,*codes))
-                                                    nil)))))))
-            ^(macrolet ((go (:form form label)
-                          (let ((index (posql label ',lbls)))
-                            (if index ^(return* ,',tb-id ,index) form))))
-               ,basic-code)))))))
-
-(defmacro go (label)
-  (if [[orf symbolp integerp chrp] label]
-    (throwf 'eval-error "~s: no ~s label visible" 'go label)
-    (throwf 'eval-error "~s: ~s isn't a symbol, integer or character" 'go label)))
-
-
-(defmacro prog (vars . body)
-  ^(block nil
-     (let ,vars (tagbody ,*body))))
-
-(defmacro prog* (vars . body)
-  ^(block nil
-     (let* ,vars (tagbody ,*body))))
diff --git a/share/txr/stdlib/termios.tl b/share/txr/stdlib/termios.tl
deleted file mode 100644
index 5d2423dc..00000000
--- a/share/txr/stdlib/termios.tl
+++ /dev/null
@@ -1,79 +0,0 @@
-;; Copyright 2016-2021
-;; Kaz Kylheku <kaz@kylheku.com>
-;; Vancouver, Canada
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are met:
-;;
-;; 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 BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(defmeth termios set-iflags (tio . values)
-  (set tio.iflag (logior tio.iflag . values)))
-
-(defmeth termios set-oflags (tio . values)
-  (set tio.oflag (logior tio.oflag . values)))
-
-(defmeth termios set-cflags (tio . values)
-  (set tio.cflag (logior tio.cflag . values)))
-
-(defmeth termios set-lflags (tio . values)
-  (set tio.lflag (logior tio.lflag . values)))
-
-(defmeth termios clear-iflags (tio . values)
-  (set tio.iflag (logand tio.iflag (lognot (logior . values)))))
-
-(defmeth termios clear-oflags (tio . values)
-  (set tio.oflag (logand tio.oflag (lognot (logior . values)))))
-
-(defmeth termios clear-cflags (tio . values)
-  (set tio.cflag (logand tio.cflag (lognot (logior . values)))))
-
-(defmeth termios clear-lflags (tio . values)
-  (set tio.lflag (logand tio.lflag (lognot (logior . values)))))
-
-(defmeth termios go-raw (tio)
-  tio.(clear-iflags ignbrk brkint parmrk istrip inlcr igncr icrnl ixon)
-  tio.(clear-oflags opost)
-  tio.(clear-cflags csize parenb)
-  tio.(clear-lflags echo echonl icanon isig)
-  (if (boundp 'iexten)
-    tio.(clear-lflags iexten))
-  tio.(set-cflags cs8)
-  (set [tio.cc vmin] 1)
-  (set [tio.cc vtime] 0))
-
-(defmeth termios go-cbreak (tio)
-  tio.(clear-iflags icrnl)
-  tio.(clear-lflags icanon)
-  tio.(set-lflags isig)
-  (set [tio.cc vmin] 1)
-  (set [tio.cc vtime] 0))
-
-(defmeth termios string-encode (tio)
-  (let ((*print-base* 16))
-    tio.(sys:encode-speeds)
-    (downcase-str `@{tio.iflag}:@{tio.oflag}:@{tio.cflag}:@{tio.lflag}:\
-                  @{(list-vec tio.cc) ":"}`)))
-
-(defmeth termios string-decode (tio string)
-  (let ((vals (mapcar (op int-str @1 16) (split-str string ":"))))
-    (lset tio.iflag tio.oflag tio.cflag tio.lflag vals)
-    (set tio.cc (vec-list (cddddr vals)))
-    tio.(sys:decode-speeds)))
diff --git a/share/txr/stdlib/trace.tl b/share/txr/stdlib/trace.tl
deleted file mode 100644
index 8c0fbd4c..00000000
--- a/share/txr/stdlib/trace.tl
+++ /dev/null
@@ -1,123 +0,0 @@
-;; Copyright 2016-2021
-;; Kaz Kylheku <kaz@kylheku.com>
-;; Vancouver, Canada
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are met:
-;;
-;; 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 BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(defvar *trace-output* *stdout*)
-
-(defvar sys:*trace-hash* (hash :equal-based))
-(defvar sys:*trace-level* -1)
-
-(defvarl sys:tr* (fun *))
-(defvarl sys:trfm (fun format))
-
-(defun sys:trace-enter (name args)
-  [sys:trfm *trace-output* "~*a(~s ~s\n" [sys:tr* sys:*trace-level* 2] "" name args])
-
-(defun sys:trace-leave (name val)
-  [sys:trfm *trace-output* "~*a  ~s)\n" [sys:tr* sys:*trace-level* 2] "" val])
-
-(defun sys:trace-canonicalize-name (name)
-  (if (and (consp name)
-           (eq (car name) 'meth))
-    (let* ((req-type-sym (cadr name))
-           (slot-sym (caddr name))
-           (req-type (find-struct-type req-type-sym))
-           (s-s-p (if req-type
-                    (static-slot-p req-type slot-sym)))
-           (actual-type-sym (if s-s-p
-                              (static-slot-home req-type-sym slot-sym))))
-      (if (and s-s-p (neq req-type-sym actual-type-sym))
-        ^(meth ,actual-type-sym ,slot-sym)
-        name))
-    name))
-
-(defun sys:trace (names)
-  (cond
-    ((null names) (hash-keys sys:*trace-hash*))
-    (t
-      (each ((orig-n names)
-             (n [mapcar sys:trace-canonicalize-name names]))
-        (unless [sys:*trace-hash* n]
-          (when (neq n orig-n)
-            (usr:catch
-              (throwf 'warning "~s: ~s is actually ~s: tracing that instead"
-                      'trace orig-n n)
-              (continue ())))
-          (let* ((prev (or (symbol-function n)
-                           (throwf 'eval-error
-                                   "~s: ~s does not name a function" 'trace n)))
-                 (lex-n n)
-                 (hook (lambda (. args)
-                         (let ((abandoned t)
-                               (sys:*trace-level* (succ sys:*trace-level*)))
-                           (unwind-protect
-                             (progn
-                               (sys:trace-enter lex-n args)
-                               (let ((val (apply prev args)))
-                                 (sys:trace-leave lex-n val)
-                                 (set abandoned nil)
-                                 val))
-                             (if abandoned
-                               (sys:trace-leave lex-n :abandoned)))))))
-            (set (symbol-function n) hook
-                 [sys:*trace-hash* n] prev)))))))
-
-(defun sys:untrace (names)
-  (flet ((disable (name-orig name)
-           (let ((prev (del [sys:*trace-hash* name])))
-             (when prev
-               (when (neq name-orig name)
-                 (usr:catch
-                   (throwf 'warning "~s: ~s is actually ~s: untracing that instead"
-                           'trace name-orig name)
-                   (continue ())))
-               (set (symbol-function name) prev)))))
-    (if names
-      (each ((n-orig names)
-             (n [mapcar sys:trace-canonicalize-name names]))
-        (disable n-orig n))
-      (dohash (n v sys:*trace-hash*)
-        (disable n n)))))
-
-(defun sys:trace-redefine-check (orig-name)
-  (let ((name (sys:trace-canonicalize-name orig-name)))
-    (when [sys:*trace-hash* name]
-      (usr:catch
-        (cond
-          ((neq name orig-name)
-             (throwf 'warning "~!~s won't be traced, though it overrides\n\
-                               ~s which is currently traced"
-                      name orig-name))
-          (t (sys:untrace (list name))
-             (throwf 'warning "previously traced ~s is redefined and no\ \
-                               longer traced"
-                      name)))
-        (continue ())))))
-
-(defmacro usr:trace (. names)
-  ^(sys:trace ',names))
-
-(defmacro usr:untrace (. names)
-  ^(sys:untrace ',names))
diff --git a/share/txr/stdlib/txr-case.tl b/share/txr/stdlib/txr-case.tl
deleted file mode 100644
index 244c58b7..00000000
--- a/share/txr/stdlib/txr-case.tl
+++ /dev/null
@@ -1,70 +0,0 @@
-;; Copyright 2015-2021
-;; Kaz Kylheku <kaz@kylheku.com>
-;; Vancouver, Canada
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are met:
-;;
-;; 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 BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(defmacro txr-if (name args input : then else)
-  (let ((syms (keep-if [andf true symbolp [notf keywordp] [notf (op eq t)]]
-                       args))
-        (arg-exprs [mapcar [iffi symbolp (ret ^',@1)] args])
-        (result (gensym "res-"))
-        (bindings (gensym "bindings-"))
-        (insym (gensym "input-")))
-    ^(let* ((,insym ,input)
-            (,result (match-fun ',name (list ,*arg-exprs)
-                                (if (stringp ,insym) (list ,insym) ,insym)
-                                nil)))
-       (if ,result
-         (let ((,bindings (car ,result)))
-           (let (,*[mapcar (ret ^(,@1 (cdr (assoc ',@1 ,bindings))))
-                           syms])
-             ,then))
-         ,else))))
-
-(defmacro txr-when (name args input . body)
-  ^(txr-if ,name ,args ,input (progn ,*body)))
-
-(defmacro txr-case-impl (:form f sym . clauses)
-  (tree-case clauses
-    (((name args . body) . other-clauses)
-     (if (eq name t) :
-       ^(txr-if ,name ,args ,sym
-          (progn ,*body)
-          (txr-case-impl ,sym ,*other-clauses))))
-    (((sym . rest) . other-clauses)
-     (if (eq sym t)
-       (if other-clauses
-         (compile-error f "clauses after (t ...) clause ignored")
-         ^(progn ,*rest))
-       (compile-error f "bad syntax: ~s" (car clauses))))
-    (() ())
-    (atom
-       (compile-error f "unexpected atom in syntax: ~s" atom))))
-
-(defmacro txr-case (input-expr . clauses)
-  (let ((input (gensym "input-")))
-    ^(let ((,input ,input-expr))
-       (if (streamp ,input)
-         (set ,input (get-lines ,input)))
-       (txr-case-impl ,input ,*clauses))))
diff --git a/share/txr/stdlib/txr-case.txr b/share/txr/stdlib/txr-case.txr
deleted file mode 100644
index 9b65d1bc..00000000
--- a/share/txr/stdlib/txr-case.txr
+++ /dev/null
@@ -1 +0,0 @@
-@(load "txr-case.tl")
diff --git a/share/txr/stdlib/type.tl b/share/txr/stdlib/type.tl
deleted file mode 100644
index a97ac6bd..00000000
--- a/share/txr/stdlib/type.tl
+++ /dev/null
@@ -1,39 +0,0 @@
-;; Copyright 2015-2021
-;; Kaz Kylheku <kaz@kylheku.com>
-;; Vancouver, Canada
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are met:
-;;
-;; 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 BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(defmacro typecase (form . clauses)
-  (let* ((val (gensym))
-         (cond-pairs (collect-each ((cl clauses))
-                       (tree-case cl
-                         ((type . body)
-                          (if (symbolp type)
-                            ^((typep ,val ',type) ,*body)
-                            :))
-                         (else (throwf 'eval-error
-                                       "~s: bad clause syntax: ~s"
-                                       'typecase cl))))))
-    ^(let ((,val ,form))
-       (cond ,*cond-pairs))))
diff --git a/share/txr/stdlib/ver.tl b/share/txr/stdlib/ver.tl
deleted file mode 100644
index e85d7ac6..00000000
--- a/share/txr/stdlib/ver.tl
+++ /dev/null
@@ -1,2 +0,0 @@
-(defvarl lib-version 263)
-(defvarl *lib-version* lib-version)
diff --git a/share/txr/stdlib/ver.txr b/share/txr/stdlib/ver.txr
deleted file mode 100644
index 2339bda7..00000000
--- a/share/txr/stdlib/ver.txr
+++ /dev/null
@@ -1 +0,0 @@
-@(load "ver.tl")
diff --git a/share/txr/stdlib/vm-param.tl b/share/txr/stdlib/vm-param.tl
deleted file mode 100644
index d87e5bf3..00000000
--- a/share/txr/stdlib/vm-param.tl
+++ /dev/null
@@ -1,36 +0,0 @@
-;; Copyright 2018-2021
-;; Kaz Kylheku <kaz@kylheku.com>
-;; Vancouver, Canada
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are met:
-;;
-;; 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 BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(defsymacro %lev-size% 1024)
-(defsymacro %max-lev-idx% (pred %lev-size%))
-(defsymacro %lev-bits% 10)
-(defsymacro %max-lev% 63)
-(defsymacro %max-v-lev% (ppred %max-lev%))
-(defsymacro %sm-lev-size% 64)
-(defsymacro %max-sm-lev-idx% (pred %sm-lev-size%))
-(defsymacro %max-sm-lev% 15)
-(defsymacro %sm-lev-bits% 6)
-(defsymacro %max-lambda-fixed-args% 127)
diff --git a/share/txr/stdlib/with-resources.tl b/share/txr/stdlib/with-resources.tl
deleted file mode 100644
index 9d4a89c9..00000000
--- a/share/txr/stdlib/with-resources.tl
+++ /dev/null
@@ -1,51 +0,0 @@
-;; Copyright 2015-2021
-;; Kaz Kylheku <kaz@kylheku.com>
-;; Vancouver, Canada
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are met:
-;;
-;; 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 BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(defmacro with-resources (:form f res-bindings . body)
-  (tree-case res-bindings
-    (((sym init) . rest)
-     ^(let ((,sym ,init))
-        (with-resources ,rest ,*body)))
-    (((sym init . cleanup) . rest)
-     ^(let ((,sym ,init))
-        (when ,sym
-          (unwind-protect
-            (with-resources ,rest ,*body)
-            ,*cleanup))))
-    ((sym . rest)
-     ^(let (,sym)
-        (with-resources ,rest ,*body)))
-    (nil
-      ^(progn ,*body))
-    (other (compile-error f "bad syntax"))))
-
-(defmacro with-objects (var-init-forms . body)
-  (let ((gens (mapcar (ret (gensym)) var-init-forms)))
-    ^(let ,gens
-       (unwind-protect
-         (let* ,(mapcar (aret ^(,@2 (set ,@1 ,@3))) gens var-init-forms)
-           ,*body)
-         ,*(reverse (mapcar (ret ^(call-finalizers ,@1)) gens))))))
diff --git a/share/txr/stdlib/with-stream.tl b/share/txr/stdlib/with-stream.tl
deleted file mode 100644
index 2904ea3d..00000000
--- a/share/txr/stdlib/with-stream.tl
+++ /dev/null
@@ -1,58 +0,0 @@
-;; Copyright 2015-2021
-;; Kaz Kylheku <kaz@kylheku.com>
-;; Vancouver, Canada
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are met:
-;;
-;; 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 BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(defmacro with-out-string-stream ((stream) . body)
-  ^(let ((,stream (make-string-output-stream)))
-     ,*body
-     (get-string-from-stream ,stream)))
-
-(defmacro with-out-strlist-stream ((stream) . body)
-  ^(let ((,stream (make-strlist-output-stream)))
-     ,*body
-     (get-list-from-stream ,stream)))
-
-(defmacro with-out-buf-stream ((stream : buf) . body)
-  ^(let ((,stream (make-buf-stream ,*[[iff have list] buf])))
-     ,*body
-     (get-buf-from-stream ,stream)))
-
-(defmacro with-in-string-stream ((stream string) . body)
-  ^(let ((,stream (make-string-input-stream ,string)))
-     ,*body))
-
-(defmacro with-in-string-byte-stream ((stream string) . body)
-  ^(let ((,stream (make-string-byte-input-stream ,string)))
-     ,*body))
-
-(defmacro with-in-buf-stream ((stream buf) . body)
-  ^(let ((,stream (make-buf-stream ,buf)))
-     ,*body))
-
-(defmacro with-stream ((sym stream) . body)
-  ^(let ((,sym ,stream))
-     (unwind-protect
-       (progn ,*body)
-       (close-stream ,sym))))
diff --git a/share/txr/stdlib/yield.tl b/share/txr/stdlib/yield.tl
deleted file mode 100644
index 866ab8fb..00000000
--- a/share/txr/stdlib/yield.tl
+++ /dev/null
@@ -1,118 +0,0 @@
-;; Copyright 2015-2021
-;; Kaz Kylheku <kaz@kylheku.com>
-;; Vancouver, Canada
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are met:
-;;
-;; 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 BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(defstruct (sys:yld-item val cont) nil val cont)
-
-(defstruct (sys:rcv-item val cont) nil val cont)
-
-(defun sys:obtain-impl (fun)
-  (finalize
-    (lambda (: resume-val)
-      (let ((yi (call fun resume-val)))
-        (while t
-          (cond
-            ((eq (typeof yi) 'sys:yld-item)
-             (call fun 'sys:cont-free)
-             (set fun yi.cont)
-             (return yi.val))
-            ((eq (typeof yi) 'sys:rcv-item)
-             (call fun 'sys:cont-free)
-             (set fun yi.cont)
-             (set yi (call fun resume-val)))
-            (t (return yi))))))
-    (lambda (cont)
-      (call cont 'sys:cont-poison))))
-
-(defmacro obtain (. body)
-  (let ((arg (gensym "arg")))
-    ^(sys:obtain-impl (lambda (,arg)
-                        (unless (eq ,arg 'sys:cont-free)
-                          ,*body)))))
-
-(defmacro obtain-block (name . body)
-  ^(obtain (block ,name ,*body)))
-
-(defmacro obtain* (. body)
-  (let ((arg (gensym "arg"))
-        (fun (gensym "fun")))
-    ^(let ((,fun (sys:obtain-impl (lambda (,arg)
-                                    (unless (eq ,arg 'sys:cont-free)
-                                      ,*body)))))
-       (call ,fun nil)
-       ,fun)))
-
-(defmacro obtain*-block (name . body)
-  ^(obtain* (block ,name ,*body)))
-
-(defmacro yield-from (:form ctx-form name : (form nil have-form-p))
-  (let ((cont-sym (gensym)))
-    ^(sys:capture-cont ',name
-                       (lambda (,cont-sym)
-                         (sys:abscond-from ,name
-                                           ,(if have-form-p
-                                              ^(new (sys:yld-item
-                                                      ,form ,cont-sym))
-                                              ^(new (sys:rcv-item
-                                                      nil ,cont-sym)))))
-                     ',ctx-form)))
-
-(defmacro yield (: (form nil have-form-p))
-  (if have-form-p
-    ^(yield-from nil ,form)
-    ^(yield-from nil)))
-
-(defmacro suspend (:form form name sym . body)
-  ^(sys:capture-cont ',name (lambda (,sym)
-                              (sys:abscond-from ,name (progn ,*body)))
-                     ',form))
-
-(defun hlet-expand (op raw-vis body)
-  (let* ((vis (mapcar [iffi atom list] raw-vis))
-         (nvars (len vis))
-         (syms [mapcar car vis])
-         (inits [mapcar cadr vis])
-         (letop (if (eq op 'hlet*) 'let* 'let))
-         (gens (mapcar (ret (gensym)) vis))
-         (vec (gensym))
-         (macs (mapcar (ret ^(,@1 (vecref ,vec ,@2)))
-                       syms (range 0)))
-         (inits (mapcar (ret ^(set (vecref ,vec ,@1) ,@2))
-                        (range 0) inits)))
-    (if (eq op 'hlet*)
-      ^(let* ((,vec (vector ,nvars)))
-         (symacrolet ,macs
-           ,*inits
-           ,*body))
-      ^(let* ((,vec (vector ,nvars)))
-         ,*inits
-         (symacrolet ,macs
-           ,*body)))))
-
-(defmacro hlet (var-inits . body)
-  (hlet-expand 'hlet var-inits body))
-
-(defmacro hlet* (var-inits . body)
-  (hlet-expand 'hlet* var-inits body))