/[ascend]/trunk/ascend/compiler/ascParse.y
ViewVC logotype

Contents of /trunk/ascend/compiler/ascParse.y

Parent Directory Parent Directory | Revision Log Revision Log


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

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