module/scripts/punify.scm

   1 ;;; punify --- Display Scheme code w/o unnecessary comments / whitespace
   2
   3 ;;      Copyright (C) 2001, 2006 Free Software Foundation, Inc.
   4 ;;
   5 ;; This program is free software; you can redistribute it and/or
   6 ;; modify it under the terms of the GNU Lesser General Public License
   7 ;; as published by the Free Software Foundation; either version 3, or
   8 ;; (at your option) any later version.
   9 ;;
  10 ;; This program is distributed in the hope that it will be useful,
  11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 ;; Lesser General Public License for more details.
  14 ;;
  15 ;; You should have received a copy of the GNU Lesser General Public
  16 ;; License along with this software; see the file COPYING.LESSER.  If
  17 ;; not, write to the Free Software Foundation, Inc., 51 Franklin
  18 ;; Street, Fifth Floor, Boston, MA 02110-1301 USA
  19
  20 ;;; Author: Thien-Thi Nguyen
  21
  22 ;;; Commentary:
  23
  24 ;; Usage: punify FILE1 FILE2 ...
  25 ;;
  26 ;; Each file's forms are read and written to stdout.
  27 ;; The effect is to remove comments and much non-essential whitespace.
  28 ;; This is useful when installing Scheme source to space-limited media.
  29 ;;
  30 ;; Example:
  31 ;; $ wc ./punify ; ./punify ./punify | wc
  32 ;;     89     384    3031 ./punify
  33 ;;      0      42     920
  34 ;;
  35 ;; TODO: Read from stdin.
  36 ;;       Handle vectors.
  37 ;;       Identifier punification.
  38
  39 ;;; Code:
  40
  41 (define-module (scripts punify)
  42   :export (punify))
  43
  44 (define %include-in-guild-list #f)
  45 (define %summary "Strip comments and whitespace from a Scheme file.")
  46
  47 (define (write-punily form)
  48   (cond ((and (list? form) (not (null? form)))
  49          (let ((first (car form)))
  50            (display "(")
  51            (write-punily first)
  52            (let loop ((ls (cdr form)) (last-was-list? (list? first)))
  53              (if (null? ls)
  54                  (display ")")
  55                  (let* ((new-first (car ls))
  56                         (this-is-list? (list? new-first)))
  57                    (and (not last-was-list?)
  58                         (not this-is-list?)
  59                         (display " "))
  60                    (write-punily new-first)
  61                    (loop (cdr ls) this-is-list?))))))
  62         ((and (symbol? form)
  63               (let ((ls (string->list (symbol->string form))))
  64                 (and (char=? (car ls) #\:)
  65                      (not (memq #\space ls))
  66                      (list->string (cdr ls)))))
  67          => (lambda (symbol-name-after-colon)
  68               (display #\:)
  69               (display symbol-name-after-colon)))
  70         (else (write form))))
  71
  72 (define (punify-one file)
  73   (with-input-from-file file
  74     (lambda ()
  75       (let ((toke (lambda () (read (current-input-port)))))
  76         (let loop ((form (toke)))
  77           (or (eof-object? form)
  78               (begin
  79                 (write-punily form)
  80                 (loop (toke)))))))))
  81
  82 (define (punify . args)
  83   (for-each punify-one args))
  84
  85 (define main punify)
  86
  87 ;;; punify ends here