free(s);
s = t;
}
- ## free context
+ ## free context vars
+ ## free context types
exit(context.parse_error ? 1 : 0);
}
case '%': fputc(*fmt, stderr); break;
default: fputc('?', stderr); break;
case '1':
- fputs(t1 ? t1->name : "*unknown*", stderr);
+ if (t1)
+ fprintf(stderr, "%.*s", t1->name.len, t1->name.txt);
+ else
+ fputs("*unknown*", stderr);
break;
case '2':
- fputs(t2 ? t2->name : "*unknown*", stderr);
+ if (t2)
+ fprintf(stderr, "%.*s", t2->name.len, t2->name.txt);
+ else
+ fputs("*unknown*", stderr);
+ break;
break;
## format cases
}
existance of these conversion functions enable types to determine if
they are compatible with other types.
+Named type are stored in a simple linked list.
+
###### ast
struct type {
- char *name;
+ struct text name;
+ struct type *next;
struct value (*init)(struct type *type);
struct value (*parse)(struct type *type, char *str);
void (*print)(struct value val);
long long (*to_int)(struct value *v);
double (*to_float)(struct value *v);
int (*to_mpq)(mpq_t *q, struct value *v);
- ## type fields
+ union {
+ ## type union fields
+ };
+ };
+
+ struct typep {
+ struct type *t;
};
+###### parse context
+
+ struct type *typelist;
+
+###### ast functions
+
+ static struct type *find_type(struct parse_context *c, struct text s)
+ {
+ struct type *l = c->typelist;
+
+ while (l &&
+ text_cmp(l->name, s) != 0)
+ l = l->next;
+ return l;
+ }
+
+ static struct type *add_type(struct parse_context *c, struct text s,
+ struct type *proto)
+ {
+ struct type *n;
+
+ n = calloc(1, sizeof(*n));
+ *n = *proto;
+ n->name = s;
+ n->next = c->typelist;
+ c->typelist = n;
+ return n;
+ }
+
+ 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 context_init(struct parse_context *c)
+ {
+ ## context initialization
+ }
+
+###### free context types
+
+ while (context.typelist) {
+ struct type *t = context.typelist;
+
+ context.typelist = t->next;
+ free(t);
+ }
+
### Values
Values can be numbers, which we represent as multi-precision
myLDLIBS := libnumber.o libstring.o -lgmp
LDLIBS := $(filter-out $(myLDLIBS),$(LDLIBS)) $(myLDLIBS)
-###### type fields
+###### type union fields
enum vtype {Vnone, Vstr, Vnum, Vbool, Vlabel} vtype;
###### ast
static int vtype_compat(struct type *require, struct type *have, int rules)
{
- if ((rules & Rboolok) && have == &Tbool)
+ if ((rules & Rboolok) && have == Tbool)
return 1;
- if ((rules & Rnolabel) && have == &Tlabel)
+ if ((rules & Rnolabel) && have == Tlabel)
return 0;
if (!require || !have)
return 1;
rv.type = type;
switch(type->vtype) {
- case Vnone:abort();
+ case Vnone:
+ break;
case Vnum:
mpq_init(rv.num); break;
case Vstr:
static void _free_value(struct value v);
- #define BaseType \
- .init = _val_init, \
- .parse = _parse_value, \
- .print = _print_value, \
- .cmp_order = _value_cmp, \
- .cmp_eq = _value_cmp, \
- .dup = _dup_value, \
- .free = _free_value, \
-
- static struct type Tbool = {
- BaseType
- .name = "Boolean",
- .vtype = Vbool,
+ static struct type base_prototype = {
+ .init = _val_init,
+ .parse = _parse_value,
+ .print = _print_value,
+ .cmp_order = _value_cmp,
+ .cmp_eq = _value_cmp,
+ .dup = _dup_value,
+ .free = _free_value,
};
- static struct type Tstr = {
- BaseType
- .name = "string",
- .vtype = Vstr,
- };
+ static struct type *Tbool, *Tstr, *Tnum, *Tnone, *Tlabel;
- static struct type Tnum = {
- BaseType
- .name = "number",
- .vtype = Vnum,
- };
+###### ast functions
+ static struct type *add_base_type(struct parse_context *c, char *n, enum vtype vt)
+ {
+ struct text txt = { n, strlen(n) };
+ struct type *t;
- static struct type Tnone = {
- BaseType
- .name = "none",
- .vtype = Vnone,
- };
+ t = add_type(c, txt, &base_prototype);
+ t->vtype = vt;
+ return t;
+ }
- static struct type Tlabel = {
- BaseType
- .name = "label",
- .vtype = Vlabel,
- };
+###### forward decls
+ static struct type *add_base_type(struct parse_context *c, char *n, enum vtype vt);
+
+###### context initialization
+
+ Tbool = add_base_type(c, "Boolean", Vbool);
+ Tstr = add_base_type(c, "string", Vstr);
+ Tnum = add_base_type(c, "number", Vnum);
+ Tnone = add_base_type(c, "none", Vnone);
+ Tlabel = add_base_type(c, "label", Vlabel);
### Variables
}
}
-###### free context
+###### free context vars
while (context.varlist) {
struct binding *b = context.varlist;
else if (v->previous &&
v->previous->scope == PendingScope)
v->scope = PendingScope;
- else if (v->val.type == &Tlabel)
+ else if (v->val.type == Tlabel)
v->scope = PendingScope;
else if (v->name->var == v)
v->scope = OutScope;
for (v2 = v;
v2 && v2->scope == PendingScope;
v2 = v2->previous)
- if (v2->val.type != &Tlabel)
+ if (v2->val.type != Tlabel)
v2->scope = OutScope;
break;
case OutScope: break;
}
break;
case CloseSequential:
- if (v->val.type == &Tlabel)
+ if (v->val.type == Tlabel)
v->scope = PendingScope;
switch (v->scope) {
case InScope:
for (v2 = v;
v2 && v2->scope == PendingScope;
v2 = v2->previous)
- if (v2->val.type == &Tlabel) {
+ if (v2->val.type == Tlabel) {
v2->scope = CondScope;
v2->min_depth = c->scope_depth;
} else
struct type *t;
if (!prog)
- return &Tnone;
+ return Tnone;
switch (prog->type) {
case Xbinode:
}
## propagate exec cases
}
- return &Tnone;
+ return Tnone;
}
#### Interpreting
static struct value interp_exec(struct exec *e)
{
struct value rv;
- rv.type = &Tnone;
+ rv.type = Tnone;
if (!e)
return rv;
{
struct binode *b = cast(binode, e);
struct value left, right;
- left.type = right.type = &Tnone;
+ left.type = right.type = Tnone;
switch (b->op) {
## interp binode cases
}
$*val
Value -> True ${
$0 = new_pos(val, $1);
- $0->val.type = &Tbool;
+ $0->val.type = Tbool;
$0->val.bool = 1;
}$
| False ${
$0 = new_pos(val, $1);
- $0->val.type = &Tbool;
+ $0->val.type = Tbool;
$0->val.bool = 0;
}$
| NUMBER ${
$0 = new_pos(val, $1);
- $0->val.type = &Tnum;
+ $0->val.type = Tnum;
{
char tail[3];
if (number_parse($0->val.num, tail, $1.txt) == 0)
}$
| STRING ${
$0 = new_pos(val, $1);
- $0->val.type = &Tstr;
+ $0->val.type = Tstr;
{
char tail[3];
string_parse(&$1, '\\', &$0->val.str, tail);
}$
| MULTI_STRING ${
$0 = new_pos(val, $1);
- $0->val.type = &Tstr;
+ $0->val.type = Tstr;
{
char tail[3];
string_parse(&$1, '\\', &$0->val.str, tail);
case Xval:
{
struct val *v = cast(val, e);
- if (v->val.type == &Tstr)
+ if (v->val.type == Tstr)
printf("\"");
print_value(v->val);
- if (v->val.type == &Tstr)
+ if (v->val.type == Tstr)
printf("\"");
break;
}
v = var_ref(config2context(config), $1.txt);
$0->var = v;
type_err(config2context(config), "error: variable '%v' redeclared",
- $0, &Tnone, 0, &Tnone);
+ $0, Tnone, 0, Tnone);
type_err(config2context(config), "info: this is where '%v' was first declared",
- v->where_decl, &Tnone, 0, &Tnone);
+ v->where_decl, Tnone, 0, Tnone);
}
} }$
| IDENTIFIER ::= ${ {
v = var_ref(config2context(config), $1.txt);
$0->var = v;
type_err(config2context(config), "error: variable '%v' redeclared",
- $0, &Tnone, 0, &Tnone);
+ $0, Tnone, 0, Tnone);
type_err(config2context(config), "info: this is where '%v' was first declared",
- v->where_decl, &Tnone, 0, &Tnone);
+ v->where_decl, Tnone, 0, Tnone);
+ }
+ } }$
+ | IDENTIFIER : Type = ${ {
+ struct variable *v = var_decl(config2context(config), $1.txt);
+ $0 = new_pos(var, $1);
+ $0->var = v;
+ if (v) {
+ v->where_decl = $0;
+ v->where_set = $0;
+ v->val = val_init($<3);
+ } else {
+ v = var_ref(config2context(config), $1.txt);
+ $0->var = v;
+ type_err(config2context(config), "error: variable '%v' redeclared",
+ $0, Tnone, 0, Tnone);
+ type_err(config2context(config), "info: this is where '%v' was first declared",
+ v->where_decl, Tnone, 0, Tnone);
+ }
+ } }$
+ | IDENTIFIER :: Type = ${ {
+ struct variable *v = var_decl(config2context(config), $1.txt);
+ $0 = new_pos(var, $1);
+ $0->var = v;
+ if (v) {
+ v->where_decl = $0;
+ v->where_set = $0;
+ v->val = val_init($<3);
+ v->constant = 1;
+ } else {
+ v = var_ref(config2context(config), $1.txt);
+ $0->var = v;
+ type_err(config2context(config), "error: variable '%v' redeclared",
+ $0, Tnone, 0, Tnone);
+ type_err(config2context(config), "info: this is where '%v' was first declared",
+ v->where_decl, Tnone, 0, Tnone);
}
} }$
/* This might be a label - allocate a var just in case */
v = var_decl(config2context(config), $1.txt);
if (v) {
- v->val = val_init(&Tlabel);
+ v->val = val_init(Tlabel);
v->val.label = &v->val;
v->where_set = $0;
}
$0->var = v;
} }$
+ $*type
+ Type -> IDENTIFIER ${
+ $0 = find_type(config2context(config), $1.txt);
+ if (!$0) {
+ tok_err(config2context(config),
+ "error: undefined type", &$1);
+
+ $0 = Tnone;
+ }
+ }$
+
###### print exec cases
case Xvar:
{
struct var *var = cast(var, prog);
struct variable *v = var->var;
if (!v) {
- type_err(c, "%d:BUG: no variable!!", prog, &Tnone, 0, &Tnone);
+ type_err(c, "%d:BUG: no variable!!", prog, Tnone, 0, Tnone);
*ok = 0;
- return &Tnone;
+ return Tnone;
}
if (v->merged)
v = v->merged;
type_err(c, "error: expected %1%r but variable '%v' is %2", prog,
type, rules, v->val.type);
type_err(c, "info: this is where '%v' was set to %1", v->where_set,
- v->val.type, rules, &Tnone);
+ v->val.type, rules, Tnone);
*ok = 0;
}
if (!type)
Or,
Not,
-####### Grammar
+###### Grammar
$*exec
Expression -> Expression or BTerm ${ {
case Or:
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);
- if (type && type != &Tbool) {
+ propagate_types(b->left, c, ok, Tbool, 0);
+ propagate_types(b->right, c, ok, Tbool, 0);
+ if (type && type != Tbool) {
type_err(c, "error: %1 operation found where %2 expected", prog,
- &Tbool, 0, type);
+ Tbool, 0, type);
*ok = 0;
}
- return &Tbool;
+ return Tbool;
###### interp binode cases
case And:
if (t)
t = propagate_types(b->left, c, ok, t, 0);
}
- if (!vtype_compat(type, &Tbool, 0)) {
+ if (!vtype_compat(type, Tbool, 0)) {
type_err(c, "error: Comparison returns %1 but %2 expected", prog,
- &Tbool, rules, type);
+ Tbool, rules, type);
*ok = 0;
}
- return &Tbool;
+ return Tbool;
###### interp binode cases
case Less:
left = interp_exec(b->left);
right = interp_exec(b->right);
cmp = value_cmp(left, right);
- rv.type = &Tbool;
+ rv.type = Tbool;
switch (b->op) {
case Less: rv.bool = cmp < 0; break;
case LessEq: rv.bool = cmp <= 0; break;
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);
- if (!vtype_compat(type, &Tnum, 0)) {
+ propagate_types(b->left, c, ok, Tnum, 0);
+ propagate_types(b->right, c, ok, Tnum, 0);
+ if (!vtype_compat(type, Tnum, 0)) {
type_err(c, "error: Arithmetic returns %1 but %2 expected", prog,
- &Tnum, rules, type);
+ Tnum, rules, type);
*ok = 0;
}
- return &Tnum;
+ return Tnum;
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);
- if (!vtype_compat(type, &Tstr, 0)) {
+ propagate_types(b->left, c, ok, Tstr, 0);
+ propagate_types(b->right, c, ok, Tstr, 0);
+ if (!vtype_compat(type, Tstr, 0)) {
type_err(c, "error: Concat returns %1 but %2 expected", prog,
- &Tstr, rules, type);
+ Tstr, rules, type);
*ok = 0;
}
- return &Tstr;
+ return Tstr;
case Bracket:
return propagate_types(b->right, c, ok, type, 0);
case Concat:
left = interp_exec(b->left);
right = interp_exec(b->right);
- rv.type = &Tstr;
+ rv.type = Tstr;
rv.str = text_join(left.str, right.str);
break;
for (e = b; e; e = cast(binode, e->right)) {
t = propagate_types(e->left, c, ok, NULL, rules);
- if ((rules & Rboolok) && t == &Tbool)
+ if ((rules & Rboolok) && t == Tbool)
t = NULL;
- if (t && t != &Tnone && t != &Tbool) {
+ if (t && t != Tnone && t != Tbool) {
if (!type)
type = t;
else if (t != type) {
###### interp binode cases
case Block:
- while (rv.type == &Tnone &&
+ while (rv.type == Tnone &&
b) {
if (b->left)
rv = interp_exec(b->left);
sep = ' ';
} else if (sep)
eol = 0;
- left.type = &Tnone;
+ left.type = Tnone;
if (eol)
printf("\n");
break;
break;
case Declare:
+ {
+ struct variable *v = cast(var, b->left)->var;
do_indent(indent, "");
print_exec(b->left, indent, 0);
- if (cast(var, b->left)->var->constant)
- printf(" ::= ");
- else
- printf(" := ");
+ if (cast(var, b->left)->var->constant) {
+ if (v->where_decl == v->where_set)
+ printf("::%.*s = ", v->val.type->name.len,
+ v->val.type->name.txt);
+ else
+ printf(" ::= ");
+ } else {
+ if (v->where_decl == v->where_set)
+ printf(":%.*s = ", v->val.type->name.len,
+ v->val.type->name.txt);
+ else
+ printf(" := ");
+ }
print_exec(b->right, indent, 0);
if (indent >= 0)
printf("\n");
+ }
break;
###### propagate binode cases
if (propagate_types(b->right, c, ok, 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, &Tnone);
+ cast(var, b->left)->var->where_set, t, rules, Tnone);
} else {
t = propagate_types(b->right, c, ok, NULL, Rnolabel);
if (t)
propagate_types(b->left, c, ok, t, 0);
}
- return &Tnone;
+ return Tnone;
break;
struct cond_statement *cs = cast(cond_statement, prog);
struct casepart *cp;
- t = propagate_types(cs->forpart, c, ok, &Tnone, 0);
- if (!vtype_compat(&Tnone, t, 0))
+ t = propagate_types(cs->forpart, c, ok, Tnone, 0);
+ if (!vtype_compat(Tnone, t, 0))
*ok = 0;
- t = propagate_types(cs->dopart, c, ok, &Tnone, 0);
- if (!vtype_compat(&Tnone, t, 0))
+ t = propagate_types(cs->dopart, c, ok, Tnone, 0);
+ if (!vtype_compat(Tnone, t, 0))
*ok = 0;
if (cs->dopart) {
- t = propagate_types(cs->thenpart, c, ok, &Tnone, 0);
- if (!vtype_compat(&Tnone, t, 0))
+ t = propagate_types(cs->thenpart, c, ok, Tnone, 0);
+ if (!vtype_compat(Tnone, t, 0))
*ok = 0;
}
if (cs->casepart == NULL)
- propagate_types(cs->condpart, c, ok, &Tbool, 0);
+ propagate_types(cs->condpart, c, ok, Tbool, 0);
else {
/* Condpart must match case values, with bool permitted */
t = NULL;
if (c->condpart)
cnd = interp_exec(c->condpart);
else
- cnd.type = &Tnone;
- if (!(cnd.type == &Tnone ||
- (cnd.type == &Tbool && cnd.bool != 0)))
+ cnd.type = Tnone;
+ if (!(cnd.type == Tnone ||
+ (cnd.type == Tbool && cnd.bool != 0)))
break;
// cnd is Tnone or Tbool, doesn't need to be freed
if (c->dopart)
if (c->thenpart) {
v = interp_exec(c->thenpart);
- if (v.type != &Tnone || !c->dopart)
+ if (v.type != Tnone || !c->dopart)
return v;
free_value(v);
}
free_value(cnd);
if (c->elsepart)
return interp_exec(c->elsepart);
- v.type = &Tnone;
+ v.type = Tnone;
return v;
}
###### Parser: grammar
$*binode
- Program -> program OpenScope Varlist Block OptNL ${
+ Program -> InitProgram OpenScope Varlist Block OptNL ${
$0 = new(binode);
$0->op = Program;
$0->left = reorder_bilist($<3);
"error: unhandled parse error.", &$1);
}$
+ InitProgram -> program ${
+ context_init(config2context(config));
+ }$
+
Varlist -> Varlist ArgDecl ${
$0 = new(binode);
$0->op = Program;
return 0;
do {
ok = 1;
- propagate_types(b->right, c, &ok, &Tnone, 0);
+ propagate_types(b->right, c, &ok, Tnone, 0);
} while (ok == 2);
if (!ok)
return 0;
struct var *v = cast(var, b->left);
if (!v->var->val.type) {
v->var->where_set = b;
- v->var->val = val_init(&Tstr);
+ v->var->val = val_init(Tstr);
}
}
b = cast(binode, prog);
do {
ok = 1;
- propagate_types(b->right, c, &ok, &Tnone, 0);
+ propagate_types(b->right, c, &ok, Tnone, 0);
} while (ok == 2);
if (!ok)
return 0;
/* Make sure everything is still consistent */
- propagate_types(b->right, c, &ok, &Tnone, 0);
+ propagate_types(b->right, c, &ok, Tnone, 0);
return !!ok;
}
* merge happens, so types can be different
*/
if A * 2 > B:
- double := "yes"
+ double:string = "yes"
print A, "is more than twice", B, "?", double
else:
double := A*2
print "double", A, "is only", double
- a := A; b := B
+ a := A;
+ b:number = B
if a > 0 and b > 0:
while a != b:
if a < b: