← Back to branch summary

~ubuntu-branches/ubuntu/intrepid/ecl/intrepid

« back to all changes in this revision

Viewing changes to src/cmp/cmpvar.lsp

  • Committer: Bazaar Package Importer
  • Author(s): Peter Van Eynde
  • Date: 2006-06-21 09:21:21 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20060621092121-txz1f21lj0wh0f67
Tags: 0.9h-20060617-1
* New upstream version
* Updated standards version without real changes. 

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/cmp/cmpvar.lsp
104
104
;;;
105
105
;;; Check if the symbol has a symbol macro
106
106
;;;
107
 
(defun chk-symbol-macrolet (symbol)
108
 
  (do ((form symbol))
109
 
      ((not (symbolp form)) form)
110
 
    (dolist (v *vars*
111
 
             ;; At the end, loof for a DEFINE-SYMBOL-MACRO definition
112
 
             (let ((expansion (get-sysprop form 'si::symbol-macro)))
113
 
               (if expansion
114
 
                 (setq form (funcall expansion form nil))
115
 
                 (return-from chk-symbol-macrolet form))))
116
 
      ;; Search for a SYMBOL-MACROLET definition
117
 
      (cond ((consp v)
118
 
             (when (eq (first v) form)
119
 
               (setq form (second v))
120
 
               (return)))
121
 
            ((symbolp v))
122
 
            ((eq (var-name v) form)
123
 
             ;; Any macro definition has been shadowed by LET/LET*, etc.
124
 
             (return-from chk-symbol-macrolet form))))))
125
 
 
126
 
;;; During Pass 1, *vars* emulates the environment: it holds a list of var
127
 
;;; objects and the symbols 'CB' (Closure Boundary) and 'LB' (Level Boundary).
128
 
;;; 'CB' is pushed on *vars* when the compiler begins to process a closure.
129
 
;;; 'LB' is pushed on *vars* when *level* is incremented.
130
 
;;; *GLOBALS* holds a list of var objects for those variables that are
131
 
;;; not defined.  This list is used only to suppress duplicated warnings when
132
 
;;; undefined variables are detected.
 
107
(defun chk-symbol-macrolet (form)
 
108
  (loop
 
109
   (when (not (symbolp form))
 
110
     (return form))
 
111
   (let ((new-form (macroexpand-1 form *cmp-env*)))
 
112
     (when (eq new-form form)
 
113
       (return form))
 
114
     (setf form new-form))))
133
115
 
134
116
(defun c1make-var (name specials ignores types)
135
117
  (cmpck (not (symbolp name)) "The variable ~s is not a symbol." name)
187
169
;;; A variable reference (vref for short) is a list: pair
188
170
;;;     ( var-object ) Beppe(ccb) ccb-reference )
189
171
 
190
 
(defun c1vref (name &aux (ccb nil) (clb nil))
191
 
  (dolist (var *vars*)
192
 
    (declare (type var var))
193
 
    (cond ((eq var 'CB) (setq ccb t))   ; closure boundary
194
 
          ((eq var 'LB) (setq clb t))   ; level boundary
195
 
          ((consp var)
196
 
           (when (eq (first var) name) ; symbol macrolet
197
 
             (baboon)
198
 
             (return-from c1vref (c1expr (second var)))))
199
 
          ((eq (var-name var) name)
 
172
(defun c1vref (name)
 
173
  (multiple-value-bind (var ccb clb unw)
 
174
      (cmp-env-search-var name)
 
175
    (cond ((null var)
 
176
           (c1make-global-variable name :warn t
 
177
                                   :type (or (get-sysprop name 'CMP-TYPE) t)))
 
178
          ((not (var-p var))
 
179
           ;; symbol-macrolet
 
180
           (baboon))
 
181
          (t
200
182
           (when (minusp (var-ref var)) ; IGNORE.
201
183
             (cmpwarn "The ignored variable ~s is used." name)
202
184
             (setf (var-ref var) 0))
208
190
                   (clb (setf (var-ref-clb var) t
209
191
                              (var-loc var) 'OBJECT))))
210
192
           (incf (var-ref var))
211
 
           (return-from c1vref var)))) ; ccb
212
 
  (c1make-global-variable name :warn t
213
 
                          :type (or (get-sysprop name 'CMP-TYPE) t)))
214
 
 
215
 
 
216
 
;;; At each variable binding, the variable is added to *vars* which
217
 
;;; emulates the environment.
218
 
;;; The index is computed, which is used by similar to compare functions.
219
 
;;;
 
193
           var))))
 
194
 
220
195
(defun push-vars (v)
221
 
  (setf (var-index v) (length *vars*))
222
 
  (push v *vars*))
 
196
  (setf (var-index v) (length (cmp-env-variables)))
 
197
  (cmp-env-register-var v))
223
198
 
224
199
(defun unboxed (var)
225
200
  (not (eq (var-rep-type var) :object)))
297
272
    var))
298
273
 
299
274
(defun c1declare-specials (globals)
300
 
  (dolist (v globals)
301
 
    (push (c1make-global-variable v :warn nil :kind 'SPECIAL) *vars*)))
 
275
  (mapc #'cmp-env-declare-special globals))
302
276
 
303
277
(defun si::register-global (name)
304
278
  (unless (check-global name)