From 0719e6cf67a4644282f97431024f6a350b45ff46 Mon Sep 17 00:00:00 2001
From: glenda <glenda@cirno>
Date: Sun, 18 Sep 2022 10:02:25 +0000
Subject: =?UTF-8?q?Implement=20=E2=8E=95SERIAL?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 quadnames.c | 99 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 symbol.c    |  5 ++--
 2 files changed, 102 insertions(+), 2 deletions(-)

diff --git a/quadnames.c b/quadnames.c
index 8c7490c..143eef1 100644
--- a/quadnames.c
+++ b/quadnames.c
@@ -33,6 +33,7 @@ Array *quaducs(Array *);
 Array *quaddl(Array *);
 Array *quadthreads1(Array *);
 Array *quadthreads2(Array *, Array *);
+Array *quadserial(Array *, Array *);
 
 static Rune *quadquotebuf = nil;
 static Array *session = nil;
@@ -57,6 +58,7 @@ QuadnameDef quadnames[] = {
 	{L"⎕UCS", FunctionTag, nil, nil, quaducs, nil},
 	{L"⎕DL", FunctionTag, nil, nil, quaddl, nil},
 	{L"⎕THREADS", FunctionTag, nil, nil, quadthreads1, quadthreads2},
+	{L"⎕SERIAL", FunctionTag, nil, nil, nil, quadserial},
 	{nil, 0, nil, nil, nil, nil} /* MUST BE LAST */
 };
 
@@ -490,5 +492,102 @@ quadthreads2(Array *thread, Array *property)
 	return threadproperty(thread->intdata[0], property->intdata[0]);
 }
 
+/* ⎕SERIAL */
 
+Array *
+quadserial(Array *mode, Array *a)
+{
+	if(GetType(mode) != AtypeInt || GetSize(mode) != 1)
+		throwerror(nil, EDomain);
+	int m = mode->intdata[0];
+	if(m != 0 && m != 1)
+		throwerror(L"Left argument of ⎕serial must be 0 or 1", EDomain);
+
+	/* TODO: byte ordering */
+	Array *result;
+	if(m == 0){ /* serialize */
+		Array *header = allocarray(AtypeInt, 1, 2+GetRank(a));
+		header->shape[0] = GetSize(header);
+		header->intdata[0] = GetType(a);
+		header->intdata[1] = GetRank(a);
+		for(int i = 0; i < GetRank(a); i++)
+			header->intdata[2+i] = a->shape[i];
+
+		Array *body;
+		if(GetType(a) == AtypeArray) /* nested */
+			body = rundfn(L"⊃,⌿0⎕SERIAL¨,⍵", nil, nil, nil, a);
+		else{
+			int len = datasizes[GetType(a)] * GetSize(a);
+			body = allocarray(AtypeInt, 1, len);
+			body->shape[0] = len;
+			for(int i = 0; i < len; i++)
+				body->intdata[i] = a->rawdata[i];
+		}
+
+		result = fnCatenateFirst(header, body);
+		freearray(header);
+		freearray(body);
+	}else{ /* un-serialize */
+		if(GetRank(a) != 1 || GetType(a) != AtypeInt)
+			throwerror(nil, EDomain);
+
+		int type = a->intdata[0];
+		int rank = a->intdata[1];
+		vlong size = 1;
+		for(int i = 0; i < rank; i++)
+			size *= a->intdata[i+2];
+
+		if(type == AtypeArray){ /* nested */
+			int skips[512];
+			int depth = 0;
+			Array *starts = allocarray(AtypeInt, 1, GetSize(a));
+			starts->shape[0] = GetSize(starts);
+			for(int i = 0; i < GetSize(starts); i++)
+				starts->intdata[i] = 0;
+			int offset = 2+rank;
+			skips[0] = 0;
+			while(offset < GetSize(a)){
+				if(depth == 0 && skips[0] == 0)
+					starts->intdata[offset] = 1;
+				int type = a->intdata[offset];
+				int rank = a->intdata[offset+1];
+				vlong size = 1;
+				for(int i = 0; i < rank; i++)
+					size *= a->intdata[i+offset+2];
+				offset += 2+rank;
+				if(type == AtypeArray){
+					depth++;
+					skips[depth] = size;
+				}else{
+					if(skips[depth] > 0)
+						skips[depth]--;
+					if(skips[depth] == 0 && depth > 0){
+						depth--;
+						if(skips[depth] > 0)
+							skips[depth]--;
+					}
+					offset += size*datasizes[type];
+				}
+			}
+			Array *parts = rundfn(L"1⎕SERIAL¨(+⍀⍺)⊆⍵", nil, nil, starts, a);
+			Array *shape = allocarray(AtypeInt, 1, rank);
+			shape->shape[0] = rank;
+			for(int i = 0; i < rank; i++)
+				shape->intdata[i] = a->intdata[2+i];
+			result = fnReshape(shape, parts);
+			freearray(parts);
+			freearray(starts);
+		}else{
+			result = allocarray(type, rank, size);
+			for(int i = 0; i < rank; i++)
+				result->shape[i] = a->intdata[i+2];
+
+			int len = datasizes[type] * size;
+			for(int i = 0; i < len; i++)
+				result->rawdata[i] = a->intdata[i+2+rank];
+		}
+	}
+
+	return result;
+} 
 
diff --git a/symbol.c b/symbol.c
index 2f5165b..029ab0c 100644
--- a/symbol.c
+++ b/symbol.c
@@ -148,9 +148,10 @@ pushdfnframe(Rune *code, DfnFrame *scope, Datum *lefto, Datum *righto, Array *le
 		new->left->array = left;
 		incarrayref(left);
 	}else
-		new->left = nil;
+		new->left = nil;	
 	new->right = right;
-	incarrayref(right);
+	if(right)
+		incarrayref(right);
 	new->prev = td->currentdfn;
 	new->chain = scope;
 	new->errorguards = nil;
-- 
cgit v1.2.3