From f6f7f8ef79ab84f6585a7d6ee7b8cb65719f4f1f Mon Sep 17 00:00:00 2001 From: Brian Leung Date: Mon, 29 May 2023 00:12:01 -0700 Subject: Revert "Work around https://lists.gnu.org/archive/html/bug-gnu-emacs/2023-05/msg01512.html" This reverts commit e7cd4e4053af9872840f04e7a36c5f11aa81648b. Upstream is attempting to work around the issue we encountered, so we revert to avoid conflicts. --- overlays/emacs.nix | 4 - overlays/nativecomp-revert.patch | 294 --------------------------------------- 2 files changed, 298 deletions(-) delete mode 100644 overlays/nativecomp-revert.patch (limited to 'overlays') diff --git a/overlays/emacs.nix b/overlays/emacs.nix index 6bcc92f66289..79353f1776ad 100644 --- a/overlays/emacs.nix +++ b/overlays/emacs.nix @@ -146,8 +146,6 @@ let patches = oa.patches ++ [ # XXX: #318 ./bytecomp-revert.patch - # XXX: https://lists.gnu.org/archive/html/bug-gnu-emacs/2023-05/msg01512.html - ./nativecomp-revert.patch ]; } ); @@ -156,8 +154,6 @@ let patches = oa.patches ++ [ # XXX: #318 ./bytecomp-revert.patch - # XXX: https://lists.gnu.org/archive/html/bug-gnu-emacs/2023-05/msg01512.html - ./nativecomp-revert.patch ]; } ); diff --git a/overlays/nativecomp-revert.patch b/overlays/nativecomp-revert.patch deleted file mode 100644 index 087f73547a4f..000000000000 --- a/overlays/nativecomp-revert.patch +++ /dev/null @@ -1,294 +0,0 @@ -diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el -index 0b09cd7d225..8fdafe18c50 100644 ---- a/lisp/emacs-lisp/cl-macs.el -+++ b/lisp/emacs-lisp/cl-macs.el -@@ -3093,16 +3093,13 @@ cl-defstruct - (cons 'and (cdddr pred-form)) - `(,predicate cl-x)))) - (when pred-form -- (push `(eval-and-compile -- ;; Define the predicate to be effective at compile time -- ;; as native comp relies on `cl-typep' that relies on -- ;; predicates to be defined as they are registered in -- ;; cl-deftype-satisfies. -- (,defsym ,predicate (cl-x) -+ (push `(,defsym ,predicate (cl-x) - (declare (side-effect-free error-free) (pure t)) - ,(if (eq (car pred-form) 'and) - (append pred-form '(t)) - `(and ,pred-form t))) -+ forms) -+ (push `(eval-and-compile - (define-symbol-prop ',name 'cl-deftype-satisfies ',predicate)) - forms)) - (let ((pos 0) (descp descs)) -@@ -3252,7 +3249,6 @@ cl-defstruct - - ;;; Add cl-struct support to pcase - --;;In use by comp.el - (defun cl--struct-all-parents (class) - (when (cl--struct-class-p class) - (let ((res ()) -diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el -index f410270d340..5235be52996 100644 ---- a/lisp/emacs-lisp/cl-preloaded.el -+++ b/lisp/emacs-lisp/cl-preloaded.el -@@ -113,7 +113,6 @@ cl-struct-cl-structure-object-tags - (record 'cl-slot-descriptor - name initform type props))) - --;; In use by comp.el - (defun cl--struct-get-class (name) - (or (if (not (symbolp name)) name) - (cl--find-class name) -diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el -index e9132552506..d4200c16c19 100644 ---- a/lisp/emacs-lisp/comp-cstr.el -+++ b/lisp/emacs-lisp/comp-cstr.el -@@ -86,35 +86,7 @@ comp-cstr-f - (ret nil :type (or comp-cstr comp-cstr-f) - :documentation "Returned value.")) - --(defun comp--cl-class-hierarchy (x) -- "Given a class name `x' return its hierarchy." -- `(,@(mapcar #'cl--struct-class-name (cl--struct-all-parents -- (cl--struct-get-class x))) -- atom -- t)) -- --(defun comp--all-classes () -- "Return all non built-in type names currently defined." -- (let (res) -- (mapatoms (lambda (x) -- (when (cl-find-class x) -- (push x res))) -- obarray) -- res)) -- - (cl-defstruct comp-cstr-ctxt -- (typeof-types (append comp--typeof-builtin-types -- (mapcar #'comp--cl-class-hierarchy (comp--all-classes))) -- :type list -- :documentation "Type hierarchy.") -- (pred-type-h (cl-loop with h = (make-hash-table :test #'eq) -- for class-name in (comp--all-classes) -- for pred = (get class-name 'cl-deftype-satisfies) -- when pred -- do (puthash pred class-name h) -- finally return h) -- :type hash-table -- :documentation "Hash pred -> type.") - (union-typesets-mem (make-hash-table :test #'equal) :type hash-table - :documentation "Serve memoization for - `comp-union-typesets'.") -@@ -258,7 +230,7 @@ comp-supertypes - (cl-loop - named outer - with found = nil -- for l in (comp-cstr-ctxt-typeof-types comp-ctxt) -+ for l in comp--typeof-builtin-types - do (cl-loop - for x in l - for i from (length l) downto 0 -@@ -301,7 +273,7 @@ comp-union-typesets - (cl-loop - with types = (apply #'append typesets) - with res = '() -- for lane in (comp-cstr-ctxt-typeof-types comp-ctxt) -+ for lane in comp--typeof-builtin-types - do (cl-loop - with last = nil - for x in lane -@@ -895,23 +867,6 @@ comp-cstr-cons-p - (null (neg cstr)) - (equal (typeset cstr) '(cons))))) - --;; Move to comp.el? --(defsubst comp-cstr-cl-tag-p (cstr) -- "Return non-nil if CSTR is a CL tag." -- (with-comp-cstr-accessors -- (and (null (range cstr)) -- (null (neg cstr)) -- (null (typeset cstr)) -- (length= (valset cstr) 1) -- (string-match (rx "cl-struct-" (group-n 1 (1+ not-newline)) "-tags") -- (symbol-name (car (valset cstr))))))) -- --(defsubst comp-cstr-cl-tag (cstr) -- "If CSTR is a CL tag return its tag name." -- (with-comp-cstr-accessors -- (and (comp-cstr-cl-tag-p cstr) -- (intern (match-string 1 (symbol-name (car (valset cstr)))))))) -- - (defun comp-cstr-= (dst op1 op2) - "Constraint OP1 being = OP2 setting the result into DST." - (with-comp-cstr-accessors -diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el -index 8e59c06d40e..2e07b0b0e60 100644 ---- a/lisp/emacs-lisp/comp.el -+++ b/lisp/emacs-lisp/comp.el -@@ -641,14 +641,11 @@ comp-known-predicates-h - - (defun comp-known-predicate-p (predicate) - "Return t if PREDICATE is known." -- (when (or (gethash predicate comp-known-predicates-h) -- (gethash predicate (comp-cstr-ctxt-pred-type-h comp-ctxt))) -- t)) -+ (when (gethash predicate comp-known-predicates-h) t)) - - (defun comp-pred-to-cstr (predicate) - "Given PREDICATE, return the corresponding constraint." -- (or (gethash predicate comp-known-predicates-h) -- (gethash predicate (comp-cstr-ctxt-pred-type-h comp-ctxt)))) -+ (gethash predicate comp-known-predicates-h)) - - (defconst comp-symbol-values-optimizable '(most-positive-fixnum - most-negative-fixnum) -@@ -1543,7 +1540,7 @@ comp-callref - for sp from stack-off - collect (comp-slot-n sp)))) - --(cl-defun make-comp-mvar (&key slot (constant nil const-vld) type neg) -+(cl-defun make-comp-mvar (&key slot (constant nil const-vld) type) - "`comp-mvar' initializer." - (let ((mvar (make--comp-mvar :slot slot))) - (when const-vld -@@ -1551,8 +1548,6 @@ make-comp-mvar - (setf (comp-cstr-imm mvar) constant)) - (when type - (setf (comp-mvar-typeset mvar) (list type))) -- (when neg -- (setf (comp-mvar-neg mvar) t)) - mvar)) - - (defun comp-new-frame (size vsize &optional ssa) -@@ -2548,19 +2543,6 @@ comp-add-cond-cstrs - for insns-seq on (comp-block-insns b) - do - (pcase insns-seq -- (`((set ,(and (pred comp-mvar-p) mvar-tested-copy) -- ,(and (pred comp-mvar-p) mvar-tested)) -- (set ,(and (pred comp-mvar-p) mvar-1) -- (call type-of ,(and (pred comp-mvar-p) mvar-tested-copy))) -- (set ,(and (pred comp-mvar-p) mvar-2) -- (call symbol-value ,(and (pred comp-cstr-cl-tag-p) mvar-tag))) -- (set ,(and (pred comp-mvar-p) mvar-3) -- (call memq ,(and (pred comp-mvar-p) mvar-1) ,(and (pred comp-mvar-p) mvar-2))) -- (cond-jump ,(and (pred comp-mvar-p) mvar-3) ,(pred comp-mvar-p) ,bb1 ,bb2)) -- (push `(assume ,mvar-tested ,(make-comp-mvar :type (comp-cstr-cl-tag mvar-tag))) -- (comp-block-insns (comp-add-cond-cstrs-target-block b bb2))) -- (push `(assume ,mvar-tested ,(make-comp-mvar :type (comp-cstr-cl-tag mvar-tag) :neg t)) -- (comp-block-insns (comp-add-cond-cstrs-target-block b bb1)))) - (`((set ,(and (pred comp-mvar-p) cmp-res) - (,(pred comp-call-op-p) - ,(and (or (pred comp-equality-fun-p) -@@ -3216,11 +3198,7 @@ comp-fwprop-call - (+ (comp-cstr-add lval args)) - (- (comp-cstr-sub lval args)) - (1+ (comp-cstr-add lval `(,(car args) ,comp-cstr-one))) -- (1- (comp-cstr-sub lval `(,(car args) ,comp-cstr-one))) -- (record (when (comp-cstr-imm-vld-p (car args)) -- (comp-cstr-shallow-copy lval -- (comp-type-spec-to-cstr -- (comp-cstr-imm (car args))))))))) -+ (1- (comp-cstr-sub lval `(,(car args) ,comp-cstr-one)))))) - - (defun comp-fwprop-insn (insn) - "Propagate within INSN." -diff --git a/lisp/loadup.el b/lisp/loadup.el -index 532d2ca176d..1cc70348267 100644 ---- a/lisp/loadup.el -+++ b/lisp/loadup.el -@@ -103,7 +103,7 @@ - ;; During bootstrapping the byte-compiler is run interpreted - ;; when compiling itself, which uses a lot more stack - ;; than usual. -- (setq max-lisp-eval-depth (max max-lisp-eval-depth 3400)))) -+ (setq max-lisp-eval-depth 2200))) - - (if (eq t purify-flag) - ;; Hash consing saved around 11% of pure space in my tests. -diff --git a/test/src/comp-resources/comp-test-funcs.el b/test/src/comp-resources/comp-test-funcs.el -index d8c72c1a920..73da7182a54 100644 ---- a/test/src/comp-resources/comp-test-funcs.el -+++ b/test/src/comp-resources/comp-test-funcs.el -@@ -23,8 +23,6 @@ - - ;;; Code: - --(require 'cl-lib) -- - (defvar comp-tests-var1 3) - - (defun comp-tests-varref-f () -@@ -532,12 +530,6 @@ comp-test-62537-2-f - (comp-test-62537-1-f)) - t) - --(cl-defstruct comp-test-struct) -- --(defun comp-test-63674-1-f (x) -- (or -- (if (comp-test-struct-p pkg) x) -- t)) - - - ;;;;;;;;;;;;;;;;;;;; -diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el -index 673a9342f1f..4682cac450e 100644 ---- a/test/src/comp-tests.el -+++ b/test/src/comp-tests.el -@@ -875,8 +875,6 @@ comp-tests-check-ret-type-spec - ret-type)))) - - (cl-eval-when (compile eval load) -- (cl-defstruct comp-foo a b) -- (cl-defstruct (comp-bar (:include comp-foo)) c) - (defconst comp-tests-type-spec-tests - ;; Why we quote everything here, you ask? So that values of - ;; `most-positive-fixnum' and `most-negative-fixnum', which can be -@@ -1406,39 +1404,7 @@ comp-tests-check-ret-type-spec - (if (eq x 0) - (error "") - (1+ x))) -- 'number) -- -- ;; 75 -- ((defun comp-tests-ret-type-spec-f () -- (make-comp-foo)) -- 'comp-foo) -- -- ;; 76 -- ((defun comp-tests-ret-type-spec-f () -- (make-comp-bar)) -- 'comp-bar) -- -- ;; 77 -- ((defun comp-tests-ret-type-spec-f (x) -- (setf (comp-foo-a x) 2) -- x) -- 'comp-foo) -- -- ;; 78 -- ((defun comp-tests-ret-type-spec-f (x) -- (if x -- (if (> x 11) -- x -- (make-comp-foo)) -- (make-comp-bar))) -- '(or comp-foo float (integer 12 *))) -- -- ;; 79 -- ((defun comp-tests-ret-type-spec-f (x) -- (if (comp-foo-p x) -- x -- (error ""))) -- 'comp-foo))) -+ 'number))) - - (defun comp-tests-define-type-spec-test (number x) - `(comp-deftest ,(intern (format "ret-type-spec-%d" number)) () --- -2.40.1 - -- cgit 1.4.1