COMMENT ⊗   VALID 00007 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	ENTRY ITMNAM,SET_TYPE,XITEM,NAME_ITEM,COPYITEM,BTRIP,REVLST
C00004 00003	INTERNAL SIMPLE ITEMVAR PROCEDURE XITEM(STRING ID)
C00006 00004	INTERNAL ITEMVAR PROCEDURE BTRIP(ITEMVAR A,O,V)
C00007 00005	INTERNAL RECURSIVE MATCHING PROCEDURE EQVRLN(? ITEMVAR A,V1,V2)
C00008 00006	INTERNAL ITEMVAR PROCEDURE COPYITEM(ITEMVAR IV)
C00011 00007	INTERNAL PROCEDURE CPRLNS(ITEMVAR P1,P2)
C00013 ENDMK
C⊗;
ENTRY ITMNAM,SET_TYPE,XITEM,NAME_ITEM,COPYITEM,BTRIP,REVLST;
BEGIN "LEPAUX"

REQUIRE "ABBREV.SAI[S,RHT]" SOURCE_FILE;

IFCR DECLARATION(GLOBSW)=0 THENC DEFINE GLOBSW=0;

IFC GLOBSW THENC
	DEFINE MIN_GLOBAL_ITEM_NUMBER='6000;
ENDC

PRELOAD_WITH 
	"ANY",
	"MAINPI",
	"BINDIT",
	"EVTYPI",
	"ITEM4",
	"ITEM5",
	"ITEM6",
	"ITEM7";
OWN INTERNAL STRING ARRAY RIPNMS[0:7];

INTERNAL SIMPLE STRING PROCEDURE ITMNAM(ITEMVAR N);
	BEGIN
	STRING S;
	INTEGER I;
	IF 0≤#(N)<8 THEN RETURN(RIPNMS[#(N)]);
	S←CVIS(N,I);
	RETURN(IF I THEN "ITEM"&CVS(CVN(N)) ELSE S);
	END;

INTERNAL SIMPLE PROCEDURE SET_TYPE(ITEMVAR FOO;INTEGER TYP);
	START_CODE
	EXTERNAL INTEGER INFTB,GINFTB;
	MOVE	3,FOO;
	MOVE	1,TYP;
IFC GLOBSW THENC
	CAIL	1,MIN_GLOBAL_ITEM_NUMBER;
	SKIPA	2,GINFTB;
ENDC
	MOVE	2,INFTB;
	DPB	1,2;
	END;

! Only an expert better use this;

INTERNAL SIMPLE ITEMVAR PROCEDURE IMUNGE(ITEMVAR I;INTEGER T(1),D(0),P(0));
	BEGIN
	SET_TYPE(I,T);
	∂(I,INTEGER)←D;
	PROPS(I)←P;
	RETURN(I);
	END;

INTERNAL LIST PROCEDURE REVLST(LIST L);
	BEGIN
	! *** this can be made much more efficient ***;
	LIST LL;
	LL←NIL;
	WHILE LENGTH(L) DO 
		PUT LOP(L) IN LL BEFORE 1;
	RETURN(LL);
	END;
INTERNAL SIMPLE ITEMVAR PROCEDURE XITEM(STRING ID);
	BEGIN
	INTEGER F;
	ITEMVAR X;
	COMMENT GENERATES AN ITEM OF THE INDICATED NAME;
	X←CVSI(ID,F);
	IF F THEN 
		BEGIN
		X←NEW;
		NEW_PNAME(X,ID);
		END;
	RETURN(X);
	END;


INTERNAL SIMPLE ITEMVAR PROCEDURE NAME_ITEM(ITEMVAR ITM;STRING ID);
	BEGIN
	INTEGER F;ITEMVAR I;
	IF ID THEN
		BEGIN
		I←CVSI(ID,F);
		IF ¬F∧(I≠ITM) THEN
			USERERR(CVN(I),1," ALREADY HAVE AN ITEM NAMED "&ID&" ");
		NEW_PNAME(ITM,ID);
		END;
	RETURN(ITM);
	END;

INTERNAL PROCEDURE ZAPITEM(ITEMVAR IV);
	BEGIN
	ERASE IV⊗ANY≡ANY;
	ERASE ANY⊗IV≡ANY;
	ERASE ANY⊗ANY≡IV;
	DELETE (IV);
	END;
INTERNAL ITEMVAR PROCEDURE BTRIP(ITEMVAR A,O,V);
	BEGIN
	ITEMVAR L,N;
	N←NEW;
	MAKE N⊗N≡[A⊗O≡V];
	L←[A⊗O≡V]; ERASE N⊗N≡ANY;
	DELETE(N);
	RETURN( L);
	END;
INTERNAL RECURSIVE MATCHING PROCEDURE EQVRLN(? ITEMVAR A,V1,V2);
	BEGIN
	∀ ? A, ? V1, ? V2 | A⊗V1≡V2 DO SUCCEED;
	∀ ? A, ? V1, ? V2 | A⊗V2≡V1 ∧ (¬A⊗V1≡V2) DO SUCCEED;
	FAIL;
	END;
INTERNAL ITEMVAR PROCEDURE COPYITEM(ITEMVAR IV);
	BEGIN 
	COMMENT RETURNS NEW(DATUM(IV));
	CASE TYPEIT(IV) OF

		BEGIN
		
	[0]	BEGIN
		USERERR(CVN(IV),1," IS A DELETED ITEM.  COPYITEM LOSES HERE");
		RETURN(NEW);
		END;

	[1]	RETURN(NEW); COMMENT UNTYPED;

	[2]	BEGIN COMMENT A BRACKETED TRIPLE;
		USERERR(CVN(IV),1,"COPYITEM DOESNT KNOW ABOUT BRACKETED TRIPLES");
		RETURN(NEW);
		END;

	[3]	RETURN(NEW(DATUM(IV,STRING)));
	[4]	RETURN(NEW(DATUM(IV,REAL)));
	[5]	RETURN(NEW(DATUM(IV,INTEGER)));
	[6]	RETURN(NEW(DATUM(IV,SET)));
	[7]	RETURN(NEW(DATUM(IV,LIST)));
	[8]	BEGIN
		ITEMVAR XX; XX←NEW;
		ASSIGN(XX,DATUM(IV));
		RETURN(XX);
		END;
	[9]	BEGIN
		USERERR(CVN(IV),1," COPYITEM LOSES FOR PROCESSES");
		RETURN(NEW);
		END;
	[10]	BEGIN
		USERERR(CVN(IV),1," COPYITEM LOSES FOR EVENTS");
		RETURN(NEW);
		END;
	[11]	BEGIN
		USERERR(CVN(IV),1," COPYITEM LOSES FOR CONTEXTS");
		RETURN(NEW);
		END;
	[12]	BEGIN
		USERERR(CVN(IV),1," COPYITEM LOSES FOR REF ITEMS");
		RETURN(NEW);
		END;
	[16]	RETURN(NEW(DATUM(IV,STRING ARRAY)));
	[17]	RETURN(NEW(DATUM(IV,REAL ARRAY)));
	[18]	RETURN(NEW(DATUM(IV,INTEGER ARRAY)));
	[19]	RETURN(NEW(DATUM(IV,SET ARRAY)));
	[20]	RETURN(NEW(DATUM(IV,LIST ARRAY)));
	[24]	BEGIN
		USERERR(CVN(IV),1," CPOYITEM LOSES FOR CONTEXT ARRAYS");
		RETURN(NEW);
		END;
	[25]
		END;

	END;

INTERNAL PROCEDURE CPRLNS(ITEMVAR P1,P2);
	BEGIN
	ITEMVAR X,Y;
	∀ X,Y | P1⊗X≡Y DO MAKE P2⊗X≡Y;
	∀ X,Y | X⊗P1≡Y DO MAKE X⊗P2≡Y;
	∀ X,Y | X⊗Y≡P1 DO MAKE X⊗Y≡P2;
	END;

INTERNAL SIMPLE ITEMVAR PROCEDURE ITPCHK(ITEMVAR I;INTEGER T);
	BEGIN
	IF TYPEIT(I)≠T THEN
		USERERR(1,1,"ITEMVAR "&ITMNAM(I)&" HAS TYPE "&CVS(TYPEIT(I))&
				" INSTEAD OF "&CVS(T));
	RETURN(I);
	END;

INTERNAL SIMPLE ITEMVAR PROCEDURE PRPCHK(ITEMVAR I;INTEGER P);
	BEGIN
	IF ¬(PROPS(I) LAND P) THEN
		USERERR(1,1,"ITEMVAR "&ITMNAM(I)&" LACKS PROP "&CVOS(P));
	RETURN(I);
	END;

INTERNAL SIMPLE ITEMVAR PROCEDURE PRPON(ITEMVAR I;INTEGER P);
	BEGIN
	PROPS(I)←PROPS(I) LOR P;
	RETURN(I);
	END;

INTERNAL SIMPLE ITEMVAR PROCEDURE PRPOFF(ITEMVAR I;INTEGER P);
	BEGIN
	PROPS(I)←PROPS(I) LAND (LNOT P);
	RETURN(I);
	END;

END