summaryrefslogtreecommitdiff
path: root/scripts
diff options
context:
space:
mode:
authorThien-Thi Nguyen <ttn@gnuvola.org>2001-11-29 00:01:54 +0000
committerThien-Thi Nguyen <ttn@gnuvola.org>2001-11-29 00:01:54 +0000
commitb0147aec0a977a229374a4d37694039748a659c9 (patch)
tree8fa00aa46654e5a700d3957e576db810f765ff07 /scripts
parentf8e685d1b2b02f09da485c79b836fdb4ef0a862f (diff)
downloadguile-b0147aec0a977a229374a4d37694039748a659c9.tar.gz
(write-punily): Handle symbols with ":" prefix specially.
Diffstat (limited to 'scripts')
-rwxr-xr-xscripts/punify42
1 files changed, 25 insertions, 17 deletions
diff --git a/scripts/punify b/scripts/punify
index 699f3e2ff..eae8d51a7 100755
--- a/scripts/punify
+++ b/scripts/punify
@@ -34,8 +34,8 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
;;
;; Example:
;; $ wc ./punify ; ./punify ./punify | wc
-;; 81 355 2622 ./punify
-;; 0 34 694
+;; 89 384 3031 ./punify
+;; 0 42 920
;;
;; TODO: Read from stdin.
;; Handle vectors.
@@ -47,21 +47,29 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
:export (punify))
(define (write-punily form)
- (if (and (list? form) (not (null? form)))
- (let ((first (car form)))
- (display "(")
- (write-punily first)
- (let loop ((ls (cdr form)) (last-was-list? (list? first)))
- (if (null? ls)
- (display ")")
- (let* ((new-first (car ls))
- (this-is-list? (list? new-first)))
- (and (not last-was-list?)
- (not this-is-list?)
- (display " "))
- (write-punily new-first)
- (loop (cdr ls) this-is-list?)))))
- (write form)))
+ (cond ((and (list? form) (not (null? form)))
+ (let ((first (car form)))
+ (display "(")
+ (write-punily first)
+ (let loop ((ls (cdr form)) (last-was-list? (list? first)))
+ (if (null? ls)
+ (display ")")
+ (let* ((new-first (car ls))
+ (this-is-list? (list? new-first)))
+ (and (not last-was-list?)
+ (not this-is-list?)
+ (display " "))
+ (write-punily new-first)
+ (loop (cdr ls) this-is-list?))))))
+ ((and (symbol? form)
+ (let ((ls (string->list (symbol->string form))))
+ (and (char=? (car ls) #\:)
+ (not (memq #\space ls))
+ (list->string (cdr ls)))))
+ => (lambda (symbol-name-after-colon)
+ (display #\:)
+ (display symbol-name-after-colon)))
+ (else (write form))))
(define (punify-one file)
(with-input-from-file file