punify 2.97 KB
Newer Older
Thien-Thi Nguyen's avatar
Thien-Thi Nguyen committed
1 2 3
#!/bin/sh
# aside from this initial boilerplate, this is actually -*- scheme -*- code
main='(module-ref (resolve-module '\''(scripts punify)) '\'main')'
4
exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
Thien-Thi Nguyen's avatar
Thien-Thi Nguyen committed
5 6 7
!#
;;; punify --- Display Scheme code w/o unnecessary comments / whitespace

8
;; 	Copyright (C) 2001, 2006 Free Software Foundation, Inc.
Thien-Thi Nguyen's avatar
Thien-Thi Nguyen committed
9 10 11 12 13 14 15 16 17 18 19 20 21
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this software; see the file COPYING.  If not, write to
22 23
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301 USA
Thien-Thi Nguyen's avatar
Thien-Thi Nguyen committed
24

25 26
;;; Author: Thien-Thi Nguyen

Thien-Thi Nguyen's avatar
Thien-Thi Nguyen committed
27 28 29 30 31 32 33 34 35 36
;;; Commentary:

;; Usage: punify FILE1 FILE2 ...
;;
;; Each file's forms are read and written to stdout.
;; The effect is to remove comments and much non-essential whitespace.
;; This is useful when installing Scheme source to space-limited media.
;;
;; Example:
;; $ wc ./punify ; ./punify ./punify | wc
37 38
;;     89     384    3031 ./punify
;;      0      42     920
Thien-Thi Nguyen's avatar
Thien-Thi Nguyen committed
39 40 41 42 43 44 45 46 47 48 49
;;
;; TODO: Read from stdin.
;;       Handle vectors.
;;       Identifier punification.

;;; Code:

(define-module (scripts punify)
  :export (punify))

(define (write-punily form)
50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72
  (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))))
Thien-Thi Nguyen's avatar
Thien-Thi Nguyen committed
73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89

(define (punify-one file)
  (with-input-from-file file
    (lambda ()
      (let ((toke (lambda () (read (current-input-port)))))
        (let loop ((form (toke)))
          (or (eof-object? form)
              (begin
                (write-punily form)
                (loop (toke)))))))))

(define (punify . args)
  (for-each punify-one args))

(define main punify)

;;; punify ends here