1 files changed, 562 insertions, 0 deletions
diff --git a/lisp/emacs-lisp/oclosure.el b/lisp/emacs-lisp/oclosure.el
new file mode 100644
index 00000000000..9775e8cc656
--- /dev/null
+++ b/lisp/emacs-lisp/oclosure.el
@@ -0,0 +1,562 @@
+;;; oclosure.el --- Open Closures       -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021-2022  Free Software Foundation, Inc.
+
+;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
+
+;; This program 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.
+
+;; This program 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 this program.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; An OClosure is an object that combines the properties of records
+;; with those of a function.  More specifically it is a function extended
+;; with a notion of type (e.g. for defmethod dispatch) as well as the
+;; ability to have some fields that are accessible from the outside.
+
+;; See "Open closures", ELS'2022 (https://zenodo.org/record/6228797).
+
+;; Here are some cases of "callable objects" where OClosures have found use:
+;; - nadvice.el (the original motivation)
+;; - kmacros (for cl-print and for `kmacro-extract-lambda')
+;; - cl-generic: turn `cl--generic-isnot-nnm-p' into a mere type test
+;;   (by putting the no-next-methods into their own class).
+;; - Slot accessor functions, where the type-dispatch can be used to
+;;   dynamically compute the docstring, and also to pretty print them.
+;; - `save-some-buffers-function'
+;; Here are other cases of "callable objects" where OClosures could be used:
+;; - Use the type to distinguish macros from functions.
+;; - Use a `name' and `depth' property from the function passed to
+;;   `add-function' (or `add-hook') instead of passing it via "props".
+;; - iterators (generator.el), thunks (thunk.el), streams (stream.el).
+;; - PEG rules: they're currently just functions, but they should carry
+;;   their original (macro-expanded) definition (and should be printed
+;;   differently from functions)!
+;; - auto-generate docstrings for cl-defstruct slot accessors instead of
+;;   storing them in the accessor itself?
+;; - SRFI-17's `setter'.
+;; - coercion wrappers, as in "Threesomes, with and without blame"
+;;   https://dl.acm.org/doi/10.1145/1706299.1706342, or
+;;   "On the Runtime Complexity of Type-Directed Unboxing"
+;;   http://sv.c.titech.ac.jp/minamide/papers.html
+;; - An efficient `negate' operation such that
+;;   (negate (negate f)) returns just `f' and (negate #'<) returns #'>=.
+;; - Autoloads (tho currently our bytecode functions (and hence OClosures)
+;;   are too fat for that).
+
+;; Related constructs:
+;; - `funcallable-standard-object' (FSO) in Common-Lisp.  These are different
+;;   from OClosures in that they involve an additional indirection to get
+;;   to the actual code, and that they offer the possibility of
+;;   changing (via mutation) the code associated with
+;;   an FSO.  Also the FSO's function can't directly access the FSO's
+;;   other fields, contrary to the case with OClosures where those are directly
+;;   available as local variables.
+;; - Function objects in Javascript.
+;; - Function objects in Python.
+;; - Callable/Applicable classes in OO languages, i.e. classes with
+;;   a single method called `apply' or `call'.  The most obvious
+;;   difference with OClosures (beside the fact that Callable can be
+;;   extended with additional methods) is that all instances of
+;;   a given Callable class have to use the same method, whereas every
+;;   OClosure object comes with its own code, so two OClosure objects of the
+;;   same type can have different code.  Of course, you can get the
+;;   same result by turning every `oclosure-lambda' into its own class
+;;   declaration creating an ad-hoc subclass of the specified type.
+;;   In this sense, OClosures are just a generalization of `lambda' which brings
+;;   some of the extra feature of Callable objects.
+;; - Apply hooks and "entities" in MIT Scheme
+;;   https://www.gnu.org/software/mit-scheme/documentation/stable/mit-scheme-ref/Application-Hooks.html
+;;   Apply hooks are basically the same as Common-Lisp's FSOs, and "entities"
+;;   are a variant of it where the inner function gets the FSO itself as
+;;   additional argument (a kind of "self" arg), thus making it easier
+;;   for the code to get data from the object's extra info, tho still
+;;   not as easy as with OClosures.
+;; - "entities" in Lisp Machine Lisp (LML)
+;;   https://hanshuebner.github.io/lmman/fd-clo.xml
+;;   These are arguably identical to OClosures, modulo the fact that LML doesn't
+;;   have lexically-scoped closures and uses a form of closures based on
+;;   capturing (and reinstating) dynamically scoped bindings instead.
+
+;; Naming: OClosures were originally named FunCallableRecords (FCR), but
+;; that name suggested these were fundamentally records that happened
+;; to be called, whereas OClosures are really just closures that happen
+;; to enjoy some characteristics of records.
+;; The "O" comes from "Open" because OClosures aren't completely opaque
+;; (for that same reason, an alternative name suggested at the time was
+;; "disclosures").
+;; The "O" can also be understood to mean "Object" since you have notions
+;; of inheritance, and the ability to associate methods with particular
+;; OClosure types, just as is the case for OO classes.
+
+;;; Code:
+
+;; TODO:
+;; - `oclosure-(cl-)defun', `oclosure-(cl-)defsubst', `oclosure-define-inline'?
+;; - Use accessor in cl-defstruct.
+;; - Add pcase patterns for OClosures.
+;; - anonymous OClosure types.
+;; - copiers for mixins
+;; - class-allocated slots?
+;; - code-allocated slots?
+;;   The `where' slot of `advice' would like to be code-allocated, and the
+;;   interactive-spec of commands is currently code-allocated but would like
+;;   to be instance-allocated.  Their scoping rules are a bit odd, so maybe
+;;   it's best to avoid them.
+
+(eval-when-compile (require 'cl-lib))
+(eval-when-compile (require 'subr-x))   ;For `named-let'.
+
+(defun oclosure--index-table (slotdescs)
+  (let ((i -1)
+        (it (make-hash-table :test #'eq)))
+    (dolist (desc slotdescs)
+      (let* ((slot (cl--slot-descriptor-name desc)))
+        (cl-incf i)
+        (when (gethash slot it)
+          (error "Duplicate slot name: %S" slot))
+        (setf (gethash slot it) i)))
+    it))
+
+(cl-defstruct (oclosure--class
+               (:constructor nil)
+               (:constructor oclosure--class-make
+                ( name docstring slots parents allparents
+                  &aux (index-table (oclosure--index-table slots))))
+               (:include cl--class)
+               (:copier nil))
+  "Metaclass for OClosure classes."
+  (allparents nil :read-only t :type (list-of symbol)))
+
+(setf (cl--find-class 'oclosure)
+      (oclosure--class-make 'oclosure
+                            "The root parent of all OClosure classes"
+                            nil nil '(oclosure)))
+(defun oclosure--p (oclosure)
+  (not (not (oclosure-type oclosure))))
+
+(cl-deftype oclosure () '(satisfies oclosure--p))
+
+(defun oclosure--slot-mutable-p (slotdesc)
+  (not (alist-get :read-only (cl--slot-descriptor-props slotdesc))))
+
+(defun oclosure--defstruct-make-copiers (copiers slotdescs name)
+  (require 'cl-macs)            ;`cl--arglist-args' is not autoloaded.
+  (let* ((mutables '())
+         (slots (mapcar
+                 (lambda (desc)
+	           (let ((name (cl--slot-descriptor-name desc)))
+	             (when (oclosure--slot-mutable-p desc)
+	               (push name mutables))
+	             name))
+	         slotdescs)))
+    (mapcar
+     (lambda (copier)
+       (pcase-let*
+           ((cname (pop copier))
+            (args (or (pop copier) `(&key ,@slots)))
+            (inline (and (eq :inline (car copier)) (pop copier)))
+            (doc (or (pop copier)
+                     (format "Copier for objects of type `%s'." name)))
+            (obj (make-symbol "obj"))
+            (absent (make-symbol "absent"))
+            (anames (cl--arglist-args args))
+            (mnames
+             (let ((res '())
+                   (tmp args))
+               (while (and tmp
+                           (not (memq (car tmp)
+                                      cl--lambda-list-keywords)))
+                 (push (pop tmp) res))
+               res))
+            (index -1)
+            (mutlist '())
+            (argvals
+             (mapcar
+	      (lambda (slot)
+	        (setq index (1+ index))
+	        (let* ((mutable (memq slot mutables))
+	               (get `(oclosure--get ,obj ,index ,(not (not mutable)))))
+	          (push mutable mutlist)
+		  (cond
+		   ((not (memq slot anames)) get)
+		   ((memq slot mnames) slot)
+		   (t
+		    `(if (eq ',absent ,slot)
+		         ,get
+		       ,slot)))))
+	      slots)))
+	 `(,(if inline 'cl-defsubst 'cl-defun) ,cname
+               (&cl-defs (',absent) ,obj ,@args)
+            ,doc
+            (declare (side-effect-free t))
+            (oclosure--copy ,obj ',(if (remq nil mutlist) (nreverse mutlist))
+                       ,@argvals))))
+     copiers)))
+
+
+(defmacro oclosure-define (name &optional docstring &rest slots)
+  "Define a new OClosure type.
+NAME should be a symbol which is the name of the new type.
+It can also be of the form (NAME . PROPS) in which case PROPS
+is a list of additional properties among the following:
+  (:predicate PRED): asks to create a predicate function named PRED.
+  (:parent TYPE): make TYPE (another OClosure type) be a parent of NAME.
+  (:copier COPIER ARGS): asks to create a \"copier\" (i.e. functional update
+    function) named COPIER.  It will take an object of type NAME as first
+    argument followed by ARGS.  ARGS lists the names of the slots that will
+    be updated with the value of the corresponding argument.
+SLOTS is a list if slot descriptions.  Each slot can be a single symbol
+which is the name of the slot, or it can be of the form (SLOT-NAME . SPROPS)
+where SLOT-NAME is then the name of the slot and SPROPS is a property
+list of slot properties.  The currently known properties are the following:
+  `:mutable': A non-nil value mean the slot can be mutated.
+  `:type': Specifies the type of the values expected to appear in the slot."
+  (declare (doc-string 2) (indent 1))
+  (unless (or (stringp docstring) (null docstring))
+    (push docstring slots)
+    (setq docstring nil))
+  (let* ((options (when (consp name)
+                    (prog1 (copy-sequence (cdr name))
+                      (setq name (car name)))))
+         (get-opt (lambda (opt &optional all)
+                    (let ((val (assq opt options))
+                          tmp)
+                      (when val (setq options (delq val options)))
+                      (if (not all)
+                          (cdr val)
+                        (when val
+                          (setq val (list (cdr val)))
+                          (while (setq tmp (assq opt options))
+                            (push (cdr tmp) val)
+                            (setq options (delq tmp options)))
+                          (nreverse val))))))
+         (predicate (car (funcall get-opt :predicate)))
+         (parent-names (or (funcall get-opt :parent)
+                           (funcall get-opt :include)))
+         (copiers (funcall get-opt :copier 'all)))
+    `(progn
+       ,(when options (macroexp-warn-and-return name
+                       (format "Ignored options: %S" options)
+                       nil))
+       (eval-and-compile
+         (oclosure--define ',name ,docstring ',parent-names ',slots
+                           ,@(when predicate `(:predicate ',predicate))))
+       (oclosure--define-functions ,name ,copiers))))
+
+(defun oclosure--build-class (name docstring parent-names slots)
+  (cl-assert (null (cdr parent-names)))
+  (let* ((parent-class (let ((name (or (car parent-names) 'oclosure)))
+                         (or (cl--find-class name)
+                             (error "Unknown class: %S" name))))
+         (slotdescs
+          (append
+           (oclosure--class-slots parent-class)
+           (mapcar (lambda (field)
+                     (if (not (consp field))
+                         (cl--make-slot-descriptor field nil nil
+                                                   '((:read-only . t)))
+                       (let ((name (pop field))
+                             (type nil)
+                             (read-only t)
+                             (props '()))
+                         (while field
+                           (pcase (pop field)
+                             (:mutable (setq read-only (not (car field))))
+                             (:type (setq type (car field)))
+                             (p (message "Unknown property: %S" p)
+                                (push (cons p (car field)) props)))
+                           (setq field (cdr field)))
+                         (cl--make-slot-descriptor name nil type
+                                                   `((:read-only . ,read-only)
+                                                     ,@props)))))
+                   slots))))
+    (oclosure--class-make name docstring slotdescs
+                          (if (cdr parent-names)
+                              (oclosure--class-parents parent-class)
+                            (list parent-class))
+                          (cons name (oclosure--class-allparents
+                                      parent-class)))))
+
+(defmacro oclosure--define-functions (name copiers)
+  (let* ((class (cl--find-class name))
+         (slotdescs (oclosure--class-slots class)))
+    `(progn
+     ,@(let ((i -1))
+           (mapcar (lambda (desc)
+                     (let* ((slot (cl--slot-descriptor-name desc))
+                            (mutable (oclosure--slot-mutable-p desc))
+                            ;; Always use a double hyphen: if users wants to
+                            ;; make it public, they can do so with an alias.
+                            (aname (intern (format "%S--%S" name slot))))
+                       (cl-incf i)
+                       (if (not mutable)
+                           `(defalias ',aname
+                              ;; We use `oclosure--copy' instead of
+                              ;; `oclosure--accessor-copy' here to circumvent
+                              ;; bootstrapping problems.
+                              (oclosure--copy
+                               oclosure--accessor-prototype
+                               nil ',name ',slot ,i))
+                         (require 'gv)  ;For `gv-setter'.
+                         `(progn
+                            (defalias ',aname
+                              (oclosure--accessor-copy
+                               oclosure--mut-getter-prototype
+                               ',name ',slot ,i))
+                            (defalias ',(gv-setter aname)
+                              (oclosure--accessor-copy
+                               oclosure--mut-setter-prototype
+                               ',name ',slot ,i))))))
+                   slotdescs))
+       ,@(oclosure--defstruct-make-copiers
+          copiers slotdescs name))))
+
+;;;###autoload
+(defun oclosure--define (name docstring parent-names slots
+                              &rest props)
+  (let* ((class (oclosure--build-class name docstring parent-names slots))
+         (pred (lambda (oclosure)
+                 (let ((type (oclosure-type oclosure)))
+                   (when type
+                     (memq name (oclosure--class-allparents
+                                 (cl--find-class type)))))))
+         (predname (or (plist-get props :predicate)
+                       (intern (format "%s--internal-p" name)))))
+    (setf (cl--find-class name) class)
+    (dolist (slot (oclosure--class-slots class))
+      (put (cl--slot-descriptor-name slot) 'slot-name t))
+    (defalias predname pred)
+    (put name 'cl-deftype-satisfies predname)))
+
+(defmacro oclosure--lambda (type bindings mutables args &rest body)
+  "Low level construction of an OClosure object.
+TYPE should be a form returning an OClosure type (a symbol)
+BINDINGS should list all the slots expected by this type, in the proper order.
+MUTABLE is a list of symbols indicating which of the BINDINGS
+should be mutable.
+No checking is performed,"
+  (declare (indent 3) (debug (sexp (&rest (sexp form)) sexp def-body)))
+  ;; FIXME: Fundamentally `oclosure-lambda' should be a special form.
+  ;; We define it here as a macro which expands to something that
+  ;; looks like "normal code" in order to avoid backward compatibility
+  ;; issues with third party macros that do "code walks" and would
+  ;; likely mishandle such a new special form (e.g. `generator.el').
+  ;; But don't be fooled: this macro is tightly bound to `cconv.el'.
+  (pcase-let*
+      ((`(,prebody . ,body) (macroexp-parse-body body))
+       (rovars (mapcar #'car bindings)))
+    (dolist (mutable mutables)
+      (setq rovars (delq mutable rovars)))
+    `(let ,(mapcar (lambda (bind)
+                     (if (cdr bind) bind
+                       ;; Bind to something that doesn't look
+                       ;; like a value to avoid the "Variable
+                       ;; ‘foo’ left uninitialized" warning.
+                       `(,(car bind) (progn nil))))
+                   (reverse bindings))
+       ;; FIXME: Make sure the slotbinds whose value is duplicable aren't
+       ;; just value/variable-propagated by the optimizer (tho I think our
+       ;; optimizer is too naive to be a problem currently).
+       (oclosure--fix-type
+        ;; This `oclosure--fix-type' + `ignore' call is used by the compiler (in
+        ;; `cconv.el') to detect and signal an error in case of
+        ;; store-conversion (i.e. if a variable/slot is mutated).
+        (ignore ,@rovars)
+        (lambda ,args
+          (:documentation ,type)
+          ,@prebody
+          ;; Add dummy code which accesses the field's vars to make sure
+          ;; they're captured in the closure.
+          (if t nil ,@rovars ,@(mapcar (lambda (m) `(setq ,m ,m)) mutables))
+          ,@body)))))
+
+(defmacro oclosure-lambda (type-and-slots args &rest body)
+  "Define anonymous OClosure function.
+TYPE-AND-SLOTS should be of the form (TYPE . SLOTS)
+where TYPE is an OClosure type name (defined by `oclosure-define')
+and SLOTS is a let-style list of bindings for the various slots of TYPE.
+ARGS and BODY are the same as for `lambda'."
+  (declare (indent 2) (debug ((sexp &rest (sexp form)) sexp def-body)))
+  ;; FIXME: Should `oclosure-define' distinguish "optional" from
+  ;; "mandatory" slots, and/or provide default values for slots missing
+  ;; from `fields'?
+  (pcase-let*
+      ((`(,type . ,fields) type-and-slots)
+       (class (or (cl--find-class type)
+                  (error "Unknown class: %S" type)))
+       (slots (oclosure--class-slots class))
+       (mutables '())
+       (slotbinds (mapcar (lambda (slot)
+                            (let ((name (cl--slot-descriptor-name slot)))
+                              (when (oclosure--slot-mutable-p slot)
+                                (push name mutables))
+                              (list name)))
+                          slots))
+       (tempbinds (mapcar
+                   (lambda (field)
+                     (let* ((name (car field))
+                            (bind (assq name slotbinds)))
+                       (cond
+                        ;; FIXME: Should we also warn about missing slots?
+                        ((not bind)
+                         (error "Unknown slot: %S" name))
+                        ((cdr bind)
+                         (error "Duplicate slot: %S" name))
+                        (t
+                         (let ((temp (gensym "temp")))
+                           (setcdr bind (list temp))
+                           (cons temp (cdr field)))))))
+                   fields)))
+    ;; FIXME: Optimize temps away when they're provided in the right order?
+    `(let ,tempbinds
+       (oclosure--lambda ',type ,slotbinds ,mutables ,args ,@body))))
+
+(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 the `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)))
+
+(defun oclosure--copy (oclosure mutlist &rest args)
+  (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)))))
+
+(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)))))
+
+(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)))
+
+(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))))))
+
+(defconst oclosure--accessor-prototype
+  ;; Use `oclosure--lambda' to circumvent a bootstrapping problem:
+  ;; `oclosure-accessor' is not yet defined at this point but
+  ;; `oclosure--accessor-prototype' is needed when defining `oclosure-accessor'.
+  (oclosure--lambda 'oclosure-accessor ((type) (slot) (index)) nil
+    (oclosure) (oclosure--get oclosure index nil)))
+
+(oclosure-define accessor
+  "OClosure function to access a specific slot of an object."
+  type slot)
+
+(defun oclosure--accessor-cl-print (object stream)
+  (princ "#f(accessor " stream)
+  (prin1 (accessor--type object) stream)
+  (princ "." stream)
+  (prin1 (accessor--slot object) stream)
+  (princ ")" stream))
+
+(defun oclosure--accessor-docstring (f)
+  ;; This would like to be a (cl-defmethod function-documentation ...)
+  ;; but for circularity reason the defmethod is in `simple.el'.
+  (format "Access slot \"%S\" of OBJ of type `%S'.\n\n(fn OBJ)"
+          (accessor--slot f) (accessor--type f)))
+
+(oclosure-define (oclosure-accessor
+                  (:parent accessor)
+                  (:copier oclosure--accessor-copy (type slot index)))
+  "OClosure function to access a specific slot of an OClosure function."
+  index)
+
+(defun oclosure--slot-index (oclosure slotname)
+  (gethash slotname
+           (oclosure--class-index-table
+            (cl--find-class (oclosure-type oclosure)))))
+
+(defun oclosure--slot-value (oclosure slotname)
+  (let ((class (cl--find-class (oclosure-type oclosure)))
+        (index (oclosure--slot-index oclosure slotname)))
+    (oclosure--get oclosure index
+                   (oclosure--slot-mutable-p
+                    (nth index (oclosure--class-slots class))))))
+
+(defun oclosure--set-slot-value (oclosure slotname value)
+  (let ((class (cl--find-class (oclosure-type oclosure)))
+        (index (oclosure--slot-index oclosure slotname)))
+    (unless (oclosure--slot-mutable-p
+             (nth index (oclosure--class-slots class)))
+      (signal 'setting-constant (list oclosure slotname)))
+    (oclosure--set value oclosure index)))
+
+(defconst oclosure--mut-getter-prototype
+  (oclosure-lambda (oclosure-accessor (type) (slot) (index)) (oclosure)
+    (oclosure--get oclosure index t)))
+(defconst oclosure--mut-setter-prototype
+  ;; FIXME: The generated docstring is wrong.
+  (oclosure-lambda (oclosure-accessor (type) (slot) (index)) (val oclosure)
+    (oclosure--set val oclosure index)))
+
+;; Ideally, this should be in `files.el', but that file is loaded
+;; before `oclosure.el'.
+(oclosure-define (save-some-buffers-function
+                  (:predicate save-some-buffers-function--p)))
+
+
+(provide 'oclosure)
+;;; oclosure.el ends here