struct token_config config;
char *file_name;
int parse_error;
- struct exec *prog;
## parse context
};
struct parse_context *c = config2context(config);
###### Parser: code
-
+ #define _GNU_SOURCE
#include <unistd.h>
#include <stdlib.h>
#include <fcntl.h>
int fd;
int len;
char *file;
- struct section *s, *ss;
+ struct section *s = NULL, *ss;
char *section = NULL;
struct parse_context context = {
.config = {
if (!ss) {
fprintf(stderr, "oceani: cannot find section %s\n",
section);
- exit(1);
+ goto cleanup;
}
} else
ss = s; // NOTEST
+ if (!ss->code) {
+ fprintf(stderr, "oceani: no code found in requested section\n"); // NOTEST
+ goto cleanup; // NOTEST
+ }
+
parse_oceani(ss->code, &context.config, dotrace ? stderr : NULL);
- if (!context.prog) {
- fprintf(stderr, "oceani: no main function found.\n");
- context.parse_error = 1;
+ resolve_consts(&context);
+ prepare_types(&context);
+ if (!context.parse_error && !analyse_funcs(&context)) {
+ fprintf(stderr, "oceani: type error in program - not running.\n");
+ context.parse_error += 1;
}
- if (context.prog && doprint) {
+
+ if (doprint) {
## print const decls
## print type decls
- print_exec(context.prog, 0, brackets);
- }
- if (context.prog && doexec && !context.parse_error) {
- if (!analyse_prog(context.prog, &context)) {
- fprintf(stderr, "oceani: type error in program - not running.\n");
- exit(1);
- }
- interp_prog(&context, context.prog, argc - optind, argv+optind);
+ ## print func decls
}
- free_exec(context.prog);
-
+ if (doexec && !context.parse_error)
+ interp_main(&context, argc - optind, argv + optind);
+ cleanup:
while (s) {
struct section *t = s->next;
code_free(s->code);
free(s);
s = t;
}
- ## free context vars
+ // FIXME parser should pop scope even on error
+ while (context.scope_depth > 0)
+ scope_pop(&context);
+ ## free global vars
+ ## free const decls
## free context types
+ ## free context storage
exit(context.parse_error ? 1 : 0);
}
###### forward decls
static void fput_loc(struct exec *loc, FILE *f);
+ static void type_err(struct parse_context *c,
+ char *fmt, struct exec *loc,
+ struct type *t1, int rules, struct type *t2);
+ static void tok_err(struct parse_context *c, char *fmt, struct token *t);
###### core functions
}
}
fputs("\n", stderr);
- c->parse_error = 1;
+ c->parse_error += 1;
}
static void tok_err(struct parse_context *c, char *fmt, struct token *t)
{
fprintf(stderr, "%s:%d:%d: %s: %.*s\n", c->file_name, t->line, t->col, fmt,
t->txt.len, t->txt.txt);
- c->parse_error = 1;
+ c->parse_error += 1;
}
## Entities: declared and predeclared.
different specific code elements which comprise or manipulate these
various entities.
-### Types
+### Executables
-Values come in a wide range of types, with more likely to be added.
-Each type needs to be able to print its own values (for convenience at
-least) as well as to compare two values, at least for equality and
-possibly for order. For now, values might need to be duplicated and
-freed, though eventually such manipulations will be better integrated
-into the language.
+Executables can be lots of different things. In many cases an
+executable is just an operation combined with one or two other
+executables. This allows for expressions and lists etc. Other times an
+executable is something quite specific like a constant or variable name.
+So we define a `struct exec` to be a general executable with a type, and
+a `struct binode` which is a subclass of `exec`, forms a node in a
+binary tree, and holds an operation. There will be other subclasses,
+and to access these we need to be able to `cast` the `exec` into the
+various other types. The first field in any `struct exec` is the type
+from the `exec_types` enum.
-Rather than requiring every numeric type to support all numeric
-operations (add, multiple, etc), we allow types to be able to present
-as one of a few standard types: integer, float, and fraction. The
-existence of these conversion functions eventually enable types to
-determine if they are compatible with other types, though such types
-have not yet been implemented.
+###### macros
+ #define cast(structname, pointer) ({ \
+ const typeof( ((struct structname *)0)->type) *__mptr = &(pointer)->type; \
+ if (__mptr && *__mptr != X##structname) abort(); \
+ (struct structname *)( (char *)__mptr);})
-Named type are stored in a simple linked list. Objects of each type are
-"values" which are often passed around by value.
+ #define new(structname) ({ \
+ struct structname *__ptr = ((struct structname *)calloc(1,sizeof(struct structname))); \
+ __ptr->type = X##structname; \
+ __ptr->line = -1; __ptr->column = -1; \
+ __ptr;})
-###### ast
+ #define new_pos(structname, token) ({ \
+ struct structname *__ptr = ((struct structname *)calloc(1,sizeof(struct structname))); \
+ __ptr->type = X##structname; \
+ __ptr->line = token.line; __ptr->column = token.col; \
+ __ptr;})
- struct value {
- union {
- char ptr[1];
- ## value union fields
- };
+###### ast
+ enum exec_types {
+ Xbinode,
+ ## exec type
};
-
- struct type {
- struct text name;
- struct type *next;
- int size, align;
- void (*init)(struct type *type, struct value *val);
- void (*prepare_type)(struct parse_context *c, struct type *type, int parse_time);
- void (*print)(struct type *type, struct value *val);
- void (*print_type)(struct type *type, FILE *f);
- int (*cmp_order)(struct type *t1, struct type *t2,
- struct value *v1, struct value *v2);
- int (*cmp_eq)(struct type *t1, struct type *t2,
- struct value *v1, struct value *v2);
- void (*dup)(struct type *type, struct value *vold, struct value *vnew);
- void (*free)(struct type *type, struct value *val);
- void (*free_type)(struct type *t);
- long long (*to_int)(struct value *v);
- double (*to_float)(struct value *v);
- int (*to_mpq)(mpq_t *q, struct value *v);
- ## type functions
- union {
- ## type union fields
- };
+ struct exec {
+ enum exec_types type;
+ int line, column;
+ ## exec fields
+ };
+ struct binode {
+ struct exec;
+ enum Btype {
+ ## Binode types
+ } op;
+ struct exec *left, *right;
};
-
-###### parse context
-
- struct type *typelist;
###### ast functions
- static struct type *find_type(struct parse_context *c, struct text s)
+ static int __fput_loc(struct exec *loc, FILE *f)
{
- struct type *l = c->typelist;
-
- while (l &&
- text_cmp(l->name, s) != 0)
- l = l->next;
- return l;
+ if (!loc)
+ return 0;
+ if (loc->line >= 0) {
+ fprintf(f, "%d:%d: ", loc->line, loc->column);
+ return 1;
+ }
+ if (loc->type == Xbinode)
+ return __fput_loc(cast(binode,loc)->left, f) ||
+ __fput_loc(cast(binode,loc)->right, f); // NOTEST
+ return 0;
}
-
- static struct type *add_type(struct parse_context *c, struct text s,
- struct type *proto)
+ static void fput_loc(struct exec *loc, FILE *f)
{
- struct type *n;
-
- n = calloc(1, sizeof(*n));
- *n = *proto;
- n->name = s;
- n->next = c->typelist;
- c->typelist = n;
- return n;
+ if (!__fput_loc(loc, f))
+ fprintf(f, "??:??: ");
}
- static void free_type(struct type *t)
- {
- /* The type is always a reference to something in the
- * context, so we don't need to free anything.
- */
- }
+Each different type of `exec` node needs a number of functions defined,
+a bit like methods. We must be able to free it, print it, analyse it
+and execute it. Once we have specific `exec` types we will need to
+parse them too. Let's take this a bit more slowly.
- static void free_value(struct type *type, struct value *v)
- {
- if (type && v)
- type->free(type, v);
- }
+#### Freeing
- static void type_print(struct type *type, FILE *f)
+The parser generator requires a `free_foo` function for each struct
+that stores attributes and they will often be `exec`s and subtypes
+there-of. So we need `free_exec` which can handle all the subtypes,
+and we need `free_binode`.
+
+###### ast functions
+
+ static void free_binode(struct binode *b)
{
- if (!type)
- fputs("*unknown*type*", f); // NOTEST
- else if (type->name.len)
- fprintf(f, "%.*s", type->name.len, type->name.txt);
- else if (type->print_type)
- type->print_type(type, f);
- else
- fputs("*invalid*type*", f); // NOTEST
+ if (!b)
+ return;
+ free_exec(b->left);
+ free_exec(b->right);
+ free(b);
}
- static void val_init(struct type *type, struct value *val)
+###### core functions
+ static void free_exec(struct exec *e)
{
- if (type && type->init)
- type->init(type, val);
+ if (!e)
+ return;
+ switch(e->type) {
+ ## free exec cases
+ }
}
- static void dup_value(struct type *type,
- struct value *vold, struct value *vnew)
+###### forward decls
+
+ static void free_exec(struct exec *e);
+
+###### free exec cases
+ case Xbinode: free_binode(cast(binode, e)); break;
+
+#### Printing
+
+Printing an `exec` requires that we know the current indent level for
+printing line-oriented components. As will become clear later, we
+also want to know what sort of bracketing to use.
+
+###### ast functions
+
+ static void do_indent(int i, char *str)
{
- if (type && type->dup)
- type->dup(type, vold, vnew);
+ while (i-- > 0)
+ printf(" ");
+ printf("%s", str);
}
- static int value_cmp(struct type *tl, struct type *tr,
- struct value *left, struct value *right)
+###### core functions
+ static void print_binode(struct binode *b, int indent, int bracket)
{
- if (tl && tl->cmp_order)
- return tl->cmp_order(tl, tr, left, right);
- if (tl && tl->cmp_eq) // NOTEST
- return tl->cmp_eq(tl, tr, left, right); // NOTEST
- return -1; // NOTEST
+ struct binode *b2;
+ switch(b->op) {
+ ## print binode cases
+ }
}
- static void print_value(struct type *type, struct value *v)
+ static void print_exec(struct exec *e, int indent, int bracket)
{
- if (type && type->print)
- type->print(type, v);
- else
- printf("*Unknown*"); // NOTEST
+ if (!e)
+ return;
+ switch (e->type) {
+ case Xbinode:
+ print_binode(cast(binode, e), indent, bracket); break;
+ ## print exec cases
+ }
+ if (e->to_free) {
+ struct variable *v;
+ do_indent(indent, "/* FREE");
+ for (v = e->to_free; v; v = v->next_free) {
+ printf(" %.*s", v->name->name.len, v->name->name.txt);
+ printf("[%d,%d]", v->scope_start, v->scope_end);
+ if (v->frame_pos >= 0)
+ printf("(%d+%d)", v->frame_pos,
+ v->type ? v->type->size:0);
+ }
+ printf(" */\n");
+ }
}
###### forward decls
- static void free_value(struct type *type, struct value *v);
- static int type_compat(struct type *require, struct type *have, int rules);
- static void type_print(struct type *type, FILE *f);
- static void val_init(struct type *type, struct value *v);
- static void dup_value(struct type *type,
- struct value *vold, struct value *vnew);
- static int value_cmp(struct type *tl, struct type *tr,
- struct value *left, struct value *right);
- static void print_value(struct type *type, struct value *v);
+ static void print_exec(struct exec *e, int indent, int bracket);
-###### free context types
+#### Analysing
- while (context.typelist) {
- struct type *t = context.typelist;
+As discussed, analysis involves propagating type requirements around the
+program and looking for errors.
- context.typelist = t->next;
- if (t->free_type)
- t->free_type(t);
- free(t);
- }
+So `propagate_types` is passed an expected type (being a `struct type`
+pointer together with some `val_rules` flags) that the `exec` is
+expected to return, and returns the type that it does return, either of
+which can be `NULL` signifying "unknown". A `prop_err` flag set is
+passed by reference. It has `Efail` set when an error is found, and
+`Eretry` when the type for some element is set via propagation. If
+any expression cannot be evaluated immediately, `Enoconst` is set.
+If the expression can be copied, `Emaycopy` is set.
-Type can be specified for local variables, for fields in a structure,
-for formal parameters to functions, and possibly elsewhere. Different
-rules may apply in different contexts. As a minimum, a named type may
-always be used. Currently the type of a formal parameter can be
-different from types in other contexts, so we have a separate grammar
-symbol for those.
+If it remains unchanged at `0`, then no more propagation is needed.
-###### Grammar
+###### ast
- $*type
- Type -> IDENTIFIER ${
- $0 = find_type(c, $1.txt);
- if (!$0) {
- tok_err(c,
- "error: undefined type", &$1);
+ enum val_rules {Rnolabel = 1<<0, Rboolok = 1<<1, Rnoconstant = 1<<2};
+ enum prop_err {Efail = 1<<0, Eretry = 1<<1, Enoconst = 1<<2,
+ Emaycopy = 1<<3};
- $0 = Tnone;
- }
- }$
- ## type grammar
+###### format cases
+ case 'r':
+ if (rules & Rnolabel)
+ fputs(" (labels not permitted)", stderr);
+ break;
- FormalType -> Type ${ $0 = $<1; }$
- ## formal type grammar
+###### forward decls
+ static struct type *propagate_types(struct exec *prog, struct parse_context *c, enum prop_err *perr,
+ struct type *type, int rules);
+###### core functions
+
+ static struct type *__propagate_types(struct exec *prog, struct parse_context *c, enum prop_err *perr,
+ struct type *type, int rules)
+ {
+ struct type *t;
+
+ if (!prog)
+ return Tnone;
+
+ switch (prog->type) {
+ case Xbinode:
+ {
+ struct binode *b = cast(binode, prog);
+ switch (b->op) {
+ ## propagate binode cases
+ }
+ break;
+ }
+ ## propagate exec cases
+ }
+ return Tnone;
+ }
+
+ static struct type *propagate_types(struct exec *prog, struct parse_context *c, enum prop_err *perr,
+ struct type *type, int rules)
+ {
+ int pre_err = c->parse_error;
+ struct type *ret = __propagate_types(prog, c, perr, type, rules);
+
+ if (c->parse_error > pre_err)
+ *perr |= Efail;
+ return ret;
+ }
+
+#### Interpreting
+
+Interpreting an `exec` doesn't require anything but the `exec`. State
+is stored in variables and each variable will be directly linked from
+within the `exec` tree. The exception to this is the `main` function
+which needs to look at command line arguments. This function will be
+interpreted separately.
+
+Each `exec` can return a value combined with a type in `struct lrval`.
+The type may be `Tnone` but must be non-NULL. Some `exec`s will return
+the location of a value, which can be updated, in `lval`. Others will
+set `lval` to NULL indicating that there is a value of appropriate type
+in `rval`.
+
+###### forward decls
+ static struct value interp_exec(struct parse_context *c, struct exec *e,
+ struct type **typeret);
+###### core functions
+
+ struct lrval {
+ struct type *type;
+ struct value rval, *lval;
+ };
+
+ /* If dest is passed, dtype must give the expected type, and
+ * result can go there, in which case type is returned as NULL.
+ */
+ static struct lrval _interp_exec(struct parse_context *c, struct exec *e,
+ struct value *dest, struct type *dtype);
+
+ static struct value interp_exec(struct parse_context *c, struct exec *e,
+ struct type **typeret)
+ {
+ struct lrval ret = _interp_exec(c, e, NULL, NULL);
+
+ if (!ret.type) abort();
+ if (typeret)
+ *typeret = ret.type;
+ if (ret.lval)
+ dup_value(ret.type, ret.lval, &ret.rval);
+ return ret.rval;
+ }
+
+ static struct value *linterp_exec(struct parse_context *c, struct exec *e,
+ struct type **typeret)
+ {
+ struct lrval ret = _interp_exec(c, e, NULL, NULL);
+
+ if (!ret.type) abort();
+ if (ret.lval)
+ *typeret = ret.type;
+ else
+ free_value(ret.type, &ret.rval);
+ return ret.lval;
+ }
+
+ /* dinterp_exec is used when the destination type is certain and
+ * the value has a place to go.
+ */
+ static void dinterp_exec(struct parse_context *c, struct exec *e,
+ struct value *dest, struct type *dtype,
+ int need_free)
+ {
+ struct lrval ret = _interp_exec(c, e, dest, dtype);
+ if (!ret.type)
+ return;
+ if (need_free)
+ free_value(dtype, dest);
+ if (ret.lval)
+ dup_value(dtype, ret.lval, dest);
+ else
+ memcpy(dest, &ret.rval, dtype->size);
+ }
+
+ static struct lrval _interp_exec(struct parse_context *c, struct exec *e,
+ struct value *dest, struct type *dtype)
+ {
+ /* If the result is copied to dest, ret.type is set to NULL */
+ struct lrval ret;
+ struct value rv = {}, *lrv = NULL;
+ struct type *rvtype;
+
+ rvtype = ret.type = Tnone;
+ if (!e) {
+ ret.lval = lrv;
+ ret.rval = rv;
+ return ret;
+ }
+
+ switch(e->type) {
+ case Xbinode:
+ {
+ struct binode *b = cast(binode, e);
+ struct value left, right, *lleft;
+ struct type *ltype, *rtype;
+ ltype = rtype = Tnone;
+ switch (b->op) {
+ ## interp binode cases
+ }
+ free_value(ltype, &left);
+ free_value(rtype, &right);
+ break;
+ }
+ ## interp exec cases
+ }
+ if (rvtype) {
+ ret.lval = lrv;
+ ret.rval = rv;
+ ret.type = rvtype;
+ }
+ ## interp exec cleanup
+ return ret;
+ }
+
+### Types
+
+Values come in a wide range of types, with more likely to be added.
+Each type needs to be able to print its own values (for convenience at
+least) as well as to compare two values, at least for equality and
+possibly for order. For now, values might need to be duplicated and
+freed, though eventually such manipulations will be better integrated
+into the language.
+
+Rather than requiring every numeric type to support all numeric
+operations (add, multiply, etc), we allow types to be able to present
+as one of a few standard types: integer, float, and fraction. The
+existence of these conversion functions eventually enable types to
+determine if they are compatible with other types, though such types
+have not yet been implemented.
+
+Named type are stored in a simple linked list. Objects of each type are
+"values" which are often passed around by value.
+
+There are both explicitly named types, and anonymous types. Anonymous
+cannot be accessed by name, but are used internally and have a name
+which might be reported in error messages.
+
+###### ast
+
+ struct value {
+ union {
+ char ptr[1];
+ ## value union fields
+ };
+ };
+
+ struct type {
+ struct text name;
+ struct type *next;
+ struct token first_use;
+ int size, align;
+ int anon;
+ void (*init)(struct type *type, struct value *val);
+ int (*prepare_type)(struct parse_context *c, struct type *type, int parse_time);
+ void (*print)(struct type *type, struct value *val, FILE *f);
+ void (*print_type)(struct type *type, FILE *f);
+ int (*cmp_order)(struct type *t1, struct type *t2,
+ struct value *v1, struct value *v2);
+ int (*cmp_eq)(struct type *t1, struct type *t2,
+ struct value *v1, struct value *v2);
+ void (*dup)(struct type *type, struct value *vold, struct value *vnew);
+ void (*free)(struct type *type, struct value *val);
+ void (*free_type)(struct type *t);
+ long long (*to_int)(struct value *v);
+ double (*to_float)(struct value *v);
+ int (*to_mpq)(mpq_t *q, struct value *v);
+ ## type functions
+ union {
+ ## type union fields
+ };
+ };
+
+###### parse context
+
+ struct type *typelist;
+
+###### includes
+ #include <stdarg.h>
+
+###### ast functions
+
+ static struct type *find_type(struct parse_context *c, struct text s)
+ {
+ struct type *t = c->typelist;
+
+ while (t && (t->anon ||
+ text_cmp(t->name, s) != 0))
+ t = t->next;
+ return t;
+ }
+
+ static struct type *_add_type(struct parse_context *c, struct text s,
+ struct type *proto, int anon)
+ {
+ struct type *n;
+
+ n = calloc(1, sizeof(*n));
+ if (proto)
+ *n = *proto;
+ else
+ n->size = -1;
+ n->name = s;
+ n->anon = anon;
+ n->next = c->typelist;
+ c->typelist = n;
+ return n;
+ }
+
+ static struct type *add_type(struct parse_context *c, struct text s,
+ struct type *proto)
+ {
+ return _add_type(c, s, proto, 0);
+ }
+
+ static struct type *add_anon_type(struct parse_context *c,
+ struct type *proto, char *name, ...)
+ {
+ struct text t;
+ va_list ap;
+
+ va_start(ap, name);
+ vasprintf(&t.txt, name, ap);
+ va_end(ap);
+ t.len = strlen(name);
+ return _add_type(c, t, proto, 1);
+ }
+
+ static void free_type(struct type *t)
+ {
+ /* The type is always a reference to something in the
+ * context, so we don't need to free anything.
+ */
+ }
+
+ static void free_value(struct type *type, struct value *v)
+ {
+ if (type && v) {
+ type->free(type, v);
+ memset(v, 0x5a, type->size);
+ }
+ }
+
+ static void type_print(struct type *type, FILE *f)
+ {
+ if (!type)
+ fputs("*unknown*type*", f); // NOTEST
+ else if (type->name.len && !type->anon)
+ fprintf(f, "%.*s", type->name.len, type->name.txt);
+ else if (type->print_type)
+ type->print_type(type, f);
+ else
+ fputs("*invalid*type*", f);
+ }
+
+ static void val_init(struct type *type, struct value *val)
+ {
+ if (type && type->init)
+ type->init(type, val);
+ }
+
+ static void dup_value(struct type *type,
+ struct value *vold, struct value *vnew)
+ {
+ if (type && type->dup)
+ type->dup(type, vold, vnew);
+ }
+
+ static int value_cmp(struct type *tl, struct type *tr,
+ struct value *left, struct value *right)
+ {
+ if (tl && tl->cmp_order)
+ return tl->cmp_order(tl, tr, left, right);
+ if (tl && tl->cmp_eq) // NOTEST
+ return tl->cmp_eq(tl, tr, left, right); // NOTEST
+ return -1; // NOTEST
+ }
+
+ static void print_value(struct type *type, struct value *v, FILE *f)
+ {
+ if (type && type->print)
+ type->print(type, v, f);
+ else
+ fprintf(f, "*Unknown*"); // NOTEST
+ }
+
+ static void prepare_types(struct parse_context *c)
+ {
+ struct type *t;
+ int retry = 1;
+ enum { none, some, cannot } progress = none;
+
+ while (retry) {
+ retry = 0;
+
+ for (t = c->typelist; t; t = t->next) {
+ if (t->size < 0)
+ tok_err(c, "error: type used but not declared",
+ &t->first_use);
+ if (t->size == 0 && t->prepare_type) {
+ if (t->prepare_type(c, t, 1))
+ progress = some;
+ else if (progress == cannot)
+ tok_err(c, "error: type has recursive definition",
+ &t->first_use);
+ else
+ retry = 1;
+ }
+ }
+ switch (progress) {
+ case cannot:
+ retry = 0; break;
+ case none:
+ progress = cannot; break;
+ case some:
+ progress = none; break;
+ }
+ }
+ }
+
+###### forward decls
+
+ static void free_value(struct type *type, struct value *v);
+ static int type_compat(struct type *require, struct type *have, int rules);
+ static void type_print(struct type *type, FILE *f);
+ static void val_init(struct type *type, struct value *v);
+ static void dup_value(struct type *type,
+ struct value *vold, struct value *vnew);
+ static int value_cmp(struct type *tl, struct type *tr,
+ struct value *left, struct value *right);
+ static void print_value(struct type *type, struct value *v, FILE *f);
+
+###### free context types
+
+ while (context.typelist) {
+ struct type *t = context.typelist;
+
+ context.typelist = t->next;
+ if (t->free_type)
+ t->free_type(t);
+ if (t->anon)
+ free(t->name.txt);
+ free(t);
+ }
+
+Type can be specified for local variables, for fields in a structure,
+for formal parameters to functions, and possibly elsewhere. Different
+rules may apply in different contexts. As a minimum, a named type may
+always be used. Currently the type of a formal parameter can be
+different from types in other contexts, so we have a separate grammar
+symbol for those.
+
+###### Grammar
+
+ $*type
+ Type -> IDENTIFIER ${
+ $0 = find_type(c, $ID.txt);
+ if (!$0) {
+ $0 = add_type(c, $ID.txt, NULL);
+ $0->first_use = $ID;
+ }
+ }$
+ ## type grammar
+
+ FormalType -> Type ${ $0 = $<1; }$
+ ## formal type grammar
#### Base Types
static int type_compat(struct type *require, struct type *have, int rules)
{
if ((rules & Rboolok) && have == Tbool)
- return 1;
+ return 1; // NOTEST
if ((rules & Rnolabel) && have == Tlabel)
- return 0;
+ return 0; // NOTEST
if (!require || !have)
return 1;
}
}
- static void _dup_value(struct type *type,
+ static void _dup_value(struct type *type,
struct value *vold, struct value *vnew)
{
switch (type->vtype) {
return cmp;
}
- static void _print_value(struct type *type, struct value *v)
+ static void _print_value(struct type *type, struct value *v, FILE *f)
{
switch (type->vtype) {
case Vnone: // NOTEST
- printf("*no-value*"); break; // NOTEST
+ fprintf(f, "*no-value*"); break; // NOTEST
case Vlabel: // NOTEST
- printf("*label-%p*", v->label); break; // NOTEST
+ fprintf(f, "*label-%p*", v->label); break; // NOTEST
case Vstr:
- printf("%.*s", v->str.len, v->str.txt); break;
+ fprintf(f, "%.*s", v->str.len, v->str.txt); break;
case Vbool:
- printf("%s", v->bool ? "True":"False"); break;
+ fprintf(f, "%s", v->bool ? "True":"False"); break;
case Vnum:
{
mpf_t fl;
mpf_init2(fl, 20);
mpf_set_q(fl, v->num);
- gmp_printf("%Fg", fl);
+ gmp_fprintf(f, "%.10Fg", fl);
mpf_clear(fl);
break;
}
}
}
- static void _free_value(struct type *type, struct value *v);
-
- static struct type base_prototype = {
- .init = _val_init,
- .print = _print_value,
- .cmp_order = _value_cmp,
- .cmp_eq = _value_cmp,
- .dup = _dup_value,
- .free = _free_value,
- };
-
- static struct type *Tbool, *Tstr, *Tnum, *Tnone, *Tlabel;
+ static void _free_value(struct type *type, struct value *v);
+
+ static struct type base_prototype = {
+ .init = _val_init,
+ .print = _print_value,
+ .cmp_order = _value_cmp,
+ .cmp_eq = _value_cmp,
+ .dup = _dup_value,
+ .free = _free_value,
+ };
+
+ static struct type *Tbool, *Tstr, *Tnum, *Tnone, *Tlabel;
+
+###### ast functions
+ static struct type *add_base_type(struct parse_context *c, char *n,
+ enum vtype vt, int size)
+ {
+ struct text txt = { n, strlen(n) };
+ struct type *t;
+
+ t = add_type(c, txt, &base_prototype);
+ t->vtype = vt;
+ t->size = size;
+ t->align = size > sizeof(void*) ? sizeof(void*) : size;
+ if (t->size & (t->align - 1))
+ t->size = (t->size | (t->align - 1)) + 1; // NOTEST
+ return t;
+ }
+
+###### context initialization
+
+ Tbool = add_base_type(&context, "Boolean", Vbool, sizeof(char));
+ Tstr = add_base_type(&context, "string", Vstr, sizeof(struct text));
+ Tnum = add_base_type(&context, "number", Vnum, sizeof(mpq_t));
+ Tnone = add_base_type(&context, "none", Vnone, 0);
+ Tlabel = add_base_type(&context, "label", Vlabel, sizeof(void*));
+
+##### Base Values
+
+We have already met values as separate objects. When manifest constants
+appear in the program text, that must result in an executable which has
+a constant value. So the `val` structure embeds a value in an
+executable.
+
+###### exec type
+ Xval,
+
+###### ast
+ struct val {
+ struct exec;
+ struct type *vtype;
+ struct value val;
+ };
+
+###### ast functions
+ struct val *new_val(struct type *T, struct token tk)
+ {
+ struct val *v = new_pos(val, tk);
+ v->vtype = T;
+ return v;
+ }
+
+###### Grammar
+
+ $TERM True False
+
+ $*val
+ Value -> True ${
+ $0 = new_val(Tbool, $1);
+ $0->val.bool = 1;
+ }$
+ | False ${
+ $0 = new_val(Tbool, $1);
+ $0->val.bool = 0;
+ }$
+ | NUMBER ${ {
+ char tail[3];
+ $0 = new_val(Tnum, $1);
+ if (number_parse($0->val.num, tail, $1.txt) == 0)
+ mpq_init($0->val.num); // UNTESTED
+ if (tail[0])
+ tok_err(c, "error: unsupported number suffix",
+ &$1);
+ } }$
+ | STRING ${ {
+ char tail[3];
+ $0 = new_val(Tstr, $1);
+ string_parse(&$1, '\\', &$0->val.str, tail);
+ if (tail[0])
+ tok_err(c, "error: unsupported string suffix",
+ &$1);
+ } }$
+ | MULTI_STRING ${ {
+ char tail[3];
+ $0 = new_val(Tstr, $1);
+ string_parse(&$1, '\\', &$0->val.str, tail);
+ if (tail[0])
+ tok_err(c, "error: unsupported string suffix",
+ &$1);
+ } }$
+
+###### print exec cases
+ case Xval:
+ {
+ struct val *v = cast(val, e);
+ if (v->vtype == Tstr)
+ printf("\"");
+ // FIXME how to ensure numbers have same precision.
+ print_value(v->vtype, &v->val, stdout);
+ if (v->vtype == Tstr)
+ printf("\"");
+ break;
+ }
+
+###### propagate exec cases
+ case Xval:
+ {
+ struct val *val = cast(val, prog);
+ if (!type_compat(type, val->vtype, rules))
+ type_err(c, "error: expected %1%r found %2",
+ prog, type, rules, val->vtype);
+ return val->vtype;
+ }
+
+###### interp exec cases
+ case Xval:
+ rvtype = cast(val, e)->vtype;
+ dup_value(rvtype, &cast(val, e)->val, &rv);
+ break;
+
+###### ast functions
+ static void free_val(struct val *v)
+ {
+ if (v)
+ free_value(v->vtype, &v->val);
+ free(v);
+ }
+
+###### free exec cases
+ case Xval: free_val(cast(val, e)); break;
###### ast functions
- static struct type *add_base_type(struct parse_context *c, char *n,
- enum vtype vt, int size)
+ // Move all nodes from 'b' to 'rv', reversing their order.
+ // In 'b' 'left' is a list, and 'right' is the last node.
+ // In 'rv', left' is the first node and 'right' is a list.
+ static struct binode *reorder_bilist(struct binode *b)
{
- struct text txt = { n, strlen(n) };
- struct type *t;
+ struct binode *rv = NULL;
- t = add_type(c, txt, &base_prototype);
- t->vtype = vt;
- t->size = size;
- t->align = size > sizeof(void*) ? sizeof(void*) : size;
- if (t->size & (t->align - 1))
- t->size = (t->size | (t->align - 1)) + 1;
- return t;
+ while (b) {
+ struct exec *t = b->right;
+ b->right = rv;
+ rv = b;
+ if (b->left)
+ b = cast(binode, b->left);
+ else
+ b = NULL;
+ rv->left = t;
+ }
+ return rv;
}
-###### context initialization
-
- Tbool = add_base_type(&context, "Boolean", Vbool, sizeof(char));
- Tstr = add_base_type(&context, "string", Vstr, sizeof(struct text));
- Tnum = add_base_type(&context, "number", Vnum, sizeof(mpq_t));
- Tnone = add_base_type(&context, "none", Vnone, 0);
- Tlabel = add_base_type(&context, "label", Vlabel, sizeof(void*));
-
### Variables
Variables are scoped named values. We store the names in a linked list
## variable fields
};
+When a scope closes, the values of the variables might need to be freed.
+This happens in the context of some `struct exec` and each `exec` will
+need to know which variables need to be freed when it completes.
+
+####### exec fields
+ struct variable *to_free;
+
+####### variable fields
+ struct exec *cleanup_exec;
+ struct variable *next_free;
+
+####### interp exec cleanup
+ {
+ struct variable *v;
+ for (v = e->to_free; v; v = v->next_free) {
+ struct value *val = var_value(c, v);
+ free_value(v->type, val);
+ }
+ }
+
+###### ast functions
+ static void variable_unlink_exec(struct variable *v)
+ {
+ struct variable **vp;
+ if (!v->cleanup_exec)
+ return;
+ for (vp = &v->cleanup_exec->to_free;
+ *vp; vp = &(*vp)->next_free) {
+ if (*vp != v)
+ continue;
+ *vp = v->next_free;
+ v->cleanup_exec = NULL;
+ break;
+ }
+ }
+
While the naming seems strange, we include local constants in the
definition of variables. A name declared `var := value` can
subsequently be changed, but a name declared `var ::= value` cannot -
in which declared variables must not be in scope, and subsequent
branches, whether they may already be conditionally scoped.
+We need a total ordering of scopes so we can easily compare to variables
+to see if they are concurrently in scope. To achieve this we record a
+`scope_count` which is actually a count of both beginnings and endings
+of scopes. Then each variable has a record of the scope count where it
+enters scope, and where it leaves.
+
To push a new frame *before* any code in the frame is parsed, we need a
grammar reduction. This is most easily achieved with a grammar
element which derives the empty string, and creates the new scope when
###### parse context
int scope_depth;
+ int scope_count;
struct scope *scope_stack;
+###### variable fields
+ int scope_start, scope_end;
+
###### ast functions
static void scope_pop(struct parse_context *c)
{
c->scope_stack = s->parent;
free(s);
c->scope_depth -= 1;
+ c->scope_count += 1;
}
static void scope_push(struct parse_context *c)
s->parent = c->scope_stack;
c->scope_stack = s;
c->scope_depth += 1;
+ c->scope_count += 1;
}
###### Grammar
$void
OpenScope -> ${ scope_push(c); }$
- ClosePara -> ${ var_block_close(c, CloseParallel); }$
Each variable records a scope depth and is in one of four states:
enclosed the declaration, and that has closed.
- "conditionally in scope". The "in scope" block and all parallel
- scopes have closed, and no further mention of the name has been
- seen. This state includes a secondary nest depth which records the
- outermost scope seen since the variable became conditionally in
- scope. If a use of the name is found, the variable becomes "in
- scope" and that secondary depth becomes the recorded scope depth.
- If the name is declared as a new variable, the old variable becomes
- "out of scope" and the recorded scope depth stays unchanged.
+ scopes have closed, and no further mention of the name has been seen.
+ This state includes a secondary nest depth (`min_depth`) which records
+ the outermost scope seen since the variable became conditionally in
+ scope. If a use of the name is found, the variable becomes "in scope"
+ and that secondary depth becomes the recorded scope depth. If the
+ name is declared as a new variable, the old variable becomes "out of
+ scope" and the recorded scope depth stays unchanged.
- "out of scope". The variable is neither in scope nor conditionally
in scope. It is permanently out of scope now and can be removed from
- the "in scope" stack.
+ the "in scope" stack. When a variable becomes out-of-scope it is
+ moved to a separate list (`out_scope`) of variables which have fully
+ known scope. This will be used at the end of each function to assign
+ each variable a place in the stack frame.
###### variable fields
int depth, min_depth;
###### parse context
struct variable *in_scope;
+ struct variable *out_scope;
All variables with the same name are linked together using the
'previous' link. Those variable that have been affirmatively merged all
The storage of the value of a variable will be described later. For now
we just need to know that when a variable goes out of scope, it might
-need to be freed. For this we need to be able to find it, so assume that
+need to be freed. For this we need to be able to find it, so assume that
`var_value()` will provide that.
###### variable fields
{
struct variable *v;
- if (primary->merged)
- // shouldn't happen
- primary = primary->merged; // NOTEST
+ primary = primary->merged;
for (v = primary->previous; v; v=v->previous)
if (v == secondary || v == secondary->merged ||
v->merged == secondary ||
- (v->merged && v->merged == secondary->merged)) {
+ v->merged == secondary->merged) {
v->scope = OutScope;
v->merged = primary;
+ if (v->scope_start < primary->scope_start)
+ primary->scope_start = v->scope_start;
+ if (v->scope_end > primary->scope_end)
+ primary->scope_end = v->scope_end; // NOTEST
+ variable_unlink_exec(v);
}
}
###### forward decls
static struct value *var_value(struct parse_context *c, struct variable *v);
-###### free context vars
+###### free global vars
while (context.varlist) {
struct binding *b = context.varlist;
context.varlist = b->next;
free(b);
while (v) {
- struct variable *t = v;
-
- v = t->previous;
- free_value(t->type, var_value(&context, t));
- if (t->depth == 0)
- // This is a global constant
- free_exec(t->where_decl);
- free(t);
+ struct variable *next = v->previous;
+
+ if (v->global && v->frame_pos >= 0) {
+ free_value(v->type, var_value(&context, v));
+ if (v->depth == 0 && v->type->free == function_free)
+ // This is a function constant
+ free_exec(v->where_decl);
+ }
+ free(v);
+ v = next;
}
}
#### Manipulating Bindings
-When a name is conditionally visible, a new declaration discards the
-old binding - the condition lapses. Conversely a usage of the name
-affirms the visibility and extends it to the end of the containing
-block - i.e. the block that contains both the original declaration and
-the latest usage. This is determined from `min_depth`. When a
-conditionally visible variable gets affirmed like this, it is also
-merged with other conditionally visible variables with the same name.
+When a name is conditionally visible, a new declaration discards the old
+binding - the condition lapses. Similarly when we reach the end of a
+function (outermost non-global scope) any conditional scope must lapse.
+Conversely a usage of the name affirms the visibility and extends it to
+the end of the containing block - i.e. the block that contains both the
+original declaration and the latest usage. This is determined from
+`min_depth`. When a conditionally visible variable gets affirmed like
+this, it is also merged with other conditionally visible variables with
+the same name.
When we parse a variable declaration we either report an error if the
name is currently bound, or create a new variable at the current nest
When exiting a parallel scope we check if there are any variables that
were previously pending and are still visible. If there are, then
-there weren't redeclared in the most recent scope, so they cannot be
+they weren't redeclared in the most recent scope, so they cannot be
merged and must become out-of-scope. If it is not the first of
parallel scopes (based on `child_count`), we check that there was a
previous binding that is still pending-scope. If there isn't, the new
all pending-scope variables become conditionally scoped.
###### ast
- enum closetype { CloseSequential, CloseParallel, CloseElse };
+ enum closetype { CloseSequential, CloseFunction, CloseParallel, CloseElse };
###### ast functions
v->previous = b->var;
b->var = v;
v->name = b;
+ v->merged = v;
v->min_depth = v->depth = c->scope_depth;
v->scope = InScope;
v->in_scope = c->in_scope;
+ v->scope_start = c->scope_count;
c->in_scope = v;
+ ## variable init
return v;
}
return v;
}
- static void var_block_close(struct parse_context *c, enum closetype ct)
+ static int var_refile(struct parse_context *c, struct variable *v)
+ {
+ /* Variable just went out of scope. Add it to the out_scope
+ * list, sorted by ->scope_start
+ */
+ struct variable **vp = &c->out_scope;
+ while ((*vp) && (*vp)->scope_start < v->scope_start)
+ vp = &(*vp)->in_scope;
+ v->in_scope = *vp;
+ *vp = v;
+ return 0;
+ }
+
+ static void var_block_close(struct parse_context *c, enum closetype ct,
+ struct exec *e)
{
- /* Close off all variables that are in_scope */
+ /* Close off all variables that are in_scope.
+ * Some variables in c->scope may already be not-in-scope,
+ * such as when a PendingScope variable is hidden by a new
+ * variable with the same name.
+ * So we check for v->name->var != v and drop them.
+ * If we choose to make a variable OutScope, we drop it
+ * immediately too.
+ */
struct variable *v, **vp, *v2;
scope_pop(c);
for (vp = &c->in_scope;
- v = *vp, v && v->depth > c->scope_depth && v->min_depth > c->scope_depth;
- ) {
- if (v->name->var == v) switch (ct) {
+ (v = *vp) && v->min_depth > c->scope_depth;
+ (v->scope == OutScope || v->name->var != v)
+ ? (*vp = v->in_scope, var_refile(c, v))
+ : ( vp = &v->in_scope, 0)) {
+ v->min_depth = c->scope_depth;
+ if (v->name->var != v)
+ /* This is still in scope, but we haven't just
+ * closed the scope.
+ */
+ continue;
+ v->min_depth = c->scope_depth;
+ if (v->scope == InScope)
+ v->scope_end = c->scope_count;
+ if (v->scope == InScope && e && !v->global) {
+ /* This variable gets cleaned up when 'e' finishes */
+ variable_unlink_exec(v);
+ v->cleanup_exec = e;
+ v->next_free = e->to_free;
+ e->to_free = v;
+ }
+ switch (ct) {
case CloseElse:
case CloseParallel: /* handle PendingScope */
switch(v->scope) {
case InScope:
case CondScope:
if (c->scope_stack->child_count == 1)
+ /* first among parallel branches */
v->scope = PendingScope;
else if (v->previous &&
v->previous->scope == PendingScope)
+ /* all previous branches used name */
v->scope = PendingScope;
else if (v->type == Tlabel)
- v->scope = PendingScope;
- else if (v->name->var == v)
+ /* Labels remain pending even when not used */
+ v->scope = PendingScope; // UNTESTED
+ else
v->scope = OutScope;
if (ct == CloseElse) {
/* All Pending variables with this name
}
break;
case PendingScope:
- for (v2 = v;
- v2 && v2->scope == PendingScope;
- v2 = v2->previous)
- if (v2->type != Tlabel)
- v2->scope = OutScope;
- break;
- case OutScope: break;
+ /* Not possible as it would require
+ * parallel scope to be nested immediately
+ * in a parallel scope, and that never
+ * happens.
+ */ // NOTEST
+ case OutScope:
+ /* Not possible as we already tested for
+ * OutScope
+ */
+ abort(); // NOTEST
}
break;
+ case CloseFunction:
+ if (v->scope == CondScope)
+ /* Condition cannot continue past end of function */
+ v->scope = InScope;
+ /* fallthrough */
case CloseSequential:
if (v->type == Tlabel)
v->scope = PendingScope;
for (v2 = v;
v2 && v2->scope == PendingScope;
v2 = v2->previous)
- if (v2->type == Tlabel) {
+ if (v2->type == Tlabel)
v2->scope = CondScope;
- v2->min_depth = c->scope_depth;
- } else
+ else
v2->scope = OutScope;
break;
case CondScope:
}
break;
}
- if (v->scope == OutScope || v->name->var != v)
- *vp = v->in_scope;
- else
- vp = &v->in_scope;
}
}
values. The local frame doesn't get values until the interpreted phase
is started, so there is no need to allocate until the size is known.
+We initialize the `frame_pos` to an impossible value, so that we can
+tell if it was set or not later.
+
###### variable fields
- short frame_pos;
- short global;
+ short frame_pos;
+ short global;
+
+###### variable init
+ v->frame_pos = -1;
###### parse context
short local_size;
void *global, *local;
+###### forward decls
+ static struct value *global_alloc(struct parse_context *c, struct type *t,
+ struct variable *v, struct value *init);
+
###### ast functions
static struct value *var_value(struct parse_context *c, struct variable *v)
{
if (!v->global) {
if (!c->local || !v->type)
- return NULL;
+ return NULL; // UNTESTED
if (v->frame_pos + v->type->size > c->local_size) {
printf("INVALID frame_pos\n"); // NOTEST
exit(2); // NOTEST
t->prepare_type(c, t, 1); // NOTEST
if (c->global_size & (t->align - 1))
- c->global_size = (c->global_size + t->align) & ~(t->align-1);
+ c->global_size = (c->global_size + t->align) & ~(t->align-1); // NOTEST
if (!v) {
v = &scratch;
v->type = t;
As global values are found -- struct field initializers, labels etc --
`global_alloc()` is called to record the value in the global frame.
-When the program is fully parsed, we need to walk the list of variables
-to find any that weren't merged away and that aren't global, and to
-calculate the frame size and assign a frame position for each variable.
-For this we have `scope_finalize()`.
+When the program is fully parsed, each function is analysed, we need to
+walk the list of variables local to that function and assign them an
+offset in the stack frame. For this we have `scope_finalize()`.
+
+We keep the stack from dense by re-using space for between variables
+that are not in scope at the same time. The `out_scope` list is sorted
+by `scope_start` and as we process a varible, we move it to an FIFO
+stack. For each variable we consider, we first discard any from the
+stack anything that went out of scope before the new variable came in.
+Then we place the new variable just after the one at the top of the
+stack.
###### ast functions
- static void scope_finalize(struct parse_context *c)
+ static void scope_finalize(struct parse_context *c, struct type *ft)
{
- struct binding *b;
-
- for (b = c->varlist; b; b = b->next) {
- struct variable *v;
- for (v = b->var; v; v = v->previous) {
- struct type *t = v->type;
- if (v->merged && v->merged != v)
- continue;
- if (v->global)
- continue;
- if (c->local_size & (t->align - 1))
- c->local_size = (c->local_size + t->align) & ~(t->align-1);
- v->frame_pos = c->local_size;
- c->local_size += v->type->size;
- }
+ int size = ft->function.local_size;
+ struct variable *next = ft->function.scope;
+ struct variable *done = NULL;
+
+ while (next) {
+ struct variable *v = next;
+ struct type *t = v->type;
+ int pos;
+ next = v->in_scope;
+ if (v->merged != v)
+ continue;
+ if (!t)
+ continue;
+ if (v->frame_pos >= 0)
+ continue;
+ while (done && done->scope_end < v->scope_start)
+ done = done->in_scope;
+ if (done)
+ pos = done->frame_pos + done->type->size;
+ else
+ pos = ft->function.local_size;
+ if (pos & (t->align - 1))
+ pos = (pos + t->align) & ~(t->align-1);
+ v->frame_pos = pos;
+ if (size < pos + v->type->size)
+ size = pos + v->type->size;
+ v->in_scope = done;
+ done = v;
}
- c->local = calloc(1, c->local_size);
+ c->out_scope = NULL;
+ ft->function.local_size = size;
}
-###### free context vars
+###### free context storage
free(context.global);
- free(context.local);
-
-### Executables
-Executables can be lots of different things. In many cases an
-executable is just an operation combined with one or two other
-executables. This allows for expressions and lists etc. Other times an
-executable is something quite specific like a constant or variable name.
-So we define a `struct exec` to be a general executable with a type, and
-a `struct binode` which is a subclass of `exec`, forms a node in a
-binary tree, and holds an operation. There will be other subclasses,
-and to access these we need to be able to `cast` the `exec` into the
-various other types. The first field in any `struct exec` is the type
-from the `exec_types` enum.
+#### Variables as executables
-###### macros
- #define cast(structname, pointer) ({ \
- const typeof( ((struct structname *)0)->type) *__mptr = &(pointer)->type; \
- if (__mptr && *__mptr != X##structname) abort(); \
- (struct structname *)( (char *)__mptr);})
+Just as we used a `val` to wrap a value into an `exec`, we similarly
+need a `var` to wrap a `variable` into an exec. While each `val`
+contained a copy of the value, each `var` holds a link to the variable
+because it really is the same variable no matter where it appears.
+When a variable is used, we need to remember to follow the `->merged`
+link to find the primary instance.
- #define new(structname) ({ \
- struct structname *__ptr = ((struct structname *)calloc(1,sizeof(struct structname))); \
- __ptr->type = X##structname; \
- __ptr->line = -1; __ptr->column = -1; \
- __ptr;})
+When a variable is declared, it may or may not be given an explicit
+type. We need to record which so that we can report the parsed code
+correctly.
- #define new_pos(structname, token) ({ \
- struct structname *__ptr = ((struct structname *)calloc(1,sizeof(struct structname))); \
- __ptr->type = X##structname; \
- __ptr->line = token.line; __ptr->column = token.col; \
- __ptr;})
+###### exec type
+ Xvar,
###### ast
- enum exec_types {
- Xbinode,
- ## exec type
- };
- struct exec {
- enum exec_types type;
- int line, column;
- };
- struct binode {
+ struct var {
struct exec;
- enum Btype {
- ## Binode types
- } op;
- struct exec *left, *right;
+ struct variable *var;
};
-###### ast functions
-
- static int __fput_loc(struct exec *loc, FILE *f)
- {
- if (!loc)
- return 0;
- if (loc->line >= 0) {
- fprintf(f, "%d:%d: ", loc->line, loc->column);
- return 1;
- }
- if (loc->type == Xbinode)
- return __fput_loc(cast(binode,loc)->left, f) ||
- __fput_loc(cast(binode,loc)->right, f); // NOTEST
- return 0; // NOTEST
- }
- static void fput_loc(struct exec *loc, FILE *f)
- {
- if (!__fput_loc(loc, f))
- fprintf(f, "??:??: "); // NOTEST
- }
-
-Each different type of `exec` node needs a number of functions defined,
-a bit like methods. We must be able to free it, print it, analyse it
-and execute it. Once we have specific `exec` types we will need to
-parse them too. Let's take this a bit more slowly.
-
-#### Freeing
-
-The parser generator requires a `free_foo` function for each struct
-that stores attributes and they will often be `exec`s and subtypes
-there-of. So we need `free_exec` which can handle all the subtypes,
-and we need `free_binode`.
+###### variable fields
+ int explicit_type;
-###### ast functions
+###### Grammar
- static void free_binode(struct binode *b)
- {
- if (!b)
- return;
- free_exec(b->left);
- free_exec(b->right);
- free(b);
- }
+ $TERM : ::
-###### core functions
- static void free_exec(struct exec *e)
- {
- if (!e)
- return;
- switch(e->type) {
- ## free exec cases
+ $*var
+ VariableDecl -> IDENTIFIER : ${ {
+ struct variable *v = var_decl(c, $1.txt);
+ $0 = new_pos(var, $1);
+ $0->var = v;
+ if (v)
+ v->where_decl = $0;
+ else {
+ v = var_ref(c, $1.txt);
+ $0->var = v;
+ type_err(c, "error: variable '%v' redeclared",
+ $0, NULL, 0, NULL);
+ type_err(c, "info: this is where '%v' was first declared",
+ v->where_decl, NULL, 0, NULL);
+ }
+ } }$
+ | IDENTIFIER :: ${ {
+ struct variable *v = var_decl(c, $1.txt);
+ $0 = new_pos(var, $1);
+ $0->var = v;
+ if (v) {
+ v->where_decl = $0;
+ v->constant = 1;
+ } else {
+ v = var_ref(c, $1.txt);
+ $0->var = v;
+ type_err(c, "error: variable '%v' redeclared",
+ $0, NULL, 0, NULL);
+ type_err(c, "info: this is where '%v' was first declared",
+ v->where_decl, NULL, 0, NULL);
+ }
+ } }$
+ | IDENTIFIER : Type ${ {
+ struct variable *v = var_decl(c, $1.txt);
+ $0 = new_pos(var, $1);
+ $0->var = v;
+ if (v) {
+ v->where_decl = $0;
+ v->where_set = $0;
+ v->type = $<Type;
+ v->explicit_type = 1;
+ } else {
+ v = var_ref(c, $1.txt);
+ $0->var = v;
+ type_err(c, "error: variable '%v' redeclared",
+ $0, NULL, 0, NULL);
+ type_err(c, "info: this is where '%v' was first declared",
+ v->where_decl, NULL, 0, NULL);
+ }
+ } }$
+ | IDENTIFIER :: Type ${ {
+ struct variable *v = var_decl(c, $1.txt);
+ $0 = new_pos(var, $1);
+ $0->var = v;
+ if (v) {
+ v->where_decl = $0;
+ v->where_set = $0;
+ v->type = $<Type;
+ v->constant = 1;
+ v->explicit_type = 1;
+ } else {
+ v = var_ref(c, $1.txt);
+ $0->var = v;
+ type_err(c, "error: variable '%v' redeclared",
+ $0, NULL, 0, NULL);
+ type_err(c, "info: this is where '%v' was first declared",
+ v->where_decl, NULL, 0, NULL);
}
- }
-
-###### forward decls
-
- static void free_exec(struct exec *e);
-
-###### free exec cases
- case Xbinode: free_binode(cast(binode, e)); break;
-
-#### Printing
-
-Printing an `exec` requires that we know the current indent level for
-printing line-oriented components. As will become clear later, we
-also want to know what sort of bracketing to use.
-
-###### ast functions
-
- static void do_indent(int i, char *str)
- {
- while (i--)
- printf(" ");
- printf("%s", str);
- }
+ } }$
-###### core functions
- static void print_binode(struct binode *b, int indent, int bracket)
- {
- struct binode *b2;
- switch(b->op) {
- ## print binode cases
+ $*exec
+ Variable -> IDENTIFIER ${ {
+ struct variable *v = var_ref(c, $1.txt);
+ $0 = new_pos(var, $1);
+ if (v == NULL) {
+ /* This might be a global const or a label
+ * Allocate a var with impossible type Tnone,
+ * which will be adjusted when we find out what it is,
+ * or will trigger an error.
+ */
+ v = var_decl(c, $1.txt);
+ if (v) {
+ v->type = Tnone;
+ v->where_decl = $0;
+ v->where_set = $0;
+ }
}
- }
+ cast(var, $0)->var = v;
+ } }$
- static void print_exec(struct exec *e, int indent, int bracket)
+###### print exec cases
+ case Xvar:
{
- if (!e)
- return; // NOTEST
- switch (e->type) {
- case Xbinode:
- print_binode(cast(binode, e), indent, bracket); break;
- ## print exec cases
+ struct var *v = cast(var, e);
+ if (v->var) {
+ struct binding *b = v->var->name;
+ printf("%.*s", b->name.len, b->name.txt);
}
+ break;
}
-###### forward decls
-
- static void print_exec(struct exec *e, int indent, int bracket);
-
-#### Analysing
-
-As discussed, analysis involves propagating type requirements around the
-program and looking for errors.
-
-So `propagate_types` is passed an expected type (being a `struct type`
-pointer together with some `val_rules` flags) that the `exec` is
-expected to return, and returns the type that it does return, either
-of which can be `NULL` signifying "unknown". An `ok` flag is passed
-by reference. It is set to `0` when an error is found, and `2` when
-any change is made. If it remains unchanged at `1`, then no more
-propagation is needed.
-
-###### ast
-
- enum val_rules {Rnolabel = 1<<0, Rboolok = 1<<1, Rnoconstant = 2<<1};
-
###### format cases
- case 'r':
- if (rules & Rnolabel)
- fputs(" (labels not permitted)", stderr);
+ case 'v':
+ if (loc && loc->type == Xvar) {
+ struct var *v = cast(var, loc);
+ if (v->var) {
+ struct binding *b = v->var->name;
+ fprintf(stderr, "%.*s", b->name.len, b->name.txt);
+ } else
+ fputs("???", stderr); // NOTEST
+ } else
+ fputs("NOTVAR", stderr);
break;
-###### core functions
+###### propagate exec cases
- static struct type *propagate_types(struct exec *prog, struct parse_context *c, int *ok,
- struct type *type, int rules);
- static struct type *__propagate_types(struct exec *prog, struct parse_context *c, int *ok,
- struct type *type, int rules)
+ case Xvar:
{
- struct type *t;
-
- if (!prog)
- return Tnone;
-
- switch (prog->type) {
- case Xbinode:
- {
- struct binode *b = cast(binode, prog);
- switch (b->op) {
- ## propagate binode cases
- }
- break;
+ struct var *var = cast(var, prog);
+ struct variable *v = var->var;
+ if (!v) {
+ type_err(c, "%d:BUG: no variable!!", prog, NULL, 0, NULL); // NOTEST
+ return Tnone; // NOTEST
}
- ## propagate exec cases
+ v = v->merged;
+ if (v->constant && (rules & Rnoconstant)) {
+ type_err(c, "error: Cannot assign to a constant: %v",
+ prog, NULL, 0, NULL);
+ type_err(c, "info: name was defined as a constant here",
+ v->where_decl, NULL, 0, NULL);
+ return v->type;
}
- return Tnone;
+ if (v->type == Tnone && v->where_decl == prog)
+ type_err(c, "error: variable used but not declared: %v",
+ prog, NULL, 0, NULL);
+ if (v->type == NULL) {
+ if (type && !(*perr & Efail)) {
+ v->type = type;
+ v->where_set = prog;
+ *perr |= Eretry;
+ }
+ } else if (!type_compat(type, v->type, rules)) {
+ type_err(c, "error: expected %1%r but variable '%v' is %2", prog,
+ type, rules, v->type);
+ type_err(c, "info: this is where '%v' was set to %1", v->where_set,
+ v->type, rules, NULL);
+ }
+ if (!v->global || v->frame_pos < 0)
+ *perr |= Enoconst;
+ if (!type)
+ return v->type;
+ return type;
}
- static struct type *propagate_types(struct exec *prog, struct parse_context *c, int *ok,
- struct type *type, int rules)
+###### interp exec cases
+ case Xvar:
{
- struct type *ret = __propagate_types(prog, c, ok, type, rules);
+ struct var *var = cast(var, e);
+ struct variable *v = var->var;
- if (c->parse_error)
- *ok = 0;
- return ret;
+ v = v->merged;
+ lrv = var_value(c, v);
+ rvtype = v->type;
+ break;
}
-#### Interpreting
-
-Interpreting an `exec` doesn't require anything but the `exec`. State
-is stored in variables and each variable will be directly linked from
-within the `exec` tree. The exception to this is the `main` function
-which needs to look at command line arguments. This function will be
-interpreted separately.
-
-Each `exec` can return a value combined with a type in `struct lrval`.
-The type may be `Tnone` but must be non-NULL. Some `exec`s will return
-the location of a value, which can be updated, in `lval`. Others will
-set `lval` to NULL indicating that there is a value of appropriate type
-in `rval`.
-
-###### core functions
-
- struct lrval {
- struct type *type;
- struct value rval, *lval;
- };
-
- static struct lrval _interp_exec(struct parse_context *c, struct exec *e);
-
- static struct value interp_exec(struct parse_context *c, struct exec *e,
- struct type **typeret)
- {
- struct lrval ret = _interp_exec(c, e);
-
- if (!ret.type) abort();
- if (typeret)
- *typeret = ret.type;
- if (ret.lval)
- dup_value(ret.type, ret.lval, &ret.rval);
- return ret.rval;
- }
+###### ast functions
- static struct value *linterp_exec(struct parse_context *c, struct exec *e,
- struct type **typeret)
+ static void free_var(struct var *v)
{
- struct lrval ret = _interp_exec(c, e);
-
- if (ret.lval)
- *typeret = ret.type;
- else
- free_value(ret.type, &ret.rval);
- return ret.lval;
+ free(v);
}
- static struct lrval _interp_exec(struct parse_context *c, struct exec *e)
- {
- struct lrval ret;
- struct value rv = {}, *lrv = NULL;
- struct type *rvtype;
-
- rvtype = ret.type = Tnone;
- if (!e) {
- ret.lval = lrv;
- ret.rval = rv;
- return ret;
- }
+###### free exec cases
+ case Xvar: free_var(cast(var, e)); break;
- switch(e->type) {
- case Xbinode:
- {
- struct binode *b = cast(binode, e);
- struct value left, right, *lleft;
- struct type *ltype, *rtype;
- ltype = rtype = Tnone;
- switch (b->op) {
- ## interp binode cases
- }
- free_value(ltype, &left);
- free_value(rtype, &right);
- break;
- }
- ## interp exec cases
- }
- ret.lval = lrv;
- ret.rval = rv;
- ret.type = rvtype;
- return ret;
- }
### Complex types
complex types and connected them in to the data structures and the
different phases of parse, analyse, print, interpret.
-Thus far we have arrays and structs.
+Being "complex" the language will naturally have syntax to access
+specifics of objects of these types. These will fit into the grammar as
+"Terms" which are the things that are combined with various operators to
+form "Expression". Where a Term is formed by some operation on another
+Term, the subordinate Term will always come first, so for example a
+member of an array will be expressed as the Term for the array followed
+by an index in square brackets. The strict rule of using postfix
+operations makes precedence irrelevant within terms. To provide a place
+to put the grammar for each terms of each type, we will start out by
+introducing the "Term" grammar production, with contains at least a
+simple "Value" (to be explained later).
+
+###### Grammar
+ $*exec
+ Term -> Value ${ $0 = $<1; }$
+ | Variable ${ $0 = $<1; }$
+ ## term grammar
+
+Thus far the complex types we have are arrays and structs.
#### Arrays
###### value functions
- static void array_prepare_type(struct parse_context *c, struct type *type,
+ static int array_prepare_type(struct parse_context *c, struct type *type,
int parse_time)
{
struct value *vsize;
mpz_t q;
- if (!type->array.vsize || type->array.static_size)
- return;
-
- vsize = var_value(c, type->array.vsize);
- mpz_init(q);
- mpz_tdiv_q(q, mpq_numref(vsize->num), mpq_denref(vsize->num));
- type->array.size = mpz_get_si(q);
- mpz_clear(q);
+ if (type->array.static_size)
+ return 1; // UNTESTED
+ if (type->array.unspec && parse_time)
+ return 1; // UNTESTED
+ if (parse_time && type->array.vsize && !type->array.vsize->global)
+ return 1; // UNTESTED
- if (parse_time) {
- type->array.static_size = 1;
- type->size = type->array.size * type->array.member->size;
- type->align = type->array.member->align;
+ if (type->array.vsize) {
+ vsize = var_value(c, type->array.vsize);
+ if (!vsize)
+ return 1; // UNTESTED
+ mpz_init(q);
+ mpz_tdiv_q(q, mpq_numref(vsize->num), mpq_denref(vsize->num));
+ type->array.size = mpz_get_si(q);
+ mpz_clear(q);
}
+ if (!parse_time)
+ return 1;
+ if (type->array.member->size <= 0)
+ return 0;
+
+ type->array.static_size = 1;
+ type->size = type->array.size * type->array.member->size;
+ type->align = type->array.member->align;
+
+ return 1;
}
static void array_init(struct type *type, struct value *val)
return 0;
if (have->array.unspec && require->array.unspec) {
if (have->array.vsize && require->array.vsize &&
- have->array.vsize != require->array.vsize)
+ have->array.vsize != require->array.vsize) // UNTESTED
/* sizes might not be the same */
- return 0;
+ return 0; // UNTESTED
return 1;
}
if (have->array.unspec || require->array.unspec)
- return 1;
+ return 1; // UNTESTED
if (require->array.vsize == NULL && have->array.vsize == NULL)
return require->array.size == have->array.size;
- return require->array.vsize == have->array.vsize;
+ return require->array.vsize == have->array.vsize; // UNTESTED
}
static void array_print_type(struct type *type, FILE *f)
struct binding *b = type->array.vsize->name;
fprintf(f, "%.*s%s]", b->name.len, b->name.txt,
type->array.unspec ? "::" : "");
- } else
+ } else if (type->array.size)
fprintf(f, "%d]", type->array.size);
+ else
+ fprintf(f, "]");
type_print(type->array.member, f);
}
| [ NUMBER ] Type ${ {
char tail[3];
mpq_t num;
- struct text noname = { "", 0 };
struct type *t;
+ int elements = 0;
- $0 = t = add_type(c, noname, &array_prototype);
- t->array.member = $<4;
- t->array.vsize = NULL;
if (number_parse(num, tail, $2.txt) == 0)
tok_err(c, "error: unrecognised number", &$2);
- else if (tail[0])
+ else if (tail[0]) {
tok_err(c, "error: unsupported number suffix", &$2);
- else {
- t->array.size = mpz_get_ui(mpq_numref(num));
+ mpq_clear(num);
+ } else {
+ elements = mpz_get_ui(mpq_numref(num));
if (mpz_cmp_ui(mpq_denref(num), 1) != 0) {
tok_err(c, "error: array size must be an integer",
&$2);
&$2);
mpq_clear(num);
}
- t->array.static_size = 1;
- t->size = t->array.size * t->array.member->size;
- t->align = t->array.member->align;
+
+ $0 = t = add_anon_type(c, &array_prototype, "array[%d]", elements );
+ t->array.size = elements;
+ t->array.member = $<4;
+ t->array.vsize = NULL;
} }$
| [ IDENTIFIER ] Type ${ {
struct variable *v = var_ref(c, $2.txt);
- struct text noname = { "", 0 };
if (!v)
tok_err(c, "error: name undeclared", &$2);
else if (!v->constant)
tok_err(c, "error: array size must be a constant", &$2);
- $0 = add_type(c, noname, &array_prototype);
+ $0 = add_anon_type(c, &array_prototype, "array[%.*s]", $2.txt.len, $2.txt.txt);
$0->array.member = $<4;
$0->array.size = 0;
$0->array.vsize = v;
| [ IDENTIFIER :: OptType ] Type ${ {
struct variable *v = var_decl(c, $ID.txt);
- struct text noname = { "", 0 };
v->type = $<OT;
v->constant = 1;
if (!v->type)
v->type = Tnum;
- $0 = add_type(c, noname, &array_prototype);
+ $0 = add_anon_type(c, &array_prototype, "array[var]");
$0->array.member = $<6;
$0->array.size = 0;
$0->array.unspec = 1;
###### Binode types
Index,
-###### variable grammar
+###### term grammar
- | Variable [ Expression ] ${ {
+ | Term [ Expression ] ${ {
struct binode *b = new(binode);
b->op = Index;
b->left = $<1;
/* left must be an array, right must be a number,
* result is the member type of the array
*/
- propagate_types(b->right, c, ok, Tnum, 0);
- t = propagate_types(b->left, c, ok, NULL, rules & Rnoconstant);
+ propagate_types(b->right, c, perr, Tnum, 0);
+ t = propagate_types(b->left, c, perr, NULL, rules & Rnoconstant);
if (!t || t->compat != array_compat) {
type_err(c, "error: %1 cannot be indexed", prog, t, 0, NULL);
return NULL;
if (i >= 0 && i < ltype->array.size)
lrv = ptr + i * rvtype->size;
else
- val_init(ltype->array.member, &rv);
+ val_init(ltype->array.member, &rv); // UNSAFE
ltype = NULL;
break;
}
struct type *type;
struct value *init;
int offset;
- } *fields;
+ } *fields; // This is created when field_list is analysed.
+ struct fieldlist {
+ struct fieldlist *prev;
+ struct field f;
+ struct exec *init;
+ } *field_list; // This is created during parsing
} structure;
###### type functions
struct value *v;
v = (void*) val->ptr + type->structure.fields[i].offset;
if (type->structure.fields[i].init)
- dup_value(type->structure.fields[i].type,
+ dup_value(type->structure.fields[i].type,
type->structure.fields[i].init,
v);
else
}
}
+ static void free_fieldlist(struct fieldlist *f)
+ {
+ if (!f)
+ return;
+ free_fieldlist(f->prev);
+ free_exec(f->init);
+ free(f);
+ }
+
static void structure_free_type(struct type *t)
{
int i;
t->structure.fields[i].init);
}
free(t->structure.fields);
+ free_fieldlist(t->structure.field_list);
+ }
+
+ static int structure_prepare_type(struct parse_context *c,
+ struct type *t, int parse_time)
+ {
+ int cnt = 0;
+ struct fieldlist *f;
+
+ if (!parse_time || t->structure.fields)
+ return 1;
+
+ for (f = t->structure.field_list; f; f=f->prev) {
+ enum prop_err perr;
+ cnt += 1;
+
+ if (f->f.type->size <= 0)
+ return 0;
+ if (f->f.type->prepare_type)
+ f->f.type->prepare_type(c, f->f.type, parse_time);
+
+ if (f->init == NULL)
+ continue;
+ do {
+ perr = 0;
+ propagate_types(f->init, c, &perr, f->f.type, 0);
+ } while (perr & Eretry);
+ if (perr & Efail)
+ c->parse_error += 1; // NOTEST
+ }
+
+ t->structure.nfields = cnt;
+ t->structure.fields = calloc(cnt, sizeof(struct field));
+ f = t->structure.field_list;
+ while (cnt > 0) {
+ int a = f->f.type->align;
+ cnt -= 1;
+ t->structure.fields[cnt] = f->f;
+ if (t->size & (a-1))
+ t->size = (t->size | (a-1)) + 1;
+ t->structure.fields[cnt].offset = t->size;
+ t->size += ((f->f.type->size - 1) | (a-1)) + 1;
+ if (a > t->align)
+ t->align = a;
+
+ if (f->init && !c->parse_error) {
+ struct value vl = interp_exec(c, f->init, NULL);
+ t->structure.fields[cnt].init =
+ global_alloc(c, f->f.type, NULL, &vl);
+ }
+
+ f = f->prev;
+ }
+ return 1;
}
static struct type structure_prototype = {
.free = structure_free,
.free_type = structure_free_type,
.print_type_decl = structure_print_type,
+ .prepare_type = structure_prepare_type,
};
###### exec type
###### declare terminals
$TERM struct .
-###### variable grammar
+###### term grammar
- | Variable . IDENTIFIER ${ {
+ | Term . IDENTIFIER ${ {
struct fieldref *fr = new_pos(fieldref, $2);
fr->left = $<1;
fr->name = $3.txt;
case Xfieldref:
{
struct fieldref *f = cast(fieldref, prog);
- struct type *st = propagate_types(f->left, c, ok, NULL, 0);
+ struct type *st = propagate_types(f->left, c, perr, NULL, 0);
if (!st)
- type_err(c, "error: unknown type for field access", f->left,
+ type_err(c, "error: unknown type for field access", f->left, // UNTESTED
NULL, 0, NULL);
else if (st->init != structure_init)
type_err(c, "error: field reference attempted on %1, not a struct",
break;
}
-###### ast
- struct fieldlist {
- struct fieldlist *prev;
- struct field f;
- };
-
-###### ast functions
- static void free_fieldlist(struct fieldlist *f)
- {
- if (!f)
- return;
- free_fieldlist(f->prev);
- if (f->f.init) {
- free_value(f->f.type, f->f.init);
- free(f->f.init);
- }
- free(f);
- }
-
###### top level grammar
DeclareStruct -> struct IDENTIFIER FieldBlock Newlines ${ {
- struct type *t =
- add_type(c, $2.txt, &structure_prototype);
- int cnt = 0;
- struct fieldlist *f;
-
- for (f = $3; f; f=f->prev)
- cnt += 1;
-
- t->structure.nfields = cnt;
- t->structure.fields = calloc(cnt, sizeof(struct field));
- f = $3;
- while (cnt > 0) {
- int a = f->f.type->align;
- cnt -= 1;
- t->structure.fields[cnt] = f->f;
- if (t->size & (a-1))
- t->size = (t->size | (a-1)) + 1;
- t->structure.fields[cnt].offset = t->size;
- t->size += ((f->f.type->size - 1) | (a-1)) + 1;
- if (a > t->align)
- t->align = a;
- f->f.init = NULL;
- f = f->prev;
- }
- } }$
+ struct type *t;
+ t = find_type(c, $ID.txt);
+ if (!t)
+ t = add_type(c, $ID.txt, &structure_prototype);
+ else if (t->size >= 0) {
+ tok_err(c, "error: type already declared", &$ID);
+ tok_err(c, "info: this is location of declartion", &t->first_use);
+ /* Create a new one - duplicate */
+ t = add_type(c, $ID.txt, &structure_prototype);
+ } else {
+ struct type tmp = *t;
+ *t = structure_prototype;
+ t->name = tmp.name;
+ t->next = tmp.next;
+ }
+ t->structure.field_list = $<FB;
+ t->first_use = $ID;
+ } }$
$*fieldlist
FieldBlock -> { IN OptNL FieldLines OUT OptNL } ${ $0 = $<FL; }$
- | { SimpleFieldList } ${ $0 = $<SFL; }$
- | IN OptNL FieldLines OUT ${ $0 = $<FL; }$
- | SimpleFieldList EOL ${ $0 = $<SFL; }$
+ | { SimpleFieldList } ${ $0 = $<SFL; }$
+ | IN OptNL FieldLines OUT ${ $0 = $<FL; }$
+ | SimpleFieldList EOL ${ $0 = $<SFL; }$
FieldLines -> SimpleFieldList Newlines ${ $0 = $<SFL; }$
- | FieldLines SimpleFieldList Newlines ${
- $SFL->prev = $<FL;
- $0 = $<SFL;
- }$
+ | FieldLines SimpleFieldList Newlines ${
+ $SFL->prev = $<FL;
+ $0 = $<SFL;
+ }$
SimpleFieldList -> Field ${ $0 = $<F; }$
- | SimpleFieldList ; Field ${
- $F->prev = $<SFL;
- $0 = $<F;
- }$
- | SimpleFieldList ; ${
- $0 = $<SFL;
- }$
- | ERROR ${ tok_err(c, "Syntax error in struct field", &$1); }$
+ | SimpleFieldList ; Field ${
+ $F->prev = $<SFL;
+ $0 = $<F;
+ }$
+ | SimpleFieldList ; ${
+ $0 = $<SFL;
+ }$
+ | ERROR ${ tok_err(c, "Syntax error in struct field", &$1); }$
Field -> IDENTIFIER : Type = Expression ${ {
- int ok;
-
- $0 = calloc(1, sizeof(struct fieldlist));
- $0->f.name = $1.txt;
- $0->f.type = $<3;
- $0->f.init = NULL;
- do {
- ok = 1;
- propagate_types($<5, c, &ok, $3, 0);
- } while (ok == 2);
- if (!ok)
- c->parse_error = 1;
- else {
- struct value vl = interp_exec(c, $5, NULL);
- $0->f.init = global_alloc(c, $0->f.type, NULL, &vl);
- }
- } }$
- | IDENTIFIER : Type ${
- $0 = calloc(1, sizeof(struct fieldlist));
- $0->f.name = $1.txt;
- $0->f.type = $<3;
- if ($0->f.type->prepare_type)
- $0->f.type->prepare_type(c, $0->f.type, 1);
- }$
+ $0 = calloc(1, sizeof(struct fieldlist));
+ $0->f.name = $ID.txt;
+ $0->f.type = $<Type;
+ $0->f.init = NULL;
+ $0->init = $<Expr;
+ } }$
+ | IDENTIFIER : Type ${
+ $0 = calloc(1, sizeof(struct fieldlist));
+ $0->f.name = $ID.txt;
+ $0->f.type = $<Type;
+ }$
###### forward decls
static void structure_print_type(struct type *t, FILE *f);
if (fl->type->print && fl->init) {
fprintf(f, " = ");
if (fl->type == Tstr)
- fprintf(f, "\"");
- print_value(fl->type, fl->init);
+ fprintf(f, "\""); // UNTESTED
+ print_value(fl->type, fl->init, f);
if (fl->type == Tstr)
- fprintf(f, "\"");
+ fprintf(f, "\""); // UNTESTED
}
- printf("\n");
+ fprintf(f, "\n");
}
}
while (target != 0) {
int i = 0;
for (t = context.typelist; t ; t=t->next)
- if (t->print_type_decl) {
+ if (!t->anon && t->print_type_decl &&
+ !t->check_args) {
i += 1;
if (i == target)
break;
}
}
-### Functions
+#### Functions
-A function is a named chunk of code which can be passed parameters and
-can return results. Each function has an implicit type which includes
-the set of parameters and the return value. As yet these types cannot
-be declared separate from the function itself.
+A function is a chunk of code which can be passed parameters and can
+return results. Each function has a type which includes the set of
+parameters and the return value. As yet these types cannot be declared
+separately from the function itself.
-In fact, only one function is currently possible - `main`. `main` is
-passed an array of strings together with the size of the array, and
-doesn't return anything. The strings are command line arguments.
-
-The parameters can be specified either in parentheses as a list, such as
+The parameters can be specified either in parentheses as a ';' separated
+list, such as
##### Example: function 1
- func main(av:[ac::number]string)
+ func main(av:[ac::number]string; env:[envc::number]string)
code block
-or as an indented list of one parameter per line
+or as an indented list of one parameter per line (though each line can
+be a ';' separated list)
##### Example: function 2
func main
argv:[argc::number]string
+ env:[envc::number]string
do
code block
-###### Binode types
- Func, List,
+In the first case a return type can follow the parentheses after a colon,
+in the second it is given on a line starting with the word `return`.
-###### Grammar
+##### Example: functions that return
- $TERM func main
+ func add(a:number; b:number): number
+ code block
- $*binode
- MainFunction -> func main ( OpenScope Args ) Block Newlines ${
- $0 = new(binode);
- $0->op = Func;
- $0->left = reorder_bilist($<Ar);
- $0->right = $<Bl;
- var_block_close(c, CloseSequential);
- if (c->scope_stack && !c->parse_error) abort();
- }$
- | func main IN OpenScope OptNL Args OUT OptNL do Block Newlines ${
- $0 = new(binode);
- $0->op = Func;
- $0->left = reorder_bilist($<Ar);
- $0->right = $<Bl;
- var_block_close(c, CloseSequential);
- if (c->scope_stack && !c->parse_error) abort();
- }$
- | func main NEWLINE OpenScope OptNL do Block Newlines ${
- $0 = new(binode);
- $0->op = Func;
- $0->left = NULL;
- $0->right = $<Bl;
- var_block_close(c, CloseSequential);
- if (c->scope_stack && !c->parse_error) abort();
- }$
+ func catenate
+ a: string
+ b: string
+ return string
+ do
+ code block
- Args -> ${ $0 = NULL; }$
- | Varlist ${ $0 = $<1; }$
- | Varlist ; ${ $0 = $<1; }$
- | Varlist NEWLINE ${ $0 = $<1; }$
+Rather than returning a type, the function can specify a set of local
+variables to return as a struct. The values of these variables when the
+function exits will be provided to the caller. For this the return type
+is replaced with a block of result declarations, either in parentheses
+or bracketed by `return` and `do`.
- Varlist -> Varlist ; ArgDecl ${
- $0 = new(binode);
- $0->op = List;
- $0->left = $<Vl;
- $0->right = $<AD;
- }$
- | ArgDecl ${
- $0 = new(binode);
- $0->op = List;
- $0->left = NULL;
- $0->right = $<AD;
- }$
+##### Example: functions returning multiple variables
- $*var
- ArgDecl -> IDENTIFIER : FormalType ${ {
- struct variable *v = var_decl(c, $1.txt);
- $0 = new(var);
- $0->var = v;
- v->type = $<FT;
- } }$
+ func to_cartesian(rho:number; theta:number):(x:number; y:number)
+ x = .....
+ y = .....
-## Executables: the elements of code
+ func to_polar
+ x:number; y:number
+ return
+ rho:number
+ theta:number
+ do
+ rho = ....
+ theta = ....
-Each code element needs to be parsed, printed, analysed,
-interpreted, and freed. There are several, so let's just start with
-the easy ones and work our way up.
+For constructing the lists we use a `List` binode, which will be
+further detailed when Expression Lists are introduced.
-### Values
+###### type union fields
-We have already met values as separate objects. When manifest
-constants appear in the program text, that must result in an executable
-which has a constant value. So the `val` structure embeds a value in
-an executable.
+ struct {
+ struct binode *params;
+ struct type *return_type;
+ struct variable *scope;
+ int inline_result; // return value is at start of 'local'
+ int local_size;
+ } function;
-###### exec type
- Xval,
+###### value union fields
+ struct exec *function;
-###### ast
- struct val {
- struct exec;
- struct type *vtype;
- struct value val;
- };
+###### type functions
+ void (*check_args)(struct parse_context *c, enum prop_err *perr,
+ struct type *require, struct exec *args);
-###### ast functions
- struct val *new_val(struct type *T, struct token tk)
+###### value functions
+
+ static void function_free(struct type *type, struct value *val)
{
- struct val *v = new_pos(val, tk);
- v->vtype = T;
- return v;
+ free_exec(val->function);
+ val->function = NULL;
}
-###### Grammar
-
- $TERM True False
-
- $*val
- Value -> True ${
- $0 = new_val(Tbool, $1);
- $0->val.bool = 1;
- }$
- | False ${
- $0 = new_val(Tbool, $1);
- $0->val.bool = 0;
- }$
- | NUMBER ${
- $0 = new_val(Tnum, $1);
- {
- char tail[3];
- if (number_parse($0->val.num, tail, $1.txt) == 0)
- mpq_init($0->val.num);
- if (tail[0])
- tok_err(c, "error: unsupported number suffix",
- &$1);
- }
- }$
- | STRING ${
- $0 = new_val(Tstr, $1);
- {
- char tail[3];
- string_parse(&$1, '\\', &$0->val.str, tail);
- if (tail[0])
- tok_err(c, "error: unsupported string suffix",
- &$1);
- }
- }$
- | MULTI_STRING ${
- $0 = new_val(Tstr, $1);
- {
- char tail[3];
- string_parse(&$1, '\\', &$0->val.str, tail);
- if (tail[0])
- tok_err(c, "error: unsupported string suffix",
- &$1);
- }
- }$
-
-###### print exec cases
- case Xval:
+ static int function_compat(struct type *require, struct type *have)
{
- struct val *v = cast(val, e);
- if (v->vtype == Tstr)
- printf("\"");
- print_value(v->vtype, &v->val);
- if (v->vtype == Tstr)
- printf("\"");
- break;
+ // FIXME can I do anything here yet?
+ return 0;
}
-###### propagate exec cases
- case Xval:
+ static void function_check_args(struct parse_context *c, enum prop_err *perr,
+ struct type *require, struct exec *args)
{
- struct val *val = cast(val, prog);
- if (!type_compat(type, val->vtype, rules))
- type_err(c, "error: expected %1%r found %2",
- prog, type, rules, val->vtype);
- return val->vtype;
+ /* This should be 'compat', but we don't have a 'tuple' type to
+ * hold the type of 'args'
+ */
+ struct binode *arg = cast(binode, args);
+ struct binode *param = require->function.params;
+
+ while (param) {
+ struct var *pv = cast(var, param->left);
+ if (!arg) {
+ type_err(c, "error: insufficient arguments to function.",
+ args, NULL, 0, NULL);
+ break;
+ }
+ *perr = 0;
+ propagate_types(arg->left, c, perr, pv->var->type, 0);
+ param = cast(binode, param->right);
+ arg = cast(binode, arg->right);
+ }
+ if (arg)
+ type_err(c, "error: too many arguments to function.",
+ args, NULL, 0, NULL);
}
-###### interp exec cases
- case Xval:
- rvtype = cast(val, e)->vtype;
- dup_value(rvtype, &cast(val, e)->val, &rv);
- break;
-
-###### ast functions
- static void free_val(struct val *v)
+ static void function_print(struct type *type, struct value *val, FILE *f)
{
- if (v)
- free_value(v->vtype, &v->val);
- free(v);
+ print_exec(val->function, 1, 0);
}
-###### free exec cases
- case Xval: free_val(cast(val, e)); break;
-
-###### ast functions
- // Move all nodes from 'b' to 'rv', reversing their order.
- // In 'b' 'left' is a list, and 'right' is the last node.
- // In 'rv', left' is the first node and 'right' is a list.
- static struct binode *reorder_bilist(struct binode *b)
+ static void function_print_type_decl(struct type *type, FILE *f)
{
- struct binode *rv = NULL;
-
- while (b) {
- struct exec *t = b->right;
- b->right = rv;
- rv = b;
- if (b->left)
- b = cast(binode, b->left);
- else
- b = NULL;
- rv->left = t;
+ struct binode *b;
+ fprintf(f, "(");
+ for (b = type->function.params; b; b = cast(binode, b->right)) {
+ struct variable *v = cast(var, b->left)->var;
+ fprintf(f, "%.*s%s", v->name->name.len, v->name->name.txt,
+ v->constant ? "::" : ":");
+ type_print(v->type, f);
+ if (b->right)
+ fprintf(f, "; ");
}
- return rv;
+ fprintf(f, ")");
+ if (type->function.return_type != Tnone) {
+ fprintf(f, ":");
+ if (type->function.inline_result) {
+ int i;
+ struct type *t = type->function.return_type;
+ fprintf(f, " (");
+ for (i = 0; i < t->structure.nfields; i++) {
+ struct field *fl = t->structure.fields + i;
+ if (i)
+ fprintf(f, "; ");
+ fprintf(f, "%.*s:", fl->name.len, fl->name.txt);
+ type_print(fl->type, f);
+ }
+ fprintf(f, ")");
+ } else
+ type_print(type->function.return_type, f);
+ }
+ fprintf(f, "\n");
}
-### Variables
+ static void function_free_type(struct type *t)
+ {
+ free_exec(t->function.params);
+ }
-Just as we used a `val` to wrap a value into an `exec`, we similarly
-need a `var` to wrap a `variable` into an exec. While each `val`
-contained a copy of the value, each `var` holds a link to the variable
-because it really is the same variable no matter where it appears.
-When a variable is used, we need to remember to follow the `->merged`
-link to find the primary instance.
+ static struct type function_prototype = {
+ .size = sizeof(void*),
+ .align = sizeof(void*),
+ .free = function_free,
+ .compat = function_compat,
+ .check_args = function_check_args,
+ .print = function_print,
+ .print_type_decl = function_print_type_decl,
+ .free_type = function_free_type,
+ };
-###### exec type
- Xvar,
+###### declare terminals
-###### ast
- struct var {
- struct exec;
- struct variable *var;
- };
+ $TERM func
-###### Grammar
+###### Binode types
+ List,
- $TERM : ::
+###### Grammar
- $*var
- VariableDecl -> IDENTIFIER : ${ {
- struct variable *v = var_decl(c, $1.txt);
- $0 = new_pos(var, $1);
- $0->var = v;
- if (v)
- v->where_decl = $0;
- else {
- v = var_ref(c, $1.txt);
- $0->var = v;
- type_err(c, "error: variable '%v' redeclared",
- $0, NULL, 0, NULL);
- type_err(c, "info: this is where '%v' was first declared",
- v->where_decl, NULL, 0, NULL);
- }
- } }$
- | IDENTIFIER :: ${ {
+ $*variable
+ FuncName -> IDENTIFIER ${ {
struct variable *v = var_decl(c, $1.txt);
- $0 = new_pos(var, $1);
- $0->var = v;
+ struct var *e = new_pos(var, $1);
+ e->var = v;
if (v) {
- v->where_decl = $0;
- v->constant = 1;
+ v->where_decl = e;
+ $0 = v;
} else {
v = var_ref(c, $1.txt);
- $0->var = v;
- type_err(c, "error: variable '%v' redeclared",
- $0, NULL, 0, NULL);
+ e->var = v;
+ type_err(c, "error: function '%v' redeclared",
+ e, NULL, 0, NULL);
type_err(c, "info: this is where '%v' was first declared",
- v->where_decl, NULL, 0, NULL);
+ v->where_decl, NULL, 0, NULL);
+ free_exec(e);
}
} }$
- | IDENTIFIER : Type ${ {
- struct variable *v = var_decl(c, $1.txt);
- $0 = new_pos(var, $1);
- $0->var = v;
- if (v) {
- v->where_decl = $0;
- v->where_set = $0;
- v->type = $<Type;
- } else {
- v = var_ref(c, $1.txt);
- $0->var = v;
- type_err(c, "error: variable '%v' redeclared",
- $0, NULL, 0, NULL);
- type_err(c, "info: this is where '%v' was first declared",
- v->where_decl, NULL, 0, NULL);
- }
+
+ $*binode
+ Args -> ArgsLine NEWLINE ${ $0 = $<AL; }$
+ | Args ArgsLine NEWLINE ${ {
+ struct binode *b = $<AL;
+ struct binode **bp = &b;
+ while (*bp)
+ bp = (struct binode **)&(*bp)->left;
+ *bp = $<A;
+ $0 = b;
} }$
- | IDENTIFIER :: Type ${ {
+
+ ArgsLine -> ${ $0 = NULL; }$
+ | Varlist ${ $0 = $<1; }$
+ | Varlist ; ${ $0 = $<1; }$
+
+ Varlist -> Varlist ; ArgDecl ${
+ $0 = new(binode);
+ $0->op = List;
+ $0->left = $<Vl;
+ $0->right = $<AD;
+ }$
+ | ArgDecl ${
+ $0 = new(binode);
+ $0->op = List;
+ $0->left = NULL;
+ $0->right = $<AD;
+ }$
+
+ $*var
+ ArgDecl -> IDENTIFIER : FormalType ${ {
struct variable *v = var_decl(c, $1.txt);
- $0 = new_pos(var, $1);
+ $0 = new(var);
$0->var = v;
- if (v) {
- v->where_decl = $0;
- v->where_set = $0;
- v->type = $<Type;
- v->constant = 1;
- } else {
- v = var_ref(c, $1.txt);
- $0->var = v;
- type_err(c, "error: variable '%v' redeclared",
- $0, NULL, 0, NULL);
- type_err(c, "info: this is where '%v' was first declared",
- v->where_decl, NULL, 0, NULL);
- }
+ v->type = $<FT;
+ } }$
+
+##### Function calls
+
+A function call can appear either as an expression or as a statement.
+We use a new 'Funcall' binode type to link the function with a list of
+arguments, form with the 'List' nodes.
+
+We have already seen the "Term" which is how a function call can appear
+in an expression. To parse a function call into a statement we include
+it in the "SimpleStatement Grammar" which will be described later.
+
+###### Binode types
+ Funcall,
+
+###### term grammar
+ | Term ( ExpressionList ) ${ {
+ struct binode *b = new(binode);
+ b->op = Funcall;
+ b->left = $<T;
+ b->right = reorder_bilist($<EL);
+ $0 = b;
+ } }$
+ | Term ( ) ${ {
+ struct binode *b = new(binode);
+ b->op = Funcall;
+ b->left = $<T;
+ b->right = NULL;
+ $0 = b;
} }$
- $*exec
- Variable -> IDENTIFIER ${ {
- struct variable *v = var_ref(c, $1.txt);
- $0 = new_pos(var, $1);
- if (v == NULL) {
- /* This might be a label - allocate a var just in case */
- v = var_decl(c, $1.txt);
- if (v) {
- v->type = Tnone;
- v->where_decl = $0;
- v->where_set = $0;
- }
- }
- cast(var, $0)->var = v;
+###### SimpleStatement Grammar
+
+ | Term ( ExpressionList ) ${ {
+ struct binode *b = new(binode);
+ b->op = Funcall;
+ b->left = $<T;
+ b->right = reorder_bilist($<EL);
+ $0 = b;
} }$
- ## variable grammar
-###### print exec cases
- case Xvar:
- {
- struct var *v = cast(var, e);
- if (v->var) {
- struct binding *b = v->var->name;
- printf("%.*s", b->name.len, b->name.txt);
+###### print binode cases
+
+ case Funcall:
+ do_indent(indent, "");
+ print_exec(b->left, -1, bracket);
+ printf("(");
+ for (b = cast(binode, b->right); b; b = cast(binode, b->right)) {
+ if (b->left) {
+ printf(" ");
+ print_exec(b->left, -1, bracket);
+ if (b->right)
+ printf(",");
+ }
}
+ printf(")");
+ if (indent >= 0)
+ printf("\n");
break;
- }
-###### format cases
- case 'v':
- if (loc && loc->type == Xvar) {
- struct var *v = cast(var, loc);
- if (v->var) {
- struct binding *b = v->var->name;
- fprintf(stderr, "%.*s", b->name.len, b->name.txt);
- } else
- fputs("???", stderr); // NOTEST
- } else
- fputs("NOTVAR", stderr); // NOTEST
- break;
+###### propagate binode cases
-###### propagate exec cases
+ case Funcall: {
+ /* Every arg must match formal parameter, and result
+ * is return type of function
+ */
+ struct binode *args = cast(binode, b->right);
+ struct var *v = cast(var, b->left);
- case Xvar:
- {
- struct var *var = cast(var, prog);
- struct variable *v = var->var;
- if (!v) {
- type_err(c, "%d:BUG: no variable!!", prog, NULL, 0, NULL); // NOTEST
- return Tnone; // NOTEST
- }
- if (v->merged)
- v = v->merged;
- if (v->constant && (rules & Rnoconstant)) {
- type_err(c, "error: Cannot assign to a constant: %v",
- prog, NULL, 0, NULL);
- type_err(c, "info: name was defined as a constant here",
- v->where_decl, NULL, 0, NULL);
- return v->type;
- }
- if (v->type == Tnone && v->where_decl == prog)
- type_err(c, "error: variable used but not declared: %v",
- prog, NULL, 0, NULL);
- if (v->type == NULL) {
- if (type && *ok != 0) {
- v->type = type;
- v->where_set = prog;
- *ok = 2;
- }
- return type;
- }
- if (!type_compat(type, v->type, rules)) {
- type_err(c, "error: expected %1%r but variable '%v' is %2", prog,
- type, rules, v->type);
- type_err(c, "info: this is where '%v' was set to %1", v->where_set,
- v->type, rules, NULL);
+ if (!v->var->type || v->var->type->check_args == NULL) {
+ type_err(c, "error: attempt to call a non-function.",
+ prog, NULL, 0, NULL);
+ return NULL;
}
- if (!type)
- return v->type;
- return type;
+ *perr |= Enoconst;
+ v->var->type->check_args(c, perr, v->var->type, args);
+ if (v->var->type->function.inline_result)
+ *perr |= Emaycopy;
+ return v->var->type->function.return_type;
}
-###### interp exec cases
- case Xvar:
- {
- struct var *var = cast(var, e);
- struct variable *v = var->var;
+###### interp binode cases
- if (v->merged)
- v = v->merged;
- lrv = var_value(c, v);
- rvtype = v->type;
+ case Funcall: {
+ struct var *v = cast(var, b->left);
+ struct type *t = v->var->type;
+ void *oldlocal = c->local;
+ int old_size = c->local_size;
+ void *local = calloc(1, t->function.local_size);
+ struct value *fbody = var_value(c, v->var);
+ struct binode *arg = cast(binode, b->right);
+ struct binode *param = t->function.params;
+
+ while (param) {
+ struct var *pv = cast(var, param->left);
+ struct type *vtype = NULL;
+ struct value val = interp_exec(c, arg->left, &vtype);
+ struct value *lval;
+ c->local = local; c->local_size = t->function.local_size;
+ lval = var_value(c, pv->var);
+ c->local = oldlocal; c->local_size = old_size;
+ memcpy(lval, &val, vtype->size);
+ param = cast(binode, param->right);
+ arg = cast(binode, arg->right);
+ }
+ c->local = local; c->local_size = t->function.local_size;
+ if (t->function.inline_result && dtype) {
+ _interp_exec(c, fbody->function, NULL, NULL);
+ memcpy(dest, local, dtype->size);
+ rvtype = ret.type = NULL;
+ } else
+ rv = interp_exec(c, fbody->function, &rvtype);
+ c->local = oldlocal; c->local_size = old_size;
+ free(local);
break;
}
-###### ast functions
+## Complex executables: statements and expressions
- static void free_var(struct var *v)
- {
- free(v);
- }
+Now that we have types and values and variables and most of the basic
+Terms which provide access to these, we can explore the more complex
+code that combine all of these to get useful work done. Specifically
+statements and expressions.
-###### free exec cases
- case Xvar: free_var(cast(var, e)); break;
+Expressions are various combinations of Terms. We will use operator
+precedence to ensure correct parsing. The simplest Expression is just a
+Term - others will follow.
+
+###### Grammar
+
+ $*exec
+ Expression -> Term ${ $0 = $<Term; }$
+ ## expression grammar
### Expressions: Conditional
###### Binode types
CondExpr,
-###### Grammar
+###### declare terminals
$LEFT if $$ifelse
- ## expr precedence
- $*exec
- Expression -> Expression if Expression else Expression $$ifelse ${ {
- struct binode *b1 = new(binode);
- struct binode *b2 = new(binode);
- b1->op = CondExpr;
- b1->left = $<3;
- b1->right = b2;
- b2->op = CondExpr;
- b2->left = $<1;
- b2->right = $<5;
- $0 = b1;
- } }$
- ## expression grammar
+###### expression grammar
+
+ | Expression if Expression else Expression $$ifelse ${ {
+ struct binode *b1 = new(binode);
+ struct binode *b2 = new(binode);
+ b1->op = CondExpr;
+ b1->left = $<3;
+ b1->right = b2;
+ b2->op = CondExpr;
+ b2->left = $<1;
+ b2->right = $<5;
+ $0 = b1;
+ } }$
###### print binode cases
struct binode *b2 = cast(binode, b->right);
struct type *t2;
- propagate_types(b->left, c, ok, Tbool, 0);
- t = propagate_types(b2->left, c, ok, type, Rnolabel);
- t2 = propagate_types(b2->right, c, ok, type ?: t, Rnolabel);
+ propagate_types(b->left, c, perr, Tbool, 0);
+ t = propagate_types(b2->left, c, perr, type, Rnolabel);
+ t2 = propagate_types(b2->right, c, perr, type ?: t, Rnolabel);
return t ?: t2;
}
struct binode *b2 = cast(binode, b->right);
left = interp_exec(c, b->left, <ype);
if (left.bool)
- rv = interp_exec(c, b2->left, &rvtype);
+ rv = interp_exec(c, b2->left, &rvtype); // UNTESTED
else
rv = interp_exec(c, b2->right, &rvtype);
}
break;
+### Expression list
+
+We take a brief detour, now that we have expressions, to describe lists
+of expressions. These will be needed for function parameters and
+possibly other situations. They seem generic enough to introduce here
+to be used elsewhere.
+
+And ExpressionList will use the `List` type of `binode`, building up at
+the end. And place where they are used will probably call
+`reorder_bilist()` to get a more normal first/next arrangement.
+
+###### declare terminals
+ $TERM ,
+
+`List` execs have no implicit semantics, so they are never propagated or
+interpreted. The can be printed as a comma separate list, which is how
+they are parsed. Note they are also used for function formal parameter
+lists. In that case a separate function is used to print them.
+
+###### print binode cases
+ case List:
+ while (b) {
+ printf(" ");
+ print_exec(b->left, -1, bracket);
+ if (b->right)
+ printf(",");
+ b = cast(binode, b->right);
+ }
+ break;
+
+###### propagate binode cases
+ case List: abort(); // NOTEST
+###### interp binode cases
+ case List: abort(); // NOTEST
+
+###### Grammar
+
+ $*binode
+ ExpressionList -> ExpressionList , Expression ${
+ $0 = new(binode);
+ $0->op = List;
+ $0->left = $<1;
+ $0->right = $<3;
+ }$
+ | Expression ${
+ $0 = new(binode);
+ $0->op = List;
+ $0->left = NULL;
+ $0->right = $<1;
+ }$
+
### Expressions: Boolean
The next class of expressions to use the `binode` will be Boolean
OrElse,
Not,
-###### expr precedence
+###### declare terminals
$LEFT or
$LEFT and
$LEFT not
###### expression grammar
- | Expression or Expression ${ {
- struct binode *b = new(binode);
- b->op = Or;
- b->left = $<1;
- b->right = $<3;
- $0 = b;
- } }$
- | Expression or else Expression ${ {
- struct binode *b = new(binode);
- b->op = OrElse;
- b->left = $<1;
- b->right = $<4;
- $0 = b;
- } }$
+ | Expression or Expression ${ {
+ struct binode *b = new(binode);
+ b->op = Or;
+ b->left = $<1;
+ b->right = $<3;
+ $0 = b;
+ } }$
+ | Expression or else Expression ${ {
+ struct binode *b = new(binode);
+ b->op = OrElse;
+ b->left = $<1;
+ b->right = $<4;
+ $0 = b;
+ } }$
- | Expression and Expression ${ {
- struct binode *b = new(binode);
- b->op = And;
- b->left = $<1;
- b->right = $<3;
- $0 = b;
- } }$
- | Expression and then Expression ${ {
- struct binode *b = new(binode);
- b->op = AndThen;
- b->left = $<1;
- b->right = $<4;
- $0 = b;
- } }$
+ | Expression and Expression ${ {
+ struct binode *b = new(binode);
+ b->op = And;
+ b->left = $<1;
+ b->right = $<3;
+ $0 = b;
+ } }$
+ | Expression and then Expression ${ {
+ struct binode *b = new(binode);
+ b->op = AndThen;
+ b->left = $<1;
+ b->right = $<4;
+ $0 = b;
+ } }$
- | not Expression ${ {
- struct binode *b = new(binode);
- b->op = Not;
- b->right = $<2;
- $0 = b;
- } }$
+ | not Expression ${ {
+ struct binode *b = new(binode);
+ b->op = Not;
+ b->right = $<2;
+ $0 = b;
+ } }$
###### print binode cases
case And:
case OrElse:
case Not:
/* both must be Tbool, result is Tbool */
- propagate_types(b->left, c, ok, Tbool, 0);
- propagate_types(b->right, c, ok, Tbool, 0);
+ propagate_types(b->left, c, perr, Tbool, 0);
+ propagate_types(b->right, c, perr, Tbool, 0);
if (type && type != Tbool)
type_err(c, "error: %1 operation found where %2 expected", prog,
Tbool, 0, type);
Eql,
NEql,
-###### expr precedence
+###### declare terminals
$LEFT < > <= >= == != CMPop
###### expression grammar
###### Grammar
$eop
- CMPop -> < ${ $0.op = Less; }$
- | > ${ $0.op = Gtr; }$
- | <= ${ $0.op = LessEq; }$
- | >= ${ $0.op = GtrEq; }$
- | == ${ $0.op = Eql; }$
- | != ${ $0.op = NEql; }$
+ CMPop -> < ${ $0.op = Less; }$
+ | > ${ $0.op = Gtr; }$
+ | <= ${ $0.op = LessEq; }$
+ | >= ${ $0.op = GtrEq; }$
+ | == ${ $0.op = Eql; }$
+ | != ${ $0.op = NEql; }$
###### print binode cases
case Eql:
case NEql:
/* Both must match but not be labels, result is Tbool */
- t = propagate_types(b->left, c, ok, NULL, Rnolabel);
+ t = propagate_types(b->left, c, perr, NULL, Rnolabel);
if (t)
- propagate_types(b->right, c, ok, t, 0);
+ propagate_types(b->right, c, perr, t, 0);
else {
- t = propagate_types(b->right, c, ok, NULL, Rnolabel);
- if (t)
- t = propagate_types(b->left, c, ok, t, 0);
+ t = propagate_types(b->right, c, perr, NULL, Rnolabel); // UNTESTED
+ if (t) // UNTESTED
+ t = propagate_types(b->left, c, perr, t, 0); // UNTESTED
}
if (!type_compat(type, Tbool, 0))
type_err(c, "error: Comparison returns %1 but %2 expected", prog,
break;
}
-### Expressions: The rest
+### Expressions: Arithmetic etc.
The remaining expressions with the highest precedence are arithmetic,
string concatenation, and string conversion. String concatenation
We also have a 'Bracket' operator which records where parentheses were
found. This makes it easy to reproduce these when printing. Possibly I
-should only insert brackets were needed for precedence.
+should only insert brackets were needed for precedence. Putting
+parentheses around an expression converts it into a Term,
###### Binode types
Plus, Minus,
StringConv,
Bracket,
-###### expr precedence
+###### declare terminals
$LEFT + - Eop
$LEFT * / % ++ Top
$LEFT Uop $
$TERM ( )
###### expression grammar
- | Expression Eop Expression ${ {
- struct binode *b = new(binode);
- b->op = $2.op;
- b->left = $<1;
- b->right = $<3;
- $0 = b;
- } }$
+ | Expression Eop Expression ${ {
+ struct binode *b = new(binode);
+ b->op = $2.op;
+ b->left = $<1;
+ b->right = $<3;
+ $0 = b;
+ } }$
- | Expression Top Expression ${ {
- struct binode *b = new(binode);
- b->op = $2.op;
- b->left = $<1;
- b->right = $<3;
- $0 = b;
- } }$
-
- | ( Expression ) ${ {
- struct binode *b = new_pos(binode, $1);
- b->op = Bracket;
- b->right = $<2;
- $0 = b;
- } }$
- | Uop Expression ${ {
- struct binode *b = new(binode);
- b->op = $1.op;
- b->right = $<2;
- $0 = b;
- } }$
- | Value ${ $0 = $<1; }$
- | Variable ${ $0 = $<1; }$
+ | Expression Top Expression ${ {
+ struct binode *b = new(binode);
+ b->op = $2.op;
+ b->left = $<1;
+ b->right = $<3;
+ $0 = b;
+ } }$
+
+ | Uop Expression ${ {
+ struct binode *b = new(binode);
+ b->op = $1.op;
+ b->right = $<2;
+ $0 = b;
+ } }$
+
+###### term grammar
+
+ | ( Expression ) ${ {
+ struct binode *b = new_pos(binode, $1);
+ b->op = Bracket;
+ b->right = $<2;
+ $0 = b;
+ } }$
+
+###### Grammar
$eop
- Eop -> + ${ $0.op = Plus; }$
- | - ${ $0.op = Minus; }$
+ Eop -> + ${ $0.op = Plus; }$
+ | - ${ $0.op = Minus; }$
- Uop -> + ${ $0.op = Absolute; }$
- | - ${ $0.op = Negate; }$
- | $ ${ $0.op = StringConv; }$
+ Uop -> + ${ $0.op = Absolute; }$
+ | - ${ $0.op = Negate; }$
+ | $ ${ $0.op = StringConv; }$
- Top -> * ${ $0.op = Times; }$
- | / ${ $0.op = Divide; }$
- | % ${ $0.op = Rem; }$
- | ++ ${ $0.op = Concat; }$
+ Top -> * ${ $0.op = Times; }$
+ | / ${ $0.op = Divide; }$
+ | % ${ $0.op = Rem; }$
+ | ++ ${ $0.op = Concat; }$
###### print binode cases
case Plus:
case Negate:
/* as propagate_types ignores a NULL,
* unary ops fit here too */
- propagate_types(b->left, c, ok, Tnum, 0);
- propagate_types(b->right, c, ok, Tnum, 0);
+ propagate_types(b->left, c, perr, Tnum, 0);
+ propagate_types(b->right, c, perr, Tnum, 0);
if (!type_compat(type, Tnum, 0))
type_err(c, "error: Arithmetic returns %1 but %2 expected", prog,
Tnum, rules, type);
case Concat:
/* both must be Tstr, result is Tstr */
- propagate_types(b->left, c, ok, Tstr, 0);
- propagate_types(b->right, c, ok, Tstr, 0);
+ propagate_types(b->left, c, perr, Tstr, 0);
+ propagate_types(b->right, c, perr, Tstr, 0);
if (!type_compat(type, Tstr, 0))
type_err(c, "error: Concat returns %1 but %2 expected", prog,
Tstr, rules, type);
case StringConv:
/* op must be string, result is number */
- propagate_types(b->left, c, ok, Tstr, 0);
+ propagate_types(b->left, c, perr, Tstr, 0);
if (!type_compat(type, Tnum, 0))
- type_err(c,
+ type_err(c, // UNTESTED
"error: Can only convert string to number, not %1",
prog, type, 0, NULL);
return Tnum;
case Bracket:
- return propagate_types(b->right, c, ok, type, 0);
+ return propagate_types(b->right, c, perr, type, 0);
###### interp binode cases
char tail[3];
int neg = 0;
if (tx.txt[0] == '-') {
- neg = 1;
- tx.txt++;
- tx.len--;
+ neg = 1; // UNTESTED
+ tx.txt++; // UNTESTED
+ tx.len--; // UNTESTED
}
if (number_parse(rv.num, tail, tx) == 0)
- mpq_init(rv.num);
+ mpq_init(rv.num); // UNTESTED
else if (neg)
- mpq_neg(rv.num, rv.num);
+ mpq_neg(rv.num, rv.num); // UNTESTED
if (tail[0])
- printf("Unsupported suffix: %.*s\n", tx.len, tx.txt);
+ printf("Unsupported suffix: %.*s\n", tx.len, tx.txt); // UNTESTED
break;
list. Other stand-alone statements will follow once the infrastructure
is in-place.
+As many statements will use binodes, we declare a binode pointer 'b' in
+the common header for all reductions to use.
+
+###### Parser: reduce
+ struct binode *b;
+
###### Binode types
Block,
$*binode
Block -> { IN OptNL Statementlist OUT OptNL } ${ $0 = $<Sl; }$
- | { SimpleStatements } ${ $0 = reorder_bilist($<SS); }$
- | SimpleStatements ; ${ $0 = reorder_bilist($<SS); }$
- | SimpleStatements EOL ${ $0 = reorder_bilist($<SS); }$
- | IN OptNL Statementlist OUT ${ $0 = $<Sl; }$
+ | { SimpleStatements } ${ $0 = reorder_bilist($<SS); }$
+ | SimpleStatements ; ${ $0 = reorder_bilist($<SS); }$
+ | SimpleStatements EOL ${ $0 = reorder_bilist($<SS); }$
+ | IN OptNL Statementlist OUT ${ $0 = $<Sl; }$
OpenBlock -> OpenScope { IN OptNL Statementlist OUT OptNL } ${ $0 = $<Sl; }$
- | OpenScope { SimpleStatements } ${ $0 = reorder_bilist($<SS); }$
- | OpenScope SimpleStatements ; ${ $0 = reorder_bilist($<SS); }$
- | OpenScope SimpleStatements EOL ${ $0 = reorder_bilist($<SS); }$
- | IN OpenScope OptNL Statementlist OUT ${ $0 = $<Sl; }$
+ | OpenScope { SimpleStatements } ${ $0 = reorder_bilist($<SS); }$
+ | OpenScope SimpleStatements ; ${ $0 = reorder_bilist($<SS); }$
+ | OpenScope SimpleStatements EOL ${ $0 = reorder_bilist($<SS); }$
+ | IN OpenScope OptNL Statementlist OUT ${ $0 = $<Sl; }$
UseBlock -> { OpenScope IN OptNL Statementlist OUT OptNL } ${ $0 = $<Sl; }$
- | { OpenScope SimpleStatements } ${ $0 = reorder_bilist($<SS); }$
- | IN OpenScope OptNL Statementlist OUT ${ $0 = $<Sl; }$
+ | { OpenScope SimpleStatements } ${ $0 = reorder_bilist($<SS); }$
+ | IN OpenScope OptNL Statementlist OUT ${ $0 = $<Sl; }$
ColonBlock -> { IN OptNL Statementlist OUT OptNL } ${ $0 = $<Sl; }$
- | { SimpleStatements } ${ $0 = reorder_bilist($<SS); }$
- | : SimpleStatements ; ${ $0 = reorder_bilist($<SS); }$
- | : SimpleStatements EOL ${ $0 = reorder_bilist($<SS); }$
- | : IN OptNL Statementlist OUT ${ $0 = $<Sl; }$
+ | { SimpleStatements } ${ $0 = reorder_bilist($<SS); }$
+ | : SimpleStatements ; ${ $0 = reorder_bilist($<SS); }$
+ | : SimpleStatements EOL ${ $0 = reorder_bilist($<SS); }$
+ | : IN OptNL Statementlist OUT ${ $0 = $<Sl; }$
Statementlist -> ComplexStatements ${ $0 = reorder_bilist($<CS); }$
ComplexStatements -> ComplexStatements ComplexStatement ${
- if ($2 == NULL) {
- $0 = $<1;
- } else {
- $0 = new(binode);
- $0->op = Block;
- $0->left = $<1;
- $0->right = $<2;
- }
- }$
- | ComplexStatement ${
- if ($1 == NULL) {
- $0 = NULL;
- } else {
- $0 = new(binode);
- $0->op = Block;
- $0->left = NULL;
- $0->right = $<1;
- }
- }$
-
- $*exec
- ComplexStatement -> SimpleStatements Newlines ${
- $0 = reorder_bilist($<SS);
- }$
- | SimpleStatements ; Newlines ${
- $0 = reorder_bilist($<SS);
- }$
- ## ComplexStatement Grammar
-
- $*binode
- SimpleStatements -> SimpleStatements ; SimpleStatement ${
+ if ($2 == NULL) {
+ $0 = $<1;
+ } else {
$0 = new(binode);
$0->op = Block;
$0->left = $<1;
- $0->right = $<3;
- }$
- | SimpleStatement ${
+ $0->right = $<2;
+ }
+ }$
+ | ComplexStatement ${
+ if ($1 == NULL) {
+ $0 = NULL;
+ } else {
$0 = new(binode);
$0->op = Block;
$0->left = NULL;
$0->right = $<1;
- }$
+ }
+ }$
+
+ $*exec
+ ComplexStatement -> SimpleStatements Newlines ${
+ $0 = reorder_bilist($<SS);
+ }$
+ | SimpleStatements ; Newlines ${
+ $0 = reorder_bilist($<SS);
+ }$
+ ## ComplexStatement Grammar
+
+ $*binode
+ SimpleStatements -> SimpleStatements ; SimpleStatement ${
+ $0 = new(binode);
+ $0->op = Block;
+ $0->left = $<1;
+ $0->right = $<3;
+ }$
+ | SimpleStatement ${
+ $0 = new(binode);
+ $0->op = Block;
+ $0->left = NULL;
+ $0->right = $<1;
+ }$
$TERM pass
+ $*exec
SimpleStatement -> pass ${ $0 = NULL; }$
- | ERROR ${ tok_err(c, "Syntax error in statement", &$1); }$
- ## SimpleStatement Grammar
+ | ERROR ${ tok_err(c, "Syntax error in statement", &$1); }$
+ ## SimpleStatement Grammar
###### print binode cases
case Block:
if (indent < 0) {
// simple statement
- if (b->left == NULL)
- printf("pass");
+ if (b->left == NULL) // UNTESTED
+ printf("pass"); // UNTESTED
else
- print_exec(b->left, indent, bracket);
- if (b->right) {
- printf("; ");
- print_exec(b->right, indent, bracket);
+ print_exec(b->left, indent, bracket); // UNTESTED
+ if (b->right) { // UNTESTED
+ printf("; "); // UNTESTED
+ print_exec(b->right, indent, bracket); // UNTESTED
}
} else {
// block, one per line
struct binode *e;
for (e = b; e; e = cast(binode, e->right)) {
- t = propagate_types(e->left, c, ok, NULL, rules);
- if ((rules & Rboolok) && t == Tbool)
+ t = propagate_types(e->left, c, perr, NULL, rules);
+ if ((rules & Rboolok) && (t == Tbool || t == Tnone))
+ t = NULL;
+ if (t == Tnone && e->right)
+ /* Only the final statement *must* return a value
+ * when not Rboolok
+ */
t = NULL;
- if (t && t != Tnone && t != Tbool) {
+ if (t) {
if (!type)
type = t;
else if (t != type)
expressions and prints the values separated by spaces and terminated
by a newline. No control of formatting is possible.
-`print` faces the same list-ordering issue as blocks, and uses the
-same solution.
+`print` uses `ExpressionList` to collect the expressions and stores them
+on the left side of a `Print` binode unlessthere is a trailing comma
+when the list is stored on the `right` side and no trailing newline is
+printed.
###### Binode types
Print,
-##### expr precedence
- $TERM print ,
+##### declare terminals
+ $TERM print
###### SimpleStatement Grammar
| print ExpressionList ${
- $0 = reorder_bilist($<2);
- }$
- | print ExpressionList , ${
- $0 = new(binode);
- $0->op = Print;
- $0->right = NULL;
- $0->left = $<2;
- $0 = reorder_bilist($0);
+ $0 = b = new(binode);
+ b->op = Print;
+ b->right = NULL;
+ b->left = reorder_bilist($<EL);
}$
+ | print ExpressionList , ${ {
+ $0 = b = new(binode);
+ b->op = Print;
+ b->right = reorder_bilist($<EL);
+ b->left = NULL;
+ } }$
| print ${
- $0 = new(binode);
- $0->op = Print;
- $0->right = NULL;
+ $0 = b = new(binode);
+ b->op = Print;
+ b->left = NULL;
+ b->right = NULL;
}$
-###### Grammar
-
- $*binode
- ExpressionList -> ExpressionList , Expression ${
- $0 = new(binode);
- $0->op = Print;
- $0->left = $<1;
- $0->right = $<3;
- }$
- | Expression ${
- $0 = new(binode);
- $0->op = Print;
- $0->left = NULL;
- $0->right = $<1;
- }$
-
###### print binode cases
case Print:
do_indent(indent, "print");
- while (b) {
- if (b->left) {
- printf(" ");
- print_exec(b->left, -1, bracket);
- if (b->right)
- printf(",");
- }
- b = cast(binode, b->right);
- }
+ if (b->right) {
+ print_exec(b->right, -1, bracket);
+ printf(",");
+ } else
+ print_exec(b->left, -1, bracket);
if (indent >= 0)
printf("\n");
break;
case Print:
/* don't care but all must be consistent */
- propagate_types(b->left, c, ok, NULL, Rnolabel);
- propagate_types(b->right, c, ok, NULL, Rnolabel);
+ if (b->left)
+ b = cast(binode, b->left);
+ else
+ b = cast(binode, b->right);
+ while (b) {
+ propagate_types(b->left, c, perr, NULL, Rnolabel);
+ b = cast(binode, b->right);
+ }
break;
###### interp binode cases
case Print:
{
- char sep = 0;
- int eol = 1;
- for ( ; b; b = cast(binode, b->right))
- if (b->left) {
- if (sep)
- putchar(sep);
- left = interp_exec(c, b->left, <ype);
- print_value(ltype, &left);
- free_value(ltype, &left);
- if (b->right)
- sep = ' ';
- } else if (sep)
- eol = 0;
- ltype = Tnone;
- if (eol)
+ struct binode *b2 = cast(binode, b->left);
+ if (!b2)
+ b2 = cast(binode, b->right);
+ for (; b2; b2 = cast(binode, b2->right)) {
+ left = interp_exec(c, b2->left, <ype);
+ print_value(ltype, &left, stdout);
+ free_value(ltype, &left);
+ if (b2->right)
+ putchar(' ');
+ }
+ if (b->right == NULL)
printf("\n");
+ ltype = Tnone;
break;
}
$TERM =
###### SimpleStatement Grammar
- | Variable = Expression ${
- $0 = new(binode);
- $0->op = Assign;
- $0->left = $<1;
- $0->right = $<3;
- }$
+ | Term = Expression ${
+ $0 = b= new(binode);
+ b->op = Assign;
+ b->left = $<1;
+ b->right = $<3;
+ }$
| VariableDecl = Expression ${
- $0 = new(binode);
- $0->op = Declare;
- $0->left = $<1;
- $0->right =$<3;
- }$
+ $0 = b= new(binode);
+ b->op = Declare;
+ b->left = $<1;
+ b->right =$<3;
+ }$
| VariableDecl ${
- if ($1->var->where_set == NULL) {
- type_err(c,
- "Variable declared with no type or value: %v",
- $1, NULL, 0, NULL);
- } else {
- $0 = new(binode);
- $0->op = Declare;
- $0->left = $<1;
- $0->right = NULL;
- }
- }$
+ if ($1->var->where_set == NULL) {
+ type_err(c,
+ "Variable declared with no type or value: %v",
+ $1, NULL, 0, NULL);
+ free_var($1);
+ } else {
+ $0 = b = new(binode);
+ b->op = Declare;
+ b->left = $<1;
+ b->right = NULL;
+ }
+ }$
###### print binode cases
do_indent(indent, "");
print_exec(b->left, indent, bracket);
if (cast(var, b->left)->var->constant) {
- if (v->where_decl == v->where_set) {
- printf("::");
+ printf("::");
+ if (v->explicit_type) {
type_print(v->type, stdout);
printf(" ");
- } else
- printf(" ::");
+ }
} else {
- if (v->where_decl == v->where_set) {
- printf(":");
+ printf(":");
+ if (v->explicit_type) {
type_print(v->type, stdout);
printf(" ");
- } else
- printf(" :");
+ }
}
if (b->right) {
printf("= ");
* For Assign, left must not be constant.
* result is Tnone
*/
- t = propagate_types(b->left, c, ok, NULL,
+ t = propagate_types(b->left, c, perr, NULL,
Rnolabel | (b->op == Assign ? Rnoconstant : 0));
if (!b->right)
return Tnone;
if (t) {
- if (propagate_types(b->right, c, ok, t, 0) != t)
+ if (propagate_types(b->right, c, perr, t, 0) != t)
if (b->left->type == Xvar)
type_err(c, "info: variable '%v' was set as %1 here.",
cast(var, b->left)->var->where_set, t, rules, NULL);
} else {
- t = propagate_types(b->right, c, ok, NULL, Rnolabel);
+ t = propagate_types(b->right, c, perr, NULL, Rnolabel);
if (t)
- propagate_types(b->left, c, ok, t,
+ propagate_types(b->left, c, perr, t,
(b->op == Assign ? Rnoconstant : 0));
}
- if (t && t->dup == NULL)
+ if (t && t->dup == NULL && !(*perr & Emaycopy))
type_err(c, "error: cannot assign value of type %1", b, t, 0, NULL);
return Tnone;
case Assign:
lleft = linterp_exec(c, b->left, <ype);
- right = interp_exec(c, b->right, &rtype);
- if (lleft) {
- free_value(ltype, lleft);
- dup_value(ltype, &right, lleft);
- ltype = NULL;
- }
+ if (lleft)
+ dinterp_exec(c, b->right, lleft, ltype, 1);
+ ltype = Tnone;
break;
case Declare:
{
struct variable *v = cast(var, b->left)->var;
struct value *val;
- if (v->merged)
- v = v->merged;
+ v = v->merged;
val = var_value(c, v);
- free_value(v->type, val);
if (v->type->prepare_type)
v->type->prepare_type(c, v->type, 0);
- if (b->right) {
- right = interp_exec(c, b->right, &rtype);
- memcpy(val, &right, rtype->size);
- rtype = Tnone;
- } else {
+ if (b->right)
+ dinterp_exec(c, b->right, val, v->type, 0);
+ else
val_init(v->type, val);
- }
break;
}
### The `use` statement
-The `use` statement is the last "simple" statement. It is needed when
-the condition in a conditional statement is a block. `use` works much
-like `return` in C, but only completes the `condition`, not the whole
-function.
+The `use` statement is the last "simple" statement. It is needed when a
+statement block can return a value. This includes the body of a
+function which has a return type, and the "condition" code blocks in
+`if`, `while`, and `switch` statements.
###### Binode types
Use,
-###### expr precedence
- $TERM use
+###### declare terminals
+ $TERM use
###### SimpleStatement Grammar
| use Expression ${
- $0 = new_pos(binode, $1);
- $0->op = Use;
- $0->right = $<2;
- if ($0->right->type == Xvar) {
- struct var *v = cast(var, $0->right);
+ $0 = b = new_pos(binode, $1);
+ b->op = Use;
+ b->right = $<2;
+ if (b->right->type == Xvar) {
+ struct var *v = cast(var, b->right);
if (v->var->type == Tnone) {
/* Convert this to a label */
struct value *val;
case Use:
/* result matches value */
- return propagate_types(b->right, c, ok, type, 0);
+ return propagate_types(b->right, c, perr, type, 0);
###### interp binode cases
`Rboolok` flag which is passed to `propagate_types()`.
The `cond_statement` cannot fit into a `binode` so a new `exec` is
-defined.
+defined. As there are two scopes which cover multiple parts - one for
+the whole statement and one for "while" and "do" - and as we will use
+the 'struct exec' to track scopes, we actually need two new types of
+exec. One is a `binode` for the looping part, the rest is the
+`cond_statement`. The `cond_statement` will use an auxilliary `struct
+casepart` to track a list of case parts.
+
+###### Binode types
+ Loop
###### exec type
Xcond_statement,
};
struct cond_statement {
struct exec;
- struct exec *forpart, *condpart, *dopart, *thenpart, *elsepart;
+ struct exec *forpart, *condpart, *thenpart, *elsepart;
+ struct binode *looppart;
struct casepart *casepart;
};
return;
free_exec(s->forpart);
free_exec(s->condpart);
- free_exec(s->dopart);
+ free_exec(s->looppart);
free_exec(s->thenpart);
free_exec(s->elsepart);
free_casepart(s->casepart);
###### ComplexStatement Grammar
| CondStatement ${ $0 = $<1; }$
-###### expr precedence
+###### declare terminals
$TERM for then while do
$TERM else
$TERM switch case
// may or may not end with EOL
// WhilePart and IfPart include an appropriate Suffix
- // Both ForPart and Whilepart open scopes, and CondSuffix only
- // closes one - so in the first branch here we have another to close.
+ // ForPart, SwitchPart, and IfPart open scopes, o we have to close
+ // them. WhilePart opens and closes its own scope.
CondStatement -> ForPart OptNL ThenPart OptNL WhilePart CondSuffix ${
- $0 = $<CS;
- $0->forpart = $<FP;
- $0->thenpart = $<TP;
- $0->condpart = $WP.condpart; $WP.condpart = NULL;
- $0->dopart = $WP.dopart; $WP.dopart = NULL;
- var_block_close(c, CloseSequential);
- }$
- | ForPart OptNL WhilePart CondSuffix ${
- $0 = $<CS;
- $0->forpart = $<FP;
- $0->condpart = $WP.condpart; $WP.condpart = NULL;
- $0->dopart = $WP.dopart; $WP.dopart = NULL;
- var_block_close(c, CloseSequential);
- }$
- | WhilePart CondSuffix ${
- $0 = $<CS;
- $0->condpart = $WP.condpart; $WP.condpart = NULL;
- $0->dopart = $WP.dopart; $WP.dopart = NULL;
- }$
- | SwitchPart OptNL CasePart CondSuffix ${
- $0 = $<CS;
- $0->condpart = $<SP;
- $CP->next = $0->casepart;
- $0->casepart = $<CP;
- }$
- | SwitchPart : IN OptNL CasePart CondSuffix OUT Newlines ${
- $0 = $<CS;
- $0->condpart = $<SP;
- $CP->next = $0->casepart;
- $0->casepart = $<CP;
- }$
- | IfPart IfSuffix ${
- $0 = $<IS;
- $0->condpart = $IP.condpart; $IP.condpart = NULL;
- $0->thenpart = $IP.thenpart; $IP.thenpart = NULL;
- // This is where we close an "if" statement
- var_block_close(c, CloseSequential);
- }$
+ $0 = $<CS;
+ $0->forpart = $<FP;
+ $0->thenpart = $<TP;
+ $0->looppart = $<WP;
+ var_block_close(c, CloseSequential, $0);
+ }$
+ | ForPart OptNL WhilePart CondSuffix ${
+ $0 = $<CS;
+ $0->forpart = $<FP;
+ $0->looppart = $<WP;
+ var_block_close(c, CloseSequential, $0);
+ }$
+ | WhilePart CondSuffix ${
+ $0 = $<CS;
+ $0->looppart = $<WP;
+ }$
+ | SwitchPart OptNL CasePart CondSuffix ${
+ $0 = $<CS;
+ $0->condpart = $<SP;
+ $CP->next = $0->casepart;
+ $0->casepart = $<CP;
+ var_block_close(c, CloseSequential, $0);
+ }$
+ | SwitchPart : IN OptNL CasePart CondSuffix OUT Newlines ${
+ $0 = $<CS;
+ $0->condpart = $<SP;
+ $CP->next = $0->casepart;
+ $0->casepart = $<CP;
+ var_block_close(c, CloseSequential, $0);
+ }$
+ | IfPart IfSuffix ${
+ $0 = $<IS;
+ $0->condpart = $IP.condpart; $IP.condpart = NULL;
+ $0->thenpart = $IP.thenpart; $IP.thenpart = NULL;
+ // This is where we close an "if" statement
+ var_block_close(c, CloseSequential, $0);
+ }$
CondSuffix -> IfSuffix ${
- $0 = $<1;
- // This is where we close scope of the whole
- // "for" or "while" statement
- var_block_close(c, CloseSequential);
- }$
- | Newlines CasePart CondSuffix ${
- $0 = $<CS;
- $CP->next = $0->casepart;
- $0->casepart = $<CP;
- }$
- | CasePart CondSuffix ${
- $0 = $<CS;
- $CP->next = $0->casepart;
- $0->casepart = $<CP;
- }$
+ $0 = $<1;
+ }$
+ | Newlines CasePart CondSuffix ${
+ $0 = $<CS;
+ $CP->next = $0->casepart;
+ $0->casepart = $<CP;
+ }$
+ | CasePart CondSuffix ${
+ $0 = $<CS;
+ $CP->next = $0->casepart;
+ $0->casepart = $<CP;
+ }$
IfSuffix -> Newlines ${ $0 = new(cond_statement); }$
- | Newlines ElsePart ${ $0 = $<EP; }$
- | ElsePart ${$0 = $<EP; }$
+ | Newlines ElsePart ${ $0 = $<EP; }$
+ | ElsePart ${$0 = $<EP; }$
ElsePart -> else OpenBlock Newlines ${
- $0 = new(cond_statement);
- $0->elsepart = $<OB;
- var_block_close(c, CloseElse);
- }$
- | else OpenScope CondStatement ${
- $0 = new(cond_statement);
- $0->elsepart = $<CS;
- var_block_close(c, CloseElse);
- }$
+ $0 = new(cond_statement);
+ $0->elsepart = $<OB;
+ var_block_close(c, CloseElse, $0->elsepart);
+ }$
+ | else OpenScope CondStatement ${
+ $0 = new(cond_statement);
+ $0->elsepart = $<CS;
+ var_block_close(c, CloseElse, $0->elsepart);
+ }$
$*casepart
CasePart -> case Expression OpenScope ColonBlock ${
- $0 = calloc(1,sizeof(struct casepart));
- $0->value = $<Ex;
- $0->action = $<Bl;
- var_block_close(c, CloseParallel);
- }$
+ $0 = calloc(1,sizeof(struct casepart));
+ $0->value = $<Ex;
+ $0->action = $<Bl;
+ var_block_close(c, CloseParallel, $0->action);
+ }$
$*exec
- // These scopes are closed in CondSuffix
+ // These scopes are closed in CondStatement
ForPart -> for OpenBlock ${
- $0 = $<Bl;
- }$
+ $0 = $<Bl;
+ }$
ThenPart -> then OpenBlock ${
- $0 = $<OB;
- var_block_close(c, CloseSequential);
- }$
+ $0 = $<OB;
+ var_block_close(c, CloseSequential, $0);
+ }$
+
+ $*binode
+ // This scope is closed in CondStatement
+ WhilePart -> while UseBlock OptNL do OpenBlock ${
+ $0 = new(binode);
+ $0->op = Loop;
+ $0->left = $<UB;
+ $0->right = $<OB;
+ var_block_close(c, CloseSequential, $0->right);
+ var_block_close(c, CloseSequential, $0);
+ }$
+ | while OpenScope Expression OpenScope ColonBlock ${
+ $0 = new(binode);
+ $0->op = Loop;
+ $0->left = $<Exp;
+ $0->right = $<CB;
+ var_block_close(c, CloseSequential, $0->right);
+ var_block_close(c, CloseSequential, $0);
+ }$
$cond_statement
- // This scope is closed in CondSuffix
- WhilePart -> while UseBlock OptNL do Block ${
- $0.condpart = $<UB;
- $0.dopart = $<Bl;
- }$
- | while OpenScope Expression ColonBlock ${
- $0.condpart = $<Exp;
- $0.dopart = $<Bl;
- }$
-
- IfPart -> if UseBlock OptNL then OpenBlock ClosePara ${
- $0.condpart = $<UB;
- $0.thenpart = $<Bl;
- }$
- | if OpenScope Expression OpenScope ColonBlock ClosePara ${
- $0.condpart = $<Ex;
- $0.thenpart = $<Bl;
- }$
- | if OpenScope Expression OpenScope OptNL then Block ClosePara ${
- $0.condpart = $<Ex;
- $0.thenpart = $<Bl;
- }$
+ IfPart -> if UseBlock OptNL then OpenBlock ${
+ $0.condpart = $<UB;
+ $0.thenpart = $<OB;
+ var_block_close(c, CloseParallel, $0.thenpart);
+ }$
+ | if OpenScope Expression OpenScope ColonBlock ${
+ $0.condpart = $<Ex;
+ $0.thenpart = $<CB;
+ var_block_close(c, CloseParallel, $0.thenpart);
+ }$
+ | if OpenScope Expression OpenScope OptNL then Block ${
+ $0.condpart = $<Ex;
+ $0.thenpart = $<Bl;
+ var_block_close(c, CloseParallel, $0.thenpart);
+ }$
$*exec
- // This scope is closed in CondSuffix
+ // This scope is closed in CondStatement
SwitchPart -> switch OpenScope Expression ${
- $0 = $<Ex;
- }$
- | switch UseBlock ${
- $0 = $<Bl;
- }$
+ $0 = $<Ex;
+ }$
+ | switch UseBlock ${
+ $0 = $<Bl;
+ }$
+
+###### print binode cases
+ case Loop:
+ if (b->left && b->left->type == Xbinode &&
+ cast(binode, b->left)->op == Block) {
+ if (bracket)
+ do_indent(indent, "while {\n");
+ else
+ do_indent(indent, "while\n");
+ print_exec(b->left, indent+1, bracket);
+ if (bracket)
+ do_indent(indent, "} do {\n");
+ else
+ do_indent(indent, "do\n");
+ print_exec(b->right, indent+1, bracket);
+ if (bracket)
+ do_indent(indent, "}\n");
+ } else {
+ do_indent(indent, "while ");
+ print_exec(b->left, 0, bracket);
+ if (bracket)
+ printf(" {\n");
+ else
+ printf(":\n");
+ print_exec(b->right, indent+1, bracket);
+ if (bracket)
+ do_indent(indent, "}\n");
+ }
+ break;
###### print exec cases
}
if (bracket) do_indent(indent, "}\n");
}
- if (cs->dopart) {
- // a loop
- if (cs->condpart && cs->condpart->type == Xbinode &&
- cast(binode, cs->condpart)->op == Block) {
- if (bracket)
- do_indent(indent, "while {\n");
- else
- do_indent(indent, "while\n");
- print_exec(cs->condpart, indent+1, bracket);
- if (bracket)
- do_indent(indent, "} do {\n");
- else
- do_indent(indent, "do\n");
- print_exec(cs->dopart, indent+1, bracket);
- if (bracket)
- do_indent(indent, "}\n");
- } else {
- do_indent(indent, "while ");
- print_exec(cs->condpart, 0, bracket);
- if (bracket)
- printf(" {\n");
- else
- printf(":\n");
- print_exec(cs->dopart, indent+1, bracket);
- if (bracket)
- do_indent(indent, "}\n");
- }
+ if (cs->looppart) {
+ print_exec(cs->looppart, indent, bracket);
} else {
// a condition
if (cs->casepart)
if (bracket)
printf(" {\n");
else
- printf(":\n");
+ printf("\n");
print_exec(cs->condpart, indent+1, bracket);
if (bracket)
do_indent(indent, "}\n");
if (cs->thenpart) {
- do_indent(indent, "then:\n");
+ do_indent(indent, "then\n");
print_exec(cs->thenpart, indent+1, bracket);
}
} else {
break;
}
+###### propagate binode cases
+ case Loop:
+ t = propagate_types(b->right, c, perr, Tnone, 0);
+ if (!type_compat(Tnone, t, 0))
+ *perr |= Efail; // UNTESTED
+ return propagate_types(b->left, c, perr, type, rules);
+
###### propagate exec cases
case Xcond_statement:
{
- // forpart and dopart must return Tnone
- // thenpart must return Tnone if there is a dopart,
+ // forpart and looppart->right must return Tnone
+ // thenpart must return Tnone if there is a loopart,
// otherwise it is like elsepart.
// condpart must:
// be bool if there is no casepart
struct cond_statement *cs = cast(cond_statement, prog);
struct casepart *cp;
- t = propagate_types(cs->forpart, c, ok, Tnone, 0);
+ t = propagate_types(cs->forpart, c, perr, Tnone, 0);
if (!type_compat(Tnone, t, 0))
- *ok = 0;
- t = propagate_types(cs->dopart, c, ok, Tnone, 0);
- if (!type_compat(Tnone, t, 0))
- *ok = 0;
- if (cs->dopart) {
- t = propagate_types(cs->thenpart, c, ok, Tnone, 0);
+ *perr |= Efail; // UNTESTED
+
+ if (cs->looppart) {
+ t = propagate_types(cs->thenpart, c, perr, Tnone, 0);
if (!type_compat(Tnone, t, 0))
- *ok = 0;
+ *perr |= Efail; // UNTESTED
}
- if (cs->casepart == NULL)
- propagate_types(cs->condpart, c, ok, Tbool, 0);
- else {
+ if (cs->casepart == NULL) {
+ propagate_types(cs->condpart, c, perr, Tbool, 0);
+ propagate_types(cs->looppart, c, perr, Tbool, 0);
+ } else {
/* Condpart must match case values, with bool permitted */
t = NULL;
for (cp = cs->casepart;
cp && !t; cp = cp->next)
- t = propagate_types(cp->value, c, ok, NULL, 0);
+ t = propagate_types(cp->value, c, perr, NULL, 0);
if (!t && cs->condpart)
- t = propagate_types(cs->condpart, c, ok, NULL, Rboolok);
+ t = propagate_types(cs->condpart, c, perr, NULL, Rboolok); // UNTESTED
+ if (!t && cs->looppart)
+ t = propagate_types(cs->looppart, c, perr, NULL, Rboolok); // UNTESTED
// Now we have a type (I hope) push it down
if (t) {
for (cp = cs->casepart; cp; cp = cp->next)
- propagate_types(cp->value, c, ok, t, 0);
- propagate_types(cs->condpart, c, ok, t, Rboolok);
+ propagate_types(cp->value, c, perr, t, 0);
+ propagate_types(cs->condpart, c, perr, t, Rboolok);
+ propagate_types(cs->looppart, c, perr, t, Rboolok);
}
}
// (if)then, else, and case parts must return expected type.
- if (!cs->dopart && !type)
- type = propagate_types(cs->thenpart, c, ok, NULL, rules);
+ if (!cs->looppart && !type)
+ type = propagate_types(cs->thenpart, c, perr, NULL, rules);
if (!type)
- type = propagate_types(cs->elsepart, c, ok, NULL, rules);
+ type = propagate_types(cs->elsepart, c, perr, NULL, rules);
for (cp = cs->casepart;
cp && !type;
- cp = cp->next)
- type = propagate_types(cp->action, c, ok, NULL, rules);
+ cp = cp->next) // UNTESTED
+ type = propagate_types(cp->action, c, perr, NULL, rules); // UNTESTED
if (type) {
- if (!cs->dopart)
- propagate_types(cs->thenpart, c, ok, type, rules);
- propagate_types(cs->elsepart, c, ok, type, rules);
+ if (!cs->looppart)
+ propagate_types(cs->thenpart, c, perr, type, rules);
+ propagate_types(cs->elsepart, c, perr, type, rules);
for (cp = cs->casepart; cp ; cp = cp->next)
- propagate_types(cp->action, c, ok, type, rules);
+ propagate_types(cp->action, c, perr, type, rules);
return type;
} else
return NULL;
}
+###### interp binode cases
+ case Loop:
+ // This just performs one iterration of the loop
+ rv = interp_exec(c, b->left, &rvtype);
+ if (rvtype == Tnone ||
+ (rvtype == Tbool && rv.bool != 0))
+ // rvtype is Tnone or Tbool, doesn't need to be freed
+ interp_exec(c, b->right, NULL);
+ break;
+
###### interp exec cases
case Xcond_statement:
{
if (cs->forpart)
interp_exec(c, cs->forpart, NULL);
- do {
- if (cs->condpart)
- cnd = interp_exec(c, cs->condpart, &cndtype);
- else
- cndtype = Tnone;
- if (!(cndtype == Tnone ||
- (cndtype == Tbool && cnd.bool != 0)))
- break;
- // cnd is Tnone or Tbool, doesn't need to be freed
- if (cs->dopart)
- interp_exec(c, cs->dopart, NULL);
-
- if (cs->thenpart) {
+ if (cs->looppart) {
+ while ((cnd = interp_exec(c, cs->looppart, &cndtype)),
+ cndtype == Tnone || (cndtype == Tbool && cnd.bool != 0))
+ interp_exec(c, cs->thenpart, NULL);
+ } else {
+ cnd = interp_exec(c, cs->condpart, &cndtype);
+ if ((cndtype == Tnone ||
+ (cndtype == Tbool && cnd.bool != 0))) {
+ // cnd is Tnone or Tbool, doesn't need to be freed
rv = interp_exec(c, cs->thenpart, &rvtype);
- if (rvtype != Tnone || !cs->dopart)
- goto Xcond_done;
- free_value(rvtype, &rv);
- rvtype = Tnone;
+ // skip else (and cases)
+ goto Xcond_done;
}
- } while (cs->dopart);
-
+ }
for (cp = cs->casepart; cp; cp = cp->next) {
v = interp_exec(c, cp->value, &vtype);
if (value_cmp(cndtype, vtype, &v, &cnd) == 0) {
## declare terminals
OptNL ->
- | OptNL NEWLINE
+ | OptNL NEWLINE
+
Newlines -> NEWLINE
- | Newlines NEWLINE
+ | Newlines NEWLINE
DeclarationList -> Declaration
- | DeclarationList Declaration
+ | DeclarationList Declaration
Declaration -> ERROR Newlines ${
- tok_err(c,
- "error: unhandled parse error", &$1);
- }$
- | DeclareConstant
- | DeclareFunction
- | DeclareStruct
+ tok_err(c, // UNTESTED
+ "error: unhandled parse error", &$1);
+ }$
+ | DeclareConstant
+ | DeclareFunction
+ | DeclareStruct
## top level grammar
### The `const` section
-As well as being defined in with the code that uses them, constants
-can be declared at the top level. These have full-file scope, so they
-are always `InScope`. The value of a top level constant can be given
-as an expression, and this is evaluated immediately rather than in the
-later interpretation stage. Once we add functions to the language, we
-will need rules concern which, if any, can be used to define a top
-level constant.
+As well as being defined in with the code that uses them, constants can
+be declared at the top level. These have full-file scope, so they are
+always `InScope`, even before(!) they have been declared. The value of
+a top level constant can be given as an expression, and this is
+evaluated after parsing and before execution.
+
+A function call can be used to evaluate a constant, but it will not have
+access to any program state, once such statement becomes meaningful.
+e.g. arguments and filesystem will not be visible.
Constants are defined in a section that starts with the reserved word
`const` and then has a block with a list of assignment statements.
not, the type will be determined during analysis, as with other
constants.
-As the types constants are inserted at the head of a list, printing
-them in the same order that they were read is not straight forward.
-We take a quadratic approach here and count the number of constants
-(variables of depth 0), then count down from there, each time
-searching through for the Nth constant for decreasing N.
+###### parse context
+ struct binode *constlist;
###### top level grammar
$TERM const
DeclareConstant -> const { IN OptNL ConstList OUT OptNL } Newlines
- | const { SimpleConstList } Newlines
- | const IN OptNL ConstList OUT Newlines
- | const SimpleConstList Newlines
+ | const { SimpleConstList } Newlines
+ | const IN OptNL ConstList OUT Newlines
+ | const SimpleConstList Newlines
ConstList -> ConstList SimpleConstLine
- | SimpleConstLine
+ | SimpleConstLine
+
SimpleConstList -> SimpleConstList ; Const
- | Const
- | SimpleConstList ;
+ | Const
+ | SimpleConstList ;
+
SimpleConstLine -> SimpleConstList Newlines
- | ERROR Newlines ${ tok_err(c, "Syntax error in constant", &$1); }$
+ | ERROR Newlines ${ tok_err(c, "Syntax error in constant", &$1); }$
$*type
CType -> Type ${ $0 = $<1; }$
- | ${ $0 = NULL; }$
+ | ${ $0 = NULL; }$
+
$void
Const -> IDENTIFIER :: CType = Expression ${ {
- int ok;
struct variable *v;
+ struct binode *bl, *bv;
+ struct var *var = new_pos(var, $ID);
- v = var_decl(c, $1.txt);
+ v = var_decl(c, $ID.txt);
if (v) {
- struct var *var = new_pos(var, $1);
v->where_decl = var;
v->where_set = var;
- var->var = v;
+ v->type = $<CT;
v->constant = 1;
+ v->global = 1;
} else {
v = var_ref(c, $1.txt);
- tok_err(c, "error: name already declared", &$1);
- type_err(c, "info: this is where '%v' was first declared",
- v->where_decl, NULL, 0, NULL);
- }
- do {
- ok = 1;
- propagate_types($5, c, &ok, $3, 0);
- } while (ok == 2);
- if (!ok)
- c->parse_error = 1;
- else if (v) {
- struct value res = interp_exec(c, $5, &v->type);
- global_alloc(c, v->type, v, &res);
+ if (v->type == Tnone) {
+ v->where_decl = var;
+ v->where_set = var;
+ v->type = $<CT;
+ v->constant = 1;
+ v->global = 1;
+ } else {
+ tok_err(c, "error: name already declared", &$1);
+ type_err(c, "info: this is where '%v' was first declared",
+ v->where_decl, NULL, 0, NULL);
+ }
}
+ var->var = v;
+
+ bv = new(binode);
+ bv->op = Declare;
+ bv->left = var;
+ bv->right= $<Exp;
+
+ bl = new(binode);
+ bl->op = List;
+ bl->left = c->constlist;
+ bl->right = bv;
+ c->constlist = bl;
} }$
+###### core functions
+ static void resolve_consts(struct parse_context *c)
+ {
+ struct binode *b;
+ int retry = 1;
+ enum { none, some, cannot } progress = none;
+
+ c->constlist = reorder_bilist(c->constlist);
+ while (retry) {
+ retry = 0;
+ for (b = cast(binode, c->constlist); b;
+ b = cast(binode, b->right)) {
+ enum prop_err perr;
+ struct binode *vb = cast(binode, b->left);
+ struct var *v = cast(var, vb->left);
+ if (v->var->frame_pos >= 0)
+ continue;
+ do {
+ perr = 0;
+ propagate_types(vb->right, c, &perr,
+ v->var->type, 0);
+ } while (perr & Eretry);
+ if (perr & Efail)
+ c->parse_error += 1;
+ else if (!(perr & Enoconst)) {
+ progress = some;
+ struct value res = interp_exec(
+ c, vb->right, &v->var->type);
+ global_alloc(c, v->var->type, v->var, &res);
+ } else {
+ if (progress == cannot)
+ type_err(c, "error: const %v cannot be resolved.",
+ v, NULL, 0, NULL);
+ else
+ retry = 1;
+ }
+ }
+ switch (progress) {
+ case cannot:
+ retry = 0; break;
+ case none:
+ progress = cannot; break;
+ case some:
+ progress = none; break;
+ }
+ }
+ }
+
###### print const decls
+ {
+ struct binode *b;
+ int first = 1;
+
+ for (b = cast(binode, context.constlist); b;
+ b = cast(binode, b->right)) {
+ struct binode *vb = cast(binode, b->left);
+ struct var *vr = cast(var, vb->left);
+ struct variable *v = vr->var;
+
+ if (first)
+ printf("const\n");
+ first = 0;
+
+ printf(" %.*s :: ", v->name->name.len, v->name->name.txt);
+ type_print(v->type, stdout);
+ printf(" = ");
+ print_exec(vb->right, -1, 0);
+ printf("\n");
+ }
+ }
+
+###### free const decls
+ free_binode(context.constlist);
+
+### Function declarations
+
+The code in an Ocean program is all stored in function declarations.
+One of the functions must be named `main` and it must accept an array of
+strings as a parameter - the command line arguments.
+
+As this is the top level, several things are handled a bit differently.
+The function is not interpreted by `interp_exec` as that isn't passed
+the argument list which the program requires. Similarly type analysis
+is a bit more interesting at this level.
+
+###### ast functions
+
+ static struct type *handle_results(struct parse_context *c,
+ struct binode *results)
+ {
+ /* Create a 'struct' type from the results list, which
+ * is a list for 'struct var'
+ */
+ struct type *t = add_anon_type(c, &structure_prototype,
+ "function result");
+ int cnt = 0;
+ struct binode *b;
+
+ for (b = results; b; b = cast(binode, b->right))
+ cnt += 1;
+ t->structure.nfields = cnt;
+ t->structure.fields = calloc(cnt, sizeof(struct field));
+ cnt = 0;
+ for (b = results; b; b = cast(binode, b->right)) {
+ struct var *v = cast(var, b->left);
+ struct field *f = &t->structure.fields[cnt++];
+ int a = v->var->type->align;
+ f->name = v->var->name->name;
+ f->type = v->var->type;
+ f->init = NULL;
+ f->offset = t->size;
+ v->var->frame_pos = f->offset;
+ t->size += ((f->type->size - 1) | (a-1)) + 1;
+ if (a > t->align)
+ t->align = a;
+ variable_unlink_exec(v->var);
+ }
+ free_binode(results);
+ return t;
+ }
+
+ static struct variable *declare_function(struct parse_context *c,
+ struct variable *name,
+ struct binode *args,
+ struct type *ret,
+ struct binode *results,
+ struct exec *code)
+ {
+ if (name) {
+ struct value fn = {.function = code};
+ struct type *t;
+ var_block_close(c, CloseFunction, code);
+ t = add_anon_type(c, &function_prototype,
+ "func %.*s", name->name->name.len,
+ name->name->name.txt);
+ name->type = t;
+ t->function.params = reorder_bilist(args);
+ if (!ret) {
+ ret = handle_results(c, reorder_bilist(results));
+ t->function.inline_result = 1;
+ t->function.local_size = ret->size;
+ }
+ t->function.return_type = ret;
+ global_alloc(c, t, name, &fn);
+ name->type->function.scope = c->out_scope;
+ } else {
+ free_binode(args);
+ free_type(ret);
+ free_exec(code);
+ var_block_close(c, CloseFunction, NULL);
+ }
+ c->out_scope = NULL;
+ return name;
+ }
+
+###### declare terminals
+ $TERM return
+
+###### top level grammar
+
+ $*variable
+ DeclareFunction -> func FuncName ( OpenScope ArgsLine ) Block Newlines ${
+ $0 = declare_function(c, $<FN, $<Ar, Tnone, NULL, $<Bl);
+ }$
+ | func FuncName IN OpenScope Args OUT OptNL do Block Newlines ${
+ $0 = declare_function(c, $<FN, $<Ar, Tnone, NULL, $<Bl);
+ }$
+ | func FuncName NEWLINE OpenScope OptNL do Block Newlines ${
+ $0 = declare_function(c, $<FN, NULL, Tnone, NULL, $<Bl);
+ }$
+ | func FuncName ( OpenScope ArgsLine ) : Type Block Newlines ${
+ $0 = declare_function(c, $<FN, $<Ar, $<Ty, NULL, $<Bl);
+ }$
+ | func FuncName ( OpenScope ArgsLine ) : ( ArgsLine ) Block Newlines ${
+ $0 = declare_function(c, $<FN, $<AL, NULL, $<AL2, $<Bl);
+ }$
+ | func FuncName IN OpenScope Args OUT OptNL return Type Newlines do Block Newlines ${
+ $0 = declare_function(c, $<FN, $<Ar, $<Ty, NULL, $<Bl);
+ }$
+ | func FuncName NEWLINE OpenScope return Type Newlines do Block Newlines ${
+ $0 = declare_function(c, $<FN, NULL, $<Ty, NULL, $<Bl);
+ }$
+ | func FuncName IN OpenScope Args OUT OptNL return IN Args OUT OptNL do Block Newlines ${
+ $0 = declare_function(c, $<FN, $<Ar, NULL, $<Ar2, $<Bl);
+ }$
+ | func FuncName NEWLINE OpenScope return IN Args OUT OptNL do Block Newlines ${
+ $0 = declare_function(c, $<FN, NULL, NULL, $<Ar, $<Bl);
+ }$
+
+###### print func decls
{
struct variable *v;
int target = -1;
while (target != 0) {
int i = 0;
for (v = context.in_scope; v; v=v->in_scope)
- if (v->depth == 0) {
+ if (v->depth == 0 && v->type && v->type->check_args) {
i += 1;
if (i == target)
break;
}
if (target == -1) {
- if (i)
- printf("const\n");
target = i;
} else {
struct value *val = var_value(&context, v);
- printf(" %.*s :: ", v->name->name.len, v->name->name.txt);
- type_print(v->type, stdout);
- printf(" = ");
- if (v->type == Tstr)
- printf("\"");
- print_value(v->type, val);
- if (v->type == Tstr)
- printf("\"");
- printf("\n");
+ printf("func %.*s", v->name->name.len, v->name->name.txt);
+ v->type->print_type_decl(v->type, stdout);
+ if (brackets)
+ print_exec(val->function, 0, brackets);
+ else
+ print_value(v->type, val, stdout);
+ printf("/* frame size %d */\n", v->type->function.local_size);
target -= 1;
}
}
}
-### Finally the whole `main` function.
-
-An Ocean program can currently have only one function - `main` - and
-that must exist. It expects an array of strings with a provided size.
-Following this is a `block` which is the code to execute.
-
-As this is the top level, several things are handled a bit
-differently.
-The function is not interpreted by `interp_exec` as that isn't
-passed the argument list which the program requires. Similarly type
-analysis is a bit more interesting at this level.
-
-###### top level grammar
+###### core functions
- DeclareFunction -> MainFunction ${ {
- if (c->prog)
- type_err(c, "\"main\" defined a second time",
- $1, NULL, 0, NULL);
- else
- c->prog = $<1;
- } }$
+ static int analyse_funcs(struct parse_context *c)
+ {
+ struct variable *v;
+ int all_ok = 1;
+ for (v = c->in_scope; v; v = v->in_scope) {
+ struct value *val;
+ struct type *ret;
+ enum prop_err perr;
+ if (v->depth != 0 || !v->type || !v->type->check_args)
+ continue;
+ ret = v->type->function.inline_result ?
+ Tnone : v->type->function.return_type;
+ val = var_value(c, v);
+ do {
+ perr = 0;
+ propagate_types(val->function, c, &perr, ret, 0);
+ } while (!(perr & Efail) && (perr & Eretry));
+ if (!(perr & Efail))
+ /* Make sure everything is still consistent */
+ propagate_types(val->function, c, &perr, ret, 0);
+ if (perr & Efail)
+ all_ok = 0;
+ if (!v->type->function.inline_result &&
+ !v->type->function.return_type->dup) {
+ type_err(c, "error: function cannot return value of type %1",
+ v->where_decl, v->type->function.return_type, 0, NULL);
+ }
-###### print binode cases
- case Func:
- case List:
- do_indent(indent, "func main(");
- for (b2 = cast(binode, b->left); b2; b2 = cast(binode, b2->right)) {
- struct variable *v = cast(var, b2->left)->var;
- printf(" ");
- print_exec(b2->left, 0, 0);
- printf(":");
- type_print(v->type, stdout);
+ scope_finalize(c, v->type);
}
- if (bracket)
- printf(") {\n");
- else
- printf(")\n");
- print_exec(b->right, indent+1, bracket);
- if (bracket)
- do_indent(indent, "}\n");
- break;
-
-###### propagate binode cases
- case List:
- case Func: abort(); // NOTEST
-
-###### core functions
+ return all_ok;
+ }
- static int analyse_prog(struct exec *prog, struct parse_context *c)
+ static int analyse_main(struct type *type, struct parse_context *c)
{
- struct binode *bp = cast(binode, prog);
+ struct binode *bp = type->function.params;
struct binode *b;
- int ok = 1;
+ enum prop_err perr;
int arg = 0;
struct type *argv_type;
- struct text argv_type_name = { " argv", 5 };
-
- if (!bp)
- return 0; // NOTEST
- argv_type = add_type(c, argv_type_name, &array_prototype);
+ argv_type = add_anon_type(c, &array_prototype, "argv");
argv_type->array.member = Tstr;
argv_type->array.unspec = 1;
- for (b = cast(binode, bp->left); b; b = cast(binode, b->right)) {
- ok = 1;
+ for (b = bp; b; b = cast(binode, b->right)) {
+ perr = 0;
switch (arg++) {
case 0: /* argv */
- propagate_types(b->left, c, &ok, argv_type, 0);
+ propagate_types(b->left, c, &perr, argv_type, 0);
break;
default: /* invalid */ // NOTEST
- propagate_types(b->left, c, &ok, Tnone, 0); // NOTEST
+ propagate_types(b->left, c, &perr, Tnone, 0); // NOTEST
}
+ if (perr & Efail)
+ c->parse_error += 1;
}
- do {
- ok = 1;
- propagate_types(bp->right, c, &ok, Tnone, 0);
- } while (ok == 2);
- if (!ok)
- return 0;
-
- /* Make sure everything is still consistent */
- propagate_types(bp->right, c, &ok, Tnone, 0);
- if (!ok)
- return 0;
- scope_finalize(c);
- return 1;
+ return !c->parse_error;
}
- static void interp_prog(struct parse_context *c, struct exec *prog,
- int argc, char **argv)
+ static void interp_main(struct parse_context *c, int argc, char **argv)
{
- struct binode *p = cast(binode, prog);
+ struct value *progp = NULL;
+ struct text main_name = { "main", 4 };
+ struct variable *mainv;
struct binode *al;
int anum = 0;
struct value v;
struct type *vtype;
- if (!prog)
- return; // NOTEST
- al = cast(binode, p->left);
+ mainv = var_ref(c, main_name);
+ if (mainv)
+ progp = var_value(c, mainv);
+ if (!progp || !progp->function) {
+ fprintf(stderr, "oceani: no main function found.\n");
+ c->parse_error += 1;
+ return;
+ }
+ if (!analyse_main(mainv->type, c)) {
+ fprintf(stderr, "oceani: main has wrong type.\n");
+ c->parse_error += 1;
+ return;
+ }
+ al = mainv->type->function.params;
+
+ c->local_size = mainv->type->function.local_size;
+ c->local = calloc(1, c->local_size);
while (al) {
struct var *v = cast(var, al->left);
struct value *vl = var_value(c, v->var);
array_init(v->var->type, vl);
for (i = 0; i < argc; i++) {
struct value *vl2 = vl->array + i * v->var->type->array.member->size;
-
arg.str.txt = argv[i];
arg.str.len = strlen(argv[i]);
}
al = cast(binode, al->right);
}
- v = interp_exec(c, p->right, &vtype);
+ v = interp_exec(c, progp->function, &vtype);
free_value(vtype, &v);
+ free(c->local);
+ c->local = NULL;
}
-###### interp binode cases
- case List:
- case Func: abort(); // NOTEST
+###### ast functions
+ void free_variable(struct variable *v)
+ {
+ }
## And now to test it out.
name:string
alive:Boolean
- func main
- argv:[argc::]string
- do
+ func main(argv:[argc::]string)
print "Hello World, what lovely oceans you have!"
print "Are there", five, "?"
print pi, pie, "but", cake
else
hi = mid
if hi - lo < 1:
+ lo = mid
use GiveUp
use True
do pass
case Found:
print "Yay, I found", target
case GiveUp:
- print "Closest I found was", mid
+ print "Closest I found was", lo
size::= 10
list:[size]number
code / ocean / blobdiff