Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

121 lines (108 sloc) 4.149 kb
#include "incs.h"
#include "scalar.h"
#include "k.h"
#include "km.h"
#include "ko.h"
#include "vc.h"
/* comparison verbs */
Z K lessmore(K a,K b,I x);
K dp(K*z,K(*f)(K,K),K x,K y) //dyad promote
{
x=promote(x); y=promote(y);
M(x,y,*z)
DO((*z)->n, if(!(kK(*z)[i]=f(kK(x)[i%xn],kK(y)[i%y->n]))){cd(*z);*z=ME;break;}) //TODO: optimization: remove these modulo % operations
cd(x);cd(y);
R 0;
}
K equals(K a, K b)
{
I at=a->t, an=a->n, bt=b->t, bn=b->n;
if(at <=0 && bt <= 0 && an != bn) R LE;
I AT=ABS(at), BT=ABS(bt);
if(4<AT || 4<BT) R TE;//(this catches it before descending)
//Type Error - No 0-list, Not both numeric, or both char, or both sym
if(at && bt && !(2>=AT && 2>=BT) && !(3==AT && 3==BT) && !(4==AT && 4==BT) ) R TE;
I t= (!at||!bt)?0:MIN(at,bt)<0?-1:1;//Any 0-list? Zero. Any vector? -1. Both atoms? 1.
I zn=at>0?bn:an;
K z=newK(t,zn); //oom
#define EQ(x, y) (x) == (y)
if (2==AT && 2==BT) SCALAR_EXPR_FUN(FC, kI(z), kF(a), kF(b), ?0:1)
else if(2==AT && 1==BT) SCALAR_EXPR_FUN(FC, kI(z), kF(a), kI(b), ?0:1)
else if(1==AT && 2==BT) SCALAR_EXPR_FUN(FC, kI(z), kI(a), kF(b), ?0:1)
else if(1==AT && 1==BT) SCALAR_OP_CASE(EQ, kI(z), kI(a), kI(b))
else if(3==AT && 3==BT) SCALAR_OP_CASE(EQ, kI(z), kC(a), kC(b))
else if(4==AT && 4==BT) SCALAR_OP_CASE(EQ, kI(z), kS(a), kS(b)) //works because of interning
else if(0==at || 0==bt) dp(&z,equals,a,b);
#undef EQ
R z;
}
I matchI(K a, K b)
{
if(!a||!b)R 0;//Using this in over adverb type stuff
I at=a->t, an=a->n, bt=b->t, bn=b->n;
I AT=ABS(at), BT=ABS(bt);
K *c,*d;
//if(an!=bn || (at!=bt && !(1==AT && 2==BT) && !(2==AT && 1==BT)))R 0; // 0 ~ 1.0 ~ 1
if(an!=bn || at!=bt) R 0;
if(4==AT)DO(an, if(kS(a)[i]!=kS(b)[i]) R 0 )
if(3==AT)DO(an, if(kC(a)[i]!=kC(b)[i]) R 0 )
if(2==AT && 2==BT)DO(an, if(FC(kF(a)[i],kF(b)[i])) R 0 )
//if(2==AT && 1==BT)DO(an, if(FC(kF(a)[i],kI(b)[i])) R 0 )
//if(1==AT && 2==BT)DO(an, if(FC(kI(a)[i],kF(b)[i])) R 0 )
if(1==AT && 1==BT)DO(an, if(kI(a)[i]!=kI(b)[i]) R 0 )
if(0==AT || 5==AT)DO(an, if(!matchI(kK(a)[i],kK(b)[i]))R 0)//Dictionary keys are ordered sets
if(7==AT)
{
if(a->n!=b->n) R 0;
switch(a->n)
{
CS(1,
an=kVC(a)->n-1;
bn=kVC(b)->n-1;
if(an!=bn) R 0;
DO(an, c=kW(a)[i];d=kW(b)[i]; if(VA(c)||VA(d)){if(c!=d) R 0;} else if(!matchI(*c,*d)) R 0) //TODO: Projection (up above?)
)
CS(2, )//TODO
CS(3, if(kV(a)[CONTEXT] != kV(b)[CONTEXT])R 0; R matchI(kV(a)[CODE],kV(b)[CODE])) //TODO: Projection (up above?)
}
}
R 1;
}
K match(K a, K b){R Ki(matchI(a,b));}
Z K lessmore(K a, K b, I x)
{
if (!x){K c=a;a=b;b=c; } //NB: If primitives modify a but not b (or vice-versa. e.g. reuse of refcount 1 objects)
//this should be reviewed. in q it can effect dicts (borror). see backup for unfactored ver.
I at=a->t, an=a->n, bt=b->t, bn=b->n;
if(at <=0 && bt <= 0 && an != bn) R LE;
I AT=ABS(at), BT=ABS(bt);
if(4<AT || 4<BT) R TE;//also Type Error (this catches it before descending)
// Type Error - No 0-list, Not both numeric, or both char, or both sym
if(at && bt && !(2>=AT && 2>=BT) && !(3==AT && 3==BT) && !(4==AT && 4==BT) ) R TE;
I t= (!at||!bt)?0:MIN(at,bt)<0?-1:1;//Any 0-list? Zero. Any vector? -1. Both atoms? 1.
I zn=at>0?bn:an;
K z=newK(t,zn);
U(z)
I*h=kI(z);
if(0==at || 0==bt)
{
a=promote(a); b=promote(b); //copy-pasted from dp()
M(a,b,z);
DO(zn, if(!(kK(z)[i]=lessmore(kK(a)[i%an],kK(b)[i%b->n],x))){cd(z);z=ME;break;})
cd(a);cd(b);
}
else
{
#define GT(x, y) (x) > (y)
if (2==AT && 2==BT) SCALAR_EXPR_FUN(FC, h, kF(a), kF(b), >0)
else if(2==AT && 1==BT) SCALAR_EXPR_FUN(FC, h, kF(a), kI(b), >0)
else if(1==AT && 2==BT) SCALAR_EXPR_FUN(FC, h, kI(a), kF(b), >0)
else if(1==AT && 1==BT) SCALAR_OP_CASE(GT, kI(z), kI(a), kI(b))
else if(3==AT && 3==BT) SCALAR_OP_CASE(GT, kI(z), kC(a), kC(b))
else if(4==AT && 4==BT) SCALAR_EXPR_FUN(SC, h, kS(a), kS(b), >0)
#undef GT
}
R z;
}
K less(K a, K b){R lessmore(a,b,0);}
K more(K a, K b){R lessmore(a,b,1);}
Jump to Line
Something went wrong with that request. Please try again.