;;; cconv.el --- Closure conversion for statically scoped Emacs lisp. -*- lexical-binding: t; coding: utf-8 -*-
-;; Copyright (C) 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
;; Author: Igor Kuzmin <kzuminig@iro.umontreal.ca>
;; Maintainer: FSF
;; since afterwards they can because obnoxious (warnings about an "unused
;; variable" should not be emitted when the variable use has simply been
;; optimized away).
-;; - turn defun and defmacro into macros (and remove special handling of
-;; `declare' afterwards).
;; - let macros specify that some let-bindings come from the same source,
;; so the unused warning takes all uses into account.
;; - let interactive specs return a function to build the args (to stash into
;; ,@(mapcar (lambda (binder) (if (consp binder) (cadr binder)))
;; binders)))
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(defconst cconv-liftwhen 6
"Try to do lambda lifting if the number of arguments + free variables
;; Here we assume that X appears at most once in M.
(let* ((b (assq x m))
(res (if b (remq b m) m)))
- (assert (null (assq x res))) ;; Check the assumption was warranted.
+ (cl-assert (null (assq x res))) ;; Check the assumption was warranted.
res))
(defun cconv--map-diff-set (m s)
(nreverse res)))
(defun cconv--convert-function (args body env parentform)
- (assert (equal body (caar cconv-freevars-alist)))
+ (cl-assert (equal body (caar cconv-freevars-alist)))
(let* ((fvs (cdr (pop cconv-freevars-alist)))
(body-new '())
(letbind '())
EXTEND is a list of variables which might need to be accessed even from places
where they are shadowed, because some part of ENV causes them to be used at
places where they originally did not directly appear."
- (assert (not (delq nil (mapcar (lambda (mapping)
- (if (eq (cadr mapping) 'apply-partially)
- (cconv--set-diff (cdr (cddr mapping))
- extend)))
- env))))
+ (cl-assert (not (delq nil (mapcar (lambda (mapping)
+ (if (eq (cadr mapping) 'apply-partially)
+ (cconv--set-diff (cdr (cddr mapping))
+ extend)))
+ env))))
;; What's the difference between fvrs and envs?
;; Suppose that we have the code
;; Check if var is a candidate for lambda lifting.
((and (member (cons binder form) cconv-lambda-candidates)
(progn
- (assert (and (eq (car value) 'function)
- (eq (car (cadr value)) 'lambda)))
- (assert (equal (cddr (cadr value))
- (caar cconv-freevars-alist)))
+ (cl-assert (and (eq (car value) 'function)
+ (eq (car (cadr value)) 'lambda)))
+ (cl-assert (equal (cddr (cadr value))
+ (caar cconv-freevars-alist)))
;; Peek at the freevars to decide whether to λ-lift.
(let* ((fvs (cdr (car cconv-freevars-alist)))
(fun (cadr value))
(funcbody-env ()))
(push `(,var . (apply-partially ,var . ,fvs)) new-env)
(dolist (fv fvs)
- (pushnew fv new-extend)
+ (cl-pushnew fv new-extend)
(if (and (eq 'car (car-safe (cdr (assq fv env))))
(not (memq fv funargs)))
(push `(,fv . (car ,fv)) funcbody-env)))
(mapcar (lambda (mapping)
(if (not (eq (cadr mapping) 'apply-partially))
mapping
- (assert (eq (car mapping) (nth 2 mapping)))
- (list* (car mapping)
- 'apply-partially
- (car mapping)
- (mapcar (lambda (arg)
- (if (eq var arg)
- closedsym arg))
- (nthcdr 3 mapping)))))
+ (cl-assert (eq (car mapping) (nth 2 mapping)))
+ `(,(car mapping)
+ apply-partially
+ ,(car mapping)
+ ,@(mapcar (lambda (arg)
+ (if (eq var arg)
+ closedsym arg))
+ (nthcdr 3 mapping)))))
new-env))
(setq new-extend (remq var new-extend))
(push closedsym new-extend)
. ,(mapcar (lambda (form) (cconv-convert form env extend))
forms)))
- ;defun, defmacro
- (`(,(and sym (or `defun `defmacro))
- ,func ,args . ,body)
- (assert (equal body (caar cconv-freevars-alist)))
- (assert (null (cdar cconv-freevars-alist)))
-
- (let ((new (cconv--convert-function args body env form)))
- (pcase new
- (`(function (lambda ,newargs . ,new-body))
- (assert (equal args newargs))
- `(,sym ,func ,args . ,new-body))
- (t (byte-compile-report-error
- (format "Internal error in cconv of (%s %s ...)" sym func))))))
-
;condition-case
(`(condition-case ,var ,protected-form . ,handlers)
(let ((newform (cconv--convert-function
(let ((mapping (cdr (assq fun env))))
(pcase mapping
(`(apply-partially ,_ . ,(and fvs `(,_ . ,_)))
- (assert (eq (cadr mapping) fun))
+ (cl-assert (eq (cadr mapping) fun))
`(,callsym ,fun
,@(mapcar (lambda (fv)
(let ((exp (or (cdr (assq fv env)) fv)))
;; Transfer uses collected in `envcopy' (via `newenv') back to `env';
;; and compute free variables.
(while env
- (assert (and envcopy (eq (caar env) (caar envcopy))))
+ (cl-assert (and envcopy (eq (caar env) (caar envcopy))))
(let ((free nil)
(x (cdr (car env)))
(y (cdr (car envcopy))))
(dolist (vardata newvars)
(cconv--analyse-use vardata form "variable"))))
- ; defun special form
- (`(,(or `defun `defmacro) ,func ,vrs . ,body-forms)
- (when env
- (byte-compile-log-warning
- (format "Function %S will ignore its context %S"
- func (mapcar #'car env))
- t :warning))
- (cconv--analyse-function vrs body-forms nil form))
-
(`(function (lambda ,vrs . ,body-forms))
(cconv--analyse-function vrs body-forms env form))
(cconv-analyse-form (cadr forms) env)
(setq forms (cddr forms))))
- (`((lambda . ,_) . ,_) ; first element is lambda expression
+ (`((lambda . ,_) . ,_) ; First element is lambda expression.
+ (byte-compile-log-warning
+ "Use of deprecated ((lambda ...) ...) form" t :warning)
(dolist (exp `((function ,(car form)) . ,(cdr form)))
(cconv-analyse-form exp env)))