Make errors more like dyalog:

* Use the same error numbers
* Rename ⎕THROW to ⎕SIGNAL
* Implement ⎕EN to inspect the last error code
* Implement ⎕EM to get a message from an error code

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);