1 ;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: COMMON-LISP -*-
3 ;;; This code is in the public domain.
5 ;;; The cmucl implementation of simple-streams was done by Paul Foley,
6 ;;; who placed the code in the public domain. Sbcl port by Rudi
9 (in-package "COMMON-LISP")
11 ;; .../compiler/knownfun.lisp
13 ;; TODO: I suppose sbcl internals have sufficiently diverged from
14 ;; cmucl that this does not work after my primitive translation
15 ;; attempt. This is used in the cmucl version to compute (via
16 ;; :derive-type arg to defknown) the return type of open. For the
17 ;; time being, the new defknown form for open does not specify its
20 (defun result-type-open-class (call)
21 (declare (type sb-c::combination call))
22 (do ((args (sb-c::combination-args call) (cdr args)))
24 (let ((leaf (sb-c::ref-leaf (sb-c::continuation-use (car args)))))
25 (when (and (typep leaf 'sb-kernel:constant)
26 (eq (sb-c::constant-value leaf) :class)
28 (let ((leaf (sb-c::ref-leaf (sb-c::continuation-use (cadr args)))))
29 (return (if (typep leaf 'sb-kernel:constant)
30 (find-class (sb-c::constant-value leaf) nil)
33 (handler-bind ((error #'(lambda (condition) (declare (ignore condition))
35 (sb-c:defknown open (t &rest t
36 &key (:direction (member :input :output :io :probe))
37 (:element-type sb-kernel:type-specifier)
38 (:if-exists (member :error :new-version :rename
39 :rename-and-delete :overwrite
40 :append :supersede nil))
41 (:if-does-not-exist (member :error :create nil))
42 (:external-format (member :default))
43 (:class (or symbol class))
44 (:mapped (member t nil))
45 (:input-handle (or null fixnum stream))
46 (:output-handle (or null fixnum stream))
50 ;; :derive-type #'result-type-open-class
53 (sb-c:defknown listen (&optional sb-kernel:streamlike
54 (or null (integer 1 10) (member 'character)))
55 boolean (sb-c::unsafely-flushable sb-c::explicit-check))
57 (sb-c:defknown read-sequence (sequence stream &key (:start sb-int:index)
58 (:end sb-kernel:sequence-end)
59 (:partial-fill boolean))
62 (sb-c:defknown clear-input (&optional stream boolean) null
63 (sb-c::explicit-check)))