An Example for Oberon-D

The following example shows how to use the new feature persistence. A module List implements a list of elements with the properties name and number and a module Client offers the commands Init (to allocate the list), Insert (to insert elements in the list) and Print (to print the list). Each list has a header containing the property font, which determines the printing font.

MODULE List;

	IMPORT SYSTEM, Fonts, Persistent, PersMaps;

	TYPE
		List* = POINTER TO ListDesc;
		Elem* = POINTER TO ElemDesc;
		
		ListDesc* = RECORD
			first*: Elem;
			font*: Fonts.Font
		END;
		
		ElemDesc* = RECORD
			number*: LONGINT;
			name*: ARRAY 32 OF CHAR;
			next*: Elem
		END;
		
	PROCEDURE WriteMapper* (m: PersMaps.Map; o: SYSTEM.PTR);  (* write mapper for List *)
		VAR l: List;
	BEGIN
		l := SYSTEM.VAL (List, o); (* o interpreted as of type List *)
		m.WriteObj (l.first); 
		IF l.font # NIL THEN m.WriteString (l.font.name) ELSE m.WriteString ("") END
	END WriteMapper;
	
	PROCEDURE ReadMapper* (m: PersMaps.Map; o: SYSTEM.PTR); (* read mapper for List *)
		VAR l: List; str: ARRAY 32 OF CHAR;
	BEGIN
		l := SYSTEM.VAL (List, o); m.ReadObj (l.first); m.ReadString (str);		
		IF str # "" THEN l.font := Fonts.This (str) ELSE l.font := Fonts.Default END
	END ReadMapper;
	
BEGIN Persistent.RegisterType ("List.ListDesc", ReadMapper, WriteMapper)
END List.

The objects of type Elem are mapped automatically, the objects of type List are mapped by the registered mappers WriteMapper and ReadMapper. Note that the procedures Insert and Print of the module Client access persistent data by ordinary pointer operations.

The separation in two modules List and Client shows that the mappers need not be defined in each client, but only in the module which defines the type. It can be seen that clients have just little work with persistence.

MODULE Client;

	IMPORT Fonts, Oberon, Persistent, Texts, In, Out, List;
	
	VAR w: Texts.Writer;
	
	PROCEDURE Init*;  (* allocates a list, named root. The list header contains the property font *)
		VAR l: List.List; root, font: ARRAY 32 OF CHAR; 
	BEGIN
		In.Open; In.Name (root);  (* persistent list can be identified by a key: root*)
		In.Name (font); (* printing font *)
		NEW (l); l.first := NIL; l.font := Fonts.This (font);
		Persistent.SetRoot (l, root);
		IF Persistent.res = Persistent.alreadyExists THEN Out.String ("This root already exists") END
	END Init;
	
	PROCEDURE Insert*;  (* inserts the couples (name nr) into the list named root *)
		VAR l: List.List; e: List.Elem; nr: LONGINT; name, root: ARRAY 32 OF CHAR; 
	BEGIN
		In.Open; In.Name (root);  (* persistent list can be identified by a key: root *)	
		Persistent.GetRoot (l, root);
		IF l # NIL THEN 
			In.Name (name); In.LongInt (nr); 
			WHILE In.Done DO
				NEW (e); COPY (name, e.name); e.number := nr; e.next := l.first; l.first := e;
				In.Name (name); In.LongInt (nr)
			END
		END
	END Insert;
	
	PROCEDURE Print*;  (* prints the list with the name root *)
		VAR l: List.List; e: List.Elem; root: ARRAY 32 OF CHAR;
	BEGIN
		In.Open; In.Name (root); Persistent.GetRoot (l, root);
		IF l # NIL THEN 
			e := l.first; Texts.SetFont (w, l.font);
			WHILE e # NIL DO
				Texts.WriteString (w, e.name); Texts.WriteInt (w, e.number, 10); Texts.WriteLn (w);
				e := e.next
			END;
			Texts.Append (Oberon.Log, w.buf)
		END
	END Print;
	
BEGIN Texts.OpenWriter (w)
END Client.