From ec0d67d34e9644f25245b165b6f37afdba4bab2e Mon Sep 17 00:00:00 2001
From: "Tarn W. Burton" <twburton@gmail.com>
Date: Wed, 29 May 2024 16:29:34 -0400
Subject: [PATCH] Improve compile expansions

Also add more implementations to CI
---
 .github/workflows/test.yml                    |   6 +
 code/basic-output.lisp                        | 131 ++++++------
 code/control-flow-operations.lisp             | 179 ++++++++--------
 code/directive.lisp                           |   9 +-
 .../ansi-test/expected-failures.sexp          |   6 +-
 code/extrinsic/unit-test/utilities.lisp       |  10 +-
 code/floating-point-printers.lisp             |  95 ++++-----
 code/format.lisp                              |  33 ++-
 code/formatter.lisp                           |   2 +-
 code/generic-functions.lisp                   |   5 +
 code/interface.lisp                           |   1 +
 code/layout-control.lisp                      |  80 ++++----
 code/miscellaneous-operations.lisp            |  80 ++++----
 code/miscellaneous-pseudo-operations.lisp     | 102 +++++----
 code/numeral/numeral.lisp                     |   2 +-
 code/packages.lisp                            |   2 +-
 code/pretty-printer-operations.lisp           |  25 ++-
 code/printer-operations.lisp                  | 193 +++++++++++-------
 code/radix-control.lisp                       |  98 +++++----
 code/utilities.lisp                           |  10 +
 20 files changed, 600 insertions(+), 469 deletions(-)

diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml
index 98c51cc..140f2c3 100644
--- a/.github/workflows/test.yml
+++ b/.github/workflows/test.yml
@@ -16,11 +16,17 @@ jobs:
       fail-fast: false
       matrix:
         lisp:
+        - abcl
+        - acl
+        - ccl
         - clasp
+        - cmucl
+        - ecl
         - sbcl
     runs-on: ubuntu-latest
     container:
       image: ghcr.io/yitzchak/archlinux-cl:latest
+      options: --security-opt seccomp:unconfined
     steps:
     - name: Checkout nontrivial-gray-streams
       uses: actions/checkout@v4
diff --git a/code/basic-output.lisp b/code/basic-output.lisp
index 564a995..adf7910 100644
--- a/code/basic-output.lisp
+++ b/code/basic-output.lisp
@@ -18,23 +18,23 @@
 
 (defmethod interpret-item (client (directive c-directive) &optional parameters)
   (declare (ignore parameters))
-  (let ((char (consume-next-argument 'character))
-        (colon-p (colon-p directive))
-        (at-sign-p (at-sign-p directive)))
-    (cond ((and (not colon-p) (not at-sign-p))
-           ;; Neither colon nor at-sign.
-           ;; The HyperSpec says to do what WRITE-CHAR does.
-           (write-char char *destination*))
-          ((not at-sign-p)
-           ;; We have only a colon modifier.
+  (with-accessors ((colon-p colon-p)
+                   (at-sign-p at-sign-p))
+      directive
+  (let ((char (pop-argument 'character)))
+    (cond (colon-p
+           ;; We have a colon modifier.
            ;; The HyperSpec says to do what WRITE-CHAR does for
            ;; printing characters, and what char-name does otherwise.
            ;; The definition of "printing char" is a graphic character
            ;; other than space.
            (if (and (graphic-char-p char) (not (eql char #\Space)))
                (write-char char *destination*)
-               (write-string (char-name char) *destination*)))
-          ((not colon-p)
+               (write-string (char-name char) *destination*))
+           (when at-sign-p
+             ;; Allow client specific key sequence for at sign modifier.
+             (print-key-sequence client char *destination*)))
+          (at-sign-p
            ;; We have only an at-sign modifier.
            ;; The HyperSpec says to print it the way the Lisp
            ;; reader can understand, which I take to mean "use PRIN1".
@@ -42,34 +42,28 @@
            (let ((*print-escape* t))
              (incless:write-object client char *destination*)))
           (t
-           ;; We have both a colon and and at-sign.
-           ;; The HyperSpec says to do what ~:C does, but
-           ;; also to mention unusual shift keys on the
-           ;; keyboard required to type the character.
-           ;; I don't see how to do that, so we do the same
-           ;; as for ~:C.
-           (if (and (graphic-char-p char) (not (eql char #\Space)))
-               (write-char char *destination*)
-               (write-string (char-name char) *destination*))))))
+           ;; Neither colon nor at-sign.
+           ;; The HyperSpec says to do what WRITE-CHAR does.
+           (write-char char *destination*))))))
 
 (defmethod compile-item (client (directive c-directive) &optional parameters)
   (declare (ignore parameters))
-  (let ((colon-p (colon-p directive))
-        (at-sign-p (at-sign-p directive)))
-    `((let ((char (consume-next-argument 'character)))
-        ,(cond ((and (not colon-p) (not at-sign-p))
-                `(write-char char *destination*))
-               ((not at-sign-p)
-                `(if (and (graphic-char-p char) (not (eql char #\Space)))
-                     (write-char char *destination*)
-                     (write-string (char-name char) *destination*)))
-               ((not colon-p)
-                `(let ((*print-escape* t))
-                   (incless:write-object ,(incless:client-form client) char *destination*)))
-               (t
-                `(if (and (graphic-char-p char) (not (eql char #\Space)))
-                     (write-char char *destination*)
-                     (write-string (char-name char) *destination*))))))))
+  (with-accessors ((at-sign-p at-sign-p)
+                   (colon-p colon-p))
+      directive
+    (cond (colon-p
+           `((let ((char (pop-argument 'character)))
+               (if (and (graphic-char-p char) (not (eql char #\Space)))
+                   (write-char char *destination*)
+                   (write-string (char-name char) *destination*))
+               ,@(when at-sign-p
+                   `((print-key-sequence ,(incless:client-form client) char
+                                         *destination*))))))
+          (at-sign-p
+           `((let ((*print-escape* t))
+               (incless:write-object ,(incless:client-form client) (pop-argument 'character) *destination*))))
+          (t
+           `((write-char (pop-argument 'character) *destination*))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
@@ -85,21 +79,25 @@
 
 (defmethod parameter-specifications (client (directive percent-directive))
   (declare (ignore client))
-  '((:type (integer 0) :default 1)))
+  '((:name n
+     :type (integer 0)
+     :bind nil
+     :default 1)))
 
 (defmethod interpret-item (client (directive percent-directive) &optional parameters)
   (loop repeat (car parameters)
         do (terpri *destination*)))
 
 (defmethod compile-item (client (directive percent-directive) &optional parameters)
-  (case (car parameters)
-    (0 '())
-    (1 '((terpri *destination*)))
-    (2 '((terpri *destination*)
-         (terpri *destination*)))
-    (otherwise
-     `((loop repeat ,(car parameters)
-             do (terpri *destination*))))))
+  (let ((n (car parameters)))
+    (case n
+      (0 '())
+      (1 '((terpri *destination*)))
+      (2 '((terpri *destination*)
+           (terpri *destination*)))
+      (otherwise
+       `((loop repeat ,n
+               do (terpri *destination*)))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
@@ -116,7 +114,9 @@
 (defmethod parameter-specifications
     (client (directive ampersand-directive))
   (declare (ignore client))
-  '((:type (integer 0) :default 1)))
+  '((:name n
+     :type (integer 0)
+     :default 1)))
 
 (defmethod interpret-item (client (item ampersand-directive) &optional parameters)
   (let ((how-many (car parameters)))
@@ -126,22 +126,21 @@
             do (terpri *destination*)))))
 
 (defmethod compile-item (client (item ampersand-directive) &optional parameters)
-  (let ((how-many (car parameters)))
-    (case how-many
+  (let ((n (car parameters)))
+    (case n
       (0 nil)
       (1 `((fresh-line *destination*)))
       (2 `((fresh-line *destination*)
            (terpri *destination*)))
       (otherwise
-       (if (numberp how-many)
+       (if (numberp n)
            `((fresh-line *destination*)
-             (loop repeat ,(1- how-many)
+             (loop repeat ,(1- n)
                    do (terpri *destination*)))
-           `((let ((how-many ,how-many))
-               (unless (zerop how-many)
-                 (fresh-line *destination*)
-                 (loop repeat (1- how-many)
-                       do (terpri *destination*))))))))))
+           `((unless (zerop ,n)
+               (fresh-line *destination*)
+               (loop repeat (1- ,n)
+                     do (terpri *destination*)))))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
@@ -158,21 +157,24 @@
 (defmethod parameter-specifications
     (client (directive vertical-bar-directive))
   (declare (ignore client))
-  '((:type (integer 0) :default 1)))
+  '((:name n
+     :type (integer 0)
+     :bind nil
+     :default 1)))
 
 (defmethod interpret-item (client (directive vertical-bar-directive) &optional parameters)
   (loop repeat (car parameters)
         do (write-char #\Page *destination*)))
 
 (defmethod compile-item (client (directive vertical-bar-directive) &optional parameters)
-  (let ((how-many (car parameters)))
-    (case how-many
+  (let ((n (car parameters)))
+    (case n
       (0 nil)
       (1 `((write-char #\Page *destination*)))
       (2 `((write-char #\Page *destination*)
            (write-char #\Page *destination*)))
       (otherwise
-       `((loop repeat ,how-many
+       `((loop repeat ,n
                do (write-char #\Page *destination*)))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -189,19 +191,22 @@
 
 (defmethod parameter-specifications (client (directive tilde-directive))
   (declare (ignore client))
-  '((:type (integer 0) :default 1)))
+  '((:name n
+     :type (integer 0)
+     :bind nil
+     :default 1)))
 
 (defmethod interpret-item (client (directive tilde-directive) &optional parameters)
   (loop repeat (car parameters)
         do (write-char #\~ *destination*)))
 
 (defmethod compile-item (client (directive tilde-directive) &optional parameters)
-  (let ((how-many (car parameters)))
-    (case how-many
+  (let ((n (car parameters)))
+    (case n
       (0 nil)
       (1 `((write-char #\~ *destination*)))
       (2 `((write-char #\~ *destination*)
            (write-char #\~ *destination*)))
       (otherwise
-       `((loop repeat ,how-many
+       `((loop repeat ,n
                do (write-char #\~ *destination*)))))))
diff --git a/code/control-flow-operations.lisp b/code/control-flow-operations.lisp
index 46407fb..933d0b0 100644
--- a/code/control-flow-operations.lisp
+++ b/code/control-flow-operations.lisp
@@ -16,39 +16,39 @@
   (change-class directive 'go-to-directive))
 
 (defmethod parameter-specifications ((client t) (directive go-to-directive))
-  '((:type (or null (integer 0)) :default nil)))
+  '((:name n :type (or null (integer 0)) :default nil)))
 
 (defmethod interpret-item (client (directive go-to-directive) &optional parameters)
   (declare (ignore client))
-  (let ((param (car parameters)))
+  (let ((n (car parameters)))
     (cond ((colon-p directive)
            ;; Back up in the list of arguments.
            ;; The default value for the parameter is 1.
-           (go-to-argument (- (or param 1))))
+           (go-to-argument (- (or n 1))))
           ((at-sign-p directive)
            ;; Go to an absolute argument number.
            ;; The default value for the parameter is 0.
-           (go-to-argument (or param 0) t))
+           (go-to-argument (or n 0) t))
           (t
            ;; Skip the next arguments.
            ;; The default value for the parameter is 1.
-           (go-to-argument (or param 1))))))
+           (go-to-argument (or n 1))))))
 
 (defmethod compile-item (client (directive go-to-directive) &optional parameters)
   (declare (ignore client))
-  (let ((param (car parameters)))
+  (let ((n (car parameters)))
     (cond ((colon-p directive)
            ;; Back up in the list of arguments.
            ;; The default value for the parameter is 1.
-           `((go-to-argument (- (or ,param 1)))))
+           `((go-to-argument (- (or ,n 1)))))
           ((at-sign-p directive)
            ;; Go to an absolute argument number.
            ;; The default value for the parameter is 0.
-           `((go-to-argument (or ,param 0) t)))
+           `((go-to-argument (or ,n 0) t)))
           (t
            ;; Skip the next arguments.
            ;; The default value for the parameter is 1.
-           `((go-to-argument (or ,param 1)))))))
+           `((go-to-argument (or ,n 1)))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
@@ -87,7 +87,7 @@
 
 (defmethod parameter-specifications
     ((client t) (directive conditional-directive))
-  '((:type (or null integer) :default nil)))
+  '((:name n :type (or null integer) :default nil)))
 
 (defmethod check-directive-syntax progn (client (directive conditional-directive))
   (declare (ignore client))
@@ -125,59 +125,62 @@
     (setf (last-clause-is-default-p directive) (and pos t))))
 
 (defmethod interpret-item (client (directive conditional-directive) &optional parameters)
-  (let ((param (car parameters)))
-    (cond ((at-sign-p directive)
-           (when (consume-next-argument t)
+  (with-accessors ((at-sign-p at-sign-p)
+                   (colon-p colon-p)
+                   (clauses clauses))
+      directive
+    (cond (at-sign-p
+           (when (pop-argument)
              (go-to-argument -1)
-             (interpret-items client (aref (clauses directive) 0))))
-          ((colon-p directive)
+             (interpret-items client (aref clauses 0))))
+          (colon-p
            (interpret-items client
-                            (aref (clauses directive)
-                                  (if (consume-next-argument t) 1 0))))
+                            (aref clauses
+                                  (if (pop-argument) 1 0))))
           (t
            ;; If a parameter was given, use it,
            ;; else use the next argument.
-           (let ((val (or param (consume-next-argument 'integer))))
-             (if (or (minusp val)
-                     (>= val (length (clauses directive))))
-                 ;; Then the argument is out of range
-                 (when (last-clause-is-default-p directive)
-                   ;; Then execute the default-clause
-                   (interpret-items client
-                                    (aref (clauses directive)
-                                          (1- (length (clauses directive))))))
-                 ;; Else, execute the corresponding clause
-                 (interpret-items client
-                                  (aref (clauses directive) val))))))))
+           (let ((n (or (car parameters) (pop-argument 'integer))))
+             (cond ((< -1 n (length clauses))
+                    (interpret-items client
+                                     (aref clauses n)))
+                   ((last-clause-is-default-p directive)
+                    (interpret-items client
+                                     (aref clauses
+                                           (1- (length clauses)))))))))))
 
 (defmethod compile-item (client (directive conditional-directive) &optional parameters)
-  (let ((param (car parameters)))
-    (cond ((at-sign-p directive)
-           `((when (consume-next-argument t)
+  (with-accessors ((at-sign-p at-sign-p)
+                   (colon-p colon-p)
+                   (clauses clauses))
+      directive
+    (cond (at-sign-p
+           `((when (pop-argument)
                (go-to-argument -1)
-               ,@(compile-items client (aref (clauses directive) 0)))))
-          ((colon-p directive)
-           `((cond ((consume-next-argument t)
-                    ,@(compile-items client (aref (clauses directive) 1)))
+               ,@(compile-items client (aref clauses 0)))))
+          (colon-p
+           `((cond ((pop-argument)
+                    ,@(compile-items client (aref clauses 1)))
                    (t
-                    ,@(compile-items client (aref (clauses directive) 0))))))
+                    ,@(compile-items client (aref clauses 0))))))
           (t
-           ;; If a parameter was given, use it,
-           ;; else use the next argument.
-           `((let ((val (or ,param (consume-next-argument 'integer))))
-               (if (or (minusp val)
-                       (>= val ,(length (clauses directive))))
-                   ;; Then the argument is out of range
-                   ,(when (last-clause-is-default-p directive)
-                      ;; Then execute the default-clause
-                      `(progn ,@(compile-items client
-                                               (aref (clauses directive)
-                                                     (1- (length (clauses directive)))))))
-                   ;; Else, execute the corresponding clause
-                   (case val
-                     ,@(loop for i from 0
-                             for clause across (clauses directive)
-                             collect `(,i ,@(compile-items client clause)))))))))))
+           (let ((n (car parameters)))
+             (cond ((not (numberp n))
+                    `((case ,(if (null n)
+                                 '(pop-argument 'integer)
+                                 `(or ,n (pop-argument 'integer)))
+                        ,@(loop for i from 0
+                                for j downfrom (1- (length clauses))
+                                for clause across clauses
+                                collect `(,(if (and (zerop j)
+                                                    (last-clause-is-default-p directive))
+                                               'otherwise
+                                               i)
+                                          ,@(compile-items client clause))))))
+                   ((< -1 n (length clauses))
+                    (compile-items client (aref clauses n)))
+                   ((last-clause-is-default-p directive)
+                    (compile-items client (aref clauses (1- (length clauses)))))))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
@@ -212,7 +215,7 @@
 
 (defmethod parameter-specifications
             ((client t) (directive iteration-directive))
-   '((:type (or null (integer 0)) :default nil)))
+   '((:name n :type (or null (integer 0)) :default nil)))
 
 (defmethod interpret-item (client (directive iteration-directive) &optional parameters)
   ;; eliminate the end-of-iteration directive from the
@@ -223,7 +226,7 @@
          (items (aref (clauses directive) 0))
          (oncep (colon-p (aref items (1- (length items))))))
     (if (= (length items) 1)
-        (let ((control (consume-next-argument '(or string function))))
+        (let ((control (pop-argument '(or string function))))
           (cond ((and colon-p at-sign-p)
                  ;; The remaining arguments should be lists.  Each argument
                  ;; is used in a different iteration.
@@ -236,7 +239,7 @@
                                        (< index iteration-limit))
                              when (or (not oncep) (plusp index))
                                do (funcall *inner-exit-if-exhausted*)
-                             do (apply control *destination* (consume-next-argument 'list))))
+                             do (apply control *destination* (pop-argument 'list))))
                      (catch *inner-tag*
                        (loop with *outer-tag* = *inner-tag*
                              with *outer-exit-if-exhausted* = *inner-exit-if-exhausted*
@@ -246,7 +249,7 @@
                                        (< index iteration-limit))
                              when (or (not oncep) (plusp index))
                                do (funcall *inner-exit-if-exhausted*)
-                             do (with-arguments (consume-next-argument 'list)
+                             do (with-arguments (pop-argument 'list)
                                   (let ((*inner-tag* catch-tag))
                                     (catch *inner-tag*
                                       (format-with-runtime-arguments client control))))))))
@@ -254,14 +257,14 @@
                  ;; We use one argument, and that should be a list of sublists.
                  ;; Each sublist is used as arguments for one iteration.
                  (if (functionp control)
-                     (let ((arg (consume-next-argument 'list)))
+                     (let ((arg (pop-argument 'list)))
                        (if (null iteration-limit)
                            (loop for args in arg ; a bit unusual naming perhaps
                                  do (apply control *destination* args))
                            (loop for args in arg ; a bit unusual naming perhaps
                                  repeat iteration-limit
                                  do (apply control *destination* args))))
-                     (let ((arg (consume-next-argument 'list)))
+                     (let ((arg (pop-argument 'list)))
                        (flet ((one-iteration (args)
                                 (unless (listp args)
                                   (error 'argument-type-error
@@ -278,7 +281,7 @@
                                    do (one-iteration args)))))))
                 (at-sign-p
                  (if (functionp control)
-                     (loop for args = (consume-remaining-arguments)
+                     (loop for args = (pop-remaining-arguments)
                              then (apply control *destination* args)
                            for index from 0
                            finally (go-to-argument (- (length args)))
@@ -297,13 +300,13 @@
                  ;; We use one argument, and that should be a list.
                  ;; The elements of that list are used by the iteration.
                  (if (functionp control)
-                     (loop for args = (consume-next-argument 'list)
+                     (loop for args = (pop-argument 'list)
                              then (apply control *destination* args)
                            for index from 0
                            while (and (or (null iteration-limit)
                                           (< index iteration-limit))
                                       (or (and oncep (zerop index)) args)))
-                     (with-arguments (consume-next-argument 'list)
+                     (with-arguments (pop-argument 'list)
                        (catch *inner-tag*
                          (loop for index from 0
                                while (or (null iteration-limit)
@@ -320,18 +323,18 @@
                                  (< index iteration-limit))
                        when (or (not oncep) (plusp index))
                          do (funcall *inner-exit-if-exhausted*)
-                       do (with-arguments (consume-next-argument 'list)
+                       do (with-arguments (pop-argument 'list)
                             (interpret-items client items)))))
               (colon-p
                ;; We use one argument, and that should be a list of sublists.
                ;; Each sublist is used as arguments for one iteration.
-               (with-arguments (consume-next-argument 'list)
+               (with-arguments (pop-argument 'list)
                  (loop for index from 0
                        while (or (null iteration-limit)
                                  (< index iteration-limit))
                        when (or (not oncep) (plusp index))
                          do (funcall *inner-exit-if-exhausted*)
-                       do (with-arguments (consume-next-argument 'list)
+                       do (with-arguments (pop-argument 'list)
                             (interpret-items client items)))))
               (at-sign-p
                (catch *inner-tag*
@@ -345,7 +348,7 @@
                ;; no modifiers
                ;; We use one argument, and that should be a list.
                ;; The elements of that list are used by the iteration.
-               (with-arguments (consume-next-argument 'list)
+               (with-arguments (pop-argument 'list)
                  (loop for index from 0
                        while (or (null iteration-limit)
                                  (< index iteration-limit))
@@ -366,7 +369,7 @@
                ;; The remaining arguments should be lists.  Each argument
                ;; is used in a different iteration.
                `((let ((iteration-limit ,iteration-limit)
-                       (control (consume-next-argument '(or function string))))
+                       (control (pop-argument '(or function string))))
                    (catch *inner-tag*
                      (loop for index from 0
                            while (or (null iteration-limit)
@@ -375,17 +378,17 @@
                                  '(when (plusp index) do (funcall *inner-exit-if-exhausted*))
                                  '(do (funcall *inner-exit-if-exhausted*)))
                            if (functionp control)
-                             do (apply control *destination* (consume-next-argument 'list))
+                             do (apply control *destination* (pop-argument 'list))
                            else
-                             do (with-arguments (consume-next-argument 'list)
+                             do (with-arguments (pop-argument 'list)
                                   (format-with-runtime-arguments ,(incless:client-form client)
                                                                  control)))))))
               (colon-p
                ;; We use one argument, and that should be a list of sublists.
                ;; Each sublist is used as arguments for one iteration.
                `((let ((iteration-limit ,iteration-limit)
-                       (control (consume-next-argument '(or function string))))
-                   (with-arguments (consume-next-argument 'list)
+                       (control (pop-argument '(or function string))))
+                   (with-arguments (pop-argument 'list)
                      (loop for index from 0
                            while (or (null iteration-limit)
                                      (< index iteration-limit))
@@ -393,16 +396,16 @@
                                  '(when (plusp index) do (funcall *inner-exit-if-exhausted*))
                                  '(do (funcall *inner-exit-if-exhausted*)))
                            if (functionp control)
-                             do (apply control *destination* (consume-next-argument 'list))
+                             do (apply control *destination* (pop-argument 'list))
                            else
-                             do (with-arguments (consume-next-argument 'list)
+                             do (with-arguments (pop-argument 'list)
                                   (format-with-runtime-arguments ,(incless:client-form client)
                                                                  control)))))))
               (at-sign-p
                `((let ((iteration-limit ,iteration-limit)
-                       (control (consume-next-argument '(or function string))))
+                       (control (pop-argument '(or function string))))
                    (if (functionp control)
-                       (loop for args = (consume-remaining-arguments)
+                       (loop for args = (pop-remaining-arguments)
                                then (apply control *destination* args)
                              for index from 0
                              finally (go-to-argument (- (length args)))
@@ -425,9 +428,9 @@
                ;; We use one argument, and that should be a list.
                ;; The elements of that list are used by the iteration.
                `((let ((iteration-limit ,iteration-limit)
-                       (control (consume-next-argument '(or function string))))
+                       (control (pop-argument '(or function string))))
                    (if (functionp control)
-                       (loop for args = (consume-next-argument 'list)
+                       (loop for args = (pop-argument 'list)
                                then (apply control *destination* args)
                              for index from 0
                              while (and (or (null iteration-limit)
@@ -435,7 +438,7 @@
                                         ,(if oncep
                                              '(or (zerop index) args)
                                              'args)))
-                       (with-arguments (consume-next-argument 'list)
+                       (with-arguments (pop-argument 'list)
                          (loop for index from 0
                                while (or (null iteration-limit)
                                          (< index iteration-limit))
@@ -456,20 +459,20 @@
                              ,@(if oncep
                                    '(when (plusp index) do (funcall *inner-exit-if-exhausted*))
                                    '(do (funcall *inner-exit-if-exhausted*)))
-                             do (with-arguments (consume-next-argument 'list)
+                             do (with-arguments (pop-argument 'list)
                                   ,@compiled-items))))))
                 (colon-p
                  ;; We use one argument, and that should be a list of sublists.
                  ;; Each sublist is used as arguments for one iteration.
                  `((let ((iteration-limit ,iteration-limit))
-                     (with-arguments (consume-next-argument 'list)
+                     (with-arguments (pop-argument 'list)
                        (loop for index from 0
                              while (or (null iteration-limit)
                                        (< index iteration-limit))
                              ,@(if oncep
                                    '(when (plusp index) do (funcall *inner-exit-if-exhausted*))
                                    '(do (funcall *inner-exit-if-exhausted*)))
-                             do (with-arguments (consume-next-argument 'list)
+                             do (with-arguments (pop-argument 'list)
                                   ,@compiled-items))))))
                 (at-sign-p
                  `((let ((iteration-limit ,iteration-limit))
@@ -487,7 +490,7 @@
                  ;; We use one argument, and that should be a list.
                  ;; The elements of that list are used by the iteration.
                  `((let ((iteration-limit ,iteration-limit))
-                     (with-arguments (consume-next-argument 'list)
+                     (with-arguments (pop-argument 'list)
                        (loop for index from 0
                              while (or (null iteration-limit)
                                        (< index iteration-limit))
@@ -514,23 +517,23 @@
   (if (at-sign-p directive)
       ;; reuse the arguments from the parent control-string
       (format-with-runtime-arguments client
-                                     (consume-next-argument 'string))
+                                     (pop-argument 'string))
       ;;
       (apply #'format
              client
              *destination*
-             (consume-next-argument 'string)
-             (consume-next-argument 'list))))
+             (pop-argument 'string)
+             (pop-argument 'list))))
 
 (defmethod compile-item (client (directive recursive-processing-directive) &optional parameters)
   (declare (ignore parameters))
   (if (at-sign-p directive)
       ;; reuse the arguments from the parent control-string
       `((format-with-runtime-arguments ,(incless:client-form client)
-                                       (consume-next-argument 'string)))
+                                       (pop-argument 'string)))
       ;;
       `((apply #'format
                ,(incless:client-form client)
                *destination*
-               (consume-next-argument 'string)
-               (consume-next-argument 'list)))))
+               (pop-argument 'string)
+               (pop-argument 'list)))))
diff --git a/code/directive.lisp b/code/directive.lisp
index d659cc3..9e99bd7 100644
--- a/code/directive.lisp
+++ b/code/directive.lisp
@@ -50,9 +50,16 @@
 (defgeneric compile-parameter (parameter))
 
 (defclass parameter ()
-  ((%type :accessor parameter-type
+  ((%name :accessor parameter-name
+          :initarg :name
+          :initform (gensym))
+   (%type :accessor parameter-type
           :initarg :type
           :initform '(or null character integer))
+   (%bind :accessor parameter-bind-p
+          :initarg :bind
+          :initform t
+          :type boolean)
    (%default :accessor parameter-default
              :initarg :default
              :initform nil)))
diff --git a/code/extrinsic/ansi-test/expected-failures.sexp b/code/extrinsic/ansi-test/expected-failures.sexp
index 2186af8..a0128c7 100644
--- a/code/extrinsic/ansi-test/expected-failures.sexp
+++ b/code/extrinsic/ansi-test/expected-failures.sexp
@@ -3,4 +3,8 @@
 #+(or clasp ecl) :MAKE-CONDITION-WITH-COMPOUND-NAME
 #+(or clasp ecl) :NO-FLOATING-POINT-UNDERFLOW-BY-DEFAULT
 
-#+(or abcl clasp ecl sbcl) FORMAT.E.26
+#+(or abcl ccl clasp cmucl ecl sbcl) FORMAT.E.26
+
+#+cmucl FORMAT.{.ERROR.5
+#+cmucl |FORMAT.:{.ERROR.3|
+#+cmucl |FORMAT.:@{.ERROR.5|
\ No newline at end of file
diff --git a/code/extrinsic/unit-test/utilities.lisp b/code/extrinsic/unit-test/utilities.lisp
index b7a10ed..c6879ff 100644
--- a/code/extrinsic/unit-test/utilities.lisp
+++ b/code/extrinsic/unit-test/utilities.lisp
@@ -3,6 +3,8 @@
 (defun format-eval (&rest args)
   (apply #'invistra-extrinsic:format args))
 
+(defun rti (x) x)
+
 (defmacro my-with-standard-io-syntax (&body body)
   `(let ((*print-array* t)
          (*print-base* 10)
@@ -27,7 +29,7 @@
           ,expected
           ,form))
     (macrolet ((fmt (destination control-string &rest args)
-                 `(invistra-extrinsic:format ,destination (progn ,control-string) ,@args)))
+                 `(invistra-extrinsic:format ,destination (rti ,control-string) ,@args)))
       (is equal
           ,expected
           ,form))))
@@ -41,7 +43,7 @@
              ,expected
              ,form))
        (macrolet ((fmt (destination control-string &rest args)
-                    `(invistra-extrinsic:format ,destination (progn ,control-string) ,@args)))
+                    `(invistra-extrinsic:format ,destination (rti ,control-string) ,@args)))
          (is equal
              ,expected
              ,form)))))
@@ -54,7 +56,7 @@
                      ,form)
                    condition)
      (fail (macrolet ((fmt (destination control-string &rest args)
-                        `(invistra-extrinsic:format ,destination (progn ,control-string) ,@args)))
+                        `(invistra-extrinsic:format ,destination (rti ,control-string) ,@args)))
              ,form))))
 
 (defmacro define-argument-fail-test (name form)
@@ -64,5 +66,5 @@
                                 `(invistra-extrinsic:format ,destination ,control-string ,@args)))
                      ,form))
      (fail (macrolet ((fmt (destination control-string &rest args)
-                        `(invistra-extrinsic:format ,destination (progn ,control-string) ,@args)))
+                        `(invistra-extrinsic:format ,destination (rti ,control-string) ,@args)))
              ,form))))
diff --git a/code/floating-point-printers.lisp b/code/floating-point-printers.lisp
index f905653..59f1eb2 100644
--- a/code/floating-point-printers.lisp
+++ b/code/floating-point-printers.lisp
@@ -5,7 +5,7 @@
 (in-package #:invistra)
 
 (defun print-float-arg (client func)
-  (let ((value (consume-next-argument t)))
+  (let ((value (pop-argument)))
     (if (or (complexp value)
             (not (numberp value)))
         (let ((*print-base* 10)
@@ -66,11 +66,11 @@
   (change-class directive 'f-directive))
 
 (defmethod parameter-specifications ((client t) (directive f-directive))
-  '((:type (or null integer) :default nil)
-    (:type (or null integer) :default nil)
-    (:type (or null integer) :default 0)
-    (:type (or null character) :default nil)
-    (:type character :default #\Space)))
+  '((:name w :type (or null integer) :default nil)
+    (:name d :type (or null integer) :default nil)
+    (:name k :type (or null integer) :default 0)
+    (:name overflowchar :type (or null character) :default nil)
+    (:name padchar :type character :default #\Space)))
 
 (defun print-fixed-arg (client value digits exponent
                         colon-p at-sign-p w d k overflowchar padchar)
@@ -171,13 +171,11 @@
                             parameters))))
 
 (defmethod compile-item (client (directive f-directive) &optional parameters)
-  `((let ((parameters (list ,@parameters)))
-      (print-float-arg ,(incless:client-form client)
-                       (lambda (client value digits exponent)
-                         (apply #'print-fixed-arg
-                                client value digits exponent
-                                ,(colon-p directive) ,(at-sign-p directive)
-                                parameters))))))
+  `((print-float-arg ,(incless:client-form client)
+                     (lambda (client value digits exponent)
+                       (print-fixed-arg client value digits exponent
+                                        ,(colon-p directive) ,(at-sign-p directive)
+                                        ,@parameters)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
@@ -190,13 +188,13 @@
   (change-class directive 'e-directive))
 
 (defmethod parameter-specifications ((client t) (directive e-directive))
-  '((:type (or null integer) :default nil)
-    (:type (or null integer) :default nil)
-    (:type (or null integer) :default nil)
-    (:type (or null integer) :default 1)
-    (:type (or null character) :default nil)
-    (:type character :default #\Space)
-    (:type (or null character) :default nil)))
+  '((:name w :type (or null integer) :default nil)
+    (:name d :type (or null integer) :default nil)
+    (:name e :type (or null integer) :default nil)
+    (:name k :type (or null integer) :default 1)
+    (:name overflowchar :type (or null character) :default nil)
+    (:name padchar :type character :default #\Space)
+    (:name exponentchar :type (or null character) :default nil)))
 
 (defun print-exponent-arg (client value digits exponent colon-p at-sign-p w d e k overflowchar padchar exponentchar)
   (declare (ignore colon-p))
@@ -311,12 +309,11 @@
                             parameters))))
 
 (defmethod compile-item (client (directive e-directive) &optional parameters)
-  `((let ((parameters (list ,@parameters)))
-      (print-float-arg ,(incless:client-form client)
-                       (lambda (client value digits exponent)
-                         (apply #'print-exponent-arg client value digits exponent
-                                ,(colon-p directive) ,(at-sign-p directive)
-                                parameters))))))
+  `((print-float-arg ,(incless:client-form client)
+                     (lambda (client value digits exponent)
+                       (print-exponent-arg client value digits exponent
+                                           ,(colon-p directive) ,(at-sign-p directive)
+                                           ,@parameters)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
@@ -329,13 +326,13 @@
   (change-class directive 'g-directive))
 
 (defmethod parameter-specifications ((client t) (directive g-directive))
-  '((:type (or null integer) :default nil)
-    (:type (or null integer) :default nil)
-    (:type (or null integer) :default nil)
-    (:type (or null integer) :default 1)
-    (:type (or null character) :default nil)
-    (:type character :default #\Space)
-    (:type (or null character) :default nil)))
+  '((:name w :type (or null integer) :default nil)
+    (:name d :type (or null integer) :default nil)
+    (:name e :type (or null integer) :default nil)
+    (:name k :type (or null integer) :default 1)
+    (:name overflowchar :type (or null character) :default nil)
+    (:name padchar :type character :default #\Space)
+    (:name exponentchar :type (or null character) :default nil)))
 
 (defun print-general-arg (client value digits exponent
                           colon-p at-sign-p w d e k
@@ -369,13 +366,11 @@
                             parameters))))
 
 (defmethod compile-item (client (directive g-directive) &optional parameters)
-  `((let ((parameters (list ,@parameters)))
-      (print-float-arg ,(incless:client-form client)
-                       (lambda (client value digits exponent)
-                         (apply #'print-general-arg
-                                client value digits exponent
-                                ,(colon-p directive) ,(at-sign-p directive)
-                                parameters))))))
+  `((print-float-arg ,(incless:client-form client)
+                     (lambda (client value digits exponent)
+                       (print-general-arg client value digits exponent
+                                          ,(colon-p directive) ,(at-sign-p directive)
+                                          ,@parameters)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
@@ -389,10 +384,10 @@
 
 (defmethod parameter-specifications
     ((client t) (directive monetary-directive))
-  '((:type integer :default 2)
-    (:type integer :default 1)
-    (:type (or null integer) :default nil)
-    (:type character :default #\Space)))
+  '((:name d :type integer :default 2)
+    (:name n :type integer :default 1)
+    (:name w :type (or null integer) :default nil)
+    (:name padchar :type character :default #\Space)))
 
 (defun print-monetary-arg (client value digits exponent
                            colon-p at-sign-p d n w padchar)
@@ -461,10 +456,8 @@
                             parameters))))
 
 (defmethod compile-item (client (directive monetary-directive) &optional parameters)
-  `((let ((parameters (list ,@parameters)))
-      (print-float-arg ,(incless:client-form client)
-                       (lambda (client value digits exponent)
-                         (apply #'print-monetary-arg
-                                client value digits exponent
-                                ,(colon-p directive) ,(at-sign-p directive)
-                                parameters))))))
+  `((print-float-arg ,(incless:client-form client)
+                     (lambda (client value digits exponent)
+                       (print-monetary-arg client value digits exponent
+                                           ,(colon-p directive) ,(at-sign-p directive)
+                                           ,@parameters)))))
diff --git a/code/format.lisp b/code/format.lisp
index 84c6aff..d196701 100644
--- a/code/format.lisp
+++ b/code/format.lisp
@@ -98,7 +98,7 @@
 
 ;;; The directive interpreter.
 
-(defun consume-next-argument (type)
+(defun pop-argument (&optional (type t))
   (unless (< *previous-argument-index* (length *previous-arguments*))
     (let (exited)
       (unwind-protect
@@ -119,7 +119,7 @@
              :datum arg))
     arg))
 
-(defun consume-remaining-arguments ()
+(defun pop-remaining-arguments ()
   (let* ((tail (funcall *pop-remaining-arguments*))
          (tail-len (length tail)))
     (adjust-array *previous-arguments* (+ (length *previous-arguments*) tail-len))
@@ -142,8 +142,8 @@
           next
             (decf index)
             (when (zerop index)
-              (return (consume-next-argument t)))
-            (consume-next-argument t)
+              (return (pop-argument)))
+            (pop-argument)
             (go next)))
         (t
          (let ((new-arg-index (+ *previous-argument-index* index)))
@@ -156,12 +156,14 @@
            (aref *previous-arguments* *previous-argument-index*)))))
 
 (defmethod interpret-parameter ((parameter argument-reference-parameter))
-  (or (consume-next-argument `(or null ,(parameter-type parameter)))
+  (or (pop-argument `(or null ,(parameter-type parameter)))
       (parameter-default parameter)))
 
 (defmethod compile-parameter ((parameter argument-reference-parameter))
-  `(or (consume-next-argument '(or null ,(parameter-type parameter)))
-       ,(parameter-default parameter)))
+  (if (parameter-default parameter)
+      `(or (pop-argument '(or null ,(parameter-type parameter)))
+           ,(parameter-default parameter))
+      `(pop-argument '(or null ,(parameter-type parameter)))))
 
 (defmethod interpret-parameter ((parameter remaining-argument-count-parameter))
   (if (typep *remaining-argument-count*
@@ -262,5 +264,18 @@
 
 (defmethod compile-item :around (client (item directive) &optional parameters)
   (declare (ignore parameters))
-  (call-next-method client item
-                    (mapcar #'compile-parameter (parameters item))))
+  (loop for parameter in (parameters item)
+        for compiled-parameter = (compile-parameter parameter)
+        for name = (parameter-name parameter)
+        finally (return (if bindings
+                            `((let* ,bindings
+                                (declare (ignorable ,@(mapcar #'first bindings)))
+                                ,@(call-next-method client item forms)))
+                            (call-next-method client item forms)))
+        when (or (not (parameter-bind-p parameter))
+                 (constantp compiled-parameter))
+          collect compiled-parameter into forms
+        else
+          collect name into forms
+          and collect `(,name ,compiled-parameter) into bindings
+        end))
diff --git a/code/formatter.lisp b/code/formatter.lisp
index 6652b1c..adefa31 100644
--- a/code/formatter.lisp
+++ b/code/formatter.lisp
@@ -6,7 +6,7 @@
     `(lambda (*destination* &rest args)
        (with-arguments args
          ,@(compile-items client items)
-         (consume-remaining-arguments)))))
+         (pop-remaining-arguments)))))
 
 (defun format-compiler-macro (client form destination control-string args)
   (declare (ignore form))
diff --git a/code/generic-functions.lisp b/code/generic-functions.lisp
index 2d00c22..d225cdd 100644
--- a/code/generic-functions.lisp
+++ b/code/generic-functions.lisp
@@ -42,3 +42,8 @@
   (:method (client object)
     (declare (ignore client))
     object))
+
+(defgeneric print-key-sequence (client character stream)
+  (:method (client character stream)
+    (declare (ignore client stream))
+    character))
diff --git a/code/interface.lisp b/code/interface.lisp
index 274b23f..44b94d0 100644
--- a/code/interface.lisp
+++ b/code/interface.lisp
@@ -4,6 +4,7 @@
   (intern (string name) package))
 
 (defmacro define-interface ((client-var client-class &optional intrinsic) &body body)
+  (declare (ignore client-class))
   (let* ((intrinsic-pkg (if intrinsic (find-package '#:common-lisp) *package*))
          (format-func (ensure-symbol '#:format intrinsic-pkg))
          (initialize-func (ensure-symbol '#:initialize-invistra)))
diff --git a/code/layout-control.lisp b/code/layout-control.lisp
index dc07907..34afebf 100644
--- a/code/layout-control.lisp
+++ b/code/layout-control.lisp
@@ -16,8 +16,14 @@
 
 (defmethod parameter-specifications
     ((client t) (directive tabulate-directive))
-  '((:type (integer 0) :default 1)
-    (:type (integer 0) :default 1)))
+  '((:name colnum
+     :type (integer 0)
+     :bind nil
+     :default 1)
+    (:name colinc
+     :type (integer 0)
+     :bind nil
+     :default 1)))
 
 (defmethod layout-requirements ((item tabulate-directive))
   (when (colon-p item)
@@ -45,8 +51,9 @@
                                                (+ cur (- colinc (rem (- cur colnum) colinc)))))))))
 
 (defmethod interpret-item (client (directive tabulate-directive) &optional parameters)
-  (let ((colon-p (colon-p directive))
-        (at-sign-p (at-sign-p directive)))
+  (with-accessors ((colon-p colon-p)
+                   (at-sign-p at-sign-p))
+      directive
     (cond (colon-p
            #-sicl
            (apply #'inravina:pprint-tab
@@ -59,8 +66,9 @@
            (apply #'format-absolute-tab client parameters)))))
 
 (defmethod compile-item (client (directive tabulate-directive) &optional parameters)
-  (let ((colon-p (colon-p directive))
-        (at-sign-p (at-sign-p directive)))
+  (with-accessors ((colon-p colon-p)
+                   (at-sign-p at-sign-p))
+      directive
     (cond (colon-p
            #-sicl
            `((inravina:pprint-tab ,(incless:client-form client) *destination*
@@ -105,10 +113,18 @@
 
 (defmethod parameter-specifications
     ((client t) (directive justification-directive))
-  '((:type integer :default 0)
-    (:type (integer 0) :default 1)
-    (:type integer :default 0)
-    (:type character :default #\Space)))
+  '((:name mincol
+     :type integer
+     :default 0)
+    (:name colinc
+     :type (integer 0)
+     :default 1)
+    (:name minpad
+     :type integer
+     :default 0)
+    (:name padchar
+     :type character
+     :default #\Space)))
 
 (defmethod layout-requirements :around ((item justification-directive))
   (merge-layout-requirements (list (if (colon-p (aref (aref (clauses item) 0) (1- (length (aref (clauses item) 0)))))
@@ -188,29 +204,21 @@
           collect segment into segments))
 
 (defmethod compile-item (client (directive justification-directive) &optional parameters)
-  `((prog (newline-segment segments
-           *extra-space* *line-length*
-           (parameters (list ,@parameters)))
-       ,@(loop for clause across (clauses directive)
-               for segment = `(catch *inner-tag*
-                                (with-output-to-string (*destination*)
-                                  ,@(compile-items client clause)))
-               for index from 0
-               while segment
-               if (and (zerop index)
-                       (colon-p (aref clause (1- (length clause)))))
-                 collect `(let ((segment ,segment))
-                            (if segment
-                                (setf newline-segment segment)
-                                (go end)))
-               else
-                 collect `(let ((segment ,segment))
-                            (if segment
-                                (push segment segments)
-                                (go end))))
-     end
-       (apply #'print-justification ,(incless:client-form client)
-              ,(colon-p directive) ,(at-sign-p directive)
-              *extra-space* *line-length*
-              newline-segment (nreverse segments)
-              parameters))))
+  `((let (newline-segment segments
+          *extra-space* *line-length*)
+      (catch *inner-tag*
+        ,@(loop for clause across (clauses directive)
+                for segment = `(with-output-to-string (*destination*)
+                                 ,@(compile-items client clause))
+                for index from 0
+                while segment
+                if (and (zerop index)
+                        (colon-p (aref clause (1- (length clause)))))
+                  collect `(setf newline-segment ,segment)
+                else
+                  collect `(push ,segment segments)))
+      (print-justification ,(incless:client-form client)
+                           ,(colon-p directive) ,(at-sign-p directive)
+                           *extra-space* *line-length*
+                           newline-segment (nreverse segments)
+                           ,@parameters))))
diff --git a/code/miscellaneous-operations.lisp b/code/miscellaneous-operations.lisp
index 661775f..913f9ae 100644
--- a/code/miscellaneous-operations.lisp
+++ b/code/miscellaneous-operations.lisp
@@ -36,24 +36,26 @@
          :control-string (control-string directive)
          :tilde-position (start directive)))
 
-(defmethod interpret-item (client (item case-conversion-directive) &optional parameters)
+(defmethod interpret-item (client (directive case-conversion-directive) &optional parameters)
   (declare (ignore parameters))
-  (let* ((colon-p (colon-p item))
-         (at-sign-p (at-sign-p item))
-         (*destination* (cond ((and colon-p at-sign-p)
-                               (make-instance 'upcase-stream :target *destination*))
-                              (colon-p
-                               (make-instance 'capitalize-stream :target *destination*))
-                              (at-sign-p
-                               (make-instance 'first-capitalize-stream :target *destination*))
-                              (t
-                               (make-instance 'downcase-stream :target *destination*)))))
-    (interpret-items client (aref (clauses item) 0))))
+  (with-accessors ((colon-p colon-p)
+                   (at-sign-p at-sign-p))
+      directive
+    (let ((*destination* (cond ((and colon-p at-sign-p)
+                                (make-instance 'upcase-stream :target *destination*))
+                               (colon-p
+                                (make-instance 'capitalize-stream :target *destination*))
+                               (at-sign-p
+                                (make-instance 'first-capitalize-stream :target *destination*))
+                               (t
+                                (make-instance 'downcase-stream :target *destination*)))))
+      (interpret-items client (aref (clauses directive) 0)))))
 
-(defmethod compile-item (client (item case-conversion-directive) &optional parameters)
+(defmethod compile-item (client (directive case-conversion-directive) &optional parameters)
   (declare (ignore parameters))
-  (let ((colon-p (colon-p item))
-        (at-sign-p (at-sign-p item)))
+  (with-accessors ((colon-p colon-p)
+                   (at-sign-p at-sign-p))
+      directive
     `((let ((*destination* ,(cond ((and colon-p at-sign-p)
                                    '(make-instance 'upcase-stream :target *destination*))
                                   (colon-p
@@ -62,7 +64,7 @@
                                    '(make-instance 'first-capitalize-stream :target *destination*))
                                   (t
                                    '(make-instance 'downcase-stream :target *destination*)))))
-        ,@(compile-items client (aref (clauses item) 0))))))
+        ,@(compile-items client (aref (clauses directive) 0))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
@@ -74,26 +76,32 @@
     ((client t) (char (eql #\P)) directive (end-directive t))
   (change-class directive 'plural-directive))
 
-(defmethod interpret-item (client (item plural-directive) &optional parameters)
+(defmethod interpret-item (client (directive plural-directive) &optional parameters)
   (declare (ignore parameters))
-  (when (colon-p item)
-    (go-to-argument -1))
-  (if (at-sign-p item)
-      (write-string (if (eql (consume-next-argument t) 1)
-                        "y"
-                        "ies")
-                    *destination*)
-      (unless (eql (consume-next-argument t) 1)
-        (write-char #\s *destination*))))
+  (with-accessors ((colon-p colon-p)
+                   (at-sign-p at-sign-p))
+      directive
+    (when colon-p
+      (go-to-argument -1))
+    (if at-sign-p
+        (write-string (if (eql (pop-argument) 1)
+                          "y"
+                          "ies")
+                      *destination*)
+        (unless (eql (pop-argument) 1)
+          (write-char #\s *destination*)))))
 
-(defmethod compile-item (client (item plural-directive) &optional parameters)
+(defmethod compile-item (client (directive plural-directive) &optional parameters)
   (declare (ignore parameters))
-  `(,@(when (colon-p item)
-        `((go-to-argument -1)))
-    ,(if (at-sign-p item)
-         `(write-string (if (eql (consume-next-argument t) 1)
-                            "y"
-                            "ies")
-                        *destination*)
-         `(unless (eql (consume-next-argument t) 1)
-            (write-char #\s *destination*)))))
+  (with-accessors ((colon-p colon-p)
+                   (at-sign-p at-sign-p))
+      directive
+    `(,@(when colon-p
+          `((go-to-argument -1)))
+      ,(if at-sign-p
+           `(write-string (if (eql (pop-argument) 1)
+                              "y"
+                              "ies")
+                          *destination*)
+           `(unless (eql (pop-argument) 1)
+              (write-char #\s *destination*))))))
diff --git a/code/miscellaneous-pseudo-operations.lisp b/code/miscellaneous-pseudo-operations.lisp
index 58d8919..91c7c44 100644
--- a/code/miscellaneous-pseudo-operations.lisp
+++ b/code/miscellaneous-pseudo-operations.lisp
@@ -20,8 +20,12 @@
 
 (defmethod parameter-specifications
     ((client t) (directive semicolon-directive))
-  '((:type (or null integer) :default nil)
-    (:type (or null integer) :default nil)))
+  '((:name *extra-space*
+     :type (or null integer)
+     :bind nil)
+    (:name *line-length*
+     :type (or null integer)
+     :bind nil)))
 
 (defmethod structured-separator-p ((directive semicolon-directive))
   t)
@@ -60,9 +64,9 @@
 
 (defmethod parameter-specifications
     ((client t) (directive circumflex-directive))
-  '((:type (or null character integer))
-    (:type (or null character integer))
-    (:type (or null character integer))))
+  '((:name p1 :type (or null character integer))
+    (:name p2 :type (or null character integer))
+    (:name p3 :type (or null character integer))))
 
 (defmethod check-directive-syntax progn
     (client (directive circumflex-directive))
@@ -78,56 +82,50 @@
              :parameter3 3))))
 
 (defmethod interpret-item (client (directive circumflex-directive) &optional parameters)
-  (let ((p1 (car parameters))
-        (p2 (cadr parameters))
-        (p3 (caddr parameters))
-        (colon-p (colon-p directive)))
-    (cond ((and (null p1) (null p2) (null p3))
-           (funcall (if colon-p *outer-exit-if-exhausted* *inner-exit-if-exhausted*)))
-          ((or (and (eql p1 0) (null p2) (null p3))
-               (and (null p1) (eql p2 0) (null p3))
-               (and (null p1) (null p2) (eql p3 0))
-               (and (null p1) p2 p3 (eql p2 p3))
-               (and (null p2) p1 p3 (eql p1 p3))
-               (and (null p3) p1 p2 (eql p1 p2))
-               (and p1 p2 p3 (<= p1 p2 p3)))
-           (funcall (if colon-p *outer-exit* *inner-exit*) nil)))))
+  (with-accessors ((colon-p colon-p))
+      directive
+    (destructuring-bind (p1 p2 p3)
+        parameters
+      (cond ((and (null p1) (null p2) (null p3))
+             (funcall (if colon-p *outer-exit-if-exhausted* *inner-exit-if-exhausted*)))
+            ((or (and (eql p1 0) (null p2) (null p3))
+                 (and (null p1) (eql p2 0) (null p3))
+                 (and (null p1) (null p2) (eql p3 0))
+                 (and (null p1) p2 p3 (eql p2 p3))
+                 (and (null p2) p1 p3 (eql p1 p3))
+                 (and (null p3) p1 p2 (eql p1 p2))
+                 (and p1 p2 p3 (<= p1 p2 p3)))
+             (funcall (if colon-p *outer-exit* *inner-exit*) nil))))))
 
 (defmethod compile-item (client (directive circumflex-directive) &optional parameters)
-  (let ((p1 (car parameters))
-        (p2 (cadr parameters))
-        (p3 (caddr parameters))
-        (colon-p (colon-p directive)))
-    (cond ((null p1)
-           `((funcall ,(if colon-p '*outer-exit-if-exhausted* '*inner-exit-if-exhausted*))))
-          ((null p2)
-           `((let ((p1 ,p1))
-               (cond ((null p1)
+  (with-accessors ((colon-p colon-p))
+      directive
+    (destructuring-bind (p1 p2 p3)
+        parameters
+      (cond ((null p1)
+             `((funcall ,(if colon-p '*outer-exit-if-exhausted* '*inner-exit-if-exhausted*))))
+            ((null p2)
+             `((cond ((null ,p1)
                       (funcall ,(if colon-p '*outer-exit-if-exhausted* '*inner-exit-if-exhausted*)))
-                     ((eql 0 p1)
-                      (funcall ,(if colon-p '*outer-exit* '*inner-exit*) nil))))))
-          ((null p3)
-           `((let ((p1 ,p1)
-                   (p2 ,p2))
-               (cond ((and (null p1) (null p2))
+                     ((eql 0 ,p1)
+                      (funcall ,(if colon-p '*outer-exit* '*inner-exit*) nil)))))
+            ((null p3)
+             `((cond ((and (null ,p1) (null ,p2))
                       (funcall ,(if colon-p '*outer-exit-if-exhausted* '*inner-exit-if-exhausted*)))
-                     ((or (and (null p1) (eql 0 p2))
-                          (and (eql 0 p1) (null p2))
-                          (and p1 p2 (eql p1 p2)))
-                      (funcall ,(if colon-p '*outer-exit* '*inner-exit*) nil))))))
-          (t
-           `((let ((p1 ,p1)
-                   (p2 ,p2)
-                   (p3 ,p3))
-               (cond ((and (null p1) (null p2) (null p3))
+                     ((or (and (null ,p1) (eql 0 ,p2))
+                          (and (eql 0 ,p1) (null ,p2))
+                          (and ,p1 ,p2 (eql ,p1 ,p2)))
+                      (funcall ,(if colon-p '*outer-exit* '*inner-exit*) nil)))))
+            (t
+             `((cond ((and (null ,p1) (null ,p2) (null ,p3))
                       (funcall ,(if colon-p '*outer-exit-if-exhausted* '*inner-exit-if-exhausted*)))
-                     ((or (and (null p1) (null p2) (eql 0 p3))
-                          (and (null p1) (eql 0 p2) (null p3))
-                          (and (eql 0 p1) (null p2) (null p3))
-                          (and (null p1) p2 p3 (eql p2 p3))
-                          (and (null p2) p1 p3 (eql p1 p3))
-                          (and (null p3) p1 p2 (eql p1 p2))
-                          (and p1 p2 p3 (<= p1 p2 p3)))
+                     ((or (and (null ,p1) (null ,p2) (eql 0 ,p3))
+                          (and (null ,p1) (eql 0 ,p2) (null ,p3))
+                          (and (eql 0 ,p1) (null ,p2) (null ,p3))
+                          (and (null ,p1) ,p2 ,p3 (eql ,p2 ,p3))
+                          (and (null ,p2) ,p1 ,p3 (eql ,p1 ,p3))
+                          (and (null ,p3) ,p1 ,p2 (eql ,p1 ,p2))
+                          (and ,p1 ,p2 ,p3 (<= ,p1 ,p2 ,p3)))
                       (funcall ,(if colon-p '*outer-exit* '*inner-exit*) nil)))))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -154,7 +152,7 @@
          (write-string (subseq (control-string directive) (suffix-start directive) (end directive)) *destination*))
         ((at-sign-p directive)
          ;; Print the newline, but remove the following whitespace.
-         (write-char #\Newline *destination*))
+         (terpri *destination*))
         (t
          ;; Ignore both the newline and the following whitespace.
          nil)))
@@ -166,7 +164,7 @@
          `((write-string ,(subseq (control-string directive) (suffix-start directive) (end directive)) *destination*)))
         ((at-sign-p directive)
          ;; Print the newline, but remove the following whitespace.
-         `((write-char #\Newline *destination*)))
+         `((terpri *destination*)))
         (t
          ;; Ignore both the newline and the following whitespace.
          nil)))
diff --git a/code/numeral/numeral.lisp b/code/numeral/numeral.lisp
index 407f51c..ace2b45 100644
--- a/code/numeral/numeral.lisp
+++ b/code/numeral/numeral.lisp
@@ -50,7 +50,7 @@
         . #1#))|#
 
 (defun print-numeral-arg (client colon-p at-sign-p pattern mincol padchar commachar comma-interval)
-  (prog ((q (invistra:consume-next-argument t))
+  (prog ((q (invistra:pop-argument))
          (r 0)
          (c 0)
          parts
diff --git a/code/packages.lisp b/code/packages.lisp
index 1242ac5..083c7dd 100644
--- a/code/packages.lisp
+++ b/code/packages.lisp
@@ -11,7 +11,7 @@
            #:coerce-function-designator
            #:colon-p
            #:compile-item
-           #:consume-next-argument
+           #:pop-argument
            #:define-interface
            #:directive
            #:format
diff --git a/code/pretty-printer-operations.lisp b/code/pretty-printer-operations.lisp
index 39d28ac..92011df 100644
--- a/code/pretty-printer-operations.lisp
+++ b/code/pretty-printer-operations.lisp
@@ -21,8 +21,9 @@
   (declare (ignore parameters)
            (ignorable client))
   #-sicl
-  (let ((colon-p (colon-p directive))
-        (at-sign-p (at-sign-p directive)))
+  (with-accessors ((colon-p colon-p)
+                   (at-sign-p at-sign-p))
+      directive
     (inravina:pprint-newline client *destination*
                              (cond ((and colon-p at-sign-p) :mandatory)
                                    (colon-p :fill)
@@ -33,8 +34,9 @@
   (declare (ignore parameters)
            (ignorable client))
   #-sicl
-  (let ((colon-p (colon-p directive))
-        (at-sign-p (at-sign-p directive)))
+  (with-accessors ((colon-p colon-p)
+                   (at-sign-p at-sign-p))
+      directive
     `((inravina:pprint-newline ,(incless:client-form client) *destination*
                                ,(cond ((and colon-p at-sign-p) :mandatory)
                                       (colon-p :fill)
@@ -113,7 +115,7 @@
          (per-line-prefix-p (and (> (length (clauses directive)) 1)
                                  (at-sign-p (aref (aref (clauses directive) 0)
                                             (1- (length (aref (clauses directive) 0)))))))
-         (object (unless at-sign-p (consume-next-argument t))))
+         (object (unless at-sign-p (pop-argument))))
     (flet ((interpret-body (*destination* escape-hook pop-argument-hook)
              (if at-sign-p
                  (interpret-items client (aref (clauses directive)
@@ -177,7 +179,7 @@
                                                                                 1)))))
                                           :prefix ,prefix :suffix ,suffix
                                           :per-line-prefix-p ,per-line-prefix-p))
-        `((let* ((object (consume-next-argument t))
+        `((let* ((object (pop-argument))
                  (*remaining-argument-count* (dotted-list-length object))
                  (*previous-arguments* (make-array *remaining-argument-count*
                                                    :adjustable t :fill-pointer 0))
@@ -292,20 +294,17 @@
       (setf (function-name directive) (intern symbol-name package)))))
 
 (defmethod interpret-item (client (directive call-function-directive) &optional parameters)
-  (declare (ignore client))
   (apply (coerce-function-designator client (function-name directive))
          *destination*
-         (consume-next-argument t)
+         (pop-argument)
          (colon-p directive)
          (at-sign-p directive)
          parameters))
 
 (defmethod compile-item (client (directive call-function-directive) &optional parameters)
-  (declare (ignore client))
-  `((let ((parameters (list ,@parameters)))
-      (apply (coerce-function-designator ,(incless:client-form client) ',(function-name directive))
+  `((funcall (coerce-function-designator ,(incless:client-form client) ',(function-name directive))
              *destination*
-             (consume-next-argument t)
+             (pop-argument)
              ,(colon-p directive)
              ,(at-sign-p directive)
-             parameters))))
+             ,@parameters)))
diff --git a/code/printer-operations.lisp b/code/printer-operations.lisp
index cd19b8c..366b78c 100644
--- a/code/printer-operations.lisp
+++ b/code/printer-operations.lisp
@@ -4,14 +4,6 @@
 
 (in-package #:invistra)
 
-(defun print-a-or-s (raw-output at-sign-p mincol colinc minpad padchar)
-  (let ((pad-length (max minpad (* colinc (ceiling (- mincol (length raw-output)) colinc)))))
-    (if at-sign-p
-        (progn (loop repeat pad-length do (write-char padchar *destination*))
-               (write-string raw-output *destination*))
-        (progn (write-string raw-output *destination*)
-               (loop repeat pad-length do (write-char padchar *destination*))))))
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
 ;;; 22.3.4.1 ~a Aesthetic.
@@ -23,36 +15,68 @@
   (change-class directive 'a-directive))
 
 (defmethod parameter-specifications ((client t) (directive a-directive))
-  '((:type integer :default 0)
-    (:type (integer 0) :default 1)
-    (:type integer :default 0)
-    (:type character :default #\Space)))
+  '((:name mincol :type integer :default 0)
+    (:name colinc :type (integer 0) :default 1)
+    (:name minpad :type integer :default 0)
+    (:name padchar :type character :default #\Space)))
 
 (defmethod interpret-item (client (directive a-directive) &optional parameters)
   (let ((*print-escape* nil)
         (*print-readably* nil)
-        (arg (consume-next-argument t)))
-    (apply #'print-a-or-s
+        (arg (pop-argument)))
+    (apply #'write-string-with-padding
            (if (and (colon-p directive) (null arg))
                "()"
                (with-output-to-string (stream)
                  (incless:write-object client arg stream)))
+           *destination*
            (at-sign-p directive) parameters)))
 
 (defmethod compile-item (client (directive a-directive) &optional parameters)
-  `((let* ((*print-escape* nil)
-           (*print-readably* nil)
-           (parameters (list ,@parameters))
-           (arg (consume-next-argument t)))
-      (apply #'print-a-or-s
-             ,(if (colon-p directive)
-                  `(if (null arg)
-                       "()"
-                       (with-output-to-string (stream)
-                         (incless:write-object ,(incless:client-form client) arg stream)))
-                  `(with-output-to-string (stream)
-                     (incless:write-object ,(incless:client-form client) arg stream)))
-             ,(at-sign-p directive) parameters))))
+  (with-accessors ((colon-p colon-p)
+                   (at-sign-p at-sign-p))
+      directive
+    (destructuring-bind (mincol colinc minpad padchar)
+        parameters
+      (cond ((and colon-p
+                  (eql 0 mincol)
+                  (eql 0 minpad))
+             `((let ((*print-escape* nil)
+                     (*print-readably* nil)
+                     (arg (pop-argument)))
+                 (if (null arg)
+                     (write-string "()" *destination*)
+                     (incless:write-object ,(incless:client-form client)
+                                           arg
+                                           *destination*)))))
+            ((and (eql 0 mincol)
+                  (eql 0 minpad))
+             `((let ((*print-escape* nil)
+                     (*print-readably* nil))
+                 (incless:write-object ,(incless:client-form client)
+                                       (pop-argument)
+                                       *destination*))))
+            (colon-p
+             `((let ((*print-escape* nil)
+                     (*print-readably* nil)
+                     (arg (pop-argument)))
+                 (write-string-with-padding
+                  (if (null arg)
+                      "()"
+                      (with-output-to-string (stream)
+                        (incless:write-object ,(incless:client-form client) arg stream)))
+                  *destination*
+                  ,at-sign-p ,mincol ,colinc ,minpad ,padchar))))
+            (t
+             `((let ((*print-escape* nil)
+                     (*print-readably* nil))
+                 (write-string-with-padding
+                  (with-output-to-string (stream)
+                    (incless:write-object ,(incless:client-form client)
+                                          (pop-argument)
+                                          stream))
+                  *destination*
+                  ,at-sign-p ,mincol ,colinc ,minpad ,padchar))))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
@@ -65,34 +89,63 @@
   (change-class directive 's-directive))
 
 (defmethod parameter-specifications ((client t) (directive s-directive))
-  '((:type integer :default 0)
-    (:type (integer 0) :default 1)
-    (:type integer :default 0)
-    (:type character :default #\Space)))
+  '((:name mincol :type integer :default 0)
+    (:name colinc :type (integer 0) :default 1)
+    (:name minpad :type integer :default 0)
+    (:name padchar :type character :default #\Space)))
 
 (defmethod interpret-item (client (directive s-directive) &optional parameters)
   (let ((*print-escape* t)
-        (arg (consume-next-argument t)))
-    (apply #'print-a-or-s
+        (arg (pop-argument)))
+    (apply #'write-string-with-padding
            (if (and (colon-p directive) (null arg))
                "()"
                (with-output-to-string (stream)
                  (incless:write-object client arg stream)))
+           *destination*
            (at-sign-p directive) parameters)))
 
 (defmethod compile-item (client (directive s-directive) &optional parameters)
-  `((let* ((*print-escape* t)
-           (parameters (list ,@parameters))
-           (arg (consume-next-argument t)))
-      (apply #'print-a-or-s
-             ,(if (colon-p directive)
-                  `(if (null arg)
-                       "()"
-                       (with-output-to-string (stream)
-                         (incless:write-object ,(incless:client-form client) arg stream)))
-                  `(with-output-to-string (stream)
-                     (incless:write-object ,(incless:client-form client) arg stream)))
-             ,(at-sign-p directive) parameters))))
+  (with-accessors ((colon-p colon-p)
+                   (at-sign-p at-sign-p))
+      directive
+    (destructuring-bind (mincol colinc minpad padchar)
+        parameters
+      (cond ((and colon-p
+                  (eql 0 mincol)
+                  (eql 0 minpad))
+             `((let ((*print-escape* t)
+                     (arg (pop-argument)))
+                 (if (null arg)
+                     (write-string "()" *destination*)
+                     (incless:write-object ,(incless:client-form client)
+                                           arg
+                                           *destination*)))))
+            ((and (eql 0 mincol)
+                  (eql 0 minpad))
+             `((let ((*print-escape* t))
+                 (incless:write-object ,(incless:client-form client)
+                                       (pop-argument)
+                                       *destination*))))
+            (colon-p
+             `((let ((*print-escape* t)
+                     (arg (pop-argument)))
+                 (write-string-with-padding
+                  (if (null arg)
+                      "()"
+                      (with-output-to-string (stream)
+                        (incless:write-object ,(incless:client-form client) arg stream)))
+                  *destination*
+                  ,at-sign-p ,mincol ,colinc ,minpad ,padchar))))
+            (t
+             `((let ((*print-escape* t))
+                 (write-string-with-padding
+                  (with-output-to-string (stream)
+                    (incless:write-object ,(incless:client-form client)
+                                          (pop-argument)
+                                          stream))
+                  *destination*
+                  ,at-sign-p ,mincol ,colinc ,minpad ,padchar))))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
@@ -109,39 +162,41 @@
 
 (defmethod interpret-item (client (directive w-directive) &optional parameters)
   (declare (ignore parameters))
-  (let ((arg (consume-next-argument t))
-        (colon-p (colon-p directive))
-        (at-sign-p (at-sign-p directive)))
-    (cond ((and colon-p at-sign-p)
-           (let ((*print-pretty* t)
-                 (*print-level* nil)
-                 (*print-length* nil))
-             (incless:write-object client arg *destination*)))
-          (colon-p
-           (let ((*print-pretty* t))
-             (incless:write-object client arg *destination*)))
-          (at-sign-p
-           (let ((*print-level* nil)
-                 (*print-length* nil))
-             (incless:write-object client arg *destination*)))
-          (t
-           (incless:write-object client arg *destination*)))))
+  (with-accessors ((colon-p colon-p)
+                   (at-sign-p at-sign-p))
+      directive
+    (let ((arg (pop-argument)))
+      (cond ((and colon-p at-sign-p)
+             (let ((*print-pretty* t)
+                   (*print-level* nil)
+                   (*print-length* nil))
+               (incless:write-object client arg *destination*)))
+            (colon-p
+             (let ((*print-pretty* t))
+               (incless:write-object client arg *destination*)))
+            (at-sign-p
+             (let ((*print-level* nil)
+                   (*print-length* nil))
+               (incless:write-object client arg *destination*)))
+            (t
+             (incless:write-object client arg *destination*))))))
 
 (defmethod compile-item (client (directive w-directive) &optional parameters)
   (declare (ignore parameters))
-  (let ((colon-p (colon-p directive))
-        (at-sign-p (at-sign-p directive)))
-    (cond ((and colon-p at-sign-p )
+  (with-accessors ((colon-p colon-p)
+                   (at-sign-p at-sign-p))
+      directive
+    (cond ((and colon-p at-sign-p)
            `((let ((*print-pretty* t)
                    (*print-level* nil)
                    (*print-length* nil))
-               (incless:write-object ,(incless:client-form client) (consume-next-argument t) *destination*))))
+               (incless:write-object ,(incless:client-form client) (pop-argument) *destination*))))
           (colon-p
            `((let ((*print-pretty* t))
-               (incless:write-object ,(incless:client-form client) (consume-next-argument t) *destination*))))
+               (incless:write-object ,(incless:client-form client) (pop-argument) *destination*))))
           (at-sign-p
            `((let ((*print-level* nil)
                    (*print-length* nil))
-               (incless:write-object ,(incless:client-form client) (consume-next-argument t) *destination*))))
+               (incless:write-object ,(incless:client-form client) (pop-argument) *destination*))))
           (t
-           `((incless:write-object ,(incless:client-form client) (consume-next-argument t) *destination*))))))
+           `((incless:write-object ,(incless:client-form client) (pop-argument) *destination*))))))
diff --git a/code/radix-control.lisp b/code/radix-control.lisp
index 9c95b96..5d70f5f 100644
--- a/code/radix-control.lisp
+++ b/code/radix-control.lisp
@@ -9,13 +9,21 @@
 
 (defmethod parameter-specifications (client (directive base-radix-directive))
   (declare (ignore client))
-  '((:type integer :default 0)
-    (:type character :default #\Space)
-    (:type character :default #\,)
-    (:type integer :default 3)))
+  '((:name mincol
+     :type integer
+     :default 0)
+    (:name padchar
+     :type character
+     :default #\Space)
+    (:name commachar
+     :type character
+     :default #\,)
+    (:name comma-interval
+     :type integer
+     :default 3)))
 
 (defun print-radix-arg (client colon-p at-sign-p radix mincol padchar commachar comma-interval)
-  (let ((argument (consume-next-argument t)))
+  (let ((argument (pop-argument)))
     (if (not (integerp argument))
         (let ((*print-base* radix)
               (*print-escape* nil)
@@ -62,7 +70,9 @@
   (change-class directive 'radix-directive))
 
 (defmethod parameter-specifications ((client t) (directive radix-directive))
-  (list* '(:type (or null (integer 2 36)) :default nil)
+  (list* '(:name radix
+           :type (or null (integer 2 36))
+           :default nil)
          (call-next-method)))
 
 (defparameter *roman-digits*
@@ -89,7 +99,7 @@
                     (loop repeat r1
                           do (write-string (car digits) *destination*))))))))
     (let ((digit-count (list-length *roman-digits*)))
-      (write-digit (consume-next-argument
+      (write-digit (pop-argument
                     (if digit-count
                         (multiple-value-bind (q r)
                             (floor digit-count 2)
@@ -113,7 +123,7 @@
                  (loop repeat r1
                        do (write-string (car digits) *destination*))))))
     (let ((digit-count (list-length *roman-digits*)))
-      (write-digit (consume-next-argument
+      (write-digit (pop-argument
                     (if digit-count
                         (multiple-value-bind (q r)
                             (floor digit-count 2)
@@ -143,7 +153,7 @@
                         (loop repeat r1
                               do (write-string (car digits) *destination*))))))))
     (let ((digit-count (list-length *roman-digits*)))
-      (write-digit (consume-next-argument
+      (write-digit (pop-argument
                     (if digit-count
                         (multiple-value-bind (q r)
                             (floor digit-count 2)
@@ -217,7 +227,7 @@
 
 ;;; Print a cardinal number n such that - 10^65 < n < 10^65.
 (defun print-cardinal-arg ()
-  (let ((n (consume-next-argument `(integer ,(1+ (- (expt 10 65))) ,(1- (expt 10 65))))))
+  (let ((n (pop-argument `(integer ,(1+ (- (expt 10 65))) ,(1- (expt 10 65))))))
     (cond ((minusp n)
            (write-string "negative " *destination*)
            (print-cardinal-non-zero (- n) 0))
@@ -283,7 +293,7 @@
 
 ;;; Print an ordinal number n such that - 10^65 < n < 10^65.
 (defun print-ordinal-arg ()
-  (let ((n (consume-next-argument `(integer ,(1+ (- (expt 10 65))) ,(1- (expt 10 65))))))
+  (let ((n (pop-argument `(integer ,(1+ (- (expt 10 65))) ,(1- (expt 10 65))))))
     (cond ((minusp n)
            (write-string "negative " *destination*)
            (print-ordinal-non-zero (- n)))
@@ -293,40 +303,42 @@
            (print-ordinal-non-zero n)))))
 
 (defmethod interpret-item (client (directive radix-directive) &optional parameters)
-  (let ((radix (car parameters))
-        (colon-p (colon-p directive))
-        (at-sign-p (at-sign-p directive)))
-    (cond (radix
-           (apply #'print-radix-arg client colon-p at-sign-p parameters))
-          ((and at-sign-p colon-p)
-           (print-old-roman-arg))
-          (at-sign-p
-           (print-roman-arg))
-          (colon-p
-           (print-ordinal-arg))
-          (t
-           (print-cardinal-arg)))))
+  (with-accessors ((colon-p colon-p)
+                   (at-sign-p at-sign-p))
+      directive
+    (let ((radix (car parameters)))
+      (cond (radix
+             (apply #'print-radix-arg client colon-p at-sign-p parameters))
+            ((and at-sign-p colon-p)
+             (print-old-roman-arg))
+            (at-sign-p
+             (print-roman-arg))
+            (colon-p
+             (print-ordinal-arg))
+            (t
+             (print-cardinal-arg))))))
 
 (defmethod compile-item (client (directive radix-directive) &optional parameters)
-  (let ((colon-p (colon-p directive))
-        (at-sign-p (at-sign-p directive)))
-    (cond ((numberp (car parameters))
-           `((print-radix-arg ,(incless:client-form client)
-                              ,colon-p ,at-sign-p ,@parameters)))
-          ((null (car parameters))
-           (cond ((and at-sign-p colon-p)
-                  `((print-old-roman-arg)))
-                 (at-sign-p
-                  `((print-roman-arg)))
-                 (colon-p
-                  `((print-ordinal-arg)))
-                 (t
-                  `((print-cardinal-arg)))))
-          (t
-           `((let ((parameters (list ,@parameters)))
-               (if (car parameters)
-                   (apply #'print-radix-arg ,(incless:client-form client)
-                          ,colon-p ,at-sign-p parameters)
+  (with-accessors ((colon-p colon-p)
+                   (at-sign-p at-sign-p))
+      directive
+    (let ((radix (car parameters)))
+      (cond ((numberp radix)
+             `((print-radix-arg ,(incless:client-form client)
+                                ,colon-p ,at-sign-p ,@parameters)))
+            ((null radix)
+             (cond ((and at-sign-p colon-p)
+                    `((print-old-roman-arg)))
+                   (at-sign-p
+                    `((print-roman-arg)))
+                   (colon-p
+                    `((print-ordinal-arg)))
+                   (t
+                    `((print-cardinal-arg)))))
+            (t
+             `((if ,radix
+                   (print-radix-arg ,(incless:client-form client)
+                                    ,colon-p ,at-sign-p ,@parameters)
                    ,(cond ((and at-sign-p colon-p)
                            `(print-old-roman-arg))
                           (at-sign-p
diff --git a/code/utilities.lisp b/code/utilities.lisp
index 37f5bdb..f6dd7cc 100644
--- a/code/utilities.lisp
+++ b/code/utilities.lisp
@@ -97,3 +97,13 @@
              (write-char (char-downcase char) (target stream)))
             (t
              (write-char char (target stream)))))))
+
+(defun write-string-with-padding (string stream pad-left-p mincol colinc minpad padchar)
+  (let ((pad-length (max minpad (* colinc (ceiling (- mincol (length string)) colinc)))))
+    (if pad-left-p
+        (loop repeat pad-length
+              finally (write-string string stream)
+              do (write-char padchar stream))
+        (loop repeat pad-length
+                initially (write-string string stream)
+              do (write-char padchar stream)))))