Data update

Task/History-variables/Ada/history-variables-1.adb

@@ -0,0 +1,34 @@
+private with Ada.Containers.Indefinite_Vectors;
+generic
+   type Item_Type (<>) is private;
+package History_Variables is
+
+   type Variable is tagged limited private;
+
+   -- set and get current value
+   procedure Set(V: in out Variable; Item: Item_Type);
+   function Get(V: Variable) return Item_Type;
+
+   -- number of items in history (including the current one)
+   function Defined(V: Variable) return Natural;
+
+   -- non-destructively search for old values
+   function Peek(V: Variable; Generation: Natural := 1) return Item_Type;
+   -- V.Peek(0) returns current value; V.Peek(1) the previous value, etc.
+   -- when calling V.Peek(i), i must be in 0 .. V.Defined-1, else Constraint_Error is raised
+
+   -- destructively restore previous value
+   procedure Undo(V: in out Variable);
+   -- old V.Peek(0) is forgotten, old V.Peek(i) is new V.Peek(i-1), etc.
+   -- accordingly, V.Defined decrements by 1
+   -- special case: if V.Defined=0 then V.Undo does not change V
+
+private
+   package Vectors is new Ada.Containers.Indefinite_Vectors
+     (Index_Type   => Positive,
+      Element_Type => Item_Type);
+
+   type Variable is tagged limited record
+      History: Vectors.Vector;
+   end record;
+end History_Variables;

Task/History-variables/Ada/history-variables-2.adb

@@ -0,0 +1,35 @@
+package body History_Variables is
+
+   -- set and get
+   procedure Set(V: in out Variable; Item: Item_Type) is
+   begin
+      V.History.Prepend(Item);
+   end Set;
+
+   function Get(V: Variable) return Item_Type is
+   begin
+      return V.History.First_Element;
+   end Get;
+
+   -- number of items in history (including the current one)
+   function Defined(V: Variable) return Natural is
+   begin
+      return (1 + V.History.Last_Index) - V.History.First_Index;
+   end Defined;
+
+   -- non-destructively search
+   function Peek(V: Variable; Generation: Natural := 1) return Item_Type is
+      Index: Positive  := V.History.First_Index + Generation;
+   begin
+      if Index > V.History.Last_Index then
+         raise Constraint_Error;
+      end if;
+      return V.History.Element(Index);
+   end Peek;
+
+   procedure  Undo(V: in out Variable) is
+   begin
+      V.History.Delete_First;
+   end Undo;
+
+end History_Variables;

Task/History-variables/Ada/history-variables-3.adb

@@ -0,0 +1,32 @@
+with Ada.Text_IO, History_Variables;
+
+procedure Test_History is
+
+   package Int_With_Hist is new History_Variables(Integer);
+
+   -- define a history variable
+   I: Int_With_Hist.Variable;
+
+   Sum: Integer := 0;
+
+begin
+
+   -- assign three values
+   I.Set(3);
+   I.Set(I.Get + 4);
+   I.Set(9);
+
+   -- non-destructively display the history
+   for N in reverse 0 .. I.Defined-1 loop
+      Ada.Text_IO.Put(Integer'Image(I.Peek(N)));
+   end loop;
+   Ada.Text_IO.New_Line;
+
+   -- recall the three values
+   while I.Defined > 0 loop
+      Sum := Sum + I.Get;
+      I.Undo;
+   end loop;
+   Ada.Text_IO.Put_Line(Integer'Image(Sum));
+
+end Test_History;

Task/History-variables/Ada/history-variables-4.adb

@@ -0,0 +1,32 @@
+with Ada.Text_IO, History_Variables;
+
+procedure Test_History is
+
+   package Str_With_Hist is new History_Variables(String);
+
+   -- define a history variable
+   S: Str_With_Hist.Variable;
+
+   Sum: Integer := 0;
+
+begin
+
+   -- assign three values
+   S.Set("one");
+   S.Set(S.Get & S.Get); --"oneone"
+   S.Set("three");
+
+   -- non-destructively display the history
+   for N in reverse 0 .. S.Defined-1 loop
+      Ada.Text_IO.Put(S.Peek(Generation => N) &" ");
+   end loop;
+   Ada.Text_IO.New_Line;
+
+   -- recall the three values
+   while S.Defined > 0 loop
+      Sum := Sum + S.Get'Length;
+      S.Undo;
+   end loop;
+   Ada.Text_IO.Put_Line(Integer'Image(Sum));
+
+end Test_History;

Task/History-variables/C/history-variables.c

@@ -0,0 +1,126 @@
+#include <stddef.h>
+#include <stdlib.h>
+#include <stdio.h>
+
+//
+// high address________
+//            |________| length
+//  T *p ---> |___ ____| most recent value
+//            |____ ___|
+//                     |
+//            |___ ____
+//            |_____ __|
+//            |________| oldest value
+//  low address
+//
+
+static size_t hv__align(void const *p, size_t z) {
+	return z + ((sizeof(z) - (((size_t)p + z) % sizeof(z))) % sizeof(z));
+}
+
+static size_t hvlen(void const *p, size_t z) {
+	return *(size_t *)((char *)p + hv__align(p, z));
+}
+
+static void *hv__malloc(size_t z) {
+	size_t const m = z + (2 * sizeof(z));
+	void  *const p = malloc(m);
+	if(p) {
+		*(size_t *)((char *)p + hv__align(p, z)) = 1;
+		return p;
+	}
+	perror("");
+	abort();
+}
+
+static void *hv__realloc(void *p, size_t z, size_t n) {
+	size_t const u = hvlen(p, z);
+	size_t const o = (n > 1) ? n * z : z;
+	size_t const g = (u > 1) ? u * z : z;
+	size_t const m = o + (2 * sizeof(z));
+	void  *const b = (char *)p - (g - z);
+	p = realloc(b, m);
+	if(p) {
+		p = (char *)p + (o - z);
+		*(size_t *)((char *)p + hv__align(p, z)) = n;
+		return p;
+	}
+	perror("");
+	abort();
+}
+
+static void *hvfree(void const *p, size_t z) {
+	if(p) {
+		size_t u = hvlen(p, z);
+		size_t const o = (u > 1) ? u * z : z;
+		free((char *)p - (o - z));
+	}
+	return NULL;
+}
+
+static void *hv(void const *p, size_t z) {
+	return p ? hv__realloc((void *)p, z, hvlen(p, z) + 1) : hv__malloc(z);
+}
+#define HV__TYPE(T,V) \
+	T: *(T *)(V = (hv)((V), sizeof(*(V))))
+#define hv(V) _Generic(*(V), \
+	HV__TYPE(         char     , (V)), \
+	HV__TYPE(         short    , (V)), \
+	HV__TYPE(         int      , (V)), \
+	HV__TYPE(         long     , (V)), \
+	HV__TYPE(         long long, (V)), \
+	HV__TYPE(unsigned char     , (V)), \
+	HV__TYPE(unsigned short    , (V)), \
+	HV__TYPE(unsigned int      , (V)), \
+	HV__TYPE(unsigned long     , (V)), \
+	HV__TYPE(unsigned long long, (V)), \
+	HV__TYPE(float             , (V)), \
+	HV__TYPE(double            , (V)), \
+	HV__TYPE(long double       , (V))  \
+)
+
+static void const *hvundo(void const *p, size_t z) {
+	return p ? hv__realloc((void *)p, z, hvlen(p, z) - 1) : p;
+}
+#define hvundo(V)  (V = (hvundo)((V), sizeof(*(V))))
+
+#define hvfree(V)  (hvfree)((V), sizeof(*(V)))
+#define hvlen(V)   (hvlen)((V), sizeof(*(V)))
+
+int main(int argc, char **argv) {
+	char     const *c = NULL;
+	unsigned const *u = NULL;
+	double   const *d = NULL;
+	hv(c) = '1';
+	hv(c) = '2';
+	hv(c) = '3';
+	hv(u) = 1;
+	hv(u) = 21;
+	hvundo(u);
+	hv(u) = 12;
+	hv(u) = 123;
+	hv(d) = 1.23;
+	hv(d) = 2.31;
+	hv(d) = 3.12;
+	printf("current values        : '%c', %u, %g", *c, *u, *d);
+	putchar('\n');
+	printf("char value history    :");
+	for(size_t n = hvlen(c), i = 0; i < n; i++) {
+		printf(" [%zu]  '%c',", i, c[-i]);
+	}
+	putchar('\n');
+	printf("unsigned value history:");
+	for(size_t n = hvlen(u), i = 0; i < n; i++) {
+		printf(" [%zu] %4u,", i, u[-i]);
+	}
+	putchar('\n');
+	printf("double value history  :");
+	for(size_t n = hvlen(d), i = 0; i < n; i++) {
+		printf(" [%zu] %4g,", i, d[-i]);
+	}
+	putchar('\n');
+	hvfree(c);
+	hvfree(u);
+	hvfree(d);
+	return 0;
+}

Task/History-variables/Icon/history-variables.icon

@@ -0,0 +1,22 @@
+procedure main(A)
+   \A := ["cat","hat",7]
+   x := history()
+   every x.set(!A)
+   write("x current value is: ",x.val())
+   write("Number of saved values is: ",x.size())
+   writes("3 most recent x values from newest to oldest: ")
+   every writes(" ",x.gen()\3)
+   write()
+   while write("x value was: ",\x.get())
+   write("Number of saved values is now: ",x.size())
+end
+
+class history(x)
+   method size(); return *x; end
+   method val();  return x[-1]; end
+   method set(v); put(x,v); end
+   method get();  return pull(x); end
+   method gen();  suspend x[*x to 1 by -1]; end
+initially
+   x := []
+end