X-Git-Url: https://ocean-lang.org/code/?a=blobdiff_plain;f=csrc%2Foceani.mdc;h=fabfe188c07ebd5bc9abdca9dd492aad34041de2;hb=6a7ef05f3986dd8127b8c3bfaeeceb514a8beaa4;hp=364ee290ab54ca10d0e825d9d128edd5b15ea0b2;hpb=688a9e05b01cd47b1a583848ade627d3f29b52d1;p=ocean diff --git a/csrc/oceani.mdc b/csrc/oceani.mdc index 364ee29..fabfe18 100644 --- a/csrc/oceani.mdc +++ b/csrc/oceani.mdc @@ -114,7 +114,6 @@ structures can be used. struct token_config config; char *file_name; int parse_error; - struct exec *prog; ## parse context }; @@ -236,25 +235,25 @@ 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"); + if (!context.parse_error && !analyse_funcs(&context)) { + fprintf(stderr, "oceani: type error in program - not running.\n"); context.parse_error = 1; } - if (context.prog && doprint) { + + if (doprint) { ## print const decls ## print type decls - print_exec(context.prog, 0, brackets); - } - 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); - } - interp_prog(&context, context.prog, argc - optind, argv+optind); + ## print func decls } - free_exec(context.prog); + if (doexec && !context.parse_error) + interp_main(&context, argc - optind, argv + optind); while (s) { struct section *t = s->next; @@ -262,7 +261,9 @@ structures can be used. free(s); s = t; } - ## free context vars + if (!context.parse_error) { + ## free global vars + } ## free context types ## free context storage exit(context.parse_error ? 1 : 0); @@ -359,6 +360,9 @@ context so indicate that parsing failed. ###### forward decls static void fput_loc(struct exec *loc, FILE *f); + static void type_err(struct parse_context *c, + char *fmt, struct exec *loc, + struct type *t1, int rules, struct type *t2); ###### core functions @@ -497,8 +501,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) @@ -845,6 +851,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 - @@ -932,7 +974,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: @@ -953,13 +994,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 @@ -1010,13 +1051,14 @@ 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; + 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; @@ -1024,14 +1066,16 @@ need to be freed. For this we need to be able to find it, so assume that context.varlist = b->next; free(b); while (v) { - struct variable *t = v; - - 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); - free(t); + struct variable *next = v->previous; + + if (v->global) { + free_value(v->type, var_value(&context, v)); + if (v->depth == 0) + // This is a global constant + free_exec(v->where_decl); + } + free(v); + v = next; } } @@ -1065,7 +1109,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 @@ -1108,6 +1152,7 @@ all pending-scope variables become conditionally scoped. v->scope = InScope; v->in_scope = c->in_scope; c->in_scope = v; + ## variable init return v; } @@ -1139,9 +1184,17 @@ 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); @@ -1150,11 +1203,19 @@ all pending-scope variables become conditionally scoped. (v->scope == OutScope || v->name->var != v) ? (*vp = v->in_scope, 0) : ( vp = &v->in_scope, 0)) { - if (v->name->var != v) { + 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 && e) { + /* 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: @@ -1163,14 +1224,17 @@ all pending-scope variables become conditionally scoped. 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) // UNTESTED + else if (v->type == Tlabel) + /* Labels remain pending even when not used */ v->scope = PendingScope; // UNTESTED - else if (v->name->var == v) // UNTESTED - v->scope = OutScope; // UNTESTED + else + v->scope = OutScope; if (ct == CloseElse) { /* All Pending variables with this name * are now Conditional */ @@ -1181,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; // UNTESTED + /* 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: @@ -1206,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: @@ -1233,9 +1299,15 @@ the frame needs to be reallocated as it grows so it can store those values. The local frame doesn't get values until the interpreted phase is started, so there is no need to allocate until the size is known. +We initialize the `frame_pos` to an impossible value, so that we can +tell if it was set or not later. + ###### variable fields - short frame_pos; - short global; + short frame_pos; + short global; + +###### variable init + v->frame_pos = -1; ###### parse context @@ -1249,7 +1321,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 @@ -1275,7 +1347,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); // UNTESTED + c->global_size = (c->global_size + t->align) & ~(t->align-1); if (!v) { v = &scratch; v->type = t; @@ -1296,14 +1368,15 @@ As global values are found -- struct field initializers, labels etc -- 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()`. +calculate the frame size and assign a frame position for each +variable. For this we have `scope_finalize()`. ###### ast functions - static void scope_finalize(struct parse_context *c) + static int scope_finalize(struct parse_context *c) { struct binding *b; + int size = 0; for (b = c->varlist; b; b = b->next) { struct variable *v; @@ -1313,18 +1386,19 @@ For this we have `scope_finalize()`. continue; if (v->global) continue; - if (c->local_size & (t->align - 1)) - c->local_size = (c->local_size + t->align) & ~(t->align-1); - v->frame_pos = c->local_size; - c->local_size += v->type->size; + if (!t) + continue; + if (size & (t->align - 1)) + size = (size + t->align) & ~(t->align-1); + v->frame_pos = size; + size += v->type->size; } } - c->local = calloc(1, c->local_size); + return size; } ###### free context storage free(context.global); - free(context.local); ### Executables @@ -1365,6 +1439,7 @@ from the `exec_types` enum. struct exec { enum exec_types type; int line, column; + ## exec fields }; struct binode { struct exec; @@ -1387,12 +1462,12 @@ from the `exec_types` enum. if (loc->type == Xbinode) return __fput_loc(cast(binode,loc)->left, f) || __fput_loc(cast(binode,loc)->right, f); // NOTEST - return 0; // NOTEST + return 0; } static void fput_loc(struct exec *loc, FILE *f) { if (!__fput_loc(loc, f)) - fprintf(f, "??:??: "); // NOTEST + fprintf(f, "??:??: "); } Each different type of `exec` node needs a number of functions defined, @@ -1445,7 +1520,7 @@ also want to know what sort of bracketing to use. static void do_indent(int i, char *str) { - while (i--) + while (i-- > 0) printf(" "); printf("%s", str); } @@ -1462,12 +1537,23 @@ 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", v->name->name.len, v->name->name.txt); + if (v->frame_pos >= 0) + printf("(%d+%d)", v->frame_pos, + v->type ? v->type->size:0); + } + printf(" */\n"); + } } ###### forward decls @@ -1497,10 +1583,11 @@ propagation is needed. fputs(" (labels not permitted)", stderr); break; -###### core functions - +###### forward decls static struct type *propagate_types(struct exec *prog, struct parse_context *c, int *ok, struct type *type, int rules); +###### core functions + static struct type *__propagate_types(struct exec *prog, struct parse_context *c, int *ok, struct type *type, int rules) { @@ -1589,9 +1676,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) { @@ -1613,6 +1700,7 @@ in `rval`. ret.lval = lrv; ret.rval = rv; ret.type = rvtype; + ## interp exec cleanup return ret; } @@ -1730,7 +1818,7 @@ with a const size by whether they are prepared at parse time or not. static int array_compat(struct type *require, struct type *have) { if (have->compat != require->compat) - return 0; // UNTESTED + return 0; /* Both are arrays, so we can look at details */ if (!type_compat(require->array.member, have->array.member, 0)) return 0; @@ -2229,7 +2317,7 @@ function will be needed. while (target != 0) { int i = 0; for (t = context.typelist; t ; t=t->next) - if (t->print_type_decl) { + if (t->print_type_decl && !t->check_args) { i += 1; if (i == target) break; @@ -2244,72 +2332,171 @@ function will be needed. } } -### Functions +#### Functions -A function is a named chunk of code which can be passed parameters and -can return results. Each function has an implicit type which includes -the set of parameters and the return value. As yet these types cannot -be declared separate from the function itself. +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. -In fact, only one function is currently possible - `main`. `main` is -passed an array of strings together with the size of the array, and -doesn't return anything. The strings are command line arguments. - -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 +For constructing these lists we use a `List` binode, which will be +further detailed when Expression Lists are introduced. + +###### type union fields + + struct { + struct binode *params; + int local_size; + } function; + +###### value union fields + struct exec *function; + +###### type functions + void (*check_args)(struct parse_context *c, int *ok, + struct type *require, struct exec *args); + +###### value functions + + static void function_free(struct type *type, struct value *val) + { + free_exec(val->function); + val->function = NULL; + } + + static int function_compat(struct type *require, struct type *have) + { + // FIXME can I do anything here yet? + return 0; + } + + static void function_check_args(struct parse_context *c, int *ok, + struct type *require, struct exec *args) + { + /* This should be 'compat', but we don't have a 'tuple' type to + * hold the type of 'args' + */ + struct binode *arg = cast(binode, args); + struct binode *param = require->function.params; + + while (param) { + struct var *pv = cast(var, param->left); + if (!arg) { + type_err(c, "error: insufficient arguments to function.", + args, NULL, 0, NULL); + break; + } + *ok = 1; + propagate_types(arg->left, c, ok, pv->var->type, 0); + param = cast(binode, param->right); + arg = cast(binode, arg->right); + } + if (arg) + type_err(c, "error: too many arguments to function.", + args, NULL, 0, NULL); + } + + static void function_print(struct type *type, struct value *val) + { + print_exec(val->function, 1, 0); + } + + static void function_print_type_decl(struct type *type, FILE *f) + { + struct binode *b; + fprintf(f, "("); + for (b = type->function.params; b; b = cast(binode, b->right)) { + struct variable *v = cast(var, b->left)->var; + fprintf(f, "%.*s%s", v->name->name.len, v->name->name.txt, + v->constant ? "::" : ":"); + type_print(v->type, f); + if (b->right) + fprintf(f, "; "); + } + fprintf(f, ")\n"); + } + + static void function_free_type(struct type *t) + { + free_exec(t->function.params); + } + + static struct type function_prototype = { + .size = sizeof(void*), + .align = sizeof(void*), + .free = function_free, + .compat = function_compat, + .check_args = function_check_args, + .print = function_print, + .print_type_decl = function_print_type_decl, + .free_type = function_free_type, + }; + +###### declare terminals + + $TERM func + ###### Binode types - Func, List, + List, ###### Grammar - $TERM func main + $*variable + FuncName -> IDENTIFIER ${ { + struct variable *v = var_decl(c, $1.txt); + struct var *e = new_pos(var, $1); + e->var = v; + if (v) { + v->where_decl = e; + $0 = v; + } else { + v = var_ref(c, $1.txt); + e->var = v; + type_err(c, "error: function '%v' redeclared", + e, NULL, 0, NULL); + type_err(c, "info: this is where '%v' was first declared", + v->where_decl, NULL, 0, NULL); + free_exec(e); + } + } }$ + $*binode - MainFunction -> func main ( OpenScope Args ) Block Newlines ${ - $0 = new(binode); - $0->op = Func; - $0->left = reorder_bilist($right = $scope_stack && !c->parse_error) abort(); - }$ - | func main IN OpenScope OptNL Args OUT OptNL do Block Newlines ${ - $0 = new(binode); - $0->op = Func; - $0->left = reorder_bilist($right = $scope_stack && !c->parse_error) abort(); - }$ - | func main NEWLINE OpenScope OptNL do Block Newlines ${ - $0 = new(binode); - $0->op = Func; - $0->left = NULL; - $0->right = $scope_stack && !c->parse_error) abort(); - }$ + Args -> ArgsLine NEWLINE ${ $0 = $left; + *bp = $ ${ $0 = NULL; }$ + ArgsLine -> ${ $0 = NULL; }$ | Varlist ${ $0 = $<1; }$ | Varlist ; ${ $0 = $<1; }$ - | Varlist NEWLINE ${ $0 = $<1; }$ - Varlist -> Varlist ; ArgDecl ${ // UNTESTED + Varlist -> Varlist ; ArgDecl ${ $0 = new(binode); $0->op = List; $0->left = $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 @@ -2987,7 +3225,7 @@ expression operator, and the `CMPop` non-terminal will match one of them. break; } -### Expressions: The rest +### Expressions: Arithmetic etc. The remaining expressions with the highest precedence are arithmetic, string concatenation, and string conversion. String concatenation @@ -3051,6 +3289,8 @@ should only insert brackets were needed for precedence. | Value ${ $0 = $<1; }$ | Variable ${ $0 = $<1; }$ +###### Grammar + $eop Eop -> + ${ $0.op = Plus; }$ | - ${ $0.op = Minus; }$ @@ -3231,6 +3471,110 @@ should only insert brackets were needed for precedence. return rv; } +### Function calls + +A function call can appear either as an expression or as a statement. +As functions cannot yet return values, only the statement version will work. +We use a new 'Funcall' binode type to link the function with a list of +arguments, form with the 'List' nodes. + +###### Binode types + Funcall, + +###### expression grammar + | Variable ( ExpressionList ) ${ { + struct binode *b = new(binode); + b->op = Funcall; + b->left = $right = reorder_bilist($op = Funcall; + b->left = $right = NULL; + $0 = b; + } }$ + +###### SimpleStatement Grammar + + | Variable ( ExpressionList ) ${ { + struct binode *b = new(binode); + b->op = Funcall; + b->left = $right = reorder_bilist($left, -1, bracket); + printf("("); + for (b = cast(binode, b->right); b; b = cast(binode, b->right)) { + if (b->left) { + printf(" "); + print_exec(b->left, -1, bracket); + if (b->right) + printf(","); + } + } + printf(")"); + if (indent >= 0) + printf("\n"); + break; + +###### propagate binode cases + + case Funcall: { + /* Every arg must match formal parameter, and result + * is return type of function (currently Tnone). + */ + struct binode *args = cast(binode, b->right); + struct var *v = cast(var, b->left); + + if (!v->var->type || v->var->type->check_args == NULL) { + type_err(c, "error: attempt to call a non-function.", + prog, NULL, 0, NULL); + return NULL; + } + v->var->type->check_args(c, ok, v->var->type, args); + return Tnone; + } + +###### interp binode cases + + case Funcall: { + struct var *v = cast(var, b->left); + struct type *t = v->var->type; + void *oldlocal = c->local; + int old_size = c->local_size; + void *local = calloc(1, t->function.local_size); + struct value *fbody = var_value(c, v->var); + struct binode *arg = cast(binode, b->right); + struct binode *param = t->function.params; + + while (param) { + struct var *pv = cast(var, param->left); + struct type *vtype = NULL; + struct value val = interp_exec(c, arg->left, &vtype); + struct value *lval; + c->local = local; c->local_size = t->function.local_size; + lval = var_value(c, pv->var); + c->local = oldlocal; c->local_size = old_size; + memcpy(lval, &val, vtype->size); + param = cast(binode, param->right); + arg = cast(binode, arg->right); + } + c->local = local; c->local_size = t->function.local_size; + right = interp_exec(c, fbody->function, &rtype); + c->local = oldlocal; c->local_size = old_size; + free(local); + break; + } + ### Blocks, Statements, and Statement lists. Now that we have expressions out of the way we need to turn to @@ -3431,62 +3775,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; @@ -3495,30 +3824,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; } @@ -3583,19 +3915,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("= "); @@ -3655,7 +3985,6 @@ it is declared, and error will be raised as the name is created as struct value *val; 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) { @@ -3782,7 +4111,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 +4132,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 +4157,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,53 +4184,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 @@ -3925,46 +4259,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: @@ -3991,33 +4366,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) @@ -4026,16 +4376,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(" "); @@ -4076,11 +4426,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 @@ -4095,17 +4452,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; @@ -4113,15 +4469,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); @@ -4130,7 +4489,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) @@ -4140,6 +4499,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: { @@ -4150,27 +4519,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) { @@ -4314,7 +4676,7 @@ searching through for the Nth constant for decreasing N. while (target != 0) { int i = 0; for (v = context.in_scope; v; v=v->in_scope) - if (v->depth == 0) { + if (v->depth == 0 && v->constant) { i += 1; if (i == target) break; @@ -4340,11 +4702,12 @@ searching through for the Nth constant for decreasing N. } } -### Finally the whole `main` function. +### Function declarations + +The code in an Ocean program is all stored in function declarations. +One of the functions must be named `main` and it must accept an array of +strings as a parameter - the command line arguments. -An Ocean program can currently have only one function - `main` - and -that must exist. It expects an array of strings with a provided size. -Following this is a `block` which is the code to execute. As this is the top level, several things are handled a bit differently. @@ -4352,59 +4715,108 @@ 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 variable *declare_function(struct parse_context *c, + struct variable *name, + struct binode *args, + struct exec *code) + { + struct text funcname = {" func", 5}; + if (name) { + struct value fn = {.function = code}; + name->type = add_type(c, funcname, &function_prototype); + name->type->function.params = reorder_bilist(args); + global_alloc(c, name->type, name, &fn); + var_block_close(c, CloseSequential, code); + } else + var_block_close(c, CloseSequential, NULL); + return name; + } + ###### top level grammar - DeclareFunction -> MainFunction ${ { - if (c->prog) - type_err(c, "\"main\" defined a second time", - $1, NULL, 0, NULL); - else - c->prog = $<1; - } }$ + $*variable + DeclareFunction -> func FuncName ( OpenScope ArgsLine ) Block Newlines ${ + $0 = declare_function(c, $left); b2; b2 = cast(binode, b2->right)) { - struct variable *v = cast(var, b2->left)->var; - printf(" "); - print_exec(b2->left, 0, 0); - printf(":"); - type_print(v->type, stdout); - } - if (bracket) - printf(") {\n"); - else - printf(")\n"); - print_exec(b->right, indent+1, bracket); - if (bracket) - do_indent(indent, "}\n"); - break; +###### print func decls + { + struct variable *v; + int target = -1; -###### propagate binode cases - case List: - case Func: abort(); // NOTEST + while (target != 0) { + int i = 0; + for (v = context.in_scope; v; v=v->in_scope) + if (v->depth == 0 && v->type && v->type->check_args) { + i += 1; + if (i == target) + break; + } + + if (target == -1) { + target = i; + } else { + struct value *val = var_value(&context, v); + printf("func %.*s", v->name->name.len, v->name->name.txt); + v->type->print_type_decl(v->type, stdout); + if (brackets) + print_exec(val->function, 0, brackets); + else + print_value(v->type, val); + printf("/* frame size %d */\n", v->type->function.local_size); + target -= 1; + } + } + } ###### core functions - static int analyse_prog(struct exec *prog, struct parse_context *c) + static int analyse_funcs(struct parse_context *c) { - struct binode *bp = cast(binode, prog); + struct variable *v; + int all_ok = 1; + for (v = c->in_scope; v; v = v->in_scope) { + struct value *val; + int ok = 1; + if (v->depth != 0 || !v->type || !v->type->check_args) + continue; + val = var_value(c, v); + do { + ok = 1; + propagate_types(val->function, c, &ok, Tnone, 0); + } while (ok == 2); + if (ok) + /* Make sure everything is still consistent */ + propagate_types(val->function, c, &ok, Tnone, 0); + if (!ok) + all_ok = 0; + v->type->function.local_size = scope_finalize(c); + } + return all_ok; + } + + static int analyse_main(struct type *type, struct parse_context *c) + { + struct binode *bp = type->function.params; struct binode *b; int ok = 1; int arg = 0; struct type *argv_type; struct text argv_type_name = { " argv", 5 }; - if (!bp) - return 0; // NOTEST - argv_type = add_type(c, argv_type_name, &array_prototype); argv_type->array.member = Tstr; argv_type->array.unspec = 1; - for (b = cast(binode, bp->left); b; b = cast(binode, b->right)) { + for (b = bp; b; b = cast(binode, b->right)) { ok = 1; switch (arg++) { case 0: /* argv */ @@ -4413,35 +4825,40 @@ analysis is a bit more interesting at this level. default: /* invalid */ // NOTEST propagate_types(b->left, c, &ok, Tnone, 0); // NOTEST } + if (!ok) + c->parse_error = 1; } - do { - ok = 1; - propagate_types(bp->right, c, &ok, Tnone, 0); - } while (ok == 2); - if (!ok) - return 0; - - /* Make sure everything is still consistent */ - propagate_types(bp->right, c, &ok, Tnone, 0); - if (!ok) - return 0; // UNTESTED - scope_finalize(c); - return 1; + return !c->parse_error; } - static void interp_prog(struct parse_context *c, struct exec *prog, - int argc, char **argv) + static void interp_main(struct parse_context *c, int argc, char **argv) { - struct binode *p = cast(binode, prog); + struct value *progp = NULL; + struct text main_name = { "main", 4 }; + struct variable *mainv; struct binode *al; int anum = 0; struct value v; struct type *vtype; - if (!prog) - return; // NOTEST - al = cast(binode, p->left); + mainv = var_ref(c, main_name); + if (mainv) + progp = var_value(c, mainv); + if (!progp || !progp->function) { + fprintf(stderr, "oceani: no main function found.\n"); + c->parse_error = 1; + return; + } + if (!analyse_main(mainv->type, c)) { + fprintf(stderr, "oceani: main has wrong type.\n"); + c->parse_error = 1; + return; + } + al = mainv->type->function.params; + + c->local_size = mainv->type->function.local_size; + c->local = calloc(1, c->local_size); while (al) { struct var *v = cast(var, al->left); struct value *vl = var_value(c, v->var); @@ -4471,13 +4888,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, progp->function, &vtype); free_value(vtype, &v); + free(c->local); + c->local = NULL; } -###### interp binode cases - case List: - case Func: abort(); // NOTEST +###### ast functions + void free_variable(struct variable *v) + { + } ## And now to test it out. @@ -4507,9 +4927,7 @@ things which will likely grow as the languages grows. name:string alive:Boolean - func main - argv:[argc::]string - do + func main(argv:[argc::]string) print "Hello World, what lovely oceans you have!" print "Are there", five, "?" print pi, pie, "but", cake @@ -4574,13 +4992,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