txlyre 3 months ago
parent
commit
e7dfd47eee
1 changed files with 83 additions and 85 deletions
  1. 83 85
      jk.c

+ 83 - 85
jk.c

@@ -82,36 +82,24 @@ P mrea(P p,Z size){if(!(p=GC_REALLOC(p,size)))abort();R p;}
 S sdup(S s){S p=GC_strdup(s);
   if(!p)abort();R p;}
 typedef struct{P*data;
-  Z length;
-  Z allocated;}Ar;
+  Z length;}Ar;
 Ar*An(void){Ar*arr=ma(SO(Ar));
   arr->data=N;
-  arr->length=arr->allocated=0;R arr;}
+  arr->length=0;R arr;}
 Ar*Ank(Z k){Ar*arr=ma(SO(Ar));
   arr->data=ma(k*SO(P ));
-  arr->length=k;
-  arr->allocated=k;R arr;}
-Ar*Ana(Z k){Ar*arr=ma(SO(Ar));
-  arr->data=ma(k*SO(P ));
-  arr->length=0;
-  arr->allocated=k;R arr;}
-Ar*Ac(Ar*l){Ar*arr=ma(SO(Ar));
-  arr->data=ma(l->length*SO(P ));
-  arr->length=l->length;
-  arr->allocated=l->length;
+  arr->length=k;R arr;}
+Ar*Ac(Ar*l){Ar*arr=Ank(l->length);
   for(Z i=0;i<l->length;i++)arr->data[i]=l->data[i];R arr;}
 V Ap(Ar*l,P v){Z i=l->length++;
-  if(l->length>l->allocated){l->allocated+=16;
-    l->data=mrea(l->data,l->allocated*SO(P ));}
+  l->data=mrea(l->data,l->length*SO(P ));
   l->data[i]=v;}
 P AP(Ar*l){if(!l->data)R N;
-  P v=l->data[--l->length];
+  Z i=--l->length;
+  P v=l->data[i];
+  l->data[i]=N;
   if(!l->length){FR(l->data);
-    l->data=N;
-    l->allocated=0;}
-  elif(l->allocated-l->length>16){l->allocated=l->length;
-    l->data=mrea(l->data,l->allocated*SO(P ));}
-  R v;}
+    l->data=N;}else l->data=mrea(l->data,l->length*SO(P ));R v;}
 P Ai(Ar*l,SZ index){if(!l->data)R N;
   if(index<0)index+=((SZ)l->length);
   if(index<0||index>=l->length)R N;R l->data[index];}
@@ -453,13 +441,14 @@ S show_array(Vt*v){if(v->tag!=ARRAY)R Vshow(v);
     BappendS(buf,ts);
     FR(ts);R Bread(buf);}
   if(Cap(t)){for(Z i=0;i<t->length;i++)Bappend(buf,((Vt*)t->data[i])->val._char);R Bread(buf);}
-  if(!Aap(t)){for(Z i=0;i<t->length;i++){S ts=Vshow(t->data[i]);
+  if(!Aap(t))for(Z i=0;i<t->length;i++){S ts=Vshow(t->data[i]);
       BappendS(buf,ts);
       FR(ts);
-      if(i!=t->length-1)Bappend(buf,' ');}}else{for(Z i=0;i<t->length;i++){S ts=show_array(t->data[i]);
+      if(i!=t->length-1)Bappend(buf,' ');}
+  else for(Z i=0;i<t->length;i++){S ts=show_array(t->data[i]);
       BappendS(buf,ts);
       FR(ts);
-      if(i!=t->length-1)Bappend(buf,'\n');}}
+      if(i!=t->length-1)Bappend(buf,'\n');}
   R Bread(buf);}
 S Vshow(Vt*v){SW(v->tag){CS ARRAY:R show_array(v);
   CS VERB:R sdup(v->val.verb->name);
@@ -734,8 +723,8 @@ Vt*Swalk(St*st,Nt*node){if(!node)R st->nil;
     Tset(st->env,l->val.symbol,r);}}
   R st->nil;}
 Vt*vconst(St*st,vt*self,Vt*x){vt*nv=vnew();
-  nv->bonds=An();
-  Ap(nv->bonds,x);
+  nv->bonds=Ank(1);
+  nv->bonds->data[0]=x;
   S r=Vshow(x);
   Z l=strlen(r)+2;
   nv->name=ma(l);
@@ -851,10 +840,10 @@ Vt*vodometer(St*st,vt*self,Vt*x){if(xt!=ARRAY)x=venlist(st,N,x);
       if(carry){s[a]++;carry=F;}
       if(s[a]>=lims[a]){s[a]=0;carry=T;}}}
   FR(lims);
-  Ar*r=An();
-  for(Z i=0;i<p;i++){Ar*rw=An();
-    for(Z j=0;j<xl;j++)Ap(rw,Vnn(z[i][j]));
-    Ap(r,Vna(rw));
+  Ar*r=Ank(p);
+  for(Z i=0;i<p;i++){Ar*rw=Ank(xl);
+    for(Z j=0;j<xl;j++)rw->data[j]=Vnn(z[i][j]);
+    r->data[i]=Vna(rw);
     FR(z[i]);}
   FR(z);R Vna(r);}
 Vt*vchunks(St*st,vt*self,Vt*x,Vt*y){if(xt!=NUM)R st->udf;
@@ -873,9 +862,9 @@ I bits_needed(U32 value){I bits=0;
   R bits+value;}
 Vt*vbits(St*st,vt*self,Vt*x){if(xt==NUM){I n=xn;
     I bk=bits_needed(n);
-    Ar*r=Ana(bk);
-    for(I i=0;i<bk;i++)if((n &(1<<i))>>i)Ap(r,NUMS[1]);
-      else Ap(r,NUMS[0]);R Vna(r);}
+    Ar*r=Ank(bk);
+    for(I i=0;i<bk;i++)if((n &(1<<i))>>i)r->data[i]=NUMS[1];
+      else r->data[i]=NUMS[0];R Vna(r);}
   R st->udf;}
 Vt*vreverse(St*st,vt*self,Vt*x);
 Vt*vbase(St*st,vt*self,Vt*x,Vt*y){if(xt==NUM&&yt==NUM){Z v=fabs(yn);
@@ -1129,12 +1118,12 @@ Vt*vcopy(St*st,vt*self,Vt*x,Vt*y){if(xt!=ARRAY)x=venlist(st,N,x);
     for(Z i=0;i<k;i++)Ap(r,a);}
   R Vna(r);}
 Vt*vnub(St*st,vt*self,Vt*x){if(xt!=ARRAY||!xad)R x;
-  Ar*n=An();
+  Ar*n=Ank(xal);
   Ar*r=An();
   for(Z i=0;i<xal;i++){B u=T;
     for(Z j=0;j<r->length;j++)if(Veq(xad[i],r->data[j])){u=F;BR;}
     if(u)Ap(r,xad[i]);
-    Ap(n,u?NUMS[1]:NUMS[0]);}
+    n->data[i]=u?NUMS[1]:NUMS[0];}
   FR(r->data);
   FR(r);R Vna(n);}
 Vt*vdrop(St*st,vt*self,Vt*x,Vt*y){if(xt==NUM){if(yt!=ARRAY){if(xn==0)R y;
@@ -1143,10 +1132,12 @@ Vt*vdrop(St*st,vt*self,Vt*x,Vt*y){if(xt==NUM){if(yt!=ARRAY){if(xn==0)R y;
     if(!yad)R st->unit;
     B rev=xn<0;
     Z k=(Z)fabs(xn);
+    if(k>=yal)R st->unit;
     if(rev){Z l=yal;
       if(k>=l)R st->unit;R vtake(st,N,Vnn(l-k),y);}
-    Ar*r=An();
-    for(Z i=k;i<yal;i++)Ap(r,yad[i]);R Vna(r);}
+    Ar*r=Ank(yal-k);
+    Z rp=0;
+    for(Z i=k;i<yal;i++)r->data[rp++]=yad[i];R Vna(r);}
   R st->udf;}
 Vt*vunique(St*st,vt*self,Vt*x){if(xt!=ARRAY||!xad)R x;
   Ar*r=An();
@@ -1173,8 +1164,9 @@ Vt*vminand(St*st,vt*self,Vt*x,Vt*y){if((xt==NUM||xt==CHAR)&&(yt==NUM||yt==CHAR))
   R _NAN;}
 Vt*vreverse(St*st,vt*self,Vt*x){if(xt!=ARRAY)R x;
   if(xal<2)R x;
-  Ar*r=An();
-  for(SZ i=xal-1;i>=0;i--)Ap(r,xad[i]);R Vna(r);}
+  Ar*r=Ank(xal);
+  Z rp=0;
+  for(SZ i=xal-1;i>=0;i--)r->data[rp++]=xad[i];R Vna(r);}
 Vt*vmaxor(St*st,vt*self,Vt*x,Vt*y){if((xt==NUM||xt==CHAR)&&(yt==NUM||yt==CHAR)){if(Vnum(x)>Vnum(y))R x;R y;}
   R _NAN;}
 Vt*vrotate(St*st,vt*self,Vt*x,Vt*y){if(yt!=ARRAY||yal<2)R x;
@@ -1332,8 +1324,8 @@ Vt*vreshape(St*st,vt*self,Vt*x,Vt*y){if(yt!=ARRAY)y=venlist(st,N,y);
     Z k=fabs(a->val.number);
     Ar*t=An();
     flatten(y,t);
-    r=An();
-    for(Z i=0;i<k;i++)Ap(r,t->data[i>=t->length?t->length-1:i]);}elif(xal>1){Vt*a=xad[0];
+    r=Ank(k);
+    for(Z i=0;i<k;i++)r->data[i]=t->data[i>=t->length?t->length-1:i];}elif(xal>1){Vt*a=xad[0];
     if(a->tag!=NUM)R st->udf;
     Vt*b=xad[1];
     if(a->tag!=NUM)R st->udf;
@@ -1381,12 +1373,15 @@ Vt*vformat(St*st,vt*self,Vt*x,Vt*y){if(yt!=ARRAY)y=venlist(st,N,x);
   S fmt=Vshow(x);
   S s=format(fmt,ya);
   FR(fmt);
-  Ar*r=An();
-  WH(*s)Ap(r,Vnc(*s++));R Vna(r);}
+  Z z=strlen(s);
+  Ar*r=Ank(z);
+  for(Z i=0;i<z;i++)r->data[i]=CHARS[s[i]];R Vna(r);}
 Vt*vinsert(St*st,vt*self,Vt*x,Vt*y){if(yt!=ARRAY)y=venlist(st,N,y);
-  Ar*r=An();
-  for(Z i=0;i<yal;i++){Ap(r,yad[i]);
-    if(i!=yal-1)Ap(r,x);}
+  elif(!yad)R y;
+  Ar*r=Ank(yal*2-1);
+  Z rp=0;
+  for(Z i=0;i<yal;i++){r->data[rp++]=yad[i];
+    if(i!=yal-1)r->data[rp++]=x;}
   R Vna(r);}
 U64 fibonacci(U64 n){U64 a=0;
   U64 b=1;
@@ -1412,17 +1407,18 @@ Vt*vrange(St*st,vt*self,Vt*x,Vt*y){if((xt==NUM||xt==CHAR)&&(yt==NUM||yt==CHAR)){
   R _NAN;}
 Vt*vdeal(St*st,vt*self,Vt*x){if(xt!=ARRAY)R x;
   if(!xad)R st->udf;R xad[rand()%xal];}
-Vt*vroll(St*st,vt*self,Vt*x,Vt*y){if(xt==NUM&&yt==NUM){Ar*r=An();
-    Z k=fabs(xn);
+Vt*vroll(St*st,vt*self,Vt*x,Vt*y){if(xt==NUM&&yt==NUM){Z k=fabs(xn);
     Z d=fabs(yn);
-    for(Z i=0;i<k;i++)Ap(r,Vnn(rand()%d));R Vna(r);}
+    Ar*r=Ank(k);
+    for(Z i=0;i<k;i++)r->data[i]=Vnn(rand()%d);R Vna(r);}
   R st->udf;}
 Vt*vtype(St*st,vt*self,Vt*x){R NUMS[xt];}
 Vt*vcast(St*st,vt*self,Vt*x,Vt*y){if(xt==NUM){I t=fabs(xn);
     if(yt==t)R y;
     SW(t){CS ARRAY:if(yt==SYM){S s=yY;
-        Ar*r=An();
-        WH(*s)Ap(r,Vnc(*s++));R Vna(r);}BR;
+        Z z=strlen(s);
+        Ar*r=Ank(z);
+        for(Z i=0;i<z;i++)r->data[i]=CHARS[s[i]];R Vna(r);}BR;
     CS NUM:if(yt==CHAR)R Vnn(y->val._char);
       elif(yt==ARRAY&&Cap(ya)){Bt*buf=Bnew();
         for(Z i=0;i<yal;i++)Bappend(buf,((Vt*)yad[i])->val._char);
@@ -1446,13 +1442,14 @@ Vt*vread(St*st,vt*self,Vt*x){if(x==NUMS[0]){Bt*buf=Bnew();
       if(c<0)BR;
       Bappend(buf,c);size++;}
     S s=Bread(buf);
-    Ar*r=An();
-    for(Z i=0;i<size;i++)Ap(r,Vnc(s[i]));
+    Ar*r=Ank(size);
+    for(Z i=0;i<size;i++)r->data[i]=CHARS[s[i]];
     FR(s);R Vna(r);}
   elif(x==NUMS[1]){C line[512];
     if(!fgets(line,SO(line),stdin))R st->udf;
-    Ar*r=An();
-    for(Z i=0;i<strlen(line);i++)Ap(r,Vnc(line[i]));R Vna(r);}
+    Z z=strlen(line);
+    Ar*r=Ank(z);
+    for(Z i=0;i<z;i++)r->data[i]=CHARS[line[i]];R Vna(r);}
   S path=Vshow(x);
   FILE*fd=fopen(path,"rb");
   if(!fd){FR(path);R st->udf;}
@@ -1464,8 +1461,8 @@ Vt*vread(St*st,vt*self,Vt*x){if(x==NUMS[0]){Bt*buf=Bnew();
   size=fread(buf,SO(UC),size,fd);
   fclose(fd);
   FR(path);
-  Ar*r=Ana(size);
-  for(Z i=0;i<size;i++)Ap(r,Vnc(buf[i]));
+  Ar*r=Ank(size);
+  for(Z i=0;i<size;i++)r->data[i]=CHARS[buf[i]];
   FR(buf);R Vna(r);}
 Vt*vwrite(St*st,vt*self,Vt*x,Vt*y){FILE*fd;
   S path=N;
@@ -1506,8 +1503,8 @@ Vt*vsystem(St*st,vt*self,Vt*x){S cmd=Vshow(x);
     if(feof(pd))BR;}
   pclose(pd);
   FR(cmd);
-  Ar*r=Ana(Bsize);
-  for(Z i=0;i<Bsize;i++)Ap(r,Vnc(buffer[i]));
+  Ar*r=Ank(Bsize);
+  for(Z i=0;i<Bsize;i++)r->data[i]=CHARS[buffer[i]];
   FR(buffer);R Vna(r);}
 struct files_t{FILE*in;
   FILE*out;};
@@ -1589,8 +1586,8 @@ Vt*vsystem2(St*st,vt*self,Vt*x,Vt*y){S cmd=Vshow(y);
     if(feof(pd->out))BR;}
   pclose2(pd);
   FR(cmd);
-  Ar*r=Ana(Bsize);
-  for(Z i=0;i<Bsize;i++)Ap(r,Vnc(buffer[i]));
+  Ar*r=Ank(Bsize);
+  for(Z i=0;i<Bsize;i++)r->data[i]=CHARS[buffer[i]];
   FR(buffer);R Vna(r);}
 Vt*vshl(St*st,vt*self,Vt*x,Vt*y){if(xt==NUM&&yt==NUM)R Vnn(((int)xn)<<((int)yn));R _NAN;}
 Vt*vshr(St*st,vt*self,Vt*x,Vt*y){if(xt==NUM&&yt==NUM)R Vnn(((int)xn)>>((int)yn));R _NAN;}
@@ -1615,13 +1612,12 @@ Vt*vparts(St*st,vt*self,Vt*x,Vt*y){if(xt!=NUM)R st->udf;
   elif(!yad)R y;
   if(spnp(xn)||xn<1)R y;
   Z np=fabs(xn);
-  Ar*r=Ana(np);
-  Z l=yal;
-  Z k=ceil(((D)l)/(D)np);
-  WH(yt==ARRAY&&yad){if(yal<=k){Ap(r,y);BR;}
-    Ap(r,vtake(st,N,Vnn(k),y));
+  Ar*r=Ank(np);
+  Z rp=0;
+  for(SZ i=np;i>0;i--){Z k=ceil(((D)yal)/(D)i);
+    r->data[rp++]=vtake(st,N,Vnn(k),y);
     y=vdrop(st,N,Vnn(k),y);}
-  WH(r->length<np)Ap(r,st->unit);R Vna(r);}
+  R Vna(r);}
 Vt*vbor(St*st,vt*self,Vt*x,Vt*y){if(xt==NUM&&yt==NUM)R Vnn(((int)xn)|((int)yn));R _NAN;}
 Vt*vbnot(St*st,vt*self,Vt*x){if(xt==NUM)R Vnn(~(int)xn);R _NAN;}
 Ar*prime_factors(D n){Ar*factors=An();
@@ -1692,10 +1688,10 @@ Vt*vtackright(St*st,vt*self,Vt*x,Vt*y){if(yt!=ARRAY)y=venlist(st,N,y);
   for(Z i=0;i<yal;i++)r->data[i]=yad[i];
   r->data[yal]=x;R Vna(r);}
 Vt*veye(St*st,vt*self,Vt*x){if(xt==NUM&&!spnp(xn)){Z k=fabs(xn);
-    Ar*r=Ana(k);
-    for(Z i=0;i<k;i++){Ar*rw=Ana(k);
-      for(Z j=0;j<k;j++)Ap(rw,NUMS[i==j]);
-      Ap(r,Vna(rw));}
+    Ar*r=Ank(k);
+    for(Z i=0;i<k;i++){Ar*rw=Ank(k);
+      for(Z j=0;j<k;j++)rw->data[j]=NUMS[i==j];
+      r->data[i]=Vna(rw);}
     R Vna(r);}
   R st->udf;}
 Vt*vudf1(St*st,vt*self,Vt*x){R st->udf;}
@@ -1855,8 +1851,8 @@ Vt*_advinverse_d(St*st,vt*self,Vt*x,Vt*y){Vt*_v=self->bonds->data[0];
 #define ADVERB(__name,__symb)\
   vt*adv##__name(St*st,Vt*v){\
     vt*nv=vnew();\
-    nv->bonds=An();\
-    Ap(nv->bonds,v);\
+    nv->bonds=Ank(1);\
+    nv->bonds->data[0]=v;\
     S r=Vshow(v);\
     Z l=strlen(r)+strlen(__symb)+1;\
     nv->name=ma(l);\
@@ -1962,9 +1958,9 @@ Vt*_cnjunder_d(St*st,vt*self,Vt*x,Vt*y){Vt*v1=self->bonds->data[0];
 #define CONJUNCTION(__name,__symb)\
   vt*cnj##__name(St*st,Vt*x,Vt*y){\
     vt*nv=vnew();\
-    nv->bonds=An();\
-    Ap(nv->bonds,x);\
-    Ap(nv->bonds,y);\
+    nv->bonds=Ank(2);\
+    nv->bonds->data[0]=x;\
+    nv->bonds->data[1]=y;\
     S rx=Vshow(x);\
     S ry=Vshow(y);\
     Z l=strlen(rx)+strlen(ry)+strlen(__symb)+1;\
@@ -2034,9 +2030,9 @@ Nt*PPverb(Pt*parser){Tkt*tok=Plook(parser,0);
   vt*verb=Gv(tok->text);
   if(!verb)R N;R Nnl(Vnv(verb));}
 Vt*_advwrapper_m(St*st,vt*self,Vt*x){advt*av=self->bonds->data[0];
-  if(xt!=VERB)R st->nil;R Vnv(av->adverb(st,x));}
+  if(xt!=VERB)R st->udf;R Vnv(av->adverb(st,x));}
 Vt*_advwrapper_d(St*st,vt*self,Vt*x,Vt*y){advt*av=self->bonds->data[0];
-  if(xt!=VERB)R st->nil;
+  if(xt!=VERB)R st->udf;
   vt*v=av->adverb(st,x);R eR(st,v,y,0,v->rank[0]);}
 Nt*PPadvatom(Pt*parser){Tkt*tok=Plook(parser,0);
   if(!tok||tok->tag!=T_PUNCT)R N;
@@ -2044,8 +2040,8 @@ Nt*PPadvatom(Pt*parser){Tkt*tok=Plook(parser,0);
   if(!adverb)R N;
   vt*nv=vnew();
   nv->name=sdup(tok->text);
-  nv->bonds=An();
-  Ap(nv->bonds,adverb);
+  nv->bonds=Ank(1);
+  nv->bonds->data[0]=adverb;
   nv->rank[0]=0;
   nv->rank[1]=0;
   nv->rank[2]=0;
@@ -2058,8 +2054,8 @@ Nt*PPcnjatom(Pt*parser){Tkt*tok=Plook(parser,0);
   if(!adverb)R N;
   vt*nv=vnew();
   nv->name=sdup(tok->text);
-  nv->bonds=An();
-  Ap(nv->bonds,adverb);
+  nv->bonds=Ank(1);
+  nv->bonds->data[0]=adverb;
   nv->rank[0]=0;
   nv->rank[1]=0;
   nv->rank[2]=0;
@@ -2082,9 +2078,10 @@ Nt*PPatom(Pt*parser){Tkt*tok=Plook(parser,0);
   CS T_NAME:node=Nnl(Vny(sdup(tok->text)));BR;
   CS T_QUOTE:if(!*tok->text)node=Nnl(parser->st->unit);
     elif(!*(tok->text+1))node=Nnl(Vnc(tok->text[0]));
-    else{Ar*arr=An();
-      for(Z i=0;i<strlen(tok->text);i++)Ap(arr,Vnc(tok->text[i]));
-      node=Nnl(Vna(arr));}BR;}
+    else{Z z=strlen(tok->text);
+      Ar*r=Ank(z);
+      for(Z i=0;i<z;i++)r->data[i]=CHARS[tok->text[i]];
+      node=Nnl(Vna(r));}BR;}
   if(!node)Perror(parser,"parse");
   Peat(parser);R node;}
 Nt*PPa(Pt*parser,Nt*a,enum Tkt tag){Tkt*tok;
@@ -2208,6 +2205,7 @@ Vt*Srun(St*st,S program){Lt*lexer=Lnew();
 cS VHELP =\
 ":  monadic const         create a function that always yields x" "\n"\
 ":  dyadic  bind          bind y to symbol x" "\n"\
+":: monadic unbind        unbind symbol x" "\n"\
 ":: dyadic  obverse       insert inverse for x" "\n"\
 "+  monadic flip          transpose matrix" "\n"\
 "+  dyadic  plus          add numbers" "\n"\