X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fearly-type.lisp;h=6679a42b7e2e59f9a6d9ceed354c30e89a1d6a91;hb=dc78da1842ccba35e49ca8ca91fd0ab88b1a08b3;hp=3a9a2897a9da9c7008b43cec9296039774ac2b6f;hpb=9489abab7f981b8eea2aec8a883f2eb48d4cb138;p=sbcl.git diff --git a/src/code/early-type.lisp b/src/code/early-type.lisp index 3a9a289..6679a42 100644 --- a/src/code/early-type.lisp +++ b/src/code/early-type.lisp @@ -139,8 +139,6 @@ :rest rest :allowp allowp)) -;;; FIXME: ANSI VALUES has a short form (without lambda list -;;; keywords), which should be translated into a long one. (defun make-values-type (&key (args nil argsp) required optional rest allowp) (if argsp @@ -175,7 +173,14 @@ ;;; (SPECIFIER-TYPE 'FUNCTION) and its subtypes (defstruct (fun-type (:include args-type (class-info (type-class-or-lose 'function))) - (:constructor %make-fun-type)) + (:constructor + %make-fun-type (&key required optional rest + keyp keywords allowp + wild-args + returns + &aux (rest (if (eq rest *empty-type*) + nil + rest))))) ;; true if the arguments are unrestrictive, i.e. * (wild-args nil :type boolean) ;; type describing the return values. This is a values type @@ -330,7 +335,7 @@ :enumerable enumerable)) ;;; An ARRAY-TYPE is used to represent any array type, including -;;; things such as SIMPLE-STRING. +;;; things such as SIMPLE-BASE-STRING. (defstruct (array-type (:include ctype (class-info (type-class-or-lose 'array))) (:constructor %make-array-type) @@ -487,13 +492,10 @@ (or (built-in-classoid-translation spec) spec) spec)) (t - (let* (;; FIXME: This automatic promotion of FOO-style - ;; specs to (FOO)-style specs violates the ANSI - ;; standard. Unfortunately, we can't fix the - ;; problem just by removing it, since then things - ;; downstream should break. But at some point we - ;; should fix this and the things downstream too. - (lspec (if (atom spec) (list spec) spec)) + (when (and (atom spec) + (member spec '(and or not member eql satisfies values))) + (error "The symbol ~S is not valid as a type specifier." spec)) + (let* ((lspec (if (atom spec) (list spec) spec)) (fun (info :type :translator (car lspec)))) (cond (fun (funcall fun lspec))