/[gcl]/gcl/ansi-tests/random-int-form.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/random-int-form.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.12 by pfdietz, Fri Sep 26 01:18:01 2003 UTC revision 1.13 by pfdietz, Fri Sep 26 15:56:43 2003 UTC
# Line 451  Line 451 
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))
# Line 534  Line 536 
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))
# Line 549  Line 551 
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                    
# Line 750  Line 752 
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)
# Line 762  Line 764 
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)
# Line 770  Line 772 
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))
# Line 786  Line 788 
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
# Line 822  Line 824 
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))
# Line 831  Line 833 
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

Legend:
Removed from v.1.12  
changed lines
  Added in v.1.13

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26