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