native monadic ↕

This commit is contained in:
dzaima 2021-05-13 21:20:10 +03:00
parent 62dbedc9b8
commit 0a69c1e457
6 changed files with 82 additions and 19 deletions

View File

@ -51,6 +51,13 @@ B getFillE(B x) { // errors if there's no fill
}
bool noFill(B x) { return x.u == bi_noFill.u; }
B m_fillarrp(usz ia) {
return m_arr(fsizeof(FillArr,a,B,ia), t_fillarr);
}
void fillarr_setFill(B x, B fill) { // consumes fill
c(FillArr, x)->fill = fill;
}
typedef struct FillSlice {
struct Slice;
B* a;

View File

@ -9,19 +9,71 @@ void print_funBI(B x) { printf("%s", format_pf(c(Fun,x)->extra)); }
B funBI_identity(B x) { return inc(c(BFn,x)->ident); }
void ud_rec(B** p, usz d, usz r, usz* pos, usz* sh) {
if (d==r) {
i32* rp;
*(*p)++ = m_i32arrv(&rp, r);
memcpy(rp, pos, 4*r);
} else {
usz c = sh[d];
for (usz i = 0; i < c; i++) {
pos[d] = i;
ud_rec(p, d+1, r, pos, sh);
}
}
}
B ud_c1(B t, B x) {
usz xu = o2s(x);
if (xu<I32_MAX) {
if (isAtm(x)) {
usz xu = o2s(x);
if (RARE(xu>=I32_MAX)) {
f64* rp; B r = m_f64arrv(&rp, xu);
for (usz i = 0; i < xu; i++) rp[i] = i;
return r;
}
if (xu==0) { B r = bi_emptyIVec; ptr_inc(v(r)); return r; }
i32* rp; B r = m_i32arrv(&rp, xu);
for (usz i = 0; i < xu; i++) rp[i] = i;
return r;
}
f64* rp; B r = m_f64arrv(&rp, xu);
for (usz i = 0; i < xu; i++) rp[i] = i;
BS2B xgetU = TI(x).getU;
usz xia = a(x)->ia;
if (rnk(x)!=1) thrM("↕: Argument must be a vector");
if (xia>UR_MAX) thrM("↕: Result rank too large");
usz sh[xia];
usz ria = 1;
for (usz i = 0; i < xia; i++) {
usz c = o2s(xgetU(x, i));
if (c > I32_MAX) thrM("↕: Result too large");
sh[i] = c;
if (c*(u64)ria >= U32_MAX) thrM("↕: Result too large");
ria*= c;
}
dec(x);
B r = m_fillarrp(ria);
fillarr_setFill(r, m_f64(0));
B* rp = fillarr_ptr(r);
for (usz i = 0; i < ria; i++) rp[i] = m_f64(0); // don't break if allocation errors
usz* rsh = arr_shAllocI(r, ria, xia);
if (rsh) memcpy(rsh, sh, sizeof(usz)*xia);
usz pos[xia]; B* crp = rp;
ud_rec(&crp, 0, xia, pos, sh);
if (ria) fillarr_setFill(r, inc(rp[0]));
else {
i32* fp;
fillarr_setFill(r, m_i32arrv(&fp, xia));
for (usz i = 0; i < xia; i++) fp[i] = 0;
}
return r;
}
B rt_ud;
B ud_c2(B t, B w, B x) {
return c2(rt_ud, w, x);
}
B pair_c1(B t, B x) { return m_v1( x); }
B pair_c2(B t, B w, B x) { return m_v2(w, x); }
B ltack_c1(B t, B x) { return x; }
@ -118,7 +170,7 @@ B fne_c2(B t, B w, B x) {
#define BI_FNS1(F) F(BI_A,BI_M,BI_D)
#define F(A,M,D) M(ud) A(fne) A(feq) A(ltack) A(rtack) M(fmtF) M(fmtN)
#define F(A,M,D) A(ud) A(fne) A(feq) A(ltack) A(rtack) M(fmtF) M(fmtN)
BI_FNS0(F);
static inline void fns_init() { BI_FNS1(F)
ti[t_funBI].print = print_funBI;

17
src/h.h
View File

@ -8,8 +8,17 @@
#include <stdarg.h>
#include <setjmp.h>
#define i8 int8_t
#define u8 uint8_t
#define rtLen 63
#ifdef CATCH_ERRORS
#define PROPER_FILLS (EACH_FILLS&SFNS_FILLS)
#else
#undef EACH_FILLS
#define EACH_FILLS false
#define PROPER_FILLS false
#endif
#define i8 int8_t
#define u8 uint8_t
#define i16 int16_t
#define u16 uint16_t
#define i32 int32_t
@ -20,11 +29,13 @@
#define I32_MAX ((i32)((1LL<<31)-1))
#define I32_MIN ((i32)(-(1LL<<31)))
#define CHR_MAX 1114111
#define U16_MAX ((u16)-1)
#define U16_MAX ((u16)~(u16)0)
#define U32_MAX ((u32)~(u32)0)
#define UD __builtin_unreachable();
#define NOINLINE __attribute__ ((noinline))
#define NORETURN __attribute__ ((noreturn))
#define AUTO __auto_type
#define RARE(X) __builtin_expect(X,0)
typedef u32 usz;
typedef u8 ur;

View File

@ -52,7 +52,7 @@ static inline void load_init() {
bool rtComplete[] = {
/* +-×÷⋆√⌊⌈|¬ */ 1,1,1,1,1,0,1,1,1,1,
/* ∧∨<>≠=≤≥≡≢ */ 1,1,1,1,1,1,1,1,1,1,
/* ⊣⊢⥊∾≍↑↓↕«» */ 1,1,0,1,1,0,0,0,1,1,
/* ⊣⊢⥊∾≍↑↓↕«» */ 1,1,0,1,1,0,0,1,1,1,
/* ⌽⍉/⍋⍒⊏⊑⊐⊒∊ */ 0,0,1,1,0,1,0,0,0,0,
/* ⍷⊔!˙˜˘¨⌜⁼´ */ 0,0,1,1,1,0,1,1,0,1,
/* ˝`∘○⊸⟜⌾⊘◶⎉ */ 0,1,1,1,1,1,0,1,0,0,
@ -99,6 +99,7 @@ static inline void load_init() {
rt_slash = rtObjGet(rtObjRaw, 32); gc_add(rt_slash);
rt_join = rtObjGet(rtObjRaw, 23); gc_add(rt_join);
rt_gradeUp = rtObjGet(rtObjRaw, 33); gc_add(rt_gradeUp);
rt_ud = rtObjGet(rtObjRaw, 27); gc_add(rt_ud);
for (usz i = 0; i < runtimeLen; i++) {
#ifdef ALL_R1

View File

@ -25,15 +25,7 @@
// #define RT_PERF // time runtime primitives
// #define NO_COMP // don't load the compiler, instead execute src/interp; needed for ./precompiled.bqn
#ifdef CATCH_ERRORS
#define PROPER_FILLS (EACH_FILLS&SFNS_FILLS)
#else
#undef EACH_FILLS
#define EACH_FILLS false
#define PROPER_FILLS false
#endif
#define rtLen 63
#include "h.h"
#include "stuff.c"
#include "heap.c"

View File

@ -74,7 +74,7 @@ void BN(free)(Value* x) {
void* BN(allocL)(u8 bucket, u8 type) {
EmptyValue* x = buckets[bucket];
if (x==NULL) x = BN(makeEmpty)(bucket);
if (RARE(x==NULL)) x = BN(makeEmpty)(bucket);
else buckets[bucket] = x->next;
#ifdef USE_VALGRIND
VALGRIND_MAKE_MEM_UNDEFINED(x, BSZ(bucket));