comparison lisp/bytecomp.el @ 5182:2e528066e2fc

Move #'sort*, #'fill, #'merge to C from cl-seq.el. lisp/ChangeLog addition: 2010-04-01 Aidan Kehoe <kehoea@parhasard.net> * cl-seq.el (fill, sort*, merge): Move these functions to fns.c. (stable-sort): Make this docstring reflect the argument names used in the #'sort* docstring. * cl-macs.el (stable-sort): Make #'stable-sort exactly equivalent to #'sort* in compiled code. * bytecomp.el (byte-compile-maybe-add-*): New macro, for functions like #'sort and #'mapcar that, to be strictly compatible, should only take two args, but in our implementation can take more, because they're aliases of #'sort* and #'mapcar*. (byte-compile-mapcar, byte-compile-sort, byte-compile-fillarray): Use this new macro. (map-into): Add a byte-compile method for #'map-into in passing. * apropos.el (apropos-print): Use #'sort* with a :key argument, now it's in C. * compat.el (extent-at): Ditto. * register.el (list-registers): Ditto. * package-ui.el (pui-list-packages): Ditto. * help.el (sorted-key-descriptions): Ditto. src/ChangeLog addition: 2010-03-31 Aidan Kehoe <kehoea@parhasard.net> * fns.c (STRING_DATA_TO_OBJECT_ARRAY) (BIT_VECTOR_TO_OBJECT_ARRAY, c_merge_predicate_key) (c_merge_predicate_nokey, list_merge, array_merge) (list_array_merge_into_list, list_list_merge_into_array) (list_array_merge_into_array, CHECK_KEY_ARGUMENT, Fmerge) (list_sort, array_sort, FsortX): Move #'sort*, #'fill, #'merge from cl-seq.el to C, extending the implementations of Fsort, Ffillarray, and merge() to do so. * keymap.c (keymap_submaps, map_keymap_sort_predicate) (describe_map_sort_predicate): Change the calling semantics of the C sort predicates to return a non-nil Lisp object if the first argument is less than the second, rather than C integers. * fontcolor-msw.c (sort_font_list_function): * fileio.c (build_annotations): * dired.c (Fdirectory_files): * abbrev.c (Finsert_abbrev_table_description): Call list_sort instead of Fsort, list_merge instead of merge() in these functions. man/ChangeLog addition: 2010-04-01 Aidan Kehoe <kehoea@parhasard.net> * lispref/lists.texi (Rearrangement): Update the documentation of #'sort here, now that it accepts any type of sequence and the KEY keyword argument. (Though this is probably now the wrong place for this function, given that.)
author Aidan Kehoe <kehoea@parhasard.net>
date Thu, 01 Apr 2010 20:22:50 +0100
parents 8c3671b62dad
children 0d436a78c514
comparison
equal deleted inserted replaced
5181:a00bfbd64e0a 5182:2e528066e2fc
3508 (eq (car-safe (nth 1 fn)) 'lambda) 3508 (eq (car-safe (nth 1 fn)) 'lambda)
3509 (or 3509 (or
3510 (null (memq 'quoted-lambda 3510 (null (memq 'quoted-lambda
3511 byte-compile-warnings)) 3511 byte-compile-warnings))
3512 (byte-compile-warn 3512 (byte-compile-warn
3513 "Passing a quoted lambda to #'%s, forcing \ 3513 "Passing a quoted lambda (arg %d) to #'%s, \
3514 function quoting" (car form)))) 3514 forcing function quoting" ,en (car form))))
3515 (setcar fn 'function)))) 3515 (setcar fn 'function))))
3516 (byte-compile-normal-call form))) 3516 (byte-compile-normal-call form)))
3517 3517
3518 ;; (mapcar '(lambda (x) ..) ..) ==> (mapcar (function (lambda (x) ..)) ..) 3518 ;; (mapcar '(lambda (x) ..) ..) ==> (mapcar (function (lambda (x) ..)) ..)
3519 ;; for cases where it's guaranteed that first arg will be used as a lambda. 3519 ;; for cases where it's guaranteed that first arg will be used as a lambda.
3546 (or (null (memq 'discarded-consing byte-compile-warnings)) 3546 (or (null (memq 'discarded-consing byte-compile-warnings))
3547 (byte-compile-warn 3547 (byte-compile-warn
3548 "Discarding the result of #'maplist; maybe you meant #'mapl?")) 3548 "Discarding the result of #'maplist; maybe you meant #'mapl?"))
3549 (setq form (cons 'mapl (cdr form)))) 3549 (setq form (cons 'mapl (cdr form))))
3550 (byte-compile-funarg form)) 3550 (byte-compile-funarg form))
3551
3552 ;; For when calls to #'sort or #'mapcar have more than two args, something
3553 ;; recent XEmacs can handle, but GNU and 21.4 can't.
3554 (defmacro byte-compile-maybe-add-* (complex max)
3555 `#'(lambda (form)
3556 (when (> (length (cdr form)) ,max)
3557 (when (memq 'callargs byte-compile-warnings)
3558 (byte-compile-warn
3559 "#'%s called with %d arguments, using #'%s instead"
3560 (car form) (length (cdr form)) ',complex))
3561 (setq form (cons ',complex (cdr form))))
3562 (funcall (or (get ',complex 'byte-compile)
3563 'byte-compile-normal-call) form)))
3564
3565 (defalias 'byte-compile-mapcar (byte-compile-maybe-add-* mapcar* 2))
3566
3567 (defalias 'byte-compile-sort (byte-compile-maybe-add-* sort* 2))
3568
3569 (defalias 'byte-compile-fillarray (byte-compile-maybe-add-* fill 2))
3551 3570
3552 ;; (function foo) must compile like 'foo, not like (symbol-function 'foo). 3571 ;; (function foo) must compile like 'foo, not like (symbol-function 'foo).
3553 ;; Otherwise it will be incompatible with the interpreter, 3572 ;; Otherwise it will be incompatible with the interpreter,
3554 ;; and (funcall (function foo)) will lose with autoloads. 3573 ;; and (funcall (function foo)) will lose with autoloads.
3555 3574
3723 (byte-defop-compiler-1 and) 3742 (byte-defop-compiler-1 and)
3724 (byte-defop-compiler-1 or) 3743 (byte-defop-compiler-1 or)
3725 (byte-defop-compiler-1 while) 3744 (byte-defop-compiler-1 while)
3726 (byte-defop-compiler-1 funcall) 3745 (byte-defop-compiler-1 funcall)
3727 (byte-defop-compiler-1 apply byte-compile-funarg) 3746 (byte-defop-compiler-1 apply byte-compile-funarg)
3728 (byte-defop-compiler-1 mapcar byte-compile-maybe-mapc) 3747 (byte-defop-compiler-1 mapcar byte-compile-mapcar)
3748 (byte-defop-compiler-1 mapcar* byte-compile-maybe-mapc)
3729 (byte-defop-compiler-1 mapatoms byte-compile-funarg) 3749 (byte-defop-compiler-1 mapatoms byte-compile-funarg)
3730 (byte-defop-compiler-1 mapconcat byte-compile-funarg) 3750 (byte-defop-compiler-1 mapconcat byte-compile-funarg)
3731 (byte-defop-compiler-1 mapc byte-compile-funarg) 3751 (byte-defop-compiler-1 mapc byte-compile-funarg)
3732 (byte-defop-compiler-1 maphash byte-compile-funarg) 3752 (byte-defop-compiler-1 maphash byte-compile-funarg)
3733 (byte-defop-compiler-1 map-char-table byte-compile-funarg) 3753 (byte-defop-compiler-1 map-char-table byte-compile-funarg)
3741 (byte-defop-compiler-1 map-extent-children byte-compile-funarg) 3761 (byte-defop-compiler-1 map-extent-children byte-compile-funarg)
3742 (byte-defop-compiler-1 map-extents byte-compile-funarg) 3762 (byte-defop-compiler-1 map-extents byte-compile-funarg)
3743 (byte-defop-compiler-1 map-plist byte-compile-funarg) 3763 (byte-defop-compiler-1 map-plist byte-compile-funarg)
3744 (byte-defop-compiler-1 map-range-table byte-compile-funarg) 3764 (byte-defop-compiler-1 map-range-table byte-compile-funarg)
3745 (byte-defop-compiler-1 map-syntax-table byte-compile-funarg) 3765 (byte-defop-compiler-1 map-syntax-table byte-compile-funarg)
3746 (byte-defop-compiler-1 mapcar* byte-compile-maybe-mapc)
3747 3766
3748 (byte-defop-compiler-1 remove-if byte-compile-funarg) 3767 (byte-defop-compiler-1 remove-if byte-compile-funarg)
3749 (byte-defop-compiler-1 remove-if-not byte-compile-funarg) 3768 (byte-defop-compiler-1 remove-if-not byte-compile-funarg)
3750 (byte-defop-compiler-1 delete-if byte-compile-funarg) 3769 (byte-defop-compiler-1 delete-if byte-compile-funarg)
3751 (byte-defop-compiler-1 delete-if-not byte-compile-funarg) 3770 (byte-defop-compiler-1 delete-if-not byte-compile-funarg)
3769 3788
3770 (byte-defop-compiler-1 walk-windows byte-compile-funarg) 3789 (byte-defop-compiler-1 walk-windows byte-compile-funarg)
3771 (byte-defop-compiler-1 get-window-with-predicate byte-compile-funarg) 3790 (byte-defop-compiler-1 get-window-with-predicate byte-compile-funarg)
3772 3791
3773 (byte-defop-compiler-1 map byte-compile-funarg-2) 3792 (byte-defop-compiler-1 map byte-compile-funarg-2)
3793 (byte-defop-compiler-1 map-into byte-compile-funarg-2)
3774 (byte-defop-compiler-1 apropos-internal byte-compile-funarg-2) 3794 (byte-defop-compiler-1 apropos-internal byte-compile-funarg-2)
3775 (byte-defop-compiler-1 sort byte-compile-funarg-2) 3795 (byte-defop-compiler-1 sort byte-compile-sort)
3776 (byte-defop-compiler-1 sort* byte-compile-funarg-2) 3796 (byte-defop-compiler-1 sort* byte-compile-funarg-2)
3777 (byte-defop-compiler-1 stable-sort byte-compile-funarg-2) 3797 (byte-defop-compiler-1 stable-sort byte-compile-funarg-2)
3778 (byte-defop-compiler-1 substitute-if byte-compile-funarg-2) 3798 (byte-defop-compiler-1 substitute-if byte-compile-funarg-2)
3779 (byte-defop-compiler-1 substitute-if-not byte-compile-funarg-2) 3799 (byte-defop-compiler-1 substitute-if-not byte-compile-funarg-2)
3780 (byte-defop-compiler-1 nsubstitute-if byte-compile-funarg-2) 3800 (byte-defop-compiler-1 nsubstitute-if byte-compile-funarg-2)
3791 3811
3792 (byte-defop-compiler-1 let) 3812 (byte-defop-compiler-1 let)
3793 (byte-defop-compiler-1 let*) 3813 (byte-defop-compiler-1 let*)
3794 3814
3795 (byte-defop-compiler-1 integerp) 3815 (byte-defop-compiler-1 integerp)
3816 (byte-defop-compiler-1 fillarray)
3796 3817
3797 (defun byte-compile-progn (form) 3818 (defun byte-compile-progn (form)
3798 (byte-compile-body-do-effect (cdr form))) 3819 (byte-compile-body-do-effect (cdr form)))
3799 3820
3800 (defun byte-compile-prog1 (form) 3821 (defun byte-compile-prog1 (form)