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