newer version, partial parse trees

lang/m2/comp/Makefile

@@ -17,7 +17,7 @@ LFLAGS = $(PROFILE)
 LOBJ =	tokenfile.o program.o declar.o expression.o statement.o
 COBJ =	LLlex.o LLmessage.o char.o error.o main.o \
 	symbol2str.o tokenname.o idf.o input.o type.o def.o \
-	scope.o misc.o enter.o defmodule.o typequiv.o
+	scope.o misc.o enter.o defmodule.o typequiv.o node.o
 OBJ =	$(COBJ) $(LOBJ) Lpars.o
 GENFILES=	tokenfile.c \
 	program.c declar.c expression.c statement.c \
@@ -47,6 +47,7 @@ symbol2str.c:	tokenname.c make.tokcase
 misc.h:		misc.H make.allocd
 def.h:		def.H make.allocd
 type.h:		type.H make.allocd
+node.h:		node.H make.allocd
 scope.c:	scope.C make.allocd
 
 char.c: char.tab tab
@@ -71,22 +72,23 @@ depend:
 LLlex.o: LLlex.h Lpars.h class.h f_info.h idf.h input.h
 LLmessage.o: LLlex.h Lpars.h idf.h
 char.o: class.h
-error.o: LLlex.h f_info.h input.h main.h
+error.o: LLlex.h f_info.h input.h main.h node.h
 main.o: LLlex.h Lpars.h debug.h def.h f_info.h idf.h input.h main.h scope.h standards.h type.h
 symbol2str.o: Lpars.h
 tokenname.o: Lpars.h idf.h tokenname.h
 idf.o: idf.h
 input.o: f_info.h input.h
-type.o: Lpars.h def.h def_sizes.h idf.h misc.h type.h
+type.o: LLlex.h Lpars.h def.h def_sizes.h idf.h node.h type.h
-def.o: Lpars.h debug.h def.h idf.h main.h misc.h scope.h type.h
+def.o: LLlex.h Lpars.h debug.h def.h idf.h main.h node.h scope.h type.h
 scope.o: LLlex.h debug.h def.h idf.h scope.h type.h
 misc.o: LLlex.h f_info.h idf.h misc.h
-enter.o: def.h idf.h misc.h scope.h type.h
+enter.o: LLlex.h def.h idf.h node.h scope.h type.h
 defmodule.o: LLlex.h def.h f_info.h idf.h input.h scope.h
 typequiv.o: Lpars.h def.h type.h
+node.o: LLlex.h def.h node.h type.h
 tokenfile.o: Lpars.h
-program.o: LLlex.h Lpars.h debug.h def.h idf.h main.h misc.h scope.h type.h
+program.o: LLlex.h Lpars.h debug.h def.h idf.h main.h node.h scope.h type.h
-declar.o: LLlex.h Lpars.h def.h idf.h misc.h scope.h type.h
+declar.o: LLlex.h Lpars.h def.h idf.h misc.h node.h scope.h type.h
-expression.o: LLlex.h Lpars.h def.h idf.h scope.h
+expression.o: LLlex.h Lpars.h def.h idf.h node.h scope.h
 statement.o: Lpars.h
 Lpars.o: Lpars.h

lang/m2/comp/declar.g

@@ -7,11 +7,12 @@ static char *RcsId = "$Header$";
 #include	<em_label.h>
 #include	<assert.h>
 #include	"idf.h"
-#include	"misc.h"
 #include	"LLlex.h"
 #include	"def.h"
 #include	"type.h"
 #include	"scope.h"
+#include	"node.h"
+#include	"misc.h"
 }
 
 ProcedureDeclaration
@@ -95,7 +96,7 @@ FormalParameters(int doparams; struct paramlist **pr; struct type **tp;)
 	]?
 	')'
 			{ *tp = 0; }
-	[	':' qualident(D_TYPE | D_HTYPE, &df, "type")
+	[	':' qualident(D_TYPE | D_HTYPE, &df, "type", (struct node **) 0)
 			{ *tp = df->df_type; }
 	]?
 ;
@@ -108,7 +109,7 @@ FormalParameters(int doparams; struct paramlist **pr; struct type **tp;)
 */
 FPSection(int doparams; struct paramlist **ppr;)
 {
-	struct id_list *FPList;
+	struct node *FPList;
 	struct paramlist *ParamList();
 	struct type *tp;
 	int VARp = 0;
@@ -122,7 +123,7 @@ FPSection(int doparams; struct paramlist **ppr;)
 			EnterIdList(FPList, D_VARIABLE, VARp, tp, CurrentScope);
 		  }
 		  *ppr = ParamList(FPList, tp);
-		  FreeIdList(FPList);
+		  FreeNode(FPList);
 		}
 ;
 
@@ -133,7 +134,7 @@ FormalType(struct type **tp;)
 } :
 	[ ARRAY OF	{ ARRAYflag = 1; }
 	]?
-	qualident(D_TYPE | D_HTYPE, &df, "type")
+	qualident(D_TYPE | D_HTYPE, &df, "type", (struct node **) 0)
 			{ if (ARRAYflag) {
 				*tp = construct_type(ARRAY, NULLTYPE);
 				(*tp)->arr_elem = df->df_type;
@@ -182,7 +183,7 @@ SimpleType(struct type **ptp;)
 	struct def *df;
 	struct type *tp;
 } :
-	qualident(D_TYPE | D_HTYPE, &df, "type")
+	qualident(D_TYPE | D_HTYPE, &df, "type", (struct node **) 0)
 	[
 		/* nothing */
 	|
@@ -202,41 +203,44 @@ SimpleType(struct type **ptp;)
 
 enumeration(struct type **ptp;)
 {
-	struct id_list *EnumList;
+	struct node *EnumList;
 } :
 	'(' IdentList(&EnumList) ')'
 			{
 			  *ptp = standard_type(ENUMERATION,int_align,int_size);
 			  EnterIdList(EnumList, D_ENUM, 0, *ptp, CurrentScope);
-			  FreeIdList(EnumList);
+			  FreeNode(EnumList);
 			}
 
 ;
 
-IdentList(struct id_list **p;)
+IdentList(struct node **p;)
 {
-	register struct id_list *q = new_id_list();
+	register struct node *q;
 } :
-	IDENT			{ q->id_ptr = dot.TOK_IDF;  *p = q;}
+	IDENT		{ q = MkNode(Value, NULLNODE, NULLNODE, &dot);
+			  *p = q;
+			}
 	[
-		',' IDENT	{ q->next = new_id_list();
+		',' IDENT
-				  q = q->next;
+			{ q->next = MkNode(Value,NULLNODE,NULLNODE,&dot);
-				  q->id_ptr = dot.TOK_IDF;
+			  q = q->next;
-				}
+			}
 	]*
-				{ q->next = 0; }
+			{ q->next = 0; }
 ;
 
 SubrangeType(struct type **ptp;)
 {
 	struct type *tp;
+	struct node *nd1 = 0, *nd2 = 0;
 }:
 	/*
 	   This is not exactly the rule in the new report, but see
 	   the rule for "SimpleType".
 	*/
-	'[' ConstExpression
+	'[' ConstExpression(&nd1)
-	UPTO ConstExpression
+	UPTO ConstExpression(&nd2)
 	']'
 	/*
 	   Evaluate the expressions. Check that they are indeed constant.
@@ -295,7 +299,7 @@ FieldListSequence(struct scope *scope;):
 
 FieldList(struct scope *scope;)
 {
-	struct id_list *FldList;
+	struct node *FldList;
 	struct idf *id;
 	struct def *df, *df1;
 	struct type *tp;
@@ -303,7 +307,7 @@ FieldList(struct scope *scope;)
 [
 	IdentList(&FldList) ':' type(&tp)
 			{ EnterIdList(FldList, D_FIELD, 0, tp, scope);
-			  FreeIdList(FldList);
+			  FreeNode(FldList);
 			}
 |
 	CASE
@@ -312,7 +316,7 @@ FieldList(struct scope *scope;)
 	|
 				{ id = gen_anon_idf(); }
 	]			/* Changed rule in new modula-2 */
-	':' qualident(D_TYPE|D_HTYPE, &df, "type")
+	':' qualident(D_TYPE|D_HTYPE, &df, "type", (struct node **) 0)
 				{ df1 = define(id, scope, D_FIELD);
 				  df1->df_type = df->df_type;
 				}
@@ -335,8 +339,11 @@ CaseLabelList:
 	CaseLabels [ ',' CaseLabels ]*
 ;
 
-CaseLabels:
+CaseLabels
-	ConstExpression [ UPTO ConstExpression ]?
+{
+	struct node *nd1, *nd2 = 0;
+}:
+	ConstExpression(&nd1) [ UPTO ConstExpression(&nd2) ]?
 ;
 
 SetType(struct type **ptp;)
@@ -364,7 +371,7 @@ PointerType(struct type **ptp;)
 		/* Either a Module or a Type, but in both cases defined
 		   in this scope, so this is the correct identification
 		*/
-		qualident(D_TYPE|D_HTYPE, &df, "type")
+		qualident(D_TYPE|D_HTYPE, &df, "type", (struct node **) 0)
 				{
 				  if (!df->df_type) {
 					error("type \"%s\" not declared",
@@ -429,7 +436,7 @@ FormalTypeList(struct paramlist **ppr; struct type **ptp;)
 				{ p->next = 0; }
 	]?
 	')'
-	[ ':' qualident(D_TYPE|D_HTYPE, &df, "type")
+	[ ':' qualident(D_TYPE|D_HTYPE, &df, "type", (struct node **) 0)
 				{ *ptp = df->df_type; }
 	]?
 ;
@@ -438,24 +445,26 @@ ConstantDeclaration
 {
 	struct def *df;
 	struct idf *id;
+	struct node *nd;
 }:
 	IDENT			{ id = dot.TOK_IDF; }
-	'=' ConstExpression	{ df = define(id, CurrentScope, D_CONST);
+	'=' ConstExpression(&nd){ df = define(id, CurrentScope, D_CONST);
 				  /* ???? */
 				}
 ;
 
 VariableDeclaration
 {
-	struct id_list *VarList;
+	struct node *VarList;
 	struct type *tp;
+	struct node *nd = 0;
 } :
 	IdentList(&VarList)
 	[
-		ConstExpression
+		ConstExpression(&nd)
 	]?
 	':' type(&tp)
 			{ EnterIdList(VarList, D_VARIABLE, 0, tp, CurrentScope);
-			  FreeIdList(VarList);
+			  FreeNode(VarList);
 			}
 ;

lang/m2/comp/def.c

@@ -10,9 +10,10 @@ static char *RcsId = "$Header$";
 #include	"def.h"
 #include	"type.h"
 #include	"idf.h"
-#include	"misc.h"
 #include	"main.h"
 #include	"scope.h"
+#include	"LLlex.h"
+#include	"node.h"
 #include	"debug.h"
 
 struct def *h_def;		/* Pointer to free list of def structures */
@@ -63,7 +64,7 @@ define(id, scope, kind)
 			return df;
 		}
 		if (kind != D_ERROR) {
-			error("identifier \"%s\" already declared", id->id_text);
+error("identifier \"%s\" already declared", id->id_text);
 		}
 		return df;
 	}
@@ -115,7 +116,7 @@ lookup(id, scope)
 }
 
 Export(ids, qualified)
-	register struct id_list *ids;
+	register struct node *ids;
 {
 	/*	From the current scope, the list of identifiers "ids" is
 		exported. Note this fact. If the export is not qualified, make
@@ -125,36 +126,38 @@ Export(ids, qualified)
 	register struct def *df;
 
 	while (ids) {
-		df = define(ids->id_ptr, CurrentScope, D_ISEXPORTED);
+		df = define(ids->nd_IDF, CurrentScope, D_ISEXPORTED);
 		if (qualified) {
 			df->df_flags |= D_QEXPORTED;
 		}
 		else {
 			df->df_flags |= D_EXPORTED;
-			df = define(ids->id_ptr, enclosing(CurrentScope),
+			df = define(ids->nd_IDF, enclosing(CurrentScope),
 					D_IMPORT);
 		}
 		ids = ids->next;
 	}
 }
 
-Import(ids, id, local)
+Import(ids, idn, local)
-	register struct id_list *ids;
+	register struct node *ids;
-	struct idf *id;
+	struct node *idn;
 {
 	/*	"ids" is a list of imported identifiers.
-		If "id" is a null-pointer, the identifiers are imported from the
+		If "idn" is a null-pointer, the identifiers are imported from
-		enclosing scope. Otherwise they are imported from the module
+		the enclosing scope. Otherwise they are imported from the module
-		indicated by "id", which must be visible in the enclosing scope.
+		indicated by "idn", which must be visible in the enclosing
-		An exception must be made for imports of the Compilation Unit.
+		scope.  An exception must be made for imports of the
+		Compilation Unit.
 		This case is indicated by  the value 0 of the flag "local".
-		In this case, if "id" is a null pointer, the "ids" identifiers
+		In this case, if "idn" is a null pointer, the "ids" identifiers
 		are all module identifiers. Their Definition Modules must be
-		read.  Otherwise "id" is a module identifier whose Definition
+		read.  Otherwise "idn" is a module identifier whose Definition
 		Module must be read. "ids" then represents a list of
 		identifiers defined in this module.
 	*/
 	register struct def *df;
+	register struct idf *id = 0;
 	int scope;
 	int kind;
 	int imp_kind;
@@ -162,6 +165,7 @@ Import(ids, id, local)
 #define FROM_ENCLOSING	1
 	struct def *lookfor(), *GetDefinitionModule();
 
+	if (idn) id = idn->nd_IDF;
 	kind = D_IMPORT;
 	scope = enclosing(CurrentScope)->sc_scope;
 	if (!id) imp_kind = FROM_ENCLOSING;
@@ -173,35 +177,35 @@ Import(ids, id, local)
 			/* enter all "ids" with type D_ERROR */
 			kind = D_ERROR;
 			if (df->df_kind != D_ERROR) {
-error("identifier \"%s\" does not represent a module", id->id_text);
+node_error(idn, "identifier \"%s\" does not represent a module", id->id_text);
 			}
 		}
 		else	scope = df->mod_scope;
 	}
 	while (ids) {
 		if (imp_kind == FROM_MODULE) {
-			if (!(df = lookup(ids->id_ptr, scope))) {
+			if (!(df = lookup(ids->nd_IDF, scope))) {
-error("identifier \"%s\" not declared in qualifying module",
+node_error(ids, "identifier \"%s\" not declared in qualifying module",
-ids->id_ptr->id_text);
+ids->nd_IDF->id_text);
 				df = ill_df;
 			}
 			else 
 			if (!(df->df_flags&(D_EXPORTED|D_QEXPORTED))) {
-error("identifier \"%s\" not exported from qualifying module",
+node_error(ids,"identifier \"%s\" not exported from qualifying module",
-ids->id_ptr->id_text);
+ids->nd_IDF->id_text);
 			}
 		}
 		else {
 			if (local) {
-				df = lookfor(ids->id_ptr,
+				df = lookfor(ids->nd_IDF,
 					     enclosing(CurrentScope), 0);
-			} else df = GetDefinitionModule(ids->id_ptr);
+			} else df = GetDefinitionModule(ids->nd_IDF);
 			if (df->df_kind == D_ERROR) {
-error("identifier \"%s\" not visible in enclosing scope",
+node_error(ids, "identifier \"%s\" not visible in enclosing scope",
-ids->id_ptr->id_text);
+ids->nd_IDF->id_text);
 			}
 		}
-		define(ids->id_ptr, CurrentScope, kind)->imp_def = df;
+		define(ids->nd_IDF, CurrentScope, kind)->imp_def = df;
 		if (df->df_kind == D_TYPE &&
 		    df->df_type->tp_fund == ENUMERATION) {
 			/* Also import all enumeration literals */

lang/m2/comp/enter.c

@@ -9,7 +9,8 @@ static char *RcsId = "$Header$";
 #include	"def.h"
 #include	"type.h"
 #include	"scope.h"
-#include	"misc.h"
+#include	"LLlex.h"
+#include	"node.h"
 
 struct def *
 Enter(name, kind, type, pnam)
@@ -30,7 +31,7 @@ Enter(name, kind, type, pnam)
 }
 
 EnterIdList(idlist, kind, flags, type, scope)
-	register struct id_list *idlist;
+	register struct node *idlist;
 	struct type *type;
 	struct scope *scope;
 {
@@ -39,7 +40,7 @@ EnterIdList(idlist, kind, flags, type, scope)
 	int assval = 0;
 
 	while (idlist) {
-		df = define(idlist->id_ptr, scope, kind);
+		df = define(idlist->nd_IDF, scope, kind);
 		df->df_type = type;
 		df->df_flags = flags;
 		if (kind == D_ENUM) {

lang/m2/comp/error.c

@@ -13,6 +13,7 @@ static char *RcsId = "$Header$";
 #include	"f_info.h"
 #include	"LLlex.h"
 #include	"main.h"
+#include	"node.h"
 
 #define MAXERR_LINE	5	/* Number of error messages on one line ... */
 #define	ERROUT		STDERR
@@ -28,8 +29,6 @@ static char *RcsId = "$Header$";
 #define VDEBUG		7
 #endif
 
-#define NILEXPR	((struct expr *) 0)
-
 int err_occurred;
 
 extern char *symbol2str();
@@ -37,12 +36,12 @@ extern char *symbol2str();
 /*	There are three general error-message functions:
 		lexerror()	lexical and pre-processor error messages
 		error()		syntactic and semantic error messages
-		expr_error()	errors in expressions
+		node_error()	errors in nodes
 	The difference lies in the place where the file name and line
 	number come from.
 	Lexical errors report from the global variables LineNumber and
-	FileName, expression errors get their information from the
+	FileName, node errors get their information from the
-	expression, whereas other errors use the information in the token.
+	node, whereas other errors use the information in the token.
 */
 
 #ifdef DEBUG
@@ -50,7 +49,7 @@ extern char *symbol2str();
 debug(level, fmt, args)
 	char *fmt;
 {
-	if (level <= options['D']) _error(VDEBUG, NILEXPR, fmt, &args);
+	if (level <= options['D']) _error(VDEBUG, NULLNODE, fmt, &args);
 }
 #endif DEBUG
 
@@ -58,44 +57,44 @@ debug(level, fmt, args)
 error(fmt, args)
 	char *fmt;
 {
-	_error(ERROR, NILEXPR, fmt, &args);
+	_error(ERROR, NULLNODE, fmt, &args);
 }
 
 /*VARARGS2*/
-expr_error(expr, fmt, args)
+node_error(node, fmt, args)
-	struct expr *expr;
+	struct node *node;
 	char *fmt;
 {
-	_error(ERROR, expr, fmt, &args);
+	_error(ERROR, node, fmt, &args);
 }
 
 /*VARARGS1*/
 warning(fmt, args)
 	char *fmt;
 {
-	_error(WARNING, NILEXPR, fmt, &args);
+	_error(WARNING, NULLNODE, fmt, &args);
 }
 
 /*VARARGS2*/
-expr_warning(expr, fmt, args)
+node_warning(node, fmt, args)
-	struct expr *expr;
+	struct node *node;
 	char *fmt;
 {
-	_error(WARNING, expr, fmt, &args);
+	_error(WARNING, node, fmt, &args);
 }
 
 /*VARARGS1*/
 lexerror(fmt, args)
 	char *fmt;
 {
-	_error(LEXERROR, NILEXPR, fmt, &args);
+	_error(LEXERROR, NULLNODE, fmt, &args);
 }
 
 /*VARARGS1*/
 lexwarning(fmt, args) 
 	char *fmt;
 {
-	_error(LEXWARNING, NILEXPR, fmt, &args);
+	_error(LEXWARNING, NULLNODE, fmt, &args);
 }
 
 /*VARARGS1*/
@@ -104,13 +103,13 @@ fatal(fmt, args)
 	int args;
 {
 
-	_error(FATAL, NILEXPR, fmt, &args);
+	_error(FATAL, NULLNODE, fmt, &args);
 	sys_stop(S_EXIT);
 }
 
-_error(class, expr, fmt, argv)
+_error(class, node, fmt, argv)
 	int class;
-	struct expr *expr;
+	struct node *node;
 	char *fmt;
 	int argv[];
 {
@@ -118,8 +117,10 @@ _error(class, expr, fmt, argv)
 		for a given line to MAXERR_LINE.
 	*/
 	static unsigned int last_ln = 0;
-	static int e_seen = 0;
 	unsigned int ln = 0;
+	static char * last_fn = 0;
+	char *fn = 0;
+	static int e_seen = 0;
 	char *remark = 0;
 	
 	/*	Since name and number are gathered from different places
@@ -158,13 +159,19 @@ _error(class, expr, fmt, argv)
 	case FATAL:
 		remark = "fatal error --";
 		break;
+#ifdef DEBUG
+	case VDEBUG:
+		remark = "(debug)";
+		break;
+#endif DEBUG
 	}
 	
 	/* the place */
 	switch (class)	{	
 	case WARNING:
 	case ERROR:
-		ln = /* ???? expr ? expr->ex_line : */ dot.tk_lineno;
+		fn = node ? node->nd_filename : dot.tk_filename;
+		ln = node ? node->nd_lineno : dot.tk_lineno;
 		break;
 	case LEXWARNING:
 	case LEXERROR:
@@ -174,13 +181,14 @@ _error(class, expr, fmt, argv)
 	case VDEBUG:
 #endif DEBUG
 		ln = LineNumber;
+		fn = FileName;
 		break;
 	}
 	
 #ifdef DEBUG
 	if (class != VDEBUG) {
 #endif
-	if (ln == last_ln)	{
+	if (fn == last_fn && ln == last_ln)	{
 		/* we've seen this place before */
 		e_seen++;
 		if (e_seen == MAXERR_LINE) fmt = "etc ...";
@@ -192,13 +200,14 @@ _error(class, expr, fmt, argv)
 	else	{
 		/* brand new place */
 		last_ln = ln;
+		last_fn = fn;
 		e_seen = 0;
 	}
 #ifdef DEBUG
 	}
 #endif DEBUG
 	
-	if (FileName) fprint(ERROUT, "\"%s\", line %u: ", FileName, ln);
+	if (fn) fprint(ERROUT, "\"%s\", line %u: ", fn, ln);
 
 	if (remark) fprint(ERROUT, "%s ", remark);
 

lang/m2/comp/expression.g

@@ -10,15 +10,18 @@ static char *RcsId = "$Header$";
 #include	"idf.h"
 #include	"def.h"
 #include	"scope.h"
+#include	"node.h"
 }
 
-number:
+number(struct node **p;):
+[
 	INTEGER
 |
 	REAL
+]			{ *p = MkNode(Value, NULLNODE, NULLNODE, dot); }
 ;
 
-qualident(int types; struct def **pdf; char *str;)
+qualident(int types; struct def **pdf; char *str; struct node **p;)
 {
 	int scope;
 	int  module;
@@ -30,6 +33,9 @@ qualident(int types; struct def **pdf; char *str;)
 				*pdf = df;
 				if (df->df_kind == D_ERROR) types = 0;
 			  }
+			  if (p) {
+			  	*p = MkNode(Value, NULLNODE, NULLNODE,&dot);
+			  }
 			}
 	[
 			{ if (types &&!(scope = has_selectors(df))) {
@@ -38,8 +44,13 @@ qualident(int types; struct def **pdf; char *str;)
 			  }
 			}
 		/* selector */
-		'.' IDENT
+		'.'	{ if (p) *p = MkNode(Link, *p, NULLNODE, &dot); }
-			{ if (types) {
+		IDENT
+			{ if (p) {
+				p = &((*p)->nd_right);
+				*p = MkNode(Value, NULLNODE, NULLNODE,&dot);
+			  }
+			  if (types) {
 				module = (df->df_kind == D_MODULE);
 				df = lookup(dot.TOK_IDF, scope);
 				if (!df) {
@@ -62,99 +73,179 @@ qualident(int types; struct def **pdf; char *str;)
 			}
 ;
 
+/* Inline substituted wherever it occurred
 selector:
-	'.' /* field */ IDENT
+	'.' IDENT
+;
+*/
+
+ExpList(struct node **pnd;)
+{
+	struct node **nd;
+} :
+	expression(pnd)		{ nd = pnd; }
+	[
+		','		{ *nd = MkNode(Link, *nd, NULLNODE, &dot);
+				  nd = &(*nd)->nd_right;
+				}
+		expression(nd)
+	]*
 ;
 
-ExpList:
+ConstExpression(struct node **pnd;):
-	expression [ ',' expression ]*
+	expression(pnd)
-;
-
-ConstExpression:
-	expression
 	/*
 	 * Changed rule in new Modula-2.
 	 * Check that the expression is a constant expression and evaluate!
 	 */
 ;
 
-expression:
+expression(struct node **pnd;)
-	SimpleExpression [ relation SimpleExpression ]?
+{
+	struct node *nd;
+} :
+	SimpleExpression(&nd)
+	[
+		/* relation */
+		[ '=' | '#' | UNEQUAL | '<' | LESSEQUAL | '>' |
+		  GREATEREQUAL | IN
+		]
+			{ nd = MkNode(Oper, nd, NULLNODE, &dot); }
+		SimpleExpression(&(nd->nd_right))
+	]?
+			{ *pnd = nd; }
 ;
 
+/* Inline in expression
 relation:
 	'=' | '#' | UNEQUAL | '<' | LESSEQUAL | '>' | GREATEREQUAL | IN
 ;
+*/
 
-SimpleExpression:
+SimpleExpression(struct node **pnd;)
-	[ '+' | '-' ]? term [ AddOperator term ]*
-;
-
-AddOperator:
-	'+' | '-' | OR
-;
-
-term:
-	factor [ MulOperator factor ]*
-;
-
-MulOperator:
-	'*' | '/' | DIV | MOD | AND | '&'
-;
-
-factor
 {
-	struct def *df;
+	register struct node *nd;
 } :
-	qualident(0, &df, (char *) 0)
+	[ '+' | '-' ]?
+	term(pnd)	{ nd = *pnd; }
 	[
-		designator_tail? ActualParameters?
+		/* AddOperator */
-	|
+		[ '+' | '-' | OR ]
-		bare_set
+			{ *pnd = nd = MkNode(Oper, nd, NULLNODE, &dot); }
-	]
+		term(&(nd->nd_right))
-|
-	bare_set
-| %default
-	number
-|
-	STRING
-|
-	'(' expression ')'
-|
-	NOT factor
-;
-
-bare_set:
-	'{' [ element [ ',' element ]* ]? '}'
-;
-
-ActualParameters:
-	'(' ExpList? ')'
-;
-
-element:
-	expression [ UPTO expression ]?
-;
-
-designator
-{
-	struct def *df;
-} :
-	qualident(0, &df, (char *) 0)
-	designator_tail?
-;
-
-designator_tail:
-	visible_designator_tail
-	[
-		selector
-	|
-		visible_designator_tail
 	]*
 ;
 
-visible_designator_tail:
+/* Inline in "SimpleExpression"
-	'[' ExpList ']'
+AddOperator:
-|
+	'+' | '-' | OR
-	'^'
+;
+*/
+
+term(struct node **pnd;)
+{
+	register struct node *nd;
+}:
+	factor(pnd)	{ nd = *pnd; }
+	[
+		/* MulOperator */
+		[ '*' | '/' | DIV | MOD | AND | '&' ]
+			{ *pnd = nd = MkNode(Oper, nd, NULLNODE, &dot); }
+		factor(&(nd->nd_right))
+	]*
+;
+
+/* inline in "term"
+MulOperator:
+	'*' | '/' | DIV | MOD | AND | '&'
+;
+*/
+
+factor(struct node **p;)
+{
+	struct def *df;
+} :
+	qualident(0, &df, (char *) 0, p)
+	[
+		designator_tail(p)?
+		[
+				{ *p = MkNode(Call, p, NULLNODE, &dot); } 
+			ActualParameters(&((*p)->nd_right))
+		]?
+	|			{ *p = MkNode(Call, p, NULLNODE, &dot); }
+		bare_set(&((*p)->nd_right))
+	]
+|
+	bare_set(p)
+| %default
+	number(p)
+|
+	STRING		{ *p = MkNode(Value, NULLNODE, NULLNODE, &dot); }
+|
+	'(' expression(p) ')'
+|
+	NOT		{ *p = MkNode(Uoper, NULLNODE, NULLNODE, &dot); }
+	factor(&((*p)->nd_left))
+;
+
+bare_set(struct node **pnd;)
+{
+	struct node **nd;
+} :
+	'{'		{
+			  dot.tk_symb = SET;
+			  *pnd = MkNode(Link, NULLNODE, NULLNODE, &dot);
+			  nd = &((*pnd)->nd_left);
+			}
+	[
+		element(nd)
+		[
+			','	{ *nd = MkNode(Link, *nd, NULLNODE, &dot);
+				  nd = &((*nd)->nd_right);
+				}
+			element(nd)
+		]*
+	]?
+	'}'
+;
+
+ActualParameters(struct node **pnd;):
+	'(' ExpList(pnd)? ')'
+;
+
+element(struct node **pnd;):
+	expression(pnd)
+	[
+		UPTO		{ *pnd = MkNode(Link, *pnd, NULLNODE, &dot);}
+		expression(&((*pnd)->nd_right))
+	]?
+;
+
+designator(struct node **pnd;)
+{
+	struct def *df;
+} :
+	qualident(0, &df, (char *) 0, pnd)
+	designator_tail(pnd)?
+;
+
+designator_tail(struct node **pnd;):
+	visible_designator_tail(pnd)
+	[
+		/* selector */
+		'.'	{ *pnd = MkNode(Oper, *pnd, NULLNODE, &dot); }
+		IDENT	{ (*pnd)->nd_right =
+				MkNode(Value, NULLNODE, NULLNODE, &dot);
+			}
+	|
+		visible_designator_tail(pnd)
+	]*
+;
+
+visible_designator_tail(struct node **pnd;):
+	'['		{ *pnd = MkNode(Oper, *pnd, NULLNODE, &dot); }
+	ExpList(&((*pnd)->nd_right))
+	']'
+|
+	'^'		{ *pnd = MkNode(Oper, *pnd, NULLNODE, &dot); }
 ;

lang/m2/comp/misc.H

@@ -2,13 +2,6 @@
 
 /* $Header$ */
 
-/*	Structure to link idf structures together
-*/
-struct id_list {
-	struct id_list *next;
-	struct idf *id_ptr;
-};
-
 /* ALLOCDEF "id_list" */
 
 #define is_anon_idf(x)	((x)->id_text[0] == '#')

lang/m2/comp/misc.c

@@ -24,22 +24,6 @@ match_id(id1, id2)
 	}
 }
 
-struct id_list *h_id_list;	/* Header of free list of id_list structures */
-
-/*	FreeIdList: take a list of id_list structures and put them
-	on the free list of id_list structures
-*/
-FreeIdList(p)
-	struct id_list *p;
-{
-	register struct id_list *q;
-
-	while (q = p) {
-		p = p->next;
-		free_id_list(q);
-	}
-}
-
 struct idf *
 gen_anon_idf()
 {

lang/m2/comp/node.H

@@ -0,0 +1,31 @@
+/* N O D E   O F   A N   A B S T R A C T   P A R S E T R E E */
+
+/* $Header$ */
+
+struct node {
+	struct node *next;
+#define nd_left	next
+	struct node *nd_right;
+	int nd_class;		/* kind of node */
+#define Value	1		/* idf or constant */
+#define Oper	2		/* binary operator */
+#define Uoper	3		/* unary operator */
+#define Call	4		/* cast or procedure - or function call */
+#define Link	5
+	struct type *nd_type;	/* type of this node */
+	struct token nd_token;
+#define nd_symb		nd_token.tk_symb
+#define nd_lineno	nd_token.tk_lineno
+#define nd_filename	nd_token.tk_filename
+#define nd_IDF		nd_token.TOK_IDF
+#define nd_STR		nd_token.TOK_STR
+#define nd_SLE		nd_token.TOK_SLE
+#define nd_INT		nd_token.TOK_INT
+#define nd_REL		nd_token.TOK_REL
+};
+
+/* ALLOCDEF "node" */
+
+extern struct node *MkNode();
+
+#define NULLNODE ((struct node *) 0)

lang/m2/comp/node.c

@@ -0,0 +1,41 @@
+/* N O D E   O F   A N   A B S T R A C T   P A R S E T R E E */
+
+static char *RcsId = "$Header$";
+
+#include	<em_label.h>
+#include	<em_arith.h>
+#include	<alloc.h>
+#include	"def.h"
+#include	"type.h"
+#include	"LLlex.h"
+#include	"node.h"
+
+struct node *h_node;		/* header of free list */
+
+struct node *
+MkNode(class, left, right, token)
+	struct node *left, *right;
+	struct token *token;
+{
+	/*	Create a node and initialize it with the given parameters
+	*/
+	register struct node *nd = new_node();
+
+	nd->nd_left = left;
+	nd->nd_right = right;
+	nd->nd_token = *token;
+	nd->nd_class = class;
+	nd->nd_type = NULLTYPE;
+	return nd;
+}
+
+FreeNode(nd)
+	register struct node *nd;
+{
+	/*	Put nodes that are no longer needed back onto the free
+		list
+	*/
+	if (nd->nd_left) FreeNode(nd->nd_left);
+	if (nd->nd_right) FreeNode(nd->nd_right);
+	free_node(nd);
+}

lang/m2/comp/program.g

@@ -7,12 +7,12 @@ static  char *RcsId = "$Header$";
 #include	<em_arith.h>
 #include	<em_label.h>
 #include	"idf.h"
-#include	"misc.h"
 #include	"main.h"
 #include	"LLlex.h"
 #include	"scope.h"
 #include	"def.h"
 #include	"type.h"
+#include	"node.h"
 #include	"debug.h"
 
 static struct idf *impl_name = 0;
@@ -57,13 +57,16 @@ ModuleDeclaration
 				}
 ;
 
-priority:
+priority
-	'[' ConstExpression ']'
+{
+	struct node *nd;
+}:
+	'[' ConstExpression(&nd) ']'
 ;
 
 export(int def;)
 {
-	struct id_list *ExportList;
+	struct node *ExportList;
 	int QUALflag = 0;
 } :
 	EXPORT
@@ -74,17 +77,17 @@ export(int def;)
 			{
 			  if (!def) Export(ExportList, QUALflag);
 			  else warning("export list in definition module ignored");
-			  FreeIdList(ExportList);
+			  FreeNode(ExportList);
 			}
 ;
 
 import(int local;)
 {
-	struct id_list *ImportList;
+	struct node *ImportList;
-	struct idf *id = 0;
+	struct node *id = 0;
 } :
 	[ FROM
-	  IDENT		{ id = dot.TOK_IDF; }
+	  IDENT		{ id = MkNode(Value, NULLNODE, NULLNODE, &dot); }
 	]?
 	IMPORT IdentList(&ImportList) ';'
 	/*
@@ -95,7 +98,8 @@ import(int local;)
 	*/
 			{
 			  Import(ImportList, id, local);
-			  FreeIdList(ImportList);
+			  FreeNode(ImportList);
+			  if (id) FreeNode(id);
 			}
 ;
 

lang/m2/comp/statement.g

@@ -2,20 +2,27 @@
 
 {
 static char *RcsId = "$Header$";
+
+#include	<em_arith.h>
+#include	"LLlex.h"
+#include	"node.h"
 }
 
-statement:
+statement
+{
+	struct node *nd1, *nd2;
+} :
 [
 	/*
 	 * This part is not in the reference grammar. The reference grammar
 	 * states : assignment | ProcedureCall | ...
 	 * but this gives LL(1) conflicts
 	 */
-	designator
+	designator(&nd1)
 	[
-		ActualParameters?
+		ActualParameters(&nd2)?
 	|
-		BECOMES expression
+		BECOMES expression(&nd2)
 	]
 	/*
 	 * end of changed part
@@ -37,7 +44,10 @@ statement:
 |
 	EXIT
 |
-	RETURN expression?
+	RETURN
+	[
+		expression(&nd1)
+	]?
 ]?
 ;
 
@@ -57,15 +67,21 @@ StatementSequence:
 	statement [ ';' statement ]*
 ;
 
-IfStatement:
+IfStatement
-	IF expression THEN StatementSequence
+{
-	[ ELSIF expression THEN StatementSequence ]*
+	struct node *nd1;
+} :
+	IF expression(&nd1) THEN StatementSequence
+	[ ELSIF expression(&nd1) THEN StatementSequence ]*
 	[ ELSE StatementSequence ]?
 	END
 ;
 
-CaseStatement:
+CaseStatement
-	CASE expression OF case [ '|' case ]*
+{
+	struct node *nd;
+} :
+	CASE expression(&nd) OF case [ '|' case ]*
 	[ ELSE StatementSequence ]?
 	END
 ;
@@ -75,19 +91,28 @@ case:
 				/* This rule is changed in new modula-2 */
 ;
 
-WhileStatement:
+WhileStatement
-	WHILE expression DO StatementSequence END
+{
+	struct node *nd;
+}:
+	WHILE expression(&nd) DO StatementSequence END
 ;
 
-RepeatStatement:
+RepeatStatement
-	REPEAT StatementSequence UNTIL expression
+{
+	struct node *nd;
+}:
+	REPEAT StatementSequence UNTIL expression(&nd)
 ;
 
-ForStatement:
+ForStatement
+{
+	struct node *nd1, *nd2, *nd3;
+}:
 	FOR IDENT
-	BECOMES expression
+	BECOMES expression(&nd1)
-	TO expression
+	TO expression(&nd2)
-	[ BY ConstExpression ]?
+	[ BY ConstExpression(&nd3) ]?
 	DO StatementSequence END
 ;
 
@@ -95,6 +120,9 @@ LoopStatement:
 	LOOP StatementSequence END
 ;
 
-WithStatement:
+WithStatement
-	WITH designator DO StatementSequence END
+{
+	struct node *nd;
+}:
+	WITH designator(&nd) DO StatementSequence END
 ;

lang/m2/comp/type.c

@@ -11,7 +11,8 @@ static char *RcsId = "$Header$";
 #include	"def.h"
 #include	"type.h"
 #include	"idf.h"
-#include	"misc.h"
+#include	"LLlex.h"
+#include	"node.h"
 
 /*	To be created dynamically in main() from defaults or from command
 	line parameters.
@@ -164,7 +165,7 @@ has_selectors(df)
 */
 struct paramlist *
 ParamList(ids, tp, VARp)
-	register struct id_list *ids;
+	register struct node *ids;
 	struct type *tp;
 {
 	register struct paramlist *pr;