ocean-lang.org Git - ocean/blob - csrc/oceani.mdc

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