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
))