2 # aside from this initial boilerplate, this is actually -*- scheme -*- code
3 main='(module-ref (resolve-module '\''(scripts lint)) '\'main')'
4 exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
6 ;;; lint --- Preemptive checks for coding errors in Guile Scheme code
8 ;; Copyright (C) 2002, 2006 Free Software Foundation, Inc.
10 ;; This program is free software; you can redistribute it and/or
11 ;; modify it under the terms of the GNU General Public License as
12 ;; published by the Free Software Foundation; either version 2, or
13 ;; (at your option) any later version.
15 ;; This program is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with this software; see the file COPYING. If not, write to
22 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
23 ;; Boston, MA 02110-1301 USA
25 ;;; Author: Neil Jerram
29 ;; Usage: lint FILE1 FILE2 ...
31 ;; Perform various preemptive checks for coding errors in Guile Scheme
34 ;; Right now, there is only one check available, for unresolved free
35 ;; variables. The intention is that future lint-like checks will be
36 ;; implemented by adding to this script file.
38 ;; Unresolved free variables
39 ;; -------------------------
41 ;; Free variables are those whose definitions come from outside the
42 ;; module under investigation. In Guile, these definitions are
43 ;; imported from other modules using `#:use-module' forms.
45 ;; This tool scans the specified files for unresolved free variables -
46 ;; i.e. variables for which you may have forgotten the appropriate
47 ;; `#:use-module', or for which the module that is supposed to export
50 ;; It isn't guaranteed that the scan will find absolutely all such
51 ;; errors. Quoted (and quasiquoted) expressions are skipped, since
52 ;; they are most commonly used to describe constant data, not code, so
53 ;; code that is explicitly evaluated using `eval' will not be checked.
54 ;; For example, the `unresolved-var' in `(eval 'unresolved-var
55 ;; (current-module))' would be missed.
57 ;; False positives are also possible. Firstly, the tool doesn't
58 ;; understand all possible forms of implicit quoting; in particular,
59 ;; it doesn't detect and expand uses of macros. Secondly, it picks up
60 ;; explicit compatibility code like `(if (defined? 'x) (define y x))'.
61 ;; Thirdly, there are occasional oddities like `next-method'.
62 ;; However, the number of false positives for realistic code is
63 ;; hopefully small enough that they can be individually considered and
69 ;; Note: most of the unresolved variables found in this example are
70 ;; false positives, as you would hope. => scope for improvement.
72 ;; $ guile-tools lint `guile-tools`
73 ;; No unresolved free variables in PROGRAM
74 ;; No unresolved free variables in autofrisk
75 ;; No unresolved free variables in display-commentary
76 ;; Unresolved free variables in doc-snarf:
78 ;; No unresolved free variables in frisk
79 ;; No unresolved free variables in generate-autoload
80 ;; No unresolved free variables in lint
81 ;; No unresolved free variables in punify
82 ;; No unresolved free variables in read-scheme-source
83 ;; Unresolved free variables in snarf-check-and-output-texi:
104 ;; No unresolved free variables in use2dot
108 (define-module (scripts lint)
109 #:use-module (ice-9 common-list)
110 #:use-module (ice-9 format)
113 (define (lint filename)
114 (let ((module-name (scan-file-for-module-name filename))
115 (free-vars (uniq (scan-file-for-free-variables filename))))
116 (let ((module (resolve-module module-name))
118 (format #t "Resolved module: ~S\n" module)
119 (let loop ((free-vars free-vars))
120 (or (null? free-vars)
124 (eval (car free-vars) module))
128 "Unresolved free variables in ~A:\n"
131 (write (car free-vars))
133 (set! all-resolved? #f)))
134 (loop (cdr free-vars)))))
137 "No unresolved free variables in ~A\n"
140 (define (scan-file-for-module-name filename)
141 (with-input-from-file filename
143 (let loop ((x (read)))
144 (cond ((eof-object? x) #f)
146 (eq? (car x) 'define-module))
148 (else (loop (read))))))))
150 (define (scan-file-for-free-variables filename)
151 (with-input-from-file filename
153 (let loop ((x (read)) (fvlists '()))
155 (apply append fvlists)
156 (loop (read) (cons (detect-free-variables x '()) fvlists)))))))
158 ; guile> (detect-free-variables '(let ((a 1)) a) '())
160 ; guile> (detect-free-variables '(let ((a 1)) b) '())
162 ; guile> (detect-free-variables '(let ((a 1) (b a)) b) '())
164 ; guile> (detect-free-variables '(let* ((a 1) (b a)) b) '())
166 ; guile> (detect-free-variables '(define a 1) '())
168 ; guile> (detect-free-variables '(define a b) '())
170 ; guile> (detect-free-variables '(define (a b c) b) '())
172 ; guile> (detect-free-variables '(define (a b c) e) '())
175 (define (detect-free-variables x locals)
176 ;; Given an expression @var{x} and a list @var{locals} of local
177 ;; variables (symbols) that are in scope for @var{x}, return a list
178 ;; of free variable symbols.
180 (if (memq x locals) '() (list x)))
184 ((define-module define-generic quote quasiquote)
185 ;; No code of interest in these expressions.
189 ;; Check for named let. If there is a name, transform the
190 ;; expression so that it looks like an unnamed let with
191 ;; the name as one of the bindings.
192 (if (symbol? (cadr x))
193 (set-cdr! x (cons (cons (list (cadr x) #f) (caddr x))
195 ;; Unnamed let processing.
196 (let ((letrec? (eq? (car x) 'letrec))
197 (locals-for-let-body (append locals (map car (cadr x)))))
198 (append (apply append
199 (map (lambda (binding)
200 (detect-free-variables (cadr binding)
206 (map (lambda (bodyform)
207 (detect-free-variables bodyform
208 locals-for-let-body))
212 ;; Handle bindings recursively.
215 (map (lambda (bodyform)
216 (detect-free-variables bodyform locals))
218 (append (detect-free-variables (cadr (caadr x)) locals)
219 (detect-free-variables `(let* ,(cdadr x) ,@(cddr x))
220 (cons (caaadr x) locals)))))
222 ((define define-public define-macro)
225 (set! locals (cons (caadr x) locals))
226 (detect-free-variables `(lambda ,(cdadr x) ,@(cddr x))
229 (set! locals (cons (cadr x) locals))
230 (detect-free-variables (caddr x) locals))))
233 (let ((locals-for-lambda-body (let loop ((locals locals)
235 (cond ((null? args) locals)
237 (loop (cons (car args) locals)
240 (cons args locals))))))
242 (map (lambda (bodyform)
243 (detect-free-variables bodyform
244 locals-for-lambda-body))
248 (let ((locals-for-receive-body (append locals (cadr x))))
250 (detect-free-variables (caddr x) locals)
251 (map (lambda (bodyform)
252 (detect-free-variables bodyform
253 locals-for-receive-body))
256 ((define-method define*)
257 (let ((locals-for-method-body (let loop ((locals locals)
259 (cond ((null? args) locals)
261 (loop (cons (if (pair? (car args))
267 (cons args locals))))))
269 (map (lambda (bodyform)
270 (detect-free-variables bodyform
271 locals-for-method-body))
275 ;; Avoid picking up slot names at the start of slot
278 (map (lambda (slot/option)
279 (detect-free-variables-noncar (if (pair? slot/option)
287 (detect-free-variables (cadr x) locals)
289 (detect-free-variables (cdr case) locals))
292 ((unquote unquote-splicing else =>)
293 (detect-free-variables-noncar (cdr x) locals))
295 (else (append (detect-free-variables (car x) locals)
296 (detect-free-variables-noncar (cdr x) locals)))))
300 (define (detect-free-variables-noncar x locals)
301 ;; Given an expression @var{x} and a list @var{locals} of local
302 ;; variables (symbols) that are in scope for @var{x}, return a list
303 ;; of free variable symbols.
305 (if (memq x locals) '() (list x)))
310 (detect-free-variables-noncar (cdr x) locals))
312 (else (append (detect-free-variables (car x) locals)
313 (detect-free-variables-noncar (cdr x) locals)))))
317 (define (main . files)
318 (for-each lint files))