/[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.11 by pfdietz, Thu Sep 25 11:19:57 2003 UTC revision 1.12 by pfdietz, Fri Sep 26 01:18:01 2003 UTC
# Line 803  Line 803 
803                   (not (rest binding-list))                   (not (rest binding-list))
804                   (not (rest body)))                   (not (rest body)))
805          (let ((binding (first binding-list)))          (let ((binding (first binding-list)))
806            (unless (consp (second binding))            (unless (or (consp (second binding))
807                          (has-assignment-to-var (first binding) body))
808              (funcall try-fn `(let ()              (funcall try-fn `(let ()
809                                 ,@(subst (second binding)                                 ,@(subst (second binding)
810                                          (first binding) body))))))                                          (first binding) body))))))
# Line 812  Line 813 
813                   (funcall try-fn                   (funcall try-fn
814                            `(,@(butlast form) ,form2)))))))                            `(,@(butlast form) ,form2)))))))
815    
816    (defun has-assignment-to-var (var form)
817      (when (consp form)
818        (or (and (member (car form) '(setq setf))
819                 (eq (cadr form) var))
820            (loop for subform in form
821                  thereis (has-assignment-to-var var subform)))))      
822    
823  (defun prune-flet (form try-fn)  (defun prune-flet (form try-fn)
824    "Attempt to simplify a FLET form."    "Attempt to simplify a FLET form."
825    (declare (function try-fn))    (declare (function try-fn))

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

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