X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-simple-streams%2Ffndb.lisp;h=237cb930f6c3ea787734402d70298eb48c771dab;hb=f057566fe993f008a9b34dc87b026e7c8ef2611d;hp=6d8579f4429ef829d57bc2773b3a30cecb5f7807;hpb=8dc1241068db5855115a9e25488a8962718a6c79;p=sbcl.git diff --git a/contrib/sb-simple-streams/fndb.lisp b/contrib/sb-simple-streams/fndb.lisp index 6d8579f..237cb93 100644 --- a/contrib/sb-simple-streams/fndb.lisp +++ b/contrib/sb-simple-streams/fndb.lisp @@ -22,24 +22,24 @@ Here's a (smarter) replacement: (defun result-type-open-class (call) (declare (type sb-c::combination call)) (let* ((not-set '#:not-set) - (not-constant '#:not-constant) - (direction not-set) - (if-exists not-set) - (if-does-not-exist not-set) - (class not-set)) + (not-constant '#:not-constant) + (direction not-set) + (if-exists not-set) + (if-does-not-exist not-set) + (class not-set)) ;; find (the first occurence of) each interesting keyword argument (do ((args (cdr (combination-args call)) (cddr args))) - ((null args)) + ((null args)) (macrolet ((maybe-set (var) - `(when (and (eq ,var not-set) (cadr args)) - (if (constant-continuation-p (cadr args)) - (setq ,var (continuation-value (cadr args))) - (setq ,var not-constant))))) - (case (continuation-value (car args)) - (:direction (maybe-set direction)) - (:if-exists (maybe-set if-exists)) - (:if-does-not-exist (maybe-set if-does-not-exist)) - (:class (maybe-set class))))) + `(when (and (eq ,var not-set) (cadr args)) + (if (constant-continuation-p (cadr args)) + (setq ,var (continuation-value (cadr args))) + (setq ,var not-constant))))) + (case (continuation-value (car args)) + (:direction (maybe-set direction)) + (:if-exists (maybe-set if-exists)) + (:if-does-not-exist (maybe-set if-does-not-exist)) + (:class (maybe-set class))))) ;; and set default values for any that weren't set above (when (eq direction not-set) (setq direction :input)) (when (eq if-exists not-constant) (setq if-exists nil)) @@ -51,11 +51,11 @@ Here's a (smarter) replacement: ;; direction is :output or :io or not-constant and :if-exists is nil ;; :if-does-not-exist is nil (if (or (and (or (eq direction :probe) (eq direction not-constant)) - (not (eq if-does-not-exist :error))) - (and (or (eq direction :output) (eq direction :io) - (eq direction not-constant)) - (eq if-exists nil)) - (eq if-does-not-exist nil)) + (not (eq if-does-not-exist :error))) + (and (or (eq direction :output) (eq direction :io) + (eq direction not-constant)) + (eq if-exists nil)) + (eq if-does-not-exist nil)) (specifier-type `(or null ,class)) (specifier-type class)))) @@ -72,7 +72,7 @@ TODO (rudi 2003-05-19): make the above work, make (defknown open) use it. :rename-and-delete :overwrite :append :supersede nil)) (:if-does-not-exist (member :error :create nil)) - (:external-format (member :default)) + (:external-format keyword) (:class (or symbol class)) (:mapped (member t nil)) (:input-handle (or null fixnum stream)) @@ -83,7 +83,7 @@ TODO (rudi 2003-05-19): make the above work, make (defknown open) use it. ;; :derive-type #'result-type-open-class ) - (sb-c:defknown listen (&optional sb-kernel:streamlike + (sb-c:defknown listen (&optional sb-kernel:stream-designator (or null (integer 1 10) (member character))) boolean (sb-c::unsafely-flushable sb-c::explicit-check))