1 files changed, 39 insertions, 57 deletions

diff --git a/lisp/emacs-lisp/oclosure.el b/lisp/emacs-lisp/oclosure.el
index 4da8e61aaa7..165d7c4b6e8 100644
--- a/lisp/emacs-lisp/oclosure.el
+++ b/lisp/emacs-lisp/oclosure.el
@@ -146,7 +146,7 @@
 (setf (cl--find-class 'oclosure)
       (oclosure--class-make 'oclosure
                             "The root parent of all OClosure types"
-                            nil (list (cl--find-class 'function))
+                            nil (list (cl--find-class 'closure))
                             '(oclosure)))
 (defun oclosure--p (oclosure)
   (not (not (oclosure-type oclosure))))
@@ -431,75 +431,57 @@ ARGS and BODY are the same as for `lambda'."
 
 (defun oclosure--fix-type (_ignore oclosure)
   "Helper function to implement `oclosure-lambda' via a macro.
-This has 2 uses:
-- For interpreted code, this converts the representation of type information
-  by moving it from the docstring to the environment.
-- For compiled code, this is used as a marker which cconv uses to check that
-  immutable fields are indeed not mutated."
-  (if (byte-code-function-p oclosure)
-      ;; Actually, this should never happen since `cconv.el' should have
-      ;; optimized away the call to this function.
-      oclosure
-    ;; For byte-coded functions, we store the type as a symbol in the docstring
-    ;; slot.  For interpreted functions, there's no specific docstring slot
-    ;; so `Ffunction' turns the symbol into a string.
-    ;; We thus have convert it back into a symbol (via `intern') and then
-    ;; stuff it into the environment part of the closure with a special
-    ;; marker so we can distinguish this entry from actual variables.
-    (cl-assert (eq 'closure (car-safe oclosure)))
-    (let ((typename (nth 3 oclosure))) ;; The "docstring".
-      (cl-assert (stringp typename))
-      (push (cons :type (intern typename))
-            (cadr oclosure))
-      oclosure)))
+This is used as a marker which cconv uses to check that
+immutable fields are indeed not mutated."
+  (cl-assert (closurep oclosure))
+  ;; This should happen only for interpreted closures since `cconv.el'
+  ;; should have optimized away the call to this function.
+  oclosure)
 
 (defun oclosure--copy (oclosure mutlist &rest args)
+  (cl-assert (closurep oclosure))
   (if (byte-code-function-p oclosure)
       (apply #'make-closure oclosure
              (if (null mutlist)
                  args
                (mapcar (lambda (arg) (if (pop mutlist) (list arg) arg)) args)))
-    (cl-assert (eq 'closure (car-safe oclosure))
-               nil "oclosure not closure: %S" oclosure)
-    (cl-assert (eq :type (caar (cadr oclosure))))
-    (let ((env (cadr oclosure)))
-      `(closure
-           (,(car env)
-            ,@(named-let loop ((env (cdr env)) (args args))
-                (when args
-                  (cons (cons (caar env) (car args))
-                        (loop (cdr env) (cdr args)))))
-            ,@(nthcdr (1+ (length args)) env))
-           ,@(nthcdr 2 oclosure)))))
+    (cl-assert (consp (aref oclosure 1)))
+    (cl-assert (null (aref oclosure 3)))
+    (cl-assert (symbolp (aref oclosure 4)))
+    (let ((env (aref oclosure 2)))
+      (make-interpreted-closure
+       (aref oclosure 0)
+       (aref oclosure 1)
+       (named-let loop ((env env) (args args))
+         (if (null args) env
+           (cons (cons (caar env) (car args))
+                 (loop (cdr env) (cdr args)))))
+       (aref oclosure 4)
+       (if (> (length oclosure) 5)
+           `(interactive ,(aref oclosure 5)))))))
 
 (defun oclosure--get (oclosure index mutable)
-  (if (byte-code-function-p oclosure)
-      (let* ((csts (aref oclosure 2))
-             (v (aref csts index)))
-        (if mutable (car v) v))
-    (cl-assert (eq 'closure (car-safe oclosure)))
-    (cl-assert (eq :type (caar (cadr oclosure))))
-    (cdr (nth (1+ index) (cadr oclosure)))))
+  (cl-assert (closurep oclosure))
+  (let* ((csts (aref oclosure 2)))
+    (if (vectorp csts)
+        (let ((v (aref csts index)))
+          (if mutable (car v) v))
+      (cdr (nth index csts)))))
 
 (defun oclosure--set (v oclosure index)
-  (if (byte-code-function-p oclosure)
-      (let* ((csts (aref oclosure 2))
-             (cell (aref csts index)))
-        (setcar cell v))
-    (cl-assert (eq 'closure (car-safe oclosure)))
-    (cl-assert (eq :type (caar (cadr oclosure))))
-    (setcdr (nth (1+ index) (cadr oclosure)) v)))
+  (cl-assert (closurep oclosure))
+  (let ((csts (aref oclosure 2)))
+    (if (vectorp csts)
+        (let ((cell (aref csts index)))
+          (setcar cell v))
+      (setcdr (nth index csts) v))))
 
 (defun oclosure-type (oclosure)
-  "Return the type of OCLOSURE, or nil if the arg is not a OClosure."
-  (if (byte-code-function-p oclosure)
-      (let ((type (and (> (length oclosure) 4) (aref oclosure 4))))
-        (if (symbolp type) type))
-    (and (eq 'closure (car-safe oclosure))
-         (let* ((env (car-safe (cdr oclosure)))
-                (first-var (car-safe env)))
-           (and (eq :type (car-safe first-var))
-                (cdr first-var))))))
+  "Return the type of OCLOSURE, or nil if the arg is not an OClosure."
+  (and (closurep oclosure)
+       (> (length oclosure) 4)
+       (let ((type (aref oclosure 4)))
+         (if (symbolp type) type))))
 
 (defconst oclosure--accessor-prototype
   ;; Use `oclosure--lambda' to circumvent a bootstrapping problem: