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

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