summaryrefslogtreecommitdiff
path: root/scripts/lint
diff options
context:
space:
mode:
Diffstat (limited to 'scripts/lint')
-rwxr-xr-xscripts/lint319
1 files changed, 0 insertions, 319 deletions
diff --git a/scripts/lint b/scripts/lint
deleted file mode 100755
index a43cfc065..000000000
--- a/scripts/lint
+++ /dev/null
@@ -1,319 +0,0 @@
-#!/bin/sh
-# aside from this initial boilerplate, this is actually -*- scheme -*- code
-main='(module-ref (resolve-module '\''(scripts lint)) '\'main')'
-exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
-!#
-;;; lint --- Preemptive checks for coding errors in Guile Scheme code
-
-;; Copyright (C) 2002 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
-
-;;; Author: Neil Jerram
-
-;;; Commentary:
-
-;; Usage: lint FILE1 FILE2 ...
-;;
-;; Perform various preemptive checks for coding errors in Guile Scheme
-;; code.
-;;
-;; Right now, there is only one check available, for unresolved free
-;; variables. The intention is that future lint-like checks will be
-;; implemented by adding to this script file.
-;;
-;; Unresolved free variables
-;; -------------------------
-;;
-;; Free variables are those whose definitions come from outside the
-;; module under investigation. In Guile, these definitions are
-;; imported from other modules using `#:use-module' forms.
-;;
-;; This tool scans the specified files for unresolved free variables -
-;; i.e. variables for which you may have forgotten the appropriate
-;; `#:use-module', or for which the module that is supposed to export
-;; them forgot to.
-;;
-;; It isn't guaranteed that the scan will find absolutely all such
-;; errors. Quoted (and quasiquoted) expressions are skipped, since
-;; they are most commonly used to describe constant data, not code, so
-;; code that is explicitly evaluated using `eval' will not be checked.
-;; For example, the `unresolved-var' in `(eval 'unresolved-var
-;; (current-module))' would be missed.
-;;
-;; False positives are also possible. Firstly, the tool doesn't
-;; understand all possible forms of implicit quoting; in particular,
-;; it doesn't detect and expand uses of macros. Secondly, it picks up
-;; explicit compatibility code like `(if (defined? 'x) (define y x))'.
-;; Thirdly, there are occasional oddities like `next-method'.
-;; However, the number of false positives for realistic code is
-;; hopefully small enough that they can be individually considered and
-;; ignored.
-;;
-;; Example
-;; -------
-;;
-;; Note: most of the unresolved variables found in this example are
-;; false positives, as you would hope. => scope for improvement.
-;;
-;; $ guile-tools lint `guile-tools`
-;; No unresolved free variables in PROGRAM
-;; No unresolved free variables in autofrisk
-;; No unresolved free variables in display-commentary
-;; Unresolved free variables in doc-snarf:
-;; doc-snarf-version
-;; No unresolved free variables in frisk
-;; No unresolved free variables in generate-autoload
-;; No unresolved free variables in lint
-;; No unresolved free variables in punify
-;; No unresolved free variables in read-scheme-source
-;; Unresolved free variables in snarf-check-and-output-texi:
-;; name
-;; pos
-;; line
-;; x
-;; rest
-;; ...
-;; do-argpos
-;; do-command
-;; do-args
-;; type
-;; num
-;; file
-;; do-arglist
-;; req
-;; opt
-;; var
-;; command
-;; do-directive
-;; s
-;; ?
-;; No unresolved free variables in use2dot
-
-;;; Code:
-
-(define-module (scripts lint)
- #:use-module (ice-9 common-list)
- #:use-module (ice-9 format)
- #:export (lint))
-
-(define (lint filename)
- (let ((module-name (scan-file-for-module-name filename))
- (free-vars (uniq (scan-file-for-free-variables filename))))
- (let ((module (resolve-module module-name))
- (all-resolved? #t))
- (let loop ((free-vars free-vars))
- (or (null? free-vars)
- (begin
- (catch #t
- (lambda ()
- (eval (car free-vars) module))
- (lambda args
- (if all-resolved?
- (format #t
- "Unresolved free variables in ~A:\n"
- filename))
- (write-char #\tab)
- (write (car free-vars))
- (newline)
- (set! all-resolved? #f)))
- (loop (cdr free-vars)))))
- (if all-resolved?
- (format #t
- "No unresolved free variables in ~A\n"
- filename)))))
-
-(define (scan-file-for-module-name filename)
- (with-input-from-file filename
- (lambda ()
- (let loop ((x (read)))
- (cond ((eof-object? x) #f)
- ((and (pair? x)
- (eq? (car x) 'define-module))
- (cadr x))
- (else (loop (read))))))))
-
-(define (scan-file-for-free-variables filename)
- (with-input-from-file filename
- (lambda ()
- (let loop ((x (read)) (fvlists '()))
- (if (eof-object? x)
- (apply append fvlists)
- (loop (read) (cons (detect-free-variables x '()) fvlists)))))))
-
-; guile> (detect-free-variables '(let ((a 1)) a) '())
-; ()
-; guile> (detect-free-variables '(let ((a 1)) b) '())
-; (b)
-; guile> (detect-free-variables '(let ((a 1) (b a)) b) '())
-; (a)
-; guile> (detect-free-variables '(let* ((a 1) (b a)) b) '())
-; ()
-; guile> (detect-free-variables '(define a 1) '())
-; ()
-; guile> (detect-free-variables '(define a b) '())
-; (b)
-; guile> (detect-free-variables '(define (a b c) b) '())
-; ()
-; guile> (detect-free-variables '(define (a b c) e) '())
-; (e)
-
-(define (detect-free-variables x locals)
- ;; Given an expression @var{x} and a list @var{locals} of local
- ;; variables (symbols) that are in scope for @var{x}, return a list
- ;; of free variable symbols.
- (cond ((symbol? x)
- (if (memq x locals) '() (list x)))
-
- ((pair? x)
- (case (car x)
- ((define-module define-generic quote quasiquote)
- ;; No code of interest in these expressions.
- '())
-
- ((let letrec)
- ;; Check for named let. If there is a name, transform the
- ;; expression so that it looks like an unnamed let with
- ;; the name as one of the bindings.
- (if (symbol? (cadr x))
- (set-cdr! x (cons (cons (list (cadr x) #f) (caddr x))
- (cdddr x))))
- ;; Unnamed let processing.
- (let ((letrec? (eq? (car x) 'letrec))
- (locals-for-let-body (append locals (map car (cadr x)))))
- (append (apply append
- (map (lambda (binding)
- (detect-free-variables (cadr binding)
- (if letrec?
- locals-for-let-body
- locals)))
- (cadr x)))
- (apply append
- (map (lambda (bodyform)
- (detect-free-variables bodyform
- locals-for-let-body))
- (cddr x))))))
-
- ((let* and-let*)
- ;; Handle bindings recursively.
- (if (null? (cadr x))
- (apply append
- (map (lambda (bodyform)
- (detect-free-variables bodyform locals))
- (cddr x)))
- (append (detect-free-variables (cadr (caadr x)) locals)
- (detect-free-variables `(let* ,(cdadr x) ,@(cddr x))
- (cons (caaadr x) locals)))))
-
- ((define define-public define-macro)
- (if (pair? (cadr x))
- (begin
- (set! locals (cons (caadr x) locals))
- (detect-free-variables `(lambda ,(cdadr x) ,@(cddr x))
- locals))
- (begin
- (set! locals (cons (cadr x) locals))
- (detect-free-variables (caddr x) locals))))
-
- ((lambda lambda*)
- (let ((locals-for-lambda-body (let loop ((locals locals)
- (args (cadr x)))
- (cond ((null? args) locals)
- ((pair? args)
- (loop (cons (car args) locals)
- (cdr args)))
- (else
- (cons args locals))))))
- (apply append
- (map (lambda (bodyform)
- (detect-free-variables bodyform
- locals-for-lambda-body))
- (cddr x)))))
-
- ((receive)
- (let ((locals-for-receive-body (append locals (cadr x))))
- (apply append
- (detect-free-variables (caddr x) locals)
- (map (lambda (bodyform)
- (detect-free-variables bodyform
- locals-for-receive-body))
- (cdddr x)))))
-
- ((define-method define*)
- (let ((locals-for-method-body (let loop ((locals locals)
- (args (cdadr x)))
- (cond ((null? args) locals)
- ((pair? args)
- (loop (cons (if (pair? (car args))
- (caar args)
- (car args))
- locals)
- (cdr args)))
- (else
- (cons args locals))))))
- (apply append
- (map (lambda (bodyform)
- (detect-free-variables bodyform
- locals-for-method-body))
- (cddr x)))))
-
- ((define-class)
- ;; Avoid picking up slot names at the start of slot
- ;; definitions.
- (apply append
- (map (lambda (slot/option)
- (detect-free-variables-noncar (if (pair? slot/option)
- (cdr slot/option)
- slot/option)
- locals))
- (cdddr x))))
-
- ((case)
- (apply append
- (detect-free-variables (cadr x) locals)
- (map (lambda (case)
- (detect-free-variables (cdr case) locals))
- (cddr x))))
-
- ((unquote unquote-splicing else =>)
- (detect-free-variables-noncar (cdr x) locals))
-
- (else (append (detect-free-variables (car x) locals)
- (detect-free-variables-noncar (cdr x) locals)))))
-
- (else '())))
-
-(define (detect-free-variables-noncar x locals)
- ;; Given an expression @var{x} and a list @var{locals} of local
- ;; variables (symbols) that are in scope for @var{x}, return a list
- ;; of free variable symbols.
- (cond ((symbol? x)
- (if (memq x locals) '() (list x)))
-
- ((pair? x)
- (case (car x)
- ((=>)
- (detect-free-variables-noncar (cdr x) locals))
-
- (else (append (detect-free-variables (car x) locals)
- (detect-free-variables-noncar (cdr x) locals)))))
-
- (else '())))
-
-(define (main . files)
- (for-each lint files))
-
-;;; lint ends here