Mercurial > hg > xemacs-beta

comparison lisp/byte-optimize.el @ 434:9d177e8d4150 r21-2-25

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-25
author cvs
date Mon, 13 Aug 2007 11:30:53 +0200
parents 3ecd8885ac67
children 8de8e3f6228a
comparison
equal deleted inserted replaced
433:892ca416f0fb 434:9d177e8d4150
697 697
698 (defun byte-optimize-plus (form) 698 (defun byte-optimize-plus (form)
699 (setq form (byte-optimize-delay-constants-math form 1 '+)) 699 (setq form (byte-optimize-delay-constants-math form 1 '+))
700 (if (memq 0 form) (setq form (delq 0 (copy-sequence form)))) 700 (if (memq 0 form) (setq form (delq 0 (copy-sequence form))))
701 ;;(setq form (byte-optimize-associative-two-args-math form)) 701 ;;(setq form (byte-optimize-associative-two-args-math form))
702 (cond ((null (cdr form)) 702 (case (length (cdr form))
703 (condition-case () 703 ((0)
704 (eval form) 704 (condition-case ()
705 (error form))) 705 (eval form)
706 706 (error form)))
707 ;; `add1' and `sub1' are a marginally fewer instructions 707
708 ;; than `plus' and `minus', so use them when possible. 708 ;; `add1' and `sub1' are a marginally fewer instructions
709 ((and (null (nthcdr 3 form)) 709 ;; than `plus' and `minus', so use them when possible.
710 (eq (nth 2 form) 1)) 710 ((2)
711 (list '1+ (nth 1 form))) ; (+ x 1) --> (1+ x) 711 (cond
712 ((and (null (nthcdr 3 form)) 712 ((eq (nth 1 form) 1) `(1+ ,(nth 2 form))) ; (+ 1 x) --> (1+ x)
713 (eq (nth 1 form) 1)) 713 ((eq (nth 2 form) 1) `(1+ ,(nth 1 form))) ; (+ x 1) --> (1+ x)
714 (list '1+ (nth 2 form))) ; (+ 1 x) --> (1+ x) 714 ((eq (nth 1 form) -1) `(1- ,(nth 2 form))) ; (+ -1 x) --> (1- x)
715 ((and (null (nthcdr 3 form)) 715 ((eq (nth 2 form) -1) `(1- ,(nth 1 form))) ; (+ x -1) --> (1- x)
716 (eq (nth 2 form) -1)) 716 (t form)))
717 (list '1- (nth 1 form))) ; (+ x -1) --> (1- x) 717
718 ((and (null (nthcdr 3 form)) 718 ;; It is not safe to delete the function entirely
719 (eq (nth 1 form) -1)) 719 ;; (actually, it would be safe if we know the sole arg
720 (list '1- (nth 2 form))) ; (+ -1 x) --> (1- x) 720 ;; is not a marker).
721 721 ;; ((null (cdr (cdr form))) (nth 1 form))
722 ;;; It is not safe to delete the function entirely 722 (t form)))
723 ;;; (actually, it would be safe if we know the sole arg
724 ;;; is not a marker).
725 ;; ((null (cdr (cdr form))) (nth 1 form))
726 (t form)))
727 723
728 (defun byte-optimize-minus (form) 724 (defun byte-optimize-minus (form)
729 ;; Put constants at the end, except the last constant. 725 ;; Put constants at the end, except the last constant.
730 (setq form (byte-optimize-delay-constants-math form 2 '+)) 726 (setq form (byte-optimize-delay-constants-math form 2 '+))
731 ;; Now only first and last element can be a number. 727 ;; Now only first and last element can be a number.
782 (prog1 (setq form (delq 2 (copy-sequence form))) 778 (prog1 (setq form (delq 2 (copy-sequence form)))
783 (while (not (symbolp (car (setq form (cdr form)))))) 779 (while (not (symbolp (car (setq form (cdr form))))))
784 (setcar form (list '+ (car form) (car form))))) 780 (setcar form (list '+ (car form) (car form)))))
785 (form)))))) 781 (form))))))
786 782
787 (defsubst byte-compile-butlast (form)
788 (nreverse (cdr (reverse form))))
789
790 (defun byte-optimize-divide (form) 783 (defun byte-optimize-divide (form)
791 (setq form (byte-optimize-delay-constants-math form 2 '*)) 784 (setq form (byte-optimize-delay-constants-math form 2 '*))
792 (let ((last (car (reverse (cdr (cdr form)))))) 785 (let ((last (car (reverse (cdr (cdr form))))))
793 (if (numberp last) 786 (if (numberp last)
794 (cond ((= (length form) 3) 787 (cond ((= (length form) 3)
797 (condition-case nil 790 (condition-case nil
798 (/ (nth 1 form) last) 791 (/ (nth 1 form) last)
799 (error nil))) 792 (error nil)))
800 (setq form (list 'progn (/ (nth 1 form) last))))) 793 (setq form (list 'progn (/ (nth 1 form) last)))))
801 ((= last 1) 794 ((= last 1)
802 (setq form (byte-compile-butlast form))) 795 (setq form (butlast form)))
803 ((numberp (nth 1 form)) 796 ((numberp (nth 1 form))
804 (setq form (cons (car form) 797 (setq form (cons (car form)
805 (cons (/ (nth 1 form) last) 798 (cons (/ (nth 1 form) last)
806 (byte-compile-butlast (cdr (cdr form))))) 799 (butlast (cdr (cdr form)))))
807 last nil)))) 800 last nil))))
808 (cond 801 (cond
809 ;;; ((null (cdr (cdr form))) 802 ;;; ((null (cdr (cdr form)))
810 ;;; (nth 1 form)) 803 ;;; (nth 1 form))
811 ((eq (nth 1 form) 0) 804 ((eq (nth 1 form) 0)
812 (append '(progn) (cdr (cdr form)) '(0))) 805 (append '(progn) (cdr (cdr form)) '(0)))
813 ((eq last -1) 806 ((eq last -1)
814 (list '- (if (nthcdr 3 form) 807 (list '- (if (nthcdr 3 form)
815 (byte-compile-butlast form) 808 (butlast form)
816 (nth 1 form)))) 809 (nth 1 form))))
817 (form)))) 810 (form))))
818 811
819 (defun byte-optimize-logmumble (form) 812 (defun byte-optimize-logmumble (form)
820 (setq form (byte-optimize-delay-constants-math form 1 (car form))) 813 (setq form (byte-optimize-delay-constants-math form 1 (car form)))
1030 (put 'and 'byte-optimizer 'byte-optimize-and) 1023 (put 'and 'byte-optimizer 'byte-optimize-and)
1031 (put 'or 'byte-optimizer 'byte-optimize-or) 1024 (put 'or 'byte-optimizer 'byte-optimize-or)
1032 (put 'cond 'byte-optimizer 'byte-optimize-cond) 1025 (put 'cond 'byte-optimizer 'byte-optimize-cond)
1033 (put 'if 'byte-optimizer 'byte-optimize-if) 1026 (put 'if 'byte-optimizer 'byte-optimize-if)
1034 (put 'while 'byte-optimizer 'byte-optimize-while) 1027 (put 'while 'byte-optimizer 'byte-optimize-while)
1028
1029 ;; Remove any reason for avoiding `char-before'.
1030 (defun byte-optimize-char-before (form)
1031 `(char-after (1- ,(or (nth 1 form) '(point))) ,@(cdr (cdr form))))
1032
1033 (put 'char-before 'byte-optimizer 'byte-optimize-char-before)
1035 1034
1036 ;; byte-compile-negation-optimizer lives in bytecomp.el 1035 ;; byte-compile-negation-optimizer lives in bytecomp.el
1037 ;(put '/= 'byte-optimizer 'byte-compile-negation-optimizer) 1036 ;(put '/= 'byte-optimizer 'byte-compile-negation-optimizer)
1038 (put 'atom 'byte-optimizer 'byte-compile-negation-optimizer) 1037 (put 'atom 'byte-optimizer 'byte-compile-negation-optimizer)
1039 (put 'nlistp 'byte-optimizer 'byte-compile-negation-optimizer) 1038 (put 'nlistp 'byte-optimizer 'byte-compile-negation-optimizer)