[unix-history] / usr / src / usr.bin / pascal / pxp / rmothers.c

static	char *sccsid = "@(#)rmothers.c	1.1 (Berkeley) %G%";
/* Copyright (c) 1983 Regents of the University of California */
#ifdef RMOTHERS
    /* and the rest of the file */

#include "0.h"
#include "tree.h"

    /*
     *	translate extended case statements to pascal (for tex).
     *	don knuth should know better.  enough said.
     *		... peter 5/4/83
     *
     *	extended case statements have the form:
     *	    case expresion of
     *		label1,label2,...: statement1;
     *		...
     *		others: otherstatement
     *		end
     *	which i am going to translate to:
     *	    if expression in [ label1,label2,...] then
     *		case expression of
     *		    label1,label2,...: statement1;
     *		    ...
     *		    end
     *	    else otherstatement
     *	which has the effect that the expression will be evaluated twice.
     *	i've looked very briefly at all cases in tex and
     *	they seem to be variables or pure functions.
     *	for simplicity i'm assuming that the others is the last labeled
     *	statement, and that no other labels appear with the label others.
     *	this appears correct from the tex82 documentation.
     */

    /*
     *	given a case statement tree and the address of an others pointer,
     *	amputate the others statement from the case statement tree
     *	and hang it on the the others pointer.
     *
     *	Case statement
     *	r	[0]	T_CASE
     *		[1]	lineof "case"
     *		[2]	expression
     *		[3]	list of cased statements:
     *			cstat	[0]	T_CSTAT
     *				[1]	lineof ":"
     *				[2]	list of constant labels
     *				[3]	statement
     */
needscaseguard(r, otherspp)
    int	*r;
    int	**otherspp;
{
    int	*statlistp;
    int	*cutpointer;
    int	*lstatementp;
    int	*lablistp;
    int	*label;
    int	hasothers;

    *otherspp = NIL;
    hasothers = 0;
    if (!rmothers) {
	return hasothers;
    }
    for (cutpointer = &r[3], statlistp = r[3];
	 statlistp != NIL;
	 cutpointer = &statlistp[2], statlistp = statlistp[2]) {
	lstatementp = statlistp[1];
	if (lstatementp == NIL)
	    continue;
	lablistp = lstatementp[2];
	if (lablistp != NIL) {
	    label = lablistp[1];
		/* only look at the first label */
	    if (label != NIL &&
		label[0] == T_ID && !strcmp(label[1],"others")) {
		    hasothers = 1;
		    *otherspp = lstatementp[3];
		    *cutpointer = NIL;
		    if (statlistp[2] != NIL) {
			panic("others not last case");
		    }
		    if (lablistp[2] != NIL) {
			panic("others not only case label");
		    }
	    }
	}
    }
    return hasothers;
}

precaseguard(r)
    int	*r;
{
    int	*statlistp;
    int	*cutpointer;
    int	*lstatementp;
    int	*lablistp;
    int	*label;
    int	hadsome;
    int	counter;

    if (!rmothers) {
	return;
    }
    ppkw("if");
    ppspac();
    rvalue(r[2], NIL);
    ppspac();
    ppkw("in");
    ppgoin(DECL);
    ppnl();
    indent();
    ppsep("[");
    hadsome = 0;
    counter = 0;
    for (statlistp = r[3]; statlistp != NIL; statlistp = statlistp[2]) {
	lstatementp = statlistp[1];
	if (lstatementp == NIL)
	    continue;
	for (lablistp = lstatementp[2];lablistp != NIL;lablistp = lablistp[2]) {
	    label = lablistp[1];
	    if (hadsome) {
		if (counter < 8) {
		    ppsep(", ");
		} else {
		    ppsep(",");
		    ppnl();
		    indent();
		    ppspac();
		    counter = 0;
		}
	    } else {
		hadsome = 1;
	    }
	    gconst(label);
	    counter += 1;
	}
    }
    ppsep("]");
    ppspac();
    ppkw("then");
    ppgoout(DECL);
    ppgoin(STAT);
    ppnl();
    indent();
}

    /*
     *	given an others statement, hang it on the else branch of the guard.
     */
postcaseguard(othersp)
    int	*othersp;
{
    if (!rmothers) {
	return;
    }
    ppgoout(STAT);
    ppnl();
    indent();
    ppkw("else");
    ppgoin(STAT);
    if (othersp[0] == T_BLOCK) {
	ppnl();
	indent();
	ppstbl1(othersp, STAT);
	ppstbl2();
    } else {
	statement(othersp);
    }
    ppgoout(STAT);
}
#endif RMOTHERS
Commit	Line	Data
696b4d8f PK	1	static char *sccsid = "@(#)rmothers.c 1.1 (Berkeley) %G%";
	2	/* Copyright (c) 1983 Regents of the University of California */
	3	#ifdef RMOTHERS
	4	/* and the rest of the file */
	5
	6	#include "0.h"
	7	#include "tree.h"
	8
	9	/*
	10	* translate extended case statements to pascal (for tex).
	11	* don knuth should know better. enough said.
	12	* ... peter 5/4/83
	13	*
	14	* extended case statements have the form:
	15	* case expresion of
	16	* label1,label2,...: statement1;
	17	* ...
	18	* others: otherstatement
	19	* end
	20	* which i am going to translate to:
	21	* if expression in [ label1,label2,...] then
	22	* case expression of
	23	* label1,label2,...: statement1;
	24	* ...
	25	* end
	26	* else otherstatement
	27	* which has the effect that the expression will be evaluated twice.
	28	* i've looked very briefly at all cases in tex and
	29	* they seem to be variables or pure functions.
	30	* for simplicity i'm assuming that the others is the last labeled
	31	* statement, and that no other labels appear with the label others.
	32	* this appears correct from the tex82 documentation.
	33	*/
	34
	35	/*
	36	* given a case statement tree and the address of an others pointer,
	37	* amputate the others statement from the case statement tree
	38	* and hang it on the the others pointer.
	39	*
	40	* Case statement
	41	* r [0] T_CASE
	42	* [1] lineof "case"
	43	* [2] expression
	44	* [3] list of cased statements:
	45	* cstat [0] T_CSTAT
	46	* [1] lineof ":"
	47	* [2] list of constant labels
	48	* [3] statement
	49	*/
	50	needscaseguard(r, otherspp)
	51	int *r;
	52	int **otherspp;
	53	{
	54	int *statlistp;
	55	int *cutpointer;
	56	int *lstatementp;
	57	int *lablistp;
	58	int *label;
	59	int hasothers;
	60
	61	*otherspp = NIL;
	62	hasothers = 0;
	63	if (!rmothers) {
	64	return hasothers;
65	}
66	for (cutpointer = &r[3], statlistp = r[3];
67	statlistp != NIL;
68	cutpointer = &statlistp[2], statlistp = statlistp[2]) {
69	lstatementp = statlistp[1];
70	if (lstatementp == NIL)
71	continue;
72	lablistp = lstatementp[2];
73	if (lablistp != NIL) {
74	label = lablistp[1];
75	/* only look at the first label */
76	if (label != NIL &&
77	label[0] == T_ID && !strcmp(label[1],"others")) {
78	hasothers = 1;
79	*otherspp = lstatementp[3];
80	*cutpointer = NIL;
81	if (statlistp[2] != NIL) {
82	panic("others not last case");
83	}
84	if (lablistp[2] != NIL) {
85	panic("others not only case label");
86	}
87	}
88	}
89	}
90	return hasothers;
91	}
92
93	precaseguard(r)
94	int *r;
95	{
96	int *statlistp;
97	int *cutpointer;
98	int *lstatementp;
99	int *lablistp;
100	int *label;
101	int hadsome;
102	int counter;
103
104	if (!rmothers) {
105	return;
106	}
107	ppkw("if");
108	ppspac();
109	rvalue(r[2], NIL);
110	ppspac();
111	ppkw("in");
112	ppgoin(DECL);
113	ppnl();
114	indent();
115	ppsep("[");
116	hadsome = 0;
117	counter = 0;
118	for (statlistp = r[3]; statlistp != NIL; statlistp = statlistp[2]) {
119	lstatementp = statlistp[1];
120	if (lstatementp == NIL)
121	continue;
122	for (lablistp = lstatementp[2];lablistp != NIL;lablistp = lablistp[2]) {
123	label = lablistp[1];
124	if (hadsome) {
125	if (counter < 8) {
126	ppsep(", ");
127	} else {
128	ppsep(",");
129	ppnl();
130	indent();
131	ppspac();
132	counter = 0;
133	}
134	} else {
135	hadsome = 1;
136	}
137	gconst(label);
138	counter += 1;
139	}
140	}
141	ppsep("]");
142	ppspac();
143	ppkw("then");
144	ppgoout(DECL);
145	ppgoin(STAT);
146	ppnl();
147	indent();
148	}
149
150	/*
151	* given an others statement, hang it on the else branch of the guard.
152	*/
153	postcaseguard(othersp)
154	int *othersp;
155	{
156	if (!rmothers) {
157	return;
158	}
159	ppgoout(STAT);
160	ppnl();
161	indent();
162	ppkw("else");
163	ppgoin(STAT);
164	if (othersp[0] == T_BLOCK) {
165	ppnl();
166	indent();
167	ppstbl1(othersp, STAT);
168	ppstbl2();
169	} else {
170	statement(othersp);
171	}
172	ppgoout(STAT);
173	}
174	#endif RMOTHERS