451 |
(*standard-output*) |
(*standard-output*) |
452 |
(let ((*print-escape* t)) |
(let ((*print-escape* t)) |
453 |
(prin1 c))))))))) |
(prin1 c))))))))) |
454 |
(compile nil lambda-form)))) |
(prog1 (compile nil lambda-form) |
455 |
|
#+:ecl (si:gc t) |
456 |
|
)))) |
457 |
(let ((optimized-compiled-fn (%compile optimized-fn-src)) |
(let ((optimized-compiled-fn (%compile optimized-fn-src)) |
458 |
(unoptimized-compiled-fn (%compile unoptimized-fn-src))) |
(unoptimized-compiled-fn (%compile unoptimized-fn-src))) |
459 |
(declare (type function optimized-compiled-fn unoptimized-compiled-fn)) |
(declare (type function optimized-compiled-fn unoptimized-compiled-fn)) |
536 |
;;; The return value of PRUNE should be ignored. |
;;; The return value of PRUNE should be ignored. |
537 |
;;; |
;;; |
538 |
(defun prune (form try-fn) |
(defun prune (form try-fn) |
539 |
(declare (function try-fn)) |
(declare (type function try-fn)) |
540 |
(flet ((try (x) (funcall try-fn x))) |
(flet ((try (x) (funcall try-fn x))) |
541 |
(when (consp form) |
(when (consp form) |
542 |
(let ((op (car form)) |
(let ((op (car form)) |
551 |
(try -1) |
(try -1) |
552 |
(prune-fn form try-fn)) |
(prune-fn form try-fn)) |
553 |
|
|
554 |
((abs 1+ 1- identity values progn realpart imagpart) |
((abs 1+ 1- identity values progn) |
555 |
(mapc #'try args) |
(mapc #'try args) |
556 |
(prune-fn form try-fn)) |
(prune-fn form try-fn)) |
557 |
|
|
752 |
;; Assume each case has a single form |
;; Assume each case has a single form |
753 |
(prune-list cases |
(prune-list cases |
754 |
#'(lambda (case try-fn) |
#'(lambda (case try-fn) |
755 |
(declare (function try-fn)) |
(declare (type function try-fn)) |
756 |
(when (eql (length case) 2) |
(when (eql (length case) 2) |
757 |
(prune (cadr case) |
(prune (cadr case) |
758 |
#'(lambda (form) |
#'(lambda (form) |
764 |
(defun prune-fn (form try-fn) |
(defun prune-fn (form try-fn) |
765 |
"Attempt to simplify a function call form. It is considered |
"Attempt to simplify a function call form. It is considered |
766 |
acceptable to replace the call by one of its argument forms." |
acceptable to replace the call by one of its argument forms." |
767 |
(declare (function try-fn)) |
(declare (type function try-fn)) |
768 |
(prune-list (cdr form) |
(prune-list (cdr form) |
769 |
#'prune |
#'prune |
770 |
#'(lambda (args) |
#'(lambda (args) |
772 |
|
|
773 |
(defun prune-let (form try-fn) |
(defun prune-let (form try-fn) |
774 |
"Attempt to simplify a LET form." |
"Attempt to simplify a LET form." |
775 |
(declare (function try-fn)) |
(declare (type function try-fn)) |
776 |
(let* ((op (car form)) |
(let* ((op (car form)) |
777 |
(binding-list (cadr form)) |
(binding-list (cadr form)) |
778 |
(body (cddr form)) |
(body (cddr form)) |
788 |
;; Try to simplify the forms in the RHS of the bindings |
;; Try to simplify the forms in the RHS of the bindings |
789 |
(prune-list binding-list |
(prune-list binding-list |
790 |
#'(lambda (binding try-fn) |
#'(lambda (binding try-fn) |
791 |
(declare (function try-fn)) |
(declare (type function try-fn)) |
792 |
(prune (cadr binding) |
(prune (cadr binding) |
793 |
#'(lambda (form) |
#'(lambda (form) |
794 |
(funcall try-fn |
(funcall try-fn |
824 |
|
|
825 |
(defun prune-flet (form try-fn) |
(defun prune-flet (form try-fn) |
826 |
"Attempt to simplify a FLET form." |
"Attempt to simplify a FLET form." |
827 |
(declare (function try-fn)) |
(declare (type function try-fn)) |
828 |
|
|
829 |
(let* ((op (car form)) |
(let* ((op (car form)) |
830 |
(binding-list (cadr form)) |
(binding-list (cadr form)) |
833 |
;; Try to simplify the forms in the RHS of the bindings |
;; Try to simplify the forms in the RHS of the bindings |
834 |
(prune-list binding-list |
(prune-list binding-list |
835 |
#'(lambda (binding try-fn) |
#'(lambda (binding try-fn) |
836 |
(declare (function try-fn)) |
(declare (type function try-fn)) |
837 |
(prune (third binding) |
(prune (third binding) |
838 |
#'(lambda (form) |
#'(lambda (form) |
839 |
(funcall try-fn |
(funcall try-fn |