diff --git a/run-generic.lisp b/run-generic.lisp index c6575ec1b454e4b00bdc41f3df8ad8d8e5628865..5975f4ce184315d30b4944f28adb80fea466c37b 100644 --- a/run-generic.lisp +++ b/run-generic.lisp @@ -138,16 +138,16 @@ (eval-pred predicate rest)) (let ((next (car rest))) (generic-run-spec next input output error predicate (cdr rest) - (if (typep next 'sequence-spec) - r - resume))) + (if (typep next 'sequence-spec) + r + resume))) (when resume (with-slots (predicate rest resume input output error) resume (when (and (consp rest) (consp (cdr rest))) (let ((remainder (cdr rest))) (when (eval-pred predicate remainder) (generic-run-spec (second rest) input output error - predicate (cddr rest) resume)))))))))) + predicate (cddr rest) resume)))))))))) (defun process-result-list (rl) (if (listp rl) diff --git a/run-sbcl.lisp b/run-sbcl.lisp index 97fdd8f0ff67f8be275ca2f061ea3df74ef1f993..331c651d23da6add5ad7e4e8d96901aaf50705ee 100644 --- a/run-sbcl.lisp +++ b/run-sbcl.lisp @@ -40,36 +40,6 @@ (defun process-wait (p) (sb-ext:process-wait p)) -(defmethod process-result ((r result)) - (labels ((eval-pred (pred rest) - (and (consp rest) - (or (null pred) - (and (functionp pred) (funcall pred (result-process r))))))) - (with-slots (process predicate rest input output error resume) r - (when process - (sb-ext:process-wait process)) - (if (or (not process) - (eval-pred predicate rest)) - (let ((next (car rest))) - (generic-run-spec next input output error predicate (cdr rest) - (if (typep next 'sequence-spec) - r - resume))) - (when resume - (with-slots (predicate rest resume input output error) resume - (when (and (consp rest) (consp (cdr rest))) - (let ((remainder (cdr rest))) - (when (eval-pred predicate remainder) - (generic-run-spec (second rest) input output error - predicate (cddr rest) resume)))))))))) - -(defun process-result-list (rl) - (if (listp rl) - (mapcar #'process-result-list rl) - (let ((next (process-result rl))) - (when next - (alexandria:flatten (list next (process-result-list next))))))) - (defun sbcl-run (spec &key input output error ignore-error-status) (declare (ignore ignore-error-status)) ;; THIS IS A BUG! (labels ((collect-threads (r)