--	File IntSets.mesa
--	Management of ordered sets in VM
--	Created: March 5, 1980  3:48 AM by MN
--	Last changed: June 23, 1980  12:48 PM

DIRECTORY

IntStorageDefs: FROM "IntStorageDefs" USING [ObjectName, ObjectRecord,
	NilObjectName, StoreObject, FetchObject, ReplaceObject, DeleteObject],
IntSetsDefs: FROM "IntSetsDefs",
IODefs: FROM "IODefs" USING [SP],
StringDefs: FROM "StringDefs" USING [AppendChar, AppendLongNumber];

IntSets: PROGRAM IMPORTS IntStorageDefs, StringDefs
EXPORTS IntSetsDefs =

BEGIN OPEN IntStorageDefs, IODefs, StringDefs;

--kludge to effectively achieve StoreObject[@[SetNode[value, set]]] by
-- calling StoreObjectRecord[[SetNode[value, set]]]
StoreObjectRecord: PROCEDURE [object: ObjectRecord] RETURNS[ObjectName] = INLINE
	BEGIN
	RETURN[StoreObject[@object]];
	END;

InsertSet: PUBLIC PROCEDURE [set: ObjectName, value: LONG CARDINAL]
		RETURNS [newset: ObjectName] =
-- Insert value into set
	BEGIN
	lprev,lcurr: SetNode ObjectRecord;
	prev,curr: ObjectName;
	curr _ set;
	IF curr#NilObjectName THEN
		BEGIN
		FetchObject[curr, @lcurr];
		IF value = lcurr.contents THEN RETURN [set];	-- first element
		END;
	IF curr=NilObjectName OR value<lcurr.contents THEN
		RETURN[StoreObjectRecord[[SetNode[value, set]]]]; --stick it on the front
	DO
		prev _ curr;
		lprev _ lcurr;
		IF (curr _ lcurr.next)#NilObjectName
		THEN	BEGIN
				FetchObject[curr, @lcurr];
				SELECT lcurr.contents FROM
				<value	=>	LOOP;	--keep searching
				=value	=> RETURN[set];	--it's already in the set
				ENDCASE;
				END;
-- this is where it goes, including past-end case
		lprev.next _ StoreObjectRecord[[SetNode[value, curr]]];
		ReplaceObject[@lprev, prev];
		RETURN[set];
	ENDLOOP;
	END;

StripSet: PUBLIC PROCEDURE [set: ObjectName, n: LONG CARDINAL]
		RETURNS [newset: ObjectName] =
-- Destroy all elements having .contents >= n
	BEGIN
	lprev,lcurr: SetNode ObjectRecord;
	prev,curr: ObjectName;
	curr _ set;
	IF set=NilObjectName THEN RETURN[NilObjectName];
	FetchObject[curr, @lcurr];
	IF lcurr.contents>=n THEN --release whole set
		BEGIN
		FreeSet[set];
		RETURN[NilObjectName];
		END;
	DO	--search for first element >=n
		prev _ curr;
		lprev _ lcurr;
		IF (curr _ lcurr.next)=NilObjectName THEN EXIT;
		FetchObject[curr, @lcurr];
		IF lcurr.contents>=n THEN
			BEGIN --release rest of set
			lprev.next _ NilObjectName;
			ReplaceObject[@lprev, prev];
			FreeSet[curr];
			EXIT;
			END;
	ENDLOOP;
	RETURN[set];
	END;

FreeSet: PUBLIC PROCEDURE [set: ObjectName] =
-- Destroy entire set
	BEGIN
	lset: SetNode ObjectRecord;
	FOR set _ set, lset.next UNTIL set=NilObjectName DO
		FetchObject[set, @lset];
		DeleteObject[set];
	ENDLOOP;
	END;

EnumerateSet: PUBLIC PROCEDURE [set: ObjectName,
									proc: PROCEDURE[ObjectName,LONG CARDINAL] RETURNS[BOOLEAN]]
		RETURNS [ObjectName] =
-- Emunerate all elements of set until proc returns TRUE or none left
-- Returns last object or NilObjectName
	BEGIN
	obj: ObjectName;
	lobj: SetNode ObjectRecord;
	FOR obj _ set, lobj.next UNTIL obj=NilObjectName DO
		FetchObject[obj, @lobj];
		IF proc[obj,lobj.contents] THEN EXIT;
	ENDLOOP;
	RETURN[obj];
	END;

InSet: PUBLIC PROCEDURE [set: ObjectName, value: LONG CARDINAL]
		RETURNS [BOOLEAN] =
-- Determine if value is in set
	BEGIN
	Equals: PROCEDURE [object: ObjectName, contents: LONG CARDINAL] RETURNS[BOOLEAN] =
		BEGIN
		RETURN[contents=value];
		END;
	RETURN[EnumerateSet[set,Equals]#NilObjectName];
	END;

RemoveFromSet: PUBLIC PROCEDURE [set: ObjectName, value: LONG CARDINAL]
		RETURNS [newset: ObjectName] =
-- Remove element having contents=value from set
	BEGIN
	lprev,lcurr: SetNode ObjectRecord;
	prev,curr: ObjectName;
	IF set=NilObjectName THEN RETURN[NilObjectName];
	curr _ set;
	FetchObject[curr, @lcurr];
	IF value=lcurr.contents THEN
		BEGIN
		DeleteObject[curr];
		RETURN[lcurr.next];
		END;
	DO
		prev _ curr;
		lprev _ lcurr;
		IF (curr _ lcurr.next)=NilObjectName THEN RETURN[set]
		ELSE
			BEGIN
			FetchObject[curr, @lcurr];
			IF value=lcurr.contents THEN
				BEGIN
				lprev.next _ lcurr.next;
				ReplaceObject[@lprev, prev];
				DeleteObject[curr];
				RETURN[set];
				END;
			END;
	ENDLOOP;
	END;

PrintSet: PUBLIC PROCEDURE [set: ObjectName, string: STRING] =
-- Convert and concatenate all .contents into given string
	BEGIN
	lset: SetNode ObjectRecord;
	FOR set _ set, lset.next UNTIL set=NilObjectName DO
		FetchObject[set, @lset];
		AppendChar[string, SP];
		AppendLongNumber[string, lset.contents, 10];
	ENDLOOP;
	END;

END.
(635)\140b9B281b7B239b17B109b9B894b8B729b7B215b12B446b5B301b13B705b8B