don't autocompile while snarfing
[bpt/guile.git] / libguile / guile-func-name-check
CommitLineData
6832604e
TTN
1;;; guile-func-name-check -*- scheme -*-
2
3;; Copyright (C) 2000, 2001, 2006, 2010 Free Software Foundation, Inc.
4;;
5;; This program is free software; you can redistribute it and/or modify
6;; it under the terms of the GNU Lesser General Public License as
7;; published by the Free Software Foundation; either version 3, or (at
8;; your option) any later version.
9;;
10;; This program is distributed in the hope that it will be useful, but
11;; WITHOUT ANY WARRANTY; without even the implied warranty of
12;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13;; Lesser General Public License for more details.
14;;
15;; You should have received a copy of the GNU Lesser General Public
16;; License along with this software; see the file COPYING.LESSER. If
17;; not, write to the Free Software Foundation, Inc., 51 Franklin
18;; Street, Fifth Floor, Boston, MA 02110-1301 USA
19
20;;; Commentary:
21
22;; This is a Guile Scheme script based on the AWK script
23;; originally by Greg J. Badros <gjb@cs.washington.edu>.
24;; It has the following improvements:
25;; - handle inhibition directives
26;; - ignore a string literal ‘FUNC_NAME’
27;; - on error, exit failurefully (after file is scanned)
28;; - written in Scheme :-D
29
30;;; Code:
31
32(use-modules
33 ((ice-9 regex) #:select (match:substring
34 match:end))
35 ((ice-9 rdelim) #:select (read-line)))
36
37(define fse ; "format string to error-port"
38 (let ((cep (current-error-port)))
39 (lambda (s . args)
40 (apply simple-format cep s args))))
41
42;; Global non-procedure variables have LOUD names.
43(define FILENAME (cadr (command-line)))
44(define FUNC-NAME "")
45(define IN-A-FUNC? #f)
46(define INHIBIT? #f)
47(define LAST-LINE #f)
48(define NEXT-LINE-BETTER-BE-UNDEF #f)
49(define EXIT-VALUE #t)
50
51(define (fatal lno s . args)
52 (fse "~A:~A:*** " FILENAME lno)
53 (apply fse s args)
54 (fse "~%")
55 (set! EXIT-VALUE #f))
56
57(define MOE "Missing or erroneous") ; constant
58
59;; By default, processing is uninhibited. In the scanned file, the comment:
60;; /* guile-func-name-check: TEXT */
61;; inhibits processing if TEXT is anything but "ok", and displays TEXT to stderr.
62;; This is used in pairs.c, for example.
63(define check-directive
64 (let ((rx (make-regexp "^.. guile-func-name-check: (.+) ..$")))
65 (lambda (line lno)
66 (and=> (regexp-exec rx line)
67 (lambda (m)
68 (set! INHIBIT? (not (string=? "ok" (match:substring m 1))))
69 (fse "~A:~A: ~A~%" FILENAME lno
70 (substring line 3 (match:end m 1))))))))
71
72;; Extract the function name from "SCM_DEFINE (foo, ...".
73;; FIXME: This loses if the open paren is on the next line.
74(define check-SCM_DEFINE
75 (let ((rx (make-regexp "^SCM_DEFINE *.([^,]+)")))
76 (lambda (line)
77 (and=> (regexp-exec rx line)
78 (lambda (m)
79 (set! FUNC-NAME (match:substring m 1))
80 (or INHIBIT? (set! IN-A-FUNC? #t)))))))
81
82;; Check that for "SCM_DEFINE (foo, ...)", we see:
83;; #define FUNC_NAME s_foo
84;; {
85;; FIXME: This loses if #define is inside the curly brace.
86(define check-curly-open
87 (let ((rx-curly (make-regexp "^\\{"))
88 (rx-string (make-regexp "\".+\""))
89 (rx-hash-define (make-regexp "^#define[ \t]+FUNC_NAME[ \t]+s_([^ \t]+)")))
90 (define (proper)
91 (string-append "#define FUNC_NAME s_" FUNC-NAME))
92 (lambda (line lno)
93 (and=> (and IN-A-FUNC? (regexp-exec rx-curly line))
94 (lambda (m)
95 (cond
96 ((regexp-exec rx-string LAST-LINE)
97 ;; Do nothing for C string-literal:
98 ;; #define FUNC_NAME "foo"
99 )
100 ((regexp-exec rx-hash-define LAST-LINE)
101 ;; Found a well-formed #define, but does its name match?
102 => (lambda (m)
103 (or (string=? (match:substring m 1) FUNC-NAME)
104 (fatal lno "Mismatching FUNC_NAME. Should be: `~A'"
105 (proper)))))
106 (else
107 (fatal lno "~A `~A'" MOE (proper)))))))))
108
109;; If previous line closed the function, check that we see "#undef FUNC_NAME".
110;; FIXME: This loses if #undef is inside the curly brace.
111(define check-undef
112 (let ((rx (make-regexp "^#undef FUNC_NAME[ \t]*$")))
113 (lambda (line lno)
114 (cond (NEXT-LINE-BETTER-BE-UNDEF
115 (or (regexp-exec rx line)
116 (fatal lno "~A #undef for ~A: Got `~A' instead."
117 MOE FUNC-NAME line))
118 (set! IN-A-FUNC? #f)
119 (set! FUNC-NAME "")
120 (set! NEXT-LINE-BETTER-BE-UNDEF #f))))))
121
122;; Note function closing.
123(define check-curly-close
124 (let ((rx (make-regexp "^\\}")))
125 (lambda (line)
126 (and IN-A-FUNC? (regexp-exec rx line)
127 (set! NEXT-LINE-BETTER-BE-UNDEF #t)))))
128
129;; The main loop.
130(let ((p (open-input-file FILENAME)))
131 (let loop ((lno 1))
132 (let ((line (read-line p)))
133 (or (eof-object? line)
134 (begin (check-directive line lno)
135 (check-SCM_DEFINE line)
136 (check-curly-open line lno)
137 (check-undef line lno)
138 (check-curly-close line)
139 ;; Remember this line for the next cycle.
140 (set! LAST-LINE line)
141 (loop (1+ lno))))))
142 (close-port p))
143
144(exit EXIT-VALUE)
145
146;;; guile-func-name-check ends here