Mercurial > hg > xemacs-beta

comparison lisp/byte-optimize.el @ 448:3078fd1074e8 r21-2-39

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-39
author cvs
date Mon, 13 Aug 2007 11:38:25 +0200
parents 1ccc32a20af4
children 3d3049ae1304
comparison
equal deleted inserted replaced
447:4fc5f13f3bd3 448:3078fd1074e8
937 rest (setcdr (memq (car rest) form) nil)))) 937 rest (setcdr (memq (car rest) form) nil))))
938 (if (cdr (cdr form)) 938 (if (cdr (cdr form))
939 (byte-optimize-predicate form) 939 (byte-optimize-predicate form)
940 (nth 1 form)))) 940 (nth 1 form))))
941 941
942 ;;; For the byte optimizer, `cond' is just overly sweet syntactic sugar.
943 ;;; So we rewrite (cond ...) in terms of `if' and `or',
944 ;;; which are easier to optimize.
942 (defun byte-optimize-cond (form) 945 (defun byte-optimize-cond (form)
943 ;; if any clauses have a literal nil as their test, throw them away. 946 (byte-optimize-cond-1 (cdr form)))
944 ;; if any clause has a literal non-nil constant as its test, throw 947
945 ;; away all following clauses. 948 (defun byte-optimize-cond-1 (clauses)
946 (let (rest) 949 (cond
947 ;; This must be first, to reduce (cond (t ...) (nil)) to (progn t ...) 950 ((null clauses) nil)
948 (while (setq rest (assq nil (cdr form))) 951 ((consp (car clauses))
949 (setq form (delq rest (copy-sequence form)))) 952 (nconc
950 (if (memq nil (cdr form)) 953 (case (length (car clauses))
951 (setq form (delq nil (copy-sequence form)))) 954 (1 `(or ,(nth 0 (car clauses))))
952 (setq rest form) 955 (2 `(if ,(nth 0 (car clauses)) ,(nth 1 (car clauses))))
953 (while (setq rest (cdr rest)) 956 (t `(if ,(nth 0 (car clauses)) (progn ,@(cdr (car clauses))))))
954 (cond ((byte-compile-trueconstp (car-safe (car rest))) 957 (when (cdr clauses) (list (byte-optimize-cond-1 (cdr clauses))))))
955 (cond ((eq rest (cdr form)) 958 (t (error "malformed cond clause %s" (car clauses)))))
956 (setq form
957 (if (cdr (car rest))
958 (if (cdr (cdr (car rest)))
959 (cons 'progn (cdr (car rest)))
960 (nth 1 (car rest)))
961 (car (car rest)))))
962 ((cdr rest)
963 (setq form (copy-sequence form))
964 (setcdr (memq (car rest) form) nil)))
965 (setq rest nil)))))
966 ;;
967 ;; Turn (cond (( <x> )) ... ) into (or <x> (cond ... ))
968 (if (eq 'cond (car-safe form))
969 (let ((clauses (cdr form)))
970 (if (and (consp (car clauses))
971 (null (cdr (car clauses))))
972 (list 'or (car (car clauses))
973 (byte-optimize-cond
974 (cons (car form) (cdr (cdr form)))))
975 form))
976 form))
977 959
978 (defun byte-optimize-if (form) 960 (defun byte-optimize-if (form)
979 ;; (if <true-constant> <then> <else...>) ==> <then> 961 ;; (if <true-constant> <then> <else...>) ==> <then>
980 ;; (if <false-constant> <then> <else...>) ==> (progn <else...>) 962 ;; (if <false-constant> <then> <else...>) ==> (progn <else...>)
981 ;; (if <test> nil <else...>) ==> (if (not <test>) (progn <else...>)) 963 ;; (if <test> nil <else...>) ==> (if (not <test>) (progn <else...>))