Mercurial > hg > xemacs-beta

comparison lisp/bytecomp/byte-optimize.el @ 142:1856695b1fa9 r20-2b5

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-2b5
author cvs
date Mon, 13 Aug 2007 09:33:18 +0200
parents 585fb297b004
children 538048ae2ab8
comparison
equal deleted inserted replaced
141:ea67ad3963dc 142:1856695b1fa9
647 ;; (setq form (byte-optimize-nonassociative-math form)) 647 ;; (setq form (byte-optimize-nonassociative-math form))
648 ;; (if (consp form) 648 ;; (if (consp form)
649 ;; (byte-optimize-two-args-right form) 649 ;; (byte-optimize-two-args-right form)
650 ;; form)) 650 ;; form))
651 651
652 ;; jwz: (byte-optimize-approx-equal 0.0 0.0) was returning nil
653 ;; in xemacs 19.15 because it used < instead of <=.
654 (defun byte-optimize-approx-equal (x y) 652 (defun byte-optimize-approx-equal (x y)
655 (<= (* (abs (- x y)) 100) (abs (+ x y)))) 653 (< (* (abs (- x y)) 100) (abs (+ x y))))
656 654
657 ;; Collect all the constants from FORM, after the STARTth arg, 655 ;; Collect all the constants from FORM, after the STARTth arg,
658 ;; and apply FUN to them to make one argument at the end. 656 ;; and apply FUN to them to make one argument at the end.
659 ;; For functions that can handle floats, that optimization 657 ;; For functions that can handle floats, that optimization
660 ;; can be incorrect because reordering can cause an overflow 658 ;; can be incorrect because reordering can cause an overflow
697 ;;(setq form (byte-optimize-associative-two-args-math form)) 695 ;;(setq form (byte-optimize-associative-two-args-math form))
698 (cond ((null (cdr form)) 696 (cond ((null (cdr form))
699 (condition-case () 697 (condition-case ()
700 (eval form) 698 (eval form)
701 (error form))) 699 (error form)))
702
703 ;; `add1' and `sub1' are a marginally fewer instructions
704 ;; than `plus' and `minus', so use them when possible.
705 ((and (null (nthcdr 3 form))
706 (eq (nth 2 form) 1))
707 (list '1+ (nth 1 form))) ; (+ x 1) --> (1+ x)
708 ((and (null (nthcdr 3 form))
709 (eq (nth 1 form) 1))
710 (list '1+ (nth 2 form))) ; (+ 1 x) --> (1+ x)
711 ((and (null (nthcdr 3 form))
712 (eq (nth 2 form) -1))
713 (list '1- (nth 1 form))) ; (+ x -1) --> (1- x)
714 ((and (null (nthcdr 3 form))
715 (eq (nth 1 form) -1))
716 (list '1- (nth 2 form))) ; (+ -1 x) --> (1- x)
717
718 ;;; It is not safe to delete the function entirely 700 ;;; It is not safe to delete the function entirely
719 ;;; (actually, it would be safe if we know the sole arg 701 ;;; (actually, it would be safe if we know the sole arg
720 ;;; is not a marker). 702 ;;; is not a marker).
721 ;; ((null (cdr (cdr form))) (nth 1 form)) 703 ;; ((null (cdr (cdr form))) (nth 1 form))
722 (t form))) 704 (t form)))
733 ;; If form is (- CONST foo... CONST), merge first and last. 715 ;; If form is (- CONST foo... CONST), merge first and last.
734 ((and (numberp (nth 1 form)) 716 ((and (numberp (nth 1 form))
735 (numberp last)) 717 (numberp last))
736 (setq form (nconc (list '- (- (nth 1 form) last) (nth 2 form)) 718 (setq form (nconc (list '- (- (nth 1 form) last) (nth 2 form))
737 (delq last (copy-sequence (nthcdr 3 form)))))))) 719 (delq last (copy-sequence (nthcdr 3 form))))))))
738 (setq form
739 ;;; It is not safe to delete the function entirely 720 ;;; It is not safe to delete the function entirely
740 ;;; (actually, it would be safe if we know the sole arg 721 ;;; (actually, it would be safe if we know the sole arg
741 ;;; is not a marker). 722 ;;; is not a marker).
742 ;;; (if (eq (nth 2 form) 0) 723 ;;; (if (eq (nth 2 form) 0)
743 ;;; (nth 1 form) ; (- x 0) --> x 724 ;;; (nth 1 form) ; (- x 0) --> x
745 (if (and (null (cdr (cdr (cdr form)))) 726 (if (and (null (cdr (cdr (cdr form))))
746 (eq (nth 1 form) 0)) ; (- 0 x) --> (- x) 727 (eq (nth 1 form) 0)) ; (- 0 x) --> (- x)
747 (cons (car form) (cdr (cdr form))) 728 (cons (car form) (cdr (cdr form)))
748 form)) 729 form))
749 ;;; ) 730 ;;; )
750 )
751
752 ;; `add1' and `sub1' are a marginally fewer instructions than `plus'
753 ;; and `minus', so use them when possible.
754 (cond ((and (null (nthcdr 3 form))
755 (eq (nth 2 form) 1))
756 (list '1- (nth 1 form))) ; (- x 1) --> (1- x)
757 ((and (null (nthcdr 3 form))
758 (eq (nth 2 form) -1))
759 (list '1+ (nth 1 form))) ; (- x -1) --> (1+ x)
760 (t
761 form))
762 ) 731 )
763 732
764 (defun byte-optimize-multiply (form) 733 (defun byte-optimize-multiply (form)
765 (setq form (byte-optimize-delay-constants-math form 1 '*)) 734 (setq form (byte-optimize-delay-constants-math form 1 '*))
766 ;; If there is a constant in FORM, it is now the last element. 735 ;; If there is a constant in FORM, it is now the last element.