oceani: initial support for named types.

The base types are now stored in a symbol table (linked list)
and can be fetched by name.
  name:type = value

now works to declare 'name' as of the given type.

The narrative needs to be improved to include a clear
section on types, and variable declarations of the form
   name:type

with no assignment still need to be added.

Signed-off-by: NeilBrown <neil@brown.name>

diff --git a/csrc/oceani.mdc b/csrc/oceani.mdc
index 062eaed69f82f7c4762b053977069609a838e4c2..c4f7e2998c04d7ee475b365b16c1e0d2bcf30793 100644 (file)
--- a/csrc/oceani.mdc
+++ b/csrc/oceani.mdc
@@ -250,7 +250,8 @@ option.
                        free(s);
                        s = t;
                }
                        free(s);
                        s = t;
                }

-               ## free context
+               ## free context vars
+               ## free context types

                exit(context.parse_error ? 1 : 0);
        }
 
                exit(context.parse_error ? 1 : 0);
        }
 


@@ -365,10 +366,17 @@ in too.
                        case '%': fputc(*fmt, stderr); break;
                        default: fputc('?', stderr); break;
                        case '1':
                        case '%': fputc(*fmt, stderr); break;
                        default: fputc('?', stderr); break;
                        case '1':

-                               fputs(t1 ? t1->name : "*unknown*", stderr);
+                               if (t1)
+                                       fprintf(stderr, "%.*s", t1->name.len, t1->name.txt);
+                               else
+                                       fputs("*unknown*", stderr);

                                break;
                        case '2':
                                break;
                        case '2':

-                               fputs(t2 ? t2->name : "*unknown*", stderr);
+                               if (t2)
+                                       fprintf(stderr, "%.*s", t2->name.len, t2->name.txt);
+                               else
+                                       fputs("*unknown*", stderr);
+                               break;

                                break;
                        ## format cases
                        }
                                break;
                        ## format cases
                        }


@@ -410,10 +418,13 @@ as one of a few standard types: integer, float, and fraction.  The
 existance of these conversion functions enable types to determine if
 they are compatible with other types.
 
 existance of these conversion functions enable types to determine if
 they are compatible with other types.
 

+Named type are stored in a simple linked list.
+

 ###### ast
 
        struct type {
 ###### ast
 
        struct type {

-               char *name;
+               struct text name;
+               struct type *next;

                struct value (*init)(struct type *type);
                struct value (*parse)(struct type *type, char *str);
                void (*print)(struct value val);
                struct value (*init)(struct type *type);
                struct value (*parse)(struct type *type, char *str);
                void (*print)(struct value val);


@@ -425,9 +436,65 @@ they are compatible with other types.
                long long (*to_int)(struct value *v);
                double (*to_float)(struct value *v);
                int (*to_mpq)(mpq_t *q, struct value *v);
                long long (*to_int)(struct value *v);
                double (*to_float)(struct value *v);
                int (*to_mpq)(mpq_t *q, struct value *v);

-               ## type fields
+               union {
+                       ## type union fields
+               };
+       };
+
+       struct typep {
+               struct type *t;

        };
 
        };
 

+###### parse context
+
+       struct type *typelist;
+
+###### ast functions
+
+       static struct type *find_type(struct parse_context *c, struct text s)
+       {
+               struct type *l = c->typelist;
+
+               while (l &&
+                      text_cmp(l->name, s) != 0)
+                               l = l->next;
+               return l;
+       }
+
+       static struct type *add_type(struct parse_context *c, struct text s,
+                                    struct type *proto)
+       {
+               struct type *n;
+
+               n = calloc(1, sizeof(*n));
+               *n = *proto;
+               n->name = s;
+               n->next = c->typelist;
+               c->typelist = n;
+               return n;
+       }
+
+       static void free_type(struct type *t)
+       {
+               /* The type is always a reference to something in the
+                * context, so we don't need to free anything.
+                */
+       }
+
+       static void context_init(struct parse_context *c)
+       {
+               ## context initialization
+       }
+
+###### free context types
+
+       while (context.typelist) {
+               struct type *t = context.typelist;
+
+               context.typelist = t->next;
+               free(t);
+       }
+

 ### Values
 
 Values can be numbers, which we represent as multi-precision
 ### Values
 
 Values can be numbers, which we represent as multi-precision


@@ -459,7 +526,7 @@ to parse each type from a string.
        myLDLIBS := libnumber.o libstring.o -lgmp
        LDLIBS := $(filter-out $(myLDLIBS),$(LDLIBS)) $(myLDLIBS)
 
        myLDLIBS := libnumber.o libstring.o -lgmp
        LDLIBS := $(filter-out $(myLDLIBS),$(LDLIBS)) $(myLDLIBS)
 

-###### type fields
+###### type union fields

        enum vtype {Vnone, Vstr, Vnum, Vbool, Vlabel} vtype;
 
 ###### ast
        enum vtype {Vnone, Vstr, Vnum, Vbool, Vlabel} vtype;
 
 ###### ast


@@ -501,9 +568,9 @@ to parse each type from a string.
 
        static int vtype_compat(struct type *require, struct type *have, int rules)
        {
 
        static int vtype_compat(struct type *require, struct type *have, int rules)
        {

-               if ((rules & Rboolok) && have == &Tbool)
+               if ((rules & Rboolok) && have == Tbool)

                        return 1;
                        return 1;

-               if ((rules & Rnolabel) && have == &Tlabel)
+               if ((rules & Rnolabel) && have == Tlabel)

                        return 0;
                if (!require || !have)
                        return 1;
                        return 0;
                if (!require || !have)
                        return 1;


@@ -519,7 +586,8 @@ to parse each type from a string.
 
                rv.type = type;
                switch(type->vtype) {
 
                rv.type = type;
                switch(type->vtype) {

-               case Vnone:abort();
+               case Vnone:
+                       break;

                case Vnum:
                        mpq_init(rv.num); break;
                case Vstr:
                case Vnum:
                        mpq_init(rv.num); break;
                case Vstr:


@@ -705,44 +773,39 @@ to parse each type from a string.
 
        static void _free_value(struct value v);
 
 
        static void _free_value(struct value v);
 

-       #define BaseType \
-               .init = _val_init,              \
-               .parse = _parse_value,          \
-               .print = _print_value,          \
-               .cmp_order = _value_cmp,        \
-               .cmp_eq = _value_cmp,           \
-               .dup = _dup_value,              \
-               .free = _free_value,            \
-
-       static struct type Tbool = {
-               BaseType
-               .name = "Boolean",
-               .vtype = Vbool,
+       static struct type base_prototype = {
+               .init = _val_init,
+               .parse = _parse_value,
+               .print = _print_value,
+               .cmp_order = _value_cmp,
+               .cmp_eq = _value_cmp,
+               .dup = _dup_value,
+               .free = _free_value,

        };
 
        };
 

-       static struct type Tstr = {
-               BaseType
-               .name = "string",
-               .vtype = Vstr,
-       };
+       static struct type *Tbool, *Tstr, *Tnum, *Tnone, *Tlabel;

 
 

-       static struct type Tnum = {
-               BaseType
-               .name = "number",
-               .vtype = Vnum,
-       };
+###### ast functions
+       static struct type *add_base_type(struct parse_context *c, char *n, enum vtype vt)
+       {
+               struct text txt = { n, strlen(n) };
+               struct type *t;

 
 

-       static struct type Tnone = {
-               BaseType
-               .name = "none",
-               .vtype = Vnone,
-       };
+               t = add_type(c, txt, &base_prototype);
+               t->vtype = vt;
+               return t;
+       }

 
 

-       static struct type Tlabel = {
-               BaseType
-               .name = "label",
-               .vtype = Vlabel,
-       };
+###### forward decls
+       static struct type *add_base_type(struct parse_context *c, char *n, enum vtype vt);
+
+###### context initialization
+
+       Tbool  = add_base_type(c, "Boolean", Vbool);
+       Tstr   = add_base_type(c, "string", Vstr);
+       Tnum   = add_base_type(c, "number", Vnum);
+       Tnone  = add_base_type(c, "none", Vnone);
+       Tlabel = add_base_type(c, "label", Vlabel);

 
 ### Variables
 
 
 ### Variables
 


@@ -964,7 +1027,7 @@ no longer be primary.
                        }
        }
 
                        }
        }
 

-###### free context
+###### free context vars

 
        while (context.varlist) {
                struct binding *b = context.varlist;
 
        while (context.varlist) {
                struct binding *b = context.varlist;


@@ -1102,7 +1165,7 @@ all pending-scope variables become conditionally scoped.
                                        else if (v->previous &&
                                                 v->previous->scope == PendingScope)
                                                v->scope = PendingScope;
                                        else if (v->previous &&
                                                 v->previous->scope == PendingScope)
                                                v->scope = PendingScope;

-                                       else if (v->val.type == &Tlabel)
+                                       else if (v->val.type == Tlabel)

                                                v->scope = PendingScope;
                                        else if (v->name->var == v)
                                                v->scope = OutScope;
                                                v->scope = PendingScope;
                                        else if (v->name->var == v)
                                                v->scope = OutScope;


@@ -1119,14 +1182,14 @@ all pending-scope variables become conditionally scoped.
                                        for (v2 = v;
                                             v2 && v2->scope == PendingScope;
                                             v2 = v2->previous)
                                        for (v2 = v;
                                             v2 && v2->scope == PendingScope;
                                             v2 = v2->previous)

-                                               if (v2->val.type != &Tlabel)
+                                               if (v2->val.type != Tlabel)

                                                        v2->scope = OutScope;
                                        break;
                                case OutScope: break;
                                }
                                break;
                        case CloseSequential:
                                                        v2->scope = OutScope;
                                        break;
                                case OutScope: break;
                                }
                                break;
                        case CloseSequential:

-                               if (v->val.type == &Tlabel)
+                               if (v->val.type == Tlabel)

                                        v->scope = PendingScope;
                                switch (v->scope) {
                                case InScope:
                                        v->scope = PendingScope;
                                switch (v->scope) {
                                case InScope:


@@ -1141,7 +1204,7 @@ all pending-scope variables become conditionally scoped.
                                        for (v2 = v;
                                             v2 && v2->scope == PendingScope;
                                             v2 = v2->previous)
                                        for (v2 = v;
                                             v2 && v2->scope == PendingScope;
                                             v2 = v2->previous)

-                                               if (v2->val.type == &Tlabel) {
+                                               if (v2->val.type == Tlabel) {

                                                        v2->scope = CondScope;
                                                        v2->min_depth = c->scope_depth;
                                                } else
                                                        v2->scope = CondScope;
                                                        v2->min_depth = c->scope_depth;
                                                } else


@@ -1326,7 +1389,7 @@ propagation is needed.
                struct type *t;
 
                if (!prog)
                struct type *t;
 
                if (!prog)

-                       return &Tnone;
+                       return Tnone;

 
                switch (prog->type) {
                case Xbinode:
 
                switch (prog->type) {
                case Xbinode:


@@ -1339,7 +1402,7 @@ propagation is needed.
                }
                ## propagate exec cases
                }
                }
                ## propagate exec cases
                }

-               return &Tnone;
+               return Tnone;

        }
 
 #### Interpreting
        }
 
 #### Interpreting


@@ -1357,7 +1420,7 @@ Each `exec` can return a value, which may be `Tnone` but must be non-NULL;
        static struct value interp_exec(struct exec *e)
        {
                struct value rv;
        static struct value interp_exec(struct exec *e)
        {
                struct value rv;

-               rv.type = &Tnone;
+               rv.type = Tnone;

                if (!e)
                        return rv;
 
                if (!e)
                        return rv;
 


@@ -1366,7 +1429,7 @@ Each `exec` can return a value, which may be `Tnone` but must be non-NULL;
                {
                        struct binode *b = cast(binode, e);
                        struct value left, right;
                {
                        struct binode *b = cast(binode, e);
                        struct value left, right;

-                       left.type = right.type = &Tnone;
+                       left.type = right.type = Tnone;

                        switch (b->op) {
                        ## interp binode cases
                        }
                        switch (b->op) {
                        ## interp binode cases
                        }


@@ -1405,17 +1468,17 @@ an executable.
        $*val
        Value ->  True ${
                        $0 = new_pos(val, $1);
        $*val
        Value ->  True ${
                        $0 = new_pos(val, $1);

-                       $0->val.type = &Tbool;
+                       $0->val.type = Tbool;

                        $0->val.bool = 1;
                        }$
                | False ${
                        $0 = new_pos(val, $1);
                        $0->val.bool = 1;
                        }$
                | False ${
                        $0 = new_pos(val, $1);

-                       $0->val.type = &Tbool;
+                       $0->val.type = Tbool;

                        $0->val.bool = 0;
                        }$
                | NUMBER ${
                        $0 = new_pos(val, $1);
                        $0->val.bool = 0;
                        }$
                | NUMBER ${
                        $0 = new_pos(val, $1);

-                       $0->val.type = &Tnum;
+                       $0->val.type = Tnum;

                        {
                        char tail[3];
                        if (number_parse($0->val.num, tail, $1.txt) == 0)
                        {
                        char tail[3];
                        if (number_parse($0->val.num, tail, $1.txt) == 0)


@@ -1427,7 +1490,7 @@ an executable.
                        }$
                | STRING ${
                        $0 = new_pos(val, $1);
                        }$
                | STRING ${
                        $0 = new_pos(val, $1);

-                       $0->val.type = &Tstr;
+                       $0->val.type = Tstr;

                        {
                        char tail[3];
                        string_parse(&$1, '\\', &$0->val.str, tail);
                        {
                        char tail[3];
                        string_parse(&$1, '\\', &$0->val.str, tail);


@@ -1438,7 +1501,7 @@ an executable.
                        }$
                | MULTI_STRING ${
                        $0 = new_pos(val, $1);
                        }$
                | MULTI_STRING ${
                        $0 = new_pos(val, $1);

-                       $0->val.type = &Tstr;
+                       $0->val.type = Tstr;

                        {
                        char tail[3];
                        string_parse(&$1, '\\', &$0->val.str, tail);
                        {
                        char tail[3];
                        string_parse(&$1, '\\', &$0->val.str, tail);


@@ -1452,10 +1515,10 @@ an executable.
        case Xval:
        {
                struct val *v = cast(val, e);
        case Xval:
        {
                struct val *v = cast(val, e);

-               if (v->val.type == &Tstr)
+               if (v->val.type == Tstr)

                        printf("\"");
                print_value(v->val);
                        printf("\"");
                print_value(v->val);

-               if (v->val.type == &Tstr)
+               if (v->val.type == Tstr)

                        printf("\"");
                break;
        }
                        printf("\"");
                break;
        }


@@ -1540,9 +1603,9 @@ link to find the primary instance.
                        v = var_ref(config2context(config), $1.txt);
                        $0->var = v;
                        type_err(config2context(config), "error: variable '%v' redeclared",
                        v = var_ref(config2context(config), $1.txt);
                        $0->var = v;
                        type_err(config2context(config), "error: variable '%v' redeclared",

-                                $0, &Tnone, 0, &Tnone);
+                                $0, Tnone, 0, Tnone);

                        type_err(config2context(config), "info: this is where '%v' was first declared",
                        type_err(config2context(config), "info: this is where '%v' was first declared",

-                                v->where_decl, &Tnone, 0, &Tnone);
+                                v->where_decl, Tnone, 0, Tnone);

                }
        } }$
            | IDENTIFIER ::= ${ {
                }
        } }$
            | IDENTIFIER ::= ${ {


@@ -1556,9 +1619,44 @@ link to find the primary instance.
                        v = var_ref(config2context(config), $1.txt);
                        $0->var = v;
                        type_err(config2context(config), "error: variable '%v' redeclared",
                        v = var_ref(config2context(config), $1.txt);
                        $0->var = v;
                        type_err(config2context(config), "error: variable '%v' redeclared",

-                                $0, &Tnone, 0, &Tnone);
+                                $0, Tnone, 0, Tnone);

                        type_err(config2context(config), "info: this is where '%v' was first declared",
                        type_err(config2context(config), "info: this is where '%v' was first declared",

-                                v->where_decl, &Tnone, 0, &Tnone);
+                                v->where_decl, Tnone, 0, Tnone);
+               }
+       } }$
+           | IDENTIFIER : Type = ${ {
+               struct variable *v = var_decl(config2context(config), $1.txt);
+               $0 = new_pos(var, $1);
+               $0->var = v;
+               if (v) {
+                       v->where_decl = $0;
+                       v->where_set = $0;
+                       v->val = val_init($<3);
+               } else {
+                       v = var_ref(config2context(config), $1.txt);
+                       $0->var = v;
+                       type_err(config2context(config), "error: variable '%v' redeclared",
+                                $0, Tnone, 0, Tnone);
+                       type_err(config2context(config), "info: this is where '%v' was first declared",
+                                v->where_decl, Tnone, 0, Tnone);
+               }
+       } }$
+           | IDENTIFIER :: Type = ${ {
+               struct variable *v = var_decl(config2context(config), $1.txt);
+               $0 = new_pos(var, $1);
+               $0->var = v;
+               if (v) {
+                       v->where_decl = $0;
+                       v->where_set = $0;
+                       v->val = val_init($<3);
+                       v->constant = 1;
+               } else {
+                       v = var_ref(config2context(config), $1.txt);
+                       $0->var = v;
+                       type_err(config2context(config), "error: variable '%v' redeclared",
+                                $0, Tnone, 0, Tnone);
+                       type_err(config2context(config), "info: this is where '%v' was first declared",
+                                v->where_decl, Tnone, 0, Tnone);

                }
        } }$
 
                }
        } }$
 


@@ -1569,7 +1667,7 @@ link to find the primary instance.
                        /* This might be a label - allocate a var just in case */
                        v = var_decl(config2context(config), $1.txt);
                        if (v) {
                        /* This might be a label - allocate a var just in case */
                        v = var_decl(config2context(config), $1.txt);
                        if (v) {

-                               v->val = val_init(&Tlabel);
+                               v->val = val_init(Tlabel);

                                v->val.label = &v->val;
                                v->where_set = $0;
                        }
                                v->val.label = &v->val;
                                v->where_set = $0;
                        }


@@ -1577,6 +1675,17 @@ link to find the primary instance.
                $0->var = v;
        } }$
 
                $0->var = v;
        } }$
 

+       $*type
+       Type -> IDENTIFIER ${
+               $0 = find_type(config2context(config), $1.txt);
+               if (!$0) {
+                       tok_err(config2context(config),
+                               "error: undefined type", &$1);
+
+                       $0 = Tnone;
+               }
+       }$
+

 ###### print exec cases
        case Xvar:
        {
 ###### print exec cases
        case Xvar:
        {


@@ -1608,9 +1717,9 @@ link to find the primary instance.
                struct var *var = cast(var, prog);
                struct variable *v = var->var;
                if (!v) {
                struct var *var = cast(var, prog);
                struct variable *v = var->var;
                if (!v) {

-                       type_err(c, "%d:BUG: no variable!!", prog, &Tnone, 0, &Tnone);
+                       type_err(c, "%d:BUG: no variable!!", prog, Tnone, 0, Tnone);

                        *ok = 0;
                        *ok = 0;

-                       return &Tnone;
+                       return Tnone;

                }
                if (v->merged)
                        v = v->merged;
                }
                if (v->merged)
                        v = v->merged;


@@ -1626,7 +1735,7 @@ link to find the primary instance.
                        type_err(c, "error: expected %1%r but variable '%v' is %2", prog,
                                 type, rules, v->val.type);
                        type_err(c, "info: this is where '%v' was set to %1", v->where_set,
                        type_err(c, "error: expected %1%r but variable '%v' is %2", prog,
                                 type, rules, v->val.type);
                        type_err(c, "info: this is where '%v' was set to %1", v->where_set,

-                                v->val.type, rules, &Tnone);
+                                v->val.type, rules, Tnone);

                        *ok = 0;
                }
                if (!type)
                        *ok = 0;
                }
                if (!type)


@@ -1669,7 +1778,7 @@ and `BFact`s.
        Or,
        Not,
 
        Or,
        Not,
 

-####### Grammar
+###### Grammar

 
        $*exec
        Expression -> Expression or BTerm ${ {
 
        $*exec
        Expression -> Expression or BTerm ${ {


@@ -1719,14 +1828,14 @@ and `BFact`s.
        case Or:
        case Not:
                /* both must be Tbool, result is Tbool */
        case Or:
        case Not:
                /* both must be Tbool, result is Tbool */

-               propagate_types(b->left, c, ok, &Tbool, 0);
-               propagate_types(b->right, c, ok, &Tbool, 0);
-               if (type && type != &Tbool) {
+               propagate_types(b->left, c, ok, Tbool, 0);
+               propagate_types(b->right, c, ok, Tbool, 0);
+               if (type && type != Tbool) {

                        type_err(c, "error: %1 operation found where %2 expected", prog,
                        type_err(c, "error: %1 operation found where %2 expected", prog,

-                                  &Tbool, 0, type);
+                                  Tbool, 0, type);

                        *ok = 0;
                }
                        *ok = 0;
                }

-               return &Tbool;
+               return Tbool;

 
 ###### interp binode cases
        case And:
 
 ###### interp binode cases
        case And:


@@ -1831,12 +1940,12 @@ expression operator.
                        if (t)
                                t = propagate_types(b->left, c, ok, t, 0);
                }
                        if (t)
                                t = propagate_types(b->left, c, ok, t, 0);
                }

-               if (!vtype_compat(type, &Tbool, 0)) {
+               if (!vtype_compat(type, Tbool, 0)) {

                        type_err(c, "error: Comparison returns %1 but %2 expected", prog,
                        type_err(c, "error: Comparison returns %1 but %2 expected", prog,

-                                   &Tbool, rules, type);
+                                   Tbool, rules, type);

                        *ok = 0;
                }
                        *ok = 0;
                }

-               return &Tbool;
+               return Tbool;

 
 ###### interp binode cases
        case Less:
 
 ###### interp binode cases
        case Less:


@@ -1850,7 +1959,7 @@ expression operator.
                left = interp_exec(b->left);
                right = interp_exec(b->right);
                cmp = value_cmp(left, right);
                left = interp_exec(b->left);
                right = interp_exec(b->right);
                cmp = value_cmp(left, right);

-               rv.type = &Tbool;
+               rv.type = Tbool;

                switch (b->op) {
                case Less:      rv.bool = cmp <  0; break;
                case LessEq:    rv.bool = cmp <= 0; break;
                switch (b->op) {
                case Less:      rv.bool = cmp <  0; break;
                case LessEq:    rv.bool = cmp <= 0; break;


@@ -1972,25 +2081,25 @@ precedence is handled better I might be able to discard this.
        case Negate:
                /* as propagate_types ignores a NULL,
                 * unary ops fit here too */
        case Negate:
                /* as propagate_types ignores a NULL,
                 * unary ops fit here too */

-               propagate_types(b->left, c, ok, &Tnum, 0);
-               propagate_types(b->right, c, ok, &Tnum, 0);
-               if (!vtype_compat(type, &Tnum, 0)) {
+               propagate_types(b->left, c, ok, Tnum, 0);
+               propagate_types(b->right, c, ok, Tnum, 0);
+               if (!vtype_compat(type, Tnum, 0)) {

                        type_err(c, "error: Arithmetic returns %1 but %2 expected", prog,
                        type_err(c, "error: Arithmetic returns %1 but %2 expected", prog,

-                                  &Tnum, rules, type);
+                                  Tnum, rules, type);

                        *ok = 0;
                }
                        *ok = 0;
                }

-               return &Tnum;
+               return Tnum;

 
        case Concat:
                /* both must be Tstr, result is Tstr */
 
        case Concat:
                /* both must be Tstr, result is Tstr */

-               propagate_types(b->left, c, ok, &Tstr, 0);
-               propagate_types(b->right, c, ok, &Tstr, 0);
-               if (!vtype_compat(type, &Tstr, 0)) {
+               propagate_types(b->left, c, ok, Tstr, 0);
+               propagate_types(b->right, c, ok, Tstr, 0);
+               if (!vtype_compat(type, Tstr, 0)) {

                        type_err(c, "error: Concat returns %1 but %2 expected", prog,
                        type_err(c, "error: Concat returns %1 but %2 expected", prog,

-                                  &Tstr, rules, type);
+                                  Tstr, rules, type);

                        *ok = 0;
                }
                        *ok = 0;
                }

-               return &Tstr;
+               return Tstr;

 
        case Bracket:
                return propagate_types(b->right, c, ok, type, 0);
 
        case Bracket:
                return propagate_types(b->right, c, ok, type, 0);


@@ -2031,7 +2140,7 @@ precedence is handled better I might be able to discard this.
        case Concat:
                left = interp_exec(b->left);
                right = interp_exec(b->right);
        case Concat:
                left = interp_exec(b->left);
                right = interp_exec(b->right);

-               rv.type = &Tstr;
+               rv.type = Tstr;

                rv.str = text_join(left.str, right.str);
                break;
 
                rv.str = text_join(left.str, right.str);
                break;
 


@@ -2188,9 +2297,9 @@ list.
 
                for (e = b; e; e = cast(binode, e->right)) {
                        t = propagate_types(e->left, c, ok, NULL, rules);
 
                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 = NULL;
                                t = NULL;

-                       if (t && t != &Tnone && t != &Tbool) {
+                       if (t && t != Tnone && t != Tbool) {

                                if (!type)
                                        type = t;
                                else if (t != type) {
                                if (!type)
                                        type = t;
                                else if (t != type) {


@@ -2205,7 +2314,7 @@ list.
 
 ###### interp binode cases
        case Block:
 
 ###### interp binode cases
        case Block:

-               while (rv.type == &Tnone &&
+               while (rv.type == Tnone &&

                       b) {
                        if (b->left)
                                rv = interp_exec(b->left);
                       b) {
                        if (b->left)
                                rv = interp_exec(b->left);


@@ -2301,7 +2410,7 @@ same solution.
                                        sep = ' ';
                        } else if (sep)
                                eol = 0;
                                        sep = ' ';
                        } else if (sep)
                                eol = 0;

-               left.type = &Tnone;
+               left.type = Tnone;

                if (eol)
                        printf("\n");
                break;
                if (eol)
                        printf("\n");
                break;


@@ -2352,15 +2461,27 @@ it is declared, and error will be raised as the name is created as
                break;
 
        case Declare:
                break;
 
        case Declare:

+               {
+               struct variable *v = cast(var, b->left)->var;

                do_indent(indent, "");
                print_exec(b->left, indent, 0);
                do_indent(indent, "");
                print_exec(b->left, indent, 0);

-               if (cast(var, b->left)->var->constant)
-                       printf(" ::= ");
-               else
-                       printf(" := ");
+               if (cast(var, b->left)->var->constant) {
+                       if (v->where_decl == v->where_set)
+                               printf("::%.*s = ", v->val.type->name.len,
+                                      v->val.type->name.txt);
+                       else
+                               printf(" ::= ");
+               } else {
+                       if (v->where_decl == v->where_set)
+                               printf(":%.*s = ", v->val.type->name.len,
+                                      v->val.type->name.txt);
+                       else
+                               printf(" := ");
+               }

                print_exec(b->right, indent, 0);
                if (indent >= 0)
                        printf("\n");
                print_exec(b->right, indent, 0);
                if (indent >= 0)
                        printf("\n");

+               }

                break;
 
 ###### propagate binode cases
                break;
 
 ###### propagate binode cases


@@ -2373,13 +2494,13 @@ it is declared, and error will be raised as the name is created as
                        if (propagate_types(b->right, c, ok, t, 0) != t)
                                if (b->left->type == Xvar)
                                        type_err(c, "info: variable '%v' was set as %1 here.",
                        if (propagate_types(b->right, c, ok, t, 0) != t)
                                if (b->left->type == Xvar)
                                        type_err(c, "info: variable '%v' was set as %1 here.",

-                                                cast(var, b->left)->var->where_set, t, rules, &Tnone);
+                                                cast(var, b->left)->var->where_set, t, rules, Tnone);

                } else {
                        t = propagate_types(b->right, c, ok, NULL, Rnolabel);
                        if (t)
                                propagate_types(b->left, c, ok, t, 0);
                }
                } else {
                        t = propagate_types(b->right, c, ok, NULL, Rnolabel);
                        if (t)
                                propagate_types(b->left, c, ok, t, 0);
                }

-               return &Tnone;
+               return Tnone;

 
                break;
 
 
                break;
 


@@ -2818,19 +2939,19 @@ defined.
                struct cond_statement *cs = cast(cond_statement, prog);
                struct casepart *cp;
 
                struct cond_statement *cs = cast(cond_statement, prog);
                struct casepart *cp;
 

-               t = propagate_types(cs->forpart, c, ok, &Tnone, 0);
-               if (!vtype_compat(&Tnone, t, 0))
+               t = propagate_types(cs->forpart, c, ok, Tnone, 0);
+               if (!vtype_compat(Tnone, t, 0))

                        *ok = 0;
                        *ok = 0;

-               t = propagate_types(cs->dopart, c, ok, &Tnone, 0);
-               if (!vtype_compat(&Tnone, t, 0))
+               t = propagate_types(cs->dopart, c, ok, Tnone, 0);
+               if (!vtype_compat(Tnone, t, 0))

                        *ok = 0;
                if (cs->dopart) {
                        *ok = 0;
                if (cs->dopart) {

-                       t = propagate_types(cs->thenpart, c, ok, &Tnone, 0);
-                       if (!vtype_compat(&Tnone, t, 0))
+                       t = propagate_types(cs->thenpart, c, ok, Tnone, 0);
+                       if (!vtype_compat(Tnone, t, 0))

                                *ok = 0;
                }
                if (cs->casepart == NULL)
                                *ok = 0;
                }
                if (cs->casepart == NULL)

-                       propagate_types(cs->condpart, c, ok, &Tbool, 0);
+                       propagate_types(cs->condpart, c, ok, Tbool, 0);

                else {
                        /* Condpart must match case values, with bool permitted */
                        t = NULL;
                else {
                        /* Condpart must match case values, with bool permitted */
                        t = NULL;


@@ -2879,9 +3000,9 @@ defined.
                        if (c->condpart)
                                cnd = interp_exec(c->condpart);
                        else
                        if (c->condpart)
                                cnd = interp_exec(c->condpart);
                        else

-                               cnd.type = &Tnone;
-                       if (!(cnd.type == &Tnone ||
-                             (cnd.type == &Tbool && cnd.bool != 0)))
+                               cnd.type = Tnone;
+                       if (!(cnd.type == Tnone ||
+                             (cnd.type == Tbool && cnd.bool != 0)))

                                break;
                        // cnd is Tnone or Tbool, doesn't need to be freed
                        if (c->dopart)
                                break;
                        // cnd is Tnone or Tbool, doesn't need to be freed
                        if (c->dopart)


@@ -2889,7 +3010,7 @@ defined.
 
                        if (c->thenpart) {
                                v = interp_exec(c->thenpart);
 
                        if (c->thenpart) {
                                v = interp_exec(c->thenpart);

-                               if (v.type != &Tnone || !c->dopart)
+                               if (v.type != Tnone || !c->dopart)

                                        return v;
                                free_value(v);
                        }
                                        return v;
                                free_value(v);
                        }


@@ -2907,7 +3028,7 @@ defined.
                free_value(cnd);
                if (c->elsepart)
                        return interp_exec(c->elsepart);
                free_value(cnd);
                if (c->elsepart)
                        return interp_exec(c->elsepart);

-               v.type = &Tnone;
+               v.type = Tnone;

                return v;
        }
 
                return v;
        }
 


@@ -2930,7 +3051,7 @@ analysis is a bit more interesting at this level.
 ###### Parser: grammar
 
        $*binode
 ###### Parser: grammar
 
        $*binode

-       Program -> program OpenScope Varlist Block OptNL ${
+       Program -> InitProgram OpenScope Varlist Block OptNL ${

                $0 = new(binode);
                $0->op = Program;
                $0->left = reorder_bilist($<3);
                $0 = new(binode);
                $0->op = Program;
                $0->left = reorder_bilist($<3);


@@ -2943,6 +3064,10 @@ analysis is a bit more interesting at this level.
                                "error: unhandled parse error.", &$1);
                }$
 
                                "error: unhandled parse error.", &$1);
                }$
 

+       InitProgram -> program ${
+               context_init(config2context(config));
+               }$
+

        Varlist -> Varlist ArgDecl ${
                        $0 = new(binode);
                        $0->op = Program;
        Varlist -> Varlist ArgDecl ${
                        $0 = new(binode);
                        $0->op = Program;


@@ -2990,7 +3115,7 @@ analysis is a bit more interesting at this level.
                        return 0;
                do {
                        ok = 1;
                        return 0;
                do {
                        ok = 1;

-                       propagate_types(b->right, c, &ok, &Tnone, 0);
+                       propagate_types(b->right, c, &ok, Tnone, 0);

                } while (ok == 2);
                if (!ok)
                        return 0;
                } while (ok == 2);
                if (!ok)
                        return 0;


@@ -2999,19 +3124,19 @@ analysis is a bit more interesting at this level.
                        struct var *v = cast(var, b->left);
                        if (!v->var->val.type) {
                                v->var->where_set = b;
                        struct var *v = cast(var, b->left);
                        if (!v->var->val.type) {
                                v->var->where_set = b;

-                               v->var->val = val_init(&Tstr);
+                               v->var->val = val_init(Tstr);

                        }
                }
                b = cast(binode, prog);
                do {
                        ok = 1;
                        }
                }
                b = cast(binode, prog);
                do {
                        ok = 1;

-                       propagate_types(b->right, c, &ok, &Tnone, 0);
+                       propagate_types(b->right, c, &ok, Tnone, 0);

                } while (ok == 2);
                if (!ok)
                        return 0;
 
                /* Make sure everything is still consistent */
                } while (ok == 2);
                if (!ok)
                        return 0;
 
                /* Make sure everything is still consistent */

-               propagate_types(b->right, c, &ok, &Tnone, 0);
+               propagate_types(b->right, c, &ok, Tnone, 0);

                return !!ok;
        }
 
                return !!ok;
        }
 


@@ -3075,13 +3200,14 @@ Fibonacci, and performs a binary search for a number.
                 * merge happens, so types can be different
                 */
                if A * 2 > B:
                 * merge happens, so types can be different
                 */
                if A * 2 > B:

-                       double := "yes"
+                       double:string = "yes"

                        print A, "is more than twice", B, "?", double
                else:
                        double := A*2
                        print "double", A, "is only", double
 
                        print A, "is more than twice", B, "?", double
                else:
                        double := A*2
                        print "double", A, "is only", double
 

-               a := A; b := B
+               a := A;
+               b:number = B

                if a > 0 and b > 0:
                        while a != b:
                                if a < b:
                if a > 0 and b > 0:
                        while a != b:
                                if a < b: