Introducing lazy structs.

* share/txr/stdlib/struct.tl (lnew): New macro.

* struct.c (struct_type): Turn id into a bitfield one bit
smaller than cnum. New Boolean bitfield lazy.
(struct_init): Register make-lazy-struct intrinsic.
(make_struct): Initialize lazy bitfield to zero.
(lazy_struct_init, check_init_lazy_struct): New static
functions.
(make_lazy_struct): New function.
(copy_struct, clear_struct, replace_struct, reset_struct,
lookup_slot, struct_inst_equal, struct_inst_hash):
Call check_init_lazy_struct on all structures involved.
(lookup_slot): Call check_init_lazy_struct.
(struct_inst_mark): If the struct is lazy, it has one
instance slot which must be marked, holding the argfun
function passed into make_lazy_struct.

* struct.h (make_lazy_struct): Declared.

* txr.1: Documented lnew and make-lazy-struct.

1 files changed, 12 insertions, 0 deletions

diff --git a/share/txr/stdlib/struct.tl b/share/txr/stdlib/struct.tl
index 5cbf3c83..8eb4d35c 100644
--- a/share/txr/stdlib/struct.tl
+++ b/share/txr/stdlib/struct.tl
@@ -188,6 +188,18 @@
       ((atom . args) ^(make-struct ',atom (list ,*qpairs) ,*args))
       (atom ^(make-struct ',atom (list ,*qpairs))))))
 
+(defmacro lnew (spec . pairs)
+  (if (oddp (length pairs))
+    (throwf 'eval-error "~s: slot initform arguments must occur pairwise"
+            'lnew))
+  (let ((qpairs (mappend (aret ^(',@1 ,@2)) (tuples 2 pairs))))
+    (tree-case spec
+      ((atom . args) ^(make-lazy-struct ',atom
+                                        (lambda ()
+                                          (cons (list ,*qpairs)
+                                                (list ,*args)))))
+      (atom ^(make-lazy-struct ',atom (lambda () (list (list ,*qpairs))))))))
+
 (defmacro meth (obj slot)
   ^(method ,obj ',slot))