/[ascend]/branches/relerrorlist/ascend/compiler/ascParse.y
ViewVC logotype

Contents of /branches/relerrorlist/ascend/compiler/ascParse.y

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3217 - (show annotations) (download)
Sat Oct 28 07:01:00 2017 UTC (18 months, 3 weeks ago) by jpye
File size: 72511 byte(s)
fixing va_copy errors and snprintf warnings from gcc 7.2.0

1 /*
2 ASCEND modelling environment
3
4 Copyright (C) 1990, 1993, 1994 Thomas Guthrie Epperly
5 Copyright (C) 1997 Benjamin Andrew Allan & Vicente Rico-Ramirez
6 Copyright (C) 1998, 2006 Carnegie Mellon University
7
8 This program is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 2, or (at your option)
11 any later version.
12
13 This program is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
17
18 You should have received a copy of the GNU General Public License
19 along with Foobar. If not, see <http://www.gnu.org/licenses/>.
20 *//*
21 ASCEND parser
22 by Tom Epperly
23 Last in CVS: $Revision: 1.23 $ $Date: 2000/01/25 02:25:59 $ $Author: ballan $
24 */
25
26 /*------------------------------------------------------------------------------
27 PROLOGUE
28 */
29 %{
30 #include <stdio.h>
31 #include <stdarg.h>
32 #include <limits.h> /* need DBL_MAX and LONG_MAX */
33 #include <float.h> /* on a NeXT they are in here */
34
35 #include <ascend/compiler/parser.h>
36
37 #include <ascend/general/ascMalloc.h>
38 #include <ascend/general/list.h>
39 #include <ascend/general/dstring.h>
40 #include <ascend/compiler/compiler.h>
41 #include <ascend/compiler/scanner.h>
42 #include <ascend/compiler/symtab.h> /* the global string/symbol table */
43 #include <ascend/compiler/notate.h> /* notes database wrapper */
44 #include <ascend/compiler/braced.h>
45 #include <ascend/compiler/fractions.h>
46 #include <ascend/compiler/dimen.h>
47 #include <ascend/compiler/functype.h>
48 #include <ascend/compiler/func.h>
49 #include <ascend/compiler/expr_types.h>
50 #include <ascend/compiler/name.h>
51 #include <ascend/compiler/nameio.h>
52 #include <ascend/compiler/instance_enum.h>
53 #include <ascend/compiler/extfunc.h>
54 #include <ascend/compiler/packages.h>
55 #include <ascend/compiler/sets.h>
56 #include <ascend/compiler/exprs.h>
57 #include <ascend/compiler/exprio.h>
58 #include <ascend/compiler/vlist.h>
59 #include <ascend/compiler/vlistio.h> /* for debugging only */
60 #include <ascend/compiler/stattypes.h>
61 #include <ascend/compiler/slist.h>
62 #include <ascend/compiler/statement.h>
63 #include <ascend/compiler/statio.h>
64 #include <ascend/compiler/units.h>
65 #include <ascend/compiler/when.h>
66 #include <ascend/compiler/select.h>
67 #include <ascend/compiler/switch.h>
68 #include <ascend/compiler/proc.h>
69 #include <ascend/compiler/watchpt.h>
70 #include <ascend/compiler/module.h>
71 #include <ascend/compiler/child.h>
72 #include <ascend/compiler/type_desc.h>
73 #include <ascend/compiler/type_descio.h>
74 #include <ascend/compiler/typedef.h>
75 #include <ascend/compiler/library.h>
76 #include <ascend/compiler/syntax.h>
77 #include <ascend/compiler/lexer.h>
78
79 /* 1 ==> expr can find missing , w/o shift/reduce conflicts */
80 #define COMMAEXPR_NOTBUGGY 0
81 #if COMMAEXPR_NOTBUGGY
82 #include <ascend/compiler/exprio.h>
83 #endif /* for CommaExpr if working. */
84
85 //#define ASCPARSE_DEBUG
86 #ifdef ASCPARSE_DEBUG
87 # define MSG CONSOLE_DEBUG
88 #else
89 # define MSG(ARGS...) ((void)0)
90 #endif
91
92
93 int g_compiler_warnings = 1; /* level of whine to allow */
94
95 #include <ascend/compiler/redirectFile.h>
96 #ifndef ASCERR
97 # error "ASCERR not defined"
98 #endif
99
100 //#define ASCPARSE_DEBUG
101 #ifdef ASCPARSE_DEBUG
102 # define MSG CONSOLE_DEBUG
103 #else
104 # define MSG(ARGS...) ((void)0)
105 #endif
106
107 extern int zz_error(char *);
108 /* provided at the end of this file.
109 * it increments g_untrapped_error, the global defined below
110 */
111
112 static unsigned long g_header_linenum = 0;
113 static unsigned int g_untrapped_error = 0;
114 /* if g_untrapped_error is set to 1, the current definition
115 * should be abandoned even if nothing else detectable by
116 * typedef.c exists. basically any syntax error should cause a type
117 * to be abandoned, but not all cause the parser to barf.
118 */
119
120 /* the last seen method name while processing a method */
121 static symchar *g_proc_name=NULL;
122
123 /* the last seen ATOM/MODEL/constant type and refinement base */
124 static symchar *g_type_name=NULL;
125 static symchar *g_refines_name=NULL;
126 /*
127 * g_type_name is used by the scanner when closing a module to check if
128 * the parser is in the middle of parsing a MODEL or ATOM type
129 * definition.
130 * g_type_name == NULL implies that the parser is in between
131 * definitions. This depends on proper
132 * resets to NULL at END of type productions.
133 * g_type_name != NULL implies that the parser is in the middle
134 * of a type definition and gives the name
135 * of that type.
136 */
137
138 static symchar *g_end_identifier = NULL;
139 /* This variable gets reset every time we see an ``END_TOK''. If the
140 * token after END_TOK is missing (i.e., ``END;'') or if it is recognized
141 * (e.g., FOR_TOK), set this variable to NULL. When we see an
142 * ``END_TOK IDENTIFIER_TOK'', set this variable to the pointer into the
143 * symbol table returned by the scanner.
144 */
145
146 static struct StatementList *g_model_parameters=NULL;
147 /* this is the statementlist of the parameterized type
148 */
149
150 static struct StatementList *g_parameter_wheres=NULL;
151 /* this is the where list of a parameterized type. restrictions on args
152 */
153
154 static struct StatementList *g_parameter_reduction=NULL;
155 /* this is the statementlist of the REFINES clause
156 * at present both might be null, which is bad.
157 */
158
159 static struct Set *g_typeargs=NULL;
160 /* optional args to a typename in part declaration.
161 * it is set in the production type_identifier. in
162 * contexts where args are not allowed, use IDENTIFIER_TOK instead of the
163 * type_identifier production.
164 */
165
166 static struct Set *g_callargs=NULL;
167 /* optional args to a user defined method.
168 * it is set in the production call_identifier. in
169 * contexts where args are not allowed, use IDENTIFIER_TOK instead of the
170 * type_identifier production.
171 */
172
173 static struct gl_list_t *g_notelist = NULL;
174 /*
175 * Notes accumulator until a type commits or destroys it.
176 */
177
178 static int g_defaulted; /* used for atoms,constants */
179
180 static CONST dim_type *g_dim_ptr; /* dim of last units parsed, or so */
181 static CONST dim_type *g_atom_dim_ptr; /* dim of DIMENSION decl */
182 static CONST dim_type *g_default_dim_ptr; /* dim of default value parsed */
183
184 static double g_default_double;
185 static long g_default_long;
186 symchar *g_default_symbol;
187 #define DOUBLECONSTANT 0
188 #define LONGCONSTANT 1
189 #define BOOLEANCONSTANT 2
190 #define SYMBOLCONSTANT 3
191 static int g_constant_type = DOUBLECONSTANT;
192 static CONST struct Units *g_units_ptr;
193
194 int g_parse_relns = 1;
195 /* Should we parse relations?
196 * 0 indicates don't parse relations
197 * 1 indicates process them
198 */
199
200 /* Forward declaration of error message reporting
201 * functions provided at the end of this file.
202 */
203 static void ErrMsg_Generic(CONST char *);
204 static void ErrMsg_CommaName(CONST char *, struct Name *);
205 #if COMMAEXPR_NOTBUGGY
206 static void ErrMsg_CommaExpr(CONST char *, struct Expr *);
207 #endif /* COMMAEXPR_NOTBUGGY */
208 static void ErrMsg_NullDefPointer(CONST char *);
209 static void ErrMsg_ParensBrackets(CONST char *);
210 static void WarnMsg_MismatchEnd(CONST char *, CONST char *,
211 unsigned long, CONST char *);
212 static CONST char *TokenAsString(unsigned long);
213
214 static void error_reporter_current_line(const error_severity_t sev, const char *fmt,...);
215
216 /** @page ascend-notes About 'NOTES' in ASCEND
217 *
218 * The parser will now parse a NOTES block as well as in-lined NOTES. As
219 * a matter of fact, the parser would probably parse FORTRAN now since it
220 * is very lenient. For the in-lined NOTES, I accept any "doubly-quoted"
221 * string after an `fname'. I am currently dropping the NOTE on the
222 * floor. Ideally, we should only accept an inline NOTE when we are
223 * creating a new thing, like in an IS_A statement or a labeled relation.
224 * That means either adding the optional_note to fname and whining at the
225 * user when he/she uses the in-lined notes incorrectly, or coming up
226 * with a fvarnotelist and fnamenote that accepts fnames and
227 * optional_notes in a list or a stand-alone form.
228 *
229 * For the block NOTES statement, the symtax is
230 *
231 * NOTES ( SYMBOL_TOK ( fvarlist BRACEDTEXT_TOK )+ )+ END NOTES ';'
232 *
233 * Here I am using () as part of the meta-language to describe the syntax
234 * to you, they are not part of the formal grammer. An example is
235 *
236 * NOTES
237 * 'text' a,b,c { Here is some text }
238 * d { Here is more text }
239 * 'html' SELF { <bold>html sucks</bold> }
240 * END NOTES;
241 *
242 * Note that the only punctuation is the `,' between the members of the
243 * fvarlist and the closing `;'. Right now, the term `SELF' would be
244 * eaten in the fvarlist production. I'm not sure if this is what we
245 * should do (which requires having the notes processing do something
246 * special when it sees SELF in the fvarlist), or if we should create
247 * a SELF_TOK token. The latter is certainly easier to implement from
248 * the parser's perspective, which is why I did it that way.
249 *
250 * The block NOTES statement doesn't do anything with its stuff either,
251 * the symbols and {bracedText} get dropped on the floor and I destroy
252 * the fvarlist, but that all that happens.
253 *
254 * The `notes_body' and `noteslist' productions return `notes_ptr', which
255 * right now is a `void*' until we can decide what type of data structure
256 * we want to handle NOTES.
257 *
258 * As an amusing side note, the parser will currently eat the following:
259 *
260 * NOTES
261 * 'fun' name "put some text here" {put more text here}
262 * END NOTES;
263 *
264 * Like I said, this is so the parser will eat them; it's not being real
265 * smart about what it does with them.
266 *
267 * For debugging the NOTES stuff, set the DEBUG_NOTES macro to the
268 * following:
269 *
270 * #define DEBUG_NOTES(s) FPRINTF(stderr,"****DISCARDED NOTES:\n%s****\n",(s))
271 *
272 * To completely ignore the NOTES, set DEBUG_NOTES to the following:
273 *
274 * #define DEBUG_NOTES(s) 0
275 *
276 * Note that if you do the latter, you'll get `statement with no effect'
277 * warnings from gcc -Wall.
278 *
279 * -- Mark Thomas Thursday, 13 March 1997
280 */
281 /* #define DEBUG_NOTES(s) 0 */
282 #define DEBUG_NOTES(s) ERROR_REPORTER_NOLINE(ASC_USER_WARNING,"Discarded note: %s", (s))
283
284 /*
285 * Because the ascend types and notes are not tightly bound to each other,
286 * what with notes being stored in a database,
287 * We collect notes locally until the type associated with a batch of notes
288 * is approved by typedef and other error checks. Then we process the
289 * collected notes, commiting them to the database.
290 *
291 * NOTES made via ADD NOTES do not require a type check first and the
292 * type may not even exist yet in the library.
293 *
294 * ProcessNotes(keep); Clear up collected list, commit them if keep != 0.
295 * CollectNote(note); Add a note to the collected list.
296 */
297 static void ProcessNotes(int);
298 static void CollectNote(struct Note *);
299
300 /* For 'inline' notes, note on DQUOTE_TOK from scanner.l:
301 * Remember that DQUOTE_TOK is a string value which is local to the
302 * production that finds it. It must be copied if you want to
303 * keep it.
304 */
305
306 /* MS VC++ won't compiler Bison output unless we switch this */
307 #ifdef _MSC_VER
308 # define __STDC__
309 #endif
310
311 %}
312 /* END OF PROLOGUE
313 ------------------------------------------------------------------------------
314 DEFINITION OF PARSER RETURN TYPE
315 */
316
317 %union {
318 double real_value;
319 long int_value;
320 struct fraction frac_value;
321 symchar *id_ptr;
322 CONST char *braced_ptr; /* pointer for units, explanations, tables */
323 symchar *sym_ptr; /* pointer for symbols */
324 CONST char *dquote_ptr; /* for text in "double quotes" */
325 struct Name *nptr;
326 struct Expr *eptr;
327 struct Set *sptr;
328 struct VariableList *lptr;
329 struct Statement *statptr;
330 struct StatementList *slptr;
331 struct SelectList *septr;
332 struct SwitchList *swptr;
333 struct WhenList *wptr;
334 struct NoteTmp *notesptr; /* change this once struct Notes is defined */
335 struct gl_list_t *listp;
336 struct InitProcedure *procptr;
337 CONST dim_type *dimp;
338 struct TypeDescription *tptr;
339 struct UnitDefinition *udefptr;
340 dim_type dimen;
341 enum ForOrder order;
342 enum ForKind fkind;
343 }
344
345 /*------------------------------------------------------------------------------
346 YACC TOKENS
347 */
348
349 %token ADD_TOK ALIASES_TOK AND_TOK ANY_TOK AREALIKE_TOK ARETHESAME_TOK ARRAY_TOK ASSERT_TOK ATOM_TOK
350 %token BEQ_TOK BNE_TOK BREAK_TOK
351 %token CALL_TOK CARD_TOK CASE_TOK CHOICE_TOK CHECK_TOK CONDITIONAL_TOK CONSTANT_TOK
352 %token CONTINUE_TOK CREATE_TOK
353 %token DATA_TOK DECREASING_TOK DEFAULT_TOK DEFINITION_TOK DER_TOK DIMENSION_TOK
354 %token DIMENSIONLESS_TOK DO_TOK
355 %token ELSE_TOK END_TOK EXPECT_TOK EXTERNAL_TOK
356 %token FALSE_TOK FALLTHRU_TOK FIX_TOK FOR_TOK FREE_TOK FROM_TOK
357 %token GLOBAL_TOK
358 %token IF_TOK IGNORE_TOK IMPORT_TOK IN_TOK INPUT_TOK INCREASING_TOK INTERACTIVE_TOK INDEPENDENT_TOK
359 %token INTERSECTION_TOK ISA_TOK _IS_T ISREFINEDTO_TOK
360 %token LINK_TOK
361 %token MAXIMIZE_TOK MAXINTEGER_TOK MAXREAL_TOK METHODS_TOK METHOD_TOK MINIMIZE_TOK MODEL_TOK
362 %token NOT_TOK NOTES_TOK
363 %token OF_TOK OPTION_TOK OR_TOK OTHERWISE_TOK OUTPUT_TOK
364 %token PATCH_TOK PROD_TOK PROVIDE_TOK
365 %token REFINES_TOK REPLACE_TOK REQUIRE_TOK RETURN_TOK RUN_TOK
366 %token SATISFIED_TOK SELECT_TOK SIZE_TOK SOLVE_TOK SOLVER_TOK STOP_TOK SUCHTHAT_TOK SUM_TOK SWITCH_TOK
367 %token THEN_TOK TRUE_TOK
368 %token UNION_TOK UNITS_TOK UNIVERSAL_TOK UNLINK_TOK
369 %token WHEN_TOK WHERE_TOK WHILE_TOK WILLBE_TOK WILLBETHESAME_TOK WILLNOTBETHESAME_TOK
370 %token ASSIGN_TOK CASSIGN_TOK DBLCOLON_TOK USE_TOK LEQ_TOK GEQ_TOK NEQ_TOK
371 %token DOTDOT_TOK WITH_TOK VALUE_TOK WITH_VALUE_T
372 %token <real_value> REAL_TOK
373 %token <int_value> INTEGER_TOK
374 %token <id_ptr> IDENTIFIER_TOK
375 %token <braced_ptr> BRACEDTEXT_TOK
376 %token <sym_ptr> SYMBOL_TOK
377 %token <dquote_ptr> DQUOTE_TOK
378
379 /* Set associativities */
380 %left ',' '|' SUCHTHAT_TOK
381 %left BEQ_TOK BNE_TOK
382 %left AND_TOK OR_TOK IN_TOK
383 %left '<' '=' '>' LEQ_TOK GEQ_TOK NEQ_TOK
384 %left '+' '-'
385 %left '/' '*'
386 %left UMINUS_TOK UPLUS_TOK
387 %right '^'
388 %left NOT_TOK
389 %start definitions
390
391 %type <real_value> default_val number realnumber opunits
392 %type <int_value> end optional_sign universal
393 %type <fkind> forexprend
394 %type <frac_value> fraction fractail
395 %type <id_ptr> optional_of optional_method type_identifier call_identifier
396 %type <dquote_ptr> optional_notes
397 %type <braced_ptr> optional_bracedtext
398 %type <nptr> data_args fname name optional_scope
399 %type <eptr> relation expr relop logrelop optional_with_value
400 %type <sptr> set setexprlist optional_set_values
401 %type <lptr> fvarlist input_args output_args varlist
402
403 %type <statptr> statement isa_statement willbe_statement aliases_statement
404 %type <statptr> is_statement isrefinedto_statement arealike_statement link_statement unlink_statement der_statement independent_statement
405 %type <statptr> arethesame_statement willbethesame_statement
406 %type <statptr> willnotbethesame_statement assignment_statement
407 %type <statptr> relation_statement glassbox_statement blackbox_statement
408 %type <statptr> call_statement units_statement
409 %type <statptr> external_statement for_statement run_statement if_statement assert_statement fix_statement free_statement
410 %type <statptr> when_statement use_statement select_statement
411 %type <statptr> conditional_statement notes_statement
412 %type <statptr> flow_statement while_statement
413 %type <statptr> solve_statement solver_statement option_statement switch_statement
414
415 %type <slptr> fstatements global_def optional_else
416 %type <slptr> optional_model_parameters optional_parameter_reduction
417 %type <slptr> optional_parameter_wheres
418 %type <septr> selectlist selectlistf
419 %type <swptr> switchlist switchlistf
420 %type <wptr> whenlist whenlistf
421 %type <notesptr> notes_body noteslist
422 %type <listp> methods proclist proclistf statements unitdeflist complex_statement fix_and_assign_statement
423 %type <procptr> procedure
424 %type <dimp> dims dimensions
425 %type <dimen> dimexpr
426 %type <order> optional_direction
427 %type <tptr> add_method_head replace_method_head
428 %type <udefptr> unitdef
429 %type <id_ptr> model_id atom_id procedure_id definition_id
430
431 /* stuff without a particular need for a type */
432
433 /*------------------------------------------------------------------------------
434 GRAMMAR RULES
435 */
436
437 %%
438
439 definitions:
440 /* empty */
441 | definitions definition
442 ;
443
444 definition:
445 require_file
446 | provide_module
447 | import
448 | add_method_def
449 | replace_method_def
450 | add_notes_def
451 | constant_def
452 | atom_def
453 | model_def
454 | definition_def
455 | patch_def
456 | units_def
457 | global_def
458 | error
459 {
460 ErrMsg_Generic("Error in definition.");
461 }
462 ;
463
464 global_def:
465 GLOBAL_TOK ';' fstatements end ';'
466 {
467 /* the following steps apply to string buffers only, not files */
468 struct gl_list_t *stats;
469 int dispose;
470 if ($3 != NULL) {
471 stats = gl_create(1L);
472 gl_append_ptr(stats,(void *)$3);
473 if (g_untrapped_error) {
474 ErrMsg_Generic("Because of a syntax error, the following statements are being ignored:");
475 WriteStatementList(ASCERR,$3,4);
476 DestroyStatementList($3);
477 }else{
478 dispose = Asc_ModuleAddStatements(Asc_CurrentModule(),stats);
479 switch (dispose) {
480 case 1: /* appended */
481 if (stats != NULL) {
482 gl_destroy(stats);
483 }
484 break;
485 case 0: /* kept */
486 break;
487 case -1: /* illegal in file */
488 ErrMsg_Generic("GLOBAL statements can only be made interactively. Ignoring:");
489 if (stats != NULL) {
490 WriteStatementList(ASCERR,$3,4);
491 gl_iterate(stats,(DestroyFunc)DestroyStatementList);
492 gl_destroy(stats);
493 }
494 break;
495 default:
496 break;
497 }
498 }
499 }
500 /* don't let any bizarreness in string parsing hang around */
501 g_type_name = g_refines_name = g_proc_name = NULL;
502 g_model_parameters =
503 g_parameter_reduction =
504 g_parameter_wheres = NULL;
505 g_untrapped_error = 0;
506 }
507 ;
508
509 require_file:
510 REQUIRE_TOK DQUOTE_TOK ';'
511 {
512 Asc_ScannerPushBuffer($2);
513 }
514 | REQUIRE_TOK name ';'
515 {
516 DestroyName($2);
517 ErrMsg_Generic("REQUIRE statement syntax is 'REQUIRE \"filename\";'.");
518 }
519 | REQUIRE_TOK name
520 {
521 DestroyName($2);
522 ErrMsg_Generic("REQUIRE statement syntax is 'REQUIRE \"filename\";'.");
523 }
524 ;
525
526 provide_module:
527 PROVIDE_TOK DQUOTE_TOK ';'
528 {
529 Asc_ModuleCreateAlias(Asc_CurrentModule(),$2);
530 }
531 | PROVIDE_TOK name ';'
532 {
533 DestroyName($2);
534 ErrMsg_Generic("PROVIDE statement syntax is 'PROVIDE \"filename\";'.");
535 }
536 | PROVIDE_TOK name
537 {
538 DestroyName($2);
539 ErrMsg_Generic("PROVIDE statement syntax is 'PROVIDE \"filename\";'.");
540 }
541 ;
542
543 import:
544 IMPORT_TOK IDENTIFIER_TOK FROM_TOK DQUOTE_TOK ';'
545 {
546 if(package_load($4,SCP($2))){
547 error_reporter_current_line(ASC_USER_ERROR
548 ,"IMPORT of '%s' from '%s'."
549 ,SCP($4), SCP($2)
550 );
551 }
552 }
553 | IMPORT_TOK DQUOTE_TOK ';'
554 {
555 if(package_load(SCP($2),NULL)){
556 error_reporter_current_line(ASC_USER_ERROR
557 ,"IMPORT of '%s' failed."
558 ,SCP($2)
559 );
560 }
561 }
562 ;
563
564 add_notes_def:
565 add_notes_head notes_body end ';'
566 {
567 /* see comments for notes statement. */
568 if( $3 != NOTES_TOK ) {
569 WarnMsg_MismatchEnd("NOTES", NULL, $3, NULL);
570 }
571 if ($2 != NULL) {
572 struct NoteTmp *nt;
573 symchar *lang=NULL; /* dummy */
574 nt = $2;
575 while (nt != NULL) {
576 if (nt->lang != NULL) {
577 lang = nt->lang;
578 }
579 /* save exploding vardata to simple entries until we keep */
580 CollectNote(CreateNote(g_type_name, lang, NULL, g_proc_name,
581 Asc_ModuleBestName(Asc_CurrentModule()),
582 nt->bt,
583 nt->line, nt->vardata, nd_vlist));
584 nt = nt->next;
585 }
586 /* now keep them */
587 ProcessNotes(1);
588 DestroyNoteTmpList($2);
589 }
590 g_type_name = g_proc_name = NULL;
591 g_untrapped_error = 0;
592 }
593 ;
594
595 add_notes_head:
596 ADD_TOK NOTES_TOK IN_TOK IDENTIFIER_TOK optional_method ';'
597 {
598 g_type_name = $4;
599 g_proc_name = $5;
600 }
601 ;
602
603 add_method_def:
604 add_method_head proclist end ';'
605 {
606 if ($1 == NULL) {
607 DestroyProcedureList($2);
608 } else {
609 if( $3 != METHODS_TOK ) {
610 WarnMsg_MismatchEnd("ADD METHODS", NULL, $3, "METHODS");
611 }
612 if (AddMethods($1,$2,g_untrapped_error) != 0) {
613 if ($1 != ILLEGAL_DEFINITION) {
614 error_reporter_current_line(ASC_USER_ERROR
615 ,"ADD METHODS failed for type %s"
616 ,SCP(GetName($1))
617 );
618 DestroyProcedureList($2);
619 } /* else adding in DEFINITION MODEL may have misgone */
620 }
621 }
622 g_untrapped_error = 0;
623 }
624 ;
625
626 add_method_head:
627 ADD_TOK METHODS_TOK IN_TOK IDENTIFIER_TOK ';'
628 {
629 struct TypeDescription *tmptype;
630 tmptype = FindType($4);
631 if(tmptype == NULL){
632 error_reporter_current_line(ASC_USER_ERROR
633 ,"ADD METHODS called with undefined type (%s)"
634 ,SCP($4)
635 );
636 }
637 $$ = tmptype; /* parent should check for NULL */
638 g_type_name = $4; /* scope for notes */
639 }
640 | ADD_TOK METHODS_TOK IN_TOK DEFINITION_TOK MODEL_TOK ';'
641 {
642 $$ = ILLEGAL_DEFINITION;
643 /* need a bit of global state here to tag base methods */
644 }
645 ;
646
647 replace_method_def:
648 replace_method_head proclist end ';'
649 {
650 if ($1 == NULL) {
651 DestroyProcedureList($2);
652 } else {
653 if( $3 != METHODS_TOK ) {
654 WarnMsg_MismatchEnd("REPLACE METHODS", NULL, $3, "METHODS");
655 }
656 if (ReplaceMethods($1,$2,g_untrapped_error) != 0) {
657 error_reporter_current_line(ASC_USER_ERROR
658 ,"REPLACE METHODS failed for type %s"
659 ,SCP(GetName($1))
660 );
661 DestroyProcedureList($2);
662 }
663 }
664 g_untrapped_error = 0;
665 }
666 ;
667
668 replace_method_head:
669 REPLACE_TOK METHODS_TOK IN_TOK IDENTIFIER_TOK ';'
670 {
671 struct TypeDescription *tmptype;
672 tmptype = FindType($4);
673 if (tmptype == NULL) {
674 error_reporter_current_line(ASC_USER_ERROR
675 ,"REPLACE METHODS called with undefined type (%s)"
676 ,SCP($4)
677 );
678 }
679 $$ = tmptype; /* parent should check for NULL */
680 }
681 | REPLACE_TOK METHODS_TOK IN_TOK DEFINITION_TOK MODEL_TOK ';'
682 {
683 $$ = ILLEGAL_DEFINITION;
684 /* need a bit of global state here to tag base methods */
685 }
686 ;
687
688 atom_def:
689 universal atom_head fstatements methods end ';'
690 {
691 struct TypeDescription *def_ptr;
692 int keepnotes = 0;
693
694 if(( $5 != IDENTIFIER_TOK ) || ( g_end_identifier != g_type_name )) {
695 /* all identifier_t are from symbol table, so ptr match
696 * is sufficient for equality.
697 */
698 WarnMsg_MismatchEnd("ATOM", SCP(g_type_name),
699 $5, SCP(g_type_name));
700 }
701 g_atom_dim_ptr = CheckDimensionsMatch(g_default_dim_ptr,
702 g_atom_dim_ptr);
703 if (g_atom_dim_ptr != NULL) {
704 def_ptr = CreateAtomTypeDef(g_type_name,
705 g_refines_name,
706 real_type, /* ignored..really */
707 Asc_CurrentModule(),
708 $1,
709 $3,
710 $4,
711 g_defaulted,
712 g_default_double,
713 g_atom_dim_ptr,
714 g_default_long,
715 g_default_symbol,
716 g_untrapped_error);
717 if (def_ptr != NULL) {
718 keepnotes = AddType(def_ptr);
719 } else {
720 /* CreateAtomTypeDef is responsible for freeing (if needed)
721 * all args sent to it event of failure so we don't have to.
722 * In particular $3 $4 should be killed before returning NULL.
723 */
724 ErrMsg_NullDefPointer(SCP(g_type_name));
725 }
726 } else {
727 error_reporter(ASC_USER_ERROR,Asc_ModuleBestName(Asc_CurrentModule()),g_header_linenum,NULL
728 ,"Atom dimensions don't match in ATOM %s"
729 ,SCP(g_type_name)
730 );
731 DestroyStatementList($3);
732 DestroyProcedureList($4);
733 }
734 ProcessNotes(keepnotes);
735 g_type_name = g_refines_name = g_proc_name = NULL;
736 g_untrapped_error = 0;
737 }
738 ;
739
740 atom_head:
741 atom_id REFINES_TOK IDENTIFIER_TOK dims default_val ';'
742 {
743 /* g_type_name = $1; */
744 g_refines_name = $3;
745 g_atom_dim_ptr = $4;
746 g_default_double = $5;
747 g_header_linenum = LineNum();
748 }
749 ;
750
751 atom_id:
752 ATOM_TOK IDENTIFIER_TOK
753 {
754 $$ = $2;
755 g_type_name = $2; /* want this set early so parm lists see it */
756 }
757 ;
758
759 default_val:
760 /* empty */
761 {
762 $$ = 0.0;
763 g_default_dim_ptr = WildDimension();
764 g_defaulted = 0;
765 }
766 | DEFAULT_TOK optional_sign number
767 {
768 $$ = $2 ? -$3 : $3;
769 g_defaulted = 1;
770 }
771 | DEFAULT_TOK FALSE_TOK
772 {
773 $$ = 0.0;
774 g_default_dim_ptr = Dimensionless();
775 g_default_long = 0;
776 g_defaulted = 1;
777 }
778 | DEFAULT_TOK TRUE_TOK
779 {
780 $$ = 0.0;
781 g_default_dim_ptr = Dimensionless();
782 g_default_long = 1;
783 g_defaulted = 1;
784 }
785 | DEFAULT_TOK SYMBOL_TOK
786 {
787 $$ = 0.0;
788 g_default_dim_ptr = Dimensionless();
789 g_default_symbol = $2;
790 g_defaulted = 0;
791 }
792 ;
793
794 constant_def:
795 universal constant_head
796 {
797 struct TypeDescription *def_ptr;
798 int keepnotes = 0;
799 if (g_defaulted) {
800 g_atom_dim_ptr = CheckDimensionsMatch(g_default_dim_ptr,
801 g_atom_dim_ptr);
802 }
803 if (g_atom_dim_ptr != NULL) {
804 def_ptr = CreateConstantTypeDef(g_type_name,
805 g_refines_name,
806 Asc_CurrentModule(),
807 $1,
808 g_defaulted,
809 g_default_double,
810 g_default_long,
811 g_default_symbol,
812 g_atom_dim_ptr,
813 g_untrapped_error);
814 if (def_ptr != NULL) {
815 keepnotes = AddType(def_ptr);
816 } else {
817 ErrMsg_NullDefPointer(SCP(g_type_name));
818 }
819 } else {
820 error_reporter(ASC_USER_ERROR,Asc_ModuleBestName(Asc_CurrentModule()),g_header_linenum,NULL,
821 "Constant dimensions don't match in CONSTANT %s"
822 " on line %s:%lu.\n",
823 SCP(g_type_name),
824 Asc_ModuleBestName(Asc_CurrentModule()),
825 g_header_linenum);
826 }
827 ProcessNotes(keepnotes);
828 g_type_name = g_refines_name = NULL;
829 g_untrapped_error = 0;
830 }
831 ;
832
833 constant_head:
834 CONSTANT_TOK IDENTIFIER_TOK REFINES_TOK IDENTIFIER_TOK dims constant_val
835 optional_notes ';'
836 {
837 g_type_name = $2;
838 g_refines_name = $4;
839 g_atom_dim_ptr = $5;
840 switch (g_constant_type) {
841 case DOUBLECONSTANT:
842 g_default_double = $<real_value>6;
843 break;
844 case LONGCONSTANT:
845 g_default_long = $<real_value>6;
846 break;
847 case BOOLEANCONSTANT:
848 g_default_long = $<int_value>6;
849 break;
850 case SYMBOLCONSTANT:
851 g_default_symbol = $<sym_ptr>6;
852 break;
853 default:
854 ErrMsg_Generic("Wierd constant type assign encountered.");
855 break; /* better not be reached. */
856 }
857 g_header_linenum = LineNum();
858 if ($7 != NULL) {
859 CollectNote(CreateNote(g_type_name,InlineNote(),SelfNote(),NULL,
860 Asc_ModuleBestName(Asc_CurrentModule()),
861 AddBraceChar($7,InlineNote()),
862 g_header_linenum,NULL,nd_empty));
863 }
864 }
865 ;
866
867 constant_val:
868 /* empty */
869 {
870 $<real_value>$ = 0.0;
871 g_default_dim_ptr = WildDimension();
872 g_defaulted = 0;
873 }
874 | CASSIGN_TOK optional_sign number
875 {
876 $<real_value>$ = $2 ? -$3 : $3;
877 g_defaulted = 1;
878 }
879 | CASSIGN_TOK TRUE_TOK
880 {
881 $<int_value>$ = 1;
882 g_defaulted = 1;
883 g_default_dim_ptr = Dimensionless();
884 g_constant_type = BOOLEANCONSTANT;
885 }
886 | CASSIGN_TOK FALSE_TOK
887 {
888 $<int_value>$ = 0;
889 g_defaulted = 1;
890 g_default_dim_ptr = Dimensionless();
891 g_constant_type = BOOLEANCONSTANT;
892 }
893 | CASSIGN_TOK SYMBOL_TOK
894 {
895 $<sym_ptr>$ = $2;
896 g_defaulted = 1;
897 g_default_dim_ptr = Dimensionless();
898 g_constant_type = SYMBOLCONSTANT;
899 }
900 ;
901
902 model_def:
903 universal model_head fstatements methods end ';'
904 {
905 struct TypeDescription *def_ptr;
906 int keepnotes = 0;
907 if(( $5 != IDENTIFIER_TOK ) || ( g_end_identifier != g_type_name )) {
908 /* all identifier_t are from symbol table, so ptr match
909 * is sufficient for equality.
910 */
911 WarnMsg_MismatchEnd("MODEL", SCP(g_type_name),
912 $5, SCP(g_type_name));
913 }
914 def_ptr = CreateModelTypeDef(g_type_name,
915 g_refines_name,
916 Asc_CurrentModule(),
917 $1,
918 $3,
919 $4,
920 g_model_parameters,
921 g_parameter_reduction,
922 g_parameter_wheres,
923 g_untrapped_error);
924 if (def_ptr != NULL) {
925 keepnotes = AddType(def_ptr);
926 } else {
927 /* CreateModelTypeDef is responsible for freeing (if needed)
928 * all args sent to it so we don't have to here.
929 * in particular $3 $4 g_model_parameters, g_parameter_reduction,
930 * and g_parameter_wheres.
931 */
932 ErrMsg_NullDefPointer(SCP(g_type_name));
933 }
934 ProcessNotes(keepnotes);
935 g_type_name = g_refines_name = NULL;
936 g_model_parameters =
937 g_parameter_reduction =
938 g_parameter_wheres = NULL;
939 g_untrapped_error = 0;
940 }
941 ;
942
943 model_head:
944 model_id optional_model_parameters
945 optional_parameter_wheres ';'
946 {
947 /* g_type_name = $1; */
948 g_model_parameters = $2;
949 g_parameter_wheres = $3;
950 g_refines_name = NULL;
951 g_header_linenum = LineNum();
952 }
953 | model_id optional_model_parameters optional_parameter_wheres
954 REFINES_TOK IDENTIFIER_TOK optional_parameter_reduction ';'
955 {
956 /* g_type_name = $1; */
957 g_model_parameters = $2;
958 g_parameter_wheres = $3;
959 g_refines_name = $5;
960 g_parameter_reduction = $6;
961 g_header_linenum = LineNum();
962 }
963 ;
964
965 model_id:
966 MODEL_TOK IDENTIFIER_TOK
967 {
968 $$ = $2;
969 g_type_name = $2; /* want this set early so parm lists see it */
970 }
971 ;
972
973 optional_model_parameters:
974 /* empty */
975 {
976 $$ = NULL;
977 }
978 | '(' fstatements ')'
979 {
980 $$ = $2; /* this could be much more sophisticated */
981 }
982 ;
983
984 optional_parameter_wheres:
985 /* empty */
986 {
987 $$ = NULL;
988 }
989 | WHERE_TOK '(' fstatements ')'
990 {
991 $$ = $3; /* this could be much more sophisticated */
992 }
993 ;
994
995 optional_parameter_reduction:
996 /* empty */
997 {
998 $$ = NULL;
999 }
1000 | '(' fstatements ')'
1001 {
1002 $$ = $2; /* this could be much more sophisticated */
1003 }
1004 ;
1005
1006 patch_def:
1007 patch_head fstatements methods end ';'
1008 {
1009 struct TypeDescription *def_ptr;
1010 if (($4 != IDENTIFIER_TOK ) || ( g_end_identifier != g_type_name )) {
1011 /* all identifier_t are from symbol table, so ptr match
1012 * is sufficient for equality.
1013 */
1014 WarnMsg_MismatchEnd("PATCH", SCP(g_type_name),
1015 $4, SCP(g_type_name));
1016 }
1017 def_ptr = CreatePatchTypeDef(g_type_name,
1018 g_refines_name,
1019 NULL,
1020 Asc_CurrentModule(),
1021 $2,
1022 $3,
1023 g_untrapped_error);
1024 g_untrapped_error = 0;
1025 if (def_ptr != NULL) {
1026 AddType(def_ptr);
1027 } else {
1028 /* CreatePatchTypeDef is responsible for freeing (if needed)
1029 * all args sent to it so we don't have to here.
1030 * in particular $2 $3
1031 */
1032 ErrMsg_NullDefPointer(SCP(g_type_name));
1033 }
1034 g_type_name = g_refines_name = g_proc_name = NULL;
1035 }
1036 ;
1037
1038 patch_head:
1039 PATCH_TOK IDENTIFIER_TOK FOR_TOK IDENTIFIER_TOK ';'
1040 {
1041 /*
1042 * A patch definition looks just like a model def.
1043 * with the original name <=> refine name.
1044 */
1045 g_type_name = $2;
1046 g_refines_name = $4;
1047 g_header_linenum = LineNum();
1048 }
1049 ;
1050
1051 universal:
1052 /* empty */
1053 {
1054 $$ = 0;
1055 }
1056 | UNIVERSAL_TOK
1057 {
1058 $$ = 1;
1059 }
1060 ;
1061
1062 definition_def:
1063 definition_id fstatements methods end ';'
1064 {
1065 struct TypeDescription *def_ptr;
1066 int keepnotes = 0;
1067
1068 if(( $4 != IDENTIFIER_TOK ) || ( g_end_identifier != $1 )) {
1069 WarnMsg_MismatchEnd("DEFINITION", SCP($1), $4, SCP($1));
1070 }
1071 if( $1 == GetBaseTypeName(relation_type)) {
1072 def_ptr = CreateRelationTypeDef(Asc_CurrentModule(),$1,$2,$3);
1073 }
1074 else if( $1 == GetBaseTypeName(logrel_type) ) {
1075 def_ptr = CreateLogRelTypeDef(Asc_CurrentModule(),$1,$2,$3);
1076 }
1077 else {
1078 ErrMsg_Generic("Bad type passed to DEFINITION statement.");
1079 def_ptr = NULL;
1080 }
1081 if ( def_ptr != NULL ) {
1082 keepnotes = AddType(def_ptr);
1083 } else {
1084 ErrMsg_NullDefPointer(SCP($1));
1085 }
1086 ProcessNotes(keepnotes);
1087 g_type_name = NULL;
1088 g_untrapped_error = 0;
1089 }
1090 ;
1091
1092 definition_id:
1093 DEFINITION_TOK IDENTIFIER_TOK
1094 {
1095 $$ = $2;
1096 g_type_name = $2; /* want this set early so parm lists see it */
1097 }
1098 ;
1099
1100
1101 units_def:
1102 units_statement ';'
1103 { /* nothing to do. just cruft to fix ; problem */ }
1104 ;
1105
1106 units_statement:
1107 UNITS_TOK unitdeflist end
1108 {
1109 struct UnitDefinition *ud;
1110 unsigned long c,len;
1111
1112 if( $3 != UNITS_TOK ) {
1113 WarnMsg_MismatchEnd("UNITS", NULL, $3, NULL);
1114 }
1115 len = gl_length($2);
1116 for (c=1; c <= len; c++) {
1117 ud = (struct UnitDefinition *)gl_fetch($2,c);
1118 ProcessUnitDef(ud);
1119 DestroyUnitDef(ud);
1120 }
1121 gl_destroy($2);
1122 $$ = NULL;
1123 }
1124 ;
1125
1126 unitdeflist:
1127 {
1128 $$ = gl_create(100L);
1129 }
1130 | unitdeflist unitdef
1131 {
1132 gl_append_ptr($1,(char *)$2);
1133 $$ = $1;
1134 }
1135 ;
1136
1137 unitdef:
1138 IDENTIFIER_TOK '=' BRACEDTEXT_TOK ';'
1139 {
1140 $$ = CreateUnitDef($1,$3,Asc_ModuleBestName(Asc_CurrentModule()),
1141 LineNum());
1142 }
1143 ;
1144
1145
1146 methods:
1147 /* empty */
1148 {
1149 $$ = NULL;
1150 }
1151 | METHODS_TOK
1152 { /* To get rid of this, we will need a global proclist
1153 * that accumulates procs until a MODEL production is
1154 * completed. If any other sort of production is started,
1155 * and proclist is not NULL, it should be discarded.
1156 */
1157 }
1158 proclist
1159 {
1160 $$ = $3;
1161 }
1162 ;
1163
1164 proclist:
1165 proclistf
1166 {
1167 $$ = $1;
1168 gl_sort($$,(CmpFunc)CmpProcs);
1169 }
1170 ;
1171
1172 proclistf:
1173 {
1174 $$ = gl_create(7L);
1175 }
1176 | proclistf procedure
1177 {
1178 unsigned long c;
1179 struct InitProcedure *oldproc;
1180 c = gl_length($1);
1181 while (c > 0) {
1182 oldproc = (struct InitProcedure *)gl_fetch($1,c);
1183 if (ProcName($2) == ProcName(oldproc)) {
1184 error_reporter_current_line(ASC_USER_WARNING
1185 ,"Duplicate METHOD %s rejected", SCP(ProcName($2))
1186 );
1187 break;
1188 }
1189 c--;
1190 }
1191 if (c) { /* broke early */
1192 DestroyProcedure($2);
1193 } else {
1194 gl_append_ptr($1,(char *)$2);
1195 }
1196 $$ = $1;
1197 }
1198 ;
1199
1200 procedure:
1201 procedure_id ';' fstatements end ';'
1202 {
1203 if (($4 != IDENTIFIER_TOK) || ($1 != g_end_identifier)) {
1204 /* all identifier_t are from symbol table, so ptr match
1205 * is sufficient for equality.
1206 */
1207 WarnMsg_MismatchEnd("METHOD", SCP($1), $4, SCP($1));
1208 }
1209 $$ = CreateProcedure($1,$3);
1210 g_proc_name = NULL;
1211 }
1212 ;
1213
1214 procedure_id:
1215 METHOD_TOK IDENTIFIER_TOK
1216 {
1217 $$ = $2;
1218 g_proc_name = $2;
1219 }
1220 ;
1221
1222
1223 fstatements:
1224 statements
1225 {
1226 $$ = CreateStatementList($1);
1227 }
1228 ;
1229
1230 statements:
1231 /* empty */
1232 {
1233 $$ = gl_create(7L);
1234 }
1235 | statements statement ';'
1236 {
1237 /* this is appending to a gllist of statements, not yet slist. */
1238 if ($2 != NULL) {
1239 gl_append_ptr($1,(char *)$2);
1240 }
1241 $$ = $1;
1242 }
1243 | statements complex_statement ';'
1244 {
1245 if ($2 != NULL) {
1246 gl_append_list($1,$2);
1247 }
1248 $$ = $1;
1249 }
1250 | statements error ';'
1251 {
1252 ErrMsg_Generic("Error in statement input.");
1253 $$ = $1;
1254 }
1255 ;
1256
1257 statement:
1258 isa_statement
1259 | willbe_statement
1260 | aliases_statement
1261 | is_statement
1262 | isrefinedto_statement
1263 | arealike_statement
1264 | link_statement
1265 | unlink_statement
1266 | der_statement
1267 | independent_statement
1268 | arethesame_statement
1269 | willbethesame_statement
1270 | willnotbethesame_statement
1271 | assignment_statement
1272 | relation_statement
1273 | glassbox_statement
1274 | blackbox_statement
1275 | call_statement
1276 | external_statement
1277 | for_statement
1278 | run_statement
1279 | fix_statement
1280 | free_statement
1281 | solver_statement
1282 | solve_statement
1283 | option_statement
1284 | assert_statement
1285 | if_statement
1286 | while_statement
1287 | when_statement
1288 | use_statement
1289 | flow_statement
1290 | select_statement
1291 | switch_statement
1292 | conditional_statement
1293 | notes_statement
1294 | units_statement
1295 ;
1296
1297 complex_statement:
1298 fix_and_assign_statement
1299 ;
1300
1301
1302 isa_statement:
1303 fvarlist ISA_TOK type_identifier optional_of optional_with_value
1304 {
1305 struct TypeDescription *tmptype;
1306 tmptype = FindType($3);
1307 if ($5 != NULL) {
1308 ErrMsg_Generic("WITH VALUE clause not allowed in IS_A.");
1309 g_untrapped_error++;
1310 DestroyVariableList($1);
1311 DestroySetList(g_typeargs);
1312 DestroyExprList($5);
1313 $$ = NULL;
1314 } else {
1315 if (tmptype != NULL) {
1316 if ((GetBaseType(tmptype) != model_type) &&
1317 (g_typeargs != NULL)) {
1318 error_reporter_current_line(ASC_USER_ERROR,
1319 "IS_A has arguments to the nonmodel type %s.\n",
1320 SCP($3));
1321 DestroyVariableList($1);
1322 DestroySetList(g_typeargs);
1323 DestroyExprList($5);
1324 g_untrapped_error++;
1325 $$ = NULL;
1326 } else {
1327 $$ = CreateISA($1,$3,g_typeargs,$4);
1328 }
1329 } else {
1330 error_reporter_current_line(ASC_USER_ERROR,"IS_A uses the undefined type %s.", SCP($3));
1331 DestroyVariableList($1);
1332 DestroySetList(g_typeargs);
1333 DestroyExprList($5);
1334 g_untrapped_error++;
1335 $$ = NULL;
1336 }
1337 }
1338 g_typeargs = NULL;
1339
1340 }
1341 ;
1342
1343 willbe_statement:
1344 fvarlist WILLBE_TOK type_identifier optional_of optional_with_value
1345 {
1346 struct TypeDescription *tmptype;
1347 tmptype = FindType($3);
1348 if (tmptype != NULL) {
1349 if ((GetBaseType(tmptype) != model_type) &&
1350 (g_typeargs != NULL)) {
1351 error_reporter_current_line(ASC_USER_ERROR,"WILL_BE has arguments to the nonmodel type '%s'",SCP($3));
1352 DestroyVariableList($1);
1353 DestroySetList(g_typeargs);
1354 DestroyExprList($5);
1355 g_untrapped_error++;
1356 $$ = NULL;
1357 } else {
1358 $$ = CreateWILLBE($1,$3,g_typeargs,$4,$5);
1359 }
1360 } else {
1361 DestroyVariableList($1);
1362 DestroySetList(g_typeargs);
1363 DestroyExprList($5);
1364 g_untrapped_error++;
1365 $$ = NULL;
1366 error_reporter_current_line(ASC_USER_ERROR,"WILL_BE uses the undefined type %s.",SCP($3));
1367 }
1368 g_typeargs = NULL;
1369 }
1370 ;
1371
1372 aliases_statement:
1373 fvarlist ALIASES_TOK fname
1374 {
1375 $$ = CreateALIASES($1,$3);
1376 }
1377 | fvarlist ALIASES_TOK '(' fvarlist ')' WHERE_TOK fvarlist ISA_TOK
1378 IDENTIFIER_TOK OF_TOK IDENTIFIER_TOK optional_set_values
1379 {
1380 int carray_err;
1381 carray_err = 0;
1382 if (VariableListLength($1) != 1L) {
1383 carray_err = 1;
1384 error_reporter_current_line(ASC_USER_ERROR,
1385 "Compound ALIASES allows only 1 LHS name. Found:");
1386 WriteVariableList(ASCERR,$1);
1387 }
1388 if (VariableListLength($7) != 1L) {
1389 carray_err = 1;
1390 error_reporter_current_line(ASC_USER_ERROR,
1391 "Compound ALIASES/IS_A allows only one LHS name. Found:");
1392 WriteVariableList(ASCERR,$7);
1393 }
1394 /* verify $9 == "set" */
1395 if (!carray_err && $9 != GetBaseTypeName(set_type)) {
1396 carray_err = 1;
1397 error_reporter_current_line(ASC_USER_ERROR,"Compound ALIASES statement requires IS_A %s. ",SCP(GetBaseTypeName(set_type)));
1398 FPRINTF(ASCERR," Found %s.\n",SCP($9));
1399 }
1400 /* verify set type */
1401 if ((!carray_err) &&
1402 ($11 != GetBaseTypeName(symbol_constant_type)) &&
1403 ($11 != GetBaseTypeName(integer_constant_type))) {
1404 carray_err = 1;
1405 error_reporter_current_line(ASC_USER_ERROR,
1406 "Compound ALIASES IS_A statement requires %s or %s.\n",
1407 SCP(GetBaseTypeName(integer_constant_type)),
1408 SCP(GetBaseTypeName(symbol_constant_type)));
1409 FPRINTF(ASCERR," Found %s.\n",SCP($11));
1410 }
1411 if (carray_err) {
1412 DestroyVariableList($1);
1413 DestroyVariableList($4);
1414 DestroyVariableList($7);
1415 DestroySetList($12);
1416 g_untrapped_error++;
1417 $$ = NULL;
1418 } else {
1419 int intset;
1420 intset = ($11 == GetBaseTypeName(integer_constant_type));
1421 $$ = CreateARR($1,$4,$7,intset,$12);
1422 }
1423 }
1424 ;
1425
1426 optional_set_values:
1427 /* empty */
1428 {
1429 $$ = NULL;
1430 }
1431 | WITH_VALUE_T '(' set ')'
1432 {
1433 $$ = $3;
1434 }
1435 ;
1436
1437 is_statement:
1438 fvarlist _IS_T IDENTIFIER_TOK optional_of
1439 {
1440 if (FindType($3)) {
1441 $$ = CreateREF($1,$3,$4,1);
1442 } else {
1443 $$ = CreateREF($1,$3,$4,1);
1444 error_reporter_current_line(ASC_USER_WARNING,"_IS_ uses the unbuilt prototype %s.\n",SCP($3));
1445 }
1446 }
1447 ;
1448
1449 isrefinedto_statement:
1450 fvarlist ISREFINEDTO_TOK type_identifier
1451 {
1452 struct TypeDescription *tmptype;
1453 tmptype = FindType($3);
1454 if (tmptype != NULL) {
1455 if ((GetBaseType(tmptype) != model_type) &&
1456 (g_typeargs != NULL)) {
1457 error_reporter_current_line(ASC_USER_ERROR,"IS_REFINED_TO has arguments to the nonmodel type %s.",SCP($3));
1458 DestroyVariableList($1);
1459 DestroySetList(g_typeargs);
1460 g_untrapped_error++;
1461 $$ = NULL;
1462 } else {
1463 $$ = CreateIRT($1,$3,g_typeargs);
1464 }
1465 } else {
1466 error_reporter_current_line(ASC_USER_ERROR,"The IS_REFINED_TO uses the undefined type %s.\n",SCP($3));
1467 DestroyVariableList($1);
1468 DestroySetList(g_typeargs);
1469 g_untrapped_error++;
1470 $$ = NULL;
1471 }
1472 g_typeargs = NULL;
1473 }
1474 ;
1475
1476 call_identifier:
1477 IDENTIFIER_TOK
1478 {
1479 $$ = $1;
1480 g_callargs = NULL;
1481 }
1482 | IDENTIFIER_TOK '(' set ')'
1483 {
1484 $$ = $1;
1485 g_callargs = $3;
1486 }
1487 ;
1488
1489 type_identifier:
1490 IDENTIFIER_TOK
1491 {
1492 $$ = $1;
1493 g_typeargs = NULL;
1494 }
1495 | IDENTIFIER_TOK '(' set ')'
1496 {
1497 $$ = $1;
1498 g_typeargs = $3;
1499 }
1500 ;
1501
1502 optional_method:
1503 /* empty */
1504 {
1505 $$ = NULL;
1506 }
1507 | METHOD_TOK IDENTIFIER_TOK
1508 {
1509 $$ = $2;
1510 }
1511 ;
1512
1513 optional_of:
1514 /* empty */
1515 {
1516 $$ = NULL;
1517 }
1518 | OF_TOK IDENTIFIER_TOK
1519 {
1520 $$ = $2;
1521 }
1522 ;
1523
1524 optional_with_value:
1525 /* empty */
1526 {
1527 $$ = NULL;
1528 }
1529 | WITH_VALUE_T expr
1530 {
1531 $$ = $2;
1532 }
1533 ;
1534
1535 arealike_statement:
1536 fvarlist AREALIKE_TOK
1537 {
1538 $$ = CreateAA($1);
1539 }
1540 ;
1541
1542 link_statement:
1543 LINK_TOK '(' IGNORE_TOK ',' SYMBOL_TOK ',' fvarlist ')'
1544 {
1545 $$ = IgnoreLNK($5,NULL,$7);
1546 }
1547 | LINK_TOK '(' SYMBOL_TOK ',' fvarlist ')'
1548 {
1549 $$ = CreateLNK($3,NULL,$5);
1550 }
1551 | LINK_TOK '(' fname ',' fvarlist ')'
1552 {
1553 $$ = CreateLNK(NULL,$3,$5);
1554 }
1555 ;
1556
1557 unlink_statement:
1558 UNLINK_TOK '(' SYMBOL_TOK ',' fvarlist ')'
1559 {
1560 $$ = CreateUNLNK($3,NULL,$5);
1561 }
1562 | UNLINK_TOK '(' fname ',' fvarlist ')'
1563 {
1564 $$ = CreateUNLNK(NULL,$3,$5);
1565 }
1566 ;
1567
1568 der_statement:
1569 DER_TOK '(' fvarlist ')'
1570 {
1571 symchar *str;
1572 str = AddSymbol("ode");
1573 $$ = CreateLNK(str,NULL,$3);
1574 }
1575 ;
1576
1577 independent_statement:
1578 INDEPENDENT_TOK fvarlist
1579 {
1580 symchar *str;
1581 str = AddSymbol("independent");
1582 $$ = CreateLNK(str,NULL,$2);
1583 }
1584 ;
1585
1586 arethesame_statement:
1587 fvarlist ARETHESAME_TOK
1588 {
1589 $$ = CreateATS($1);
1590 }
1591 ;
1592
1593 willbethesame_statement:
1594 fvarlist WILLBETHESAME_TOK
1595 {
1596 $$ = CreateWBTS($1);
1597 }
1598 ;
1599
1600 willnotbethesame_statement:
1601 fvarlist WILLNOTBETHESAME_TOK
1602 {
1603 $$ = CreateWNBTS($1);
1604 }
1605 ;
1606
1607 assignment_statement:
1608 fname ASSIGN_TOK expr
1609 {
1610 $$ = CreateASSIGN($1,$3);
1611 }
1612 | fname CASSIGN_TOK expr
1613 {
1614 $$ = CreateCASSIGN($1,$3);
1615 }
1616 ;
1617
1618 relation_statement:
1619 relation
1620 {
1621 if (IsRelation($1)) {
1622 if (g_parse_relns == 0) {
1623 DestroyExprList($1);
1624 $$ = NULL;
1625 } else {
1626 $$ = CreateREL(NULL,$1);
1627 }
1628 } else {
1629 $$ = CreateLOGREL(NULL,$1);
1630 }
1631 }
1632 | fname ':' relation
1633 {
1634 if (IsRelation($3)) {
1635 if (g_parse_relns == 0) {
1636 DestroyExprList($3);
1637 DestroyName($1);
1638 $$ = NULL;
1639 } else {
1640 $$ = CreateREL($1,$3);
1641 }
1642 } else {
1643 $$ = CreateLOGREL($1,$3);
1644 }
1645 }
1646 ;
1647
1648 relation:
1649 expr
1650 {
1651 $$ = $1;
1652 if (NumberOfRelOps($1) < 1) {
1653 /* want at least 1. restriction to exactly 1 is in typelint */
1654 ErrMsg_Generic("Missing punctuation (,;:) or else expression contains the \
1655 wrong number of relation operators (=, ==, <, >, <=, >=, !=) preceeding or.");
1656 g_untrapped_error++;
1657 }
1658 }
1659 | MINIMIZE_TOK expr
1660 {
1661 $$ = JoinExprLists($2,CreateOpExpr(e_minimize));
1662 if (NumberOfRelOps($2) > 0) {
1663 ErrMsg_Generic("Objective function contains relation operators (=, ==, <, >, <=, >=, !=).");
1664 g_untrapped_error++;
1665 }
1666 }
1667 | MAXIMIZE_TOK expr
1668 {
1669 $$ = JoinExprLists($2,CreateOpExpr(e_maximize));
1670 if (NumberOfRelOps($2)>0) {
1671 ErrMsg_Generic("Objective function contains relation operators (=, ==, <, >, <=, >=, !=).");
1672 g_untrapped_error++;
1673 }
1674 }
1675 ;
1676
1677 blackbox_statement:
1678 fname ':' IDENTIFIER_TOK '(' input_args ';' output_args data_args ')'
1679 {
1680 /*
1681 * This is the blackbox declarative external relation.
1682 */
1683 struct VariableList *vl;
1684 /*determine the number of variables declared in input_args and output_args*/
1685 unsigned long n_inputs, n_outputs;
1686 n_inputs = VariableListLength($5);
1687 n_outputs = VariableListLength($7);
1688 /*continue with normal parsing process */
1689 vl = JoinVariableLists($5,$7);
1690 /* $$ = CreateEXTERN(2,$1,SCP($3),vl,$8,NULL); */
1691
1692 /*$$ = CreateEXTERNBlackBox($1,SCP($3),vl,$8); //original */
1693 //statement now also knows how many of the variables in vl are inputs/outputs
1694 $$ = CreateEXTERNBlackBox($1,SCP($3),vl,$8,n_inputs,n_outputs);
1695 }
1696 ;
1697
1698 input_args:
1699 fvarlist ':' INPUT_TOK
1700 {
1701 $$ = $1;
1702 }
1703 ;
1704
1705 output_args:
1706 fvarlist ':' OUTPUT_TOK
1707 {
1708 $$ = $1;
1709 }
1710 ;
1711
1712 data_args:
1713 /* empty */
1714 {
1715 $$ = NULL;
1716 }
1717 | ';' fname ':' DATA_TOK
1718 {
1719 $$ = $2;
1720 }
1721 ;
1722
1723 glassbox_statement:
1724 fname ':' IDENTIFIER_TOK '(' fvarlist ';' INTEGER_TOK ')' optional_scope
1725 {
1726 /*
1727 * This is the glassbox declarative external relation.
1728 * This now allows a scope for placement of the relations
1729 */
1730 struct VariableList *vl = $5;
1731 struct Name *nptr;
1732 char tmp[32];
1733 symchar *str;
1734
1735 sprintf(tmp,"%ld",$7);
1736 str = AddSymbol(tmp);
1737 nptr = CreateIdName(str);
1738 /* $$ = CreateEXTERN(1,$1,SCP($3),vl,nptr,$9); */
1739 $$ = CreateEXTERNGlassBox($1,SCP($3),vl,nptr,$9);
1740 }
1741 ;
1742
1743 optional_scope:
1744 /* empty */
1745 {
1746 $$ = NULL;
1747 }
1748 | IN_TOK fname
1749 {
1750 $$ = $2;
1751 }
1752 ;
1753
1754 for_statement:
1755 FOR_TOK IDENTIFIER_TOK IN_TOK expr optional_direction forexprend
1756 fstatements end
1757 {
1758 if( $8 != FOR_TOK ) {
1759 WarnMsg_MismatchEnd("FOR", SCP($2), $8, NULL);
1760 }
1761 if ($6 == fk_create && $5 != f_random) {
1762 /* create cannot have an order in declarative FOR */
1763 ErrMsg_Generic("FOR loops only accept DECREASING or INCREASING in the method section.");
1764 g_untrapped_error++;
1765 }
1766 if ($6 == fk_do && $5 == f_random) {
1767 /* all FOR/DO default to increasing */
1768 $$ = CreateFOR($2,$4,$7,f_increasing,$6);
1769 } else {
1770 $$ = CreateFOR($2,$4,$7,$5,$6);
1771 }
1772 }
1773 ;
1774
1775 optional_direction:
1776 /* empty */
1777 {
1778 $$ = f_random;
1779 }
1780 | INCREASING_TOK
1781 {
1782 $$ = f_increasing;
1783 }
1784 | DECREASING_TOK
1785 {
1786 $$ = f_decreasing;
1787 }
1788 ;
1789
1790 forexprend:
1791 CREATE_TOK
1792 {
1793 $$ = fk_create; /* declarative FOR */
1794 }
1795 | EXPECT_TOK
1796 {
1797 $$ = fk_expect; /* parameter FOR */
1798 }
1799 | CHECK_TOK
1800 {
1801 $$ = fk_check; /* WHERE FOR */
1802 }
1803 | DO_TOK
1804 {
1805 $$ = fk_do; /* method FOR */
1806 }
1807 ;
1808
1809 run_statement:
1810 RUN_TOK fname
1811 {
1812 $$ = CreateRUN($2,NULL);
1813 }
1814 | RUN_TOK fname DBLCOLON_TOK fname
1815 {
1816 $$ = CreateRUN($4,$2); /* type :: name */
1817 }
1818 ;
1819
1820 fix_statement:
1821 FIX_TOK fvarlist
1822 {
1823 /*CONSOLE_DEBUG("GOT 'FIX' STATEMENT...");*/
1824 $$ = CreateFIX($2);
1825 }
1826 ;
1827
1828 fix_and_assign_statement:
1829 FIX_TOK assignment_statement
1830 {
1831 struct Statement *assign = $2;
1832 struct Name *n = CopyName($2 -> v.asgn.nptr);
1833 struct VariableList *vars = CreateVariableNode(n);
1834 struct Statement *fix = CreateFIX(ReverseVariableList(vars));
1835 struct gl_list_t *fix_and_assign = gl_create(7L);
1836 gl_append_ptr(fix_and_assign,(char*)fix);
1837 gl_append_ptr(fix_and_assign,(char*)assign);
1838 $$ = fix_and_assign;
1839 }
1840 ;
1841
1842 free_statement:
1843 FREE_TOK fvarlist
1844 {
1845 $$ = CreateFREE($2);
1846 }
1847 ;
1848
1849 solver_statement:
1850 SOLVER_TOK IDENTIFIER_TOK
1851 {
1852 /*CONSOLE_DEBUG("GOT 'SOLVER' STATEMENT WITH '%s'", SCP($2));*/
1853 $$ = CreateSOLVER(SCP($2));
1854 }
1855 ;
1856
1857 option_statement:
1858 OPTION_TOK IDENTIFIER_TOK expr
1859 {
1860 /*CONSOLE_DEBUG("GOT 'OPTION' STATEMENT WITH '%s'", SCP($2));*/
1861 $$ = CreateOPTION(SCP($2),$3);
1862 }
1863 ;
1864
1865 solve_statement:
1866 SOLVE_TOK
1867 {
1868 /*CONSOLE_DEBUG("GOT 'SOLVE' STATEMENT");*/
1869 $$ = CreateSOLVE();
1870 }
1871 ;
1872
1873 external_statement:
1874 EXTERNAL_TOK IDENTIFIER_TOK '(' fvarlist ')'
1875 {
1876 /*
1877 * This is procedural external code. Was:
1878 $$ = CreateEXTERN(0,NULL,SCP($2),$4,NULL,NULL);
1879 */
1880 $$ = CreateEXTERNMethod(SCP($2),$4);
1881 }
1882 ;
1883
1884 call_statement:
1885 CALL_TOK call_identifier
1886 {
1887 /*
1888 * This is proper procedural external method code.
1889 */
1890 $$ = CreateCALL($2,g_callargs);
1891 g_callargs = NULL;
1892 }
1893 ;
1894
1895 assert_statement:
1896 ASSERT_TOK expr
1897 {
1898 $$ = CreateASSERT($2);
1899 }
1900
1901 if_statement:
1902 IF_TOK expr THEN_TOK fstatements optional_else end
1903 {
1904 if( $6 != IF_TOK ) {
1905 WarnMsg_MismatchEnd("IF", NULL, $6, NULL);
1906 }
1907 $$ = CreateIF($2,$4,$5);
1908 }
1909 ;
1910
1911 while_statement:
1912 WHILE_TOK expr DO_TOK fstatements end
1913 {
1914 if( $5 != WHILE_TOK ) {
1915 WarnMsg_MismatchEnd("WHILE", NULL, $5, NULL);
1916 }
1917 $$ = CreateWhile($2,$4);
1918 }
1919 ;
1920
1921 optional_else:
1922 {
1923 $$ = NULL;
1924 }
1925 | ELSE_TOK fstatements
1926 {
1927 $$ = $2;
1928 }
1929 ;
1930
1931 when_statement:
1932 WHEN_TOK fvarlist whenlist end
1933 {
1934 if( $4 != WHEN_TOK ) {
1935 WarnMsg_MismatchEnd("WHEN", NULL, $4, NULL);
1936 }
1937 ErrMsg_Generic("() missing in WHEN statement.");
1938 DestroyWhenList($3);
1939 DestroyVariableList($2);
1940 g_untrapped_error++;
1941 $$ = NULL;
1942 }
1943 | fname ':' WHEN_TOK fvarlist whenlist end
1944 {
1945 if( $6 != WHEN_TOK ) {
1946 WarnMsg_MismatchEnd("WHEN", NULL, $6, NULL);
1947 }
1948 ErrMsg_Generic("() missing in WHEN statement.");
1949 DestroyWhenList($5);
1950 DestroyVariableList($4);
1951 DestroyName($1);
1952 g_untrapped_error++;
1953 $$ = NULL;
1954 }
1955 | WHEN_TOK '(' fvarlist ')' whenlist end
1956 {
1957 if( $6 != WHEN_TOK ) {
1958 WarnMsg_MismatchEnd("WHEN", NULL, $6, NULL);
1959 }
1960 $$ = CreateWHEN(NULL,$3,$5);
1961 }
1962 | fname ':' WHEN_TOK '(' fvarlist ')' whenlist end
1963 {
1964 if( $8 != WHEN_TOK ) {
1965 WarnMsg_MismatchEnd("WHEN", NULL, $8, NULL);
1966 }
1967 $$ = CreateWHEN($1,$5,$7);
1968 }
1969 ;
1970
1971 whenlist:
1972 whenlistf
1973 {
1974 $$ = ReverseWhenCases($1);
1975 }
1976 ;
1977
1978 whenlistf:
1979 CASE_TOK set ':' fstatements
1980 {
1981 $$ = CreateWhen($2,$4);
1982 }
1983 | OTHERWISE_TOK ':' fstatements
1984 {
1985 $$ = CreateWhen(NULL,$3);
1986 }
1987 | whenlistf CASE_TOK set ':' fstatements
1988 {
1989 $$ = LinkWhenCases(CreateWhen($3,$5),$1);
1990 }
1991 | whenlistf OTHERWISE_TOK ':' fstatements
1992 {
1993 $$ = LinkWhenCases(CreateWhen(NULL,$4),$1);
1994 }
1995 ;
1996
1997 flow_statement:
1998 BREAK_TOK
1999 {
2000 $$ = CreateFlow(fc_break,NULL);
2001 }
2002 | CONTINUE_TOK
2003 {
2004 $$ = CreateFlow(fc_continue,NULL);
2005 }
2006 | FALLTHRU_TOK
2007 {
2008 $$ = CreateFlow(fc_fallthru,NULL);
2009 }
2010 | RETURN_TOK
2011 {
2012 $$ = CreateFlow(fc_return,NULL);
2013 }
2014 | STOP_TOK optional_bracedtext
2015 {
2016 $$ = CreateFlow(fc_stop,$2);
2017 }
2018 ;
2019
2020 use_statement:
2021 USE_TOK fname
2022 {
2023 $$ = CreateFNAME($2);
2024 }
2025 ;
2026
2027 select_statement:
2028 SELECT_TOK fvarlist selectlist end
2029 {
2030 if( $4 != SELECT_TOK ) {
2031 WarnMsg_MismatchEnd("SELECT", NULL, $4, NULL);
2032 }
2033 ErrMsg_Generic("() missing in SELECT statement.");
2034 DestroySelectList($3);
2035 DestroyVariableList($2);
2036 g_untrapped_error++;
2037 $$ = NULL;
2038 }
2039 | SELECT_TOK '(' fvarlist ')' selectlist end
2040 {
2041 if( $6 != SELECT_TOK ) {
2042 WarnMsg_MismatchEnd("SELECT", NULL, $6, NULL);
2043 }
2044 $$ = CreateSELECT($3,$5);
2045 }
2046 ;
2047
2048 selectlist:
2049 selectlistf
2050 {
2051 $$ = ReverseSelectCases($1);
2052 }
2053 ;
2054
2055 selectlistf:
2056 CASE_TOK set ':' fstatements
2057 {
2058 $$ = CreateSelect($2,$4);
2059 }
2060 | OTHERWISE_TOK ':' fstatements
2061 {
2062 $$ = CreateSelect(NULL,$3);
2063 }
2064 | selectlistf CASE_TOK set ':' fstatements
2065 {
2066 $$ = LinkSelectCases(CreateSelect($3,$5),$1);
2067 }
2068 | selectlistf OTHERWISE_TOK ':' fstatements
2069 {
2070 $$ = LinkSelectCases(CreateSelect(NULL,$4),$1);
2071 }
2072 ;
2073
2074 switch_statement:
2075 SWITCH_TOK fvarlist switchlist end
2076 {
2077 if( $4 != SWITCH_TOK ) {
2078 WarnMsg_MismatchEnd("SWITCH", NULL, $4, NULL);
2079 }
2080 ErrMsg_Generic("() missing in SWITCH statement.");
2081 DestroySwitchList($3);
2082 DestroyVariableList($2);
2083 g_untrapped_error++;
2084 $$ = NULL;
2085 }
2086 | SWITCH_TOK '(' fvarlist ')' switchlist end
2087 {
2088 if( $6 != SWITCH_TOK ) {
2089 WarnMsg_MismatchEnd("SWITCH", NULL, $6, NULL);
2090 }
2091 $$ = CreateSWITCH($3,$5);
2092 }
2093 ;
2094
2095 switchlist:
2096 switchlistf
2097 {
2098 $$ = ReverseSwitchCases($1);
2099 }
2100 ;
2101
2102 switchlistf:
2103 CASE_TOK set ':' fstatements
2104 {
2105 $$ = CreateSwitch($2,$4);
2106 }
2107 | OTHERWISE_TOK ':' fstatements
2108 {
2109 $$ = CreateSwitch(NULL,$3);
2110 }
2111 | switchlistf CASE_TOK set ':' fstatements
2112 {
2113 $$ = LinkSwitchCases(CreateSwitch($3,$5),$1);
2114 }
2115 | switchlistf OTHERWISE_TOK ':' fstatements
2116 {
2117 $$ = LinkSwitchCases(CreateSwitch(NULL,$4),$1);
2118 }
2119 ;
2120
2121 conditional_statement:
2122 CONDITIONAL_TOK fstatements end
2123 {
2124 if( $3 != CONDITIONAL_TOK ) {
2125 WarnMsg_MismatchEnd("CONDITIONAL", NULL, $3, NULL);
2126 }
2127 $$ = CreateCOND($2);
2128 }
2129 ;
2130
2131 notes_statement:
2132 NOTES_TOK notes_body end
2133 {
2134 /* All processing of notes takes place on the notes_body here.
2135 * Notes should NOT be added to the statement list.
2136 * Here we know the current type and method names.
2137 */
2138 if( $3 != NOTES_TOK ) {
2139 WarnMsg_MismatchEnd("NOTES", NULL, $3, NULL);
2140 }
2141 if ($2 != NULL) {
2142 struct NoteTmp *nt;
2143 symchar *lang=NULL; /* dummy */
2144 nt = $2;
2145 while (nt != NULL) {
2146 if (nt->lang != NULL) {
2147 /* this logic works because of the reverse sort that
2148 * yacc does via noteslist and the forward sort that
2149 * we do via notesbody. lang recorded last appears
2150 * before other entries that need it.
2151 */
2152 lang = nt->lang;
2153 }
2154
2155 /* save exploding vardata to simple entries until we keep */
2156 CollectNote(CreateNote(g_type_name, lang, NULL, g_proc_name,
2157 Asc_ModuleBestName(Asc_CurrentModule()),
2158 nt->bt,
2159 nt->line, nt->vardata, nd_vlist));
2160 nt = nt->next;
2161 }
2162 DestroyNoteTmpList($2);
2163 }
2164 $$ = NULL;
2165 }
2166 ;
2167
2168 notes_body:
2169 SYMBOL_TOK noteslist
2170 {
2171 /* At this point we have the "language", the names of the
2172 * objects we are explaining, and the explanation/notes itself.
2173 */
2174 $$ = $2;
2175 assert($$->lang == NULL);
2176 $$->lang = $1;
2177 }
2178 | notes_body SYMBOL_TOK noteslist
2179 {
2180 struct NoteTmp *nt;
2181 $$ = $1;
2182 assert($3->lang == NULL);
2183 $3->lang = $2;
2184 nt = $$;
2185 while (nt->next != NULL) {
2186 nt = nt->next;
2187 }
2188 LinkNoteTmp(nt,$3);
2189 }
2190 ;
2191
2192 noteslist:
2193 fvarlist BRACEDTEXT_TOK
2194 {
2195 $$ = CreateNoteTmp(NULL, AddBraceChar($2,NULL),
2196 (void *)$1, LineNum());
2197 }
2198 | noteslist fvarlist BRACEDTEXT_TOK
2199 {
2200 $$ = CreateNoteTmp(NULL, AddBraceChar($3,NULL),
2201 (void *)$2, LineNum());
2202 LinkNoteTmp($$,$1);
2203 }
2204 ;
2205
2206 fvarlist:
2207 varlist
2208 {
2209 /*
2210 * Reversing the variable list is now essential to deal with
2211 * external procedures and other things where order is important.
2212 */
2213 $$ = ReverseVariableList($1);
2214 }
2215 ;
2216
2217 varlist:
2218 fname
2219 {
2220 $$ = CreateVariableNode($1);
2221 }
2222 | varlist ',' fname
2223 {
2224 $$ = CreateVariableNode($3);
2225 LinkVariableNodes($$,$1);
2226 }
2227 | varlist fname
2228 {
2229 ErrMsg_CommaName("name",$2);
2230 $$ = CreateVariableNode($2);
2231 LinkVariableNodes($$,$1);
2232 /* trash the definition. keep the loose fname around because
2233 * destroying here is inconvenient
2234 */
2235 g_untrapped_error++;
2236 }
2237 ;
2238
2239 fname:
2240 name optional_notes
2241 {
2242 symchar *simple;
2243 void *data;
2244 enum NoteData nd;
2245 $$ = ReverseName($1);
2246 if ($2 != NULL && $1 != NULL) {
2247 simple = SimpleNameIdPtr($$);
2248 data = (simple == NULL ? (void *)$$ : NULL);
2249 nd = (data == NULL ? nd_empty : nd_name);
2250 CollectNote(CreateNote(g_type_name, InlineNote(), simple,
2251 g_proc_name,
2252 Asc_ModuleBestName(Asc_CurrentModule()),
2253 AddBraceChar($2,InlineNote()),
2254 LineNum(), data, nd));
2255 }
2256 }
2257 ;
2258
2259 name:
2260 IDENTIFIER_TOK
2261 {
2262 $$ = CreateIdName($1);
2263 }
2264 | name '.' IDENTIFIER_TOK
2265 {
2266 $$ = CreateIdName($3);
2267 LinkNames($$,$1);
2268 }
2269 | name '[' set ']'
2270 {
2271 if ($3 == NULL) {
2272 error_reporter_current_line(ASC_USER_ERROR,"syntax error: Empty set in name definition, name:");
2273 WriteName(ASCERR,$1);
2274 FPRINTF(ASCERR,"[]\n");
2275 g_untrapped_error++;
2276 } else {
2277 $$ = CreateSetName($3);
2278 LinkNames($$,$1);
2279 }
2280 }
2281 ;
2282
2283 end:
2284 END_TOK CONDITIONAL_TOK
2285 {
2286 g_end_identifier = NULL;
2287 $$ = CONDITIONAL_TOK;
2288 }
2289 | END_TOK FOR_TOK
2290 {
2291 g_end_identifier = NULL;
2292 $$ = FOR_TOK;
2293 }
2294 | END_TOK IF_TOK
2295 {
2296 g_end_identifier = NULL;
2297 $$ = IF_TOK;
2298 }
2299 | END_TOK INTERACTIVE_TOK
2300 {
2301 g_end_identifier = NULL;
2302 $$ = INTERACTIVE_TOK;
2303 }
2304 | END_TOK METHODS_TOK
2305 {
2306 g_end_identifier = NULL;
2307 $$ = METHODS_TOK;
2308 }
2309 | END_TOK NOTES_TOK
2310 {
2311 g_end_identifier = NULL;
2312 $$ = NOTES_TOK;
2313 }
2314 | END_TOK SELECT_TOK
2315 {
2316 g_end_identifier = NULL;
2317 $$ = SELECT_TOK;
2318 }
2319 | END_TOK SWITCH_TOK
2320 {
2321 g_end_identifier = NULL;
2322 $$ = SWITCH_TOK;
2323 }
2324 | END_TOK UNITS_TOK
2325 {
2326 g_end_identifier = NULL;
2327 $$ = UNITS_TOK;
2328 }
2329 | END_TOK GLOBAL_TOK
2330 {
2331 g_end_identifier = NULL;
2332 $$ = GLOBAL_TOK;
2333 }
2334 | END_TOK WHEN_TOK
2335 {
2336 g_end_identifier = NULL;
2337 $$ = WHEN_TOK;
2338 }
2339 | END_TOK WHILE_TOK
2340 {
2341 g_end_identifier = NULL;
2342 $$ = WHILE_TOK;
2343 }
2344 | END_TOK IDENTIFIER_TOK
2345 {
2346 g_end_identifier = $2;
2347 $$ = IDENTIFIER_TOK;
2348 }
2349 | END_TOK /* empty */
2350 {
2351 g_end_identifier = NULL;
2352 $$ = END_TOK;
2353 }
2354 ;
2355
2356 optional_bracedtext:
2357 /* empty */
2358 {
2359 $$ = NULL;
2360 }
2361 | BRACEDTEXT_TOK
2362 {
2363 $$ = $1;
2364 }
2365 ;
2366
2367 optional_notes:
2368 /* empty */
2369 {
2370 $$ = NULL;
2371 }
2372 | DQUOTE_TOK
2373 {
2374 $$ = $1;
2375 }
2376 ;
2377
2378 set:
2379 setexprlist
2380 {
2381 $$ = ReverseSetList($1);
2382 }
2383 | /* empty */
2384 {
2385 $$ = NULL;
2386 }
2387 ;
2388
2389 setexprlist:
2390 expr
2391 {
2392 $$ = CreateSingleSet($1);
2393 }
2394 | expr DOTDOT_TOK expr
2395 {
2396 $$ = CreateRangeSet($1,$3);
2397 }
2398 | setexprlist ',' expr
2399 {
2400 $$ = CreateSingleSet($3);
2401 LinkSets($$,$1);
2402 }
2403 | setexprlist ',' expr DOTDOT_TOK expr
2404 {
2405 $$ = CreateRangeSet($3,$5);
2406 LinkSets($$,$1);
2407 }
2408 ;
2409
2410 number:
2411 INTEGER_TOK
2412 {
2413 $$ = $1;
2414 g_constant_type = LONGCONSTANT;
2415 g_default_dim_ptr = Dimensionless();
2416 }
2417 | realnumber
2418 {
2419 $$ = $1;
2420 g_constant_type = DOUBLECONSTANT;
2421 g_default_dim_ptr = g_dim_ptr;
2422 }
2423 ;
2424
2425 realnumber:
2426 REAL_TOK opunits
2427 {
2428 $$ = $1*$2;
2429 }
2430 | INTEGER_TOK BRACEDTEXT_TOK
2431 {
2432 unsigned long pos;
2433 int error_code;
2434 g_units_ptr = FindOrDefineUnits($2,&pos,&error_code);
2435 if (g_units_ptr != NULL) {
2436 $$ = (double)$1*UnitsConvFactor(g_units_ptr);
2437 g_dim_ptr = UnitsDimensions(g_units_ptr);
2438 } else {
2439 char **errv;
2440 $$ = (double)$1;
2441 g_dim_ptr = WildDimension();
2442 error_reporter_current_line(ASC_USER_ERROR,"Undefined units '%s'", $2);
2443 errv = UnitsExplainError($2,error_code,pos);
2444 error_reporter_current_line(ASC_USER_ERROR," %s\n %s\n %s\n",errv[0],errv[1],errv[2]);
2445 g_untrapped_error++;
2446 }
2447 }
2448 ;
2449
2450 opunits:
2451 /* empty */
2452 {
2453 g_dim_ptr = Dimensionless();
2454 $$ = 1.0;
2455 }
2456 | BRACEDTEXT_TOK
2457 {
2458 unsigned long pos;
2459 int error_code;
2460 g_units_ptr = FindOrDefineUnits($1,&pos,&error_code);
2461 if (g_units_ptr != NULL) {
2462 $$ = UnitsConvFactor(g_units_ptr);
2463 g_dim_ptr = UnitsDimensions(g_units_ptr);
2464 } else {
2465 char **errv;
2466 $$ = 1.0;
2467 g_dim_ptr = WildDimension();
2468 error_reporter_current_line(ASC_USER_ERROR,"Undefined units '%s'",$1);
2469 errv = UnitsExplainError($1,error_code,pos);
2470 error_reporter_current_line(ASC_USER_ERROR," %s\n %s\n %s\n",errv[0],errv[1],errv[2]);
2471 g_untrapped_error++;
2472 }
2473 }
2474 ;
2475
2476 dims:
2477 DIMENSION_TOK dimensions
2478 {
2479 $$ = $2;
2480 }
2481 | DIMENSIONLESS_TOK
2482 {
2483 $$ = Dimensionless();
2484 }
2485 | /* empty */
2486 {
2487 $$ = WildDimension();
2488 }
2489 ;
2490
2491 dimensions:
2492 '*'
2493 {
2494 $$ = WildDimension();
2495 }
2496 | dimexpr
2497 {
2498 $$ = FindOrAddDimen(&($1));
2499 }
2500 ;
2501
2502 dimexpr:
2503 IDENTIFIER_TOK
2504 {
2505 ParseDim(&($$),SCP($1));
2506 }
2507 | INTEGER_TOK
2508 {
2509 ClearDimensions(&($$));
2510 }
2511 | dimexpr '/' dimexpr
2512 {
2513 $$ = SubDimensions(&($1),&($3));
2514 }
2515 | dimexpr '*' dimexpr
2516 {
2517 $$ = AddDimensions(&($1),&($3));
2518 }
2519 | dimexpr '^' fraction
2520 {
2521 $$ = ScaleDimensions(&($1),$3);
2522 }
2523 | '(' dimexpr ')'
2524 {
2525 CopyDimensions(&($2),&($$));
2526 }
2527 ;
2528
2529 fraction:
2530 optional_sign fractail
2531 {
2532 $$ = $1 ? NegateF($2) : $2;
2533 }
2534 ;
2535
2536 fractail:
2537 INTEGER_TOK
2538 {
2539 $$ = CreateFraction((short)$1,(short)1);
2540 }
2541 | '(' INTEGER_TOK '/' INTEGER_TOK ')'
2542 {
2543 $$ = CreateFraction((short)$2,(short)$4);
2544 }
2545 ;
2546
2547 optional_sign:
2548 /* empty */
2549 {
2550 $$ = 0;
2551 }
2552 | '+'
2553 {
2554 $$ = 0;
2555 }
2556 | '-'
2557 {
2558 $$ = 1;
2559 }
2560 ;
2561
2562 expr:
2563 INTEGER_TOK
2564 {
2565 $$ = CreateIntExpr($1);
2566 }
2567 | MAXINTEGER_TOK
2568 {
2569 $$ = CreateIntExpr(LONG_MAX-1);
2570 }
2571 | realnumber
2572 {
2573 $$ = CreateRealExpr($1,g_dim_ptr);
2574 }
2575 | MAXREAL_TOK
2576 {
2577 $$ = CreateRealExpr(DBL_MAX/(1+1e-15),Dimensionless());
2578 }
2579 | TRUE_TOK
2580 {
2581 $$ = CreateTrueExpr();
2582 }
2583 | FALSE_TOK
2584 {
2585 $$ = CreateFalseExpr();
2586 }
2587 | ANY_TOK
2588 {
2589 $$ = CreateAnyExpr();
2590 }
2591 | SYMBOL_TOK
2592 {
2593 $$ = CreateSymbolExpr($1);
2594 }
2595 | fname
2596 {
2597 $$ = CreateVarExpr($1);
2598 }
2599 | '[' set ']'
2600 {
2601 $$ = CreateSetExpr($2);
2602 }
2603 | expr '+' expr
2604 {
2605 $3 = JoinExprLists($3,CreateOpExpr(e_plus));
2606 $$ = JoinExprLists($1,$3);
2607 }
2608 | expr '-' expr
2609 {
2610 $3 = JoinExprLists($3,CreateOpExpr(e_minus));
2611 $$ = JoinExprLists($1,$3);
2612 }
2613 | expr '*' expr
2614 {
2615 $3 = JoinExprLists($3,CreateOpExpr(e_times));
2616 $$ = JoinExprLists($1,$3);
2617 }
2618 | expr '/' expr
2619 {
2620 $3 = JoinExprLists($3,CreateOpExpr(e_divide));
2621 $$ = JoinExprLists($1,$3);
2622 }
2623 | expr '^' expr
2624 {
2625 $3 = JoinExprLists($3,CreateOpExpr(e_power));
2626 $$ = JoinExprLists($1,$3);
2627 }
2628 | expr AND_TOK expr
2629 {
2630 $3 = JoinExprLists($3,CreateOpExpr(e_and));
2631 $$ = JoinExprLists($1,$3);
2632 }
2633 | expr OR_TOK expr
2634 {
2635 $3 = JoinExprLists($3,CreateOpExpr(e_or));
2636 $$ = JoinExprLists($1,$3);
2637 }
2638 | NOT_TOK expr
2639 {
2640 $$ = JoinExprLists($2,CreateOpExpr(e_not));
2641 }
2642 | expr relop expr %prec NEQ_TOK
2643 {
2644 $3 = JoinExprLists($3,$2);
2645 $$ = JoinExprLists($1,$3);
2646 }
2647 | expr logrelop expr %prec BEQ_TOK
2648 {
2649 $3 = JoinExprLists($3,$2);
2650 $$ = JoinExprLists($1,$3);
2651 }
2652 | expr IN_TOK expr
2653 {
2654 $3 = JoinExprLists($3,CreateOpExpr(e_in));
2655 $$ = JoinExprLists($1,$3);
2656 }
2657 | expr '|' expr
2658 {
2659 $3 = JoinExprLists($3,CreateOpExpr(e_st));
2660 $$ = JoinExprLists($1,$3);
2661 }
2662 | expr SUCHTHAT_TOK expr
2663 {
2664 $3 = JoinExprLists($3,CreateOpExpr(e_st));
2665 $$ = JoinExprLists($1,$3);
2666 }
2667 | '+' expr %prec UPLUS_TOK
2668 {
2669 $$ = $2;
2670 }
2671 | '-' expr %prec UMINUS_TOK
2672 {
2673 $$ = JoinExprLists($2,CreateOpExpr(e_uminus));
2674 }
2675 | SATISFIED_TOK '(' fname ',' realnumber ')'
2676 {
2677 $$ = CreateSatisfiedExpr($3,$5,g_dim_ptr);
2678 }
2679 | SATISFIED_TOK '(' fname ')'
2680 {
2681 $$ = CreateSatisfiedExpr($3,DBL_MAX,NULL);
2682 }
2683 | SUM_TOK '(' set ')'
2684 {
2685 DestroySetList($3);
2686 $$ = NULL;
2687 ErrMsg_ParensBrackets("SUM");
2688 g_untrapped_error++;
2689 }
2690 | SUM_TOK '[' set ']'
2691 {
2692 $$ = CreateBuiltin(e_sum,$3);
2693 }
2694 | PROD_TOK '(' set ')'
2695 {
2696 DestroySetList($3);
2697 $$ = NULL;
2698 ErrMsg_ParensBrackets("PROD");
2699 g_untrapped_error++;
2700 }
2701 | PROD_TOK '[' set ']'
2702 {
2703 $$ = CreateBuiltin(e_prod,$3);
2704 }
2705 | UNION_TOK '(' set ')'
2706 {
2707 DestroySetList($3);
2708 $$ = NULL;
2709 ErrMsg_ParensBrackets("UNION");
2710 g_untrapped_error++;
2711 }
2712 | UNION_TOK '[' set ']'
2713 {
2714 $$ = CreateBuiltin(e_union,$3);
2715 }
2716 | INTERSECTION_TOK '(' set ')'
2717 {
2718 DestroySetList($3);
2719 $$ = NULL;
2720 ErrMsg_ParensBrackets("INTERSECTION");
2721 g_untrapped_error++;
2722 }
2723 | INTERSECTION_TOK '[' set ']'
2724 {
2725 $$ = CreateBuiltin(e_inter,$3);
2726 }
2727 | CARD_TOK '(' set ')'
2728 {
2729 DestroySetList($3);
2730 $$ = NULL;
2731 ErrMsg_ParensBrackets("CARD");
2732 g_untrapped_error++;
2733 }
2734 | CARD_TOK '[' set ']'
2735 {
2736 $$ = CreateBuiltin(e_card,$3);
2737 }
2738 | CHOICE_TOK '(' set ')'
2739 {
2740 DestroySetList($3);
2741 $$ = NULL;
2742 ErrMsg_ParensBrackets("CHOICE");
2743 g_untrapped_error++;
2744 }
2745 | CHOICE_TOK '[' set ']'
2746 {
2747 $$ = CreateBuiltin(e_choice,$3);
2748 }
2749 | IDENTIFIER_TOK '(' expr ')'
2750 {
2751 CONST struct Func *fptr;
2752 if ((fptr = LookupFunc(SCP($1)))!=NULL) {
2753 $$ = JoinExprLists($3,CreateFuncExpr(fptr));
2754 } else {
2755 $$ = NULL;
2756 error_reporter_current_line(ASC_USER_ERROR,"Function '%s' is not defined.",SCP($1));
2757 g_untrapped_error++;
2758 }
2759 }
2760 | '(' expr ')'
2761 {
2762 $$ = $2;
2763 }
2764 ;
2765
2766 relop:
2767 '='
2768 {
2769 $$ = CreateOpExpr(e_equal);
2770 }
2771 | '<'
2772 {
2773 $$ = CreateOpExpr(e_less);
2774 }
2775 | '>'
2776 {
2777 $$ = CreateOpExpr(e_greater);
2778 }
2779 | LEQ_TOK /* less than or equal written "<=" */
2780 {
2781 $$ = CreateOpExpr(e_lesseq);
2782 }
2783 | GEQ_TOK /* greater than or equal written ">=" */
2784 {
2785 $$ = CreateOpExpr(e_greatereq);
2786 }
2787 | NEQ_TOK /* not equal written "<>" */
2788 {
2789 $$ = CreateOpExpr(e_notequal);
2790 }
2791 ;
2792
2793 logrelop:
2794 BEQ_TOK /* equality in boolean relations */
2795 {
2796 $$ = CreateOpExpr(e_boolean_eq);
2797 }
2798 | BNE_TOK /* non equality in boolean relations */
2799 {
2800 $$ = CreateOpExpr(e_boolean_neq);
2801 }
2802 ;
2803 %%
2804 /* END OF GRAMMAR RULES
2805 -----------------------------------------------------------------------------
2806 START OF EPILOGUE
2807 */
2808
2809 /*
2810 * We really need to do something about freeing up the productions
2811 * that invoke this so we don't leak memory like a seive.
2812 * for example z[i IN [1..2]][j IN [process[i]] IS_A mass; eats a ton.
2813 */
2814 int
2815 zz_error(char *s){
2816 g_untrapped_error++;
2817 if (Asc_CurrentModule() != NULL) {
2818 MSG("message string '%s'",s);
2819 error_reporter_current_line(ASC_USER_ERROR,"%s",s);
2820 } else {
2821 error_reporter(ASC_USER_ERROR,NULL,0,NULL,"%s at end of input.",s);
2822 }
2823 return 0;
2824 }
2825
2826 /*
2827 * See the header file scanner.h for a description of this function.
2828 */
2829 void
2830 Asc_ErrMsgTypeDefnEOF(void)
2831 {
2832 /* Check g_type_name to see if we're in the middle of a type
2833 * definition. If NULL no, otherwise yes.
2834 */
2835 if ( g_type_name ) {
2836 error_reporter_current_line(ASC_USER_ERROR,
2837 "End of file reached in a type definition. Incomplete definition for '%s'.",
2838 SCP(g_type_name));
2839 }
2840 }
2841
2842 #define ERRCOUNT_PARSERGENERIC 30
2843 /*
2844 * void ErrMsg_*(void)
2845 *
2846 * The following print error and warning messages to the filehandles
2847 * ASCERR and ASCWARN, respectively.
2848 * The type of error/warning that will be printed is indicated by the
2849 * functions name and the arguments to fprintf.
2850 */
2851 static void ErrMsg_Generic(CONST char *string){
2852 static int errcount=0;
2853 if(errcount<30){
2854 char *s1 = strdup(string);
2855 /* the module may have be already closed, Asc_CurrentModule will be null */
2856 MSG("generic message, '%s'",string);
2857 error_reporter_current_line(ASC_USER_ERROR,"%s",string);
2858
2859 if (g_type_name != NULL) {
2860 error_reporter_current_line(ASC_USER_ERROR," type %s\n",SCP(g_type_name));
2861 }
2862 if (g_proc_name != NULL) {
2863 error_reporter_current_line(ASC_USER_ERROR," METHOD %s\n",SCP(g_proc_name));
2864 }
2865
2866 errcount++;
2867 if(errcount==30){
2868 ERROR_REPORTER_HERE(ASC_PROG_NOTE
2869 ,"Further reports of this error will be suppressed.\n"
2870 );
2871 }
2872 ASC_FREE(s1);
2873 }
2874 }
2875
2876 static void ErrMsg_CommaName(CONST char *what, struct Name *name)
2877 {
2878 //struct module_t *mod;
2879
2880 /* the module may have be already closed */
2881 /* mod = */ Asc_CurrentModule();
2882
2883 ERROR_REPORTER_START_HERE(ASC_USER_ERROR);
2884 FPRINTF(ASCERR, "Missing comma or operator before %s '",what);
2885 WriteName(ASCERR,name);
2886 FPRINTF(ASCERR, "'");
2887 error_reporter_end_flush();
2888 }
2889
2890 #if COMMAEXPR_NOTBUGGY
2891 static void ErrMsg_CommaExpr(CONST char *what, struct Expr *eptr)
2892 {
2893 struct module_t *mod;
2894
2895 /* the module may have be already closed */
2896 error_reporter_current_line(ASC_USER_ERROR, "ASC-Error: Missing comma before %s ",what);
2897 WriteExpr(ASCERR,eptr);
2898 }
2899 #endif /* COMMAEXPR_NOTBUGGY. delete if can't fix */
2900
2901 static void
2902 ErrMsg_NullDefPointer(CONST char *object){
2903 MSG("Rejecting '%s'",object);
2904 MSG("About to reject '%s'",object);
2905 error_reporter_current_line(ASC_USER_ERROR,"Rejected '%s'", object);
2906 }
2907
2908 static void
2909 ErrMsg_ParensBrackets(CONST char *operation)
2910 {
2911 error_reporter_current_line(ASC_USER_ERROR,
2912 " You should be using %s[] not %s()",
2913 operation,
2914 operation);
2915 }
2916
2917
2918 /**
2919 Print a warning message that the token after the END keyword did not
2920 match what we were expecting for the current statement.
2921
2922 @param statement --the current statement, e.g. ATOM, METHOD, FOR, IF, CASE
2923 @param opt_name --the name of the thing we were defining for ATOMs, METHODs,
2924 etc, or NULL anonymous statements (FOR, IF, CASE, etc)
2925 @param end_token --the TOKEN_TOK that we were received instead. We use the
2926 TokenAsString to produce a string given a TOKEN_TOK
2927 @param expecting --the keyword we were expecting to see after the END; if
2928 NULL, we were expecting the string given in statement
2929 */
2930 static void
2931 WarnMsg_MismatchEnd(CONST char *statement, CONST char *opt_name,
2932 unsigned long end_token, CONST char *expecting)
2933 {
2934 error_reporter_current_line(ASC_USER_WARNING,
2935 "%s %s terminated with 'END %s;', expecting 'END %s;'"
2936 ,statement
2937 ,((opt_name != NULL) ? opt_name : "statement")
2938 ,TokenAsString(end_token)
2939 ,((expecting != NULL) ? expecting : statement));
2940 }
2941
2942
2943 /*
2944 Take a TOKEN_TOK (e.g., FOR_TOK, MODEL_TOK, END_TOK, IDENTIFIER_TOK) and returns
2945 a string representation of it:
2946 e.g.: TokenAsString(FOR_TOK) ==> "FOR"
2947
2948 Since this function is only used inside WarnMsg_MismatchEnd, we do a
2949 couple of things specific to that function: If token is END_TOK, we
2950 return an empty string, and if it is IDENTIFIER_TOK, we return the
2951 current value of g_end_identifier, or UNKNOWN if g_end_identifier is
2952 NULL.
2953 */
2954 static CONST char *
2955 TokenAsString(unsigned long token)
2956 {
2957 switch( token ) {
2958 case ATOM_TOK:
2959 return "ATOM";
2960 case CONDITIONAL_TOK:
2961 return "CONDITIONAL";
2962 case FOR_TOK:
2963 return "FOR";
2964 case ASSERT_TOK:
2965 return "ASSERT";
2966 case IF_TOK:
2967 return "IF";
2968 case INTERACTIVE_TOK:
2969 return "INTERACTIVE";
2970 case METHOD_TOK:
2971 return "METHOD";
2972 case METHODS_TOK:
2973 return "METHODS";
2974 case MODEL_TOK:
2975 return "MODEL";
2976 case NOTES_TOK:
2977 return "NOTES";
2978 case PATCH_TOK:
2979 return "PATCH";
2980 case SELECT_TOK:
2981 return "SELECT";
2982 case SWITCH_TOK:
2983 return "SWITCH";
2984 case UNITS_TOK:
2985 return "UNITS";
2986 case WHEN_TOK:
2987 return "WHEN";
2988 case END_TOK:
2989 return "";
2990 case IDENTIFIER_TOK:
2991 default:
2992 if( g_end_identifier != NULL ) {
2993 return SCP(g_end_identifier);
2994 } else {
2995 return "UNKNOWN";
2996 }
2997 }
2998 }
2999
3000 /* need a refcount game on the text field of the note. must keep
3001 * original note to avoid losing the varlist.
3002 */
3003 static void ProcessNotes(int keep)
3004 {
3005 int c,len;
3006 if (g_notelist == NULL) {
3007 return;
3008 }
3009 if (keep) {
3010 len = gl_length(g_notelist);
3011 for (c=1;c <= len;c++) {
3012 CommitNote(LibraryNote(),gl_fetch(g_notelist,c));
3013 }
3014 } else {
3015 gl_iterate(g_notelist,(void (*) (VOIDPTR))DestroyNote);
3016 }
3017 gl_destroy(g_notelist);
3018 g_notelist = NULL;
3019 }
3020
3021 static void CollectNote(struct Note *n)
3022 {
3023 if (g_notelist == NULL) {
3024 g_notelist = gl_create(50L);
3025 }
3026 if (g_notelist == NULL) {
3027 DestroyNote(n);
3028 return;
3029 }
3030 gl_append_ptr(g_notelist,(VOIDPTR)n);
3031 }
3032
3033 /*
3034 This can be called as error_reporter_current_line(ASC_USER_ERROR,...);
3035 or error_reporter_current_line(ASC_USER_WARNING,...), or with any of the other
3036 severity flags.
3037 */
3038 static void error_reporter_current_line(const error_severity_t sev, const char *fmt,...){
3039 MSG("format = %s",fmt);
3040 va_list args, args2;
3041 va_start(args,fmt);
3042 va_copy(args2,args);
3043 va_error_reporter(sev,Asc_ModuleBestName(Asc_CurrentModule()),(int)LineNum(),NULL,fmt,&args2);
3044 va_end(args);
3045 }
3046
3047 /* vim: set ts=8: */

john.pye@anu.edu.au
ViewVC Help
Powered by ViewVC 1.1.22