- ; funcall is not a special form
- ; but we treat it separately
- ; for the needs of lambda lifting
- (let ((fv (cdr (assq fun lmenvs))))
- (if fv
- (let ((args-new '())
- (processed-fv '()))
- ;; All args (free variables and actual arguments)
- ;; should be processed, because they can be fvrs
- ;; (free variables of another closure)
- (dolist (fvr fv)
- (push (cconv-closure-convert-rec
- fvr (remq fvr emvrs)
- fvrs envs lmenvs)
- processed-fv))
- (setq processed-fv (reverse processed-fv))
- (dolist (elm args)
- (push (cconv-closure-convert-rec
- elm emvrs fvrs envs lmenvs)
- args-new))
- (setq args-new (append processed-fv (reverse args-new)))
- (setq fun (cconv-closure-convert-rec
- fun emvrs fvrs envs lmenvs))
- `(,callsym ,fun . ,args-new))
- (let ((cdr-new '()))
- (dolist (elm (cdr form))
- (push (cconv-closure-convert-rec
- elm emvrs fvrs envs lmenvs)
- cdr-new))
- `(,callsym . ,(reverse cdr-new))))))
-
- (`(,func . ,body-forms) ; first element is function or whatever
- ; function-like forms are:
- ; or, and, if, progn, prog1, prog2,
- ; while, until
- (let ((body-forms-new '()))
- (dolist (elm body-forms)
- (push (cconv-closure-convert-rec
- elm emvrs fvrs envs lmenvs)
- body-forms-new))
- (setq body-forms-new (reverse body-forms-new))
- `(,func . ,body-forms-new)))
-
- (_
- (let ((free (memq form fvrs)))
- (if free ;form is a free variable
- (let* ((numero (- (length fvrs) (length free)))
- (var '()))
- (assert numero)
- (if (null (cdr envs))
- (setq var 'env)
- ;replace form =>
- ;(aref env #)
- (setq var `(aref env ,numero)))
- (if (memq form emvrs) ; form => (car (aref env #)) if mutable
- `(car ,var)
- var))
- (if (memq form emvrs) ; if form is a mutable variable
- `(car ,form) ; replace form => (car form)
- form))))))
-
-(defun cconv-analyse-function (args body env parentform inclosure)
- (dolist (arg args)
- (cond
- ((cconv-not-lexical-var-p arg)
- (byte-compile-report-error
- (format "Argument %S is not a lexical variable" arg)))
- ((eq ?& (aref (symbol-name arg) 0)) nil) ;Ignore &rest, &optional, ...
- (t (push (list arg inclosure parentform) env)))) ;Push vrs to vars.
- (dolist (form body) ;Analyse body forms.
- (cconv-analyse-form form env inclosure)))
-
-(defun cconv-analyse-form (form env inclosure)
- "Find mutated variables and variables captured by closure. Analyse
-lambdas if they are suitable for lambda lifting.
--- FORM is a piece of Elisp code after macroexpansion.
--- ENV is a list of variables visible in current lexical environment.
- Each entry has the form (VAR INCLOSURE BINDER PARENTFORM)
- for let-bound vars and (VAR INCLOSURE PARENTFORM) for function arguments.
--- INCLOSURE is the nesting level within lambdas."
+ ;; These are not special forms but we treat them separately for the needs
+ ;; of lambda lifting.
+ (let ((mapping (cdr (assq fun env))))
+ (pcase mapping
+ (`(apply-partially ,_ . ,(and fvs `(,_ . ,_)))
+ (cl-assert (eq (cadr mapping) fun))
+ `(,callsym ,fun
+ ,@(mapcar (lambda (fv)
+ (let ((exp (or (cdr (assq fv env)) fv)))
+ (pcase exp
+ (`(car ,iexp . ,_) iexp)
+ (_ exp))))
+ fvs)
+ ,@(mapcar (lambda (arg)
+ (cconv-convert arg env extend))
+ args)))
+ (_ `(,callsym ,@(mapcar (lambda (arg)
+ (cconv-convert arg env extend))
+ (cons fun args)))))))
+
+ (`(interactive . ,forms)
+ `(interactive . ,(mapcar (lambda (form)
+ (cconv-convert form nil nil))
+ forms)))
+
+ (`(declare . ,_) form) ;The args don't contain code.
+
+ (`(,func . ,forms)
+ ;; First element is function or whatever function-like forms are: or, and,
+ ;; if, progn, prog1, prog2, while, until
+ `(,func . ,(mapcar (lambda (form)
+ (cconv-convert form env extend))
+ forms)))
+
+ (_ (or (cdr (assq form env)) form))))
+
+(unless (fboundp 'byte-compile-not-lexical-var-p)
+ ;; Only used to test the code in non-lexbind Emacs.
+ (defalias 'byte-compile-not-lexical-var-p 'boundp))
+
+(defun cconv--analyse-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.
+FORM is the parent form that binds this var."
+ ;; use = `(,binder ,read ,mutated ,captured ,called)
+ (pcase vardata
+ (`(,_ nil nil nil nil) nil)
+ (`((,(and (pred (lambda (var) (eq ?_ (aref (symbol-name var) 0)))) var) . ,_)
+ ,_ ,_ ,_ ,_)
+ (byte-compile-log-warning
+ (format "%s `%S' not left unused" varkind var))))
+ (pcase vardata
+ (`((,var . ,_) nil ,_ ,_ nil)
+ ;; FIXME: This gives warnings in the wrong order, with imprecise line
+ ;; numbers and without function name info.
+ (unless (or ;; Uninterned symbols typically come from macro-expansion, so
+ ;; it is often non-trivial for the programmer to avoid such
+ ;; unused vars.
+ (not (intern-soft var))
+ (eq ?_ (aref (symbol-name var) 0))
+ ;; As a special exception, ignore "ignore".
+ (eq var 'ignored))
+ (byte-compile-log-warning (format "Unused lexical %s `%S'"
+ varkind var))))
+ ;; If it's unused, there's no point converting it into a cons-cell, even if
+ ;; it's captured and mutated.
+ (`(,binder ,_ t t ,_)
+ (push (cons binder form) cconv-captured+mutated))
+ (`(,(and binder `(,_ (function (lambda . ,_)))) nil nil nil t)
+ (push (cons binder form) cconv-lambda-candidates))))
+
+(defun cconv--analyse-function (args body env parentform)
+ (let* ((newvars nil)
+ (freevars (list body))
+ ;; We analyze the body within a new environment where all uses are
+ ;; nil, so we can distinguish uses within that function from uses
+ ;; outside of it.
+ (envcopy
+ (mapcar (lambda (vdata) (list (car vdata) nil nil nil nil)) env))
+ (newenv envcopy))
+ ;; Push it before recursing, so cconv-freevars-alist contains entries in
+ ;; the order they'll be used by closure-convert-rec.
+ (push freevars cconv-freevars-alist)
+ (dolist (arg args)
+ (cond
+ ((byte-compile-not-lexical-var-p arg)
+ (byte-compile-log-warning
+ (format "Argument %S is not a lexical variable" arg)))
+ ((eq ?& (aref (symbol-name arg) 0)) nil) ;Ignore &rest, &optional, ...
+ (t (let ((varstruct (list arg nil nil nil nil)))
+ (push (cons (list arg) (cdr varstruct)) newvars)
+ (push varstruct newenv)))))
+ (dolist (form body) ;Analyze body forms.
+ (cconv-analyse-form form newenv))
+ ;; Summarize resulting data about arguments.
+ (dolist (vardata newvars)
+ (cconv--analyse-use vardata parentform "argument"))
+ ;; Transfer uses collected in `envcopy' (via `newenv') back to `env';
+ ;; and compute free variables.
+ (while env
+ (cl-assert (and envcopy (eq (caar env) (caar envcopy))))
+ (let ((free nil)
+ (x (cdr (car env)))
+ (y (cdr (car envcopy))))
+ (while x
+ (when (car y) (setcar x t) (setq free t))
+ (setq x (cdr x) y (cdr y)))
+ (when free
+ (push (caar env) (cdr freevars))
+ (setf (nth 3 (car env)) t))
+ (setq env (cdr env) envcopy (cdr envcopy))))))
+
+(defun cconv-analyse-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.
+- ENV is an alist mapping each enclosing lexical variable to its info.
+ I.e. each element has the form (VAR . (READ MUTATED CAPTURED CALLED)).
+This function does not return anything but instead fills the
+`cconv-captured+mutated' and `cconv-lambda-candidates' variables
+and updates the data stored in ENV."