Mercurial > hg > xemacs-beta

comparison lisp/byte-optimize.el @ 400:a86b2b5e0111 r21-2-30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-30
author cvs
date Mon, 13 Aug 2007 11:14:34 +0200
parents 74fd4e045ea6
children 697ef44129c6
comparison
equal deleted inserted replaced
399:376370fb5946 400:a86b2b5e0111
471 (setq backwards (cdr backwards))) 471 (setq backwards (cdr backwards)))
472 (if (and (cdr form) (null backwards)) 472 (if (and (cdr form) (null backwards))
473 (byte-compile-log 473 (byte-compile-log
474 " all subforms of %s called for effect; deleted" form)) 474 " all subforms of %s called for effect; deleted" form))
475 (and backwards 475 (and backwards
476 ;; Now optimize the rest of the forms. We need the return
477 ;; values. We already did the car.
478 (setcdr backwards
479 (mapcar 'byte-optimize-form (cdr backwards)))
476 (cons fn (nreverse backwards)))) 480 (cons fn (nreverse backwards))))
477 (cons fn (mapcar 'byte-optimize-form (cdr form))))) 481 (cons fn (mapcar 'byte-optimize-form (cdr form)))))
478 482
479 ((eq fn 'interactive) 483 ((eq fn 'interactive)
480 (byte-compile-warn "misplaced interactive spec: %s" 484 (byte-compile-warn "misplaced interactive spec: %s"
697 701
698 (defun byte-optimize-plus (form) 702 (defun byte-optimize-plus (form)
699 (setq form (byte-optimize-delay-constants-math form 1 '+)) 703 (setq form (byte-optimize-delay-constants-math form 1 '+))
700 (if (memq 0 form) (setq form (delq 0 (copy-sequence form)))) 704 (if (memq 0 form) (setq form (delq 0 (copy-sequence form))))
701 ;;(setq form (byte-optimize-associative-two-args-math form)) 705 ;;(setq form (byte-optimize-associative-two-args-math form))
706
702 (case (length (cdr form)) 707 (case (length (cdr form))
703 ((0) 708 ((0) ; (+)
704 (condition-case () 709 (condition-case ()
705 (eval form) 710 (eval form)
706 (error form))) 711 (error form)))
707 712
708 ;; `add1' and `sub1' are a marginally fewer instructions
709 ;; than `plus' and `minus', so use them when possible.
710 ((2)
711 (cond
712 ((eq (nth 1 form) 1) `(1+ ,(nth 2 form))) ; (+ 1 x) --> (1+ x)
713 ((eq (nth 2 form) 1) `(1+ ,(nth 1 form))) ; (+ x 1) --> (1+ x)
714 ((eq (nth 1 form) -1) `(1- ,(nth 2 form))) ; (+ -1 x) --> (1- x)
715 ((eq (nth 2 form) -1) `(1- ,(nth 1 form))) ; (+ x -1) --> (1- x)
716 (t form)))
717
718 ;; It is not safe to delete the function entirely 713 ;; It is not safe to delete the function entirely
719 ;; (actually, it would be safe if we know the sole arg 714 ;; (actually, it would be safe if we knew the sole arg
720 ;; is not a marker). 715 ;; is not a marker).
721 ;; ((null (cdr (cdr form))) (nth 1 form)) 716 ;; ((1)
722 (t form))) 717 ;; (nth 1 form))
718
719 ((2) ; (+ x y)
720 (byte-optimize-predicate
721 (cond
722 ;; `add1' and `sub1' are a marginally fewer instructions
723 ;; than `plus' and `minus', so use them when possible.
724 ((eq (nth 1 form) 1) `(1+ ,(nth 2 form))) ; (+ 1 x) --> (1+ x)
725 ((eq (nth 2 form) 1) `(1+ ,(nth 1 form))) ; (+ x 1) --> (1+ x)
726 ((eq (nth 1 form) -1) `(1- ,(nth 2 form))) ; (+ -1 x) --> (1- x)
727 ((eq (nth 2 form) -1) `(1- ,(nth 1 form))) ; (+ x -1) --> (1- x)
728 (t form))))
729
730 (t (byte-optimize-predicate form))))
723 731
724 (defun byte-optimize-minus (form) 732 (defun byte-optimize-minus (form)
725 ;; Put constants at the end, except the last constant. 733 ;; Put constants at the end, except the last constant.
726 (setq form (byte-optimize-delay-constants-math form 2 '+)) 734 (setq form (byte-optimize-delay-constants-math form 2 '+))
727 ;; Now only first and last element can be a number. 735 ;; Now only first and last element can be an integer.
728 (let ((last (car (reverse (nthcdr 3 form))))) 736 (let ((last (last (nthcdr 3 form))))
729 (cond ((eq 0 last) 737 (cond ((eq 0 last)
730 ;; (- x y ... 0) --> (- x y ...) 738 ;; (- x y ... 0) --> (- x y ...)
731 (setq form (copy-sequence form)) 739 (setq form (copy-sequence form))
732 (setcdr (cdr (cdr form)) (delq 0 (nthcdr 3 form)))) 740 (setcdr (cdr (cdr form)) (delq 0 (nthcdr 3 form))))
733 ;; If form is (- CONST foo... CONST), merge first and last. 741 ;; If form is (- CONST foo... CONST), merge first and last.
734 ((and (numberp (nth 1 form)) 742 ((and (numberp (nth 1 form))
735 (numberp last)) 743 (numberp last))
736 (setq form (nconc (list '- (- (nth 1 form) last) (nth 2 form)) 744 (setq form (nconc (list '- (- (nth 1 form) last) (nth 2 form))
737 (delq last (copy-sequence (nthcdr 3 form)))))))) 745 (delq last (copy-sequence (nthcdr 3 form))))))))
738 (setq form 746
739 ;;; It is not safe to delete the function entirely 747 (case (length (cdr form))
740 ;;; (actually, it would be safe if we know the sole arg 748 ((0) ; (-)
741 ;;; is not a marker). 749 (condition-case ()
742 ;;; (if (eq (nth 2 form) 0) 750 (eval form)
743 ;;; (nth 1 form) ; (- x 0) --> x 751 (error form)))
744 (byte-optimize-predicate 752
745 (if (and (null (cdr (cdr (cdr form)))) 753 ;; It is not safe to delete the function entirely
746 (eq (nth 1 form) 0)) ; (- 0 x) --> (- x) 754 ;; (actually, it would be safe if we knew the sole arg
747 (cons (car form) (cdr (cdr form))) 755 ;; is not a marker).
748 form)) 756 ;; ((1)
749 ;;; ) 757 ;; (nth 1 form)
750 ) 758
751 759 ((2) ; (+ x y)
752 ;; `add1' and `sub1' are a marginally fewer instructions than `plus' 760 (byte-optimize-predicate
753 ;; and `minus', so use them when possible. 761 (cond
754 (cond ((and (null (nthcdr 3 form)) 762 ;; `add1' and `sub1' are a marginally fewer instructions than `plus'
755 (eq (nth 2 form) 1)) 763 ;; and `minus', so use them when possible.
756 (list '1- (nth 1 form))) ; (- x 1) --> (1- x) 764 ((eq (nth 2 form) 1) `(1- ,(nth 1 form))) ; (- x 1) --> (1- x)
757 ((and (null (nthcdr 3 form)) 765 ((eq (nth 2 form) -1) `(1+ ,(nth 1 form))) ; (- x -1) --> (1+ x)
758 (eq (nth 2 form) -1)) 766 ((eq (nth 1 form) 0) `(- ,(nth 2 form))) ; (- 0 x) --> (- x)
759 (list '1+ (nth 1 form))) ; (- x -1) --> (1+ x) 767 (t form))))
760 (t 768
761 form)) 769 (t (byte-optimize-predicate form))))
762 )
763 770
764 (defun byte-optimize-multiply (form) 771 (defun byte-optimize-multiply (form)
765 (setq form (byte-optimize-delay-constants-math form 1 '*)) 772 (setq form (byte-optimize-delay-constants-math form 1 '*))
766 ;; If there is a constant in FORM, it is now the last element. 773 ;; If there is a constant integer in FORM, it is now the last element.
767 (cond ((null (cdr form)) 1) 774 (cond ((null (cdr form)) 1)
768 ;;; It is not safe to delete the function entirely 775 ;;; It is not safe to delete the function entirely
769 ;;; (actually, it would be safe if we know the sole arg 776 ;;; (actually, it would be safe if we know the sole arg
770 ;;; is not a marker or if it appears in other arithmetic). 777 ;;; is not a marker or if it appears in other arithmetic).
771 ;;; ((null (cdr (cdr form))) (nth 1 form)) 778 ;;; ((null (cdr (cdr form))) (nth 1 form))
772 ((let ((last (car (reverse form)))) 779 ((let ((last (last form)))
773 (cond ((eq 0 last) (cons 'progn (cdr form))) 780 (byte-optimize-predicate
774 ((eq 1 last) (delq 1 (copy-sequence form))) 781 (cond ((eq 0 last) (cons 'progn (cdr form)))
775 ((eq -1 last) (list '- (delq -1 (copy-sequence form)))) 782 ((eq 1 last) (delq 1 (copy-sequence form)))
776 ((and (eq 2 last) 783 ((eq -1 last) (list '- (delq -1 (copy-sequence form))))
777 (memq t (mapcar 'symbolp (cdr form)))) 784 ((and (eq 2 last)
778 (prog1 (setq form (delq 2 (copy-sequence form))) 785 (memq t (mapcar 'symbolp (cdr form))))
779 (while (not (symbolp (car (setq form (cdr form)))))) 786 (prog1 (setq form (delq 2 (copy-sequence form)))
780 (setcar form (list '+ (car form) (car form))))) 787 (while (not (symbolp (car (setq form (cdr form))))))
781 (form)))))) 788 (setcar form (list '+ (car form) (car form)))))
789 (form)))))))
782 790
783 (defun byte-optimize-divide (form) 791 (defun byte-optimize-divide (form)
784 (setq form (byte-optimize-delay-constants-math form 2 '*)) 792 (setq form (byte-optimize-delay-constants-math form 2 '*))
785 (let ((last (car (reverse (cdr (cdr form)))))) 793 ;; If there is a constant integer in FORM, it is now the last element.
794 (let ((last (last (cdr (cdr form)))))
786 (if (numberp last) 795 (if (numberp last)
787 (cond ((= (length form) 3) 796 (cond ((= (length form) 3)
788 (if (and (numberp (nth 1 form)) 797 (if (and (numberp (nth 1 form))
789 (not (zerop last)) 798 (not (zerop last))
790 (condition-case nil 799 (condition-case nil
799 (butlast (cdr (cdr form))))) 808 (butlast (cdr (cdr form)))))
800 last nil)))) 809 last nil))))
801 (cond 810 (cond
802 ;;; ((null (cdr (cdr form))) 811 ;;; ((null (cdr (cdr form)))
803 ;;; (nth 1 form)) 812 ;;; (nth 1 form))
804 ((eq (nth 1 form) 0) 813 ((eq (nth 1 form) 0)
805 (append '(progn) (cdr (cdr form)) '(0))) 814 (append '(progn) (cdr (cdr form)) '(0)))
806 ((eq last -1) 815 ((eq last -1)
807 (list '- (if (nthcdr 3 form) 816 (list '- (if (nthcdr 3 form)
808 (butlast form) 817 (butlast form)
809 (nth 1 form)))) 818 (nth 1 form))))
810 (form)))) 819 (form))))
811 820
812 (defun byte-optimize-logmumble (form) 821 (defun byte-optimize-logmumble (form)
813 (setq form (byte-optimize-delay-constants-math form 1 (car form))) 822 (setq form (byte-optimize-delay-constants-math form 1 (car form)))
814 (byte-optimize-predicate 823 (byte-optimize-predicate
815 (cond ((memq 0 form) 824 (cond ((memq 0 form)