+ (length r) r)))
+ (format s "~A" st))
+ (error () (format s "Actual value: #<error during printing>~%")
+ ))
+ (finish-output s)
+ ))))
+ (when (not (pend entry)) *test*))
+
+(defun expanded-eval (form)
+ "Split off top level of a form and eval separately. This reduces the chance that
+ compiler optimizations will fold away runtime computation."
+ (if (not (consp form))
+ (eval form)
+ (let ((op (car form)))
+ (cond
+ ((eq op 'let)
+ (let* ((bindings (loop for b in (cadr form)
+ collect (if (consp b) b (list b nil))))
+ (vars (mapcar #'car bindings))
+ (binding-forms (mapcar #'cadr bindings)))
+ (apply
+ (the function
+ (eval `(lambda ,vars ,@(cddr form))))
+ (mapcar #'eval binding-forms))))
+ ((and (eq op 'let*) (cadr form))
+ (let* ((bindings (loop for b in (cadr form)
+ collect (if (consp b) b (list b nil))))
+ (vars (mapcar #'car bindings))
+ (binding-forms (mapcar #'cadr bindings)))
+ (funcall
+ (the function
+ (eval `(lambda (,(car vars) &aux ,@(cdr bindings)) ,@(cddr form))))
+ (eval (car binding-forms)))))
+ ((eq op 'progn)
+ (loop for e on (cdr form)
+ do (if (null (cdr e)) (return (eval (car e)))
+ (eval (car e)))))
+ ((and (symbolp op) (fboundp op)
+ (not (macro-function op))
+ (not (special-operator-p op)))
+ (apply (symbol-function op)
+ (mapcar #'eval (cdr form))))
+ (t (eval form))))))