mal_parser.mx

一个内存数据库的源代码这是服务器端还有客户端

commands or pattern definitions.  This enables for fast execution.

In addition we allow functions to be bound to both
a linked C-function and a MAL specification block.
It the function address is not available, the interpreter
will use the MAL block instead.
This scheme is intended for just-in-time compilation.

[note, command and patterns do not have a MAL block]
@c
	if( MALkeyword(cntxt,"address",7)){
		str nme;
		int i;
		i = idLength(cntxt);
		if( i==0){
			parseError(cntxt,"<identifier> expected\n");
			return 0;
		}
		cntxt->blkmode=0;
		nme = idCopy(cntxt,i);
		if( getModuleId(curInstr)) 
			setModuleId(curInstr, NULL);
		setModuleScope(curInstr, 
			findModule(cntxt->nspace, putName(modnme,strlen(modnme))) );
		curInstr->fcn = getAddress(cntxt->srcFile, modnme, nme,0);
		curBlk->binding = nme;
		if( cntxt->nspace->isAtomModule) 
			malAtomProperty(curBlk, curInstr);
	} else {
		return (MalBlkPtr) parseError(cntxt,"'address' expected\n");
	}
	@:helpInfo(curBlk->help)@
	showErrors();
	if(curBlk && cntxt->listing) 
		printFunction(GDKout, curBlk, cntxt->listing);
	return curBlk;
}

MalBlkPtr parseFunction(Client cntxt, int kind){
	MalBlkPtr curBlk = 0;
	Symbol curPrg = 0;
	InstrPtr curInstr=0;
	int l;
	str fnme=0, modnme=0;
	char ch;

	int varid=0;
	int type= TYPE_any;

	@:fcnHeader@
	if( MALkeyword(cntxt,"address",7)){
		str nme;
		int i;
		i = idLength(cntxt);
		if( i==0){
			parseError(cntxt,"<identifier> expected\n");
			return 0;
		}
		nme = idCopy(cntxt,i);
		curInstr->fcn = getAddress(cntxt->srcFile, cntxt->nspace->name, nme,0);
		skipSpace(cntxt);
	}
	/* block is terminated at the END statement */
	@:helpInfo(curBlk->help)@
	return curBlk;
}

@-
Functions and  factories end with a labeled end-statement. 
The routine below checks for misalignment of the closing statements.
Any instruction parsed after the function block is considered an
error.
@c
int parseEnd(Client cntxt)
{   MalBlkPtr curBlk = 0;
	Symbol curPrg = 0;
	int l,showit=0;

	if( MALkeyword(cntxt,"end",3) ){
		curPrg = cntxt->curprg;
		curBlk = curPrg->def;   
		l = idLength(cntxt);
		if(l==0) l= operatorLength(cntxt);
		
		if( strncmp(CURRENT(cntxt), getModuleId(getSignature(curPrg)), l)==0) {
			advance(cntxt,l);
			skipSpace(cntxt);
			if( currChar(cntxt) == '.')
				nextChar(cntxt);
			skipSpace(cntxt);
			l = idLength(cntxt);
			if(l==0) l= operatorLength(cntxt);
		} 
		/* parse fcn */
		if( (l== (int)strlen(curPrg->name) &&
			 strncmp(CURRENT(cntxt), curPrg->name, l)==0) || l==0) {
			/* its ok */
		} else {
			parseError(cntxt,"non matching end label, overruled\n");
		}
		pushEndInstruction(curBlk);
		insertSymbol(cntxt->nspace, cntxt->curprg);
		trimMalBlk(cntxt->curprg->def);
		cntxt->blkmode =0;
		curBlk->typefixed=0;
		chkProgram(cntxt->nspace, cntxt->curprg->def);
		if( cntxt->backup){
			cntxt->curprg = cntxt->backup;
			cntxt->backup = 0;
		}
		showit= TRUE;
		skipToEnd(cntxt);
		if(showit && cntxt->listing) 
			printFunction(GDKout, curBlk, cntxt->listing);
		showErrors();
		return 1;
	}
	return 0;
}
@-
Most instructions are simple assignments, possibly
modified with a barrier/catch tag.
@multitable @columnfractions .15 .8
@item statement	   
@tab :  tag varlist [':=' expr ] propQualifier
@item tag			 
@tab :  @sc{ return} | @sc{ barrier} | @sc{ catch}
@item
@tab |  @sc{ leave} | @sc{ redo} | 
@item expr			
@tab :  fcncall 
@item
@tab : [factor  operator] factor 
@item varlist		 
@tab :  variable 
@item
@tab |  @verb{'{' variable {',' variable}* ')' } 
@item variable		
@tab :  identifier propQualifier 
@item factor		  
@tab :  constant | var 
@end multitable

The basic types are also predefined as a variable.
This makes it easier to communicate types to MAL patterns.

@= GETvariable
if ((varid = findVariableLength(curBlk, CURRENT(cntxt), l)) == -1){
	arg = idCopy(cntxt,l); 
	varid = newVariable(curBlk,arg,TYPE_any);
} else
	advance(cntxt,l); 
@-
@c
void 
parseAssign(Client cntxt, int cntrl) 
{   
	InstrPtr curInstr;
	MalBlkPtr curBlk;
	Symbol curPrg;
	int i=0, l,type=TYPE_any, varid= -1;
	int idx;
	str arg=0; 
	ValRecord cst;

	curPrg = cntxt->curprg;
	curBlk = curPrg->def;
	curInstr = newInstruction(curBlk, cntrl?cntrl:ASSIGNsymbol);

	/* start the parsing by recognition of the lhs of an assignment */
	if( currChar(cntxt) == '('){
		/* parsing multi-assignment */
		advance(cntxt,1);
		curInstr->argc=0; /*reset to handle pushArg correctly !! */
		curInstr->retc=0;
		while( currChar(cntxt)  != ')' && currChar(cntxt)) {
			l= idLength(cntxt);
			if( l==0) {
				 parseError(cntxt,"<identifier> expected\n"); 
				 pushInstruction(curBlk,curInstr);
				 return;
			}
			@:GETvariable@
			if( currChar(cntxt)==':') {
				freezeVarType(curBlk,varid);
				type = typeElm(cntxt,getVarType(curBlk,varid));
				setPolymorphic(curInstr, type, FALSE); 
				setVarType(curBlk,varid,type);
			}
			@:propList(varid)@
			curInstr= pushArgument(curBlk,curInstr, varid);
			curInstr->retc++;
			if( currChar(cntxt) == ')') 
				break;
			if( currChar(cntxt) == ',') 
				keyphrase1(cntxt,",");
		}
		advance(cntxt,1); /* skip ')' */
	} else { 
		/* are we dealing with a simple assignment? */
		l= idLength(cntxt);
		if( l==0){
			/* we haven't seen a target variable */
			/* flow of control statements may end here. */
			/* shouldn;t allow for nameless controls todo*/
			if( cntrl == LEAVEsymbol || cntrl == REDOsymbol ||
				cntrl == RETURNsymbol || cntrl == EXITsymbol ){	
 				curInstr->argv[0]= getBarrierEnvelop(curBlk);
				pushInstruction(curBlk,curInstr);
				if( currChar(cntxt) != ';')
					parseError(cntxt,"<identifier> expected\n"); 
				skipToEnd(cntxt);
				return;
				 }
			getArg(curInstr,0)= newTmpVariable(curBlk,TYPE_any);
			pushInstruction(curBlk,curInstr);
			parseError(cntxt,"<identifier> expected\n"); 
			return;
		}  
		/* Check if we are dealing with module.fcn call*/
		if( CURRENT(cntxt)[l]=='.' || CURRENT(cntxt)[l]=='(') {
			curInstr->argv[0]= newTmpVariable(curBlk,TYPE_any);
			goto FCNcallparse;
		}

		/* Get target variable details*/
		@:GETvariable@
		if( !(currChar(cntxt)==':' && CURRENT(cntxt)[1]=='=') ){
			if( currChar(cntxt)==':') {
				freezeVarType(curBlk,varid);
				type = typeElm(cntxt,getVarType(curBlk,varid));
				setPolymorphic(curInstr, type, FALSE);
				setVarType(curBlk,varid,type);
			}
		} 
		@:propList(varid)@
		curInstr->argv[0]= varid;
	}
	/* look for assignment operator */
	if( !keyphrase2(cntxt,":=") ){
	  	/* no assignment !! a control variable is allowed */
		if (currChar(cntxt) != ';')
			parseError(cntxt,"';' expected\n");
		goto part3;
	} 
	if (currChar(cntxt) == '('){
			/* parse multi assignment */
		advance(cntxt,1);
		@:parseArguments()@ /* parseAssign() -> void */
		skipToEnd(cntxt);
		pushInstruction(curBlk,curInstr);
		return;
	}
@-
At this stage the LHS part has been parsed and the destination
variables have been set. Next step is to parse the expression,
which starts with an operand.
This code is used in both positions of the expression
@= term
	str v = NULL;

	if( (i= cstToken(cntxt,&cst))){
		int cstidx = -1,csttpe= TYPE_any;

		cstidx = fndConstant(curBlk,&cst);
		if( cstidx >= 0){
			advance(cntxt,i);
			if( currChar(cntxt)==':') {
				csttpe = typeElm(cntxt,getVarType(curBlk,cstidx));
				if(csttpe == getVarType(curBlk,cstidx) ){
					freezeVarType(curBlk,cstidx);
				} else {
					cstidx = defConstant(curBlk,csttpe,&cst);
					setPolymorphic(curInstr,csttpe, FALSE);
					freezeVarType(curBlk,cstidx);
				}
			} else
			if( cst.vtype != getVarType(curBlk,cstidx)){
					cstidx = defConstant(curBlk,cst.vtype,&cst);
					setPolymorphic(curInstr,cst.vtype, FALSE);
			} 
			curInstr = pushArgument(curBlk,curInstr,cstidx);
			@1;
		} else { 
			/* add a new constant */
			int flag;
			advance(cntxt,i);
			flag= currChar(cntxt)==':';
			csttpe = typeElm(cntxt,cst.vtype);
			cstidx = defConstant(curBlk,csttpe,&cst);
			setPolymorphic(curInstr,csttpe, FALSE);
			if( flag )
				freezeVarType(curBlk,cstidx);
			curInstr = pushArgument(curBlk,curInstr,cstidx);
			@1;
		}
	} else if( (i= idLength(cntxt))){
		if( (idx=findVariableLength(curBlk,CURRENT(cntxt),i)) == -1){
			v= idCopy(cntxt,i);
			i= typeElm(cntxt,TYPE_any);
			setPolymorphic(curInstr,i, FALSE);
			idx = newVariable(curBlk, v, i);
			@:propList(idx)@
		} else {
			advance(cntxt,i);
			i = typeElm(cntxt,getVarType(curBlk,idx));
			setPolymorphic(curInstr,i,FALSE);
			@:propList(idx)@
		}
		curInstr= pushArgument(curBlk,curInstr,idx);
	} else if (currChar(cntxt) == ':'){
		i = typeElm(cntxt,TYPE_any);
		setPolymorphic(curInstr,i,FALSE);
		idx = newTypeVariable(curBlk, i );
		@:propList(idx)@
		curInstr = pushArgument(curBlk,curInstr,idx);
		@1;
	}
@-
The parameter of parseArguments is the return value of the enclosing function.
@= parseArguments
while( currChar(cntxt)!= ')'){
	@:term()@ 
	 else { 
		idx = 0;
		parseError(cntxt,"<factor> expected\n");
		pushInstruction(curBlk,curInstr);
		return @1;
	}
	if (currChar(cntxt) == ',') 
		advance(cntxt,1);
	else if (currChar(cntxt) != ')') {
		parseError(cntxt,"',' expected\n");
		cntxt->yycur--; /* keep it */
		break;
	}
}
if (currChar(cntxt) == ')') 
	advance(cntxt,1);
@-
We have so far the LHS part of an assignment. The remainder is
either a simple term expression, a multi assignent, or the start 
of a function call.
@c
FCNcallparse:
	if( (l=idLength(cntxt)) && CURRENT(cntxt)[l] == '(') {
		setModuleId(curInstr,putName("user",4));
		i= l;
		goto FCNcallparse2;
	} else
	if( (l=idLength(cntxt)) && CURRENT(cntxt)[l] == '.') {
		/* continue with parseing a function/operator call */
		arg= putName(CURRENT(cntxt),l);
		advance(cntxt,l+1); /* skip '.' too */
		setModuleId(curInstr,arg);
		i = idLength(cntxt);
		if( i==0) i= operatorLength(cntxt);
FCNcallparse2:
		if( i ) {
			 setFunctionId(curInstr, putName(((char*)CURRENT(cntxt)),i));
			advance(cntxt,i);
		} else {
			 parseError(cntxt,"<functionname> expected\n");
			 pushInstruction(curBlk,curInstr);
			 return;
		}
		skipSpace(cntxt);
		if (currChar(cntxt) != '(') {
			parseError(cntxt,"'(' expected\n");
			pushInstruction(curBlk,curInstr);
			return;
		}
		advance(cntxt,1);
		@:parseArguments()@ /* parseAssign() -> void */
		skipSpace(cntxt);
		if( currChar(cntxt)!=';')
		parseError(cntxt,"';' expected\n");
		goto part3;
	}
@-
Handle the ordinary assignments and expressions
@c
	{@:term(goto part2)@}
part2:  /* consume <operator><term> part of expression */
	if( (i= operatorLength(cntxt)) ){
		/* simple arithmetic operator expression */
		setFunctionId(curInstr, putName(((char*)CURRENT(cntxt)),i));
		advance(cntxt,i);
		curInstr->modname= putName("calc",4);
		if( (l = idLength(cntxt)) && !(l==3 && strncmp(CURRENT(cntxt),"nil",3)==0) ) {
			@:GETvariable@
			curInstr= pushArgument(curBlk,curInstr,varid); 
			goto part3;
		} 
		{@:term(goto part3)@}
		parseError(cntxt,"<term> expected\n");
		pushInstruction(curBlk,curInstr);
		return;
	} else  {
		skipSpace(cntxt);
		if( currChar(cntxt) == '(')
			parseError(cntxt,"module name missing\n");
		else
		if( currChar(cntxt) != ';' && currChar(cntxt) != '#')
			parseError(cntxt,"operator expected\n");
	}
part3:
	skipToEnd(cntxt);
	pushInstruction(curBlk,curInstr);
}
#define BRKONERR if( curPrg->def->errors>=MAXERRORS) return curPrg->def->errors;
int parseMAL(Client cntxt, Symbol curPrg){
	int cntrl=0;
	/*Symbol curPrg= cntxt->curprg;*/
	char c;

	echoInput(cntxt);
	/* here the work takes place */
	while( (c=currChar(cntxt)) ){
		switch( c){
		case '\n': case '\r': case '\f': 
			nextChar(cntxt);
			echoInput(cntxt);
			continue;
		case ';': case '\t': case ' ': 
			nextChar(cntxt);
			continue;
		case '#': 
		{ /* keep the full line comments unless it is a MX #line */
			char start[256], *e=start, c; 
			MalBlkPtr curBlk= cntxt->curprg->def;
			InstrPtr curInstr;

			*e=0;
			nextChar(cntxt);
			while ((c = currChar(cntxt))) {
				if( e < start+256-1) *e++= c;
				nextChar(cntxt);
				if (c == '\n' || c == '\r') {
					*e = 0;
					if( e > start) e--;
					/* prevChar(cntxt);*/
					break;
				}
			}
			if( e> start) *e=0;
			if( e>start && curBlk->stop > 0 &&
				 strncmp("line ",start,5)!= 0 ){
				ValRecord cst;
@-
Keep the comment lines as un-used constants.
However, comment lines produced by Mx, i.e. #line
directives are not saved. The unnecessarily consume
resources when kept.
The deadcode optimizer removes all comment information.
@c
				curInstr= newInstruction(NULL, REMsymbol);
				cst.vtype= TYPE_str;
				cst.len = strlen(start);
				cst.val.sval= GDKstrdup(start);
				getArg(curInstr,0)= defConstant(curBlk, TYPE_str,&cst);
				/* mark the constant for not being copied to the stack */
				isConstant(curBlk,getArg(curInstr,0)) = 
						-isConstant(curBlk,getArg(curInstr,0));
				pushInstruction(curBlk,curInstr);
			}
			echoInput(cntxt);
		}
			  continue;
		case 'A': case 'a':
			  if( MALkeyword(cntxt,"atom",4) &&
				   parseAtom(cntxt)!=0) break;
			  goto allLeft;
		case 'b': case 'B':
			  if( MALkeyword(cntxt,"barrier",7)) {
				 cntxt->blkmode++;
				 cntrl = BARRIERsymbol; 
			  }
			  goto allLeft;
		case 'C': case 'c': 
			  if( MALkeyword(cntxt,"command",7) ) {
				 parseCommandPattern(cntxt, COMMANDsymbol);
				 continue;
			  }
			  if( MALkeyword(cntxt,"catch",5)){
				 cntrl= CATCHsymbol;
				 goto allLeft;
			  }
			  goto allLeft;
		case 'E': case 'e': 
			  if( MALkeyword(cntxt,"exit",4)){
				 if(cntxt->blkmode>0) cntxt->blkmode--;
				 cntrl= EXITsymbol;
			  } else if( parseEnd(cntxt)) {
					break;
			  }
			  goto allLeft;
		case 'F': case 'f': 
			  if( MALkeyword(cntxt,"function",8) ){
				 cntxt->blkmode++;
				 if( parseFunction(cntxt, FUNCTIONsymbol)) 
					break;
			  } else if( MALkeyword(cntxt,"factory",7) ){
				 cntxt->blkmode++;
				 parseFunction(cntxt, FACTORYsymbol);
				 break;
			  }
			  goto allLeft;
		case 'H': case 'h':
			  if( MALkeyword(cntxt,"handler",5)) { 
				skipToEnd(cntxt); 
				 cntxt->blkmode++;
				 break; 
			  }
		case 'i': if( parseInclude(cntxt)) continue;
			goto allLeft;
		case 'L': case 'l': 
			  if( MALkeyword(cntxt,"leave",5))
				 cntrl= LEAVEsymbol;
			  goto allLeft;
		case 'M': case 'm': 
			  if( MALkeyword(cntxt,"module",6) &&
				 parseModule(cntxt)!= 0) break;
			  goto allLeft;
		case 'P': case 'p': 
			  if( MALkeyword(cntxt,"pattern",7) ) {
				 parseCommandPattern(cntxt, PATTERNsymbol);
				 continue;
			  }
			  goto allLeft;
		case 'R': case 'r': 
			  if( MALkeyword(cntxt,"redo",4)){
				 cntrl= REDOsymbol;
				 goto allLeft;
			  }
			  if( MALkeyword(cntxt,"raise",5)){
				 cntrl= RAISEsymbol;
				 goto allLeft;
			  }
			  if( MALkeyword(cntxt,"return",6)){
				 cntrl= RETURNsymbol;
			  }
			  goto allLeft;
		case 'Y': case 'y':
			if( MALkeyword(cntxt,"yield",5)){
				 cntrl= YIELDsymbol;
				 goto allLeft;
			}
		default: allLeft:
			parseAssign(cntxt,cntrl);
			cntrl =0;
			BRKONERR;
		}
	}
	return curPrg->def->errors;
}
@- Error display
Display the error information for the current client.
An arrow and state number is printed at the "appropriate" place. 
If no lookahead character is a used and the next character is a newline,
we should also copy the input.
@c
str parseError(Client cntxt, str msg)
{   
	Symbol curPrg;
	MalBlkPtr curBlk;
	char buf[10*1024];
	char *s=buf, *t, *l = lastline(cntxt);
	lng i;

	curPrg = cntxt->curprg;
	curBlk = curPrg->def;
	if(curBlk) 
		curBlk->errors++;

	/* accidental %s directives in the lastline can
	   crash the vfsprintf later => escape them */
	for(t=l; *t && *t!='\n'; t++) {
		if (*t == '%') 
			*s++ = '%'; 
		*s++ = *t;
	}
	*s++= '\n';
	*s = 0;
	showException(SYNTAX, "parseError", buf);
	/* produce the position marker*/
	s= buf;
	i = position(cntxt) -1;
	for(; i > 0; i--) {
	   *s++ = ((l && *(l+1) && *l++ != '\t'))?' ':'\t';
	}
	*s++ = '^'; 
	*s = 0;

	if( msg && strlen(msg)+strlen(buf) < 1020)
		snprintf(s,1020,"%s", msg);
	skipToEnd(cntxt);
	showException(SYNTAX, "parseError", buf);
	return 0;
}
@}