Tool for detecting unresolved free variables

[Neil Jerram]

Here's a useful tool.  It scans code for unresolved free variables -
i.e. names for which you are probably missing a `#:use-module' in your
`define-module' form, or for which the module that is supposed to
export them forgot to.

No guarantees, of course; both false negatives and false positives are
possible.  (Examples... you can get a false negative because the tool
jumps over quoted expressions, so the `unresolved-var' in `(eval
'unresolved-var (current-module))' would be missed; you can get a
false positive because the tool doesn't understand all possible forms
of implicit quoting - in particular, it doesn't expand macro usages -
and because of oddities like `next-method'.)

But it's already found a good number of true positives for me as well,
which is useful.  (Otherwise, of course, you only find out at runtime
when the erroneous code is evaluated, which could be in the middle of
something important.)

Code is appended; here's how I've been using it:

(use-modules (ossau scan-dependencies))
(for-each scan-dependencies
          '("/home/neil/Guile/guile-debugger/ossau/behaviour.scm"
            "/home/neil/Guile/guile-debugger/ossau/breakpoints.scm"
            "/home/neil/Guile/guile-debugger/ossau/breakpoints/procedural.scm"
            "/home/neil/Guile/guile-debugger/ossau/breakpoints/range.scm"
            "/home/neil/Guile/guile-debugger/ossau/breakpoints/source.scm"
            "/home/neil/Guile/guile-debugger/ossau/command-loop.scm"
            "/home/neil/Guile/guile-debugger/ossau/context.scm"
            "/home/neil/Guile/guile-debugger/ossau/debug-stack.scm"
            "/home/neil/Guile/guile-debugger/ossau/debugger.scm"
            "/home/neil/Guile/guile-debugger/ossau/filesys.scm"
            "/home/neil/Guile/guile-debugger/ossau/fns.scm"
            
"/home/neil/Guile/guile-debugger/ossau/ice-9-debugger-extensions.scm"
            "/home/neil/Guile/guile-debugger/ossau/interactive.scm"
            
"/home/neil/Guile/guile-debugger/ossau/interactive/core-handlers.scm"
            "/home/neil/Guile/guile-debugger/ossau/interactive/utils.scm"
            "/home/neil/Guile/guile-debugger/ossau/trace.scm"
            "/home/neil/Guile/guile-debugger/ossau/traps.scm"))

Output looks like this:

No unresolved free variables in 
/home/neil/Guile/guile-debugger/ossau/behaviour.scm
No unresolved free variables in 
/home/neil/Guile/guile-debugger/ossau/breakpoints.scm
No unresolved free variables in 
/home/neil/Guile/guile-debugger/ossau/breakpoints/procedural.scm
No unresolved free variables in 
/home/neil/Guile/guile-debugger/ossau/breakpoints/range.scm
Unresolved free variables in 
/home/neil/Guile/guile-debugger/ossau/breakpoints/source.scm:
        next-method
Unresolved free variables in 
/home/neil/Guile/guile-debugger/ossau/command-loop.scm:
        call-with-readline-completion-function
No unresolved free variables in 
/home/neil/Guile/guile-debugger/ossau/context.scm
No unresolved free variables in 
/home/neil/Guile/guile-debugger/ossau/debug-stack.scm
Unresolved free variables in /home/neil/Guile/guile-debugger/ossau/debugger.scm:
        user-error
        display-position
No unresolved free variables in 
/home/neil/Guile/guile-debugger/ossau/filesys.scm
No unresolved free variables in /home/neil/Guile/guile-debugger/ossau/fns.scm
Unresolved free variables in 
/home/neil/Guile/guile-debugger/ossau/ice-9-debugger-extensions.scm:
        state-stack
        state-index
        display-position
        write-frame-short
No unresolved free variables in 
/home/neil/Guile/guile-debugger/ossau/interactive.scm
No unresolved free variables in 
/home/neil/Guile/guile-debugger/ossau/interactive/core-handlers.scm
No unresolved free variables in 
/home/neil/Guile/guile-debugger/ossau/interactive/utils.scm
No unresolved free variables in /home/neil/Guile/guile-debugger/ossau/trace.scm
No unresolved free variables in /home/neil/Guile/guile-debugger/ossau/traps.scm

Comments and improvements gratefully received!

        Neil


(define-module (ossau scan-dependencies)
  #:use-module (ice-9 format)
  #:export (scan-dependencies))

(define (scan-dependencies filename)
  (let ((module-name (scan-file-for-module-name filename))
        (free-vars (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)
            ;; 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)))))

           ((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 (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 (cdr x) locals))

           (else (append (detect-free-variables (car x) locals)
                         (detect-free-variables (cdr x) locals)))))

        (else '())))

;;; (ossau scan-dependencies) ends here.