From: João Távora Date: Sat, 19 Sep 2020 21:16:38 +0000 (+0100) Subject: Move most of the shorthand implementation to C code X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=5811e055c0f46e0a2163027d26c54cde642d21c9;p=emacs.git Move most of the shorthand implementation to C code This very likely isn't the final form of the implementation. For one, the reader is much slower and allocates a Lisp string for every atom read, regardless if its already interned or not, which perhaps has the potential to be catastrophic in terms of GC. But it passes the tests. The solution to this, is probably to simplify the semantics of shorthand-shorthands. Instead of making it a regexp-to-longhand alist, make it just prefix-to-longhand. Then we wouldn't need to call Fstring_match in oblookup_considering_shorthand, meaning we wouldn't need a Lisp string there. * lisp/shorthand.el (shorthand-shorthands): Move to C code. (shorthand--expand-shorthand): Remove. (shorthand-read-wrapper): Remove. (shorthand-intern-soft-wrapper): Remove. (read, intern-soft): No longer advise. * src/lread.c: (read1, Fintern, Fintern_soft, Funintern): Use oblookup_considering_shorthand. (oblookup_considering_shorthand): New helper. (syms_of_lread): Declare shorthand-shorthands. --- diff --git a/lisp/shorthand.el b/lisp/shorthand.el index 54c34120390..f40af92e1c7 100644 --- a/lisp/shorthand.el +++ b/lisp/shorthand.el @@ -49,52 +49,10 @@ ;; that with the shorthands for other longer named symbols. ;;; Code: - (require 'cl-lib) -(defvar shorthand-shorthands nil) (put 'shorthand-shorthands 'safe-local-variable #'consp) -(defun shorthand--expand-shorthand (form) - (cl-typecase form - (cons (setcar form (shorthand--expand-shorthand (car form))) - (setcdr form (shorthand--expand-shorthand (cdr form)))) - (vector (cl-loop for i from 0 for e across form - do (aset form i (shorthand--expand-shorthand e)))) - (symbol (let* ((name (symbol-name form))) - (cl-loop for (short-pat . long-pat) in shorthand-shorthands - when (string-match short-pat name) - do (setq name (replace-match long-pat t nil name))) - (setq form (intern name)))) - (string) (number) - (t (message "[shorthand] unexpected %s" (type-of form)))) - form) - -(defun shorthand-read-wrapper (wrappee stream &rest stuff) - "Read a form from STREAM. -Do this in two steps, read the form while shadowing the global -`obarray' so that symbols aren't just automatically interned into -`obarray' as usual. Then walk the form using -`shorthand--expand-shorthand' and every time a symbol is found, -apply the transformations of `shorthand-shorthands' to it before -interning it the \"real\" global `obarray'. This ensures that -longhand, _not_ shorthand, versions of each symbol is interned." - (if (and load-file-name (string-match "\\.elc$" load-file-name)) - (apply wrappee stream stuff) - (shorthand--expand-shorthand - (let ((obarray (obarray-make))) (apply wrappee stream stuff))))) - -(defun shorthand-intern-soft-wrapper (wrappee name &rest stuff) - "Tell if string NAME names an interned symbol. -Even if NAME directly doesn't, its longhand expansion might." - (let ((res (apply wrappee name stuff))) - (or res (cl-loop - for (short-pat . long-pat) in shorthand-shorthands - thereis (apply wrappee - (replace-regexp-in-string short-pat - long-pat name) - stuff))))) - (defun shorthand-load-wrapper (wrappee file &rest stuff) "Load Elisp FILE, aware of file-local `shortand-shorthands'." (let (file-local-shorthands) @@ -106,8 +64,6 @@ Even if NAME directly doesn't, its longhand expansion might." (let ((shorthand-shorthands file-local-shorthands)) (apply wrappee file stuff)))) -(advice-add 'read :around #'shorthand-read-wrapper) -(advice-add 'intern-soft :around #'shorthand-intern-soft-wrapper) (advice-add 'load :around #'shorthand-load-wrapper) (provide 'shorthand) diff --git a/src/lread.c b/src/lread.c index 2abe2fd91ab..f7d0a8c5ea9 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2956,6 +2956,7 @@ read_integer (Lisp_Object readcharfun, int radix, return unbind_to (count, string_to_number (read_buffer, radix, NULL)); } +Lisp_Object oblookup_considering_shorthand (Lisp_Object, Lisp_Object*); /* If the next token is ')' or ']' or '.', we store that character in *PCH and the return value is not interesting. Else, we store @@ -3781,23 +3782,17 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) } else { - /* Don't create the string object for the name unless - we're going to retain it in a new symbol. - - Like intern_1 but supports multibyte names. */ + /* Like intern_1 but supports multibyte names. */ Lisp_Object obarray = check_obarray (Vobarray); - Lisp_Object tem = oblookup (obarray, read_buffer, - nchars, nbytes); + Lisp_Object name + = make_specified_string (read_buffer, nchars, nbytes, + multibyte); + Lisp_Object tem = oblookup_considering_shorthand (obarray, &name); if (SYMBOLP (tem)) result = tem; else - { - Lisp_Object name - = make_specified_string (read_buffer, nchars, nbytes, - multibyte); - result = intern_driver (name, obarray, tem); - } + result = intern_driver (name, obarray, tem); } if (EQ (Vread_with_symbol_positions, Qt) @@ -4407,7 +4402,7 @@ it defaults to the value of `obarray'. */) obarray = check_obarray (NILP (obarray) ? Vobarray : obarray); CHECK_STRING (string); - tem = oblookup (obarray, SSDATA (string), SCHARS (string), SBYTES (string)); + tem = oblookup_considering_shorthand (obarray, &string); if (!SYMBOLP (tem)) tem = intern_driver (NILP (Vpurify_flag) ? string : Fpurecopy (string), obarray, tem); @@ -4422,7 +4417,8 @@ A second optional argument specifies the obarray to use; it defaults to the value of `obarray'. */) (Lisp_Object name, Lisp_Object obarray) { - register Lisp_Object tem, string; + register Lisp_Object tem; + Lisp_Object string; if (NILP (obarray)) obarray = Vobarray; obarray = check_obarray (obarray); @@ -4435,7 +4431,7 @@ it defaults to the value of `obarray'. */) else string = SYMBOL_NAME (name); - tem = oblookup (obarray, SSDATA (string), SCHARS (string), SBYTES (string)); + tem = oblookup_considering_shorthand (obarray, &string); if (FIXNUMP (tem) || (SYMBOLP (name) && !EQ (name, tem))) return Qnil; else @@ -4451,7 +4447,8 @@ OBARRAY, if nil, defaults to the value of the variable `obarray'. usage: (unintern NAME OBARRAY) */) (Lisp_Object name, Lisp_Object obarray) { - register Lisp_Object string, tem; + register Lisp_Object tem; + Lisp_Object string; size_t hash; if (NILP (obarray)) obarray = Vobarray; @@ -4465,9 +4462,7 @@ usage: (unintern NAME OBARRAY) */) string = name; } - tem = oblookup (obarray, SSDATA (string), - SCHARS (string), - SBYTES (string)); + tem = oblookup_considering_shorthand (obarray, &string); if (FIXNUMP (tem)) return Qnil; /* If arg was a symbol, don't delete anything but that symbol itself. */ @@ -4554,6 +4549,26 @@ oblookup (Lisp_Object obarray, register const char *ptr, ptrdiff_t size, ptrdiff XSETINT (tem, hash); return tem; } + +Lisp_Object +oblookup_considering_shorthand (Lisp_Object obarray, Lisp_Object* string) +{ + Lisp_Object tail = Vshorthand_shorthands; + FOR_EACH_TAIL_SAFE(tail) + { + Lisp_Object pair = XCAR (tail); + Lisp_Object shorthand = XCAR (pair); + Lisp_Object longhand = XCDR (pair); + CHECK_STRING (shorthand); + CHECK_STRING (longhand); + Lisp_Object match = Fstring_match(shorthand, *string, Qnil); + if (!NILP(match)){ + *string = Freplace_match(longhand, Qnil, Qnil, *string, Qnil); + } + } + return oblookup(obarray, SSDATA (*string), SCHARS (*string), SBYTES (*string)); +} + void map_obarray (Lisp_Object obarray, void (*fn) (Lisp_Object, Lisp_Object), Lisp_Object arg) @@ -5310,4 +5325,9 @@ that are loaded before your customizations are read! */); DEFSYM (Qrehash_threshold, "rehash-threshold"); DEFSYM (Qchar_from_name, "char-from-name"); + + DEFVAR_LISP ("shorthand-shorthands", Vshorthand_shorthands, + doc: /* Alist of known symbol name shorthands*/); + Vshorthand_shorthands = Qnil; + DEFSYM (Qshorthand_shorthands, "shorthand-shorthands"); }