diff options
Diffstat (limited to 'glafp-utils')
29 files changed, 0 insertions, 3611 deletions
diff --git a/glafp-utils/Makefile b/glafp-utils/Makefile deleted file mode 100644 index d9a8b2e351..0000000000 --- a/glafp-utils/Makefile +++ /dev/null @@ -1,19 +0,0 @@ -################################################################################# -# -# glafp-utils/Makefile -# -# Main Makefile for project glafp-utils -# -################################################################################# - -TOP=. -include $(TOP)/mk/boilerplate.mk - -# We need to write mkdependC first (in that order), to be sure that -# make depend will succeed in all the other directories. -SUBDIRS = mkdependC mkdirhier runstdtest -ifneq "$(TARGETPLATFORM)" "i386-unknown-mingw32" -SUBDIRS += lndir -endif - -include $(TOP)/mk/target.mk diff --git a/glafp-utils/PATCHLEVEL b/glafp-utils/PATCHLEVEL deleted file mode 100644 index a20156b9cb..0000000000 --- a/glafp-utils/PATCHLEVEL +++ /dev/null @@ -1 +0,0 @@ -Miscellaneous FP-projects-related tools, version 2.01, patchlevel 0 diff --git a/glafp-utils/README b/glafp-utils/README deleted file mode 100644 index 8967522e5a..0000000000 --- a/glafp-utils/README +++ /dev/null @@ -1,31 +0,0 @@ -This directory tree's worth of stuff are utility bits that are used in -more than one of the Glasgow functional-programming tools. (For the -project-specific bits, try <project>/utils/<blah>.) - - lndir from X imake stuff (via DuBois); make a shadow tree - of symbolic links - - ltx a "latex" wrapper. Re-runs latex/bibtex/makeindex - enough times to "do the right thing." - - mkdependC script version of C makedepend (from X11R4 via DuBois) - - mkdirhier "mkdir a/b/c/d" will do "mkdir a; mkdir a/b; ..." - (assuming none of those dirs exist) - - runstdtest runs a pgm with some flags & some stdin; checks for an - expected exit code, expected stdout, and expected - stderr. (Expect this to change :-) - - verbatim pre-processor for LaTeX files that typesets text between - @...@ in typewriter font. - - sgmlverb pre-processor for SGML that does essentially the same thing - as verbatim. - - docbook scripts to process DocBook files stolen from Cygnus DocBook - tools. - - genargs converts whitespace separated strings into partial - Haskell lists. - diff --git a/glafp-utils/genargs/Makefile b/glafp-utils/genargs/Makefile deleted file mode 100644 index 3c31e6a39f..0000000000 --- a/glafp-utils/genargs/Makefile +++ /dev/null @@ -1,8 +0,0 @@ -comma = , -BAR= "-L\"foo bar\"" -FOO= $(patsubst %,$(comma)"%",$(BAR)) - -test: - @echo "$(FOO)" - @echo "$(BAR)" | $(PERL) genargs.pl -comma - @echo diff --git a/glafp-utils/genargs/genargs.pl b/glafp-utils/genargs/genargs.pl deleted file mode 100644 index 2ef2dfa3e6..0000000000 --- a/glafp-utils/genargs/genargs.pl +++ /dev/null @@ -1,62 +0,0 @@ -#!/usr/bin/perl -my $quote_open = 0; -my $quote_char = ''; -my $accum = ""; -my $once = 1; -my $c; - -# This program generates a partial Haskell list of Strings from -# words passed via stdin suitable for use in package.conf, e.g.: -# -# foo bar --> "foo", "bar" -# "foo bar" --> "foo bar" -# foo\"bar --> "foo\"bar" -# -# Invoking genargs.pl with -comma will print an initial comma if -# there's anything to print at all. -# -# Sample application in a Makefile: -# HSIFIED_EXTRA_LD_OPTS= `echo "$(EXTRA_LD_OPTS)" | $(PERL) genargs.pl` -# PACKAGE_CPP_OPTS += -DHSIFIED_EXTRA_LD_OPTS="$(HSIFIED_EXTRA_LD_OPTS)" - -sub printaccum { - if ($once) { - if ($ARGV[0] eq "-comma") { - print ", "; - } - } else { - print ", "; - } - $once=0; - print '"'; - print $accum; - print '"'; -} - -while ($c = getc) { - if ($quote_open) { - if ($c eq $quote_char) { - $quote_open = 0; - } elsif ($c eq '"') { - $accum .= '\"'; - } else { - $accum .= $c; - } - } else { - if (($c eq ' ') || ($c eq "\n")) { - if (!($accum eq "")) { - printaccum; - $accum = ""; - } - } elsif ($c eq "\\") { - $accum .= $c; - $c = getc; - $accum .= $c; - } elsif (($c eq '"') || ($c eq "\'")) { - $quote_open = 1; - $quote_char = $c; - } else { - $accum .= $c - } - } -} diff --git a/glafp-utils/lndir/Makefile b/glafp-utils/lndir/Makefile deleted file mode 100644 index d85f92cf7e..0000000000 --- a/glafp-utils/lndir/Makefile +++ /dev/null @@ -1,15 +0,0 @@ -TOP=.. -include $(TOP)/mk/boilerplate.mk - -C_SRCS=lndir.c -C_PROG=lndir - -CLEAN_FILES += $(C_PROG)$(exeext) $(C_OBJS) -DESTDIR=$(INSTBINDIR) - -include $(TOP)/mk/target.mk - -# Win32: cygwin supports symlinks, so make sure we -# don't feed in the mingw flags here. In other -# words, lndir.exe is a cygwin-based app. -CC_OPTS := $(filter-out -mno-cygwin,$(CC_OPTS)) diff --git a/glafp-utils/lndir/lndir-Xos.h b/glafp-utils/lndir/lndir-Xos.h deleted file mode 100644 index e91e959c73..0000000000 --- a/glafp-utils/lndir/lndir-Xos.h +++ /dev/null @@ -1,152 +0,0 @@ -/* - * $XConsortium: Xos.h,v 1.47 91/08/17 17:14:38 rws Exp $ - * - * Copyright 1987 by the Massachusetts Institute of Technology - * - * Permission to use, copy, modify, and distribute this software and its - * documentation for any purpose and without fee is hereby granted, provided - * that the above copyright notice appear in all copies and that both that - * copyright notice and this permission notice appear in supporting - * documentation, and that the name of M.I.T. not be used in advertising - * or publicity pertaining to distribution of the software without specific, - * written prior permission. M.I.T. makes no representations about the - * suitability of this software for any purpose. It is provided "as is" - * without express or implied warranty. - * - * The X Window System is a Trademark of MIT. - * - */ - -/* This is a collection of things to try and minimize system dependencies - * in a "signficant" number of source files. - */ - -#ifndef _XOS_H_ -#define _XOS_H_ - -#include "lndir-Xosdefs.h" - -/* - * Get major data types (esp. caddr_t) - */ - -#ifdef USG -#ifndef __TYPES__ -#ifdef CRAY -#define word word_t -#endif /* CRAY */ -#include <sys/types.h> /* forgot to protect it... */ -#define __TYPES__ -#endif /* __TYPES__ */ -#else /* USG */ -#if defined(_POSIX_SOURCE) && defined(MOTOROLA) -#undef _POSIX_SOURCE -#include <sys/types.h> -#define _POSIX_SOURCE -#else -#include <sys/types.h> -#endif -#endif /* USG */ - - -/* - * Just about everyone needs the strings routines. We provide both forms here, - * index/rindex and strchr/strrchr, so any systems that don't provide them all - * need to have #defines here. - */ - -#ifndef X_NOT_STDC_ENV -#include <string.h> -#define index strchr -#define rindex strrchr -#else -#ifdef SYSV -#include <string.h> -#define index strchr -#define rindex strrchr -#else -#include <strings.h> -#define strchr index -#define strrchr rindex -#endif -#endif - - -/* - * Get open(2) constants - */ -#ifdef X_NOT_POSIX -#include <fcntl.h> -#ifdef USL -#include <unistd.h> -#endif /* USL */ -#ifdef CRAY -#include <unistd.h> -#endif /* CRAY */ -#ifdef MOTOROLA -#include <unistd.h> -#endif /* MOTOROLA */ -#ifdef SYSV386 -#include <unistd.h> -#endif /* SYSV386 */ -#include <sys/file.h> -#else /* X_NOT_POSIX */ -#if !defined(_POSIX_SOURCE) && defined(macII) -#define _POSIX_SOURCE -#include <fcntl.h> -#undef _POSIX_SOURCE -#else -#include <fcntl.h> -#endif -#include <unistd.h> -#endif /* X_NOT_POSIX else */ - -/* - * Get struct timeval - */ - -#ifdef SYSV - -#ifndef USL -#include <sys/time.h> -#endif -#include <time.h> -#ifdef CRAY -#undef word -#endif /* CRAY */ -#if defined(USG) && !defined(CRAY) && !defined(MOTOROLA) -struct timeval { - long tv_sec; - long tv_usec; -}; -#ifndef USL_SHARELIB -struct timezone { - int tz_minuteswest; - int tz_dsttime; -}; -#endif /* USL_SHARELIB */ -#endif /* USG */ - -#else /* not SYSV */ - -#if defined(_POSIX_SOURCE) && defined(SVR4) -/* need to omit _POSIX_SOURCE in order to get what we want in SVR4 */ -#undef _POSIX_SOURCE -#include <sys/time.h> -#define _POSIX_SOURCE -#else -#include <sys/time.h> -#endif - -#endif /* SYSV */ - -/* use POSIX name for signal */ -#if defined(X_NOT_POSIX) && defined(SYSV) && !defined(SIGCHLD) -#define SIGCHLD SIGCLD -#endif - -#ifdef ISC -#include <sys/bsdtypes.h> -#endif - -#endif /* _XOS_H_ */ diff --git a/glafp-utils/lndir/lndir-Xosdefs.h b/glafp-utils/lndir/lndir-Xosdefs.h deleted file mode 100644 index e21db4b24e..0000000000 --- a/glafp-utils/lndir/lndir-Xosdefs.h +++ /dev/null @@ -1,99 +0,0 @@ -/* - * O/S-dependent (mis)feature macro definitions - * - * $XConsortium: Xosdefs.h,v 1.7 91/07/19 23:22:19 rws Exp $ - * - * Copyright 1991 Massachusetts Institute of Technology - * - * Permission to use, copy, modify, distribute, and sell this software and its - * documentation for any purpose is hereby granted without fee, provided that - * the above copyright notice appear in all copies and that both that - * copyright notice and this permission notice appear in supporting - * documentation, and that the name of M.I.T. not be used in advertising or - * publicity pertaining to distribution of the software without specific, - * written prior permission. M.I.T. makes no representations about the - * suitability of this software for any purpose. It is provided "as is" - * without express or implied warranty. - * - * M.I.T. DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING ALL - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL M.I.T. - * BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES - * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION - * OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN - * CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. - */ - -#ifndef _XOSDEFS_H_ -#define _XOSDEFS_H_ - -/* - * X_NOT_STDC_ENV means does not have ANSI C header files. Lack of this - * symbol does NOT mean that the system has stdarg.h. - * - * X_NOT_POSIX means does not have POSIX header files. Lack of this - * symbol does NOT mean that the POSIX environment is the default. - * You may still have to define _POSIX_SOURCE to get it. - */ - -#ifdef NOSTDHDRS -#define X_NOT_POSIX -#define X_NOT_STDC_ENV -#endif - -#ifdef NeXT -#define X_NOT_POSIX -#endif - -#ifdef sony -#ifndef SYSTYPE_SYSV -#define X_NOT_POSIX -#endif -#endif - -#ifdef UTEK -#define X_NOT_POSIX -#define X_NOT_STDC_ENV -#endif - -#ifdef CRAY -#define X_NOT_POSIX -#endif - -#ifdef vax -#ifndef ultrix /* assume vanilla BSD */ -#define X_NOT_POSIX -#define X_NOT_STDC_ENV -#endif -#endif - -#ifdef luna -#define X_NOT_POSIX -#define X_NOT_STDC_ENV -#endif - -#ifdef Mips -#define X_NOT_POSIX -#define X_NOT_STDC_ENV -#endif - -#ifdef USL -#ifdef SYSV /* (release 3.2) */ -#define X_NOT_POSIX -#define X_NOT_STDC_ENV -#endif -#endif - -#ifdef SYSV386 -#ifdef SYSV -#define X_NOT_POSIX -#define X_NOT_STDC_ENV -#endif -#endif - -#ifdef MOTOROLA -#ifdef SYSV -#define X_NOT_STDC_ENV -#endif -#endif - -#endif /* _XOSDEFS_H_ */ diff --git a/glafp-utils/lndir/lndir.c b/glafp-utils/lndir/lndir.c deleted file mode 100644 index c65715e379..0000000000 --- a/glafp-utils/lndir/lndir.c +++ /dev/null @@ -1,399 +0,0 @@ -/* $XConsortium: lndir.c /main/16 1996/09/28 16:16:40 rws $ */ -/* Create shadow link tree (after X11R4 script of the same name) - Mark Reinhold (mbr@lcs.mit.edu)/3 January 1990 */ - -/* -Copyright (c) 1990, X Consortium - -Permission is hereby granted, free of charge, to any person obtaining a copy -of this software and associated documentation files (the "Software"), to deal -in the Software without restriction, including without limitation the rights -to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -copies of the Software, and to permit persons to whom the Software is -furnished to do so, subject to the following conditions: - -The above copyright notice and this permission notice shall be included in -all copies or substantial portions of the Software. - -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -X CONSORTIUM BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN -AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN -CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. - -Except as contained in this notice, the name of the X Consortium shall not be -used in advertising or otherwise to promote the sale, use or other dealings -in this Software without prior written authorization from the X Consortium. - -*/ - -/* From the original /bin/sh script: - - Used to create a copy of the a directory tree that has links for all - non-directories (except those named RCS, SCCS or CVS.adm). If you are - building the distribution on more than one machine, you should use - this technique. - - If your master sources are located in /usr/local/src/X and you would like - your link tree to be in /usr/local/src/new-X, do the following: - - % mkdir /usr/local/src/new-X - % cd /usr/local/src/new-X - % lndir ../X -*/ - -#include "lndir-Xos.h" -#include <stdlib.h> -#include <stdio.h> -#include <sys/stat.h> -#include <sys/param.h> -#include <errno.h> - -#ifndef X_NOT_POSIX -#include <dirent.h> -#else -#ifdef SYSV -#include <dirent.h> -#else -#ifdef USG -#include <dirent.h> -#else -#include <sys/dir.h> -#ifndef dirent -#define dirent direct -#endif -#endif -#endif -#endif -#ifndef MAXPATHLEN -#define MAXPATHLEN 2048 -#endif - -#ifdef __CYGWIN32__ -#include <sys/cygwin.h> -#endif - -#if NeedVarargsPrototypes -#include <stdarg.h> -#endif - -#ifdef X_NOT_STDC_ENV -extern int errno; -#endif -int silent = 0; /* -silent */ -int ignore_links = 0; /* -ignorelinks */ - -char *rcurdir; -char *curdir; - -int force=0; - -void -quit ( -#if NeedVarargsPrototypes - int code, char * fmt, ...) -#else - code, fmt, a1, a2, a3) - char *fmt; -#endif -{ -#if NeedVarargsPrototypes - va_list args; - va_start(args, fmt); - vfprintf (stderr, fmt, args); - va_end(args); -#else - fprintf (stderr, fmt, a1, a2, a3); -#endif - putc ('\n', stderr); - exit (code); -} - -void -quiterr (code, s) - char *s; -{ - perror (s); - exit (code); -} - -void -msg ( -#if NeedVarargsPrototypes - char * fmt, ...) -#else - fmt, a1, a2, a3) - char *fmt; -#endif -{ -#if NeedVarargsPrototypes - va_list args; -#endif - if (curdir) { - fprintf (stderr, "%s:\n", curdir); - curdir = 0; - } -#if NeedVarargsPrototypes - va_start(args, fmt); - vfprintf (stderr, fmt, args); - va_end(args); -#else - fprintf (stderr, fmt, a1, a2, a3); -#endif - putc ('\n', stderr); -} - -void -mperror (s) - char *s; -{ - if (curdir) { - fprintf (stderr, "%s:\n", curdir); - curdir = 0; - } - perror (s); -} - - -int equivalent(lname, rname) - char *lname; - char *rname; -{ - char *s; - - if (!strcmp(lname, rname)) - return 1; - for (s = lname; *s && (s = strchr(s, '/')); s++) { - while (s[1] == '/') - strcpy(s+1, s+2); - } - return !strcmp(lname, rname); -} - - -/* Recursively create symbolic links from the current directory to the "from" - directory. Assumes that files described by fs and ts are directories. */ - -dodir (fn, fs, ts, rel) -char *fn; /* name of "from" directory, either absolute or - relative to cwd */ -struct stat *fs, *ts; /* stats for the "from" directory and cwd */ -int rel; /* if true, prepend "../" to fn before using */ -{ - DIR *df; - struct dirent *dp; - char buf[MAXPATHLEN + 1], *p; - char symbuf[MAXPATHLEN + 1]; - char basesym[MAXPATHLEN + 1]; - struct stat sb, sc; - int n_dirs; - int symlen; - int basesymlen = -1; - char *ocurdir; - - if ((fs->st_dev == ts->st_dev) && (fs->st_ino == ts->st_ino)) { - msg ("%s: From and to directories are identical!", fn); - return 1; - } - - if (rel) - strcpy (buf, "../"); - else - buf[0] = '\0'; - strcat (buf, fn); - - if (!(df = opendir (buf))) { - msg ("%s: Cannot opendir", buf); - return 1; - } - - p = buf + strlen (buf); - *p++ = '/'; - n_dirs = fs->st_nlink; - while (dp = readdir (df)) { - if (dp->d_name[strlen(dp->d_name) - 1] == '~') - continue; - if (dp->d_name[0] == '.' && dp->d_name[1] == '#') /* 'non-conflict files' left behind by CVS */ - continue; - strcpy (p, dp->d_name); - - if (n_dirs > 0) { - if (stat (buf, &sb) < 0) { - mperror (buf); - continue; - } - -#ifdef S_ISDIR - if(S_ISDIR(sb.st_mode)) -#else - if (sb.st_mode & S_IFDIR) -#endif - { - /* directory */ -#ifndef __CYGWIN32__ /* don't trust cygwin's n_dirs count */ - n_dirs--; -#endif - if (dp->d_name[0] == '.' && - (dp->d_name[1] == '\0' || (dp->d_name[1] == '.' && - dp->d_name[2] == '\0'))) - continue; - if (!strcmp (dp->d_name, "RCS")) - continue; - if (!strcmp (dp->d_name, "SCCS")) - continue; - if (!strcmp (dp->d_name, "CVS")) - continue; - if (!strcmp (dp->d_name, ".svn")) - continue; - if (!strcmp (dp->d_name, "_darcs")) - continue; - if (!strcmp (dp->d_name, "CVS.adm")) - continue; - ocurdir = rcurdir; - rcurdir = buf; - curdir = silent ? buf : (char *)0; - if (!silent) - printf ("%s:\n", buf); - if ((stat (dp->d_name, &sc) < 0) && (errno == ENOENT)) { - if (mkdir (dp->d_name, 0777) < 0 || - stat (dp->d_name, &sc) < 0) { - mperror (dp->d_name); - curdir = rcurdir = ocurdir; - continue; - } - } - if (readlink (dp->d_name, symbuf, sizeof(symbuf) - 1) >= 0) { - msg ("%s: is a link instead of a directory", dp->d_name); - curdir = rcurdir = ocurdir; - continue; - } - if (chdir (dp->d_name) < 0) { - mperror (dp->d_name); - curdir = rcurdir = ocurdir; - continue; - } - dodir (buf, &sb, &sc, (buf[0] != '/')); - if (chdir ("..") < 0) - quiterr (1, ".."); - curdir = rcurdir = ocurdir; - continue; - } - } - - /* non-directory */ - symlen = readlink (dp->d_name, symbuf, sizeof(symbuf) - 1); - if (symlen >= 0) - symbuf[symlen] = '\0'; - - /* The option to ignore links exists mostly because - checking for them slows us down by 10-20%. - But it is off by default because this really is a useful check. */ - if (!ignore_links) { - /* see if the file in the base tree was a symlink */ - basesymlen = readlink(buf, basesym, sizeof(basesym) - 1); - if (basesymlen >= 0) - basesym[basesymlen] = '\0'; - } - - if (symlen >= 0) { - if (!equivalent (basesymlen>=0 ? basesym : buf, symbuf)) { - if (force) { - unlink(dp->d_name); - if (symlink (basesymlen>=0 ? basesym : buf, dp->d_name) < 0) - mperror (dp->d_name); - } else { - /* Link exists in new tree. Print message if it doesn't match. */ - msg ("%s: %s", dp->d_name, symbuf); - } - } - } else { - if (symlink (basesymlen>=0 ? basesym : buf, dp->d_name) < 0) - mperror (dp->d_name); - } - } - - closedir (df); - return 0; -} - - -main (ac, av) -int ac; -char **av; -{ - char *prog_name = av[0]; - char* tn; - struct stat fs, ts; -#ifdef __CYGWIN32__ - /* - The lndir code assumes unix-style paths to work. cygwin - lets you get away with using dos'ish paths (e.g., "f:/oo") - in most contexts. Using them with 'lndir' will seriously - confuse the user though, so under-the-hood, we convert the - path into something POSIX-like. - */ - static char fn[MAXPATHLEN+1]; -#else - char *fn; -#endif - - while (++av, --ac) { - if (strcmp(*av, "-silent") == 0) - silent = 1; - else if (strcmp(*av, "-f") == 0) - force = 1; - else if (strcmp(*av, "-ignorelinks") == 0) - ignore_links = 1; - else if (strcmp(*av, "--") == 0) { - ++av, --ac; - break; - } else - break; - } - - if (ac < 1 || ac > 2) - quit (1, "usage: %s [-f] [-silent] [-ignorelinks] fromdir [todir]", - prog_name); - -#ifdef __CYGWIN32__ - cygwin_conv_to_full_posix_path(av[0], fn); -#else - fn = av[0]; -#endif - - if (ac == 2) - tn = av[1]; - else - tn = "."; - - /* to directory */ - if (stat (tn, &ts) < 0) { - if (force && (tn[0] != '.' || tn[1] != '\0') ) { - mkdir(tn, S_IRWXU | S_IRWXG | S_IROTH | S_IXOTH ); - } - else { - quiterr (1, tn); -#ifdef S_ISDIR - if (!(S_ISDIR(ts.st_mode))) -#else - if (!(ts.st_mode & S_IFDIR)) -#endif - quit (2, "%s: Not a directory", tn); - } - } - if (chdir (tn) < 0) - quiterr (1, tn); - - /* from directory */ - if (stat (fn, &fs) < 0) - quiterr (1, fn); -#ifdef S_ISDIR - if (!(S_ISDIR(fs.st_mode))) -#else - if (!(fs.st_mode & S_IFDIR)) -#endif - quit (2, "%s: Not a directory", fn); - - exit (dodir (fn, &fs, &ts, 0)); -} diff --git a/glafp-utils/ltx/Makefile b/glafp-utils/ltx/Makefile deleted file mode 100644 index 6271c07b42..0000000000 --- a/glafp-utils/ltx/Makefile +++ /dev/null @@ -1,12 +0,0 @@ -TOP=.. -include $(TOP)/mk/boilerplate.mk - -SCRIPT_PROG=ltx -SCRIPT_OBJS=ltx.prl -SCRIPT_SUBST_VARS=DEFAULT_TMPDIR CONTEXT_DIFF - -INTERP=perl -DESTDIR=$(INSTSCRIPTDIR) -CLEAN_FILES += $(SCRIPT_PROG) - -include $(TOP)/mk/target.mk diff --git a/glafp-utils/ltx/ltx.prl b/glafp-utils/ltx/ltx.prl deleted file mode 100644 index 96dbc71026..0000000000 --- a/glafp-utils/ltx/ltx.prl +++ /dev/null @@ -1,229 +0,0 @@ -# -# The perl script requires bindings for the following -# variables to be prepended: -# DEFAULT_TMPDIR -# CONTEXTDIFF -# - -$Pgm = $0; $Pgm =~ s/.*\/([^\/]+)$/\1/; -# -# set up signal handler -sub quit_upon_signal { &rm_temp_files_and_exit(); } -$SIG{'INT'} = 'quit_upon_signal'; -$SIG{'QUIT'} = 'quit_upon_signal'; -# -$Verbose = 0; -if ($ARGV[0] eq '-v') { - $Verbose = 1; - shift(@ARGV); -} -# -die "$Pgm: must have exactly one argument\n" if $#ARGV != 0; -# figure out input file and its filename root -if (-f $ARGV[0]) { - $TeX_input = $ARGV[0]; - if ($TeX_input =~ /(.+)\.[^\.\/\n]+$/) { - $TeX_root = $1; - } else { - $TeX_root = $TeX_input; - } -} elsif (-f $ARGV[0].'.tex') { - $TeX_input = $ARGV[0].'.tex'; - $TeX_root = $ARGV[0]; -} else { - die "$Pgm: input file $ARGV[0] doesn't exist\n"; -} - -if ( $ENV{'TMPDIR'} ) { # where to make tmp file names - $Tmp_prefix = $ENV{'TMPDIR'} ; -} else { - $Tmp_prefix ="$DEFAULT_TMPDIR"; - $ENV{'TMPDIR'} = "$DEFAULT_TMPDIR"; # set the env var as well -} - -sub rm_temp_files { - system("rm -f $Tmp_prefix/ltx-*.$$"); -} -sub rm_temp_files_and_exit { - system("rm -f $Tmp_prefix/ltx-*.$$"); - exit(1); -} -$SIG{'INT'} = 'rm_temp_files_and_exit'; -$SIG{'QUIT'} = 'rm_temp_files_and_exit'; - -sub die_gracefully { - local($msg) = @_; - - print STDERR $msg; - &rm_temp_files_and_exit(); -} - -# must read through root file to see if a \bibliography -# is there... -$Bibliography_requested = 0; -open(TEXIF, "<$TeX_input") - || &die_gracefully("$Pgm: Can't read $TeX_input\n"); -while (<TEXIF>) { - $Bibliography_requested = 1 if /^\\bibliography/; -} -close(TEXIF); -&die_gracefully("$Pgm: reading $TeX_input had errors\n") if $? >> 8; - -# run latex first time (?) -&run_latex(); # sets $Says_labels_changed -$Times_run = 1; - -while (&something_more_needed()) { - - print STDERR "labels_changed=$Says_label_changed;bibtex_needed=$BibTeX_run_needed;makeindex_needed=$MakeIndex_run_needed\n" if $Verbose; - - if ($BibTeX_run_needed) { - &run_bibtex(); - } - if ($MakeIndex_run_needed) { - unlink "$TeX_root.ind"; - (system("makeindex $TeX_root.idx") >> 8) - && &die_gracefully("$Pgm: makeindex $TeX_root.idx had errors\n"); - } - - # save (copy) .aux file as .aux-prev file for future ref - # ditto for .idx file - unlink "$TeX_root.aux-prev"; - (system("cp $TeX_root.aux $TeX_root.aux-prev") >> 8) - && &die_gracefully("$Pgm: cp $TeX_root.aux $TeX_root.aux-prev failed\n"); - if (-f "$TeX_root.idx") { - unlink "$TeX_root.idx-prev"; - (system("cp $TeX_root.idx $TeX_root.idx-prev") >> 8) - && &die_gracefully("$Pgm: cp $TeX_root.idx $TeX_root.idx-prev failed\n"); - } - - # run latex again - &run_latex(); # sets $Says_labels_changed - $Times_run++; - - if ($Times_run >= 4) { - print STDERR "*** I don't run LaTeX more than four times;\n"; - print STDERR "*** Something is probably wrong...\n"; - &rm_temp_files_and_exit(); - } -} -&rm_temp_files(); -exit(0); - -sub run_latex { - $Says_labels_changed = 0; - $Multiply_defined_labels = 0; - - select(STDERR); $| = 1; select(STDOUT); # no buffering on STDERR - print STDERR "$Pgm: *** running LaTeX...\n" if $Verbose; - unlink "$TeX_root.dvi"; - - open(LTXPIPE, "latex $TeX_input 2>&1 |") - || &die_gracefully("$Pgm: Can't run latex pipe\n"); - while (<LTXPIPE>) { - $Multiply_defined_labels = 1 if /^LaTeX Warning: Label .* multiply defined/; - $Says_labels_changed = 1 if /^LaTeX Warning: Label\(s\) may have changed/ - && ! $Multiply_defined_labels; - print STDERR $_; - } - close(LTXPIPE); - &die_gracefully("$Pgm: LaTeX run had errors\n") if $? >> 8; - - # sort .idx file, because this helps makeindex - # (can you say `bug'?) - if (-f "$TeX_root.idx") { - print STDERR "$Pgm: *** sorting $TeX_root.idx...\n" if $Verbose; - (system("sort $TeX_root.idx -o $TeX_root.idx") >> 8) - && &die_gracefully("$Pgm: sorting $TeX_root.idx failed\n"); - } - -} - -sub run_bibtex { # ugly because bibtex doesn't return a correct error status - local($bibtex_had_errors) = 0; - - print STDERR "$Pgm: *** running BibTeX...\n" if $Verbose; - unlink "$TeX_root.bbl"; - - $| = 1; # no buffering - open(BIBTXPIPE, "bibtex $TeX_root 2>&1 |") - || &die_gracefully("$Pgm: Can't run bibtex pipe\n"); - while (<BIBTXPIPE>) { - $bibtex_had_errors = 1 if /^\(There.*error message(s)?\)$/; - print STDERR $_; - } - close(BIBTXPIPE); - &die_gracefully("$Pgm: BibTeX run had errors\n") - if $? >> 8 || $bibtex_had_errors; -} - -sub something_more_needed { - # returns 1 or 0 if we need to run LaTeX - # possibly preceded by bibtex and/or makeindex run - - # $Says_labels_changed was set by previous &run_latex... - $BibTeX_run_needed = 0; - $MakeIndex_run_needed = 0; - - if ( ! -f ($TeX_root . '.aux-prev')) { # this was the first run - - print STDERR "$Pgm: *** 'twas first run of LaTeX on $TeX_input\n" if $Verbose; - - # we need makeindex to run if a non-zero-sized .idx file exists - # - $MakeIndex_run_needed = 1 - if -f "$TeX_root.idx" && -s "$TeX_root.idx"; - - # we need bibtex to run if there are \citations in the .aux file - # - &slurp_aux_file('aux'); - $BibTeX_run_needed = 1 - if $Bibliography_requested && - -f "$Tmp_prefix/ltx-aux-cite.$$" && - -s "$Tmp_prefix/ltx-aux-cite.$$"; - - - } else { # ltx had been run before (.aux-prev/.idx-prev files exist) - - # slurp both .aux and .aux-prev files - &slurp_aux_file('aux'); - &slurp_aux_file('aux-prev'); - - local($tmp_pre) = "$Tmp_prefix/ltx"; - - if ((-s "$tmp_pre-.aux-cite.$$") # there are still \cite's in there - && (system("cmp -s $tmp_pre-.aux-cite.$$ $tmp_pre-.aux-prev-cite.$$") >> 8)) { - $BibTeX_run_needed = 1 if $Bibliography_requested; - if ($Verbose) { - system("$CONTEXT_DIFF $tmp_pre-.aux-prev-cite.$$ $tmp_pre-.aux-cite.$$"); - } - } - - if (-f "$TeX_root.idx") { - $MakeIndex_run_needed = - (system("cmp -s $TeX_root.idx $TeX_root.idx-prev") >> 8) ? 1 : 0; - if ($MakeIndex_run_needed && $Verbose) { - system("$CONTEXT_DIFF $TeX_root.idx-prev $TeX_root.idx"); - } - } - } - - $Says_labels_changed || $BibTeX_run_needed || $MakeIndex_run_needed; -} - -sub slurp_aux_file { - local($ext) = @_; - - # copy all citations from slurpfile into $Tmp_prefix/ltx-$ext-cite.$$ - - open(SLURPF,"< $TeX_root.$ext") - || &die_gracefully("$Pgm: Can't open $TeX_root.$ext for reading\n"); - open(CITEF,"> $Tmp_prefix/ltx-$ext-cite.$$") - || &die_gracefully("$Pgm: Can't open $Tmp_prefix/ltx-$ext-cite.$$ for writing\n"); - - while (<SLURPF>) { - print CITEF $_ if /\\citation/; - } - close(CITEF); - close(SLURPF); -} diff --git a/glafp-utils/mk/boilerplate.mk b/glafp-utils/mk/boilerplate.mk deleted file mode 100644 index e645586a5d..0000000000 --- a/glafp-utils/mk/boilerplate.mk +++ /dev/null @@ -1,32 +0,0 @@ -################################################################################ -# -# GHC boilerplate.mk -# -# Boilerplate Makefile for an fptools project -# -################################################################################ - -# Begin by slurping in the boilerplate from one level up. -# Remember, TOP is the top level of the innermost level -# (FPTOOLS_TOP is the fptools top) - -# We need to set TOP to be the TOP that the next level up expects! -GLAFP_UTILS_TOP := $(TOP) -TOP:=$(GLAFP_UTILS_TOP)/.. - -include $(TOP)/mk/boilerplate.mk - -TOP:=$(GLAFP_UTILS_TOP) - -# ----------------------------------------------------------------- -# Everything after this point -# augments or overrides previously set variables. -# (these files are optional, so `make' won't fret if -# cannot get to them). -# ----------------------------------------------------------------- - -#Not currently used: -include $(GLAFP_UTILS_TOP)/mk/paths.mk -#Not currently used: -include $(GLAFP_UTILS_TOP)/mk/suffix.mk - -# No ways, please -WAYS= diff --git a/glafp-utils/mk/target.mk b/glafp-utils/mk/target.mk deleted file mode 100644 index a2ed36c3c9..0000000000 --- a/glafp-utils/mk/target.mk +++ /dev/null @@ -1,7 +0,0 @@ -# -# (c) The GHC Team 2000 -# - -TOP:=$(TOP)/.. -include $(TOP)/mk/target.mk -TOP:=$(GLAFP_UTILS_TOP) diff --git a/glafp-utils/mkdependC/Makefile b/glafp-utils/mkdependC/Makefile deleted file mode 100644 index 9a96fdf276..0000000000 --- a/glafp-utils/mkdependC/Makefile +++ /dev/null @@ -1,21 +0,0 @@ -# -# Boilerplate Makefile for building perl script that -# needs some configured constants prepended to it. -# -TOP=.. -include $(TOP)/mk/boilerplate.mk - -boot :: all - -SCRIPT_PROG=mkdependC -SCRIPT_OBJS=mkdependC.prl -# -# Prepend (perl) bindings for these Makefile variables -# when creating `mkdependC' (a more flexible way of doing msub). -# -SCRIPT_SUBST_VARS=DEFAULT_TMPDIR CPP BUILDPLATFORM - -CLEAN_FILES += $(SCRIPT_PROG) -INTERP=perl - -include $(TOP)/mk/target.mk diff --git a/glafp-utils/mkdependC/mkdependC.prl b/glafp-utils/mkdependC/mkdependC.prl deleted file mode 100644 index f7af53ac3c..0000000000 --- a/glafp-utils/mkdependC/mkdependC.prl +++ /dev/null @@ -1,231 +0,0 @@ -# -# This perl script template assumes that definitions for -# the following variables are prepended: -# -# DEFAULT_TMPDIR CPP BUILDPLATFORM -# -# ToDo: strip out all the .h junk -# -($Pgm = $0) =~ s/.*\/([^\/]+)$/\1/; -$Usage = "usage: $Pgm: not done yet\n"; - -$Status = 0; # just used for exit() status -$Verbose = 0; -$Dashdashes_seen = 0; - -$Begin_magic_str = "# DO NOT DELETE: Beginning of C dependencies"; -$End_magic_str = "# DO NOT DELETE: End of C dependencies"; -$Obj_suffix = 'o'; -@Defines = (); -$Include_dirs = ''; -$Makefile = ''; -@Src_files = (); -@File_suffix = (); -$baseName=''; -$ignore_output='> /dev/null'; - -if ( ${BUILDPLATFORM} eq "i386-unknown-mingw32" ) { - # Assuming the underlying perl uses cmd to exec system() calls. - $ignore_output = ">nul"; -} - -if ( $ENV{'TMPDIR'} ) { # where to make tmp file names - $Tmp_prefix = $ENV{'TMPDIR'} . "/mkdependC$$"; -} else { - $Tmp_prefix ="${DEFAULT_TMPDIR}/mkdependC$$"; - $ENV{'TMPDIR'} = "${DEFAULT_TMPDIR}"; # set the env var as well -} - -$tempfile = ''; - -sub quit_upon_signal { - if (-f $tempfile) { - print STDERR "Deleting $tempfile .. \n"; - unlink $tempfile; - } -} -$SIG{'INT'} = 'quit_upon_signal'; -$SIG{'QUIT'} = 'quit_upon_signal'; - -&mangle_command_line_args(); - -if ( ! $Makefile && -f 'makefile' ) { - $Makefile = 'makefile'; -} elsif ( ! $Makefile && -f 'Makefile') { - $Makefile = 'Makefile'; -} elsif ( ! $Makefile) { - die "$Pgm: no makefile or Makefile found\n"; -} - -@Depend_lines = (); - -print STDERR "Include_dirs=$Include_dirs\n" if $Verbose; - -foreach $sf (@Src_files) { - # just like lit-inputter - # except it puts each file through CPP and - # a de-commenter (not implemented); - # builds up @Depend_lines - print STDERR "Here we go for source file: $sf\n" if $Verbose; - ($baseName = $sf) =~ s/\.(c|hc)$//; - - &slurp_file($sf, 'fh00'); -} - -# Tiresome EOL termination issues -if ( ${BUILDPLATFORM} eq "i386-unknown-mingw32" ) { - $Begin_magic_str = $Begin_magic_str . "\r\n"; - $End_magic_str = $End_magic_str . "\r\n"; -} else { - $Begin_magic_str = $Begin_magic_str . "\n"; - $End_magic_str = $End_magic_str . "\n"; -} - -# OK, mangle the Makefile -unlink("$Makefile.bak"); -rename($Makefile,"$Makefile.bak"); -# now copy Makefile.bak into Makefile, rm'ing old dependencies -# and adding the new -open(OMKF,"< $Makefile.bak") || die "$Pgm: can't open $Makefile.bak: $!\n"; -open(NMKF,"> $Makefile") || die "$Pgm: can't open $Makefile: $!\n"; -binmode(OMKF); # Do not add stupid ^M's to the output on Win32 -binmode(NMKF); # Do not add stupid ^M's to the output on Win32 - -select(NMKF); -$_ = <OMKF>; -while ($_ && $_ ne $Begin_magic_str) { # copy through, 'til Begin_magic_str - print $_; - $_ = <OMKF>; -} -while ($_ && $_ ne $End_magic_str) { # delete 'til End_magic_str - $_ = <OMKF>; -} -# insert dependencies -print $Begin_magic_str; -print @Depend_lines; -print $End_magic_str; -while (<OMKF>) { # copy the rest through - print $_; -} -close(NMKF); -close(OMKF); -exit 0; - -sub mangle_command_line_args { - while($_ = $ARGV[0]) { - shift(@ARGV); - - if ( /^--$/ ) { - $Dashdashes_seen++; - - } elsif ( /^(-optc)?(-D.*)/ ) { # recognized wherever they occur - push(@Defines, $2); - } elsif ( /^(-optc)?(-I.*)/ ) { - $Include_dirs .= " $2"; - - } elsif ($Dashdashes_seen != 1) { # not between -- ... -- - if ( /^-v$/ ) { - $Verbose++; - } elsif ( /^-f/ ) { - $Makefile = &grab_arg_arg($_); - } elsif ( /^-o/ ) { - $Obj_suffix = &grab_arg_arg($_); - } elsif ( /^-s/ ) { - local($suff) = &grab_arg_arg($_); - push(@File_suffix, $suff); - } elsif ( /^-bs/ ) { - $Begin_magic_str = &grab_arg_arg($_); - } elsif ( /^-es/ ) { - $End_magic_str = &grab_arg_arg($_); - } elsif ( /^-w/ ) { - $Width = &grab_arg_arg($_); - } elsif ( /^-/ ) { - print STDERR "$Pgm: unknown option ignored: $_\n"; - } else { - push(@Src_files, $_); - } - - } elsif ($Dashdashes_seen == 1) { # where we ignore unknown options - push(@Src_files,$_) if ! /^-/; - } - } -} - -sub grab_arg_arg { - local($option) = @_; - local($rest_of_arg); - - ($rest_of_arg = $option) =~ s/^-.//; - - if ($rest_of_arg) { - return($rest_of_arg); - } elsif ($#ARGV >= 0) { - local($temp) = $ARGV[0]; shift(@ARGV); - return($temp); - } else { - die "$Pgm: no argument following $option option\n"; - } -} - -sub slurp_file { # follows an example in the `open' item in perl man page - local($fname,$fhandle) = @_; - local($depend,$dep); # tmp - local(@Deps); - - $fhandle++; # a string increment - - $fname = &tidy_dir_names($fname); - - ($tempfile = $fname) =~ s/\.[^\.]*$/\.d/; - $tempfile =~ s|.*/([^/]+)$|$1|g; - - # ${CPP} better be 'gcc -E', or the -x option will fail... - # ..and the -MM & -MMD. - $result = system("${CPP} -MM -MMD $Include_dirs @Defines -x c $fname $ignore_output"); - - if ($result != 0) { - # On the cheesy side..we do want to know what went wrong, so - # re-run the command. - $result = system("${CPP} -MM -MMD $Include_dirs @Defines -x c $fname "); - if ($result != 0) { - unlink($tempfile); - exit($result); - } - }; - - local($dep_contents)=''; - local($deps)=''; - open($fhandle, $tempfile) || die "$Pgm: Can't open $tempfile: $!\n"; - - while (<$fhandle>) { - chop; - $dep_contents .= $_; - } - ($deps = $dep_contents) =~ s|^[^:]+:(.*)$|$1|g; - $deps =~ s| \\| |g; - - @Deps = split(/ +/, $deps); - - $depend = "$baseName.$Obj_suffix"; - foreach $suff (@File_suffix) { - $depend .= " $baseName.${suff}_$Obj_suffix"; - } - - foreach $dep (@Deps) { - push(@Depend_lines, "$depend: $dep\n") if $dep ne ''; - } - - close($fhandle); - unlink($tempfile); - $tempfile = ''; # for quit_upon_signal -} - -sub tidy_dir_names { # rm various pernicious dir-name combinations... - local($str) = @_; - - $str =~ s|/[^/.][^/]*/\.\.||g; # nuke: /<dir>/.. - $str =~ s|/\.[^.][^/]*/\.\.||g; # nuke: /./.. (and others) - $str =~ s|"||g; - $str =~ s| \./| |; - $str; -} diff --git a/glafp-utils/mkdirhier/Makefile b/glafp-utils/mkdirhier/Makefile deleted file mode 100644 index 8ae4c4a50f..0000000000 --- a/glafp-utils/mkdirhier/Makefile +++ /dev/null @@ -1,12 +0,0 @@ -# -# - -TOP=.. -include $(TOP)/mk/boilerplate.mk - -SCRIPT_PROG=mkdirhier -SCRIPT_OBJS=mkdirhier.sh -INTERP=$(SHELL) -CLEAN_FILES += $(SCRIPT_PROG) - -include $(TOP)/mk/target.mk diff --git a/glafp-utils/mkdirhier/mkdirhier.sh b/glafp-utils/mkdirhier/mkdirhier.sh deleted file mode 100644 index 3ae24b3c6e..0000000000 --- a/glafp-utils/mkdirhier/mkdirhier.sh +++ /dev/null @@ -1,34 +0,0 @@ -#!/bin/sh - -# -# create a hierarchy of directories -# -# Based on Noah Friedman's mkinstalldirs.. -# -errs=0 - -for f in $*; do - parts=`echo ":$f" | sed -ne 's/^:\//#/;s/^://;s/\// /g;s/^#/\//;p'` - path=""; - for p in $parts; do - path="$path$p" - case "$path" in - -* ) path=./$path ;; - esac - - if test ! -d "$path"; then - echo "mkdir $path" 1>&2 - - mkdir "$path" || lasterr=$? - - if test ! -d "$path"; then - errs=$lasterr - fi - fi - path="$path/"; - done; -done - -exit $errs - -# end of story diff --git a/glafp-utils/nofib-analyse/CmdLine.hs b/glafp-utils/nofib-analyse/CmdLine.hs deleted file mode 100644 index 6e920f8c60..0000000000 --- a/glafp-utils/nofib-analyse/CmdLine.hs +++ /dev/null @@ -1,69 +0,0 @@ ------------------------------------------------------------------------------ --- CmdLine.hs - --- (c) Simon Marlow 2005 ------------------------------------------------------------------------------ - -module CmdLine where - -import System.Console.GetOpt -import System.Environment ( getArgs ) -import System.IO.Unsafe ( unsafePerformIO ) - ------------------------------------------------------------------------------ --- Command line arguments - -args = unsafePerformIO getArgs -(flags, other_args, cmdline_errors) = getOpt Permute argInfo args - -default_tooquick_threshold = 0.2 {- secs -} :: Float -tooquick_threshold - = case [ i | OptIgnoreSmallTimes i <- flags ] of - [] -> default_tooquick_threshold - (i:_) -> i - -devs = OptDeviations `elem` flags -nodevs = OptNoDeviations `elem` flags - -default_title = "NoFib Results" -reportTitle = case [ t | OptTitle t <- flags ] of - [] -> default_title - (t:_) -> t - -data CLIFlags - = OptASCIIOutput - | OptLaTeXOutput - | OptHTMLOutput - | OptIgnoreSmallTimes Float - | OptDeviations - | OptNoDeviations - | OptTitle String - | OptColumns String - | OptRows String - | OptHelp - deriving Eq - -argInfo :: [ OptDescr CLIFlags ] -argInfo = - [ Option ['?'] ["help"] (NoArg OptHelp) - "Display this message" - , Option ['a'] ["ascii"] (NoArg OptASCIIOutput) - "Produce ASCII output (default)" - , Option ['h'] ["html"] (NoArg OptHTMLOutput) - "Produce HTML output" - , Option ['i'] ["ignore"] (ReqArg (OptIgnoreSmallTimes . read) "secs") - "Ignore runtimes smaller than <secs>" - , Option ['d'] ["deviations"] (NoArg OptDeviations) - "Display deviations (default)" - , Option ['l'] ["latex"] (NoArg OptLaTeXOutput) - "Produce LaTeX output" - , Option [] ["columns"] (ReqArg OptColumns "COLUMNS") - "Specify columns for summary table (comma separates)" - , Option [] ["rows"] (ReqArg OptRows "ROWS") - "Specify rows for summary table (comma separates)" - , Option ['n'] ["nodeviations"] (NoArg OptNoDeviations) - "Hide deviations" - , Option ['t'] ["title"] (ReqArg OptTitle "title") - "Specify report title" - ] - diff --git a/glafp-utils/nofib-analyse/GenUtils.lhs b/glafp-utils/nofib-analyse/GenUtils.lhs deleted file mode 100644 index 540199f972..0000000000 --- a/glafp-utils/nofib-analyse/GenUtils.lhs +++ /dev/null @@ -1,297 +0,0 @@ ------------------------------------------------------------------------------ --- $Id: GenUtils.lhs,v 1.1 1999/11/12 11:54:17 simonmar Exp $ - --- Some General Utilities, including sorts, etc. --- This is realy just an extended prelude. --- All the code below is understood to be in the public domain. ------------------------------------------------------------------------------ - -> module GenUtils ( - -> partition', tack, -> assocMaybeErr, -> arrElem, -> memoise, -> returnMaybe,handleMaybe, findJust, -> MaybeErr(..), -> maybeMap, -> joinMaybe, -> mkClosure, -> foldb, -> sortWith, -> sort, -> cjustify, -> ljustify, -> rjustify, -> space, -> copy, -> combinePairs, -> --trace, -- re-export it -> fst3, -> snd3, -> thd3 - -#if __HASKELL1__ < 3 || ( defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 200 ) - -> ,Cmp(..), compare, lookup, isJust - -#endif - -> ) where - -#if __HASKELL1__ >= 3 && ( !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ >= 200 ) - -> import Ix ( Ix(..) ) -> import Array ( listArray, array, (!) ) - -#define Text Show -#define ASSOC(a,b) (a , b) -#else -#define ASSOC(a,b) (a := b) -#endif - -%------------------------------------------------------------------------------ - -Here are two defs that everyone seems to define ... -HBC has it in one of its builtin modules - -#ifdef __GOFER__ - - primitive primPrint "primPrint" :: Int -> a -> ShowS - -#endif - -#ifdef __GOFER__ - - primitive primGenericEq "primGenericEq", - primGenericNe "primGenericNe", - primGenericLe "primGenericLe", - primGenericLt "primGenericLt", - primGenericGe "primGenericGe", - primGenericGt "primGenericGt" :: a -> a -> Bool - - instance Text (Maybe a) where { showsPrec = primPrint } - instance Eq (Maybe a) where - (==) = primGenericEq - (/=) = primGenericNe - - instance (Ord a) => Ord (Maybe a) - where - Nothing <= _ = True - _ <= Nothing = True - (Just a) <= (Just b) = a <= b - -#endif - -> maybeMap :: (a -> b) -> Maybe a -> Maybe b -> maybeMap f (Just a) = Just (f a) -> maybeMap f Nothing = Nothing - -> joinMaybe :: (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a -> joinMaybe _ Nothing Nothing = Nothing -> joinMaybe _ (Just g) Nothing = Just g -> joinMaybe _ Nothing (Just g) = Just g -> joinMaybe f (Just g) (Just h) = Just (f g h) - -> data MaybeErr a err = Succeeded a | Failed err deriving (Eq,Text) - -@mkClosure@ makes a closure, when given a comparison and iteration loop. -Be careful, because if the functional always makes the object different, -This will never terminate. - -> mkClosure :: (a -> a -> Bool) -> (a -> a) -> a -> a -> mkClosure eq f = match . iterate f -> where -> match (a:b:c) | a `eq` b = a -> match (_:c) = match c - -> foldb :: (a -> a -> a) -> [a] -> a -> foldb f [] = error "can't reduce an empty list using foldb" -> foldb f [x] = x -> foldb f l = foldb f (foldb' l) -> where -> foldb' (x:y:x':y':xs) = f (f x y) (f x' y') : foldb' xs -> foldb' (x:y:xs) = f x y : foldb' xs -> foldb' xs = xs - -Merge two ordered lists into one ordered list. - -> mergeWith :: (a -> a -> Bool) -> [a] -> [a] -> [a] -> mergeWith _ [] ys = ys -> mergeWith _ xs [] = xs -> mergeWith le (x:xs) (y:ys) -> | x `le` y = x : mergeWith le xs (y:ys) -> | otherwise = y : mergeWith le (x:xs) ys - -> insertWith :: (a -> a -> Bool) -> a -> [a] -> [a] -> insertWith _ x [] = [x] -> insertWith le x (y:ys) -> | x `le` y = x:y:ys -> | otherwise = y:insertWith le x ys - -Sorting is something almost every program needs, and this is the -quickest sorting function I know of. - -> sortWith :: (a -> a -> Bool) -> [a] -> [a] -> sortWith le [] = [] -> sortWith le lst = foldb (mergeWith le) (splitList lst) -> where -> splitList (a1:a2:a3:a4:a5:xs) = -> insertWith le a1 -> (insertWith le a2 -> (insertWith le a3 -> (insertWith le a4 [a5]))) : splitList xs -> splitList [] = [] -> splitList (r:rs) = [foldr (insertWith le) [r] rs] - -> sort :: (Ord a) => [a] -> [a] -> sort = sortWith (<=) - -> returnMaybe :: a -> Maybe a -> returnMaybe = Just - -> handleMaybe :: Maybe a -> Maybe a -> Maybe a -> handleMaybe m k = case m of -> Nothing -> k -> _ -> m - -> findJust :: (a -> Maybe b) -> [a] -> Maybe b -> findJust f = foldr handleMaybe Nothing . map f - - -Gofer-like stuff: - -> fst3 (a,_,_) = a -> snd3 (_,a,_) = a -> thd3 (_,a,_) = a - -> cjustify, ljustify, rjustify :: Int -> String -> String -> cjustify n s = space halfm ++ s ++ space (m - halfm) -> where m = n - length s -> halfm = m `div` 2 -> ljustify n s = s ++ space (n - length s) -> rjustify n s = let s' = take n s in space (n - length s') ++ s' - -> space :: Int -> String -> space n | n < 0 = "" -> | otherwise = copy n ' ' - -> copy :: Int -> a -> [a] -- make list of n copies of x -> copy n x = take n xs where xs = x:xs - -> partition' :: (Eq b) => (a -> b) -> [a] -> [[a]] -> partition' f [] = [] -> partition' f [x] = [[x]] -> partition' f (x:x':xs) | f x == f x' -> = tack x (partition' f (x':xs)) -> | otherwise -> = [x] : partition' f (x':xs) - -> tack x xss = (x : head xss) : tail xss - -> combinePairs :: (Ord a) => [(a,b)] -> [(a,[b])] -> combinePairs xs = -> combine [ (a,[b]) | (a,b) <- sortWith (\ (a,_) (b,_) -> a <= b) xs] -> where -> combine [] = [] -> combine ((a,b):(c,d):r) | a == c = combine ((a,b++d) : r) -> combine (a:r) = a : combine r -> - -#if __HASKELL1__ < 3 || ( defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 200 ) - -> lookup :: (Eq a) => a -> [(a,b)] -> Maybe b -> lookup k env = case [ val | (key,val) <- env, k == key] of -> [] -> Nothing -> (val:vs) -> Just val -> - -> data Cmp = LT | EQ | GT - -> compare a b | a < b = LT -> | a == b = EQ -> | otherwise = GT - -> isJust :: Maybe a -> Bool -> isJust (Just _) = True -> isJust _ = False - -#endif - -> assocMaybeErr :: (Eq a) => [(a,b)] -> a -> MaybeErr b String -> assocMaybeErr env k = case [ val | (key,val) <- env, k == key] of -> [] -> Failed "assoc: " -> (val:vs) -> Succeeded val -> - -Now some utilties involving arrays. -Here is a version of @elem@ that uses partual application -to optimise lookup. - -> arrElem :: (Ix a) => [a] -> a -> Bool -> arrElem obj = \x -> inRange size x && arr ! x -> where -> obj' = sort obj -> size = (head obj',last obj') -> arr = listArray size [ i `elem` obj | i <- range size ] - - -You can use this function to simulate memoisation. For example: - - > fib = memoise (0,100) fib' - > where - > fib' 0 = 0 - > fib' 1 = 0 - > fib' n = fib (n-1) + fib (n-2) - -will give a very efficent variation of the fib function. - - -> memoise :: (Ix a) => (a,a) -> (a -> b) -> a -> b -> memoise bds f = (!) arr -> where arr = array bds [ ASSOC(t, f t) | t <- range bds ] - -> mapAccumR :: (acc -> x -> (acc, y)) -- Function of elt of input list -> -- and accumulator, returning new -> -- accumulator and elt of result list -> -> acc -- Initial accumulator -> -> [x] -- Input list -> -> (acc, [y]) -- Final accumulator and result list -> -> mapAccumR f b [] = (b, []) -> mapAccumR f b (x:xs) = (b'', x':xs') where -> (b'', x') = f b' x -> (b', xs') = mapAccumR f b xs - -> mapAccumL :: (acc -> x -> (acc, y)) -- Function of elt of input list -> -- and accumulator, returning new -> -- accumulator and elt of result list -> -> acc -- Initial accumulator -> -> [x] -- Input list -> -> (acc, [y]) -- Final accumulator and result list -> -> mapAccumL f b [] = (b, []) -> mapAccumL f b (x:xs) = (b'', x':xs') where -> (b', x') = f b x -> (b'', xs') = mapAccumL f b' xs - -Here is the bi-directional version ... - -> mapAccumB :: (accl -> accr -> x -> (accl, accr,y)) -> -- Function of elt of input list -> -- and accumulator, returning new -> -- accumulator and elt of result list -> -> accl -- Initial accumulator from left -> -> accr -- Initial accumulator from right -> -> [x] -- Input list -> -> (accl, accr, [y]) -- Final accumulator and result list -> -> mapAccumB f a b [] = (a,b,[]) -> mapAccumB f a b (x:xs) = (a'',b'',y:ys) -> where -> (a',b'',y) = f a b' x -> (a'',b',ys) = mapAccumB f a' b xs - - -> assert False x = error "assert Failed" -> assert True x = x diff --git a/glafp-utils/nofib-analyse/Main.hs b/glafp-utils/nofib-analyse/Main.hs deleted file mode 100644 index c2b0d42ad0..0000000000 --- a/glafp-utils/nofib-analyse/Main.hs +++ /dev/null @@ -1,757 +0,0 @@ ------------------------------------------------------------------------------ --- $Id: Main.hs,v 1.10 2005/06/07 10:58:31 simonmar Exp $ - --- (c) Simon Marlow 1997-2005 ------------------------------------------------------------------------------ - -module Main where - -import GenUtils -import Printf -import Slurp -import CmdLine - -import Text.Html hiding ((!)) -import qualified Text.Html as Html ((!)) -import Data.FiniteMap -import System.Console.GetOpt -import System.Exit ( exitWith, ExitCode(..) ) - -import Data.Maybe ( isNothing ) -import Data.Char -import System.IO -import Data.List - -(<!) = (Html.!) - ------------------------------------------------------------------------------ --- Top level stuff - -die :: String -> IO a -die s = hPutStr stderr s >> exitWith (ExitFailure 1) - -usageHeader = "usage: nofib-analyse [OPTION...] <logfile1> <logfile2> ..." - -main = do - - if not (null cmdline_errors) || OptHelp `elem` flags - then die (concat cmdline_errors ++ usageInfo usageHeader argInfo) - else do - - let { html = OptHTMLOutput `elem` flags; - latex = OptLaTeXOutput `elem` flags; - ascii = OptASCIIOutput `elem` flags - } - - if ascii && html - then die "Can't produce both ASCII and HTML" - else do - - if devs && nodevs - then die "Can't both display and hide deviations" - else do - - results <- parse_logs other_args - - summary_spec <- case [ cols | OptColumns cols <- flags ] of - [] -> return (pickSummary results) - (cols:_) -> namedColumns (split ',' cols) - - let summary_rows = case [ rows | OptRows rows <- flags ] of - [] -> Nothing - rows -> Just (split ',' (last rows)) - - let column_headings = map (reverse . takeWhile (/= '/') . reverse) other_args - - -- sanity check - sequence_ [ checkTimes prog res | table <- results, - (prog,res) <- fmToList table ] - - case () of - _ | html -> - putStr (renderHtml (htmlPage results column_headings)) - _ | latex -> - putStr (latexOutput results column_headings summary_spec summary_rows) - _ | otherwise -> - putStr (asciiPage results column_headings summary_spec summary_rows) - - -parse_logs :: [String] -> IO [ResultTable] -parse_logs [] = do - f <- hGetContents stdin - return [parse_log f] -parse_logs log_files = - mapM (\f -> do h <- openFile f ReadMode - c <- hGetContents h - return (parse_log c)) log_files - ------------------------------------------------------------------------------ --- List of tables we're going to generate - -data PerProgTableSpec = - forall a . Result a => - SpecP - String -- Name of the table - String -- Short name (for column heading) - String -- HTML tag for the table - (Results -> Maybe a) -- How to get the result - (Results -> Status) -- How to get the status of this result - (a -> Bool) -- Result within reasonable limits? - -data PerModuleTableSpec = - forall a . Result a => - SpecM - String -- Name of the table - String -- HTML tag for the table - (Results -> FiniteMap String a) -- get the module map - (a -> Bool) -- Result within reasonable limits? - --- The various per-program aspects of execution that we can generate results for. -size_spec = SpecP "Binary Sizes" "Size" "binary-sizes" binary_size compile_status always_ok -alloc_spec = SpecP "Allocations" "Allocs" "allocations" allocs run_status always_ok -runtime_spec = SpecP "Run Time" "Runtime" "run-times" (mean run_time) run_status time_ok -muttime_spec = SpecP "Mutator Time" "MutTime" "mutator-time" (mean mut_time) run_status time_ok -gctime_spec = SpecP "GC Time" "GCTime" "gc-time" (mean gc_time) run_status time_ok -gcwork_spec = SpecP "GC Work" "GCWork" "gc-work" gc_work run_status always_ok -instrs_spec = SpecP "Instructions" "Instrs" "instrs" instrs run_status always_ok -mreads_spec = SpecP "Memory Reads" "Reads" "mem-reads" mem_reads run_status always_ok -mwrite_spec = SpecP "Memory Writes" "Writes" "mem-writes" mem_writes run_status always_ok -cmiss_spec = SpecP "Cache Misses" "Misses" "cache-misses" cache_misses run_status always_ok - -all_specs = [ - size_spec, - alloc_spec, - runtime_spec, - muttime_spec, - gctime_spec, - gcwork_spec, - instrs_spec, - mreads_spec, - mwrite_spec, - cmiss_spec - ] - -namedColumns :: [String] -> IO [PerProgTableSpec] -namedColumns ss = mapM findSpec ss - where findSpec s = - case [ spec | spec@(SpecP _ short_name _ _ _ _) <- all_specs, - short_name == s ] of - [] -> die ("unknown column: " ++ s) - (spec:_) -> return spec - -mean :: (Results -> [Float]) -> Results -> Maybe Float -mean f results = go (f results) - where go [] = Nothing - go fs = Just (foldl' (+) 0 fs / fromIntegral (length fs)) - --- Look for bogus-looking times: On Linux we occasionally get timing results --- that are bizarrely low, and skew the average. -checkTimes :: String -> Results -> IO () -checkTimes prog results = do - check "run time" (run_time results) - check "mut time" (mut_time results) - check "GC time" (gc_time results) - where - check kind ts - | any strange ts = - hPutStrLn stderr ("warning: dubious " ++ kind - ++ " results for " ++ prog - ++ ": " ++ show ts) - | otherwise = return () - where strange t = any (\r -> time_ok r && r / t > 1.4) ts - -- looks for times that are >40% smaller than - -- any other. - - --- These are the per-prog tables we want to generate -per_prog_result_tab = - [ size_spec, alloc_spec, runtime_spec, muttime_spec, gctime_spec, - gcwork_spec, instrs_spec, mreads_spec, mwrite_spec, cmiss_spec ] - --- A single summary table, giving comparison figures for a number of --- aspects, each in its own column. Only works when comparing two runs. -normal_summary_specs = - [ size_spec, alloc_spec, runtime_spec ] - -cachegrind_summary_specs = - [ size_spec, alloc_spec, instrs_spec, mreads_spec, mwrite_spec ] - --- Pick an appropriate summary table: if we're cachegrinding, then --- we're probably not interested in the runtime, but we are interested --- in instructions, mem reads and mem writes (and vice-versa). -pickSummary :: [ResultTable] -> [PerProgTableSpec] -pickSummary rs - | isNothing (instrs (head (eltsFM (head rs)))) = normal_summary_specs - | otherwise = cachegrind_summary_specs - -per_module_result_tab = - [ SpecM "Module Sizes" "mod-sizes" module_size always_ok - , SpecM "Compile Times" "compile-time" compile_time time_ok - ] - -always_ok :: a -> Bool -always_ok = const True - -time_ok :: Float -> Bool -time_ok t = t > tooquick_threshold - ------------------------------------------------------------------------------ --- HTML page generation - ---htmlPage :: Results -> [String] -> Html -htmlPage results args - = header << thetitle << reportTitle - +++ hr - +++ h1 << reportTitle - +++ gen_menu - +++ hr - +++ body (gen_tables results args) - -gen_menu = unordList (map (prog_menu_item) per_prog_result_tab - ++ map (module_menu_item) per_module_result_tab) - -prog_menu_item (SpecP name _ anc _ _ _) = anchor <! [href ('#':anc)] << name -module_menu_item (SpecM name anc _ _) = anchor <! [href ('#':anc)] << name - -gen_tables results args = - foldr1 (+++) (map (htmlGenProgTable results args) per_prog_result_tab) - +++ foldr1 (+++) (map (htmlGenModTable results args) per_module_result_tab) - -htmlGenProgTable results args (SpecP title _ anc get_result get_status result_ok) - = sectHeading title anc - +++ font <! [size "1"] - << mkTable (htmlShowResults results args get_result get_status result_ok) - +++ hr - -htmlGenModTable results args (SpecM title anc get_result result_ok) - = sectHeading title anc - +++ font <![size "1"] - << mkTable (htmlShowMultiResults results args get_result result_ok) - +++ hr - -sectHeading :: String -> String -> Html -sectHeading s nm = h2 << anchor <! [name nm] << s - -htmlShowResults - :: Result a - => [ResultTable] - -> [String] - -> (Results -> Maybe a) - -> (Results -> Status) - -> (a -> Bool) - -> HtmlTable - -htmlShowResults (r:rs) ss f stat result_ok - = tabHeader ss - </> aboves (zipWith tableRow [1..] results_per_prog) - </> aboves ((if nodevs then [] - else [tableRow (-1) ("-1 s.d.", lows), - tableRow (-1) ("+1 s.d.", highs)]) - ++ [tableRow (-1) ("Average", gms)]) - where - -- results_per_prog :: [ (String,[BoxValue a]) ] - results_per_prog = map (calc_result rs f stat result_ok) (fmToList r) - - results_per_run = transpose (map snd results_per_prog) - (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run) - -htmlShowMultiResults - :: Result a - => [ResultTable] - -> [String] - -> (Results -> FiniteMap String a) - -> (a -> Bool) - -> HtmlTable - -htmlShowMultiResults (r:rs) ss f result_ok = - multiTabHeader ss - </> aboves (map show_results_for_prog results_per_prog_mod_run) - </> aboves ((if nodevs then [] - else [td << bold << "-1 s.d." - <-> tableRow (-1) ("", lows), - td << bold << "+1 s.d." - <-> tableRow (-1) ("", highs)]) - ++ [td << bold << "Average" - <-> tableRow (-1) ("", gms)]) - - where - base_results = fmToList r :: [(String,Results)] - - -- results_per_prog_mod_run :: [(String,[(String,[BoxValue a])])] - results_per_prog_mod_run = map get_results_for_prog base_results - - -- get_results_for_prog :: (String,Results) -> (String,[BoxValue a]) - get_results_for_prog (prog,r) = (prog, map get_results_for_mod (fmToList (f r))) - - where fms = map get_run_results rs - - get_run_results fm = case lookupFM fm prog of - Nothing -> emptyFM - Just res -> f res - - get_results_for_mod (id,attr) = calc_result fms Just (const Success) - result_ok (id,attr) - - show_results_for_prog (prog,mrs) = - td <! [valign "top"] << bold << prog - <-> (if null mrs then - td << "(no modules compiled)" - else - toHtml (aboves (map (tableRow 0) mrs))) - - results_per_run = transpose [xs | (_,mods) <- results_per_prog_mod_run, - (_,xs) <- mods] - (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run) - -tableRow :: Int -> (String, [BoxValue]) -> HtmlTable -tableRow row_no (prog, results) - = td <! [bgcolor left_column_color] << prog - <-> besides (map (\s -> td <! [align "right", clr] << showBox s) - results) - where clr | row_no < 0 = bgcolor average_row_color - | even row_no = bgcolor even_row_color - | otherwise = bgcolor odd_row_color - -left_column_color = "#d0d0ff" -- light blue -odd_row_color = "#d0d0ff" -- light blue -even_row_color = "#f0f0ff" -- v. light blue -average_row_color = "#ffd0d0" -- light red - -{- -findBest :: Result a => [BoxValue a] -> [(Bool,BoxValue a)] -findBest stuff@(Result base : rest) - = map (\a -> (a==base, a)) - where - best = snd (minimumBy (\a b -> fst a < fst b) no_pcnt_stuff - - no_pcnt_stuff = map unPcnt stuff - - unPcnt (r@(Percentage f) : rest) = (base * f/100, r) : unPcnt rest - unPcnt (r@(Result a) : rest) = (a, r) : unPcnt rest - unPcnt (_ : rest) = unPcnt rest --} - -logHeaders ss - = besides (map (\s -> (td <! [align "right", width "100"] << bold << s)) ss) - -mkTable t = table <! [cellspacing 0, cellpadding 0, border 0] << t - -tabHeader ss - = (td <! [align "left", width "100"] << bold << "Program") - <-> logHeaders ss - -multiTabHeader ss - = (td <! [align "left", width "100"] << bold << "Program") - <-> (td <! [align "left", width "100"] << bold << "Module") - <-> logHeaders ss - --- Calculate a color ranging from bright blue for -100% to bright red for +100%. - -calcColor :: Int -> String -calcColor p | p >= 0 = "#" ++ (showHex red 2 "0000") - | otherwise = "#0000" ++ (showHex blue 2 "") - where red = p * 255 `div` 100 - blue = (-p) * 255 `div` 100 - -showHex 0 f s = if f > 0 then take f (repeat '0') ++ s else s -showHex i f s = showHex (i `div` 16) (f-1) (hexDig (i `mod` 16) : s) - -hexDig i | i > 10 = chr (i-10 + ord 'a') - | otherwise = chr (i + ord '0') - ------------------------------------------------------------------------------ --- LaTeX table generation (just the summary for now) - -latexOutput results args summary_spec summary_rows = - (if (length results == 2) - then ascii_summary_table True results summary_spec summary_rows - . str "\n\n" - else id) "" - - ------------------------------------------------------------------------------ --- ASCII page generation - -asciiPage results args summary_spec summary_rows = - ( str reportTitle - . str "\n\n" - -- only show the summary table if we're comparing two runs - . (if (length results == 2) - then ascii_summary_table False results summary_spec summary_rows . str "\n\n" - else id) - . interleave "\n\n" (map (asciiGenProgTable results args) per_prog_result_tab) - . str "\n" - . interleave "\n\n" (map (asciiGenModTable results args) per_module_result_tab) - ) "\n" - -asciiGenProgTable results args (SpecP title _ anc get_result get_status result_ok) - = str title - . str "\n" - . ascii_show_results results args get_result get_status result_ok - -asciiGenModTable results args (SpecM title anc get_result result_ok) - = str title - . str "\n" - . ascii_show_multi_results results args get_result result_ok - -ascii_header width ss - = str "\n-------------------------------------------------------------------------------\n" - . str (rjustify 15 "Program") - . str (space 5) - . foldr (.) id (map (str . rjustify width) ss) - . str "\n-------------------------------------------------------------------------------\n" - -ascii_show_results - :: Result a - => [ResultTable] - -> [String] - -> (Results -> Maybe a) - -> (Results -> Status) - -> (a -> Bool) - -> ShowS - -ascii_show_results (r:rs) ss f stat result_ok - = ascii_header fIELD_WIDTH ss - . interleave "\n" (map show_per_prog_results results_per_prog) - . if nodevs then id - else str "\n" - . show_per_prog_results ("-1 s.d.",lows) - . str "\n" - . show_per_prog_results ("+1 s.d.",highs) - . str "\n" - . show_per_prog_results ("Average",gms) - where - -- results_per_prog :: [ (String,[BoxValue a]) ] - results_per_prog = map (calc_result rs f stat result_ok) (fmToList r) - - results_per_run = transpose (map snd results_per_prog) - (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run) - --- A summary table, useful only when we are comparing two runs. This table --- shows a number of different result categories, one per column. -ascii_summary_table - :: Bool -- generate a LaTeX table? - -> [ResultTable] - -> [PerProgTableSpec] - -> Maybe [String] - -> ShowS -ascii_summary_table latex (r1:r2:_) specs mb_restrict - | latex = makeLatexTable (rows ++ TableLine : av_rows) - | otherwise = - makeTable (table_layout (length specs) width) - (TableLine : TableRow header : TableLine : rows ++ TableLine : av_rows) - where - header = BoxString "Program" : map BoxString headings - - (headings, columns, av_cols) = unzip3 (map calc_col specs) - av_heads = [BoxString "Min", BoxString "Max", BoxString "Geometric Mean"] - baseline = fmToList r1 - progs = map BoxString (keysFM r1) - rows0 = map TableRow (zipWith (:) progs (transpose columns)) - - rows1 = restrictRows mb_restrict rows0 - - rows | latex = mungeForLaTeX rows1 - | otherwise = rows1 - - av_rows = map TableRow (zipWith (:) av_heads (transpose av_cols)) - width = 10 - - calc_col (SpecP _ heading _ getr gets ok) - = (heading, column, [min,max,mean]) -- throw away the baseline result - where (_, boxes) = unzip (map calc_one_result baseline) - calc_one_result = calc_result [r2] getr gets ok - column = map (\(_:b:_) -> b) boxes - (_,mean,_) = calc_gmsd column - (min,max) = calc_minmax column - -restrictRows :: Maybe [String] -> [TableRow] -> [TableRow] -restrictRows Nothing rows = rows -restrictRows (Just these) rows = filter keep_it rows - where keep_it (TableRow (BoxString s: _)) = s `elem` these - keep_it TableLine = True - keep_it _ = False - -mungeForLaTeX :: [TableRow] -> [TableRow] -mungeForLaTeX = map transrow - where - transrow (TableRow boxes) = TableRow (map transbox boxes) - transrow row = row - - transbox (BoxString s) = BoxString (foldr transchar "" s) - transbox box = box - - transchar '_' s = '\\':'_':s - transchar c s = c:s - -table_layout n width = - (str . rjustify 15) : - (\s -> str (space 5) . str (rjustify width s)) : - replicate (n-1) (str . rjustify width) - -ascii_show_multi_results - :: Result a - => [ResultTable] - -> [String] - -> (Results -> FiniteMap String a) - -> (a -> Bool) - -> ShowS - -ascii_show_multi_results (r:rs) ss f result_ok - = ascii_header fIELD_WIDTH ss - . interleave "\n" (map show_results_for_prog results_per_prog_mod_run) - . str "\n" - . if nodevs then id - else str "\n" - . show_per_prog_results ("-1 s.d.",lows) - . str "\n" - . show_per_prog_results ("+1 s.d.",highs) - . str "\n" - . show_per_prog_results ("Average",gms) - where - base_results = fmToList r :: [(String,Results)] - - -- results_per_prog_mod_run :: [(String,[(String,[BoxValue a])])] - results_per_prog_mod_run = map get_results_for_prog base_results - - -- get_results_for_prog :: (String,Results) -> (String,[BoxValue a]) - get_results_for_prog (prog,r) = (prog, map get_results_for_mod (fmToList (f r))) - - where fms = map get_run_results rs - - get_run_results fm = case lookupFM fm prog of - Nothing -> emptyFM - Just res -> f res - - get_results_for_mod (id,attr) = calc_result fms Just (const Success) - result_ok (id,attr) - - show_results_for_prog (prog,mrs) = - str ("\n"++prog++"\n") - . (if null mrs then - str "(no modules compiled)\n" - else - interleave "\n" (map show_per_prog_results mrs)) - - results_per_run = transpose [xs | (_,mods) <- results_per_prog_mod_run, - (_,xs) <- mods] - (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run) - - -show_per_prog_results :: (String, [BoxValue]) -> ShowS -show_per_prog_results = show_per_prog_results_width fIELD_WIDTH - -show_per_prog_results_width width (prog,results) - = str (rjustify 15 prog) - . str (space 5) - . foldr (.) id (map (str . rjustify width . showBox) results) - --- --------------------------------------------------------------------------- --- Generic stuff for results generation - --- calc_result is a nice exercise in higher-order programming... -calc_result - :: Result a - => [FiniteMap String b] -- accumulated results - -> (b -> Maybe a) -- get a result from the b - -> (b -> Status) -- get a status from the b - -> (a -> Bool) -- is this result ok? - -> (String,b) -- the baseline result - -> (String,[BoxValue]) - -calc_result rts get_maybe_a get_stat result_ok (prog,base_r) = - (prog, (just_result baseline base_stat : - - let - rts' = map (\rt -> get_stuff (lookupFM rt prog)) rts - - get_stuff Nothing = (Nothing, NotDone) - get_stuff (Just r) = (get_maybe_a r, get_stat r) - in - ( - case baseline of - Just base | result_ok base - -> map (\(r,s) -> percentage r s base) rts' - _other - -> map (\(r,s) -> just_result r s) rts' - ))) - where - baseline = get_maybe_a base_r - base_stat = get_stat base_r - - just_result Nothing s = RunFailed s - just_result (Just a) s = toBox a - - percentage Nothing s base = RunFailed s - percentage (Just a) s base = Percentage - (convert_to_percentage base a) ------------------------------------------------------------------------------ --- Calculating geometric means and standard deviations - -{- -This is done using the log method, to avoid needing really large -intermediate results. The formula for a geometric mean is - - (a1 * .... * an) ^ 1/n - -which is equivalent to - - e ^ ( (log a1 + ... + log an) / n ) - -where log is the natural logarithm function. - -Similarly, to compute the geometric standard deviation we compute the -deviation of each log, take the root-mean-square, and take the -exponential again: - - e ^ sqrt( ( sqr(log a1 - lbar) + ... + sqr(log an - lbar) ) / n ) - -where lbar is the mean log, - - (log a1 + ... + log an) / n - -This is a *factor*: i.e., the 1 s.d. points are (gm/sdf,gm*sdf); do -not subtract 100 from gm before performing this calculation. - -We therefore return a (low, mean, high) triple. - --} - -calc_gmsd :: [BoxValue] -> (BoxValue, BoxValue, BoxValue) -calc_gmsd xs - | null percentages = (RunFailed NotDone, RunFailed NotDone, RunFailed NotDone) - | otherwise = let sqr x = x * x - len = fromIntegral (length percentages) - logs = map log percentages - lbar = sum logs / len - devs = map (sqr . (lbar-)) logs - dbar = sum devs / len - gm = exp lbar - sdf = exp (sqrt dbar) - in - (Percentage (gm/sdf), - Percentage gm, - Percentage (gm*sdf)) - where - percentages = [ if f < 5 then 5 else f | Percentage f <- xs ] - -- can't do log(0.0), so exclude zeros - -- small values have inordinate effects so cap at -95%. - -calc_minmax :: [BoxValue] -> (BoxValue, BoxValue) -calc_minmax xs - | null percentages = (RunFailed NotDone, RunFailed NotDone) - | otherwise = (Percentage (minimum percentages), - Percentage (maximum percentages)) - where - percentages = [ if f < 5 then 5 else f | Percentage f <- xs ] - - ------------------------------------------------------------------------------ --- Show the Results - -class Num a => Result a where - toBox :: a -> BoxValue - convert_to_percentage :: a -> a -> Float - --- We assume an Int is a size, and print it in kilobytes. - -instance Result Int where - convert_to_percentage 0 size = 100 - convert_to_percentage base size = (fromIntegral size / fromIntegral base) * 100 - - toBox = BoxInt - -instance Result Integer where - convert_to_percentage 0 size = 100 - convert_to_percentage base size = (fromInteger size / fromInteger base) * 100 - toBox = BoxInteger - - -instance Result Float where - convert_to_percentage 0.0 size = 100.0 - convert_to_percentage base size = size / base * 100 - - toBox = BoxFloat - --- ----------------------------------------------------------------------------- --- BoxValues - --- The contents of a box in a table -data BoxValue - = RunFailed Status - | Percentage Float - | BoxFloat Float - | BoxInt Int - | BoxInteger Integer - | BoxString String - -showBox :: BoxValue -> String -showBox (RunFailed stat) = show_stat stat -showBox (Percentage f) = show_pcntage f -showBox (BoxFloat f) = showFloat' Nothing (Just 2) f -showBox (BoxInt n) = show (n `div` 1024) ++ "k" -showBox (BoxInteger n) = show (n `div` 1024) ++ "k" -showBox (BoxString s) = s - -instance Show BoxValue where { show = showBox } - -show_pcntage n = show_float_signed (n-100) ++ "%" - -show_float_signed = showFloat False False True False False Nothing (Just 1) - -show_stat Success = "(no result)" -show_stat WrongStdout = "(stdout)" -show_stat WrongStderr = "(stderr)" -show_stat (Exit x) = "exit(" ++ show x ++")" -show_stat OutOfHeap = "(heap)" -show_stat OutOfStack = "(stack)" -show_stat NotDone = "-----" - --- ----------------------------------------------------------------------------- --- Table layout - -data TableRow - = TableRow [BoxValue] - | TableLine - -type Layout = [String -> ShowS] - -makeTable :: Layout -> [TableRow] -> ShowS -makeTable p = interleave "\n" . map do_row - where do_row (TableRow boxes) = applyLayout p boxes - do_row TableLine = str (take 80 (repeat '-')) - -makeLatexTable :: [TableRow] -> ShowS -makeLatexTable = foldr (.) id . map do_row - where do_row (TableRow boxes) - = applyLayout latexTableLayout boxes . str "\\\\\n" - do_row TableLine - = str "\\hline\n" - -latexTableLayout :: Layout -latexTableLayout = box : repeat (box . (" & "++)) - where box s = str (foldr transchar "" s) - - transchar '%' s = s -- leave out the percentage signs - transchar c s = c : s - -applyLayout :: Layout -> [BoxValue] -> ShowS -applyLayout layout values = - foldr (.) id [ f (show val) | (val,f) <- zip values layout ] - --- ----------------------------------------------------------------------------- --- General Utils - -split :: Char -> String -> [String] -split c s = case rest of - [] -> [chunk] - _:rest -> chunk : split c rest - where (chunk, rest) = break (==c) s - -str = showString - -interleave s = foldr1 (\a b -> a . str s . b) - -fIELD_WIDTH = 16 :: Int - ------------------------------------------------------------------------------ diff --git a/glafp-utils/nofib-analyse/Makefile b/glafp-utils/nofib-analyse/Makefile deleted file mode 100644 index 01323bf0b1..0000000000 --- a/glafp-utils/nofib-analyse/Makefile +++ /dev/null @@ -1,11 +0,0 @@ -# ----------------------------------------------------------------------------- -# $Id: Makefile,v 1.6 2005/06/07 10:58:31 simonmar Exp $ -# (c) Simon Marlow 1999-2000 - -TOP=.. -include $(TOP)/mk/boilerplate.mk - -SRC_HC_OPTS += -fglasgow-exts -package util -package data -package text -cpp -package lang -HS_PROG = nofib-analyse - -include $(TOP)/mk/target.mk diff --git a/glafp-utils/nofib-analyse/Printf.lhs b/glafp-utils/nofib-analyse/Printf.lhs deleted file mode 100644 index 33b5290e07..0000000000 --- a/glafp-utils/nofib-analyse/Printf.lhs +++ /dev/null @@ -1,84 +0,0 @@ ------------------------------------------------------------------------------ --- $Id: Printf.lhs,v 1.5 2002/03/14 17:09:46 simonmar Exp $ - --- (c) Simon Marlow 1997-2001 ------------------------------------------------------------------------------ - -> module Printf (showFloat, showFloat') where - -> import Foreign -> import CTypes -> import CTypesISO -> import CString -> import IOExts -> import ByteArray - -> showFloat -> :: Bool -- Always print decimal point -> -> Bool -- Left adjustment -> -> Bool -- Always print sign -> -> Bool -- Leave blank before positive number -> -> Bool -- Use zero padding -> -> Maybe Int -- Field Width -> -> Maybe Int -- Precision -> -> Float -> -> String - -> bUFSIZE = 512 :: Int - -> showFloat alt left sign blank zero width prec num = -> unsafePerformIO $ do - -#if __GLASGOW_HASKELL__ < 500 - -> buf <- malloc bUFSIZE -> snprintf buf (fromIntegral bUFSIZE) (packString format) -> (realToFrac num) -> let s = unpackCString buf -> length s `seq` -- urk! need to force the string before we -> -- free the buffer. A better solution would -> -- be to use foreign objects and finalisers, -> -- but that's just too heavyweight. -> free buf -> return s - -#else - -> allocaBytes bUFSIZE $ \buf -> -> withCString format $ \cformat -> do -> snprintf buf (fromIntegral bUFSIZE) cformat -> (realToFrac num) -> peekCString buf - -#endif - -> where -> format = '%' : -> if_bool alt "#" ++ -> if_bool left "-" ++ -> if_bool sign "+" ++ -> if_bool blank " " ++ -> if_bool zero "0" ++ -> if_maybe width show ++ -> if_maybe prec (\s -> "." ++ show s) ++ -> "f" - -> showFloat' :: Maybe Int -> Maybe Int -> Float -> String -> showFloat' = showFloat False False False False False - -> if_bool False s = [] -> if_bool True s = s - -> if_maybe Nothing f = [] -> if_maybe (Just s) f = f s - -#if __GLASGOW_HASKELL__ < 500 - -> type PackedString = ByteArray Int -> foreign import unsafe snprintf :: Addr -> CSize -> PackedString -> Double -> IO () - -#else - -> foreign import unsafe snprintf :: CString -> CSize -> CString -> Double -> IO () - -#endif diff --git a/glafp-utils/nofib-analyse/Slurp.hs b/glafp-utils/nofib-analyse/Slurp.hs deleted file mode 100644 index f775baee4f..0000000000 --- a/glafp-utils/nofib-analyse/Slurp.hs +++ /dev/null @@ -1,373 +0,0 @@ ------------------------------------------------------------------------------ --- --- (c) Simon Marlow 1997-2005 --- ------------------------------------------------------------------------------ - -module Slurp (Status(..), Results(..), ResultTable(..), parse_log) where - -import CmdLine -import Data.FiniteMap -import RegexString -import Data.Maybe --- import Debug.Trace - ------------------------------------------------------------------------------ --- This is the structure into which we collect our results: - -type ResultTable = FiniteMap String Results - -data Status - = NotDone - | Success - | OutOfHeap - | OutOfStack - | Exit Int - | WrongStdout - | WrongStderr - -data Results = Results { - compile_time :: FiniteMap String Float, - module_size :: FiniteMap String Int, - binary_size :: Maybe Int, - link_time :: Maybe Float, - run_time :: [Float], - mut_time :: [Float], - instrs :: Maybe Integer, - mem_reads :: Maybe Integer, - mem_writes :: Maybe Integer, - cache_misses :: Maybe Integer, - gc_work :: Maybe Integer, - gc_time :: [Float], - allocs :: Maybe Integer, - run_status :: Status, - compile_status :: Status - } - -emptyResults = Results { - compile_time = emptyFM, - module_size = emptyFM, - binary_size = Nothing, - link_time = Nothing, - run_time = [], - mut_time = [], - instrs = Nothing, - mem_reads = Nothing, - mem_writes = Nothing, - cache_misses = Nothing, - gc_time = [], - gc_work = Nothing, - allocs = Nothing, - compile_status = NotDone, - run_status = NotDone - } - ------------------------------------------------------------------------------ --- Parse the log file - -{- -Various banner lines: - -==nofib== awards: size of QSort.o follows... -==nofib== banner: size of banner follows... -==nofib== awards: time to link awards follows... -==nofib== awards: time to run awards follows... -==nofib== boyer2: time to compile Checker follows... --} - -banner_re = mkRegex "^==nofib==[ \t]+([A-Za-z0-9-_]+):[ \t]+(size of|time to link|time to run|time to compile)[ \t]+([A-Za-z0-9-_]+)(\\.o)?[ \t]+follows" - -{- -This regexp for the output of "time" works on FreeBSD, other versions -of "time" will need different regexps. --} - -time_re = mkRegex "^[ \t]*([0-9.]+)[ \t]+real[ \t]+([0-9.]+)[ \t]+user[ \t]+([0-9.]+)[ \t]+sys[ \t]*$" - -time_gnu17_re = mkRegex "^[ \t]*([0-9.]+)user[ \t]+([0-9.]+)system[ \t]+([0-9.:]+)elapsed" - -- /usr/bin/time --version reports: GNU time 1.7 - -- notice the order is different, and the elapsed time is [hh:]mm:ss.s - -size_re = mkRegex "^[ \t]*([0-9]+)[ \t]+([0-9]+)[ \t]+([0-9]+)" - -{- -<<ghc: 5820820 bytes, 0 GCs, 0/0 avg/max bytes residency (0 samples), 41087234 bytes GC work, 0.00 INIT (0.05 elapsed), 0.08 MUT (0.18 elapsed), 0.00 GC (0.00 elapsed) :ghc>> - - = (bytes, gcs, avg_resid, max_resid, samples, gc_work, - init, init_elapsed, mut, mut_elapsed, gc, gc_elapsed) - -ghc1_re = pre GHC 4.02 -ghc2_re = GHC 4.02 (includes "xxM in use") -ghc3_re = GHC 4.03 (includes "xxxx bytes GC work") --} - -ghc1_re = mkRegex "^<<ghc:[ \t]+([0-9]+)[ \t]+bytes,[ \t]*([0-9]+)[ \t]+GCs,[ \t]*([0-9]+)/([0-9]+)[ \t]+avg/max bytes residency \\(([0-9]+) samples\\), ([0-9]+) bytes GC work, ([0-9.]+) INIT \\(([0-9.]+) elapsed\\), ([0-9.]+) MUT \\(([0-9.]+) elapsed\\), ([0-9.]+) GC \\(([0-9.]+) elapsed\\) :ghc>>" - -ghc2_re = mkRegex "^<<ghc:[ \t]+([0-9]+)[ \t]+bytes,[ \t]*([0-9]+)[ \t]+GCs,[ \t]*([0-9]+)/([0-9]+)[ \t]+avg/max bytes residency \\(([0-9]+) samples\\), ([0-9]+)M in use, ([0-9.]+) INIT \\(([0-9.]+) elapsed\\), ([0-9.]+) MUT \\(([0-9.]+) elapsed\\), ([0-9.]+) GC \\(([0-9.]+) elapsed\\) :ghc>>" - -ghc3_re = mkRegex "^<<ghc:[ \t]+([0-9]+)[ \t]+bytes,[ \t]*([0-9]+)[ \t]+GCs,[ \t]*([0-9]+)/([0-9]+)[ \t]+avg/max bytes residency \\(([0-9]+) samples\\), ([0-9]+) bytes GC work, ([0-9]+)M in use, ([0-9.]+) INIT \\(([0-9.]+) elapsed\\), ([0-9.]+) MUT \\(([0-9.]+) elapsed\\), ([0-9.]+) GC \\(([0-9.]+) elapsed\\) :ghc>>" - -ghc4_re = mkRegex "^<<ghc-instrs:[ \t]+([0-9]+)[ \t]+bytes,[ \t]*([0-9]+)[ \t]+GCs,[ \t]*([0-9]+)/([0-9]+)[ \t]+avg/max bytes residency \\(([0-9]+) samples\\), ([0-9]+) bytes GC work, ([0-9]+)M in use, ([0-9.]+) INIT \\(([0-9.]+) elapsed\\), ([0-9.]+) MUT \\(([0-9.]+) elapsed\\), ([0-9.]+) GC \\(([0-9.]+) elapsed\\), ([0-9]+) instructions, ([0-9]+) memory reads, ([0-9]+) memory writes, ([0-9]+) L2 cache misses :ghc-instrs>>" - -wrong_exit_status = mkRegex "^\\**[ \t]*expected exit status ([0-9]+) not seen ; got ([0-9]+)" - -wrong_output = mkRegex "^expected (stdout|stderr) not matched by reality$" - -out_of_heap = mkRegex "^\\+ Heap exhausted;$" - -out_of_stack = mkRegex "^\\+ Stack space overflow:" - -parse_log :: String -> ResultTable -parse_log - = combine_results -- collate information - . concat - . map process_chunk -- get information from each chunk - . tail -- first chunk is junk - . chunk_log [] [] -- break at banner lines - . lines - -combine_results :: [(String,Results)] -> FiniteMap String Results -combine_results = foldr f emptyFM - where - f (prog,results) fm = addToFM_C combine2Results fm prog results - - -combine2Results - Results{ compile_time = ct1, link_time = lt1, - module_size = ms1, - run_time = rt1, mut_time = mt1, - instrs = is1, mem_reads = mr1, mem_writes = mw1, - cache_misses = cm1, - gc_time = gt1, gc_work = gw1, - binary_size = bs1, allocs = al1, - run_status = rs1, compile_status = cs1 } - Results{ compile_time = ct2, link_time = lt2, - module_size = ms2, - run_time = rt2, mut_time = mt2, - instrs = is2, mem_reads = mr2, mem_writes = mw2, - cache_misses = cm2, - gc_time = gt2, gc_work = gw2, - binary_size = bs2, allocs = al2, - run_status = rs2, compile_status = cs2 } - = Results{ compile_time = plusFM_C const ct1 ct2, - module_size = plusFM_C const ms1 ms2, - link_time = combMaybes lt1 lt2, - run_time = rt1 ++ rt2, - mut_time = mt1 ++ mt2, - instrs = combMaybes is1 is2, - mem_reads = combMaybes mr1 mr2, - mem_writes = combMaybes mw1 mw2, - cache_misses = combMaybes cm1 cm2, - gc_time = gt1 ++ gt2, - gc_work = combMaybes gw1 gw2, - binary_size = combMaybes bs1 bs2, - allocs = combMaybes al1 al2, - run_status = combStatus rs1 rs2, - compile_status = combStatus cs1 cs2 } - -combMaybes m1 m2 = case maybeToList m1 ++ maybeToList m2 of - [] -> Nothing - (x:_) -> Just x - -combStatus NotDone x = x -combStatus x NotDone = x -combStatus x y = x - -chunk_log :: [String] -> [String] -> [String] -> [([String],[String])] -chunk_log header chunk [] = [(header,chunk)] -chunk_log header chunk (l:ls) = - case matchRegex banner_re l of - Nothing -> chunk_log header (l:chunk) ls - Just stuff -> (header,chunk) : chunk_log stuff [] ls - -process_chunk :: ([String],[String]) -> [(String,Results)] -process_chunk (prog : what : mod : _, chk) = - case what of - "time to compile" -> parse_compile_time prog mod chk - "time to run" -> parse_run_time prog (reverse chk) emptyResults NotDone - "time to link" -> parse_link_time prog chk - "size of" -> parse_size prog mod chk - _ -> error ("process_chunk: "++what) - -parse_compile_time prog mod [] = [] -parse_compile_time prog mod (l:ls) = - case matchRegex time_re l of { - Just (real:user:system:_) -> - let ct = addToFM emptyFM mod (read user) - in - [(prog,emptyResults{compile_time = ct})]; - Nothing -> - - case matchRegex time_gnu17_re l of { - Just (user:system:elapsed:_) -> - let ct = addToFM emptyFM mod (read user) - in - [(prog,emptyResults{compile_time = ct})]; - Nothing -> - - case matchRegex ghc1_re l of { - Just (allocs:_:_:_:_:init:_:mut:_:gc:_) -> - let - read_mut = read mut - read_gc = read gc - time = (read init + read_mut + read_gc) :: Float - ct = addToFM emptyFM mod time - in - [(prog,emptyResults{compile_time = ct})]; - Nothing -> - - case matchRegex ghc2_re l of { - Just (allocs:_:_:_:_:_:init:_:mut:_:gc:_) -> - let - read_mut = read mut - read_gc = read gc - time = (read init + read_mut + read_gc) :: Float - ct = addToFM emptyFM mod time - in - [(prog,emptyResults{compile_time = ct})]; - Nothing -> - - case matchRegex ghc3_re l of { - Just (allocs:_:_:_:_:_:_:init:_:mut:_:gc:_) -> - let - read_mut = read mut - read_gc = read gc - time = (read init + read_mut + read_gc) :: Float - ct = addToFM emptyFM mod time - in - [(prog,emptyResults{compile_time = ct})]; - Nothing -> - - case matchRegex ghc4_re l of { - Just (allocs:_:_:_:_:_:_:init:_:mut:_:gc:_:_:_:_) -> - let - read_mut = read mut - read_gc = read gc - time = (read init + read_mut + read_gc) :: Float - ct = addToFM emptyFM mod time - in - [(prog,emptyResults{compile_time = ct})]; - Nothing -> - - parse_compile_time prog mod ls - }}}}}} - -parse_link_time prog [] = [] -parse_link_time prog (l:ls) = - case matchRegex time_re l of { - Just (real:user:system:_) -> - [(prog,emptyResults{link_time = Just (read user)})]; - Nothing -> - - case matchRegex time_gnu17_re l of { - Just (user:system:elapsed:_) -> - [(prog,emptyResults{link_time = Just (read user)})]; - Nothing -> - - parse_link_time prog ls - }} - - --- There might be multiple runs of the program, so we have to collect up --- all the results. Variable results like runtimes are aggregated into --- a list, whereas the non-variable aspects are just kept singly. -parse_run_time prog [] res NotDone = [] -parse_run_time prog [] res ex = [(prog, res{run_status=ex})] -parse_run_time prog (l:ls) res ex = - case matchRegex ghc1_re l of { - Just (allocs:_:_:_:_:init:_:mut:_:gc:_) -> - got_run_result allocs init mut gc Nothing - Nothing Nothing Nothing Nothing; - Nothing -> - - case matchRegex ghc2_re l of { - Just (allocs:_:_:_:_:_:init:_:mut:_:gc:_) -> - got_run_result allocs init mut gc Nothing - Nothing Nothing Nothing Nothing; - - Nothing -> - - case matchRegex ghc3_re l of { - Just (allocs:_:_:_:_:gc_work:_:init:_:mut:_:gc:_) -> - got_run_result allocs init mut gc (Just (read gc_work)) - Nothing Nothing Nothing Nothing; - - Nothing -> - - case matchRegex ghc4_re l of { - Just (allocs:_:_:_:_:gc_work:_:init:_:mut:_:gc:_:is:mem_rs:mem_ws:cache_misses:_) -> - got_run_result allocs init mut gc (Just (read gc_work)) - (Just (read is)) (Just (read mem_rs)) - (Just (read mem_ws)) (Just (read cache_misses)); - - Nothing -> - - case matchRegex wrong_output l of { - Just ("stdout":_) -> - parse_run_time prog ls res (combineRunResult WrongStdout ex); - Just ("stderr":_) -> - parse_run_time prog ls res (combineRunResult WrongStderr ex); - Nothing -> - - case matchRegex wrong_exit_status l of { - Just (wanted:got:_) -> - parse_run_time prog ls res (combineRunResult (Exit (read got)) ex); - Nothing -> - - case matchRegex out_of_heap l of { - Just _ -> - parse_run_time prog ls res (combineRunResult OutOfHeap ex); - Nothing -> - - case matchRegex out_of_stack l of { - Just _ -> - parse_run_time prog ls res (combineRunResult OutOfStack ex); - Nothing -> - parse_run_time prog ls res ex; - - }}}}}}}} - where - got_run_result allocs init mut gc gc_work instrs mem_rs mem_ws cache_misses - = -- trace ("got_run_result: " ++ init ++ ", " ++ mut ++ ", " ++ gc) $ - let - read_mut = read mut - read_gc = read gc - time = (read init + read_mut + read_gc) :: Float - res' = combine2Results res - emptyResults{ run_time = [time], - mut_time = [read_mut], - gc_time = [read_gc], - gc_work = gc_work, - allocs = Just (read allocs), - instrs = instrs, - mem_reads = mem_rs, - mem_writes = mem_ws, - cache_misses = cache_misses, - run_status = Success - } - in - parse_run_time prog ls res' Success - - -combineRunResult OutOfHeap _ = OutOfHeap -combineRunResult _ OutOfHeap = OutOfHeap -combineRunResult OutOfStack _ = OutOfStack -combineRunResult _ OutOfStack = OutOfStack -combineRunResult (Exit e) _ = Exit e -combineRunResult _ (Exit e) = Exit e -combineRunResult exit _ = exit - -parse_size prog mod [] = [] -parse_size prog mod (l:ls) = - case matchRegex size_re l of - Nothing -> parse_size prog mod ls - Just (text:datas:bss:_) - | prog == mod -> - [(prog,emptyResults{binary_size = - Just (read text + read datas), - compile_status = Success})] - | otherwise -> - let ms = addToFM emptyFM mod (read text + read datas) - in - [(prog,emptyResults{module_size = ms})] - diff --git a/glafp-utils/runstdtest/Makefile b/glafp-utils/runstdtest/Makefile deleted file mode 100644 index ec2f66abc7..0000000000 --- a/glafp-utils/runstdtest/Makefile +++ /dev/null @@ -1,15 +0,0 @@ -# $Id: Makefile,v 1.5 2000/09/05 10:16:41 simonmar Exp $ -# - -TOP=.. -include $(TOP)/mk/boilerplate.mk - -SCRIPT_PROG=runstdtest -SCRIPT_OBJS=runstdtest.prl -SCRIPT_SUBST_VARS=RM DEFAULT_TMPDIR CONTEXT_DIFF -INTERP=perl - -CLEAN_FILES += $(SCRIPT_PROG) -DESTDIR=$(INSTSCRIPTDIR) - -include $(TOP)/mk/target.mk diff --git a/glafp-utils/runstdtest/runstdtest.prl b/glafp-utils/runstdtest/runstdtest.prl deleted file mode 100644 index 1b1af9fb4d..0000000000 --- a/glafp-utils/runstdtest/runstdtest.prl +++ /dev/null @@ -1,475 +0,0 @@ -# -# The perl script requires the following variables to be bound -# to something meaningful before it will operate correctly: -# -# DEFAULT_TMPDIR -# CONTEXT_DIFF -# RM -# -# Given: -# * a program to run (1st arg) -# * some "command-line opts" ( -O<opt1> -O<opt2> ... ) -# [default: anything on the cmd line this script doesn't recognise ] -# the first opt not starting w/ "-" is taken to be an input -# file and (if it exists) is grepped for "what's going on here" -# comments (^-- !!!). -# * a file to feed to stdin ( -i<file> ) [default: /dev/null ] -# * a "time" command to use (-t <cmd>). -# -# * alternatively, a "-script <script>" argument says: run the -# named Bourne-shell script to do the test. It's passed the -# pgm-to-run as the one-and-only arg. -# -# Run the program with those options and that input, and check: -# if we get... -# -# * an expected exit status ( -x <val> ) [ default 0 ] -# * expected output on stdout ( -o1 <file> ) [ default /dev/null ] -# ( we'll accept one of several...) -# * expected output on stderr ( -o2 <file> ) [ default /dev/null ] -# ( we'll accept one of several...) -# -# (if the expected-output files' names end in .Z, then -# they are uncompressed before doing the comparison) -# -# (This is supposed to be a "prettier" replacement for runstdtest.) -# -# Flags -# ~~~~~ -# -accept-output replace output files with the ones actually generated by running -# the program -# -($Pgm = $0) =~ s|.*/||; -$Verbose = 0; -$SaveStderr = 0; -$SaveStdout = 0; -$Status = 0; -@PgmArgs = (); -$PgmFail=0; -$PgmExitStatus = 0; -$PgmStdinFile = '/dev/null'; -if ( $ENV{'TMPDIR'} ) { # where to make tmp file names - $TmpPrefix = $ENV{'TMPDIR'}; -} else { - $TmpPrefix ="$DEFAULT_TMPDIR"; - $ENV{'TMPDIR'} = "$DEFAULT_TMPDIR"; # set the env var as well -} -# If this is Cygwin, ignore eol and CR characters. -# Perhaps required for MSYS too, although the cygpath -# bit is hopefully unnecessary. -if ( `uname | grep CYGWIN` ) { - $CONTEXT_DIFF=$CONTEXT_DIFF . " --strip-trailing-cr" ; - $TmpPrefix = `cygpath -m $TmpPrefix | tr -d \\\\n`; -} -$ScriptFile = "$TmpPrefix/run_me$$"; -$DefaultStdoutFile = "$TmpPrefix/no_stdout$$"; # can't use /dev/null (e.g. Alphas) -$DefaultStderrFile = "$TmpPrefix/no_stderr$$"; -@PgmStdoutFile = (); -@PgmStderrFile = (); -$PreScript = ''; -$PostScript = ''; -$TimeCmd = ''; -$StatsFile = "$TmpPrefix/stats$$"; -$CachegrindStats = "cachegrind.out.summary"; -$SysSpecificTiming = ''; -$Cachegrind = 'no'; - -die "$Pgm: program to run not given as first argument\n" if $#ARGV < 0; -$ToRun = $ARGV[0]; shift(@ARGV); -# avoid picking up same-named thing from somewhere else on $PATH... -$ToRun = "./$ToRun" if -e "./$ToRun"; - -arg: while ($_ = $ARGV[0]) { - shift(@ARGV); - - /^--$/ && do { # let anything past after -- - push(@PgmArgs, @ARGV); - last arg; }; - - /^-v$/ && do { $Verbose = 1; next arg; }; - /^-accept-output-stderr$/ && do { $SaveStderr = 1; next arg; }; - /^-accept-output-stdout$/ && do { $SaveStdout = 1; next arg; }; - /^-accept-output$/ && do { $SaveStdout = 1; $SaveStderr = 1; next arg; }; - - /^-O(.*)/ && do { push(@PgmArgs, &grab_arg_arg('-O',$1)); next arg; }; - /^-i(.*)/ && do { $PgmStdinFile = &grab_arg_arg('-i',$1); - $Status++, - print STDERR "$Pgm: bogus -i input file: $PgmStdinFile\n" - if $PgmStdinFile !~ /^\/dev\/.*$/ && ! -f $PgmStdinFile; - next arg; }; - /^-fail/ && do { $PgmFail=1; next arg; }; - /^-x(.*)/ && do { $PgmExitStatus = &grab_arg_arg('-x',$1); - $Status++ , - print STDERR "$Pgm: bogus -x expected exit status: $PgmExitStatus\n" - if $PgmExitStatus !~ /^\d+$/; - next arg; }; - /^-o1(.*)/ && do { $out_file = &grab_arg_arg('-o1',$1); - push(@PgmStdoutFile, $out_file); - next arg; }; - /^-o2(.*)/ && do { $out_file = &grab_arg_arg('-o2',$1); - push(@PgmStderrFile, $out_file); - next arg; }; - /^-prescript(.*)/ && do { $PreScript = &grab_arg_arg('-prescript',$1); - next arg; }; - /^-postscript(.*)/ && do { $PostScript = &grab_arg_arg('-postscript',$1); - next arg; }; - /^-script/ && do { print STDERR "$Pgm: -script argument is obsolete;\nUse -prescript and -postscript instead.\n"; - $Status++; - next arg; }; - /^-(ghc|hbc)-timing$/ && do { $SysSpecificTiming = $1; - next arg; }; - /^-cachegrind$/ && do { $SysSpecificTiming = 'ghc-instrs'; - $Cachegrind = 'yes'; - next arg }; - /^-t(.*)/ && do { $TimeCmd = &grab_arg_arg('-t', $1); next arg; }; - - # anything else is taken to be a pgm arg - push(@PgmArgs, $_); -} - -foreach $out_file ( @PgmStdoutFile ) { - if ( ! -f $out_file && !$SaveStdout ) { - print STDERR "$Pgm: warning: expected-stdout file missing: $out_file\n"; - pop(@PgmStdoutFile); - } -} - -foreach $out_file ( @PgmStderrFile ) { - if ( ! -f $out_file && !$SaveStderr ) { - print STDERR "$Pgm: warning: expected-stderr file missing: $out_file\n"; - pop(@PgmStderrFile); - } -} - -exit 1 if $Status; - -# add on defaults if none specified -@PgmStdoutFile = ( $DefaultStdoutFile ) if $#PgmStdoutFile < 0; -@PgmStderrFile = ( $DefaultStderrFile ) if $#PgmStderrFile < 0; - -# tidy up the pgm args: -# (1) look for the "first input file" -# and grep it for "interesting" comments (-- !!! ) -# (2) quote any args w/ whitespace in them. -$grep_done = 0; -foreach $a ( @PgmArgs ) { - if (! $grep_done && $a !~ /^-/ && -f $a) { - print `egrep "^--[ ]?!!!" $a`; - $grep_done = 1; - } - if ($a =~ /\s/ || $a =~ /'/) { - $a =~ s/'/\\'/g; # backslash the quotes; - $a = "\"$a\""; # quote the arg - } -} - -# deal with system-specific timing options -$TimingMagic = ''; -if ( $SysSpecificTiming =~ /^ghc/ ) { - $TimingMagic = "+RTS -S$StatsFile -RTS" -} elsif ( $SysSpecificTiming eq 'hbc' ) { - $TimingMagic = "-S$StatsFile"; -} - -if ($PreScript ne '') { - local($to_do); - $PreScriptLines = `cat $PreScript`; - $PreScriptLines =~ s/\r//g; -} else { - $PreScriptLines = ''; -} - -if ($PostScript ne '') { - local($to_do); - $PostScriptLines = `cat $PostScript`; - $PostScriptLines =~ s/\r//g; - $* = 1; - $PostScriptLines =~ s#\$o1#$TmpPrefix/runtest$$.1#g; - $PostScriptLines =~ s#\$o2#$TmpPrefix/runtest$$.2#g; -} else { - $PostScriptLines = ''; -} - -# OK, so we're gonna do the normal thing... - -if ($Cachegrind eq 'yes') { - $CachegrindPrefix = "valgrind --tool=cachegrind --log-fd=9 9>$CachegrindStats"; -} else { - $CachegrindPrefix = ''; -} - -$Script = <<EOSCRIPT; -#! /bin/sh -myexit=0 -diffsShown=0 -rm -f $DefaultStdoutFile $DefaultStderrFile -cat /dev/null > $DefaultStdoutFile -cat /dev/null > $DefaultStderrFile -$PreScriptLines -$SpixifyLine1 -echo $TimeCmd /bin/sh -c \'$CachegrindPrefix $ToRun $TimingMagic @PgmArgs < $PgmStdinFile 1> $TmpPrefix/runtest$$.1 2> $TmpPrefix/runtest$$.2 3> $TmpPrefix/runtest$$.3\' -$TimeCmd /bin/sh -c \'$CachegrindPrefix $ToRun $TimingMagic @PgmArgs < $PgmStdinFile 1> $TmpPrefix/runtest$$.1 2> $TmpPrefix/runtest$$.2 3> $TmpPrefix/runtest$$.3\' -progexit=\$? -if [ \$progexit -eq 0 ] && [ $PgmFail -ne 0 ]; then - echo $ToRun @PgmArgs \\< $PgmStdinFile - echo "****" expected a failure, but was successful - myexit=1 -fi -if [ \$progexit -ne $PgmExitStatus ] && [ $PgmFail -eq 0 ]; then - echo $ToRun @PgmArgs \\< $PgmStdinFile - echo "****" expected exit status $PgmExitStatus not seen \\; got \$progexit - myexit=1 -else - $PostScriptLines - hit='NO' - for out_file in @PgmStdoutFile ; do - if cmp -s \$out_file $TmpPrefix/runtest$$.1 ; then - hit='YES' - fi - done - if [ \$hit = 'NO' ] ; then - echo $ToRun @PgmArgs \\< $PgmStdinFile - echo expected stdout not matched by reality - orig_file="$PgmStdoutFile[0]"; - [ ! -f \$orig_file ] && orig_file="/dev/null" - ${CONTEXT_DIFF} \$orig_file $TmpPrefix/runtest$$.1 - myexit=\$? - diffsShown=1 - fi - if [ $SaveStdout = 1 ] && - [ $PgmStdoutFile[0] != $DefaultStdoutFile ] && [ -s $TmpPrefix/runtest$$.1 ]; then - echo Saving away stdout output in $PgmStdoutFile[0] ... - if [ -f $PgmStdoutFile[0] ]; then - rm -f $PgmStdoutFile[0].bak - cp $PgmStdoutFile[0] $PgmStdoutFile[0].bak - fi; - cp $TmpPrefix/runtest$$.1 $PgmStdoutFile[0] - fi -fi - -hit='NO' -for out_file in @PgmStderrFile ; do - if cmp -s \$out_file $TmpPrefix/runtest$$.2 ; then - hit='YES' - fi -done -if [ \$hit = 'NO' ] ; then - echo $ToRun @PgmArgs \\< $PgmStdinFile - echo expected stderr not matched by reality - orig_file="$PgmStderrFile[0]" - [ ! -f \$orig_file ] && orig_file="/dev/null" - ${CONTEXT_DIFF} \$orig_file $TmpPrefix/runtest$$.2 - myexit=\$? - diffsShown=1 -fi -if [ $SaveStderr = 1 ] && - [ $PgmStderrFile[0] != $DefaultStderrFile ] && [ -s $TmpPrefix/runtest$$.2 ]; then - echo Saving away stderr output in $PgmStderrFile[0] ... - if [ -f $PgmStderrFile[0] ]; then - rm -f $PgmStderrFile[0].bak - cp $PgmStderrFile[0] $PgmStderrFile[0].bak - fi; - cp $TmpPrefix/runtest$$.2 $PgmStderrFile[0] -fi - -${RM} core $ToRunOrig.spix $DefaultStdoutFile $DefaultStderrFile $TmpPrefix/runtest$$.1 $TmpPrefix/runtest$$.2 $TmpPrefix/runtest$$.3 -exit \$myexit -EOSCRIPT - -# bung script into a file -open(SCR, "> $ScriptFile") || die "Failed opening script file $ScriptFile!\n"; -print SCR $Script; -close(SCR) || die "Failed closing script file!\n"; -chmod 0755, $ScriptFile; - -print STDERR $Script if $Verbose; - -&run_something($ScriptFile); - -if ( $SysSpecificTiming eq '' ) { - unlink $StatsFile; - unlink $ScriptFile; - exit 0; -} - -&process_stats_file(); -&process_cachegrind_files() if $Cachegrind eq 'yes'; - -# print out what we found -print STDERR "<<$SysSpecificTiming: "; -if ( $Cachegrind ne 'yes') { - print STDERR "$BytesAlloc bytes, $GCs GCs, $AvgResidency/$MaxResidency avg/max bytes residency ($ResidencySamples samples), $GCWork bytes GC work, ${TotMem}M in use, $InitTime INIT ($InitElapsed elapsed), $MutTime MUT ($MutElapsed elapsed), $GcTime GC ($GcElapsed elapsed)"; -} else { - print STDERR "$BytesAlloc bytes, $GCs GCs, $AvgResidency/$MaxResidency avg/max bytes residency ($ResidencySamples samples), $GCWork bytes GC work, ${TotMem}M in use, $InitTime INIT ($InitElapsed elapsed), $MutTime MUT ($MutElapsed elapsed), $GcTime GC ($GcElapsed elapsed), $TotInstrs instructions, $TotReads memory reads, $TotWrites memory writes, $TotMisses L2 cache misses"; -}; -print STDERR " :$SysSpecificTiming>>\n"; - -# OK, party over -unlink $StatsFile; -unlink $ScriptFile; -exit 0; - -sub grab_arg_arg { - local($option, $rest_of_arg) = @_; - - if ($rest_of_arg ne "") { - return($rest_of_arg); - } elsif ($#ARGV >= 0) { - local($temp) = $ARGV[0]; shift(@ARGV); - return($temp); - } else { - print STDERR "$Pgm: no argument following $option option\n"; - $Status++; - } -} - -sub run_something { - local($str_to_do) = @_; - -# print STDERR "$str_to_do\n" if $Verbose; - - local($return_val) = 0; - system($str_to_do); - $return_val = $?; - - if ($return_val != 0) { -#ToDo: this return-value mangling is wrong -# local($die_msg) = "$Pgm: execution of the $tidy_name had trouble"; -# $die_msg .= " (program not found)" if $return_val == 255; -# $die_msg .= " ($!)" if $Verbose && $! != 0; -# $die_msg .= "\n"; - unlink $ScriptFile; - unlink $StatsFile; - - exit (($return_val == 0) ? 0 : 1); - } -} - -sub process_stats_file { - - # OK, process system-specific stats file - if ( $SysSpecificTiming =~ /^ghc/ ) { - - #NB: nearly the same as in GHC driver's -ghc-timing stuff - - open(STATS, $StatsFile) || die "Failed when opening $StatsFile\n"; - - local($max_live) = 0; - local($tot_live) = 0; # for calculating residency stuff - local($tot_samples) = 0; - - $GCWork = 0; - while (<STATS>) { - if (! /Gen:\s+0/ && /^\s*\d+\s+\d+\s+(\d+)\s+\d+\.\d+/ ) { - $max_live = $1 if $max_live < $1; - $tot_live += $1; - $tot_samples += 1; - } - - $BytesAlloc = $1 if /^\s*([0-9,]+) bytes allocated in the heap/; - $GCWork += $1 if /^\s*([0-9,]+) bytes copied during GC/; - -# if ( /^\s*([0-9,]+) bytes maximum residency .* (\d+) sample/ ) { -# $MaxResidency = $1; $ResidencySamples = $2; -# } - - $GCs = $1 if /^\s*([0-9,]+) collections? in generation 0/; - - if ( /^\s+([0-9]+)\s+Mb total memory/ ) { - $TotMem = $1; - } - - if ( /^\s*INIT\s+time\s*(-*\d+\.\d\d)s\s*\(\s*(-*\d+\.\d\d)s elapsed\)/ ) { - $InitTime = $1; $InitElapsed = $2; - } elsif ( /^\s*MUT\s+time\s*(-*\d+\.\d\d)s\s*\(\s*(-*\d+\.\d\d)s elapsed\)/ ) { - $MutTime = $1; $MutElapsed = $2; - } elsif ( /^\s*GC\s+time\s*(-*\d+\.\d\d)s\s*\(\s*(-*\d+\.\d\d)s elapsed\)/ ) { - $GcTime = $1; $GcElapsed = $2; - } - } - close(STATS) || die "Failed when closing $StatsFile\n"; - if ( $tot_samples > 0 ) { - $ResidencySamples = $tot_samples; - $MaxResidency = $max_live; - $AvgResidency = int ($tot_live / $tot_samples) ; - } - - } elsif ( $SysSpecificTiming eq 'hbc' ) { - - open(STATS, $StatsFile) || die "Failed when opening $StatsFile\n"; - while (<STATS>) { - $BytesAlloc = $1 if /^\s*([0-9]+) bytes allocated from the heap/; - - $GCs = $1 if /^\s*([0-9]+) GCs?,$/; - - if ( /^\s*(\d+\.\d\d) \((\d+\.\d)\) seconds total time,$/ ) { - $MutTime = $1; $MutElapsed = $2; # will fix up later - - $InitTime = 0; $InitElapsed = 0; # hbc doesn't report these - - } elsif ( /^\s*(\d+\.\d\d) \((\d+\.\d)\) seconds GC time/ ) { - $GcTime = $1; $GcElapsed = $2; - - # fix up mutator time now - $MutTime = sprintf("%.2f", ($MutTime - $GcTime)); - $MutElapsed = sprintf("%.1f", ($MutElapsed - $GcElapsed)); - } - } - close(STATS) || die "Failed when closing $StatsFile\n"; - } - - # warn about what we didn't find - print STDERR "Warning: BytesAlloc not found in stats file\n" unless defined($BytesAlloc); - print STDERR "Warning: GCs not found in stats file\n" unless defined($GCs); - print STDERR "Warning: InitTime not found in stats file\n" unless defined($InitTime); - print STDERR "Warning: InitElapsed not found in stats file\n" unless defined($InitElapsed); - print STDERR "Warning: MutTime not found in stats file\n" unless defined($MutTime); - print STDERR "Warning: MutElapsed not found in stats file\n" unless defined($MutElapsed); - print STDERR "Warning: GcTime inot found in stats file\n" unless defined($GcTime); - print STDERR "Warning: GcElapsed not found in stats file\n" unless defined($GcElapsed); - print STDERR "Warning: total memory not found in stats file\n" unless defined($TotMem); - print STDERR "Warning: GC work not found in stats file\n" unless defined($GCWork); - - # things we didn't necessarily expect to find - $MaxResidency = 0 unless defined($MaxResidency); - $AvgResidency = 0 unless defined($AvgResidency); - $ResidencySamples = 0 unless defined($ResidencySamples); - - # a bit of tidying - $BytesAlloc =~ s/,//g; - $GCWork =~ s/,//g; - $MaxResidency =~ s/,//g; - $GCs =~ s/,//g; - $InitTime =~ s/,//g; - $InitElapsed =~ s/,//g; - $MutTime =~ s/,//g; - $MutElapsed =~ s/,//g; - $GcTime =~ s/,//g; - $GcElapsed =~ s/,//g; -} - -sub process_cachegrind_files { - - open(STATS, "< $CachegrindStats") || die("Can't open $CachegrindStats\n"); - - while (<STATS>) { - /^==\d+==\s+I\s+refs:\s+([0-9,]*)/ && do { - $TotInstrs = $1; - $TotInstrs =~ s/,//g; - }; - - /^==\d+==\s+D\s+refs:\s+[0-9,]+\s+\(([0-9,]+)\s+rd\s+\+\s+([0-9,]+)\s+wr/ && do { - $TotReads = $1; - $TotWrites = $2; - $TotReads =~ s/,//g; - $TotWrites =~ s/,//g; - }; - - /^==\d+==\s+L2d\s+misses:\s+([0-9,]+)/ && do { - $TotMisses = $1; - $TotMisses =~ s/,//g; - }; - } - close(STATS); -} - diff --git a/glafp-utils/sgmlverb/Makefile b/glafp-utils/sgmlverb/Makefile deleted file mode 100644 index 4ae120326f..0000000000 --- a/glafp-utils/sgmlverb/Makefile +++ /dev/null @@ -1,18 +0,0 @@ -TOP=.. -include $(TOP)/mk/boilerplate.mk - -C_SRCS = sgmlverb.c -C_PROG = sgmlverb -LIBS = $(FLEX_LIB) - -override SRC_FLEX_OPTS=-8 - -# sgmlverb.c isn't in distclean -MAINTAINER_CLEAN_FILES += sgmlverb.c - -# -# For src distributions, include flex output. -# -SRC_DIST_FILES += sgmlverb.c - -include $(TOP)/mk/target.mk diff --git a/glafp-utils/sgmlverb/sgmlverb.lex b/glafp-utils/sgmlverb/sgmlverb.lex deleted file mode 100644 index 812cb8416c..0000000000 --- a/glafp-utils/sgmlverb/sgmlverb.lex +++ /dev/null @@ -1,68 +0,0 @@ - - /* This Lex script acts as a filter to pre-process Latex files. - - It surrounds groups of lines beginning with a ">" sign, and - preceded and followed by a blank line, with \begin{verbatim} - and \end{verbatim}. The ">" may be preceded by a digit or digit - range (eg 4>, 2-5>, 3->); in this case the digits are removed. - They are meant to be used for filtering out versions. - - It takes words surrounded with @ signs (thus @letrec@) and makes them - come out in typewriter font, regardless of the current mode. - */ - -%START NORM VERB VERBENV -sp [ \t]* -nl {sp}\n{sp} -comment \%.*$ -miranda ([0-9]+(\-([0-9]+)?)?)?> -%{ -#define PUSH states[top++] = -#define POP BEGIN states[--top] -#define yywrap() 1 -#define YY_SKIP_YYWRAP -%} -%% - int states[256]; - int top; - BEGIN NORM; - top = 0; -<NORM>@@ { printf ("@"); } -<NORM>@ { printf ("<tt>"); PUSH NORM; BEGIN VERB; } -<NORM>\\% { printf ("%"); } -<NORM>{comment} { } -<VERB>@ { printf ("</tt>"); POP; } -<VERB>@@ { printf ("@"); } -<VERB>\> { printf (">"); } -<VERB>\< { printf ("<"); } -<VERB>\# { printf ("#"); } -<VERB>\$ { printf ("$"); } -<VERB>\% { printf ("%"); } -<VERB>\& { printf ("&"); } -<VERB>\~ { printf ("˜"); } -<VERB>\^ { printf ("ˆ"); } - -<NORM>\<verb\> { printf ("<verb>"); PUSH NORM; BEGIN VERBENV; } -<NORM>\<code\> { printf ("<code>"); PUSH NORM; BEGIN VERBENV; } -<NORM>\\begin\{code\} { printf ("<code>"); PUSH NORM; BEGIN VERBENV; } -<VERBENV>\<\/verb\> { printf ("</verb>"); POP; } -<VERBENV>\<\/code\> { printf ("</code>"); POP; } -<VERBENV>\<\\end\{code\} { printf ("</code>"); POP; } -<VERBENV>\&\& { printf ("&"); } -<VERBENV>\& { printf ("&ero;"); } -<VERBENV>\<\/ { printf ("&etago;"); } - -%% -int -main() -{ - yylex(); - return(0); -} - -/* -<VERB>\_ { printf ("{\\char'137}"); } -<VERB>\\ { printf ("{\\char'134}"); } -<VERB>\{ { printf ("{\\char'173}"); } -<VERB>\} { printf ("{\\char'175}"); } -*/ diff --git a/glafp-utils/verbatim/Makefile b/glafp-utils/verbatim/Makefile deleted file mode 100644 index eb40f0d1a3..0000000000 --- a/glafp-utils/verbatim/Makefile +++ /dev/null @@ -1,17 +0,0 @@ -TOP=.. -include $(TOP)/mk/boilerplate.mk - -C_SRCS = verbatim.c -C_PROG = verbatim -LIBS = $(FLEX_LIB) - -override SRC_FLEX_OPTS=-8 - -# -# For src distributions, include flex output. -# -SRC_DIST_FILES += verbatim.c - -CLEAN_FILES += verbatim.c - -include $(TOP)/mk/target.mk diff --git a/glafp-utils/verbatim/verbatim.lex b/glafp-utils/verbatim/verbatim.lex deleted file mode 100644 index bac87cc45f..0000000000 --- a/glafp-utils/verbatim/verbatim.lex +++ /dev/null @@ -1,63 +0,0 @@ - - /* This Lex script acts as a filter to pre-process Latex files. - - It surrounds groups of lines beginning with a ">" sign, and - preceded and followed by a blank line, with \begin{verbatim} - and \end{verbatim}. The ">" may be preceded by a digit or digit - range (eg 4>, 2-5>, 3->); in this case the digits are removed. - They are meant to be used for filtering out versions. - - It takes words surrounded with @ signs (thus @letrec@) and makes them - come out in typewriter font, regardless of the current mode. - */ - -%START NORM VERB MIRANDA VERBATIM VERBATIMSIM -sp [ \t]* -nl {sp}\n{sp} -miranda ([0-9]+(\-([0-9]+)?)?)?> -%{ -#define PUSH states[top++] = -#define POP BEGIN states[--top] -#define yywrap() 1 -%} -%% - int states[256]; - int top; - BEGIN NORM; - top = 0; -<NORM>@@ { printf ("@"); } -<NORM>@ { printf ("\\mbox{\\tt "); PUSH NORM; BEGIN VERB; } -<VERB>@ { printf ("}"); POP; } -<VERB>\n { printf ("}\\\\{}\n\\mbox{\\tt "); } -<VERB>" " { printf ("\\ "); } -<VERB>@@ { printf ("@"); } -<VERB>\# { printf ("{\\char'43}"); } -<VERB>\$ { printf ("{\\char'44}"); } -<VERB>\% { printf ("{\\char'45}"); } -<VERB>\& { printf ("{\\char'46}"); } -<VERB>\~ { printf ("{\\char'176}"); } -<VERB>\_ { printf ("{\\char'137}"); } -<VERB>\^ { printf ("{\\char'136}"); } -<VERB>\\ { printf ("{\\char'134}"); } -<VERB>\{ { printf ("{\\char'173}"); } -<VERB>\} { printf ("{\\char'175}"); } - -<NORM>^@{sp}\n { printf( "\\begin{verbatim}\n" ); - PUSH NORM; BEGIN VERBATIMSIM; } -<VERBATIMSIM>^@{sp}\n { printf( "\\end{verbatim}\n" ); POP; } - -<NORM>\\"begin{verbatim}" { printf( "\\begin{verbatim}" ); - PUSH NORM; BEGIN VERBATIM; } -<VERBATIM>\\"end{verbatim}" { printf( "\\end{verbatim}" ); POP; } - -<NORM>^\n{miranda} { printf ("\\begin{verbatim}\n>" ); - PUSH NORM; BEGIN MIRANDA; } -<MIRANDA>\n{miranda} { printf( "\n>" ); } -<MIRANDA>^\n { printf ("\\end{verbatim}\n"); POP; } -%% -int -main() -{ - yylex(); - return(0); -} |