Add OClosures, a cross between functions and structs

We here just add the new type.  It is not fully self-contained.
It requires cooperation from `cconv.el` on the one hand, and it
hijacks the docstring info to hold the type of OClosure objects.
This does imply that OClosures can't have docstrings, tho this
limitation will be lifted in subsequent patches.

* lisp/emacs-lisp/oclosure.el: New file.
* test/lisp/emacs-lisp/oclosure-tests.el: New file.
* doc/lispref/functions.texi (OClosures): New section.

* src/eval.c (Ffunction): Accept symbols instead of strings for docstrings.
* src/doc.c (store_function_docstring): Avoid overwriting an OClosure type.
* lisp/emacs-lisp/cconv.el (cconv--convert-function): Tweak ordering of
captured variables.
(cconv-convert): Add case for `oclosure--fix-type`.

1 files changed, 113 insertions, 0 deletions

diff --git a/test/lisp/emacs-lisp/oclosure-tests.el b/test/lisp/emacs-lisp/oclosure-tests.el
new file mode 100644
index 00000000000..e7e76fa4bda
--- /dev/null
+++ b/test/lisp/emacs-lisp/oclosure-tests.el
@@ -0,0 +1,113 @@
+;;; oclosure-tests.e; --- Tests for Open Closures  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021-2022  Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'oclosure)
+(require 'cl-lib)
+
+(oclosure-define (oclosure-test
+                  (:copier oclosure-test-copy)
+                  (:copier oclosure-test-copy1 (fst)))
+  "Simple OClosure."
+  fst snd name)
+
+(ert-deftest oclosure-test ()
+  (let* ((i 42)
+         (ocl1 (oclosure-lambda (oclosure-test (fst 1) (snd 2) (name "hi"))
+                   ()
+                 (list fst snd i)))
+         (ocl2 (oclosure-lambda (oclosure-test (name (cl-incf i)) (fst (cl-incf i)))
+                   ()
+                 (list fst snd 152 i))))
+    (should (equal (list (oclosure-test--fst ocl1)
+                         (oclosure-test--snd ocl1)
+                         (oclosure-test--name ocl1))
+                   '(1 2 "hi")))
+    (should (equal (list (oclosure-test--fst ocl2)
+                         (oclosure-test--snd ocl2)
+                         (oclosure-test--name ocl2))
+                   '(44 nil 43)))
+    (should (equal (funcall ocl1) '(1 2 44)))
+    (should (equal (funcall ocl2) '(44 nil 152 44)))
+    (should (equal (funcall (oclosure-test-copy ocl1 :fst 7)) '(7 2 44)))
+    (should (equal (funcall (oclosure-test-copy1 ocl1 9)) '(9 2 44)))
+    (should (cl-typep ocl1 'oclosure-test))
+    (should (cl-typep ocl1 'oclosure))
+    ))
+
+(ert-deftest oclosure-test-limits ()
+  (should
+   (condition-case err
+       (let ((lexical-binding t)
+             (byte-compile-debug t))
+         (byte-compile '(lambda ()
+                          (let ((inc-fst nil))
+                            (oclosure-lambda (oclosure-test (fst 'foo)) ()
+                              (setq inc-fst (lambda () (setq fst (1+ fst))))
+                              fst))))
+         nil)
+     (error
+      (and (eq 'error (car err))
+           (string-match "fst.*mutated" (cadr err))))))
+  (should
+   (condition-case err
+       (progn (macroexpand-all '(oclosure-define oclosure--foo a a))
+              nil)
+     (error
+      (and (eq 'error (car err))
+           (string-match "Duplicate slot name: a$" (cadr err))))))
+  (should
+   (condition-case err
+       (progn (macroexpand-all
+               '(oclosure-define (oclosure--foo (:parent oclosure-test)) fst))
+              nil)
+     (error
+      (and (eq 'error (car err))
+           (string-match "Duplicate slot name: fst$" (cadr err))))))
+  (should
+   (condition-case err
+       (progn (macroexpand '(oclosure-lambda (oclosure-test (fst 1) (fst 2))
+                                () fst))
+              nil)
+     (error
+      (and (eq 'error (car err))
+           (string-match "Duplicate slot: fst$" (cadr err)))))))
+
+(oclosure-define (oclosure-test-mut
+                  (:parent oclosure-test)
+                  (:copier oclosure-test-mut-copy))
+  "Simple OClosure with a mutable field."
+  (mut :mutable t))
+
+(ert-deftest oclosure-test-mutate ()
+  (let* ((f (oclosure-lambda (oclosure-test-mut (fst 0) (mut 3))
+                (x)
+              (+ x fst mut)))
+         (f2 (oclosure-test-mut-copy f :fst 50)))
+    (should (equal (oclosure-test-mut--mut f) 3))
+    (should (equal (funcall f 5) 8))
+    (should (equal (funcall f2 5) 58))
+    (cl-incf (oclosure-test-mut--mut f) 7)
+    (should (equal (oclosure-test-mut--mut f) 10))
+    (should (equal (funcall f 5) 15))
+    (should (equal (funcall f2 15) 68))))
+
+;;; oclosure-tests.el ends here.