From a3ebefe7fbcb375c77c3b4ccb6064dabb45d8911 Mon Sep 17 00:00:00 2001 From: Peter Mikkelsen Date: Fri, 28 Jan 2022 14:15:17 +0000 Subject: =?UTF-8?q?Add=20strand=20assignment=20(a=20(b=20c)=20d)=E2=86=901?= =?UTF-8?q?=20(2=203)=204?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- apl9.h | 1 + eval.c | 101 +++++++++++++++++++++++++++++++++++++++++++++++++++------------- print.c | 6 ++-- 3 files changed, 85 insertions(+), 23 deletions(-) diff --git a/apl9.h b/apl9.h index 3181fcb..1502412 100644 --- a/apl9.h +++ b/apl9.h @@ -149,6 +149,7 @@ struct Datum Operator operator; int hybrid; Rune *name; + Statement names; }; }; diff --git a/eval.c b/eval.c index e33c3b5..8829609 100644 --- a/eval.c +++ b/eval.c @@ -15,6 +15,7 @@ Datum monadfun(Datum, Datum); Datum dyadfun(Datum, Datum); Datum parens(Datum, Datum); Datum nameis(Datum, Datum); +Datum namesis(Datum, Datum); Datum assign(Datum, Datum); Datum monadop(Datum, Datum); Datum dyadop(Datum, Datum); @@ -29,8 +30,8 @@ int bindingstrengths[11][11] = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* MO */ 6, 6, 6, 0, 0, 0, 0, 0, 0, 0, 0, /* DO */ 3, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* AF */ - 0, 0, 0, 0, 0, 0, 0, 8, 0, 0, 0, /* ( */ - 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, /* ) */ + 0, 0, 0, 0, 0, 0, 0, 8, 9, 0, 0, /* ( */ + 0, 0, 0, 0, 0, 0, 0, 0, 9, 0, 0, /* ) */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* ← */ 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, /* IS */ 0, 0, 0, 0, 0, 0, 0, 0, 9, 0, 0, /* N */ @@ -44,10 +45,10 @@ evalfn evalfns[11][11] = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* MO */ dyadop, dyadop, dyadop, 0, 0, 0, 0, 0, 0, 0, 0, /* DO */ monadfun, train, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* AF */ - 0, 0, 0, 0, 0, 0, 0, parens, 0, 0, 0, /* ( */ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* ) */ + 0, 0, 0, 0, 0, 0, 0, parens, namesis, 0, 0, /* ( */ + 0, 0, 0, 0, 0, 0, 0, 0, namesis, 0, 0, /* ) */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* ← */ - assign, assign, assign, assign, assign, 0, 0, 0, 0, 0, 0, /* IS */ + assign, assign, assign, assign, assign, 0, assign, 0, 0, 0, 0, /* IS */ 0, 0, 0, 0, 0, 0, 0, 0, nameis, 0, 0, /* N */ }; @@ -221,27 +222,87 @@ nameis(Datum left, Datum right) { traceprint("NAMEIS %S←\n", left.name); right.tag = AssignmentTag; - right.name = left.name; + right.names.ntoks = 1; + right.names.toks = malloc(sizeof(Datum)); + right.names.toks[0] = left; + return right; +} + +Datum +namesis(Datum left, Datum right) +{ + if(left.tag == RParTag) + return right; + + traceprint("NAMES IS %S %S\n", ppdatum(left), ppdatum(right)); + right.tag = AssignmentTag; + right.names = left.stmt; return right; } Datum assign(Datum left, Datum right) { - Symbol *symbol = getsym(left.name, 0); - if(symbol->setfn != nil) - symbol->setfn(right); - else{ - /* re-assign the symbol to one that is sure to be local. This enables shadowing */ - symbol = getsym(left.name, 1); - - if(symbol->undefined == 0 && symbol->value.tag == ArrayTag) - freearray(symbol->value.array); - symbol->value = right; - symbol->undefined = 0; - if(symbol->value.tag == ArrayTag){ - symbol->value.array->stranded = 0; - incref(right.array); /* for the binding */ + traceprint("ASSIGN %S %S\n", ppdatum(left), ppdatum(right)); + if(left.names.ntoks == 1){ + if(left.names.toks[0].tag != NameTag) + throwerror(nil, ESyntax); + + Symbol *symbol = getsym(left.names.toks[0].name, 0); + if(symbol->setfn != nil) + symbol->setfn(right); + else{ + /* re-assign the symbol to one that is sure to be local. This enables shadowing */ + symbol = getsym(symbol->name, 1); + + if(symbol->undefined == 0 && symbol->value.tag == ArrayTag) + freearray(symbol->value.array); + symbol->value = right; + symbol->undefined = 0; + if(symbol->value.tag == ArrayTag){ + symbol->value.array->stranded = 0; + incref(right.array); /* for the binding */ + } + } + }else{ + if(right.tag != ArrayTag) + throwerror(nil, ESyntax); + if(right.array->rank != 1 && right.array->rank != 0) + throwerror(nil, ERank); + + int nlocs = 0; + Datum *locations = nil; + for(int i = 0; i < left.names.ntoks; i++){ + Datum loc = left.names.toks[i]; + if(loc.tag == NameTag){ + nlocs++; + locations = realloc(locations, sizeof(Datum) * nlocs); + locations[nlocs-1].tag = AssignmentTag; + locations[nlocs-1].names.ntoks = 1; + locations[nlocs-1].names.toks = malloc(sizeof(Datum)); + locations[nlocs-1].names.toks[0] = loc; + }else if(loc.tag == LParTag){ + i++; + nlocs++; + locations = realloc(locations, sizeof(Datum) * nlocs); + locations[nlocs-1].tag = AssignmentTag; + locations[nlocs-1].names = loc.stmt; + } + } + + if(right.array->rank == 1 && right.array->size != nlocs) + throwerror(nil, ELength); + + for(int i = 0; i < nlocs; i++){ + if(right.array->rank == 0) + assign(locations[i], right); + else{ + Datum item; + item.tag = ArrayTag; + item.array = arrayitem(right.array, i); + assign(locations[i], item); + freearray(item.array); + } } } right.shy = 1; diff --git a/print.c b/print.c index 3c119dd..45bca53 100644 --- a/print.c +++ b/print.c @@ -21,10 +21,10 @@ ppdatum(Datum d) case HybridTag: result = runesmprint("%C", primhybridnames[d.func.code]); break; case MonadicOpTag: case DyadicOpTag: result = ppoperator(d.operator); break; - case LParTag: result = runestrdup(L"("); break; + case LParTag: result = runesmprint("(%S", ppdatums(d.stmt.toks, d.stmt.ntoks)); break; case RParTag: result = runestrdup(L")"); break; case ArrowTag: result = runestrdup(L"←"); break; - case AssignmentTag: result = runesmprint("%S←", d.name); break; + case AssignmentTag: result = runesmprint("(%S)←", ppdatums(d.stmt.toks, d.stmt.ntoks)); break; case NameTag: result = runestrdup(d.name); break; default: result = runesmprint("", d.tag); } @@ -39,7 +39,7 @@ ppdatums(Datum *ds, int n) Rune *tmp; for(i = 0; i < n; i++){ tmp = res; - res = runesmprint("%S %S", res, ppdatum(ds[i])); + res = runesmprint("%S%S%s", res, ppdatum(ds[i]), (i+1) < n ? " " : ""); free(tmp); } return res; -- cgit v1.2.3