jk.c 141 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194419541964197419841994200420142024203420442054206420742084209421042114212421342144215421642174218421942204221422242234224422542264227422842294230423142324233423442354236423742384239424042414242424342444245424642474248424942504251425242534254425542564257425842594260426142624263426442654266426742684269427042714272427342744275427642774278427942804281428242834284428542864287428842894290429142924293429442954296429742984299430043014302430343044305430643074308430943104311431243134314431543164317431843194320432143224323432443254326432743284329433043314332433343344335433643374338433943404341434243434344434543464347434843494350435143524353435443554356435743584359436043614362436343644365436643674368436943704371437243734374437543764377437843794380438143824383438443854386438743884389439043914392439343944395439643974398439944004401440244034404440544064407440844094410441144124413441444154416441744184419442044214422442344244425442644274428442944304431443244334434443544364437443844394440444144424443444444454446444744484449445044514452445344544455445644574458445944604461446244634464446544664467446844694470447144724473447444754476447744784479448044814482448344844485448644874488448944904491449244934494449544964497449844994500450145024503450445054506450745084509451045114512451345144515451645174518451945204521452245234524452545264527452845294530453145324533453445354536453745384539454045414542454345444545454645474548454945504551455245534554455545564557455845594560456145624563456445654566456745684569457045714572457345744575457645774578457945804581458245834584458545864587458845894590459145924593459445954596459745984599460046014602460346044605460646074608460946104611461246134614461546164617461846194620462146224623462446254626462746284629463046314632463346344635463646374638463946404641464246434644464546464647464846494650465146524653465446554656465746584659466046614662466346644665466646674668466946704671467246734674467546764677467846794680468146824683468446854686468746884689469046914692469346944695469646974698469947004701470247034704470547064707470847094710471147124713471447154716471747184719472047214722472347244725472647274728472947304731473247334734473547364737473847394740474147424743474447454746474747484749475047514752475347544755475647574758475947604761476247634764476547664767476847694770477147724773477447754776477747784779478047814782478347844785478647874788478947904791479247934794479547964797479847994800480148024803480448054806480748084809481048114812481348144815481648174818481948204821482248234824482548264827482848294830483148324833483448354836483748384839484048414842484348444845484648474848484948504851485248534854485548564857485848594860486148624863486448654866486748684869487048714872487348744875487648774878487948804881488248834884488548864887488848894890489148924893489448954896489748984899490049014902490349044905490649074908490949104911491249134914491549164917491849194920492149224923492449254926492749284929493049314932493349344935493649374938493949404941494249434944494549464947494849494950495149524953495449554956495749584959496049614962496349644965496649674968496949704971497249734974497549764977497849794980498149824983498449854986498749884989499049914992499349944995499649974998499950005001500250035004500550065007500850095010501150125013501450155016501750185019502050215022502350245025502650275028502950305031503250335034503550365037503850395040504150425043504450455046504750485049505050515052505350545055505650575058505950605061506250635064506550665067506850695070507150725073507450755076507750785079508050815082508350845085508650875088508950905091509250935094509550965097509850995100510151025103510451055106510751085109511051115112511351145115511651175118511951205121512251235124512551265127512851295130513151325133513451355136513751385139514051415142514351445145514651475148514951505151515251535154515551565157515851595160516151625163516451655166516751685169517051715172517351745175517651775178517951805181518251835184518551865187518851895190519151925193519451955196519751985199520052015202520352045205520652075208520952105211521252135214521552165217521852195220522152225223522452255226522752285229523052315232523352345235523652375238523952405241524252435244524552465247524852495250525152525253525452555256525752585259526052615262526352645265526652675268526952705271527252735274527552765277527852795280528152825283528452855286528752885289529052915292529352945295529652975298529953005301530253035304530553065307530853095310531153125313531453155316531753185319532053215322532353245325532653275328532953305331533253335334533553365337533853395340534153425343534453455346534753485349535053515352535353545355535653575358535953605361536253635364536553665367536853695370537153725373537453755376537753785379538053815382538353845385538653875388538953905391539253935394539553965397539853995400540154025403540454055406540754085409541054115412541354145415541654175418541954205421542254235424542554265427542854295430543154325433543454355436543754385439544054415442544354445445544654475448544954505451545254535454545554565457545854595460546154625463546454655466546754685469547054715472547354745475547654775478547954805481548254835484548554865487548854895490549154925493549454955496549754985499550055015502550355045505550655075508550955105511551255135514551555165517551855195520552155225523552455255526552755285529553055315532553355345535553655375538553955405541554255435544554555465547554855495550555155525553555455555556555755585559556055615562556355645565556655675568556955705571557255735574557555765577557855795580558155825583558455855586558755885589559055915592559355945595559655975598559956005601560256035604560556065607560856095610561156125613561456155616561756185619562056215622562356245625562656275628562956305631563256335634563556365637563856395640564156425643564456455646564756485649565056515652565356545655565656575658565956605661566256635664566556665667566856695670567156725673567456755676567756785679568056815682568356845685568656875688568956905691569256935694569556965697569856995700570157025703570457055706570757085709571057115712571357145715571657175718571957205721572257235724572557265727572857295730573157325733573457355736573757385739574057415742574357445745574657475748574957505751575257535754575557565757575857595760576157625763576457655766576757685769577057715772577357745775577657775778577957805781578257835784578557865787578857895790579157925793579457955796579757985799580058015802580358045805580658075808580958105811581258135814581558165817581858195820582158225823582458255826582758285829583058315832583358345835583658375838583958405841584258435844584558465847584858495850585158525853585458555856585758585859586058615862586358645865586658675868586958705871587258735874587558765877587858795880588158825883588458855886588758885889589058915892589358945895589658975898589959005901590259035904590559065907590859095910591159125913591459155916591759185919592059215922592359245925592659275928592959305931593259335934593559365937593859395940594159425943594459455946594759485949595059515952595359545955595659575958595959605961596259635964596559665967596859695970597159725973597459755976597759785979598059815982598359845985598659875988598959905991599259935994599559965997599859996000600160026003600460056006600760086009601060116012601360146015601660176018601960206021602260236024602560266027602860296030603160326033603460356036603760386039604060416042604360446045604660476048604960506051605260536054605560566057605860596060606160626063606460656066606760686069607060716072607360746075607660776078607960806081608260836084608560866087608860896090609160926093609460956096609760986099610061016102610361046105610661076108610961106111611261136114611561166117611861196120612161226123612461256126612761286129613061316132613361346135613661376138613961406141614261436144614561466147614861496150615161526153615461556156615761586159616061616162616361646165616661676168616961706171617261736174617561766177617861796180618161826183618461856186618761886189619061916192619361946195619661976198619962006201620262036204620562066207620862096210621162126213621462156216621762186219622062216222622362246225622662276228622962306231623262336234623562366237623862396240624162426243624462456246624762486249625062516252625362546255625662576258625962606261626262636264626562666267626862696270627162726273627462756276627762786279628062816282628362846285628662876288628962906291629262936294629562966297629862996300630163026303630463056306630763086309631063116312631363146315631663176318631963206321632263236324632563266327632863296330633163326333633463356336633763386339634063416342634363446345634663476348634963506351635263536354635563566357635863596360636163626363636463656366636763686369637063716372637363746375637663776378637963806381638263836384638563866387638863896390639163926393639463956396639763986399640064016402640364046405640664076408640964106411641264136414641564166417641864196420642164226423642464256426642764286429643064316432643364346435643664376438643964406441644264436444644564466447644864496450645164526453645464556456645764586459646064616462646364646465646664676468646964706471647264736474647564766477647864796480648164826483648464856486648764886489649064916492649364946495649664976498649965006501650265036504650565066507650865096510651165126513651465156516651765186519652065216522652365246525652665276528652965306531653265336534653565366537653865396540654165426543654465456546654765486549655065516552655365546555655665576558655965606561656265636564656565666567656865696570657165726573657465756576657765786579658065816582658365846585658665876588658965906591659265936594659565966597659865996600660166026603660466056606660766086609661066116612661366146615661666176618661966206621662266236624662566266627662866296630
  1. #include <ctype.h>
  2. #include <limits.h>
  3. #include <math.h>
  4. #include <setjmp.h>
  5. #include <stdbool.h>
  6. #include <stdint.h>
  7. #include <stdio.h>
  8. #include <stdlib.h>
  9. #include <string.h>
  10. #include <time.h>
  11. #include <unistd.h>
  12. #include <sys/wait.h>
  13. #include <errno.h>
  14. #include <gc.h>
  15. #include "version.h"
  16. /* HEAD HEAD */
  17. jmp_buf interactive_checkpoint;
  18. bool is_interactive;
  19. void *malloc_checked(size_t size) {
  20. void *p;
  21. if (!(p = GC_MALLOC(size)))
  22. abort();
  23. return p;
  24. }
  25. void *malloc_checked_atomic(size_t size) {
  26. void *p;
  27. if (!(p = GC_malloc_atomic(size)))
  28. abort();
  29. memset(p, 0, size);
  30. return p;
  31. }
  32. void *malloc_checked_uncollectable(size_t size) {
  33. void *p;
  34. if (!(p = GC_malloc_uncollectable(size)))
  35. abort();
  36. memset(p, 0, size);
  37. return p;
  38. }
  39. void *realloc_checked(void *p, size_t size) {
  40. if (!(p = GC_REALLOC(p, size)))
  41. abort();
  42. return p;
  43. }
  44. char *strdup_checked(char *s) {
  45. char *p = GC_strdup(s);
  46. if (!p)
  47. abort();
  48. return p;
  49. }
  50. typedef struct _list_t list_t;
  51. struct _list_t {
  52. void *value;
  53. list_t *next;
  54. };
  55. list_t *list_new(void) {
  56. list_t *list = malloc_checked(sizeof(list_t));
  57. list->value = NULL;
  58. list->next = NULL;
  59. return list;
  60. }
  61. bool list_empty(list_t *list) {
  62. return (!(list)->value);
  63. }
  64. size_t list_length(list_t *list) {
  65. size_t length = 0;
  66. if (list_empty(list))
  67. return length;
  68. do {
  69. list = list->next, length++;
  70. } while (list);
  71. return length;
  72. }
  73. void *list_index(list_t *list, ssize_t index) {
  74. size_t length;
  75. if (list_empty(list))
  76. return NULL;
  77. if (index == 0)
  78. return list->value;
  79. length = list_length(list);
  80. if (index < 0)
  81. index += ((ssize_t)length);
  82. if (index < 0 || index >= length)
  83. return NULL;
  84. for (size_t i = 0; i < ((size_t)index); i++)
  85. list = list->next;
  86. return list->value;
  87. }
  88. list_t *list_push(list_t *list, void *value) {
  89. list_t *head = list;
  90. if (list_empty(list)) {
  91. list->value = value;
  92. return head;
  93. }
  94. while (list->next)
  95. list = list->next;
  96. list = list->next = list_new();
  97. list->value = value;
  98. return head;
  99. }
  100. list_t *list_copy(list_t *l) {
  101. list_t *r = list_new();
  102. if (!list_empty(l))
  103. while (l) {
  104. list_push(r, l->value);
  105. l = l->next;
  106. }
  107. return r;
  108. }
  109. void *list_pop(list_t *list) {
  110. if (list_empty(list))
  111. return NULL;
  112. if (!list->next) {
  113. void *value = list->value;
  114. list->value = NULL;
  115. return value;
  116. }
  117. list_t *head = list;
  118. while (list) {
  119. if (!list->next) {
  120. void *value = list->value;
  121. list->value = NULL;
  122. head->next = NULL;
  123. return value;
  124. }
  125. head = list;
  126. list = list->next;
  127. }
  128. return NULL;
  129. }
  130. void *list_set(list_t *list, ssize_t index, void *value) {
  131. size_t length = list_length(list);
  132. if (index < 0)
  133. index += ((ssize_t)length);
  134. if (index == ((ssize_t)length)) {
  135. list_push(list, value);
  136. return value;
  137. }
  138. if (index < 0 || index >= length)
  139. return NULL;
  140. for (size_t i = 0; i < ((size_t)index); i++)
  141. list = list->next;
  142. list->value = value;
  143. return value;
  144. }
  145. list_t *list_insert(list_t **list, ssize_t index, void *value) {
  146. list_t *head = *list;
  147. if (index == -1)
  148. return list_push(head, value);
  149. size_t length = list_length(head);
  150. if (index < 0)
  151. index += (ssize_t)length;
  152. if (index < 0 || index > length)
  153. return NULL;
  154. if (index == -1)
  155. return list_push(head, value);
  156. if (index == 0) {
  157. if (list_empty(head))
  158. return list_push(head, value);
  159. list_t *temp = list_new();
  160. temp->value = value;
  161. temp->next = head;
  162. *list = temp;
  163. return temp;
  164. }
  165. list_t *temp0 = *list;
  166. for (size_t i = 0; i < ((size_t)index) - 1; i++)
  167. temp0 = temp0->next;
  168. list_t *temp = temp0->next;
  169. temp0->next = list_new();
  170. temp0->next->value = value;
  171. temp0->next->next = temp;
  172. return head;
  173. }
  174. list_t *list_delete(list_t **list, ssize_t index) {
  175. list_t *head = *list;
  176. if (list_empty(head))
  177. return NULL;
  178. size_t length = list_length(head);
  179. if (index < 0)
  180. index += (ssize_t)length;
  181. if (index < 0 || index >= length)
  182. return NULL;
  183. if (index == 0) {
  184. head->value = NULL;
  185. if (!head->next)
  186. return head;
  187. *list = head->next;
  188. return *list;
  189. }
  190. list_t *temp0 = *list;
  191. for (size_t i = 0; i < ((size_t)index) - 1; i++)
  192. temp0 = temp0->next;
  193. list_t *temp = temp0->next;
  194. temp->value = NULL;
  195. temp0->next = temp->next;
  196. return head;
  197. }
  198. list_t *list_sort(list_t *list, bool (*cmp)(void *, void *)) {
  199. size_t l = list_length(list);
  200. bool s;
  201. for (size_t i = 0; i < l; i++) {
  202. list_t *t = list;
  203. list_t *p = list;
  204. s = false;
  205. while (t->next) {
  206. list_t *n = t->next;
  207. if (cmp(t->value, n->value)) {
  208. s = true;
  209. if (t == list) {
  210. t->next = n->next;
  211. n->next = t;
  212. p = n;
  213. list = p;
  214. } else {
  215. t->next = n->next;
  216. n->next = t;
  217. p->next = n;
  218. p = n;
  219. }
  220. continue;
  221. }
  222. p = t;
  223. t = t->next;
  224. }
  225. if (!s)
  226. break;
  227. }
  228. return list;
  229. }
  230. typedef struct {
  231. char *str;
  232. size_t used;
  233. size_t allocated;
  234. } buffer_t;
  235. buffer_t *buffer_new(void) {
  236. buffer_t *buf = malloc_checked(sizeof(buffer_t));
  237. buf->str = NULL;
  238. buf->used = buf->allocated = 0;
  239. return buf;
  240. }
  241. void buffer_append(buffer_t *buf, char c) {
  242. buf->used++;
  243. if (buf->used > buf->allocated) {
  244. buf->allocated++;
  245. buf->str = realloc_checked(buf->str, sizeof(char) * buf->allocated);
  246. }
  247. buf->str[buf->used - 1] = c;
  248. }
  249. char *buffer_read(buffer_t *buf) {
  250. if (buf->used == 0 || buf->str[buf->used - 1])
  251. buffer_append(buf, 0);
  252. char *str = buf->str;
  253. GC_FREE(buf);
  254. return str;
  255. }
  256. void buffer_append_str(buffer_t *buf, char *s) {
  257. while (*s)
  258. buffer_append(buf, *s++);
  259. }
  260. typedef struct {
  261. enum token_tag_t { T_PUNCT, T_LPAR, T_RPAR, T_NAME, T_NUMBER, T_QUOTE } tag;
  262. char *text;
  263. } token_t;
  264. typedef struct {
  265. char *source;
  266. size_t len;
  267. size_t pos;
  268. list_t *tokens;
  269. } lexer_t;
  270. lexer_t *lexer_new(void) {
  271. lexer_t *lexer = malloc_checked(sizeof(lexer_t));
  272. return lexer;
  273. }
  274. char lexer_lookahead(lexer_t *lexer, size_t offset) {
  275. size_t pos = lexer->pos + offset;
  276. if (pos >= lexer->len)
  277. return 0;
  278. return lexer->source[pos];
  279. }
  280. char lexer_eat(lexer_t *lexer) {
  281. if (lexer->pos >= lexer->len)
  282. return 0;
  283. return lexer->source[lexer->pos++];
  284. }
  285. void lexer_push_token(lexer_t *lexer, enum token_tag_t tag, char *text) {
  286. token_t *token = malloc_checked(sizeof(token_t));
  287. token->tag = tag;
  288. token->text = text;
  289. list_push(lexer->tokens, token);
  290. }
  291. list_t *guards;
  292. jmp_buf *guard() {
  293. jmp_buf *lb = malloc_checked_atomic(sizeof(jmp_buf));
  294. list_push(guards, lb);
  295. return lb;
  296. }
  297. jmp_buf *guarding() {
  298. return list_index(guards, -1);
  299. }
  300. void unguard() {
  301. jmp_buf *lb = list_pop(guards);
  302. GC_FREE(lb);
  303. }
  304. void fatal(char *s) {
  305. jmp_buf *lb;
  306. if ((lb = guarding()))
  307. longjmp(*lb, 1);
  308. fprintf(stderr, "|%s error\n", s);
  309. if (is_interactive)
  310. longjmp(interactive_checkpoint, 1);
  311. exit(1);
  312. }
  313. void lexer_error(lexer_t *lexer, char *s) { fatal(s); }
  314. void lexer_lex_number(lexer_t *lexer, bool is_negative) {
  315. buffer_t *buf = buffer_new();
  316. if (is_negative)
  317. buffer_append(buf, '-');
  318. if (lexer_lookahead(lexer, 0) == '.') {
  319. buffer_append(buf, lexer_eat(lexer));
  320. if (!(isdigit(lexer_lookahead(lexer, 0))))
  321. lexer_error(lexer, "trailing-dot");
  322. }
  323. do {
  324. buffer_append(buf, lexer_eat(lexer));
  325. } while (isdigit(lexer_lookahead(lexer, 0)));
  326. if (lexer_lookahead(lexer, 0) == '.') {
  327. buffer_append(buf, lexer_eat(lexer));
  328. if (!(isdigit(lexer_lookahead(lexer, 0))))
  329. lexer_error(lexer, "trailing-dot");
  330. do {
  331. buffer_append(buf, lexer_eat(lexer));
  332. } while (isdigit(lexer_lookahead(lexer, 0)));
  333. }
  334. lexer_push_token(lexer, T_NUMBER, buffer_read(buf));
  335. }
  336. void lexer_lex(lexer_t *lexer, char *s) {
  337. lexer->source = s;
  338. lexer->len = strlen(s);
  339. lexer->pos = 0;
  340. lexer->tokens = list_new();
  341. while (lexer->pos < lexer->len) {
  342. char c = lexer_lookahead(lexer, 0);
  343. if (c == '/' && list_empty(lexer->tokens))
  344. break;
  345. if (isspace(c)) {
  346. lexer_eat(lexer);
  347. if (lexer_lookahead(lexer, 0) == '/')
  348. break;
  349. } else if (isdigit(c) || c == '.') {
  350. lexer_lex_number(lexer, false);
  351. } else if (isalpha(c)) {
  352. buffer_t *buf = buffer_new();
  353. do {
  354. buffer_append(buf, lexer_eat(lexer));
  355. } while (isalpha(lexer_lookahead(lexer, 0)));
  356. if (buf->used == 1 && lexer_lookahead(lexer, 0) == '.') {
  357. buffer_append(buf, lexer_eat(lexer));
  358. lexer_push_token(lexer, T_PUNCT, buffer_read(buf));
  359. } else
  360. lexer_push_token(lexer, T_NAME, buffer_read(buf));
  361. } else if (c == '(' || c == ')') {
  362. lexer_eat(lexer);
  363. lexer_push_token(lexer, c == '(' ? T_LPAR : T_RPAR, NULL);
  364. } else if (c == '\'') {
  365. buffer_t *buf = buffer_new();
  366. lexer_eat(lexer);
  367. for (;;) {
  368. if (lexer->pos >= lexer->len)
  369. lexer_error(lexer, "unmatched-quote");
  370. if (lexer_lookahead(lexer, 0) == '\'') {
  371. if (lexer_lookahead(lexer, 1) == '\'') {
  372. buffer_append(buf, lexer_eat(lexer));
  373. lexer_eat(lexer);
  374. continue;
  375. }
  376. lexer_eat(lexer);
  377. break;
  378. }
  379. buffer_append(buf, lexer_eat(lexer));
  380. }
  381. lexer_push_token(lexer, T_QUOTE, buffer_read(buf));
  382. } else if (ispunct(c)) {
  383. char buf[3];
  384. buf[0] = lexer_eat(lexer);
  385. buf[1] = 0;
  386. if (lexer_lookahead(lexer, 0) == '.' ||
  387. lexer_lookahead(lexer, 0) == ':') {
  388. buf[1] = lexer_eat(lexer);
  389. buf[2] = 0;
  390. }
  391. if (strcmp(buf, "-") == 0 && isdigit(lexer_lookahead(lexer, 0))) {
  392. lexer_lex_number(lexer, true);
  393. continue;
  394. }
  395. lexer_push_token(lexer, T_PUNCT, strdup_checked(buf));
  396. } else
  397. lexer_error(lexer, "lex");
  398. }
  399. }
  400. typedef struct _table_t table_t;
  401. typedef struct _table_entry_t table_entry_t;
  402. struct _table_entry_t {
  403. char *key;
  404. void *value;
  405. bool is_deleted;
  406. };
  407. struct _table_t {
  408. table_entry_t *entries;
  409. size_t used;
  410. size_t capacity;
  411. };
  412. #define TABLE_MIN_SIZE 32
  413. table_t *table_new(void) {
  414. table_t *table = malloc_checked(sizeof(table_t));
  415. table->used = 0;
  416. table->capacity = TABLE_MIN_SIZE;
  417. table->entries = malloc_checked(table->capacity * sizeof(table_entry_t));
  418. return table;
  419. }
  420. size_t table_length(table_t *table) {
  421. return table->used;
  422. }
  423. bool table_empty(table_t *table) {
  424. return table->used == 0;
  425. }
  426. static uint64_t MM86128(void *key, const int len, uint32_t seed) {
  427. #define ROTL32(x, r) ((x << r) | (x >> (32 - r)))
  428. #define FMIX32(h) \
  429. h ^= h >> 16; \
  430. h *= 0x85ebca6b; \
  431. h ^= h >> 13; \
  432. h *= 0xc2b2ae35; \
  433. h ^= h >> 16;
  434. const uint8_t *data = (const uint8_t *)key;
  435. const int nblocks = len / 16;
  436. uint32_t h1 = seed;
  437. uint32_t h2 = seed;
  438. uint32_t h3 = seed;
  439. uint32_t h4 = seed;
  440. uint32_t c1 = 0x239b961b;
  441. uint32_t c2 = 0xab0e9789;
  442. uint32_t c3 = 0x38b34ae5;
  443. uint32_t c4 = 0xa1e38b93;
  444. const uint32_t *blocks = (const uint32_t *)(data + nblocks * 16);
  445. for (int i = -nblocks; i; i++) {
  446. uint32_t k1 = blocks[i * 4 + 0];
  447. uint32_t k2 = blocks[i * 4 + 1];
  448. uint32_t k3 = blocks[i * 4 + 2];
  449. uint32_t k4 = blocks[i * 4 + 3];
  450. k1 *= c1;
  451. k1 = ROTL32(k1, 15);
  452. k1 *= c2;
  453. h1 ^= k1;
  454. h1 = ROTL32(h1, 19);
  455. h1 += h2;
  456. h1 = h1 * 5 + 0x561ccd1b;
  457. k2 *= c2;
  458. k2 = ROTL32(k2, 16);
  459. k2 *= c3;
  460. h2 ^= k2;
  461. h2 = ROTL32(h2, 17);
  462. h2 += h3;
  463. h2 = h2 * 5 + 0x0bcaa747;
  464. k3 *= c3;
  465. k3 = ROTL32(k3, 17);
  466. k3 *= c4;
  467. h3 ^= k3;
  468. h3 = ROTL32(h3, 15);
  469. h3 += h4;
  470. h3 = h3 * 5 + 0x96cd1c35;
  471. k4 *= c4;
  472. k4 = ROTL32(k4, 18);
  473. k4 *= c1;
  474. h4 ^= k4;
  475. h4 = ROTL32(h4, 13);
  476. h4 += h1;
  477. h4 = h4 * 5 + 0x32ac3b17;
  478. }
  479. const uint8_t *tail = (const uint8_t *)(data + nblocks * 16);
  480. uint32_t k1 = 0;
  481. uint32_t k2 = 0;
  482. uint32_t k3 = 0;
  483. uint32_t k4 = 0;
  484. switch (len & 15) {
  485. case 15:
  486. k4 ^= tail[14] << 16;
  487. case 14:
  488. k4 ^= tail[13] << 8;
  489. case 13:
  490. k4 ^= tail[12] << 0;
  491. k4 *= c4;
  492. k4 = ROTL32(k4, 18);
  493. k4 *= c1;
  494. h4 ^= k4;
  495. case 12:
  496. k3 ^= tail[11] << 24;
  497. case 11:
  498. k3 ^= tail[10] << 16;
  499. case 10:
  500. k3 ^= tail[9] << 8;
  501. case 9:
  502. k3 ^= tail[8] << 0;
  503. k3 *= c3;
  504. k3 = ROTL32(k3, 17);
  505. k3 *= c4;
  506. h3 ^= k3;
  507. case 8:
  508. k2 ^= tail[7] << 24;
  509. case 7:
  510. k2 ^= tail[6] << 16;
  511. case 6:
  512. k2 ^= tail[5] << 8;
  513. case 5:
  514. k2 ^= tail[4] << 0;
  515. k2 *= c2;
  516. k2 = ROTL32(k2, 16);
  517. k2 *= c3;
  518. h2 ^= k2;
  519. case 4:
  520. k1 ^= tail[3] << 24;
  521. case 3:
  522. k1 ^= tail[2] << 16;
  523. case 2:
  524. k1 ^= tail[1] << 8;
  525. case 1:
  526. k1 ^= tail[0] << 0;
  527. k1 *= c1;
  528. k1 = ROTL32(k1, 15);
  529. k1 *= c2;
  530. h1 ^= k1;
  531. }
  532. h1 ^= len;
  533. h2 ^= len;
  534. h3 ^= len;
  535. h4 ^= len;
  536. h1 += h2;
  537. h1 += h3;
  538. h1 += h4;
  539. h2 += h1;
  540. h3 += h1;
  541. h4 += h1;
  542. FMIX32(h1);
  543. FMIX32(h2);
  544. FMIX32(h3);
  545. FMIX32(h4);
  546. h1 += h2;
  547. h1 += h3;
  548. h1 += h4;
  549. h2 += h1;
  550. h3 += h1;
  551. h4 += h1;
  552. return (((uint64_t)h2) << 32) | h1;
  553. }
  554. static uint32_t HASH_SEED = 0;
  555. void *table_get(table_t *table, char *key) {
  556. if (table_empty(table))
  557. return NULL;
  558. uint64_t hash = MM86128(key, strlen(key), HASH_SEED);
  559. size_t index = hash % table->capacity;
  560. size_t i = index;
  561. while (table->entries[i].key) {
  562. if (!table->entries[i].is_deleted &&
  563. strcmp(table->entries[i].key, key) == 0)
  564. return table->entries[i].value;
  565. i++;
  566. if (i >= table->capacity)
  567. i = 0;
  568. if (i == index)
  569. break;
  570. }
  571. return NULL;
  572. }
  573. bool table_has(table_t *table, char *key) {
  574. if (table_empty(table))
  575. return false;
  576. uint64_t hash = MM86128(key, strlen(key), HASH_SEED);
  577. size_t index = hash % table->capacity;
  578. size_t i = index;
  579. while (table->entries[i].key) {
  580. if (!table->entries[i].is_deleted &&
  581. strcmp(table->entries[i].key, key) == 0)
  582. return true;
  583. i++;
  584. if (i >= table->capacity)
  585. i = 0;
  586. if (i == index)
  587. break;
  588. }
  589. return false;
  590. }
  591. static void table_entry_set(table_entry_t *entries, char *key, void *value,
  592. size_t capacity, size_t *used) {
  593. uint64_t hash = MM86128(key, strlen(key), HASH_SEED);
  594. size_t index = hash % capacity;
  595. size_t i = index;
  596. while (entries[i].key) {
  597. if (strcmp(entries[i].key, key) == 0) {
  598. entries[i].value = value;
  599. if (entries[i].is_deleted) {
  600. if (used)
  601. (*used)++;
  602. entries[i].is_deleted = false;
  603. }
  604. return;
  605. } else if (entries[i].is_deleted)
  606. break;
  607. i++;
  608. if (i >= capacity)
  609. i = 0;
  610. if (i == index)
  611. break;
  612. }
  613. if (used)
  614. (*used)++;
  615. entries[i].key = key;
  616. entries[i].value = value;
  617. entries[i].is_deleted = false;
  618. }
  619. table_t *table_set(table_t *table, char *key, void *value) {
  620. if (table->used >= table->capacity) {
  621. size_t capacity = table->capacity + TABLE_MIN_SIZE;
  622. table_entry_t *entries = malloc_checked(capacity * sizeof(table_entry_t));
  623. for (size_t i = 0; i < table->capacity; i++) {
  624. table_entry_t entry = table->entries[i];
  625. if (entry.key && !entry.is_deleted)
  626. table_entry_set(entries, entry.key, entry.value, capacity, NULL);
  627. }
  628. GC_FREE(table->entries);
  629. table->entries = entries;
  630. table->capacity = capacity;
  631. }
  632. table_entry_set(table->entries, key, value, table->capacity, &table->used);
  633. return table;
  634. }
  635. typedef struct _value_t value_t;
  636. typedef struct _interpreter_t interpreter_t;
  637. typedef struct _verb_t verb_t;
  638. struct _interpreter_t {
  639. table_t *env;
  640. list_t *args;
  641. list_t *selfrefs;
  642. value_t *nil;
  643. value_t *udf;
  644. value_t *unit;
  645. verb_t *at;
  646. };
  647. struct _verb_t {
  648. char *name;
  649. unsigned int rank[3];
  650. list_t *bonds;
  651. bool mark;
  652. bool is_fun;
  653. value_t *(*monad)(interpreter_t *, verb_t *, value_t *);
  654. value_t *(*dyad)(interpreter_t *, verb_t *, value_t *, value_t *);
  655. };
  656. typedef struct {
  657. char *name;
  658. verb_t *(*adverb)(interpreter_t *, value_t *);
  659. verb_t *(*conjunction)(interpreter_t *, value_t *, value_t *);
  660. } adverb_t;
  661. struct _value_t {
  662. enum value_tag_t { ARRAY, VERB, SYMBOL, NUMBER, CHAR, NIL, UDF } tag;
  663. union {
  664. list_t *array;
  665. verb_t *verb;
  666. char *symbol;
  667. double number;
  668. unsigned char _char;
  669. } val;
  670. };
  671. verb_t *verb_new() {
  672. verb_t *verb = malloc_checked(sizeof(verb_t));
  673. return verb;
  674. }
  675. value_t *value_new(enum value_tag_t tag) {
  676. value_t *val;
  677. if (tag > SYMBOL)
  678. val = malloc_checked_atomic(sizeof(value_t));
  679. else
  680. val = malloc_checked(sizeof(value_t));
  681. val->tag = tag;
  682. return val;
  683. }
  684. value_t *value_new_const(enum value_tag_t tag) {
  685. value_t *val = malloc_checked_uncollectable(sizeof(value_t));
  686. val->tag = tag;
  687. return val;
  688. }
  689. value_t *_UNIT;
  690. value_t *value_new_array(list_t *array) {
  691. if (list_empty(array)) {
  692. GC_FREE(array);
  693. return _UNIT;
  694. }
  695. value_t *val = value_new(ARRAY);
  696. val->val.array = array;
  697. return val;
  698. }
  699. table_t *VCACHE;
  700. value_t *value_new_verb(verb_t *verb) {
  701. value_t *val;
  702. if ((val = table_get(VCACHE, verb->name)))
  703. return val;
  704. val = value_new(VERB);
  705. val->val.verb = verb;
  706. return val;
  707. }
  708. table_t *SCACHE;
  709. value_t *value_new_symbol(char *symbol) {
  710. value_t *val;
  711. if ((val = table_get(SCACHE, symbol)))
  712. return val;
  713. val = value_new_const(SYMBOL);
  714. val->val.symbol = symbol;
  715. table_set(SCACHE, symbol, val);
  716. return val;
  717. }
  718. value_t *_NAN, *INF, *NINF;
  719. value_t *NNUMS[8];
  720. value_t *NUMS[256];
  721. value_t *CHARS[256];
  722. value_t *value_new_number(double number) {
  723. if (isnan(number))
  724. return _NAN;
  725. else if (number == INFINITY)
  726. return INF;
  727. else if (number == -INFINITY)
  728. return NINF;
  729. else if (number >= 0 && number < 256 && number == (double)((size_t)number))
  730. return NUMS[(size_t)number];
  731. else if (number < 0 && number >= -8 &&
  732. fabs(number) == (double)((size_t)fabs(number)))
  733. return NNUMS[((size_t)fabs(number)) - 1];
  734. value_t *val = value_new(NUMBER);
  735. val->val.number = number;
  736. return val;
  737. }
  738. value_t *value_new_char(unsigned char _char) { return CHARS[_char]; }
  739. bool value_equals(value_t *x, value_t *y) {
  740. if (x->tag != y->tag)
  741. return false;
  742. switch (x->tag) {
  743. case ARRAY: {
  744. list_t *tx = x->val.array;
  745. list_t *ty = y->val.array;
  746. if (list_empty(tx) && list_empty(ty))
  747. break;
  748. if (list_empty(tx) && !list_empty(ty))
  749. return false;
  750. if (!list_empty(tx) && list_empty(ty))
  751. return false;
  752. while (tx) {
  753. if (!ty)
  754. return false;
  755. if (!value_equals(tx->value, ty->value))
  756. return false;
  757. tx = tx->next;
  758. ty = ty->next;
  759. }
  760. if (ty)
  761. return false;
  762. }
  763. case VERB:
  764. return strcmp(x->val.verb->name, x->val.verb->name) == 0;
  765. case SYMBOL:
  766. return strcmp(x->val.symbol, y->val.symbol) == 0;
  767. case NUMBER:
  768. if (isnan(x->val.number) && isnan(y->val.number))
  769. break;
  770. return x->val.number == y->val.number;
  771. case CHAR:
  772. return x == y;
  773. case NIL:
  774. case UDF:
  775. break;
  776. }
  777. return true;
  778. }
  779. bool is_char_array(list_t *a) {
  780. if (list_empty(a))
  781. return false;
  782. while (a) {
  783. value_t *v = a->value;
  784. if (v->tag != CHAR || !isprint(v->val._char))
  785. return false;
  786. a = a->next;
  787. }
  788. return true;
  789. }
  790. bool is_arrays_array(list_t *a) {
  791. if (list_empty(a))
  792. return false;
  793. while (a) {
  794. value_t *v = a->value;
  795. if (v->tag != ARRAY)
  796. return false;
  797. a = a->next;
  798. }
  799. return true;
  800. }
  801. char *value_show(value_t *v);
  802. char *show_array(value_t *v) {
  803. if (v->tag != ARRAY)
  804. return value_show(v);
  805. list_t *t = v->val.array;
  806. if (list_empty(t))
  807. return strdup_checked("()");
  808. buffer_t *buf = buffer_new();
  809. if (!t->next) {
  810. buffer_append(buf, ',');
  811. char *ts = value_show(t->value);
  812. buffer_append_str(buf, ts);
  813. GC_FREE(ts);
  814. return buffer_read(buf);
  815. }
  816. if (is_char_array(t)) {
  817. while (t) {
  818. value_t *c = t->value;
  819. buffer_append(buf, c->val._char);
  820. t = t->next;
  821. }
  822. return buffer_read(buf);
  823. }
  824. if (!is_arrays_array(t)) {
  825. while (t) {
  826. char *ts = value_show(t->value);
  827. buffer_append_str(buf, ts);
  828. GC_FREE(ts);
  829. t = t->next;
  830. if (t)
  831. buffer_append(buf, ' ');
  832. }
  833. } else {
  834. unsigned int rwk = 0;
  835. unsigned int rwl = list_length(t->value);
  836. while (t) {
  837. char *ts = show_array(t->value);
  838. buffer_append_str(buf, ts);
  839. GC_FREE(ts);
  840. t = t->next;
  841. if (t)
  842. buffer_append(buf, ' ');
  843. rwk++;
  844. if (rwk >= rwl && t) {
  845. rwk = 0;
  846. buffer_append(buf, '\n');
  847. }
  848. }
  849. }
  850. return buffer_read(buf);
  851. }
  852. char *value_show(value_t *v) {
  853. switch (v->tag) {
  854. case ARRAY:
  855. return show_array(v);
  856. case VERB:
  857. return strdup_checked(v->val.verb->name);
  858. case SYMBOL:
  859. return strdup_checked(v->val.symbol);
  860. case NUMBER: {
  861. char buf[128];
  862. snprintf(buf, sizeof(buf), "%.15g", v->val.number);
  863. return strdup_checked(buf);
  864. }
  865. case CHAR: {
  866. if (!isprint(v->val._char)) {
  867. char buf[16];
  868. snprintf(buf, sizeof(buf), "4t.%d", v->val._char);
  869. return strdup_checked(buf);
  870. }
  871. char buf[2];
  872. buf[0] = v->val._char;
  873. buf[1] = 0;
  874. return strdup_checked(buf);
  875. }
  876. case NIL:
  877. return strdup_checked("nil");
  878. case UDF:
  879. return strdup_checked("udf");
  880. }
  881. return strdup_checked("<?>");
  882. }
  883. double get_numeric(value_t *v) {
  884. if (v->tag == CHAR)
  885. return v->val._char;
  886. return v->val.number;
  887. }
  888. bool value_is_truthy(value_t *x) {
  889. switch (x->tag) {
  890. case ARRAY:
  891. return !list_empty(x->val.array);
  892. case NUMBER:
  893. case CHAR:
  894. return get_numeric(x) != 0;
  895. case NIL:
  896. case UDF:
  897. return false;
  898. default:
  899. return true;
  900. }
  901. }
  902. verb_t *find_verb(char *s);
  903. interpreter_t *interpreter_new(void) {
  904. interpreter_t *state = malloc_checked(sizeof(interpreter_t));
  905. state->env = table_new();
  906. state->args = list_new();
  907. state->selfrefs = list_new();
  908. state->nil = value_new(NIL);
  909. state->udf = value_new(UDF);
  910. state->unit = _UNIT;
  911. state->at = find_verb("@");
  912. return state;
  913. }
  914. void interpreter_error(interpreter_t *state, char *e) {
  915. fprintf(stderr, "%s error\n", e);
  916. exit(1);
  917. }
  918. value_t *each_rank(interpreter_t *state, verb_t *f, value_t *x, unsigned int d,
  919. unsigned int rm) {
  920. if (!f->monad)
  921. return state->udf;
  922. if (d >= rm || x->tag != ARRAY) {
  923. if (f->mark)
  924. list_push(state->selfrefs, f);
  925. value_t *r = f->monad(state, f, x);
  926. if (f->mark)
  927. list_pop(state->selfrefs);
  928. return r;
  929. }
  930. list_t *t = x->val.array;
  931. if (list_empty(t))
  932. return x;
  933. list_t *l = list_new();
  934. while (t) {
  935. list_push(l, each_rank(state, f, t->value, d + 1, rm));
  936. t = t->next;
  937. }
  938. return value_new_array(l);
  939. }
  940. value_t *apply_monad(interpreter_t *state, value_t *f, value_t *x) {
  941. if (f->tag != VERB)
  942. return state->udf;
  943. if (!f->val.verb->monad)
  944. return state->udf;
  945. return each_rank(state, f->val.verb, x, 0, f->val.verb->rank[0]);
  946. }
  947. value_t *together(interpreter_t *state, verb_t *f, value_t *x, value_t *y,
  948. unsigned int dl, unsigned int dr, unsigned int rl,
  949. unsigned int rr) {
  950. if (!f->dyad)
  951. return state->udf;
  952. if (dl >= rl && dr >= rr) {
  953. if (f->mark)
  954. list_push(state->selfrefs, f);
  955. value_t *r = f->dyad(state, f, x, y);
  956. if (f->mark)
  957. list_pop(state->selfrefs);
  958. return r;
  959. }
  960. if (dl < rl && dr < rr && x->tag == ARRAY && y->tag == ARRAY) {
  961. list_t *tx = x->val.array;
  962. list_t *ty = y->val.array;
  963. if (!tx->value || !ty->value)
  964. return !tx->value ? x : y;
  965. list_t *t = list_new();
  966. while (tx) {
  967. if (!ty)
  968. break;
  969. list_push(
  970. t, together(state, f, tx->value, ty->value, dl + 1, dr + 1, rl, rr));
  971. tx = tx->next;
  972. ty = ty->next;
  973. }
  974. return value_new_array(t);
  975. } else if ((x->tag != ARRAY || dl >= rl) && y->tag == ARRAY && dr < rr) {
  976. list_t *ty = y->val.array;
  977. if (!ty->value)
  978. return y;
  979. list_t *t = list_new();
  980. while (ty) {
  981. list_push(t, together(state, f, x, ty->value, dl, dr + 1, rl, rr));
  982. ty = ty->next;
  983. }
  984. return value_new_array(t);
  985. } else if ((y->tag != ARRAY || dr >= rr) && x->tag == ARRAY && dl < rl) {
  986. list_t *tx = x->val.array;
  987. if (!tx->value)
  988. return x;
  989. list_t *t = list_new();
  990. while (tx) {
  991. list_push(t, together(state, f, tx->value, y, dl + 1, dr, rl, rr));
  992. tx = tx->next;
  993. }
  994. return value_new_array(t);
  995. }
  996. if (f->mark)
  997. list_push(state->selfrefs, f);
  998. value_t *r = f->dyad(state, f, x, y);
  999. if (f->mark)
  1000. list_pop(state->selfrefs);
  1001. return r;
  1002. }
  1003. value_t *apply_dyad(interpreter_t *state, value_t *f, value_t *x, value_t *y) {
  1004. if (f->tag != VERB)
  1005. return state->nil;
  1006. return together(state, f->val.verb, x, y, 0, 0, f->val.verb->rank[1],
  1007. f->val.verb->rank[2]);
  1008. }
  1009. typedef struct _node_t node_t;
  1010. struct _node_t {
  1011. enum node_tag_t {
  1012. N_STRAND,
  1013. N_LITERAL,
  1014. N_INDEX1,
  1015. N_INDEX2,
  1016. N_FUN,
  1017. N_MONAD,
  1018. N_DYAD,
  1019. N_ADV,
  1020. N_CONJ,
  1021. N_PARTIAL_CONJ,
  1022. N_FORK,
  1023. N_HOOK,
  1024. N_BOND,
  1025. N_OVER,
  1026. N_BIND
  1027. } tag;
  1028. adverb_t *av;
  1029. value_t *v;
  1030. list_t *l;
  1031. node_t *a;
  1032. node_t *b;
  1033. node_t *c;
  1034. };
  1035. value_t *_fork_monad(interpreter_t *state, verb_t *self, value_t *x) {
  1036. verb_t *f = list_index(self->bonds, 0);
  1037. verb_t *g = list_index(self->bonds, 1);
  1038. verb_t *h = list_index(self->bonds, 2);
  1039. value_t *l = each_rank(state, f, x, 0, f->rank[0]);
  1040. value_t *r = each_rank(state, h, x, 0, f->rank[0]);
  1041. return together(state, g, l, r, 0, 0, g->rank[1], g->rank[2]);
  1042. }
  1043. value_t *_fork_dyad(interpreter_t *state, verb_t *self, value_t *x,
  1044. value_t *y) {
  1045. verb_t *f = list_index(self->bonds, 0);
  1046. verb_t *g = list_index(self->bonds, 1);
  1047. verb_t *h = list_index(self->bonds, 2);
  1048. value_t *l = each_rank(state, f, x, 0, f->rank[0]);
  1049. value_t *r = each_rank(state, h, y, 0, f->rank[0]);
  1050. return together(state, g, l, r, 0, 0, g->rank[1], g->rank[2]);
  1051. }
  1052. value_t *_hook_monad(interpreter_t *state, verb_t *self, value_t *x) {
  1053. verb_t *f = list_index(self->bonds, 0);
  1054. verb_t *g = list_index(self->bonds, 1);
  1055. value_t *r = each_rank(state, g, x, 0, g->rank[0]);
  1056. return each_rank(state, f, r, 0, f->rank[0]);
  1057. }
  1058. value_t *_hook_dyad(interpreter_t *state, verb_t *self, value_t *x,
  1059. value_t *y) {
  1060. verb_t *f = list_index(self->bonds, 0);
  1061. verb_t *g = list_index(self->bonds, 1);
  1062. value_t *r = together(state, g, x, y, 0, 0, g->rank[1], g->rank[2]);
  1063. return each_rank(state, f, r, 0, f->rank[0]);
  1064. }
  1065. value_t *_bond_monad(interpreter_t *state, verb_t *self, value_t *x) {
  1066. verb_t *f = list_index(self->bonds, 0);
  1067. value_t *g = list_index(self->bonds, 1);
  1068. return together(state, f, g, x, 0, 0, f->rank[1], f->rank[2]);
  1069. }
  1070. value_t *_bond_dyad(interpreter_t *state, verb_t *self, value_t *x,
  1071. value_t *y) {
  1072. verb_t *f = list_index(self->bonds, 0);
  1073. value_t *g = list_index(self->bonds, 1);
  1074. value_t *r = together(state, f, x, y, 0, 0, f->rank[1], f->rank[2]);
  1075. return together(state, f, x, r, 0, 0, f->rank[1], f->rank[2]);
  1076. }
  1077. value_t *_over_monad(interpreter_t *state, verb_t *self, value_t *x) {
  1078. value_t *f = list_index(self->bonds, 0);
  1079. verb_t *g = list_index(self->bonds, 1);
  1080. verb_t *h = list_index(self->bonds, 2);
  1081. value_t *l = each_rank(state, h, x, 0, h->rank[0]);
  1082. return together(state, g, f, l, 0, 0, g->rank[1], g->rank[2]);
  1083. }
  1084. value_t *_over_dyad(interpreter_t *state, verb_t *self, value_t *x,
  1085. value_t *y) {
  1086. value_t *f = list_index(self->bonds, 0);
  1087. verb_t *g = list_index(self->bonds, 1);
  1088. verb_t *h = list_index(self->bonds, 2);
  1089. value_t *l = together(state, h, x, y, 0, 0, h->rank[1], h->rank[2]);
  1090. return together(state, g, f, l, 0, 0, g->rank[1], g->rank[2]);
  1091. }
  1092. bool function_collect_args(node_t *node, unsigned int *argc) {
  1093. if (!node)
  1094. return false;
  1095. if (node->tag == N_LITERAL && node->v->tag == SYMBOL &&
  1096. strcmp(node->v->val.symbol, "y") == 0) {
  1097. *argc = 2;
  1098. return true;
  1099. } else if (node->tag == N_LITERAL && node->v->tag == SYMBOL &&
  1100. strcmp(node->v->val.symbol, "x") == 0) {
  1101. if (*argc < 2)
  1102. *argc = 1;
  1103. } else if (node->tag == N_MONAD || node->tag == N_CONJ ||
  1104. node->tag == N_HOOK || node->tag == N_BOND ||
  1105. node->tag == N_INDEX1) {
  1106. if (function_collect_args(node->a, argc))
  1107. return true;
  1108. if (function_collect_args(node->b, argc))
  1109. return true;
  1110. } else if (node->tag == N_DYAD || node->tag == N_FORK ||
  1111. node->tag == N_OVER || node->tag == N_INDEX2) {
  1112. if (function_collect_args(node->a, argc))
  1113. return true;
  1114. if (function_collect_args(node->b, argc))
  1115. return true;
  1116. if (function_collect_args(node->c, argc))
  1117. return true;
  1118. } else if (node->tag == N_ADV) {
  1119. if (function_collect_args(node->a, argc))
  1120. return true;
  1121. } else if (node->tag == N_STRAND) {
  1122. list_t *t = node->l;
  1123. while (t) {
  1124. if (function_collect_args(t->value, argc))
  1125. return true;
  1126. t = t->next;
  1127. }
  1128. }
  1129. return false;
  1130. }
  1131. value_t *interpreter_walk(interpreter_t *state, node_t *node);
  1132. value_t *_const_monad(interpreter_t *state, verb_t *self, value_t *x) {
  1133. return self->bonds->value;
  1134. }
  1135. value_t *_const_dyad(interpreter_t *state, verb_t *self, value_t *x,
  1136. value_t *y) {
  1137. return self->bonds->value;
  1138. }
  1139. value_t *_fun_monad(interpreter_t *state, verb_t *self, value_t *x) {
  1140. list_t *args = list_new();
  1141. list_push(args, x);
  1142. list_push(args, self);
  1143. list_push(state->args, args);
  1144. value_t *r = interpreter_walk(state, self->bonds->value);
  1145. list_pop(state->args);
  1146. GC_FREE(args);
  1147. return r;
  1148. }
  1149. value_t *_fun_dyad(interpreter_t *state, verb_t *self, value_t *x, value_t *y) {
  1150. list_t *args = list_new();
  1151. list_push(args, x);
  1152. list_push(args, y);
  1153. list_push(args, self);
  1154. list_push(state->args, args);
  1155. value_t *r = interpreter_walk(state, self->bonds->next->value);
  1156. list_pop(state->args);
  1157. GC_FREE(args);
  1158. return r;
  1159. }
  1160. value_t *_partial_conjunction(interpreter_t *state, verb_t *self, value_t *x) {
  1161. adverb_t *av = self->bonds->value;
  1162. value_t *a = self->bonds->next->value;
  1163. return value_new_verb(av->conjunction(state, a, x));
  1164. }
  1165. node_t *node_new1(enum node_tag_t tag, node_t *a);
  1166. value_t *interpreter_walk(interpreter_t *state, node_t *node) {
  1167. if (!node)
  1168. return state->nil;
  1169. switch (node->tag) {
  1170. case N_STRAND: {
  1171. list_t *t = node->l;
  1172. while (t) {
  1173. t->value = interpreter_walk(state, t->value);
  1174. t = t->next;
  1175. }
  1176. return value_new_array(node->l);
  1177. }
  1178. case N_LITERAL: {
  1179. value_t *v = node->v;
  1180. value_t *t = NULL;
  1181. if (v->tag == SYMBOL) {
  1182. char *n = v->val.symbol;
  1183. if (!list_empty(state->args)) {
  1184. list_t *args = list_index(state->args, -1);
  1185. size_t argc = list_length(args) - 1;
  1186. if (argc == 2 && strcmp(n, "y") == 0)
  1187. return args->next->value;
  1188. else if (strcmp(n, "x") == 0)
  1189. return args->value;
  1190. }
  1191. if ((t = table_get(state->env, n)))
  1192. return t;
  1193. }
  1194. return v;
  1195. }
  1196. case N_INDEX1:
  1197. return together(state, state->at, interpreter_walk(state, node->a),
  1198. interpreter_walk(state, node->b), 0, 0, state->at->rank[1],
  1199. state->at->rank[2]);
  1200. case N_INDEX2:
  1201. return together(state, state->at,
  1202. together(state, state->at, interpreter_walk(state, node->a),
  1203. interpreter_walk(state, node->b), 0, 0,
  1204. state->at->rank[1], state->at->rank[2]),
  1205. interpreter_walk(state, node->c), 0, 0, state->at->rank[1],
  1206. state->at->rank[2]);
  1207. case N_FUN: {
  1208. unsigned int argc = 0;
  1209. function_collect_args(node->a, &argc);
  1210. verb_t *nv = verb_new();
  1211. if (argc > 0)
  1212. nv->is_fun = true;
  1213. nv->bonds = list_new();
  1214. nv->name = strdup_checked(argc == 0 ? ":..." : argc == 1 ? ":x" : ":xy");
  1215. nv->rank[0] = 0;
  1216. nv->rank[1] = 0;
  1217. nv->rank[2] = 0;
  1218. if (argc == 0) {
  1219. list_push(nv->bonds, interpreter_walk(state, node->a));
  1220. nv->monad = _const_monad;
  1221. nv->dyad = _const_dyad;
  1222. } else if (argc == 1) {
  1223. list_push(nv->bonds, node->a);
  1224. nv->monad = _fun_monad;
  1225. nv->dyad = NULL;
  1226. } else {
  1227. nv->monad = NULL;
  1228. list_push(nv->bonds, state->udf);
  1229. list_push(nv->bonds, node->a);
  1230. nv->dyad = _fun_dyad;
  1231. }
  1232. return value_new_verb(nv);
  1233. }
  1234. case N_MONAD:
  1235. return apply_monad(state, interpreter_walk(state, node->a),
  1236. interpreter_walk(state, node->b));
  1237. case N_DYAD:
  1238. return apply_dyad(state, interpreter_walk(state, node->a),
  1239. interpreter_walk(state, node->b),
  1240. interpreter_walk(state, node->c));
  1241. case N_ADV: {
  1242. value_t *v = interpreter_walk(state, node->a);
  1243. return value_new_verb(node->av->adverb(state, v));
  1244. }
  1245. case N_CONJ: {
  1246. value_t *v1 = interpreter_walk(state, node->a);
  1247. value_t *v2 = interpreter_walk(state, node->b);
  1248. return value_new_verb(node->av->conjunction(state, v1, v2));
  1249. }
  1250. case N_PARTIAL_CONJ: {
  1251. verb_t *nv = verb_new();
  1252. value_t *a = interpreter_walk(state, node->a);
  1253. char *r = value_show(a);
  1254. size_t l = strlen(r) + strlen(node->av->name) + 1;
  1255. nv->name = malloc_checked(l);
  1256. snprintf(nv->name, l, "%s%s", r, node->av->name);
  1257. GC_FREE(r);
  1258. nv->bonds = list_new();
  1259. list_push(nv->bonds, node->av);
  1260. list_push(nv->bonds, a);
  1261. nv->rank[0] = 0;
  1262. nv->rank[1] = 0;
  1263. nv->rank[2] = 0;
  1264. nv->monad = _partial_conjunction;
  1265. nv->dyad = NULL;
  1266. return value_new_verb(nv);
  1267. }
  1268. case N_FORK: {
  1269. value_t *_f = interpreter_walk(state, node->a);
  1270. if (_f->tag != VERB)
  1271. return state->udf;
  1272. value_t *_g = interpreter_walk(state, node->b);
  1273. if (_g->tag != VERB)
  1274. return state->udf;
  1275. value_t *_h = interpreter_walk(state, node->c);
  1276. if (_h->tag != VERB)
  1277. return state->udf;
  1278. verb_t *f = _f->val.verb;
  1279. verb_t *g = _g->val.verb;
  1280. verb_t *h = _h->val.verb;
  1281. verb_t *nv = verb_new();
  1282. nv->bonds = list_new();
  1283. list_push(nv->bonds, f);
  1284. list_push(nv->bonds, g);
  1285. list_push(nv->bonds, h);
  1286. size_t l = strlen(f->name) + strlen(g->name) + strlen(h->name) + 1;
  1287. nv->name = malloc_checked(l);
  1288. snprintf(nv->name, l, "%s%s%s", f->name, g->name, h->name);
  1289. nv->rank[0] = 0;
  1290. nv->rank[1] = 0;
  1291. nv->rank[2] = 0;
  1292. nv->monad = _fork_monad;
  1293. nv->dyad = _fork_dyad;
  1294. return value_new_verb(nv);
  1295. }
  1296. case N_HOOK: {
  1297. value_t *_f = interpreter_walk(state, node->a);
  1298. if (_f->tag != VERB)
  1299. return state->udf;
  1300. value_t *_g = interpreter_walk(state, node->b);
  1301. if (_g->tag != VERB)
  1302. return state->udf;
  1303. verb_t *f = _f->val.verb;
  1304. verb_t *g = _g->val.verb;
  1305. verb_t *nv = verb_new();
  1306. nv->bonds = list_new();
  1307. list_push(nv->bonds, f);
  1308. list_push(nv->bonds, g);
  1309. size_t l = strlen(f->name) + strlen(g->name) + 1;
  1310. nv->name = malloc_checked(l);
  1311. snprintf(nv->name, l, "%s%s", f->name, g->name);
  1312. nv->rank[0] = 0;
  1313. nv->rank[1] = 0;
  1314. nv->rank[2] = 0;
  1315. nv->monad = _hook_monad;
  1316. nv->dyad = _hook_dyad;
  1317. return value_new_verb(nv);
  1318. }
  1319. case N_BOND: {
  1320. value_t *_f = interpreter_walk(state, node->a);
  1321. if (_f->tag != VERB)
  1322. return state->udf;
  1323. value_t *g = interpreter_walk(state, node->b);
  1324. verb_t *f = _f->val.verb;
  1325. verb_t *nv = verb_new();
  1326. nv->bonds = list_new();
  1327. list_push(nv->bonds, f);
  1328. list_push(nv->bonds, g);
  1329. char *r = value_show(g);
  1330. size_t l = strlen(r) + strlen(f->name) + 1;
  1331. nv->name = malloc_checked(l);
  1332. snprintf(nv->name, l, "%s%s", r, f->name);
  1333. GC_FREE(r);
  1334. nv->rank[0] = 0;
  1335. nv->rank[1] = 0;
  1336. nv->rank[2] = 0;
  1337. nv->monad = _bond_monad;
  1338. nv->dyad = _bond_dyad;
  1339. return value_new_verb(nv);
  1340. }
  1341. case N_OVER: {
  1342. value_t *f = interpreter_walk(state, node->a);
  1343. value_t *_g = interpreter_walk(state, node->b);
  1344. if (_g->tag != VERB)
  1345. return state->udf;
  1346. value_t *_h = interpreter_walk(state, node->c);
  1347. if (_h->tag != VERB)
  1348. return state->udf;
  1349. verb_t *g = _g->val.verb;
  1350. verb_t *h = _h->val.verb;
  1351. verb_t *nv = verb_new();
  1352. nv->bonds = list_new();
  1353. list_push(nv->bonds, f);
  1354. list_push(nv->bonds, g);
  1355. list_push(nv->bonds, h);
  1356. char *r = value_show(f);
  1357. size_t l = strlen(r) + strlen(g->name) + strlen(h->name) + 1;
  1358. nv->name = malloc_checked(l);
  1359. snprintf(nv->name, l, "%s%s%s", r, g->name, h->name);
  1360. GC_FREE(r);
  1361. nv->rank[0] = 0;
  1362. nv->rank[1] = 0;
  1363. nv->rank[2] = 0;
  1364. nv->monad = _over_monad;
  1365. nv->dyad = _over_dyad;
  1366. return value_new_verb(nv);
  1367. }
  1368. case N_BIND: {
  1369. value_t *l = node->a->v;
  1370. node_t *b = node->b;
  1371. unsigned int argc = 0;
  1372. function_collect_args(b, &argc);
  1373. if (argc != 0)
  1374. b = node_new1(N_FUN, b);
  1375. value_t *r = interpreter_walk(state, b);
  1376. if (r->tag == VERB && argc == 0)
  1377. r->val.verb->mark = true;
  1378. value_t *ov = table_get(state->env, l->val.symbol);
  1379. if (ov && ov->tag == VERB && ov->val.verb->is_fun && r->tag == VERB && r->val.verb->is_fun) {
  1380. if (!ov->val.verb->monad && r->val.verb->monad) {
  1381. list_set(ov->val.verb->bonds, 0, r->val.verb->bonds->value);
  1382. ov->val.verb->monad = r->val.verb->monad;
  1383. break;
  1384. }
  1385. if (!ov->val.verb->dyad && r->val.verb->dyad) {
  1386. list_push(ov->val.verb->bonds, r->val.verb->bonds->next->value);
  1387. ov->val.verb->dyad = r->val.verb->dyad;
  1388. break;
  1389. }
  1390. }
  1391. table_set(state->env, l->val.symbol, r);
  1392. }
  1393. }
  1394. return state->nil;
  1395. }
  1396. value_t *verb_const(interpreter_t *state, verb_t *self, value_t *x) {
  1397. verb_t *nv = verb_new();
  1398. nv->bonds = list_new();
  1399. list_push(nv->bonds, x);
  1400. char *r = value_show(x);
  1401. size_t l = strlen(r) + 2;
  1402. nv->name = malloc_checked(l);
  1403. snprintf(nv->name, l, ":%s", r);
  1404. nv->rank[0] = 0;
  1405. nv->rank[1] = 0;
  1406. nv->rank[2] = 0;
  1407. nv->monad = _const_monad;
  1408. nv->dyad = _const_dyad;
  1409. return value_new_verb(nv);
  1410. }
  1411. value_t *verb_bind(interpreter_t *state, verb_t *self, value_t *x, value_t *y) {
  1412. if (x->tag == SYMBOL) {
  1413. if (y->tag == VERB)
  1414. y->val.verb->mark = true;
  1415. table_set(state->env, x->val.symbol, y);
  1416. }
  1417. return state->udf;
  1418. }
  1419. table_t *Inverses;
  1420. value_t *verb_obverse(interpreter_t *state, verb_t *self, value_t *x, value_t *y) {
  1421. if (x->tag == VERB && y->tag == VERB) {
  1422. verb_t *vx = x->val.verb;
  1423. if (!y->val.verb->monad)
  1424. return state->udf;
  1425. if (strcmp(vx->name, ":...") == 0 || strcmp(vx->name, ":x") == 0 || strcmp(vx->name, ":xy") == 0)
  1426. return state->udf;
  1427. if (table_has(Inverses, vx->name))
  1428. return state->udf;
  1429. table_set(Inverses, vx->name, y->val.verb);
  1430. return state->nil;
  1431. }
  1432. return state->udf;
  1433. }
  1434. value_t *verb_flip(interpreter_t *state, verb_t *self, value_t *x) {
  1435. if (x->tag != ARRAY || list_empty(x->val.array))
  1436. return state->udf;
  1437. list_t *t = x->val.array;
  1438. if (!is_arrays_array(t))
  1439. return state->udf;
  1440. list_t *r = list_new();
  1441. value_t *c0 = t->value;
  1442. list_t *c0t = c0->val.array;
  1443. size_t c0l = list_length(c0t);
  1444. for (size_t i = 0; i < c0l; i++) {
  1445. list_t *nc = list_new();
  1446. list_t *t2 = t;
  1447. while (t2) {
  1448. value_t *rw = t2->value;
  1449. list_t *rwt = rw->val.array;
  1450. if (list_empty(rwt))
  1451. return state->udf;
  1452. value_t *v = list_index(rwt, i);
  1453. if (!v)
  1454. v = rwt->value;
  1455. list_push(nc, v);
  1456. t2 = t2->next;
  1457. }
  1458. list_push(r, value_new_array(nc));
  1459. }
  1460. return value_new_array(r);
  1461. }
  1462. value_t *verb_plus(interpreter_t *state, verb_t *self, value_t *x, value_t *y) {
  1463. if ((x->tag == NUMBER || x->tag == CHAR) &&
  1464. (y->tag == NUMBER || y->tag == CHAR)) {
  1465. if (x->tag == CHAR || y->tag == CHAR)
  1466. return value_new_char(get_numeric(x) + get_numeric(y));
  1467. return value_new_number(get_numeric(x) + get_numeric(y));
  1468. }
  1469. return _NAN;
  1470. }
  1471. value_t *verb_sign(interpreter_t *state, verb_t *self, value_t *x) {
  1472. if (x->tag == NUMBER)
  1473. return x->val.number < 0? NNUMS[0]: x->val.number > 0? NUMS[1]: NUMS[0];
  1474. return _NAN;
  1475. }
  1476. double gcd(double a, double b) {
  1477. if (b != 0)
  1478. return gcd(b, fmod(a, b));
  1479. else
  1480. return fabs(a);
  1481. }
  1482. value_t *verb_gcd(interpreter_t *state, verb_t *self, value_t *x, value_t *y) {
  1483. if (x->tag == NUMBER && y->tag == NUMBER)
  1484. return value_new_number(gcd(x->val.number, y->val.number));
  1485. return _NAN;
  1486. }
  1487. value_t *verb_sin(interpreter_t *state, verb_t *self, value_t *x) {
  1488. if (x->tag == NUMBER)
  1489. return value_new_number(sin(x->val.number));
  1490. return _NAN;
  1491. }
  1492. value_t *verb_square(interpreter_t *state, verb_t *self, value_t *x) {
  1493. if (x->tag == NUMBER)
  1494. return value_new_number(x->val.number * x->val.number);
  1495. return _NAN;
  1496. }
  1497. value_t *verb_negate(interpreter_t *state, verb_t *self, value_t *x) {
  1498. if (x->tag == NUMBER)
  1499. return value_new_number(-x->val.number);
  1500. return _NAN;
  1501. }
  1502. value_t *verb_minus(interpreter_t *state, verb_t *self, value_t *x,
  1503. value_t *y) {
  1504. if ((x->tag == NUMBER || x->tag == CHAR) &&
  1505. (y->tag == NUMBER || y->tag == CHAR)) {
  1506. if (x->tag == CHAR || y->tag == CHAR)
  1507. return value_new_char(get_numeric(x) - get_numeric(y));
  1508. return value_new_number(get_numeric(x) - get_numeric(y));
  1509. }
  1510. return _NAN;
  1511. }
  1512. value_t *verb_atan(interpreter_t *state, verb_t *self, value_t *x) {
  1513. if (x->tag == NUMBER)
  1514. return value_new_number(atan(x->val.number));
  1515. return _NAN;
  1516. }
  1517. value_t *verb_atan2(interpreter_t *state, verb_t *self, value_t *x,
  1518. value_t *y) {
  1519. if (x->tag == NUMBER && y->tag == NUMBER)
  1520. return value_new_number(atan2(x->val.number, y->val.number));
  1521. return _NAN;
  1522. }
  1523. value_t *verb_first(interpreter_t *state, verb_t *self, value_t *x) {
  1524. if (x->tag != ARRAY)
  1525. return x;
  1526. if (list_empty(x->val.array))
  1527. return state->udf;
  1528. return x->val.array->value;
  1529. }
  1530. value_t *verb_times(interpreter_t *state, verb_t *self, value_t *x,
  1531. value_t *y) {
  1532. if ((x->tag == NUMBER || x->tag == CHAR) &&
  1533. (y->tag == NUMBER || y->tag == CHAR)) {
  1534. if (x->tag == CHAR || y->tag == CHAR)
  1535. return value_new_char(get_numeric(x) * get_numeric(y));
  1536. return value_new_number(get_numeric(x) * get_numeric(y));
  1537. }
  1538. return _NAN;
  1539. }
  1540. double lcm(double a, double b) { return (a * b) / gcd(a, b); }
  1541. uint64_t factorial(uint64_t n) {
  1542. uint64_t r = 1;
  1543. while (n > 0)
  1544. r *= n--;
  1545. return r;
  1546. }
  1547. value_t *verb_factorial(interpreter_t *state, verb_t *self, value_t *x) {
  1548. if (x->tag == NUMBER)
  1549. return value_new_number(factorial((uint64_t)fabs(x->val.number)));
  1550. return _NAN;
  1551. }
  1552. value_t *verb_lcm(interpreter_t *state, verb_t *self, value_t *x, value_t *y) {
  1553. if (x->tag == NUMBER && y->tag == NUMBER)
  1554. return value_new_number(lcm(x->val.number, y->val.number));
  1555. return _NAN;
  1556. }
  1557. value_t *verb_double(interpreter_t *state, verb_t *self, value_t *x) {
  1558. if (x->tag == NUMBER)
  1559. return value_new_number(x->val.number * 2);
  1560. return _NAN;
  1561. }
  1562. value_t *verb_replicate(interpreter_t *state, verb_t *self, value_t *x,
  1563. value_t *y) {
  1564. if (x->tag == NUMBER) {
  1565. size_t k = fabs(x->val.number);
  1566. list_t *r = list_new();
  1567. while (k--)
  1568. list_push(r, y);
  1569. return value_new_array(r);
  1570. }
  1571. return state->udf;
  1572. }
  1573. value_t *verb_reciprocal(interpreter_t *state, verb_t *self, value_t *x) {
  1574. if (x->tag == NUMBER)
  1575. return value_new_number(1 / x->val.number);
  1576. return _NAN;
  1577. }
  1578. value_t *verb_divide(interpreter_t *state, verb_t *self, value_t *x,
  1579. value_t *y) {
  1580. if (x->tag == NUMBER && y->tag == NUMBER) {
  1581. double ny = y->val.number;
  1582. if (ny == 0)
  1583. return INF;
  1584. return value_new_number(x->val.number / ny);
  1585. }
  1586. return _NAN;
  1587. }
  1588. double npower(double base, int n) {
  1589. if (n < 0)
  1590. return npower(1 / base, -n);
  1591. else if (n == 0)
  1592. return 1.0;
  1593. else if (n == 1)
  1594. return base;
  1595. else if (n % 2)
  1596. return base * npower(base * base, n / 2);
  1597. else
  1598. return npower(base * base, n / 2);
  1599. }
  1600. double nroot(double base, int n) {
  1601. if (n == 1)
  1602. return base;
  1603. else if (n <= 0 || base < 0)
  1604. return NAN;
  1605. else {
  1606. double delta, x = base / n;
  1607. do {
  1608. delta = (base / npower(x, n - 1) - x) / n;
  1609. x += delta;
  1610. } while (fabs(delta) >= 1e-8);
  1611. return x;
  1612. }
  1613. }
  1614. value_t *verb_sqrt(interpreter_t *state, verb_t *self, value_t *x) {
  1615. if (x->tag == NUMBER)
  1616. return value_new_number(sqrt(x->val.number));
  1617. return _NAN;
  1618. }
  1619. value_t *verb_root(interpreter_t *state, verb_t *self, value_t *x, value_t *y) {
  1620. if (x->tag == NUMBER && y->tag == NUMBER)
  1621. return value_new_number(nroot(y->val.number, x->val.number));
  1622. return _NAN;
  1623. }
  1624. value_t *verb_halve(interpreter_t *state, verb_t *self, value_t *x) {
  1625. if (x->tag == NUMBER)
  1626. return value_new_number(x->val.number / 2);
  1627. return _NAN;
  1628. }
  1629. value_t *verb_idivide(interpreter_t *state, verb_t *self, value_t *x,
  1630. value_t *y) {
  1631. if (x->tag == NUMBER && y->tag == NUMBER) {
  1632. double ny = y->val.number;
  1633. if (ny == 0)
  1634. return INF;
  1635. return value_new_number(trunc(x->val.number / ny));
  1636. }
  1637. return _NAN;
  1638. }
  1639. value_t *verb_enlist(interpreter_t *state, verb_t *self, value_t *x);
  1640. value_t *verb_pred(interpreter_t *state, verb_t *self, value_t *x);
  1641. value_t *verb_range(interpreter_t *state, verb_t *self, value_t *x, value_t *y);
  1642. value_t *verb_enum(interpreter_t *state, verb_t *self, value_t *x) {
  1643. if (value_equals(x, NUMS[1]))
  1644. return verb_enlist(state, NULL, NUMS[0]);
  1645. else if (value_equals(x, NUMS[0]))
  1646. return state->unit;
  1647. return verb_range(state, self, NUMS[0], verb_pred(state, self, x));
  1648. }
  1649. value_t *verb_mod(interpreter_t *state, verb_t *self, value_t *x, value_t *y) {
  1650. if (x->tag == NUMBER && y->tag == NUMBER) {
  1651. double ny = y->val.number;
  1652. if (ny == 0)
  1653. return _NAN;
  1654. return value_new_number(fmod(x->val.number, ny));
  1655. }
  1656. return _NAN;
  1657. }
  1658. value_t *verb_take(interpreter_t *state, verb_t *self, value_t *x, value_t *y);
  1659. value_t *verb_drop(interpreter_t *state, verb_t *self, value_t *x, value_t *y);
  1660. bool is_bad_num(double v) {
  1661. return isnan(v) || v == INFINITY || v == -INFINITY;
  1662. }
  1663. value_t *verb_odometer(interpreter_t *state, verb_t *self, value_t *x) {
  1664. if (x->tag != ARRAY)
  1665. x = verb_enlist(state, NULL, x);
  1666. else if (list_empty(x->val.array) || !x->val.array->next)
  1667. return state->udf;
  1668. size_t p = 1;
  1669. size_t xl = 0;
  1670. list_t *t = x->val.array;
  1671. while (t) {
  1672. value_t *it = t->value;
  1673. if (it->tag != NUMBER || is_bad_num(it->val.number))
  1674. return state->udf;
  1675. p *= (size_t)(it->val.number);
  1676. t = t->next; xl++;
  1677. }
  1678. if (p < 1)
  1679. return state->unit;
  1680. t = x->val.array;
  1681. uint64_t *lims = malloc_checked_atomic(sizeof(uint64_t) * xl);
  1682. for (size_t i = 0; i < xl; i++) {
  1683. lims[i] = (size_t)(((value_t *)t->value)->val.number);
  1684. t = t->next;
  1685. }
  1686. uint64_t **z = malloc_checked(sizeof(uint64_t *) * p);
  1687. for (size_t i = 0; i < p; i++)
  1688. z[i] = malloc_checked_atomic(sizeof(uint64_t) * xl);
  1689. for (size_t i = 0; i < p-1; i++) {
  1690. uint64_t *r = z[i];
  1691. uint64_t *s = z[i + 1];
  1692. bool carry = true;
  1693. for (size_t j = 0; j < xl; j++) {
  1694. uint64_t a = xl-1-j;
  1695. s[a] = r[a];
  1696. if (carry) {
  1697. s[a]++; carry = false;
  1698. }
  1699. if (s[a] >= lims[a]) {
  1700. s[a] = 0; carry = true;
  1701. }
  1702. }
  1703. }
  1704. GC_FREE(lims);
  1705. list_t *r = list_new();
  1706. for (size_t i = 0; i < p; i++) {
  1707. list_t *rw = list_new();
  1708. for (size_t j = 0; j < xl; j++)
  1709. list_push(rw, value_new_number(z[i][j]));
  1710. list_push(r, value_new_array(rw));
  1711. GC_FREE(z[i]);
  1712. }
  1713. GC_FREE(z);
  1714. return value_new_array(r);
  1715. }
  1716. value_t *verb_chunks(interpreter_t *state, verb_t *self, value_t *x, value_t *y) {
  1717. if (x->tag != NUMBER)
  1718. return state->udf;
  1719. if (y->tag != ARRAY)
  1720. y = verb_enlist(state, NULL, y);
  1721. else if (list_empty(y->val.array))
  1722. return y;
  1723. list_t *r = list_new();
  1724. size_t l = list_length(y->val.array);
  1725. size_t cl = fabs(x->val.number);
  1726. for (size_t i = 0; i < l; i += cl)
  1727. list_push(r, verb_take(state, NULL, value_new_number(cl), verb_drop(state, NULL, value_new_number(i), y)));
  1728. return value_new_array(r);
  1729. }
  1730. value_t *verb_exp(interpreter_t *state, verb_t *self, value_t *x) {
  1731. if (x->tag == NUMBER)
  1732. return value_new_number(exp(x->val.number));
  1733. return _NAN;
  1734. }
  1735. value_t *verb_power(interpreter_t *state, verb_t *self, value_t *x,
  1736. value_t *y) {
  1737. if (x->tag == NUMBER && y->tag == NUMBER)
  1738. return value_new_number(pow(x->val.number, y->val.number));
  1739. return _NAN;
  1740. }
  1741. value_t *verb_nlog(interpreter_t *state, verb_t *self, value_t *x) {
  1742. if (x->tag == NUMBER)
  1743. return value_new_number(log(x->val.number));
  1744. return _NAN;
  1745. }
  1746. value_t *verb_log(interpreter_t *state, verb_t *self, value_t *x, value_t *y) {
  1747. if (x->tag == NUMBER && y->tag == NUMBER)
  1748. return value_new_number(log(y->val.number) / log(x->val.number));
  1749. return _NAN;
  1750. }
  1751. int bits_needed(uint32_t value) {
  1752. int bits = 0;
  1753. for (int bit_test = 16; bit_test > 0; bit_test >>= 1) {
  1754. if (value >> bit_test != 0) {
  1755. bits += bit_test;
  1756. value >>= bit_test;
  1757. }
  1758. }
  1759. return bits + value;
  1760. }
  1761. value_t *verb_bits(interpreter_t *state, verb_t *self, value_t *x) {
  1762. if (x->tag == NUMBER) {
  1763. int n = x->val.number;
  1764. int bk = bits_needed(n);
  1765. list_t *r = list_new();
  1766. for (int i = 0; i < bk; i++)
  1767. if ((n & (1 << i)) >> i)
  1768. list_push(r, NUMS[1]);
  1769. else
  1770. list_push(r, NUMS[0]);
  1771. return value_new_array(r);
  1772. }
  1773. return state->udf;
  1774. }
  1775. value_t *verb_base(interpreter_t *state, verb_t *self, value_t *x, value_t *y) {
  1776. if (x->tag == NUMBER && y->tag == NUMBER) {
  1777. size_t v = fabs(y->val.number);
  1778. size_t b = fabs(x->val.number);
  1779. if (b < 2)
  1780. return state->udf;
  1781. list_t *r = list_new();
  1782. while (v > 0) {
  1783. r = list_insert(&r, 0, value_new_number(v % b));
  1784. v /= b;
  1785. }
  1786. return value_new_array(r);
  1787. }
  1788. return state->udf;
  1789. }
  1790. ssize_t indexOf(list_t *l, value_t *x) {
  1791. if (list_empty(l))
  1792. return -1;
  1793. size_t i = 0;
  1794. while (l) {
  1795. if (value_equals(l->value, x))
  1796. return i;
  1797. l = l->next;
  1798. i++;
  1799. }
  1800. return -1;
  1801. }
  1802. value_t *verb_group(interpreter_t *state, verb_t *self, value_t *x) {
  1803. if (x->tag != ARRAY)
  1804. x = verb_enlist(state, NULL, x);
  1805. else if (list_empty(x->val.array))
  1806. return x;
  1807. list_t *r = list_new();
  1808. list_t *is = list_new();
  1809. size_t i = 0;
  1810. list_t *t = x->val.array;
  1811. while (t) {
  1812. value_t *v = t->value;
  1813. ssize_t n = indexOf(is, v);
  1814. if (n < 0) {
  1815. list_push(r, verb_enlist(state, NULL, value_new_number(i)));
  1816. list_push(is, v);
  1817. } else {
  1818. value_t *tmp = list_index(r, n);
  1819. list_push(tmp->val.array, value_new_number(i));
  1820. }
  1821. t = t->next;
  1822. i++;
  1823. }
  1824. while (is) {
  1825. list_t *tmp = is->next;
  1826. GC_FREE(is);
  1827. is = tmp;
  1828. }
  1829. return value_new_array(r);
  1830. }
  1831. value_t *verb_buckets(interpreter_t *state, verb_t *self, value_t *x,
  1832. value_t *y) {
  1833. if (x->tag != ARRAY)
  1834. x = verb_enlist(state, NULL, x);
  1835. else if (list_empty(x->val.array))
  1836. return y;
  1837. if (y->tag != ARRAY)
  1838. y = verb_enlist(state, NULL, x);
  1839. else if (list_empty(y->val.array))
  1840. return y;
  1841. list_t *r = list_new();
  1842. list_t *t = x->val.array;
  1843. size_t mx = 0;
  1844. while (t) {
  1845. value_t *v = t->value;
  1846. if (v->tag != NUMBER)
  1847. break;
  1848. ssize_t i = v->val.number;
  1849. if (i >= 0 && i > mx)
  1850. mx = i;
  1851. t = t->next;
  1852. }
  1853. for (size_t i = 0; i < mx+1; i++)
  1854. list_push(r, list_new());
  1855. if (list_empty(r)) {
  1856. GC_FREE(r);
  1857. return state->unit;
  1858. }
  1859. list_t *ty = y->val.array;
  1860. t = x->val.array;
  1861. while (t && ty) {
  1862. value_t *v = t->value;
  1863. if (v->tag != NUMBER)
  1864. break;
  1865. ssize_t i = v->val.number;
  1866. if (i >= 0) {
  1867. list_t *b = list_index(r, i);
  1868. if (b)
  1869. list_push(b, ty->value);
  1870. }
  1871. t = t->next; ty = ty->next;
  1872. }
  1873. if (ty) {
  1874. list_t *lb = list_new();
  1875. while (ty) {
  1876. list_push(lb, ty->value);
  1877. ty = ty->next;
  1878. }
  1879. list_push(r, lb);
  1880. }
  1881. t = r;
  1882. while (t) {
  1883. t->value = value_new_array(t->value);
  1884. t = t->next;
  1885. }
  1886. return value_new_array(r);
  1887. }
  1888. value_t *verb_equals(interpreter_t *state, verb_t *self, value_t *x,
  1889. value_t *y) {
  1890. return value_equals(x, y) ? NUMS[1] : NUMS[0];
  1891. }
  1892. value_t *verb_permute(interpreter_t *state, verb_t *self, value_t *x) {
  1893. if (x->tag != ARRAY || list_empty(x->val.array) || !x->val.array->next)
  1894. return x;
  1895. list_t* permutation = list_copy(x->val.array);
  1896. size_t length = list_length(permutation);
  1897. list_t *result = list_new();
  1898. list_push(result, list_copy(permutation));
  1899. list_t *c = list_new();
  1900. for (size_t i = 0; i < length; i++) {
  1901. size_t *n = malloc_checked_atomic(sizeof(size_t));
  1902. list_push(c, n);
  1903. }
  1904. size_t k;
  1905. list_t *p;
  1906. size_t i = 0;
  1907. while (i < length) {
  1908. size_t *n = list_index(c, i);
  1909. if ((*n) < i) {
  1910. k = i % 2 && (*n);
  1911. p = list_index(permutation, i);
  1912. list_set(permutation, i, list_index(permutation, k));
  1913. list_set(permutation, k, p);
  1914. *n = (*n) + 1;
  1915. i = 1;
  1916. list_push(result, list_copy(permutation));
  1917. } else {
  1918. *n = 0;
  1919. i++;
  1920. }
  1921. }
  1922. while (c) {
  1923. list_t *tmp = c->next;
  1924. GC_FREE(c->value);
  1925. GC_FREE(c);
  1926. c = tmp;
  1927. }
  1928. while (permutation) {
  1929. list_t *tmp = permutation->next;
  1930. GC_FREE(permutation);
  1931. permutation = tmp;
  1932. }
  1933. list_t *t = result;
  1934. while (t) {
  1935. t->value = value_new_array(t->value);
  1936. t = t->next;
  1937. }
  1938. return value_new_array(result);
  1939. }
  1940. value_t *verb_occurences(interpreter_t *state, verb_t *self, value_t *x) {
  1941. if (x->tag != ARRAY)
  1942. x = verb_enlist(state, NULL, x);
  1943. else if (list_empty(x->val.array))
  1944. return x;
  1945. list_t *table = list_new();
  1946. list_t *r = list_new();
  1947. list_t *t = x->val.array;
  1948. while (t) {
  1949. bool f = false;
  1950. value_t *it = t->value;
  1951. list_t *tt = table;
  1952. if (!list_empty(tt))
  1953. while (tt) {
  1954. list_t *p = tt->value;
  1955. if (value_equals(p->value, it)) {
  1956. size_t *n = p->next->value;
  1957. *n = (*n) + 1;
  1958. list_push(r, value_new_number(*n));
  1959. f = true;
  1960. break;
  1961. }
  1962. tt = tt->next;
  1963. }
  1964. if (!f) {
  1965. list_t *p = list_new();
  1966. list_push(p, it);
  1967. size_t *n = malloc_checked_atomic(sizeof(size_t));
  1968. list_push(p, n);
  1969. list_push(table, p);
  1970. list_push(r, NUMS[0]);
  1971. }
  1972. t = t->next;
  1973. }
  1974. if (!list_empty(table)) {
  1975. t = table;
  1976. while (t) {
  1977. list_t *tmp = t->next;
  1978. list_t *p = t->value;
  1979. GC_FREE(p->next->value);
  1980. GC_FREE(p->next);
  1981. GC_FREE(p);
  1982. GC_FREE(t);
  1983. t = tmp;
  1984. }
  1985. }
  1986. return value_new_array(r);
  1987. }
  1988. value_t *verb_mask(interpreter_t *state, verb_t *self, value_t *x,
  1989. value_t *y) {
  1990. if (x->tag != ARRAY)
  1991. x = verb_enlist(state, NULL, x);
  1992. else if (list_empty(x->val.array))
  1993. return x;
  1994. if (y->tag != ARRAY)
  1995. y = verb_enlist(state, NULL, y);
  1996. list_t *r = list_new();
  1997. value_t *l = value_new_number(list_length(y->val.array));
  1998. size_t n = 0;
  1999. size_t k = list_length(x->val.array);
  2000. for (size_t i = 0; i < k; i++) {
  2001. value_t *s = verb_take(state, NULL, l, verb_drop(state, NULL, value_new_number(i), x));
  2002. if (value_equals(s, y)) {
  2003. n++;
  2004. for (size_t j = 0; j < l->val.number; j++, i++)
  2005. list_push(r, value_new_number(n));
  2006. i--;
  2007. } else list_push(r, NUMS[0]);
  2008. }
  2009. return value_new_array(r);
  2010. }
  2011. value_t *verb_classify(interpreter_t *state, verb_t *self, value_t *x) {
  2012. if (x->tag != ARRAY)
  2013. x = verb_enlist(state, NULL, x);
  2014. else if (list_empty(x->val.array))
  2015. return x;
  2016. list_t *table = list_new();
  2017. list_t *r = list_new();
  2018. list_t *t = x->val.array;
  2019. size_t i = 0;
  2020. while (t) {
  2021. bool f = false;
  2022. value_t *it = t->value;
  2023. list_t *tt = table;
  2024. if (!list_empty(tt))
  2025. while (tt) {
  2026. list_t *p = tt->value;
  2027. if (value_equals(p->value, it)) {
  2028. size_t *n = p->next->value;
  2029. list_push(r, value_new_number(*n));
  2030. f = true;
  2031. break;
  2032. }
  2033. tt = tt->next;
  2034. }
  2035. if (!f) {
  2036. list_t *p = list_new();
  2037. list_push(p, it);
  2038. size_t *n = malloc_checked_atomic(sizeof(size_t));
  2039. *n = i++;
  2040. list_push(p, n);
  2041. list_push(table, p);
  2042. list_push(r, value_new_number(*n));
  2043. }
  2044. t = t->next;
  2045. }
  2046. if (!list_empty(table)) {
  2047. t = table;
  2048. while (t) {
  2049. list_t *tmp = t->next;
  2050. list_t *p = t->value;
  2051. GC_FREE(p->next->value);
  2052. GC_FREE(p->next);
  2053. GC_FREE(p);
  2054. GC_FREE(t);
  2055. t = tmp;
  2056. }
  2057. }
  2058. return value_new_array(r);
  2059. }
  2060. value_t *verb_unbits(interpreter_t *state, verb_t *self, value_t *x) {
  2061. if (x->tag != ARRAY)
  2062. x = verb_enlist(state, NULL, x);
  2063. int n = 0;
  2064. int i = 0;
  2065. list_t *t = x->val.array;
  2066. while (t) {
  2067. if (value_is_truthy(t->value))
  2068. n |= (int)1 << i;
  2069. else
  2070. n &= ~((int)1 << i);
  2071. t = t->next;
  2072. i++;
  2073. }
  2074. return value_new_number(n);
  2075. }
  2076. value_t *verb_unbase(interpreter_t *state, verb_t *self, value_t *x,
  2077. value_t *y) {
  2078. if (x->tag == NUMBER) {
  2079. size_t b = fabs(x->val.number);
  2080. if (b < 2)
  2081. return state->udf;
  2082. if (y->tag != ARRAY)
  2083. y = verb_enlist(state, NULL, y);
  2084. size_t n = 0;
  2085. list_t *t = y->val.array;
  2086. if (list_empty(t))
  2087. return state->udf;
  2088. while (t) {
  2089. value_t *v = t->value;
  2090. if (v->tag != NUMBER)
  2091. break;
  2092. size_t k = fabs(v->val.number);
  2093. n = n * b + k;
  2094. t = t->next;
  2095. }
  2096. return value_new_number(n);
  2097. }
  2098. return state->udf;
  2099. }
  2100. value_t *verb_not(interpreter_t *state, verb_t *self, value_t *x) {
  2101. return value_is_truthy(x) ? NUMS[0] : NUMS[1];
  2102. }
  2103. value_t *verb_not_equals(interpreter_t *state, verb_t *self, value_t *x,
  2104. value_t *y) {
  2105. return !value_equals(x, y) ? NUMS[1] : NUMS[0];
  2106. }
  2107. value_t *verb_pred(interpreter_t *state, verb_t *self, value_t *x) {
  2108. if (x->tag == NUMBER)
  2109. return value_new_number(x->val.number - 1);
  2110. else if (x->tag == CHAR)
  2111. return value_new_char(x->val._char - 1);
  2112. return _NAN;
  2113. }
  2114. value_t *verb_less(interpreter_t *state, verb_t *self, value_t *x, value_t *y) {
  2115. if ((x->tag == NUMBER || x->tag == CHAR) &&
  2116. (y->tag == NUMBER || y->tag == CHAR)) {
  2117. if (get_numeric(x) < get_numeric(y))
  2118. return NUMS[1];
  2119. return NUMS[0];
  2120. }
  2121. return _NAN;
  2122. }
  2123. value_t *verb_floor(interpreter_t *state, verb_t *self, value_t *x) {
  2124. if (x->tag == NUMBER)
  2125. return value_new_number(floor(x->val.number));
  2126. return _NAN;
  2127. }
  2128. bool _compare_up(void *a, void *b) {
  2129. value_t *x = ((list_t *)a)->value;
  2130. value_t *y = ((list_t *)b)->value;
  2131. if ((x->tag == NUMBER || x->tag == CHAR) &&
  2132. (y->tag == NUMBER || y->tag == CHAR)) {
  2133. if (get_numeric(x) > get_numeric(y))
  2134. return true;
  2135. return false;
  2136. }
  2137. return false;
  2138. }
  2139. bool _compare_down(void *a, void *b) {
  2140. value_t *x = ((list_t *)a)->value;
  2141. value_t *y = ((list_t *)b)->value;
  2142. if ((x->tag == NUMBER || x->tag == CHAR) &&
  2143. (y->tag == NUMBER || y->tag == CHAR)) {
  2144. if (get_numeric(x) < get_numeric(y))
  2145. return true;
  2146. return false;
  2147. }
  2148. return false;
  2149. }
  2150. value_t *_grade(value_t *x, bool down) {
  2151. if (x->tag != ARRAY || list_empty(x->val.array) || !x->val.array->next)
  2152. return x;
  2153. size_t i = 0;
  2154. list_t *ps = list_new();
  2155. list_t *t = x->val.array;
  2156. while (t) {
  2157. list_t *p = list_new();
  2158. list_push(p, t->value);
  2159. list_push(p, value_new_number(i++));
  2160. list_push(ps, p);
  2161. t = t->next;
  2162. }
  2163. ps = list_sort(ps, down ? _compare_down : _compare_up);
  2164. t = ps;
  2165. while (t) {
  2166. list_t *p = t->value;
  2167. t->value = p->next->value;
  2168. GC_FREE(p->next);
  2169. GC_FREE(p);
  2170. t = t->next;
  2171. }
  2172. return value_new_array(ps);
  2173. }
  2174. value_t *verb_gradedown(interpreter_t *state, verb_t *self, value_t *x) {
  2175. return _grade(x, true);
  2176. }
  2177. value_t *verb_nudge_left(interpreter_t *state, verb_t *self, value_t *x,
  2178. value_t *y) {
  2179. if (y->tag != ARRAY)
  2180. return verb_enlist(state, NULL, x);
  2181. else if (list_empty(y->val.array))
  2182. return y;
  2183. else if (!y->val.array->next)
  2184. return verb_enlist(state, NULL, x);
  2185. list_t *r = list_new();
  2186. list_t *t = y->val.array->next;
  2187. while (t) {
  2188. list_push(r, t->value);
  2189. t = t->next;
  2190. }
  2191. list_push(r, x);
  2192. return value_new_array(r);
  2193. }
  2194. value_t *verb_lesseq(interpreter_t *state, verb_t *self, value_t *x,
  2195. value_t *y) {
  2196. if (value_equals(x, y))
  2197. return NUMS[1];
  2198. if ((x->tag == NUMBER || x->tag == CHAR) &&
  2199. (y->tag == NUMBER || y->tag == CHAR)) {
  2200. if (get_numeric(x) < get_numeric(y))
  2201. return NUMS[1];
  2202. return NUMS[0];
  2203. }
  2204. return _NAN;
  2205. }
  2206. value_t *verb_succ(interpreter_t *state, verb_t *self, value_t *x) {
  2207. if (x->tag == NUMBER)
  2208. return value_new_number(x->val.number + 1);
  2209. else if (x->tag == CHAR)
  2210. return value_new_char(x->val._char + 1);
  2211. return _NAN;
  2212. }
  2213. value_t *verb_ceil(interpreter_t *state, verb_t *self, value_t *x) {
  2214. if (x->tag == NUMBER)
  2215. return value_new_number(ceil(x->val.number));
  2216. return _NAN;
  2217. }
  2218. value_t *verb_greater(interpreter_t *state, verb_t *self, value_t *x,
  2219. value_t *y) {
  2220. if ((x->tag == NUMBER || x->tag == CHAR) &&
  2221. (y->tag == NUMBER || y->tag == CHAR)) {
  2222. if (get_numeric(x) > get_numeric(y))
  2223. return NUMS[1];
  2224. return NUMS[0];
  2225. }
  2226. return _NAN;
  2227. }
  2228. value_t *verb_greatereq(interpreter_t *state, verb_t *self, value_t *x,
  2229. value_t *y) {
  2230. if (value_equals(x, y))
  2231. return NUMS[1];
  2232. if ((x->tag == NUMBER || x->tag == CHAR) &&
  2233. (y->tag == NUMBER || y->tag == CHAR)) {
  2234. if (get_numeric(x) > get_numeric(y))
  2235. return NUMS[1];
  2236. return NUMS[0];
  2237. }
  2238. return _NAN;
  2239. }
  2240. value_t *verb_gradeup(interpreter_t *state, verb_t *self, value_t *x) {
  2241. return _grade(x, false);
  2242. }
  2243. value_t *verb_nudge_right(interpreter_t *state, verb_t *self, value_t *x,
  2244. value_t *y) {
  2245. if (y->tag != ARRAY)
  2246. return verb_enlist(state, NULL, x);
  2247. else if (list_empty(y->val.array))
  2248. return y;
  2249. else if (!y->val.array->next)
  2250. return verb_enlist(state, NULL, x);
  2251. list_t *r = list_new();
  2252. list_push(r, x);
  2253. list_t *t = y->val.array;
  2254. while (t->next) {
  2255. list_push(r, t->value);
  2256. t = t->next;
  2257. }
  2258. return value_new_array(r);
  2259. }
  2260. value_t *verb_enlist(interpreter_t *state, verb_t *self, value_t *x) {
  2261. list_t *l = list_new();
  2262. list_push(l, x);
  2263. return value_new_array(l);
  2264. }
  2265. value_t *verb_join(interpreter_t *state, verb_t *self, value_t *x, value_t *y) {
  2266. list_t *l = list_new();
  2267. if (x->tag == ARRAY && !list_empty(x->val.array)) {
  2268. list_t *t = x->val.array;
  2269. while (t) {
  2270. list_push(l, t->value);
  2271. t = t->next;
  2272. }
  2273. } else
  2274. list_push(l, x);
  2275. if (y->tag == ARRAY && !list_empty(y->val.array)) {
  2276. list_t *t = y->val.array;
  2277. while (t) {
  2278. list_push(l, t->value);
  2279. t = t->next;
  2280. }
  2281. } else
  2282. list_push(l, y);
  2283. return value_new_array(l);
  2284. }
  2285. value_t *verb_enpair(interpreter_t *state, verb_t *self, value_t *x,
  2286. value_t *y) {
  2287. list_t *l = list_new();
  2288. list_push(l, x);
  2289. list_push(l, y);
  2290. return value_new_array(l);
  2291. }
  2292. value_t *verb_selfref1(interpreter_t *state, verb_t *self, value_t *x) {
  2293. verb_t *v;
  2294. if (!list_empty(state->args))
  2295. v = list_index(list_index(state->args, -1), -1);
  2296. else if (!list_empty(state->selfrefs))
  2297. v = list_index(state->selfrefs, -1);
  2298. else
  2299. return state->udf;
  2300. return each_rank(state, v, x, 0, v->rank[0]);
  2301. }
  2302. value_t *verb_selfref2(interpreter_t *state, verb_t *self, value_t *x,
  2303. value_t *y) {
  2304. verb_t *v;
  2305. if (!list_empty(state->args))
  2306. v = list_index(list_index(state->args, -1), -1);
  2307. else if (!list_empty(state->selfrefs))
  2308. v = list_index(state->selfrefs, -1);
  2309. else
  2310. return state->udf;
  2311. return together(state, v, x, y, 0, 0, v->rank[1], v->rank[2]);
  2312. }
  2313. value_t *verb_take(interpreter_t *state, verb_t *self, value_t *x, value_t *y) {
  2314. if (x->tag == NUMBER) {
  2315. if (y->tag != ARRAY) {
  2316. if (x->val.number == 0)
  2317. return state->unit;
  2318. else return x;
  2319. }
  2320. if (x->val.number == 0 || list_empty(y->val.array))
  2321. return state->unit;
  2322. bool rev = x->val.number < 0;
  2323. size_t k = (size_t)fabs(x->val.number);
  2324. list_t *t = y->val.array;
  2325. list_t *r = list_new();
  2326. if (rev)
  2327. for (ssize_t i = k; i > 0; i--) {
  2328. value_t *v = list_index(t, -i);
  2329. if (!v)
  2330. continue;
  2331. list_push(r, v);
  2332. }
  2333. else
  2334. while (t && k) {
  2335. list_push(r, t->value);
  2336. t = t->next;
  2337. k--;
  2338. }
  2339. return value_new_array(r);
  2340. }
  2341. return state->udf;
  2342. }
  2343. value_t *verb_where(interpreter_t *state, verb_t *self, value_t *x) {
  2344. if (x->tag != ARRAY)
  2345. x = verb_enlist(state, NULL, x);
  2346. else if (list_empty(x->val.array))
  2347. return x;
  2348. list_t *r = list_new();
  2349. list_t *t = x->val.array;
  2350. size_t i = 0;
  2351. while (t) {
  2352. value_t *a = t->value;
  2353. if (a->tag != NUMBER)
  2354. break;
  2355. size_t k = fabs(a->val.number);
  2356. for (size_t j = 0; j < k; j++)
  2357. list_push(r, value_new_number(i));
  2358. t = t->next;
  2359. i++;
  2360. }
  2361. return value_new_array(r);
  2362. }
  2363. value_t *verb_copy(interpreter_t *state, verb_t *self, value_t *x, value_t *y) {
  2364. if (x->tag != ARRAY)
  2365. x = verb_enlist(state, NULL, x);
  2366. if (y->tag != ARRAY)
  2367. y = verb_enlist(state, NULL, y);
  2368. list_t *tx = x->val.array;
  2369. list_t *ty = y->val.array;
  2370. if (list_empty(tx) || list_empty(ty))
  2371. return state->unit;
  2372. list_t *r = list_new();
  2373. while (tx) {
  2374. value_t *a = tx->value;
  2375. value_t *b = ty->value;
  2376. if (b->tag != NUMBER)
  2377. break;
  2378. size_t k = fabs(b->val.number);
  2379. for (size_t i = 0; i < k; i++)
  2380. list_push(r, a);
  2381. tx = tx->next;
  2382. if (ty->next)
  2383. ty = ty->next;
  2384. }
  2385. return value_new_array(r);
  2386. }
  2387. value_t *verb_nub(interpreter_t *state, verb_t *self, value_t *x) {
  2388. if (x->tag != ARRAY || list_empty(x->val.array))
  2389. return x;
  2390. list_t *n = list_new();
  2391. list_t *r = list_new();
  2392. list_t *t = x->val.array;
  2393. while (t) {
  2394. bool u = true;
  2395. list_t *t2 = r;
  2396. if (!list_empty(t2))
  2397. while (t2) {
  2398. if (value_equals(t->value, t2->value)) {
  2399. u = false;
  2400. break;
  2401. }
  2402. t2 = t2->next;
  2403. }
  2404. if (u)
  2405. list_push(r, t->value);
  2406. list_push(n, u ? NUMS[1] : NUMS[0]);
  2407. t = t->next;
  2408. }
  2409. while (r) {
  2410. list_t *tmp = r->next;
  2411. GC_FREE(r);
  2412. r = tmp;
  2413. }
  2414. return value_new_array(n);
  2415. }
  2416. value_t *verb_drop(interpreter_t *state, verb_t *self, value_t *x, value_t *y) {
  2417. if (x->tag == NUMBER) {
  2418. if (y->tag != ARRAY) {
  2419. if (x->val.number == 0)
  2420. return y;
  2421. else return state->unit;
  2422. }
  2423. if (x->val.number == 0)
  2424. return y;
  2425. if (list_empty(y->val.array))
  2426. return state->unit;
  2427. bool rev = x->val.number < 0;
  2428. size_t k = (size_t)fabs(x->val.number);
  2429. list_t *t = y->val.array;
  2430. if (rev) {
  2431. size_t l = list_length(t);
  2432. if (k >= l)
  2433. return state->unit;
  2434. return verb_take(state, NULL, value_new_number(l - k), y);
  2435. }
  2436. list_t *r = list_new();
  2437. while (t && k) {
  2438. t = t->next;
  2439. k--;
  2440. }
  2441. while (t) {
  2442. list_push(r, t->value);
  2443. t = t->next;
  2444. }
  2445. return value_new_array(r);
  2446. }
  2447. return state->udf;
  2448. }
  2449. value_t *verb_unique(interpreter_t *state, verb_t *self, value_t *x) {
  2450. if (x->tag != ARRAY || list_empty(x->val.array))
  2451. return x;
  2452. list_t *r = list_new();
  2453. list_t *t = x->val.array;
  2454. while (t) {
  2455. bool u = true;
  2456. list_t *t2 = r;
  2457. if (!list_empty(t2))
  2458. while (t2) {
  2459. if (value_equals(t->value, t2->value)) {
  2460. u = false;
  2461. break;
  2462. }
  2463. t2 = t2->next;
  2464. }
  2465. if (u)
  2466. list_push(r, t->value);
  2467. t = t->next;
  2468. }
  2469. return value_new_array(r);
  2470. }
  2471. value_t *verb_find(interpreter_t *state, verb_t *self, value_t *x, value_t *y) {
  2472. if (y->tag != ARRAY)
  2473. y = verb_enlist(state, self, y);
  2474. else if (list_empty(y->val.array))
  2475. return state->unit;
  2476. size_t i = 0;
  2477. list_t *r = list_new();
  2478. list_t *t = y->val.array;
  2479. while (t) {
  2480. if (value_equals(t->value, x))
  2481. list_push(r, value_new_number(i));
  2482. t = t->next;
  2483. i++;
  2484. }
  2485. return value_new_array(r);
  2486. }
  2487. value_t *verb_count(interpreter_t *state, verb_t *self, value_t *x) {
  2488. if (x->tag != ARRAY)
  2489. return NUMS[1];
  2490. return value_new_number(list_length(x->val.array));
  2491. }
  2492. void flatten(value_t *v, list_t *r) {
  2493. if (v->tag == ARRAY) {
  2494. list_t *t = v->val.array;
  2495. while (t) {
  2496. flatten(t->value, r);
  2497. t = t->next;
  2498. }
  2499. } else
  2500. list_push(r, v);
  2501. }
  2502. value_t *verb_flatten(interpreter_t *state, verb_t *self, value_t *x) {
  2503. if (x->tag != ARRAY || list_empty(x->val.array))
  2504. return x;
  2505. list_t *r = list_new();
  2506. flatten(x, r);
  2507. return value_new_array(r);
  2508. }
  2509. value_t *verb_minand(interpreter_t *state, verb_t *self, value_t *x,
  2510. value_t *y) {
  2511. if ((x->tag == NUMBER || x->tag == CHAR) &&
  2512. (y->tag == NUMBER || y->tag == CHAR)) {
  2513. if (get_numeric(x) < get_numeric(y))
  2514. return x;
  2515. return y;
  2516. }
  2517. return _NAN;
  2518. }
  2519. value_t *verb_reverse(interpreter_t *state, verb_t *self, value_t *x) {
  2520. if (x->tag != ARRAY)
  2521. return x;
  2522. list_t *t = x->val.array;
  2523. if (list_empty(t))
  2524. return x;
  2525. list_t *r = list_new();
  2526. for (ssize_t i = list_length(t) - 1; i >= 0; i--)
  2527. list_push(r, list_index(t, i));
  2528. return value_new_array(r);
  2529. }
  2530. value_t *verb_maxor(interpreter_t *state, verb_t *self, value_t *x,
  2531. value_t *y) {
  2532. if ((x->tag == NUMBER || x->tag == CHAR) &&
  2533. (y->tag == NUMBER || y->tag == CHAR)) {
  2534. if (get_numeric(x) > get_numeric(y))
  2535. return x;
  2536. return y;
  2537. }
  2538. return _NAN;
  2539. }
  2540. value_t *verb_rotate(interpreter_t *state, verb_t *self, value_t *x,
  2541. value_t *y) {
  2542. if (y->tag != ARRAY || list_empty(y->val.array) || !y->val.array->next)
  2543. return x;
  2544. if (x->tag != NUMBER)
  2545. return state->udf;
  2546. bool rev = x->val.number < 0;
  2547. size_t k = fabs(x->val.number);
  2548. list_t *r = list_new();
  2549. list_t *t = y->val.array;
  2550. while (t) {
  2551. list_push(r, t->value);
  2552. t = t->next;
  2553. }
  2554. for (size_t i = 0; i < k; i++) {
  2555. value_t *v;
  2556. if (rev) {
  2557. v = r->value;
  2558. r = r->next;
  2559. list_push(r, v);
  2560. } else {
  2561. v = list_pop(r);
  2562. r = list_insert(&r, 0, v);
  2563. }
  2564. }
  2565. return value_new_array(r);
  2566. }
  2567. value_t *verb_windows(interpreter_t *state, verb_t *self, value_t *x, value_t *y) {
  2568. if (y->tag != ARRAY)
  2569. y = verb_enlist(state, NULL, y);
  2570. else if (list_empty(y->val.array))
  2571. return y;
  2572. size_t k = fabs(x->val.number);
  2573. size_t l = list_length(y->val.array);
  2574. list_t *r = list_new();
  2575. for (size_t i = 0; i < l; i++) {
  2576. if (i + k > l)
  2577. break;
  2578. list_push(r, verb_take(state, NULL, value_new_number(k), verb_drop(state, NULL, value_new_number(i), y)));
  2579. }
  2580. return value_new_array(r);
  2581. }
  2582. size_t depthOf(value_t *x, size_t d) {
  2583. if (x->tag == ARRAY) {
  2584. list_t *t = x->val.array;
  2585. if (list_empty(t))
  2586. return 0;
  2587. while (t) {
  2588. size_t d2 = depthOf(t->value, d + 1);
  2589. if (d2 > d)
  2590. d = d2;
  2591. t = t->next;
  2592. }
  2593. return d;
  2594. }
  2595. return 0;
  2596. }
  2597. value_t *verb_depth(interpreter_t *state, verb_t *self, value_t *x) {
  2598. return value_new_number(depthOf(x, 1));
  2599. }
  2600. value_t *verb_round(interpreter_t *state, verb_t *self, value_t *x) {
  2601. if (x->tag == NUMBER)
  2602. return value_new_number(round(x->val.number));
  2603. return _NAN;
  2604. }
  2605. value_t *verb_abs(interpreter_t *state, verb_t *self, value_t *x) {
  2606. if (x->tag == NUMBER)
  2607. return value_new_number(fabs(x->val.number));
  2608. return _NAN;
  2609. }
  2610. value_t *verb_tail(interpreter_t *state, verb_t *self, value_t *x);
  2611. value_t *verb_at(interpreter_t *state, verb_t *self, value_t *x, value_t *y) {
  2612. if (y->tag != NUMBER)
  2613. return state->udf;
  2614. if (x->tag != ARRAY) {
  2615. if (y->val.number > -1 && y->val.number < 1)
  2616. return x;
  2617. else
  2618. return state->udf;
  2619. }
  2620. if (list_empty(x->val.array))
  2621. return state->nil;
  2622. value_t *v = list_index(x->val.array, (ssize_t)y->val.number);
  2623. if (!v)
  2624. return state->udf;
  2625. return v;
  2626. }
  2627. value_t *verb_member(interpreter_t *state, verb_t *self, value_t *x,
  2628. value_t *y) {
  2629. if (y->tag != ARRAY)
  2630. y = verb_enlist(state, self, y);
  2631. else if (list_empty(y->val.array))
  2632. return NUMS[0];
  2633. list_t *t = y->val.array;
  2634. while (t) {
  2635. if (value_equals(t->value, x))
  2636. return NUMS[1];
  2637. t = t->next;
  2638. }
  2639. return NUMS[0];
  2640. }
  2641. value_t *verb_shuffle(interpreter_t *state, verb_t *self, value_t *x) {
  2642. if (x->tag != ARRAY)
  2643. x = verb_enlist(state, self, x);
  2644. else if (list_empty(x->val.array))
  2645. return x;
  2646. list_t *t = x->val.array;
  2647. size_t l = 0;
  2648. list_t *r = list_new();
  2649. while (t) {
  2650. list_push(r, t->value);
  2651. t = t->next; l++;
  2652. }
  2653. for (size_t i = 0; i < l; i++) {
  2654. size_t j = rand() % l;
  2655. value_t *tmp = list_index(r, i);
  2656. list_set(r, i, list_index(r, j));
  2657. list_set(r, j, tmp);
  2658. }
  2659. return value_new_array(r);
  2660. }
  2661. value_t *verb_head(interpreter_t *state, verb_t *self, value_t *x) {
  2662. return verb_take(state, NULL, NUMS[2], x);
  2663. }
  2664. value_t *verb_bin(interpreter_t *state, verb_t *self, value_t *x, value_t *y) {
  2665. if (x->tag != ARRAY)
  2666. x = verb_enlist(state, self, x);
  2667. else if (list_empty(x->val.array))
  2668. return x;
  2669. if (y->tag != ARRAY)
  2670. y = verb_enlist(state, self, x);
  2671. else if (list_empty(y->val.array))
  2672. return y;
  2673. size_t xl = list_length(x->val.array);
  2674. list_t *bins = list_new();
  2675. for (size_t i = 0; i < xl; i++) {
  2676. double s;
  2677. double e;
  2678. value_t *vs = list_index(x->val.array, i);
  2679. if (vs->tag == NUMBER)
  2680. s = vs->val.number;
  2681. else if (vs->tag == CHAR)
  2682. s = vs->val._char;
  2683. else return state->udf;
  2684. value_t *ve = i == xl - 1? value_new_number(s + 1): list_index(x->val.array, i + 1);
  2685. if (ve->tag == NUMBER)
  2686. e = fabs(ve->val.number);
  2687. else if (ve->tag == CHAR)
  2688. e = ve->val._char;
  2689. else return state->udf;
  2690. if (list_length(bins) > 0) {
  2691. list_t *pp = list_index(bins, -1);
  2692. double *pe = pp->value;
  2693. if (s <= (*pe))
  2694. return state->udf;
  2695. }
  2696. double *sn = malloc_checked(sizeof(double));
  2697. *sn = s;
  2698. double *en = malloc_checked(sizeof(double));
  2699. *en = e;
  2700. list_t *p = list_new();
  2701. list_push(p, sn);
  2702. list_push(p, en);
  2703. list_push(bins, p);
  2704. }
  2705. size_t bl = list_length(bins);
  2706. list_t *r = list_new();
  2707. size_t yl = list_length(y->val.array);
  2708. for (size_t i = 0; i < yl; i++) {
  2709. value_t *it = list_index(y->val.array, i);
  2710. double itv;
  2711. if (it->tag == NUMBER)
  2712. itv = it->val.number;
  2713. else if (it->tag == CHAR)
  2714. itv = it->val._char;
  2715. else return state->udf;
  2716. list_t *b = bins->value;
  2717. double *s = b->value;
  2718. if (itv < (*s)) {
  2719. list_push(r, NNUMS[0]);
  2720. continue;
  2721. }
  2722. b = list_index(bins, -1);
  2723. s = b->next->value;
  2724. if (itv >= (*s)) {
  2725. list_push(r, value_new_number(bl - 1));
  2726. continue;
  2727. }
  2728. double v = NAN;
  2729. for (size_t j = 0; j < bl; j++) {
  2730. b = list_index(bins, j);
  2731. double *s = b->value;
  2732. double *e = b->next->value;
  2733. if (itv >= (*s) && itv < (*e)) {
  2734. v = j; break;
  2735. }
  2736. }
  2737. if (!isnan(v))
  2738. list_push(r, value_new_number(v));
  2739. }
  2740. while (bins) {
  2741. list_t *tmp = bins->next;
  2742. list_t *b = bins->value;
  2743. GC_FREE(b->next->value);
  2744. GC_FREE(b->next);
  2745. GC_FREE(b->value);
  2746. GC_FREE(b);
  2747. GC_FREE(bins);
  2748. bins = tmp;
  2749. }
  2750. return value_new_array(r);
  2751. }
  2752. value_t *verb_tail(interpreter_t *state, verb_t *self, value_t *x) {
  2753. if (x->tag != ARRAY)
  2754. return x;
  2755. if (list_empty(x->val.array))
  2756. return state->udf;
  2757. return list_index(x->val.array, -1);
  2758. }
  2759. value_t *verb_cut(interpreter_t *state, verb_t *self, value_t *x, value_t *y) {
  2760. if (x->tag != ARRAY)
  2761. x = verb_enlist(state, self, x);
  2762. else if (list_empty(x->val.array))
  2763. return x;
  2764. if (y->tag != ARRAY)
  2765. y = verb_enlist(state, self, x);
  2766. else if (list_empty(y->val.array))
  2767. return x;
  2768. if (list_length(x->val.array) != 2)
  2769. return state->udf;
  2770. value_t *vs = x->val.array->value;
  2771. value_t *ve = x->val.array->next->value;
  2772. if (vs->tag != NUMBER || ve->tag != NUMBER)
  2773. return state->udf;
  2774. size_t s = fabs(vs->val.number);
  2775. size_t e = fabs(ve->val.number);
  2776. list_t *r = list_new();
  2777. size_t l = list_length(y->val.array);
  2778. list_t *pa = list_new();
  2779. for (size_t i = s; i < e && i < l; i++) {
  2780. value_t *v = list_index(y->val.array, i);
  2781. if (!v)
  2782. break;
  2783. list_push(pa, v);
  2784. }
  2785. list_t *pb = list_new();
  2786. for (size_t i = e; i < l; i++) {
  2787. value_t *v = list_index(y->val.array, i);
  2788. if (!v)
  2789. break;
  2790. list_push(pb, v);
  2791. }
  2792. list_push(r, value_new_array(pa));
  2793. list_push(r, value_new_array(pb));
  2794. return value_new_array(r);
  2795. }
  2796. value_t *verb_prefixes(interpreter_t *state, verb_t *self, value_t *x) {
  2797. if (x->tag != ARRAY)
  2798. x = verb_enlist(state, NULL, x);
  2799. list_t *r = list_new();
  2800. size_t i = 0;
  2801. list_t *t = x->val.array;
  2802. while (t) {
  2803. list_push(r, verb_take(state, NULL, value_new_number(i), x));
  2804. t = t->next;
  2805. i++;
  2806. }
  2807. list_push(r, x);
  2808. return value_new_array(r);
  2809. }
  2810. value_t *verb_behead(interpreter_t *state, verb_t *self, value_t *x) {
  2811. return verb_drop(state, NULL, NUMS[1], x);
  2812. }
  2813. value_t *verb_curtail(interpreter_t *state, verb_t *self, value_t *x) {
  2814. return verb_drop(state, NULL, NNUMS[0], x);
  2815. }
  2816. value_t *verb_suffixes(interpreter_t *state, verb_t *self, value_t *x) {
  2817. if (x->tag != ARRAY)
  2818. x = verb_enlist(state, NULL, x);
  2819. list_t *r = list_new();
  2820. size_t i = 0;
  2821. list_t *t = x->val.array;
  2822. while (t) {
  2823. list_push(r, verb_drop(state, NULL, value_new_number(i), x));
  2824. t = t->next;
  2825. i++;
  2826. }
  2827. list_push(r, state->unit);
  2828. return value_new_array(r);
  2829. }
  2830. value_t *verb_left(interpreter_t *state, verb_t *self, value_t *x, value_t *y) {
  2831. return x;
  2832. }
  2833. value_t *verb_same(interpreter_t *state, verb_t *self, value_t *x) { return x; }
  2834. value_t *verb_right(interpreter_t *state, verb_t *self, value_t *x,
  2835. value_t *y) {
  2836. return y;
  2837. }
  2838. value_t *verb_symbol(interpreter_t *state, verb_t *self, value_t *x) {
  2839. char *s = value_show(x);
  2840. return value_new_symbol(s);
  2841. }
  2842. value_t *verb_apply1(interpreter_t *state, verb_t *self, value_t *x,
  2843. value_t *y) {
  2844. return apply_monad(state, x, y);
  2845. }
  2846. value_t *verb_apply2(interpreter_t *state, verb_t *self, value_t *x,
  2847. value_t *y) {
  2848. if (y->tag != ARRAY || list_empty(y->val.array) || !y->val.array->next)
  2849. return state->udf;
  2850. return apply_dyad(state, x, y->val.array->value, y->val.array->next->value);
  2851. }
  2852. value_t *verb_shape(interpreter_t *state, verb_t *self, value_t *x) {
  2853. if (x->tag != ARRAY || list_empty(x->val.array))
  2854. return state->unit;
  2855. if (!is_arrays_array(x->val.array))
  2856. return verb_enlist(state, NULL, verb_count(state, NULL, x));
  2857. if (!x->val.array->next)
  2858. return verb_enlist(state, NULL,
  2859. verb_shape(state, NULL, x->val.array->value));
  2860. return verb_enpair(state, NULL, verb_count(state, NULL, x),
  2861. verb_count(state, NULL, x->val.array->value));
  2862. }
  2863. value_t *verb_reshape(interpreter_t *state, verb_t *self, value_t *x,
  2864. value_t *y) {
  2865. if (y->tag != ARRAY)
  2866. y = verb_enlist(state, NULL, y);
  2867. else if (list_empty(y->val.array))
  2868. return y;
  2869. if (x->tag != ARRAY)
  2870. x = verb_enlist(state, NULL, x);
  2871. else if (list_empty(x->val.array))
  2872. return state->unit;
  2873. list_t *r;
  2874. if (!x->val.array->next) {
  2875. value_t *a = x->val.array->value;
  2876. if (a->tag != NUMBER)
  2877. return state->udf;
  2878. size_t k = fabs(a->val.number);
  2879. list_t *t = list_new();
  2880. flatten(y, t);
  2881. r = list_new();
  2882. while (k) {
  2883. list_push(r, t->value);
  2884. if (t->next)
  2885. t = t->next;
  2886. k--;
  2887. }
  2888. } else if (x->val.array->next) {
  2889. value_t *a = x->val.array->value;
  2890. if (a->tag != NUMBER)
  2891. return state->udf;
  2892. value_t *b = x->val.array->next->value;
  2893. if (a->tag != NUMBER)
  2894. return state->udf;
  2895. size_t k = fabs(a->val.number);
  2896. size_t l = fabs(b->val.number);
  2897. y = verb_reshape(state, self, verb_enlist(state, NULL, value_new_number(k * l)), y);
  2898. list_t *t = y->val.array;
  2899. r = list_new();
  2900. while (k--) {
  2901. list_t *rw = list_new();
  2902. for (size_t i = 0; i < l; i++) {
  2903. list_push(rw, t->value);
  2904. t = t->next;
  2905. }
  2906. list_push(r, value_new_array(rw));
  2907. }
  2908. } else
  2909. return state->udf;
  2910. return value_new_array(r);
  2911. }
  2912. value_t *verb_repr(interpreter_t *state, verb_t *self, value_t *x) {
  2913. char *s = value_show(x);
  2914. list_t *r = list_new();
  2915. for (size_t i = 0; i < strlen(s); i++)
  2916. list_push(r, value_new_char(s[i]));
  2917. GC_FREE(s);
  2918. return value_new_array(r);
  2919. }
  2920. char *format(char *template, list_t *replaces) {
  2921. buffer_t *text = buffer_new();
  2922. bool skip = false;
  2923. size_t ri = 0;
  2924. size_t tl = strlen(template);
  2925. size_t rl = list_length(replaces);
  2926. for (size_t i = 0; i < tl; i++) {
  2927. char c = template[i];
  2928. if (skip) {
  2929. buffer_append(text, c);
  2930. skip = false;
  2931. continue;
  2932. }
  2933. if (c == '_') {
  2934. char *s = value_show(list_index(replaces, ri));
  2935. buffer_append_str(text, s);
  2936. GC_FREE(s);
  2937. if (ri < rl - 1)
  2938. ri++;
  2939. continue;
  2940. } else if (c == '{') {
  2941. size_t bi = i;
  2942. buffer_t *n = buffer_new();
  2943. i++;
  2944. while (i < tl && template[i] != '}')
  2945. buffer_append(n, template[i++]);
  2946. if (i >= tl || template[i] != '}') {
  2947. GC_FREE(buffer_read(n));
  2948. buffer_append(text, '{');
  2949. i = bi;
  2950. continue;
  2951. }
  2952. char *s = buffer_read(n);
  2953. ssize_t ind = atoi(s);
  2954. GC_FREE(s);
  2955. value_t *v = list_index(replaces, ind);
  2956. if (!v)
  2957. continue;
  2958. s = value_show(v);
  2959. buffer_append_str(text, s);
  2960. GC_FREE(s);
  2961. continue;
  2962. } else if (c == '~') {
  2963. skip = true;
  2964. continue;
  2965. }
  2966. buffer_append(text, c);
  2967. }
  2968. return buffer_read(text);
  2969. }
  2970. value_t *verb_format(interpreter_t *state, verb_t *self, value_t *x,
  2971. value_t *y) {
  2972. if (y->tag != ARRAY)
  2973. y = verb_enlist(state, NULL, x);
  2974. else if (list_empty(y->val.array))
  2975. return y;
  2976. char *fmt = value_show(x);
  2977. char *s = format(fmt, y->val.array);
  2978. GC_FREE(fmt);
  2979. list_t *r = list_new();
  2980. while (*s)
  2981. list_push(r, value_new_char(*s++));
  2982. return value_new_array(r);
  2983. }
  2984. value_t *verb_insert(interpreter_t *state, verb_t *self, value_t *x,
  2985. value_t *y) {
  2986. if (y->tag != ARRAY)
  2987. y = verb_enlist(state, NULL, y);
  2988. list_t *r = list_new();
  2989. list_t *t = y->val.array;
  2990. while (t) {
  2991. list_push(r, t->value);
  2992. if (t->next)
  2993. list_push(r, x);
  2994. t = t->next;
  2995. }
  2996. return value_new_array(r);
  2997. }
  2998. uint64_t fibonacci(uint64_t n) {
  2999. uint64_t a = 0;
  3000. uint64_t b = 1;
  3001. while (n-- > 1) {
  3002. uint64_t t = a;
  3003. a = b;
  3004. b += t;
  3005. }
  3006. return b;
  3007. }
  3008. value_t *verb_fibonacci(interpreter_t *state, verb_t *self, value_t *x) {
  3009. if (x->tag == NUMBER)
  3010. return value_new_number(fibonacci((uint64_t)fabs(x->val.number)));
  3011. return _NAN;
  3012. }
  3013. value_t *verb_iota(interpreter_t *state, verb_t *self, value_t *x) {
  3014. if (value_equals(x, NUMS[1]))
  3015. return verb_enlist(state, NULL, NUMS[1]);
  3016. else if (value_equals(x, NUMS[0]))
  3017. return state->unit;
  3018. return verb_range(state, self, NUMS[1], x);
  3019. }
  3020. value_t *verb_range(interpreter_t *state, verb_t *self, value_t *x,
  3021. value_t *y) {
  3022. if ((x->tag == NUMBER || x->tag == CHAR) &&
  3023. (y->tag == NUMBER || y->tag == CHAR)) {
  3024. if (x->tag == NUMBER && is_bad_num(x->val.number))
  3025. return state->udf;
  3026. if (y->tag == NUMBER && is_bad_num(y->val.number))
  3027. return state->udf;
  3028. ssize_t s = get_numeric(x);
  3029. ssize_t e = get_numeric(y);
  3030. if (s == e)
  3031. return verb_enlist(state, NULL, x);
  3032. list_t *r = list_new();
  3033. if (s > e)
  3034. for (ssize_t i = s; i >= e; i--) {
  3035. if (x->tag == CHAR || y->tag == CHAR)
  3036. list_push(r, value_new_char(i));
  3037. else
  3038. list_push(r, value_new_number(i));
  3039. }
  3040. else
  3041. for (ssize_t i = s; i <= e; i++) {
  3042. if (x->tag == CHAR || y->tag == CHAR)
  3043. list_push(r, value_new_char(i));
  3044. else
  3045. list_push(r, value_new_number(i));
  3046. }
  3047. return value_new_array(r);
  3048. }
  3049. return _NAN;
  3050. }
  3051. value_t *verb_deal(interpreter_t *state, verb_t *self, value_t *x) {
  3052. if (x->tag != ARRAY)
  3053. return x;
  3054. list_t *t = x->val.array;
  3055. if (list_empty(t))
  3056. return state->udf;
  3057. size_t i = rand() % list_length(t);
  3058. return list_index(t, i);
  3059. }
  3060. value_t *verb_roll(interpreter_t *state, verb_t *self, value_t *x, value_t *y) {
  3061. if (x->tag == NUMBER && y->tag == NUMBER) {
  3062. list_t *r = list_new();
  3063. size_t k = fabs(x->val.number);
  3064. size_t d = fabs(y->val.number);
  3065. for (size_t i = 0; i < k; i++)
  3066. list_push(r, value_new_number(rand() % d));
  3067. return value_new_array(r);
  3068. }
  3069. return state->udf;
  3070. }
  3071. value_t *verb_type(interpreter_t *state, verb_t *self, value_t *x) {
  3072. return NUMS[x->tag];
  3073. }
  3074. value_t *verb_cast(interpreter_t *state, verb_t *self, value_t *x, value_t *y) {
  3075. if (x->tag == NUMBER) {
  3076. int t = fabs(x->val.number);
  3077. if (y->tag == t)
  3078. return y;
  3079. switch (t) {
  3080. case ARRAY:
  3081. if (y->tag == SYMBOL) {
  3082. char *s = y->val.symbol;
  3083. list_t *r = list_new();
  3084. while (*s)
  3085. list_push(r, value_new_char(*s++));
  3086. return value_new_array(r);
  3087. }
  3088. break;
  3089. case NUMBER:
  3090. if (y->tag == CHAR)
  3091. return value_new_number(y->val._char);
  3092. else if (y->tag == ARRAY && is_char_array(y->val.array)) {
  3093. buffer_t *buf = buffer_new();
  3094. list_t *t = y->val.array;
  3095. while (t) {
  3096. buffer_append(buf, ((value_t *)t->value)->val._char);
  3097. t = t->next;
  3098. }
  3099. char *s = buffer_read(buf);
  3100. double r = strtod(s, NULL);
  3101. GC_FREE(s);
  3102. return value_new_number(r);
  3103. }
  3104. break;
  3105. case CHAR:
  3106. if (y->tag == NUMBER)
  3107. return value_new_char(y->val.number);
  3108. break;
  3109. }
  3110. }
  3111. return state->udf;
  3112. }
  3113. value_t *verb_print(interpreter_t *state, verb_t *self, value_t *x) {
  3114. char *s = value_show(x);
  3115. fprintf(stdout, "%s", s);
  3116. GC_FREE(s);
  3117. return state->nil;
  3118. }
  3119. value_t *verb_println(interpreter_t *state, verb_t *self, value_t *x) {
  3120. char *s = value_show(x);
  3121. fprintf(stdout, "%s\n", s);
  3122. GC_FREE(s);
  3123. return state->nil;
  3124. }
  3125. value_t *verb_exit(interpreter_t *state, verb_t *self, value_t *x) {
  3126. if (x->tag != NUMBER)
  3127. return state->udf;
  3128. int code = x->val.number;
  3129. exit(code);
  3130. return state->nil;
  3131. }
  3132. value_t *verb_read(interpreter_t *state, verb_t *self, value_t *x) {
  3133. if (x == NUMS[0]) {
  3134. buffer_t *buf = buffer_new();
  3135. size_t size = 0;
  3136. for (;;) {
  3137. int c = fgetc(stdin);
  3138. if (c < 0)
  3139. break;
  3140. buffer_append(buf, c); size++;
  3141. }
  3142. char *s = buffer_read(buf);
  3143. list_t *r = list_new();
  3144. for (size_t i = 0; i < size; i++)
  3145. list_push(r, value_new_char(s[i]));
  3146. GC_FREE(s);
  3147. return value_new_array(r);
  3148. }
  3149. else if (x == NUMS[1]) {
  3150. char line[512];
  3151. if (!fgets(line, sizeof(line), stdin))
  3152. return state->udf;
  3153. list_t *r = list_new();
  3154. for (size_t i = 0; i < strlen(line); i++)
  3155. list_push(r, value_new_char(line[i]));
  3156. return value_new_array(r);
  3157. }
  3158. char *path = value_show(x);
  3159. FILE *fd = fopen(path, "rb");
  3160. if (!fd) {
  3161. GC_FREE(path);
  3162. return state->udf;
  3163. }
  3164. fseek(fd, 0, SEEK_END);
  3165. size_t size = ftell(fd);
  3166. fseek(fd, 0, SEEK_SET);
  3167. unsigned char *buf = malloc_checked(size + 1);
  3168. if (!buf)
  3169. return state->udf;
  3170. size = fread(buf, sizeof(unsigned char), size, fd);
  3171. fclose(fd);
  3172. GC_FREE(path);
  3173. list_t *r = list_new();
  3174. for (size_t i = 0; i < size; i++)
  3175. list_push(r, value_new_char(buf[i]));
  3176. GC_FREE(buf);
  3177. return value_new_array(r);
  3178. }
  3179. value_t *verb_write(interpreter_t *state, verb_t *self, value_t *x,
  3180. value_t *y) {
  3181. FILE *fd;
  3182. char *path = NULL;
  3183. if (x->tag != ARRAY)
  3184. x = verb_enlist(state, NULL, x);
  3185. if (y == NUMS[0])
  3186. fd = stderr;
  3187. else {
  3188. path = value_show(y);
  3189. fd = fopen(path, "wb");
  3190. if (!fd) {
  3191. GC_FREE(path);
  3192. return NNUMS[0];
  3193. }
  3194. }
  3195. size_t k = 0;
  3196. list_t *t = x->val.array;
  3197. while (t) {
  3198. unsigned char c;
  3199. value_t *v = t->value;
  3200. if (v->tag == NUMBER)
  3201. c = fabs(v->val.number);
  3202. else if (v->tag == CHAR)
  3203. c = v->val._char;
  3204. else break;
  3205. fputc(c, fd);
  3206. t = t->next; k++;
  3207. }
  3208. fclose(fd);
  3209. if (path) GC_FREE(path);
  3210. return value_new_number(k);
  3211. }
  3212. value_t *verb_system(interpreter_t *state, verb_t *self, value_t *x) {
  3213. char *cmd = value_show(x);
  3214. FILE *pd;
  3215. pd = popen(cmd, "r");
  3216. if (!pd) {
  3217. GC_FREE(cmd);
  3218. return state->udf;
  3219. }
  3220. unsigned char *buffer = NULL;
  3221. size_t buffer_size = 0;
  3222. size_t buffer_allocated = 0;
  3223. size_t bytes_received;
  3224. unsigned char chunk[1024];
  3225. for (;;) {
  3226. bytes_received = fread(chunk, 1, 1024, pd);
  3227. if (bytes_received == 0)
  3228. break;
  3229. size_t head = buffer_size;
  3230. buffer_size += bytes_received;
  3231. if (buffer_size > buffer_allocated) {
  3232. buffer_allocated = buffer_size;
  3233. if (!buffer)
  3234. buffer = malloc_checked(buffer_allocated);
  3235. else
  3236. buffer = realloc_checked(buffer, buffer_allocated);
  3237. if (!buffer){
  3238. GC_FREE(cmd);
  3239. pclose(pd);
  3240. return state->udf;
  3241. }
  3242. }
  3243. for (size_t i = 0; i < bytes_received; i++)
  3244. buffer[head + i] = chunk[i];
  3245. if (feof(pd)) break;
  3246. }
  3247. pclose(pd);
  3248. GC_FREE(cmd);
  3249. list_t *r = list_new();
  3250. for (size_t i = 0; i < buffer_size; i++)
  3251. list_push(r, value_new_char(buffer[i]));
  3252. GC_FREE(buffer);
  3253. return value_new_array(r);
  3254. }
  3255. struct files_t {
  3256. FILE *in;
  3257. FILE *out;
  3258. };
  3259. typedef struct files_t files_t;
  3260. struct files_chain_t {
  3261. files_t files;
  3262. pid_t pid;
  3263. struct files_chain_t *next;
  3264. };
  3265. typedef struct files_chain_t files_chain_t;
  3266. static files_chain_t *files_chain;
  3267. void _cleanup_pipe(int *pipe) {
  3268. close(pipe[0]);
  3269. close(pipe[1]);
  3270. }
  3271. static int _do_popen2(files_chain_t *link, const char *command) {
  3272. int child_in[2];
  3273. int child_out[2];
  3274. if (0 != pipe(child_in))
  3275. return -1;
  3276. if (0 != pipe(child_out)) {
  3277. _cleanup_pipe(child_in);
  3278. return -1;
  3279. }
  3280. pid_t cpid = link->pid = fork();
  3281. if (0 > cpid) {
  3282. _cleanup_pipe(child_in);
  3283. _cleanup_pipe(child_out);
  3284. return -1;
  3285. }
  3286. if (0 == cpid) {
  3287. if (0 > dup2(child_in[0], 0) || 0 > dup2(child_out[1], 1))
  3288. _Exit(127);
  3289. _cleanup_pipe(child_in);
  3290. _cleanup_pipe(child_out);
  3291. for (files_chain_t *p = files_chain; p; p = p->next) {
  3292. int fd_in = fileno(p->files.in);
  3293. if (fd_in != 0)
  3294. close(fd_in);
  3295. int fd_out = fileno(p->files.out);
  3296. if (fd_out != 1)
  3297. close(fd_out);
  3298. }
  3299. execl("/bin/sh", "sh", "-c", command, (char *)NULL);
  3300. _Exit(127);
  3301. }
  3302. close(child_in[0]);
  3303. close(child_out[1]);
  3304. link->files.in = fdopen(child_in[1], "w");
  3305. link->files.out = fdopen(child_out[0], "r");
  3306. return 0;
  3307. }
  3308. files_t *popen2(const char *command) {
  3309. files_chain_t *link = (files_chain_t *) malloc(sizeof (files_chain_t));
  3310. if (NULL == link)
  3311. return NULL;
  3312. if (0 > _do_popen2(link, command)) {
  3313. free(link);
  3314. return NULL;
  3315. }
  3316. link->next = files_chain;
  3317. files_chain = link;
  3318. return (files_t *) link;
  3319. }
  3320. int pclose2(files_t *fp) {
  3321. files_chain_t **p = &files_chain;
  3322. int found = 0;
  3323. while (*p) {
  3324. if (*p == (files_chain_t *) fp) {
  3325. *p = (*p)->next;
  3326. found = 1;
  3327. break;
  3328. }
  3329. p = &(*p)->next;
  3330. }
  3331. if (!found)
  3332. return -1;
  3333. if (0 > fclose(fp->out)) {
  3334. free((files_chain_t *) fp);
  3335. return -1;
  3336. }
  3337. int status = -1;
  3338. pid_t wait_pid;
  3339. do {
  3340. wait_pid = waitpid(((files_chain_t *) fp)->pid, &status, 0);
  3341. } while (-1 == wait_pid && EINTR == errno);
  3342. free((files_chain_t *) fp);
  3343. if (wait_pid == -1)
  3344. return -1;
  3345. return status;
  3346. }
  3347. value_t *verb_system2(interpreter_t *state, verb_t *self, value_t *x, value_t *y) {
  3348. char *cmd = value_show(y);
  3349. files_t *pd;
  3350. pd = popen2(cmd);
  3351. if (pd == NULL) {
  3352. GC_FREE(cmd);
  3353. return state->udf;
  3354. }
  3355. list_t *t = x->val.array;
  3356. while (t) {
  3357. unsigned char c;
  3358. value_t *v = t->value;
  3359. if (v->tag == NUMBER)
  3360. c = fabs(v->val.number);
  3361. else if (v->tag == CHAR)
  3362. c = v->val._char;
  3363. else break;
  3364. fputc(c, pd->in);
  3365. t = t->next;
  3366. }
  3367. fflush(pd->in);
  3368. fclose(pd->in);
  3369. unsigned char *buffer = NULL;
  3370. size_t buffer_size = 0;
  3371. size_t buffer_allocated = 0;
  3372. size_t bytes_received;
  3373. unsigned char chunk[1024];
  3374. for (;;) {
  3375. bytes_received = fread(chunk, 1, 1024, pd->out);
  3376. if (bytes_received == 0)
  3377. break;
  3378. size_t head = buffer_size;
  3379. buffer_size += bytes_received;
  3380. if (buffer_size > buffer_allocated) {
  3381. buffer_allocated = buffer_size;
  3382. if (!buffer)
  3383. buffer = malloc_checked(buffer_allocated);
  3384. else
  3385. buffer = realloc_checked(buffer, buffer_allocated);
  3386. if (!buffer){
  3387. GC_FREE(cmd);
  3388. pclose2(pd);
  3389. return state->udf;
  3390. }
  3391. }
  3392. for (size_t i = 0; i < bytes_received; i++)
  3393. buffer[head + i] = chunk[i];
  3394. if (feof(pd->out)) break;
  3395. }
  3396. pclose2(pd);
  3397. GC_FREE(cmd);
  3398. list_t *r = list_new();
  3399. for (size_t i = 0; i < buffer_size; i++)
  3400. list_push(r, value_new_char(buffer[i]));
  3401. GC_FREE(buffer);
  3402. return value_new_array(r);
  3403. }
  3404. value_t *verb_shl(interpreter_t *state, verb_t *self, value_t *x, value_t *y) {
  3405. if (x->tag == NUMBER && y->tag == NUMBER)
  3406. return value_new_number(((int)x->val.number) << ((int)y->val.number));
  3407. return _NAN;
  3408. }
  3409. value_t *verb_shr(interpreter_t *state, verb_t *self, value_t *x, value_t *y) {
  3410. if (x->tag == NUMBER && y->tag == NUMBER)
  3411. return value_new_number(((int)x->val.number) >> ((int)y->val.number));
  3412. return _NAN;
  3413. }
  3414. value_t *verb_xor(interpreter_t *state, verb_t *self, value_t *x, value_t *y) {
  3415. if (x->tag == NUMBER && y->tag == NUMBER)
  3416. return value_new_number(((int)x->val.number) ^ ((int)y->val.number));
  3417. return _NAN;
  3418. }
  3419. value_t *verb_band(interpreter_t *state, verb_t *self, value_t *x, value_t *y) {
  3420. if (x->tag == NUMBER && y->tag == NUMBER)
  3421. return value_new_number(((int)x->val.number) & ((int)y->val.number));
  3422. return _NAN;
  3423. }
  3424. list_t *find_primes(uint64_t limit) {
  3425. bool sieve[limit + 1];
  3426. for (uint64_t i = 0; i <= limit; i++)
  3427. sieve[i] = false;
  3428. if (limit > 2)
  3429. sieve[2] = true;
  3430. if (limit > 3)
  3431. sieve[3] = true;
  3432. for (uint64_t x = 1; x * x <= limit; x++)
  3433. for (uint64_t y = 1; y * y <= limit; y++) {
  3434. uint64_t n = (4 * x * x) + (y * y);
  3435. if (n <= limit && (n % 12 == 1 || n % 12 == 5))
  3436. sieve[n] ^= true;
  3437. n = (3 * x * x) + (y * y);
  3438. if (n <= limit && n % 12 == 7)
  3439. sieve[n] ^= true;
  3440. n = (3 * x * x) - (y * y);
  3441. if (x > y && n <= limit && n % 12 == 11)
  3442. sieve[n] ^= true;
  3443. }
  3444. for (uint64_t r = 5; r * r <= limit; r++)
  3445. if (sieve[r])
  3446. for (int i = r * r; i <= limit; i += r * r)
  3447. sieve[i] = false;
  3448. list_t *r = list_new();
  3449. for (uint64_t a = 1; a <= limit; a++)
  3450. if (sieve[a])
  3451. list_push(r, value_new_number(a));
  3452. return r;
  3453. }
  3454. value_t *verb_primes(interpreter_t *state, verb_t *self, value_t *x) {
  3455. if (x->tag == NUMBER && !is_bad_num(x->val.number))
  3456. return value_new_array(find_primes(fabs(x->val.number) + 1));
  3457. return state->udf;
  3458. }
  3459. value_t *verb_parts(interpreter_t *state, verb_t *self, value_t *x, value_t *y) {
  3460. if (x->tag != NUMBER)
  3461. return state->udf;
  3462. if (y->tag != ARRAY)
  3463. y = verb_enlist(state, NULL, y);
  3464. else if (list_empty(y->val.array))
  3465. return y;
  3466. list_t *r = list_new();
  3467. size_t l = list_length(y->val.array);
  3468. size_t k = fabs(x->val.number);
  3469. while (y->tag == ARRAY && !list_empty(y->val.array)) {
  3470. list_push(r, verb_take(state, NULL, value_new_number(k), y));
  3471. y = verb_drop(state, NULL, value_new_number(k), y);
  3472. }
  3473. return value_new_array(r);
  3474. }
  3475. value_t *verb_bor(interpreter_t *state, verb_t *self, value_t *x, value_t *y) {
  3476. if (x->tag == NUMBER && y->tag == NUMBER)
  3477. return value_new_number(((int)x->val.number) | ((int)y->val.number));
  3478. return _NAN;
  3479. }
  3480. value_t *verb_bnot(interpreter_t *state, verb_t *self, value_t *x) {
  3481. if (x->tag == NUMBER)
  3482. return value_new_number(~(int)x->val.number);
  3483. return _NAN;
  3484. }
  3485. list_t *prime_factors(double n) {
  3486. list_t *factors = list_new();
  3487. double divisor = 2;
  3488. while (n >= 2) {
  3489. if (fmod(n, divisor) == 0) {
  3490. list_push(factors, value_new_number(divisor));
  3491. n /= divisor;
  3492. } else divisor++;
  3493. }
  3494. return factors;
  3495. }
  3496. value_t *verb_factors(interpreter_t *state, verb_t *self, value_t *x) {
  3497. if (x->tag == NUMBER && !is_bad_num(x->val.number))
  3498. return value_new_array(prime_factors(x->val.number));
  3499. return state->udf;
  3500. }
  3501. value_t *verb_combine(interpreter_t *state, verb_t *self, value_t *x,
  3502. value_t *y) {
  3503. if (x->tag == NUMBER && y->tag == NUMBER && !is_bad_num(x->val.number) && !is_bad_num(y->val.number)) {
  3504. value_t *n = verb_enpair(state, NULL, x, y);
  3505. return verb_unbase(state, NULL, NUMS[10], n);
  3506. }
  3507. return _NAN;
  3508. }
  3509. value_t *verb_outof(interpreter_t *state, verb_t *self, value_t *x,
  3510. value_t *y) {
  3511. if (x->tag == NUMBER && y->tag == NUMBER && !is_bad_num(x->val.number) && !is_bad_num(y->val.number) && x->val.number > 0 && y->val.number > 0) {
  3512. uint64_t a = (uint64_t)fabs(x->val.number);
  3513. uint64_t b = (uint64_t)fabs(y->val.number);
  3514. return value_new_number(factorial(b) / (factorial(a) * (a >= b? 1: factorial(b - a))));
  3515. }
  3516. return _NAN;
  3517. }
  3518. value_t *verb_sort(interpreter_t *state, verb_t *self, value_t *x) {
  3519. value_t *i = verb_gradeup(state, NULL, x);
  3520. return together(state, state->at, x, i, 0, 0, state->at->rank[1], state->at->rank[2]);
  3521. }
  3522. value_t *verb_unsort(interpreter_t *state, verb_t *self, value_t *x) {
  3523. value_t *i = verb_gradedown(state, NULL, x);
  3524. return together(state, state->at, x, i, 0, 0, state->at->rank[1], state->at->rank[2]);
  3525. }
  3526. value_t *interpreter_run(interpreter_t *state, char *program);
  3527. value_t *verb_eval(interpreter_t *state, verb_t *self, value_t *x) {
  3528. char *s = value_show(x);
  3529. jmp_buf *lb = guard();
  3530. if (setjmp(*lb)) {
  3531. unguard();
  3532. GC_FREE(s);
  3533. return state->udf;
  3534. }
  3535. value_t *v = interpreter_run(state, s);
  3536. GC_FREE(s);
  3537. unguard();
  3538. return v;
  3539. }
  3540. value_t *verb_import(interpreter_t *state, verb_t *self, value_t *x) {
  3541. char *path = value_show(x);
  3542. FILE *fd = fopen(path, "rb");
  3543. if (!fd) {
  3544. GC_FREE(path);
  3545. return state->udf;
  3546. }
  3547. fseek(fd, 0, SEEK_END);
  3548. size_t size = ftell(fd);
  3549. fseek(fd, 0, SEEK_SET);
  3550. unsigned char *buf = malloc_checked(size + 1);
  3551. if (!buf)
  3552. return state->udf;
  3553. size = fread(buf, sizeof(unsigned char), size, fd);
  3554. fclose(fd);
  3555. GC_FREE(path);
  3556. value_t *v = interpreter_run(state, (char *)buf);
  3557. GC_FREE(buf);
  3558. return v;
  3559. }
  3560. value_t *verb_explode(interpreter_t *state, verb_t *self, value_t *x,
  3561. value_t *y) {
  3562. char *del = value_show(x);
  3563. char *s = value_show(y);
  3564. size_t dell = strlen(del);
  3565. size_t sl = strlen(s);
  3566. list_t *r = list_new();
  3567. list_t *t = list_new();
  3568. for (size_t i = 0; i < sl; i++) {
  3569. if (strncmp(&s[i], del, dell) == 0) {
  3570. list_push(r, value_new_array(t));
  3571. t = list_new();
  3572. i += dell-1; continue;
  3573. }
  3574. list_push(t, CHARS[s[i]]);
  3575. }
  3576. GC_FREE(s);
  3577. GC_FREE(del);
  3578. list_push(r, value_new_array(t));
  3579. return value_new_array(r);
  3580. }
  3581. value_t *verb_implode(interpreter_t *state, verb_t *self, value_t *x,
  3582. value_t *y) {
  3583. if (y->tag != ARRAY || list_empty(y->val.array))
  3584. return y;
  3585. char *del = value_show(x);
  3586. list_t *r = list_new();
  3587. list_t *t = y->val.array;
  3588. while (t) {
  3589. char *s = value_show(t->value);
  3590. char *_s = s;
  3591. while (*_s)
  3592. list_push(r, CHARS[*_s++]);
  3593. GC_FREE(s);
  3594. if (t->next) {
  3595. char *s = del;
  3596. while (*s)
  3597. list_push(r, CHARS[*s++]);
  3598. }
  3599. t = t->next;
  3600. }
  3601. GC_FREE(del);
  3602. return value_new_array(r);
  3603. }
  3604. value_t *verb_eye(interpreter_t *state, verb_t *self, value_t *x) {
  3605. if (x->tag == NUMBER && !is_bad_num(x->val.number)) {
  3606. size_t k = fabs(x->val.number);
  3607. list_t *r = list_new();
  3608. for (size_t i = 0; i < k; i++) {
  3609. list_t *rw = list_new();
  3610. for (size_t j = 0; j < k; j++)
  3611. list_push(rw, NUMS[i == j]);
  3612. list_push(r, value_new_array(rw));
  3613. }
  3614. return value_new_array(r);
  3615. }
  3616. return state->udf;
  3617. }
  3618. value_t *verb_udf1(interpreter_t *state, verb_t *self, value_t *x) {
  3619. return state->udf;
  3620. }
  3621. value_t *verb_udf2(interpreter_t *state, verb_t *self, value_t *x, value_t *y) {
  3622. return state->udf;
  3623. }
  3624. #define X UINT_MAX
  3625. #define DEFVERB(__symb, __rm, __rl, __rr, __monad, __dyad) \
  3626. {__symb, {__rm, __rl, __rr}, NULL, false, false, verb_##__monad, verb_##__dyad}
  3627. #define DEFVERBD(__symb, __rm, __rl, __rr, __monad, __dyad) \
  3628. {__symb ".", {__rm, __rl, __rr}, NULL, false, false, verb_##__monad, verb_##__dyad}
  3629. #define DEFVERBC(__symb, __rm, __rl, __rr, __monad, __dyad) \
  3630. {__symb ":", {__rm, __rl, __rr}, NULL, false, false, verb_##__monad, verb_##__dyad}
  3631. verb_t VERBS[] = {
  3632. DEFVERB(":", 0, 0, 0, const, bind),
  3633. DEFVERBC(":", 0, 0, 0, udf1, obverse),
  3634. DEFVERB("+", 0, X, X, flip, plus),
  3635. DEFVERBD("+", X, X, X, fibonacci, gcd),
  3636. DEFVERBC("+", X, X, X, sin, combine),
  3637. DEFVERB("-", X, X, X, negate, minus),
  3638. DEFVERBD("-", X, X, X, atan, atan2),
  3639. DEFVERB("*", 0, X, X, first, times),
  3640. DEFVERBD("*", X, X, X, factorial, lcm),
  3641. DEFVERBC("*", X, X, 0, double, replicate),
  3642. DEFVERB("%", X, X, X, reciprocal, divide),
  3643. DEFVERBD("%", X, X, X, sqrt, root),
  3644. DEFVERBC("%", X, X, X, halve, idivide),
  3645. DEFVERB("!", X, X, X, enum, mod),
  3646. DEFVERBD("!", X, X, X, iota, range),
  3647. DEFVERBC("!", 0, X, 0, odometer, chunks),
  3648. DEFVERB("^", X, X, X, exp, power),
  3649. DEFVERBD("^", X, X, X, nlog, log),
  3650. DEFVERB("=", 0, X, X, permute, equals),
  3651. DEFVERBD("=", 0, 0, 0, occurences, mask),
  3652. DEFVERBC("=", 0, 0, 0, classify, equals),
  3653. DEFVERB("~", X, X, X, not, not_equals),
  3654. DEFVERBD("~", X, 0, 0, sign, insert),
  3655. DEFVERBC("~", 0, 0, 0, not, not_equals),
  3656. DEFVERB("<", X, X, X, pred, less),
  3657. DEFVERBD("<", X, X, X, floor, lesseq),
  3658. DEFVERBC("<", 0, X, 0, gradedown, nudge_left),
  3659. DEFVERB(">", X, X, X, succ, greater),
  3660. DEFVERBD(">", X, X, X, ceil, greatereq),
  3661. DEFVERBC(">", 0, X, 0, gradeup, nudge_right),
  3662. DEFVERB(",", 0, 0, 0, enlist, join),
  3663. DEFVERBD(",", X, 0, 0, enlist, enpair),
  3664. DEFVERB("#", 0, X, 0, count, take),
  3665. DEFVERBD("#", 0, 0, 0, where, copy),
  3666. DEFVERBC("#", 0, 0, 0, group, buckets),
  3667. DEFVERB("_", 0, X, 0, nub, drop),
  3668. DEFVERBD("_", 0, X, 0, unbits, unbase),
  3669. DEFVERBC("_", X, X, X, bits, base),
  3670. DEFVERB("?", 0, 0, 0, unique, find),
  3671. DEFVERB("&", 0, X, X, flatten, minand),
  3672. DEFVERB("|", 0, X, X, reverse, maxor),
  3673. DEFVERBD("|", X, X, 0, round, rotate),
  3674. DEFVERBC("|", 0, X, 0, depth, windows),
  3675. DEFVERB("@", X, 0, X, abs, at),
  3676. DEFVERBD("@", 0, 0, 0, shuffle, member),
  3677. DEFVERB("{", 0, 0, 0, head, bin),
  3678. DEFVERBD("{", 0, 0, 0, tail, cut),
  3679. DEFVERBC("{", 0, X, X, prefixes, shl),
  3680. DEFVERB("}", 0, X, X, behead, xor),
  3681. DEFVERBD("}", 0, 0, 0, curtail, band),
  3682. DEFVERBC("}", 0, X, X, suffixes, shr),
  3683. DEFVERB("[", X, 0, 0, factors, left),
  3684. DEFVERBD("[", X, X, X, bnot, bor),
  3685. DEFVERBC("[", X, X, 0, primes, parts),
  3686. DEFVERB("]", 0, 0, 0, same, right),
  3687. DEFVERBD("]", 0, X, X, sort, outof),
  3688. DEFVERBC("]", 0, 0, 0, unsort, explode),
  3689. DEFVERBD("`", 0, 0, 0, symbol, apply1),
  3690. DEFVERBC("`", 0, 0, 0, square, apply2),
  3691. DEFVERB("$", 0, 0, 0, shape, reshape),
  3692. DEFVERBD("$", 0, 0, 0, repr, format),
  3693. DEFVERBC("$", X, 0, 0, eye, implode),
  3694. DEFVERBD("p", 0, 0, 0, print, udf2),
  3695. DEFVERBD("P", 0, 0, 0, println, udf2),
  3696. DEFVERBD("f", 0, 0, 0, selfref1, selfref2),
  3697. DEFVERBD("F", 0, 0, 0, read, write),
  3698. DEFVERBD("r", 0, X, X, deal, roll),
  3699. DEFVERBD("t", 0, 0, 0, type, cast),
  3700. DEFVERBD("E", 0, 0, 0, exit, udf2),
  3701. DEFVERBD("y", 0, 0, 0, system, system2),
  3702. DEFVERBD("e", 0, 0, 0, eval, udf2),
  3703. DEFVERBD("i", 0, 0, 0, import, udf2)
  3704. };
  3705. value_t *_adverb_fold_monad(interpreter_t *state, verb_t *self, value_t *x) {
  3706. if (x->tag != ARRAY || list_empty(x->val.array))
  3707. return x;
  3708. value_t *_v = self->bonds->value;
  3709. if (_v->tag != VERB)
  3710. return state->udf;
  3711. verb_t *v = _v->val.verb;
  3712. value_t *t = x->val.array->value;
  3713. list_t *tx = x->val.array->next;
  3714. while (tx) {
  3715. t = together(state, v, t, tx->value, 0, 0, v->rank[1], v->rank[2]);
  3716. tx = tx->next;
  3717. }
  3718. return t;
  3719. }
  3720. value_t *_adverb_fold_dyad(interpreter_t *state, verb_t *self, value_t *x,
  3721. value_t *y) {
  3722. if (y->tag != ARRAY || list_empty(y->val.array))
  3723. return y;
  3724. value_t *_v = self->bonds->value;
  3725. if (_v->tag != VERB)
  3726. return state->udf;
  3727. verb_t *v = _v->val.verb;
  3728. value_t *t = x;
  3729. list_t *ty = y->val.array;
  3730. while (ty) {
  3731. t = together(state, v, t, ty->value, 0, 0, v->rank[1], v->rank[2]);
  3732. ty = ty->next;
  3733. }
  3734. return t;
  3735. }
  3736. value_t *_adverb_scan_monad(interpreter_t *state, verb_t *self, value_t *x) {
  3737. if (x->tag != ARRAY || list_empty(x->val.array))
  3738. return x;
  3739. value_t *_v = self->bonds->value;
  3740. if (_v->tag != VERB)
  3741. return state->udf;
  3742. verb_t *v = _v->val.verb;
  3743. list_t *r = list_new();
  3744. value_t *t = x->val.array->value;
  3745. list_t *tx = x->val.array->next;
  3746. list_push(r, t);
  3747. while (tx) {
  3748. t = together(state, v, t, tx->value, 0, 0, v->rank[1], v->rank[2]);
  3749. list_push(r, t);
  3750. tx = tx->next;
  3751. }
  3752. return value_new_array(r);
  3753. }
  3754. value_t *_adverb_scan_dyad(interpreter_t *state, verb_t *self, value_t *x,
  3755. value_t *y) {
  3756. if (y->tag != ARRAY || list_empty(y->val.array))
  3757. return y;
  3758. value_t *_v = self->bonds->value;
  3759. if (_v->tag != VERB)
  3760. return state->udf;
  3761. verb_t *v = _v->val.verb;
  3762. list_t *r = list_new();
  3763. value_t *t = x;
  3764. list_t *ty = y->val.array;
  3765. list_push(r, t);
  3766. while (ty) {
  3767. t = together(state, v, t, ty->value, 0, 0, v->rank[1], v->rank[2]);
  3768. list_push(r, t);
  3769. ty = ty->next;
  3770. }
  3771. return value_new_array(r);
  3772. }
  3773. value_t *_adverb_each_monad(interpreter_t *state, verb_t *self, value_t *x) {
  3774. value_t *_v = self->bonds->value;
  3775. if (_v->tag != VERB)
  3776. return state->udf;
  3777. verb_t *v = _v->val.verb;
  3778. if (x->tag != ARRAY)
  3779. return each_rank(state, v, x, 0, 1);
  3780. if (list_empty(x->val.array))
  3781. return x;
  3782. return each_rank(state, v, x, 0, 1);
  3783. }
  3784. value_t *_adverb_each_dyad(interpreter_t *state, verb_t *self, value_t *x,
  3785. value_t *y) {
  3786. value_t *_v = self->bonds->value;
  3787. if (_v->tag != VERB)
  3788. return state->udf;
  3789. verb_t *v = _v->val.verb;
  3790. if (x->tag != ARRAY)
  3791. x = verb_enlist(state, NULL, x);
  3792. if (y->tag != ARRAY)
  3793. y = verb_enlist(state, NULL, y);
  3794. list_t *r = list_new();
  3795. list_t *tx = x->val.array;
  3796. list_t *ty = y->val.array;
  3797. while (tx && ty) {
  3798. list_push(r, together(state, v, tx->value, ty->value, 0, 0, v->rank[1],
  3799. v->rank[2]));
  3800. tx = tx->next;
  3801. ty = ty->next;
  3802. }
  3803. return value_new_array(r);
  3804. }
  3805. value_t *_adverb_converge_monad(interpreter_t *state, verb_t *self,
  3806. value_t *x) {
  3807. value_t *_v = self->bonds->value;
  3808. if (_v->tag != VERB)
  3809. return state->udf;
  3810. verb_t *v = _v->val.verb;
  3811. value_t *t;
  3812. for (;;) {
  3813. t = x;
  3814. x = each_rank(state, v, x, 0, v->rank[0]);
  3815. if (value_equals(x, t))
  3816. break;
  3817. }
  3818. return x;
  3819. }
  3820. verb_t *conjunction_bond(interpreter_t *state, value_t *x, value_t *y);
  3821. value_t *_adverb_converge_dyad(interpreter_t *state, verb_t *self, value_t *x,
  3822. value_t *y) {
  3823. value_t *_v = self->bonds->value;
  3824. if (_v->tag != VERB)
  3825. return state->udf;
  3826. verb_t *v = _v->val.verb;
  3827. if (y->tag != ARRAY)
  3828. return together(state, v, y, x, 0, 0, v->rank[1], v->rank[2]);
  3829. if (list_empty(y->val.array))
  3830. return x;
  3831. v = conjunction_bond(state, value_new_verb(v), x);
  3832. return each_rank(state, v, y, 0, 1);
  3833. }
  3834. value_t *_adverb_converges_monad(interpreter_t *state, verb_t *self,
  3835. value_t *x) {
  3836. value_t *_v = self->bonds->value;
  3837. if (_v->tag != VERB)
  3838. return state->udf;
  3839. list_t *r = list_new();
  3840. value_t *t;
  3841. list_push(r, x);
  3842. for (;;) {
  3843. t = x;
  3844. x = apply_monad(state, _v, x);
  3845. if (value_equals(x, t))
  3846. break;
  3847. list_push(r, x);
  3848. }
  3849. return value_new_array(r);
  3850. }
  3851. value_t *_adverb_converges_dyad(interpreter_t *state, verb_t *self, value_t *x,
  3852. value_t *y) {
  3853. value_t *_v = self->bonds->value;
  3854. if (_v->tag != VERB)
  3855. return state->udf;
  3856. verb_t *v = _v->val.verb;
  3857. if (y->tag != ARRAY)
  3858. return together(state, v, y, x, 0, 0, v->rank[1], v->rank[2]);
  3859. if (list_empty(y->val.array))
  3860. return x;
  3861. v = conjunction_bond(state, x, value_new_verb(v));
  3862. return each_rank(state, v, y, 0, 1);
  3863. }
  3864. value_t *_adverb_eachprior_monad(interpreter_t *state, verb_t *self,
  3865. value_t *x) {
  3866. if (x->tag != ARRAY || list_empty(x->val.array) || !x->val.array->next)
  3867. return x;
  3868. value_t *_v = self->bonds->value;
  3869. if (_v->tag != VERB)
  3870. return state->udf;
  3871. verb_t *v = _v->val.verb;
  3872. list_t *r = list_new();
  3873. list_t *p = x->val.array;
  3874. list_t *t = x->val.array->next;
  3875. while (t) {
  3876. list_push(r, together(state, v, t->value, p->value, 0, 0, v->rank[1],
  3877. v->rank[2]));
  3878. p = t;
  3879. t = t->next;
  3880. }
  3881. return value_new_array(r);
  3882. }
  3883. value_t *_adverb_eachprior_dyad(interpreter_t *state, verb_t *self, value_t *x,
  3884. value_t *y) {
  3885. if (y->tag != ARRAY || list_empty(y->val.array))
  3886. return y;
  3887. value_t *_v = self->bonds->value;
  3888. if (_v->tag != VERB)
  3889. return state->udf;
  3890. verb_t *v = _v->val.verb;
  3891. list_t *r = list_new();
  3892. list_t *p = NULL;
  3893. list_t *t = y->val.array;
  3894. while (t) {
  3895. list_push(r, together(state, v, t->value, !p ? x : p->value, 0, 0,
  3896. v->rank[1], v->rank[2]));
  3897. p = t;
  3898. t = t->next;
  3899. }
  3900. return value_new_array(r);
  3901. }
  3902. value_t *_adverb_reflex_monad(interpreter_t *state, verb_t *self, value_t *x) {
  3903. value_t *_v = self->bonds->value;
  3904. if (_v->tag != VERB)
  3905. return state->udf;
  3906. verb_t *v = _v->val.verb;
  3907. return together(state, v, x, x, 0, 0, v->rank[1], v->rank[2]);
  3908. }
  3909. value_t *_adverb_reflex_dyad(interpreter_t *state, verb_t *self, value_t *x,
  3910. value_t *y) {
  3911. value_t *_v = self->bonds->value;
  3912. if (_v->tag != VERB)
  3913. return state->udf;
  3914. verb_t *v = _v->val.verb;
  3915. return together(state, v, y, x, 0, 0, v->rank[1], v->rank[2]);
  3916. }
  3917. value_t *_adverb_amend_monad(interpreter_t *state, verb_t *self, value_t *x) {
  3918. return state->udf;
  3919. }
  3920. value_t *_adverb_amend_dyad(interpreter_t *state, verb_t *self, value_t *x,
  3921. value_t *y) {
  3922. if (x->tag != ARRAY)
  3923. x = verb_enlist(state, NULL, x);
  3924. value_t *v = self->bonds->value;
  3925. if (v->tag != ARRAY)
  3926. v = verb_enlist(state, NULL, v);
  3927. if (y->tag != ARRAY)
  3928. y = verb_enlist(state, NULL, y);
  3929. list_t *r = list_copy(y->val.array);
  3930. size_t i = 0;
  3931. size_t l = list_length(x->val.array);
  3932. list_t *t = v->val.array;
  3933. while (t) {
  3934. value_t *n = t->value;
  3935. if (n->tag != NUMBER)
  3936. break;
  3937. list_set(r, n->val.number, list_index(x->val.array, i < l ? i : l - 1));
  3938. t = t->next;
  3939. i++;
  3940. }
  3941. return value_new_array(r);
  3942. }
  3943. value_t *_adverb_filter_monad(interpreter_t *state, verb_t *self, value_t *x) {
  3944. value_t *_v = self->bonds->value;
  3945. if (_v->tag != VERB)
  3946. return state->udf;
  3947. if (x->tag != ARRAY)
  3948. x = verb_enlist(state, NULL, x);
  3949. else if (list_empty(x->val.array))
  3950. return x;
  3951. verb_t *v = _v->val.verb;
  3952. list_t *r = list_new();
  3953. list_t *t = x->val.array;
  3954. while (t) {
  3955. value_t *b = each_rank(state, v, t->value, 0, v->rank[0]);
  3956. if (value_is_truthy(b))
  3957. list_push(r, t->value);
  3958. t = t->next;
  3959. }
  3960. return value_new_array(r);
  3961. }
  3962. value_t *_adverb_filter_dyad(interpreter_t *state, verb_t *self, value_t *x,
  3963. value_t *y) {
  3964. return state->udf;
  3965. }
  3966. value_t *_adverb_span_monad(interpreter_t *state, verb_t *self, value_t *x) {
  3967. value_t *v = self->bonds->value;
  3968. if (v->tag != VERB)
  3969. return state->udf;
  3970. if (x->tag != ARRAY)
  3971. x = verb_enlist(state, NULL, x);
  3972. else if (list_empty(x->val.array))
  3973. return x;
  3974. list_t *r = list_new();
  3975. list_t *t = x->val.array;
  3976. list_t *p = list_new();
  3977. while (t) {
  3978. value_t *b = apply_monad(state, v, t->value);
  3979. if (value_is_truthy(b)) {
  3980. list_push(r, value_new_array(p));
  3981. p = list_new();
  3982. } else list_push(p, t->value);
  3983. t = t->next;
  3984. }
  3985. list_push(r, value_new_array(p));
  3986. return value_new_array(r);
  3987. }
  3988. value_t *_adverb_span_dyad(interpreter_t *state, verb_t *self, value_t *x,
  3989. value_t *y) {
  3990. value_t *_v = self->bonds->value;
  3991. if (_v->tag != VERB)
  3992. return state->udf;
  3993. verb_t *v = _v->val.verb;
  3994. value_t *r = verb_windows(state, NULL, x, y);
  3995. return each_rank(state, v, r, 0, 1);
  3996. }
  3997. value_t *_adverb_inverse_monad(interpreter_t *state, verb_t *self, value_t *x) {
  3998. value_t *_v = self->bonds->value;
  3999. if (_v->tag != VERB)
  4000. return state->udf;
  4001. verb_t *v = _v->val.verb;
  4002. verb_t *iv = table_get(Inverses, v->name);
  4003. if (!iv)
  4004. return state->udf;
  4005. return each_rank(state, iv, x, 0, iv->rank[0]);
  4006. }
  4007. value_t *_adverb_inverse_dyad(interpreter_t *state, verb_t *self, value_t *x,
  4008. value_t *y) {
  4009. value_t *_v = self->bonds->value;
  4010. if (_v->tag != VERB)
  4011. return state->udf;
  4012. verb_t *v = _v->val.verb;
  4013. verb_t *iv = table_get(Inverses, v->name);
  4014. if (!iv)
  4015. return state->udf;
  4016. value_t *a = each_rank(state, iv, x, 0, iv->rank[0]);
  4017. value_t *b = each_rank(state, iv, y, 0, iv->rank[0]);
  4018. return apply_dyad(state, _v, a, b);
  4019. }
  4020. #define ADVERB(__name, __symb) \
  4021. verb_t *adverb_##__name(interpreter_t *state, value_t *v) { \
  4022. verb_t *nv = verb_new(); \
  4023. nv->bonds = list_new(); \
  4024. list_push(nv->bonds, v); \
  4025. char *r = value_show(v); \
  4026. size_t l = strlen(r) + strlen(__symb) + 1; \
  4027. nv->name = malloc_checked(l); \
  4028. snprintf(nv->name, l, "%s" __symb, r); \
  4029. GC_FREE(r); \
  4030. nv->rank[0] = 0; \
  4031. nv->monad = _adverb_##__name##_monad; \
  4032. nv->dyad = _adverb_##__name##_dyad; \
  4033. return nv; \
  4034. }
  4035. ADVERB(fold, "/");
  4036. ADVERB(converge, "/.");
  4037. ADVERB(scan, "\\");
  4038. ADVERB(converges, "\\.");
  4039. ADVERB(each, "\"");
  4040. ADVERB(eachprior, "\".");
  4041. ADVERB(reflex, ";.");
  4042. ADVERB(amend, "`");
  4043. ADVERB(filter, "&.");
  4044. ADVERB(span, "/:");
  4045. ADVERB(inverse, "-:");
  4046. adverb_t ADVERBS[] = {
  4047. {"/", adverb_fold, NULL}, {"/.", adverb_converge, NULL},
  4048. {"\\", adverb_scan, NULL}, {"\\.", adverb_converges, NULL},
  4049. {"\"", adverb_each, NULL}, {"\".", adverb_eachprior, NULL},
  4050. {";.", adverb_reflex, NULL}, {"`", adverb_amend, NULL},
  4051. {"&.", adverb_filter, NULL}, {"/:", adverb_span, NULL},
  4052. {"-:", adverb_inverse, NULL}};
  4053. value_t *_conjunction_bond_monad(interpreter_t *state, verb_t *self,
  4054. value_t *x) {
  4055. value_t *v1 = self->bonds->value;
  4056. value_t *v2 = self->bonds->next->value;
  4057. if (v1->tag == VERB && v2->tag == VERB)
  4058. return apply_monad(state, v1, apply_monad(state, v2, x));
  4059. else if (v1->tag == VERB)
  4060. return apply_dyad(state, v1, x, v2);
  4061. else if (v2->tag == VERB)
  4062. return apply_dyad(state, v2, v1, x);
  4063. else
  4064. return state->nil;
  4065. }
  4066. value_t *_conjunction_bond_dyad(interpreter_t *state, verb_t *self, value_t *x,
  4067. value_t *y) {
  4068. value_t *v1 = self->bonds->value;
  4069. value_t *v2 = self->bonds->next->value;
  4070. if (v1->tag == VERB && v2->tag == VERB)
  4071. return apply_monad(state, v1, apply_dyad(state, v2, x, y));
  4072. else if (v1->tag == VERB)
  4073. return apply_dyad(state, v1, apply_dyad(state, v1, x, y), v2);
  4074. else if (v2->tag == VERB)
  4075. return apply_dyad(state, v2, v1, apply_dyad(state, v2, x, y));
  4076. else
  4077. return state->nil;
  4078. }
  4079. value_t *_conjunction_pick_monad(interpreter_t *state, verb_t *self,
  4080. value_t *x) {
  4081. value_t *v1 = self->bonds->value;
  4082. value_t *v2 = self->bonds->next->value;
  4083. if (v1->tag != VERB || v2->tag != ARRAY)
  4084. return state->nil;
  4085. value_t *n = apply_monad(state, v1, x);
  4086. value_t *f = verb_at(state, NULL, v2, n);
  4087. return apply_monad(state, f, x);
  4088. }
  4089. value_t *_conjunction_pick_dyad(interpreter_t *state, verb_t *self, value_t *x,
  4090. value_t *y) {
  4091. value_t *v1 = self->bonds->value;
  4092. value_t *v2 = self->bonds->next->value;
  4093. if (v1->tag != VERB || v2->tag != ARRAY)
  4094. return state->nil;
  4095. value_t *n = apply_dyad(state, v1, x, y);
  4096. value_t *f = verb_at(state, NULL, v2, n);
  4097. return apply_dyad(state, f, x, y);
  4098. }
  4099. value_t *_conjunction_while_monad(interpreter_t *state, verb_t *self,
  4100. value_t *x) {
  4101. value_t *v1 = self->bonds->value;
  4102. value_t *v2 = self->bonds->next->value;
  4103. if (v1->tag == VERB) {
  4104. for (;;) {
  4105. if (!value_is_truthy(apply_monad(state, v1, x)))
  4106. break;
  4107. x = apply_monad(state, v2, x);
  4108. }
  4109. } else if (v1->tag == NUMBER) {
  4110. size_t k = (size_t)fabs(v1->val.number);
  4111. for (size_t i = 0; i < k; i++)
  4112. x = apply_monad(state, v2, x);
  4113. }
  4114. return x;
  4115. }
  4116. value_t *_conjunction_while_dyad(interpreter_t *state, verb_t *self, value_t *x,
  4117. value_t *y) {
  4118. value_t *v1 = self->bonds->value;
  4119. value_t *v2 = self->bonds->next->value;
  4120. if (v1->tag == VERB) {
  4121. for (;;) {
  4122. if (!value_is_truthy(apply_dyad(state, v1, x, y)))
  4123. break;
  4124. x = apply_dyad(state, v2, x, y);
  4125. }
  4126. } else if (v1->tag == NUMBER) {
  4127. size_t k = (size_t)fabs(v1->val.number);
  4128. for (size_t i = 0; i < k; i++)
  4129. x = apply_dyad(state, v2, x, y);
  4130. }
  4131. return x;
  4132. }
  4133. value_t *_conjunction_rank_monad(interpreter_t *state, verb_t *self,
  4134. value_t *x) {
  4135. value_t *v1 = self->bonds->value;
  4136. value_t *v2 = self->bonds->next->value;
  4137. if (v1->tag != VERB || v2->tag != NUMBER)
  4138. return state->udf;
  4139. unsigned int rank =
  4140. v2->val.number == INFINITY ? UINT_MAX : fabs(v2->val.number);
  4141. return each_rank(state, v1->val.verb, x, 0, rank);
  4142. }
  4143. value_t *_conjunction_rank_dyad(interpreter_t *state, verb_t *self, value_t *x,
  4144. value_t *y) {
  4145. value_t *v1 = self->bonds->value;
  4146. value_t *v2 = self->bonds->next->value;
  4147. if (v1->tag != VERB || v2->tag != NUMBER)
  4148. return state->udf;
  4149. unsigned int rank =
  4150. v2->val.number == INFINITY ? UINT_MAX : fabs(v2->val.number);
  4151. return together(state, v1->val.verb, x, y, 0, 0, rank, rank);
  4152. }
  4153. value_t *_conjunction_monaddyad_monad(interpreter_t *state, verb_t *self,
  4154. value_t *x) {
  4155. value_t *v = self->bonds->value;
  4156. if (v->tag != VERB)
  4157. return state->udf;
  4158. return each_rank(state, v->val.verb, x, 0, v->val.verb->rank[0]);
  4159. }
  4160. value_t *_conjunction_monaddyad_dyad(interpreter_t *state, verb_t *self,
  4161. value_t *x, value_t *y) {
  4162. value_t *v = self->bonds->next->value;
  4163. if (v->tag != VERB)
  4164. return state->udf;
  4165. return together(state, v->val.verb, x, y, 0, 0, v->val.verb->rank[1],
  4166. v->val.verb->rank[2]);
  4167. }
  4168. value_t *_conjunction_if_monad(interpreter_t *state, verb_t *self,
  4169. value_t *x) {
  4170. value_t *v1 = self->bonds->value;
  4171. value_t *v2 = self->bonds->next->value;
  4172. if (v1->tag != VERB || v2->tag != VERB)
  4173. return state->udf;
  4174. value_t *b = apply_monad(state, v2, x);
  4175. if (value_is_truthy(b))
  4176. return x;
  4177. return apply_monad(state, v1, x);
  4178. }
  4179. value_t *_conjunction_if_dyad(interpreter_t *state, verb_t *self,
  4180. value_t *x, value_t *y) {
  4181. value_t *v1 = self->bonds->value;
  4182. value_t *v2 = self->bonds->next->value;
  4183. if (v1->tag != VERB || v2->tag != VERB)
  4184. return state->udf;
  4185. value_t *b = apply_dyad(state, v2, x, y);
  4186. if (value_is_truthy(b))
  4187. return y;
  4188. return apply_dyad(state, v1, x, y);
  4189. }
  4190. value_t *_conjunction_under_monad(interpreter_t *state, verb_t *self,
  4191. value_t *x) {
  4192. value_t *v1 = self->bonds->value;
  4193. value_t *v2 = self->bonds->next->value;
  4194. if (v1->tag != VERB || v2->tag != VERB)
  4195. return state->udf;
  4196. verb_t *iv = table_get(Inverses, v2->val.verb->name);
  4197. if (!iv)
  4198. return state->udf;
  4199. value_t *v = apply_monad(state, v2, x);
  4200. v = apply_monad(state, v1, v);
  4201. return each_rank(state, iv, v, 0, iv->rank[0]);
  4202. }
  4203. value_t *_conjunction_under_dyad(interpreter_t *state, verb_t *self,
  4204. value_t *x, value_t *y) {
  4205. value_t *v1 = self->bonds->value;
  4206. value_t *v2 = self->bonds->next->value;
  4207. if (v1->tag != VERB || v2->tag != VERB)
  4208. return state->udf;
  4209. verb_t *iv = table_get(Inverses, v2->val.verb->name);
  4210. if (!iv)
  4211. return state->udf;
  4212. value_t *a = apply_monad(state, v2, x);
  4213. value_t *b = apply_monad(state, v2, y);
  4214. value_t *v = apply_dyad(state, v1, a, b);
  4215. return each_rank(state, iv, v, 0, iv->rank[0]);
  4216. }
  4217. #define CONJUNCTION(__name, __symb) \
  4218. verb_t *conjunction_##__name(interpreter_t *state, value_t *x, value_t *y) { \
  4219. verb_t *nv = verb_new(); \
  4220. nv->bonds = list_new(); \
  4221. list_push(nv->bonds, x); \
  4222. list_push(nv->bonds, y); \
  4223. char *rx = value_show(x); \
  4224. char *ry = value_show(y); \
  4225. size_t l = strlen(rx) + strlen(ry) + strlen(__symb) + 1; \
  4226. nv->name = malloc_checked(l); \
  4227. snprintf(nv->name, l, "%s" __symb "%s", rx, ry); \
  4228. GC_FREE(rx); \
  4229. GC_FREE(ry); \
  4230. nv->rank[0] = 0; \
  4231. nv->rank[1] = 0; \
  4232. nv->rank[1] = 0; \
  4233. nv->monad = _conjunction_##__name##_monad; \
  4234. nv->dyad = _conjunction_##__name##_dyad; \
  4235. return nv; \
  4236. }
  4237. CONJUNCTION(bond, ";");
  4238. CONJUNCTION(pick, "?.");
  4239. CONJUNCTION(while, "?:");
  4240. CONJUNCTION(rank, "\":");
  4241. CONJUNCTION(monaddyad, ";:");
  4242. CONJUNCTION(if, "&:");
  4243. CONJUNCTION(under, "^:");
  4244. adverb_t CONJUNCTIONS[] = {{";", NULL, conjunction_bond},
  4245. {"?.", NULL, conjunction_pick},
  4246. {"?:", NULL, conjunction_while},
  4247. {"\":", NULL, conjunction_rank},
  4248. {";:", NULL, conjunction_monaddyad},
  4249. {"&:", NULL, conjunction_if},
  4250. {"^:", NULL, conjunction_under}};
  4251. #define countof(x) (sizeof(x) / sizeof((x)[0]))
  4252. #define FINDER(kind, rname, table) \
  4253. kind *find_##rname (char *s) { \
  4254. for (size_t i = 0; i < countof(table); i++) { \
  4255. if (strcmp(table[i].name, s) == 0) \
  4256. return &table[i]; \
  4257. } \
  4258. return NULL; \
  4259. }
  4260. FINDER(verb_t, verb, VERBS);
  4261. FINDER(adverb_t, adverb, ADVERBS);
  4262. FINDER(adverb_t, conjunction, CONJUNCTIONS);
  4263. node_t *node_new(enum node_tag_t tag) {
  4264. node_t *node = malloc_checked(sizeof(node_t));
  4265. node->tag = tag;
  4266. return node;
  4267. }
  4268. node_t *node_new_strand(list_t *l) {
  4269. node_t *node = malloc_checked(sizeof(node_t));
  4270. node->tag = N_STRAND;
  4271. node->l = l;
  4272. return node;
  4273. }
  4274. node_t *node_new_literal(value_t *v) {
  4275. node_t *node = malloc_checked(sizeof(node_t));
  4276. node->tag = N_LITERAL;
  4277. node->v = v;
  4278. return node;
  4279. }
  4280. node_t *node_new1(enum node_tag_t tag, node_t *a) {
  4281. node_t *node = malloc_checked(sizeof(node_t));
  4282. node->tag = tag;
  4283. node->a = a;
  4284. return node;
  4285. }
  4286. node_t *node_new2(enum node_tag_t tag, node_t *a, node_t *b) {
  4287. node_t *node = malloc_checked(sizeof(node_t));
  4288. node->tag = tag;
  4289. node->a = a;
  4290. node->b = b;
  4291. return node;
  4292. }
  4293. node_t *node_new3(enum node_tag_t tag, node_t *a, node_t *b, node_t *c) {
  4294. node_t *node = malloc_checked(sizeof(node_t));
  4295. node->tag = tag;
  4296. node->a = a;
  4297. node->b = b;
  4298. node->c = c;
  4299. return node;
  4300. }
  4301. typedef struct {
  4302. lexer_t *lexer;
  4303. interpreter_t *state;
  4304. size_t pos;
  4305. size_t end;
  4306. } parser_t;
  4307. parser_t *parser_new(interpreter_t *state) {
  4308. parser_t *parser = malloc_checked(sizeof(parser_t));
  4309. parser->state = state;
  4310. return parser;
  4311. }
  4312. void parser_error(parser_t *parser, char *s) { fatal(s); }
  4313. bool parser_done(parser_t *parser) { return parser->pos >= parser->end; }
  4314. token_t *parser_lookahead(parser_t *parser, size_t offset) {
  4315. size_t pos = parser->pos + offset;
  4316. if (pos >= parser->end)
  4317. return NULL;
  4318. return list_index(parser->lexer->tokens, pos);
  4319. }
  4320. bool parser_stop(parser_t *parser) {
  4321. token_t *tok = parser_lookahead(parser, 0);
  4322. if (!tok)
  4323. return true;
  4324. return tok->tag == T_RPAR;
  4325. }
  4326. void parser_eat(parser_t *parser) {
  4327. if (!parser_done(parser))
  4328. parser->pos++;
  4329. }
  4330. node_t *parser_parse_expr(parser_t *parser);
  4331. node_t *parser_parse_verb(parser_t *parser) {
  4332. token_t *tok = parser_lookahead(parser, 0);
  4333. if (!tok || tok->tag != T_PUNCT)
  4334. return NULL;
  4335. verb_t *verb = find_verb(tok->text);
  4336. if (!verb)
  4337. return NULL;
  4338. return node_new_literal(value_new_verb(verb));
  4339. }
  4340. value_t *_adverb_wrapper_monad(interpreter_t *state, verb_t *self, value_t *x) {
  4341. adverb_t *av = self->bonds->value;
  4342. if (x->tag != VERB)
  4343. return state->nil;
  4344. return value_new_verb(av->adverb(state, x));
  4345. }
  4346. value_t *_adverb_wrapper_dyad(interpreter_t *state, verb_t *self, value_t *x,
  4347. value_t *y) {
  4348. adverb_t *av = self->bonds->value;
  4349. if (x->tag != VERB)
  4350. return state->nil;
  4351. verb_t *v = av->adverb(state, x);
  4352. return each_rank(state, v, y, 0, v->rank[0]);
  4353. }
  4354. node_t *parser_parse_adverb_atom(parser_t *parser) {
  4355. token_t *tok = parser_lookahead(parser, 0);
  4356. if (!tok || tok->tag != T_PUNCT)
  4357. return NULL;
  4358. adverb_t *adverb = find_adverb(tok->text);
  4359. if (!adverb)
  4360. return NULL;
  4361. verb_t *nv = verb_new();
  4362. nv->name = strdup_checked(tok->text);
  4363. nv->bonds = list_new();
  4364. list_push(nv->bonds, adverb);
  4365. nv->rank[0] = 0;
  4366. nv->rank[1] = 0;
  4367. nv->rank[2] = 0;
  4368. nv->monad = _adverb_wrapper_monad;
  4369. nv->dyad = _adverb_wrapper_dyad;
  4370. return node_new_literal(value_new_verb(nv));
  4371. }
  4372. value_t *_conjunction_wrapper_dyad(interpreter_t *state, verb_t *self,
  4373. value_t *x, value_t *y) {
  4374. adverb_t *av = self->bonds->value;
  4375. return value_new_verb(av->conjunction(state, x, y));
  4376. }
  4377. node_t *parser_parse_conjunction_atom(parser_t *parser) {
  4378. token_t *tok = parser_lookahead(parser, 0);
  4379. if (!tok || tok->tag != T_PUNCT)
  4380. return NULL;
  4381. adverb_t *adverb = find_conjunction(tok->text);
  4382. if (!adverb)
  4383. return NULL;
  4384. verb_t *nv = verb_new();
  4385. nv->name = strdup_checked(tok->text);
  4386. nv->bonds = list_new();
  4387. list_push(nv->bonds, adverb);
  4388. nv->rank[0] = 0;
  4389. nv->rank[1] = 0;
  4390. nv->rank[2] = 0;
  4391. nv->monad = NULL;
  4392. nv->dyad = _conjunction_wrapper_dyad;
  4393. return node_new_literal(value_new_verb(nv));
  4394. }
  4395. node_t *parser_parse_atom(parser_t *parser) {
  4396. token_t *tok = parser_lookahead(parser, 0);
  4397. node_t *node = NULL;
  4398. switch (tok->tag) {
  4399. case T_RPAR:
  4400. parser_error(parser, "unmatched");
  4401. case T_LPAR:
  4402. parser_eat(parser);
  4403. tok = parser_lookahead(parser, 0);
  4404. if (tok && tok->tag == T_RPAR) {
  4405. node = node_new_literal(parser->state->unit);
  4406. break;
  4407. }
  4408. node = parser_parse_expr(parser);
  4409. tok = parser_lookahead(parser, 0);
  4410. if (!tok || tok->tag != T_RPAR)
  4411. parser_error(parser, "unmatched");
  4412. break;
  4413. case T_PUNCT:
  4414. node = parser_parse_verb(parser);
  4415. if (!node)
  4416. node = parser_parse_adverb_atom(parser);
  4417. if (!node)
  4418. node = parser_parse_conjunction_atom(parser);
  4419. if (!node)
  4420. parser_error(parser, "parse");
  4421. break;
  4422. case T_NUMBER:
  4423. node = node_new_literal(value_new_number(strtod(tok->text, NULL)));
  4424. break;
  4425. case T_NAME:
  4426. node = node_new_literal(value_new_symbol(strdup_checked(tok->text)));
  4427. break;
  4428. case T_QUOTE:
  4429. if (!*tok->text)
  4430. node = node_new_literal(parser->state->unit);
  4431. else if (!*(tok->text + 1))
  4432. node = node_new_literal(value_new_char(tok->text[0]));
  4433. else {
  4434. list_t *list = list_new();
  4435. for (size_t i = 0; i < strlen(tok->text); i++)
  4436. list_push(list, value_new_char(tok->text[i]));
  4437. node = node_new_literal(value_new_array(list));
  4438. }
  4439. break;
  4440. }
  4441. if (!node)
  4442. parser_error(parser, "parse");
  4443. parser_eat(parser);
  4444. return node;
  4445. }
  4446. node_t *parser_parse_sequence(parser_t *parser, node_t *a,
  4447. enum token_tag_t tag) {
  4448. token_t *tok;
  4449. if ((tok = parser_lookahead(parser, 0)) && tok->tag == tag) {
  4450. list_t *as = list_new();
  4451. list_push(as, a->v);
  4452. do {
  4453. a = parser_parse_atom(parser);
  4454. list_push(as, a->v);
  4455. } while ((tok = parser_lookahead(parser, 0)) && tok->tag == tag);
  4456. return node_new_literal(value_new_array(as));
  4457. }
  4458. return NULL;
  4459. }
  4460. node_t *_parser_parse_noun(parser_t *parser) {
  4461. node_t *n;
  4462. node_t *a = parser_parse_atom(parser);
  4463. if (a->tag == N_LITERAL && a->v->tag == NUMBER &&
  4464. (n = parser_parse_sequence(parser, a, T_NUMBER)))
  4465. return n;
  4466. else if (a->tag == N_LITERAL && a->v->tag == SYMBOL &&
  4467. (n = parser_parse_sequence(parser, a, T_NAME)))
  4468. return n;
  4469. else if (a->tag == N_LITERAL && a->v->tag == ARRAY &&
  4470. is_char_array(a->v->val.array) &&
  4471. (n = parser_parse_sequence(parser, a, T_QUOTE)))
  4472. return n;
  4473. return a;
  4474. }
  4475. node_t *parser_parse_noun(parser_t *parser, bool flat) {
  4476. node_t *a = flat ? parser_parse_atom(parser) : _parser_parse_noun(parser);
  4477. token_t *tok;
  4478. if ((tok = parser_lookahead(parser, 0)) && tok->tag == T_PUNCT &&
  4479. strcmp(tok->text, ",:") == 0) {
  4480. parser_eat(parser);
  4481. list_t *l = list_new();
  4482. list_push(l, a);
  4483. for (;;) {
  4484. a = flat ? parser_parse_atom(parser) : _parser_parse_noun(parser);
  4485. list_push(l, a);
  4486. if (!((tok = parser_lookahead(parser, 0)) && tok->tag == T_PUNCT &&
  4487. strcmp(tok->text, ",:") == 0))
  4488. break;
  4489. parser_eat(parser);
  4490. }
  4491. return node_new_strand(l);
  4492. }
  4493. return a;
  4494. }
  4495. bool parser_node_is_verbal(parser_t *parser, node_t *n) {
  4496. value_t *v;
  4497. if (n->tag == N_FUN)
  4498. return true;
  4499. else if (n->tag == N_ADV || n->tag == N_CONJ || n->tag == N_PARTIAL_CONJ)
  4500. return true;
  4501. else if (n->tag == N_FORK || n->tag == N_HOOK || n->tag == N_BOND ||
  4502. n->tag == N_OVER)
  4503. return true;
  4504. else if (n->tag == N_LITERAL && n->v->tag == VERB)
  4505. return true;
  4506. else if (n->tag == N_LITERAL && n->v->tag == SYMBOL &&
  4507. (v = table_get(parser->state->env, n->v->val.symbol)) &&
  4508. v->tag == VERB)
  4509. return true;
  4510. return false;
  4511. }
  4512. node_t *parser_parse_adverb(parser_t *parser, node_t *v, bool *flag) {
  4513. token_t *tok;
  4514. adverb_t *adv;
  4515. node_t *t;
  4516. for (;;) {
  4517. tok = parser_lookahead(parser, 0);
  4518. if (!tok || tok->tag != T_PUNCT)
  4519. break;
  4520. if ((adv = find_adverb(tok->text))) {
  4521. if (flag)
  4522. *flag = true;
  4523. parser_eat(parser);
  4524. t = node_new(N_ADV);
  4525. t->av = adv;
  4526. t->a = v;
  4527. v = t;
  4528. } else
  4529. break;
  4530. }
  4531. return v;
  4532. }
  4533. node_t *parser_parse_conjunction(parser_t *parser, node_t *v, bool *flag) {
  4534. token_t *tok;
  4535. adverb_t *adv;
  4536. node_t *t;
  4537. for (;;) {
  4538. tok = parser_lookahead(parser, 0);
  4539. if (!tok || tok->tag != T_PUNCT)
  4540. break;
  4541. if ((adv = find_conjunction(tok->text))) {
  4542. if (flag)
  4543. *flag = true;
  4544. parser_eat(parser);
  4545. if (parser_stop(parser)) {
  4546. t = node_new(N_PARTIAL_CONJ);
  4547. t->av = adv;
  4548. t->a = v;
  4549. } else {
  4550. t = node_new(N_CONJ);
  4551. t->av = adv;
  4552. t->a = v;
  4553. t->b = parser_parse_noun(parser, true);
  4554. }
  4555. v = t;
  4556. } else
  4557. break;
  4558. }
  4559. return v;
  4560. }
  4561. bool is_apply(node_t *n) {
  4562. return n->tag == N_LITERAL && n->v->tag == VERB &&
  4563. (strcmp(n->v->val.verb->name, "`.") == 0 ||
  4564. strcmp(n->v->val.verb->name, "`:") == 0);
  4565. }
  4566. bool is_obverse(node_t *n) {
  4567. return n->tag == N_LITERAL && n->v->tag == VERB && strcmp(n->v->val.verb->name, "::") == 0;
  4568. }
  4569. node_t *parser_parse_expr(parser_t *parser) {
  4570. token_t *tmp;
  4571. list_t *ns = list_new();
  4572. while (!parser_stop(parser)) {
  4573. if (list_empty(ns) && (tmp = parser_lookahead(parser, 0)) &&
  4574. tmp->tag == T_PUNCT && strcmp(tmp->text, ":") == 0 &&
  4575. (parser_lookahead(parser, 1))) {
  4576. parser_eat(parser);
  4577. return node_new1(N_FUN, parser_parse_expr(parser));
  4578. }
  4579. node_t *n = parser_parse_noun(parser, false);
  4580. if (list_empty(ns) && n->tag == N_LITERAL && n->v->tag == SYMBOL &&
  4581. (tmp = parser_lookahead(parser, 0)) && tmp->tag == T_PUNCT &&
  4582. strcmp(tmp->text, ":") == 0) {
  4583. parser_eat(parser);
  4584. return node_new2(N_BIND, n, parser_parse_expr(parser));
  4585. }
  4586. for (;;) {
  4587. bool flag = false;
  4588. n = parser_parse_adverb(parser, n, &flag);
  4589. n = parser_parse_conjunction(parser, n, &flag);
  4590. if (!flag)
  4591. break;
  4592. }
  4593. list_push(ns, n);
  4594. }
  4595. size_t len;
  4596. node_t *l, *m, *r;
  4597. for (;;) {
  4598. len = list_length(ns);
  4599. if (len < 2)
  4600. break;
  4601. if (len >= 3 && is_apply(list_index(ns, -2)) || is_obverse(list_index(ns, -2))) {
  4602. r = list_pop(ns);
  4603. m = list_pop(ns);
  4604. l = list_pop(ns);
  4605. list_push(ns, node_new3(N_DYAD, m, l, r));
  4606. } else if (len >= 3 && !parser_node_is_verbal(parser, list_index(ns, -1)) &&
  4607. parser_node_is_verbal(parser, list_index(ns, -2)) &&
  4608. !parser_node_is_verbal(parser, list_index(ns, -3))) {
  4609. r = list_pop(ns);
  4610. m = list_pop(ns);
  4611. l = list_pop(ns);
  4612. list_push(ns, node_new3(N_DYAD, m, l, r));
  4613. } else if (len >= 3 && parser_node_is_verbal(parser, list_index(ns, -1)) &&
  4614. parser_node_is_verbal(parser, list_index(ns, -2)) &&
  4615. parser_node_is_verbal(parser, list_index(ns, -3))) {
  4616. r = list_pop(ns);
  4617. m = list_pop(ns);
  4618. l = list_pop(ns);
  4619. list_push(ns, node_new3(N_FORK, l, m, r));
  4620. } else if (len >= 3 && parser_node_is_verbal(parser, list_index(ns, -1)) &&
  4621. parser_node_is_verbal(parser, list_index(ns, -2)) &&
  4622. !parser_node_is_verbal(parser, list_index(ns, -3))) {
  4623. r = list_pop(ns);
  4624. m = list_pop(ns);
  4625. l = list_pop(ns);
  4626. list_push(ns, node_new3(N_OVER, l, m, r));
  4627. } else if (len >= 2 && is_apply(list_index(ns, -1))) {
  4628. r = list_pop(ns);
  4629. l = list_pop(ns);
  4630. list_push(ns, node_new2(N_BOND, r, l));
  4631. } else if (len >= 2 && !parser_node_is_verbal(parser, list_index(ns, -1)) &&
  4632. parser_node_is_verbal(parser, list_index(ns, -2))) {
  4633. r = list_pop(ns);
  4634. l = list_pop(ns);
  4635. list_push(ns, node_new2(N_MONAD, l, r));
  4636. } else if (len >= 2 && parser_node_is_verbal(parser, list_index(ns, -1)) &&
  4637. parser_node_is_verbal(parser, list_index(ns, -2))) {
  4638. r = list_pop(ns);
  4639. l = list_pop(ns);
  4640. list_push(ns, node_new2(N_HOOK, l, r));
  4641. } else if (len >= 2 && parser_node_is_verbal(parser, list_index(ns, -1)) &&
  4642. !parser_node_is_verbal(parser, list_index(ns, -2))) {
  4643. r = list_pop(ns);
  4644. l = list_pop(ns);
  4645. list_push(ns, node_new2(N_BOND, r, l));
  4646. } else if (len >= 3) {
  4647. r = list_pop(ns);
  4648. m = list_pop(ns);
  4649. l = list_pop(ns);
  4650. list_push(ns, node_new3(N_INDEX2, m, l, r));
  4651. } else if (len >= 2) {
  4652. r = list_pop(ns);
  4653. l = list_pop(ns);
  4654. list_push(ns, node_new2(N_INDEX1, l, r));
  4655. }
  4656. }
  4657. return ns->value;
  4658. }
  4659. node_t *parser_parse(parser_t *parser, lexer_t *lexer) {
  4660. parser->lexer = lexer;
  4661. parser->pos = 0;
  4662. parser->end = list_length(parser->lexer->tokens);
  4663. node_t *node = parser_parse_expr(parser);
  4664. if (!parser_done(parser)) {
  4665. token_t *tok = parser_lookahead(parser, 0);
  4666. if (tok && tok->tag == T_RPAR)
  4667. parser_error(parser, "unmatched");
  4668. parser_error(parser, "parse");
  4669. }
  4670. return node;
  4671. }
  4672. value_t *interpreter_run(interpreter_t *state, char *program) {
  4673. lexer_t *lexer = lexer_new();
  4674. lexer_lex(lexer, program);
  4675. parser_t *parser = parser_new(state);
  4676. node_t *node = parser_parse(parser, lexer);
  4677. list_t *t = lexer->tokens;
  4678. if (t->value)
  4679. while (t) {
  4680. list_t *tmp = t->next;
  4681. token_t *tok = t->value;
  4682. if (tok->text)
  4683. GC_FREE(tok->text);
  4684. GC_FREE(tok);
  4685. GC_FREE(t);
  4686. t = tmp;
  4687. }
  4688. value_t *r = interpreter_walk(state, node);
  4689. GC_FREE(parser);
  4690. return r;
  4691. }
  4692. #include "help.h"
  4693. const char *VSTR = VER " " __DATE__;
  4694. int main(int argc, char **argv) {
  4695. GC_INIT();
  4696. GC_enable_incremental();
  4697. guards = list_new();
  4698. is_interactive = isatty(0);
  4699. HASH_SEED = time(NULL);
  4700. srand(HASH_SEED);
  4701. VCACHE = table_new();
  4702. SCACHE = table_new();
  4703. for (size_t i = 0; i < countof(VERBS); i++) {
  4704. value_t *v = value_new_const(VERB);
  4705. v->val.verb = &VERBS[i];
  4706. table_set(VCACHE, VERBS[i].name, v);
  4707. }
  4708. _UNIT = value_new(ARRAY);
  4709. _UNIT->val.array = list_new();
  4710. interpreter_t *state = interpreter_new();
  4711. for (int i = 1; i <= 8; i++) {
  4712. NNUMS[i - 1] = value_new_const(NUMBER);
  4713. NNUMS[i - 1]->val.number = -i;
  4714. }
  4715. for (int i = 0; i < 256; i++) {
  4716. NUMS[i] = value_new_const(NUMBER);
  4717. NUMS[i]->val.number = i;
  4718. }
  4719. for (int i = 0; i < 256; i++) {
  4720. CHARS[i] = value_new_const(CHAR);
  4721. CHARS[i]->val._char = i;
  4722. }
  4723. _NAN = value_new_const(NUMBER);
  4724. _NAN->val.number = NAN;
  4725. INF = value_new_const(NUMBER);
  4726. INF->val.number = INFINITY;
  4727. NINF = value_new_const(NUMBER);
  4728. NINF->val.number = -INFINITY;
  4729. list_t *vs = list_new();
  4730. for (size_t i = 0; i < strlen(VSTR); i++)
  4731. list_push(vs, CHARS[VSTR[i]]);
  4732. table_set(state->env, "JKV", value_new_array(vs));
  4733. table_set(state->env, "E", value_new_number(exp(1)));
  4734. table_set(state->env, "pi", value_new_number(M_PI));
  4735. table_set(state->env, "tau", value_new_number(M_PI*2));
  4736. table_set(state->env, "nan", _NAN);
  4737. table_set(state->env, "inf", INF);
  4738. table_set(state->env, "nil", state->nil);
  4739. table_set(state->env, "udf", state->udf);
  4740. Inverses = table_new();
  4741. table_set(Inverses, "+", find_verb("+"));
  4742. table_set(Inverses, "-", find_verb("-"));
  4743. table_set(Inverses, "|", find_verb("|"));
  4744. table_set(Inverses, "~", find_verb("~"));
  4745. table_set(Inverses, "%", find_verb("%"));
  4746. table_set(Inverses, "]", find_verb("]"));
  4747. table_set(Inverses, "*:", find_verb("%:"));
  4748. table_set(Inverses, "%:", find_verb("*:"));
  4749. table_set(Inverses, ">", find_verb("<"));
  4750. table_set(Inverses, "<", find_verb(">"));
  4751. table_set(Inverses, "_.", find_verb("_:"));
  4752. table_set(Inverses, "_:", find_verb("_."));
  4753. table_set(Inverses, "^.", find_verb("^"));
  4754. table_set(Inverses, "^", find_verb("^."));
  4755. table_set(Inverses, "+;.", find_verb("%:"));
  4756. table_set(Inverses, "*/", find_verb("["));
  4757. table_set(Inverses, "[", interpreter_run(state, "*/")->val.verb);
  4758. table_set(Inverses, "!", interpreter_run(state, ">|/")->val.verb);
  4759. table_set(Inverses, "!.", interpreter_run(state, "|/")->val.verb);
  4760. table_set(Inverses, "]@>:", interpreter_run(state, "]@<:")->val.verb);
  4761. table_set(Inverses, "]@<:", interpreter_run(state, "]@>:")->val.verb);
  4762. list_t *args = list_new();
  4763. for (int i = 1; i < argc; i++) {
  4764. list_t *arg = list_new();
  4765. char *s = argv[i];
  4766. while (*s)
  4767. list_push(arg, CHARS[*s++]);
  4768. list_push(args, value_new_array(arg));
  4769. }
  4770. table_set(state->env, "args", value_new_array(args));
  4771. if (is_interactive)
  4772. printf("jk\t\\\\ to exit \\ for help\n");
  4773. char *s = NULL;
  4774. if (is_interactive)
  4775. setjmp(interactive_checkpoint);
  4776. if (s) {
  4777. GC_FREE(s); s = NULL;
  4778. }
  4779. for (;;) {
  4780. buffer_t *buffer;
  4781. char line[256];
  4782. buffer = buffer_new();
  4783. if (is_interactive)
  4784. putc('\t', stdout);
  4785. if (!fgets(line, sizeof(line), stdin))
  4786. break;
  4787. if (is_interactive) {
  4788. if (strcmp(line, "\\\\\n") == 0)
  4789. break;
  4790. else if (strcmp(line, "\\\n") == 0) {
  4791. printf("%s", HELP);
  4792. continue;
  4793. }
  4794. else if (strcmp(line, "\\0\n") == 0) {
  4795. printf("%s", SHELP);
  4796. continue;
  4797. }
  4798. else if (strcmp(line, "\\+\n") == 0) {
  4799. printf("%s", VHELP);
  4800. continue;
  4801. }
  4802. else if (strcmp(line, "\\a\n") == 0) {
  4803. printf("%s", V2HELP);
  4804. continue;
  4805. }
  4806. else if (strcmp(line, "\\\"\n") == 0) {
  4807. printf("%s", AHELP);
  4808. continue;
  4809. }
  4810. else if (strcmp(line, "\\;\n") == 0) {
  4811. printf("%s", CHELP);
  4812. continue;
  4813. }
  4814. else if (strcmp(line, "\\-:\n") == 0) {
  4815. printf("%s", IHELP);
  4816. continue;
  4817. }
  4818. }
  4819. while (strlen(line) > 2 && strcmp(line+strlen(line)-3, "..\n") == 0) {
  4820. line[strlen(line) - 3] = 0;
  4821. buffer_append_str(buffer, line);
  4822. if (is_interactive)
  4823. putc('\t', stdout);
  4824. if (!fgets(line, sizeof(line), stdin))
  4825. return 0;
  4826. }
  4827. buffer_append_str(buffer, line);
  4828. s = buffer_read(buffer);
  4829. value_t *v = interpreter_run(state, s);
  4830. GC_FREE(s); s = NULL;
  4831. if (v->tag != NIL) {
  4832. table_set(state->env, "it", v);
  4833. char *s = value_show(v);
  4834. fputs(s, stdout);
  4835. if (is_interactive)
  4836. putc('\n', stdout);
  4837. }
  4838. }
  4839. }