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

/*
 * Copyright (c) 1980 Regents of the University of California.
 * All rights reserved.  The Berkeley software License Agreement
 * specifies the terms and conditions for redistribution.
 */

#ifndef lint
static char sccsid[] = "@(#)rmothers.c	5.1 (Berkeley) 6/5/85";
#endif not lint

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