Introducing struct instance dirty flags.

* struct.c (struct struct_inst): New bitfield member, dirty.
(struct_init): Register test-dirty, test-clear-dirty and
clear-dirty intrinsics.
(make_struct): Initialize dirty flag to 1.
(slotset): If the object is clean, then determine whether
the slot being set is an instance slot. If so, then
set the dirty flag.
(test_dirty, test_clear_dirty, clear_dirty): New functions.

* struct.h (test_dirty, test_clear_dirty, clear_dirty):
Declared.

* txr.1: Documented dirty flags concept and new functions.

3 files changed, 119 insertions, 1 deletions

diff --git a/struct.c b/struct.c
index edc4038f..364050ba 100644
--- a/struct.c
+++ b/struct.c
@@ -85,6 +85,7 @@ struct struct_inst {
   struct struct_type *type;
   cnum id : sizeof (cnum) * CHAR_BIT - 1 ;
   unsigned lazy : 1;
+  unsigned dirty : 1;
   val slot[1];
 };
 
@@ -142,6 +143,9 @@ void struct_init(void)
   reg_fun(intern(lit("static-slot"), user_package), func_n2(static_slot));
   reg_fun(intern(lit("static-slot-set"), user_package),
           func_n3(static_slot_set));
+  reg_fun(intern(lit("test-dirty"), user_package), func_n1(test_dirty));
+  reg_fun(intern(lit("test-clear-dirty"), user_package), func_n1(test_clear_dirty));
+  reg_fun(intern(lit("clear-dirty"), user_package), func_n1(clear_dirty));
   reg_fun(intern(lit("static-slot-ensure"), user_package),
           func_n4o(static_slot_ensure, 3));
   reg_fun(intern(lit("call-super-method"), user_package),
@@ -463,6 +467,7 @@ val make_struct(val type, val plist, struct args *args)
   si->type = st;
   si->id = st->id;
   si->lazy = 0;
+  si->dirty = 1;
 
   sinst = cobj(coerce(mem_t *, si), st->name, &struct_inst_ops);
 
@@ -882,8 +887,16 @@ val slotset(val strct, val sym, val newval)
 
   if (symbolp(sym)) {
     loc ptr = lookup_slot(strct, si, sym);
-    if (!nullocp(ptr))
+    if (!nullocp(ptr)) {
+      if (!si->dirty) {
+        if (valptr(ptr) >= &si->slot[0] &&
+            valptr(ptr) < &si->slot[si->type->nslots])
+        {
+          si->dirty = 1;
+        }
+      }
       return set(ptr, newval);
+    }
   }
 
   no_such_slot(self, si->type->self, sym);
@@ -920,6 +933,30 @@ val static_slot_set(val stype, val sym, val newval)
   no_such_slot(self, stype, sym);
 }
 
+val test_dirty(val strct)
+{
+  const val self = lit("test-dirty");
+  struct struct_inst *si = struct_handle(strct, self);
+  return tnil(si->dirty);
+}
+
+val test_clear_dirty(val strct)
+{
+  const val self = lit("test-clear-dirty");
+  struct struct_inst *si = struct_handle(strct, self);
+  val ret = tnil(si->dirty);
+  si->dirty = 0;
+  return ret;
+}
+
+val clear_dirty(val strct)
+{
+  const val self = lit("clear-dirty");
+  struct struct_inst *si = struct_handle(strct, self);
+  si->dirty = 0;
+  return strct;
+}
+
 static void static_slot_home_fixup_rec(struct struct_type *st)
 {
   static_slot_home_fixup(st);
diff --git a/struct.h b/struct.h
index ab3e7037..604015b3 100644
--- a/struct.h
+++ b/struct.h
@@ -46,6 +46,9 @@ val slotset(val strct, val sym, val newval);
 val static_slot(val stype, val sym);
 val static_slot_set(val stype, val sym, val newval);
 val static_slot_ensure(val stype, val sym, val newval, val no_error_p);
+val test_dirty(val strct);
+val test_clear_dirty(val strct);
+val clear_dirty(val strct);
 val slotp(val type, val sym);
 val static_slot_p(val type, val sym);
 val slots(val stype);
diff --git a/txr.1 b/txr.1
index b692d6f0..8d671053 100644
--- a/txr.1
+++ b/txr.1
@@ -20740,6 +20740,30 @@ is invoked once in a type's life time, when the type is created.
 The function is also inherited by derived struct types and invoked when
 they are created.
 
+.NP* Dirty Flags
+All structure instances contain a Boolean flag called the
+.IR "dirty flag" .
+This flag is not a slot, but rather a meta-data property that is exposed
+to program access. When the flag is set, an object is said to be dirty;
+otherwise it is clean.
+
+Newly constructed objects come into existence dirty. The dirty flag
+state can be tested with the function
+.codn test-dirty .
+An object can be marked as clean by clearing its dirty flag with
+.codn clear-dirty .
+A combined operation
+.code test-clear-dirty
+is provided which clears the dirty flag, and
+returns its previous value.
+
+The dirty flag is set whenever a new value is stored into the instance
+slot of an object.
+
+Note: the dirty flag can be used to support support the caching of values
+derived from an object's slots. The derived values don't have to be
+re-computed while an object remains clean.
+
 .coNP Macro @ defstruct
 .synb
 .mets (defstruct >> { name | >> ( name << arg *)} < super
@@ -22112,6 +22136,60 @@ The
 .meta new-value
 argument specifies the value to be stored in the slot.
 
+If a successful store takes place to an instance slot of
+.metn struct-obj ,
+then the dirty flag of that object is set, causing the
+.code test-dirty
+function to report true for that object.
+
+.coNP Functions @, test-dirty @ clear-dirty and @ test-clear-dirty
+.synb
+.mets (test-dirty << struct-obj )
+.mets (clear-dirty << struct-obj )
+.mets (test-clear-dirty << struct-obj )
+.syne
+.desc
+The
+.codn test-dirty ,
+.code clear-dirty
+and
+.code test-clear-dirty
+functions comprise the interface for interacting with structure
+dirty flags.
+
+Each structure instance has a dirty flag. When this flag is set, the
+structure instance is said to be dirty, otherwise it is said to be clean. A
+newly created structure is dirty.  A structure remains dirty until its dirty
+flag is explicitly reset.  If a structure is clean, and one of its instance
+slots is overwritten with a new value, it becomes dirty.
+
+The
+.code test-dirty
+function returns the dirty flag of
+.metn struct-obj :
+.code t
+if
+.meta struct-obj
+is dirty, otherwise
+.codn nil .
+
+The
+.code clear-dirty
+function clears the dirty flag of
+.meta struct-obj
+and returns
+.meta struct-obj
+itself.
+
+The
+.code test-clear-dirty
+flag combines these operations: it makes a note of the dirty flag of
+.meta struct-obj
+and clears it. Then it returns the noted value,
+.code t
+or
+.codn nil .
+
 .coNP Function @ structp
 .synb
 .mets (structp << obj )