Mercurial > hg > xemacs-beta

comparison lisp/mule/ccl.el @ 5366:f00192e1cd49

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Examining the result of #'length: `eql', not `=', it's better style & cheaper 2011-03-08 Aidan Kehoe <kehoea@parhasard.net> * buff-menu.el (list-buffers-noselect): * byte-optimize.el (byte-optimize-identity): * byte-optimize.el (byte-optimize-if): * byte-optimize.el (byte-optimize-nth): * byte-optimize.el (byte-optimize-nthcdr): * bytecomp.el (byte-compile-warn-wrong-args): * bytecomp.el (byte-compile-two-args-19->20): * bytecomp.el (byte-compile-list): * bytecomp.el (byte-compile-beginning-of-line): * bytecomp.el (byte-compile-set): * bytecomp.el (byte-compile-set-default): * bytecomp.el (byte-compile-values): * bytecomp.el (byte-compile-values-list): * bytecomp.el (byte-compile-integerp): * bytecomp.el (byte-compile-multiple-value-list-internal): * bytecomp.el (byte-compile-throw): * cl-macs.el (cl-do-arglist): * cl-macs.el (cl-parse-loop-clause): * cl-macs.el (multiple-value-bind): * cl-macs.el (multiple-value-setq): * cl-macs.el (get-setf-method): * cmdloop.el (command-error): * cmdloop.el (y-or-n-p-minibuf): * cmdloop.el (yes-or-no-p-minibuf): * coding.el (unencodable-char-position): * cus-edit.el (custom-face-prompt): * cus-edit.el (custom-buffer-create-internal): * cus-edit.el (widget-face-action): * cus-edit.el (custom-group-value-create): * descr-text.el (describe-char-unicode-data): * dialog-gtk.el (popup-builtin-question-dialog): * dragdrop.el (experimental-dragdrop-drop-log-function): * dragdrop.el (experimental-dragdrop-drop-mime-default): * easymenu.el (easy-menu-add): * easymenu.el (easy-menu-remove): * faces.el (read-face-name): * faces.el (set-face-stipple): * files.el (file-name-non-special): * font.el (font-combine-fonts): * font.el (font-set-face-font): * font.el (font-parse-rgb-components): * font.el (font-rgb-color-p): * font.el (font-color-rgb-components): * gnuserv.el (gnuserv-edit-files): * help.el (key-or-menu-binding): * help.el (function-documentation-1): * help.el (function-documentation): * info.el (info): * isearch-mode.el (isearch-exit): * isearch-mode.el (isearch-edit-string): * isearch-mode.el (isearch-*-char): * isearch-mode.el (isearch-complete1): * ldap.el (ldap-encode-country-string): * ldap.el (ldap-decode-string): * minibuf.el (read-file-name-internal-1): * minibuf.el (read-non-nil-coding-system): * minibuf.el (get-user-response): * mouse.el (drag-window-divider): * mule/ccl.el: * mule/ccl.el (ccl-compile-if): * mule/ccl.el (ccl-compile-break): * mule/ccl.el (ccl-compile-repeat): * mule/ccl.el (ccl-compile-write-repeat): * mule/ccl.el (ccl-compile-call): * mule/ccl.el (ccl-compile-end): * mule/ccl.el (ccl-compile-read-multibyte-character): * mule/ccl.el (ccl-compile-write-multibyte-character): * mule/ccl.el (ccl-compile-translate-character): * mule/ccl.el (ccl-compile-mule-to-unicode): * mule/ccl.el (ccl-compile-unicode-to-mule): * mule/ccl.el (ccl-compile-lookup-integer): * mule/ccl.el (ccl-compile-lookup-character): * mule/ccl.el (ccl-compile-map-multiple): * mule/ccl.el (ccl-compile-map-single): * mule/devan-util.el (devanagari-compose-to-one-glyph): * mule/devan-util.el (devanagari-composition-component): * mule/mule-cmds.el (finish-set-language-environment): * mule/viet-util.el: * mule/viet-util.el (viet-encode-viscii-char): * multicast.el (open-multicast-group): * newcomment.el (comment-quote-nested): * newcomment.el (comment-region): * newcomment.el (comment-dwim): * regexp-opt.el (regexp-opt-group): * replace.el (map-query-replace-regexp): * specifier.el (derive-device-type-from-tag-set): * subr.el (skip-chars-quote): * test-harness.el (test-harness-from-buffer): * test-harness.el (batch-test-emacs): * wid-edit.el (widget-choice-action): * wid-edit.el (widget-symbol-prompt-internal): * wid-edit.el (widget-color-action): * window-xemacs.el (push-window-configuration): * window-xemacs.el (pop-window-configuration): * window.el (quit-window): * x-compose.el (electric-diacritic): It's better style, and cheaper (often one assembler instruction vs. a C funcall in the byte code), to use `eql' instead of `=' when it's clear what numerical type a given result will be. Change much of our code to do this, with the help of a byte-compiler change (not comitted) that looked for calls to #'length (which always returns an integer) in its args.
author Aidan Kehoe <kehoea@parhasard.net>
date Tue, 08 Mar 2011 23:41:52 +0000
parents 476d0799d704
children 3889ef128488 ac37a5f7e5be
comparison
equal deleted inserted replaced
5365:dbae25a8949d 5366:f00192e1cd49
471 471
472 ;; Compile IF statement of the form `(if CONDITION TRUE-PART FALSE-PART)'. 472 ;; Compile IF statement of the form `(if CONDITION TRUE-PART FALSE-PART)'.
473 ;; If READ-FLAG is non-nil, this statement has the form 473 ;; If READ-FLAG is non-nil, this statement has the form
474 ;; `(read-if (REG OPERATOR ARG) TRUE-PART FALSE-PART)'. 474 ;; `(read-if (REG OPERATOR ARG) TRUE-PART FALSE-PART)'.
475 (defun ccl-compile-if (cmd &optional read-flag) 475 (defun ccl-compile-if (cmd &optional read-flag)
476 (if (and (/= (length cmd) 3) (/= (length cmd) 4)) 476 (if (and (not (<= 3 (length cmd) 4)))
477 (error "CCL: Invalid number of arguments: %s" cmd)) 477 (error "CCL: Invalid number of arguments: %s" cmd))
478 (let ((condition (nth 1 cmd)) 478 (let ((condition (nth 1 cmd))
479 (true-cmds (nth 2 cmd)) 479 (true-cmds (nth 2 cmd))
480 (false-cmds (nth 3 cmd)) 480 (false-cmds (nth 3 cmd))
481 jump-cond-address) 481 jump-cond-address)
644 (setq ccl-breaks (cdr ccl-breaks)))) 644 (setq ccl-breaks (cdr ccl-breaks))))
645 nil)))) 645 nil))))
646 646
647 ;; Compile BREAK statement. 647 ;; Compile BREAK statement.
648 (defun ccl-compile-break (cmd) 648 (defun ccl-compile-break (cmd)
649 (if (/= (length cmd) 1) 649 (if (not (eql (length cmd) 1))
650 (error "CCL: Invalid number of arguments: %s" cmd)) 650 (error "CCL: Invalid number of arguments: %s" cmd))
651 (if (null ccl-loop-head) 651 (if (null ccl-loop-head)
652 (error "CCL: No outer loop: %s" cmd)) 652 (error "CCL: No outer loop: %s" cmd))
653 (setq ccl-breaks (cons ccl-current-ic ccl-breaks)) 653 (setq ccl-breaks (cons ccl-current-ic ccl-breaks))
654 (ccl-embed-code 'jump 0 0) 654 (ccl-embed-code 'jump 0 0)
655 t) 655 t)
656 656
657 ;; Compile REPEAT statement. 657 ;; Compile REPEAT statement.
658 (defun ccl-compile-repeat (cmd) 658 (defun ccl-compile-repeat (cmd)
659 (if (/= (length cmd) 1) 659 (if (not (eql (length cmd) 1))
660 (error "CCL: Invalid number of arguments: %s" cmd)) 660 (error "CCL: Invalid number of arguments: %s" cmd))
661 (if (null ccl-loop-head) 661 (if (null ccl-loop-head)
662 (error "CCL: No outer loop: %s" cmd)) 662 (error "CCL: No outer loop: %s" cmd))
663 (ccl-embed-code 'jump 0 ccl-loop-head) 663 (ccl-embed-code 'jump 0 ccl-loop-head)
664 t) 664 t)
665 665
666 ;; Compile WRITE-REPEAT statement. 666 ;; Compile WRITE-REPEAT statement.
667 (defun ccl-compile-write-repeat (cmd) 667 (defun ccl-compile-write-repeat (cmd)
668 (if (/= (length cmd) 2) 668 (if (not (eql (length cmd) 2))
669 (error "CCL: Invalid number of arguments: %s" cmd)) 669 (error "CCL: Invalid number of arguments: %s" cmd))
670 (if (null ccl-loop-head) 670 (if (null ccl-loop-head)
671 (error "CCL: No outer loop: %s" cmd)) 671 (error "CCL: No outer loop: %s" cmd))
672 (let ((arg (nth 1 cmd))) 672 (let ((arg (nth 1 cmd)))
673 (cond ((integer-or-char-p arg) 673 (cond ((integer-or-char-p arg)
781 (error "CCL: Invalid argument: %s" cmd)))) 781 (error "CCL: Invalid argument: %s" cmd))))
782 nil) 782 nil)
783 783
784 ;; Compile CALL statement. 784 ;; Compile CALL statement.
785 (defun ccl-compile-call (cmd) 785 (defun ccl-compile-call (cmd)
786 (if (/= (length cmd) 2) 786 (if (not (eql (length cmd) 2))
787 (error "CCL: Invalid number of arguments: %s" cmd)) 787 (error "CCL: Invalid number of arguments: %s" cmd))
788 (if (not (symbolp (nth 1 cmd))) 788 (if (not (symbolp (nth 1 cmd)))
789 (error "CCL: Subroutine should be a symbol: %s" cmd)) 789 (error "CCL: Subroutine should be a symbol: %s" cmd))
790 (ccl-embed-code 'call 1 0) 790 (ccl-embed-code 'call 1 0)
791 (ccl-embed-symbol (nth 1 cmd) 'ccl-program-idx) 791 (ccl-embed-symbol (nth 1 cmd) 'ccl-program-idx)
792 nil) 792 nil)
793 793
794 ;; Compile END statement. 794 ;; Compile END statement.
795 (defun ccl-compile-end (cmd) 795 (defun ccl-compile-end (cmd)
796 (if (/= (length cmd) 1) 796 (if (not (eql (length cmd) 1))
797 (error "CCL: Invalid number of arguments: %s" cmd)) 797 (error "CCL: Invalid number of arguments: %s" cmd))
798 (ccl-embed-code 'end 0 0) 798 (ccl-embed-code 'end 0 0)
799 t) 799 t)
800 800
801 ;; Compile read-multibyte-character 801 ;; Compile read-multibyte-character
802 (defun ccl-compile-read-multibyte-character (cmd) 802 (defun ccl-compile-read-multibyte-character (cmd)
803 (if (/= (length cmd) 3) 803 (if (not (eql (length cmd) 3))
804 (error "CCL: Invalid number of arguments: %s" cmd)) 804 (error "CCL: Invalid number of arguments: %s" cmd))
805 (let ((RRR (nth 1 cmd)) 805 (let ((RRR (nth 1 cmd))
806 (rrr (nth 2 cmd))) 806 (rrr (nth 2 cmd)))
807 (ccl-check-register rrr cmd) 807 (ccl-check-register rrr cmd)
808 (ccl-check-register RRR cmd) 808 (ccl-check-register RRR cmd)
809 (ccl-embed-extended-command 'read-multibyte-character rrr RRR 0)) 809 (ccl-embed-extended-command 'read-multibyte-character rrr RRR 0))
810 nil) 810 nil)
811 811
812 ;; Compile write-multibyte-character 812 ;; Compile write-multibyte-character
813 (defun ccl-compile-write-multibyte-character (cmd) 813 (defun ccl-compile-write-multibyte-character (cmd)
814 (if (/= (length cmd) 3) 814 (if (not (eql (length cmd) 3))
815 (error "CCL: Invalid number of arguments: %s" cmd)) 815 (error "CCL: Invalid number of arguments: %s" cmd))
816 (let ((RRR (nth 1 cmd)) 816 (let ((RRR (nth 1 cmd))
817 (rrr (nth 2 cmd))) 817 (rrr (nth 2 cmd)))
818 (ccl-check-register rrr cmd) 818 (ccl-check-register rrr cmd)
819 (ccl-check-register RRR cmd) 819 (ccl-check-register RRR cmd)
820 (ccl-embed-extended-command 'write-multibyte-character rrr RRR 0)) 820 (ccl-embed-extended-command 'write-multibyte-character rrr RRR 0))
821 nil) 821 nil)
822 822
823 ;; Compile translate-character 823 ;; Compile translate-character
824 (defun ccl-compile-translate-character (cmd) 824 (defun ccl-compile-translate-character (cmd)
825 (if (/= (length cmd) 4) 825 (if (not (eql (length cmd) 4))
826 (error "CCL: Invalid number of arguments: %s" cmd)) 826 (error "CCL: Invalid number of arguments: %s" cmd))
827 (let ((Rrr (nth 1 cmd)) 827 (let ((Rrr (nth 1 cmd))
828 (RRR (nth 2 cmd)) 828 (RRR (nth 2 cmd))
829 (rrr (nth 3 cmd))) 829 (rrr (nth 3 cmd)))
830 (ccl-check-register rrr cmd) 830 (ccl-check-register rrr cmd)
838 (ccl-embed-extended-command 'translate-character rrr RRR Rrr)))) 838 (ccl-embed-extended-command 'translate-character rrr RRR Rrr))))
839 nil) 839 nil)
840 840
841 ;; Compile mule-to-unicode 841 ;; Compile mule-to-unicode
842 (defun ccl-compile-mule-to-unicode (cmd) 842 (defun ccl-compile-mule-to-unicode (cmd)
843 (if (/= (length cmd) 3) 843 (if (not (eql (length cmd) 3))
844 (error "CCL: Invalid number of arguments: %s" cmd)) 844 (error "CCL: Invalid number of arguments: %s" cmd))
845 (let ((RRR (nth 1 cmd)) 845 (let ((RRR (nth 1 cmd))
846 (rrr (nth 2 cmd))) 846 (rrr (nth 2 cmd)))
847 (ccl-check-register RRR cmd) 847 (ccl-check-register RRR cmd)
848 (ccl-check-register rrr cmd) 848 (ccl-check-register rrr cmd)
850 nil) 850 nil)
851 851
852 ;; Given a Unicode code point in register rrr, write the charset ID of the 852 ;; Given a Unicode code point in register rrr, write the charset ID of the
853 ;; corresponding character in RRR, and the Mule-CCL form of its code in rrr. 853 ;; corresponding character in RRR, and the Mule-CCL form of its code in rrr.
854 (defun ccl-compile-unicode-to-mule (cmd) 854 (defun ccl-compile-unicode-to-mule (cmd)
855 (if (/= (length cmd) 3) 855 (if (not (eql (length cmd) 3))
856 (error "CCL: Invalid number of arguments: %s" cmd)) 856 (error "CCL: Invalid number of arguments: %s" cmd))
857 (let ((rrr (nth 1 cmd)) 857 (let ((rrr (nth 1 cmd))
858 (RRR (nth 2 cmd))) 858 (RRR (nth 2 cmd)))
859 (ccl-check-register rrr cmd) 859 (ccl-check-register rrr cmd)
860 (ccl-check-register RRR cmd) 860 (ccl-check-register RRR cmd)
861 (ccl-embed-extended-command 'unicode-to-mule rrr RRR 0)) 861 (ccl-embed-extended-command 'unicode-to-mule rrr RRR 0))
862 nil) 862 nil)
863 863
864 ;; Compile lookup-integer 864 ;; Compile lookup-integer
865 (defun ccl-compile-lookup-integer (cmd) 865 (defun ccl-compile-lookup-integer (cmd)
866 (if (/= (length cmd) 4) 866 (if (not (eql (length cmd) 4))
867 (error "CCL: Invalid number of arguments: %s" cmd)) 867 (error "CCL: Invalid number of arguments: %s" cmd))
868 (let ((Rrr (nth 1 cmd)) 868 (let ((Rrr (nth 1 cmd))
869 (RRR (nth 2 cmd)) 869 (RRR (nth 2 cmd))
870 (rrr (nth 3 cmd))) 870 (rrr (nth 3 cmd)))
871 (ccl-check-register RRR cmd) 871 (ccl-check-register RRR cmd)
881 (ccl-embed-extended-command 'lookup-int rrr RRR 0)))) 881 (ccl-embed-extended-command 'lookup-int rrr RRR 0))))
882 nil) 882 nil)
883 883
884 ;; Compile lookup-character 884 ;; Compile lookup-character
885 (defun ccl-compile-lookup-character (cmd) 885 (defun ccl-compile-lookup-character (cmd)
886 (if (/= (length cmd) 4) 886 (if (not (eql (length cmd) 4))
887 (error "CCL: Invalid number of arguments: %s" cmd)) 887 (error "CCL: Invalid number of arguments: %s" cmd))
888 (let ((Rrr (nth 1 cmd)) 888 (let ((Rrr (nth 1 cmd))
889 (RRR (nth 2 cmd)) 889 (RRR (nth 2 cmd))
890 (rrr (nth 3 cmd))) 890 (rrr (nth 3 cmd)))
891 (ccl-check-register RRR cmd) 891 (ccl-check-register RRR cmd)
904 (defun ccl-compile-iterate-multiple-map (cmd) 904 (defun ccl-compile-iterate-multiple-map (cmd)
905 (ccl-compile-multiple-map-function 'iterate-multiple-map cmd) 905 (ccl-compile-multiple-map-function 'iterate-multiple-map cmd)
906 nil) 906 nil)
907 907
908 (defun ccl-compile-map-multiple (cmd) 908 (defun ccl-compile-map-multiple (cmd)
909 (if (/= (length cmd) 4) 909 (if (not (eql (length cmd) 4))
910 (error "CCL: Invalid number of arguments: %s" cmd)) 910 (error "CCL: Invalid number of arguments: %s" cmd))
911 (let (func arg) 911 (let (func arg)
912 (setq func 912 (setq func
913 (lambda (arg mp) 913 (lambda (arg mp)
914 (let ((len 0) result add) 914 (let ((len 0) result add)
930 (funcall func (nth 3 cmd) nil))) 930 (funcall func (nth 3 cmd) nil)))
931 (ccl-compile-multiple-map-function 'map-multiple arg)) 931 (ccl-compile-multiple-map-function 'map-multiple arg))
932 nil) 932 nil)
933 933
934 (defun ccl-compile-map-single (cmd) 934 (defun ccl-compile-map-single (cmd)
935 (if (/= (length cmd) 4) 935 (if (not (eql (length cmd) 4))
936 (error "CCL: Invalid number of arguments: %s" cmd)) 936 (error "CCL: Invalid number of arguments: %s" cmd))
937 (let ((RRR (nth 1 cmd)) 937 (let ((RRR (nth 1 cmd))
938 (rrr (nth 2 cmd)) 938 (rrr (nth 2 cmd))
939 (map (nth 3 cmd))) 939 (map (nth 3 cmd)))
940 (ccl-check-register rrr cmd) 940 (ccl-check-register rrr cmd)