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

   1 # Ocean Interpreter - Stoney Creek version
   2
   3 Ocean is intended to be an 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 second version of the interpreter exists to test out the
  33 structured statement providing conditions and iteration, and simple
  34 variable scoping.  Clearly we need some minimal other functionality so
  35 that values can be tested and instructions iterated over.  All that
  36 functionality is clearly not normative at this stage (not that
  37 anything is **really** normative yet) and will change, so early test
  38 code will certainly break in later versions.
  39
  40 The under-test parts of the language are:
  41
  42  - conditional/looping structured statements
  43  - the `use` statement which is needed for that
  44  - Variable binding using ":=" and "::=", and assignment using "=".
  45
  46 Elements which are present to make a usable language are:
  47
  48  - "blocks" of multiple statements.
  49  - `pass`: a statement which does nothing.
  50  - expressions: `+`, `-`, `*`, `/` can apply to numbers and `++` can
  51    catenate strings.  `and`, `or`, `not` manipulate Booleans, and
  52    normal comparison operators can work on all three types.
  53  - `print`: will print the values in a list of expressions.
  54  - `program`: is given a list of identifiers to initialize from
  55    arguments.
  56
  57 ## Naming
  58
  59 Versions of the interpreter which obviously do not support a complete
  60 language will be named after creeks and streams.  This one is Stoney
  61 Creek.
  62
  63 Once we have something reasonably resembling a complete language, the
  64 names of rivers will be used.
  65 Early versions of the compiler will be named after seas.  Major
  66 releases of the compiler will be named after oceans.  Hopefully I will
  67 be finished once I get to the Pacific Ocean release.
  68
  69 ## Outline
  70
  71 As well as parsing and executing a program, the interpreter can print
  72 out the program from the parsed internal structure.  This is useful
  73 for validating the parsing.
  74 So the main requirements of the interpreter are:
  75
  76 - Parse the program, possible with tracing
  77 - Analyse the parsed program to ensure consistency
  78 - print the program
  79 - execute the program
  80
  81 This is all performed by a single C program extracted with
  82 `parsergen`.
  83
  84 There will be two formats for printing the program: a default and one
  85 that uses bracketing.  So a `--bracket` command line option is needed
  86 for that.  Normally the first code section found is used, however an
  87 alternate section can be requested so that a file (such as this one)
  88 can contain multiple programs This is effected with the `--section`
  89 option.
  90
  91 ###### File: oceani.mk
  92
  93         myCFLAGS := -Wall -g -fplan9-extensions
  94         CFLAGS := $(filter-out $(myCFLAGS),$(CFLAGS)) $(myCFLAGS)
  95         myLDLIBS:= libparser.o libscanner.o libmdcode.o -licuuc
  96         LDLIBS := $(filter-out $(myLDLIBS),$(LDLIBS)) $(myLDLIBS)
  97         ## libs
  98         all :: $(LDLIBS) oceani
  99         oceani.c oceani.h : oceani.mdc parsergen
 100                 ./parsergen -o oceani --LALR --tag Parser oceani.mdc
 101         oceani.mk: oceani.mdc md2c
 102                 ./md2c oceani.mdc
 103
 104         oceani: oceani.o $(LDLIBS)
 105                 $(CC) $(CFLAGS) -o oceani oceani.o $(LDLIBS)
 106
 107 ###### Parser: header
 108         ## macros
 109         ## ast
 110         struct parse_context {
 111                 struct token_config config;
 112                 char *file_name;
 113                 int parse_error;
 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;
 168                 char *section = NULL;
 169                 struct parse_context context = {
 170                         .config = {
 171                                 .ignored = (1 << TK_line_comment)
 172                                          | (1 << TK_block_comment),
 173                                 .number_chars = ".,_+-",
 174                                 .word_start = "_",
 175                                 .word_cont = "_",
 176                         },
 177                 };
 178                 int doprint=0, dotrace=0, doexec=1, brackets=0;
 179                 struct exec **prog;
 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                 if (section) {
 212                         struct section *ss;
 213                         for (ss = s; ss; ss = ss->next) {
 214                                 struct text sec = ss->section;
 215                                 if (sec.len == strlen(section) &&
 216                                     strncmp(sec.txt, section, sec.len) == 0)
 217                                         break;
 218                         }
 219                         if (ss)
 220                                 prog = parse_oceani(ss->code, &context.config,
 221                                                     dotrace ? stderr : NULL);
 222                         else {
 223                                 fprintf(stderr, "oceani: cannot find section %s\n",
 224                                         section);
 225                                 exit(1);
 226                         }
 227                 } else
 228                         prog = parse_oceani(s->code, &context.config,
 229                                     dotrace ? stderr : NULL);
 230                 if (!prog) {
 231                         fprintf(stderr, "oceani: fatal parser error.\n");
 232                         context.parse_error = 1;
 233                 }
 234                 if (prog && doprint)
 235                         print_exec(*prog, 0, brackets);
 236                 if (prog && doexec && !context.parse_error) {
 237                         if (!analyse_prog(*prog, &context)) {
 238                                 fprintf(stderr, "oceani: type error in program - not running.\n");
 239                                 exit(1);
 240                         }
 241                         interp_prog(*prog, argv+optind+1);
 242                 }
 243                 if (prog) {
 244                         free_exec(*prog);
 245                         free(prog);
 246                 }
 247                 while (s) {
 248                         struct section *t = s->next;
 249                         code_free(s->code);
 250                         free(s);
 251                         s = t;
 252                 }
 253                 ## free context
 254                 exit(context.parse_error ? 1 : 0);
 255         }
 256
 257 ### Analysis
 258
 259 These four requirements of parse, analyse, print, interpret apply to
 260 each language element individually so that is how most of the code
 261 will be structured.
 262
 263 Three of the four are fairly self explanatory.  The one that requires
 264 a little explanation is the analysis step.
 265
 266 The current language design does not require (or even allow) the types
 267 of variables to be declared, but they must still have a single type.
 268 Different operations impose different requirements on the variables,
 269 for example addition requires both arguments to be numeric, and
 270 assignment requires the variable on the left to have the same type as
 271 the expression on the right.
 272
 273 Analysis involves propagating these type requirements around and
 274 consequently setting the type of each variable.  If any requirements
 275 are violated (e.g. a string is compared with a number) or if a
 276 variable needs to have two different types, then an error is raised
 277 and the program will not run.
 278
 279 If the same variable is declared in both branchs of an 'if/else', or
 280 in all cases of a 'switch' then the multiple instances may be merged
 281 into just one variable if the variable is references after the
 282 conditional statement.  When this happens, the types must naturally be
 283 consistent across all the branches.  When the variable is not used
 284 outside the if, the variables in the different branches are distinct
 285 and can be of different types.
 286
 287 Determining the types of all variables early is important for
 288 processing command line arguments.  These can be assigned to any type
 289 of variable, but we must first know the correct type so any required
 290 conversion can happen.  If a variable is associated with a command
 291 line argument but no type can be interpreted (e.g. the variable is
 292 only ever used in a `print` statement), then the type is set to
 293 'string'.
 294
 295 Undeclared names may only appear in "use" statements and "case" expressions.
 296 These names are given a type of "label" and a unique value.
 297 This allows them to fill the role of a name in an enumerated type, which
 298 is useful for testing the `switch` statement.
 299
 300 As we will see, the condition part of a `while` statement can return
 301 either a Boolean or some other type.  This requires that the expect
 302 type that gets passed around comprises a type (`enum vtype`) and a
 303 flag to indicate that `Vbool` is also permitted.
 304
 305 As there are, as yet, no distinct types that are compatible, there
 306 isn't much subtlety in the analysis.  When we have distinct number
 307 types, this will become more interesting.
 308
 309 #### Error reporting
 310
 311 When analysis discovers an inconsistency it needs to report an error;
 312 just refusing to run the code esure that the error doesn't cascade,
 313 but by itself it isn't very useful.  A clear understand of the sort of
 314 error message that are useful will help guide the process of analysis.
 315
 316 At a simplistic level, the only sort of error that type analysis can
 317 report is that the type of some construct doesn't match a contextual
 318 requirement.  For example, in `4 + "hello"` the addition provides a
 319 contextual requirement for numbers, but `"hello"` is not a number.  In
 320 this particular example no further information is needed as the types
 321 are obvious from local information.  When a variable is involved that
 322 isn't the case.  It may be helpful to explain why the variable has a
 323 particular type, by indicating the location where the type was set,
 324 whether by declaration or usage.
 325
 326 Using a recursive-descent analysis we can easily detect a problem at
 327 multiple locations. In "`hello:= "there"; 4 + hello`" the addition
 328 will detect that one argument is not a number and the usage of `hello`
 329 will detect that a number was wanted, but not provided.  In this
 330 (early) version of the language, we will generate error reports at
 331 multiple locations, to the use of `hello` will report an error and
 332 explain were the value was set, and the addition will report an error
 333 and say why numbers are needed.  To be able to report locations for
 334 errors, each language element will need to record a file location
 335 (line and column) and each variable will need to record the language
 336 element where its type was set.  For now we will assume that each line
 337 of an error message indicates one location in the file, and up to 2
 338 types.  So we provide a `printf`-like function which takes a format, a
 339 language (a `struct exec` which has not yet been introduced), and 2
 340 types. "`$1`" reports the first type, "`$2`" reports the second.  We
 341 will need a function to print the location, once we know how that is
 342 stored.
 343
 344 ###### forward decls
 345
 346         static void fput_loc(struct exec *loc, FILE *f);
 347
 348 ###### core functions
 349
 350         static void type_err(struct parse_context *c,
 351                              char *fmt, struct exec *loc,
 352                              enum vtype t1, enum vtype t2)
 353         {
 354                 fprintf(stderr, "%s:", c->file_name);
 355                 fput_loc(loc, stderr);
 356                 for (; *fmt ; fmt++) {
 357                         if (*fmt != '%') {
 358                                 fputc(*fmt, stderr);
 359                                 continue;
 360                         }
 361                         fmt++;
 362                         switch (*fmt) {
 363                         case '%': fputc(*fmt, stderr); break;
 364                         default: fputc('?', stderr); break;
 365                         case '1':
 366                                 fputs(vtype_names[t1], stderr);
 367                                 break;
 368                         case '2':
 369                                 fputs(vtype_names[t2], stderr);
 370                                 break;
 371                         ## format cases
 372                         }
 373                 }
 374                 fputs("\n", stderr);
 375                 c->parse_error = 1;
 376         }
 377
 378 ## Data Structures
 379
 380 One last introductory step before detailing the language elements and
 381 providing their four requirements is to establish the data structures
 382 to store these elements.
 383
 384 There are two key objects that we need to work with: executable
 385 elements which comprise the program, and values which the program
 386 works with.  Between these are the variables in their various scopes
 387 which hold the values.
 388
 389 ### Values
 390
 391 Values can be numbers, which we represent as multi-precision
 392 fractions, strings, Booleans and labels.  When analysing the program
 393 we also need to allow for places where no value is meaningful
 394 (`Vnone`) and where we don't know what type to expect yet (`Vunknown`
 395 which can be anything and `Vnolabel` which can be anything except a
 396 label).  A 2 character 'tail' is included in each value as the scanner
 397 wants to parse that from the end of numbers and we need somewhere to
 398 put it.  It is currently ignored but one day might allow for
 399 e.g. "imaginary" numbers.
 400
 401 Values are never shared, they are always copied when used, and freed
 402 when no longer needed.
 403
 404 When propagating type information around the program, we need to
 405 determine if two types are compatible, where `Vunknown` is compatible
 406 which anything, and `Vnolabel` is compatible with anything except a
 407 label.  A separate funtion to encode this rule will simplify some code
 408 later.
 409
 410 When assigning command line arguments to variable, we need to be able
 411 to parse each type from a string.
 412
 413 ###### includes
 414         #include <gmp.h>
 415         #include "string.h"
 416         #include "number.h"
 417
 418 ###### libs
 419         myLDLIBS := libnumber.o libstring.o -lgmp
 420         LDLIBS := $(filter-out $(myLDLIBS),$(LDLIBS)) $(myLDLIBS)
 421
 422 ###### ast
 423         struct value {
 424                 enum vtype {Vnolabel, Vunknown, Vnone, Vstr, Vnum, Vbool, Vlabel} vtype;
 425                 union {
 426                         struct text str;
 427                         mpq_t num;
 428                         int bool;
 429                         void *label;
 430                 };
 431                 char tail[2];
 432         };
 433
 434         char *vtype_names[] = {"nolabel", "unknown", "none", "string",
 435                                "number", "Boolean", "label"};
 436
 437 ###### ast functions
 438         static void free_value(struct value v)
 439         {
 440                 switch (v.vtype) {
 441                 case Vnone:
 442                 case Vnolabel:
 443                 case Vunknown: break;
 444                 case Vstr: free(v.str.txt); break;
 445                 case Vnum: mpq_clear(v.num); break;
 446                 case Vlabel:
 447                 case Vbool: break;
 448                 }
 449         }
 450
 451         static int vtype_compat(enum vtype require, enum vtype have, int bool_permitted)
 452         {
 453                 if (bool_permitted && have == Vbool)
 454                         return 1;
 455                 switch (require) {
 456                 case Vnolabel:
 457                         return have != Vlabel;
 458                 case Vunknown:
 459                         return 1;
 460                 default:
 461                         return have == Vunknown || require == have;
 462                 }
 463         }
 464
 465 ###### value functions
 466
 467         static void val_init(struct value *val, enum vtype type)
 468         {
 469                 val->vtype = type;
 470                 switch(type) {
 471                 case Vnone:abort();
 472                 case Vnolabel:
 473                 case Vunknown: break;
 474                 case Vnum:
 475                         mpq_init(val->num); break;
 476                 case Vstr:
 477                         val->str.txt = malloc(1);
 478                         val->str.len = 0;
 479                         break;
 480                 case Vbool:
 481                         val->bool = 0;
 482                         break;
 483                 case Vlabel:
 484                         val->label = val;
 485                         break;
 486                 }
 487         }
 488
 489         static struct value dup_value(struct value v)
 490         {
 491                 struct value rv;
 492                 rv.vtype = v.vtype;
 493                 switch (rv.vtype) {
 494                 case Vnone:
 495                 case Vnolabel:
 496                 case Vunknown: break;
 497                 case Vlabel:
 498                         rv.label = v.label;
 499                         break;
 500                 case Vbool:
 501                         rv.bool = v.bool;
 502                         break;
 503                 case Vnum:
 504                         mpq_init(rv.num);
 505                         mpq_set(rv.num, v.num);
 506                         break;
 507                 case Vstr:
 508                         rv.str.len = v.str.len;
 509                         rv.str.txt = malloc(rv.str.len);
 510                         memcpy(rv.str.txt, v.str.txt, v.str.len);
 511                         break;
 512                 }
 513                 return rv;
 514         }
 515
 516         static int value_cmp(struct value left, struct value right)
 517         {
 518                 int cmp;
 519                 if (left.vtype != right.vtype)
 520                         return left.vtype - right.vtype;
 521                 switch (left.vtype) {
 522                 case Vlabel: cmp = left.label == right.label ? 0 : 1; break;
 523                 case Vnum: cmp = mpq_cmp(left.num, right.num); break;
 524                 case Vstr: cmp = text_cmp(left.str, right.str); break;
 525                 case Vbool: cmp = left.bool - right.bool; break;
 526                 case Vnone:
 527                 case Vnolabel:
 528                 case Vunknown: cmp = 0;
 529                 }
 530                 return cmp;
 531         }
 532
 533         static struct text text_join(struct text a, struct text b)
 534         {
 535                 struct text rv;
 536                 rv.len = a.len + b.len;
 537                 rv.txt = malloc(rv.len);
 538                 memcpy(rv.txt, a.txt, a.len);
 539                 memcpy(rv.txt+a.len, b.txt, b.len);
 540                 return rv;
 541         }
 542
 543         static void print_value(struct value v)
 544         {
 545                 switch (v.vtype) {
 546                 case Vunknown:
 547                         printf("*Unknown*"); break;
 548                 case Vnone:
 549                 case Vnolabel:
 550                         printf("*no-value*"); break;
 551                 case Vlabel:
 552                         printf("*label-%p*", v.label); break;
 553                 case Vstr:
 554                         printf("%.*s", v.str.len, v.str.txt); break;
 555                 case Vbool:
 556                         printf("%s", v.bool ? "True":"False"); break;
 557                 case Vnum:
 558                         {
 559                         mpf_t fl;
 560                         mpf_init2(fl, 20);
 561                         mpf_set_q(fl, v.num);
 562                         gmp_printf("%Fg", fl);
 563                         mpf_clear(fl);
 564                         break;
 565                         }
 566                 }
 567         }
 568
 569         static int parse_value(struct value *vl, char *arg)
 570         {
 571                 struct text tx;
 572                 int neg = 0;
 573                 switch(vl->vtype) {
 574                 case Vnolabel:
 575                 case Vlabel:
 576                 case Vunknown:
 577                 case Vnone:
 578                         return 0;
 579                 case Vstr:
 580                         vl->str.len = strlen(arg);
 581                         vl->str.txt = malloc(vl->str.len);
 582                         memcpy(vl->str.txt, arg, vl->str.len);
 583                         break;
 584                 case Vnum:
 585                         if (*arg == '-') {
 586                                 neg = 1;
 587                                 arg++;
 588                         }
 589                         tx.txt = arg; tx.len = strlen(tx.txt);
 590                         if (number_parse(vl->num, vl->tail, tx) == 0)
 591                                 mpq_init(vl->num);
 592                         else if (neg)
 593                                 mpq_neg(vl->num, vl->num);
 594                         break;
 595                 case Vbool:
 596                         if (strcasecmp(arg, "true") == 0 ||
 597                             strcmp(arg, "1") == 0)
 598                                 vl->bool = 1;
 599                         else if (strcasecmp(arg, "false") == 0 ||
 600                                  strcmp(arg, "0") == 0)
 601                                 vl->bool = 0;
 602                         else {
 603                                 printf("Bad bool: %s\n", arg);
 604                                 return 0;
 605                         }
 606                         break;
 607                 }
 608                 return 1;
 609         }
 610
 611 ### Variables
 612
 613 Variables are scoped named values.  We store the names in a linked
 614 list of "bindings" sorted lexically, and use sequential search and
 615 insertion sort.
 616
 617 ###### ast
 618
 619         struct binding {
 620                 struct text name;
 621                 struct binding *next;   // in lexical order
 622                 ## binding fields
 623         };
 624
 625 This linked list is stored in the parse context so that "reduce"
 626 functions can find or add variables, and so the analysis phase can
 627 ensure that every variable gets a type.
 628
 629 ###### parse context
 630
 631         struct binding *varlist;  // In lexical order
 632
 633 ###### ast functions
 634
 635         static struct binding *find_binding(struct parse_context *c, struct text s)
 636         {
 637                 struct binding **l = &c->varlist;
 638                 struct binding *n;
 639                 int cmp = 1;
 640
 641                 while (*l &&
 642                         (cmp = text_cmp((*l)->name, s)) < 0)
 643                                 l = & (*l)->next;
 644                 if (cmp == 0)
 645                         return *l;
 646                 n = calloc(1, sizeof(*n));
 647                 n->name = s;
 648                 n->next = *l;
 649                 *l = n;
 650                 return n;
 651         }
 652
 653 Each name can be linked to multiple variables defined in different
 654 scopes.  Each scope starts where the name is declared and continues
 655 until the end of the containing code block.  Scopes of a given name
 656 cannot nest, so a declaration while a name is in-scope is an error.
 657
 658 ###### binding fields
 659         struct variable *var;
 660
 661 ###### ast
 662         struct variable {
 663                 struct variable *previous;
 664                 struct value val;
 665                 struct binding *name;
 666                 struct exec *where_decl;// where name was declared
 667                 struct exec *where_set; // where type was set
 668                 ## variable fields
 669         };
 670
 671 While the naming seems strange, we include local constants in the
 672 definition of variables.  A name declared `var := value` can
 673 subsequently be changed, but a name declared `var ::= value` cannot -
 674 it is constant
 675
 676 ###### variable fields
 677         int constant;
 678
 679 Scopes in parallel branches can be partially merged.  More
 680 specifically, if a given name is declared in both branches of an
 681 if/else then it's scope is a candidate for merging.  Similarly if
 682 every branch of an exhaustive switch (e.g. has an "else" clause)
 683 declares a given name, then the scopes from the branches are
 684 candidates for merging.
 685
 686 Note that names declared inside a loop (which is only parallel to
 687 itself) are never visible after the loop.  Similarly names defined in
 688 scopes which are not parallel, such as those started by `for` and
 689 `switch`, are never visible after the scope.  Only variable defined in
 690 both `then` and `else` (including the implicit then after an `if`, and
 691 excluding `then` used with `for`) and in all `case`s and `else` of a
 692 `switch` or `while` can be visible beyond the `if`/`switch`/`while`.
 693
 694 Labels, which are a bit like variables, follow different rules.
 695 Labels are not explicitly declared, but if an undeclared name appears
 696 in a context where a label is legal, that effectively declares the
 697 name as a label.  The declaration remains in force (or in scope) at
 698 least to the end of the immediately containing block and conditionally
 699 in any larger containing block which does not declare the name in some
 700 other way.  Importantly, the conditional scope extension happens even
 701 if the label is only used in parallel branch of a conditional -- when
 702 used in one branch it is treated as having been declared in all
 703 branches.
 704
 705 Merge candidates are tentatively visible beyond the end of the
 706 branching statement which creates them.  If the name is used, the
 707 merge is affirmed and they become a single variable visible at the
 708 outer layer.  If not - if it is redeclared first - the merge lapses.
 709
 710 To track scopes we have an extra stack, implemented as a linked list,
 711 which roughly parallels the parse stack and which is used exclusively
 712 for scoping.  When a new scope is opened, a new frame is pushed and
 713 the child-count of the parent frame is incremented.  This child-count
 714 is used to distinguish between the first of a set of parallel scopes,
 715 in which declared variables must not be in scope, and subsequent
 716 branches, whether they must already be conditionally scoped.
 717
 718 To push a new frame *before* any code in the frame is parsed, we need a
 719 grammar reduction.  This is most easily achieved with a grammar
 720 element which derives the empty string, and created the new scope when
 721 it is recognized.  This can be placed, for example, between a keyword
 722 like "if" and the code following it.
 723
 724 ###### ast
 725         struct scope {
 726                 struct scope *parent;
 727                 int child_count;
 728         };
 729
 730 ###### parse context
 731         int scope_depth;
 732         struct scope *scope_stack;
 733
 734 ###### ast functions
 735         static void scope_pop(struct parse_context *c)
 736         {
 737                 struct scope *s = c->scope_stack;
 738
 739                 c->scope_stack = s->parent;
 740                 free(s);
 741                 c->scope_depth -= 1;
 742         }
 743
 744         static void scope_push(struct parse_context *c)
 745         {
 746                 struct scope *s = calloc(1, sizeof(*s));
 747                 if (c->scope_stack)
 748                         c->scope_stack->child_count += 1;
 749                 s->parent = c->scope_stack;
 750                 c->scope_stack = s;
 751                 c->scope_depth += 1;
 752         }
 753
 754 ###### Grammar
 755
 756         $void
 757         OpenScope -> ${ scope_push(config2context(config)); }$
 758
 759
 760 Each variable records a scope depth and is in one of four states:
 761
 762 - "in scope".  This is the case between the declaration of the
 763   variable and the end of the containing block, and also between
 764   the usage with affirms a merge and the end of the block.
 765
 766   The scope depth is not greater than the current parse context scope
 767   nest depth.  When the block of that depth closes, the state will
 768   change.  To achieve this, all "in scope" variables are linked
 769   together as a stack in nesting order.
 770
 771 - "pending".  The "in scope" block has closed, but other parallel
 772   scopes are still being processed.  So far, every parallel block at
 773   the same level that has closed has declared the name.
 774
 775   The scope depth is the depth of the last parallel block that
 776   enclosed the declaration, and that has closed.
 777
 778 - "conditionally in scope".  The "in scope" block and all parallel
 779   scopes have closed, and no further mention of the name has been
 780   seen.  This state includes a secondary nest depth which records the
 781   outermost scope seen since the variable became conditionally in
 782   scope.  If a use of the name is found, the variable becomes "in
 783   scope" and that secondary depth becomes the recorded scope depth.
 784   If the name is declared as a new variable, the old variable becomes
 785   "out of scope" and the recorded scope depth stays unchanged.
 786
 787 - "out of scope".  The variable is neither in scope nor conditionally
 788   in scope.  It is permanently out of scope now and can be removed from
 789   the "in scope" stack.
 790
 791
 792 ###### variable fields
 793         int depth, min_depth;
 794         enum { OutScope, PendingScope, CondScope, InScope } scope;
 795         struct variable *in_scope;
 796
 797 ###### parse context
 798
 799         struct variable *in_scope;
 800
 801 All variables with the same name are linked together using the
 802 'previous' link.  Those variable that have
 803 been affirmatively merged all have a 'merged' pointer that points to
 804 one primary variable - the most recently declared instance. When
 805 merging variables, we need to also adjust the 'merged' pointer on any
 806 other variables that had previously been merged with the one that will
 807 no longer be primary.
 808
 809 ###### variable fields
 810         struct variable *merged;
 811
 812 ###### ast functions
 813
 814         static void variable_merge(struct variable *primary, struct variable *secondary)
 815         {
 816                 struct variable *v;
 817
 818                 if (primary->merged)
 819                         // shouldn't happen
 820                         primary = primary->merged;
 821
 822                 for (v = primary->previous; v; v=v->previous)
 823                         if (v == secondary || v == secondary->merged ||
 824                             v->merged == secondary ||
 825                             (v->merged && v->merged == secondary->merged)) {
 826                                 v->scope = OutScope;
 827                                 v->merged = primary;
 828                         }
 829         }
 830
 831 ###### free context
 832
 833         while (context.varlist) {
 834                 struct binding *b = context.varlist;
 835                 struct variable *v = b->var;
 836                 context.varlist = b->next;
 837                 free(b);
 838                 while (v) {
 839                         struct variable *t = v;
 840
 841                         v = t->previous;
 842                         free_value(t->val);
 843                         free(t);
 844                 }
 845         }
 846
 847 #### Manipulating Bindings
 848
 849 When a name is conditionally visible, a new declaration discards the
 850 old binding - the condition lapses.  Conversely a usage of the name
 851 affirms the visibility and extends it to the end of the containing
 852 block - i.e. the block that contains both the original declaration and
 853 the latest usage.  This is determined from `min_depth`.  When a
 854 conditionally visible variable gets affirmed like this, it is also
 855 merged with other conditionally visible variables with the same name.
 856
 857 When we parse a variable declaration we either signal an error if the
 858 name is currently bound, or create a new variable at the current nest
 859 depth if the name is unbound or bound to a conditionally scoped or
 860 pending-scope variable.  If the previous variable was conditionally
 861 scoped, it and its homonyms becomes out-of-scope.
 862
 863 When we parse a variable reference (including non-declarative
 864 assignment) we signal an error if the name is not bound or is bound to
 865 a pending-scope variable; update the scope if the name is bound to a
 866 conditionally scoped variable; or just proceed normally if the named
 867 variable is in scope.
 868
 869 When we exit a scope, any variables bound at this level are either
 870 marked out of scope or pending-scoped, depending on whether the
 871 scope was sequential or parallel.
 872
 873 When exiting a parallel scope we check if there are any variables that
 874 were previously pending and are still visible. If there are, then
 875 there weren't redeclared in the most recent scope, so they cannot be
 876 merged and must become out-of-scope.  If it is not the first of
 877 parallel scopes (based on `child_count`), we check that there was a
 878 previous binding that is still pending-scope.  If there isn't, the new
 879 variable must now be out-of-scope.
 880
 881 When exiting a sequential scope that immediately enclosed parallel
 882 scopes, we need to resolve any pending-scope variables.  If there was
 883 no `else` clause, and we cannot determine that the `switch` was exhaustive,
 884 we need to mark all pending-scope variable as out-of-scope.  Otherwise
 885 all pending-scope variables become conditionally scoped.
 886
 887 ###### ast
 888         enum closetype { CloseSequential, CloseParallel, CloseElse };
 889
 890 ###### ast functions
 891
 892         static struct variable *var_decl(struct parse_context *c, struct text s)
 893         {
 894                 struct binding *b = find_binding(c, s);
 895                 struct variable *v = b->var;
 896
 897                 switch (v ? v->scope : OutScope) {
 898                 case InScope:
 899                         /* Caller will report the error */
 900                         return NULL;
 901                 case CondScope:
 902                         for (;
 903                              v && v->scope == CondScope;
 904                              v = v->previous)
 905                                 v->scope = OutScope;
 906                         break;
 907                 default: break;
 908                 }
 909                 v = calloc(1, sizeof(*v));
 910                 v->previous = b->var;
 911                 b->var = v;
 912                 v->name = b;
 913                 v->min_depth = v->depth = c->scope_depth;
 914                 v->scope = InScope;
 915                 v->in_scope = c->in_scope;
 916                 c->in_scope = v;
 917                 val_init(&v->val, Vunknown);
 918                 return v;
 919         }
 920
 921         static struct variable *var_ref(struct parse_context *c, struct text s)
 922         {
 923                 struct binding *b = find_binding(c, s);
 924                 struct variable *v = b->var;
 925                 struct variable *v2;
 926
 927                 switch (v ? v->scope : OutScope) {
 928                 case OutScope:
 929                 case PendingScope:
 930                         /* Signal an error - once that is possible */
 931                         return NULL;
 932                 case CondScope:
 933                         /* All CondScope variables of this name need to be merged
 934                          * and become InScope
 935                          */
 936                         v->depth = v->min_depth;
 937                         v->scope = InScope;
 938                         for (v2 = v->previous;
 939                              v2 && v2->scope == CondScope;
 940                              v2 = v2->previous)
 941                                 variable_merge(v, v2);
 942                         break;
 943                 case InScope:
 944                         break;
 945                 }
 946                 return v;
 947         }
 948
 949         static void var_block_close(struct parse_context *c, enum closetype ct)
 950         {
 951                 /* close of all variables that are in_scope */
 952                 struct variable *v, **vp, *v2;
 953
 954                 scope_pop(c);
 955                 for (vp = &c->in_scope;
 956                      v = *vp, v && v->depth > c->scope_depth && v->min_depth > c->scope_depth;
 957                      ) {
 958                         switch (ct) {
 959                         case CloseElse:
 960                         case CloseParallel: /* handle PendingScope */
 961                                 switch(v->scope) {
 962                                 case InScope:
 963                                 case CondScope:
 964                                         if (c->scope_stack->child_count == 1)
 965                                                 v->scope = PendingScope;
 966                                         else if (v->previous &&
 967                                                  v->previous->scope == PendingScope)
 968                                                 v->scope = PendingScope;
 969                                         else if (v->val.vtype == Vlabel)
 970                                                 v->scope = PendingScope;
 971                                         else if (v->name->var == v)
 972                                                 v->scope = OutScope;
 973                                         if (ct == CloseElse) {
 974                                                 /* All Pending variables with this name
 975                                                  * are now Conditional */
 976                                                 for (v2 = v;
 977                                                      v2 && v2->scope == PendingScope;
 978                                                      v2 = v2->previous)
 979                                                         v2->scope = CondScope;
 980                                         }
 981                                         break;
 982                                 case PendingScope:
 983                                         for (v2 = v;
 984                                              v2 && v2->scope == PendingScope;
 985                                              v2 = v2->previous)
 986                                                 if (v2->val.vtype != Vlabel)
 987                                                         v2->scope = OutScope;
 988                                         break;
 989                                 case OutScope: break;
 990                                 }
 991                                 break;
 992                         case CloseSequential:
 993                                 if (v->val.vtype == Vlabel)
 994                                         v->scope = PendingScope;
 995                                 switch (v->scope) {
 996                                 case InScope:
 997                                         v->scope = OutScope;
 998                                         break;
 999                                 case PendingScope:
1000                                         /* There was no 'else', so we can only become
1001                                          * conditional if we know the cases were exhaustive,
1002                                          * and that doesn't mean anything yet.
1003                                          * So only labels become conditional..
1004                                          */
1005                                         for (v2 = v;
1006                                              v2 && v2->scope == PendingScope;
1007                                              v2 = v2->previous)
1008                                                 if (v2->val.vtype == Vlabel) {
1009                                                         v2->scope = CondScope;
1010                                                         v2->min_depth = c->scope_depth;
1011                                                 } else
1012                                                         v2->scope = OutScope;
1013                                         break;
1014                                 case CondScope:
1015                                 case OutScope: break;
1016                                 }
1017                                 break;
1018                         }
1019                         if (v->scope == OutScope)
1020                                 *vp = v->in_scope;
1021                         else
1022                                 vp = &v->in_scope;
1023                 }
1024         }
1025
1026 ### Executables
1027
1028 Executables can be lots of different things.  In many cases an
1029 executable is just an operation combined with one or two other
1030 executables.  This allows for expressions and lists etc.  Other times
1031 an executable is something quite specific like a constant or variable
1032 name.  So we define a `struct exec` to be a general executable with a
1033 type, and a `struct binode` which is a subclass of `exec` and forms a
1034 node in a binary tree and holding an operation. There will be other
1035 subclasses, and to access these we need to be able to `cast` the
1036 `exec` into the various other types.
1037
1038 ###### macros
1039         #define cast(structname, pointer) ({            \
1040                 const typeof( ((struct structname *)0)->type) *__mptr = &(pointer)->type; \
1041                 if (__mptr && *__mptr != X##structname) abort();                \
1042                 (struct structname *)( (char *)__mptr);})
1043
1044         #define new(structname) ({                                              \
1045                 struct structname *__ptr = ((struct structname *)calloc(1,sizeof(struct structname))); \
1046                 __ptr->type = X##structname;                                            \
1047                 __ptr->line = -1; __ptr->column = -1;                                   \
1048                 __ptr;})
1049
1050         #define new_pos(structname, token) ({                                           \
1051                 struct structname *__ptr = ((struct structname *)calloc(1,sizeof(struct structname))); \
1052                 __ptr->type = X##structname;                                            \
1053                 __ptr->line = token.line; __ptr->column = token.col;                    \
1054                 __ptr;})
1055
1056 ###### ast
1057         enum exec_types {
1058                 Xbinode,
1059                 ## exec type
1060         };
1061         struct exec {
1062                 enum exec_types type;
1063                 int line, column;
1064         };
1065         struct binode {
1066                 struct exec;
1067                 enum Btype {
1068                         ## Binode types
1069                 } op;
1070                 struct exec *left, *right;
1071         };
1072
1073 ###### ast functions
1074
1075         static int __fput_loc(struct exec *loc, FILE *f)
1076         {
1077                 if (loc->line >= 0) {
1078                         fprintf(f, "%d:%d: ", loc->line, loc->column);
1079                         return 1;
1080                 }
1081                 if (loc->type == Xbinode)
1082                         return __fput_loc(cast(binode,loc)->left, f) ||
1083                                __fput_loc(cast(binode,loc)->right, f);
1084                 return 0;
1085         }
1086         static void fput_loc(struct exec *loc, FILE *f)
1087         {
1088                 if (!__fput_loc(loc, f))
1089                         fprintf(f, "??:??: ");
1090         }
1091
1092 Each different type of `exec` node needs a number of functions
1093 defined, a bit like methods.  We must be able to be able to free it,
1094 print it, analyse it and execute it.  Once we have specific `exec`
1095 types we will need to parse them too.  Let's take this a bit more
1096 slowly.
1097
1098 #### Freeing
1099
1100 The parser generator requires a `free_foo` function for each struct
1101 that stores attributes and they will be `exec`s of subtypes there-of.
1102 So we need `free_exec` which can handle all the subtypes, and we need
1103 `free_binode`.
1104
1105 ###### ast functions
1106
1107         static void free_binode(struct binode *b)
1108         {
1109                 if (!b)
1110                         return;
1111                 free_exec(b->left);
1112                 free_exec(b->right);
1113                 free(b);
1114         }
1115
1116 ###### core functions
1117         static void free_exec(struct exec *e)
1118         {
1119                 if (!e)
1120                         return;
1121                 switch(e->type) {
1122                         ## free exec cases
1123                 }
1124         }
1125
1126 ###### forward decls
1127
1128         static void free_exec(struct exec *e);
1129
1130 ###### free exec cases
1131         case Xbinode: free_binode(cast(binode, e)); break;
1132
1133 #### Printing
1134
1135 Printing an `exec` requires that we know the current indent level for
1136 printing line-oriented components.  As will become clear later, we
1137 also want to know what sort of bracketing to use.
1138
1139 ###### ast functions
1140
1141         static void do_indent(int i, char *str)
1142         {
1143                 while (i--)
1144                         printf("    ");
1145                 printf("%s", str);
1146         }
1147
1148 ###### core functions
1149         static void print_binode(struct binode *b, int indent, int bracket)
1150         {
1151                 struct binode *b2;
1152                 switch(b->op) {
1153                 ## print binode cases
1154                 }
1155         }
1156
1157         static void print_exec(struct exec *e, int indent, int bracket)
1158         {
1159                 if (!e)
1160                         return;
1161                 switch (e->type) {
1162                 case Xbinode:
1163                         print_binode(cast(binode, e), indent, bracket); break;
1164                 ## print exec cases
1165                 }
1166         }
1167
1168 ###### forward decls
1169
1170         static void print_exec(struct exec *e, int indent, int bracket);
1171
1172 #### Analysing
1173
1174 As discussed, analysis involves propagating type requirements around
1175 the program and looking for errors.
1176
1177 So `propagate_types` is passed an expected type (being a `vtype`
1178 together with a `bool_permitted` flag) that the `exec` is expected to
1179 return, and returns the type that it does return, either of which can
1180 be `Vunknown`.  An `ok` flag is passed by reference. It is set to `0`
1181 when an error is found, and `2` when any change is made.  If it
1182 remains unchanged at `1`, then no more propagation is needed.
1183
1184 ###### core functions
1185
1186         static enum vtype propagate_types(struct exec *prog, struct parse_context *c, int *ok,
1187                                           enum vtype type, int bool_permitted)
1188         {
1189                 enum vtype t;
1190
1191                 if (!prog)
1192                         return Vnone;
1193
1194                 switch (prog->type) {
1195                 case Xbinode:
1196                 {
1197                         struct binode *b = cast(binode, prog);
1198                         switch (b->op) {
1199                         ## propagate binode cases
1200                         }
1201                         break;
1202                 }
1203                 ## propagate exec cases
1204                 }
1205                 return Vnone;
1206         }
1207
1208 #### Interpreting
1209
1210 Interpreting an `exec` doesn't require anything but the `exec`.  State
1211 is stored in variables and each variable will be directly linked from
1212 within the `exec` tree.  The exception to this is the whole `program`
1213 which needs to look at command line arguments.  The `program` will be
1214 interpreted separately.
1215
1216 Each `exec` can return a value, which may be `Vnone` but shouldn't be `Vunknown`.
1217
1218 ###### core functions
1219
1220         static struct value interp_exec(struct exec *e)
1221         {
1222                 struct value rv;
1223                 rv.vtype = Vnone;
1224                 if (!e)
1225                         return rv;
1226
1227                 switch(e->type) {
1228                 case Xbinode:
1229                 {
1230                         struct binode *b = cast(binode, e);
1231                         struct value left, right;
1232                         left.vtype = right.vtype = Vnone;
1233                         switch (b->op) {
1234                         ## interp binode cases
1235                         }
1236                         free_value(left); free_value(right);
1237                         break;
1238                 }
1239                 ## interp exec cases
1240                 }
1241                 return rv;
1242         }
1243
1244 ## Language elements
1245
1246 Each language element needs to be parsed, printed, analysed,
1247 interpreted, and freed.  There are several, so let's just start with
1248 the easy ones and work our way up.
1249
1250 ### Values
1251
1252 We have already met values as separate objects.  When manifest
1253 constants appear in the program text that must result in an executable
1254 which has a constant value.  So the `val` structure embeds a value in
1255 an executable.
1256
1257 ###### exec type
1258         Xval,
1259
1260 ###### ast
1261         struct val {
1262                 struct exec;
1263                 struct value val;
1264         };
1265
1266 ###### Grammar
1267
1268         $*val
1269         Value ->  True ${
1270                         $0 = new_pos(val, $1);
1271                         $0->val.vtype = Vbool;
1272                         $0->val.bool = 1;
1273                         }$
1274                 | False ${
1275                         $0 = new_pos(val, $1);
1276                         $0->val.vtype = Vbool;
1277                         $0->val.bool = 0;
1278                         }$
1279                 | NUMBER ${
1280                         $0 = new_pos(val, $1);
1281                         $0->val.vtype = Vnum;
1282                         if (number_parse($0->val.num, $0->val.tail, $1.txt) == 0)
1283                                 mpq_init($0->val.num);
1284                         }$
1285                 | STRING ${
1286                         $0 = new_pos(val, $1);
1287                         $0->val.vtype = Vstr;
1288                         string_parse(&$1, '\\', &$0->val.str, $0->val.tail);
1289                         }$
1290                 | MULTI_STRING ${
1291                         $0 = new_pos(val, $1);
1292                         $0->val.vtype = Vstr;
1293                         string_parse(&$1, '\\', &$0->val.str, $0->val.tail);
1294                         }$
1295
1296 ###### print exec cases
1297         case Xval:
1298         {
1299                 struct val *v = cast(val, e);
1300                 if (v->val.vtype == Vstr)
1301                         printf("\"");
1302                 print_value(v->val);
1303                 if (v->val.vtype == Vstr)
1304                         printf("\"");
1305                 break;
1306         }
1307
1308 ###### propagate exec cases
1309                 case Xval:
1310                 {
1311                         struct val *val = cast(val, prog);
1312                         if (!vtype_compat(type, val->val.vtype, bool_permitted)) {
1313                                 type_err(c, "error: expected %1 found %2",
1314                                            prog, type, val->val.vtype);
1315                                 *ok = 0;
1316                         }
1317                         return val->val.vtype;
1318                 }
1319
1320 ###### interp exec cases
1321         case Xval:
1322                 return dup_value(cast(val, e)->val);
1323
1324 ###### ast functions
1325         static void free_val(struct val *v)
1326         {
1327                 if (!v)
1328                         return;
1329                 free_value(v->val);
1330                 free(v);
1331         }
1332
1333 ###### free exec cases
1334         case Xval: free_val(cast(val, e)); break;
1335
1336 ###### ast functions
1337         // Move all nodes from 'b' to 'rv', reversing the order.
1338         // In 'b' 'left' is a list, and 'right' is the last node.
1339         // In 'rv', left' is the first node and 'right' is a list.
1340         static struct binode *reorder_bilist(struct binode *b)
1341         {
1342                 struct binode *rv = NULL;
1343
1344                 while (b) {
1345                         struct exec *t = b->right;
1346                         b->right = rv;
1347                         rv = b;
1348                         if (b->left)
1349                                 b = cast(binode, b->left);
1350                         else
1351                                 b = NULL;
1352                         rv->left = t;
1353                 }
1354                 return rv;
1355         }
1356
1357 ### Variables
1358
1359 Just as we used as `val` to wrap a value into an `exec`, we similarly
1360 need a `var` to wrap a `variable` into an exec.  While each `val`
1361 contained a copy of the value, each `var` hold a link to the variable
1362 because it really is the same variable no matter where it appears.
1363 When a variable is used, we need to remember to follow the `->merged`
1364 link to find the primary instance.
1365
1366 ###### exec type
1367         Xvar,
1368
1369 ###### ast
1370         struct var {
1371                 struct exec;
1372                 struct variable *var;
1373         };
1374
1375 ###### Grammar
1376
1377         $*var
1378         VariableDecl -> IDENTIFIER := ${ {
1379                 struct variable *v = var_decl(config2context(config), $1.txt);
1380                 $0 = new_pos(var, $1);
1381                 $0->var = v;
1382                 if (v)
1383                         v->where_decl = $0;
1384                 else {
1385                         v = var_ref(config2context(config), $1.txt);
1386                         $0->var = v;
1387                         type_err(config2context(config), "error: variable '%v' redeclared",
1388                                  $0, Vnone, Vnone);
1389                         type_err(config2context(config), "info: this is where '%v' was first declared",
1390                                  v->where_decl, Vnone, Vnone);
1391                 }
1392         } }$
1393             | IDENTIFIER ::= ${ {
1394                 struct variable *v = var_decl(config2context(config), $1.txt);
1395                 $0 = new_pos(var, $1);
1396                 $0->var = v;
1397                 if (v) {
1398                         v->where_decl = $0;
1399                         v->constant = 1;
1400                 } else {
1401                         v = var_ref(config2context(config), $1.txt);
1402                         $0->var = v;
1403                         type_err(config2context(config), "error: variable '%v' redeclared",
1404                                  $0, Vnone, Vnone);
1405                         type_err(config2context(config), "info: this is where '%v' was first declared",
1406                                  v->where_decl, Vnone, Vnone);
1407                 }
1408         } }$
1409
1410         Variable -> IDENTIFIER ${ {
1411                 struct variable *v = var_ref(config2context(config), $1.txt);
1412                 $0 = new_pos(var, $1);
1413                 if (v == NULL) {
1414                         /* This might be a label - allocate a var just in case */
1415                         v = var_decl(config2context(config), $1.txt);
1416                         if (v) {
1417                                 val_init(&v->val, Vlabel);
1418                                 v->where_set = $0;
1419                         }
1420                 }
1421                 $0->var = v;
1422         } }$
1423
1424 ###### print exec cases
1425         case Xvar:
1426         {
1427                 struct var *v = cast(var, e);
1428                 if (v->var) {
1429                         struct binding *b = v->var->name;
1430                         printf("%.*s", b->name.len, b->name.txt);
1431                 }
1432                 break;
1433         }
1434
1435 ###### format cases
1436         case 'v':
1437                 if (loc->type == Xvar) {
1438                         struct var *v = cast(var, loc);
1439                         if (v->var) {
1440                                 struct binding *b = v->var->name;
1441                                 fprintf(stderr, "%.*s", b->name.len, b->name.txt);
1442                         } else
1443                                 fputs("???", stderr);
1444                 } else
1445                         fputs("NOTVAR", stderr);
1446                 break;
1447
1448 ###### propagate exec cases
1449
1450         case Xvar:
1451         {
1452                 struct var *var = cast(var, prog);
1453                 struct variable *v = var->var;
1454                 if (!v) {
1455                         type_err(c, "%d:BUG: no variable!!", prog, Vnone, Vnone);
1456                         *ok = 0;
1457                         return Vnone;
1458                 }
1459                 if (v->merged)
1460                         v = v->merged;
1461                 if (v->val.vtype == Vunknown) {
1462                         if (type > Vunknown && *ok != 0) {
1463                                 val_init(&v->val, type);
1464                                 v->where_set = prog;
1465                                 *ok = 2;
1466                         }
1467                         return type;
1468                 }
1469                 if (!vtype_compat(type, v->val.vtype, bool_permitted)) {
1470                         type_err(c, "error: expected %1 but variable '%v' is %2", prog,
1471                                  type, v->val.vtype);
1472                         type_err(c, "info: this is where '%v' was set to %1", v->where_set,
1473                                  v->val.vtype, Vnone);
1474                         *ok = 0;
1475                 }
1476                 if (type <= Vunknown)
1477                         return v->val.vtype;
1478                 return type;
1479         }
1480
1481 ###### interp exec cases
1482         case Xvar:
1483         {
1484                 struct var *var = cast(var, e);
1485                 struct variable *v = var->var;
1486
1487                 if (v->merged)
1488                         v = v->merged;
1489                 return dup_value(v->val);
1490         }
1491
1492 ###### ast functions
1493
1494         static void free_var(struct var *v)
1495         {
1496                 free(v);
1497         }
1498
1499 ###### free exec cases
1500         case Xvar: free_var(cast(var, e)); break;
1501
1502 ### Expressions: Boolean
1503
1504 Our first user of the `binode` will be expressions, and particularly
1505 Boolean expressions.  As I haven't implemented precedence in the
1506 parser generator yet, we need different names from each precedence
1507 level used by expressions.  The outer most or lowest level precedence
1508 are Boolean `or` `and`, and `not` which form an `Expression` out of `BTerm`s
1509 and `BFact`s.
1510
1511 ###### Binode types
1512         And,
1513         Or,
1514         Not,
1515
1516 ####### Grammar
1517
1518         $*exec
1519         Expression -> Expression or BTerm ${ {
1520                         struct binode *b = new(binode);
1521                         b->op = Or;
1522                         b->left = $<1;
1523                         b->right = $<3;
1524                         $0 = b;
1525                 } }$
1526                 | BTerm ${ $0 = $<1; }$
1527
1528         BTerm -> BTerm and BFact ${ {
1529                         struct binode *b = new(binode);
1530                         b->op = And;
1531                         b->left = $<1;
1532                         b->right = $<3;
1533                         $0 = b;
1534                 } }$
1535                 | BFact ${ $0 = $<1; }$
1536
1537         BFact -> not BFact ${ {
1538                         struct binode *b = new(binode);
1539                         b->op = Not;
1540                         b->right = $<2;
1541                         $0 = b;
1542                 } }$
1543                 ## other BFact
1544
1545 ###### print binode cases
1546         case And:
1547                 print_exec(b->left, -1, 0);
1548                 printf(" and ");
1549                 print_exec(b->right, -1, 0);
1550                 break;
1551         case Or:
1552                 print_exec(b->left, -1, 0);
1553                 printf(" or ");
1554                 print_exec(b->right, -1, 0);
1555                 break;
1556         case Not:
1557                 printf("not ");
1558                 print_exec(b->right, -1, 0);
1559                 break;
1560
1561 ###### propagate binode cases
1562         case And:
1563         case Or:
1564         case Not:
1565                 /* both must be Vbool, result is Vbool */
1566                 propagate_types(b->left, c, ok, Vbool, 0);
1567                 propagate_types(b->right, c, ok, Vbool, 0);
1568                 if (type != Vbool && type > Vunknown) {
1569                         type_err(c, "error: %1 operation found where %2 expected", prog,
1570                                    Vbool, type);
1571                         *ok = 0;
1572                 }
1573                 return Vbool;
1574
1575 ###### interp binode cases
1576         case And:
1577                 rv = interp_exec(b->left);
1578                 right = interp_exec(b->right);
1579                 rv.bool = rv.bool && right.bool;
1580                 break;
1581         case Or:
1582                 rv = interp_exec(b->left);
1583                 right = interp_exec(b->right);
1584                 rv.bool = rv.bool || right.bool;
1585                 break;
1586         case Not:
1587                 rv = interp_exec(b->right);
1588                 rv.bool = !rv.bool;
1589                 break;
1590
1591 ### Expressions: Comparison
1592
1593 Of slightly higher precedence that Boolean expressions are
1594 Comparisons.
1595 A comparison takes arguments of any type, but the two types must be
1596 the same.
1597
1598 To simplify the parsing we introduce an `eop` which can return an
1599 expression operator.
1600
1601 ###### ast
1602         struct eop {
1603                 enum Btype op;
1604         };
1605
1606 ###### ast functions
1607         static void free_eop(struct eop *e)
1608         {
1609                 if (e)
1610                         free(e);
1611         }
1612
1613 ###### Binode types
1614         Less,
1615         Gtr,
1616         LessEq,
1617         GtrEq,
1618         Eql,
1619         NEql,
1620
1621 ###### other BFact
1622         | Expr CMPop Expr ${ {
1623                         struct binode *b = new(binode);
1624                         b->op = $2.op;
1625                         b->left = $<1;
1626                         b->right = $<3;
1627                         $0 = b;
1628         } }$
1629         | Expr ${ $0 = $<1; }$
1630
1631 ###### Grammar
1632
1633         $eop
1634         CMPop ->   < ${ $0.op = Less; }$
1635                 |  > ${ $0.op = Gtr; }$
1636                 |  <= ${ $0.op = LessEq; }$
1637                 |  >= ${ $0.op = GtrEq; }$
1638                 |  == ${ $0.op = Eql; }$
1639                 |  != ${ $0.op = NEql; }$
1640
1641 ###### print binode cases
1642
1643         case Less:
1644         case LessEq:
1645         case Gtr:
1646         case GtrEq:
1647         case Eql:
1648         case NEql:
1649                 print_exec(b->left, -1, 0);
1650                 switch(b->op) {
1651                 case Less:   printf(" < "); break;
1652                 case LessEq: printf(" <= "); break;
1653                 case Gtr:    printf(" > "); break;
1654                 case GtrEq:  printf(" >= "); break;
1655                 case Eql:    printf(" == "); break;
1656                 case NEql:   printf(" != "); break;
1657                 default: abort();
1658                 }
1659                 print_exec(b->right, -1, 0);
1660                 break;
1661
1662 ###### propagate binode cases
1663         case Less:
1664         case LessEq:
1665         case Gtr:
1666         case GtrEq:
1667         case Eql:
1668         case NEql:
1669                 /* Both must match but not labels, result is Vbool */
1670                 t = propagate_types(b->left, c, ok, Vnolabel, 0);
1671                 if (t > Vunknown)
1672                         propagate_types(b->right, c, ok, t, 0);
1673                 else {
1674                         t = propagate_types(b->right, c, ok, Vnolabel, 0);
1675                         if (t > Vunknown)
1676                                 t = propagate_types(b->left, c, ok, t, 0);
1677                 }
1678                 if (!vtype_compat(type, Vbool, 0)) {
1679                         type_err(c, "error: Comparison returns %1 but %2 expected", prog,
1680                                     Vbool, type);
1681                         *ok = 0;
1682                 }
1683                 return Vbool;
1684
1685 ###### interp binode cases
1686         case Less:
1687         case LessEq:
1688         case Gtr:
1689         case GtrEq:
1690         case Eql:
1691         case NEql:
1692         {
1693                 int cmp;
1694                 left = interp_exec(b->left);
1695                 right = interp_exec(b->right);
1696                 cmp = value_cmp(left, right);
1697                 rv.vtype = Vbool;
1698                 switch (b->op) {
1699                 case Less:      rv.bool = cmp <  0; break;
1700                 case LessEq:    rv.bool = cmp <= 0; break;
1701                 case Gtr:       rv.bool = cmp >  0; break;
1702                 case GtrEq:     rv.bool = cmp >= 0; break;
1703                 case Eql:       rv.bool = cmp == 0; break;
1704                 case NEql:      rv.bool = cmp != 0; break;
1705                 default: rv.bool = 0; break;
1706                 }
1707                 break;
1708         }
1709
1710 ### Expressions: The rest
1711
1712 The remaining expressions with the highest precedence are arithmetic
1713 and string concatenation.  There are `Expr`, `Term`, and `Factor`.
1714 The `Factor` is where the `Value` and `Variable` that we already have
1715 are included.
1716
1717 `+` and `-` are both infix and prefix operations (where they are
1718 absolute value and negation).  These have different operator names.
1719
1720 We also have a 'Bracket' operator which records where parentheses were
1721 found.  This make it easy to reproduce these when printing.  Once
1722 precedence is handled better I might be able to discard this.
1723
1724 ###### Binode types
1725         Plus, Minus,
1726         Times, Divide,
1727         Concat,
1728         Absolute, Negate,
1729         Bracket,
1730
1731 ###### Grammar
1732
1733         $*exec
1734         Expr -> Expr Eop Term ${ {
1735                         struct binode *b = new(binode);
1736                         b->op = $2.op;
1737                         b->left = $<1;
1738                         b->right = $<3;
1739                         $0 = b;
1740                 } }$
1741                 | Term ${ $0 = $<1; }$
1742
1743         Term -> Term Top Factor ${ {
1744                         struct binode *b = new(binode);
1745                         b->op = $2.op;
1746                         b->left = $<1;
1747                         b->right = $<3;
1748                         $0 = b;
1749                 } }$
1750                 | Factor ${ $0 = $<1; }$
1751
1752         Factor -> ( Expression ) ${ {
1753                         struct binode *b = new_pos(binode, $1);
1754                         b->op = Bracket;
1755                         b->right = $<2;
1756                         $0 = b;
1757                 } }$
1758                 | Uop Factor ${ {
1759                         struct binode *b = new(binode);
1760                         b->op = $1.op;
1761                         b->right = $<2;
1762                         $0 = b;
1763                 } }$
1764                 | Value ${ $0 = $<1; }$
1765                 | Variable ${ $0 = $<1; }$
1766
1767         $eop
1768         Eop ->    + ${ $0.op = Plus; }$
1769                 | - ${ $0.op = Minus; }$
1770
1771         Uop ->    + ${ $0.op = Absolute; }$
1772                 | - ${ $0.op = Negate; }$
1773
1774         Top ->    * ${ $0.op = Times; }$
1775                 | / ${ $0.op = Divide; }$
1776                 | ++ ${ $0.op = Concat; }$
1777
1778 ###### print binode cases
1779         case Plus:
1780         case Minus:
1781         case Times:
1782         case Divide:
1783         case Concat:
1784                 print_exec(b->left, indent, 0);
1785                 switch(b->op) {
1786                 case Plus:   printf(" + "); break;
1787                 case Minus:  printf(" - "); break;
1788                 case Times:  printf(" * "); break;
1789                 case Divide: printf(" / "); break;
1790                 case Concat: printf(" ++ "); break;
1791                 default: abort();
1792                 }
1793                 print_exec(b->right, indent, 0);
1794                 break;
1795         case Absolute:
1796                 printf("+");
1797                 print_exec(b->right, indent, 0);
1798                 break;
1799         case Negate:
1800                 printf("-");
1801                 print_exec(b->right, indent, 0);
1802                 break;
1803         case Bracket:
1804                 printf("(");
1805                 print_exec(b->right, indent, 0);
1806                 printf(")");
1807                 break;
1808
1809 ###### propagate binode cases
1810         case Plus:
1811         case Minus:
1812         case Times:
1813         case Divide:
1814                 /* both must be numbers, result is Vnum */
1815         case Absolute:
1816         case Negate:
1817                 /* as propagate_types ignores a NULL,
1818                  * unary ops fit here too */
1819                 propagate_types(b->left, c, ok, Vnum, 0);
1820                 propagate_types(b->right, c, ok, Vnum, 0);
1821                 if (!vtype_compat(type, Vnum, 0)) {
1822                         type_err(c, "error: Arithmetic returns %1 but %2 expected", prog,
1823                                    Vnum, type);
1824                         *ok = 0;
1825                 }
1826                 return Vnum;
1827
1828         case Concat:
1829                 /* both must be Vstr, result is Vstr */
1830                 propagate_types(b->left, c, ok, Vstr, 0);
1831                 propagate_types(b->right, c, ok, Vstr, 0);
1832                 if (!vtype_compat(type, Vstr, 0)) {
1833                         type_err(c, "error: Concat returns %1 but %2 expected", prog,
1834                                    Vstr, type);
1835                         *ok = 0;
1836                 }
1837                 return Vstr;
1838
1839         case Bracket:
1840                 return propagate_types(b->right, c, ok, type, 0);
1841
1842 ###### interp binode cases
1843
1844         case Plus:
1845                 rv = interp_exec(b->left);
1846                 right = interp_exec(b->right);
1847                 mpq_add(rv.num, rv.num, right.num);
1848                 break;
1849         case Minus:
1850                 rv = interp_exec(b->left);
1851                 right = interp_exec(b->right);
1852                 mpq_sub(rv.num, rv.num, right.num);
1853                 break;
1854         case Times:
1855                 rv = interp_exec(b->left);
1856                 right = interp_exec(b->right);
1857                 mpq_mul(rv.num, rv.num, right.num);
1858                 break;
1859         case Divide:
1860                 rv = interp_exec(b->left);
1861                 right = interp_exec(b->right);
1862                 mpq_div(rv.num, rv.num, right.num);
1863                 break;
1864         case Negate:
1865                 rv = interp_exec(b->right);
1866                 mpq_neg(rv.num, rv.num);
1867                 break;
1868         case Absolute:
1869                 rv = interp_exec(b->right);
1870                 mpq_abs(rv.num, rv.num);
1871                 break;
1872         case Bracket:
1873                 rv = interp_exec(b->right);
1874                 break;
1875         case Concat:
1876                 left = interp_exec(b->left);
1877                 right = interp_exec(b->right);
1878                 rv.vtype = Vstr;
1879                 rv.str = text_join(left.str, right.str);
1880                 break;
1881
1882 ### Blocks, Statements, and Statement lists.
1883
1884 Now that we have expressions out of the way we need to turn to
1885 statements.  There are simple statements and more complex statements.
1886 Simple statements do not contain newlines, complex statements do.
1887
1888 Statements often come in sequences and we have corresponding simple
1889 statement lists and complex statement lists.
1890 The former comprise only simple statements separated by semicolons.
1891 The later comprise complex statements and simple statement lists.  They are
1892 separated by newlines.  Thus the semicolon is only used to separate
1893 simple statements on the one line.  This may be overly restrictive,
1894 but I'm not sure I every want a complex statement to share a line with
1895 anything else.
1896
1897 Note that a simple statement list can still use multiple lines if
1898 subsequent lines are indented, so
1899
1900 ###### Example: wrapped simple statement list
1901
1902         a = b; c = d;
1903            e = f; print g
1904
1905 is a single simple statement list.  This might allow room for
1906 confusion, so I'm not set on it yet.
1907
1908 A simple statement list needs no extra syntax.  A complex statement
1909 list has two syntactic forms.  It can be enclosed in braces (much like
1910 C blocks), or it can be introduced by a colon and continue until an
1911 unindented newline (much like Python blocks).  With this extra syntax
1912 it is referred to as a block.
1913
1914 Note that a block does not have to include any newlines if it only
1915 contains simple statements.  So both of:
1916
1917         if condition: a=b; d=f
1918
1919         if condition { a=b; print f }
1920
1921 are valid.
1922
1923 In either case the list is constructed from a `binode` list with
1924 `Block` as the operator.  When parsing the list it is most convenient
1925 to append to the end, so a list is a list and a statement.  When using
1926 the list it is more convenient to consider a list to be a statement
1927 and a list.  So we need a function to re-order a list.
1928 `reorder_bilist` serves this purpose.
1929
1930 The only stand-alone statement we introduce at this stage is `pass`
1931 which does nothing and is represented as a `NULL` pointer in a `Block`
1932 list.
1933
1934 ###### Binode types
1935         Block,
1936
1937 ###### Grammar
1938
1939         $void
1940         OptNL -> Newlines
1941                 |
1942
1943         Newlines -> NEWLINE
1944                 | Newlines NEWLINE
1945
1946         $*binode
1947         Open -> {
1948                 | NEWLINE {
1949         Close -> }
1950                 | NEWLINE }
1951         Block -> Open Statementlist Close ${ $0 = $<2; }$
1952                 | Open Newlines Statementlist Close ${ $0 = $<3; }$
1953                 | Open SimpleStatements } ${ $0 = reorder_bilist($<2); }$
1954                 | Open Newlines SimpleStatements } ${ $0 = reorder_bilist($<3); }$
1955                 | : Statementlist ${ $0 = $<2; }$
1956                 | : SimpleStatements ${ $0 = reorder_bilist($<2); }$
1957
1958         Statementlist -> ComplexStatements ${ $0 = reorder_bilist($<1); }$
1959
1960         ComplexStatements -> ComplexStatements ComplexStatement ${
1961                 $0 = new(binode);
1962                 $0->op = Block;
1963                 $0->left = $<1;
1964                 $0->right = $<2;
1965                 }$
1966                 | ComplexStatements NEWLINE ${ $0 = $<1; }$
1967                 | ComplexStatement ${
1968                 $0 = new(binode);
1969                 $0->op = Block;
1970                 $0->left = NULL;
1971                 $0->right = $<1;
1972                 }$
1973
1974         $*exec
1975         ComplexStatement -> SimpleStatements NEWLINE ${
1976                         $0 = reorder_bilist($<1);
1977                         }$
1978                 ## ComplexStatement Grammar
1979
1980         $*binode
1981         SimpleStatements -> SimpleStatements ; SimpleStatement ${
1982                         $0 = new(binode);
1983                         $0->op = Block;
1984                         $0->left = $<1;
1985                         $0->right = $<3;
1986                         }$
1987                 | SimpleStatement ${
1988                         $0 = new(binode);
1989                         $0->op = Block;
1990                         $0->left = NULL;
1991                         $0->right = $<1;
1992                         }$
1993                 | SimpleStatements ; ${ $0 = $<1; }$
1994
1995         SimpleStatement -> pass ${ $0 = NULL; }$
1996                 ## SimpleStatement Grammar
1997
1998 ###### print binode cases
1999         case Block:
2000                 if (indent < 0) {
2001                         // simple statement
2002                         if (b->left == NULL)
2003                                 printf("pass");
2004                         else
2005                                 print_exec(b->left, indent, 0);
2006                         if (b->right) {
2007                                 printf("; ");
2008                                 print_exec(b->right, indent, 0);
2009                         }
2010                 } else {
2011                         // block, one per line
2012                         if (b->left == NULL)
2013                                 do_indent(indent, "pass\n");
2014                         else
2015                                 print_exec(b->left, indent, bracket);
2016                         if (b->right)
2017                                 print_exec(b->right, indent, bracket);
2018                 }
2019                 break;
2020
2021 ###### propagate binode cases
2022         case Block:
2023         {
2024                 /* If any statement returns something other then Vnone
2025                  * or Vbool then all such must return same type.
2026                  * As each statement may be Vnone or something else,
2027                  * we must always pass Vunknown down, otherwise an incorrect
2028                  * error might occur.  We never return Vnone unless it is
2029                  * passed in.
2030                  */
2031                 struct binode *e;
2032
2033                 for (e = b; e; e = cast(binode, e->right)) {
2034                         t = propagate_types(e->left, c, ok, Vunknown, bool_permitted);
2035                         if (bool_permitted && t == Vbool)
2036                                 t = Vunknown;
2037                         if (t != Vunknown && t != Vnone && t != Vbool) {
2038                                 if (type == Vunknown)
2039                                         type = t;
2040                                 else if (t != type) {
2041                                         type_err(c, "error: expected %1, found %2",
2042                                                  e->left, type, t);
2043                                         *ok = 0;
2044                                 }
2045                         }
2046                 }
2047                 return type;
2048         }
2049
2050 ###### interp binode cases
2051         case Block:
2052                 while (rv.vtype == Vnone &&
2053                        b) {
2054                         if (b->left)
2055                                 rv = interp_exec(b->left);
2056                         b = cast(binode, b->right);
2057                 }
2058                 break;
2059
2060 ### The Print statement
2061
2062 `print` is a simple statement that takes a comma-separated list of
2063 expressions and prints the values separated by spaces and terminated
2064 by a newline.  No control of formatting is possible.
2065
2066 `print` faces the same list-ordering issue as blocks, and uses the
2067 same solution.
2068
2069 ###### Binode types
2070         Print,
2071
2072 ###### SimpleStatement Grammar
2073
2074         | print ExpressionList ${
2075                 $0 = reorder_bilist($<2);
2076         }$
2077         | print ExpressionList , ${
2078                 $0 = new(binode);
2079                 $0->op = Print;
2080                 $0->right = NULL;
2081                 $0->left = $<2;
2082                 $0 = reorder_bilist($0);
2083         }$
2084         | print ${
2085                 $0 = new(binode);
2086                 $0->op = Print;
2087                 $0->right = NULL;
2088         }$
2089
2090 ###### Grammar
2091
2092         $*binode
2093         ExpressionList -> ExpressionList , Expression ${
2094                 $0 = new(binode);
2095                 $0->op = Print;
2096                 $0->left = $<1;
2097                 $0->right = $<3;
2098                 }$
2099                 | Expression ${
2100                         $0 = new(binode);
2101                         $0->op = Print;
2102                         $0->left = NULL;
2103                         $0->right = $<1;
2104                 }$
2105
2106 ###### print binode cases
2107
2108         case Print:
2109                 do_indent(indent, "print");
2110                 while (b) {
2111                         if (b->left) {
2112                                 printf(" ");
2113                                 print_exec(b->left, -1, 0);
2114                                 if (b->right)
2115                                         printf(",");
2116                         }
2117                         b = cast(binode, b->right);
2118                 }
2119                 if (indent >= 0)
2120                         printf("\n");
2121                 break;
2122
2123 ###### propagate binode cases
2124
2125         case Print:
2126                 /* don't care but all must be consistent */
2127                 propagate_types(b->left, c, ok, Vnolabel, 0);
2128                 propagate_types(b->right, c, ok, Vnolabel, 0);
2129                 break;
2130
2131 ###### interp binode cases
2132
2133         case Print:
2134         {
2135                 char sep = 0;
2136                 int eol = 1;
2137                 for ( ; b; b = cast(binode, b->right))
2138                         if (b->left) {
2139                                 if (sep)
2140                                         putchar(sep);
2141                                 left = interp_exec(b->left);
2142                                 print_value(left);
2143                                 free_value(left);
2144                                 if (b->right)
2145                                         sep = ' ';
2146                         } else if (sep)
2147                                 eol = 0;
2148                 left.vtype = Vnone;
2149                 if (eol)
2150                         printf("\n");
2151                 break;
2152         }
2153
2154 ###### Assignment statement
2155
2156 An assignment will assign a value to a variable, providing it hasn't
2157 be declared as a constant.  The analysis phase ensures that the type
2158 will be correct so the interpreter just needs to perform the
2159 calculation.  There is a form of assignment which declares a new
2160 variable as well as assigning a value.  If a name is assigned before
2161 it is declared, and error will be raised as the name is created as
2162 `Vlabel` and it is illegal to assign to such names.
2163
2164 ###### Binode types
2165         Assign,
2166         Declare,
2167
2168 ###### SimpleStatement Grammar
2169         | Variable = Expression ${ {
2170                         struct var *v = cast(var, $1);
2171
2172                         $0 = new(binode);
2173                         $0->op = Assign;
2174                         $0->left = $<1;
2175                         $0->right = $<3;
2176                         if (v->var && !v->var->constant) {
2177                                 /* FIXME error? */
2178                         }
2179                 } }$
2180         | VariableDecl Expression ${
2181                         $0 = new(binode);
2182                         $0->op = Declare;
2183                         $0->left = $<1;
2184                         $0->right =$<2;
2185                 }$
2186
2187 ###### print binode cases
2188
2189         case Assign:
2190                 do_indent(indent, "");
2191                 print_exec(b->left, indent, 0);
2192                 printf(" = ");
2193                 print_exec(b->right, indent, 0);
2194                 if (indent >= 0)
2195                         printf("\n");
2196                 break;
2197
2198         case Declare:
2199                 do_indent(indent, "");
2200                 print_exec(b->left, indent, 0);
2201                 if (cast(var, b->left)->var->constant)
2202                         printf(" ::= ");
2203                 else
2204                         printf(" := ");
2205                 print_exec(b->right, indent, 0);
2206                 if (indent >= 0)
2207                         printf("\n");
2208                 break;
2209
2210 ###### propagate binode cases
2211
2212         case Assign:
2213         case Declare:
2214                 /* Both must match and not be labels, result is Vnone */
2215                 t = propagate_types(b->left, c, ok, Vnolabel, 0);
2216                 if (t > Vunknown) {
2217                         if (propagate_types(b->right, c, ok, t, 0) != t)
2218                                 if (b->left->type == Xvar)
2219                                         type_err(c, "info: variable '%v' was set as %1 here.",
2220                                                  cast(var, b->left)->var->where_set, t, Vnone);
2221                 } else {
2222                         t = propagate_types(b->right, c, ok, Vnolabel, 0);
2223                         if (t > Vunknown)
2224                                 propagate_types(b->left, c, ok, t, 0);
2225                 }
2226                 return Vnone;
2227
2228                 break;
2229
2230 ###### interp binode cases
2231
2232         case Assign:
2233         case Declare:
2234         {
2235                 struct variable *v = cast(var, b->left)->var;
2236                 if (v->merged)
2237                         v = v->merged;
2238                 right = interp_exec(b->right);
2239                 free_value(v->val);
2240                 v->val = right;
2241                 right.vtype = Vunknown;
2242                 break;
2243         }
2244
2245 ### The `use` statement
2246
2247 The `use` statement is the last "simple" statement.  It is needed when
2248 the condition in a conditional statement is a block.  `use` works much
2249 like `return` in C, but only completes the `condition`, not the whole
2250 function.
2251
2252 ###### Binode types
2253         Use,
2254
2255 ###### SimpleStatement Grammar
2256         | use Expression ${
2257                 $0 = new_pos(binode, $1);
2258                 $0->op = Use;
2259                 $0->right = $<2;
2260         }$
2261
2262 ###### print binode cases
2263
2264         case Use:
2265                 do_indent(indent, "use ");
2266                 print_exec(b->right, -1, 0);
2267                 if (indent >= 0)
2268                         printf("\n");
2269                 break;
2270
2271 ###### propagate binode cases
2272
2273         case Use:
2274                 /* result matches value */
2275                 return propagate_types(b->right, c, ok, type, 0);
2276
2277 ###### interp binode cases
2278
2279         case Use:
2280                 rv = interp_exec(b->right);
2281                 break;
2282
2283 ### The Conditional Statement
2284
2285 This is the biggy and currently the only complex statement.  This
2286 subsumes `if`, `while`, `do/while`, `switch`, and some parts of `for`.
2287 It is comprised of a number of parts, all of which are optional though
2288 set combinations apply.  Each part is (usually) a key word (`then` is
2289 sometimes optional) followed by either an expression of a code block,
2290 except the `casepart` which is a "key word and an expression" followed
2291 by a code block.  The code-block option is valid for all parts and,
2292 where an expression is also allowed, the code block can use the `use`
2293 statement to report a value.  If the code block does no report a value
2294 the effect is similar to reporting `False`.
2295
2296 The `else` and `case` parts, as well as `then` when combined with
2297 `if`, can contain a `use` statement which will apply to some
2298 containing conditional statement. `for` parts, `do` parts and `then`
2299 parts used with `for` can never contain a `use`, except in some
2300 subordinate conditional statement.
2301
2302 If there is a `forpart`, it is executed first, only once.
2303 If there is a `dopart`, then it is executed repeatedly providing
2304 always that the `condpart` or `cond`, if present, does not return a non-True
2305 value.  `condpart` can fail to return any value if it simply executes
2306 to completion.  This is treated the same as returning `True`.
2307
2308 If there is a `thenpart` it will be executed whenever the `condpart`
2309 or `cond` returns True (or does not return any value), but this will happen
2310 *after* `dopart` (when present).
2311
2312 If `elsepart` is present it will be executed at most once when the
2313 condition returns `False` or some value that isn't `True` and isn't
2314 matched by any `casepart`.  If there are any `casepart`s, they will be
2315 executed when the condition returns a matching value.
2316
2317 The particular sorts of values allowed in case parts has not yet been
2318 determined in the language design, so nothing is prohibited.
2319
2320 The various blocks in this complex statement potentially provide scope
2321 for variables as described earlier.  Each such block must include the
2322 "OpenScope" nonterminal before parsing the block, and must call
2323 `var_block_close()` when closing the block.
2324
2325 The code following "`if`", "`switch`" and "`for`" does not get its own
2326 scope, but is in a scope covering the whole statement, so names
2327 declared there cannot be redeclared elsewhere.  Similarly the
2328 condition following "`while`" is in a scope the covers the body
2329 ("`do`" part) of the loop, and which does not allow conditional scope
2330 extension.  Code following "`then`" (both looping and non-looping),
2331 "`else`" and "`case`" each get their own local scope.
2332
2333 The type requirements on the code block in a `whilepart` are quite
2334 unusal.  It is allowed to return a value of some identifiable type, in
2335 which case the loop abort and an appropriate `casepart` is run, or it
2336 can return a Boolean, in which case the loop either continues to the
2337 `dopart` (on `True`) or aborts and runs the `elsepart` (on `False`).
2338 This is different both from the `ifpart` code block which is expected to
2339 return a Boolean, or the `switchpart` code block which is expected to
2340 return the same type as the casepart values.  The correct analysis of
2341 the type of the `whilepart` code block is the reason for the
2342 `bool_permitted` flag which is passed to `propagate_types()`.
2343
2344 The `cond_statement` cannot fit into a `binode` so a new `exec` is
2345 defined.
2346
2347 ###### exec type
2348         Xcond_statement,
2349
2350 ###### ast
2351         struct casepart {
2352                 struct exec *value;
2353                 struct exec *action;
2354                 struct casepart *next;
2355         };
2356         struct cond_statement {
2357                 struct exec;
2358                 struct exec *forpart, *condpart, *dopart, *thenpart, *elsepart;
2359                 struct casepart *casepart;
2360         };
2361
2362 ###### ast functions
2363
2364         static void free_casepart(struct casepart *cp)
2365         {
2366                 while (cp) {
2367                         struct casepart *t;
2368                         free_exec(cp->value);
2369                         free_exec(cp->action);
2370                         t = cp->next;
2371                         free(cp);
2372                         cp = t;
2373                 }
2374         }
2375
2376         static void free_cond_statement(struct cond_statement *s)
2377         {
2378                 if (!s)
2379                         return;
2380                 free_exec(s->forpart);
2381                 free_exec(s->condpart);
2382                 free_exec(s->dopart);
2383                 free_exec(s->thenpart);
2384                 free_exec(s->elsepart);
2385                 free_casepart(s->casepart);
2386                 free(s);
2387         }
2388
2389 ###### free exec cases
2390         case Xcond_statement: free_cond_statement(cast(cond_statement, e)); break;
2391
2392 ###### ComplexStatement Grammar
2393         | CondStatement ${ $0 = $<1; }$
2394
2395 ###### Grammar
2396
2397         $*cond_statement
2398         // both ForThen and Whilepart open scopes, and CondSuffix only
2399         // closes one - so in the first branch here we have another to close.
2400         CondStatement -> ForThen WhilePart CondSuffix ${
2401                         $0 = $<3;
2402                         $0->forpart = $1.forpart; $1.forpart = NULL;
2403                         $0->thenpart = $1.thenpart; $1.thenpart = NULL;
2404                         $0->condpart = $2.condpart; $2.condpart = NULL;
2405                         $0->dopart = $2.dopart; $2.dopart = NULL;
2406                         var_block_close(config2context(config), CloseSequential);
2407                         }$
2408                 | WhilePart CondSuffix ${
2409                         $0 = $<2;
2410                         $0->condpart = $1.condpart; $1.condpart = NULL;
2411                         $0->dopart = $1.dopart; $1.dopart = NULL;
2412                         }$
2413                 | SwitchPart CondSuffix ${
2414                         $0 = $<2;
2415                         $0->condpart = $<1;
2416                         }$
2417                 | IfPart IfSuffix ${
2418                         $0 = $<2;
2419                         $0->condpart = $1.condpart; $1.condpart = NULL;
2420                         $0->thenpart = $1.thenpart; $1.thenpart = NULL;
2421                         // This is where we close an "if" statement
2422                         var_block_close(config2context(config), CloseSequential);
2423                         }$
2424
2425         CondSuffix -> IfSuffix ${
2426                         $0 = $<1;
2427                         // This is where we close scope of the whole
2428                         // "for" or "while" statement
2429                         var_block_close(config2context(config), CloseSequential);
2430                 }$
2431                 | CasePart CondSuffix ${
2432                         $0 = $<2;
2433                         $1->next = $0->casepart;
2434                         $0->casepart = $<1;
2435                 }$
2436
2437         $*casepart
2438         CasePart -> Newlines case Expression OpenScope Block ${
2439                         $0 = calloc(1,sizeof(struct casepart));
2440                         $0->value = $<3;
2441                         $0->action = $<5;
2442                         var_block_close(config2context(config), CloseParallel);
2443                 }$
2444                 | case Expression OpenScope Block ${
2445                         $0 = calloc(1,sizeof(struct casepart));
2446                         $0->value = $<2;
2447                         $0->action = $<4;
2448                         var_block_close(config2context(config), CloseParallel);
2449                 }$
2450
2451         $*cond_statement
2452         IfSuffix -> Newlines ${ $0 = new(cond_statement); }$
2453                 | Newlines else OpenScope Block ${
2454                         $0 = new(cond_statement);
2455                         $0->elsepart = $<4;
2456                         var_block_close(config2context(config), CloseElse);
2457                 }$
2458                 | else OpenScope Block ${
2459                         $0 = new(cond_statement);
2460                         $0->elsepart = $<3;
2461                         var_block_close(config2context(config), CloseElse);
2462                 }$
2463                 | Newlines else OpenScope CondStatement ${
2464                         $0 = new(cond_statement);
2465                         $0->elsepart = $<4;
2466                         var_block_close(config2context(config), CloseElse);
2467                 }$
2468                 | else OpenScope CondStatement ${
2469                         $0 = new(cond_statement);
2470                         $0->elsepart = $<3;
2471                         var_block_close(config2context(config), CloseElse);
2472                 }$
2473
2474
2475         $*exec
2476         // These scopes are closed in CondSuffix
2477         ForPart -> for OpenScope SimpleStatements ${
2478                         $0 = reorder_bilist($<3);
2479                 }$
2480                 |  for OpenScope Block ${
2481                         $0 = $<3;
2482                 }$
2483
2484         ThenPart -> then OpenScope SimpleStatements ${
2485                         $0 = reorder_bilist($<3);
2486                         var_block_close(config2context(config), CloseSequential);
2487                 }$
2488                 |  then OpenScope Block ${
2489                         $0 = $<3;
2490                         var_block_close(config2context(config), CloseSequential);
2491                 }$
2492
2493         ThenPartNL -> ThenPart OptNL ${
2494                         $0 = $<1;
2495                 }$
2496
2497         // This scope is closed in CondSuffix
2498         WhileHead -> while OpenScope Block ${
2499                 $0 = $<3;
2500                 }$
2501
2502         $cond_statement
2503         ForThen -> ForPart OptNL ThenPartNL ${
2504                         $0.forpart = $<1;
2505                         $0.thenpart = $<3;
2506                 }$
2507                 | ForPart OptNL ${
2508                         $0.forpart = $<1;
2509                 }$
2510
2511         // This scope is closed in CondSuffix
2512         WhilePart -> while OpenScope Expression Block ${
2513                         $0.type = Xcond_statement;
2514                         $0.condpart = $<3;
2515                         $0.dopart = $<4;
2516                 }$
2517                 | WhileHead OptNL do Block ${
2518                         $0.type = Xcond_statement;
2519                         $0.condpart = $<1;
2520                         $0.dopart = $<4;
2521                 }$
2522
2523         IfPart -> if OpenScope Expression OpenScope Block ${
2524                         $0.type = Xcond_statement;
2525                         $0.condpart = $<3;
2526                         $0.thenpart = $<5;
2527                         var_block_close(config2context(config), CloseParallel);
2528                 }$
2529                 | if OpenScope Block OptNL then OpenScope Block ${
2530                         $0.type = Xcond_statement;
2531                         $0.condpart = $<3;
2532                         $0.thenpart = $<7;
2533                         var_block_close(config2context(config), CloseParallel);
2534                 }$
2535
2536         $*exec
2537         // This scope is closed in CondSuffix
2538         SwitchPart -> switch OpenScope Expression ${
2539                         $0 = $<3;
2540                 }$
2541                 | switch OpenScope Block ${
2542                         $0 = $<3;
2543                 }$
2544
2545 ###### print exec cases
2546
2547         case Xcond_statement:
2548         {
2549                 struct cond_statement *cs = cast(cond_statement, e);
2550                 struct casepart *cp;
2551                 if (cs->forpart) {
2552                         do_indent(indent, "for");
2553                         if (bracket) printf(" {\n"); else printf(":\n");
2554                         print_exec(cs->forpart, indent+1, bracket);
2555                         if (cs->thenpart) {
2556                                 if (bracket)
2557                                         do_indent(indent, "} then {\n");
2558                                 else
2559                                         do_indent(indent, "then:\n");
2560                                 print_exec(cs->thenpart, indent+1, bracket);
2561                         }
2562                         if (bracket) do_indent(indent, "}\n");
2563                 }
2564                 if (cs->dopart) {
2565                         // a loop
2566                         if (cs->condpart && cs->condpart->type == Xbinode &&
2567                             cast(binode, cs->condpart)->op == Block) {
2568                                 if (bracket)
2569                                         do_indent(indent, "while {\n");
2570                                 else
2571                                         do_indent(indent, "while:\n");
2572                                 print_exec(cs->condpart, indent+1, bracket);
2573                                 if (bracket)
2574                                         do_indent(indent, "} do {\n");
2575                                 else
2576                                         do_indent(indent, "do:\n");
2577                                 print_exec(cs->dopart, indent+1, bracket);
2578                                 if (bracket)
2579                                         do_indent(indent, "}\n");
2580                         } else {
2581                                 do_indent(indent, "while ");
2582                                 print_exec(cs->condpart, 0, bracket);
2583                                 if (bracket)
2584                                         printf(" {\n");
2585                                 else
2586                                         printf(":\n");
2587                                 print_exec(cs->dopart, indent+1, bracket);
2588                                 if (bracket)
2589                                         do_indent(indent, "}\n");
2590                         }
2591                 } else {
2592                         // a condition
2593                         if (cs->casepart)
2594                                 do_indent(indent, "switch");
2595                         else
2596                                 do_indent(indent, "if");
2597                         if (cs->condpart && cs->condpart->type == Xbinode &&
2598                             cast(binode, cs->condpart)->op == Block) {
2599                                 if (bracket)
2600                                         printf(" {\n");
2601                                 else
2602                                         printf(":\n");
2603                                 print_exec(cs->condpart, indent+1, bracket);
2604                                 if (bracket)
2605                                         do_indent(indent, "}\n");
2606                                 if (cs->thenpart) {
2607                                         do_indent(indent, "then:\n");
2608                                         print_exec(cs->thenpart, indent+1, bracket);
2609                                 }
2610                         } else {
2611                                 printf(" ");
2612                                 print_exec(cs->condpart, 0, bracket);
2613                                 if (cs->thenpart) {
2614                                         if (bracket)
2615                                                 printf(" {\n");
2616                                         else
2617                                                 printf(":\n");
2618                                         print_exec(cs->thenpart, indent+1, bracket);
2619                                         if (bracket)
2620                                                 do_indent(indent, "}\n");
2621                                 } else
2622                                         printf("\n");
2623                         }
2624                 }
2625                 for (cp = cs->casepart; cp; cp = cp->next) {
2626                         do_indent(indent, "case ");
2627                         print_exec(cp->value, -1, 0);
2628                         if (bracket)
2629                                 printf(" {\n");
2630                         else
2631                                 printf(":\n");
2632                         print_exec(cp->action, indent+1, bracket);
2633                         if (bracket)
2634                                 do_indent(indent, "}\n");
2635                 }
2636                 if (cs->elsepart) {
2637                         do_indent(indent, "else");
2638                         if (bracket)
2639                                 printf(" {\n");
2640                         else
2641                                 printf(":\n");
2642                         print_exec(cs->elsepart, indent+1, bracket);
2643                         if (bracket)
2644                                 do_indent(indent, "}\n");
2645                 }
2646                 break;
2647         }
2648
2649 ###### propagate exec cases
2650         case Xcond_statement:
2651         {
2652                 // forpart and dopart must return Vnone
2653                 // thenpart must return Vnone if there is a dopart,
2654                 // otherwise it is like elsepart.
2655                 // condpart must:
2656                 //    be bool if there is not casepart
2657                 //    match casepart->values if there is a switchpart
2658                 //    either be bool or match casepart->value if there
2659                 //             is a whilepart
2660                 // elsepart, casepart->action must match there return type
2661                 // expected of this statement.
2662                 struct cond_statement *cs = cast(cond_statement, prog);
2663                 struct casepart *cp;
2664
2665                 t = propagate_types(cs->forpart, c, ok, Vnone, 0);
2666                 if (!vtype_compat(Vnone, t, 0))
2667                         *ok = 0;
2668                 t = propagate_types(cs->dopart, c, ok, Vnone, 0);
2669                 if (!vtype_compat(Vnone, t, 0))
2670                         *ok = 0;
2671                 if (cs->dopart) {
2672                         t = propagate_types(cs->thenpart, c, ok, Vnone, 0);
2673                         if (!vtype_compat(Vnone, t, 0))
2674                                 *ok = 0;
2675                 }
2676                 if (cs->casepart == NULL)
2677                         propagate_types(cs->condpart, c, ok, Vbool, 0);
2678                 else {
2679                         /* Condpart must match case values, with bool permitted */
2680                         t = Vunknown;
2681                         for (cp = cs->casepart;
2682                              cp && (t == Vunknown); cp = cp->next)
2683                                 t = propagate_types(cp->value, c, ok, Vunknown, 0);
2684                         if (t == Vunknown && cs->condpart)
2685                                 t = propagate_types(cs->condpart, c, ok, Vunknown, 1);
2686                         // Now we have a type (I hope) push it down
2687                         if (t != Vunknown) {
2688                                 for (cp = cs->casepart; cp; cp = cp->next)
2689                                         propagate_types(cp->value, c, ok, t, 0);
2690                                 propagate_types(cs->condpart, c, ok, t, 1);
2691                         }
2692                 }
2693                 // (if)then, else, and case parts must return expected type.
2694                 if (!cs->dopart && type == Vunknown)
2695                         type = propagate_types(cs->thenpart, c, ok, Vunknown, bool_permitted);
2696                 if (type == Vunknown)
2697                         type = propagate_types(cs->elsepart, c, ok, Vunknown, bool_permitted);
2698                 for (cp = cs->casepart;
2699                      cp && type == Vunknown;
2700                      cp = cp->next)
2701                         type = propagate_types(cp->action, c, ok, Vunknown, bool_permitted);
2702                 if (type > Vunknown) {
2703                         if (!cs->dopart)
2704                                 propagate_types(cs->thenpart, c, ok, type, bool_permitted);
2705                         propagate_types(cs->elsepart, c, ok, type, bool_permitted);
2706                         for (cp = cs->casepart; cp ; cp = cp->next)
2707                                 propagate_types(cp->action, c, ok, type, bool_permitted);
2708                         return type;
2709                 } else
2710                         return Vunknown;
2711         }
2712
2713 ###### interp exec cases
2714         case Xcond_statement:
2715         {
2716                 struct value v, cnd;
2717                 struct casepart *cp;
2718                 struct cond_statement *c = cast(cond_statement, e);
2719                 if (c->forpart)
2720                         interp_exec(c->forpart);
2721                 do {
2722                         if (c->condpart)
2723                                 cnd = interp_exec(c->condpart);
2724                         else
2725                                 cnd.vtype = Vnone;
2726                         if (!(cnd.vtype == Vnone ||
2727                               (cnd.vtype == Vbool && cnd.bool != 0)))
2728                                 break;
2729                         if (c->dopart) {
2730                                 free_value(cnd);
2731                                 interp_exec(c->dopart);
2732                         }
2733                         if (c->thenpart) {
2734                                 v = interp_exec(c->thenpart);
2735                                 if (v.vtype != Vnone || !c->dopart)
2736                                         return v;
2737                                 free_value(v);
2738                         }
2739                 } while (c->dopart);
2740
2741                 for (cp = c->casepart; cp; cp = cp->next) {
2742                         v = interp_exec(cp->value);
2743                         if (value_cmp(v, cnd) == 0) {
2744                                 free_value(v);
2745                                 free_value(cnd);
2746                                 return interp_exec(cp->action);
2747                         }
2748                         free_value(v);
2749                 }
2750                 free_value(cnd);
2751                 if (c->elsepart)
2752                         return interp_exec(c->elsepart);
2753                 v.vtype = Vnone;
2754                 return v;
2755         }
2756
2757 ### Finally the whole program.
2758
2759 Somewhat reminiscent of Pascal a (current) Ocean program starts with
2760 the keyword "program" and a list of variable names which are assigned
2761 values from command line arguments.  Following this is a `block` which
2762 is the code to execute.
2763
2764 As this is the top level, several things are handled a bit
2765 differently.
2766 The whole program is not interpreted by `interp_exec` as that isn't
2767 passed the argument list which the program requires.  Similarly type
2768 analysis is a bit more interesting at this level.
2769
2770 ###### Binode types
2771         Program,
2772
2773 ###### Parser: grammar
2774
2775         $*binode
2776         Program -> program OpenScope Varlist Block OptNL ${
2777                 $0 = new(binode);
2778                 $0->op = Program;
2779                 $0->left = reorder_bilist($<3);
2780                 $0->right = $<4;
2781                 var_block_close(config2context(config), CloseSequential);
2782                 if (config2context(config)->scope_stack) abort();
2783                 }$
2784                 | ERROR ${
2785                         fprintf(stderr, "%s:%d:%d: error: unhandled parse error.\n",
2786                                 config2context(config)->file_name, $1.line, $1.col);
2787                         config2context(config)->parse_error = 1;
2788                 }$
2789
2790         Varlist -> Varlist ArgDecl ${
2791                         $0 = new(binode);
2792                         $0->op = Program;
2793                         $0->left = $<1;
2794                         $0->right = $<2;
2795                 }$
2796                 | ${ $0 = NULL; }$
2797
2798         $*var
2799         ArgDecl -> IDENTIFIER ${ {
2800                 struct variable *v = var_decl(config2context(config), $1.txt);
2801                 $0 = new(var);
2802                 $0->var = v;
2803         } }$
2804
2805         ## Grammar
2806
2807 ###### print binode cases
2808         case Program:
2809                 do_indent(indent, "program");
2810                 for (b2 = cast(binode, b->left); b2; b2 = cast(binode, b2->right)) {
2811                         printf(" ");
2812                         print_exec(b2->left, 0, 0);
2813                 }
2814                 if (bracket)
2815                         printf(" {\n");
2816                 else
2817                         printf(":\n");
2818                 print_exec(b->right, indent+1, bracket);
2819                 if (bracket)
2820                         do_indent(indent, "}\n");
2821                 break;
2822
2823 ###### propagate binode cases
2824         case Program: abort();
2825
2826 ###### core functions
2827
2828         static int analyse_prog(struct exec *prog, struct parse_context *c)
2829         {
2830                 struct binode *b = cast(binode, prog);
2831                 int ok = 1;
2832
2833                 if (!b)
2834                         return 0;
2835                 do {
2836                         ok = 1;
2837                         propagate_types(b->right, c, &ok, Vnone, 0);
2838                 } while (ok == 2);
2839                 if (!ok)
2840                         return 0;
2841
2842                 for (b = cast(binode, b->left); b; b = cast(binode, b->right)) {
2843                         struct var *v = cast(var, b->left);
2844                         if (v->var->val.vtype == Vunknown) {
2845                                 v->var->where_set = b;
2846                                 val_init(&v->var->val, Vstr);
2847                         }
2848                 }
2849                 b = cast(binode, prog);
2850                 do {
2851                         ok = 1;
2852                         propagate_types(b->right, c, &ok, Vnone, 0);
2853                 } while (ok == 2);
2854                 if (!ok)
2855                         return 0;
2856
2857                 /* Make sure everything is still consistent */
2858                 propagate_types(b->right, c, &ok, Vnone, 0);
2859                 return !!ok;
2860         }
2861
2862         static void interp_prog(struct exec *prog, char **argv)
2863         {
2864                 struct binode *p = cast(binode, prog);
2865                 struct binode *al;
2866                 struct value v;
2867
2868                 if (!prog)
2869                         return;
2870                 al = cast(binode, p->left);
2871                 while (al) {
2872                         struct var *v = cast(var, al->left);
2873                         struct value *vl = &v->var->val;
2874
2875                         if (argv[0] == NULL) {
2876                                 printf("Not enough args\n");
2877                                 exit(1);
2878                         }
2879                         al = cast(binode, al->right);
2880                         free_value(*vl);
2881                         if (!parse_value(vl, argv[0]))
2882                                 exit(1);
2883                         argv++;
2884                 }
2885                 v = interp_exec(p->right);
2886                 free_value(v);
2887         }
2888
2889 ###### interp binode cases
2890         case Program: abort();
2891
2892 ## And now to test it out.
2893
2894 Having a language requires having a "hello world" program. I'll
2895 provide a little more than that: a program that prints "Hello world"
2896 finds the GCD of two numbers, prints the first few elements of
2897 Fibonacci, and performs a binary search for a number.
2898
2899 ###### File: oceani.mk
2900         tests :: sayhello
2901         sayhello : oceani
2902                 @echo "===== TEST ====="
2903                 ./oceani --section "test: hello" oceani.mdc 55 33
2904
2905 ###### test: hello
2906
2907         program A B:
2908                 print "Hello World, what lovely oceans you have!"
2909                 /* When a variable is defined in both branches of an 'if',
2910                  * and used afterwards, the variables are merged.
2911                  */
2912                 if A > B:
2913                         bigger := "yes"
2914                 else:
2915                         bigger := "no"
2916                 print "Is", A, "bigger than", B,"? ", bigger
2917                 /* If a variable is not used after the 'if', no
2918                  * merge happens, so types can be different
2919                  */
2920                 if A * 2 > B:
2921                         double := "yes"
2922                         print A, "is more than twice", B, "?", double
2923                 else:
2924                         double := A*2
2925                         print "double", A, "is only", double
2926
2927                 a := A; b := B
2928                 if a > 0 and b > 0:
2929                         while a != b:
2930                                 if a < b:
2931                                         b = b - a
2932                                 else:
2933                                         a = a - b
2934                         print "GCD of", A, "and", B,"is", a
2935                 else if a <= 0:
2936                         print a, "is not positive, cannot calculate GCD"
2937                 else:
2938                         print b, "is not positive, cannot calculate GCD"
2939
2940                 for:
2941                         togo := 10
2942                         f1 := 1; f2 := 1
2943                         print "Fibonacci:", f1,f2,
2944                 then togo = togo - 1
2945                 while togo > 0:
2946                         f3 := f1 + f2
2947                         print "", f3,
2948                         f1 = f2
2949                         f2 = f3
2950                 print ""
2951
2952                 /* Binary search... */
2953                 for:
2954                         lo:= 0; hi := 100
2955                         target := 77
2956                 while:
2957                         mid := (lo + hi) / 2
2958                         if mid == target:
2959                                 use Found
2960                         if mid < target:
2961                                 lo = mid
2962                         else:
2963                                 hi = mid
2964                         if hi - lo < 1:
2965                                 use GiveUp
2966                         use True
2967                 do: pass
2968                 case Found:
2969                         print "Yay, I found", target
2970                 case GiveUp:
2971                         print "Closest I found was", mid