123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709 |
- /* jk intepreter, by @txlyre,www:txlyre.website, in the public domain */
- #include<ctype.h>
- #include<limits.h>
- #include<math.h>
- #include<setjmp.h>
- #include<stdbool.h>
- #include<stdint.h>
- #include<stdio.h>
- #include<stdlib.h>
- #include<string.h>
- #include<time.h>
- #include<unistd.h>
- #include<sys/wait.h>
- #include<errno.h>
- #include<gc.h>
- #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 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)
- 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;
- #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 _Lst Lst;
- struct _Lst{P value;
- Lst*next;};
- Lst*ln(void){Lst*list=ma(SO(Lst));
- list->value=N;
- list->next=N;R list;}
- B le(Lst*list){R(!(list)->value);}
- Z ll(Lst*list){Z length=0;
- if(le(list))R length;
- do{list=list->next,length++;}WH(list);R length;}
- P li(Lst*list,SZ index){Z length;
- if(le(list))R N;
- if(index==0)R list->value;
- length=ll(list);
- if(index<0)index+=((SZ)length);
- if(index<0||index>=length)R N;
- for(Z i=0;i<((Z)index);i++)list=list->next;R list->value;}
- Lst*lp(Lst*list,P value){Lst*head=list;
- if(le(list)){list->value=value;R head;}
- WH(list->next)list=list->next;
- list=list->next=ln();
- list->value=value;R head;}
- Lst*lc(Lst*l){Lst*r=ln();
- if(!le(l))WH(l){lp(r,l->value);
- l=l->next;}
- R r;}
- P lP(Lst*list){if(le(list))R N;
- if(!list->next){P value=list->value;
- list->value=N;R value;}
- Lst*head=list;
- WH(list){if(!list->next){P value=list->value;
- list->value=N;
- head->next=N;R value;}
- head=list;
- list=list->next;}
- R N;}
- P ls(Lst*list,SZ index,P value){Z length=ll(list);
- if(index<0)index+=((SZ)length);
- if(index==((SZ)length)){lp(list,value);R value;}
- if(index<0||index>=length)R N;
- for(Z i=0;i<((Z)index);i++)list=list->next;
- list->value=value;R value;}
- Lst*lI(Lst**list,SZ index,P value){Lst*head=*list;
- if(index==-1)R lp(head,value);
- Z length=ll(head);
- if(index<0)index+=(SZ)length;
- if(index<0||index>length)R N;
- if(index==-1)R lp(head,value);
- if(index==0){if(le(head))R lp(head,value);
- Lst*temp=ln();
- temp->value=value;
- temp->next=head;
- *list=temp;R temp;}
- Lst*temp0=*list;
- for(Z i=0;i<((Z)index)-1;i++)temp0=temp0->next;
- Lst*temp=temp0->next;
- temp0->next=ln();
- temp0->next->value=value;
- temp0->next->next=temp;R head;}
- Lst*ld(Lst**list,SZ index){Lst*head=*list;
- if(le(head))R N;
- Z length=ll(head);
- if(index<0)index+=(SZ)length;
- if(index<0||index>=length)R N;
- if(index==0){head->value=N;
- if(!head->next)R head;
- *list=head->next;
- return*list;}
- Lst*temp0=*list;
- for(Z i=0;i<((Z)index)-1;i++)temp0=temp0->next;
- Lst*temp=temp0->next;
- temp->value=N;
- temp0->next=temp->next;R head;}
- Lst*lS(Lst*list,bool(*cmp)(P ,P )){Z l=ll(list);
- B s;
- for(Z i=0;i<l;i++){Lst*t=list;
- Lst*p=list;
- s=F;
- WH(t->next){Lst*n=t->next;
- if(cmp(t->value,n->value)){s=T;
- if(t==list){t->next=n->next;
- n->next=t;
- p=n;
- list=p;}else{t->next=n->next;
- n->next=t;
- p->next=n;
- p=n;}
- CN;}
- p=t;
- t=t->next;}
- if(!s)BR;}
- R list;}
- 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_QUOTE}tag;
- S text;}Tkt;
- typedef struct{S source;
- Z len;
- Z pos;
- Lst*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;
- lp(lexer->tokens,token);}
- Lst*guards;
- jmp_buf*guard(){jmp_buf*lb=maa(SO(jmp_buf));
- lp(guards,lb);R lb;}
- jmp_buf*guarding(){R li(guards,-1);}
- V unguard(){jmp_buf*lb=lP(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));}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=ln();
- WH(lexer->pos<lexer->len){C c=Llook(lexer,0);
- if(c=='/'&&le(lexer->tokens))BR;
- if(isspace(c)){Leat(lexer);
- if(Llook(lexer,0)=='/')BR;}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;i<table->capacity;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;}
- typedef struct _Vt Vt;
- typedef struct _St St;
- typedef struct _vt vt;
- struct _St{Tt*env;
- Lst*args;
- Lst*selfrefs;
- Vt*nil;
- Vt*udf;
- Vt*unit;
- vt*at;};
- struct _vt{S name;
- UI rank[3];
- Lst*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{Lst*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(Lst*array){if(le(array)){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;}
- Vt*Vnc(UC _char){R CHARS[_char];}
- B Veq(Vt*x,Vt*y){if(xt!=yt)R F;
- SW(xt){CS ARRAY:{Lst*tx=xa;
- Lst*ty=ya;
- if(le(tx)&&le(ty))BR;
- if(le(tx)&&!le(ty))R F;
- if(!le(tx)&&le(ty))R F;
- WH(tx){if(!ty)R F;
- if(!Veq(tx->value,ty->value))R F;
- tx=tx->next;
- ty=ty->next;}
- if(ty)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(Lst*a){if(le(a))R F;
- WH(a){Vt*v=a->value;
- if(v->tag!=CHAR||!isprint(v->val._char))R F;
- a=a->next;}
- R T;}
- B Aap(Lst*a){if(le(a))R F;
- WH(a){Vt*v=a->value;
- if(v->tag!=ARRAY)R F;
- a=a->next;}
- R T;}
- S Vshow(Vt*v);
- S show_array(Vt*v){if(v->tag!=ARRAY)R Vshow(v);
- Lst*t=v->val.array;
- if(le(t))R sdup("()");
- Bt*buf=Bnew();
- if(!t->next){Bappend(buf,',');
- S ts=Vshow(t->value);
- BappendS(buf,ts);
- FR(ts);R Bread(buf);}
- if(Cap(t)){WH(t){Vt*c=t->value;
- Bappend(buf,c->val._char);
- t=t->next;}
- R Bread(buf);}
- if(!Aap(t)){WH(t){S ts=Vshow(t->value);
- BappendS(buf,ts);
- FR(ts);
- t=t->next;
- if(t)Bappend(buf,' ');}}else{UI rwk=0;
- UI rwl=ll(t->value);
- WH(t){S ts=show_array(t->value);
- BappendS(buf,ts);
- FR(ts);
- t=t->next;
- if(t)Bappend(buf,' ');
- rwk++;
- if(rwk>=rwl&&t){rwk=0;
- 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("<?>");}
- D Vnum(Vt*v){if(v->tag==CHAR)R v->val._char;R vn;}
- B VTp(Vt*x){SW(xt){CS ARRAY:R !le(xa);
- 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=ln();
- st->selfrefs=ln();
- 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)lp(st->selfrefs,f);
- Vt*r=f->monad(st,f,x);
- if(f->mark)lP(st->selfrefs);R r;}
- Lst*t=xa;
- if(le(t))R x;
- Lst*l=ln();
- WH(t){lp(l,eR(st,f,t->value,d+1,rm));
- t=t->next;}
- 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)lp(st->selfrefs,f);
- Vt*r=f->dyad(st,f,x,y);
- if(f->mark)lP(st->selfrefs);R r;}
- if(dl<rl&&dr<rr&&xt==ARRAY&&yt==ARRAY){Lst*tx=xa;
- Lst*ty=ya;
- if(!tx->value||!ty->value)R !tx->value?x:y;
- Lst*t=ln();
- WH(tx){if(!ty)BR;
- lp(
- t,tgth(st,f,tx->value,ty->value,dl+1,dr+1,rl,rr));
- tx=tx->next;
- ty=ty->next;}
- R Vna(t);}elif((xt!=ARRAY||dl>=rl)&&yt==ARRAY&&dr<rr){Lst*ty=ya;
- if(!ty->value)R y;
- Lst*t=ln();
- WH(ty){lp(t,tgth(st,f,x,ty->value,dl,dr+1,rl,rr));
- ty=ty->next;}
- R Vna(t);}elif((yt!=ARRAY||dr>=rr)&&xt==ARRAY&&dl<rl){Lst*tx=xa;
- if(!tx->value)R x;
- Lst*t=ln();
- WH(tx){lp(t,tgth(st,f,tx->value,y,dl+1,dr,rl,rr));
- tx=tx->next;}
- R Vna(t);}
- if(f->mark)lp(st->selfrefs,f);
- Vt*r=f->dyad(st,f,x,y);
- if(f->mark)lP(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;
- Lst*l;
- Nt*a;
- Nt*b;
- Nt*c;};
- Vt*_fork_m(St*st,vt*self,Vt*x){vt*f=li(self->bonds,0);
- vt*g=li(self->bonds,1);
- vt*h=li(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=li(self->bonds,0);
- vt*g=li(self->bonds,1);
- vt*h=li(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=li(self->bonds,0);
- vt*g=li(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=li(self->bonds,0);
- vt*g=li(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=li(self->bonds,0);
- Vt*g=li(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=li(self->bonds,0);
- Vt*g=li(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=li(self->bonds,0);
- vt*g=li(self->bonds,1);
- vt*h=li(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=li(self->bonds,0);
- vt*g=li(self->bonds,1);
- vt*h=li(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){Lst*t=node->l;
- WH(t){if(nca(t->value,argc))R T;
- t=t->next;}}
- R F;}
- Vt*Swalk(St*st,Nt*node);
- Vt*_const_m(St*st,vt*self,Vt*x){R self->bonds->value;}
- Vt*_const_d(St*st,vt*self,Vt*x,Vt*y){R self->bonds->value;}
- Vt*_fun_m(St*st,vt*self,Vt*x){Lst*args=ln();
- lp(args,x);
- lp(args,self);
- lp(st->args,args);
- Vt*r=Swalk(st,self->bonds->value);
- lP(st->args);
- FR(args);R r;}
- Vt*_fun_d(St*st,vt*self,Vt*x,Vt*y){Lst*args=ln();
- lp(args,x);
- lp(args,y);
- lp(args,self);
- lp(st->args,args);
- Vt*r=Swalk(st,self->bonds->next->value);
- lP(st->args);
- FR(args);R r;}
- Vt*_partial_conjunction(St*st,vt*self,Vt*x){advt*av=self->bonds->value;
- Vt*a=self->bonds->next->value;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:{Lst*t=node->l;
- WH(t){t->value=Swalk(st,t->value);
- t=t->next;}
- R Vna(node->l);}
- CS N_LITERAL:{Vt*v=node->v;
- Vt*t=N;
- if(v->tag==SYM){S n=v->val.symbol;
- if(!le(st->args)){Lst*args=li(st->args,-1);
- Z argc=ll(args)-1;
- if(argc==2&&strcmp(n,"y")==0)R args->next->value;
- elif(strcmp(n,"x")==0)R args->value;}
- if((t=Tget(st->env,n)))R t;}
- 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=ln();
- nv->name=sdup(argc==0?":...":argc==1?":x":":xy");
- nv->rank[0]=0;
- nv->rank[1]=0;
- nv->rank[2]=0;
- if(argc==0){lp(nv->bonds,Swalk(st,node->a));
- nv->monad=_const_m;
- nv->dyad=_const_d;}elif(argc==1){lp(nv->bonds,node->a);
- nv->monad=_fun_m;
- nv->dyad=N;}else{nv->monad=N;
- lp(nv->bonds,st->udf);
- lp(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);R Vnv(node->av->adverb(st,v));}
- CS N_CONJ:{Vt*v1=Swalk(st,node->a);
- Vt*v2=Swalk(st,node->b);R Vnv(node->av->conjunction(st,v1,v2));}
- 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=ln();
- lp(nv->bonds,node->av);
- lp(nv->bonds,a);
- nv->rank[0]=0;
- nv->rank[1]=0;
- nv->rank[2]=0;
- nv->monad=_partial_conjunction;
- nv->dyad=N;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=ln();
- lp(nv->bonds,f);
- lp(nv->bonds,g);
- lp(nv->bonds,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;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=ln();
- lp(nv->bonds,f);
- lp(nv->bonds,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;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=ln();
- lp(nv->bonds,f);
- lp(nv->bonds,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;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=ln();
- lp(nv->bonds,f);
- lp(nv->bonds,g);
- lp(nv->bonds,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;R Vnv(nv);}
- CS N_BIND:{Vt*l=node->a->v;
- Nt*b=node->b;
- UI argc=0;
- nca(b,&argc);
- if(argc!=0)b=Nn1(N_FUN,b);
- Vt*r=Swalk(st,b);
- 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){ls(ov->val.verb->bonds,0,r->val.verb->bonds->value);
- ov->val.verb->monad=r->val.verb->monad;BR;}
- if(!ov->val.verb->dyad&&r->val.verb->dyad){lp(ov->val.verb->bonds,r->val.verb->bonds->next->value);
- ov->val.verb->dyad=r->val.verb->dyad;BR;}}
- Tset(st->env,l->val.symbol,r);}}
- R st->nil;}
- Vt*vconst(St*st,vt*self,Vt*x){vt*nv=vnew();
- nv->bonds=ln();
- lp(nv->bonds,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=_const_m;
- nv->dyad=_const_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*vobverse(St*st,vt*self,Vt*x,Vt*y){if(xt==VERB&&yt==VERB){vt*vx=xV;
- if(!yV->monad)
- R st->udf;
- if(strcmp(vx->name,":...")==0||strcmp(vx->name,":x")==0||strcmp(vx->name,":xy")==0)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||le(xa))R st->udf;
- Lst*t=xa;
- if(!Aap(t))R st->udf;
- Lst*r=ln();
- Vt*c0=t->value;
- Lst*c0t=c0->val.array;
- Z c0l=ll(c0t);
- for(Z i=0;i<c0l;i++){Lst*nc=ln();
- Lst*t2=t;
- WH(t2){Vt*rw=t2->value;
- Lst*rwt=rw->val.array;
- if(le(rwt))R st->udf;
- Vt*v=li(rwt,i);
- if(!v)v=rwt->value;
- lp(nc,v);
- t2=t2->next;}
- lp(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(le(xa))R st->udf;R xa->value;}
- 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);
- Lst*r=ln();
- WH(k--)lp(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(le(xa)||!xa->next)R st->udf;
- Z p=1;
- Z xl=0;
- Lst*t=xa;
- WH(t){Vt*it=t->value;
- if(it->tag!=NUM||spnp(it->val.number))R st->udf;
- p*=(Z)(it->val.number);
- t=t->next;xl++;}
- if(p<1)R st->unit;
- t=xa;
- uint64_t*lims=maa(SO(U64)*xl);
- for(Z i=0;i<xl;i++){lims[i]=(Z)(((Vt*)t->value)->val.number);
- t=t->next;}
- uint64_t**z=ma(SO(uint64_t*)*p);
- for(Z i=0;i<p;i++)z[i]=maa(SO(U64)*xl);
- for(Z i=0;i<p-1;i++){uint64_t*r=z[i];
- uint64_t*s=z[i+1];
- B carry=T;
- for(Z j=0;j<xl;j++){U64 a=xl-1-j;
- s[a]=r[a];
- if(carry){s[a]++;carry=F;}
- if(s[a]>=lims[a]){s[a]=0;carry=T;}}}
- FR(lims);
- Lst*r=ln();
- for(Z i=0;i<p;i++){Lst*rw=ln();
- for(Z j=0;j<xl;j++)lp(rw,Vnn(z[i][j]));
- lp(r,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(le(ya))R y;
- Lst*r=ln();
- Z l=ll(ya);
- Z cl=fabs(xn);
- for(Z i=0;i<l;i+=cl)lp(r,vtake(st,N,Vnn(cl),vdrop(st,N,Vnn(i),y)));R Vna(r);}
- Vt*vexp(St*st,vt*self,Vt*x){if(xt==NUM)R Vnn(exp(xn));R _NAN;}
- Vt*vpower(St*st,vt*self,Vt*x,Vt*y){if(xt==NUM&&yt==NUM)R Vnn(pow(xn,yn));R _NAN;}
- Vt*vnlog(St*st,vt*self,Vt*x){if(xt==NUM)R Vnn(log(xn));R _NAN;}
- Vt*vlog(St*st,vt*self,Vt*x,Vt*y){if(xt==NUM&&yt==NUM)R Vnn(log(yn)/log(xn));R _NAN;}
- I bits_needed(U32 value){I bits=0;
- for(I bit_test=16;bit_test>0;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);
- Lst*r=ln();
- for(I i=0;i<bk;i++)if((n &(1<<i))>>i)lp(r,NUMS[1]);
- else lp(r,NUMS[0]);R Vna(r);}
- R st->udf;}
- 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;
- Lst*r=ln();
- WH(v>0){r=lI(&r,0,Vnn(v%b));
- v/=b;}
- R Vna(r);}
- R st->udf;}
- SZ indexOf(Lst*l,Vt*x){if(le(l))return-1;
- Z i=0;
- WH(l){if(Veq(l->value,x))R i;
- l=l->next;
- i++;}
- return-1;}
- Vt*vgroup(St*st,vt*self,Vt*x){if(xt!=ARRAY)x=venlist(st,N,x);
- elif(le(xa))R x;
- Lst*r=ln();
- Lst*is=ln();
- Z i=0;
- Lst*t=xa;
- WH(t){Vt*v=t->value;
- SZ n=indexOf(is,v);
- if(n<0){lp(r,venlist(st,N,Vnn(i)));
- lp(is,v);}else{Vt*tmp=li(r,n);
- lp(tmp->val.array,Vnn(i));}
- t=t->next;
- i++;}
- WH(is){Lst*tmp=is->next;
- FR(is);
- is=tmp;}
- R Vna(r);}
- Vt*vbuckets(St*st,vt*self,Vt*x,Vt*y){if(xt!=ARRAY)x=venlist(st,N,x);
- elif(le(xa))R y;
- if(yt!=ARRAY)y=venlist(st,N,x);
- elif(le(ya))R y;
- Lst*r=ln();
- Lst*t=xa;
- Z mx=0;
- WH(t){Vt*v=t->value;
- if(v->tag!=NUM)BR;
- SZ i=vn;
- if(i>=0&&i>mx)mx=i;
- t=t->next;}
- for(Z i=0;i<mx+1;i++)lp(r,ln());
- if(le(r)){FR(r);R st->unit;}
- Lst*ty=ya;
- t=xa;
- WH(t&&ty){Vt*v=t->value;
- if(v->tag!=NUM)BR;
- SZ i=vn;
- if(i>=0){Lst*b=li(r,i);
- if(b)lp(b,ty->value);}
- t=t->next;ty=ty->next;}
- if(ty){Lst*lb=ln();
- WH(ty){lp(lb,ty->value);
- ty=ty->next;}
- lp(r,lb);}
- t=r;
- WH(t){t->value=Vna(t->value);
- t=t->next;}
- 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||le(xa)||!xa->next)R x;
- Lst*permutation=lc(xa);
- Z length=ll(permutation);
- Lst*result=ln();
- lp(result,lc(permutation));
- Lst*c=ln();
- for(Z i=0;i<length;i++){Z*n=maa(SO(Z));
- lp(c,n);}
- Z k;
- Lst*p;
- Z i=0;
- WH(i<length){Z*n=li(c,i);
- if((*n)<i){k=i%2&&(*n);
- p=li(permutation,i);
- ls(permutation,i,li(permutation,k));
- ls(permutation,k,p);
- *n=(*n)+1;
- i=1;
- lp(result,lc(permutation));}else{*n=0;
- i++;}}
- WH(c){Lst*tmp=c->next;
- FR(c->value);
- FR(c);
- c=tmp;}
- WH(permutation){Lst*tmp=permutation->next;
- FR(permutation);
- permutation=tmp;}
- Lst*t=result;
- WH(t){t->value=Vna(t->value);
- t=t->next;}
- R Vna(result);}
- Vt*voccurences(St*st,vt*self,Vt*x){if(xt!=ARRAY)x=venlist(st,N,x);
- elif(le(xa))R x;
- Lst*table=ln();
- Lst*r=ln();
- Lst*t=xa;
- WH(t){B f=F;
- Vt*it=t->value;
- Lst*tt=table;
- if(!le(tt))WH(tt){Lst*p=tt->value;
- if(Veq(p->value,it)){Z*n=p->next->value;
- *n=(*n)+1;
- lp(r,Vnn(*n));
- f=T;BR;}
- tt=tt->next;}
- if(!f){Lst*p=ln();
- lp(p,it);
- Z*n=maa(SO(Z));
- lp(p,n);
- lp(table,p);
- lp(r,NUMS[0]);}
- t=t->next;}
- if(!le(table)){t=table;
- WH(t){Lst*tmp=t->next;
- Lst*p=t->value;
- FR(p->next->value);
- FR(p->next);
- FR(p);
- FR(t);
- t=tmp;}}
- R Vna(r);}
- Vt*vmask(St*st,vt*self,Vt*x,Vt*y){if(xt!=ARRAY)x=venlist(st,N,x);
- elif(le(xa))R x;
- if(yt!=ARRAY)y=venlist(st,N,y);
- Lst*r=ln();
- Vt*l=Vnn(ll(ya));
- Z n=0;
- Z k=ll(xa);
- for(Z i=0;i<k;i++){Vt*s=vtake(st,N,l,vdrop(st,N,Vnn(i),x));
- if(Veq(s,y)){n++;
- for(Z j=0;j<l->val.number;j++,i++)lp(r,Vnn(n));
- i--;}else lp(r,NUMS[0]);}
- R Vna(r);}
- Vt*vclassify(St*st,vt*self,Vt*x){if(xt!=ARRAY)x=venlist(st,N,x);
- elif(le(xa))R x;
- Lst*table=ln();
- Lst*r=ln();
- Lst*t=xa;
- Z i=0;
- WH(t){B f=F;
- Vt*it=t->value;
- Lst*tt=table;
- if(!le(tt))WH(tt){Lst*p=tt->value;
- if(Veq(p->value,it)){Z*n=p->next->value;
- lp(r,Vnn(*n));
- f=T;BR;}
- tt=tt->next;}
- if(!f){Lst*p=ln();
- lp(p,it);
- Z*n=maa(SO(Z));
- *n=i++;
- lp(p,n);
- lp(table,p);
- lp(r,Vnn(*n));}
- t=t->next;}
- if(!le(table)){t=table;
- WH(t){Lst*tmp=t->next;
- Lst*p=t->value;
- FR(p->next->value);
- FR(p->next);
- FR(p);
- FR(t);
- t=tmp;}}
- R Vna(r);}
- Vt*vunbits(St*st,vt*self,Vt*x){if(xt!=ARRAY)x=venlist(st,N,x);
- I n=0;
- I i=0;
- Lst*t=xa;
- WH(t){if(VTp(t->value))n|=(int)1<<i;
- else n &=~((int)1<<i);
- t=t->next;
- i++;}
- R Vnn(n);}
- Vt*vunbase(St*st,vt*self,Vt*x,Vt*y){if(xt==NUM){Z b=fabs(xn);
- if(b<2)R st->udf;
- if(yt!=ARRAY)y=venlist(st,N,y);
- Z n=0;
- Lst*t=ya;
- if(le(t))R st->udf;
- WH(t){Vt*v=t->value;
- if(v->tag!=NUM)BR;
- Z k=fabs(vn);
- n=n*b+k;
- t=t->next;}
- 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)<Vnum(y))R NUMS[1];R NUMS[0];}
- R _NAN;}
- Vt*vfloor(St*st,vt*self,Vt*x){if(xt==NUM)R Vnn(floor(xn));R _NAN;}
- B _compare_up(P a,P b){Vt*x=((Lst*)a)->value;
- Vt*y=((Lst*)b)->value;
- if((xt==NUM||xt==CHAR)&&(yt==NUM||yt==CHAR)){if(Vnum(x)>Vnum(y))R T;R F;}
- R F;}
- B _compare_down(P a,P b){Vt*x=((Lst*)a)->value;
- Vt*y=((Lst*)b)->value;
- if((xt==NUM||xt==CHAR)&&(yt==NUM||yt==CHAR)){if(Vnum(x)<Vnum(y))R T;R F;}
- R F;}
- Vt*_grade(Vt*x,B down){if(xt!=ARRAY||le(xa)||!xa->next)R x;
- Z i=0;
- Lst*ps=ln();
- Lst*t=xa;
- WH(t){Lst*p=ln();
- lp(p,t->value);
- lp(p,Vnn(i++));
- lp(ps,p);
- t=t->next;}
- ps=lS(ps,down?_compare_down:_compare_up);
- t=ps;
- WH(t){Lst*p=t->value;
- t->value=p->next->value;
- FR(p->next);
- FR(p);
- t=t->next;}
- 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(le(ya))R y;
- elif(!ya->next)R venlist(st,N,x);
- Lst*r=ln();
- Lst*t=ya->next;
- WH(t){lp(r,t->value);
- t=t->next;}
- lp(r,x);R Vna(r);}
- Vt*vlesseq(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*vsucc(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*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(le(ya))R y;
- elif(!ya->next)R venlist(st,N,x);
- Lst*r=ln();
- lp(r,x);
- Lst*t=ya;
- WH(t->next){lp(r,t->value);
- t=t->next;}
- R Vna(r);}
- Vt*venlist(St*st,vt*self,Vt*x){Lst*l=ln();
- lp(l,x);R Vna(l);}
- Vt*vjoin(St*st,vt*self,Vt*x,Vt*y){Lst*l=ln();
- if(xt==ARRAY&&!le(xa)){Lst*t=xa;
- WH(t){lp(l,t->value);
- t=t->next;}}else lp(l,x);
- if(yt==ARRAY&&!le(ya)){Lst*t=ya;
- WH(t){lp(l,t->value);
- t=t->next;}}else lp(l,y);R Vna(l);}
- Vt*venpair(St*st,vt*self,Vt*x,Vt*y){Lst*l=ln();
- lp(l,x);
- lp(l,y);R Vna(l);}
- Vt*vselfref1(St*st,vt*self,Vt*x){vt*v;
- if(!le(st->args))v=li(li(st->args,-1),-1);
- elif(!le(st->selfrefs))v=li(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(!le(st->args))v=li(li(st->args,-1),-1);
- elif(!le(st->selfrefs))v=li(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||le(ya))R st->unit;
- B rev=xn<0;
- Z k=(Z)fabs(xn);
- Lst*t=ya;
- Lst*r=ln();
- if(rev)for(SZ i=k;i>0;i--){Vt*v=li(t,-i);
- if(!v)CN;
- lp(r,v);}
- else WH(t&&k){lp(r,t->value);
- t=t->next;
- k--;}
- R Vna(r);}
- R st->udf;}
- Vt*vwhere(St*st,vt*self,Vt*x){if(xt!=ARRAY)x=venlist(st,N,x);
- elif(le(xa))R x;
- Lst*r=ln();
- Lst*t=xa;
- Z i=0;
- WH(t){Vt*a=t->value;
- if(a->tag!=NUM)BR;
- Z k=fabs(a->val.number);
- for(Z j=0;j<k;j++)lp(r,Vnn(i));
- t=t->next;
- i++;}
- R Vna(r);}
- Vt*vcopy(St*st,vt*self,Vt*x,Vt*y){if(xt!=ARRAY)x=venlist(st,N,x);
- if(yt!=ARRAY)y=venlist(st,N,y);
- Lst*tx=xa;
- Lst*ty=ya;
- if(le(tx)||le(ty))R st->unit;
- Lst*r=ln();
- WH(tx){Vt*a=tx->value;
- Vt*b=ty->value;
- if(b->tag!=NUM)BR;
- Z k=fabs(b->val.number);
- for(Z i=0;i<k;i++)lp(r,a);
- tx=tx->next;
- if(ty->next)ty=ty->next;}
- R Vna(r);}
- Vt*vnub(St*st,vt*self,Vt*x){if(xt!=ARRAY||le(xa))R x;
- Lst*n=ln();
- Lst*r=ln();
- Lst*t=xa;
- WH(t){B u=T;
- Lst*t2=r;
- if(!le(t2))WH(t2){if(Veq(t->value,t2->value)){u=F;BR;}
- t2=t2->next;}
- if(u)lp(r,t->value);
- lp(n,u?NUMS[1]:NUMS[0]);
- t=t->next;}
- WH(r){Lst*tmp=r->next;
- FR(r);
- r=tmp;}
- 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(le(ya))R st->unit;
- B rev=xn<0;
- Z k=(Z)fabs(xn);
- Lst*t=ya;
- if(rev){Z l=ll(t);
- if(k>=l)R st->unit;R vtake(st,N,Vnn(l-k),y);}
- Lst*r=ln();
- WH(t&&k){t=t->next;
- k--;}
- WH(t){lp(r,t->value);
- t=t->next;}
- R Vna(r);}
- R st->udf;}
- Vt*vunique(St*st,vt*self,Vt*x){if(xt!=ARRAY||le(xa))R x;
- Lst*r=ln();
- Lst*t=xa;
- WH(t){B u=T;
- Lst*t2=r;
- if(!le(t2))WH(t2){if(Veq(t->value,t2->value)){u=F;BR;}
- t2=t2->next;}
- if(u)lp(r,t->value);
- t=t->next;}
- R Vna(r);}
- Vt*vfind(St*st,vt*self,Vt*x,Vt*y){if(yt!=ARRAY)y=venlist(st,self,y);
- elif(le(ya))R st->unit;
- Z i=0;
- Lst*r=ln();
- Lst*t=ya;
- WH(t){if(Veq(t->value,x))lp(r,Vnn(i));
- t=t->next;
- i++;}
- R Vna(r);}
- Vt*vcount(St*st,vt*self,Vt*x){if(xt!=ARRAY)R NUMS[1];R Vnn(ll(xa));}
- V flatten(Vt*v,Lst*r){if(v->tag==ARRAY){Lst*t=v->val.array;
- WH(t){flatten(t->value,r);
- t=t->next;}}else lp(r,v);}
- Vt*vflatten(St*st,vt*self,Vt*x){if(xt!=ARRAY||le(xa))R x;
- Lst*r=ln();
- flatten(x,r);R Vna(r);}
- Vt*vminand(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*vreverse(St*st,vt*self,Vt*x){if(xt!=ARRAY)R x;
- Lst*t=xa;
- if(le(t))R x;
- Lst*r=ln();
- for(SZ i=ll(t)-1;i>=0;i--)lp(r,li(t,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||le(ya)||!ya->next)R x;
- if(xt!=NUM)R st->udf;
- B rev=xn<0;
- Z k=fabs(xn);
- Lst*r=ln();
- Lst*t=ya;
- WH(t){lp(r,t->value);
- t=t->next;}
- for(Z i=0;i<k;i++){Vt*v;
- if(rev){v=r->value;
- r=r->next;
- lp(r,v);}else{v=lP(r);
- r=lI(&r,0,v);}}
- R Vna(r);}
- Vt*vwindows(St*st,vt*self,Vt*x,Vt*y){if(yt!=ARRAY)y=venlist(st,N,y);
- elif(le(ya))R y;
- Z k=fabs(xn);
- Z l=ll(ya);
- Lst*r=ln();
- for(Z i=0;i<l;i++){if(i+k>l)BR;
- lp(r,vtake(st,N,Vnn(k),vdrop(st,N,Vnn(i),y)));}
- R Vna(r);}
- Z depthOf(Vt*x,Z d){if(xt==ARRAY){Lst*t=xa;
- if(le(t))R 0;
- WH(t){Z d2=depthOf(t->value,d+1);
- if(d2>d)d=d2;
- t=t->next;}
- 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(le(xa))R st->nil;
- Vt*v=li(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(le(ya))R NUMS[0];
- Lst*t=ya;
- WH(t){if(Veq(t->value,x))R NUMS[1];
- t=t->next;}
- R NUMS[0];}
- Vt*vshuffle(St*st,vt*self,Vt*x){if(xt!=ARRAY)x=venlist(st,self,x);
- elif(le(xa))R x;
- Lst*t=xa;
- Z l=0;
- Lst*r=ln();
- WH(t){lp(r,t->value);
- t=t->next;l++;}
- for(Z i=0;i<l;i++){Z j=rand()%l;
- Vt*tmp=li(r,i);
- ls(r,i,li(r,j));
- ls(r,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(le(xa))R x;
- if(yt!=ARRAY)y=venlist(st,self,x);
- elif(le(ya))R y;
- Z xl=ll(xa);
- Lst*bins=ln();
- for(Z i=0;i<xl;i++){D s;
- D e;
- Vt*vs=li(xa,i);
- if(vs->tag==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):li(xa,i+1);
- if(ve->tag==NUM)e=fabs(ve->val.number);
- elif(ve->tag==CHAR)e=ve->val._char;
- else R st->udf;
- if(ll(bins)>0){Lst*pp=li(bins,-1);
- D*pe=pp->value;
- if(s<=(*pe))R st->udf;}
- D*sn=ma(SO(D));
- *sn=s;
- D*en=ma(SO(D));
- *en=e;
- Lst*p=ln();
- lp(p,sn);
- lp(p,en);
- lp(bins,p);}
- Z bl=ll(bins);
- Lst*r=ln();
- Z yl=ll(ya);
- for(Z i=0;i<yl;i++){Vt*it=li(ya,i);
- D itv;
- if(it->tag==NUM)itv=it->val.number;
- elif(it->tag==CHAR)itv=it->val._char;
- else R st->udf;
- Lst*b=bins->value;
- D*s=b->value;
- if(itv<(*s)){lp(r,NNUMS[0]);CN;}
- b=li(bins,-1);
- s=b->next->value;
- if(itv>=(*s)){lp(r,Vnn(bl-1));CN;}
- D v=NAN;
- for(Z j=0;j<bl;j++){b=li(bins,j);
- D*s=b->value;
- D*e=b->next->value;
- if(itv>=(*s)&&itv<(*e)){v=j;BR;}}
- if(!isnan(v))lp(r,Vnn(v));}
- WH(bins){Lst*tmp=bins->next;
- Lst*b=bins->value;
- FR(b->next->value);
- FR(b->next);
- FR(b->value);
- FR(b);
- FR(bins);
- bins=tmp;}
- R Vna(r);}
- Vt*vtail(St*st,vt*self,Vt*x){if(xt!=ARRAY)R x;
- if(le(xa))R st->udf;R li(xa,-1);}
- Vt*vcut(St*st,vt*self,Vt*x,Vt*y){if(xt!=ARRAY)x=venlist(st,self,x);
- elif(le(xa))R x;
- if(yt!=ARRAY)y=venlist(st,self,x);
- elif(le(ya))R x;
- if(ll(xa)!=2)R st->udf;
- Vt*vs=xa->value;
- Vt*ve=xa->next->value;
- if(vs->tag!=NUM||ve->tag!=NUM)R st->udf;
- Z s=fabs(vs->val.number);
- Z e=fabs(ve->val.number);
- Lst*r=ln();
- Z l=ll(ya);
- Lst*pa=ln();
- for(Z i=s;i<e&&i<l;i++){Vt*v=li(ya,i);
- if(!v)BR;
- lp(pa,v);}
- Lst*pb=ln();
- for(Z i=e;i<l;i++){Vt*v=li(ya,i);
- if(!v)BR;
- lp(pb,v);}
- lp(r,Vna(pa));
- lp(r,Vna(pb));R Vna(r);}
- Vt*vprefixes(St*st,vt*self,Vt*x){if(xt!=ARRAY)x=venlist(st,N,x);
- Lst*r=ln();
- Z i=0;
- Lst*t=xa;
- WH(t){lp(r,vtake(st,N,Vnn(i),x));
- t=t->next;
- i++;}
- lp(r,x);R Vna(r);}
- Vt*vbehead(St*st,vt*self,Vt*x){R vdrop(st,N,NUMS[1],x);}
- Vt*vcurtail(St*st,vt*self,Vt*x){R vdrop(st,N,NNUMS[0],x);}
- Vt*vsuffixes(St*st,vt*self,Vt*x){if(xt!=ARRAY)x=venlist(st,N,x);
- Lst*r=ln();
- Z i=0;
- Lst*t=xa;
- WH(t){lp(r,vdrop(st,N,Vnn(i),x));
- t=t->next;
- i++;}
- lp(r,st->unit);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=Vshow(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||le(ya)||!ya->next)R st->udf;R apD(st,x,ya->value,ya->next->value);}
- Vt*vshape(St*st,vt*self,Vt*x){if(xt!=ARRAY||le(xa))R st->unit;
- if(!Aap(xa))R venlist(st,N,vcount(st,N,x));
- if(!xa->next)R venlist(st,N,vshape(st,N,xa->value));R venpair(st,N,vcount(st,N,x),vcount(st,N,xa->value));}
- Vt*vreshape(St*st,vt*self,Vt*x,Vt*y){if(yt!=ARRAY)y=venlist(st,N,y);
- elif(le(ya))R y;
- if(xt!=ARRAY)x=venlist(st,N,x);
- elif(le(xa))R st->unit;
- Lst*r;
- if(!xa->next){Vt*a=xa->value;
- if(a->tag!=NUM)R st->udf;
- Z k=fabs(a->val.number);
- Lst*t=ln();
- flatten(y,t);
- r=ln();
- WH(k){lp(r,t->value);
- if(t->next)t=t->next;
- k--;}}elif(xa->next){Vt*a=xa->value;
- if(a->tag!=NUM)R st->udf;
- Vt*b=xa->next->value;
- 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);
- Lst*t=ya;
- r=ln();
- WH(k--){Lst*rw=ln();
- for(Z i=0;i<l;i++){lp(rw,t->value);
- t=t->next;}
- lp(r,Vna(rw));}}else R st->udf;R Vna(r);}
- Vt*vrepr(St*st,vt*self,Vt*x){S s=Vshow(x);
- Lst*r=ln();
- for(Z i=0;i<strlen(s);i++)lp(r,Vnc(s[i]));
- FR(s);R Vna(r);}
- S format(S template,Lst*replaces){Bt*text=Bnew();
- B skip=F;
- Z ri=0;
- Z tl=strlen(template);
- Z rl=ll(replaces);
- for(Z i=0;i<tl;i++){C c=template[i];
- if(skip){Bappend(text,c);
- skip=F;CN;}
- if(c=='_'){S s=Vshow(li(replaces,ri));
- BappendS(text,s);
- FR(s);
- if(ri<rl-1)ri++;CN;}elif(c=='{'){Z bi=i;
- Bt*n=Bnew();
- i++;
- WH(i<tl&&template[i]!='}')Bappend(n,template[i++]);
- if(i>=tl||template[i]!='}'){FR(Bread(n));
- Bappend(text,'{');
- i=bi;CN;}
- S s=Bread(n);
- SZ ind=atoi(s);
- FR(s);
- Vt*v=li(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(le(ya))R y;
- S fmt=Vshow(x);
- S s=format(fmt,ya);
- FR(fmt);
- Lst*r=ln();
- WH(*s)lp(r,Vnc(*s++));R Vna(r);}
- Vt*vinsert(St*st,vt*self,Vt*x,Vt*y){if(yt!=ARRAY)y=venlist(st,N,y);
- Lst*r=ln();
- Lst*t=ya;
- WH(t){lp(r,t->value);
- if(t->next)lp(r,x);
- t=t->next;}
- 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);
- Lst*r=ln();
- if(s>e)for(SZ i=s;i>=e;i--){if(xt==CHAR||yt==CHAR)lp(r,Vnc(i));
- else lp(r,Vnn(i));}
- else for(SZ i=s;i<=e;i++){if(xt==CHAR||yt==CHAR)lp(r,Vnc(i));
- else lp(r,Vnn(i));}
- R Vna(r);}
- R _NAN;}
- Vt*vdeal(St*st,vt*self,Vt*x){if(xt!=ARRAY)R x;
- Lst*t=xa;
- if(le(t))R st->udf;
- Z i=rand()%ll(t);R li(t,i);}
- Vt*vroll(St*st,vt*self,Vt*x,Vt*y){if(xt==NUM&&yt==NUM){Lst*r=ln();
- Z k=fabs(xn);
- Z d=fabs(yn);
- for(Z i=0;i<k;i++)lp(r,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;
- Lst*r=ln();
- WH(*s)lp(r,Vnc(*s++));R Vna(r);}BR;
- CS NUM:if(yt==CHAR)R Vnn(y->val._char);
- elif(yt==ARRAY&&Cap(ya)){Bt*buf=Bnew();
- Lst*t=ya;
- WH(t){Bappend(buf,((Vt*)t->value)->val._char);
- t=t->next;}
- 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=Vshow(x);
- fprintf(stdout,"%s",s);
- FR(s);R st->nil;}
- Vt*vprintln(St*st,vt*self,Vt*x){S s=Vshow(x);
- fprintf(stdout,"%s\n",s);
- FR(s);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);
- Lst*r=ln();
- for(Z i=0;i<size;i++)lp(r,Vnc(s[i]));
- FR(s);R Vna(r);}
- elif(x==NUMS[1]){C line[512];
- if(!fgets(line,SO(line),stdin))R st->udf;
- Lst*r=ln();
- for(Z i=0;i<strlen(line);i++)lp(r,Vnc(line[i]));R Vna(r);}
- S path=Vshow(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);
- if(!buf)R st->udf;
- size=fread(buf,SO(UC),size,fd);
- fclose(fd);
- FR(path);
- Lst*r=ln();
- for(Z i=0;i<size;i++)lp(r,Vnc(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=Vshow(y);
- fd=fopen(path,"wb");
- if(!fd){FR(path);R NNUMS[0];}}
- Z k=0;
- Lst*t=xa;
- WH(t){UC c;
- Vt*v=t->value;
- if(v->tag==NUM)c=fabs(vn);
- elif(v->tag==CHAR)c=v->val._char;
- else BR;
- fputc(c,fd);
- t=t->next;k++;}
- fclose(fd);
- if(path)FR(path);R Vnn(k);}
- Vt*vsystem(St*st,vt*self,Vt*x){S cmd=Vshow(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;
- if(!buffer)buffer=ma(Ballocated);
- else buffer=mrea(buffer,Ballocated);
- if(!buffer){FR(cmd);
- pclose(pd);R st->udf;}}
- for(Z i=0;i<bytes_received;i++)buffer[head+i]=chunk[i];
- if(feof(pd))BR;}
- pclose(pd);
- FR(cmd);
- Lst*r=ln();
- for(Z i=0;i<Bsize;i++)lp(r,Vnc(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,const S 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(const S 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=Vshow(y);
- files_t*pd;
- pd=popen2(cmd);
- if(pd==N){FR(cmd);R st->udf;}
- Lst*t=xa;
- WH(t){UC c;
- Vt*v=t->value;
- if(v->tag==NUM)c=fabs(vn);
- elif(v->tag==CHAR)c=v->val._char;
- else BR;
- fputc(c,pd->in);
- t=t->next;}
- 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;
- if(!buffer)buffer=ma(Ballocated);
- else buffer=mrea(buffer,Ballocated);
- if(!buffer){FR(cmd);
- pclose2(pd);R st->udf;}}
- for(Z i=0;i<bytes_received;i++)buffer[head+i]=chunk[i];
- if(feof(pd->out))BR;}
- pclose2(pd);
- FR(cmd);
- Lst*r=ln();
- for(Z i=0;i<Bsize;i++)lp(r,Vnc(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;}
- Lst*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;
- Lst*r=ln();
- for(U64 a=1;a<=limit;a++)if(sieve[a])lp(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(le(ya))R y;
- Lst*r=ln();
- Z l=ll(ya);
- Z k=fabs(xn);
- WH(yt==ARRAY&&!le(ya)){lp(r,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;}
- Lst*prime_factors(D n){Lst*factors=ln();
- D divisor=2;
- WH(n>=2){if(fmod(n,divisor)==0){lp(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)){Vt*n=venpair(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)&&xn>0&&yn>0){U64 a=(U64)fabs(xn);
- U64 b=(U64)fabs(yn);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=Vshow(x);
- jmp_buf*lb=guard();
- if(setjmp(*lb)){unguard();
- FR(s);R st->udf;}
- Vt*v=Srun(st,s);
- FR(s);
- unguard();R v;}
- Vt*vimport(St*st,vt*self,Vt*x){S path=Vshow(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);
- if(!buf)R st->udf;
- size=fread(buf,SO(UC),size,fd);
- fclose(fd);
- FR(path);
- Vt*v=Srun(st,(S )buf);
- FR(buf);R v;}
- Vt*vexplode(St*st,vt*self,Vt*x,Vt*y){S del=Vshow(x);
- S s=Vshow(y);
- Z dell=strlen(del);
- Z sl=strlen(s);
- Lst*r=ln();
- Lst*t=ln();
- for(Z i=0;i<sl;i++){if(strncmp(&s[i],del,dell)==0){lp(r,Vna(t));
- t=ln();
- i+=dell-1;CN;}
- lp(t,CHARS[s[i]]);}
- FR(s);
- FR(del);
- lp(r,Vna(t));R Vna(r);}
- Vt*vimplode(St*st,vt*self,Vt*x,Vt*y){if(yt!=ARRAY||le(ya))R y;
- S del=Vshow(x);
- Lst*r=ln();
- Lst*t=ya;
- WH(t){S s=Vshow(t->value);
- S _s=s;
- WH(*_s)lp(r,CHARS[*_s++]);
- FR(s);
- if(t->next){S s=del;
- WH(*s)lp(r,CHARS[*s++]);}
- t=t->next;}
- FR(del);R Vna(r);}
- Vt*veye(St*st,vt*self,Vt*x){if(xt==NUM&&!spnp(xn)){Z k=fabs(xn);
- Lst*r=ln();
- for(Z i=0;i<k;i++){Lst*rw=ln();
- for(Z j=0;j<k;j++)lp(rw,NUMS[i==j]);
- lp(r,Vna(rw));}
- R Vna(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(":",0,0,0,udf1,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),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("f",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,udf2)};
- Vt*_advfold_m(St*st,vt*self,Vt*x){if(xt!=ARRAY||le(xa))R x;
- Vt*_v=self->bonds->value;
- if(_v->tag!=VERB)R st->udf;
- vt*v=_v->val.verb;
- Vt*t=xa->value;
- Lst*tx=xa->next;
- WH(tx){t=tgth(st,v,t,tx->value,0,0,v->rank[1],v->rank[2]);
- tx=tx->next;}
- R t;}
- Vt*_advfold_d(St*st,vt*self,Vt*x,Vt*y){if(yt!=ARRAY||le(ya))R y;
- Vt*_v=self->bonds->value;
- if(_v->tag!=VERB)R st->udf;
- vt*v=_v->val.verb;
- Vt*t=x;
- Lst*ty=ya;
- WH(ty){t=tgth(st,v,t,ty->value,0,0,v->rank[1],v->rank[2]);
- ty=ty->next;}
- R t;}
- Vt*_advscan_m(St*st,vt*self,Vt*x){if(xt!=ARRAY||le(xa))R x;
- Vt*_v=self->bonds->value;
- if(_v->tag!=VERB)R st->udf;
- vt*v=_v->val.verb;
- Lst*r=ln();
- Vt*t=xa->value;
- Lst*tx=xa->next;
- lp(r,t);
- WH(tx){t=tgth(st,v,t,tx->value,0,0,v->rank[1],v->rank[2]);
- lp(r,t);
- tx=tx->next;}
- R Vna(r);}
- Vt*_advscan_d(St*st,vt*self,Vt*x,Vt*y){if(yt!=ARRAY||le(ya))R y;
- Vt*_v=self->bonds->value;
- if(_v->tag!=VERB)R st->udf;
- vt*v=_v->val.verb;
- Lst*r=ln();
- Vt*t=x;
- Lst*ty=ya;
- lp(r,t);
- WH(ty){t=tgth(st,v,t,ty->value,0,0,v->rank[1],v->rank[2]);
- lp(r,t);
- ty=ty->next;}
- R Vna(r);}
- Vt*_adveach_m(St*st,vt*self,Vt*x){Vt*_v=self->bonds->value;
- if(_v->tag!=VERB)R st->udf;
- vt*v=_v->val.verb;
- if(xt!=ARRAY)R eR(st,v,x,0,1);
- if(le(xa))R x;R eR(st,v,x,0,1);}
- Vt*_adveach_d(St*st,vt*self,Vt*x,Vt*y){Vt*_v=self->bonds->value;
- 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);
- Lst*r=ln();
- Lst*tx=xa;
- Lst*ty=ya;
- WH(tx&&ty){lp(r,tgth(st,v,tx->value,ty->value,0,0,v->rank[1],v->rank[2]));
- tx=tx->next;
- ty=ty->next;}
- R Vna(r);}
- Vt*_advconverge_m(St*st,vt*self,Vt*x){Vt*_v=self->bonds->value;
- 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->value;
- 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(le(ya))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->value;
- if(_v->tag!=VERB)R st->udf;
- Lst*r=ln();
- Vt*t;
- lp(r,x);
- LOOP{t=x;
- x=apM(st,_v,x);
- if(Veq(x,t))BR;
- lp(r,x);}
- R Vna(r);}
- Vt*_advconverges_d(St*st,vt*self,Vt*x,Vt*y){Vt*_v=self->bonds->value;
- 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(le(ya))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||le(xa)||!xa->next)R x;
- Vt*_v=self->bonds->value;
- if(_v->tag!=VERB)R st->udf;
- vt*v=_v->val.verb;
- Lst*r=ln();
- Lst*p=xa;
- Lst*t=xa->next;
- WH(t){lp(r,tgth(st,v,t->value,p->value,0,0,v->rank[1],v->rank[2]));
- p=t;
- t=t->next;}
- R Vna(r);}
- Vt*_adveachprior_d(St*st,vt*self,Vt*x,Vt*y){if(yt!=ARRAY||le(ya))R y;
- Vt*_v=self->bonds->value;
- if(_v->tag!=VERB)R st->udf;
- vt*v=_v->val.verb;
- Lst*r=ln();
- Lst*p=N;
- Lst*t=ya;
- WH(t){lp(r,tgth(st,v,t->value,!p?x:p->value,0,0,v->rank[1],v->rank[2]));
- p=t;
- t=t->next;}
- R Vna(r);}
- Vt*_advreflex_m(St*st,vt*self,Vt*x){Vt*_v=self->bonds->value;
- 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->value;
- 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->value;
- if(v->tag!=ARRAY)v=venlist(st,N,v);
- if(yt!=ARRAY)y=venlist(st,N,y);
- Lst*r=lc(ya);
- Z i=0;
- Z l=ll(xa);
- Lst*t=v->val.array;
- WH(t){Vt*n=t->value;
- if(n->tag!=NUM)BR;
- ls(r,n->val.number,li(xa,i<l?i:l-1));
- t=t->next;
- i++;}
- R Vna(r);}
- Vt*_advfilter_m(St*st,vt*self,Vt*x){Vt*_v=self->bonds->value;
- if(_v->tag!=VERB)R st->udf;
- if(xt!=ARRAY)x=venlist(st,N,x);
- elif(le(xa))R x;
- vt*v=_v->val.verb;
- Lst*r=ln();
- Lst*t=xa;
- WH(t){Vt*b=eR(st,v,t->value,0,v->rank[0]);
- if(VTp(b))lp(r,t->value);
- t=t->next;}
- 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->value;
- if(v->tag!=VERB)R st->udf;
- if(xt!=ARRAY)x=venlist(st,N,x);
- elif(le(xa))R x;
- Lst*r=ln();
- Lst*t=xa;
- Lst*p=ln();
- WH(t){Vt*b=apM(st,v,t->value);
- if(VTp(b)){lp(r,Vna(p));
- p=ln();}else lp(p,t->value);
- t=t->next;}
- lp(r,Vna(p));R Vna(r);}
- Vt*_advspan_d(St*st,vt*self,Vt*x,Vt*y){Vt*_v=self->bonds->value;
- 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->value;
- 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->value;
- 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=ln();\
- lp(nv->bonds,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->value;
- Vt*v2=self->bonds->next->value;
- 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->nil;}
- Vt*_cnjbond_d(St*st,vt*self,Vt*x,Vt*y){Vt*v1=self->bonds->value;
- Vt*v2=self->bonds->next->value;
- 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->nil;}
- Vt*_cnjpick_m(St*st,vt*self,Vt*x){Vt*v1=self->bonds->value;
- Vt*v2=self->bonds->next->value;
- if(v1->tag!=VERB||v2->tag!=ARRAY)R st->nil;
- 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->value;
- Vt*v2=self->bonds->next->value;
- if(v1->tag!=VERB||v2->tag!=ARRAY)R st->nil;
- 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->value;
- Vt*v2=self->bonds->next->value;
- 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;i<k;i++)x=apM(st,v2,x);}
- R x;}
- Vt*_cnjwhile_d(St*st,vt*self,Vt*x,Vt*y){Vt*v1=self->bonds->value;
- Vt*v2=self->bonds->next->value;
- 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;i<k;i++)x=apD(st,v2,x,y);}
- R x;}
- Vt*_cnjrank_m(St*st,vt*self,Vt*x){Vt*v1=self->bonds->value;
- Vt*v2=self->bonds->next->value;
- 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->value;
- Vt*v2=self->bonds->next->value;
- if(v1->tag!=VERB||v2->tag!=NUM)R st->udf;
- UI rank=
- v2->val.number==INFINITY?UINT_MAX:fabs(v2->val.number);R tgth(st,v1->val.verb,x,y,0,0,rank,rank);}
- Vt*_cnjmonaddyad_m(St*st,vt*self,Vt*x){Vt*v=self->bonds->value;
- 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->next->value;
- 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->value;
- Vt*v2=self->bonds->next->value;
- 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->value;
- Vt*v2=self->bonds->next->value;
- 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->value;
- Vt*v2=self->bonds->next->value;
- 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->value;
- Vt*v2=self->bonds->next->value;
- 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=ln();\
- lp(nv->bonds,x);\
- lp(nv->bonds,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;i<AE(table);i++){\
- if(strcmp(table[i].name,s)==0)\
- R &table[i];}\
- R N;}
- FINDER(vt,v,VERBS);
- FINDER(advt,adv,ADVERBS);
- FINDER(advt,cnj,CONJUNCTIONS);
- Nt*Nn(enum Ntag_t tag){Nt*node=ma(SO(Nt));
- node->tag=tag;R node;}
- Nt*Nns(Lst*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;}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 li(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->value;
- if(xt!=VERB)R st->nil;R Vnv(av->adverb(st,x));}
- Vt*_advwrapper_d(St*st,vt*self,Vt*x,Vt*y){advt*av=self->bonds->value;
- if(xt!=VERB)R st->nil;
- 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=ln();
- lp(nv->bonds,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->value;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=ln();
- lp(nv->bonds,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;}
- node=PPexpr(parser);
- 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_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{Lst*list=ln();
- for(Z i=0;i<strlen(tok->text);i++)lp(list,Vnc(tok->text[i]));
- node=Nnl(Vna(list));}BR;}
- if(!node)Perror(parser,"parse");
- Peat(parser);R node;}
- Nt*PPa(Pt*parser,Nt*a,enum Tkt tag){Tkt*tok;
- if((tok=Plook(parser,0))&&tok->tag==tag){Lst*as=ln();
- lp(as,a->v);
- do{a=PPatom(parser);
- lp(as,a->v);}WH((tok=Plook(parser,0))&&tok->tag==tag);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&&(n=PPa(parser,a,T_NAME)))R n;
- elif(a->tag==N_LITERAL&&a->v->tag==ARRAY&&Cap(a->v->val.array)&&(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);
- Lst*l=ln();
- lp(l,a);
- LOOP{a=flat?PPatom(parser):_PPnoun(parser);
- lp(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;
- Lst*ns=ln();
- WH(!Pstop(parser)){if(le(ns)&&(tmp=Plook(parser,0))&&tmp->tag==T_PUNCT&&strcmp(tmp->text,":")==0&&(Plook(parser,1))){Peat(parser);R Nn1(N_FUN,PPexpr(parser));}
- Nt*n=PPnoun(parser,F);
- if(le(ns)&&n->tag==N_LITERAL&&n->v->tag==SYM&&(tmp=Plook(parser,0))&&tmp->tag==T_PUNCT&&strcmp(tmp->text,":")==0){Peat(parser);R Nn2(N_BIND,n,PPexpr(parser));}
- LOOP{B flag=F;
- n=PPadv(parser,n,&flag);
- n=PPcnj(parser,n,&flag);
- if(!flag)BR;}
- lp(ns,n);}
- Z len;
- Nt*l,*m,*r;
- LOOP{len=ll(ns);
- if(len<2)BR;
- if(len>=3&&is_apply(li(ns,-2))||is_obverse(li(ns,-2))){r=lP(ns);
- m=lP(ns);
- l=lP(ns);
- lp(ns,Nn3(N_DYAD,m,l,r));}elif(len>=3&&!Nisv(parser,li(ns,-1))&&Nisv(parser,li(ns,-2))&&!Nisv(parser,li(ns,-3))){r=lP(ns);
- m=lP(ns);
- l=lP(ns);
- lp(ns,Nn3(N_DYAD,m,l,r));}elif(len>=3&&Nisv(parser,li(ns,-1))&&Nisv(parser,li(ns,-2))&&Nisv(parser,li(ns,-3))){r=lP(ns);
- m=lP(ns);
- l=lP(ns);
- lp(ns,Nn3(N_FORK,l,m,r));}elif(len>=3&&Nisv(parser,li(ns,-1))&&Nisv(parser,li(ns,-2))&&!Nisv(parser,li(ns,-3))){r=lP(ns);
- m=lP(ns);
- l=lP(ns);
- lp(ns,Nn3(N_OVER,l,m,r));}elif(len>=2&&is_apply(li(ns,-1))){r=lP(ns);
- l=lP(ns);
- lp(ns,Nn2(N_BOND,r,l));}elif(len>=2&&!Nisv(parser,li(ns,-1))&&Nisv(parser,li(ns,-2))){r=lP(ns);
- l=lP(ns);
- lp(ns,Nn2(N_MONAD,l,r));}elif(len>=2&&Nisv(parser,li(ns,-1))&&Nisv(parser,li(ns,-2))){r=lP(ns);
- l=lP(ns);
- lp(ns,Nn2(N_HOOK,l,r));}elif(len>=2&&Nisv(parser,li(ns,-1))&&!Nisv(parser,li(ns,-2))){r=lP(ns);
- l=lP(ns);
- lp(ns,Nn2(N_BOND,r,l));}elif(len>=3){r=lP(ns);
- m=lP(ns);
- l=lP(ns);
- lp(ns,Nn3(N_INDEX2,m,l,r));}elif(len>=2){r=lP(ns);
- l=lP(ns);
- lp(ns,Nn2(N_INDEX1,l,r));}}
- R ns->value;}
- Nt*Pparse(Pt*parser,Lt*lexer){parser->lexer=lexer;
- parser->pos=0;
- parser->end=ll(parser->lexer->tokens);
- 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);
- Lst*t=lexer->tokens;
- if(t->value)WH(t){Lst*tmp=t->next;
- Tkt*tok=t->value;
- if(tok->text)FR(tok->text);
- FR(tok);
- FR(t);
- t=tmp;}
- 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"\
- ":: 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 ame as , enlist but with infinite rank, ,.1 2 3 is (,1),:(,2),:(,3)" "\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"\
- "@. dyadicn member check whether x is 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"\
- "f. monadic selfref1 monadic reference to current function or rhs of bind" "\n"\
- "f. 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"\
- "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"\
- "";
- 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\": rank 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 inverse (~fx)~f~fx" "\n"\
- "f^:Fx under ~FfFx" "\n"\
- "xf^:Fx under ~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"\
- "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";
- const S VSTR=VER " " __DATE__;
- I main(I argc,S*argv){GC_INIT();
- GC_enable_incremental();
- guards=ln();
- Iin=isatty(0);
- HASH_SEED=time(N);
- srand(HASH_SEED);
- VCACHE=Tnew();
- SCACHE=Tnew();
- for(Z i=0;i<AE(VERBS);i++){Vt*v=VnC(VERB);
- v->val.verb=&VERBS[i];
- Tset(VCACHE,VERBS[i].name,v);}
- _UNIT=Vnew(ARRAY);
- _UNIT->val.array=ln();
- 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;
- Lst*vs=ln();
- for(Z i=0;i<strlen(VSTR);i++)lp(vs,CHARS[VSTR[i]]);
- Tset(st->env,"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("]@>:"));
- Lst*args=ln();
- for(I i=1;i<argc;i++){Lst*arg=ln();
- S s=argv[i];
- WH(*s)lp(arg,CHARS[*s++]);
- lp(args,Vna(arg));}
- Tset(st->env,"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;}
- LOOP{Bt*buffer;
- C line[256];
- buffer=Bnew();
- if(Iin)putc('\t',stdout);
- if(!fgets(line,SO(line),stdin))BR;
- if(Iin){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(Iin)putc('\t',stdout);
- if(!fgets(line,SO(line),stdin))R 0;}
- BappendS(buffer,line);
- s=Bread(buffer);
- Vt*v=Srun(st,s);
- FR(s);s=N;
- if(v->tag!=NIL){Tset(st->env,"it",v);
- S s=Vshow(v);
- fputs(s,stdout);
- if(Iin)putc('\n',stdout);}}}
|