Mercurial > hg > xemacs-beta

comparison lisp/bytecomp/byte-optimize.el @ 151:59463afc5666 r20-3b2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b2
author cvs
date Mon, 13 Aug 2007 09:37:19 +0200
parents 538048ae2ab8
children 28f395d8dc7a
comparison
equal deleted inserted replaced
150:8ebb1c0f0f6f 151:59463afc5666
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 <=.
652 (defun byte-optimize-approx-equal (x y) 654 (defun byte-optimize-approx-equal (x y)
653 (< (* (abs (- x y)) 100) (abs (+ x y)))) 655 (<= (* (abs (- x y)) 100) (abs (+ x y))))
654 656
655 ;; Collect all the constants from FORM, after the STARTth arg, 657 ;; Collect all the constants from FORM, after the STARTth arg,
656 ;; and apply FUN to them to make one argument at the end. 658 ;; and apply FUN to them to make one argument at the end.
657 ;; For functions that can handle floats, that optimization 659 ;; For functions that can handle floats, that optimization
658 ;; can be incorrect because reordering can cause an overflow 660 ;; can be incorrect because reordering can cause an overflow
695 ;;(setq form (byte-optimize-associative-two-args-math form)) 697 ;;(setq form (byte-optimize-associative-two-args-math form))
696 (cond ((null (cdr form)) 698 (cond ((null (cdr form))
697 (condition-case () 699 (condition-case ()
698 (eval form) 700 (eval form)
699 (error form))) 701 (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
700 ;;; It is not safe to delete the function entirely 718 ;;; It is not safe to delete the function entirely
701 ;;; (actually, it would be safe if we know the sole arg 719 ;;; (actually, it would be safe if we know the sole arg
702 ;;; is not a marker). 720 ;;; is not a marker).
703 ;; ((null (cdr (cdr form))) (nth 1 form)) 721 ;; ((null (cdr (cdr form))) (nth 1 form))
704 (t form))) 722 (t form)))
715 ;; If form is (- CONST foo... CONST), merge first and last. 733 ;; If form is (- CONST foo... CONST), merge first and last.
716 ((and (numberp (nth 1 form)) 734 ((and (numberp (nth 1 form))
717 (numberp last)) 735 (numberp last))
718 (setq form (nconc (list '- (- (nth 1 form) last) (nth 2 form)) 736 (setq form (nconc (list '- (- (nth 1 form) last) (nth 2 form))
719 (delq last (copy-sequence (nthcdr 3 form)))))))) 737 (delq last (copy-sequence (nthcdr 3 form))))))))
738 (setq form
720 ;;; It is not safe to delete the function entirely 739 ;;; It is not safe to delete the function entirely
721 ;;; (actually, it would be safe if we know the sole arg 740 ;;; (actually, it would be safe if we know the sole arg
722 ;;; is not a marker). 741 ;;; is not a marker).
723 ;;; (if (eq (nth 2 form) 0) 742 ;;; (if (eq (nth 2 form) 0)
724 ;;; (nth 1 form) ; (- x 0) --> x 743 ;;; (nth 1 form) ; (- x 0) --> x
726 (if (and (null (cdr (cdr (cdr form)))) 745 (if (and (null (cdr (cdr (cdr form))))
727 (eq (nth 1 form) 0)) ; (- 0 x) --> (- x) 746 (eq (nth 1 form) 0)) ; (- 0 x) --> (- x)
728 (cons (car form) (cdr (cdr form))) 747 (cons (car form) (cdr (cdr form)))
729 form)) 748 form))
730 ;;; ) 749 ;;; )
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))
731 ) 762 )
732 763
733 (defun byte-optimize-multiply (form) 764 (defun byte-optimize-multiply (form)
734 (setq form (byte-optimize-delay-constants-math form 1 '*)) 765 (setq form (byte-optimize-delay-constants-math form 1 '*))
735 ;; If there is a constant in FORM, it is now the last element. 766 ;; If there is a constant in FORM, it is now the last element.