;;; cconv.el --- Closure conversion for statically scoped Emacs lisp. -*- lexical-binding: t; coding: utf-8 -*-
-;; Copyright (C) 2011-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2015 Free Software Foundation, Inc.
;; Author: Igor Kuzmin <kzuminig@iro.umontreal.ca>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: lisp
;; Package: emacs
;; All macros should be expanded beforehand.
;;
;; Here is a brief explanation how this code works.
-;; Firstly, we analyze the tree by calling cconv-analyse-form.
+;; Firstly, we analyze the tree by calling cconv-analyze-form.
;; This function finds all mutated variables, all functions that are suitable
;; for lambda lifting and all variables captured by closure. It passes the tree
;; once, returning a list of three lists.
;;
;; Then we calculate the intersection of the first and third lists returned by
-;; cconv-analyse form to find all mutated variables that are captured by
+;; cconv-analyze form to find all mutated variables that are captured by
;; closure.
;; Armed with this data, we call cconv-closure-convert-rec, that rewrites the
;; command-history).
;; - canonize code in macro-expand so we don't have to handle (let (var) body)
;; and other oddities.
-;; - new byte codes for unwind-protect, catch, and condition-case so that
-;; closures aren't needed at all.
+;; - new byte codes for unwind-protect so that closures aren't needed at all.
;; - a reference to a var that is known statically to always hold a constant
;; should be turned into a byte-constant rather than a byte-stack-ref.
;; Hmm... right, that's called constant propagation and could be done here,
(cconv-lambda-candidates '())
(cconv-captured+mutated '()))
;; Analyze form - fill these variables with new information.
- (cconv-analyse-form form '())
+ (cconv-analyze-form form '())
(setq cconv-freevars-alist (nreverse cconv-freevars-alist))
(prog1 (cconv-convert form nil nil) ; Env initially empty.
(cl-assert (null cconv-freevars-alist)))))
(cconv-lambda-candidates '())
(cconv-captured+mutated '()))
;; Analyze form - fill these variables with new information.
- (cconv-analyse-form form '())
+ (cconv-analyze-form form '())
;; But don't perform the closure conversion.
form))
(dolist (binder binders)
(let* ((value nil)
- (var (if (not (consp binder))
- (prog1 binder (setq binder (list binder)))
- (setq value (cadr binder))
- (car binder)))
- (new-val
- (cond
+ (var (if (not (consp binder))
+ (prog1 binder (setq binder (list binder)))
+ (when (cddr binder)
+ (byte-compile-log-warning
+ (format "Malformed `%S' binding: %S" letsym binder)))
+ (setq value (cadr binder))
+ (car binder)))
+ (new-val
+ (cond
;; Check if var is a candidate for lambda lifting.
((and (member (cons binder form) cconv-lambda-candidates)
(progn
forms)))
;condition-case
- (`(condition-case ,var ,protected-form . ,handlers)
+ ((and `(condition-case ,var ,protected-form . ,handlers)
+ (guard byte-compile--use-old-handlers))
(let ((newform (cconv--convert-function
() (list protected-form) env form)))
`(condition-case :fun-body ,newform
- ,@(mapcar (lambda (handler)
+ ,@(mapcar (lambda (handler)
(list (car handler)
(cconv--convert-function
(list (or var cconv--dummy-var))
(cdr handler) env form)))
handlers))))
- (`(,(and head (or `catch `unwind-protect)) ,form . ,body)
+ ; condition-case with new byte-codes.
+ (`(condition-case ,var ,protected-form . ,handlers)
+ `(condition-case ,var
+ ,(cconv-convert protected-form env extend)
+ ,@(let* ((cm (and var (member (cons (list var) form)
+ cconv-captured+mutated)))
+ (newenv
+ (cond (cm (cons `(,var . (car-save ,var)) env))
+ ((assq var env) (cons `(,var) env))
+ (t env))))
+ (mapcar
+ (lambda (handler)
+ `(,(car handler)
+ ,@(let ((body
+ (mapcar (lambda (form)
+ (cconv-convert form newenv extend))
+ (cdr handler))))
+ (if (not cm) body
+ `((let ((,var (list ,var))) ,@body))))))
+ handlers))))
+
+ (`(,(and head (or (and `catch (guard byte-compile--use-old-handlers))
+ `unwind-protect))
+ ,form . ,body)
`(,head ,(cconv-convert form env extend)
:fun-body ,(cconv--convert-function () body env form)))
- (`(track-mouse . ,body)
- `(track-mouse
- :fun-body ,(cconv--convert-function () body env form)))
-
(`(setq . ,forms) ; setq special form
(let ((prognlist ()))
(while forms
(`(,func . ,forms)
;; First element is function or whatever function-like forms are: or, and,
- ;; if, progn, prog1, prog2, while, until
+ ;; if, catch, progn, prog1, prog2, while, until
`(,func . ,(mapcar (lambda (form)
(cconv-convert form env extend))
forms)))
(defalias 'byte-compile-not-lexical-var-p 'boundp))
(defvar byte-compile-lexical-variables)
-(defun cconv--analyse-use (vardata form varkind)
+(defun cconv--analyze-use (vardata form varkind)
"Analyze the use of a variable.
VARDATA should be (BINDER READ MUTATED CAPTURED CALLED).
VARKIND is the name of the kind of variable.
(`(,(and binder `(,_ (function (lambda . ,_)))) nil nil nil t)
(push (cons binder form) cconv-lambda-candidates))))
-(defun cconv--analyse-function (args body env parentform)
+(defun cconv--analyze-function (args body env parentform)
(let* ((newvars nil)
(freevars (list body))
;; We analyze the body within a new environment where all uses are
(push (cons (list arg) (cdr varstruct)) newvars)
(push varstruct newenv)))))
(dolist (form body) ;Analyze body forms.
- (cconv-analyse-form form newenv))
+ (cconv-analyze-form form newenv))
;; Summarize resulting data about arguments.
(dolist (vardata newvars)
- (cconv--analyse-use vardata parentform "argument"))
+ (cconv--analyze-use vardata parentform "argument"))
;; Transfer uses collected in `envcopy' (via `newenv') back to `env';
;; and compute free variables.
(while env
(setf (nth 3 (car env)) t))
(setq env (cdr env) envcopy (cdr envcopy))))))
-(defun cconv-analyse-form (form env)
+(defun cconv-analyze-form (form env)
"Find mutated variables and variables captured by closure.
Analyze lambdas if they are suitable for lambda lifting.
- FORM is a piece of Elisp code after macroexpansion.
(setq var (car binder))
(setq value (cadr binder))
- (cconv-analyse-form value (if (eq letsym 'let*) env orig-env)))
+ (cconv-analyze-form value (if (eq letsym 'let*) env orig-env)))
(unless (byte-compile-not-lexical-var-p var)
(cl-pushnew var byte-compile-lexical-variables)
(push varstruct env))))
(dolist (form body-forms) ; Analyze body forms.
- (cconv-analyse-form form env))
+ (cconv-analyze-form form env))
(dolist (vardata newvars)
- (cconv--analyse-use vardata form "variable"))))
+ (cconv--analyze-use vardata form "variable"))))
(`(function (lambda ,vrs . ,body-forms))
- (cconv--analyse-function vrs body-forms env form))
+ (cconv--analyze-function vrs body-forms env form))
(`(setq . ,forms)
;; If a local variable (member of env) is modified by setq then
(while forms
(let ((v (assq (car forms) env))) ; v = non nil if visible
(when v (setf (nth 2 v) t)))
- (cconv-analyse-form (cadr forms) env)
+ (cconv-analyze-form (cadr forms) env)
(setq forms (cddr forms))))
(`((lambda . ,_) . ,_) ; First element is lambda expression.
(format "Use of deprecated ((lambda %s ...) ...) form" (nth 1 (car form)))
t :warning)
(dolist (exp `((function ,(car form)) . ,(cdr form)))
- (cconv-analyse-form exp env)))
+ (cconv-analyze-form exp env)))
(`(cond . ,cond-forms) ; cond special form
(dolist (forms cond-forms)
- (dolist (form forms) (cconv-analyse-form form env))))
+ (dolist (form forms) (cconv-analyze-form form env))))
(`(quote . ,_) nil) ; quote form
(`(function . ,_) nil) ; same as quote
- (`(condition-case ,var ,protected-form . ,handlers)
+ ((and `(condition-case ,var ,protected-form . ,handlers)
+ (guard byte-compile--use-old-handlers))
;; FIXME: The bytecode for condition-case forces us to wrap the
- ;; form and handlers in closures (for handlers, it's understandable
- ;; but not for the protected form).
- (cconv--analyse-function () (list protected-form) env form)
+ ;; form and handlers in closures.
+ (cconv--analyze-function () (list protected-form) env form)
(dolist (handler handlers)
- (cconv--analyse-function (if var (list var)) (cdr handler) env form)))
-
- ;; FIXME: The bytecode for catch forces us to wrap the body.
- (`(,(or `catch `unwind-protect) ,form . ,body)
- (cconv-analyse-form form env)
- (cconv--analyse-function () body env form))
+ (cconv--analyze-function (if var (list var)) (cdr handler)
+ env form)))
- ;; FIXME: The lack of bytecode for track-mouse forces us to wrap the body.
- ;; `track-mouse' really should be made into a macro.
- (`(track-mouse . ,body)
- (cconv--analyse-function () body env form))
+ (`(condition-case ,var ,protected-form . ,handlers)
+ (cconv-analyze-form protected-form env)
+ (when (and var (symbolp var) (byte-compile-not-lexical-var-p var))
+ (byte-compile-log-warning
+ (format "Lexical variable shadows the dynamic variable %S" var)))
+ (let* ((varstruct (list var nil nil nil nil)))
+ (if var (push varstruct env))
+ (dolist (handler handlers)
+ (dolist (form (cdr handler))
+ (cconv-analyze-form form env)))
+ (if var (cconv--analyze-use (cons (list var) (cdr varstruct))
+ form "variable"))))
+
+ ;; FIXME: The bytecode for unwind-protect forces us to wrap the unwind.
+ (`(,(or (and `catch (guard byte-compile--use-old-handlers))
+ `unwind-protect)
+ ,form . ,body)
+ (cconv-analyze-form form env)
+ (cconv--analyze-function () body env form))
(`(defvar ,var) (push var byte-compile-bound-variables))
(`(,(or `defconst `defvar) ,var ,value . ,_)
(push var byte-compile-bound-variables)
- (cconv-analyse-form value env))
+ (cconv-analyze-form value env))
(`(,(or `funcall `apply) ,fun . ,args)
;; Here we ignore fun because funcall and apply are the only two
(let ((fdata (and (symbolp fun) (assq fun env))))
(if fdata
(setf (nth 4 fdata) t)
- (cconv-analyse-form fun env)))
- (dolist (form args) (cconv-analyse-form form env)))
+ (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
;; 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-analyse-form form nil)))
+ (dolist (form forms) (cconv-analyze-form form nil)))
;; `declare' should now be macro-expanded away (and if they're not, we're
;; in trouble because they *can* contain code nowadays).
;; (`(declare . ,_) nil) ;The args don't contain code.
(`(,_ . ,body-forms) ; First element is a function or whatever.
- (dolist (form body-forms) (cconv-analyse-form form env)))
+ (dolist (form body-forms) (cconv-analyze-form form env)))
((pred symbolp)
(let ((dv (assq form env))) ; dv = declared and visible
(when dv
(setf (nth 1 dv) t))))))
+(define-obsolete-function-alias 'cconv-analyse-form 'cconv-analyze-form "25.1")
(provide 'cconv)
;;; cconv.el ends here