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; }
|
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 {
|
typedef struct FillSlice {
|
||||||
struct Slice;
|
struct Slice;
|
||||||
B* a;
|
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); }
|
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) {
|
B ud_c1(B t, B x) {
|
||||||
usz xu = o2s(x);
|
if (isAtm(x)) {
|
||||||
if (xu<I32_MAX) {
|
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);
|
i32* rp; B r = m_i32arrv(&rp, xu);
|
||||||
for (usz i = 0; i < xu; i++) rp[i] = i;
|
for (usz i = 0; i < xu; i++) rp[i] = i;
|
||||||
return r;
|
return r;
|
||||||
}
|
}
|
||||||
f64* rp; B r = m_f64arrv(&rp, xu);
|
BS2B xgetU = TI(x).getU;
|
||||||
for (usz i = 0; i < xu; i++) rp[i] = i;
|
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;
|
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_c1(B t, B x) { return m_v1( x); }
|
||||||
B pair_c2(B t, B w, B x) { return m_v2(w, x); }
|
B pair_c2(B t, B w, B x) { return m_v2(w, x); }
|
||||||
B ltack_c1(B t, B x) { return 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 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);
|
BI_FNS0(F);
|
||||||
static inline void fns_init() { BI_FNS1(F)
|
static inline void fns_init() { BI_FNS1(F)
|
||||||
ti[t_funBI].print = print_funBI;
|
ti[t_funBI].print = print_funBI;
|
||||||
|
|||||||
17
src/h.h
17
src/h.h
@ -8,8 +8,17 @@
|
|||||||
#include <stdarg.h>
|
#include <stdarg.h>
|
||||||
#include <setjmp.h>
|
#include <setjmp.h>
|
||||||
|
|
||||||
#define i8 int8_t
|
#define rtLen 63
|
||||||
#define u8 uint8_t
|
#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 i16 int16_t
|
||||||
#define u16 uint16_t
|
#define u16 uint16_t
|
||||||
#define i32 int32_t
|
#define i32 int32_t
|
||||||
@ -20,11 +29,13 @@
|
|||||||
#define I32_MAX ((i32)((1LL<<31)-1))
|
#define I32_MAX ((i32)((1LL<<31)-1))
|
||||||
#define I32_MIN ((i32)(-(1LL<<31)))
|
#define I32_MIN ((i32)(-(1LL<<31)))
|
||||||
#define CHR_MAX 1114111
|
#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 UD __builtin_unreachable();
|
||||||
#define NOINLINE __attribute__ ((noinline))
|
#define NOINLINE __attribute__ ((noinline))
|
||||||
#define NORETURN __attribute__ ((noreturn))
|
#define NORETURN __attribute__ ((noreturn))
|
||||||
#define AUTO __auto_type
|
#define AUTO __auto_type
|
||||||
|
#define RARE(X) __builtin_expect(X,0)
|
||||||
|
|
||||||
typedef u32 usz;
|
typedef u32 usz;
|
||||||
typedef u8 ur;
|
typedef u8 ur;
|
||||||
|
|||||||
@ -52,7 +52,7 @@ static inline void load_init() {
|
|||||||
bool rtComplete[] = {
|
bool rtComplete[] = {
|
||||||
/* +-×÷⋆√⌊⌈|¬ */ 1,1,1,1,1,0,1,1,1,1,
|
/* +-×÷⋆√⌊⌈|¬ */ 1,1,1,1,1,0,1,1,1,1,
|
||||||
/* ∧∨<>≠=≤≥≡≢ */ 1,1,1,1,1,1,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,0,1,0,0,0,0,
|
||||||
/* ⍷⊔!˙˜˘¨⌜⁼´ */ 0,0,1,1,1,0,1,1,0,1,
|
/* ⍷⊔!˙˜˘¨⌜⁼´ */ 0,0,1,1,1,0,1,1,0,1,
|
||||||
/* ˝`∘○⊸⟜⌾⊘◶⎉ */ 0,1,1,1,1,1,0,1,0,0,
|
/* ˝`∘○⊸⟜⌾⊘◶⎉ */ 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_slash = rtObjGet(rtObjRaw, 32); gc_add(rt_slash);
|
||||||
rt_join = rtObjGet(rtObjRaw, 23); gc_add(rt_join);
|
rt_join = rtObjGet(rtObjRaw, 23); gc_add(rt_join);
|
||||||
rt_gradeUp = rtObjGet(rtObjRaw, 33); gc_add(rt_gradeUp);
|
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++) {
|
for (usz i = 0; i < runtimeLen; i++) {
|
||||||
#ifdef ALL_R1
|
#ifdef ALL_R1
|
||||||
|
|||||||
@ -25,15 +25,7 @@
|
|||||||
// #define RT_PERF // time runtime primitives
|
// #define RT_PERF // time runtime primitives
|
||||||
// #define NO_COMP // don't load the compiler, instead execute src/interp; needed for ./precompiled.bqn
|
// #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 "h.h"
|
||||||
#include "stuff.c"
|
#include "stuff.c"
|
||||||
#include "heap.c"
|
#include "heap.c"
|
||||||
|
|||||||
@ -74,7 +74,7 @@ void BN(free)(Value* x) {
|
|||||||
|
|
||||||
void* BN(allocL)(u8 bucket, u8 type) {
|
void* BN(allocL)(u8 bucket, u8 type) {
|
||||||
EmptyValue* x = buckets[bucket];
|
EmptyValue* x = buckets[bucket];
|
||||||
if (x==NULL) x = BN(makeEmpty)(bucket);
|
if (RARE(x==NULL)) x = BN(makeEmpty)(bucket);
|
||||||
else buckets[bucket] = x->next;
|
else buckets[bucket] = x->next;
|
||||||
#ifdef USE_VALGRIND
|
#ifdef USE_VALGRIND
|
||||||
VALGRIND_MAKE_MEM_UNDEFINED(x, BSZ(bucket));
|
VALGRIND_MAKE_MEM_UNDEFINED(x, BSZ(bucket));
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user