1 # Ocean Interpreter - Jamison Creek version
3 Ocean is intended to be a 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.
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.
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
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
26 Nonetheless, the interpreter should end up being reasonably complete,
27 and any performance bottlenecks which appear and are easily fixed, will
32 This third version of the interpreter exists to test out some initial
33 ideas relating to types. Particularly it adds arrays (indexed from
34 zero) and simple structures. Basic control flow and variable scoping
35 are already fairly well established, as are basic numerical and
38 Some operators that have only recently been added, and so have not
39 generated all that much experience yet are "and then" and "or else" as
40 short-circuit Boolean operators, and the "if ... else" trinary
41 operator which can select between two expressions based on a third
42 (which appears syntactically in the middle).
44 Elements that are present purely to make a usable language, and
45 without any expectation that they will remain, are the "program'
46 clause, which provides a list of variables to received command-line
47 arguments, and the "print" statement which performs simple output.
49 The current scalar types are "number", "Boolean", and "string".
50 Boolean will likely stay in its current form, the other two might, but
51 could just as easily be changed.
55 Versions of the interpreter which obviously do not support a complete
56 language will be named after creeks and streams. This one is Jamison
59 Once we have something reasonably resembling a complete language, the
60 names of rivers will be used.
61 Early versions of the compiler will be named after seas. Major
62 releases of the compiler will be named after oceans. Hopefully I will
63 be finished once I get to the Pacific Ocean release.
67 As well as parsing and executing a program, the interpreter can print
68 out the program from the parsed internal structure. This is useful
69 for validating the parsing.
70 So the main requirements of the interpreter are:
72 - Parse the program, possibly with tracing,
73 - Analyse the parsed program to ensure consistency,
75 - Execute the program, if no parsing or consistency errors were found.
77 This is all performed by a single C program extracted with
80 There will be two formats for printing the program: a default and one
81 that uses bracketing. So a `--bracket` command line option is needed
82 for that. Normally the first code section found is used, however an
83 alternate section can be requested so that a file (such as this one)
84 can contain multiple programs. This is effected with the `--section`
87 This code must be compiled with `-fplan9-extensions` so that anonymous
88 structures can be used.
90 ###### File: oceani.mk
92 myCFLAGS := -Wall -g -fplan9-extensions
93 CFLAGS := $(filter-out $(myCFLAGS),$(CFLAGS)) $(myCFLAGS)
94 myLDLIBS:= libparser.o libscanner.o libmdcode.o -licuuc
95 LDLIBS := $(filter-out $(myLDLIBS),$(LDLIBS)) $(myLDLIBS)
97 all :: $(LDLIBS) oceani
98 oceani.c oceani.h : oceani.mdc parsergen
99 ./parsergen -o oceani --LALR --tag Parser oceani.mdc
100 oceani.mk: oceani.mdc md2c
103 oceani: oceani.o $(LDLIBS)
104 $(CC) $(CFLAGS) -o oceani oceani.o $(LDLIBS)
106 ###### Parser: header
108 struct parse_context;
110 struct parse_context {
111 struct token_config config;
120 #define container_of(ptr, type, member) ({ \
121 const typeof( ((type *)0)->member ) *__mptr = (ptr); \
122 (type *)( (char *)__mptr - offsetof(type,member) );})
124 #define config2context(_conf) container_of(_conf, struct parse_context, \
127 ###### Parser: reduce
128 struct parse_context *c = config2context(config);
136 #include <sys/mman.h>
155 static char Usage[] =
156 "Usage: oceani --trace --print --noexec --brackets --section=SectionName prog.ocn\n";
157 static const struct option long_options[] = {
158 {"trace", 0, NULL, 't'},
159 {"print", 0, NULL, 'p'},
160 {"noexec", 0, NULL, 'n'},
161 {"brackets", 0, NULL, 'b'},
162 {"section", 1, NULL, 's'},
165 const char *options = "tpnbs";
166 int main(int argc, char *argv[])
171 struct section *s, *ss;
172 char *section = NULL;
173 struct parse_context context = {
175 .ignored = (1 << TK_mark),
176 .number_chars = ".,_+- ",
181 int doprint=0, dotrace=0, doexec=1, brackets=0;
183 while ((opt = getopt_long(argc, argv, options, long_options, NULL))
186 case 't': dotrace=1; break;
187 case 'p': doprint=1; break;
188 case 'n': doexec=0; break;
189 case 'b': brackets=1; break;
190 case 's': section = optarg; break;
191 default: fprintf(stderr, Usage);
195 if (optind >= argc) {
196 fprintf(stderr, "oceani: no input file given\n");
199 fd = open(argv[optind], O_RDONLY);
201 fprintf(stderr, "oceani: cannot open %s\n", argv[optind]);
204 context.file_name = argv[optind];
205 len = lseek(fd, 0, 2);
206 file = mmap(NULL, len, PROT_READ, MAP_SHARED, fd, 0);
207 s = code_extract(file, file+len, NULL);
209 fprintf(stderr, "oceani: could not find any code in %s\n",
214 ## context initialization
217 for (ss = s; ss; ss = ss->next) {
218 struct text sec = ss->section;
219 if (sec.len == strlen(section) &&
220 strncmp(sec.txt, section, sec.len) == 0)
224 fprintf(stderr, "oceani: cannot find section %s\n",
230 parse_oceani(ss->code, &context.config, dotrace ? stderr : NULL);
233 fprintf(stderr, "oceani: no program found.\n");
234 context.parse_error = 1;
236 if (context.prog && doprint) {
239 print_exec(context.prog, 0, brackets);
241 if (context.prog && doexec && !context.parse_error) {
242 if (!analyse_prog(context.prog, &context)) {
243 fprintf(stderr, "oceani: type error in program - not running.\n");
246 interp_prog(&context, context.prog, argv+optind+1);
248 free_exec(context.prog);
251 struct section *t = s->next;
257 ## free context types
258 exit(context.parse_error ? 1 : 0);
263 The four requirements of parse, analyse, print, interpret apply to
264 each language element individually so that is how most of the code
267 Three of the four are fairly self explanatory. The one that requires
268 a little explanation is the analysis step.
270 The current language design does not require the types of variables to
271 be declared, but they must still have a single type. Different
272 operations impose different requirements on the variables, for example
273 addition requires both arguments to be numeric, and assignment
274 requires the variable on the left to have the same type as the
275 expression on the right.
277 Analysis involves propagating these type requirements around and
278 consequently setting the type of each variable. If any requirements
279 are violated (e.g. a string is compared with a number) or if a
280 variable needs to have two different types, then an error is raised
281 and the program will not run.
283 If the same variable is declared in both branchs of an 'if/else', or
284 in all cases of a 'switch' then the multiple instances may be merged
285 into just one variable if the variable is referenced after the
286 conditional statement. When this happens, the types must naturally be
287 consistent across all the branches. When the variable is not used
288 outside the if, the variables in the different branches are distinct
289 and can be of different types.
291 Undeclared names may only appear in "use" statements and "case" expressions.
292 These names are given a type of "label" and a unique value.
293 This allows them to fill the role of a name in an enumerated type, which
294 is useful for testing the `switch` statement.
296 As we will see, the condition part of a `while` statement can return
297 either a Boolean or some other type. This requires that the expected
298 type that gets passed around comprises a type and a flag to indicate
299 that `Tbool` is also permitted.
301 As there are, as yet, no distinct types that are compatible, there
302 isn't much subtlety in the analysis. When we have distinct number
303 types, this will become more interesting.
307 When analysis discovers an inconsistency it needs to report an error;
308 just refusing to run the code ensures that the error doesn't cascade,
309 but by itself it isn't very useful. A clear understanding of the sort
310 of error message that are useful will help guide the process of
313 At a simplistic level, the only sort of error that type analysis can
314 report is that the type of some construct doesn't match a contextual
315 requirement. For example, in `4 + "hello"` the addition provides a
316 contextual requirement for numbers, but `"hello"` is not a number. In
317 this particular example no further information is needed as the types
318 are obvious from local information. When a variable is involved that
319 isn't the case. It may be helpful to explain why the variable has a
320 particular type, by indicating the location where the type was set,
321 whether by declaration or usage.
323 Using a recursive-descent analysis we can easily detect a problem at
324 multiple locations. In "`hello:= "there"; 4 + hello`" the addition
325 will detect that one argument is not a number and the usage of `hello`
326 will detect that a number was wanted, but not provided. In this
327 (early) version of the language, we will generate error reports at
328 multiple locations, so the use of `hello` will report an error and
329 explain were the value was set, and the addition will report an error
330 and say why numbers are needed. To be able to report locations for
331 errors, each language element will need to record a file location
332 (line and column) and each variable will need to record the language
333 element where its type was set. For now we will assume that each line
334 of an error message indicates one location in the file, and up to 2
335 types. So we provide a `printf`-like function which takes a format, a
336 location (a `struct exec` which has not yet been introduced), and 2
337 types. "`%1`" reports the first type, "`%2`" reports the second. We
338 will need a function to print the location, once we know how that is
339 stored. e As will be explained later, there are sometimes extra rules for
340 type matching and they might affect error messages, we need to pass those
343 As well as type errors, we sometimes need to report problems with
344 tokens, which might be unexpected or might name a type that has not
345 been defined. For these we have `tok_err()` which reports an error
346 with a given token. Each of the error functions sets the flag in the
347 context so indicate that parsing failed.
351 static void fput_loc(struct exec *loc, FILE *f);
353 ###### core functions
355 static void type_err(struct parse_context *c,
356 char *fmt, struct exec *loc,
357 struct type *t1, int rules, struct type *t2)
359 fprintf(stderr, "%s:", c->file_name);
360 fput_loc(loc, stderr);
361 for (; *fmt ; fmt++) {
368 case '%': fputc(*fmt, stderr); break; // NOTEST
369 default: fputc('?', stderr); break; // NOTEST
371 type_print(t1, stderr);
374 type_print(t2, stderr);
383 static void tok_err(struct parse_context *c, char *fmt, struct token *t)
385 fprintf(stderr, "%s:%d:%d: %s: %.*s\n", c->file_name, t->line, t->col, fmt,
386 t->txt.len, t->txt.txt);
390 ## Entities: declared and predeclared.
392 There are various "things" that the language and/or the interpreter
393 needs to know about to parse and execute a program. These include
394 types, variables, values, and executable code. These are all lumped
395 together under the term "entities" (calling them "objects" would be
396 confusing) and introduced here. The following section will present the
397 different specific code elements which comprise or manipulate these
402 Values come in a wide range of types, with more likely to be added.
403 Each type needs to be able to print its own values (for convenience at
404 least) as well as to compare two values, at least for equality and
405 possibly for order. For now, values might need to be duplicated and
406 freed, though eventually such manipulations will be better integrated
409 Rather than requiring every numeric type to support all numeric
410 operations (add, multiple, etc), we allow types to be able to present
411 as one of a few standard types: integer, float, and fraction. The
412 existence of these conversion functions eventually enable types to
413 determine if they are compatible with other types, though such types
414 have not yet been implemented.
416 Named type are stored in a simple linked list. Objects of each type are
417 "values" which are often passed around by value.
424 ## value union fields
432 void (*init)(struct type *type, struct value *val);
433 void (*prepare_type)(struct parse_context *c, struct type *type, int parse_time);
434 void (*print)(struct type *type, struct value *val);
435 void (*print_type)(struct type *type, FILE *f);
436 int (*cmp_order)(struct type *t1, struct type *t2,
437 struct value *v1, struct value *v2);
438 int (*cmp_eq)(struct type *t1, struct type *t2,
439 struct value *v1, struct value *v2);
440 void (*dup)(struct type *type, struct value *vold, struct value *vnew);
441 void (*free)(struct type *type, struct value *val);
442 void (*free_type)(struct type *t);
443 long long (*to_int)(struct value *v);
444 double (*to_float)(struct value *v);
445 int (*to_mpq)(mpq_t *q, struct value *v);
454 struct type *typelist;
458 static struct type *find_type(struct parse_context *c, struct text s)
460 struct type *l = c->typelist;
463 text_cmp(l->name, s) != 0)
468 static struct type *add_type(struct parse_context *c, struct text s,
473 n = calloc(1, sizeof(*n));
476 n->next = c->typelist;
481 static void free_type(struct type *t)
483 /* The type is always a reference to something in the
484 * context, so we don't need to free anything.
488 static void free_value(struct type *type, struct value *v)
494 static void type_print(struct type *type, FILE *f)
497 fputs("*unknown*type*", f);
498 else if (type->name.len)
499 fprintf(f, "%.*s", type->name.len, type->name.txt);
500 else if (type->print_type)
501 type->print_type(type, f);
503 fputs("*invalid*type*", f); // NOTEST
506 static void val_init(struct type *type, struct value *val)
508 if (type && type->init)
509 type->init(type, val);
512 static void dup_value(struct type *type,
513 struct value *vold, struct value *vnew)
515 if (type && type->dup)
516 type->dup(type, vold, vnew);
519 static int value_cmp(struct type *tl, struct type *tr,
520 struct value *left, struct value *right)
522 if (tl && tl->cmp_order)
523 return tl->cmp_order(tl, tr, left, right);
524 if (tl && tl->cmp_eq)
525 return tl->cmp_eq(tl, tr, left, right);
529 static void print_value(struct type *type, struct value *v)
531 if (type && type->print)
532 type->print(type, v);
534 printf("*Unknown*"); // NOTEST
537 static struct value *val_alloc(struct parse_context *c, struct type *t,
543 t->prepare_type(c, t, 0);
545 ret = calloc(1, t->size);
547 memcpy(ret, init, t->size);
555 static void free_value(struct type *type, struct value *v);
556 static int type_compat(struct type *require, struct type *have, int rules);
557 static void type_print(struct type *type, FILE *f);
558 static void val_init(struct type *type, struct value *v);
559 static void dup_value(struct type *type,
560 struct value *vold, struct value *vnew);
561 static int value_cmp(struct type *tl, struct type *tr,
562 struct value *left, struct value *right);
563 static void print_value(struct type *type, struct value *v);
565 ###### free context types
567 while (context.typelist) {
568 struct type *t = context.typelist;
570 context.typelist = t->next;
578 Values of the base types can be numbers, which we represent as
579 multi-precision fractions, strings, Booleans and labels. When
580 analysing the program we also need to allow for places where no value
581 is meaningful (type `Tnone`) and where we don't know what type to
582 expect yet (type is `NULL`).
584 Values are never shared, they are always copied when used, and freed
585 when no longer needed.
587 When propagating type information around the program, we need to
588 determine if two types are compatible, where type `NULL` is compatible
589 with anything. There are two special cases with type compatibility,
590 both related to the Conditional Statement which will be described
591 later. In some cases a Boolean can be accepted as well as some other
592 primary type, and in others any type is acceptable except a label (`Vlabel`).
593 A separate function encoding these cases will simplify some code later.
597 int (*compat)(struct type *this, struct type *other);
601 static int type_compat(struct type *require, struct type *have, int rules)
603 if ((rules & Rboolok) && have == Tbool)
605 if ((rules & Rnolabel) && have == Tlabel)
607 if (!require || !have)
611 return require->compat(require, have);
613 return require == have;
618 #include "parse_string.h"
619 #include "parse_number.h"
622 myLDLIBS := libnumber.o libstring.o -lgmp
623 LDLIBS := $(filter-out $(myLDLIBS),$(LDLIBS)) $(myLDLIBS)
625 ###### type union fields
626 enum vtype {Vnone, Vstr, Vnum, Vbool, Vlabel} vtype;
628 ###### value union fields
635 static void _free_value(struct type *type, struct value *v)
639 switch (type->vtype) {
641 case Vstr: free(v->str.txt); break;
642 case Vnum: mpq_clear(v->num); break;
648 ###### value functions
650 static void _val_init(struct type *type, struct value *val)
652 switch(type->vtype) {
653 case Vnone: // NOTEST
656 mpq_init(val->num); break;
658 val->str.txt = malloc(1);
664 case Vlabel: // NOTEST
665 val->label = NULL; // NOTEST
670 static void _dup_value(struct type *type,
671 struct value *vold, struct value *vnew)
673 switch (type->vtype) {
674 case Vnone: // NOTEST
677 vnew->label = vold->label;
680 vnew->bool = vold->bool;
684 mpq_set(vnew->num, vold->num);
687 vnew->str.len = vold->str.len;
688 vnew->str.txt = malloc(vnew->str.len);
689 memcpy(vnew->str.txt, vold->str.txt, vnew->str.len);
694 static int _value_cmp(struct type *tl, struct type *tr,
695 struct value *left, struct value *right)
699 return tl - tr; // NOTEST
701 case Vlabel: cmp = left->label == right->label ? 0 : 1; break;
702 case Vnum: cmp = mpq_cmp(left->num, right->num); break;
703 case Vstr: cmp = text_cmp(left->str, right->str); break;
704 case Vbool: cmp = left->bool - right->bool; break;
705 case Vnone: cmp = 0; // NOTEST
710 static void _print_value(struct type *type, struct value *v)
712 switch (type->vtype) {
713 case Vnone: // NOTEST
714 printf("*no-value*"); break; // NOTEST
715 case Vlabel: // NOTEST
716 printf("*label-%p*", v->label); break; // NOTEST
718 printf("%.*s", v->str.len, v->str.txt); break;
720 printf("%s", v->bool ? "True":"False"); break;
725 mpf_set_q(fl, v->num);
726 gmp_printf("%Fg", fl);
733 static void _free_value(struct type *type, struct value *v);
735 static struct type base_prototype = {
737 .print = _print_value,
738 .cmp_order = _value_cmp,
739 .cmp_eq = _value_cmp,
744 static struct type *Tbool, *Tstr, *Tnum, *Tnone, *Tlabel;
747 static struct type *add_base_type(struct parse_context *c, char *n,
748 enum vtype vt, int size)
750 struct text txt = { n, strlen(n) };
753 t = add_type(c, txt, &base_prototype);
756 t->align = size > sizeof(void*) ? sizeof(void*) : size;
757 if (t->size & (t->align - 1))
758 t->size = (t->size | (t->align - 1)) + 1;
762 ###### context initialization
764 Tbool = add_base_type(&context, "Boolean", Vbool, sizeof(char));
765 Tstr = add_base_type(&context, "string", Vstr, sizeof(struct text));
766 Tnum = add_base_type(&context, "number", Vnum, sizeof(mpq_t));
767 Tnone = add_base_type(&context, "none", Vnone, 0);
768 Tlabel = add_base_type(&context, "label", Vlabel, sizeof(void*));
772 Variables are scoped named values. We store the names in a linked list
773 of "bindings" sorted in lexical order, and use sequential search and
780 struct binding *next; // in lexical order
784 This linked list is stored in the parse context so that "reduce"
785 functions can find or add variables, and so the analysis phase can
786 ensure that every variable gets a type.
790 struct binding *varlist; // In lexical order
794 static struct binding *find_binding(struct parse_context *c, struct text s)
796 struct binding **l = &c->varlist;
801 (cmp = text_cmp((*l)->name, s)) < 0)
805 n = calloc(1, sizeof(*n));
812 Each name can be linked to multiple variables defined in different
813 scopes. Each scope starts where the name is declared and continues
814 until the end of the containing code block. Scopes of a given name
815 cannot nest, so a declaration while a name is in-scope is an error.
817 ###### binding fields
818 struct variable *var;
822 struct variable *previous;
825 struct binding *name;
826 struct exec *where_decl;// where name was declared
827 struct exec *where_set; // where type was set
831 While the naming seems strange, we include local constants in the
832 definition of variables. A name declared `var := value` can
833 subsequently be changed, but a name declared `var ::= value` cannot -
836 ###### variable fields
839 Scopes in parallel branches can be partially merged. More
840 specifically, if a given name is declared in both branches of an
841 if/else then its scope is a candidate for merging. Similarly if
842 every branch of an exhaustive switch (e.g. has an "else" clause)
843 declares a given name, then the scopes from the branches are
844 candidates for merging.
846 Note that names declared inside a loop (which is only parallel to
847 itself) are never visible after the loop. Similarly names defined in
848 scopes which are not parallel, such as those started by `for` and
849 `switch`, are never visible after the scope. Only variables defined in
850 both `then` and `else` (including the implicit then after an `if`, and
851 excluding `then` used with `for`) and in all `case`s and `else` of a
852 `switch` or `while` can be visible beyond the `if`/`switch`/`while`.
854 Labels, which are a bit like variables, follow different rules.
855 Labels are not explicitly declared, but if an undeclared name appears
856 in a context where a label is legal, that effectively declares the
857 name as a label. The declaration remains in force (or in scope) at
858 least to the end of the immediately containing block and conditionally
859 in any larger containing block which does not declare the name in some
860 other way. Importantly, the conditional scope extension happens even
861 if the label is only used in one parallel branch of a conditional --
862 when used in one branch it is treated as having been declared in all
865 Merge candidates are tentatively visible beyond the end of the
866 branching statement which creates them. If the name is used, the
867 merge is affirmed and they become a single variable visible at the
868 outer layer. If not - if it is redeclared first - the merge lapses.
870 To track scopes we have an extra stack, implemented as a linked list,
871 which roughly parallels the parse stack and which is used exclusively
872 for scoping. When a new scope is opened, a new frame is pushed and
873 the child-count of the parent frame is incremented. This child-count
874 is used to distinguish between the first of a set of parallel scopes,
875 in which declared variables must not be in scope, and subsequent
876 branches, whether they may already be conditionally scoped.
878 To push a new frame *before* any code in the frame is parsed, we need a
879 grammar reduction. This is most easily achieved with a grammar
880 element which derives the empty string, and creates the new scope when
881 it is recognised. This can be placed, for example, between a keyword
882 like "if" and the code following it.
886 struct scope *parent;
892 struct scope *scope_stack;
895 static void scope_pop(struct parse_context *c)
897 struct scope *s = c->scope_stack;
899 c->scope_stack = s->parent;
904 static void scope_push(struct parse_context *c)
906 struct scope *s = calloc(1, sizeof(*s));
908 c->scope_stack->child_count += 1;
909 s->parent = c->scope_stack;
917 OpenScope -> ${ scope_push(c); }$
918 ClosePara -> ${ var_block_close(c, CloseParallel); }$
920 Each variable records a scope depth and is in one of four states:
922 - "in scope". This is the case between the declaration of the
923 variable and the end of the containing block, and also between
924 the usage with affirms a merge and the end of that block.
926 The scope depth is not greater than the current parse context scope
927 nest depth. When the block of that depth closes, the state will
928 change. To achieve this, all "in scope" variables are linked
929 together as a stack in nesting order.
931 - "pending". The "in scope" block has closed, but other parallel
932 scopes are still being processed. So far, every parallel block at
933 the same level that has closed has declared the name.
935 The scope depth is the depth of the last parallel block that
936 enclosed the declaration, and that has closed.
938 - "conditionally in scope". The "in scope" block and all parallel
939 scopes have closed, and no further mention of the name has been
940 seen. This state includes a secondary nest depth which records the
941 outermost scope seen since the variable became conditionally in
942 scope. If a use of the name is found, the variable becomes "in
943 scope" and that secondary depth becomes the recorded scope depth.
944 If the name is declared as a new variable, the old variable becomes
945 "out of scope" and the recorded scope depth stays unchanged.
947 - "out of scope". The variable is neither in scope nor conditionally
948 in scope. It is permanently out of scope now and can be removed from
949 the "in scope" stack.
951 ###### variable fields
952 int depth, min_depth;
953 enum { OutScope, PendingScope, CondScope, InScope } scope;
954 struct variable *in_scope;
958 struct variable *in_scope;
960 All variables with the same name are linked together using the
961 'previous' link. Those variable that have been affirmatively merged all
962 have a 'merged' pointer that points to one primary variable - the most
963 recently declared instance. When merging variables, we need to also
964 adjust the 'merged' pointer on any other variables that had previously
965 been merged with the one that will no longer be primary.
967 A variable that is no longer the most recent instance of a name may
968 still have "pending" scope, if it might still be merged with most
969 recent instance. These variables don't really belong in the
970 "in_scope" list, but are not immediately removed when a new instance
971 is found. Instead, they are detected and ignored when considering the
972 list of in_scope names.
974 ###### variable fields
975 struct variable *merged;
979 static void variable_merge(struct variable *primary, struct variable *secondary)
985 primary = primary->merged;
987 for (v = primary->previous; v; v=v->previous)
988 if (v == secondary || v == secondary->merged ||
989 v->merged == secondary ||
990 (v->merged && v->merged == secondary->merged)) {
996 ###### free context vars
998 while (context.varlist) {
999 struct binding *b = context.varlist;
1000 struct variable *v = b->var;
1001 context.varlist = b->next;
1004 struct variable *t = v;
1007 free_value(t->type, t->val);
1010 // This is a global constant
1011 free_exec(t->where_decl);
1016 #### Manipulating Bindings
1018 When a name is conditionally visible, a new declaration discards the
1019 old binding - the condition lapses. Conversely a usage of the name
1020 affirms the visibility and extends it to the end of the containing
1021 block - i.e. the block that contains both the original declaration and
1022 the latest usage. This is determined from `min_depth`. When a
1023 conditionally visible variable gets affirmed like this, it is also
1024 merged with other conditionally visible variables with the same name.
1026 When we parse a variable declaration we either report an error if the
1027 name is currently bound, or create a new variable at the current nest
1028 depth if the name is unbound or bound to a conditionally scoped or
1029 pending-scope variable. If the previous variable was conditionally
1030 scoped, it and its homonyms becomes out-of-scope.
1032 When we parse a variable reference (including non-declarative assignment
1033 "foo = bar") we report an error if the name is not bound or is bound to
1034 a pending-scope variable; update the scope if the name is bound to a
1035 conditionally scoped variable; or just proceed normally if the named
1036 variable is in scope.
1038 When we exit a scope, any variables bound at this level are either
1039 marked out of scope or pending-scoped, depending on whether the scope
1040 was sequential or parallel. Here a "parallel" scope means the "then"
1041 or "else" part of a conditional, or any "case" or "else" branch of a
1042 switch. Other scopes are "sequential".
1044 When exiting a parallel scope we check if there are any variables that
1045 were previously pending and are still visible. If there are, then
1046 there weren't redeclared in the most recent scope, so they cannot be
1047 merged and must become out-of-scope. If it is not the first of
1048 parallel scopes (based on `child_count`), we check that there was a
1049 previous binding that is still pending-scope. If there isn't, the new
1050 variable must now be out-of-scope.
1052 When exiting a sequential scope that immediately enclosed parallel
1053 scopes, we need to resolve any pending-scope variables. If there was
1054 no `else` clause, and we cannot determine that the `switch` was exhaustive,
1055 we need to mark all pending-scope variable as out-of-scope. Otherwise
1056 all pending-scope variables become conditionally scoped.
1059 enum closetype { CloseSequential, CloseParallel, CloseElse };
1061 ###### ast functions
1063 static struct variable *var_decl(struct parse_context *c, struct text s)
1065 struct binding *b = find_binding(c, s);
1066 struct variable *v = b->var;
1068 switch (v ? v->scope : OutScope) {
1070 /* Caller will report the error */
1074 v && v->scope == CondScope;
1076 v->scope = OutScope;
1080 v = calloc(1, sizeof(*v));
1081 v->previous = b->var;
1084 v->min_depth = v->depth = c->scope_depth;
1086 v->in_scope = c->in_scope;
1092 static struct variable *var_ref(struct parse_context *c, struct text s)
1094 struct binding *b = find_binding(c, s);
1095 struct variable *v = b->var;
1096 struct variable *v2;
1098 switch (v ? v->scope : OutScope) {
1101 /* Caller will report the error */
1104 /* All CondScope variables of this name need to be merged
1105 * and become InScope
1107 v->depth = v->min_depth;
1109 for (v2 = v->previous;
1110 v2 && v2->scope == CondScope;
1112 variable_merge(v, v2);
1120 static void var_block_close(struct parse_context *c, enum closetype ct)
1122 /* Close off all variables that are in_scope */
1123 struct variable *v, **vp, *v2;
1126 for (vp = &c->in_scope;
1127 v = *vp, v && v->depth > c->scope_depth && v->min_depth > c->scope_depth;
1129 if (v->name->var == v) switch (ct) {
1131 case CloseParallel: /* handle PendingScope */
1135 if (c->scope_stack->child_count == 1)
1136 v->scope = PendingScope;
1137 else if (v->previous &&
1138 v->previous->scope == PendingScope)
1139 v->scope = PendingScope;
1140 else if (v->type == Tlabel)
1141 v->scope = PendingScope;
1142 else if (v->name->var == v)
1143 v->scope = OutScope;
1144 if (ct == CloseElse) {
1145 /* All Pending variables with this name
1146 * are now Conditional */
1148 v2 && v2->scope == PendingScope;
1150 v2->scope = CondScope;
1155 v2 && v2->scope == PendingScope;
1157 if (v2->type != Tlabel)
1158 v2->scope = OutScope;
1160 case OutScope: break;
1163 case CloseSequential:
1164 if (v->type == Tlabel)
1165 v->scope = PendingScope;
1168 v->scope = OutScope;
1171 /* There was no 'else', so we can only become
1172 * conditional if we know the cases were exhaustive,
1173 * and that doesn't mean anything yet.
1174 * So only labels become conditional..
1177 v2 && v2->scope == PendingScope;
1179 if (v2->type == Tlabel) {
1180 v2->scope = CondScope;
1181 v2->min_depth = c->scope_depth;
1183 v2->scope = OutScope;
1186 case OutScope: break;
1190 if (v->scope == OutScope || v->name->var != v)
1199 Executables can be lots of different things. In many cases an
1200 executable is just an operation combined with one or two other
1201 executables. This allows for expressions and lists etc. Other times an
1202 executable is something quite specific like a constant or variable name.
1203 So we define a `struct exec` to be a general executable with a type, and
1204 a `struct binode` which is a subclass of `exec`, forms a node in a
1205 binary tree, and holds an operation. There will be other subclasses,
1206 and to access these we need to be able to `cast` the `exec` into the
1207 various other types. The first field in any `struct exec` is the type
1208 from the `exec_types` enum.
1211 #define cast(structname, pointer) ({ \
1212 const typeof( ((struct structname *)0)->type) *__mptr = &(pointer)->type; \
1213 if (__mptr && *__mptr != X##structname) abort(); \
1214 (struct structname *)( (char *)__mptr);})
1216 #define new(structname) ({ \
1217 struct structname *__ptr = ((struct structname *)calloc(1,sizeof(struct structname))); \
1218 __ptr->type = X##structname; \
1219 __ptr->line = -1; __ptr->column = -1; \
1222 #define new_pos(structname, token) ({ \
1223 struct structname *__ptr = ((struct structname *)calloc(1,sizeof(struct structname))); \
1224 __ptr->type = X##structname; \
1225 __ptr->line = token.line; __ptr->column = token.col; \
1234 enum exec_types type;
1242 struct exec *left, *right;
1245 ###### ast functions
1247 static int __fput_loc(struct exec *loc, FILE *f)
1251 if (loc->line >= 0) {
1252 fprintf(f, "%d:%d: ", loc->line, loc->column);
1255 if (loc->type == Xbinode)
1256 return __fput_loc(cast(binode,loc)->left, f) ||
1257 __fput_loc(cast(binode,loc)->right, f);
1260 static void fput_loc(struct exec *loc, FILE *f)
1262 if (!__fput_loc(loc, f))
1263 fprintf(f, "??:??: "); // NOTEST
1266 Each different type of `exec` node needs a number of functions defined,
1267 a bit like methods. We must be able to free it, print it, analyse it
1268 and execute it. Once we have specific `exec` types we will need to
1269 parse them too. Let's take this a bit more slowly.
1273 The parser generator requires a `free_foo` function for each struct
1274 that stores attributes and they will often be `exec`s and subtypes
1275 there-of. So we need `free_exec` which can handle all the subtypes,
1276 and we need `free_binode`.
1278 ###### ast functions
1280 static void free_binode(struct binode *b)
1285 free_exec(b->right);
1289 ###### core functions
1290 static void free_exec(struct exec *e)
1299 ###### forward decls
1301 static void free_exec(struct exec *e);
1303 ###### free exec cases
1304 case Xbinode: free_binode(cast(binode, e)); break;
1308 Printing an `exec` requires that we know the current indent level for
1309 printing line-oriented components. As will become clear later, we
1310 also want to know what sort of bracketing to use.
1312 ###### ast functions
1314 static void do_indent(int i, char *str)
1321 ###### core functions
1322 static void print_binode(struct binode *b, int indent, int bracket)
1326 ## print binode cases
1330 static void print_exec(struct exec *e, int indent, int bracket)
1336 print_binode(cast(binode, e), indent, bracket); break;
1341 ###### forward decls
1343 static void print_exec(struct exec *e, int indent, int bracket);
1347 As discussed, analysis involves propagating type requirements around the
1348 program and looking for errors.
1350 So `propagate_types` is passed an expected type (being a `struct type`
1351 pointer together with some `val_rules` flags) that the `exec` is
1352 expected to return, and returns the type that it does return, either
1353 of which can be `NULL` signifying "unknown". An `ok` flag is passed
1354 by reference. It is set to `0` when an error is found, and `2` when
1355 any change is made. If it remains unchanged at `1`, then no more
1356 propagation is needed.
1360 enum val_rules {Rnolabel = 1<<0, Rboolok = 1<<1, Rnoconstant = 2<<1};
1364 if (rules & Rnolabel)
1365 fputs(" (labels not permitted)", stderr);
1368 ###### core functions
1370 static struct type *propagate_types(struct exec *prog, struct parse_context *c, int *ok,
1371 struct type *type, int rules);
1372 static struct type *__propagate_types(struct exec *prog, struct parse_context *c, int *ok,
1373 struct type *type, int rules)
1380 switch (prog->type) {
1383 struct binode *b = cast(binode, prog);
1385 ## propagate binode cases
1389 ## propagate exec cases
1394 static struct type *propagate_types(struct exec *prog, struct parse_context *c, int *ok,
1395 struct type *type, int rules)
1397 struct type *ret = __propagate_types(prog, c, ok, type, rules);
1406 Interpreting an `exec` doesn't require anything but the `exec`. State
1407 is stored in variables and each variable will be directly linked from
1408 within the `exec` tree. The exception to this is the whole `program`
1409 which needs to look at command line arguments. The `program` will be
1410 interpreted separately.
1412 Each `exec` can return a value combined with a type in `struct lrval`.
1413 The type may be `Tnone` but must be non-NULL. Some `exec`s will return
1414 the location of a value, which can be updated, in `lval`. Others will
1415 set `lval` to NULL indicating that there is a value of appropriate type
1419 ###### core functions
1423 struct value rval, *lval;
1426 static struct lrval _interp_exec(struct parse_context *c, struct exec *e);
1428 static struct value interp_exec(struct parse_context *c, struct exec *e,
1429 struct type **typeret)
1431 struct lrval ret = _interp_exec(c, e);
1433 if (!ret.type) abort();
1435 *typeret = ret.type;
1437 dup_value(ret.type, ret.lval, &ret.rval);
1441 static struct value *linterp_exec(struct parse_context *c, struct exec *e,
1442 struct type **typeret)
1444 struct lrval ret = _interp_exec(c, e);
1447 *typeret = ret.type;
1449 free_value(ret.type, &ret.rval);
1453 static struct lrval _interp_exec(struct parse_context *c, struct exec *e)
1456 struct value rv = {}, *lrv = NULL;
1457 struct type *rvtype;
1459 rvtype = ret.type = Tnone;
1469 struct binode *b = cast(binode, e);
1470 struct value left, right, *lleft;
1471 struct type *ltype, *rtype;
1472 ltype = rtype = Tnone;
1474 ## interp binode cases
1476 free_value(ltype, &left);
1477 free_value(rtype, &right);
1480 ## interp exec cases
1490 Now that we have the shape of the interpreter in place we can add some
1491 complex types and connected them in to the data structures and the
1492 different phases of parse, analyse, print, interpret.
1494 Thus far we have arrays and structs.
1498 Arrays can be declared by giving a size and a type, as `[size]type' so
1499 `freq:[26]number` declares `freq` to be an array of 26 numbers. The
1500 size can be either a literal number, or a named constant. Some day an
1501 arbitrary expression will be supported.
1503 Arrays cannot be assigned. When pointers are introduced we will also
1504 introduce array slices which can refer to part or all of an array -
1505 the assignment syntax will create a slice. For now, an array can only
1506 ever be referenced by the name it is declared with. It is likely that
1507 a "`copy`" primitive will eventually be define which can be used to
1508 make a copy of an array with controllable recursive depth.
1510 For now we have two sorts of array, those with fixed size either because
1511 it is given as a literal number or because it is a struct member (which
1512 cannot have a runtime-changing size), and those with a size that is
1513 determined at runtime - local variables with a const size. The former
1514 have their size calculated at parse time, the latter at run time.
1516 For the latter type, the `size` field of the type is the size of a
1517 pointer, and the array is reallocated every time it comes into scope.
1519 We differentiate struct fields with a const size from local variables
1520 with a const size by whether they are prepared at parse time or not.
1522 ###### type union fields
1527 struct variable *vsize;
1528 struct type *member;
1531 ###### value union fields
1532 void *array; // used if not static_size
1534 ###### value functions
1536 static void array_prepare_type(struct parse_context *c, struct type *type,
1540 if (!type->array.vsize || type->array.static_size)
1544 mpz_tdiv_q(q, mpq_numref(type->array.vsize->val->num),
1545 mpq_denref(type->array.vsize->val->num));
1546 type->array.size = mpz_get_si(q);
1550 type->array.static_size = 1;
1551 type->size = type->array.size * type->array.member->size;
1552 type->align = type->array.member->align;
1556 static void array_init(struct type *type, struct value *val)
1559 void *ptr = val->ptr;
1563 if (!type->array.static_size) {
1564 val->array = calloc(type->array.size,
1565 type->array.member->size);
1568 for (i = 0; i < type->array.size; i++) {
1570 v = (void*)ptr + i * type->array.member->size;
1571 val_init(type->array.member, v);
1575 static void array_free(struct type *type, struct value *val)
1578 void *ptr = val->ptr;
1580 if (!type->array.static_size)
1582 for (i = 0; i < type->array.size; i++) {
1584 v = (void*)ptr + i * type->array.member->size;
1585 free_value(type->array.member, v);
1587 if (!type->array.static_size)
1591 static int array_compat(struct type *require, struct type *have)
1593 if (have->compat != require->compat)
1595 /* Both are arrays, so we can look at details */
1596 if (!type_compat(require->array.member, have->array.member, 0))
1598 if (require->array.vsize == NULL && have->array.vsize == NULL)
1599 return require->array.size == have->array.size;
1601 return require->array.vsize == have->array.vsize;
1604 static void array_print_type(struct type *type, FILE *f)
1607 if (type->array.vsize) {
1608 struct binding *b = type->array.vsize->name;
1609 fprintf(f, "%.*s]", b->name.len, b->name.txt);
1611 fprintf(f, "%d]", type->array.size);
1612 type_print(type->array.member, f);
1615 static struct type array_prototype = {
1617 .prepare_type = array_prepare_type,
1618 .print_type = array_print_type,
1619 .compat = array_compat,
1621 .size = sizeof(void*),
1622 .align = sizeof(void*),
1625 ###### declare terminals
1630 | [ NUMBER ] Type ${ {
1633 struct text noname = { "", 0 };
1636 $0 = t = add_type(c, noname, &array_prototype);
1637 t->array.member = $<4;
1638 t->array.vsize = NULL;
1639 if (number_parse(num, tail, $2.txt) == 0)
1640 tok_err(c, "error: unrecognised number", &$2);
1642 tok_err(c, "error: unsupported number suffix", &$2);
1644 t->array.size = mpz_get_ui(mpq_numref(num));
1645 if (mpz_cmp_ui(mpq_denref(num), 1) != 0) {
1646 tok_err(c, "error: array size must be an integer",
1648 } else if (mpz_cmp_ui(mpq_numref(num), 1UL << 30) >= 0)
1649 tok_err(c, "error: array size is too large",
1653 t->array.static_size = 1;
1654 t->size = t->array.size * t->array.member->size;
1655 t->align = t->array.member->align;
1658 | [ IDENTIFIER ] Type ${ {
1659 struct variable *v = var_ref(c, $2.txt);
1660 struct text noname = { "", 0 };
1663 tok_err(c, "error: name undeclared", &$2);
1664 else if (!v->constant)
1665 tok_err(c, "error: array size must be a constant", &$2);
1667 $0 = add_type(c, noname, &array_prototype);
1668 $0->array.member = $<4;
1670 $0->array.vsize = v;
1676 ###### variable grammar
1678 | Variable [ Expression ] ${ {
1679 struct binode *b = new(binode);
1686 ###### print binode cases
1688 print_exec(b->left, -1, bracket);
1690 print_exec(b->right, -1, bracket);
1694 ###### propagate binode cases
1696 /* left must be an array, right must be a number,
1697 * result is the member type of the array
1699 propagate_types(b->right, c, ok, Tnum, 0);
1700 t = propagate_types(b->left, c, ok, NULL, rules & Rnoconstant);
1701 if (!t || t->compat != array_compat) {
1702 type_err(c, "error: %1 cannot be indexed", prog, t, 0, NULL);
1705 if (!type_compat(type, t->array.member, rules)) {
1706 type_err(c, "error: have %1 but need %2", prog,
1707 t->array.member, rules, type);
1709 return t->array.member;
1713 ###### interp binode cases
1719 lleft = linterp_exec(c, b->left, <ype);
1720 right = interp_exec(c, b->right, &rtype);
1722 mpz_tdiv_q(q, mpq_numref(right.num), mpq_denref(right.num));
1726 if (ltype->array.static_size)
1729 ptr = *(void**)lleft;
1730 rvtype = ltype->array.member;
1731 if (i >= 0 && i < ltype->array.size)
1732 lrv = ptr + i * rvtype->size;
1734 val_init(ltype->array.member, &rv);
1741 A `struct` is a data-type that contains one or more other data-types.
1742 It differs from an array in that each member can be of a different
1743 type, and they are accessed by name rather than by number. Thus you
1744 cannot choose an element by calculation, you need to know what you
1747 The language makes no promises about how a given structure will be
1748 stored in memory - it is free to rearrange fields to suit whatever
1749 criteria seems important.
1751 Structs are declared separately from program code - they cannot be
1752 declared in-line in a variable declaration like arrays can. A struct
1753 is given a name and this name is used to identify the type - the name
1754 is not prefixed by the word `struct` as it would be in C.
1756 Structs are only treated as the same if they have the same name.
1757 Simply having the same fields in the same order is not enough. This
1758 might change once we can create structure initializers from a list of
1761 Each component datum is identified much like a variable is declared,
1762 with a name, one or two colons, and a type. The type cannot be omitted
1763 as there is no opportunity to deduce the type from usage. An initial
1764 value can be given following an equals sign, so
1766 ##### Example: a struct type
1772 would declare a type called "complex" which has two number fields,
1773 each initialised to zero.
1775 Struct will need to be declared separately from the code that uses
1776 them, so we will need to be able to print out the declaration of a
1777 struct when reprinting the whole program. So a `print_type_decl` type
1778 function will be needed.
1780 ###### type union fields
1792 ###### type functions
1793 void (*print_type_decl)(struct type *type, FILE *f);
1795 ###### value functions
1797 static void structure_init(struct type *type, struct value *val)
1801 for (i = 0; i < type->structure.nfields; i++) {
1803 v = (void*) val->ptr + type->structure.fields[i].offset;
1804 if (type->structure.fields[i].init)
1805 dup_value(type->structure.fields[i].type,
1806 type->structure.fields[i].init,
1809 val_init(type->structure.fields[i].type, v);
1813 static void structure_free(struct type *type, struct value *val)
1817 for (i = 0; i < type->structure.nfields; i++) {
1819 v = (void*)val->ptr + type->structure.fields[i].offset;
1820 free_value(type->structure.fields[i].type, v);
1824 static void structure_free_type(struct type *t)
1827 for (i = 0; i < t->structure.nfields; i++)
1828 if (t->structure.fields[i].init) {
1829 free_value(t->structure.fields[i].type,
1830 t->structure.fields[i].init);
1831 free(t->structure.fields[i].init);
1833 free(t->structure.fields);
1836 static struct type structure_prototype = {
1837 .init = structure_init,
1838 .free = structure_free,
1839 .free_type = structure_free_type,
1840 .print_type_decl = structure_print_type,
1854 ###### free exec cases
1856 free_exec(cast(fieldref, e)->left);
1860 ###### declare terminals
1863 ###### variable grammar
1865 | Variable . IDENTIFIER ${ {
1866 struct fieldref *fr = new_pos(fieldref, $2);
1873 ###### print exec cases
1877 struct fieldref *f = cast(fieldref, e);
1878 print_exec(f->left, -1, bracket);
1879 printf(".%.*s", f->name.len, f->name.txt);
1883 ###### ast functions
1884 static int find_struct_index(struct type *type, struct text field)
1887 for (i = 0; i < type->structure.nfields; i++)
1888 if (text_cmp(type->structure.fields[i].name, field) == 0)
1893 ###### propagate exec cases
1897 struct fieldref *f = cast(fieldref, prog);
1898 struct type *st = propagate_types(f->left, c, ok, NULL, 0);
1901 type_err(c, "error: unknown type for field access", f->left,
1903 else if (st->init != structure_init)
1904 type_err(c, "error: field reference attempted on %1, not a struct",
1905 f->left, st, 0, NULL);
1906 else if (f->index == -2) {
1907 f->index = find_struct_index(st, f->name);
1909 type_err(c, "error: cannot find requested field in %1",
1910 f->left, st, 0, NULL);
1912 if (f->index >= 0) {
1913 struct type *ft = st->structure.fields[f->index].type;
1914 if (!type_compat(type, ft, rules))
1915 type_err(c, "error: have %1 but need %2", prog,
1922 ###### interp exec cases
1925 struct fieldref *f = cast(fieldref, e);
1927 struct value *lleft = linterp_exec(c, f->left, <ype);
1928 lrv = (void*)lleft->ptr + ltype->structure.fields[f->index].offset;
1929 rvtype = ltype->structure.fields[f->index].type;
1935 struct fieldlist *prev;
1939 ###### ast functions
1940 static void free_fieldlist(struct fieldlist *f)
1944 free_fieldlist(f->prev);
1946 free_value(f->f.type, f->f.init);
1952 ###### top level grammar
1953 DeclareStruct -> struct IDENTIFIER FieldBlock Newlines ${ {
1955 add_type(c, $2.txt, &structure_prototype);
1957 struct fieldlist *f;
1959 for (f = $3; f; f=f->prev)
1962 t->structure.nfields = cnt;
1963 t->structure.fields = calloc(cnt, sizeof(struct field));
1966 int a = f->f.type->align;
1968 t->structure.fields[cnt] = f->f;
1969 if (t->size & (a-1))
1970 t->size = (t->size | (a-1)) + 1;
1971 t->structure.fields[cnt].offset = t->size;
1972 t->size += ((f->f.type->size - 1) | (a-1)) + 1;
1981 FieldBlock -> { IN OptNL FieldLines OUT OptNL } ${ $0 = $<FL; }$
1982 | { SimpleFieldList } ${ $0 = $<SFL; }$
1983 | IN OptNL FieldLines OUT ${ $0 = $<FL; }$
1984 | SimpleFieldList EOL ${ $0 = $<SFL; }$
1986 FieldLines -> SimpleFieldList Newlines ${ $0 = $<SFL; }$
1987 | FieldLines SimpleFieldList Newlines ${
1992 SimpleFieldList -> Field ${ $0 = $<F; }$
1993 | SimpleFieldList ; Field ${
1997 | SimpleFieldList ; ${
2000 | ERROR ${ tok_err(c, "Syntax error in struct field", &$1); }$
2002 Field -> IDENTIFIER : Type = Expression ${ {
2005 $0 = calloc(1, sizeof(struct fieldlist));
2006 $0->f.name = $1.txt;
2011 propagate_types($<5, c, &ok, $3, 0);
2016 struct value vl = interp_exec(c, $5, NULL);
2017 $0->f.init = val_alloc(c, $0->f.type, &vl);
2020 | IDENTIFIER : Type ${
2021 $0 = calloc(1, sizeof(struct fieldlist));
2022 $0->f.name = $1.txt;
2024 if ($0->f.type->prepare_type)
2025 $0->f.type->prepare_type(c, $0->f.type, 1);
2028 ###### forward decls
2029 static void structure_print_type(struct type *t, FILE *f);
2031 ###### value functions
2032 static void structure_print_type(struct type *t, FILE *f)
2036 fprintf(f, "struct %.*s\n", t->name.len, t->name.txt);
2038 for (i = 0; i < t->structure.nfields; i++) {
2039 struct field *fl = t->structure.fields + i;
2040 fprintf(f, " %.*s : ", fl->name.len, fl->name.txt);
2041 type_print(fl->type, f);
2042 if (fl->type->print && fl->init) {
2044 if (fl->type == Tstr)
2046 print_value(fl->type, fl->init);
2047 if (fl->type == Tstr)
2054 ###### print type decls
2059 while (target != 0) {
2061 for (t = context.typelist; t ; t=t->next)
2062 if (t->print_type_decl) {
2071 t->print_type_decl(t, stdout);
2077 ## Executables: the elements of code
2079 Each code element needs to be parsed, printed, analysed,
2080 interpreted, and freed. There are several, so let's just start with
2081 the easy ones and work our way up.
2085 We have already met values as separate objects. When manifest
2086 constants appear in the program text, that must result in an executable
2087 which has a constant value. So the `val` structure embeds a value in
2100 ###### ast functions
2101 struct val *new_val(struct type *T, struct token tk)
2103 struct val *v = new_pos(val, tk);
2114 $0 = new_val(Tbool, $1);
2118 $0 = new_val(Tbool, $1);
2122 $0 = new_val(Tnum, $1);
2125 if (number_parse($0->val.num, tail, $1.txt) == 0)
2126 mpq_init($0->val.num);
2128 tok_err(c, "error: unsupported number suffix",
2133 $0 = new_val(Tstr, $1);
2136 string_parse(&$1, '\\', &$0->val.str, tail);
2138 tok_err(c, "error: unsupported string suffix",
2143 $0 = new_val(Tstr, $1);
2146 string_parse(&$1, '\\', &$0->val.str, tail);
2148 tok_err(c, "error: unsupported string suffix",
2153 ###### print exec cases
2156 struct val *v = cast(val, e);
2157 if (v->vtype == Tstr)
2159 print_value(v->vtype, &v->val);
2160 if (v->vtype == Tstr)
2165 ###### propagate exec cases
2168 struct val *val = cast(val, prog);
2169 if (!type_compat(type, val->vtype, rules))
2170 type_err(c, "error: expected %1%r found %2",
2171 prog, type, rules, val->vtype);
2175 ###### interp exec cases
2177 rvtype = cast(val, e)->vtype;
2178 dup_value(rvtype, &cast(val, e)->val, &rv);
2181 ###### ast functions
2182 static void free_val(struct val *v)
2185 free_value(v->vtype, &v->val);
2189 ###### free exec cases
2190 case Xval: free_val(cast(val, e)); break;
2192 ###### ast functions
2193 // Move all nodes from 'b' to 'rv', reversing their order.
2194 // In 'b' 'left' is a list, and 'right' is the last node.
2195 // In 'rv', left' is the first node and 'right' is a list.
2196 static struct binode *reorder_bilist(struct binode *b)
2198 struct binode *rv = NULL;
2201 struct exec *t = b->right;
2205 b = cast(binode, b->left);
2215 Just as we used a `val` to wrap a value into an `exec`, we similarly
2216 need a `var` to wrap a `variable` into an exec. While each `val`
2217 contained a copy of the value, each `var` holds a link to the variable
2218 because it really is the same variable no matter where it appears.
2219 When a variable is used, we need to remember to follow the `->merged`
2220 link to find the primary instance.
2228 struct variable *var;
2236 VariableDecl -> IDENTIFIER : ${ {
2237 struct variable *v = var_decl(c, $1.txt);
2238 $0 = new_pos(var, $1);
2243 v = var_ref(c, $1.txt);
2245 type_err(c, "error: variable '%v' redeclared",
2247 type_err(c, "info: this is where '%v' was first declared",
2248 v->where_decl, NULL, 0, NULL);
2251 | IDENTIFIER :: ${ {
2252 struct variable *v = var_decl(c, $1.txt);
2253 $0 = new_pos(var, $1);
2259 v = var_ref(c, $1.txt);
2261 type_err(c, "error: variable '%v' redeclared",
2263 type_err(c, "info: this is where '%v' was first declared",
2264 v->where_decl, NULL, 0, NULL);
2267 | IDENTIFIER : Type ${ {
2268 struct variable *v = var_decl(c, $1.txt);
2269 $0 = new_pos(var, $1);
2277 v = var_ref(c, $1.txt);
2279 type_err(c, "error: variable '%v' redeclared",
2281 type_err(c, "info: this is where '%v' was first declared",
2282 v->where_decl, NULL, 0, NULL);
2285 | IDENTIFIER :: Type ${ {
2286 struct variable *v = var_decl(c, $1.txt);
2287 $0 = new_pos(var, $1);
2296 v = var_ref(c, $1.txt);
2298 type_err(c, "error: variable '%v' redeclared",
2300 type_err(c, "info: this is where '%v' was first declared",
2301 v->where_decl, NULL, 0, NULL);
2306 Variable -> IDENTIFIER ${ {
2307 struct variable *v = var_ref(c, $1.txt);
2308 $0 = new_pos(var, $1);
2310 /* This might be a label - allocate a var just in case */
2311 v = var_decl(c, $1.txt);
2319 cast(var, $0)->var = v;
2324 Type -> IDENTIFIER ${
2325 $0 = find_type(c, $1.txt);
2328 "error: undefined type", &$1);
2335 ###### print exec cases
2338 struct var *v = cast(var, e);
2340 struct binding *b = v->var->name;
2341 printf("%.*s", b->name.len, b->name.txt);
2348 if (loc->type == Xvar) {
2349 struct var *v = cast(var, loc);
2351 struct binding *b = v->var->name;
2352 fprintf(stderr, "%.*s", b->name.len, b->name.txt);
2354 fputs("???", stderr); // NOTEST
2356 fputs("NOTVAR", stderr); // NOTEST
2359 ###### propagate exec cases
2363 struct var *var = cast(var, prog);
2364 struct variable *v = var->var;
2366 type_err(c, "%d:BUG: no variable!!", prog, NULL, 0, NULL); // NOTEST
2367 return Tnone; // NOTEST
2371 if (v->constant && (rules & Rnoconstant)) {
2372 type_err(c, "error: Cannot assign to a constant: %v",
2373 prog, NULL, 0, NULL);
2374 type_err(c, "info: name was defined as a constant here",
2375 v->where_decl, NULL, 0, NULL);
2378 if (v->type == Tnone && v->where_decl == prog)
2379 type_err(c, "error: variable used but not declared: %v",
2380 prog, NULL, 0, NULL);
2381 if (v->type == NULL) {
2382 if (type && *ok != 0) {
2385 v->where_set = prog;
2390 if (!type_compat(type, v->type, rules)) {
2391 type_err(c, "error: expected %1%r but variable '%v' is %2", prog,
2392 type, rules, v->type);
2393 type_err(c, "info: this is where '%v' was set to %1", v->where_set,
2394 v->type, rules, NULL);
2401 ###### interp exec cases
2404 struct var *var = cast(var, e);
2405 struct variable *v = var->var;
2414 ###### ast functions
2416 static void free_var(struct var *v)
2421 ###### free exec cases
2422 case Xvar: free_var(cast(var, e)); break;
2424 ### Expressions: Conditional
2426 Our first user of the `binode` will be conditional expressions, which
2427 is a bit odd as they actually have three components. That will be
2428 handled by having 2 binodes for each expression. The conditional
2429 expression is the lowest precedence operator which is why we define it
2430 first - to start the precedence list.
2432 Conditional expressions are of the form "value `if` condition `else`
2433 other_value". They associate to the right, so everything to the right
2434 of `else` is part of an else value, while only a higher-precedence to
2435 the left of `if` is the if values. Between `if` and `else` there is no
2436 room for ambiguity, so a full conditional expression is allowed in
2448 Expression -> Expression if Expression else Expression $$ifelse ${ {
2449 struct binode *b1 = new(binode);
2450 struct binode *b2 = new(binode);
2459 ## expression grammar
2461 ###### print binode cases
2464 b2 = cast(binode, b->right);
2465 if (bracket) printf("(");
2466 print_exec(b2->left, -1, bracket);
2468 print_exec(b->left, -1, bracket);
2470 print_exec(b2->right, -1, bracket);
2471 if (bracket) printf(")");
2474 ###### propagate binode cases
2477 /* cond must be Tbool, others must match */
2478 struct binode *b2 = cast(binode, b->right);
2481 propagate_types(b->left, c, ok, Tbool, 0);
2482 t = propagate_types(b2->left, c, ok, type, Rnolabel);
2483 t2 = propagate_types(b2->right, c, ok, type ?: t, Rnolabel);
2487 ###### interp binode cases
2490 struct binode *b2 = cast(binode, b->right);
2491 left = interp_exec(c, b->left, <ype);
2493 rv = interp_exec(c, b2->left, &rvtype);
2495 rv = interp_exec(c, b2->right, &rvtype);
2499 ### Expressions: Boolean
2501 The next class of expressions to use the `binode` will be Boolean
2502 expressions. "`and then`" and "`or else`" are similar to `and` and `or`
2503 have same corresponding precendence. The difference is that they don't
2504 evaluate the second expression if not necessary.
2513 ###### expr precedence
2518 ###### expression grammar
2519 | Expression or Expression ${ {
2520 struct binode *b = new(binode);
2526 | Expression or else Expression ${ {
2527 struct binode *b = new(binode);
2534 | Expression and Expression ${ {
2535 struct binode *b = new(binode);
2541 | Expression and then Expression ${ {
2542 struct binode *b = new(binode);
2549 | not Expression ${ {
2550 struct binode *b = new(binode);
2556 ###### print binode cases
2558 if (bracket) printf("(");
2559 print_exec(b->left, -1, bracket);
2561 print_exec(b->right, -1, bracket);
2562 if (bracket) printf(")");
2565 if (bracket) printf("(");
2566 print_exec(b->left, -1, bracket);
2567 printf(" and then ");
2568 print_exec(b->right, -1, bracket);
2569 if (bracket) printf(")");
2572 if (bracket) printf("(");
2573 print_exec(b->left, -1, bracket);
2575 print_exec(b->right, -1, bracket);
2576 if (bracket) printf(")");
2579 if (bracket) printf("(");
2580 print_exec(b->left, -1, bracket);
2581 printf(" or else ");
2582 print_exec(b->right, -1, bracket);
2583 if (bracket) printf(")");
2586 if (bracket) printf("(");
2588 print_exec(b->right, -1, bracket);
2589 if (bracket) printf(")");
2592 ###### propagate binode cases
2598 /* both must be Tbool, result is Tbool */
2599 propagate_types(b->left, c, ok, Tbool, 0);
2600 propagate_types(b->right, c, ok, Tbool, 0);
2601 if (type && type != Tbool)
2602 type_err(c, "error: %1 operation found where %2 expected", prog,
2606 ###### interp binode cases
2608 rv = interp_exec(c, b->left, &rvtype);
2609 right = interp_exec(c, b->right, &rtype);
2610 rv.bool = rv.bool && right.bool;
2613 rv = interp_exec(c, b->left, &rvtype);
2615 rv = interp_exec(c, b->right, NULL);
2618 rv = interp_exec(c, b->left, &rvtype);
2619 right = interp_exec(c, b->right, &rtype);
2620 rv.bool = rv.bool || right.bool;
2623 rv = interp_exec(c, b->left, &rvtype);
2625 rv = interp_exec(c, b->right, NULL);
2628 rv = interp_exec(c, b->right, &rvtype);
2632 ### Expressions: Comparison
2634 Of slightly higher precedence that Boolean expressions are Comparisons.
2635 A comparison takes arguments of any comparable type, but the two types
2638 To simplify the parsing we introduce an `eop` which can record an
2639 expression operator, and the `CMPop` non-terminal will match one of them.
2646 ###### ast functions
2647 static void free_eop(struct eop *e)
2661 ###### expr precedence
2662 $LEFT < > <= >= == != CMPop
2664 ###### expression grammar
2665 | Expression CMPop Expression ${ {
2666 struct binode *b = new(binode);
2676 CMPop -> < ${ $0.op = Less; }$
2677 | > ${ $0.op = Gtr; }$
2678 | <= ${ $0.op = LessEq; }$
2679 | >= ${ $0.op = GtrEq; }$
2680 | == ${ $0.op = Eql; }$
2681 | != ${ $0.op = NEql; }$
2683 ###### print binode cases
2691 if (bracket) printf("(");
2692 print_exec(b->left, -1, bracket);
2694 case Less: printf(" < "); break;
2695 case LessEq: printf(" <= "); break;
2696 case Gtr: printf(" > "); break;
2697 case GtrEq: printf(" >= "); break;
2698 case Eql: printf(" == "); break;
2699 case NEql: printf(" != "); break;
2700 default: abort(); // NOTEST
2702 print_exec(b->right, -1, bracket);
2703 if (bracket) printf(")");
2706 ###### propagate binode cases
2713 /* Both must match but not be labels, result is Tbool */
2714 t = propagate_types(b->left, c, ok, NULL, Rnolabel);
2716 propagate_types(b->right, c, ok, t, 0);
2718 t = propagate_types(b->right, c, ok, NULL, Rnolabel);
2720 t = propagate_types(b->left, c, ok, t, 0);
2722 if (!type_compat(type, Tbool, 0))
2723 type_err(c, "error: Comparison returns %1 but %2 expected", prog,
2724 Tbool, rules, type);
2727 ###### interp binode cases
2736 left = interp_exec(c, b->left, <ype);
2737 right = interp_exec(c, b->right, &rtype);
2738 cmp = value_cmp(ltype, rtype, &left, &right);
2741 case Less: rv.bool = cmp < 0; break;
2742 case LessEq: rv.bool = cmp <= 0; break;
2743 case Gtr: rv.bool = cmp > 0; break;
2744 case GtrEq: rv.bool = cmp >= 0; break;
2745 case Eql: rv.bool = cmp == 0; break;
2746 case NEql: rv.bool = cmp != 0; break;
2747 default: rv.bool = 0; break; // NOTEST
2752 ### Expressions: The rest
2754 The remaining expressions with the highest precedence are arithmetic,
2755 string concatenation, and string conversion. String concatenation
2756 (`++`) has the same precedence as multiplication and division, but lower
2759 String conversion is a temporary feature until I get a better type
2760 system. `$` is a prefix operator which expects a string and returns
2763 `+` and `-` are both infix and prefix operations (where they are
2764 absolute value and negation). These have different operator names.
2766 We also have a 'Bracket' operator which records where parentheses were
2767 found. This makes it easy to reproduce these when printing. Possibly I
2768 should only insert brackets were needed for precedence.
2778 ###### expr precedence
2784 ###### expression grammar
2785 | Expression Eop Expression ${ {
2786 struct binode *b = new(binode);
2793 | Expression Top Expression ${ {
2794 struct binode *b = new(binode);
2801 | ( Expression ) ${ {
2802 struct binode *b = new_pos(binode, $1);
2807 | Uop Expression ${ {
2808 struct binode *b = new(binode);
2813 | Value ${ $0 = $<1; }$
2814 | Variable ${ $0 = $<1; }$
2817 Eop -> + ${ $0.op = Plus; }$
2818 | - ${ $0.op = Minus; }$
2820 Uop -> + ${ $0.op = Absolute; }$
2821 | - ${ $0.op = Negate; }$
2822 | $ ${ $0.op = StringConv; }$
2824 Top -> * ${ $0.op = Times; }$
2825 | / ${ $0.op = Divide; }$
2826 | % ${ $0.op = Rem; }$
2827 | ++ ${ $0.op = Concat; }$
2829 ###### print binode cases
2836 if (bracket) printf("(");
2837 print_exec(b->left, indent, bracket);
2839 case Plus: fputs(" + ", stdout); break;
2840 case Minus: fputs(" - ", stdout); break;
2841 case Times: fputs(" * ", stdout); break;
2842 case Divide: fputs(" / ", stdout); break;
2843 case Rem: fputs(" % ", stdout); break;
2844 case Concat: fputs(" ++ ", stdout); break;
2845 default: abort(); // NOTEST
2847 print_exec(b->right, indent, bracket);
2848 if (bracket) printf(")");
2853 if (bracket) printf("(");
2855 case Absolute: fputs("+", stdout); break;
2856 case Negate: fputs("-", stdout); break;
2857 case StringConv: fputs("$", stdout); break;
2858 default: abort(); // NOTEST
2860 print_exec(b->right, indent, bracket);
2861 if (bracket) printf(")");
2865 print_exec(b->right, indent, bracket);
2869 ###### propagate binode cases
2875 /* both must be numbers, result is Tnum */
2878 /* as propagate_types ignores a NULL,
2879 * unary ops fit here too */
2880 propagate_types(b->left, c, ok, Tnum, 0);
2881 propagate_types(b->right, c, ok, Tnum, 0);
2882 if (!type_compat(type, Tnum, 0))
2883 type_err(c, "error: Arithmetic returns %1 but %2 expected", prog,
2888 /* both must be Tstr, result is Tstr */
2889 propagate_types(b->left, c, ok, Tstr, 0);
2890 propagate_types(b->right, c, ok, Tstr, 0);
2891 if (!type_compat(type, Tstr, 0))
2892 type_err(c, "error: Concat returns %1 but %2 expected", prog,
2897 /* op must be string, result is number */
2898 propagate_types(b->left, c, ok, Tstr, 0);
2899 if (!type_compat(type, Tnum, 0))
2901 "error: Can only convert string to number, not %1",
2902 prog, type, 0, NULL);
2906 return propagate_types(b->right, c, ok, type, 0);
2908 ###### interp binode cases
2911 rv = interp_exec(c, b->left, &rvtype);
2912 right = interp_exec(c, b->right, &rtype);
2913 mpq_add(rv.num, rv.num, right.num);
2916 rv = interp_exec(c, b->left, &rvtype);
2917 right = interp_exec(c, b->right, &rtype);
2918 mpq_sub(rv.num, rv.num, right.num);
2921 rv = interp_exec(c, b->left, &rvtype);
2922 right = interp_exec(c, b->right, &rtype);
2923 mpq_mul(rv.num, rv.num, right.num);
2926 rv = interp_exec(c, b->left, &rvtype);
2927 right = interp_exec(c, b->right, &rtype);
2928 mpq_div(rv.num, rv.num, right.num);
2933 left = interp_exec(c, b->left, <ype);
2934 right = interp_exec(c, b->right, &rtype);
2935 mpz_init(l); mpz_init(r); mpz_init(rem);
2936 mpz_tdiv_q(l, mpq_numref(left.num), mpq_denref(left.num));
2937 mpz_tdiv_q(r, mpq_numref(right.num), mpq_denref(right.num));
2938 mpz_tdiv_r(rem, l, r);
2939 val_init(Tnum, &rv);
2940 mpq_set_z(rv.num, rem);
2941 mpz_clear(r); mpz_clear(l); mpz_clear(rem);
2946 rv = interp_exec(c, b->right, &rvtype);
2947 mpq_neg(rv.num, rv.num);
2950 rv = interp_exec(c, b->right, &rvtype);
2951 mpq_abs(rv.num, rv.num);
2954 rv = interp_exec(c, b->right, &rvtype);
2957 left = interp_exec(c, b->left, <ype);
2958 right = interp_exec(c, b->right, &rtype);
2960 rv.str = text_join(left.str, right.str);
2963 right = interp_exec(c, b->right, &rvtype);
2967 struct text tx = right.str;
2970 if (tx.txt[0] == '-') {
2975 if (number_parse(rv.num, tail, tx) == 0)
2978 mpq_neg(rv.num, rv.num);
2980 printf("Unsupported suffix: %.*s\n", tx.len, tx.txt);
2984 ###### value functions
2986 static struct text text_join(struct text a, struct text b)
2989 rv.len = a.len + b.len;
2990 rv.txt = malloc(rv.len);
2991 memcpy(rv.txt, a.txt, a.len);
2992 memcpy(rv.txt+a.len, b.txt, b.len);
2996 ### Blocks, Statements, and Statement lists.
2998 Now that we have expressions out of the way we need to turn to
2999 statements. There are simple statements and more complex statements.
3000 Simple statements do not contain (syntactic) newlines, complex statements do.
3002 Statements often come in sequences and we have corresponding simple
3003 statement lists and complex statement lists.
3004 The former comprise only simple statements separated by semicolons.
3005 The later comprise complex statements and simple statement lists. They are
3006 separated by newlines. Thus the semicolon is only used to separate
3007 simple statements on the one line. This may be overly restrictive,
3008 but I'm not sure I ever want a complex statement to share a line with
3011 Note that a simple statement list can still use multiple lines if
3012 subsequent lines are indented, so
3014 ###### Example: wrapped simple statement list
3019 is a single simple statement list. This might allow room for
3020 confusion, so I'm not set on it yet.
3022 A simple statement list needs no extra syntax. A complex statement
3023 list has two syntactic forms. It can be enclosed in braces (much like
3024 C blocks), or it can be introduced by an indent and continue until an
3025 unindented newline (much like Python blocks). With this extra syntax
3026 it is referred to as a block.
3028 Note that a block does not have to include any newlines if it only
3029 contains simple statements. So both of:
3031 if condition: a=b; d=f
3033 if condition { a=b; print f }
3037 In either case the list is constructed from a `binode` list with
3038 `Block` as the operator. When parsing the list it is most convenient
3039 to append to the end, so a list is a list and a statement. When using
3040 the list it is more convenient to consider a list to be a statement
3041 and a list. So we need a function to re-order a list.
3042 `reorder_bilist` serves this purpose.
3044 The only stand-alone statement we introduce at this stage is `pass`
3045 which does nothing and is represented as a `NULL` pointer in a `Block`
3046 list. Other stand-alone statements will follow once the infrastructure
3057 Block -> { IN OptNL Statementlist OUT OptNL } ${ $0 = $<Sl; }$
3058 | { SimpleStatements } ${ $0 = reorder_bilist($<SS); }$
3059 | SimpleStatements ; ${ $0 = reorder_bilist($<SS); }$
3060 | SimpleStatements EOL ${ $0 = reorder_bilist($<SS); }$
3061 | IN OptNL Statementlist OUT ${ $0 = $<Sl; }$
3063 OpenBlock -> OpenScope { IN OptNL Statementlist OUT OptNL } ${ $0 = $<Sl; }$
3064 | OpenScope { SimpleStatements } ${ $0 = reorder_bilist($<SS); }$
3065 | OpenScope SimpleStatements ; ${ $0 = reorder_bilist($<SS); }$
3066 | OpenScope SimpleStatements EOL ${ $0 = reorder_bilist($<SS); }$
3067 | IN OpenScope OptNL Statementlist OUT ${ $0 = $<Sl; }$
3069 UseBlock -> { OpenScope IN OptNL Statementlist OUT OptNL } ${ $0 = $<Sl; }$
3070 | { OpenScope SimpleStatements } ${ $0 = reorder_bilist($<SS); }$
3071 | IN OpenScope OptNL Statementlist OUT ${ $0 = $<Sl; }$
3073 ColonBlock -> { IN OptNL Statementlist OUT OptNL } ${ $0 = $<Sl; }$
3074 | { SimpleStatements } ${ $0 = reorder_bilist($<SS); }$
3075 | : SimpleStatements ; ${ $0 = reorder_bilist($<SS); }$
3076 | : SimpleStatements EOL ${ $0 = reorder_bilist($<SS); }$
3077 | : IN OptNL Statementlist OUT ${ $0 = $<Sl; }$
3079 Statementlist -> ComplexStatements ${ $0 = reorder_bilist($<CS); }$
3081 ComplexStatements -> ComplexStatements ComplexStatement ${
3091 | ComplexStatement ${
3103 ComplexStatement -> SimpleStatements Newlines ${
3104 $0 = reorder_bilist($<SS);
3106 | SimpleStatements ; Newlines ${
3107 $0 = reorder_bilist($<SS);
3109 ## ComplexStatement Grammar
3112 SimpleStatements -> SimpleStatements ; SimpleStatement ${
3118 | SimpleStatement ${
3126 SimpleStatement -> pass ${ $0 = NULL; }$
3127 | ERROR ${ tok_err(c, "Syntax error in statement", &$1); }$
3128 ## SimpleStatement Grammar
3130 ###### print binode cases
3134 if (b->left == NULL)
3137 print_exec(b->left, indent, bracket);
3140 print_exec(b->right, indent, bracket);
3143 // block, one per line
3144 if (b->left == NULL)
3145 do_indent(indent, "pass\n");
3147 print_exec(b->left, indent, bracket);
3149 print_exec(b->right, indent, bracket);
3153 ###### propagate binode cases
3156 /* If any statement returns something other than Tnone
3157 * or Tbool then all such must return same type.
3158 * As each statement may be Tnone or something else,
3159 * we must always pass NULL (unknown) down, otherwise an incorrect
3160 * error might occur. We never return Tnone unless it is
3165 for (e = b; e; e = cast(binode, e->right)) {
3166 t = propagate_types(e->left, c, ok, NULL, rules);
3167 if ((rules & Rboolok) && t == Tbool)
3169 if (t && t != Tnone && t != Tbool) {
3173 type_err(c, "error: expected %1%r, found %2",
3174 e->left, type, rules, t);
3180 ###### interp binode cases
3182 while (rvtype == Tnone &&
3185 rv = interp_exec(c, b->left, &rvtype);
3186 b = cast(binode, b->right);
3190 ### The Print statement
3192 `print` is a simple statement that takes a comma-separated list of
3193 expressions and prints the values separated by spaces and terminated
3194 by a newline. No control of formatting is possible.
3196 `print` faces the same list-ordering issue as blocks, and uses the
3202 ##### expr precedence
3205 ###### SimpleStatement Grammar
3207 | print ExpressionList ${
3208 $0 = reorder_bilist($<2);
3210 | print ExpressionList , ${
3215 $0 = reorder_bilist($0);
3226 ExpressionList -> ExpressionList , Expression ${
3239 ###### print binode cases
3242 do_indent(indent, "print");
3246 print_exec(b->left, -1, bracket);
3250 b = cast(binode, b->right);
3256 ###### propagate binode cases
3259 /* don't care but all must be consistent */
3260 propagate_types(b->left, c, ok, NULL, Rnolabel);
3261 propagate_types(b->right, c, ok, NULL, Rnolabel);
3264 ###### interp binode cases
3270 for ( ; b; b = cast(binode, b->right))
3274 left = interp_exec(c, b->left, <ype);
3275 print_value(ltype, &left);
3276 free_value(ltype, &left);
3287 ###### Assignment statement
3289 An assignment will assign a value to a variable, providing it hasn't
3290 been declared as a constant. The analysis phase ensures that the type
3291 will be correct so the interpreter just needs to perform the
3292 calculation. There is a form of assignment which declares a new
3293 variable as well as assigning a value. If a name is assigned before
3294 it is declared, and error will be raised as the name is created as
3295 `Tlabel` and it is illegal to assign to such names.
3301 ###### declare terminals
3304 ###### SimpleStatement Grammar
3305 | Variable = Expression ${
3311 | VariableDecl = Expression ${
3319 if ($1->var->where_set == NULL) {
3321 "Variable declared with no type or value: %v",
3331 ###### print binode cases
3334 do_indent(indent, "");
3335 print_exec(b->left, indent, bracket);
3337 print_exec(b->right, indent, bracket);
3344 struct variable *v = cast(var, b->left)->var;
3345 do_indent(indent, "");
3346 print_exec(b->left, indent, bracket);
3347 if (cast(var, b->left)->var->constant) {
3348 if (v->where_decl == v->where_set) {
3350 type_print(v->type, stdout);
3355 if (v->where_decl == v->where_set) {
3357 type_print(v->type, stdout);
3364 print_exec(b->right, indent, bracket);
3371 ###### propagate binode cases
3375 /* Both must match and not be labels,
3376 * Type must support 'dup',
3377 * For Assign, left must not be constant.
3380 t = propagate_types(b->left, c, ok, NULL,
3381 Rnolabel | (b->op == Assign ? Rnoconstant : 0));
3386 if (propagate_types(b->right, c, ok, t, 0) != t)
3387 if (b->left->type == Xvar)
3388 type_err(c, "info: variable '%v' was set as %1 here.",
3389 cast(var, b->left)->var->where_set, t, rules, NULL);
3391 t = propagate_types(b->right, c, ok, NULL, Rnolabel);
3393 propagate_types(b->left, c, ok, t,
3394 (b->op == Assign ? Rnoconstant : 0));
3396 if (t && t->dup == NULL)
3397 type_err(c, "error: cannot assign value of type %1", b, t, 0, NULL);
3402 ###### interp binode cases
3405 lleft = linterp_exec(c, b->left, <ype);
3406 right = interp_exec(c, b->right, &rtype);
3408 free_value(ltype, lleft);
3409 dup_value(ltype, &right, lleft);
3416 struct variable *v = cast(var, b->left)->var;
3419 free_value(v->type, v->val);
3422 right = interp_exec(c, b->right, &rtype);
3423 v->val = val_alloc(c, v->type, &right);
3426 v->val = val_alloc(c, v->type, NULL);
3431 ### The `use` statement
3433 The `use` statement is the last "simple" statement. It is needed when
3434 the condition in a conditional statement is a block. `use` works much
3435 like `return` in C, but only completes the `condition`, not the whole
3441 ###### expr precedence
3444 ###### SimpleStatement Grammar
3446 $0 = new_pos(binode, $1);
3449 if ($0->right->type == Xvar) {
3450 struct var *v = cast(var, $0->right);
3451 if (v->var->type == Tnone) {
3452 /* Convert this to a label */
3453 v->var->type = Tlabel;
3454 v->var->val = val_alloc(c, Tlabel, NULL);
3455 v->var->val->label = v->var->val;
3460 ###### print binode cases
3463 do_indent(indent, "use ");
3464 print_exec(b->right, -1, bracket);
3469 ###### propagate binode cases
3472 /* result matches value */
3473 return propagate_types(b->right, c, ok, type, 0);
3475 ###### interp binode cases
3478 rv = interp_exec(c, b->right, &rvtype);
3481 ### The Conditional Statement
3483 This is the biggy and currently the only complex statement. This
3484 subsumes `if`, `while`, `do/while`, `switch`, and some parts of `for`.
3485 It is comprised of a number of parts, all of which are optional though
3486 set combinations apply. Each part is (usually) a key word (`then` is
3487 sometimes optional) followed by either an expression or a code block,
3488 except the `casepart` which is a "key word and an expression" followed
3489 by a code block. The code-block option is valid for all parts and,
3490 where an expression is also allowed, the code block can use the `use`
3491 statement to report a value. If the code block does not report a value
3492 the effect is similar to reporting `True`.
3494 The `else` and `case` parts, as well as `then` when combined with
3495 `if`, can contain a `use` statement which will apply to some
3496 containing conditional statement. `for` parts, `do` parts and `then`
3497 parts used with `for` can never contain a `use`, except in some
3498 subordinate conditional statement.
3500 If there is a `forpart`, it is executed first, only once.
3501 If there is a `dopart`, then it is executed repeatedly providing
3502 always that the `condpart` or `cond`, if present, does not return a non-True
3503 value. `condpart` can fail to return any value if it simply executes
3504 to completion. This is treated the same as returning `True`.
3506 If there is a `thenpart` it will be executed whenever the `condpart`
3507 or `cond` returns True (or does not return any value), but this will happen
3508 *after* `dopart` (when present).
3510 If `elsepart` is present it will be executed at most once when the
3511 condition returns `False` or some value that isn't `True` and isn't
3512 matched by any `casepart`. If there are any `casepart`s, they will be
3513 executed when the condition returns a matching value.
3515 The particular sorts of values allowed in case parts has not yet been
3516 determined in the language design, so nothing is prohibited.
3518 The various blocks in this complex statement potentially provide scope
3519 for variables as described earlier. Each such block must include the
3520 "OpenScope" nonterminal before parsing the block, and must call
3521 `var_block_close()` when closing the block.
3523 The code following "`if`", "`switch`" and "`for`" does not get its own
3524 scope, but is in a scope covering the whole statement, so names
3525 declared there cannot be redeclared elsewhere. Similarly the
3526 condition following "`while`" is in a scope the covers the body
3527 ("`do`" part) of the loop, and which does not allow conditional scope
3528 extension. Code following "`then`" (both looping and non-looping),
3529 "`else`" and "`case`" each get their own local scope.
3531 The type requirements on the code block in a `whilepart` are quite
3532 unusal. It is allowed to return a value of some identifiable type, in
3533 which case the loop aborts and an appropriate `casepart` is run, or it
3534 can return a Boolean, in which case the loop either continues to the
3535 `dopart` (on `True`) or aborts and runs the `elsepart` (on `False`).
3536 This is different both from the `ifpart` code block which is expected to
3537 return a Boolean, or the `switchpart` code block which is expected to
3538 return the same type as the casepart values. The correct analysis of
3539 the type of the `whilepart` code block is the reason for the
3540 `Rboolok` flag which is passed to `propagate_types()`.
3542 The `cond_statement` cannot fit into a `binode` so a new `exec` is
3551 struct exec *action;
3552 struct casepart *next;
3554 struct cond_statement {
3556 struct exec *forpart, *condpart, *dopart, *thenpart, *elsepart;
3557 struct casepart *casepart;
3560 ###### ast functions
3562 static void free_casepart(struct casepart *cp)
3566 free_exec(cp->value);
3567 free_exec(cp->action);
3574 static void free_cond_statement(struct cond_statement *s)
3578 free_exec(s->forpart);
3579 free_exec(s->condpart);
3580 free_exec(s->dopart);
3581 free_exec(s->thenpart);
3582 free_exec(s->elsepart);
3583 free_casepart(s->casepart);
3587 ###### free exec cases
3588 case Xcond_statement: free_cond_statement(cast(cond_statement, e)); break;
3590 ###### ComplexStatement Grammar
3591 | CondStatement ${ $0 = $<1; }$
3593 ###### expr precedence
3594 $TERM for then while do
3601 // A CondStatement must end with EOL, as does CondSuffix and
3603 // ForPart, ThenPart, SwitchPart, CasePart are non-empty and
3604 // may or may not end with EOL
3605 // WhilePart and IfPart include an appropriate Suffix
3608 // Both ForPart and Whilepart open scopes, and CondSuffix only
3609 // closes one - so in the first branch here we have another to close.
3610 CondStatement -> ForPart OptNL ThenPart OptNL WhilePart CondSuffix ${
3613 $0->thenpart = $<TP;
3614 $0->condpart = $WP.condpart; $WP.condpart = NULL;
3615 $0->dopart = $WP.dopart; $WP.dopart = NULL;
3616 var_block_close(c, CloseSequential);
3618 | ForPart OptNL WhilePart CondSuffix ${
3621 $0->condpart = $WP.condpart; $WP.condpart = NULL;
3622 $0->dopart = $WP.dopart; $WP.dopart = NULL;
3623 var_block_close(c, CloseSequential);
3625 | WhilePart CondSuffix ${
3627 $0->condpart = $WP.condpart; $WP.condpart = NULL;
3628 $0->dopart = $WP.dopart; $WP.dopart = NULL;
3630 | SwitchPart OptNL CasePart CondSuffix ${
3632 $0->condpart = $<SP;
3633 $CP->next = $0->casepart;
3634 $0->casepart = $<CP;
3636 | SwitchPart : IN OptNL CasePart CondSuffix OUT Newlines ${
3638 $0->condpart = $<SP;
3639 $CP->next = $0->casepart;
3640 $0->casepart = $<CP;
3642 | IfPart IfSuffix ${
3644 $0->condpart = $IP.condpart; $IP.condpart = NULL;
3645 $0->thenpart = $IP.thenpart; $IP.thenpart = NULL;
3646 // This is where we close an "if" statement
3647 var_block_close(c, CloseSequential);
3650 CondSuffix -> IfSuffix ${
3652 // This is where we close scope of the whole
3653 // "for" or "while" statement
3654 var_block_close(c, CloseSequential);
3656 | Newlines CasePart CondSuffix ${
3658 $CP->next = $0->casepart;
3659 $0->casepart = $<CP;
3661 | CasePart CondSuffix ${
3663 $CP->next = $0->casepart;
3664 $0->casepart = $<CP;
3667 IfSuffix -> Newlines ${ $0 = new(cond_statement); }$
3668 | Newlines ElsePart ${ $0 = $<EP; }$
3669 | ElsePart ${$0 = $<EP; }$
3671 ElsePart -> else OpenBlock Newlines ${
3672 $0 = new(cond_statement);
3673 $0->elsepart = $<OB;
3674 var_block_close(c, CloseElse);
3676 | else OpenScope CondStatement ${
3677 $0 = new(cond_statement);
3678 $0->elsepart = $<CS;
3679 var_block_close(c, CloseElse);
3683 CasePart -> case Expression OpenScope ColonBlock ${
3684 $0 = calloc(1,sizeof(struct casepart));
3687 var_block_close(c, CloseParallel);
3691 // These scopes are closed in CondSuffix
3692 ForPart -> for OpenBlock ${
3696 ThenPart -> then OpenBlock ${
3698 var_block_close(c, CloseSequential);
3702 // This scope is closed in CondSuffix
3703 WhilePart -> while UseBlock OptNL do Block ${
3707 | while OpenScope Expression ColonBlock ${
3708 $0.condpart = $<Exp;
3712 IfPart -> if UseBlock OptNL then OpenBlock ClosePara ${
3716 | if OpenScope Expression OpenScope ColonBlock ClosePara ${
3720 | if OpenScope Expression OpenScope OptNL then Block ClosePara ${
3726 // This scope is closed in CondSuffix
3727 SwitchPart -> switch OpenScope Expression ${
3730 | switch UseBlock ${
3734 ###### print exec cases
3736 case Xcond_statement:
3738 struct cond_statement *cs = cast(cond_statement, e);
3739 struct casepart *cp;
3741 do_indent(indent, "for");
3742 if (bracket) printf(" {\n"); else printf("\n");
3743 print_exec(cs->forpart, indent+1, bracket);
3746 do_indent(indent, "} then {\n");
3748 do_indent(indent, "then\n");
3749 print_exec(cs->thenpart, indent+1, bracket);
3751 if (bracket) do_indent(indent, "}\n");
3755 if (cs->condpart && cs->condpart->type == Xbinode &&
3756 cast(binode, cs->condpart)->op == Block) {
3758 do_indent(indent, "while {\n");
3760 do_indent(indent, "while\n");
3761 print_exec(cs->condpart, indent+1, bracket);
3763 do_indent(indent, "} do {\n");
3765 do_indent(indent, "do\n");
3766 print_exec(cs->dopart, indent+1, bracket);
3768 do_indent(indent, "}\n");
3770 do_indent(indent, "while ");
3771 print_exec(cs->condpart, 0, bracket);
3776 print_exec(cs->dopart, indent+1, bracket);
3778 do_indent(indent, "}\n");
3783 do_indent(indent, "switch");
3785 do_indent(indent, "if");
3786 if (cs->condpart && cs->condpart->type == Xbinode &&
3787 cast(binode, cs->condpart)->op == Block) {
3792 print_exec(cs->condpart, indent+1, bracket);
3794 do_indent(indent, "}\n");
3796 do_indent(indent, "then:\n");
3797 print_exec(cs->thenpart, indent+1, bracket);
3801 print_exec(cs->condpart, 0, bracket);
3807 print_exec(cs->thenpart, indent+1, bracket);
3809 do_indent(indent, "}\n");
3814 for (cp = cs->casepart; cp; cp = cp->next) {
3815 do_indent(indent, "case ");
3816 print_exec(cp->value, -1, 0);
3821 print_exec(cp->action, indent+1, bracket);
3823 do_indent(indent, "}\n");
3826 do_indent(indent, "else");
3831 print_exec(cs->elsepart, indent+1, bracket);
3833 do_indent(indent, "}\n");
3838 ###### propagate exec cases
3839 case Xcond_statement:
3841 // forpart and dopart must return Tnone
3842 // thenpart must return Tnone if there is a dopart,
3843 // otherwise it is like elsepart.
3845 // be bool if there is no casepart
3846 // match casepart->values if there is a switchpart
3847 // either be bool or match casepart->value if there
3849 // elsepart and casepart->action must match the return type
3850 // expected of this statement.
3851 struct cond_statement *cs = cast(cond_statement, prog);
3852 struct casepart *cp;
3854 t = propagate_types(cs->forpart, c, ok, Tnone, 0);
3855 if (!type_compat(Tnone, t, 0))
3857 t = propagate_types(cs->dopart, c, ok, Tnone, 0);
3858 if (!type_compat(Tnone, t, 0))
3861 t = propagate_types(cs->thenpart, c, ok, Tnone, 0);
3862 if (!type_compat(Tnone, t, 0))
3865 if (cs->casepart == NULL)
3866 propagate_types(cs->condpart, c, ok, Tbool, 0);
3868 /* Condpart must match case values, with bool permitted */
3870 for (cp = cs->casepart;
3871 cp && !t; cp = cp->next)
3872 t = propagate_types(cp->value, c, ok, NULL, 0);
3873 if (!t && cs->condpart)
3874 t = propagate_types(cs->condpart, c, ok, NULL, Rboolok);
3875 // Now we have a type (I hope) push it down
3877 for (cp = cs->casepart; cp; cp = cp->next)
3878 propagate_types(cp->value, c, ok, t, 0);
3879 propagate_types(cs->condpart, c, ok, t, Rboolok);
3882 // (if)then, else, and case parts must return expected type.
3883 if (!cs->dopart && !type)
3884 type = propagate_types(cs->thenpart, c, ok, NULL, rules);
3886 type = propagate_types(cs->elsepart, c, ok, NULL, rules);
3887 for (cp = cs->casepart;
3890 type = propagate_types(cp->action, c, ok, NULL, rules);
3893 propagate_types(cs->thenpart, c, ok, type, rules);
3894 propagate_types(cs->elsepart, c, ok, type, rules);
3895 for (cp = cs->casepart; cp ; cp = cp->next)
3896 propagate_types(cp->action, c, ok, type, rules);
3902 ###### interp exec cases
3903 case Xcond_statement:
3905 struct value v, cnd;
3906 struct type *vtype, *cndtype;
3907 struct casepart *cp;
3908 struct cond_statement *cs = cast(cond_statement, e);
3911 interp_exec(c, cs->forpart, NULL);
3914 cnd = interp_exec(c, cs->condpart, &cndtype);
3917 if (!(cndtype == Tnone ||
3918 (cndtype == Tbool && cnd.bool != 0)))
3920 // cnd is Tnone or Tbool, doesn't need to be freed
3922 interp_exec(c, cs->dopart, NULL);
3925 rv = interp_exec(c, cs->thenpart, &rvtype);
3926 if (rvtype != Tnone || !cs->dopart)
3928 free_value(rvtype, &rv);
3931 } while (cs->dopart);
3933 for (cp = cs->casepart; cp; cp = cp->next) {
3934 v = interp_exec(c, cp->value, &vtype);
3935 if (value_cmp(cndtype, vtype, &v, &cnd) == 0) {
3936 free_value(vtype, &v);
3937 free_value(cndtype, &cnd);
3938 rv = interp_exec(c, cp->action, &rvtype);
3941 free_value(vtype, &v);
3943 free_value(cndtype, &cnd);
3945 rv = interp_exec(c, cs->elsepart, &rvtype);
3952 ### Top level structure
3954 All the language elements so far can be used in various places. Now
3955 it is time to clarify what those places are.
3957 At the top level of a file there will be a number of declarations.
3958 Many of the things that can be declared haven't been described yet,
3959 such as functions, procedures, imports, and probably more.
3960 For now there are two sorts of things that can appear at the top
3961 level. They are predefined constants, `struct` types, and the main
3962 program. While the syntax will allow the main program to appear
3963 multiple times, that will trigger an error if it is actually attempted.
3965 The various declarations do not return anything. They store the
3966 various declarations in the parse context.
3968 ###### Parser: grammar
3971 Ocean -> OptNL DeclarationList
3973 ## declare terminals
3980 DeclarationList -> Declaration
3981 | DeclarationList Declaration
3983 Declaration -> ERROR Newlines ${
3985 "error: unhandled parse error", &$1);
3991 ## top level grammar
3993 ### The `const` section
3995 As well as being defined in with the code that uses them, constants
3996 can be declared at the top level. These have full-file scope, so they
3997 are always `InScope`. The value of a top level constant can be given
3998 as an expression, and this is evaluated immediately rather than in the
3999 later interpretation stage. Once we add functions to the language, we
4000 will need rules concern which, if any, can be used to define a top
4003 Constants are defined in a section that starts with the reserved word
4004 `const` and then has a block with a list of assignment statements.
4005 For syntactic consistency, these must use the double-colon syntax to
4006 make it clear that they are constants. Type can also be given: if
4007 not, the type will be determined during analysis, as with other
4010 As the types constants are inserted at the head of a list, printing
4011 them in the same order that they were read is not straight forward.
4012 We take a quadratic approach here and count the number of constants
4013 (variables of depth 0), then count down from there, each time
4014 searching through for the Nth constant for decreasing N.
4016 ###### top level grammar
4020 DeclareConstant -> const { IN OptNL ConstList OUT OptNL } Newlines
4021 | const { SimpleConstList } Newlines
4022 | const IN OptNL ConstList OUT Newlines
4023 | const SimpleConstList Newlines
4025 ConstList -> ConstList SimpleConstLine
4027 SimpleConstList -> SimpleConstList ; Const
4030 SimpleConstLine -> SimpleConstList Newlines
4031 | ERROR Newlines ${ tok_err(c, "Syntax error in constant", &$1); }$
4034 CType -> Type ${ $0 = $<1; }$
4037 Const -> IDENTIFIER :: CType = Expression ${ {
4041 v = var_decl(c, $1.txt);
4043 struct var *var = new_pos(var, $1);
4044 v->where_decl = var;
4049 v = var_ref(c, $1.txt);
4050 tok_err(c, "error: name already declared", &$1);
4051 type_err(c, "info: this is where '%v' was first declared",
4052 v->where_decl, NULL, 0, NULL);
4056 propagate_types($5, c, &ok, $3, 0);
4061 struct value res = interp_exec(c, $5, &v->type);
4062 v->val = val_alloc(c, v->type, &res);
4066 ###### print const decls
4071 while (target != 0) {
4073 for (v = context.in_scope; v; v=v->in_scope)
4074 if (v->depth == 0) {
4085 printf(" %.*s :: ", v->name->name.len, v->name->name.txt);
4086 type_print(v->type, stdout);
4088 if (v->type == Tstr)
4090 print_value(v->type, v->val);
4091 if (v->type == Tstr)
4099 ### Finally the whole program.
4101 Somewhat reminiscent of Pascal a (current) Ocean program starts with
4102 the keyword "program" and a list of variable names which are assigned
4103 values from command line arguments. Following this is a `block` which
4104 is the code to execute. Unlike Pascal, constants and other
4105 declarations come *before* the program.
4107 As this is the top level, several things are handled a bit
4109 The whole program is not interpreted by `interp_exec` as that isn't
4110 passed the argument list which the program requires. Similarly type
4111 analysis is a bit more interesting at this level.
4116 ###### top level grammar
4118 DeclareProgram -> Program ${ {
4120 type_err(c, "Program defined a second time",
4129 Program -> program OpenScope Varlist ColonBlock Newlines ${
4132 $0->left = reorder_bilist($<Vl);
4134 var_block_close(c, CloseSequential);
4135 if (c->scope_stack && !c->parse_error) abort();
4138 Varlist -> Varlist ArgDecl ${
4147 ArgDecl -> IDENTIFIER ${ {
4148 struct variable *v = var_decl(c, $1.txt);
4155 ###### print binode cases
4157 do_indent(indent, "program");
4158 for (b2 = cast(binode, b->left); b2; b2 = cast(binode, b2->right)) {
4160 print_exec(b2->left, 0, 0);
4166 print_exec(b->right, indent+1, bracket);
4168 do_indent(indent, "}\n");
4171 ###### propagate binode cases
4172 case Program: abort(); // NOTEST
4174 ###### core functions
4176 static int analyse_prog(struct exec *prog, struct parse_context *c)
4178 struct binode *b = cast(binode, prog);
4185 propagate_types(b->right, c, &ok, Tnone, 0);
4190 for (b = cast(binode, b->left); b; b = cast(binode, b->right)) {
4191 struct var *v = cast(var, b->left);
4192 if (!v->var->type) {
4193 v->var->where_set = b;
4194 v->var->type = Tstr;
4198 b = cast(binode, prog);
4201 propagate_types(b->right, c, &ok, Tnone, 0);
4206 /* Make sure everything is still consistent */
4207 propagate_types(b->right, c, &ok, Tnone, 0);
4211 static void interp_prog(struct parse_context *c, struct exec *prog, char **argv)
4213 struct binode *p = cast(binode, prog);
4220 al = cast(binode, p->left);
4222 struct var *v = cast(var, al->left);
4223 struct value *vl = v->var->val;
4225 if (argv[0] == NULL) {
4226 printf("Not enough args\n");
4229 al = cast(binode, al->right);
4231 free_value(v->var->type, vl);
4233 vl = val_alloc(c, v->var->type, NULL);
4236 free_value(v->var->type, vl);
4237 vl->str.len = strlen(argv[0]);
4238 vl->str.txt = malloc(vl->str.len);
4239 memcpy(vl->str.txt, argv[0], vl->str.len);
4242 v = interp_exec(c, p->right, &vtype);
4243 free_value(vtype, &v);
4246 ###### interp binode cases
4247 case Program: abort(); // NOTEST
4249 ## And now to test it out.
4251 Having a language requires having a "hello world" program. I'll
4252 provide a little more than that: a program that prints "Hello world"
4253 finds the GCD of two numbers, prints the first few elements of
4254 Fibonacci, performs a binary search for a number, and a few other
4255 things which will likely grow as the languages grows.
4257 ###### File: oceani.mk
4260 @echo "===== DEMO ====="
4261 ./oceani --section "demo: hello" oceani.mdc 55 33
4267 four ::= 2 + 2 ; five ::= 10/2
4268 const pie ::= "I like Pie";
4269 cake ::= "The cake is"
4278 print "Hello World, what lovely oceans you have!"
4279 print "Are there", five, "?"
4280 print pi, pie, "but", cake
4282 A := $Astr; B := $Bstr
4284 /* When a variable is defined in both branches of an 'if',
4285 * and used afterwards, the variables are merged.
4291 print "Is", A, "bigger than", B,"? ", bigger
4292 /* If a variable is not used after the 'if', no
4293 * merge happens, so types can be different
4296 double:string = "yes"
4297 print A, "is more than twice", B, "?", double
4300 print "double", B, "is", double
4305 if a > 0 and then b > 0:
4311 print "GCD of", A, "and", B,"is", a
4313 print a, "is not positive, cannot calculate GCD"
4315 print b, "is not positive, cannot calculate GCD"
4320 print "Fibonacci:", f1,f2,
4321 then togo = togo - 1
4329 /* Binary search... */
4334 mid := (lo + hi) / 2
4346 print "Yay, I found", target
4348 print "Closest I found was", mid
4353 // "middle square" PRNG. Not particularly good, but one my
4354 // Dad taught me - the first one I ever heard of.
4355 for i:=1; then i = i + 1; while i < size:
4356 n := list[i-1] * list[i-1]
4357 list[i] = (n / 100) % 10 000
4359 print "Before sort:",
4360 for i:=0; then i = i + 1; while i < size:
4364 for i := 1; then i=i+1; while i < size:
4365 for j:=i-1; then j=j-1; while j >= 0:
4366 if list[j] > list[j+1]:
4370 print " After sort:",
4371 for i:=0; then i = i + 1; while i < size:
4375 if 1 == 2 then print "yes"; else print "no"
4379 bob.alive = (bob.name == "Hello")
4380 print "bob", "is" if bob.alive else "isn't", "alive"