cmp: make-load-form: detect circular dependencies
Init forms are deferred when possible. This change solves two problems: - init forms using uninitialized constant boxes - make forms not signaling an error when circular Partial fix for #562 (we need to fix bytecodes compiler too).
This commit is contained in:
parent
3b6dd501e6
commit
379254456e
3 changed files with 36 additions and 9 deletions
|
|
@ -268,6 +268,9 @@ lines are inserted, but the order is preserved")
|
|||
(defvar *top-level-forms* nil) ; holds { top-level-form }*
|
||||
(defvar *make-forms* nil) ; holds { top-level-form }*
|
||||
|
||||
(defvar *objects-being-created* nil) ; helps detecting circular references
|
||||
(defvar *objects-init-deferred* nil) ; helps avoiding circularity
|
||||
|
||||
;;;
|
||||
;;; top-level-form:
|
||||
;;; ( 'DEFUN' fun-name cfun lambda-expr doc-vv sp )
|
||||
|
|
|
|||
|
|
@ -134,6 +134,14 @@
|
|||
Compiler assumes it is a global."
|
||||
(slot-value c 'variable)))))
|
||||
|
||||
(define-condition circular-dependency (compiler-error)
|
||||
()
|
||||
(:report
|
||||
(lambda (c stream)
|
||||
(compiler-message-report stream c
|
||||
"Circular references in creation form for ~S."
|
||||
(compiler-message-form c)))))
|
||||
|
||||
(defun print-compiler-message (c stream)
|
||||
(unless (typep c *suppress-compiler-messages*)
|
||||
#+cmu-format
|
||||
|
|
|
|||
|
|
@ -155,15 +155,29 @@
|
|||
(add-object 0 :duplicate t :permanent t))
|
||||
|
||||
(defun add-load-form (object location)
|
||||
(when (clos::need-to-make-load-form-p object *cmp-env*)
|
||||
(if (not (eq *compiler-phase* 't1))
|
||||
(cmperr "Unable to internalize complex object ~A in ~a phase" object *compiler-phase*)
|
||||
(multiple-value-bind (make-form init-form) (make-load-form object)
|
||||
(setf (gethash object *load-objects*) location)
|
||||
(when make-form
|
||||
(push (make-c1form* 'MAKE-FORM :args location (c1expr make-form)) *make-forms*))
|
||||
(when init-form
|
||||
(push (make-c1form* 'INIT-FORM :args location (c1expr init-form)) *make-forms*))))))
|
||||
(unless (clos::need-to-make-load-form-p object *cmp-env*)
|
||||
(return-from add-load-form))
|
||||
(unless (eq *compiler-phase* 't1)
|
||||
(cmperr "Unable to internalize complex object ~A in ~a phase." object *compiler-phase*))
|
||||
(multiple-value-bind (make-form init-form) (make-load-form object)
|
||||
(setf (gethash object *load-objects*) location)
|
||||
(let (deferred)
|
||||
(when make-form
|
||||
(let ((*objects-init-deferred* nil)
|
||||
(*objects-being-created* (list* object *objects-being-created*)))
|
||||
(push (make-c1form* 'MAKE-FORM :args location (c1expr make-form)) *make-forms*)
|
||||
(setf deferred (nreverse *objects-init-deferred*))))
|
||||
(flet ((maybe-init (loc init)
|
||||
(handler-case
|
||||
(push (make-c1form* 'INIT-FORM :args loc (c1expr init)) *make-forms*)
|
||||
(circular-dependency (c)
|
||||
(if *objects-being-created*
|
||||
(push (cons location init-form) *objects-init-deferred*)
|
||||
(error c))))))
|
||||
(loop for (loc . init) in deferred
|
||||
do (maybe-init loc init)
|
||||
finally (when init-form
|
||||
(maybe-init location init-form)))))))
|
||||
|
||||
(defun add-object (object &key
|
||||
(duplicate nil)
|
||||
|
|
@ -197,6 +211,8 @@
|
|||
(vector-push-extend (list object vv ndx) array)
|
||||
vv))
|
||||
(item
|
||||
(when (member object *objects-being-created*)
|
||||
(error 'circular-dependency :form object))
|
||||
(second item))
|
||||
;; FIXME! all other branches return VV instance
|
||||
;; while this branch returns a STRING making the
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue