summaryrefslogtreecommitdiff
path: root/module/scripts/punify.scm
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2009-04-17 11:19:42 +0200
committerAndy Wingo <wingo@pobox.com>2009-04-17 11:19:42 +0200
commit6d66647d5b2c6649bb4dade734f6d583d10d797c (patch)
tree3c05d62af67617f0949fbe4a4228ac3564da0be5 /module/scripts/punify.scm
parent798244609bfd3b4d2b12f722d9130d47abcfeb1a (diff)
downloadguile-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.scm84
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