]> ocean-lang.org Git - ocean/blobdiff - csrc/oceani.mdc
oceani: mark code that doesn't need testing.
[ocean] / csrc / oceani.mdc
index a0fd796bbcc0478881dc15cadc9948be3f7a1f44..de899a2524d91d79f740bd2582874aa5fe7a018d 100644 (file)
@@ -47,7 +47,7 @@ Elements which are present to make a usable language are:
 
  - "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.
@@ -375,20 +375,13 @@ context so indicate that parsing failed.
                        }
                        fmt++;
                        switch (*fmt) {
-                       case '%': fputc(*fmt, stderr); break;
-                       default: fputc('?', stderr); break;
+                       case '%': fputc(*fmt, stderr); break;   // NOTEST
+                       default: fputc('?', stderr); break;     // NOTEST
                        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
                        }
@@ -450,6 +443,7 @@ which are often passed around by value.
                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);
@@ -520,6 +514,18 @@ which are often passed around by value.
                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);     // NOTEST
+       }
+
        static struct value val_prepare(struct type *type)
        {
                struct value rv;
@@ -561,7 +567,7 @@ which are often passed around by value.
                if (v.type && v.type->print)
                        v.type->print(v);
                else
-                       printf("*Unknown*");
+                       printf("*Unknown*");            // NOTEST
        }
 
        static struct value parse_value(struct type *type, char *arg)
@@ -570,10 +576,21 @@ which are often passed around by value.
 
                if (type && type->parse)
                        return type->parse(type, arg);
-               rv.type = NULL;
-               return rv;
+               rv.type = NULL;                         // NOTEST
+               return rv;                              // NOTEST
        }
 
+###### forward decls
+
+       static void free_value(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 struct value val_init(struct type *type);
+       static struct value dup_value(struct value v);
+       static int value_cmp(struct value left, struct value right);
+       static void print_value(struct value v);
+       static struct value parse_value(struct type *type, char *arg);
+
 ###### free context types
 
        while (context.typelist) {
@@ -668,8 +685,8 @@ to parse each type from a string.
 
                rv.type = type;
                switch(type->vtype) {
-               case Vnone:
-                       break;
+               case Vnone:             // NOTEST
+                       break;          // NOTEST
                case Vnum:
                        mpq_init(rv.num); break;
                case Vstr:
@@ -679,9 +696,9 @@ to parse each type from a string.
                case Vbool:
                        rv.bool = 0;
                        break;
-               case Vlabel:
-                       rv.label = NULL;
-                       break;
+               case Vlabel:                    // NOTEST
+                       rv.label = NULL;        // NOTEST
+                       break;                  // NOTEST
                }
                return rv;
        }
@@ -691,8 +708,8 @@ to parse each type from a string.
                struct value rv;
                rv.type = v.type;
                switch (rv.type->vtype) {
-               case Vnone:
-                       break;
+               case Vnone:             // NOTEST
+                       break;          // NOTEST
                case Vlabel:
                        rv.label = v.label;
                        break;
@@ -716,13 +733,13 @@ to parse each type from a string.
        {
                int cmp;
                if (left.type != right.type)
-                       return left.type - right.type;
+                       return left.type - right.type;  // NOTEST
                switch (left.type->vtype) {
                case Vlabel: cmp = left.label == right.label ? 0 : 1; break;
                case Vnum: cmp = mpq_cmp(left.num, right.num); break;
                case Vstr: cmp = text_cmp(left.str, right.str); break;
                case Vbool: cmp = left.bool - right.bool; break;
-               case Vnone: cmp = 0;
+               case Vnone: cmp = 0;                    // NOTEST
                }
                return cmp;
        }
@@ -730,10 +747,10 @@ to parse each type from a string.
        static void _print_value(struct value v)
        {
                switch (v.type->vtype) {
-               case Vnone:
-                       printf("*no-value*"); break;
-               case Vlabel:
-                       printf("*label-%p*", v.label); break;
+               case Vnone:                             // NOTEST
+                       printf("*no-value*"); break;    // NOTEST
+               case Vlabel:                            // NOTEST
+                       printf("*label-%p*", v.label); break; // NOTEST
                case Vstr:
                        printf("%.*s", v.str.len, v.str.txt); break;
                case Vbool:
@@ -759,10 +776,10 @@ to parse each type from a string.
 
                val.type = type;
                switch(type->vtype) {
-               case Vlabel:
-               case Vnone:
-                       val.type = NULL;
-                       break;
+               case Vlabel:                            // NOTEST
+               case Vnone:                             // NOTEST
+                       val.type = NULL;                // NOTEST
+                       break;                          // NOTEST
                case Vstr:
                        val.str.len = strlen(arg);
                        val.str.txt = malloc(val.str.len);
@@ -1299,6 +1316,8 @@ subclasses, and to access these we need to be able to `cast` the
 
        static int __fput_loc(struct exec *loc, FILE *f)
        {
+               if (!loc)
+                       return 0;               // NOTEST
                if (loc->line >= 0) {
                        fprintf(f, "%d:%d: ", loc->line, loc->column);
                        return 1;
@@ -1311,7 +1330,7 @@ subclasses, and to access these we need to be able to `cast` the
        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
@@ -1382,7 +1401,7 @@ also want to know what sort of bracketing to use.
        static void print_exec(struct exec *e, int indent, int bracket)
        {
                if (!e)
-                       return;
+                       return;         // NOTEST
                switch (e->type) {
                case Xbinode:
                        print_binode(cast(binode, e), indent, bracket); break;
@@ -1409,7 +1428,7 @@ propagation is needed.
 
 ###### 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':
@@ -1453,18 +1472,45 @@ Each `exec` can return a value, which may be `Tnone` but must be non-NULL;
 
 ###### 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
@@ -1474,7 +1520,240 @@ Each `exec` can return a value, which may be `Tnone` but must be non-NULL;
                }
                ## interp exec cases
                }
-               return rv;
+               ret.lval = lrv;
+               ret.val = rv;
+               return ret;
+       }
+
+### Complex types
+
+Now that we have the shape of the interpreter in place we can add some
+complex types and connected them in to the data structures and the
+different phases of parse, analyse, print, interpret.
+
+For now, just arrays.
+
+#### Arrays
+
+Arrays can be declared by giving a size and a type, as `[size]type' so
+`freq:[26]number` declares `freq` to be an array of 26 numbers.  The
+size can be an arbitrary expression which is evaluated when the name
+comes into scope.
+
+Arrays cannot be assigned.  When pointers are introduced we will also
+introduce array slices which can refer to part or all of an array -
+the assignment syntax will create a slice.  For now, an array can only
+ever be referenced by the name it is declared with.  It is likely that
+a "`copy`" primitive will eventually be define which can be used to
+make a copy of an array with controllable depth.
+
+###### type union fields
+
+       struct {
+               int size;
+               struct variable *vsize;
+               struct type *member;
+       } array;
+
+###### value union fields
+       struct {
+               struct value *elmnts;
+       } array;
+
+###### value functions
+
+       static struct value array_prepare(struct type *type)
+       {
+               struct value ret;
+
+               ret.type = type;
+               ret.array.elmnts = NULL;
+               return ret;
+       }
+
+       static struct value array_init(struct type *type)
+       {
+               struct value ret;
+               int i;
+
+               ret.type = type;
+               if (type->array.vsize) {
+                       mpz_t q;
+                       mpz_init(q);
+                       mpz_tdiv_q(q, mpq_numref(type->array.vsize->val.num),
+                                  mpq_denref(type->array.vsize->val.num));
+                       type->array.size = mpz_get_si(q);
+                       mpz_clear(q);
+               }
+               ret.array.elmnts = calloc(type->array.size,
+                                         sizeof(ret.array.elmnts[0]));
+               for (i = 0; ret.array.elmnts && i < type->array.size; i++)
+                       ret.array.elmnts[i] = val_init(type->array.member);
+               return ret;
+       }
+
+       static void array_free(struct value val)
+       {
+               int i;
+
+               if (val.array.elmnts)
+                       for (i = 0; i < val.type->array.size; i++)
+                               free_value(val.array.elmnts[i]);
+               free(val.array.elmnts);
+       }
+
+       static int array_compat(struct type *require, struct type *have)
+       {
+               if (have->compat != require->compat)
+                       return 0;
+               /* Both are arrays, so we can look at details */
+               if (!type_compat(require->array.member, have->array.member, 0))
+                       return 0;
+               if (require->array.vsize == NULL && have->array.vsize == NULL)
+                       return require->array.size == have->array.size;
+
+               return require->array.vsize == have->array.vsize;
+       }
+
+       static void array_print_type(struct type *type, FILE *f)
+       {
+               fputs("[", f);
+               if (type->array.vsize) {
+                       struct binding *b = type->array.vsize->name;
+                       fprintf(f, "%.*s]", b->name.len, b->name.txt);
+               } else
+                       fprintf(f, "%d]", type->array.size);
+               type_print(type->array.member, f);
+       }
+
+       static struct type array_prototype = {
+               .prepare = array_prepare,
+               .init = array_init,
+               .print_type = array_print_type,
+               .compat = array_compat,
+               .free = array_free,
+       };
+
+###### type grammar
+
+       | [ NUMBER ] Type ${
+               $0 = calloc(1, sizeof(struct type));
+               *($0) = array_prototype;
+               $0->array.member = $<4;
+               $0->array.vsize = NULL;
+               {
+               struct parse_context *c = config2context(config);
+               char tail[3];
+               mpq_t num;
+               if (number_parse(num, tail, $2.txt) == 0)
+                       tok_err(c, "error: unrecognised number", &$2);
+               else if (tail[0])
+                       tok_err(c, "error: unsupported number suffix", &$2);
+               else {
+                       $0->array.size = 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);
+                       } else if (mpz_cmp_ui(mpq_numref(num), 1UL << 30) >= 0)
+                               tok_err(c, "error: array size is too large",
+                                       &$2);
+                       mpq_clear(num);
+               }
+               $0->next= c->anon_typelist;
+               c->anon_typelist = $0;
+               }
+       }$
+
+       | [ IDENTIFIER ] Type ${ {
+               struct parse_context *c = config2context(config);
+               struct variable *v = var_ref(c, $2.txt);
+
+               if (!v)
+                       tok_err(config2context(config), "error: name undeclared", &$2);
+               else if (!v->constant)
+                       tok_err(config2context(config), "error: array size must be a constant", &$2);
+
+               $0 = calloc(1, sizeof(struct type));
+               *($0) = array_prototype;
+               $0->array.member = $<4;
+               $0->array.size = 0;
+               $0->array.vsize = v;
+               $0->next= c->anon_typelist;
+               c->anon_typelist = $0;
+       } }$
+
+###### parse context
+
+       struct type *anon_typelist;
+
+###### free context types
+
+       while (context.anon_typelist) {
+               struct type *t = context.anon_typelist;
+
+               context.anon_typelist = t->next;
+               free(t);
+       }
+
+###### Binode types
+       Index,
+
+###### variable grammar
+
+       | Variable [ Expression ] ${ {
+               struct binode *b = new(binode);
+               b->op = Index;
+               b->left = $<1;
+               b->right = $<3;
+               $0 = b;
+       } }$
+
+###### print binode cases
+       case Index:
+               print_exec(b->left, -1, 0);
+               printf("[");
+               print_exec(b->right, -1, 0);
+               printf("]");
+               break;
+
+###### propagate binode cases
+       case Index:
+               /* 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);
+               if (!t || t->compat != array_compat) {
+                       type_err(c, "error: %1 cannot be indexed", prog, t, 0, NULL);
+                       *ok = 0;
+                       return NULL;
+               } else {
+                       if (!type_compat(type, t->array.member, rules)) {
+                               type_err(c, "error: have %1 but need %2", prog,
+                                        t->array.member, rules, type);
+                               *ok = 0;
+                       }
+                       return t->array.member;
+               }
+               break;
+
+###### interp binode cases
+       case Index: {
+               mpz_t q;
+               long i;
+
+               lleft = linterp_exec(b->left);
+               right = interp_exec(b->right);
+               mpz_init(q);
+               mpz_tdiv_q(q, mpq_numref(right.num), mpq_denref(right.num));
+               i = mpz_get_si(q);
+               mpz_clear(q);
+
+               if (i >= 0 && i < lleft->type->array.size)
+                       lrv = &lleft->array.elmnts[i];
+               else
+                       rv = val_init(lleft->type->array.member);
+               break;
        }
 
 ## Language elements
@@ -1573,7 +1852,8 @@ an executable.
 
 ###### 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)
@@ -1696,6 +1976,7 @@ link to find the primary instance.
                }
        } }$
 
+       $*exec
        Variable -> IDENTIFIER ${ {
                struct variable *v = var_ref(config2context(config), $1.txt);
                $0 = new_pos(var, $1);
@@ -1708,8 +1989,9 @@ link to find the primary instance.
                                v->where_set = $0;
                        }
                }
-               $0->var = v;
+               cast(var, $0)->var = v;
        } }$
+       ## variable grammar
 
        $*type
        Type -> IDENTIFIER ${
@@ -1721,6 +2003,7 @@ link to find the primary instance.
                        $0 = Tnone;
                }
        }$
+       ## type grammar
 
 ###### print exec cases
        case Xvar:
@@ -1741,9 +2024,9 @@ link to find the primary instance.
                                struct binding *b = v->var->name;
                                fprintf(stderr, "%.*s", b->name.len, b->name.txt);
                        } else
-                               fputs("???", stderr);
+                               fputs("???", stderr);   // NOTEST
                } else
-                       fputs("NOTVAR", stderr);
+                       fputs("NOTVAR", stderr);        // NOTEST
                break;
 
 ###### propagate exec cases
@@ -1753,12 +2036,20 @@ link to find the primary instance.
                struct var *var = cast(var, prog);
                struct variable *v = var->var;
                if (!v) {
-                       type_err(c, "%d:BUG: no variable!!", prog, Tnone, 0, Tnone);
-                       *ok = 0;
-                       return Tnone;
+                       type_err(c, "%d:BUG: no variable!!", prog, Tnone, 0, Tnone); // NOTEST
+                       *ok = 0;                                        // 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);
+                       *ok = 0;
+                       return v->val.type;
+               }
                if (v->val.type == NULL) {
                        if (type && *ok != 0) {
                                v->val = val_prepare(type);
@@ -1787,7 +2078,8 @@ link to find the primary instance.
 
                if (v->merged)
                        v = v->merged;
-               return dup_value(v->val);
+               lrv = &v->val;
+               break;
        }
 
 ###### ast functions
@@ -1800,30 +2092,111 @@ link to find the primary instance.
 ###### free exec cases
        case Xvar: free_var(cast(var, e)); break;
 
+### Expressions: Conditional
+
+Our first user of the `binode` will be conditional expressions, which
+is a bit odd as they actually have three components.  That will be
+handled by having 2 binodes for each expression.  The conditional
+expression is the lowest precedence operatior, so it gets to define
+what an "Expression" is.  The next level up is "BoolExpr", which
+comes next.
+
+Conditional expressions are of the form "value `if` condition `else`
+other_value".  There is no associativite with this operator: the
+values and conditions can only be other conditional expressions if
+they are enclosed in parentheses.  Allowing nesting without
+parentheses would be too confusing.
+
+###### Binode types
+       CondExpr,
+
+###### Grammar
+
+       $*exec
+       Expression -> BoolExpr if BoolExpr else BoolExpr ${ {
+                       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;
+               } }$
+               | BoolExpr ${ $0 = $<1; }$
+
+###### print binode cases
+
+       case CondExpr:
+               b2 = cast(binode, b->right);
+               print_exec(b2->left, -1, 0);
+               printf(" if ");
+               print_exec(b->left, -1, 0);
+               printf(" else ");
+               print_exec(b2->right, -1, 0);
+               break;
+
+###### propagate binode cases
+
+       case CondExpr: {
+               /* cond must be Tbool, others must match */
+               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);
+               return t ?: t2;
+       }
+
+###### interp binode cases
+
+       case CondExpr: {
+               struct binode *b2 = cast(binode, b->right);
+               left = interp_exec(b->left);
+               if (left.bool)
+                       rv = interp_exec(b2->left);
+               else
+                       rv = interp_exec(b2->right);
+               }
+               break;
+
 ### Expressions: Boolean
 
-Our first user of the `binode` will be expressions, and particularly
-Boolean expressions.  As I haven't implemented precedence in the
-parser generator yet, we need different names for each precedence
-level used by expressions.  The outer most or lowest level precedence
-are Boolean `or` `and`, and `not` which form an `Expression` out of `BTerm`s
-and `BFact`s.
+The next class of expressions to use the `binode` will be Boolean
+expressions.  As I haven't implemented precedence in the parser
+generator yet, we need different names for each precedence level used
+by expressions.  The outer most or lowest level precedence are
+conditional expressions are Boolean operators which form an `BoolExpr`
+out of `BTerm`s and `BFact`s.  As well as `or` `and`, and `not` we
+have `and then` and `or else` which only evaluate the second operand
+if the result would make a difference.
 
 ###### Binode types
        And,
+       AndThen,
        Or,
+       OrElse,
        Not,
 
 ###### Grammar
 
        $*exec
-       Expression -> Expression or BTerm ${ {
+       BoolExpr -> BoolExpr or BTerm ${ {
                        struct binode *b = new(binode);
                        b->op = Or;
                        b->left = $<1;
                        b->right = $<3;
                        $0 = b;
                } }$
+               | BoolExpr or else BTerm ${ {
+                       struct binode *b = new(binode);
+                       b->op = OrElse;
+                       b->left = $<1;
+                       b->right = $<4;
+                       $0 = b;
+               } }$
                | BTerm ${ $0 = $<1; }$
 
        BTerm -> BTerm and BFact ${ {
@@ -1833,6 +2206,13 @@ and `BFact`s.
                        b->right = $<3;
                        $0 = b;
                } }$
+               | BTerm and then BFact ${ {
+                       struct binode *b = new(binode);
+                       b->op = AndThen;
+                       b->left = $<1;
+                       b->right = $<4;
+                       $0 = b;
+               } }$
                | BFact ${ $0 = $<1; }$
 
        BFact -> not BFact ${ {
@@ -1849,11 +2229,21 @@ and `BFact`s.
                printf(" and ");
                print_exec(b->right, -1, 0);
                break;
+       case AndThen:
+               print_exec(b->left, -1, 0);
+               printf(" and then ");
+               print_exec(b->right, -1, 0);
+               break;
        case Or:
                print_exec(b->left, -1, 0);
                printf(" or ");
                print_exec(b->right, -1, 0);
                break;
+       case OrElse:
+               print_exec(b->left, -1, 0);
+               printf(" or else ");
+               print_exec(b->right, -1, 0);
+               break;
        case Not:
                printf("not ");
                print_exec(b->right, -1, 0);
@@ -1861,7 +2251,9 @@ and `BFact`s.
 
 ###### propagate binode cases
        case And:
+       case AndThen:
        case Or:
+       case OrElse:
        case Not:
                /* both must be Tbool, result is Tbool */
                propagate_types(b->left, c, ok, Tbool, 0);
@@ -1879,11 +2271,21 @@ and `BFact`s.
                right = interp_exec(b->right);
                rv.bool = rv.bool && right.bool;
                break;
+       case AndThen:
+               rv = interp_exec(b->left);
+               if (rv.bool)
+                       rv = interp_exec(b->right);
+               break;
        case Or:
                rv = interp_exec(b->left);
                right = interp_exec(b->right);
                rv.bool = rv.bool || right.bool;
                break;
+       case OrElse:
+               rv = interp_exec(b->left);
+               if (!rv.bool)
+                       rv = interp_exec(b->right);
+               break;
        case Not:
                rv = interp_exec(b->right);
                rv.bool = !rv.bool;
@@ -1955,7 +2357,7 @@ expression operator.
                case GtrEq:  printf(" >= "); break;
                case Eql:    printf(" == "); break;
                case NEql:   printf(" != "); break;
-               default: abort();
+               default: abort();               // NOTEST
                }
                print_exec(b->right, -1, 0);
                break;
@@ -2003,7 +2405,7 @@ expression operator.
                case GtrEq:     rv.bool = cmp >= 0; break;
                case Eql:       rv.bool = cmp == 0; break;
                case NEql:      rv.bool = cmp != 0; break;
-               default: rv.bool = 0; break;
+               default: rv.bool = 0; break;    // NOTEST
                }
                break;
        }
@@ -2024,7 +2426,7 @@ precedence is handled better I might be able to discard this.
 
 ###### Binode types
        Plus, Minus,
-       Times, Divide,
+       Times, Divide, Rem,
        Concat,
        Absolute, Negate,
        Bracket,
@@ -2074,6 +2476,7 @@ precedence is handled better I might be able to discard this.
 
        Top ->    * ${ $0.op = Times; }$
                | / ${ $0.op = Divide; }$
+               | % ${ $0.op = Rem; }$
                | ++ ${ $0.op = Concat; }$
 
 ###### print binode cases
@@ -2082,15 +2485,17 @@ precedence is handled better I might be able to discard this.
        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;
-               default: abort();
-               }
+               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();       // NOTEST
+               }                       // NOTEST
                print_exec(b->right, indent, 0);
                break;
        case Absolute:
@@ -2111,6 +2516,7 @@ precedence is handled better I might be able to discard this.
        case Plus:
        case Minus:
        case Times:
+       case Rem:
        case Divide:
                /* both must be numbers, result is Tnum */
        case Absolute:
@@ -2162,6 +2568,20 @@ precedence is handled better I might be able to discard this.
                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);
@@ -2482,20 +2902,12 @@ it is declared, and error will be raised as the name is created as
        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;
@@ -2532,16 +2944,18 @@ it is declared, and error will be raised as the name is created as
                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) {
@@ -2559,8 +2973,11 @@ it is declared, and error will be raised as the name is created as
        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;
 
@@ -2572,7 +2989,8 @@ it is declared, and error will be raised as the name is created as
                } 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);
@@ -2585,16 +3003,15 @@ it is declared, and error will be raised as the name is created as
 ###### 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);      // NOTEST
                right.type = NULL;
                break;
-       }
 
        case Declare:
        {
@@ -3101,10 +3518,10 @@ defined.
                                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);
 
@@ -3113,15 +3530,18 @@ defined.
                        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.
@@ -3190,7 +3610,7 @@ analysis is a bit more interesting at this level.
                break;
 
 ###### propagate binode cases
-       case Program: abort();
+       case Program: abort();          // NOTEST
 
 ###### core functions
 
@@ -3200,7 +3620,7 @@ analysis is a bit more interesting at this level.
                int ok = 1;
 
                if (!b)
-                       return 0;
+                       return 0;       // NOTEST
                do {
                        ok = 1;
                        propagate_types(b->right, c, &ok, Tnone, 0);
@@ -3235,7 +3655,7 @@ analysis is a bit more interesting at this level.
                struct value v;
 
                if (!prog)
-                       return;
+                       return;         // NOTEST
                al = cast(binode, p->left);
                while (al) {
                        struct var *v = cast(var, al->left);
@@ -3257,7 +3677,7 @@ analysis is a bit more interesting at this level.
        }
 
 ###### interp binode cases
-       case Program: abort();
+       case Program: abort();  // NOTEST
 
 ## And now to test it out.
 
@@ -3287,17 +3707,17 @@ Fibonacci, and performs a binary search for a number.
                /* 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;
                b:number = B
-               if a > 0 and b > 0:
+               if a > 0 and then b > 0:
                        while a != b:
                                if a < b:
                                        b = b - a
@@ -3341,3 +3761,24 @@ Fibonacci, and performs a binary search for a number.
                        print "Yay, I found", target
                case GiveUp:
                        print "Closest I found was", mid
+
+               size::=55
+               list:[size]number
+               list[0] = 1234
+               for i:=1; then i = i + 1; while i < size:
+                       n := list[i-1] * list[i-1]
+                       list[i] = (n / 100) % 10000
+
+               print "Before sort:"
+               for i:=0; then i = i + 1; while i < size:
+                       print "list[",i,"]=",list[i]
+
+               for i := 1; then i=i+1; while i < size:
+                       for j:=i-1; then j=j-1; while j >= 0:
+                               if list[j] > list[j+1]:
+                                       t:= list[j]
+                                       list[j] = list[j+1]
+                                       list[j+1] = t
+               print "After sort:"
+               for i:=0; then i = i + 1; while i < size:
+                       print "list[",i,"]=",list[i]