Skip to content

Commit

Permalink
formatter and working on string builder in terms of formatter
Browse files Browse the repository at this point in the history 
This results in a pretty big performance increase in both memory
 and time
  • Loading branch information
@bobbysmith007
bobbysmith007 committed Feb 1, 2012
1 parent c26f4b1 commit cc51ef9
Showing 1 changed file with 133 additions and 64 deletions.
197 changes: 133 additions & 64 deletions collectors.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -18,74 +18,13 @@
#:make-string-builder
#:with-mapping-collector
#:with-mapping-appender
#:make-formatter
#:with-formatter
#:with-formatter-output
))

(in-package :collectors)

(defun make-string-builder (&optional
delimiter
(ignore-empty-strings-and-nil t)
(pretty nil))
"Create a function that will build up a string for you
Each call to the function with arguments appends those arguments to the string
with an optional delimiter between them.
if ignore-empty-strings-and-nil is true neither empty strings nor nil will be
printed to the stream
A call to the function with no arguments returns the output string"
(let ((arr (make-array 100
:element-type 'character :fill-pointer 0
:adjustable T))
(*print-pretty* pretty)
(printed? nil)
(print-empty? (null ignore-empty-strings-and-nil))
(delimiter
(typecase delimiter
((or null string) delimiter)
(t (princ-to-string delimiter)))))
(labels ((coerce-it (item)
(typecase item
((or null string character) item)
(T (princ-to-string item))))
(write-it (item s)
(typecase item
(character (write-char item s))
(string (write-sequence item s))))
(not-empty? (item)
(and item (typecase item
(string (plusp (length item)))
(character t))))
(p (item &aux (item (coerce-it item)))
(with-output-to-string (s arr)
(when (or print-empty? (not-empty? item))
(when (and printed? delimiter)
(write-sequence delimiter s))
(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)
"A macro that creates a string builder with name in scope during the
duration of the env"
(alexandria:with-unique-names (it)
`(let ((,it (make-string-builder ,delimiter ,ignore-empty-strings-and-nil)))
(flet ((,name (&rest items) (apply ,it items)))
,@body))))

(defmacro with-string-builder-output ((name &key delimiter (ignore-empty-strings-and-nil t))
&body body)
"A macro that creates a string builder with name in scope during the
duration of the env, the form returns the string that is built"
`(with-string-builder (,name :delimiter ,delimiter
:ignore-empty-strings-and-nil ,ignore-empty-strings-and-nil)
,@body
(,name)))

;;;; * Reducing and Collecting

;;;; ** Reducing
Expand Down Expand Up @@ -257,6 +196,136 @@ current list of values."
(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))
"Create a function that will build up a string for you
Each call to the function with arguments appends those arguments to the string
with an optional delimiter between them.
if ignore-empty-strings-and-nil is true neither empty strings nor nil will be
printed to the stream
A call to the function with no arguments returns the output string"
(let ((arr (make-array 100
:element-type 'character :fill-pointer 0
:adjustable T))
(*print-pretty* pretty)
(printed? nil)
(print-empty? (null ignore-empty-strings-and-nil))
(delimiter
(typecase delimiter
((or null string) delimiter)
(t (princ-to-string delimiter)))))
(labels ((coerce-it (item)
(typecase item
((or null string character) item)
(T (princ-to-string item))))
(write-it (item s)
(typecase item
(character (write-char item s))
(string (write-sequence item s))))
(not-empty? (item)
(and item (typecase item
(string (plusp (length item)))
(character t))))
(p (item &aux (item (coerce-it item)))
(with-output-to-string (s arr)
(when (or print-empty? (not-empty? item))
(when (and printed? delimiter)
(write-sequence delimiter s))
(write-it item s)
(setf printed? t)))))
(lambda (&rest args)
(declare (dynamic-extent args))
(if args
(mapc #'p args)
(coerce arr 'string))))))

(defun make-string-builder (&optional
delimiter
(ignore-empty-strings-and-nil t))
"Create a function that will build up a string for you
Each call to the function with arguments appends those arguments to the string
with an optional delimiter between them.
if ignore-empty-strings-and-nil is true neither empty strings nor nil will be
printed to the stream
A call to the function with no arguments returns the output string"
(let ((formatter (make-formatter :delimiter delimiter))
(include-empty? (not ignore-empty-strings-and-nil)))
(flet ((include-arg? (arg)
(or include-empty?
(if (stringp arg)
(plusp (length arg))
arg))))
(lambda (&rest args)
(declare (dynamic-extent args))
(if args
(loop for arg in args
when (include-arg? arg)
do (apply formatter (list "~A" arg)))
(funcall formatter))))))

(defmacro with-string-builder ((name &key delimiter (ignore-empty-strings-and-nil t))
&body body)
"A macro that creates a string builder with name in scope during the
duration of the env"
(alexandria:with-unique-names (it)
`(let ((,it (make-string-builder ,delimiter ,ignore-empty-strings-and-nil)))
(flet ((,name (&rest items) (apply ,it items)))
,@body))))

(defmacro with-string-builder-output ((name &key delimiter (ignore-empty-strings-and-nil t))
&body body)
"A macro that creates a string builder with name in scope during the
duration of the env, the form returns the string that is built"
`(with-string-builder (,name :delimiter ,delimiter
:ignore-empty-strings-and-nil ,ignore-empty-strings-and-nil)
,@body
(,name)))

;;;; Mapping collectors
(defmacro with-mapping-collector ((name fn-args &body fn-body)
&body body)
Expand Down

0 comments on commit cc51ef9

Please sign in to comment.