From 5e77691681a955a146ae8f9cbf7ec0a6509316a6 Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Wed, 4 Sep 2019 21:31:27 -0400 Subject: [PATCH] Add tmap-value forward-ref type This allows forward references in object slots to be replaced. The forward ref's ref is the object and its datum is the slot name. --- src/decode.lisp | 12 +++++++++--- src/reftable.lisp | 4 +++- 2 files changed, 12 insertions(+), 4 deletions(-) diff --git a/src/decode.lisp b/src/decode.lisp index f0c0e44..5f1c4d2 100644 --- a/src/decode.lisp +++ b/src/decode.lisp @@ -103,7 +103,8 @@ (let* ((len (or len (decode-size (size-bytes header) buffer))) (fixed-header (when (container-fixed-p header) (fast-read-byte buffer))) - (class (decode-value buffer))) + (class (decode-value buffer)) + (forward-refs nil)) (container-precheck-bytes (* 2 len) fixed-header) (unless (symbolp class) (error 'invalid-tmap-type :value class :reason "Not a symbol")) @@ -111,10 +112,15 @@ collect (let ((cons (cons nil nil))) (setf (car cons) (decode-value-or-fref buffer :car cons fixed-header)) - (setf (cdr cons) (decode-value-or-fref buffer :cdr cons nil)) + (setf (cdr cons) (decode-value-or-fref buffer :tmap-value nil (car cons))) + (when (forward-ref-p (cdr cons)) + (push (cdr cons) forward-refs)) cons) into alist finally - (return (decode-object class alist))))) + (let ((object (decode-object class alist))) + (loop for forward-ref in forward-refs + do (setf (forward-ref-ref forward-ref) object)) + (return object))))) (defun decode-container (header buffer &optional len) (let ((type (decode-container-type header))) diff --git a/src/reftable.lisp b/src/reftable.lisp index fedfe30..b98b60c 100644 --- a/src/reftable.lisp +++ b/src/reftable.lisp @@ -45,7 +45,9 @@ (setf (gethash object ref) (gethash forward-ref ref)) (remhash forward-ref ref)) (:map-value - (setf (gethash datum ref) object))))) + (setf (gethash datum ref) object)) + (:tmap-value + (setf (slot-value ref datum) object))))) (defun replace-forward-refs (id object &optional (context *ref-context*)) (loop for forward-ref in (gethash id (ref-context-forward-refs context))