-
Notifications
You must be signed in to change notification settings - Fork 4
/
compile-time.lisp
120 lines (108 loc) · 5.4 KB
/
compile-time.lisp
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
(cl:in-package #:cleavir-environment)
;;;; This file defines a function COMPILE-TIME that reduces an ENTRY
;;;; to only those components that are "fully available" during
;;;; compilation. This is just as for MACROLET:
;;;; "The macro-expansion functions defined by macrolet are defined
;;;; in the lexical environment in which the macrolet form appears.
;;;; Declarations and macrolet and symbol-macrolet definitions affect
;;;; the local macro definitions in a macrolet, but the consequences
;;;; are undefined if the local macro definitions reference any local
;;;; variable or function bindings that are visible in that lexical
;;;; environment."
;;;; Therefore this function strips all lexical variables,
;;;; functions, etc, while leaving macros and declarations.
;;;; This makes CLEAVIR-ENV:EVAL easier: it can be
;;;; (funcall (cleavir-compile form env)) where cleavir-compile is
;;;; in terms of GENERATE-AST etc.
;;;; If this was done with an unstripped environment, the AST/HIR/etc.
;;;; could refer to variables/functions that are not actually defined,
;;;; which could result in bad memory reads by a trusting compiler.
;;; We don't want to keep e.g. LEXICAL-VARIABLE environments, but we do need
;;; to know they're there, because they override earlier bindings.
;;; For example, in the following BAR refers to the local function and is
;;; therefore nonconformant.
;;; (macrolet ((foo ())) (flet ((foo ())) (macrolet ((bar () (foo))))))
;;; So we keep lists of shadowed names that we don't want environments for.
(defgeneric compile-time (environment &key variable-shadow function-shadow))
;;; Default, for the global environment: just return it.
(defmethod compile-time (environment &key variable-shadow function-shadow)
(declare (cl:ignore variable-shadow function-shadow))
environment)
;;; If we don't specifically preserve an entry, lose it. (e.g. BLOCK)
(defmethod compile-time ((environment entry) &key variable-shadow function-shadow)
(compile-time (next environment)
:variable-shadow variable-shadow :function-shadow function-shadow))
;;; For most environments we have to copy, as the parent environments
;;; will be different.
(defmethod compile-time ((environment lexical-variable)
&key variable-shadow function-shadow)
(compile-time (next environment)
:variable-shadow (cons (name environment) variable-shadow)
:function-shadow function-shadow))
(defmethod compile-time ((environment function)
&key variable-shadow function-shadow)
(compile-time (next environment)
:variable-shadow variable-shadow
:function-shadow (cons (name environment) function-shadow)))
(defmethod compile-time ((environment special-variable)
&key variable-shadow function-shadow)
(if (member (name environment) variable-shadow)
(compile-time (next environment)
:variable-shadow variable-shadow
:function-shadow function-shadow)
(make-instance 'special-variable
:name (name environment)
:next (compile-time (next environment)
:variable-shadow (cons (name environment) variable-shadow)
:function-shadow function-shadow))))
(defmethod compile-time ((environment symbol-macro)
&key variable-shadow function-shadow)
(if (member (name environment) variable-shadow)
(compile-time (next environment)
:variable-shadow variable-shadow :function-shadow function-shadow)
(make-instance 'symbol-macro
:name (name environment)
:expansion (expansion environment)
:next (compile-time (next environment)
:variable-shadow (cons (name environment) variable-shadow)
:function-shadow function-shadow))))
(defmethod compile-time ((environment macro)
&key variable-shadow function-shadow)
(if (member (name environment) function-shadow)
(compile-time (next environment)
:variable-shadow variable-shadow :function-shadow function-shadow)
(make-instance 'macro
:name (name environment)
:expander (expander environment)
:next (compile-time (next environment)
:variable-shadow variable-shadow
:function-shadow (cons (name environment) function-shadow)))))
(macrolet ((defcopy (class shadow &rest initargs-and-readers)
`(defmethod compile-time ((environment ,class)
&key variable-shadow function-shadow)
(if (member (name environment) ,shadow)
(compile-time (next environment)
:variable-shadow variable-shadow
:function-shadow function-shadow)
(make-instance ',class
,@(loop for (initarg reader) on initargs-and-readers
by #'cddr
collect initarg
collect `(,reader environment))
:next (compile-time (next environment)
:variable-shadow variable-shadow
:function-shadow function-shadow))))))
(defcopy variable-type variable-shadow :name name :type type)
(defcopy function-type function-shadow :name name :type type)
(defcopy variable-ignore variable-shadow :name name :ignore ignore)
(defcopy function-ignore function-shadow :name name :ignore ignore)
(defcopy variable-dynamic-extent variable-shadow :name name)
(defcopy function-dynamic-extent function-shadow :name name)
(defcopy inline function-shadow :name name :inline inline)
(defcopy inline-expansion function-shadow :name name :ast ast))
(defmethod compile-time ((environment optimize) &key variable-shadow function-shadow)
(make-instance 'optimize
:optimize (optimize environment) :policy (policy environment)
:next (compile-time (next environment)
:variable-shadow variable-shadow
:function-shadow function-shadow)))