1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
|
# Copyright (C) 1999, 2000, 2001, 2006 Free Software Foundation, Inc.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU Lesser General Public License as
# published by the Free Software Foundation; either version 3, 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
# Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser General Public
# License along with this software; see the file COPYING.LESSER. If
# not, write to the Free Software Foundation, Inc., 51 Franklin
# Street, Fifth Floor, Boston, MA 02110-1301 USA
#
# Written by Greg J. Badros, <gjb@cs.washington.edu>
# 12-Dec-1999
BEGIN { FS="|";
dot_doc_file = ARGV[1]; ARGV[1] = "-";
std_err = "/dev/stderr";
# be sure to put something in the files to help make out
print "";
printf "" > dot_doc_file;
}
/^[ \t]*SCM_SNARF_INIT_START/ { copy = $0;
gsub(/[ \t]*SCM_SNARF_INIT_START/, "", copy);
gsub(/SCM_SNARF_DOC_START.*$/, "", copy);
print copy; }
/SCM_SNARF_DOC_START/,/SCM_SNARF_DOCSTRING_START/ { copy = $0;
if (match(copy,/SCM_SNARF_DOC_STARTR/)) { registering = 1; }
else {registering = 0; }
gsub(/.*SCM_SNARF_DOC_START./,"", copy);
gsub(/SCM_SNARF_DOCSTRING_START.*/,"",copy);
gsub(/[ \t]+/," ", copy);
sub(/^[ \t]*/,"(", copy);
gsub(/\"/,"",copy);
sub(/\([ \t]*void[ \t]*\)/,"()", copy);
sub(/ \(/," ",copy);
numargs = gsub(/SCM /,"", copy);
numcommas = gsub(/,/,"", copy);
numactuals = $2 + $3 + $4;
location = $5;
gsub(/\"/,"",location);
sub(/^[ \t]*/,"",location);
sub(/[ \t]*$/,"",location);
sub(/: /,":",location);
sub(/^\.\//,"",location);
# Now whittle copy down to just the $1 field
# (but do not use $1, since it hasn't been
# altered by the above regexps)
gsub(/[ \t]*\|.*$/,"",copy);
sub(/ \)/,")",copy);
# Now `copy' contains the nice scheme proc "prototype", e.g.
# (set-car! pair value)
# Since this is destined to become Texinfo source,
# quote any `@'s that occur in the prototype.
gsub(/\@/,"@@",copy);
# print copy > "/dev/stderr"; # for debugging
sub(/^\(/,"",copy);
sub(/\)[ \t]*$/,"",copy);
proc_and_args = copy;
curr_function_proto = copy;
proc_name = copy;
sub(/ .*$/,"",proc_name);
sub(/[^ \n]* /,"",proc_and_args);
split(proc_and_args,args," ");
# now args is an array of the arguments
# args[1] is the formal name of the first argument, etc.
if (numargs != numactuals && !registering)
{ print location ":*** `" curr_function_proto "' is improperly registered as having " numactuals " arguments" > std_err; }
# Build a nicer function prototype than curr_function_proto
# that shows optional and rest arguments.
nicer_function_proto = proc_name;
if (!registering) {
optional_args_tail = "";
for (i = 1; i <= $2; i++) {
nicer_function_proto = nicer_function_proto " " args[i];
}
for (; i <= $2 + $3; i++) {
nicer_function_proto = nicer_function_proto " [" args[i];
optional_args_tail = optional_args_tail "]";
}
nicer_function_proto = nicer_function_proto optional_args_tail;
if ($4 != 0) {
nicer_function_proto = nicer_function_proto " . " args[i];
}
}
# Now produce Texinfo format output.
print "\n " proc_name > dot_doc_file;
print "@c snarfed from " location > dot_doc_file;
print "@deffn primitive " nicer_function_proto > dot_doc_file;
}
/SCM_SNARF_DOCSTRING_START/,/SCM_SNARF_DOCSTRING_END.*$/ { copy = $0;
# Trim everything up to and including
# SCM_SNARF_DOCSTRING_START marker.
gsub(/.*SCM_SNARF_DOCSTRING_START/,"",copy);
# Trim leading whitespace and opening quote.
sub(/^[ \t]*\"?/,"", copy);
# Trim closing quote and trailing whitespace, or
# closing quote and whitespace followed by the
# SCM_SNARF_DOCSTRING_END marker.
sub(/[ \t]*\"?[ \t]*$/,"", copy);
sub(/[ \t]*\"?[ \t]*SCM_SNARF_DOCSTRING_END.*$/,"", copy);
# Replace escaped characters.
gsub(/\\n/,"\n",copy);
gsub(/\\\"/,"\"",copy);
gsub(/\\\\/,"\\",copy);
# Some docstrings end each line with "\n", while
# others don't. Therefore we always strip off one "\n"
# if present at the end of the line. Docstrings must
# therefore always use "\n\n" to indicate a blank line.
if (copy != "")
{
sub(/[ \t]*\n$/, "", copy);
print copy > dot_doc_file;
}
}
/SCM_SNARF_DOCSTRING_END[ \t]*/ { print "@end deffn" >> dot_doc_file; }
/\*&\*&\*&\*SCM_ARG_BETTER_BE_IN_POSITION/ { copy = $0;
sub(/.*\*&\*&\*&\*SCM_ARG_BETTER_BE_IN_POSITION\([ \t]*/,"",copy);
if (copy ~ /\"/) { next }
gsub(/[ \t]*,[ \t]*/,":",copy);
sub(/[ \t]*\).*/,"",copy);
split(copy,argpos,":");
argname = argpos[1];
pos = argpos[2];
if (pos ~ /[A-Za-z]/) { next }
if (pos ~ /^[ \t]*$/) { next }
if (argname ~ / /) { next }
line = argpos[3];
# print pos " " args[pos] " vs. " argname > "/dev/stderr";
if (args[pos] != argname) { print filename ":" line ":*** Argument name/number mismatch in `" curr_function_proto "' -- " argname " is not formal #" pos > "/dev/stderr"; }
}
|
