diff options
author | Andy Wingo <wingo@pobox.com> | 2009-04-17 11:19:42 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2009-04-17 11:19:42 +0200 |
commit | 6d66647d5b2c6649bb4dade734f6d583d10d797c (patch) | |
tree | 3c05d62af67617f0949fbe4a4228ac3564da0be5 /module/scripts/punify.scm | |
parent | 798244609bfd3b4d2b12f722d9130d47abcfeb1a (diff) | |
download | guile-6d66647d5b2c6649bb4dade734f6d583d10d797c.tar.gz |
guile-tools is a scheme script that loads scheme modules
* meta/guile-tools: Changed to be a scheme script. Instead of looking for
executables in a "scripts dir", we just look for modules in (scripts),
and load the modules directly.
* module/Makefile.am:
* module/scripts/: Move the scripts into module/ so they can be compiled.
Rename scripts from `foo' to `foo.scm'.
* libguile/Makefile.am: Invoke the snarf->texi code via guile-tools.
* configure.in:
* .gitignore: Update for changes.
Diffstat (limited to 'module/scripts/punify.scm')
-rw-r--r-- | module/scripts/punify.scm | 84 |
1 files changed, 84 insertions, 0 deletions
diff --git a/module/scripts/punify.scm b/module/scripts/punify.scm new file mode 100644 index 000000000..098c4b935 --- /dev/null +++ b/module/scripts/punify.scm @@ -0,0 +1,84 @@ +;;; punify --- Display Scheme code w/o unnecessary comments / whitespace + +;; Copyright (C) 2001, 2006 Free Software Foundation, Inc. +;; +;; 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 +;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301 USA + +;;; Author: Thien-Thi Nguyen + +;;; 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 +;; 89 384 3031 ./punify +;; 0 42 920 +;; +;; TODO: Read from stdin. +;; Handle vectors. +;; Identifier punification. + +;;; Code: + +(define-module (scripts punify) + :export (punify)) + +(define (write-punily 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 + (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 |