]> ocean-lang.org Git - ocean/blobdiff - csrc/oceani.mdc
oceani: pass a destination buffer into interp_exec to receive large result.
[ocean] / csrc / oceani.mdc
index beb4fc9830f41e25f4fbe65e54bb4195a3abde18..f375db62f818b5f07faf7cefb6d2cebef05ec562 100644 (file)
@@ -176,7 +176,7 @@ structures can be used.
                int fd;
                int len;
                char *file;
-               struct section *s, *ss;
+               struct section *s = NULL, *ss;
                char *section = NULL;
                struct parse_context context = {
                        .config = {
@@ -231,13 +231,13 @@ structures can be used.
                        if (!ss) {
                                fprintf(stderr, "oceani: cannot find section %s\n",
                                        section);
-                               exit(1);
+                               goto cleanup;
                        }
                } else
                        ss = s;                         // NOTEST
                if (!ss->code) {
                        fprintf(stderr, "oceani: no code found in requested section\n");        // NOTEST
-                       exit(1);                        // NOTEST
+                       goto cleanup;                   // NOTEST
                }
 
                parse_oceani(ss->code, &context.config, dotrace ? stderr : NULL);
@@ -254,16 +254,17 @@ structures can be used.
                }
                if (doexec && !context.parse_error)
                        interp_main(&context, argc - optind, argv + optind);
-
+       cleanup:
                while (s) {
                        struct section *t = s->next;
                        code_free(s->code);
                        free(s);
                        s = t;
                }
-               if (!context.parse_error) {
-                       ## free global vars
-               }
+               // FIXME parser should pop scope even on error
+               while (context.scope_depth > 0)
+                       scope_pop(&context);
+               ## free global vars
                ## free context types
                ## free context storage
                exit(context.parse_error ? 1 : 0);
@@ -1641,12 +1642,16 @@ in `rval`.
                struct value rval, *lval;
        };
 
-       static struct lrval _interp_exec(struct parse_context *c, struct exec *e);
+       /* If dest is passed, dtype must give the expected type, and
+        * result can go there, in which case type is returned as NULL.
+        */
+       static struct lrval _interp_exec(struct parse_context *c, struct exec *e,
+                                        struct value *dest, struct type *dtype);
 
        static struct value interp_exec(struct parse_context *c, struct exec *e,
                                        struct type **typeret)
        {
-               struct lrval ret = _interp_exec(c, e);
+               struct lrval ret = _interp_exec(c, e, NULL, NULL);
 
                if (!ret.type) abort();
                if (typeret)
@@ -1659,8 +1664,9 @@ in `rval`.
        static struct value *linterp_exec(struct parse_context *c, struct exec *e,
                                          struct type **typeret)
        {
-               struct lrval ret = _interp_exec(c, e);
+               struct lrval ret = _interp_exec(c, e, NULL, NULL);
 
+               if (!ret.type) abort();
                if (ret.lval)
                        *typeret = ret.type;
                else
@@ -1668,8 +1674,28 @@ in `rval`.
                return ret.lval;
        }
 
-       static struct lrval _interp_exec(struct parse_context *c, struct exec *e)
+       /* dinterp_exec is used when the destination type is certain and
+        * the value has a place to go.
+        */
+       static void dinterp_exec(struct parse_context *c, struct exec *e,
+                                struct value *dest, struct type *dtype,
+                                int need_free)
        {
+               struct lrval ret = _interp_exec(c, e, dest, dtype);
+               if (!ret.type)
+                       return; // NOTEST
+               if (need_free)
+                       free_value(dtype, dest);
+               if (ret.lval)
+                       dup_value(dtype, ret.lval, dest);
+               else
+                       memcpy(dest, &ret.rval, dtype->size);
+       }
+
+       static struct lrval _interp_exec(struct parse_context *c, struct exec *e,
+                                        struct value *dest, struct type *dtype)
+       {
+               /* If the result is copied to dest, ret.type is set to NULL */
                struct lrval ret;
                struct value rv = {}, *lrv = NULL;
                struct type *rvtype;
@@ -1697,9 +1723,11 @@ in `rval`.
                }
                ## interp exec cases
                }
-               ret.lval = lrv;
-               ret.rval = rv;
-               ret.type = rvtype;
+               if (rvtype) {
+                       ret.lval = lrv;
+                       ret.rval = rv;
+                       ret.type = rvtype;
+               }
                ## interp exec cleanup
                return ret;
        }
@@ -1875,9 +1903,10 @@ with a const size by whether they are prepared at parse time or not.
                t->array.vsize = NULL;
                if (number_parse(num, tail, $2.txt) == 0)
                        tok_err(c, "error: unrecognised number", &$2);
-               else if (tail[0])
+               else if (tail[0]) {
                        tok_err(c, "error: unsupported number suffix", &$2);
-               else {
+                       mpq_clear(num);
+               } else {
                        t->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",
@@ -1990,7 +2019,7 @@ with a const size by whether they are prepared at parse time or not.
                if (i >= 0 && i < ltype->array.size)
                        lrv = ptr + i * rvtype->size;
                else
-                       val_init(ltype->array.member, &rv);
+                       val_init(ltype->array.member, &rv); // UNSAFE
                ltype = NULL;
                break;
        }
@@ -2335,10 +2364,9 @@ function will be needed.
 #### Functions
 
 A function is a chunk of code which can be passed parameters and can
-return results (though results are not yet implemented).  Each function
-has a type which includes the set of parameters and the return value.
-As yet these types cannot be declared separately from the function
-itself.
+return results.  Each function has a type which includes the set of
+parameters and the return value.  As yet these types cannot be declared
+separately from the function itself.
 
 The parameters can be specified either in parentheses as a ';' separated
 list, such as
@@ -2359,6 +2387,22 @@ be a ';' separated list)
        do
                code block
 
+In the first case a return type can follow the paentheses after a colon,
+in the second it is given on a line starting with the word `return`.
+
+##### Example: functions that return
+
+       func add(a:number; b:number): number
+               code block
+
+       func catenate
+               a: string
+               b: string
+       return string
+       do
+               code block
+
+
 For constructing these lists we use a `List` binode, which will be
 further detailed when Expression Lists are introduced.
 
@@ -2366,6 +2410,7 @@ further detailed when Expression Lists are introduced.
 
        struct {
                struct binode *params;
+               struct type *return_type;
                int local_size;
        } function;
 
@@ -2433,7 +2478,12 @@ further detailed when Expression Lists are introduced.
                        if (b->right)
                                fprintf(f, "; ");
                }
-               fprintf(f, ")\n");
+               fprintf(f, ")");
+               if (type->function.return_type != Tnone) {
+                       fprintf(f, ":");
+                       type_print(type->function.return_type, f);
+               }
+               fprintf(f, "\n");
        }
 
        static void function_free_type(struct type *t)
@@ -3529,7 +3579,7 @@ arguments, form with the 'List' nodes.
 
        case Funcall: {
                /* Every arg must match formal parameter, and result
-                * is return type of function (currently Tnone).
+                * is return type of function
                 */
                struct binode *args = cast(binode, b->right);
                struct var *v = cast(var, b->left);
@@ -3540,7 +3590,7 @@ arguments, form with the 'List' nodes.
                        return NULL;
                }
                v->var->type->check_args(c, ok, v->var->type, args);
-               return Tnone;
+               return v->var->type->function.return_type;
        }
 
 ###### interp binode cases
@@ -3568,7 +3618,7 @@ arguments, form with the 'List' nodes.
                        arg = cast(binode, arg->right);
                }
                c->local = local; c->local_size = t->function.local_size;
-               right = interp_exec(c, fbody->function, &rtype);
+               rv = interp_exec(c, fbody->function, &rvtype);
                c->local = oldlocal; c->local_size = old_size;
                free(local);
                break;
@@ -3894,6 +3944,7 @@ it is declared, and error will be raised as the name is created as
                                type_err(c,
                                         "Variable declared with no type or value: %v",
                                         $1, NULL, 0, NULL);
+                               free_var($1);
                        } else {
                                $0 = new(binode);
                                $0->op = Declare;
@@ -3975,12 +4026,9 @@ it is declared, and error will be raised as the name is created as
 
        case Assign:
                lleft = linterp_exec(c, b->left, &ltype);
-               right = interp_exec(c, b->right, &rtype);
-               if (lleft) {
-                       free_value(ltype, lleft);
-                       dup_value(ltype, &right, lleft);
-                       ltype = NULL;
-               }
+               if (lleft)
+                       dinterp_exec(c, b->right, lleft, ltype, 1);
+               ltype = Tnone;
                break;
 
        case Declare:
@@ -3991,22 +4039,19 @@ it is declared, and error will be raised as the name is created as
                val = var_value(c, v);
                if (v->type->prepare_type)
                        v->type->prepare_type(c, v->type, 0);
-               if (b->right) {
-                       right = interp_exec(c, b->right, &rtype);
-                       memcpy(val, &right, rtype->size);
-                       rtype = Tnone;
-               } else {
+               if (b->right)
+                       dinterp_exec(c, b->right, val, v->type, 0);
+               else
                        val_init(v->type, val);
-               }
                break;
        }
 
 ### The `use` statement
 
-The `use` statement is the last "simple" statement.  It is needed when
-the condition in a conditional statement is a block.  `use` works much
-like `return` in C, but only completes the `condition`, not the whole
-function.
+The `use` statement is the last "simple" statement.  It is needed when a
+statement block can return a value.  This includes the body of a
+function which has a return type, and the "condition" code blocks in
+`if`, `while`, and `switch` statements.
 
 ###### Binode types
        Use,
@@ -4509,7 +4554,7 @@ casepart` to track a list of case parts.
                rv = interp_exec(c, b->left, &rvtype);
                if (rvtype == Tnone ||
                    (rvtype == Tbool && rv.bool != 0))
-                       // cnd is Tnone or Tbool, doesn't need to be freed
+                       // rvtype is Tnone or Tbool, doesn't need to be freed
                        interp_exec(c, b->right, NULL);
                break;
 
@@ -4654,11 +4699,12 @@ searching through for the Nth constant for decreasing N.
                        v->where_set = var;
                        var->var = v;
                        v->constant = 1;
+                       v->global = 1;
                } else {
-                       v = var_ref(c, $1.txt);
+                       struct variable *vorig = var_ref(c, $1.txt);
                        tok_err(c, "error: name already declared", &$1);
                        type_err(c, "info: this is where '%v' was first declared",
-                                v->where_decl, NULL, 0, NULL);
+                                vorig->where_decl, NULL, 0, NULL);
                }
                do {
                        ok = 1;
@@ -4712,17 +4758,17 @@ The code in an Ocean program is all stored in function declarations.
 One of the functions must be named `main` and it must accept an array of
 strings as a parameter - the command line arguments.
 
-As this is the top level, several things are handled a bit
-differently.
-The function is not interpreted by `interp_exec` as that isn't
-passed the argument list which the program requires.  Similarly type
-analysis is a bit more interesting at this level.
+As this is the top level, several things are handled a bit differently.
+The function is not interpreted by `interp_exec` as that isn't passed
+the argument list which the program requires.  Similarly type analysis
+is a bit more interesting at this level.
 
 ###### ast functions
 
        static struct variable *declare_function(struct parse_context *c,
                                                struct variable *name,
                                                struct binode *args,
+                                               struct type *ret,
                                                struct exec *code)
        {
                struct text funcname = {" func", 5};
@@ -4730,24 +4776,41 @@ analysis is a bit more interesting at this level.
                        struct value fn = {.function = code};
                        name->type = add_type(c, funcname, &function_prototype);
                        name->type->function.params = reorder_bilist(args);
+                       name->type->function.return_type = ret;
                        global_alloc(c, name->type, name, &fn);
                        var_block_close(c, CloseSequential, code);
-               } else
+               } else {
+                       free_binode(args);
+                       free_type(ret);
+                       free_exec(code);
                        var_block_close(c, CloseSequential, NULL);
+               }
                return name;
        }
 
+###### declare terminals
+       $TERM return
+
 ###### top level grammar
 
        $*variable
        DeclareFunction -> func FuncName ( OpenScope ArgsLine ) Block Newlines ${
-                       $0 = declare_function(c, $<FN, $<Ar, $<Bl);
+                       $0 = declare_function(c, $<FN, $<Ar, Tnone, $<Bl);
                }$
                | func FuncName IN OpenScope Args OUT OptNL do Block Newlines ${
-                       $0 = declare_function(c, $<FN, $<Ar, $<Bl);
+                       $0 = declare_function(c, $<FN, $<Ar, Tnone, $<Bl);
                }$
                | func FuncName NEWLINE OpenScope OptNL do Block Newlines ${
-                       $0 = declare_function(c, $<FN, NULL, $<Bl);
+                       $0 = declare_function(c, $<FN, NULL, Tnone, $<Bl);
+               }$
+               | func FuncName ( OpenScope ArgsLine ) : Type Block Newlines ${
+                       $0 = declare_function(c, $<FN, $<Ar, $<Ty, $<Bl);
+               }$
+               | func FuncName IN OpenScope Args OUT OptNL return Type Newlines do Block Newlines ${
+                       $0 = declare_function(c, $<FN, $<Ar, $<Ty, $<Bl);
+               }$
+               | func FuncName NEWLINE OpenScope return Type Newlines do Block Newlines ${
+                       $0 = declare_function(c, $<FN, NULL, $<Ty, $<Bl);
                }$
 
 ###### print func decls
@@ -4794,13 +4857,20 @@ analysis is a bit more interesting at this level.
                        val = var_value(c, v);
                        do {
                                ok = 1;
-                               propagate_types(val->function, c, &ok, Tnone, 0);
+                               propagate_types(val->function, c, &ok,
+                                               v->type->function.return_type, 0);
                        } while (ok == 2);
                        if (ok)
                                /* Make sure everything is still consistent */
-                               propagate_types(val->function, c, &ok, Tnone, 0);
+                               propagate_types(val->function, c, &ok,
+                                               v->type->function.return_type, 0);
                        if (!ok)
                                all_ok = 0;
+                       if (!v->type->function.return_type->dup) {
+                               type_err(c, "error: function cannot return value of type %1", 
+                                        v->where_decl, v->type->function.return_type, 0, NULL);
+                       }
+
                        v->type->function.local_size = scope_finalize(c);
                }
                return all_ok;