Miroirs/newrpl
1
0
Fork 0
mirror of https://git.code.sf.net/p/newrpl/sources synced 2024-11-16 19:51:25 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

Added support for case lists and angles in symbolic expressions. Added RANGE command and ALLROOTS rules.

Browse source 
Fixed compiler/decompiler to accept case lists in symbolics.
This commit is contained in:
claudiol 2019-02-14 12:59:52 -05:00
parent 85ba740c2f
commit 34884fd210
13 changed files with 405 additions and 352 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
newrpl/compiler.c
View file

@ -602,11 +602,14 @@ WORDPTR rplCompile(BYTEPTR string,BINT length, BINT addwrapper)
while(InfixOpTop>(WORDPTR)ValidateTop){
if((TI_TYPE(*(InfixOpTop-1))==TITYPE_OPENBRACKET)) {
// CHECK IF THE BRACKET IS THE RIGHT TYPE OF BRACKET
if((TI_TYPE(probe_tokeninfo)==TITYPE_CLOSEBRACKET) &&(*(InfixOpTop-2)!=Opcode)) {
if((TI_TYPE(probe_tokeninfo)==TITYPE_CLOSEBRACKET) &&(*(InfixOpTop-2)!=(Opcode-1))) {
// MISMATCHED BRACKET TYPE
// SPECIAL CASE: ALLOW LISTBRACKET TO CLOSE CLISTBRACKETS
if(!((Opcode==CMD_LISTCLOSEBRACKET)&&(*(InfixOpTop-2)==CMD_CLISTOPENBRACKET))) {
rplError(ERR_MISSINGBRACKET);
LAMTop=LAMTopSaved;
return 0;
}
}
break;
}
@ -1272,6 +1275,7 @@ end_of_expression:
case INFIX_STARTSYMBOLIC:
rplDecompAppendChar('\'');
if(Exceptions) break;
// DELIBERATE FALL THROUGH
case INFIX_STARTEXPRESSION:
{

46
newrpl/lib-104-solvers.c
View file

@ -341,7 +341,7 @@ case NUMINT:
// HERE THERE'S 8 VALUES ON THE STACK OVER THE RIGHT PART: D F(D) E F(E) AREA_L AREA_R NEWERR FALSE
rplOverwriteData(1,L_ERR);
//*** TESTING: DO NOT HALVE THE ERROR EACH TIME
// *** TESTING: DO NOT HALVE THE ERROR EACH TIME
//plPushData((WORDPTR)one_half_real);
//rplCallOvrOperator(CMD_OVR_MUL); // L_ERR/2
//if(Exceptions) { DSTop=dstkptr; return; }
@ -802,7 +802,7 @@ case NUMINT:
//************************* DEBUG ONLY ***************************
// ************************* DEBUG ONLY ***************************
/*
char Buffer0[1000],Buffer1[1000],Buffer2[1000];
rplReadNumberAsReal(rplPeekData(3),&x1);
@ -814,7 +814,7 @@ case NUMINT:
printf("INI: X=%s , Y=%s , F(P)=%s\n",Buffer0,Buffer1,Buffer2); fflush(stdout);
*/
//************************* DEBUG ONLY ***************************
// ************************* DEBUG ONLY ***************************
@ -947,7 +947,7 @@ case NUMINT:
if(gteReal(&fx,&x1) && ltReal(&fx,&x2)) {
// REPLACE POINT AND CONTINUE
/*
//************************* DEBUG ONLY ***************************
// ************************* DEBUG ONLY ***************************
char Buffer0[1000],Buffer1[1000],Buffer2[1000];
rplReadNumberAsReal(rplPeekData(3),&x1);
rplReadNumberAsReal(rplPeekData(2),&x2);
@ -957,7 +957,7 @@ case NUMINT:
*formatReal(&fx,Buffer2,FMT_CODE,MAKELOCALE('.',' ',' ',','))=0;
printf("REF: X=%s , Y=%s , F(P)=%s\n",Buffer0,Buffer1,Buffer2); fflush(stdout);
//************************* DEBUG ONLY ***************************
// ************************* DEBUG ONLY ***************************
*/
WORDPTR newpt=rplCreateListN(nvars+1,1,1);
@ -1008,7 +1008,7 @@ case NUMINT:
// NOW REPLACE WORST POINT WITH P
/*
//************************* DEBUG ONLY ***************************
// ************************* DEBUG ONLY ***************************
char Buffer0[1000],Buffer1[1000],Buffer2[1000];
rplReadNumberAsReal(rplPeekData(3),&x1);
rplReadNumberAsReal(rplPeekData(2),&x2);
@ -1018,7 +1018,7 @@ case NUMINT:
*formatReal(&fx,Buffer2,FMT_CODE,MAKELOCALE('.',' ',' ',','))=0;
printf("EXP: X=%s , Y=%s , F(P)=%s\n",Buffer0,Buffer1,Buffer2); fflush(stdout);
//************************* DEBUG ONLY ***************************
// ************************* DEBUG ONLY ***************************
*/
// REPLACE POINT AND CONTINUE
WORDPTR newpt=rplCreateListN(nvars+1,1,1);
@ -1071,7 +1071,7 @@ case NUMINT:
rplRemoveAtData(nvars+2,nvars+1); // KEEP P''
/*
//************************* DEBUG ONLY ***************************
// ************************* DEBUG ONLY ***************************
char Buffer0[1000],Buffer1[1000],Buffer2[1000];
rplReadNumberAsReal(rplPeekData(3),&x1);
rplReadNumberAsReal(rplPeekData(2),&x2);
@ -1081,7 +1081,7 @@ case NUMINT:
*formatReal(&fx,Buffer2,FMT_CODE,MAKELOCALE('.',' ',' ',','))=0;
printf("CON: X=%s , Y=%s , F(P)=%s\n",Buffer0,Buffer1,Buffer2); fflush(stdout);
//************************* DEBUG ONLY ***************************
// ************************* DEBUG ONLY ***************************
*/
@ -1128,7 +1128,7 @@ case NUMINT:
if(Exceptions) { DSTop=stksave; return; }
/*
//************************* DEBUG ONLY ***************************
// ************************* DEBUG ONLY ***************************
char Buffer0[1000],Buffer1[1000],Buffer2[1000];
rplReadNumberAsReal(rplPeekData(3),&x1);
rplReadNumberAsReal(rplPeekData(2),&x2);
@ -1138,7 +1138,7 @@ case NUMINT:
*formatReal(&fx,Buffer2,FMT_CODE,MAKELOCALE('.',' ',' ',','))=0;
printf("SHR: X=%s , Y=%s , F(P)=%s\n",Buffer0,Buffer1,Buffer2); fflush(stdout);
//************************* DEBUG ONLY ***************************
// ************************* DEBUG ONLY ***************************
*/
// REPLACE POINT
WORDPTR newpt=rplCreateListN(nvars+1,1,1);
@ -1301,7 +1301,7 @@ case NUMINT:
// NOW REPLACE WORST POINT WITH P
//************************* DEBUG ONLY ***************************
// ************************* DEBUG ONLY ***************************
/*
{
char Buffer0[1000],Buffer1[1000],Buffer2[1000];
@ -1315,7 +1315,7 @@ case NUMINT:
printf("EXP: X=%s , Y=%s , F(P)=%s\n",Buffer0,Buffer1,Buffer2); fflush(stdout);
}
*/
//************************* DEBUG ONLY ***************************
// ************************* DEBUG ONLY ***************************
// REPLACE POINT AND CONTINUE
WORDPTR newpt=rplCreateListN(nvars+1,1,1);
@ -1339,7 +1339,7 @@ case NUMINT:
//************************* DEBUG ONLY ***************************
// ************************* DEBUG ONLY ***************************
/*
char Buffer0[1000],Buffer1[1000],Buffer2[1000];
rplReadNumberAsReal(rplPeekData(3),&x1);
@ -1351,7 +1351,7 @@ case NUMINT:
printf("P??: X=%s , Y=%s , F(P)=%s\n",Buffer0,Buffer1,Buffer2); fflush(stdout);
*/
//************************* DEBUG ONLY ***************************
// ************************* DEBUG ONLY ***************************
// REFLECTION DIDN'T IMPROVE ON OUR BEST POINT, FIND A POINT THROUGH GRADIENTS TO SEE IF WE CAN DO BETTER
@ -1446,7 +1446,7 @@ case NUMINT:
if(Exceptions) { DSTop=stksave; return; }
//************************* DEBUG ONLY ***************************
// ************************* DEBUG ONLY ***************************
/*
{
char Buffer0[1000],Buffer1[1000],Buffer2[1000];
@ -1460,7 +1460,7 @@ case NUMINT:
printf("GR?: X=%s , Y=%s , F(P)=%s\n",Buffer0,Buffer1,Buffer2); fflush(stdout);
}
*/
//************************* DEBUG ONLY ***************************
// ************************* DEBUG ONLY ***************************
rplReadNumberAsReal(rplPeekData(1),&x1); // F(G')
rplReadNumberAsReal(rplPeekData(nvars+2),&fx); // F(P)
@ -1480,7 +1480,7 @@ case NUMINT:
if(ltReal(&fx,&x2)) {
// REPLACE POINT AND CONTINUE
//************************* DEBUG ONLY ***************************
// ************************* DEBUG ONLY ***************************
/*
char Buffer0[1000],Buffer1[1000],Buffer2[1000];
rplReadNumberAsReal(rplPeekData(3),&x1);
@ -1492,7 +1492,7 @@ case NUMINT:
printf("REF: X=%s , Y=%s , F(P)=%s\n",Buffer0,Buffer1,Buffer2); fflush(stdout);
*/
//************************* DEBUG ONLY ***************************
// ************************* DEBUG ONLY ***************************
WORDPTR newpt=rplCreateListN(nvars+1,1,1);
@ -1546,7 +1546,7 @@ case NUMINT:
rplRemoveAtData(nvars+2,nvars+1); // KEEP P''
//************************* DEBUG ONLY ***************************
// ************************* DEBUG ONLY ***************************
/*
char Buffer0[1000],Buffer1[1000],Buffer2[1000];
rplReadNumberAsReal(rplPeekData(3),&x1);
@ -1558,7 +1558,7 @@ case NUMINT:
printf("CON: X=%s , Y=%s , F(P)=%s\n",Buffer0,Buffer1,Buffer2); fflush(stdout);
*/
//************************* DEBUG ONLY ***************************
// ************************* DEBUG ONLY ***************************
@ -1605,7 +1605,7 @@ case NUMINT:
if(Exceptions) { DSTop=stksave; return; }
//************************* DEBUG ONLY ***************************
// ************************* DEBUG ONLY ***************************
/*
char Buffer0[1000],Buffer1[1000],Buffer2[1000];
rplReadNumberAsReal(rplPeekData(3),&x1);
@ -1617,7 +1617,7 @@ case NUMINT:
printf("SHR: X=%s , Y=%s , F(P)=%s\n",Buffer0,Buffer1,Buffer2); fflush(stdout);
*/
//************************* DEBUG ONLY ***************************
// ************************* DEBUG ONLY ***************************
// REPLACE POINT
WORDPTR newpt=rplCreateListN(nvars+1,1,1);

125
newrpl/lib-55-constants.c
View file

@ -65,6 +65,12 @@ INCLUDE_ROMOBJECT(LIB_MSGTABLE);
INCLUDE_ROMOBJECT(LIB_HELPTABLE);
INCLUDE_ROMOBJECT(lib55_menu);
INCLUDE_ROMOBJECT(lib55_pi);
INCLUDE_ROMOBJECT(lib55_i);
INCLUDE_ROMOBJECT(lib55_e);
INCLUDE_ROMOBJECT(lib55_j);
// EXTERNAL EXPORTED OBJECT TABLE
// UP TO 64 OBJECTS ALLOWED, NO MORE
@ -72,37 +78,25 @@ const WORDPTR const ROMPTR_TABLE[]={
(WORDPTR)LIB_HELPTABLE,
(WORDPTR)LIB_MSGTABLE,
(WORDPTR)lib55_menu,
// HERE ADD THE VALUES OF THE CONSTANTS AS RPL OBJECTS. ALL CONSTANTS NEED TO HAVE THEIR NUMERIC OBJECTS IN ROM
(WORDPTR)lib55_pi,
(WORDPTR)lib55_i,
(WORDPTR)lib55_e,
(WORDPTR)lib55_j,
0
};
// CONVERT A CONSTANT TO A NUMBER
// RETURNS EITHER A NEW OBJECT WITH THE NUMERIC REPRESENTATION OF THE CONSTANT
// OR THE SAME OBJECT AS BEFORE. MAY TRIGGER A GC BUT RETURNED POINTER IS SAFE FROM GC.
// OR THE SAME OBJECT AS BEFORE.
// RETURNS OBJECTS IN ROM, VERY FAST, NEVER TRIGGERS GC OR ALLOCATES ANY MEMORY
// DRAWBACK: IT'S ALWAYS AT MAXIMUM PRECISION (2000 DIGITS)
WORDPTR rplConstant2Number(WORDPTR object)
{
if(!ISCONSTANT(*object)) return object;
WORD saveopcode=CurOpcode;
rplPushDataNoGrow(object);
CurOpcode=object[1]; // GET THE OPCODE FOR THE SYMBOL
LIB_HANDLER();
CurOpcode=saveopcode;
return rplPopData();
}
// PUT THE GIVEN CONSTANT INTO RReg[0] OR RReg[0] AND RReg[1] IF COMPLEX
// RETURNS 1 IF REAL, 1000+ANGLE_MODE IF COMPLEX
BINT rplConstant2NumberDirect(WORDPTR object)
{
if(!ISCONSTANT(*object)) return 0;
WORD saveopcode=CurOpcode;
CurOpcode=object[1]|CONSTANT_DIRECT2NUMBER; // GET THE OPCODE FOR THE SYMBOL
LIB_HANDLER();
CurOpcode=saveopcode;
return (BINT)RetNum;
return ROMPTR_TABLE[OPCODE(object[1])+3]; // GET THE OPCODE FOR THE SYMBOL
}
void LIB_HANDLER()
@ -138,9 +132,8 @@ void LIB_HANDLER()
return;
case OVR_NUM:
{
WORDPTR obj=rplPeekData(1);
CurOpcode=obj[1]; // GET THE OPCODE FOR THE SYMBOL
break; // AND CONTINUE TO THE EXECUTION PART
rplOverwriteData(1,rplConstant2Number(rplPeekData(1)));
return;
}
case OVR_ISTRUE:
@ -194,88 +187,6 @@ void LIB_HANDLER()
switch(OPCODE(CurOpcode))
{
case PICONST:
{
//@SHORT_DESC=Numeric constant π with twice the current system precision
//@NEW
if(rplDepthData()<1) { rplError(ERR_BADARGCOUNT); return; }
REAL pi;
decconst_PI(&pi);
WORDPTR result=rplNewReal(&pi);
if(result) rplOverwriteData(1,result);
return;
}
case PICONST | CONSTANT_DIRECT2NUMBER:
{
// PUT THE CONSTANT DIRECTLY INTO RReg[0] (REAL) OR RReg[0] AND [1] FOR COMPLEX
// RETURNS RetNum=1 IF REAL, 1000+ANGLE_MODE IF COMPLEX
REAL pi;
decconst_PI(&pi);
copyReal(&RReg[0],&pi);
normalize(&RReg[0]);
return;
}
case ECONST:
{
//@SHORT_DESC=Numeric constant e at current system precision
//@NEW
if(rplDepthData()<1) { rplError(ERR_BADARGCOUNT); return; }
rplOneToRReg(0);
hyp_exp(&RReg[0]);
normalize(&RReg[0]);
WORDPTR result=rplNewReal(&RReg[0]);
if(result) rplOverwriteData(1,result);
return;
}
case ECONST | CONSTANT_DIRECT2NUMBER:
{
// PUT THE CONSTANT DIRECTLY INTO RReg[0] (REAL) OR RReg[0] AND [1] FOR COMPLEX
// RETURNS RetNum=1 IF REAL, 1000+ANGLE_MODE IF COMPLEX
rplOneToRReg(0);
hyp_exp(&RReg[0]);
normalize(&RReg[0]);
return;
}
case ICONST:
case JCONST:
{
//@SHORT_DESC=Imaginary constant i = j = (0,1)
//@NEW
if(rplDepthData()<1) { rplError(ERR_BADARGCOUNT); return; }
rplOneToRReg(0);
rplZeroToRReg(1);
WORDPTR result=rplNewComplex(&RReg[1],&RReg[0],ANGLENONE);
if(result) rplOverwriteData(1,result);
return;
}
case ICONST | CONSTANT_DIRECT2NUMBER:
case JCONST | CONSTANT_DIRECT2NUMBER:
{
// PUT THE CONSTANT DIRECTLY INTO RReg[0] (REAL) OR RReg[0] AND [1] FOR COMPLEX
// RETURNS RetNum=1 IF REAL, 1000+ANGLE_MODE IF COMPLEX
rplOneToRReg(0);
rplZeroToRReg(1);
return;
}
// STANDARIZED OPCODES:

162
newrpl/lib-56-symbolic.c
View file

@ -53,7 +53,10 @@
CMD(RULEAPPLY1,MKTOKENINFO(10,TITYPE_NOTALLOWED,2,2)), \
ECMD(GIVENTHAT,"|",MKTOKENINFO(1,TITYPE_BINARYOP_LEFT,2,15)), \
CMD(TRIGSIN,MKTOKENINFO(7,TITYPE_CASFUNCTION,1,2)), \
CMD(ALLROOTS,MKTOKENINFO(8,TITYPE_CASFUNCTION,1,2))
CMD(ALLROOTS,MKTOKENINFO(8,TITYPE_CASFUNCTION,1,2)), \
ECMD(CLISTOPENBRACKET,"c{",MKTOKENINFO(2,TITYPE_OPENBRACKET,0,31)), \
ECMD(CLISTCLOSEBRACKET,"}",MKTOKENINFO(1,TITYPE_CLOSEBRACKET,0,31)), \
CMD(RANGE,MKTOKENINFO(5,TITYPE_FUNCTION,3,2))
// CMD(TEST,MKTOKENINFO(4,TITYPE_NOTALLOWED,1,2))
@ -1172,7 +1175,7 @@ void LIB_HANDLER()
rplSetExceptionHandler(IPtr+5); // SET THE EXCEPTION HANDLER TO THE SYMBEVAL1ERR WORD
if((Opcode==CMD_OPENBRACKET) || (Opcode==CMD_LISTOPENBRACKET)) {
if((Opcode==CMD_OPENBRACKET) || (Opcode==CMD_LISTOPENBRACKET) || (Opcode==CMD_CLISTOPENBRACKET)) {
// SPECIAL CASE, THESE COMMANDS NEED THE NUMBER OF ARGUMENTS PUSHED ON THE STACK
rplNewBINTPush(newdepth,DECBINT);
@ -1514,7 +1517,7 @@ void LIB_HANDLER()
rplSetExceptionHandler(IPtr+3); // SET THE EXCEPTION HANDLER TO THE SYMBEVAL1ERR WORD
if((Opcode==CMD_OPENBRACKET) || (Opcode==CMD_LISTOPENBRACKET)) {
if((Opcode==CMD_OPENBRACKET) || (Opcode==CMD_LISTOPENBRACKET) || (Opcode==CMD_CLISTOPENBRACKET)) {
// SPECIAL CASE, THESE COMMANDS NEED THE NUMBER OF ARGUMENTS PUSHED ON THE STACK
rplNewBINTPush(newdepth,DECBINT);
}
@ -1662,7 +1665,7 @@ void LIB_HANDLER()
rplSetExceptionHandler(IPtr+3); // SET THE EXCEPTION HANDLER TO THE SYMBEVAL1ERR WORD
if((Opcode==CMD_OPENBRACKET) || (Opcode==CMD_LISTOPENBRACKET)) {
if((Opcode==CMD_OPENBRACKET) || (Opcode==CMD_LISTOPENBRACKET) || (Opcode==CMD_CLISTOPENBRACKET)) {
// SPECIAL CASE, THESE COMMANDS NEED THE NUMBER OF ARGUMENTS PUSHED ON THE STACK
rplNewBINTPush(newdepth,DECBINT);
}
@ -1963,8 +1966,22 @@ void LIB_HANDLER()
}
rplCreateList();
if(!Exceptions) rplListAutoExpand(rplPeekData(1));
//if(!Exceptions) rplListAutoExpand(rplPeekData(1));
return;
case CLISTOPENBRACKET:
//@SHORT_DESC=@HIDE
if(rplDepthData()<1) {
rplError(ERR_BADARGCOUNT);
return;
}
rplCreateList();
if(!Exceptions) rplListAutoExpand(rplPeekData(1));
return;
case LISTCLOSEBRACKET:
//@SHORT_DESC=@HIDE
@ -2029,7 +2046,130 @@ void LIB_HANDLER()
return;
}
case RANGE:
//@SHORT_DESC=Create a case-list of integers in the given range.
//@NEW
{
if(rplDepthData()<3) {
rplError(ERR_BADARGCOUNT);
return;
}
WORDPTR argstart,argend,argstep;
argstart=rplPeekData(3);
argend=rplPeekData(2);
argstep=rplPeekData(1);
if( ISSYMBOLIC(*argstart)||ISIDENT(*argstart)||ISCONSTANT(*argstart) ||
ISSYMBOLIC(*argend)||ISIDENT(*argend)||ISCONSTANT(*argend) ||
ISSYMBOLIC(*argstep)||ISIDENT(*argstep)||ISCONSTANT(*argstep)
) {
rplSymbApplyOperator(CurOpcode,3);
return;
}
if(ISBINT(*argstart)&&ISBINT(*argend)&&(ISBINT(*argstep)))
{
// ALL INTEGERS!, DO THIS FASTER
BINT64 start,end,step,k;
BINT size=1;
start=rplReadBINT(argstart);
end=rplReadBINT(argend);
step=rplReadBINT(argstep);
if(end<start) {
if(step>=0) step=(end-start)*2;
}
else if(step<=0) step=(end-start)*2;
if(step>0) {
for(k=start;k<=end;k+=step) {
if( (k<=MAX_SINT)&&(k>=MIN_SINT)) size+=1;
else size+=3;
}
} else {
for(k=start;k>=end;k+=step) {
if( (k<=MAX_SINT)&&(k>=MIN_SINT)) size+=1;
else size+=3;
}
}
// HERE WE HAVE THE SIZE OF THE LIST
WORDPTR newlist=rplAllocTempOb(size),ptr;
if(!newlist) return;
newlist[0]=MKPROLOG(DOCASELIST,size);
newlist[size]=CMD_ENDLIST;
ptr=newlist+1;
if(step>0) {
for(k=start;k<=end;k+=step) {
ptr=rplWriteBINT(k,DECBINT,ptr);
}
} else {
for(k=start;k>=end;k+=step) {
ptr=rplWriteBINT(k,DECBINT,ptr);
}
}
rplOverwriteData(3,newlist);
rplDropData(2);
return;
}
// USE REAL NUMBERS, WE ARE DEALING WITH LARGE INTEGERS
REAL start,end,step;
BINT direction;
WORDPTR newlist=rplAllocTempOb(2),ptr;
if(!newlist) return;
ptr=newlist+1;
rplReadNumberAsReal(argstart,&start);
if(Exceptions) return;
rplReadNumberAsReal(argend,&end);
if(Exceptions) return;
rplReadNumberAsReal(argstep,&step);
if(Exceptions) return;
subReal(&RReg[0],&end,&start);
if(RReg[0].flags&F_NEGATIVE) {
if(iszeroReal(&step) || !(step.flags&F_NEGATIVE)) addReal(&RReg[0],&RReg[0],&RReg[0]); // STEP=(END-REAL)*2 SO ONLY ONE POINT WILL BE RETURNED
else copyReal(&RReg[0],&step);
}
else {
if(iszeroReal(&step) || (step.flags&F_NEGATIVE)) addReal(&RReg[0],&RReg[0],&RReg[0]); // STEP=(END-REAL)*2 SO ONLY ONE POINT WILL BE RETURNED
else copyReal(&RReg[0],&step);
}
copyReal(&RReg[1],&start);
copyReal(&RReg[2],&end);
if(RReg[0].flags&F_NEGATIVE) direction=-1;
else direction=1;
do {
// ADD THE CURRENT NUMBER TO THE LIST
ScratchPointer1=newlist;
ScratchPointer2=ptr;
rplResizeLastObject(RReg[1].len+2);
if(Exceptions) return;
ptr=ScratchPointer2;
newlist=ScratchPointer1;
ptr=rplNewRealInPlace(&RReg[1],ptr);
addReal(&RReg[1],&RReg[1],&RReg[0]);
} while(cmpReal(&RReg[1],&RReg[2])!=direction);
newlist[0]=MKPROLOG(DOCASELIST,ptr-newlist);
newlist[ptr-newlist]=CMD_ENDLIST;
rplOverwriteData(3,newlist);
rplDropData(2);
return;
}
@ -2068,7 +2208,7 @@ void LIB_HANDLER()
if(*tok==')') {
if((TokenLen==1) && (CurrentConstruct==MKPROLOG(DOSYMB,0))) {
rplCompileAppend(MKOPCODE(LIBRARY_NUMBER,OPENBRACKET)); // INDICATE THE OPENING BRACKET TO MATCH
rplCompileAppend(MKOPCODE(LIBRARY_NUMBER,CLOSEBRACKET)); // INDICATE THE OPENING BRACKET TO MATCH
RetNum=OK_CONTINUE;
}
else RetNum=ERR_NOTMINE;
@ -2083,6 +2223,14 @@ void LIB_HANDLER()
return;
}
if( (TokenLen==2) && (*tok=='c') && (tok[1]=='{')) {
if(CurrentConstruct==MKPROLOG(DOSYMB,0)) {
rplCompileAppend(MKOPCODE(LIBRARY_NUMBER,CLISTOPENBRACKET));
RetNum=OK_CONTINUE;
}
else RetNum=ERR_NOTMINE;
return;
}
if(*tok=='{') {
if((TokenLen==1)&&(CurrentConstruct==MKPROLOG(DOSYMB,0))) {
rplCompileAppend(MKOPCODE(LIBRARY_NUMBER,LISTOPENBRACKET));
@ -2094,7 +2242,7 @@ void LIB_HANDLER()
if(*tok=='}') {
if((TokenLen==1)&&(CurrentConstruct==MKPROLOG(DOSYMB,0))) {
// ISSUE A BUILDLIST OPERATOR
rplCompileAppend(MKOPCODE(LIBRARY_NUMBER,LISTOPENBRACKET));
rplCompileAppend(MKOPCODE(LIBRARY_NUMBER,LISTCLOSEBRACKET));
RetNum=OK_CONTINUE;
}
else RetNum=ERR_NOTMINE;

59
newrpl/lib-62-lists.c
View file

@ -3005,10 +3005,67 @@ void LIB_HANDLER()
//DECOMPILE RETURNS
// RetNum = enum DecompileErrors
if(ISPROLOG(*DecompileObject)) {
if(!ISAUTOEXPLIST(*DecompileObject)) rplDecompAppendString((BYTEPTR)"{");
else rplDecompAppendString((BYTEPTR)"c{");
RetNum=OK_STARTCONSTRUCT;
BINT islistoflist=rplListHasLists(DecompileObject);
BINT depth=0,needseparator;
if(islistoflist) needseparator=!rplDecompDoHintsWidth(HINT_NLAFTER|HINT_ADDINDENTAFTER);
else needseparator=!rplDecompDoHintsWidth(0);
if(needseparator) rplDecompAppendChar(' ');
BINT offset=1,endoffset=rplObjSize(DecompileObject);
while(offset<endoffset)
{
if(ISLIST(DecompileObject[offset])) {
if(!ISAUTOEXPLIST(DecompileObject[offset])) rplDecompAppendString((BYTEPTR)"{");
else rplDecompAppendString((BYTEPTR)"c{");
if(!rplDecompDoHintsWidth(0)) rplDecompAppendChar(' ');
if(Exceptions) { RetNum=ERR_INVALID; return; }
++depth;
++offset;
continue;
}
if(DecompileObject[offset]==CMD_ENDLIST) {
rplDecompAppendString((BYTEPTR)"}");
if(Exceptions) { RetNum=ERR_INVALID; return; }
if(depth) needseparator=!rplDecompDoHintsWidth(HINT_NLAFTER|HINT_SUBINDENTAFTER);
else needseparator=!rplDecompDoHintsWidth(0);
if(needseparator && offset<endoffset-1) rplDecompAppendChar(' ');
--depth;
++offset;
continue;
}
rplDecompile(DecompileObject+offset,DECOMP_EMBEDDED | ((CurOpcode==OPCODE_DECOMPEDIT)? (DECOMP_EDIT|DECOMP_NOHINTS):DECOMP_NOHINTS)); // RUN EMBEDDED
if(Exceptions) { RetNum=ERR_INVALID; return; }
if(islistoflist && !depth) needseparator=!rplDecompDoHintsWidth(HINT_NLAFTER);
else needseparator=!rplDecompDoHintsWidth(0);
if(needseparator) rplDecompAppendChar(' ');
offset+=rplObjSize(DecompileObject+offset);
}
RetNum=OK_CONTINUE;
return;
}
if(*DecompileObject==CMD_ENDLIST) {

122
newrpl/lib-64-arithmetic.c
View file

@ -342,23 +342,6 @@ void LIB_HANDLER()
return;
}
if(ISCONSTANT(*arg)) {
if(rplConstant2NumberDirect(arg)==1) {
if(isintegerReal(&RReg[0])) {
return;
}
ipReal(&RReg[1],&RReg[0],1);
if((RReg[0].flags&F_NEGATIVE)) {
RReg[1].data[0]++;
normalize(&RReg[1]);
}
rplDropData(1);
rplNewRealFromRRegPush(1);
return;
}
rplError(ERR_REALEXPECTED);
return;
}
REAL rnum;
if(ISBINT(*arg)) return;
@ -398,25 +381,6 @@ void LIB_HANDLER()
if(ISBINT(*arg)) return;
if(ISCONSTANT(*arg)) {
if(rplConstant2NumberDirect(arg)==1) {
if(isintegerReal(&RReg[0])) {
return;
}
ipReal(&RReg[1],&RReg[0],1);
if(!(RReg[0].flags&F_NEGATIVE)) {
RReg[1].data[0]++;
normalize(&RReg[1]);
}
rplDropData(1);
rplNewRealFromRRegPush(1);
return;
}
rplError(ERR_REALEXPECTED);
return;
}
REAL rnum;
rplReadNumberAsReal(rplPeekData(1),&rnum);
@ -464,18 +428,7 @@ void LIB_HANDLER()
return;
}
if(ISCONSTANT(*arg)) {
if(rplConstant2NumberDirect(arg)==1) {
ipReal(&RReg[1],&RReg[0],1);
rplDropData(1);
rplNewRealFromRRegPush(1);
return;
}
rplError(ERR_REALEXPECTED);
return;
}
REAL rnum;
REAL rnum;
rplReadNumberAsReal(arg,&rnum);
if(Exceptions) return;
@ -547,17 +500,6 @@ case IPPOST:
return;
}
if(ISCONSTANT(*arg)) {
if(rplConstant2NumberDirect(arg)==1) {
fpReal(&RReg[1],&RReg[0],1);
rplDropData(1);
rplNewRealFromRRegPush(1);
return;
}
rplError(ERR_REALEXPECTED);
return;
}
REAL rnum;
rplReadNumberAsReal(arg,&rnum);
if(Exceptions) return;
@ -654,22 +596,6 @@ case IPPOST:
} else {
if(ISCONSTANT(*arg)) {
if(rplConstant2NumberDirect(arg)==1) {
if(!isintegerReal(&RReg[0])) {
rplError(ERR_INTEGEREXPECTED);
return;
}
swapReal(&RReg[0],&RReg[7]);
if(isprimeReal(&RReg[7])) rplOverwriteData(1,(WORDPTR)one_bint);
else rplOverwriteData(1,(WORDPTR)zero_bint);
return;
}
rplError(ERR_REALEXPECTED);
return;
}
REAL num;
rplReadNumberAsReal(arg,&num);
@ -725,25 +651,6 @@ case IPPOST:
}
if(ISCONSTANT(*arg)) {
if(rplConstant2NumberDirect(arg)==1) {
if(!isintegerReal(&RReg[0])) {
rplError(ERR_INTEGEREXPECTED);
return;
}
swapReal(&RReg[0],&RReg[7]);
nextprimeReal(0,&RReg[7]);
rplDropData(1);
rplNewRealFromRRegPush(0);
return;
}
rplError(ERR_REALEXPECTED);
return;
}
REAL num;
rplReadNumberAsReal(arg,&num);
@ -819,17 +726,7 @@ case IPPOST:
REAL num;
if(ISCONSTANT(*arg)) {
if(rplConstant2NumberDirect(arg)==1) {
swapReal(&RReg[0],&RReg[8]);
cloneReal(&num,&RReg[8]);
}
else {
rplError(ERR_INTEGEREXPECTED);
return;
}
}
else rplReadNumberAsReal(arg,&num);
rplReadNumberAsReal(arg,&num);
if(!isintegerReal(&num)) {
rplError(ERR_INTEGEREXPECTED);
@ -894,17 +791,7 @@ case IPPOST:
else {
REAL num;
if(ISCONSTANT(*arg)) {
if(rplConstant2NumberDirect(arg)==1) {
swapReal(&RReg[0],&RReg[8]);
cloneReal(&num,&RReg[8]);
}
else {
rplError(ERR_INTEGEREXPECTED);
return;
}
}
else rplReadNumberAsReal(arg,&num);
rplReadNumberAsReal(arg,&num);
if(!isintegerReal(&num)) {
rplError(ERR_INTEGEREXPECTED);
@ -972,6 +859,7 @@ case IPPOST:
return;
}
WORDPTR mod=rplGetSettingsbyName((BYTEPTR)modulo_name,(BYTEPTR)modulo_name+3);
if(!mod) mod=(WORDPTR)two_bint;
if( !ISNUMBER(*arg2) || !ISNUMBER(*mod)) {
@ -979,6 +867,8 @@ case IPPOST:
return;
}
if(ISBINT(*arg1) && ISBINT(*arg2) && ISBINT(*mod)) {
BINT64 a1=rplReadBINT(arg1);

2
newrpl/lib-ten-reals.c
View file

@ -153,6 +153,8 @@ BINT rplReadRealFlags(WORDPTR object)
// CHECK IF AN OBJECT IS THE NUMBER ZERO
BINT rplIsNumberZero(WORDPTR obj)
{
if(ISCONSTANT(*obj)) obj=rplConstant2Number(obj);
if(ISBINT(*obj)) {
if(ISPROLOG(*obj)) {
BINT64 *ptr=(BINT64 *)(obj+1);

12
newrpl/lib-twelve-bint.c
View file

@ -69,10 +69,7 @@
#define LIBFROMBASE(base) ((base<<1)+(BINBINT-2))
#define MIN_SINT -131072
#define MAX_SINT +131071
#define MAX_BINT +9223372036854775807LL
#define MIN_BINT (-9223372036854775807LL-1LL)
const UBINT64 const powersof10[20]={
1000000000000000000LL,
@ -315,6 +312,8 @@ void rplPushTrue()
BINT rplIsFalse(WORDPTR objptr)
{
objptr=rplConstant2Number(objptr);
if(ISANGLE(*objptr)) ++objptr; // POINT TO THE NUMBER INSIDE THE ANGLE
if(IS_FALSE(*objptr)) return 1;
@ -349,6 +348,7 @@ BINT rplIsTrue(WORDPTR objptr)
BINT rplIsNegative(WORDPTR objptr)
{
objptr=rplConstant2Number(objptr);
if(ISANGLE(*objptr)) ++objptr; // POINT TO THE NUMBER INSIDE THE ANGLE
if(ISBINT(*objptr)) {
@ -381,6 +381,7 @@ BINT rplIsNegative(WORDPTR objptr)
// READS A SINT, BINT OR REAL INTO A REAL NUMBER REGISTER
void rplNumberToRReg(int num,WORDPTR number)
{
number=rplConstant2Number(number);
if(ISREAL(*number)) rplCopyRealToRReg(num,number);
else if(ISBINT(*number)) rplBINTToRReg(num,rplReadBINT(number));
else {
@ -396,6 +397,7 @@ void rplNumberToRReg(int num,WORDPTR number)
BINT64 rplReadNumberAsBINT(WORDPTR number)
{
BINT64 value;
number=rplConstant2Number(number);
if(ISANGLE(*number)) ++number;
if(ISREAL(*number)) {
@ -424,6 +426,8 @@ BINT64 rplReadNumberAsBINT(WORDPTR number)
void rplReadNumberAsReal(WORDPTR number,REAL*dec)
{
number=rplConstant2Number(number);
if(ISANGLE(*number)) ++number;
if(ISREAL(*number)) rplReadReal(number,dec);
else if(ISBINT(*number)) {

8
newrpl/libraries.h
View file

@ -237,7 +237,10 @@ WORD libComputeHash2(WORDPTR start,BINT nwords);
#define MIN_SINT -131072
#define MAX_SINT +131071
#define MAX_BINT +9223372036854775807LL
#define MIN_BINT (-9223372036854775807LL-1LL)
@ -432,9 +435,6 @@ WORD libComputeHash2(WORDPTR start,BINT nwords);
#define INCLUDE_ROMOBJECT(id_name) ROMOBJECT id_name[]={ MAKESINT(0) }
#endif
// REQUEST OPCODE TO CONVERT CONSTANT DIRECTLY TO REAL/COMPLEX NUMBERS, WITHOUT CREATING ANY OBJECTS
#define CONSTANT_DIRECT2NUMBER 0x40000
// CONSTANTS FOR UNIVERSAL LIBRARY ENTRY POINTS
#define USERLIB_HANDLER 0
#define USERLIB_TITLE 1

12
newrpl/lists.c
View file

@ -679,3 +679,15 @@ void rplListExpandCases()
rplOverwriteData(1,newlist2);
rplOverwriteData(2,newlist1);
}
// RETURN TRUE IF ANY OF THE OBJECTS WITHIN A LIST IS A LIST
BINT rplListHasLists(WORDPTR list)
{
WORDPTR endlist=rplSkipOb(list);
++list;
while(list<endlist) {
if(ISLIST(*list)) return 1;
list=rplSkipOb(list);
}
return 0;
}

2
newrpl/newrpl.h
View file

@ -657,6 +657,8 @@ WORDPTR rplListAddRot(WORDPTR list,WORDPTR object,BINT nmax);
WORDPTR rplListReplace(WORDPTR list,BINT position,WORDPTR object);
WORDPTR rplListReplaceMulti(WORDPTR list,BINT position,WORDPTR object);
void rplListExpandCases();
BINT rplListHasLists(WORDPTR list);

4
newrpl/rpl-objects/lib-56.nrpl
View file

@ -201,8 +201,8 @@ R → A<fraction>"
@#name allroots_rules
{
'√.xX:→XROOT(ABS(.xX),2)*{1,-1}'
'.xX^(1/.iN):→XROOT(ABS(.xX),.iN)*е^(ARG(.xX)/.iN*і+RANGE(1,.iN,1))'
'√.xX:→XROOT(ABS(.xX),2)*c{1,-1}'
'.xX^(1/.iN):→XROOT(ABS(.xX),.iN)*е^(ARG(.xX)/.iN*і+∡360°/.iN*RANGE(1,.iN,1))'
}

197
newrpl/symbolic.c
View file

@ -492,7 +492,6 @@ WORDPTR rplSymbImplode(WORDPTR *exprstart)
{
if(addcount) { numobjects+=OBJSIZE(**stkptr)-1; addcount=0; }
if((!ISBINT(**stkptr)) && (!ISPROLOG(**stkptr))) { addcount=1; ++numobjects; }
size+=rplObjSize(*stkptr);
--stkptr;
}
@ -516,13 +515,37 @@ WORDPTR rplSymbImplode(WORDPTR *exprstart)
++f;
}
else {
if(f==0) {
// FIRST OBJECT NEEDS A SYMBOLIC WRAPPER EVEN WITHOUT AN OPCODE
*newptr++=MKPROLOG(DOSYMB,rplObjSize(object));
if(ISLIST(*object)) {
// CONVERT THE LIST INTO A SYMBOLIC LIST CONSTRUCTOR OPERATOR
*newptr++=MKPROLOG(DOSYMB,rplObjSize(object)-1);
if(ISAUTOEXPLIST(*object)) *newptr++=CMD_CLISTOPENBRACKET;
else *newptr++=CMD_LISTOPENBRACKET;
// NOW COPY THE OBJECTS IN THE LIST
WORDPTR endobj=rplSkipOb(object)-1; // STOP AT THE CMD_ENDLIST OBJECT
BINT k;
object++;
while(object!=endobj) {
if(*object==CMD_ENDLIST) { ++object; continue; }
if(ISLIST(*object)) {
*newptr++=MKPROLOG(DOSYMB,rplObjSize(object)-1);
if(ISAUTOEXPLIST(*object)) *newptr++=CMD_CLISTOPENBRACKET;
else *newptr++=CMD_LISTOPENBRACKET;
object++;
continue;
}
for(k=0;k<rplObjSize(object);++k) *newptr++=*object++;
}
}
else {
if(f==0) {
// FIRST OBJECT NEEDS A SYMBOLIC WRAPPER EVEN WITHOUT AN OPCODE
*newptr++=MKPROLOG(DOSYMB,rplObjSize(object));
}
// COPY THE OBJECT
WORDPTR endobj=rplSkipOb(object);
while(object!=endobj) *newptr++=*object++;
}
}
--stkptr;
@ -633,7 +656,7 @@ WORDPTR *rplSymbExplodeCanonicalForm(WORDPTR object,BINT for_display)
stkptr=DSTop-1;
endofstk=stkptr-numitems;
//*******************************************
// *******************************************
// SCAN THE SYMBOLIC FOR ITEM A)
// A) NEGATIVE NUMBERS REPLACED WITH NEG(n)
@ -692,7 +715,7 @@ WORDPTR *rplSymbExplodeCanonicalForm(WORDPTR object,BINT for_display)
}
//*******************************************
// *******************************************
// SCAN THE SYMBOLIC FOR ITEM B)
// B) ALL SUBTRACTIONS REPLACED WITH ADDITION OF NEGATED ITEMS
@ -730,7 +753,7 @@ WORDPTR *rplSymbExplodeCanonicalForm(WORDPTR object,BINT for_display)
//*******************************************
// *******************************************
// SCAN THE SYMBOLIC FOR ITEM C)
// C) ALL NEG(A+B+...) = NEG(A)+NEG(B)+NEG(...)
@ -805,7 +828,7 @@ WORDPTR *rplSymbExplodeCanonicalForm(WORDPTR object,BINT for_display)
//*******************************************
// *******************************************
// SCAN THE SYMBOLIC FOR ITEM D)
// D) FLATTEN ALL ADDITION TREES
@ -856,7 +879,7 @@ WORDPTR *rplSymbExplodeCanonicalForm(WORDPTR object,BINT for_display)
}
//*******************************************
// *******************************************
// SCAN THE SYMBOLIC FOR ITEM E)
// E) ALL NEGATIVE POWERS REPLACED WITH a^-n = INV(a^n)
@ -890,7 +913,7 @@ WORDPTR *rplSymbExplodeCanonicalForm(WORDPTR object,BINT for_display)
--stkptr;
}
//*******************************************
// *******************************************
// SCAN THE SYMBOLIC FOR ITEM F)
// F) ALL DIVISIONS REPLACED WITH MULTIPLICATION BY INV()
@ -926,7 +949,7 @@ WORDPTR *rplSymbExplodeCanonicalForm(WORDPTR object,BINT for_display)
}
//*******************************************
// *******************************************
// SCAN THE SYMBOLIC FOR ITEM G)
// G) ALL INV(A*B*...) = INV(...)*INV(B)*INV(A)
@ -1073,7 +1096,7 @@ WORDPTR *rplSymbExplodeCanonicalForm(WORDPTR object,BINT for_display)
--stkptr;
}
//*******************************************
// *******************************************
// SCAN THE SYMBOLIC FOR ITEM G.2)
// G.2) ALL NEG(A*B*...) = NEG(A)*B*...
@ -1103,7 +1126,7 @@ WORDPTR *rplSymbExplodeCanonicalForm(WORDPTR object,BINT for_display)
--stkptr;
}
//*******************************************
// *******************************************
// SCAN THE SYMBOLIC FOR ITEM G.3)
// G.3) ALL NEG(NEG(...)) = (...)
@ -1133,7 +1156,7 @@ WORDPTR *rplSymbExplodeCanonicalForm(WORDPTR object,BINT for_display)
--stkptr;
}
//*******************************************
// *******************************************
// SCAN THE SYMBOLIC FOR ITEM H)
// H) FLATTEN ALL MULTIPLICATION TREES
@ -1185,7 +1208,7 @@ WORDPTR *rplSymbExplodeCanonicalForm(WORDPTR object,BINT for_display)
if(for_display) {
//*******************************************
// *******************************************
// SCAN THE SYMBOLIC FOR ITEM I)
// I) SORT ALL MULTIPLICATIONS WITH INV(...) LAST, NON-INVERSE FACTORS FIRST
// ALSO, IF ALL FACTORS ARE INV(...), THEN ADD A BINT 1 AS FIRST ELEMENT (1/X)
@ -1269,7 +1292,7 @@ if(for_display) {
--stkptr;
}
//*******************************************
// *******************************************
// SCAN THE SYMBOLIC FOR ITEM J)
// J) ANY EXPRESSION STARTING WITH INV() NEEDS TO BE REPLACED WITH 1*INV(), EXCEPT MUL ARGUMENTS
@ -2341,7 +2364,7 @@ WORDPTR rplSymbNumericReduce(WORDPTR object)
}
// SPECIAL CASE: FOR BRACKET OPERATORS WE NEED TO KEEP THEM AS SYMBOLIC
if((**stkptr==CMD_OPENBRACKET)||(**stkptr==CMD_LISTOPENBRACKET)) rplSymbApplyOperator(**stkptr,nargs);
if((**stkptr==CMD_OPENBRACKET)||(**stkptr==CMD_LISTOPENBRACKET)||(**stkptr==CMD_CLISTOPENBRACKET)) rplSymbApplyOperator(**stkptr,nargs);
else rplCallOperator(**stkptr);
if(Exceptions) { rplBlameError(*stkptr); DSTop=endofstk+1; return 0; }
@ -2916,9 +2939,9 @@ BINT rplSymbRuleMatch()
rplPushDataNoGrow(newexp);
//******************************************************
// ******************************************************
// DEBUG ONLY AREA
//******************************************************
// ******************************************************
#ifdef RULEDEBUG
printf("START RULE MATCH 3: ");
@ -3015,9 +3038,9 @@ do {
// GET POINTERS TO THE LEFT AND RIGHT EXPRESSIONS, AND ARGUMENT COUNTS
reloadPointers(DSTop,&s);
//******************************************************
// ******************************************************
// DEBUG ONLY AREA
//******************************************************
// ******************************************************
#ifdef RULEDEBUG
printf("OPMATCH: ");
@ -3037,9 +3060,9 @@ do {
}
printf("\n"); fflush(stdout);
#endif
//******************************************************
// ******************************************************
// END DEBUG ONLY AREA
//******************************************************
// ******************************************************
// OPERATOR COMPARISON, CHECK IF OPERATORS ARE IDENTICAL
if(s.rightnargs) {
@ -3970,9 +3993,9 @@ do {
// UPDATE POINTERS
reloadPointers(DSTop,&s);
//******************************************************
// ******************************************************
// DEBUG ONLY AREA
//******************************************************
// ******************************************************
#ifdef RULEDEBUG
printf("ARGMATCH: %d/%d,%d/%d",s.leftidx,s.leftnargs,s.rightidx,s.rightnargs);
if((s.leftidx>0) && (s.leftidx<=s.leftnargs)) {
@ -3995,9 +4018,9 @@ do {
}
printf("\n"); fflush(stdout);
#endif
//******************************************************
// ******************************************************
// END DEBUG ONLY AREA
//******************************************************
// ******************************************************
@ -4048,9 +4071,9 @@ do {
reloadPointers(DSTop,&s);
//******************************************************
// ******************************************************
// DEBUG ONLY AREA
//******************************************************
// ******************************************************
#ifdef RULEDEBUG
printf("RESTARTMATCH: %d/%d,%d/%d",s.leftidx,s.leftnargs,s.rightidx,s.rightnargs);
if((s.leftidx>0) && (s.leftidx<=s.leftnargs)) {
@ -4073,9 +4096,9 @@ do {
}
printf("\n"); fflush(stdout);
#endif
//******************************************************
// ******************************************************
// END DEBUG ONLY AREA
//******************************************************
// ******************************************************
if(s.leftidx<s.leftnargs) {
@ -4109,9 +4132,9 @@ do {
matchtype=OPMATCH;
matchstarted=0;
//******************************************************
// ******************************************************
// DEBUG ONLY AREA
//******************************************************
// ******************************************************
#ifdef RULEDEBUG
printf("RESTARTED: %d/%d,%d/%d",s.leftidx,s.leftnargs,s.rightidx,s.rightnargs);
if((s.leftidx>0) && (s.leftidx<=s.leftnargs)) {
@ -4134,9 +4157,9 @@ do {
}
printf("\n"); fflush(stdout);
#endif
//******************************************************
// ******************************************************
// END DEBUG ONLY AREA
//******************************************************
// ******************************************************
@ -4155,16 +4178,16 @@ do {
DSTop=s.left- ( (s.leftnargs)? (1+s.leftnargs):0);
baselevel=DSTop-DStkBottom;
//******************************************************
// ******************************************************
// DEBUG ONLY AREA
//******************************************************
// ******************************************************
#ifdef RULEDEBUG
printf("RESTARTMATCH UP");
printf("\n"); fflush(stdout);
#endif
//******************************************************
// ******************************************************
// END DEBUG ONLY AREA
//******************************************************
// ******************************************************
@ -4177,9 +4200,9 @@ do {
reloadPointers(DSTop,&s);
//******************************************************
// ******************************************************
// DEBUG ONLY AREA
//******************************************************
// ******************************************************
#ifdef RULEDEBUG
printf("BACKTRACK: %d/%d,%d/%d",s.leftidx,s.leftnargs,s.rightidx,s.rightnargs);
if((s.leftidx>0) && (s.leftidx<=s.leftnargs)) {
@ -4202,9 +4225,9 @@ do {
}
printf("\n"); fflush(stdout);
#endif
//******************************************************
// ******************************************************
// END DEBUG ONLY AREA
//******************************************************
// ******************************************************
@ -4236,32 +4259,32 @@ do {
if(Exceptions) { rplCleanupSnapshots(stkbottom); DSTop=expression; LAMTop=lamsave; nLAMBase=lamcurrent; return 0; }
//******************************************************
// ******************************************************
// DEBUG ONLY AREA
//******************************************************
// ******************************************************
#ifdef RULEDEBUG
printf("ARGUMENT ROT1");
printf("\n"); fflush(stdout);
#endif
//******************************************************
// ******************************************************
// END DEBUG ONLY AREA
//******************************************************
// ******************************************************
}
else {
if(s.leftrot && (s.leftrot==s.leftnargs-s.leftidx)) {
// ALL ARGUMENTS COMPLETE
matchtype=BACKTRACK;
//******************************************************
// ******************************************************
// DEBUG ONLY AREA
//******************************************************
// ******************************************************
#ifdef RULEDEBUG
printf("BACKTRACKED UP");
printf("\n"); fflush(stdout);
#endif
//******************************************************
// ******************************************************
// END DEBUG ONLY AREA
//******************************************************
// ******************************************************
break;
}
@ -4272,9 +4295,9 @@ do {
// NON-COMMUTATIVE MATCH BACKTRACK FROM A SNAPSHOT, THIS SHOULD NEVER HAPPEN (???)
//******************************************************
// ******************************************************
// DEBUG ONLY AREA
//******************************************************
// ******************************************************
#ifdef RULEDEBUG
printf("ERROR IN BACKTRACK: %d/%d,%d/%d",s.leftidx,s.leftnargs,s.rightidx,s.rightnargs);
if((s.leftidx>0) && (s.leftidx<=s.leftnargs)) {
@ -4297,9 +4320,9 @@ do {
}
printf("\n"); fflush(stdout);
#endif
//******************************************************
// ******************************************************
// END DEBUG ONLY AREA
//******************************************************
// ******************************************************
break;
@ -4340,9 +4363,9 @@ do {
matchstarted=0;
//******************************************************
// ******************************************************
// DEBUG ONLY AREA
//******************************************************
// ******************************************************
#ifdef RULEDEBUG
printf("BACKTRACKED: %d/%d,%d/%d",s.leftidx,s.leftnargs,s.rightidx,s.rightnargs);
if((s.leftidx>0) && (s.leftidx<=s.leftnargs)) {
@ -4365,9 +4388,9 @@ do {
}
printf("\n"); fflush(stdout);
#endif
//******************************************************
// ******************************************************
// END DEBUG ONLY AREA
//******************************************************
// ******************************************************
// CLEAN THE PREVIOUS ENVIRONMENT
@ -4386,16 +4409,16 @@ do {
// KEEP BACKTRACKING
DSTop=s.left- ( (s.leftnargs)? (1+s.leftnargs):0); // DROP ENTIRE LEVEL
//******************************************************
// ******************************************************
// DEBUG ONLY AREA
//******************************************************
// ******************************************************
#ifdef RULEDEBUG
printf("BACKTRACKED UP");
printf("\n"); fflush(stdout);
#endif
//******************************************************
// ******************************************************
// END DEBUG ONLY AREA
//******************************************************
// ******************************************************
}
}
break;
@ -4404,9 +4427,9 @@ do {
{
reloadPointers(DSTop,&s);
//******************************************************
// ******************************************************
// DEBUG ONLY AREA
//******************************************************
// ******************************************************
#ifdef RULEDEBUG
printf("ARGDONE: %d/%d,%d/%d",s.leftidx,s.leftnargs,s.rightidx,s.rightnargs);
if((s.leftidx>0) && (s.leftidx<=s.leftnargs)) {
@ -4429,9 +4452,9 @@ do {
}
printf("\n"); fflush(stdout);
#endif
//******************************************************
// ******************************************************
// END DEBUG ONLY AREA
//******************************************************
// ******************************************************
++s.leftidx;
@ -4447,9 +4470,9 @@ do {
rplSymbReplaceMatchHere(rule,s.leftidx-s.rightnargs);
if(Exceptions) { rplCleanupSnapshots(stkbottom); DSTop=expression; LAMTop=lamsave; nLAMBase=lamcurrent; return 0; }
//******************************************************
// ******************************************************
// DEBUG ONLY AREA
//******************************************************
// ******************************************************
#ifdef RULEDEBUG
printf("REPLACED (EXTRA LEFT): ");
WORDPTR string=rplDecompile(*DStkBottom,DECOMP_EDIT|DECOMP_NOHINTS);
@ -4461,9 +4484,9 @@ do {
}
printf("\n"); fflush(stdout);
#endif
//******************************************************
// ******************************************************
// END DEBUG ONLY AREA
//******************************************************
// ******************************************************
// UPDATE ALL POINTERS AS THE EXPRESSION MOVED IN THE STACK
baselevel=DSTop-DStkBottom;
reloadPointers(DSTop,&s);
@ -4516,16 +4539,16 @@ do {
if(Exceptions) { rplCleanupSnapshots(stkbottom); DSTop=expression; LAMTop=lamsave; nLAMBase=lamcurrent; return 0; }
//******************************************************
// ******************************************************
// DEBUG ONLY AREA
//******************************************************
// ******************************************************
#ifdef RULEDEBUG
printf("ARGDONE UP");
printf("\n"); fflush(stdout);
#endif
//******************************************************
// ******************************************************
// END DEBUG ONLY AREA
//******************************************************
// ******************************************************
}
@ -4596,9 +4619,9 @@ do {
if( (s.leftidx-s.rightnargs>=1)&& (s.leftidx-s.rightnargs<s.leftnargs)) rplSymbReplaceMatchHere(rule,s.leftidx-s.rightnargs);
else rplSymbReplaceMatchHere(rule,1);
if(Exceptions) { rplCleanupSnapshots(stkbottom); DSTop=expression; LAMTop=lamsave; nLAMBase=lamcurrent; return 0; }
//******************************************************
// ******************************************************
// DEBUG ONLY AREA
//******************************************************
// ******************************************************
#ifdef RULEDEBUG
printf("REPLACED (EXACT): ");
WORDPTR string=rplDecompile(*DStkBottom,DECOMP_EDIT|DECOMP_NOHINTS);
@ -4610,9 +4633,9 @@ do {
}
printf("\n"); fflush(stdout);
#endif
//******************************************************
// ******************************************************
// END DEBUG ONLY AREA
//******************************************************
// ******************************************************
// UPDATE ALL POINTERS AS THE EXPRESSION MOVED IN THE STACK
baselevel=DSTop-DStkBottom;
@ -4665,16 +4688,16 @@ do {
// ALL ARGUMENTS ARE DONE, PASS IT TO THE UPPER LEVEL
DSTop=s.left- ( (s.leftnargs)? (1+s.leftnargs):0);
//******************************************************
// ******************************************************
// DEBUG ONLY AREA
//******************************************************
// ******************************************************
#ifdef RULEDEBUG
printf("ARGDONE UP");
printf("\n"); fflush(stdout);
#endif
//******************************************************
// ******************************************************
// END DEBUG ONLY AREA
//******************************************************
// ******************************************************
}
@ -4685,9 +4708,9 @@ do {
case ARGDONEEXTRA:
{
reloadPointers(DSTop,&s);
//******************************************************
// ******************************************************
// DEBUG ONLY AREA
//******************************************************
// ******************************************************
#ifdef RULEDEBUG
printf("ARGDONEEXTRA: %d/%d,%d/%d",s.leftidx,s.leftnargs,s.rightidx,s.rightnargs);
if((s.leftidx>0) && (s.leftidx<=s.leftnargs)) {
@ -4710,9 +4733,9 @@ do {
}
printf("\n"); fflush(stdout);
#endif
//******************************************************
// ******************************************************
// END DEBUG ONLY AREA
//******************************************************
// ******************************************************
// TODO: HANDLE THE CASE OF PARTIAL MATCH
// ALL ARGUMENTS ARE DONE, PASS IT TO THE UPPER LEVEL