diff options
| -rw-r--r-- | apl9.h | 6 | ||||
| -rw-r--r-- | array.c | 91 | ||||
| -rw-r--r-- | functions.c | 102 | ||||
| -rw-r--r-- | lexer.c | 13 | ||||
| -rw-r--r-- | print.c | 16 | ||||
| -rw-r--r-- | quadnames.c | 27 | ||||
| -rw-r--r-- | symbol.c | 8 |
7 files changed, 220 insertions, 43 deletions
@@ -22,6 +22,7 @@ typedef enum typedef enum { AtypeInt, + AtypeFloat, AtypeArray, } arrayDataType; @@ -58,6 +59,7 @@ struct Array union { char *rawdata; vlong *intdata; + double *floatdata; Array **arraydata; }; }; @@ -154,11 +156,13 @@ Statement *lexline(Rune *); /* array.c */ Array *mkscalarint(vlong); +Array *mkscalarfloat(double); Array *duparray(Array *); int simplearray(Array *); int simplescalar(Array *); Array *extend(Array *, Array *); int scalarextend(Array *, Array *, Array **, Array **); +int commontype(Array *, Array *, Array **, Array **, int); Array *arrayitem(Array *, int); Array *simplifyarray(Array *); @@ -169,7 +173,6 @@ Datum *eval(Statement *); Symbol *getsym(Symtab *, Rune *); Symtab *newsymtab(void); void freesymtab(Symtab *); -vlong globalIO(void); /* memory.c */ void *emalloc(ulong); @@ -230,3 +233,4 @@ extern Symtab *globalsymtab; /* symbol.c */ extern Symtab *currentsymtab; /* symbol.c */ extern int alloccounts; /* memory.c */ extern QuadnameDef quadnames[]; /* quadnames.c */ +extern int printprecision; /* print.c */
\ No newline at end of file @@ -4,8 +4,11 @@ #include "apl9.h" +Array *inttofloatarray(Array *); + int datasizes[] = { [AtypeInt] = sizeof(vlong), + [AtypeFloat] = sizeof(double), [AtypeArray] = sizeof(Array *) }; @@ -14,7 +17,14 @@ mkscalarint(vlong i) { Array *a = allocarray(AtypeInt, 0, 1); a->intdata[0] = i; + return a; +} +Array * +mkscalarfloat(double f) +{ + Array *a = allocarray(AtypeFloat, 0, 1); + a->floatdata[0] = f; return a; } @@ -39,7 +49,7 @@ simplearray(Array *a) int simplescalar(Array *a) { - return simplearray(a) && a->rank == 0; + return a->rank == 0 && a->type != AtypeArray; } Array * @@ -81,6 +91,40 @@ scalarextend(Array *a, Array *b, Array **aa, Array **bb) } Array * +inttofloatarray(Array *a) +{ + Array *b = allocarray(AtypeFloat, a->rank, a->size); + for(int i = 0; i < a->rank; i++) + b->shape[i] = a->shape[i]; + for(int i = 0; i < a->size; i++) + b->floatdata[i] = a->intdata[i]; + return b; +} + +int +commontype(Array *a, Array *b, Array **aa, Array **bb, int forcefloat) +{ + /* When A and B are numeric arrays, set aa and bb + to arrays that have compatible types, with the same data. + */ + if(forcefloat){ + *aa = a->type == AtypeFloat ? fnSame(a) : inttofloatarray(a); + *bb = b->type == AtypeFloat ? fnSame(b) : inttofloatarray(b); + }else if(a->type == b->type){ + *aa = fnSame(a); + *bb = fnSame(b); + }else if(a->type == AtypeFloat && b->type == AtypeInt){ + *aa = fnSame(a); + *bb = inttofloatarray(b); + }else if(a->type == AtypeInt && b->type == AtypeFloat){ + *aa = inttofloatarray(a); + *bb = fnSame(b); + }else + return 0; + return 1; +} + +Array * arrayitem(Array *a, int index) { Array *res = nil; @@ -88,6 +132,9 @@ arrayitem(Array *a, int index) case AtypeInt: res = mkscalarint(a->intdata[index]); break; + case AtypeFloat: + res = mkscalarfloat(a->floatdata[index]); + break; case AtypeArray: res = a->arraydata[index]; incref(res); @@ -106,14 +153,38 @@ simplifyarray(Array *a) if(a->type != AtypeArray || a->size == 0) return fnSame(a); int type = a->arraydata[0]->type; + int canfloat = type == AtypeFloat || type == AtypeInt; + int sametype = 1; int i; - for(i = 0; i < a->size; i++) - if(a->arraydata[i]->type != type || a->arraydata[i]->rank != 0) - return fnSame(a); - Array *b = allocarray(type, a->rank, a->size); - for(i = 0; i < a->rank; i++) - b->shape[i] = a->shape[i]; - for(i = 0; i < a->size; i++) - memcpy(b->rawdata + i * datasizes[type], a->arraydata[i]->rawdata, datasizes[type]); - return b; + + for(i = 0; i < a->size; i++){ + int t = a->arraydata[i]->type; + canfloat = canfloat && (t == AtypeFloat || t == AtypeInt); + sametype = sametype && (t == type); + if(a->arraydata[i]->rank != 0) + return fnSame(a); /* cannot be simplified */ + } + + if(sametype){ + Array *b = allocarray(type, a->rank, a->size); + b->stranded = a->stranded; + for(i = 0; i < a->rank; i++) + b->shape[i] = a->shape[i]; + for(i = 0; i < a->size; i++) + memcpy(b->rawdata + i * datasizes[type], a->arraydata[i]->rawdata, datasizes[type]); + return b; + }else if(canfloat){ + Array *b = allocarray(AtypeFloat, a->rank, a->size); + b->stranded = a->stranded; + for(i = 0; i < a->rank; i++) + b->shape[i] = a->shape[i]; + for(i = 0; i < a->size; i++){ + if(a->arraydata[i]->type == AtypeFloat) + b->floatdata[i] = a->arraydata[i]->floatdata[0]; + else + b->floatdata[i] = a->arraydata[i]->intdata[0]; + } + return b; + }else + return fnSame(a); }
\ No newline at end of file diff --git a/functions.c b/functions.c index 5fa9305..411f90b 100644 --- a/functions.c +++ b/functions.c @@ -191,7 +191,7 @@ fnIndexGenerator(Array *right) vlong n = right->intdata[0]; Array *res = allocarray(AtypeInt, 1, n); res->shape[0] = n; - vlong io = globalIO(); + vlong io = currentsymtab->io; for(vlong i = 0; i < n; i++) res->intdata[i] = i + io; return res; @@ -239,11 +239,23 @@ fnPlus(Array *left, Array *right) exits(nil); } - Array *res = duparray(leftarr); - for(int i = 0; i < leftarr->size; i++) - res->intdata[i] += rightarr->intdata[i]; + int typeok = commontype(leftarr, rightarr, &left, &right, 0); + if(!typeok){ + print("Types don't match lol\n"); + exits(nil); + } + + Array *res = duparray(left); + for(int i = 0; i < left->size; i++){ + if(res->type == AtypeFloat) + res->floatdata[i] += right->floatdata[i]; + else if(res->type == AtypeInt) + res->intdata[i] += right->intdata[i]; + } freearray(leftarr); freearray(rightarr); + freearray(left); + freearray(right); return res; } @@ -258,11 +270,23 @@ fnMinus(Array *left, Array *right) exits(nil); } - Array *res = duparray(leftarr); - for(int i = 0; i < leftarr->size; i++) - res->intdata[i] -= rightarr->intdata[i]; + int typeok = commontype(leftarr, rightarr, &left, &right, 0); + if(!typeok){ + print("Types don't match lol\n"); + exits(nil); + } + + Array *res = duparray(left); + for(int i = 0; i < left->size; i++){ + if(res->type == AtypeFloat) + res->floatdata[i] -= right->floatdata[i]; + else if(res->type == AtypeInt) + res->intdata[i] -= right->intdata[i]; + } freearray(leftarr); freearray(rightarr); + freearray(left); + freearray(right); return res; } @@ -277,11 +301,23 @@ fnTimes(Array *left, Array *right) exits(nil); } - Array *res = duparray(leftarr); - for(int i = 0; i < leftarr->size; i++) - res->intdata[i] *= rightarr->intdata[i]; + int typeok = commontype(leftarr, rightarr, &left, &right, 0); + if(!typeok){ + print("Types don't match lol\n"); + exits(nil); + } + + Array *res = duparray(left); + for(int i = 0; i < left->size; i++){ + if(res->type == AtypeFloat) + res->floatdata[i] *= right->floatdata[i]; + else if(res->type == AtypeInt) + res->intdata[i] *= right->intdata[i]; + } freearray(leftarr); freearray(rightarr); + freearray(left); + freearray(right); return res; } @@ -296,11 +332,19 @@ fnDivide(Array *left, Array *right) exits(nil); } - Array *res = duparray(leftarr); - for(int i = 0; i < leftarr->size; i++) - res->intdata[i] /= rightarr->intdata[i]; + int typeok = commontype(leftarr, rightarr, &left, &right, 1); + if(!typeok){ + print("Types don't match lol\n"); + exits(nil); + } + + Array *res = duparray(left); + for(int i = 0; i < left->size; i++) + res->floatdata[i] /= right->floatdata[i]; freearray(leftarr); freearray(rightarr); + freearray(left); + freearray(right); return res; } @@ -315,11 +359,23 @@ fnPower(Array *left, Array *right) exits(nil); } - Array *res = duparray(leftarr); - for(int i = 0; i < leftarr->size; i++) - res->intdata[i] = pow(res->intdata[i], rightarr->intdata[i]); + int typeok = commontype(leftarr, rightarr, &left, &right, 0); + if(!typeok){ + print("Types don't match lol\n"); + exits(nil); + } + + Array *res = duparray(left); + for(int i = 0; i < left->size; i++){ + if(res->type == AtypeFloat) + res->floatdata[i] = pow(res->floatdata[i], right->floatdata[i]); + else if(res->type == AtypeInt) + res->intdata[i] = pow(res->intdata[i], right->intdata[i]); + } freearray(leftarr); freearray(rightarr); + freearray(left); + freearray(right); return res; } @@ -334,11 +390,19 @@ fnLogarithm(Array *left, Array *right) exits(nil); } - Array *res = duparray(leftarr); - for(int i = 0; i < leftarr->size; i++) - res->intdata[i] = log(rightarr->intdata[i])/log(res->intdata[i]); + int typeok = commontype(leftarr, rightarr, &left, &right, 1); + if(!typeok){ + print("Types don't match lol\n"); + exits(nil); + } + + Array *res = duparray(left); + for(int i = 0; i < left->size; i++) + res->floatdata[i] = log(right->floatdata[i])/log(res->floatdata[i]); freearray(leftarr); freearray(rightarr); + freearray(left); + freearray(right); return res; } @@ -88,13 +88,18 @@ lexline(Rune *line) }else if(isdigitrune(line[offset])){ char buf[64]; char *p = buf; - while(isdigitrune(line[offset])){ - p += runetochar(p, &line[offset]); - offset++; + int floating = 0; +get_digits: + while(isdigitrune(line[offset])) + p += runetochar(p, &line[offset++]); + if(!floating && line[offset] == '.'){ + p += runetochar(p, &line[offset++]); + floating = 1; + goto get_digits; } *p = 0; stmt->toks[stmt->ntoks].tag = ArrayTag; - stmt->toks[stmt->ntoks].array = mkscalarint(atoll(buf)); + stmt->toks[stmt->ntoks].array = floating ? mkscalarfloat(atof(buf)) : mkscalarint(atoll(buf)); }else if(runestrchr(L"⍺⍵", line[offset])){ Rune *name = L"?"; name[0] = line[offset]; @@ -4,6 +4,8 @@ #include "apl9.h" +int printprecision = 10; + void strdims(Rune *, int *, int *); Rune *printborder(Rune *, int *, int, int); Rune *strline(Rune *, int); @@ -69,7 +71,7 @@ pparray(Array *a) rowcount *= a->shape[i]; } Rune **rowstrs = mallocz(sizeof(Rune *) * rowcount, 1); - int boxing = a->type == AtypeArray; + int boxing = !simplearray(a); char *align = a->type == AtypeArray ? "-" : ""; for(int i = 0; i < a->size; i++){ @@ -79,6 +81,18 @@ pparray(Array *a) free(arrstr); }else if(a->type == AtypeInt) elemstrs[i] = runesmprint("%lld", a->intdata[i]); + else if(a->type == AtypeFloat){ + char *fmt = smprint("%%.%df", printprecision); + elemstrs[i] = runesmprint(fmt, a->floatdata[i]); + free(fmt); + Rune *p = &elemstrs[i][runestrlen(elemstrs[i])-1]; + int done = 0; + while((*p == '0' || *p == '.') && !done){ + if(*p == '.') + done = 1; + *p-- = 0; /* remove trailing 0's */ + } + } } int lastdim = a->rank ? a->shape[a->rank-1] : 1; diff --git a/quadnames.c b/quadnames.c index b765e58..14c431e 100644 --- a/quadnames.c +++ b/quadnames.c @@ -8,10 +8,13 @@ Datum *getquad(void); int setquad(Datum); Datum *getio(void); int setio(Datum); +Datum *getpp(void); +int setpp(Datum); QuadnameDef quadnames[] = { {L"⎕", NameTag, getquad, setquad, nil, nil}, {L"⎕IO", NameTag, getio, setio, nil, nil}, + {L"⎕PP", NameTag, getpp, setpp, nil, nil}, {nil, 0, nil, nil, nil, nil} /* MUST BE LAST */ }; @@ -60,7 +63,7 @@ getio(void) { Datum *d = mallocz(sizeof(Datum), 1); d->tag = ArrayTag; - d->array = mkscalarint(globalIO()); + d->array = mkscalarint(currentsymtab->io); return d; } @@ -74,4 +77,26 @@ setio(Datum new) currentsymtab->io = new.array->intdata[0]; return 1; } +} + +/* ⎕PP */ +Datum * +getpp(void) +{ + Datum *d = mallocz(sizeof(Datum), 1); + d->tag = ArrayTag; + d->array = mkscalarint(printprecision); + return d; +} + +int +setpp(Datum new) +{ + if(new.tag != ArrayTag || new.array->rank != 0 || new.array->type != AtypeInt || new.array->intdata[0] < 0){ + print("⎕PP: domain error\n"); + return 0; + }else{ + printprecision = new.array->intdata[0]; + return 1; + } }
\ No newline at end of file @@ -30,7 +30,7 @@ newsymtab(void) Symtab *tab = emalloc(sizeof(Symtab)); tab->nsyms = 0; tab->syms = nil; - tab->io = currentsymtab ? globalIO() : 1; + tab->io = currentsymtab ? currentsymtab->io : 1; return tab; } @@ -47,9 +47,3 @@ freesymtab(Symtab *tab) free(tab->syms); free(tab); } - -vlong -globalIO(void) -{ - return currentsymtab->io; -}
\ No newline at end of file |