;; Alist associating to each function body the list of its free variables.
)
+(defvar cconv--interactive-form-funs
+ ;; Table used to hold the functions we create internally for
+ ;; interactive forms.
+ (make-hash-table :test #'eq :weakness 'key))
+
;;;###autoload
(defun cconv-closure-convert (form)
"Main entry point for closure conversion.
cond-forms)))
(`(function (lambda ,args . ,body) . ,_)
- (let ((docstring (if (eq :documentation (car-safe (car body)))
- (cconv-convert (cadr (pop body)) env extend))))
- (cconv--convert-function args body env form docstring)))
+ (let* ((docstring (if (eq :documentation (car-safe (car body)))
+ (cconv-convert (cadr (pop body)) env extend)))
+ (bf (if (stringp (car body)) (cdr body) body))
+ (if (when (eq 'interactive (car-safe (car bf)))
+ (gethash form cconv--interactive-form-funs)))
+ (cif (when if (cconv-convert if env extend)))
+ (_ (pcase cif
+ (`#'(lambda () ,form) (setf (cadr (car bf)) form) (setq cif nil))
+ ('nil nil)
+ ;; The interactive form needs special treatment, so the form
+ ;; inside the `interactive' won't be used any further.
+ (_ (setf (cadr (car bf)) nil))))
+ (cf (cconv--convert-function args body env form docstring)))
+ (if (not cif)
+ ;; Normal case, the interactive form needs no special treatment.
+ cf
+ `(cconv--interactive-helper ,cf ,cif))))
(`(internal-make-closure . ,_)
(byte-compile-report-error
(cconv-convert arg env extend))
(cons fun args)))))))
- (`(interactive . ,forms)
- `(,(car form) . ,(mapcar (lambda (form)
- (cconv-convert form nil nil))
- forms)))
+ ;; The form (if any) is converted beforehand as part of the `lambda' case.
+ (`(interactive . ,_) form)
- (`(declare . ,_) form) ;The args don't contain code.
+ ;; `declare' should now be macro-expanded away (and if they're not, we're
+ ;; in trouble because they *can* contain code nowadays).
+ ;; (`(declare . ,_) form) ;The args don't contain code.
(`(oclosure--fix-type (ignore . ,vars) ,exp)
(dolist (var vars)
(`(function (lambda ,vrs . ,body-forms))
(when (eq :documentation (car-safe (car body-forms)))
(cconv-analyze-form (cadr (pop body-forms)) env))
+ (let ((bf (if (stringp (car body-forms)) (cdr body-forms) body-forms)))
+ (when (eq 'interactive (car-safe (car bf)))
+ (let ((if (cadr (car bf))))
+ (unless (macroexp-const-p if) ;Optimize this common case.
+ (let ((f `#'(lambda () ,if)))
+ (setf (gethash form cconv--interactive-form-funs) f)
+ (cconv-analyze-form f env))))))
(cconv--analyze-function vrs body-forms env form))
(`(setq ,var ,expr)
(cconv-analyze-form fun env)))
(dolist (form args) (cconv-analyze-form form env)))
- (`(interactive . ,forms)
- ;; These appear within the function body but they don't have access
- ;; to the function's arguments.
- ;; We could extend this to allow interactive specs to refer to
- ;; variables in the function's enclosing environment, but it doesn't
- ;; seem worth the trouble.
- (dolist (form forms) (cconv-analyze-form form nil)))
+ ;; The form (if any) is converted beforehand as part of the `lambda' case.
+ (`(interactive . ,_) nil)
;; `declare' should now be macro-expanded away (and if they're not, we're
;; in trouble because they *can* contain code nowadays).
(oclosure-define (save-some-buffers-function
(:predicate save-some-buffers-function--p)))
+;; This OClosure type is used internally by `cconv.el' to handle
+;; the case where we need to build a closure whose `interactive' spec
+;; captures variables from the context.
+;; It arguably belongs with `cconv.el' but is needed at runtime,
+;; so we placed it here.
+(oclosure-define (cconv--interactive-helper) fun if)
+(defun cconv--interactive-helper (fun if)
+ "Add interactive \"form\" IF to FUN.
+Returns a new command that otherwise behaves like FUN.
+IF should actually not be a form but a function of no arguments."
+ (oclosure-lambda (cconv--interactive-helper (fun fun) (if if))
+ (&rest args)
+ (apply (if (called-interactively-p 'any)
+ #'funcall-interactively #'funcall)
+ fun args)))
(provide 'oclosure)
;;; oclosure.el ends here
(cl-defmethod function-documentation ((function accessor))
(oclosure--accessor-docstring function)) ;; FIXME: η-reduce!
+(cl-defmethod function-documentation ((f cconv--interactive-helper))
+ (function-documentation (cconv--interactive-helper--fun f)))
+
;; This should be in `oclosure.el' but that file is loaded before `cl-generic'.
(cl-defgeneric oclosure-interactive-form (_function)
"Return the interactive form of FUNCTION or nil if none.
;; (interactive-form function)
nil)
+(cl-defmethod oclosure-interactive-form ((f cconv--interactive-helper))
+ `(interactive (funcall ',(cconv--interactive-helper--if f))))
+
(defun command-execute (cmd &optional record-flag keys special)
;; BEWARE: Called directly from the C code.
"Execute CMD as an editor command.