From e7cd4e4053af9872840f04e7a36c5f11aa81648b Mon Sep 17 00:00:00 2001 From: Brian Leung Date: Thu, 25 May 2023 05:01:39 -0700 Subject: Work around https://lists.gnu.org/archive/html/bug-gnu-emacs/2023-05/msg01512.html --- overlays/emacs.nix | 4 + overlays/nativecomp-revert.patch | 294 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 298 insertions(+) create mode 100644 overlays/nativecomp-revert.patch diff --git a/overlays/emacs.nix b/overlays/emacs.nix index 79353f1776ad..6bcc92f66289 100644 --- a/overlays/emacs.nix +++ b/overlays/emacs.nix @@ -146,6 +146,8 @@ 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 ]; } ); @@ -154,6 +156,8 @@ 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 new file mode 100644 index 000000000000..087f73547a4f --- /dev/null +++ b/overlays/nativecomp-revert.patch @@ -0,0 +1,294 @@ +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