[5d4902]: src / compiler / knownfun.lisp Maximize Restore History

Download this file

knownfun.lisp    270 lines (251 with data), 11.9 kB

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
;;;; This file contains stuff for maintaining a database of special
;;;; information about functions known to the compiler. This includes
;;;; semantic information such as side effects and type inference
;;;; functions as well as transforms and IR2 translators.
;;;; This software is part of the SBCL system. See the README file for
;;;; more information.
;;;;
;;;; This software is derived from the CMU CL system, which was
;;;; written at Carnegie Mellon University and released into the
;;;; public domain. The software is in the public domain and is
;;;; provided with absolutely no warranty. See the COPYING and CREDITS
;;;; files for more information.
(in-package "SB!C")
(/show0 "knownfun.lisp 17")
;;; IR1 boolean function attributes
;;;
;;; There are a number of boolean attributes of known functions which
;;; we like to have in IR1. This information is mostly side effect
;;; information of a sort, but it is different from the kind of
;;; information we want in IR2. We aren't interested in a fine
;;; breakdown of side effects, since we do very little code motion on
;;; IR1. We are interested in some deeper semantic properties such as
;;; whether it is safe to pass stack closures to.
(!def-boolean-attribute ir1
;; may call functions that are passed as arguments. In order to
;; determine what other effects are present, we must find the
;; effects of all arguments that may be functions.
call
;; may incorporate function or number arguments into the result or
;; somehow pass them upward. Note that this applies to any argument
;; that *might* be a function or number, not just the arguments that
;; always are.
unsafe
;; may fail to return during correct execution. Errors are O.K.
unwind
;; the (default) worst case. Includes all the other bad things, plus
;; any other possible bad thing. If this is present, the above bad
;; attributes will be explicitly present as well.
any
;; may be constant-folded. The function has no side effects, but may
;; be affected by side effects on the arguments. e.g. SVREF, MAPC.
;; Functions that side-effect their arguments are not considered to
;; be foldable. Although it would be "legal" to constant fold them
;; (since it "is an error" to modify a constant), we choose not to
;; mark these functions as foldable in this database.
foldable
;; may be eliminated if value is unused. The function has no side
;; effects except possibly cons. If a function might signal errors,
;; then it is not flushable even if it is movable, foldable or
;; unsafely-flushable. Implies UNSAFELY-FLUSHABLE. (In safe code
;; type checking of arguments is always performed by the caller, so
;; a function which SHOULD signal an error if arguments are not of
;; declared types may be FLUSHABLE.)
flushable
;; unsafe call may be eliminated if value is unused. The function
;; has no side effects except possibly cons and signalling an error
;; in the safe code. If a function MUST signal errors, then it is
;; not unsafely-flushable even if it is movable or foldable.
unsafely-flushable
;; may be moved with impunity. Has no side effects except possibly
;; consing, and is affected only by its arguments.
movable
;; The function is a true predicate likely to be open-coded. Convert
;; any non-conditional uses into (IF <pred> T NIL). Not usually
;; specified to DEFKNOWN, since this is implementation dependent,
;; and is usually automatically set by the DEFINE-VOP :CONDITIONAL
;; option.
predicate
;; Inhibit any warning for compiling a recursive definition.
;; (Normally the compiler warns when compiling a recursive
;; definition for a known function, since it might be a botched
;; interpreter stub.)
recursive
;; The function does explicit argument type checking, so the
;; declared type should not be asserted when a definition is
;; compiled.
explicit-check)
(defstruct (fun-info #-sb-xc-host (:pure t))
;; boolean attributes of this function.
(attributes (missing-arg) :type attributes)
;; TRANSFORM structures describing transforms for this function
(transforms () :type list)
;; a function which computes the derived type for a call to this
;; function by examining the arguments. This is null when there is
;; no special method for this function.
(derive-type nil :type (or function null))
;; a function that does various unspecified code transformations by
;; directly hacking the IR. Returns true if further optimizations of
;; the call shouldn't be attempted.
;;
;; KLUDGE: This return convention (non-NIL if you shouldn't do
;; further optimiz'ns) is backwards from the return convention for
;; transforms. -- WHN 19990917
(optimizer nil :type (or function null))
;; If true, a special-case LTN annotation method that is used in
;; place of the standard type/policy template selection. It may use
;; arbitrary code to choose a template, decide to do a full call, or
;; conspire with the IR2-CONVERT method to do almost anything. The
;; COMBINATION node is passed as the argument.
(ltn-annotate nil :type (or function null))
;; If true, the special-case IR2 conversion method for this
;; function. This deals with funny functions, and anything else that
;; can't be handled using the template mechanism. The Combination
;; node and the IR2-BLOCK are passed as arguments.
(ir2-convert nil :type (or function null))
;; all the templates that could be used to translate this function
;; into IR2, sorted by increasing cost.
(templates nil :type list)
;; If non-null, then this function is a unary type predicate for
;; this type.
(predicate-type nil :type (or ctype null)))
(defprinter (fun-info)
(transforms :test transforms)
(derive-type :test derive-type)
(optimizer :test optimizer)
(ltn-annotate :test ltn-annotate)
(ir2-convert :test ir2-convert)
(templates :test templates)
(predicate-type :test predicate-type))
;;;; interfaces to defining macros
;;; an IR1 transform
(defstruct (transform (:copier nil))
;; the function type which enables this transform.
;;
;; (Note that declaring this :TYPE FUN-TYPE probably wouldn't
;; work because some function types, like (SPECIFIER-TYPE 'FUNCTION0
;; itself, are represented as BUILT-IN-TYPE, and at least as of
;; sbcl-0.pre7.54 or so, that's inconsistent with being a
;; FUN-TYPE.)
(type (missing-arg) :type ctype)
;; the transformation function. Takes the COMBINATION node and
;; returns a lambda expression, or throws out.
(function (missing-arg) :type function)
;; string used in efficiency notes
(note (missing-arg) :type string)
;; T if we should emit a failure note even if SPEED=INHIBIT-WARNINGS.
(important nil :type (member t nil)))
(defprinter (transform) type note important)
;;; Grab the FUN-INFO and enter the function, replacing any old
;;; one with the same type and note.
(declaim (ftype (function (t list function &optional (or string null)
(member t nil))
*)
%deftransform))
(defun %deftransform (name type fun &optional note important)
(let* ((ctype (specifier-type type))
(note (or note "optimize"))
(info (fun-info-or-lose name))
(old (find-if (lambda (x)
(and (type= (transform-type x) ctype)
(string-equal (transform-note x) note)
(eq (transform-important x) important)))
(fun-info-transforms info))))
(if old
(setf (transform-function old) fun
(transform-note old) note)
(push (make-transform :type ctype :function fun :note note
:important important)
(fun-info-transforms info)))
name))
;;; Make a FUN-INFO structure with the specified type, attributes
;;; and optimizers.
(declaim (ftype (function (list list attributes &key
(:derive-type (or function null))
(:optimizer (or function null)))
*)
%defknown))
(defun %defknown (names type attributes &key derive-type optimizer)
(let ((ctype (specifier-type type))
(info (make-fun-info :attributes attributes
:derive-type derive-type
:optimizer optimizer))
(target-env *info-environment*))
(dolist (name names)
(let ((old-fun-info (info :function :info name)))
(when old-fun-info
;; This is handled as an error because it's generally a bad
;; thing to blow away all the old optimization stuff. It's
;; also a potential source of sneaky bugs:
;; DEFKNOWN FOO
;; DEFTRANSFORM FOO
;; DEFKNOWN FOO ; possibly hidden inside some macroexpansion
;; ; Now the DEFTRANSFORM doesn't exist in the target Lisp.
;; However, it's continuable because it might be useful to do
;; it when testing new optimization stuff interactively.
(cerror "Go ahead, overwrite it."
"~@<overwriting old FUN-INFO ~2I~_~S ~I~_for ~S~:>"
old-fun-info name)))
(setf (info :function :type name target-env) ctype)
(setf (info :function :where-from name target-env) :declared)
(setf (info :function :kind name target-env) :function)
(setf (info :function :info name target-env) info)))
names)
;;; Return the FUN-INFO for NAME or die trying. Since this is
;;; used by callers who want to modify the info, and the info may be
;;; shared, we copy it. We don't have to copy the lists, since each
;;; function that has generators or transforms has already been
;;; through here.
(declaim (ftype (function (t) fun-info) fun-info-or-lose))
(defun fun-info-or-lose (name)
(let (;; FIXME: Do we need this rebinding here? It's a literal
;; translation of the old CMU CL rebinding to
;; (OR *BACKEND-INFO-ENVIRONMENT* *INFO-ENVIRONMENT*),
;; and it's not obvious whether the rebinding to itself is
;; needed that SBCL doesn't need *BACKEND-INFO-ENVIRONMENT*.
(*info-environment* *info-environment*))
(let ((old (info :function :info name)))
(unless old (error "~S is not a known function." name))
(setf (info :function :info name) (copy-fun-info old)))))
;;;; generic type inference methods
;;; Derive the type to be the type of the xxx'th arg. This can normally
;;; only be done when the result value is that argument.
(defun result-type-first-arg (call)
(declare (type combination call))
(let ((cont (first (combination-args call))))
(when cont (continuation-type cont))))
(defun result-type-last-arg (call)
(declare (type combination call))
(let ((cont (car (last (combination-args call)))))
(when cont (continuation-type cont))))
;;; Derive the result type according to the float contagion rules, but
;;; always return a float. This is used for irrational functions that
;;; preserve realness of their arguments.
(defun result-type-float-contagion (call)
(declare (type combination call))
(reduce #'numeric-contagion (combination-args call)
:key #'continuation-type
:initial-value (specifier-type 'single-float)))
;;; Return a closure usable as a derive-type method for accessing the
;;; N'th argument. If arg is a list, result is a list. If arg is a
;;; vector, result is a vector with the same element type.
(defun sequence-result-nth-arg (n)
(lambda (call)
(declare (type combination call))
(let ((cont (nth (1- n) (combination-args call))))
(when cont
(let ((type (continuation-type cont)))
(if (array-type-p type)
(specifier-type
`(vector ,(type-specifier (array-type-element-type type))))
(let ((ltype (specifier-type 'list)))
(when (csubtypep type ltype)
ltype))))))))
;;; Derive the type to be the type specifier which is the N'th arg.
(defun result-type-specifier-nth-arg (n)
(lambda (call)
(declare (type combination call))
(let ((cont (nth (1- n) (combination-args call))))
(when (and cont (constant-continuation-p cont))
(careful-specifier-type (continuation-value cont))))))
(/show0 "knownfun.lisp end of file")