From 7ecfc3ca6925d7140dbe8c6079e03f765eecfc4a Mon Sep 17 00:00:00 2001 From: =?utf8?q?Gerd=20M=C3=B6llmann?= Date: Thu, 13 Oct 2022 13:17:29 +0200 Subject: [PATCH] Can now pdump --- lisp/progmodes/compile.el | 2 +- src/.lldbinit | 6 + src/lread.c | 234 ++++++++++++++++++++------------------ src/pkg.c | 15 +++ 4 files changed, 145 insertions(+), 112 deletions(-) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index bfb5899318b..a0786cb7596 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -359,7 +359,7 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) 1 2 3 (nil . 4)) ;; PKG-FIXME - (|ruby-Test::Unit| + (ruby-Test::Unit "^ [[ ]?\\([^ (].*\\):\\([1-9][0-9]*\\)\\(\\]\\)?:in " 1 2) (gmake diff --git a/src/.lldbinit b/src/.lldbinit index 358cea5f8b6..1819dae95d3 100644 --- a/src/.lldbinit +++ b/src/.lldbinit @@ -30,4 +30,10 @@ script -- sys.path.append('../etc') # Load our Python files command script import emacs_lldb +# b xsignal +b pkg_break +b pkg_error +b Fpkg_read + + # end. diff --git a/src/lread.c b/src/lread.c index b812474a2c3..f847879ebc6 100644 --- a/src/lread.c +++ b/src/lread.c @@ -904,10 +904,13 @@ DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0, otherwise nothing is read. */ static bool -lisp_file_lexically_bound_p (Lisp_Object readcharfun) +lisp_file_lexically_bound_p (Lisp_Object readcharfun, bool *prefixes) { int ch = READCHAR; + /* We don't read package names as part of symbol_names by default. */ + *prefixes = false; + if (ch == '#') { ch = READCHAR; @@ -1012,12 +1015,11 @@ lisp_file_lexically_bound_p (Lisp_Object readcharfun) i--; val[i] = '\0'; - if (strcmp (var, "lexical-binding") == 0) - /* This is it... */ - { - rv = (strcmp (val, "nil") != 0); - break; - } + /* PKG-FIXME Do this more elegantly? */ + if (strcmp (var, "package-prefixes") == 0) + *prefixes = strcmp (val, "nil") == 0 ? false : true; + else if (strcmp (var, "lexical-binding") == 0) + rv = (strcmp (val, "nil") != 0); } } @@ -1575,8 +1577,11 @@ Return t if the file exists and loads successfully. */) } else { - if (lisp_file_lexically_bound_p (Qget_file_char)) + bool prefixes; + if (lisp_file_lexically_bound_p (Qget_file_char, &prefixes)) Fset (Qlexical_binding, Qt); + if (prefixes) + Fset (Qpackage_prefixes, Qt); if (! version || version >= 22) readevalloop (Qget_file_char, &input, hist_file_name, @@ -2406,7 +2411,9 @@ This function preserves the position of point. */) specbind (Qstandard_output, tem); record_unwind_protect_excursion (); BUF_TEMP_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf))); - specbind (Qlexical_binding, lisp_file_lexically_bound_p (buf) ? Qt : Qnil); + bool prefixes; + specbind (Qlexical_binding, lisp_file_lexically_bound_p (buf, &prefixes) ? Qt : Qnil); + specbind (Qpackage_prefixes, prefixes ? Qt : Qnil); BUF_TEMP_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf))); readevalloop (buf, 0, filename, !NILP (printflag), unibyte, Qnil, Qnil, Qnil); @@ -3702,6 +3709,34 @@ read_make_string (const char *s, ptrdiff_t nbytes, bool multibyte) return make_pure_string (s, nchars, nbytes, multibyte); } +static bool +is_symbol_constituent (int c) +{ + /* Symbols end at control characters like newlines or + tabs, or space of course. This if includes end of + input, where c < 0. */ + if (c <= ' ') + return false; + + /* Let symbols end at NO_BREAK_SPACE. */ + if (c == NO_BREAK_SPACE) + return false; + + /* Accept characters >= 128 as symbol constituents, like + unlauts and so on. */ + if (c >= 128) + return true; + + /* End reading when we reach a character that can not + be part of a symbol name, unless quoted. */ + if (c == '"' || c == '\'' || c == ';' || c == '#' + || c == '(' || c == ')' || c == '[' || c == ']' + || c == '`' || c == ',') + return false; + + return true; +} + /* Read a Lisp object. If LOCATE_SYMS is true, symbols are read with position. */ static Lisp_Object @@ -4134,6 +4169,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms) EMACS_INT start_position = readchar_offset - 1; /* PKG-FIXME: This is too complicated. */ + /* PKG-FIXME: Check package-prefixes binding working. */ /* Remember where package prefixes end in COLON, which will be set to the first colon we find. NCOLONS is the @@ -4141,64 +4177,46 @@ read0 (Lisp_Object readcharfun, bool locate_syms) char *colon = NULL; int ncolons = 0; - /* True means last character read was a backslash. */ + /* True if last character read was a backslash. */ bool last_was_backslash = false; - bool in_vertical_bar = false; + /* True if \ for escaping appeared. */ bool any_quoted = false; for (;;) { - if (c == ':' - // This is actually \: or |...: - && !last_was_backslash && !in_vertical_bar) + eassert (is_symbol_constituent (c) || last_was_backslash); + + /* Treat ':' as package prefix, unless someone says we + should't, or it is escaped by a preceding '\\' or + inside a multi-escape. Note that we don't land here + for #:. */ + if (c == ':' && !last_was_backslash && !NILP (Vpackage_prefixes)) { /* Remember where the first : is. */ if (colon == NULL) colon = p; ++ncolons; - if (!read_emacs_syntax) - { - /* #:xyz should not contain a colon unless in Emacs - original syntax. */ - if (uninterned_symbol) - invalid_syntax ("colon in uninterned symbol", readcharfun); - - /* Up to two colons are allowed if they are - consecutive. PKG-FIXME check consecutive :. */ - if (ncolons > 2) - invalid_syntax ("too many colons", readcharfun); - } + /* #:xyz should not contain a colon unless in Emacs + original syntax. */ + if (uninterned_symbol) + invalid_syntax ("colon in uninterned symbol", readcharfun); + + /* Up to two colons are allowed if they are + consecutive. PKG-FIXME check consecutive :. */ + if (ncolons > 2) + invalid_syntax ("too many colons", readcharfun); } - /* Handle unquote backslash and bar . */ - if (!last_was_backslash) + /* unescaped backslash. Remember that we have seen it. */ + if (c == '\\' && !last_was_backslash) { - /* Unquoted backslash: The first backslash is not part - of the symbol name. \\ gives a single \ in the - symbol. */ - if (c == '\\') - { - c = READCHAR; - if (c < 0) - end_of_file_error (); - last_was_backslash = true; - any_quoted = true; - continue; - } - - /* Unquoted vertical bar. Begin or end multi-escape, - unless in Emacs syntax. In either case, proceed - with next char, the bar is not part of the - name. */ - if (c == '|' && !read_emacs_syntax) - { - c = READCHAR; - if (c < 0) - end_of_file_error (); - in_vertical_bar = !in_vertical_bar; - continue; - } + any_quoted = true; + last_was_backslash = true; + c = READCHAR; + if (c < 0) + invalid_syntax ("eof in single-escape", readcharfun); + continue; } last_was_backslash = false; @@ -4228,52 +4246,38 @@ read0 (Lisp_Object readcharfun, bool locate_syms) /* Proceed with the next character. */ c = READCHAR; - /* If in |...| everything is quoted by default, except |. - An unquoted bar ends the symbol, and is not part of the - symbol. */ - if (in_vertical_bar) - { - eassert (!read_emacs_syntax); - if (c < 0) - end_of_file_error (); - if (c == '|') - { - c = READCHAR; - break; - } - } - else - { - /* Symbols end at control characters like newlines or - tabs, or space of course. This if includes end of - input, where c < 0. */ - if (c <= ' ') - break; - - /* Let symbols end at NO_BREAK_SPACE. */ - if (c == NO_BREAK_SPACE) - break; - - /* Accept characters >= 128 as symbol constituents, like - unlauts and so on. */ - if (c >= 128) - continue; - - /* End reading when we reach a character that can not - be part of a symbol name, unless quoted. */ - if (c == '"' || c == '\'' || c == ';' || c == '#' - || c == '(' || c == ')' || c == '[' || c == ']' - || c == '`' || c == ',') - break; - } + /* Symbols end at control characters like newlines or + tabs, or space of course. This if includes end of + input, where c < 0. */ + if (c <= ' ') + break; + + /* Let symbols end at NO_BREAK_SPACE. */ + if (c == NO_BREAK_SPACE) + break; + + /* Accept characters >= 128 as symbol constituents, like + unlauts and so on. */ + if (c >= 128) + continue; + + /* End reading when we reach a character that can not + be part of a symbol name, unless quoted. */ + if (c == '"' || c == '\'' || c == ';' || c == '#' + || c == '(' || c == ')' || c == '[' || c == ']' + || c == '`' || c == ',') + break; } + eassert (!is_symbol_constituent (c)); + /* c maybe -1 here, hut we can unread EOF. */ *p = 0; UNREAD (c); /* The start of the symbol, If a package prefix is present, - the start of the symbol-name part. */ - char *symbol_start; + set to the start of the symbol-name part later on. */ + char *symbol_start = read_buffer; + const char *symbol_end = p; /* Package for the package prefix, if there is one, or nil if there is none. */ @@ -4281,10 +4285,22 @@ read0 (Lisp_Object readcharfun, bool locate_syms) /* If a package prefix was found, determine the package it names. It is an error if a package of that name does not - exist, or ':' is used for an internal symbol. */ - if (colon) + exist, or ':' is used for an internal symbol. + + If we don't want to recognize ':' as a package indicator, + nevertheless handle keywords. */ + if (NILP (Vpackage_prefixes)) { - /* Package name is in read_buffer, colon + ncolons is the + if (*symbol_start == ':') + { + ++symbol_start; + package = Ffind_package (Qkeyword); + eassert (!NILP (package)); + } + } + else if (colon) + { + /* PACKAGE name is in read_buffer, colon + ncolons is the start of the symbol name. */ *colon = 0; @@ -4304,24 +4320,24 @@ read0 (Lisp_Object readcharfun, bool locate_syms) /* Symbol name starts after the package prefix. */ symbol_start = colon + ncolons; } - else - symbol_start = read_buffer; - const ptrdiff_t symbol_nbytes = p - symbol_start; - /* This could be a number after all. But not if empty, and not - if in |...|, and not if any quoted characters were found, - or a package prefix was found, or we have #:xyz. */ + /* This could be a number after all. But not if empty, and + not if anything was quoted. or a package prefix was found, + or we have #:xyz. */ + const ptrdiff_t symbol_nbytes = symbol_end - symbol_start; if (!any_quoted - && !in_vertical_bar - && !colon - && !uninterned_symbol) + && !uninterned_symbol + && NILP (package) + && symbol_end != symbol_start) { - char c0 = symbol_start[0]; + char c0 = *symbol_start; if (((c0 >= '0' && c0 <= '9') || c0 == '.' || c0 == '-' || c0 == '+') && !skip_shorthand) { ptrdiff_t len; - Lisp_Object result = string_to_number (read_buffer, 10, &len); + /* 10 as base because the other bases require a #, and + don't land here. */ + Lisp_Object result = string_to_number (symbol_start, 10, &len); if (!NILP (result) && len == symbol_nbytes) { obj = result; @@ -5599,10 +5615,6 @@ that are loaded before your customizations are read! */); doc: /* Non-nil means not to load a .eln file when a .elc was requested. */); load_no_native = false; - DEFVAR_BOOL ("read-emacs-syntax", read_emacs_syntax, - doc: /* Non-nil means don't treat ':' or '|' specially in symbols. */); - read_emacs_syntax = true; - /* Vsource_directory was initialized in init_lread. */ DEFSYM (Qcurrent_load_list, "current-load-list"); diff --git a/src/pkg.c b/src/pkg.c index 5a021ac39de..0b98b3801db 100644 --- a/src/pkg.c +++ b/src/pkg.c @@ -1076,6 +1076,13 @@ DEFUN ("unuse-package", Funuse_package, Sunuse_package, 1, 2, 0, return Qt; } +DEFUN ("pkg-read", Fpkg_read, Spkg_read, 1, 1, 0, + doc: /* tbd */) + (Lisp_Object stream) +{ + return Fread (stream); +} + /*********************************************************************** Initialization @@ -1167,6 +1174,7 @@ syms_of_pkg (void) defsubr (&Sunexport); defsubr (&Sunuse_package); defsubr (&Suse_package); + defsubr (&Spkg_read); DEFSYM (QCexternal, ":external"); DEFSYM (QCinherited, ":inherited"); @@ -1175,6 +1183,7 @@ syms_of_pkg (void) DEFSYM (QCuse, ":use"); DEFSYM (Qearmuffs_package, "*package*"); + DEFSYM (Qpackage_prefixes, "package-prefixes"); DEFSYM (Qemacs_package, "emacs-package"); DEFSYM (Qkeyword_package, "keyword-package"); DEFSYM (Qpackage_registry, "package-registry"); @@ -1199,6 +1208,12 @@ syms_of_pkg (void) Vearmuffs_package = Vemacs_package; XSYMBOL (Qearmuffs_package)->u.s.declared_special = true; + DEFSYM (Qpackage_prefixes, "package-prefixes"); + DEFVAR_LISP ("package-prefixes", Vpackage_prefixes, + doc: /* Whether to read package prefixes in symbol names. */); + Vpackage_prefixes = Qnil; + Fmake_variable_buffer_local (Qpackage_prefixes); + package_system_ready = true; fix_symbol_packages (); } -- 2.39.2