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                 | MULTI_STRING ${
 730                         $0 = new(val);
 731                         $0->val.vtype = Vstr;
 732                         string_parse(&$1, '\\', &$0->val.str, $0->val.tail);
 733                         }$
 734
 735 ###### print exec cases
 736         case Xval:
 737         {
 738                 struct val *v = cast(val, e);
 739                 if (v->val.vtype == Vstr)
 740                         printf("\"");
 741                 print_value(v->val);
 742                 if (v->val.vtype == Vstr)
 743                         printf("\"");
 744                 break;
 745         }
 746
 747 ###### propagate exec cases
 748                 case Xval:
 749                 {
 750                         struct val *val = cast(val, prog);
 751                         if (type != Vunknown &&
 752                             type != val->val.vtype)
 753                                 *ok = 0;
 754                         return val->val.vtype;
 755                 }
 756
 757 ###### interp exec cases
 758         case Xval:
 759                 return dup_value(cast(val, e)->val);
 760
 761 ###### ast functions
 762         void free_val(struct val *v)
 763         {
 764                 if (!v)
 765                         return;
 766                 free_value(v->val);
 767                 free(v);
 768         }
 769
 770 ###### free exec cases
 771         case Xval: free_val(cast(val, e)); break;
 772
 773 ###### ast functions
 774         // Move all nodes from 'b' to 'rv', reversing the order.
 775         // In 'b' 'left' is a list, and 'right' is the last node.
 776         // In 'rv', left' is the first node and 'right' is a list.
 777         struct binode *reorder_bilist(struct binode *b)
 778         {
 779                 struct binode *rv = NULL;
 780
 781                 while (b) {
 782                         struct exec *t = b->right;
 783                         b->right = rv;
 784                         rv = b;
 785                         if (b->left)
 786                                 b = cast(binode, b->left);
 787                         else
 788                                 b = NULL;
 789                         rv->left = t;
 790                 }
 791                 return rv;
 792         }
 793
 794 ### Variables
 795
 796 Just as we used as `val` to wrap a value into an `exec`, we similarly
 797 need a `var` to wrap a `variable` into an exec.  While each `val`
 798 contained a copy of the value, each `var` hold a link to the variable
 799 because it really is the same variable no matter where it appears.
 800
 801 ###### exec type
 802         Xvar,
 803
 804 ###### ast
 805         struct var {
 806                 struct exec;
 807                 struct variable *var;
 808         };
 809
 810 ###### Grammar
 811         $*var
 812         Variable -> IDENTIFIER ${
 813                 $0 = new(var);
 814                 $0->var = find_variable(config, $1.txt);
 815         }$
 816
 817 ###### print exec cases
 818         case Xvar:
 819         {
 820                 struct var *v = cast(var, e);
 821                 printf("%.*s", v->var->name.len, v->var->name.txt);
 822                 break;
 823         }
 824
 825 ###### propagate exec cases
 826
 827         case Xvar:
 828         {
 829                 struct var *var = cast(var, prog);
 830                 if (var->var->val.vtype == Vunknown) {
 831                         if (type != Vunknown && *ok != 0) {
 832                                 val_init(&var->var->val, type);
 833                                 *ok = 2;
 834                         }
 835                         return type;
 836                 }
 837                 if (type == Vunknown)
 838                         return var->var->val.vtype;
 839                 if (type != var->var->val.vtype)
 840                         *ok = 0;
 841                 return type;
 842         }
 843
 844 ###### interp exec cases
 845         case Xvar:
 846                 return dup_value(cast(var, e)->var->val);
 847
 848 ###### ast functions
 849
 850         void free_var(struct var *v)
 851         {
 852                 free(v);
 853         }
 854
 855 ###### free exec cases
 856         case Xvar: free_var(cast(var, e)); break;
 857
 858 ### Expressions: Boolean
 859
 860 Our first user of the `binode` will be expressions, and particularly
 861 Boolean expressions.  As I haven't implemented precedence in the
 862 parser generator yet, we need different names from each precedence
 863 level used by expressions.  The outer most or lowest level precedence
 864 are Boolean `or` `and`, and `not` which form and `Expression` our of `BTerm`s
 865 and `BFact`s.
 866
 867 ###### Binode types
 868         And,
 869         Or,
 870         Not,
 871
 872 ####### Grammar
 873
 874         $*binode
 875         Expression -> Expression or BTerm ${
 876                         $0 = new(binode);
 877                         $0->op = Or;
 878                         $0->left = $<1;
 879                         $0->right = $<3;
 880                 }$
 881                 | BTerm ${ $0 = $<1; }$
 882
 883         BTerm -> BTerm and BFact ${
 884                         $0 = new(binode);
 885                         $0->op = And;
 886                         $0->left = $<1;
 887                         $0->right = $<3;
 888                 }$
 889                 | BFact ${ $0 = $<1; }$
 890
 891         BFact -> not BFact ${
 892                         $0 = new(binode);
 893                         $0->op = Not;
 894                         $0->right = $<2;
 895                         }$
 896                 ## other BFact
 897
 898 ###### print binode cases
 899         case And:
 900                 print_exec(b->left, -1, 0);
 901                 printf(" and ");
 902                 print_exec(b->right, -1, 0);
 903                 break;
 904         case Or:
 905                 print_exec(b->left, -1, 0);
 906                 printf(" or ");
 907                 print_exec(b->right, -1, 0);
 908                 break;
 909         case Not:
 910                 printf("not ");
 911                 print_exec(b->right, -1, 0);
 912                 break;
 913
 914 ###### propagate binode cases
 915         case And:
 916         case Or:
 917         case Not:
 918                 /* both must be Vbool, result is Vbool */
 919                 propagate_types(b->left, Vbool, ok);
 920                 propagate_types(b->right, Vbool, ok);
 921                 if (type != Vbool && type != Vunknown)
 922                         *ok = 0;
 923                 return Vbool;
 924
 925 ###### interp binode cases
 926         case And:
 927                 rv = interp_exec(b->left);
 928                 right = interp_exec(b->right);
 929                 rv.bool = rv.bool && right.bool;
 930                 break;
 931         case Or:
 932                 rv = interp_exec(b->left);
 933                 right = interp_exec(b->right);
 934                 rv.bool = rv.bool || right.bool;
 935                 break;
 936         case Not:
 937                 rv = interp_exec(b->right);
 938                 rv.bool = !rv.bool;
 939                 break;
 940
 941 ### Expressions: Comparison
 942
 943 Of slightly higher precedence that Boolean expressions are
 944 Comparisons.
 945 A comparison takes arguments of any type, but the two types must be
 946 the same.
 947
 948 To simplify the parsing we introduce an `eop` which can return an
 949 expression operator.
 950
 951 ###### ast
 952         struct eop {
 953                 enum Btype op;
 954         };
 955
 956 ###### ast functions
 957         static void free_eop(struct eop *e)
 958         {
 959                 if (e)
 960                         free(e);
 961         }
 962
 963 ###### Binode types
 964         Less,
 965         Gtr,
 966         LessEq,
 967         GtrEq,
 968         Eql,
 969         NEql,
 970
 971 ###### other BFact
 972         | Expr CMPop Expr ${
 973                         $0 = new(binode);
 974                         $0->op = $2.op;
 975                         $0->left = $<1;
 976                         $0->right = $<3;
 977                 }$
 978                 | Expr ${ $0 = $<1; }$
 979
 980 ###### Grammar
 981
 982         $eop
 983         CMPop ->   < ${ $0.op = Less; }$
 984                 |  > ${ $0.op = Gtr; }$
 985                 |  <= ${ $0.op = LessEq; }$
 986                 |  >= ${ $0.op = GtrEq; }$
 987                 |  == ${ $0.op = Eql; }$
 988                 |  != ${ $0.op = NEql; }$
 989
 990 ###### print binode cases
 991
 992         case Less:
 993         case LessEq:
 994         case Gtr:
 995         case GtrEq:
 996         case Eql:
 997         case NEql:
 998                 print_exec(b->left, -1, 0);
 999                 switch(b->op) {
1000                 case Less:   printf(" < "); break;
1001                 case LessEq: printf(" <= "); break;
1002                 case Gtr:    printf(" > "); break;
1003                 case GtrEq:  printf(" >= "); break;
1004                 case Eql:    printf(" == "); break;
1005                 case NEql:   printf(" != "); break;
1006                 default: abort();
1007                 }
1008                 print_exec(b->right, -1, 0);
1009                 break;
1010
1011 ###### propagate binode cases
1012         case Less:
1013         case LessEq:
1014         case Gtr:
1015         case GtrEq:
1016         case Eql:
1017         case NEql:
1018                 /* Both must match, result is Vbool */
1019                 t = propagate_types(b->left, Vunknown, ok);
1020                 if (t != Vunknown)
1021                         propagate_types(b->right, t, ok);
1022                 else {
1023                         t = propagate_types(b->right, Vunknown, ok);
1024                         if (t != Vunknown)
1025                                 t = propagate_types(b->left, t, ok);
1026                 }
1027                 if (type != Vbool && type != Vunknown)
1028                         *ok = 0;
1029                 return Vbool;
1030
1031 ###### interp binode cases
1032         case Less:
1033         case LessEq:
1034         case Gtr:
1035         case GtrEq:
1036         case Eql:
1037         case NEql:
1038         {
1039                 int cmp;
1040                 left = interp_exec(b->left);
1041                 right = interp_exec(b->right);
1042                 cmp = value_cmp(left, right);
1043                 rv.vtype = Vbool;
1044                 switch (b->op) {
1045                 case Less:      rv.bool = cmp <  0; break;
1046                 case LessEq:    rv.bool = cmp <= 0; break;
1047                 case Gtr:       rv.bool = cmp >  0; break;
1048                 case GtrEq:     rv.bool = cmp >= 0; break;
1049                 case Eql:       rv.bool = cmp == 0; break;
1050                 case NEql:      rv.bool = cmp != 0; break;
1051                 default: rv.bool = 0; break;
1052                 }
1053                 break;
1054         }
1055
1056 ### Expressions: The rest
1057
1058 The remaining expressions with the highest precedence are arithmetic
1059 and string concatenation.  There are `Expr`, `Term`, and `Factor`.
1060 The `Factor` is where the `Value` and `Variable` that we already have
1061 are included.
1062
1063 `+` and `-` are both infix and prefix operations (where they are
1064 absolute value and negation).  These have different operator names.
1065
1066 We also have a 'Bracket' operator which records where parentheses were
1067 found.  This make it easy to reproduce these when printing.  Once
1068 precedence is handled better I might be able to discard this.
1069
1070 ###### Binode types
1071         Plus, Minus,
1072         Times, Divide,
1073         Concat,
1074         Absolute, Negate,
1075         Bracket,
1076
1077 ###### Grammar
1078
1079         $*binode
1080         Expr -> Expr Eop Term ${
1081                         $0 = new(binode);
1082                         $0->op = $2.op;
1083                         $0->left = $<1;
1084                         $0->right = $<3;
1085                 }$
1086                 | Term ${ $0 = $<1; }$
1087
1088         Term -> Term Top Factor ${
1089                         $0 = new(binode);
1090                         $0->op = $2.op;
1091                         $0->left = $<1;
1092                         $0->right = $<3;
1093                 }$
1094                 | Factor ${ $0 = $<1; }$
1095
1096         Factor -> ( Expression ) ${
1097                         $0 = new(binode);
1098                         $0->op = Bracket;
1099                         $0->right = $<2;
1100                 }$
1101                 | Uop Factor ${
1102                         $0 = new(binode);
1103                         $0->op = $1.op;
1104                         $0->right = $<2;
1105                 }$
1106                 | Value ${ $0 = (struct binode *)$<1; }$
1107                 | Variable ${ $0 = (struct binode *)$<1; }$
1108
1109         $eop
1110         Eop ->    + ${ $0.op = Plus; }$
1111                 | - ${ $0.op = Minus; }$
1112
1113         Uop ->    + ${ $0.op = Absolute; }$
1114                 | - ${ $0.op = Negate; }$
1115
1116         Top ->    * ${ $0.op = Times; }$
1117                 | / ${ $0.op = Divide; }$
1118                 | ++ ${ $0.op = Concat; }$
1119
1120 ###### print binode cases
1121         case Plus:
1122         case Minus:
1123         case Times:
1124         case Divide:
1125         case Concat:
1126                 print_exec(b->left, indent, 0);
1127                 switch(b->op) {
1128                 case Plus:   printf(" + "); break;
1129                 case Minus:  printf(" - "); break;
1130                 case Times:  printf(" * "); break;
1131                 case Divide: printf(" / "); break;
1132                 case Concat: printf(" ++ "); break;
1133                 default: abort();
1134                 }
1135                 print_exec(b->right, indent, 0);
1136                 break;
1137         case Absolute:
1138                 printf("+");
1139                 print_exec(b->right, indent, 0);
1140                 break;
1141         case Negate:
1142                 printf("-");
1143                 print_exec(b->right, indent, 0);
1144                 break;
1145         case Bracket:
1146                 printf("(");
1147                 print_exec(b->right, indent, 0);
1148                 printf(")");
1149                 break;
1150
1151 ###### propagate binode cases
1152         case Plus:
1153         case Minus:
1154         case Times:
1155         case Divide:
1156                 /* both must be numbers, result is Vnum */
1157         case Absolute:
1158         case Negate:
1159                 /* as propagate_types ignores a NULL,
1160                  * unary ops fit here too */
1161                 propagate_types(b->left, Vnum, ok);
1162                 propagate_types(b->right, Vnum, ok);
1163                 if (type != Vnum && type != Vunknown)
1164                         *ok = 0;
1165                 return Vnum;
1166
1167         case Concat:
1168                 /* both must be Vstr, result is Vstr */
1169                 propagate_types(b->left, Vstr, ok);
1170                 propagate_types(b->right, Vstr, ok);
1171                 if (type != Vstr && type != Vunknown)
1172                         *ok = 0;
1173                 return Vstr;
1174
1175         case Bracket:
1176                 return propagate_types(b->right, type, ok);
1177
1178 ###### interp binode cases
1179
1180         case Plus:
1181                 rv = interp_exec(b->left);
1182                 right = interp_exec(b->right);
1183                 mpq_add(rv.num, rv.num, right.num);
1184                 break;
1185         case Minus:
1186                 rv = interp_exec(b->left);
1187                 right = interp_exec(b->right);
1188                 mpq_sub(rv.num, rv.num, right.num);
1189                 break;
1190         case Times:
1191                 rv = interp_exec(b->left);
1192                 right = interp_exec(b->right);
1193                 mpq_mul(rv.num, rv.num, right.num);
1194                 break;
1195         case Divide:
1196                 rv = interp_exec(b->left);
1197                 right = interp_exec(b->right);
1198                 mpq_div(rv.num, rv.num, right.num);
1199                 break;
1200         case Negate:
1201                 rv = interp_exec(b->right);
1202                 mpq_neg(rv.num, rv.num);
1203                 break;
1204         case Absolute:
1205                 rv = interp_exec(b->right);
1206                 mpq_abs(rv.num, rv.num);
1207                 break;
1208         case Bracket:
1209                 rv = interp_exec(b->right);
1210                 break;
1211         case Concat:
1212                 left = interp_exec(b->left);
1213                 right = interp_exec(b->right);
1214                 rv.vtype = Vstr;
1215                 rv.str = text_join(left.str, right.str);
1216                 break;
1217
1218 ### Blocks, Statements, and Statement lists.
1219
1220 Now that we have expressions out of the way we need to turn to
1221 statements.  There are simple statements and more complex statements.
1222 Simple statements do not contain newlines, complex statements do.
1223
1224 Statements often come in sequences and we have corresponding simple
1225 statement lists and complex statement lists.
1226 The former comprise only simple statements separated by semicolons.
1227 The later comprise complex statements and simple statement lists.  They are
1228 separated by newlines.  Thus the semicolon is only used to separate
1229 simple statements on the one line.  This may be overly restrictive,
1230 but I'm not sure I every want a complex statement to share a line with
1231 anything else.
1232
1233 Note that a simple statement list can still use multiple lines if
1234 subsequent lines are indented, so
1235
1236 ###### Example: wrapped simple statement list
1237
1238         a = b; c = d;
1239            e = f; print g
1240
1241 is a single simple statement list.  This might allow room for
1242 confusion, so I'm not set on it yet.
1243
1244 A simple statement list needs no extra syntax.  A complex statement
1245 list has two syntactic forms.  It can be enclosed in braces (much like
1246 C blocks), or it can be introduced by a colon and continue until an
1247 unindented newline (much like Python blocks).  With this extra syntax
1248 it is referred to as a block.
1249
1250 Note that a block does not have to include any newlines if it only
1251 contains simple statements.  So both of:
1252
1253         if condition: a=b; d=f
1254
1255         if condition { a=b; print f }
1256
1257 are valid.
1258
1259 In either case the list is constructed from a `binode` list with
1260 `Block` as the operator.  When parsing the list it is most convenient
1261 to append to the end, so a list is a list and a statement.  When using
1262 the list it is more convenient to consider a list to be a statement
1263 and a list.  So we need a function to re-order a list.
1264 `reorder_bilist` serves this purpose.
1265
1266 The only stand-alone statement we introduce at this stage is `pass`
1267 which does nothing and is represented as a `NULL` pointer in a `Block`
1268 list.
1269
1270 ###### Binode types
1271         Block,
1272
1273 ###### Grammar
1274
1275         $void
1276         OptNL -> Newlines
1277                 |
1278
1279         Newlines -> NEWLINE
1280                 | Newlines NEWLINE
1281
1282         $*binode
1283         Open -> {
1284                 | NEWLINE {
1285         Close -> }
1286                 | NEWLINE }
1287         Block -> Open Statementlist Close ${ $0 = $<2; }$
1288                 | Open Newlines Statementlist Close ${ $0 = $<3; }$
1289                 | Open SimpleStatements } ${ $0 = reorder_bilist($<2); }$
1290                 | Open Newlines SimpleStatements } ${ $0 = reorder_bilist($<3); }$
1291                 | : Statementlist ${ $0 = $<2; }$
1292                 | : SimpleStatements ${ $0 = reorder_bilist($<2); }$
1293
1294         Statementlist -> ComplexStatements ${ $0 = reorder_bilist($<1); }$
1295
1296         ComplexStatements -> ComplexStatements ComplexStatement ${
1297                 $0 = new(binode);
1298                 $0->op = Block;
1299                 $0->left = $<1;
1300                 $0->right = $<2;
1301                 }$
1302                 | ComplexStatements NEWLINE ${ $0 = $<1; }$
1303                 | ComplexStatement ${
1304                 $0 = new(binode);
1305                 $0->op = Block;
1306                 $0->left = NULL;
1307                 $0->right = $<1;
1308                 }$
1309
1310         $*exec
1311         ComplexStatement -> SimpleStatements NEWLINE ${
1312                         $0 = reorder_bilist($<1);
1313                         }$
1314                 ## ComplexStatement Grammar
1315
1316         $*binode
1317         SimpleStatements -> SimpleStatements ; SimpleStatement ${
1318                         $0 = new(binode);
1319                         $0->op = Block;
1320                         $0->left = $<1;
1321                         $0->right = $<3;
1322                         }$
1323                 | SimpleStatement ${
1324                         $0 = new(binode);
1325                         $0->op = Block;
1326                         $0->left = NULL;
1327                         $0->right = $<1;
1328                         }$
1329                 | SimpleStatements ; ${ $0 = $<1; }$
1330
1331         SimpleStatement -> pass ${ $0 = NULL; }$
1332                 ## SimpleStatement Grammar
1333
1334 ###### print binode cases
1335         case Block:
1336                 if (indent < 0) {
1337                         // simple statement
1338                         if (b->left == NULL)
1339                                 printf("pass");
1340                         else
1341                                 print_exec(b->left, indent, 0);
1342                         if (b->right) {
1343                                 printf("; ");
1344                                 print_exec(b->right, indent, 0);
1345                         }
1346                 } else {
1347                         // block, one per line
1348                         if (b->left == NULL)
1349                                 do_indent(indent, "pass\n");
1350                         else
1351                                 print_exec(b->left, indent, bracket);
1352                         if (b->right)
1353                                 print_exec(b->right, indent, bracket);
1354                 }
1355                 break;
1356
1357 ###### propagate binode cases
1358         case Block:
1359         {
1360                 /* If any statement returns something other then Vnone
1361                  * then all such must return same type.
1362                  * As each statement may be Vnone or something else,
1363                  * we must always pass Vunknown down, otherwise an incorrect
1364                  * error might occur.
1365                  */
1366                 struct binode *e;
1367
1368                 for (e = b; e; e = cast(binode, e->right)) {
1369                         t = propagate_types(e->left, Vunknown, ok);
1370                         if (t != Vunknown && t != Vnone) {
1371                                 if (type == Vunknown)
1372                                         type = t;
1373                                 else if (t != type)
1374                                         *ok = 0;
1375                         }
1376                 }
1377                 return type;
1378         }
1379
1380 ###### interp binode cases
1381         case Block:
1382                 while (rv.vtype == Vnone &&
1383                        b) {
1384                         if (b->left)
1385                                 rv = interp_exec(b->left);
1386                         b = cast(binode, b->right);
1387                 }
1388                 break;
1389
1390 ### The Print statement
1391
1392 `print` is a simple statement that takes a comma-separated list of
1393 expressions and prints the values separated by spaces and terminated
1394 by a newline.  No control of formatting is possible.
1395
1396 `print` faces the same list-ordering issue as blocks, and uses the
1397 same solution.
1398
1399 ###### Binode types
1400         Print,
1401
1402 ###### SimpleStatement Grammar
1403
1404         | print ExpressionList ${
1405                 $0 = reorder_bilist($<2);
1406         }$
1407         | print ExpressionList , ${
1408                 $0 = new(binode);
1409                 $0->op = Print;
1410                 $0->right = NULL;
1411                 $0->left = $<2;
1412                 $0 = reorder_bilist($0);
1413         }$
1414         | print ${
1415                 $0 = new(binode);
1416                 $0->op = Print;
1417                 $0->right = NULL;
1418         }$
1419
1420 ###### Grammar
1421
1422         $*binode
1423         ExpressionList -> ExpressionList , Expression ${
1424                 $0 = new(binode);
1425                 $0->op = Print;
1426                 $0->left = $<1;
1427                 $0->right = $<3;
1428                 }$
1429                 | Expression ${
1430                         $0 = new(binode);
1431                         $0->op = Print;
1432                         $0->left = NULL;
1433                         $0->right = $<1;
1434                 }$
1435
1436 ###### print binode cases
1437
1438         case Print:
1439                 do_indent(indent, "print");
1440                 while (b) {
1441                         if (b->left) {
1442                                 printf(" ");
1443                                 print_exec(b->left, -1, 0);
1444                                 if (b->right)
1445                                         printf(",");
1446                         }
1447                         b = cast(binode, b->right);
1448                 }
1449                 if (indent >= 0)
1450                         printf("\n");
1451                 break;
1452
1453 ###### propagate binode cases
1454
1455         case Print:
1456                 /* don't care but all must be consistent */
1457                 propagate_types(b->left, Vunknown, ok);
1458                 propagate_types(b->right, Vunknown, ok);
1459                 break;
1460
1461 ###### interp binode cases
1462
1463         case Print:
1464         {
1465                 char sep = 0;
1466                 int eol = 1;
1467                 for ( ; b; b = cast(binode, b->right))
1468                         if (b->left) {
1469                                 if (sep)
1470                                         putchar(sep);
1471                                 left = interp_exec(b->left);
1472                                 print_value(left);
1473                                 free_value(left);
1474                                 if (b->right)
1475                                         sep = ' ';
1476                         } else if (sep)
1477                                 eol = 0;
1478                 left.vtype = Vnone;
1479                 if (eol)
1480                         printf("\n");
1481                 break;
1482         }
1483
1484 ###### Assignment statement
1485
1486 An assignment will assign a value to a variable.  The analysis phase
1487 ensures that the type will be correct so the interpreted just needs to
1488 perform the calculation.
1489
1490 ###### Binode types
1491         Assign,
1492
1493 ###### SimpleStatement Grammar
1494         | Variable = Expression ${
1495                         $0 = new(binode);
1496                         $0->op = Assign;
1497                         $0->left = $<1;
1498                         $0->right =$<3;
1499                 }$
1500
1501 ###### print binode cases
1502
1503         case Assign:
1504                 do_indent(indent, "");
1505                 print_exec(b->left, indent, 0);
1506                 printf(" = ");
1507                 print_exec(b->right, indent, 0);
1508                 if (indent >= 0)
1509                         printf("\n");
1510                 break;
1511
1512 ###### propagate binode cases
1513
1514         case Assign:
1515                 /* Both must match, result is Vnone */
1516                 t = propagate_types(b->left, Vunknown, ok);
1517                 if (t != Vunknown)
1518                         propagate_types(b->right, t, ok);
1519                 else {
1520                         t = propagate_types(b->right, Vunknown, ok);
1521                         if (t != Vunknown)
1522                                 t = propagate_types(b->left, t, ok);
1523                 }
1524                 return Vnone;
1525
1526 ###### interp binode cases
1527
1528         case Assign:
1529         {
1530                 struct variable *v = cast(var, b->left)->var;
1531                 right = interp_exec(b->right);
1532                 free_value(v->val);
1533                 v->val = right;
1534                 right.vtype = Vunknown;
1535                 break;
1536         }
1537
1538 ### The `use` statement
1539
1540 The `use` statement is the last "simple" statement.  It is needed when
1541 the condition in a conditional statement is a block.  `use` works much
1542 like `return` in C, but only completes the `condition`, not the whole
1543 function.
1544
1545 ###### Binode types
1546         Use,
1547
1548 ###### SimpleStatement Grammar
1549         | use Expression ${
1550                 $0 = new(binode);
1551                 $0->op = Use;
1552                 $0->right = $<2;
1553         }$
1554
1555 ###### print binode cases
1556
1557         case Use:
1558                 do_indent(indent, "use ");
1559                 print_exec(b->right, -1, 0);
1560                 if (indent >= 0)
1561                         printf("\n");
1562                 break;
1563
1564 ###### propagate binode cases
1565
1566         case Use:
1567                 /* result matches value */
1568                 return propagate_types(b->right, type, ok);
1569
1570 ###### interp binode cases
1571
1572         case Use:
1573                 rv = interp_exec(b->right);
1574                 break;
1575
1576 ### The Conditional Statement
1577
1578 This is the biggy and currently the only complex statement.
1579 This subsumes `if`, `while`, `do/while`, `switch`, and some part of
1580 `for`.  It is comprised of a number of parts, all of which are
1581 optional though set combinations apply.
1582
1583 If there is a `forpart`, it is executed first, only once.
1584 If there is a `dopart`, then it is executed repeatedly providing
1585 always that the `condpart` or `cond`, if present, does not return a non-True
1586 value.  `condpart` can fail to return any value if it simply executes
1587 to completion.  This is treated the same as returning True.
1588
1589 If there is a `thenpart` it will be executed whenever the `condpart`
1590 or `cond` returns True (or does not return), but this will happen
1591 *after* `dopart` (when present).
1592
1593 If `elsepart` is present it will be executed at most once when the
1594 condition returns False.  If there are any `casepart`s, they will be
1595 executed when the condition returns a matching value.
1596
1597 The particular sorts of values allowed in case parts has not yet been
1598 determined in the language design.
1599
1600 The cond_statement cannot fit into a `binode` so a new `exec` is
1601 defined.
1602
1603 ###### exec type
1604         Xcond_statement,
1605
1606 ###### ast
1607         struct casepart {
1608                 struct exec *value;
1609                 struct exec *action;
1610                 struct casepart *next;
1611         };
1612         struct cond_statement {
1613                 struct exec;
1614                 struct exec *forpart, *condpart, *dopart, *thenpart, *elsepart;
1615                 struct casepart *casepart;
1616         };
1617
1618 ###### ast functions
1619
1620         static void free_casepart(struct casepart *cp)
1621         {
1622                 while (cp) {
1623                         struct casepart *t;
1624                         free_exec(cp->value);
1625                         free_exec(cp->action);
1626                         t = cp->next;
1627                         free(cp);
1628                         cp = t;
1629                 }
1630         }
1631
1632         void free_cond_statement(struct cond_statement *s)
1633         {
1634                 if (!s)
1635                         return;
1636                 free_exec(s->forpart);
1637                 free_exec(s->condpart);
1638                 free_exec(s->dopart);
1639                 free_exec(s->thenpart);
1640                 free_exec(s->elsepart);
1641                 free_casepart(s->casepart);
1642                 free(s);
1643         }
1644
1645 ###### free exec cases
1646         case Xcond_statement: free_cond_statement(cast(cond_statement, e)); break;
1647
1648 ###### ComplexStatement Grammar
1649         | CondStatement ${ $0 = $<1; }$
1650
1651 ###### Grammar
1652
1653         $*cond_statement
1654         CondStatement -> ForThen WhilePart CondSuffix ${
1655                         $0 = $<3;
1656                         $0->forpart = $1.forpart; $1.forpart = NULL;
1657                         $0->thenpart = $1.thenpart; $1.thenpart = NULL;
1658                         $0->condpart = $2.condpart; $2.condpart = NULL;
1659                         $0->dopart = $2.dopart; $2.dopart = NULL;
1660                         }$
1661                 | WhilePart CondSuffix ${
1662                         $0 = $<2;
1663                         $0->condpart = $1.condpart; $1.condpart = NULL;
1664                         $0->dopart = $1.dopart; $1.dopart = NULL;
1665                         }$
1666                 | SwitchPart CondSuffix ${
1667                         $0 = $<2;
1668                         $0->condpart = $<1;
1669                         }$
1670                 | IfPart IfSuffix ${
1671                         $0 = $<2;
1672                         $0->condpart = $1.condpart; $1.condpart = NULL;
1673                         $0->thenpart = $1.thenpart; $1.thenpart = NULL;
1674                         }$
1675
1676         CondSuffix -> IfSuffix ${ $0 = $<1; }$
1677                 | Newlines case Expression Block CondSuffix ${ {
1678                         struct casepart *cp = calloc(1, sizeof(*cp));
1679                         $0 = $<5;
1680                         cp->value = $<3;
1681                         cp->action = $<4;
1682                         cp->next = $0->casepart;
1683                         $0->casepart = cp;
1684                 } }$
1685                 | case Expression Block CondSuffix ${ {
1686                         struct casepart *cp = calloc(1, sizeof(*cp));
1687                         $0 = $<4;
1688                         cp->value = $<2;
1689                         cp->action = $<3;
1690                         cp->next = $0->casepart;
1691                         $0->casepart = cp;
1692                 } }$
1693
1694         IfSuffix -> Newlines ${ $0 = new(cond_statement); }$
1695                 | Newlines else Block ${
1696                         $0 = new(cond_statement);
1697                         $0->elsepart = $<3;
1698                 }$
1699                 | else Block ${
1700                         $0 = new(cond_statement);
1701                         $0->elsepart = $<2;
1702                 }$
1703                 | Newlines else CondStatement ${
1704                         $0 = new(cond_statement);
1705                         $0->elsepart = $<3;
1706                 }$
1707                 | else CondStatement ${
1708                         $0 = new(cond_statement);
1709                         $0->elsepart = $<2;
1710                 }$
1711
1712
1713         $*exec
1714         ForPart -> for SimpleStatements ${
1715                         $0 = reorder_bilist($<2);
1716                 }$
1717                 |  for Block ${
1718                         $0 = $<2;
1719                 }$
1720
1721         ThenPart -> then SimpleStatements ${
1722                         $0 = reorder_bilist($<2);
1723                 }$
1724                 |  then Block ${
1725                         $0 = $<2;
1726                 }$
1727
1728         ThenPartNL -> ThenPart OptNL ${
1729                         $0 = $<1;
1730                 }$
1731
1732         WhileHead -> while Block ${
1733                 $0 = $<2;
1734                 }$
1735
1736         $cond_statement
1737         ForThen -> ForPart OptNL ThenPartNL ${
1738                         $0.forpart = $<1;
1739                         $0.thenpart = $<3;
1740                 }$
1741                 | ForPart OptNL ${
1742                         $0.forpart = $<1;
1743                 }$
1744
1745         WhilePart -> while Expression Block ${
1746                         $0.type = Xcond_statement;
1747                         $0.condpart = $<2;
1748                         $0.dopart = $<3;
1749                 }$
1750                 |    WhileHead OptNL do Block ${
1751                         $0.type = Xcond_statement;
1752                         $0.condpart = $<1;
1753                         $0.dopart = $<4;
1754                 }$
1755
1756         IfPart -> if Expression Block ${
1757                         $0.type = Xcond_statement;
1758                         $0.condpart = $<2;
1759                         $0.thenpart = $<3;
1760                 }$
1761                 | if Block OptNL then Block ${
1762                         $0.type = Xcond_statement;
1763                         $0.condpart = $<2;
1764                         $0.thenpart = $<5;
1765                 }$
1766
1767         $*exec
1768         SwitchPart -> switch Expression ${
1769                         $0 = $<2;
1770                 }$
1771                 | switch Block ${
1772                         $0 = $<2;
1773                 }$
1774
1775 ###### print exec cases
1776
1777         case Xcond_statement:
1778         {
1779                 struct cond_statement *cs = cast(cond_statement, e);
1780                 struct casepart *cp;
1781                 if (cs->forpart) {
1782                         do_indent(indent, "for");
1783                         if (bracket) printf(" {\n"); else printf(":\n");
1784                         print_exec(cs->forpart, indent+1, bracket);
1785                         if (cs->thenpart) {
1786                                 if (bracket)
1787                                         do_indent(indent, "} then {\n");
1788                                 else
1789                                         do_indent(indent, "then:\n");
1790                                 print_exec(cs->thenpart, indent+1, bracket);
1791                         }
1792                         if (bracket) do_indent(indent, "}\n");
1793                 }
1794                 if (cs->dopart) {
1795                         // a loop
1796                         if (cs->condpart && cs->condpart->type == Xbinode &&
1797                             cast(binode, cs->condpart)->op == Block) {
1798                                 if (bracket)
1799                                         do_indent(indent, "while {\n");
1800                                 else
1801                                         do_indent(indent, "while:\n");
1802                                 print_exec(cs->condpart, indent+1, bracket);
1803                                 if (bracket)
1804                                         do_indent(indent, "} do {\n");
1805                                 else
1806                                         do_indent(indent, "do:\n");
1807                                 print_exec(cs->dopart, indent+1, bracket);
1808                                 if (bracket)
1809                                         do_indent(indent, "}\n");
1810                         } else {
1811                                 do_indent(indent, "while ");
1812                                 print_exec(cs->condpart, 0, bracket);
1813                                 if (bracket)
1814                                         printf(" {\n");
1815                                 else
1816                                         printf(":\n");
1817                                 print_exec(cs->dopart, indent+1, bracket);
1818                                 if (bracket)
1819                                         do_indent(indent, "}\n");
1820                         }
1821                 } else {
1822                         // a condition
1823                         if (cs->casepart)
1824                                 do_indent(indent, "switch");
1825                         else
1826                                 do_indent(indent, "if");
1827                         if (cs->condpart && cs->condpart->type == Xbinode &&
1828                             cast(binode, cs->condpart)->op == Block) {
1829                                 printf(":\n");
1830                                 print_exec(cs->condpart, indent+1, bracket);
1831                                 if (cs->thenpart) {
1832                                         do_indent(indent, "then:\n");
1833                                         print_exec(cs->thenpart, indent+1, bracket);
1834                                 }
1835                         } else {
1836                                 printf(" ");
1837                                 print_exec(cs->condpart, 0, bracket);
1838                                 if (cs->thenpart) {
1839                                         printf(":\n");
1840                                         print_exec(cs->thenpart, indent+1, bracket);
1841                                 } else
1842                                         printf("\n");
1843                         }
1844                 }
1845                 for (cp = cs->casepart; cp; cp = cp->next) {
1846                         do_indent(indent, "case ");
1847                         print_exec(cp->value, -1, 0);
1848                         printf(":\n");
1849                         print_exec(cp->action, indent+1, bracket);
1850                 }
1851                 if (cs->elsepart) {
1852                         do_indent(indent, "else:\n");
1853                         print_exec(cs->elsepart, indent+1, bracket);
1854                 }
1855                 break;
1856         }
1857
1858 ###### propagate exec cases
1859         case Xcond_statement:
1860         {
1861                 // forpart and dopart must return Vnone
1862                 // condpart must be bool or match casepart->values
1863                 // thenpart, elsepart, casepart->action must match
1864                 // or be Vnone
1865                 struct cond_statement *cs = cast(cond_statement, prog);
1866                 struct casepart *c;
1867
1868                 t = propagate_types(cs->forpart, Vnone, ok);
1869                 if (t != Vunknown && t != Vnone)
1870                         *ok = 0;
1871                 t = propagate_types(cs->dopart, Vnone, ok);
1872                 if (t != Vunknown && t != Vnone)
1873                         *ok = 0;
1874                 if (cs->casepart == NULL)
1875                         propagate_types(cs->condpart, Vbool, ok);
1876                 else {
1877                         t = Vunknown;
1878                         for (c = cs->casepart;
1879                              c && (t == Vunknown); c = c->next)
1880                                 t = propagate_types(c->value, Vunknown, ok);
1881                         if (t == Vunknown && cs->condpart)
1882                                 t = propagate_types(cs->condpart, Vunknown, ok);
1883                         // Now we have a type (I hope) push it down
1884                         if (t != Vunknown) {
1885                                 for (c = cs->casepart; c; c = c->next)
1886                                         propagate_types(c->value, t, ok);
1887                                 propagate_types(cs->condpart, t, ok);
1888                         }
1889                 }
1890                 if (type == Vunknown || type == Vnone)
1891                         type = propagate_types(cs->thenpart, Vunknown, ok);
1892                 if (type == Vunknown || type == Vnone)
1893                         type = propagate_types(cs->elsepart, Vunknown, ok);
1894                 for (c = cs->casepart;
1895                      c && (type == Vunknown || type == Vnone);
1896                      c = c->next)
1897                         type = propagate_types(c->action, Vunknown, ok);
1898                 if (type != Vunknown && type != Vnone) {
1899                         propagate_types(cs->thenpart, type, ok);
1900                         propagate_types(cs->elsepart, type, ok);
1901                         for (c = cs->casepart; c ; c = c->next)
1902                                 propagate_types(c->action, type, ok);
1903                         return type;
1904                 } else
1905                         return Vunknown;
1906         }
1907
1908 ###### interp exec cases
1909         case Xcond_statement:
1910         {
1911                 struct value v, cnd;
1912                 struct casepart *cp;
1913                 struct cond_statement *c = cast(cond_statement, e);
1914                 if (c->forpart)
1915                         interp_exec(c->forpart);
1916                 do {
1917                         if (c->condpart)
1918                                 cnd = interp_exec(c->condpart);
1919                         else
1920                                 cnd.vtype = Vnone;
1921                         if (!(cnd.vtype == Vnone ||
1922                               (cnd.vtype == Vbool && cnd.bool != 0)))
1923                                 break;
1924                         if (c->dopart) {
1925                                 free_value(cnd);
1926                                 interp_exec(c->dopart);
1927                         }
1928                         if (c->thenpart) {
1929                                 v = interp_exec(c->thenpart);
1930                                 if (v.vtype != Vnone || !c->dopart)
1931                                         return v;
1932                                 free_value(v);
1933                         }
1934                 } while (c->dopart);
1935
1936                 for (cp = c->casepart; cp; cp = cp->next) {
1937                         v = interp_exec(cp->value);
1938                         if (value_cmp(v, cnd) == 0) {
1939                                 free_value(v);
1940                                 free_value(cnd);
1941                                 return interp_exec(cp->action);
1942                         }
1943                         free_value(v);
1944                 }
1945                 free_value(cnd);
1946                 if (c->elsepart)
1947                         return interp_exec(c->elsepart);
1948                 v.vtype = Vnone;
1949                 return v;
1950         }
1951
1952 ### Finally the whole program.
1953
1954 Somewhat reminiscent of Pascal a (current) Ocean program starts with
1955 the keyword "program" and list of variable names which are assigned
1956 values from command line arguments.  Following this is a `block` which
1957 is the code to execute.
1958
1959 As this is the top level, several things are handled a bit
1960 differently.
1961 The whole program is not interpreted by `interp_exec` as that isn't
1962 passed the argument list which the program requires.  Similarly type
1963 analysis is a bit more interesting at this level.
1964
1965 ###### Binode types
1966         Program,
1967
1968 ###### Parser: grammar
1969
1970         $*binode
1971         Program -> program Varlist Block OptNL ${
1972                 $0 = new(binode);
1973                 $0->op = Program;
1974                 $0->left = reorder_bilist($<2);
1975                 $0->right = $<3;
1976         }$
1977
1978         Varlist -> Varlist Variable ${
1979                         $0 = new(binode);
1980                         $0->op = Program;
1981                         $0->left = $<1;
1982                         $0->right = $<2;
1983                 }$
1984                 | ${ $0 = NULL; }$
1985         ## Grammar
1986
1987 ###### print binode cases
1988         case Program:
1989                 do_indent(indent, "program");
1990                 for (b2 = cast(binode, b->left); b2; b2 = cast(binode, b2->right)) {
1991                         printf(" ");
1992                         print_exec(b2->left, 0, 0);
1993                 }
1994                 if (bracket)
1995                         printf(" {\n");
1996                 else
1997                         printf(":\n");
1998                 print_exec(b->right, indent+1, bracket);
1999                 if (bracket)
2000                         do_indent(indent, "}\n");
2001                 break;
2002
2003 ###### propagate binode cases
2004         case Program: abort();
2005
2006 ###### core functions
2007
2008         static int analyse_prog(struct exec *prog, struct parse_context *c)
2009         {
2010                 struct binode *b = cast(binode, prog);
2011                 struct variable *v;
2012                 int ok = 1;
2013                 int uniq = 314159;
2014                 do {
2015                         ok = 1;
2016                         propagate_types(b->right, Vnone, &ok);
2017                 } while (ok == 2);
2018                 if (!ok)
2019                         return 0;
2020
2021                 for (b = cast(binode, b->left); b; b = cast(binode, b->right)) {
2022                         struct var *v = cast(var, b->left);
2023                         if (v->var->val.vtype == Vunknown)
2024                                 val_init(&v->var->val, Vstr);
2025                 }
2026                 b = cast(binode, prog);
2027                 do {
2028                         ok = 1;
2029                         propagate_types(b->right, Vnone, &ok);
2030                 } while (ok == 2);
2031                 if (!ok)
2032                         return 0;
2033
2034                 for (v = c->varlist; v; v = v->next)
2035                         if (v->val.vtype == Vunknown) {
2036                                 v->val.vtype = Vnum;
2037                                 mpq_init(v->val.num);
2038                                 mpq_set_ui(v->val.num, uniq, 1);
2039                                 uniq++;
2040                         }
2041                 /* Make sure everything is still consistent */
2042                 propagate_types(b->right, Vnone, &ok);
2043                 return !!ok;
2044         }
2045
2046         static void interp_prog(struct exec *prog, char **argv)
2047         {
2048                 struct binode *p = cast(binode, prog);
2049                 struct binode *al = cast(binode, p->left);
2050                 struct value v;
2051
2052                 while (al) {
2053                         struct var *v = cast(var, al->left);
2054                         struct value *vl = &v->var->val;
2055
2056                         if (argv[0] == NULL) {
2057                                 printf("Not enough args\n");
2058                                 exit(1);
2059                         }
2060                         al = cast(binode, al->right);
2061                         free_value(*vl);
2062                         if (!parse_value(vl, argv[0]))
2063                                 exit(1);
2064                         argv++;
2065                 }
2066                 v = interp_exec(p->right);
2067                 free_value(v);
2068         }
2069
2070 ###### interp binode cases
2071         case Program: abort();