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:
Daniel Kochmański 2020-03-21 12:25:29 +01:00
parent 3b6dd501e6
commit 379254456e
3 changed files with 36 additions and 9 deletions

View file

@ -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 )

View file

@ -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

View file

@ -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