/[guile]/guile/guile-core/scripts/lint
ViewVC logotype

Diff of /guile/guile-core/scripts/lint

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by ossau, Tue Mar 5 21:34:42 2002 UTC revision 1.2 by ttn, Thu Apr 4 23:56:21 2002 UTC
# Line 0  Line 1 
1    #!/bin/sh
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)))" "$@"
5    !#
6    ;;; lint --- Preemptive checks for coding errors in Guile Scheme code
7    
8    ;;      Copyright (C) 2002 Free Software Foundation, Inc.
9    ;;
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.
14    ;;
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.
19    ;;
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., 59 Temple Place, Suite 330,
23    ;; Boston, MA 02111-1307 USA
24    
25    ;;; Author: Neil Jerram
26    
27    ;;; Commentary:
28    
29    ;; Usage: lint FILE1 FILE2 ...
30    ;;
31    ;; Perform various preemptive checks for coding errors in Guile Scheme
32    ;; code.
33    ;;
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.
37    ;;
38    ;; Unresolved free variables
39    ;; -------------------------
40    ;;
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.
44    ;;
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
48    ;; them forgot to.
49    ;;
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.
56    ;;
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
64    ;; ignored.
65    ;;
66    ;; Example
67    ;; -------
68    ;;
69    ;; Note: most of the unresolved variables found in this example are
70    ;; false positives, as you would hope.  => scope for improvement.
71    ;;
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:
77    ;;         doc-snarf-version
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:
84    ;;         name
85    ;;         pos
86    ;;         line
87    ;;         x
88    ;;         rest
89    ;;         ...
90    ;;         do-argpos
91    ;;         do-command
92    ;;         do-args
93    ;;         type
94    ;;         num
95    ;;         file
96    ;;         do-arglist
97    ;;         req
98    ;;         opt
99    ;;         var
100    ;;         command
101    ;;         do-directive
102    ;;         s
103    ;;         ?
104    ;; No unresolved free variables in use2dot
105    
106    ;;; Code:
107    
108    (define-module (scripts lint)
109      #:use-module (ice-9 common-list)
110      #:use-module (ice-9 format)
111      #:export (lint))
112    
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))
117              (all-resolved? #t))
118          (let loop ((free-vars free-vars))
119            (or (null? free-vars)
120                (begin
121                  (catch #t
122                    (lambda ()
123                      (eval (car free-vars) module))
124                    (lambda args
125                      (if all-resolved?
126                          (format #t
127                                  "Unresolved free variables in ~A:\n"
128                                  filename))
129                      (write-char #\tab)
130                      (write (car free-vars))
131                      (newline)
132                      (set! all-resolved? #f)))
133                  (loop (cdr free-vars)))))
134          (if all-resolved?
135              (format #t
136                      "No unresolved free variables in ~A\n"
137                      filename)))))
138    
139    (define (scan-file-for-module-name filename)
140      (with-input-from-file filename
141        (lambda ()
142          (let loop ((x (read)))
143            (cond ((eof-object? x) #f)
144                  ((and (pair? x)
145                        (eq? (car x) 'define-module))
146                   (cadr x))
147                  (else (loop (read))))))))
148    
149    (define (scan-file-for-free-variables filename)
150      (with-input-from-file filename
151        (lambda ()
152          (let loop ((x (read)) (fvlists '()))
153            (if (eof-object? x)
154                (apply append fvlists)
155                (loop (read) (cons (detect-free-variables x '()) fvlists)))))))
156    
157    ; guile> (detect-free-variables '(let ((a 1)) a) '())
158    ; ()
159    ; guile> (detect-free-variables '(let ((a 1)) b) '())
160    ; (b)
161    ; guile> (detect-free-variables '(let ((a 1) (b a)) b) '())
162    ; (a)
163    ; guile> (detect-free-variables '(let* ((a 1) (b a)) b) '())
164    ; ()
165    ; guile> (detect-free-variables '(define a 1) '())
166    ; ()
167    ; guile> (detect-free-variables '(define a b) '())
168    ; (b)
169    ; guile> (detect-free-variables '(define (a b c) b) '())
170    ; ()
171    ; guile> (detect-free-variables '(define (a b c) e) '())
172    ; (e)
173    
174    (define (detect-free-variables x locals)
175      ;; Given an expression @var{x} and a list @var{locals} of local
176      ;; variables (symbols) that are in scope for @var{x}, return a list
177      ;; of free variable symbols.
178      (cond ((symbol? x)
179             (if (memq x locals) '() (list x)))
180    
181            ((pair? x)
182             (case (car x)
183               ((define-module define-generic quote quasiquote)
184                ;; No code of interest in these expressions.
185                '())
186    
187               ((let letrec)
188                ;; Check for named let.  If there is a name, transform the
189                ;; expression so that it looks like an unnamed let with
190                ;; the name as one of the bindings.
191                (if (symbol? (cadr x))
192                    (set-cdr! x (cons (cons (list (cadr x) #f) (caddr x))
193                                      (cdddr x))))
194                ;; Unnamed let processing.
195                (let ((letrec? (eq? (car x) 'letrec))
196                      (locals-for-let-body (append locals (map car (cadr x)))))
197                  (append (apply append
198                                 (map (lambda (binding)
199                                        (detect-free-variables (cadr binding)
200                                                               (if letrec?
201                                                                   locals-for-let-body
202                                                                   locals)))
203                                      (cadr x)))
204                          (apply append
205                                 (map (lambda (bodyform)
206                                        (detect-free-variables bodyform
207                                                               locals-for-let-body))
208                                      (cddr x))))))
209    
210               ((let* and-let*)
211                ;; Handle bindings recursively.
212                (if (null? (cadr x))
213                    (apply append
214                           (map (lambda (bodyform)
215                                  (detect-free-variables bodyform locals))
216                                (cddr x)))
217                    (append (detect-free-variables (cadr (caadr x)) locals)
218                            (detect-free-variables `(let* ,(cdadr x) ,@(cddr x))
219                                                   (cons (caaadr x) locals)))))
220    
221               ((define define-public define-macro)
222                (if (pair? (cadr x))
223                    (begin
224                      (set! locals (cons (caadr x) locals))
225                      (detect-free-variables `(lambda ,(cdadr x) ,@(cddr x))
226                                             locals))
227                    (begin
228                      (set! locals (cons (cadr x) locals))
229                      (detect-free-variables (caddr x) locals))))
230    
231               ((lambda lambda*)
232                (let ((locals-for-lambda-body (let loop ((locals locals)
233                                                         (args (cadr x)))
234                                                (cond ((null? args) locals)
235                                                      ((pair? args)
236                                                       (loop (cons (car args) locals)
237                                                             (cdr args)))
238                                                      (else
239                                                       (cons args locals))))))
240                  (apply append
241                         (map (lambda (bodyform)
242                                (detect-free-variables bodyform
243                                                       locals-for-lambda-body))
244                              (cddr x)))))
245    
246               ((receive)
247                (let ((locals-for-receive-body (append locals (cadr x))))
248                  (apply append
249                         (detect-free-variables (caddr x) locals)
250                         (map (lambda (bodyform)
251                                (detect-free-variables bodyform
252                                                       locals-for-receive-body))
253                              (cdddr x)))))
254    
255               ((define-method define*)
256                (let ((locals-for-method-body (let loop ((locals locals)
257                                                         (args (cdadr x)))
258                                                (cond ((null? args) locals)
259                                                      ((pair? args)
260                                                       (loop (cons (if (pair? (car args))
261                                                                       (caar args)
262                                                                       (car args))
263                                                                   locals)
264                                                             (cdr args)))
265                                                      (else
266                                                       (cons args locals))))))
267                  (apply append
268                         (map (lambda (bodyform)
269                                (detect-free-variables bodyform
270                                                       locals-for-method-body))
271                              (cddr x)))))
272    
273               ((define-class)
274                ;; Avoid picking up slot names at the start of slot
275                ;; definitions.
276                (apply append
277                       (map (lambda (slot/option)
278                              (detect-free-variables-noncar (if (pair? slot/option)
279                                                                (cdr slot/option)
280                                                                slot/option)
281                                                            locals))
282                            (cdddr x))))
283    
284               ((case)
285                (apply append
286                       (detect-free-variables (cadr x) locals)
287                       (map (lambda (case)
288                              (detect-free-variables (cdr case) locals))
289                            (cddr x))))
290    
291               ((unquote unquote-splicing else =>)
292                (detect-free-variables-noncar (cdr x) locals))
293    
294               (else (append (detect-free-variables (car x) locals)
295                             (detect-free-variables-noncar (cdr x) locals)))))
296    
297            (else '())))
298    
299    (define (detect-free-variables-noncar x locals)
300      ;; Given an expression @var{x} and a list @var{locals} of local
301      ;; variables (symbols) that are in scope for @var{x}, return a list
302      ;; of free variable symbols.
303      (cond ((symbol? x)
304             (if (memq x locals) '() (list x)))
305    
306            ((pair? x)
307             (case (car x)
308               ((=>)
309                (detect-free-variables-noncar (cdr x) locals))
310    
311               (else (append (detect-free-variables (car x) locals)
312                             (detect-free-variables-noncar (cdr x) locals)))))
313    
314            (else '())))
315    
316    (define (main . files)
317      (for-each lint files))
318    
319    ;;; lint ends here

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26