guile18/scripts/punify

   1 #!/bin/sh
   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)))" "$@"
   5 !#
   6 ;;; punify --- Display Scheme code w/o unnecessary comments / whitespace
   7
   8 ;;      Copyright (C) 2001, 2006 Free Software Foundation, Inc.
   9 ;;
  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.
  14 ;;
  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.
  19 ;;
  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
  24
  25 ;;; Author: Thien-Thi Nguyen
  26
  27 ;;; Commentary:
  28
  29 ;; Usage: punify FILE1 FILE2 ...
  30 ;;
  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.
  34 ;;
  35 ;; Example:
  36 ;; $ wc ./punify ; ./punify ./punify | wc
  37 ;;     89     384    3031 ./punify
  38 ;;      0      42     920
  39 ;;
  40 ;; TODO: Read from stdin.
  41 ;;       Handle vectors.
  42 ;;       Identifier punification.
  43
  44 ;;; Code:
  45
  46 (define-module (scripts punify)
  47   :export (punify))
  48
  49 (define (write-punily form)
  50   (cond ((and (list? form) (not (null? form)))
  51          (let ((first (car form)))
  52            (display "(")
  53            (write-punily first)
  54            (let loop ((ls (cdr form)) (last-was-list? (list? first)))
  55              (if (null? ls)
  56                  (display ")")
  57                  (let* ((new-first (car ls))
  58                         (this-is-list? (list? new-first)))
  59                    (and (not last-was-list?)
  60                         (not this-is-list?)
  61                         (display " "))
  62                    (write-punily new-first)
  63                    (loop (cdr ls) this-is-list?))))))
  64         ((and (symbol? form)
  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)
  70               (display #\:)
  71               (display symbol-name-after-colon)))
  72         (else (write form))))
  73
  74 (define (punify-one file)
  75   (with-input-from-file file
  76     (lambda ()
  77       (let ((toke (lambda () (read (current-input-port)))))
  78         (let loop ((form (toke)))
  79           (or (eof-object? form)
  80               (begin
  81                 (write-punily form)
  82                 (loop (toke)))))))))
  83
  84 (define (punify . args)
  85   (for-each punify-one args))
  86
  87 (define main punify)
  88
  89 ;;; punify ends here