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)))))) |
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)) |