Mercurial > hg > xemacs-beta

comparison lisp/byte-optimize.el @ 5657:2a870a7b86bd

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Descend special forms more exhaustively, #'byte-optimize-form-code-walker lisp/ChangeLog addition: 2012-05-06 Aidan Kehoe <kehoea@parhasard.net> * byte-optimize.el: * byte-optimize.el (or): * byte-optimize.el (byte-optimize-or): Declare for-effect properly, it's not free. * byte-optimize.el (byte-optimize-condition-case): New. * byte-optimize.el (byte-optimize-form-code-walker): Be more exhaustive in descending special forms, for the sake of lexically-oriented optimizers such as that for #'labels.
author Aidan Kehoe <kehoea@parhasard.net>
date Sun, 06 May 2012 05:22:19 +0100
parents e9c3fe82127d
children 0df4d95bd98a
comparison
equal deleted inserted replaced
5656:e9c3fe82127d 5657:2a870a7b86bd
360 (if (eq 'interactive (car-safe (car body))) 360 (if (eq 'interactive (car-safe (car body)))
361 (setq body (nthcdr (incf offset) form))) 361 (setq body (nthcdr (incf offset) form)))
362 (if (eq body (setq body (byte-optimize-body body nil))) 362 (if (eq body (setq body (byte-optimize-body body nil)))
363 form 363 form
364 (nconc (subseq form 0 offset) body)))) 364 (nconc (subseq form 0 offset) body))))
365
366 ;; Setting this to the byte-optimizer property of condition-case gives an
367 ;; infinite loop, as of So 6 Mai 2012 05:10:44 IST
368 (defun byte-optimize-condition-case (form &optional for-effect)
369 (let ((modified nil)
370 (result nil)
371 (new nil))
372 (setq result
373 (list* (car form) (nth 1 form)
374 (prog1
375 (setq new (byte-optimize-form (nth 2 form) for-effect))
376 (setq modified (or modified (eq new (nth 2 form)))))
377 (mapcar #'(lambda (handler)
378 (if (eq (cdr handler)
379 (setq new
380 (byte-optimize-body (cdr handler)
381 for-effect)))
382 handler
383 (setq modified t)
384 (cons (car handler) new)))
385 (cdddr form))))
386 (if modified result form)))
365 387
366 ;;; implementing source-level optimizers 388 ;;; implementing source-level optimizers
367 389
368 (defun byte-optimize-form-code-walker (form for-effect) 390 (defun byte-optimize-form-code-walker (form for-effect)
369 ;; 391 ;;
501 nil) 523 nil)
502 524
503 ((memq fn '(defun defmacro)) 525 ((memq fn '(defun defmacro))
504 (if (eq (setq tmp (cons 'lambda (cddr form))) 526 (if (eq (setq tmp (cons 'lambda (cddr form)))
505 (setq tmp (byte-optimize-lambda tmp))) 527 (setq tmp (byte-optimize-lambda tmp)))
506 (cons fn (cdr tmp)) 528 form
507 form)) 529 (nconc (subseq form 0 2) (cdr tmp))))
508 530
509 ((eq fn 'condition-case) 531 ((eq fn 'condition-case)
510 (list* fn (nth 1 form) (byte-optimize-form (nth 2 form) for-effect) 532 (if (eq (setq tmp (byte-optimize-condition-case form for-effect))
511 (mapcar #'(lambda (handler) 533 form)
512 (cons (car handler) 534 form
513 (byte-optimize-body (cdr handler) 535 tmp))
514 for-effect)))
515 (cdddr form))))
516 536
517 ((eq fn 'unwind-protect) 537 ((eq fn 'unwind-protect)
518 ;; the "protected" part of an unwind-protect is compiled (and thus 538 ;; the "protected" part of an unwind-protect is compiled (and
519 ;; optimized) as a top-level form, so don't do it here. But the 539 ;; thus optimized) as a top-level form, but do it here too for
540 ;; the sake of lexically-oriented code (labels, and so on). The
520 ;; non-protected part has the same for-effect status as the 541 ;; non-protected part has the same for-effect status as the
521 ;; unwind-protect itself. (The protected part is always for effect, 542 ;; unwind-protect itself.
522 ;; but that isn't handled properly yet.)
523 (cons fn 543 (cons fn
524 (cons (byte-optimize-form (nth 1 form) for-effect) 544 (cons (byte-optimize-form (nth 1 form) for-effect)
525 (cdr (cdr form))))) 545 (byte-optimize-body (cddr form) t))))
526 546
527 ((eq fn 'catch) 547 ((eq fn 'catch)
528 ;; the body of a catch is compiled (and thus optimized) as a 548 ;; The body of a catch is compiled (and thus optimized) as a
529 ;; top-level form, so don't do it here. The tag is never 549 ;; top-level form, but do it here too for the sake of
530 ;; for-effect. The body should have the same for-effect status 550 ;; lexically-oriented code. The tag is never for-effect.
531 ;; as the catch form itself, but that isn't handled properly yet.
532 (cons fn 551 (cons fn
533 (cons (byte-optimize-form (nth 1 form) nil) 552 (cons (byte-optimize-form (nth 1 form) nil)
534 (cdr (cdr form))))) 553 (byte-optimize-body (cddr form) for-effect))))
535 554
536 ;; If optimization is on, this is the only place that macros are 555 ;; If optimization is on, this is the only place that macros are
537 ;; expanded. If optimization is off, then macroexpansion happens 556 ;; expanded. If optimization is off, then macroexpansion happens
538 ;; in byte-compile-form. Otherwise, the macros are already expanded 557 ;; in byte-compile-form. Otherwise, the macros are already expanded
539 ;; by the time that is reached. 558 ;; by the time that is reached.
972 nil)) 991 nil))
973 ((null (cdr (cdr form))) 992 ((null (cdr (cdr form)))
974 (nth 1 form)) 993 (nth 1 form))
975 ((byte-optimize-predicate form)))) 994 ((byte-optimize-predicate form))))
976 995
977 (defun byte-optimize-or (form) 996 (defun byte-optimize-or (form &optional for-effect)
978 ;; Throw away unneeded nils, and simplify if less than 2 args. 997 ;; Throw away unneeded nils, and simplify if less than 2 args.
979 ;; XEmacs; change to be more careful about discarding multiple values. 998 ;; XEmacs; change to be more careful about discarding multiple values.
980 (if (memq nil form) 999 (if (memq nil form)
981 (setq form (remove* nil form 1000 (setq form (remove* nil form
982 ;; A trailing nil indicates to discard multiple 1001 ;; A trailing nil indicates to discard multiple
1055 (if (nth 1 form) 1074 (if (nth 1 form)
1056 form)) 1075 form))
1057 1076
1058 (put 'and 'byte-optimizer 'byte-optimize-and) 1077 (put 'and 'byte-optimizer 'byte-optimize-and)
1059 (put 'or 'byte-optimizer 'byte-optimize-or) 1078 (put 'or 'byte-optimizer 'byte-optimize-or)
1079 (put 'or 'byte-for-effect-optimizer
1080 #'(lambda (form) (byte-optimize-or form t)))
1060 (put 'cond 'byte-optimizer 'byte-optimize-cond) 1081 (put 'cond 'byte-optimizer 'byte-optimize-cond)
1061 (put 'if 'byte-optimizer 'byte-optimize-if) 1082 (put 'if 'byte-optimizer 'byte-optimize-if)
1062 (put 'while 'byte-optimizer 'byte-optimize-while) 1083 (put 'while 'byte-optimizer 'byte-optimize-while)
1063 1084
1064 ;; The supply of bytecodes is small and constrained by backward compatibility. 1085 ;; The supply of bytecodes is small and constrained by backward compatibility.