1 /****************************************************************************
2 **
3 ** This file is part of GAP, a system for computational discrete algebra.
4 **
5 ** Copyright of GAP belongs to its developers, whose names are too numerous
6 ** to list here. Please refer to the COPYRIGHT file for details.
7 **
8 ** SPDX-License-Identifier: GPL-2.0-or-later
9 **
10 ** This module contains the functions to read expressions and statements.
11 */
12
13 #include "read.h"
14
15 #include "bool.h"
16 #include "calls.h"
17 #include "code.h"
18 #include "funcs.h"
19 #include "gapstate.h"
20 #include "gvars.h"
21 #include "intrprtr.h"
22 #include "io.h"
23 #include "modules.h"
24 #include "plist.h"
25 #include "records.h"
26 #include "scanner.h"
27 #include "stats.h"
28 #include "stringobj.h"
29 #include "sysopt.h"
30 #include "vars.h"
31
32 #ifdef HPCGAP
33 #include "hpc/thread.h"
34 #endif
35
36
37 struct ReaderState {
38
39 /****************************************************************************
40 **
41 *V StackNams . . . . . . . . . . . . . stack of local variables names lists
42 **
43 ** 'StackNams' is a stack of local variables names lists. A new names list
44 ** is pushed onto this stack when the reader begins to read a new function
45 ** expression (after reading the argument list and the local variables
46 ** list), and popped again when the reader has finished reading the function
47 ** expression (after reading the 'end').
48 */
49 Obj StackNams;
50
51 /****************************************************************************
52 **
53 *V ReadTop . . . . . . . . . . . . . . . . . . . . . . top level expression
54 *V ReadTilde . . . . . . . . . . . . . . . . . . . . . . . . . . tilde read
55 **
56 ** 'ReadTop' is 0 if the reader is currently not reading a list or record
57 ** expression. 'ReadTop' is 1 if the reader is currently reading an outmost
58 ** list or record expression. 'ReadTop' is larger than 1 if the reader is
59 ** currently reading a nested list or record expression.
60 **
61 ** 'ReadTilde' is 1 if the reader has read a reference to a '~' symbol
62 ** within the current outmost list or record expression.
63 */
64 UInt ReadTop;
65 UInt ReadTilde;
66
67 /****************************************************************************
68 **
69 *V CurrLHSGVar . . . . . . . . . . . . current left hand side of assignment
70 **
71 ** 'CurrLHSGVar' is the current left hand side of an assignment. It is used
72 ** to prevent undefined global variable warnings, when reading a recursive
73 ** function.
74 */
75 UInt CurrLHSGVar;
76
77
78 UInt CurrentGlobalForLoopVariables[100];
79 UInt CurrentGlobalForLoopDepth;
80
81 UInt LoopNesting;
82
83 };
84
85 static ModuleStateOffset ReaderStateOffset = -1;
86
ReaderState(void)87 extern inline struct ReaderState * ReaderState(void)
88 {
89 return (struct ReaderState *)StateSlotsAtOffset(ReaderStateOffset);
90 }
91
92
93 /****************************************************************************
94 **
95 ** The constructs <Expr> and <Statements> may have themselves as subpart,
96 ** e.g., '<Var>( <Expr> )' is <Expr> and 'if <Expr> then <Statements> fi;'
97 ** is <Statements>. The functions 'ReadExpr' and 'ReadStats' must therefore
98 ** be declared forward.
99 */
100 static void ReadExpr(ScannerState * s, TypSymbolSet follow, Char mode);
101
102 static UInt ReadStats(ScannerState * s, TypSymbolSet follow);
103
104 static void ReadFuncExprAbbrevSingle(ScannerState * s, TypSymbolSet follow);
105
106 static void ReadAtom(ScannerState * s, TypSymbolSet follow, Char mode);
107
PushGlobalForLoopVariable(UInt var)108 void PushGlobalForLoopVariable( UInt var)
109 {
110 struct ReaderState * rs = ReaderState();
111 if (rs->CurrentGlobalForLoopDepth < 100)
112 rs->CurrentGlobalForLoopVariables[rs->CurrentGlobalForLoopDepth] = var;
113 rs->CurrentGlobalForLoopDepth++;
114 }
115
PopGlobalForLoopVariable(void)116 void PopGlobalForLoopVariable( void )
117 {
118 GAP_ASSERT(ReaderState()->CurrentGlobalForLoopDepth);
119 ReaderState()->CurrentGlobalForLoopDepth--;
120 }
121
GlobalComesFromEnclosingForLoop(UInt var)122 static UInt GlobalComesFromEnclosingForLoop (UInt var)
123 {
124 struct ReaderState * rs = ReaderState();
125 for (UInt i = 0; i < rs->CurrentGlobalForLoopDepth; i++) {
126 if (i == 100)
127 return 0;
128 if (rs->CurrentGlobalForLoopVariables[i] == var)
129 return 1;
130 }
131 return 0;
132 }
133
134 // match either a semicolon or a dual semicolon
MatchSemicolon(ScannerState * s,TypSymbolSet skipto)135 static void MatchSemicolon(ScannerState * s, TypSymbolSet skipto)
136 {
137 Match(s, s->Symbol == S_DUALSEMICOLON ? S_DUALSEMICOLON : S_SEMICOLON,
138 ";", skipto);
139 }
140
141 // Search the plist 'nams' for a string equal to 'value' between and
142 // including index 'start' and 'end' and return its index; return 0 if not
143 // found.
findValueInNams(Obj nams,const Char * val,UInt start,UInt end)144 static UInt findValueInNams(Obj nams, const Char * val, UInt start, UInt end)
145 {
146 GAP_ASSERT(LEN_PLIST(nams) < MAX_FUNC_LVARS);
147 for (UInt i = start; i <= end; i++) {
148 if (strcmp(CONST_CSTR_STRING(ELM_PLIST(nams, i)), val) == 0) {
149 return i;
150 }
151 }
152 // not found
153 return 0;
154 }
155
156 /****************************************************************************
157 **
158 *F * * * * * * * * * * read symbols and call interpreter * * * * * * * * * *
159 */
160
161
162 /* This function reads the options part at the end of a function call
163 The syntax is
164
165 <options> := <option> [, <options> ]
166 <option> := <Ident> | '(' <Expr> ')' [ ':=' <Expr> ]
167
168 empty options lists are handled further up
169 */
ReadFuncCallOption(ScannerState * s,TypSymbolSet follow)170 static void ReadFuncCallOption(ScannerState * s, TypSymbolSet follow)
171 {
172 volatile UInt rnam; // record component name
173 if (s->Symbol == S_IDENT) {
174 rnam = RNamName(s->Value);
175 Match(s, S_IDENT, "identifier", S_COMMA | follow);
176 TRY_IF_NO_ERROR { IntrFuncCallOptionsBeginElmName(rnam); }
177 }
178 else if (s->Symbol == S_LPAREN) {
179 Match(s, S_LPAREN, "(", S_COMMA | follow);
180 ReadExpr(s, follow, 'r');
181 Match(s, S_RPAREN, ")", S_COMMA | follow);
182 TRY_IF_NO_ERROR { IntrFuncCallOptionsBeginElmExpr(); }
183 }
184 else {
185 SyntaxError(s, "Identifier expected");
186 }
187 if (s->Symbol == S_ASSIGN) {
188 Match(s, S_ASSIGN, ":=", S_COMMA | follow);
189 ReadExpr(s, S_COMMA | S_RPAREN | follow, 'r');
190 TRY_IF_NO_ERROR { IntrFuncCallOptionsEndElm(); }
191 }
192 else {
193 TRY_IF_NO_ERROR { IntrFuncCallOptionsEndElmEmpty(); }
194 }
195 }
196
ReadFuncCallOptions(ScannerState * s,TypSymbolSet follow)197 static void ReadFuncCallOptions(ScannerState * s, TypSymbolSet follow)
198 {
199 volatile UInt nr;
200 TRY_IF_NO_ERROR { IntrFuncCallOptionsBegin( ); }
201 ReadFuncCallOption(s, follow);
202 nr = 1;
203 while (s->Symbol == S_COMMA) {
204 Match(s, S_COMMA, ",", follow);
205 ReadFuncCallOption(s, follow);
206 nr++;
207 }
208 TRY_IF_NO_ERROR {
209 IntrFuncCallOptionsEnd( nr );
210 }
211 }
212
213 static Obj GAPInfo;
214
215 static UInt WarnOnUnboundGlobalsRNam;
216
217 /****************************************************************************
218 **
219 ** type must be one of the following:
220 **
221 ** R_LVAR: local var with id <var>
222 ** R_HVAR: high var with id <var>
223 ** R_DVAR: debug var with id <var>, at nesting level <nest0>
224 ** R_GVAR: global var with id <var>
225 ** R_ELM_LIST: list access l[idx], uses <narg>, <level>
226 ** R_ELMS_LIST: list access l{indices}, uses <level>
227 ** R_ELM_POSOBJ: pos obj access obj![idx]
228 ** R_ELM_REC_NAME: record access r.<rnam>
229 ** R_ELM_REC_EXPR record access r.(expr)
230 ** R_ELM_COMOBJ_NAME: com obj access obj.<rnam>
231 ** R_ELM_COMOBJ_EXPR: com obj access obj.(expr)
232 ** R_FUNCCALL function call without options & with <narg> arguments
233 ** R_FUNCCALL_OPTS function call with options and with <narg> arguments
234 */
235 enum REFTYPE {
236 R_INVALID,
237 R_LVAR,
238 R_HVAR,
239 R_DVAR,
240 R_GVAR,
241 R_ELM_LIST,
242 R_ELMS_LIST,
243 R_ELM_POSOBJ,
244 R_ELM_REC_NAME,
245 R_ELM_REC_EXPR,
246 R_ELM_COMOBJ_NAME,
247 R_ELM_COMOBJ_EXPR,
248 R_FUNCCALL,
249 R_FUNCCALL_OPTS,
250 };
251
252 typedef struct {
253 UInt1 type;
254 UInt1 _padding;
255 union {
256 UInt2 nest0;
257 UInt2 level;
258 };
259 union {
260 UInt4 var;
261 UInt4 narg;
262 UInt4 rnam;
263 };
264 } LHSRef;
265
266 GAP_STATIC_ASSERT(sizeof(LHSRef) <= 8, "LHSRef is too big");
267
268 /****************************************************************************
269 **
270 */
EvalRef(const LHSRef ref,Int needExpr)271 static UInt EvalRef(const LHSRef ref, Int needExpr)
272 {
273 TRY_IF_NO_ERROR
274 {
275 switch (ref.type) {
276 case R_LVAR:
277 IntrRefLVar(ref.var);
278 break;
279 case R_HVAR:
280 IntrRefHVar(ref.var);
281 break;
282 case R_DVAR:
283 IntrRefDVar(ref.var, ref.nest0);
284 break;
285 case R_GVAR:
286 IntrRefGVar(ref.var);
287 break;
288 case R_ELM_LIST:
289 if (ref.level == 0)
290 IntrElmList(ref.narg);
291 else
292 IntrElmListLevel(ref.narg, ref.level);
293 return ref.level;
294 case R_ELMS_LIST:
295 if (ref.level == 0)
296 IntrElmsList();
297 else
298 IntrElmsListLevel(ref.level);
299 return ref.level + 1;
300 case R_ELM_POSOBJ:
301 IntrElmPosObj();
302 break;
303 case R_ELM_REC_NAME:
304 IntrElmRecName(ref.rnam);
305 break;
306 case R_ELM_REC_EXPR:
307 IntrElmRecExpr();
308 break;
309 case R_ELM_COMOBJ_NAME:
310 IntrElmComObjName(ref.rnam);
311 break;
312 case R_ELM_COMOBJ_EXPR:
313 IntrElmComObjExpr();
314 break;
315 case R_FUNCCALL:
316 IntrFuncCallEnd(needExpr, 0, ref.narg);
317 break;
318 case R_FUNCCALL_OPTS:
319 IntrFuncCallEnd(needExpr, 1, ref.narg);
320 break;
321 case R_INVALID:
322 default:
323 // This should never be reached
324 Panic("Parse error in EvalRef");
325 }
326 }
327 return 0;
328 }
329
AssignRef(const LHSRef ref)330 static void AssignRef(const LHSRef ref)
331 {
332 TRY_IF_NO_ERROR
333 {
334 switch (ref.type) {
335 case R_LVAR:
336 IntrAssLVar(ref.var);
337 break;
338 case R_HVAR:
339 IntrAssHVar(ref.var);
340 break;
341 case R_DVAR:
342 IntrAssDVar(ref.var, ref.nest0);
343 break;
344 case R_GVAR:
345 IntrAssGVar(ref.var);
346 break;
347 case R_ELM_LIST:
348 if (ref.level == 0)
349 IntrAssList(ref.narg);
350 else
351 IntrAssListLevel(ref.narg, ref.level);
352 break;
353 case R_ELMS_LIST:
354 if (ref.level == 0)
355 IntrAsssList();
356 else
357 IntrAsssListLevel(ref.level);
358 break;
359 case R_ELM_POSOBJ:
360 IntrAssPosObj();
361 break;
362 case R_ELM_REC_NAME:
363 IntrAssRecName(ref.rnam);
364 break;
365 case R_ELM_REC_EXPR:
366 IntrAssRecExpr();
367 break;
368 case R_ELM_COMOBJ_NAME:
369 IntrAssComObjName(ref.rnam);
370 break;
371 case R_ELM_COMOBJ_EXPR:
372 IntrAssComObjExpr();
373 break;
374 case R_INVALID:
375 case R_FUNCCALL:
376 case R_FUNCCALL_OPTS:
377 default:
378 // This should never be reached
379 Panic("Parse error in AssignRef");
380 }
381 }
382 }
383
UnbindRef(ScannerState * s,const LHSRef ref)384 static void UnbindRef(ScannerState * s, const LHSRef ref)
385 {
386 TRY_IF_NO_ERROR
387 {
388 switch (ref.type) {
389 case R_LVAR:
390 IntrUnbLVar(ref.var);
391 break;
392 case R_HVAR:
393 IntrUnbHVar(ref.var);
394 break;
395 case R_DVAR:
396 IntrUnbDVar(ref.var, ref.nest0);
397 break;
398 case R_GVAR:
399 IntrUnbGVar(ref.var);
400 break;
401 case R_ELM_LIST:
402 IntrUnbList(ref.narg);
403 break;
404 case R_ELM_POSOBJ:
405 IntrUnbPosObj();
406 break;
407 case R_ELM_REC_NAME:
408 IntrUnbRecName(ref.rnam);
409 break;
410 case R_ELM_REC_EXPR:
411 IntrUnbRecExpr();
412 break;
413 case R_ELM_COMOBJ_NAME:
414 IntrUnbComObjName(ref.rnam);
415 break;
416 case R_ELM_COMOBJ_EXPR:
417 IntrUnbComObjExpr();
418 break;
419 case R_INVALID:
420 case R_ELMS_LIST:
421 case R_FUNCCALL:
422 case R_FUNCCALL_OPTS:
423 default:
424 SyntaxError(s, "Illegal operand for 'Unbind'");
425 }
426 }
427 }
428
IsBoundRef(ScannerState * s,const LHSRef ref)429 static void IsBoundRef(ScannerState * s, const LHSRef ref)
430 {
431 TRY_IF_NO_ERROR
432 {
433 switch (ref.type) {
434 case R_LVAR:
435 IntrIsbLVar(ref.var);
436 break;
437 case R_HVAR:
438 IntrIsbHVar(ref.var);
439 break;
440 case R_DVAR:
441 IntrIsbDVar(ref.var, ref.nest0);
442 break;
443 case R_GVAR:
444 IntrIsbGVar(ref.var);
445 break;
446 case R_ELM_LIST:
447 IntrIsbList(ref.narg);
448 break;
449 case R_ELM_POSOBJ:
450 IntrIsbPosObj();
451 break;
452 case R_ELM_REC_NAME:
453 IntrIsbRecName(ref.rnam);
454 break;
455 case R_ELM_REC_EXPR:
456 IntrIsbRecExpr();
457 break;
458 case R_ELM_COMOBJ_NAME:
459 IntrIsbComObjName(ref.rnam);
460 break;
461 case R_ELM_COMOBJ_EXPR:
462 IntrIsbComObjExpr();
463 break;
464 case R_INVALID:
465 case R_ELMS_LIST:
466 case R_FUNCCALL:
467 case R_FUNCCALL_OPTS:
468 default:
469 SyntaxError(s, "Illegal operand for 'IsBound'");
470 }
471 }
472 }
473
474
475 /****************************************************************************
476 **
477 */
ReadSelector(ScannerState * s,TypSymbolSet follow,UInt level)478 static LHSRef ReadSelector(ScannerState * s, TypSymbolSet follow, UInt level)
479 {
480 volatile LHSRef ref;
481
482 ref.type = R_INVALID;
483
484 // <Var> '[' <Expr> ']' list selector
485 if (s->Symbol == S_LBRACK) {
486 Match(s, S_LBRACK, "[", follow);
487 ReadExpr(s, S_COMMA | S_RBRACK | follow, 'r');
488 ref.narg = 1;
489 while (s->Symbol == S_COMMA) {
490 Match(s, S_COMMA, ",", follow | S_RBRACK);
491 ReadExpr(s, S_COMMA | S_RBRACK | follow, 'r');
492 ref.narg++;
493 }
494 if (ref.narg > 2) {
495 SyntaxError(s, "'[]' only supports 1 or 2 indices");
496 }
497 Match(s, S_RBRACK, "]", follow);
498 ref.type = R_ELM_LIST;
499 ref.level = level;
500 }
501
502 // <Var> '{' <Expr> '}' sublist selector
503 else if (s->Symbol == S_LBRACE) {
504 Match(s, S_LBRACE, "{", follow);
505 ReadExpr(s, S_RBRACE | follow, 'r');
506 Match(s, S_RBRACE, "}", follow);
507 ref.type = R_ELMS_LIST;
508 ref.level = level;
509 }
510
511 // <Var> '![' <Expr> ']' list selector
512 else if (s->Symbol == S_BLBRACK) {
513 Match(s, S_BLBRACK, "![", follow);
514 ReadExpr(s, S_RBRACK | follow, 'r');
515 Match(s, S_RBRACK, "]", follow);
516 ref.type = R_ELM_POSOBJ;
517 }
518
519 // <Var> '.' <Ident> record selector
520 else if (s->Symbol == S_DOT) {
521 Match(s, S_DOT, ".", follow);
522 if (s->Symbol == S_IDENT || s->Symbol == S_INT) {
523 ref.rnam = RNamName(s->Value);
524 Match(s, s->Symbol, "identifier", follow);
525 ref.type = R_ELM_REC_NAME;
526 }
527 else if (s->Symbol == S_LPAREN) {
528 Match(s, S_LPAREN, "(", follow);
529 ReadExpr(s, S_RPAREN | follow, 'r');
530 Match(s, S_RPAREN, ")", follow);
531 ref.type = R_ELM_REC_EXPR;
532 }
533 else {
534 SyntaxError(s, "Record component name expected");
535 }
536 }
537
538 // <Var> '!.' <Ident> record selector
539 else if (s->Symbol == S_BDOT) {
540 Match(s, S_BDOT, "!.", follow);
541 if (s->Symbol == S_IDENT || s->Symbol == S_INT) {
542 ref.rnam = RNamName(s->Value);
543 Match(s, s->Symbol, "identifier", follow);
544 ref.type = R_ELM_COMOBJ_NAME;
545 }
546 else if (s->Symbol == S_LPAREN) {
547 Match(s, S_LPAREN, "(", follow);
548 ReadExpr(s, S_RPAREN | follow, 'r');
549 Match(s, S_RPAREN, ")", follow);
550 ref.type = R_ELM_COMOBJ_EXPR;
551 }
552 else {
553 SyntaxError(s, "Record component name expected");
554 }
555 }
556
557 // <Var> '(' [ <Expr> { ',' <Expr> } ] ')' function call
558 else if (s->Symbol == S_LPAREN) {
559 Match(s, S_LPAREN, "(", follow);
560 TRY_IF_NO_ERROR
561 {
562 IntrFuncCallBegin();
563 }
564 ref.narg = 0;
565 if (s->Symbol != S_RPAREN && s->Symbol != S_COLON) {
566 ReadExpr(s, S_RPAREN | follow, 'r');
567 ref.narg++;
568 }
569 while (s->Symbol == S_COMMA) {
570 Match(s, S_COMMA, ",", follow);
571 ReadExpr(s, S_RPAREN | follow, 'r');
572 ref.narg++;
573 }
574 ref.type = R_FUNCCALL;
575 if (s->Symbol == S_COLON) {
576 Match(s, S_COLON, ":", follow);
577 if (s->Symbol != S_RPAREN) { // save work for empty options
578 ReadFuncCallOptions(s, S_RPAREN | follow);
579 ref.type = R_FUNCCALL_OPTS;
580 }
581 }
582 Match(s, S_RPAREN, ")", follow);
583 }
584
585 return ref;
586 }
587
ReadReferenceModifiers(ScannerState * s,TypSymbolSet follow)588 static void ReadReferenceModifiers(ScannerState * s, TypSymbolSet follow)
589 {
590 UInt level = 0;
591
592 // read one or more selectors
593 while (IS_IN(s->Symbol, S_LPAREN | S_LBRACK | S_LBRACE | S_DOT)) {
594 LHSRef ref = ReadSelector(s, follow, level);
595 level = EvalRef(ref, 1);
596 }
597 }
598
599 /****************************************************************************
600 **
601 *F ReadVar( <follow>, <mode> ) . . . . . . . . . . . read a variable
602 **
603 ** 'ReadVar' reads a variable identifier. In case of an error it skips all
604 ** symbols up to one contained in <follow>.
605 **
606 ** <Ident> := a|b|..|z|A|B|..|Z { a|b|..|z|A|B|..|Z|0|..|9|_ }
607 */
ReadVar(ScannerState * s,TypSymbolSet follow)608 static LHSRef ReadVar(ScannerState * s, TypSymbolSet follow)
609 {
610 LHSRef ref = { R_INVALID, 0, {0}, {0} };
611
612 Obj nams; // list of names of local vars.
613 Obj lvars; // environment
614 UInt nest; // nesting level of a higher var.
615 Obj lvars0; // environment
616 UInt nest0; // nesting level of a higher var.
617 UInt indx; // index of a local variable
618 Char varname[MAX_VALUE_LEN]; // copy of variable name
619
620 /* all variables must begin with an identifier */
621 if (s->Symbol != S_IDENT) {
622 SyntaxError(s, "Identifier expected");
623 return ref;
624 }
625
626 // try to look up the variable on the stack of local variables
627 const UInt countNams = LEN_PLIST(ReaderState()->StackNams);
628 for (nest = 0; nest < countNams; nest++) {
629 #ifndef SYS_IS_64_BIT
630 if (nest >= MAX_FUNC_EXPR_NESTING) {
631 Pr("Warning: abandoning search for %g at %dth higher frame\n",
632 (Int)s->Value, MAX_FUNC_EXPR_NESTING);
633 break;
634 }
635 #endif
636 nams = ELM_PLIST(ReaderState()->StackNams, countNams - nest);
637 indx = findValueInNams(nams, s->Value, 1, LEN_PLIST(nams));
638 if (indx != 0) {
639 ref.type = (nest == 0) ? R_LVAR : R_HVAR;
640 ref.var = (nest << MAX_FUNC_LVARS_BITS) + indx;
641 break;
642 }
643 }
644
645 // try to look up the variable on the error stack;
646 // the outer loop runs up the calling stack, while the inner loop runs
647 // up the static definition stack for each call function
648 lvars0 = STATE(ErrorLVars);
649 nest0 = 0;
650 while (ref.type == R_INVALID && lvars0 != 0 && lvars0 != STATE(BottomLVars)) {
651 lvars = lvars0;
652 nest = 0;
653 while (ref.type == R_INVALID && lvars != 0 && lvars != STATE(BottomLVars)) {
654 nams = NAMS_FUNC(FUNC_LVARS(lvars));
655 if (nams != 0) {
656 indx = findValueInNams(nams, s->Value, 1, LEN_PLIST(nams));
657 if (indx) {
658 ref.type = R_DVAR;
659 ref.var = (nest << MAX_FUNC_LVARS_BITS) + indx;
660 ref.nest0 = nest0;
661 break;
662 }
663 }
664 lvars = ENVI_FUNC(FUNC_LVARS(lvars));
665 nest++;
666 #ifndef SYS_IS_64_BIT
667 if (nest >= MAX_FUNC_EXPR_NESTING) {
668 Pr("Warning: abandoning search for %g at %dth higher "
669 "frame\n",
670 (Int)s->Value, MAX_FUNC_EXPR_NESTING);
671 break;
672 }
673 #endif
674 }
675 lvars0 = PARENT_LVARS(lvars0);
676 nest0++;
677 }
678
679 // get the variable as a global variable
680 if (ref.type == R_INVALID) {
681 ref.type = R_GVAR;
682 // we do not want to call GVarName on this value until after we
683 // have checked if this is the argument to a lambda function
684 strlcpy(varname, s->Value, sizeof(varname));
685 }
686
687 // match away the identifier, now that we know the variable
688 Match(s, S_IDENT, "identifier", follow);
689
690 // If this isn't a lambda function, look up the name
691 if (s->Symbol != S_MAPTO && ref.type == R_GVAR) {
692 ref.var = GVarName(varname);
693 }
694
695 return ref;
696 }
697
698 /****************************************************************************
699 **
700 *F ReadCallVarAss( <follow>, <mode> ) . . . . . . . . . . . read a variable
701 **
702 ** 'ReadCallVarAss' reads a variable. In case of an error it skips all
703 ** symbols up to one contained in <follow>. The <mode> must be one of the
704 ** following:
705 **
706 ** 'i': check if variable, record component, list entry is bound
707 ** 'r': reference to a variable
708 ** 's': assignment via ':='
709 ** 'u': unbind a variable
710 ** 'x': either 'r' or 's' depending on <Symbol>
711 **
712 ** <Ident> := a|b|..|z|A|B|..|Z { a|b|..|z|A|B|..|Z|0|..|9|_ }
713 **
714 ** <Var> := <Ident>
715 ** | <Var> '[' <Expr> [,<Expr>]* ']'
716 ** | <Var> '{' <Expr> '}'
717 ** | <Var> '.' <Ident>
718 ** | <Var> '(' [ <Expr> { ',' <Expr> } ] [':' [ <options> ]] ')'
719 */
ReadCallVarAss(ScannerState * s,TypSymbolSet follow,Char mode)720 static void ReadCallVarAss(ScannerState * s, TypSymbolSet follow, Char mode)
721 {
722 volatile LHSRef ref = ReadVar(s, follow);
723 if (ref.type == R_INVALID)
724 return;
725
726 // if this was actually the beginning of a function literal, then we are
727 // in the wrong function
728 if (s->Symbol == S_MAPTO) {
729 if (mode == 'r' || mode == 'x')
730 ReadFuncExprAbbrevSingle(s, follow);
731 else
732 SyntaxError(s, "Function literal in impossible context");
733 return;
734 }
735
736 // Check if the variable is a constant
737 if (ref.type == R_GVAR && IsConstantGVar(ref.var) && ValGVar(ref.var)) {
738 // deal with references
739 if (mode == 'r' || (mode == 'x' && s->Symbol != S_ASSIGN)) {
740 Obj val = ValAutoGVar(ref.var);
741 TRY_IF_NO_ERROR {
742 if (val == True)
743 IntrTrueExpr();
744 else if (val == False)
745 IntrFalseExpr();
746 else if (IS_INTOBJ(val))
747 IntrIntObjExpr(val);
748 else
749 SyntaxError(s, "Invalid constant variable");
750 }
751 return;
752 }
753 }
754
755
756 /* check whether this is an unbound global variable */
757
758 if (WarnOnUnboundGlobalsRNam == 0)
759 WarnOnUnboundGlobalsRNam = RNamName("WarnOnUnboundGlobals");
760
761 if ( ref.type == R_GVAR // Reading a global variable
762 && mode != 'i' // Not inside 'IsBound'
763 && LEN_PLIST(ReaderState()->StackNams) != 0 // Inside a function
764 && ref.var != ReaderState()->CurrLHSGVar // Not LHS of assignment
765 && ValGVar(ref.var) == 0 // Not an existing global var
766 && ExprGVar(ref.var) == 0 // Or an auto var
767 && ! STATE(IntrIgnoring) // Not currently ignoring parsed code
768 && ! GlobalComesFromEnclosingForLoop(ref.var) // Not loop variable
769 && (GAPInfo == 0 || !IS_REC(GAPInfo)
770 || !ISB_REC(GAPInfo,WarnOnUnboundGlobalsRNam) // Warning enabled
771 || ELM_REC(GAPInfo,WarnOnUnboundGlobalsRNam) != False )
772 && ! SyCompilePlease ) // Not compiling
773 {
774 // Need to pass an offset, because we have already parsed more tokens
775 SyntaxWarningWithOffset(s, "Unbound global variable", 2);
776 }
777
778 /* followed by one or more selectors */
779 while (IS_IN(s->Symbol, S_LPAREN | S_LBRACK | S_LBRACE | S_DOT)) {
780
781 /* so the prefix was a reference */
782 UInt level = EvalRef(ref, 1);
783 ref = ReadSelector(s, follow, level);
784 }
785
786 /* if we need a reference */
787 if (mode == 'r' || (mode == 'x' && s->Symbol != S_ASSIGN)) {
788 Int needExpr = mode == 'r' || !IS_IN(s->Symbol, S_SEMICOLON);
789 EvalRef(ref, needExpr);
790 }
791
792 /* if we need a statement */
793 else if (mode == 's' || (mode == 'x' && s->Symbol == S_ASSIGN)) {
794 if (ref.type == R_FUNCCALL || ref.type == R_FUNCCALL_OPTS) {
795 TRY_IF_NO_ERROR {
796 IntrFuncCallEnd(0, ref.type == R_FUNCCALL_OPTS, ref.narg);
797 }
798 }
799 else {
800 Match(s, S_ASSIGN, ":=", follow);
801 UInt currLHSGVar = ReaderState()->CurrLHSGVar;
802 if ( LEN_PLIST(ReaderState()->StackNams) == 0 || !STATE(IntrCoding) ) {
803 ReaderState()->CurrLHSGVar = (ref.type == R_GVAR ? ref.var : 0);
804 }
805 ReadExpr(s, follow, 'r');
806 AssignRef(ref);
807 ReaderState()->CurrLHSGVar = currLHSGVar;
808 }
809 }
810
811 /* if we need an unbind */
812 else if ( mode == 'u' ) {
813 if (s->Symbol != S_RPAREN) {
814 SyntaxError(s, "'Unbind': argument should be followed by ')'");
815 }
816 UnbindRef(s, ref);
817 }
818
819
820 /* if we need an isbound */
821 else /* if ( mode == 'i' ) */ {
822 IsBoundRef(s, ref);
823 }
824
825 }
826
827
828 /****************************************************************************
829 **
830 *F ReadIsBound( <follow> ) . . . . . . . . . . . read an isbound expression
831 **
832 ** 'ReadIsBound' reads an isbound expression. In case of an error it skips
833 ** all symbols up to one contained in <follow>.
834 **
835 ** <Atom> := 'IsBound' '(' <Var> ')'
836 */
ReadIsBound(ScannerState * s,TypSymbolSet follow)837 static void ReadIsBound(ScannerState * s, TypSymbolSet follow)
838 {
839 Match(s, S_ISBOUND, "IsBound", follow);
840 Match(s, S_LPAREN, "(", follow);
841 ReadCallVarAss(s, S_RPAREN|follow, 'i');
842 Match(s, S_RPAREN, ")", follow);
843 }
844
845
846 /****************************************************************************
847 **
848 *F ReadPerm( <follow> ) . . . . . . . . . . . . . . . . read a permutation
849 **
850 ** 'ReadPerm' reads a permutation. In case of an error it skips all symbols
851 ** up to one contained in <follow>.
852 **
853 ** Note that the first expression has already been read. The reason is that
854 ** until the first expression has been read and a comma is found it could
855 ** also be a parenthesized expression.
856 **
857 ** <Perm> := ( <Expr> {, <Expr>} ) { ( <Expr> {, <Expr>} ) }
858 **
859 */
ReadPerm(ScannerState * s,TypSymbolSet follow)860 static void ReadPerm(ScannerState * s, TypSymbolSet follow)
861 {
862 volatile UInt nrc; /* number of cycles */
863 volatile UInt nrx; /* number of expressions in cycle */
864
865 /* read the first cycle (first expression has already been read) */
866 nrx = 1;
867 while (s->Symbol == S_COMMA) {
868 Match(s, S_COMMA, ",", follow);
869 ReadExpr(s, S_COMMA|S_RPAREN|follow, 'r');
870 nrx++;
871 }
872 Match(s, S_RPAREN, ")", follow);
873 nrc = 1;
874 TRY_IF_NO_ERROR { IntrPermCycle( nrx, nrc ); }
875
876 /* read the remaining cycles */
877 while (s->Symbol == S_LPAREN) {
878 Match(s, S_LPAREN, "(", follow);
879 ReadExpr(s, S_COMMA|S_RPAREN|follow, 'r');
880 nrx = 1;
881 while (s->Symbol == S_COMMA) {
882 Match(s, S_COMMA, ",", follow);
883 ReadExpr(s, S_COMMA|S_RPAREN|follow, 'r');
884 nrx++;
885 }
886 Match(s, S_RPAREN, ")", follow);
887 nrc++;
888 TRY_IF_NO_ERROR { IntrPermCycle( nrx, nrc ); }
889 }
890
891 /* that was the permutation */
892 TRY_IF_NO_ERROR { IntrPerm( nrc ); }
893 }
894
895 /****************************************************************************
896 **
897 *F ReadListExpr( <follow> ) . . . . . . . . . . . . . . . . . . read a list
898 **
899 ** 'ReadListExpr' reads a list literal expression. In case of an error it
900 ** skips all symbols up to one contained in <follow>.
901 **
902 ** <List> := '[' [ <Expr> ] {',' [ <Expr> ] } ']'
903 ** | '[' <Expr> [',' <Expr>] '..' <Expr> ']'
904 */
ReadListExpr(ScannerState * s,TypSymbolSet follow)905 static void ReadListExpr(ScannerState * s, TypSymbolSet follow)
906 {
907 volatile UInt pos; /* actual position of element */
908 volatile UInt nr; /* number of elements */
909 volatile UInt range; /* is the list expression a range */
910
911 struct ReaderState * volatile rs = ReaderState();
912
913 /* '[' */
914 Match(s, S_LBRACK, "[", follow);
915 rs->ReadTop++;
916 if (rs->ReadTop == 1) {
917 rs->ReadTilde = 0;
918 STATE(Tilde) = 0;
919 }
920 TRY_IF_NO_ERROR { IntrListExprBegin( (rs->ReadTop == 1) ); }
921 pos = 1;
922 nr = 0;
923 range = 0;
924
925 /* [ <Expr> ] */
926 if (s->Symbol != S_COMMA && s->Symbol != S_RBRACK) {
927 TRY_IF_NO_ERROR { IntrListExprBeginElm( pos ); }
928 ReadExpr(s, S_RBRACK|follow, 'r');
929 TRY_IF_NO_ERROR { IntrListExprEndElm(); }
930 nr++;
931 }
932
933 /* {',' [ <Expr> ] } */
934 while (s->Symbol == S_COMMA) {
935 Match(s, S_COMMA, ",", follow);
936 pos++;
937 if (s->Symbol != S_COMMA && s->Symbol != S_RBRACK) {
938 TRY_IF_NO_ERROR { IntrListExprBeginElm( pos ); }
939 ReadExpr(s, S_RBRACK|follow, 'r');
940 TRY_IF_NO_ERROR { IntrListExprEndElm(); }
941 nr++;
942 }
943 }
944
945 /* incorrect place for three dots */
946 if (s->Symbol == S_DOTDOTDOT) {
947 SyntaxError(s, "Only two dots in a range");
948 }
949
950 /* '..' <Expr> ']' */
951 if (s->Symbol == S_DOTDOT) {
952 if ( pos != nr ) {
953 SyntaxError(s, "Must have no unbound entries in range");
954 }
955 if ( 2 < nr ) {
956 SyntaxError(s, "Must have at most 2 entries before '..'");
957 }
958 range = 1;
959 Match(s, S_DOTDOT, "..", follow);
960 pos++;
961 TRY_IF_NO_ERROR { IntrListExprBeginElm( pos ); }
962 ReadExpr(s, S_RBRACK|follow, 'r');
963 TRY_IF_NO_ERROR { IntrListExprEndElm(); }
964 nr++;
965 if (rs->ReadTop == 1 && rs->ReadTilde == 1) {
966 SyntaxError(s, "Sorry, '~' not allowed in range");
967 }
968 }
969
970 /* ']' */
971 Match(s, S_RBRACK, "]", follow);
972 TRY_IF_NO_ERROR {
973 IntrListExprEnd( nr, range, (rs->ReadTop == 1), (rs->ReadTilde == 1) );
974 }
975 if (rs->ReadTop == 1) {
976 rs->ReadTilde = 0;
977 STATE(Tilde) = 0;
978 }
979 rs->ReadTop--;
980 }
981
982
983 /****************************************************************************
984 **
985 *F ReadRecExpr( <follow> ) . . . . . . . . . . . . . . . . . . read a record
986 **
987 ** 'ReadRecExpr' reads a record literal expression. In case of an error it
988 ** skips all symbols up to one contained in <follow>.
989 **
990 ** <Record> := 'rec( [ <Ident>:=<Expr> {, <Ident>:=<Expr> } ] )'
991 */
ReadRecExpr(ScannerState * s,TypSymbolSet follow)992 static void ReadRecExpr(ScannerState * s, TypSymbolSet follow)
993 {
994 volatile UInt rnam; /* record component name */
995 volatile UInt nr; /* number of components */
996
997 struct ReaderState * volatile rs = ReaderState();
998
999 /* 'rec(' */
1000 Match(s, S_REC, "rec", follow);
1001 Match(s, S_LPAREN, "(", follow|S_RPAREN|S_COMMA);
1002 rs->ReadTop++;
1003 if ( rs->ReadTop == 1 ) {
1004 rs->ReadTilde = 0;
1005 STATE(Tilde) = 0;
1006 }
1007 TRY_IF_NO_ERROR { IntrRecExprBegin( (rs->ReadTop == 1) ); }
1008 nr = 0;
1009
1010 /* [ <Ident> | '(' <Expr> ')' ':=' <Expr> */
1011 do {
1012 if (nr || s->Symbol == S_COMMA) {
1013 Match(s, S_COMMA, ",", follow);
1014 }
1015 if ( s->Symbol != S_RPAREN ) {
1016 if ( s->Symbol == S_INT ) {
1017 rnam = RNamName( s->Value );
1018 Match(s, S_INT, "integer", follow);
1019 TRY_IF_NO_ERROR { IntrRecExprBeginElmName( rnam ); }
1020 }
1021 else if ( s->Symbol == S_IDENT ) {
1022 rnam = RNamName( s->Value );
1023 Match(s, S_IDENT, "identifier", follow);
1024 TRY_IF_NO_ERROR { IntrRecExprBeginElmName( rnam ); }
1025 }
1026 else if ( s->Symbol == S_LPAREN ) {
1027 Match(s, S_LPAREN, "(", follow);
1028 ReadExpr(s, follow, 'r');
1029 Match(s, S_RPAREN, ")", follow);
1030 TRY_IF_NO_ERROR { IntrRecExprBeginElmExpr(); }
1031 }
1032 else {
1033 SyntaxError(s, "Identifier expected");
1034 }
1035 Match(s, S_ASSIGN, ":=", follow);
1036 ReadExpr(s, S_RPAREN|follow, 'r');
1037 TRY_IF_NO_ERROR { IntrRecExprEndElm(); }
1038 nr++;
1039 }
1040
1041 } while (s->Symbol == S_COMMA);
1042
1043 /* ')' */
1044 Match(s, S_RPAREN, ")", follow);
1045 TRY_IF_NO_ERROR {
1046 IntrRecExprEnd( nr, (rs->ReadTop == 1), (rs->ReadTilde == 1) );
1047 }
1048 if (rs->ReadTop == 1) {
1049 rs->ReadTilde = 0;
1050 STATE(Tilde) = 0;
1051 }
1052 rs->ReadTop--;
1053 }
1054
1055 /****************************************************************************
1056 **
1057 ** ArgList represents the return value of ReadFuncArgList
1058 */
1059 typedef struct {
1060 Int narg; /* number of arguments */
1061 Obj nams; /* list of local variables names */
1062 UInt isvarg; /* does function have varargs? */
1063 #ifdef HPCGAP
1064 Obj locks; /* locks of the function (HPC-GAP) */
1065 #endif
1066 } ArgList;
1067
1068 /****************************************************************************
1069 **
1070 *F ReadFuncArgList(<follow>, <is_atomic>, <symbol>, <symbolstr>)
1071 ** . . . . . . . . . . read a function argument list.
1072 **
1073 ** 'ReadFuncArgList' reads the argument list of a function. In case of an
1074 ** error it skips all symbols up to one contained in <follow>.
1075 **
1076 ** <ArgList> := ('readwrite'|'readonly') <Ident>
1077 ** {',' ('readwrite'|'readonly') <Ident> } ( '...' )
1078 **
1079 ** is_atomic: Is this an atomic function?
1080 ** symbol: The end symbol of the arglist (usually S_RBRACK, but S_RBRACE
1081 ** for lambda functions).
1082 ** symbolstr: symbol as an ascii string
1083 **
1084 ** This function assumes the opening bracket is already read, and is
1085 ** responsible for reading the closing bracket.
1086 */
1087
ReadFuncArgList(ScannerState * s,TypSymbolSet follow,Int is_atomic,UInt symbol,const Char * symbolstr)1088 static ArgList ReadFuncArgList(ScannerState * s,
1089 TypSymbolSet follow,
1090 Int is_atomic,
1091 UInt symbol,
1092 const Char * symbolstr)
1093 {
1094 Int narg; /* number of arguments */
1095 Obj nams; /* list of local variables names */
1096 #ifdef HPCGAP
1097 LockQual lockqual;
1098 Bag locks = 0; /* locks of the function */
1099 #endif
1100 UInt isvarg = 0; /* does function have varargs? */
1101
1102 #ifdef HPCGAP
1103 if (is_atomic)
1104 locks = NEW_STRING(4);
1105 #endif
1106
1107 /* make and push the new local variables list (args and locals) */
1108 narg = 0;
1109 nams = NEW_PLIST(T_PLIST, 0);
1110 if (s->Symbol != symbol) {
1111 goto start;
1112 }
1113
1114 while (s->Symbol == S_COMMA) {
1115 if (isvarg) {
1116 SyntaxError(s, "Only final argument can be variadic");
1117 }
1118
1119 Match(s, S_COMMA, ",", follow);
1120 start:
1121 #ifdef HPCGAP
1122 lockqual = LOCK_QUAL_NONE;
1123 #endif
1124 if (s->Symbol == S_READWRITE) {
1125 if (!is_atomic) {
1126 SyntaxError(s, "'readwrite' argument of non-atomic function");
1127 }
1128 #ifdef HPCGAP
1129 else {
1130 lockqual = LOCK_QUAL_READWRITE;
1131 }
1132 #endif
1133 Match(s, S_READWRITE, "readwrite", follow);
1134 }
1135 else if (s->Symbol == S_READONLY) {
1136 if (!is_atomic) {
1137 SyntaxError(s, "'readonly' argument of non-atomic function");
1138 }
1139 #ifdef HPCGAP
1140 else {
1141 lockqual = LOCK_QUAL_READONLY;
1142 }
1143 #endif
1144 Match(s, S_READONLY, "readonly", follow);
1145 }
1146 if (s->Symbol == S_IDENT && findValueInNams(nams, s->Value, 1, narg)) {
1147 SyntaxError(s, "Name used for two arguments");
1148 }
1149 narg += 1;
1150 PushPlist(nams, MakeImmString(s->Value));
1151 #ifdef HPCGAP
1152 if (is_atomic) {
1153 GrowString(locks, narg);
1154 SET_LEN_STRING(locks, narg);
1155 CHARS_STRING(locks)[narg - 1] = lockqual;
1156 }
1157 #endif
1158 if (LEN_PLIST(nams) >= MAX_FUNC_LVARS) {
1159 SyntaxError(s, "Too many function arguments");
1160 }
1161 Match(s, S_IDENT,"identifier",symbol|S_LOCAL|STATBEGIN|S_END|follow);
1162 if (s->Symbol == S_DOTDOT) {
1163 SyntaxError(s, "Three dots required for variadic argument list");
1164 }
1165 if (s->Symbol == S_DOTDOTDOT) {
1166 isvarg = 1;
1167 Match(s, S_DOTDOTDOT, "...", follow);
1168 }
1169 }
1170 Match(s, symbol, symbolstr, S_LOCAL|STATBEGIN|S_END|follow);
1171
1172 // Special case for function(arg)
1173 if ( narg == 1 && ! strcmp( "arg", CONST_CSTR_STRING( ELM_PLIST(nams, narg) ) )) {
1174 isvarg = 1;
1175 }
1176
1177 ArgList args;
1178 args.narg = narg;
1179 args.nams = nams;
1180 args.isvarg = isvarg;
1181 #ifdef HPCGAP
1182 args.locks = locks;
1183 if (locks)
1184 MakeImmutable(args.locks);
1185 #endif
1186 return args;
1187 }
1188
1189
StartFakeFuncExpr(Int startLine)1190 void StartFakeFuncExpr(Int startLine)
1191 {
1192 assert(STATE(IntrCoding) == 0);
1193
1194 // switch to coding mode now
1195 CodeBegin();
1196
1197 // code a function expression (with no arguments and locals)
1198 Obj nams = NEW_PLIST(T_PLIST, 0);
1199
1200 // If we are in the break loop, then a local variable context may well
1201 // exist, and we have to create an empty local variable names list to
1202 // match the function expression that we are creating.
1203 //
1204 // Without this, access to variables defined in the existing local
1205 // variable context will be coded as LVAR accesses; but when we then
1206 // execute this code, they will not actually be available in the current
1207 // context, but rather one level up, i.e., they really should have been
1208 // coded as HVARs.
1209 //
1210 // If we are not in a break loop, then this would be a waste of time and
1211 // effort
1212 if (LEN_PLIST(ReaderState()->StackNams) > 0) {
1213 PushPlist(ReaderState()->StackNams, nams);
1214 }
1215
1216 CodeFuncExprBegin(0, 0, nams, startLine);
1217 }
1218
1219
FinishAndCallFakeFuncExpr(void)1220 void FinishAndCallFakeFuncExpr(void)
1221 {
1222 assert(STATE(IntrCoding) == 0);
1223
1224 // code a function expression (with one statement in the body)
1225 CodeFuncExprEnd(1, 1);
1226
1227 // switch back to immediate mode and get the function
1228 Obj func = CodeEnd(0);
1229
1230 // If we are in a break loop, then we will have created a "dummy" local
1231 // variable names list to get the counts right. Remove it.
1232 const UInt len = LEN_PLIST(ReaderState()->StackNams);
1233 if (len > 0)
1234 PopPlist(ReaderState()->StackNams);
1235
1236 // call the function
1237 CALL_0ARGS(func);
1238
1239 // push void
1240 PushVoidObj();
1241 }
1242
1243
ReadFuncExprBody(ScannerState * s,TypSymbolSet follow,Int isAbbrev,Int nloc,ArgList args,Int startLine)1244 static void ReadFuncExprBody(ScannerState * s,
1245 TypSymbolSet follow,
1246 Int isAbbrev,
1247 Int nloc,
1248 ArgList args,
1249 Int startLine)
1250 {
1251 volatile UInt nr; // number of statements
1252 volatile UInt nrError; // copy of <STATE(NrError)>
1253 volatile Bag currLVars; // copy of <STATE(CurrLVars)>
1254
1255 // remember the current variables in case of an error
1256 currLVars = STATE(CurrLVars);
1257 nrError = STATE(NrError);
1258
1259 // push the new local variables list
1260 PushPlist(ReaderState()->StackNams, args.nams);
1261
1262 // begin interpreting the function expression
1263 TRY_IF_NO_ERROR {
1264 IntrFuncExprBegin(args.isvarg ? -args.narg : args.narg, nloc,
1265 args.nams, startLine);
1266 }
1267
1268 if (isAbbrev) {
1269 // read the expression and turn it into a return-statement
1270 ReadExpr(s, follow, 'r');
1271 TRY_IF_NO_ERROR {
1272 IntrReturnObj();
1273 }
1274 nr = 1;
1275 }
1276 else {
1277 #ifdef HPCGAP
1278 if (nrError == 0)
1279 SET_LCKS_FUNC(CURR_FUNC(), args.locks);
1280 #endif
1281 // <Statements>
1282 UInt oldLoopNesting = ReaderState()->LoopNesting;
1283 ReaderState()->LoopNesting = 0;
1284 nr = ReadStats(s, S_END | follow);
1285 ReaderState()->LoopNesting = oldLoopNesting;
1286 }
1287
1288
1289 // end interpreting the function expression
1290 TRY_IF_NO_ERROR {
1291 IntrFuncExprEnd(nr);
1292 }
1293 CATCH_ERROR {
1294 // an error has occurred *after* the 'IntrFuncExprEnd'
1295 if (nrError == 0)
1296 IntrAbortCoding(currLVars);
1297 }
1298
1299 // pop the new local variables list
1300 PopPlist(ReaderState()->StackNams);
1301 }
1302
1303
1304 /****************************************************************************
1305 **
1306 *F ReadLocals( <follow> )
1307 */
ReadLocals(ScannerState * s,TypSymbolSet follow,Obj nams)1308 static UInt ReadLocals(ScannerState * s, TypSymbolSet follow, Obj nams)
1309 {
1310 UInt narg = LEN_PLIST(nams);
1311 UInt nloc = 0;
1312
1313 Match(s, S_LOCAL, "local", follow);
1314
1315 while (1) {
1316 if (s->Symbol == S_IDENT) {
1317 if (findValueInNams(nams, s->Value, narg + 1, narg + nloc)) {
1318 SyntaxError(s, "Name used for two locals");
1319 }
1320 if (findValueInNams(nams, s->Value, 1, narg)) {
1321 SyntaxError(s, "Name used for argument and local");
1322 }
1323 nloc += 1;
1324 PushPlist(nams, MakeImmString(s->Value));
1325 if (LEN_PLIST(nams) >= 65536) {
1326 SyntaxError(s, "Too many function arguments and locals");
1327 }
1328 }
1329 Match(s, S_IDENT, "identifier", STATBEGIN | S_END | follow);
1330
1331 if (s->Symbol != S_COMMA)
1332 break;
1333
1334 // init to avoid strange message in case of empty string
1335 s->Value[0] = '\0';
1336 Match(s, S_COMMA, ",", follow);
1337 }
1338 MatchSemicolon(s, STATBEGIN | S_END | follow);
1339
1340 return nloc;
1341 }
1342
1343 /****************************************************************************
1344 **
1345 *F ReadFuncExpr( <follow> ) . . . . . . . . . . read a function definition
1346 **
1347 ** 'ReadFuncExpr' reads a function literal expression. In case of an error
1348 ** it skips all symbols up to one contained in <follow>.
1349 **
1350 ** <Function> := 'function (' <ArgList> ')'
1351 ** [ 'local' <Ident> {',' <Ident>} ';' ]
1352 ** <Statements>
1353 ** 'end'
1354 */
ReadFuncExpr(ScannerState * s,TypSymbolSet follow,Char mode)1355 static void ReadFuncExpr(ScannerState * s, TypSymbolSet follow, Char mode)
1356 {
1357 Int startLine; // line number of function keyword
1358 int is_atomic = 0; // is this an atomic function?
1359 UInt nloc = 0; // number of locals
1360 ArgList args;
1361
1362 /* begin the function */
1363 startLine = GetInputLineNumber();
1364 if (s->Symbol == S_ATOMIC) {
1365 Match(s, S_ATOMIC, "atomic", follow);
1366 is_atomic = 1;
1367 } else if (mode == 'a') {
1368 // in this case the atomic keyword was matched away by ReadAtomic
1369 // before we realised we were reading an atomic function
1370 is_atomic = 1;
1371 }
1372 Match(s, S_FUNCTION, "function", follow);
1373 Match(s, S_LPAREN, "(", S_IDENT|S_RPAREN|S_LOCAL|STATBEGIN|S_END|follow);
1374
1375 args = ReadFuncArgList(s, follow, is_atomic, S_RPAREN, ")");
1376
1377 if (s->Symbol == S_LOCAL) {
1378 nloc = ReadLocals(s, follow, args.nams);
1379 }
1380
1381 ReadFuncExprBody(s, follow, 0, nloc, args, startLine);
1382
1383 /* 'end' */
1384 Match(s, S_END, "while parsing a function: statement or 'end'", follow);
1385 }
1386
1387
1388 /****************************************************************************
1389 **
1390 *F ReadFuncExprAbbrevMulti(<follow>) . . read multi-arg abbrev. func. expr.
1391 **
1392 ** 'ReadFuncExprAbbrevMulti' reads a multi-argument abbreviated function
1393 ** literal expression. In case of an error it skips all symbols up to one
1394 ** contained in <follow>.
1395 **
1396 ** <Function> := '{' <ArgList> '}' '->' <Expr>
1397 */
ReadFuncExprAbbrevMulti(ScannerState * s,TypSymbolSet follow)1398 static void ReadFuncExprAbbrevMulti(ScannerState * s, TypSymbolSet follow)
1399 {
1400 Match(s, S_LBRACE, "{", follow);
1401
1402 ArgList args = ReadFuncArgList(s, follow, 0, S_RBRACE, ")");
1403
1404 /* match away the '->' */
1405 Match(s, S_MAPTO, "->", follow);
1406
1407 ReadFuncExprBody(s, follow, 1, 0, args, GetInputLineNumber());
1408 }
1409
1410 /****************************************************************************
1411 **
1412 *F ReadFuncExprAbbrevSingle(<follow>) . read single-arg abbrev. func. expr.
1413 **
1414 ** 'ReadFuncExprAbbrevSingle' reads a single-argument abbreviated function
1415 ** literal expression. In case of an error it skips all symbols up to one
1416 ** contained in <follow>.
1417 **
1418 ** <Function> := <Var> '->' <Expr>
1419 */
ReadFuncExprAbbrevSingle(ScannerState * s,TypSymbolSet follow)1420 static void ReadFuncExprAbbrevSingle(ScannerState * s, TypSymbolSet follow)
1421 {
1422 /* make and push the new local variables list */
1423 Obj nams = NEW_PLIST(T_PLIST, 1);
1424 PushPlist(nams, MakeImmString(s->Value));
1425
1426 ArgList args;
1427 args.narg = 1;
1428 args.nams = nams;
1429 args.isvarg = 0;
1430 #ifdef HPCGAP
1431 args.locks = 0;
1432 #endif
1433
1434 /* match away the '->' */
1435 Match(s, S_MAPTO, "->", follow);
1436
1437 ReadFuncExprBody(s, follow, 1, 0, args, GetInputLineNumber());
1438 }
1439
1440 /****************************************************************************
1441 **
1442 *F ReadLiteral( <follow>, <mode> ) . . . . . . . . . . . . . . read an atom
1443 **
1444 ** 'ReadLiteral' reads a literal expression. In case of an error it skips
1445 ** all symbols up to one contained in <follow>.
1446 **
1447 ** <Literal> := <Int>
1448 ** | 'true'
1449 ** | 'false'
1450 ** | <Char>
1451 ** | <Perm>
1452 ** | <String>
1453 ** | <List>
1454 ** | <Record>
1455 ** | <Function>
1456 **
1457 ** <Int> := 0|1|..|9 { 0|1|..|9 }
1458 **
1459 ** <Char> := ' <any character> '
1460 **
1461 ** <String> := " { <any character> } "
1462 */
ReadLiteral(ScannerState * s,TypSymbolSet follow,Char mode)1463 static void ReadLiteral(ScannerState * s, TypSymbolSet follow, Char mode)
1464 {
1465 if (s->Symbol == S_DOT) {
1466 // HACK: The only way a dot could turn up here is in a floating point
1467 // literal that starts with '.'. Call back to the scanner to deal
1468 // with this.
1469 ScanForFloatAfterDotHACK(s);
1470 }
1471
1472 switch (s->Symbol) {
1473
1474 /* <Int> */
1475 case S_INT:
1476 TRY_IF_NO_ERROR { IntrIntExpr(s->ValueObj, s->Value); }
1477 Match(s, S_INT, "integer", follow);
1478 break;
1479
1480 /* <Float> */
1481 case S_FLOAT:
1482 TRY_IF_NO_ERROR { IntrFloatExpr(s->ValueObj, s->Value); }
1483 Match(s, S_FLOAT, "float", follow);
1484 break;
1485
1486 /* 'true' */
1487 case S_TRUE:
1488 Match(s, S_TRUE, "true", follow);
1489 IntrTrueExpr();
1490 break;
1491
1492 /* 'false' */
1493 case S_FALSE:
1494 Match(s, S_FALSE, "false", follow);
1495 IntrFalseExpr();
1496 break;
1497
1498 /* '~' */
1499 case S_TILDE:
1500 if (ReaderState()->ReadTop == 0) {
1501 SyntaxError(s, "'~' not allowed here");
1502 }
1503 ReaderState()->ReadTilde = 1;
1504 TRY_IF_NO_ERROR { IntrTildeExpr(); }
1505 Match(s, S_TILDE, "~", follow);
1506 break;
1507
1508 /* <Char> */
1509 case S_CHAR:
1510 TRY_IF_NO_ERROR { IntrCharExpr( s->Value[0] ); }
1511 Match(s, S_CHAR, "character", follow);
1512 break;
1513
1514 /* string */
1515 case S_STRING:
1516 GAP_ASSERT(s->ValueObj != 0);
1517 TRY_IF_NO_ERROR { IntrStringExpr(s->ValueObj); }
1518 Match(s, S_STRING, "", follow);
1519 s->ValueObj = 0;
1520 break;
1521
1522 /* <List> */
1523 case S_LBRACK:
1524 ReadListExpr(s, follow);
1525 break;
1526
1527 /* <Rec> */
1528 case S_REC:
1529 ReadRecExpr(s, follow);
1530 break;
1531
1532 /* <Function> */
1533 case S_FUNCTION:
1534 case S_ATOMIC:
1535 ReadFuncExpr(s, follow, mode);
1536 break;
1537
1538 case S_LBRACE:
1539 ReadFuncExprAbbrevMulti(s, follow);
1540 break;
1541
1542 /* signal an error, we want to see a literal */
1543 default:
1544 Match(s, S_INT, "literal", follow);
1545 }
1546 }
1547
1548
1549 /****************************************************************************
1550 **
1551 *F ReadAtom( <follow>, <mode> ) . . . . . . . . . . . . . . . read an atom
1552 **
1553 ** 'ReadAtom' reads an atom. In case of an error it skips all symbols up to
1554 ** one contained in <follow>.
1555 **
1556 ** <Atom> := <Var>
1557 ** | 'IsBound' '(' <Var> ')'
1558 ** | <Literal>
1559 ** | '(' <Expr> ')'
1560 */
1561 static const UInt LiteralExprStateMask =
1562 S_INT|S_TRUE|S_FALSE|S_CHAR|S_STRING|S_LBRACK|
1563 S_TILDE|S_REC|S_FUNCTION|
1564 S_ATOMIC|S_FLOAT|S_DOT|S_MAPTO;
1565
ReadAtom(ScannerState * s,TypSymbolSet follow,Char mode)1566 static void ReadAtom(ScannerState * s, TypSymbolSet follow, Char mode)
1567 {
1568 /* read a variable */
1569 if (s->Symbol == S_IDENT) {
1570 ReadCallVarAss(s, follow, mode);
1571 }
1572
1573 /* 'IsBound' '(' <Var> ')' */
1574 else if (s->Symbol == S_ISBOUND) {
1575 ReadIsBound(s, follow);
1576 }
1577 /* otherwise read a literal expression */
1578 else if (IS_IN(s->Symbol, LiteralExprStateMask)) {
1579 ReadLiteral(s, follow, mode);
1580 }
1581
1582 /* '(' <Expr> ')' */
1583 else if (s->Symbol == S_LPAREN) {
1584 Match(s, S_LPAREN, "(", follow);
1585 if (s->Symbol == S_RPAREN) {
1586 Match(s, S_RPAREN, ")", follow);
1587 TRY_IF_NO_ERROR { IntrPerm( 0UL ); }
1588 return;
1589 }
1590 ReadExpr(s, S_RPAREN|follow, 'r');
1591 if (s->Symbol == S_COMMA) {
1592 ReadPerm(s, follow);
1593 return;
1594 }
1595 Match(s, S_RPAREN, ")", follow);
1596 }
1597
1598 /* otherwise signal an error */
1599 else {
1600 Match(s, S_INT, "expression", follow);
1601 }
1602
1603 ReadReferenceModifiers(s, follow);
1604 }
1605
1606 /****************************************************************************
1607 **
1608 *F ReadSign( <follow> ) . . . . . . . . . . . . . . read a sign, or nothing
1609 */
ReadSign(ScannerState * s,TypSymbolSet follow)1610 static Int ReadSign(ScannerState * s, TypSymbolSet follow)
1611 {
1612 if (s->Symbol == S_PLUS) {
1613 Match(s, S_PLUS, "unary +", follow);
1614 return +1;
1615 }
1616 if (s->Symbol == S_MINUS) {
1617 Match(s, S_MINUS, "unary -", follow);
1618 return -1;
1619 }
1620 return 0;
1621 }
1622
1623 /****************************************************************************
1624 **
1625 *F ReadFactor( <follow>, <mode> ) . . . . . . . . . . . . . . read a factor
1626 **
1627 ** 'ReadFactor' reads a factor. In case of an error it skips all symbols up
1628 ** to one contained in <follow>.
1629 **
1630 ** <Factor> := {'+'|'-'} <Atom> [ '^' {'+'|'-'} <Atom> ]
1631 */
ReadFactor(ScannerState * s,TypSymbolSet follow,Char mode)1632 static void ReadFactor(ScannerState * s, TypSymbolSet follow, Char mode)
1633 {
1634 volatile Int sign1;
1635 volatile Int sign2;
1636
1637 /* { '+'|'-' } leading sign */
1638 sign1 = ReadSign(s, follow);
1639
1640 /* <Atom> */
1641 ReadAtom(s, follow, (sign1 == 0 ? mode : 'r'));
1642
1643 /* ['^' <Atom> ] implemented as {'^' <Atom> } for better error message */
1644 while (s->Symbol == S_POW) {
1645
1646 /* match the '^' away */
1647 Match(s, S_POW, "^", follow);
1648
1649 /* { '+'|'-' } leading sign */
1650 sign2 = ReadSign(s, follow);
1651
1652 /* ['^' <Atom>] */
1653 ReadAtom(s, follow, 'r');
1654
1655 /* interpret the unary minus */
1656 if ( sign2 == -1 ) {
1657 TRY_IF_NO_ERROR { IntrAInv(); }
1658 }
1659
1660 /* interpret the power */
1661 TRY_IF_NO_ERROR { IntrPow(); }
1662
1663 /* check for multiple '^' */
1664 if (s->Symbol == S_POW) {
1665 SyntaxError(s, "'^' is not associative");
1666 }
1667 }
1668
1669 /* interpret the unary minus */
1670 if ( sign1 == -1 ) {
1671 TRY_IF_NO_ERROR { IntrAInv(); }
1672 }
1673 }
1674
1675
1676 /****************************************************************************
1677 **
1678 *F ReadTerm( <follow>, <mode> ) . . . . . . . . . . . . . . . . read a term
1679 **
1680 ** 'ReadTerm' reads a term. In case of an error it skips all symbols up to
1681 ** one contained in <follow>.
1682 **
1683 ** <Term> := <Factor> { '*'|'/'|'mod' <Factor> }
1684 */
ReadTerm(ScannerState * s,TypSymbolSet follow,Char mode)1685 static void ReadTerm(ScannerState * s, TypSymbolSet follow, Char mode)
1686 {
1687 volatile UInt symbol;
1688
1689 /* <Factor> */
1690 ReadFactor(s, follow, mode);
1691
1692 /* { '*'|'/'|'mod' <Factor> } */
1693 /* do not use 'IS_IN', since 'IS_IN(S_POW,S_MULT|S_DIV|S_MOD)' is true */
1694 while (s->Symbol == S_MULT ||
1695 s->Symbol == S_DIV || s->Symbol == S_MOD) {
1696 symbol = s->Symbol;
1697 Match(s, s->Symbol, "*, /, or mod", follow);
1698 ReadFactor(s, follow, 'r');
1699 TRY_IF_NO_ERROR {
1700 if ( symbol == S_MULT ) { IntrProd(); }
1701 else if ( symbol == S_DIV ) { IntrQuo(); }
1702 else if ( symbol == S_MOD ) { IntrMod(); }
1703 }
1704 }
1705 }
1706
1707
1708 /****************************************************************************
1709 **
1710 *F ReadAri( <follow>, <mode> ) . . . . . . . . read an arithmetic expression
1711 **
1712 ** 'ReadAri' reads an arithmetic expression. In case of an error it skips
1713 ** all symbols up to one contained in <follow>.
1714 **
1715 ** <Arith> := <Term> { '+'|'-' <Term> }
1716 */
ReadAri(ScannerState * s,TypSymbolSet follow,Char mode)1717 static void ReadAri(ScannerState * s, TypSymbolSet follow, Char mode)
1718 {
1719 UInt symbol;
1720
1721 /* <Term> */
1722 ReadTerm(s, follow, mode);
1723
1724 /* { '+'|'-' <Term> } */
1725 while (IS_IN(s->Symbol, S_PLUS | S_MINUS)) {
1726 symbol = s->Symbol;
1727 Match(s, s->Symbol, "+ or -", follow);
1728 ReadTerm(s, follow, 'r');
1729 TRY_IF_NO_ERROR {
1730 if ( symbol == S_PLUS ) { IntrSum(); }
1731 else if ( symbol == S_MINUS ) { IntrDiff(); }
1732 }
1733 }
1734 }
1735
1736
1737 /****************************************************************************
1738 **
1739 *F ReadRel( <follow>, <mode> ) . . . . . . . . read a relational expression
1740 **
1741 ** 'ReadRel' reads a relational expression. In case of an error it skips
1742 ** all symbols up to one contained in <follow>.
1743 **
1744 ** <Rel> := { 'not' } <Arith> { '=|<>|<|>|<=|>=|in' <Arith> }
1745 */
ReadRel(ScannerState * s,TypSymbolSet follow,Char mode)1746 static void ReadRel(ScannerState * s, TypSymbolSet follow, Char mode)
1747 {
1748 volatile UInt symbol;
1749 volatile UInt isNot;
1750
1751 /* { 'not' } */
1752 isNot = 0;
1753 while (s->Symbol == S_NOT) {
1754 isNot++;
1755 Match(s, S_NOT, "not", follow);
1756 }
1757
1758 /* <Arith> */
1759 ReadAri(s, follow, (isNot == 0 ? mode : 'r'));
1760
1761 /* { '=|<>|<|>|<=|>=|in' <Arith> } */
1762 if (IS_IN(s->Symbol, S_EQ | S_LT | S_GT | S_NE | S_LE | S_GE | S_IN)) {
1763 symbol = s->Symbol;
1764 Match(s, s->Symbol, "comparison operator", follow);
1765 ReadAri(s, follow, 'r');
1766 TRY_IF_NO_ERROR {
1767 if ( symbol == S_EQ ) { IntrEq(); }
1768 else if ( symbol == S_NE ) { IntrNe(); }
1769 else if ( symbol == S_LT ) { IntrLt(); }
1770 else if ( symbol == S_GE ) { IntrGe(); }
1771 else if ( symbol == S_GT ) { IntrGt(); }
1772 else if ( symbol == S_LE ) { IntrLe(); }
1773 else if ( symbol == S_IN ) { IntrIn(); }
1774 }
1775 }
1776
1777 /* interpret the not */
1778 if ( (isNot % 2) != 0 ) {
1779 TRY_IF_NO_ERROR { IntrNot(); }
1780 }
1781 }
1782
1783
1784 /****************************************************************************
1785 **
1786 *F ReadAnd( <follow>, <mode> ) . . . . . . . read a logical 'and' expression
1787 **
1788 ** 'ReadAnd' reads an and expression. In case of an error it skips all
1789 ** symbols up to one contained in <follow>.
1790 **
1791 ** <And> := <Rel> { 'and' <Rel> }
1792 */
ReadAnd(ScannerState * s,TypSymbolSet follow,Char mode)1793 static void ReadAnd(ScannerState * s, TypSymbolSet follow, Char mode)
1794 {
1795 /* <Rel> */
1796 ReadRel(s, follow, mode);
1797
1798 /* { 'and' <Rel> } */
1799 while (s->Symbol == S_AND) {
1800 Match(s, S_AND, "and", follow);
1801 TRY_IF_NO_ERROR { IntrAndL(); }
1802 ReadRel(s, follow, 'r');
1803 TRY_IF_NO_ERROR { IntrAnd(); }
1804 }
1805 }
1806
1807
1808 /****************************************************************************
1809 **
1810 *F ReadQualifiedExpr( <follow>, <mode> ) . . . . . read an expression which
1811 ** may be qualified with readonly or readwrite
1812 **
1813 ** 'ReadQualifiedExpr' reads a qualified expression. In case of an error it
1814 ** skips all symbols up to one contained in <follow>.
1815 **
1816 ** <QualifiedExpr> := ['readonly' | 'readwrite' ] <Expr>
1817 **
1818 ** These functions only do something meaningful inside HPC-GAP; in plain GAP
1819 ** they are simply placeholders.
1820 */
1821 static void
ReadQualifiedExpr(ScannerState * s,TypSymbolSet follow,Char mode)1822 ReadQualifiedExpr(ScannerState * s, TypSymbolSet follow, Char mode)
1823 {
1824 volatile UInt access = 0;
1825 if (s->Symbol == S_READWRITE)
1826 {
1827 Match(s, S_READWRITE, "readwrite", follow | EXPRBEGIN);
1828 access = 2;
1829 }
1830 else if (s->Symbol == S_READONLY)
1831 {
1832 Match(s, S_READONLY, "readonly", follow | EXPRBEGIN);
1833 access = 1;
1834 }
1835 TRY_IF_NO_ERROR { IntrQualifiedExprBegin(access); }
1836 ReadExpr(s, follow,mode);
1837 TRY_IF_NO_ERROR { IntrQualifiedExprEnd(); }
1838 }
1839
1840
1841
1842 /****************************************************************************
1843 **
1844 *F ReadExpr( <follow>, <mode> ) . . . . . . . . . . . . read an expression
1845 **
1846 ** 'ReadExpr' reads an expression. In case of an error it skips all symbols
1847 ** up to one contained in <follow>.
1848 **
1849 ** <Expr> := <And> { 'or' <And> }
1850 **
1851 ** The <mode> is either 'r' indicating that the expression should be
1852 ** evaluated as usual, 'x' indicating that it may be the left-hand-side of
1853 ** an assignment or 'a' indicating that it is a function expression
1854 ** following an "atomic" keyword and that the function should be made
1855 ** atomic.
1856 **
1857 ** This last case exists because when reading "atomic function" in statement
1858 ** context the atomic has been matched away before we can see that it is an
1859 ** atomic function literal, not an atomic statement.
1860 **
1861 **
1862 */
ReadExpr(ScannerState * s,TypSymbolSet follow,Char mode)1863 static void ReadExpr(ScannerState * s, TypSymbolSet follow, Char mode)
1864 {
1865 /* <And> */
1866 ReadAnd(s, follow, mode);
1867
1868 /* { 'or' <And> } */
1869 while (s->Symbol == S_OR) {
1870 Match(s, S_OR, "or", follow);
1871 TRY_IF_NO_ERROR { IntrOrL(); }
1872 ReadAnd(s, follow, 'r');
1873 TRY_IF_NO_ERROR { IntrOr(); }
1874 }
1875 }
1876
1877
1878 /****************************************************************************
1879 **
1880 *F ReadUnbind( <follow> ) . . . . . . . . . . . . read an unbind statement
1881 **
1882 ** 'ReadUnbind' reads an unbind statement. In case of an error it skips all
1883 ** symbols up to one contained in <follow>.
1884 **
1885 ** <Statement> := 'Unbind' '(' <Var> ')' ';'
1886 */
ReadUnbind(ScannerState * s,TypSymbolSet follow)1887 static void ReadUnbind(ScannerState * s, TypSymbolSet follow)
1888 {
1889 Match(s, S_UNBIND, "Unbind", follow);
1890 Match(s, S_LPAREN, "(", follow);
1891 ReadCallVarAss(s, S_RPAREN|follow, 'u');
1892 Match(s, S_RPAREN, ")", follow);
1893 }
1894
1895
1896 /****************************************************************************
1897 **
1898 *F ReadEmpty( <follow> ) . . . . . . . . . . . . . .read an empty statement
1899 **
1900 ** 'ReadEmpty' reads an empty statement. The argument is actually ignored
1901 **
1902 ** <Statement> := ';'
1903 */
ReadEmpty(ScannerState * s,TypSymbolSet follow)1904 static void ReadEmpty(ScannerState * s, TypSymbolSet follow)
1905 {
1906 IntrEmpty();
1907 }
1908
1909 /****************************************************************************
1910 **
1911 *F ReadInfo( <follow> ) . . . . . . . . . . . . . . . read an info statement
1912 **
1913 ** 'ReadInfo' reads an info statement. In case of an error it skips all
1914 ** symbols up to one contained in <follow>.
1915 **
1916 ** <Statement> := 'Info' '(' <Expr> ',' <Expr> { ',' <Expr> } ')' ';'
1917 */
ReadInfo(ScannerState * s,TypSymbolSet follow)1918 static void ReadInfo(ScannerState * s, TypSymbolSet follow)
1919 {
1920 volatile UInt narg; // number of arguments to print (or not)
1921
1922 TRY_IF_NO_ERROR { IntrInfoBegin(); }
1923 Match(s, S_INFO, "Info", follow);
1924 Match(s, S_LPAREN, "(", follow);
1925 ReadExpr(s, S_RPAREN | S_COMMA | follow, 'r');
1926 Match(s, S_COMMA, ",", S_RPAREN|follow);
1927 ReadExpr(s, S_RPAREN | S_COMMA | follow, 'r');
1928 TRY_IF_NO_ERROR { IntrInfoMiddle(); }
1929 narg = 0;
1930 while (s->Symbol == S_COMMA) {
1931 narg++;
1932 Match(s, S_COMMA, "", 0L);
1933 ReadExpr(s, S_RPAREN | S_COMMA | follow, 'r');
1934 }
1935 Match(s, S_RPAREN, ")", follow);
1936 TRY_IF_NO_ERROR { IntrInfoEnd(narg); }
1937 }
1938
1939
1940 /****************************************************************************
1941 **
1942 *F ReadAssert( <follow> ) . . . . . . . . . . . . . read an assert statement
1943 **
1944 ** 'ReadAssert' reads an assert statement. In case of an error it skips all
1945 ** symbols up to one contained in <follow>.
1946 **
1947 ** <Statement> := 'Assert' '(' <Expr> ',' <Expr> [ ',' <Expr> ] ')' ';'
1948 */
ReadAssert(ScannerState * s,TypSymbolSet follow)1949 static void ReadAssert(ScannerState * s, TypSymbolSet follow)
1950 {
1951 TRY_IF_NO_ERROR { IntrAssertBegin(); }
1952 Match(s, S_ASSERT, "Assert", follow);
1953 Match(s, S_LPAREN, "(", follow);
1954 ReadExpr(s, S_RPAREN | S_COMMA | follow, 'r');
1955 TRY_IF_NO_ERROR { IntrAssertAfterLevel(); }
1956 Match(s, S_COMMA, ",", S_RPAREN|follow);
1957 ReadExpr(s, S_RPAREN | S_COMMA | follow, 'r');
1958 TRY_IF_NO_ERROR { IntrAssertAfterCondition(); }
1959 if (s->Symbol == S_COMMA) {
1960 Match(s, S_COMMA, "", 0L);
1961 ReadExpr(s, S_RPAREN | follow, 'r');
1962 Match(s, S_RPAREN, ")", follow);
1963 TRY_IF_NO_ERROR { IntrAssertEnd3Args(); }
1964 }
1965 else
1966 {
1967 Match(s, S_RPAREN, ")", follow);
1968 TRY_IF_NO_ERROR { IntrAssertEnd2Args(); }
1969 }
1970 }
1971
1972 /****************************************************************************
1973 **
1974 *F ReadIf( <follow> ) . . . . . . . . . . . . . . . . read an if statement
1975 **
1976 ** 'ReadIf' reads an if-statement. In case of an error it skips all symbols
1977 ** up to one contained in <follow>.
1978 **
1979 ** <Statement> := 'if' <Expr> 'then' <Statements>
1980 ** { 'elif' <Expr> 'then' <Statements> }
1981 ** [ 'else' <Statements> ]
1982 ** 'fi' ';'
1983 */
ReadIf(ScannerState * s,TypSymbolSet follow)1984 static void ReadIf(ScannerState * s, TypSymbolSet follow)
1985 {
1986 volatile UInt nrb; /* number of branches */
1987 volatile UInt nrs; /* number of statements in a body */
1988
1989 /* 'if' <Expr> 'then' <Statements> */
1990 nrb = 0;
1991 TRY_IF_NO_ERROR { IntrIfBegin(); }
1992 Match(s, S_IF, "if", follow);
1993 ReadExpr(s, S_THEN|S_ELIF|S_ELSE|S_FI|follow, 'r');
1994 Match(s, S_THEN, "then", STATBEGIN|S_ELIF|S_ELSE|S_FI|follow);
1995 TRY_IF_NO_ERROR { IntrIfBeginBody(); }
1996 nrs = ReadStats(s, S_ELIF|S_ELSE|S_FI|follow);
1997 TRY_IF_NO_ERROR { nrb += IntrIfEndBody( nrs ); }
1998
1999 /* { 'elif' <Expr> 'then' <Statements> } */
2000 while (s->Symbol == S_ELIF) {
2001 TRY_IF_NO_ERROR { IntrIfElif(); }
2002 Match(s, S_ELIF, "elif", follow);
2003 ReadExpr(s, S_THEN|S_ELIF|S_ELSE|S_FI|follow, 'r');
2004 Match(s, S_THEN, "then", STATBEGIN|S_ELIF|S_ELSE|S_FI|follow);
2005 TRY_IF_NO_ERROR { IntrIfBeginBody(); }
2006 nrs = ReadStats(s, S_ELIF|S_ELSE|S_FI|follow);
2007 TRY_IF_NO_ERROR { nrb += IntrIfEndBody( nrs ); }
2008 }
2009
2010 /* [ 'else' <Statements> ] */
2011 if (s->Symbol == S_ELSE) {
2012 TRY_IF_NO_ERROR { IntrIfElse(); }
2013 Match(s, S_ELSE, "else", follow);
2014 TRY_IF_NO_ERROR { IntrIfBeginBody(); }
2015 nrs = ReadStats(s, S_FI|follow);
2016 TRY_IF_NO_ERROR { nrb += IntrIfEndBody( nrs ); }
2017 }
2018
2019 /* 'fi' */
2020 Match(s, S_FI, "while parsing an 'if' statement: statement or 'fi'", follow);
2021 TRY_IF_NO_ERROR { IntrIfEnd( nrb ); }
2022 }
2023
2024
2025 /****************************************************************************
2026 **
2027 *F ReadFor( <follow> ) . . . . . . . . . . . . . . . . read a for statement
2028 **
2029 ** 'ReadFor' reads a for-loop. In case of an error it skips all symbols up
2030 ** to one contained in <follow>.
2031 **
2032 ** <Statement> := 'for' <Var> 'in' <Expr> 'do'
2033 ** <Statements>
2034 ** 'od' ';'
2035 */
2036
2037
ReadFor(ScannerState * s,TypSymbolSet follow)2038 static void ReadFor(ScannerState * s, TypSymbolSet follow)
2039 {
2040 volatile UInt nrs; /* number of statements in body */
2041 volatile UInt nrError; /* copy of <STATE(NrError)> */
2042 volatile Bag currLVars; /* copy of <STATE(CurrLVars)> */
2043
2044 /* remember the current variables in case of an error */
2045 currLVars = STATE(CurrLVars);
2046 nrError = STATE(NrError);
2047
2048 /* 'for' */
2049 TRY_IF_NO_ERROR { IntrForBegin(); }
2050 Match(s, S_FOR, "for", follow);
2051
2052 /* <Var> */
2053 ReadCallVarAss(s, follow, 'r');
2054
2055 /* 'in' <Expr> */
2056 Match(s, S_IN, "in", S_DO|S_OD|follow);
2057 TRY_IF_NO_ERROR { IntrForIn(); }
2058 ReadExpr(s, S_DO|S_OD|follow, 'r');
2059
2060 /* 'do' <Statements> */
2061 Match(s, S_DO, "do", STATBEGIN|S_OD|follow);
2062 ReaderState()->LoopNesting++;
2063 TRY_IF_NO_ERROR { IntrForBeginBody(); }
2064 nrs = ReadStats(s, S_OD|follow);
2065 TRY_IF_NO_ERROR { IntrForEndBody( nrs ); }
2066 ReaderState()->LoopNesting--;
2067
2068 /* 'od' */
2069 Match(s, S_OD, "while parsing a 'for' loop: statement or 'od'", follow);
2070 TRY_IF_NO_ERROR {
2071 IntrForEnd();
2072 }
2073 CATCH_ERROR {
2074 /* an error has occurred *after* the 'IntrForBegin' */
2075 /* If we hadn't actually come out of coding the body, we need
2076 to recover. Otherwise it was probably an error in executing the
2077 body and we just return */
2078 if (nrError == 0)
2079 IntrAbortCoding(currLVars);
2080 }
2081 }
2082
2083
2084 /****************************************************************************
2085 **
2086 *F ReadWhile( <follow> ) . . . . . . . . . . . . . . read a while statement
2087 **
2088 ** 'ReadWhile' reads a while-loop. In case of an error it skips all symbols
2089 ** up to one contained in <follow>.
2090 **
2091 ** <Statement> := 'while' <Expr> 'do'
2092 ** <Statements>
2093 ** 'od' ';'
2094 */
ReadWhile(ScannerState * s,TypSymbolSet follow)2095 static void ReadWhile(ScannerState * s, TypSymbolSet follow)
2096 {
2097 volatile UInt nrs; /* number of statements in body */
2098 volatile UInt nrError; /* copy of <STATE(NrError)> */
2099 volatile Bag currLVars; /* copy of <STATE(CurrLVars)> */
2100
2101 /* remember the current variables in case of an error */
2102 currLVars = STATE(CurrLVars);
2103 nrError = STATE(NrError);
2104
2105 /* 'while' <Expr> 'do' */
2106 TRY_IF_NO_ERROR { IntrWhileBegin(); }
2107 Match(s, S_WHILE, "while", follow);
2108 ReadExpr(s, S_DO|S_OD|follow, 'r');
2109 Match(s, S_DO, "do", STATBEGIN|S_DO|follow);
2110
2111 // <Statements>
2112 ReaderState()->LoopNesting++;
2113 TRY_IF_NO_ERROR { IntrWhileBeginBody(); }
2114 nrs = ReadStats(s, S_OD|follow);
2115 TRY_IF_NO_ERROR { IntrWhileEndBody( nrs ); }
2116 ReaderState()->LoopNesting--;
2117
2118 /* 'od' */
2119 Match(s, S_OD, "while parsing a 'while' loop: statement or 'od'", follow);
2120 TRY_IF_NO_ERROR {
2121 IntrWhileEnd();
2122 }
2123 CATCH_ERROR {
2124 /* an error has occurred *after* the 'IntrWhileBegin' */
2125 /* If we hadn't actually come out of coding the body, we need
2126 to recover. Otherwise it was probably an error in executing the
2127 body and we just return */
2128 if (nrError == 0)
2129 IntrAbortCoding(currLVars);
2130 }
2131 }
2132
2133 /****************************************************************************
2134 **
2135 *F ReadAtomic( <follow> ) . . . . . . . . . . . . . . read an atomic block
2136 **
2137 ** 'ReadAtomic' reads an atomic block. In case of an error it skips all
2138 ** symbols up to one contained in <follow>.
2139 **
2140 ** <Statement> := 'atomic' <QualifiedExpression> { ',' <QualifiedExpression } 'do' <Statements> 'od' ';'
2141 **
2142 ** These functions only do something meaningful inside HPC-GAP; in plain GAP,
2143 ** they are simply placeholders.
2144 */
ReadAtomic(ScannerState * s,TypSymbolSet follow)2145 static void ReadAtomic(ScannerState * s, TypSymbolSet follow)
2146 {
2147 volatile UInt nrs; /* number of statements in body */
2148 volatile UInt nexprs; /* number of statements in body */
2149 volatile UInt nrError; /* copy of <STATE(NrError)> */
2150 volatile Bag currLVars; /* copy of <STATE(CurrLVars)> */
2151 #ifdef HPCGAP
2152 volatile int lockSP; /* lock stack */
2153 #endif
2154
2155 /* remember the current variables in case of an error */
2156 currLVars = STATE(CurrLVars);
2157 nrError = STATE(NrError);
2158 #ifdef HPCGAP
2159 lockSP = RegionLockSP();
2160 #endif
2161
2162 Match(s, S_ATOMIC, "atomic", follow);
2163 /* Might just be an atomic function literal as an expression */
2164 if (s->Symbol == S_FUNCTION) {
2165 ReadExpr(s, follow, 'a');
2166 return;
2167 }
2168
2169 /* 'atomic' <QualifiedExpression> {',' <QualifiedExpression> } 'do' */
2170 TRY_IF_NO_ERROR { IntrAtomicBegin(); }
2171
2172 ReadQualifiedExpr(s, S_DO|S_OD|follow, 'r');
2173 nexprs = 1;
2174 while (s->Symbol == S_COMMA) {
2175 Match(s, S_COMMA, ",", follow | S_DO | S_OD);
2176 ReadQualifiedExpr(s, S_DO|S_OD|follow, 'r');
2177 nexprs ++;
2178 #ifdef HPCGAP
2179 if (nexprs > MAX_ATOMIC_OBJS) {
2180 SyntaxError(s, "'atomic' statement can have at most 256 objects to lock");
2181 return;
2182 }
2183 #endif
2184 }
2185
2186 Match(s, S_DO, "do", STATBEGIN|S_DO|follow);
2187
2188 // <Statements>
2189 TRY_IF_NO_ERROR { IntrAtomicBeginBody(nexprs); }
2190 nrs = ReadStats(s, S_OD|follow);
2191 TRY_IF_NO_ERROR { IntrAtomicEndBody( nrs ); }
2192
2193 /* 'od' */
2194 Match(s, S_OD, "while parsing an atomic block: statement or 'od'", follow);
2195 TRY_IF_NO_ERROR {
2196 IntrAtomicEnd();
2197 }
2198 CATCH_ERROR {
2199 /* an error has occurred *after* the 'IntrAtomicBegin' */
2200 /* If we hadn't actually come out of coding the body, we need
2201 to recover. Otherwise it was probably an error in executing the
2202 body and we just return */
2203 if (nrError == 0)
2204 IntrAbortCoding(currLVars);
2205 }
2206 #ifdef HPCGAP
2207 /* This is a no-op if IntrAtomicEnd() succeeded, otherwise it restores
2208 * locks to where they were before. */
2209 PopRegionLocks(lockSP);
2210 #endif
2211 }
2212
2213
2214 /****************************************************************************
2215 **
2216 *F ReadRepeat( <follow> ) . . . . . . . . . . . . . read a repeat statement
2217 **
2218 ** 'ReadRepeat' reads a repeat-loop. In case of an error it skips all
2219 ** symbols up to one contained in <follow>.
2220 **
2221 ** <Statement> := 'repeat'
2222 ** <Statements>
2223 ** 'until' <Expr> ';'
2224 */
ReadRepeat(ScannerState * s,TypSymbolSet follow)2225 static void ReadRepeat(ScannerState * s, TypSymbolSet follow)
2226 {
2227 volatile UInt nrs; /* number of statements in body */
2228 volatile UInt nrError; /* copy of <STATE(NrError)> */
2229 volatile Bag currLVars; /* copy of <STATE(CurrLVars)> */
2230
2231 /* remember the current variables in case of an error */
2232 currLVars = STATE(CurrLVars);
2233 nrError = STATE(NrError);
2234
2235 /* 'repeat' */
2236 TRY_IF_NO_ERROR { IntrRepeatBegin(); }
2237 Match(s, S_REPEAT, "repeat", follow);
2238
2239 // <Statements>
2240 ReaderState()->LoopNesting++;
2241 TRY_IF_NO_ERROR { IntrRepeatBeginBody(); }
2242 nrs = ReadStats(s, S_UNTIL|follow);
2243 TRY_IF_NO_ERROR { IntrRepeatEndBody( nrs ); }
2244 ReaderState()->LoopNesting--;
2245
2246 /* 'until' <Expr> */
2247 Match(s, S_UNTIL, "while parsing a 'repeat' loop: statement or 'until'", EXPRBEGIN|follow);
2248 ReadExpr(s, follow, 'r');
2249 TRY_IF_NO_ERROR {
2250 IntrRepeatEnd();
2251 }
2252 CATCH_ERROR {
2253 /* an error has occurred *after* the 'IntrRepeatBegin' */
2254 /* If we hadn't actually come out of coding the body, we need
2255 to recover. Otherwise it was probably an error in executing the
2256 body and we just return */
2257 if (nrError == 0)
2258 IntrAbortCoding(currLVars);
2259 }
2260 }
2261
2262
2263 /****************************************************************************
2264 **
2265 *F ReadBreak(<follow>) . . . . . . . . . . . . . . . read a break statement
2266 **
2267 ** 'ReadBreak' reads a break-statement. In case of an error it skips all
2268 ** symbols up to one contained in <follow>.
2269 **
2270 ** <Statement> := 'break' ';'
2271 */
ReadBreak(ScannerState * s,TypSymbolSet follow)2272 static void ReadBreak(ScannerState * s, TypSymbolSet follow)
2273 {
2274 if (!ReaderState()->LoopNesting)
2275 SyntaxError(s, "'break' statement not enclosed in a loop");
2276
2277 /* skip the break symbol */
2278 Match(s, S_BREAK, "break", follow);
2279
2280 /* interpret the break statement */
2281 TRY_IF_NO_ERROR { IntrBreak(); }
2282 }
2283
2284 /****************************************************************************
2285 **
2286 *F ReadContinue(<follow>) . . . . . . . . . . . . read a continue statement
2287 **
2288 ** 'ReadContinue' reads a continue-statement. In case of an error it skips
2289 ** all symbols up to one contained in <follow>.
2290 **
2291 ** <Statement> := 'continue' ';'
2292 */
ReadContinue(ScannerState * s,TypSymbolSet follow)2293 static void ReadContinue(ScannerState * s, TypSymbolSet follow)
2294 {
2295 if (!ReaderState()->LoopNesting)
2296 SyntaxError(s, "'continue' statement not enclosed in a loop");
2297
2298 // skip the continue symbol
2299 Match(s, S_CONTINUE, "continue", follow);
2300
2301 // interpret the continue statement
2302 TRY_IF_NO_ERROR { IntrContinue(); }
2303 }
2304
2305
2306 /****************************************************************************
2307 **
2308 *F ReadReturn( <follow> ) . . . . . . . . . . . . . read a return statement
2309 **
2310 ** 'ReadReturn' reads a return-statement. Return with no expression
2311 ** following is used in functions to return void. In case of an error it
2312 ** skips all symbols up to one contained in <follow>.
2313 **
2314 ** <Statement> := 'return' [ <Expr> ] ';'
2315 **
2316 ** It is still legal to use parenthesis but they are no longer required,
2317 ** a return statement is not a function call and should not look like one.
2318 */
ReadReturn(ScannerState * s,TypSymbolSet follow)2319 static void ReadReturn(ScannerState * s, TypSymbolSet follow)
2320 {
2321 /* skip the return symbol */
2322 Match(s, S_RETURN, "return", follow);
2323
2324 /* 'return' with no expression following */
2325 if (IS_IN(s->Symbol, S_SEMICOLON)) {
2326 TRY_IF_NO_ERROR { IntrReturnVoid(); }
2327 }
2328
2329 /* 'return' with an expression following */
2330 else {
2331 ReadExpr(s, follow, 'r');
2332 TRY_IF_NO_ERROR { IntrReturnObj(); }
2333 }
2334 }
2335
2336
2337 /****************************************************************************
2338 **
2339 *F ReadTryNext(<follow>) . . . . . . . . . read a try-next-method statement
2340 **
2341 ** 'ReadTryNext' reads a try-next-method statement. In case of an error it
2342 ** skips all symbols up to one contained in <follow>.
2343 **
2344 ** <Statement> := 'TryNextMethod' '(' ')' ';'
2345 */
ReadTryNext(ScannerState * s,TypSymbolSet follow)2346 static void ReadTryNext(ScannerState * s, TypSymbolSet follow)
2347 {
2348 Match(s, S_TRYNEXT, "TryNextMethod", follow);
2349 Match(s, S_LPAREN, "(", follow);
2350 Match(s, S_RPAREN, ")", follow);
2351 TRY_IF_NO_ERROR {
2352 IntrRefGVar( GVarName( "TRY_NEXT_METHOD" ) );
2353 IntrReturnObj();
2354 }
2355 }
2356
ReadHelp(ScannerState * s,TypSymbolSet follow)2357 static void ReadHelp(ScannerState * s, TypSymbolSet follow)
2358 {
2359 TRY_IF_NO_ERROR { IntrHelp(s->ValueObj); }
2360 s->ValueObj = 0;
2361 }
2362
ReadPragma(ScannerState * s,TypSymbolSet follow)2363 static void ReadPragma(ScannerState * s, TypSymbolSet follow)
2364 {
2365 TRY_IF_NO_ERROR { IntrPragma(s->ValueObj); }
2366 s->ValueObj = 0;
2367 }
2368
2369 /****************************************************************************
2370 **
2371 *F ReadQuit( <follow> ) . . . . . . . . . . . . . . . read a quit statement
2372 **
2373 ** 'ReadQuit' reads a quit statement. In case of an error it skips all
2374 ** symbols up to one contained in <follow>.
2375 **
2376 ** <Statement> := 'quit' ';'
2377 */
ReadQuit(ScannerState * s,TypSymbolSet follow)2378 static void ReadQuit(ScannerState * s, TypSymbolSet follow)
2379 {
2380 /* skip the quit symbol */
2381 Match(s, S_QUIT, "quit", follow);
2382
2383 /* interpret the quit */
2384 TRY_IF_NO_ERROR { IntrQuit(); }
2385 }
2386
2387 /****************************************************************************
2388 **
2389 *F ReadQUIT( <follow> ) . . . . . . . . . . . . . . . read a QUIT statement
2390 **
2391 ** 'ReadQUIT' reads a QUIT statement. In case of an error it skips all
2392 ** symbols up to one contained in <follow>.
2393 **
2394 ** <Statement> := 'QUIT' ';'
2395 */
ReadQUIT(ScannerState * s,TypSymbolSet follow)2396 static void ReadQUIT(ScannerState * s, TypSymbolSet follow)
2397 {
2398 /* skip the quit symbol */
2399 Match(s, S_QQUIT, "QUIT", follow);
2400
2401 /* interpret the quit */
2402 TRY_IF_NO_ERROR { IntrQUIT(); }
2403 }
2404
2405
2406 /****************************************************************************
2407 **
2408 *F ReadStats(<follow>) . . . . . . . . . . . . . . read a statement sequence
2409 **
2410 ** 'ReadStats' reads a statement sequence. In case of an error it skips all
2411 ** symbols up to one contained in <follow>.
2412 **
2413 ** <Statements> := { <Statement> }
2414 **
2415 ** <Statement> := <Var> ':=' <Expr> ';'
2416 ** | <Var> '(' [ <Expr> { ',' <Expr> } ] ')' ';'
2417 ** | 'Unbind' '(' <Var> ')' ';'
2418 ** | 'if' <Expr> 'then' <Statements>
2419 ** { 'elif' <Expr> 'then' <Statements> }
2420 ** [ 'else' <Statements> ] 'fi' ';'
2421 ** | 'for' <Var> 'in' <Expr> 'do' <Statements> 'od' ';'
2422 ** | 'while' <Expr> 'do' <Statements> 'od' ';'
2423 ** | 'repeat' <Statements> 'until' <Expr> ';'
2424 ** | 'break' ';'
2425 ** | 'return' [ <Expr> ] ';'
2426 ** | 'atomic' <QualifiedExpression> { ',' <QualifiedExpression> } 'do' <Statements> 'od' ';'
2427 ** | ';'
2428 */
TryReadStatement(ScannerState * s,TypSymbolSet follow)2429 static Int TryReadStatement(ScannerState * s, TypSymbolSet follow)
2430 {
2431 switch (s->Symbol) {
2432 case S_IDENT: ReadCallVarAss(s, follow,'s'); break;
2433 case S_UNBIND: ReadUnbind(s, follow ); break;
2434 case S_INFO: ReadInfo(s, follow ); break;
2435 case S_ASSERT: ReadAssert(s, follow ); break;
2436 case S_IF: ReadIf(s, follow ); break;
2437 case S_FOR: ReadFor(s, follow ); break;
2438 case S_WHILE: ReadWhile(s, follow ); break;
2439 case S_REPEAT: ReadRepeat(s, follow ); break;
2440 case S_BREAK: ReadBreak(s, follow ); break;
2441 case S_CONTINUE: ReadContinue(s, follow ); break;
2442 case S_RETURN: ReadReturn(s, follow ); break;
2443 case S_TRYNEXT: ReadTryNext(s, follow ); break;
2444 case S_ATOMIC: ReadAtomic(s, follow ); break;
2445 case S_SEMICOLON: ReadEmpty(s, follow ); break;
2446 case S_PRAGMA: ReadPragma(s, follow ); break;
2447 case S_QUIT: SyntaxError(s, "'quit;' cannot be used in this context"); break;
2448 case S_QQUIT: SyntaxError(s, "'QUIT;' cannot be used in this context"); break;
2449 case S_HELP: SyntaxError(s, "'?' cannot be used in this context"); break;
2450 default: return 0;
2451 }
2452 return 1;
2453 }
2454
ReadStats(ScannerState * s,TypSymbolSet follow)2455 static UInt ReadStats(ScannerState * s, TypSymbolSet follow)
2456 {
2457 UInt nr = 0; // number of statements
2458
2459 // read the statements
2460 while (IS_IN(s->Symbol, STATBEGIN | S_SEMICOLON)) {
2461 if (!TryReadStatement(s, follow)) {
2462 SyntaxError(s, "statement expected");
2463 }
2464 nr++;
2465 if (s->Symbol == S_PRAGMA)
2466 Match(s, S_PRAGMA, "", 0);
2467 else
2468 MatchSemicolon(s, follow);
2469 }
2470
2471 // return the number of statements
2472 return nr;
2473 }
2474
2475
2476 /****************************************************************************
2477 **
2478 *F * * * * * * * * * * * * read and evaluate symbols * * * * * * * * * * * *
2479 */
2480
2481
2482 /****************************************************************************
2483 **
2484 *F ReadEvalCommand() . . . . . . . . . . . . . . . . . . . read one command
2485 **
2486 ** 'ReadEvalCommand' reads one command and interprets it immediately.
2487 **
2488 ** It does not expect the first symbol of its input already read and won't
2489 ** read the first symbol of the next input.
2490 **
2491 */
2492
RecreateStackNams(Obj context)2493 static void RecreateStackNams( Obj context )
2494 {
2495 Obj stackNams = ReaderState()->StackNams;
2496 Obj lvars = context;
2497 while (lvars != STATE(BottomLVars) && lvars != (Obj)0) {
2498 Obj nams = NAMS_FUNC(FUNC_LVARS(lvars));
2499 if (nams != (Obj) 0) {
2500 PushPlist(stackNams, nams);
2501 }
2502 lvars = ENVI_FUNC(FUNC_LVARS(lvars));
2503 }
2504
2505 // At this point we have the stack upside down, so invert it
2506 const UInt countNams = LEN_PLIST(stackNams);
2507 for (UInt i = 1; i <= countNams/2; i++) {
2508 const UInt j = countNams + 1 -i;
2509 Obj tmpA = ELM_PLIST(stackNams, i);
2510 Obj tmpB = ELM_PLIST(stackNams, j);
2511 SET_ELM_PLIST(stackNams, i, tmpB);
2512 SET_ELM_PLIST(stackNams, j, tmpA);
2513 }
2514 }
2515
ReadEvalCommand(Obj context,Obj * evalResult,UInt * dualSemicolon)2516 ExecStatus ReadEvalCommand(Obj context, Obj *evalResult, UInt *dualSemicolon)
2517 {
2518 volatile ExecStatus type;
2519 volatile Obj stackNams;
2520 volatile UInt readTop;
2521 volatile UInt readTilde;
2522 volatile Obj tilde;
2523 volatile UInt currLHSGVar;
2524 volatile Obj errorLVars;
2525 syJmp_buf readJmpError;
2526 #ifdef HPCGAP
2527 int lockSP;
2528 #endif
2529
2530 struct ReaderState * volatile rs = ReaderState();
2531 ScannerState * volatile s = &STATE(Scanner);
2532
2533 /* get the first symbol from the input */
2534 Match(s, s->Symbol, "", 0UL);
2535
2536 // if scanning the first symbol produced a syntax error, abort
2537 if (STATE(NrError)) {
2538 FlushRestOfInputLine();
2539 return STATUS_ERROR;
2540 }
2541
2542 /* if we have hit <end-of-file>, then give up */
2543 if (s->Symbol == S_EOF) {
2544 return STATUS_EOF;
2545 }
2546
2547 /* print only a partial prompt from now on */
2548 STATE(Prompt) = SyQuiet ? "" : "> ";
2549
2550 /* remember the old reader context */
2551 stackNams = rs->StackNams;
2552 readTop = rs->ReadTop;
2553 readTilde = rs->ReadTilde;
2554 tilde = STATE(Tilde);
2555 currLHSGVar = rs->CurrLHSGVar;
2556 errorLVars = STATE(ErrorLVars);
2557 memcpy( readJmpError, STATE(ReadJmpError), sizeof(syJmp_buf) );
2558
2559 // initialize everything and begin an interpreter
2560 rs->StackNams = NEW_PLIST( T_PLIST, 16 );
2561 rs->ReadTop = 0;
2562 rs->ReadTilde = 0;
2563 STATE(Tilde) = 0;
2564 rs->CurrLHSGVar = 0;
2565 STATE(ErrorLVars) = context;
2566 RecreateStackNams(context);
2567 #ifdef HPCGAP
2568 lockSP = RegionLockSP();
2569 #endif
2570
2571 AssGVar(GVarName("READEVALCOMMAND_LINENUMBER"), INTOBJ_INT(GetInputLineNumber()));
2572
2573 GAP_ASSERT(rs->LoopNesting == 0);
2574
2575 IntrBegin( context );
2576
2577 switch (s->Symbol) {
2578 /* read an expression or an assignment or a procedure call */
2579 case S_IDENT: ReadExpr(s, S_SEMICOLON|S_EOF, 'x' ); break;
2580
2581 // otherwise read a statement -- first handle some which are different on
2582 // the top level than inside a function, if/else or loop
2583 case S_QUIT: ReadQuit(s, S_SEMICOLON|S_EOF ); break;
2584 case S_QQUIT: ReadQUIT(s, S_SEMICOLON|S_EOF ); break;
2585 case S_HELP: ReadHelp(s, S_SEMICOLON|S_EOF ); break;
2586 case S_PRAGMA: ReadPragma(s, S_SEMICOLON|S_EOF ); break;
2587
2588 // otherwise try to read a generic statement
2589 default:
2590 if (!TryReadStatement(s, S_SEMICOLON | S_EOF)) {
2591 // not a statement, but perhaps it is an expression
2592 ReadExpr(s, S_SEMICOLON | S_EOF, 'r');
2593 }
2594 }
2595
2596 /* every statement must be terminated by a semicolon */
2597 if (!IS_IN(s->Symbol, S_SEMICOLON) && s->Symbol != S_HELP && s->Symbol != S_PRAGMA) {
2598 SyntaxError(s, "; expected");
2599 }
2600
2601 /* end the interpreter */
2602 TRY_IF_NO_ERROR {
2603 type = IntrEnd(0, evalResult);
2604
2605 /* check for dual semicolon */
2606 if (dualSemicolon)
2607 *dualSemicolon = (s->Symbol == S_DUALSEMICOLON);
2608 }
2609 CATCH_ERROR {
2610 IntrEnd(1, evalResult);
2611 type = STATUS_ERROR;
2612 #ifdef HPCGAP
2613 PopRegionLocks(lockSP);
2614 if (TLS(CurrentHashLock))
2615 HashUnlock(TLS(CurrentHashLock));
2616 #endif
2617 }
2618
2619 GAP_ASSERT(rs->LoopNesting == 0);
2620
2621 /* switch back to the old reader context */
2622 memcpy( STATE(ReadJmpError), readJmpError, sizeof(syJmp_buf) );
2623 rs->StackNams = stackNams;
2624 rs->ReadTop = readTop;
2625 rs->ReadTilde = readTilde;
2626 STATE(Tilde) = tilde;
2627 rs->CurrLHSGVar = currLHSGVar;
2628 STATE(ErrorLVars) = errorLVars;
2629
2630 /* return whether a return-statement or a quit-statement were executed */
2631 return type;
2632 }
2633
2634 /****************************************************************************
2635 **
2636 *F ReadEvalFile() . . . . . . . . . . . . . . . . . . . . . . . read a file
2637 **
2638 ** 'ReadEvalFile' reads an entire file and returns (in 'evalResult') the
2639 ** entire file as thunk, i.e., as function of no argument.
2640 **
2641 ** It does not expect the first symbol of its input already read and wont
2642 ** reads to the end of the input (unless an error happens).
2643 */
ReadEvalFile(Obj * evalResult)2644 UInt ReadEvalFile(Obj *evalResult)
2645 {
2646 volatile ExecStatus type;
2647 volatile Obj stackNams;
2648 volatile UInt readTop;
2649 volatile UInt readTilde;
2650 volatile Obj tilde;
2651 volatile UInt currLHSGVar;
2652 syJmp_buf readJmpError;
2653 volatile UInt nr;
2654 volatile Obj nams;
2655 volatile Int nloc;
2656 volatile Bag currLVars; /* copy of <STATE(CurrLVars)> */
2657 #ifdef HPCGAP
2658 volatile int lockSP;
2659 #endif
2660
2661 struct ReaderState * volatile rs = ReaderState();
2662 ScannerState * volatile s = &STATE(Scanner);
2663
2664 /* get the first symbol from the input */
2665 Match(s, s->Symbol, "", 0UL);
2666
2667 /* if we have hit <end-of-file>, then give up */
2668 if (s->Symbol == S_EOF) {
2669 return STATUS_EOF;
2670 }
2671
2672 /* print only a partial prompt from now on */
2673 STATE(Prompt) = SyQuiet ? "" : "> ";
2674
2675 /* remember the old reader context */
2676 stackNams = rs->StackNams;
2677 readTop = rs->ReadTop;
2678 readTilde = rs->ReadTilde;
2679 tilde = STATE(Tilde);
2680 currLHSGVar = rs->CurrLHSGVar;
2681 #ifdef HPCGAP
2682 lockSP = RegionLockSP();
2683 #endif
2684 memcpy( readJmpError, STATE(ReadJmpError), sizeof(syJmp_buf) );
2685
2686 // initialize everything and begin an interpreter
2687 rs->StackNams = NEW_PLIST( T_PLIST, 16 );
2688 rs->ReadTop = 0;
2689 rs->ReadTilde = 0;
2690 STATE(Tilde) = 0;
2691 rs->CurrLHSGVar = 0;
2692 IntrBegin(STATE(BottomLVars));
2693
2694 GAP_ASSERT(rs->LoopNesting == 0);
2695
2696 /* check for local variables */
2697 nams = NEW_PLIST(T_PLIST, 0);
2698 PushPlist(rs->StackNams, nams);
2699 nloc = 0;
2700 if (s->Symbol == S_LOCAL) {
2701 nloc = ReadLocals(s, 0, nams);
2702 }
2703
2704 currLVars = STATE(CurrLVars);
2705
2706 /* fake the 'function ()' */
2707 IntrFuncExprBegin(0, nloc, nams, GetInputLineNumber());
2708
2709 /* read the statements */
2710 {
2711 UInt oldLoopNesting = rs->LoopNesting;
2712 rs->LoopNesting = 0;
2713 nr = ReadStats(s, S_SEMICOLON | S_EOF);
2714 rs->LoopNesting = oldLoopNesting;
2715 }
2716
2717 GAP_ASSERT(rs->LoopNesting == 0);
2718
2719 /* we now want to be at <end-of-file> */
2720 if (s->Symbol != S_EOF) {
2721 SyntaxError(s, "<end-of-file> expected");
2722 }
2723
2724 /* fake the 'end;' */
2725 TRY_IF_NO_ERROR {
2726 IntrFuncExprEnd(nr);
2727 }
2728 CATCH_ERROR {
2729 IntrAbortCoding(currLVars);
2730 }
2731
2732 /* end the interpreter */
2733 TRY_IF_NO_ERROR {
2734 type = IntrEnd(0, evalResult);
2735 }
2736 CATCH_ERROR {
2737 IntrEnd(1, evalResult);
2738 type = STATUS_ERROR;
2739 }
2740
2741 /* switch back to the old reader context */
2742 memcpy( STATE(ReadJmpError), readJmpError, sizeof(syJmp_buf) );
2743 #ifdef HPCGAP
2744 PopRegionLocks(lockSP);
2745 if (TLS(CurrentHashLock))
2746 HashUnlock(TLS(CurrentHashLock));
2747 #endif
2748 rs->StackNams = stackNams;
2749 rs->ReadTop = readTop;
2750 rs->ReadTilde = readTilde;
2751 STATE(Tilde) = tilde;
2752 rs->CurrLHSGVar = currLHSGVar;
2753
2754 /* return whether a return-statement or a quit-statement were executed */
2755 return type;
2756 }
2757
2758
2759 /****************************************************************************
2760 **
2761 *F ReadEvalError() . . . . . . . . . . . . . . . . . . return with an error
2762 */
ReadEvalError(void)2763 void ReadEvalError(void)
2764 {
2765 STATE(PtrBody) = PTR_BAG(BODY_FUNC(CURR_FUNC()));
2766 STATE(PtrLVars) = PTR_BAG(STATE(CurrLVars));
2767 syLongjmp( &(STATE(ReadJmpError)), 1 );
2768 }
2769
2770
2771 /****************************************************************************
2772 **
2773 ** Reader state -- the next group of functions are used to "push" the
2774 ** current interpreter state allowing GAP code to be interpreted in the
2775 ** middle of other code. This is used, for instance, in the command-line
2776 ** editor.
2777 */
2778
2779
2780 struct SavedReaderState {
2781 Obj stackNams;
2782 UInt readTop;
2783 UInt readTilde;
2784 UInt currLHSGVar;
2785 UInt userHasQuit;
2786 syJmp_buf readJmpError;
2787 UInt intrCoding;
2788 UInt intrIgnoring;
2789 UInt intrReturning;
2790 UInt nrError;
2791 };
2792
SaveReaderState(struct SavedReaderState * s)2793 static void SaveReaderState(struct SavedReaderState *s) {
2794 s->stackNams = ReaderState()->StackNams;
2795 s->readTop = ReaderState()->ReadTop;
2796 s->readTilde = ReaderState()->ReadTilde;
2797 s->currLHSGVar = ReaderState()->CurrLHSGVar;
2798 s->userHasQuit = STATE(UserHasQuit);
2799 s->intrCoding = STATE(IntrCoding);
2800 s->intrIgnoring = STATE(IntrIgnoring);
2801 s->intrReturning = STATE(IntrReturning);
2802 s->nrError = STATE(NrError);
2803 memcpy( s->readJmpError, STATE(ReadJmpError), sizeof(syJmp_buf) );
2804 }
2805
ClearReaderState(void)2806 static void ClearReaderState(void ) {
2807 ReaderState()->StackNams = NEW_PLIST( T_PLIST, 16 );
2808 ReaderState()->ReadTop = 0;
2809 ReaderState()->ReadTilde = 0;
2810 ReaderState()->CurrLHSGVar = 0;
2811 STATE(UserHasQuit) = 0;
2812 STATE(IntrCoding) = 0;
2813 STATE(IntrIgnoring) = 0;
2814 STATE(IntrReturning) = 0;
2815 STATE(NrError) = 0;
2816 }
2817
RestoreReaderState(const struct SavedReaderState * s)2818 static void RestoreReaderState(const struct SavedReaderState *s) {
2819 memcpy( STATE(ReadJmpError), s->readJmpError, sizeof(syJmp_buf) );
2820 STATE(UserHasQuit) = s->userHasQuit;
2821 ReaderState()->StackNams = s->stackNams;
2822 ReaderState()->ReadTop = s->readTop;
2823 ReaderState()->ReadTilde = s->readTilde;
2824 ReaderState()->CurrLHSGVar = s->currLHSGVar;
2825 STATE(IntrCoding) = s->intrCoding;
2826 STATE(IntrIgnoring) = s->intrIgnoring;
2827 STATE(IntrReturning) = s->intrReturning;
2828 STATE(NrError) = s->nrError;
2829 }
2830
2831
2832 /****************************************************************************
2833 **
2834 *F Call0ArgsInNewReader(Obj f) . . . . . . . . . . . . call a GAP function
2835 **
2836 ** The current reader context is saved and a new one is started.
2837 */
Call0ArgsInNewReader(Obj f)2838 Obj Call0ArgsInNewReader(Obj f)
2839
2840 {
2841 /* for the new interpreter context: */
2842 /* ExecStatus type; */
2843 struct SavedReaderState s;
2844 Obj result;
2845
2846 /* remember the old reader context */
2847 SaveReaderState(&s);
2848
2849 // initialize everything and begin an interpreter
2850 ClearReaderState();
2851 IntrBegin( STATE(BottomLVars) );
2852
2853 TRY_IF_NO_ERROR {
2854 result = CALL_0ARGS(f);
2855 PushVoidObj();
2856 /* end the interpreter */
2857 IntrEnd(0, NULL);
2858 }
2859 CATCH_ERROR {
2860 result = (Obj) 0L;
2861 IntrEnd(1, NULL);
2862 ClearError();
2863 }
2864
2865 /* switch back to the old reader context */
2866 RestoreReaderState(&s);
2867 return result;
2868 }
2869
2870 /****************************************************************************
2871 **
2872 *F Call1ArgsInNewReader(Obj f,Obj a) . . . . . . . . . . call a GAP function
2873 **
2874 ** The current reader context is saved and a new one is started.
2875 */
Call1ArgsInNewReader(Obj f,Obj a)2876 Obj Call1ArgsInNewReader(Obj f,Obj a)
2877
2878 {
2879 /* for the new interpreter context: */
2880 /*ExecStatus type; */
2881 struct SavedReaderState s;
2882 Obj result;
2883
2884 /* remember the old reader context */
2885
2886 SaveReaderState(&s);
2887
2888 // initialize everything and begin an interpreter
2889 ClearReaderState();
2890 IntrBegin( STATE(BottomLVars) );
2891
2892 TRY_IF_NO_ERROR {
2893 result = CALL_1ARGS(f,a);
2894 PushVoidObj();
2895 /* end the interpreter */
2896 IntrEnd(0, NULL);
2897 }
2898 CATCH_ERROR {
2899 result = (Obj) 0L;
2900 IntrEnd(1, NULL);
2901 ClearError();
2902 }
2903
2904 /* switch back to the old reader context */
2905 RestoreReaderState(&s);
2906 return result;
2907 }
2908
2909
2910 /****************************************************************************
2911 **
2912 *F * * * * * * * * * * * * * initialize module * * * * * * * * * * * * * * *
2913 */
2914
2915 /****************************************************************************
2916 **
2917 *F InitKernel( <module> ) . . . . . . . . initialise kernel data structures
2918 */
InitKernel(StructInitInfo * module)2919 static Int InitKernel (
2920 StructInitInfo * module )
2921 {
2922 #if !defined(HPCGAP)
2923 InitGlobalBag(&ReaderState()->StackNams, "src/read.c:StackNams");
2924 #endif
2925 InitCopyGVar( "GAPInfo", &GAPInfo);
2926 /* return success */
2927 return 0;
2928 }
2929
2930
InitModuleState(void)2931 static Int InitModuleState(void)
2932 {
2933 STATE(ErrorLVars) = (UInt **)0;
2934 ReaderState()->StackNams = NEW_PLIST(T_PLIST, 16);
2935 ReaderState()->ReadTop = 0;
2936 ReaderState()->ReadTilde = 0;
2937 ReaderState()->CurrLHSGVar = 0;
2938 ReaderState()->CurrentGlobalForLoopDepth = 0;
2939
2940 // return success
2941 return 0;
2942 }
2943
2944
2945 /****************************************************************************
2946 **
2947 *F InitInfoRead() . . . . . . . . . . . . . . . . . table of init functions
2948 */
2949 static StructInitInfo module = {
2950 // init struct using C99 designated initializers; for a full list of
2951 // fields, please refer to the definition of StructInitInfo
2952 .type = MODULE_BUILTIN,
2953 .name = "read",
2954 .initKernel = InitKernel,
2955
2956 .moduleStateSize = sizeof(struct ReaderState),
2957 .moduleStateOffsetPtr = &ReaderStateOffset,
2958 .initModuleState = InitModuleState,
2959 };
2960
InitInfoRead(void)2961 StructInitInfo * InitInfoRead ( void )
2962 {
2963 return &module;
2964 }
2965