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

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