X-Git-Url: https://ocean-lang.org/code/?p=ocean;a=blobdiff_plain;f=csrc%2Foceani.mdc;h=af24d9becd86326c48633e66cd0718a5510479da;hp=2a40ff203efa442fa148610521cb016070c13974;hb=d7e32bb049504f5e931f09ac041470f496c58b2c;hpb=6a546ea265d0ee30152298463e9e7b7c2f53b3b0 diff --git a/csrc/oceani.mdc b/csrc/oceani.mdc index 2a40ff2..af24d9b 100644 --- a/csrc/oceani.mdc +++ b/csrc/oceani.mdc @@ -242,18 +242,19 @@ structures can be used. 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) { @@ -932,7 +933,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: @@ -1589,9 +1589,9 @@ in `rval`. rvtype = ret.type = Tnone; if (!e) { - ret.lval = lrv; // UNTESTED - ret.rval = rv; // UNTESTED - return ret; // UNTESTED + ret.lval = lrv; + ret.rval = rv; + return ret; } switch(e->type) { @@ -3583,19 +3583,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("= "); @@ -3782,7 +3780,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, @@ -3795,7 +3801,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; }; @@ -3819,7 +3826,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); @@ -3846,27 +3853,24 @@ 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; + $0->looppart = $forpart = $condpart = $WP.condpart; $WP.condpart = NULL; - $0->dopart = $WP.dopart; $WP.dopart = NULL; + $0->looppart = $condpart = $WP.condpart; $WP.condpart = NULL; - $0->dopart = $WP.dopart; $WP.dopart = NULL; + $0->looppart = $ while UseBlock OptNL do Block ${ - $0.condpart = $ while UseBlock OptNL do OpenBlock ${ + $0 = new(binode); + $0->op = Loop; + $0->left = $right = $op = Loop; + $0->left = $right = $ if UseBlock OptNL then OpenBlock ClosePara ${ + $cond_statement + IfPart -> if UseBlock OptNL then OpenBlock ${ $0.condpart = $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: @@ -3992,33 +4035,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) @@ -4027,16 +4045,16 @@ defined. do_indent(indent, "if"); if (cs->condpart && cs->condpart->type == Xbinode && cast(binode, cs->condpart)->op == Block) { - if (bracket) // UNTESTED - printf(" {\n"); // UNTESTED + if (bracket) + printf(" {\n"); else - printf(":\n"); // UNTESTED - print_exec(cs->condpart, indent+1, bracket); // UNTESTED - if (bracket) // UNTESTED - do_indent(indent, "}\n"); // UNTESTED - if (cs->thenpart) { // UNTESTED - do_indent(indent, "then:\n"); // UNTESTED - print_exec(cs->thenpart, indent+1, bracket); // UNTESTED + printf("\n"); + print_exec(cs->condpart, indent+1, bracket); + if (bracket) + do_indent(indent, "}\n"); + if (cs->thenpart) { + do_indent(indent, "then\n"); + print_exec(cs->thenpart, indent+1, bracket); } } else { printf(" "); @@ -4077,11 +4095,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 @@ -4096,17 +4121,16 @@ defined. t = propagate_types(cs->forpart, c, ok, Tnone, 0); if (!type_compat(Tnone, t, 0)) *ok = 0; // UNTESTED - t = propagate_types(cs->dopart, c, ok, Tnone, 0); - if (!type_compat(Tnone, t, 0)) - *ok = 0; // UNTESTED - if (cs->dopart) { + + if (cs->looppart) { t = propagate_types(cs->thenpart, c, ok, Tnone, 0); if (!type_compat(Tnone, t, 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; @@ -4114,15 +4138,18 @@ defined. t = propagate_types(cp->value, c, ok, NULL, 0); if (!t && cs->condpart) 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); @@ -4131,7 +4158,7 @@ defined. 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) @@ -4141,6 +4168,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: { @@ -4151,27 +4188,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; // UNTESTED - 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) { @@ -4472,13 +4502,16 @@ 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 List: abort(); // NOTEST + + case Func: + rv = interp_exec(c, b->right, &rvtype); + break; ## And now to test it out.