diff options
| -rw-r--r-- | quadnames.c | 99 | ||||
| -rw-r--r-- | 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; +} @@ -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; |