Commit 21263a7f 21263a7f79184500989c66aee03159f6ea3d1e39 by Sergey Poznyakoff

Added to the repository

1 parent dfffa19f
EXTRA_DIST = \
guile-doc-snarf\
guile-func-name-check\
guile-snarf.awk
#! /bin/sh
# Extract the initialization actions for builtin things.
#
# Copyright (C) 1999, 2000 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., 59 Temple Place, Suite 330,
# Boston, MA 02111-1307 USA
#
## For some obscure reason, the original guile-doc-snarf distributed
## with guile up to version 1.4, passes guile-func-name-check
## to awk without absolute path spec. Consequently the script bails
## out unless guile-func-name-check is in the current directory.
## This version assumes that both scripts live in the same directory
## and deduces the path to guile-func-name-check from the own pathname.
## --gray
OUTFILE=/dev/tty
DOCFILE=0
# process aruments
while [ $# -gt 0 ];
do
case $1 in
-o) OUTFILE=$2; shift 2;;
-d) DOCFILE=1; shift;;
*) break;;
esac
done
fullfilename=$1; shift
# strip path to source directory
filename=`basename $fullfilename`
if [ $DOCFILE -ne 0 ]; then
dot_doc=$OUTFILE
OUTFILE=/dev/null
else
# we need to be sure that the .x file exists
# since the .c/.cc file may include it
# (the old guile-snarf did not have this problem
# because the makefile redirects output to the .x file
# which creates the file before the inclusion occurs)
# --12/12/99 gjb
no_ext=`echo $filename | sed 's/\.[^.]*$//g'`
dot_doc=${no_ext}.doc
fi
temp="/tmp/snarf.$$"
trap "rm -f $temp" 0 1 2 15
## Let the user override the preprocessor & awk autoconf found.
test -n "${CPP+set}" || CPP="gcc -E"
test -n "${AWK+set}" || AWK="gawk"
## Must run guile-func-name-check on the unpreprocessed source
${AWK} -f `dirname $0`/guile-func-name-check "$fullfilename"
## We must use a temporary file here, instead of a pipe, because we
## need to know if CPP exits with a non-zero status.
echo "/* empty */" > $OUTFILE
${CPP} -DSCM_MAGIC_SNARFER $fullfilename "$@" > ${temp}
if [ $? -ne 0 ]; then
rm -f $OUTFILE
exit 1
fi
cat ${temp} | \
sed 's/^\(.\{128\}.\{128\}.\{128\}.\{128\}.\{128\}.\{128\}.\{128\}.\{128\}\).*/\1/g' | \
${AWK} -f `dirname $0`/guile-snarf.awk `basename ${dot_doc}` > $OUTFILE
#! /usr/bin/awk -f
#
# Copyright (C) 2000 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., 59 Temple Place, Suite 330,
# Boston, MA 02111-1307 USA
#
# Written by Greg J. Badros, <gjb@cs.washington.edu>
# 11-Jan-2000
BEGIN {
filename = ARGV[1];
}
/^SCM_DEFINE/ {
func_name = $0;
sub(/^[^\(\n]*\([ \t]*/,"", func_name);
sub(/[ \t]*,.*/,"", func_name);
# print func_name; # GJB:FIXME:: flag to do this to list primitives?
in_a_func = 1;
}
in_a_func && /^\{/ {
if (!match(last_line,/^#define[ \t]+FUNC_NAME[ \t]+/)) {
printf filename ":" NR ":***" > "/dev/stderr";
print "Missing or erroneous `#define FUNC_NAME s_" func_name "'" > "/dev/stderr";
} else {
sub(/^#define[ \t]+FUNC_NAME[ \t]+s_/, "", last_line);
sub(/[ \t]*$/,"",last_line);
if (last_line != func_name) {
printf filename ":" NR ":***" > "/dev/stderr";
print "Mismatching FUNC_NAME. Should be: `#define FUNC_NAME s_" func_name "'" > "/dev/stderr";
}
}
}
1 == next_line_better_be_undef {
if (!match($0,/^#undef FUNC_NAME[ \t]*$/)) {
printf filename ":" NR ":***" > "/dev/stderr";
print "Missing or erroneous #undef for " func_name ": "
"Got `" $0 "' instead." > "/dev/stderr";
}
in_a_func = "";
func_name = "";
next_line_better_be_undef = 0;
}
in_a_func && /^\}/ {
next_line_better_be_undef = 1;
}
{ last_line = $0; }
# Copyright (C) 1999, 2000 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., 59 Temple Place, Suite 330,
# Boston, MA 02111-1307 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__I/ { copy = $0;
gsub(/[ \t]*SCM__I/, "", copy);
gsub(/SCM__D.*$/, "", copy);
print copy; }
/SCM__D/,/SCM__S/ { copy = $0;
if (match(copy,/SCM__DR/)) { registering = 1; }
else {registering = 0; }
gsub(/.*SCM__D./,"", copy);
gsub(/SCM__S.*/,"",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);
# 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)
# print copy > "/dev/stderr"; # for debugging
proc_and_args = copy;
curr_function_proto = copy;
sub(/[^ \n]* /,"",proc_and_args);
sub(/\)[ \t]*/,"",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 ":*** `" copy "' is improperly registered as having " numactuals " arguments" > std_err; }
print " \n" copy (registering?")":"") > dot_doc_file ; }
/SCM__S/,/SCM__E.*$/ { copy = $0;
gsub(/.*SCM__S/,"",copy);
sub(/^[ \t]*"?/,"", copy);
sub(/\"?[ \t]*SCM__E.*$/,"", copy);
gsub(/\\n\\n"?/,"\n",copy);
gsub(/\\n"?[ \t]*$/,"",copy);
gsub(/\\\"[ \t]*$/,"\"",copy);
gsub(/[ \t]*$/,"", copy);
if (copy != "") { print copy > dot_doc_file }
}
/SCM__E[ \t]/ { print "[" location "]" >> 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"; }
}
EXTRA_DIST = \
guile-doc-snarf\
guile-doc-snarf.awk
#! /bin/sh
# Copyright (C) 2002 Sergey Poznyakoff
#
# This is a snarfer for guile version 1.6
#
# 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 of the License, 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 program; if not, write to the Free Software Foundation,
# Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
OUTFILE=/dev/tty
DOCFILE=0
BASEDIR=`dirname $0`
test -n "${CPP+set}" || CPP="gcc -E"
test -n "${AWK+set}" || AWK=awk
temp=/tmp/snarf.$$
trap "rm -f $temp" 0 1 2 15
# process aruments
while [ $# -gt 0 ];
do
case $1 in
-o) OUTFILE=$2; shift 2;;
-d) DOCFILE=1; shift;;
*) break;;
esac
done
INFILE=$1; shift
cpp_exit=1
snarf_x() {
echo "/* source: $INFILE */" ;
echo "/* cpp arguments: $@ */" ;
$CPP -DSCM_MAGIC_SNARF_INITS -DSCM_MAGIC_SNARFER "$@" > ${temp}
cpp_exit=$?
grep "^ *\^ *\^" ${temp} | sed -e "s/^ *\^ *\^//" -e "s/\^\ *:\ *\^.*/;/"
}
snarf_doc() {
$CPP -DSCM_MAGIC_SNARF_DOCS "$@" > ${temp}
cpp_exit=$?
$AWK '
NF<2 {next}
state == 0 && /\^\^ {/ { state = 1; print; next }
state == 0 && /\^\^/ { print }
state == 1 && /\^\^ }/ { state = 0; print; next }
state == 1 { print }
state == 0 { next }' $temp |\
tr -d '\n' | tr '^' '\n' |\
awk -f $BASEDIR/guile-doc-snarf.awk > $OUTFILE
}
case "$DOCFILE" in
0) snarf_x $INFILE "$@" > $OUTFILE;;
1) snarf_doc $INFILE "$@" > $OUTFILE;;
esac
if [ $cpp_exit -ne 0 ]; then
[ "$OUTFILE" != "/dev/tty" ] && rm $OUTFILE
fi
exit $cpp_exit
# Copyright (C) 2002 Sergey Poznyakoff
#
# This is a snarfer for guile version 1.6
#
# 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 of the License, 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 program; if not, write to the Free Software Foundation,
# Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
BEGIN {
cname = ""
}
function flush() {
if (cname == "")
return;
if (arg_req + arg_opt + arg_var != numargs)
error(cname " incorrectly defined as taking " numargs " arguments")
print "\f" cname
print "@c snarfed from " loc_source ":" loc_line
printf "@deffn {Scheme procedure} %s", cname
for (i = 1; i <= numargs; i++)
printf(" %s", arglist[i])
print ""
print docstring
print "@end deffn\n"
delete argpos
delete arglist
cname = ""
}
function error(s) {
print loc_source ":" loc_line ": " s > "/dev/stderr"
exit 1
}
state == 0 && /{/ {
flush()
cname = $3
next
}
state == 0 && /fname/ { fname = $2; next }
state == 0 && /type/ { type = $2; next }
state == 0 && /location/ { loc_source = $2; loc_line = $3 }
state == 0 && /arglist/ {
match($0, "\\(.*\\)")
s = substr($0,RSTART+1,RLENGTH-2)
numargs = split(s, a, ",")
for (i = 1; i <= numargs; i++) {
m = split(a[i], b, "[ \t]*")
if (b[1] == "") {
t = b[2]
n = b[3]
m--
} else {
t = b[1]
n = b[2]
}
if (m > 2 || t != "SCM")
error(cname ": wrong argument type for arg " i " " t)
arglist[i] = n
}
}
state == 0 && /argsig/ { arg_req = $2; arg_opt = $3; arg_var = $4 }
state == 0 && /.*\"/ {
gsub("\"\"", "")
gsub("\\\\n", "\n")
match($0,"\".*\"")
docstring = substr($0,RSTART+1,RLENGTH-2)
}
/argpos/ { argpos[$2] = $3 }
END {
flush()
}
\ No newline at end of file