/* jk intepreter, by @txlyre,www:txlyre.website, in the public domain */ #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #define VER "0.1alep" #define R return #define BR break #define CN continue #define WH while #define SW switch #define CS case #define T true #define F false #define N NULL #define LOOP for(;;) #define elif else if #define FR(p) GC_FREE(p) #define xt ((x)->tag) #define yt ((y)->tag) #define xa ((x)->val.array) #define ya ((y)->val.array) #define xad ((x)->val.array->data) #define yad ((y)->val.array->data) #define xal ((x)->val.array->length) #define yal ((y)->val.array->length) #define xn ((x)->val.number) #define yn ((y)->val.number) #define vn ((v)->val.number) #define xV ((x)->val.verb) #define yV ((y)->val.verb) #define xY ((x)->val.symbol) #define yY ((y)->val.symbol) #define Vnc(c) (CHARS[(unsigned char)(c)]) typedef uint32_t U32; typedef uint64_t U64; typedef double D; typedef unsigned char UC; typedef char C; typedef char *S; typedef ssize_t SZ; typedef size_t Z; typedef bool B; typedef unsigned int UI; typedef int I; typedef void *P; typedef void V; typedef const char *cS; typedef const void *cP; #define SO(t) (sizeof(t)) #define AE(x)(SO(x)/SO((x)[0])) #define ROTL32(x, r) ((x << r) | (x >> (32 - r))) #define FMIX32(h) \ h ^= h >> 16; \ h *= 0x85ebca6b; \ h ^= h >> 13; \ h *= 0xc2b2ae35; \ h ^= h >> 16; #define TABLE_MIN_SIZE 32 #define CV(s) (Srun(st,s)->val.verb) jmp_buf Icp; B Iin; P ma(Z size){P p; if(!(p=GC_MALLOC(size)))abort();R p;} P maa(Z size){P p; if(!(p=GC_malloc_atomic(size)))abort(); memset(p,0,size);R p;} P mau(Z size){P p; if(!(p=GC_malloc_uncollectable(size)))abort(); memset(p,0,size);R p;} 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;}Ar; Ar*An(void){Ar*arr=ma(SO(Ar)); arr->data=N; arr->length=0;R arr;} Ar*Ank(Z k){Ar*arr=ma(SO(Ar)); arr->data=ma(k*SO(P )); arr->length=k;R arr;} Ar*Ac(Ar*l){Ar*arr=Ank(l->length); for(Z i=0;ilength;i++)arr->data[i]=l->data[i];R arr;} V Ap(Ar*l,P v){Z i=l->length++; l->data=mrea(l->data,l->length*SO(P )); l->data[i]=v;} P AP(Ar*l){if(!l->data)R N; Z i=--l->length; P v=l->data[i]; l->data[i]=N; if(!l->length){FR(l->data); 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];} V As(Ar*l,SZ index,P v){if(!l->data)R; if(index<0)index+=((SZ)l->length); if(index<0||index>=l->length)R; l->data[index]=v;} typedef struct{S str; Z used; Z allocated;}Bt; Bt*Bnew(void){Bt*buf=ma(SO(Bt)); buf->str=N; buf->used=buf->allocated=0;R buf;} V Bappend(Bt*buf,C c){buf->used++; if(buf->used>buf->allocated){buf->allocated++; buf->str=mrea(buf->str,SO(char)*buf->allocated);} buf->str[buf->used-1]=c;} S Bread(Bt*buf){if(buf->used==0||buf->str[buf->used-1])Bappend(buf,0); S str=buf->str; FR(buf);R str;} V BappendS(Bt*buf,S s){WH(*s)Bappend(buf,*s++);} typedef struct{enum Tkt{T_PUNCT,T_LPAR,T_RPAR,T_NAME,T_NUM,T_BNUM,T_QUOTE}tag; S text;}Tkt; typedef struct{S source; Z len; Z pos; Ar*tokens;}Lt; Lt*Lnew(void){Lt*lexer=ma(SO(Lt));R lexer;} C Llook(Lt*lexer,Z offset){Z pos=lexer->pos+offset; if(pos>=lexer->len)R 0;R lexer->source[pos];} C Leat(Lt*lexer){if(lexer->pos>=lexer->len)R 0;R lexer->source[lexer->pos++];} V LpT(Lt*lexer,enum Tkt tag,S text){Tkt*token=ma(SO(Tkt)); token->tag=tag; token->text=text; Ap(lexer->tokens,token);} Ar*guards; jmp_buf*guard(){jmp_buf*lb=maa(SO(jmp_buf)); Ap(guards,lb);R lb;} jmp_buf*guarding(){R Ai(guards,-1);} V unguard(){jmp_buf*lb=AP(guards); FR(lb);} V fatal(S s){jmp_buf*lb; if((lb=guarding()))longjmp(*lb,1); fprintf(stderr,"|%s error\n",s); if(Iin)longjmp(Icp,1); exit(1);} V Lerror(Lt*lexer,S s){fatal(s);} V Llnum(Lt*lexer,B is_negative){Bt*buf=Bnew(); if(is_negative)Bappend(buf,'-'); if(Llook(lexer,0)=='.'){Bappend(buf,Leat(lexer)); if(!(isdigit(Llook(lexer,0))))Lerror(lexer,"trailing-dot");} do{Bappend(buf,Leat(lexer)); if(Llook(lexer,0)=='`'&&isdigit(Llook(lexer,1)))Leat(lexer);}WH(isdigit(Llook(lexer,0))); if(Llook(lexer,0)=='.'){Bappend(buf,Leat(lexer)); if(!(isdigit(Llook(lexer,0))))Lerror(lexer,"trailing-dot"); do{Bappend(buf,Leat(lexer));}WH(isdigit(Llook(lexer,0)));} LpT(lexer,T_NUM,Bread(buf));} V Llex(Lt*lexer,S s){lexer->source=s; lexer->len=strlen(s); lexer->pos=0; lexer->tokens=An(); WH(lexer->poslen){C c=Llook(lexer,0); if(c=='/'&&!lexer->tokens->data)BR; if(isspace(c)){Leat(lexer); if(Llook(lexer,0)=='/')BR;}elif(c=='0'&&(Llook(lexer,1)=='x'||Llook(lexer,1)=='b'||Llook(lexer,1)=='o')){Leat(lexer); Bt*buf=Bnew(); C b=Leat(lexer); Bappend(buf,b); cS base=b=='x'?"0123456789abcdefABCDEF":b=='b'?"01":"01234567"; WH(strchr(base,Llook(lexer,0))!=N)Bappend(buf,Leat(lexer)); LpT(lexer,T_BNUM,Bread(buf));}elif(isdigit(c)||c=='.'){Llnum(lexer,F);}elif(isalpha(c)){Bt*buf=Bnew(); do{Bappend(buf,Leat(lexer));}WH(isalpha(Llook(lexer,0))); if(buf->used==1&&Llook(lexer,0)=='.'){Bappend(buf,Leat(lexer)); LpT(lexer,T_PUNCT,Bread(buf));}else LpT(lexer,T_NAME,Bread(buf));}elif(c=='('||c==')'){Leat(lexer); LpT(lexer,c=='('?T_LPAR:T_RPAR,N);}elif(c=='\''){Bt*buf=Bnew(); Leat(lexer); LOOP{if(lexer->pos>=lexer->len)Lerror(lexer,"unmatched-quote"); if(Llook(lexer,0)=='\''){if(Llook(lexer,1)=='\''){Bappend(buf,Leat(lexer)); Leat(lexer);CN;} Leat(lexer);BR;} Bappend(buf,Leat(lexer));} LpT(lexer,T_QUOTE,Bread(buf));}elif(ispunct(c)){C buf[3]; buf[0]=Leat(lexer); buf[1]=0; if(Llook(lexer,0)=='.'||Llook(lexer,0)==':'){buf[1]=Leat(lexer); buf[2]=0;} if(strcmp(buf,"-")==0&&isdigit(Llook(lexer,0))){Llnum(lexer,T);CN;} LpT(lexer,T_PUNCT,sdup(buf));}else Lerror(lexer,"lex");}} typedef struct _Tt Tt; typedef struct _Tentry_t Tentry_t; struct _Tentry_t{S key; P value; B is_deleted;}; struct _Tt{Tentry_t*entries; Z used; Z capacity;}; Tt*Tnew(void){Tt*table=ma(SO(Tt)); table->used=0; table->capacity=TABLE_MIN_SIZE; table->entries=ma(table->capacity*SO(Tentry_t));R table;} Z Tlength(Tt*table){R table->used;} B Tempty(Tt*table){R table->used==0;} static U64 MM86128(P key,const I len,U32 seed){const uint8_t*data=(const uint8_t*)key; const I nblocks=len/16; U32 h1=seed; U32 h2=seed; U32 h3=seed; U32 h4=seed; U32 c1=0x239b961b; U32 c2=0xab0e9789; U32 c3=0x38b34ae5; U32 c4=0xa1e38b93; const uint32_t*blocks=(const uint32_t*)(data+nblocks*16); for(I i=-nblocks;i;i++){U32 k1=blocks[i*4+0]; U32 k2=blocks[i*4+1]; U32 k3=blocks[i*4+2]; U32 k4=blocks[i*4+3]; k1*=c1; k1=ROTL32(k1,15); k1*=c2; h1^=k1; h1=ROTL32(h1,19); h1+=h2; h1=h1*5+0x561ccd1b; k2*=c2; k2=ROTL32(k2,16); k2*=c3; h2^=k2; h2=ROTL32(h2,17); h2+=h3; h2=h2*5+0x0bcaa747; k3*=c3; k3=ROTL32(k3,17); k3*=c4; h3^=k3; h3=ROTL32(h3,15); h3+=h4; h3=h3*5+0x96cd1c35; k4*=c4; k4=ROTL32(k4,18); k4*=c1; h4^=k4; h4=ROTL32(h4,13); h4+=h1; h4=h4*5+0x32ac3b17;} const uint8_t*tail=(const uint8_t*)(data+nblocks*16); U32 k1=0; U32 k2=0; U32 k3=0; U32 k4=0; SW(len & 15){CS 15:k4^=tail[14]<<16; CS 14:k4^=tail[13]<<8; CS 13:k4^=tail[12]<<0; k4*=c4; k4=ROTL32(k4,18); k4*=c1; h4^=k4; CS 12:k3^=tail[11]<<24; CS 11:k3^=tail[10]<<16; CS 10:k3^=tail[9]<<8; CS 9:k3^=tail[8]<<0; k3*=c3; k3=ROTL32(k3,17); k3*=c4; h3^=k3; CS 8:k2^=tail[7]<<24; CS 7:k2^=tail[6]<<16; CS 6:k2^=tail[5]<<8; CS 5:k2^=tail[4]<<0; k2*=c2; k2=ROTL32(k2,16); k2*=c3; h2^=k2; CS 4:k1^=tail[3]<<24; CS 3:k1^=tail[2]<<16; CS 2:k1^=tail[1]<<8; CS 1:k1^=tail[0]<<0; k1*=c1; k1=ROTL32(k1,15); k1*=c2; h1^=k1;} h1^=len; h2^=len; h3^=len; h4^=len; h1+=h2; h1+=h3; h1+=h4; h2+=h1; h3+=h1; h4+=h1; FMIX32(h1); FMIX32(h2); FMIX32(h3); FMIX32(h4); h1+=h2; h1+=h3; h1+=h4; h2+=h1; h3+=h1; h4+=h1;R(((U64)h2)<<32)| h1;} static U32 HASH_SEED=0; P Tget(Tt*table,S key){if(Tempty(table))R N; U64 hash=MM86128(key,strlen(key),HASH_SEED); Z index=hash%table->capacity; Z i=index; WH(table->entries[i].key){if(!table->entries[i].is_deleted&&strcmp(table->entries[i].key,key)==0)R table->entries[i].value; i++; if(i>=table->capacity)i=0; if(i==index)BR;} R N;} B Thas(Tt*table,S key){if(Tempty(table))R F; U64 hash=MM86128(key,strlen(key),HASH_SEED); Z index=hash%table->capacity; Z i=index; WH(table->entries[i].key){if(!table->entries[i].is_deleted&&strcmp(table->entries[i].key,key)==0)R T; i++; if(i>=table->capacity)i=0; if(i==index)BR;} R F;} static V Tentry_set(Tentry_t*entries,S key,P value,Z capacity,Z*used){U64 hash=MM86128(key,strlen(key),HASH_SEED); Z index=hash%capacity; Z i=index; WH(entries[i].key){if(strcmp(entries[i].key,key)==0){entries[i].value=value; if(entries[i].is_deleted){if(used)(*used)++; entries[i].is_deleted=F;} R;}elif(entries[i].is_deleted)BR; i++; if(i>=capacity)i=0; if(i==index)BR;} if(used)(*used)++; entries[i].key=key; entries[i].value=value; entries[i].is_deleted=F;} Tt*Tset(Tt*table,S key,P value){if(table->used>=table->capacity){Z capacity=table->capacity+TABLE_MIN_SIZE; Tentry_t*entries=ma(capacity*SO(Tentry_t)); for(Z i=0;icapacity;i++){Tentry_t entry=table->entries[i]; if(entry.key&&!entry.is_deleted)Tentry_set(entries,entry.key,entry.value,capacity,N);} FR(table->entries); table->entries=entries; table->capacity=capacity;} Tentry_set(table->entries,key,value,table->capacity,&table->used);R table;} B Tdelete(Tt*table,S key){U64 hash=MM86128(key,strlen(key),HASH_SEED); Z index=hash%table->capacity; Z i=index; WH(table->entries[i].key){if(!table->entries[i].is_deleted&&strcmp(table->entries[i].key,key)==0){table->entries[i].value=N; table->entries[i].is_deleted=T; table->used--; if(table->capacity>TABLE_MIN_SIZE&&table->used<=table->capacity-TABLE_MIN_SIZE){Z capacity=table->capacity-TABLE_MIN_SIZE; Tentry_t*entries=ma(capacity*SO(Tentry_t)); for(Z i=0;icapacity;i++){Tentry_t entry=table->entries[i]; if(entry.key&&!entry.is_deleted)Tentry_set(entries,entry.key,entry.value,capacity,N);} FR(table->entries); table->entries=entries; table->capacity=capacity;} R T;} i++; if(i>=table->capacity)i=0; if(i==index)BR;} R F;} typedef struct _Vt Vt; typedef struct _St St; typedef struct _vt vt; struct _St{Tt*env; Ar*args; Ar*selfrefs; Vt*nil; Vt*udf; Vt*unit; vt*at; B bn;}; struct _vt{S name; UI rank[3]; Ar*bonds; B mark; B is_fun; Vt*(*monad)(St*,vt*,Vt*); Vt*(*dyad)(St*,vt*,Vt*,Vt*);}; typedef struct{S name; vt*(*adverb)(St*,Vt*); vt*(*conjunction)(St*,Vt*,Vt*);}advt; struct _Vt{enum Vtag_t{ARRAY,VERB,SYM,NUM,CHAR,NIL,UDF}tag; union{Ar*array; vt*verb; S symbol; D number; UC _char;}val;}; vt*vnew(){vt*verb=ma(SO(vt));R verb;} Vt*Vnew(enum Vtag_t tag){Vt*val; if(tag>SYM)val=maa(SO(Vt)); else val=ma(SO(Vt)); val->tag=tag;R val;} Vt*VnC(enum Vtag_t tag){Vt*val=mau(SO(Vt)); val->tag=tag;R val;} Vt*_UNIT; Vt*Vna(Ar*array){if(!array->data){FR(array);R _UNIT;} Vt*val=Vnew(ARRAY); val->val.array=array;R val;} Tt*VCACHE; Vt*Vnv(vt*verb){Vt*val; if((val=Tget(VCACHE,verb->name)))R val; val=Vnew(VERB); val->val.verb=verb;R val;} Tt*SCACHE; Vt*Vny(S symbol){Vt*val; if((val=Tget(SCACHE,symbol)))R val; val=VnC(SYM); val->val.symbol=symbol; Tset(SCACHE,symbol,val);R val;} Vt*_NAN,*INF,*NINF; Vt*NNUMS[8]; Vt*NUMS[256]; Vt*CHARS[256]; Vt*Vnn(D number){if(isnan(number))R _NAN; elif(number==INFINITY)R INF; elif(number==-INFINITY)R NINF; elif(number>=0&&number<256&&number==(D)((Z)number))R NUMS[(Z)number]; elif(number<0&&number>=-8&&fabs(number)==(D)((Z)fabs(number)))R NNUMS[((Z)fabs(number))-1]; Vt*val=Vnew(NUM); val->val.number=number;R val;} B Veq(Vt*x,Vt*y){if(xt!=yt)R F; SW(xt){CS ARRAY:{Ar*tx=xa; Ar*ty=ya; if(tx->length==0&&ty->length==0)BR; if(tx->length!=ty->length)R F; for(Z i=0;ilength;i++)if(!Veq(tx->data[i],ty->data[i]))R F;} CS VERB:R strcmp(xV->name,xV->name)==0; CS SYM:R strcmp(xY,yY)==0; CS NUM:if(isnan(xn)&&isnan(yn))BR;R xn==yn; CS CHAR:R x==y; CS NIL:CS UDF:BR;} R T;} B Cap(Ar*a){for(Z i=0;ilength;i++){Vt*v=a->data[i]; if(v->tag!=CHAR||!isprint(v->val._char))R F;} R T;} B Aap(Ar*a){for(Z i=0;ilength;i++){Vt*v=a->data[i]; if(v->tag!=ARRAY)R F;} R T;} B nonar(Ar*a){if(!a->data)R T; for(Z i=1;ilength;i++){Vt*v=a->data[i]; if(v->tag==ARRAY)R F;} R T;} B matp(Ar*a){if(a->length<2)R F; Z rwl=((Vt*)a->data[0])->val.array->length; if(rwl<1)R F; for(Z i=0;ilength;i++){Vt*v=a->data[i]; if(v->tag!=ARRAY||v->val.array->length!=rwl||!nonar(v->val.array)||Cap(v->val.array))R F;} R T;} S Vshow(Vt*v); S show_array(Vt*v){if(v->tag!=ARRAY)R Vshow(v); Ar*t=v->val.array; if(!t->data)R sdup("()"); Bt*buf=Bnew(); if(t->length==1){Bappend(buf,','); S ts=Vshow(t->data[0]); BappendS(buf,ts); FR(ts);R Bread(buf);} if(Cap(t)){for(Z i=0;ilength;i++)Bappend(buf,((Vt*)t->data[i])->val._char);R Bread(buf);} if(!Aap(t))for(Z i=0;ilength;i++){S ts=Vshow(t->data[i]); BappendS(buf,ts); FR(ts); if(i!=t->length-1)Bappend(buf,' ');} elif(matp(t)){Z rwl=0; Z pad=0; Z padl=0; Ar*ss=An(); for(Z i=0;ilength;i++){Vt*rw=t->data[i]; Ar*rwt=rw->val.array; if(rwl<1)rwl=rwt->length; for(Z j=0;jlength;j++){S s=Vshow(rwt->data[j]); Z z=strlen(s); if(z>pad)pad=z; if(j==0&&z>padl)padl=z; Ap(ss,s);}} Z k=0; for(Z i=0;ilength;i++){S s=ss->data[i]; Z mp=(k==0?padl:pad)-strlen(s); WH(mp--)Bappend(buf,' '); BappendS(buf,s); FR(s); if(i!=ss->length-1){if(k==rwl-1){k=0; Bappend(buf,'\n');}else{Bappend(buf,' '); k++;}}} FR(ss->data); FR(ss);} else for(Z i=0;ilength;i++){Vt*rw=t->data[i]; S ts=show_array(rw); BappendS(buf,ts); FR(ts); 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); CS SYM:R sdup(v->val.symbol); CS NUM:{C buf[128]; snprintf(buf,SO(buf),"%.15g",vn);R sdup(buf);} CS CHAR:{if(!isprint(v->val._char)){C buf[16]; snprintf(buf,SO(buf),"4t.%d",v->val._char);R sdup(buf);} C buf[2]; buf[0]=v->val._char; buf[1]=0;R sdup(buf);} CS NIL:R sdup("nil"); CS UDF:R sdup("udf");} R sdup("");} S Vstr(Vt*v){if(v->tag==ARRAY&&v->val.array->length==1&&((Vt*)v->val.array->data[0])->tag==CHAR)R Vshow(v->val.array->data[0]);R Vshow(v);} D Vnum(Vt*v){if(v->tag==CHAR)R v->val._char;R vn;} B VTp(Vt*x){SW(xt){CS ARRAY:R xal!=0; CS NUM:CS CHAR:R Vnum(x)!=0; CS NIL:CS UDF:R F; default:R T;}} vt*Gv(S s); St*Sn(void){St*st=ma(SO(St)); st->env=Tnew(); st->args=An(); st->selfrefs=An(); st->nil=Vnew(NIL); st->udf=Vnew(UDF); st->unit=_UNIT; st->at=Gv("@");R st;} V Serror(St*st,S e){fprintf(stderr,"%s error\n",e); exit(1);} Vt*eR(St*st,vt*f,Vt*x,UI d,UI rm){if(!f->monad)R st->udf; if(d>=rm||xt!=ARRAY){if(f->mark)Ap(st->selfrefs,f); Vt*r=f->monad(st,f,x); if(f->mark)AP(st->selfrefs);R r;} Ar*t=xa; if(!t->data)R x; Ar*l=Ank(t->length); for(Z i=0;ilength;i++)l->data[i]=eR(st,f,t->data[i],d+1,rm);R Vna(l);} Vt*apM(St*st,Vt*f,Vt*x){if(f->tag!=VERB)R st->udf; if(!f->val.verb->monad)R st->udf;R eR(st,f->val.verb,x,0,f->val.verb->rank[0]);} Vt*tgth(St*st,vt*f,Vt*x,Vt*y,UI dl,UI dr,UI rl,UI rr){if(!f->dyad)R st->udf; if(dl>=rl&&dr>=rr){if(f->mark)Ap(st->selfrefs,f); Vt*r=f->dyad(st,f,x,y); if(f->mark)AP(st->selfrefs);R r;} if(dldata||!ty->data)R !tx->data?x:y; Ar*t=Ank(ty->lengthlength?ty->length:tx->length); for(Z i=0;ilength;i++){if(i>=ty->length)BR; t->data[i]=tgth(st,f,tx->data[i],ty->data[i],dl+1,dr+1,rl,rr);} R Vna(t);}elif((xt!=ARRAY||dl>=rl)&&yt==ARRAY&&drdata)R y; Ar*t=Ank(ty->length); for(Z i=0;ilength;i++)t->data[i]=tgth(st,f,x,ty->data[i],dl,dr+1,rl,rr);R Vna(t);}elif((yt!=ARRAY||dr>=rr)&&xt==ARRAY&&dldata)R x; Ar*t=Ank(tx->length); for(Z i=0;ilength;i++)t->data[i]=tgth(st,f,tx->data[i],y,dl+1,dr,rl,rr);R Vna(t);} if(f->mark)Ap(st->selfrefs,f); Vt*r=f->dyad(st,f,x,y); if(f->mark)AP(st->selfrefs);R r;} Vt*apD(St*st,Vt*f,Vt*x,Vt*y){if(f->tag!=VERB)R st->nil;R tgth(st,f->val.verb,x,y,0,0,f->val.verb->rank[1],f->val.verb->rank[2]);} typedef struct _Nt Nt; struct _Nt{enum Ntag_t{N_STRAND,N_LITERAL,N_INDEX1,N_INDEX2,N_FUN,N_MONAD,N_DYAD,N_ADV,N_CONJ,N_PARTIAL_CONJ,N_FORK,N_HOOK,N_BOND,N_OVER,N_BIND}tag; advt*av; Vt*v; Ar*l; Nt*a; Nt*b; Nt*c; Z dp;}; S Nshow(Nt*n){SW(n->tag){CS N_STRAND:{Bt*buf=Bnew(); for(Z i=0;il->length;i++){if(i!=0)BappendS(buf,",:"); S s=Nshow(n->l->data[i]); BappendS(buf,s); FR(s);} R Bread(buf);} CS N_LITERAL:R Vshow(n->v); CS N_INDEX1:{S s; Bt*buf=Bnew(); s=Nshow(n->a); BappendS(buf,s); FR(s); Bappend(buf,' '); s=Nshow(n->b); BappendS(buf,s); FR(s);R Bread(buf);} CS N_INDEX2:{S s; Bt*buf=Bnew(); s=Nshow(n->a); BappendS(buf,s); FR(s); Bappend(buf,' '); s=Nshow(n->b); BappendS(buf,s); FR(s); Bappend(buf,' '); s=Nshow(n->c); BappendS(buf,s); FR(s);R Bread(buf);} CS N_FUN:{Bt*buf=Bnew(); Bappend(buf,':'); S s=Nshow(n->a); BappendS(buf,s); FR(s);R Bread(buf);} CS N_MONAD:CS N_HOOK:CS N_BOND:CS N_OVER:{S s; Bt*buf=Bnew(); s=Nshow(n->a); BappendS(buf,s); FR(s); s=Nshow(n->b); BappendS(buf,s); FR(s);R Bread(buf);} CS N_DYAD:{S s; Bt*buf=Bnew(); s=Nshow(n->b); BappendS(buf,s); FR(s); s=Nshow(n->a); BappendS(buf,s); FR(s); s=Nshow(n->c); BappendS(buf,s); FR(s);R Bread(buf);} CS N_ADV:CS N_PARTIAL_CONJ:{Bt*buf=Bnew(); S s=Nshow(n->a); BappendS(buf,s); FR(s); BappendS(buf,n->av->name);R Bread(buf);} CS N_CONJ:{S s; Bt*buf=Bnew(); s=Nshow(n->a); BappendS(buf,s); FR(s); BappendS(buf,n->av->name); s=Nshow(n->b); BappendS(buf,s); FR(s);R Bread(buf);} CS N_FORK:{S s; Bt*buf=Bnew(); s=Nshow(n->a); BappendS(buf,s); FR(s); s=Nshow(n->b); BappendS(buf,s); FR(s); s=Nshow(n->c); BappendS(buf,s); FR(s);R Bread(buf);} CS N_BIND:{S s; Bt*buf=Bnew(); s=Nshow(n->a); BappendS(buf,s); FR(s); Bappend(buf,':'); s=Nshow(n->b); BappendS(buf,s); FR(s);R Bread(buf);}} R sdup("");} Vt*_fork_m(St*st,vt*self,Vt*x){vt*f=Ai(self->bonds,0); vt*g=Ai(self->bonds,1); vt*h=Ai(self->bonds,2); Vt*l=eR(st,f,x,0,f->rank[0]); Vt*r=eR(st,h,x,0,f->rank[0]);R tgth(st,g,l,r,0,0,g->rank[1],g->rank[2]);} Vt*_fork_d(St*st,vt*self,Vt*x,Vt*y){vt*f=Ai(self->bonds,0); vt*g=Ai(self->bonds,1); vt*h=Ai(self->bonds,2); Vt*l=eR(st,f,x,0,f->rank[0]); Vt*r=eR(st,h,y,0,f->rank[0]);R tgth(st,g,l,r,0,0,g->rank[1],g->rank[2]);} Vt*_hook_m(St*st,vt*self,Vt*x){vt*f=Ai(self->bonds,0); vt*g=Ai(self->bonds,1); Vt*r=eR(st,g,x,0,g->rank[0]);R eR(st,f,r,0,f->rank[0]);} Vt*_hook_d(St*st,vt*self,Vt*x,Vt*y){vt*f=Ai(self->bonds,0); vt*g=Ai(self->bonds,1); Vt*r=tgth(st,g,x,y,0,0,g->rank[1],g->rank[2]);R eR(st,f,r,0,f->rank[0]);} Vt*_bond_m(St*st,vt*self,Vt*x){vt*f=Ai(self->bonds,0); Vt*g=Ai(self->bonds,1);R tgth(st,f,g,x,0,0,f->rank[1],f->rank[2]);} Vt*_bond_d(St*st,vt*self,Vt*x,Vt*y){vt*f=Ai(self->bonds,0); Vt*g=Ai(self->bonds,1); Vt*r=tgth(st,f,x,y,0,0,f->rank[1],f->rank[2]);R tgth(st,f,x,r,0,0,f->rank[1],f->rank[2]);} Vt*_over_m(St*st,vt*self,Vt*x){Vt*f=Ai(self->bonds,0); vt*g=Ai(self->bonds,1); vt*h=Ai(self->bonds,2); Vt*l=eR(st,h,x,0,h->rank[0]);R tgth(st,g,f,l,0,0,g->rank[1],g->rank[2]);} Vt*_over_d(St*st,vt*self,Vt*x,Vt*y){Vt*f=Ai(self->bonds,0); vt*g=Ai(self->bonds,1); vt*h=Ai(self->bonds,2); Vt*l=tgth(st,h,x,y,0,0,h->rank[1],h->rank[2]);R tgth(st,g,f,l,0,0,g->rank[1],g->rank[2]);} B nca(Nt*node,unsigned int*argc){if(!node)R F; if(node->tag==N_LITERAL&&node->v->tag==SYM&&strcmp(node->v->val.symbol,"y")==0){*argc=2;R T;}elif(node->tag==N_LITERAL&&node->v->tag==SYM&&strcmp(node->v->val.symbol,"x")==0){if(*argc<2)*argc=1;}elif(node->tag==N_MONAD||node->tag==N_CONJ||node->tag==N_HOOK||node->tag==N_BOND||node->tag==N_INDEX1){if(nca(node->a,argc))R T; if(nca(node->b,argc))R T;}elif(node->tag==N_DYAD||node->tag==N_FORK||node->tag==N_OVER||node->tag==N_INDEX2){if(nca(node->a,argc))R T; if(nca(node->b,argc))R T; if(nca(node->c,argc))R T;}elif(node->tag==N_ADV){if(nca(node->a,argc))R T;}elif(node->tag==N_STRAND){Ar*t=node->l; for(Z i=0;ilength;i++)if(nca(t->data[i],argc))R T;}elif(node->tag==N_BIND){if(nca(node->b,argc))R T;} R F;} Vt*Swalk(St*st,Nt*node); Vt*_const_m(St*st,vt*self,Vt*x){R Swalk(st,self->bonds->data[0]);} Vt*_const_d(St*st,vt*self,Vt*x,Vt*y){R Swalk(st,self->bonds->data[0]);} Vt*_constv_m(St*st,vt*self,Vt*x){R self->bonds->data[0];} Vt*_constv_d(St*st,vt*self,Vt*x,Vt*y){R self->bonds->data[0];} Vt*_fun_m(St*st,vt*self,Vt*x){Ar*args=An(); Ap(args,x); Ap(args,self); Ap(st->args,args); Vt*r=Swalk(st,self->bonds->data[0]); AP(st->args); FR(args);R r;} Vt*_fun_d(St*st,vt*self,Vt*x,Vt*y){Ar*args=An(); Ap(args,x); Ap(args,y); Ap(args,self); Ap(st->args,args); Vt*r=Swalk(st,self->bonds->data[1]); AP(st->args); FR(args);R r;} Vt*_partial_conjunction(St*st,vt*self,Vt*x){advt*av=self->bonds->data[0]; Vt*a=self->bonds->data[1];R Vnv(av->conjunction(st,a,x));} Nt*Nn1(enum Ntag_t tag,Nt*a); Vt*Swalk(St*st,Nt*node){if(!node)R st->nil; SW(node->tag){CS N_STRAND:{Ar*t=Ac(node->l); for(Z i=0;ilength;i++)t->data[i]=Swalk(st,t->data[i]);R Vna(t);} CS N_LITERAL:{Vt*v=node->v; Vt*t=N; if(v->tag==SYM){S n=v->val.symbol; if(st->args->data){Ar*args=Ai(st->args,-1); Z argc=args->length-1; if(argc==2&&strcmp(n,"y")==0)R args->data[1]; elif(strcmp(n,"x")==0)R args->data[0];} if((t=Tget(st->env,n)))R t; if(strcmp(n,"T")==0)R Vnn(time(N));} R v;} CS N_INDEX1:R tgth(st,st->at,Swalk(st,node->a),Swalk(st,node->b),0,0,st->at->rank[1],st->at->rank[2]); CS N_INDEX2:R tgth(st,st->at,tgth(st,st->at,Swalk(st,node->a),Swalk(st,node->b),0,0,st->at->rank[1],st->at->rank[2]),Swalk(st,node->c),0,0,st->at->rank[1],st->at->rank[2]); CS N_FUN:{UI argc=0; nca(node->a,&argc); vt*nv=vnew(); if(argc>0)nv->is_fun=T; nv->bonds=An(); S s=Nshow(node->a); Z z=strlen(s)+2; nv->name=ma(z); snprintf(nv->name,z,":%s",s); FR(s); nv->rank[0]=0; nv->rank[1]=0; nv->rank[2]=0; if(argc==0){Ap(nv->bonds,node->a); nv->monad=_const_m; nv->dyad=_const_d;}elif(argc==1){Ap(nv->bonds,node->a); nv->monad=_fun_m; nv->dyad=N;}else{nv->monad=N; Ap(nv->bonds,st->udf); Ap(nv->bonds,node->a); nv->dyad=_fun_d;} R Vnv(nv);} CS N_MONAD:R apM(st,Swalk(st,node->a),Swalk(st,node->b)); CS N_DYAD:R apD(st,Swalk(st,node->a),Swalk(st,node->b),Swalk(st,node->c)); CS N_ADV:{Vt*v=Swalk(st,node->a); vt*nv=node->av->adverb(st,v); if(node->dp<2)nv->mark=T;R Vnv(nv);} CS N_CONJ:{Vt*v1=Swalk(st,node->a); Vt*v2=Swalk(st,node->b); vt*nv=node->av->conjunction(st,v1,v2); if(node->dp<2)nv->mark=T;R Vnv(nv);} CS N_PARTIAL_CONJ:{vt*nv=vnew(); Vt*a=Swalk(st,node->a); S r=Vshow(a); Z l=strlen(r)+strlen(node->av->name)+1; nv->name=ma(l); snprintf(nv->name,l,"%s%s",r,node->av->name); FR(r); nv->bonds=An(); Ap(nv->bonds,node->av); Ap(nv->bonds,a); nv->rank[0]=0; nv->rank[1]=0; nv->rank[2]=0; nv->monad=_partial_conjunction; nv->dyad=N; if(node->dp<2)nv->mark=T;R Vnv(nv);} CS N_FORK:{Vt*_f=Swalk(st,node->a); if(_f->tag!=VERB)R st->udf; Vt*_g=Swalk(st,node->b); if(_g->tag!=VERB)R st->udf; Vt*_h=Swalk(st,node->c); if(_h->tag!=VERB)R st->udf; vt*f=_f->val.verb; vt*g=_g->val.verb; vt*h=_h->val.verb; vt*nv=vnew(); nv->bonds=Ank(3); nv->bonds->data[0]=f; nv->bonds->data[1]=g; nv->bonds->data[2]=h; Z l=strlen(f->name)+strlen(g->name)+strlen(h->name)+1; nv->name=ma(l); snprintf(nv->name,l,"%s%s%s",f->name,g->name,h->name); nv->rank[0]=0; nv->rank[1]=0; nv->rank[2]=0; nv->monad=_fork_m; nv->dyad=_fork_d; if(node->dp<2)nv->mark=T;R Vnv(nv);} CS N_HOOK:{Vt*_f=Swalk(st,node->a); if(_f->tag!=VERB)R st->udf; Vt*_g=Swalk(st,node->b); if(_g->tag!=VERB)R st->udf; vt*f=_f->val.verb; vt*g=_g->val.verb; vt*nv=vnew(); nv->bonds=Ank(2); nv->bonds->data[0]=f; nv->bonds->data[1]=g; Z l=strlen(f->name)+strlen(g->name)+1; nv->name=ma(l); snprintf(nv->name,l,"%s%s",f->name,g->name); nv->rank[0]=0; nv->rank[1]=0; nv->rank[2]=0; nv->monad=_hook_m; nv->dyad=_hook_d; if(node->dp<2)nv->mark=T;R Vnv(nv);} CS N_BOND:{Vt*_f=Swalk(st,node->a); if(_f->tag!=VERB)R st->udf; Vt*g=Swalk(st,node->b); vt*f=_f->val.verb; vt*nv=vnew(); nv->bonds=Ank(2); nv->bonds->data[0]=f; nv->bonds->data[1]=g; S r=Vshow(g); Z l=strlen(r)+strlen(f->name)+1; nv->name=ma(l); snprintf(nv->name,l,"%s%s",r,f->name); FR(r); nv->rank[0]=0; nv->rank[1]=0; nv->rank[2]=0; nv->monad=_bond_m; nv->dyad=_bond_d; if(node->dp<2)nv->mark=T;R Vnv(nv);} CS N_OVER:{Vt*f=Swalk(st,node->a); Vt*_g=Swalk(st,node->b); if(_g->tag!=VERB)R st->udf; Vt*_h=Swalk(st,node->c); if(_h->tag!=VERB)R st->udf; vt*g=_g->val.verb; vt*h=_h->val.verb; vt*nv=vnew(); nv->bonds=Ank(3); nv->bonds->data[0]=f; nv->bonds->data[1]=g; nv->bonds->data[2]=h; S r=Vshow(f); Z l=strlen(r)+strlen(g->name)+strlen(h->name)+1; nv->name=ma(l); snprintf(nv->name,l,"%s%s%s",r,g->name,h->name); FR(r); nv->rank[0]=0; nv->rank[1]=0; nv->rank[2]=0; nv->monad=_over_m; nv->dyad=_over_d; if(node->dp<2)nv->mark=T;R Vnv(nv);} CS N_BIND:{Vt*l=node->a->v; Nt*b=node->b; if(st->bn||st->args->data||node->dp!=0){Tset(st->env,l->val.symbol,Swalk(st,b));BR;} UI argc=0; nca(b,&argc); if(argc!=0)b=Nn1(N_FUN,b); B t=st->bn; st->bn=T; Vt*r=Swalk(st,b); st->bn=F; if(argc!=0){FR(r->val.verb->name); r->val.verb->name=l->val.symbol;} if(r->tag==VERB&&argc==0)r->val.verb->mark=T; Vt*ov=Tget(st->env,l->val.symbol); if(ov&&ov->tag==VERB&&ov->val.verb->is_fun&&r->tag==VERB&&r->val.verb->is_fun){if(!ov->val.verb->monad&&r->val.verb->monad){As(ov->val.verb->bonds,0,r->val.verb->bonds->data[0]); ov->val.verb->monad=r->val.verb->monad;BR;} if(!ov->val.verb->dyad&&r->val.verb->dyad){Ap(ov->val.verb->bonds,r->val.verb->bonds->data[1]); ov->val.verb->dyad=r->val.verb->dyad;BR;}} Tset(st->env,l->val.symbol,r);}BR;} R st->nil;} Vt*vconst(St*st,vt*self,Vt*x){vt*nv=vnew(); nv->bonds=Ank(1); nv->bonds->data[0]=x; S r=Vshow(x); Z l=strlen(r)+2; nv->name=ma(l); snprintf(nv->name,l,":%s",r); nv->rank[0]=0; nv->rank[1]=0; nv->rank[2]=0; nv->monad=_constv_m; nv->dyad=_constv_d;R Vnv(nv);} Vt*vbind(St*st,vt*self,Vt*x,Vt*y){if(xt==SYM){if(yt==VERB)yV->mark=T; Tset(st->env,xY,y);} R st->udf;} Tt*Inverses; Vt*vunbind(St*st,vt*self,Vt*x){if(xt==SYM){Tdelete(st->env,xY);R st->nil;} R st->udf;} Vt*vobverse(St*st,vt*self,Vt*x,Vt*y){if(xt==VERB&&yt==VERB){vt*vx=xV; if(!yV->monad) R st->udf; if(vx->is_fun)R st->udf; if(Thas(Inverses,vx->name))R st->udf; Tset(Inverses,vx->name,yV);R st->nil;} R st->udf;} Vt*vflip(St*st,vt*self,Vt*x){if(xt!=ARRAY||!xad)R st->udf; if(!Aap(xa))R st->udf; Ar*r=An(); Vt*c0=xad[0]; Ar*c0t=c0->val.array; Z c0l=c0t->length; for(Z i=0;ival.array; if(!rwt->data)R st->udf; Vt*v=Ai(rwt,i); if(!v)v=rwt->data[0]; Ap(nc,v);} Ap(r,Vna(nc));} R Vna(r);} Vt*vplus(St*st,vt*self,Vt*x,Vt*y){if((xt==NUM||xt==CHAR)&&(yt==NUM||yt==CHAR)){if(xt==CHAR||yt==CHAR)R Vnc(Vnum(x)+Vnum(y));R Vnn(Vnum(x)+Vnum(y));} R _NAN;} Vt*vsign(St*st,vt*self,Vt*x){if(xt==NUM)R xn<0?NNUMS[0]:xn>0?NUMS[1]:NUMS[0];R _NAN;} D gcd(D a,D b){if(b!=0)R gcd(b,fmod(a,b)); else R fabs(a);} Vt*vgcd(St*st,vt*self,Vt*x,Vt*y){if(xt==NUM&&yt==NUM)R Vnn(gcd(xn,yn));R _NAN;} Vt*vsin(St*st,vt*self,Vt*x){if(xt==NUM)R Vnn(sin(xn));R _NAN;} Vt*vsquare(St*st,vt*self,Vt*x){if(xt==NUM)R Vnn(xn*xn);R _NAN;} Vt*vnegate(St*st,vt*self,Vt*x){if(xt==NUM)R Vnn(-xn);R _NAN;} Vt*vminus(St*st,vt*self,Vt*x,Vt*y){if((xt==NUM||xt==CHAR)&&(yt==NUM||yt==CHAR)){if(xt==CHAR||yt==CHAR)R Vnc(Vnum(x)-Vnum(y));R Vnn(Vnum(x)-Vnum(y));} R _NAN;} Vt*vatan(St*st,vt*self,Vt*x){if(xt==NUM)R Vnn(atan(xn));R _NAN;} Vt*vatan2(St*st,vt*self,Vt*x,Vt*y){if(xt==NUM&&yt==NUM)R Vnn(atan2(xn,yn));R _NAN;} Vt*vfirst(St*st,vt*self,Vt*x){if(xt!=ARRAY)R x; if(!xad)R st->udf;R xad[0];} Vt*vtimes(St*st,vt*self,Vt*x,Vt*y){if((xt==NUM||xt==CHAR)&&(yt==NUM||yt==CHAR)){if(xt==CHAR||yt==CHAR)R Vnc(Vnum(x)*Vnum(y));R Vnn(Vnum(x)*Vnum(y));} R _NAN;} D lcm(D a,D b){R(a*b)/gcd(a,b);} U64 factorial(U64 n){U64 r=1; WH(n>0)r*=n--;R r;} Vt*vfactorial(St*st,vt*self,Vt*x){if(xt==NUM)R Vnn(factorial((U64)fabs(xn)));R _NAN;} Vt*vlcm(St*st,vt*self,Vt*x,Vt*y){if(xt==NUM&&yt==NUM)R Vnn(lcm(xn,yn));R _NAN;} Vt*vdouble(St*st,vt*self,Vt*x){if(xt==NUM)R Vnn(xn*2);R _NAN;} Vt*vreplicate(St*st,vt*self,Vt*x,Vt*y){if(xt==NUM){Z k=fabs(xn); Ar*r=An(); WH(k--)Ap(r,y);R Vna(r);} R st->udf;} Vt*vreciprocal(St*st,vt*self,Vt*x){if(xt==NUM)R Vnn(1/xn);R _NAN;} Vt*vdivide(St*st,vt*self,Vt*x,Vt*y){if(xt==NUM&&yt==NUM){D ny=yn; if(ny==0)R INF;R Vnn(xn/ny);} R _NAN;} D npower(D base,I n){if(n<0)R npower(1/base,-n); elif(n==0)R 1.0; elif(n==1)R base; elif(n%2)R base*npower(base*base,n/2); else R npower(base*base,n/2);} D nroot(D base,I n){if(n==1)R base; elif(n<=0||base<0)R NAN; else{D delta,x=base/n; do{delta=(base/npower(x,n-1)-x)/n; x+=delta;}WH(fabs(delta)>=1e-8);R x;}} Vt*vsqrt(St*st,vt*self,Vt*x){if(xt==NUM)R Vnn(sqrt(xn));R _NAN;} Vt*vroot(St*st,vt*self,Vt*x,Vt*y){if(xt==NUM&&yt==NUM)R Vnn(nroot(yn,xn));R _NAN;} Vt*vhalve(St*st,vt*self,Vt*x){if(xt==NUM)R Vnn(xn/2);R _NAN;} Vt*vidivide(St*st,vt*self,Vt*x,Vt*y){if(xt==NUM&&yt==NUM){D ny=yn; if(ny==0)R INF;R Vnn(trunc(xn/ny));} R _NAN;} Vt*venlist(St*st,vt*self,Vt*x); Vt*vpred(St*st,vt*self,Vt*x); Vt*vrange(St*st,vt*self,Vt*x,Vt*y); Vt*venum(St*st,vt*self,Vt*x){if(Veq(x,NUMS[1]))R venlist(st,N,NUMS[0]); elif(Veq(x,NUMS[0]))R st->unit;R vrange(st,self,NUMS[0],vpred(st,self,x));} Vt*vmod(St*st,vt*self,Vt*x,Vt*y){if(xt==NUM&&yt==NUM){D ny=yn; if(ny==0)R _NAN;R Vnn(fmod(xn,ny));} R _NAN;} Vt*vtake(St*st,vt*self,Vt*x,Vt*y); Vt*vdrop(St*st,vt*self,Vt*x,Vt*y); B spnp(D v){R isnan(v)||v==INFINITY||v==-INFINITY;} Vt*vodometer(St*st,vt*self,Vt*x){if(xt!=ARRAY)x=venlist(st,N,x); elif(xal<2)R st->udf; Z p=1; Z xl=xal; for(Z i=0;itag!=NUM||spnp(it->val.number))R st->udf; p*=(Z)(it->val.number);} if(p<1)R st->unit; uint64_t*lims=maa(SO(U64)*xl); for(Z i=0;ival.number); uint64_t**z=ma(SO(uint64_t*)*p); for(Z i=0;i=lims[a]){s[a]=0;carry=T;}}} FR(lims); Ar*r=Ank(p); for(Z i=0;idata[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; if(yt!=ARRAY)y=venlist(st,N,y); elif(!yad)R y; Ar*r=An(); Z cl=fabs(xn); for(Z i=0;i0;bit_test>>=1){if(value>>bit_test!=0){bits+=bit_test; value>>=bit_test;}} R bits+value;} Vt*vbits(St*st,vt*self,Vt*x){if(xt==NUM){I n=xn; I bk=bits_needed(n); Ar*r=Ank(bk); for(I i=0;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); Z b=fabs(xn); if(b<2)R st->udf; Ar*r=An(); WH(v>0){Ap(r,Vnn(v%b)); v/=b;} R vreverse(st,N,Vna(r));} R st->udf;} SZ indexOf(Ar*l,Vt*x){if(!l->data)return-1; for(Z i=0;ilength;i++)if(Veq(l->data[i],x))R i; return-1;} Vt*vgroup(St*st,vt*self,Vt*x){if(xt!=ARRAY)x=venlist(st,N,x); elif(!xad)R x; Ar*r=An(); Ar*is=An(); for(Z i=0;ival.array,Vnn(i));}} FR(is->data); FR(is);R Vna(r);} Vt*vbuckets(St*st,vt*self,Vt*x,Vt*y){if(xt!=ARRAY)x=venlist(st,N,x); elif(!xad)R y; if(yt!=ARRAY)y=venlist(st,N,x); elif(!yad)R y; Ar*r=An(); Z mx=0; for(Z i=0;itag!=NUM)BR; SZ j=vn; if(j>=0&&j>mx)mx=j;} for(Z i=0;idata){FR(r);R st->unit;} for(Z i=0;i=yal)BR; Vt*v=xad[i]; if(v->tag!=NUM)BR; SZ j=vn; if(j>=0){Ar*b=Ai(r,j); if(b)Ap(b,yad[i]);}} if(xallength;i++)r->data[i]=Vna(r->data[i]);R Vna(r);} Vt*vequals(St*st,vt*self,Vt*x,Vt*y){R Veq(x,y)?NUMS[1]:NUMS[0];} Vt*vpermute(St*st,vt*self,Vt*x){if(xt!=ARRAY||xal<2)R x; Ar*permutation=Ac(xa); Z length=permutation->length; Ar*result=An(); Ap(result,Ac(permutation)); Ar*c=An(); for(Z i=0;ilength;i++)FR(c->data[i]); FR(c->data); FR(c); FR(permutation->data); FR(permutation); for(Z i=0;ilength;i++)result->data[i]=Vna(result->data[i]);R Vna(result);} Vt*voccurences(St*st,vt*self,Vt*x){if(xt!=ARRAY)x=venlist(st,N,x); elif(!xad)R x; Ar*table=An(); Ar*r=An(); for(Z i=0;ilength;j++){Ar*p=table->data[j]; if(Veq(p->data[0],it)){Z*n=p->data[1]; *n=(*n)+1; Ap(r,Vnn(*n)); f=T;BR;}} if(!f){Ar*p=Ank(2); p->data[0]=it; Z*n=maa(SO(Z)); p->data[1]=n; Ap(table,p); Ap(r,NUMS[0]);}} for(Z i=0;ilength;i++){Ar*p=table->data[i]; FR(p->data[1]); FR(p->data); FR(p);} FR(table->data); FR(table);R Vna(r);} Vt*vmask(St*st,vt*self,Vt*x,Vt*y){if(xt!=ARRAY)x=venlist(st,N,x); elif(!xad)R x; if(yt!=ARRAY)y=venlist(st,N,y); Ar*r=An(); Vt*l=Vnn(yal); Z n=0; Z k=xal; for(Z i=0;ival.number;j++,i++)Ap(r,Vnn(n)); i--;}else Ap(r,NUMS[0]);} R Vna(r);} Vt*vclassify(St*st,vt*self,Vt*x){if(xt!=ARRAY)x=venlist(st,N,x); elif(!xad)R x; Ar*table=An(); Ar*r=An(); for(Z i=0;ilength;j++){Ar*p=table->data[j]; if(Veq(p->data[0],it)){Z*n=p->data[1]; Ap(r,Vnn(*n)); f=T;BR;}} if(!f){Ar*p=Ank(2); p->data[0]=it; Z*n=maa(SO(Z)); *n=i++; p->data[1]=n; Ap(table,p); Ap(r,Vnn(*n));}} for(Z i=0;ilength;i++){Ar*p=table->data[i]; FR(p->data[1]); FR(p->data); FR(p);} FR(table->data); FR(table);R Vna(r);} Vt*vunbits(St*st,vt*self,Vt*x){if(xt!=ARRAY)x=venlist(st,N,x); I n=0; for(Z i=0;iudf; if(yt!=ARRAY)y=venlist(st,N,y); Z n=0; if(!yad)R st->udf; for(Z i=0;itag!=NUM)BR; Z k=fabs(vn); n=n*b+k;} R Vnn(n);} R st->udf;} Vt*vnot(St*st,vt*self,Vt*x){R VTp(x)?NUMS[0]:NUMS[1];} Vt*vnot_equals(St*st,vt*self,Vt*x,Vt*y){R !Veq(x,y)?NUMS[1]:NUMS[0];} Vt*vpred(St*st,vt*self,Vt*x){if(xt==NUM)R Vnn(xn-1); elif(xt==CHAR)R Vnc(x->val._char-1);R _NAN;} Vt*vless(St*st,vt*self,Vt*x,Vt*y){if((xt==NUM||xt==CHAR)&&(yt==NUM||yt==CHAR)){if(Vnum(x)data[0]; Vt*y=(*(Ar**)b)->data[0]; if((xt==NUM||xt==CHAR)&&(yt==NUM||yt==CHAR)){if(Vnum(x)>Vnum(y))R 1; elif(Vnum(x)data[0]; Vt*y=(*(Ar**)b)->data[0]; if((xt==NUM||xt==CHAR)&&(yt==NUM||yt==CHAR)){if(Vnum(x)>Vnum(y))return-1; elif(Vnum(x)data[0]=xad[i]; p->data[1]=Vnn(i); ps->data[i]=p;} qsort(ps->data,ps->length,SO(P ),down?_compare_down:_compare_up); for(Z i=0;ilength;i++){Ar*p=ps->data[i]; ps->data[i]=p->data[1]; FR(p->data); FR(p);} R Vna(ps);} Vt*vgradedown(St*st,vt*self,Vt*x){R _grade(x,T);} Vt*vnudge_left(St*st,vt*self,Vt*x,Vt*y){if(yt!=ARRAY)R venlist(st,N,x); elif(!yad)R y; elif(yal<2)R venlist(st,N,x); Ar*r=An(); for(Z i=1;ival._char+1);R _NAN;} Vt*vceil(St*st,vt*self,Vt*x){if(xt==NUM)R Vnn(ceil(xn));R _NAN;} Vt*vgreater(St*st,vt*self,Vt*x,Vt*y){if((xt==NUM||xt==CHAR)&&(yt==NUM||yt==CHAR)){if(Vnum(x)>Vnum(y))R NUMS[1];R NUMS[0];} R _NAN;} Vt*vgreatereq(St*st,vt*self,Vt*x,Vt*y){if(Veq(x,y))R NUMS[1]; if((xt==NUM||xt==CHAR)&&(yt==NUM||yt==CHAR)){if(Vnum(x)>Vnum(y))R NUMS[1];R NUMS[0];} R _NAN;} Vt*vgradeup(St*st,vt*self,Vt*x){R _grade(x,F);} Vt*vnudge_right(St*st,vt*self,Vt*x,Vt*y){if(yt!=ARRAY)R venlist(st,N,x); elif(!yad)R y; elif(yal<2)R venlist(st,N,x); Ar*r=An(); Ap(r,x); for(Z i=0;iunit; elif(!xad)R y; elif(!yad)R x; l=Ank(xal+yal); Z lp=0; for(Z i=0;idata[lp++]=xad[i]; for(Z i=0;idata[lp++]=yad[i];} elif(xt==ARRAY&&yt!=ARRAY){if(!xad)R venlist(st,N,y); l=Ank(xal+1); Z lp=0; for(Z i=0;idata[lp++]=xad[i]; l->data[lp++]=y;} elif(xt!=ARRAY&&yt==ARRAY){if(!yad)R venlist(st,N,x); l=Ank(yal+1); Z lp=0; l->data[lp++]=x; for(Z i=0;idata[lp++]=yad[i];} else R venpair(st,N,x,y);R Vna(l);} Vt*venpair(St*st,vt*self,Vt*x,Vt*y){Ar*l=Ank(2); l->data[0]=x; l->data[1]=y;R Vna(l);} Vt*vselfref1(St*st,vt*self,Vt*x){vt*v; if(st->args->data)v=Ai(Ai(st->args,-1),-1); elif(st->selfrefs->data)v=Ai(st->selfrefs,-1); else R st->udf;R eR(st,v,x,0,v->rank[0]);} Vt*vselfref2(St*st,vt*self,Vt*x,Vt*y){vt*v; if(st->args->data)v=Ai(Ai(st->args,-1),-1); elif(st->selfrefs->data)v=Ai(st->selfrefs,-1); else R st->udf;R tgth(st,v,x,y,0,0,v->rank[1],v->rank[2]);} Vt*vtake(St*st,vt*self,Vt*x,Vt*y){if(xt==NUM){if(yt!=ARRAY){if(xn==0)R st->unit; else R x;} if(xn==0||!yad)R st->unit; B rev=xn<0; Z k=(Z)fabs(xn); Ar*r=Ank(yal0;i--){Vt*v=Ai(ya,-i); if(!v)CN; r->data[p++]=v;} else for(Z i=0;idata[p++]=yad[i];R Vna(r);} R st->udf;} Vt*vwhere(St*st,vt*self,Vt*x){if(xt!=ARRAY)x=venlist(st,N,x); elif(!xad)R x; Ar*r=An(); for(Z i=0;itag!=NUM)BR; Z k=fabs(a->val.number); for(Z j=0;jdata||!ty->data)R st->unit; Ar*r=An(); for(Z i=0;ilength;i++){Vt*a=tx->data[i]; Vt*b=ty->data[i>=ty->length?ty->length-1:i]; if(b->tag!=NUM)BR; Z k=fabs(b->val.number); for(Z i=0;ilength;j++)if(Veq(xad[i],r->data[j])){u=F;BR;} if(u)Ap(r,xad[i]); 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; else R st->unit;} 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=Ank(yal-k); Z rp=0; for(Z i=k;idata[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(); for(Z i=0;ilength;j++)if(Veq(xad[i],r->data[j])){u=F;BR;} if(u)Ap(r,xad[i]);} R Vna(r);} Vt*vfind(St*st,vt*self,Vt*x,Vt*y){if(yt!=ARRAY)y=venlist(st,self,y); elif(!yad)R st->unit; Ar*r=An(); for(Z i=0;iunit; SZ n=indexOf(ya,x); if(n<0)n=yal;R Vnn(n);} Vt*vcount(St*st,vt*self,Vt*x){if(xt!=ARRAY)R NUMS[1];R Vnn(xal);} V flatten(Vt*x,Ar*r){if(xt==ARRAY) for(Z i=0;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; if(xt!=NUM)R st->udf; B rev=xn<0; Z k=fabs(xn); Ar*r=Ac(ya); for(Z i=0;idata[0]; for(Z j=0;jlength-1;j++)r->data[j]=r->data[j+1]; r->data[r->length-1]=v;} else{v=r->data[r->length-1]; for(Z j=r->length-1;j>0;j--)r->data[j]=r->data[j-1]; r->data[0]=v;}} R Vna(r);} Vt*vwindows(St*st,vt*self,Vt*x,Vt*y){if(yt!=ARRAY)y=venlist(st,N,y); elif(!yad)R y; Z k=fabs(xn); Z l=yal; Ar*r=An(); for(Z i=0;il)BR; Ap(r,vtake(st,N,Vnn(k),vdrop(st,N,Vnn(i),y)));} R Vna(r);} Z depthOf(Vt*x,Z d){if(xt==ARRAY){if(!xad)R 0; for(Z i=0;id)d=d2;} R d;} R 0;} Vt*vdepth(St*st,vt*self,Vt*x){R Vnn(depthOf(x,1));} Vt*vround(St*st,vt*self,Vt*x){if(xt==NUM)R Vnn(round(xn));R _NAN;} Vt*vabs(St*st,vt*self,Vt*x){if(xt==NUM)R Vnn(fabs(xn));R _NAN;} Vt*vtail(St*st,vt*self,Vt*x); Vt*vat(St*st,vt*self,Vt*x,Vt*y){if(yt!=NUM)R st->udf; if(xt!=ARRAY){if(yn>-1&&yn<1)R x; else R st->udf;} if(!xad)R st->nil; Vt*v=Ai(xa,(SZ)yn); if(!v)R st->udf;R v;} Vt*vmember(St*st,vt*self,Vt*x,Vt*y){if(yt!=ARRAY)y=venlist(st,self,y); elif(!yad)R NUMS[0]; for(Z i=0;ilength;i++){Z j=rand()%r->length; Vt*tmp=r->data[i]; r->data[i]=r->data[j]; r->data[j]=tmp;} R Vna(r);} Vt*vhead(St*st,vt*self,Vt*x){R vtake(st,N,NUMS[2],x);} Vt*vbin(St*st,vt*self,Vt*x,Vt*y){if(xt!=ARRAY)x=venlist(st,self,x); elif(!xad)R x; if(yt!=ARRAY)y=venlist(st,self,x); elif(!yad)R y; Z xl=xal; Ar*bins=An(); for(Z i=0;itag==NUM)s=vs->val.number; elif(vs->tag==CHAR)s=vs->val._char; else R st->udf; Vt*ve=i==xl-1?Vnn(s+1):xad[i+1]; if(ve->tag==NUM)e=fabs(ve->val.number); elif(ve->tag==CHAR)e=ve->val._char; else R st->udf; if(bins->data){Ar*pp=Ai(bins,-1); D*pe=pp->data[0]; if(s<=(*pe))R st->udf;} D*sn=ma(SO(D)); *sn=s; D*en=ma(SO(D)); *en=e; Ar*p=An(); Ap(p,sn); Ap(p,en); Ap(bins,p);} Z bl=bins->length; Ar*r=An(); Z yl=yal; for(Z i=0;itag==NUM)itv=it->val.number; elif(it->tag==CHAR)itv=it->val._char; else R st->udf; Ar*b=bins->data[0]; D*s=b->data[0]; if(itv<(*s)){Ap(r,NNUMS[0]);CN;} b=Ai(bins,-1); s=b->data[1]; if(itv>=(*s)){Ap(r,Vnn(bl-1));CN;} D v=NAN; for(Z j=0;jdata[j]; D*s=b->data[0]; D*e=b->data[1]; if(itv>=(*s)&&itv<(*e)){v=j;BR;}} if(!isnan(v))Ap(r,Vnn(v));} for(Z j=0;jdata[j]; FR(b->data[0]); FR(b->data[1]); FR(b->data); FR(b);} FR(bins->data); FR(bins);R Vna(r);} Vt*vtail(St*st,vt*self,Vt*x){if(xt!=ARRAY)R x; if(!xad)R st->udf;R Ai(xa,-1);} Vt*vcut(St*st,vt*self,Vt*x,Vt*y){if(xt!=ARRAY)x=venlist(st,self,x); elif(!xad)R x; if(yt!=ARRAY)y=venlist(st,self,x); elif(!yad)R x; if(xal!=2)R st->udf; Vt*vs=xad[0]; Vt*ve=xad[1]; if(vs->tag!=NUM||ve->tag!=NUM)R st->udf; Z s=fabs(vs->val.number); Z e=fabs(ve->val.number); Ar*r=An(); Z l=yal; Ar*pa=An(); for(Z i=s;iunit);R Vna(r);} Vt*vleft(St*st,vt*self,Vt*x,Vt*y){R x;} Vt*vsame(St*st,vt*self,Vt*x){R x;} Vt*vright(St*st,vt*self,Vt*x,Vt*y){R y;} Vt*vsymbol(St*st,vt*self,Vt*x){S s=Vstr(x);R Vny(s);} Vt*vapply1(St*st,vt*self,Vt*x,Vt*y){R apM(st,x,y);} Vt*vapply2(St*st,vt*self,Vt*x,Vt*y){if(yt!=ARRAY||yal<2)R st->udf;R apD(st,x,yad[0],yad[1]);} Vt*vshape(St*st,vt*self,Vt*x){if(xt!=ARRAY||!xad)R st->unit; if(!Aap(xa))R venlist(st,N,vcount(st,N,x)); if(xal<2)R venlist(st,N,vshape(st,N,xad[0]));R venpair(st,N,vcount(st,N,x),vcount(st,N,xad[0]));} Vt*vreshape(St*st,vt*self,Vt*x,Vt*y){if(yt!=ARRAY)y=venlist(st,N,y); elif(!yad)R y; if(xt!=ARRAY)x=venlist(st,N,x); elif(!xad)R st->unit; Ar*r; if(xal<2){Vt*a=xad[0]; if(a->tag!=NUM)R st->udf; Z k=fabs(a->val.number); Ar*t=An(); flatten(y,t); r=Ank(k); for(Z i=0;idata[i]=t->data[i%t->length];}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; Z k=fabs(a->val.number); Z l=fabs(b->val.number); y=vreshape(st,self,venlist(st,N,Vnn(k*l)),y); r=An(); Z yp=0; WH(k--){Ar*rw=An(); for(Z i=0;iudf;R Vna(r);} Vt*vrepr(St*st,vt*self,Vt*x){S s=Vshow(x); Ar*r=An(); for(Z i=0;ilength; for(Z i=0;i=tl||template[i]!='}'){FR(Bread(n)); Bappend(text,'{'); i=bi;CN;} S s=Bread(n); SZ ind=atoi(s); FR(s); Vt*v=Ai(replaces,ind); if(!v)CN; s=Vshow(v); BappendS(text,s); FR(s);CN;}elif(c=='~'){skip=T;CN;} Bappend(text,c);} R Bread(text);} Vt*vformat(St*st,vt*self,Vt*x,Vt*y){if(yt!=ARRAY)y=venlist(st,N,x); elif(!yad)R y; S fmt=Vshow(x); S s=format(fmt,ya); FR(fmt); Z z=strlen(s); Ar*r=Ank(z); for(Z i=0;idata[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); elif(!yad)R y; Ar*r=Ank(yal*2-1); Z rp=0; for(Z i=0;idata[rp++]=yad[i]; if(i!=yal-1)r->data[rp++]=x;} R Vna(r);} U64 fibonacci(U64 n){U64 a=0; U64 b=1; WH(n-->1){U64 t=a; a=b; b+=t;} R b;} Vt*vfibonacci(St*st,vt*self,Vt*x){if(xt==NUM)R Vnn(fibonacci((U64)fabs(xn)));R _NAN;} Vt*viota(St*st,vt*self,Vt*x){if(Veq(x,NUMS[1]))R venlist(st,N,NUMS[1]); elif(Veq(x,NUMS[0]))R st->unit;R vrange(st,self,NUMS[1],x);} Vt*vrange(St*st,vt*self,Vt*x,Vt*y){if((xt==NUM||xt==CHAR)&&(yt==NUM||yt==CHAR)){if(xt==NUM&&spnp(xn))R st->udf; if(yt==NUM&&spnp(yn))R st->udf; SZ s=Vnum(x); SZ e=Vnum(y); if(s==e)R venlist(st,N,x); Z p=0; Ar*r=Ank((s>e?s-e:e-s)+1); if(s>e)for(SZ i=s;i>=e;i--){if(xt==CHAR||yt==CHAR)r->data[p++]=CHARS[i]; else r->data[p++]=Vnn(i);} else for(SZ i=s;i<=e;i++){if(xt==CHAR||yt==CHAR)r->data[p++]=CHARS[i]; else r->data[p++]=Vnn(i);} R Vna(r);} 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){Z k=fabs(xn); Z d=fabs(yn); Ar*r=Ank(k); for(Z i=0;idata[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; Z z=strlen(s); Ar*r=Ank(z); for(Z i=0;idata[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;ival._char); S s=Bread(buf); D r=strtod(s,N); FR(s);R Vnn(r);}BR; CS CHAR:if(yt==NUM)R Vnc(yn);BR;}} R st->udf;} Vt*vprint(St*st,vt*self,Vt*x){S s=Vstr(x); fprintf(stdout,"%s",s); FR(s);R st->nil;} Vt*vprintln(St*st,vt*self,Vt*x){S s=Vstr(x); fprintf(stdout,"%s\n",s); FR(s);R st->nil;} Vt*vputch(St*st,vt*self,Vt*x){if(xt!=CHAR)R st->udf; fputc(x->val._char,stdout);R st->nil;} Vt*vexit(St*st,vt*self,Vt*x){if(xt!=NUM)R st->udf; I code=xn; exit(code);R st->nil;} Vt*vread(St*st,vt*self,Vt*x){if(x==NUMS[0]){Bt*buf=Bnew(); Z size=0; LOOP{I c=fgetc(stdin); if(c<0)BR; Bappend(buf,c);size++;} S s=Bread(buf); Ar*r=Ank(size); for(Z i=0;idata[i]=CHARS[s[i]]; FR(s);R Vna(r);} elif(x==NUMS[1])R Vnc((UC)fgetc(stdin)); elif(x==NUMS[2]){C line[512]; if(!fgets(line,SO(line),stdin))R st->udf; Z z=strlen(line); Ar*r=Ank(z); for(Z i=0;idata[i]=CHARS[line[i]];R Vna(r);} S path=Vstr(x); FILE*fd=fopen(path,"rb"); if(!fd){FR(path);R st->udf;} fseek(fd,0,SEEK_END); Z size=ftell(fd); fseek(fd,0,SEEK_SET); UC*buf=ma(size+1); size=fread(buf,SO(UC),size,fd); fclose(fd); FR(path); Ar*r=Ank(size); for(Z i=0;idata[i]=CHARS[buf[i]]; FR(buf);R Vna(r);} Vt*vwrite(St*st,vt*self,Vt*x,Vt*y){FILE*fd; S path=N; if(xt!=ARRAY)x=venlist(st,N,x); if(y==NUMS[0])fd=stderr; else{path=Vstr(y); fd=fopen(path,"wb"); if(!fd){FR(path);R NNUMS[0];}} Z k=0; for(Z i=0;itag==NUM)c=fabs(vn); elif(v->tag==CHAR)c=v->val._char; else BR; fputc(c,fd); k++;} fclose(fd); if(path)FR(path);R Vnn(k);} Vt*vsystem(St*st,vt*self,Vt*x){S cmd=Vstr(x); FILE*pd; pd=popen(cmd,"r"); if(!pd){FR(cmd);R st->udf;} UC*buffer=N; Z Bsize=0; Z Ballocated=0; Z bytes_received; UC chunk[1024]; LOOP{bytes_received=fread(chunk,1,1024,pd); if(bytes_received==0)BR; Z head=Bsize; Bsize+=bytes_received; if(Bsize>Ballocated){Ballocated=Bsize; buffer=mrea(buffer,Ballocated);} for(Z i=0;idata[i]=CHARS[buffer[i]]; FR(buffer);R Vna(r);} struct files_t{FILE*in; FILE*out;}; typedef struct files_t files_t; struct files_chain_t{files_t files; pid_t pid; struct files_chain_t*next;}; typedef struct files_chain_t files_chain_t; static files_chain_t*files_chain; V _cleanup_pipe(int*pipe){close(pipe[0]); close(pipe[1]);} static I _do_popen2(files_chain_t*link,cS command){I child_in[2]; I child_out[2]; if(0!=pipe(child_in))return-1; if(0!=pipe(child_out)){_cleanup_pipe(child_in); return-1;} pid_t cpid=link->pid=fork(); if(0>cpid){_cleanup_pipe(child_in); _cleanup_pipe(child_out); return-1;} if(0==cpid){if(0>dup2(child_in[0],0)||0>dup2(child_out[1],1))_Exit(127); _cleanup_pipe(child_in); _cleanup_pipe(child_out); for(files_chain_t*p=files_chain;p;p=p->next){I fd_in=fileno(p->files.in); if(fd_in!=0)close(fd_in); I fd_out=fileno(p->files.out); if(fd_out!=1)close(fd_out);} execl("/bin/sh","sh","-c",command,(S )N); _Exit(127);} close(child_in[0]); close(child_out[1]); link->files.in=fdopen(child_in[1],"w"); link->files.out=fdopen(child_out[0],"r");R 0;} files_t*popen2(cS command){files_chain_t*link=(files_chain_t*)malloc(SO(files_chain_t)); if(N==link)R N; if(0>_do_popen2(link,command)){free(link);R N;} link->next=files_chain; files_chain=link;R(files_t*)link;} I pclose2(files_t*fp){files_chain_t**p=&files_chain; I found=0; WH(*p){if(*p==(files_chain_t*)fp){*p=(*p)->next; found=1;BR;} p=&(*p)->next;} if(!found)return-1; if(0>fclose(fp->out)){free((files_chain_t*)fp); return-1;} I status=-1; pid_t wait_pid; do{wait_pid=waitpid(((files_chain_t*)fp)->pid,&status,0);}WH(-1==wait_pid&&EINTR==errno); free((files_chain_t*)fp); if(wait_pid==-1)return-1;R status;} Vt*vsystem2(St*st,vt*self,Vt*x,Vt*y){S cmd=Vstr(y); files_t*pd; pd=popen2(cmd); if(pd==N){FR(cmd);R st->udf;} for(Z i=0;itag==NUM)c=fabs(vn); elif(v->tag==CHAR)c=v->val._char; else BR; fputc(c,pd->in);} fflush(pd->in); fclose(pd->in); UC*buffer=N; Z Bsize=0; Z Ballocated=0; Z bytes_received; UC chunk[1024]; LOOP{bytes_received=fread(chunk,1,1024,pd->out); if(bytes_received==0)BR; Z head=Bsize; Bsize+=bytes_received; if(Bsize>Ballocated){Ballocated=Bsize; buffer=mrea(buffer,Ballocated);} for(Z i=0;iout))BR;} pclose2(pd); FR(cmd); Ar*r=Ank(Bsize); for(Z i=0;idata[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;} Vt*vxor(St*st,vt*self,Vt*x,Vt*y){if(xt==NUM&&yt==NUM)R Vnn(((int)xn)^((int)yn));R _NAN;} Vt*vband(St*st,vt*self,Vt*x,Vt*y){if(xt==NUM&&yt==NUM)R Vnn(((int)xn)&((int)yn));R _NAN;} Ar*find_primes(U64 limit){B sieve[limit+1]; for(U64 i=0;i<=limit;i++)sieve[i]=F; if(limit>2)sieve[2]=T; if(limit>3)sieve[3]=T; for(U64 x=1;x*x<=limit;x++)for(U64 y=1;y*y<=limit;y++){U64 n=(4*x*x)+(y*y); if(n<=limit&&(n%12==1||n%12==5))sieve[n]^=T; n=(3*x*x)+(y*y); if(n<=limit&&n%12==7)sieve[n]^=T; n=(3*x*x)-(y*y); if(x>y&&n<=limit&&n%12==11)sieve[n]^=T;} for(U64 r=5;r*r<=limit;r++)if(sieve[r])for(I i=r*r;i<=limit;i+=r*r)sieve[i]=F; Ar*r=An(); for(U64 a=1;a<=limit;a++)if(sieve[a])Ap(r,Vnn(a));R r;} Vt*vprimes(St*st,vt*self,Vt*x){if(xt==NUM&&!spnp(xn))R Vna(find_primes(fabs(xn)+1));R st->udf;} Vt*vparts(St*st,vt*self,Vt*x,Vt*y){if(xt!=NUM)R st->udf; if(yt!=ARRAY)y=venlist(st,N,y); elif(!yad)R y; if(spnp(xn)||xn<1)R y; Z np=fabs(xn); 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);} 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(); D divisor=2; WH(n>=2){if(fmod(n,divisor)==0){Ap(factors,Vnn(divisor)); n/=divisor;}else divisor++;} R factors;} Vt*vfactors(St*st,vt*self,Vt*x){if(xt==NUM&&!spnp(xn))R Vna(prime_factors(xn));R st->udf;} Vt*vcombine(St*st,vt*self,Vt*x,Vt*y){if(xt==NUM&&yt==NUM&&!spnp(xn)&&!spnp(yn)){x=vbase(st,N,NUMS[10],x); y=vbase(st,N,NUMS[10],y); Vt*n=vjoin(st,N,x,y);R vunbase(st,N,NUMS[10],n);} R _NAN;} Vt*voutof(St*st,vt*self,Vt*x,Vt*y){if(xt==NUM&&yt==NUM&&!spnp(xn)&&!spnp(yn)){U64 a=(U64)fabs(xn); U64 b=(U64)fabs(yn); if(a==0)R NUMS[1]; if(b==0)R NUMS[0];R Vnn(factorial(b)/(factorial(a)*(a>=b?1:factorial(b-a))));} R _NAN;} Vt*vsort(St*st,vt*self,Vt*x){Vt*i=vgradeup(st,N,x);R tgth(st,st->at,x,i,0,0,st->at->rank[1],st->at->rank[2]);} Vt*vunsort(St*st,vt*self,Vt*x){Vt*i=vgradedown(st,N,x);R tgth(st,st->at,x,i,0,0,st->at->rank[1],st->at->rank[2]);} Vt*Srun(St*st,S program); Vt*veval(St*st,vt*self,Vt*x){S s=Vstr(x); jmp_buf*lb=guard(); if(setjmp(*lb)){unguard(); FR(s);R st->udf;} Vt*v=Srun(st,s); FR(s); unguard();R v;} V jkexec(St*st,FILE*fd,B isrepl,S*s); Vt*vimport(St*st,vt*self,Vt*x){S path=Vstr(x); FILE*fd=fopen(path,"rb"); if(!fd){FR(path);R st->udf;} S s=N; jkexec(st,fd,F,&s); if(s)FR(s); fclose(fd); FR(path);R st->nil;} Vt*vforeign(St*st,vt*self,Vt*x,Vt*y){if(xt!=ARRAY)x=venlist(st,N,x); S pth=Vstr(y); S lib; S sig; S fun; lib=strtok(pth,":"); if(!lib)R st->udf; sig=strtok(N,":"); if(!sig)R st->udf; fun=strtok(N,":"); if(!fun)R st->udf; Z argc=strlen(sig); if(argc<1)R st->udf; argc--; if(argc!=xal)R st->udf; ffi_cif cif; ffi_type*ret; ffi_type*args[argc]; P values[argc]; P pool[argc]; Z fc=0; P retv=N; C rett; Z retvsz=0; for(I i=0;itag!=NUM)goto cleanup; _pv=(P )(Z)fabs(vt->val.number); pool[i-1]=ma(SO(P )); memcpy(pool[i-1],&_pv,SO(P )); v=pool[i-1]; fc++;}BR; CS 'i':{I _iv; Vt*vt=xad[i-1]; if(vt->tag!=NUM)goto cleanup; _iv=(int)vt->val.number; pool[i-1]=ma(SO(int)); memcpy(pool[i-1],&_iv,SO(int)); v=pool[i-1]; fc++;}BR; CS 'l':{long _lv; Vt*_vt=xad[i-1]; if(_vt->tag!=NUM)goto cleanup; _lv=(long)_vt->val.number; pool[i-1]=ma(SO(long)); memcpy(pool[i-1],&_lv,SO(long)); v=pool[i-1]; fc++;}BR; CS 'f':{float _fv; Vt*_vt=xad[i-1]; if(_vt->tag!=NUM)goto cleanup; _fv=(float)_vt->val.number; pool[i-1]=ma(SO(float)); memcpy(pool[i-1],&_fv,SO(float)); v=pool[i-1]; fc++;}BR; CS 'd':{D _dv; Vt*_vt=xad[i-1]; if(_vt->tag!=NUM)goto cleanup; _dv=(D)_vt->val.number; pool[i-1]=ma(SO(D)); memcpy(pool[i-1],&_dv,SO(D)); v=pool[i-1]; fc++;}BR; CS 'c':{UC _cv; Vt*_vt=xad[i-1]; if(_vt->tag!=CHAR)goto cleanup; _cv=(UC)_vt->val._char; pool[i-1]=ma(SO(UC)); memcpy(pool[i-1],&_cv,SO(UC)); v=pool[i-1]; fc++;}BR;} args[i-1]=t; values[i-1]=v;}} P dlh=dlopen(lib,RTLD_LAZY); if(!dlh)goto cleanup; P exfn=dlsym(dlh,fun); S e=dlerror(); if(!exfn||e)goto cleanup; if(ffi_prep_cif(&cif,FFI_DEFAULT_ABI,argc,ret,args)!=FFI_OK)goto cleanup; if(retvsz)retv=ma(retvsz); ffi_call(&cif,exfn,retv,values); dlclose(dlh); Vt*rv=st->nil; SW(rett){CS 'v':BR; CS '$':{S s=*(S*)retv; Z z=strlen(s); Ar*l=Ank(z); for(Z i=0;idata[i]=CHARS[s[i]]; rv=Vna(l);}BR; CS '@':{S s=*(S*)retv; Z z=strlen(s); Ar*l=Ank(z); for(Z i=0;idata[i]=CHARS[s[i]]; rv=Vna(l); free(s);}BR; CS 'p':rv=Vnn((Z)*(P*)retv);BR; CS 'i':rv=Vnn(*(int*)retv);BR; CS 'l':rv=Vnn(*(long*)retv);BR; CS 'f':rv=Vnn(*(float*)retv);BR; CS 'd':rv=Vnn(*(D*)retv);BR; CS 'c':rv=Vnc(*(UC*)retv);BR;} FR(retv); for(Z i=0;iudf;} Vt*vexplode(St*st,vt*self,Vt*x,Vt*y){S del=Vshow(x); S s=Vstr(y); Z dell=strlen(del); Z sl=strlen(s); Ar*r=An(); Ar*t=An(); for(Z i=0;idata[0]=x; for(Z i=0;idata[i+1]=yad[i];R Vna(r);} Vt*vtackright(St*st,vt*self,Vt*x,Vt*y){if(yt!=ARRAY)y=venlist(st,N,y); Ar*r=Ank(yal+1); for(Z i=0;idata[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=Ank(k); for(Z i=0;idata[j]=NUMS[i==j]; r->data[i]=Vna(rw);} R Vna(r);} R st->udf;} Vt*vinfix(St*st,vt*self,Vt*x){R vbehead(st,N,vprefixes(st,N,x));} Vt*vvalue(St*st,vt*self,Vt*x){S s=Vstr(x); Vt*r=Tget(st->env,s); FR(s);R r?r:st->udf;} Vt*vudf1(St*st,vt*self,Vt*x){R st->udf;} Vt*vudf2(St*st,vt*self,Vt*x,Vt*y){R st->udf;} #define X UINT_MAX #define DEFVERB(__symb,__rm,__rl,__rr,__m,__d){__symb,{__rm,__rl,__rr},N,F,F,v##__m,v##__d} #define DEFVERBD(__symb,__rm,__rl,__rr,__m,__d){__symb ".",{__rm,__rl,__rr},N,F,F,v##__m,v##__d} #define DEFVERBC(__symb,__rm,__rl,__rr,__m,__d){__symb ":",{__rm,__rl,__rr},N,F,F,v##__m,v##__d} vt VERBS[]={DEFVERB(":",0,0,0,const,bind),DEFVERBC(":",X,0,0,unbind,obverse),DEFVERB("+",0,X,X,flip,plus),DEFVERBD("+",X,X,X,fibonacci,gcd),DEFVERBC("+",X,X,X,sin,combine),DEFVERB("-",X,X,X,negate,minus),DEFVERBD("-",X,X,X,atan,atan2),DEFVERB("*",0,X,X,first,times),DEFVERBD("*",X,X,X,factorial,lcm),DEFVERBC("*",X,X,0,double,replicate),DEFVERB("%",X,X,X,reciprocal,divide),DEFVERBD("%",X,X,X,sqrt,root),DEFVERBC("%",X,X,X,halve,idivide),DEFVERB("!",X,X,X,enum,mod),DEFVERBD("!",X,X,X,iota,range),DEFVERBC("!",0,X,0,odometer,chunks),DEFVERB("^",X,X,X,exp,power),DEFVERBD("^",X,X,X,nlog,log),DEFVERB("=",0,X,X,permute,equals),DEFVERBD("=",0,0,0,occurences,mask),DEFVERBC("=",0,0,0,classify,equals),DEFVERB("~",X,X,X,not,not_equals),DEFVERBD("~",X,0,0,sign,insert),DEFVERBC("~",0,0,0,not,not_equals),DEFVERB("<",X,X,X,pred,less),DEFVERBD("<",X,X,X,floor,lesseq),DEFVERBC("<",0,X,0,gradedown,nudge_left),DEFVERB(">",X,X,X,succ,greater),DEFVERBD(">",X,X,X,ceil,greatereq),DEFVERBC(">",0,X,0,gradeup,nudge_right),DEFVERB(",",0,0,0,enlist,join),DEFVERBD(",",X,0,0,enlist,enpair),DEFVERB("#",0,X,0,count,take),DEFVERBD("#",0,0,0,where,copy),DEFVERBC("#",0,0,0,group,buckets),DEFVERB("_",0,X,0,nub,drop),DEFVERBD("_",0,X,0,unbits,unbase),DEFVERBC("_",X,X,X,bits,base),DEFVERB("?",0,0,0,unique,find),DEFVERB("&",0,X,X,flatten,minand),DEFVERB("|",0,X,X,reverse,maxor),DEFVERBD("|",X,X,0,round,rotate),DEFVERBC("|",0,X,0,depth,windows),DEFVERB("@",X,0,X,abs,at),DEFVERBD("@",0,0,0,shuffle,member),DEFVERBC("@",0,0,0,infix,indexof),DEFVERB("{",0,0,0,head,bin),DEFVERBD("{",0,0,0,tail,cut),DEFVERBC("{",0,X,X,prefixes,shl),DEFVERB("}",0,X,X,behead,xor),DEFVERBD("}",0,0,0,curtail,band),DEFVERBC("}",0,X,X,suffixes,shr),DEFVERB("[",X,0,0,factors,left),DEFVERBD("[",X,X,X,bnot,bor),DEFVERBC("[",X,X,0,primes,parts),DEFVERB("]",0,0,0,same,right),DEFVERBD("]",0,X,X,sort,outof),DEFVERBC("]",0,0,0,unsort,explode),DEFVERBD("`",0,0,0,symbol,apply1),DEFVERBC("`",0,0,0,square,apply2),DEFVERB("$",0,0,0,shape,reshape),DEFVERBD("$",0,0,0,repr,format),DEFVERBC("$",X,0,0,eye,implode),DEFVERBD("p",0,0,0,print,udf2),DEFVERBD("P",0,0,0,println,udf2),DEFVERBD("c",X,0,0,putch,udf2),DEFVERBD("s",0,0,0,selfref1,selfref2),DEFVERBD("F",0,0,0,read,write),DEFVERBD("r",0,X,X,deal,roll),DEFVERBD("t",0,0,0,type,cast),DEFVERBD("E",0,0,0,exit,udf2),DEFVERBD("y",0,0,0,system,system2),DEFVERBD("e",0,0,0,eval,udf2),DEFVERBD("i",0,0,0,import,foreign),DEFVERBD("L",0,0,0,udf1,tackleft),DEFVERBD("R",0,0,0,udf1,tackright),DEFVERBD("v",0,0,0,value,udf2)}; Vt*_advfold_m(St*st,vt*self,Vt*x){if(xt!=ARRAY||!xad)R x; Vt*_v=self->bonds->data[0]; if(_v->tag!=VERB)R st->udf; vt*v=_v->val.verb; Vt*t=xad[0]; Ar*tx=xa; for(Z i=1;ilength;i++)t=tgth(st,v,t,tx->data[i],0,0,v->rank[1],v->rank[2]);R t;} Vt*_advfold_d(St*st,vt*self,Vt*x,Vt*y){if(yt!=ARRAY)y=venlist(st,N,y); elif(!yad)R x; Vt*_v=self->bonds->data[0]; if(_v->tag!=VERB)R st->udf; vt*v=_v->val.verb; Vt*t=x; Ar*ty=ya; for(Z i=0;ilength;i++)t=tgth(st,v,t,ty->data[i],0,0,v->rank[1],v->rank[2]);R t;} Vt*_advscan_m(St*st,vt*self,Vt*x){if(xt!=ARRAY||!xad)R x; Vt*_v=self->bonds->data[0]; if(_v->tag!=VERB)R st->udf; vt*v=_v->val.verb; Ar*r=An(); Vt*t=xad[0]; Ar*tx=xa; Ap(r,t); for(Z i=1;ilength;i++){t=tgth(st,v,t,tx->data[i],0,0,v->rank[1],v->rank[2]); Ap(r,t);} R Vna(r);} Vt*_advscan_d(St*st,vt*self,Vt*x,Vt*y){if(yt!=ARRAY||!yad)R y; Vt*_v=self->bonds->data[0]; if(_v->tag!=VERB)R st->udf; vt*v=_v->val.verb; Ar*r=An(); Vt*t=x; Ar*ty=ya; Ap(r,t); for(Z i=1;ilength;i++){t=tgth(st,v,t,ty->data[i],0,0,v->rank[1],v->rank[2]); Ap(r,t);} R Vna(r);} Vt*_adveach_m(St*st,vt*self,Vt*x){Vt*_v=self->bonds->data[0]; if(_v->tag!=VERB)R st->udf; vt*v=_v->val.verb; if(xt!=ARRAY)R eR(st,v,x,0,1); if(!xad)R x;R eR(st,v,x,0,1);} Vt*_adveach_d(St*st,vt*self,Vt*x,Vt*y){Vt*_v=self->bonds->data[0]; if(_v->tag!=VERB)R st->udf; vt*v=_v->val.verb; if(xt!=ARRAY)x=venlist(st,N,x); if(yt!=ARRAY)y=venlist(st,N,y); Ar*r=An(); Ar*tx=xa; Ar*ty=ya; for(Z i=0;ilength&&ilength;i++)Ap(r,tgth(st,v,tx->data[i],ty->data[i],0,0,v->rank[1],v->rank[2]));R Vna(r);} Vt*_advconverge_m(St*st,vt*self,Vt*x){Vt*_v=self->bonds->data[0]; if(_v->tag!=VERB)R st->udf; vt*v=_v->val.verb; Vt*t; LOOP{t=x; x=eR(st,v,x,0,v->rank[0]); if(Veq(x,t))BR;} R x;} vt*cnjbond(St*st,Vt*x,Vt*y); Vt*_advconverge_d(St*st,vt*self,Vt*x,Vt*y){Vt*_v=self->bonds->data[0]; if(_v->tag!=VERB)R st->udf; vt*v=_v->val.verb; if(yt!=ARRAY)R tgth(st,v,y,x,0,0,v->rank[1],v->rank[2]); if(!yad)R x; v=cnjbond(st,Vnv(v),x);R eR(st,v,y,0,1);} Vt*_advconverges_m(St*st,vt*self,Vt*x){Vt*_v=self->bonds->data[0]; if(_v->tag!=VERB)R st->udf; Ar*r=An(); Vt*t; Ap(r,x); LOOP{t=x; x=apM(st,_v,x); if(Veq(x,t))BR; Ap(r,x);} R Vna(r);} Vt*_advconverges_d(St*st,vt*self,Vt*x,Vt*y){Vt*_v=self->bonds->data[0]; if(_v->tag!=VERB)R st->udf; vt*v=_v->val.verb; if(yt!=ARRAY)R tgth(st,v,y,x,0,0,v->rank[1],v->rank[2]); if(!yad)R x; v=cnjbond(st,x,Vnv(v));R eR(st,v,y,0,1);} Vt*_adveachprior_m(St*st,vt*self,Vt*x){if(xt!=ARRAY||xal<2)R x; Vt*_v=self->bonds->data[0]; if(_v->tag!=VERB)R st->udf; vt*v=_v->val.verb; Ar*r=An(); for(Z i=1;irank[1],v->rank[2]));R Vna(r);} Vt*_adveachprior_d(St*st,vt*self,Vt*x,Vt*y){if(yt!=ARRAY||!yad)R y; Vt*_v=self->bonds->data[0]; if(_v->tag!=VERB)R st->udf; vt*v=_v->val.verb; Ar*r=An(); for(Z i=0;irank[1],v->rank[2]));R Vna(r);} Vt*_advreflex_m(St*st,vt*self,Vt*x){Vt*_v=self->bonds->data[0]; if(_v->tag!=VERB)R st->udf; vt*v=_v->val.verb;R tgth(st,v,x,x,0,0,v->rank[1],v->rank[2]);} Vt*_advreflex_d(St*st,vt*self,Vt*x,Vt*y){Vt*_v=self->bonds->data[0]; if(_v->tag!=VERB)R st->udf; vt*v=_v->val.verb;R tgth(st,v,y,x,0,0,v->rank[1],v->rank[2]);} Vt*_advamend_m(St*st,vt*self,Vt*x){R st->udf;} Vt*_advamend_d(St*st,vt*self,Vt*x,Vt*y){if(xt!=ARRAY)x=venlist(st,N,x); Vt*v=self->bonds->data[0]; if(v->tag!=ARRAY)v=venlist(st,N,v); if(yt!=ARRAY)y=venlist(st,N,y); Ar*r=Ac(ya); Z l=xal; Ar*t=v->val.array; for(Z i=0;ilength;i++){Vt*n=t->data[i]; if(n->tag!=NUM)BR; As(r,n->val.number,Ai(xa,ibonds->data[0]; if(_v->tag!=VERB)R st->udf; if(xt!=ARRAY)x=venlist(st,N,x); elif(!xad)R x; vt*v=_v->val.verb; Ar*r=An(); for(Z i=0;irank[0]); if(VTp(b))Ap(r,xad[i]);} R Vna(r);} Vt*_advfilter_d(St*st,vt*self,Vt*x,Vt*y){R st->udf;} Vt*_advspan_m(St*st,vt*self,Vt*x){Vt*v=self->bonds->data[0]; if(v->tag!=VERB)R st->udf; if(xt!=ARRAY)x=venlist(st,N,x); elif(!xad)R x; Ar*r=An(); Ar*p=An(); for(Z i=0;ibonds->data[0]; if(_v->tag!=VERB)R st->udf; vt*v=_v->val.verb; Vt*r=vwindows(st,N,x,y);R eR(st,v,r,0,1);} Vt*_advinverse_m(St*st,vt*self,Vt*x){Vt*_v=self->bonds->data[0]; if(_v->tag!=VERB)R st->udf; vt*v=_v->val.verb; vt*iv=Tget(Inverses,v->name); if(!iv)R st->udf;R eR(st,iv,x,0,iv->rank[0]);} Vt*_advinverse_d(St*st,vt*self,Vt*x,Vt*y){Vt*_v=self->bonds->data[0]; if(_v->tag!=VERB)R st->udf; vt*v=_v->val.verb; vt*iv=Tget(Inverses,v->name); if(!iv)R st->udf; Vt*a=eR(st,iv,x,0,iv->rank[0]); Vt*b=eR(st,iv,y,0,iv->rank[0]);R apD(st,_v,a,b);} #define ADVERB(__name,__symb)\ vt*adv##__name(St*st,Vt*v){\ vt*nv=vnew();\ nv->bonds=Ank(1);\ nv->bonds->data[0]=v;\ S r=Vshow(v);\ Z l=strlen(r)+strlen(__symb)+1;\ nv->name=ma(l);\ snprintf(nv->name,l,"%s" __symb,r);\ FR(r);\ nv->rank[0]=0;\ nv->monad=_adv##__name##_m;\ nv->dyad=_adv##__name##_d;\ R nv;} ADVERB(fold,"/"); ADVERB(converge,"/."); ADVERB(scan,"\\"); ADVERB(converges,"\\."); ADVERB(each,"\""); ADVERB(eachprior,"\"."); ADVERB(reflex,";."); ADVERB(amend,"`"); ADVERB(filter,"&."); ADVERB(span,"/:"); ADVERB(inverse,"-:"); advt ADVERBS[]={{"/",advfold,N}, {"/.",advconverge,N},{"\\",advscan,N}, {"\\.",advconverges,N},{"\"",adveach,N}, {"\".",adveachprior,N},{";.",advreflex,N},{"`",advamend,N},{"&.",advfilter,N},{"/:",advspan,N},{"-:",advinverse,N}}; Vt*_cnjbond_m(St*st,vt*self,Vt*x){Vt*v1=self->bonds->data[0]; Vt*v2=self->bonds->data[1]; if(v1->tag==VERB&&v2->tag==VERB)R apM(st,v1,apM(st,v2,x)); elif(v1->tag==VERB)R apD(st,v1,x,v2); elif(v2->tag==VERB)R apD(st,v2,v1,x); else R st->udf;} Vt*_cnjbond_d(St*st,vt*self,Vt*x,Vt*y){Vt*v1=self->bonds->data[0]; Vt*v2=self->bonds->data[1]; if(v1->tag==VERB&&v2->tag==VERB)R apM(st,v1,apD(st,v2,x,y)); elif(v1->tag==VERB)R apD(st,v1,apD(st,v1,x,y),v2); elif(v2->tag==VERB)R apD(st,v2,v1,apD(st,v2,x,y)); else R st->udf;} Vt*_cnjpick_m(St*st,vt*self,Vt*x){Vt*v1=self->bonds->data[0]; Vt*v2=self->bonds->data[1]; if(v1->tag!=VERB||v2->tag!=ARRAY)R st->udf; Vt*n=apM(st,v1,x); Vt*f=vat(st,N,v2,n);R apM(st,f,x);} Vt*_cnjpick_d(St*st,vt*self,Vt*x,Vt*y){Vt*v1=self->bonds->data[0]; Vt*v2=self->bonds->data[1]; if(v1->tag!=VERB||v2->tag!=ARRAY)R st->udf; Vt*n=apD(st,v1,x,y); Vt*f=vat(st,N,v2,n);R apD(st,f,x,y);} Vt*_cnjwhile_m(St*st,vt*self,Vt*x){Vt*v1=self->bonds->data[0]; Vt*v2=self->bonds->data[1]; if(v1->tag==VERB){LOOP{if(!VTp(apM(st,v1,x)))BR; x=apM(st,v2,x);}}elif(v1->tag==NUM){Z k=(Z)fabs(v1->val.number); for(Z i=0;ibonds->data[0]; Vt*v2=self->bonds->data[1]; if(v1->tag==VERB){LOOP{if(!VTp(apD(st,v1,x,y)))BR; x=apD(st,v2,x,y);}}elif(v1->tag==NUM){Z k=(Z)fabs(v1->val.number); for(Z i=0;ibonds->data[0]; Vt*v2=self->bonds->data[1]; if(v1->tag!=VERB||v2->tag!=NUM)R st->udf; UI rank= v2->val.number==INFINITY?UINT_MAX:fabs(v2->val.number);R eR(st,v1->val.verb,x,0,rank);} Vt*_cnjrank_d(St*st,vt*self,Vt*x,Vt*y){Vt*v1=self->bonds->data[0]; Vt*v2=self->bonds->data[1]; if(v1->tag!=VERB)R st->udf; UI rl; UI rr; if(v2->tag==NUM)rl=rr=v2->val.number==INFINITY?UINT_MAX:fabs(v2->val.number); elif(v2->tag==ARRAY&&v2->val.array->length==2){Vt*a=v2->val.array->data[0]; Vt*b=v2->val.array->data[1]; if(a->tag!=NUM)R st->udf; rl=a->val.number==INFINITY?UINT_MAX:fabs(a->val.number); if(b->tag!=NUM)R st->udf; rr=b->val.number==INFINITY?UINT_MAX:fabs(b->val.number);} else R st->udf;R tgth(st,v1->val.verb,x,y,0,0,rl,rr);} Vt*_cnjmonaddyad_m(St*st,vt*self,Vt*x){Vt*v=self->bonds->data[0]; if(v->tag!=VERB)R st->udf;R eR(st,v->val.verb,x,0,v->val.verb->rank[0]);} Vt*_cnjmonaddyad_d(St*st,vt*self,Vt*x,Vt*y){Vt*v=self->bonds->data[1]; if(v->tag!=VERB)R st->udf;R tgth(st,v->val.verb,x,y,0,0,v->val.verb->rank[1],v->val.verb->rank[2]);} Vt*_cnjif_m(St*st,vt*self,Vt*x){Vt*v1=self->bonds->data[0]; Vt*v2=self->bonds->data[1]; if(v1->tag!=VERB||v2->tag!=VERB)R st->udf; Vt*b=apM(st,v2,x); if(VTp(b))R x;R apM(st,v1,x);} Vt*_cnjif_d(St*st,vt*self,Vt*x,Vt*y){Vt*v1=self->bonds->data[0]; Vt*v2=self->bonds->data[1]; if(v1->tag!=VERB||v2->tag!=VERB)R st->udf; Vt*b=apD(st,v2,x,y); if(VTp(b))R y;R apD(st,v1,x,y);} Vt*_cnjunder_m(St*st,vt*self,Vt*x){Vt*v1=self->bonds->data[0]; Vt*v2=self->bonds->data[1]; if(v1->tag!=VERB||v2->tag!=VERB)R st->udf; vt*iv=Tget(Inverses,v2->val.verb->name); if(!iv)R st->udf; Vt*v=apM(st,v2,x); v=apM(st,v1,v);R eR(st,iv,v,0,iv->rank[0]);} Vt*_cnjunder_d(St*st,vt*self,Vt*x,Vt*y){Vt*v1=self->bonds->data[0]; Vt*v2=self->bonds->data[1]; if(v1->tag!=VERB||v2->tag!=VERB)R st->udf; vt*iv=Tget(Inverses,v2->val.verb->name); if(!iv)R st->udf; Vt*a=apM(st,v2,x); Vt*b=apM(st,v2,y); Vt*v=apD(st,v1,a,b);R eR(st,iv,v,0,iv->rank[0]);} #define CONJUNCTION(__name,__symb)\ vt*cnj##__name(St*st,Vt*x,Vt*y){\ vt*nv=vnew();\ 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;\ nv->name=ma(l);\ snprintf(nv->name,l,"%s"__symb"%s",rx,ry);\ FR(rx);\ FR(ry);\ nv->rank[0]=0;\ nv->rank[1]=0;\ nv->rank[1]=0;\ nv->monad=_cnj##__name##_m;\ nv->dyad=_cnj##__name##_d;\ R nv;} CONJUNCTION(bond,";"); CONJUNCTION(pick,"?."); CONJUNCTION(while,"?:"); CONJUNCTION(rank,"\":"); CONJUNCTION(monaddyad,";:"); CONJUNCTION(if,"&:"); CONJUNCTION(under,"^:"); advt CONJUNCTIONS[]={{";",N,cnjbond},{"?.",N,cnjpick},{"?:",N,cnjwhile},{"\":",N,cnjrank},{";:",N,cnjmonaddyad},{"&:",N,cnjif},{"^:",N,cnjunder}}; #define FINDER(kind,rname,table)\ kind*G##rname(S s){\ for(Z i=0;itag=tag;R node;} Nt*Nns(Ar*l){Nt*node=ma(SO(Nt)); node->tag=N_STRAND; node->l=l;R node;} Nt*Nnl(Vt*v){Nt*node=ma(SO(Nt)); node->tag=N_LITERAL; node->v=v;R node;} Nt*Nn1(enum Ntag_t tag,Nt*a){Nt*node=ma(SO(Nt)); node->tag=tag; node->a=a;R node;} Nt*Nn2(enum Ntag_t tag,Nt*a,Nt*b){Nt*node=ma(SO(Nt)); node->tag=tag; node->a=a; node->b=b;R node;} Nt*Nn3(enum Ntag_t tag,Nt*a,Nt*b,Nt*c){Nt*node=ma(SO(Nt)); node->tag=tag; node->a=a; node->b=b; node->c=c;R node;} typedef struct{Lt*lexer; St*st; Z pos; Z end; Z dp; B bn;}Pt; Pt*Pnew(St*state){Pt*parser=ma(SO(Pt)); parser->st=state;R parser;} V Perror(Pt*parser,S s){fatal(s);} B Pdone(Pt*parser){R parser->pos>=parser->end;} Tkt*Plook(Pt*parser,Z offset){Z pos=parser->pos+offset; if(pos>=parser->end)R N;R Ai(parser->lexer->tokens,pos);} B Pstop(Pt*parser){Tkt*tok=Plook(parser,0); if(!tok)R T;R tok->tag==T_RPAR;} V Peat(Pt*parser){if(!Pdone(parser))parser->pos++;} Nt*PPexpr(Pt*parser); Nt*PPverb(Pt*parser){Tkt*tok=Plook(parser,0); if(!tok||tok->tag!=T_PUNCT)R N; 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->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->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; advt*adverb=Gadv(tok->text); if(!adverb)R N; vt*nv=vnew(); nv->name=sdup(tok->text); nv->bonds=Ank(1); nv->bonds->data[0]=adverb; nv->rank[0]=0; nv->rank[1]=0; nv->rank[2]=0; nv->monad=_advwrapper_m; nv->dyad=_advwrapper_d;R Nnl(Vnv(nv));} Vt*_cnjwrapper_d(St*st,vt*self,Vt*x,Vt*y){advt*av=self->bonds->data[0];R Vnv(av->conjunction(st,x,y));} Nt*PPcnjatom(Pt*parser){Tkt*tok=Plook(parser,0); if(!tok||tok->tag!=T_PUNCT)R N; advt*adverb=Gcnj(tok->text); if(!adverb)R N; vt*nv=vnew(); nv->name=sdup(tok->text); nv->bonds=Ank(1); nv->bonds->data[0]=adverb; nv->rank[0]=0; nv->rank[1]=0; nv->rank[2]=0; nv->monad=N; nv->dyad=_cnjwrapper_d;R Nnl(Vnv(nv));} Nt*PPatom(Pt*parser){Tkt*tok=Plook(parser,0); Nt*node=N; SW(tok->tag){CS T_RPAR:Perror(parser,"unmatched"); CS T_LPAR:Peat(parser); tok=Plook(parser,0); if(tok&&tok->tag==T_RPAR){node=Nnl(parser->st->unit);BR;} parser->dp++; node=PPexpr(parser); if(parser->bn)node->dp=2; else node->dp=parser->dp; parser->dp--; tok=Plook(parser,0); if(!tok||tok->tag!=T_RPAR)Perror(parser,"unmatched");BR; CS T_PUNCT:node=PPverb(parser); if(!node)node=PPadvatom(parser); if(!node)node=PPcnjatom(parser); if(!node)Perror(parser,"parse");BR; CS T_NUM:node=Nnl(Vnn(strtod(tok->text,N)));BR; CS T_BNUM:{if(!tok->text[1])Perror(parser,"trailing-base"); I base=tok->text[0]=='x'?16:tok->text[0]=='b'?2:8; node=Nnl(Vnn(strtol(tok->text+1,N,base)));}BR; 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{Z z=strlen(tok->text); Ar*r=Ank(z); for(Z i=0;idata[i]=CHARS[tok->text[i]]; node=Nnl(Vna(r));}BR;} if(!node)Perror(parser,"parse"); Peat(parser);R node;} B isunb(St*st,S s){if(st->args->data){Ar*args=Ai(st->args,-1); Z argc=args->length-1; if(argc==2&&strcmp(s,"y")==0)R F; elif(strcmp(s,"x")==0)R F;} elif(Thas(st->env,s))R F;R T;} Nt*PPa(Pt*parser,Nt*a,enum Tkt tag){Tkt*tok; if((tok=Plook(parser,0))&&(tok->tag==tag||(tag==T_NUM&&tok->tag==T_BNUM))){if(tag==T_NAME&&!isunb(parser->st,tok->text))R N; Ar*as=An(); Ap(as,a->v); do{if(tag==T_NAME&&tok->tag==T_NAME&&!isunb(parser->st,tok->text))BR; a=PPatom(parser); Ap(as,a->v);}WH((tok=Plook(parser,0))&&(tok->tag==tag||(tag==T_NUM&&tok->tag==T_BNUM)));R Nnl(Vna(as));} R N;} Nt*_PPnoun(Pt*parser){Nt*n; Nt*a=PPatom(parser); if(a->tag==N_LITERAL&&a->v->tag==NUM&&(n=PPa(parser,a,T_NUM)))R n; elif(a->tag==N_LITERAL&&a->v->tag==SYM&&isunb(parser->st,a->v->val.symbol)&&(n=PPa(parser,a,T_NAME)))R n; elif(a->tag==N_LITERAL&&((a->v->tag==ARRAY&&Cap(a->v->val.array))||a->v->tag==CHAR)&&(n=PPa(parser,a,T_QUOTE)))R n;R a;} Nt*PPnoun(Pt*parser,B flat){Nt*a=flat?PPatom(parser):_PPnoun(parser); Tkt*tok; if((tok=Plook(parser,0))&&tok->tag==T_PUNCT&&strcmp(tok->text,",:")==0){Peat(parser); Ar*l=An(); Ap(l,a); LOOP{if(Pstop(parser))Perror(parser,"trailing-strand"); a=flat?PPatom(parser):_PPnoun(parser); Ap(l,a); if(!((tok=Plook(parser,0))&&tok->tag==T_PUNCT&&strcmp(tok->text,",:")==0))BR; Peat(parser);} R Nns(l);} R a;} B Nisv(Pt*parser,Nt*n){Vt*v; if(n->tag==N_FUN)R T; elif(n->tag==N_ADV||n->tag==N_CONJ||n->tag==N_PARTIAL_CONJ)R T; elif(n->tag==N_FORK||n->tag==N_HOOK||n->tag==N_BOND||n->tag==N_OVER)R T; elif(n->tag==N_LITERAL&&n->v->tag==VERB)R T; elif(n->tag==N_LITERAL&&n->v->tag==SYM&&(v=Tget(parser->st->env,n->v->val.symbol))&&v->tag==VERB)R T;R F;} Nt*PPadv(Pt*parser,Nt*v,bool*flag){Tkt*tok; advt*adv; Nt*t; LOOP{tok=Plook(parser,0); if(!tok||tok->tag!=T_PUNCT)BR; if((adv=Gadv(tok->text))){if(flag)*flag=T; Peat(parser); t=Nn(N_ADV); t->av=adv; t->a=v; v=t;}else BR;} R v;} Nt*PPcnj(Pt*parser,Nt*v,bool*flag){Tkt*tok; advt*adv; Nt*t; LOOP{tok=Plook(parser,0); if(!tok||tok->tag!=T_PUNCT)BR; if((adv=Gcnj(tok->text))){if(flag)*flag=T; Peat(parser); if(Pstop(parser)){t=Nn(N_PARTIAL_CONJ); t->av=adv; t->a=v;}else{t=Nn(N_CONJ); t->av=adv; t->a=v; t->b=PPnoun(parser,T);} v=t;}else BR;} R v;} B is_apply(Nt*n){R n->tag==N_LITERAL&&n->v->tag==VERB&&(strcmp(n->v->val.verb->name,"`.")==0||strcmp(n->v->val.verb->name,"`:")==0);} B is_obverse(Nt*n){R n->tag==N_LITERAL&&n->v->tag==VERB&&strcmp(n->v->val.verb->name,"::")==0;} Nt*PPexpr(Pt*parser){Tkt*tmp; Ar*ns=An(); WH(!Pstop(parser)){if(!ns->data&&(tmp=Plook(parser,0))&&tmp->tag==T_PUNCT&&strcmp(tmp->text,":")==0){Peat(parser); Nt*r=PPexpr(parser); if(!r)r=Nnl(parser->st->nil);R Nn1(N_FUN,r);} Nt*n=PPnoun(parser,F); if(!ns->data&&n->tag==N_LITERAL&&n->v->tag==SYM&&(tmp=Plook(parser,0))&&tmp->tag==T_PUNCT&&strcmp(tmp->text,":")==0){Peat(parser); B t=parser->bn; parser->bn=T; Nt*r=PPexpr(parser); parser->bn=t;R Nn2(N_BIND,n,r);} LOOP{B flag=F; n=PPadv(parser,n,&flag); n=PPcnj(parser,n,&flag); if(!flag)BR;} Ap(ns,n);} Z len; Nt*l,*m,*r; LOOP{len=ns->length; if(len<2)BR; if(len>=3&&(is_apply(Ai(ns,-2))||is_obverse(Ai(ns,-2)))&&Nisv(parser,Ai(ns,-1))){r=AP(ns); m=AP(ns); l=AP(ns); Ap(ns,Nn3(N_DYAD,m,l,r));}elif(len>=3&&!Nisv(parser,Ai(ns,-1))&&Nisv(parser,Ai(ns,-2))&&!Nisv(parser,Ai(ns,-3))){r=AP(ns); m=AP(ns); l=AP(ns); Ap(ns,Nn3(N_DYAD,m,l,r));}elif(len>=3&&Nisv(parser,Ai(ns,-1))&&Nisv(parser,Ai(ns,-2))&&Nisv(parser,Ai(ns,-3))){r=AP(ns); m=AP(ns); l=AP(ns); Ap(ns,Nn3(N_FORK,l,m,r));}elif(len>=3&&Nisv(parser,Ai(ns,-1))&&Nisv(parser,Ai(ns,-2))&&!Nisv(parser,Ai(ns,-3))){r=AP(ns); m=AP(ns); l=AP(ns); Ap(ns,Nn3(N_OVER,l,m,r));}elif(len>=2&&is_apply(Ai(ns,-1))){r=AP(ns); l=AP(ns); Ap(ns,Nn2(N_BOND,r,l));}elif(len>=2&&!Nisv(parser,Ai(ns,-1))&&Nisv(parser,Ai(ns,-2))){r=AP(ns); l=AP(ns); Ap(ns,Nn2(N_MONAD,l,r));}elif(len>=2&&Nisv(parser,Ai(ns,-1))&&Nisv(parser,Ai(ns,-2))){r=AP(ns); l=AP(ns); Ap(ns,Nn2(N_HOOK,l,r));}elif(len>=2&&Nisv(parser,Ai(ns,-1))&&!Nisv(parser,Ai(ns,-2))){r=AP(ns); l=AP(ns); Ap(ns,Nn2(N_BOND,r,l));}elif(len>=3){r=AP(ns); m=AP(ns); l=AP(ns); Ap(ns,Nn3(N_INDEX2,m,l,r));}elif(len>=2){r=AP(ns); l=AP(ns); Ap(ns,Nn2(N_INDEX1,l,r));}} R ns->data?ns->data[0]:N;} Nt*Pparse(Pt*parser,Lt*lexer){parser->lexer=lexer; parser->pos=0; parser->end=parser->lexer->tokens->length; Nt*node=PPexpr(parser); if(!Pdone(parser)){Tkt*tok=Plook(parser,0); if(tok&&tok->tag==T_RPAR)Perror(parser,"unmatched"); Perror(parser,"parse");} R node;} Vt*Srun(St*st,S program){Lt*lexer=Lnew(); Llex(lexer,program); Pt*parser=Pnew(st); Nt*node=Pparse(parser,lexer); Ar*t=lexer->tokens; for(Z i=0;ilength;i++){Tkt*tok=t->data[i]; if(tok->text)FR(tok->text); FR(tok);} FR(t->data); FR(t); Vt*r=Swalk(st,node); FR(parser);R r;} 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"\ "+. monadic fibonacci compute xth fibonacci number" "\n"\ "+. dyadic gcd compute gcd(x, y)" "\n"\ "+: monadic sin compute sin(x)" "\n"\ "+: dyadic combine combine digits of x and y, same as 10_.(10_:),(10_:)" "\n"\ "- monadic negate negate number" "\n"\ "- dyadic minus subtract numbers" "\n"\ "* monadic first yield first element of x" "\n"\ "* dyadic times multiply numbers" "\n"\ "*. monadic factorial x!" "\n"\ "*. dyadic lcm compute lcm(x, y)" "\n"\ "*: monadic double x * 2" "\n"\ "*: dyadic replicate repeat y x times" "\n"\ "% monadic reciprocal 1 / x" "\n"\ "% dyadic divide divide numbers" "\n"\ "%. monadic sqrt compute square root of x" "\n"\ "%. dyadic root compute xth root of y" "\n"\ "%: monadic halve x % 2" "\n"\ "%: dyadic idivide same as % divide, but result is always integer" "\n"\ "! monadic enum [0, x)" "\n"\ "! dyadic mod modulo of numbers" "\n"\ "!. monadic iota [1, x]" "\n"\ "!. dyadic range [x, y] (also works for chars and even if x > y)" "\n"\ "!: monadic odometer !:10 10 is 0 0,:0 1,: ... 1 0,:1 1,: ... 9 8,:9 9" "\n"\ "!: dyadic chunks split y into x-sized chunks" "\n"\ "^ monadic exp e^x" "\n"\ "^ dyadic power raise number to a power" "\n"\ "^. monadic nlog ln(x)" "\n"\ "^. dyadic log log(y)/log(x)" "\n"\ "= monadic permute generate permutations of x" "\n"\ "= dyadic equals test whether x and y are equal" "\n"\ "=. monadic occurences count occurences of elts, =.'Hello World!' is 0 0 0 1 0 0 0 1 0 2 0 0" "\n"\ "=. dyadic mask mask one array in another, 'abxyzabayxxyabxyk'=.'xy' is 0 0 1 1 0 0 0 0 0 0 2 2 0 0 3 3 0" "\n"\ "=: monadic classify assign unique index to each unique elt, =:'Hello World!' is 0 1 2 2 3 4 5 3 6 2 7 8" "\n"\ "=: dyadic match same as = equals, but rank 0, so compares x and y as whole" "\n"\ "~ monadic not logical not, nil udf () 0 4t.0 are not truthy, everything else is truthy" "\n"\ "~ dyadic notequals test whether x and y are not equal" "\n"\ "~. monadic sign sign of x, -1 for negative, 0 for 0, 1 for positive" "\n"\ "~. dyadic insert insert x between elts of y, 0~.1 2 3 is 1 0 2 0 3" "\n"\ "~: dyadic notmatch rank 0 version of ~ notequals" "\n"\ "< monadic pred x - 1" "\n"\ "< dyadic less test whether x is lesser than y" "\n"\ "<. monadic floor round x down" "\n"\ "<. dyadic lesseq test whether x is equal or lesser than y" "\n"\ "<: monadic gradedown indices of array sorted descending" "\n"\ "<: dyadic nudgeleft shift elts of y to the left filling gap with x" "\n"\ "> monadic succ x + 1" "\n"\ "> dyadic greater test whether x is greater than y" "\n"\ ">. monadic ceil round x up" "\n"\ ">. dyadic greatereq test whether x is equal or greater than y" "\n"\ ">: monadic gradeup indices of array sorted ascending" "\n"\ ">: dyadic nudgeright shift elts of y to the right filling gap with x" "\n"\ ", monadic enlist put x into 1-elt array" "\n"\ ", dyadic join concat x and y" "\n"\ ",. monadic enfile same as , enlist but with infinite rank, ,.1 2 3 is (,1),:(,2),:(,3)" "\n"\ ",. dyadic enpair put x and y into 2-elt array" "\n"\ "# monadic count yield count of elts of x" "\n"\ "# dyadic take take x first elts of y (or last if x < 0)" "\n"\ "#. monadic where #.0 0 1 0 1 0 is 2 4" "\n"\ "#. dyadic copy repeat each elt of x by corresponding number in y, 5 2 3 3#.0 2 2 1 is 2 2 3 3 3" "\n"\ "#: monadic group #:'mississippi' is (,0),:1 4 7 10,:2 3 5 6,:8 9" "\n"\ "#: dyadic buckets group elts of y into buckets according to x, e.g. 0 -1 -1 2 0#:a b c d e is (a,.e),:(),:(,d)" "\n"\ "_ monadic nub mark all unique elts of x, e.g. _'abracadabra' yields 1 1 1 0 1 0 1 0 0 0 0" "\n"\ "_ dyadic drop remove first x elts of y (or last if x < 0)" "\n"\ "_. monadic unbits _.1 0 1 is 5" "\n"\ "_. dyadic unbase 10_.4 5 6 is 456" "\n"\ "_: monadic bits _:5 is 1 0 1" "\n"\ "_: dyadic base 10_:4242 is 4 2 4 2" "\n"\ "? monadic unique distinct elts of x, same as ]#._" "\n"\ "? dyadic find find all indices of x in y" "\n"\ "& monadic flatten flatten an array, same as ,//." "\n"\ "& dyadic minand get min of two numbers (logical and for 0/1s)" "\n"\ "| monadic reverse reverse an array" "\n"\ "| dyadic maxor get max of two numbers (for 0/1s is same as logical or)" "\n"\ "|. monadic round round x" "\n"\ "|. dyadic rotate rotate array x times clockwise (-x for counterclockwise)" "\n"\ "|: monadic depth find max depth of x, |:,,,y yields 3" "\n"\ "|: dyadic windows yields all contiguous x-sized subarrays of y" "\n"\ "@ monadic abs |x|" "\n"\ "@ dyadic at pick elts from x by indices from y" "\n"\ "@. monadic shuffle shuffle elts of x" "\n"\ "@. dyadic member check whether x is in y" "\n"\ "@: monadic infix shortcut for }{:" "\n"\ "@: dyadic indexof yield index of x in y or #y if x not in y" "\n"\ "{ monadic head first two elts of x, same as 2#" "\n"\ "{ dyadic bin bin search, e.g. 1 3 5 7 9{8 9 0 yields 3 4 -1" "\n"\ "{. monadic tail last elt of x" "\n"\ "{: monadic prefixes prefixes of x, same as |}.\\." "\n"\ "{: dyadic shl x << y" "\n"\ "} monadic behead all elts of x except first, same as 1_" "\n"\ "} dyadic xor x ^ y" "\n"\ "}. monadic curtail all elts of x except last, same as -1_" "\n"\ "}: monadic suffixes suffixes of x, same as }.\\." "\n"\ "}: dyadic shr x >> y" "\n"\ "[ monadic factors compute prime factors of x" "\n"\ "[ dyadic left yield x" "\n"\ "[. monadic bnot ~x" "\n"\ "[. dyadic bor x | y" "\n"\ "[: monadic primes find primes in range [2, x]" "\n"\ "[: dyadic parts split y into x parts" "\n"\ "] monadic same yield x (i.e. identity)" "\n"\ "] dyadic right yield y (i.e. right argument)" "\n"\ "]. monadic sort sort x ascending, shortcut for ]@>:" "\n"\ "]. dyadic outof the number of ways of picking x balls from a bag of y balls, e.g. 5].10 is 252" "\n"\ "]: monadic unsort sort x descending, shortcut for ]@<:" "\n"\ "]: dyadic explode split y by delim x" "\n"\ "`. monadic symbol cast x to a symbol" "\n"\ "`. dyadic apply1 apply x to y" "\n"\ "`: monadic square x ^ 2" "\n"\ "`: dyadic apply2 apply x to y (y is 2-elt array of args)" "\n"\ "$ monadic shape yield shape of x" "\n"\ "$ dyadic reshape reshape y to shape x" "\n"\ "$. monadic repr yield string repr of x" "\n"\ "$. dyadic format format y by template x, e.g. '{0}+{1}*{-1}+_'$.1 2 3 4 is 1+2*4+1" "\n"\ "$: monadic eye identity matrix of size x" "\n"\ "$: dyadic implode join y inserting x between" "\n"\ ""; cS V2HELP =\ "p. monadic print print x" "\n"\ "P. monadic println print x and a \\n" "\n"\ "s. monadic selfref1 monadic reference to current function or rhs of bind" "\n"\ "s. dyadic selfref2 dyadic reference to current function or rhs of bind" "\n"\ "F. monadic read read file (x=0 to read stdin)" "\n"\ "F. dyadic write write file (y=0 to write to stderr)" "\n"\ "t. monadic type type of x, array=0, verb=1, symbol=2, number=3, char=4, nil=5, udf=6" "\n"\ "r. monadic deal yield random elt of x" "\n"\ "r. dyadic roll roll xdy (note: y is 0-based, so >xr.y for 1-based)" "\n"\ "e. monadic eval eval expression, yields udf on parse error" "\n"\ "i. monadic import load and eval source file" "\n"\ "i. dyadic foreign call external function (lhs is array of arguments), e.g. .5i.'libm.so:dd:sin'" "\n"\ "y. monadic system exec system command (yields output)" "\n"\ "y. dyadic system2 exec system command with input" "\n"\ "E. monadic exit exit with exit code" "\n"\ "L. dyadic tackleft prepend x to y" "\n"\ "R. dyadic tackright append x to y" "\n"\ ""; cS AHELP =\ "f\" each >\"1 2 3 yields 2 3 4" "\n"\ "xf\" merge 1 2 3,\"a b c yields (1,.a),:(2,.b),:(3,.c)" "\n"\ "f\". eachprior -\".1 2 2 3 5 6 yields 1 0 1 2 1" "\n"\ "xf\". eachpriorwith 0-\".1 2 2 3 5 6 yields 1 1 0 1 2 1" "\n"\ "f/ fold +/1 2 3 yields 6" "\n"\ "xf/ foldwith 1+/1 2 3 yields 7" "\n"\ "f\\ scan +\\1 2 3 yields 1 3 6" "\n"\ "xf\\ scanwith 1+\\1 2 3 yields 1 2 4 7" "\n"\ "f/. converge 1;_/.1 2 3 yields ()" "\n"\ "f\\. converges 1;_\\.1 2 3 yields 1 2 3,:2 3,:(,3),:()" "\n"\ "xf/. eachright 1-/.1 2 3 yields 0 1 2" "\n"\ "xf\\. eachleft 1-\\.1 2 3 yields 0 -1 -2" "\n"\ "f\": rank #\":1 2 3$1 yields 3 3, #\":inf 2 3$1 yields 1 1 1,:1 1 1" "\n"\ "xf\": rank2 1 2 3 *:\":1 1 2 3 yields (,1),:2 2,:3 3 3" "\n"\ "n` amend 'gw'0 3`'cross' yields 'grows'" "\n"\ "f&. filter >;0&.-2!.2 yields 1 2, basically shortcut for ]#.f" "\n"\ "f/: span =;' '/:'x y z' yields (,'x'),:(,'y'),:(,'z')" "\n"\ "xf/: stencil 3+//:!10 yields 3 6 9 12 15 18 21 24, shortcut for f\"x|:" "\n"\ "f;. reflex *;.5 yields 25, 5%;.2 yields 0.4" "\n"\ ""; cS CHELP =\ "f;g bond */;!.5 yields 120, +;1 5 yields 6, 5;- 1 yields 4" "\n"\ "f?.x pick >;5?.((2*),:<)\"3 6 yields 6 5" "\n"\ "f?:F while <;5?:>0 yields 5" "\n"\ "n?:f repeat 5?:*;2 1 yields 32" "\n"\ "f&:F if 1+&:+2 yields 2" "\n"\ "f;:F monaddyad -;:+5 yields -5, 1-;:+5 yields 6" "\n"\ ""; cS IHELP =\ "inverse of a function f is a function ~f that undoes the effect of f" "\n"\ "\n"\ "f::~f obverse define inverse ~f for f" "\n"\ "\n"\ "f-:x inverse ~fx" "\n"\ "xf-:y inverse2 (~fx)~f~fx" "\n"\ "f^:Fx under ~FfFx" "\n"\ "xf^:Fx under2 ~F(Fx)f(Fx)" "\n"\ ""; cS SHELP =\ "/ comment" "\n"\ "5+5 / also comment" "\n"\ "5+5/not comment (no whitespace before /)" "\n"\ "nil udf / special, nil and undefined" "\n"\ "'a'%2 / = nan, nan used to denote illegal numeric operation" "\n"\ "+1 2 3 / = udf, attempt to transpose flat vector, udf/undefined used to denote illegal operation" "\n"\ "5 5.5 -5 42 / number (double-precision floats)" "\n"\ "1`000 1`000`000 /" "\n"\ ".5 .429 /" "\n"\ "0xff 0o4 0b0101 /" "\n"\ "nan inf /" "\n"\ "'a' 'b' 'g' / chars (bytes)" "\n"\ "4t.0 / 0 NUL byte" "\n"\ "(4t.0),:(4t.16),:(4t.22) /" "\n"\ "1 2 3 / numbers array" "\n"\ "'hello world!' 'bla''bla' / quote, array of chars" "\n"\ ",'a' / 1-char string" "\n"\ ",1 / 1-elt array" "\n"\ "() / unit, empty array" "\n"\ "1,:(5+5),:1 2 3 / strand, mixed array literal" "\n"\ "-1 / negative num literal" "\n"\ "- 1 / application of - negate to 1" "\n"\ "-1 -2 -3 / array of negative nums" "\n"\ "- 1 2 3 / application of - negate to an array of nums" "\n"\ "5-5 / array of numbers 5 and -5" "\n"\ "5- 5 / 5 minus 5" "\n"\ "+ / verb" "\n"\ "5+5 / dyadic expr" "\n"\ "#1 2 3 / monadic expr (no left side)" "\n"\ "+/ *;. / adverb" "\n"\ "+;1 -;* +^:^. / conjunction" "\n"\ ":x+y / function literal" "\n"\ ":1 / function that always yields 1" "\n"\ "x:123 / bind name" "\n"\ "sq:*;. /" "\n"\ "fac:*/1+! / bind function" "\n"\ "f:x+y /" "\n"\ "f:-x / overload function by arity" "\n"\ "f 5 / = -5" "\n"\ "5 f 5 / = 10" "\n"\ "*/!. / hook, fgx -> f(g(x)), xfgy -> f(g(x, y))" "\n"\ "+/%# / fork, fghx -> g(f(x), h(x)), xfghy -> g(f(x), h(y))" "\n"\ "1+! / over, nfgx -> f(n, g(x)), xnfgy -> f(n, g(x, y))" "\n"\ "1+ / bond, nfx -> f(n, x), xnfy -> f(n, f(x, y))" "\n"; cS HELP = "\\0\thelp on syntax\n"\ "\\+\thelp on verbs\n"\ "\\a\thelp on additional verbs\n"\ "\\\"\thelp on adverbs\n"\ "\\;\thelp on conjunctions\n"\ "\\-:\thelp on inverses\n"; cS VSTR=VER " " __DATE__; V jkexec(St*st,FILE*fd,B isrepl,S*s){Vt*v=N; LOOP{Bt*buffer; C line[256]; buffer=Bnew(); if(isrepl)putc('\t',stdout); if(!fgets(line,SO(line),fd))BR; if(isrepl){if(strcmp(line,"\\\\\n")==0)BR; elif(strcmp(line,"\\\n")==0){printf("%s",HELP);CN;} elif(strcmp(line,"\\0\n")==0){printf("%s",SHELP);CN;} elif(strcmp(line,"\\+\n")==0){printf("%s",VHELP);CN;} elif(strcmp(line,"\\a\n")==0){printf("%s",V2HELP);CN;} elif(strcmp(line,"\\\"\n")==0){printf("%s",AHELP);CN;} elif(strcmp(line,"\\;\n")==0){printf("%s",CHELP);CN;} elif(strcmp(line,"\\-:\n")==0){printf("%s",IHELP);CN;}} WH(strlen(line)>2&&strcmp(line+strlen(line)-3,"..\n")==0){line[strlen(line)-3]=0; BappendS(buffer,line); if(isrepl)putc('\t',stdout); if(!fgets(line,SO(line),fd))R;} BappendS(buffer,line); *s=Bread(buffer); v=Srun(st,*s); FR(*s);*s=N; if(isrepl&&v->tag!=NIL){Tset(st->env,"it",v); S s=Vshow(v); fputs(s,stdout); FR(s); if(isrepl)putc('\n',stdout);}} if(!isrepl&&v&&v->tag!=NIL){S s=Vshow(v); fputs(s,stdout); FR(s);}} I main(I argc,S*argv){GC_INIT(); GC_enable_incremental(); guards=An(); Iin=isatty(0); HASH_SEED=time(N); srand(HASH_SEED); VCACHE=Tnew(); SCACHE=Tnew(); for(Z i=0;ival.verb=&VERBS[i]; Tset(VCACHE,VERBS[i].name,v);} _UNIT=Vnew(ARRAY); _UNIT->val.array=An(); St*st=Sn(); for(I i=1;i<=8;i++){NNUMS[i-1]=VnC(NUM); NNUMS[i-1]->val.number=-i;} for(I i=0;i<256;i++){NUMS[i]=VnC(NUM); NUMS[i]->val.number=i;} for(I i=0;i<256;i++){CHARS[i]=VnC(CHAR); CHARS[i]->val._char=i;} _NAN=VnC(NUM); _NAN->val.number=NAN; INF=VnC(NUM); INF->val.number=INFINITY; NINF=VnC(NUM); NINF->val.number=-INFINITY; Ar*vs=An(); for(Z i=0;ienv,"JKV",Vna(vs)); Tset(st->env,"E",Vnn(exp(1))); Tset(st->env,"pi",Vnn(M_PI)); Tset(st->env,"tau",Vnn(M_PI*2)); Tset(st->env,"nan",_NAN); Tset(st->env,"inf",INF); Tset(st->env,"nil",st->nil); Tset(st->env,"udf",st->udf); Inverses=Tnew(); Tset(Inverses,"+",Gv("+")); Tset(Inverses,"-",Gv("-")); Tset(Inverses,"|",Gv("|")); Tset(Inverses,"~",Gv("~")); Tset(Inverses,"%",Gv("%")); Tset(Inverses,"]",Gv("]")); Tset(Inverses,"*:",Gv("%:")); Tset(Inverses,"%:",Gv("*:")); Tset(Inverses,">",Gv("<")); Tset(Inverses,"<",Gv(">")); Tset(Inverses,"_.",Gv("_:")); Tset(Inverses,"_:",Gv("_.")); Tset(Inverses,"^.",Gv("^")); Tset(Inverses,"^",Gv("^.")); Tset(Inverses,"+;.",Gv("%:")); Tset(Inverses,"*/",Gv("[")); Tset(Inverses,"[",CV("*/")); Tset(Inverses,"!",CV(">|/")); Tset(Inverses,"!.",CV("|/")); Tset(Inverses,"]@>:",CV("]@<:")); Tset(Inverses,"]@<:",CV("]@>:")); Ar*args=An(); for(I i=1;ienv,"args",Vna(args)); if(Iin)printf("jk\t\\\\ to exit \\ for help\n"); S s=N; if(Iin)setjmp(Icp); if(s){FR(s);s=N;} jkexec(st,stdin,Iin,&s);}