Formula.cpp 239 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194419541964197419841994200420142024203420442054206420742084209421042114212421342144215421642174218421942204221422242234224422542264227422842294230423142324233423442354236423742384239424042414242424342444245424642474248424942504251425242534254425542564257425842594260426142624263426442654266426742684269427042714272427342744275427642774278427942804281428242834284428542864287428842894290429142924293429442954296429742984299430043014302430343044305430643074308430943104311431243134314431543164317431843194320432143224323432443254326432743284329433043314332433343344335433643374338433943404341434243434344434543464347434843494350435143524353435443554356435743584359436043614362436343644365436643674368436943704371437243734374437543764377437843794380438143824383438443854386438743884389439043914392439343944395439643974398439944004401440244034404440544064407440844094410441144124413441444154416441744184419442044214422442344244425442644274428442944304431443244334434443544364437443844394440444144424443444444454446444744484449445044514452445344544455445644574458445944604461446244634464446544664467446844694470447144724473447444754476447744784479448044814482448344844485448644874488448944904491449244934494449544964497449844994500450145024503450445054506450745084509451045114512451345144515451645174518451945204521452245234524452545264527452845294530453145324533453445354536453745384539454045414542454345444545454645474548454945504551455245534554455545564557455845594560456145624563456445654566456745684569457045714572457345744575457645774578457945804581458245834584458545864587458845894590459145924593459445954596459745984599460046014602460346044605460646074608460946104611461246134614461546164617461846194620462146224623462446254626462746284629463046314632463346344635463646374638463946404641464246434644464546464647464846494650465146524653465446554656465746584659466046614662466346644665466646674668466946704671467246734674467546764677467846794680468146824683468446854686468746884689469046914692469346944695469646974698469947004701470247034704470547064707470847094710471147124713471447154716471747184719472047214722472347244725472647274728472947304731473247334734473547364737473847394740474147424743474447454746474747484749475047514752475347544755475647574758475947604761476247634764476547664767476847694770477147724773477447754776477747784779478047814782478347844785478647874788478947904791479247934794479547964797479847994800480148024803480448054806480748084809481048114812481348144815481648174818481948204821482248234824482548264827482848294830483148324833483448354836483748384839484048414842484348444845484648474848484948504851485248534854485548564857485848594860486148624863486448654866486748684869487048714872487348744875487648774878487948804881488248834884488548864887488848894890489148924893489448954896489748984899490049014902490349044905490649074908490949104911491249134914491549164917491849194920492149224923492449254926492749284929493049314932493349344935493649374938493949404941494249434944494549464947494849494950495149524953495449554956495749584959496049614962496349644965496649674968496949704971497249734974497549764977497849794980498149824983498449854986498749884989499049914992499349944995499649974998499950005001500250035004500550065007500850095010501150125013501450155016501750185019502050215022502350245025502650275028502950305031503250335034503550365037503850395040504150425043504450455046504750485049505050515052505350545055505650575058505950605061506250635064506550665067506850695070507150725073507450755076507750785079508050815082508350845085508650875088508950905091509250935094509550965097509850995100510151025103510451055106510751085109511051115112511351145115511651175118511951205121512251235124512551265127512851295130513151325133513451355136513751385139514051415142514351445145514651475148514951505151515251535154515551565157515851595160516151625163516451655166516751685169517051715172517351745175517651775178517951805181518251835184518551865187518851895190519151925193519451955196519751985199520052015202520352045205520652075208520952105211521252135214521552165217521852195220522152225223522452255226522752285229523052315232523352345235523652375238523952405241524252435244524552465247524852495250525152525253525452555256525752585259526052615262526352645265526652675268526952705271527252735274527552765277527852795280528152825283528452855286528752885289529052915292529352945295529652975298529953005301530253035304530553065307530853095310531153125313531453155316531753185319532053215322532353245325532653275328532953305331533253335334533553365337533853395340534153425343534453455346534753485349535053515352535353545355535653575358535953605361536253635364536553665367536853695370537153725373537453755376537753785379538053815382538353845385538653875388538953905391539253935394539553965397539853995400540154025403540454055406540754085409541054115412541354145415541654175418541954205421542254235424542554265427542854295430543154325433543454355436543754385439544054415442544354445445544654475448544954505451545254535454545554565457545854595460546154625463546454655466546754685469547054715472547354745475547654775478547954805481548254835484548554865487548854895490549154925493549454955496549754985499550055015502550355045505550655075508550955105511551255135514551555165517551855195520552155225523552455255526552755285529553055315532553355345535553655375538553955405541554255435544554555465547554855495550555155525553555455555556555755585559556055615562556355645565556655675568556955705571557255735574557555765577557855795580558155825583558455855586558755885589559055915592559355945595559655975598559956005601560256035604560556065607560856095610561156125613561456155616561756185619562056215622562356245625562656275628562956305631563256335634563556365637563856395640564156425643564456455646564756485649565056515652565356545655565656575658565956605661566256635664566556665667566856695670567156725673567456755676567756785679568056815682568356845685568656875688568956905691569256935694569556965697569856995700570157025703570457055706570757085709571057115712571357145715571657175718571957205721572257235724572557265727572857295730573157325733573457355736573757385739574057415742574357445745574657475748574957505751575257535754575557565757575857595760576157625763576457655766576757685769577057715772577357745775577657775778577957805781578257835784578557865787578857895790579157925793579457955796579757985799580058015802580358045805580658075808580958105811581258135814581558165817581858195820582158225823582458255826582758285829583058315832583358345835583658375838583958405841584258435844584558465847584858495850585158525853585458555856585758585859586058615862586358645865586658675868586958705871587258735874587558765877587858795880588158825883588458855886588758885889589058915892589358945895589658975898589959005901590259035904590559065907590859095910591159125913591459155916591759185919592059215922592359245925592659275928592959305931593259335934593559365937593859395940594159425943594459455946594759485949595059515952595359545955595659575958595959605961596259635964596559665967596859695970597159725973597459755976597759785979598059815982598359845985598659875988598959905991599259935994599559965997599859996000600160026003600460056006600760086009601060116012601360146015601660176018601960206021602260236024602560266027602860296030603160326033603460356036603760386039604060416042604360446045604660476048604960506051605260536054605560566057605860596060606160626063606460656066606760686069607060716072607360746075607660776078607960806081608260836084608560866087608860896090609160926093609460956096609760986099610061016102610361046105610661076108610961106111611261136114611561166117611861196120612161226123612461256126612761286129613061316132613361346135613661376138613961406141614261436144614561466147614861496150615161526153615461556156615761586159616061616162616361646165616661676168616961706171617261736174617561766177617861796180618161826183618461856186618761886189619061916192619361946195619661976198619962006201620262036204620562066207620862096210621162126213621462156216621762186219622062216222622362246225622662276228622962306231623262336234623562366237623862396240624162426243624462456246624762486249625062516252625362546255625662576258625962606261626262636264626562666267626862696270627162726273627462756276627762786279628062816282628362846285628662876288628962906291629262936294629562966297629862996300630163026303630463056306630763086309631063116312631363146315631663176318631963206321632263236324632563266327632863296330633163326333633463356336633763386339634063416342634363446345634663476348634963506351635263536354635563566357635863596360636163626363636463656366636763686369637063716372637363746375637663776378637963806381638263836384638563866387638863896390639163926393639463956396639763986399640064016402640364046405640664076408640964106411641264136414641564166417641864196420642164226423642464256426642764286429643064316432643364346435643664376438643964406441644264436444644564466447644864496450645164526453645464556456645764586459646064616462646364646465646664676468646964706471647264736474647564766477647864796480648164826483648464856486648764886489649064916492649364946495649664976498649965006501650265036504650565066507650865096510651165126513651465156516651765186519652065216522652365246525652665276528652965306531653265336534653565366537653865396540654165426543654465456546654765486549655065516552655365546555655665576558655965606561656265636564656565666567656865696570657165726573657465756576657765786579658065816582658365846585658665876588658965906591659265936594659565966597659865996600660166026603660466056606
  1. /* Formula.cpp
  2. *
  3. * Copyright (C) 1992-2018 Paul Boersma
  4. *
  5. * This code is free software; you can redistribute it and/or modify
  6. * it under the terms of the GNU General Public License as published by
  7. * the Free Software Foundation; either version 2 of the License, or (at
  8. * your option) any later version.
  9. *
  10. * This code is distributed in the hope that it will be useful, but
  11. * WITHOUT ANY WARRANTY; without even the implied warranty of
  12. * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  13. * See the GNU General Public License for more details.
  14. *
  15. * You should have received a copy of the GNU General Public License
  16. * along with this work. If not, see <http://www.gnu.org/licenses/>.
  17. */
  18. #include <ctype.h>
  19. #if defined (UNIX)
  20. #include <sys/stat.h>
  21. #endif
  22. #include "../dwsys/NUM2.h"
  23. #include "Formula.h"
  24. #include "Interpreter.h"
  25. #include "Ui.h"
  26. #include "praatP.h"
  27. #include "praat_script.h"
  28. #include "../kar/UnicodeData.h"
  29. #include "../kar/longchar.h"
  30. #include "UiPause.h"
  31. #include "DemoEditor.h"
  32. static Interpreter theInterpreter;
  33. static autoInterpreter theLocalInterpreter;
  34. static Daata theSource;
  35. static conststring32 theExpression;
  36. static int theLevel = 1;
  37. #define MAXIMUM_NUMBER_OF_LEVELS 20
  38. static int theExpressionType [1 + MAXIMUM_NUMBER_OF_LEVELS];
  39. static bool theOptimize;
  40. typedef struct structFormulaInstruction {
  41. int symbol;
  42. int position;
  43. union {
  44. double number;
  45. int label;
  46. char32 *string;
  47. Daata object;
  48. InterpreterVariable variable;
  49. } content;
  50. } *FormulaInstruction;
  51. static FormulaInstruction lexan, parse;
  52. static int ilabel, ilexan, iparse, numberOfInstructions, numberOfStringConstants;
  53. enum { GEENSYMBOOL_,
  54. /* First, all symbols after which "-" is unary. */
  55. /* The list ends with "MINUS_" itself. */
  56. /* Haakjes-openen. */
  57. IF_, THEN_, ELSE_, HAAKJEOPENEN_, RECHTEHAAKOPENEN_, OPENING_BRACE_, KOMMA_, COLON_, FROM_, TO_,
  58. /* Operatoren met boolean resultaat. */
  59. OR_, AND_, NOT_, EQ_, NE_, LE_, LT_, GE_, GT_,
  60. /* Operatoren met reeel resultaat. */
  61. ADD_, SUB_, MUL_, RDIV_, IDIV_, MOD_, POWER_, CALL_, MINUS_,
  62. /* Then, the symbols after which "-" is binary. */
  63. /* Haakjes-sluiten. */
  64. ENDIF_, FI_, HAAKJESLUITEN_, RECHTEHAAKSLUITEN_, CLOSING_BRACE_,
  65. /* Dingen met een waarde. */
  66. #define LOW_VALUE NUMBER_
  67. NUMBER_, NUMBER_PI_, NUMBER_E_, NUMBER_UNDEFINED_,
  68. /* Attributes of objects. */
  69. #define LOW_ATTRIBUTE XMIN_
  70. XMIN_, XMAX_, YMIN_, YMAX_, NX_, NY_, DX_, DY_,
  71. ROW_, COL_, NROW_, NCOL_, ROWSTR_, COLSTR_, Y_, X_,
  72. #define HIGH_ATTRIBUTE X_
  73. #define HIGH_VALUE HIGH_ATTRIBUTE
  74. SELF_, SELFSTR_, OBJECT_, OBJECTSTR_, MATRIKS_, MATRIKSSTR_,
  75. STOPWATCH_,
  76. /* The following symbols can be followed by "-" only if they are a variable. */
  77. /* Functions of 1 variable; if you add, update the #defines. */
  78. #define LOW_FUNCTION_1 ABS_
  79. ABS_, ROUND_, FLOOR_, CEILING_,
  80. RECTIFY_, VEC_RECTIFY_,
  81. SQRT_, SIN_, COS_, TAN_, ARCSIN_, ARCCOS_, ARCTAN_, SINC_, SINCPI_,
  82. EXP_, VEC_EXP_, MAT_EXP_,
  83. SINH_, COSH_, TANH_, ARCSINH_, ARCCOSH_, ARCTANH_,
  84. SIGMOID_, VEC_SIGMOID_, VEC_SOFTMAX_,
  85. INV_SIGMOID_, ERF_, ERFC_, GAUSS_P_, GAUSS_Q_, INV_GAUSS_Q_,
  86. RANDOM_BERNOULLI_, VEC_RANDOM_BERNOULLI_,
  87. RANDOM_POISSON_,
  88. LOG2_, LN_, LOG10_, LN_GAMMA_,
  89. HERTZ_TO_BARK_, BARK_TO_HERTZ_, PHON_TO_DIFFERENCE_LIMENS_, DIFFERENCE_LIMENS_TO_PHON_,
  90. HERTZ_TO_MEL_, MEL_TO_HERTZ_, HERTZ_TO_SEMITONES_, SEMITONES_TO_HERTZ_,
  91. ERB_, HERTZ_TO_ERB_, ERB_TO_HERTZ_,
  92. SUM_, MEAN_, STDEV_, CENTER_,
  93. EVALUATE_, EVALUATE_NOCHECK_, EVALUATE_STR_, EVALUATE_NOCHECK_STR_,
  94. STRINGSTR_, SLEEP_, UNICODE_, UNICODESTR_,
  95. #define HIGH_FUNCTION_1 UNICODESTR_
  96. /* Functions of 2 variables; if you add, update the #defines. */
  97. #define LOW_FUNCTION_2 ARCTAN2_
  98. ARCTAN2_, RANDOM_UNIFORM_, RANDOM_INTEGER_, RANDOM_GAUSS_, RANDOM_BINOMIAL_,
  99. CHI_SQUARE_P_, CHI_SQUARE_Q_, INCOMPLETE_GAMMAP_,
  100. INV_CHI_SQUARE_Q_, STUDENT_P_, STUDENT_Q_, INV_STUDENT_Q_,
  101. BETA_, BETA2_, BESSEL_I_, BESSEL_K_, LN_BETA_,
  102. SOUND_PRESSURE_TO_PHON_, OBJECTS_ARE_IDENTICAL_,
  103. INNER_, MAT_OUTER_, VEC_MUL_, VEC_REPEAT_,
  104. #define HIGH_FUNCTION_2 VEC_REPEAT_
  105. /* Functions of 3 variables; if you add, update the #defines. */
  106. #define LOW_FUNCTION_3 FISHER_P_
  107. FISHER_P_, FISHER_Q_, INV_FISHER_Q_,
  108. BINOMIAL_P_, BINOMIAL_Q_, INCOMPLETE_BETA_, INV_BINOMIAL_P_, INV_BINOMIAL_Q_,
  109. #define HIGH_FUNCTION_3 INV_BINOMIAL_Q_
  110. /* Functions of a variable number of variables; if you add, update the #defines. */
  111. #define LOW_FUNCTION_N DO_
  112. DO_, DOSTR_,
  113. WRITE_INFO_, WRITE_INFO_LINE_, APPEND_INFO_, APPEND_INFO_LINE_,
  114. WRITE_FILE_, WRITE_FILE_LINE_, APPEND_FILE_, APPEND_FILE_LINE_,
  115. PAUSE_SCRIPT_, EXIT_SCRIPT_, RUN_SCRIPT_, RUN_SYSTEM_, RUN_SYSTEM_NOCHECK_, RUN_SUBPROCESS_,
  116. MIN_, MAX_, IMIN_, IMAX_, NORM_,
  117. LEFTSTR_, RIGHTSTR_, MIDSTR_,
  118. SELECTED_, SELECTEDSTR_, NUMBER_OF_SELECTED_, VEC_SELECTED_,
  119. SELECT_OBJECT_, PLUS_OBJECT_, MINUS_OBJECT_, REMOVE_OBJECT_,
  120. BEGIN_PAUSE_FORM_, PAUSE_FORM_ADD_REAL_, PAUSE_FORM_ADD_POSITIVE_, PAUSE_FORM_ADD_INTEGER_, PAUSE_FORM_ADD_NATURAL_,
  121. PAUSE_FORM_ADD_WORD_, PAUSE_FORM_ADD_SENTENCE_, PAUSE_FORM_ADD_TEXT_, PAUSE_FORM_ADD_BOOLEAN_,
  122. PAUSE_FORM_ADD_CHOICE_, PAUSE_FORM_ADD_OPTION_MENU_, PAUSE_FORM_ADD_OPTION_,
  123. PAUSE_FORM_ADD_COMMENT_, END_PAUSE_FORM_,
  124. CHOOSE_READ_FILESTR_, CHOOSE_WRITE_FILESTR_, CHOOSE_DIRECTORYSTR_,
  125. DEMO_WINDOW_TITLE_, DEMO_SHOW_, DEMO_WAIT_FOR_INPUT_, DEMO_PEEK_INPUT_, DEMO_INPUT_, DEMO_CLICKED_IN_,
  126. DEMO_CLICKED_, DEMO_X_, DEMO_Y_, DEMO_KEY_PRESSED_, DEMO_KEY_,
  127. DEMO_SHIFT_KEY_PRESSED_, DEMO_COMMAND_KEY_PRESSED_, DEMO_OPTION_KEY_PRESSED_, DEMO_EXTRA_CONTROL_KEY_PRESSED_,
  128. VEC_ZERO_, MAT_ZERO_,
  129. VEC_LINEAR_, MAT_LINEAR_, VEC_TO_,
  130. VEC_RANDOM_UNIFORM_, MAT_RANDOM_UNIFORM_,
  131. VEC_RANDOM_INTEGER_, MAT_RANDOM_INTEGER_,
  132. VEC_RANDOM_GAUSS_, MAT_RANDOM_GAUSS_,
  133. MAT_PEAKS_,
  134. SIZE_, NUMBER_OF_ROWS_, NUMBER_OF_COLUMNS_, EDITOR_, HASH_,
  135. #define HIGH_FUNCTION_N HASH_
  136. /* String functions. */
  137. #define LOW_STRING_FUNCTION LOW_FUNCTION_STR1
  138. #define LOW_FUNCTION_STR1 LENGTH_
  139. LENGTH_, STRING_TO_NUMBER_, FILE_READABLE_, DELETE_FILE_, CREATE_DIRECTORY_, VARIABLE_EXISTS_,
  140. READ_FILE_, READ_FILESTR_, UNICODE_TO_BACKSLASH_TRIGRAPHS_, BACKSLASH_TRIGRAPHS_TO_UNICODE_, ENVIRONMENTSTR_,
  141. #define HIGH_FUNCTION_STR1 ENVIRONMENTSTR_
  142. DATESTR_, INFOSTR_,
  143. INDEX_, RINDEX_,
  144. STARTS_WITH_, ENDS_WITH_, REPLACESTR_, INDEX_REGEX_, RINDEX_REGEX_, REPLACE_REGEXSTR_,
  145. EXTRACT_NUMBER_, EXTRACT_WORDSTR_, EXTRACT_LINESTR_,
  146. FIXEDSTR_, PERCENTSTR_, HEXADECIMALSTR_,
  147. #define HIGH_STRING_FUNCTION HEXADECIMALSTR_
  148. /* Range functions. */
  149. #define LOW_RANGE_FUNCTION SUM_OVER_
  150. SUM_OVER_,
  151. #define HIGH_RANGE_FUNCTION SUM_OVER_
  152. #define LOW_FUNCTION LOW_FUNCTION_1
  153. #define HIGH_FUNCTION HIGH_RANGE_FUNCTION
  154. /* Membership operator. */
  155. PERIOD_,
  156. #define hoogsteInvoersymbool PERIOD_
  157. /* Symbols introduced by the parser. */
  158. TRUE_, FALSE_,
  159. GOTO_, IFTRUE_, IFFALSE_, INCREMENT_GREATER_GOTO_,
  160. LABEL_,
  161. DECREMENT_AND_ASSIGN_, ADD_3DOWN_, POP_2_,
  162. NUMERIC_VECTOR_ELEMENT_, NUMERIC_MATRIX_ELEMENT_, VARIABLE_REFERENCE_,
  163. TENSOR_LITERAL_,
  164. SELF0_, SELFSTR0_, TO_OBJECT_,
  165. OBJECT_XMIN_, OBJECT_XMAX_, OBJECT_YMIN_, OBJECT_YMAX_, OBJECT_NX_, OBJECT_NY_,
  166. OBJECT_DX_, OBJECT_DY_, OBJECT_NROW_, OBJECT_NCOL_, OBJECT_ROWSTR_, OBJECT_COLSTR_,
  167. OBJECTCELL0_, OBJECTCELLSTR0_, OBJECTCELL1_, OBJECTCELLSTR1_, OBJECTCELL2_, OBJECTCELLSTR2_,
  168. OBJECTLOCATION0_, OBJECTLOCATIONSTR0_, OBJECTLOCATION1_, OBJECTLOCATIONSTR1_, OBJECTLOCATION2_, OBJECTLOCATIONSTR2_,
  169. SELFMATRIKS1_, SELFMATRIKSSTR1_, SELFMATRIKS2_, SELFMATRIKSSTR2_,
  170. SELFFUNKTIE1_, SELFFUNKTIESTR1_, SELFFUNKTIE2_, SELFFUNKTIESTR2_,
  171. MATRIKS0_, MATRIKSSTR0_, MATRIKS1_, MATRIKSSTR1_, MATRIKS2_, MATRIKSSTR2_,
  172. FUNKTIE0_, FUNKTIESTR0_, FUNKTIE1_, FUNKTIESTR1_, FUNKTIE2_, FUNKTIESTR2_,
  173. SQR_,
  174. /* Symbols introduced by lexical analysis. */
  175. STRING_,
  176. NUMERIC_VARIABLE_, NUMERIC_VECTOR_VARIABLE_, NUMERIC_MATRIX_VARIABLE_,
  177. STRING_VARIABLE_, STRING_ARRAY_VARIABLE_,
  178. VARIABLE_NAME_, INDEXED_NUMERIC_VARIABLE_, INDEXED_STRING_VARIABLE_,
  179. END_
  180. #define hoogsteSymbool END_
  181. };
  182. /* The names that start with an underscore (_) do not occur in the formula text: */
  183. /* they are used in error messages and in debugging (see Formula_print). */
  184. static const conststring32 Formula_instructionNames [1 + hoogsteSymbool] = { U"",
  185. U"if", U"then", U"else", U"(", U"[", U"{", U",", U":", U"from", U"to",
  186. U"or", U"and", U"not", U"=", U"<>", U"<=", U"<", U">=", U">",
  187. U"+", U"-", U"*", U"/", U"div", U"mod", U"^", U"_call", U"_neg",
  188. U"endif", U"fi", U")", U"]", U"}",
  189. U"a number", U"pi", U"e", U"undefined",
  190. U"xmin", U"xmax", U"ymin", U"ymax", U"nx", U"ny", U"dx", U"dy",
  191. U"row", U"col", U"nrow", U"ncol", U"row$", U"col$", U"y", U"x",
  192. U"self", U"self$", U"object", U"object$", U"_matriks", U"_matriks$",
  193. U"stopwatch",
  194. U"abs", U"round", U"floor", U"ceiling",
  195. U"rectify", U"rectify#",
  196. U"sqrt", U"sin", U"cos", U"tan", U"arcsin", U"arccos", U"arctan", U"sinc", U"sincpi",
  197. U"exp", U"exp#", U"exp##",
  198. U"sinh", U"cosh", U"tanh", U"arcsinh", U"arccosh", U"arctanh",
  199. U"sigmoid", U"sigmoid#", U"softmax#",
  200. U"invSigmoid", U"erf", U"erfc", U"gaussP", U"gaussQ", U"invGaussQ",
  201. U"randomBernoulli", U"randomBernoulli#",
  202. U"randomPoisson",
  203. U"log2", U"ln", U"log10", U"lnGamma",
  204. U"hertzToBark", U"barkToHertz", U"phonToDifferenceLimens", U"differenceLimensToPhon",
  205. U"hertzToMel", U"melToHertz", U"hertzToSemitones", U"semitonesToHertz",
  206. U"erb", U"hertzToErb", U"erbToHertz",
  207. U"sum", U"mean", U"stdev", U"center",
  208. U"evaluate", U"evaluate_nocheck", U"evaluate$", U"evaluate_nocheck$",
  209. U"string$", U"sleep", U"unicode", U"unicode$",
  210. U"arctan2", U"randomUniform", U"randomInteger", U"randomGauss", U"randomBinomial",
  211. U"chiSquareP", U"chiSquareQ", U"incompleteGammaP", U"invChiSquareQ", U"studentP", U"studentQ", U"invStudentQ",
  212. U"beta", U"beta2", U"besselI", U"besselK", U"lnBeta",
  213. U"soundPressureToPhon", U"objectsAreIdentical",
  214. U"inner", U"outer##", U"mul#", U"repeat#",
  215. U"fisherP", U"fisherQ", U"invFisherQ",
  216. U"binomialP", U"binomialQ", U"incompleteBeta", U"invBinomialP", U"invBinomialQ",
  217. U"do", U"do$",
  218. U"writeInfo", U"writeInfoLine", U"appendInfo", U"appendInfoLine",
  219. U"writeFile", U"writeFileLine", U"appendFile", U"appendFileLine",
  220. U"pauseScript", U"exitScript", U"runScript", U"runSystem", U"runSystem_nocheck", U"runSubprocess",
  221. U"min", U"max", U"imin", U"imax", U"norm",
  222. U"left$", U"right$", U"mid$",
  223. U"selected", U"selected$", U"numberOfSelected", U"selected#",
  224. U"selectObject", U"plusObject", U"minusObject", U"removeObject",
  225. U"beginPause", U"real", U"positive", U"integer", U"natural",
  226. U"word", U"sentence", U"text", U"boolean",
  227. U"choice", U"optionMenu", U"option",
  228. U"comment", U"endPause",
  229. U"chooseReadFile$", U"chooseWriteFile$", U"chooseDirectory$",
  230. U"demoWindowTitle", U"demoShow", U"demoWaitForInput", U"demoPeekInput", U"demoInput", U"demoClickedIn",
  231. U"demoClicked", U"demoX", U"demoY", U"demoKeyPressed", U"demoKey$",
  232. U"demoShiftKeyPressed", U"demoCommandKeyPressed", U"demoOptionKeyPressed", U"demoExtraControlKeyPressed",
  233. U"zero#", U"zero##",
  234. U"linear#", U"linear##", U"to#",
  235. U"randomUniform#", U"randomUniform##",
  236. U"randomInteger#", U"randomInteger##",
  237. U"randomGauss#", U"randomGauss##",
  238. U"peaks##",
  239. U"size", U"numberOfRows", U"numberOfColumns", U"editor", U"hash",
  240. U"length", U"number", U"fileReadable", U"deleteFile", U"createDirectory", U"variableExists",
  241. U"readFile", U"readFile$", U"unicodeToBackslashTrigraphs$", U"backslashTrigraphsToUnicode$", U"environment$",
  242. U"date$", U"info$",
  243. U"index", U"rindex",
  244. U"startsWith", U"endsWith", U"replace$", U"index_regex", U"rindex_regex", U"replace_regex$",
  245. U"extractNumber", U"extractWord$", U"extractLine$",
  246. U"fixed$", U"percent$", U"hexadecimal$",
  247. U"sumOver",
  248. U".",
  249. U"_true", U"_false",
  250. U"_goto", U"_iftrue", U"_iffalse", U"_incrementGreaterGoto",
  251. U"_label",
  252. U"_decrementAndAssign", U"_add3Down", U"_pop2",
  253. U"_numericVectorElement", U"_numericMatrixElement", U"_variableReference",
  254. U"_numericVectorLiteral",
  255. U"_self0", U"_self0$", U"_toObject",
  256. U"_object_xmin", U"_object_xmax", U"_object_ymin", U"_object_ymax", U"_object_dnx", U"_object_ny",
  257. U"_object_dx", U"_object_dy", U"_object_nrow", U"_object_ncol", U"_object_row$", U"_object_col$",
  258. U"_objectcell0", U"_objectcell0$", U"_objectcell1", U"_objectcell1$", U"_objectcell2", U"_objectcell2$",
  259. U"_objectlocation0", U"_objectlocation0$", U"_objectlocation1", U"_objectlocation1$", U"_objectlocation2", U"_objectlocation2$",
  260. U"_selfmatriks1", U"_selfmatriks1$", U"_selfmatriks2", U"_selfmatriks2$",
  261. U"_selffunktie1", U"_selffunktie1$", U"_selffunktie2", U"_selffunktie2$",
  262. U"_matriks0", U"_matriks0$", U"_matriks1", U"_matriks1$", U"_matriks2", U"_matriks2$",
  263. U"_funktie0", U"_funktie0$", U"_funktie1", U"_funktie1$", U"_funktie2", U"_funktie2$",
  264. U"_square",
  265. U"_string",
  266. U"a numeric variable", U"a vector variable", U"a matrix variable",
  267. U"a string variable", U"a string array variable",
  268. U"a variable name", U"an indexed numeric variable", U"an indexed string variable",
  269. U"the end of the formula"
  270. };
  271. #define nieuwlabel (-- ilabel)
  272. #define nieuwlees (lexan [++ ilexan]. symbol)
  273. #define oudlees (-- ilexan)
  274. static void formulefout (conststring32 message, int position) {
  275. static MelderString truncatedExpression { };
  276. MelderString_ncopy (& truncatedExpression, theExpression, position + 1);
  277. Melder_throw (message, U":\n« ", truncatedExpression.string);
  278. }
  279. static conststring32 languageNameCompare_searchString;
  280. static int languageNameCompare (const void *first, const void *second) {
  281. int i = * (int *) first, j = * (int *) second;
  282. return str32cmp (i == 0 ? languageNameCompare_searchString : Formula_instructionNames [i],
  283. j == 0 ? languageNameCompare_searchString : Formula_instructionNames [j]);
  284. }
  285. static int Formula_hasLanguageName (conststring32 f) {
  286. static int *index;
  287. if (! index) {
  288. index = NUMvector <int> (1, hoogsteInvoersymbool);
  289. for (int tok = 1; tok <= hoogsteInvoersymbool; tok ++) {
  290. index [tok] = tok;
  291. }
  292. qsort (& index [1], hoogsteInvoersymbool, sizeof (int), languageNameCompare);
  293. }
  294. if (! index) { // linear search
  295. for (int tok = 1; tok <= hoogsteInvoersymbool; tok ++) {
  296. if (str32equ (f, Formula_instructionNames [tok])) return tok;
  297. }
  298. } else { // binary search
  299. int dummy = 0, *found;
  300. languageNameCompare_searchString = f;
  301. found = (int *) bsearch (& dummy, & index [1], hoogsteInvoersymbool, sizeof (int), languageNameCompare);
  302. if (found) return *found;
  303. }
  304. return 0;
  305. }
  306. static void Formula_lexan () {
  307. /*
  308. Purpose:
  309. translate the formula text into a series of symbols.
  310. Return:
  311. 0 in case of error, otherwise 1.
  312. Postcondition:
  313. if result != 0, then the last symbol is L"END_".
  314. Example:
  315. the text L"x*7" yields 5 symbols:
  316. lexan [0] is empty;
  317. lexan [1]. symbol = X_;
  318. lexan [2]. symbol = MUL_;
  319. lexan [3]. symbol = NUMBER_;
  320. lexan [3]. number = 7.00000000e+00;
  321. lexan [4]. symbol = END_;
  322. */
  323. char32 kar; /* The character most recently read from theExpression. */
  324. int ikar = -1; /* The position of that character in theExpression. */
  325. #define nieuwkar kar = theExpression [++ ikar]
  326. #define oudkar -- ikar
  327. int itok = 0; /* Position of most recent symbol in "lexan". */
  328. #define nieuwtok(s) { lexan [++ itok]. symbol = s; lexan [itok]. position = ikar; }
  329. #define tokgetal(g) lexan [itok]. content.number = (g)
  330. #define tokmatriks(m) lexan [itok]. content.object = (m)
  331. static MelderString token { }; /* String to collect a symbol name in. */
  332. #define stokaan MelderString_empty (& token);
  333. #define stokkar { MelderString_appendCharacter (& token, kar); nieuwkar; }
  334. #define stokuit (void) 0
  335. ilexan = iparse = ilabel = numberOfStringConstants = 0;
  336. do {
  337. nieuwkar;
  338. if (Melder_isHorizontalOrVerticalSpace (kar)) {
  339. ; // ignore spaces and tabs
  340. } else if (kar == U'\0') {
  341. nieuwtok (END_)
  342. } else if (Melder_isAsciiDecimalNumber (kar)) {
  343. char32 saveKar = kar;
  344. bool isHexadecimal = false;
  345. if (kar == U'0') {
  346. nieuwkar;
  347. if (kar == U'x') {
  348. isHexadecimal = true;
  349. nieuwkar;
  350. } else {
  351. oudkar;
  352. }
  353. }
  354. if (isHexadecimal) {
  355. stokaan;
  356. do stokkar while (Melder_isHexadecimalDigit (kar));
  357. stokuit;
  358. oudkar;
  359. nieuwtok (NUMBER_)
  360. tokgetal (strtoull (Melder_peek32to8 (token.string), nullptr, 16));
  361. } else {
  362. kar = saveKar;
  363. stokaan;
  364. do stokkar while (Melder_isAsciiDecimalNumber (kar));
  365. if (kar == U'.') do stokkar while (Melder_isAsciiDecimalNumber (kar));
  366. if (kar == U'e' || kar == U'E') {
  367. kar = U'e'; stokkar
  368. if (kar == U'-') stokkar
  369. else if (kar == U'+') nieuwkar;
  370. if (! Melder_isAsciiDecimalNumber (kar))
  371. formulefout (U"Missing exponent", ikar);
  372. do stokkar while (Melder_isAsciiDecimalNumber (kar));
  373. }
  374. if (kar == U'%') stokkar
  375. stokuit;
  376. oudkar;
  377. nieuwtok (NUMBER_)
  378. tokgetal (Melder_atof (token.string));
  379. }
  380. } else if (Melder_isLowerCaseLetter (kar) || (kar == U'.' && Melder_isLowerCaseLetter (theExpression [ikar + 1])
  381. && (itok == 0 || (lexan [itok]. symbol != MATRIKS_ && lexan [itok]. symbol != MATRIKSSTR_
  382. && lexan [itok]. symbol != RECHTEHAAKSLUITEN_)))) {
  383. int tok;
  384. bool isString = false;
  385. int rank = 0;
  386. stokaan;
  387. do stokkar while (Melder_isWordCharacter (kar) || kar == U'.');
  388. if (kar == '$') {
  389. stokkar
  390. isString = true;
  391. }
  392. if (kar == '#') {
  393. rank += 1;
  394. stokkar
  395. if (kar == '#') {
  396. rank += 1;
  397. stokkar
  398. if (kar == '#') {
  399. rank += 1;
  400. stokkar
  401. if (kar == '#') {
  402. rank += 1;
  403. stokkar
  404. }
  405. }
  406. }
  407. }
  408. stokuit;
  409. oudkar;
  410. /*
  411. * 'token' now contains a word, possibly ending in a dollar or number sign;
  412. * it could be a variable name, a function name, both, or a procedure name.
  413. * Try a language or function name first.
  414. */
  415. tok = Formula_hasLanguageName (token.string);
  416. if (tok) {
  417. /*
  418. * We have a language name or function name. It MIGHT be meant to be a variable name, though,
  419. * regarding the large and expanding number of language names.
  420. */
  421. /*
  422. * First the constants. They are reserved words and can never be variable names.
  423. */
  424. if (tok == NUMBER_PI_) {
  425. nieuwtok (NUMBER_)
  426. tokgetal (NUMpi);
  427. } else if (tok == NUMBER_E_) {
  428. nieuwtok (NUMBER_)
  429. tokgetal (NUMe);
  430. } else if (tok == NUMBER_UNDEFINED_) {
  431. nieuwtok (NUMBER_)
  432. tokgetal (undefined);
  433. /*
  434. * One very common language name must be converted to a synonym.
  435. */
  436. } else if (tok == FI_) {
  437. nieuwtok (ENDIF_)
  438. /*
  439. * Is it a function name? These may be ambiguous.
  440. */
  441. } else if (tok >= LOW_FUNCTION && tok <= HIGH_FUNCTION) {
  442. /*
  443. * Look ahead to find out whether the next token is a left parenthesis (or a colon).
  444. */
  445. int jkar;
  446. jkar = ikar + 1;
  447. while (Melder_isHorizontalSpace (theExpression [jkar])) jkar ++;
  448. if (theExpression [jkar] == U'(' || theExpression [jkar] == U':') {
  449. nieuwtok (tok) // this must be a function name
  450. } else if (theExpression [jkar] == U'[' && rank == 0) {
  451. if (isString) {
  452. nieuwtok (INDEXED_STRING_VARIABLE_)
  453. } else {
  454. nieuwtok (INDEXED_NUMERIC_VARIABLE_)
  455. }
  456. lexan [itok]. content.string = Melder_dup_f (token.string).transfer();
  457. numberOfStringConstants ++;
  458. } else {
  459. /*
  460. * This could be a variable with the same name as a function.
  461. */
  462. InterpreterVariable var = Interpreter_hasVariable (theInterpreter, token.string);
  463. if (! var) {
  464. nieuwtok (VARIABLE_NAME_)
  465. lexan [itok]. content.string = Melder_dup_f (token.string).transfer();
  466. numberOfStringConstants ++;
  467. } else {
  468. if (rank == 0) {
  469. if (isString) {
  470. nieuwtok (STRING_VARIABLE_)
  471. } else {
  472. nieuwtok (NUMERIC_VARIABLE_)
  473. }
  474. } else if (rank == 1) {
  475. if (isString) {
  476. nieuwtok (STRING_ARRAY_VARIABLE_)
  477. } else {
  478. nieuwtok (NUMERIC_VECTOR_VARIABLE_)
  479. }
  480. } else if (rank == 2) {
  481. if (isString) {
  482. formulefout (U"String matrices not implemented.", ikar);
  483. } else {
  484. nieuwtok (NUMERIC_MATRIX_VARIABLE_)
  485. }
  486. } else if (rank == 3) {
  487. formulefout (U"Rank-3 tensors not implemented.", ikar);
  488. } else {
  489. formulefout (U"Rank-4 tensors not implemented.", ikar);
  490. }
  491. lexan [itok]. content.variable = var;
  492. }
  493. }
  494. /*
  495. * Not a function name.
  496. * Must be a language name (if, then, else, endif, or, and, not, div, mod, x, ncol, stopwatch).
  497. * Some can be used as variable names (x, ncol...).
  498. */
  499. } else if (tok >= LOW_ATTRIBUTE && tok <= HIGH_ATTRIBUTE) {
  500. /*
  501. * Look back to find out whether this is an attribute.
  502. */
  503. if (itok > 0 && lexan [itok]. symbol == PERIOD_) {
  504. /*
  505. * This must be an attribute that follows a period.
  506. */
  507. nieuwtok (tok)
  508. } else if (theSource) {
  509. /*
  510. * Look for ambiguity.
  511. */
  512. if (Interpreter_hasVariable (theInterpreter, token.string))
  513. Melder_throw (
  514. U"«", token.string,
  515. U"» is ambiguous: a variable or an attribute of the current object. "
  516. U"Please change variable name.");
  517. if (tok == ROW_ || tok == COL_ || tok == X_ || tok == Y_) {
  518. nieuwtok (tok)
  519. } else {
  520. nieuwtok (MATRIKS_)
  521. tokmatriks (theSource);
  522. nieuwtok (PERIOD_)
  523. nieuwtok (tok)
  524. }
  525. } else {
  526. /*
  527. * This must be a variable, since there is no "current object" here.
  528. */
  529. int jkar = ikar + 1;
  530. while (Melder_isHorizontalSpace (theExpression [jkar])) jkar ++;
  531. if (theExpression [jkar] == U'[' && rank == 0) {
  532. if (isString) {
  533. nieuwtok (INDEXED_STRING_VARIABLE_)
  534. } else {
  535. nieuwtok (INDEXED_NUMERIC_VARIABLE_)
  536. }
  537. lexan [itok]. content.string = Melder_dup_f (token.string).transfer();
  538. numberOfStringConstants ++;
  539. } else {
  540. InterpreterVariable var = Interpreter_hasVariable (theInterpreter, token.string);
  541. if (! var) {
  542. nieuwtok (VARIABLE_NAME_)
  543. lexan [itok]. content.string = Melder_dup_f (token.string).transfer();
  544. numberOfStringConstants ++;
  545. } else {
  546. if (rank == 0) {
  547. if (isString) {
  548. nieuwtok (STRING_VARIABLE_)
  549. } else {
  550. nieuwtok (NUMERIC_VARIABLE_)
  551. }
  552. } else if (rank == 1) {
  553. if (isString) {
  554. nieuwtok (STRING_ARRAY_VARIABLE_)
  555. } else {
  556. nieuwtok (NUMERIC_VECTOR_VARIABLE_)
  557. }
  558. } else if (rank == 2) {
  559. if (isString) {
  560. formulefout (U"String matrices not implemented.", ikar);
  561. } else {
  562. nieuwtok (NUMERIC_MATRIX_VARIABLE_)
  563. }
  564. } else if (rank == 3) {
  565. formulefout (U"Rank-3 tensors not implemented.", ikar);
  566. } else {
  567. formulefout (U"Rank-4 tensors not implemented.", ikar);
  568. }
  569. lexan [itok]. content.variable = var;
  570. }
  571. }
  572. }
  573. } else {
  574. nieuwtok (tok) /* This must be a language name. */
  575. }
  576. } else {
  577. /*
  578. * token.string is not a language name
  579. */
  580. int jkar = ikar + 1;
  581. while (Melder_isHorizontalSpace (theExpression [jkar])) jkar ++;
  582. if (theExpression [jkar] == U'(' || theExpression [jkar] == U':') {
  583. Melder_throw (
  584. U"Unknown function «", token.string, U"» in formula.");
  585. } else if (theExpression [jkar] == '[' && rank == 0) {
  586. if (isString) {
  587. nieuwtok (INDEXED_STRING_VARIABLE_)
  588. } else {
  589. nieuwtok (INDEXED_NUMERIC_VARIABLE_)
  590. }
  591. lexan [itok]. content.string = Melder_dup_f (token.string).transfer();
  592. numberOfStringConstants ++;
  593. } else {
  594. InterpreterVariable var = Interpreter_hasVariable (theInterpreter, token.string);
  595. if (! var) {
  596. nieuwtok (VARIABLE_NAME_)
  597. lexan [itok]. content.string = Melder_dup_f (token.string).transfer();
  598. numberOfStringConstants ++;
  599. } else {
  600. if (rank == 0) {
  601. if (isString) {
  602. nieuwtok (STRING_VARIABLE_)
  603. } else {
  604. nieuwtok (NUMERIC_VARIABLE_)
  605. }
  606. } else if (rank == 1) {
  607. if (isString) {
  608. nieuwtok (STRING_ARRAY_VARIABLE_)
  609. } else {
  610. nieuwtok (NUMERIC_VECTOR_VARIABLE_)
  611. }
  612. } else if (rank == 2) {
  613. if (isString) {
  614. formulefout (U"String matrices not implemented.", ikar);
  615. } else {
  616. nieuwtok (NUMERIC_MATRIX_VARIABLE_)
  617. }
  618. } else if (rank == 3) {
  619. formulefout (U"Rank-3 tensors not implemented.", ikar);
  620. } else {
  621. formulefout (U"Rank-4 tensors not implemented.", ikar);
  622. }
  623. lexan [itok]. content.variable = var;
  624. }
  625. }
  626. }
  627. } else if (kar >= U'A' && kar <= U'Z') {
  628. bool endsInDollarSign = false;
  629. stokaan;
  630. do stokkar while (isalnum ((int) kar) || kar == U'_'); // TODO: allow more than just ASCII
  631. if (kar == U'$') { stokkar endsInDollarSign = true; }
  632. stokuit;
  633. oudkar;
  634. /*
  635. * 'token' now contains a word that could be an object name.
  636. */
  637. char32 *underscore = str32chr (token.string, '_');
  638. if (str32equ (token.string, U"Self")) {
  639. if (! theSource)
  640. formulefout (U"Cannot use \"Self\" if there is no current object.", ikar);
  641. nieuwtok (MATRIKS_)
  642. tokmatriks (theSource);
  643. } else if (str32equ (token.string, U"Self$")) {
  644. if (! theSource)
  645. formulefout (U"Cannot use \"Self$\" if there is no current object.", ikar);
  646. nieuwtok (MATRIKSSTR_)
  647. tokmatriks (theSource);
  648. } else if (! underscore) {
  649. Melder_throw (
  650. U"Unknown symbol «", token.string, U"» in formula "
  651. U"(variables start with lower case; object names contain an underscore).");
  652. } else if (str32nequ (token.string, U"Object_", 7)) {
  653. integer uniqueID = Melder_atoi (token.string + 7);
  654. int i = theCurrentPraatObjects -> n;
  655. while (i > 0 && uniqueID != theCurrentPraatObjects -> list [i]. id)
  656. i --;
  657. if (i == 0)
  658. formulefout (U"No such object (note: variables start with lower case)", ikar);
  659. nieuwtok (endsInDollarSign ? MATRIKSSTR_ : MATRIKS_)
  660. tokmatriks ((Daata) theCurrentPraatObjects -> list [i]. object);
  661. } else {
  662. int i = theCurrentPraatObjects -> n;
  663. *underscore = ' ';
  664. if (endsInDollarSign) token.string [-- token.length] = '\0';
  665. while (i > 0 && ! str32equ (token.string, theCurrentPraatObjects -> list [i]. name.get()))
  666. i --;
  667. if (i == 0)
  668. formulefout (U"No such object (note: variables start with lower case)", ikar);
  669. nieuwtok (endsInDollarSign ? MATRIKSSTR_ : MATRIKS_)
  670. tokmatriks ((Daata) theCurrentPraatObjects -> list [i]. object);
  671. }
  672. } else if (kar == U'(') {
  673. nieuwtok (HAAKJEOPENEN_)
  674. } else if (kar == U')') {
  675. nieuwtok (HAAKJESLUITEN_)
  676. } else if (kar == U'+') {
  677. nieuwtok (ADD_)
  678. } else if (kar == U'-') {
  679. if (itok == 0 || lexan [itok]. symbol <= MINUS_) {
  680. nieuwtok (MINUS_)
  681. } else {
  682. nieuwtok (SUB_)
  683. }
  684. } else if (kar == U'*') {
  685. nieuwkar;
  686. if (kar == U'*') {
  687. nieuwtok (POWER_) /* "**" = "^" */
  688. } else {
  689. oudkar;
  690. nieuwtok (MUL_)
  691. }
  692. } else if (kar == U'/') {
  693. nieuwkar;
  694. if (kar == U'=') {
  695. nieuwtok (NE_) /* "/=" = "<>" */
  696. } else {
  697. oudkar;
  698. nieuwtok (RDIV_)
  699. }
  700. } else if (kar == U'=') {
  701. nieuwtok (EQ_) /* "=" */
  702. nieuwkar;
  703. if (kar != U'=') {
  704. oudkar; /* "==" = "=" */
  705. }
  706. } else if (kar == U'>') {
  707. nieuwkar;
  708. if (kar == U'=') {
  709. nieuwtok (GE_)
  710. } else {
  711. oudkar;
  712. nieuwtok (GT_)
  713. }
  714. } else if (kar == U'<') {
  715. nieuwkar;
  716. if (kar == U'=') {
  717. nieuwtok (LE_)
  718. } else if (kar == U'>') {
  719. nieuwtok (NE_)
  720. } else {
  721. oudkar;
  722. nieuwtok (LT_)
  723. }
  724. } else if (kar == U'!') {
  725. nieuwkar;
  726. if (kar == U'=') {
  727. nieuwtok (NE_) /* "!=" = "<>" */
  728. } else {
  729. oudkar;
  730. nieuwtok (NOT_)
  731. }
  732. } else if (kar == U',') {
  733. nieuwtok (KOMMA_)
  734. } else if (kar == U':') {
  735. nieuwtok (COLON_)
  736. } else if (kar == U';') {
  737. nieuwtok (END_)
  738. } else if (kar == U'^') {
  739. nieuwtok (POWER_)
  740. } else if (kar == U'@') {
  741. do {
  742. nieuwkar;
  743. } while (Melder_isHorizontalSpace (kar));
  744. stokaan;
  745. do stokkar while (Melder_isWordCharacter (kar) || kar == U'.');
  746. stokuit;
  747. oudkar;
  748. nieuwtok (CALL_)
  749. lexan [itok]. content.string = Melder_dup_f (token.string).transfer();
  750. numberOfStringConstants ++;
  751. } else if (kar == U'\"') {
  752. /*
  753. * String constant.
  754. */
  755. nieuwkar;
  756. stokaan;
  757. for (;;) {
  758. if (kar == U'\0')
  759. formulefout (U"No closing quote in string constant", ikar);
  760. if (kar == U'\"') {
  761. nieuwkar;
  762. if (kar == U'\"') stokkar
  763. else break;
  764. } else {
  765. stokkar
  766. }
  767. }
  768. stokuit;
  769. oudkar;
  770. nieuwtok (STRING_)
  771. lexan [itok]. content.string = Melder_dup_f (token.string).transfer();
  772. numberOfStringConstants ++;
  773. } else if (kar == U'~') {
  774. /*
  775. The content of the remainder of the line,
  776. including any leading and trailing space,
  777. will become a string constant (this is good for formulas).
  778. */
  779. nieuwkar;
  780. stokaan;
  781. for (;;) {
  782. if (kar == U'\0') break;
  783. stokkar
  784. }
  785. stokuit;
  786. oudkar;
  787. nieuwtok (STRING_)
  788. lexan [itok]. content.string = Melder_dup_f (token.string).transfer();
  789. numberOfStringConstants ++;
  790. } else if (kar == U'|') {
  791. nieuwtok (OR_) /* "|" = "or" */
  792. nieuwkar;
  793. if (kar != U'|') {
  794. oudkar; /* "||" = "or" */
  795. }
  796. } else if (kar == U'&') {
  797. nieuwtok (AND_) /* "&" = "and" */
  798. nieuwkar;
  799. if (kar != U'&') {
  800. oudkar; /* "&&" = "and" */
  801. }
  802. } else if (kar == U'[') {
  803. nieuwtok (RECHTEHAAKOPENEN_)
  804. } else if (kar == U']') {
  805. nieuwtok (RECHTEHAAKSLUITEN_)
  806. } else if (kar == U'{') {
  807. nieuwtok (OPENING_BRACE_)
  808. } else if (kar == U'}') {
  809. nieuwtok (CLOSING_BRACE_)
  810. } else if (kar == U'.') {
  811. nieuwtok (PERIOD_)
  812. } else {
  813. formulefout (U"Unknown symbol", ikar);
  814. }
  815. } while (lexan [itok]. symbol != END_);
  816. }
  817. static void pas (int symbol) {
  818. if (symbol == nieuwlees) {
  819. return; // success
  820. } else {
  821. const conststring32 symbolName1 = Formula_instructionNames [symbol];
  822. const conststring32 symbolName2 = Formula_instructionNames [lexan [ilexan]. symbol];
  823. const bool needQuotes1 = ! str32chr (symbolName1, U' ');
  824. const bool needQuotes2 = ! str32chr (symbolName2, U' ');
  825. static MelderString melding { };
  826. MelderString_copy (& melding,
  827. U"Expected ", ( needQuotes1 ? U"\"" : nullptr ), symbolName1, ( needQuotes1 ? U"\"" : nullptr ),
  828. U", but found ", ( needQuotes2 ? U"\"" : nullptr ), symbolName2, ( needQuotes2 ? U"\"" : nullptr ));
  829. formulefout (melding.string, lexan [ilexan]. position);
  830. }
  831. }
  832. static bool pasArguments () {
  833. int symbol = nieuwlees;
  834. if (symbol == HAAKJEOPENEN_) return true; // success: a function call like: myFunction (...)
  835. if (symbol == COLON_) return false; // success: a function call like: myFunction: ...
  836. const conststring32 symbolName2 = Formula_instructionNames [lexan [ilexan]. symbol];
  837. bool needQuotes2 = ! str32chr (symbolName2, U' ');
  838. static MelderString melding { };
  839. MelderString_copy (& melding,
  840. U"Expected \"(\" or \":\", but found ", ( needQuotes2 ? U"\"" : nullptr ), symbolName2, ( needQuotes2 ? U"\"" : nullptr ));
  841. formulefout (melding.string, lexan [ilexan]. position);
  842. return false; // will never occur
  843. }
  844. #define nieuwontleed(s) parse [++ iparse]. symbol = (s)
  845. #define parsenumber(g) parse [iparse]. content.number = (g)
  846. #define ontleedlabel(l) parse [iparse]. content.label = (l)
  847. static void parseExpression ();
  848. static void parsePowerFactor () {
  849. int symbol = nieuwlees;
  850. if (symbol >= LOW_VALUE && symbol <= HIGH_VALUE) {
  851. nieuwontleed (symbol);
  852. if (symbol == NUMBER_) parsenumber (lexan [ilexan]. content.number);
  853. return;
  854. }
  855. if (symbol == STRING_) {
  856. nieuwontleed (symbol);
  857. parse [iparse]. content.string = lexan [ilexan]. content.string; // reference copy!
  858. return;
  859. }
  860. if (symbol == NUMERIC_VARIABLE_ || symbol == STRING_VARIABLE_) {
  861. nieuwontleed (symbol);
  862. parse [iparse]. content.variable = lexan [ilexan]. content.variable;
  863. return;
  864. }
  865. if (symbol == INDEXED_NUMERIC_VARIABLE_ || symbol == INDEXED_STRING_VARIABLE_) {
  866. char32 *var = lexan [ilexan]. content.string; // Save before incrementing ilexan.
  867. if (nieuwlees == RECHTEHAAKOPENEN_) {
  868. int n = 0;
  869. if (nieuwlees != RECHTEHAAKSLUITEN_) {
  870. oudlees;
  871. parseExpression ();
  872. n ++;
  873. while (nieuwlees == KOMMA_) {
  874. parseExpression ();
  875. n ++;
  876. }
  877. oudlees;
  878. pas (RECHTEHAAKSLUITEN_);
  879. }
  880. nieuwontleed (NUMBER_); parsenumber (n);
  881. nieuwontleed (symbol);
  882. } else {
  883. Melder_fatal (U"Formula:parsePowerFactor (indexed variable): No '['; cannot happen.");
  884. }
  885. parse [iparse]. content.string = var;
  886. return;
  887. }
  888. if (symbol == NUMERIC_VECTOR_VARIABLE_) {
  889. InterpreterVariable var = lexan [ilexan]. content.variable; // save before incrementing ilexan
  890. if (nieuwlees == RECHTEHAAKOPENEN_) {
  891. parseExpression ();
  892. pas (RECHTEHAAKSLUITEN_);
  893. nieuwontleed (NUMERIC_VECTOR_ELEMENT_);
  894. } else {
  895. oudlees;
  896. nieuwontleed (NUMERIC_VECTOR_VARIABLE_);
  897. }
  898. parse [iparse]. content.variable = var;
  899. return;
  900. }
  901. if (symbol == NUMERIC_MATRIX_VARIABLE_) {
  902. InterpreterVariable var = lexan [ilexan]. content.variable; // save before incrementing ilexan
  903. if (nieuwlees == RECHTEHAAKOPENEN_) {
  904. parseExpression ();
  905. pas (KOMMA_);
  906. parseExpression ();
  907. pas (RECHTEHAAKSLUITEN_);
  908. nieuwontleed (NUMERIC_MATRIX_ELEMENT_);
  909. } else {
  910. oudlees;
  911. nieuwontleed (NUMERIC_MATRIX_VARIABLE_);
  912. }
  913. parse [iparse]. content.variable = var;
  914. return;
  915. }
  916. if (symbol == VARIABLE_NAME_) {
  917. InterpreterVariable var = Interpreter_hasVariable (theInterpreter, lexan [ilexan]. content.string);
  918. if (! var)
  919. formulefout (U"Unknown variable", lexan [ilexan]. position);
  920. nieuwontleed (NUMERIC_VARIABLE_);
  921. parse [iparse]. content.variable = var;
  922. return;
  923. }
  924. if (symbol == SELF_) {
  925. symbol = nieuwlees;
  926. if (symbol == RECHTEHAAKOPENEN_) {
  927. parseExpression ();
  928. if (nieuwlees == KOMMA_) {
  929. parseExpression ();
  930. nieuwontleed (SELFMATRIKS2_);
  931. pas (RECHTEHAAKSLUITEN_);
  932. return;
  933. }
  934. oudlees;
  935. nieuwontleed (SELFMATRIKS1_);
  936. pas (RECHTEHAAKSLUITEN_);
  937. return;
  938. }
  939. if (symbol == HAAKJEOPENEN_) {
  940. parseExpression ();
  941. if (nieuwlees == KOMMA_) {
  942. parseExpression ();
  943. nieuwontleed (SELFFUNKTIE2_);
  944. pas (HAAKJESLUITEN_);
  945. return;
  946. }
  947. oudlees;
  948. nieuwontleed (SELFFUNKTIE1_);
  949. pas (HAAKJESLUITEN_);
  950. return;
  951. }
  952. oudlees;
  953. nieuwontleed (SELF0_);
  954. return;
  955. }
  956. if (symbol == SELFSTR_) {
  957. symbol = nieuwlees;
  958. if (symbol == RECHTEHAAKOPENEN_) {
  959. parseExpression ();
  960. if (nieuwlees == KOMMA_) {
  961. parseExpression ();
  962. nieuwontleed (SELFMATRIKSSTR2_);
  963. pas (RECHTEHAAKSLUITEN_);
  964. return;
  965. }
  966. oudlees;
  967. nieuwontleed (SELFMATRIKSSTR1_);
  968. pas (RECHTEHAAKSLUITEN_);
  969. return;
  970. }
  971. if (symbol == HAAKJEOPENEN_) {
  972. parseExpression ();
  973. if (nieuwlees == KOMMA_) {
  974. parseExpression ();
  975. nieuwontleed (SELFFUNKTIESTR2_);
  976. pas (HAAKJESLUITEN_);
  977. return;
  978. }
  979. oudlees;
  980. nieuwontleed (SELFFUNKTIESTR1_);
  981. pas (HAAKJESLUITEN_);
  982. return;
  983. }
  984. oudlees;
  985. nieuwontleed (SELFSTR0_);
  986. return;
  987. }
  988. if (symbol == OBJECT_) {
  989. symbol = nieuwlees;
  990. if (symbol == RECHTEHAAKOPENEN_) {
  991. parseExpression (); // the object's name or ID
  992. nieuwontleed (TO_OBJECT_);
  993. if (nieuwlees == RECHTEHAAKSLUITEN_) {
  994. symbol = nieuwlees;
  995. if (symbol == PERIOD_) {
  996. switch (nieuwlees) {
  997. case XMIN_:
  998. nieuwontleed (OBJECT_XMIN_);
  999. return;
  1000. case XMAX_:
  1001. nieuwontleed (OBJECT_XMAX_);
  1002. return;
  1003. case YMIN_:
  1004. nieuwontleed (OBJECT_YMIN_);
  1005. return;
  1006. case YMAX_:
  1007. nieuwontleed (OBJECT_YMAX_);
  1008. return;
  1009. case NX_:
  1010. nieuwontleed (OBJECT_NX_);
  1011. return;
  1012. case NY_:
  1013. nieuwontleed (OBJECT_NY_);
  1014. return;
  1015. case DX_:
  1016. nieuwontleed (OBJECT_DX_);
  1017. return;
  1018. case DY_:
  1019. nieuwontleed (OBJECT_DY_);
  1020. return;
  1021. case NROW_:
  1022. nieuwontleed (OBJECT_NROW_);
  1023. return;
  1024. case NCOL_:
  1025. nieuwontleed (OBJECT_NCOL_);
  1026. return;
  1027. case ROWSTR_:
  1028. pas (RECHTEHAAKOPENEN_);
  1029. parseExpression ();
  1030. nieuwontleed (OBJECT_ROWSTR_);
  1031. pas (RECHTEHAAKSLUITEN_);
  1032. return;
  1033. case COLSTR_:
  1034. pas (RECHTEHAAKOPENEN_);
  1035. parseExpression ();
  1036. nieuwontleed (OBJECT_COLSTR_);
  1037. pas (RECHTEHAAKSLUITEN_);
  1038. return;
  1039. default:
  1040. formulefout (U"After \"object [number].\" there should be \"xmin\", \"xmax\", \"ymin\", "
  1041. "\"ymax\", \"nx\", \"ny\", \"dx\", \"dy\", \"nrow\" or \"ncol\"", lexan [ilexan]. position);
  1042. }
  1043. } else if (symbol == RECHTEHAAKOPENEN_) {
  1044. parseExpression ();
  1045. if (nieuwlees == KOMMA_) {
  1046. parseExpression ();
  1047. nieuwontleed (OBJECTCELL2_);
  1048. pas (RECHTEHAAKSLUITEN_);
  1049. } else {
  1050. oudlees;
  1051. nieuwontleed (OBJECTCELL1_);
  1052. pas (RECHTEHAAKSLUITEN_);
  1053. }
  1054. } else {
  1055. oudlees;
  1056. nieuwontleed (OBJECTCELL0_);
  1057. }
  1058. } else {
  1059. oudlees;
  1060. pas (KOMMA_);
  1061. parseExpression ();
  1062. if (nieuwlees == KOMMA_) {
  1063. parseExpression ();
  1064. nieuwontleed (OBJECTCELL2_);
  1065. pas (RECHTEHAAKSLUITEN_);
  1066. } else {
  1067. oudlees;
  1068. nieuwontleed (OBJECTCELL1_);
  1069. pas (RECHTEHAAKSLUITEN_);
  1070. }
  1071. }
  1072. } else if (symbol == HAAKJEOPENEN_) {
  1073. parseExpression (); // the object's name or ID
  1074. nieuwontleed (TO_OBJECT_);
  1075. if (nieuwlees == HAAKJESLUITEN_) {
  1076. nieuwontleed (OBJECTLOCATION0_);
  1077. } else {
  1078. oudlees;
  1079. pas (KOMMA_);
  1080. parseExpression ();
  1081. if (nieuwlees == KOMMA_) {
  1082. parseExpression ();
  1083. nieuwontleed (OBJECTLOCATION2_);
  1084. pas (HAAKJESLUITEN_);
  1085. } else {
  1086. oudlees;
  1087. nieuwontleed (OBJECTLOCATION1_);
  1088. pas (HAAKJESLUITEN_);
  1089. }
  1090. }
  1091. } else {
  1092. formulefout (U"After \"object\" there should be \"(\" or \"[\"", lexan [ilexan]. position);
  1093. }
  1094. return;
  1095. }
  1096. if (symbol == OBJECTSTR_) {
  1097. symbol = nieuwlees;
  1098. if (symbol == RECHTEHAAKOPENEN_) {
  1099. parseExpression (); // the object's name or ID
  1100. nieuwontleed (TO_OBJECT_);
  1101. if (nieuwlees == RECHTEHAAKSLUITEN_) {
  1102. nieuwontleed (OBJECTCELLSTR0_);
  1103. } else {
  1104. oudlees;
  1105. pas (KOMMA_);
  1106. parseExpression ();
  1107. if (nieuwlees == KOMMA_) {
  1108. parseExpression ();
  1109. nieuwontleed (OBJECTCELLSTR2_);
  1110. pas (RECHTEHAAKSLUITEN_);
  1111. } else {
  1112. oudlees;
  1113. nieuwontleed (OBJECTCELLSTR1_);
  1114. pas (RECHTEHAAKSLUITEN_);
  1115. }
  1116. }
  1117. } else if (symbol == HAAKJEOPENEN_) {
  1118. parseExpression (); // the object's name or ID
  1119. nieuwontleed (TO_OBJECT_);
  1120. if (nieuwlees == HAAKJESLUITEN_) {
  1121. nieuwontleed (OBJECTLOCATIONSTR0_);
  1122. } else {
  1123. oudlees;
  1124. pas (KOMMA_);
  1125. parseExpression ();
  1126. if (nieuwlees == KOMMA_) {
  1127. parseExpression ();
  1128. nieuwontleed (OBJECTLOCATIONSTR2_);
  1129. pas (HAAKJESLUITEN_);
  1130. } else {
  1131. oudlees;
  1132. nieuwontleed (OBJECTLOCATIONSTR1_);
  1133. pas (HAAKJESLUITEN_);
  1134. }
  1135. }
  1136. } else {
  1137. formulefout (U"After \"object$\" there should be \"(\" or \"[\"", lexan [ilexan]. position);
  1138. }
  1139. return;
  1140. }
  1141. if (symbol == HAAKJEOPENEN_) {
  1142. parseExpression ();
  1143. pas (HAAKJESLUITEN_);
  1144. return;
  1145. }
  1146. if (symbol == IF_) {
  1147. int elseLabel = nieuwlabel; // has to be local,
  1148. int endifLabel = nieuwlabel; // because of recursion
  1149. parseExpression ();
  1150. nieuwontleed (IFFALSE_); ontleedlabel (elseLabel);
  1151. pas (THEN_);
  1152. parseExpression ();
  1153. nieuwontleed (GOTO_); ontleedlabel (endifLabel);
  1154. pas (ELSE_);
  1155. nieuwontleed (LABEL_); ontleedlabel (elseLabel);
  1156. parseExpression ();
  1157. pas (ENDIF_);
  1158. nieuwontleed (LABEL_); ontleedlabel (endifLabel);
  1159. return;
  1160. }
  1161. if (symbol == MATRIKS_) {
  1162. Daata thee = lexan [ilexan]. content.object;
  1163. Melder_assert (thee != nullptr);
  1164. symbol = nieuwlees;
  1165. if (symbol == RECHTEHAAKOPENEN_) {
  1166. if (nieuwlees == RECHTEHAAKSLUITEN_) {
  1167. nieuwontleed (MATRIKS0_);
  1168. parse [iparse]. content.object = thee;
  1169. } else {
  1170. oudlees;
  1171. parseExpression ();
  1172. if (nieuwlees == KOMMA_) {
  1173. parseExpression ();
  1174. nieuwontleed (MATRIKS2_);
  1175. parse [iparse]. content.object = thee;
  1176. pas (RECHTEHAAKSLUITEN_);
  1177. } else {
  1178. oudlees;
  1179. nieuwontleed (MATRIKS1_);
  1180. parse [iparse]. content.object = thee;
  1181. pas (RECHTEHAAKSLUITEN_);
  1182. }
  1183. }
  1184. } else if (symbol == HAAKJEOPENEN_) {
  1185. if (nieuwlees == HAAKJESLUITEN_) {
  1186. nieuwontleed (FUNKTIE0_);
  1187. parse [iparse]. content.object = thee;
  1188. } else {
  1189. oudlees;
  1190. parseExpression ();
  1191. if (nieuwlees == KOMMA_) {
  1192. parseExpression ();
  1193. nieuwontleed (FUNKTIE2_);
  1194. parse [iparse]. content.object = thee;
  1195. pas (HAAKJESLUITEN_);
  1196. } else {
  1197. oudlees;
  1198. nieuwontleed (FUNKTIE1_);
  1199. parse [iparse]. content.object = thee;
  1200. pas (HAAKJESLUITEN_);
  1201. }
  1202. }
  1203. } else if (symbol == PERIOD_) {
  1204. switch (nieuwlees) {
  1205. case XMIN_:
  1206. if (! thy v_hasGetXmin ()) {
  1207. formulefout (U"Attribute \"xmin\" not defined for this object", lexan [ilexan]. position);
  1208. } else {
  1209. nieuwontleed (NUMBER_);
  1210. parsenumber (thy v_getXmin ());
  1211. return;
  1212. }
  1213. case XMAX_:
  1214. if (! thy v_hasGetXmax ()) {
  1215. formulefout (U"Attribute \"xmax\" not defined for this object", lexan [ilexan]. position);
  1216. } else {
  1217. nieuwontleed (NUMBER_);
  1218. parsenumber (thy v_getXmax ());
  1219. return;
  1220. }
  1221. case YMIN_:
  1222. if (! thy v_hasGetYmin ()) {
  1223. formulefout (U"Attribute \"ymin\" not defined for this object", lexan [ilexan]. position);
  1224. } else {
  1225. nieuwontleed (NUMBER_);
  1226. parsenumber (thy v_getYmin ());
  1227. return;
  1228. }
  1229. case YMAX_:
  1230. if (! thy v_hasGetYmax ()) {
  1231. formulefout (U"Attribute \"ymax\" not defined for this object", lexan [ilexan]. position);
  1232. } else {
  1233. nieuwontleed (NUMBER_);
  1234. parsenumber (thy v_getYmax ());
  1235. return;
  1236. }
  1237. case NX_:
  1238. if (! thy v_hasGetNx ()) {
  1239. formulefout (U"Attribute \"nx\" not defined for this object", lexan [ilexan]. position);
  1240. } else {
  1241. nieuwontleed (NUMBER_);
  1242. parsenumber (thy v_getNx ());
  1243. return;
  1244. }
  1245. case NY_:
  1246. if (! thy v_hasGetNy ()) {
  1247. formulefout (U"Attribute \"ny\" not defined for this object", lexan [ilexan]. position);
  1248. } else {
  1249. nieuwontleed (NUMBER_);
  1250. parsenumber (thy v_getNy ());
  1251. return;
  1252. }
  1253. case DX_:
  1254. if (! thy v_hasGetDx ()) {
  1255. formulefout (U"Attribute \"dx\" not defined for this object", lexan [ilexan]. position);
  1256. } else {
  1257. nieuwontleed (NUMBER_);
  1258. parsenumber (thy v_getDx ());
  1259. return;
  1260. }
  1261. case DY_:
  1262. if (! thy v_hasGetDy ()) {
  1263. formulefout (U"Attribute \"dy\" not defined for this object", lexan [ilexan]. position);
  1264. } else {
  1265. nieuwontleed (NUMBER_);
  1266. parsenumber (thy v_getDy ());
  1267. return;
  1268. }
  1269. case NCOL_:
  1270. if (! thy v_hasGetNcol ()) {
  1271. formulefout (U"Attribute \"ncol\" not defined for this object", lexan [ilexan]. position);
  1272. } else {
  1273. nieuwontleed (NUMBER_);
  1274. parsenumber (thy v_getNcol ());
  1275. return;
  1276. }
  1277. case NROW_:
  1278. if (! thy v_hasGetNrow ()) {
  1279. formulefout (U"Attribute \"nrow\" not defined for this object", lexan [ilexan]. position);
  1280. } else {
  1281. nieuwontleed (NUMBER_);
  1282. parsenumber (thy v_getNrow ());
  1283. return;
  1284. }
  1285. case ROWSTR_:
  1286. if (! thy v_hasGetRowStr ()) {
  1287. formulefout (U"Attribute \"row$\" not defined for this object", lexan [ilexan]. position);
  1288. } else {
  1289. pas (RECHTEHAAKOPENEN_);
  1290. parseExpression ();
  1291. nieuwontleed (ROWSTR_);
  1292. parse [iparse]. content.object = thee;
  1293. pas (RECHTEHAAKSLUITEN_);
  1294. return;
  1295. }
  1296. case COLSTR_:
  1297. if (! thy v_hasGetColStr ()) {
  1298. formulefout (U"Attribute \"col$\" not defined for this object", lexan [ilexan]. position);
  1299. } else {
  1300. pas (RECHTEHAAKOPENEN_);
  1301. parseExpression ();
  1302. nieuwontleed (COLSTR_);
  1303. parse [iparse]. content.object = thee;
  1304. pas (RECHTEHAAKSLUITEN_);
  1305. return;
  1306. }
  1307. default: formulefout (U"Unknown attribute.", lexan [ilexan]. position);
  1308. }
  1309. } else {
  1310. formulefout (U"After a name of a matrix there should be \"(\", \"[\", or \".\"", lexan [ilexan]. position);
  1311. }
  1312. return;
  1313. }
  1314. if (symbol == MATRIKSSTR_) {
  1315. Daata thee = lexan [ilexan]. content.object;
  1316. Melder_assert (thee != nullptr);
  1317. symbol = nieuwlees;
  1318. if (symbol == RECHTEHAAKOPENEN_) {
  1319. if (nieuwlees == RECHTEHAAKSLUITEN_) {
  1320. nieuwontleed (MATRIKSSTR0_);
  1321. parse [iparse]. content.object = thee;
  1322. } else {
  1323. oudlees;
  1324. parseExpression ();
  1325. if (nieuwlees == KOMMA_) {
  1326. parseExpression ();
  1327. nieuwontleed (MATRIKSSTR2_);
  1328. parse [iparse]. content.object = thee;
  1329. pas (RECHTEHAAKSLUITEN_);
  1330. } else {
  1331. oudlees;
  1332. nieuwontleed (MATRIKSSTR1_);
  1333. parse [iparse]. content.object = thee;
  1334. pas (RECHTEHAAKSLUITEN_);
  1335. }
  1336. }
  1337. } else {
  1338. formulefout (U"After a name of a matrix$ there should be \"[\"", lexan [ilexan]. position);
  1339. }
  1340. return;
  1341. }
  1342. if (symbol >= LOW_FUNCTION_1 && symbol <= HIGH_FUNCTION_1) {
  1343. bool isParenthesis = pasArguments ();
  1344. parseExpression ();
  1345. if (isParenthesis) pas (HAAKJESLUITEN_);
  1346. nieuwontleed (symbol);
  1347. return;
  1348. }
  1349. if (symbol >= LOW_FUNCTION_2 && symbol <= HIGH_FUNCTION_2) {
  1350. bool isParenthesis = pasArguments ();
  1351. parseExpression ();
  1352. pas (KOMMA_);
  1353. parseExpression ();
  1354. if (isParenthesis) pas (HAAKJESLUITEN_);
  1355. nieuwontleed (symbol);
  1356. return;
  1357. }
  1358. if (symbol >= LOW_FUNCTION_3 && symbol <= HIGH_FUNCTION_3) {
  1359. bool isParenthesis = pasArguments ();
  1360. parseExpression ();
  1361. pas (KOMMA_);
  1362. parseExpression ();
  1363. pas (KOMMA_);
  1364. parseExpression ();
  1365. if (isParenthesis) pas (HAAKJESLUITEN_);
  1366. nieuwontleed (symbol);
  1367. return;
  1368. }
  1369. if (symbol >= LOW_FUNCTION_N && symbol <= HIGH_FUNCTION_N) {
  1370. int n = 0;
  1371. bool isParenthesis = pasArguments ();
  1372. if (nieuwlees != HAAKJESLUITEN_) {
  1373. oudlees;
  1374. parseExpression ();
  1375. n ++;
  1376. while (nieuwlees == KOMMA_) {
  1377. parseExpression ();
  1378. n ++;
  1379. }
  1380. oudlees;
  1381. if (isParenthesis) pas (HAAKJESLUITEN_);
  1382. }
  1383. nieuwontleed (NUMBER_); parsenumber (n);
  1384. nieuwontleed (symbol);
  1385. return;
  1386. }
  1387. if (symbol == OPENING_BRACE_) {
  1388. parseExpression ();
  1389. int n = 1;
  1390. while (nieuwlees == KOMMA_) {
  1391. parseExpression ();
  1392. n ++;
  1393. }
  1394. oudlees;
  1395. pas (CLOSING_BRACE_);
  1396. nieuwontleed (NUMBER_); parsenumber (n);
  1397. nieuwontleed (TENSOR_LITERAL_);
  1398. return;
  1399. }
  1400. if (symbol == CALL_) {
  1401. char32 *procedureName = lexan [ilexan]. content.string; // reference copy!
  1402. int n = 0;
  1403. bool isParenthesis = pasArguments ();
  1404. if (nieuwlees != HAAKJESLUITEN_) {
  1405. oudlees;
  1406. parseExpression ();
  1407. n ++;
  1408. while (nieuwlees == KOMMA_) {
  1409. parseExpression ();
  1410. n ++;
  1411. }
  1412. oudlees;
  1413. if (isParenthesis) pas (HAAKJESLUITEN_);
  1414. }
  1415. nieuwontleed (NUMBER_); parsenumber (n);
  1416. nieuwontleed (CALL_);
  1417. parse [iparse]. content.string = procedureName;
  1418. return;
  1419. }
  1420. if (symbol >= LOW_STRING_FUNCTION && symbol <= HIGH_STRING_FUNCTION) {
  1421. if (symbol >= LOW_FUNCTION_STR1 && symbol <= HIGH_FUNCTION_STR1) {
  1422. bool isParenthesis = pasArguments ();
  1423. parseExpression ();
  1424. if (isParenthesis) pas (HAAKJESLUITEN_);
  1425. } else if (symbol == INDEX_ || symbol == RINDEX_ ||
  1426. symbol == STARTS_WITH_ || symbol == ENDS_WITH_ ||
  1427. symbol == INDEX_REGEX_ || symbol == RINDEX_REGEX_ || symbol == EXTRACT_NUMBER_)
  1428. {
  1429. bool isParenthesis = pasArguments ();
  1430. parseExpression ();
  1431. pas (KOMMA_);
  1432. parseExpression ();
  1433. if (isParenthesis) pas (HAAKJESLUITEN_);
  1434. } else if (symbol == DATESTR_ || symbol == INFOSTR_) {
  1435. pas (HAAKJEOPENEN_);
  1436. pas (HAAKJESLUITEN_);
  1437. } else if (symbol == EXTRACT_WORDSTR_ || symbol == EXTRACT_LINESTR_) {
  1438. bool isParenthesis = pasArguments ();
  1439. parseExpression ();
  1440. pas (KOMMA_);
  1441. parseExpression ();
  1442. if (isParenthesis) pas (HAAKJESLUITEN_);
  1443. } else if (symbol == FIXEDSTR_ || symbol == PERCENTSTR_ || symbol == HEXADECIMALSTR_) {
  1444. bool isParenthesis = pasArguments ();
  1445. parseExpression ();
  1446. pas (KOMMA_);
  1447. parseExpression ();
  1448. if (isParenthesis) pas (HAAKJESLUITEN_);
  1449. } else if (symbol == REPLACESTR_ || symbol == REPLACE_REGEXSTR_) {
  1450. bool isParenthesis = pasArguments ();
  1451. parseExpression ();
  1452. pas (KOMMA_);
  1453. parseExpression ();
  1454. pas (KOMMA_);
  1455. parseExpression ();
  1456. pas (KOMMA_);
  1457. parseExpression ();
  1458. if (isParenthesis) pas (HAAKJESLUITEN_);
  1459. } else {
  1460. oudlees; // needed for retry if we are going to be in a string comparison?
  1461. formulefout (U"Function expected", lexan [ilexan + 1]. position);
  1462. }
  1463. nieuwontleed (symbol);
  1464. return;
  1465. }
  1466. if (symbol >= LOW_RANGE_FUNCTION && symbol <= HIGH_RANGE_FUNCTION) {
  1467. if (symbol == SUM_OVER_) {
  1468. //theOptimize = 1;
  1469. nieuwontleed (NUMBER_); parsenumber (0.0); // initialize the sum
  1470. bool isParenthesis = pasArguments ();
  1471. int symbol2 = nieuwlees;
  1472. if (symbol2 == NUMERIC_VARIABLE_) { // an existing variable
  1473. nieuwontleed (VARIABLE_REFERENCE_);
  1474. InterpreterVariable loopVariable = lexan [ilexan]. content.variable;
  1475. parse [iparse]. content.variable = loopVariable;
  1476. } else if (symbol2 == VARIABLE_NAME_) { // a new variable
  1477. InterpreterVariable loopVariable = Interpreter_lookUpVariable (theInterpreter, lexan [ilexan]. content.string);
  1478. nieuwontleed (VARIABLE_REFERENCE_);
  1479. parse [iparse]. content.variable = loopVariable;
  1480. } else {
  1481. formulefout (U"Numeric variable expected", lexan [ilexan]. position);
  1482. }
  1483. // now on stack: sum, loop variable
  1484. if (nieuwlees == FROM_) {
  1485. parseExpression ();
  1486. } else {
  1487. oudlees;
  1488. nieuwontleed (NUMBER_); parsenumber (1.0);
  1489. }
  1490. nieuwontleed (DECREMENT_AND_ASSIGN_); // this pushes the variable back on the stack
  1491. // now on stack: sum, loop variable
  1492. pas (TO_);
  1493. parseExpression ();
  1494. // now on stack: sum, loop variable, end value
  1495. int startLabel = nieuwlabel;
  1496. int endLabel = nieuwlabel;
  1497. nieuwontleed (LABEL_); ontleedlabel (startLabel);
  1498. nieuwontleed (INCREMENT_GREATER_GOTO_); ontleedlabel (endLabel);
  1499. pas (KOMMA_);
  1500. parseExpression ();
  1501. if (isParenthesis) pas (HAAKJESLUITEN_);
  1502. // now on stack: sum, loop variable, end value, value to add
  1503. nieuwontleed (ADD_3DOWN_);
  1504. // now on stack: sum, loop variable, end value
  1505. nieuwontleed (GOTO_); ontleedlabel (startLabel);
  1506. nieuwontleed (LABEL_); ontleedlabel (endLabel);
  1507. nieuwontleed (POP_2_);
  1508. // now on stack: sum
  1509. return;
  1510. }
  1511. }
  1512. if (symbol == STOPWATCH_) {
  1513. nieuwontleed (symbol);
  1514. return;
  1515. }
  1516. oudlees; // needed for retry if we are going to be in a string comparison
  1517. formulefout (U"Symbol misplaced", lexan [ilexan + 1]. position);
  1518. }
  1519. static void parseFactor ();
  1520. static void parsePowerFactors () {
  1521. if (nieuwlees == POWER_) {
  1522. if (ilexan > 2 && lexan [ilexan - 2]. symbol == MINUS_ && lexan [ilexan - 1]. symbol == NUMBER_) {
  1523. oudlees;
  1524. formulefout (U"Expressions like -3^4 are ambiguous; use (-3)^4 or -(3^4) or -(3)^4", lexan [ilexan + 1]. position);
  1525. }
  1526. parseFactor (); // like a^-b
  1527. nieuwontleed (POWER_);
  1528. }
  1529. else
  1530. oudlees;
  1531. }
  1532. static void parseMinus () {
  1533. parsePowerFactor ();
  1534. parsePowerFactors ();
  1535. }
  1536. static void parseFactor () {
  1537. if (nieuwlees == MINUS_) {
  1538. parseFactor (); // there can be multiple consecutive minuses
  1539. nieuwontleed (MINUS_);
  1540. return;
  1541. }
  1542. oudlees;
  1543. parseMinus (); // like -a^b
  1544. }
  1545. static void parseFactors () {
  1546. int sym = nieuwlees; // has to be local, because of recursion
  1547. if (sym == MUL_ || sym == RDIV_ || sym == IDIV_ || sym == MOD_) {
  1548. parseFactor ();
  1549. nieuwontleed (sym);
  1550. parseFactors ();
  1551. }
  1552. else oudlees;
  1553. }
  1554. static void parseTerm () {
  1555. parseFactor ();
  1556. parseFactors ();
  1557. }
  1558. static void parseTerms () {
  1559. int symbol = nieuwlees;
  1560. if (symbol == ADD_ || symbol == SUB_) {
  1561. parseTerm ();
  1562. nieuwontleed (symbol);
  1563. parseTerms ();
  1564. }
  1565. else oudlees;
  1566. }
  1567. static void parseNot () {
  1568. int symbol;
  1569. parseTerm ();
  1570. parseTerms ();
  1571. symbol = nieuwlees;
  1572. if (symbol >= EQ_ && symbol <= GT_) {
  1573. parseTerm ();
  1574. parseTerms ();
  1575. nieuwontleed (symbol);
  1576. }
  1577. else oudlees;
  1578. }
  1579. static void parseAnd () {
  1580. if (nieuwlees == NOT_) {
  1581. parseAnd (); // like not not not
  1582. nieuwontleed (NOT_);
  1583. return;
  1584. }
  1585. oudlees;
  1586. parseNot ();
  1587. }
  1588. static void parseOr () {
  1589. parseAnd ();
  1590. if (nieuwlees == AND_) {
  1591. int falseLabel = nieuwlabel;
  1592. int andLabel = nieuwlabel;
  1593. do {
  1594. nieuwontleed (IFFALSE_); ontleedlabel (falseLabel);
  1595. parseAnd ();
  1596. } while (nieuwlees == AND_);
  1597. nieuwontleed (IFFALSE_); ontleedlabel (falseLabel);
  1598. nieuwontleed (TRUE_);
  1599. nieuwontleed (GOTO_); ontleedlabel (andLabel);
  1600. nieuwontleed (LABEL_); ontleedlabel (falseLabel);
  1601. nieuwontleed (FALSE_);
  1602. nieuwontleed (LABEL_); ontleedlabel (andLabel);
  1603. }
  1604. oudlees;
  1605. }
  1606. static void parseExpression () {
  1607. parseOr ();
  1608. if (nieuwlees == OR_) {
  1609. int trueLabel = nieuwlabel;
  1610. int orLabel = nieuwlabel;
  1611. do {
  1612. nieuwontleed (IFTRUE_); ontleedlabel (trueLabel);
  1613. parseOr ();
  1614. } while (nieuwlees == OR_);
  1615. nieuwontleed (IFTRUE_); ontleedlabel (trueLabel);
  1616. nieuwontleed (FALSE_);
  1617. nieuwontleed (GOTO_); ontleedlabel (orLabel);
  1618. nieuwontleed (LABEL_); ontleedlabel (trueLabel);
  1619. nieuwontleed (TRUE_);
  1620. nieuwontleed (LABEL_); ontleedlabel (orLabel);
  1621. }
  1622. oudlees;
  1623. }
  1624. /*
  1625. Translate the infix expression "my lexan" into the postfix expression "my parse":
  1626. remove parentheses and brackets, commas, colons, FROM_, TO_,
  1627. IF_ THEN_ ELSE_ ENDIF_ OR_ AND_;
  1628. introduce LABEL_ GOTO_ IFTRUE_ IFFALSE_ TRUE_ FALSE_
  1629. SELF0_ SELF1_ SELF2_ MATRIKS0_ MATRIKS1_ MATRIKS2_
  1630. Return:
  1631. 0 if error, otherwise 1.
  1632. Precondition:
  1633. "my lexan" contains an END_ symbol.
  1634. Postconditions:
  1635. *my lexan not changed.
  1636. result == 0 || my parse [my numberOfInstructions]. symbol == END_
  1637. */
  1638. static void Formula_parseExpression () {
  1639. ilabel = ilexan = iparse = 0;
  1640. if (lexan [1]. symbol == END_) Melder_throw (U"Empty formula.");
  1641. parseExpression ();
  1642. pas (END_);
  1643. nieuwontleed (END_);
  1644. numberOfInstructions = iparse;
  1645. }
  1646. static void schuif (int begin, int afstand) {
  1647. numberOfInstructions -= afstand;
  1648. for (int j = begin; j <= numberOfInstructions; j ++)
  1649. parse [j] = parse [j + afstand];
  1650. }
  1651. static int vindLabel (int label) {
  1652. int result = numberOfInstructions;
  1653. while (parse [result]. symbol != LABEL_ ||
  1654. parse [result]. content.label != label)
  1655. result --;
  1656. return result;
  1657. }
  1658. static void Formula_optimizeFlow ()
  1659. /* Vereenvoudig boolse uitdrukkingen. */
  1660. /* Nadien: */
  1661. /* de stroom volgt het kortste pad; */
  1662. /* als de rekenkundige waarden van boolse uitdrukkingen */
  1663. /* in de formule niet voorkomen, zijn alle TRUE_s en FALSE_s weg; */
  1664. /* als in de formule geen NOT_s voorkwamen op rekenkundige */
  1665. /* uitdrukkingen, zijn alle NOT_s weg; */
  1666. /* onbereikbare kode is weg; */
  1667. {
  1668. int i, j, volg;
  1669. for (;;) {
  1670. int verbeterd = 0;
  1671. for (i = 1; i <= numberOfInstructions; i ++)
  1672. {
  1673. /* Optimalisatie 1: */
  1674. /* true goto x -> goto y / __ ... label x iftrue y */
  1675. /* false goto x -> goto y / __ ... label x iffalse y */
  1676. if ((parse [i]. symbol == TRUE_ &&
  1677. parse [i + 1]. symbol == GOTO_ &&
  1678. parse [volg = vindLabel (parse [i + 1]. content.label) + 1]
  1679. . symbol == IFTRUE_)
  1680. ||
  1681. (parse [i]. symbol == FALSE_ &&
  1682. parse [i + 1]. symbol == GOTO_ &&
  1683. parse [volg = vindLabel (parse [i + 1]. content.label) + 1]
  1684. . symbol == IFFALSE_))
  1685. {
  1686. verbeterd = 1;
  1687. parse [i]. symbol = GOTO_;
  1688. parse [i]. content.label = parse [volg]. content.label;
  1689. schuif (i + 1, 1);
  1690. }
  1691. /* Optimalisatie 2: */
  1692. /* true goto x ... label x iffalse y -> */
  1693. /* goto z ... label x iffalse y label z */
  1694. /* en analoog met false en iftrue. */
  1695. if ((parse [i]. symbol == TRUE_ &&
  1696. parse [i + 1]. symbol == GOTO_ &&
  1697. parse [volg = vindLabel (parse [i + 1]. content.label) + 1]
  1698. . symbol == IFFALSE_)
  1699. ||
  1700. (parse [i]. symbol == FALSE_ &&
  1701. parse [i + 1]. symbol == GOTO_ &&
  1702. parse [volg = vindLabel (parse [i + 1]. content.label) + 1]
  1703. . symbol == IFTRUE_))
  1704. {
  1705. verbeterd = 1;
  1706. parse [i]. symbol = GOTO_;
  1707. parse [i]. content.label = nieuwlabel;
  1708. for (j = i + 1; j < volg; j ++)
  1709. parse [j] = parse [j + 1];
  1710. parse [volg]. symbol = LABEL_;
  1711. parse [volg]. content.label = ilabel;
  1712. }
  1713. /* Optimalisatie 3a: */
  1714. /* iftrue x goto y label x -> iffalse y label x */
  1715. if (parse [i]. symbol == IFTRUE_ &&
  1716. parse [i + 1]. symbol == GOTO_ &&
  1717. parse [i + 2]. symbol == LABEL_ &&
  1718. parse [i]. content.label == parse [i + 2]. content.label)
  1719. {
  1720. verbeterd = 1;
  1721. parse [i]. symbol = IFFALSE_;
  1722. parse [i]. content.label = parse [i + 1]. content.label;
  1723. schuif (i + 1, 1);
  1724. }
  1725. /* Optimalisatie 3b: */
  1726. /* iffalse x goto y label x -> iftrue y label x */
  1727. if (parse [i]. symbol == IFFALSE_ &&
  1728. parse [i + 1]. symbol == GOTO_ &&
  1729. parse [i + 2]. symbol == LABEL_ &&
  1730. parse [i]. content.label == parse [i + 2]. content.label)
  1731. {
  1732. verbeterd = 1;
  1733. parse [i]. symbol = IFTRUE_;
  1734. parse [i]. content.label = parse [i + 1]. content.label;
  1735. schuif (i + 1, 1);
  1736. }
  1737. /* Optimalisatie 4: */
  1738. /* verwijder onbereikbare kode: na een GOTO_ hoort een LABEL_. */
  1739. if (parse [i]. symbol == GOTO_ &&
  1740. parse [i + 1]. symbol != LABEL_)
  1741. {
  1742. verbeterd = 1;
  1743. j = i + 2;
  1744. while (parse [j]. symbol != LABEL_) j ++;
  1745. schuif (i + 1, j - i - 1);
  1746. }
  1747. /* Optimalisatie 5: */
  1748. /* goto x -> 0 / __ label x */
  1749. if (parse [i]. symbol == GOTO_ &&
  1750. parse [i]. symbol == LABEL_ &&
  1751. parse [i]. content.label == parse [i + 1]. content.label)
  1752. {
  1753. verbeterd = 1;
  1754. schuif (i, 1);
  1755. }
  1756. /* Optimalisatie 6: */
  1757. /* true iffalse x -> 0 */
  1758. /* false iftrue x -> 0 */
  1759. if ((parse [i]. symbol == TRUE_ && parse [i + 1]. symbol == IFFALSE_)
  1760. || (parse [i]. symbol == FALSE_ && parse [i + 1]. symbol == IFTRUE_))
  1761. {
  1762. verbeterd = 1;
  1763. schuif (i, 2);
  1764. }
  1765. /* Optimalisatie 7: */
  1766. /* true iftrue x -> goto x */
  1767. /* false iffalse x -> goto x */
  1768. if ((parse [i]. symbol == TRUE_ && parse [i + 1]. symbol == IFTRUE_)
  1769. || (parse [i]. symbol == FALSE_ && parse [i + 1]. symbol == IFFALSE_))
  1770. {
  1771. verbeterd = 1;
  1772. parse [i]. symbol = GOTO_;
  1773. parse [i]. content.label = parse [i + 1]. content.label;
  1774. schuif (i + 1, 1);
  1775. }
  1776. /* Optimalisatie 8: */
  1777. /* iftrue x -> iftrue y / __ ... label x goto y */
  1778. /* iffalse x -> iffalse y / __ ... label x goto y */
  1779. if ((parse [i]. symbol == IFTRUE_ || parse [i]. symbol == IFFALSE_)
  1780. && parse [volg = vindLabel (parse [i]. content.label) + 1]. symbol == GOTO_)
  1781. {
  1782. verbeterd = 1;
  1783. parse [i]. content.label = parse [volg]. content.label;
  1784. }
  1785. /* Optimalisatie 9a: */
  1786. /* not iftrue x -> iffalse x */
  1787. if (parse [i]. symbol == NOT_ && parse [i + 1]. symbol == IFTRUE_)
  1788. {
  1789. verbeterd = 1;
  1790. parse [i]. symbol = IFFALSE_;
  1791. parse [i]. content.label = parse [i + 1]. content.label;
  1792. schuif (i + 1, 1);
  1793. }
  1794. /* Optimalisatie 9b: */
  1795. /* not iffalse x -> iftrue x */
  1796. if (parse [i]. symbol == NOT_ && parse [i + 1]. symbol == IFFALSE_)
  1797. {
  1798. verbeterd = 1;
  1799. parse [i]. symbol = IFTRUE_;
  1800. parse [i]. content.label = parse [i + 1]. content.label;
  1801. schuif (i + 1, 1);
  1802. }
  1803. /* De volgende optimalisaties ontbreken want zijn hier overbodig: */
  1804. /* goto x -> goto y / __ ... label x goto y */
  1805. /* trek twee opeenvolgende labels samen */
  1806. } /* for i */
  1807. /* Verwijder labels waar niet naar verwezen wordt. */
  1808. for (i = 1; i <= numberOfInstructions; i ++)
  1809. if (parse [i]. symbol == LABEL_)
  1810. {
  1811. int gevonden = 0;
  1812. for (j = 1; j <= numberOfInstructions; j ++)
  1813. if ((parse [j]. symbol == GOTO_ || parse [j]. symbol == IFFALSE_ || parse [j]. symbol == IFTRUE_
  1814. || parse [j]. symbol == INCREMENT_GREATER_GOTO_)
  1815. && parse [i]. content.label == parse [j]. content.label)
  1816. gevonden = 1;
  1817. if (! gevonden)
  1818. {
  1819. verbeterd = 1;
  1820. schuif (i, 1);
  1821. }
  1822. }
  1823. if (! verbeterd) break;
  1824. }
  1825. }
  1826. static int praat_findObjectById (integer id) {
  1827. int IOBJECT;
  1828. WHERE_DOWN (ID == id)
  1829. return IOBJECT;
  1830. Melder_throw (U"No object with number ", id, U".");
  1831. }
  1832. static int praat_findObjectByName (conststring32 name) {
  1833. int IOBJECT;
  1834. if (*name >= U'A' && *name <= U'Z') {
  1835. static MelderString buffer { };
  1836. MelderString_copy (& buffer, name);
  1837. char32 *spaceLocation = str32chr (buffer.string, U' ');
  1838. if (! spaceLocation)
  1839. Melder_throw (U"Missing space in object name \"", name, U"\".");
  1840. *spaceLocation = U'\0';
  1841. conststring32 className = & buffer.string [0], givenName = spaceLocation + 1;
  1842. WHERE_DOWN (1) {
  1843. Daata object = OBJECT;
  1844. if (str32equ (className, Thing_className (OBJECT)) && str32equ (givenName, object -> name.get()))
  1845. return IOBJECT;
  1846. }
  1847. ClassInfo klas = Thing_classFromClassName (className, nullptr);
  1848. WHERE_DOWN (1) {
  1849. Daata object = OBJECT;
  1850. if (str32equ (klas -> className, Thing_className (OBJECT)) && str32equ (givenName, object -> name.get()))
  1851. return IOBJECT;
  1852. }
  1853. }
  1854. Melder_throw (U"No object with name \"", name, U"\".");
  1855. }
  1856. static void Formula_evaluateConstants () {
  1857. for (;;) {
  1858. bool improved = false;
  1859. for (int i = 1; i <= numberOfInstructions; i ++) {
  1860. int gain = 0;
  1861. if (parse [i]. symbol == NUMBER_) {
  1862. if (parse [i]. content.number == 2.0 && parse [i + 1]. symbol == POWER_)
  1863. { gain = 1; parse [i]. symbol = SQR_; }
  1864. else if (parse [i + 1]. symbol == MINUS_)
  1865. { gain = 1; parse [i]. content.number = - parse [i]. content.number; }
  1866. else if (parse [i + 1]. symbol == SQR_)
  1867. { gain = 1; parse [i]. content.number *= parse [i]. content.number; }
  1868. else if (parse [i + 1]. symbol == NUMBER_) {
  1869. if (parse [i + 2]. symbol == ADD_)
  1870. { gain = 2; parse [i]. content.number += parse [i + 1]. content.number; }
  1871. else if (parse [i + 2]. symbol == SUB_)
  1872. { gain = 2; parse [i]. content.number -= parse [i + 1]. content.number; }
  1873. else if (parse [i + 2]. symbol == MUL_)
  1874. { gain = 2; parse [i]. content.number *= parse [i + 1]. content.number; }
  1875. else if (parse [i + 2]. symbol == RDIV_)
  1876. { gain = 2; parse [i]. content.number /= parse [i + 1]. content.number; }
  1877. } else if (parse [i + 1]. symbol == TO_OBJECT_) {
  1878. parse [i]. symbol = OBJECT_;
  1879. int IOBJECT = praat_findObjectById (Melder_iround (parse [i]. content.number));
  1880. parse [i]. content.object = OBJECT;
  1881. gain = 1;
  1882. }
  1883. } else if (parse [i]. symbol == STRING_) {
  1884. if (parse [i + 1]. symbol == TO_OBJECT_) {
  1885. parse [i]. symbol = OBJECT_;
  1886. int IOBJECT = praat_findObjectByName (parse [i]. content.string);
  1887. parse [i]. content.object = OBJECT;
  1888. gain = 1;
  1889. }
  1890. } else if (parse [i]. symbol == NUMERIC_VARIABLE_) {
  1891. parse [i]. symbol = NUMBER_;
  1892. parse [i]. content.number = parse [i]. content.variable -> numericValue;
  1893. gain = 0;
  1894. improved = true;
  1895. } else if (parse [i]. symbol == STRING_VARIABLE_) {
  1896. parse [i]. symbol = STRING_;
  1897. parse [i]. content.string = parse [i]. content.variable -> stringValue.get(); // again a reference copy (lexan is still the owner)
  1898. gain = 0;
  1899. improved = true;
  1900. #if 0
  1901. } else if (parse [i]. symbol == ROW_) {
  1902. if (parse [i + 1]. symbol == COL_ && parse [i + 2]. symbol == SELFMATRIKS2_)
  1903. { gain = 2; parse [i]. symbol = SELF0_; } // TODO: SELF0_ may not have the same restrictions as SELFMATRIKS2_
  1904. } else if (parse [i]. symbol == COL_) {
  1905. if (parse [i + 1]. symbol == SELFMATRIKS1_)
  1906. { gain = 1; parse [i]. symbol = SELF0_; }
  1907. #endif
  1908. }
  1909. if (gain > 0) {
  1910. improved = true;
  1911. schuif (i + 1, gain);
  1912. }
  1913. }
  1914. if (! improved) break;
  1915. }
  1916. }
  1917. static void Formula_removeLabels () {
  1918. /*
  1919. * First translate symbolic labels (< 0) into instructions locations (> 0).
  1920. */
  1921. for (int i = 1; i <= numberOfInstructions; i ++) {
  1922. int symboli = parse [i]. symbol;
  1923. if (symboli == GOTO_ || symboli == IFTRUE_ || symboli == IFFALSE_ || symboli == INCREMENT_GREATER_GOTO_) {
  1924. int label = parse [i]. content.label;
  1925. for (int j = 1; j <= numberOfInstructions; j ++) {
  1926. if (parse [j]. symbol == LABEL_ && parse [j]. content.label == label) {
  1927. parse [i]. content.label = j;
  1928. }
  1929. }
  1930. }
  1931. }
  1932. /*
  1933. Then remove the labels,
  1934. which have become superfluous.
  1935. */
  1936. if (theOptimize) {
  1937. int i = 1;
  1938. while (i <= numberOfInstructions) {
  1939. int symboli = parse [i]. symbol;
  1940. if (symboli == LABEL_) {
  1941. schuif (i, 1); // remove one label
  1942. for (int j = 1; j <= numberOfInstructions; j ++) {
  1943. int symbolj = parse [j]. symbol;
  1944. if ((symbolj == GOTO_ || symbolj == IFTRUE_ || symbolj == IFFALSE_ || symbolj == INCREMENT_GREATER_GOTO_) && parse [j]. content.label > i)
  1945. parse [j]. content.label --; /* Pas een label aan. */
  1946. }
  1947. i --; // voorkom ophogen i (overbodig?)
  1948. }
  1949. i ++;
  1950. }
  1951. }
  1952. numberOfInstructions --; /* Het END_-symbol hoeft niet geinterpreteerd. */
  1953. }
  1954. #include <inttypes.h>
  1955. /*
  1956. * For debugging.
  1957. */
  1958. static void Formula_print (FormulaInstruction f) {
  1959. int i = 0, symbol;
  1960. do {
  1961. conststring32 instructionName;
  1962. symbol = f [++ i]. symbol;
  1963. instructionName = Formula_instructionNames [symbol];
  1964. if (symbol == NUMBER_)
  1965. Melder_casual (i, U" ", instructionName, U" ", f [i]. content.number);
  1966. else if (symbol == GOTO_ || symbol == IFFALSE_ || symbol == IFTRUE_ || symbol == LABEL_ || symbol == INCREMENT_GREATER_GOTO_)
  1967. Melder_casual (i, U" ", instructionName, U" ", f [i]. content.label);
  1968. else if (symbol == NUMERIC_VARIABLE_)
  1969. Melder_casual (i, U" ", instructionName, U" ", f [i]. content.variable -> string.get(), U" ", f [i]. content.variable -> numericValue);
  1970. else if (symbol == STRING_VARIABLE_)
  1971. Melder_casual (i, U" ", instructionName, U" ", f [i]. content.variable -> string.get(), U" ", f [i]. content.variable -> stringValue.get());
  1972. else if (symbol == STRING_ || symbol == VARIABLE_NAME_ || symbol == INDEXED_NUMERIC_VARIABLE_ || symbol == INDEXED_STRING_VARIABLE_)
  1973. Melder_casual (i, U" ", instructionName, U" ", f [i]. content.string);
  1974. else if (symbol == MATRIKS_ || symbol == MATRIKSSTR_ || symbol == MATRIKS1_ || symbol == MATRIKSSTR1_ ||
  1975. symbol == MATRIKS2_ || symbol == MATRIKSSTR2_ || symbol == ROWSTR_ || symbol == COLSTR_)
  1976. {
  1977. Thing object = f [i]. content.object;
  1978. if (object) {
  1979. Melder_casual (i, U" ", instructionName, U" ", Thing_className (object), U" ", object -> name.get());
  1980. } else {
  1981. Melder_casual (i, U" ", instructionName);
  1982. }
  1983. }
  1984. else if (symbol == CALL_)
  1985. Melder_casual (i, U" ", instructionName, U" ", f [i]. content.string);
  1986. else
  1987. Melder_casual (i, U" ", instructionName);
  1988. } while (symbol != END_);
  1989. }
  1990. void Formula_compile (Interpreter interpreter, Daata data, conststring32 expression, int expressionType, bool optimize) {
  1991. theInterpreter = interpreter;
  1992. if (! theInterpreter) {
  1993. if (! theLocalInterpreter)
  1994. theLocalInterpreter = Interpreter_create (nullptr, nullptr);
  1995. theInterpreter = theLocalInterpreter.get();
  1996. theInterpreter -> variablesMap. clear ();
  1997. }
  1998. theSource = data;
  1999. theExpression = expression;
  2000. theExpressionType [theLevel] = expressionType;
  2001. theOptimize = optimize;
  2002. if (! lexan) {
  2003. lexan = Melder_calloc_f (struct structFormulaInstruction, 3000);
  2004. lexan [3000 - 1]. symbol = END_; // make sure that cleaning up always terminates
  2005. }
  2006. if (! parse)
  2007. parse = Melder_calloc_f (struct structFormulaInstruction, 3000);
  2008. /*
  2009. Clean up strings from the previous call.
  2010. These strings are in a union, that's why this cannot be done later, when a new string is created.
  2011. */
  2012. if (numberOfStringConstants) {
  2013. ilexan = 1;
  2014. for (;;) {
  2015. int symbol = lexan [ilexan]. symbol;
  2016. if (symbol == STRING_ ||
  2017. symbol == VARIABLE_NAME_ ||
  2018. symbol == INDEXED_NUMERIC_VARIABLE_ ||
  2019. symbol == INDEXED_STRING_VARIABLE_ ||
  2020. symbol == CALL_
  2021. ) {
  2022. Melder_free (lexan [ilexan]. content.string);
  2023. }
  2024. else if (symbol == END_) break; // either the end of a formula, or the end of lexan
  2025. ilexan ++;
  2026. }
  2027. numberOfStringConstants = 0;
  2028. }
  2029. Formula_lexan ();
  2030. if (Melder_debug == 17) Formula_print (lexan);
  2031. Formula_parseExpression ();
  2032. if (Melder_debug == 17) Formula_print (parse);
  2033. if (theOptimize) {
  2034. Formula_optimizeFlow ();
  2035. if (Melder_debug == 17) Formula_print (parse);
  2036. Formula_evaluateConstants ();
  2037. if (Melder_debug == 17) Formula_print (parse);
  2038. }
  2039. Formula_removeLabels ();
  2040. if (Melder_debug == 17) Formula_print (parse);
  2041. }
  2042. /*
  2043. Running.
  2044. */
  2045. conststring32 structStackel :: whichText () {
  2046. return
  2047. our which == Stackel_NUMBER ? U"a number" :
  2048. our which == Stackel_NUMERIC_VECTOR ? U"a numeric vector" :
  2049. our which == Stackel_NUMERIC_MATRIX ? U"a numeric matrix" :
  2050. our which == Stackel_STRING ? U"a string" :
  2051. our which == Stackel_STRING_ARRAY ? U"a string array" :
  2052. our which == Stackel_OBJECT ? U"an object" :
  2053. U"???";
  2054. }
  2055. static int programPointer;
  2056. #define Formula_MAXIMUM_STACK_SIZE 1000
  2057. static Stackel theStack;
  2058. static integer w, wmax; /* w = stack pointer; */
  2059. #define pop & theStack [w --]
  2060. #define topOfStack & theStack [w]
  2061. inline static void pushNumber (double x) {
  2062. /* inline runs 10 to 20 percent faster; here's the test script:
  2063. stopwatch
  2064. Create Sound from formula: "test", 1, 0.0, 1000.0, 44100, ~ x + 1 + 2 + 3 + 4 + 5 + 6
  2065. writeInfoLine: stopwatch
  2066. Remove
  2067. * Mac: 3.76 -> 3.20 seconds
  2068. */
  2069. Stackel stackel = & theStack [++ w];
  2070. stackel -> reset();
  2071. if (w > wmax) {
  2072. wmax ++;
  2073. if (wmax > Formula_MAXIMUM_STACK_SIZE)
  2074. Melder_throw (U"Formula: stack overflow. Please simplify your formulas.");
  2075. }
  2076. stackel -> which = Stackel_NUMBER;
  2077. stackel -> number = isdefined (x) ? x : undefined;
  2078. //stackel -> number = x; // this one would be 2 percent faster
  2079. //stackel -> owned = true;
  2080. }
  2081. static void pushNumericVector (autoVEC x) {
  2082. Stackel stackel = & theStack [++ w];
  2083. stackel -> reset();
  2084. if (w > wmax) {
  2085. wmax ++;
  2086. if (wmax > Formula_MAXIMUM_STACK_SIZE)
  2087. Melder_throw (U"Formula: stack overflow. Please simplify your formulas.");
  2088. }
  2089. stackel -> which = Stackel_NUMERIC_VECTOR;
  2090. stackel -> numericVector = x.releaseToAmbiguousOwner();
  2091. stackel -> owned = true;
  2092. }
  2093. static void pushNumericVectorReference (VEC x) {
  2094. Stackel stackel = & theStack [++ w];
  2095. stackel -> reset();
  2096. if (w > wmax) {
  2097. wmax ++;
  2098. if (wmax > Formula_MAXIMUM_STACK_SIZE)
  2099. Melder_throw (U"Formula: stack overflow. Please simplify your formulas.");
  2100. }
  2101. stackel -> which = Stackel_NUMERIC_VECTOR;
  2102. stackel -> numericVector = x;
  2103. stackel -> owned = false;
  2104. }
  2105. static void pushNumericMatrix (autoMAT x) {
  2106. Stackel stackel = & theStack [++ w];
  2107. stackel -> reset();
  2108. if (w > wmax) {
  2109. wmax ++;
  2110. if (wmax > Formula_MAXIMUM_STACK_SIZE)
  2111. Melder_throw (U"Formula: stack overflow. Please simplify your formulas.");
  2112. }
  2113. stackel -> which = Stackel_NUMERIC_MATRIX;
  2114. stackel -> numericMatrix = x.releaseToAmbiguousOwner();
  2115. stackel -> owned = true;
  2116. }
  2117. static void pushNumericMatrixReference (MAT x) {
  2118. Stackel stackel = & theStack [++ w];
  2119. stackel -> reset();
  2120. if (w > wmax) {
  2121. wmax ++;
  2122. if (wmax > Formula_MAXIMUM_STACK_SIZE)
  2123. Melder_throw (U"Formula: stack overflow. Please simplify your formulas.");
  2124. }
  2125. stackel -> which = Stackel_NUMERIC_MATRIX;
  2126. stackel -> numericMatrix = x;
  2127. stackel -> owned = false;
  2128. }
  2129. static void pushString (autostring32 x) {
  2130. Stackel stackel = & theStack [++ w];
  2131. if (w > wmax) {
  2132. wmax ++;
  2133. if (wmax > Formula_MAXIMUM_STACK_SIZE)
  2134. Melder_throw (U"Formula: stack overflow. Please simplify your formulas.");
  2135. }
  2136. stackel -> setString (x.move());
  2137. //stackel -> owned = true;
  2138. }
  2139. static void pushObject (Daata object) {
  2140. Stackel stackel = & theStack [++ w];
  2141. stackel -> reset();
  2142. if (w > wmax) {
  2143. wmax ++;
  2144. if (wmax > Formula_MAXIMUM_STACK_SIZE)
  2145. Melder_throw (U"Formula: stack overflow. Please simplify your formulas.");
  2146. }
  2147. stackel -> which = Stackel_OBJECT;
  2148. stackel -> object = object;
  2149. //stackel -> owned = false;
  2150. }
  2151. static void pushVariable (InterpreterVariable var) {
  2152. Stackel stackel = & theStack [++ w];
  2153. stackel -> reset();
  2154. if (w > wmax) {
  2155. wmax ++;
  2156. if (wmax > Formula_MAXIMUM_STACK_SIZE)
  2157. Melder_throw (U"Formula: stack overflow. Please simplify your formulas.");
  2158. }
  2159. stackel -> which = Stackel_VARIABLE;
  2160. stackel -> variable = var;
  2161. //stackel -> owned = false;
  2162. }
  2163. static void do_not () {
  2164. Stackel x = pop;
  2165. if (x->which == Stackel_NUMBER) {
  2166. pushNumber (isundef (x->number) ? undefined : x->number == 0.0 ? 1.0 : 0.0);
  2167. } else {
  2168. Melder_throw (U"Cannot negate (\"not\") ", x->whichText(), U".");
  2169. }
  2170. }
  2171. static void do_eq () {
  2172. Stackel y = pop, x = pop;
  2173. if (x->which == Stackel_NUMBER && y->which == Stackel_NUMBER) {
  2174. /*
  2175. It is possible that we are comparing a value against --undefined--.
  2176. Any defined value is unequal to --undefined--,
  2177. but any undefined value (inf or NaN) *is* equal to --undefined--.
  2178. Note that this is different from how "==" works in C.
  2179. */
  2180. double xvalue = x->number, yvalue = y->number;
  2181. if (isdefined (xvalue)) {
  2182. if (isdefined (yvalue)) {
  2183. pushNumber (x->number == y->number ? 1.0 : 0.0);
  2184. } else {
  2185. pushNumber (0.0); // defined is not equal to undefined
  2186. }
  2187. } else {
  2188. if (isdefined (yvalue)) {
  2189. pushNumber (0.0); // undefined is not equal to defined
  2190. } else {
  2191. pushNumber (1.0); // undefined is equal to undefined
  2192. }
  2193. }
  2194. } else if (x->which == Stackel_STRING && y->which == Stackel_STRING) {
  2195. double result = str32equ (x->getString(), y->getString()) ? 1.0 : 0.0;
  2196. pushNumber (result);
  2197. } else if (x->which == Stackel_NUMERIC_VECTOR && y->which == Stackel_NUMERIC_VECTOR) {
  2198. pushNumber (NUMequal (x->numericVector, y->numericVector));
  2199. } else if (x->which == Stackel_NUMERIC_MATRIX && y->which == Stackel_NUMERIC_MATRIX) {
  2200. pushNumber (NUMequal (x->numericMatrix, y->numericMatrix));
  2201. } else {
  2202. Melder_throw (U"Cannot compare (=) ", x->whichText(), U" to ", y->whichText(), U".");
  2203. }
  2204. }
  2205. static void do_ne () {
  2206. Stackel y = pop, x = pop;
  2207. if (x->which == Stackel_NUMBER && y->which == Stackel_NUMBER) {
  2208. /*
  2209. Unequal is defined as the opposite of equal.
  2210. */
  2211. double xvalue = x->number, yvalue = y->number;
  2212. if (isdefined (xvalue)) {
  2213. if (isdefined (yvalue)) {
  2214. pushNumber (x->number != y->number ? 1.0 : 0.0);
  2215. } else {
  2216. pushNumber (1.0); // defined is unequal to undefined
  2217. }
  2218. } else {
  2219. if (isdefined (yvalue)) {
  2220. pushNumber (1.0); // undefined is unequal to defined
  2221. } else {
  2222. pushNumber (0.0); // undefined is not unequal to undefined
  2223. }
  2224. }
  2225. } else if (x->which == Stackel_STRING && y->which == Stackel_STRING) {
  2226. double result = str32equ (x->getString(), y->getString()) ? 0.0 : 1.0;
  2227. pushNumber (result);
  2228. } else {
  2229. Melder_throw (U"Cannot compare (<>) ", x->whichText(), U" to ", y->whichText(), U".");
  2230. }
  2231. }
  2232. static void do_le () {
  2233. Stackel y = pop, x = pop;
  2234. if (x->which == Stackel_NUMBER && y->which == Stackel_NUMBER) {
  2235. double xvalue = x->number, yvalue = y->number;
  2236. if (isdefined (xvalue)) {
  2237. if (isdefined (yvalue)) {
  2238. pushNumber (x->number <= y->number ? 1.0 : 0.0);
  2239. } else {
  2240. pushNumber (0.0); // defined is not equal to, nor less than, undefined
  2241. }
  2242. } else {
  2243. if (isdefined (yvalue)) {
  2244. pushNumber (0.0); // undefined is not equal to, nor less than, defined
  2245. } else {
  2246. pushNumber (1.0); // undefined is equal to undefined
  2247. }
  2248. }
  2249. } else if (x->which == Stackel_STRING && y->which == Stackel_STRING) {
  2250. double result = str32cmp (x->getString(), y->getString()) <= 0 ? 1.0 : 0.0;
  2251. pushNumber (result);
  2252. } else {
  2253. Melder_throw (U"Cannot compare (<=) ", x->whichText(), U" to ", y->whichText(), U".");
  2254. }
  2255. }
  2256. static void do_lt () {
  2257. Stackel y = pop, x = pop;
  2258. if (x->which == Stackel_NUMBER && y->which == Stackel_NUMBER) {
  2259. double xvalue = x->number, yvalue = y->number;
  2260. if (isdefined (xvalue)) {
  2261. if (isdefined (yvalue)) {
  2262. pushNumber (x->number < y->number ? 1.0 : 0.0);
  2263. } else {
  2264. pushNumber (0.0); // defined is not less than undefined
  2265. }
  2266. } else {
  2267. if (isdefined (yvalue)) {
  2268. pushNumber (0.0); // undefined is not less than defined
  2269. } else {
  2270. pushNumber (0.0); // undefined is not less than undefined
  2271. }
  2272. }
  2273. } else if (x->which == Stackel_STRING && y->which == Stackel_STRING) {
  2274. double result = str32cmp (x->getString(), y->getString()) < 0 ? 1.0 : 0.0;
  2275. pushNumber (result);
  2276. } else {
  2277. Melder_throw (U"Cannot compare (<) ", x->whichText(), U" to ", y->whichText(), U".");
  2278. }
  2279. }
  2280. static void do_ge () {
  2281. Stackel y = pop, x = pop;
  2282. if (x->which == Stackel_NUMBER && y->which == Stackel_NUMBER) {
  2283. double xvalue = x->number, yvalue = y->number;
  2284. if (isdefined (xvalue)) {
  2285. if (isdefined (yvalue)) {
  2286. pushNumber (x->number >= y->number ? 1.0 : 0.0);
  2287. } else {
  2288. pushNumber (0.0); // defined is not equal to, nor greater than, undefined
  2289. }
  2290. } else {
  2291. if (isdefined (yvalue)) {
  2292. pushNumber (0.0); // undefined is not equal to, nor greater than, defined
  2293. } else {
  2294. pushNumber (1.0); // undefined is equal to undefined
  2295. }
  2296. }
  2297. } else if (x->which == Stackel_STRING && y->which == Stackel_STRING) {
  2298. double result = str32cmp (x->getString(), y->getString()) >= 0 ? 1.0 : 0.0;
  2299. pushNumber (result);
  2300. } else {
  2301. Melder_throw (U"Cannot compare (>=) ", x->whichText(), U" to ", y->whichText(), U".");
  2302. }
  2303. }
  2304. static void do_gt () {
  2305. Stackel y = pop, x = pop;
  2306. if (x->which == Stackel_NUMBER && y->which == Stackel_NUMBER) {
  2307. double xvalue = x->number, yvalue = y->number;
  2308. if (isdefined (xvalue)) {
  2309. if (isdefined (yvalue)) {
  2310. pushNumber (x->number > y->number ? 1.0 : 0.0);
  2311. } else {
  2312. pushNumber (0.0); // defined is not greater than undefined
  2313. }
  2314. } else {
  2315. if (isdefined (yvalue)) {
  2316. pushNumber (0.0); // undefined is not greater than defined
  2317. } else {
  2318. pushNumber (0.0); // undefined is not greater than undefined
  2319. }
  2320. }
  2321. } else if (x->which == Stackel_STRING && y->which == Stackel_STRING) {
  2322. double result = str32cmp (x->getString(), y->getString()) > 0 ? 1.0 : 0.0;
  2323. pushNumber (result);
  2324. } else {
  2325. Melder_throw (U"Cannot compare (>) ", x->whichText(), U" to ", y->whichText(), U".");
  2326. }
  2327. }
  2328. inline static void moveNumericVector (Stackel from, Stackel to) {
  2329. //Melder_assert (from -> owned);
  2330. //Melder_assert (to -> which == Stackel_NUMERIC_VECTOR);
  2331. from -> owned = false;
  2332. to -> numericVector = from -> numericVector;
  2333. to -> owned = true;
  2334. }
  2335. inline static void moveNumericMatrix (Stackel from, Stackel to) {
  2336. //Melder_assert (from -> owned);
  2337. //Melder_assert (to -> which == Stackel_NUMERIC_MATRIX);
  2338. from -> owned = false;
  2339. to -> numericMatrix = from -> numericMatrix;
  2340. to -> owned = true;
  2341. }
  2342. /**
  2343. result.. = x.. + y..
  2344. */
  2345. static void do_add () {
  2346. Stackel y = pop, x = topOfStack;
  2347. if (x->which == Stackel_NUMBER) {
  2348. if (y->which == Stackel_NUMBER) {
  2349. /*@praat
  2350. #
  2351. # result = x + y
  2352. #
  2353. x = 5
  2354. y = 6
  2355. result = x + y
  2356. assert result = 11
  2357. @*/
  2358. x->number += y->number;
  2359. //x->which = Stackel_NUMBER; // superfluous, as is cleaning up
  2360. return;
  2361. }
  2362. if (y->which == Stackel_NUMERIC_VECTOR) {
  2363. /*
  2364. result# = x + y#
  2365. */
  2366. if (y->owned) {
  2367. /*@praat
  2368. #
  2369. # result# = x + owned y#
  2370. #
  2371. result# = 5 + { 11, 13, 31 } ; numeric vector literals are owned
  2372. assert result# = { 16, 18, 36 }
  2373. @*/
  2374. ////VECadd_inplace (y->numericVector, x->number);
  2375. y->numericVector += x->number;
  2376. // x does not have to be cleaned up, because it was a number
  2377. moveNumericVector (y, x);
  2378. } else {
  2379. /*@praat
  2380. #
  2381. # result# = x + unowned y#
  2382. #
  2383. y# = { 17, -11, 29 }
  2384. result# = 30 + y# ; numeric vector variables are not owned
  2385. assert result# = { 47, 19, 59 }
  2386. @*/
  2387. // x does not have to be cleaned up, because it was a number
  2388. x->numericVector = VECadd (y->numericVector, x->number). releaseToAmbiguousOwner();
  2389. x->owned = true;
  2390. }
  2391. x->which = Stackel_NUMERIC_VECTOR;
  2392. return;
  2393. }
  2394. if (y->which == Stackel_NUMERIC_MATRIX) {
  2395. /*
  2396. result## = x + y##
  2397. */
  2398. if (y->owned) {
  2399. ////MATadd_inplace (y->numericMatrix, x->number);
  2400. y->numericMatrix += x->number;
  2401. // x does not have to be cleaned up, because it was a number
  2402. moveNumericMatrix (y, x);
  2403. } else {
  2404. // x does not have to be cleaned up, because it was a number
  2405. x->numericMatrix = MATadd (y->numericMatrix, x->number). releaseToAmbiguousOwner();
  2406. x->owned = true;
  2407. }
  2408. x->which = Stackel_NUMERIC_MATRIX;
  2409. return;
  2410. }
  2411. }
  2412. if (x->which == Stackel_NUMERIC_VECTOR) {
  2413. if (y->which == Stackel_NUMERIC_VECTOR) {
  2414. /*
  2415. result# = x# + y#
  2416. i.e.
  2417. result# [i] = x# [i] + y# [i]
  2418. */
  2419. integer nx = x->numericVector.size, ny = y->numericVector.size;
  2420. if (nx != ny) {
  2421. /*@praat
  2422. #
  2423. # Error: unequal sizes.
  2424. #
  2425. x# = { 11, 13, 17 }
  2426. y# = { 8, 90 }
  2427. asserterror When adding vectors, their numbers of elements should be equal, instead of 3 and 2.
  2428. result# = x# + y#
  2429. @*/
  2430. Melder_throw (U"When adding vectors, their numbers of elements should be equal, instead of ", nx, U" and ", ny, U".");
  2431. }
  2432. if (x -> owned) {
  2433. /*@praat
  2434. #
  2435. # result# = owned x# + y#
  2436. #
  2437. result# = { 11, 13, 17 } + { 44, 56, 67 } ; owned + owned
  2438. assert result# = { 55, 69, 84 }
  2439. y# = { 3, 2, 89.5 }
  2440. result# = { 11, 13, 17 } + y# ; owned + unowned
  2441. assert result# = { 14, 15, 106.5 }
  2442. @*/
  2443. ////VECadd_inplace (x->numericVector, y->numericVector);
  2444. x->numericVector += y->numericVector;
  2445. } else if (y -> owned) {
  2446. /*@praat
  2447. #
  2448. # result# = unowned x# + owned y#
  2449. #
  2450. x# = { 14, -3, 6.25 }
  2451. result# = x# + { 55, 1, -89 }
  2452. assert result# = { 69, -2, -82.75 }
  2453. @*/
  2454. ////VECadd_inplace (y->numericVector, x->numericVector);
  2455. y->numericVector += x->numericVector;
  2456. // x does not have to be cleaned up, because it was not owned
  2457. moveNumericVector (y, x);
  2458. } else {
  2459. /*@praat
  2460. #
  2461. # result# = unowned x# + unowned y#
  2462. #
  2463. x# = { 14, -33, 6.25 }
  2464. y# = { -33, 17, 9 }
  2465. result# = x# + y#
  2466. assert result# = { -19, -16, 15.25 }
  2467. @*/
  2468. // x does not have to be cleaned up, because it was not owned
  2469. x->numericVector = VECadd (x->numericVector, y->numericVector). releaseToAmbiguousOwner();
  2470. x->owned = true;
  2471. }
  2472. //x->which = Stackel_NUMERIC_VECTOR; // superfluous
  2473. return;
  2474. }
  2475. if (y->which == Stackel_NUMBER) {
  2476. /*
  2477. result# = x# + y
  2478. i.e.
  2479. result# [i] = x# [i] + y
  2480. */
  2481. if (x->owned) {
  2482. ////VECadd_inplace (x->numericVector, y->number);
  2483. x->numericVector += y->number;
  2484. } else {
  2485. // x does not have to be cleaned up, because it was not owned
  2486. x->numericVector = VECadd (x->numericVector, y->number). releaseToAmbiguousOwner();
  2487. x->owned = true;
  2488. }
  2489. //x->which = Stackel_NUMERIC_VECTOR; // superfluous
  2490. return;
  2491. }
  2492. }
  2493. if (x->which == Stackel_NUMERIC_MATRIX) {
  2494. if (y->which == Stackel_NUMERIC_MATRIX) {
  2495. /*
  2496. result## = x## + y##
  2497. i.e.
  2498. result## [i, j] = x## [i, j] + y## [i, j]
  2499. */
  2500. integer xnrow = x->numericMatrix.nrow, xncol = x->numericMatrix.ncol;
  2501. integer ynrow = y->numericMatrix.nrow, yncol = y->numericMatrix.ncol;
  2502. if (xnrow != ynrow)
  2503. Melder_throw (U"When adding matrices, their numbers of rows should be equal, instead of ", xnrow, U" and ", ynrow, U".");
  2504. if (xncol != yncol)
  2505. Melder_throw (U"When adding matrices, their numbers of columns should be equal, instead of ", xncol, U" and ", yncol, U".");
  2506. if (x->owned) {
  2507. ////MATadd_inplace (x->numericMatrix, y->numericMatrix);
  2508. x->numericMatrix += y->numericMatrix;
  2509. } else if (y->owned) {
  2510. ////MATadd_inplace (y->numericMatrix, x->numericMatrix);
  2511. y->numericMatrix += x->numericMatrix;
  2512. // x does not have to be cleaned up, because it was not owned
  2513. moveNumericMatrix (y, x);
  2514. } else {
  2515. // x does not have to be cleaned up, because it was not owned
  2516. x->numericMatrix = MATadd (x->numericMatrix, y->numericMatrix). releaseToAmbiguousOwner();
  2517. x->owned = true;
  2518. }
  2519. //x->which = Stackel_NUMERIC_MATRIX;
  2520. return;
  2521. }
  2522. if (y->which == Stackel_NUMBER) {
  2523. /*
  2524. result## = x## + y
  2525. i.e.
  2526. result## [i, j] = x## [i, j] + y
  2527. */
  2528. if (x->owned) {
  2529. ////MATadd_inplace (x->numericMatrix, y->number);
  2530. x->numericMatrix += y->number;
  2531. } else {
  2532. // x does not have to be cleaned up, because it was not owned
  2533. x->numericMatrix = MATadd (x->numericMatrix, y->number). releaseToAmbiguousOwner();
  2534. x->owned = true;
  2535. }
  2536. //x->which = Stackel_NUMERIC_MATRIX; // superfluous
  2537. return;
  2538. }
  2539. }
  2540. if (x->which == Stackel_STRING && y->which == Stackel_STRING) {
  2541. /*
  2542. result$ = x$ + y$
  2543. */
  2544. integer length1 = str32len (x->getString()), length2 = str32len (y->getString());
  2545. autostring32 result (length1 + length2);
  2546. str32cpy (result.get(), x->getString());
  2547. str32cpy (result.get() + length1, y->getString());
  2548. x->setString (result.move());
  2549. return;
  2550. }
  2551. Melder_throw (U"Cannot add ", y->whichText(), U" to ", x->whichText(), U".");
  2552. }
  2553. static void do_sub () {
  2554. /*
  2555. result.. = x.. - y..
  2556. */
  2557. Stackel y = pop, x = topOfStack;
  2558. if (x->which == Stackel_NUMBER) {
  2559. if (y->which == Stackel_NUMBER) {
  2560. /*
  2561. result = x - y
  2562. */
  2563. x->number -= y->number;
  2564. //x->which = Stackel_NUMBER; // superfluous
  2565. return;
  2566. }
  2567. if (y->which == Stackel_NUMERIC_VECTOR) {
  2568. /*
  2569. result# = x - y#
  2570. */
  2571. if (y->owned) {
  2572. VECsubtractReversed_inplace (y->numericVector, x->number);
  2573. moveNumericVector (y, x);
  2574. } else {
  2575. x->numericVector = VECsubtract (x->number, y->numericVector). releaseToAmbiguousOwner();
  2576. x->owned = true;
  2577. }
  2578. x->which = Stackel_NUMERIC_VECTOR;
  2579. return;
  2580. }
  2581. if (y->which == Stackel_NUMERIC_MATRIX) {
  2582. /*
  2583. result## = x - y##
  2584. */
  2585. if (y->owned) {
  2586. MATsubtractReversed_inplace (y->numericMatrix, x->number);
  2587. moveNumericMatrix (y, x);
  2588. } else {
  2589. x->numericMatrix = MATsubtract (x->number, y->numericMatrix). releaseToAmbiguousOwner();
  2590. x->owned = true;
  2591. }
  2592. x->which = Stackel_NUMERIC_MATRIX;
  2593. return;
  2594. }
  2595. }
  2596. if (x->which == Stackel_NUMERIC_VECTOR) {
  2597. if (y->which == Stackel_NUMERIC_VECTOR) {
  2598. /*
  2599. result# = x# - y#
  2600. i.e.
  2601. result# [i] = x# [i] - y# [i]
  2602. */
  2603. integer nx = x->numericVector.size, ny = y->numericVector.size;
  2604. if (nx != ny)
  2605. Melder_throw (U"When subtracting vectors, their numbers of elements should be equal, instead of ", nx, U" and ", ny, U".");
  2606. if (x -> owned) {
  2607. VECsubtract_inplace (x->numericVector, y->numericVector);
  2608. } else if (y -> owned) {
  2609. VECsubtractReversed_inplace (y->numericVector, x->numericVector);
  2610. moveNumericVector (y, x);
  2611. } else {
  2612. // no clean-up of x required, because x is not owned and has the right type
  2613. x->numericVector = VECsubtract (x->numericVector, y->numericVector). releaseToAmbiguousOwner();
  2614. x->owned = true;
  2615. }
  2616. //x->which = Stackel_NUMERIC_VECTOR; // superfluous
  2617. return;
  2618. }
  2619. if (y->which == Stackel_NUMBER) {
  2620. /*
  2621. result# = x# - y
  2622. i.e.
  2623. result# [i] = x# [i] - y
  2624. */
  2625. if (x->owned) {
  2626. VECsubtract_inplace (x->numericVector, y->number);
  2627. } else {
  2628. x->numericVector = VECsubtract (x->numericVector, y->number). releaseToAmbiguousOwner();
  2629. x->owned = true;
  2630. }
  2631. //x->which = Stackel_NUMERIC_VECTOR; // superfluous
  2632. return;
  2633. }
  2634. }
  2635. if (x->which == Stackel_NUMERIC_MATRIX) {
  2636. if (y->which == Stackel_NUMERIC_MATRIX) {
  2637. integer xnrow = x->numericMatrix.nrow, xncol = x->numericMatrix.ncol;
  2638. integer ynrow = y->numericMatrix.nrow, yncol = y->numericMatrix.ncol;
  2639. if (xnrow != ynrow)
  2640. Melder_throw (U"When subtracting matrices, their numbers of rows should be equal, instead of ", xnrow, U" and ", ynrow, U".");
  2641. if (xncol != yncol)
  2642. Melder_throw (U"When subtracting matrices, their numbers of columns should be equal, instead of ", xncol, U" and ", yncol, U".");
  2643. if (x->owned) {
  2644. MATsubtract_inplace (x->numericMatrix, y->numericMatrix);
  2645. } else if (y->owned) {
  2646. MATsubtractReversed_inplace (y->numericMatrix, x->numericMatrix);
  2647. moveNumericMatrix (y, x);
  2648. } else {
  2649. // no clean-up of x required, because x is not owned and has the right type
  2650. x->numericMatrix = MATsubtract (x->numericMatrix, y->numericMatrix). releaseToAmbiguousOwner();
  2651. x->owned = true;
  2652. }
  2653. //x->which = Stackel_NUMERIC_MATRIX; // superfluous
  2654. return;
  2655. }
  2656. if (y->which == Stackel_NUMBER) {
  2657. if (x->owned) {
  2658. MATsubtract_inplace (x->numericMatrix, y->number);
  2659. } else {
  2660. x->numericMatrix = MATsubtract (x->numericMatrix, y->number). releaseToAmbiguousOwner();
  2661. x->owned = true;
  2662. }
  2663. //x->which = Stackel_NUMERIC_MATRIX; // superfluous
  2664. return;
  2665. }
  2666. }
  2667. if (x->which == Stackel_STRING && y->which == Stackel_STRING) {
  2668. int64 length1 = str32len (x->getString()), length2 = str32len (y->getString()), newlength = length1 - length2;
  2669. autostring32 result;
  2670. if (newlength >= 0 && str32nequ (x->getString() + newlength, y->getString(), length2)) {
  2671. result = autostring32 (newlength);
  2672. str32ncpy (result.get(), x->getString(), newlength);
  2673. } else {
  2674. result = Melder_dup (x->getString());
  2675. }
  2676. x->setString (result.move());
  2677. return;
  2678. }
  2679. Melder_throw (U"Cannot subtract (-) ", y->whichText(), U" from ", x->whichText(), U".");
  2680. }
  2681. static void do_mul () {
  2682. /*
  2683. result.. = x.. * y..
  2684. */
  2685. Stackel y = pop, x = pop;
  2686. if (x->which == Stackel_NUMBER) {
  2687. double xvalue = x->number;
  2688. if (y->which == Stackel_NUMBER) {
  2689. /*
  2690. result = x * y
  2691. */
  2692. double yvalue = y->number;
  2693. pushNumber (xvalue * yvalue);
  2694. return;
  2695. }
  2696. if (y->which == Stackel_NUMERIC_VECTOR) {
  2697. /*
  2698. result# = x * y#
  2699. */
  2700. if (y->owned) {
  2701. VECmultiply_inplace (y->numericVector, xvalue);
  2702. x->which = Stackel_NUMERIC_VECTOR;
  2703. moveNumericVector (y, x);
  2704. w ++;
  2705. } else {
  2706. integer ny = y->numericVector.size;
  2707. autoVEC result { ny, kTensorInitializationType::RAW };
  2708. for (integer i = 1; i <= ny; i ++) {
  2709. double yvalue = y->numericVector [i];
  2710. result [i] = xvalue * yvalue;
  2711. }
  2712. pushNumericVector (result.move());
  2713. }
  2714. return;
  2715. }
  2716. if (y->which == Stackel_NUMERIC_MATRIX) {
  2717. /*
  2718. result## = x * y##
  2719. */
  2720. if (y->owned) {
  2721. MATmultiply_inplace (y->numericMatrix, xvalue);
  2722. x->which = Stackel_NUMERIC_MATRIX;
  2723. moveNumericMatrix (y, x);
  2724. w ++;
  2725. } else {
  2726. integer nrow = y->numericMatrix.nrow, ncol = y->numericMatrix.ncol;
  2727. autoMAT result (nrow, ncol, kTensorInitializationType::RAW);
  2728. for (integer irow = 1; irow <= nrow; irow ++) {
  2729. for (integer icol = 1; icol <= ncol; icol ++) {
  2730. double yvalue = y->numericMatrix [irow] [icol];
  2731. result [irow] [icol] = xvalue * yvalue;
  2732. }
  2733. }
  2734. pushNumericMatrix (result.move());
  2735. }
  2736. return;
  2737. }
  2738. }
  2739. if (x->which == Stackel_NUMERIC_VECTOR && y->which == Stackel_NUMERIC_VECTOR) {
  2740. /*
  2741. result# = x# * y#
  2742. */
  2743. integer nx = x->numericVector.size, ny = y->numericVector.size;
  2744. if (nx != ny)
  2745. Melder_throw (U"When multiplying vectors, their numbers of elements should be equal, instead of ", nx, U" and ", ny, U".");
  2746. autoVEC result { nx, kTensorInitializationType::RAW };
  2747. for (integer i = 1; i <= nx; i ++) {
  2748. double xvalue = x->numericVector [i];
  2749. double yvalue = y->numericVector [i];
  2750. result [i] = xvalue * yvalue;
  2751. }
  2752. pushNumericVector (result.move());
  2753. return;
  2754. }
  2755. Melder_throw (U"Cannot multiply (*) ", x->whichText(), U" by ", y->whichText(), U".");
  2756. }
  2757. static void do_rdiv () {
  2758. Stackel y = pop, x = pop;
  2759. if (x->which == Stackel_NUMBER && y->which == Stackel_NUMBER) {
  2760. pushNumber (x->number / y->number); // result could be inf (1/0) or NaN (0/0), which is OK
  2761. return;
  2762. }
  2763. if (x->which == Stackel_NUMERIC_VECTOR) {
  2764. if (y->which == Stackel_NUMERIC_VECTOR) {
  2765. integer nelem1 = x->numericVector.size, nelem2 = y->numericVector.size;
  2766. if (nelem1 != nelem2)
  2767. Melder_throw (U"When dividing vectors, their numbers of elements should be equal, instead of ", nelem1, U" and ", nelem2, U".");
  2768. autoVEC result { nelem1, kTensorInitializationType::RAW };
  2769. for (integer ielem = 1; ielem <= nelem1; ielem ++)
  2770. result [ielem] = x->numericVector [ielem] / y->numericVector [ielem];
  2771. pushNumericVector (result.move());
  2772. return;
  2773. }
  2774. if (y->which == Stackel_NUMBER) {
  2775. /*
  2776. result# = x# / y
  2777. */
  2778. integer xn = x->numericVector.size;
  2779. autoVEC result { xn, kTensorInitializationType::RAW };
  2780. double yvalue = y->number;
  2781. if (yvalue == 0.0) {
  2782. Melder_throw (U"Cannot divide (/) ", x->whichText(), U" by zero.");
  2783. } else {
  2784. for (integer i = 1; i <= xn; i ++) {
  2785. double xvalue = x->numericVector [i];
  2786. result [i] = xvalue / yvalue;
  2787. }
  2788. }
  2789. pushNumericVector (result.move());
  2790. return;
  2791. }
  2792. }
  2793. Melder_throw (U"Cannot divide (/) ", x->whichText(), U" by ", y->whichText(), U".");
  2794. }
  2795. static void do_idiv () {
  2796. Stackel y = pop, x = pop;
  2797. if (x->which == Stackel_NUMBER && y->which == Stackel_NUMBER) {
  2798. pushNumber (floor (x->number / y->number));
  2799. return;
  2800. }
  2801. Melder_throw (U"Cannot divide (\"div\") ", x->whichText(), U" by ", y->whichText(), U".");
  2802. }
  2803. static void do_mod () {
  2804. Stackel y = pop, x = pop;
  2805. if (x->which == Stackel_NUMBER && y->which == Stackel_NUMBER) {
  2806. pushNumber (x->number - floor (x->number / y->number) * y->number);
  2807. return;
  2808. }
  2809. Melder_throw (U"Cannot divide (\"mod\") ", x->whichText(), U" by ", y->whichText(), U".");
  2810. }
  2811. static void do_minus () {
  2812. Stackel x = pop;
  2813. if (x->which == Stackel_NUMBER) {
  2814. pushNumber (- x->number);
  2815. } else {
  2816. Melder_throw (U"Cannot take the opposite (-) of ", x->whichText(), U".");
  2817. }
  2818. }
  2819. static void do_power () {
  2820. Stackel y = pop, x = pop;
  2821. if (x->which == Stackel_NUMBER && y->which == Stackel_NUMBER) {
  2822. pushNumber (isundef (x->number) || isundef (y->number) ? undefined : pow (x->number, y->number));
  2823. } else {
  2824. Melder_throw (U"Cannot exponentiate (^) ", x->whichText(), U" to ", y->whichText(), U".");
  2825. }
  2826. }
  2827. static void do_sqr () {
  2828. Stackel x = pop;
  2829. if (x->which == Stackel_NUMBER) {
  2830. pushNumber (isundef (x->number) ? undefined : x->number * x->number);
  2831. } else {
  2832. Melder_throw (U"Cannot take the square (^ 2) of ", x->whichText(), U".");
  2833. }
  2834. }
  2835. static void do_function_n_n (double (*f) (double)) {
  2836. Stackel x = pop;
  2837. if (x->which == Stackel_NUMBER) {
  2838. pushNumber (isundef (x->number) ? undefined : f (x->number));
  2839. } else {
  2840. Melder_throw (U"The function ", Formula_instructionNames [parse [programPointer]. symbol],
  2841. U" requires a numeric argument, not ", x->whichText(), U".");
  2842. }
  2843. }
  2844. static void do_functionvec_n_n (double (*f) (double)) {
  2845. Stackel x = & theStack [w];
  2846. if (x->which == Stackel_NUMERIC_VECTOR) {
  2847. integer n = x->numericVector.size;
  2848. double *at = x->numericVector.at;
  2849. if (x->owned) {
  2850. for (integer i = 1; i <= n; i ++)
  2851. at [i] = f (at [i]);
  2852. } else {
  2853. autoVEC result { n, kTensorInitializationType::RAW };
  2854. for (integer i = 1; i <= n; i ++)
  2855. result [i] = f (at [i]);
  2856. x->numericVector = result. releaseToAmbiguousOwner();
  2857. x->owned = true;
  2858. }
  2859. } else {
  2860. Melder_throw (U"The function ", Formula_instructionNames [parse [programPointer]. symbol],
  2861. U" requires a numeric vector argument, not ", x->whichText(), U".");
  2862. }
  2863. }
  2864. static void do_softmax () {
  2865. Stackel x = & theStack [w];
  2866. if (x->which == Stackel_NUMERIC_VECTOR) {
  2867. if (! x->owned) {
  2868. x->numericVector = VECcopy (x->numericVector). releaseToAmbiguousOwner(); // TODO: no need to copy
  2869. x->owned = true;
  2870. }
  2871. integer nelm = x->numericVector.size;
  2872. double maximum = -1e308;
  2873. for (integer i = 1; i <= nelm; i ++) {
  2874. if (x->numericVector [i] > maximum)
  2875. maximum = x->numericVector [i];
  2876. }
  2877. for (integer i = 1; i <= nelm; i ++)
  2878. x->numericVector [i] -= maximum;
  2879. longdouble sum = 0.0;
  2880. for (integer i = 1; i <= nelm; i ++) {
  2881. x->numericVector [i] = exp (x->numericVector [i]);
  2882. sum += x->numericVector [i];
  2883. }
  2884. for (integer i = 1; i <= nelm; i ++)
  2885. x->numericVector [i] /= (double) sum;
  2886. } else {
  2887. Melder_throw (U"The function ", Formula_instructionNames [parse [programPointer]. symbol],
  2888. U" requires a numeric vector argument, not ", x->whichText(), U".");
  2889. }
  2890. }
  2891. static void do_abs () {
  2892. Stackel x = pop;
  2893. if (x->which == Stackel_NUMBER) {
  2894. pushNumber (isundef (x->number) ? undefined : fabs (x->number));
  2895. } else {
  2896. Melder_throw (U"Cannot take the absolute value (abs) of ", x->whichText(), U".");
  2897. }
  2898. }
  2899. static void do_round () {
  2900. Stackel x = pop;
  2901. if (x->which == Stackel_NUMBER) {
  2902. pushNumber (isundef (x->number) ? undefined : floor (x->number + 0.5));
  2903. } else {
  2904. Melder_throw (U"Cannot round ", x->whichText(), U".");
  2905. }
  2906. }
  2907. static void do_floor () {
  2908. Stackel x = pop;
  2909. if (x->which == Stackel_NUMBER) {
  2910. pushNumber (isundef (x->number) ? undefined : Melder_roundDown (x->number));
  2911. } else {
  2912. Melder_throw (U"Cannot round down (floor) ", x->whichText(), U".");
  2913. }
  2914. }
  2915. static void do_ceiling () {
  2916. Stackel x = pop;
  2917. if (x->which == Stackel_NUMBER) {
  2918. pushNumber (isundef (x->number) ? undefined : Melder_roundUp (x->number));
  2919. } else {
  2920. Melder_throw (U"Cannot round up (ceiling) ", x->whichText(), U".");
  2921. }
  2922. }
  2923. static void do_rectify () {
  2924. Stackel x = pop;
  2925. if (x->which == Stackel_NUMBER) {
  2926. pushNumber (isundef (x->number) ? undefined : x->number > 0.0 ? x->number : 0.0);
  2927. } else {
  2928. Melder_throw (U"Cannot rectify ", x->whichText(), U".");
  2929. }
  2930. }
  2931. static void do_VECrectify () {
  2932. Stackel x = pop;
  2933. if (x->which == Stackel_NUMERIC_VECTOR) {
  2934. integer nelm = x->numericVector.size;
  2935. autoVEC result { nelm, kTensorInitializationType::RAW };
  2936. for (integer i = 1; i <= nelm; i ++) {
  2937. double xvalue = x->numericVector [i];
  2938. result [i] = isundef (xvalue) ? undefined : xvalue > 0.0 ? xvalue : 0.0;
  2939. }
  2940. pushNumericVector (result.move());
  2941. } else {
  2942. Melder_throw (U"Cannot rectify ", x->whichText(), U".");
  2943. }
  2944. }
  2945. static void do_sqrt () {
  2946. Stackel x = pop;
  2947. if (x->which == Stackel_NUMBER) {
  2948. pushNumber (isundef (x->number) ? undefined :
  2949. x->number < 0.0 ? undefined : sqrt (x->number));
  2950. } else {
  2951. Melder_throw (U"Cannot take the square root (sqrt) of ", x->whichText(), U".");
  2952. }
  2953. }
  2954. static void do_sin () {
  2955. Stackel x = pop;
  2956. if (x->which == Stackel_NUMBER) {
  2957. pushNumber (isundef (x->number) ? undefined : sin (x->number));
  2958. } else {
  2959. Melder_throw (U"Cannot take the sine (sin) of ", x->whichText(), U".");
  2960. }
  2961. }
  2962. static void do_cos () {
  2963. Stackel x = pop;
  2964. if (x->which == Stackel_NUMBER) {
  2965. pushNumber (isundef (x->number) ? undefined : cos (x->number));
  2966. } else {
  2967. Melder_throw (U"Cannot take the cosine (cos) of ", x->whichText(), U".");
  2968. }
  2969. }
  2970. static void do_tan () {
  2971. Stackel x = pop;
  2972. if (x->which == Stackel_NUMBER) {
  2973. pushNumber (isundef (x->number) ? undefined : tan (x->number));
  2974. } else {
  2975. Melder_throw (U"Cannot take the tangent (tan) of ", x->whichText(), U".");
  2976. }
  2977. }
  2978. static void do_arcsin () {
  2979. Stackel x = pop;
  2980. if (x->which == Stackel_NUMBER) {
  2981. pushNumber (isundef (x->number) ? undefined :
  2982. fabs (x->number) > 1.0 ? undefined : asin (x->number));
  2983. } else {
  2984. Melder_throw (U"Cannot take the arcsine (arcsin) of ", x->whichText(), U".");
  2985. }
  2986. }
  2987. static void do_arccos () {
  2988. Stackel x = pop;
  2989. if (x->which == Stackel_NUMBER) {
  2990. pushNumber (isundef (x->number) ? undefined :
  2991. fabs (x->number) > 1.0 ? undefined : acos (x->number));
  2992. } else {
  2993. Melder_throw (U"Cannot take the arccosine (arccos) of ", x->whichText(), U".");
  2994. }
  2995. }
  2996. static void do_arctan () {
  2997. Stackel x = pop;
  2998. if (x->which == Stackel_NUMBER) {
  2999. pushNumber (isundef (x->number) ? undefined : atan (x->number));
  3000. } else {
  3001. Melder_throw (U"Cannot take the arctangent (arctan) of ", x->whichText(), U".");
  3002. }
  3003. }
  3004. static void do_exp () {
  3005. Stackel x = pop;
  3006. if (x->which == Stackel_NUMBER) {
  3007. pushNumber (isundef (x->number) ? undefined : exp (x->number));
  3008. } else {
  3009. Melder_throw (U"Cannot exponentiate (exp) ", x->whichText(), U".");
  3010. }
  3011. }
  3012. static void do_VECexp () {
  3013. Stackel x = pop;
  3014. if (x->which == Stackel_NUMERIC_VECTOR) {
  3015. integer nelm = x->numericVector.size;
  3016. autoVEC result (nelm, kTensorInitializationType::RAW);
  3017. for (integer i = 1; i <= nelm; i ++) {
  3018. result [i] = exp (x->numericVector [i]);
  3019. }
  3020. pushNumericVector (result.move());
  3021. } else {
  3022. Melder_throw (U"Cannot exponentiate (exp) ", x->whichText(), U".");
  3023. }
  3024. }
  3025. static void do_MATexp () {
  3026. Stackel x = pop;
  3027. if (x->which == Stackel_NUMERIC_MATRIX) {
  3028. integer nrow = x->numericMatrix.nrow, ncol = x->numericMatrix.ncol;
  3029. autoMAT result (nrow, ncol, kTensorInitializationType::RAW);
  3030. for (integer irow = 1; irow <= nrow; irow ++) {
  3031. for (integer icol = 1; icol <= ncol; icol ++) {
  3032. result [irow] [icol] = exp (x->numericMatrix [irow] [icol]);
  3033. }
  3034. }
  3035. pushNumericMatrix (result.move());
  3036. } else {
  3037. Melder_throw (U"Cannot exponentiate (exp) ", x->whichText(), U".");
  3038. }
  3039. }
  3040. static void do_sinh () {
  3041. Stackel x = pop;
  3042. if (x->which == Stackel_NUMBER) {
  3043. pushNumber (isundef (x->number) ? undefined : sinh (x->number));
  3044. } else {
  3045. Melder_throw (U"Cannot take the hyperbolic sine (sinh) of ", x->whichText(), U".");
  3046. }
  3047. }
  3048. static void do_cosh () {
  3049. Stackel x = pop;
  3050. if (x->which == Stackel_NUMBER) {
  3051. pushNumber (isundef (x->number) ? undefined : cosh (x->number));
  3052. } else {
  3053. Melder_throw (U"Cannot take the hyperbolic cosine (cosh) of ", x->whichText(), U".");
  3054. }
  3055. }
  3056. static void do_tanh () {
  3057. Stackel x = pop;
  3058. if (x->which == Stackel_NUMBER) {
  3059. pushNumber (isundef (x->number) ? undefined : tanh (x->number));
  3060. } else {
  3061. Melder_throw (U"Cannot take the hyperbolic tangent (tanh) of ", x->whichText(), U".");
  3062. }
  3063. }
  3064. static void do_log2 () {
  3065. Stackel x = pop;
  3066. if (x->which == Stackel_NUMBER) {
  3067. pushNumber (isundef (x->number) ? undefined :
  3068. x->number <= 0.0 ? undefined : log (x->number) * NUMlog2e);
  3069. } else {
  3070. Melder_throw (U"Cannot take the base-2 logarithm (log2) of ", x->whichText(), U".");
  3071. }
  3072. }
  3073. static void do_ln () {
  3074. Stackel x = pop;
  3075. if (x->which == Stackel_NUMBER) {
  3076. pushNumber (isundef (x->number) ? undefined :
  3077. x->number <= 0.0 ? undefined : log (x->number));
  3078. } else {
  3079. Melder_throw (U"Cannot take the natural logarithm (ln) of ", x->whichText(), U".");
  3080. }
  3081. }
  3082. static void do_log10 () {
  3083. Stackel x = pop;
  3084. if (x->which == Stackel_NUMBER) {
  3085. pushNumber (isundef (x->number) ? undefined :
  3086. x->number <= 0.0 ? undefined : log10 (x->number));
  3087. } else {
  3088. Melder_throw (U"Cannot take the base-10 logarithm (log10) of ", x->whichText(), U".");
  3089. }
  3090. }
  3091. static void do_sum () {
  3092. Stackel x = pop;
  3093. if (x->which == Stackel_NUMERIC_VECTOR) {
  3094. pushNumber (NUMsum (x->numericVector));
  3095. } else {
  3096. Melder_throw (U"Cannot compute the sum of ", x->whichText(), U".");
  3097. }
  3098. }
  3099. static void do_mean () {
  3100. Stackel x = pop;
  3101. if (x->which == Stackel_NUMERIC_VECTOR) {
  3102. pushNumber (NUMmean (x->numericVector));
  3103. } else {
  3104. Melder_throw (U"Cannot compute the mean of ", x->whichText(), U".");
  3105. }
  3106. }
  3107. static void do_stdev () {
  3108. Stackel x = pop;
  3109. if (x->which == Stackel_NUMERIC_VECTOR) {
  3110. pushNumber (NUMstdev (x->numericVector));
  3111. } else {
  3112. Melder_throw (U"Cannot compute the mean of ", x->whichText(), U".");
  3113. }
  3114. }
  3115. static void do_center () {
  3116. Stackel x = pop;
  3117. if (x->which == Stackel_NUMERIC_VECTOR) {
  3118. pushNumber (NUMcenterOfGravity (x->numericVector));
  3119. } else {
  3120. Melder_throw (U"Cannot compute the center of ", x->whichText(), U".");
  3121. }
  3122. }
  3123. static void do_function_dd_d (double (*f) (double, double)) {
  3124. Stackel y = pop, x = pop;
  3125. if (x->which == Stackel_NUMBER && y->which == Stackel_NUMBER) {
  3126. pushNumber (isundef (x->number) || isundef (y->number) ? undefined : f (x->number, y->number));
  3127. } else {
  3128. Melder_throw (U"The function ", Formula_instructionNames [parse [programPointer]. symbol],
  3129. U" requires two numeric arguments, not ",
  3130. x->whichText(), U" and ", y->whichText(), U".");
  3131. }
  3132. }
  3133. static void do_function_VECdd_d (double (*f) (double, double)) {
  3134. Stackel n = pop;
  3135. Melder_assert (n -> which == Stackel_NUMBER);
  3136. if (n -> number != 3)
  3137. Melder_throw (U"The function ", Formula_instructionNames [parse [programPointer]. symbol], U" requires three arguments.");
  3138. Stackel y = pop, x = pop, a = pop;
  3139. if ((a->which == Stackel_NUMERIC_VECTOR || a->which == Stackel_NUMBER) && x->which == Stackel_NUMBER && y->which == Stackel_NUMBER) {
  3140. integer numberOfElements = ( a->which == Stackel_NUMBER ? a->number : a->numericVector.size );
  3141. autoVEC newData (numberOfElements, kTensorInitializationType::RAW);
  3142. for (integer ielem = 1; ielem <= numberOfElements; ielem ++) {
  3143. newData [ielem] = f (x->number, y->number);
  3144. }
  3145. pushNumericVector (newData.move());
  3146. } else {
  3147. Melder_throw (U"The function ", Formula_instructionNames [parse [programPointer]. symbol],
  3148. U" requires either three numeric arguments, or one vector argument and two numeric arguments, not ",
  3149. a->whichText(), U", ", x->whichText(), U" and ", y->whichText(), U".");
  3150. }
  3151. }
  3152. static void do_function_MATdd_d (double (*f) (double, double)) {
  3153. Stackel n = pop;
  3154. Melder_assert (n -> which == Stackel_NUMBER);
  3155. if (n -> number != 3)
  3156. Melder_throw (U"The function ", Formula_instructionNames [parse [programPointer]. symbol], U" requires three arguments.");
  3157. Stackel y = pop, x = pop, a = pop;
  3158. if (a->which == Stackel_NUMERIC_MATRIX && x->which == Stackel_NUMBER && y->which == Stackel_NUMBER) {
  3159. integer numberOfRows = a->numericMatrix.nrow;
  3160. integer numberOfColumns = a->numericMatrix.ncol;
  3161. autoMAT newData (numberOfRows, numberOfColumns, kTensorInitializationType::RAW);
  3162. for (integer irow = 1; irow <= numberOfRows; irow ++) {
  3163. for (integer icol = 1; icol <= numberOfColumns; icol ++) {
  3164. newData [irow] [icol] = f (x->number, y->number);
  3165. }
  3166. }
  3167. pushNumericMatrix (newData.move());
  3168. } else {
  3169. Melder_throw (U"The function ", Formula_instructionNames [parse [programPointer]. symbol],
  3170. U" requires one matrix argument and two numeric arguments, not ",
  3171. a->whichText(), U", ", x->whichText(), U" and ", y->whichText(), U".");
  3172. }
  3173. }
  3174. static void do_function_VECll_l (integer (*f) (integer, integer)) {
  3175. Stackel n = pop;
  3176. Melder_assert (n -> which == Stackel_NUMBER);
  3177. if (n -> number != 3)
  3178. Melder_throw (U"The function ", Formula_instructionNames [parse [programPointer]. symbol], U" requires three arguments.");
  3179. Stackel y = pop, x = pop, a = pop;
  3180. if ((a->which == Stackel_NUMERIC_VECTOR || a->which == Stackel_NUMBER) && x->which == Stackel_NUMBER) {
  3181. integer numberOfElements = ( a->which == Stackel_NUMBER ? a->number : a->numericVector.size );
  3182. autoVEC newData (numberOfElements, kTensorInitializationType::RAW);
  3183. for (integer ielem = 1; ielem <= numberOfElements; ielem ++) {
  3184. newData [ielem] = f (Melder_iround (x->number), Melder_iround (y->number));
  3185. }
  3186. pushNumericVector (newData.move());
  3187. } else {
  3188. Melder_throw (U"The function ", Formula_instructionNames [parse [programPointer]. symbol],
  3189. U" requires either three numeric arguments, or one vector argument and two numeric arguments, not ",
  3190. a->whichText(), U", ", x->whichText(), U" and ", y->whichText(), U".");
  3191. }
  3192. }
  3193. static void do_function_MATll_l (integer (*f) (integer, integer)) {
  3194. Stackel n = pop;
  3195. Melder_assert (n -> which == Stackel_NUMBER);
  3196. if (n -> number != 3)
  3197. Melder_throw (U"The function ", Formula_instructionNames [parse [programPointer]. symbol], U" requires three arguments.");
  3198. Stackel y = pop, x = pop, a = pop;
  3199. if (a->which == Stackel_NUMERIC_MATRIX && x->which == Stackel_NUMBER && y->which == Stackel_NUMBER) {
  3200. integer numberOfRows = a->numericMatrix.nrow;
  3201. integer numberOfColumns = a->numericMatrix.ncol;
  3202. autoMAT newData (numberOfRows, numberOfColumns, kTensorInitializationType::RAW);
  3203. for (integer irow = 1; irow <= numberOfRows; irow ++) {
  3204. for (integer icol = 1; icol <= numberOfColumns; icol ++) {
  3205. newData [irow] [icol] = f (Melder_iround (x->number), Melder_iround (y->number));
  3206. }
  3207. }
  3208. pushNumericMatrix (newData.move());
  3209. } else {
  3210. Melder_throw (U"The function ", Formula_instructionNames [parse [programPointer]. symbol],
  3211. U" requires one matrix argument and two numeric arguments, not ",
  3212. a->whichText(), U", ", x->whichText(), U" and ", y->whichText(), U".");
  3213. }
  3214. }
  3215. static void do_function_dl_d (double (*f) (double, integer)) {
  3216. Stackel y = pop, x = pop;
  3217. if (x->which == Stackel_NUMBER && y->which == Stackel_NUMBER) {
  3218. pushNumber (isundef (x->number) || isundef (y->number) ? undefined :
  3219. f (x->number, Melder_iround (y->number)));
  3220. } else {
  3221. Melder_throw (U"The function ", Formula_instructionNames [parse [programPointer]. symbol],
  3222. U" requires two numeric arguments, not ",
  3223. x->whichText(), U" and ", y->whichText(), U".");
  3224. }
  3225. }
  3226. static void do_function_ld_d (double (*f) (integer, double)) {
  3227. Stackel y = pop, x = pop;
  3228. if (x->which == Stackel_NUMBER && y->which == Stackel_NUMBER) {
  3229. pushNumber (isundef (x->number) || isundef (y->number) ? undefined :
  3230. f (Melder_iround (x->number), y->number));
  3231. } else {
  3232. Melder_throw (U"The function ", Formula_instructionNames [parse [programPointer]. symbol],
  3233. U" requires two numeric arguments, not ",
  3234. x->whichText(), U" and ", y->whichText(), U".");
  3235. }
  3236. }
  3237. static void do_function_ll_l (integer (*f) (integer, integer)) {
  3238. Stackel y = pop, x = pop;
  3239. if (x->which == Stackel_NUMBER && y->which == Stackel_NUMBER) {
  3240. pushNumber (isundef (x->number) || isundef (y->number) ? undefined :
  3241. f (Melder_iround (x->number), Melder_iround (y->number)));
  3242. } else {
  3243. Melder_throw (U"The function ", Formula_instructionNames [parse [programPointer]. symbol],
  3244. U" requires two numeric arguments, not ",
  3245. x->whichText(), U" and ", y->whichText(), U".");
  3246. }
  3247. }
  3248. static void do_objects_are_identical () {
  3249. Stackel y = pop, x = pop;
  3250. if (x->which == Stackel_NUMBER && y->which == Stackel_NUMBER) {
  3251. integer id1 = Melder_iround (x->number), id2 = Melder_iround (y->number);
  3252. integer i = theCurrentPraatObjects -> n;
  3253. while (i > 0 && id1 != theCurrentPraatObjects -> list [i]. id) i --;
  3254. if (i == 0) Melder_throw (U"Object #", id1, U" does not exist in function objectsAreIdentical.");
  3255. Daata object1 = (Daata) theCurrentPraatObjects -> list [i]. object;
  3256. i = theCurrentPraatObjects -> n;
  3257. while (i > 0 && id2 != theCurrentPraatObjects -> list [i]. id) i --;
  3258. if (i == 0) Melder_throw (U"Object #", id2, U" does not exist in function objectsAreIdentical.");
  3259. Daata object2 = (Daata) theCurrentPraatObjects -> list [i]. object;
  3260. pushNumber (isundef (x->number) || isundef (y->number) ? undefined : Data_equal (object1, object2));
  3261. } else {
  3262. Melder_throw (U"The function objectsAreIdentical requires two numeric arguments (object IDs), not ",
  3263. x->whichText(), U" and ", y->whichText(), U".");
  3264. }
  3265. }
  3266. static void do_function_ddd_d (double (*f) (double, double, double)) {
  3267. Stackel z = pop, y = pop, x = pop;
  3268. if (x->which == Stackel_NUMBER && y->which == Stackel_NUMBER && z->which == Stackel_NUMBER) {
  3269. pushNumber (isundef (x->number) || isundef (y->number) || isundef (z->number) ? undefined :
  3270. f (x->number, y->number, z->number));
  3271. } else {
  3272. Melder_throw (U"The function ", Formula_instructionNames [parse [programPointer]. symbol],
  3273. U" requires three numeric arguments, not ", x->whichText(), U", ",
  3274. y->whichText(), U", and ", z->whichText(), U".");
  3275. }
  3276. }
  3277. static void do_do () {
  3278. Stackel narg = pop;
  3279. Melder_assert (narg->which == Stackel_NUMBER);
  3280. if (narg->number < 1)
  3281. Melder_throw (U"The function \"do\" requires at least one argument, namely a menu command.");
  3282. integer numberOfArguments = Melder_iround (narg->number) - 1;
  3283. #define MAXNUM_FIELDS 40
  3284. structStackel stack [1+MAXNUM_FIELDS];
  3285. for (integer iarg = numberOfArguments; iarg >= 0; iarg --) {
  3286. Stackel arg = pop;
  3287. stack [iarg] = std::move (*arg);
  3288. }
  3289. if (stack [0]. which != Stackel_STRING)
  3290. Melder_throw (U"The first argument of the function \"do\" has to be a string, namely a menu command, and not ", stack [0]. whichText(), U".");
  3291. conststring32 command = stack [0]. getString();
  3292. if (theCurrentPraatObjects == & theForegroundPraatObjects && praatP. editor != nullptr) {
  3293. autoMelderString valueString;
  3294. MelderString_appendCharacter (& valueString, 1); // TODO: check whether this is needed at all, or is just MelderString_empty enough?
  3295. autoMelderDivertInfo divert (& valueString);
  3296. autostring32 command2 = Melder_dup (command); // allow the menu command to reuse the stack (?)
  3297. Editor_doMenuCommand (praatP. editor, command2.get(), numberOfArguments, & stack [0], nullptr, theInterpreter);
  3298. pushNumber (Melder_atof (valueString.string));
  3299. return;
  3300. } else if (theCurrentPraatObjects != & theForegroundPraatObjects &&
  3301. (str32nequ (command, U"Save ", 5) || str32nequ (command, U"Write ", 6) || str32nequ (command, U"Append ", 7) || str32equ (command, U"Quit")))
  3302. {
  3303. Melder_throw (U"Commands that write files (including Quit) are not available inside manuals.");
  3304. } else {
  3305. autoMelderString valueString;
  3306. MelderString_appendCharacter (& valueString, 1); // a semaphor to check whether praat_doAction or praat_doMenuCommand wrote anything with MelderInfo
  3307. autoMelderDivertInfo divert (& valueString);
  3308. autostring32 command2 = Melder_dup (command); // allow the menu command to reuse the stack (?)
  3309. if (! praat_doAction (command2.get(), numberOfArguments, & stack [0], theInterpreter) &&
  3310. ! praat_doMenuCommand (command2.get(), numberOfArguments, & stack [0], theInterpreter))
  3311. {
  3312. Melder_throw (U"Command \"", command, U"\" not available for current selection.");
  3313. }
  3314. //praat_updateSelection ();
  3315. double value = undefined;
  3316. if (valueString.string [0] == 1) { // nothing written with MelderInfo by praat_doAction or praat_doMenuCommand? then the return value is the ID of the selected object
  3317. int IOBJECT, result = 0, found = 0;
  3318. WHERE (SELECTED) {
  3319. result = IOBJECT;
  3320. found += 1;
  3321. }
  3322. if (found == 1)
  3323. value = theCurrentPraatObjects -> list [result]. id;
  3324. } else {
  3325. value = Melder_atof (valueString.string); // including --undefined--
  3326. }
  3327. pushNumber (value);
  3328. return;
  3329. }
  3330. praat_updateSelection (); // BUG: superfluous? flickering?
  3331. pushNumber (1);
  3332. }
  3333. static void do_evaluate () {
  3334. Stackel expression = pop;
  3335. if (expression->which == Stackel_STRING) {
  3336. double result;
  3337. Interpreter_numericExpression (theInterpreter, expression->getString(), & result);
  3338. pushNumber (result);
  3339. } else Melder_throw (U"The argument of the function \"evaluate\" should be a string with a numeric expression, not ", expression->whichText());
  3340. }
  3341. static void do_evaluate_nocheck () {
  3342. Stackel expression = pop;
  3343. if (expression->which == Stackel_STRING) {
  3344. try {
  3345. double result;
  3346. Interpreter_numericExpression (theInterpreter, expression->getString(), & result);
  3347. pushNumber (result);
  3348. } catch (MelderError) {
  3349. Melder_clearError ();
  3350. pushNumber (undefined);
  3351. }
  3352. } else Melder_throw (U"The argument of the function \"evaluate_nocheck\" should be a string with a numeric expression, not ", expression->whichText());
  3353. }
  3354. static void do_evaluateStr () {
  3355. Stackel expression = pop;
  3356. if (expression->which == Stackel_STRING) {
  3357. autostring32 result = Interpreter_stringExpression (theInterpreter, expression->getString());
  3358. pushString (result.move());
  3359. } else Melder_throw (U"The argument of the function \"evaluate$\" should be a string with a string expression, not ", expression->whichText());
  3360. }
  3361. static void do_evaluate_nocheckStr () {
  3362. Stackel expression = pop;
  3363. if (expression->which == Stackel_STRING) {
  3364. try {
  3365. autostring32 result = Interpreter_stringExpression (theInterpreter, expression->getString());
  3366. pushString (result.move());
  3367. } catch (MelderError) {
  3368. Melder_clearError ();
  3369. pushString (Melder_dup (U""));
  3370. }
  3371. } else Melder_throw (U"The argument of the function \"evaluate_nocheck$\" should be a string with a string expression, not ", expression->whichText());
  3372. }
  3373. static void do_doStr () {
  3374. Stackel narg = pop;
  3375. Melder_assert (narg->which == Stackel_NUMBER);
  3376. if (narg->number < 1)
  3377. Melder_throw (U"The function \"do$\" requires at least one argument, namely a menu command.");
  3378. integer numberOfArguments = Melder_iround (narg->number) - 1;
  3379. #define MAXNUM_FIELDS 40
  3380. structStackel stack [1+MAXNUM_FIELDS];
  3381. for (integer iarg = numberOfArguments; iarg >= 0; iarg --) {
  3382. Stackel arg = pop;
  3383. stack [iarg] = std::move (*arg);
  3384. }
  3385. if (stack [0]. which != Stackel_STRING)
  3386. Melder_throw (U"The first argument of the function \"do$\" has to be a string, namely a menu command, and not ", stack [0]. whichText(), U".");
  3387. conststring32 command = stack [0]. getString();
  3388. if (theCurrentPraatObjects == & theForegroundPraatObjects && praatP. editor != nullptr) {
  3389. static MelderString info;
  3390. MelderString_empty (& info);
  3391. autoMelderDivertInfo divert (& info);
  3392. autostring32 command2 = Melder_dup (command);
  3393. Editor_doMenuCommand (praatP. editor, command2.get(), numberOfArguments, & stack [0], nullptr, theInterpreter);
  3394. pushString (Melder_dup (info.string));
  3395. return;
  3396. } else if (theCurrentPraatObjects != & theForegroundPraatObjects &&
  3397. (str32nequ (command, U"Save ", 5) || str32nequ (command, U"Write ", 6) || str32nequ (command, U"Append ", 7) || str32equ (command, U"Quit")))
  3398. {
  3399. Melder_throw (U"Commands that write files (including Quit) are not available inside manuals.");
  3400. } else {
  3401. static MelderString info;
  3402. MelderString_empty (& info);
  3403. autoMelderDivertInfo divert (& info);
  3404. autostring32 command2 = Melder_dup (command);
  3405. if (! praat_doAction (command2.get(), numberOfArguments, & stack [0], theInterpreter) &&
  3406. ! praat_doMenuCommand (command2.get(), numberOfArguments, & stack [0], theInterpreter))
  3407. {
  3408. Melder_throw (U"Command \"", command, U"\" not available for current selection.");
  3409. }
  3410. praat_updateSelection ();
  3411. pushString (Melder_dup (info.string));
  3412. return;
  3413. }
  3414. praat_updateSelection (); // BUG: superfluous? flickering?
  3415. pushString (Melder_dup (U""));
  3416. }
  3417. static void shared_do_writeInfo (integer numberOfArguments) {
  3418. for (integer iarg = 1; iarg <= numberOfArguments; iarg ++) {
  3419. Stackel arg = & theStack [w + iarg];
  3420. if (arg->which == Stackel_NUMBER) {
  3421. MelderInfo_write (arg->number);
  3422. } else if (arg->which == Stackel_STRING) {
  3423. MelderInfo_write (arg->getString());
  3424. } else if (arg->which == Stackel_NUMERIC_VECTOR) {
  3425. for (integer i = 1; i <= arg->numericVector.size; i ++)
  3426. MelderInfo_write (arg->numericVector [i],
  3427. i == arg->numericVector.size ? U"" : U" ");
  3428. } else if (arg->which == Stackel_NUMERIC_MATRIX) {
  3429. for (integer irow = 1; irow <= arg->numericMatrix.nrow; irow ++) {
  3430. for (integer icol = 1; icol <= arg->numericMatrix.ncol; icol ++) {
  3431. MelderInfo_write (arg->numericMatrix [irow] [icol],
  3432. icol == arg->numericMatrix.ncol ? U"" : U" ");
  3433. }
  3434. MelderInfo_write (irow == arg->numericMatrix.nrow ? U"" : U"\n");
  3435. }
  3436. }
  3437. }
  3438. }
  3439. static void do_writeInfo () {
  3440. Stackel narg = pop;
  3441. Melder_assert (narg->which == Stackel_NUMBER);
  3442. integer numberOfArguments = Melder_iround (narg->number);
  3443. w -= numberOfArguments;
  3444. MelderInfo_open ();
  3445. shared_do_writeInfo (numberOfArguments);
  3446. MelderInfo_drain ();
  3447. pushNumber (1);
  3448. }
  3449. static void do_writeInfoLine () {
  3450. Stackel narg = pop;
  3451. Melder_assert (narg->which == Stackel_NUMBER);
  3452. integer numberOfArguments = Melder_iround (narg->number);
  3453. w -= numberOfArguments;
  3454. MelderInfo_open ();
  3455. shared_do_writeInfo (numberOfArguments);
  3456. MelderInfo_write (U"\n");
  3457. MelderInfo_drain ();
  3458. pushNumber (1);
  3459. }
  3460. static void do_appendInfo () {
  3461. Stackel narg = pop;
  3462. Melder_assert (narg->which == Stackel_NUMBER);
  3463. integer numberOfArguments = Melder_iround (narg->number);
  3464. w -= numberOfArguments;
  3465. shared_do_writeInfo (numberOfArguments);
  3466. MelderInfo_drain ();
  3467. pushNumber (1);
  3468. }
  3469. static void do_appendInfoLine () {
  3470. Stackel narg = pop;
  3471. Melder_assert (narg->which == Stackel_NUMBER);
  3472. integer numberOfArguments = Melder_iround (narg->number);
  3473. w -= numberOfArguments;
  3474. shared_do_writeInfo (numberOfArguments);
  3475. MelderInfo_write (U"\n");
  3476. MelderInfo_drain ();
  3477. pushNumber (1);
  3478. }
  3479. static void do_writeFile () {
  3480. if (theCurrentPraatObjects != & theForegroundPraatObjects)
  3481. Melder_throw (U"The function \"writeFile\" is not available inside manuals.");
  3482. Stackel narg = pop;
  3483. Melder_assert (narg->which == Stackel_NUMBER);
  3484. integer numberOfArguments = Melder_iround (narg->number);
  3485. w -= numberOfArguments;
  3486. Stackel fileName = & theStack [w + 1];
  3487. if (fileName -> which != Stackel_STRING) {
  3488. Melder_throw (U"The first argument of \"writeFile\" has to be a string (a file name), not ", fileName->whichText(), U".");
  3489. }
  3490. autoMelderString text;
  3491. for (int iarg = 2; iarg <= numberOfArguments; iarg ++) {
  3492. Stackel arg = & theStack [w + iarg];
  3493. if (arg->which == Stackel_NUMBER)
  3494. MelderString_append (& text, arg->number);
  3495. else if (arg->which == Stackel_STRING)
  3496. MelderString_append (& text, arg->getString());
  3497. }
  3498. structMelderFile file { };
  3499. Melder_relativePathToFile (fileName -> getString(), & file);
  3500. MelderFile_writeText (& file, text.string, Melder_getOutputEncoding ());
  3501. pushNumber (1);
  3502. }
  3503. static void do_writeFileLine () {
  3504. if (theCurrentPraatObjects != & theForegroundPraatObjects)
  3505. Melder_throw (U"The function \"writeFile\" is not available inside manuals.");
  3506. Stackel narg = pop;
  3507. Melder_assert (narg->which == Stackel_NUMBER);
  3508. integer numberOfArguments = Melder_iround (narg->number);
  3509. w -= numberOfArguments;
  3510. Stackel fileName = & theStack [w + 1];
  3511. if (fileName -> which != Stackel_STRING) {
  3512. Melder_throw (U"The first argument of \"writeFileLine\" has to be a string (a file name), not ", fileName->whichText(), U".");
  3513. }
  3514. autoMelderString text;
  3515. for (int iarg = 2; iarg <= numberOfArguments; iarg ++) {
  3516. Stackel arg = & theStack [w + iarg];
  3517. if (arg->which == Stackel_NUMBER)
  3518. MelderString_append (& text, arg->number);
  3519. else if (arg->which == Stackel_STRING)
  3520. MelderString_append (& text, arg->getString());
  3521. }
  3522. MelderString_appendCharacter (& text, U'\n');
  3523. structMelderFile file { };
  3524. Melder_relativePathToFile (fileName -> getString(), & file);
  3525. MelderFile_writeText (& file, text.string, Melder_getOutputEncoding ());
  3526. pushNumber (1);
  3527. }
  3528. static void do_appendFile () {
  3529. if (theCurrentPraatObjects != & theForegroundPraatObjects)
  3530. Melder_throw (U"The function \"writeFile\" is not available inside manuals.");
  3531. Stackel narg = pop;
  3532. Melder_assert (narg->which == Stackel_NUMBER);
  3533. integer numberOfArguments = Melder_iround (narg->number);
  3534. w -= numberOfArguments;
  3535. Stackel fileName = & theStack [w + 1];
  3536. if (fileName -> which != Stackel_STRING) {
  3537. Melder_throw (U"The first argument of \"appendFile\" has to be a string (a file name), not ", fileName->whichText(), U".");
  3538. }
  3539. autoMelderString text;
  3540. for (int iarg = 2; iarg <= numberOfArguments; iarg ++) {
  3541. Stackel arg = & theStack [w + iarg];
  3542. if (arg->which == Stackel_NUMBER)
  3543. MelderString_append (& text, arg->number);
  3544. else if (arg->which == Stackel_STRING)
  3545. MelderString_append (& text, arg->getString());
  3546. }
  3547. structMelderFile file { };
  3548. Melder_relativePathToFile (fileName -> getString(), & file);
  3549. MelderFile_appendText (& file, text.string);
  3550. pushNumber (1);
  3551. }
  3552. static void do_appendFileLine () {
  3553. if (theCurrentPraatObjects != & theForegroundPraatObjects)
  3554. Melder_throw (U"The function \"writeFile\" is not available inside manuals.");
  3555. Stackel narg = pop;
  3556. Melder_assert (narg->which == Stackel_NUMBER);
  3557. integer numberOfArguments = Melder_iround (narg->number);
  3558. w -= numberOfArguments;
  3559. Stackel fileName = & theStack [w + 1];
  3560. if (fileName -> which != Stackel_STRING) {
  3561. Melder_throw (U"The first argument of \"appendFileLine\" has to be a string (a file name), not ", fileName->whichText(), U".");
  3562. }
  3563. autoMelderString text;
  3564. for (int iarg = 2; iarg <= numberOfArguments; iarg ++) {
  3565. Stackel arg = & theStack [w + iarg];
  3566. if (arg->which == Stackel_NUMBER)
  3567. MelderString_append (& text, arg->number);
  3568. else if (arg->which == Stackel_STRING)
  3569. MelderString_append (& text, arg->getString());
  3570. }
  3571. MelderString_appendCharacter (& text, '\n');
  3572. structMelderFile file { };
  3573. Melder_relativePathToFile (fileName -> getString(), & file);
  3574. MelderFile_appendText (& file, text.string);
  3575. pushNumber (1);
  3576. }
  3577. static void do_pauseScript () {
  3578. if (theCurrentPraatObjects != & theForegroundPraatObjects)
  3579. Melder_throw (U"The function \"pause\" is not available inside manuals.");
  3580. if (theCurrentPraatApplication -> batch) return; // in batch we ignore pause statements
  3581. Stackel narg = pop;
  3582. Melder_assert (narg->which == Stackel_NUMBER);
  3583. integer numberOfArguments = Melder_iround (narg->number);
  3584. w -= numberOfArguments;
  3585. autoMelderString buffer;
  3586. for (int iarg = 1; iarg <= numberOfArguments; iarg ++) {
  3587. Stackel arg = & theStack [w + iarg];
  3588. if (arg->which == Stackel_NUMBER)
  3589. MelderString_append (& buffer, arg->number);
  3590. else if (arg->which == Stackel_STRING)
  3591. MelderString_append (& buffer, arg->getString());
  3592. }
  3593. UiPause_begin (theCurrentPraatApplication -> topShell, U"stop or continue", theInterpreter);
  3594. UiPause_comment (numberOfArguments == 0 ? U"..." : buffer.string);
  3595. UiPause_end (1, 1, 0, U"Continue", nullptr, nullptr, nullptr, nullptr, nullptr, nullptr, nullptr, nullptr, nullptr, theInterpreter);
  3596. pushNumber (1);
  3597. }
  3598. static void do_exitScript () {
  3599. Stackel narg = pop;
  3600. Melder_assert (narg->which == Stackel_NUMBER);
  3601. integer numberOfArguments = Melder_iround (narg->number);
  3602. w -= numberOfArguments;
  3603. for (int iarg = 1; iarg <= numberOfArguments; iarg ++) {
  3604. Stackel arg = & theStack [w + iarg];
  3605. if (arg->which == Stackel_NUMBER)
  3606. Melder_appendError_noLine (arg->number);
  3607. else if (arg->which == Stackel_STRING)
  3608. Melder_appendError_noLine (arg->getString());
  3609. }
  3610. Melder_throw (U"\nScript exited.");
  3611. pushNumber (1);
  3612. }
  3613. static void do_runScript () {
  3614. Stackel narg = pop;
  3615. Melder_assert (narg->which == Stackel_NUMBER);
  3616. integer numberOfArguments = Melder_iround (narg->number);
  3617. if (numberOfArguments < 1)
  3618. Melder_throw (U"The function \"runScript\" requires at least one argument, namely the file name.");
  3619. w -= numberOfArguments;
  3620. Stackel fileName = & theStack [w + 1];
  3621. if (fileName->which != Stackel_STRING)
  3622. Melder_throw (U"The first argument to \"runScript\" has to be a string (the file name), not ", fileName->whichText());
  3623. theLevel += 1;
  3624. try {
  3625. praat_executeScriptFromFileName (fileName->getString(), numberOfArguments - 1, & theStack [w + 1]);
  3626. theLevel -= 1;
  3627. } catch (MelderError) {
  3628. theLevel -= 1;
  3629. throw;
  3630. }
  3631. pushNumber (1);
  3632. }
  3633. static void do_runSystem () {
  3634. if (theCurrentPraatObjects != & theForegroundPraatObjects)
  3635. Melder_throw (U"The function \"runSystem\" is not available inside manuals.");
  3636. Stackel narg = pop;
  3637. Melder_assert (narg->which == Stackel_NUMBER);
  3638. integer numberOfArguments = Melder_iround (narg->number);
  3639. w -= numberOfArguments;
  3640. autoMelderString text;
  3641. for (integer iarg = 1; iarg <= numberOfArguments; iarg ++) {
  3642. Stackel arg = & theStack [w + iarg];
  3643. if (arg->which == Stackel_NUMBER)
  3644. MelderString_append (& text, arg->number);
  3645. else if (arg->which == Stackel_STRING)
  3646. MelderString_append (& text, arg->getString());
  3647. }
  3648. try {
  3649. Melder_system (text.string);
  3650. } catch (MelderError) {
  3651. Melder_throw (U"System command \"", text.string, U"\" returned error status;\n"
  3652. U"if you want to ignore this, use `runSystem_nocheck' instead of `runSystem'.");
  3653. }
  3654. pushNumber (1);
  3655. }
  3656. static void do_runSystem_nocheck () {
  3657. if (theCurrentPraatObjects != & theForegroundPraatObjects)
  3658. Melder_throw (U"The function \"runSystem\" is not available inside manuals.");
  3659. Stackel narg = pop;
  3660. Melder_assert (narg->which == Stackel_NUMBER);
  3661. integer numberOfArguments = Melder_iround (narg->number);
  3662. w -= numberOfArguments;
  3663. autoMelderString text;
  3664. for (int iarg = 1; iarg <= numberOfArguments; iarg ++) {
  3665. Stackel arg = & theStack [w + iarg];
  3666. if (arg->which == Stackel_NUMBER)
  3667. MelderString_append (& text, arg->number);
  3668. else if (arg->which == Stackel_STRING)
  3669. MelderString_append (& text, arg->getString());
  3670. }
  3671. try {
  3672. Melder_system (text.string);
  3673. } catch (MelderError) {
  3674. Melder_clearError ();
  3675. }
  3676. pushNumber (1);
  3677. }
  3678. static void do_runSubprocess () {
  3679. if (theCurrentPraatObjects != & theForegroundPraatObjects)
  3680. Melder_throw (U"The function \"runSubprocess\" is not available inside manuals.");
  3681. Stackel narg = pop;
  3682. Melder_assert (narg->which == Stackel_NUMBER);
  3683. integer numberOfArguments = Melder_iround (narg->number);
  3684. w -= numberOfArguments;
  3685. Stackel commandFile = & theStack [w + 1];
  3686. if (commandFile->which != Stackel_STRING)
  3687. Melder_throw (U"The first argument to \"runSubprocess\" has to be a command name.");
  3688. autostring32vector arguments (numberOfArguments - 1);
  3689. for (int iarg = 1; iarg < numberOfArguments; iarg ++) {
  3690. Stackel arg = & theStack [w + 1 + iarg];
  3691. if (arg->which == Stackel_NUMBER)
  3692. arguments [iarg] = Melder_dup (Melder_double (arg->number));
  3693. else if (arg->which == Stackel_STRING)
  3694. arguments [iarg] = Melder_dup (arg->getString());
  3695. }
  3696. try {
  3697. Melder_execv (commandFile->getString(), numberOfArguments - 1, arguments.peek2());
  3698. } catch (MelderError) {
  3699. Melder_throw (U"Command \"", commandFile->getString(), U"\" returned error status.");
  3700. }
  3701. pushNumber (1);
  3702. }
  3703. static void do_min () {
  3704. Stackel n = pop, last;
  3705. double result;
  3706. Melder_assert (n->which == Stackel_NUMBER);
  3707. if (n->number < 1)
  3708. Melder_throw (U"The function \"min\" requires at least one argument.");
  3709. last = pop;
  3710. if (last->which != Stackel_NUMBER)
  3711. Melder_throw (U"The function \"min\" can only have numeric arguments, not ", last->whichText(), U".");
  3712. result = last->number;
  3713. for (integer j = Melder_iround (n->number) - 1; j > 0; j --) {
  3714. Stackel previous = pop;
  3715. if (previous->which != Stackel_NUMBER)
  3716. Melder_throw (U"The function \"min\" can only have numeric arguments, not ", previous->whichText(), U".");
  3717. result = isundef (result) || isundef (previous->number) ? undefined :
  3718. result < previous->number ? result : previous->number;
  3719. }
  3720. pushNumber (result);
  3721. }
  3722. static void do_max () {
  3723. Stackel n = pop, last;
  3724. double result;
  3725. Melder_assert (n->which == Stackel_NUMBER);
  3726. if (n->number < 1)
  3727. Melder_throw (U"The function \"max\" requires at least one argument.");
  3728. last = pop;
  3729. if (last->which != Stackel_NUMBER)
  3730. Melder_throw (U"The function \"max\" can only have numeric arguments, not ", last->whichText(), U".");
  3731. result = last->number;
  3732. for (integer j = Melder_iround (n->number) - 1; j > 0; j --) {
  3733. Stackel previous = pop;
  3734. if (previous->which != Stackel_NUMBER)
  3735. Melder_throw (U"The function \"max\" can only have numeric arguments, not ", previous->whichText(), U".");
  3736. result = isundef (result) || isundef (previous->number) ? undefined :
  3737. result > previous->number ? result : previous->number;
  3738. }
  3739. pushNumber (result);
  3740. }
  3741. static void do_imin () {
  3742. Stackel n = pop, last;
  3743. double minimum, result;
  3744. Melder_assert (n->which == Stackel_NUMBER);
  3745. if (n->number < 1)
  3746. Melder_throw (U"The function \"imin\" requires at least one argument.");
  3747. last = pop;
  3748. if (last->which != Stackel_NUMBER)
  3749. Melder_throw (U"The function \"imin\" can only have numeric arguments, not ", last->whichText(), U".");
  3750. minimum = last->number;
  3751. result = n->number;
  3752. for (integer j = Melder_iround (n->number) - 1; j > 0; j --) {
  3753. Stackel previous = pop;
  3754. if (previous->which != Stackel_NUMBER)
  3755. Melder_throw (U"The function \"imin\" can only have numeric arguments, not ", previous->whichText(), U".");
  3756. if (isundef (minimum) || isundef (previous->number)) {
  3757. minimum = undefined;
  3758. result = undefined;
  3759. } else if (previous->number < minimum) {
  3760. minimum = previous->number;
  3761. result = j;
  3762. }
  3763. }
  3764. pushNumber (result);
  3765. }
  3766. static void do_imax () {
  3767. Stackel n = pop;
  3768. Melder_assert (n->which == Stackel_NUMBER);
  3769. if (n->number < 1)
  3770. Melder_throw (U"The function \"imax\" requires at least one argument.");
  3771. Stackel last = pop;
  3772. if (last->which == Stackel_NUMBER) {
  3773. double maximum = last->number;
  3774. double result = n->number;
  3775. for (integer j = Melder_iround (n->number) - 1; j > 0; j --) {
  3776. Stackel previous = pop;
  3777. if (previous->which != Stackel_NUMBER)
  3778. Melder_throw (U"The function \"imax\" cannot mix a numeric argument with ", previous->whichText(), U".");
  3779. if (isundef (maximum) || isundef (previous->number)) {
  3780. maximum = undefined;
  3781. result = undefined;
  3782. } else if (previous->number > maximum) {
  3783. maximum = previous->number;
  3784. result = j;
  3785. }
  3786. }
  3787. pushNumber (result);
  3788. } else if (last->which == Stackel_NUMERIC_VECTOR) {
  3789. if (n->number != 1)
  3790. Melder_throw (U"The function \"imax\" requires exactly one vector argument.");
  3791. integer numberOfElements = last->numericVector.size;
  3792. integer result = 1;
  3793. double maximum = last->numericVector [1];
  3794. for (integer i = 2; i <= numberOfElements; i ++) {
  3795. if (last->numericVector [i] > maximum) {
  3796. result = i;
  3797. maximum = last->numericVector [i];
  3798. }
  3799. }
  3800. pushNumber (result);
  3801. } else {
  3802. Stackel nn = pop;
  3803. Melder_throw (U"Cannot compute the imax of ", nn->whichText(), U".");
  3804. }
  3805. }
  3806. static void do_norm () {
  3807. Stackel n = pop;
  3808. Melder_assert (n->which == Stackel_NUMBER);
  3809. if (n->number < 1 || n->number > 2)
  3810. Melder_throw (U"The function \"norm\" requires one or two arguments.");
  3811. double powerNumber = 2.0;
  3812. if (n->number == 2) {
  3813. Stackel power = pop;
  3814. if (power->which != Stackel_NUMBER)
  3815. Melder_throw (U"The second argument to \"norm\" should be a number, not ", power->whichText(), U".");
  3816. powerNumber = power->number;
  3817. }
  3818. Stackel x = pop;
  3819. if (x->which == Stackel_NUMERIC_VECTOR) {
  3820. pushNumber (NUMnorm (x->numericVector, powerNumber));
  3821. } else if (x->which == Stackel_NUMERIC_MATRIX) {
  3822. pushNumber (NUMnorm (x->numericMatrix, powerNumber));
  3823. } else {
  3824. Melder_throw (U"Cannot compute the norm of ", x->whichText(), U".");
  3825. }
  3826. }
  3827. static void do_VECzero () {
  3828. Stackel n = pop;
  3829. Melder_assert (n -> which == Stackel_NUMBER);
  3830. integer rank = Melder_iround (n -> number);
  3831. if (rank < 1)
  3832. Melder_throw (U"The function \"zero#\" requires an argument.");
  3833. if (rank > 1) {
  3834. Melder_throw (U"The function \"zero#\" cannot have more than one argument (consider using zero##).");
  3835. }
  3836. Stackel nelem = pop;
  3837. if (nelem -> which != Stackel_NUMBER)
  3838. Melder_throw (U"In the function \"zero#\", the number of elements has to be a number, not ", nelem->whichText(), U".");
  3839. double numberOfElements = nelem -> number;
  3840. if (isundef (numberOfElements))
  3841. Melder_throw (U"In the function \"zero#\", the number of elements is undefined.");
  3842. if (numberOfElements < 0.0)
  3843. Melder_throw (U"In the function \"zero#\", the number of elements should not be negative.");
  3844. pushNumericVector (VECzero (Melder_iround (numberOfElements)));
  3845. }
  3846. static void do_MATzero () {
  3847. Stackel n = pop;
  3848. Melder_assert (n -> which == Stackel_NUMBER);
  3849. integer rank = Melder_iround (n -> number);
  3850. if (rank != 2)
  3851. Melder_throw (U"The function \"zero##\" requires two arguments.");
  3852. Stackel ncol = pop;
  3853. if (ncol -> which != Stackel_NUMBER)
  3854. Melder_throw (U"In the function \"zero##\", the number of columns has to be a number, not ", ncol->whichText(), U".");
  3855. double numberOfColumns = ncol -> number;
  3856. Stackel nrow = pop;
  3857. if (nrow -> which != Stackel_NUMBER)
  3858. Melder_throw (U"In the function \"zero##\", the number of rows has to be a number, not ", nrow->whichText(), U".");
  3859. double numberOfRows = nrow -> number;
  3860. if (isundef (numberOfRows))
  3861. Melder_throw (U"In the function \"zero##\", the number of rows is undefined.");
  3862. if (isundef (numberOfColumns))
  3863. Melder_throw (U"In the function \"zero##\", the number of columns is undefined.");
  3864. if (numberOfRows < 0.0)
  3865. Melder_throw (U"In the function \"zero##\", the number of rows should not be negative.");
  3866. if (numberOfColumns < 0.0)
  3867. Melder_throw (U"In the function \"zero##\", the number of columns should not be negative.");
  3868. autoMAT result = MATzero (Melder_iround (numberOfRows), Melder_iround (numberOfColumns));
  3869. pushNumericMatrix (result.move());
  3870. }
  3871. static void do_VEClinear () {
  3872. Stackel stackel_narg = pop;
  3873. Melder_assert (stackel_narg -> which == Stackel_NUMBER);
  3874. integer narg = Melder_iround (stackel_narg -> number);
  3875. if (narg < 3 || narg > 4)
  3876. Melder_throw (U"The function \"linear#\" requires three or four arguments.");
  3877. bool excludeEdges = false; // default
  3878. if (narg == 4) {
  3879. Stackel stack_excludeEdges = pop;
  3880. if (stack_excludeEdges -> which != Stackel_NUMBER)
  3881. Melder_throw (U"In the function \"linear#\", the edge exclusion flag (fourth argument) has to be a number, not ", stack_excludeEdges->whichText(), U".");
  3882. excludeEdges = Melder_iround (stack_excludeEdges -> number);
  3883. }
  3884. Stackel stack_numberOfSteps = pop, stack_maximum = pop, stack_minimum = pop;
  3885. if (stack_minimum -> which != Stackel_NUMBER)
  3886. Melder_throw (U"In the function \"linear#\", the minimum (first argument) has to be a number, not ", stack_minimum->whichText(), U".");
  3887. double minimum = stack_minimum -> number;
  3888. if (isundef (minimum))
  3889. Melder_throw (U"Undefined minimum in the function \"linear#\" (first argument).");
  3890. if (stack_maximum -> which != Stackel_NUMBER)
  3891. Melder_throw (U"In the function \"linear#\", the maximum (second argument) has to be a number, not ", stack_maximum->whichText(), U".");
  3892. double maximum = stack_maximum -> number;
  3893. if (isundef (maximum))
  3894. Melder_throw (U"Undefined maximum in the function \"linear#\" (second argument).");
  3895. if (maximum < minimum)
  3896. Melder_throw (U"Maximum (", maximum, U") smaller than minimum (", minimum, U") in function \"linear#\".");
  3897. if (stack_numberOfSteps -> which != Stackel_NUMBER)
  3898. Melder_throw (U"In the function \"linear#\", the number of steps (third argument) has to be a number, not ", stack_numberOfSteps->whichText(), U".");
  3899. if (isundef (stack_numberOfSteps -> number))
  3900. Melder_throw (U"Undefined number of steps in the function \"linear#\" (third argument).");
  3901. integer numberOfSteps = Melder_iround (stack_numberOfSteps -> number);
  3902. if (numberOfSteps <= 0)
  3903. Melder_throw (U"In the function \"linear#\", the number of steps (third argument) has to be positive, not ", numberOfSteps, U".");
  3904. autoVEC result = VECraw (numberOfSteps);
  3905. for (integer ielem = 1; ielem <= numberOfSteps; ielem ++) {
  3906. result [ielem] = excludeEdges ?
  3907. minimum + (ielem - 0.5) * (maximum - minimum) / numberOfSteps :
  3908. minimum + (ielem - 1) * (maximum - minimum) / (numberOfSteps - 1);
  3909. }
  3910. if (! excludeEdges) result [numberOfSteps] = maximum; // remove rounding problems
  3911. pushNumericVector (result.move());
  3912. }
  3913. static void do_VECto () {
  3914. Stackel stackel_narg = pop;
  3915. Melder_assert (stackel_narg -> which == Stackel_NUMBER);
  3916. integer narg = (integer) stackel_narg -> number;
  3917. if (narg != 1)
  3918. Melder_throw (U"The function to#() requires one argument.");
  3919. Stackel stack_to = pop;
  3920. if (stack_to -> which != Stackel_NUMBER)
  3921. Melder_throw (U"In the function \"to#\", the argument has to be a number, not ", stack_to->whichText(), U".");
  3922. integer to = Melder_iround (stack_to -> number);
  3923. autoVEC result = VECto (to);
  3924. pushNumericVector (result.move());
  3925. }
  3926. static void do_MATpeaks () {
  3927. Stackel n = pop;
  3928. Melder_assert (n->which == Stackel_NUMBER);
  3929. if (n->number != 4)
  3930. Melder_throw (U"The function peaks## requires four arguments (vector, edges, interpolation, sortByHeight).");
  3931. Stackel s = pop;
  3932. if (s->which != Stackel_NUMBER)
  3933. Melder_throw (U"The fourth argument to peaks## has to be a number, not ", s->whichText(), U".");
  3934. bool sortByHeight = s->number != 0.0;
  3935. Stackel i = pop;
  3936. if (i->which != Stackel_NUMBER)
  3937. Melder_throw (U"The third argument to peaks## has to be a number, not ", i->whichText(), U".");
  3938. integer interpolation = Melder_iround (i->number);
  3939. Stackel e = pop;
  3940. if (e->which != Stackel_NUMBER)
  3941. Melder_throw (U"The second argument to peaks## has to be a number, not ", e->whichText(), U".");
  3942. bool includeEdges = e->number != 0.0;
  3943. Stackel vec = pop;
  3944. if (vec->which != Stackel_NUMERIC_VECTOR)
  3945. Melder_throw (U"The first argument to peaks## has to be a numeric vector, not ", vec->whichText(), U".");
  3946. autoMAT result = MATpeaks (vec->numericVector, includeEdges, interpolation, sortByHeight);
  3947. pushNumericMatrix (result.move());
  3948. }
  3949. static void do_size () {
  3950. Stackel n = pop;
  3951. Melder_assert (n->which == Stackel_NUMBER);
  3952. if (n->number != 1)
  3953. Melder_throw (U"The function \"size\" requires one (vector) argument.");
  3954. Stackel array = pop;
  3955. if (array->which == Stackel_NUMERIC_VECTOR) {
  3956. pushNumber (array->numericVector.size);
  3957. } else {
  3958. Melder_throw (U"The function size requires a vector argument, not ", array->whichText(), U".");
  3959. }
  3960. }
  3961. static void do_numberOfRows () {
  3962. Stackel n = pop;
  3963. Melder_assert (n->which == Stackel_NUMBER);
  3964. if (n->number != 1)
  3965. Melder_throw (U"The function \"numberOfRows\" requires one argument.");
  3966. Stackel array = pop;
  3967. if (array->which == Stackel_NUMERIC_MATRIX) {
  3968. pushNumber (array->numericMatrix.nrow);
  3969. } else {
  3970. Melder_throw (U"The function ", Formula_instructionNames [parse [programPointer]. symbol],
  3971. U" requires a matrix argument, not ", array->whichText(), U".");
  3972. }
  3973. }
  3974. static void do_numberOfColumns () {
  3975. Stackel n = pop;
  3976. Melder_assert (n->which == Stackel_NUMBER);
  3977. if (n->number != 1)
  3978. Melder_throw (U"The function \"numberOfColumns\" requires one argument.");
  3979. Stackel array = pop;
  3980. if (array->which == Stackel_NUMERIC_MATRIX) {
  3981. pushNumber (array->numericMatrix.ncol);
  3982. } else {
  3983. Melder_throw (U"The function ", Formula_instructionNames [parse [programPointer]. symbol],
  3984. U" requires a matrix argument, not ", array->whichText(), U".");
  3985. }
  3986. }
  3987. static void do_editor () {
  3988. Stackel n = pop;
  3989. Melder_assert (n->which == Stackel_NUMBER);
  3990. if (n->number == 0) {
  3991. if (theInterpreter && theInterpreter -> editorClass) {
  3992. praatP. editor = praat_findEditorFromString (theInterpreter -> environmentName.get());
  3993. } else {
  3994. Melder_throw (U"The function \"editor\" requires an argument when called from outside an editor.");
  3995. }
  3996. } else if (n->number == 1) {
  3997. Stackel editor = pop;
  3998. if (editor->which == Stackel_STRING) {
  3999. praatP. editor = praat_findEditorFromString (editor->getString());
  4000. } else if (editor->which == Stackel_NUMBER) {
  4001. praatP. editor = praat_findEditorById (Melder_iround (editor->number));
  4002. } else {
  4003. Melder_throw (U"The function \"editor\" requires a numeric or string argument, not ", editor->whichText(), U".");
  4004. }
  4005. } else {
  4006. Melder_throw (U"The function \"editor\" requires 0 or 1 arguments, not ", n->number, U".");
  4007. }
  4008. pushNumber (1);
  4009. }
  4010. static void do_hash () {
  4011. Stackel n = pop;
  4012. Melder_assert (n->which == Stackel_NUMBER);
  4013. if (n->number == 1) {
  4014. Stackel s = pop;
  4015. if (s->which == Stackel_STRING) {
  4016. double result = NUMhashString (s->getString());
  4017. pushNumber (result);
  4018. } else {
  4019. Melder_throw (U"The function \"hash\" requires a string, not ", s->whichText(), U".");
  4020. }
  4021. } else {
  4022. Melder_throw (U"The function \"hash\" requires 1 argument, not ", n->number, U".");
  4023. }
  4024. }
  4025. static void do_numericVectorElement () {
  4026. InterpreterVariable vector = parse [programPointer]. content.variable;
  4027. integer element = 1; // default
  4028. Stackel r = pop;
  4029. if (r -> which != Stackel_NUMBER)
  4030. Melder_throw (U"In vector indexing, the index has to be a number, not ", r->whichText(), U".");
  4031. if (isundef (r -> number))
  4032. Melder_throw (U"The element index is undefined.");
  4033. element = Melder_iround (r -> number);
  4034. if (element <= 0)
  4035. Melder_throw (U"In vector indexing, the element index has to be positive.");
  4036. if (element > vector -> numericVectorValue.size)
  4037. Melder_throw (U"Element index out of bounds.");
  4038. pushNumber (vector -> numericVectorValue [element]);
  4039. }
  4040. static void do_numericMatrixElement () {
  4041. InterpreterVariable matrix = parse [programPointer]. content.variable;
  4042. integer row = 1, column = 1; // default
  4043. Stackel c = pop;
  4044. if (c -> which != Stackel_NUMBER)
  4045. Melder_throw (U"In matrix indexing, the column index has to be a number, not ", c->whichText(), U".");
  4046. if (isundef (c -> number))
  4047. Melder_throw (U"The column index is undefined.");
  4048. column = Melder_iround (c -> number);
  4049. if (column <= 0)
  4050. Melder_throw (U"In matrix indexing, the column index has to be positive.");
  4051. if (column > matrix -> numericMatrixValue. ncol)
  4052. Melder_throw (U"Column index out of bounds.");
  4053. Stackel r = pop;
  4054. if (r -> which != Stackel_NUMBER)
  4055. Melder_throw (U"In matrix indexing, the row index has to be a number, not ", r->whichText(), U".");
  4056. if (isundef (r -> number))
  4057. Melder_throw (U"The row index is undefined.");
  4058. row = Melder_iround (r -> number);
  4059. if (row <= 0)
  4060. Melder_throw (U"In matrix indexing, the row index has to be positive.");
  4061. if (row > matrix -> numericMatrixValue. nrow)
  4062. Melder_throw (U"Row index out of bounds.");
  4063. pushNumber (matrix -> numericMatrixValue [row] [column]);
  4064. }
  4065. static void do_indexedNumericVariable () {
  4066. Stackel n = pop;
  4067. Melder_assert (n -> which == Stackel_NUMBER);
  4068. integer nindex = Melder_iround (n -> number);
  4069. if (nindex < 1)
  4070. Melder_throw (U"Indexed variables require at least one index.");
  4071. char32 *indexedVariableName = parse [programPointer]. content.string;
  4072. static MelderString totalVariableName { };
  4073. MelderString_copy (& totalVariableName, indexedVariableName, U"[");
  4074. w -= nindex;
  4075. for (int iindex = 1; iindex <= nindex; iindex ++) {
  4076. Stackel index = & theStack [w + iindex];
  4077. if (index -> which == Stackel_NUMBER) {
  4078. MelderString_append (& totalVariableName, index -> number, iindex == nindex ? U"]" : U",");
  4079. } else if (index -> which == Stackel_STRING) {
  4080. MelderString_append (& totalVariableName, U"\"", index -> getString(), U"\"", iindex == nindex ? U"]" : U",");
  4081. } else {
  4082. Melder_throw (U"In indexed variables, the index has to be a number or a string, not ", index->whichText(), U".");
  4083. }
  4084. }
  4085. InterpreterVariable var = Interpreter_hasVariable (theInterpreter, totalVariableName.string);
  4086. if (! var)
  4087. Melder_throw (U"Undefined indexed variable «", totalVariableName.string, U"».");
  4088. pushNumber (var -> numericValue);
  4089. }
  4090. static void do_indexedStringVariable () {
  4091. Stackel n = pop;
  4092. Melder_assert (n -> which == Stackel_NUMBER);
  4093. integer nindex = Melder_iround (n -> number);
  4094. if (nindex < 1)
  4095. Melder_throw (U"Indexed variables require at least one index.");
  4096. char32 *indexedVariableName = parse [programPointer]. content.string;
  4097. static MelderString totalVariableName { };
  4098. MelderString_copy (& totalVariableName, indexedVariableName, U"[");
  4099. w -= nindex;
  4100. for (int iindex = 1; iindex <= nindex; iindex ++) {
  4101. Stackel index = & theStack [w + iindex];
  4102. if (index -> which == Stackel_NUMBER) {
  4103. MelderString_append (& totalVariableName, index -> number, iindex == nindex ? U"]" : U",");
  4104. } else if (index -> which == Stackel_STRING) {
  4105. MelderString_append (& totalVariableName, U"\"", index -> getString(), U"\"", iindex == nindex ? U"]" : U",");
  4106. } else {
  4107. Melder_throw (U"In indexed variables, the index has to be a number or a string, not ", index->whichText(), U".");
  4108. }
  4109. }
  4110. InterpreterVariable var = Interpreter_hasVariable (theInterpreter, totalVariableName.string);
  4111. if (! var)
  4112. Melder_throw (U"Undefined indexed variable «", totalVariableName.string, U"».");
  4113. autostring32 result = Melder_dup (var -> stringValue.get());
  4114. pushString (result.move());
  4115. }
  4116. static void do_length () {
  4117. Stackel s = pop;
  4118. if (s->which == Stackel_STRING) {
  4119. double result = str32len (s->getString());
  4120. pushNumber (result);
  4121. } else {
  4122. Melder_throw (U"The function \"length\" requires a string, not ", s->whichText(), U".");
  4123. }
  4124. }
  4125. static void do_number () {
  4126. Stackel s = pop;
  4127. if (s->which == Stackel_STRING) {
  4128. double result = Melder_atof (s->getString());
  4129. pushNumber (result);
  4130. } else {
  4131. Melder_throw (U"The function \"number\" requires a string, not ", s->whichText(), U".");
  4132. }
  4133. }
  4134. static void do_fileReadable () {
  4135. Stackel s = pop;
  4136. if (s->which == Stackel_STRING) {
  4137. structMelderFile file { };
  4138. Melder_relativePathToFile (s->getString(), & file);
  4139. pushNumber (MelderFile_readable (& file));
  4140. } else {
  4141. Melder_throw (U"The function \"fileReadable\" requires a string, not ", s->whichText(), U".");
  4142. }
  4143. }
  4144. static void do_STRdate () {
  4145. pushString (STRdate ());
  4146. }
  4147. static void do_infoStr () {
  4148. autostring32 info = Melder_dup (Melder_getInfo ());
  4149. pushString (info.move());
  4150. }
  4151. static void do_STRleft () {
  4152. trace (U"enter");
  4153. Stackel narg = pop;
  4154. if (narg->number == 1) {
  4155. Stackel s = pop;
  4156. if (s->which == Stackel_STRING) {
  4157. pushString (STRleft (s->getString()));
  4158. } else {
  4159. Melder_throw (U"The function \"left$\" requires a string (or a string and a number).");
  4160. }
  4161. } else if (narg->number == 2) {
  4162. Stackel n = pop, s = pop;
  4163. if (s->which == Stackel_STRING && n->which == Stackel_NUMBER) {
  4164. pushString (STRleft (s->getString(), Melder_iround (n->number)));
  4165. } else {
  4166. Melder_throw (U"The function \"left$\" requires a string and a number (or a string only).");
  4167. }
  4168. } else {
  4169. Melder_throw (U"The function \"left$\" requires one or two arguments: a string and optionally a number.");
  4170. }
  4171. trace (U"exit");
  4172. }
  4173. static void do_STRright () {
  4174. Stackel narg = pop;
  4175. if (narg->number == 1) {
  4176. Stackel s = pop;
  4177. if (s->which == Stackel_STRING) {
  4178. pushString (STRright (s->getString()));
  4179. } else {
  4180. Melder_throw (U"The function \"right$\" requires a string (or a string and a number).");
  4181. }
  4182. } else if (narg->number == 2) {
  4183. Stackel n = pop, s = pop;
  4184. if (s->which == Stackel_STRING && n->which == Stackel_NUMBER) {
  4185. pushString (STRright (s->getString(), Melder_iround (n->number)));
  4186. } else {
  4187. Melder_throw (U"The function \"right$\" requires a string and a number (or a string only).");
  4188. }
  4189. } else {
  4190. Melder_throw (U"The function \"right$\" requires one or two arguments: a string and optionally a number.");
  4191. }
  4192. }
  4193. static void do_STRmid () {
  4194. Stackel narg = pop;
  4195. if (narg->number == 2) {
  4196. Stackel position = pop, str = pop;
  4197. if (str->which == Stackel_STRING && position->which == Stackel_NUMBER) {
  4198. pushString (STRmid (str->getString(), Melder_iround (position->number)));
  4199. } else {
  4200. Melder_throw (U"The function \"mid$\" requires a string and a number (or two).");
  4201. }
  4202. } else if (narg->number == 3) {
  4203. Stackel numberOfCharacters = pop, startingPosition = pop, str = pop;
  4204. if (str->which == Stackel_STRING && startingPosition->which == Stackel_NUMBER && numberOfCharacters->which == Stackel_NUMBER) {
  4205. pushString (STRmid (str->getString(), Melder_iround (startingPosition->number), Melder_iround (numberOfCharacters->number)));
  4206. } else {
  4207. Melder_throw (U"The function \"mid$\" requires a string and two numbers (or one).");
  4208. }
  4209. } else {
  4210. Melder_throw (U"The function \"mid$\" requires two or three arguments.");
  4211. }
  4212. }
  4213. static void do_unicodeToBackslashTrigraphsStr () {
  4214. Stackel s = pop;
  4215. if (s->which == Stackel_STRING) {
  4216. integer length = str32len (s->getString());
  4217. autostring32 trigraphs (3 * length);
  4218. Longchar_genericize32 (s->getString(), trigraphs.get());
  4219. pushString (trigraphs.move());
  4220. } else {
  4221. Melder_throw (U"The function \"unicodeToBackslashTrigraphs$\" requires a string, not ", s->whichText(), U".");
  4222. }
  4223. }
  4224. static void do_backslashTrigraphsToUnicodeStr () {
  4225. Stackel s = pop;
  4226. if (s->which == Stackel_STRING) {
  4227. integer length = str32len (s->getString());
  4228. autostring32 unicode (length);
  4229. Longchar_nativize32 (s->getString(), unicode.get(), false); // noexcept
  4230. pushString (unicode.move());
  4231. } else {
  4232. Melder_throw (U"The function \"unicodeToBackslashTrigraphs$\" requires a string, not ", s->whichText(), U".");
  4233. }
  4234. }
  4235. static void do_environmentStr () {
  4236. Stackel s = pop;
  4237. if (s->which == Stackel_STRING) {
  4238. conststring32 value = Melder_getenv (s->getString());
  4239. autostring32 result = Melder_dup (value ? value : U"");
  4240. pushString (result.move());
  4241. } else {
  4242. Melder_throw (U"The function \"environment$\" requires a string, not ", s->whichText(), U".");
  4243. }
  4244. }
  4245. static void do_index () {
  4246. Stackel t = pop, s = pop;
  4247. if (s->which == Stackel_STRING && t->which == Stackel_STRING) {
  4248. char32 *substring = str32str (s->getString(), t->getString());
  4249. integer result = substring ? substring - s->getString() + 1 : 0;
  4250. pushNumber (result);
  4251. } else {
  4252. Melder_throw (U"The function \"index\" requires two strings, not ",
  4253. s->whichText(), U" and ", t->whichText(), U".");
  4254. }
  4255. }
  4256. static void do_rindex () {
  4257. Stackel part = pop, whole = pop;
  4258. if (whole->which == Stackel_STRING && part->which == Stackel_STRING) {
  4259. char32 *lastSubstring = str32str (whole->getString(), part->getString());
  4260. if (part->getString() [0] == U'\0') {
  4261. integer result = str32len (whole->getString());
  4262. pushNumber (result);
  4263. } else if (lastSubstring) {
  4264. for (;;) {
  4265. char32 *substring = str32str (lastSubstring + 1, part->getString());
  4266. if (! substring) break;
  4267. lastSubstring = substring;
  4268. }
  4269. pushNumber (lastSubstring - whole->getString() + 1);
  4270. } else {
  4271. pushNumber (0);
  4272. }
  4273. } else {
  4274. Melder_throw (U"The function \"rindex\" requires two strings, not ",
  4275. whole->whichText(), U" and ", part->whichText(), U".");
  4276. }
  4277. }
  4278. static void do_stringMatchesCriterion (kMelder_string criterion) {
  4279. Stackel t = pop, s = pop;
  4280. if (s->which == Stackel_STRING && t->which == Stackel_STRING) {
  4281. int result = Melder_stringMatchesCriterion (s->getString(), criterion, t->getString(), true);
  4282. pushNumber (result);
  4283. } else {
  4284. Melder_throw (U"The function \"", Formula_instructionNames [parse [programPointer]. symbol],
  4285. U"\" requires two strings, not ", s->whichText(), U" and ", t->whichText(), U".");
  4286. }
  4287. }
  4288. static void do_index_regex (int backward) {
  4289. Stackel t = pop, s = pop;
  4290. if (s->which == Stackel_STRING && t->which == Stackel_STRING) {
  4291. conststring32 errorMessage;
  4292. regexp *compiled_regexp = CompileRE (t->getString(), & errorMessage, 0);
  4293. if (! compiled_regexp) {
  4294. Melder_throw (U"index_regex(): ", errorMessage, U".");
  4295. } else {
  4296. if (ExecRE (compiled_regexp, nullptr, s->getString(), nullptr, backward, U'\0', U'\0', nullptr, nullptr)) {
  4297. char32 *location = (char32 *) compiled_regexp -> startp [0];
  4298. pushNumber (location - s->getString() + 1);
  4299. free (compiled_regexp);
  4300. } else {
  4301. pushNumber (false);
  4302. }
  4303. }
  4304. } else {
  4305. Melder_throw (U"The function \"", Formula_instructionNames [parse [programPointer]. symbol],
  4306. U"\" requires two strings, not ", s->whichText(), U" and ", t->whichText(), U".");
  4307. }
  4308. }
  4309. static void do_STRreplace () {
  4310. Stackel x = pop, u = pop, t = pop, s = pop;
  4311. if (s->which == Stackel_STRING && t->which == Stackel_STRING && u->which == Stackel_STRING && x->which == Stackel_NUMBER) {
  4312. autostring32 result = STRreplace (s->getString(), t->getString(), u->getString(), Melder_iround (x->number));
  4313. pushString (result.move());
  4314. } else {
  4315. Melder_throw (U"The function \"replace$\" requires three strings and a number.");
  4316. }
  4317. }
  4318. static void do_STRreplace_regex () {
  4319. Stackel x = pop, u = pop, t = pop, s = pop;
  4320. if (s->which == Stackel_STRING && t->which == Stackel_STRING && u->which == Stackel_STRING && x->which == Stackel_NUMBER) {
  4321. conststring32 errorMessage;
  4322. regexp *compiled_regexp = CompileRE (t->getString(), & errorMessage, 0);
  4323. if (! compiled_regexp) {
  4324. Melder_throw (U"replace_regex$(): ", errorMessage, U".");
  4325. } else {
  4326. autostring32 result = STRreplace_regex (s->getString(), compiled_regexp, u->getString(), Melder_iround (x->number));
  4327. pushString (result.move());
  4328. }
  4329. } else {
  4330. Melder_throw (U"The function \"replace_regex$\" requires three strings and a number.");
  4331. }
  4332. }
  4333. static void do_extractNumber () {
  4334. Stackel t = pop, s = pop;
  4335. if (s->which == Stackel_STRING && t->which == Stackel_STRING) {
  4336. char32 *substring = str32str (s->getString(), t->getString());
  4337. if (! substring) {
  4338. pushNumber (undefined);
  4339. } else {
  4340. /* Skip the prompt. */
  4341. substring += str32len (t->getString());
  4342. /* Skip white space. */
  4343. while (Melder_isHorizontalOrVerticalSpace (*substring)) substring ++;
  4344. if (substring [0] == U'\0' || str32nequ (substring, U"--undefined--", 13)) {
  4345. pushNumber (undefined);
  4346. } else {
  4347. char32 buffer [101], *slash;
  4348. int i = 0;
  4349. for (; i < 100; i ++) {
  4350. buffer [i] = *substring;
  4351. substring ++;
  4352. if (*substring == U'\0' || Melder_isHorizontalOrVerticalSpace (*substring))
  4353. break;
  4354. }
  4355. if (i >= 100) {
  4356. buffer [100] = U'\0';
  4357. pushNumber (Melder_atof (buffer));
  4358. } else {
  4359. buffer [i + 1] = U'\0';
  4360. slash = str32chr (buffer, U'/');
  4361. if (slash) {
  4362. double numerator, denominator;
  4363. *slash = U'\0';
  4364. numerator = Melder_atof (buffer), denominator = Melder_atof (slash + 1);
  4365. pushNumber (numerator / denominator);
  4366. } else {
  4367. pushNumber (Melder_atof (buffer));
  4368. }
  4369. }
  4370. }
  4371. }
  4372. } else {
  4373. Melder_throw (U"The function \"", Formula_instructionNames [parse [programPointer]. symbol],
  4374. U"\" requires two strings, not ", s->whichText(), U" and ", t->whichText(), U".");
  4375. }
  4376. }
  4377. static void do_extractTextStr (bool singleWord) {
  4378. Stackel t = pop, s = pop;
  4379. if (s->which == Stackel_STRING && t->which == Stackel_STRING) {
  4380. char32 *substring = str32str (s->getString(), t->getString());
  4381. autostring32 result;
  4382. if (! substring) {
  4383. result = Melder_dup (U"");
  4384. } else {
  4385. integer length;
  4386. /* Skip the prompt. */
  4387. substring += str32len (t->getString());
  4388. if (singleWord) {
  4389. /* Skip white space. */
  4390. while (Melder_isHorizontalOrVerticalSpace (*substring)) substring ++;
  4391. }
  4392. char32 *p = substring;
  4393. if (singleWord) {
  4394. /* Proceed until next white space. */
  4395. while (Melder_staysWithinInk (*p)) p ++;
  4396. } else {
  4397. /* Proceed until end of line. */
  4398. while (Melder_staysWithinLine (*p)) p ++;
  4399. }
  4400. length = p - substring;
  4401. result = autostring32 (length);
  4402. str32ncpy (result.get(), substring, length);
  4403. }
  4404. pushString (result.move());
  4405. } else {
  4406. Melder_throw (U"The function \"", Formula_instructionNames [parse [programPointer]. symbol],
  4407. U"\" requires two strings, not ", s->whichText(), U" and ", t->whichText(), U".");
  4408. }
  4409. }
  4410. static void do_selected () {
  4411. Stackel n = pop;
  4412. integer result = 0;
  4413. if (n->number == 0) {
  4414. result = praat_idOfSelected (nullptr, 0);
  4415. } else if (n->number == 1) {
  4416. Stackel a = pop;
  4417. if (a->which == Stackel_STRING) {
  4418. ClassInfo klas = Thing_classFromClassName (a->getString(), nullptr);
  4419. result = praat_idOfSelected (klas, 0);
  4420. } else if (a->which == Stackel_NUMBER) {
  4421. result = praat_idOfSelected (nullptr, Melder_iround (a->number));
  4422. } else {
  4423. Melder_throw (U"The function \"selected\" requires a string (an object type name) and/or a number.");
  4424. }
  4425. } else if (n->number == 2) {
  4426. Stackel x = pop, s = pop;
  4427. if (s->which == Stackel_STRING && x->which == Stackel_NUMBER) {
  4428. ClassInfo klas = Thing_classFromClassName (s->getString(), nullptr);
  4429. result = praat_idOfSelected (klas, Melder_iround (x->number));
  4430. } else {
  4431. Melder_throw (U"The function \"selected\" requires a string (an object type name) and/or a number.");
  4432. }
  4433. } else {
  4434. Melder_throw (U"The function \"selected\" requires 0, 1, or 2 arguments, not ", n->number, U".");
  4435. }
  4436. pushNumber (result);
  4437. }
  4438. #if 0
  4439. static void do_selectedStr () {
  4440. Stackel n = pop;
  4441. autostring32 result;
  4442. if (n->number == 0) {
  4443. result = Melder_dup (praat_nameOfSelected (nullptr, 0));
  4444. } else if (n->number == 1) {
  4445. Stackel a = pop;
  4446. if (a->which == Stackel_STRING) {
  4447. ClassInfo klas = Thing_classFromClassName (a->string, nullptr);
  4448. result = Melder_dup (praat_nameOfSelected (klas, 0));
  4449. } else if (a->which == Stackel_NUMBER) {
  4450. result = Melder_dup (praat_nameOfSelected (nullptr, Melder_iround (a->number)));
  4451. } else {
  4452. Melder_throw (U"The function \"selected$\" requires a string (an object type name) and/or a number.");
  4453. }
  4454. } else if (n->number == 2) {
  4455. Stackel x = pop, s = pop;
  4456. if (s->which == Stackel_STRING && x->which == Stackel_NUMBER) {
  4457. ClassInfo klas = Thing_classFromClassName (s->string, nullptr);
  4458. result = Melder_dup (praat_nameOfSelected (klas, Melder_iround (x->number)));
  4459. } else {
  4460. Melder_throw (U"The function \"selected$\" requires a string (an object type name) and a number.");
  4461. }
  4462. } else {
  4463. Melder_throw (U"The function \"selected$\" requires 0, 1, or 2 arguments, not ", n->number, U".");
  4464. }
  4465. pushString (result.transfer());
  4466. }
  4467. #else
  4468. static void do_selectedStr () {
  4469. Stackel n = pop;
  4470. char32 *resultSource; // purposefully don't initialize, so that the compiler can check that has been assigned to when used
  4471. if (n->number == 0) {
  4472. resultSource = praat_nameOfSelected (nullptr, 0);
  4473. } else if (n->number == 1) {
  4474. Stackel a = pop;
  4475. if (a->which == Stackel_STRING) {
  4476. ClassInfo klas = Thing_classFromClassName (a->getString(), nullptr);
  4477. resultSource = praat_nameOfSelected (klas, 0);
  4478. } else if (a->which == Stackel_NUMBER) {
  4479. resultSource = praat_nameOfSelected (nullptr, Melder_iround (a->number));
  4480. } else {
  4481. Melder_throw (U"The function \"selected$\" requires a string (an object type name) and/or a number.");
  4482. }
  4483. } else if (n->number == 2) {
  4484. Stackel x = pop, s = pop;
  4485. if (s->which == Stackel_STRING && x->which == Stackel_NUMBER) {
  4486. ClassInfo klas = Thing_classFromClassName (s->getString(), nullptr);
  4487. resultSource = praat_nameOfSelected (klas, Melder_iround (x->number));
  4488. } else {
  4489. Melder_throw (U"The function \"selected$\" requires a string (an object type name) and a number.");
  4490. }
  4491. } else {
  4492. Melder_throw (U"The function \"selected$\" requires 0, 1, or 2 arguments, not ", n->number, U".");
  4493. }
  4494. pushString (Melder_dup (resultSource));
  4495. }
  4496. #endif
  4497. static void do_numberOfSelected () {
  4498. Stackel n = pop;
  4499. integer result = 0;
  4500. if (n->number == 0) {
  4501. result = praat_numberOfSelected (nullptr);
  4502. } else if (n->number == 1) {
  4503. Stackel s = pop;
  4504. if (s->which == Stackel_STRING) {
  4505. ClassInfo klas = Thing_classFromClassName (s->getString(), nullptr);
  4506. result = praat_numberOfSelected (klas);
  4507. } else {
  4508. Melder_throw (U"The function \"numberOfSelected\" requires a string (an object type name), not ", s->whichText(), U".");
  4509. }
  4510. } else {
  4511. Melder_throw (U"The function \"numberOfSelected\" requires 0 or 1 arguments, not ", n->number, U".");
  4512. }
  4513. pushNumber (result);
  4514. }
  4515. static void do_VECselected () {
  4516. Stackel n = pop;
  4517. autoVEC result;
  4518. if (n->number == 0) {
  4519. result = praat_idsOfAllSelected (nullptr);
  4520. } else if (n->number == 1) {
  4521. Stackel s = pop;
  4522. if (s->which == Stackel_STRING) {
  4523. ClassInfo klas = Thing_classFromClassName (s->getString(), nullptr);
  4524. result = praat_idsOfAllSelected (klas);
  4525. } else {
  4526. Melder_throw (U"The function \"numberOfSelected\" requires a string (an object type name), not ", s->whichText(), U".");
  4527. }
  4528. } else {
  4529. Melder_throw (U"The function \"numberOfSelected\" requires 0 or 1 arguments, not ", n->number, U".");
  4530. }
  4531. pushNumericVector (result.move());
  4532. }
  4533. static void do_selectObject () {
  4534. Stackel n = pop;
  4535. praat_deselectAll ();
  4536. for (int iobject = 1; iobject <= n -> number; iobject ++) {
  4537. Stackel object = pop;
  4538. if (object -> which == Stackel_NUMBER) {
  4539. int IOBJECT = praat_findObjectById (Melder_iround (object -> number));
  4540. praat_select (IOBJECT);
  4541. } else if (object -> which == Stackel_STRING) {
  4542. int IOBJECT = praat_findObjectByName (object -> getString());
  4543. praat_select (IOBJECT);
  4544. } else if (object -> which == Stackel_NUMERIC_VECTOR) {
  4545. VEC vec = object -> numericVector;
  4546. for (int ielm = 1; ielm <= vec.size; ielm ++) {
  4547. int IOBJECT = praat_findObjectById (Melder_iround (vec [ielm]));
  4548. praat_select (IOBJECT);
  4549. }
  4550. } else {
  4551. Melder_throw (U"The function \"selectObject\" takes numbers, strings, or numeric vectors, not ", object->whichText());
  4552. }
  4553. }
  4554. praat_show ();
  4555. pushNumber (1);
  4556. }
  4557. static void do_plusObject () {
  4558. Stackel n = pop;
  4559. for (int iobject = 1; iobject <= n -> number; iobject ++) {
  4560. Stackel object = pop;
  4561. if (object -> which == Stackel_NUMBER) {
  4562. int IOBJECT = praat_findObjectById (Melder_iround (object -> number));
  4563. praat_select (IOBJECT);
  4564. } else if (object -> which == Stackel_STRING) {
  4565. int IOBJECT = praat_findObjectByName (object -> getString());
  4566. praat_select (IOBJECT);
  4567. } else if (object -> which == Stackel_NUMERIC_VECTOR) {
  4568. VEC vec = object -> numericVector;
  4569. for (int ielm = 1; ielm <= vec.size; ielm ++) {
  4570. int IOBJECT = praat_findObjectById (Melder_iround (vec [ielm]));
  4571. praat_select (IOBJECT);
  4572. }
  4573. } else {
  4574. Melder_throw (U"The function \"plusObject\" takes numbers, strings, or numeric vectors, not ", object->whichText(), U".");
  4575. }
  4576. }
  4577. praat_show ();
  4578. pushNumber (1);
  4579. }
  4580. static void do_minusObject () {
  4581. Stackel n = pop;
  4582. for (int iobject = 1; iobject <= n -> number; iobject ++) {
  4583. Stackel object = pop;
  4584. if (object -> which == Stackel_NUMBER) {
  4585. int IOBJECT = praat_findObjectById (Melder_iround (object -> number));
  4586. praat_deselect (IOBJECT);
  4587. } else if (object -> which == Stackel_STRING) {
  4588. int IOBJECT = praat_findObjectByName (object -> getString());
  4589. praat_deselect (IOBJECT);
  4590. } else if (object -> which == Stackel_NUMERIC_VECTOR) {
  4591. VEC vec = object -> numericVector;
  4592. for (int ielm = 1; ielm <= vec.size; ielm ++) {
  4593. int IOBJECT = praat_findObjectById (Melder_iround (vec [ielm]));
  4594. praat_deselect (IOBJECT);
  4595. }
  4596. } else {
  4597. Melder_throw (U"The function \"minusObject\" takes numbers, strings, or numeric vectors, not ", object->whichText(), U".");
  4598. }
  4599. }
  4600. praat_show ();
  4601. pushNumber (1);
  4602. }
  4603. static void do_removeObject () {
  4604. Stackel n = pop;
  4605. for (int iobject = 1; iobject <= n -> number; iobject ++) {
  4606. Stackel object = pop;
  4607. if (object -> which == Stackel_NUMBER) {
  4608. int IOBJECT = praat_findObjectById (Melder_iround (object -> number));
  4609. praat_removeObject (IOBJECT);
  4610. } else if (object -> which == Stackel_STRING) {
  4611. int IOBJECT = praat_findObjectByName (object -> getString());
  4612. praat_removeObject (IOBJECT);
  4613. } else if (object -> which == Stackel_NUMERIC_VECTOR) {
  4614. VEC vec = object -> numericVector;
  4615. for (int ielm = 1; ielm <= vec.size; ielm ++) {
  4616. int IOBJECT = praat_findObjectById (Melder_iround (vec [ielm]));
  4617. praat_removeObject (IOBJECT);
  4618. }
  4619. } else {
  4620. Melder_throw (U"The function \"removeObject\" takes numbers, strings, or numeric vectors, not ", object->whichText(), U".");
  4621. }
  4622. }
  4623. praat_show ();
  4624. pushNumber (1);
  4625. }
  4626. static Daata _do_object (Stackel object, conststring32 expressionMessage) {
  4627. Daata data;
  4628. if (object -> which == Stackel_NUMBER) {
  4629. int IOBJECT = praat_findObjectById (Melder_iround (object -> number));
  4630. data = OBJECT;
  4631. } else if (object -> which == Stackel_STRING) {
  4632. int IOBJECT = praat_findObjectByName (object -> getString());
  4633. data = OBJECT;
  4634. } else if (object -> which == Stackel_OBJECT) {
  4635. data = object -> object;
  4636. } else {
  4637. Melder_throw (U"The expression \"", expressionMessage, U"\" requires xx to be a number or a string, not ", object->whichText(), U".");
  4638. }
  4639. return data;
  4640. }
  4641. static void do_object_xmin () {
  4642. Stackel object = pop;
  4643. Daata data = _do_object (object, U"object[xx].xmin");
  4644. Melder_require (data -> v_hasGetXmin (),
  4645. U"An object of type ", Thing_className (data), U" has no \"xmin\" attribute.");
  4646. pushNumber (data -> v_getXmin ());
  4647. }
  4648. static void do_object_xmax () {
  4649. Stackel object = pop;
  4650. Daata data = _do_object (object, U"object[xx].xmax");
  4651. Melder_require (data -> v_hasGetXmax (),
  4652. U"An object of type ", Thing_className (data), U" has no \"xmax\" attribute.");
  4653. pushNumber (data -> v_getXmax ());
  4654. }
  4655. static void do_object_ymin () {
  4656. Stackel object = pop;
  4657. Daata data = _do_object (object, U"object[xx].ymin");
  4658. Melder_require (data -> v_hasGetYmin (),
  4659. U"An object of type ", Thing_className (data), U" has no \"ymin\" attribute.");
  4660. pushNumber (data -> v_getYmin ());
  4661. }
  4662. static void do_object_ymax () {
  4663. Stackel object = pop;
  4664. Daata data = _do_object (object, U"object[xx].ymax");
  4665. Melder_require (data -> v_hasGetYmax (),
  4666. U"An object of type ", Thing_className (data), U" has no \"ymax\" attribute.");
  4667. pushNumber (data -> v_getYmax ());
  4668. }
  4669. static void do_object_nx () {
  4670. Stackel object = pop;
  4671. Daata data = _do_object (object, U"object[xx].nx");
  4672. Melder_require (data -> v_hasGetNx (),
  4673. U"An object of type ", Thing_className (data), U" has no \"nx\" attribute.");
  4674. pushNumber (data -> v_getNx ());
  4675. }
  4676. static void do_object_ny () {
  4677. Stackel object = pop;
  4678. Daata data = _do_object (object, U"object[xx].ny");
  4679. Melder_require (data -> v_hasGetNy (),
  4680. U"An object of type ", Thing_className (data), U" has no \"ny\" attribute.");
  4681. pushNumber (data -> v_getNy ());
  4682. }
  4683. static void do_object_dx () {
  4684. Stackel object = pop;
  4685. Daata data = _do_object (object, U"object[xx].dx");
  4686. Melder_require (data -> v_hasGetDx (),
  4687. U"An object of type ", Thing_className (data), U" has no \"dx\" attribute.");
  4688. pushNumber (data -> v_getDx ());
  4689. }
  4690. static void do_object_dy () {
  4691. Stackel object = pop;
  4692. Daata data = _do_object (object, U"object[xx].dy");
  4693. Melder_require (data -> v_hasGetDy (),
  4694. U"An object of type ", Thing_className (data), U" has no \"dy\" attribute.");
  4695. pushNumber (data -> v_getDy ());
  4696. }
  4697. static void do_object_nrow () {
  4698. Stackel object = pop;
  4699. Daata data = _do_object (object, U"object[xx].nrow");
  4700. Melder_require (data -> v_hasGetNrow (),
  4701. U"An object of type ", Thing_className (data), U" has no \"nrow\" attribute.");
  4702. pushNumber (data -> v_getNrow ());
  4703. }
  4704. static void do_object_ncol () {
  4705. Stackel object = pop;
  4706. Daata data = _do_object (object, U"object[xx].ncol");
  4707. Melder_require (data -> v_hasGetNcol (),
  4708. U"An object of type ", Thing_className (data), U" has no \"ncol\" attribute.");
  4709. pushNumber (data -> v_getNcol ());
  4710. }
  4711. static void do_object_rowstr () {
  4712. Stackel index = pop, object = pop;
  4713. Daata data = _do_object (object, U"object[xx].row$[]");
  4714. Melder_require (data -> v_hasGetRowStr (),
  4715. U"An object of type ", Thing_className (data), U" has no \"row$[]\" attribute.");
  4716. Melder_require (index -> which == Stackel_NUMBER,
  4717. U"The expression \"object[].row$[xx]\" requires xx to be a number, not ", index->whichText(), U".");
  4718. integer number = Melder_iround (index->number);
  4719. autostring32 result = Melder_dup (data -> v_getRowStr (number));
  4720. if (! result)
  4721. Melder_throw (U"Row index out of bounds.");
  4722. pushString (result.move());
  4723. }
  4724. static void do_object_colstr () {
  4725. Stackel index = pop, object = pop;
  4726. Daata data = _do_object (object, U"object[xx].col$[]");
  4727. Melder_require (data -> v_hasGetColStr (),
  4728. U"An object of type ", Thing_className (data), U" has no \"col$[]\" attribute.");
  4729. Melder_require (index -> which == Stackel_NUMBER,
  4730. U"The expression \"object[].col$[xx]\" requires xx to be a number, not ", index->whichText(), U".");
  4731. integer number = Melder_iround (index->number);
  4732. autostring32 result = Melder_dup (data -> v_getColStr (number));
  4733. if (! result)
  4734. Melder_throw (U"Column index out of bounds.");
  4735. pushString (result.move());
  4736. }
  4737. static void do_stringStr () {
  4738. Stackel value = pop;
  4739. if (value->which == Stackel_NUMBER) {
  4740. autostring32 result = Melder_dup (Melder_double (value->number));
  4741. pushString (result.move());
  4742. } else {
  4743. Melder_throw (U"The function \"string$\" requires a number, not ", value->whichText(), U".");
  4744. }
  4745. }
  4746. static void do_sleep () {
  4747. Stackel value = pop;
  4748. if (value->which == Stackel_NUMBER) {
  4749. Melder_sleep (value->number);
  4750. pushNumber (1);
  4751. } else {
  4752. Melder_throw (U"The function \"sleep\" requires a number, not ", value->whichText(), U".");
  4753. }
  4754. }
  4755. static void do_unicode () {
  4756. Stackel value = pop;
  4757. if (value->which == Stackel_STRING) {
  4758. pushNumber (value->getString() [0]);
  4759. } else {
  4760. Melder_throw (U"The function \"unicode\" requires a character, not ", value->whichText(), U".");
  4761. }
  4762. }
  4763. static void do_unicodeStr () {
  4764. Stackel value = pop;
  4765. if (value->which == Stackel_NUMBER) {
  4766. Melder_require (value->number >= 0.0 && value->number < (double) (1 << 21),
  4767. U"A unicode number cannot be greater than ", (1 << 21) - 1, U".");
  4768. Melder_require (value->number < 0xD800 || value->number > 0xDFFF,
  4769. U"A unicode number cannot lie between 0xD800 and 0xDFFF. Those are \"surrogates\".");
  4770. char32 string [2] = { U'\0', U'\0' };
  4771. string [0] = (char32) value->number;
  4772. pushString (Melder_dup (string).move());
  4773. } else {
  4774. Melder_throw (U"The function \"unicode$\" requires a number, not ", value->whichText(), U".");
  4775. }
  4776. }
  4777. static void do_fixedStr () {
  4778. Stackel precision = pop, value = pop;
  4779. if (value->which == Stackel_NUMBER && precision->which == Stackel_NUMBER) {
  4780. autostring32 result = Melder_dup (Melder_fixed (value->number, Melder_iround (precision->number)));
  4781. pushString (result.move());
  4782. } else {
  4783. Melder_throw (U"The function \"fixed$\" requires two numbers (value and precision), not ", value->whichText(), U" and ", precision->whichText(), U".");
  4784. }
  4785. }
  4786. static void do_percentStr () {
  4787. Stackel precision = pop, value = pop;
  4788. if (value->which == Stackel_NUMBER && precision->which == Stackel_NUMBER) {
  4789. autostring32 result = Melder_dup (Melder_percent (value->number, Melder_iround (precision->number)));
  4790. pushString (result.move());
  4791. } else {
  4792. Melder_throw (U"The function \"percent$\" requires two numbers (value and precision), not ", value->whichText(), U" and ", precision->whichText(), U".");
  4793. }
  4794. }
  4795. static void do_hexadecimalStr () {
  4796. Stackel precision = pop, value = pop;
  4797. if (value->which == Stackel_NUMBER && precision->which == Stackel_NUMBER) {
  4798. autostring32 result = Melder_dup (Melder_hexadecimal (Melder_iround (value->number), Melder_iround (precision->number)));
  4799. pushString (result.move());
  4800. } else {
  4801. Melder_throw (U"The function \"hexadecimal$\" requires two numbers (value and precision), not ", value->whichText(), U" and ", precision->whichText(), U".");
  4802. }
  4803. }
  4804. static void do_deleteFile () {
  4805. if (theCurrentPraatObjects != & theForegroundPraatObjects)
  4806. Melder_throw (U"The function \"deleteFile\" is not available inside manuals.");
  4807. Stackel f = pop;
  4808. if (f->which == Stackel_STRING) {
  4809. structMelderFile file { };
  4810. Melder_relativePathToFile (f->getString(), & file);
  4811. MelderFile_delete (& file);
  4812. pushNumber (1);
  4813. } else {
  4814. Melder_throw (U"The function \"deleteFile\" requires a string, not ", f->whichText(), U".");
  4815. }
  4816. }
  4817. static void do_createDirectory () {
  4818. if (theCurrentPraatObjects != & theForegroundPraatObjects)
  4819. Melder_throw (U"The function \"createDirectory\" is not available inside manuals.");
  4820. Stackel f = pop;
  4821. if (f->which == Stackel_STRING) {
  4822. structMelderDir currentDirectory { };
  4823. Melder_getDefaultDir (& currentDirectory);
  4824. #if defined (UNIX) || defined (macintosh)
  4825. Melder_createDirectory (& currentDirectory, f->getString(), S_IRWXU | S_IRWXG | S_IROTH | S_IXOTH);
  4826. #else
  4827. Melder_createDirectory (& currentDirectory, f->getString(), 0);
  4828. #endif
  4829. pushNumber (1);
  4830. } else {
  4831. Melder_throw (U"The function \"createDirectory\" requires a string, not ", f->whichText(), U".");
  4832. }
  4833. }
  4834. static void do_variableExists () {
  4835. Stackel f = pop;
  4836. if (f->which == Stackel_STRING) {
  4837. bool result = !! Interpreter_hasVariable (theInterpreter, f->getString());
  4838. pushNumber (result);
  4839. } else {
  4840. Melder_throw (U"The function \"variableExists\" requires a string, not ", f->whichText(), U".");
  4841. }
  4842. }
  4843. static void do_readFile () {
  4844. Stackel f = pop;
  4845. if (f->which == Stackel_STRING) {
  4846. structMelderFile file { };
  4847. Melder_relativePathToFile (f->getString(), & file);
  4848. autostring32 text = MelderFile_readText (& file);
  4849. pushNumber (Melder_atof (text.get()));
  4850. } else {
  4851. Melder_throw (U"The function \"readFile\" requires a string (a file name), not ", f->whichText(), U".");
  4852. }
  4853. }
  4854. static void do_readFileStr () {
  4855. Stackel f = pop;
  4856. if (f->which == Stackel_STRING) {
  4857. structMelderFile file { };
  4858. Melder_relativePathToFile (f->getString(), & file);
  4859. autostring32 text = MelderFile_readText (& file);
  4860. pushString (text.move());
  4861. } else {
  4862. Melder_throw (U"The function \"readFile$\" requires a string (a file name), not ", f->whichText(), U".");
  4863. }
  4864. }
  4865. static void do_tensorLiteral () {
  4866. Stackel n = pop;
  4867. Melder_assert (n->which == Stackel_NUMBER);
  4868. integer numberOfElements = Melder_iround (n->number);
  4869. Melder_assert (numberOfElements > 0);
  4870. /*
  4871. The type of the tensor can be a vector, or a matrix, or a tensor3...
  4872. This depends on whether the last element is a number, a vector, or a matrix...
  4873. */
  4874. Stackel last = pop;
  4875. if (last->which == Stackel_NUMBER) {
  4876. autoVEC result = VECraw (numberOfElements);
  4877. result [numberOfElements] = last->number;
  4878. for (integer ielement = numberOfElements - 1; ielement > 0; ielement --) {
  4879. Stackel element = pop;
  4880. if (element->which != Stackel_NUMBER)
  4881. Melder_throw (U"The tensor elements have to be of the same type, not ", element->whichText(), U" and a number.");
  4882. result [ielement] = element->number;
  4883. }
  4884. pushNumericVector (result.move());
  4885. } else if (last->which == Stackel_NUMERIC_VECTOR) {
  4886. integer sharedNumberOfColumns = last->numericVector.size;
  4887. autoMAT result = MATraw (numberOfElements, sharedNumberOfColumns);
  4888. VECcopy_preallocated (result.row (numberOfElements), last->numericVector);
  4889. for (integer ielement = numberOfElements - 1; ielement > 0; ielement --) {
  4890. Stackel element = pop;
  4891. Melder_require (element->which == Stackel_NUMERIC_VECTOR,
  4892. U"The tensor elements have to be of the same type, not ", element->whichText(), U" and a vector.");
  4893. Melder_require (element->numericVector.size == sharedNumberOfColumns,
  4894. U"The vectors have to be of the same size, not ", element->numericVector.size, U" and ", sharedNumberOfColumns);
  4895. VECcopy_preallocated (result.row (ielement), element->numericVector);
  4896. }
  4897. pushNumericMatrix (result.move());
  4898. } else {
  4899. Melder_throw (U"Cannot (yet?) create a tensor containing ", last->whichText(), U".");
  4900. }
  4901. }
  4902. static void do_inner () {
  4903. /*
  4904. result = inner (x#, y#)
  4905. */
  4906. Stackel y = pop, x = pop;
  4907. if (x->which == Stackel_NUMERIC_VECTOR && y->which == Stackel_NUMERIC_VECTOR) {
  4908. pushNumber (NUMinner (x->numericVector, y->numericVector));
  4909. } else {
  4910. Melder_throw (U"The function \"inner\" requires two vectors, not ", x->whichText(), U" and ", y->whichText(), U".");
  4911. }
  4912. }
  4913. static void do_MATouter () {
  4914. /*
  4915. result## = outer## (x#, y#)
  4916. */
  4917. Stackel y = pop, x = pop;
  4918. if (x->which == Stackel_NUMERIC_VECTOR && y->which == Stackel_NUMERIC_VECTOR) {
  4919. autoMAT result = MATouter (x->numericVector, y->numericVector);
  4920. pushNumericMatrix (result.move());
  4921. } else {
  4922. Melder_throw (U"The function \"outer##\" requires two vectors, not ", x->whichText(), U" and ", y->whichText(), U".");
  4923. }
  4924. }
  4925. static void do_VECmul () {
  4926. /*
  4927. result# = mul# (x.., y..)
  4928. */
  4929. Stackel y = pop, x = pop;
  4930. if (x->which == Stackel_NUMERIC_VECTOR && y->which == Stackel_NUMERIC_MATRIX) {
  4931. /*
  4932. result# = mul# (x#, y##)
  4933. */
  4934. integer xSize = x->numericVector.size, yNrow = y->numericMatrix.nrow;
  4935. Melder_require (yNrow == xSize,
  4936. U"In the function \"mul#\", the dimension of the vector and the number of rows of the matrix should be equal, "
  4937. U"not ", xSize, U" and ", yNrow);
  4938. autoVEC result = VECmul (x->numericVector, y->numericMatrix);
  4939. pushNumericVector (result.move());
  4940. } else if (x->which == Stackel_NUMERIC_MATRIX && y->which == Stackel_NUMERIC_VECTOR) {
  4941. /*
  4942. result# = mul# (x##, y#)
  4943. */
  4944. integer xNcol = x->numericMatrix.ncol, ySize = y->numericVector.size;
  4945. Melder_require (ySize == xNcol,
  4946. U"In the function \"mul#\", the number of columns of the matrix and the dimension of the vector should be equal, "
  4947. U"not ", xNcol, U" and ", ySize);
  4948. autoVEC result = VECmul (x->numericMatrix, y->numericVector);
  4949. pushNumericVector (result.move());
  4950. } else {
  4951. Melder_throw (U"The function \"mul#\" requires a vector and a matrix, not ", x->whichText(), U" and ", y->whichText(), U".");
  4952. }
  4953. }
  4954. static void do_VECrepeat () {
  4955. Stackel n = pop, x = pop;
  4956. if (x->which == Stackel_NUMERIC_VECTOR && n->which == Stackel_NUMBER) {
  4957. integer n_old = x->numericVector.size;
  4958. integer times = Melder_iround (n->number);
  4959. autoVEC result { n_old * times, kTensorInitializationType::RAW };
  4960. for (integer i = 1; i <= times; i ++) {
  4961. for (integer j = 1; j <= n_old; j ++)
  4962. result [(i - 1) * n_old + j] = x->numericVector [j];
  4963. }
  4964. pushNumericVector (result.move());
  4965. } else {
  4966. Melder_throw (U"The function \"repeat#\" requires a vector and a number, not ", x->whichText(), U" and ", n->whichText(), U".");
  4967. }
  4968. }
  4969. static void do_beginPauseForm () {
  4970. if (theCurrentPraatObjects != & theForegroundPraatObjects)
  4971. Melder_throw (U"The function \"beginPauseForm\" is not available inside manuals.");
  4972. Stackel n = pop;
  4973. if (n->number == 1) {
  4974. Stackel title = pop;
  4975. if (title->which == Stackel_STRING) {
  4976. UiPause_begin (theCurrentPraatApplication -> topShell, title->getString(), theInterpreter);
  4977. } else {
  4978. Melder_throw (U"The function \"beginPauseForm\" requires a string (the title), not ", title->whichText(), U".");
  4979. }
  4980. } else {
  4981. Melder_throw (U"The function \"beginPauseForm\" requires 1 argument (a title), not ", n->number, U".");
  4982. }
  4983. pushNumber (1);
  4984. }
  4985. static void do_pauseFormAddReal () {
  4986. if (theCurrentPraatObjects != & theForegroundPraatObjects)
  4987. Melder_throw (U"The function \"real\" is not available inside manuals.");
  4988. Stackel n = pop;
  4989. if (n->number == 2) {
  4990. Stackel defaultValue = pop;
  4991. conststring32 defaultString = nullptr;
  4992. if (defaultValue->which == Stackel_STRING) {
  4993. defaultString = defaultValue->getString();
  4994. } else if (defaultValue->which == Stackel_NUMBER) {
  4995. defaultString = Melder_double (defaultValue->number);
  4996. } else {
  4997. Melder_throw (U"The second argument of \"real\" (the default value) should be a string or a number, not ", defaultValue->whichText(), U".");
  4998. }
  4999. Stackel label = pop;
  5000. if (label->which == Stackel_STRING) {
  5001. UiPause_real (label->getString(), defaultString);
  5002. } else {
  5003. Melder_throw (U"The first argument of \"real\" (the label) should be a string, not ", label->whichText(), U".");
  5004. }
  5005. } else {
  5006. Melder_throw (U"The function \"real\" requires 2 arguments (a label and a default value), not ", n->number, U".");
  5007. }
  5008. pushNumber (1);
  5009. }
  5010. static void do_pauseFormAddPositive () {
  5011. if (theCurrentPraatObjects != & theForegroundPraatObjects)
  5012. Melder_throw (U"The function \"positive\" is not available inside manuals.");
  5013. Stackel n = pop;
  5014. if (n->number == 2) {
  5015. Stackel defaultValue = pop;
  5016. conststring32 defaultString = nullptr;
  5017. if (defaultValue->which == Stackel_STRING) {
  5018. defaultString = defaultValue->getString();
  5019. } else if (defaultValue->which == Stackel_NUMBER) {
  5020. defaultString = Melder_double (defaultValue->number);
  5021. } else {
  5022. Melder_throw (U"The second argument of \"positive\" (the default value) should be a string or a number, not ", defaultValue->whichText(), U".");
  5023. }
  5024. Stackel label = pop;
  5025. if (label->which == Stackel_STRING) {
  5026. UiPause_positive (label->getString(), defaultString);
  5027. } else {
  5028. Melder_throw (U"The first argument of \"positive\" (the label) should be a string, not ", label->whichText(), U".");
  5029. }
  5030. } else {
  5031. Melder_throw (U"The function \"positive\" requires 2 arguments (a label and a default value), not ", n->number, U".");
  5032. }
  5033. pushNumber (1);
  5034. }
  5035. static void do_pauseFormAddInteger () {
  5036. if (theCurrentPraatObjects != & theForegroundPraatObjects)
  5037. Melder_throw (U"The function \"integer\" is not available inside manuals.");
  5038. Stackel n = pop;
  5039. if (n->number == 2) {
  5040. Stackel defaultValue = pop;
  5041. conststring32 defaultString = nullptr;
  5042. if (defaultValue->which == Stackel_STRING) {
  5043. defaultString = defaultValue->getString();
  5044. } else if (defaultValue->which == Stackel_NUMBER) {
  5045. defaultString = Melder_double (defaultValue->number);
  5046. } else {
  5047. Melder_throw (U"The second argument of \"integer\" (the default value) should be a string or a number, not ", defaultValue->whichText(), U".");
  5048. }
  5049. Stackel label = pop;
  5050. if (label->which == Stackel_STRING) {
  5051. UiPause_integer (label->getString(), defaultString);
  5052. } else {
  5053. Melder_throw (U"The first argument of \"integer\" (the label) should be a string, not ", label->whichText(), U".");
  5054. }
  5055. } else {
  5056. Melder_throw (U"The function \"integer\" requires 2 arguments (a label and a default value), not ", n->number, U".");
  5057. }
  5058. pushNumber (1);
  5059. }
  5060. static void do_pauseFormAddNatural () {
  5061. if (theCurrentPraatObjects != & theForegroundPraatObjects)
  5062. Melder_throw (U"The function \"natural\" is not available inside manuals.");
  5063. Stackel n = pop;
  5064. if (n->number == 2) {
  5065. Stackel defaultValue = pop;
  5066. conststring32 defaultString = nullptr;
  5067. if (defaultValue->which == Stackel_STRING) {
  5068. defaultString = defaultValue->getString();
  5069. } else if (defaultValue->which == Stackel_NUMBER) {
  5070. defaultString = Melder_double (defaultValue->number);
  5071. } else {
  5072. Melder_throw (U"The second argument of \"natural\" (the default value) should be a string or a number, not ", defaultValue->whichText(), U".");
  5073. }
  5074. Stackel label = pop;
  5075. if (label->which == Stackel_STRING) {
  5076. UiPause_natural (label->getString(), defaultString);
  5077. } else {
  5078. Melder_throw (U"The first argument of \"natural\" (the label) should be a string, not ", label->whichText(), U".");
  5079. }
  5080. } else {
  5081. Melder_throw (U"The function \"natural\" requires 2 arguments (a label and a default value), not ", n->number, U".");
  5082. }
  5083. pushNumber (1);
  5084. }
  5085. static void do_pauseFormAddWord () {
  5086. if (theCurrentPraatObjects != & theForegroundPraatObjects)
  5087. Melder_throw (U"The function \"word\" is not available inside manuals.");
  5088. Stackel n = pop;
  5089. if (n->number == 2) {
  5090. Stackel defaultValue = pop;
  5091. Melder_require (defaultValue->which == Stackel_STRING,
  5092. U"The second argument of \"word\" (the default value) should be a string, not ", defaultValue->whichText(), U".");
  5093. Stackel label = pop;
  5094. if (label->which == Stackel_STRING) {
  5095. UiPause_word (label->getString(), defaultValue->getString());
  5096. } else {
  5097. Melder_throw (U"The first argument of \"word\" (the label) should be a string, not ", label->whichText(), U".");
  5098. }
  5099. } else {
  5100. Melder_throw (U"The function \"word\" requires 2 arguments (a label and a default value), not ", n->number, U".");
  5101. }
  5102. pushNumber (1);
  5103. }
  5104. static void do_pauseFormAddSentence () {
  5105. if (theCurrentPraatObjects != & theForegroundPraatObjects)
  5106. Melder_throw (U"The function \"sentence\" is not available inside manuals.");
  5107. Stackel n = pop;
  5108. if (n->number == 2) {
  5109. Stackel defaultValue = pop;
  5110. Melder_require (defaultValue->which == Stackel_STRING,
  5111. U"The second argument of \"sentence\" (the default value) should be a string, not ", defaultValue->whichText(), U".");
  5112. Stackel label = pop;
  5113. if (label->which == Stackel_STRING) {
  5114. UiPause_sentence (label->getString(), defaultValue->getString());
  5115. } else {
  5116. Melder_throw (U"The first argument of \"sentence\" (the label) should be a string, not ", label->whichText(), U".");
  5117. }
  5118. } else {
  5119. Melder_throw (U"The function \"sentence\" requires 2 arguments (a label and a default value), not ", n->number, U".");
  5120. }
  5121. pushNumber (1);
  5122. }
  5123. static void do_pauseFormAddText () {
  5124. if (theCurrentPraatObjects != & theForegroundPraatObjects)
  5125. Melder_throw (U"The function \"text\" is not available inside manuals.");
  5126. Stackel n = pop;
  5127. if (n->number == 2) {
  5128. Stackel defaultValue = pop;
  5129. Melder_require (defaultValue->which == Stackel_STRING,
  5130. U"The second argument of \"text\" (the default value) should be a string, not ", defaultValue->whichText(), U".");
  5131. Stackel label = pop;
  5132. if (label->which == Stackel_STRING) {
  5133. UiPause_text (label->getString(), defaultValue->getString());
  5134. } else {
  5135. Melder_throw (U"The first argument of \"text\" (the label) should be a string, not ", label->whichText(), U".");
  5136. }
  5137. } else {
  5138. Melder_throw (U"The function \"text\" requires 2 arguments (a label and a default value), not ", n->number, U".");
  5139. }
  5140. pushNumber (1);
  5141. }
  5142. static void do_pauseFormAddBoolean () {
  5143. if (theCurrentPraatObjects != & theForegroundPraatObjects)
  5144. Melder_throw (U"The function \"boolean\" is not available inside manuals.");
  5145. Stackel n = pop;
  5146. if (n->number == 2) {
  5147. Stackel defaultValue = pop;
  5148. Melder_require (defaultValue->which == Stackel_NUMBER,
  5149. U"The second argument of \"boolean\" (the default value) should be a number (0 or 1), not ", defaultValue->whichText(), U".");
  5150. Stackel label = pop;
  5151. if (label->which == Stackel_STRING) {
  5152. UiPause_boolean (label->getString(), defaultValue->number != 0.0);
  5153. } else {
  5154. Melder_throw (U"The first argument of \"boolean\" (the label) should be a string, not ", label->whichText(), U".");
  5155. }
  5156. } else {
  5157. Melder_throw (U"The function \"boolean\" requires 2 arguments (a label and a default value), not ", n->number, U".");
  5158. }
  5159. pushNumber (1);
  5160. }
  5161. static void do_pauseFormAddChoice () {
  5162. if (theCurrentPraatObjects != & theForegroundPraatObjects)
  5163. Melder_throw (U"The function \"choice\" is not available inside manuals.");
  5164. Stackel n = pop;
  5165. if (n->number == 2) {
  5166. Stackel defaultValue = pop;
  5167. if (defaultValue->which != Stackel_NUMBER) {
  5168. Melder_throw (U"The second argument of \"choice\" (the default value) should be a whole number, not ", defaultValue->whichText(), U".");
  5169. }
  5170. Stackel label = pop;
  5171. if (label->which == Stackel_STRING) {
  5172. UiPause_choice (label->getString(), Melder_iround (defaultValue->number));
  5173. } else {
  5174. Melder_throw (U"The first argument of \"choice\" (the label) should be a string, not ", label->whichText(), U".");
  5175. }
  5176. } else {
  5177. Melder_throw (U"The function \"choice\" requires 2 arguments (a label and a default value), not ", n->number, U".");
  5178. }
  5179. pushNumber (1);
  5180. }
  5181. static void do_pauseFormAddOptionMenu () {
  5182. if (theCurrentPraatObjects != & theForegroundPraatObjects)
  5183. Melder_throw (U"The function \"optionMenu\" is not available inside manuals.");
  5184. Stackel n = pop;
  5185. if (n->number == 2) {
  5186. Stackel defaultValue = pop;
  5187. if (defaultValue->which != Stackel_NUMBER) {
  5188. Melder_throw (U"The second argument of \"optionMenu\" (the default value) should be a whole number, not ", defaultValue->whichText(), U".");
  5189. }
  5190. Stackel label = pop;
  5191. if (label->which == Stackel_STRING) {
  5192. UiPause_optionMenu (label->getString(), Melder_iround (defaultValue->number));
  5193. } else {
  5194. Melder_throw (U"The first argument of \"optionMenu\" (the label) should be a string, not ", label->whichText(), U".");
  5195. }
  5196. } else {
  5197. Melder_throw (U"The function \"optionMenu\" requires 2 arguments (a label and a default value), not ", n->number, U".");
  5198. }
  5199. pushNumber (1);
  5200. }
  5201. static void do_pauseFormAddOption () {
  5202. if (theCurrentPraatObjects != & theForegroundPraatObjects)
  5203. Melder_throw (U"The function \"option\" is not available inside manuals.");
  5204. Stackel n = pop;
  5205. if (n->number == 1) {
  5206. Stackel text = pop;
  5207. if (text->which == Stackel_STRING) {
  5208. UiPause_option (text->getString());
  5209. } else {
  5210. Melder_throw (U"The argument of \"option\" should be a string (the text), not ", text->whichText(), U".");
  5211. }
  5212. } else {
  5213. Melder_throw (U"The function \"option\" requires 1 argument (a text), not ", n->number, U".");
  5214. }
  5215. pushNumber (1);
  5216. }
  5217. static void do_pauseFormAddComment () {
  5218. if (theCurrentPraatObjects != & theForegroundPraatObjects)
  5219. Melder_throw (U"The function \"comment\" is not available inside manuals.");
  5220. Stackel n = pop;
  5221. if (n->number == 1) {
  5222. Stackel text = pop;
  5223. if (text->which == Stackel_STRING) {
  5224. UiPause_comment (text->getString());
  5225. } else {
  5226. Melder_throw (U"The argument of \"comment\" should be a string (the text), not ", text->whichText(), U".");
  5227. }
  5228. } else {
  5229. Melder_throw (U"The function \"comment\" requires 1 argument (a text), not ", n->number, U".");
  5230. }
  5231. pushNumber (1);
  5232. }
  5233. static void do_endPauseForm () {
  5234. if (theCurrentPraatObjects != & theForegroundPraatObjects)
  5235. Melder_throw (U"The function \"endPause\" is not available inside manuals.");
  5236. Stackel n = pop;
  5237. if (n->number < 2 || n->number > 12)
  5238. Melder_throw (U"The function \"endPause\" requires 2 to 12 arguments, not ", n->number, U".");
  5239. Stackel d = pop;
  5240. if (d->which != Stackel_NUMBER)
  5241. Melder_throw (U"The last argument of \"endPause\" has to be a number (the default or cancel continue button), not ", d->whichText(), U".");
  5242. integer numberOfContinueButtons = Melder_iround (n->number) - 1;
  5243. integer cancelContinueButton = 0, defaultContinueButton = Melder_iround (d->number);
  5244. Stackel ca = pop;
  5245. if (ca->which == Stackel_NUMBER) {
  5246. cancelContinueButton = defaultContinueButton;
  5247. defaultContinueButton = Melder_iround (ca->number);
  5248. numberOfContinueButtons --;
  5249. if (cancelContinueButton < 1 || cancelContinueButton > numberOfContinueButtons)
  5250. Melder_throw (U"Your last argument of \"endPause\" is the number of the cancel button; it cannot be ", cancelContinueButton,
  5251. U" but has to lie between 1 and ", numberOfContinueButtons, U".");
  5252. }
  5253. Stackel co [1+10] = { 0 };
  5254. for (integer i = numberOfContinueButtons; i >= 1; i --) {
  5255. co [i] = cancelContinueButton != 0 || i != numberOfContinueButtons ? pop : ca;
  5256. if (co[i]->which != Stackel_STRING)
  5257. Melder_throw (U"Each of the first ", numberOfContinueButtons,
  5258. U" argument(s) of \"endPause\" has to be a string (a button text), not ", co[i]->whichText(), U".");
  5259. }
  5260. int buttonClicked = UiPause_end (numberOfContinueButtons, defaultContinueButton, cancelContinueButton,
  5261. ! co [1] ? nullptr : co[1]->getString(), ! co [2] ? nullptr : co[2]->getString(),
  5262. ! co [3] ? nullptr : co[3]->getString(), ! co [4] ? nullptr : co[4]->getString(),
  5263. ! co [5] ? nullptr : co[5]->getString(), ! co [6] ? nullptr : co[6]->getString(),
  5264. ! co [7] ? nullptr : co[7]->getString(), ! co [8] ? nullptr : co[8]->getString(),
  5265. ! co [9] ? nullptr : co[9]->getString(), ! co [10] ? nullptr : co[10]->getString(),
  5266. theInterpreter);
  5267. //Melder_casual (U"Button ", buttonClicked);
  5268. pushNumber (buttonClicked);
  5269. }
  5270. static void do_chooseReadFileStr () {
  5271. Stackel n = pop;
  5272. if (n->number == 1) {
  5273. Stackel title = pop;
  5274. if (title->which == Stackel_STRING) {
  5275. autoStringSet fileNames = GuiFileSelect_getInfileNames (nullptr, title->getString(), false);
  5276. if (fileNames->size == 0) {
  5277. pushString (Melder_dup (U""));
  5278. } else {
  5279. SimpleString fileName = fileNames->at [1];
  5280. pushString (Melder_dup (fileName -> string.get()));
  5281. }
  5282. } else {
  5283. Melder_throw (U"The argument of \"chooseReadFile$\" should be a string (the title), not ", title->whichText(), U".");
  5284. }
  5285. } else {
  5286. Melder_throw (U"The function \"chooseReadFile$\" requires 1 argument (a title), not ", n->number, U".");
  5287. }
  5288. }
  5289. static void do_chooseWriteFileStr () {
  5290. Stackel n = pop;
  5291. if (n->number == 2) {
  5292. Stackel defaultName = pop, title = pop;
  5293. if (title->which == Stackel_STRING && defaultName->which == Stackel_STRING) {
  5294. autostring32 result = GuiFileSelect_getOutfileName (nullptr, title->getString(), defaultName->getString());
  5295. if (! result)
  5296. result = Melder_dup (U"");
  5297. pushString (result.move());
  5298. } else {
  5299. Melder_throw (U"The arguments of \"chooseWriteFile$\" should be two strings (the title and the default name).");
  5300. }
  5301. } else {
  5302. Melder_throw (U"The function \"chooseWriteFile$\" requires 2 arguments (a title and a default name), not ", n->number, U".");
  5303. }
  5304. }
  5305. static void do_chooseDirectoryStr () {
  5306. Stackel n = pop;
  5307. if (n->number == 1) {
  5308. Stackel title = pop;
  5309. if (title->which == Stackel_STRING) {
  5310. autostring32 result = GuiFileSelect_getDirectoryName (nullptr, title->getString());
  5311. if (! result)
  5312. result = Melder_dup (U"");
  5313. pushString (result.move());
  5314. } else {
  5315. Melder_throw (U"The argument of \"chooseDirectory$\" should be a string (the title).");
  5316. }
  5317. } else {
  5318. Melder_throw (U"The function \"chooseDirectory$\" requires 1 argument (a title), not ", n->number, U".");
  5319. }
  5320. }
  5321. static void do_demoWindowTitle () {
  5322. Stackel n = pop;
  5323. if (n->number == 1) {
  5324. Stackel title = pop;
  5325. if (title->which == Stackel_STRING) {
  5326. Demo_windowTitle (title->getString());
  5327. } else {
  5328. Melder_throw (U"The argument of \"demoWindowTitle\" should be a string (the title), not ", title->whichText(), U".");
  5329. }
  5330. } else {
  5331. Melder_throw (U"The function \"demoWindowTitle\" requires 1 argument (a title), not ", n->number, U".");
  5332. }
  5333. pushNumber (1);
  5334. }
  5335. static void do_demoShow () {
  5336. Stackel n = pop;
  5337. if (n->number != 0)
  5338. Melder_throw (U"The function \"demoShow\" requires 0 arguments, not ", n->number, U".");
  5339. Demo_show ();
  5340. pushNumber (1);
  5341. }
  5342. static void do_demoWaitForInput () {
  5343. Stackel n = pop;
  5344. if (n->number != 0)
  5345. Melder_throw (U"The function \"demoWaitForInput\" requires 0 arguments, not ", n->number, U".");
  5346. Demo_waitForInput (theInterpreter);
  5347. pushNumber (1);
  5348. }
  5349. static void do_demoPeekInput () {
  5350. Stackel n = pop;
  5351. if (n->number != 0)
  5352. Melder_throw (U"The function \"demoPeekInput\" requires 0 arguments, not ", n->number, U".");
  5353. Demo_peekInput (theInterpreter);
  5354. pushNumber (1);
  5355. }
  5356. static void do_demoInput () {
  5357. Stackel n = pop;
  5358. if (n->number == 1) {
  5359. Stackel keys = pop;
  5360. if (keys->which == Stackel_STRING) {
  5361. bool result = Demo_input (keys->getString());
  5362. pushNumber (result);
  5363. } else {
  5364. Melder_throw (U"The argument of \"demoInput\" should be a string (the keys), not ", keys->whichText(), U".");
  5365. }
  5366. } else {
  5367. Melder_throw (U"The function \"demoInput\" requires 1 argument (keys), not ", n->number, U".");
  5368. }
  5369. }
  5370. static void do_demoClickedIn () {
  5371. Stackel n = pop;
  5372. if (n->number == 4) {
  5373. Stackel top = pop, bottom = pop, right = pop, left = pop;
  5374. if (left->which == Stackel_NUMBER && right->which == Stackel_NUMBER && bottom->which == Stackel_NUMBER && top->which == Stackel_NUMBER) {
  5375. bool result = Demo_clickedIn (left->number, right->number, bottom->number, top->number);
  5376. pushNumber (result);
  5377. } else {
  5378. Melder_throw (U"All arguments of \"demoClickedIn\" should be numbers (the x and y ranges).");
  5379. }
  5380. } else {
  5381. Melder_throw (U"The function \"demoClickedIn\" requires 4 arguments (x and y ranges), not ", n->number, U".");
  5382. }
  5383. }
  5384. static void do_demoClicked () {
  5385. Stackel n = pop;
  5386. if (n->number != 0)
  5387. Melder_throw (U"The function \"demoClicked\" requires 0 arguments, not ", n->number, U".");
  5388. bool result = Demo_clicked ();
  5389. pushNumber (result);
  5390. }
  5391. static void do_demoX () {
  5392. Stackel n = pop;
  5393. if (n->number != 0)
  5394. Melder_throw (U"The function \"demoX\" requires 0 arguments, not ", n->number, U".");
  5395. double result = Demo_x ();
  5396. pushNumber (result);
  5397. }
  5398. static void do_demoY () {
  5399. Stackel n = pop;
  5400. if (n->number != 0)
  5401. Melder_throw (U"The function \"demoY\" requires 0 arguments, not ", n->number, U".");
  5402. double result = Demo_y ();
  5403. pushNumber (result);
  5404. }
  5405. static void do_demoKeyPressed () {
  5406. Stackel n = pop;
  5407. if (n->number != 0)
  5408. Melder_throw (U"The function \"demoKeyPressed\" requires 0 arguments, not ", n->number, U".");
  5409. bool result = Demo_keyPressed ();
  5410. pushNumber (result);
  5411. }
  5412. static void do_demoKey () {
  5413. Stackel n = pop;
  5414. if (n->number != 0)
  5415. Melder_throw (U"The function \"demoKey\" requires 0 arguments, not ", n->number, U".");
  5416. autostring32 key (1);
  5417. key [0] = Demo_key ();
  5418. pushString (key.move());
  5419. }
  5420. static void do_demoShiftKeyPressed () {
  5421. Stackel n = pop;
  5422. if (n->number != 0)
  5423. Melder_throw (U"The function \"demoShiftKeyPressed\" requires 0 arguments, not ", n->number, U".");
  5424. bool result = Demo_shiftKeyPressed ();
  5425. pushNumber (result);
  5426. }
  5427. static void do_demoCommandKeyPressed () {
  5428. Stackel n = pop;
  5429. if (n->number != 0)
  5430. Melder_throw (U"The function \"demoCommandKeyPressed\" requires 0 arguments, not ", n->number, U".");
  5431. bool result = Demo_commandKeyPressed ();
  5432. pushNumber (result);
  5433. }
  5434. static void do_demoOptionKeyPressed () {
  5435. Stackel n = pop;
  5436. if (n->number != 0)
  5437. Melder_throw (U"The function \"demoOptionKeyPressed\" requires 0 arguments, not ", n->number, U".");
  5438. bool result = Demo_optionKeyPressed ();
  5439. pushNumber (result);
  5440. }
  5441. static void do_demoExtraControlKeyPressed () {
  5442. Stackel n = pop;
  5443. if (n->number != 0)
  5444. Melder_throw (U"The function \"demoControlKeyPressed\" requires 0 arguments, not ", n->number, U".");
  5445. bool result = Demo_extraControlKeyPressed ();
  5446. pushNumber (result);
  5447. }
  5448. static integer Stackel_getRowNumber (Stackel row, Daata thee) {
  5449. integer result = 0;
  5450. if (row->which == Stackel_NUMBER) {
  5451. result = Melder_iround (row->number);
  5452. } else if (row->which == Stackel_STRING) {
  5453. if (! thy v_hasGetRowIndex ())
  5454. Melder_throw (U"Objects of type ", Thing_className (thee), U" do not have row labels, so row indexes have to be numbers.");
  5455. result = Melder_iround (thy v_getRowIndex (row->getString()));
  5456. if (result == 0)
  5457. Melder_throw (U"Object \"", thy name.get(), U"\" has no row labelled \"", row->getString(), U"\".");
  5458. } else {
  5459. Melder_throw (U"A row index should be a number or a string, not ", row->whichText(), U".");
  5460. }
  5461. return result;
  5462. }
  5463. static integer Stackel_getColumnNumber (Stackel column, Daata thee) {
  5464. integer result = 0;
  5465. if (column->which == Stackel_NUMBER) {
  5466. result = Melder_iround (column->number);
  5467. } else if (column->which == Stackel_STRING) {
  5468. if (! thy v_hasGetColIndex ())
  5469. Melder_throw (U"Objects of type ", Thing_className (thee), U" do not have column labels, so column indexes have to be numbers.");
  5470. result = Melder_iround (thy v_getColIndex (column->getString()));
  5471. if (result == 0)
  5472. Melder_throw (U"Object ", thee, U" has no column labelled \"", column->getString(), U"\".");
  5473. } else {
  5474. Melder_throw (U"A column index should be a number or a string, not ", column->whichText(), U".");
  5475. }
  5476. return result;
  5477. }
  5478. static void do_self0 (integer irow, integer icol) {
  5479. Daata me = theSource;
  5480. if (! me) Melder_throw (U"The name \"self\" is restricted to formulas for objects.");
  5481. if (my v_hasGetCell ()) {
  5482. pushNumber (my v_getCell ());
  5483. } else if (my v_hasGetVector ()) {
  5484. if (icol == 0) {
  5485. Melder_throw (U"We are not in a loop, hence no implicit column index for the current ",
  5486. Thing_className (me), U" object (self).\nTry using the [column] index explicitly.");
  5487. } else {
  5488. pushNumber (my v_getVector (irow, icol));
  5489. }
  5490. } else if (my v_hasGetMatrix ()) {
  5491. if (irow == 0) {
  5492. if (icol == 0) {
  5493. Melder_throw (U"We are not in a loop over rows and columns,\n"
  5494. U"hence no implicit row and column indexing for the current ",
  5495. Thing_className (me), U" object (self).\n"
  5496. U"Try using both [row, column] indexes explicitly.");
  5497. } else {
  5498. Melder_throw (U"We are not in a loop over columns only,\n"
  5499. U"hence no implicit row index for the current ",
  5500. Thing_className (me), U" object (self).\n"
  5501. U"Try using the [row] index explicitly.");
  5502. }
  5503. } else {
  5504. pushNumber (my v_getMatrix (irow, icol));
  5505. }
  5506. } else {
  5507. Melder_throw (Thing_className (me), U" objects (like self) accept no [] indexing.");
  5508. }
  5509. }
  5510. static void do_selfStr0 (integer irow, integer icol) {
  5511. Daata me = theSource;
  5512. if (! me) Melder_throw (U"The name \"self$\" is restricted to formulas for objects.");
  5513. if (my v_hasGetCellStr ()) {
  5514. pushString (Melder_dup (my v_getCellStr ()));
  5515. } else if (my v_hasGetVectorStr ()) {
  5516. if (icol == 0) {
  5517. Melder_throw (U"We are not in a loop, hence no implicit column index for the current ",
  5518. Thing_className (me), U" object (self).\nTry using the [column] index explicitly.");
  5519. } else {
  5520. pushString (Melder_dup (my v_getVectorStr (icol)));
  5521. }
  5522. } else if (my v_hasGetMatrixStr ()) {
  5523. if (irow == 0) {
  5524. if (icol == 0) {
  5525. Melder_throw (U"We are not in a loop over rows and columns,\n"
  5526. U"hence no implicit row and column indexing for the current ",
  5527. Thing_className (me), U" object (self).\n"
  5528. U"Try using both [row, column] indexes explicitly.");
  5529. } else {
  5530. Melder_throw (U"We are not in a loop over columns only,\n"
  5531. U"hence no implicit row index for the current ",
  5532. Thing_className (me), U" object (self).\n"
  5533. U"Try using the [row] index explicitly.");
  5534. }
  5535. } else {
  5536. pushString (Melder_dup (my v_getMatrixStr (irow, icol)));
  5537. }
  5538. } else {
  5539. Melder_throw (Thing_className (me), U" objects (like self) accept no [] indexing.");
  5540. }
  5541. }
  5542. static void do_toObject () {
  5543. Stackel object = pop;
  5544. Daata thee = nullptr;
  5545. if (object->which == Stackel_NUMBER) {
  5546. int i = theCurrentPraatObjects -> n;
  5547. while (i > 0 && object->number != theCurrentPraatObjects -> list [i]. id)
  5548. i --;
  5549. if (i == 0)
  5550. Melder_throw (U"No such object: ", object->number);
  5551. thee = (Daata) theCurrentPraatObjects -> list [i]. object;
  5552. } else if (object->which == Stackel_STRING) {
  5553. int i = theCurrentPraatObjects -> n;
  5554. while (i > 0 && ! Melder_equ (object->getString(), theCurrentPraatObjects -> list [i]. name.get()))
  5555. i --;
  5556. if (i == 0)
  5557. Melder_throw (U"No such object: ", object->getString());
  5558. thee = (Daata) theCurrentPraatObjects -> list [i]. object;
  5559. } else {
  5560. Melder_throw (U"The first argument to \"object\" should be a number (unique ID) or a string (name), not ", object->whichText(), U".");
  5561. }
  5562. pushObject (thee);
  5563. }
  5564. static void do_objectCell0 (integer irow, integer icol) {
  5565. Stackel object = pop;
  5566. Daata thee = object->object;
  5567. if (thy v_hasGetCell ()) {
  5568. pushNumber (thy v_getCell ());
  5569. } else if (thy v_hasGetVector ()) {
  5570. if (icol == 0) {
  5571. Melder_throw (U"We are not in a loop,\n"
  5572. U"hence no implicit column index for this ", Thing_className (thee), U" object.\n"
  5573. U"Try using: object [id, column].");
  5574. } else {
  5575. pushNumber (thy v_getVector (irow, icol));
  5576. }
  5577. } else if (thy v_hasGetMatrix ()) {
  5578. if (irow == 0) {
  5579. if (icol == 0) {
  5580. Melder_throw (U"We are not in a loop over rows and columns,\n"
  5581. U"hence no implicit row and column indexing for this ", Thing_className (thee), U" object.\n"
  5582. U"Try using: object [id, row, column].");
  5583. } else {
  5584. Melder_throw (U"We are not in a loop over columns only,\n"
  5585. U"hence no implicit row index for this ", Thing_className (thee), U" object.\n"
  5586. U"Try using: object [id, row].");
  5587. }
  5588. } else {
  5589. pushNumber (thy v_getMatrix (irow, icol));
  5590. }
  5591. } else {
  5592. Melder_throw (Thing_className (thee), U" objects accept no [] indexing.");
  5593. }
  5594. }
  5595. static void do_matriks0 (integer irow, integer icol) {
  5596. Daata thee = parse [programPointer]. content.object;
  5597. if (thy v_hasGetCell ()) {
  5598. pushNumber (thy v_getCell ());
  5599. } else if (thy v_hasGetVector ()) {
  5600. if (icol == 0) {
  5601. Melder_throw (U"We are not in a loop,\n"
  5602. U"hence no implicit column index for this ", Thing_className (thee), U" object.\n"
  5603. U"Try using the [column] index explicitly.");
  5604. } else {
  5605. pushNumber (thy v_getVector (irow, icol));
  5606. }
  5607. } else if (thy v_hasGetMatrix ()) {
  5608. if (irow == 0) {
  5609. if (icol == 0) {
  5610. Melder_throw (U"We are not in a loop over rows and columns,\n"
  5611. U"hence no implicit row and column indexing for this ", Thing_className (thee), U" object.\n"
  5612. U"Try using both [row, column] indexes explicitly.");
  5613. } else {
  5614. Melder_throw (U"We are not in a loop over columns only,\n"
  5615. U"hence no implicit row index for this ", Thing_className (thee), U" object.\n"
  5616. U"Try using the [row] index explicitly.");
  5617. }
  5618. } else {
  5619. pushNumber (thy v_getMatrix (irow, icol));
  5620. }
  5621. } else {
  5622. Melder_throw (Thing_className (thee), U" objects accept no [] indexing.");
  5623. }
  5624. }
  5625. static void do_selfMatriks1 (integer irow) {
  5626. Daata me = theSource;
  5627. Stackel column = pop;
  5628. if (! me) Melder_throw (U"The name \"self\" is restricted to formulas for objects.");
  5629. integer icol = Stackel_getColumnNumber (column, me);
  5630. if (my v_hasGetVector ()) {
  5631. pushNumber (my v_getVector (irow, icol));
  5632. } else if (my v_hasGetMatrix ()) {
  5633. if (irow == 0) {
  5634. Melder_throw (U"We are not in a loop,\n"
  5635. U"hence no implicit row index for the current ", Thing_className (me), U" object (self).\n"
  5636. U"Try using both [row, column] indexes instead.");
  5637. } else {
  5638. pushNumber (my v_getMatrix (irow, icol));
  5639. }
  5640. } else {
  5641. Melder_throw (Thing_className (me), U" objects (like self) accept no [column] indexes.");
  5642. }
  5643. }
  5644. static void do_selfMatriksStr1 (integer irow) {
  5645. Daata me = theSource;
  5646. Stackel column = pop;
  5647. if (! me) Melder_throw (U"The name \"self$\" is restricted to formulas for objects.");
  5648. integer icol = Stackel_getColumnNumber (column, me);
  5649. if (my v_hasGetVectorStr ()) {
  5650. pushString (Melder_dup (my v_getVectorStr (icol)));
  5651. } else if (my v_hasGetMatrixStr ()) {
  5652. if (irow == 0) {
  5653. Melder_throw (U"We are not in a loop,\n"
  5654. U"hence no implicit row index for the current ", Thing_className (me), U" object (self).\n"
  5655. U"Try using both [row, column] indexes instead.");
  5656. } else {
  5657. pushString (Melder_dup (my v_getMatrixStr (irow, icol)));
  5658. }
  5659. } else {
  5660. Melder_throw (Thing_className (me), U" objects (like self) accept no [column] indexes.");
  5661. }
  5662. }
  5663. static void do_objectCell1 (integer irow) {
  5664. Stackel column = pop, object = pop;
  5665. Daata thee = object->object;
  5666. integer icol = Stackel_getColumnNumber (column, thee);
  5667. if (thy v_hasGetVector ()) {
  5668. pushNumber (thy v_getVector (irow, icol));
  5669. } else if (thy v_hasGetMatrix ()) {
  5670. if (irow == 0) {
  5671. Melder_throw (U"We are not in a loop,\n"
  5672. U"hence no implicit row index for this ", Thing_className (thee), U" object.\n"
  5673. U"Try using: object [id, row, column].");
  5674. } else {
  5675. pushNumber (thy v_getMatrix (irow, icol));
  5676. }
  5677. } else {
  5678. Melder_throw (Thing_className (thee), U" objects accept no [column] indexes.");
  5679. }
  5680. }
  5681. static void do_matriks1 (integer irow) {
  5682. Daata thee = parse [programPointer]. content.object;
  5683. Stackel column = pop;
  5684. integer icol = Stackel_getColumnNumber (column, thee);
  5685. if (thy v_hasGetVector ()) {
  5686. pushNumber (thy v_getVector (irow, icol));
  5687. } else if (thy v_hasGetMatrix ()) {
  5688. if (irow == 0) {
  5689. Melder_throw (U"We are not in a loop,\n"
  5690. U"hence no implicit row index for this ", Thing_className (thee), U" object.\n"
  5691. U"Try using both [row, column] indexes instead.");
  5692. } else {
  5693. pushNumber (thy v_getMatrix (irow, icol));
  5694. }
  5695. } else {
  5696. Melder_throw (Thing_className (thee), U" objects accept no [column] indexes.");
  5697. }
  5698. }
  5699. static void do_objectCellStr1 (integer irow) {
  5700. Stackel column = pop, object = pop;
  5701. Daata thee = object->object;
  5702. integer icol = Stackel_getColumnNumber (column, thee);
  5703. if (thy v_hasGetVectorStr ()) {
  5704. pushString (Melder_dup (thy v_getVectorStr (icol)));
  5705. } else if (thy v_hasGetMatrixStr ()) {
  5706. if (irow == 0) {
  5707. Melder_throw (U"We are not in a loop,\n"
  5708. U"hence no implicit row index for this ", Thing_className (thee), U" object.\n"
  5709. U"Try using: object [id, row, column].");
  5710. } else {
  5711. pushString (Melder_dup (thy v_getMatrixStr (irow, icol)));
  5712. }
  5713. } else {
  5714. Melder_throw (Thing_className (thee), U" objects accept no [column] indexes for string cells.");
  5715. }
  5716. }
  5717. static void do_matrixStr1 (integer irow) {
  5718. Daata thee = parse [programPointer]. content.object;
  5719. Stackel column = pop;
  5720. integer icol = Stackel_getColumnNumber (column, thee);
  5721. if (thy v_hasGetVectorStr ()) {
  5722. pushString (Melder_dup (thy v_getVectorStr (icol)));
  5723. } else if (thy v_hasGetMatrixStr ()) {
  5724. if (irow == 0) {
  5725. Melder_throw (U"We are not in a loop,\n"
  5726. U"hence no implicit row index for this ", Thing_className (thee), U" object.\n"
  5727. U"Try using both [row, column] indexes instead.");
  5728. } else {
  5729. pushString (Melder_dup (thy v_getMatrixStr (irow, icol)));
  5730. }
  5731. } else {
  5732. Melder_throw (Thing_className (thee), U" objects accept no [column] indexes for string cells.");
  5733. }
  5734. }
  5735. static void do_selfMatriks2 () {
  5736. Daata me = theSource;
  5737. Stackel column = pop, row = pop;
  5738. if (! me) Melder_throw (U"The name \"self\" is restricted to formulas for objects.");
  5739. integer irow = Stackel_getRowNumber (row, me);
  5740. integer icol = Stackel_getColumnNumber (column, me);
  5741. if (! my v_hasGetMatrix ())
  5742. Melder_throw (Thing_className (me), U" objects like \"self\" accept no [row, column] indexing.");
  5743. pushNumber (my v_getMatrix (irow, icol));
  5744. }
  5745. static void do_selfMatriksStr2 () {
  5746. Daata me = theSource;
  5747. Stackel column = pop, row = pop;
  5748. if (! me) Melder_throw (U"The name \"self$\" is restricted to formulas for objects.");
  5749. integer irow = Stackel_getRowNumber (row, me);
  5750. integer icol = Stackel_getColumnNumber (column, me);
  5751. if (! my v_hasGetMatrixStr ())
  5752. Melder_throw (Thing_className (me), U" objects like \"self$\" accept no [row, column] indexing for string cells.");
  5753. pushString (Melder_dup (my v_getMatrixStr (irow, icol)));
  5754. }
  5755. static void do_objectCell2 () {
  5756. Stackel column = pop, row = pop, object = pop;
  5757. Daata thee = object->object;
  5758. integer irow = Stackel_getRowNumber (row, thee);
  5759. integer icol = Stackel_getColumnNumber (column, thee);
  5760. if (! thy v_hasGetMatrix ())
  5761. Melder_throw (Thing_className (thee), U" objects accept no [id, row, column] indexing.");
  5762. pushNumber (thy v_getMatrix (irow, icol));
  5763. }
  5764. static void do_matriks2 () {
  5765. Daata thee = parse [programPointer]. content.object;
  5766. Stackel column = pop, row = pop;
  5767. integer irow = Stackel_getRowNumber (row, thee);
  5768. integer icol = Stackel_getColumnNumber (column, thee);
  5769. if (! thy v_hasGetMatrix ())
  5770. Melder_throw (Thing_className (thee), U" objects accept no [row, column] indexing.");
  5771. pushNumber (thy v_getMatrix (irow, icol));
  5772. }
  5773. static void do_objectCellStr2 () {
  5774. Stackel column = pop, row = pop, object = pop;
  5775. Daata thee = object->object;
  5776. integer irow = Stackel_getRowNumber (row, thee);
  5777. integer icol = Stackel_getColumnNumber (column, thee);
  5778. if (! thy v_hasGetMatrixStr ())
  5779. Melder_throw (Thing_className (thee), U" objects accept no [id, row, column] indexing for string cells.");
  5780. pushString (Melder_dup (thy v_getMatrixStr (irow, icol)));
  5781. }
  5782. static void do_matriksStr2 () {
  5783. Daata thee = parse [programPointer]. content.object;
  5784. Stackel column = pop, row = pop;
  5785. integer irow = Stackel_getRowNumber (row, thee);
  5786. integer icol = Stackel_getColumnNumber (column, thee);
  5787. if (! thy v_hasGetMatrixStr ())
  5788. Melder_throw (Thing_className (thee), U" objects accept no [row, column] indexing for string cells.");
  5789. pushString (Melder_dup (thy v_getMatrixStr (irow, icol)));
  5790. }
  5791. static void do_objectLocation0 (integer irow, integer icol) {
  5792. Stackel object = pop;
  5793. Daata thee = object->object;
  5794. if (thy v_hasGetFunction0 ()) {
  5795. pushNumber (thy v_getFunction0 ());
  5796. } else if (thy v_hasGetFunction1 ()) {
  5797. Daata me = theSource;
  5798. if (! me)
  5799. Melder_throw (U"No current object (we are not in a Formula command),\n"
  5800. U"hence no implicit x value for this ", Thing_className (thee), U" object.\n"
  5801. U"Try using: object (id, x).");
  5802. if (! my v_hasGetX ())
  5803. Melder_throw (U"The current ", Thing_className (me),
  5804. U" object gives no implicit x values,\nhence no implicit x value for this ",
  5805. Thing_className (thee), " object.\n"
  5806. U"Try using: object (id, x).");
  5807. double x = my v_getX (icol);
  5808. pushNumber (thy v_getFunction1 (irow, x));
  5809. } else if (thy v_hasGetFunction2 ()) {
  5810. Daata me = theSource;
  5811. if (! me)
  5812. Melder_throw (U"No current object (we are not in a Formula command),\n"
  5813. U"hence no implicit x or y values for this ", Thing_className (thee), U" object.\n"
  5814. U"Try using: object (id, x, y).");
  5815. if (! my v_hasGetX ())
  5816. Melder_throw (U"The current ", Thing_className (me), U" object gives no implicit x values,\n"
  5817. U"hence no implicit x value for this ", Thing_className (thee), U" object.\n"
  5818. U"Try using: object (id, x, y).");
  5819. double x = my v_getX (icol);
  5820. if (! my v_hasGetY ())
  5821. Melder_throw (U"The current ", Thing_className (me), U" object gives no implicit y values,\n"
  5822. U"hence no implicit y value for this ", Thing_className (thee), U" object.\n"
  5823. U"Try using: object (id, y).");
  5824. double y = my v_getY (irow);
  5825. pushNumber (thy v_getFunction2 (x, y));
  5826. } else {
  5827. Melder_throw (Thing_className (thee), U" objects accept no () values.");
  5828. }
  5829. }
  5830. static void do_funktie0 (integer irow, integer icol) {
  5831. Daata thee = parse [programPointer]. content.object;
  5832. if (thy v_hasGetFunction0 ()) {
  5833. pushNumber (thy v_getFunction0 ());
  5834. } else if (thy v_hasGetFunction1 ()) {
  5835. Daata me = theSource;
  5836. if (!me)
  5837. Melder_throw (U"No current object (we are not in a Formula command),\n"
  5838. U"hence no implicit x value for this ", Thing_className (thee), U" object.\n"
  5839. U"Try using the (x) argument explicitly.");
  5840. if (! my v_hasGetX ())
  5841. Melder_throw (U"The current ", Thing_className (me),
  5842. U" object gives no implicit x values,\nhence no implicit x value for this ",
  5843. Thing_className (thee), U" object.\n"
  5844. U"Try using the (x) argument explicitly.");
  5845. double x = my v_getX (icol);
  5846. pushNumber (thy v_getFunction1 (irow, x));
  5847. } else if (thy v_hasGetFunction2 ()) {
  5848. Daata me = theSource;
  5849. if (! me)
  5850. Melder_throw (U"No current object (we are not in a Formula command),\n"
  5851. U"hence no implicit x or y values for this ", Thing_className (thee), U" object.\n"
  5852. U"Try using both (x, y) arguments explicitly.");
  5853. if (! my v_hasGetX ())
  5854. Melder_throw (U"The current ", Thing_className (me), U" object gives no implicit x values,\n"
  5855. U"hence no implicit x value for this ", Thing_className (thee), U" object.\n"
  5856. U"Try using both (x, y) arguments explicitly.");
  5857. double x = my v_getX (icol);
  5858. if (! my v_hasGetY ())
  5859. Melder_throw (U"The current ", Thing_className (me), U" object gives no implicit y values,\n"
  5860. U"hence no implicit y value for this ", Thing_className (thee), U" object.\n"
  5861. U"Try using the (y) argument explicitly.");
  5862. double y = my v_getY (irow);
  5863. pushNumber (thy v_getFunction2 (x, y));
  5864. } else {
  5865. Melder_throw (Thing_className (thee), U" objects accept no () values.");
  5866. }
  5867. }
  5868. static void do_selfFunktie1 (integer irow) {
  5869. Daata me = theSource;
  5870. Stackel x = pop;
  5871. if (x->which == Stackel_NUMBER) {
  5872. if (! me) Melder_throw (U"The name \"self\" is restricted to formulas for objects.");
  5873. if (my v_hasGetFunction1 ()) {
  5874. pushNumber (my v_getFunction1 (irow, x->number));
  5875. } else if (my v_hasGetFunction2 ()) {
  5876. if (! my v_hasGetY ())
  5877. Melder_throw (U"The current ", Thing_className (me), U" object (self) accepts no implicit y values.\n"
  5878. U"Try using both (x, y) arguments instead.");
  5879. double y = my v_getY (irow);
  5880. pushNumber (my v_getFunction2 (x->number, y));
  5881. } else {
  5882. Melder_throw (Thing_className (me), U" objects like \"self\" accept no (x) values.");
  5883. }
  5884. } else {
  5885. Melder_throw (Thing_className (me), U" objects like \"self\" accept only numeric x values.");
  5886. }
  5887. }
  5888. static void do_objectLocation1 (integer irow) {
  5889. Stackel x = pop, object = pop;
  5890. Daata thee = object->object;
  5891. if (x->which == Stackel_NUMBER) {
  5892. if (thy v_hasGetFunction1 ()) {
  5893. pushNumber (thy v_getFunction1 (irow, x->number));
  5894. } else if (thy v_hasGetFunction2 ()) {
  5895. Daata me = theSource;
  5896. if (! me)
  5897. Melder_throw (U"No current object (we are not in a Formula command),\n"
  5898. U"hence no implicit y value for this ", Thing_className (thee), U" object.\n"
  5899. U"Try using: object (id, x, y).");
  5900. if (! my v_hasGetY ())
  5901. Melder_throw (U"The current ", Thing_className (me), U" object gives no implicit y values,\n"
  5902. U"hence no implicit y value for this ", Thing_className (thee), U" object.\n"
  5903. U"Try using: object (id, x, y).");
  5904. double y = my v_getY (irow);
  5905. pushNumber (thy v_getFunction2 (x->number, y));
  5906. } else {
  5907. Melder_throw (Thing_className (thee), U" objects accept no (x) values.");
  5908. }
  5909. } else {
  5910. Melder_throw (Thing_className (thee), U" objects accept only numeric x values.");
  5911. }
  5912. }
  5913. static void do_funktie1 (integer irow) {
  5914. Daata thee = parse [programPointer]. content.object;
  5915. Stackel x = pop;
  5916. if (x->which == Stackel_NUMBER) {
  5917. if (thy v_hasGetFunction1 ()) {
  5918. pushNumber (thy v_getFunction1 (irow, x->number));
  5919. } else if (thy v_hasGetFunction2 ()) {
  5920. Daata me = theSource;
  5921. if (! me)
  5922. Melder_throw (U"No current object (we are not in a Formula command),\n"
  5923. U"hence no implicit y value for this ", Thing_className (thee), U" object.\n"
  5924. U"Try using both (x, y) arguments instead.");
  5925. if (! my v_hasGetY ())
  5926. Melder_throw (U"The current ", Thing_className (me), U" object gives no implicit y values,\n"
  5927. U"hence no implicit y value for this ", Thing_className (thee), U" object.\n"
  5928. U"Try using both (x, y) arguments instead.");
  5929. double y = my v_getY (irow);
  5930. pushNumber (thy v_getFunction2 (x->number, y));
  5931. } else {
  5932. Melder_throw (Thing_className (thee), U" objects accept no (x) values.");
  5933. }
  5934. } else {
  5935. Melder_throw (Thing_className (thee), U" objects accept only numeric x values.");
  5936. }
  5937. }
  5938. static void do_selfFunktie2 () {
  5939. Daata me = theSource;
  5940. Stackel y = pop, x = pop;
  5941. if (x->which == Stackel_NUMBER && y->which == Stackel_NUMBER) {
  5942. if (! me) Melder_throw (U"The name \"self\" is restricted to formulas for objects.");
  5943. if (! my v_hasGetFunction2 ())
  5944. Melder_throw (Thing_className (me), U" objects like \"self\" accept no (x, y) values.");
  5945. pushNumber (my v_getFunction2 (x->number, y->number));
  5946. } else {
  5947. Melder_throw (Thing_className (me), U" objects accept only numeric x values.");
  5948. }
  5949. }
  5950. static void do_objectLocation2 () {
  5951. Stackel y = pop, x = pop, object = pop;
  5952. Daata thee = object->object;
  5953. if (x->which == Stackel_NUMBER && y->which == Stackel_NUMBER) {
  5954. if (! thy v_hasGetFunction2 ())
  5955. Melder_throw (Thing_className (thee), U" objects accept no (x, y) values.");
  5956. pushNumber (thy v_getFunction2 (x->number, y->number));
  5957. } else {
  5958. Melder_throw (Thing_className (thee), U" objects accept only numeric x values.");
  5959. }
  5960. }
  5961. static void do_funktie2 () {
  5962. Daata thee = parse [programPointer]. content.object;
  5963. Stackel y = pop, x = pop;
  5964. if (x->which == Stackel_NUMBER && y->which == Stackel_NUMBER) {
  5965. if (! thy v_hasGetFunction2 ())
  5966. Melder_throw (Thing_className (thee), U" objects accept no (x, y) values.");
  5967. pushNumber (thy v_getFunction2 (x->number, y->number));
  5968. } else {
  5969. Melder_throw (Thing_className (thee), U" objects accept only numeric x values.");
  5970. }
  5971. }
  5972. static void do_rowStr () {
  5973. Daata thee = parse [programPointer]. content.object;
  5974. Stackel row = pop;
  5975. integer irow = Stackel_getRowNumber (row, thee);
  5976. autostring32 result = Melder_dup (thy v_getRowStr (irow));
  5977. if (! result)
  5978. Melder_throw (U"Row index out of bounds.");
  5979. pushString (result.move());
  5980. }
  5981. static void do_colStr () {
  5982. Daata thee = parse [programPointer]. content.object;
  5983. Stackel col = pop;
  5984. integer icol = Stackel_getColumnNumber (col, thee);
  5985. autostring32 result = Melder_dup (thy v_getColStr (icol));
  5986. if (! result)
  5987. Melder_throw (U"Column index out of bounds.");
  5988. pushString (result.move());
  5989. }
  5990. static double NUMarcsinh (double x) {
  5991. //Melder_casual (U"NUMarcsinh ", fileno(stdout));
  5992. return log (x + sqrt (1.0 + x * x));
  5993. }
  5994. static double NUMarccosh (double x) {
  5995. return x < 1.0 ? undefined : log (x + sqrt (x * x - 1.0));
  5996. }
  5997. static double NUMarctanh (double x) {
  5998. return x <= -1.0 || x >= 1.0 ? undefined : 0.5 * log ((1.0 + x) / (1.0 - x));
  5999. }
  6000. static double NUMerf (double x) {
  6001. return 1.0 - NUMerfcc (x);
  6002. }
  6003. void Formula_run (integer row, integer col, Formula_Result *result) {
  6004. FormulaInstruction f = parse;
  6005. programPointer = 1; // first symbol of the program
  6006. if (! theStack) {
  6007. theStack = Melder_calloc_f (struct structStackel, 1+Formula_MAXIMUM_STACK_SIZE);
  6008. if (! theStack)
  6009. Melder_throw (U"Out of memory during formula computation.");
  6010. }
  6011. w = 0, wmax = 0; // start new stack
  6012. try {
  6013. while (programPointer <= numberOfInstructions) {
  6014. int symbol;
  6015. switch (symbol = f [programPointer]. symbol) {
  6016. case NUMBER_: { pushNumber (f [programPointer]. content.number);
  6017. } break; case STOPWATCH_: { pushNumber (Melder_stopwatch ());
  6018. } break; case ROW_: { pushNumber (row);
  6019. } break; case COL_: { pushNumber (col);
  6020. } break; case X_: {
  6021. Daata me = theSource;
  6022. if (! my v_hasGetX ()) Melder_throw (U"No values for \"x\" for this object.");
  6023. pushNumber (my v_getX (col));
  6024. } break; case Y_: {
  6025. Daata me = theSource;
  6026. if (! my v_hasGetY ()) Melder_throw (U"No values for \"y\" for this object.");
  6027. pushNumber (my v_getY (row));
  6028. } break; case NOT_: { do_not ();
  6029. } break; case EQ_: { do_eq ();
  6030. } break; case NE_: { do_ne ();
  6031. } break; case LE_: { do_le ();
  6032. } break; case LT_: { do_lt ();
  6033. } break; case GE_: { do_ge ();
  6034. } break; case GT_: { do_gt ();
  6035. } break; case ADD_: { do_add ();
  6036. } break; case SUB_: { do_sub ();
  6037. } break; case MUL_: { do_mul ();
  6038. } break; case RDIV_: { do_rdiv ();
  6039. } break; case IDIV_: { do_idiv ();
  6040. } break; case MOD_: { do_mod ();
  6041. } break; case MINUS_: { do_minus ();
  6042. } break; case POWER_: { do_power ();
  6043. /********** Functions of 1 variable: **********/
  6044. } break; case ABS_: { do_abs ();
  6045. } break; case ROUND_: { do_round ();
  6046. } break; case FLOOR_: { do_floor ();
  6047. } break; case CEILING_: { do_ceiling ();
  6048. } break; case RECTIFY_: { do_rectify ();
  6049. } break; case VEC_RECTIFY_: { do_VECrectify ();
  6050. } break; case SQRT_: { do_sqrt ();
  6051. } break; case SIN_: { do_sin ();
  6052. } break; case COS_: { do_cos ();
  6053. } break; case TAN_: { do_tan ();
  6054. } break; case ARCSIN_: { do_arcsin ();
  6055. } break; case ARCCOS_: { do_arccos ();
  6056. } break; case ARCTAN_: { do_arctan ();
  6057. } break; case SINC_: { do_function_n_n (NUMsinc);
  6058. } break; case SINCPI_: { do_function_n_n (NUMsincpi);
  6059. } break; case EXP_: { do_exp ();
  6060. } break; case VEC_EXP_: { do_VECexp ();
  6061. } break; case MAT_EXP_: { do_MATexp ();
  6062. } break; case SINH_: { do_sinh ();
  6063. } break; case COSH_: { do_cosh ();
  6064. } break; case TANH_: { do_tanh ();
  6065. } break; case ARCSINH_: { do_function_n_n (NUMarcsinh);
  6066. } break; case ARCCOSH_: { do_function_n_n (NUMarccosh);
  6067. } break; case ARCTANH_: { do_function_n_n (NUMarctanh);
  6068. } break; case SIGMOID_: { do_function_n_n (NUMsigmoid);
  6069. } break; case VEC_SIGMOID_: { do_functionvec_n_n (NUMsigmoid);
  6070. } break; case VEC_SOFTMAX_: { do_softmax ();
  6071. } break; case INV_SIGMOID_: { do_function_n_n (NUMinvSigmoid);
  6072. } break; case ERF_: { do_function_n_n (NUMerf);
  6073. } break; case ERFC_: { do_function_n_n (NUMerfcc);
  6074. } break; case GAUSS_P_: { do_function_n_n (NUMgaussP);
  6075. } break; case GAUSS_Q_: { do_function_n_n (NUMgaussQ);
  6076. } break; case INV_GAUSS_Q_: { do_function_n_n (NUMinvGaussQ);
  6077. } break; case RANDOM_BERNOULLI_: { do_function_n_n (NUMrandomBernoulli_real);
  6078. } break; case VEC_RANDOM_BERNOULLI_: { do_functionvec_n_n (NUMrandomBernoulli_real);
  6079. } break; case RANDOM_POISSON_: { do_function_n_n (NUMrandomPoisson);
  6080. } break; case LOG2_: { do_log2 ();
  6081. } break; case LN_: { do_ln ();
  6082. } break; case LOG10_: { do_log10 ();
  6083. } break; case LN_GAMMA_: { do_function_n_n (NUMlnGamma);
  6084. } break; case HERTZ_TO_BARK_: { do_function_n_n (NUMhertzToBark);
  6085. } break; case BARK_TO_HERTZ_: { do_function_n_n (NUMbarkToHertz);
  6086. } break; case PHON_TO_DIFFERENCE_LIMENS_: { do_function_n_n (NUMphonToDifferenceLimens);
  6087. } break; case DIFFERENCE_LIMENS_TO_PHON_: { do_function_n_n (NUMdifferenceLimensToPhon);
  6088. } break; case HERTZ_TO_MEL_: { do_function_n_n (NUMhertzToMel);
  6089. } break; case MEL_TO_HERTZ_: { do_function_n_n (NUMmelToHertz);
  6090. } break; case HERTZ_TO_SEMITONES_: { do_function_n_n (NUMhertzToSemitones);
  6091. } break; case SEMITONES_TO_HERTZ_: { do_function_n_n (NUMsemitonesToHertz);
  6092. } break; case ERB_: { do_function_n_n (NUMerb);
  6093. } break; case HERTZ_TO_ERB_: { do_function_n_n (NUMhertzToErb);
  6094. } break; case ERB_TO_HERTZ_: { do_function_n_n (NUMerbToHertz);
  6095. } break; case SUM_: { do_sum ();
  6096. } break; case MEAN_: { do_mean ();
  6097. } break; case STDEV_: { do_stdev ();
  6098. } break; case CENTER_: { do_center ();
  6099. } break; case EVALUATE_: { do_evaluate ();
  6100. } break; case EVALUATE_NOCHECK_: { do_evaluate_nocheck ();
  6101. } break; case EVALUATE_STR_: { do_evaluateStr ();
  6102. } break; case EVALUATE_NOCHECK_STR_: { do_evaluate_nocheckStr ();
  6103. /********** Functions of 2 numerical variables: **********/
  6104. } break; case ARCTAN2_: { do_function_dd_d (atan2);
  6105. } break; case RANDOM_UNIFORM_: { do_function_dd_d (NUMrandomUniform);
  6106. } break; case RANDOM_INTEGER_: { do_function_ll_l (NUMrandomInteger);
  6107. } break; case RANDOM_GAUSS_: { do_function_dd_d (NUMrandomGauss);
  6108. } break; case RANDOM_BINOMIAL_: { do_function_dl_d (NUMrandomBinomial_real);
  6109. } break; case CHI_SQUARE_P_: { do_function_dd_d (NUMchiSquareP);
  6110. } break; case CHI_SQUARE_Q_: { do_function_dd_d (NUMchiSquareQ);
  6111. } break; case INCOMPLETE_GAMMAP_: { do_function_dd_d (NUMincompleteGammaP);
  6112. } break; case INV_CHI_SQUARE_Q_: { do_function_dd_d (NUMinvChiSquareQ);
  6113. } break; case STUDENT_P_: { do_function_dd_d (NUMstudentP);
  6114. } break; case STUDENT_Q_: { do_function_dd_d (NUMstudentQ);
  6115. } break; case INV_STUDENT_Q_: { do_function_dd_d (NUMinvStudentQ);
  6116. } break; case BETA_: { do_function_dd_d (NUMbeta);
  6117. } break; case BETA2_: { do_function_dd_d (NUMbeta2);
  6118. } break; case BESSEL_I_: { do_function_ld_d (NUMbesselI);
  6119. } break; case BESSEL_K_: { do_function_ld_d (NUMbesselK);
  6120. } break; case LN_BETA_: { do_function_dd_d (NUMlnBeta);
  6121. } break; case SOUND_PRESSURE_TO_PHON_: { do_function_dd_d (NUMsoundPressureToPhon);
  6122. } break; case OBJECTS_ARE_IDENTICAL_: { do_objects_are_identical ();
  6123. /********** Functions of 3 numerical variables: **********/
  6124. } break; case FISHER_P_: { do_function_ddd_d (NUMfisherP);
  6125. } break; case FISHER_Q_: { do_function_ddd_d (NUMfisherQ);
  6126. } break; case INV_FISHER_Q_: { do_function_ddd_d (NUMinvFisherQ);
  6127. } break; case BINOMIAL_P_: { do_function_ddd_d (NUMbinomialP);
  6128. } break; case BINOMIAL_Q_: { do_function_ddd_d (NUMbinomialQ);
  6129. } break; case INCOMPLETE_BETA_: { do_function_ddd_d (NUMincompleteBeta);
  6130. } break; case INV_BINOMIAL_P_: { do_function_ddd_d (NUMinvBinomialP);
  6131. } break; case INV_BINOMIAL_Q_: { do_function_ddd_d (NUMinvBinomialQ);
  6132. /********** Functions of a variable number of variables: **********/
  6133. } break; case DO_ : { do_do ();
  6134. } break; case DOSTR_: { do_doStr ();
  6135. } break; case WRITE_INFO_ : { do_writeInfo ();
  6136. } break; case WRITE_INFO_LINE_ : { do_writeInfoLine ();
  6137. } break; case APPEND_INFO_ : { do_appendInfo ();
  6138. } break; case APPEND_INFO_LINE_: { do_appendInfoLine ();
  6139. } break; case WRITE_FILE_ : { do_writeFile ();
  6140. } break; case WRITE_FILE_LINE_ : { do_writeFileLine ();
  6141. } break; case APPEND_FILE_ : { do_appendFile ();
  6142. } break; case APPEND_FILE_LINE_: { do_appendFileLine ();
  6143. } break; case PAUSE_SCRIPT_: { do_pauseScript ();
  6144. } break; case EXIT_SCRIPT_: { do_exitScript ();
  6145. } break; case RUN_SCRIPT_: { do_runScript ();
  6146. } break; case RUN_SYSTEM_: { do_runSystem ();
  6147. } break; case RUN_SYSTEM_NOCHECK_: { do_runSystem_nocheck ();
  6148. } break; case RUN_SUBPROCESS_: { do_runSubprocess ();
  6149. } break; case MIN_: { do_min ();
  6150. } break; case MAX_: { do_max ();
  6151. } break; case IMIN_: { do_imin ();
  6152. } break; case IMAX_: { do_imax ();
  6153. } break; case NORM_: { do_norm ();
  6154. } break; case VEC_ZERO_: { do_VECzero ();
  6155. } break; case MAT_ZERO_: { do_MATzero ();
  6156. } break; case VEC_LINEAR_: { do_VEClinear ();
  6157. } break; case VEC_TO_: { do_VECto ();
  6158. } break; case VEC_RANDOM_UNIFORM_: { do_function_VECdd_d (NUMrandomUniform);
  6159. } break; case MAT_RANDOM_UNIFORM_: { do_function_MATdd_d (NUMrandomUniform);
  6160. } break; case VEC_RANDOM_INTEGER_: { do_function_VECll_l (NUMrandomInteger);
  6161. } break; case MAT_RANDOM_INTEGER_: { do_function_MATll_l (NUMrandomInteger);
  6162. } break; case VEC_RANDOM_GAUSS_: { do_function_VECdd_d (NUMrandomGauss);
  6163. } break; case MAT_RANDOM_GAUSS_: { do_function_MATdd_d (NUMrandomGauss);
  6164. } break; case MAT_PEAKS_: { do_MATpeaks ();
  6165. } break; case SIZE_: { do_size ();
  6166. } break; case NUMBER_OF_ROWS_: { do_numberOfRows ();
  6167. } break; case NUMBER_OF_COLUMNS_: { do_numberOfColumns ();
  6168. } break; case EDITOR_: { do_editor ();
  6169. } break; case HASH_: { do_hash ();
  6170. /********** String functions: **********/
  6171. } break; case LENGTH_: { do_length ();
  6172. } break; case STRING_TO_NUMBER_: { do_number ();
  6173. } break; case FILE_READABLE_: { do_fileReadable ();
  6174. } break; case DATESTR_: { do_STRdate ();
  6175. } break; case INFOSTR_: { do_infoStr ();
  6176. } break; case LEFTSTR_: { do_STRleft ();
  6177. } break; case RIGHTSTR_: { do_STRright ();
  6178. } break; case MIDSTR_: { do_STRmid ();
  6179. } break; case UNICODE_TO_BACKSLASH_TRIGRAPHS_: { do_unicodeToBackslashTrigraphsStr ();
  6180. } break; case BACKSLASH_TRIGRAPHS_TO_UNICODE_: { do_backslashTrigraphsToUnicodeStr ();
  6181. } break; case ENVIRONMENTSTR_: { do_environmentStr ();
  6182. } break; case INDEX_: { do_index ();
  6183. } break; case RINDEX_: { do_rindex ();
  6184. } break; case STARTS_WITH_: { do_stringMatchesCriterion (kMelder_string::STARTS_WITH);
  6185. } break; case ENDS_WITH_: { do_stringMatchesCriterion (kMelder_string::ENDS_WITH);
  6186. } break; case REPLACESTR_: { do_STRreplace ();
  6187. } break; case INDEX_REGEX_: { do_index_regex (false);
  6188. } break; case RINDEX_REGEX_: { do_index_regex (true);
  6189. } break; case REPLACE_REGEXSTR_: { do_STRreplace_regex ();
  6190. } break; case EXTRACT_NUMBER_: { do_extractNumber ();
  6191. } break; case EXTRACT_WORDSTR_: { do_extractTextStr (true);
  6192. } break; case EXTRACT_LINESTR_: { do_extractTextStr (false);
  6193. } break; case SELECTED_: { do_selected ();
  6194. } break; case SELECTEDSTR_: { do_selectedStr ();
  6195. } break; case NUMBER_OF_SELECTED_: { do_numberOfSelected ();
  6196. } break; case VEC_SELECTED_: { do_VECselected ();
  6197. } break; case SELECT_OBJECT_: { do_selectObject ();
  6198. } break; case PLUS_OBJECT_ : { do_plusObject ();
  6199. } break; case MINUS_OBJECT_ : { do_minusObject ();
  6200. } break; case REMOVE_OBJECT_: { do_removeObject ();
  6201. } break; case OBJECT_XMIN_: { do_object_xmin ();
  6202. } break; case OBJECT_XMAX_: { do_object_xmax ();
  6203. } break; case OBJECT_YMIN_: { do_object_ymin ();
  6204. } break; case OBJECT_YMAX_: { do_object_ymax ();
  6205. } break; case OBJECT_NX_: { do_object_nx ();
  6206. } break; case OBJECT_NY_: { do_object_ny ();
  6207. } break; case OBJECT_DX_: { do_object_dx ();
  6208. } break; case OBJECT_DY_: { do_object_dy ();
  6209. } break; case OBJECT_NROW_: { do_object_nrow ();
  6210. } break; case OBJECT_NCOL_: { do_object_ncol ();
  6211. } break; case OBJECT_ROWSTR_: { do_object_rowstr ();
  6212. } break; case OBJECT_COLSTR_: { do_object_colstr ();
  6213. } break; case STRINGSTR_: { do_stringStr ();
  6214. } break; case SLEEP_: { do_sleep ();
  6215. } break; case UNICODE_: { do_unicode ();
  6216. } break; case UNICODESTR_: { do_unicodeStr ();
  6217. } break; case FIXEDSTR_: { do_fixedStr ();
  6218. } break; case PERCENTSTR_: { do_percentStr ();
  6219. } break; case HEXADECIMALSTR_: { do_hexadecimalStr ();
  6220. } break; case DELETE_FILE_: { do_deleteFile ();
  6221. } break; case CREATE_DIRECTORY_: { do_createDirectory ();
  6222. } break; case VARIABLE_EXISTS_: { do_variableExists ();
  6223. } break; case READ_FILE_: { do_readFile ();
  6224. } break; case READ_FILESTR_: { do_readFileStr ();
  6225. /********** Matrix functions: **********/
  6226. } break; case INNER_: { do_inner ();
  6227. } break; case MAT_OUTER_: { do_MATouter ();
  6228. } break; case VEC_MUL_: { do_VECmul ();
  6229. } break; case VEC_REPEAT_: { do_VECrepeat ();
  6230. /********** Pause window functions: **********/
  6231. } break; case BEGIN_PAUSE_FORM_: { do_beginPauseForm ();
  6232. } break; case PAUSE_FORM_ADD_REAL_: { do_pauseFormAddReal ();
  6233. } break; case PAUSE_FORM_ADD_POSITIVE_: { do_pauseFormAddPositive ();
  6234. } break; case PAUSE_FORM_ADD_INTEGER_: { do_pauseFormAddInteger ();
  6235. } break; case PAUSE_FORM_ADD_NATURAL_: { do_pauseFormAddNatural ();
  6236. } break; case PAUSE_FORM_ADD_WORD_: { do_pauseFormAddWord ();
  6237. } break; case PAUSE_FORM_ADD_SENTENCE_: { do_pauseFormAddSentence ();
  6238. } break; case PAUSE_FORM_ADD_TEXT_: { do_pauseFormAddText ();
  6239. } break; case PAUSE_FORM_ADD_BOOLEAN_: { do_pauseFormAddBoolean ();
  6240. } break; case PAUSE_FORM_ADD_CHOICE_: { do_pauseFormAddChoice ();
  6241. } break; case PAUSE_FORM_ADD_OPTION_MENU_: { do_pauseFormAddOptionMenu ();
  6242. } break; case PAUSE_FORM_ADD_OPTION_: { do_pauseFormAddOption ();
  6243. } break; case PAUSE_FORM_ADD_COMMENT_: { do_pauseFormAddComment ();
  6244. } break; case END_PAUSE_FORM_: { do_endPauseForm ();
  6245. } break; case CHOOSE_READ_FILESTR_: { do_chooseReadFileStr ();
  6246. } break; case CHOOSE_WRITE_FILESTR_: { do_chooseWriteFileStr ();
  6247. } break; case CHOOSE_DIRECTORYSTR_: { do_chooseDirectoryStr ();
  6248. /********** Demo window functions: **********/
  6249. } break; case DEMO_WINDOW_TITLE_: { do_demoWindowTitle ();
  6250. } break; case DEMO_SHOW_: { do_demoShow ();
  6251. } break; case DEMO_WAIT_FOR_INPUT_: { do_demoWaitForInput ();
  6252. } break; case DEMO_PEEK_INPUT_: { do_demoPeekInput ();
  6253. } break; case DEMO_INPUT_: { do_demoInput ();
  6254. } break; case DEMO_CLICKED_IN_: { do_demoClickedIn ();
  6255. } break; case DEMO_CLICKED_: { do_demoClicked ();
  6256. } break; case DEMO_X_: { do_demoX ();
  6257. } break; case DEMO_Y_: { do_demoY ();
  6258. } break; case DEMO_KEY_PRESSED_: { do_demoKeyPressed ();
  6259. } break; case DEMO_KEY_: { do_demoKey ();
  6260. } break; case DEMO_SHIFT_KEY_PRESSED_: { do_demoShiftKeyPressed ();
  6261. } break; case DEMO_COMMAND_KEY_PRESSED_: { do_demoCommandKeyPressed ();
  6262. } break; case DEMO_OPTION_KEY_PRESSED_: { do_demoOptionKeyPressed ();
  6263. } break; case DEMO_EXTRA_CONTROL_KEY_PRESSED_: { do_demoExtraControlKeyPressed ();
  6264. /********** **********/
  6265. } break; case TRUE_: {
  6266. pushNumber (1.0);
  6267. } break; case FALSE_: {
  6268. pushNumber (0.0);
  6269. } break; case IFTRUE_: {
  6270. Stackel condition = pop;
  6271. if (condition->which == Stackel_NUMBER) {
  6272. if (condition->number != 0.0) {
  6273. /* Possible compiler BUG: some compilers cannot handle the following assignment. */
  6274. /* Those compilers will have trouble with praat's AND and OR. */
  6275. programPointer = f [programPointer]. content.label - theOptimize;
  6276. }
  6277. } else {
  6278. Melder_throw (U"A condition between \"if\" and \"then\" has to be a number, not ", condition->whichText(), U".");
  6279. }
  6280. } break; case IFFALSE_: {
  6281. Stackel condition = pop;
  6282. if (condition->which == Stackel_NUMBER) {
  6283. if (condition->number == 0.0) {
  6284. programPointer = f [programPointer]. content.label - theOptimize;
  6285. }
  6286. } else {
  6287. Melder_throw (U"A condition between \"if\" and \"then\" has to be a number, not ", condition->whichText(), U".");
  6288. }
  6289. } break; case GOTO_: {
  6290. programPointer = f [programPointer]. content.label - theOptimize;
  6291. } break; case LABEL_: {
  6292. ;
  6293. } break; case DECREMENT_AND_ASSIGN_: {
  6294. Stackel x = pop, v = pop;
  6295. InterpreterVariable var = v->variable;
  6296. var -> numericValue = x->number - 1.0;
  6297. //Melder_casual (U"starting value ", var -> numericValue);
  6298. pushVariable (var);
  6299. } break; case INCREMENT_GREATER_GOTO_: {
  6300. //Melder_casual (U"top of loop, stack depth ", w);
  6301. Stackel e = & theStack [w], v = & theStack [w - 1];
  6302. Melder_assert (e->which == Stackel_NUMBER);
  6303. Melder_assert (v->which == Stackel_VARIABLE);
  6304. InterpreterVariable var = v->variable;
  6305. //Melder_casual (U"loop variable ", var -> numericValue);
  6306. var -> numericValue += 1.0;
  6307. //Melder_casual (U"loop variable ", var -> numericValue);
  6308. //Melder_casual (U"end value ", e->number);
  6309. if (var -> numericValue > e->number) {
  6310. programPointer = f [programPointer]. content.label - theOptimize;
  6311. }
  6312. } break; case ADD_3DOWN_: {
  6313. Stackel x = pop, s = & theStack [w - 2];
  6314. Melder_assert (x->which == Stackel_NUMBER);
  6315. Melder_assert (s->which == Stackel_NUMBER);
  6316. //Melder_casual (U"to add ", x->number);
  6317. s->number += x->number;
  6318. //Melder_casual (U"sum ", s->number);
  6319. } break; case POP_2_: {
  6320. w -= 2;
  6321. //Melder_casual (U"total ", theStack[w].number);
  6322. } break; case NUMERIC_VECTOR_ELEMENT_: { do_numericVectorElement ();
  6323. } break; case NUMERIC_MATRIX_ELEMENT_: { do_numericMatrixElement ();
  6324. } break; case INDEXED_NUMERIC_VARIABLE_: { do_indexedNumericVariable ();
  6325. } break; case INDEXED_STRING_VARIABLE_: { do_indexedStringVariable ();
  6326. } break; case VARIABLE_REFERENCE_: {
  6327. InterpreterVariable var = f [programPointer]. content.variable;
  6328. pushVariable (var);
  6329. } break; case SELF0_: { do_self0 (row, col);
  6330. } break; case SELFSTR0_: { do_selfStr0 (row, col);
  6331. } break; case OBJECT_: { pushObject (f [programPointer]. content.object);
  6332. } break; case TO_OBJECT_: { do_toObject ();
  6333. } break; case SELFMATRIKS1_: { do_selfMatriks1 (row);
  6334. } break; case SELFMATRIKSSTR1_: { do_selfMatriksStr1 (row);
  6335. } break; case SELFMATRIKS2_: { do_selfMatriks2 ();
  6336. } break; case SELFMATRIKSSTR2_: { do_selfMatriksStr2 ();
  6337. } break; case SELFFUNKTIE1_: { do_selfFunktie1 (row);
  6338. } break; case SELFFUNKTIE2_: { do_selfFunktie2 ();
  6339. } break; case OBJECTCELL0_: { do_objectCell0 (row, col);
  6340. } break; case OBJECTCELL1_: { do_objectCell1 (row);
  6341. } break; case OBJECTCELLSTR1_: { do_objectCellStr1 (row);
  6342. } break; case OBJECTCELL2_: { do_objectCell2 ();
  6343. } break; case OBJECTCELLSTR2_: { do_objectCellStr2 ();
  6344. } break; case OBJECTLOCATION0_: { do_objectLocation0 (row, col);
  6345. } break; case OBJECTLOCATION1_: { do_objectLocation1 (row);
  6346. } break; case OBJECTLOCATION2_: { do_objectLocation2 ();
  6347. } break; case MATRIKS0_: { do_matriks0 (row, col);
  6348. } break; case MATRIKS1_: { do_matriks1 (row);
  6349. } break; case MATRIKSSTR1_: { do_matrixStr1 (row);
  6350. } break; case MATRIKS2_: { do_matriks2 ();
  6351. } break; case MATRIKSSTR2_: { do_matriksStr2 ();
  6352. } break; case FUNKTIE0_: { do_funktie0 (row, col);
  6353. } break; case FUNKTIE1_: { do_funktie1 (row);
  6354. } break; case FUNKTIE2_: { do_funktie2 ();
  6355. } break; case ROWSTR_: { do_rowStr ();
  6356. } break; case COLSTR_: { do_colStr ();
  6357. } break; case SQR_: { do_sqr ();
  6358. } break; case STRING_: {
  6359. autostring32 string = Melder_dup (f [programPointer]. content.string);
  6360. pushString (string.move());
  6361. } break; case TENSOR_LITERAL_: { do_tensorLiteral ();
  6362. } break; case NUMERIC_VARIABLE_: {
  6363. InterpreterVariable var = f [programPointer]. content.variable;
  6364. pushNumber (var -> numericValue);
  6365. } break; case NUMERIC_VECTOR_VARIABLE_: {
  6366. InterpreterVariable var = f [programPointer]. content.variable;
  6367. pushNumericVectorReference (var -> numericVectorValue.get());
  6368. } break; case NUMERIC_MATRIX_VARIABLE_: {
  6369. InterpreterVariable var = f [programPointer]. content.variable;
  6370. pushNumericMatrixReference (var -> numericMatrixValue.get());
  6371. } break; case STRING_VARIABLE_: {
  6372. InterpreterVariable var = f [programPointer]. content.variable;
  6373. autostring32 string = Melder_dup (var -> stringValue.get());
  6374. pushString (string.move());
  6375. } break; default: Melder_throw (U"Symbol \"", Formula_instructionNames [parse [programPointer]. symbol], U"\" without action.");
  6376. } // endswitch
  6377. programPointer ++;
  6378. } // endwhile
  6379. if (w != 1)
  6380. Melder_fatal (U"Formula: stackpointer ends at ", w, U" instead of 1.");
  6381. /*
  6382. Move the result from the stack to `result`.
  6383. */
  6384. result -> reset();
  6385. if (theExpressionType [theLevel] == kFormula_EXPRESSION_TYPE_NUMERIC) {
  6386. if (theStack [1]. which == Stackel_STRING)
  6387. Melder_throw (U"Found a string expression instead of a numeric expression.");
  6388. if (theStack [1]. which == Stackel_NUMERIC_VECTOR)
  6389. Melder_throw (U"Found a vector expression instead of a numeric expression.");
  6390. if (theStack [1]. which == Stackel_NUMERIC_MATRIX)
  6391. Melder_throw (U"Found a matrix expression instead of a numeric expression.");
  6392. Melder_assert (theStack [1]. which == Stackel_NUMBER);
  6393. result -> expressionType = kFormula_EXPRESSION_TYPE_NUMERIC;
  6394. result -> numericResult = theStack [1]. number;
  6395. } else if (theExpressionType [theLevel] == kFormula_EXPRESSION_TYPE_STRING) {
  6396. if (theStack [1]. which == Stackel_NUMBER)
  6397. Melder_throw (U"Found a numeric expression (value ", theStack [1]. number, U") instead of a string expression.");
  6398. if (theStack [1]. which == Stackel_NUMERIC_VECTOR)
  6399. Melder_throw (U"Found a vector expression instead of a string expression.");
  6400. if (theStack [1]. which == Stackel_NUMERIC_MATRIX)
  6401. Melder_throw (U"Found a matrix expression instead of a string expression.");
  6402. Melder_assert (theStack [1]. which == Stackel_STRING);
  6403. result -> expressionType = kFormula_EXPRESSION_TYPE_STRING;
  6404. Melder_assert (! result -> stringResult);
  6405. result -> stringResult = theStack [1]. moveString();
  6406. Melder_assert (theStack [1]. which == Stackel_STRING);
  6407. Melder_assert (! theStack [1]. getString());
  6408. } else if (theExpressionType [theLevel] == kFormula_EXPRESSION_TYPE_NUMERIC_VECTOR) {
  6409. if (theStack [1]. which == Stackel_NUMBER)
  6410. Melder_throw (U"Found a numeric expression instead of a vector expression.");
  6411. if (theStack [1]. which == Stackel_STRING)
  6412. Melder_throw (U"Found a string expression instead of a vector expression.");
  6413. if (theStack [1]. which == Stackel_NUMERIC_MATRIX)
  6414. Melder_throw (U"Found a matrix expression instead of a vector expression.");
  6415. Melder_assert (theStack [1]. which == Stackel_NUMERIC_VECTOR);
  6416. result -> expressionType = kFormula_EXPRESSION_TYPE_NUMERIC_VECTOR;
  6417. result -> numericVectorResult = theStack [1]. numericVector;
  6418. result -> owned = theStack [1]. owned;
  6419. theStack [1]. owned = false;
  6420. } else if (theExpressionType [theLevel] == kFormula_EXPRESSION_TYPE_NUMERIC_MATRIX) {
  6421. if (theStack [1]. which == Stackel_NUMBER)
  6422. Melder_throw (U"Found a numeric expression instead of a matrix expression.");
  6423. if (theStack [1]. which == Stackel_STRING)
  6424. Melder_throw (U"Found a string expression instead of a matrix expression.");
  6425. if (theStack [1]. which == Stackel_NUMERIC_VECTOR)
  6426. Melder_throw (U"Found a vector expression instead of a matrix expression.");
  6427. Melder_assert (theStack [1]. which == Stackel_NUMERIC_MATRIX);
  6428. result -> expressionType = kFormula_EXPRESSION_TYPE_NUMERIC_MATRIX;
  6429. result -> numericMatrixResult = theStack [1]. numericMatrix;
  6430. result -> owned = theStack [1]. owned;
  6431. theStack [1]. owned = false;
  6432. } else {
  6433. Melder_assert (theExpressionType [theLevel] == kFormula_EXPRESSION_TYPE_UNKNOWN);
  6434. if (theStack [1]. which == Stackel_NUMBER) {
  6435. result -> expressionType = kFormula_EXPRESSION_TYPE_NUMERIC;
  6436. result -> numericResult = theStack [1]. number;
  6437. } else if (theStack [1]. which == Stackel_STRING) {
  6438. result -> expressionType = kFormula_EXPRESSION_TYPE_STRING;
  6439. Melder_assert (! result -> stringResult);
  6440. result -> stringResult = theStack [1]. moveString();
  6441. Melder_assert (theStack [1]. which == Stackel_STRING);
  6442. Melder_assert (! theStack [1]. getString());
  6443. } else if (theStack [1]. which == Stackel_NUMERIC_VECTOR) {
  6444. result -> expressionType = kFormula_EXPRESSION_TYPE_NUMERIC_VECTOR;
  6445. result -> numericVectorResult = theStack [1]. numericVector;
  6446. result -> owned = theStack [1]. owned;
  6447. theStack [1]. owned = false;
  6448. } else if (theStack [1]. which == Stackel_NUMERIC_MATRIX) {
  6449. result -> expressionType = kFormula_EXPRESSION_TYPE_NUMERIC_MATRIX;
  6450. result -> numericMatrixResult = theStack [1]. numericMatrix;
  6451. result -> owned = theStack [1]. owned;
  6452. theStack [1]. owned = false;
  6453. } else {
  6454. Melder_throw (U"Don't know yet how to write ", theStack [1]. whichText(), U".");
  6455. }
  6456. }
  6457. /*
  6458. Clean up the stack (theStack [1] has probably been disowned).
  6459. */
  6460. for (w = wmax; w > 0; w --)
  6461. theStack [w]. reset();
  6462. } catch (MelderError) {
  6463. /*
  6464. Clean up the stack (theStack [1] has probably not been disowned).
  6465. */
  6466. for (w = wmax; w > 0; w --)
  6467. theStack [w]. reset();
  6468. if (Melder_hasError (U"Script exited.")) {
  6469. throw;
  6470. } else {
  6471. Melder_throw (U"Formula not run.");
  6472. }
  6473. }
  6474. }
  6475. /* End of file Formula.cpp */