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

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