/* This program implements an approximation to COBOL's INSPECT statement.	*/
/* Copyright (c) 2004 by R. A. Vowels.						*/
/* Date Written: 12 September 2004.						*/

/* It is expected that this facility will be enhanced. */

/* Examples of usage in a PL/I source program: */
/* INSPECT (field TALLYING quantity FOR LEADING 'L' BEFORE INITIAL 'A'); */
/* INSPECT (field REPLACING CHARACTERS BY 'X' BEFORE INITIAL 'A'); */

%SEARCH: PROCEDURE (S, Delimiter, Wherefrom) RETURNS (CHAR);
		DCL S CHAR, Delimiter CHAR, Wherefrom FIXED;
		DCL (J, K) FIXED;
		DCL Ch CHAR;

		DO J = Wherefrom TO LENGTH (S);
			Ch = SUBSTR(S, J, 1);
			DO K = 1 TO LENGTH (Delimiter);
				IF SUBSTR(Delimiter, K, 1) = Ch THEN RETURN (J);
			END;
			/* We fall throught here when there is no match. */
			/* in which case, keep on searching. */
		END;
		RETURN (0); /* All characters match. We are at the end of the string. */
%END SEARCH;

%INSPECT: PROCEDURE (*);
	DCL ARG CHAR;
	DCL WORDS (100) CHAR, Delimiter CHAR;
/*	DCL (End_Position, Start_Position) CHAR; */
	DCL (J, K, Apostrophe_Count) FIXED;
	DCL Name CHAR;

	Name = 'L0000' || COUNTER;

/*	Start_Position = 'Start' || COUNTER;*/
/*	End_Position   = 'End'   || COUNTER; */

	ARG = MACARGS;

	/* Parse the argument list, placing successive tokens in the array WORDS. */
	DO J = 1 TO 100;

		IF SUBSTR(ARG, 1, 1) = '''' THEN /* Search for closing apostrophe. */
			DO; /* This code deals with embedded apostrophes. */
				Apostrophe_Count = 1; /* Note: Apostrophe_Count is 0 or 1 depending on */
						/* whether an even or odd number of apostrophes has been seen. */
				DO K = 2 TO LENGTH(ARG);
					IF SUBSTR(ARG, K, 1) = '''' THEN
						IF Apostrophe_Count = 1 THEN Apostrophe_Count = 0; ELSE Apostrophe_Count = 1;
					ELSE
						IF Apostrophe_count = 0 THEN LEAVE;
				END;

				IF K > LENGTH(ARG) THEN
					DO; /* We are at the end of the string. */
						K = 0;
						IF Apostrophe_Count = 1 THEN
							NOTE ('Unterminated character string constant beginning at ' || ARG, 4);
					END;
			END;
		ELSE
			K = SEARCH (ARG, ' ', 1); /* Search for the end of a word. */

		IF K > 0 THEN
			WORDS(J) = SUBSTR(ARG, 1, K-1);
		ELSE
			WORDS(J) = ARG;
		IF K = 0 THEN LEAVE;
		K = VERIFY (ARG, ' ', K); /* Search to the start of the next word. */
		ARG = SUBSTR (ARG, K);
	END;

	IF J > 100 THEN NOTE ('More than 99 words in UNSTRING.  Remainder ignored after ' ||
		WORDS(100), 4);

ANSWER('/' || '* ' || WORDS(1)  || ' *' || '/' ) SKIP;
ANSWER('/' || '* ' || WORDS(2)  || ' *' || '/' ) SKIP;
ANSWER('/' || '* ' || WORDS(3)  || ' *' || '/' ) SKIP;
ANSWER('/' || '* ' || WORDS(4)  || ' *' || '/' ) SKIP;
ANSWER('/' || '* ' || WORDS(5)  || ' *' || '/' ) SKIP;
ANSWER('/' || '* ' || WORDS(6)  || ' *' || '/' ) SKIP;
ANSWER('/' || '* ' || WORDS(7)  || ' *' || '/' ) SKIP;
ANSWER('/' || '* ' || WORDS(8)  || ' *' || '/' ) SKIP;
ANSWER('/' || '* ' || WORDS(9)  || ' *' || '/' ) SKIP;
ANSWER('/' || '* ' || WORDS(10) || ' *' || '/' ) SKIP;

	IF WORDS(2) = 'TALLYING' THEN
		DO;
			IF WORDS(4) ^= 'FOR' THEN
				NOTE ('<FOR> expected in a TALLYING clause', 4);
			IF WORDS(5) = 'LEADING' THEN
				;
			ELSE IF WORDS(5) = 'ALL' THEN
				;
			ELSE
				NOTE ('<LEADING> or <ALL> expected in a TALLYING clause', 4);
		END;
	ELSE IF WORDS(2) = 'REPLACING' THEN
		DO;
			IF WORDS(3) ^= 'CHARACTERS' THEN
				NOTE ('<CHARACTERS> expected following <REPLACING>', 4);
			IF WORDS(4) ^= 'BY' THEN
				NOTE ('<BY> expected following <CHARACTERS>', 4);
		END;
	ELSE
		NOTE ('Missing keyword <TALLYING> or <REPLACING>', 4);


	IF WORDS(2) = 'TALLYING' THEN
		DO;
			ANSWER ('DECLARE ' || Name || ' FIXED BINARY;' ) NOSCAN SKIP COL (16);
			ANSWER (Name || ' = INDEX(' || WORDS(1) || ', ' || WORDS(9) || ');' ) NOSCAN SKIP COL (16);
			ANSWER ('IF ' || Name || ' > 1 THEN' ) NOSCAN SKIP COL (16);
			ANSWER (WORDS(3) || ' = TALLY (SUBSTR(' || WORDS(1) || ', 1, ' || Name || '-1), ' ||
				WORDS(6) || ');' ) NOSCAN SKIP COL (19);
		END;
	ELSE IF WORDS(2) = 'REPLACING' THEN
		DO;
			ANSWER ('DECLARE ' || Name || ' FIXED BINARY;' ) NOSCAN SKIP COL (16);
			ANSWER (Name || ' = INDEX(' || WORDS(1) || ', ' || WORDS(8) || ');' ) NOSCAN SKIP COL (16);
			ANSWER ('DO ' || Name || ' = 1 TO ' || Name || '-1;' ) NOSCAN SKIP COL (16);
			ANSWER ('SUBSTR(' || WORDS(1) || ', ' || Name || ', 1) = ' || WORDS(5) || ';' )
				NOSCAN SKIP COL (19);
			ANSWER ('END' ) NOSCAN SKIP COL (16);
		END;


%END INSPECT;

%ACTIVATE INSPECT;