ghc/utils/unlit/unlit.c

   1 /* unlit.c                                   Wed Dec  5 17:16:24 GMT 1990
   2  *
   3  * Literate script filter.  In contrast with the format used by most
   4  * programming languages, a literate script is a program in which
   5  * comments are given the leading role, whilst program text must be
   6  * explicitly flagged as such by placing a `>' character in the first
   7  * column on each line.  It is hoped that this style of programming will
   8  * encourage the writing of accurate and clearly documented programs
   9  * in which the writer may include motivating arguments, examples
  10  * and explanations.
  11  *
  12  * Unlit is a filter that can be used to strip all of the comment lines
  13  * out of a literate script file.  The command format for unlit is:
  14  *              unlit [-n] [-q] ifile ofile
  15  * where ifile and ofile are the names of the input (literate script) and
  16  * output (raw program) files respectively.  Either of these names may
  17  * be `-' representing the standard input or the standard output resp.
  18  * A number of rules are used in an attempt to guard against the most
  19  * common errors that are made when writing literate scripts:
  20  * 1) Empty script files are not permitted.  A file in which no lines
  21  *    begin with `>' usually indicates a file in which the programmer
  22  *    has forgotten about the literate script convention.
  23  * 2) A line containing part of program definition (i.e. preceeded by `>')
  24  *    cannot be used immediately before or after a comment line unless
  25  *    the comment line is blank.  This error usually indicates that
  26  *    the `>' character has been omitted from a line in a section of
  27  *    program spread over a number of lines.
  28  * Using the -q (quiet) flag suppresses the signalling of these error
  29  * conditions.  The default behaviour can be selected explicitly using
  30  * the -n (noisy) option so that any potential errors in the script file
  31  * are reported.
  32  *
  33  * The original idea for the use of literate scripts is due to Richard
  34  * Bird of the programming Research Group, Oxford and was initially
  35  * adopted for use in the implementation of the functional programming
  36  * language Orwell used for teaching in Oxford.  This idea has subsequently
  37  * been borrowed in a number of other language implementations.
  38  *
  39  * Modified to understand \begin{code} ... \end{code} used in Glasgow.  -- LA
  40  * And \begin{pseudocode} ... \end{pseudocode}.  -- LA
  41  */
  42
  43 #include <stdio.h>
  44 #include <stdlib.h>
  45 #include <ctype.h>
  46
  47 #define NULLSTR        ((char *)0)
  48 #define DEFNCHAR       '>'
  49 #define MISSINGBLANK   "unlit: Program line next to comment"
  50 #define EMPTYSCRIPT    "unlit: No definitions in file (perhaps you forgot the '>'s?)"
  51 #define USAGE          "usage: unlit [-q] [-n] [-c] file1 file2\n"
  52 #define CANNOTOPEN     "unlit: cannot open \"%s\"\n"
  53 #define DISTINCTNAMES  "unlit: input and output filenames must differ\n"
  54 #define MISSINGENDCODE "unlit: missing \\end{code}\n"
  55
  56 #define BEGINCODE "\\begin{code}"
  57 #define LENBEGINCODE 12
  58 #define ENDCODE "\\end{code}"
  59 #define LENENDCODE 10
  60 #ifdef PSEUDOCODE
  61 /* According to Will Partain, the inventor of pseudocode, this gone now. */
  62 #define MISSINGENDPSEUDOCODE "unlit: missing \\end{pseudocode}\n"
  63 #define BEGINPSEUDOCODE "\\begin{pseudocode}"
  64 #define LENBEGINPSEUDOCODE 18
  65 #define ENDPSEUDOCODE "\\end{pseudocode}"
  66 #define LENENDPSEUDOCODE 16
  67 #endif
  68
  69 typedef enum { START, BLANK, TEXT, DEFN, BEGIN, /*PSEUDO,*/ END, HASH, SHEBANG } line;
  70 #define isWhitespace(c)  (c==' '  || c=='\t')
  71 #define isLineTerm(c)    (c=='\n' || c==EOF)
  72
  73 static int noisy  = 1;   /* 0 => keep quiet about errors, 1 => report errors */
  74 static int errors = 0;   /* count the number of errors reported              */
  75 static int crunchnl = 0; /* don't print \n for removed lines                 */
  76 static int leavecpp = 1; /* leave preprocessor lines */
  77 static int ignore_shebang = 1; /* Leave out shebang (#!) lines */
  78
  79 static char* prefix_str = NULL; /* Prefix output with a string */
  80
  81 /* complain(file,line,what)
  82  *
  83  * print error message `what' for `file' at `line'.  The error is suppressed
  84  * if noisy is not set.
  85  */
  86
  87 complain(file, lin, what)
  88 char *file;
  89 char *what;
  90 int lin; {
  91     if (noisy) {
  92         if (file)
  93             fprintf(stderr, "%s ", file);
  94         fprintf(stderr,"line %d: %s\n",lin,what);
  95         errors++;
  96     }
  97 }
  98
  99 #define TABPOS 8
 100
 101 /* As getc, but does TAB expansion */
 102 int
 103 egetc(istream)
 104 FILE *istream;
 105 {
 106     static int spleft = 0;
 107     static int linepos = 0;
 108     int c;
 109
 110     if (spleft > 0) {
 111         spleft--;
 112         linepos++;
 113         return ' ';
 114     }
 115     c = getc(istream);
 116     if (c == EOF)
 117         return c;
 118     else if (c == '\n' || c == '\f') {
 119         linepos = 0;
 120         return c;
 121     } else if (c == '\t') {
 122         spleft = TABPOS - linepos % TABPOS;
 123         spleft--;
 124         linepos++;
 125         return ' ';
 126     } else {
 127         linepos++;
 128         return c;
 129     }
 130
 131 }
 132
 133 /* readline(istream, ostream)
 134  *
 135  * Read a line from the input stream `istream', and return a value
 136  * indicating whether that line was:
 137  *     BLANK (whitespace only),
 138  *     DEFN  (first character is DEFNCHAR),
 139  *     TEXT  (a line of text)
 140  *     BEGIN (a \begin{code} line)
 141  *     PSEUDO (a \begin{pseodocode} line)
 142  *     HASH  (a preprocessor line)
 143  * or  END   (indicating an EOF).
 144  * Lines of type DEFN are copied to the output stream `ostream'
 145  * (without the leading DEFNCHAR).  BLANK and TEXT lines are
 146  * replaced by empty (i.e. blank lines) in the output stream, so
 147  * that error messages refering to line numbers in the output file
 148  * can also be used to locate the corresponding line in the input
 149  * stream.
 150  */
 151
 152 line readline(istream,ostream)
 153 FILE *istream, *ostream; {
 154     int c, c1;
 155     char buf[100];
 156     int i;
 157
 158     c = egetc(istream);
 159
 160     if (c==EOF)
 161         return END;
 162
 163     if ( c == '#' ) {
 164       if ( ignore_shebang ) {
 165          c1 = egetc(istream);
 166          if ( c1 == '!' ) {
 167            while (c=egetc(istream), !isLineTerm(c)) ;
 168            return SHEBANG;
 169          }
 170          putc(c, ostream);
 171          c=c1;
 172       }
 173       if ( leavecpp ) {
 174         putc(c, ostream);
 175         while (c=egetc(istream), !isLineTerm(c))
 176             putc(c,ostream);
 177         putc('\n',ostream);
 178         return HASH;
 179       }
 180     }
 181
 182     if (c==DEFNCHAR) {
 183 /*      putc(' ',ostream);*/
 184         while (c=egetc(istream), !isLineTerm(c))
 185             putc(c,ostream);
 186         putc('\n',ostream);
 187         return DEFN;
 188     }
 189
 190     if (!crunchnl)
 191         putc('\n',ostream);
 192
 193     while (isWhitespace(c))
 194         c=egetc(istream);
 195     if (isLineTerm(c))
 196         return BLANK;
 197
 198     i = 0;
 199     buf[i++] = c;
 200     while (c=egetc(istream), !isLineTerm(c))
 201         if (i < sizeof buf - 1)
 202             buf[i++] = c;
 203     while(i > 0 && isspace(buf[i-1]))
 204         i--;
 205     buf[i] = 0;
 206     if (strcmp(buf, BEGINCODE) == 0)
 207         return BEGIN;
 208 #ifdef PSEUDOCODE
 209     else if (strcmp(buf, BEGINPSEUDOCODE) == 0)
 210         return PSEUDO;
 211 #endif
 212     else
 213         return TEXT;
 214 }
 215
 216
 217 /* unlit(file,istream,ostream)
 218  *
 219  * Copy the file named `file', accessed using the input stream `istream'
 220  * to the output stream `ostream', removing any comments and checking
 221  * for bad use of literate script features:
 222  *  - there should be at least one BLANK line between a DEFN and TEXT
 223  *  - there should be at least one DEFN line in a script.
 224  */
 225
 226 unlit(file, istream, ostream)
 227 char *file;
 228 FILE *istream;
 229 FILE *ostream; {
 230     line last, this=START;
 231     int  linesread=0;
 232     int  defnsread=0;
 233
 234     do {
 235         last = this;
 236         this = readline(istream, ostream);
 237         linesread++;
 238         if (this==DEFN)
 239             defnsread++;
 240         if (last==DEFN && this==TEXT)
 241             complain(file, linesread-1, MISSINGBLANK);
 242         if (last==TEXT && this==DEFN)
 243             complain(file, linesread, MISSINGBLANK);
 244         if (this == BEGIN) {
 245             /* start of code, copy to end */
 246             char lineb[1000];
 247             for(;;) {
 248                 if (fgets(lineb, sizeof lineb, istream) == NULL) {
 249                     complain(file, linesread, MISSINGENDCODE);
 250                     exit(1);
 251                 }
 252                 linesread++;
 253                 if (strncmp(lineb,ENDCODE,LENENDCODE) == 0) {
 254                     putc('\n', ostream);
 255                     break;
 256                 }
 257                 fputs(lineb, ostream);
 258             }
 259             defnsread++;
 260         }
 261 #ifdef PSEUDOCODE
 262         if (this == PSEUDO) {
 263             char lineb[1000];
 264             for(;;) {
 265                 if (fgets(lineb, sizeof lineb, istream) == NULL) {
 266                     complain(file, linesread, MISSINGENDPSEUDOCODE);
 267                     exit(1);
 268                 }
 269                 linesread++;
 270                 putc('\n', ostream);
 271                 if (strncmp(lineb,ENDPSEUDOCODE,LENENDPSEUDOCODE) == 0) {
 272                     break;
 273                 }
 274             }
 275         }
 276 #endif
 277     } while(this!=END);
 278
 279     if (defnsread==0)
 280         complain(file,linesread,EMPTYSCRIPT);
 281 }
 282
 283 /* main(argc, argv)
 284  *
 285  * Main program.  Processes command line arguments, looking for leading:
 286  *  -q  quiet mode - do not complain about bad literate script files
 287  *  -n  noisy mode - complain about bad literate script files.
 288  *  -r  remove cpp droppings in output.
 289  * Expects two additional arguments, a file name for the input and a file
 290  * name for the output file.  These two names must normally be distinct.
 291  * An exception is made for the special name "-" which can be used in either
 292  * position to specify the standard input or the standard output respectively.
 293  */
 294
 295 main(argc,argv)
 296 int argc;
 297 char **argv; {
 298     FILE *istream, *ostream;
 299     char *file;
 300
 301     for (argc--, argv++; argc > 0; argc--, argv++)
 302         if (strcmp(*argv,"-n")==0)
 303             noisy = 1;
 304         else if (strcmp(*argv,"-q")==0)
 305             noisy = 0;
 306         else if (strcmp(*argv,"-c")==0)
 307             crunchnl = 1;
 308         else if (strcmp(*argv,"-h")==0) {
 309           if (argc > 1) {
 310             argc--; argv++;
 311             if (prefix_str)
 312               free(prefix_str);
 313             prefix_str = (char*)malloc(sizeof(char)*(1+strlen(*argv)));
 314             if (prefix_str)
 315               strcpy(prefix_str, *argv);
 316           }
 317         } else if (strcmp(*argv,"-#")==0)
 318             ignore_shebang = 0;
 319         else
 320             break;
 321
 322     if (argc!=2) {
 323         fprintf(stderr, USAGE);
 324         exit(1);
 325     }
 326
 327     if (strcmp(argv[0],argv[1])==0 && strcmp(argv[0],"-")!=0) {
 328         fprintf(stderr, DISTINCTNAMES);
 329         exit(1);
 330     }
 331
 332     file = argv[0];
 333     if (strcmp(argv[0], "-")==0) {
 334         istream = stdin;
 335         file    = "stdin";
 336     }
 337     else
 338         if ((istream=fopen(argv[0], "r")) == NULL) {
 339             fprintf(stderr, CANNOTOPEN, argv[0]);
 340             exit(1);
 341         }
 342
 343     if (strcmp(argv[1], "-")==0)
 344         ostream = stdout;
 345     else
 346         if ((ostream=fopen(argv[1], "w")) == NULL)  {
 347             fprintf(stderr, CANNOTOPEN, argv[1]);
 348             exit(1);
 349         }
 350
 351     /* Prefix the output with line pragmas */
 352     if (prefix_str) {
 353       fprintf(ostream, "#line 1 \"%s\"\n{-# LINE 1 \"%s\" #-}\n", prefix_str, prefix_str);
 354     }
 355
 356     unlit(file, istream, ostream);
 357
 358     if (istream != stdin)  fclose(istream);
 359     if (ostream != stdout) fclose(ostream);
 360
 361     exit(errors==0 ? 0 : 1);
 362 }