X-Git-Url: https://ocean-lang.org/code/?a=blobdiff_plain;f=csrc%2Foceani.mdc;h=6c5b4466a229ec73a63ac565e5e5300cbd43b740;hb=20651d69e0f672461c2c458ae07fe98d0c1c6c28;hp=e399a2a88374389ada32a9315ea51f84b822e877;hpb=66f3d29e6a32a78cc54af282491683b7d2746ca4;p=ocean diff --git a/csrc/oceani.mdc b/csrc/oceani.mdc index e399a2a..6c5b446 100644 --- a/csrc/oceani.mdc +++ b/csrc/oceani.mdc @@ -236,24 +236,30 @@ structures can be used. } } else ss = s; // NOTEST + if (!ss->code) { + fprintf(stderr, "oceani: no code found in requested section\n"); // NOTEST + exit(1); // NOTEST + } + parse_oceani(ss->code, &context.config, dotrace ? stderr : NULL); if (!context.prog) { fprintf(stderr, "oceani: no main function found.\n"); context.parse_error = 1; } + if (context.prog && !context.parse_error) { + if (!analyse_prog(context.prog, &context)) { + fprintf(stderr, "oceani: type error in program - not running.\n"); + context.parse_error = 1; + } + } if (context.prog && doprint) { ## print const decls ## print type decls print_exec(context.prog, 0, brackets); } - if (context.prog && doexec && !context.parse_error) { - if (!analyse_prog(context.prog, &context)) { - fprintf(stderr, "oceani: type error in program - not running.\n"); - exit(1); - } + if (context.prog && doexec && !context.parse_error) interp_prog(&context, context.prog, argc - optind, argv+optind); - } free_exec(context.prog); while (s) { @@ -262,8 +268,9 @@ structures can be used. free(s); s = t; } - ## free context vars + ## free global vars ## free context types + ## free context storage exit(context.parse_error ? 1 : 0); } @@ -496,8 +503,10 @@ Named type are stored in a simple linked list. Objects of each type are static void free_value(struct type *type, struct value *v) { - if (type && v) + if (type && v) { type->free(type, v); + memset(v, 0x5a, type->size); + } } static void type_print(struct type *type, FILE *f) @@ -844,6 +853,42 @@ cannot nest, so a declaration while a name is in-scope is an error. ## variable fields }; +When a scope closes, the values of the variables might need to be freed. +This happens in the context of some `struct exec` and each `exec` will +need to know which variables need to be freed when it completes. + +####### exec fields + struct variable *to_free; + +####### variable fields + struct exec *cleanup_exec; + struct variable *next_free; + +####### interp exec cleanup + { + struct variable *v; + for (v = e->to_free; v; v = v->next_free) { + struct value *val = var_value(c, v); + free_value(v->type, val); + } + } + +###### ast functions + static void variable_unlink_exec(struct variable *v) + { + struct variable **vp; + if (!v->cleanup_exec) + return; + for (vp = &v->cleanup_exec->to_free; + *vp; vp = &(*vp)->next_free) { + if (*vp != v) + continue; + *vp = v->next_free; + v->cleanup_exec = NULL; + break; + } + } + While the naming seems strange, we include local constants in the definition of variables. A name declared `var := value` can subsequently be changed, but a name declared `var ::= value` cannot - @@ -931,7 +976,6 @@ like "if" and the code following it. $void OpenScope -> ${ scope_push(c); }$ - ClosePara -> ${ var_block_close(c, CloseParallel); }$ Each variable records a scope depth and is in one of four states: @@ -952,13 +996,13 @@ Each variable records a scope depth and is in one of four states: enclosed the declaration, and that has closed. - "conditionally in scope". The "in scope" block and all parallel - scopes have closed, and no further mention of the name has been - seen. This state includes a secondary nest depth which records the - outermost scope seen since the variable became conditionally in - scope. If a use of the name is found, the variable becomes "in - scope" and that secondary depth becomes the recorded scope depth. - If the name is declared as a new variable, the old variable becomes - "out of scope" and the recorded scope depth stays unchanged. + scopes have closed, and no further mention of the name has been seen. + This state includes a secondary nest depth (`min_depth`) which records + the outermost scope seen since the variable became conditionally in + scope. If a use of the name is found, the variable becomes "in scope" + and that secondary depth becomes the recorded scope depth. If the + name is declared as a new variable, the old variable becomes "out of + scope" and the recorded scope depth stays unchanged. - "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 @@ -1001,23 +1045,22 @@ need to be freed. For this we need to be able to find it, so assume that { struct variable *v; - if (primary->merged) - // shouldn't happen - primary = primary->merged; // NOTEST + primary = primary->merged; for (v = primary->previous; v; v=v->previous) if (v == secondary || v == secondary->merged || v->merged == secondary || - (v->merged && v->merged == secondary->merged)) { + v->merged == secondary->merged) { v->scope = OutScope; v->merged = primary; + variable_unlink_exec(v); } } ###### forward decls static struct value *var_value(struct parse_context *c, struct variable *v); -###### free context vars +###### free global vars while (context.varlist) { struct binding *b = context.varlist; @@ -1028,10 +1071,11 @@ need to be freed. For this we need to be able to find it, so assume that struct variable *t = v; v = t->previous; - free_value(t->type, var_value(&context, t)); - if (t->depth == 0) - // This is a global constant - free_exec(t->where_decl); + if (t->global) { + free_value(t->type, var_value(&context, t)); + if (t->depth == 0) + free_exec(t->where_decl); + } free(t); } } @@ -1066,7 +1110,7 @@ switch. Other scopes are "sequential". When exiting a parallel scope we check if there are any variables that were previously pending and are still visible. If there are, then -there weren't redeclared in the most recent scope, so they cannot be +they weren't redeclared in the most recent scope, so they cannot be merged and must become out-of-scope. If it is not the first of parallel scopes (based on `child_count`), we check that there was a previous binding that is still pending-scope. If there isn't, the new @@ -1104,6 +1148,7 @@ all pending-scope variables become conditionally scoped. v->previous = b->var; b->var = v; v->name = b; + v->merged = v; v->min_depth = v->depth = c->scope_depth; v->scope = InScope; v->in_scope = c->in_scope; @@ -1139,29 +1184,56 @@ all pending-scope variables become conditionally scoped. return v; } - static void var_block_close(struct parse_context *c, enum closetype ct) + static void var_block_close(struct parse_context *c, enum closetype ct, + struct exec *e) { - /* Close off all variables that are in_scope */ + /* Close off all variables that are in_scope. + * Some variables in c->scope may already be not-in-scope, + * such as when a PendingScope variable is hidden by a new + * variable with the same name. + * So we check for v->name->var != v and drop them. + * If we choose to make a variable OutScope, we drop it + * immediately too. + */ struct variable *v, **vp, *v2; scope_pop(c); for (vp = &c->in_scope; - v = *vp, v && v->depth > c->scope_depth && v->min_depth > c->scope_depth; - ) { - if (v->name->var == v) switch (ct) { + (v = *vp) && v->min_depth > c->scope_depth; + (v->scope == OutScope || v->name->var != v) + ? (*vp = v->in_scope, 0) + : ( vp = &v->in_scope, 0)) { + v->min_depth = c->scope_depth; + if (v->name->var != v) + /* This is still in scope, but we haven't just + * closed the scope. + */ + continue; + v->min_depth = c->scope_depth; + if (v->scope == InScope) { + /* This variable gets cleaned up when 'e' finishes */ + variable_unlink_exec(v); + v->cleanup_exec = e; + v->next_free = e->to_free; + e->to_free = v; + } + switch (ct) { case CloseElse: case CloseParallel: /* handle PendingScope */ switch(v->scope) { case InScope: case CondScope: if (c->scope_stack->child_count == 1) + /* first among parallel branches */ v->scope = PendingScope; else if (v->previous && v->previous->scope == PendingScope) + /* all previous branches used name */ v->scope = PendingScope; else if (v->type == Tlabel) - v->scope = PendingScope; - else if (v->name->var == v) + /* Labels remain pending even when not used */ + v->scope = PendingScope; // UNTESTED + else v->scope = OutScope; if (ct == CloseElse) { /* All Pending variables with this name @@ -1173,13 +1245,16 @@ all pending-scope variables become conditionally scoped. } break; case PendingScope: - for (v2 = v; - v2 && v2->scope == PendingScope; - v2 = v2->previous) - if (v2->type != Tlabel) - v2->scope = OutScope; - break; - case OutScope: break; + /* Not possible as it would require + * parallel scope to be nested immediately + * in a parallel scope, and that never + * happens. + */ // NOTEST + case OutScope: + /* Not possible as we already tested for + * OutScope + */ + abort(); // NOTEST } break; case CloseSequential: @@ -1198,10 +1273,9 @@ all pending-scope variables become conditionally scoped. for (v2 = v; v2 && v2->scope == PendingScope; v2 = v2->previous) - if (v2->type == Tlabel) { + if (v2->type == Tlabel) v2->scope = CondScope; - v2->min_depth = c->scope_depth; - } else + else v2->scope = OutScope; break; case CondScope: @@ -1209,10 +1283,6 @@ all pending-scope variables become conditionally scoped. } break; } - if (v->scope == OutScope || v->name->var != v) - *vp = v->in_scope; - else - vp = &v->in_scope; } } @@ -1245,7 +1315,7 @@ is started, so there is no need to allocate until the size is known. { if (!v->global) { if (!c->local || !v->type) - return NULL; + return NULL; // NOTEST if (v->frame_pos + v->type->size > c->local_size) { printf("INVALID frame_pos\n"); // NOTEST exit(2); // NOTEST @@ -1271,7 +1341,7 @@ is started, so there is no need to allocate until the size is known. t->prepare_type(c, t, 1); // NOTEST if (c->global_size & (t->align - 1)) - c->global_size = (c->global_size + t->align) & ~(t->align-1); + c->global_size = (c->global_size + t->align) & ~(t->align-1); // UNTESTED if (!v) { v = &scratch; v->type = t; @@ -1305,7 +1375,7 @@ For this we have `scope_finalize()`. struct variable *v; for (v = b->var; v; v = v->previous) { struct type *t = v->type; - if (v->merged && v->merged != v) + if (v->merged != v) continue; if (v->global) continue; @@ -1318,7 +1388,7 @@ For this we have `scope_finalize()`. c->local = calloc(1, c->local_size); } -###### free context vars +###### free context storage free(context.global); free(context.local); @@ -1361,6 +1431,7 @@ from the `exec_types` enum. struct exec { enum exec_types type; int line, column; + ## exec fields }; struct binode { struct exec; @@ -1458,12 +1529,21 @@ also want to know what sort of bracketing to use. static void print_exec(struct exec *e, int indent, int bracket) { if (!e) - return; // NOTEST + return; switch (e->type) { case Xbinode: print_binode(cast(binode, e), indent, bracket); break; ## print exec cases } + if (e->to_free) { + struct variable *v; + do_indent(indent, "/* FREE"); + for (v = e->to_free; v; v = v->next_free) + printf(" %.*s(%c%d+%d)", v->name->name.len, v->name->name.txt, + v->global ? 'G':'L', + v->frame_pos, v->type ? v->type->size:0); + printf(" */\n"); + } } ###### forward decls @@ -1609,6 +1689,7 @@ in `rval`. ret.lval = lrv; ret.rval = rv; ret.type = rvtype; + ## interp exec cleanup return ret; } @@ -1726,23 +1807,23 @@ with a const size by whether they are prepared at parse time or not. static int array_compat(struct type *require, struct type *have) { if (have->compat != require->compat) - return 0; + return 0; // UNTESTED /* Both are arrays, so we can look at details */ if (!type_compat(require->array.member, have->array.member, 0)) return 0; if (have->array.unspec && require->array.unspec) { if (have->array.vsize && require->array.vsize && - have->array.vsize != require->array.vsize) + have->array.vsize != require->array.vsize) // UNTESTED /* sizes might not be the same */ - return 0; + return 0; // UNTESTED return 1; } if (have->array.unspec || require->array.unspec) - return 1; + return 1; // UNTESTED if (require->array.vsize == NULL && have->array.vsize == NULL) return require->array.size == have->array.size; - return require->array.vsize == have->array.vsize; + return require->array.vsize == have->array.vsize; // UNTESTED } static void array_print_type(struct type *type, FILE *f) @@ -2064,7 +2145,7 @@ function will be needed. struct type *st = propagate_types(f->left, c, ok, NULL, 0); if (!st) - type_err(c, "error: unknown type for field access", f->left, + type_err(c, "error: unknown type for field access", f->left, // UNTESTED NULL, 0, NULL); else if (st->init != structure_init) type_err(c, "error: field reference attempted on %1, not a struct", @@ -2109,8 +2190,8 @@ function will be needed. return; free_fieldlist(f->prev); if (f->f.init) { - free_value(f->f.type, f->f.init); - free(f->f.init); + free_value(f->f.type, f->f.init); // UNTESTED + free(f->f.init); // UNTESTED } free(f); } @@ -2166,7 +2247,7 @@ function will be needed. | ERROR ${ tok_err(c, "Syntax error in struct field", &$1); }$ Field -> IDENTIFIER : Type = Expression ${ { - int ok; + int ok; // UNTESTED $0 = calloc(1, sizeof(struct fieldlist)); $0->f.name = $1.txt; @@ -2177,7 +2258,7 @@ function will be needed. propagate_types($<5, c, &ok, $3, 0); } while (ok == 2); if (!ok) - c->parse_error = 1; + c->parse_error = 1; // UNTESTED else { struct value vl = interp_exec(c, $5, NULL); $0->f.init = global_alloc(c, $0->f.type, NULL, &vl); @@ -2195,9 +2276,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) - { - int i; + static void structure_print_type(struct type *t, FILE *f) // UNTESTED + { // UNTESTED + int i; // UNTESTED fprintf(f, "struct %.*s\n", t->name.len, t->name.txt); @@ -2208,18 +2289,18 @@ function will be needed. if (fl->type->print && fl->init) { fprintf(f, " = "); if (fl->type == Tstr) - fprintf(f, "\""); + fprintf(f, "\""); // UNTESTED print_value(fl->type, fl->init); if (fl->type == Tstr) - fprintf(f, "\""); + fprintf(f, "\""); // UNTESTED } printf("\n"); } } ###### print type decls - { - struct type *t; + { // UNTESTED + struct type *t; // UNTESTED int target = -1; while (target != 0) { @@ -2267,6 +2348,9 @@ or as an indented list of one parameter per line do code block +For constructing these lists we use a `List` binode, which will be +further detailed when Expression Lists are introduced. + ###### Binode types Func, List, @@ -2280,7 +2364,7 @@ or as an indented list of one parameter per line $0->op = Func; $0->left = reorder_bilist($right = $scope_stack && !c->parse_error) abort(); }$ | func main IN OpenScope OptNL Args OUT OptNL do Block Newlines ${ @@ -2288,7 +2372,7 @@ or as an indented list of one parameter per line $0->op = Func; $0->left = reorder_bilist($right = $scope_stack && !c->parse_error) abort(); }$ | func main NEWLINE OpenScope OptNL do Block Newlines ${ @@ -2296,7 +2380,7 @@ or as an indented list of one parameter per line $0->op = Func; $0->left = NULL; $0->right = $scope_stack && !c->parse_error) abort(); }$ @@ -2305,7 +2389,7 @@ or as an indented list of one parameter per line | Varlist ; ${ $0 = $<1; }$ | Varlist NEWLINE ${ $0 = $<1; }$ - Varlist -> Varlist ; ArgDecl ${ + Varlist -> Varlist ; ArgDecl ${ // UNTESTED $0 = new(binode); $0->op = List; $0->left = $val.num, tail, $1.txt) == 0) - mpq_init($0->val.num); + mpq_init($0->val.num); // UNTESTED if (tail[0]) tok_err(c, "error: unsupported number suffix", &$1); @@ -2603,8 +2687,7 @@ link to find the primary instance. type_err(c, "%d:BUG: no variable!!", prog, NULL, 0, NULL); // NOTEST return Tnone; // NOTEST } - if (v->merged) - v = v->merged; + v = v->merged; if (v->constant && (rules & Rnoconstant)) { type_err(c, "error: Cannot assign to a constant: %v", prog, NULL, 0, NULL); @@ -2640,8 +2723,7 @@ link to find the primary instance. struct var *var = cast(var, e); struct variable *v = var->var; - if (v->merged) - v = v->merged; + v = v->merged; lrv = var_value(c, v); rvtype = v->type; break; @@ -2726,12 +2808,63 @@ there. struct binode *b2 = cast(binode, b->right); left = interp_exec(c, b->left, <ype); if (left.bool) - rv = interp_exec(c, b2->left, &rvtype); + rv = interp_exec(c, b2->left, &rvtype); // UNTESTED else rv = interp_exec(c, b2->right, &rvtype); } break; +### Expression list + +We take a brief detour, now that we have expressions, to describe lists +of expressions. These will be needed for function parameters and +possibly other situations. They seem generic enough to introduce here +to be used elsewhere. + +And ExpressionList will use the `List` type of `binode`, building up at +the end. And place where they are used will probably call +`reorder_bilist()` to get a more normal first/next arrangement. + +###### declare terminals + $TERM , + +`List` execs have no implicit semantics, so they are never propagated or +interpreted. The can be printed as a comma separate list, which is how +they are parsed. Note they are also used for function formal parameter +lists. In that case a separate function is used to print them. + +###### print binode cases + case List: + while (b) { + printf(" "); + print_exec(b->left, -1, bracket); + if (b->right) + printf(","); + b = cast(binode, b->right); + } + break; + +###### propagate binode cases + case List: abort(); // NOTEST +###### interp binode cases + case List: abort(); // NOTEST + +###### Grammar + + $*binode + ExpressionList -> ExpressionList , Expression ${ + $0 = new(binode); + $0->op = List; + $0->left = $<1; + $0->right = $<3; + }$ + | Expression ${ + $0 = new(binode); + $0->op = List; + $0->left = NULL; + $0->right = $<1; + }$ + ### Expressions: Boolean The next class of expressions to use the `binode` will be Boolean @@ -2951,9 +3084,9 @@ expression operator, and the `CMPop` non-terminal will match one of them. if (t) propagate_types(b->right, c, ok, t, 0); else { - t = propagate_types(b->right, c, ok, NULL, Rnolabel); - if (t) - t = propagate_types(b->left, c, ok, t, 0); + t = propagate_types(b->right, c, ok, NULL, Rnolabel); // UNTESTED + if (t) // UNTESTED + t = propagate_types(b->left, c, ok, t, 0); // UNTESTED } if (!type_compat(type, Tbool, 0)) type_err(c, "error: Comparison returns %1 but %2 expected", prog, @@ -3133,7 +3266,7 @@ should only insert brackets were needed for precedence. /* op must be string, result is number */ propagate_types(b->left, c, ok, Tstr, 0); if (!type_compat(type, Tnum, 0)) - type_err(c, + type_err(c, // UNTESTED "error: Can only convert string to number, not %1", prog, type, 0, NULL); return Tnum; @@ -3204,16 +3337,16 @@ should only insert brackets were needed for precedence. char tail[3]; int neg = 0; if (tx.txt[0] == '-') { - neg = 1; - tx.txt++; - tx.len--; + neg = 1; // UNTESTED + tx.txt++; // UNTESTED + tx.len--; // UNTESTED } if (number_parse(rv.num, tail, tx) == 0) - mpq_init(rv.num); + mpq_init(rv.num); // UNTESTED else if (neg) - mpq_neg(rv.num, rv.num); + mpq_neg(rv.num, rv.num); // UNTESTED if (tail[0]) - printf("Unsupported suffix: %.*s\n", tx.len, tx.txt); + printf("Unsupported suffix: %.*s\n", tx.len, tx.txt); // UNTESTED break; @@ -3367,13 +3500,13 @@ is in-place. case Block: if (indent < 0) { // simple statement - if (b->left == NULL) - printf("pass"); + if (b->left == NULL) // UNTESTED + printf("pass"); // UNTESTED else - print_exec(b->left, indent, bracket); - if (b->right) { - printf("; "); - print_exec(b->right, indent, bracket); + print_exec(b->left, indent, bracket); // UNTESTED + if (b->right) { // UNTESTED + printf("; "); // UNTESTED + print_exec(b->right, indent, bracket); // UNTESTED } } else { // block, one per line @@ -3429,62 +3562,47 @@ is in-place. expressions and prints the values separated by spaces and terminated by a newline. No control of formatting is possible. -`print` faces the same list-ordering issue as blocks, and uses the -same solution. +`print` uses `ExpressionList` to collect the expressions and stores them +on the left side of a `Print` binode unlessthere is a trailing comma +when the list is stored on the `right` side and no trailing newline is +printed. ###### Binode types Print, ##### expr precedence - $TERM print , + $TERM print ###### SimpleStatement Grammar | print ExpressionList ${ - $0 = reorder_bilist($<2); - }$ - | print ExpressionList , ${ $0 = new(binode); $0->op = Print; $0->right = NULL; - $0->left = $<2; - $0 = reorder_bilist($0); + $0->left = reorder_bilist($op = Print; + $0->right = reorder_bilist($left = NULL; + } }$ | print ${ $0 = new(binode); $0->op = Print; + $0->left = NULL; $0->right = NULL; }$ -###### Grammar - - $*binode - ExpressionList -> ExpressionList , Expression ${ - $0 = new(binode); - $0->op = Print; - $0->left = $<1; - $0->right = $<3; - }$ - | Expression ${ - $0 = new(binode); - $0->op = Print; - $0->left = NULL; - $0->right = $<1; - }$ - ###### print binode cases case Print: do_indent(indent, "print"); - while (b) { - if (b->left) { - printf(" "); - print_exec(b->left, -1, bracket); - if (b->right) - printf(","); - } - b = cast(binode, b->right); - } + if (b->right) { + print_exec(b->right, -1, bracket); + printf(","); + } else + print_exec(b->left, -1, bracket); if (indent >= 0) printf("\n"); break; @@ -3493,30 +3611,33 @@ same solution. case Print: /* don't care but all must be consistent */ - propagate_types(b->left, c, ok, NULL, Rnolabel); - propagate_types(b->right, c, ok, NULL, Rnolabel); + if (b->left) + b = cast(binode, b->left); + else + b = cast(binode, b->right); + while (b) { + propagate_types(b->left, c, ok, NULL, Rnolabel); + b = cast(binode, b->right); + } break; ###### interp binode cases case Print: { - char sep = 0; - int eol = 1; - for ( ; b; b = cast(binode, b->right)) - if (b->left) { - if (sep) - putchar(sep); - left = interp_exec(c, b->left, <ype); - print_value(ltype, &left); - free_value(ltype, &left); - if (b->right) - sep = ' '; - } else if (sep) - eol = 0; - ltype = Tnone; - if (eol) + struct binode *b2 = cast(binode, b->left); + if (!b2) + b2 = cast(binode, b->right); + for (; b2; b2 = cast(binode, b2->right)) { + left = interp_exec(c, b2->left, <ype); + print_value(ltype, &left); + free_value(ltype, &left); + if (b2->right) + putchar(' '); + } + if (b->right == NULL) printf("\n"); + ltype = Tnone; break; } @@ -3581,19 +3702,17 @@ it is declared, and error will be raised as the name is created as do_indent(indent, ""); print_exec(b->left, indent, bracket); if (cast(var, b->left)->var->constant) { + printf("::"); if (v->where_decl == v->where_set) { - printf("::"); type_print(v->type, stdout); printf(" "); - } else - printf(" ::"); + } } else { + printf(":"); if (v->where_decl == v->where_set) { - printf(":"); type_print(v->type, stdout); printf(" "); - } else - printf(" :"); + } } if (b->right) { printf("= "); @@ -3651,10 +3770,8 @@ it is declared, and error will be raised as the name is created as { struct variable *v = cast(var, b->left)->var; struct value *val; - if (v->merged) - v = v->merged; + v = v->merged; val = var_value(c, v); - free_value(v->type, val); if (v->type->prepare_type) v->type->prepare_type(c, v->type, 0); if (b->right) { @@ -3781,7 +3898,15 @@ the type of the `whilepart` code block is the reason for the `Rboolok` flag which is passed to `propagate_types()`. The `cond_statement` cannot fit into a `binode` so a new `exec` is -defined. +defined. As there are two scopes which cover multiple parts - one for +the whole statement and one for "while" and "do" - and as we will use +the 'struct exec' to track scopes, we actually need two new types of +exec. One is a `binode` for the looping part, the rest is the +`cond_statement`. The `cond_statement` will use an auxilliary `struct +casepart` to track a list of case parts. + +###### Binode types + Loop ###### exec type Xcond_statement, @@ -3794,7 +3919,8 @@ defined. }; struct cond_statement { struct exec; - struct exec *forpart, *condpart, *dopart, *thenpart, *elsepart; + struct exec *forpart, *condpart, *thenpart, *elsepart; + struct binode *looppart; struct casepart *casepart; }; @@ -3818,7 +3944,7 @@ defined. return; free_exec(s->forpart); free_exec(s->condpart); - free_exec(s->dopart); + free_exec(s->looppart); free_exec(s->thenpart); free_exec(s->elsepart); free_casepart(s->casepart); @@ -3845,53 +3971,49 @@ defined. // may or may not end with EOL // WhilePart and IfPart include an appropriate Suffix - // Both ForPart and Whilepart open scopes, and CondSuffix only - // closes one - so in the first branch here we have another to close. + // ForPart, SwitchPart, and IfPart open scopes, o we have to close + // them. WhilePart opens and closes its own scope. CondStatement -> ForPart OptNL ThenPart OptNL WhilePart CondSuffix ${ $0 = $forpart = $thenpart = $condpart = $WP.condpart; $WP.condpart = NULL; - $0->dopart = $WP.dopart; $WP.dopart = NULL; - var_block_close(c, CloseSequential); + $0->looppart = $forpart = $condpart = $WP.condpart; $WP.condpart = NULL; - $0->dopart = $WP.dopart; $WP.dopart = NULL; - var_block_close(c, CloseSequential); + $0->looppart = $condpart = $WP.condpart; $WP.condpart = NULL; - $0->dopart = $WP.dopart; $WP.dopart = NULL; + $0->looppart = $condpart = $next = $0->casepart; $0->casepart = $condpart = $next = $0->casepart; $0->casepart = $condpart = $IP.condpart; $IP.condpart = NULL; $0->thenpart = $IP.thenpart; $IP.thenpart = NULL; // This is where we close an "if" statement - var_block_close(c, CloseSequential); + var_block_close(c, CloseSequential, $0); }$ CondSuffix -> IfSuffix ${ $0 = $<1; - // This is where we close scope of the whole - // "for" or "while" statement - var_block_close(c, CloseSequential); }$ | Newlines CasePart CondSuffix ${ $0 = $ else OpenBlock Newlines ${ $0 = new(cond_statement); $0->elsepart = $elsepart); }$ | else OpenScope CondStatement ${ $0 = new(cond_statement); $0->elsepart = $elsepart); }$ $*casepart @@ -3924,46 +4046,58 @@ defined. $0 = calloc(1,sizeof(struct casepart)); $0->value = $action = $action); }$ $*exec - // These scopes are closed in CondSuffix + // These scopes are closed in CondStatement ForPart -> for OpenBlock ${ $0 = $ then OpenBlock ${ $0 = $ while UseBlock OptNL do Block ${ - $0.condpart = $ while UseBlock OptNL do OpenBlock ${ + $0 = new(binode); + $0->op = Loop; + $0->left = $right = $right); + var_block_close(c, CloseSequential, $0); }$ - | while OpenScope Expression ColonBlock ${ - $0.condpart = $op = Loop; + $0->left = $right = $right); + var_block_close(c, CloseSequential, $0); }$ - IfPart -> if UseBlock OptNL then OpenBlock ClosePara ${ + $cond_statement + IfPart -> if UseBlock OptNL then OpenBlock ${ $0.condpart = $ switch OpenScope Expression ${ $0 = $left && b->left->type == Xbinode && + cast(binode, b->left)->op == Block) { + if (bracket) + do_indent(indent, "while {\n"); + else + do_indent(indent, "while\n"); + print_exec(b->left, indent+1, bracket); + if (bracket) + do_indent(indent, "} do {\n"); + else + do_indent(indent, "do\n"); + print_exec(b->right, indent+1, bracket); + if (bracket) + do_indent(indent, "}\n"); + } else { + do_indent(indent, "while "); + print_exec(b->left, 0, bracket); + if (bracket) + printf(" {\n"); + else + printf(":\n"); + print_exec(b->right, indent+1, bracket); + if (bracket) + do_indent(indent, "}\n"); + } + break; + ###### print exec cases case Xcond_statement: @@ -3990,33 +4153,8 @@ defined. } if (bracket) do_indent(indent, "}\n"); } - if (cs->dopart) { - // a loop - if (cs->condpart && cs->condpart->type == Xbinode && - cast(binode, cs->condpart)->op == Block) { - if (bracket) - do_indent(indent, "while {\n"); - else - do_indent(indent, "while\n"); - print_exec(cs->condpart, indent+1, bracket); - if (bracket) - do_indent(indent, "} do {\n"); - else - do_indent(indent, "do\n"); - print_exec(cs->dopart, indent+1, bracket); - if (bracket) - do_indent(indent, "}\n"); - } else { - do_indent(indent, "while "); - print_exec(cs->condpart, 0, bracket); - if (bracket) - printf(" {\n"); - else - printf(":\n"); - print_exec(cs->dopart, indent+1, bracket); - if (bracket) - do_indent(indent, "}\n"); - } + if (cs->looppart) { + print_exec(cs->looppart, indent, bracket); } else { // a condition if (cs->casepart) @@ -4028,12 +4166,12 @@ defined. if (bracket) printf(" {\n"); else - printf(":\n"); + printf("\n"); print_exec(cs->condpart, indent+1, bracket); if (bracket) do_indent(indent, "}\n"); if (cs->thenpart) { - do_indent(indent, "then:\n"); + do_indent(indent, "then\n"); print_exec(cs->thenpart, indent+1, bracket); } } else { @@ -4075,11 +4213,18 @@ defined. break; } +###### propagate binode cases + case Loop: + t = propagate_types(b->right, c, ok, Tnone, 0); + if (!type_compat(Tnone, t, 0)) + *ok = 0; // UNTESTED + return propagate_types(b->left, c, ok, type, rules); + ###### propagate exec cases case Xcond_statement: { - // forpart and dopart must return Tnone - // thenpart must return Tnone if there is a dopart, + // forpart and looppart->right must return Tnone + // thenpart must return Tnone if there is a loopart, // otherwise it is like elsepart. // condpart must: // be bool if there is no casepart @@ -4093,43 +4238,45 @@ defined. t = propagate_types(cs->forpart, c, ok, Tnone, 0); if (!type_compat(Tnone, t, 0)) - *ok = 0; - t = propagate_types(cs->dopart, c, ok, Tnone, 0); - if (!type_compat(Tnone, t, 0)) - *ok = 0; - if (cs->dopart) { + *ok = 0; // UNTESTED + + if (cs->looppart) { t = propagate_types(cs->thenpart, c, ok, Tnone, 0); if (!type_compat(Tnone, t, 0)) - *ok = 0; + *ok = 0; // UNTESTED } - if (cs->casepart == NULL) + if (cs->casepart == NULL) { propagate_types(cs->condpart, c, ok, Tbool, 0); - else { + propagate_types(cs->looppart, c, ok, Tbool, 0); + } else { /* Condpart must match case values, with bool permitted */ t = NULL; for (cp = cs->casepart; cp && !t; cp = cp->next) t = propagate_types(cp->value, c, ok, NULL, 0); if (!t && cs->condpart) - t = propagate_types(cs->condpart, c, ok, NULL, Rboolok); + t = propagate_types(cs->condpart, c, ok, NULL, Rboolok); // UNTESTED + if (!t && cs->looppart) + t = propagate_types(cs->looppart, c, ok, NULL, Rboolok); // UNTESTED // Now we have a type (I hope) push it down if (t) { for (cp = cs->casepart; cp; cp = cp->next) propagate_types(cp->value, c, ok, t, 0); propagate_types(cs->condpart, c, ok, t, Rboolok); + propagate_types(cs->looppart, c, ok, t, Rboolok); } } // (if)then, else, and case parts must return expected type. - if (!cs->dopart && !type) + if (!cs->looppart && !type) type = propagate_types(cs->thenpart, c, ok, NULL, rules); if (!type) type = propagate_types(cs->elsepart, c, ok, NULL, rules); for (cp = cs->casepart; cp && !type; - cp = cp->next) - type = propagate_types(cp->action, c, ok, NULL, rules); + cp = cp->next) // UNTESTED + type = propagate_types(cp->action, c, ok, NULL, rules); // UNTESTED if (type) { - if (!cs->dopart) + if (!cs->looppart) propagate_types(cs->thenpart, c, ok, type, rules); propagate_types(cs->elsepart, c, ok, type, rules); for (cp = cs->casepart; cp ; cp = cp->next) @@ -4139,6 +4286,16 @@ defined. return NULL; } +###### interp binode cases + case Loop: + // This just performs one iterration of the loop + 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 + interp_exec(c, b->right, NULL); + break; + ###### interp exec cases case Xcond_statement: { @@ -4149,27 +4306,20 @@ defined. if (cs->forpart) interp_exec(c, cs->forpart, NULL); - do { - if (cs->condpart) - cnd = interp_exec(c, cs->condpart, &cndtype); - else - cndtype = Tnone; - if (!(cndtype == Tnone || - (cndtype == Tbool && cnd.bool != 0))) - break; - // cnd is Tnone or Tbool, doesn't need to be freed - if (cs->dopart) - interp_exec(c, cs->dopart, NULL); - - if (cs->thenpart) { + if (cs->looppart) { + while ((cnd = interp_exec(c, cs->looppart, &cndtype)), + cndtype == Tnone || (cndtype == Tbool && cnd.bool != 0)) + interp_exec(c, cs->thenpart, NULL); + } else { + cnd = interp_exec(c, cs->condpart, &cndtype); + if ((cndtype == Tnone || + (cndtype == Tbool && cnd.bool != 0))) { + // cnd is Tnone or Tbool, doesn't need to be freed rv = interp_exec(c, cs->thenpart, &rvtype); - if (rvtype != Tnone || !cs->dopart) - goto Xcond_done; - free_value(rvtype, &rv); - rvtype = Tnone; + // skip else (and cases) + goto Xcond_done; } - } while (cs->dopart); - + } for (cp = cs->casepart; cp; cp = cp->next) { v = interp_exec(c, cp->value, &vtype); if (value_cmp(cndtype, vtype, &v, &cnd) == 0) { @@ -4221,7 +4371,7 @@ various declarations in the parse context. | DeclarationList Declaration Declaration -> ERROR Newlines ${ - tok_err(c, + tok_err(c, // UNTESTED "error: unhandled parse error", &$1); }$ | DeclareConstant @@ -4363,7 +4513,6 @@ analysis is a bit more interesting at this level. ###### print binode cases case Func: - case List: do_indent(indent, "func main("); for (b2 = cast(binode, b->left); b2; b2 = cast(binode, b2->right)) { struct variable *v = cast(var, b2->left)->var; @@ -4382,7 +4531,6 @@ analysis is a bit more interesting at this level. break; ###### propagate binode cases - case List: case Func: abort(); // NOTEST ###### core functions @@ -4424,7 +4572,7 @@ analysis is a bit more interesting at this level. /* Make sure everything is still consistent */ propagate_types(bp->right, c, &ok, Tnone, 0); if (!ok) - return 0; + return 0; // UNTESTED scope_finalize(c); return 1; } @@ -4470,13 +4618,14 @@ analysis is a bit more interesting at this level. } al = cast(binode, al->right); } - v = interp_exec(c, p->right, &vtype); + v = interp_exec(c, p, &vtype); free_value(vtype, &v); } ###### interp binode cases - case List: - case Func: abort(); // NOTEST + case Func: + rv = interp_exec(c, b->right, &rvtype); + break; ## And now to test it out. @@ -4573,13 +4722,14 @@ things which will likely grow as the languages grows. else hi = mid if hi - lo < 1: + lo = mid use GiveUp use True do pass case Found: print "Yay, I found", target case GiveUp: - print "Closest I found was", mid + print "Closest I found was", lo size::= 10 list:[size]number