From b7b95a1e50e5f8699a35f7c035e5e9bdd3592ddf Mon Sep 17 00:00:00 2001 From: Dave Love Date: Wed, 27 Nov 2002 12:25:11 +0000 Subject: [PATCH] Move `predicates for analyzing Lisp forms' block to top (before uses). (help-fns): Don't require at top level. (Recursively.) (cl-transform-lambda): Require help-fns. --- lisp/ChangeLog | 7 ++ lisp/emacs-lisp/cl-macs.el | 170 ++++++++++++++++++------------------- 2 files changed, 91 insertions(+), 86 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index a95d0aa6eeb..82c220c7d53 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,10 @@ +2002-11-27 Dave Love + + * emacs-lisp/cl-macs.el: Move `predicates for analyzing Lisp + forms' block to top (before uses). + (help-fns): Don't require at top level. (Recursively.) + (cl-transform-lambda): Require help-fns. + 2002-11-26 Dave Love * language/european.el (encode-mac-roman): Deal with unencodable diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index ce5055ba087..ddc0572ad52 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -44,8 +44,6 @@ ;;; Code: -(require 'help-fns) ;For help-add-fundoc-usage. - (or (memq 'cl-19 features) (error "Tried to load `cl-macs' before `cl'!")) @@ -80,6 +78,89 @@ (run-hooks 'cl-hack-bytecomp-hook)) +;;; Some predicates for analyzing Lisp forms. These are used by various +;;; macro expanders to optimize the results in certain common cases. + +(defconst cl-simple-funcs '(car cdr nth aref elt if and or + - 1+ 1- min max + car-safe cdr-safe progn prog1 prog2)) +(defconst cl-safe-funcs '(* / % length memq list vector vectorp + < > <= >= = error)) + +;;; Check if no side effects, and executes quickly. +(defun cl-simple-expr-p (x &optional size) + (or size (setq size 10)) + (if (and (consp x) (not (memq (car x) '(quote function function*)))) + (and (symbolp (car x)) + (or (memq (car x) cl-simple-funcs) + (get (car x) 'side-effect-free)) + (progn + (setq size (1- size)) + (while (and (setq x (cdr x)) + (setq size (cl-simple-expr-p (car x) size)))) + (and (null x) (>= size 0) size))) + (and (> size 0) (1- size)))) + +(defun cl-simple-exprs-p (xs) + (while (and xs (cl-simple-expr-p (car xs))) + (setq xs (cdr xs))) + (not xs)) + +;;; Check if no side effects. +(defun cl-safe-expr-p (x) + (or (not (and (consp x) (not (memq (car x) '(quote function function*))))) + (and (symbolp (car x)) + (or (memq (car x) cl-simple-funcs) + (memq (car x) cl-safe-funcs) + (get (car x) 'side-effect-free)) + (progn + (while (and (setq x (cdr x)) (cl-safe-expr-p (car x)))) + (null x))))) + +;;; Check if constant (i.e., no side effects or dependencies). +(defun cl-const-expr-p (x) + (cond ((consp x) + (or (eq (car x) 'quote) + (and (memq (car x) '(function function*)) + (or (symbolp (nth 1 x)) + (and (eq (car-safe (nth 1 x)) 'lambda) 'func))))) + ((symbolp x) (and (memq x '(nil t)) t)) + (t t))) + +(defun cl-const-exprs-p (xs) + (while (and xs (cl-const-expr-p (car xs))) + (setq xs (cdr xs))) + (not xs)) + +(defun cl-const-expr-val (x) + (and (eq (cl-const-expr-p x) t) (if (consp x) (nth 1 x) x))) + +(defun cl-expr-access-order (x v) + (if (cl-const-expr-p x) v + (if (consp x) + (progn + (while (setq x (cdr x)) (setq v (cl-expr-access-order (car x) v))) + v) + (if (eq x (car v)) (cdr v) '(t))))) + +;;; Count number of times X refers to Y. Return nil for 0 times. +(defun cl-expr-contains (x y) + (cond ((equal y x) 1) + ((and (consp x) (not (memq (car-safe x) '(quote function function*)))) + (let ((sum 0)) + (while x + (setq sum (+ sum (or (cl-expr-contains (pop x) y) 0)))) + (and (> sum 0) sum))) + (t nil))) + +(defun cl-expr-contains-any (x y) + (while (and y (not (cl-expr-contains x (car y)))) (pop y)) + y) + +;;; Check whether X may depend on any of the symbols in Y. +(defun cl-expr-depends-p (x y) + (and (not (cl-const-expr-p x)) + (or (not (cl-safe-expr-p x)) (cl-expr-contains-any x y)))) + ;;; Symbols. (defvar *gensym-counter*) @@ -183,6 +264,7 @@ ARGLIST allows full Common Lisp conventions." (nconc (nreverse simple-args) (list '&rest (car (pop bind-lets)))) (nconc (let ((hdr (nreverse header))) + (require 'help-fns) (cons (help-add-fundoc-usage (if (stringp (car hdr)) (pop hdr)) orig-args) hdr)) @@ -2357,90 +2439,6 @@ Otherwise, return result of last FORM." `(condition-case nil (progn ,@body) (error nil))) -;;; Some predicates for analyzing Lisp forms. These are used by various -;;; macro expanders to optimize the results in certain common cases. - -(defconst cl-simple-funcs '(car cdr nth aref elt if and or + - 1+ 1- min max - car-safe cdr-safe progn prog1 prog2)) -(defconst cl-safe-funcs '(* / % length memq list vector vectorp - < > <= >= = error)) - -;;; Check if no side effects, and executes quickly. -(defun cl-simple-expr-p (x &optional size) - (or size (setq size 10)) - (if (and (consp x) (not (memq (car x) '(quote function function*)))) - (and (symbolp (car x)) - (or (memq (car x) cl-simple-funcs) - (get (car x) 'side-effect-free)) - (progn - (setq size (1- size)) - (while (and (setq x (cdr x)) - (setq size (cl-simple-expr-p (car x) size)))) - (and (null x) (>= size 0) size))) - (and (> size 0) (1- size)))) - -(defun cl-simple-exprs-p (xs) - (while (and xs (cl-simple-expr-p (car xs))) - (setq xs (cdr xs))) - (not xs)) - -;;; Check if no side effects. -(defun cl-safe-expr-p (x) - (or (not (and (consp x) (not (memq (car x) '(quote function function*))))) - (and (symbolp (car x)) - (or (memq (car x) cl-simple-funcs) - (memq (car x) cl-safe-funcs) - (get (car x) 'side-effect-free)) - (progn - (while (and (setq x (cdr x)) (cl-safe-expr-p (car x)))) - (null x))))) - -;;; Check if constant (i.e., no side effects or dependencies). -(defun cl-const-expr-p (x) - (cond ((consp x) - (or (eq (car x) 'quote) - (and (memq (car x) '(function function*)) - (or (symbolp (nth 1 x)) - (and (eq (car-safe (nth 1 x)) 'lambda) 'func))))) - ((symbolp x) (and (memq x '(nil t)) t)) - (t t))) - -(defun cl-const-exprs-p (xs) - (while (and xs (cl-const-expr-p (car xs))) - (setq xs (cdr xs))) - (not xs)) - -(defun cl-const-expr-val (x) - (and (eq (cl-const-expr-p x) t) (if (consp x) (nth 1 x) x))) - -(defun cl-expr-access-order (x v) - (if (cl-const-expr-p x) v - (if (consp x) - (progn - (while (setq x (cdr x)) (setq v (cl-expr-access-order (car x) v))) - v) - (if (eq x (car v)) (cdr v) '(t))))) - -;;; Count number of times X refers to Y. Return nil for 0 times. -(defun cl-expr-contains (x y) - (cond ((equal y x) 1) - ((and (consp x) (not (memq (car-safe x) '(quote function function*)))) - (let ((sum 0)) - (while x - (setq sum (+ sum (or (cl-expr-contains (pop x) y) 0)))) - (and (> sum 0) sum))) - (t nil))) - -(defun cl-expr-contains-any (x y) - (while (and y (not (cl-expr-contains x (car y)))) (pop y)) - y) - -;;; Check whether X may depend on any of the symbols in Y. -(defun cl-expr-depends-p (x y) - (and (not (cl-const-expr-p x)) - (or (not (cl-safe-expr-p x)) (cl-expr-contains-any x y)))) - - ;;; Compiler macros. (defmacro define-compiler-macro (func args &rest body) -- 2.39.2