native monadic ↕
This commit is contained in:
parent
62dbedc9b8
commit
0a69c1e457
@ -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;
|
||||
|
||||
64
src/fns.c
64
src/fns.c
@ -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
17
src/h.h
@ -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;
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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"
|
||||
|
||||
@ -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));
|
||||
|
||||
Loading…
Reference in New Issue
Block a user