oceani: prepare for adding new types with new syntax.

[ocean] / csrc / oceani.mdc

diff --git a/csrc/oceani.mdc b/csrc/oceani.mdc
index 07606745a481a5b7ec174660a6a17e0c23086db0..9ab456a629badad65780a72cc1d10e366cd29ced 100644 (file)
--- a/csrc/oceani.mdc
+++ b/csrc/oceani.mdc
@@ -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.
@@ -580,6 +580,17 @@ which are often passed around by value.
                return rv;
        }
 
+###### 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) {
@@ -1459,18 +1470,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
@@ -1480,7 +1518,9 @@ 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;
        }
 
 ## Language elements
@@ -1579,7 +1619,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)
@@ -1702,6 +1743,7 @@ link to find the primary instance.
                }
        } }$
 
+       $*exec
        Variable -> IDENTIFIER ${ {
                struct variable *v = var_ref(config2context(config), $1.txt);
                $0 = new_pos(var, $1);
@@ -1714,7 +1756,7 @@ link to find the primary instance.
                                v->where_set = $0;
                        }
                }
-               $0->var = v;
+               cast(var, $0)->var = v;
        } }$
 
        $*type
@@ -1801,7 +1843,8 @@ link to find the primary instance.
 
                if (v->merged)
                        v = v->merged;
-               return dup_value(v->val);
+               lrv = &v->val;
+               break;
        }
 
 ###### ast functions
@@ -2038,7 +2081,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,
@@ -2088,6 +2131,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
@@ -2096,13 +2140,15 @@ 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;
+               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);
@@ -2125,6 +2171,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:
@@ -2176,6 +2223,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);
@@ -2597,16 +2658,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);
                right.type = NULL;
                break;
-       }
 
        case Declare:
        {
@@ -3113,10 +3173,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);
 
@@ -3125,15 +3185,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.
@@ -3299,12 +3362,12 @@ 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;