From 23d6b5a6ee9ddd1d6bffe06d4b73e7ec16e0396f Mon Sep 17 00:00:00 2001 From: Jim Blandy Date: Wed, 8 Jul 1992 22:47:39 +0000 Subject: [PATCH] *** empty log message *** --- lib-src/make-docfile.c | 568 ++++++++++++++++------------------------- src/eval.c | 37 +-- 2 files changed, 230 insertions(+), 375 deletions(-) diff --git a/lib-src/make-docfile.c b/lib-src/make-docfile.c index d8e9377f32..676f29cb9c 100644 --- a/lib-src/make-docfile.c +++ b/lib-src/make-docfile.c @@ -348,35 +348,74 @@ scan_c_file (filename) /* Read a file of Lisp code, compiled or interpreted. Looks for (defun NAME ARGS DOCSTRING ...) - (autoload 'NAME FILE DOCSTRING ...) + (defmacro NAME ARGS DOCSTRING ...) + (autoload (quote NAME) FILE DOCSTRING ...) (defvar NAME VALUE DOCSTRING) (defconst NAME VALUE DOCSTRING) - (fset (quote NAME) (make-byte-code (quote ARGS) ... "\ - DOCSTRING") + (fset (quote NAME) (make-byte-code ... DOCSTRING ...)) + (fset (quote NAME) #[... DOCSTRING ...]) starting in column zero. - ARGS, FILE or VALUE is ignored. We do not know how to parse Lisp code - so we use a kludge to skip them: - In a function definition, the form of ARGS of FILE is known, and we - can skip it. - In a variable definition, we use a formatting convention: - the DOCSTRING, if present, must be followed by a closeparen and a newline, - and no newline must appear between the defvar or defconst and the docstring, - The only source file that must follow this convention is loaddefs.el; - aside from that, it is always the .elc file that we look at, and - they are no problem because byte-compiler output follows this convention. + (quote NAME) may appear as 'NAME as well. + For defun, defmacro, and autoload, we know how to skip over the arglist. + For defvar, defconst, and fset we skip to the docstring with a klugey + formatting convention: all docstrings must appear on the same line as the + initial open-paren (the one in column zero) and must contain a backslash + and a double-quote immediately after the initial double-quote. No newlines + must appear between the beginning of the form and the first double-quote. + The only source file that must follow this convention is loaddefs.el; aside + from that, it is always the .elc file that we look at, and they are no + problem because byte-compiler output follows this convention. The NAME and DOCSTRING are output. NAME is preceded by `F' for a function or `V' for a variable. An entry is output only if DOCSTRING has \ newline just after the opening " */ +void +skip_white (infile) + FILE *infile; +{ + char c = ' '; + while (c == ' ' || c == '\t' || c == '\n') + c = getc (infile); + ungetc (c, infile); +} + +void +read_lisp_symbol (infile, buffer) + FILE *infile; + char *buffer; +{ + char c; + char *fillp = buffer; + + skip_white (infile); + while (1) + { + c = getc (infile); + if (c == '\\') + *(++fillp) = getc (infile); + else if (c == ' ' || c == '\t' || c == '\n' || c == '(' || c == ')') + { + ungetc (c, infile); + *fillp = 0; + break; + } + else + *fillp++ = c; + } + + if (! buffer[0]) + fprintf (stderr, "## expected a symbol, got '%c'\n", c); + + skip_white (infile); +} + + scan_lisp_file (filename) char *filename; { FILE *infile; register int c; - register int commas; - register char *p; - int defvarflag; infile = fopen (filename, "r"); if (infile == NULL) @@ -388,6 +427,10 @@ scan_lisp_file (filename) c = '\n'; while (!feof (infile)) { + char buffer [BUFSIZ]; + char *fillp = buffer; + char type; + if (c != '\n') { c = getc (infile); @@ -397,382 +440,213 @@ scan_lisp_file (filename) if (c != '(') continue; - /* Handle an autoload. */ - c = getc (infile); - if (c == 'a') + read_lisp_symbol (infile, buffer); + + if (! strcmp (buffer, "defun") || + ! strcmp (buffer, "defmacro")) { - c = getc (infile); - if (c != 'u') - continue; - c = getc (infile); - if (c != 't') - continue; - c = getc (infile); - if (c != 'o') - continue; - c = getc (infile); - if (c != 'l') - continue; - c = getc (infile); - if (c != 'o') - continue; - c = getc (infile); - if (c != 'a') - continue; - c = getc (infile); - if (c != 'd') - continue; + type = 'F'; + read_lisp_symbol (infile, buffer); - c = getc (infile); - while (c == ' ') - c = getc (infile); + /* Skip the arguments: either "nil" or a list in parens */ - if (c == '\'') + c = getc (infile); + if (c == 'n') /* nil */ { - c = getc (infile); + if ((c = getc (infile)) != 'i' || + (c = getc (infile)) != 'l') + { + fprintf (stderr, "## unparsable arglist in %s (%s)\n", + buffer, filename); + continue; + } } - else + else if (c != '(') { - if (c != '(') - continue; - c = getc (infile); - if (c != 'q') - continue; - c = getc (infile); - if (c != 'u') - continue; - c = getc (infile); - if (c != 'o') - continue; - c = getc (infile); - if (c != 't') - continue; - c = getc (infile); - if (c != 'e') - continue; - c = getc (infile); - if (c != ' ') - continue; - while (c == ' ') - c = getc (infile); + fprintf (stderr, "## unparsable arglist in %s (%s)\n", + buffer, filename); + continue; } - - p = buf; - while (c != ' ' && c != ')') - { - if (c == EOF) - return 1; - if (c == '\\') - c = getc (infile); - *p++ = c; + else + while (c != ')') c = getc (infile); - } - *p = 0; - - while (c != '"') + skip_white (infile); + + /* If the next three characters aren't `dquote bslash newline' + then we're not reading a docstring. + */ + if ((c = getc (infile)) != '"' || + (c = getc (infile)) != '\\' || + (c = getc (infile)) != '\n') { - if (c == EOF) - return 1; - c = getc (infile); +#ifdef DEBUG + fprintf (stderr, "## non-docstring in %s (%s)\n", + buffer, filename); +#endif + continue; } - c = read_c_string (infile, 0); } - /* Handle def* clauses. */ - else if (c == 'd') + else if (! strcmp (buffer, "defvar") || + ! strcmp (buffer, "defconst")) { - c = getc (infile); - if (c != 'e') - continue; - c = getc (infile); - if (c != 'f') - continue; - c = getc (infile); + char c1 = 0, c2 = 0; + type = 'V'; + read_lisp_symbol (infile, buffer); - /* Is this a defun? */ - if (c == 'u') + /* Skip until the first newline; remember the two previous chars. */ + while (c != '\n' && c >= 0) { + c2 = c1; + c1 = c; c = getc (infile); - if (c != 'n') - continue; - defvarflag = 0; } - - /* Or a defvar? */ - else if (c == 'v') + + /* If two previous characters were " and \, + this is a doc string. Otherwise, there is none. */ + if (c2 != '"' || c1 != '\\') { - c = getc (infile); - if (c != 'a') - continue; - c = getc (infile); - if (c != 'r') - continue; - defvarflag = 1; +#ifdef DEBUG + fprintf (stderr, "## non-docstring in %s (%s)\n", + buffer, filename); +#endif + continue; } + } + + else if (! strcmp (buffer, "fset")) + { + char c1 = 0, c2 = 0; + type = 'F'; - /* Or a defconst? */ - else if (c == 'c') + c = getc (infile); + if (c == '\'') + read_lisp_symbol (infile, buffer); + else { + if (c != '(') + { + fprintf (stderr, "## unparsable name in fset in %s\n", + filename); + continue; + } + read_lisp_symbol (infile, buffer); + if (strcmp (buffer, "quote")) + { + fprintf (stderr, "## unparsable name in fset in %s\n", + filename); + continue; + } + read_lisp_symbol (infile, buffer); c = getc (infile); - if (c != 'o') - continue; - c = getc (infile); - if (c != 'n') - continue; - c = getc (infile); - if (c != 's') - continue; - c = getc (infile); - if (c != 't') - continue; - defvarflag = 1; + if (c != ')') + { + fprintf (stderr, + "## unparsable quoted name in fset in %s\n", + filename); + continue; + } } - else - continue; - - /* Now we have seen "defun" or "defvar" or "defconst". */ - while (c != ' ' && c != '\n' && c != '\t') - c = getc (infile); - - while (c == ' ' || c == '\n' || c == '\t') - c = getc (infile); - - /* Read and store name of function or variable being defined - Discard backslashes that are for quoting. */ - p = buf; - while (c != ' ' && c != '\n' && c != '\t') + /* Skip until the first newline; remember the two previous chars. */ + while (c != '\n' && c >= 0) { - if (c == '\\') - c = getc (infile); - *p++ = c; + c2 = c1; + c1 = c; c = getc (infile); } - *p = 0; - - while (c == ' ' || c == '\n' || c == '\t') - c = getc (infile); + + /* If two previous characters were " and \, + this is a doc string. Otherwise, there is none. */ + if (c2 != '"' || c1 != '\\') + { +#ifdef DEBUG + fprintf (stderr, "## non-docstring in %s (%s)\n", + buffer, filename); +#endif + continue; + } + } - if (! defvarflag) + else if (! strcmp (buffer, "autoload")) + { + type = 'F'; + c = getc (infile); + if (c == '\'') + read_lisp_symbol (infile, buffer); + else { - /* A function: */ - /* Skip the arguments: either "nil" or a list in parens */ - if (c == 'n') + if (c != '(') { - while (c != ' ' && c != '\n' && c != '\t') - c = getc (infile); + fprintf (stderr, "## unparsable name in autoload in %s\n", + filename); + continue; } - else + read_lisp_symbol (infile, buffer); + if (strcmp (buffer, "quote")) { - while (c != '(') - c = getc (infile); - while (c != ')') - c = getc (infile); + fprintf (stderr, "## unparsable name in autoload in %s\n", + filename); + continue; } + read_lisp_symbol (infile, buffer); c = getc (infile); - } - else - { - /* A variable: */ - - /* Skip until the first newline; remember - the two previous characters. */ - char c1 = 0, c2 = 0; - - while (c != '\n' && c >= 0) + if (c != ')') { - c2 = c1; - c1 = c; - c = getc (infile); - } - - /* If two previous characters were " and \, - this is a doc string. Otherwise, there is none. */ - if (c2 == '"' && c1 == '\\') - { - putc (037, outfile); - putc ('V', outfile); - fprintf (outfile, "%s\n", buf); - read_c_string (infile, 1); + fprintf (stderr, + "## unparsable quoted name in autoload in %s\n", + filename); + continue; } + } + skip_white (infile); + if ((c = getc (infile)) != '\"') + { + fprintf (stderr, "## autoload of %s unparsable (%s)\n", + buffer, filename); continue; } - } - - /* Handle an fset clause. */ - else if (c == 'f') - { - c = getc (infile); - if (c != 's') - continue; - c = getc (infile); - if (c != 'e') - continue; - c = getc (infile); - if (c != 't') - continue; - - /* Skip white space */ - do - c = getc (infile); - while (c == ' ' || c == '\n' || c == '\t'); - - /* Recognize "(quote". */ - if (c != '(') - continue; - c = getc (infile); - if (c != 'q') - continue; - c = getc (infile); - if (c != 'u') - continue; - c = getc (infile); - if (c != 'o') - continue; - c = getc (infile); - if (c != 't') - continue; - c = getc (infile); - if (c != 'e') - continue; - - /* Skip white space */ - do - c = getc (infile); - while (c == ' ' || c == '\n' || c == '\t'); - - /* Read and store name of function or variable being defined - Discard backslashes that are for quoting. */ - p = buf; - while (c != ')' && c != ' ' && c != '\n' && c != '\t') + read_c_string (infile, 0); + skip_white (infile); + + /* If the next three characters aren't `dquote bslash newline' + then we're not reading a docstring. + */ + if ((c = getc (infile)) != '"' || + (c = getc (infile)) != '\\' || + (c = getc (infile)) != '\n') { - if (c == '\\') - c = getc (infile); - *p++ = c; - c = getc (infile); +#ifdef DEBUG + fprintf (stderr, "## non-docstring in %s (%s)\n", + buffer, filename); +#endif + continue; } - *p = '\0'; - - /* Skip white space */ - do - c = getc (infile); - while (c == ' ' || c == '\n' || c == '\t'); - - /* Recognize "(make-byte-code". */ - if (c != '(') - continue; - c = getc (infile); - if (c != 'm') - continue; - c = getc (infile); - if (c != 'a') - continue; - c = getc (infile); - if (c != 'k') - continue; - c = getc (infile); - if (c != 'e') - continue; - c = getc (infile); - if (c != '-') - continue; - c = getc (infile); - if (c != 'b') - continue; - c = getc (infile); - if (c != 'y') - continue; - c = getc (infile); - if (c != 't') - continue; - c = getc (infile); - if (c != 'e') - continue; - c = getc (infile); - if (c != '-') - continue; - c = getc (infile); - if (c != 'c') - continue; - c = getc (infile); - if (c != 'o') - continue; - c = getc (infile); - if (c != 'd') - continue; - c = getc (infile); - if (c != 'e') - continue; - - /* Scan for a \" followed by a newline, or for )) followed by - a newline. If we find the latter first, this function has - no docstring. */ - { - char c1 = 0, c2 = 0; - - for (;;) - { - - /* Find newlines, and remember the two previous characters. */ - for (;;) - { - c = getc (infile); - - if (c == '\n' || c < 0) - break; - - c2 = c1; - c1 = c; - } - - /* If we've hit eof, quit. */ - if (c == EOF) - break; - - /* If the last two characters were \", this is a docstring. */ - else if (c2 == '"' && c1 == '\\') - { - putc (037, outfile); - putc ('F', outfile); - fprintf (outfile, "%s\n", buf); - read_c_string (infile, 1); - break; - } - - /* If the last two characters were )), there is no - docstring. */ - else if (c2 == ')' && c1 == ')') - break; - } - continue; - } } - else - continue; - - /* Here for a function definition. - We have skipped the file name or arguments - and arrived at where the doc string is, - if there is a doc string. */ - - /* Skip whitespace */ - while (c == ' ' || c == '\n' || c == '\t') - c = getc (infile); +#ifdef DEBUG + else if (! strcmp (buffer, "if") || + ! strcmp (buffer, "byte-code")) + ; +#endif - /* " followed by \ and newline means a doc string we should gobble */ - if (c != '"') - continue; - c = getc (infile); - if (c != '\\') - continue; - c = getc (infile); - if (c != '\n') - continue; + else + { +#ifdef DEBUG + fprintf (stderr, "## unrecognised top-level form, %s (%s)\n", + buffer, filename); +#endif + continue; + } + /* At this point, there is a docstring that we should gobble. + The opening quote (and leading backslash-newline) have already + been read. + */ + putc ('\n', outfile); putc (037, outfile); - putc ('F', outfile); - fprintf (outfile, "%s\n", buf); + putc (type, outfile); + fprintf (outfile, "%s\n", buffer); read_c_string (infile, 1); } fclose (infile); diff --git a/src/eval.c b/src/eval.c index 572410e961..4d4ca7c584 100644 --- a/src/eval.c +++ b/src/eval.c @@ -743,6 +743,7 @@ definitions to shadow the loaded ones for use in file byte-compilation.") register Lisp_Object form; Lisp_Object env; { + /* With cleanups from Hallvard Furuseth. */ register Lisp_Object expander, sym, def, tem; while (1) @@ -751,42 +752,23 @@ definitions to shadow the loaded ones for use in file byte-compilation.") in case it expands into another macro call. */ if (XTYPE (form) != Lisp_Cons) break; - sym = XCONS (form)->car; - /* Detect ((macro lambda ...) ...) */ - if (XTYPE (sym) == Lisp_Cons - && EQ (XCONS (sym)->car, Qmacro)) - { - expander = XCONS (sym)->cdr; - goto explicit; - } - if (XTYPE (sym) != Lisp_Symbol) - break; + /* Set SYM, give DEF and TEM right values in case SYM is not a symbol. */ + def = sym = XCONS (form)->car; + tem = Qnil; /* Trace symbols aliases to other symbols until we get a symbol that is not an alias. */ - while (1) + while (XTYPE (def) == Lisp_Symbol) { QUIT; + sym = def; tem = Fassq (sym, env); if (NILP (tem)) { def = XSYMBOL (sym)->function; - if (XTYPE (def) == Lisp_Symbol && !EQ (def, Qunbound)) - sym = def; - else - break; - } - else - { -#if 0 /* This is turned off because it caused an element (foo . bar) - to have the effect of defining foo as an alias for the macro bar. - That is inconsistent; bar should be a function to expand foo. */ - if (XTYPE (tem) == Lisp_Cons - && XTYPE (XCONS (tem)->cdr) == Lisp_Symbol) - sym = XCONS (tem)->cdr; - else -#endif - break; + if (!EQ (def, Qunbound)) + continue; } + break; } /* Right now TEM is the result from SYM in ENV, and if TEM is nil then DEF is SYM's function definition. */ @@ -818,7 +800,6 @@ definitions to shadow the loaded ones for use in file byte-compilation.") if (NILP (expander)) break; } - explicit: form = apply1 (expander, XCONS (form)->cdr); } return form; -- 2.20.1