;------------------------------------------------------------------
; FILE         "collect.oo"
; IMPLEMENTS    Sample collection operations over lists, vectors,
;               strings, simple tables.
; AUTHOR        Ken Dickey
; DATE          1992 September 1
; LAST UPDATED  1992 September 2
; NOTES         Expository (optimizations & checks elided).

;               Requires YASOS (Yet Another Scheme Object System).
;               See "Scheming with Objects", AI Expert, October 1992.

;;(require 'yasos)


;; COLLECTION INTERFACE

;; (collection? obj)  -- predicate
;;
;; (do-elts proc coll+) -- apply proc element-wise to collections
;; (do-keys proc coll+) -- .. return value is unspecified
;;
;; (map-elts proc coll+) -- as with do-*, but returns collection
;; (map-keys proc coll+) -- e.g. (map-keys + (list 1 2 3) (vector 1 2 3))
;;                                      -> #( 2 4 6 )
;;
;; (for-each-key coll proc) -- for single collection (more efficient)
;; (for-each-elt coll proc)
;;
;; (reduce proc seed coll+) -- e.g. (reduce + 0 (vector 1 2 3))
;; (any?   predicate coll+) -- e.g. (any? odd? (list 2 3 4 5))
;; (every? predicate coll+) -- e.g. (every? collection collections)
;;
;; (empty? collection)  -- I bet you can guess what these do as well...
;; (size collection)
;;
;;==============================
;; Collections must implement:
;;  collection?
;;  gen-elts
;;  gen-keys
;;  size
;;  print
;;
;; Collections should implement {typically faster}:
;;  for-each-key
;;  for-each-elt
;;==============================

(define-operation (COLLECTION? obj)
 ;; default
  (cond
    ((or (list? obj) (vector? obj) (string obj)) #t)
    (else #f)
) )

(define (EMPTY? collection) (zero? (size collection)))

(define-operation (GEN-ELTS <collection>) ;; return element generator
  ;; default behavior
  (cond                      ;; see utilities, below, for generators
    ((vector? <collection>) (vector-gen-elts <collection>)) 
    ((list?   <collection>) (list-gen-elts   <collection>))
    ((string? <collection>) (string-gen-elts <collection>))
    (else 
      (error "Operation not supported: gen-elts " (print obj #f)))
) )

(define-operation (GEN-KEYS collection)
  (if (or (vector? collection) (list? collection) (string? collection))
      (let ( (max+1 (size collection)) (index 0) )
         (lambda ()
            (cond
              ((< index max+1)
               (set! index (add1 index))
               (sub1 index))
              (else (error "no more keys in generator"))
      ) ) )
      (error "Operation not handled: GEN-KEYS " collection)
) )

(define (DO-ELTS <proc> . <collections>)
  (let ( (max+1 (size (car <collections>)))
         (generators (map gen-elts <collections>))
       )
    (let loop ( (counter 0) )
       (cond
          ((< counter max+1)
           (apply <proc> (map (lambda (g) (g)) generators))
           (loop (add1 counter))
          )
          (else 'unspecific)  ; done
    )  )
) )

(define (DO-KEYS <proc> . <collections>)
  (let ( (max+1 (size (car <collections>)))
         (generators (map gen-keys <collections>))
       )
    (let loop ( (counter 0) )
       (cond
          ((< counter max+1)
           (apply <proc> (map (lambda (g) (g)) generators))
           (loop (add1 counter))
          )
          (else 'unspecific)  ; done
    )  )
) )

(define (MAP-ELTS <proc> . <collections>)
  (let ( (max+1 (size (car <collections>)))
         (generators (map gen-elts <collections>))
         (vec (make-vector (size (car <collections>))))
       )
    (let loop ( (index 0) )
       (cond
          ((< index max+1)
           (vector-set! vec index (apply <proc> (map (lambda (g) (g))
generators)))
           (loop (add1 index))
          )
          (else vec)  ; done
    )  )
) )

(define (MAP-KEYS <proc> . <collections>)
  (let ( (max+1 (size (car <collections>)))
         (generators (map gen-keys <collections>))
         (vec (make-vector (size (car <collections>))))
       )
    (let loop ( (index 0) )
       (cond
          ((< index max+1)
           (vector-set! vec index (apply <proc> (map (lambda (g) (g))   
                                                                generators)))
           (loop (add1 index))
          )
          (else vec)  ; done
    )  )
) )

(define-operation (FOR-EACH-KEY <collection> <proc>)
   ;; default
   (do-keys <proc> <collection>)  ;; talk about lazy!
)

(define-operation (FOR-EACH-ELT <collection> <proc>)
   (do-elts <proc> <collection>)
)

(define (REDUCE <proc> <seed> . <collections>)
   (let ( (max+1 (size (car <collections>)))
          (generators (map gen-elts <collections>))
        )
     (let loop ( (count 0) )
       (cond
          ((< count max+1)
           (set! <seed> 
                 (apply <proc> <seed> (map (lambda (g) (g)) generators)))
           (loop (add1 count))
          )
          (else <seed>)
     ) )
)  )

;; pred true for every elt?
(define (EVERY? <pred?> . <collections>)
   (let ( (max+1 (size (car <collections>)))
          (generators (map gen-elts <collections>))
        )
     (let loop ( (count 0) )
       (cond
          ((< count max+1)
           (if (apply <pred?> (map (lambda (g) (g)) generators))
               (loop (add1 count))
               #f)
          )
          (else #t)
     ) )
)  )

;; pred true for any elt?
(define (ANY? <pred?> . <collections>)
   (let ( (max+1 (size (car <collections>)))
          (generators (map gen-elts <collections>))
        )
     (let loop ( (count 0) )
       (cond
          ((< count max+1)
           (if (apply <pred?> (map (lambda (g) (g)) generators))
               #t
               (loop (add1 count))
          ))
          (else #f)
     ) )
)  )


;; SAMPLE COLLECTION -- simple-table .. also a TABLE

(define-predicate TABLE?)
(define-operation (LOOKUP table key failure-object))
(define-operation (ASSOCIATE! table key value)) ;; returns key
(define-operation (REMOVE! table key))          ;; returns value

(define (MAKE-SIMPLE-TABLE)
  (let ( (table (list)) )
    (object
      ;; table behaviors
      ((TABLE? self) #t)
      ((SIZE self) (size table))
      ((PRINT self port) (format port "#<SIMPLE-TABLE>"))
      ((LOOKUP self key failure-object)
       (cond 
         ((assq key table) => cdr)
         (else failure-object)
      ))
      ((ASSOCIATE! self key value)
       (cond
         ((assq key table) => (lambda (bucket) (set-cdr! bucket value) key))
         (else 
           (set! table (cons (cons key value) table))
           key)
      ))
      ((REMOVE! self key) ;; returns old value
       (cond
         ((null? table) (error "TABLE:REMOVE! Key not found: " key))
         ((eq? key (caar table))
          (let ( (value (cdar table)) )
             (set! table (cdr table))
             value)
         )
         (else
           (let loop ( (last table) (this (cdr table)) )
             (cond
               ((null? this) (error "TABLE:REMOVE! Key not found: " key))
               ((eq? key (caar this))
                (let ( (value (cdar this)) )
                  (set-cdr! last (cdr this))
                 value)
               )
               (else
                (loop (cdr last) (cdr this)))
         ) ) )
      ))
      ;; collection behaviors
      ((COLLECTION? self) #t)
      ((GEN-KEYS self) (list-gen-elts (map car table)))
      ((GEN-ELTS self) (list-gen-elts (map cdr table)))
      ((FOR-EACH-KEY self proc)
       (for-each (lambda (bucket) (proc (car bucket))) table)
      )
      ((FOR-EACH-ELT self proc)
       (for-each (lambda (bucket) (proc (cdr bucket))) table)
      )
) ) )

;; MISC UTILITIES

;; (define (ZERO? obj) (= obj 0))  ;; standard
(define (ADD1 obj)  (+ obj 1))
(define (SUB1 obj)  (- obj 1))


;; Let lists be regular

;;(define (LIST-REF <list> <index>)  ;; standard
;;  (if (zero? <index>)
;;      (car <list>)
;;      (list-ref (cdr <list>) (sub1 <index>))
;;) )


(define (LIST-SET! <list> <index> <value>)

  (define (set-loop last this idx)
     (cond
        ((zero? idx) 
         (set-cdr! last (cons <value> (cdr this)))
         <list>
        )
        (else (set-loop (cdr last) (cdr this) (sub1 idx)))
  )  )

  ;; main
  (if (zero? <index>)
      (begin (set-car! <list> <value>) <list>)
      (set-loop <list> (cdr <list>) (sub1 <index>)))
)

(ADD-SETTER list-ref list-set!)  ; for (setter list-ref)


;; generator for list elements
(define (LIST-GEN-ELTS <list>)
  (lambda ()
     (if (null? <list>)
         (error "No more list elements in generator")
         (let ( (elt (car <list>)) )
           (set! <list> (cdr <list>))
           elt))
) )

(define (MAKE-VEC-GEN-ELTS <accessor>)
  (lambda (vec)
    (let ( (max+1 (size vec))
           (index 0)
         )
      (lambda () 
         (cond ((< index max+1)
                (set! index (add1 index))
                (<accessor> vec (sub1 index))
               )
               (else #f)
      )  )
  ) )
)

(define VECTOR-GEN-ELTS (make-vec-gen-elts vector-ref))

(define STRING-GEN-ELTS (make-vec-gen-elts string-ref))

;;                    --- E O F "collect.oo" ---                    ;;
 ;;====================================================================
;; FILE         "YASOS.scm"
;; IMPLEMENTS   YASOS: Yet Another Scheme Object System
;; AUTHOR       Kenneth Dickey
;; DATE         1992 March 1
;; LAST UPDATED 1992 September 1 -- misc optimizations
;;              1992 May 22  -- added SET and SETTER

;; REQUIRES     R^4RS Syntax System

;; NOTES: A simple object system for Scheme based on the paper by
;; Norman Adams and Jonathan Rees: "Object Oriented Programming in
;; Scheme", Proceedings of the 1988 ACM Conference on LISP and Functional
;; Programming, July 1988 [ACM #552880].
;
;; Setters use space for speed {extra conses for O(1) lookup}.


;;
;; INTERFACE:
;;
;; (DEFINE-OPERATION (opname self arg ...) default-body)
;;
;; (DEFINE-PREDICATE opname)
;;
;; (OBJECT ((name self arg ...) body) ... )
;;
;; (OBJECT-WITH-ANCESTORS ( (ancestor1 init1) ...) operation ...)
;;
;; in an operation {a.k.a. send-to-super}
;;   (OPERATE-AS component operation self arg ...)
;;

;; (SET var new-vale) or (SET (access-proc index ...) new-value)
;;
;; (SETTER access-proc) -> setter-proc
;; (DEFINE-ACCESS-OPERATION getter-name) -> operation
;; (ADD-SETTER getter setter) ;; setter is a Scheme proc
;; (REMOVE-SETTER-FOR getter)
;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;; IMPLEMENTATION ;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; INSTANCES

; (define-predicate instance?)
; (define (make-instance dispatcher)
;    (object
;       ((instance?  self) #t)
;       ((instance-dispatcher self) dispatcher)
; )  )

(define make-instance 'bogus)  ;; defined below
(define instance?     'bogus)
(define-syntax INSTANCE-DISPATCHER  ;; alias so compiler can inline for speed
   (syntax-rules () ((instance-dispatcher inst) (cdr inst)))
)

(let ( (instance-tag "instance") ) ;; Make a unique tag within a local scope.
                                   ;; No other data object is EQ? to this tag.
  (set! MAKE-INSTANCE
     (lambda (dispatcher) (cons instance-tag dispatcher)))

  (set! INSTANCE?
     (lambda (obj) (and (pair? obj) (eq? (car obj) instance-tag))))
)

;; DEFINE-OPERATION


(define-syntax DEFINE-OPERATION
  (syntax-rules ()
    ((define-operation (<name> <inst> <arg> ...) <exp1> <exp2> ...)
     ;;=>
     (define <name>
       (letrec ( (former-inst #f) ;; simple caching -- for loops
                 (former-method #f)
                 (self
                  (lambda (<inst> <arg> ...)
                     (cond
                       ((eq? <inst> former-inst) ; check cache
                        (former-method <inst> <arg> ...)
                       )
                       ((and (instance? <inst>) 
                             ((instance-dispatcher <inst>) self))
                          => (lambda (method) 
                                (set! former-inst <inst>)
                                (set! former-method method)
                                (method <inst> <arg> ...))
                       )
                       (else <exp1> <exp2> ...)
               ) ) )  )
        self)
  ))
  ((define-operation (<name> <inst> <arg> ...) ) ;; no body
   ;;=>
   (define-operation (<name> <inst> <arg> ...)
      (error "Operation not handled" 
             '<name> 
             (format #f (if (instance? <inst>) "#<INSTANCE>" "~s") <inst>)))
  ))
)



;; DEFINE-PREDICATE

(define-syntax DEFINE-PREDICATE
  (syntax-rules ()
    ((define-predicate <name>)
     ;;=>
     (define-operation (<name> obj) #f)
    )
) )


;; OBJECT

(define-syntax OBJECT
  (syntax-rules ()
    ((object ((<name> <self> <arg> ...) <exp1> <exp2> ...) ...)
    ;;=>
     (let ( (table
              (list (cons <name>
                          (lambda (<self> <arg> ...) <exp1> <exp2> ...))
                      ...
            ) ) 
          )
      (make-instance
        (lambda (op)
          (cond
            ((assq op table) => cdr)
            (else #f)
) ) )))) )


;; OBJECT with MULTIPLE INHERITANCE  {First Found Rule}

(define-syntax OBJECT-WITH-ANCESTORS
  (syntax-rules ()
    ((object-with-ancestors ( (<ancestor1> <init1>) ... ) <operation> ...)
    ;;=>
     (let ( (<ancestor1> <init1>) ...  )
      (let ( (child (object <operation> ...)) )
       (make-instance
         (lambda (op) 
            (or ((instance-dispatcher child) op)
                ((instance-dispatcher <ancestor1>) op) ...
       ) )  )
    )))
) )


;; OPERATE-AS  {a.k.a. send-to-super}

; used in operations/methods

(define-syntax OPERATE-AS
  (syntax-rules ()
   ((operate-as <component> <op> <composit> <arg> ...)
   ;;=>
    (((instance-dispatcher <component>) <op>) <composit> <arg> ...)
  ))
)



;; SET & SETTER


(define-syntax SET
  (syntax-rules ()
    ((set (<access> <index> ...) <newval>)
     ((setter <access>) <index> ... <newval>)
    )
    ((set <var> <newval>)
     (set! <var> <newval>)
    )
) )


(define add-setter        'bogus)
(define remove-setter-for 'bogus)

(define SETTER 
  (let ( (known-setters (list (cons car set-car!)
                              (cons cdr set-cdr!)
                              (cons vector-ref vector-set!)
                              (cons string-ref string-set!))
         )
         (added-setters '())
       )

    (set! ADD-SETTER 
      (lambda (getter setter) 
        (set! added-setters (cons (cons getter setter) added-setters)))
    )
    (set! REMOVE-SETTER-FOR
      (lambda (getter)
        (cond
          ((null? added-setters) 
           (error "REMOVE-SETTER: Unknown getter" getter)
          )
          ((eq? getter (caar added-setters))
           (set! added-setters (cdr added-setters))
          )
          (else 
            (let loop ((x added-setters) (y (cdr added-setters)))
              (cond
                ((null? y) (error "REMOVE-SETTER: Unknown getter" getter))
                ((eq? getter (caar y)) (set-cdr! x (cdr y)))
                (else (loop (cdr x) (cdr y)))
          ) ) )
     ) ) )
    
    (letrec ( (self
                 (lambda (proc-or-operation)
                   (cond ((assq proc-or-operation known-setters) => cdr)
                         ((assq proc-or-operation added-setters) => cdr)
                         (else (proc-or-operation self))) )
            ) )
      self)
) )



(define (%%MAKE-ACCESS-OPERATION <name>)
  (letrec ( (setter-dispatch
               (lambda (inst . args)
                   (cond
                     ((and (instance? inst)
                           ((instance-dispatcher inst) setter-dispatch))
                       => (lambda (method) (apply method inst args))
                     )
                     (else #f)))
            )
            (self
               (lambda (inst . args)
                  (cond
                     ((eq? inst setter) setter-dispatch) ; for (setter self)
                     ((and (instance? inst) 
                           ((instance-dispatcher inst) self))
                      => (lambda (method) (apply method inst args))
                     )
                     (else (error "Operation not handled" <name> inst))
                )  )
            )
          )

          self
) )

(define-syntax DEFINE-ACCESS-OPERATION
  (syntax-rules ()
    ((define-access-operation <name>)
     ;=>
     (define <name> (%%make-access-operation '<name>))
) ) )



;;---------------------
;; general operations
;;---------------------

(define-operation (PRINT obj port) 
  (format port
          ;; if an instance does not have a PRINT operation..
          (if (instance? obj) "#<INSTANCE>" "~s") 
          obj
) )

(define-operation (SIZE obj)
  ;; default behavior
  (cond   
    ((vector? obj) (vector-length obj))
    ((list?   obj) (length obj))
    ((pair?   obj) 2)
    ((string? obj) (string-length obj))
    ((char?   obj) 1)
    (else 
      (error "Operation not supported: size" obj))
) )


;;                  --- E O F "yasos.scm" ---                     ;;
 ;;==================================================================
; FILE:         "format.scm"
; IMPLEMENTS:   Format function {Scheme} -- see documentation below.
; AUTHOR:       Ken Dickey
; DATE:         1988
; LAST UPDATED: 1992 January 8 -- now implements ~& option
;               1991 November 25 -- now uses string ports
; NOTES:        Imports PRETTY-PRINT (~g) and OBJECT->STRING
;


;;  
;;  
;;  ========
;;  FUNCTION: (FORMAT <port> <format-string> . <args>)
;;  ========
;;  
;;  RESULT: returns unconsumed <args> or a string; has side effect of
;;  printing according to <format-string>.  If <port> is #t the output is
;;  to the current input port.  If <port> is #f, a formatted string is
;;  returned as the result of the call.  Otherwise <port> must be an
;;  output port.  <format-string> must be a string.  Characters are output
;;  as if the string were output by the DISPLAY function with the
;;  exception of those prefixed by a tilde (~) as follows [note that options
;;  which take arguments remove them from the argument list (they are said to
;;  be `consumed')]:
;;
;;option  mnemonic: description
;;------  ------------------------
;;    ~a  any: display the argument (as for humans).
;;    ~s  slashified: write the argument (as for parsers).
;;    ~d  decimal: the integer argument is output in decimal format.
;;    ~x  hexadecimal: the integer argument is output in hexadecimal format.
;;    ~o  octal: the integer argument is output in octal format.
;;    ~b  binary: the integer argument is output in binary format.
;;    ~p  plural: if the argument is > than 1, a lower case 's' is printed.
;;    ~c  character: the next argument is displayed as a character.
;;    ~_  space: output a space character.
;;    ~%  newline: output a newline character.
;;    ~&  freshline: unless at the beginning of a line, same as ~%, else
ignored.
;;    ~~  tilde: output a tilde.
;;    ~t  tab: output a tab charcter. **implemented, but system dependent**
;;    ~g  glorify: pretty print the argument (typically an s-expression).
;;    ~|  page seperator: output a page seperator.
;;    ~?  indirection: take the next argument as a format string and consume
;;        further arguments as appropriate, then continue to process the current
;;        format string.
;;
;;  

;----- IMPLEMENTATION SPECIFIC OPTIMIZATIONS

(##declare (standard-bindings) (fixnum)) ;; GAMBIT (v1.71)



;---------- FORMAT


(define FORMAT

 (let ( (LAST-WAS-NEWLINE #f)  ; state shared between invocations
        (ASCII-TAB   (integer->char 9))
        (ASCII-FF    (integer->char 12))
        (DONT-PRINT  (string->symbol ""))
      )

  (lambda (<output-port> <format-string> . <args>)

  (letrec (
           (PORT (cond ((output-port? <output-port>) <output-port>)
                       ((eq? <output-port> #t) (current-output-port))
                       ((eq? <output-port> #f) (open-output-string))
                       (else (error "format: bad port -> " <output-port>)))
           )
           (RETURN-VALUE  (if (eq? <output-port> #f)  ;; format to a string
                              (lambda () (get-output-string port))
                              (lambda () dont-print))
           )
          )

    (define (FORMAT-HELP format-strg arglyst)

      (letrec
          (
           (LENGTH-OF-FORMAT-STRING (string-length format-strg))

           (ANYCHAR-DISPATCH
            (lambda (pos arglist last-char-was-nl)
              (if (>= pos length-of-format-string)
                  (begin
                    (set! last-was-newline last-char-was-nl)
                    arglist ; used for ~? continuance
                  )
                  (let ( (char (string-ref format-strg pos)) )
                    (cond
                     ((eq? char #\~)
                      (tilde-dispatch (+ pos 1) arglist last-char-was-nl))
                     (else
                      (write-char char port)
                      (anychar-dispatch (+ pos 1) arglist #f)
                      ))
                    ))
              )) ; end anychar-dispatch

            (TILDE-DISPATCH
             (lambda (pos arglist last-char-was-nl)
               (cond
                ((>= pos length-of-format-string)
                 (write-char #\~ port) ; tilde at end of string is just output
                 (set! last-was-newline last-char-was-nl)
                 arglist ; used for ~? continuance
                 )
                (else
                 (case (char-upcase (string-ref format-strg pos))
                   ((#\A)       ; Any -- for humans
                    (display (car arglist) port)
                    (anychar-dispatch (+ pos 1) (cdr arglist) #f)
                    )
                   ((#\S)       ; Slashified -- for parsers
                    (write (car arglist) port)
                    (anychar-dispatch (+ pos 1) (cdr arglist) #f)
                    )
                   ((#\D)       ; Decimal
                    (display (number->string (car arglist) 10) port)
                    (anychar-dispatch (+ pos 1) (cdr arglist) #f)
                    )
                   ((#\X)       ; Hexadecimal
                    (display (number->string (car arglist) 16) port)
                    (anychar-dispatch (+ pos 1) (cdr arglist) #f)
                    )
                   ((#\O)       ; Octal
                    (display (number->string (car arglist)  8) port)
                    (anychar-dispatch (+ pos 1) (cdr arglist) #f)
                    )
                   ((#\B)       ; Binary
                    (display (number->string (car arglist)  2) port)
                    (anychar-dispatch (+ pos 1) (cdr arglist) #f)
                    )
                   ((#\C)       ; Character
                    (write-char (car arglist) port) 
                    (anychar-dispatch (+ pos 1) (cdr arglist) #f)
                    )
                   ((#\P)       ; Plural
                    (if (= (car arglist) 1)
                        #f ; no action
                        (write-char #\s port))
                    (anychar-dispatch (+ pos 1) (cdr arglist) #f)
                    )
                   ((#\~)       ; Tilde
                    (write-char #\~ port)
                    (anychar-dispatch (+ pos 1) arglist #f)
                    )
                   ((#\%)       ; Newline
                    (write-char #\newline port)
                    (anychar-dispatch (+ pos 1) arglist #t)
                    )
                   ((#\_)       ; Space
                    (write-char #\space port)
                    (anychar-dispatch (+ pos 1) arglist #f)
                    )
                   ((#\&)       ; Freshline
                    (if (not last-char-was-nl)
                        (write-char #\newline port))
                    (anychar-dispatch (+ pos 1) arglist #t)
                    )
                   ((#\T)       ; Tab -- Implementation dependent
                    (write-char ASCII-TAB port) 
                    (anychar-dispatch (+ pos 1) arglist #f)
                    )
                   ((#\|)       ; Page Seperator -- Implementation dependent
                    (write-char ascii-ff port) ;; use form-feed char
                    (anychar-dispatch (+ pos 1) arglist #t) ; counts as newline
                    )
                   ((#\G)       ; Pretty-print {T}
                    (if (eq? port #f)
                        (display (pretty-print-to-string (car arglist)) port)
                        (pretty-print (car arglist) port))
                    (anychar-dispatch (+ pos 1) (cdr arglist) #t) ; check this!
                    )
                   ;; {"~?" in Common Lisp is "~K" in T}
                   ((#\?)       ; indirection -- take next arg as format string.
                    (set! last-was-newline last-char-was-nl)
                    (anychar-dispatch (+ pos 1) 
                                      (format-help (car arglist) (cdr arglist))
                                      last-was-newline)
                                      ; Note: format-help returns unused args
                    )
                   (else
                    (error "FORMAT: unknown tilde escape" 
                           (string-ref format-strg pos)))
                   )))
               )) ; end tilde-dispatch

            )                    

        ; FORMAT-HELP MAIN
        (anychar-dispatch 0 arglyst last-was-newline)

        )) ; end format-help


    ; FORMAT MAIN
    (format-help <format-string> <args>)
    (return-value)
    
    ) ; end let
))) ; end format


