1 ;;;; This file implements LOAD-TIME-VALUE.
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
14 (defknown %load-time-value (t) t (flushable movable))
16 (def-ir1-translator load-time-value
17 ((form &optional read-only-p) start next result)
19 "Arrange for FORM to be evaluated at load-time and use the value produced as
20 if it were a constant. If READ-ONLY-P is non-NIL, then the resultant object is
21 guaranteed to never be modified, so it can be put in read-only storage."
22 (let ((*allow-instrumenting* nil)
23 ;; First derive an approximate type from the source form, because it allows
24 ;; us to use READ-ONLY-P implicitly.
26 ;; We also use this type to augment whatever COMPILE-LOAD-TIME-VALUE
27 ;; returns -- in practice it returns *WILD-TYPE* all the time, but
28 ;; theoretically it could return something useful for the READ-ONLY-P case.
29 (source-type (single-value-type
31 (let ((op (car form)))
32 (cond ((member op '(the truly-the))
33 (specifier-type (second form)))
35 (specifier-type 'function))
36 ((and (legal-fun-name-p op)
37 (eq :declared (info :function :where-from op)))
38 (fun-type-returns (info :function :type op)))
42 (eq :declared (info :variable :where-from form)))
43 (info :variable :type form))
46 ;; Implictly READ-ONLY-P for immutable objects.
47 (when (and (not read-only-p)
48 (csubtypep source-type (specifier-type '(or character number))))
50 (if (producing-fasl-file)
51 (multiple-value-bind (handle type)
52 ;; Value cells are allocated for non-READ-ONLY-P stop the compiler
53 ;; from complaining about constant modification -- it seems that
54 ;; we should be able to elide them all the time if we had a way
55 ;; of telling the compiler that "this object isn't really a constant
56 ;; the way you think". --NS 2009-06-28
57 (compile-load-time-value (if read-only-p
59 `(make-value-cell ,form)))
60 (when (eq *wild-type* type)
61 (setf type source-type))
64 `(%load-time-value ',handle)
65 `(value-cell-ref (%load-time-value ',handle)))))
66 (ir1-convert start next result `(truly-the ,type ,value-form))))
68 (handler-case (eval form)
70 (compiler-error "(during EVAL of LOAD-TIME-VALUE)~%~A"
72 (ir1-convert start next result
75 `(truly-the ,(ctype-of value)
77 ',(make-value-cell value)))))))))
79 (defoptimizer (%load-time-value ir2-convert) ((handle) node block)
80 (aver (constant-lvar-p handle))
81 (let ((lvar (node-lvar node))
82 (tn (make-load-time-value-tn (lvar-value handle)
84 (move-lvar-result node block (list tn) lvar)))