]> ocean-lang.org Git - ocean/blobdiff - csrc/oceani.mdc
oceani-tests: assorted more tests.
[ocean] / csrc / oceani.mdc
index 9e1ce020eb7ff0b265938b5f76b525244131128c..dd02e81ab89e7b01855e145973bf0def5252b6d3 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.
@@ -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) {
@@ -1305,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;
                if (loc->line >= 0) {
                        fprintf(f, "%d:%d: ", loc->line, loc->column);
                        return 1;
@@ -1732,6 +1745,7 @@ link to find the primary instance.
                }
        } }$
 
+       $*exec
        Variable -> IDENTIFIER ${ {
                struct variable *v = var_ref(config2context(config), $1.txt);
                $0 = new_pos(var, $1);
@@ -1744,8 +1758,9 @@ link to find the primary instance.
                                v->where_set = $0;
                        }
                }
-               $0->var = v;
+               cast(var, $0)->var = v;
        } }$
+       ## variable grammar
 
        $*type
        Type -> IDENTIFIER ${
@@ -1757,6 +1772,7 @@ link to find the primary instance.
                        $0 = Tnone;
                }
        }$
+       ## type grammar
 
 ###### print exec cases
        case Xvar:
@@ -2069,7 +2085,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,
@@ -2119,6 +2135,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
@@ -2127,13 +2144,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);
@@ -2156,6 +2175,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:
@@ -2207,6 +2227,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);
@@ -3169,6 +3203,217 @@ defined.
                break;
        }
 
+## 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;
+               {
+               char tail[3];
+               mpq_t num;
+               if (number_parse(num, tail, $2.txt) == 0)
+                       tok_err(config2context(config), "error: unrecognised number", &$2);
+               else if (tail[0])
+                       tok_err(config2context(config), "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(config2context(config), "error: array size must be an integer",
+                                       &$2);
+                       } else if (mpz_cmp_ui(mpq_numref(num), 1UL << 30) >= 0)
+                               tok_err(config2context(config), "error: array size is too large",
+                                       &$2);
+               }
+               }
+       }$
+
+       | [ IDENTIFIER ] Type ${ {
+               struct variable *v = var_ref(config2context(config), $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;
+       } }$
+
+###### 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;
+       }
+
 ### Finally the whole program.
 
 Somewhat reminiscent of Pascal a (current) Ocean program starts with
@@ -3386,3 +3631,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]