mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 14:00:21 +02:00
Code Activity

(write-punily): Handle symbols with ":" prefix specially.

Browse source
This commit is contained in:
Thien-Thi Nguyen 2001-11-29 00:01:54 +00:00
parent f8e685d1b2
commit b0147aec0a
1 changed files with 25 additions and 17 deletions
Download patch file Download diff file Expand all files Collapse all files

42
scripts/punify
View file

@ -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