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