]> ocean-lang.org Git - ocean/blobdiff - csrc/oceani.mdc
oceani: change SimpleStatement to be $*exec, not $*binode
[ocean] / csrc / oceani.mdc
index f257736edc328baf8ba313d28f3bd7826e4e5004..a4110da2a970c1b60a6ad2e0f3be4f6243a2c1e0 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);
@@ -445,7 +446,7 @@ Named type are stored in a simple linked list.  Objects of each type are
                int size, align;
                void (*init)(struct type *type, struct value *val);
                void (*prepare_type)(struct parse_context *c, struct type *type, int parse_time);
-               void (*print)(struct type *type, struct value *val);
+               void (*print)(struct type *type, struct value *val, FILE *f);
                void (*print_type)(struct type *type, FILE *f);
                int (*cmp_order)(struct type *t1, struct type *t2,
                                 struct value *v1, struct value *v2);
@@ -542,12 +543,12 @@ Named type are stored in a simple linked list.  Objects of each type are
                return -1;                              // NOTEST
        }
 
-       static void print_value(struct type *type, struct value *v)
+       static void print_value(struct type *type, struct value *v, FILE *f)
        {
                if (type && type->print)
-                       type->print(type, v);
+                       type->print(type, v, f);
                else
-                       printf("*Unknown*");            // NOTEST
+                       fprintf(f, "*Unknown*");                // NOTEST
        }
 
 ###### forward decls
@@ -560,7 +561,7 @@ Named type are stored in a simple linked list.  Objects of each type are
                              struct value *vold, struct value *vnew);
        static int value_cmp(struct type *tl, struct type *tr,
                             struct value *left, struct value *right);
-       static void print_value(struct type *type, struct value *v);
+       static void print_value(struct type *type, struct value *v, FILE *f);
 
 ###### free context types
 
@@ -691,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) {
@@ -731,23 +732,23 @@ A separate function encoding these cases will simplify some code later.
                return cmp;
        }
 
-       static void _print_value(struct type *type, struct value *v)
+       static void _print_value(struct type *type, struct value *v, FILE *f)
        {
                switch (type->vtype) {
                case Vnone:                             // NOTEST
-                       printf("*no-value*"); break;    // NOTEST
+                       fprintf(f, "*no-value*"); break;        // NOTEST
                case Vlabel:                            // NOTEST
-                       printf("*label-%p*", v->label); break; // NOTEST
+                       fprintf(f, "*label-%p*", v->label); break; // NOTEST
                case Vstr:
-                       printf("%.*s", v->str.len, v->str.txt); break;
+                       fprintf(f, "%.*s", v->str.len, v->str.txt); break;
                case Vbool:
-                       printf("%s", v->bool ? "True":"False"); break;
+                       fprintf(f, "%s", v->bool ? "True":"False"); break;
                case Vnum:
                        {
                        mpf_t fl;
                        mpf_init2(fl, 20);
                        mpf_set_q(fl, v->num);
-                       gmp_printf("%Fg", fl);
+                       gmp_fprintf(f, "%Fg", fl);
                        mpf_clear(fl);
                        break;
                        }
@@ -934,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
@@ -948,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)
        {
@@ -958,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)
@@ -968,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
@@ -1004,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;
@@ -1014,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
@@ -1031,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
@@ -1051,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);
                        }
        }
@@ -1081,13 +1102,15 @@ need to be freed.  For this we need to be able to find it, so assume that
 
 #### 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
@@ -1122,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
 
@@ -1151,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;
@@ -1184,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)
        {
@@ -1201,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)
@@ -1210,7 +1247,9 @@ all pending-scope variables become conditionally scoped.
                                 */
                                continue;
                        v->min_depth = c->scope_depth;
-                       if (v->scope == InScope && e) {
+                       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;
@@ -1257,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;
@@ -1366,35 +1410,53 @@ 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 int scope_finalize(struct parse_context *c)
+       static void scope_finalize(struct parse_context *c, struct type *ft)
        {
-               struct binding *b;
-               int size = 0;
-
-               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 (!t)
-                                       continue;
-                               if (size & (t->align - 1))
-                                       size = (size + t->align) & ~(t->align-1);
-                               v->frame_pos = size;
-                               size += v->type->size;
-                       }
+               int size = ft->function.local_size;
+               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;
+                       if (v->frame_pos >= 0)
+                               continue;
+                       while (done && done->scope_end < v->scope_start)
+                               done = done->in_scope;
+                       if (done)
+                               pos = done->frame_pos + done->type->size;
+                       else
+                               pos = ft->function.local_size;
+                       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;
                }
-               return size;
+               c->out_scope = NULL;
+               ft->function.local_size = size;
        }
 
 ###### free context storage
@@ -1548,6 +1610,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);
@@ -1575,7 +1638,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':
@@ -1641,12 +1704,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 +1726,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 +1736,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;
+               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 +1785,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 +1965,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 +2081,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;
        }
@@ -2061,7 +2152,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
@@ -2258,7 +2349,7 @@ function will be needed.
                | ERROR ${ tok_err(c, "Syntax error in struct field", &$1); }$
 
        Field -> IDENTIFIER : Type = Expression ${ {
-                       int ok; // UNTESTED
+                       int ok;
 
                        $0 = calloc(1, sizeof(struct fieldlist));
                        $0->f.name = $1.txt;
@@ -2287,9 +2378,9 @@ function will be needed.
        static void structure_print_type(struct type *t, FILE *f);
 
 ###### value functions
-       static void structure_print_type(struct type *t, FILE *f)       // UNTESTED
-       {       // UNTESTED
-               int i;  // UNTESTED
+       static void structure_print_type(struct type *t, FILE *f)
+       {
+               int i;
 
                fprintf(f, "struct %.*s\n", t->name.len, t->name.txt);
 
@@ -2301,23 +2392,23 @@ function will be needed.
                                fprintf(f, " = ");
                                if (fl->type == Tstr)
                                        fprintf(f, "\"");       // UNTESTED
-                               print_value(fl->type, fl->init);
+                               print_value(fl->type, fl->init, f);
                                if (fl->type == Tstr)
                                        fprintf(f, "\"");       // UNTESTED
                        }
-                       printf("\n");
+                       fprintf(f, "\n");
                }
        }
 
 ###### print type decls
-       {       // UNTESTED
-               struct type *t; // UNTESTED
+       {
+               struct type *t;
                int target = -1;
 
                while (target != 0) {
                        int i = 0;
                        for (t = context.typelist; t ; t=t->next)
-                               if (t->print_type_decl && !t->check_args) {
+                               if (t->print_type_decl && !t->check_args && t->name.txt[0] != ' ') {
                                        i += 1;
                                        if (i == target)
                                                break;
@@ -2335,34 +2426,75 @@ 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 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 parentheses 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
+Rather than returning a type, the function can specify a set of local
+variables to return as a struct.  The values of these variables when the
+function exits will be provided to the caller.  For this the return type
+is replaced with a block of result declarations, either in parentheses
+or bracketed by `return` and `do`.
+
+##### Example: functions returning multiple variables
+
+       func to_cartesian(rho:number; theta:number):(x:number; y:number)
+               x = .....
+               y = .....
+
+       func to_polar
+               x:number; y:number
+       return
+               rho:number
+               theta:number
+       do
+               rho = ....
+               theta = ....
+
+For constructing the 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 inline_result;      // return value is at start of 'local'
                int local_size;
        } function;
 
@@ -2413,7 +2545,7 @@ further detailed when Expression Lists are introduced.
                                 args, NULL, 0, NULL);
        }
 
-       static void function_print(struct type *type, struct value *val)
+       static void function_print(struct type *type, struct value *val, FILE *f)
        {
                print_exec(val->function, 1, 0);
        }
@@ -2430,7 +2562,25 @@ 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, ":");
+                       if (type->function.inline_result) {
+                               int i;
+                               struct type *t = type->function.return_type;
+                               fprintf(f, " (");
+                               for (i = 0; i < t->structure.nfields; i++) {
+                                       struct field *fl = t->structure.fields + i;
+                                       if (i)
+                                               fprintf(f, "; ");
+                                       fprintf(f, "%.*s:", fl->name.len, fl->name.txt);
+                                       type_print(fl->type, f);
+                               }
+                               fprintf(f, ")");
+                       } else
+                               type_print(type->function.return_type, f);
+               }
+               fprintf(f, "\n");
        }
 
        static void function_free_type(struct type *t)
@@ -2477,14 +2627,22 @@ further detailed when Expression Lists are introduced.
                        }
                } }$
 
-
        $*binode
-       Args -> ${ $0 = NULL; }$
+       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;
+               } }$
+
+       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;
@@ -2587,7 +2745,7 @@ an executable.
                struct val *v = cast(val, e);
                if (v->vtype == Tstr)
                        printf("\"");
-               print_value(v->vtype, &v->val);
+               print_value(v->vtype, &v->val, stdout);
                if (v->vtype == Tstr)
                        printf("\"");
                break;
@@ -2650,6 +2808,10 @@ because it really is the same variable no matter where it appears.
 When a variable is used, we need to remember to follow the `->merged`
 link to find the primary instance.
 
+When a variable is declared, it may or may not be given an explicit
+type.  We need to record which so that we can report the parsed code
+correctly.
+
 ###### exec type
        Xvar,
 
@@ -2659,6 +2821,9 @@ link to find the primary instance.
                struct variable *var;
        };
 
+###### variable fields
+       int explicit_type;
+
 ###### Grammar
 
        $TERM : ::
@@ -2703,6 +2868,7 @@ link to find the primary instance.
                        v->where_decl = $0;
                        v->where_set = $0;
                        v->type = $<Type;
+                       v->explicit_type = 1;
                } else {
                        v = var_ref(c, $1.txt);
                        $0->var = v;
@@ -2721,6 +2887,7 @@ link to find the primary instance.
                        v->where_set = $0;
                        v->type = $<Type;
                        v->constant = 1;
+                       v->explicit_type = 1;
                } else {
                        v = var_ref(c, $1.txt);
                        $0->var = v;
@@ -2852,10 +3019,11 @@ there.
 ###### Binode types
        CondExpr,
 
-###### Grammar
+###### declare terminals
 
        $LEFT if $$ifelse
-       ## expr precedence
+
+###### Grammar
 
        $*exec
        Expression -> Expression if Expression else Expression $$ifelse ${ {
@@ -2974,7 +3142,7 @@ evaluate the second expression if not necessary.
        OrElse,
        Not,
 
-###### expr precedence
+###### declare terminals
        $LEFT or
        $LEFT and
        $LEFT not
@@ -3122,7 +3290,7 @@ expression operator, and the `CMPop` non-terminal will match one of them.
        Eql,
        NEql,
 
-###### expr precedence
+###### declare terminals
        $LEFT < > <= >= == != CMPop
 
 ###### expression grammar
@@ -3239,7 +3407,7 @@ should only insert brackets were needed for precedence.
        StringConv,
        Bracket,
 
-###### expr precedence
+###### declare terminals
        $LEFT + - Eop
        $LEFT * / % ++ Top
        $LEFT Uop $
@@ -3518,7 +3686,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);
@@ -3529,7 +3697,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
@@ -3557,7 +3725,12 @@ 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);
+               if (t->function.inline_result && dtype) {
+                       _interp_exec(c, fbody->function, NULL, NULL);
+                       memcpy(dest, local, dtype->size);
+                       rvtype = ret.type = NULL;
+               } else
+                       rv = interp_exec(c, fbody->function, &rvtype);
                c->local = oldlocal; c->local_size = old_size;
                free(local);
                break;
@@ -3616,6 +3789,12 @@ which does nothing and is represented as a `NULL` pointer in a `Block`
 list.  Other stand-alone statements will follow once the infrastructure
 is in-place.
 
+As many statements will use binodes, we declare a binode pointer 'b' in
+the common header for all reductions to use.
+
+###### Parser: reduce
+       struct binode *b;
+
 ###### Binode types
        Block,
 
@@ -3693,6 +3872,7 @@ is in-place.
                        }$
 
        $TERM pass
+       $*exec
        SimpleStatement -> pass ${ $0 = NULL; }$
                | ERROR ${ tok_err(c, "Syntax error in statement", &$1); }$
                ## SimpleStatement Grammar
@@ -3734,9 +3914,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)
@@ -3771,28 +3956,28 @@ printed.
 ###### Binode types
        Print,
 
-##### expr precedence
+##### declare terminals
        $TERM print
 
 ###### SimpleStatement Grammar
 
        | print ExpressionList ${
-               $0 = new(binode);
-               $0->op = Print;
-               $0->right = NULL;
-               $0->left = reorder_bilist($<EL);
+               $0 = b = new(binode);
+               b->op = Print;
+               b->right = NULL;
+               b->left = reorder_bilist($<EL);
        }$
        | print ExpressionList , ${ {
-               $0 = new(binode);
-               $0->op = Print;
-               $0->right = reorder_bilist($<EL);
-               $0->left = NULL;
+               $0 = b = new(binode);
+               b->op = Print;
+               b->right = reorder_bilist($<EL);
+               b->left = NULL;
        } }$
        | print ${
-               $0 = new(binode);
-               $0->op = Print;
-               $0->left = NULL;
-               $0->right = NULL;
+               $0 = b = new(binode);
+               b->op = Print;
+               b->left = NULL;
+               b->right = NULL;
        }$
 
 ###### print binode cases
@@ -3831,7 +4016,7 @@ printed.
                        b2 = cast(binode, b->right);
                for (; b2; b2 = cast(binode, b2->right)) {
                        left = interp_exec(c, b2->left, &ltype);
-                       print_value(ltype, &left);
+                       print_value(ltype, &left, stdout);
                        free_value(ltype, &left);
                        if (b2->right)
                                putchar(' ');
@@ -3861,16 +4046,16 @@ it is declared, and error will be raised as the name is created as
 
 ###### SimpleStatement Grammar
        | Variable = Expression ${
-                       $0 = new(binode);
-                       $0->op = Assign;
-                       $0->left = $<1;
-                       $0->right = $<3;
+                       $0 = b= new(binode);
+                       b->op = Assign;
+                       b->left = $<1;
+                       b->right = $<3;
                }$
        | VariableDecl = Expression ${
-                       $0 = new(binode);
-                       $0->op = Declare;
-                       $0->left = $<1;
-                       $0->right =$<3;
+                       $0 = b= new(binode);
+                       b->op = Declare;
+                       b->left = $<1;
+                       b->right =$<3;
                }$
 
        | VariableDecl ${
@@ -3878,11 +4063,12 @@ 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;
-                               $0->left = $<1;
-                               $0->right = NULL;
+                               $0 = b = new(binode);
+                               b->op = Declare;
+                               b->left = $<1;
+                               b->right = NULL;
                        }
                }$
 
@@ -3904,13 +4090,13 @@ it is declared, and error will be raised as the name is created as
                print_exec(b->left, indent, bracket);
                if (cast(var, b->left)->var->constant) {
                        printf("::");
-                       if (v->where_decl == v->where_set) {
+                       if (v->explicit_type) {
                                type_print(v->type, stdout);
                                printf(" ");
                        }
                } else {
                        printf(":");
-                       if (v->where_decl == v->where_set) {
+                       if (v->explicit_type) {
                                type_print(v->type, stdout);
                                printf(" ");
                        }
@@ -3949,7 +4135,7 @@ it is declared, and error will be raised as the name is created as
                                propagate_types(b->left, c, ok, t,
                                                (b->op == Assign ? Rnoconstant : 0));
                }
-               if (t && t->dup == NULL)
+               if (t && t->dup == NULL && t->name.txt[0] != ' ') // HACK
                        type_err(c, "error: cannot assign value of type %1", b, t, 0, NULL);
                return Tnone;
 
@@ -3959,12 +4145,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:
@@ -3975,36 +4158,33 @@ 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       
+###### declare terminals
+       $TERM use
 
 ###### SimpleStatement Grammar
        | use Expression ${
-               $0 = new_pos(binode, $1);
-               $0->op = Use;
-               $0->right = $<2;
-               if ($0->right->type == Xvar) {
-                       struct var *v = cast(var, $0->right);
+               $0 = b = new_pos(binode, $1);
+               b->op = Use;
+               b->right = $<2;
+               if (b->right->type == Xvar) {
+                       struct var *v = cast(var, b->right);
                        if (v->var->type == Tnone) {
                                /* Convert this to a label */
                                struct value *val;
@@ -4158,7 +4338,7 @@ casepart` to track a list of case parts.
 ###### ComplexStatement Grammar
        | CondStatement ${ $0 = $<1; }$
 
-###### expr precedence
+###### declare terminals
        $TERM for then while do
        $TERM else
        $TERM switch case
@@ -4493,7 +4673,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;
 
@@ -4638,11 +4818,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;
@@ -4681,7 +4862,7 @@ searching through for the Nth constant for decreasing N.
                                printf(" = ");
                                if (v->type == Tstr)
                                        printf("\"");
-                               print_value(v->type, val);
+                               print_value(v->type, val, stdout);
                                if (v->type == Tstr)
                                        printf("\"");
                                printf("\n");
@@ -4696,53 +4877,113 @@ 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 type *handle_results(struct parse_context *c,
+                                          struct binode *results)
+       {
+               /* Create a 'struct' type from the results list, which
+                * is a list for 'struct var'
+                */
+               struct text result_type_name = { " function_result", 5 };
+               struct type *t = add_type(c, result_type_name, &structure_prototype);
+               int cnt = 0;
+               struct binode *b;
+
+               for (b = results; b; b = cast(binode, b->right))
+                       cnt += 1;
+               t->structure.nfields = cnt;
+               t->structure.fields = calloc(cnt, sizeof(struct field));
+               cnt = 0;
+               for (b = results; b; b = cast(binode, b->right)) {
+                       struct var *v = cast(var, b->left);
+                       struct field *f = &t->structure.fields[cnt++];
+                       int a = v->var->type->align;
+                       f->name = v->var->name->name;
+                       f->type = v->var->type;
+                       f->init = NULL;
+                       f->offset = t->size;
+                       v->var->frame_pos = f->offset;
+                       t->size += ((f->type->size - 1) | (a-1)) + 1;
+                       if (a > t->align)
+                               t->align = a;
+                       variable_unlink_exec(v->var);
+               }
+               free_binode(results);
+               return t;
+       }
+
+       static struct variable *declare_function(struct parse_context *c,
+                                               struct variable *name,
+                                               struct binode *args,
+                                               struct type *ret,
+                                               struct binode *results,
+                                               struct exec *code)
+       {
+               struct text funcname = {" func", 5};
+               if (name) {
+                       struct value fn = {.function = code};
+                       struct type *t;
+                       var_block_close(c, CloseFunction, code);
+                       t = add_type(c, funcname, &function_prototype);
+                       name->type = t;
+                       t->function.params = reorder_bilist(args);
+                       if (!ret) {
+                               ret = handle_results(c, reorder_bilist(results));
+                               t->function.inline_result = 1;
+                               t->function.local_size = ret->size;
+                       }
+                       t->function.return_type = ret;
+                       global_alloc(c, t, name, &fn);
+                       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
 
        $*variable
-       DeclareFunction -> func FuncName ( OpenScope Args ) Block Newlines ${ {
-                       struct text funcname = { " func", 5};
-                       $0 = $<FN;
-                       if ($0) {
-                               struct value fn = {.function = $<Bl};
-                               $0->type = add_type(c, funcname, &function_prototype);
-                               $0->type->function.params = reorder_bilist($<Ar);
-                               global_alloc(c, $0->type, $0, &fn);
-                               var_block_close(c, CloseSequential, fn.function);
-                       } else
-                               var_block_close(c, CloseSequential, NULL);
-               } }$
-               | func FuncName then IN OpenScope OptNL Args OUT OptNL do Block Newlines ${ {
-                       // FIXME that 'then' should not be there.
-                       struct text funcname = { " func", 5};
-                       $0 = $<FN;
-                       if ($0) {
-                               struct value fn = {.function = $<Bl};
-                               $0->type = add_type(c, funcname, &function_prototype);
-                               $0->type->function.params = reorder_bilist($<Ar);
-                               global_alloc(c, $0->type, $0, &fn);
-                               var_block_close(c, CloseSequential, fn.function);
-                       } else
-                               var_block_close(c, CloseSequential, NULL);
-               } }$
-               | func FuncName NEWLINE OpenScope OptNL do Block Newlines ${ {
-                       struct text funcname = { " func", 5};
-                       $0 = $<FN;
-                       if ($0) {
-                               struct value fn = {.function = $<Bl};
-                               $0->type = add_type(c, funcname, &function_prototype);
-                               $0->type->function.params = NULL;
-                               global_alloc(c, $0->type, $0, &fn);
-                               var_block_close(c, CloseSequential, fn.function);
-                       } else
-                               var_block_close(c, CloseSequential, NULL);
-               } }$
+       DeclareFunction -> func FuncName ( OpenScope ArgsLine ) Block Newlines ${
+                       $0 = declare_function(c, $<FN, $<Ar, Tnone, NULL, $<Bl);
+               }$
+               | func FuncName IN OpenScope Args OUT OptNL do Block Newlines ${
+                       $0 = declare_function(c, $<FN, $<Ar, Tnone, NULL, $<Bl);
+               }$
+               | func FuncName NEWLINE OpenScope OptNL do Block Newlines ${
+                       $0 = declare_function(c, $<FN, NULL, Tnone, NULL, $<Bl);
+               }$
+               | func FuncName ( OpenScope ArgsLine ) : Type Block Newlines ${
+                       $0 = declare_function(c, $<FN, $<Ar, $<Ty, NULL, $<Bl);
+               }$
+               | func FuncName ( OpenScope ArgsLine ) : ( ArgsLine ) Block Newlines ${
+                       $0 = declare_function(c, $<FN, $<AL, NULL, $<AL2, $<Bl);
+               }$
+               | func FuncName IN OpenScope Args OUT OptNL return Type Newlines do Block Newlines ${
+                       $0 = declare_function(c, $<FN, $<Ar, $<Ty, NULL, $<Bl);
+               }$
+               | func FuncName NEWLINE OpenScope return Type Newlines do Block Newlines ${
+                       $0 = declare_function(c, $<FN, NULL, $<Ty, NULL, $<Bl);
+               }$
+               | func FuncName IN OpenScope Args OUT OptNL return IN Args OUT OptNL do Block Newlines ${
+                       $0 = declare_function(c, $<FN, $<Ar, NULL, $<Ar2, $<Bl);
+               }$
+               | func FuncName NEWLINE OpenScope return IN Args OUT OptNL do Block Newlines ${
+                       $0 = declare_function(c, $<FN, NULL, NULL, $<Ar, $<Bl);
+               }$
 
 ###### print func decls
        {
@@ -4767,7 +5008,7 @@ analysis is a bit more interesting at this level.
                                if (brackets)
                                        print_exec(val->function, 0, brackets);
                                else
-                                       print_value(v->type, val);
+                                       print_value(v->type, val, stdout);
                                printf("/* frame size %d */\n", v->type->function.local_size);
                                target -= 1;
                        }
@@ -4779,22 +5020,34 @@ analysis is a bit more interesting at this level.
        static int analyse_funcs(struct parse_context *c)
        {
                struct variable *v;
-               int ok = 1;
-               for (v = c->in_scope; ok && v; v = v->in_scope) {
+               int all_ok = 1;
+               for (v = c->in_scope; v; v = v->in_scope) {
                        struct value *val;
+                       struct type *ret;
+                       int ok = 1;
                        if (v->depth != 0 || !v->type || !v->type->check_args)
                                continue;
+                       ret = v->type->function.inline_result ?
+                               Tnone : v->type->function.return_type;
                        val = var_value(c, v);
                        do {
                                ok = 1;
-                               propagate_types(val->function, c, &ok, Tnone, 0);
+                               propagate_types(val->function, c, &ok, ret, 0);
                        } while (ok == 2);
                        if (ok)
                                /* Make sure everything is still consistent */
-                               propagate_types(val->function, c, &ok, Tnone, 0);
-                       v->type->function.local_size = scope_finalize(c);
+                               propagate_types(val->function, c, &ok, ret, 0);
+                       if (!ok)
+                               all_ok = 0;
+                       if (!v->type->function.inline_result &&
+                           !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 ok;
+               return all_ok;
        }
 
        static int analyse_main(struct type *type, struct parse_context *c)
@@ -4871,7 +5124,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]);