diff options
author | Thien-Thi Nguyen <ttn@gnuvola.org> | 2001-05-09 01:50:39 +0000 |
---|---|---|
committer | Thien-Thi Nguyen <ttn@gnuvola.org> | 2001-05-09 01:50:39 +0000 |
commit | bff56cdfa1af12f1933f09649ae33adcae211252 (patch) | |
tree | d2b474ea148259bf7a7b173d0fea42a35fa96816 /scripts/read-scheme-source | |
parent | 8ff45739c59e1150b09d251792b6c74c522439fe (diff) | |
download | guile-bff56cdfa1af12f1933f09649ae33adcae211252.tar.gz |
Initial revision
Diffstat (limited to 'scripts/read-scheme-source')
-rwxr-xr-x | scripts/read-scheme-source | 197 |
1 files changed, 197 insertions, 0 deletions
diff --git a/scripts/read-scheme-source b/scripts/read-scheme-source new file mode 100755 index 000000000..54cad4db0 --- /dev/null +++ b/scripts/read-scheme-source @@ -0,0 +1,197 @@ +#!/bin/sh +# aside from this initial boilerplate, this is actually -*- scheme -*- code +main='(module-ref (resolve-module '\''(scripts read-scheme-source)) '\'main')' +exec ${GUILE-guile} -c "(apply $main (cdr (command-line)))" "$@" +!# +;;; read-scheme-source --- Read a file, recognizing scheme forms and comments + +;; Copyright (C) 2001 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., 59 Temple Place, Suite 330, +;; Boston, MA 02111-1307 USA + +;;; Commentary: + +;; Usage: read-scheme-source FILE1 FILE2 ... +;; +;; This program parses each FILE and writes to stdout sexps that describe the +;; top-level structures of the file: scheme forms, single-line comments, and +;; hash-bang comments. You can further process these (to associate comments +;; w/ scheme forms as a kind of documentation, for example). +;; +;; The output sexps have one of these forms: +;; +;; (quote (filename FILENAME)) +;; +;; (quote (comment :leading-parens N +;; :text LINE)) +;; +;; (quote (whitespace :text LINE)) +;; +;; (quote (hash-bang-comment :line LINUM +;; :line-count N +;; :text-list (LINE1 LINE2 ...))) +;; +;; (quote (following-form-properties :line LINUM +;; :line-count N) +;; :type TYPE +;; :signature SIGNATURE +;; :std-int-doc DOCSTRING)) +;; +;; SEXP +;; +;; The first four are straightforward (both FILENAME and LINE are strings sans +;; newline, while LINUM and N are integers). The last two always go together, +;; in that order. SEXP is scheme code processed only by `read' and then +;; `write'. +;; +;; The :type field may be omitted if the form is not recognized. Otherwise, +;; TYPE may be one of: procedure, alias, define-module, variable. +;; +;; The :signature field may be omitted if the form is not a procedure. +;; Otherwise, SIGNATURE is a list showing the procedure's signature. +;; +;; If the type is `procedure' and the form has a standard internal docstring +;; (first body form a string), that is extracted in full -- including any +;; embedded newlines -- and recorded by field :std-int-doc. +;; +;; +;; Usage from a program: The output list of sexps can be retrieved by scheme +;; programs w/o having to capture stdout, like so: +;; +;; (use-modules (scripts read-scheme-source)) +;; (define source-forms (read-scheme-source-silently "FILE1" "FILE2" ...)) +;; +;; +;; TODO: Add option "--clump-comments", maybe w/ different clumping styles. +;; Make `annotate!' extensible. +;; +;; Author: Thien-Thi Nguyen + +;;; Code: + +(define-module (scripts read-scheme-source) + :use-module (ice-9 rdelim) + :export (read-scheme-source read-scheme-source-silently)) + +;; Try to figure out what FORM is and its various attributes. +;; Call proc NOTE! with key (a symbol) and value. +;; +(define (annotate! form note!) + (cond ((and (list? form) + (< 2 (length form)) + (eq? 'define (car form)) + (pair? (cadr form)) + (symbol? (caadr form))) + (note! ':type 'procedure) + (note! ':signature (cadr form)) + (and (< 3 (length form)) + (string? (caddr form)) + (note! ':std-int-doc (caddr form)))) + ((and (list? form) + (< 2 (length form)) + (eq? 'define (car form)) + (symbol? (cadr form)) + (list? (caddr form)) + (< 3 (length (caddr form))) + (eq? 'lambda (car (caddr form))) + (string? (caddr (caddr form)))) + (note! ':type 'procedure) + (note! ':signature (cons (cadr form) (cadr (caddr form)))) + (note! ':std-int-doc (caddr (caddr form)))) + ((and (list? form) + (= 3 (length form)) + (eq? 'define (car form)) + (symbol? (cadr form)) + (symbol? (caddr form))) + (note! ':type 'alias)) + ((and (list? form) + (eq? 'define-module (car form))) + (note! ':type 'define-module)) + ;; Add other types here. + (else (note! ':type 'variable)))) + +;; Process FILE, calling NB! on parsed top-level elements. +;; Recognized: #!-!# and regular comments in addition to normal forms. +;; +(define (process file nb!) + (nb! `'(filename ,file)) + (let ((hash-bang-rx (make-regexp "^#!")) + (bang-hash-rx (make-regexp "^!#")) + (all-comment-rx (make-regexp "^[ \t]*(;+)")) + (all-whitespace-rx (make-regexp "^[ \t]*$")) + (p (open-input-file file))) + (let loop ((n (1+ (port-line p))) (line (read-line p))) + (or (not n) + (eof-object? line) + (begin + (cond ((regexp-exec hash-bang-rx line) + (let loop ((line (read-line p)) + (text (list line))) + (if (or (eof-object? line) + (regexp-exec bang-hash-rx line)) + (nb! `'(hash-bang-comment + :line ,n + :line-count ,(1+ (length text)) + :text-list ,(reverse + (cons line text)))) + (loop (read-line p) + (cons line text))))) + ((regexp-exec all-whitespace-rx line) + (nb! `'(whitespace :text ,line))) + ((regexp-exec all-comment-rx line) + => (lambda (m) + (nb! `'(comment + :leading-parens ,(let ((m1 (vector-ref m 1))) + (- (cdr m1) (car m1))) + :text ,line)))) + (else + (unread-string line p) + (let* ((form (read p)) + (count (- (port-line p) n)) + (props (let* ((props '()) + (prop+ (lambda args + (set! props + (append props args))))) + (annotate! form prop+) + props))) + (or (= count 1) ; ugh + (begin + (read-line p) + (set! count (1+ count)))) + (nb! `'(following-form-properties + :line ,n + :line-count ,count + ,@props)) + (nb! form)))) + (loop (1+ (port-line p)) (read-line p))))))) + +(define (read-scheme-source-silently . files) + "See commentary in module (scripts read-scheme-source)." + (let* ((res '())) + (for-each (lambda (file) + (process file (lambda (e) (set! res (cons e res))))) + files) + (reverse res))) + +(define (read-scheme-source . files) + "See commentary in module (scripts read-scheme-source)." + (for-each (lambda (file) + (process file (lambda (e) (write e) (newline)))) + files)) + +(define main read-scheme-source) + +;;; read-scheme-source ends here |