[comp.lang.icon] avoid duplicate procedure id's

goer@quads.uchicago.edu (Richard L. Goerwitz) (10/02/90)

As Icon code starts to pack my filesystem more and more, duplicate
procedure and record names have become a greater and greater problem,
especially when the duplicate names turn up in files intended as
Icon libraries.

Here's a program to make sure that duplicate procedure names don't
invade your libraries (or, for that matter, the IPL - which to start
with has a few duplicate names).

Certainly, in some cases, duplicate names are desirable (as when a
library exists in several OS-specific implementations).  In most
cases, though, they are not.  The following package might be especi-
ally useful to those who intend to post code.  At least this way,
they can be sure their procedure names don't conflict with a known
body of programs that everyone has access to (i.e. the IPL).

-Richard

P.S.  I write these things mainly for myself, so don't expect them
      to be "polished."  Naturally, though, I'll hungrily eat up any
      bug reports, and either re-post or send out individual diffs,
      depending on which seems more appropriate at the time.

---- Cut Here and feed the following to sh ----
#!/bin/sh
# This is a shell archive (produced by shar 3.49)
# To extract the files from this archive, save it to a file, remove
# everything above the "!/bin/sh" line above, and type "sh file_name".
#
# made 10/02/1990 16:10 UTC by goer@sophist.uchicago.edu
# Source directory /u/richard/Tmp
#
# existing files will NOT be overwritten unless -c is specified
# This format requires very little intelligence at unshar time.
# "if test", "cat", "rm", "echo", "true", and "sed" may be needed.
#
#                                                                          
#                                                                          
#
# This shar contains:
# length  mode       name
# ------ ---------- ------------------------------------------
#   8344 -r--r--r-- duplproc.icn
#    692 -rw-r--r-- README
#    623 -rw-r--r-- Makefile.dist
#
if test -r _shar_seq_.tmp; then
	echo 'Must unpack archives in sequence!'
	echo Please unpack part `cat _shar_seq_.tmp` next
	exit 1
fi
# ============= duplproc.icn ==============
if test -f 'duplproc.icn' -a X"$1" != X"-c"; then
	echo 'x - skipping duplproc.icn (File already exists)'
	rm -f _shar_wnt_.tmp
else
> _shar_wnt_.tmp
echo 'x - extracting duplproc.icn (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'duplproc.icn' &&
X############################################################################
X#
X#	Name:	 duplproc.icn
X#
X#	Title:	 Find duplicate procedure/record identifiers
X#
X#	Author:	 Richard L. Goerwitz
X#
X#	Version: 1.1
X#
X############################################################################
X#
X#  Use this if you plan on posting code!
X#
X#  Finddupl.icn compiles into a program which will search through
X#  every directory in your ILIBS environment variable (and/or in the
X#  directories supplied as arguments to the program).  If it finds any
X#  duplicate procedure or record identifiers, it will report this on
X#  the standard output.
X#
X#  It is important to try to use unique procedure names in programs
X#  you write, especially if you intend to link in some of the routines
X#  contained in the IPL.  Checking for duplicate procedure names has
X#  been somewhat tedious in the past, and many of us (me included)
X#  must be counted as guilty for not checking more thoroughly.  Now,
X#  however, checking should be a breeze.
X#
X############################################################################
X#
X#  Links:  none
X#
X#  Requires:  Unix (MS-DOS may work; dunno)
X#
X############################################################################
X
Xrecord procedure_stats(name, file, lineno)
X
Xprocedure main(a)
X
X    local proc_table, fname, elem, lib_file, tmp
X
X    #     usage:  duplproc [libdirs]
X    #
X    # Where libdirs is a series of space-separated directories in
X    # which relevant library files are to be found.  To the
X    # directories listed in libdirs are added any directories found in
X    # the ILIBS environment variable.
X
X    proc_table := table()
X
X    # Put all command-line option paths, and ILIBS paths, into one sorted
X    # list.  Then get the names of all .icn filenames in those paths.
X    every fname := !get_icn_filenames(getlibpaths(a)) do {
X	# For each .icn filename, open that file, and find all procedure
X	# calls in it.
X	if not (lib_file := open(fname, "r")) then
X	    write(&errout,"Can't open ",fname," for reading.")
X	else {
X	    # Find all procedure calls in lib_file.
X	    every elem := !get_procedures(lib_file,fname) do {
X		if /proc_table[elem.name] := set()
X		then insert(proc_table[elem.name],elem)
X		else {
X		    write("\"", elem.name, "\"",
X			" is defined in ",*proc_table[elem.name]+1," places:")
X		    every tmp := !proc_table[elem.name] do
X			write("     ",tmp.file, ", line ",tmp.lineno)
X		    write("     ",elem.file, ", line ", elem.lineno)
X		}
X	    }
X	    close(lib_file)
X	}
X    }
X
X
Xend
X
X
X
Xprocedure getlibpaths(ipl_paths)
X
X    # Unite command-line args and ILIBS environment variable into one
X    # path list.
X
X    local i, path
X
X    # Make sure all paths have a consistent format (one trailing slash).a
X    if *\ipl_paths > 0 then {
X	every i := 1 to *ipl_paths do {
X	    ipl_paths[i] := fixup_path(ipl_paths[i])
X	}
X	ipl_paths := set(ipl_paths)
X    }
X    else ipl_paths := set()
X
X    # If the ILIBS environment variable is set, read it into
X    # ipl_paths.  Colons *or* spaces are okay as separators.
X    getenv("ILIBS") ? {
X	while path := tab(upto(' :')) do {
X	    insert(ipl_paths, fixup_path(path))
X	    tab(many(' :'))
X	}
X    insert(ipl_paths, fixup_path(tab(0)))
X    }
X
X    return sort(ipl_paths)
X
Xend
X
X
X
Xprocedure fixup_path(s)
X    # Make sure paths have a consistent format.
X    return "/" ~== (trim(s,'/') || "/")
Xend
X
X
X
Xprocedure get_procedures(intext,fname)
X
X    # Extracts the names of all procedures declared in file f.
X    # Returns them in a list, each of whose elements have the
X    # form record procedure_stats(procedurename, filename, lineno).
X
X    local psl, f_pos
X    static name_chars
X    initial {
X	name_chars := &ucase ++ &lcase ++ &digits ++ '_'
X    }
X
X    # Initialize procedure-name list, line count.
X    psl := list()
X    line_no := 0
X
X    # Find procedure declarations in intext.
X    while line := read(intext) & line_no +:= 1 do {
X	take_out_comments(line) ? {
X	    if tab(match("procedure")) then {
X		tab(many(' \t')) &
X		    put(psl, procedure_stats(
X			    "main" ~== tab(many(name_chars)), fname, line_no))
X	    }
X	}
X    }
X
X    return psl   # returns empty list if no procedures found
X
Xend
X
X
X
Xprocedure take_out_comments(s)
X
X    # Commented-out portions of Icon code - strip 'em.  Fails on lines
X    # which, either stripped or otherwise, come out as an empty string.
X    #
X    # BUG:  Does not handle lines which use the _ string-continuation
X    # notation.  Typically take_out_comments barfs on the next line.
X
X    local i, j, c, c2
X
X    s ? {
X	tab(many(' \t'))
X	pos(0) & fail
X        find("#") | (return trim(tab(0),' \t'))
X	match("#") & fail
X	(s2 <- tab(find("#"))) ? {
X	    c2 := &null
X	    while tab(upto('\\"\'')) do {
X		case c := move(1) of {
X		    "\\"   : {
X			if match("^")
X			then move(2)
X			else move(1)
X		    }
X		    default: {
X			if \c2
X			then (c == c2, c2 := &null)
X			else c2 := c
X		    }
X		}
X	    }
X	    /c2
X	}
X	return "" ~== trim((\s2 | tab(0)) \ 1, ' \t')
X    }
X
Xend
X
X
X
Xprocedure get_icn_filenames(lib_paths)
X
X    # Return the names of all .icn files in all of the paths in the
X    # list lib_paths.  The dir routine used depends on which OS we
X    # are running under.
X
X    local procedure_stat_list
X    static get_dir
X    initial get_dir := set_getdir_by_os()
X
X    procedure_stat_list := list()
X    # Run through every possible path in which files might be found,
X    # and get a list of procedures contained in those files.
X    every procedure_stat_list |||:= get_dir(!lib_paths)
X
X    return procedure_stat_list
X
Xend
X
X
X
Xprocedure set_getdir_by_os()
X
X    if find("UNIX", &features)
X    then return unix_get_dir
X    else if find("MS-DOS", &features)
X    then return msdos_get_dir
X    else stop("Your operating system is not (yet) supported.")
X
Xend
X
X
X
Xprocedure msdos_get_dir(dir)
X
X    # Returns a sorted list of all filenames (full paths included) in
X    # directory "dir."  The list is sorted.  Fails on invalid or empty
X    # directory.  Aborts if temp file cannot be opened.
X    #
X    # Temp files can be directed to one or another directory either by
X    # manually setting the variable temp_dir below, or by setting the
X    # value of the environment variable TEMPDIR to an appropriate
X    # directory name.
X
X    local in_dir, filename_list, line
X    static temp_dir
X    initial {
X        temp_dir := 
X            (trim(map(getenv("TEMPDIR"), "/", "\\"), '\\') || "\\") |
X                ".\\"
X    }
X
X    # Get name of tempfile to be used.
X    temp_name := get_dos_tempname(temp_dir) |
X	stop("No more available tempfile names!")
X
X    # Make sure we have an unambiguous directory name, with backslashes
X    # instead of Unix-like forward slashes.
X    dir := trim(map(dir, "/", "\\"), '\\') || "\\"
X
X    # Put dir listing into a temp file.
X    system("dir "||dir||" > "||temp_name)
X
X    # Put tempfile entries into a list, removing blank- and
X    # space-initial lines.  Exclude directories (i.e. return file
X    # names only).
X    in_dir := open(temp_name,"r") |
X	stop("Can't open temp file in directory ",temp_dir,".")
X    filename_list := list()
X    every filename := ("" ~== !in_dir) do {
X        match(" ",filename) | find(" <DIR>", filename) & next
X	# Exclude our own tempfiles (may not always be appropriate).
X	filename ?:= trim(trim(tab(10)) || "." || tab(13), '. ')
X	if filename ? (not match("s."), tab(find(".icn")+4), pos(0))
X	then put(filename_list, map(dir || filename))
X    }
X
X    # Clean up.
X    close(in_dir) & remove(temp_name)
X
X    # Check to be sure we actually managed to read some files.
X    if *filename_list = 0 then fail
X    else return sort(filename_list)
X
Xend
X
X
X
Xprocedure get_dos_tempname(dir)
X
X    # Don't clobber existing files.  Get a unique temp file name for
X    # use as a temporary storage site.
X
X    every temp_name := dir || "icondir." || right(string(1 to 999),3,"0") do {
X	temp_file := open(temp_name,"r") | break
X        close(temp_file)
X    }
X    return \temp_name
X
Xend
X
X
X
Xprocedure unix_get_dir(dir)
X
X    dir := trim(dir, '/') || "/"
X    filename_list := list()
X    in_dir := open("/bin/ls -F "||dir, "pr")
X    every filename := ("" ~== !in_dir) do {
X	match("/",filename,*filename) & next
X	if filename ? (not match("s."), tab(find(".icn")+4), pos(0))
X	then put(filename_list, trim(dir || filename, '*'))
X    }
X    close(in_dir)
X
X    if *filename_list = 0 then fail
X    else return filename_list
X
Xend
SHAR_EOF
true || echo 'restore of duplproc.icn failed'
rm -f _shar_wnt_.tmp
fi
# ============= README ==============
if test -f 'README' -a X"$1" != X"-c"; then
	echo 'x - skipping README (File already exists)'
	rm -f _shar_wnt_.tmp
else
> _shar_wnt_.tmp
echo 'x - extracting README (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'README' &&
XSee the comments prepended to duplproc.icn for a statement of what
Xthis program is and does.  To create it on a Unix system, you can
Xjust mv Makefile.dist to Makefile and make.  If you want to install
Xit, type "make Install" as root.  Be sure to check the Makefile
Xfirst, though, to be sure the installation routine uses the correct
Xdirectories and permissions for your system.
X
XUsers of other systems, you're on your own.  This may work under
XMS-DOS, but it hasn't been tested on anything other than Unix.  The
Xreason for the OS-specificity is duplproc's need to get a listing
Xof various filenames in various directories at run-time.  This has
Xto be implemented on a system-by-system basis.
SHAR_EOF
true || echo 'restore of README failed'
rm -f _shar_wnt_.tmp
fi
# ============= Makefile.dist ==============
if test -f 'Makefile.dist' -a X"$1" != X"-c"; then
	echo 'x - skipping Makefile.dist (File already exists)'
	rm -f _shar_wnt_.tmp
else
> _shar_wnt_.tmp
echo 'x - extracting Makefile.dist (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'Makefile.dist' &&
XPROGNAME = duplproc
X
X# Please edit these to reflect your local file structure & conventions.
XDESTDIR = /usr/local/bin
XOWNER = bin
XGROUP = bin
X
XSRC = $(PROGNAME).icn
X
X$(PROGNAME): $(PROGNAME).icn
X	icont $(PROGNAME).icn
X
X# Pessimistic assumptions regarding the environment (in particular,
X# I don't assume you have the BSD "install" shell script).
Xinstall: $(PROGNAME)
X	@sh -c "test -d $(DESTDIR) || (mkdir $(DESTDIR) && chmod 755 $(DESTDIR))"
X	cp $(PROGNAME) $(DESTDIR)/
X	chgrp $(GROUP) $(DESTDIR)/$(PROGNAME)
X	chown $(OWNER) $(DESTDIR)/$(PROGNAME)
X	@echo "\nInstallation done.\n"
X
Xclean:
X	-rm -f *~ .u?
X	-rm -f $(PROGNAME)
SHAR_EOF
true || echo 'restore of Makefile.dist failed'
rm -f _shar_wnt_.tmp
fi
exit 0