2 # aside from this initial boilerplate, this is actually -*- scheme -*- code
3 main
='(module-ref (resolve-module '\''(scripts punify)) '\'main
')'
4 exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
6 ;;; punify
--- Display Scheme code w
/o unnecessary comments
/ whitespace
8 ;; Copyright
(C
) 2001, 2006 Free Software Foundation
, Inc.
10 ;; This program is free software
; you can redistribute it and
/or
11 ;; modify it under the terms of the GNU General Public License as
12 ;; published by the Free Software Foundation
; either version
2, or
13 ;; (at your option
) any later version.
15 ;; This program is distributed
in the hope that it will be useful
,
16 ;; but WITHOUT ANY WARRANTY
; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License
for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with this software
; see the
file COPYING. If not
, write to
22 ;; the Free Software Foundation
, Inc.
, 51 Franklin Street
, Fifth Floor
,
23 ;; Boston
, MA
02110-1301 USA
25 ;;; Author
: Thien-Thi Nguyen
29 ;; Usage
: punify FILE1 FILE2 ...
31 ;; Each
file's forms are read and written to stdout.
32 ;; The effect is to remove comments and much non-essential whitespace.
33 ;; This is useful when installing Scheme source to space-limited media.
36 ;; $ wc ./punify ; ./punify ./punify | wc
37 ;; 89 384 3031 ./punify
40 ;; TODO: Read from stdin.
42 ;; Identifier punification.
46 (define-module (scripts punify)
49 (define (write-punily form)
50 (cond ((and (list? form) (not (null? form)))
51 (let ((first (car form)))
54 (let loop ((ls (cdr form)) (last-was-list? (list? first)))
57 (let* ((new-first (car ls))
58 (this-is-list? (list? new-first)))
59 (and (not last-was-list?)
62 (write-punily new-first)
63 (loop (cdr ls) this-is-list?))))))
65 (let ((ls (string->list (symbol->string form))))
66 (and (char=? (car ls) #\:)
67 (not (memq #\space ls))
68 (list->string (cdr ls)))))
69 => (lambda (symbol-name-after-colon)
71 (display symbol-name-after-colon)))
74 (define (punify-one file)
75 (with-input-from-file file
77 (let ((toke (lambda () (read (current-input-port)))))
78 (let loop ((form (toke)))
79 (or (eof-object? form)
84 (define (punify . args)
85 (for-each punify-one args))