#!/usr/bin/guile \
-e "(scripts lint)" -s
!#
;;; lint --- Preemptive checks for coding errors in Guile Scheme code

;; 	Copyright (C) 2002,2003,2004,2005 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., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;
;; As a special exception, the Free Software Foundation gives permission
;; for additional uses of the text contained in its release of GUILE.
;;
;; The exception is that, if you link the GUILE library with other files
;; to produce an executable, this does not by itself cause the
;; resulting executable to be covered by the GNU General Public License.
;; Your use of that executable is in no way restricted on account of
;; linking the GUILE library code into it.
;;
;; This exception does not however invalidate any other reasons why
;; the executable file might be covered by the GNU General Public License.
;;
;; This exception applies only to the code released by the
;; Free Software Foundation under the name GUILE.  If you copy
;; code from other Free Software Foundation releases into a copy of
;; GUILE, as the General Public License permits, the exception does
;; not apply to the code that you add in this way.  To avoid misleading
;; anyone as to the status of such modified files, you must delete
;; this exception notice from them.
;;
;; If you write modifications of your own for GUILE, it is your choice
;; whether to permit this exception to apply to your modifications.
;; If you do not wish that, delete this exception notice.

;;; Author: Thien-Thi Nguyen <ttn@gnu.org>
;;; (completely rewritten from code originally by: Neil Jerram)

;;; Commentary:

;; Usage: lint [options] FILE1 FILE2 ...
;;
;; Perform various preemptive checks for coding errors in Guile Scheme
;; code.  Options are:
;;
;;  -m, --module NAME  -- use NAME as the module name, for files
;;                        that do not have a `define-module' form;
;;                        default: `(guile-user)'
;;
;; Here are the available checks (in order of application):
;;
;;  *exists
;;  *readable
;;  *topsyn
;;  *borders
;;   freevars
;;   unused
;;
;; The * means that if the check fails, lint skips further tests.
;; The rest of this help message explains the checks in more detail.
;;
;;
;; Readability
;; -----------
;;
;; This checks for file readability as well as the absense of `#.'
;; (hash-dot) reader macros, which is a risky practice.
;;
;;
;; Top-level syntax
;; ----------------
;;
;; This checks for a shell-script header (recognized when the first two
;; characters of the file are "#!" and a later line begins with "!#"),
;; and also that the top-level forms can be `read' without syntax error.
;;
;;
;; Imports and exports
;; -------------------
;;
;; This checks #:autoload and #:use-module clauses in a `define-module'
;; form, as well as top-level `use-modules' forms.  For autoloads, each
;; trigger is checked against the module's exports list.  For the other
;; forms, referenced bindings from the #:select sub-clause are checked
;; against the module's exports list.
;;
;;
;; Unresolved free variables
;; -------------------------
;;
;; Unresolved free variables are symbols that have no binding in any of
;; the environments in which it could be defined.  Relevant environments
;; start with the smallest (closest) scope defined by `lambda' and
;; friends, and move outward, to include the top-level forms "in" the
;; module (if the file has a `define-module' form); in the file; in the
;; interface imported from upstream modules; and finally, in the base
;; (also called the "builtin") environment that Guile itself provides.
;;
;; It isn't guaranteed that the scan will find absolutely all such
;; errors.  Quoted expressions are skipped, so code that is explicitly
;; evaluated using `eval' will not be checked.  For example, in the
;; form: `(eval-in-module 'missing (current-module))', `missing' 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'.
;;
;;
;; Unused definitions
;; ------------------
;;
;; This checks for definitions that are not used anywhere, either
;; internally, or exported, or named as the shell-script header
;; entry-point (via "guile -e ENTRY-POINT").
;;
;;
;; Usage from a Scheme program:
;;   (lint filename [tests...]) => alist
;;
;; TESTS, a list of symbols, specifies tests to run.  If omitted,
;; run all tests.  ALIST maps each test name to its result.

;;; Code:

(define-module (scripts lint)
  #:use-module ((ice-9 known-names) #:select (known?))
  #:use-module ((scripts generate-autoload) #:select (module-name/exports))
  #:use-module ((ice-9 mapping) #:select (hash-table-mapping
                                          mapping-ref
                                          mapping-set!))
  #:autoload (ice-9 regex) (string-match)
  #:autoload (ice-9 editing-buffer) (editing-buffer)
  #:autoload (scripts PROGRAM) (HVQC-MAIN)
  #:autoload (ice-9 common-list) (uniq remove-if find-if)
  #:use-module (ice-9 format)
  #:export (lint))

;; naming conventions:
;; - filename properties begin with "F:"
;; - procedures named in *tests* begin with "check-" or ">>"

(define F:shell-script-header (make-object-property))

(define (check-readability filename)
  ;; For safety, do textual checks before actually applying `read'.
  (and (access? filename R_OK)
       (editing-buffer (open-input-file filename)
         (goto-char (point-min))
         (and
          ;; shell script header
          (or (not (looking-at "#!"))
              (and (re-search-forward "^!#\n" (point-max) #t)
                   (begin (set! (F:shell-script-header filename) ; save
                                (buffer-substring (point-min) (point)))
                          (delete-region (point-min) (point))
                          #t)))
          ;; full-line comments
          (let loop ()
            (cond ((re-search-forward "^[ \t]*;.*$" (point-max) #t)
                   (replace-match "")
                   (loop))
                  (else #t)))
          ;; strings
          (goto-char (point-min))
          (let ((p (buffer-port)))
            (let loop ()
              (or (not (re-search-forward "[^\\][\"]" (point-max) #t))
                  (let ((beg (1- (point))))
                    (forward-char -1)
                    (and (string? (read p))
                         (begin (delete-region (1+ beg) (1- (point)))
                                (loop)))))))
          ;; trailing-line comments
          (goto-char (point-min))       ; like this one
          (let loop ()
            (or (not (re-search-forward ";.*$" (point-max) #t))
                (begin (replace-match "")
                       (loop))))
          ;; hash-dot
          (goto-char (point-min))
          (not (search-forward "#." (point-max) #t))))))

(define F:forms (make-object-property))

(define (check-top-syntax filename)
  (false-if-exception
   (and (or (not (F:shell-script-header filename))
            ;; todo: check shell-script header syntax
            #t)
        (let ((p (open-input-file filename))
              (box (list #f)))
          (let loop ((form (read p)) (tp box) (count 0))
            (cond ((eof-object? form)
                   (close-port p)
                   (set! (F:forms filename) (cdr box)) ; save
                   count)                              ; rv
                  (else
                   (set-cdr! tp (list form))
                   (loop (read p) (cdr tp) (1+ count)))))))))

(define F:borders (make-object-property))

(define cached-module-name/exports
  (let ((m (hash-table-mapping)))
    (lambda (name)
      (or (mapping-ref m name)
          (mapping-set! m name (or (module-name/exports name)
                                   (list #f #f)))))))

(define (check-borders filename)        ; imports and exports
  (let* ((forms (F:forms filename))
         (mdef (find-if (lambda (x)
                          (and (pair? x)
                               (eq? 'define-module (car x))))
                        forms))
         (mname (and mdef (cadr mdef)))
         (umods '())                    ; upstream modules
         (blind '())                    ; umods lacking exports info
         (imports '())                  ; SEEN or (ORIG . SEEN)
         (exports '())
         (problems '())                 ; (TYPE FSTR . FDATA)
         (om (make-object-property)))   ; originating module

    (define (prob! type fstr . fdata)
      (set! problems (cons (list type fstr fdata) problems)))

    (define (note-import! module-name prefix refs)
      (let ((info (cached-module-name/exports module-name)))
        (cond ((equal? module-name (car info))
               (let ((avail (list-ref info 1)))
                 (if refs
                     (for-each (lambda (ref)
                                 (let ((expect (if (pair? ref)
                                                   (car ref)
                                                   ref)))
                                   (or (memq expect avail)
                                       (prob! #:not-avail
                                              "~S does not export `~S'"
                                              module-name expect))))
                               refs)
                     (set! refs avail))))
              (else
               (prob! #:exports-unknown
                      "WARNING: exports unknown for module ~S"
                      module-name)
               (set! blind (cons module-name blind))
               (set! refs (or refs '())))))
      (for-each (lambda (ref)
                  (let ((seen (let ((stem (if (pair? ref)
                                              (cdr ref)
                                              ref)))
                                (if prefix
                                    (symbol-append prefix stem)
                                    stem))))
                    (set! (om seen) module-name)
                    (set! imports (cons seen imports))))
                refs)
      (set! umods (cons module-name umods)))

    (define (scan-use-module-spec! spec)
      (if (pair? (car spec))
          (note-import! (car spec)
                        (let search-prefix ((ls (cdr spec)))
                          (and (not (null? ls))
                               (case (car ls)
                                 ((#:renamer :renamer)
                                  (let ((how (cadr ls)))
                                    (and (pair? how)
                                         (eq? 'symbol-prefix-proc (car how))
                                         (pair? (cadr how))
                                         (eq? 'quote (car (cadr how)))
                                         (cadr (cadr how)))))
                                 ((#:prefix :prefix)
                                  (cadr ls))
                                 (else
                                  (search-prefix (cdr ls))))))
                        (let search-refs ((ls (cdr spec)))
                          (and (not (null? ls))
                               (case (car ls)
                                 ((#:select :select)
                                  (cadr ls))
                                 (else
                                  (search-refs (cdr ls)))))))
          (note-import! spec #f #f)))

    (define (note-exports! names)
      (set! exports (append exports names)))

    (and mdef
         (let loop ((ls (cddr mdef)))
           (or (null? ls)
               (case (car ls)
                 ((#:use-module :use-module)
                  (scan-use-module-spec! (cadr ls))
                  (loop (cddr ls)))
                 ((#:autoload :autoload)
                  (let ((triggers (caddr ls)))
                    (note-import! (cadr ls) #f #f)
                    (or (memq (cadr ls) blind)
                        (for-each (lambda (trigger)
                                    (or (memq trigger imports)
                                        (prob! #:bad-trigger
                                               "trigger ~A not found in\n~S"
                                               trigger imports)))
                                  triggers)))
                  (loop (cdddr ls)))
                 ((#:export :export #:export-syntax :export-syntax)
                  (note-exports! (cadr ls))
                  (loop (cddr ls)))
                 (else
                  (loop (cdr ls)))))))

    (for-each (lambda (form)
                (and (pair? form)
                     (case (car form)
                       ((define-public)
                        (let loop ((it (cadr form)))
                          (if (symbol? it)
                              (note-exports! (list it))
                              (loop (car it)))))
                       ((defmacro-public)
                        (note-exports! (list (cadr form))))
                       ((export)
                        (note-exports! (cdr form)))
                       ((use-modules)
                        (for-each scan-use-module-spec! (cdr form))))))
              forms)

    (set! (F:borders filename)
          (vector om                    ; 0
                  umods                 ; 1
                  imports               ; 2
                  exports               ; 3
                  mname                 ; 4
                  problems))))          ; 5

(define (>>borders filename results)
  (for-each (lambda (problem)
              (apply-to-args
               problem (lambda (type fstr fdata)
                         (apply simple-format #t
                                (string-append "~A: " fstr "\n")
                                filename fdata))))
            (vector-ref results 5)))

(define *default-module-name* '(guile-user))

(define (oe? object)
  (hash-table? object))

(define (oe:new!)                       ; one environment (scope)
  (make-hash-table #:size 31))

(define (oe:add! oe symbol)
  (hashq-set! oe symbol 0))

(define (oe:in? oe symbol)
  (hashq-ref oe symbol))

(define (oe:inc! oe symbol)
  (hashq-set! oe symbol (1+ (hashq-ref oe symbol))))

(define nick (make-object-property))

(define F:environments (make-object-property))

(define (collect ls mogrify)
  ;; This proc is similar to `pick-mappings' in (ice-9 common-list),
  ;; except that args are inverted, order is maintained, and improper
  ;; lists are handled.
  (let ((box (list #f)))
    (let loop ((ls ls) (tp box))
      (if (null? ls)
          (cdr box)                     ; rv
          (let* ((p? (pair? ls))
                 (next (if p? (cdr ls) '()))
                 (item (mogrify (if p? (car ls) ls))))
            (loop next (cond ((not item) tp)
                             (else (set-cdr! tp (list item))
                                   (cdr tp)))))))))

(define (scan-file-for-free-variables filename)

  (define (newenv id inits env)
    (let ((oe (oe:new!)))
      (set! (nick oe) id)
      (set! (F:environments filename)
            (acons oe env (F:environments filename)))
      (for-each (lambda (symbol)
                  (oe:add! oe symbol))
                inits)
      (cons oe env)))

  (define (memenv? symbol env)
    (or-map (lambda (oe)
              (and (oe:in? oe symbol) oe))
            env))

  (define (app! ls)
    (apply append! ls))

  (define (a1p! one ls)
    (app! (cons one ls)))

  (define (procedure?/name x)
    (and (pair? x)
         (memq (car x) '(define define-public)) ; todo: generalize
         (pair? (cdr x))
         (let* ((rest (cdr x))
                (name (car rest)))
           (if (symbol? name)
               (letrec ((ltu?           ;-D lambda the ultimate
                         (lambda (form)
                           (and (pair? form)
                                (< 2 (length form))
                                (case (car form)
                                  ((let let* letrec)
                                   (ltu? (car (last-pair form))))
                                  ((lambda lambda*) #t)
                                  (else #f))))))
                 (and (ltu? (cadr rest))
                      name))
               (let loop ((name (car name)))
                 (if (symbol? name)
                     name
                     (loop (car name))))))))

  (define (dfv x locals)                ; detect free variables

    (define (ext id new)
      (newenv id (if (symbol? new) (list new) new) locals))

    (define (iseq id forms new)         ; internal (non top-level)
      (seq forms (if (and (not (null? new))
                          (oe? (car new)))
                     new                ; extension already done
                     (ext id new))      ; extend now
           (let ((first? #t)
                 (acceptable? #t))
             ;; Ignore internal `define' forms not at scope beginning.
             (lambda (form)
               (and acceptable?
                    (let ((name (procedure?/name form)))
                      (or name
                          ;; Allow for one "standard internal docstring".
                          (and first? (string? form))
                          (set! acceptable? #f))
                      (set! first? #f)
                      name))))))

    (define (dfv/recurse)
      (app! (collect x (lambda (form)
                         (let ((fv (dfv form locals)))
                           (and (not (null? fv))
                                fv))))))

    (define (formal-names from)
      (collect (from x) (lambda (formal)
                          (and (not (keyword? formal))
                               (if (pair? formal)
                                   (car formal)
                                   formal)))))

    (define (->id)
      (or (nick x)
          (symbol->keyword (car x))))

    (cond ((symbol? x)
           (cond ((memenv? x locals)
                  => (lambda (oe)
                       (oe:inc! oe x)
                       '()))
                 ((memq x (vector-ref (F:borders filename) 2))
                  '())
                 ((known? (symbol->string x))
                  '())
                 (else
                  (list x))))

          ((and (pair? x) (symbol? (car x)))
           (case (car x)
             ((define-module use-modules define-generic quote)
              ;; No code of interest in these expressions.
              '())

             ((quasiquote)
              (letrec ((dfv/first-un
                        (lambda (form)
                          (cond ((and (pair? form)
                                      (pair? (cdr form))
                                      (memq (car form)
                                            '(unquote unquote-splicing)))
                                 (dfv (cadr form) locals))
                                ((pair? form)
                                 (app! (collect form dfv/first-un)))
                                (else
                                 '())))))
                (dfv/first-un (cadr x))))

             ((let)
              ;; 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.
              (and (symbol? (cadr x))
                   (set-cdr! x (cons (cons (list (cadr x) #f) (caddr x))
                                     (cdddr x))))
              ;; Unnamed let processing.
              (let ((letvars (map car (cadr x))))
                (append (app! (map (lambda (binding)
                                     (dfv (cadr binding) locals))
                                   (cadr x)))
                        (iseq (->id) (cddr x) letvars))))

             ((letrec)
              ;; Construct an environment accessible from the binding values
              ;; as well as from the body.  The "r" stands for "recursive".
              (let* ((rvars (map car (cadr x)))
                     (renv (ext (->id) rvars)))
                (append (app! (map (lambda (binding)
                                     (dfv (cadr binding) renv))
                                   (cadr x)))
                        (iseq (->id) (cddr x) renv))))

             ((let* and-let*)
              ;; Handle bindings recursively.
              (let ((bindings (cadr x)))
                (if (pair? bindings)
                    (append (dfv (cadr (car bindings)) locals)
                            (dfv `(let* ,(cdr bindings) ,@(cddr x))
                                 (ext (->id) (caar bindings))))
                    (iseq (->id) (cddr x) '()))))

             ((defmacro defmacro-public)
              (iseq (cadr x) (cdddr x) (formal-names caddr)))

             ((define define-public define-macro)
              (dfv (if (pair? (cadr x))
                       (let* ((call-proto (cadr x))
                              (supposed-name (car call-proto))
                              (extra (let loop ((call (list supposed-name)))
                                       (if (symbol? (car call))
                                           (collect (cdr call)
                                                    (lambda (x)
                                                      (and (symbol? x) x)))
                                           (loop (car call)))))
                              (proc `(lambda ,(append extra (cdr call-proto))
                                       ,@(cddr x))))
                         (set! (nick proc) (let loop ((name supposed-name))
                                             (if (symbol? name)
                                                 name
                                                 (loop (car name)))))
                         proc)
                       (let ((form (caddr x)))
                         (set! (nick form) (cadr x))
                         form))
                   locals))

             ((lambda lambda*)
              (iseq (->id) (cddr x) (formal-names cadr)))

             ((receive)
              (append (dfv (caddr x) locals)
                      (iseq (->id) (cdddr x) (formal-names cadr))))

             ((define-method define* define*-public)
              (iseq (->id) (cddr x) (formal-names cdadr)))

             ((define-class)
              ;; Avoid picking up slot names at the start of slot
              ;; definitions.
              (app! (map (lambda (slot/option)
                           (dfv (if (pair? slot/option)
                                    (cdr slot/option)
                                    slot/option)
                                locals))
                         (cdddr x))))

             ((case)
              (a1p! (dfv (cadr x) locals)
                    (map (lambda (case)
                           (dfv (cdr case) locals))
                         (cddr x))))

             ((cond)
              (app! (map (lambda (sub)
                           (append (let ((condition (car sub)))
                                     (if (eq? 'else condition)
                                         '()
                                         (dfv condition locals)))
                                   (let ((actions (cdr sub)))
                                     (cond ((not (pair? actions))
                                            (dfv actions locals))
                                           ((eq? '=> (car actions))
                                            (dfv (cadr actions) locals))
                                           (else
                                            (dfv actions locals))))))
                         (cdr x))))

             ((do)
              (let* ((bindings (cadr x))
                     (do/locals (ext (->id) (map car bindings)))
                     (do/dfv (lambda (forms)
                               (app! (map (lambda (form)
                                            (dfv form do/locals))
                                          forms)))))
                (append (app! (map (lambda (binding)
                                     (append!
                                      ;; init part
                                      (dfv (cadr binding) locals)
                                      ;; (optional) next part
                                      (if (pair? (cddr binding))
                                          (do/dfv (caddr binding))
                                          '())))
                                   bindings))
                        (do/dfv (caddr x))
                        (do/dfv (cdddr x)))))

             ((unquote unquote-splicing)
              (dfv (cadr x) locals))

             (else (dfv/recurse))))

          ((pair? x)
           (dfv/recurse))

          (else '())))

  (define (seq forms env relevant)
    (for-each (lambda (name)
                (oe:add! (car env) name))
              (collect forms relevant))
    (app! (map (lambda (x)
                 (dfv x env))
               forms)))

  ;; do it!
  (set! (F:environments filename) '())  ; simple list
  (seq (F:forms filename)
       (newenv #:top-level '() '())
       (lambda (form)
         (or (procedure?/name form)
             (and (pair? form)
                  (case (car form)      ; todo: generalize
                    ((define define-public defmacro)
                     (and (symbol? (cadr form))
                          (cadr form)))
                    ((define-macro)
                     (and (symbol? (caadr form))
                          (caadr form)))
                    (else #f)))))))

(define (check-free-variables filename)
  (let ((vars (uniq (scan-file-for-free-variables filename)))
        (top-oe (caar (last-pair (F:environments filename)))))
    (define (ref! s)
      (let ((symbol (if (symbol? s) s (string->symbol s))))
        (if (oe:in? top-oe symbol)
            (oe:inc! top-oe symbol)
            (set! vars (cons symbol vars)))))
    (for-each ref! (vector-ref (F:borders filename) 3))
    (and=> (vector-ref (F:borders filename) 4)
           (lambda (module-name)
             (let* ((full (format #f "~S" module-name))
                    (part (substring full 1 (1- (string-length full))))
                    (m? (and=> (F:shell-script-header filename)
                               (lambda (header)
                                 (lambda (pattern)
                                   (string-match (format #f pattern part)
                                                 header))))))
               (cond ((not m?))
                     ((m? "-e ['\"]\\(~A\\)['\"]")
                      (ref! "main"))
                     ((m? "-e ['\"]\\(~A\\) ([^'\" ]+)['\"]")
                      => (lambda (m)
                           (ref! (match:substring m 1))))))))
    vars))

(define (>>freevars filename vars)
  (let ((count (length vars)))
    (or (= 0 count)
        (format #t "~A: ~A unresolved free variable~P\n"
                filename (case count
                           ((0) "no")
                           ((1) "one")
                           (else count))
                count)))
  (format #t "~{\t~A\n~}" vars))

(define (check-lonely-refs filename)
  (collect (F:environments filename)
           (lambda (env)
             (let ((unused (hash-fold (lambda (k v sofar)
                                        (if (zero? v)
                                            (cons k sofar)
                                            sofar))
                                      '() (car env))))
               (and (not (null? unused))
                    (cons unused (map nick env)))))))

(define (>>lonely filename result)
  (let ((vcount (apply + (map length (map car result))))
        (ecount (length result)))
    (or (= 0 vcount)
        (format #t "~A: ~A unused binding~P in ~A environment~P\n"
                filename
                vcount vcount
                ecount ecount)))
  (for-each (lambda (res)
              (let ((path (reverse!
                           (collect (cdr res)
                                    (lambda (name)
                                      (and (symbol? name) name))))))
                (format #t "\t~S: ~{`~A'~^, ~}\n"
                        (if (null? path)
                            'top-level
                            path)
                        (car res))))
            result))

;; selection

(define *tests*
  `((exists   #t ,file-exists? #f)
    (readable #t ,check-readability #f)
    (topsyn   #t ,check-top-syntax #f)
    (borders  #t ,check-borders ,>>borders)
    (freevars #f ,check-free-variables ,>>freevars)
    (unused   #f ,check-lonely-refs ,>>lonely)))

(define t:fatal?  car)
(define t:proc    cadr)
(define t:report  caddr)

(define (lint filename . tests)
  (let ((no-worries #t))
    (map (lambda (name)
           (cons name
                 (cond ((assq-ref *tests* name)
                        => (lambda (ent)
                             (let ((res (and no-worries
                                             ((t:proc ent) filename))))
                               (and (t:fatal? ent)
                                    (not res)
                                    no-worries
                                    (begin
                                      (simple-format
                                       #t "~A: fatal result for test `~A'\n"
                                       filename name)
                                      (set! no-worries #f)))
                               res)))
                       (else
                        "no such test"))))
         (if (null? tests)
             (map car *tests*)
             tests))))

;; output driver

(define (lint-main . files)
  (for-each (lambda (filename)
              (for-each
               (lambda (res)
                 (let* ((entry (assq-ref *tests* (car res)))
                        (report (t:report entry))
                        (results (cdr res)))
                   (and report results (report filename results))))
               (lint filename)))
            files))

(define (main args)
  (HVQC-MAIN args (lambda (qop)
                    (qop 'module (lambda (s)
                                   (set! *default-module-name*
                                         (with-input-from-string s read))))
                    (apply lint-main (qop '())))
             '(usage . commentary)
             '(package . "Guile")
             '(option-spec (module (single-char #\m) (value #t)))))

;;; lint ends here
