1 /* Interpreter.cpp
2  *
3  * Copyright (C) 1993-2021 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 
19 #include "Interpreter.h"
20 #include "praatP.h"
21 #include "praat_script.h"
22 #include "Formula.h"
23 #include "praat_version.h"
24 #include "../kar/UnicodeData.h"
25 
26 #include "../fon/Vector.h"
27 
28 #define Interpreter_WORD 1
29 
30 #define Interpreter_REAL 2
31 #define Interpreter_POSITIVE 3
32 #define Interpreter_INTEGER 4
33 #define Interpreter_NATURAL 5
34 #define Interpreter_BOOLEAN 6
35 #define Interpreter_MINIMUM_TYPE_FOR_NUMERIC_VARIABLE  Interpreter_REAL
36 #define Interpreter_MAXIMUM_TYPE_FOR_NUMERIC_VARIABLE  Interpreter_BOOLEAN
37 
38 #define Interpreter_SENTENCE 7
39 #define Interpreter_TEXT 8
40 
41 #define Interpreter_REALVECTOR 9
42 #define Interpreter_POSITIVEVECTOR 10
43 #define Interpreter_INTEGERVECTOR 11
44 #define Interpreter_NATURALVECTOR 12
45 #define Interpreter_MINIMUM_TYPE_FOR_NUMERIC_VECTOR_VARIABLE  Interpreter_REALVECTOR
46 #define Interpreter_MAXIMUM_TYPE_FOR_NUMERIC_VECTOR_VARIABLE  Interpreter_NATURALVECTOR
47 
48 #define Interpreter_REALMATRIX 19
49 #define Interpreter_CHOICE 20
50 #define Interpreter_OPTIONMENU 21
51 #define Interpreter_BUTTON 22
52 #define Interpreter_OPTION 23
53 #define Interpreter_COMMENT 24
54 
55 Thing_implement (InterpreterVariable, SimpleString, 0);
56 
InterpreterVariable_create(conststring32 key)57 static autoInterpreterVariable InterpreterVariable_create (conststring32 key) {
58 	try {
59 		if (key [0] == U'e' && key [1] == U'\0')
60 			Melder_throw (U"You cannot use 'e' as the name of a variable (e is the constant 2.71...).");
61 		if (key [0] == U'p' && key [1] == U'i' && key [2] == U'\0')
62 			Melder_throw (U"You cannot use 'pi' as the name of a variable (pi is the constant 3.14...).");
63 		if (key [0] == U'u' && key [1] == U'n' && key [2] == U'd' && key [3] == U'e' && key [4] == U'f' && key [5] == U'i' &&
64 			key [6] == U'n' && key [7] == U'e' && key [8] == U'd' && key [9] == U'\0')
65 			Melder_throw (U"You cannot use 'undefined' as the name of a variable.");
66 		autoInterpreterVariable me = Thing_new (InterpreterVariable);
67 		my string = Melder_dup (key);
68 		return me;
69 	} catch (MelderError) {
70 		Melder_throw (U"Interpreter variable not created.");
71 	}
72 }
73 
kInterpreter_ReturnType_errorMessage(kInterpreter_ReturnType returnType,conststring32 command)74 conststring32 kInterpreter_ReturnType_errorMessage (kInterpreter_ReturnType returnType, conststring32 command) {
75 	switch (returnType) {
76 		case kInterpreter_ReturnType::VOID_:
77 			return Melder_cat (U"The command \"", command, U"\" does not return anything");
78 		case kInterpreter_ReturnType::OBJECT_:
79 			return Melder_cat (U"The command \"", command, U"\" returns an object");
80 		case kInterpreter_ReturnType::REAL_:
81 		case kInterpreter_ReturnType::INTEGER_:
82 			return Melder_cat (U"The command \"", command, U"\" returns a number or a string");
83 		case kInterpreter_ReturnType::STRING_:
84 			return Melder_cat (U"The command \"", command, U"\" returns a string");
85 		case kInterpreter_ReturnType::REALVECTOR_:
86 		case kInterpreter_ReturnType::INTEGERVECTOR_:
87 			return Melder_cat (U"The command \"", command, U"\" returns a vector");
88 		case kInterpreter_ReturnType::REALMATRIX_:
89 			return Melder_cat (U"The command \"", command, U"\" returns a matrix");
90 		case kInterpreter_ReturnType::STRINGARRAY_:
91 			return Melder_cat (U"The command \"", command, U"\" returns a string array");
92 		default:
93 			return Melder_cat (U"The command \"", command, U"\" has an unknown return type");
94 	}
95 }
96 
97 Thing_implement (Interpreter, Thing, 0);
98 
Interpreter_create(conststring32 environmentName,ClassInfo editorClass)99 autoInterpreter Interpreter_create (conststring32 environmentName, ClassInfo editorClass) {
100 	try {
101 		autoInterpreter me = Thing_new (Interpreter);
102 		my variablesMap. max_load_factor (0.65f);
103 		my environmentName = Melder_dup (environmentName);
104 		my editorClass = editorClass;
105 		return me;
106 	} catch (MelderError) {
107 		Melder_throw (U"Interpreter not created.");
108 	}
109 }
110 
Interpreter_createFromEnvironment(Editor editor)111 autoInterpreter Interpreter_createFromEnvironment (Editor editor) {
112 	if (! editor)
113 		return Interpreter_create (nullptr, nullptr);
114 	return Interpreter_create (editor -> name.get(), editor -> classInfo);
115 }
116 
Melder_includeIncludeFiles(autostring32 * inout_text)117 void Melder_includeIncludeFiles (autostring32 *inout_text) {
118 	for (int depth = 0; ; depth ++) {
119 		char32 *head = inout_text->get();
120 		integer numberOfIncludes = 0;
121 		if (depth > 10)
122 			Melder_throw (U"Include files nested too deep. Probably cyclic.");
123 		for (;;) {
124 			char32 *includeLocation, *includeFileName, *tail;
125 			integer headLength, includeTextLength, newLength;
126 			/*
127 				Look for an include statement. If not found, we have finished.
128 			 */
129 			includeLocation = ( str32nequ (head, U"include ", 8) ? head : str32str (head, U"\ninclude ") );
130 			if (! includeLocation)
131 				break;
132 			if (includeLocation != head)
133 				includeLocation += 1;
134 			numberOfIncludes += 1;
135 			/*
136 				Separate out the head.
137 			 */
138 			*includeLocation = U'\0';
139 			/*
140 				Separate out the name of the include file.
141 			 */
142 			includeFileName = includeLocation + 8;
143 			while (Melder_isHorizontalSpace (*includeFileName)) includeFileName ++;
144 			tail = includeFileName;
145 			while (Melder_staysWithinLine (*tail)) tail ++;
146 			if (*tail != U'\0') {
147 				*tail = U'\0';
148 				tail += 1;
149 			}
150 			/*
151 				Get the contents of the include file.
152 			 */
153 			structMelderFile includeFile { };
154 			Melder_relativePathToFile (includeFileName, & includeFile);
155 			autostring32 includeText;
156 			try {
157 				includeText = MelderFile_readText (& includeFile);
158 			} catch (MelderError) {
159 				Melder_throw (U"Include file ", & includeFile, U" not read.");
160 			}
161 			/*
162 				Construct the new text.
163 			 */
164 			headLength = (head - inout_text->get()) + str32len (head);
165 			includeTextLength = str32len (includeText.get());
166 			newLength = headLength + includeTextLength + 1 + str32len (tail);
167 			autostring32 newText (newLength);
168 			str32cpy (newText.get(), inout_text->get());
169 			str32cpy (newText.get() + headLength, includeText.get());
170 			str32cpy (newText.get() + headLength + includeTextLength, U"\n");
171 			str32cpy (newText.get() + headLength + includeTextLength + 1, tail);
172 			/*
173 				Replace the old text with the new. This will work even within an autostring.
174 			 */
175 			*inout_text = newText.move();
176 			/*
177 				Cycle.
178 			 */
179 			head = inout_text->get() + headLength + includeTextLength + 1;
180 		}
181 		if (numberOfIncludes == 0) break;
182 	}
183 }
184 
Interpreter_readParameters(Interpreter me,mutablestring32 text)185 integer Interpreter_readParameters (Interpreter me, mutablestring32 text) {
186 	char32 *formLocation = nullptr;
187 	integer npar = 0;
188 	my dialogTitle [0] = U'\0';
189 	/*
190 		Look for a "form" line.
191 	*/
192 	{// scope
193 		char32 *p = & text [0];
194 		for (;;) {
195 			/*
196 				Invariant here: we are at the beginning of a line.
197 			*/
198 			Melder_skipHorizontalSpace (& p);
199 			if (str32nequ (p, U"form", 4) && Melder_isEndOfInk (p [4])) {
200 				formLocation = p;
201 				break;
202 			}
203 			Melder_skipToEndOfLine (& p);
204 			if (*p == U'\0')
205 				break;
206 			p ++;   // skip newline symbol
207 		}
208 	}
209 	/*
210 		If there is no "form" line, there are no parameters.
211 	*/
212 	if (formLocation) {
213 		char32 *dialogTitle = Melder_findEndOfHorizontalSpace (formLocation + 4);
214 		char32 *endOfLine = Melder_findEndOfLine (dialogTitle);
215 		if (*endOfLine == U'\0')
216 			Melder_throw (U"Unfinished form (only a \"form\" line).");
217 		*endOfLine = U'\0';   // destroy input temporarily in order to limit copying of dialog title
218 		str32ncpy (my dialogTitle, dialogTitle, Interpreter_MAX_DIALOG_TITLE_LENGTH);
219 		*endOfLine = U'\n';   // restore input
220 		my numberOfParameters = 0;
221 		while (true) {
222 			int type = 0;
223 			char32 *startOfLine = Melder_findEndOfHorizontalSpace (endOfLine + 1);
224 			/*
225 				Skip empty lines and lines with comments.
226 			*/
227 			while (*startOfLine == U'#' || *startOfLine == U';' || *startOfLine == U'!' || Melder_isEndOfLine (*startOfLine)) {
228 				endOfLine = Melder_findEndOfLine (startOfLine);
229 				if (Melder_isEndOfText (*endOfLine))
230 					Melder_throw (U"Unfinished form (missing \"endform\").");
231 				startOfLine = Melder_findEndOfHorizontalSpace (endOfLine + 1);
232 			}
233 			if (str32nequ (startOfLine, U"endform", 7) && Melder_isEndOfInk (startOfLine [7]))
234 				break;
235 			char32 *parameterLocation;
236 			if (str32nequ (startOfLine, U"word", 4) && Melder_isEndOfInk (startOfLine [4]))
237 				{ type = Interpreter_WORD; parameterLocation = startOfLine + 4; }
238 			else if (str32nequ (startOfLine, U"real", 4) && Melder_isEndOfInk (startOfLine [4]))
239 				{ type = Interpreter_REAL; parameterLocation = startOfLine + 4; }
240 			else if (str32nequ (startOfLine, U"positive", 8) && Melder_isEndOfInk (startOfLine [8]))
241 				{ type = Interpreter_POSITIVE; parameterLocation = startOfLine + 8; }
242 			else if (str32nequ (startOfLine, U"integer", 7) && Melder_isEndOfInk (startOfLine [7]))
243 				{ type = Interpreter_INTEGER; parameterLocation = startOfLine + 7; }
244 			else if (str32nequ (startOfLine, U"natural", 7) && Melder_isEndOfInk (startOfLine [7]))
245 				{ type = Interpreter_NATURAL; parameterLocation = startOfLine + 7; }
246 			else if (str32nequ (startOfLine, U"boolean", 7) && Melder_isEndOfInk (startOfLine [7]))
247 				{ type = Interpreter_BOOLEAN; parameterLocation = startOfLine + 7; }
248 			else if (str32nequ (startOfLine, U"sentence", 8) && Melder_isEndOfInk (startOfLine [8]))
249 				{ type = Interpreter_SENTENCE; parameterLocation = startOfLine + 8; }
250 			else if (str32nequ (startOfLine, U"text", 4) && Melder_isEndOfInk (startOfLine [4]))
251 				{ type = Interpreter_TEXT; parameterLocation = startOfLine + 4; }
252 			else if (str32nequ (startOfLine, U"realvector", 10) && Melder_isEndOfInk (startOfLine [10]))
253 				{ type = Interpreter_REALVECTOR; parameterLocation = startOfLine + 10; }
254 			else if (str32nequ (startOfLine, U"positivevector", 14) && Melder_isEndOfInk (startOfLine [14]))
255 				{ type = Interpreter_POSITIVEVECTOR; parameterLocation = startOfLine + 14; }
256 			else if (str32nequ (startOfLine, U"integervector", 13) && Melder_isEndOfInk (startOfLine [13]))
257 				{ type = Interpreter_INTEGERVECTOR; parameterLocation = startOfLine + 13; }
258 			else if (str32nequ (startOfLine, U"naturalvector", 13) && Melder_isEndOfInk (startOfLine [13]))
259 				{ type = Interpreter_NATURALVECTOR; parameterLocation = startOfLine + 13; }
260 			else if (str32nequ (startOfLine, U"realmatrix", 10) && Melder_isEndOfInk (startOfLine [10]))
261 				{ type = Interpreter_REALMATRIX; parameterLocation = startOfLine + 10; }
262 			else if (str32nequ (startOfLine, U"choice", 6) && Melder_isEndOfInk (startOfLine [6]))
263 				{ type = Interpreter_CHOICE; parameterLocation = startOfLine + 6; }
264 			else if (str32nequ (startOfLine, U"optionmenu", 10) && Melder_isEndOfInk (startOfLine [10]))
265 				{ type = Interpreter_OPTIONMENU; parameterLocation = startOfLine + 10; }
266 			else if (str32nequ (startOfLine, U"button", 6) && Melder_isEndOfInk (startOfLine [6]))
267 				{ type = Interpreter_BUTTON; parameterLocation = startOfLine + 6; }
268 			else if (str32nequ (startOfLine, U"option", 6) && Melder_isEndOfInk (startOfLine [6]))
269 				{ type = Interpreter_OPTION; parameterLocation = startOfLine + 6; }
270 			else if (str32nequ (startOfLine, U"comment", 7) && Melder_isEndOfInk (startOfLine [7]))
271 				{ type = Interpreter_COMMENT; parameterLocation = startOfLine + 7; }
272 			else {
273 				endOfLine = Melder_findEndOfLine (startOfLine);
274 				*endOfLine = U'\0';   // destroy input in order to limit printing of parameter type
275 				Melder_throw (U"Unknown parameter type:\n\"", startOfLine, U"\".");
276 			}
277 			/*
278 				Example:
279 					form Something
280 						real Time_(s) 3.14 (= pi)
281 						choice Colour 2
282 							button Red
283 							button Green
284 							button Blue
285 					endform
286 				my parameters [1] := "Time_(s)"
287 				my parameters [2] := "Colour"
288 				my parameters [3] := ""
289 				my parameters [4] := ""
290 				my parameters [5] := ""
291 				my arguments [1] := "3.14 (= pi)"
292 				my arguments [2] := "2"
293 				my arguments [3] := "Red"   (funny, but needed in Interpreter_getArgumentsFromString)
294 				my arguments [4] := "Green"
295 				my arguments [5] := "Blue"
296 			*/
297 			if (type <= Interpreter_OPTIONMENU) {
298 				Melder_skipHorizontalSpace (& parameterLocation);
299 				if (Melder_isEndOfLine (*parameterLocation)) {
300 					*parameterLocation = U'\0';   // destroy input in order to limit printing of line
301 					Melder_throw (U"Missing parameter:\n\"", startOfLine, U"\".");
302 				}
303 				char32 *q = my parameters [++ my numberOfParameters];
304 				while (Melder_staysWithinInk (*parameterLocation))
305 					* (q ++) = * (parameterLocation ++);
306 				*q = U'\0';
307 				npar ++;
308 			} else {
309 				my parameters [++ my numberOfParameters] [0] = U'\0';
310 			}
311 			char32 *argumentLocation;
312 			if (type >= Interpreter_MINIMUM_TYPE_FOR_NUMERIC_VECTOR_VARIABLE && type <= Interpreter_MAXIMUM_TYPE_FOR_NUMERIC_VECTOR_VARIABLE) {
313 				char32 *formatLocation = Melder_findEndOfHorizontalSpace (parameterLocation);
314 				if (Melder_isEndOfLine (*formatLocation)) {
315 					*formatLocation = U'\0';   // destroy input in order to limit printing of line
316 					Melder_throw (U"Missing format:\n\"", startOfLine, U"\".");
317 				}
318 				char32 *q = my formats [my numberOfParameters];
319 				if (*formatLocation != U'(') {
320 					*formatLocation = U'\0';   // destroy input in order to limit printing of line
321 					Melder_throw (U"Missing format (should start with \"(\"):\n\"", startOfLine, U"\".");
322 				}
323 				while (*formatLocation != U')') {
324 					if (Melder_isEndOfLine (*formatLocation)) {
325 						*formatLocation = U'\0';   // destroy input in order to limit printing of line
326 						Melder_throw (U"Incomplete format (should end in \")\"):\n\"", startOfLine, U"\".");
327 					}
328 					* (q ++) = * (formatLocation ++);
329 				}
330 				* (q ++) = * (formatLocation ++);   // copy the closing parenthesis
331 				*q = U'\0';
332 				argumentLocation = Melder_findEndOfHorizontalSpace (formatLocation);
333 			} else {
334 				argumentLocation = Melder_findEndOfHorizontalSpace (parameterLocation);
335 			}
336 			endOfLine = Melder_findEndOfLine (argumentLocation);
337 			if (Melder_isEndOfText (*endOfLine))
338 				Melder_throw (U"Unfinished form (missing \"endform\").");
339 			*endOfLine = U'\0';   // destroy input temporarily in order to limit copying of argument
340 			my arguments [my numberOfParameters] = Melder_dup_f (argumentLocation);
341 			*endOfLine = U'\n';   // restore input
342 			my types [my numberOfParameters] = type;
343 		}
344 	} else {
345 		npar = my numberOfParameters = 0;
346 	}
347 	return npar;
348 }
349 
Interpreter_createForm(Interpreter me,GuiWindow parent,conststring32 path,void (* okCallback)(UiForm,integer,Stackel,conststring32,Interpreter,conststring32,bool,void *),void * okClosure,bool selectionOnly)350 autoUiForm Interpreter_createForm (Interpreter me, GuiWindow parent, conststring32 path,
351 	void (*okCallback) (UiForm, integer, Stackel, conststring32, Interpreter, conststring32, bool, void *), void *okClosure,
352 	bool selectionOnly)
353 {
354 	autoUiForm form = UiForm_create (parent,
355 		Melder_cat (selectionOnly ? U"Run script (selection only): " : U"Run script: ", my dialogTitle),
356 		okCallback, okClosure, nullptr, nullptr);
357 	UiField radio = nullptr;
358 	if (path)
359 		form -> scriptFilePath = Melder_dup (path);
360 	for (int ipar = 1; ipar <= my numberOfParameters; ipar ++) {
361 		/*
362 			Convert underscores to spaces.
363 		*/
364 		char32 parameter [100], *p = & parameter [0];
365 		str32cpy (parameter, my parameters [ipar]);
366 		while (*p) {
367 			if (*p == U'_')
368 				*p = U' ';
369 			p ++;
370 		}
371 		switch (my types [ipar]) {
372 			case Interpreter_WORD: {
373 				UiForm_addWord (form.get(), nullptr, nullptr, parameter, my arguments [ipar].get());
374 			} break; case Interpreter_REAL: {
375 				UiForm_addReal (form.get(), nullptr, nullptr, parameter, my arguments [ipar].get());   // TODO: an address of a real variable
376 			} break; case Interpreter_POSITIVE: {
377 				UiForm_addPositive (form.get(), nullptr, nullptr, parameter, my arguments [ipar].get());
378 			} break; case Interpreter_INTEGER: {
379 				UiForm_addInteger (form.get(), nullptr, nullptr, parameter, my arguments [ipar].get());
380 			} break; case Interpreter_NATURAL: {
381 				UiForm_addNatural (form.get(), nullptr, nullptr, parameter, my arguments [ipar].get());
382 			} break; case Interpreter_BOOLEAN: {
383 				UiForm_addBoolean (form.get(), nullptr, nullptr, parameter, my arguments [ipar] [0] == U'1' ||
384 					my arguments [ipar] [0] == U'y' || my arguments [ipar] [0] == U'Y' ||
385 					(my arguments [ipar] [0] == U'o' && my arguments [ipar] [1] == U'n'));
386 			} break; case Interpreter_SENTENCE: {
387 				UiForm_addSentence (form.get(), nullptr, nullptr, parameter, my arguments [ipar].get());
388 			} break; case Interpreter_TEXT: {
389 				UiForm_addText (form.get(), nullptr, nullptr, parameter, my arguments [ipar].get());
390 			} break; case Interpreter_REALVECTOR: {
391 				kUi_realVectorFormat format = kUi_realVectorFormat_getValue (my formats [ipar]);
392 				if (format == kUi_realVectorFormat::UNDEFINED)
393 					Melder_throw (U"Undefined real vector format \"", my formats [ipar], U"\".");
394 				UiForm_addRealVector (form.get(), nullptr, nullptr, parameter, format, my arguments [ipar].get());
395 			} break; case Interpreter_POSITIVEVECTOR: {
396 				kUi_realVectorFormat format = kUi_realVectorFormat_getValue (my formats [ipar]);
397 				if (format == kUi_realVectorFormat::UNDEFINED)
398 					Melder_throw (U"Undefined positive vector format \"", my formats [ipar], U"\".");
399 				UiForm_addPositiveVector (form.get(), nullptr, nullptr, parameter, format, my arguments [ipar].get());
400 			} break; case Interpreter_INTEGERVECTOR: {
401 				kUi_integerVectorFormat format = kUi_integerVectorFormat_getValue (my formats [ipar]);
402 				if (format == kUi_integerVectorFormat::UNDEFINED)
403 					Melder_throw (U"Undefined integer vector format \"", my formats [ipar], U"\".");
404 				UiForm_addIntegerVector (form.get(), nullptr, nullptr, parameter, format, my arguments [ipar].get());
405 			} break; case Interpreter_NATURALVECTOR: {
406 				kUi_integerVectorFormat format = kUi_integerVectorFormat_getValue (my formats [ipar]);
407 				if (format == kUi_integerVectorFormat::UNDEFINED)
408 					Melder_throw (U"Undefined natural vector format \"", my formats [ipar], U"\".");
409 				UiForm_addNaturalVector (form.get(), nullptr, nullptr, parameter, kUi_integerVectorFormat_getValue (my formats [ipar]), my arguments [ipar].get());
410 			// } break; case Interpreter_REALMATRIX: {
411 			//	UiForm_addRealMatrix (form.get(), nullptr, nullptr, parameter, my arguments [ipar].get());
412 			} break; case Interpreter_CHOICE: {
413 				radio = UiForm_addRadio (form.get(), nullptr, nullptr, nullptr, parameter, (int) Melder_atoi (my arguments [ipar].get()), 1);
414 			} break; case Interpreter_OPTIONMENU: {
415 				radio = UiForm_addOptionMenu (form.get(), nullptr, nullptr, nullptr, parameter, (int) Melder_atoi (my arguments [ipar].get()), 1);
416 			} break; case Interpreter_BUTTON: {
417 				if (radio)
418 					UiRadio_addButton (radio, my arguments [ipar].get());
419 			} break; case Interpreter_OPTION: {
420 				if (radio)
421 					UiOptionMenu_addButton (radio, my arguments [ipar].get());
422 			} break; case Interpreter_COMMENT: {
423 				UiForm_addLabel (form.get(), nullptr, my arguments [ipar].get());
424 			} break; default: {
425 				UiForm_addWord (form.get(), nullptr, nullptr, parameter, my arguments [ipar].get());
426 			}
427 		}
428 		/*
429 			Strip parentheses and colon off parameter name.
430 		*/
431 		if ((p = str32chr (my parameters [ipar], U'(')) != nullptr) {
432 			*p = U'\0';
433 			if (p - my parameters [ipar] > 0 && p [-1] == U'_')
434 				p [-1] = U'\0';
435 		}
436 		p = my parameters [ipar];
437 		if (*p != U'\0' && p [str32len (p) - 1] == U':')
438 			p [str32len (p) - 1] = U'\0';
439 	}
440 	UiForm_finish (form.get());
441 	return form;
442 }
443 
Interpreter_getArgumentsFromDialog(Interpreter me,UiForm dialog)444 void Interpreter_getArgumentsFromDialog (Interpreter me, UiForm dialog) {
445 	for (int ipar = 1; ipar <= my numberOfParameters; ipar ++) {
446 		char32 parameter [100], *p;
447 		/*
448 			Strip parentheses and colon off parameter name.
449 		*/
450 		if ((p = str32chr (my parameters [ipar], U'(')) != nullptr) {
451 			*p = U'\0';
452 			if (p - my parameters [ipar] > 0 && p [-1] == U'_')
453 				p [-1] = U'\0';
454 		}
455 		p = my parameters [ipar];
456 		if (*p != U'\0' && p [str32len (p) - 1] == U':')
457 			p [str32len (p) - 1] = U'\0';
458 		/*
459 			Convert underscores to spaces.
460 		*/
461 		str32cpy (parameter, my parameters [ipar]);
462 		p = & parameter [0];
463 		while (*p) {
464 			if (*p == U'_')
465 				*p = U' ';
466 			p ++;
467 		}
468 		switch (my types [ipar]) {
469 			case Interpreter_REAL:
470 			case Interpreter_POSITIVE: {
471 				const double value = UiForm_getReal_check (dialog, parameter);
472 				my arguments [ipar] = autostring32 (40, true);
473 				Melder_sprint (my arguments [ipar].get(),40+1, value);
474 				break;
475 			}
476 			case Interpreter_INTEGER:
477 			case Interpreter_NATURAL:
478 			case Interpreter_BOOLEAN: {
479 				const integer value = UiForm_getInteger (dialog, parameter);
480 				my arguments [ipar] = autostring32 (40, true);
481 				Melder_sprint (my arguments [ipar].get(),40+1, value);
482 				break;
483 			}
484 			case Interpreter_CHOICE:
485 			case Interpreter_OPTIONMENU: {
486 				const integer integerValue = UiForm_getInteger (dialog, parameter);
487 				const conststring32 stringValue = UiForm_getString (dialog, parameter);
488 				my arguments [ipar] = autostring32 (40, true);
489 				Melder_sprint (my arguments [ipar].get(),40+1, integerValue);
490 				Melder_sprint (my choiceArguments [ipar],100, stringValue);
491 				break;
492 			}
493 			case Interpreter_REALVECTOR:
494 			case Interpreter_POSITIVEVECTOR:
495 			{
496 				const VEC realVectorValue = UiForm_getRealVector (dialog, parameter);
497 				autoMelderString buffer;
498 				for (integer i = 1; i <= realVectorValue.size; i ++) {
499 					MelderString_append (& buffer, realVectorValue [i]);
500 					if (i < realVectorValue.size)
501 						MelderString_appendCharacter (& buffer, U' ');
502 				}
503 				my arguments [ipar] = Melder_dup (buffer.string);
504 				break;
505 			}
506 			case Interpreter_INTEGERVECTOR:
507 			case Interpreter_NATURALVECTOR:
508 			{
509 				const INTVEC integerVectorValue = UiForm_getIntegerVector (dialog, parameter);
510 				autoMelderString buffer;
511 				for (integer i = 1; i <= integerVectorValue.size; i ++) {
512 					MelderString_append (& buffer, integerVectorValue [i]);
513 					if (i < integerVectorValue.size)
514 						MelderString_appendCharacter (& buffer, U' ');
515 				}
516 				my arguments [ipar] = Melder_dup (buffer.string);
517 				break;
518 			}
519 			case Interpreter_BUTTON:
520 			case Interpreter_OPTION:
521 			case Interpreter_COMMENT:
522 				break;
523 			default: {
524 				const conststring32 value = UiForm_getString (dialog, parameter);
525 				my arguments [ipar] = Melder_dup_f (value);
526 				break;
527 			}
528 		}
529 	}
530 }
531 
Interpreter_getArgumentsFromString(Interpreter me,conststring32 arguments)532 void Interpreter_getArgumentsFromString (Interpreter me, conststring32 arguments) {
533 	int size = my numberOfParameters;
534 	integer length = str32len (arguments);
535 	while (size >= 1 && my parameters [size] [0] == U'\0')
536 		size --;   /* Ignore fields without a variable name (button, comment). */
537 	for (int ipar = 1; ipar <= size; ipar ++) {
538 		char32 *p = my parameters [ipar];
539 		/*
540 			Ignore buttons and comments again.
541 		*/
542 		if (! *p)
543 			continue;
544 		/*
545 			Strip parentheses and colon off parameter name.
546 		*/
547 		if ((p = str32chr (p, U'(')) != nullptr) {
548 			*p = U'\0';
549 			if (p - my parameters [ipar] > 0 && p [-1] == U'_')
550 				p [-1] = U'\0';
551 		}
552 		p = my parameters [ipar];
553 		if (*p != U'\0' && p [str32len (p) - 1] == U':')
554 			p [str32len (p) - 1] = U'\0';
555 	}
556 	for (int ipar = 1; ipar < size; ipar ++) {
557 		int ichar = 0;
558 		/*
559 			Ignore buttons and comments again. The buttons will keep their labels as "arguments".
560 		*/
561 		if (my parameters [ipar] [0] == U'\0') continue;
562 		/*
563 			Erase the current values, probably the default values,
564 			and replace with the actual arguments.
565 		*/
566 		my arguments [ipar] = autostring32 (length);
567 		/*
568 			Skip spaces until next argument.
569 		*/
570 		while (Melder_isHorizontalSpace (*arguments))
571 			arguments ++;
572 		/*
573 			The argument is everything up to the next space, or, if it starts with a double quote,
574 			everything between this quote and the matching double quote;
575 			in this case, the argument can represent a double quote by a sequence of two double quotes.
576 			Example: the string
577 				"I said ""hello"""
578 			will be passed to the dialog as a single argument containing the text
579 				I said "hello"
580 		*/
581 		if (*arguments == U'\"') {
582 			arguments ++;   // do not include leading double quote
583 			for (;;) {
584 				if (*arguments == U'\0')
585 					Melder_throw (U"Missing matching quote.");
586 				if (*arguments == U'\"' && * ++ arguments != U'\"')
587 					break;   // remember second quote
588 				my arguments [ipar] [ichar ++] = *arguments ++;
589 			}
590 		} else {
591 			while (Melder_staysWithinInk (*arguments))
592 				my arguments [ipar] [ichar ++] = *arguments ++;
593 		}
594 		my arguments [ipar] [ichar] = U'\0';   // trailing null byte
595 	}
596 	/*
597 		The last item is handled separately, because it consists of the rest of the line.
598 		Leading spaces are skipped, but trailing spaces are included.
599 	*/
600 	if (size > 0) {
601 		while (Melder_isHorizontalSpace (*arguments))
602 			arguments ++;
603 		my arguments [size] = Melder_dup_f (arguments);
604 	}
605 	/*
606 		Convert booleans and choices to numbers.
607 	*/
608 	for (int ipar = 1; ipar <= size; ipar ++) {
609 		if (my types [ipar] == Interpreter_BOOLEAN) {
610 			mutablestring32 arg = & my arguments [ipar] [0];
611 			if (str32equ (arg, U"1") || str32equ (arg, U"yes") || str32equ (arg, U"on") ||
612 			    str32equ (arg, U"Yes") || str32equ (arg, U"On") || str32equ (arg, U"YES") || str32equ (arg, U"ON"))
613 			{
614 				str32cpy (arg, U"1");
615 			} else if (str32equ (arg, U"0") || str32equ (arg, U"no") || str32equ (arg, U"off") ||
616 			    str32equ (arg, U"No") || str32equ (arg, U"Off") || str32equ (arg, U"NO") || str32equ (arg, U"OFF"))
617 			{
618 				str32cpy (arg, U"0");
619 			} else {
620 				Melder_throw (U"Unknown value \"", arg, U"\" for boolean \"", my parameters [ipar], U"\".");
621 			}
622 		} else if (my types [ipar] == Interpreter_CHOICE) {
623 			int jpar;
624 			mutablestring32 arg = & my arguments [ipar] [0];
625 			for (jpar = ipar + 1; jpar <= my numberOfParameters; jpar ++) {
626 				if (my types [jpar] != Interpreter_BUTTON && my types [jpar] != Interpreter_OPTION)
627 					Melder_throw (U"Unknown value \"", arg, U"\" for choice \"", my parameters [ipar], U"\".");
628 				if (str32equ (my arguments [jpar].get(), arg)) {   // the button labels are in the arguments; see Interpreter_readParameters
629 					str32cpy (arg, Melder_integer (jpar - ipar));
630 					str32cpy (my choiceArguments [ipar], my arguments [jpar].get());
631 					break;
632 				}
633 			}
634 			if (jpar > my numberOfParameters)
635 				Melder_throw (U"Unknown value \"", arg, U"\" for choice \"", my parameters [ipar], U"\".");
636 		} else if (my types [ipar] == Interpreter_OPTIONMENU) {
637 			int jpar;
638 			mutablestring32 arg = & my arguments [ipar] [0];
639 			for (jpar = ipar + 1; jpar <= my numberOfParameters; jpar ++) {
640 				if (my types [jpar] != Interpreter_OPTION && my types [jpar] != Interpreter_BUTTON)
641 					Melder_throw (U"Unknown value \"", arg, U"\" for option menu \"", my parameters [ipar], U"\".");
642 				if (str32equ (my arguments [jpar].get(), arg)) {
643 					str32cpy (arg, Melder_integer (jpar - ipar));
644 					str32cpy (my choiceArguments [ipar], my arguments [jpar].get());
645 					break;
646 				}
647 			}
648 			if (jpar > my numberOfParameters)
649 				Melder_throw (U"Unknown value \"", arg, U"\" for option menu \"", my parameters [ipar], U"\".");
650 		}
651 	}
652 }
653 
Interpreter_getArgumentsFromArgs(Interpreter me,integer narg,Stackel args)654 void Interpreter_getArgumentsFromArgs (Interpreter me, integer narg, Stackel args) {
655 	trace (narg, U" arguments");
656 	integer size = my numberOfParameters;
657 	while (size >= 1 && my parameters [size] [0] == U'\0')
658 		size --;   // ignore trailing fields without a variable name (button, comment)
659 	for (integer ipar = 1; ipar <= size; ipar ++) {
660 		mutablestring32 p = my parameters [ipar];
661 		/*
662 			Ignore buttons and comments again.
663 		*/
664 		if (! *p)
665 			continue;
666 		/*
667 			Strip parentheses and colon off parameter name.
668 		*/
669 		if ((p = str32chr (p, U'(')) != nullptr) {
670 			*p = U'\0';
671 			if (p - my parameters [ipar] > 0 && p [-1] == U'_')
672 				p [-1] = U'\0';
673 		}
674 		p = my parameters [ipar];
675 		if (*p != U'\0' && p [str32len (p) - 1] == U':')
676 			p [str32len (p) - 1] = U'\0';
677 	}
678 	integer iarg = 0;
679 	for (integer ipar = 1; ipar <= size; ipar ++) {
680 		/*
681 			Ignore buttons and comments again. The buttons will keep their labels as "arguments".
682 		*/
683 		if (my parameters [ipar] [0] == U'\0')
684 			continue;
685 		/*
686 			Erase the current values, probably the default values...
687 		*/
688 		my arguments [ipar]. reset();   //
689 		if (iarg == narg)
690 			Melder_throw (U"Found ", narg, U" arguments but expected more.");
691 		Stackel arg = & args [++ iarg];
692 		/*
693 			... and replace with the actual arguments.
694 		*/
695 		my arguments [ipar] =
696 			arg -> which == Stackel_NUMBER ? Melder_dup (Melder_double (arg -> number)) :
697 			arg -> which == Stackel_STRING ? Melder_dup (arg -> getString()) :
698 			arg -> which == Stackel_NUMERIC_VECTOR ? Melder_dup (Melder_VEC (arg -> numericVector)) :
699 			autostring32();
700 		Melder_assert (my arguments [ipar]);
701 	}
702 	if (iarg < narg)
703 		Melder_throw (U"Found ", narg, U" arguments but expected only ", iarg, U".");
704 	/*
705 		Convert booleans and choices to numbers.
706 	*/
707 	for (integer ipar = 1; ipar <= size; ipar ++) {
708 		if (my types [ipar] == Interpreter_BOOLEAN) {
709 			mutablestring32 arg = & my arguments [ipar] [0];
710 			if (str32equ (arg, U"1") || str32equ (arg, U"yes") || str32equ (arg, U"on") ||
711 			    str32equ (arg, U"Yes") || str32equ (arg, U"On") || str32equ (arg, U"YES") || str32equ (arg, U"ON"))
712 			{
713 				str32cpy (arg, U"1");
714 			} else if (str32equ (arg, U"0") || str32equ (arg, U"no") || str32equ (arg, U"off") ||
715 			    str32equ (arg, U"No") || str32equ (arg, U"Off") || str32equ (arg, U"NO") || str32equ (arg, U"OFF"))
716 			{
717 				str32cpy (arg, U"0");
718 			} else {
719 				Melder_throw (U"Unknown value \"", arg, U"\" for boolean \"", my parameters [ipar], U"\".");
720 			}
721 		} else if (my types [ipar] == Interpreter_CHOICE) {
722 			integer jpar;
723 			mutablestring32 arg = & my arguments [ipar] [0];
724 			for (jpar = ipar + 1; jpar <= my numberOfParameters; jpar ++) {
725 				if (my types [jpar] != Interpreter_BUTTON && my types [jpar] != Interpreter_OPTION)
726 					Melder_throw (U"Unknown value \"", arg, U"\" for choice \"", my parameters [ipar], U"\".");
727 				if (str32equ (my arguments [jpar].get(), arg)) {   // the button labels are in the arguments; see Interpreter_readParameters
728 					str32cpy (arg, Melder_integer (jpar - ipar));
729 					str32cpy (my choiceArguments [ipar], my arguments [jpar].get());
730 					break;
731 				}
732 			}
733 			if (jpar > my numberOfParameters)
734 				Melder_throw (U"Unknown value \"", arg, U"\" for choice \"", my parameters [ipar], U"\".");
735 		} else if (my types [ipar] == Interpreter_OPTIONMENU) {
736 			integer jpar;
737 			mutablestring32 arg = & my arguments [ipar] [0];
738 			for (jpar = ipar + 1; jpar <= my numberOfParameters; jpar ++) {
739 				if (my types [jpar] != Interpreter_OPTION && my types [jpar] != Interpreter_BUTTON)
740 					Melder_throw (U"Unknown value \"", arg, U"\" for option menu \"", my parameters [ipar], U"\".");
741 				if (str32equ (my arguments [jpar].get(), arg)) {
742 					str32cpy (arg, Melder_integer (jpar - ipar));
743 					str32cpy (my choiceArguments [ipar], my arguments [jpar].get());
744 					break;
745 				}
746 			}
747 			if (jpar > my numberOfParameters)
748 				Melder_throw (U"Unknown value \"", arg, U"\" for option menu \"", my parameters [ipar], U"\".");
749 		}
750 	}
751 }
752 
Interpreter_addNumericVariable(Interpreter me,conststring32 key,double value)753 static void Interpreter_addNumericVariable (Interpreter me, conststring32 key, double value) {
754 	autoInterpreterVariable variable = InterpreterVariable_create (key);
755 	variable -> numericValue = value;
756 	my variablesMap [key] = variable.move();
757 	variable.releaseToAmbiguousOwner();
758 }
759 
Interpreter_addStringVariable(Interpreter me,conststring32 key,conststring32 value)760 static void Interpreter_addStringVariable (Interpreter me, conststring32 key, conststring32 value) {
761 	autoInterpreterVariable variable = InterpreterVariable_create (key);
762 	variable -> stringValue = Melder_dup (value);
763 	my variablesMap [key] = variable.move();
764 	variable.releaseToAmbiguousOwner();
765 }
766 
Interpreter_addNumericVectorVariable(Interpreter me,conststring32 key,conststring32 value)767 static void Interpreter_addNumericVectorVariable (Interpreter me, conststring32 key, conststring32 value) {
768 	autoInterpreterVariable variable = InterpreterVariable_create (key);
769 	variable -> numericVectorValue = splitByWhitespace_VEC (value);
770 	my variablesMap [key] = variable.move();
771 	variable.releaseToAmbiguousOwner();
772 }
773 
Interpreter_hasVariable(Interpreter me,conststring32 key)774 InterpreterVariable Interpreter_hasVariable (Interpreter me, conststring32 key) {
775 	Melder_assert (key);
776 	auto it = my variablesMap. find (key [0] == U'.' ? Melder_cat (my procedureNames [my callDepth], key) : key);
777 	if (it != my variablesMap.end())
778 		return it -> second.get();
779 	else
780 		return nullptr;
781 }
782 
Interpreter_lookUpVariable(Interpreter me,conststring32 key)783 InterpreterVariable Interpreter_lookUpVariable (Interpreter me, conststring32 key) {
784 	Melder_assert (key);
785 	conststring32 variableNameIncludingProcedureName =
786 		key [0] == U'.' ? Melder_cat (my procedureNames [my callDepth], key) : key;
787 	auto it = my variablesMap. find (variableNameIncludingProcedureName);
788 	if (it != my variablesMap.end())
789 		return it -> second.get();
790 	/*
791 		The variable doesn't yet exist: create a new one.
792 	*/
793 	autoInterpreterVariable variable = InterpreterVariable_create (variableNameIncludingProcedureName);
794 	InterpreterVariable variable_ref = variable.get();
795 	my variablesMap [variableNameIncludingProcedureName] = variable.move();
796 	return variable_ref;
797 }
798 
lookupLabel(Interpreter me,conststring32 labelName)799 static integer lookupLabel (Interpreter me, conststring32 labelName) {
800 	for (integer ilabel = 1; ilabel <= my numberOfLabels; ilabel ++)
801 		if (str32equ (labelName, my labelNames [ilabel]))
802 			return ilabel;
803 	Melder_throw (U"Unknown label \"", labelName, U"\".");
804 }
805 
isCommand(conststring32 string)806 static bool isCommand (conststring32 string) {
807 	const char32 *p = & string [0];
808 	/*
809 		Things that start with "nowarn", "noprogress", or "nocheck" are commands.
810 	*/
811 	if (p [0] == U'n' && p [1] == U'o' &&
812 			(str32nequ (p + 2, U"warn ", 5) || str32nequ (p + 2, U"progress ", 9) || str32nequ (p + 2, U"check ", 6)))
813 		return true;
814 	if (str32nequ (p, U"demo ", 5))
815 		return true;
816 	/*
817 		Otherwise, things that start with nonupper case are formulas.
818 	*/
819 	if (! Melder_isUpperCaseLetter (*p))
820 		return false;
821 	/*
822 		The remaining possibility is things that start with upper case.
823 		If they contain an underscore, they are object names, hence we must have a formula.
824 		Otherwise, we have a command.
825 	*/
826 	while (Melder_isAlphanumeric (*p))
827 		p ++;
828 	return *p != U'_';
829 }
830 
parameterToVariable(Interpreter me,int type,conststring32 in_parameter,int ipar)831 static void parameterToVariable (Interpreter me, int type, conststring32 in_parameter, int ipar) {
832 	char32 parameter [200];
833 	Melder_assert (type != 0);
834 	str32cpy (parameter, in_parameter);
835 	if (type >= Interpreter_MINIMUM_TYPE_FOR_NUMERIC_VARIABLE && type <= Interpreter_MAXIMUM_TYPE_FOR_NUMERIC_VARIABLE) {
836 		Interpreter_addNumericVariable (me, parameter, Melder_atof (my arguments [ipar].get()));
837 	} else if (type == Interpreter_CHOICE || type == Interpreter_OPTIONMENU) {
838 		Interpreter_addNumericVariable (me, parameter, Melder_atof (my arguments [ipar].get()));
839 		str32cat (parameter, U"$");
840 		Interpreter_addStringVariable (me, parameter, my choiceArguments [ipar]);
841 	} else if (type == Interpreter_BUTTON || type == Interpreter_OPTION || type == Interpreter_COMMENT) {
842 		;   // do not add a variable
843 	} else if (type >= Interpreter_MINIMUM_TYPE_FOR_NUMERIC_VECTOR_VARIABLE && type <= Interpreter_MAXIMUM_TYPE_FOR_NUMERIC_VECTOR_VARIABLE) {
844 		str32cat (parameter, U"#");
845 		Interpreter_addNumericVectorVariable (me, parameter, my arguments [ipar].get());
846 	} else {
847 		str32cat (parameter, U"$");
848 		Interpreter_addStringVariable (me, parameter, my arguments [ipar].get());
849 	}
850 }
851 
NumericVectorVariable_move(InterpreterVariable variable,VEC movedVector,bool rightHandSideOwned)852 inline static void NumericVectorVariable_move (InterpreterVariable variable, VEC movedVector, bool rightHandSideOwned) {
853 	if (rightHandSideOwned) {
854 		/*
855 			Statement like: a# = b# + c#
856 		*/
857 		variable -> numericVectorValue. adoptFromAmbiguousOwner (movedVector);
858 	} else if (variable -> numericVectorValue.size == movedVector.size) {
859 		if (variable -> numericVectorValue.cells == movedVector.cells) {
860 			/*
861 				Statement like: a# = a#
862 			*/
863 			(void) 0;   // assigning a variable to itself: do nothing
864 		} else {
865 			/*
866 				Statement like: a# = b#   // with matching sizes
867 			*/
868 			variable -> numericVectorValue.all()  <<=  movedVector;
869 		}
870 	} else {
871 		/*
872 			Statement like: a# = b#   // with non-matching sizes
873 		*/
874 		variable -> numericVectorValue = copy_VEC (movedVector);
875 	}
876 }
877 
StringArrayVariable_move(InterpreterVariable variable,STRVEC movedVector,bool rightHandSideOwned)878 inline static void StringArrayVariable_move (InterpreterVariable variable, STRVEC movedVector, bool rightHandSideOwned) {
879 	if (rightHandSideOwned) {
880 		/*
881 			Statement like: a$# = b$# + c$#
882 		*/
883 		variable -> stringArrayValue. adoptFromAmbiguousOwner (movedVector);
884 	} else if (variable -> stringArrayValue.size == movedVector.size) {
885 		if ((char32 **) variable -> stringArrayValue.elements == movedVector.elements) {
886 			/*
887 				Statement like: a$# = a$#
888 			*/
889 			(void) 0;   // assigning a variable to itself: do nothing
890 		} else {
891 			/*
892 				Statement like: a$# = b$#   // with matching sizes
893 			*/
894 			variable -> stringArrayValue.all()  <<=  movedVector;
895 		}
896 	} else {
897 		/*
898 			Statement like: a$# = b$#   // with non-matching sizes
899 		*/
900 		variable -> stringArrayValue = copy_STRVEC (movedVector);
901 	}
902 }
903 
NumericMatrixVariable_move(InterpreterVariable variable,MAT movedMatrix,bool rightHandSideOwned)904 inline static void NumericMatrixVariable_move (InterpreterVariable variable, MAT movedMatrix, bool rightHandSideOwned) {
905 	if (rightHandSideOwned) {
906 		/*
907 			Statement like: a## = b## + c##
908 		*/
909 		variable -> numericMatrixValue. adoptFromAmbiguousOwner (movedMatrix);
910 	} else if (variable -> numericMatrixValue.nrow == movedMatrix.nrow && variable -> numericMatrixValue.ncol == movedMatrix.ncol) {
911 		if (variable -> numericMatrixValue.cells == movedMatrix.cells) {
912 			/*
913 				Statement like: a## = a##
914 			*/
915 			(void) 0;   // assigning a variable to itself: do nothing
916 		} else {
917 			/*
918 				Statement like: a## = b##   // with matching sizes
919 			*/
920 			variable -> numericMatrixValue.all()  <<=  movedMatrix;
921 		}
922 	} else {
923 		/*
924 			Statement like: a## = b##   // with non-matching sizes
925 		*/
926 		variable -> numericMatrixValue = copy_MAT (movedMatrix);
927 	}
928 }
929 
NumericVectorVariable_add(InterpreterVariable variable,double scalar)930 inline static void NumericVectorVariable_add (InterpreterVariable variable, double scalar) {
931 	variable -> numericVectorValue.all()  +=  scalar;
932 }
NumericVectorVariable_add(InterpreterVariable variable,constVEC vector)933 inline static void NumericVectorVariable_add (InterpreterVariable variable, constVEC vector) {
934 	VEC const& variableVector = variable -> numericVectorValue.get();
935 	Melder_require (vector.size == variableVector.size,
936 		U"You cannot add a vector with size ", vector.size,
937 		U" to a vector with a different size (", variableVector.size, U")."
938 	);
939 	variableVector  +=  vector;
940 }
NumericVectorVariable_subtract(InterpreterVariable variable,double scalar)941 inline static void NumericVectorVariable_subtract (InterpreterVariable variable, double scalar) {
942 	variable -> numericVectorValue.all()  -=  scalar;
943 }
NumericVectorVariable_subtract(InterpreterVariable variable,constVEC vector)944 inline static void NumericVectorVariable_subtract (InterpreterVariable variable, constVEC vector) {
945 	VEC const& variableVector = variable -> numericVectorValue.get();
946 	Melder_require (vector.size == variable -> numericVectorValue.size,
947 		U"You cannot subtract a vector with size ", vector.size,
948 		U" from a vector with a different size (", variableVector.size, U")."
949 	);
950 	variableVector  -=  vector;
951 }
NumericVectorVariable_multiply(InterpreterVariable variable,double scalar)952 inline static void NumericVectorVariable_multiply (InterpreterVariable variable, double scalar) {
953 	variable -> numericVectorValue.all()  *=  scalar;
954 }
NumericVectorVariable_multiply(InterpreterVariable variable,constVEC vector)955 inline static void NumericVectorVariable_multiply (InterpreterVariable variable, constVEC vector) {
956 	VEC const& variableVector = variable -> numericVectorValue.get();
957 	Melder_require (vector.size != variableVector.size,
958 		U"You cannot multiply a vector with size ", variableVector.size,
959 		U" with a vector with a different size (", vector.size, U")."
960 	);
961 	variableVector  *=  vector;
962 }
NumericVectorVariable_divide(InterpreterVariable variable,double scalar)963 inline static void NumericVectorVariable_divide (InterpreterVariable variable, double scalar) {
964 	variable -> numericVectorValue.all()  /=  scalar;
965 }
NumericVectorVariable_divide(InterpreterVariable variable,constVEC vector)966 inline static void NumericVectorVariable_divide (InterpreterVariable variable, constVEC vector) {
967 	VEC const& variableVector = variable -> numericVectorValue.get();
968 	Melder_require (vector.size != variableVector.size,
969 		U"You cannot divide a vector with size ", variableVector.size,
970 		U" by a vector with a different size (", vector.size, U")."
971 	);
972 	variableVector  /=  vector;
973 }
NumericMatrixVariable_add(InterpreterVariable variable,double scalar)974 inline static void NumericMatrixVariable_add (InterpreterVariable variable, double scalar) {
975 	MAT variableMatrix = variable -> numericMatrixValue.get();
976 	for (integer irow = 1; irow <= variableMatrix.nrow; irow ++)
977 		for (integer icol = 1; icol <= variableMatrix.ncol; icol ++)
978 			variableMatrix [irow] [icol] += scalar;
979 }
NumericMatrixVariable_add(InterpreterVariable variable,constMAT matrix)980 inline static void NumericMatrixVariable_add (InterpreterVariable variable, constMAT matrix) {
981 	MAT variableMatrix = variable -> numericMatrixValue.get();
982 	if (matrix.nrow != variableMatrix.nrow || matrix.ncol != variableMatrix.ncol)
983 		Melder_throw (U"You cannot add a matrix with size ", matrix.nrow, U"x", matrix.ncol,
984 		              U" to a matrix with a different size (", variableMatrix.nrow, U"x", variableMatrix.ncol, U").");
985 	for (integer irow = 1; irow <= variableMatrix.nrow; irow ++)
986 		for (integer icol = 1; icol <= variableMatrix.ncol; icol ++)
987 			variableMatrix [irow] [icol] += matrix [irow] [icol];
988 }
NumericMatrixVariable_subtract(InterpreterVariable variable,double scalar)989 inline static void NumericMatrixVariable_subtract (InterpreterVariable variable, double scalar) {
990 	MAT variableMatrix = variable -> numericMatrixValue.get();
991 	for (integer irow = 1; irow <= variableMatrix.nrow; irow ++)
992 		for (integer icol = 1; icol <= variableMatrix.ncol; icol ++)
993 			variableMatrix [irow] [icol] -= scalar;
994 }
NumericMatrixVariable_subtract(InterpreterVariable variable,constMAT matrix)995 inline static void NumericMatrixVariable_subtract (InterpreterVariable variable, constMAT matrix) {
996 	MAT variableMatrix = variable -> numericMatrixValue.get();
997 	if (matrix.nrow != variableMatrix.nrow || matrix.ncol != variableMatrix.ncol)
998 		Melder_throw (U"You cannot subtract a matrix with size ", matrix.nrow, U"x", matrix.ncol,
999 		              U" from a matrix with a different size (", variableMatrix.nrow, U"x", variableMatrix.ncol, U").");
1000 	for (integer irow = 1; irow <= variableMatrix.nrow; irow ++)
1001 		for (integer icol = 1; icol <= variableMatrix.ncol; icol ++)
1002 			variableMatrix [irow] [icol] -= matrix [irow] [icol];
1003 }
NumericMatrixVariable_multiply(InterpreterVariable variable,double scalar)1004 inline static void NumericMatrixVariable_multiply (InterpreterVariable variable, double scalar) {
1005 	MAT variableMatrix = variable -> numericMatrixValue.get();
1006 	for (integer irow = 1; irow <= variableMatrix.nrow; irow ++)
1007 		for (integer icol = 1; icol <= variableMatrix.ncol; icol ++)
1008 			variableMatrix [irow] [icol] *= scalar;
1009 }
NumericMatrixVariable_multiply(InterpreterVariable variable,constMAT matrix)1010 inline static void NumericMatrixVariable_multiply (InterpreterVariable variable, constMAT matrix) {
1011 	MAT variableMatrix = variable -> numericMatrixValue.get();
1012 	if (matrix.nrow != variableMatrix.nrow || matrix.ncol != variableMatrix.ncol)
1013 		Melder_throw (U"You cannot multiply a matrix with size ", variableMatrix.nrow, U"x", variableMatrix.ncol,
1014 		              U" from a matrix with a different size (", matrix.nrow, U"x", matrix.ncol, U").");
1015 	for (integer irow = 1; irow <= variableMatrix.nrow; irow ++)
1016 		for (integer icol = 1; icol <= variableMatrix.ncol; icol ++)
1017 			variableMatrix [irow] [icol] *= matrix [irow] [icol];
1018 }
NumericMatrixVariable_divide(InterpreterVariable variable,double scalar)1019 inline static void NumericMatrixVariable_divide (InterpreterVariable variable, double scalar) {
1020 	MAT variableMatrix = variable -> numericMatrixValue.get();
1021 	for (integer irow = 1; irow <= variableMatrix.nrow; irow ++)
1022 		for (integer icol = 1; icol <= variableMatrix.ncol; icol ++)
1023 			variableMatrix [irow] [icol] /= scalar;
1024 }
NumericMatrixVariable_divide(InterpreterVariable variable,constMAT matrix)1025 inline static void NumericMatrixVariable_divide (InterpreterVariable variable, constMAT matrix) {
1026 	MAT variableMatrix = variable -> numericMatrixValue.get();
1027 	if (matrix.nrow != variableMatrix.nrow || matrix.ncol != variableMatrix.ncol)
1028 		Melder_throw (U"You cannot divide a matrix with size ", variableMatrix.nrow, U"x", variableMatrix.ncol,
1029 		              U" by a matrix with a different size (", matrix.nrow, U"x", matrix.ncol, U").");
1030 	for (integer irow = 1; irow <= variableMatrix.nrow; irow ++)
1031 		for (integer icol = 1; icol <= variableMatrix.ncol; icol ++)
1032 			variableMatrix [irow] [icol] /= matrix [irow] [icol];
1033 }
1034 
Interpreter_do_procedureCall(Interpreter me,char32 * command,constvector<mutablestring32> const & lines,integer & lineNumber,integer callStack[],int & callDepth)1035 static void Interpreter_do_procedureCall (Interpreter me, char32 *command,
1036 	constvector <mutablestring32> const& lines, integer& lineNumber, integer callStack [], int& callDepth)
1037 {
1038 	/*
1039 		Modern type of procedure calls, with comma separation, quoted strings, and array support.
1040 
1041 		We just passed the `@` sign, so we continue by looking for a procedure name at the call site.
1042 	*/
1043 	char32 *p = command;
1044 	while (Melder_isHorizontalSpace (*p))
1045 		p ++;   // skip whitespace
1046 	char32 *callName = p;
1047 	while (Melder_staysWithinInk (*p) && *p != U'(' && *p != U':')
1048 		p ++;
1049 	if (p == callName) Melder_throw (U"Missing procedure name after \"@\".");
1050 	bool hasArguments = ( *p != U'\0' );
1051 	if (hasArguments) {
1052 		bool parenthesisOrColonFound = ( *p == U'(' || *p == U':' );
1053 		*p = U'\0';   // close procedure name
1054 		if (! parenthesisOrColonFound) {
1055 			p ++;   // step over first white space
1056 			while (Melder_isHorizontalSpace (*p))
1057 				p ++;   // skip more whitespace
1058 			hasArguments = ( *p != U'\0' );
1059 			parenthesisOrColonFound = ( *p == U'(' || *p == U':' );
1060 			if (hasArguments && ! parenthesisOrColonFound)
1061 				Melder_throw (U"Missing parenthesis or colon after procedure name \"", callName, U"\".");
1062 		}
1063 		p ++;   // step over parenthesis or colon
1064 	}
1065 	integer callLength = str32len (callName);
1066 	integer iline = 1;
1067 	for (; iline <= lines.size; iline ++) {
1068 		if (! str32nequ (lines [iline], U"procedure ", 10))
1069 			continue;
1070 		char32 *q = lines [iline] + 10;
1071 		while (Melder_isHorizontalSpace (*q))
1072 			q ++;   // skip whitespace before procedure name
1073 		char32 *procName = q;
1074 		while (Melder_staysWithinInk (*q) && *q != U'(' && *q != U':')
1075 			q ++;
1076 		if (q == procName) Melder_throw (U"Missing procedure name after 'procedure'.");
1077 		if (q - procName == callLength && str32nequ (procName, callName, callLength)) {
1078 			/*
1079 				We found the procedure definition.
1080 			*/
1081 			if (++ my callDepth > Interpreter_MAX_CALL_DEPTH)
1082 				Melder_throw (U"Call depth greater than ", Interpreter_MAX_CALL_DEPTH, U".");
1083 			str32cpy (my procedureNames [my callDepth], callName);
1084 			bool parenthesisOrColonFound = ( *q == U'(' || *q == U':' );
1085 			if (*q)
1086 				q ++;   // step over parenthesis or colon or first white space
1087 			if (! parenthesisOrColonFound) {
1088 				while (Melder_isHorizontalSpace (*q))
1089 					q ++;   // skip more whitespace
1090 				if (*q == U'(' || *q == U':')
1091 					q ++;   // step over parenthesis or colon
1092 			}
1093 			while (*q && *q != U')' && *q != U';') {
1094 				static MelderString argument;
1095 				MelderString_empty (& argument);
1096 				while (Melder_isHorizontalSpace (*p))
1097 					p ++;
1098 				while (Melder_isHorizontalSpace (*q))
1099 					q ++;
1100 				conststring32 parameterName = q;
1101 				while (Melder_staysWithinInk (*q) && *q != U',' && *q != U')' && *q != U';')
1102 					q ++;   // collect parameter name
1103 				int expressionDepth = 0;
1104 				for (; *p; p ++) {
1105 					if (*p == U',') {
1106 						if (expressionDepth == 0)
1107 							break;   // depth-0 comma ends expression
1108 						MelderString_appendCharacter (& argument, U',');
1109 					} else if (*p == U')' || *p == U']' || *p == U'}') {
1110 						if (expressionDepth == 0)
1111 							break;   // depth-0 closing parenthesis ends expression
1112 						expressionDepth --;
1113 						MelderString_appendCharacter (& argument, *p);
1114 					} else if (*p == U'(' || *p == U'[' || *p == U'{') {
1115 						expressionDepth ++;
1116 						MelderString_appendCharacter (& argument, *p);
1117 					} else if (*p == U'\"') {
1118 						/*
1119 							Enter a string literal.
1120 						*/
1121 						MelderString_appendCharacter (& argument, U'\"');
1122 						p ++;
1123 						for (;; p ++) {
1124 							if (*p == U'\0') {
1125 								Melder_throw (U"Incomplete string literal: the quotes don't match.");
1126 							} else if (*p == U'\"') {
1127 								MelderString_appendCharacter (& argument, U'\"');
1128 								if (p [1] == '\"') {
1129 									p ++;   // stay in the string literal
1130 									MelderString_appendCharacter (& argument, U'\"');
1131 								} else {
1132 									break;
1133 								}
1134 							} else {
1135 								MelderString_appendCharacter (& argument, *p);
1136 							}
1137 						}
1138 					} else {
1139 						MelderString_appendCharacter (& argument, *p);
1140 					}
1141 				}
1142 				if (q == parameterName)
1143 					break;
1144 				if (*p) {
1145 					*p = U'\0';
1146 					p ++;
1147 				}
1148 				if (q [-1] == U'$') {
1149 					my callDepth --;
1150 					autostring32 value = Interpreter_stringExpression (me, argument.string);
1151 					my callDepth ++;
1152 					char32 save = *q;
1153 					*q = U'\0';
1154 					InterpreterVariable var = Interpreter_lookUpVariable (me, parameterName);
1155 					*q = save;
1156 					var -> stringValue = value.move();
1157 				} else if (q [-1] == U'#') {
1158 					if (q [-2] == U'#') {
1159 						MAT value;
1160 						bool owned;
1161 						my callDepth --;
1162 						Interpreter_numericMatrixExpression (me, argument.string, & value, & owned);
1163 						my callDepth ++;
1164 						char32 save = *q;
1165 						*q = U'\0';
1166 						InterpreterVariable var = Interpreter_lookUpVariable (me, parameterName);
1167 						*q = save;
1168 						NumericMatrixVariable_move (var, value, owned);
1169 					} else if (q [-2] == U'$') {
1170 						STRVEC value;
1171 						bool owned;
1172 						my callDepth --;
1173 						Interpreter_stringArrayExpression (me, argument.string, & value, & owned);
1174 						my callDepth ++;
1175 						char32 save = *q;
1176 						*q = U'\0';
1177 						InterpreterVariable var = Interpreter_lookUpVariable (me, parameterName);
1178 						*q = save;
1179 						StringArrayVariable_move (var, value, owned);
1180 					} else {
1181 						VEC value;
1182 						bool owned;
1183 						my callDepth --;
1184 						Interpreter_numericVectorExpression (me, argument.string, & value, & owned);
1185 						my callDepth ++;
1186 						char32 save = *q;
1187 						*q = U'\0';
1188 						InterpreterVariable var = Interpreter_lookUpVariable (me, parameterName);
1189 						*q = save;
1190 						NumericVectorVariable_move (var, value, owned);
1191 					}
1192 				} else {
1193 					double value;
1194 					my callDepth --;
1195 					Interpreter_numericExpression (me, argument.string, & value);
1196 					my callDepth ++;
1197 					char32 save = *q;
1198 					*q = U'\0';
1199 					InterpreterVariable var = Interpreter_lookUpVariable (me, parameterName);
1200 					*q = save;
1201 					var -> numericValue = value;
1202 				}
1203 				if (*q)
1204 					q ++;   // skip comma
1205 			}
1206 			if (callDepth == Interpreter_MAX_CALL_DEPTH)
1207 				Melder_throw (U"Call depth greater than ", Interpreter_MAX_CALL_DEPTH, U".");
1208 			callStack [++ callDepth] = lineNumber;
1209 			lineNumber = iline;
1210 			break;
1211 		}
1212 	}
1213 	if (iline > lines.size)
1214 		Melder_throw (U"Procedure \"", callName, U"\" not found.");
1215 }
Interpreter_do_oldProcedureCall(Interpreter me,char32 * command,constvector<mutablestring32> const & lines,integer & lineNumber,integer callStack[],int & callDepth)1216 static void Interpreter_do_oldProcedureCall (Interpreter me, char32 *command,
1217 	constvector <mutablestring32> const& lines, integer& lineNumber, integer callStack [], int& callDepth)
1218 {
1219 	/*
1220 		Old type of procedure calls, with space separation, unquoted strings, and no array support.
1221 	*/
1222 	char32 *p = command;
1223 	while (Melder_isHorizontalSpace (*p))
1224 		p ++;   // skip whitespace
1225 	char32 *callName = p;
1226 	while (*p != U'\0' && ! Melder_isHorizontalSpace (*p) && *p != U'(' && *p != U':')
1227 		p ++;
1228 	if (p == callName)
1229 		Melder_throw (U"Missing procedure name after 'call'.");
1230 	bool hasArguments = ( *p != U'\0' );
1231 	*p = U'\0';   // close procedure name
1232 	integer callLength = str32len (callName);
1233 	integer iline = 1;
1234 	for (; iline <= lines.size; iline ++) {
1235 		if (! str32nequ (lines [iline], U"procedure ", 10))
1236 			continue;
1237 		char32 *q = lines [iline] + 10;
1238 		while (Melder_isHorizontalSpace (*q))
1239 			q ++;
1240 		char32 *procName = q;
1241 		while (*q != U'\0' && ! Melder_isHorizontalSpace (*q) && *q != U'(' && *q != U':')
1242 			q ++;
1243 		if (q == procName)
1244 			Melder_throw (U"Missing procedure name after 'procedure'.");
1245 		bool hasParameters = ( *q != U'\0' );
1246 		if (q - procName == callLength && str32nequ (procName, callName, callLength)) {
1247 			if (hasArguments && ! hasParameters)
1248 				Melder_throw (U"Call to procedure \"", callName, U"\" has too many arguments.");
1249 			if (hasParameters && ! hasArguments)
1250 				Melder_throw (U"Call to procedure \"", callName, U"\" has too few arguments.");
1251 			if (++ my callDepth > Interpreter_MAX_CALL_DEPTH)
1252 				Melder_throw (U"Call depth greater than ", Interpreter_MAX_CALL_DEPTH, U".");
1253 			str32cpy (my procedureNames [my callDepth], callName);
1254 			if (hasParameters) {
1255 				bool parenthesisOrColonFound = ( *q == U'(' || *q == U':' );
1256 				q ++;   // step over parenthesis or colon or first white space
1257 				if (! parenthesisOrColonFound) {
1258 					while (Melder_isHorizontalSpace (*q))
1259 						q ++;   // skip more whitespace
1260 					if (*q == U'(' || *q == U':')
1261 						q ++;   // step over parenthesis or colon
1262 				}
1263 				++ p;   // first argument
1264 				while (*q && *q != U')') {
1265 					char32 *par, save;
1266 					static MelderString arg;
1267 					MelderString_empty (& arg);
1268 					while (Melder_isHorizontalSpace (*p))
1269 						p ++;
1270 					while (Melder_isHorizontalSpace (*q) || *q == U',' || *q == U')')
1271 						q ++;
1272 					par = q;
1273 					while (*q != U'\0' && ! Melder_isHorizontalSpace (*q) && *q != U',' && *q != U')')
1274 						q ++;   // collect parameter name
1275 					if (*q) {   // does anything follow the parameter name?
1276 						if (*p == U'\"') {
1277 							p ++;   // skip initial quote
1278 							while (*p != U'\0') {
1279 								if (*p == U'\"') {   // quote signals end-of-string or string-internal quote
1280 									if (p [1] == U'\"') {   // double quote signals string-internal quote
1281 										MelderString_appendCharacter (& arg, U'\"');
1282 										p += 2;   // skip second quote
1283 									} else {   // single quote signals end-of-string
1284 										break;
1285 									}
1286 								} else {
1287 									MelderString_appendCharacter (& arg, *p ++);
1288 								}
1289 							}
1290 						} else {
1291 							while (*p != U'\0' && ! Melder_isHorizontalSpace (*p))
1292 								MelderString_appendCharacter (& arg, *p ++);   // white space separates
1293 						}
1294 						if (*p) {
1295 							*p = U'\0';
1296 							p ++;
1297 						}
1298 					} else {   // else rest of line
1299 						while (*p != '\0')
1300 							MelderString_appendCharacter (& arg, *p ++);
1301 					}
1302 					if (q [-1] == '$') {
1303 						save = *q; *q = U'\0';
1304 						InterpreterVariable var = Interpreter_lookUpVariable (me, par); *q = save;
1305 						var -> stringValue = Melder_dup_f (arg.string);
1306 					} else {
1307 						double value;
1308 						my callDepth --;
1309 						Interpreter_numericExpression (me, arg.string, & value);
1310 						my callDepth ++;
1311 						save = *q; *q = U'\0';
1312 						InterpreterVariable var = Interpreter_lookUpVariable (me, par); *q = save;
1313 						var -> numericValue = value;
1314 					}
1315 				}
1316 			}
1317 			if (callDepth == Interpreter_MAX_CALL_DEPTH)
1318 				Melder_throw (U"Call depth greater than ", Interpreter_MAX_CALL_DEPTH, U".");
1319 			callStack [++ callDepth] = lineNumber;
1320 			lineNumber = iline;
1321 			break;
1322 		}
1323 	}
1324 	if (iline > lines.size)
1325 		Melder_throw (U"Procedure \"", callName, U"\" not found.");
1326 }
1327 
assignToNumericVectorElement(Interpreter me,char32 * & p,const char32 * vectorName,MelderString & valueString)1328 static void assignToNumericVectorElement (Interpreter me, char32 *& p, const char32* vectorName, MelderString& valueString) {
1329 	integer indexValue = 0;
1330 	static MelderString index;
1331 	MelderString_empty (& index);
1332 	int depth = 0;
1333 	bool inString = false;
1334 	while ((depth > 0 || *p != U']' || inString) && Melder_staysWithinLine (*p)) {
1335 		MelderString_appendCharacter (& index, *p);
1336 		if (*p == U'[') {
1337 			if (! inString)
1338 				depth ++;
1339 		} else if (*p == U']') {
1340 			if (! inString)
1341 				depth --;
1342 		}
1343 		if (*p == U'"') inString = ! inString;
1344 		p ++;
1345 	}
1346 	if (! Melder_staysWithinLine (*p))
1347 		Melder_throw (U"Missing closing bracket (]) in array element.");
1348 	Formula_Result result;
1349 	Interpreter_anyExpression (me, index.string, & result);
1350 	if (result.expressionType == kFormula_EXPRESSION_TYPE_NUMERIC) {
1351 		indexValue = Melder_iround (result. numericResult);
1352 	} else {
1353 		Melder_throw (U"Element index should be numeric.");
1354 	}
1355 	p ++;   // step over closing bracket
1356 	while (Melder_isHorizontalSpace (*p))
1357 		p ++;
1358 	int assignmentType = 0;
1359 	if (*p == U'=') {
1360 		p ++;   // step over equals sign
1361 	} else if (*p == U'+' && p [1] == U'=') {
1362 		assignmentType = 1;
1363 		p += 2;   // step over plus-gets sign
1364 	} else if (*p == U'-' && p [1] == U'=') {
1365 		assignmentType = 2;
1366 		p += 2;   // step over minus-gets sign
1367 	} else if (*p == U'*' && p [1] == U'=') {
1368 		assignmentType = 3;
1369 		p += 2;   // step over times-gets sign
1370 	} else if (*p == U'/' && p [1] == U'=') {
1371 		assignmentType = 4;
1372 		p += 2;   // step over div-gets sign
1373 	} else
1374 		Melder_throw (U"Missing '=', '+=', '-=', '*=' or '/=' after vector element ", vectorName, U" [", index.string, U"].");
1375 	while (Melder_isHorizontalSpace (*p))
1376 		p ++;   // go to first token after assignment
1377 	if (*p == U'\0')
1378 		Melder_throw (U"Missing expression after vector element ", vectorName, U" [", index.string, U"].");
1379 	double value;
1380 	if (isCommand (p)) {
1381 		/*
1382 			Get the value of the query.
1383 		*/
1384 		MelderString_empty (& valueString);
1385 		autoMelderDivertInfo divert (& valueString);
1386 		MelderString_appendCharacter (& valueString, 1);   // will be overwritten by something totally different if any MelderInfo function is called...
1387 		bool status = praat_executeCommand (me, p);
1388 		if (! status) {
1389 			value = undefined;
1390 		} else if (my returnType == kInterpreter_ReturnType::OBJECT_) {
1391 			int IOBJECT, selectedObject = 0, numberOfSelectedObjects = 0;
1392 			WHERE (SELECTED) { selectedObject = IOBJECT; numberOfSelectedObjects += 1; }
1393 			if (numberOfSelectedObjects > 1)
1394 				Melder_throw (U"Multiple objects selected. Cannot assign object IDs to vector element. "
1395 						"Perhaps use a vector variable instead.");
1396 			if (numberOfSelectedObjects == 0)
1397 				Melder_throw (U"No objects selected. Cannot assign object ID to vector element.");
1398 			value = theCurrentPraatObjects -> list [selectedObject]. id;
1399 		} else {
1400 			value = Melder_atof (valueString.string);   // including --undefined--
1401 		}
1402 	} else {
1403 		/*
1404 			Get the value of the formula.
1405 		*/
1406 		Interpreter_numericExpression (me, p, & value);
1407 	}
1408 	InterpreterVariable var = Interpreter_hasVariable (me, vectorName);
1409 	if (! var)
1410 		Melder_throw (U"Vector ", vectorName, U" does not exist.");
1411 	if (indexValue < 1)
1412 		Melder_throw (U"A vector index cannot be less than 1 (the index you supplied is ", indexValue, U").");
1413 	if (indexValue > var -> numericVectorValue.size)
1414 		Melder_throw (U"A vector index cannot be greater than the number of elements (here ",
1415 			var -> numericVectorValue.size, U"). The index you supplied is ", indexValue, U".");
1416 	if (assignmentType == 0)
1417 		var -> numericVectorValue [indexValue] = value;
1418 	else if (assignmentType == 1)
1419 		var -> numericVectorValue [indexValue] += value;
1420 	else if (assignmentType == 2)
1421 		var -> numericVectorValue [indexValue] -= value;
1422 	else if (assignmentType == 3)
1423 		var -> numericVectorValue [indexValue] *= value;
1424 	else if (assignmentType == 4)
1425 		var -> numericVectorValue [indexValue] /= value;
1426 	else
1427 		Melder_assert (false);
1428 }
1429 
assignToNumericMatrixElement(Interpreter me,char32 * & p,const char32 * matrixName,MelderString & valueString)1430 static void assignToNumericMatrixElement (Interpreter me, char32 *& p, const char32* matrixName, MelderString& valueString) {
1431 	integer rowNumber = 0, columnNumber = 0;
1432 	/*
1433 		Get the row number.
1434 	*/
1435 	static MelderString rowFormula;
1436 	MelderString_empty (& rowFormula);
1437 	int depth = 0;
1438 	bool inString = false;
1439 	while ((depth > 0 || *p != U',' || inString) && Melder_staysWithinLine (*p)) {
1440 		MelderString_appendCharacter (& rowFormula, *p);
1441 		if (*p == U'[' || *p == U'(') {
1442 			if (! inString)
1443 				depth ++;
1444 		} else if (*p == U']' || *p == U')') {
1445 			if (! inString)
1446 				depth --;
1447 		}
1448 		if (*p == U'"') inString = ! inString;
1449 		p ++;
1450 	}
1451 	if (! Melder_staysWithinLine (*p))
1452 		Melder_throw (U"Missing comma in matrix indexing.");
1453 	Formula_Result result;
1454 	Interpreter_anyExpression (me, rowFormula.string, & result);
1455 	if (result.expressionType == kFormula_EXPRESSION_TYPE_NUMERIC) {
1456 		rowNumber = Melder_iround (result. numericResult);
1457 	} else {
1458 		Melder_throw (U"Row number should be numeric.");
1459 	}
1460 	p ++;   // step over comma
1461 	/*
1462 		Get the column number.
1463 	*/
1464 	static MelderString columnFormula;
1465 	MelderString_empty (& columnFormula);
1466 	depth = 0;
1467 	inString = false;
1468 	while ((depth > 0 || *p != U']' || inString) && Melder_staysWithinLine (*p)) {
1469 		MelderString_appendCharacter (& columnFormula, *p);
1470 		if (*p == U'[') {
1471 			if (! inString)
1472 				depth ++;
1473 		} else if (*p == U']') {
1474 			if (! inString)
1475 				depth --;
1476 		}
1477 		if (*p == U'"')
1478 			inString = ! inString;
1479 		p ++;
1480 	}
1481 	if (! Melder_staysWithinLine (*p))
1482 		Melder_throw (U"Missing closing bracket (]) in matrix indexing.");
1483 	Interpreter_anyExpression (me, columnFormula.string, & result);
1484 	if (result.expressionType == kFormula_EXPRESSION_TYPE_NUMERIC) {
1485 		columnNumber = Melder_iround (result. numericResult);
1486 	} else {
1487 		Melder_throw (U"Column number should be numeric.");
1488 	}
1489 	p ++;   // step over closing bracket
1490 	while (Melder_isHorizontalSpace (*p))
1491 		p ++;
1492 	int assignmentType = 0;
1493 	if (*p == U'=') {
1494 		p ++;   // step over equals sign
1495 	} else if (*p == U'+' && p [1] == U'=') {
1496 		assignmentType = 1;
1497 		p += 2;   // step over plus-gets sign
1498 	} else if (*p == U'-' && p [1] == U'=') {
1499 		assignmentType = 2;
1500 		p += 2;   // step over minus-gets sign
1501 	} else if (*p == U'*' && p [1] == U'=') {
1502 		assignmentType = 3;
1503 		p += 2;   // step over times-gets sign
1504 	} else if (*p == U'/' && p [1] == U'=') {
1505 		assignmentType = 4;
1506 		p += 2;   // step over div-gets sign
1507 	} else
1508 		Melder_throw (U"Missing '=', '+=', '-=', '*=' or '/=' after matrix element ", matrixName, U" [",
1509 			rowFormula.string, U",", columnFormula.string, U"].");
1510 	while (Melder_isHorizontalSpace (*p))
1511 		p ++;   // go to first token after assignment
1512 	if (*p == U'\0')
1513 		Melder_throw (U"Missing expression after matrix element ", matrixName, U" [",
1514 				rowFormula.string, U",", columnFormula.string, U"].");
1515 	double value;
1516 	if (isCommand (p)) {
1517 		/*
1518 			Get the value of the query.
1519 		*/
1520 		MelderString_empty (& valueString);
1521 		autoMelderDivertInfo divert (& valueString);
1522 		MelderString_appendCharacter (& valueString, 1);   // will be overwritten by something totally different if any MelderInfo function is called...
1523 		bool status = praat_executeCommand (me, p);
1524 		if (! status) {
1525 			value = undefined;
1526 		} else if (my returnType == kInterpreter_ReturnType::OBJECT_) {
1527 			int IOBJECT, selectedObject = 0, numberOfSelectedObjects = 0;
1528 			WHERE (SELECTED) { selectedObject = IOBJECT; numberOfSelectedObjects += 1; }
1529 			if (numberOfSelectedObjects > 1)
1530 				Melder_throw (U"Multiple objects selected. Cannot assign object IDs to matrix element. "
1531 						"Perhaps use a vector variable instead.");
1532 			if (numberOfSelectedObjects == 0)
1533 				Melder_throw (U"No objects selected. Cannot assign object ID to matrix element.");
1534 			value = theCurrentPraatObjects -> list [selectedObject]. id;
1535 		} else {
1536 			value = Melder_atof (valueString.string);   // including --undefined--
1537 		}
1538 	} else {
1539 		/*
1540 			Get the value of the formula.
1541 		*/
1542 		Interpreter_numericExpression (me, p, & value);
1543 	}
1544 	InterpreterVariable var = Interpreter_hasVariable (me, matrixName);
1545 	if (! var)
1546 		Melder_throw (U"Matrix ", matrixName, U" does not exist.");
1547 	if (rowNumber < 1)
1548 		Melder_throw (U"A row number cannot be less than 1 (the row number you supplied is ", rowNumber, U").");
1549 	if (rowNumber > var -> numericMatrixValue. nrow)
1550 		Melder_throw (U"A row number cannot be greater than the number of rows (here ",
1551 			var -> numericMatrixValue. nrow, U"). The row number you supplied is ", rowNumber, U".");
1552 	if (columnNumber < 1)
1553 		Melder_throw (U"A column number cannot be less than 1 (the column number you supplied is ", columnNumber, U").");
1554 	if (columnNumber > var -> numericMatrixValue. ncol)
1555 		Melder_throw (U"A column number cannot be greater than the number of columns (here ",
1556 			var -> numericMatrixValue. ncol, U"). The column number you supplied is ", columnNumber, U".");
1557 	if (assignmentType == 0)
1558 		var -> numericMatrixValue [rowNumber] [columnNumber] = value;
1559 	else if (assignmentType == 1)
1560 		var -> numericMatrixValue [rowNumber] [columnNumber] += value;
1561 	else if (assignmentType == 2)
1562 		var -> numericMatrixValue [rowNumber] [columnNumber] -= value;
1563 	else if (assignmentType == 3)
1564 		var -> numericMatrixValue [rowNumber] [columnNumber] *= value;
1565 	else if (assignmentType == 4)
1566 		var -> numericMatrixValue [rowNumber] [columnNumber] /= value;
1567 	else
1568 		Melder_assert (false);
1569 }
1570 
assignToStringArrayElement(Interpreter me,char32 * & p,const char32 * vectorName,MelderString & valueString)1571 static void assignToStringArrayElement (Interpreter me, char32 *& p, const char32* vectorName, MelderString& valueString) {
1572 	integer indexValue = 0;
1573 	static MelderString index;
1574 	MelderString_empty (& index);
1575 	int depth = 0;
1576 	bool inString = false;
1577 	while ((depth > 0 || *p != U']' || inString) && Melder_staysWithinLine (*p)) {
1578 		MelderString_appendCharacter (& index, *p);
1579 		if (*p == U'[') {
1580 			if (! inString)
1581 				depth ++;
1582 		} else if (*p == U']') {
1583 			if (! inString)
1584 				depth --;
1585 		}
1586 		if (*p == U'"') inString = ! inString;
1587 		p ++;
1588 	}
1589 	if (! Melder_staysWithinLine (*p))
1590 		Melder_throw (U"Missing closing bracket (]) in array element.");
1591 	Formula_Result result;
1592 	Interpreter_anyExpression (me, index.string, & result);
1593 	if (result.expressionType == kFormula_EXPRESSION_TYPE_NUMERIC) {
1594 		indexValue = Melder_iround (result. numericResult);
1595 	} else {
1596 		Melder_throw (U"Element index should be numeric.");
1597 	}
1598 	p ++;   // step over closing bracket
1599 	while (Melder_isHorizontalSpace (*p))
1600 		p ++;
1601 	if (*p != U'=')
1602 		Melder_throw (U"Missing '=' after string vector element ", vectorName, U" [", index.string, U"].");
1603 	p ++;   // step over equals sign
1604 	while (Melder_isHorizontalSpace (*p))
1605 		p ++;   // go to first token after assignment
1606 	if (*p == U'\0')
1607 		Melder_throw (U"Missing expression after string vector element ", vectorName, U" [", index.string, U"].");
1608 	autostring32 value;
1609 	if (isCommand (p)) {
1610 		/*
1611 			Get the value of the query.
1612 		*/
1613 		MelderString_empty (& valueString);
1614 		autoMelderDivertInfo divert (& valueString);
1615 		bool status = praat_executeCommand (me, p);
1616 		if (! status)
1617 			value = autostring32();
1618 		else
1619 			value = Melder_dup (valueString.string);
1620 	} else {
1621 		/*
1622 			Get the value of the formula.
1623 		*/
1624 		value = Interpreter_stringExpression (me, p);
1625 	}
1626 	InterpreterVariable var = Interpreter_hasVariable (me, vectorName);
1627 	if (! var)
1628 		Melder_throw (U"String vector ", vectorName, U" does not exist.");
1629 	if (indexValue < 1)
1630 		Melder_throw (U"A vector index cannot be less than 1 (the index you supplied is ", indexValue, U").");
1631 	if (indexValue > var -> stringArrayValue.size)
1632 		Melder_throw (U"A vector index cannot be greater than the number of elements (here ",
1633 			var -> stringArrayValue.size, U"). The index you supplied is ", indexValue, U".");
1634 	var -> stringArrayValue [indexValue] = value. move();
1635 }
1636 
Interpreter_run(Interpreter me,char32 * text)1637 void Interpreter_run (Interpreter me, char32 *text) {
1638 	autovector <mutablestring32> lines;   // not autostringvector, because the elements are reference copies
1639 	integer lineNumber = 0;
1640 	bool assertionFailed = false;
1641 	try {
1642 		static MelderString valueString;   // to divert the info
1643 		static MelderString assertErrorString;
1644 		char32 *command = text;
1645 		autoMelderString command2;
1646 		autoMelderString buffer;
1647 		integer numberOfLines = 0, assertErrorLineNumber = 0, callStack [1 + Interpreter_MAX_CALL_DEPTH];
1648 		bool atLastLine = false, fromif = false, fromendfor = false;
1649 		int callDepth = 0, chopped = 0, ipar;
1650 		my callDepth = 0;
1651 		/*
1652 			The "environment" is null if we are in the Praat shell, or an editor otherwise.
1653 		*/
1654 		if (my editorClass)
1655 			praatP. editor = praat_findEditorFromString (my environmentName.get());
1656 		else
1657 			praatP. editor = nullptr;
1658 		/*
1659 			Start.
1660 		*/
1661 		my running = true;
1662 		/*
1663 			Count lines and set the newlines to zero.
1664 		*/
1665 		while (! atLastLine) {
1666 			char32 *endOfLine = command;
1667 			while (Melder_staysWithinLine (*endOfLine))
1668 				endOfLine ++;
1669 			if (*endOfLine == U'\0')
1670 				atLastLine = true;
1671 			*endOfLine = U'\0';
1672 			numberOfLines ++;
1673 			command = endOfLine + 1;
1674 		}
1675 		/*
1676 			Remember line starts and labels.
1677 		*/
1678 		lines. resize (numberOfLines);
1679 		for (lineNumber = 1, command = text; lineNumber <= numberOfLines; lineNumber ++, command += str32len (command) + 1 + chopped) {
1680 			while (Melder_isHorizontalSpace (*command))
1681 				command ++;   // nbsp can occur for scripts copied from the manual
1682 			/*
1683 				Chop trailing spaces?
1684 			*/
1685 			#if 0
1686 				chopped = 0;
1687 				int length = str32len (command);
1688 				while (length > 0) {
1689 					char kar = command [-- length];
1690 					if (! Melder_isHorizontalSpace (kar))
1691 						break;
1692 					command [length] = U'\0';
1693 					chopped ++;
1694 				}
1695 			#endif
1696 			lines [lineNumber] = command;
1697 			if (str32nequ (command, U"label ", 6)) {
1698 				for (integer ilabel = 1; ilabel <= my numberOfLabels; ilabel ++)
1699 					if (str32equ (command + 6, my labelNames [ilabel]))
1700 						Melder_throw (U"Duplicate label \"", command + 6, U"\".");
1701 				if (my numberOfLabels >= Interpreter_MAXNUM_LABELS)
1702 					Melder_throw (U"Too many labels.");
1703 				str32ncpy (my labelNames [++ my numberOfLabels], command + 6, 1+Interpreter_MAX_LABEL_LENGTH);
1704 				my labelNames [my numberOfLabels] [Interpreter_MAX_LABEL_LENGTH] = U'\0';
1705 				my labelLines [my numberOfLabels] = lineNumber;
1706 			}
1707 		}
1708 		/*
1709 			Connect continuation lines.
1710 		*/
1711 		trace (U"connect continuation lines");
1712 		for (lineNumber = numberOfLines; lineNumber >= 2; lineNumber --) {
1713 			char32 *line = lines [lineNumber];
1714 			if (line [0] == U'.' && line [1] == U'.' && line [2] == U'.') {
1715 				char32 *previous = lines [lineNumber - 1];
1716 				MelderString_copy (& command2, line + 3);
1717 				MelderString_get (& command2, previous + str32len (previous));
1718 				static char32 emptyLine [] = { U'\0' };
1719 				lines [lineNumber] = emptyLine;
1720 			}
1721 		}
1722 		/*
1723 			Copy the parameter names and argument values into the array of variables.
1724 		*/
1725 		my variablesMap. clear ();
1726 		for (ipar = 1; ipar <= my numberOfParameters; ipar ++) {
1727 			char32 parameter [200];
1728 			/*
1729 				Create variable names as-are and variable names without capitals.
1730 			*/
1731 			str32cpy (parameter, my parameters [ipar]);
1732 			parameterToVariable (me, my types [ipar], parameter, ipar);
1733 			if (parameter [0] >= U'A' && parameter [0] <= U'Z') {
1734 				parameter [0] = Melder_toLowerCase (parameter [0]);
1735 				parameterToVariable (me, my types [ipar], parameter, ipar);
1736 			}
1737 		}
1738 		/*
1739 			Initialize some variables.
1740 		*/
1741 		Interpreter_addStringVariable (me, U"newline$", U"\n");
1742 		Interpreter_addStringVariable (me, U"tab$", U"\t");
1743 		Interpreter_addStringVariable (me, U"shellDirectory$", Melder_getShellDirectory ());
1744 		structMelderDir dir { }; Melder_getDefaultDir (& dir);
1745 		Interpreter_addStringVariable (me, U"defaultDirectory$", Melder_dirToPath (& dir));
1746 		Interpreter_addStringVariable (me, U"preferencesDirectory$", Melder_dirToPath (& Melder_preferencesFolder));
1747 		Melder_getHomeDir (& dir);
1748 		Interpreter_addStringVariable (me, U"homeDirectory$", Melder_dirToPath (& dir));
1749 		Melder_getTempDir (& dir);
1750 		Interpreter_addStringVariable (me, U"temporaryDirectory$", Melder_dirToPath (& dir));
1751 		#if defined (macintosh)
1752 			Interpreter_addNumericVariable (me, U"macintosh", 1);
1753 			Interpreter_addNumericVariable (me, U"windows", 0);
1754 			Interpreter_addNumericVariable (me, U"unix", 0);
1755 		#elif defined (_WIN32)
1756 			Interpreter_addNumericVariable (me, U"macintosh", 0);
1757 			Interpreter_addNumericVariable (me, U"windows", 1);
1758 			Interpreter_addNumericVariable (me, U"unix", 0);
1759 		#elif defined (UNIX)
1760 			Interpreter_addNumericVariable (me, U"macintosh", 0);
1761 			Interpreter_addNumericVariable (me, U"windows", 0);
1762 			Interpreter_addNumericVariable (me, U"unix", 1);
1763 		#else
1764 			Interpreter_addNumericVariable (me, U"macintosh", 0);
1765 			Interpreter_addNumericVariable (me, U"windows", 0);
1766 			Interpreter_addNumericVariable (me, U"unix", 0);
1767 		#endif
1768 		Interpreter_addNumericVariable (me, U"left", 1);   // to accommodate scripts from before Praat 5.2.06
1769 		Interpreter_addNumericVariable (me, U"right", 2);   // to accommodate scripts from before Praat 5.2.06
1770 		Interpreter_addNumericVariable (me, U"mono", 1);   // to accommodate scripts from before Praat 5.2.06
1771 		Interpreter_addNumericVariable (me, U"stereo", 2);   // to accommodate scripts from before Praat 5.2.06
1772 		Interpreter_addNumericVariable (me, U"all", 0);   // to accommodate scripts from before Praat 5.2.06
1773 		Interpreter_addNumericVariable (me, U"average", 0);   // to accommodate scripts from before Praat 5.2.06
1774 		#define xstr(s) str(s)
1775 		#define str(s) #s
1776 		Interpreter_addStringVariable (me, U"praatVersion$", U"" xstr(PRAAT_VERSION_STR));
1777 		Interpreter_addNumericVariable (me, U"praatVersion", PRAAT_VERSION_NUM);
1778 		/*
1779 			Execute commands.
1780 		*/
1781 		trace (U"going to handle ", numberOfLines, U" lines");
1782 		//for (lineNumber = 1; lineNumber <= numberOfLines; lineNumber ++) {
1783 			//trace (U"line ", lineNumber, U": ", lines [lineNumber]);
1784 		//}
1785 		for (lineNumber = 1; lineNumber <= numberOfLines; lineNumber ++) {
1786 			if (my stopped) break;
1787 			//trace (U"now at line ", lineNumber, U": ", lines [lineNumber]);
1788 			//for (int lineNumber2 = 1; lineNumber2 <= numberOfLines; lineNumber2 ++) {
1789 				//trace (U"  line ", lineNumber2, U": ", lines [lineNumber2]);
1790 			//}
1791 			try {
1792 				char32 c0;
1793 				bool fail = false;
1794 				MelderString_copy (& command2, lines [lineNumber]);
1795 				c0 = command2. string [0];
1796 				if (c0 == U'\0')
1797 					continue;
1798 				/*
1799 					Substitute variables.
1800 				*/
1801 				trace (U"substituting variables");
1802 				for (char32 *p = & command2. string [0]; *p != U'\0'; p ++) if (*p == U'\'') {
1803 					/*
1804 						Found a left quote. Search for a matching right quote.
1805 					*/
1806 					char32 *q = p + 1, varName [300], *r, *s;
1807 					integer precision = -1;
1808 					bool percent = false;
1809 					while (*q != U'\0' && *q != U'\'' && q - p < 299)
1810 						q ++;
1811 					if (*q == U'\0')
1812 						break;   // no matching right quote? done with this line!
1813 					if (q - p == 1 || q - p >= 299)
1814 						continue;   // ignore empty and too long variable names
1815 					trace (U"found ", q - p - 1);
1816 					/*
1817 						Found a right quote. Get potential variable name.
1818 					*/
1819 					for (r = p + 1, s = varName; q - r > 0; r ++, s ++)
1820 						*s = *r;
1821 					*s = U'\0';   // trailing null byte
1822 					char32 *colon = str32chr (varName, U':');
1823 					if (colon) {
1824 						precision = Melder_atoi (colon + 1);
1825 						if (str32chr (colon + 1, U'%'))
1826 							percent = true;
1827 						*colon = U'\0';
1828 					}
1829 					InterpreterVariable var = Interpreter_hasVariable (me, varName);
1830 					if (var) {
1831 						/*
1832 							Found a variable (p points to the left quote, q to the right quote). Substitute.
1833 						*/
1834 						integer headlen = p - command2.string;
1835 						conststring32 string = ( var -> stringValue ? var -> stringValue.get() :
1836 								percent ? Melder_percent (var -> numericValue, precision) :
1837 								precision >= 0 ?  Melder_fixed (var -> numericValue, precision) :
1838 								Melder_double (var -> numericValue) );
1839 						integer arglen = str32len (string);
1840 						MelderString_ncopy (& buffer, command2.string, headlen);
1841 						MelderString_append (& buffer, string, q + 1);
1842 						MelderString_copy (& command2, buffer.string);   // This invalidates p!! (really bad bug 20070203)
1843 						p = command2.string + headlen + arglen - 1;
1844 					} else {
1845 						p = q - 1;   // go to before next quote
1846 					}
1847 				}
1848 				trace (U"resume");
1849 				c0 = command2.string [0];   // resume in order to allow things like 'c$' = 5
1850 				if ((! Melder_isLetter (c0) || Melder_isUpperCaseLetter (c0)) && c0 != U'@' &&
1851 						! (c0 == U'.' && Melder_isLetter (command2.string [1]) && ! Melder_isUpperCaseLetter (command2.string [1])))
1852 				{
1853 					(void) praat_executeCommand (me, command2.string);
1854 				/*
1855 				 * Interpret control flow and variables.
1856 				 */
1857 				} else switch (c0) {
1858 					case U'.':
1859 						fail = true;
1860 						break;
1861 					case U'@':
1862 						Interpreter_do_procedureCall (me, command2.string + 1, lines.get(), lineNumber, callStack, callDepth);
1863 						break;
1864 					case U'a':
1865 						if (str32nequ (command2.string, U"assert ", 7)) {
1866 							double value;
1867 							Interpreter_numericExpression (me, command2.string + 7, & value);
1868 							if (value == 0.0 || isundef (value)) {
1869 								assertionFailed = true;
1870 								Melder_throw (U"Script assertion fails in line ", lineNumber,
1871 									U" (", value == 0.0 ? U"false" : U"undefined", U"):\n   ", command2.string + 7);
1872 							}
1873 						} else if (str32nequ (command2.string, U"asserterror ", 12)) {
1874 							MelderString_copy (& assertErrorString, command2.string + 12);
1875 							assertErrorLineNumber = lineNumber;
1876 						} else
1877 							fail = true;
1878 						break;
1879 					case U'b':
1880 						fail = true;
1881 						break;
1882 					case U'c':
1883 						if (str32nequ (command2.string, U"call ", 5)) {
1884 							Interpreter_do_oldProcedureCall (me, command2.string + 5, lines.get(), lineNumber, callStack, callDepth);
1885 						} else
1886 							fail = true;
1887 						break;
1888 					case U'd':
1889 						if (str32nequ (command2.string, U"dec ", 4)) {
1890 							InterpreterVariable var = Interpreter_lookUpVariable (me, command2.string + 4);
1891 							var -> numericValue -= 1.0;
1892 						} else
1893 							fail = true;
1894 						break;
1895 					case U'e':
1896 						if (command2.string [1] == U'n' && command2.string [2] == U'd') {
1897 							if (str32nequ (command2.string, U"endif", 5) &&
1898 									(! Melder_staysWithinInk (command2.string [5]) || command2.string [5] == U';'))
1899 							{
1900 								const char32 *startOfInk = Melder_findInk (command2.string + 5);
1901 								if (startOfInk && *startOfInk != U';')
1902 									Melder_throw (U"Stray text after 'endif'.");
1903 								/* Ignore. */
1904 							} else if (str32nequ (command2.string, U"endfor", 6) &&
1905 									(! Melder_staysWithinInk (command2.string [6]) || command2.string [6] == U';'))
1906 							{
1907 								const char32 *startOfInk = Melder_findInk (command2.string + 6);
1908 								if (startOfInk && *startOfInk != U';')
1909 									Melder_throw (U"Stray text after 'endfor'.");
1910 								int depth = 0;
1911 								integer iline;
1912 								for (iline = lineNumber - 1; iline > 0; iline --) {
1913 									char32 *line = lines [iline];
1914 									if (line [0] == U'f' && line [1] == U'o' && line [2] == U'r' && line [3] == U' ') {
1915 										if (depth == 0) { lineNumber = iline - 1; fromendfor = true; break; }   // go before 'for'
1916 										else depth --;
1917 									} else if (str32nequ (lines [iline], U"endfor", 6) &&
1918 											(! Melder_staysWithinInk (lines [iline] [6]) || lines [iline] [6] == U';'))
1919 									{
1920 										depth ++;
1921 									}
1922 								}
1923 								if (iline <= 0) Melder_throw (U"Unmatched 'endfor'.");
1924 							} else if (str32nequ (command2.string, U"endwhile", 8) &&
1925 									(! Melder_staysWithinInk (command2.string [8]) || command2.string [8] == U';'))
1926 							{
1927 								const char32 *startOfInk = Melder_findInk (command2.string + 8);
1928 								if (startOfInk && *startOfInk != U';')
1929 									Melder_throw (U"Stray text after 'endwhile'.");
1930 								int depth = 0;
1931 								integer iline;
1932 								for (iline = lineNumber - 1; iline > 0; iline --) {
1933 									if (str32nequ (lines [iline], U"while ", 6)) {
1934 										if (depth == 0) {
1935 											lineNumber = iline - 1;
1936 											break;   // go before 'while'
1937 										} else
1938 											depth --;
1939 									} else if (str32nequ (lines [iline], U"endwhile", 8) &&
1940 											(! Melder_staysWithinInk (lines [iline] [8]) || lines [iline] [8] == U';'))
1941 									{
1942 										depth ++;
1943 									}
1944 								}
1945 								if (iline <= 0) Melder_throw (U"Unmatched 'endwhile'.");
1946 							} else if (str32nequ (command2.string, U"endproc", 7) &&
1947 									(! Melder_staysWithinInk (command2.string [7]) || command2.string [7] == U';'))
1948 							{
1949 								const char32 *startOfInk = Melder_findInk (command2.string + 7);
1950 								if (startOfInk && *startOfInk != U';')
1951 									Melder_throw (U"Stray text after 'endproc'.");
1952 								if (callDepth == 0)
1953 									Melder_throw (U"Unmatched 'endproc'.");
1954 								lineNumber = callStack [callDepth --];
1955 								-- my callDepth;
1956 							} else fail = true;
1957 						} else if (str32nequ (command2.string, U"else", 4) &&
1958 								(! Melder_staysWithinInk (command2.string [4]) || command2.string [4] == U';'))
1959 						{
1960 							const char32 *startOfInk = Melder_findInk (command2.string + 4);
1961 							if (startOfInk && *startOfInk != U';')
1962 								Melder_throw (U"Stray text after 'else'.");
1963 							int depth = 0;
1964 							integer iline;
1965 							for (iline = lineNumber + 1; iline <= numberOfLines; iline ++) {
1966 								if (str32nequ (lines [iline], U"endif", 5) &&
1967 										(! Melder_staysWithinInk (lines [iline] [5]) || lines [iline] [5] == U';'))
1968 								{
1969 									startOfInk = Melder_findInk (lines [iline] + 5);
1970 									if (startOfInk && *startOfInk != U';') {
1971 										lineNumber = iline;   // on behalf of the error message
1972 										Melder_throw (U"Stray text after 'endif'.");
1973 									}
1974 									if (depth == 0) { lineNumber = iline; break; }   // go after `endif`
1975 									else depth --;
1976 								} else if (str32nequ (lines [iline], U"if ", 3)) {
1977 									depth ++;
1978 								}
1979 							}
1980 							if (iline > numberOfLines)
1981 								Melder_throw (U"Unmatched 'else'.");
1982 						} else if (str32nequ (command2.string, U"elsif ", 6) || str32nequ (command2.string, U"elif ", 5)) {
1983 							if (fromif) {
1984 								double value;
1985 								fromif = false;
1986 								Interpreter_numericExpression (me, command2.string + 5, & value);
1987 								if (value == 0.0) {
1988 									int depth = 0;
1989 									integer iline;
1990 									for (iline = lineNumber + 1; iline <= numberOfLines; iline ++) {
1991 										if (str32nequ (lines [iline], U"endif", 5) &&
1992 												(! Melder_staysWithinInk (lines [iline] [5]) || lines [iline] [5] == U';'))
1993 										{
1994 											const char32 *startOfInk = Melder_findInk (lines [iline] + 5);
1995 											if (startOfInk && *startOfInk != U';') {
1996 												lineNumber = iline;   // on behalf of error message
1997 												Melder_throw (U"Stray text after 'endif'.");
1998 											}
1999 											if (depth == 0) {
2000 												lineNumber = iline;
2001 												break;   // go after `endif`
2002 											} else
2003 												depth --;
2004 										} else if (str32nequ (lines [iline], U"else", 4) &&
2005 												(! Melder_staysWithinInk (lines [iline] [4]) || lines [iline] [4] == U';'))
2006 										{
2007 											const char32 *startOfInk = Melder_findInk (lines [iline] + 4);
2008 											if (startOfInk && *startOfInk != U';') {
2009 												lineNumber = iline;   // on behalf of error message
2010 												Melder_throw (U"Stray text after 'else'.");
2011 											}
2012 											if (depth == 0) {
2013 												lineNumber = iline;
2014 												break;   // go after `else`
2015 											}
2016 										} else if ((str32nequ (lines [iline], U"elsif", 5) && ! Melder_staysWithinInk (lines [iline] [5]))
2017 											|| (str32nequ (lines [iline], U"elif", 4) && ! Melder_staysWithinInk (lines [iline] [4]))) {
2018 											if (depth == 0) {
2019 												lineNumber = iline - 1;
2020 												fromif = true;
2021 												break;   // go at next 'elsif' or 'elif'
2022 											}
2023 										} else if (str32nequ (lines [iline], U"if ", 3)) {
2024 											depth ++;
2025 										}
2026 									}
2027 									if (iline > numberOfLines)
2028 										Melder_throw (U"Unmatched 'elsif'.");
2029 								}
2030 							} else {
2031 								int depth = 0;
2032 								integer iline;
2033 								for (iline = lineNumber + 1; iline <= numberOfLines; iline ++) {
2034 									if (str32nequ (lines [iline], U"endif", 5) &&
2035 											(! Melder_staysWithinInk (lines [iline] [5]) || lines [iline] [5] == U';'))
2036 									{
2037 										const char32 *startOfInk = Melder_findInk (lines [iline] + 5);
2038 										if (startOfInk && *startOfInk != U';') {
2039 											lineNumber = iline;   // on behalf of error message
2040 											Melder_throw (U"Stray text after 'endif'.");
2041 										}
2042 										if (depth == 0) {
2043 											lineNumber = iline;
2044 											break;   // go after `endif`
2045 										} else
2046 											depth --;
2047 									} else if (str32nequ (lines [iline], U"if ", 3)) {
2048 										depth ++;
2049 									}
2050 								}
2051 								if (iline > numberOfLines)
2052 									Melder_throw (U"'elsif' not matched with 'endif'.");
2053 							}
2054 						} else if (str32nequ (command2.string, U"exit", 4)) {
2055 							if (command2.string [4] == U'\0') {
2056 								lineNumber = numberOfLines;   // go after end
2057 							} else if (command2.string [4] == U' ') {
2058 								Melder_throw (command2.string + 5);
2059 							} else
2060 								fail = true;
2061 						} else if (str32nequ (command2.string, U"echo ", 5)) {
2062 							/*
2063 								Make sure that lines like "echo = 3" will not be regarded as assignments.
2064 							*/
2065 							(void) praat_executeCommand (me, command2.string);
2066 						} else
2067 							fail = true;
2068 						break;
2069 					case U'f':
2070 						if (command2.string [1] == U'o' && command2.string [2] == U'r' && command2.string [3] == U' ') {   // for_
2071 							double toValue, loopVariable;
2072 							char32 *frompos = str32str (command2.string, U" from "), *topos = str32str (command2.string, U" to ");
2073 							char32 *varpos = command2.string + 4, *endvar = frompos;
2074 							if (! topos)
2075 								Melder_throw (U"Missing \'to\' in \'for\' loop.");
2076 							if (! endvar)
2077 								endvar = topos;
2078 							while (*endvar == U' ') {
2079 								*endvar = U'\0';
2080 								endvar --;
2081 							}
2082 							while (*varpos == U' ')
2083 								varpos ++;
2084 							if (endvar - varpos < 0)
2085 								Melder_throw (U"Missing loop variable after \'for\'.");
2086 							InterpreterVariable var = Interpreter_lookUpVariable (me, varpos);
2087 							Interpreter_numericExpression (me, topos + 4, & toValue);
2088 							if (fromendfor) {
2089 								fromendfor = false;
2090 								loopVariable = var -> numericValue + 1.0;
2091 							} else if (frompos) {
2092 								*topos = U'\0';
2093 								Interpreter_numericExpression (me, frompos + 6, & loopVariable);
2094 							} else {
2095 								loopVariable = 1.0;
2096 							}
2097 							var -> numericValue = loopVariable;
2098 							if (loopVariable > toValue) {
2099 								int depth = 0;
2100 								integer iline;
2101 								for (iline = lineNumber + 1; iline <= numberOfLines; iline ++) {
2102 									if (str32nequ (lines [iline], U"endfor", 6) &&
2103 											(! Melder_staysWithinInk (lines [iline] [6]) || lines [iline] [6] == U';'))
2104 									{
2105 										const char32 *startOfInk = Melder_findInk (lines [iline] + 6);
2106 										if (startOfInk && *startOfInk != U';') {
2107 											lineNumber = iline;   // on behalf of error message
2108 											Melder_throw (U"Stray text after 'endfor'.");
2109 										}
2110 										if (depth == 0) {
2111 											lineNumber = iline;
2112 											break;   // go after 'endfor'
2113 										} else
2114 											depth --;
2115 									} else if (str32nequ (lines [iline], U"for ", 4)) {
2116 										depth ++;
2117 									}
2118 								}
2119 								if (iline > numberOfLines)
2120 									Melder_throw (U"Unmatched 'for'.");
2121 							}
2122 						} else if (str32nequ (command2.string, U"form", 4) && Melder_isEndOfInk (command2.string [4])) {
2123 							integer iline;
2124 							for (iline = lineNumber + 1; iline <= numberOfLines; iline ++)
2125 								if (str32nequ (lines [iline], U"endform", 7) && Melder_isEndOfInk (lines [iline] [7])) {
2126 									lineNumber = iline;
2127 									break;   // go after 'endform'
2128 								}
2129 							if (iline > numberOfLines)
2130 								Melder_throw (U"Unmatched 'form'.");
2131 						} else
2132 							fail = true;
2133 						break;
2134 					case U'g':
2135 						if (str32nequ (command2.string, U"goto ", 5)) {
2136 							char32 labelName [1+Interpreter_MAX_LABEL_LENGTH];
2137 							str32ncpy (labelName, command2.string + 5, 1+Interpreter_MAX_LABEL_LENGTH);
2138 							labelName [Interpreter_MAX_LABEL_LENGTH] = U'\0';
2139 							char32 *space = str32chr (labelName, U' ');
2140 							if (space == labelName)
2141 								Melder_throw (U"Missing label name after 'goto'.");
2142 							bool dojump = true;
2143 							if (space) {
2144 								double value;
2145 								*space = '\0';
2146 								Interpreter_numericExpression (me, command2.string + 6 + str32len (labelName), & value);
2147 								if (value == 0.0)
2148 									dojump = false;
2149 							}
2150 							if (dojump) {
2151 								integer ilabel = lookupLabel (me, labelName);
2152 								lineNumber = my labelLines [ilabel];   // loop will add 1
2153 							}
2154 						} else
2155 							fail = true;
2156 						break;
2157 					case U'h':
2158 						fail = true;
2159 						break;
2160 					case U'i':
2161 						if (command2.string [1] == U'f' && Melder_isHorizontalSpace (command2.string [2])) {   // if_
2162 							double value;
2163 							Interpreter_numericExpression (me, command2.string + 3, & value);
2164 							if (value == 0.0) {
2165 								int depth = 0;
2166 								integer iline;
2167 								for (iline = lineNumber + 1; iline <= numberOfLines; iline ++) {
2168 									if (str32nequ (lines [iline], U"endif", 5) &&
2169 											(! Melder_staysWithinInk (lines [iline] [5]) || lines [iline] [5] == U';'))
2170 									{
2171 										const char32 *startOfInk = Melder_findInk (lines [iline] + 5);
2172 										if (startOfInk && *startOfInk != U';') {
2173 											lineNumber = iline;   // on behalf of error message
2174 											Melder_throw (U"Stray text after 'endif'.");
2175 										}
2176 										if (depth == 0) {
2177 											lineNumber = iline;
2178 											break;   // go after 'endif'
2179 										} else
2180 											depth --;
2181 									} else if (str32nequ (lines [iline], U"else", 4) &&
2182 											(! Melder_staysWithinInk (lines [iline] [4]) || lines [iline] [4] == U';'))
2183 									{
2184 										const char32 *startOfInk = Melder_findInk (lines [iline] + 4);
2185 										if (startOfInk && *startOfInk != U';') {
2186 											lineNumber = iline;   // on behalf of error message
2187 											Melder_throw (U"Stray text after 'else'.");
2188 										}
2189 										if (depth == 0) {
2190 											lineNumber = iline;
2191 											break;   // go after 'else'
2192 										}
2193 									} else if (str32nequ (lines [iline], U"elsif ", 6) || str32nequ (lines [iline], U"elif ", 5)) {
2194 										if (depth == 0) {
2195 											lineNumber = iline - 1;
2196 											fromif = true;
2197 											break;   // go at 'elsif'
2198 										}
2199 									} else if (str32nequ (lines [iline], U"if ", 3)) {
2200 										depth ++;
2201 									}
2202 								}
2203 								if (iline > numberOfLines)
2204 									Melder_throw (U"Unmatched 'if'.");
2205 							} else if (isundef (value)) {
2206 								Melder_throw (U"The value of the 'if' condition is undefined.");
2207 							}
2208 						} else if (str32nequ (command2.string, U"inc ", 4)) {
2209 							InterpreterVariable var = Interpreter_lookUpVariable (me, command2.string + 4);
2210 							var -> numericValue += 1.0;
2211 						} else
2212 							fail = true;
2213 						break;
2214 					case U'j':
2215 						fail = true;
2216 						break;
2217 					case U'k':
2218 						fail = true;
2219 						break;
2220 					case U'l':
2221 						if (str32nequ (command2.string, U"label ", 6)) {
2222 							if (command2.string [6] == U'=')
2223 								Melder_throw (U"\"label\" cannot be used as a variable name.");
2224 							;   // ignore labels
2225 						} else
2226 							fail = true;
2227 						break;
2228 					case U'm':
2229 						fail = true;
2230 						break;
2231 					case U'n':
2232 						fail = true;
2233 						break;
2234 					case U'o':
2235 						fail = true;
2236 						break;
2237 					case U'p':
2238 						if (str32nequ (command2.string, U"procedure ", 10)) {
2239 							integer iline = lineNumber + 1;
2240 							for (; iline <= numberOfLines; iline ++) {
2241 								if (str32nequ (lines [iline], U"endproc", 7) &&
2242 										(! Melder_staysWithinInk (lines [iline] [7]) || lines [iline] [7] == U';'))
2243 								{
2244 									const char32 *startOfInk = Melder_findInk (lines [iline] + 7);
2245 									if (startOfInk && *startOfInk != U';') {
2246 										lineNumber = iline;   // on behalf of error message
2247 										Melder_throw (U"Stray text after 'endproc'.");
2248 									}
2249 									lineNumber = iline;
2250 									break;
2251 								}   // go after `endproc`
2252 							}
2253 							if (iline > numberOfLines) Melder_throw (U"Unmatched 'procedure'.");
2254 						} else if (str32nequ (command2.string, U"print", 5)) {
2255 							/*
2256 							 * Make sure that lines like "print = 3" will not be regarded as assignments.
2257 							 */
2258 							if (command2.string [5] == U' ' || (str32nequ (command2.string + 5, U"line", 4) && (command2.string [9] == U' ' || command2.string [9] == U'\0'))) {
2259 								(void) praat_executeCommand (me, command2.string);
2260 							} else
2261 								fail = true;
2262 						} else
2263 							fail = true;
2264 						break;
2265 					case U'q':
2266 						fail = true;
2267 						break;
2268 					case U'r':
2269 						if (str32nequ (command2.string, U"repeat", 6) &&
2270 								(! Melder_staysWithinInk (command2.string [6]) || command2.string [6] == U';'))
2271 						{
2272 							const char32 *startOfInk = Melder_findInk (command2.string + 6);
2273 							if (startOfInk && *startOfInk != U';')
2274 								Melder_throw (U"Stray text after 'repeat'.");
2275 							/* Ignore. */
2276 						} else
2277 							fail = true;
2278 						break;
2279 					case U's':
2280 						if (str32nequ (command2.string, U"stopwatch", 9) && ! Melder_staysWithinInk (command2.string [9])) {
2281 							(void) Melder_stopwatch ();   // reset stopwatch
2282 						} else
2283 							fail = true;
2284 						break;
2285 					case U't':
2286 						fail = true;
2287 						break;
2288 					case U'u':
2289 						if (str32nequ (command2.string, U"until ", 6)) {
2290 							double value;
2291 							Interpreter_numericExpression (me, command2.string + 6, & value);
2292 							if (value == 0.0) {
2293 								int depth = 0;
2294 								integer iline = lineNumber - 1;
2295 								for (; iline > 0; iline --) {
2296 									if (str32nequ (lines [iline], U"repeat", 6) &&
2297 											(! Melder_staysWithinInk (lines [iline] [6]) || lines [iline] [6] == U';'))
2298 									{
2299 										if (depth == 0) {
2300 											lineNumber = iline;
2301 											break;   // go after `repeat`
2302 										} else
2303 											depth --;
2304 									} else if (str32nequ (lines [iline], U"until ", 6)) {
2305 										depth ++;
2306 									}
2307 								}
2308 								if (iline <= 0)
2309 									Melder_throw (U"Unmatched 'until'.");
2310 							}
2311 						} else
2312 							fail = true;
2313 						break;
2314 					case U'v':
2315 						fail = true;
2316 						break;
2317 					case U'w':
2318 						if (str32nequ (command2.string, U"while ", 6)) {
2319 							double value;
2320 							Interpreter_numericExpression (me, command2.string + 6, & value);
2321 							if (value == 0.0) {
2322 								int depth = 0;
2323 								integer iline = lineNumber + 1;
2324 								for (; iline <= numberOfLines; iline ++) {
2325 									if (str32nequ (lines [iline], U"endwhile", 8) &&
2326 											(! Melder_staysWithinInk (lines [iline] [8]) || lines [iline] [8] == U';'))
2327 									{
2328 										const char32 *startOfInk = Melder_findInk (lines [iline] + 8);
2329 										if (startOfInk && *startOfInk != U';') {
2330 											lineNumber = iline;
2331 											Melder_throw (U"Stray text after 'endwhile'.");
2332 										}
2333 										if (depth == 0) {
2334 											lineNumber = iline;
2335 											break;   // go after `endwhile`
2336 										} else
2337 											depth --;
2338 									} else if (str32nequ (lines [iline], U"while ", 6)) {
2339 										depth ++;
2340 									}
2341 								}
2342 								if (iline > numberOfLines)
2343 									Melder_throw (U"Unmatched 'while'.");
2344 							}
2345 						} else
2346 							fail = true;
2347 						break;
2348 					case U'x':
2349 						fail = true;
2350 						break;
2351 					case U'y':
2352 						fail = true;
2353 						break;
2354 					case U'z':
2355 						fail = true;
2356 						break;
2357 					default:
2358 						fail = true;
2359 						break;
2360 				}
2361 				if (fail) {
2362 					/*
2363 						Found an unknown word starting with a nonupper-case letter, optionally preceded by a period.
2364 						See whether the word is a variable name.
2365 					*/
2366 					trace (U"found an unknown word starting with a nonupper-case letter, optionally preceded by a period");
2367 					char32 *p = & command2.string [0];
2368 					/*
2369 						Variable names consist of a sequence of letters, digits, and underscores,
2370 						optionally preceded by a period and optionally followed by a $ and/or #.
2371 					*/
2372 					if (*p == U'.')
2373 						p ++;
2374 					while (Melder_isWordCharacter (*p) || *p == U'.')
2375 						p ++;
2376 					if (*p == U'$') {
2377 						if (p [1] == U'#') {
2378 							/*
2379 								Assign to a string array variable or a string array element.
2380 							*/
2381 							static MelderString arrayName;
2382 							p ++;
2383 							*p = U'\0';   // erase the number sign temporarily
2384 							MelderString_copy (& arrayName, command2.string, U"#");
2385 							*p = U'#';   // put the number sign back
2386 							p ++;   // step over number sign
2387 							while (Melder_isHorizontalSpace (*p))
2388 								p ++;   // go to first token after array name
2389 							if (*p == U'=') {
2390 								/*
2391 									This must be an assignment to a string array variable.
2392 								*/
2393 								p ++;   // step over equals sign
2394 								while (Melder_isHorizontalSpace (*p))
2395 									p ++;   // go to first token after assignment
2396 								if (*p == U'\0')
2397 									Melder_throw (U"Missing right-hand expression in assignment to string array ", arrayName.string, U".");
2398 								InterpreterVariable var = Interpreter_lookUpVariable (me, arrayName.string);
2399 								if (isCommand (p)) {
2400 									/*
2401 										Statement like: lines$# = Get all strings
2402 									*/
2403 									bool status = praat_executeCommand (me, p);
2404 									if (! status)
2405 										var -> stringArrayValue = autoSTRVEC();   // anything can have happened, including an incorrect returnType
2406 									else if (my returnType == kInterpreter_ReturnType::STRINGARRAY_)
2407 										var -> stringArrayValue = my returnedStringArray.move();
2408 									else
2409 										Melder_throw (kInterpreter_ReturnType_errorMessage (my returnType, p),
2410 												U"; not assigned to the string array variable \"", arrayName.string, U"\".");
2411 								} else {
2412 									/*
2413 										Statement like: files$# = fileNames$# ("*.wav")
2414 									 */
2415 									STRVEC value;
2416 									bool owned;
2417 									Interpreter_stringArrayExpression (me, p, & value, & owned);
2418 									StringArrayVariable_move (var, value, owned);
2419 								}
2420 							} else if (*p == U'[') {
2421 								assignToStringArrayElement (me, ++ p, arrayName.string, valueString);
2422 							} else Melder_throw (U"Missing '=' or '[' after string array variable ", arrayName.string, U".");
2423 						} else {
2424 							/*
2425 								Assign to a string variable.
2426 							*/
2427 							trace (U"detected an assignment to a string variable");
2428 							char32 *endOfVariable = ++ p;
2429 							char32 *variableName = command2.string;
2430 							while (Melder_isHorizontalSpace (*p))
2431 								p ++;   // go to first token after variable name
2432 							if (*p == U'[') {
2433 								/*
2434 									This must be an assignment to an indexed string variable.
2435 								*/
2436 								*endOfVariable = U'\0';
2437 								static MelderString indexedVariableName;
2438 								MelderString_copy (& indexedVariableName, command2.string, U"[");
2439 								for (;;) {
2440 									p ++;   // skip opening bracket or comma
2441 									static MelderString index;
2442 									MelderString_empty (& index);
2443 									int depth = 0;
2444 									bool inString = false;
2445 									while ((depth > 0 || (*p != U',' && *p != U']') || inString) && Melder_staysWithinLine (*p)) {
2446 										MelderString_appendCharacter (& index, *p);
2447 										if (*p == U'[') {
2448 											if (! inString)
2449 												depth ++;
2450 										} else if (*p == U']') {
2451 											if (! inString)
2452 												depth --;
2453 										}
2454 										if (*p == U'"')
2455 											inString = ! inString;
2456 										p ++;
2457 									}
2458 									if (! Melder_staysWithinLine (*p))
2459 										Melder_throw (U"Missing closing bracket (]) in indexed variable.");
2460 									Formula_Result result;
2461 									Interpreter_anyExpression (me, index.string, & result);
2462 									if (result.expressionType == kFormula_EXPRESSION_TYPE_NUMERIC) {
2463 										double numericIndexValue = result. numericResult;
2464 										MelderString_append (& indexedVariableName, numericIndexValue);
2465 									} else if (result.expressionType == kFormula_EXPRESSION_TYPE_STRING) {
2466 										MelderString_append (& indexedVariableName, U"\"", result. stringResult.get(), U"\"");
2467 									}
2468 									MelderString_appendCharacter (& indexedVariableName, *p);
2469 									if (*p == U']') {
2470 										break;
2471 									}
2472 								}
2473 								variableName = indexedVariableName.string;
2474 								p ++;   // skip closing bracket
2475 							}
2476 							while (Melder_isHorizontalSpace (*p)) p ++;   // go to first token after (perhaps indexed) variable name
2477 							int typeOfAssignment;   // 0, 1, 2, 3 or 4
2478 							if (*p == U'=') {
2479 								typeOfAssignment = 0;   // assignment
2480 							} else if (*p == U'+') {
2481 								if (p [1] == U'=') {
2482 									typeOfAssignment = 1;   // adding assignment
2483 									p ++;
2484 								} else {
2485 									Melder_throw (U"Missing \"=\", \"+=\", \"<\", or \">\" after variable ", variableName, U".");
2486 								}
2487 							} else if (*p == U'<') {
2488 								typeOfAssignment = 2;   // read from file
2489 							} else if (*p == U'>') {
2490 								if (p [1] == U'>') {
2491 									typeOfAssignment = 3;   // append to file
2492 									p ++;
2493 								} else {
2494 									typeOfAssignment = 4;   // save to file
2495 								}
2496 							} else Melder_throw (U"Missing \"=\", \"+=\", \"<\", or \">\" after variable ", variableName, U".");
2497 							*endOfVariable = U'\0';
2498 							p ++;
2499 							while (Melder_isHorizontalSpace (*p)) p ++;   // go to first token after assignment or I/O symbol
2500 							if (*p == U'\0') {
2501 								if (typeOfAssignment >= 2)
2502 									Melder_throw (U"Missing file name after variable ", variableName, U".");
2503 								else
2504 									Melder_throw (U"Missing expression after variable ", variableName, U".");
2505 							}
2506 							if (typeOfAssignment >= 2) {
2507 								structMelderFile file { };
2508 								Melder_relativePathToFile (p, & file);
2509 								if (typeOfAssignment == 2) {
2510 									autostring32 stringValue = MelderFile_readText (& file);
2511 									InterpreterVariable var = Interpreter_lookUpVariable (me, variableName);
2512 									var -> stringValue = stringValue.move();
2513 								} else if (typeOfAssignment == 3) {
2514 									if (theCurrentPraatObjects != & theForegroundPraatObjects) Melder_throw (U"Commands that write to a file are not available inside pictures.");
2515 									InterpreterVariable var = Interpreter_hasVariable (me, variableName);
2516 									if (! var)
2517 										Melder_throw (U"Variable ", variableName, U" undefined.");
2518 									MelderFile_appendText (& file, var -> stringValue.get());
2519 								} else {
2520 									if (theCurrentPraatObjects != & theForegroundPraatObjects) Melder_throw (U"Commands that write to a file are not available inside pictures.");
2521 									InterpreterVariable var = Interpreter_hasVariable (me, variableName);
2522 									if (! var)
2523 										Melder_throw (U"Variable ", variableName, U" undefined.");
2524 									MelderFile_writeText (& file, var -> stringValue.get(), Melder_getOutputEncoding ());
2525 								}
2526 							} else if (isCommand (p)) {
2527 								/*
2528 									Statement like: name$ = Get name
2529 								*/
2530 								MelderString_empty (& valueString);   // empty because command may print nothing; also makes sure that valueString.string exists
2531 								autoMelderDivertInfo divert (& valueString);
2532 								bool status = praat_executeCommand (me, p);
2533 								InterpreterVariable var = Interpreter_lookUpVariable (me, variableName);
2534 								if (! status)
2535 									var -> stringValue = Melder_dup (U"");   // anything can have happened, including an incorrect returnType
2536 								else if (my returnType == kInterpreter_ReturnType::STRING_ ||
2537 									my returnType == kInterpreter_ReturnType::REAL_ ||
2538 									my returnType == kInterpreter_ReturnType::INTEGER_
2539 								)
2540 									var -> stringValue = Melder_dup (valueString.string);
2541 								else
2542 									Melder_throw (kInterpreter_ReturnType_errorMessage (my returnType, p),
2543 											U"; not assigned to the string variable \"", variableName, U"\".");
2544 							} else {
2545 								/*
2546 									Evaluate a string expression and assign the result to the variable.
2547 									Statements like:
2548 										sentence$ = subject$ + verb$ + object$
2549 										extension$ = if index (file$, ".") <> 0
2550 										... then right$ (file$, length (file$) - rindex (file$, "."))
2551 										... else "" fi
2552 								*/
2553 								trace (U"evaluating string expression");
2554 								autostring32 stringValue = Interpreter_stringExpression (me, p);
2555 								trace (U"assigning to string variable ", variableName);
2556 								if (typeOfAssignment == 1) {
2557 									InterpreterVariable var = Interpreter_hasVariable (me, variableName);
2558 									if (! var)
2559 										Melder_throw (U"The string ", variableName, U" does not exist.\n"
2560 													  U"You can increment (+=) only existing strings.");
2561 									integer oldLength = str32len (var -> stringValue.get()), extraLength = str32len (stringValue.get());
2562 									autostring32 newString = autostring32 (oldLength + extraLength, false);
2563 									str32cpy (newString.get(), var -> stringValue.get());
2564 									str32cpy (newString.get() + oldLength, stringValue.get());
2565 									var -> stringValue = newString.move();
2566 								} else {
2567 									InterpreterVariable var = Interpreter_lookUpVariable (me, variableName);
2568 									var -> stringValue = stringValue.move();
2569 								}
2570 							}
2571 						}
2572 					} else if (*p == U'#') {
2573 						if (p [1] == U'#') {
2574 							/*
2575 								Assign to a numeric matrix variable or to a matrix element.
2576 							*/
2577 							static MelderString matrixName;
2578 							p ++;   // go to second '#'
2579 							*p = U'\0';   // erase the last number sign temporarily
2580 							MelderString_copy (& matrixName, command2.string, U'#');
2581 							*p = U'#';   // put the number sign back
2582 							p ++;   // step over last number sign
2583 							while (Melder_isHorizontalSpace (*p)) p ++;   // go to first token after matrix name
2584 							if (*p == U'=') {
2585 								/*
2586 									This must be an assignment to a matrix variable.
2587 								*/
2588 								p ++;   // step over equals sign
2589 								while (Melder_isHorizontalSpace (*p)) p ++;   // go to first token after assignment
2590 								if (*p == U'\0')
2591 									Melder_throw (U"Missing right-hand expression in assignment to matrix ", matrixName.string, U".");
2592 								InterpreterVariable var = Interpreter_lookUpVariable (me, matrixName.string);
2593 								if (isCommand (p)) {
2594 									/*
2595 										Statement like: values## = Get all values
2596 									*/
2597 									bool status = praat_executeCommand (me, p);
2598 									if (! status)
2599 										var -> numericMatrixValue = autoMAT();   // anything can have happened, including an incorrect returnType
2600 									else if (my returnType == kInterpreter_ReturnType::REALMATRIX_)
2601 										var -> numericMatrixValue = my returnedRealMatrix.move();
2602 									else
2603 										Melder_throw (kInterpreter_ReturnType_errorMessage (my returnType, p),
2604 												U"; not assigned to the matrix variable \"", matrixName.string, U"\".");
2605 								} else {
2606 									MAT value;
2607 									bool owned;
2608 									Interpreter_numericMatrixExpression (me, p, & value, & owned);
2609 									NumericMatrixVariable_move (var, value, owned);
2610 								}
2611 							} else if (*p == U'[') {
2612 								assignToNumericMatrixElement (me, ++ p, matrixName.string, valueString);
2613 							} else if (*p == U'+' && p [1] == U'=') {
2614 								InterpreterVariable var = Interpreter_hasVariable (me, matrixName.string);
2615 								if (! var)
2616 									Melder_throw (U"The matrix ", matrixName.string, U" does not exist.\n"
2617 									              U"You can increment (+=) only existing matrices.");
2618 								Formula_Result result;
2619 								Interpreter_anyExpression (me, p += 2, & result);
2620 								if (result. expressionType == kFormula_EXPRESSION_TYPE_NUMERIC_MATRIX) {
2621 									NumericMatrixVariable_add (var, result. numericMatrixResult);
2622 								} else if (result. expressionType == kFormula_EXPRESSION_TYPE_NUMERIC) {
2623 									NumericMatrixVariable_add (var, result. numericResult);
2624 								} else {
2625 									Melder_throw (U"You can increment (+=) a numeric matrix only with a number or another numeric matrix.");
2626 								}
2627 							} else if (*p == U'-' && p [1] == U'=') {
2628 								InterpreterVariable var = Interpreter_hasVariable (me, matrixName.string);
2629 								if (! var)
2630 									Melder_throw (U"The matrix ", matrixName.string, U" does not exist.\n"
2631 									              U"You can decrement (-=) only existing matrices.");
2632 								Formula_Result result;
2633 								Interpreter_anyExpression (me, p += 2, & result);
2634 								if (result. expressionType == kFormula_EXPRESSION_TYPE_NUMERIC_MATRIX) {
2635 									NumericMatrixVariable_subtract (var, result. numericMatrixResult);
2636 								} else if (result. expressionType == kFormula_EXPRESSION_TYPE_NUMERIC) {
2637 									NumericMatrixVariable_subtract (var, result. numericResult);
2638 								} else {
2639 									Melder_throw (U"You can decrement (-=) a numeric matrix only with a number or another numeric matrix.");
2640 								}
2641 							} else if (*p == U'*' && p [1] == U'=') {
2642 								InterpreterVariable var = Interpreter_hasVariable (me, matrixName.string);
2643 								if (! var)
2644 									Melder_throw (U"The matrix ", matrixName.string, U" does not exist.\n"
2645 									              U"You can multiply (*=) only existing matrices.");
2646 								Formula_Result result;
2647 								Interpreter_anyExpression (me, p += 2, & result);
2648 								if (result. expressionType == kFormula_EXPRESSION_TYPE_NUMERIC_MATRIX) {
2649 									NumericMatrixVariable_multiply (var, result. numericMatrixResult);
2650 								} else if (result. expressionType == kFormula_EXPRESSION_TYPE_NUMERIC) {
2651 									NumericMatrixVariable_multiply (var, result. numericResult);
2652 								} else {
2653 									Melder_throw (U"You can multiply (*=) a numeric matrix only with a number or another numeric matrix.");
2654 								}
2655 							} else if (*p == U'/' && p [1] == U'=') {
2656 								InterpreterVariable var = Interpreter_hasVariable (me, matrixName.string);
2657 								if (! var)
2658 									Melder_throw (U"The matrix ", matrixName.string, U" does not exist.\n"
2659 									              U"You can divide (/=) only existing matrices.");
2660 								Formula_Result result;
2661 								Interpreter_anyExpression (me, p += 2, & result);
2662 								if (result. expressionType == kFormula_EXPRESSION_TYPE_NUMERIC_MATRIX) {
2663 									NumericMatrixVariable_divide (var, result. numericMatrixResult);
2664 								} else if (result. expressionType == kFormula_EXPRESSION_TYPE_NUMERIC) {
2665 									NumericMatrixVariable_divide (var, result. numericResult);
2666 								} else {
2667 									Melder_throw (U"You can divide (/=) a numeric matrix only with a number or another numeric matrix.");
2668 								}
2669 							} else if (*p == U'~') {
2670 								/*
2671 									This must be a formula assignment to a matrix variable.
2672 								*/
2673 								p ++;   // step over tilde
2674 								while (Melder_isHorizontalSpace (*p)) p ++;   // go to first token after assignment
2675 								if (*p == U'\0')
2676 									Melder_throw (U"Missing formula expression for matrix ", matrixName.string, U".");
2677 								InterpreterVariable var = Interpreter_hasVariable (me, matrixName.string);
2678 								if (! var)
2679 									Melder_throw (U"The matrix ", matrixName.string, U" does not exist.\n"
2680 										"You can assign a formula only to an existing matrix.");
2681 								static Matrix matrixObject;
2682 								if (! matrixObject)
2683 									matrixObject = Matrix_createSimple (1, 1). releaseToAmbiguousOwner();   // prevent exit-time destruction
2684 								MAT mat = var -> numericMatrixValue.get();
2685 								matrixObject -> xmax = mat.ncol + 0.5;
2686 								matrixObject -> nx = mat.ncol;
2687 								matrixObject -> ymax = mat.nrow + 0.5;
2688 								matrixObject -> ny = mat.nrow;
2689 								matrixObject -> z.cells = mat.cells;   // just a reference (YUCK)
2690 								matrixObject -> z.nrow = mat.nrow;
2691 								matrixObject -> z.ncol = mat.ncol;
2692 								Matrix_formula (matrixObject, p, me, nullptr);
2693 							} else Melder_throw (U"Missing '=' after matrix variable ", matrixName.string, U".");
2694 						} else {
2695 							/*
2696 								Assign to a numeric vector variable or to a vector element.
2697 							*/
2698 							static MelderString vectorName;
2699 							*p = U'\0';   // erase the number sign temporarily
2700 							MelderString_copy (& vectorName, command2.string, U"#");
2701 							*p = U'#';   // put the number sign back
2702 							p ++;   // step over number sign
2703 							while (Melder_isHorizontalSpace (*p))
2704 								p ++;   // go to first token after array name
2705 							if (*p == U'=') {
2706 								/*
2707 									This must be an assignment to a vector variable.
2708 								*/
2709 								p ++;   // step over equals sign
2710 								while (Melder_isHorizontalSpace (*p))
2711 									p ++;   // go to first token after assignment
2712 								if (*p == U'\0')
2713 									Melder_throw (U"Missing right-hand expression in assignment to vector ", vectorName.string, U".");
2714 								InterpreterVariable var = Interpreter_lookUpVariable (me, vectorName.string);
2715 								if (isCommand (p)) {
2716 									/*
2717 										Statement like: times# = Get all times
2718 									*/
2719 									bool status = praat_executeCommand (me, p);
2720 									if (! status)
2721 										var -> numericVectorValue = autoVEC();   // anything can have happened, including an incorrect returnType
2722 									else if (my returnType == kInterpreter_ReturnType::OBJECT_) {
2723 										var -> numericVectorValue = autoVEC();
2724 										int IOBJECT;
2725 										WHERE (SELECTED) *var -> numericVectorValue. append() = ID;
2726 									} else if (my returnType == kInterpreter_ReturnType::REALVECTOR_)
2727 										var -> numericVectorValue = my returnedRealVector.move();
2728 									else
2729 										Melder_throw (kInterpreter_ReturnType_errorMessage (my returnType, p), U"; not assigned to the vector variable \"", vectorName.string, U"\".");
2730 								} else {
2731 									VEC value;
2732 									bool owned;
2733 									Interpreter_numericVectorExpression (me, p, & value, & owned);
2734 									NumericVectorVariable_move (var, value, owned);
2735 								}
2736 							} else if (*p == U'[') {
2737 								assignToNumericVectorElement (me, ++ p, vectorName.string, valueString);
2738 							} else if (*p == U'+' && p [1] == U'=') {
2739 								InterpreterVariable var = Interpreter_hasVariable (me, vectorName.string);
2740 								if (! var)
2741 									Melder_throw (U"The vector ", vectorName.string, U" does not exist.\n"
2742 									              U"You can increment (+=) only existing vectors.");
2743 								Formula_Result result;
2744 								Interpreter_anyExpression (me, p += 2, & result);
2745 								if (result. expressionType == kFormula_EXPRESSION_TYPE_NUMERIC_VECTOR) {
2746 									NumericVectorVariable_add (var, result. numericVectorResult);
2747 								} else if (result. expressionType == kFormula_EXPRESSION_TYPE_NUMERIC) {
2748 									NumericVectorVariable_add (var, result. numericResult);
2749 								} else {
2750 									Melder_throw (U"You can increment (+=) a numeric vector only with a number or another numeric vector.");
2751 								}
2752 							} else if (*p == U'-' && p [1] == U'=') {
2753 								InterpreterVariable var = Interpreter_hasVariable (me, vectorName.string);
2754 								if (! var)
2755 									Melder_throw (U"The vector ", vectorName.string, U" does not exist.\n"
2756 									              U"You can decrement (-=) only existing vectors.");
2757 								Formula_Result result;
2758 								Interpreter_anyExpression (me, p += 2, & result);
2759 								if (result. expressionType == kFormula_EXPRESSION_TYPE_NUMERIC_VECTOR) {
2760 									NumericVectorVariable_subtract (var, result. numericVectorResult);
2761 								} else if (result. expressionType == kFormula_EXPRESSION_TYPE_NUMERIC) {
2762 									NumericVectorVariable_subtract (var, result. numericResult);
2763 								} else {
2764 									Melder_throw (U"You can decrement (-=) a numeric vector only with a number or another numeric vector.");
2765 								}
2766 							} else if (*p == U'*' && p [1] == U'=') {
2767 								InterpreterVariable var = Interpreter_hasVariable (me, vectorName.string);
2768 								if (! var)
2769 									Melder_throw (U"The vector ", vectorName.string, U" does not exist.\n"
2770 									              U"You can multiply (*=) only existing vectors.");
2771 								Formula_Result result;
2772 								Interpreter_anyExpression (me, p += 2, & result);
2773 								if (result. expressionType == kFormula_EXPRESSION_TYPE_NUMERIC_VECTOR) {
2774 									NumericVectorVariable_multiply (var, result. numericVectorResult);
2775 								} else if (result. expressionType == kFormula_EXPRESSION_TYPE_NUMERIC) {
2776 									NumericVectorVariable_multiply (var, result. numericResult);
2777 								} else {
2778 									Melder_throw (U"You can multiply (*=) a numeric vector only with a number or another numeric vector.");
2779 								}
2780 							} else if (*p == U'/' && p [1] == U'=') {
2781 								InterpreterVariable var = Interpreter_hasVariable (me, vectorName.string);
2782 								if (! var)
2783 									Melder_throw (U"The vector ", vectorName.string, U" does not exist.\n"
2784 									              U"You can divide (/=) only existing vectors.");
2785 								Formula_Result result;
2786 								Interpreter_anyExpression (me, p += 2, & result);
2787 								if (result. expressionType == kFormula_EXPRESSION_TYPE_NUMERIC_VECTOR) {
2788 									NumericVectorVariable_divide (var, result. numericVectorResult);
2789 								} else if (result. expressionType == kFormula_EXPRESSION_TYPE_NUMERIC) {
2790 									NumericVectorVariable_divide (var, result. numericResult);
2791 								} else {
2792 									Melder_throw (U"You can divide (/=) a numeric vector only with a number or another numeric vector.");
2793 								}
2794 							} else if (*p == U'~') {
2795 								/*
2796 									This must be a formula assignment to a vector variable.
2797 								*/
2798 								p ++;   // step over tilde
2799 								while (Melder_isHorizontalSpace (*p))
2800 									p ++;   // go to first token after assignment
2801 								if (*p == U'\0')
2802 									Melder_throw (U"Missing formula expression for vector ", vectorName.string, U".");
2803 								InterpreterVariable var = Interpreter_hasVariable (me, vectorName.string);
2804 								if (! var)
2805 									Melder_throw (U"The vector ", vectorName.string, U" does not exist.\n"
2806 										"You can assign a formula only to an existing vector.");
2807 								static Matrix vectorObject;
2808 								if (! vectorObject)
2809 									vectorObject = Matrix_createSimple (1, 1). releaseToAmbiguousOwner();   // prevent destruction when program ends
2810 								VEC vec = var -> numericVectorValue.get();
2811 								//vectorObject -> xmin = 0.5;
2812 								vectorObject -> xmax = vec.size + 0.5;
2813 								vectorObject -> nx = vec.size;
2814 								vectorObject -> z.cells = & vec [1];
2815 								//vectorObject -> z.nrow = 1;
2816 								vectorObject -> z.ncol = vec.size;
2817 								Matrix_formula (vectorObject, p, me, nullptr);
2818 							} else Melder_throw (U"Missing '=' or '+=' or '[' or '~' after vector variable ", vectorName.string, U".");
2819 						}
2820 					} else {
2821 						/*
2822 							Try to assign to a numeric variable.
2823 						*/
2824 						double value;
2825 						char32 *variableName = command2.string;
2826 						int typeOfAssignment = 0;   // plain assignment
2827 						if (*p == U'\0') {
2828 							/*
2829 								Command ends here: it may be a PraatShell command.
2830 							*/
2831 							(void) praat_executeCommand (me, command2.string);
2832 							continue;   // next line
2833 						}
2834 						char32 *endOfVariable = p;
2835 						while (Melder_isHorizontalSpace (*p)) p ++;
2836 						if (*p == U'=' || ((*p == U'+' || *p == U'-' || *p == U'*' || *p == U'/') && p [1] == U'=')) {
2837 							/*
2838 								This must be an assignment (though: "echo = ..." ???)
2839 							*/
2840 							typeOfAssignment = ( *p == U'+' ? 1 : *p == U'-' ? 2 : *p == U'*' ? 3 : *p == U'/' ? 4 : 0 );
2841 							*endOfVariable = U'\0';   // close variable name; FIXME: this can be any weird character, e.g. hallo&
2842 						} else if (*p == U'[') {
2843 							/*
2844 								This must be an assignment to an indexed numeric variable.
2845 							*/
2846 							*endOfVariable = U'\0';
2847 							static MelderString indexedVariableName;
2848 							MelderString_copy (& indexedVariableName, command2.string, U"[");
2849 							for (;;) {
2850 								p ++;   // skip opening bracket or comma
2851 								static MelderString index;
2852 								MelderString_empty (& index);
2853 								int depth = 0;
2854 								bool inString = false;
2855 								while ((depth > 0 || (*p != U',' && *p != U']') || inString) && Melder_staysWithinLine (*p)) {
2856 									MelderString_appendCharacter (& index, *p);
2857 									if (*p == U'[') {
2858 										if (! inString)
2859 											depth ++;
2860 									} else if (*p == U']') {
2861 										if (! inString)
2862 											depth --;
2863 									}
2864 									if (*p == U'"')
2865 										inString = ! inString;
2866 									p ++;
2867 								}
2868 								if (! Melder_staysWithinLine (*p))
2869 									Melder_throw (U"Missing closing bracket (]) in indexed variable.");
2870 								Formula_Result result;
2871 								Melder_assert (! result. stringResult);
2872 								Interpreter_anyExpression (me, index.string, & result);
2873 								if (result.expressionType == kFormula_EXPRESSION_TYPE_NUMERIC) {
2874 									const double numericIndexValue = result. numericResult;
2875 									MelderString_append (& indexedVariableName, numericIndexValue);
2876 								} else if (result.expressionType == kFormula_EXPRESSION_TYPE_STRING) {
2877 									MelderString_append (& indexedVariableName, U"\"", result. stringResult.get(), U"\"");
2878 								}
2879 								MelderString_appendCharacter (& indexedVariableName, *p);
2880 								if (*p == U']')
2881 									break;
2882 							}
2883 							variableName = indexedVariableName.string;
2884 							p ++;   // skip closing bracket
2885 							while (Melder_isHorizontalSpace (*p))
2886 								p ++;
2887 							if (*p == U'=' || ((*p == U'+' || *p == U'-' || *p == U'*' || *p == U'/') && p [1] == U'=')) {
2888 								typeOfAssignment = ( *p == U'+' ? 1 : *p == U'-' ? 2 : *p == U'*' ? 3 : *p == U'/' ? 4 : 0 );
2889 							}
2890 						} else {
2891 							/*
2892 								Not an assignment: perhaps a PraatShell command (select, echo, execute, pause ...).
2893 							*/
2894 							(void) praat_executeCommand (me, variableName);
2895 							continue;   // next line
2896 						}
2897 						p += ( typeOfAssignment == 0 ? 1 : 2 );
2898 						while (Melder_isHorizontalSpace (*p))
2899 							p ++;
2900 						if (*p == U'\0')
2901 							Melder_throw (U"Missing expression after variable ", variableName, U".");
2902 						/*
2903 							Three classes of assignments:
2904 								var = formula
2905 								var = Query
2906 								var = Object creation
2907 						*/
2908 						if (isCommand (p)) {
2909 							/*
2910 								Get the value of the query.
2911 							*/
2912 							MelderString_empty (& valueString);
2913 							autoMelderDivertInfo divert (& valueString);
2914 							MelderString_appendCharacter (& valueString, 1);   // will be overwritten by something totally different if any MelderInfo function is called...
2915 							bool status = praat_executeCommand (me, p);
2916 							if (! status) {
2917 								value = undefined;   // anything can have happened, including an incorrect return type
2918 							} else if (my returnType == kInterpreter_ReturnType::OBJECT_) {
2919 								int IOBJECT, selectedObject = 0, numberOfSelectedObjects = 0;
2920 								WHERE (SELECTED) { selectedObject = IOBJECT; numberOfSelectedObjects += 1; }
2921 								if (numberOfSelectedObjects > 1)
2922 									Melder_throw (U"Multiple objects selected. Cannot assign object IDs to numeric variable. "
2923 											"Perhaps use a vector variable instead.");
2924 								if (numberOfSelectedObjects == 0)
2925 									Melder_throw (U"No objects selected. Cannot assign object ID to variable.");
2926 								value = theCurrentPraatObjects -> list [selectedObject]. id;
2927 							} else if (my returnType == kInterpreter_ReturnType::REAL_ || my returnType == kInterpreter_ReturnType::INTEGER_) {
2928 								value = Melder_atof (valueString.string);   // including --undefined--
2929 							} else
2930 								Melder_throw (kInterpreter_ReturnType_errorMessage (my returnType, p),
2931 										U"; not assigned to the numeric variable \"", variableName, U"\".");
2932 						} else {
2933 							/*
2934 								Get the value of the formula.
2935 							*/
2936 							Interpreter_numericExpression (me, p, & value);
2937 						}
2938 						/*
2939 							Assign the value to a variable.
2940 						*/
2941 						if (typeOfAssignment == 0) {
2942 							/*
2943 								Use an existing variable, or create a new one.
2944 							*/
2945 							//Melder_casual (U"looking up variable ", variableName);
2946 							InterpreterVariable var = Interpreter_lookUpVariable (me, variableName);
2947 							var -> numericValue = value;
2948 						} else {
2949 							/*
2950 								Modify an existing variable.
2951 							*/
2952 							InterpreterVariable var = Interpreter_hasVariable (me, variableName);
2953 							if (! var)
2954 								Melder_throw (U"The variable ", variableName, U" does not exist. You can modify only existing variables.");
2955 							if (isundef (var -> numericValue)) {
2956 								/* Keep it that way. */
2957 							} else {
2958 								if (typeOfAssignment == 1) {
2959 									var -> numericValue += value;
2960 								} else if (typeOfAssignment == 2) {
2961 									var -> numericValue -= value;
2962 								} else if (typeOfAssignment == 3) {
2963 									var -> numericValue *= value;
2964 								} else if (value == 0) {
2965 									var -> numericValue = undefined;
2966 								} else {
2967 									var -> numericValue /= value;
2968 								}
2969 							}
2970 						}
2971 					}
2972 				} // endif fail
2973 				if (assertErrorLineNumber != 0 && assertErrorLineNumber != lineNumber) {
2974 					const integer save_assertErrorLineNumber = assertErrorLineNumber;
2975 					assertErrorLineNumber = 0;
2976 					Melder_throw (U"Script assertion fails in line ", save_assertErrorLineNumber,
2977 							U": error « ", assertErrorString.string, U" » not raised. Instead: no error.");
2978 
2979 				}
2980 			} catch (MelderError) {
2981 				//	Melder_casual (U"Error: << ", Melder_getError(),
2982 				//		U" >>\nassertErrorLineNumber: ", assertErrorLineNumber,
2983 				//		U"\nlineNumber: ", lineNumber,
2984 				//		U"\nAssert error string: << ", assertErrorString.string,
2985 				//		U" >>\n"
2986 				//	);
2987 				if (Melder_hasCrash ())
2988 					throw;
2989 				if (assertErrorLineNumber == 0) {
2990 					throw;
2991 				} else if (assertErrorLineNumber != lineNumber) {
2992 					if (str32str (Melder_getError (), assertErrorString.string)) {
2993 						Melder_clearError ();
2994 						assertErrorLineNumber = 0;
2995 					} else {
2996 						autostring32 errorCopy_nothrow = Melder_dup_f (Melder_getError ());
2997 						Melder_clearError ();
2998 						Melder_throw (U"Script assertion fails in line ", assertErrorLineNumber,
2999 							U": error « ", assertErrorString.string, U" » not raised. Instead:\n",
3000 							errorCopy_nothrow.get());
3001 					}
3002 				}
3003 			}
3004 		} // endfor lineNumber
3005 		my numberOfLabels = 0;
3006 		my running = false;
3007 		my stopped = false;
3008 	} catch (MelderError) {
3009 		if (lineNumber > 0) {
3010 			const bool normalExplicitExit = str32nequ (lines [lineNumber], U"exit ", 5) || Melder_hasError (U"Script exited.");
3011 			if (! normalExplicitExit && ! assertionFailed) {   // don't show the message twice!
3012 				while (lines [lineNumber] [0] == U'\0') {   // did this use to be a continuation line?
3013 					lineNumber --;
3014 					Melder_assert (lineNumber > 0);   // originally empty lines that stayed empty should not generate errors
3015 				}
3016 				Melder_appendError (U"Script line ", lineNumber, U" not performed or completed:\n« ", lines [lineNumber], U" »");
3017 			}
3018 		}
3019 		my numberOfLabels = 0;
3020 		my running = false;
3021 		my stopped = false;
3022 		if (Melder_hasCrash ()) {
3023 			throw;
3024 		} else if (str32equ (Melder_getError (), U"\nScript exited.\n")) {
3025 			Melder_clearError ();
3026 		} else {
3027 			throw;
3028 		}
3029 	}
3030 }
3031 
Interpreter_stop(Interpreter me)3032 void Interpreter_stop (Interpreter me) {
3033 //Melder_casual (U"Interpreter_stop in: ", Melder_pointer (me));
3034 	my stopped = true;
3035 //Melder_casual (U"Interpreter_stop out: ", Melder_pointer (me));
3036 }
3037 
Interpreter_voidExpression(Interpreter me,conststring32 expression)3038 void Interpreter_voidExpression (Interpreter me, conststring32 expression) {
3039 	Formula_compile (me, nullptr, expression, kFormula_EXPRESSION_TYPE_NUMERIC, false);
3040 	Formula_Result result;
3041 	Formula_run (0, 0, & result);
3042 }
3043 
Interpreter_numericExpression(Interpreter me,conststring32 expression,double * out_value)3044 void Interpreter_numericExpression (Interpreter me, conststring32 expression, double *out_value) {
3045 	Melder_assert (out_value);
3046 	if (str32str (expression, U"(=")) {
3047 		*out_value = Melder_atof (expression);
3048 	} else {
3049 		Formula_compile (me, nullptr, expression, kFormula_EXPRESSION_TYPE_NUMERIC, false);
3050 		Formula_Result result;
3051 		Formula_run (0, 0, & result);
3052 		*out_value = result. numericResult;
3053 	}
3054 }
3055 
Interpreter_numericVectorExpression(Interpreter me,conststring32 expression,VEC * out_value,bool * out_owned)3056 void Interpreter_numericVectorExpression (Interpreter me, conststring32 expression, VEC *out_value, bool *out_owned) {
3057 	Formula_compile (me, nullptr, expression, kFormula_EXPRESSION_TYPE_NUMERIC_VECTOR, false);
3058 	Formula_Result result;
3059 	Formula_run (0, 0, & result);
3060 	*out_value = result. numericVectorResult;
3061 	*out_owned = result. owned;
3062 	result. owned = false;
3063 }
3064 
Interpreter_numericMatrixExpression(Interpreter me,conststring32 expression,MAT * out_value,bool * out_owned)3065 void Interpreter_numericMatrixExpression (Interpreter me, conststring32 expression, MAT *out_value, bool *out_owned) {
3066 	Formula_compile (me, nullptr, expression, kFormula_EXPRESSION_TYPE_NUMERIC_MATRIX, false);
3067 	Formula_Result result;
3068 	Formula_run (0, 0, & result);
3069 	*out_value = result. numericMatrixResult;
3070 	*out_owned = result. owned;
3071 	result. owned = false;
3072 }
3073 
Interpreter_stringExpression(Interpreter me,conststring32 expression)3074 autostring32 Interpreter_stringExpression (Interpreter me, conststring32 expression) {
3075 	Formula_compile (me, nullptr, expression, kFormula_EXPRESSION_TYPE_STRING, false);
3076 	Formula_Result result;
3077 	Formula_run (0, 0, & result);
3078 	return result. stringResult.move();
3079 }
3080 
Interpreter_stringArrayExpression(Interpreter me,conststring32 expression,STRVEC * out_value,bool * out_owned)3081 void Interpreter_stringArrayExpression (Interpreter me, conststring32 expression, STRVEC *out_value, bool *out_owned) {
3082 	Formula_compile (me, nullptr, expression, kFormula_EXPRESSION_TYPE_STRING_ARRAY, false);
3083 	Formula_Result result;
3084 	Formula_run (0, 0, & result);
3085 	*out_value = result. stringArrayResult;
3086 	*out_owned = result. owned;
3087 	result. owned = false;
3088 }
3089 
Interpreter_anyExpression(Interpreter me,conststring32 expression,Formula_Result * out_result)3090 void Interpreter_anyExpression (Interpreter me, conststring32 expression, Formula_Result *out_result) {
3091 	Formula_compile (me, nullptr, expression, kFormula_EXPRESSION_TYPE_UNKNOWN, false);
3092 	Formula_run (0, 0, out_result);
3093 }
3094 
3095 /* End of file Interpreter.cpp */
3096