title: riastradh-format wiliki-lwp-version: 1.0 mtime: 1170175454
This is Riastradh's alternate proposal for formatting, as concocted when Brian Mastenbrook approached him with a horrible use of Common Lisp's FORMAT.
(MYTHICAL-FORMAT output-spec formatter-expression ...) is defined to format output to output-spec -- an output port, #F, or #T -- with the given formatter expressions. The meaning of each type of formatter expression is described in brief here, in a rather informal list:
Emits char or string literally.
An eager comprehension, sort of, for emitting output, in the style of SRFI 42; qualifier is a regular SRFI 42 qualifier, and formatter-expression is used in the place of a regular Scheme expression for the value expression in the comprehension.
A new generator not defined in SRFI 42 that produces pairs from the list, rather than just the elements; it is also extended by allowing for pattern matching rather than just a plain variable.
Formats each formatter-expression in sequence.
Evaluates BODY as a formatter body, but pad it on the left to WIDTH with CHAR, which are both evaluated normally.
Evaluates number & radix normally and emits the value that evaluating (NUMBER->STRING number radix) produces.
Evaluates condition normally. If it evaluates to a true value, formats the formatter expression consequent; if condition evaluates to #F & alternative is present, formats alternative as a formatter expression, and if alternative is not present, this does nothing.
Evaluates object normally and emits the result as with DISPLAY.
Observe the transition from the unbelievably ugly & unreadable Common Lisp FORMAT to verbose Scheme to less verbose Scheme to a wicked cool-looking hypothetical formatter macro.
;;; Original Common Lisp code, using CL's FORMAT. (defun format-edit-matrix (output matrix) (format output " ~{~3<C~A~>~^ ~}~%~{~{~3<R~A~> ~:*~[~;[~:; ~][~{~3<~:[~;~:*~A~]~>~^ ~}]~}~^~%~}]" (loop for i from 1 to (length (car matrix)) collect i) (loop for i from 1 for row in matrix collect (list i (loop for j from 1 for column in row collect (if (>= j i) column nil)))))) ;;; Translation of the above CL code into Scheme, for readability. (define (display-to-string object) (let ((port (open-output-string))) (display object port) (get-output-string port))) (define (nchars n char) (if (eqv? n 0) '() (cons char (nchars (- n 1) char)))) (define (justify string-object mincol charpad) (let ((len (string-length string-object))) (if (< len mincol) (string-append (apply string (nchars (- mincol len) charpad)) string-object) string-object))) (define (convoluted-formatter output row-headers matrix) (display " " output) (let loop ((head-list row-headers)) (display (justify (string-append "C" (display-to-string (car head-list))) 3 #\space) output) (if (null? (cdr head-list)) (newline output) (begin (display " " output) (loop (cdr head-list))))) (pair-for-each (lambda (l) (let ((row-with-label (car l))) (display (justify (string-append "R" (display-to-string (car row-with-label))) 3 #\space) output) (if (eqv? (car row-with-label) 1) (display " [[" output) (display " [" output)) (for-each (lambda (elt) (display (justify (if elt (display-to-string elt) "") 3 #\space) output) (display " " output)) (second row-with-label)) (display "]" output)) (if (not (null? (cdr l))) (newline output))) matrix) (display "]" output)) (define (format-edit-matrix output matrix) (convoluted-formatter output (let loop ((index 1) (list-head (car matrix))) (if (null? list-head) '() (cons index (loop (+ index 1) (cdr list-head))))) (let loop ((index 1) (list-head matrix)) (if (null? list-head) '() (cons (list index (let loop ((jndex 1) (list-head (car list-head))) (if (null? list-head) '() (cons (and (>= jndex index) (car list-head)) (loop (+ jndex 1) (cdr list-head)))))) (loop (+ index 1) (cdr list-head))))))) ;;; Similar code, but using SRFI 42's DO-EC instead of manual loops. (define (format-edit-matrix out matrix) (display " " out) (do-ec (:list-pairs (_ . tail) (index i) (car matrix)) (begin (call-with-left-padding-port 3 #\space out (lambda (out) (write-char #\C out) (display (number->string i 10 out)))) (if (null? tail) (newline out) (write-char #\space out)))) (do-ec (:list-pairs ((label row) . tail) (index i) (cdr matrix)) (begin (call-with-left-padding-port 3 #\space out (lambda (out) (write-char #\R out) (display label out))) (write-char #\space out) (write-char (if (zero? i) #\[ #\space) out) (write-char #\[ out) (do-ec (:list elt row) (begin (call-with-left-padding-port 3 #\space out (lambda (out) (display (or elt "") out))) (write-char #\space out))) (if (null? tail) (write-char #\] out)) (newline out)))) ;;; Mythical formatter (define (format-edit-matrix out matrix) (mythical-format out " " (output-ec (:list-pairs (_ . tail) (index i) (car matrix)) (sequence (pad-left 3 #\space #\C (number i 10)) (if (null? tail) #\newline " "))) (output-ec (:list-pairs ((label row) . tail) (index i) (car matrix)) (sequence (pad-left 3 #\space #\R (display label)) #\space (if (zero? i) #\[ #\space) (output-ec (:list elt row) (sequence (pad-left 3 #\space (display (or elt ""))) #\space)) (if (null? tail) #\]) (newline)))))