Commit 493a9f7b6c106a5e73486fc2534fc7456cc64663
2013-11-27T13:31:01
Make STR use a generic function ATOM-STR to convert atoms to string using WALK-STR. This allows for a really dry implementation of WRITE-STR.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98
diff --git a/package.lisp b/package.lisp
index 0c9c183..fb24842 100644
--- a/package.lisp
+++ b/package.lisp
@@ -22,7 +22,9 @@
(:nicknames :L>uri)
(:use :cl :alexandria)
(:export
- #:str #:rope-merge #:rope-nmerge #:write-rope #:case-char
+ #:str #:atom-str #:walk-str #:write-str
+ #:rope-merge #:rope-nmerge #:write-rope
+ #:case-char
#:uri-template #:uri-template-expand
#:canonical-document-uri
#:%-encode-char))
diff --git a/str.lisp b/str.lisp
index d20b2e2..b788be8 100644
--- a/str.lisp
+++ b/str.lisp
@@ -79,20 +79,39 @@
(iter rope))
rope)
-(defun str (&rest objects)
- (cond ((endp objects)
- (str ""))
- ((= 1 (length objects))
- (let ((obj (first objects)))
- (typecase obj
- (null "")
- (symbol (str (string-downcase (symbol-name obj))))
- (string obj)
- (pathname (format nil "~A" obj))
- (t (string obj)))))
- (t
- (apply #'concatenate 'string
- (mapcar 'str objects)))))
+;; STR
+
+(defgeneric atom-str (x))
+
+(defmethod atom-str (x)
+ (string x))
+
+(defmethod atom-str ((x null))
+ "")
+
+(defmethod atom-str ((x symbol))
+ (string-downcase (symbol-name x)))
+
+(defmethod atom-str ((x string))
+ x)
+
+(defmethod atom-str ((x pathname))
+ (namestring x))
+
+(defmethod atom-str ((x integer))
+ (format nil "~D" x))
+
+(defun walk-str (fn str)
+ (labels ((walk (x)
+ (if (typep x 'sequence)
+ (map nil #'walk x)
+ (funcall fn (atom-str x)))))
+ (walk str)))
+
+(defun str (&rest parts)
+ (with-output-to-string (s)
+ (walk-str (lambda (x) (write-string x s))
+ parts)))
(define-compiler-macro str (&whole form &rest parts)
(let ((merged (rope-merge parts)))
@@ -100,6 +119,24 @@
form
`(str ,@merged))))
+(defun write-str (stream &rest parts)
+ (walk-str (lambda (x) (write-string x stream))
+ parts))
+
+(defgeneric to-str (x))
+
+(defmethod to-str (x)
+ (atom-str x))
+
+(defmethod to-str ((x sequence))
+ (with-output-to-string (out)
+ (labels ((str<< (y)
+ (if (typep y 'sequence)
+ (map nil #'str<< y)
+ (write-string (atom-str y) out))))
+ (str<< x))))
+
+
(defun write-rope (rope &optional (stream *standard-output*))
(dolist (x rope)
(write-string x stream)))