diff --git a/src/builtins.h b/src/builtins.h index d063e031..4c2d9400 100644 --- a/src/builtins.h +++ b/src/builtins.h @@ -21,7 +21,8 @@ /*md1.c*/A(tbl,"⌜") A(each,"¨") A(fold,"´") A(scan,"`") A(const,"˙") A(swap,"˜") A(cell,"˘") A(insert,"˝") \ /*inverse.c*/A(undo,"⁼") \ /* everything before the definition of •_timed is defined to be pure, and everything after is not */ \ - /*md1.c*/A(timed,"•_timed") + /*md1.c*/A(timed,"•_timed") \ + /*bit.c*/M(bitcast,"•bit._cast") #define FOR_PM2(A,M,D) \ /*md2.c*/A(val,"⊘") A(repeat,"⍟") A(rank,"⎉") A(depth,"⚇") A(fillBy,"•_fillBy_") A(catch,"⎊") \ @@ -84,4 +85,4 @@ FOR_PFN(F,F,F) FOR_PM1(F,F,F) FOR_PM2(F,F,F) #undef F -rt_invFnReg, rt_invFnSwap; \ No newline at end of file +rt_invFnReg, rt_invFnSwap; diff --git a/src/builtins/sysfn.c b/src/builtins/sysfn.c index 6c778e29..198e48f4 100644 --- a/src/builtins/sysfn.c +++ b/src/builtins/sysfn.c @@ -856,6 +856,110 @@ B sh_c1(B t, B x) { return sh_c2(t, bi_N, x); } +typedef struct CastType { usz s; bool c; } CastType; +static bool isCharType(u8 t) { + return t==t_c8arr || t==t_c16arr || t==t_c32arr + || t==t_c8slice || t==t_c16slice || t==t_c32slice; +} +static CastType getCastType(B e, B v) { + usz s; bool c; + if (isNum(e)) { + s = o2s(e); + c = q_N(v) ? 0 : isCharType(v(v)->type); + } else { + if (!isArr(e) || rnk(e)!=1 || a(e)->ia!=2) thrM("•bit._cast: 𝕗 elements must be numbers or two-element lists"); + SGetU(e); + s = o2s(GetU(e,0)); + u32 t = o2c(GetU(e,1)); + c = t=='c'; + if (t=='n'); // generic number + else if (c ) { if (s<8||s>32) thrM("•bit._cast: unsupported character width"); } + else if (t=='i') { if (s<8||s>32) thrM("•bit._cast: unsupported integer width"); } + else if (t=='u') { if ( s>32) thrM("•bit._cast: unsupported integer width"); } + else if (t=='f') { if (s!=64) thrM("•bit._cast: type f only supports width 64"); } + else thrM("•bit._cast: type descriptor in 𝕗 must be one of \"iufnc\""); + } + return (CastType) { s, c }; +} +static B convert(CastType t, B x) { + switch (t.s) { + case 1: return taga(toBitArr(x)); + case 8: return t.c ? toC8Any (x) : toI8Any (x); + case 16: return t.c ? toC16Any(x) : toI16Any(x); + case 32: return t.c ? toC32Any(x) : toI32Any(x); + case 64: return toF64Any(x); + default: thrM("•bit._cast: unsupported input width"); + } +} +static TyArr* copy(CastType t, B x) { + switch (t.s) { + case 1: return cpyBitArr(x); + case 8: return t.c ? cpyC8Arr (x) : cpyI8Arr (x); + case 16: return t.c ? cpyC16Arr(x) : cpyI16Arr(x); + case 32: return t.c ? cpyC32Arr(x) : cpyI32Arr(x); + case 64: return cpyF64Arr(x); + default: thrM("•bit._cast: unsupported input width"); + } +} +static u8 typeOfCast(CastType t) { + switch (t.s) { + case 1: return t_bitarr; + case 8: return t.c ? t_c8arr : t_i8arr ; + case 16: return t.c ? t_c16arr : t_i16arr; + case 32: return t.c ? t_c32arr : t_i32arr; + case 64: return t_f64arr; + default: thrM("•bit._cast: unsupported result width"); + } +} +B bitcast_c1(Md1D* d, B x) { B f = d->f; + if (!isArr(f) || rnk(f)!=1 || a(f)->ia!=2) thrM("•bit._cast: 𝕗 must be a 2-element list (from‿to)"); + SGetU(f); + CastType xt = getCastType(GetU(f,0), x); + CastType zt = getCastType(GetU(f,1), bi_N); + ur xr; + if (!isArr(x) || (xr=rnk(x))<1) thrM("•bit._cast: 𝕩 must have rank at least 1"); + usz* sh = a(x)->sh; + usz s=xt.s*sh[xr-1], zl=s/zt.s; + if (zl*zt.s != s) thrM("•bit._cast: incompatible lengths"); + // Convert to input type + B r = convert(xt, x); + u8 rt = typeOfCast(zt); + if (rt==t_bitarr && (v(r)->refc!=1 || IS_SLICE(v(r)->type))) { + r = taga(copy(xt, r)); + } else if (v(r)->refc!=1) { + r = taga(TI(r,slice)(r, 0, a(r)->ia)); + sprnk(v(r),xr); + } + // Cast to output type + v(r)->type = IS_SLICE(v(r)->type) ? TO_SLICE(rt) : rt; + // Adjust shape + if (xr<=1) { + Arr* a = a(r); + a->ia = zl; + a->sh = &a->ia; + } else { + if (shObj(x)->refc>1) { + usz* zsh = arr_shAlloc(a(r), xr); + memcpy(zsh, sh, (xr-1)*sizeof(usz)); + sh = zsh; + } + sh[xr-1]=zl; + usz ia=zl; for (usz i=0;iia=ia; + } + return r; +} +static B bitNS; +B getBitNS() { + if (bitNS.u == 0) { + #define F(X) inc(bi_bit##X), + Body* d = m_nnsDesc("cast"); + bitNS = m_nns(d, F(cast)); + #undef F + gc_add(bitNS); + } + return inc(bitNS); +} + B getInternalNS(void); B getMathNS(void); @@ -893,6 +997,7 @@ B sys_c1(B t, B x) { } else if (eqStr(c, U"internal")) cr = getInternalNS(); else if (eqStr(c, U"math")) cr = getMathNS(); + else if (eqStr(c, U"bit")) cr = getBitNS(); else if (eqStr(c, U"type")) cr = incG(bi_type); else if (eqStr(c, U"sh")) cr = incG(bi_sh); else if (eqStr(c, U"decompose")) cr = incG(bi_decp); diff --git a/src/h.h b/src/h.h index 78788b84..72e099d4 100644 --- a/src/h.h +++ b/src/h.h @@ -224,8 +224,9 @@ enum Type { #undef F t_COUNT }; -#define IS_SLICE(T) ((t)>=t_hslice & (t)<=t_f64slice) -#define IS_ARR(T) ((t)>=t_harr & (t)<=t_bitarr) +#define IS_SLICE(T) ((T)>=t_hslice & (T)<=t_f64slice) +#define IS_ARR(T) ((T)>=t_harr & (T)<=t_bitarr) +#define TO_SLICE(T) ((T) + t_hslice - t_harr) // Assumes T!=t_bitarr enum ElType { // a⌈b shall return the type that can store both, if possible el_bit=0, diff --git a/src/load.c b/src/load.c index 9706c69c..843fb55c 100644 --- a/src/load.c +++ b/src/load.c @@ -639,17 +639,17 @@ void base_init() { // very first init function #undef FM #undef FD - #define FA(N,X) bi_##N = m_bm1(N##_c1, N##_c2, pm1_##N); - #define FM(N,X) bi_##N = m_bm1(N##_c1, c2_bad, pm1_##N); - #define FD(N,X) bi_##N = m_bm1(c1_bad, N##_c2, pm1_##N); + #define FA(N,X) bi_##N = m_bm1(N##_c1, N##_c2, pm1_##N); + #define FM(N,X) bi_##N = m_bm1(N##_c1, m1c2_bad, pm1_##N); + #define FD(N,X) bi_##N = m_bm1(m1c1_bad, N##_c2, pm1_##N); FOR_PM1(FA,FM,FD) #undef FA #undef FM #undef FD #define FA(N,X) bi_##N = m_bm2(N##_c1, N##_c2, pm2_##N); - #define FM(N,X) bi_##N = m_bm2(m1c1_bad, N##_c2, pm2_##N); - #define FD(N,X) bi_##N = m_bm2(N##_c1, m1c2_bad, pm2_##N); + #define FM(N,X) bi_##N = m_bm2(m2c1_bad, N##_c2, pm2_##N); + #define FD(N,X) bi_##N = m_bm2(N##_c1, m2c2_bad, pm2_##N); FOR_PM2(FA,FM,FD) #undef FA #undef FM