- "blocks" of multiple statements.
- `pass`: a statement which does nothing.
- - expressions: `+`, `-`, `*`, `/` can apply to numbers and `++` can
+ - expressions: `+`, `-`, `*`, `/`, `%` can apply to numbers and `++` can
catenate strings. `and`, `or`, `not` manipulate Booleans, and
normal comparison operators can work on all three types.
- `print`: will print the values in a list of expressions.
case '%': fputc(*fmt, stderr); break;
default: fputc('?', stderr); break;
case '1':
- if (t1)
- fprintf(stderr, "%.*s", t1->name.len, t1->name.txt);
- else
- fputs("*unknown*", stderr);
+ type_print(t1, stderr);
break;
case '2':
- if (t2)
- fprintf(stderr, "%.*s", t2->name.len, t2->name.txt);
- else
- fputs("*unknown*", stderr);
- break;
+ type_print(t2, stderr);
break;
## format cases
}
struct value (*prepare)(struct type *type);
struct value (*parse)(struct type *type, char *str);
void (*print)(struct value val);
+ void (*print_type)(struct type *type, FILE *f);
int (*cmp_order)(struct value v1, struct value v2);
int (*cmp_eq)(struct value v1, struct value v2);
struct value (*dup)(struct value val);
void (*free)(struct value val);
- struct type *(*compat)(struct type *this, struct type *other);
+ int (*compat)(struct type *this, struct type *other);
long long (*to_int)(struct value *v);
double (*to_float)(struct value *v);
int (*to_mpq)(mpq_t *q, struct value *v);
v.type->free(v);
}
+ static int type_compat(struct type *require, struct type *have, int rules)
+ {
+ if ((rules & Rboolok) && have == Tbool)
+ return 1;
+ if ((rules & Rnolabel) && have == Tlabel)
+ return 0;
+ if (!require || !have)
+ return 1;
+
+ if (require->compat)
+ return require->compat(require, have);
+
+ return require == have;
+ }
+
+ static void type_print(struct type *type, FILE *f)
+ {
+ if (!type)
+ fputs("*unknown*type*", f);
+ 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);
+ }
+
static struct value val_prepare(struct type *type)
{
struct value rv;
}
}
- static int vtype_compat(struct type *require, struct type *have, int rules)
- {
- if ((rules & Rboolok) && have == Tbool)
- return 1;
- if ((rules & Rnolabel) && have == Tlabel)
- return 0;
- if (!require || !have)
- return 1;
-
- return require == have;
- }
-
###### value functions
static struct value _val_prepare(struct type *type)
###### ast
- enum val_rules {Rnolabel = 1<<0, Rboolok = 1<<1};
+ enum val_rules {Rnolabel = 1<<0, Rboolok = 1<<1, Rnoconstant = 2<<1};
###### format cases
case 'r':
###### core functions
+ struct lrval {
+ struct value val, *lval;
+ };
+
+ static struct lrval _interp_exec(struct exec *e);
+
static struct value interp_exec(struct exec *e)
{
- struct value rv;
+ struct lrval ret = _interp_exec(e);
+
+ if (ret.lval)
+ return dup_value(*ret.lval);
+ else
+ return ret.val;
+ }
+
+ static struct value *linterp_exec(struct exec *e)
+ {
+ struct lrval ret = _interp_exec(e);
+
+ return ret.lval;
+ }
+
+ static struct lrval _interp_exec(struct exec *e)
+ {
+ struct lrval ret;
+ struct value rv, *lrv = NULL;
rv.type = Tnone;
- if (!e)
- return rv;
+ if (!e) {
+ ret.lval = lrv;
+ ret.val = rv;
+ return ret;
+ }
switch(e->type) {
case Xbinode:
{
struct binode *b = cast(binode, e);
- struct value left, right;
+ struct value left, right, *lleft;
left.type = right.type = Tnone;
switch (b->op) {
## interp binode cases
}
## interp exec cases
}
- return rv;
+ ret.lval = lrv;
+ ret.val = rv;
+ return ret;
}
## Language elements
case Xval:
{
struct val *val = cast(val, prog);
- if (!vtype_compat(type, val->val.type, rules)) {
+ if (!type_compat(type, val->val.type, rules)) {
type_err(c, "error: expected %1%r found %2",
prog, type, rules, val->val.type);
*ok = 0;
###### interp exec cases
case Xval:
- return dup_value(cast(val, e)->val);
+ rv = dup_value(cast(val, e)->val);
+ break;
###### ast functions
static void free_val(struct val *v)
}
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);
+ *ok = 0;
+ return v->val.type;
+ }
if (v->val.type == NULL) {
if (type && *ok != 0) {
v->val = val_prepare(type);
}
return type;
}
- if (!vtype_compat(type, v->val.type, rules)) {
+ if (!type_compat(type, v->val.type, rules)) {
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,
if (v->merged)
v = v->merged;
- return dup_value(v->val);
+ lrv = &v->val;
+ break;
}
###### ast functions
if (t)
t = propagate_types(b->left, c, ok, t, 0);
}
- if (!vtype_compat(type, Tbool, 0)) {
+ if (!type_compat(type, Tbool, 0)) {
type_err(c, "error: Comparison returns %1 but %2 expected", prog,
Tbool, rules, type);
*ok = 0;
###### Binode types
Plus, Minus,
- Times, Divide,
+ Times, Divide, Rem,
Concat,
Absolute, Negate,
Bracket,
Top -> * ${ $0.op = Times; }$
| / ${ $0.op = Divide; }$
+ | % ${ $0.op = Rem; }$
| ++ ${ $0.op = Concat; }$
###### print binode cases
case Times:
case Divide:
case Concat:
+ case Rem:
print_exec(b->left, indent, 0);
switch(b->op) {
- case Plus: printf(" + "); break;
- case Minus: printf(" - "); break;
- case Times: printf(" * "); break;
- case Divide: printf(" / "); break;
- case Concat: printf(" ++ "); break;
+ case Plus: fputs(" + ", stdout); break;
+ case Minus: fputs(" - ", stdout); break;
+ case Times: fputs(" * ", stdout); break;
+ case Divide: fputs(" / ", stdout); break;
+ case Rem: fputs(" % ", stdout); break;
+ case Concat: fputs(" ++ ", stdout); break;
default: abort();
}
print_exec(b->right, indent, 0);
case Plus:
case Minus:
case Times:
+ case Rem:
case Divide:
/* both must be numbers, result is Tnum */
case Absolute:
* 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)) {
+ if (!type_compat(type, Tnum, 0)) {
type_err(c, "error: Arithmetic returns %1 but %2 expected", prog,
Tnum, rules, type);
*ok = 0;
/* 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)) {
+ if (!type_compat(type, Tstr, 0)) {
type_err(c, "error: Concat returns %1 but %2 expected", prog,
Tstr, rules, type);
*ok = 0;
right = interp_exec(b->right);
mpq_div(rv.num, rv.num, right.num);
break;
+ case Rem: {
+ mpz_t l, r, rem;
+
+ left = interp_exec(b->left);
+ right = interp_exec(b->right);
+ mpz_init(l); mpz_init(r); mpz_init(rem);
+ mpz_tdiv_q(l, mpq_numref(left.num), mpq_denref(left.num));
+ mpz_tdiv_q(r, mpq_numref(right.num), mpq_denref(right.num));
+ mpz_tdiv_r(rem, l, r);
+ rv = val_init(Tnum);
+ mpq_set_z(rv.num, rem);
+ mpz_clear(r); mpz_clear(l); mpz_clear(rem);
+ break;
+ }
case Negate:
rv = interp_exec(b->right);
mpq_neg(rv.num, rv.num);
Declare,
###### SimpleStatement Grammar
- | Variable = Expression ${ {
- struct var *v = cast(var, $1);
-
+ | Variable = Expression ${
$0 = new(binode);
$0->op = Assign;
$0->left = $<1;
$0->right = $<3;
- if (v->var && v->var->constant) {
- type_err(config2context(config), "Cannot assign to a constant: %v",
- $0->left, NULL, 0, NULL);
- type_err(config2context(config), "name was defined as a constant here",
- v->var->where_decl, NULL, 0, NULL);
- }
- } }$
+ }$
| VariableDecl = Expression ${
$0 = new(binode);
$0->op = Declare;
do_indent(indent, "");
print_exec(b->left, indent, 0);
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
+ if (v->where_decl == v->where_set) {
+ printf("::");
+ type_print(v->val.type, stdout);
+ printf(" ");
+ } else
printf(" ::");
} else {
- if (v->where_decl == v->where_set)
- printf(":%.*s ", v->val.type->name.len,
- v->val.type->name.txt);
- else
+ if (v->where_decl == v->where_set) {
+ printf(":");
+ type_print(v->val.type, stdout);
+ printf(" ");
+ } else
printf(" :");
}
if (b->right) {
case Declare:
/* Both must match and not be labels,
* Type must support 'dup',
- * result is Tnone */
- t = propagate_types(b->left, c, ok, NULL, Rnolabel);
+ * For Assign, left must not be constant.
+ * result is Tnone
+ */
+ t = propagate_types(b->left, c, ok, NULL,
+ Rnolabel | (b->op == Assign ? Rnoconstant : 0));
if (!b->right)
return Tnone;
} else {
t = propagate_types(b->right, c, ok, NULL, Rnolabel);
if (t)
- propagate_types(b->left, c, ok, t, 0);
+ propagate_types(b->left, c, ok, t,
+ (b->op == Assign ? Rnoconstant : 0));
}
if (t && t->dup == NULL) {
type_err(c, "error: cannot assign value of type %1", b, t, 0, NULL);
###### interp binode cases
case Assign:
- {
- struct variable *v = cast(var, b->left)->var;
- if (v->merged)
- v = v->merged;
+ lleft = linterp_exec(b->left);
right = interp_exec(b->right);
- free_value(v->val);
- v->val = right;
+ if (lleft) {
+ free_value(*lleft);
+ *lleft = right;
+ } else
+ free_value(right);
right.type = NULL;
break;
- }
case Declare:
{
struct casepart *cp;
t = propagate_types(cs->forpart, c, ok, Tnone, 0);
- if (!vtype_compat(Tnone, t, 0))
+ if (!type_compat(Tnone, t, 0))
*ok = 0;
t = propagate_types(cs->dopart, c, ok, Tnone, 0);
- if (!vtype_compat(Tnone, t, 0))
+ if (!type_compat(Tnone, t, 0))
*ok = 0;
if (cs->dopart) {
t = propagate_types(cs->thenpart, c, ok, Tnone, 0);
- if (!vtype_compat(Tnone, t, 0))
+ if (!type_compat(Tnone, t, 0))
*ok = 0;
}
if (cs->casepart == NULL)
interp_exec(c->dopart);
if (c->thenpart) {
- v = interp_exec(c->thenpart);
- if (v.type != Tnone || !c->dopart)
- return v;
- free_value(v);
+ rv = interp_exec(c->thenpart);
+ if (rv.type != Tnone || !c->dopart)
+ goto Xcond_done;
+ free_value(rv);
}
} while (c->dopart);
if (value_cmp(v, cnd) == 0) {
free_value(v);
free_value(cnd);
- return interp_exec(cp->action);
+ rv = interp_exec(cp->action);
+ goto Xcond_done;
}
free_value(v);
}
free_value(cnd);
if (c->elsepart)
- return interp_exec(c->elsepart);
- v.type = Tnone;
- return v;
+ rv = interp_exec(c->elsepart);
+ else
+ rv.type = Tnone;
+ Xcond_done:
+ break;
}
### Finally the whole program.
/* If a variable is not used after the 'if', no
* merge happens, so types can be different
*/
- if A * 2 > B:
+ if A > B * 2:
double:string = "yes"
print A, "is more than twice", B, "?", double
else:
- double := A*2
- print "double", A, "is only", double
+ double := B*2
+ print "double", B, "is", double
a : number
a = A;
code / ocean / blobdiff