Oceani - Cataract Creek version
[ocean] / csrc / oceani.mdc
1 # Ocean Interpreter - Cataract Creek version
2
3 Ocean is intended to be a compiled language, so this interpreter is
4 not targeted at being the final product.  It is, rather, an intermediate
5 stage and fills that role in two distinct ways.
6
7 Firstly, it exists as a platform to experiment with the early language
8 design.  An interpreter is easy to write and easy to get working, so
9 the barrier for entry is lower if I aim to start with an interpreter.
10
11 Secondly, the plan for the Ocean compiler is to write it in the
12 [Ocean language](http://ocean-lang.org).  To achieve this we naturally
13 need some sort of boot-strap process and this interpreter - written in
14 portable C - will fill that role.  It will be used to bootstrap the
15 Ocean compiler.
16
17 Two features that are not needed to fill either of these roles are
18 performance and completeness.  The interpreter only needs to be fast
19 enough to run small test programs and occasionally to run the compiler
20 on itself.  It only needs to be complete enough to test aspects of the
21 design which are developed before the compiler is working, and to run
22 the compiler on itself.  Any features not used by the compiler when
23 compiling itself are superfluous.  They may be included anyway, but
24 they may not.
25
26 Nonetheless, the interpreter should end up being reasonably complete,
27 and any performance bottlenecks which appear and are easily fixed, will
28 be.
29
30 ## Current version
31
32 This fourth version of the interpreter showcases the latest iteration of
33 the design for parsing indents and line breaks, provides a first cut of
34 support for references and functions, and introduces some syntax for a
35 array with run-time length - currently only used for "argv".
36
37 Indents are now explicit elements of the grammar and we no longer
38 require a colon before an indent.  The colon still appears on "if" and
39 "while" statements and others but it now marks the end of the
40 expression.  Where there is no expression, such as after "else", there
41 is no colon - an indent can immediately follow the "else".
42
43 References can refer objects of any type which has a name, and this
44 explicitly excludes other pointers and arrays.  This makes a very clear
45 difference between references and things that they refer to, which we
46 will see makes the description of function parameters simpler.  As a
47 structure can hold a reference it is still quite possible to have a
48 reference to a reference, but there will be a structure which keeps the
49 inner and outer clearly separate.
50
51 Functions can receive by-value or by-reference parameters with by-ref being
52 declared like references.  If a non-reference is passed to a reference
53 parameter, it is passed by-reference.  Functions can return a single
54 value, or can return a collections of values which acts like a structure.
55
56 The only IO that is currently possible is that "input" can be received
57 in the sense that command line arguments are available to `main()`, and
58 "output" can be generated with the "print" statement.  It is quite
59 possible that neither of these will remain in the final language.
60
61 The current scalar types are "number", "Boolean", "string" and the new
62 "reference".  Boolean will likely stay in its current form, "string" and
63 "number" are still open to being revised.  Compound types are structures
64 and arrays.
65
66 ## Naming
67
68 Versions of the interpreter which obviously do not support a complete
69 language will be named after creeks and streams.  This one is Cataract
70 Creek.
71
72 Once we have support for methods, the names of rivers will be used.
73 With semantic analysis can start tracking changes to effective types
74 typing within the code (e.g.  a ref becoming "known to not be NULL"),
75 names of lakes will be used.
76
77 Early versions of the compiler will be named after seas.  Major
78 releases of the compiler will be named after oceans.  Hopefully I will
79 be finished once I get to the Pacific Ocean release - otherwise I might
80 need to use Lunar Maria.
81
82 ## Outline
83
84 As well as parsing and executing a program, the interpreter can print
85 out the program from the parsed internal structure.  This is useful
86 for validating the parsing.
87 So the main requirements of the interpreter are:
88
89 - Parse the program, possibly with tracing,
90 - Analyse the parsed program to ensure consistency and deduce implicit
91   information.
92 - Print the program,
93 - Execute the "main" function in the program, if no parsing or
94   consistency errors were found.
95
96 This is all performed by a single C program extracted with
97 `parsergen`, using the `scanner` library.
98
99 There will be two formats for printing the program: a default that uses
100 indenting to show structure and an alternate that uses bracketing.  So a
101 `--bracket` command line option is needed for that.
102
103 The program appear in an "`mdcode`" file and is normally the first
104 top-level code section found.  However an alternate section can
105 be requested so that a file (such as this one) can contain multiple
106 programs.  This is effected with the `--section` option.
107
108 This code must be compiled with `-fplan9-extensions` so that anonymous
109 structures can be used.
110
111 The information gathered while parsing, and used while executing, is all
112 stored in a single `parse_context` data structure.  And this exposition
113 of the program progresses we will add various fields to this structure.
114 It will be pass to many function, and all reduction code (called by the
115 parsing engine) will have easy access to it.
116
117 ###### File: oceani.mk
118
119         myCFLAGS := -Wall -g -fplan9-extensions
120         CFLAGS := $(filter-out $(myCFLAGS),$(CFLAGS)) $(myCFLAGS)
121         myLDLIBS:= libparser.o libscanner.o libmdcode.o -licuuc
122         LDLIBS := $(filter-out $(myLDLIBS),$(LDLIBS)) $(myLDLIBS)
123         ## libs
124         all :: $(LDLIBS) oceani
125         oceani.c oceani.h : oceani.mdc parsergen
126                 ./parsergen -o oceani --LALR --tag Parser oceani.mdc
127         oceani.mk: oceani.mdc md2c
128                 ./md2c oceani.mdc
129
130         oceani: oceani.o $(LDLIBS)
131                 $(CC) $(CFLAGS) -o oceani oceani.o $(LDLIBS)
132
133 ###### Parser: header
134         ## macros
135         struct parse_context;
136         ## ast
137         ## ast late
138         struct parse_context {
139                 struct token_config config;
140                 char *file_name;
141                 int parse_error;
142                 ## parse context
143         };
144
145 ###### macros
146
147         #define container_of(ptr, type, member) ({                      \
148                 const typeof( ((type *)0)->member ) *__mptr = (ptr);    \
149                 (type *)( (char *)__mptr - offsetof(type,member) );})
150
151         #define config2context(_conf) container_of(_conf, struct parse_context, \
152                 config)
153
154 ###### Parser: reduce
155         struct parse_context *c = config2context(config);
156
157 ###### Parser: code
158         #define _GNU_SOURCE
159         #include <unistd.h>
160         #include <stdlib.h>
161         #include <fcntl.h>
162         #include <errno.h>
163         #include <sys/mman.h>
164         #include <string.h>
165         #include <stdio.h>
166         #include <locale.h>
167         #include <malloc.h>
168         #include "mdcode.h"
169         #include "scanner.h"
170         #include "parser.h"
171
172         ## includes
173
174         #include "oceani.h"
175
176         ## forward decls
177         ## value functions
178         ## ast functions
179         ## core functions
180
181         #include <getopt.h>
182         static char Usage[] =
183                 "Usage: oceani --trace --print --noexec --brackets --section=SectionName prog.ocn\n";
184         static const struct option long_options[] = {
185                 {"trace",     0, NULL, 't'},
186                 {"print",     0, NULL, 'p'},
187                 {"noexec",    0, NULL, 'n'},
188                 {"brackets",  0, NULL, 'b'},
189                 {"section",   1, NULL, 's'},
190                 {NULL,        0, NULL, 0},
191         };
192         const char *options = "tpnbs";
193
194         /* pr_err() is used to report inconsistencies in the mdcode,
195          * particularly missing or duplicate section names.
196          */
197         static void pr_err(char *msg)                   // NOTEST
198         {
199                 fprintf(stderr, "%s\n", msg);           // NOTEST
200         }                                               // NOTEST
201
202         int main(int argc, char *argv[])
203         {
204                 int fd;
205                 int len;
206                 char *file;
207                 struct section *s = NULL, *ss;
208                 char *section = NULL;
209                 struct parse_context context = {
210                         .config = {
211                                 ## scanner configuration
212                         },
213                 };
214                 int doprint=0, dotrace=0, doexec=1, brackets=0;
215                 int opt;
216                 while ((opt = getopt_long(argc, argv, options, long_options, NULL))
217                        != -1) {
218                         switch(opt) {
219                         case 't': dotrace=1; break;
220                         case 'p': doprint=1; break;
221                         case 'n': doexec=0; break;
222                         case 'b': brackets=1; break;
223                         case 's': section = optarg; break;
224                         default: fprintf(stderr, Usage);
225                                 exit(1);
226                         }
227                 }
228                 if (optind >= argc) {
229                         fprintf(stderr, "oceani: no input file given\n");
230                         exit(1);
231                 }
232                 fd = open(argv[optind], O_RDONLY);
233                 if (fd < 0) {
234                         fprintf(stderr, "oceani: cannot open %s\n", argv[optind]);
235                         exit(1);
236                 }
237                 context.file_name = argv[optind];
238                 len = lseek(fd, 0, 2);
239                 file = mmap(NULL, len, PROT_READ, MAP_SHARED, fd, 0);
240                 s = code_extract(file, file+len, pr_err);
241                 if (!s) {
242                         fprintf(stderr, "oceani: could not find any code in %s\n",
243                                 argv[optind]);
244                         exit(1);
245                 }
246
247                 ## context initialization
248
249                 if (section) {
250                         for (ss = s; ss; ss = ss->next) {
251                                 struct text sec = ss->section;
252                                 if (sec.len == strlen(section) &&
253                                     strncmp(sec.txt, section, sec.len) == 0)
254                                         break;
255                         }
256                         if (!ss) {
257                                 fprintf(stderr, "oceani: cannot find section %s\n",
258                                         section);
259                                 goto cleanup;
260                         }
261                 } else
262                         ss = s;                         // NOTEST
263                 if (!ss->code) {
264                         fprintf(stderr, "oceani: no code found in requested section\n");        // NOTEST
265                         goto cleanup;                   // NOTEST
266                 }
267
268                 parse_oceani(ss->code, &context.config, dotrace ? stderr : NULL);
269
270                 resolve_consts(&context);
271                 prepare_types(&context);
272                 if (!context.parse_error && !analyse_funcs(&context)) {
273                         fprintf(stderr, "oceani: type error in program - not running.\n");
274                         context.parse_error += 1;
275                 }
276
277                 if (doprint) {
278                         ## print const decls
279                         ## print type decls
280                         ## print func decls
281                 }
282                 if (doexec && !context.parse_error)
283                         interp_main(&context, argc - optind, argv + optind);
284         cleanup:
285                 while (s) {
286                         struct section *t = s->next;
287                         code_free(s->code);
288                         free(s);
289                         s = t;
290                 }
291                 // FIXME parser should pop scope even on error
292                 while (context.scope_depth > 0)
293                         scope_pop(&context);
294                 ## free global vars
295                 ## free const decls
296                 ## free context types
297                 ## free context storage
298                 exit(context.parse_error ? 1 : 0);
299         }
300
301 Minimal configuration is needed for the scanner.  Unknown marks
302 (punctuation) are not permitted so we ignore that.  A wide range of
303 character are permitted in numbers, so that both period and comma can
304 be used for the decimal marker, and both space and underscore can be
305 used to separate groups of digits.  Only the defauls are allowed in
306 identifiers with the exception that underscore can both start and
307 continue an identifier.
308
309 ###### scanner configuration
310         .ignored = (1 << TK_mark),
311         .number_chars = ".,_+- ",
312         .word_start = "_",
313         .word_cont = "_",
314
315 ### Analysis
316
317 The four requirements of parse, analyse, print, and interpret apply to
318 each language element individually so that is how most of the code will
319 be structured.
320
321 Three of the four are fairly self explanatory.  The one that requires
322 a little explanation is the analysis step.
323
324 The current language design does not require the types of variables to
325 be declared, but they must still have a single type.  Different
326 operations impose different requirements on the variables, for example
327 addition requires both arguments to be numeric, and assignment requires
328 the variable on the left to have the same type as the expression on the
329 right, or to be a reference to that type.  There are currently no type
330 that are distinct but compatible, though that will change when more
331 numeric types are introduced and again when interfaces are added.  Until
332 then the type or a variable is determined either from the declaration of
333 the initial assignment, but the code tries not to assume that.
334
335 Analysis involves propagating these type requirements around and
336 consequently setting the type of each variable.  If any requirements are
337 violated (e.g.  a string is compared with a number) or if a variable
338 needs to have two different types, then an error is raised and the
339 program will not run.
340
341 If the same variable is declared in both branches of an 'if/else', or
342 in all cases of a 'switch' then the multiple instances may be merged
343 into just one variable if the variable is referenced after the
344 conditional statement.  When this happens, the types must naturally be
345 consistent across all the branches.  When the variable is not used
346 outside the if, the variables in the different branches are distinct
347 and can be of different types.
348
349 Local variables, global constants, and functions are all named in the
350 same namespace.  If a name is used before it is declared, it is assumed
351 to be global, either a constant or a function.  It must be declare
352 eventually, and this is checked in the analysis phase after all code has
353 been parsed.
354
355 As we will see, the condition part of a `while` statement can return
356 either a Boolean or some other type, and as we have seen an asignment to
357 a reference allows either a reference or the refered-to type to be
358 given.  This requires that the expected type that gets passed around is
359 accompanied by some flags, one to indicate that `Boolean` is also
360 permitted and one to indicate that a reference to the given type is also
361 permitted.
362
363 Possibly the most interesting part of analysis at present involves some
364 flags can be set during analysis of an expression, such as whether it
365 can be used and a "lvalue" (i.e.  it can be assigned to) and whether it
366 can be computed at compile-time, or whether it must wait until runtime.
367 These will be introduced in due course.
368
369 #### Error reporting
370
371 When analysis discovers an inconsistency it needs to report an error;
372 just refusing to run the code ensures that the error doesn't cascade,
373 but by itself it isn't very useful.  A clear understanding of the sort
374 of error messages that are useful will help guide the process of
375 analysis.
376
377 At a simplistic level, the only sort of error that type analysis can
378 report is that the type of some construct doesn't match a contextual
379 requirement.  For example, in `4 + "hello"` the addition provides a
380 contextual requirement for numbers, but `"hello"` is not a number.  In
381 this particular example no further information is needed as the types
382 are obvious from local information.  When a variable is involved that
383 isn't the case.  It may be helpful to explain why the variable has a
384 particular type, by indicating the location where the type was set,
385 whether by declaration or usage.
386
387 Using a recursive-descent analysis we can easily detect a problem at
388 multiple locations.  In "`hello := "there"; print 4 + hello`" the
389 addition will detect that one argument is not a number and the usage of
390 `hello` will detect that a number was wanted, but not provided.  We
391 could generate an error at either location, or even at both.  In this
392 version of the language, we pass down the expected type, and the handler
393 for variables notices that `hello` is not the correct type and reports
394 an error.  So errors are large reported at the leaves.
395
396 To be able to report locations for errors, each language element will
397 need to record a file location (line and column) and each variable will
398 need to record the language element where its type was set.  For now we
399 will assume that each line of an error message indicates one location in
400 the file, and up to 2 types.  So we provide a `printf`-like function
401 which takes a format, a location (a `struct exec` which has not yet been
402 introduced), and 2 types.  "`%1`" reports the first type, "`%2`" reports
403 the second.  We will need a function to print the location, once we know
404 how that is stored.  As explained earlier, there are sometimes extra
405 rules for type matching (to accept Bool or reference) and they might
406 affect error messages, we need to pass those in too.
407
408 As well as type errors, we sometimes need to report problems with
409 tokens, which might be unexpected or badly formatted, or might be a name
410 that has been defined twice or not at all.  For these we have
411 `tok_err()` which reports an error with a given token.  Each of the
412 error functions updates a count of error in the context to indicate that
413 parsing failed.  We use a counter so it is easy to determine if a new
414 error occurred during a particular stage of analysis.
415
416 ###### forward decls
417
418         static void fput_loc(struct exec *loc, FILE *f);
419         static void type_err(struct parse_context *c,
420                              char *fmt, struct exec *loc,
421                              struct type *t1, enum val_rules rules, struct type *t2);
422         static void tok_err(struct parse_context *c, char *fmt, struct token *t);
423
424 ###### core functions
425
426         static void type_err(struct parse_context *c,
427                              char *fmt, struct exec *loc,
428                              struct type *t1, enum val_rules rules, struct type *t2)
429         {
430                 fprintf(stderr, "%s:", c->file_name);
431                 fput_loc(loc, stderr);
432                 for (; *fmt ; fmt++) {
433                         if (*fmt != '%') {
434                                 fputc(*fmt, stderr);
435                                 continue;
436                         }
437                         fmt++;
438                         switch (*fmt) {
439                         case '%': fputc(*fmt, stderr); break;   // NOTEST
440                         default: fputc('?', stderr); break;     // NOTEST
441                         case '1':
442                                 type_print(t1, stderr);
443                                 break;
444                         case '2':
445                                 type_print(t2, stderr);
446                                 break;
447                         ## format cases
448                         }
449                 }
450                 fputs("\n", stderr);
451                 c->parse_error += 1;
452         }
453
454         static void tok_err(struct parse_context *c, char *fmt, struct token *t)
455         {
456                 fprintf(stderr, "%s:%d:%d: %s: %.*s\n", c->file_name, t->line, t->col, fmt,
457                         t->txt.len, t->txt.txt);
458                 c->parse_error += 1;
459         }
460
461 ## Entities: values, types, variables, and code.
462
463 It could be said that the focus of a language is values, which are
464 organised into types, stored in variables, and manipulated with
465 executable code.  This section introduces each of these entities and
466 provide a foundation for them.  Once they are all in place, the next
467 section will flesh them out, particular the mode complex executable code
468 entities.
469
470 ### Executables
471
472 Executables can be lots of different things.  In many cases an
473 executable is just an operation combined with one or two other
474 executables.  This allows for expressions and lists etc.  Other times an
475 executable is something quite specific like a constant or variable name.
476 So we define a `struct exec` to be a general executable with a type, and
477 a `struct binodes` which is a subclass of `exec`, forms a node in a
478 binary tree, and holds an operation.  The simplest operation is "List"
479 which can be used to combine several execs together.
480
481 When parsing a list of binodes, whether with the `List` operator or some
482 other, it is most convenient to append to the end, so a list is a list
483 and a thin.  When using the list it is more convenient to consider
484 a list to be a thing and a list.  So we need a function to re-order
485 a list.  `reorder_bilist` serves this purpose.
486
487 There will be other subclasses, and to access these we need to be able
488 to `cast` the `exec` into the various other types.  The first field in
489 any `struct exec` is the type from the `exec_types` enum.
490
491 ###### macros
492         #define cast(structname, pointer) ({            \
493                 const typeof( ((struct structname *)0)->type) *__mptr =         \
494                                                          &(pointer)->type;      \
495                 if (__mptr && *__mptr != X##structname) abort();                \
496                 (struct structname *)( (char *)__mptr);})
497
498         #define new(structname) ({                                              \
499                 struct structname *__ptr = ((struct structname *)calloc(        \
500                                                 1,sizeof(struct structname)));  \
501                 __ptr->type = X##structname;                                    \
502                 __ptr->line = -1; __ptr->column = -1;                           \
503                 __ptr;})
504
505         #define new_pos(structname, token) ({                                   \
506                 struct structname *__ptr = ((struct structname *)calloc(        \
507                                                 1,sizeof(struct structname)));  \
508                 __ptr->type = X##structname;                                    \
509                 __ptr->line = token.line; __ptr->column = token.col;            \
510                 __ptr;})
511
512 ###### ast
513         enum exec_types {
514                 Xbinode,
515                 ## exec type
516         };
517         struct exec {
518                 enum exec_types type;
519                 int line, column;
520                 ## exec fields
521         };
522         struct binode {
523                 struct exec;
524                 enum Btype {
525                         List,
526                         ## Binode types
527                 } op;
528                 struct exec *left, *right;
529         };
530
531 ###### ast functions
532
533         static int __fput_loc(struct exec *loc, FILE *f)
534         {
535                 if (!loc)
536                         return 0;
537                 if (loc->line >= 0) {
538                         fprintf(f, "%d:%d: ", loc->line, loc->column);
539                         return 1;
540                 }
541                 if (loc->type == Xbinode)
542                         return __fput_loc(cast(binode,loc)->left, f) ||
543                                __fput_loc(cast(binode,loc)->right, f); // NOTEST
544                 return 0;                                              // NOTEST
545         }
546         static void fput_loc(struct exec *loc, FILE *f)
547         {
548                 if (!__fput_loc(loc, f))
549                         fprintf(f, "??:??: ");                  // NOTEST
550         }
551
552         // Move all nodes from 'b' to 'rv', reversing their order.
553         // In 'b' 'left' is a list, and 'right' is the last node.
554         // In 'rv', left' is the first node and 'right' is a list.
555         static struct binode *reorder_bilist(struct binode *b)
556         {
557                 struct binode *rv = NULL;
558
559                 while (b) {
560                         struct exec *t = b->right;
561                         b->right = rv;
562                         rv = b;
563                         if (b->left)
564                                 b = cast(binode, b->left);
565                         else
566                                 b = NULL;
567                         rv->left = t;
568                 }
569                 return rv;
570         }
571
572 Each different type of `exec` node needs a number of functions defined,
573 a bit like methods.  We must be able to free it, print it, analyse it
574 and execute it.  Once we have specific `exec` types we will need to
575 parse them too.  Let's take this a bit more slowly.
576
577 #### Freeing
578
579 The parser generator requires a `free_foo` function for each struct
580 that stores attributes and they will often be `exec`s and subtypes
581 there-of.  So we need `free_exec` which can handle all the subtypes,
582 and we need `free_binode`.
583
584 ###### ast functions
585
586         static void free_binode(struct binode *b)
587         {
588                 if (!b)
589                         return;
590                 free_exec(b->left);
591                 free_exec(b->right);
592                 free(b);
593         }
594
595 ###### core functions
596         static void free_exec(struct exec *e)
597         {
598                 if (!e)
599                         return;
600                 switch(e->type) {
601                         ## free exec cases
602                 }
603         }
604
605 ###### forward decls
606
607         static void free_exec(struct exec *e);
608
609 ###### free exec cases
610         case Xbinode: free_binode(cast(binode, e)); break;
611
612 #### Printing
613
614 Printing an `exec` requires that we know the current indent level for
615 printing line-oriented components.  As will become clear later, we
616 also want to know what sort of bracketing to use.  It will also be used
617 to sometime print comments after an exec to explain some of the results
618 of analysis.
619
620 ###### ast functions
621
622         static void do_indent(int i, char *str)
623         {
624                 while (i-- > 0)
625                         printf("    ");
626                 printf("%s", str);
627         }
628
629 ###### core functions
630         static void print_binode(struct binode *b, int indent, int bracket)
631         {
632                 struct binode *b2;
633                 switch(b->op) {
634                 case List: abort(); // must be handled by parent NOTEST
635                 ## print binode cases
636                 }
637         }
638
639         static void print_exec(struct exec *e, int indent, int bracket)
640         {
641                 if (!e)
642                         return; // NOTEST
643                 switch (e->type) {
644                 case Xbinode:
645                         print_binode(cast(binode, e), indent, bracket); break;
646                 ## print exec cases
647                 }
648                 ## print exec extras
649         }
650
651 ###### forward decls
652
653         static void print_exec(struct exec *e, int indent, int bracket);
654
655 #### Analysing
656
657 As discussed, analysis involves propagating type requirements around the
658 program and looking for errors.
659
660 So `propagate_types` is passed an expected type (being a `struct type`
661 pointer together with some `val_rules` flags) that the `exec` is
662 expected to return, and returns the type that it does return, either of
663 which can be `NULL` signifying "unknown".  A `prop_err` flag set is
664 passed by reference.  It has `Efail` set when an error is found, and
665 `Eretry` when the type for some element is set via propagation.  If
666 any expression cannot be evaluated a compile time, `Eruntime` is set.
667 If the expression can be copied, `Emaycopy` is set.
668
669 If `Erval` is set, then the value cannot be assigned to because it is
670 a temporary result.  If `Erval` is clear but `Econst` is set, then
671 the value can only be assigned once, when the variable is declared.
672
673 Various propagate cases can pass "perr_local" to analyse components of
674 an expression which do not affect the result type of the whole
675 expression.
676
677 ###### ast
678
679         enum val_rules {Rboolok = 1<<0, Rrefok = 1<<1,};
680         enum prop_err {Efail = 1<<0, Eretry = 1<<1, Eruntime = 1<<2,
681                        Emaycopy = 1<<3, Erval = 1<<4, Econst = 1<<5};
682
683 ###### forward decls
684         static struct type *propagate_types(
685                 struct exec *prog, struct parse_context *c, enum prop_err *perr,
686                 struct type *type, enum val_rules rules);
687 ###### core functions
688
689         static struct type *__propagate_types(
690                 struct exec *prog, struct parse_context *c,
691                 enum prop_err *perr, enum prop_err *perr_local,
692                 struct type *type, enum val_rules rules)
693         {
694                 struct type *t;
695
696                 if (!prog)
697                         return Tnone;
698
699                 switch (prog->type) {
700                 case Xbinode:
701                 {
702                         struct binode *b = cast(binode, prog);
703                         switch (b->op) {
704                         case List: abort(); // NOTEST
705                         ## propagate binode cases
706                         }
707                         break;
708                 }
709                 ## propagate exec cases
710                 }
711                 return Tnone;
712         }
713
714         static struct type *propagate_types(struct exec *prog,
715                                             struct parse_context *c,
716                                             enum prop_err *perr,
717                                             struct type *type,
718                                             enum val_rules rules)
719         {
720                 int pre_err = c->parse_error;
721                 enum prop_err perr_local = 0;
722                 struct type *ret = __propagate_types(prog, c, perr, &perr_local,
723                                                      type, rules);
724
725                 *perr |= perr_local & (Efail | Eretry);
726                 if (c->parse_error > pre_err)
727                         *perr |= Efail;
728                 return ret;
729         }
730
731 #### Interpreting
732
733 Interpreting an `exec` primarily requires the `exec` and the variable
734 storage information stored in the parse state.  Apart from modifying
735 those variables, and possibly performing other side-effects, an exec can
736 return a value.  `struct value` is used for passing around small values
737 and a pointer to that structure can be used for larger values.
738
739 Specifically, each `exec` case can return a value combined with a type
740 in `struct lrval`.  The type may be `Tnone` but must be non-NULL.  Some
741 `exec`s will return the location of a value, which can be updated, in
742 `lval`.  Others will set `lval` to NULL indicating that there is a value
743 of appropriate type in `rval`.
744
745 Callers call either `interp_exec()` if they just want the value, or
746 `linterp_exec()~ if they need an lvalue.  `dinterp_exec()` is called
747 when there is a destination for the value to go.  This is used for
748 function calls which return a value that is not an lvalue, but is too
749 large to store in `struct value`.
750
751 Each of these call `_interp_exec()` which calls the appropriate exec case.
752
753 ###### forward decls
754         static struct value interp_exec(struct parse_context *c, struct exec *e,
755                                         struct type **typeret);
756 ###### ast
757
758         struct value {
759                 union {
760                         char ptr[1];
761                         ## value union fields
762                 };
763         };
764
765         struct lrval {
766                 struct type *type;
767                 struct value rval, *lval;
768         };
769
770 ###### core functions
771
772         /* If dest is passed, dtype must give the expected type, and
773          * result can go there, in which case type is returned as NULL.
774          */
775         static struct lrval _interp_exec(struct parse_context *c, struct exec *e,
776                                          struct value *dest, struct type *dtype);
777
778         static struct value interp_exec(struct parse_context *c, struct exec *e,
779                                         struct type **typeret)
780         {
781                 struct lrval ret = _interp_exec(c, e, NULL, NULL);
782
783                 if (!ret.type) abort();
784                 if (typeret)
785                         *typeret = ret.type;
786                 if (ret.lval)
787                         dup_value(ret.type, ret.lval, &ret.rval);
788                 return ret.rval;
789         }
790
791         static struct value *linterp_exec(struct parse_context *c, struct exec *e,
792                                           struct type **typeret)
793         {
794                 struct lrval ret = _interp_exec(c, e, NULL, NULL);
795
796                 if (!ret.type) abort();
797                 if (ret.lval)
798                         *typeret = ret.type;
799                 else
800                         free_value(ret.type, &ret.rval);
801                 return ret.lval;
802         }
803
804         /* dinterp_exec is used when the destination type is certain and
805          * the value has a place to go.
806          */
807         static void dinterp_exec(struct parse_context *c, struct exec *e,
808                                  struct value *dest, struct type *dtype,
809                                  int need_free)
810         {
811                 struct lrval ret = _interp_exec(c, e, dest, dtype);
812                 if (!ret.type)
813                         return;
814                 if (need_free)
815                         free_value(dtype, dest);
816                 if (ret.lval)
817                         dup_value(dtype, ret.lval, dest);
818                 else
819                         memcpy(dest, &ret.rval, dtype->size);
820         }
821
822         static struct lrval _interp_exec(struct parse_context *c, struct exec *e,
823                                          struct value *dest, struct type *dtype)
824         {
825                 /* If the result is copied to dest, ret.type is set to NULL */
826                 struct lrval ret;
827                 struct value rv = {}, *lrv = NULL;
828                 struct type *rvtype;
829
830                 rvtype = ret.type = Tnone;
831                 if (!e) {
832                         ret.lval = lrv;
833                         ret.rval = rv;
834                         return ret;
835                 }
836
837                 switch(e->type) {
838                 case Xbinode:
839                 {
840                         struct binode *b = cast(binode, e);
841                         struct value left, right, *lleft;
842                         struct type *ltype, *rtype;
843                         ltype = rtype = Tnone;
844                         switch (b->op) {
845                         case List: abort();     // NOTEST
846                         ## interp binode cases
847                         }
848                         free_value(ltype, &left);
849                         free_value(rtype, &right);
850                         break;
851                 }
852                 ## interp exec cases
853                 }
854                 if (rvtype) {
855                         ret.lval = lrv;
856                         ret.rval = rv;
857                         ret.type = rvtype;
858                 }
859                 ## interp exec cleanup
860                 return ret;
861         }
862
863 ### Types
864
865 Values come in a wide range of types, with more likely to be added.
866 Each type needs to be able to print its own values (for convenience at
867 least, and for printing manifest constants when generating code) as well
868 as to compare two values, at least for equality and possibly for order.
869 For now, values might need to be duplicated and freed, though eventually
870 such manipulations will be better integrated into the language.
871
872 Named type are stored in a simple linked list.  Objects of each type are
873 "values" which are often passed around by value.
874
875 There are both explicitly named types, and anonymous types.  Anonymous
876 cannot be accessed by name, but are used internally and have a name
877 which might be reported in error messages.
878
879 The `prepare_type()` interface is called on a type in two circumstances.
880 After the program has been parsed but before anything in executed it is
881 called with `parse_time` set to one.  This can be used for processing
882 information that was not fully available when the type description was
883 parsed, such as types of fields in structures.  It is then called again
884 at runtime when a variable declaration is processed.  This allows the
885 details of a type to depend on runtime context, such as the size of an
886 array being determined by a constant.  In this second case the
887 `parse_time` parameter is set to zero.
888
889 ###### ast late
890         struct type {
891                 struct text name;
892                 struct type *next;
893                 struct token first_use;
894                 int size, align;
895                 int anon;
896                 void (*init)(struct type *type, struct value *val);
897                 int (*prepare_type)(struct parse_context *c, struct type *type,
898                      int parse_time);
899                 void (*print)(struct type *type, struct value *val, FILE *f);
900                 void (*print_type)(struct type *type, FILE *f);
901                 int (*cmp_order)(struct type *t1, struct type *t2,
902                                  struct value *v1, struct value *v2);
903                 int (*cmp_eq)(struct type *t1, struct type *t2,
904                               struct value *v1, struct value *v2);
905                 void (*dup)(struct type *type, struct value *vold,
906                             struct value *vnew);
907                 int (*test)(struct type *type, struct value *val);
908                 void (*free)(struct type *type, struct value *val);
909                 void (*free_type)(struct type *t);
910                 ## type functions
911                 union {
912                         ## type union fields
913                 };
914         };
915
916 ###### parse context
917
918         struct type *typelist;
919
920 ###### includes
921         #include <stdarg.h>
922
923 ###### ast functions
924
925         static struct type *find_type(struct parse_context *c, struct text s)
926         {
927                 struct type *t = c->typelist;
928
929                 while (t && (t->anon ||
930                              text_cmp(t->name, s) != 0))
931                                 t = t->next;
932                 return t;
933         }
934
935         static struct type *_add_type(struct parse_context *c, struct text s,
936                                      struct type *proto, int anon)
937         {
938                 struct type *n;
939
940                 n = calloc(1, sizeof(*n));
941                 if (proto)
942                         *n = *proto;
943                 else
944                         n->size = -1;
945                 n->name = s;
946                 n->anon = anon;
947                 n->next = c->typelist;
948                 c->typelist = n;
949                 return n;
950         }
951
952         static struct type *add_type(struct parse_context *c, struct text s,
953                                       struct type *proto)
954         {
955                 return _add_type(c, s, proto, 0);
956         }
957
958         static struct type *add_anon_type(struct parse_context *c,
959                                           struct type *proto, char *name, ...)
960         {
961                 struct text t;
962                 va_list ap;
963
964                 va_start(ap, name);
965                 vasprintf(&t.txt, name, ap);
966                 va_end(ap);
967                 t.len = strlen(t.txt);
968                 return _add_type(c, t, proto, 1);
969         }
970
971         static struct type *find_anon_type(struct parse_context *c,
972                                            struct type *proto, char *name, ...)
973         {
974                 struct type *t = c->typelist;
975                 struct text nm;
976                 va_list ap;
977
978                 va_start(ap, name);
979                 vasprintf(&nm.txt, name, ap);
980                 va_end(ap);
981                 nm.len = strlen(name);
982
983                 while (t && (!t->anon ||
984                              text_cmp(t->name, nm) != 0))
985                                 t = t->next;
986                 if (t) {
987                         free(nm.txt);
988                         return t;
989                 }
990                 return _add_type(c, nm, proto, 1);
991         }
992
993         static void free_type(struct type *t)
994         {
995                 /* The type is always a reference to something in the
996                  * context, so we don't need to free anything.
997                  */
998         }
999
1000         static void free_value(struct type *type, struct value *v)
1001         {
1002                 if (type && v) {
1003                         type->free(type, v);
1004                         memset(v, 0x5a, type->size);
1005                 }
1006         }
1007
1008         static void type_print(struct type *type, FILE *f)
1009         {
1010                 if (!type)
1011                         fputs("*unknown*type*", f);     // NOTEST
1012                 else if (type->name.len && !type->anon)
1013                         fprintf(f, "%.*s", type->name.len, type->name.txt);
1014                 else if (type->print_type)
1015                         type->print_type(type, f);
1016                 else if (type->name.len && type->anon)
1017                         fprintf(f, "\"%.*s\"", type->name.len, type->name.txt);
1018                 else
1019                         fputs("*invalid*type*", f);     // NOTEST
1020         }
1021
1022         static void val_init(struct type *type, struct value *val)
1023         {
1024                 if (type && type->init)
1025                         type->init(type, val);
1026         }
1027
1028         static void dup_value(struct type *type,
1029                               struct value *vold, struct value *vnew)
1030         {
1031                 if (type && type->dup)
1032                         type->dup(type, vold, vnew);
1033         }
1034
1035         static int value_cmp(struct type *tl, struct type *tr,
1036                              struct value *left, struct value *right)
1037         {
1038                 if (tl && tl->cmp_order)
1039                         return tl->cmp_order(tl, tr, left, right);
1040                 if (tl && tl->cmp_eq)
1041                         return tl->cmp_eq(tl, tr, left, right);
1042                 return -1;                              // NOTEST
1043         }
1044
1045         static void print_value(struct type *type, struct value *v, FILE *f)
1046         {
1047                 if (type && type->print)
1048                         type->print(type, v, f);
1049                 else
1050                         fprintf(f, "*Unknown*");                // NOTEST
1051         }
1052
1053         static void prepare_types(struct parse_context *c)
1054         {
1055                 struct type *t;
1056                 int retry = 1;
1057                 enum { none, some, cannot } progress = none;
1058
1059                 while (retry) {
1060                         retry = 0;
1061
1062                         for (t = c->typelist; t; t = t->next) {
1063                                 if (t->size < 0)
1064                                         tok_err(c, "error: type used but not declared",
1065                                                  &t->first_use);
1066                                 if (t->size == 0 && t->prepare_type) {
1067                                         if (t->prepare_type(c, t, 1))
1068                                                 progress = some;
1069                                         else if (progress == cannot)
1070                                                 tok_err(c, "error: type has recursive definition",
1071                                                         &t->first_use);
1072                                         else
1073                                                 retry = 1;
1074                                 }
1075                         }
1076                         switch (progress) {
1077                         case cannot:
1078                                 retry = 0; break;
1079                         case none:
1080                                 progress = cannot; break;
1081                         case some:
1082                                 progress = none; break;
1083                         }
1084                 }
1085         }
1086
1087 ###### forward decls
1088
1089         static void free_value(struct type *type, struct value *v);
1090         static int type_compat(struct type *require, struct type *have, enum val_rules rules);
1091         static void type_print(struct type *type, FILE *f);
1092         static void val_init(struct type *type, struct value *v);
1093         static void dup_value(struct type *type,
1094                               struct value *vold, struct value *vnew);
1095         static int value_cmp(struct type *tl, struct type *tr,
1096                              struct value *left, struct value *right);
1097         static void print_value(struct type *type, struct value *v, FILE *f);
1098
1099 ###### free context types
1100
1101         while (context.typelist) {
1102                 struct type *t = context.typelist;
1103
1104                 context.typelist = t->next;
1105                 if (t->free_type)
1106                         t->free_type(t);
1107                 if (t->anon)
1108                         free(t->name.txt);
1109                 free(t);
1110         }
1111
1112 Type can be specified for local variables, for fields in a structure,
1113 for formal parameters to functions, and possibly elsewhere.  Different
1114 rules may apply in different contexts.  As a minimum, a named type may
1115 always be used.  Currently the type of a formal parameter can be
1116 different from types in other contexts, so we have a separate grammar
1117 symbol for those.
1118
1119 ###### Grammar
1120
1121         $*type
1122         Type -> IDENTIFIER ${
1123                 $0 = find_type(c, $ID.txt);
1124                 if (!$0) {
1125                         $0 = add_type(c, $ID.txt, NULL);
1126                         $0->first_use = $ID;
1127                 }
1128         }$
1129         ## type grammar
1130
1131         FormalType -> Type ${ $0 = $<1; }$
1132         ## formal type grammar
1133
1134 #### Base Types
1135
1136 Values of the base types can be numbers, which we represent as
1137 multi-precision fractions, strings, Booleans and labels.  When
1138 analysing the program we also need to allow for places where no value
1139 is meaningful (type `Tnone`) and where we don't know what type to
1140 expect yet (type is `NULL`).
1141
1142 Values are never shared, they are always copied when used, and freed
1143 when no longer needed.
1144
1145 When propagating type information around the program, we need to
1146 determine if two types are compatible, where type `NULL` is compatible
1147 with anything.  There are two special cases with type compatibility.
1148 In some cases a Boolean can be accepted as well as some other
1149 primary type.  In other cases a reference to the given type is
1150 acceptable in place of a value of the type itself.
1151
1152 ###### type functions
1153
1154         int (*compat)(struct type *this, struct type *other, enum val_rules rules);
1155
1156 ###### ast functions
1157
1158         static int type_compat(struct type *require, struct type *have,
1159                                enum val_rules rules)
1160         {
1161                 if (!require || !have)
1162                         return 1;
1163
1164                 if (require->compat)
1165                         return require->compat(require, have, rules);
1166
1167                 return require == have;
1168         }
1169
1170 ###### includes
1171         #include <gmp.h>
1172         #include "parse_string.h"
1173         #include "parse_number.h"
1174
1175 ###### libs
1176         myLDLIBS := libnumber.o libstring.o -lgmp
1177         LDLIBS := $(filter-out $(myLDLIBS),$(LDLIBS)) $(myLDLIBS)
1178
1179 ###### type union fields
1180         enum vtype {Vnone, Vstr, Vnum, Vbool, Vlabel} vtype;
1181
1182 ###### value union fields
1183         struct text str;
1184         mpq_t num;
1185         unsigned char bool;
1186         int label;
1187
1188 ###### ast functions
1189         static void _free_value(struct type *type, struct value *v)
1190         {
1191                 if (!v)
1192                         return;         // NOTEST
1193                 switch (type->vtype) {
1194                 case Vnone: break;
1195                 case Vstr: free(v->str.txt); break;
1196                 case Vnum: mpq_clear(v->num); break;
1197                 case Vlabel:
1198                 case Vbool: break;
1199                 }
1200         }
1201
1202 ###### value functions
1203
1204         static void _val_init(struct type *type, struct value *val)
1205         {
1206                 switch(type->vtype) {
1207                 case Vnone:             // NOTEST
1208                         break;          // NOTEST
1209                 case Vnum:
1210                         mpq_init(val->num); break;
1211                 case Vstr:
1212                         val->str.txt = malloc(1);
1213                         val->str.len = 0;
1214                         break;
1215                 case Vbool:
1216                         val->bool = 0;
1217                         break;
1218                 case Vlabel:
1219                         val->label = 0; // NOTEST
1220                         break;          // NOTEST
1221                 }
1222         }
1223
1224         static void _dup_value(struct type *type,
1225                                struct value *vold, struct value *vnew)
1226         {
1227                 switch (type->vtype) {
1228                 case Vnone:             // NOTEST
1229                         break;          // NOTEST
1230                 case Vlabel:
1231                         vnew->label = vold->label;      // NOTEST
1232                         break;          // NOTEST
1233                 case Vbool:
1234                         vnew->bool = vold->bool;
1235                         break;
1236                 case Vnum:
1237                         mpq_init(vnew->num);
1238                         mpq_set(vnew->num, vold->num);
1239                         break;
1240                 case Vstr:
1241                         vnew->str.len = vold->str.len;
1242                         vnew->str.txt = malloc(vnew->str.len);
1243                         memcpy(vnew->str.txt, vold->str.txt, vnew->str.len);
1244                         break;
1245                 }
1246         }
1247
1248         static int _value_cmp(struct type *tl, struct type *tr,
1249                               struct value *left, struct value *right)
1250         {
1251                 int cmp;
1252                 if (tl != tr)
1253                         return tl - tr;
1254                 switch (tl->vtype) {
1255                 case Vlabel: cmp = left->label == right->label ? 0 : 1; break;
1256                 case Vnum: cmp = mpq_cmp(left->num, right->num); break;
1257                 case Vstr: cmp = text_cmp(left->str, right->str); break;
1258                 case Vbool: cmp = left->bool - right->bool; break;
1259                 case Vnone: cmp = 0;                    // NOTEST
1260                 }
1261                 return cmp;
1262         }
1263
1264         static void _print_value(struct type *type, struct value *v, FILE *f)
1265         {
1266                 switch (type->vtype) {
1267                 case Vnone:                             // NOTEST
1268                         fprintf(f, "*no-value*"); break;        // NOTEST
1269                 case Vlabel:                            // NOTEST
1270                         fprintf(f, "*label-%d*", v->label); break; // NOTEST
1271                 case Vstr:
1272                         fprintf(f, "%.*s", v->str.len, v->str.txt); break;
1273                 case Vbool:
1274                         fprintf(f, "%s", v->bool ? "True":"False"); break;
1275                 case Vnum:
1276                         {
1277                         mpf_t fl;
1278                         mpf_init2(fl, 20);
1279                         mpf_set_q(fl, v->num);
1280                         gmp_fprintf(f, "%.10Fg", fl);
1281                         mpf_clear(fl);
1282                         break;
1283                         }
1284                 }
1285         }
1286
1287         static void _free_value(struct type *type, struct value *v);
1288
1289         static int bool_test(struct type *type, struct value *v)
1290         {
1291                 return v->bool;
1292         }
1293
1294         static struct type base_prototype = {
1295                 .init = _val_init,
1296                 .print = _print_value,
1297                 .cmp_order = _value_cmp,
1298                 .cmp_eq = _value_cmp,
1299                 .dup = _dup_value,
1300                 .free = _free_value,
1301         };
1302
1303         static struct type *Tbool, *Tstr, *Tnum, *Tnone, *Tlabel;
1304
1305 ###### ast functions
1306         static struct type *add_base_type(struct parse_context *c, char *n,
1307                                           enum vtype vt, int size)
1308         {
1309                 struct text txt = { n, strlen(n) };
1310                 struct type *t;
1311
1312                 t = add_type(c, txt, &base_prototype);
1313                 t->vtype = vt;
1314                 t->size = size;
1315                 t->align = size > sizeof(void*) ? sizeof(void*) : size;
1316                 if (t->size & (t->align - 1))
1317                         t->size = (t->size | (t->align - 1)) + 1;       // NOTEST
1318                 return t;
1319         }
1320
1321 ###### context initialization
1322
1323         Tbool  = add_base_type(&context, "Boolean", Vbool, sizeof(char));
1324         Tbool->test = bool_test;
1325         Tstr   = add_base_type(&context, "string", Vstr, sizeof(struct text));
1326         Tnum   = add_base_type(&context, "number", Vnum, sizeof(mpq_t));
1327         Tnone  = add_base_type(&context, "none", Vnone, 0);
1328         Tlabel = add_base_type(&context, "label", Vlabel, sizeof(void*));
1329
1330 ##### Base Values
1331
1332 We have already met values as separate objects.  When manifest constants
1333 appear in the program text, that must result in an executable which has
1334 a constant value.  So the `val` structure embeds a value in an
1335 executable.
1336
1337 ###### exec type
1338         Xval,
1339
1340 ###### ast
1341         struct val {
1342                 struct exec;
1343                 struct type *vtype;
1344                 struct value val;
1345         };
1346
1347 ###### ast functions
1348         struct val *new_val(struct type *T, struct token tk)
1349         {
1350                 struct val *v = new_pos(val, tk);
1351                 v->vtype = T;
1352                 return v;
1353         }
1354
1355 ###### declare terminals
1356         $TERM True False
1357
1358 ###### Grammar
1359
1360         $*val
1361         Value ->  True ${
1362                 $0 = new_val(Tbool, $1);
1363                 $0->val.bool = 1;
1364         }$
1365         | False ${
1366                 $0 = new_val(Tbool, $1);
1367                 $0->val.bool = 0;
1368         }$
1369         | NUMBER ${ {
1370                 char tail[3] = "";
1371                 $0 = new_val(Tnum, $1);
1372                 if (number_parse($0->val.num, tail, $1.txt) == 0) {
1373                         mpq_init($0->val.num);
1374                         tok_err(c, "error: unsupported number format", &$NUM);
1375                 } else if (tail[0])
1376                         tok_err(c, "error: unsupported number suffix", &$1);
1377         } }$
1378         | STRING ${ {
1379                 char tail[3];
1380                 $0 = new_val(Tstr, $1);
1381                 string_parse(&$1, '\\', &$0->val.str, tail);
1382                 if (tail[0])
1383                         tok_err(c, "error: unsupported string suffix",
1384                                 &$1);
1385         } }$
1386         | MULTI_STRING ${ {
1387                 char tail[3];
1388                 $0 = new_val(Tstr, $1);
1389                 string_parse(&$1, '\\', &$0->val.str, tail);
1390                 if (tail[0])
1391                         tok_err(c, "error: unsupported string suffix",
1392                                 &$1);
1393         } }$
1394
1395 ###### print exec cases
1396         case Xval:
1397         {
1398                 struct val *v = cast(val, e);
1399                 if (v->vtype == Tstr)
1400                         printf("\"");
1401                 // FIXME how to ensure numbers have same precision.
1402                 print_value(v->vtype, &v->val, stdout);
1403                 if (v->vtype == Tstr)
1404                         printf("\"");
1405                 break;
1406         }
1407
1408 ###### propagate exec cases
1409         case Xval:
1410         {
1411                 struct val *val = cast(val, prog);
1412                 if (!type_compat(type, val->vtype, rules))
1413                         type_err(c, "error: expected %1 found %2",
1414                                    prog, type, rules, val->vtype);
1415                 *perr |= Erval;
1416                 return val->vtype;
1417         }
1418
1419 ###### interp exec cases
1420         case Xval:
1421                 rvtype = cast(val, e)->vtype;
1422                 dup_value(rvtype, &cast(val, e)->val, &rv);
1423                 break;
1424
1425 ###### ast functions
1426         static void free_val(struct val *v)
1427         {
1428                 if (v)
1429                         free_value(v->vtype, &v->val);
1430                 free(v);
1431         }
1432
1433 ###### free exec cases
1434         case Xval: free_val(cast(val, e)); break;
1435
1436 #### Labels
1437
1438 Labels are a temporary concept until I implement enums.  There are an
1439 anonymous enum which is declared by usage.  They are only allowed in
1440 `use` statements and corresponding `case` entries.  They appear as a
1441 period followed by an identifier.  All identifiers that are "used" must
1442 have a "case".
1443
1444 For now, we have a global list of labels, and don't check that all "use"
1445 match "case".
1446
1447 ###### exec type
1448         Xlabel,
1449
1450 ###### ast
1451         struct label {
1452                 struct exec;
1453                 struct text name;
1454                 int value;
1455         };
1456 ###### free exec cases
1457         case Xlabel:
1458                 free(e);
1459                 break;
1460 ###### print exec cases
1461         case Xlabel: {
1462                 struct label *l = cast(label, e);
1463                 printf(".%.*s", l->name.len, l->name.txt);
1464                 break;
1465         }
1466
1467 ###### ast
1468         struct labels {
1469                 struct labels *next;
1470                 struct text name;
1471                 int value;
1472         };
1473 ###### parse context
1474         struct labels *labels;
1475         int next_label;
1476 ###### ast functions
1477         static int label_lookup(struct parse_context *c, struct text name)
1478         {
1479                 struct labels *l, **lp = &c->labels;
1480                 while (*lp && text_cmp((*lp)->name, name) < 0)
1481                         lp = &(*lp)->next;
1482                 if (*lp && text_cmp((*lp)->name, name) == 0)
1483                         return (*lp)->value;
1484                 l = calloc(1, sizeof(*l));
1485                 l->next = *lp;
1486                 l->name = name;
1487                 if (c->next_label == 0)
1488                         c->next_label = 2;
1489                 l->value = c->next_label;
1490                 c->next_label += 1;
1491                 *lp = l;
1492                 return l->value;
1493         }
1494
1495 ###### free context storage
1496         while (context.labels) {
1497                 struct labels *l = context.labels;
1498                 context.labels = l->next;
1499                 free(l);
1500         }
1501
1502 ###### declare terminals
1503         $TERM .
1504 ###### term grammar
1505         | . IDENTIFIER ${ {
1506                 struct label *l = new_pos(label, $ID);
1507                 l->name = $ID.txt;
1508                 $0 = l;
1509         } }$
1510 ###### propagate exec cases
1511         case Xlabel: {
1512                 struct label *l = cast(label, prog);
1513                 l->value = label_lookup(c, l->name);
1514                 if (!type_compat(type, Tlabel, rules))
1515                         type_err(c, "error: expected %1 found %2",
1516                                  prog, type, rules, Tlabel);
1517                 *perr |= Erval;
1518                 return Tlabel;
1519         }
1520 ###### interp exec cases
1521         case Xlabel : {
1522                 struct label *l = cast(label, e);
1523                 rv.label = l->value;
1524                 rvtype = Tlabel;
1525                 break;
1526         }
1527
1528 ### Variables
1529
1530 Variables are scoped named values.  We store the names in a linked list
1531 of "bindings" sorted in lexical order, and use sequential search and
1532 insertion sort.
1533
1534 ###### ast
1535
1536         struct binding {
1537                 struct text name;
1538                 struct binding *next;   // in lexical order
1539                 ## binding fields
1540         };
1541
1542 This linked list is stored in the parse context so that "reduce"
1543 functions can find or add variables, and so the analysis phase can
1544 ensure that every variable gets a type.
1545
1546 ###### parse context
1547
1548         struct binding *varlist;  // In lexical order
1549
1550 ###### ast functions
1551
1552         static struct binding *find_binding(struct parse_context *c, struct text s)
1553         {
1554                 struct binding **l = &c->varlist;
1555                 struct binding *n;
1556                 int cmp = 1;
1557
1558                 while (*l &&
1559                         (cmp = text_cmp((*l)->name, s)) < 0)
1560                                 l = & (*l)->next;
1561                 if (cmp == 0)
1562                         return *l;
1563                 n = calloc(1, sizeof(*n));
1564                 n->name = s;
1565                 n->next = *l;
1566                 *l = n;
1567                 return n;
1568         }
1569
1570 Each name can be linked to multiple variables defined in different
1571 scopes.  Each scope starts where the name is declared and continues
1572 until the end of the containing code block.  Scopes of a given name
1573 cannot nest, so a declaration while a name is in-scope is an error.
1574
1575 ###### binding fields
1576         struct variable *var;
1577
1578 ###### ast
1579         struct variable {
1580                 struct variable *previous;
1581                 struct type *type;
1582                 struct binding *name;
1583                 struct exec *where_decl;// where name was declared
1584                 struct exec *where_set; // where type was set
1585                 ## variable fields
1586         };
1587
1588 The parser will want to be able to free a variable, but as this will
1589 also be a reference to something stored in the parse context, there is
1590 not action needed.
1591
1592 ###### ast functions
1593         void free_variable(struct variable *v)
1594         {
1595         }
1596
1597 When a scope closes, the values of the variables might need to be freed.
1598 This happens in the context of some `struct exec` and each `exec` will
1599 need to know which variables need to be freed when it completes.  To
1600 improve visibility, we add a comment when printing any `exec` that
1601 embodies a scope to list the variables that must be freed when it ends.
1602
1603 ####### exec fields
1604         struct variable *to_free;
1605
1606 ####### variable fields
1607         struct exec *cleanup_exec;
1608         struct variable *next_free;
1609
1610 ####### interp exec cleanup
1611         {
1612                 struct variable *v;
1613                 for (v = e->to_free; v; v = v->next_free) {
1614                         struct value *val = var_value(c, v);
1615                         free_value(v->type, val);
1616                 }
1617         }
1618
1619 ###### print exec extras
1620         if (e->to_free) {
1621                 struct variable *v;
1622                 do_indent(indent, "/* FREE");
1623                 for (v = e->to_free; v; v = v->next_free) {
1624                         printf(" %.*s", v->name->name.len, v->name->name.txt);
1625                         printf("[%d,%d]", v->scope_start, v->scope_end);
1626                         if (v->frame_pos >= 0)
1627                                 printf("(%d+%d)", v->frame_pos,
1628                                        v->type ? v->type->size:0);
1629                 }
1630                 printf(" */\n");
1631         }
1632
1633 ###### ast functions
1634         static void variable_unlink_exec(struct variable *v)
1635         {
1636                 struct variable **vp;
1637                 if (!v->cleanup_exec)
1638                         return;
1639                 for (vp = &v->cleanup_exec->to_free;
1640                     *vp; vp = &(*vp)->next_free) {
1641                         if (*vp != v)
1642                                 continue;
1643                         *vp = v->next_free;
1644                         v->cleanup_exec = NULL;
1645                         break;
1646                 }
1647         }
1648
1649 While the naming seems strange, we include local constants in the
1650 definition of variables.  A name declared `var := value` can
1651 subsequently be changed, but a name declared `var ::= value` cannot -
1652 it is constant
1653
1654 ###### variable fields
1655         int constant;
1656
1657 Scopes in parallel branches can be partially merged.  More
1658 specifically, if a given name is declared in both branches of an
1659 if/else then its scope is a candidate for merging.  Similarly if
1660 every branch of an exhaustive switch (e.g. has an "else" clause)
1661 declares a given name, then the scopes from the branches are
1662 candidates for merging.
1663
1664 Note that names declared inside a loop (which is only parallel to
1665 itself) are never visible after the loop.  Similarly names defined in
1666 scopes which are not parallel, such as those started by `for` and
1667 `switch`, are never visible after the scope.  Only variables defined in
1668 both `then` and `else` (including the implicit then after an `if`, and
1669 excluding `then` used with `for`) and in all `case`s and `else` of a
1670 `switch` or `while` can be visible beyond the `if`/`switch`/`while`.
1671
1672 Labels, which are a bit like variables, follow different rules.
1673 Labels are not explicitly declared, but if an undeclared name appears
1674 in a context where a label is legal, that effectively declares the
1675 name as a label.  The declaration remains in force (or in scope) at
1676 least to the end of the immediately containing block and conditionally
1677 in any larger containing block which does not declare the name in some
1678 other way.  Importantly, the conditional scope extension happens even
1679 if the label is only used in one parallel branch of a conditional --
1680 when used in one branch it is treated as having been declared in all
1681 branches.
1682
1683 Merge candidates are tentatively visible beyond the end of the
1684 branching statement which creates them.  If the name is used, the
1685 merge is affirmed and they become a single variable visible at the
1686 outer layer.  If not - if it is redeclared first - the merge lapses.
1687
1688 To track scopes we have an extra stack, implemented as a linked list,
1689 which roughly parallels the parse stack and which is used exclusively
1690 for scoping.  When a new scope is opened, a new frame is pushed and
1691 the child-count of the parent frame is incremented.  This child-count
1692 is used to distinguish between the first of a set of parallel scopes,
1693 in which declared variables must not be in scope, and subsequent
1694 branches, whether they may already be conditionally scoped.
1695
1696 We need a total ordering of scopes so we can easily compare to variables
1697 to see if they are concurrently in scope.  To achieve this we record a
1698 `scope_count` which is actually a count of both beginnings and endings
1699 of scopes.  Then each variable has a record of the scope count where it
1700 enters scope, and where it leaves.
1701
1702 To push a new frame *before* any code in the frame is parsed, we need a
1703 grammar reduction.  This is most easily achieved with a grammar
1704 element which derives the empty string, and creates the new scope when
1705 it is recognised.  This can be placed, for example, between a keyword
1706 like "if" and the code following it.
1707
1708 ###### ast
1709         struct scope {
1710                 struct scope *parent;
1711                 int child_count;
1712         };
1713
1714 ###### parse context
1715         int scope_depth;
1716         int scope_count;
1717         struct scope *scope_stack;
1718
1719 ###### variable fields
1720         int scope_start, scope_end;
1721
1722 ###### ast functions
1723         static void scope_pop(struct parse_context *c)
1724         {
1725                 struct scope *s = c->scope_stack;
1726
1727                 c->scope_stack = s->parent;
1728                 free(s);
1729                 c->scope_depth -= 1;
1730                 c->scope_count += 1;
1731         }
1732
1733         static void scope_push(struct parse_context *c)
1734         {
1735                 struct scope *s = calloc(1, sizeof(*s));
1736                 if (c->scope_stack)
1737                         c->scope_stack->child_count += 1;
1738                 s->parent = c->scope_stack;
1739                 c->scope_stack = s;
1740                 c->scope_depth += 1;
1741                 c->scope_count += 1;
1742         }
1743
1744 ###### Grammar
1745
1746         $void
1747         OpenScope -> ${ scope_push(c); }$
1748
1749 Each variable records a scope depth and is in one of four states:
1750
1751 - "in scope".  This is the case between the declaration of the
1752   variable and the end of the containing block, and also between
1753   the usage with affirms a merge and the end of that block.
1754
1755   The scope depth is not greater than the current parse context scope
1756   nest depth.  When the block of that depth closes, the state will
1757   change.  To achieve this, all "in scope" variables are linked
1758   together as a stack in nesting order.
1759
1760 - "pending".  The "in scope" block has closed, but other parallel
1761   scopes are still being processed.  So far, every parallel block at
1762   the same level that has closed has declared the name.
1763
1764   The scope depth is the depth of the last parallel block that
1765   enclosed the declaration, and that has closed.
1766
1767 - "conditionally in scope".  The "in scope" block and all parallel
1768   scopes have closed, and no further mention of the name has been seen.
1769   This state includes a secondary nest depth (`min_depth`) which records
1770   the outermost scope seen since the variable became conditionally in
1771   scope.  If a use of the name is found, the variable becomes "in scope"
1772   and that secondary depth becomes the recorded scope depth.  If the
1773   name is declared as a new variable, the old variable becomes "out of
1774   scope" and the recorded scope depth stays unchanged.
1775
1776 - "out of scope".  The variable is neither in scope nor conditionally
1777   in scope.  It is permanently out of scope now and can be removed from
1778   the "in scope" stack.  When a variable becomes out-of-scope it is
1779   moved to a separate list (`out_scope`) of variables which have fully
1780   known scope.  This will be used at the end of each function to assign
1781   each variable a place in the stack frame.
1782
1783 ###### variable fields
1784         int depth, min_depth;
1785         enum { OutScope, PendingScope, CondScope, InScope } scope;
1786         struct variable *in_scope;
1787
1788 ###### parse context
1789
1790         struct variable *in_scope;
1791         struct variable *out_scope;
1792
1793 All variables with the same name are linked together using the
1794 'previous' link.  Those variable that have been affirmatively merged all
1795 have a 'merged' pointer that points to one primary variable - the most
1796 recently declared instance.  When merging variables, we need to also
1797 adjust the 'merged' pointer on any other variables that had previously
1798 been merged with the one that will no longer be primary.
1799
1800 A variable that is no longer the most recent instance of a name may
1801 still have "pending" scope, if it might still be merged with most
1802 recent instance.  These variables don't really belong in the
1803 "in_scope" list, but are not immediately removed when a new instance
1804 is found.  Instead, they are detected and ignored when considering the
1805 list of in_scope names.
1806
1807 The storage of the value of a variable will be described later.  For now
1808 we just need to know that when a variable goes out of scope, it might
1809 need to be freed.  For this we need to be able to find it, so assume that
1810 `var_value()` will provide that.
1811
1812 ###### variable fields
1813         struct variable *merged;
1814
1815 ###### ast functions
1816
1817         static void variable_merge(struct variable *primary, struct variable *secondary)
1818         {
1819                 struct variable *v;
1820
1821                 primary = primary->merged;
1822
1823                 for (v = primary->previous; v; v=v->previous)
1824                         if (v == secondary || v == secondary->merged ||
1825                             v->merged == secondary ||
1826                             v->merged == secondary->merged) {
1827                                 v->scope = OutScope;
1828                                 v->merged = primary;
1829                                 if (v->scope_start < primary->scope_start)
1830                                         primary->scope_start = v->scope_start;
1831                                 if (v->scope_end > primary->scope_end)
1832                                         primary->scope_end = v->scope_end;      // NOTEST
1833                                 variable_unlink_exec(v);
1834                         }
1835         }
1836
1837 ###### forward decls
1838         static struct value *var_value(struct parse_context *c, struct variable *v);
1839
1840 ###### free global vars
1841
1842         while (context.varlist) {
1843                 struct binding *b = context.varlist;
1844                 struct variable *v = b->var;
1845                 context.varlist = b->next;
1846                 free(b);
1847                 while (v) {
1848                         struct variable *next = v->previous;
1849
1850                         if (v->global && v->frame_pos >= 0) {
1851                                 free_value(v->type, var_value(&context, v));
1852                                 if (v->depth == 0 && v->type->free == function_free)
1853                                         // This is a function constant
1854                                         free_exec(v->where_decl);
1855                         }
1856                         free(v);
1857                         v = next;
1858                 }
1859         }
1860
1861 #### Manipulating Bindings
1862
1863 When a name is conditionally visible, a new declaration discards the old
1864 binding - the condition lapses.  Similarly when we reach the end of a
1865 function (outermost non-global scope) any conditional scope must lapse.
1866 Conversely a usage of the name affirms the visibility and extends it to
1867 the end of the containing block - i.e.  the block that contains both the
1868 original declaration and the latest usage.  This is determined from
1869 `min_depth`.  When a conditionally visible variable gets affirmed like
1870 this, it is also merged with other conditionally visible variables with
1871 the same name.
1872
1873 When we parse a variable declaration we either report an error if the
1874 name is currently bound, or create a new variable at the current nest
1875 depth if the name is unbound or bound to a conditionally scoped or
1876 pending-scope variable.  If the previous variable was conditionally
1877 scoped, it and its homonyms becomes out-of-scope.
1878
1879 When we parse a variable reference (including non-declarative assignment
1880 "foo = bar") we report an error if the name is not bound or is bound to
1881 a pending-scope variable; update the scope if the name is bound to a
1882 conditionally scoped variable; or just proceed normally if the named
1883 variable is in scope.
1884
1885 When we exit a scope, any variables bound at this level are either
1886 marked out of scope or pending-scoped, depending on whether the scope
1887 was sequential or parallel.  Here a "parallel" scope means the "then"
1888 or "else" part of a conditional, or any "case" or "else" branch of a
1889 switch.  Other scopes are "sequential".
1890
1891 When exiting a parallel scope we check if there are any variables that
1892 were previously pending and are still visible. If there are, then
1893 they weren't redeclared in the most recent scope, so they cannot be
1894 merged and must become out-of-scope.  If it is not the first of
1895 parallel scopes (based on `child_count`), we check that there was a
1896 previous binding that is still pending-scope.  If there isn't, the new
1897 variable must now be out-of-scope.
1898
1899 When exiting a sequential scope that immediately enclosed parallel
1900 scopes, we need to resolve any pending-scope variables.  If there was
1901 no `else` clause, and we cannot determine that the `switch` was exhaustive,
1902 we need to mark all pending-scope variable as out-of-scope.  Otherwise
1903 all pending-scope variables become conditionally scoped.
1904
1905 ###### ast
1906         enum closetype { CloseSequential, CloseFunction, CloseParallel, CloseElse };
1907
1908 ###### ast functions
1909
1910         static struct variable *var_decl(struct parse_context *c, struct text s)
1911         {
1912                 struct binding *b = find_binding(c, s);
1913                 struct variable *v = b->var;
1914
1915                 switch (v ? v->scope : OutScope) {
1916                 case InScope:
1917                         /* Caller will report the error */
1918                         return NULL;
1919                 case CondScope:
1920                         for (;
1921                              v && v->scope == CondScope;
1922                              v = v->previous)
1923                                 v->scope = OutScope;
1924                         break;
1925                 default: break;
1926                 }
1927                 v = calloc(1, sizeof(*v));
1928                 v->previous = b->var;
1929                 b->var = v;
1930                 v->name = b;
1931                 v->merged = v;
1932                 v->min_depth = v->depth = c->scope_depth;
1933                 v->scope = InScope;
1934                 v->in_scope = c->in_scope;
1935                 v->scope_start = c->scope_count;
1936                 c->in_scope = v;
1937                 ## variable init
1938                 return v;
1939         }
1940
1941         static struct variable *var_ref(struct parse_context *c, struct text s)
1942         {
1943                 struct binding *b = find_binding(c, s);
1944                 struct variable *v = b->var;
1945                 struct variable *v2;
1946
1947                 switch (v ? v->scope : OutScope) {
1948                 case OutScope:
1949                 case PendingScope:
1950                         /* Caller will report the error */
1951                         return NULL;
1952                 case CondScope:
1953                         /* All CondScope variables of this name need to be merged
1954                          * and become InScope
1955                          */
1956                         v->depth = v->min_depth;
1957                         v->scope = InScope;
1958                         for (v2 = v->previous;
1959                              v2 && v2->scope == CondScope;
1960                              v2 = v2->previous)
1961                                 variable_merge(v, v2);
1962                         break;
1963                 case InScope:
1964                         break;
1965                 }
1966                 return v;
1967         }
1968
1969         static int var_refile(struct parse_context *c, struct variable *v)
1970         {
1971                 /* Variable just went out of scope.  Add it to the out_scope
1972                  * list, sorted by ->scope_start
1973                  */
1974                 struct variable **vp = &c->out_scope;
1975                 while ((*vp) && (*vp)->scope_start < v->scope_start)
1976                         vp = &(*vp)->in_scope;
1977                 v->in_scope = *vp;
1978                 *vp = v;
1979                 return 0;
1980         }
1981
1982         static void var_block_close(struct parse_context *c, enum closetype ct,
1983                                     struct exec *e)
1984         {
1985                 /* Close off all variables that are in_scope.
1986                  * Some variables in c->scope may already be not-in-scope,
1987                  * such as when a PendingScope variable is hidden by a new
1988                  * variable with the same name.
1989                  * So we check for v->name->var != v and drop them.
1990                  * If we choose to make a variable OutScope, we drop it
1991                  * immediately too.
1992                  */
1993                 struct variable *v, **vp, *v2;
1994
1995                 scope_pop(c);
1996                 for (vp = &c->in_scope;
1997                      (v = *vp) && v->min_depth > c->scope_depth;
1998                      (v->scope == OutScope || v->name->var != v)
1999                      ? (*vp =  v->in_scope, var_refile(c, v))
2000                      : ( vp = &v->in_scope, 0)) {
2001                         v->min_depth = c->scope_depth;
2002                         if (v->name->var != v)
2003                                 /* This is still in scope, but we haven't just
2004                                  * closed the scope.
2005                                  */
2006                                 continue;
2007                         v->min_depth = c->scope_depth;
2008                         if (v->scope == InScope)
2009                                 v->scope_end = c->scope_count;
2010                         if (v->scope == InScope && e && !v->global) {
2011                                 /* This variable gets cleaned up when
2012                                  * 'e' finishes
2013                                  */
2014                                 variable_unlink_exec(v);
2015                                 v->cleanup_exec = e;
2016                                 v->next_free = e->to_free;
2017                                 e->to_free = v;
2018                         }
2019                         switch (ct) {
2020                         case CloseElse:
2021                         case CloseParallel: /* handle PendingScope */
2022                                 switch(v->scope) {
2023                                 case InScope:
2024                                 case CondScope:
2025                                         if (c->scope_stack->child_count == 1)
2026                                                 /* first among parallel branches */
2027                                                 v->scope = PendingScope;
2028                                         else if (v->previous &&
2029                                                  v->previous->scope == PendingScope)
2030                                                 /* all previous branches used name */
2031                                                 v->scope = PendingScope;
2032                                         else
2033                                                 v->scope = OutScope;
2034                                         if (ct == CloseElse) {
2035                                                 /* All Pending variables with
2036                                                  * this name are now Conditional
2037                                                  */
2038                                                 for (v2 = v;
2039                                                      v2 && v2->scope == PendingScope;
2040                                                      v2 = v2->previous)
2041                                                         v2->scope = CondScope;
2042                                         }
2043                                         break;
2044                                 case PendingScope:
2045                                         /* Not possible as it would require
2046                                          * parallel scope to be nested immediately
2047                                          * in a parallel scope, and that never
2048                                          * happens.
2049                                          */                     // NOTEST
2050                                 case OutScope:
2051                                         /* Not possible as we already tested for
2052                                          * OutScope
2053                                          */
2054                                         abort();                // NOTEST
2055                                 }
2056                                 break;
2057                         case CloseFunction:
2058                                 if (v->scope == CondScope)
2059                                         /* Condition cannot continue past end of
2060                                          * function */
2061                                         v->scope = InScope;
2062                                 /* fallthrough */
2063                         case CloseSequential:
2064                                 switch (v->scope) {
2065                                 case InScope:
2066                                         v->scope = OutScope;
2067                                         break;
2068                                 case PendingScope:
2069                                         /* There was no 'else', so we can only become
2070                                          * conditional if we know the cases were exhaustive,
2071                                          * and that doesn't mean anything yet.
2072                                          * So only labels become conditional..
2073                                          */
2074                                         for (v2 = v;
2075                                              v2 && v2->scope == PendingScope;
2076                                              v2 = v2->previous)
2077                                                 v2->scope = OutScope;
2078                                         break;
2079                                 case CondScope:
2080                                 case OutScope: break;
2081                                 }
2082                                 break;
2083                         }
2084                 }
2085         }
2086
2087 #### Storing Values
2088
2089 The value of a variable is stored separately from the variable, on an
2090 analogue of a stack frame.  There are (currently) two frames that can be
2091 active.  A global frame which currently only stores constants, and a
2092 stacked frame which stores local variables.  Each variable knows if it
2093 is global or not, and what its index into the frame is.
2094
2095 Values in the global frame are known immediately they are relevant, so
2096 the frame needs to be reallocated as it grows so it can store those
2097 values.  The local frame doesn't get values until the interpreted phase
2098 is started, so there is no need to allocate until the size is known.
2099
2100 We initialise the `frame_pos` to an impossible value, so that we can
2101 tell if it was set or not later.
2102
2103 ###### variable fields
2104         short frame_pos;
2105         short global;
2106
2107 ###### variable init
2108         v->frame_pos = -1;
2109
2110 ###### parse context
2111
2112         short global_size, global_alloc;
2113         short local_size;
2114         void *global, *local;
2115
2116 ###### forward decls
2117         static struct value *global_alloc(struct parse_context *c, struct type *t,
2118                                           struct variable *v, struct value *init);
2119
2120 ###### ast functions
2121
2122         static struct value *var_value(struct parse_context *c, struct variable *v)
2123         {
2124                 if (!v->global) {
2125                         if (!c->local || !v->type)
2126                                 return NULL;    // NOTEST
2127                         if (v->frame_pos + v->type->size > c->local_size) {
2128                                 printf("INVALID frame_pos\n");  // NOTEST
2129                                 exit(2);                        // NOTEST
2130                         }
2131                         return c->local + v->frame_pos;
2132                 }
2133                 if (c->global_size > c->global_alloc) {
2134                         int old = c->global_alloc;
2135                         c->global_alloc = (c->global_size | 1023) + 1024;
2136                         c->global = realloc(c->global, c->global_alloc);
2137                         memset(c->global + old, 0, c->global_alloc - old);
2138                 }
2139                 return c->global + v->frame_pos;
2140         }
2141
2142         static struct value *global_alloc(struct parse_context *c, struct type *t,
2143                                           struct variable *v, struct value *init)
2144         {
2145                 struct value *ret;
2146                 struct variable scratch;
2147
2148                 if (t->prepare_type)
2149                         t->prepare_type(c, t, 1);       // NOTEST
2150
2151                 if (c->global_size & (t->align - 1))
2152                         c->global_size = (c->global_size + t->align) & ~(t->align-1);
2153                 if (!v) {
2154                         v = &scratch;
2155                         v->type = t;
2156                 }
2157                 v->frame_pos = c->global_size;
2158                 v->global = 1;
2159                 c->global_size += v->type->size;
2160                 ret = var_value(c, v);
2161                 if (init)
2162                         memcpy(ret, init, t->size);
2163                 else
2164                         val_init(t, ret);       // NOTEST
2165                 return ret;
2166         }
2167
2168 As global values are found -- struct field initializers, labels etc --
2169 `global_alloc()` is called to record the value in the global frame.
2170
2171 When the program is fully parsed, each function is analysed, we need to
2172 walk the list of variables local to that function and assign them an
2173 offset in the stack frame.  For this we have `scope_finalize()`.
2174
2175 We keep the stack from dense by re-using space for between variables
2176 that are not in scope at the same time.  The `out_scope` list is sorted
2177 by `scope_start` and as we process a varible, we move it to an FIFO
2178 stack.  For each variable we consider, we first discard any from the
2179 stack anything that went out of scope before the new variable came in.
2180 Then we place the new variable just after the one at the top of the
2181 stack.
2182
2183 ###### ast functions
2184
2185         static void scope_finalize(struct parse_context *c, struct type *ft)
2186         {
2187                 int size = ft->function.local_size;
2188                 struct variable *next = ft->function.scope;
2189                 struct variable *done = NULL;
2190
2191                 while (next) {
2192                         struct variable *v = next;
2193                         struct type *t = v->type;
2194                         int pos;
2195                         next = v->in_scope;
2196                         if (v->merged != v)
2197                                 continue;
2198                         if (!t)
2199                                 continue;       // NOTEST
2200                         if (v->frame_pos >= 0)
2201                                 continue;
2202                         while (done && done->scope_end < v->scope_start)
2203                                 done = done->in_scope;
2204                         if (done)
2205                                 pos = done->frame_pos + done->type->size;
2206                         else
2207                                 pos = ft->function.local_size;
2208                         if (pos & (t->align - 1))
2209                                 pos = (pos + t->align) & ~(t->align-1);
2210                         v->frame_pos = pos;
2211                         if (size < pos + v->type->size)
2212                                 size = pos + v->type->size;
2213                         v->in_scope = done;
2214                         done = v;
2215                 }
2216                 c->out_scope = NULL;
2217                 ft->function.local_size = size;
2218         }
2219
2220 ###### free context storage
2221         free(context.global);
2222
2223 #### Variables as executables
2224
2225 Just as we used a `val` to wrap a value into an `exec`, we similarly
2226 need a `var` to wrap a `variable` into an exec.  While each `val`
2227 contained a copy of the value, each `var` holds a link to the variable
2228 because it really is the same variable no matter where it appears.
2229 When a variable is used, we need to remember to follow the `->merged`
2230 link to find the primary instance.
2231
2232 When a variable is declared, it may or may not be given an explicit
2233 type.  We need to record which so that we can report the parsed code
2234 correctly.
2235
2236 ###### exec type
2237         Xvar,
2238
2239 ###### ast
2240         struct var {
2241                 struct exec;
2242                 struct variable *var;
2243         };
2244
2245 ###### variable fields
2246         int explicit_type;
2247
2248 ###### Grammar
2249
2250         $TERM : ::
2251
2252         $*var
2253         VariableDecl -> IDENTIFIER : ${ {
2254                 struct variable *v = var_decl(c, $1.txt);
2255                 $0 = new_pos(var, $1);
2256                 $0->var = v;
2257                 if (v)
2258                         v->where_decl = $0;
2259                 else {
2260                         v = var_ref(c, $1.txt);
2261                         $0->var = v;
2262                         type_err(c, "error: variable '%v' redeclared",
2263                                  $0, NULL, 0, NULL);
2264                         type_err(c, "info: this is where '%v' was first declared",
2265                                  v->where_decl, NULL, 0, NULL);
2266                 }
2267         } }$
2268         | IDENTIFIER :: ${ {
2269                 struct variable *v = var_decl(c, $1.txt);
2270                 $0 = new_pos(var, $1);
2271                 $0->var = v;
2272                 if (v) {
2273                         v->where_decl = $0;
2274                         v->constant = 1;
2275                 } else {
2276                         v = var_ref(c, $1.txt);
2277                         $0->var = v;
2278                         type_err(c, "error: variable '%v' redeclared",
2279                                  $0, NULL, 0, NULL);
2280                         type_err(c, "info: this is where '%v' was first declared",
2281                                  v->where_decl, NULL, 0, NULL);
2282                 }
2283         } }$
2284         | IDENTIFIER : Type ${ {
2285                 struct variable *v = var_decl(c, $1.txt);
2286                 $0 = new_pos(var, $1);
2287                 $0->var = v;
2288                 if (v) {
2289                         v->where_decl = $0;
2290                         v->where_set = $0;
2291                         v->type = $<Type;
2292                         v->explicit_type = 1;
2293                 } else {
2294                         v = var_ref(c, $1.txt);
2295                         $0->var = v;
2296                         type_err(c, "error: variable '%v' redeclared",
2297                                  $0, NULL, 0, NULL);
2298                         type_err(c, "info: this is where '%v' was first declared",
2299                                  v->where_decl, NULL, 0, NULL);
2300                 }
2301         } }$
2302         | IDENTIFIER :: Type ${ {
2303                 struct variable *v = var_decl(c, $1.txt);
2304                 $0 = new_pos(var, $1);
2305                 $0->var = v;
2306                 if (v) {
2307                         v->where_decl = $0;
2308                         v->where_set = $0;
2309                         v->type = $<Type;
2310                         v->constant = 1;
2311                         v->explicit_type = 1;
2312                 } else {
2313                         v = var_ref(c, $1.txt);
2314                         $0->var = v;
2315                         type_err(c, "error: variable '%v' redeclared",
2316                                  $0, NULL, 0, NULL);
2317                         type_err(c, "info: this is where '%v' was first declared",
2318                                  v->where_decl, NULL, 0, NULL);
2319                 }
2320         } }$
2321
2322         $*exec
2323         Variable -> IDENTIFIER ${ {
2324                 struct variable *v = var_ref(c, $1.txt);
2325                 $0 = new_pos(var, $1);
2326                 if (v == NULL) {
2327                         /* This might be a global const or a label
2328                          * Allocate a var with impossible type Tnone,
2329                          * which will be adjusted when we find out what it is,
2330                          * or will trigger an error.
2331                          */
2332                         v = var_decl(c, $1.txt);
2333                         if (v) {
2334                                 v->type = Tnone;
2335                                 v->where_decl = $0;
2336                                 v->where_set = $0;
2337                         }
2338                 }
2339                 cast(var, $0)->var = v;
2340         } }$
2341
2342 ###### print exec cases
2343         case Xvar:
2344         {
2345                 struct var *v = cast(var, e);
2346                 if (v->var) {
2347                         struct binding *b = v->var->name;
2348                         printf("%.*s", b->name.len, b->name.txt);
2349                 }
2350                 break;
2351         }
2352
2353 ###### format cases
2354         case 'v':
2355                 if (loc && loc->type == Xvar) {
2356                         struct var *v = cast(var, loc);
2357                         if (v->var) {
2358                                 struct binding *b = v->var->name;
2359                                 fprintf(stderr, "%.*s", b->name.len, b->name.txt);
2360                         } else
2361                                 fputs("???", stderr);   // NOTEST
2362                 } else
2363                         fputs("NOTVAR", stderr);        // NOTEST
2364                 break;
2365
2366 ###### propagate exec cases
2367
2368         case Xvar:
2369         {
2370                 struct var *var = cast(var, prog);
2371                 struct variable *v = var->var;
2372                 if (!v) {
2373                         type_err(c, "%d:BUG: no variable!!", prog, NULL, 0, NULL); // NOTEST
2374                         return Tnone;                                   // NOTEST
2375                 }
2376                 v = v->merged;
2377                 if (v->type == Tnone && v->where_decl == prog)
2378                         type_err(c, "error: variable used but not declared: %v",
2379                                  prog, NULL, 0, NULL);
2380                 if (v->type == NULL) {
2381                         if (type && !(*perr & Efail)) {
2382                                 v->type = type;
2383                                 v->where_set = prog;
2384                                 *perr |= Eretry;
2385                         }
2386                 } else if (!type_compat(type, v->type, rules)) {
2387                         type_err(c, "error: expected %1 but variable '%v' is %2", prog,
2388                                  type, rules, v->type);
2389                         type_err(c, "info: this is where '%v' was set to %1", v->where_set,
2390                                  v->type, rules, NULL);
2391                 }
2392                 if (!v->global || v->frame_pos < 0)
2393                         *perr |= Eruntime;
2394                 if (v->constant)
2395                         *perr |= Econst;
2396                 return v->type;
2397         }
2398
2399 ###### interp exec cases
2400         case Xvar:
2401         {
2402                 struct var *var = cast(var, e);
2403                 struct variable *v = var->var;
2404
2405                 v = v->merged;
2406                 lrv = var_value(c, v);
2407                 rvtype = v->type;
2408                 break;
2409         }
2410
2411 ###### ast functions
2412
2413         static void free_var(struct var *v)
2414         {
2415                 free(v);
2416         }
2417
2418 ###### free exec cases
2419         case Xvar: free_var(cast(var, e)); break;
2420
2421 ### Complex types
2422
2423 Now that we have the shape of the interpreter in place we can add some
2424 complex types and connected them in to the data structures and the
2425 different phases of parse, analyse, print, interpret.
2426
2427 Being "complex" the language will naturally have syntax to access
2428 specifics of objects of these types.  These will fit into the grammar as
2429 "Terms" which are the things that are combined with various operators to
2430 form an "Expression".  Where a Term is formed by some operation on another
2431 Term, the subordinate Term will always come first, so for example a
2432 member of an array will be expressed as the Term for the array followed
2433 by an index in square brackets.  The strict rule of using postfix
2434 operations makes precedence irrelevant within terms.  To provide a place
2435 to put the grammar for terms of each type, we will start out by
2436 introducing the "Term" grammar production, with contains at least a
2437 simple "Value" (to be explained later).
2438
2439 We also take this opportunity to introduce the "ExpressionsList" which
2440 is a simple comma-separated list of expressions - it may be used in
2441 various places.
2442
2443 ###### declare terminals
2444         $TERM ,
2445
2446 ###### Grammar
2447         $*exec
2448         Term ->  Value ${ $0 = $<1; }$
2449         | Variable ${ $0 = $<1; }$
2450         ## term grammar
2451
2452         $*binode
2453         ExpressionList -> ExpressionList , Expression ${
2454                 $0 = new(binode);
2455                 $0->op = List;
2456                 $0->left = $<1;
2457                 $0->right = $<3;
2458         }$
2459         | Expression ${
2460                 $0 = new(binode);
2461                 $0->op = List;
2462                 $0->left = NULL;
2463                 $0->right = $<1;
2464         }$
2465
2466 Thus far the complex types we have are arrays, structs, functions and
2467 references.
2468
2469 #### Arrays
2470
2471 Arrays can be declared by giving a size and a type, as `[size]type' so
2472 `freq:[26]number` declares `freq` to be an array of 26 numbers.  The
2473 size can be either a literal number, or a named constant.  Some day an
2474 arbitrary expression will be supported.
2475
2476 As a formal parameter to a function, the array can be declared with
2477 unknown size `name:[]string`.  This is currently only supported for the
2478 "argv" parameter to "main" but will be extended more generally in a
2479 later version of the language.  The length of this array - or any array
2480 - can be found with the "[]" postfix operator.
2481
2482 Arrays cannot be assigned.  When reference are extend to allow array
2483 slices which can refer to part or all of an array the assignment
2484 syntax will create a slice.  For now, an array can only ever be
2485 referenced by the name it is declared with.  It is likely that a
2486 "`copy`" primitive will eventually be defined which can be used to make a
2487 copy of an array with controllable recursive depth.
2488
2489 For now we have two sorts of array, those with fixed size either because
2490 it is given as a literal number or because it is a struct member (which
2491 cannot have a runtime-changing size), and those with a size that is
2492 determined at runtime - local variables with a const size.  The former
2493 have their size calculated at parse time, the latter at run time.
2494
2495 For the latter type, the `size` field of the type is the size of a
2496 pointer, and the array is reallocated every time it comes into scope.
2497
2498 We differentiate struct fields with a const size from local variables
2499 with a const size by whether they are prepared at parse time or not.
2500
2501 ###### type union fields
2502
2503         struct {
2504                 int unspec;     // size is unspecified - vsize must be set.
2505                 short size;
2506                 short static_size;
2507                 struct variable *vsize;
2508                 struct type *member;
2509         } array;
2510
2511 ###### value union fields
2512         void *array;  // used if not static_size
2513
2514 ###### value functions
2515
2516         static int array_prepare_type(struct parse_context *c, struct type *type,
2517                                        int parse_time)
2518         {
2519                 struct value *vsize;
2520                 mpz_t q;
2521                 if (type->array.static_size)
2522                         return 1;       // NOTEST - guard against reentry
2523                 if (type->array.unspec && parse_time)
2524                         return 1;       // NOTEST - unspec is still incomplete
2525                 if (parse_time && type->array.vsize && !type->array.vsize->global)
2526                         return 1;       // NOTEST - should be impossible
2527
2528                 if (type->array.vsize) {
2529                         vsize = var_value(c, type->array.vsize);
2530                         if (!vsize)
2531                                 return 1;       // NOTEST - should be impossible
2532                         mpz_init(q);
2533                         mpz_tdiv_q(q, mpq_numref(vsize->num), mpq_denref(vsize->num));
2534                         type->array.size = mpz_get_si(q);
2535                         mpz_clear(q);
2536                 }
2537                 if (!parse_time)
2538                         return 1;
2539                 if (type->array.member->size <= 0)
2540                         return 0;       // NOTEST - error caught before here
2541
2542                 type->array.static_size = 1;
2543                 type->size = type->array.size * type->array.member->size;
2544                 type->align = type->array.member->align;
2545
2546                 return 1;
2547         }
2548
2549         static void array_init(struct type *type, struct value *val)
2550         {
2551                 int i;
2552                 void *ptr = val->ptr;
2553
2554                 if (!val)
2555                         return;                         // NOTEST
2556                 if (!type->array.static_size) {
2557                         val->array = calloc(type->array.size,
2558                                             type->array.member->size);
2559                         ptr = val->array;
2560                 }
2561                 for (i = 0; i < type->array.size; i++) {
2562                         struct value *v;
2563                         v = (void*)ptr + i * type->array.member->size;
2564                         val_init(type->array.member, v);
2565                 }
2566         }
2567
2568         static void array_free(struct type *type, struct value *val)
2569         {
2570                 int i;
2571                 void *ptr = val->ptr;
2572
2573                 if (!type->array.static_size)
2574                         ptr = val->array;
2575                 for (i = 0; i < type->array.size; i++) {
2576                         struct value *v;
2577                         v = (void*)ptr + i * type->array.member->size;
2578                         free_value(type->array.member, v);
2579                 }
2580                 if (!type->array.static_size)
2581                         free(ptr);
2582         }
2583
2584         static int array_compat(struct type *require, struct type *have,
2585                                 enum val_rules rules)
2586         {
2587                 if (have->compat != require->compat)
2588                         return 0;
2589                 /* Both are arrays, so we can look at details */
2590                 if (!type_compat(require->array.member, have->array.member, 0))
2591                         return 0;
2592                 if (have->array.unspec && require->array.unspec &&
2593                     have->array.size != require->array.size)
2594                         return 0;       // NOTEST
2595                 if (have->array.unspec || require->array.unspec)
2596                         return 1;
2597                 if (require->array.vsize == NULL && have->array.vsize == NULL)
2598                         return require->array.size == have->array.size;
2599
2600                 return require->array.vsize == have->array.vsize;
2601         }
2602
2603         static void array_print_type(struct type *type, FILE *f)
2604         {
2605                 fputs("[", f);
2606                 if (type->array.vsize) {
2607                         struct binding *b = type->array.vsize->name;
2608                         fprintf(f, "%.*s%s]", b->name.len, b->name.txt,
2609                                 type->array.unspec ? "::" : "");
2610                 } else if (type->array.size)
2611                         fprintf(f, "%d]", type->array.size);
2612                 else
2613                         fprintf(f, "]");
2614                 type_print(type->array.member, f);
2615         }
2616
2617         static struct type array_prototype = {
2618                 .init = array_init,
2619                 .prepare_type = array_prepare_type,
2620                 .print_type = array_print_type,
2621                 .compat = array_compat,
2622                 .free = array_free,
2623                 .size = sizeof(void*),
2624                 .align = sizeof(void*),
2625         };
2626
2627 ###### declare terminals
2628         $TERM [ ]
2629
2630 ###### type grammar
2631
2632         | [ NUMBER ] Type ${ {
2633                 char tail[3];
2634                 mpq_t num;
2635                 struct type *t;
2636                 int elements = 0;
2637
2638                 if (number_parse(num, tail, $2.txt) == 0)
2639                         tok_err(c, "error: unrecognised number", &$2);
2640                 else if (tail[0]) {
2641                         tok_err(c, "error: unsupported number suffix", &$2);
2642                         mpq_clear(num);
2643                 } else {
2644                         elements = mpz_get_ui(mpq_numref(num));
2645                         if (mpz_cmp_ui(mpq_denref(num), 1) != 0) {
2646                                 tok_err(c, "error: array size must be an integer",
2647                                         &$2);
2648                         } else if (mpz_cmp_ui(mpq_numref(num), 1UL << 30) >= 0)
2649                                 tok_err(c, "error: array size is too large",
2650                                         &$2);
2651                         mpq_clear(num);
2652                 }
2653
2654                 $0 = t = add_anon_type(c, &array_prototype, "array[%d]", elements );
2655                 t->array.size = elements;
2656                 t->array.member = $<4;
2657                 t->array.vsize = NULL;
2658         } }$
2659
2660         | [ IDENTIFIER ] Type ${ {
2661                 struct variable *v = var_ref(c, $2.txt);
2662
2663                 if (!v)
2664                         tok_err(c, "error: name undeclared", &$2);
2665                 else if (!v->constant)
2666                         tok_err(c, "error: array size must be a constant", &$2);
2667
2668                 $0 = add_anon_type(c, &array_prototype, "array[%.*s]", $2.txt.len, $2.txt.txt);
2669                 $0->array.member = $<4;
2670                 $0->array.size = 0;
2671                 $0->array.vsize = v;
2672         } }$
2673
2674 ###### formal type grammar
2675
2676         | [ ] Type ${ {
2677                 $0 = add_anon_type(c, &array_prototype, "array[]");
2678                 $0->array.member = $<Type;
2679                 $0->array.size = 0;
2680                 $0->array.unspec = 1;
2681                 $0->array.vsize = NULL;
2682         } }$
2683
2684 ###### Binode types
2685         Index, Length,
2686
2687 ###### term grammar
2688
2689         | Term [ Expression ] ${ {
2690                 struct binode *b = new(binode);
2691                 b->op = Index;
2692                 b->left = $<1;
2693                 b->right = $<3;
2694                 $0 = b;
2695         } }$
2696
2697         | Term [ ] ${ {
2698                 struct binode *b = new(binode);
2699                 b->op = Length;
2700                 b->left = $<Term;
2701                 $0 = b;
2702         } }$
2703
2704 ###### print binode cases
2705         case Index:
2706                 print_exec(b->left, -1, bracket);
2707                 printf("[");
2708                 print_exec(b->right, -1, bracket);
2709                 printf("]");
2710                 break;
2711
2712         case Length:
2713                 print_exec(b->left, -1, bracket);
2714                 printf("[]");
2715                 break;
2716
2717 ###### propagate binode cases
2718         case Index:
2719                 /* left must be an array, right must be a number,
2720                  * result is the member type of the array
2721                  */
2722                 propagate_types(b->right, c, perr_local, Tnum, 0);
2723                 t = propagate_types(b->left, c, perr, NULL, 0);
2724                 if (!t || t->compat != array_compat) {
2725                         type_err(c, "error: %1 cannot be indexed", prog, t, 0,
2726                                  NULL);
2727                         return NULL;
2728                 } else {
2729                         if (!type_compat(type, t->array.member, rules)) {
2730                                 type_err(c, "error: have %1 but need %2", prog,
2731                                          t->array.member, rules, type);
2732                         }
2733                         return t->array.member;
2734                 }
2735                 break;
2736
2737         case Length:
2738                 /* left must be an array, result is a number
2739                  */
2740                 t = propagate_types(b->left, c, perr, NULL, 0);
2741                 if (!t || t->compat != array_compat) {
2742                         type_err(c, "error: %1 cannot provide length", prog, t,
2743                                  0, NULL);
2744                         return NULL;
2745                 }
2746                 if (!type_compat(type, Tnum, rules))
2747                         type_err(c, "error: have %1 but need %2", prog,
2748                                          Tnum, rules, type);
2749                 return Tnum;
2750                 break;
2751
2752 ###### interp binode cases
2753         case Index: {
2754                 mpz_t q;
2755                 long i;
2756                 void *ptr;
2757
2758                 lleft = linterp_exec(c, b->left, &ltype);
2759                 right = interp_exec(c, b->right, &rtype);
2760                 mpz_init(q);
2761                 mpz_tdiv_q(q, mpq_numref(right.num), mpq_denref(right.num));
2762                 i = mpz_get_si(q);
2763                 mpz_clear(q);
2764
2765                 if (ltype->array.static_size)
2766                         ptr = lleft;
2767                 else
2768                         ptr = *(void**)lleft;
2769                 rvtype = ltype->array.member;
2770                 if (i >= 0 && i < ltype->array.size)
2771                         lrv = ptr + i * rvtype->size;
2772                 else
2773                         val_init(ltype->array.member, &rv); // UNSAFE
2774                 ltype = NULL;
2775                 break;
2776         }
2777         case Length: {
2778                 lleft = linterp_exec(c, b->left, &ltype);
2779                 mpq_set_ui(rv.num, ltype->array.size, 1);
2780                 ltype = NULL;
2781                 rvtype = Tnum;
2782                 break;
2783         }
2784
2785 #### Structs
2786
2787 A `struct` is a data-type that contains one or more other data-types.
2788 It differs from an array in that each member can be of a different
2789 type, and they are accessed by name rather than by number.  Thus you
2790 cannot choose an element by calculation, you need to know what you
2791 want up-front.
2792
2793 The language makes no promises about how a given structure will be
2794 stored in memory - it is free to rearrange fields to suit whatever
2795 criteria seems important.
2796
2797 Structs are declared separately from program code - they cannot be
2798 declared in-line in a variable declaration like arrays can.  A struct
2799 is given a name and this name is used to identify the type - the name
2800 is not prefixed by the word `struct` as it would be in C.
2801
2802 Structs are only treated as the same if they have the same name.
2803 Simply having the same fields in the same order is not enough.  This
2804 might change once we can create structure initializers from a list of
2805 values.
2806
2807 Each component datum is identified much like a variable is declared,
2808 with a name, one or two colons, and a type.  The type cannot be omitted
2809 as there is no opportunity to deduce the type from usage.  An initial
2810 value can be given following an equals sign, so
2811
2812 ##### Example: a struct type
2813
2814         struct complex:
2815                 x:number = 0
2816                 y:number = 0
2817
2818 would declare a type called "complex" which has two number fields,
2819 each initialised to zero.
2820
2821 Struct will need to be declared separately from the code that uses
2822 them, so we will need to be able to print out the declaration of a
2823 struct when reprinting the whole program.  So a `print_type_decl` type
2824 function will be needed.
2825
2826 ###### type union fields
2827
2828         struct {
2829                 int nfields;
2830                 struct field {
2831                         struct text name;
2832                         struct type *type;
2833                         struct value *init;
2834                         int offset;
2835                 } *fields; // This is created when field_list is analysed.
2836                 struct fieldlist {
2837                         struct fieldlist *prev;
2838                         struct field f;
2839                         struct exec *init;
2840                 } *field_list; // This is created during parsing
2841         } structure;
2842
2843 ###### type functions
2844         void (*print_type_decl)(struct type *type, FILE *f);
2845         struct type *(*fieldref)(struct type *t, struct parse_context *c,
2846                                  struct fieldref *f, struct value **vp);
2847
2848 ###### value functions
2849
2850         static void structure_init(struct type *type, struct value *val)
2851         {
2852                 int i;
2853
2854                 for (i = 0; i < type->structure.nfields; i++) {
2855                         struct value *v;
2856                         v = (void*) val->ptr + type->structure.fields[i].offset;
2857                         if (type->structure.fields[i].init)
2858                                 dup_value(type->structure.fields[i].type,
2859                                           type->structure.fields[i].init,
2860                                           v);
2861                         else
2862                                 val_init(type->structure.fields[i].type, v);
2863                 }
2864         }
2865
2866         static void structure_free(struct type *type, struct value *val)
2867         {
2868                 int i;
2869
2870                 for (i = 0; i < type->structure.nfields; i++) {
2871                         struct value *v;
2872                         v = (void*)val->ptr + type->structure.fields[i].offset;
2873                         free_value(type->structure.fields[i].type, v);
2874                 }
2875         }
2876
2877         static void free_fieldlist(struct fieldlist *f)
2878         {
2879                 if (!f)
2880                         return;
2881                 free_fieldlist(f->prev);
2882                 free_exec(f->init);
2883                 free(f);
2884         }
2885
2886         static void structure_free_type(struct type *t)
2887         {
2888                 int i;
2889                 for (i = 0; i < t->structure.nfields; i++)
2890                         if (t->structure.fields[i].init) {
2891                                 free_value(t->structure.fields[i].type,
2892                                            t->structure.fields[i].init);
2893                         }
2894                 free(t->structure.fields);
2895                 free_fieldlist(t->structure.field_list);
2896         }
2897
2898         static int structure_prepare_type(struct parse_context *c,
2899                                           struct type *t, int parse_time)
2900         {
2901                 int cnt = 0;
2902                 struct fieldlist *f;
2903
2904                 if (!parse_time || t->structure.fields)
2905                         return 1;
2906
2907                 for (f = t->structure.field_list; f; f=f->prev) {
2908                         enum prop_err perr;
2909                         cnt += 1;
2910
2911                         if (f->f.type->size <= 0)
2912                                 return 0;
2913                         if (f->f.type->prepare_type)
2914                                 f->f.type->prepare_type(c, f->f.type, parse_time);
2915
2916                         if (f->init == NULL)
2917                                 continue;
2918                         do {
2919                                 perr = 0;
2920                                 propagate_types(f->init, c, &perr, f->f.type, 0);
2921                         } while (perr & Eretry);
2922                         if (perr & Efail)
2923                                 c->parse_error += 1;    // NOTEST
2924                 }
2925
2926                 t->structure.nfields = cnt;
2927                 t->structure.fields = calloc(cnt, sizeof(struct field));
2928                 f = t->structure.field_list;
2929                 while (cnt > 0) {
2930                         int a = f->f.type->align;
2931                         cnt -= 1;
2932                         t->structure.fields[cnt] = f->f;
2933                         if (t->size & (a-1))
2934                                 t->size = (t->size | (a-1)) + 1;
2935                         t->structure.fields[cnt].offset = t->size;
2936                         t->size += ((f->f.type->size - 1) | (a-1)) + 1;
2937                         if (a > t->align)
2938                                 t->align = a;
2939
2940                         if (f->init && !c->parse_error) {
2941                                 struct value vl = interp_exec(c, f->init, NULL);
2942                                 t->structure.fields[cnt].init =
2943                                         global_alloc(c, f->f.type, NULL, &vl);
2944                         }
2945
2946                         f = f->prev;
2947                 }
2948                 return 1;
2949         }
2950
2951         static int find_struct_index(struct type *type, struct text field)
2952         {
2953                 int i;
2954                 for (i = 0; i < type->structure.nfields; i++)
2955                         if (text_cmp(type->structure.fields[i].name, field) == 0)
2956                                 return i;
2957                 return IndexInvalid;
2958         }
2959
2960         static struct type *structure_fieldref(struct type *t, struct parse_context *c,
2961                                                struct fieldref *f, struct value **vp)
2962         {
2963                 if (f->index == IndexUnknown) {
2964                         f->index = find_struct_index(t, f->name);
2965                         if (f->index < 0)
2966                                 type_err(c, "error: cannot find requested field in %1",
2967                                          f->left, t, 0, NULL);
2968                 }
2969                 if (f->index < 0)
2970                         return NULL;
2971                 if (vp) {
2972                         struct value *v = *vp;
2973                         v = (void*)v->ptr + t->structure.fields[f->index].offset;
2974                         *vp = v;
2975                 }
2976                 return t->structure.fields[f->index].type;
2977         }
2978
2979         static struct type structure_prototype = {
2980                 .init = structure_init,
2981                 .free = structure_free,
2982                 .free_type = structure_free_type,
2983                 .print_type_decl = structure_print_type,
2984                 .prepare_type = structure_prepare_type,
2985                 .fieldref = structure_fieldref,
2986         };
2987
2988 ###### exec type
2989         Xfieldref,
2990
2991 ###### ast
2992         struct fieldref {
2993                 struct exec;
2994                 struct exec *left;
2995                 int index;
2996                 struct text name;
2997         };
2998         enum { IndexUnknown = -1, IndexInvalid = -2 };
2999
3000 ###### free exec cases
3001         case Xfieldref:
3002                 free_exec(cast(fieldref, e)->left);
3003                 free(e);
3004                 break;
3005
3006 ###### declare terminals
3007         $TERM struct
3008
3009 ###### term grammar
3010
3011         | Term . IDENTIFIER ${ {
3012                 struct fieldref *fr = new_pos(fieldref, $2);
3013                 fr->left = $<1;
3014                 fr->name = $3.txt;
3015                 fr->index = IndexUnknown;
3016                 $0 = fr;
3017         } }$
3018
3019 ###### print exec cases
3020
3021         case Xfieldref:
3022         {
3023                 struct fieldref *f = cast(fieldref, e);
3024                 print_exec(f->left, -1, bracket);
3025                 printf(".%.*s", f->name.len, f->name.txt);
3026                 break;
3027         }
3028
3029 ###### propagate exec cases
3030
3031         case Xfieldref:
3032         {
3033                 struct fieldref *f = cast(fieldref, prog);
3034                 struct type *st = propagate_types(f->left, c, perr, NULL, 0);
3035
3036                 if (!st || !st->fieldref)
3037                         type_err(c, "error: field reference on %1 is not supported",
3038                                  f->left, st, 0, NULL);
3039                 else {
3040                         t = st->fieldref(st, c, f, NULL);
3041                         if (t && !type_compat(type, t, rules))
3042                                 type_err(c, "error: have %1 but need %2", prog,
3043                                          t, rules, type);
3044                         return t;
3045                 }
3046                 break;
3047         }
3048
3049 ###### interp exec cases
3050         case Xfieldref:
3051         {
3052                 struct fieldref *f = cast(fieldref, e);
3053                 struct type *ltype;
3054                 struct value *lleft = linterp_exec(c, f->left, &ltype);
3055                 lrv = lleft;
3056                 rvtype = ltype->fieldref(ltype, c, f, &lrv);
3057                 break;
3058         }
3059
3060 ###### top level grammar
3061         $*type
3062         StructName -> IDENTIFIER ${ {
3063                 struct type *t = find_type(c, $ID.txt);
3064
3065                 if (t && t->size >= 0) {
3066                         tok_err(c, "error: type already declared", &$ID);
3067                         tok_err(c, "info: this is location of declaration",
3068                                 &t->first_use);
3069                         t = NULL;
3070                 }
3071                 if (!t)
3072                         t = add_type(c, $ID.txt, NULL);
3073                 t->first_use = $ID;
3074                 $0 = t;
3075         } }$
3076         $void
3077         DeclareStruct -> struct StructName FieldBlock Newlines ${ {
3078                 struct type *t = $<SN;
3079                 struct type tmp = *t;
3080
3081                 *t = structure_prototype;
3082                 t->name = tmp.name;
3083                 t->next = tmp.next;
3084                 t->first_use = tmp.first_use;
3085
3086                 t->structure.field_list = $<FB;
3087         } }$
3088
3089         $*fieldlist
3090         FieldBlock -> { IN OptNL FieldLines OUT OptNL } ${ $0 = $<FL; }$
3091         | { SimpleFieldList } ${ $0 = $<SFL; }$
3092         | IN OptNL FieldLines OUT ${ $0 = $<FL; }$
3093         | SimpleFieldList EOL ${ $0 = $<SFL; }$
3094
3095         FieldLines -> SimpleFieldList Newlines ${ $0 = $<SFL; }$
3096         | FieldLines SimpleFieldList Newlines ${ {
3097                 struct fieldlist *f = $<SFL;
3098
3099                 if (f) {
3100                         $0 = f;
3101                         while (f->prev)
3102                                 f = f->prev;
3103                         f->prev = $<FL;
3104                 } else
3105                         $0 = $<FL;
3106         } }$
3107
3108         SimpleFieldList -> Field ${ $0 = $<F; }$
3109         | SimpleFieldList ; Field ${
3110                 $F->prev = $<SFL;
3111                 $0 = $<F;
3112         }$
3113         | SimpleFieldList ; ${
3114                 $0 = $<SFL;
3115         }$
3116         | ERROR ${ tok_err(c, "Syntax error in struct field", &$1); }$
3117
3118         Field -> IDENTIFIER : Type = Expression ${ {
3119                 $0 = calloc(1, sizeof(struct fieldlist));
3120                 $0->f.name = $ID.txt;
3121                 $0->f.type = $<Type;
3122                 $0->f.init = NULL;
3123                 $0->init = $<Expr;
3124         } }$
3125         | IDENTIFIER : Type ${
3126                 $0 = calloc(1, sizeof(struct fieldlist));
3127                 $0->f.name = $ID.txt;
3128                 $0->f.type = $<Type;
3129         }$
3130
3131 ###### forward decls
3132         static void structure_print_type(struct type *t, FILE *f);
3133
3134 ###### value functions
3135         static void structure_print_type(struct type *t, FILE *f)
3136         {
3137                 int i;
3138
3139                 fprintf(f, "struct %.*s\n", t->name.len, t->name.txt);
3140
3141                 for (i = 0; i < t->structure.nfields; i++) {
3142                         struct field *fl = t->structure.fields + i;
3143                         fprintf(f, "    %.*s : ", fl->name.len, fl->name.txt);
3144                         type_print(fl->type, f);
3145                         if (fl->type->print && fl->init) {
3146                                 fprintf(f, " = ");
3147                                 if (fl->type == Tstr)
3148                                         fprintf(f, "\"");
3149                                 print_value(fl->type, fl->init, f);
3150                                 if (fl->type == Tstr)
3151                                         fprintf(f, "\"");
3152                         }
3153                         fprintf(f, "\n");
3154                 }
3155         }
3156
3157 ###### print type decls
3158         {
3159                 struct type *t;
3160                 int target = -1;
3161
3162                 while (target != 0) {
3163                         int i = 0;
3164                         for (t = context.typelist; t ; t=t->next)
3165                                 if (!t->anon && t->print_type_decl &&
3166                                     !t->check_args) {
3167                                         i += 1;
3168                                         if (i == target)
3169                                                 break;
3170                                 }
3171
3172                         if (target == -1) {
3173                                 target = i;
3174                         } else {
3175                                 t->print_type_decl(t, stdout);
3176                                 target -= 1;
3177                         }
3178                 }
3179         }
3180
3181 #### References
3182
3183 References, or pointers, are values that refer to another value.  They
3184 can only refer to a type that is named, which excludes arrays or other
3185 references.  As these can be included in a struct which is named, it is
3186 still possible to reference an array or reference - though indirectly.
3187
3188 References are potentially dangerous as they might refer to some
3189 variable which no longer exists - either because a stack frame
3190 containing it has been discarded or because the value was allocated on
3191 the heap and has now been free.  Ocean does not yet provide any
3192 protection against these problems.  It will in due course.
3193
3194 With references comes the opportunity and the need to explicitly
3195 allocate values on the "heap" and to free them.  We currently provide
3196 fairly basic support for this.
3197
3198 Reference make use of the `@` symbol in various ways.  A type that starts
3199 with `@` is a reference to whatever follows.  A reference value
3200 followed by an `@` acts as the referred value, though the `@` is often
3201 not needed.  Finally, an expression that starts with `@` is a special
3202 reference related expression.  Some examples might help.
3203
3204 ##### Example: Reference examples
3205
3206         struct foo
3207                 a: number
3208                 b: string
3209         ref: @foo
3210         bar: foo
3211         bar.number = 23; bar.string = "hello"
3212         baz: foo
3213         ref = bar
3214         baz = @ref
3215         baz.a = ref.a * 2
3216
3217         ref = @new()
3218         ref@ = baz
3219         @free = ref
3220         ref = @nil
3221
3222 Obviously this is very contrived.  `ref` is a reference to a `foo` which
3223 is initially set to refer to the value stored in `bar` - no extra syntax
3224 is needed to "Take the address of" `bar` - the fact that `ref` is a
3225 reference means that only the address make sense.
3226
3227 When `ref.a` is accessed, that is whatever value is stored in `bar.a`.
3228 The same syntax is used for accessing fields both in structs and in
3229 references to structs.  It would be correct to use `ref@.a`, but not
3230 necessary.
3231
3232 `@new()` creates an object of whatever type is needed for the program to
3233 by type-correct.  In future iterations of Ocean, a constructor will
3234 access arguments, so the the syntax now looks like a function call.
3235 `@free` can be assigned any reference that was returned by `@new()`, and
3236 it will be freed.  `@nil` is a value of whatever reference type is
3237 appropriate, and is stable and never the address of anything in the heap
3238 or on the stack.  A reference can be assigned `nil` or compared against
3239 that value.
3240
3241 ###### declare terminals
3242         $TERM @
3243
3244 ###### type union fields
3245
3246         struct {
3247                 struct type *referent;
3248         } reference;
3249
3250 ###### value union fields
3251         struct value *ref;
3252
3253 ###### value functions
3254
3255         static void reference_print_type(struct type *t, FILE *f)
3256         {
3257                 fprintf(f, "@");
3258                 type_print(t->reference.referent, f);
3259         }
3260
3261         static int reference_cmp(struct type *tl, struct type *tr,
3262                                  struct value *left, struct value *right)
3263         {
3264                 return left->ref == right->ref ? 0 : 1;
3265         }
3266
3267         static void reference_dup(struct type *t,
3268                                   struct value *vold, struct value *vnew)
3269         {
3270                 vnew->ref = vold->ref;
3271         }
3272
3273         static void reference_free(struct type *t, struct value *v)
3274         {
3275                 /* Nothing to do here */
3276         }
3277
3278         static int reference_compat(struct type *require, struct type *have,
3279                                     enum val_rules rules)
3280         {
3281                 if (rules & Rrefok)
3282                         if (require->reference.referent == have)
3283                                 return 1;
3284                 if (have->compat != require->compat)
3285                         return 0;
3286                 if (have->reference.referent != require->reference.referent)
3287                         return 0;
3288                 return 1;
3289         }
3290
3291         static int reference_test(struct type *type, struct value *val)
3292         {
3293                 return val->ref != NULL;
3294         }
3295
3296         static struct type *reference_fieldref(
3297                 struct type *t, struct parse_context *c, struct fieldref *f,
3298                 struct value **vp)
3299         {
3300                 struct type *rt = t->reference.referent;
3301
3302                 if (rt->fieldref) {
3303                         if (vp)
3304                                 *vp = (*vp)->ref;
3305                         return rt->fieldref(rt, c, f, vp);
3306                 }
3307                 type_err(c, "error: field reference on %1 is not supported",
3308                                  f->left, rt, 0, NULL);
3309                 return Tnone;
3310         }
3311
3312         static struct type reference_prototype = {
3313                 .print_type = reference_print_type,
3314                 .cmp_eq = reference_cmp,
3315                 .dup = reference_dup,
3316                 .test = reference_test,
3317                 .free = reference_free,
3318                 .compat = reference_compat,
3319                 .fieldref = reference_fieldref,
3320                 .size = sizeof(void*),
3321                 .align = sizeof(void*),
3322         };
3323
3324 ###### type grammar
3325
3326         | @ IDENTIFIER ${ {
3327                 struct type *t = find_type(c, $ID.txt);
3328                 if (!t) {
3329                         t = add_type(c, $ID.txt, NULL);
3330                         t->first_use = $ID;
3331                 }
3332                 $0 = find_anon_type(c, &reference_prototype, "@%.*s",
3333                                     $ID.txt.len, $ID.txt.txt);
3334                 $0->reference.referent = t;
3335         } }$
3336
3337 ###### core functions
3338         static int text_is(struct text t, char *s)
3339         {
3340                 return (strlen(s) == t.len &&
3341                         strncmp(s, t.txt, t.len) == 0);
3342         }
3343
3344 ###### exec type
3345         Xref,
3346
3347 ###### ast
3348         struct ref {
3349                 struct exec;
3350                 enum ref_func { RefNew, RefFree, RefNil } action;
3351                 struct type *reftype;
3352                 struct exec *right;
3353         };
3354
3355 ###### SimpleStatement Grammar
3356
3357         | @ IDENTIFIER = Expression ${ {
3358                 struct ref *r = new_pos(ref, $ID);
3359                 // Must be "free"
3360                 if (!text_is($ID.txt, "free"))
3361                         tok_err(c, "error: only \"@free\" makes sense here",
3362                                 &$ID);
3363
3364                 $0 = r;
3365                 r->action = RefFree;
3366                 r->right = $<Exp;
3367         } }$
3368
3369 ###### expression grammar
3370         | @ IDENTIFIER ( ) ${
3371                 // Only 'new' valid here
3372                 if (!text_is($ID.txt, "new")) {
3373                         tok_err(c, "error: Only reference function is \"@new()\"",
3374                                 &$ID);
3375                 } else {
3376                         struct ref *r = new_pos(ref,$ID);
3377                         $0 = r;
3378                         r->action = RefNew;
3379                 }
3380         }$
3381         | @ IDENTIFIER ${
3382                 // Only 'nil' valid here
3383                 if (!text_is($ID.txt, "nil")) {
3384                         tok_err(c, "error: Only reference value is \"@nil\"",
3385                                 &$ID);
3386                 } else {
3387                         struct ref *r = new_pos(ref,$ID);
3388                         $0 = r;
3389                         r->action = RefNil;
3390                 }
3391         }$
3392
3393 ###### print exec cases
3394         case Xref: {
3395                 struct ref *r = cast(ref, e);
3396                 switch (r->action) {
3397                 case RefNew:
3398                         printf("@new()"); break;
3399                 case RefNil:
3400                         printf("@nil"); break;
3401                 case RefFree:
3402                         do_indent(indent, "@free = ");
3403                         print_exec(r->right, indent, bracket);
3404                         break;
3405                 }
3406                 break;
3407         }
3408
3409 ###### propagate exec cases
3410         case Xref: {
3411                 struct ref *r = cast(ref, prog);
3412                 switch (r->action) {
3413                 case RefNew:
3414                         if (type && type->free != reference_free) {
3415                                 type_err(c, "error: @new() can only be used with references, not %1",
3416                                          prog, type, 0, NULL);
3417                                 return NULL;
3418                         }
3419                         if (type && !r->reftype) {
3420                                 r->reftype = type;
3421                                 *perr |= Eretry;
3422                         }
3423                         *perr |= Erval;
3424                         return type;
3425                 case RefNil:
3426                         if (type && type->free != reference_free)
3427                                 type_err(c, "error: @nil can only be used with reference, not %1",
3428                                          prog, type, 0, NULL);
3429                         if (type && !r->reftype) {
3430                                 r->reftype = type;
3431                                 *perr |= Eretry;
3432                         }
3433                         *perr |= Erval;
3434                         return type;
3435                 case RefFree:
3436                         t = propagate_types(r->right, c, perr_local, NULL, 0);
3437                         if (t && t->free != reference_free)
3438                                 type_err(c, "error: @free can only be assigned a reference, not %1",
3439                                          prog, t, 0, NULL);
3440                         r->reftype = Tnone;
3441                         return Tnone;
3442                 }
3443                 break;  // NOTEST
3444         }
3445
3446 ###### interp exec cases
3447         case Xref: {
3448                 struct ref *r = cast(ref, e);
3449                 switch (r->action) {
3450                 case RefNew:
3451                         if (r->reftype)
3452                                 rv.ref = calloc(1, r->reftype->reference.referent->size);
3453                         rvtype = r->reftype;
3454                         break;
3455                 case RefNil:
3456                         rv.ref = NULL;
3457                         rvtype = r->reftype;
3458                         break;
3459                 case RefFree:
3460                         rv = interp_exec(c, r->right, &rvtype);
3461                         free_value(rvtype->reference.referent, rv.ref);
3462                         free(rv.ref);
3463                         rvtype = Tnone;
3464                         break;
3465                 }
3466                 break;
3467         }
3468
3469 ###### free exec cases
3470         case Xref: {
3471                 struct ref *r = cast(ref, e);
3472                 free_exec(r->right);
3473                 free(r);
3474                 break;
3475         }
3476
3477 ###### Expressions: dereference
3478
3479 ###### Binode types
3480         Deref, AddressOf,
3481
3482 ###### term grammar
3483
3484         | Term @ ${ {
3485                 struct binode *b = new(binode);
3486                 b->op = Deref;
3487                 b->left = $<Trm;
3488                 $0 = b;
3489         } }$
3490
3491 ###### print binode cases
3492         case Deref:
3493                 print_exec(b->left, -1, bracket);
3494                 printf("@");
3495                 break;
3496         case AddressOf:
3497                 print_exec(b->left, -1, bracket);
3498                 break;
3499
3500 ###### propagate binode cases
3501         case Deref:
3502                 /* left must be a reference, and we return what it refers to */
3503                 /* FIXME how can I pass the expected type down? */
3504                 t = propagate_types(b->left, c, perr, NULL, 0);
3505                 *perr &= ~Erval;
3506                 if (!t || t->free != reference_free)
3507                         type_err(c, "error: Cannot dereference %1", b, t, 0, NULL);
3508                 else
3509                         return t->reference.referent;
3510                 break;
3511
3512         case AddressOf:
3513                 /* left must be lval, we create reference to it */
3514                 if (!type || type->free != reference_free)
3515                         t = propagate_types(b->left, c, perr, type, 0); // NOTEST impossible
3516                 else
3517                         t = propagate_types(b->left, c, perr,
3518                                             type->reference.referent, 0);
3519                 if (t)
3520                         t = find_anon_type(c, &reference_prototype, "@%.*s",
3521                                         t->name.len, t->name.txt);
3522                 return t;
3523
3524 ###### interp binode cases
3525         case Deref:
3526                 left = interp_exec(c, b->left, &ltype);
3527                 lrv = left.ref;
3528                 rvtype = ltype->reference.referent;
3529                 break;
3530
3531         case AddressOf:
3532                 rv.ref = linterp_exec(c, b->left, &rvtype);
3533                 rvtype = find_anon_type(c, &reference_prototype, "@%.*s",
3534                                         rvtype->name.len, rvtype->name.txt);
3535                 break;
3536
3537 #### Functions
3538
3539 A function is a chunk of code which can be passed parameters and can
3540 return results.  Each function has a type which includes the set of
3541 parameters and the return value.  As yet these types cannot be declared
3542 separately from the function itself.
3543
3544 The parameters can be specified either in parentheses as a ';' separated
3545 list, such as
3546
3547 ##### Example: function 1
3548
3549         func main(av:[]string; env:[]string)
3550                 code block
3551
3552 or as an indented list of one parameter per line (though each line can
3553 be a ';' separated list)
3554
3555 ##### Example: function 2
3556
3557         func main
3558                 argv:[]string
3559                 env:[]string
3560         do
3561                 code block
3562
3563 In the first case a return type can follow the parentheses after a colon,
3564 in the second it is given on a line starting with the word `return`.
3565
3566 ##### Example: functions that return
3567
3568         func add(a:number; b:number): number
3569                 code block
3570
3571         func catenate
3572                 a: string
3573                 b: string
3574         return string
3575         do
3576                 code block
3577
3578 Rather than returning a type, the function can specify a set of local
3579 variables to return as a struct.  The values of these variables when the
3580 function exits will be provided to the caller.  For this the return type
3581 is replaced with a block of result declarations, either in parentheses
3582 or bracketed by `return` and `do`.
3583
3584 ##### Example: functions returning multiple variables
3585
3586         func to_cartesian(rho:number; theta:number):(x:number; y:number)
3587                 x = .....
3588                 y = .....
3589
3590         func to_polar
3591                 x:number; y:number
3592         return
3593                 rho:number
3594                 theta:number
3595         do
3596                 rho = ....
3597                 theta = ....
3598
3599 For constructing the lists we use a `List` binode, which will be
3600 further detailed when Expression Lists are introduced.
3601
3602 ###### type union fields
3603
3604         struct {
3605                 struct binode *params;
3606                 struct type *return_type;
3607                 struct variable *scope;
3608                 int inline_result;      // return value is at start of 'local'
3609                 int local_size;
3610         } function;
3611
3612 ###### value union fields
3613         struct exec *function;
3614
3615 ###### type functions
3616         void (*check_args)(struct parse_context *c, enum prop_err *perr,
3617                            struct type *require, struct exec *args);
3618
3619 ###### value functions
3620
3621         static void function_free(struct type *type, struct value *val)
3622         {
3623                 free_exec(val->function);
3624                 val->function = NULL;
3625         }
3626
3627         static int function_compat(struct type *require, struct type *have,
3628                                    enum val_rules rules)
3629         {
3630                 // FIXME can I do anything here yet?
3631                 return 0;
3632         }
3633
3634         static struct exec *take_addr(struct exec *e)
3635         {
3636                 struct binode *rv = new(binode);
3637                 rv->op = AddressOf;
3638                 rv->left = e;
3639                 return rv;
3640         }
3641
3642         static void function_check_args(struct parse_context *c, enum prop_err *perr,
3643                                         struct type *require, struct exec *args)
3644         {
3645                 /* This should be 'compat', but we don't have a 'tuple' type to
3646                  * hold the type of 'args'
3647                  */
3648                 struct binode *arg = cast(binode, args);
3649                 struct binode *param = require->function.params;
3650
3651                 while (param) {
3652                         struct var *pv = cast(var, param->left);
3653                         struct type *t = pv->var->type, *t2;
3654                         if (!arg) {
3655                                 type_err(c, "error: insufficient arguments to function.",
3656                                          args, NULL, 0, NULL);
3657                                 break;
3658                         }
3659                         *perr = 0;
3660                         t2 = propagate_types(arg->left, c, perr, t, Rrefok);
3661                         if (t->free == reference_free &&
3662                             t->reference.referent == t2 &&
3663                             !(*perr & Erval)) {
3664                                 arg->left = take_addr(arg->left);
3665                         } else if (!(*perr & Efail) && !type_compat(t2, t, 0)) {
3666                                 type_err(c, "error: cannot pass rval when reference expected",
3667                                          arg->left, NULL, 0, NULL);
3668                         }
3669                         param = cast(binode, param->right);
3670                         arg = cast(binode, arg->right);
3671                 }
3672                 if (arg)
3673                         type_err(c, "error: too many arguments to function.",
3674                                  args, NULL, 0, NULL);
3675         }
3676
3677         static void function_print(struct type *type, struct value *val, FILE *f)
3678         {
3679                 fprintf(f, "\n");
3680                 print_exec(val->function, 1, 0);
3681         }
3682
3683         static void function_print_type_decl(struct type *type, FILE *f)
3684         {
3685                 struct binode *b;
3686                 fprintf(f, "(");
3687                 for (b = type->function.params; b; b = cast(binode, b->right)) {
3688                         struct variable *v = cast(var, b->left)->var;
3689                         fprintf(f, "%.*s%s", v->name->name.len, v->name->name.txt,
3690                                 v->constant ? "::" : ":");
3691                         type_print(v->type, f);
3692                         if (b->right)
3693                                 fprintf(f, "; ");
3694                 }
3695                 fprintf(f, ")");
3696                 if (type->function.return_type != Tnone) {
3697                         fprintf(f, ":");
3698                         if (type->function.inline_result) {
3699                                 int i;
3700                                 struct type *t = type->function.return_type;
3701                                 fprintf(f, " (");
3702                                 for (i = 0; i < t->structure.nfields; i++) {
3703                                         struct field *fl = t->structure.fields + i;
3704                                         if (i)
3705                                                 fprintf(f, "; ");
3706                                         fprintf(f, "%.*s:", fl->name.len, fl->name.txt);
3707                                         type_print(fl->type, f);
3708                                 }
3709                                 fprintf(f, ")");
3710                         } else
3711                                 type_print(type->function.return_type, f);
3712                 }
3713         }
3714
3715         static void function_free_type(struct type *t)
3716         {
3717                 free_exec(t->function.params);
3718         }
3719
3720         static struct type function_prototype = {
3721                 .size = sizeof(void*),
3722                 .align = sizeof(void*),
3723                 .free = function_free,
3724                 .compat = function_compat,
3725                 .check_args = function_check_args,
3726                 .print = function_print,
3727                 .print_type_decl = function_print_type_decl,
3728                 .free_type = function_free_type,
3729         };
3730
3731 ###### declare terminals
3732
3733         $TERM func
3734
3735 ###### Grammar
3736
3737         $*variable
3738         FuncName -> IDENTIFIER ${ {
3739                 struct variable *v = var_decl(c, $1.txt);
3740                 struct var *e = new_pos(var, $1);
3741                 e->var = v;
3742                 if (v) {
3743                         v->where_decl = e;
3744                         v->where_set = e;
3745                         $0 = v;
3746                 } else {
3747                         v = var_ref(c, $1.txt);
3748                         e->var = v;
3749                         type_err(c, "error: function '%v' redeclared",
3750                                 e, NULL, 0, NULL);
3751                         type_err(c, "info: this is where '%v' was first declared",
3752                                 v->where_decl, NULL, 0, NULL);
3753                         free_exec(e);
3754                 }
3755         } }$
3756
3757         $*binode
3758         Args -> ArgsLine NEWLINE ${ $0 = $<AL; }$
3759         | Args ArgsLine NEWLINE ${ {
3760                 struct binode *b = $<AL;
3761                 struct binode **bp = &b;
3762                 while (*bp)
3763                         bp = (struct binode **)&(*bp)->left;
3764                 *bp = $<A;
3765                 $0 = b;
3766         } }$
3767
3768         ArgsLine -> ${ $0 = NULL; }$
3769         | Varlist ${ $0 = $<1; }$
3770         | Varlist ; ${ $0 = $<1; }$
3771
3772         Varlist -> Varlist ; ArgDecl ${
3773                 $0 = new_pos(binode, $2);
3774                 $0->op = List;
3775                 $0->left = $<Vl;
3776                 $0->right = $<AD;
3777         }$
3778         | ArgDecl ${
3779                 $0 = new(binode);
3780                 $0->op = List;
3781                 $0->left = NULL;
3782                 $0->right = $<AD;
3783         }$
3784
3785         $*var
3786         ArgDecl -> IDENTIFIER : FormalType ${ {
3787                 struct variable *v = var_decl(c, $ID.txt);
3788                 $0 = new_pos(var, $ID);
3789                 $0->var = v;
3790                 v->where_decl = $0;
3791                 v->where_set = $0;
3792                 v->type = $<FT;
3793         } }$
3794
3795 ##### Function calls
3796
3797 A function call can appear either as an expression or as a statement.
3798 We use a new 'Funcall' binode type to link the function with a list of
3799 arguments, form with the 'List' nodes.
3800
3801 We have already seen the "Term" which is how a function call can appear
3802 in an expression.  To parse a function call into a statement we include
3803 it in the "SimpleStatement Grammar" which will be described later.
3804
3805 ###### Binode types
3806         Funcall,
3807
3808 ###### term grammar
3809         | Term ( ExpressionList ) ${ {
3810                 struct binode *b = new(binode);
3811                 b->op = Funcall;
3812                 b->left = $<T;
3813                 b->right = reorder_bilist($<EL);
3814                 $0 = b;
3815         } }$
3816         | Term ( ) ${ {
3817                 struct binode *b = new(binode);
3818                 b->op = Funcall;
3819                 b->left = $<T;
3820                 b->right = NULL;
3821                 $0 = b;
3822         } }$
3823
3824 ###### SimpleStatement Grammar
3825
3826         | Term ( ExpressionList ) ${ {
3827                 struct binode *b = new(binode);
3828                 b->op = Funcall;
3829                 b->left = $<T;
3830                 b->right = reorder_bilist($<EL);
3831                 $0 = b;
3832         } }$
3833
3834 ###### print binode cases
3835
3836         case Funcall:
3837                 do_indent(indent, "");
3838                 print_exec(b->left, -1, bracket);
3839                 printf("(");
3840                 for (b = cast(binode, b->right); b; b = cast(binode, b->right)) {
3841                         if (b->left) {
3842                                 printf(" ");
3843                                 print_exec(b->left, -1, bracket);
3844                                 if (b->right)
3845                                         printf(",");
3846                         }
3847                 }
3848                 printf(")");
3849                 if (indent >= 0)
3850                         printf("\n");
3851                 break;
3852
3853 ###### propagate binode cases
3854
3855         case Funcall: {
3856                 /* Every arg must match formal parameter, and result
3857                  * is return type of function
3858                  */
3859                 struct binode *args = cast(binode, b->right);
3860                 struct var *v = cast(var, b->left);
3861
3862                 if (!v->var->type || v->var->type->check_args == NULL) {
3863                         type_err(c, "error: attempt to call a non-function.",
3864                                  prog, NULL, 0, NULL);
3865                         return NULL;
3866                 }
3867                 *perr |= Eruntime;
3868                 v->var->type->check_args(c, perr_local, v->var->type, args);
3869                 if (v->var->type->function.inline_result)
3870                         *perr |= Emaycopy;
3871                 *perr |= Erval;
3872                 return v->var->type->function.return_type;
3873         }
3874
3875 ###### interp binode cases
3876
3877         case Funcall: {
3878                 struct var *v = cast(var, b->left);
3879                 struct type *t = v->var->type;
3880                 void *oldlocal = c->local;
3881                 int old_size = c->local_size;
3882                 void *local = calloc(1, t->function.local_size);
3883                 struct value *fbody = var_value(c, v->var);
3884                 struct binode *arg = cast(binode, b->right);
3885                 struct binode *param = t->function.params;
3886
3887                 while (param) {
3888                         struct var *pv = cast(var, param->left);
3889                         struct type *vtype = NULL;
3890                         struct value val = interp_exec(c, arg->left, &vtype);
3891                         struct value *lval;
3892                         c->local = local; c->local_size = t->function.local_size;
3893                         lval = var_value(c, pv->var);
3894                         c->local = oldlocal; c->local_size = old_size;
3895                         memcpy(lval, &val, vtype->size);
3896                         param = cast(binode, param->right);
3897                         arg = cast(binode, arg->right);
3898                 }
3899                 c->local = local; c->local_size = t->function.local_size;
3900                 if (t->function.inline_result && dtype) {
3901                         _interp_exec(c, fbody->function, NULL, NULL);
3902                         memcpy(dest, local, dtype->size);
3903                         rvtype = ret.type = NULL;
3904                 } else
3905                         rv = interp_exec(c, fbody->function, &rvtype);
3906                 c->local = oldlocal; c->local_size = old_size;
3907                 free(local);
3908                 break;
3909         }
3910
3911 ## Complex executables: statements and expressions
3912
3913 Now that we have types, values, variables, and most of the basic
3914 Terms which provide access to these, we can explore the more complex
3915 code that combine all of these to get useful work done.  Specifically
3916 statements and expressions.
3917
3918 Expressions are various combinations of Terms.  We will use operator
3919 precedence to ensure correct parsing.  The simplest Expression is just a
3920 Term - others will follow.
3921
3922 ###### Grammar
3923
3924         $*exec
3925         Expression -> Term ${ $0 = $<Term; }$
3926         ## expression grammar
3927
3928 ### Expressions: Conditional
3929
3930 Our first user of the `binode` will be conditional expressions, which
3931 is a bit odd as they actually have three components.  That will be
3932 handled by having 2 binodes for each expression.  The conditional
3933 expression is the lowest precedence operator which is why we define it
3934 first - to start the precedence list.
3935
3936 Conditional expressions are of the form "value `if` condition `else`
3937 other_value".  They associate to the right, so everything to the right
3938 of `else` is part of an else value, while only a higher-precedence to
3939 the left of `if` is the if value.  Between `if` and `else` there is no
3940 room for ambiguity, so a full conditional expression is allowed in
3941 there.
3942
3943 ###### Binode types
3944         CondExpr,
3945
3946 ###### declare terminals
3947
3948         $LEFT if $$ifelse
3949
3950 ###### expression grammar
3951
3952         | Expression if Expression else Expression $$ifelse ${ {
3953                 struct binode *b1 = new(binode);
3954                 struct binode *b2 = new(binode);
3955                 b1->op = CondExpr;
3956                 b1->left = $<3;
3957                 b1->right = b2;
3958                 b2->op = CondExpr;
3959                 b2->left = $<1;
3960                 b2->right = $<5;
3961                 $0 = b1;
3962         } }$
3963
3964 ###### print binode cases
3965
3966         case CondExpr:
3967                 b2 = cast(binode, b->right);
3968                 if (bracket) printf("(");
3969                 print_exec(b2->left, -1, bracket);
3970                 printf(" if ");
3971                 print_exec(b->left, -1, bracket);
3972                 printf(" else ");
3973                 print_exec(b2->right, -1, bracket);
3974                 if (bracket) printf(")");
3975                 break;
3976
3977 ###### propagate binode cases
3978
3979         case CondExpr: {
3980                 /* cond must be Tbool, others must match */
3981                 struct binode *b2 = cast(binode, b->right);
3982                 struct type *t2;
3983
3984                 propagate_types(b->left, c, perr_local, Tbool, 0);
3985                 t = propagate_types(b2->left, c, perr, type, 0);
3986                 t2 = propagate_types(b2->right, c, perr, type ?: t, 0);
3987                 return t ?: t2;
3988         }
3989
3990 ###### interp binode cases
3991
3992         case CondExpr: {
3993                 struct binode *b2 = cast(binode, b->right);
3994                 left = interp_exec(c, b->left, &ltype);
3995                 if (left.bool)
3996                         rv = interp_exec(c, b2->left, &rvtype);
3997                 else
3998                         rv = interp_exec(c, b2->right, &rvtype);
3999                 }
4000                 break;
4001
4002 ### Expressions: Boolean
4003
4004 The next class of expressions to use the `binode` will be Boolean
4005 expressions.  `and` and `or` are short-circuit operators that don't
4006 evaluate the second expression if not necessary.
4007
4008 ###### Binode types
4009         And,
4010         Or,
4011         Not,
4012
4013 ###### declare terminals
4014         $LEFT or
4015         $LEFT and
4016         $LEFT not
4017
4018 ###### expression grammar
4019         | Expression or Expression ${ {
4020                 struct binode *b = new(binode);
4021                 b->op = Or;
4022                 b->left = $<1;
4023                 b->right = $<3;
4024                 $0 = b;
4025         } }$
4026         | Expression and Expression ${ {
4027                 struct binode *b = new(binode);
4028                 b->op = And;
4029                 b->left = $<1;
4030                 b->right = $<3;
4031                 $0 = b;
4032         } }$
4033         | not Expression ${ {
4034                 struct binode *b = new(binode);
4035                 b->op = Not;
4036                 b->right = $<2;
4037                 $0 = b;
4038         } }$
4039
4040 ###### print binode cases
4041         case And:
4042                 if (bracket) printf("(");
4043                 print_exec(b->left, -1, bracket);
4044                 printf(" and ");
4045                 print_exec(b->right, -1, bracket);
4046                 if (bracket) printf(")");
4047                 break;
4048         case Or:
4049                 if (bracket) printf("(");
4050                 print_exec(b->left, -1, bracket);
4051                 printf(" or ");
4052                 print_exec(b->right, -1, bracket);
4053                 if (bracket) printf(")");
4054                 break;
4055         case Not:
4056                 if (bracket) printf("(");
4057                 printf("not ");
4058                 print_exec(b->right, -1, bracket);
4059                 if (bracket) printf(")");
4060                 break;
4061
4062 ###### propagate binode cases
4063         case And:
4064         case Or:
4065         case Not:
4066                 /* both must be Tbool, result is Tbool */
4067                 propagate_types(b->left, c, perr, Tbool, 0);
4068                 propagate_types(b->right, c, perr, Tbool, 0);
4069                 if (type && type != Tbool)
4070                         type_err(c, "error: %1 operation found where %2 expected", prog,
4071                                    Tbool, 0, type);
4072                 *perr |= Erval;
4073                 return Tbool;
4074
4075 ###### interp binode cases
4076         case And:
4077                 rv = interp_exec(c, b->left, &rvtype);
4078                 if (rv.bool)
4079                         rv = interp_exec(c, b->right, NULL);
4080                 break;
4081         case Or:
4082                 rv = interp_exec(c, b->left, &rvtype);
4083                 if (!rv.bool)
4084                         rv = interp_exec(c, b->right, NULL);
4085                 break;
4086         case Not:
4087                 rv = interp_exec(c, b->right, &rvtype);
4088                 rv.bool = !rv.bool;
4089                 break;
4090
4091 ### Expressions: Comparison
4092
4093 Of slightly higher precedence that Boolean expressions are Comparisons.
4094 A comparison takes arguments of any comparable type, but the two types
4095 must be the same.
4096
4097 To simplify the parsing we introduce an `eop` which can record an
4098 expression operator, and the `CMPop` non-terminal will match one of them.
4099
4100 ###### ast
4101         struct eop {
4102                 enum Btype op;
4103         };
4104
4105 ###### ast functions
4106         static void free_eop(struct eop *e)
4107         {
4108                 if (e)
4109                         free(e);
4110         }
4111
4112 ###### Binode types
4113         Less,
4114         Gtr,
4115         LessEq,
4116         GtrEq,
4117         Eql,
4118         NEql,
4119
4120 ###### declare terminals
4121         $LEFT < > <= >= == != CMPop
4122
4123 ###### expression grammar
4124         | Expression CMPop Expression ${ {
4125                 struct binode *b = new(binode);
4126                 b->op = $2.op;
4127                 b->left = $<1;
4128                 b->right = $<3;
4129                 $0 = b;
4130         } }$
4131
4132 ###### Grammar
4133
4134         $eop
4135         CMPop ->  < ${ $0.op = Less; }$
4136         |         > ${ $0.op = Gtr; }$
4137         |         <= ${ $0.op = LessEq; }$
4138         |         >= ${ $0.op = GtrEq; }$
4139         |         == ${ $0.op = Eql; }$
4140         |         != ${ $0.op = NEql; }$
4141
4142 ###### print binode cases
4143
4144         case Less:
4145         case LessEq:
4146         case Gtr:
4147         case GtrEq:
4148         case Eql:
4149         case NEql:
4150                 if (bracket) printf("(");
4151                 print_exec(b->left, -1, bracket);
4152                 switch(b->op) {
4153                 case Less:   printf(" < "); break;
4154                 case LessEq: printf(" <= "); break;
4155                 case Gtr:    printf(" > "); break;
4156                 case GtrEq:  printf(" >= "); break;
4157                 case Eql:    printf(" == "); break;
4158                 case NEql:   printf(" != "); break;
4159                 default: abort();               // NOTEST
4160                 }
4161                 print_exec(b->right, -1, bracket);
4162                 if (bracket) printf(")");
4163                 break;
4164
4165 ###### propagate binode cases
4166         case Less:
4167         case LessEq:
4168         case Gtr:
4169         case GtrEq:
4170         case Eql:
4171         case NEql:
4172                 /* Both must match but not be labels, result is Tbool */
4173                 t = propagate_types(b->left, c, perr, NULL, 0);
4174                 if (t)
4175                         propagate_types(b->right, c, perr, t, 0);
4176                 else {
4177                         t = propagate_types(b->right, c, perr, NULL, 0); // NOTEST
4178                         if (t)  // NOTEST
4179                                 t = propagate_types(b->left, c, perr, t, 0);    // NOTEST
4180                 }
4181                 if (!type_compat(type, Tbool, 0))
4182                         type_err(c, "error: Comparison returns %1 but %2 expected", prog,
4183                                     Tbool, rules, type);
4184                 *perr |= Erval;
4185                 return Tbool;
4186
4187 ###### interp binode cases
4188         case Less:
4189         case LessEq:
4190         case Gtr:
4191         case GtrEq:
4192         case Eql:
4193         case NEql:
4194         {
4195                 int cmp;
4196                 left = interp_exec(c, b->left, &ltype);
4197                 right = interp_exec(c, b->right, &rtype);
4198                 cmp = value_cmp(ltype, rtype, &left, &right);
4199                 rvtype = Tbool;
4200                 switch (b->op) {
4201                 case Less:      rv.bool = cmp <  0; break;
4202                 case LessEq:    rv.bool = cmp <= 0; break;
4203                 case Gtr:       rv.bool = cmp >  0; break;
4204                 case GtrEq:     rv.bool = cmp >= 0; break;
4205                 case Eql:       rv.bool = cmp == 0; break;
4206                 case NEql:      rv.bool = cmp != 0; break;
4207                 default:        rv.bool = 0; break;     // NOTEST
4208                 }
4209                 break;
4210         }
4211
4212 ### Expressions: Arithmetic etc.
4213
4214 The remaining expressions with the highest precedence are arithmetic,
4215 string concatenation, string conversion, and testing.  String concatenation
4216 (`++`) has the same precedence as multiplication and division, but lower
4217 than the unary.
4218
4219 Testing comes in two forms.  A single question mark (`?`) is a unary
4220 operator which converts come types into Boolean.  The general meaning is
4221 "is this a valid value" and there will be more uses as the language
4222 develops.  A double question-mark (`??`) is a binary operator (Choose),
4223 with the same precedence as multiplication, which returns the LHS if it
4224 tests successfully, else returns the RHS.
4225
4226 String conversion is a temporary feature until I get a better type
4227 system.  `$` is a prefix operator which expects a string and returns
4228 a number.
4229
4230 `+` and `-` are both infix and prefix operations (where they are
4231 absolute value and negation).  These have different operator names.
4232
4233 We also have a 'Bracket' operator which records where parentheses were
4234 found.  This makes it easy to reproduce these when printing.  Possibly I
4235 should only insert brackets were needed for precedence.  Putting
4236 parentheses around an expression converts it into a Term,
4237
4238 ###### Binode types
4239         Plus, Minus,
4240         Times, Divide, Rem,
4241         Concat, Choose,
4242         Absolute, Negate, Test,
4243         StringConv,
4244         Bracket,
4245
4246 ###### declare terminals
4247         $LEFT + - Eop
4248         $LEFT * / % ++ ?? Top
4249         $LEFT Uop $ ?
4250         $TERM ( )
4251
4252 ###### expression grammar
4253         | Expression Eop Expression ${ {
4254                 struct binode *b = new(binode);
4255                 b->op = $2.op;
4256                 b->left = $<1;
4257                 b->right = $<3;
4258                 $0 = b;
4259         } }$
4260
4261         | Expression Top Expression ${ {
4262                 struct binode *b = new(binode);
4263                 b->op = $2.op;
4264                 b->left = $<1;
4265                 b->right = $<3;
4266                 $0 = b;
4267         } }$
4268
4269         | Uop Expression ${ {
4270                 struct binode *b = new(binode);
4271                 b->op = $1.op;
4272                 b->right = $<2;
4273                 $0 = b;
4274         } }$
4275
4276 ###### term grammar
4277
4278         | ( Expression ) ${ {
4279                 struct binode *b = new_pos(binode, $1);
4280                 b->op = Bracket;
4281                 b->right = $<2;
4282                 $0 = b;
4283         } }$
4284
4285 ###### Grammar
4286
4287         $eop
4288         Eop ->   + ${ $0.op = Plus; }$
4289         |        - ${ $0.op = Minus; }$
4290
4291         Uop ->   + ${ $0.op = Absolute; }$
4292         |        - ${ $0.op = Negate; }$
4293         |        $ ${ $0.op = StringConv; }$
4294         |        ? ${ $0.op = Test; }$
4295
4296         Top ->   * ${ $0.op = Times; }$
4297         |        / ${ $0.op = Divide; }$
4298         |        % ${ $0.op = Rem; }$
4299         |        ++ ${ $0.op = Concat; }$
4300         |        ?? ${ $0.op = Choose; }$
4301
4302 ###### print binode cases
4303         case Plus:
4304         case Minus:
4305         case Times:
4306         case Divide:
4307         case Concat:
4308         case Rem:
4309         case Choose:
4310                 if (bracket) printf("(");
4311                 print_exec(b->left, indent, bracket);
4312                 switch(b->op) {
4313                 case Plus:   fputs(" + ", stdout); break;
4314                 case Minus:  fputs(" - ", stdout); break;
4315                 case Times:  fputs(" * ", stdout); break;
4316                 case Divide: fputs(" / ", stdout); break;
4317                 case Rem:    fputs(" % ", stdout); break;
4318                 case Concat: fputs(" ++ ", stdout); break;
4319                 case Choose: fputs(" ?? ", stdout); break;
4320                 default: abort();       // NOTEST
4321                 }                       // NOTEST
4322                 print_exec(b->right, indent, bracket);
4323                 if (bracket) printf(")");
4324                 break;
4325         case Absolute:
4326         case Negate:
4327         case StringConv:
4328         case Test:
4329                 if (bracket) printf("(");
4330                 switch (b->op) {
4331                 case Absolute:   fputs("+", stdout); break;
4332                 case Negate:     fputs("-", stdout); break;
4333                 case StringConv: fputs("$", stdout); break;
4334                 case Test:       fputs("?", stdout); break;
4335                 default: abort();       // NOTEST
4336                 }                       // NOTEST
4337                 print_exec(b->right, indent, bracket);
4338                 if (bracket) printf(")");
4339                 break;
4340         case Bracket:
4341                 /* Avoid double brackets... */
4342                 if (!bracket) printf("(");
4343                 print_exec(b->right, indent, bracket);
4344                 if (!bracket) printf(")");
4345                 break;
4346
4347 ###### propagate binode cases
4348         case Plus:
4349         case Minus:
4350         case Times:
4351         case Rem:
4352         case Divide:
4353                 /* both must be numbers, result is Tnum */
4354         case Absolute:
4355         case Negate:
4356                 /* as propagate_types ignores a NULL,
4357                  * unary ops fit here too */
4358                 propagate_types(b->left, c, perr, Tnum, 0);
4359                 propagate_types(b->right, c, perr, Tnum, 0);
4360                 if (!type_compat(type, Tnum, 0))
4361                         type_err(c, "error: Arithmetic returns %1 but %2 expected", prog,
4362                                    Tnum, rules, type);
4363                 *perr |= Erval;
4364                 return Tnum;
4365
4366         case Concat:
4367                 /* both must be Tstr, result is Tstr */
4368                 propagate_types(b->left, c, perr, Tstr, 0);
4369                 propagate_types(b->right, c, perr, Tstr, 0);
4370                 if (!type_compat(type, Tstr, 0))
4371                         type_err(c, "error: Concat returns %1 but %2 expected", prog,
4372                                    Tstr, rules, type);
4373                 *perr |= Erval;
4374                 return Tstr;
4375
4376         case StringConv:
4377                 /* op must be string, result is number */
4378                 propagate_types(b->left, c, perr, Tstr, 0);
4379                 if (!type_compat(type, Tnum, 0))
4380                         type_err(c,
4381                           "error: Can only convert string to number, not %1",
4382                                 prog, type, 0, NULL);
4383                 *perr |= Erval;
4384                 return Tnum;
4385
4386         case Test:
4387                 /* LHS must support ->test, result is Tbool */
4388                 t = propagate_types(b->right, c, perr, NULL, 0);
4389                 if (!t || !t->test)
4390                         type_err(c, "error: '?' requires a testable value, not %1",
4391                                  prog, t, 0, NULL);
4392                 *perr |= Erval;
4393                 return Tbool;
4394
4395         case Choose:
4396                 /* LHS and RHS must match and are returned. Must support
4397                  * ->test
4398                  */
4399                 t = propagate_types(b->left, c, perr, type, rules);
4400                 t = propagate_types(b->right, c, perr, t, rules);
4401                 if (t && t->test == NULL)
4402                         type_err(c, "error: \"??\" requires a testable value, not %1",
4403                                  prog, t, 0, NULL);
4404                 *perr |= Erval;
4405                 return t;
4406
4407         case Bracket:
4408                 return propagate_types(b->right, c, perr, type, rules);
4409