4.3BSD/usr/contrib/B/src/bint/b2cmd.c

/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */

/*
  $Header: b2cmd.c,v 1.4 85/08/22 16:54:17 timo Exp $
*/

#include "b.h"
#include "b0fea.h"
#include "b1obj.h"
#include "b2par.h" 
#include "b2key.h"
#include "b2syn.h"
#include "b2nod.h"
#include "b3env.h"
#include "b3err.h"
#include "b3ext.h"

/* ******************************************************************** */
/*		command_suite						*/
/* ******************************************************************** */

Forward parsetree cmd_seq();

Visible parsetree cmd_suite(cil, first) intlet cil; bool first; {
	if (ateol())
		return cmd_seq(cil, first);
	else {
		parsetree v; value c; intlet l= lino;
		suite_command(&v, &c);
		return node5(SUITE, mk_integer(l), v, c, NilTree);
	}
}

Hidden parsetree cmd_seq(cil, first) intlet cil; bool first; {
	value c; intlet level, l;
	level= ilev(); l= lino;
	if (is_comment(&c)) 
		return node5(SUITE, mk_integer(l), NilTree, c,
				cmd_seq(cil, first));
	if ((level == cil && !first) || (level > cil && first)) {
		parsetree v;
		findceol();
		suite_command(&v, &c);
		return node5(SUITE, mk_integer(l), v, c, cmd_seq(level, No));
	}
	veli();
	return NilTree;
}

Visible Procedure suite_command(v, c) parsetree *v; value *c; {
	*v= NilTree; *c= Vnil;
	if (!(control_command(v) || simple_command(v, c))) 
		parerr(MESS(2000, "no command where expected"));
}

/* ******************************************************************** */
/*		is_comment, tail_line					*/
/* ******************************************************************** */

Visible bool is_comment(v) value *v; {
	txptr tx0= tx;
	skipsp(&tx);
	if (comment_sign()) {
		while (Space(Char(tx0-1))) tx0--;
		while (!Eol(tx)) tx++;
		*v= cr_text(tx0, tx);
		return Yes;
	}
	tx= tx0;
	return No;
}

Visible value tail_line() {
	value v;
	if (is_comment(&v)) return v;
	if (!ateol()) parerr(MESS(2001, "something unexpected following this line"));
	return Vnil;
}

/* ******************************************************************** */
/*		simple_command						*/
/*									*/
/* ******************************************************************** */

Forward bool bas_com(), term_com(), udr_com();

Visible bool simple_command(v, c) parsetree *v; value *c; {
	return bas_com(v) || term_com(v) || udr_com(v)
		? (*c= tail_line(), Yes) : No;
}

/* ******************************************************************** */
/*		basic_command						*/
/* ******************************************************************** */

Forward value cr_newlines();

Hidden bool bas_com(v) parsetree *v; {
	txptr ftx, ttx; parsetree e, t;
	if (check_keyword()) {
			*v= node2(CHECK, test(ceol));
	} else if (choose_keyword()) {
			req(K_FROM_choose, ceol, &ftx, &ttx);
			t= targ(ftx); tx= ttx;
			*v= node3(CHOOSE, t, expr(ceol));
	} else if (delete_keyword()) {
			*v= node2(DELETE, targ(ceol));
	} else if (draw_keyword()) {
			*v= node2(DRAW, targ(ceol));
	} else if (insert_keyword()) {
			req(K_IN_insert, ceol, &ftx, &ttx);
			e= expr(ftx); tx= ttx;
			*v= node3(INSERT, e, targ(ceol));
	} else if (put_keyword()) {
			req(K_IN_put, ceol, &ftx, &ttx);
			e= expr(ftx); tx= ttx;
			*v= node3(PUT, e, targ(ceol));
	} else if (read_keyword()) {
			if (find(K_RAW, ceol, &ftx, &ttx)) {
				*v= node2(READ_RAW, targ(ftx)); tx= ttx;
				upto(ceol, K_RAW);
			} else {
				req(K_EG, ceol, &ftx, &ttx);
				t= targ(ftx); tx= ttx;
				*v= node3(READ, t, expr(ceol));
			}
	} else if (remove_keyword()) {
			req(K_FROM_remove, ceol, &ftx, &ttx);
			e= expr(ftx); tx= ttx;
			*v= node3(REMOVE, e, targ(ceol));
	} else if (setrandom_keyword()) {
			*v= node2(SET_RANDOM, expr(ceol));
	} else if (write_keyword()) {
			intlet b_cnt= 0, a_cnt= 0;
			skipsp(&tx);
			if (Ceol(tx))
				parerr(MESS(2002, "no parameter where expected"));
			while (nwl_sign()) {b_cnt++; skipsp(&tx); }
			if (Ceol(tx)) e= NilTree;
			else {
				ftx= ceol;
				while (Space(Char(ftx-1)) || Char(ftx-1) == '/')
					if (Char(--ftx) == '/') a_cnt++;
				skipsp(&tx);
				e= ftx > tx ? expr(ftx) : NilTree;
			}
			*v= node4(WRITE,
				  cr_newlines(b_cnt), e, cr_newlines(a_cnt));
			tx= ceol;
	} else return No;
	return Yes;
}

Hidden value cr_newlines(cnt) intlet cnt; {
	value v, t= mk_text("/"), n= mk_integer(cnt);
	v= repeat(t, n);
	release(t); release(n);
	return v;
}

/* ******************************************************************** */
/*		terminating_command					*/
/* ******************************************************************** */

Visible bool term_com(v) parsetree *v; {
	if (fail_keyword()) {
		upto(ceol, K_FAIL);
		*v= node1(FAIL);
	} else if (quit_keyword()) {
		upto(ceol, K_QUIT);
		*v= node1(QUIT);
	} else if (return_keyword())
		*v= node2(RETURN, expr(ceol));
	else if (report_keyword())
		*v= node2(REPORT, test(ceol));
	else if (succeed_keyword()) {
		upto(ceol, K_SUCCEED);
		*v= node1(SUCCEED);
	} else return No;
	return Yes;
}

/* ******************************************************************** */
/*		user_defined_command; refined_command			*/
/* ******************************************************************** */

Forward value hu_actuals();
#ifdef EXT_COMMAND
Forward bool extended_command();
#endif

Hidden bool udr_com(v) parsetree *v; {
	value w;
	if (is_keyword(&w)) {
#ifdef EXT_COMMAND
		if (extended_command(w, v))
			return Yes;
#endif
		if (!in(w, kwlist)) {
			*v= node4(USER_COMMAND,
				copy(w), hu_actuals(ceol, w), Vnil);
			return Yes;
		}
		release(w);
	}
	return No;
}

Hidden value hu_actuals(q, kw) txptr q; value kw; {
	parsetree e; value v, w;
	txptr ftx;
	skipsp(&tx);
	if (!findkw(q, &ftx)) ftx= q;
	e= Text(ftx) ? expr(ftx) : NilTree;
	v= Text(q) ? hu_actuals(q, keyword()) : Vnil;
	w= node5(ACTUAL, kw, e, v, Vnil);
	return w;
}

#ifdef EXT_COMMAND

/* ******************************************************************** */
/*		extended_command					*/
/* ******************************************************************** */

Hidden bool extended_command(w, v) value w, *v; {
	string name, arg; ext *e; int i; value args[MAXEARGS], a;
	txptr ftx, ttx;
	extern bool extcmds; /* Flag set in main by -E option */
	if (!extcmds) return No;
	name= strval(w);
	for (e= extensions; e->e_name != 0; ++e) {
		if (strcmp(e->e_name, name) == 0) break;
	}
	if (e->e_name == 0) return No;
	for (i= 0; i < MAXEARGS && (arg= e->e_args[i]) != 0; ++i) {
		if (arg[1] != '\0') req(arg+1, ceol, &ftx, &ttx);
		else ftx= ceol;
		switch (arg[0]) {
		case 'e': args[i]= expr(ftx); break;
		case 't': args[i]= targ(ftx); break;
		default: psyserr(MESS(2003, "bad entry in extended_command table"));
		}
		if (arg[1] != '\0') tx= ttx;
	}
	if (i == 0) arg= e->e_name;
	else {
		arg= e->e_args[i-1];
		if (arg[1] != '\0') ++arg;
		else switch (arg[0]) {
		case 'e': arg= "expression"; break;
		case 't': arg= "target"; break;
		}
	}
	upto(ceol, arg);
	if (i == 0) a= Vnil;
	else {
		a= mk_compound(i);
		while (--i >= 0) *Field(a, i)= args[i];
	}
	*v= node3(EXTENDED_COMMAND, w, a);
	return Yes;
}

#endif EXT_COMMAND

/* ******************************************************************** */
/*		control_command						*/
/* ******************************************************************** */

Forward parsetree alt_suite();

Visible bool control_command(v) parsetree *v; {
	parsetree e, t; value c;
	txptr ftx, ttx, utx, vtx;
	skipsp(&tx);
	if (if_keyword()) {
			req(":", ceol, &utx, &vtx);
			t= test(utx); tx= vtx;
			if (!is_comment(&c)) c= Vnil;
			*v= node4(IF, t, c, cmd_suite(cur_ilev, Yes));
	} else if (select_keyword()) {
			need(":");
			c= tail_line();
			*v= node3(SELECT, c, alt_suite());
	} else if (while_keyword()) {
			req(":", ceol, &utx, &vtx);
			t= test(utx); tx= vtx;
			if (!is_comment(&c)) c= Vnil;
			*v= node4(WHILE, t, c, cmd_suite(cur_ilev, Yes));
	} else if (for_keyword()) {
			req(":", ceol, &utx, &vtx);
			req(K_IN_for, ceol, &ftx, &ttx);
			if (ttx > utx) {
				parerr(MESS(2004, "IN after colon"));
				ftx= utx= tx; ttx= vtx= ceol;
			}
			idf_cntxt= In_ranger;
			t= idf(ftx); tx= ttx;
			e= expr(utx); tx= vtx;
			if (!is_comment(&c)) c= Vnil;
			*v= node5(FOR, t, e, c, cmd_suite(cur_ilev, Yes));
	} else return No;
	return Yes;
}

/* ******************************************************************** */
/*		alternative_suite					*/
/* ******************************************************************** */

Forward parsetree alt_seq();

Hidden parsetree alt_suite() {
	parsetree v; bool empty= Yes;
	v= alt_seq(&empty, cur_ilev, Yes, No);
	if (empty) parerr(MESS(2005, "no alternative suite where expected"));
	return v;
}

Hidden parsetree 
alt_seq(empty, cil, first, else_encountered) 
	bool *empty, first, else_encountered; intlet cil;
{
	value c; intlet level, l;
	level= ilev(); l= lino;
	if (is_comment(&c)) 
		return node6(TEST_SUITE, mk_integer(l), NilTree, c, NilTree,
				alt_seq(empty, cil, first, else_encountered));
	if ((level == cil && !first) || (level > cil && first)) {
		parsetree v, s; txptr ftx, ttx;
		if (else_encountered)
			parerr(MESS(2006, "after ELSE no more alternatives allowed"));
		findceol();
		req(":", ceol, &ftx, &ttx);
		*empty= No;
		if (else_keyword()) {
			upto(ftx, K_ELSE); tx= ttx;
			if (!is_comment(&c)) c= Vnil;
			s= cmd_suite(level, Yes);
			release(alt_seq(empty, level, No, Yes));
			return node4(ELSE, mk_integer(l), c, s);
		}
		v= test(ftx); tx= ttx;
		if (!is_comment(&c)) c= Vnil;
		s= cmd_suite(level, Yes);
		return node6(TEST_SUITE, mk_integer(l), v, c, s,
				alt_seq(empty, level, No, else_encountered));
	}
	veli();
	return NilTree;
}