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

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