1;;;; This software is part of the SBCL system. See the README file for
2;;;; more information.
3
4;;;; This software is derived from software originally released by Xerox
5;;;; Corporation. Copyright and release statements follow. Later modifications
6;;;; to the software are in the public domain and are provided with
7;;;; absolutely no warranty. See the COPYING and CREDITS files for more
8;;;; information.
9
10;;;; copyright information from original PCL sources:
11;;;;
12;;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation.
13;;;; All rights reserved.
14;;;;
15;;;; Use and copying of this software and preparation of derivative works based
16;;;; upon this software are permitted. Any distribution of this software or
17;;;; derivative works must comply with all applicable United States export
18;;;; control laws.
19;;;;
20;;;; This software is made available AS IS, and Xerox Corporation makes no
21;;;; warranty about the software, its performance or its conformity to any
22;;;; specification.
23
24(in-package "SB-PCL")
25
26(eval-when (:compile-toplevel :load-toplevel :execute)
27(defparameter *checking-or-caching-list*
28  '((t nil (class) nil)
29    (t nil (class class) nil)
30    (t nil (class class class) nil)
31    (t nil (class class t) nil)
32    (t nil (class class t t) nil)
33    (t nil (class class t t t) nil)
34    (t nil (class t) nil)
35    (t nil (class t t) nil)
36    (t nil (class t t t) nil)
37    (t nil (class t t t t) nil)
38    (t nil (class t t t t t) nil)
39    (t nil (class t t t t t t) nil)
40    (t nil (t class) nil)
41    (t nil (t class t) nil)
42    (t nil (t t class) nil)
43    (t nil (class) t)
44    (t nil (class class) t)
45    (t nil (class t) t)
46    (t nil (class t t) t)
47    (t nil (class t t t) t)
48    (t nil (t class) t)
49    (t t (class) nil)
50    (t t (class class) nil)
51    (t t (class class class) nil)
52    (nil nil (class) nil)
53    (nil nil (class class) nil)
54    (nil nil (class class t) nil)
55    (nil nil (class class t t) nil)
56    (nil nil (class t) nil)
57    (nil nil (t class t) nil)
58    (nil nil (class) t)
59    (nil nil (class class) t)))
60) ; EVAL-WHEN
61
62;;; Rather than compiling the constructors here, just tickle the range
63;;; of shapes defined above, leaving the generation of the
64;;; constructors to precompile-dfun-constructors.
65(dolist (key *checking-or-caching-list*)
66  (destructuring-bind (cached-emf-p return-value-p metatypes applyp) key
67    (multiple-value-bind (args generator)
68        (if cached-emf-p
69            (if return-value-p
70                (values (list metatypes) 'emit-constant-value)
71                (values (list metatypes applyp) 'emit-caching))
72            (if return-value-p
73                (values (list metatypes) 'emit-in-checking-p)
74                (values (list metatypes applyp) 'emit-checking)))
75      (apply #'get-dfun-constructor generator args))))
76