From 6b76923873a91e4bbac451b536e536ac178a0704 Mon Sep 17 00:00:00 2001 From: Douglas Katzman Date: Sat, 19 Mar 2016 13:20:53 -0400 Subject: [PATCH] Move SFUNCTION type earlier, use it more. --- src/code/array.lisp | 3 +-- src/code/backq.lisp | 1 + src/code/early-extensions.lisp | 14 -------------- src/code/primordial-extensions.lisp | 2 -- src/compiler/constantp.lisp | 3 +-- src/compiler/defconstant.lisp | 2 +- src/compiler/early-globaldb.lisp | 23 ++++++++++++++++++----- src/compiler/generic/target-core.lisp | 3 +-- src/compiler/pack.lisp | 3 +-- src/compiler/policy.lisp | 2 +- src/compiler/x86-64/system.lisp | 6 +++--- src/compiler/x86/system.lisp | 6 +++--- src/pcl/cache.lisp | 2 +- 13 files changed, 32 insertions(+), 38 deletions(-) diff --git a/src/code/array.lisp b/src/code/array.lisp index df8c9e270..3ac39642f 100644 --- a/src/code/array.lisp +++ b/src/code/array.lisp @@ -1412,8 +1412,7 @@ of specialized arrays is supported." array)) ;;; User visible extension -(declaim (ftype (function (array) (values (simple-array * (*)) &optional)) - array-storage-vector)) +(declaim (ftype (sfunction (array) (simple-array * (*))) array-storage-vector)) (defun array-storage-vector (array) #!+sb-doc "Returns the underlying storage vector of ARRAY, which must be a non-displaced array. diff --git a/src/code/backq.lisp b/src/code/backq.lisp index d677a3823..02431f81d 100644 --- a/src/code/backq.lisp +++ b/src/code/backq.lisp @@ -84,6 +84,7 @@ (/show0 "backq.lisp 83") +;; KLUDGE: 'sfunction' is not a defined type yet. (declaim (ftype (function (t fixnum boolean) (values t t &optional)) qq-template-to-sexpr qq-template-1)) diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp index 498084677..4a8f6de04 100644 --- a/src/code/early-extensions.lisp +++ b/src/code/early-extensions.lisp @@ -112,20 +112,6 @@ data-offset) `(integer ,min ,max))))) -;;; Similar to FUNCTION, but the result type is "exactly" specified: -;;; if it is an object type, then the function returns exactly one -;;; value, if it is a short form of VALUES, then this short form -;;; specifies the exact number of values. -(def!type sfunction (args &optional result) - (let ((result (cond ((eq result '*) '*) - ((or (atom result) - (not (eq (car result) 'values))) - `(values ,result &optional)) - ((intersection (cdr result) sb!xc:lambda-list-keywords) - result) - (t `(values ,@(cdr result) &optional))))) - `(function ,args ,result))) - ;;; the default value used for initializing character data. The ANSI ;;; spec says this is arbitrary, so we use the value that falls ;;; through when we just let the low-level consing code initialize diff --git a/src/code/primordial-extensions.lisp b/src/code/primordial-extensions.lisp index 7a12fd2bc..3a5d067bf 100644 --- a/src/code/primordial-extensions.lisp +++ b/src/code/primordial-extensions.lisp @@ -59,8 +59,6 @@ ;;; Return a list of N gensyms. (This is a common suboperation in ;;; macros and other code-manipulating code.) -(declaim (ftype (function (unsigned-byte &optional t) (values list &optional)) - make-gensym-list)) (defun make-gensym-list (n &optional name) (let ((arg (if name (string name) "G"))) (loop repeat n collect (sb!xc:gensym arg)))) diff --git a/src/compiler/constantp.lisp b/src/compiler/constantp.lisp index 97f957df5..e5b447a3c 100644 --- a/src/compiler/constantp.lisp +++ b/src/compiler/constantp.lisp @@ -243,8 +243,7 @@ `(flet ((constantp* (x) (%constantp x environment envp)) (constant-form-value* (x) (%constant-form-value x environment envp))) (declare (optimize speed) (ignorable #'constantp*) - (ftype (function (t) (values t &optional)) ; avoid "unknown values" - constantp* constant-form-value*)) + (ftype (sfunction (t) t) constantp* constant-form-value*)) (let ((args (cdr (truly-the list form)))) (case (car form) ,@(map 'list diff --git a/src/compiler/defconstant.lisp b/src/compiler/defconstant.lisp index d8bb4269a..4ff316388 100644 --- a/src/compiler/defconstant.lisp +++ b/src/compiler/defconstant.lisp @@ -29,7 +29,7 @@ (declare (ignore indicator)) (values value (not (null foundp)))))) -(declaim (ftype (function (symbol t &optional t t) (values null &optional)) +(declaim (ftype (sfunction (symbol t &optional t t) null) about-to-modify-symbol-value)) ;;; the guts of DEFCONSTANT diff --git a/src/compiler/early-globaldb.lisp b/src/compiler/early-globaldb.lisp index 4a2c29b52..8c426bcc3 100644 --- a/src/compiler/early-globaldb.lisp +++ b/src/compiler/early-globaldb.lisp @@ -15,15 +15,28 @@ ;;; but such nuance isn't hugely important. (in-package "SB!C") -(declaim (ftype (function (t t t) (values t t &optional)) info) - (ftype (function (t t t) (values t &optional)) clear-info) - (ftype (function (t t t t) (values t &optional)) (setf info))) +;;; Similar to FUNCTION, but the result type is "exactly" specified: +;;; if it is an object type, then the function returns exactly one +;;; value, if it is a short form of VALUES, then this short form +;;; specifies the exact number of values. +(def!type sfunction (args &optional result) + (let ((result (cond ((eq result '*) '*) + ((or (atom result) + (not (eq (car result) 'values))) + `(values ,result &optional)) + ((intersection (cdr result) sb!xc:lambda-list-keywords) + result) + (t `(values ,@(cdr result) &optional))))) + `(function ,args ,result))) + +(declaim (ftype (sfunction (t t t) (values t t)) info) + (ftype (sfunction (t t t) t) clear-info) + (ftype (sfunction (t t t t) t) (setf info))) ;;; (:FUNCTION :TYPE) information is extracted through a wrapper. ;;; The globaldb representation is not necessarily literally a CTYPE. #-sb-xc-host -(declaim (ftype (function (t) (values ctype boolean &optional)) - proclaimed-ftype)) +(declaim (ftype (sfunction (t) (values ctype boolean)) proclaimed-ftype)) ;;; At run time, we represent the type of a piece of INFO in the globaldb ;;; by a small integer between 1 and 63. [0 is reserved for internal use.] diff --git a/src/compiler/generic/target-core.lisp b/src/compiler/generic/target-core.lisp index d6d177e73..99e12049f 100644 --- a/src/compiler/generic/target-core.lisp +++ b/src/compiler/generic/target-core.lisp @@ -16,8 +16,7 @@ (in-package "SB!C") -(declaim (ftype (function (fixnum fixnum) (values code-component &optional)) - allocate-code-object)) +(declaim (ftype (sfunction (fixnum fixnum) code-component) allocate-code-object)) (defun allocate-code-object (boxed unboxed) #!+gencgc (without-gcing diff --git a/src/compiler/pack.lisp b/src/compiler/pack.lisp index 498579ac3..b6586c43f 100644 --- a/src/compiler/pack.lisp +++ b/src/compiler/pack.lisp @@ -85,8 +85,7 @@ offset-iter))))))) ;;; Return true if TN has a conflict in SC at the specified offset. -(declaim (ftype (function (tn sc index) (values (or null index) &optional)) - conflicts-in-sc)) +(declaim (ftype (sfunction (tn sc index) (or null index)) conflicts-in-sc)) (defun conflicts-in-sc (tn sc offset) (declare (type tn tn) (type sc sc) (type index offset)) (offset-conflicts-in-sb tn (sc-sb sc) offset diff --git a/src/compiler/policy.lisp b/src/compiler/policy.lisp index f7041b9cd..a08c8eb1e 100644 --- a/src/compiler/policy.lisp +++ b/src/compiler/policy.lisp @@ -235,7 +235,7 @@ EXPERIMENTAL INTERFACE: Subject to change." ;;; Forward declaration of %COERCE-TO-POLICY. ;;; Definition is in 'node' so that FUNCTIONAL and NODE types are defined. ;;; Arg is declared of type T because the function explicitly checks it. -(declaim (ftype (function (t) (values policy &optional)) %coerce-to-policy)) +(declaim (ftype (sfunction (t) policy) %coerce-to-policy)) ;;; syntactic sugar for querying optimization policy qualities ;;; diff --git a/src/compiler/x86-64/system.lisp b/src/compiler/x86-64/system.lisp index c79a9628f..fabddd31d 100644 --- a/src/compiler/x86-64/system.lisp +++ b/src/compiler/x86-64/system.lisp @@ -459,11 +459,11 @@ number of CPU cycles elapsed as secondary value. EXPERIMENTAL." ;;;; -(defknown %cons-cas-pair (cons t t t t) (values t t &optional)) +(defknown %cons-cas-pair (cons t t t t) (values t t)) ;; These unsafely permits cmpxchg on any kind of vector, boxed or unboxed ;; and the same goes for instances. -(defknown %vector-cas-pair (simple-array index t t t t) (values t t &optional)) -(defknown %instance-cas-pair (instance index t t t t) (values t t &optional)) +(defknown %vector-cas-pair (simple-array index t t t t) (values t t)) +(defknown %instance-cas-pair (instance index t t t t) (values t t)) ;; 32-bit register names here are not an accident - it's a deliberate attempt ;; to keep this exactly in sync with 32-bit code in the hope that somebody diff --git a/src/compiler/x86/system.lisp b/src/compiler/x86/system.lisp index cc2dbd58a..6dfb7b270 100644 --- a/src/compiler/x86/system.lisp +++ b/src/compiler/x86/system.lisp @@ -446,11 +446,11 @@ number of CPU cycles elapsed as secondary value. EXPERIMENTAL." ;;;; -(defknown %cons-cas-pair (cons t t t t) (values t t &optional)) +(defknown %cons-cas-pair (cons t t t t) (values t t)) ;; These unsafely permits cmpxchg on any kind of vector, boxed or unboxed ;; and the same goes for instances. -(defknown %vector-cas-pair (simple-array index t t t t) (values t t &optional)) -(defknown %instance-cas-pair (instance index t t t t) (values t t &optional)) +(defknown %vector-cas-pair (simple-array index t t t t) (values t t)) +(defknown %instance-cas-pair (instance index t t t t) (values t t)) (macrolet ((define-cmpxchg-vop (name memory-operand more-stuff &optional index-arg) diff --git a/src/pcl/cache.lisp b/src/pcl/cache.lisp index 42ec49006..cc33148c9 100644 --- a/src/pcl/cache.lisp +++ b/src/pcl/cache.lisp @@ -260,7 +260,7 @@ (return-from probe-cache (values t value))) :miss (return-from probe-line (next-cache-index mask base line-size))))) - (declare (ftype (function (index) (values index &optional)) probe-line)) + (declare (ftype (sfunction (index) index) probe-line)) (let ((index (compute-cache-index cache layouts))) (when index (loop repeat (1+ (cache-depth cache)) -- 2.11.4.GIT