Riastradh-FORMAT


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.

Description

(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:

char or string

Emits char or string literally.

(OUTPUT-EC qualifier ... formatter-expression)

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.

(:LIST-PAIRS pattern [(INDEX variable)] list ...)

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.

(SEQUENCE formatter-expression ...)

Formats each formatter-expression in sequence.

(PAD-LEFT width char . body)

Evaluates BODY as a formatter body, but pad it on the left to WIDTH with CHAR, which are both evaluated normally.

(NUMBER number radix)

Evaluates number & radix normally and emits the value that evaluating (NUMBER->STRING number radix) produces.

(IF condition consequent [ alternative ])

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.

(DISPLAY object)

Evaluates object normally and emits the result as with DISPLAY.

Example

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)))))