COMMENT CONST HEADER FILE;

"
This file is the header for using the CONST generic function.
The CONST function takes as its argument an integer,real,list,set
or string expression and returns a local item whose datum is that
value. This differs from the use of NEW in that everytime CONST is
called with the same value it returns the same item as long as the
user has not violated the constraint that he must use the datum of
a CONST item as a value and must not assign a new value to the datum, and
he must not DELETE an item returned by CONST.
By using the CONST function we can have relations of values rather 
than variables.
"
REQUIRE "⊂⊃⊂⊃" DELIMITERS;
REQUIRE "CONST.REL[LEP,JRL]" LOAD_MODULE;

EXTERNAL INTEGER ITEMVAR PROCEDURE ICONST(INTEGER Y);
EXTERNAL REAL ITEMVAR PROCEDURE RCONST(REAL Y);
EXTERNAL LIST ITEMVAR PROCEDURE LCONST(LIST Y);
EXTERNAL SET ITEMVAR PROCEDURE SCONST(SET Y);
EXTERNAL STRING ITEMVAR PROCEDURE STCONS(STRING Y);

DEFINE CKTYP(Y) = ⊂
	(__QQ_ LAND CHECK_TYPE(Y)= CHECK_TYPE(Y))⊃;
DEFINE CONST(X) = ⊂
	DEFINE __QQ_= EXPR_TYPE(X);
	IFCR CKTYP(INTEGER) THENC ICONST ELSEC
	 IFCR CKTYP(REAL) THENC RCONST ELSEC
	  IFCR CKTYP(LIST) THENC LCONST ELSEC
	   IFCR CKTYP(SET) THENC SCONST ELSEC
	    IFCR CKTYP(STRING) THENC STCONS ELSEC "CONST BUG"## ENDC
	   ENDC
	  ENDC
         ENDC
	ENDC
		(X)⊃;