1 # Written by Greg J. Badros, <gjb@cs.washington.edu>
5 dot_doc_file =
ARGV[1]; ARGV[1] =
"-";
6 std_err =
"/dev/stderr";
7 # be sure to put something in the files to help make out
9 printf "" > dot_doc_file
;
12 /^
[ \t]*SCM_SNARF_INIT_START
/ { copy = $
0;
13 gsub(/[ \t]*SCM_SNARF_INIT_START
/, "", copy
);
14 gsub(/SCM_SNARF_DOC_START.
*$
/, "", copy
);
17 /SCM_SNARF_DOC_START
/,/SCM_SNARF_DOCSTRING_START
/ { copy = $
0;
18 if (match(copy
,/SCM_SNARF_DOC_STARTR
/)) { registering =
1; }
19 else {registering =
0; }
20 gsub(/.
*SCM_SNARF_DOC_START.
/,"", copy
);
21 gsub(/SCM_SNARF_DOCSTRING_START.
*/,"",copy
);
22 gsub(/[ \t]+/," ", copy
);
23 sub(/^
[ \t]*/,"(", copy
);
25 sub(/\
([ \t]*void
[ \t]*\
)/,"()", copy
);
27 numargs =
gsub(/SCM
/,"", copy
);
28 numcommas =
gsub(/,/,"", copy
);
29 numactuals = $
2 + $
3 + $
4;
31 gsub(/\"/,"",location
);
32 sub(/^
[ \t]*/,"",location
);
33 sub(/[ \t]*$
/,"",location
);
34 sub(/: /,":",location
);
35 sub(/^\.\
//,"",location
);
36 # Now whittle copy down to just the $1 field
37 # (but do not use $1, since it hasn't been
38 # altered by the above regexps)
39 gsub(/[ \t]*\
|.
*$
/,"",copy
);
41 # Now `copy' contains the nice scheme proc "prototype", e.g.
42 # (set-car! pair value)
43 # print copy > "/dev/stderr"; # for debugging
45 sub(/\
)[ \t]*$
/,"",copy
);
47 curr_function_proto = copy
;
49 sub(/ .
*$
/,"",proc_name
);
50 sub(/[^
\n]* /,"",proc_and_args
);
51 split(proc_and_args
,args
," ");
52 # now args is an array of the arguments
53 # args[1] is the formal name of the first argument, etc.
54 if (numargs
!= numactuals
&& !registering
)
55 { print location
":*** `" curr_function_proto
"' is improperly registered as having " numactuals
" arguments" > std_err
; }
56 # Build a nicer function prototype than curr_function_proto
57 # that shows optional and rest arguments.
58 nicer_function_proto = proc_name
;
60 optional_args_tail =
"";
61 for (i =
1; i
<= $
2; i
++) {
62 nicer_function_proto = nicer_function_proto
" " args
[i
];
64 for (; i
<= $
2 + $
3; i
++) {
65 nicer_function_proto = nicer_function_proto
" [" args
[i
];
66 optional_args_tail = optional_args_tail
"]";
68 nicer_function_proto = nicer_function_proto optional_args_tail
;
70 nicer_function_proto = nicer_function_proto
" . " args
[i
];
73 # Now produce Texinfo format output.
74 print "\n\f" proc_name
> dot_doc_file
;
75 print "@c snarfed from " location
> dot_doc_file
;
76 print "@deffn primitive " nicer_function_proto
> dot_doc_file
;
79 /SCM_SNARF_DOCSTRING_START
/,/SCM_SNARF_DOCSTRING_END.
*$
/ { copy = $
0;
80 gsub(/.
*SCM_SNARF_DOCSTRING_START
/,"",copy
);
81 sub(/^
[ \t]*\"?
/,"", copy
);
82 sub(/\"?
[ \t]*SCM_SNARF_DOCSTRING_END.
*$
/,"", copy
);
83 gsub(/\\n
\\n
\"?
/,"\n",copy
);
84 gsub(/\\n
\"?
[ \t]*$
/,"",copy
);
85 gsub(/\\\"/,"\"",copy
);
86 gsub(/[ \t]*$
/,"", copy
);
87 if (copy
!= "") { print copy
> dot_doc_file
}
90 /SCM_SNARF_DOCSTRING_END
[ \t]/ { print "@end deffn" >> dot_doc_file
; }
92 /\
*&\
*&\
*&\
*SCM_ARG_BETTER_BE_IN_POSITION
/ { copy = $
0;
93 sub(/.
*\
*&\
*&\
*&\
*SCM_ARG_BETTER_BE_IN_POSITION\
([ \t]*/,"",copy
);
94 if (copy ~
/\"/) { next }
95 gsub(/[ \t]*,[ \t]*/,":",copy
);
96 sub(/[ \t]*\
).
*/,"",copy
);
97 split(copy
,argpos
,":");
100 if (pos ~
/[A
-Za
-z
]/) { next }
101 if (pos ~
/^
[ \t]*$
/) { next }
102 if (argname ~
/ /) { next }
104 # print pos " " args[pos] " vs. " argname > "/dev/stderr";
105 if (args
[pos
] != argname
) { print filename ":" line
":*** Argument name/number mismatch in `" curr_function_proto
"' -- " argname
" is not formal #" pos
> "/dev/stderr"; }