anchor.diff:     #:make-string-builder
      #:with-mapping-collector
      #:with-mapping-appender
  +   #:make-formatter
  +   #:with-formatter
  +   #:with-formatter-output
      ))
   
   (in-package :collectors)
   
  -(defun make-string-builder (&optional
  +;;;; * Reducing and Collecting
  +
  +;;;; ** Reducing
  +
  +;;;; reducing is the act of taking values, two at a time, and
  +;;;; combining them, with the aid of a reducing function, into a
  +;;;; single final value.
  +
  +(defun make-reducer (function &optional (initial-value nil initial-value-p))
  +  "Create a function which, starting with INITIAL-VALUE, reduces
  +any other values into a single final value.
  +
  +FUNCTION will be called with two values: the current value and
  +the new value, in that order. FUNCTION should return exactly one
  +value.
  +
  +The reducing function can be called with n arguments which will
  +be applied to FUNCTION one after the other (left to right) and
  +will return the new value.
  +
  +If the reducing function is called with no arguments it will
  +return the current value.
  +
  +Example:
  +
  + (setf r (make-reducer #'+ 5))
  + (funcall r 0) => 5
  + (funcall r 1 2) => 8
  + (funcall r) => 8"
  +  (let ((value initial-value))
  +    (lambda (&rest next)
  +      (when next
  +        ;; supplied a value, reduce
  +        (if initial-value-p
  +            ;; have a value to test against
  +            (dolist (n next)
  +              (setf value (funcall function value n)))
  +            ;; nothing to test againts yet
  +            (setf initial-value-p t
  +                  value next)))
  +      ;; didn't supply a value, return the current value
  +      value)))
  +
  +(defmacro with-reducer ((name function &optional (initial-value nil))
  +                        &body body)
  +  "Locally bind NAME to a reducing function. The arguments
  +FUNCTION and INITIAL-VALUE are passed directly to MAKE-REDUCER."
  +  (alexandria:with-unique-names (reducer)
  +    `(let ((,reducer (make-reducer ,function ,@(list initial-value))))
  +       (flet ((,name (&rest items)
  +                (if items
  +                    (dolist (i items)
  +                      (funcall ,reducer i))
  +                    (funcall ,reducer))))
  +         ,@body))))
  +
  +;;;; ** Collecting
  +;;;;
  +;;;; Building up a list from multiple values.
  +
  +(defun make-collector (&optional initial-value (collect-nil t))
  +  "Create a collector function.
  +
  +A Collector function will collect, into a list, all the values
  +passed to it in the order in which they were passed. If the
  +callector function is called without arguments it returns the
  +current list of values."
  +  (let ((value initial-value)
  +        (cdr (last initial-value)))
  +    (lambda (&rest items)
  +      (unless collect-nil (setf items (delete-if #'null items)))
  +      (if items
  +          (progn
  +            (if value
  +                (if cdr
  +                    (setf (cdr cdr) items
  +                          cdr (last items))
  +                    (setf cdr (last items)))
  +                (setf value items
  +                      cdr (last items)))
  +            items)
  +          value))))
  +
  +(defun make-appender (&optional initial-value)
  +  "Create an appender function.
  +
  +An Appender will append any arguments into a list, all the values
  +passed to it in the order in which they were passed. If the
  +appender function is called without arguments it returns the
  +current list of values."
  +  (let ((collector (make-collector initial-value)))
  +    (lambda (&rest items)
  +      ;; flatten one level and append lists for appender
  +      (setf items (apply #'append
  +		   (mapcar #'alexandria:ensure-list items)))
  +      (apply collector items))))
  +
  +(defun make-pusher (&optional initial-value (collect-nil t))
  +  "Create a function which collects values as by PUSH."
  +  (let ((value initial-value))
  +    (lambda (&rest items)
  +      (if items
  +          (progn
  +            (dolist (i items)
  +              (when (or collect-nil i)
  +                (push i value)))
  +            items)
  +          value))))
  +
  +(defmacro with-appender ((name &optional initial-value) &body body)
  +  "Bind NAME to a collector function and execute BODY. If
  +  FROM-END is true the collector will actually be a pusher, (see
  +  MAKE-PUSHER), otherwise NAME will be bound to a collector,
  +  (see MAKE-COLLECTOR).
  +
  +    (with-appender (app)
  +       (app '(1 2))
  +       (app '(2 3))
  +       (app '(3 4))
  +       (app)) => (1 2 2 3 3 4)
  +
  +  "
  +  (alexandria:with-unique-names (appender)
  +    `(let ((,appender (make-appender ,initial-value)))
  +       (flet ((,name (&rest items)
  +		(apply ,appender items)))
  +         ,@body))))
  +
  +(defmacro with-appender-output ((name &optional initial-value) &body body)
  +  "Same as with-appender, but this form returns the collected values
  +   automatically
  +  "
  +  `(with-appender (,name ,initial-value) ,@body (,name)))
  +
  +(defmacro with-collector ((name &key
  +                            (collect-nil T)
  +                            initial-value from-end) &body body)
  +  "Bind NAME to a collector function and execute BODY. If
  +  FROM-END is true the collector will actually be a pusher, (see
  +  MAKE-PUSHER), otherwise NAME will be bound to a collector,
  +  (see MAKE-COLLECTOR).
  +    (with-collector (col)
  +       (col 1)
  +       (col 2)
  +       (col 3)
  +       (col)) => (1 2 3)
  +  "
  +  (alexandria:with-unique-names (collector)
  +    `(let ((,collector ,(if from-end
  +                            `(make-pusher ,initial-value ,collect-nil)
  +                            `(make-collector ,initial-value ,collect-nil))))
  +       (flet ((,name (&rest items)
  +		(apply ,collector items)))
  +         ,@body))))
  +
  +(defmacro with-collector-output ((name &key (collect-nil t) initial-value from-end)
  +                                 &body body)
  +  `(with-collector (,name :collect-nil ,collect-nil
  +                          :initial-value ,initial-value
  +                          :from-end ,from-end)
  +    ,@body
  +    (,name)))
  +
  +(defmacro with-collectors (names &body body)
  +  "Bind multiple collectors. Each element of NAMES should be a
  +  list as per WITH-COLLECTOR's first orgument."
  +  (if names
  +      `(with-collector ,(alexandria:ensure-list (car names))
  +         (with-collectors ,(cdr names) ,@body))
  +      `(progn ,@body)))
  +
  +(defun make-formatter (&key delimiter stream)
  +  "Create a string formatter collector function.
  +
  +creates a (lambda &optional format-string &rest args) and collects these in a list
  +When called with no args, returns the concatenated (with delimiter) results
  +
  +binds *print-pretty* to nil
  +"
  +  (let* (*print-pretty*
  +         (format-string (if delimiter
  +                            (format nil "~~{~~?~~^~a~~}" delimiter)
  +                            "~{~?~}")))
  +    (with-collector (value)
  +      (lambda (&rest args)
  +        (cond
  +          ((null args)
  +           (let (*print-pretty*)
  +             (format stream format-string (value))))
  +          (args
  +           (destructuring-bind (format-string &rest args) args
  +               (value format-string args))))
  +        ))))
  +
  +(defmacro with-formatter ((name &key delimiter stream) &body body)
  +  "A macro makes a function with name for body that is a string formatter
  +see make-formatter"
  +  (alexandria:with-unique-names (fn-sym)
  +    `(let ((,fn-sym (make-formatter :delimiter ,delimiter :stream ,stream)))
  +       (flet ((,name (&rest args) (apply ,fn-sym args)))
  +         ,@body))))
  +
  +(defmacro with-formatter-output ((name &key delimiter stream) &body body)
  +  "A macro makes a function with name for body that is a string formatter
  +see make-formatter.
  +This form returns the result of that formatter"
  +  `(with-formatter (,name :delimiter ,delimiter :stream ,stream )
  +     ,@body
  +     (,name)))
  +
  +(defun make-string-builder-old (&optional
                               delimiter
                               (ignore-empty-strings-and-nil t)
                               (pretty nil))
  
positive.code:                    (write-it item s)
                     (setf printed? t)))))
        (lambda (&rest args)
          (if args
              (mapc #'p args)
              (coerce arr 'string))))))
  
  (defmacro with-string-builder ((name &key delimiter (ignore-empty-strings-and-nil t))
                                 &body body)
  
negative.code:                                :ignore-empty-strings-and-nil ,ignore-empty-strings-and-nil)
      ,@body
      (,name)))
  
  ;;;; Mapping collectors
  (defmacro with-mapping-collector ((name fn-args &body fn-body)
  