summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--apl9.h20
-rw-r--r--error.c29
-rw-r--r--eval.c2
-rw-r--r--functions.c60
-rw-r--r--hybrids.c8
-rw-r--r--main.c12
-rw-r--r--operators.c16
-rw-r--r--quadnames.c62
8 files changed, 127 insertions, 82 deletions
diff --git a/apl9.h b/apl9.h
index 88135c6..51cebfb 100644
--- a/apl9.h
+++ b/apl9.h
@@ -45,16 +45,14 @@ typedef enum
typedef enum
{
- ESyntax = 1,
- EParse,
- EValue,
- EDomain,
- ERank,
- EType,
- ELength,
- EIndex,
- EShape,
- ENotImplemented,
+ /* The numbers are the same as in dyalog */
+ ESyntax = 2,
+ EIndex = 3,
+ ERank = 4,
+ ELength = 5,
+ EValue = 6,
+ EDomain = 11,
+ ENotImplemented = 100, /* not in dyalog */
} errorCodes;
/* Data types */
@@ -330,6 +328,7 @@ Datum *quadnamedatum(QuadnameDef);
/* error.c */
ErrorGuard *newerrorguard(Array *, Statement *);
void throwerror(Rune *, int);
+Rune *errorstr(int);
/* inverse.c */
Function inverse(Function);
@@ -479,6 +478,5 @@ extern int arrayalloccounts; /* memory.c */
extern int datumalloccounts; /* memory.c */
extern QuadnameDef quadnames[]; /* quadnames.c */
extern int printprecision; /* print.c */
-extern Rune *errorstrs[]; /* error.c */
extern int needsnewline; /* quadnames.c */
extern int mainstacksize; /* concurrency.c */ \ No newline at end of file
diff --git a/error.c b/error.c
index 2a59553..09f2c32 100644
--- a/error.c
+++ b/error.c
@@ -7,19 +7,6 @@
ErrorGuard *globalerrorguard;
-Rune *errorstrs[] = {
- [ESyntax] = L"SYNTAX ERROR",
- [EParse] = L"PARSE ERROR",
- [EValue] = L"VALUE ERROR",
- [EDomain] = L"DOMAIN ERROR",
- [ERank] = L"RANK ERROR",
- [EType] = L"TYPE ERROR",
- [ELength] = L"LENGTH ERROR",
- [EIndex] = L"INDEX ERROR",
- [EShape] = L"SHAPE ERROR",
- [ENotImplemented] = L"NOT IMPLEMENTED",
-};
-
ErrorGuard *
newerrorguard(Array *codes, Statement *guard)
{
@@ -69,3 +56,19 @@ match:
longjmp(matching->jmp, 1);
}
+Rune *
+errorstr(int code)
+{
+ Rune *err;
+ switch(code){
+ case ESyntax: err = L"SYNTAX ERROR"; break;
+ case EIndex: err = L"INDEX ERROR"; break;
+ case ERank: err = L"RANK ERROR"; break;
+ case ELength: err = L"LENGTH ERROR"; break;
+ case EValue: err = L"VALUE ERROR"; break;
+ case EDomain: err = L"DOMAIN ERROR"; break;
+ case ENotImplemented: err = L"NOT IMPLEMENTED"; break;
+ default: err = L""; break;
+ }
+ return err;
+} \ No newline at end of file
diff --git a/eval.c b/eval.c
index b629f90..3174cd4 100644
--- a/eval.c
+++ b/eval.c
@@ -93,7 +93,7 @@ retry:
maxlevel = level;
}
if(maxlevel == 0)
- throwerror(L"No reduce rule", EParse);
+ throwerror(L"No reduce rule", ESyntax);
else{
Datum *new = fn(stmt->toks[offset], stmt->toks[offset+1]);
traceprint("handler fn done\n");
diff --git a/functions.c b/functions.c
index 7e462c3..f73ff29 100644
--- a/functions.c
+++ b/functions.c
@@ -325,7 +325,7 @@ Array *
fnMatrixInverse(Array *right)
{
if(GetType(right) != AtypeInt && GetType(right) != AtypeFloat)
- throwerror(nil, EType);
+ throwerror(nil, EDomain);
if(GetRank(right) > 2)
throwerror(nil, ERank);
@@ -369,7 +369,7 @@ fnFactorial(Array *right)
}else if(GetType(right) == AtypeFloat)
throwerror(L"Factorial of floating values", ENotImplemented);
else
- throwerror(nil, EType);
+ throwerror(nil, EDomain);
return result;
}
@@ -408,7 +408,7 @@ fnRoll(Array *right)
result->intdata[i] = io + lrand() % right->intdata[i];
}
}else
- throwerror(nil, EType);
+ throwerror(nil, EDomain);
return result;
}
@@ -443,7 +443,7 @@ fnFloor(Array *right)
res->arraydata[i] = fnFloor(right->arraydata[i]);
break;
default:
- throwerror(nil, EType);
+ throwerror(nil, EDomain);
}
return res;
}
@@ -734,7 +734,7 @@ Array *
fnNot(Array *right)
{
if(GetType(right) != AtypeInt)
- throwerror(nil, EType);
+ throwerror(nil, EDomain);
Array *res = duparray(right);
for(int i = 0; i < GetSize(res); i++){
if(res->intdata[i] == 0)
@@ -743,7 +743,7 @@ fnNot(Array *right)
res->intdata[i] = 0;
else{
freearray(res);
- throwerror(nil, EType);
+ throwerror(nil, EDomain);
}
}
return res;
@@ -859,14 +859,14 @@ Array *
fnExecute(Array *right)
{
if(GetType(right) != AtypeRune)
- throwerror(nil, EType);
+ throwerror(nil, EDomain);
Rune *code = pparray(right);
Datum *result = evalline(code, nil, 1);
free(code);
if(!result)
throwerror(L"No result produced by ⍎", EDomain);
if(result->tag != ArrayTag)
- throwerror(L"Result of ⍎ must be an array", EType);
+ throwerror(L"Result of ⍎ must be an array", EDomain);
Array *res = result->array;
free(result);
return res;
@@ -936,7 +936,7 @@ Array *name(Array *left, Array *right){\
rightarr = fnSame(right);\
}else{\
if(!commontype(left, right, &leftarr, &rightarr, forcefloat))\
- throwerror(nil, EType);\
+ throwerror(nil, EDomain);\
}\
if(!scalarextend(leftarr, rightarr, &left, &right)) throwerror(L"Scalar extension fail", ERank);\
Array *res;\
@@ -953,7 +953,7 @@ Array *name(Array *left, Array *right){\
res = duparray(left);\
for(int i = 0; i < GetSize(left); i++)\
switch(GetType(left)){\
- default: throwerror(nil, EType); break;\
+ default: throwerror(nil, EDomain); break;\
cases\
}\
}\
@@ -1088,9 +1088,9 @@ Array *
fnDeal(Array *left, Array *right)
{
if(GetType(left) != AtypeInt || GetType(right) != AtypeInt)
- throwerror(nil, EType);
+ throwerror(nil, EDomain);
if(GetSize(left) != 1 || GetSize(right) != 1)
- throwerror(nil, EShape);
+ throwerror(nil, ELength);
vlong x = left->intdata[0];
vlong y = right->intdata[0];
if(x < 0 || y < 0 || x > y)
@@ -1140,9 +1140,9 @@ Array *
fnDecode(Array *left, Array *right)
{
if(GetType(left) != AtypeInt && GetType(left) != AtypeFloat)
- throwerror(nil, EType);
+ throwerror(nil, EDomain);
if(GetType(right) != AtypeInt && GetType(right) != AtypeFloat)
- throwerror(nil, EType);
+ throwerror(nil, EDomain);
return rundfn(L"(⌽×\\1,⌽⍵∘{1↓(≢⍺)⍴⍵}⍤1⊢⍺)+.×⍵", nil, nil, left, right);
}
@@ -1150,9 +1150,9 @@ Array *
fnEncode(Array *left, Array *right)
{
if(GetType(left) != AtypeInt && GetType(left) != AtypeFloat)
- throwerror(nil, EType);
+ throwerror(nil, EDomain);
if(GetType(right) != AtypeInt && GetType(right) != AtypeFloat)
- throwerror(nil, EType);
+ throwerror(nil, EDomain);
if(GetRank(left) > 1)
return rundfn(L"⍉(⍉⍺) (⊤⍤1) ⍵", nil, nil, left, right);
@@ -1274,9 +1274,9 @@ SCALAR_FUNCTION_2(fnAnd, 0, GetType(left),
SCALAR_FUNCTION_2(fnNand, 0, AtypeInt,
case AtypeInt:
if(left->intdata[i] != 0 && left->intdata[i] != 1)
- throwerror(nil, EType);
+ throwerror(nil, EDomain);
if(right->intdata[i] != 0 && right->intdata[i] != 1)
- throwerror(nil, EType);
+ throwerror(nil, EDomain);
res->intdata[i] = !(left->intdata[i] && right->intdata[i]);
break;
)
@@ -1284,9 +1284,9 @@ SCALAR_FUNCTION_2(fnNand, 0, AtypeInt,
SCALAR_FUNCTION_2(fnNor, 0, AtypeInt,
case AtypeInt:
if(left->intdata[i] != 0 && left->intdata[i] != 1)
- throwerror(nil, EType);
+ throwerror(nil, EDomain);
if(right->intdata[i] != 0 && right->intdata[i] != 1)
- throwerror(nil, EType);
+ throwerror(nil, EDomain);
res->intdata[i] = !(left->intdata[i] || right->intdata[i]);
break;
)
@@ -1296,7 +1296,7 @@ fnTake(Array *left, Array *right)
{
int i;
if(GetType(left) != AtypeInt)
- throwerror(nil, EType);
+ throwerror(nil, EDomain);
if(GetRank(left) > 1)
throwerror(nil, ERank);
@@ -1388,7 +1388,7 @@ fnDrop(Array *left, Array *right)
{
int i;
if(GetType(left) != AtypeInt)
- throwerror(nil, EType);
+ throwerror(nil, EDomain);
if(GetRank(left) > 1)
throwerror(nil, ERank);
@@ -1470,7 +1470,7 @@ fnPartition(Array *left, Array *right)
if(GetRank(left) > 2)
throwerror(nil, ERank);
if(GetType(left) != AtypeInt)
- throwerror(nil, EType);
+ throwerror(nil, EDomain);
if(GetSize(left) != right->shape[0])
throwerror(nil, ELength);
if(right->shape[0] == 0)
@@ -1523,7 +1523,7 @@ fnIndex(Array *left, Array *right)
if(GetRank(left) > 1)
throwerror(nil, ERank);
if(GetType(left) != AtypeArray && GetType(left) != AtypeInt)
- throwerror(nil, EType);
+ throwerror(nil, EDomain);
if(GetSize(left) > GetRank(right))
throwerror(nil, ELength);
@@ -1543,7 +1543,7 @@ fnIndex(Array *left, Array *right)
}else if(GetType(oldleft) == AtypeArray){
Array *sub = oldleft->arraydata[i];
if(GetType(sub) != AtypeInt)
- throwerror(nil, EType);
+ throwerror(nil, EDomain);
for(int j = 0; j < GetSize(sub); j++){
if(sub->intdata[j] < io || sub->intdata[j] >= io + right->shape[i])
throwerror(nil, EIndex);
@@ -1734,7 +1734,7 @@ fnCatenateFirst(Array *left, Array *right)
for(int i = 1; i < GetRank(leftarr); i++)
if(leftarr->shape[i] != rightarr->shape[i])
- throwerror(nil, EShape);
+ throwerror(nil, ELength);
}
int type, rank, leftsize, rightsize;
@@ -1834,7 +1834,7 @@ Array *
fnRotateFirst(Array *left, Array *right)
{
if(GetType(left) != AtypeInt)
- throwerror(nil, EType);
+ throwerror(nil, EDomain);
if(GetRank(right) == 0 || GetSize(right) < 2)
return fnSame(right);
@@ -1854,7 +1854,7 @@ fnRotateFirst(Array *left, Array *right)
throwerror(nil, ERank);
for(i = 0; i < GetRank(left); i++)
if(left->shape[i] != right->shape[i+1])
- throwerror(nil, EShape);
+ throwerror(nil, ELength);
int n = right->shape[0];
for(i = 0; i < GetSize(left); i++)
@@ -1893,7 +1893,7 @@ fnSend(Array *left, Array *right)
if(GetSize(right) != 1)
throwerror(nil, ELength);
if(GetType(right) != AtypeInt)
- throwerror(nil, EType);
+ throwerror(nil, EDomain);
messagesend(left, right->intdata[0]);
return fnSame(left);
}
@@ -1928,7 +1928,7 @@ indexOfHelper(Array *left, Array *right, int interval)
int i, j;
for(i = 0; i < GetRank(left)-1; i++)
if(left->shape[GetRank(left)-1-i] != right->shape[GetRank(right)-1-i])
- throwerror(nil, EShape);
+ throwerror(nil, ELength);
int rank = GetRank(right) + 1 - GetRank(left);
int size = 1;
diff --git a/hybrids.c b/hybrids.c
index 2a6b9b5..243faa4 100644
--- a/hybrids.c
+++ b/hybrids.c
@@ -37,7 +37,7 @@ Array *
fnReplicateFirst(Array *left, Array *right)
{
if(GetType(left) != AtypeInt)
- throwerror(nil, EType);
+ throwerror(nil, EDomain);
if(GetRank(left) > 1)
throwerror(nil, ERank);
@@ -107,7 +107,7 @@ Array *
fnExpandFirst(Array *left, Array *right)
{
if(GetType(left) != AtypeInt)
- throwerror(nil, EType);
+ throwerror(nil, EDomain);
if(GetRank(left) > 1)
throwerror(nil, ERank);
@@ -193,12 +193,12 @@ opReduceFirst(Datum *lefto, Array *left, Array *right)
{
if(left){
if(GetType(left) != AtypeInt)
- throwerror(nil, EType);
+ throwerror(nil, EDomain);
if(GetSize(left) != 1)
throwerror(nil, ELength);
vlong winsize = left->intdata[0];
if(winsize > right->shape[0])
- throwerror(nil, EShape);
+ throwerror(nil, ELength);
Rune *code = L"n←(-|⍺)+1+≢⍵ ⋄"
L"ix←(⍳|⍺)∘+¨(⍳n)-⎕io ⋄"
diff --git a/main.c b/main.c
index 60beed2..d67d742 100644
--- a/main.c
+++ b/main.c
@@ -33,10 +33,14 @@ threadmain(int argc, char *argv[])
restart:
if(setjmp(eg->jmp)){
ThreadData *td = getthreaddata();
- if(td->lasterrormsg)
- print("%S: %S\n", errorstrs[td->lasterror], td->lasterrormsg);
- else
- print("%S\n", errorstrs[td->lasterror]);
+ Rune *msg = errorstr(td->lasterror);
+ if(td->lasterrormsg){
+ if(runestrlen(msg) == 0)
+ print("%S\n", td->lasterrormsg);
+ else
+ print("%S: %S\n", errorstr(td->lasterror), td->lasterrormsg);
+ }else
+ print("%S\n", errorstr(td->lasterror));
while(getcurrentdfn())
popdfnframe();
goto restart;
diff --git a/operators.c b/operators.c
index 7a7f12d..7e2520c 100644
--- a/operators.c
+++ b/operators.c
@@ -86,7 +86,7 @@ Array *
opKey(Datum *lefto, Array *left, Array *right)
{
if(lefto->tag != FunctionTag)
- throwerror(nil, EType);
+ throwerror(nil, ESyntax);
if(left)
return rundfn(L"↑⍵∘(⍶{⍵⍶⍺⌷⍨⊂⍸⍹≡¨⍵}⍺)¨⊂¨∪⍺", lefto, nil, left, right);
else
@@ -97,7 +97,7 @@ Array *
opSpawn(Datum *lefto, Array *left, Array *right)
{
if(lefto->tag != FunctionTag)
- throwerror(L"Can only spawn functions", EType);
+ throwerror(L"Can only spawn functions", ESyntax);
int id = spawnthread(lefto->func, left, right);
return mkscalarint(id);
}
@@ -108,7 +108,7 @@ opOuterProduct(Datum *lefto, Array *left, Array *right)
if(left == nil)
throwerror(L"f⌾ expected a left argument", ESyntax);
if(lefto->tag != FunctionTag)
- throwerror(nil, EType);
+ throwerror(nil, ESyntax);
int i;
int rank = GetRank(left) + GetRank(right);
@@ -156,9 +156,9 @@ Array *
opReceive(Datum *lefto, Array *left, Array *right)
{
if(lefto->tag != FunctionTag)
- throwerror(nil, EType);
+ throwerror(nil, ESyntax);
if(GetType(right) != AtypeInt)
- throwerror(nil, EType);
+ throwerror(nil, EDomain);
if(GetSize(right) != 1)
throwerror(nil, ELength);
USED(left);
@@ -171,7 +171,7 @@ opPower(Datum *lefto, Datum *righto, Array *left, Array *right)
{
Rune *code = nil;
if(lefto->tag != FunctionTag)
- throwerror(nil, EType);
+ throwerror(nil, ESyntax);
if(righto->tag == FunctionTag){
if(left)
code = L"next←⍺⍶⍵ ⋄ next⍹⍵:⍵ ⋄ ⍺∇next";
@@ -206,7 +206,7 @@ opInnerProduct(Datum *lefto, Datum *righto, Array *left, Array *right)
if(left == nil)
throwerror(L"f.g expected a left argument", ESyntax);
if(lefto->tag != FunctionTag || righto->tag != FunctionTag)
- throwerror(nil, EType);
+ throwerror(nil, ESyntax);
if(GetRank(left) > 0 && GetRank(right) > 0 && left->shape[GetRank(left)-1] != right->shape[0])
throwerror(nil, ELength);
@@ -251,7 +251,7 @@ opAtop(Datum *lefto, Datum *righto, Array *left, Array *right)
if(GetRank(ranks) > 1)
throwerror(nil, ERank);
if(GetType(ranks) != AtypeInt)
- throwerror(nil, EType);
+ throwerror(nil, EDomain);
if(GetSize(ranks) < 1 || GetSize(ranks) > 3)
throwerror(nil, ELength);
int p,q,r;
diff --git a/quadnames.c b/quadnames.c
index d711ebb..bd98b9d 100644
--- a/quadnames.c
+++ b/quadnames.c
@@ -17,11 +17,13 @@ Datum *getdiv(void);
void setdiv(Datum *);
Datum *geta(void);
Datum *getd(void);
+Datum *geten(void);
Datum *getself(void);
Array *runfile(Array *);
-Array *quadthrow1(Array *);
-Array *quadthrow2(Array *, Array *);
+Array *quadem(Array *);
+Array *quadsignal1(Array *);
+Array *quadsignal2(Array *, Array *);
Array *quadinfo(Array *);
Array *quadproto(Array *);
Array *quaducs(Array *);
@@ -39,9 +41,11 @@ QuadnameDef quadnames[] = {
{L"⎕DIV", NameTag, getdiv, setdiv, nil, nil},
{L"⎕A", NameTag, geta, nil, nil, nil},
{L"⎕D", NameTag, getd, nil, nil, nil},
+ {L"⎕EN", NameTag, geten, nil, nil, nil},
{L"⎕SELF", NameTag, getself, nil, nil, nil},
{L"⎕RUN", FunctionTag, nil, nil, runfile, nil},
- {L"⎕THROW", FunctionTag, nil, nil, quadthrow1, quadthrow2},
+ {L"⎕EM", FunctionTag, nil, nil, quadem, nil},
+ {L"⎕SIGNAL", FunctionTag, nil, nil, quadsignal1, quadsignal2},
{L"⎕INFO", FunctionTag, nil, nil, quadinfo, nil},
{L"⎕PROTO", FunctionTag, nil, nil, quadproto, nil},
{L"⎕UCS", FunctionTag, nil, nil, quaducs, nil},
@@ -235,6 +239,16 @@ getd(void)
return d;
}
+/* ⎕EN */
+Datum *
+geten(void)
+{
+ Datum *d = allocdatum(ArrayTag, 0);
+ ThreadData *td = getthreaddata();
+ d->array = mkscalarint(td->lasterror);
+ return d;
+}
+
/* ⎕SELF */
Datum *
getself(void)
@@ -270,12 +284,38 @@ runfile(Array *a)
return mkscalarint(1);
}
-/* ⎕THROW */
+/* ⎕EM */
+Array *
+quadem(Array *codes)
+{
+ if(GetType(codes) != AtypeInt)
+ throwerror(nil, EDomain);
+ Array *res;
+ if(GetSize(codes) == 1){
+ Rune *msg = errorstr(codes->intdata[0]);
+ if(runestrlen(msg) == 0){
+ msg = runesmprint("ERROR NUMBER %lld", codes->intdata[0]);
+ res = mkrunearray(msg);
+ free(msg);
+ }else
+ res = mkrunearray(msg);
+ }else{
+ res = duparrayshape(codes, AtypeArray);
+ for(int i = 0; i < GetSize(codes); i++){
+ Array *code = arrayitem(codes, i);
+ res->arraydata[i] = quadem(code);
+ freearray(code);
+ }
+ }
+ return res;
+}
+
+/* ⎕SIGNAL */
Array *
-quadthrow1(Array *code)
+quadsignal1(Array *code)
{
if(GetType(code) != AtypeInt)
- throwerror(nil, EType);
+ throwerror(nil, EDomain);
if(GetSize(code) != 1)
throwerror(nil, ELength);
throwerror(nil, code->intdata[0]);
@@ -283,10 +323,10 @@ quadthrow1(Array *code)
}
Array *
-quadthrow2(Array *msg, Array *code)
+quadsignal2(Array *msg, Array *code)
{
if(GetType(code) != AtypeInt || GetType(msg) != AtypeRune)
- throwerror(nil, EType);
+ throwerror(nil, EDomain);
if(GetSize(code) != 1)
throwerror(nil, ELength);
if(GetRank(msg) > 1)
@@ -300,7 +340,7 @@ Array *
quadinfo(Array *a)
{
if(GetType(a) != AtypeRune)
- throwerror(nil, EType);
+ throwerror(nil, EDomain);
Rune *code = pparray(a);
Datum *res = evalline(code, nil, 0);
Rune *info;
@@ -349,7 +389,7 @@ quaducs(Array *a)
for(int i = 0; i < GetSize(res); i++)
res->intdata[i] = a->runedata[i];
}else
- throwerror(nil, EType);
+ throwerror(nil, EDomain);
return res;
}
@@ -361,7 +401,7 @@ quaddl(Array *a)
if(GetSize(a) != 1)
throwerror(nil, ELength);
if(GetType(a) != AtypeInt && GetType(a) != AtypeFloat)
- throwerror(nil, EType);
+ throwerror(nil, EDomain);
if(GetType(a) == AtypeInt && a->intdata[0] >= 0)
sleep(a->intdata[0] * 1000);
generated by cgit v1.2.3 (git 2.25.1) at 2025-10-13 08:27:36 +0000