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 TRN and TRAN. Enabled absolute and relative paths in STO and RCL.

Browse source
This commit is contained in:
claudiol 2017-10-27 17:07:20 -04:00
parent 94a9e13f84
commit 06710e508f
6 changed files with 323 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

50
newrpl/directory.c
View file

@ -871,3 +871,53 @@ BINT rplIsVarEmptyDir(WORDPTR *var)
}
return 0;
}
// RETURNS A POINTER TO THE START OF A DIRECTORY
// FROM A LIST OF DIRECTORIES IN A PATH
// uselastname=0 --> DISREGARD THE LAST NAME (ASSUME IT'S A VARIABLE)
// uselastname=1 --> THE ENTIRE LIST IS A PATH
// RETURN NULL IF ANY DIRECTORY IS NOT FOUND
// PATH CAN BE ABSOLUTE OR RELATIVE TO CurrentDir
// LIST MAY CONTAIN HOME AND UPDIR
WORDPTR *rplFindDirFromPath(WORDPTR pathlist,BINT uselastname)
{
WORDPTR ident, last;
if(!ISLIST(*pathlist)) return CurrentDir;
WORDPTR *dir=CurrentDir;
last=rplSkipOb(pathlist)-1; // POINT TO CMD_ENDLIST
if(!uselastname) {
ident=pathlist+1;
while(rplSkipOb(ident)<last) ident=rplSkipOb(ident);
last=ident; // HERE IDENT POINTS TO THE LAST OBJECT IN THE LIST
}
ident=pathlist+1;
while(ident<last) {
if(*ident==CMD_HOME) dir=Directories;
else if(*ident==CMD_UPDIR) dir=rplGetParentDir(dir);
else if(ISIDENT(*ident)) {
dir=rplFindGlobalInDir(ident,dir,0);
if(dir) {
if(!ISDIR(*dir[1])) { dir=0; }
else dir=rplFindDirbyHandle(dir[1]);
}
}
else dir=0;
if(!dir) {
rplError(ERR_DIRECTORYNOTFOUND);
return 0;
}
ident=rplSkipOb(ident);
}
return dir;
}

113
newrpl/lib-28-dirs.c
View file

@ -168,20 +168,43 @@ void LIB_HANDLER()
rplError(ERR_BADARGCOUNT);
return;
}
// ONLY ACCEPT IDENTS AS KEYS
WORDPTR *indir=0;
// LIST IS A PATH, ONLY ENABLE PARALLEL PROCESSING FOR LISTS OF LISTS
if(ISLIST(*rplPeekData(1)))
{
rplListBinaryDoCmd();
return;
WORDPTR firstelem=rplPeekData(1)+1;
if(!ISLIST(*firstelem)) {
rplListBinaryDoCmd();
return;
}
// LIST OF LIST, TREAT LIKE A PATH
indir=rplFindDirFromPath(rplPeekData(1)+1,0);
if(!indir) {
rplError(ERR_DIRECTORYNOTFOUND);
return;
}
}
if(!indir) {
if(!ISIDENT(*rplPeekData(1))) {
rplError(ERR_IDENTEXPECTED);
return;
}
}
else {
if(!ISIDENT(*rplGetListElement(rplPeekData(1)+1,rplListLength(rplPeekData(1)+1)))) {
rplError(ERR_IDENTEXPECTED);
return;
}
WORDPTR *val=rplFindLAM(rplPeekData(1),1);
}
WORDPTR *val;
if(!indir) val=rplFindLAM(rplPeekData(1),1);
else val=0;
@ -199,7 +222,10 @@ void LIB_HANDLER()
}
else {
// LAM WAS NOT FOUND, TRY A GLOBAL
val=rplFindGlobal(rplPeekData(1),0);
if(indir) {
val=rplFindGlobalInDir(rplGetListElement(rplPeekData(1)+1,rplListLength(rplPeekData(1)+1)),indir,0);
}
else val=rplFindGlobal(rplPeekData(1),0);
if(val) {
if(ISDIR(*val[1])) {
rplError(ERR_CANTOVERWRITEDIR);
@ -223,13 +249,29 @@ void LIB_HANDLER()
*(val+1)=*(newdir+1); // AND NEW HANDLE
}
else {
// NOT FOUND, CREATE A NEW VARIABLE
if(!indir) {
*(newdir+3)=*(CurrentDir+1);
WORDPTR name=rplMakeIdentQuoted(rplPeekData(1));
if(!name) return;
rplCreateGlobal(name,*(newdir+1));
}
else {
// SET PARENT DIR
*(newdir+3)=*(indir+1);
WORDPTR name=rplMakeIdentQuoted(rplGetListElement(rplPeekData(1)+1,rplListLength(rplPeekData(1)+1)));
if(!name) return;
rplCreateGlobalInDir(name,*(newdir+1),indir);
}
}
rplDropData(2);
return;
}
else return;
}
else {
rplError(ERR_DIRECTORYNOTFOUND);
return;
}
}
@ -240,8 +282,16 @@ void LIB_HANDLER()
}
else {
// CREATE A NEW GLOBAL VARIABLE
if(!indir) {
WORDPTR name=rplMakeIdentQuoted(rplPeekData(1));
if(!name) return;
rplCreateGlobal(name,rplPeekData(2));
}
else {
WORDPTR name=rplMakeIdentQuoted(rplGetListElement(rplPeekData(1)+1,rplListLength(rplPeekData(1)+1)));
if(!name) return;
rplCreateGlobalInDir(name,rplPeekData(2),indir);
}
}
rplDropData(2);
}
@ -256,21 +306,60 @@ void LIB_HANDLER()
rplError(ERR_BADARGCOUNT);
return;
}
// ONLY ACCEPT IDENTS AS KEYS (ONLY LOW-LEVEL VERSION CAN USE ARBITRARY OBJECTS)
if(!ISIDENT(*rplPeekData(1))) {
rplError(ERR_IDENTEXPECTED);
return;
WORDPTR *indir=0;
// LIST IS A PATH, ONLY ENABLE PARALLEL PROCESSING FOR LISTS OF LISTS
if(ISLIST(*rplPeekData(1)))
{
WORDPTR firstelem=rplPeekData(1)+1;
if(!ISLIST(*firstelem)) {
rplListUnaryDoCmd();
return;
}
// NOT A LIST, SO IT MUST BE A PATH
indir=rplFindDirFromPath(rplPeekData(1)+1,0);
if(!indir) {
rplError(ERR_DIRECTORYNOTFOUND);
return;
}
}
WORDPTR val=rplGetLAM(rplPeekData(1));
if(!indir) {
if(!ISIDENT(*rplPeekData(1))) {
rplError(ERR_IDENTEXPECTED);
return;
}
}
else {
if(!ISIDENT(*rplGetListElement(rplPeekData(1)+1,rplListLength(rplPeekData(1)+1)))) {
rplError(ERR_IDENTEXPECTED);
return;
}
}
WORDPTR val;
if(!indir) val=rplGetLAM(rplPeekData(1));
else val=0;
if(val) {
rplOverwriteData(1,val);
}
else {
if(!indir) {
// NO LAM, TRY A GLOBAL
val=rplGetGlobal(rplPeekData(1));
}
else {
WORDPTR *var=rplFindGlobalInDir(rplGetListElement(rplPeekData(1)+1,rplListLength(rplPeekData(1)+1)),indir,0);
if(var) val=var[1];
else val=0;
}
if(val) {
rplOverwriteData(1,val);
}

30
newrpl/lib-30-complex.c
View file

@ -6401,10 +6401,18 @@ void LIB_HANDLER()
return;
}
if(ISLIST(*rplPeekData(1))) {
rplListUnaryDoCmd();
return;
}
if( ISSYMBOLIC(*rplPeekData(1)) || ISIDENT(*rplPeekData(1))) {
// ARGUMENT IS SYMBOLIC, APPLY THE OPERATOR
rplSymbApplyOperator(CurOpcode,1);
return;
}
if(!ISNUMBERCPLX(*rplPeekData(1))) {
rplError(ERR_COMPLEXORREALEXPECTED);
return;
@ -6453,6 +6461,12 @@ void LIB_HANDLER()
return;
}
if( ISSYMBOLIC(*rplPeekData(1)) || ISIDENT(*rplPeekData(1))) {
// ARGUMENT IS SYMBOLIC, APPLY THE OPERATOR
rplSymbApplyOperator(CurOpcode,1);
return;
}
if(!ISNUMBERCPLX(*rplPeekData(1))) {
rplError(ERR_COMPLEXORREALEXPECTED);
return;
@ -6504,6 +6518,11 @@ void LIB_HANDLER()
return;
}
if( ISSYMBOLIC(*rplPeekData(1)) || ISIDENT(*rplPeekData(1))) {
// ARGUMENT IS SYMBOLIC, APPLY THE OPERATOR
rplSymbApplyOperator(CurOpcode,1);
return;
}
if(!ISNUMBERCPLX(*rplPeekData(1))) {
rplError(ERR_COMPLEXORREALEXPECTED);
@ -6593,6 +6612,17 @@ void LIB_HANDLER()
return;
}
if( ISSYMBOLIC(*rplPeekData(1)) || ISIDENT(*rplPeekData(1))) {
// ARGUMENT IS SYMBOLIC, APPLY THE OPERATOR
rplSymbApplyOperator(CurOpcode,1);
return;
}
if(ISMATRIX(*rplPeekData(1))) {
rplMatrixConj();
return;
}
if(!ISNUMBERCPLX(*rplPeekData(1))) {
rplError(ERR_COMPLEXORREALEXPECTED);
return;

136
newrpl/lib-52-matrix.c
View file

@ -4373,12 +4373,144 @@ void LIB_HANDLER()
}
case TRAN:
{
// TODO:
// MATRIX TRANSPOSE
if(rplDepthData()<1) {
rplError(ERR_BADARGCOUNT);
return;
}
BINT64 rows,cols;
WORDPTR *var=0;
if(ISIDENT(*rplPeekData(1))) {
var=rplFindLAM(rplPeekData(1),1);
if(!var) var=rplFindGlobal(rplPeekData(1),1);
if(!var) {
rplError(ERR_UNDEFINEDVARIABLE);
return;
}
++var;
if(!ISMATRIX(**var)) {
rplError(ERR_INVALIDDIMENSION);
return;
}
}
else var=DSTop-1;
if(ISMATRIX(**var)) {
rows=rplMatrixRows(*var);
cols=rplMatrixCols(*var);
}
else {
rplError(ERR_MATRIXEXPECTED);
return;
}
if(rows==0) return; // VECTORS DON'T NEED TO BE TRANSPOSED, BUT NO NEED TO ERROR ON THAT
rplMatrixTranspose();
return;
}
case TRN:
{
// TODO:
// COMPLEX CONJUGATE
if(rplDepthData()<1) {
rplError(ERR_BADARGCOUNT);
return;
}
BINT64 rows,cols;
WORDPTR *var=0;
if(ISIDENT(*rplPeekData(1))) {
var=rplFindLAM(rplPeekData(1),1);
if(!var) var=rplFindGlobal(rplPeekData(1),1);
if(!var) {
rplError(ERR_UNDEFINEDVARIABLE);
return;
}
++var;
if(!ISMATRIX(**var)) {
rplError(ERR_INVALIDDIMENSION);
return;
}
}
else var=DSTop-1;
if(ISMATRIX(**var)) {
rows=rplMatrixRows(*var);
cols=rplMatrixCols(*var);
}
else {
rplError(ERR_MATRIXEXPECTED);
return;
}
if(rows==0) {
// VECTORS DON'T NEED TO BE TRANSPOSED, JUST DO THE COMPLEX CONJUGATE
rplMatrixConj();
return;
}
if( (rows<1)||(rows>65535)||(cols<1)||(cols>65535)) {
rplError(ERR_INVALIDDIMENSION);
return;
}
// DO IT MANUALLY INSTEAD OF USING rplMatrixTranspose() and rplMatrixConj()
// TO AVOID DOUBLE rplMatrixCompose() OVERHEAD
WORDPTR *savestk=DSTop;
WORDPTR *a=DSTop;
rplPushData(*var);
// TRANSPOSE IS DONE DURING EXPLODE
rplMatrixExplodeByCols();
if(Exceptions) { DSTop=savestk; return; }
BINT i,j;
// CONVENIENCE MACRO TO ACCESS ELEMENTS DIRECTLY ON THE STACK
// a IS POINTING TO THE MATRIX, THE FIRST ELEMENT IS a[1]
#define STACKELEM(r,c) a[((r)-1)*rows+(c)]
// NOW DO THE COMPLEX CONJUGATE
for(i=1;i<=cols;++i)
{
for(j=1;j<=rows;++j) {
rplPushData(STACKELEM(i,j));
if(Exceptions) { DSTop=savestk; return; }
rplCallOperator(CMD_CONJ);
if(Exceptions) { DSTop=savestk; return; }
if(ISSYMBOLIC(*rplPeekData(1))) {
rplSymbAutoSimplify();
if(Exceptions) { DSTop=savestk; return; }
}
STACKELEM(i,j)=rplPopData();
}
}
#undef STACKELEM
WORDPTR newmat=rplMatrixCompose(cols,rows);
DSTop=savestk;
if(newmat) {
*var=newmat;
if(var!=DSTop-1) rplDropData(1);
}
return;
}
case VANDERMONDE:

8
newrpl/matrix.c
View file

@ -308,7 +308,7 @@ BINT j;
for(j=0;j<totalelements;++j) {
rplPushData(GETELEMENT(*a,j));
rplPushData(GETELEMENT(*b,j));
rplCallOvrOperator(Opcode);
rplCallOperator(Opcode);
if(Exceptions) {
DSTop=Savestk;
return;
@ -462,7 +462,7 @@ BINT j;
for(j=0;j<totalelements;++j) {
rplPushData(GETELEMENT(*a,j));
rplCallOvrOperator(Opcode);
rplCallOperator(Opcode);
if(Exceptions) {
DSTop=Savestk;
return;
@ -490,6 +490,10 @@ void rplMatrixNeg()
rplMatrixUnary((CMD_OVR_NEG));
}
void rplMatrixConj()
{
rplMatrixUnary((CMD_CONJ));
}

2
newrpl/newrpl.h
View file

@ -456,6 +456,7 @@ void rplCreateGlobalInDir(WORDPTR nameobj,WORDPTR value,WORDPTR *parentdir);
void rplCreateGlobal(WORDPTR nameobj,WORDPTR value);
void rplPurgeGlobal(WORDPTR nameobj);
WORDPTR *rplFindDirbyHandle(WORDPTR handle);
WORDPTR *rplFindDirFromPath(WORDPTR pathlist,BINT uselastname);
WORDPTR rplCreateNewDir(WORDPTR nameobj, WORDPTR *parentdir);
void rplPurgeDir(WORDPTR nameobj);
WORDPTR *rplGetParentDir(WORDPTR *directory);
@ -700,6 +701,7 @@ WORDPTR *rplMatrixFastGetEx(WORDPTR *first,BINT cols,BINT i,BINT j);
WORDPTR *rplMatrixNewEx(BINT rows,BINT cols);
void rplMatrixNorm();
void rplMatrixNeg();
void rplMatrixConj();
void rplMatrixEval1();
void rplMatrixEval();
void rplMatrixToNum();