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

   1 <link href="http://jasonm23.github.io/markdown-css-themes/markdown.css" rel="stylesheet"/>
   2 # Ocean Interpreter - Falls Creek version
   3
   4 Ocean is intended to be an compiled language, so this interpreter is
   5 not targeted at being the final product.  It is very much an intermediate
   6 stage, and fills that role in two distinct ways.
   7
   8 Firstly, it exists as a platform to experiment with the early language
   9 design.  An interpreter is easy to write and easy to get working, so
  10 the barrier for entry is lower if I aim to start with an interpreter.
  11
  12 Secondly, the plan for the Ocean compiler is to write it in the
  13 [Ocean language](http://ocean-lang.org).  To achieve this we naturally
  14 need some sort of boot-strap process and this interpreter - written in
  15 portable C - will fill that role.  It will be used to bootstrap the
  16 Ocean compiler.
  17
  18 Two features that are not needed to fill either of these roles are
  19 performance and completeness.  The interpreter only needs to be fast
  20 enough to run small test programs and occasionally to run the compiler
  21 on itself.  It only needs to be complete enough to test aspects of the
  22 design which are developed before the compiler is working, and to run
  23 the compiler on itself.  Any features not used by the compiler when
  24 compiling itself are superfluous.  They may be included anyway, but
  25 they may not.
  26
  27 Nonetheless, the interpreter should end up being reasonably complete,
  28 and any performance bottlenecks which appear and are easily fixed, will
  29 be.
  30
  31 ## Current version
  32
  33 This initial version of the interpreter exists to test out the
  34 structured statement providing conditions and iteration.  Clearly we
  35 need some minimal other functionality so that values can be tested and
  36 instructions iterated over.  All that functionality is clearly not
  37 normative at this stage (not that anything is **really** normative
  38 yet) and will change, so early test code will certainly break.
  39
  40 Beyond the structured statement and the `use` statement which is
  41 intimately related to it we have:
  42
  43  - "blocks" of multiple statements.
  44  - `pass`: a statement which does nothing.
  45  - variables: any identifier is assumed to store a number, string,
  46    or Boolean.
  47  - expressions: `+`, `-`, `*`, `/` can apply to integers and `++` can
  48    catenate strings.  `and`, `or`, `not` manipulate Booleans, and
  49    normal comparison operators can work on all three types.
  50  - assignments: can assign the value of an expression to a variable.
  51  - `print`: will print the values in a list of expressions.
  52  - `program`: is given a list of identifiers to initialize from
  53    arguments.
  54
  55 ## Naming
  56
  57 Versions of the interpreter which obviously do not support a complete
  58 language will be named after creeks and streams.  This one is Falls
  59 Creek.
  60
  61 Once we have something reasonably resembling a complete language, the
  62 names of rivers will be used.
  63 Early versions of the compiler will be named after seas.  Major
  64 releases of the compiler will be named after oceans.  Hopefully I will
  65 be finished once I get to the Pacific Ocean release.
  66
  67 ## Outline
  68
  69 As well as parsing and executing a program, the interpreter can print
  70 out the program from the parsed internal structure.  This is useful
  71 for validating the parsing.
  72 So the main requirements of the interpreter are:
  73
  74 - Parse the program
  75 - Analyse the parsed program to ensure consistency
  76 - print the program
  77 - execute the program
  78
  79 This is all performed by a single C program extracted with
  80 `parsergen`.
  81
  82 There will be two formats for printing the program a default and one
  83 that uses bracketing.  So an extra command line option is needed for
  84 that.
  85
  86 ###### File: oceani.mk
  87
  88         myCFLAGS := -Wall -g -fplan9-extensions
  89         CFLAGS := $(filter-out $(myCFLAGS),$(CFLAGS)) $(myCFLAGS)
  90         myLDLIBS:= libparser.o libscanner.o libmdcode.o -licuuc
  91         LDLIBS := $(filter-out $(myLDLIBS),$(LDLIBS)) $(myLDLIBS)
  92         ## libs
  93         all :: oceani
  94         oceani.c oceani.h : oceani.mdc parsergen
  95                 ./parsergen -o oceani --LALR --tag Parser oceani.mdc
  96         oceani.mk: oceani.mdc md2c
  97                 ./md2c oceani.mdc
  98
  99         oceani: oceani.o
 100
 101 ###### Parser: header
 102         ## macros
 103         ## ast
 104         struct parse_context {
 105                 struct token_config config;
 106                 ## parse context
 107         };
 108
 109 ###### Parser: code
 110
 111         #include <unistd.h>
 112         #include <stdlib.h>
 113         #include <fcntl.h>
 114         #include <errno.h>
 115         #include <sys/mman.h>
 116         #include <string.h>
 117         #include <stdio.h>
 118         #include <locale.h>
 119         #include <malloc.h>
 120         #include "mdcode.h"
 121         #include "scanner.h"
 122         #include "parser.h"
 123
 124         ## includes
 125
 126         #include "oceani.h"
 127
 128         ## forward decls
 129         ## value functions
 130         ## ast functions
 131         ## core functions
 132
 133         #include <getopt.h>
 134         static char Usage[] = "Usage: oceani --trace --print --noexec prog.ocn\n";
 135         static const struct option long_options[] = {
 136                 {"trace",     0, NULL, 't'},
 137                 {"print",     0, NULL, 'p'},
 138                 {"noexec",    0, NULL, 'n'},
 139                 {"brackets",  0, NULL, 'b'},
 140                 {NULL,        0, NULL, 0},
 141         };
 142         const char *options = "tpnb";
 143         int main(int argc, char *argv[])
 144         {
 145                 int fd;
 146                 int len;
 147                 char *file;
 148                 struct section *s;
 149                 struct parse_context context = {
 150                         .config = {
 151                                 .ignored = (1 << TK_line_comment)
 152                                          | (1 << TK_block_comment),
 153                                 .number_chars = ".,_+-",
 154                                 .word_start = "_",
 155                                 .word_cont = "_",
 156                         },
 157                 };
 158                 int doprint=0, dotrace=0, doexec=1, brackets=0;
 159                 struct exec **prog;
 160                 int opt;
 161                 while ((opt = getopt_long(argc, argv, options, long_options, NULL))
 162                        != -1) {
 163                         switch(opt) {
 164                         case 't': dotrace=1; break;
 165                         case 'p': doprint=1; break;
 166                         case 'n': doexec=0; break;
 167                         case 'b': brackets=1; break;
 168                         default: fprintf(stderr, Usage);
 169                                 exit(1);
 170                         }
 171                 }
 172                 if (optind >= argc) {
 173                         fprintf(stderr, "oceani: no input file given\n");
 174                         exit(1);
 175                 }
 176                 fd = open(argv[optind], O_RDONLY);
 177                 if (fd < 0) {
 178                         fprintf(stderr, "oceani: cannot open %s\n", argv[optind]);
 179                         exit(1);
 180                 }
 181                 len = lseek(fd, 0, 2);
 182                 file = mmap(NULL, len, PROT_READ, MAP_SHARED, fd, 0);
 183                 s = code_extract(file, file+len, NULL);
 184                 if (!s) {
 185                         fprintf(stderr, "oceani: could not find any code in %s\n",
 186                                 argv[optind]);
 187                         exit(1);
 188                 }
 189                 prog = parse_oceani(s->code, &context.config,
 190                                     dotrace ? stderr : NULL);
 191                 if (prog && doprint)
 192                         print_exec(*prog, 0, brackets);
 193                 if (prog && doexec) {
 194                         if (!analyse_prog(*prog, &context)) {
 195                                 fprintf(stderr, "oceani: type error in program\n");
 196                                 exit(1);
 197                         }
 198                         interp_prog(*prog, argv+optind+1);
 199                 }
 200                 if (prog) {
 201                         free_exec(*prog);
 202                         free(prog);
 203                 }
 204                 while (s) {
 205                         struct section *t = s->next;
 206                         code_free(s->code);
 207                         free(s);
 208                         s = t;
 209                 }
 210                 ## free context
 211                 exit(0);
 212         }
 213
 214 ### Analysis
 215
 216 These four requirements of parse, analyse, print, interpret apply to
 217 each language element individually so that is how most of the code
 218 will be structured.
 219
 220 Three of the four are fairly self explanatory.  The one that requires
 221 a little explanation is the analysis step.
 222
 223 The current language design does not require variables to be declared,
 224 but they must have a single type.  Different operations impose
 225 different requirements on the variables, for example addition requires
 226 both arguments to be numeric, and assignment requires the variable on
 227 the left to have the same type as the expression on the right.
 228
 229 Analysis involves propagating these type requirements around
 230 consequently setting the type of each variable.  If any requirements
 231 are violated (e.g. a string is compared with a number) or if a
 232 variable needs to have two different types, then an error is raised
 233 and the program will not run.
 234
 235 Determining the types of all variables early is important for
 236 processing command line arguments.  These can be assigned to any type
 237 of variable, but we must first know the correct type so any required
 238 conversion can happen.  If a variable is associated with a command
 239 line argument but no type can be interpreted (e.g. the variable is
 240 only ever used in a `print` statement), then the type is set to
 241 'string'.
 242
 243 If the type of a variable cannot be determined at all, then it is set
 244 to be a number and given a unique value.  This allows it to fill the
 245 role of a name in an enumerated type, which is useful for testing the
 246 `switch` statement.
 247
 248 ## Data Structures
 249
 250 One last introductory step before detailing the language elements and
 251 providing their four requirements is to establish the data structures
 252 to store these elements.
 253
 254 There are two key objects that we need to work with: executable
 255 elements which comprise the program, and values which the program
 256 works with.  Between these is the set of variables which hold the
 257 values.
 258
 259 ### Values
 260
 261 Values can be numbers, which we represent as multi-precision
 262 fractions, strings and Booleans.  When analysing the program we also
 263 need to allow for places where no value is meaningful (`Vnone`) and
 264 where we don't know what type to expect yet (`Vunknown`).
 265 A 2 character 'tail' is included in each value as the scanner wants
 266 to parse that from the end of numbers and we need somewhere to put
 267 it.  It is currently ignored but one day might allow for
 268 e.g. "imaginary" numbers.
 269
 270 Values are never shared, they are always copied when used, and freed
 271 when no longer needed.
 272
 273 ###### includes
 274         #include <gmp.h>
 275         #include "string.h"
 276         #include "number.h"
 277
 278 ###### libs
 279         myLDLIBS := libnumber.o libstring.o -lgmp
 280         LDLIBS := $(filter-out $(myLDLIBS),$(LDLIBS)) $(myLDLIBS)
 281
 282 ###### ast
 283         struct value {
 284                 enum vtype {Vunknown, Vnone, Vstr, Vnum, Vbool} vtype;
 285                 union {
 286                         struct text str;
 287                         mpq_t num;
 288                         int bool;
 289                 };
 290                 char tail[2];
 291         };
 292
 293 ###### ast functions
 294         void free_value(struct value v)
 295         {
 296                 switch (v.vtype) {
 297                 case Vnone:
 298                 case Vunknown: break;
 299                 case Vstr: free(v.str.txt); break;
 300                 case Vnum: mpq_clear(v.num); break;
 301                 case Vbool: break;
 302                 }
 303         }
 304
 305 ###### value functions
 306
 307         static void val_init(struct value *val, enum vtype type)
 308         {
 309                 val->vtype = type;
 310                 switch(type) {
 311                 case Vnone:abort();
 312                 case Vunknown: break;
 313                 case Vnum:
 314                         mpq_init(val->num); break;
 315                 case Vstr:
 316                         val->str.txt = malloc(1);
 317                         val->str.len = 0;
 318                         break;
 319                 case Vbool:
 320                         val->bool = 0;
 321                         break;
 322                 }
 323         }
 324
 325         static struct value dup_value(struct value v)
 326         {
 327                 struct value rv;
 328                 rv.vtype = v.vtype;
 329                 switch (rv.vtype) {
 330                 case Vnone:
 331                 case Vunknown: break;
 332                 case Vbool:
 333                         rv.bool = v.bool;
 334                         break;
 335                 case Vnum:
 336                         mpq_init(rv.num);
 337                         mpq_set(rv.num, v.num);
 338                         break;
 339                 case Vstr:
 340                         rv.str.len = v.str.len;
 341                         rv.str.txt = malloc(rv.str.len);
 342                         memcpy(rv.str.txt, v.str.txt, v.str.len);
 343                         break;
 344                 }
 345                 return rv;
 346         }
 347
 348         static int value_cmp(struct value left, struct value right)
 349         {
 350                 int cmp;
 351                 if (left.vtype != right.vtype)
 352                         return left.vtype - right.vtype;
 353                 switch (left.vtype) {
 354                 case Vnum: cmp = mpq_cmp(left.num, right.num); break;
 355                 case Vstr: cmp = text_cmp(left.str, right.str); break;
 356                 case Vbool: cmp = left.bool - right.bool; break;
 357                 case Vnone:
 358                 case Vunknown: cmp = 0;
 359                 }
 360                 return cmp;
 361         }
 362
 363         static struct text text_join(struct text a, struct text b)
 364         {
 365                 struct text rv;
 366                 rv.len = a.len + b.len;
 367                 rv.txt = malloc(rv.len);
 368                 memcpy(rv.txt, a.txt, a.len);
 369                 memcpy(rv.txt+a.len, b.txt, b.len);
 370                 return rv;
 371         }
 372
 373         static void print_value(struct value v)
 374         {
 375                 switch (v.vtype) {
 376                 case Vunknown:
 377                         printf("*Unknown*"); break;
 378                 case Vnone:
 379                         printf("*no-value*"); break;
 380                 case Vstr:
 381                         printf("%.*s", v.str.len, v.str.txt); break;
 382                 case Vbool:
 383                         printf("%s", v.bool ? "True":"False"); break;
 384                 case Vnum:
 385                         {
 386                         mpf_t fl;
 387                         mpf_init2(fl, 20);
 388                         mpf_set_q(fl, v.num);
 389                         gmp_printf("%Fg", fl);
 390                         mpf_clear(fl);
 391                         break;
 392                         }
 393                 }
 394         }
 395
 396         static int parse_value(struct value *vl, char *arg)
 397         {
 398                 struct text tx;
 399                 switch(vl->vtype) {
 400                 case Vunknown:
 401                 case Vnone:
 402                         return 0;
 403                 case Vstr:
 404                         vl->str.txt = arg;
 405                         vl->str.len = strlen(arg);
 406                         break;
 407                 case Vnum:
 408                         tx.txt = arg; tx.len = strlen(tx.txt);
 409                         if (number_parse(vl->num, vl->tail, tx) == 0)
 410                                 mpq_init(vl->num);
 411                         break;
 412                 case Vbool:
 413                         if (strcasecmp(arg, "true") == 0 ||
 414                             strcmp(arg, "1") == 0)
 415                                 vl->bool = 1;
 416                         else if (strcasecmp(arg, "false") == 0 ||
 417                             strcmp(arg, "0") == 0)
 418                                 vl->bool = 2;
 419                         else {
 420                                 printf("Bad bool: %s\n", arg);
 421                                 return 0;
 422                         }
 423                         break;
 424                 }
 425                 return 1;
 426         }
 427
 428 ### Variables
 429
 430 Variables are simply named values.  We store them in a linked list
 431 sorted by name and use sequential search and insertion sort.
 432
 433 This linked list is stored in the parse context so that reduce
 434 functions can find or add variables, and so the analysis phase can
 435 ensure that every variable gets a type.
 436
 437 ###### ast
 438
 439         struct variable {
 440                 struct text name;
 441                 struct variable *next;
 442                 struct value val;
 443         };
 444
 445 ###### macros
 446
 447         #define container_of(ptr, type, member) ({                      \
 448                 const typeof( ((type *)0)->member ) *__mptr = (ptr);    \
 449                 (type *)( (char *)__mptr - offsetof(type,member) );})
 450
 451 ###### parse context
 452
 453         struct variable *varlist;
 454
 455 ###### free context
 456         while (context.varlist) {
 457                 struct variable *v = context.varlist;
 458                 context.varlist = v->next;
 459                 free_value(v->val);
 460                 free(v);
 461         }
 462
 463 ###### ast functions
 464
 465         static struct variable *find_variable(struct token_config *conf, struct text s)
 466         {
 467                 struct variable **l = &container_of(conf, struct parse_context,
 468                                                     config)->varlist;
 469                 struct variable *n;
 470                 int cmp = 1;
 471
 472                 while (*l &&
 473                         (cmp = text_cmp((*l)->name, s)) < 0)
 474                                 l = & (*l)->next;
 475                 if (cmp == 0)
 476                         return *l;
 477                 n = calloc(1, sizeof(*n));
 478                 n->name = s;
 479                 n->val.vtype = Vunknown;
 480                 n->next = *l;
 481                 *l = n;
 482                 return n;
 483         }
 484
 485 ### Executables
 486
 487 Executables can be lots of different things.  In many cases an
 488 executable is just an operation combined with one or two other
 489 executables.  This allows for expressions and lists etc.  Other times
 490 an executable is something quite specific like a constant or variable
 491 name.  So we define a `struct exec` to be a general executable with a
 492 type, and a `struct binode` which is a subclass of `exec` and forms a
 493 node in a binary tree and holding an operation. There will be other
 494 subclasses, and to access these we need to be able to `cast` the
 495 `exec` into the various other types.
 496
 497 ###### macros
 498         #define cast(structname, pointer) ({            \
 499                 const typeof( ((struct structname *)0)->type) *__mptr = &(pointer)->type; \
 500                 if (__mptr && *__mptr != X##structname) abort();                \
 501                 (struct structname *)( (char *)__mptr);})
 502
 503         #define new(structname) ({                      \
 504                 struct structname *__ptr = ((struct structname *)calloc(1,sizeof(struct structname))); \
 505                 __ptr->type = X##structname;            \
 506                 __ptr;})
 507
 508 ###### ast
 509         enum exec_types {
 510                 Xbinode,
 511                 ## exec type
 512         };
 513         struct exec {
 514                 enum exec_types type;
 515         };
 516         struct binode {
 517                 struct exec;
 518                 enum Btype {
 519                         ## Binode types
 520                 } op;
 521                 struct exec *left, *right;
 522         };
 523
 524 Each different type of `exec` node needs a number of functions
 525 defined, a bit like methods.  We must be able to be able to free it,
 526 print it, analyse it and execute it.  Once we have specific `exec`
 527 types we will need to parse them to.  Let's take this a bit more
 528 slowly.
 529
 530 #### Freeing
 531
 532 The parser generator requires as `free_foo` function for each struct
 533 that stores attributes and they will be `exec`s of subtypes there-of.
 534 So we need `free_exec` which can handle all the subtypes, and we need
 535 `free_binode`.
 536
 537 ###### ast functions
 538
 539         static void free_binode(struct binode *b)
 540         {
 541                 if (!b)
 542                         return;
 543                 free_exec(b->left);
 544                 free_exec(b->right);
 545                 free(b);
 546         }
 547
 548 ###### core functions
 549         static void free_exec(struct exec *e)
 550         {
 551                 if (!e)
 552                         return;
 553                 switch(e->type) {
 554                         ## free exec cases
 555                 }
 556         }
 557
 558 ###### forward decls
 559
 560         static void free_exec(struct exec *e);
 561
 562 ###### free exec cases
 563         case Xbinode: free_binode(cast(binode, e)); break;
 564
 565 #### Printing
 566
 567 Printing an `exec` requires that we know the current indent level for
 568 printing line-oriented components.  As will become clear later, we
 569 also want to know what sort of bracketing to use.
 570
 571 ###### ast functions
 572
 573         static void do_indent(int i, char *str)
 574         {
 575                 while (i--)
 576                         printf("    ");
 577                 printf("%s", str);
 578         }
 579
 580 ###### core functions
 581         static void print_binode(struct binode *b, int indent, int bracket)
 582         {
 583                 struct binode *b2;
 584                 switch(b->op) {
 585                 ## print binode cases
 586                 }
 587         }
 588
 589         static void print_exec(struct exec *e, int indent, int bracket)
 590         {
 591                 switch (e->type) {
 592                 case Xbinode:
 593                         print_binode(cast(binode, e), indent, bracket); break;
 594                 ## print exec cases
 595                 }
 596         }
 597
 598 ###### forward decls
 599
 600         static void print_exec(struct exec *e, int indent, int bracket);
 601
 602 #### Analysing
 603
 604 As discusses, analysis involves propagating type requirements around
 605 the program and looking for errors.
 606
 607 So propagate_types is passed a type that the `exec` is expected to return,
 608 and returns the type that it does return, either of which can be `Vunknown`.
 609 An `ok` flag is passed by reference. It is set to `0` when an error is
 610 found, and `2` when any change is made.  If it remains unchanged at
 611 `1`, then no more propagation is needed.
 612
 613 ###### core functions
 614
 615         static enum vtype propagate_types(struct exec *prog, enum vtype type,
 616                                           int *ok)
 617         {
 618                 enum vtype t;
 619
 620                 if (!prog) {
 621                         if (type != Vunknown && type != Vnone)
 622                                 *ok = 0;
 623                         return Vnone;
 624                 }
 625
 626                 switch (prog->type) {
 627                 case Xbinode:
 628                 {
 629                         struct binode *b = cast(binode, prog);
 630                         switch (b->op) {
 631                         ## propagate binode cases
 632                         }
 633                         break;
 634                 }
 635                 ## propagate exec cases
 636                 }
 637                 return Vnone;
 638         }
 639
 640 #### Interpreting
 641
 642 Interpreting an `exec` doesn't require anything but the `exec`.  State
 643 is stored in variables and each variable will be directly linked from
 644 within the `exec` tree.  The exception to this is the whole `program`
 645 which needs to look at command line arguments.  The `program` will be
 646 interpreted separately.
 647
 648 Each `exec` can return a value, which may be `Vnone` but shouldn't be `Vunknown`.
 649
 650 ###### core functions
 651
 652         static struct value interp_exec(struct exec *e)
 653         {
 654                 struct value rv;
 655                 rv.vtype = Vnone;
 656                 if (!e)
 657                         return rv;
 658
 659                 switch(e->type) {
 660                 case Xbinode:
 661                 {
 662                         struct binode *b = cast(binode, e);
 663                         struct value left, right;
 664                         left.vtype = right.vtype = Vnone;
 665                         switch (b->op) {
 666                         ## interp binode cases
 667                         }
 668                         free_value(left); free_value(right);
 669                         break;
 670                 }
 671                 ## interp exec cases
 672                 }
 673                 return rv;
 674         }
 675
 676 ## Language elements
 677
 678 Each language element needs to be parsed, printed, analysed,
 679 interpreted, and freed.  There are several, so let's just start with
 680 the easy ones and work our way up.
 681
 682 ### Values
 683
 684 We have already met values and separate objects.  When manifest
 685 constants appear in the program text that must result in an executable
 686 which has a constant value.  So the `val` structure embeds a value in
 687 an executable.
 688
 689 ###### exec type
 690         Xval,
 691
 692 ###### ast
 693         struct val {
 694                 struct exec;
 695                 struct value val;
 696         };
 697
 698 ###### Grammar
 699
 700         $*val
 701         Value ->  True ${
 702                         $0 = new(val);
 703                         $0->val.vtype = Vbool;
 704                         $0->val.bool = 1;
 705                         }$
 706                 | False ${
 707                         $0 = new(val);
 708                         $0->val.vtype = Vbool;
 709                         $0->val.bool = 0;
 710                         }$
 711                 | NUMBER ${
 712                         $0 = new(val);
 713                         $0->val.vtype = Vnum;
 714                         if (number_parse($0->val.num, $0->val.tail, $1.txt) == 0)
 715                                 mpq_init($0->val.num);
 716                         }$
 717                 | STRING ${
 718                         $0 = new(val);
 719                         $0->val.vtype = Vstr;
 720                         string_parse(&$1, '\\', &$0->val.str, $0->val.tail);
 721                         }$
 722
 723 ###### print exec cases
 724         case Xval:
 725         {
 726                 struct val *v = cast(val, e);
 727                 if (v->val.vtype == Vstr)
 728                         printf("\"");
 729                 print_value(v->val);
 730                 if (v->val.vtype == Vstr)
 731                         printf("\"");
 732                 break;
 733         }
 734
 735 ###### propagate exec cases
 736                 case Xval:
 737                 {
 738                         struct val *val = cast(val, prog);
 739                         if (type != Vunknown &&
 740                             type != val->val.vtype)
 741                                 *ok = 0;
 742                         return val->val.vtype;
 743                 }
 744
 745 ###### interp exec cases
 746         case Xval:
 747                 return dup_value(cast(val, e)->val);
 748
 749 ###### ast functions
 750         void free_val(struct val *v)
 751         {
 752                 if (!v)
 753                         return;
 754                 free_value(v->val);
 755                 free(v);
 756         }
 757
 758 ###### free exec cases
 759         case Xval: free_val(cast(val, e)); break;
 760
 761 ###### ast functions
 762         // Move all nodes from 'b' to 'rv', reversing the order.
 763         // In 'b' 'left' is a list, and 'right' is the last node.
 764         // In 'rv', left' is the first node and 'right' is a list.
 765         struct binode *reorder_bilist(struct binode *b)
 766         {
 767                 struct binode *rv = NULL;
 768
 769                 while (b) {
 770                         struct exec *t = b->right;
 771                         b->right = rv;
 772                         rv = b;
 773                         if (b->left)
 774                                 b = cast(binode, b->left);
 775                         else
 776                                 b = NULL;
 777                         rv->left = t;
 778                 }
 779                 return rv;
 780         }
 781
 782 ### Variables
 783
 784 Just as we used as `val` to wrap a value into an `exec`, we similarly
 785 need a `var` to wrap a `variable` into an exec.  While each `val`
 786 contained a copy of the value, each `var` hold a link to the variable
 787 because it really is the same variable no matter where it appears.
 788
 789 ###### exec type
 790         Xvar,
 791
 792 ###### ast
 793         struct var {
 794                 struct exec;
 795                 struct variable *var;
 796         };
 797
 798 ###### Grammar
 799         $*var
 800         Variable -> IDENTIFIER ${
 801                 $0 = new(var);
 802                 $0->var = find_variable(config, $1.txt);
 803         }$
 804
 805 ###### print exec cases
 806         case Xvar:
 807         {
 808                 struct var *v = cast(var, e);
 809                 printf("%.*s", v->var->name.len, v->var->name.txt);
 810                 break;
 811         }
 812
 813 ###### propagate exec cases
 814
 815         case Xvar:
 816         {
 817                 struct var *var = cast(var, prog);
 818                 if (var->var->val.vtype == Vunknown) {
 819                         if (type != Vunknown && *ok != 0) {
 820                                 val_init(&var->var->val, type);
 821                                 *ok = 2;
 822                         }
 823                         return type;
 824                 }
 825                 if (type == Vunknown)
 826                         return var->var->val.vtype;
 827                 if (type != var->var->val.vtype)
 828                         *ok = 0;
 829                 return type;
 830         }
 831
 832 ###### interp exec cases
 833         case Xvar:
 834                 return dup_value(cast(var, e)->var->val);
 835
 836 ###### ast functions
 837
 838         void free_var(struct var *v)
 839         {
 840                 free(v);
 841         }
 842
 843 ###### free exec cases
 844         case Xvar: free_var(cast(var, e)); break;
 845
 846 ### Expressions: Boolean
 847
 848 Our first user of the `binode` will be expressions, and particularly
 849 Boolean expressions.  As I haven't implemented precedence in the
 850 parser generator yet, we need different names from each precedence
 851 level used by expressions.  The outer most or lowest level precedence
 852 are Boolean `or` `and`, and `not` which form and `Expression` our of `BTerm`s
 853 and `BFact`s.
 854
 855 ###### Binode types
 856         And,
 857         Or,
 858         Not,
 859
 860 ####### Grammar
 861
 862         $*binode
 863         Expression -> Expression or BTerm ${
 864                         $0 = new(binode);
 865                         $0->op = Or;
 866                         $0->left = $<1;
 867                         $0->right = $<3;
 868                 }$
 869                 | BTerm ${ $0 = $<1; }$
 870
 871         BTerm -> BTerm and BFact ${
 872                         $0 = new(binode);
 873                         $0->op = And;
 874                         $0->left = $<1;
 875                         $0->right = $<3;
 876                 }$
 877                 | BFact ${ $0 = $<1; }$
 878
 879         BFact -> not BFact ${
 880                         $0 = new(binode);
 881                         $0->op = Not;
 882                         $0->right = $<2;
 883                         }$
 884                 ## other BFact
 885
 886 ###### print binode cases
 887         case And:
 888                 print_exec(b->left, -1, 0);
 889                 printf(" and ");
 890                 print_exec(b->right, -1, 0);
 891                 break;
 892         case Or:
 893                 print_exec(b->left, -1, 0);
 894                 printf(" or ");
 895                 print_exec(b->right, -1, 0);
 896                 break;
 897         case Not:
 898                 printf("not ");
 899                 print_exec(b->right, -1, 0);
 900                 break;
 901
 902 ###### propagate binode cases
 903         case And:
 904         case Or:
 905         case Not:
 906                 /* both must be Vbool, result is Vbool */
 907                 propagate_types(b->left, Vbool, ok);
 908                 propagate_types(b->right, Vbool, ok);
 909                 if (type != Vbool && type != Vunknown)
 910                         *ok = 0;
 911                 return Vbool;
 912
 913 ###### interp binode cases
 914         case And:
 915                 rv = interp_exec(b->left);
 916                 right = interp_exec(b->right);
 917                 rv.bool = rv.bool && right.bool;
 918                 break;
 919         case Or:
 920                 rv = interp_exec(b->left);
 921                 right = interp_exec(b->right);
 922                 rv.bool = rv.bool || right.bool;
 923                 break;
 924         case Not:
 925                 rv = interp_exec(b->right);
 926                 rv.bool = !rv.bool;
 927                 break;
 928
 929 ### Expressions: Comparison
 930
 931 Of slightly higher precedence that Boolean expressions are
 932 Comparisons.
 933 A comparison takes arguments of any type, but the two types must be
 934 the same.
 935
 936 To simplify the parsing we introduce an `eop` which can return an
 937 expression operator.
 938
 939 ###### ast
 940         struct eop {
 941                 enum Btype op;
 942         };
 943
 944 ###### ast functions
 945         static void free_eop(struct eop *e)
 946         {
 947                 if (e)
 948                         free(e);
 949         }
 950
 951 ###### Binode types
 952         Less,
 953         Gtr,
 954         LessEq,
 955         GtrEq,
 956         Eql,
 957         NEql,
 958
 959 ###### other BFact
 960         | Expr CMPop Expr ${
 961                         $0 = new(binode);
 962                         $0->op = $2.op;
 963                         $0->left = $<1;
 964                         $0->right = $<3;
 965                 }$
 966                 | Expr ${ $0 = $<1; }$
 967
 968 ###### Grammar
 969
 970         $eop
 971         CMPop ->   < ${ $0.op = Less; }$
 972                 |  > ${ $0.op = Gtr; }$
 973                 |  <= ${ $0.op = LessEq; }$
 974                 |  >= ${ $0.op = GtrEq; }$
 975                 |  == ${ $0.op = Eql; }$
 976                 |  != ${ $0.op = NEql; }$
 977
 978 ###### print binode cases
 979
 980         case Less:
 981         case LessEq:
 982         case Gtr:
 983         case GtrEq:
 984         case Eql:
 985         case NEql:
 986                 print_exec(b->left, -1, 0);
 987                 switch(b->op) {
 988                 case Less:   printf(" < "); break;
 989                 case LessEq: printf(" <= "); break;
 990                 case Gtr:    printf(" > "); break;
 991                 case GtrEq:  printf(" >= "); break;
 992                 case Eql:    printf(" == "); break;
 993                 case NEql:   printf(" != "); break;
 994                 default: abort();
 995                 }
 996                 print_exec(b->right, -1, 0);
 997                 break;
 998
 999 ###### propagate binode cases
1000         case Less:
1001         case LessEq:
1002         case Gtr:
1003         case GtrEq:
1004         case Eql:
1005         case NEql:
1006                 /* Both must match, result is Vbool */
1007                 t = propagate_types(b->left, Vunknown, ok);
1008                 if (t != Vunknown)
1009                         propagate_types(b->right, t, ok);
1010                 else {
1011                         t = propagate_types(b->right, Vunknown, ok);
1012                         if (t != Vunknown)
1013                                 t = propagate_types(b->left, t, ok);
1014                 }
1015                 if (type != Vbool && type != Vunknown)
1016                         *ok = 0;
1017                 return Vbool;
1018
1019 ###### interp binode cases
1020         case Less:
1021         case LessEq:
1022         case Gtr:
1023         case GtrEq:
1024         case Eql:
1025         case NEql:
1026         {
1027                 int cmp;
1028                 left = interp_exec(b->left);
1029                 right = interp_exec(b->right);
1030                 cmp = value_cmp(left, right);
1031                 rv.vtype = Vbool;
1032                 switch (b->op) {
1033                 case Less:      rv.bool = cmp <  0; break;
1034                 case LessEq:    rv.bool = cmp <= 0; break;
1035                 case Gtr:       rv.bool = cmp >  0; break;
1036                 case GtrEq:     rv.bool = cmp >= 0; break;
1037                 case Eql:       rv.bool = cmp == 0; break;
1038                 case NEql:      rv.bool = cmp != 0; break;
1039                 default: rv.bool = 0; break;
1040                 }
1041                 break;
1042         }
1043
1044 ### Expressions: The rest
1045
1046 The remaining expressions with the highest precedence are arithmetic
1047 and string concatenation.  There are `Expr`, `Term`, and `Factor`.
1048 The `Factor` is where the `Value` and `Variable` that we already have
1049 are included.
1050
1051 `+` and `-` are both infix and prefix operations (where they are
1052 absolute value and negation).  These have different operator names.
1053
1054 We also have a 'Bracket' operator which records where parentheses were
1055 found.  This make it easy to reproduce these when printing.  Once
1056 precedence is handled better I might be able to discard this.
1057
1058 ###### Binode types
1059         Plus, Minus,
1060         Times, Divide,
1061         Concat,
1062         Absolute, Negate,
1063         Bracket,
1064
1065 ###### Grammar
1066
1067         $*binode
1068         Expr -> Expr Eop Term ${
1069                         $0 = new(binode);
1070                         $0->op = $2.op;
1071                         $0->left = $<1;
1072                         $0->right = $<3;
1073                 }$
1074                 | Term ${ $0 = $<1; }$
1075
1076         Term -> Term Top Factor ${
1077                         $0 = new(binode);
1078                         $0->op = $2.op;
1079                         $0->left = $<1;
1080                         $0->right = $<3;
1081                 }$
1082                 | Factor ${ $0 = $<1; }$
1083
1084         Factor -> ( Expression ) ${
1085                         $0 = new(binode);
1086                         $0->op = Bracket;
1087                         $0->right = $<2;
1088                 }$
1089                 | Uop Factor ${
1090                         $0 = new(binode);
1091                         $0->op = $1.op;
1092                         $0->right = $<2;
1093                 }$
1094                 | Value ${ $0 = (struct binode *)$<1; }$
1095                 | Variable ${ $0 = (struct binode *)$<1; }$
1096
1097         $eop
1098         Eop ->    + ${ $0.op = Plus; }$
1099                 | - ${ $0.op = Minus; }$
1100
1101         Uop ->    + ${ $0.op = Absolute; }$
1102                 | - ${ $0.op = Negate; }$
1103
1104         Top ->    * ${ $0.op = Times; }$
1105                 | / ${ $0.op = Divide; }$
1106                 | ++ ${ $0.op = Concat; }$
1107
1108 ###### print binode cases
1109         case Plus:
1110         case Minus:
1111         case Times:
1112         case Divide:
1113         case Concat:
1114                 print_exec(b->left, indent, 0);
1115                 switch(b->op) {
1116                 case Plus:   printf(" + "); break;
1117                 case Minus:  printf(" - "); break;
1118                 case Times:  printf(" * "); break;
1119                 case Divide: printf(" / "); break;
1120                 case Concat: printf(" ++ "); break;
1121                 default: abort();
1122                 }
1123                 print_exec(b->right, indent, 0);
1124                 break;
1125         case Absolute:
1126                 printf("+");
1127                 print_exec(b->right, indent, 0);
1128                 break;
1129         case Negate:
1130                 printf("-");
1131                 print_exec(b->right, indent, 0);
1132                 break;
1133         case Bracket:
1134                 printf("(");
1135                 print_exec(b->right, indent, 0);
1136                 printf(")");
1137                 break;
1138
1139 ###### propagate binode cases
1140         case Plus:
1141         case Minus:
1142         case Times:
1143         case Divide:
1144                 /* both must be numbers, result is Vnum */
1145         case Absolute:
1146         case Negate:
1147                 /* as propagate_types ignores a NULL,
1148                  * unary ops fit here too */
1149                 propagate_types(b->left, Vnum, ok);
1150                 propagate_types(b->right, Vnum, ok);
1151                 if (type != Vnum && type != Vunknown)
1152                         *ok = 0;
1153                 return Vnum;
1154
1155         case Concat:
1156                 /* both must be Vstr, result is Vstr */
1157                 propagate_types(b->left, Vstr, ok);
1158                 propagate_types(b->right, Vstr, ok);
1159                 if (type != Vstr && type != Vunknown)
1160                         *ok = 0;
1161                 return Vstr;
1162
1163         case Bracket:
1164                 return propagate_types(b->right, type, ok);
1165
1166 ###### interp binode cases
1167
1168         case Plus:
1169                 rv = interp_exec(b->left);
1170                 right = interp_exec(b->right);
1171                 mpq_add(rv.num, rv.num, right.num);
1172                 break;
1173         case Minus:
1174                 rv = interp_exec(b->left);
1175                 right = interp_exec(b->right);
1176                 mpq_sub(rv.num, rv.num, right.num);
1177                 break;
1178         case Times:
1179                 rv = interp_exec(b->left);
1180                 right = interp_exec(b->right);
1181                 mpq_mul(rv.num, rv.num, right.num);
1182                 break;
1183         case Divide:
1184                 rv = interp_exec(b->left);
1185                 right = interp_exec(b->right);
1186                 mpq_div(rv.num, rv.num, right.num);
1187                 break;
1188         case Negate:
1189                 rv = interp_exec(b->right);
1190                 mpq_neg(rv.num, rv.num);
1191                 break;
1192         case Absolute:
1193                 rv = interp_exec(b->right);
1194                 mpq_abs(rv.num, rv.num);
1195                 break;
1196         case Bracket:
1197                 rv = interp_exec(b->right);
1198                 break;
1199         case Concat:
1200                 left = interp_exec(b->left);
1201                 right = interp_exec(b->right);
1202                 rv.vtype = Vstr;
1203                 rv.str = text_join(left.str, right.str);
1204                 break;
1205
1206 ### Blocks, Statements, and Statement lists.
1207
1208 Now that we have expressions out of the way we need to turn to
1209 statements.  There are simple statements and more complex statements.
1210 Simple statements do not contain newlines, complex statements do.
1211
1212 Statements often come in sequences and we have corresponding simple
1213 statement lists and complex statement lists.
1214 The former comprise only simple statements separated by semicolons.
1215 The later comprise complex statements and simple statement lists.  They are
1216 separated by newlines.  Thus the semicolon is only used to separate
1217 simple statements on the one line.  This may be overly restrictive,
1218 but I'm not sure I every want a complex statement to share a line with
1219 anything else.
1220
1221 Note that a simple statement list can still use multiple lines if
1222 subsequent lines are indented, so
1223
1224 ###### Example: wrapped simple statement list
1225
1226         a = b; c = d;
1227            e = f; print g
1228
1229 is a single simple statement list.  This might allow room for
1230 confusion, so I'm not set on it yet.
1231
1232 A simple statement list needs no extra syntax.  A complex statement
1233 list has two syntactic forms.  It can be enclosed in braces (much like
1234 C blocks), or it can be introduced by a colon and continue until an
1235 unindented newline (much like Python blocks).  With this extra syntax
1236 it is referred to as a block.
1237
1238 Note that a block does not have to include any newlines if it only
1239 contains simple statements.  So both of:
1240
1241         if condition: a=b; d=f
1242
1243         if condition { a=b; print f }
1244
1245 are valid.
1246
1247 In either case the list is constructed from a `binode` list with
1248 `Block` as the operator.  When parsing the list it is most convenient
1249 to append to the end, so a list is a list and a statement.  When using
1250 the list it is more convenient to consider a list to be a statement
1251 and a list.  So we need a function to re-order a list.
1252 `reorder_bilist` serves this purpose.
1253
1254 The only stand-alone statement we introduce at this stage is `pass`
1255 which does nothing and is represented as a `NULL` pointer in a `Block`
1256 list.
1257
1258 ###### Binode types
1259         Block,
1260
1261 ###### Grammar
1262
1263         $void
1264         OptNL -> Newlines
1265                 |
1266
1267         Newlines -> NEWLINE
1268                 | Newlines NEWLINE
1269
1270         $*binode
1271         Open -> {
1272                 | NEWLINE {
1273         Close -> }
1274                 | NEWLINE }
1275         Block -> Open Statementlist Close ${ $0 = $<2; }$
1276                 | Open SimpleStatements } ${ $0 = reorder_bilist($<2); }$
1277                 | : Statementlist ${ $0 = $<2; }$
1278                 | : SimpleStatements ${ $0 = reorder_bilist($<2); }$
1279
1280         Statementlist -> ComplexStatements ${ $0 = reorder_bilist($<1); }$
1281
1282         ComplexStatements -> ComplexStatements ComplexStatement ${
1283                 $0 = new(binode);
1284                 $0->op = Block;
1285                 $0->left = $<1;
1286                 $0->right = $<2;
1287                 }$
1288                 | ComplexStatements NEWLINE ${ $0 = $<1; }$
1289                 | ComplexStatement ${
1290                 $0 = new(binode);
1291                 $0->op = Block;
1292                 $0->left = NULL;
1293                 $0->right = $<1;
1294                 }$
1295
1296         $*exec
1297         ComplexStatement -> SimpleStatements NEWLINE ${
1298                         $0 = reorder_bilist($<1);
1299                         }$
1300                 ## ComplexStatement Grammar
1301
1302         $*binode
1303         SimpleStatements -> SimpleStatements ; SimpleStatement ${
1304                         $0 = new(binode);
1305                         $0->op = Block;
1306                         $0->left = $<1;
1307                         $0->right = $<3;
1308                         }$
1309                 | SimpleStatement ${
1310                         $0 = new(binode);
1311                         $0->op = Block;
1312                         $0->left = NULL;
1313                         $0->right = $<1;
1314                         }$
1315                 | SimpleStatements ; ${ $0 = $<1; }$
1316
1317         SimpleStatement -> pass ${ $0 = NULL; }$
1318                 ## SimpleStatement Grammar
1319
1320 ###### print binode cases
1321         case Block:
1322                 if (indent < 0) {
1323                         // simple statement
1324                         if (b->left == NULL)
1325                                 printf("pass");
1326                         else
1327                                 print_exec(b->left, indent, 0);
1328                         if (b->right) {
1329                                 printf("; ");
1330                                 print_exec(b->right, indent, 0);
1331                         }
1332                 } else {
1333                         // block, one per line
1334                         if (b->left == NULL)
1335                                 do_indent(indent, "pass\n");
1336                         else
1337                                 print_exec(b->left, indent, bracket);
1338                         if (b->right)
1339                                 print_exec(b->right, indent, bracket);
1340                 }
1341                 break;
1342
1343 ###### propagate binode cases
1344         case Block:
1345         {
1346                 /* If any statement returns something other then Vnone
1347                  * then all such must return same type.
1348                  * As each statement may be Vnone or something else,
1349                  * we must always pass Vunknown down, otherwise an incorrect
1350                  * error might occur.
1351                  */
1352                 struct binode *e;
1353
1354                 for (e = b; e; e = cast(binode, e->right)) {
1355                         t = propagate_types(e->left, Vunknown, ok);
1356                         if (t != Vunknown && t != Vnone) {
1357                                 if (type == Vunknown)
1358                                         type = t;
1359                                 else if (t != type)
1360                                         *ok = 0;
1361                         }
1362                 }
1363                 return type;
1364         }
1365
1366 ###### interp binode cases
1367         case Block:
1368                 while (rv.vtype == Vnone &&
1369                        b) {
1370                         if (b->left)
1371                                 rv = interp_exec(b->left);
1372                         b = cast(binode, b->right);
1373                 }
1374                 break;
1375
1376 ### The Print statement
1377
1378 `print` is a simple statement that takes a comma-separated list of
1379 expressions and prints the values separated by spaces and terminated
1380 by a newline.  No control of formatting is possible.
1381
1382 `print` faces the same list-ordering issue as blocks, and uses the
1383 same solution.
1384
1385 ###### Binode types
1386         Print,
1387
1388 ###### SimpleStatement Grammar
1389
1390         | print ExpressionList ${
1391                 $0 = reorder_bilist($<2);
1392         }$
1393         | print ExpressionList , ${
1394                 $0 = new(binode);
1395                 $0->op = Print;
1396                 $0->right = NULL;
1397                 $0->left = $<2;
1398                 $0 = reorder_bilist($0);
1399         }$
1400         | print ${
1401                 $0 = new(binode);
1402                 $0->op = Print;
1403                 $0->right = NULL;
1404         }$
1405
1406 ###### Grammar
1407
1408         $*binode
1409         ExpressionList -> ExpressionList , Expression ${
1410                 $0 = new(binode);
1411                 $0->op = Print;
1412                 $0->left = $<1;
1413                 $0->right = $<3;
1414                 }$
1415                 | Expression ${
1416                         $0 = new(binode);
1417                         $0->op = Print;
1418                         $0->left = NULL;
1419                         $0->right = $<1;
1420                 }$
1421
1422 ###### print binode cases
1423
1424         case Print:
1425                 do_indent(indent, "print");
1426                 while (b) {
1427                         if (b->left) {
1428                                 printf(" ");
1429                                 print_exec(b->left, -1, 0);
1430                                 if (b->right)
1431                                         printf(",");
1432                         }
1433                         b = cast(binode, b->right);
1434                 }
1435                 if (indent >= 0)
1436                         printf("\n");
1437                 break;
1438
1439 ###### propagate binode cases
1440
1441         case Print:
1442                 /* don't care but all must be consistent */
1443                 propagate_types(b->left, Vunknown, ok);
1444                 propagate_types(b->right, Vunknown, ok);
1445                 break;
1446
1447 ###### interp binode cases
1448
1449         case Print:
1450         {
1451                 char sep = 0;
1452                 int eol = 1;
1453                 for ( ; b; b = cast(binode, b->right))
1454                         if (b->left) {
1455                                 if (sep)
1456                                         putchar(sep);
1457                                 left = interp_exec(b->left);
1458                                 print_value(left);
1459                                 free_value(left);
1460                                 if (b->right)
1461                                         sep = ' ';
1462                         } else if (sep)
1463                                 eol = 0;
1464                 left.vtype = Vnone;
1465                 if (eol)
1466                         printf("\n");
1467                 break;
1468         }
1469
1470 ###### Assignment statement
1471
1472 An assignment will assign a value to a variable.  The analysis phase
1473 ensures that the type will be correct so the interpreted just needs to
1474 perform the calculation.
1475
1476 ###### Binode types
1477         Assign,
1478
1479 ###### SimpleStatement Grammar
1480         | Variable = Expression ${
1481                         $0 = new(binode);
1482                         $0->op = Assign;
1483                         $0->left = $<1;
1484                         $0->right =$<3;
1485                 }$
1486
1487 ###### print binode cases
1488
1489         case Assign:
1490                 do_indent(indent, "");
1491                 print_exec(b->left, indent, 0);
1492                 printf(" = ");
1493                 print_exec(b->right, indent, 0);
1494                 if (indent >= 0)
1495                         printf("\n");
1496                 break;
1497
1498 ###### propagate binode cases
1499
1500         case Assign:
1501                 /* Both must match, result is Vnone */
1502                 t = propagate_types(b->left, Vunknown, ok);
1503                 if (t != Vunknown)
1504                         propagate_types(b->right, t, ok);
1505                 else {
1506                         t = propagate_types(b->right, Vunknown, ok);
1507                         if (t != Vunknown)
1508                                 t = propagate_types(b->left, t, ok);
1509                 }
1510                 return Vnone;
1511
1512 ###### interp binode cases
1513
1514         case Assign:
1515         {
1516                 struct variable *v = cast(var, b->left)->var;
1517                 right = interp_exec(b->right);
1518                 free_value(v->val);
1519                 v->val = right;
1520                 right.vtype = Vunknown;
1521                 break;
1522         }
1523
1524 ### The `use` statement
1525
1526 The `use` statement is the last "simple" statement.  It is needed when
1527 the condition in a conditional statement is a block.  `use` works much
1528 like `return` in C, but only completes the `condition`, not the whole
1529 function.
1530
1531 ###### Binode types
1532         Use,
1533
1534 ###### SimpleStatement Grammar
1535         | use Expression ${
1536                 $0 = new(binode);
1537                 $0->op = Use;
1538                 $0->right = $<2;
1539         }$
1540
1541 ###### print binode cases
1542
1543         case Use:
1544                 do_indent(indent, "use ");
1545                 print_exec(b->right, -1, 0);
1546                 if (indent >= 0)
1547                         printf("\n");
1548                 break;
1549
1550 ###### propagate binode cases
1551
1552         case Use:
1553                 /* result matches value */
1554                 return propagate_types(b->right, type, ok);
1555
1556 ###### interp binode cases
1557
1558         case Use:
1559                 rv = interp_exec(b->right);
1560                 break;
1561
1562 ### The Conditional Statement
1563
1564 This is the biggy and currently the only complex statement.
1565 This subsumes `if`, `while`, `do/while`, `switch`, and some part of
1566 `for`.  It is comprised of a number of parts, all of which are
1567 optional though set combinations apply.
1568
1569 If there is a `forpart`, it is executed first, only once.
1570 If there is a `dopart`, then it is executed repeatedly providing
1571 always that the `condpart` or `cond`, if present, does not return a non-True
1572 value.  `condpart` can fail to return any value if it simply executes
1573 to completion.  This is treated the same as returning True.
1574
1575 If there is a `thenpart` it will be executed whenever the `condpart`
1576 or `cond` returns True (or does not return), but this will happen
1577 *after* `dopart` (when present).
1578
1579 If `elsepart` is present it will be executed at most once when the
1580 condition returns False.  If there are any `casepart`s, they will be
1581 executed when the condition returns a matching value.
1582
1583 The particular sorts of values allowed in case parts has not yet been
1584 determined in the language design.
1585
1586 The cond_statement cannot fit into a `binode` so a new `exec` is
1587 defined.
1588
1589 ###### exec type
1590         Xcond_statement,
1591
1592 ###### ast
1593         struct casepart {
1594                 struct exec *value;
1595                 struct exec *action;
1596                 struct casepart *next;
1597         };
1598         struct cond_statement {
1599                 struct exec;
1600                 struct exec *forpart, *condpart, *dopart, *thenpart, *elsepart;
1601                 struct casepart *casepart;
1602         };
1603
1604 ###### ast functions
1605
1606         static void free_casepart(struct casepart *cp)
1607         {
1608                 while (cp) {
1609                         struct casepart *t;
1610                         free_exec(cp->value);
1611                         free_exec(cp->action);
1612                         t = cp->next;
1613                         free(cp);
1614                         cp = t;
1615                 }
1616         }
1617
1618         void free_cond_statement(struct cond_statement *s)
1619         {
1620                 if (!s)
1621                         return;
1622                 free_exec(s->forpart);
1623                 free_exec(s->condpart);
1624                 free_exec(s->dopart);
1625                 free_exec(s->thenpart);
1626                 free_exec(s->elsepart);
1627                 free_casepart(s->casepart);
1628                 free(s);
1629         }
1630
1631 ###### free exec cases
1632         case Xcond_statement: free_cond_statement(cast(cond_statement, e)); break;
1633
1634 ###### ComplexStatement Grammar
1635         | CondStatement ${ $0 = $<1; }$
1636
1637 ###### Grammar
1638
1639         $*cond_statement
1640         CondStatement -> ForPart OptNL WhilePart CondSuffix ${
1641                         $0 = $<4;
1642                         $0->forpart = $<1;
1643                         $0->condpart = $3.condpart; $3.condpart = NULL;
1644                         $0->dopart = $3.dopart; $3.dopart = NULL;
1645                         }$
1646                 | WhilePart CondSuffix ${
1647                         $0 = $<2;
1648                         $0->condpart = $1.condpart; $1.condpart = NULL;
1649                         $0->dopart = $1.dopart; $1.dopart = NULL;
1650                         }$
1651                 | SwitchPart CondSuffix ${
1652                         $0 = $<2;
1653                         $0->condpart = $<1;
1654                         }$
1655                 | IfPart IfSuffix ${
1656                         $0 = $<2;
1657                         $0->condpart = $1.condpart; $1.condpart = NULL;
1658                         $0->thenpart = $1.thenpart; $1.thenpart = NULL;
1659                         }$
1660         CondSuffix -> IfSuffix ${ $0 = $<1; }$
1661                 | Newlines case Expression Block CondSuffix ${ {
1662                         struct casepart *cp = calloc(1, sizeof(*cp));
1663                         $0 = $<5;
1664                         cp->value = $<3;
1665                         cp->action = $<4;
1666                         cp->next = $0->casepart;
1667                         $0->casepart = cp;
1668                 } }$
1669                 | case Expression Block CondSuffix ${ {
1670                         struct casepart *cp = calloc(1, sizeof(*cp));
1671                         $0 = $<4;
1672                         cp->value = $<2;
1673                         cp->action = $<3;
1674                         cp->next = $0->casepart;
1675                         $0->casepart = cp;
1676                 } }$
1677
1678         IfSuffix -> Newlines ${ $0 = new(cond_statement); }$
1679                 | Newlines else Block ${
1680                         $0 = new(cond_statement);
1681                         $0->elsepart = $<3;
1682                 }$
1683                 | else Block ${
1684                         $0 = new(cond_statement);
1685                         $0->elsepart = $<2;
1686                 }$
1687                 | Newlines else CondStatement ${
1688                         $0 = new(cond_statement);
1689                         $0->elsepart = $<3;
1690                 }$
1691                 | else CondStatement ${
1692                         $0 = new(cond_statement);
1693                         $0->elsepart = $<2;
1694                 }$
1695
1696
1697         $*exec
1698         ForPart -> for SimpleStatements ${
1699                         $0 = reorder_bilist($<2);
1700                 }$
1701                 |  for Block ${
1702                         $0 = $<2;
1703                 }$
1704
1705         WhileHead -> while Block ${
1706                 $0 = $<2;
1707                 }$
1708
1709         $cond_statement
1710         WhilePart -> while Expression Block ${
1711                         $0.type = Xcond_statement;
1712                         $0.condpart = $<2;
1713                         $0.dopart = $<3;
1714                 }$
1715                 |    WhileHead OptNL do Block ${
1716                         $0.type = Xcond_statement;
1717                         $0.condpart = $<1;
1718                         $0.dopart = $<4;
1719                 }$
1720
1721         IfPart -> if Expression Block ${
1722                         $0.type = Xcond_statement;
1723                         $0.condpart = $<2;
1724                         $0.thenpart = $<3;
1725                 }$
1726                 | if Block OptNL then Block ${
1727                         $0.type = Xcond_statement;
1728                         $0.condpart = $<2;
1729                         $0.thenpart = $<5;
1730                 }$
1731
1732         $*exec
1733         SwitchPart -> switch Expression ${
1734                         $0 = $<2;
1735                 }$
1736                 | switch Block ${
1737                         $0 = $<2;
1738                 }$
1739
1740 ###### print exec cases
1741
1742         case Xcond_statement:
1743         {
1744                 struct cond_statement *cs = cast(cond_statement, e);
1745                 struct casepart *cp;
1746                 if (cs->forpart) {
1747                         do_indent(indent, "for");
1748                         if (bracket) printf(" {\n"); else printf(":\n");
1749                         print_exec(cs->forpart, indent+1, bracket);
1750                         if (bracket) do_indent(indent, "}\n");
1751                 }
1752                 if (cs->dopart) {
1753                         // a loop
1754                         if (cs->condpart && cs->condpart->type == Xbinode &&
1755                             cast(binode, cs->condpart)->op == Block) {
1756                                 if (bracket)
1757                                         do_indent(indent, "while {\n");
1758                                 else
1759                                         do_indent(indent, "while:\n");
1760                                 print_exec(cs->condpart, indent+1, bracket);
1761                                 if (cs->thenpart) {
1762                                         if (bracket)
1763                                                 do_indent(indent, "} then {\n");
1764                                         else
1765                                                 do_indent(indent, "then:\n");
1766                                         print_exec(cs->thenpart, indent+1, bracket);
1767                                         if (bracket)
1768                                                 do_indent(indent, "}\n");
1769                                 }
1770                                 if (bracket)
1771                                         do_indent(indent, "} do {\n");
1772                                 else
1773                                         do_indent(indent, "do:\n");
1774                                 print_exec(cs->dopart, indent+1, bracket);
1775                                 if (bracket)
1776                                         do_indent(indent, "}\n");
1777                         } else {
1778                                 do_indent(indent, "while ");
1779                                 print_exec(cs->condpart, 0, bracket);
1780                                 if (bracket)
1781                                         printf(" {\n");
1782                                 else
1783                                         printf(":\n");
1784                                 print_exec(cs->dopart, indent+1, bracket);
1785                                 if (bracket)
1786                                         do_indent(indent, "}\n");
1787                         }
1788                 } else {
1789                         // a condition
1790                         if (cs->casepart)
1791                                 do_indent(indent, "switch");
1792                         else
1793                                 do_indent(indent, "if");
1794                         if (cs->condpart && cs->condpart->type == Xbinode &&
1795                             cast(binode, cs->condpart)->op == Block) {
1796                                 printf(":\n");
1797                                 print_exec(cs->condpart, indent+1, bracket);
1798                                 do_indent(indent, "then:\n");
1799                                 print_exec(cs->thenpart, indent+1, bracket);
1800                         } else {
1801                                 printf(" ");
1802                                 print_exec(cs->condpart, 0, bracket);
1803                                 printf(":\n");
1804                                 print_exec(cs->thenpart, indent+1, bracket);
1805                         }
1806                 }
1807                 for (cp = cs->casepart; cp; cp = cp->next) {
1808                         do_indent(indent, "case ");
1809                         print_exec(cp->value, -1, 0);
1810                         printf(":\n");
1811                         print_exec(cp->action, indent+1, bracket);
1812                 }
1813                 if (cs->elsepart) {
1814                         do_indent(indent, "else:\n");
1815                         print_exec(cs->elsepart, indent+1, bracket);
1816                 }
1817                 break;
1818         }
1819
1820 ###### propagate exec cases
1821         case Xcond_statement:
1822         {
1823                 // forpart and dopart must return Vnone
1824                 // condpart must be bool or match casepart->values
1825                 // thenpart, elsepart, casepart->action must match
1826                 // or be Vnone
1827                 struct cond_statement *cs = cast(cond_statement, prog);
1828                 struct casepart *c;
1829
1830                 t = propagate_types(cs->forpart, Vnone, ok);
1831                 if (t != Vunknown && t != Vnone)
1832                         *ok = 0;
1833                 t = propagate_types(cs->dopart, Vnone, ok);
1834                 if (t != Vunknown && t != Vnone)
1835                         *ok = 0;
1836                 if (cs->casepart == NULL)
1837                         propagate_types(cs->condpart, Vbool, ok);
1838                 else {
1839                         t = Vunknown;
1840                         for (c = cs->casepart;
1841                              c && (t == Vunknown); c = c->next)
1842                                 t = propagate_types(c->value, Vunknown, ok);
1843                         if (t == Vunknown && cs->condpart)
1844                                 t = propagate_types(cs->condpart, Vunknown, ok);
1845                         // Now we have a type (I hope) push it down
1846                         if (t != Vunknown) {
1847                                 for (c = cs->casepart; c; c = c->next)
1848                                         propagate_types(c->value, t, ok);
1849                                 propagate_types(cs->condpart, t, ok);
1850                         }
1851                 }
1852                 if (type == Vunknown || type == Vnone)
1853                         type = propagate_types(cs->thenpart, Vunknown, ok);
1854                 if (type == Vunknown || type == Vnone)
1855                         type = propagate_types(cs->elsepart, Vunknown, ok);
1856                 for (c = cs->casepart;
1857                      c && (type == Vunknown || type == Vnone);
1858                      c = c->next)
1859                         type = propagate_types(c->action, Vunknown, ok);
1860                 if (type != Vunknown && type != Vnone) {
1861                         propagate_types(cs->thenpart, type, ok);
1862                         propagate_types(cs->elsepart, type, ok);
1863                         for (c = cs->casepart; c ; c = c->next)
1864                                 propagate_types(c->action, type, ok);
1865                         return type;
1866                 } else
1867                         return Vunknown;
1868         }
1869
1870 ###### interp exec cases
1871         case Xcond_statement:
1872         {
1873                 struct value v, cnd;
1874                 struct casepart *cp;
1875                 struct cond_statement *c = cast(cond_statement, e);
1876                 if (c->forpart)
1877                         interp_exec(c->forpart);
1878                 do {
1879                         if (c->condpart)
1880                                 cnd = interp_exec(c->condpart);
1881                         else
1882                                 cnd.vtype = Vnone;
1883                         if (!(cnd.vtype == Vnone ||
1884                               (cnd.vtype == Vbool && cnd.bool != 0)))
1885                                 break;
1886                         if (c->dopart) {
1887                                 free_value(cnd);
1888                                 interp_exec(c->dopart);
1889                         }
1890                         if (c->thenpart) {
1891                                 v = interp_exec(c->thenpart);
1892                                 if (v.vtype != Vnone || !c->dopart)
1893                                         return v;
1894                                 free_value(v);
1895                         }
1896                 } while (c->dopart);
1897
1898                 for (cp = c->casepart; cp; cp = cp->next) {
1899                         v = interp_exec(cp->value);
1900                         if (value_cmp(v, cnd) == 0) {
1901                                 free_value(v);
1902                                 free_value(cnd);
1903                                 return interp_exec(cp->action);
1904                         }
1905                         free_value(v);
1906                 }
1907                 free_value(cnd);
1908                 if (c->elsepart)
1909                         return interp_exec(c->elsepart);
1910                 v.vtype = Vnone;
1911                 return v;
1912         }
1913
1914 ### Finally the whole program.
1915
1916 Somewhat reminiscent of Pascal a (current) Ocean program starts with
1917 the keyword "program" and list of variable names which are assigned
1918 values from command line arguments.  Following this is a `block` which
1919 is the code to execute.
1920
1921 As this is the top level, several things are handled a bit
1922 differently.
1923 The whole program is not interpreted by `interp_exec` as that isn't
1924 passed the argument list which the program requires.  Similarly type
1925 analysis is a bit more interesting at this level.
1926
1927 ###### Binode types
1928         Program,
1929
1930 ###### Parser: grammar
1931
1932         $*binode
1933         Program -> program Varlist Block OptNL ${
1934                 $0 = new(binode);
1935                 $0->op = Program;
1936                 $0->left = reorder_bilist($<2);
1937                 $0->right = $<3;
1938         }$
1939
1940         Varlist -> Varlist Variable ${
1941                         $0 = new(binode);
1942                         $0->op = Program;
1943                         $0->left = $<1;
1944                         $0->right = $<2;
1945                 }$
1946                 | ${ $0 = NULL; }$
1947         ## Grammar
1948
1949 ###### print binode cases
1950         case Program:
1951                 do_indent(indent, "program");
1952                 for (b2 = cast(binode, b->left); b2; b2 = cast(binode, b2->right)) {
1953                         printf(" ");
1954                         print_exec(b2->left, 0, 0);
1955                 }
1956                 if (bracket)
1957                         printf(" {\n");
1958                 else
1959                         printf(":\n");
1960                 print_exec(b->right, indent+1, bracket);
1961                 if (bracket)
1962                         do_indent(indent, "}\n");
1963                 break;
1964
1965 ###### propagate binode cases
1966         case Program: abort();
1967
1968 ###### core functions
1969
1970         static int analyse_prog(struct exec *prog, struct parse_context *c)
1971         {
1972                 struct binode *b = cast(binode, prog);
1973                 struct variable *v;
1974                 int ok = 1;
1975                 int uniq = 314159;
1976                 do {
1977                         ok = 1;
1978                         propagate_types(b->right, Vnone, &ok);
1979                 } while (ok == 2);
1980                 if (!ok)
1981                         return 0;
1982
1983                 for (b = cast(binode, b->left); b; b = cast(binode, b->right)) {
1984                         struct var *v = cast(var, b->left);
1985                         if (v->var->val.vtype == Vunknown)
1986                                 val_init(&v->var->val, Vstr);
1987                 }
1988                 b = cast(binode, prog);
1989                 do {
1990                         ok = 1;
1991                         propagate_types(b->right, Vnone, &ok);
1992                 } while (ok == 2);
1993                 if (!ok)
1994                         return 0;
1995
1996                 for (v = c->varlist; v; v = v->next)
1997                         if (v->val.vtype == Vunknown) {
1998                                 v->val.vtype = Vnum;
1999                                 mpq_init(v->val.num);
2000                                 mpq_set_ui(v->val.num, uniq, 1);
2001                                 uniq++;
2002                         }
2003                 /* Make sure everything is still consistent */
2004                 propagate_types(b->right, Vnone, &ok);
2005                 return !!ok;
2006         }
2007
2008         static void interp_prog(struct exec *prog, char **argv)
2009         {
2010                 struct binode *p = cast(binode, prog);
2011                 struct binode *al = cast(binode, p->left);
2012                 struct value v;
2013
2014                 while (al) {
2015                         struct var *v = cast(var, al->left);
2016                         struct value *vl = &v->var->val;
2017
2018                         if (argv[0] == NULL) {
2019                                 printf("Not enough args\n");
2020                                 exit(1);
2021                         }
2022                         al = cast(binode, al->right);
2023                         free_value(*vl);
2024                         if (!parse_value(vl, argv[0]))
2025                                 exit(1);
2026                         argv++;
2027                 }
2028                 v = interp_exec(p->right);
2029                 free_value(v);
2030         }
2031
2032 ###### interp binode cases
2033         case Program: abort();