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

Contents of /trunk/base/generic/compiler/ascParse.y

Parent Directory Parent Directory | Revision Log Revision Log


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

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