Commit | Line | Data |
---|---|---|
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 |