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