X-Git-Url: https://ocean-lang.org/code/?p=ocean;a=blobdiff_plain;f=csrc%2Foceani.mdc;h=65790ec985469c5268208cd68bb38a8fc116f1df;hp=520212be6d144365a586638bf695098689460058;hb=a9cd2fcd52ae4ba9c19f775221cc14d2745083b3;hpb=527a8f053f3ee881dad97a5c78e17d9c62862bad diff --git a/csrc/oceani.mdc b/csrc/oceani.mdc index 520212b..65790ec 100644 --- a/csrc/oceani.mdc +++ b/csrc/oceani.mdc @@ -105,6 +105,7 @@ structures can be used. ###### Parser: header ## macros + struct parse_context; ## ast struct parse_context { struct token_config config; @@ -242,7 +243,7 @@ structures can be used. fprintf(stderr, "oceani: type error in program - not running.\n"); exit(1); } - interp_prog(context.prog, argv+optind+1); + interp_prog(&context, context.prog, argc - optind, argv+optind); } free_exec(context.prog); @@ -287,14 +288,6 @@ consistent across all the branches. When the variable is not used outside the if, the variables in the different branches are distinct and can be of different types. -Determining the types of all variables early is important for -processing command line arguments. These can be assigned to any of -several types of variable, but we must first know the correct type so -any required conversion can happen. If a variable is associated with -a command line argument but no type can be interpreted (e.g. the -variable is only ever used in a `print` statement), then the type is -set to 'string'. - Undeclared names may only appear in "use" statements and "case" expressions. These names are given a type of "label" and a unique value. This allows them to fill the role of a name in an enumerated type, which @@ -407,11 +400,11 @@ various entities. ### Types Values come in a wide range of types, with more likely to be added. -Each type needs to be able to parse and print its own values (for -convenience at least) as well as to compare two values, at least for -equality and possibly for order. For now, values might need to be -duplicated and freed, though eventually such manipulations will be -better integrated into the language. +Each type needs to be able to print its own values (for convenience at +least) as well as to compare two values, at least for equality and +possibly for order. For now, values might need to be duplicated and +freed, though eventually such manipulations will be better integrated +into the language. Rather than requiring every numeric type to support all numeric operations (add, multiple, etc), we allow types to be able to present @@ -437,7 +430,7 @@ Named type are stored in a simple linked list. Objects of each type are struct type *next; int size, align; void (*init)(struct type *type, struct value *val); - int (*parse)(struct type *type, char *str, struct value *val); + void (*prepare_type)(struct parse_context *c, struct type *type, int parse_time); void (*print)(struct type *type, struct value *val); void (*print_type)(struct type *type, FILE *f); int (*cmp_order)(struct type *t1, struct type *t2, @@ -541,28 +534,6 @@ Named type are stored in a simple linked list. Objects of each type are printf("*Unknown*"); // NOTEST } - static int parse_value(struct type *type, char *arg, - struct value *val) - { - if (type && type->parse) - return type->parse(type, arg, val); - return 0; // NOTEST - } - - static struct value *val_alloc(struct type *t, struct value *init) - { - struct value *ret; - - if (!t->size) - val_init(t, NULL); - ret = calloc(1, t->size); - if (init) - memcpy(ret, init, t->size); - else - val_init(t, ret); - return ret; - } - ###### forward decls static void free_value(struct type *type, struct value *v); @@ -574,7 +545,6 @@ Named type are stored in a simple linked list. Objects of each type are static int value_cmp(struct type *tl, struct type *tr, struct value *left, struct value *right); static void print_value(struct type *type, struct value *v); - static int parse_value(struct type *type, char *arg, struct value *val); ###### free context types @@ -606,11 +576,11 @@ later. In some cases a Boolean can be accepted as well as some other primary type, and in others any type is acceptable except a label (`Vlabel`). A separate function encoding these cases will simplify some code later. -## type functions +###### type functions int (*compat)(struct type *this, struct type *other); -## ast functions +###### ast functions static int type_compat(struct type *require, struct type *have, int rules) { @@ -627,9 +597,6 @@ A separate function encoding these cases will simplify some code later. return require == have; } -When assigning command line arguments to variables, we need to be able -to parse each type from a string. - ###### includes #include #include "parse_string.h" @@ -747,57 +714,10 @@ to parse each type from a string. } } - static int _parse_value(struct type *type, char *arg, struct value *val) - { - struct text tx; - int neg = 0; - char tail[3] = ""; - - switch(type->vtype) { - case Vlabel: // NOTEST - case Vnone: // NOTEST - return 0; // NOTEST - case Vstr: - val->str.len = strlen(arg); - val->str.txt = malloc(val->str.len); - memcpy(val->str.txt, arg, val->str.len); - break; - case Vnum: - if (*arg == '-') { - neg = 1; - arg++; - } - tx.txt = arg; tx.len = strlen(tx.txt); - if (number_parse(val->num, tail, tx) == 0) - mpq_init(val->num); - else if (neg) - mpq_neg(val->num, val->num); - if (tail[0]) { - printf("Unsupported suffix: %s\n", arg); - return 0; - } - break; - case Vbool: - if (strcasecmp(arg, "true") == 0 || - strcmp(arg, "1") == 0) - val->bool = 1; - else if (strcasecmp(arg, "false") == 0 || - strcmp(arg, "0") == 0) - val->bool = 0; - else { - printf("Bad bool: %s\n", arg); - return 0; - } - break; - } - return 1; - } - static void _free_value(struct type *type, struct value *v); static struct type base_prototype = { .init = _val_init, - .parse = _parse_value, .print = _print_value, .cmp_order = _value_cmp, .cmp_eq = _value_cmp, @@ -885,7 +805,6 @@ cannot nest, so a declaration while a name is in-scope is an error. struct variable { struct variable *previous; struct type *type; - struct value *val; struct binding *name; struct exec *where_decl;// where name was declared struct exec *where_set; // where type was set @@ -1035,6 +954,11 @@ recent instance. These variables don't really belong in the is found. Instead, they are detected and ignored when considering the list of in_scope names. +The storage of the value of a variable will be described later. For now +we just need to know that when a variable goes out of scope, it might +need to be freed. For this we need to be able to find it, so assume that +`var_value()` will provide that. + ###### variable fields struct variable *merged; @@ -1057,6 +981,9 @@ list of in_scope names. } } +###### forward decls + static struct value *var_value(struct parse_context *c, struct variable *v); + ###### free context vars while (context.varlist) { @@ -1068,8 +995,7 @@ list of in_scope names. struct variable *t = v; v = t->previous; - free_value(t->type, t->val); - free(t->val); + free_value(t->type, var_value(&context, t)); if (t->depth == 0) // This is a global constant free_exec(t->where_decl); @@ -1149,7 +1075,6 @@ all pending-scope variables become conditionally scoped. v->scope = InScope; v->in_scope = c->in_scope; c->in_scope = v; - v->val = NULL; return v; } @@ -1258,6 +1183,112 @@ all pending-scope variables become conditionally scoped. } } +#### Storing Values + +The value of a variable is store separately from the variable, on an +analogue of a stack frame. There are (currently) two frames that can be +active. A global frame which currently only stores constants, and a +stacked frame which stores local variables. Each variable knows if it +is global or not, and what its index into the frame is. + +Values in the global frame are known immediately they are relevant, so +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. + +###### variable fields + short frame_pos; + short global; + +###### parse context + + short global_size, global_alloc; + short local_size; + void *global, *local; + +###### ast functions + + static struct value *var_value(struct parse_context *c, struct variable *v) + { + if (!v->global) { + if (!c->local || !v->type) + return NULL; + if (v->frame_pos + v->type->size > c->local_size) { + printf("INVALID frame_pos\n"); // NOTEST + exit(2); + } + return c->local + v->frame_pos; + } + if (c->global_size > c->global_alloc) { + int old = c->global_alloc; + c->global_alloc = (c->global_size | 1023) + 1024; + c->global = realloc(c->global, c->global_alloc); + memset(c->global + old, 0, c->global_alloc - old); + } + return c->global + v->frame_pos; + } + + static struct value *global_alloc(struct parse_context *c, struct type *t, + struct variable *v, struct value *init) + { + struct value *ret; + struct variable scratch; + + if (t->prepare_type) + t->prepare_type(c, t, 1); + + if (c->global_size & (t->align - 1)) + c->global_size = (c->global_size + t->align) & ~(t->align-1); + if (!v) { + v = &scratch; + v->type = t; + } + v->frame_pos = c->global_size; + v->global = 1; + c->global_size += v->type->size; + ret = var_value(c, v); + if (init) + memcpy(ret, init, t->size); + else + val_init(t, ret); + return ret; + } + +As global values are found -- struct field initializers, labels etc -- +`global_alloc()` is called to record the value in the global frame. + +When the program is fully parsed, we need to walk the list of variables +to find any that weren't merged away and that aren't global, and to +calculate the frame size and assign a frame position for each variable. +For this we have `scope_finalize()`. + +###### ast functions + + static void scope_finalize(struct parse_context *c) + { + struct binding *b; + + for (b = c->varlist; b; b = b->next) { + struct variable *v; + for (v = b->var; v; v = v->previous) { + struct type *t = v->type; + if (v->merged && v->merged != v) + 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; + } + } + c->local = calloc(1, c->local_size); + } + +###### free context vars + free(context.global); + free(context.local); + ### Executables Executables can be lots of different things. In many cases an @@ -1487,11 +1518,12 @@ in `rval`. struct value rval, *lval; }; - static struct lrval _interp_exec(struct exec *e); + static struct lrval _interp_exec(struct parse_context *c, struct exec *e); - static struct value interp_exec(struct exec *e, struct type **typeret) + static struct value interp_exec(struct parse_context *c, struct exec *e, + struct type **typeret) { - struct lrval ret = _interp_exec(e); + struct lrval ret = _interp_exec(c, e); if (!ret.type) abort(); if (typeret) @@ -1501,16 +1533,19 @@ in `rval`. return ret.rval; } - static struct value *linterp_exec(struct exec *e, struct type **typeret) + static struct value *linterp_exec(struct parse_context *c, struct exec *e, + struct type **typeret) { - struct lrval ret = _interp_exec(e); + struct lrval ret = _interp_exec(c, e); - if (typeret) + if (ret.lval) *typeret = ret.type; + else + free_value(ret.type, &ret.rval); return ret.lval; } - static struct lrval _interp_exec(struct exec *e) + static struct lrval _interp_exec(struct parse_context *c, struct exec *e) { struct lrval ret; struct value rv = {}, *lrv = NULL; @@ -1553,10 +1588,6 @@ different phases of parse, analyse, print, interpret. Thus far we have arrays and structs. -Some complex types need do not exist in a name table, so they are kept -on a linked list in the context (`anon_typelist`). This allows them to -be freed when parsing is complete. - #### Arrays Arrays can be declared by giving a size and a type, as `[size]type' so @@ -1571,39 +1602,68 @@ ever be referenced by the name it is declared with. It is likely that a "`copy`" primitive will eventually be define which can be used to make a copy of an array with controllable recursive depth. +For now we have two sorts of array, those with fixed size either because +it is given as a literal number or because it is a struct member (which +cannot have a runtime-changing size), and those with a size that is +determined at runtime - local variables with a const size. The former +have their size calculated at parse time, the latter at run time. + +For the latter type, the `size` field of the type is the size of a +pointer, and the array is reallocated every time it comes into scope. + +We differentiate struct fields with a const size from local variables +with a const size by whether they are prepared at parse time or not. + ###### type union fields struct { - int size; + short size; + short static_size; struct variable *vsize; struct type *member; } array; ###### value union fields - void *array; + void *array; // used if not static_size ###### value functions - static void array_init(struct type *type, struct value *val) + static void array_prepare_type(struct parse_context *c, struct type *type, + int parse_time) { - int i; + struct value *vsize; + mpz_t q; + if (!type->array.vsize || type->array.static_size) + return; - if (type->array.vsize) { - mpz_t q; - mpz_init(q); - mpz_tdiv_q(q, mpq_numref(type->array.vsize->val->num), - mpq_denref(type->array.vsize->val->num)); - type->array.size = mpz_get_si(q); - mpz_clear(q); + vsize = var_value(c, type->array.vsize); + mpz_init(q); + mpz_tdiv_q(q, mpq_numref(vsize->num), mpq_denref(vsize->num)); + type->array.size = mpz_get_si(q); + mpz_clear(q); + + if (parse_time) { + type->array.static_size = 1; + type->size = type->array.size * type->array.member->size; + type->align = type->array.member->align; } - type->size = type->array.size * type->array.member->size; - type->align = type->array.member->align; + } + + static void array_init(struct type *type, struct value *val) + { + int i; + void *ptr = val->ptr; if (!val) - return; + return; + if (!type->array.static_size) { + val->array = calloc(type->array.size, + type->array.member->size); + ptr = val->array; + } for (i = 0; i < type->array.size; i++) { struct value *v; - v = (void*)val->ptr + i * type->array.member->size; + v = (void*)ptr + i * type->array.member->size; val_init(type->array.member, v); } } @@ -1611,12 +1671,17 @@ make a copy of an array with controllable recursive depth. static void array_free(struct type *type, struct value *val) { int i; + void *ptr = val->ptr; + if (!type->array.static_size) + ptr = val->array; for (i = 0; i < type->array.size; i++) { struct value *v; - v = (void*)val->ptr + i * type->array.member->size; + v = (void*)ptr + i * type->array.member->size; free_value(type->array.member, v); } + if (!type->array.static_size) + free(ptr); } static int array_compat(struct type *require, struct type *have) @@ -1645,27 +1710,34 @@ make a copy of an array with controllable recursive depth. static struct type array_prototype = { .init = array_init, + .prepare_type = array_prepare_type, .print_type = array_print_type, .compat = array_compat, .free = array_free, + .size = sizeof(void*), + .align = sizeof(void*), }; +###### declare terminals + $TERM [ ] + ###### type grammar - | [ NUMBER ] Type ${ - $0 = calloc(1, sizeof(struct type)); - *($0) = array_prototype; - $0->array.member = $<4; - $0->array.vsize = NULL; - { + | [ NUMBER ] Type ${ { char tail[3]; mpq_t num; + struct text noname = { "", 0 }; + struct type *t; + + $0 = t = add_type(c, noname, &array_prototype); + t->array.member = $<4; + t->array.vsize = NULL; if (number_parse(num, tail, $2.txt) == 0) tok_err(c, "error: unrecognised number", &$2); else if (tail[0]) tok_err(c, "error: unsupported number suffix", &$2); else { - $0->array.size = mpz_get_ui(mpq_numref(num)); + t->array.size = mpz_get_ui(mpq_numref(num)); if (mpz_cmp_ui(mpq_denref(num), 1) != 0) { tok_err(c, "error: array size must be an integer", &$2); @@ -1674,41 +1746,26 @@ make a copy of an array with controllable recursive depth. &$2); mpq_clear(num); } - $0->next = c->anon_typelist; - c->anon_typelist = $0; - } - }$ + t->array.static_size = 1; + t->size = t->array.size * t->array.member->size; + t->align = t->array.member->align; + } }$ | [ IDENTIFIER ] Type ${ { struct variable *v = var_ref(c, $2.txt); + struct text noname = { "", 0 }; if (!v) tok_err(c, "error: name undeclared", &$2); else if (!v->constant) tok_err(c, "error: array size must be a constant", &$2); - $0 = calloc(1, sizeof(struct type)); - *($0) = array_prototype; + $0 = add_type(c, noname, &array_prototype); $0->array.member = $<4; $0->array.size = 0; $0->array.vsize = v; - $0->next = c->anon_typelist; - c->anon_typelist = $0; } }$ -###### parse context - - struct type *anon_typelist; - -###### free context types - - while (context.anon_typelist) { - struct type *t = context.anon_typelist; - - context.anon_typelist = t->next; - free(t); - } - ###### Binode types Index, @@ -1753,17 +1810,22 @@ make a copy of an array with controllable recursive depth. case Index: { mpz_t q; long i; + void *ptr; - lleft = linterp_exec(b->left, <ype); - right = interp_exec(b->right, &rtype); + lleft = linterp_exec(c, b->left, <ype); + right = interp_exec(c, b->right, &rtype); mpz_init(q); mpz_tdiv_q(q, mpq_numref(right.num), mpq_denref(right.num)); i = mpz_get_si(q); mpz_clear(q); + if (ltype->array.static_size) + ptr = lleft; + else + ptr = *(void**)lleft; rvtype = ltype->array.member; if (i >= 0 && i < ltype->array.size) - lrv = (void*)lleft + i * rvtype->size; + lrv = ptr + i * rvtype->size; else val_init(ltype->array.member, &rv); ltype = NULL; @@ -1835,7 +1897,12 @@ function will be needed. for (i = 0; i < type->structure.nfields; i++) { struct value *v; v = (void*) val->ptr + type->structure.fields[i].offset; - val_init(type->structure.fields[i].type, v); + if (type->structure.fields[i].init) + dup_value(type->structure.fields[i].type, + type->structure.fields[i].init, + v); + else + val_init(type->structure.fields[i].type, v); } } @@ -1857,7 +1924,6 @@ function will be needed. if (t->structure.fields[i].init) { free_value(t->structure.fields[i].type, t->structure.fields[i].init); - free(t->structure.fields[i].init); } free(t->structure.fields); } @@ -1886,6 +1952,9 @@ function will be needed. free(e); break; +###### declare terminals + $TERM struct . + ###### variable grammar | Variable . IDENTIFIER ${ { @@ -1950,7 +2019,7 @@ function will be needed. { struct fieldref *f = cast(fieldref, e); struct type *ltype; - struct value *lleft = linterp_exec(f->left, <ype); + struct value *lleft = linterp_exec(c, f->left, <ype); lrv = (void*)lleft->ptr + ltype->structure.fields[f->index].offset; rvtype = ltype->structure.fields[f->index].type; break; @@ -2039,15 +2108,16 @@ function will be needed. if (!ok) c->parse_error = 1; else { - struct value vl = interp_exec($5, NULL); - $0->f.init = val_alloc($0->f.type, &vl); + struct value vl = interp_exec(c, $5, NULL); + $0->f.init = global_alloc(c, $0->f.type, NULL, &vl); } } }$ | IDENTIFIER : Type ${ $0 = calloc(1, sizeof(struct fieldlist)); $0->f.name = $1.txt; $0->f.type = $<3; - $0->f.init = val_alloc($0->f.type, NULL); + if ($0->f.type->prepare_type) + $0->f.type->prepare_type(c, $0->f.type, 1); }$ ###### forward decls @@ -2132,6 +2202,8 @@ an executable. ###### Grammar + $TERM True False + $*val Value -> True ${ $0 = new_val(Tbool, $1); @@ -2253,6 +2325,8 @@ link to find the primary instance. ###### Grammar + $TERM : :: + $*var VariableDecl -> IDENTIFIER : ${ { struct variable *v = var_decl(c, $1.txt); @@ -2293,7 +2367,6 @@ link to find the primary instance. v->where_decl = $0; v->where_set = $0; v->type = $val = NULL; } else { v = var_ref(c, $1.txt); $0->var = v; @@ -2311,7 +2384,6 @@ link to find the primary instance. v->where_decl = $0; v->where_set = $0; v->type = $val = NULL; v->constant = 1; } else { v = var_ref(c, $1.txt); @@ -2331,7 +2403,6 @@ link to find the primary instance. /* This might be a label - allocate a var just in case */ v = var_decl(c, $1.txt); if (v) { - v->val = NULL; v->type = Tnone; v->where_decl = $0; v->where_set = $0; @@ -2402,7 +2473,6 @@ link to find the primary instance. if (v->type == NULL) { if (type && *ok != 0) { v->type = type; - v->val = NULL; v->where_set = prog; *ok = 2; } @@ -2427,7 +2497,7 @@ link to find the primary instance. if (v->merged) v = v->merged; - lrv = v->val; + lrv = var_value(c, v); rvtype = v->type; break; } @@ -2509,11 +2579,11 @@ there. case CondExpr: { struct binode *b2 = cast(binode, b->right); - left = interp_exec(b->left, <ype); + left = interp_exec(c, b->left, <ype); if (left.bool) - rv = interp_exec(b2->left, &rvtype); + rv = interp_exec(c, b2->left, &rvtype); else - rv = interp_exec(b2->right, &rvtype); + rv = interp_exec(c, b2->right, &rvtype); } break; @@ -2626,27 +2696,27 @@ evaluate the second expression if not necessary. ###### interp binode cases case And: - rv = interp_exec(b->left, &rvtype); - right = interp_exec(b->right, &rtype); + rv = interp_exec(c, b->left, &rvtype); + right = interp_exec(c, b->right, &rtype); rv.bool = rv.bool && right.bool; break; case AndThen: - rv = interp_exec(b->left, &rvtype); + rv = interp_exec(c, b->left, &rvtype); if (rv.bool) - rv = interp_exec(b->right, NULL); + rv = interp_exec(c, b->right, NULL); break; case Or: - rv = interp_exec(b->left, &rvtype); - right = interp_exec(b->right, &rtype); + rv = interp_exec(c, b->left, &rvtype); + right = interp_exec(c, b->right, &rtype); rv.bool = rv.bool || right.bool; break; case OrElse: - rv = interp_exec(b->left, &rvtype); + rv = interp_exec(c, b->left, &rvtype); if (!rv.bool) - rv = interp_exec(b->right, NULL); + rv = interp_exec(c, b->right, NULL); break; case Not: - rv = interp_exec(b->right, &rvtype); + rv = interp_exec(c, b->right, &rvtype); rv.bool = !rv.bool; break; @@ -2754,8 +2824,8 @@ expression operator, and the `CMPop` non-terminal will match one of them. case NEql: { int cmp; - left = interp_exec(b->left, <ype); - right = interp_exec(b->right, &rtype); + left = interp_exec(c, b->left, <ype); + right = interp_exec(c, b->right, &rtype); cmp = value_cmp(ltype, rtype, &left, &right); rvtype = Tbool; switch (b->op) { @@ -2772,9 +2842,14 @@ expression operator, and the `CMPop` non-terminal will match one of them. ### Expressions: The rest -The remaining expressions with the highest precedence are arithmetic and -string concatenation. String concatenation (`++`) has the same -precedence as multiplication and division, but lower than the uniary. +The remaining expressions with the highest precedence are arithmetic, +string concatenation, and string conversion. String concatenation +(`++`) has the same precedence as multiplication and division, but lower +than the uniary. + +String conversion is a temporary feature until I get a better type +system. `$` is a prefix operator which expects a string and returns +a number. `+` and `-` are both infix and prefix operations (where they are absolute value and negation). These have different operator names. @@ -2788,12 +2863,13 @@ should only insert brackets were needed for precedence. Times, Divide, Rem, Concat, Absolute, Negate, + StringConv, Bracket, ###### expr precedence $LEFT + - Eop $LEFT * / % ++ Top - $LEFT Uop + $LEFT Uop $ $TERM ( ) ###### expression grammar @@ -2834,6 +2910,7 @@ should only insert brackets were needed for precedence. Uop -> + ${ $0.op = Absolute; }$ | - ${ $0.op = Negate; }$ + | $ ${ $0.op = StringConv; }$ Top -> * ${ $0.op = Times; }$ | / ${ $0.op = Divide; }$ @@ -2862,14 +2939,15 @@ should only insert brackets were needed for precedence. if (bracket) printf(")"); break; case Absolute: - if (bracket) printf("("); - printf("+"); - print_exec(b->right, indent, bracket); - if (bracket) printf(")"); - break; case Negate: + case StringConv: if (bracket) printf("("); - printf("-"); + switch (b->op) { + case Absolute: fputs("+", stdout); break; + case Negate: fputs("-", stdout); break; + case StringConv: fputs("$", stdout); break; + default: abort(); // NOTEST + } // NOTEST print_exec(b->right, indent, bracket); if (bracket) printf(")"); break; @@ -2906,36 +2984,45 @@ should only insert brackets were needed for precedence. Tstr, rules, type); return Tstr; + case StringConv: + /* op must be string, result is number */ + propagate_types(b->left, c, ok, Tstr, 0); + if (!type_compat(type, Tnum, 0)) + type_err(c, + "error: Can only convert string to number, not %1", + prog, type, 0, NULL); + return Tnum; + case Bracket: return propagate_types(b->right, c, ok, type, 0); ###### interp binode cases case Plus: - rv = interp_exec(b->left, &rvtype); - right = interp_exec(b->right, &rtype); + rv = interp_exec(c, b->left, &rvtype); + right = interp_exec(c, b->right, &rtype); mpq_add(rv.num, rv.num, right.num); break; case Minus: - rv = interp_exec(b->left, &rvtype); - right = interp_exec(b->right, &rtype); + rv = interp_exec(c, b->left, &rvtype); + right = interp_exec(c, b->right, &rtype); mpq_sub(rv.num, rv.num, right.num); break; case Times: - rv = interp_exec(b->left, &rvtype); - right = interp_exec(b->right, &rtype); + rv = interp_exec(c, b->left, &rvtype); + right = interp_exec(c, b->right, &rtype); mpq_mul(rv.num, rv.num, right.num); break; case Divide: - rv = interp_exec(b->left, &rvtype); - right = interp_exec(b->right, &rtype); + rv = interp_exec(c, b->left, &rvtype); + right = interp_exec(c, b->right, &rtype); mpq_div(rv.num, rv.num, right.num); break; case Rem: { mpz_t l, r, rem; - left = interp_exec(b->left, <ype); - right = interp_exec(b->right, &rtype); + left = interp_exec(c, b->left, <ype); + right = interp_exec(c, b->right, &rtype); mpz_init(l); mpz_init(r); mpz_init(rem); mpz_tdiv_q(l, mpq_numref(left.num), mpq_denref(left.num)); mpz_tdiv_q(r, mpq_numref(right.num), mpq_denref(right.num)); @@ -2947,22 +3034,43 @@ should only insert brackets were needed for precedence. break; } case Negate: - rv = interp_exec(b->right, &rvtype); + rv = interp_exec(c, b->right, &rvtype); mpq_neg(rv.num, rv.num); break; case Absolute: - rv = interp_exec(b->right, &rvtype); + rv = interp_exec(c, b->right, &rvtype); mpq_abs(rv.num, rv.num); break; case Bracket: - rv = interp_exec(b->right, &rvtype); + rv = interp_exec(c, b->right, &rvtype); break; case Concat: - left = interp_exec(b->left, <ype); - right = interp_exec(b->right, &rtype); + left = interp_exec(c, b->left, <ype); + right = interp_exec(c, b->right, &rtype); rvtype = Tstr; rv.str = text_join(left.str, right.str); break; + case StringConv: + right = interp_exec(c, b->right, &rvtype); + rtype = Tstr; + rvtype = Tnum; + + struct text tx = right.str; + char tail[3]; + int neg = 0; + if (tx.txt[0] == '-') { + neg = 1; + tx.txt++; + tx.len--; + } + if (number_parse(rv.num, tail, tx) == 0) + mpq_init(rv.num); + else if (neg) + mpq_neg(rv.num, rv.num); + if (tail[0]) + printf("Unsupported suffix: %.*s\n", tx.len, tx.txt); + + break; ###### value functions @@ -3032,11 +3140,10 @@ is in-place. ###### Binode types Block, -###### expr precedence - $TERM pass - ###### Grammar + $TERM { } ; + $*binode Block -> { IN OptNL Statementlist OUT OptNL } ${ $0 = $right = $<1; }$ + $TERM pass SimpleStatement -> pass ${ $0 = NULL; }$ | ERROR ${ tok_err(c, "Syntax error in statement", &$1); }$ ## SimpleStatement Grammar @@ -3165,7 +3273,7 @@ is in-place. while (rvtype == Tnone && b) { if (b->left) - rv = interp_exec(b->left, &rvtype); + rv = interp_exec(c, b->left, &rvtype); b = cast(binode, b->right); } break; @@ -3254,7 +3362,7 @@ same solution. if (b->left) { if (sep) putchar(sep); - left = interp_exec(b->left, <ype); + left = interp_exec(c, b->left, <ype); print_value(ltype, &left); free_value(ltype, &left); if (b->right) @@ -3281,6 +3389,9 @@ it is declared, and error will be raised as the name is created as Assign, Declare, +###### declare terminals + $TERM = + ###### SimpleStatement Grammar | Variable = Expression ${ $0 = new(binode); @@ -3382,8 +3493,8 @@ it is declared, and error will be raised as the name is created as ###### interp binode cases case Assign: - lleft = linterp_exec(b->left, <ype); - right = interp_exec(b->right, &rtype); + lleft = linterp_exec(c, b->left, <ype); + right = interp_exec(c, b->right, &rtype); if (lleft) { free_value(ltype, lleft); dup_value(ltype, &right, lleft); @@ -3394,17 +3505,19 @@ it is declared, and error will be raised as the name is created as case Declare: { struct variable *v = cast(var, b->left)->var; + struct value *val; if (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) { - right = interp_exec(b->right, &rtype); - free_value(v->type, v->val); - free(v->val); - v->val = val_alloc(v->type, &right); + right = interp_exec(c, b->right, &rtype); + memcpy(val, &right, rtype->size); rtype = Tnone; } else { - free_value(v->type, v->val); - v->val = val_alloc(v->type, NULL); + val_init(v->type, val); } break; } @@ -3431,9 +3544,11 @@ function. struct var *v = cast(var, $0->right); if (v->var->type == Tnone) { /* Convert this to a label */ + struct value *val; + v->var->type = Tlabel; - v->var->val = val_alloc(Tlabel, NULL); - v->var->val->label = v->var->val; + val = global_alloc(c, Tlabel, v->var, NULL); + val->label = val; } } }$ @@ -3456,7 +3571,7 @@ function. ###### interp binode cases case Use: - rv = interp_exec(b->right, &rvtype); + rv = interp_exec(c, b->right, &rvtype); break; ### The Conditional Statement @@ -3886,44 +4001,44 @@ defined. struct value v, cnd; struct type *vtype, *cndtype; struct casepart *cp; - struct cond_statement *c = cast(cond_statement, e); + struct cond_statement *cs = cast(cond_statement, e); - if (c->forpart) - interp_exec(c->forpart, NULL); + if (cs->forpart) + interp_exec(c, cs->forpart, NULL); do { - if (c->condpart) - cnd = interp_exec(c->condpart, &cndtype); + 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 (c->dopart) - interp_exec(c->dopart, NULL); + if (cs->dopart) + interp_exec(c, cs->dopart, NULL); - if (c->thenpart) { - rv = interp_exec(c->thenpart, &rvtype); - if (rvtype != Tnone || !c->dopart) + if (cs->thenpart) { + rv = interp_exec(c, cs->thenpart, &rvtype); + if (rvtype != Tnone || !cs->dopart) goto Xcond_done; free_value(rvtype, &rv); rvtype = Tnone; } - } while (c->dopart); + } while (cs->dopart); - for (cp = c->casepart; cp; cp = cp->next) { - v = interp_exec(cp->value, &vtype); + for (cp = cs->casepart; cp; cp = cp->next) { + v = interp_exec(c, cp->value, &vtype); if (value_cmp(cndtype, vtype, &v, &cnd) == 0) { free_value(vtype, &v); free_value(cndtype, &cnd); - rv = interp_exec(cp->action, &rvtype); + rv = interp_exec(c, cp->action, &rvtype); goto Xcond_done; } free_value(vtype, &v); } free_value(cndtype, &cnd); - if (c->elsepart) - rv = interp_exec(c->elsepart, &rvtype); + if (cs->elsepart) + rv = interp_exec(c, cs->elsepart, &rvtype); else rvtype = Tnone; Xcond_done: @@ -3951,6 +4066,8 @@ various declarations in the parse context. $void Ocean -> OptNL DeclarationList + ## declare terminals + OptNL -> | OptNL NEWLINE Newlines -> NEWLINE @@ -3994,6 +4111,8 @@ searching through for the Nth constant for decreasing N. ###### top level grammar + $TERM const + DeclareConstant -> const { IN OptNL ConstList OUT OptNL } Newlines | const { SimpleConstList } Newlines | const IN OptNL ConstList OUT Newlines @@ -4035,8 +4154,8 @@ searching through for the Nth constant for decreasing N. if (!ok) c->parse_error = 1; else if (v) { - struct value res = interp_exec($5, &v->type); - v->val = val_alloc(v->type, &res); + struct value res = interp_exec(c, $5, &v->type); + global_alloc(c, v->type, v, &res); } } }$ @@ -4059,12 +4178,13 @@ searching through for the Nth constant for decreasing N. printf("const\n"); target = i; } else { + struct value *val = var_value(&context, v); printf(" %.*s :: ", v->name->name.len, v->name->name.txt); type_print(v->type, stdout); printf(" = "); if (v->type == Tstr) printf("\""); - print_value(v->type, v->val); + print_value(v->type, val); if (v->type == Tstr) printf("\""); printf("\n"); @@ -4100,6 +4220,8 @@ analysis is a bit more interesting at this level. c->prog = $<1; } }$ + $TERM program + $*binode Program -> program OpenScope Varlist ColonBlock Newlines ${ $0 = new(binode); @@ -4150,43 +4272,57 @@ analysis is a bit more interesting at this level. static int analyse_prog(struct exec *prog, struct parse_context *c) { - struct binode *b = cast(binode, prog); + struct binode *bp = cast(binode, prog); + struct binode *b; int ok = 1; + int arg = 0; + struct type *argv_type; + struct text argv_type_name = { " argv", 5 }; - if (!b) + if (!bp) return 0; // NOTEST - do { - ok = 1; - propagate_types(b->right, c, &ok, Tnone, 0); - } while (ok == 2); - if (!ok) - return 0; - for (b = cast(binode, b->left); b; b = cast(binode, b->right)) { - struct var *v = cast(var, b->left); - if (!v->var->type) { - v->var->where_set = b; - v->var->type = Tstr; - v->var->val = NULL; + argv_type = add_type(c, argv_type_name, &array_prototype); + argv_type->array.member = Tstr; + + for (b = cast(binode, bp->left); b; b = cast(binode, b->right)) { + struct var *v; + ok = 1; + switch (arg++) { + case 0: /* argc */ + v = cast(var, b->left); + argv_type->array.vsize = v->var; + propagate_types(b->left, c, &ok, Tnum, 0); + break; + case 1: /* argv */ + propagate_types(b->left, c, &ok, argv_type, 0); + break; + default: /* invalid */ + propagate_types(b->left, c, &ok, Tnone, 0); } } - b = cast(binode, prog); + do { ok = 1; - propagate_types(b->right, c, &ok, Tnone, 0); + propagate_types(bp->right, c, &ok, Tnone, 0); } while (ok == 2); if (!ok) return 0; /* Make sure everything is still consistent */ - propagate_types(b->right, c, &ok, Tnone, 0); - return !!ok; + propagate_types(bp->right, c, &ok, Tnone, 0); + if (!ok) + return 0; + scope_finalize(c); + return 1; } - static void interp_prog(struct exec *prog, char **argv) + static void interp_prog(struct parse_context *c, struct exec *prog, + int argc, char **argv) { struct binode *p = cast(binode, prog); struct binode *al; + int anum = 0; struct value v; struct type *vtype; @@ -4195,25 +4331,38 @@ analysis is a bit more interesting at this level. al = cast(binode, p->left); while (al) { struct var *v = cast(var, al->left); - struct value *vl = v->var->val; - - if (argv[0] == NULL) { - printf("Not enough args\n"); - exit(1); + struct value *vl = var_value(c, v->var); + struct value arg; + struct type *t; + mpq_t argcq; + int i; + + switch (anum++) { + case 0: /* argc */ + if (v->var->type == Tnum) { + mpq_init(argcq); + mpq_set_ui(argcq, argc, 1); + memcpy(vl, &argcq, sizeof(argcq)); + } + break; + case 1: /* argv */ + t = v->var->type; + t->prepare_type(c, t, 0); + array_init(v->var->type, vl); + for (i = 0; i < argc; i++) { + struct value *vl2 = vl->array + i * v->var->type->array.member->size; + + + arg.str.txt = argv[i]; + arg.str.len = strlen(argv[i]); + free_value(Tstr, vl2); + dup_value(Tstr, &arg, vl2); + } + break; } al = cast(binode, al->right); - if (vl) - free_value(v->var->type, vl); - if (!vl) { - vl = val_alloc(v->var->type, NULL); - v->var->val = vl; - } - free_value(v->var->type, vl); - if (!parse_value(v->var->type, argv[0], vl)) - exit(1); - argv++; } - v = interp_exec(p->right, &vtype); + v = interp_exec(c, p->right, &vtype); free_value(vtype, &v); } @@ -4248,11 +4397,13 @@ things which will likely grow as the languages grows. name:string alive:Boolean - program A B: + program argc argv: print "Hello World, what lovely oceans you have!" print "Are there", five, "?" print pi, pie, "but", cake + A := $argv[1]; B := $argv[2] + /* When a variable is defined in both branches of an 'if', * and used afterwards, the variables are merged. */