diff options
Diffstat (limited to 'scripts/lint')
-rwxr-xr-x | scripts/lint | 319 |
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 |