]> ocean-lang.org Git - ocean/blobdiff - csrc/oceani.mdc
oceani: improve construction of per-function stack frame
[ocean] / csrc / oceani.mdc
index 76c8c9b4efd96414511685e620c4d7b7e849acbd..c2a19ce0c7744190c2fedba910f7205c851e83db 100644 (file)
@@ -114,7 +114,6 @@ structures can be used.
                struct token_config config;
                char *file_name;
                int parse_error;
-               struct exec *prog;
                ## parse context
        };
 
@@ -177,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 = {
@@ -232,42 +231,39 @@ 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);
 
-               if (!context.prog) {
-                       fprintf(stderr, "oceani: no main function found.\n");
+               if (!context.parse_error && !analyse_funcs(&context)) {
+                       fprintf(stderr, "oceani: type error in program - not running.\n");
                        context.parse_error = 1;
                }
-               if (context.prog && !context.parse_error) {
-                       if (!analyse_prog(context.prog, &context)) {
-                               fprintf(stderr, "oceani: type error in program - not running.\n");
-                               context.parse_error = 1;
-                       }
-               }
-               if (context.prog && doprint) {
+
+               if (doprint) {
                        ## print const decls
                        ## print type decls
-                       print_exec(context.prog, 0, brackets);
+                       ## print func decls
                }
-               if (context.prog && doexec && !context.parse_error)
-                       interp_prog(&context, context.prog, argc - optind, argv+optind);
-               free_exec(context.prog);
-
+               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;
                }
+               // 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
@@ -365,6 +361,9 @@ context so indicate that parsing failed.
 ###### forward decls
 
        static void fput_loc(struct exec *loc, FILE *f);
+       static void type_err(struct parse_context *c,
+                            char *fmt, struct exec *loc,
+                            struct type *t1, int rules, struct type *t2);
 
 ###### core functions
 
@@ -693,7 +692,7 @@ A separate function encoding these cases will simplify some code later.
                }
        }
 
-       static void _dup_value(struct type *type, 
+       static void _dup_value(struct type *type,
                               struct value *vold, struct value *vnew)
        {
                switch (type->vtype) {
@@ -936,6 +935,12 @@ is used to distinguish between the first of a set of parallel scopes,
 in which declared variables must not be in scope, and subsequent
 branches, whether they may already be conditionally scoped.
 
+We need a total ordering of scopes so we can easily compare to variables
+to see if they are concurrently in scope.  To achieve this we record a
+`scope_count` which is actually a count of both beginnings and endings
+of scopes.  Then each variable has a record of the scope count where it
+enters scope, and where it leaves.
+
 To push a new frame *before* any code in the frame is parsed, we need a
 grammar reduction.  This is most easily achieved with a grammar
 element which derives the empty string, and creates the new scope when
@@ -950,8 +955,12 @@ like "if" and the code following it.
 
 ###### parse context
        int scope_depth;
+       int scope_count;
        struct scope *scope_stack;
 
+###### variable fields
+       int scope_start, scope_end;
+
 ###### ast functions
        static void scope_pop(struct parse_context *c)
        {
@@ -960,6 +969,7 @@ like "if" and the code following it.
                c->scope_stack = s->parent;
                free(s);
                c->scope_depth -= 1;
+               c->scope_count += 1;
        }
 
        static void scope_push(struct parse_context *c)
@@ -970,6 +980,7 @@ like "if" and the code following it.
                s->parent = c->scope_stack;
                c->scope_stack = s;
                c->scope_depth += 1;
+               c->scope_count += 1;
        }
 
 ###### Grammar
@@ -1006,7 +1017,10 @@ Each variable records a scope depth and is in one of four states:
 
 - "out of scope".  The variable is neither in scope nor conditionally
   in scope.  It is permanently out of scope now and can be removed from
-  the "in scope" stack.
+  the "in scope" stack.  When a variable becomes out-of-scope it is
+  moved to a separate list (`out_scope`) of variables which have fully
+  known scope.  This will be used at the end of each function to assign
+  each variable a place in the stack frame.
 
 ###### variable fields
        int depth, min_depth;
@@ -1016,6 +1030,7 @@ Each variable records a scope depth and is in one of four states:
 ###### parse context
 
        struct variable *in_scope;
+       struct variable *out_scope;
 
 All variables with the same name are linked together using the
 'previous' link.  Those variable that have been affirmatively merged all
@@ -1033,7 +1048,7 @@ list of in_scope names.
 
 The storage of the value of a variable will be described later.  For now
 we just need to know that when a variable goes out of scope, it might
-need to be freed.  For this we need to be able to find it, so assume that 
+need to be freed.  For this we need to be able to find it, so assume that
 `var_value()` will provide that.
 
 ###### variable fields
@@ -1053,6 +1068,10 @@ need to be freed.  For this we need to be able to find it, so assume that
                            v->merged == secondary->merged) {
                                v->scope = OutScope;
                                v->merged = primary;
+                               if (v->scope_start < primary->scope_start)
+                                       primary->scope_start = v->scope_start;
+                               if (v->scope_end > primary->scope_end)
+                                       primary->scope_end = v->scope_end;      // NOTEST
                                variable_unlink_exec(v);
                        }
        }
@@ -1068,27 +1087,30 @@ need to be freed.  For this we need to be able to find it, so assume that
                context.varlist = b->next;
                free(b);
                while (v) {
-                       struct variable *t = v;
+                       struct variable *next = v->previous;
 
-                       v = t->previous;
-                       if (t->global) {
-                               free_value(t->type, var_value(&context, t));
-                               if (t->depth == 0)
-                                       free_exec(t->where_decl);
+                       if (v->global) {
+                               free_value(v->type, var_value(&context, v));
+                               if (v->depth == 0)
+                                       // This is a global constant
+                                       free_exec(v->where_decl);
                        }
-                       free(t);
+                       free(v);
+                       v = next;
                }
        }
 
 #### Manipulating Bindings
 
-When a name is conditionally visible, a new declaration discards the
-old binding - the condition lapses.  Conversely a usage of the name
-affirms the visibility and extends it to the end of the containing
-block - i.e. the block that contains both the original declaration and
-the latest usage.  This is determined from `min_depth`.  When a
-conditionally visible variable gets affirmed like this, it is also
-merged with other conditionally visible variables with the same name.
+When a name is conditionally visible, a new declaration discards the old
+binding - the condition lapses.  Similarly when we reach the end of a
+function (outermost non-global scope) any conditional scope must lapse.
+Conversely a usage of the name affirms the visibility and extends it to
+the end of the containing block - i.e.  the block that contains both the
+original declaration and the latest usage.  This is determined from
+`min_depth`.  When a conditionally visible variable gets affirmed like
+this, it is also merged with other conditionally visible variables with
+the same name.
 
 When we parse a variable declaration we either report an error if the
 name is currently bound, or create a new variable at the current nest
@@ -1123,7 +1145,7 @@ we need to mark all pending-scope variable as out-of-scope.  Otherwise
 all pending-scope variables become conditionally scoped.
 
 ###### ast
-       enum closetype { CloseSequential, CloseParallel, CloseElse };
+       enum closetype { CloseSequential, CloseFunction, CloseParallel, CloseElse };
 
 ###### ast functions
 
@@ -1152,6 +1174,7 @@ all pending-scope variables become conditionally scoped.
                v->min_depth = v->depth = c->scope_depth;
                v->scope = InScope;
                v->in_scope = c->in_scope;
+               v->scope_start = c->scope_count;
                c->in_scope = v;
                ## variable init
                return v;
@@ -1185,6 +1208,19 @@ all pending-scope variables become conditionally scoped.
                return v;
        }
 
+       static int var_refile(struct parse_context *c, struct variable *v)
+       {
+               /* Variable just went out of scope.  Add it to the out_scope
+                * list, sorted by ->scope_start
+                */
+               struct variable **vp = &c->out_scope;
+               while ((*vp) && (*vp)->scope_start < v->scope_start)
+                       vp = &(*vp)->in_scope;
+               v->in_scope = *vp;
+               *vp = v;
+               return 0;               
+       }
+
        static void var_block_close(struct parse_context *c, enum closetype ct,
                                    struct exec *e)
        {
@@ -1202,7 +1238,7 @@ all pending-scope variables become conditionally scoped.
                for (vp = &c->in_scope;
                     (v = *vp) && v->min_depth > c->scope_depth;
                     (v->scope == OutScope || v->name->var != v)
-                    ? (*vp =  v->in_scope, 0)
+                    ? (*vp =  v->in_scope, var_refile(c, v))
                     : ( vp = &v->in_scope, 0)) {
                        v->min_depth = c->scope_depth;
                        if (v->name->var != v)
@@ -1211,7 +1247,9 @@ all pending-scope variables become conditionally scoped.
                                 */
                                continue;
                        v->min_depth = c->scope_depth;
-                       if (v->scope == InScope) {
+                       if (v->scope == InScope)
+                               v->scope_end = c->scope_count;
+                       if (v->scope == InScope && e && !v->global) {
                                /* This variable gets cleaned up when 'e' finishes */
                                variable_unlink_exec(v);
                                v->cleanup_exec = e;
@@ -1258,6 +1296,11 @@ all pending-scope variables become conditionally scoped.
                                        abort();                // NOTEST
                                }
                                break;
+                       case CloseFunction:
+                               if (v->scope == CondScope)
+                                       /* Condition cannot continue past end of function */
+                                       v->scope = InScope;
+                               /* fallthrough */
                        case CloseSequential:
                                if (v->type == Tlabel)
                                        v->scope = PendingScope;
@@ -1348,7 +1391,7 @@ tell if it was set or not later.
                        t->prepare_type(c, t, 1);       // NOTEST
 
                if (c->global_size & (t->align - 1))
-                       c->global_size = (c->global_size + t->align) & ~(t->align-1);   // UNTESTED
+                       c->global_size = (c->global_size + t->align) & ~(t->align-1);
                if (!v) {
                        v = &scratch;
                        v->type = t;
@@ -1367,37 +1410,54 @@ tell if it was set or not later.
 As global values are found -- struct field initializers, labels etc --
 `global_alloc()` is called to record the value in the global frame.
 
-When the program is fully parsed, we need to walk the list of variables
-to find any that weren't merged away and that aren't global, and to
-calculate the frame size and assign a frame position for each variable.
-For this we have `scope_finalize()`.
+When the program is fully parsed, each function is analysed, we need to
+walk the list of variables local to that function and assign them an
+offset in the stack frame.  For this we have `scope_finalize()`.
+
+We keep the stack from dense by re-using space for between variables
+that are not in scope at the same time.  The `out_scope` list is sorted
+by `scope_start` and as we process a varible, we move it to an FIFO
+stack.  For each variable we consider, we first discard any from the
+stack anything that went out of scope before the new variable came in.
+Then we place the new variable just after the one at the top of the
+stack.
 
 ###### ast functions
 
-       static void scope_finalize(struct parse_context *c)
+       static void scope_finalize(struct parse_context *c, struct type *ft)
        {
-               struct binding *b;
-
-               for (b = c->varlist; b; b = b->next) {
-                       struct variable *v;
-                       for (v = b->var; v; v = v->previous) {
-                               struct type *t = v->type;
-                               if (v->merged != v)
-                                       continue;
-                               if (v->global)
-                                       continue;
-                               if (c->local_size & (t->align - 1))
-                                       c->local_size = (c->local_size + t->align) & ~(t->align-1);
-                               v->frame_pos = c->local_size;
-                               c->local_size += v->type->size;
-                       }
+               int size = 0;
+               struct variable *next = ft->function.scope;
+               struct variable *done = NULL;
+               while (next) {
+                       struct variable *v = next;
+                       struct type *t = v->type;
+                       int pos;
+                       next = v->in_scope;
+                       if (v->merged != v)
+                               continue;
+                       if (!t)
+                               continue;
+                       while (done && done->scope_end < v->scope_start)
+                               done = done->in_scope;
+                       if (done)
+                               pos = done->frame_pos + done->type->size;
+                       else
+                               pos = 0;
+                       if (pos & (t->align - 1))
+                               pos = (pos + t->align) & ~(t->align-1);
+                       v->frame_pos = pos;
+                       if (size < pos + v->type->size)
+                               size = pos + v->type->size;
+                       v->in_scope = done;
+                       done = v;
                }
-               c->local = calloc(1, c->local_size);
+               c->out_scope = NULL;
+               ft->function.local_size = size;
        }
 
 ###### free context storage
        free(context.global);
-       free(context.local);
 
 ### Executables
 
@@ -1461,12 +1521,12 @@ from the `exec_types` enum.
                if (loc->type == Xbinode)
                        return __fput_loc(cast(binode,loc)->left, f) ||
                               __fput_loc(cast(binode,loc)->right, f);  // NOTEST
-               return 0;                       // NOTEST
+               return 0;
        }
        static void fput_loc(struct exec *loc, FILE *f)
        {
                if (!__fput_loc(loc, f))
-                       fprintf(f, "??:??: ");  // NOTEST
+                       fprintf(f, "??:??: ");
        }
 
 Each different type of `exec` node needs a number of functions defined,
@@ -1519,7 +1579,7 @@ also want to know what sort of bracketing to use.
 
        static void do_indent(int i, char *str)
        {
-               while (i--)
+               while (i-- > 0)
                        printf("    ");
                printf("%s", str);
        }
@@ -1547,6 +1607,7 @@ also want to know what sort of bracketing to use.
                        do_indent(indent, "/* FREE");
                        for (v = e->to_free; v; v = v->next_free) {
                                printf(" %.*s", v->name->name.len, v->name->name.txt);
+                               printf("[%d,%d]", v->scope_start, v->scope_end);
                                if (v->frame_pos >= 0)
                                        printf("(%d+%d)", v->frame_pos,
                                               v->type ? v->type->size:0);
@@ -1574,7 +1635,7 @@ propagation is needed.
 
 ###### ast
 
-       enum val_rules {Rnolabel = 1<<0, Rboolok = 1<<1, Rnoconstant = 2<<1};
+       enum val_rules {Rnolabel = 1<<0, Rboolok = 1<<1, Rnoconstant = 1<<2};
 
 ###### format cases
        case 'r':
@@ -1582,10 +1643,11 @@ propagation is needed.
                        fputs(" (labels not permitted)", stderr);
                break;
 
-###### core functions
-
+###### forward decls
        static struct type *propagate_types(struct exec *prog, struct parse_context *c, int *ok,
                                            struct type *type, int rules);
+###### core functions
+
        static struct type *__propagate_types(struct exec *prog, struct parse_context *c, int *ok,
                                              struct type *type, int rules)
        {
@@ -1639,12 +1701,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)
@@ -1657,8 +1723,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
@@ -1666,8 +1733,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;
@@ -1695,9 +1782,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;
        }
@@ -1816,7 +1905,7 @@ with a const size by whether they are prepared at parse time or not.
        static int array_compat(struct type *require, struct type *have)
        {
                if (have->compat != require->compat)
-                       return 0;       // UNTESTED
+                       return 0;
                /* Both are arrays, so we can look at details */
                if (!type_compat(require->array.member, have->array.member, 0))
                        return 0;
@@ -1873,9 +1962,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",
@@ -1988,7 +2078,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;
        }
@@ -2059,7 +2149,7 @@ function will be needed.
                        struct value *v;
                        v = (void*) val->ptr + type->structure.fields[i].offset;
                        if (type->structure.fields[i].init)
-                               dup_value(type->structure.fields[i].type, 
+                               dup_value(type->structure.fields[i].type,
                                          type->structure.fields[i].init,
                                          v);
                        else
@@ -2315,7 +2405,7 @@ function will be needed.
                while (target != 0) {
                        int i = 0;
                        for (t = context.typelist; t ; t=t->next)
-                               if (t->print_type_decl) {
+                               if (t->print_type_decl && !t->check_args) {
                                        i += 1;
                                        if (i == target)
                                                break;
@@ -2330,75 +2420,192 @@ function will be needed.
                }
        }
 
-### Functions
-
-A function is a named chunk of code which can be passed parameters and
-can return results.  Each function has an implicit type which includes
-the set of parameters and the return value.  As yet these types cannot
-be declared separate from the function itself.
+#### Functions
 
-In fact, only one function is currently possible - `main`.  `main` is
-passed an array of strings together with the size of the array, and
-doesn't return anything.  The strings are command line arguments.
+A function is a chunk of code which can be passed parameters and can
+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 list, such as
+The parameters can be specified either in parentheses as a ';' separated
+list, such as
 
 ##### Example: function 1
 
-       func main(av:[ac::number]string)
+       func main(av:[ac::number]string; env:[envc::number]string)
                code block
 
-or as an indented list of one parameter per line
+or as an indented list of one parameter per line (though each line can
+be a ';' separated list)
 
 ##### Example: function 2
 
        func main
                argv:[argc::number]string
+               env:[envc::number]string
+       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.
 
+###### type union fields
+
+       struct {
+               struct binode *params;
+               struct type *return_type;
+               struct variable *scope;
+               int local_size;
+       } function;
+
+###### value union fields
+       struct exec *function;
+
+###### type functions
+       void (*check_args)(struct parse_context *c, int *ok,
+                          struct type *require, struct exec *args);
+
+###### value functions
+
+       static void function_free(struct type *type, struct value *val)
+       {
+               free_exec(val->function);
+               val->function = NULL;
+       }
+
+       static int function_compat(struct type *require, struct type *have)
+       {
+               // FIXME can I do anything here yet?
+               return 0;
+       }
+
+       static void function_check_args(struct parse_context *c, int *ok,
+                                       struct type *require, struct exec *args)
+       {
+               /* This should be 'compat', but we don't have a 'tuple' type to
+                * hold the type of 'args'
+                */
+               struct binode *arg = cast(binode, args);
+               struct binode *param = require->function.params;
+
+               while (param) {
+                       struct var *pv = cast(var, param->left);
+                       if (!arg) {
+                               type_err(c, "error: insufficient arguments to function.",
+                                        args, NULL, 0, NULL);
+                               break;
+                       }
+                       *ok = 1;
+                       propagate_types(arg->left, c, ok, pv->var->type, 0);
+                       param = cast(binode, param->right);
+                       arg = cast(binode, arg->right);
+               }
+               if (arg)
+                       type_err(c, "error: too many arguments to function.",
+                                args, NULL, 0, NULL);
+       }
+
+       static void function_print(struct type *type, struct value *val)
+       {
+               print_exec(val->function, 1, 0);
+       }
+
+       static void function_print_type_decl(struct type *type, FILE *f)
+       {
+               struct binode *b;
+               fprintf(f, "(");
+               for (b = type->function.params; b; b = cast(binode, b->right)) {
+                       struct variable *v = cast(var, b->left)->var;
+                       fprintf(f, "%.*s%s", v->name->name.len, v->name->name.txt,
+                               v->constant ? "::" : ":");
+                       type_print(v->type, f);
+                       if (b->right)
+                               fprintf(f, "; ");
+               }
+               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)
+       {
+               free_exec(t->function.params);
+       }
+
+       static struct type function_prototype = {
+               .size = sizeof(void*),
+               .align = sizeof(void*),
+               .free = function_free,
+               .compat = function_compat,
+               .check_args = function_check_args,
+               .print = function_print,
+               .print_type_decl = function_print_type_decl,
+               .free_type = function_free_type,
+       };
+
+###### declare terminals
+
+       $TERM func
+
 ###### Binode types
-       Func, List,
+       List,
 
 ###### Grammar
 
-       $TERM func main
+       $*variable
+       FuncName -> IDENTIFIER ${ {
+                       struct variable *v = var_decl(c, $1.txt);
+                       struct var *e = new_pos(var, $1);
+                       e->var = v;
+                       if (v) {
+                               v->where_decl = e;
+                               $0 = v;
+                       } else {
+                               v = var_ref(c, $1.txt);
+                               e->var = v;
+                               type_err(c, "error: function '%v' redeclared",
+                                       e, NULL, 0, NULL);
+                               type_err(c, "info: this is where '%v' was first declared",
+                                       v->where_decl, NULL, 0, NULL);
+                               free_exec(e);
+                       }
+               } }$
 
        $*binode
-       MainFunction -> func main ( OpenScope Args ) Block Newlines ${
-                       $0 = new(binode);
-                       $0->op = Func;
-                       $0->left = reorder_bilist($<Ar);
-                       $0->right = $<Bl;
-                       var_block_close(c, CloseSequential, $0);
-                       if (c->scope_stack && !c->parse_error) abort();
-               }$
-               | func main IN OpenScope OptNL Args OUT OptNL do Block Newlines ${
-                       $0 = new(binode);
-                       $0->op = Func;
-                       $0->left = reorder_bilist($<Ar);
-                       $0->right = $<Bl;
-                       var_block_close(c, CloseSequential, $0);
-                       if (c->scope_stack && !c->parse_error) abort();
-               }$
-               | func main NEWLINE OpenScope OptNL do Block Newlines ${
-                       $0 = new(binode);
-                       $0->op = Func;
-                       $0->left = NULL;
-                       $0->right = $<Bl;
-                       var_block_close(c, CloseSequential, $0);
-                       if (c->scope_stack && !c->parse_error) abort();
-               }$
+       Args -> ArgsLine NEWLINE ${ $0 = $<AL; }$
+               | Args ArgsLine NEWLINE ${ {
+                       struct binode *b = $<AL;
+                       struct binode **bp = &b;
+                       while (*bp)
+                               bp = (struct binode **)&(*bp)->left;
+                       *bp = $<A;
+                       $0 = b;
+               } }$
 
-       Args -> ${ $0 = NULL; }$
+       ArgsLine -> ${ $0 = NULL; }$
                | Varlist ${ $0 = $<1; }$
                | Varlist ; ${ $0 = $<1; }$
-               | Varlist NEWLINE ${ $0 = $<1; }$
 
-       Varlist -> Varlist ; ArgDecl ${ // UNTESTED
+       Varlist -> Varlist ; ArgDecl ${
                        $0 = new(binode);
                        $0->op = List;
                        $0->left = $<Vl;
@@ -2683,7 +2890,7 @@ link to find the primary instance.
                        } else
                                fputs("???", stderr);   // NOTEST
                } else
-                       fputs("NOTVAR", stderr);        // NOTEST
+                       fputs("NOTVAR", stderr);
                break;
 
 ###### propagate exec cases
@@ -3127,7 +3334,7 @@ expression operator, and the `CMPop` non-terminal will match one of them.
                break;
        }
 
-### Expressions: The rest
+### Expressions: Arithmetic etc.
 
 The remaining expressions with the highest precedence are arithmetic,
 string concatenation, and string conversion.  String concatenation
@@ -3191,6 +3398,8 @@ should only insert brackets were needed for precedence.
                | Value ${ $0 = $<1; }$
                | Variable ${ $0 = $<1; }$
 
+###### Grammar
+
        $eop
        Eop ->    + ${ $0.op = Plus; }$
                | - ${ $0.op = Minus; }$
@@ -3371,6 +3580,110 @@ should only insert brackets were needed for precedence.
                return rv;
        }
 
+### Function calls
+
+A function call can appear either as an expression or as a statement.
+As functions cannot yet return values, only the statement version will work.
+We use a new 'Funcall' binode type to link the function with a list of
+arguments, form with the 'List' nodes.
+
+###### Binode types
+       Funcall,
+
+###### expression grammar
+       | Variable ( ExpressionList ) ${ {
+               struct binode *b = new(binode);
+               b->op = Funcall;
+               b->left = $<V;
+               b->right = reorder_bilist($<EL);
+               $0 = b;
+       } }$
+       | Variable ( ) ${ {
+               struct binode *b = new(binode);
+               b->op = Funcall;
+               b->left = $<V;
+               b->right = NULL;
+               $0 = b;
+       } }$
+
+###### SimpleStatement Grammar
+
+       | Variable ( ExpressionList ) ${ {
+               struct binode *b = new(binode);
+               b->op = Funcall;
+               b->left = $<V;
+               b->right = reorder_bilist($<EL);
+               $0 = b;
+       } }$
+
+###### print binode cases
+
+       case Funcall:
+               do_indent(indent, "");
+               print_exec(b->left, -1, bracket);
+               printf("(");
+               for (b = cast(binode, b->right); b; b = cast(binode, b->right)) {
+                       if (b->left) {
+                               printf(" ");
+                               print_exec(b->left, -1, bracket);
+                               if (b->right)
+                                       printf(",");
+                       }
+               }
+               printf(")");
+               if (indent >= 0)
+                       printf("\n");
+               break;
+
+###### propagate binode cases
+
+       case Funcall: {
+               /* Every arg must match formal parameter, and result
+                * is return type of function
+                */
+               struct binode *args = cast(binode, b->right);
+               struct var *v = cast(var, b->left);
+
+               if (!v->var->type || v->var->type->check_args == NULL) {
+                       type_err(c, "error: attempt to call a non-function.",
+                                prog, NULL, 0, NULL);
+                       return NULL;
+               }
+               v->var->type->check_args(c, ok, v->var->type, args);
+               return v->var->type->function.return_type;
+       }
+
+###### interp binode cases
+
+       case Funcall: {
+               struct var *v = cast(var, b->left);
+               struct type *t = v->var->type;
+               void *oldlocal = c->local;
+               int old_size = c->local_size;
+               void *local = calloc(1, t->function.local_size);
+               struct value *fbody = var_value(c, v->var);
+               struct binode *arg = cast(binode, b->right);
+               struct binode *param = t->function.params;
+
+               while (param) {
+                       struct var *pv = cast(var, param->left);
+                       struct type *vtype = NULL;
+                       struct value val = interp_exec(c, arg->left, &vtype);
+                       struct value *lval;
+                       c->local = local; c->local_size = t->function.local_size;
+                       lval = var_value(c, pv->var);
+                       c->local = oldlocal; c->local_size = old_size;
+                       memcpy(lval, &val, vtype->size);
+                       param = cast(binode, param->right);
+                       arg = cast(binode, arg->right);
+               }
+               c->local = local; c->local_size = t->function.local_size;
+               rv = interp_exec(c, fbody->function, &rvtype);
+               c->local = oldlocal; c->local_size = old_size;
+               free(local);
+               break;
+       }
+
 ### Blocks, Statements, and Statement lists.
 
 Now that we have expressions out of the way we need to turn to
@@ -3542,9 +3855,14 @@ is in-place.
 
                for (e = b; e; e = cast(binode, e->right)) {
                        t = propagate_types(e->left, c, ok, NULL, rules);
-                       if ((rules & Rboolok) && t == Tbool)
+                       if ((rules & Rboolok) && (t == Tbool || t == Tnone))
+                               t = NULL;
+                       if (t == Tnone && e->right)
+                               /* Only the final statement *must* return a value
+                                * when not Rboolok
+                                */
                                t = NULL;
-                       if (t && t != Tnone && t != Tbool) {
+                       if (t) {
                                if (!type)
                                        type = t;
                                else if (t != type)
@@ -3686,6 +4004,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;
@@ -3767,12 +4086,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:
@@ -3783,28 +4099,25 @@ 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,
 
 ###### expr precedence
-       $TERM use       
+       $TERM use
 
 ###### SimpleStatement Grammar
        | use Expression ${
@@ -4301,7 +4614,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;
 
@@ -4446,11 +4759,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;
@@ -4472,7 +4786,7 @@ searching through for the Nth constant for decreasing N.
                while (target != 0) {
                        int i = 0;
                        for (v = context.in_scope; v; v=v->in_scope)
-                               if (v->depth == 0) {
+                               if (v->depth == 0 && v->constant) {
                                        i += 1;
                                        if (i == target)
                                                break;
@@ -4498,69 +4812,146 @@ searching through for the Nth constant for decreasing N.
                }
        }
 
-### Finally the whole `main` function.
+### Function declarations
+
+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.
 
-An Ocean program can currently have only one function - `main` - and
-that must exist.  It expects an array of strings with a provided size.
-Following this is a `block` which is the code to execute.
+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
 
-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.
+       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};
+               if (name) {
+                       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, CloseFunction, code);
+                       name->type->function.scope = c->out_scope;
+               } else {
+                       free_binode(args);
+                       free_type(ret);
+                       free_exec(code);
+                       var_block_close(c, CloseFunction, NULL);
+               }
+               c->out_scope = NULL;
+               return name;
+       }
+
+###### declare terminals
+       $TERM return
 
 ###### top level grammar
 
-       DeclareFunction -> MainFunction ${ {
-               if (c->prog)
-                       type_err(c, "\"main\" defined a second time",
-                                $1, NULL, 0, NULL);
-               else
-                       c->prog = $<1;
-       } }$
+       $*variable
+       DeclareFunction -> func FuncName ( OpenScope ArgsLine ) Block Newlines ${
+                       $0 = declare_function(c, $<FN, $<Ar, Tnone, $<Bl);
+               }$
+               | func FuncName IN OpenScope Args OUT OptNL do Block Newlines ${
+                       $0 = declare_function(c, $<FN, $<Ar, Tnone, $<Bl);
+               }$
+               | func FuncName NEWLINE OpenScope OptNL do Block Newlines ${
+                       $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 binode cases
-       case Func:
-               do_indent(indent, "func main(");
-               for (b2 = cast(binode, b->left); b2; b2 = cast(binode, b2->right)) {
-                       struct variable *v = cast(var, b2->left)->var;
-                       printf(" ");
-                       print_exec(b2->left, 0, 0);
-                       printf(":");
-                       type_print(v->type, stdout);
-               }
-               if (bracket)
-                       printf(") {\n");
-               else
-                       printf(")\n");
-               print_exec(b->right, indent+1, bracket);
-               if (bracket)
-                       do_indent(indent, "}\n");
-               break;
+###### print func decls
+       {
+               struct variable *v;
+               int target = -1;
 
-###### propagate binode cases
-       case Func: abort();             // NOTEST
+               while (target != 0) {
+                       int i = 0;
+                       for (v = context.in_scope; v; v=v->in_scope)
+                               if (v->depth == 0 && v->type && v->type->check_args) {
+                                       i += 1;
+                                       if (i == target)
+                                               break;
+                               }
+
+                       if (target == -1) {
+                               target = i;
+                       } else {
+                               struct value *val = var_value(&context, v);
+                               printf("func %.*s", v->name->name.len, v->name->name.txt);
+                               v->type->print_type_decl(v->type, stdout);
+                               if (brackets)
+                                       print_exec(val->function, 0, brackets);
+                               else
+                                       print_value(v->type, val);
+                               printf("/* frame size %d */\n", v->type->function.local_size);
+                               target -= 1;
+                       }
+               }
+       }
 
 ###### core functions
 
-       static int analyse_prog(struct exec *prog, struct parse_context *c)
+       static int analyse_funcs(struct parse_context *c)
        {
-               struct binode *bp = cast(binode, prog);
+               struct variable *v;
+               int all_ok = 1;
+               for (v = c->in_scope; v; v = v->in_scope) {
+                       struct value *val;
+                       int ok = 1;
+                       if (v->depth != 0 || !v->type || !v->type->check_args)
+                               continue;
+                       val = var_value(c, v);
+                       do {
+                               ok = 1;
+                               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,
+                                               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);
+                       }
+
+                       scope_finalize(c, v->type);
+               }
+               return all_ok;
+       }
+
+       static int analyse_main(struct type *type, struct parse_context *c)
+       {
+               struct binode *bp = type->function.params;
                struct binode *b;
                int ok = 1;
                int arg = 0;
                struct type *argv_type;
                struct text argv_type_name = { " argv", 5 };
 
-               if (!bp)
-                       return 0;       // NOTEST
-
                argv_type = add_type(c, argv_type_name, &array_prototype);
                argv_type->array.member = Tstr;
                argv_type->array.unspec = 1;
 
-               for (b = cast(binode, bp->left); b; b = cast(binode, b->right)) {
+               for (b = bp; b; b = cast(binode, b->right)) {
                        ok = 1;
                        switch (arg++) {
                        case 0: /* argv */
@@ -4569,35 +4960,40 @@ analysis is a bit more interesting at this level.
                        default: /* invalid */  // NOTEST
                                propagate_types(b->left, c, &ok, Tnone, 0);     // NOTEST
                        }
+                       if (!ok)
+                               c->parse_error = 1;
                }
 
-               do {
-                       ok = 1;
-                       propagate_types(bp->right, c, &ok, Tnone, 0);
-               } while (ok == 2);
-               if (!ok)
-                       return 0;
-
-               /* Make sure everything is still consistent */
-               propagate_types(bp->right, c, &ok, Tnone, 0);
-               if (!ok)
-                       return 0;       // UNTESTED
-               scope_finalize(c);
-               return 1;
+               return !c->parse_error;
        }
 
-       static void interp_prog(struct parse_context *c, struct exec *prog, 
-                               int argc, char **argv)
+       static void interp_main(struct parse_context *c, int argc, char **argv)
        {
-               struct binode *p = cast(binode, prog);
+               struct value *progp = NULL;
+               struct text main_name = { "main", 4 };
+               struct variable *mainv;
                struct binode *al;
                int anum = 0;
                struct value v;
                struct type *vtype;
 
-               if (!prog)
-                       return;         // NOTEST
-               al = cast(binode, p->left);
+               mainv = var_ref(c, main_name);
+               if (mainv)
+                       progp = var_value(c, mainv);
+               if (!progp || !progp->function) {
+                       fprintf(stderr, "oceani: no main function found.\n");
+                       c->parse_error = 1;
+                       return;
+               }
+               if (!analyse_main(mainv->type, c)) {
+                       fprintf(stderr, "oceani: main has wrong type.\n");
+                       c->parse_error = 1;
+                       return;
+               }
+               al = mainv->type->function.params;
+
+               c->local_size = mainv->type->function.local_size;
+               c->local = calloc(1, c->local_size);
                while (al) {
                        struct var *v = cast(var, al->left);
                        struct value *vl = var_value(c, v->var);
@@ -4616,7 +5012,6 @@ analysis is a bit more interesting at this level.
                                array_init(v->var->type, vl);
                                for (i = 0; i < argc; i++) {
                                        struct value *vl2 = vl->array + i * v->var->type->array.member->size;
-                                       
 
                                        arg.str.txt = argv[i];
                                        arg.str.len = strlen(argv[i]);
@@ -4627,14 +5022,16 @@ analysis is a bit more interesting at this level.
                        }
                        al = cast(binode, al->right);
                }
-               v = interp_exec(c, p, &vtype);
+               v = interp_exec(c, progp->function, &vtype);
                free_value(vtype, &v);
+               free(c->local);
+               c->local = NULL;
        }
 
-###### interp binode cases
-       case Func:
-               rv = interp_exec(c, b->right, &rvtype);
-               break;
+###### ast functions
+       void free_variable(struct variable *v)
+       {
+       }
 
 ## And now to test it out.
 
@@ -4664,9 +5061,7 @@ things which will likely grow as the languages grows.
                name:string
                alive:Boolean
 
-       func main
-               argv:[argc::]string
-       do
+       func main(argv:[argc::]string)
                print "Hello World, what lovely oceans you have!"
                print "Are there", five, "?"
                print pi, pie, "but", cake