Mercurial > hg > xemacs-beta

comparison lisp/bytecomp/byte-optimize.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 56c54cf7c5b6
children 364816949b59
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
271 (progn 271 (progn
272 (byte-compile-warn "attempt to inline %s before it was defined" name) 272 (byte-compile-warn "attempt to inline %s before it was defined" name)
273 form) 273 form)
274 ;; else 274 ;; else
275 (if (and (consp fn) (eq (car fn) 'autoload)) 275 (if (and (consp fn) (eq (car fn) 'autoload))
276 (progn 276 (load (nth 1 fn)))
277 (load (nth 1 fn))
278 (setq fn (or (cdr (assq name byte-compile-function-environment))
279 (and (fboundp name) (symbol-function name))))))
280 (if (and (consp fn) (eq (car fn) 'autoload)) 277 (if (and (consp fn) (eq (car fn) 'autoload))
281 (error "file \"%s\" didn't define \"%s\"" (nth 1 fn) name)) 278 (error "file \"%s\" didn't define \"%s\"" (nth 1 fn) name))
282 (if (symbolp fn) 279 (if (symbolp fn)
283 (byte-compile-inline-expand (cons fn (cdr form))) 280 (byte-compile-inline-expand (cons fn (cdr form)))
284 (if (compiled-function-p fn) 281 (if (compiled-function-p fn)
647 ;; (setq form (byte-optimize-nonassociative-math form)) 644 ;; (setq form (byte-optimize-nonassociative-math form))
648 ;; (if (consp form) 645 ;; (if (consp form)
649 ;; (byte-optimize-two-args-right form) 646 ;; (byte-optimize-two-args-right form)
650 ;; form)) 647 ;; form))
651 648
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) 649 (defun byte-optimize-approx-equal (x y)
655 (<= (* (abs (- x y)) 100) (abs (+ x y)))) 650 (< (* (abs (- x y)) 100) (abs (+ x y))))
656 651
657 ;; Collect all the constants from FORM, after the STARTth arg, 652 ;; Collect all the constants from FORM, after the STARTth arg,
658 ;; and apply FUN to them to make one argument at the end. 653 ;; and apply FUN to them to make one argument at the end.
659 ;; For functions that can handle floats, that optimization 654 ;; For functions that can handle floats, that optimization
660 ;; can be incorrect because reordering can cause an overflow 655 ;; can be incorrect because reordering can cause an overflow
697 ;;(setq form (byte-optimize-associative-two-args-math form)) 692 ;;(setq form (byte-optimize-associative-two-args-math form))
698 (cond ((null (cdr form)) 693 (cond ((null (cdr form))
699 (condition-case () 694 (condition-case ()
700 (eval form) 695 (eval form)
701 (error form))) 696 (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 697 ;;; It is not safe to delete the function entirely
719 ;;; (actually, it would be safe if we know the sole arg 698 ;;; (actually, it would be safe if we know the sole arg
720 ;;; is not a marker). 699 ;;; is not a marker).
721 ;; ((null (cdr (cdr form))) (nth 1 form)) 700 ;; ((null (cdr (cdr form))) (nth 1 form))
722 (t form))) 701 (t form)))
733 ;; If form is (- CONST foo... CONST), merge first and last. 712 ;; If form is (- CONST foo... CONST), merge first and last.
734 ((and (numberp (nth 1 form)) 713 ((and (numberp (nth 1 form))
735 (numberp last)) 714 (numberp last))
736 (setq form (nconc (list '- (- (nth 1 form) last) (nth 2 form)) 715 (setq form (nconc (list '- (- (nth 1 form) last) (nth 2 form))
737 (delq last (copy-sequence (nthcdr 3 form)))))))) 716 (delq last (copy-sequence (nthcdr 3 form))))))))
738 (setq form
739 ;;; It is not safe to delete the function entirely 717 ;;; It is not safe to delete the function entirely
740 ;;; (actually, it would be safe if we know the sole arg 718 ;;; (actually, it would be safe if we know the sole arg
741 ;;; is not a marker). 719 ;;; is not a marker).
742 ;;; (if (eq (nth 2 form) 0) 720 ;;; (if (eq (nth 2 form) 0)
743 ;;; (nth 1 form) ; (- x 0) --> x 721 ;;; (nth 1 form) ; (- x 0) --> x
745 (if (and (null (cdr (cdr (cdr form)))) 723 (if (and (null (cdr (cdr (cdr form))))
746 (eq (nth 1 form) 0)) ; (- 0 x) --> (- x) 724 (eq (nth 1 form) 0)) ; (- 0 x) --> (- x)
747 (cons (car form) (cdr (cdr form))) 725 (cons (car form) (cdr (cdr form)))
748 form)) 726 form))
749 ;;; ) 727 ;;; )
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 ) 728 )
763 729
764 (defun byte-optimize-multiply (form) 730 (defun byte-optimize-multiply (form)
765 (setq form (byte-optimize-delay-constants-math form 1 '*)) 731 (setq form (byte-optimize-delay-constants-math form 1 '*))
766 ;; If there is a constant in FORM, it is now the last element. 732 ;; If there is a constant in FORM, it is now the last element.