--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
THENBEGIN
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.