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

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