## macros
struct parse_context;
## ast
+ ## ast late
struct parse_context {
struct token_config config;
char *file_name;
if (loc->type == Xbinode)
return __fput_loc(cast(binode,loc)->left, f) ||
__fput_loc(cast(binode,loc)->right, f); // NOTEST
- return 0;
+ return 0; // NOTEST
}
static void fput_loc(struct exec *loc, FILE *f)
{
if (!__fput_loc(loc, f))
- fprintf(f, "??:??: ");
+ fprintf(f, "??:??: "); // NOTEST
}
Each different type of `exec` node needs a number of functions defined,
};
};
+###### ast late
struct type {
struct text name;
struct type *next;
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);
+ int (*test)(struct type *type, struct value *val);
void (*free)(struct type *type, struct value *val);
void (*free_type)(struct type *t);
long long (*to_int)(struct value *v);
va_start(ap, name);
vasprintf(&t.txt, name, ap);
va_end(ap);
- t.len = strlen(name);
+ t.len = strlen(t.txt);
return _add_type(c, t, proto, 1);
}
+ static struct type *find_anon_type(struct parse_context *c,
+ struct type *proto, char *name, ...)
+ {
+ struct type *t = c->typelist;
+ struct text nm;
+ va_list ap;
+
+ va_start(ap, name);
+ vasprintf(&nm.txt, name, ap);
+ va_end(ap);
+ nm.len = strlen(name);
+
+ while (t && (!t->anon ||
+ text_cmp(t->name, nm) != 0))
+ t = t->next;
+ if (t) {
+ free(nm.txt);
+ return t;
+ }
+ return _add_type(c, nm, proto, 1);
+ }
+
static void free_type(struct type *t)
{
/* The type is always a reference to something in the
fprintf(f, "%.*s", type->name.len, type->name.txt);
else if (type->print_type)
type->print_type(type, f);
+ else if (type->name.len && type->anon)
+ fprintf(f, "\"%.*s\"", type->name.len, type->name.txt);
else
- fputs("*invalid*type*", f);
+ fputs("*invalid*type*", f); // NOTEST
}
static void val_init(struct type *type, struct value *val)
{
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
+ if (tl && tl->cmp_eq)
+ return tl->cmp_eq(tl, tr, left, right);
return -1; // NOTEST
}
static void _free_value(struct type *type, struct value *v);
+ static int bool_test(struct type *type, struct value *v)
+ {
+ return v->bool;
+ }
+
static struct type base_prototype = {
.init = _val_init,
.print = _print_value,
###### context initialization
Tbool = add_base_type(&context, "Boolean", Vbool, sizeof(char));
+ Tbool->test = bool_test;
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);
} else
fputs("???", stderr); // NOTEST
} else
- fputs("NOTVAR", stderr);
+ fputs("NOTVAR", stderr); // NOTEST
break;
###### propagate exec cases
if (!parse_time)
return 1;
if (type->array.member->size <= 0)
- return 0;
+ return 0; // UNTESTED
type->array.static_size = 1;
type->size = type->array.size * type->array.member->size;
###### type functions
void (*print_type_decl)(struct type *type, FILE *f);
+ struct type *(*fieldref)(struct type *t, struct parse_context *c,
+ struct fieldref *f, struct value **vp);
###### value functions
return 1;
}
+ static int find_struct_index(struct type *type, struct text field)
+ {
+ int i;
+ for (i = 0; i < type->structure.nfields; i++)
+ if (text_cmp(type->structure.fields[i].name, field) == 0)
+ return i;
+ return IndexInvalid;
+ }
+
+ static struct type *structure_fieldref(struct type *t, struct parse_context *c,
+ struct fieldref *f, struct value **vp)
+ {
+ if (f->index == IndexUnknown) {
+ f->index = find_struct_index(t, f->name);
+ if (f->index < 0)
+ type_err(c, "error: cannot find requested field in %1",
+ f->left, t, 0, NULL);
+ }
+ if (f->index < 0)
+ return NULL;
+ if (vp) {
+ struct value *v = *vp;
+ v = (void*)v->ptr + t->structure.fields[f->index].offset;
+ *vp = v;
+ }
+ return t->structure.fields[f->index].type;
+ }
+
static struct type structure_prototype = {
.init = structure_init,
.free = structure_free,
.free_type = structure_free_type,
.print_type_decl = structure_print_type,
.prepare_type = structure_prepare_type,
+ .fieldref = structure_fieldref,
};
###### exec type
int index;
struct text name;
};
+ enum { IndexUnknown = -1, IndexInvalid = -2 };
###### free exec cases
case Xfieldref:
struct fieldref *fr = new_pos(fieldref, $2);
fr->left = $<1;
fr->name = $3.txt;
- fr->index = -2;
+ fr->index = IndexUnknown;
$0 = fr;
} }$
break;
}
-###### ast functions
- static int find_struct_index(struct type *type, struct text field)
- {
- int i;
- for (i = 0; i < type->structure.nfields; i++)
- if (text_cmp(type->structure.fields[i].name, field) == 0)
- return i;
- return -1;
- }
-
###### propagate exec cases
case Xfieldref:
struct fieldref *f = cast(fieldref, prog);
struct type *st = propagate_types(f->left, c, perr, NULL, 0);
- if (!st)
- 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",
+ if (!st || !st->fieldref)
+ type_err(c, "error: field reference on %1 is not supported",
f->left, st, 0, NULL);
- else if (f->index == -2) {
- f->index = find_struct_index(st, f->name);
- if (f->index < 0)
- type_err(c, "error: cannot find requested field in %1",
- f->left, st, 0, NULL);
- }
- if (f->index >= 0) {
- struct type *ft = st->structure.fields[f->index].type;
- if (!type_compat(type, ft, rules))
+ else {
+ t = st->fieldref(st, c, f, NULL);
+ if (t && !type_compat(type, t, rules))
type_err(c, "error: have %1 but need %2", prog,
- ft, rules, type);
- return ft;
+ t, rules, type);
+ return t;
}
break;
}
struct fieldref *f = cast(fieldref, e);
struct type *ltype;
struct value *lleft = linterp_exec(c, f->left, <ype);
- lrv = (void*)lleft->ptr + ltype->structure.fields[f->index].offset;
- rvtype = ltype->structure.fields[f->index].type;
+ lrv = lleft;
+ rvtype = ltype->fieldref(ltype, c, f, &lrv);
break;
}
}
}
+#### References
+
+References, or pointers, are values that refer to another value. They
+can only refer to a `struct`, though as a struct can embed anything they
+can effectively refer to anything.
+
+References are potentially dangerous as they might refer to some
+variable which no longer exists - either because a stack frame
+containing it has been discarded or because the value was allocated on
+the heap and has now been free. Ocean does not yet provide any
+protection against these problems. It will in due course.
+
+With references comes the opportunity and the need to explicitly
+allocate values on the "heap" and to free them. We currently provide
+fairly basic support for this.
+
+Reference make use of the `@` symbol in various ways. A type that starts
+with `@` is a reference to whatever follows. A reference value
+followed by an `@` acts as the referred value, though the `@` is often
+not needed. Finally, an expression that starts with `@` is a special
+reference related expression. Some examples might help.
+
+##### Example: Reference examples
+
+ struct foo
+ a: number
+ b: string
+ ref: @foo
+ bar: foo
+ bar.number = 23; bar.string = "hello"
+ baz: foo
+ ref = bar
+ baz = @ref
+ baz.a = ref.a * 2
+
+ ref = @new()
+ ref@ = baz
+ @free = ref
+ ref = @nil
+
+Obviously this is very contrived. `ref` is a reference to a `foo` which
+is initially set to refer to the value stored in `bar` - no extra syntax
+is needed to "Take the address of" `bar` - the fact that `ref` is a
+reference means that only the address make sense.
+
+When `ref.a` is accessed, that is whatever value is stored in `bar.a`.
+The same syntax is used for accessing fields both in structs and in
+references to structs. It would be correct to use `ref@.a`, but not
+necessary.
+
+`@new()` creates an object of whatever type is needed for the program
+to by type-correct. In future iterations of Ocean, arguments a
+constructor will access arguments, so the the syntax now looks like a
+function call. `@free` can be assigned any reference that was returned
+by `@new()`, and it will be freed. `@nil` is a value of whatever
+reference type is appropriate, and is stable and never the address of
+anything in the heap or on the stack. A reference can be assigned
+`@nil` or compared against that value.
+
+###### declare terminals
+ $TERM @
+
+###### type union fields
+
+ struct {
+ struct type *referent;
+ } reference;
+
+###### value union fields
+ struct value *ref;
+
+###### value functions
+
+ static void reference_print_type(struct type *t, FILE *f)
+ {
+ fprintf(f, "@");
+ type_print(t->reference.referent, f);
+ }
+
+ static int reference_cmp(struct type *tl, struct type *tr,
+ struct value *left, struct value *right)
+ {
+ return left->ref == right->ref ? 0 : 1;
+ }
+
+ static void reference_dup(struct type *t,
+ struct value *vold, struct value *vnew)
+ {
+ vnew->ref = vold->ref;
+ }
+
+ static void reference_free(struct type *t, struct value *v)
+ {
+ /* Nothing to do here */
+ }
+
+ static int reference_compat(struct type *require, struct type *have)
+ {
+ if (have->compat != require->compat)
+ return 0;
+ if (have->reference.referent != require->reference.referent)
+ return 0;
+ return 1;
+ }
+
+ static int reference_test(struct type *type, struct value *val)
+ {
+ return val->ref != NULL;
+ }
+
+ static struct type reference_prototype = {
+ .print_type = reference_print_type,
+ .cmp_eq = reference_cmp,
+ .dup = reference_dup,
+ .test = reference_test,
+ .free = reference_free,
+ .compat = reference_compat,
+ .size = sizeof(void*),
+ .align = sizeof(void*),
+ };
+
+###### type grammar
+
+ | @ IDENTIFIER ${ {
+ struct type *t = find_type(c, $ID.txt);
+ if (!t) {
+ t = add_type(c, $ID.txt, NULL);
+ t->first_use = $ID;
+ }
+ $0 = find_anon_type(c, &reference_prototype, "@%.*s",
+ $ID.txt.len, $ID.txt.txt);
+ $0->reference.referent = t;
+ } }$
+
+###### core functions
+ static int text_is(struct text t, char *s)
+ {
+ return (strlen(s) == t.len &&
+ strncmp(s, t.txt, t.len) == 0);
+ }
+
+###### exec type
+ Xref,
+
+###### ast
+ struct ref {
+ struct exec;
+ enum ref_func { RefNew, RefFree, RefNil } action;
+ struct type *reftype;
+ struct exec *right;
+ };
+
+###### SimpleStatement Grammar
+
+ | @ IDENTIFIER = Expression ${ {
+ struct ref *r = new_pos(ref, $ID);
+ // Must be "free"
+ if (!text_is($ID.txt, "free"))
+ tok_err(c, "error: only \"@free\" makes sense here",
+ &$ID);
+
+ $0 = r;
+ r->action = RefFree;
+ r->right = $<Exp;
+ } }$
+
+###### expression grammar
+ | @ IDENTIFIER ( ) ${
+ // Only 'new' valid here
+ if (!text_is($ID.txt, "new")) {
+ tok_err(c, "error: Only reference function is \"@new()\"",
+ &$ID);
+ } else {
+ struct ref *r = new_pos(ref,$ID);
+ $0 = r;
+ r->action = RefNew;
+ }
+ }$
+ | @ IDENTIFIER ${
+ // Only 'nil' valid here
+ if (!text_is($ID.txt, "nil")) {
+ tok_err(c, "error: Only reference value is \"@nil\"",
+ &$ID);
+ } else {
+ struct ref *r = new_pos(ref,$ID);
+ $0 = r;
+ r->action = RefNil;
+ }
+ }$
+
+###### print exec cases
+ case Xref: {
+ struct ref *r = cast(ref, e);
+ switch (r->action) {
+ case RefNew:
+ printf("@new()"); break;
+ case RefNil:
+ printf("@nil"); break;
+ case RefFree:
+ do_indent(indent, "@free = ");
+ print_exec(r->right, indent, bracket);
+ break;
+ }
+ break;
+ }
+
+###### propagate exec cases
+ case Xref: {
+ struct ref *r = cast(ref, prog);
+ switch (r->action) {
+ case RefNew:
+ if (type && type->free != reference_free) {
+ type_err(c, "error: @new() can only be used with references, not %1",
+ prog, type, 0, NULL);
+ return NULL;
+ }
+ if (type && !r->reftype) {
+ r->reftype = type;
+ *perr |= Eretry;
+ }
+ return type;
+ case RefNil:
+ if (type && type->free != reference_free)
+ type_err(c, "error: @nil can only be used with reference, not %1",
+ prog, type, 0, NULL);
+ if (type && !r->reftype) {
+ r->reftype = type;
+ *perr |= Eretry;
+ }
+ return type;
+ case RefFree:
+ t = propagate_types(r->right, c, perr, NULL, 0);
+ if (t && t->free != reference_free)
+ type_err(c, "error: @free can only be assigned a reference, not %1",
+ prog, t, 0, NULL);
+ r->reftype = Tnone;
+ return Tnone;
+ }
+ break; // NOTEST
+ }
+
+
+###### interp exec cases
+ case Xref: {
+ struct ref *r = cast(ref, e);
+ switch (r->action) {
+ case RefNew:
+ if (r->reftype)
+ rv.ref = calloc(1, r->reftype->reference.referent->size);
+ rvtype = r->reftype;
+ break;
+ case RefNil:
+ rv.ref = NULL;
+ rvtype = r->reftype;
+ break;
+ case RefFree:
+ rv = interp_exec(c, r->right, &rvtype);
+ free_value(rvtype->reference.referent, rv.ref);
+ free(rv.ref);
+ rvtype = Tnone;
+ break;
+ }
+ break;
+ }
+
+###### free exec cases
+ case Xref: {
+ struct ref *r = cast(ref, e);
+ free_exec(r->right);
+ free(r);
+ break;
+ }
+
+###### Expressions: dereference
+
+###### Binode types
+ Deref,
+
+###### term grammar
+
+ | Term @ ${ {
+ struct binode *b = new(binode);
+ b->op = Deref;
+ b->left = $<Trm;
+ $0 = b;
+ } }$
+
+###### print binode cases
+ case Deref:
+ print_exec(b->left, -1, bracket);
+ printf("@");
+ break;
+
+###### propagate binode cases
+ case Deref:
+ /* left must be a reference, and we return what it refers to */
+ /* FIXME how can I pass the expected type down? */
+ t = propagate_types(b->left, c, perr, NULL, 0);
+ if (!t || t->free != reference_free)
+ type_err(c, "error: Cannot dereference %1", b, t, 0, NULL);
+ else
+ return t->reference.referent;
+ break;
+
+###### interp binode cases
+ case Deref: {
+ left = interp_exec(c, b->left, <ype);
+ lrv = left.ref;
+ rvtype = ltype->reference.referent;
+ break;
+ }
+
+
#### Functions
A function is a chunk of code which can be passed parameters and can
e->var = v;
if (v) {
v->where_decl = e;
+ v->where_set = e;
$0 = v;
} else {
v = var_ref(c, $1.txt);
| Varlist ; ${ $0 = $<1; }$
Varlist -> Varlist ; ArgDecl ${
- $0 = new(binode);
+ $0 = new_pos(binode, $2);
$0->op = List;
$0->left = $<Vl;
$0->right = $<AD;
$*var
ArgDecl -> IDENTIFIER : FormalType ${ {
- struct variable *v = var_decl(c, $1.txt);
- $0 = new(var);
+ struct variable *v = var_decl(c, $ID.txt);
+ $0 = new_pos(var, $ID);
$0->var = v;
+ v->where_decl = $0;
+ v->where_set = $0;
v->type = $<FT;
} }$
### Expressions: Arithmetic etc.
The remaining expressions with the highest precedence are arithmetic,
-string concatenation, and string conversion. String concatenation
+string concatenation, string conversion, and testing. String concatenation
(`++`) has the same precedence as multiplication and division, but lower
than the uniary.
+Testing comes in two forms. A single question mark (`?`) is a uniary
+operator which converts come types into Boolean. The general meaning is
+"is this a value value" and there will be more uses as the language
+develops. A double questionmark (`??`) is a binary operator (Choose),
+with same precedence as multiplication, which returns the LHS if it
+tests successfully, else returns the RHS.
+
String conversion is a temporary feature until I get a better type
system. `$` is a prefix operator which expects a string and returns
a number.
###### Binode types
Plus, Minus,
Times, Divide, Rem,
- Concat,
- Absolute, Negate,
+ Concat, Choose,
+ Absolute, Negate, Test,
StringConv,
Bracket,
###### declare terminals
$LEFT + - Eop
- $LEFT * / % ++ Top
- $LEFT Uop $
+ $LEFT * / % ++ ?? Top
+ $LEFT Uop $ ?
$TERM ( )
###### expression grammar
Uop -> + ${ $0.op = Absolute; }$
| - ${ $0.op = Negate; }$
| $ ${ $0.op = StringConv; }$
+ | ? ${ $0.op = Test; }$
Top -> * ${ $0.op = Times; }$
| / ${ $0.op = Divide; }$
| % ${ $0.op = Rem; }$
| ++ ${ $0.op = Concat; }$
+ | ?? ${ $0.op = Choose; }$
###### print binode cases
case Plus:
case Divide:
case Concat:
case Rem:
+ case Choose:
if (bracket) printf("(");
print_exec(b->left, indent, bracket);
switch(b->op) {
case Divide: fputs(" / ", stdout); break;
case Rem: fputs(" % ", stdout); break;
case Concat: fputs(" ++ ", stdout); break;
+ case Choose: fputs(" ?? ", stdout); break;
default: abort(); // NOTEST
} // NOTEST
print_exec(b->right, indent, bracket);
case Absolute:
case Negate:
case StringConv:
+ case Test:
if (bracket) printf("(");
switch (b->op) {
case Absolute: fputs("+", stdout); break;
case Negate: fputs("-", stdout); break;
case StringConv: fputs("$", stdout); break;
+ case Test: fputs("?", stdout); break;
default: abort(); // NOTEST
} // NOTEST
print_exec(b->right, indent, bracket);
prog, type, 0, NULL);
return Tnum;
+ case Test:
+ /* LHS must support ->test, result is Tbool */
+ t = propagate_types(b->right, c, perr, NULL, 0);
+ if (!t || !t->test)
+ type_err(c, "error: '?' requires a testable value, not %1",
+ prog, t, 0, NULL);
+ return Tbool;
+
+ case Choose:
+ /* LHS and RHS must match and are returned. Must support
+ * ->test
+ */
+ t = propagate_types(b->left, c, perr, type, rules);
+ t = propagate_types(b->right, c, perr, t, rules);
+ if (t && t->test == NULL)
+ type_err(c, "error: \"??\" requires a testable value, not %1",
+ prog, t, 0, NULL);
+ return t;
+
case Bracket:
return propagate_types(b->right, c, perr, type, 0);
printf("Unsupported suffix: %.*s\n", tx.len, tx.txt); // UNTESTED
break;
+ case Test:
+ right = interp_exec(c, b->right, &rtype);
+ rvtype = Tbool;
+ rv.bool = !!rtype->test(rtype, &right);
+ break;
+ case Choose:
+ left = interp_exec(c, b->left, <ype);
+ if (ltype->test(ltype, &left)) {
+ rv = left;
+ rvtype = ltype;
+ ltype = NULL;
+ } else
+ rv = interp_exec(c, b->right, &rvtype);
+ break;
###### value functions
###### SimpleStatement Grammar
| print ExpressionList ${
- $0 = b = new(binode);
+ $0 = b = new_pos(binode, $1);
b->op = Print;
b->right = NULL;
b->left = reorder_bilist($<EL);
}$
| print ExpressionList , ${ {
- $0 = b = new(binode);
+ $0 = b = new_pos(binode, $1);
b->op = Print;
b->right = reorder_bilist($<EL);
b->left = NULL;
} }$
| print ${
- $0 = b = new(binode);
+ $0 = b = new_pos(binode, $1);
b->op = Print;
b->left = NULL;
b->right = NULL;
case Assign:
do_indent(indent, "");
- print_exec(b->left, indent, bracket);
+ print_exec(b->left, -1, bracket);
printf(" = ");
- print_exec(b->right, indent, bracket);
+ print_exec(b->right, -1, bracket);
if (indent >= 0)
printf("\n");
break;
{
struct variable *v = cast(var, b->left)->var;
do_indent(indent, "");
- print_exec(b->left, indent, bracket);
+ print_exec(b->left, -1, bracket);
if (cast(var, b->left)->var->constant) {
printf("::");
if (v->explicit_type) {
}
if (b->right) {
printf("= ");
- print_exec(b->right, indent, bracket);
+ print_exec(b->right, -1, bracket);
}
if (indent >= 0)
printf("\n");