load reduction actions and generate a commit containing them

10 files changed, 230 insertions, 39 deletions

diff --git a/src/colm.lm b/src/colm.lm
index a5f15b9c..9b305e70 100644
--- a/src/colm.lm
+++ b/src/colm.lm
@@ -366,7 +366,7 @@ def red_nonterm
 	[id ROPEN host_item* RCLOSE]
 
 def red_action
-	[id COLON id ROPEN host_item* RCLOSE]
+	[NonTerm: type_ref COLON Prod: id ROPEN HostItems: host_item* RCLOSE]
 
 def host_item
 	[red_id]
@@ -376,8 +376,8 @@ def host_item
 |	[red_any]
 
 def reduction_item
-	[red_nonterm] commit
-|	[red_action] commit
+	[red_nonterm] :NonTerm commit
+|	[red_action] :Action commit
 
 def namespace_def
 	[NAMESPACE id ItemList: namespace_item* END]
diff --git a/src/commit.c b/src/commit.c
index 473f4bbb..1f7bf9e4 100644
--- a/src/commit.c
+++ b/src/commit.c
@@ -37,7 +37,9 @@
 //#define true 1
 //#define false 0
 
-static void commit_clear_parse_tree( program_t *prg, tree_t **sp, parse_tree_t *pt )
+extern void commit_forward_recurse( program_t *prg, tree_t **root, parse_tree_t *pt );
+
+void commit_clear_parse_tree( program_t *prg, tree_t **sp, parse_tree_t *pt )
 {
 	tree_t **top = vm_ptop();
 
@@ -82,38 +84,6 @@ static int been_committed( parse_tree_t *parse_tree )
 }
 
 
-static void commit_forward_recurse( program_t *prg, tree_t **root, parse_tree_t *pt )
-{
-	tree_t **sp = root;
-
-	parse_tree_t *lel = pt;
-
-recurse:
-
-	if ( lel->child != 0 ) {
-		/* There are children. Must process all children first. */
-		vm_push_ptree( lel );
-
-		lel = lel->child;
-		while ( lel != 0 ) {
-			goto recurse;
-			resume:
-			lel = lel->next;
-		}
-
-		lel = vm_pop_ptree();
-	}
-
-	/* Now can execute the reduction action. */
-
-	commit_clear_parse_tree( prg, sp, lel->child );
-	lel->child = 0;
-	pt->flags |= PF_COMMITTED;
-
-	if ( sp != root )
-		goto resume;
-}
-
 void commit_clear( program_t *prg, tree_t **root, struct pda_run *pda_run )
 {
 	tree_t **sp = root;
@@ -129,7 +99,7 @@ void commit_clear( program_t *prg, tree_t **root, struct pda_run *pda_run )
 	while ( sp != root ) {
 		pt = vm_pop_ptree();
 
-		commit_forward_recurse( prg, sp, pt );
+		commit_clear_parse_tree( prg, sp, pt->child );
 
 		pt->flags |= PF_COMMITTED;
 		pt = pt->next;
@@ -151,7 +121,7 @@ void commit_reduce( program_t *prg, tree_t **root, struct pda_run *pda_run )
 	while ( sp != root ) {
 		pt = vm_pop_ptree();
 
-		commit_clear_parse_tree( prg, sp, pt->child );
+		commit_forward_recurse( prg, sp, pt );
 		pt->child = 0;
 
 		pt->flags |= PF_COMMITTED;
diff --git a/src/compiler.cc b/src/compiler.cc
index 87020083..7f242cc0 100644
--- a/src/compiler.cc
+++ b/src/compiler.cc
@@ -878,6 +878,15 @@ Namespace *Namespace::findNamespace( const String &name )
 	return 0;
 }
 
+Reduction *Namespace::findReduction( const String &name )
+{
+	for ( ReductionVect::Iter r = reductions; r.lte(); r++ ) {
+		if ( strcmp( name, (*r)->name ) == 0 )
+			return *r;
+	}
+	return 0;
+}
+
 /* Search from a previously resolved qualification. (name 1+ in a qual list). */
 Namespace *NamespaceQual::searchFrom( Namespace *from, StringVect::Iter &qualPart )
 {
@@ -1129,6 +1138,65 @@ void Compiler::writeHostCall()
 
 }
 
+void Compiler::writeCommit()
+{
+	*outStream <<
+		"void commit_clear_parse_tree( program_t *prg, tree_t **sp, parse_tree_t *pt );\n"
+		"void commit_forward_recurse( program_t *prg, tree_t **root, parse_tree_t *pt )\n"
+		"{\n"
+		"	tree_t **sp = root;\n"
+		"\n"
+		"	parse_tree_t *lel = pt;\n"
+		"\n"
+		"recurse:\n"
+		"\n"
+		"	if ( lel->child != 0 ) {\n"
+		"		/* There are children. Must process all children first. */\n"
+		"		vm_push_ptree( lel );\n"
+		"\n"
+		"		lel = lel->child;\n"
+		"		while ( lel != 0 ) {\n"
+		"			goto recurse;\n"
+		"			resume:\n"
+		"			lel = lel->next;\n"
+		"		}\n"
+		"\n"
+		"		lel = vm_pop_ptree();\n"
+		"	}\n"
+		"\n"
+		"	/* Now can execute the reduction action. */\n"
+		"	if ( lel->shadow != 0 ) {\n"
+		"		switch ( lel->shadow->tree->id ) {\n";
+
+	for ( ReductionVect::Iter r = rootNamespace->reductions; r.lte(); r++ ) {
+		for ( ReduceActionList::Iter rdi = (*r)->reduceActions; rdi.lte(); rdi++ ) {
+			int lelId = rdi->production->prodName->id;
+			int prodNum = rdi->production->prodNum;
+
+			*outStream <<
+				"		case " << lelId << ": \n"
+				"			if ( lel->shadow->tree->prod_num == " << prodNum << " ) {\n"
+				"			" << rdi->txt << "\n"
+				"			}\n"
+				"			break;\n";
+		}
+	}
+
+	*outStream <<
+		"		}\n"
+		"	}\n"
+		"\n"
+		"	commit_clear_parse_tree( prg, sp, lel->child );\n"
+		"	lel->child = 0;\n"
+		"	pt->flags |= PF_COMMITTED;\n"
+		"\n"
+		"	if ( sp != root )\n"
+		"		goto resume;\n"
+		"}\n"
+		"\n";
+}
+
+
 void Compiler::generateOutput( long activeRealm )
 {
 	FsmCodeGen *fsmGen = new FsmCodeGen( *outStream, redFsm, fsmTables );
@@ -1146,6 +1214,7 @@ void Compiler::generateOutput( long activeRealm )
 	pdaGen->writeRuntimeData( runtimeData, pdaTables );
 
 	writeHostCall();
+	writeCommit();
 
 	if ( !gblLibrary ) 
 		fsmGen->writeMain( activeRealm );
diff --git a/src/compiler.h b/src/compiler.h
index e953c473..a2fb554f 100644
--- a/src/compiler.h
+++ b/src/compiler.h
@@ -655,6 +655,8 @@ struct Compiler
 	void makeEofElements();
 	void makeIgnoreCollectors();
 	void resolvePrecedence();
+	void resolveReductionActions();
+	void findReductionActionProds();
 
 	void declarePass();
 	void resolvePass();
@@ -1008,6 +1010,7 @@ struct Compiler
 	void declareReVars();
 
 	void writeHostCall();
+	void writeCommit();
 };
 
 void afterOpMinimize( FsmGraph *fsm, bool lastInSeq = true );
diff --git a/src/consinit.cc b/src/consinit.cc
index 0ef8aee2..7745ae9c 100644
--- a/src/consinit.cc
+++ b/src/consinit.cc
@@ -36,6 +36,13 @@ extern "C" tree_t **host_call( program_t *prg, long code, tree_t **sp )
 	return 0;
 }
 
+extern "C" void commit_clear_parse_tree( program_t *prg, tree_t **sp, parse_tree_t *pt );
+
+extern "C" void commit_forward_recurse( program_t *prg, tree_t **root, parse_tree_t *pt )
+{
+	commit_clear_parse_tree( prg, root, pt->child );
+}
+
 using std::cout;
 using std::cerr;
 using std::endl;
diff --git a/src/loadcolm.cc b/src/loadcolm.cc
index 5c8212c8..c0e06468 100644
--- a/src/loadcolm.cc
+++ b/src/loadcolm.cc
@@ -2335,6 +2335,38 @@ struct LoadColm
 		namespaceStack.pop();
 	}
 
+	void walkRedAction( red_action RA )
+	{
+		InputLoc loc = RA.NonTerm().loc();
+		String text = RA.HostItems().text().c_str();
+
+		TypeRef *typeRef = walkTypeRef( RA.NonTerm() );
+			
+		ReduceAction *ra = new ReduceAction( loc, typeRef, RA.Prod().data(), text );
+		curReduction()->reduceActions.append( ra );
+	}
+
+	void walkReductionItem( reduction_item reductionItem )
+	{
+		switch ( reductionItem.prodName() ) {
+			case reduction_item::NonTerm: {
+				break;
+			}
+			case reduction_item::Action: {
+				walkRedAction( reductionItem.red_action() );
+				break;
+			}
+		}
+	}
+
+	void walkReductionList( _repeat_reduction_item itemList )
+	{
+		while ( !itemList.end() ) {
+			walkReductionItem( itemList.value() );
+			itemList = itemList.next();
+		}
+	}
+
 	void walkRootItem( root_item rootItem, StmtList *stmtList )
 	{
 		switch ( rootItem.prodName() ) {
@@ -2406,6 +2438,19 @@ struct LoadColm
 			if ( stmt != 0 )
 				stmtList->append( stmt );
 			break;
+		}
+		case root_item::Reduction: {
+			reduction_def RD = rootItem.reduction_def();
+
+			InputLoc loc = RD.REDUCTION().loc();
+			String id = RD.id().data();
+
+			createReduction( loc, id );
+
+			walkReductionList( RD.ItemList() );
+
+			reductionStack.pop();
+			break;
 		}}
 	}
 
diff --git a/src/parser.cc b/src/parser.cc
index d1bead20..22348e06 100644
--- a/src/parser.cc
+++ b/src/parser.cc
@@ -261,6 +261,21 @@ Namespace *BaseParser::createNamespace( const InputLoc &loc, const String &name
 	return nspace;
 }
 
+Reduction *BaseParser::createReduction( const InputLoc loc, const String &name )
+{
+	Namespace *parent = namespaceStack.top();
+	Reduction *reduction = parent->findReduction( name );
+
+	if ( reduction == 0 ) {
+		reduction = new Reduction( loc, name );
+		parent->reductions.append( reduction );
+	}
+
+	reductionStack.push( reduction );
+
+	return reduction;
+}
+
 LexJoin *BaseParser::literalJoin( const InputLoc &loc, const String &data )
 {
 	Literal *literal = Literal::cons( loc, data, Literal::LitString );
diff --git a/src/parser.h b/src/parser.h
index 3365ff59..f2cf4f3e 100644
--- a/src/parser.h
+++ b/src/parser.h
@@ -41,6 +41,7 @@ struct BaseParser
 
 	RegionSetVect regionStack;
 	NamespaceVect namespaceStack;
+	ReductionVect reductionStack;
 	StructStack structStack;
 	ObjectDef *localFrameTop;
 	NameScope *scopeTop;
@@ -61,6 +62,9 @@ struct BaseParser
 	
 	ObjectDef *curLocalFrame()
 		{ return localFrameTop; }
+	
+	Reduction *curReduction()
+		{ return reductionStack.top(); }
 
 	/* Lexical feedback. */
 
@@ -82,6 +86,8 @@ struct BaseParser
 	void addArgvList();
 	LexJoin *literalJoin( const InputLoc &loc, const String &data );
 
+	Reduction *createReduction( const InputLoc loc, const String &name );
+
 	void defineToken( const InputLoc &loc, String name, LexJoin *join,
 			ObjectDef *objectDef, CodeBlock *transBlock,
 			bool ignore, bool noPreIgnore, bool noPostIgnore );
@@ -112,7 +118,8 @@ struct BaseParser
 	LexFactorAug *lexFactorLabel( const InputLoc &loc, const String &data,
 			LexFactorAug *factorAug );
 	LexJoin *lexOptJoin( LexJoin *join, LexJoin *context );
-	LangExpr *send( const InputLoc &loc, LangVarRef *varRef, ConsItemList *list, bool eof );
+	LangExpr *send( const InputLoc &loc, LangVarRef *varRef,
+			ConsItemList *list, bool eof );
 	LangExpr *sendTree( const InputLoc &loc, LangVarRef *varRef,
 			ConsItemList *list, bool eof );
 	LangExpr *parseCmd( const InputLoc &loc, bool tree, bool stop, ObjectField *objField,
diff --git a/src/parsetree.h b/src/parsetree.h
index 3de830cb..b7e4e637 100644
--- a/src/parsetree.h
+++ b/src/parsetree.h
@@ -67,6 +67,8 @@ struct NameScope;
 struct IterCall;
 struct TemplateType;
 struct ObjectMethod;
+struct Reduction;
+struct Production;
 
 
 /* 
@@ -729,6 +731,7 @@ typedef DList<TokenRegion> RegionList;
 typedef DList<RegionImpl> RegionImplList;
 
 typedef Vector<Namespace*> NamespaceVect;
+typedef Vector<Reduction*> ReductionVect;
 
 /* Generics have runtime-representations, so we must track them as unique
  * types. This gives the runtimes some idea of what is contained in the
@@ -872,6 +875,7 @@ struct Namespace
 
 	/* tree_t traversal. */
 	Namespace *findNamespace( const String &name );
+	Reduction *findReduction( const String &name );
 
 	InputLoc loc;
 	String name;
@@ -901,6 +905,8 @@ struct Namespace
 	Namespace *parentNamespace;
 	NamespaceVect childNamespaces;
 
+	ReductionVect reductions;
+
 	NameScope *rootScope;
 
 	Namespace *next, *prev;
@@ -911,6 +917,39 @@ struct Namespace
 typedef DList<Namespace> NamespaceList;
 typedef BstSet< Namespace*, CmpOrd<Namespace*> > NamespaceSet;
 
+struct ReduceAction
+{
+	ReduceAction( const InputLoc &loc, TypeRef *nonterm,
+			const String &prod, const String &txt )
+	:
+		loc(loc), nonterm(nonterm), prod(prod),
+		txt(txt), production(0)
+	{}
+
+	InputLoc loc;
+	TypeRef *nonterm;
+	String prod;
+	String txt;
+
+	Production *production;
+
+	ReduceAction *prev, *next;
+};
+
+typedef DList<ReduceAction> ReduceActionList;
+
+struct Reduction
+{
+	Reduction( const InputLoc &loc, String name )
+		: loc(loc), name(name) {}
+
+	InputLoc loc;
+	String name;
+	int id;
+
+	ReduceActionList reduceActions;
+};
+
 /*
  * LexJoin
  */
diff --git a/src/resolve.cc b/src/resolve.cc
index 95221bcb..38c7b169 100644
--- a/src/resolve.cc
+++ b/src/resolve.cc
@@ -882,7 +882,39 @@ void Compiler::resolvePrecedence()
 	}
 }
 
+void Compiler::resolveReductionActions()
+{
+	for ( ReductionVect::Iter r = rootNamespace->reductions; r.lte(); r++ ) {
+		for ( ReduceActionList::Iter rai = (*r)->reduceActions; rai.lte(); rai++ ) {
+			rai->nonterm->resolveType( this );
+		}
+	}
+}
 
+void Compiler::findReductionActionProds()
+{
+	for ( ReductionVect::Iter r = rootNamespace->reductions; r.lte(); r++ ) {
+		for ( ReduceActionList::Iter rai = (*r)->reduceActions; rai.lte(); rai++ ) {
+			rai->nonterm->resolveType( this );
+			LangEl *langEl = rai->nonterm->uniqueType->langEl;
+
+			Production *prod = 0;
+			for ( LelDefList::Iter ldi = langEl->defList; ldi.lte(); ldi++ ) {
+				if ( strcmp( ldi->name, rai->prod ) == 0 ) {
+					prod = ldi;
+					break;
+				}
+			}
+
+			if ( prod == 0 ) {
+				error(rai->loc) << "could not find production \"" <<
+						rai->prod << "\"" << endp;
+			}
+
+			rai->production = prod;
+		}
+	}
+}
 void Compiler::resolvePass()
 {
 	/*
@@ -896,9 +928,13 @@ void Compiler::resolvePass()
 	UniqueType *argvUT = argvTypeRef->resolveType( this );
 	argvElSel = argvUT->generic->elUt->structEl;
 
+	resolveReductionActions();
+
 	/* We must do this as the last step in the type resolution process because
 	 * all type resolves can cause new language elments with associated
 	 * productions. They get tacked onto the end of the list of productions.
 	 * Doing it at the end results processing a growing list. */
 	resolveProductionEls();
+
+	findReductionActionProds();
 }