separate non-structural functions out of sfns.c
This commit is contained in:
parent
c7af11dd2e
commit
6c2ed64ab4
120
src/fns.c
Normal file
120
src/fns.c
Normal file
@ -0,0 +1,120 @@
|
|||||||
|
#include "h.h"
|
||||||
|
|
||||||
|
typedef struct BFn {
|
||||||
|
struct Fun;
|
||||||
|
B ident;
|
||||||
|
} BFn;
|
||||||
|
|
||||||
|
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 ud_c1(B t, B x) {
|
||||||
|
usz xu = o2s(x);
|
||||||
|
if (xu<I32_MAX) {
|
||||||
|
B r = m_i32arrv(xu); i32* rp = i32arr_ptr(r);
|
||||||
|
for (usz i = 0; i < xu; i++) rp[i] = i;
|
||||||
|
return r;
|
||||||
|
}
|
||||||
|
B r = m_f64arrv(xu); f64* rp = f64arr_ptr(r);
|
||||||
|
for (usz i = 0; i < xu; i++) rp[i] = i;
|
||||||
|
return r;
|
||||||
|
}
|
||||||
|
|
||||||
|
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; }
|
||||||
|
B ltack_c2(B t, B w, B x) { dec(x); return w; }
|
||||||
|
B rtack_c1(B t, B x) { return x; }
|
||||||
|
B rtack_c2(B t, B w, B x) { dec(w); return x; }
|
||||||
|
|
||||||
|
B fmtN_c1(B t, B x) {
|
||||||
|
const u64 BL = 100;
|
||||||
|
char buf[BL];
|
||||||
|
if (isF64(x)) snprintf(buf, BL, "%g", x.f);
|
||||||
|
else snprintf(buf, BL, "(fmtN: not given a number?)");
|
||||||
|
return m_str8(strlen(buf), buf);
|
||||||
|
}
|
||||||
|
B fmtF_c1(B t, B x) {
|
||||||
|
if (!isVal(x)) return m_str32(U"(fmtF: not given a function)");
|
||||||
|
u8 fl = v(x)->flags;
|
||||||
|
if (fl==0 || fl>rtLen) return m_str32(U"(fmtF: not given a runtime primitive)");
|
||||||
|
dec(x);
|
||||||
|
return m_c32(U"+-×÷⋆√⌊⌈|¬∧∨<>≠=≤≥≡≢⊣⊢⥊∾≍↑↓↕«»⌽⍉/⍋⍒⊏⊑⊐⊒∊⍷⊔!˙˜˘¨⌜⁼´˝`∘○⊸⟜⌾⊘◶⎉⚇⍟⎊"[fl-1]);
|
||||||
|
}
|
||||||
|
|
||||||
|
i64 isum(B x) { // doesn't consume; assumes is array; may error
|
||||||
|
BS2B xgetU = TI(x).getU;
|
||||||
|
i64 r = 0;
|
||||||
|
usz xia = a(x)->ia;
|
||||||
|
for (usz i = 0; i < xia; i++) r+= o2f(xgetU(x,i)); // TODO error on overflow and non-integers or something
|
||||||
|
return r;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
B fne_c1(B t, B x) {
|
||||||
|
if (isArr(x)) {
|
||||||
|
ur xr = rnk(x);
|
||||||
|
usz* sh = a(x)->sh;
|
||||||
|
for (i32 i = 0; i < xr; i++) if (sh[i]>I32_MAX) {
|
||||||
|
B r = m_f64arrv(xr); f64* rp = f64arr_ptr(r);
|
||||||
|
for (i32 j = 0; j < xr; j++) rp[j] = sh[j];
|
||||||
|
dec(x);
|
||||||
|
return r;
|
||||||
|
}
|
||||||
|
B r = m_i32arrv(xr); i32* rp = i32arr_ptr(r);
|
||||||
|
for (i32 i = 0; i < xr; i++) rp[i] = sh[i];
|
||||||
|
dec(x);
|
||||||
|
return r;
|
||||||
|
} else {
|
||||||
|
dec(x);
|
||||||
|
return m_i32arrv(0);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
u64 depth(B x) { // doesn't consume
|
||||||
|
if (!isArr(x)) return 0;
|
||||||
|
if (TI(x).arrD1) return 1;
|
||||||
|
u64 r = 0;
|
||||||
|
usz ia = a(x)->ia;
|
||||||
|
BS2B xgetU = TI(x).getU;
|
||||||
|
for (usz i = 0; i < ia; i++) {
|
||||||
|
u64 n = depth(xgetU(x,i));
|
||||||
|
if (n>r) r = n;
|
||||||
|
}
|
||||||
|
return r+1;
|
||||||
|
}
|
||||||
|
B feq_c1(B t, B x) {
|
||||||
|
u64 r = depth(x);
|
||||||
|
dec(x);
|
||||||
|
return m_f64(r);
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
B feq_c2(B t, B w, B x) {
|
||||||
|
bool r = equal(w, x);
|
||||||
|
dec(w); dec(x);
|
||||||
|
return m_i32(r);
|
||||||
|
}
|
||||||
|
B fne_c2(B t, B w, B x) {
|
||||||
|
bool r = !equal(w, x);
|
||||||
|
dec(w); dec(x);
|
||||||
|
return m_i32(r);
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
#define ba(N) bi_##N = mm_alloc(sizeof(BFn), t_funBI, ftag(FUN_TAG)); c(Fun,bi_##N)->c2 = N##_c2 ;c(Fun,bi_##N)->c1 = N##_c1 ; c(Fun,bi_##N)->extra=pf_##N; c(BFn,bi_##N)->ident=bi_N; gc_add(bi_##N);
|
||||||
|
#define bd(N) bi_##N = mm_alloc(sizeof(BFn), t_funBI, ftag(FUN_TAG)); c(Fun,bi_##N)->c2 = N##_c2 ;c(Fun,bi_##N)->c1 = c1_invalid; c(Fun,bi_##N)->extra=pf_##N; c(BFn,bi_##N)->ident=bi_N; gc_add(bi_##N);
|
||||||
|
#define bm(N) bi_##N = mm_alloc(sizeof(BFn), t_funBI, ftag(FUN_TAG)); c(Fun,bi_##N)->c2 = c2_invalid;c(Fun,bi_##N)->c1 = N##_c1 ; c(Fun,bi_##N)->extra=pf_##N; c(BFn,bi_##N)->ident=bi_N; gc_add(bi_##N);
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
B bi_ud, bi_fne, bi_feq, bi_ltack, bi_rtack, bi_fmtF, bi_fmtN;
|
||||||
|
static inline void fns_init() { bm(ud) ba(fne) ba(feq) ba(ltack) ba(rtack) bm(fmtF) bm(fmtN)
|
||||||
|
ti[t_funBI].print = print_funBI;
|
||||||
|
ti[t_funBI].identity = funBI_identity;
|
||||||
|
}
|
||||||
|
|
||||||
|
#undef ba
|
||||||
|
#undef bd
|
||||||
|
#undef bm
|
||||||
14
src/h.h
14
src/h.h
@ -88,13 +88,13 @@ char* format_type(u8 u) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
#define FOR_PF(F) F(none, "(unknown fn)") \
|
#define FOR_PF(F) F(none, "(unknown fn)") \
|
||||||
F(add,"+") F(sub,"-") F(mul,"×") F(div,"÷") F(pow,"⋆") F(floor,"⌊") F(ceil,"⌈") F(stile,"|") F(eq,"=") /*arith.c*/ \
|
/*arith.c*/ F(add,"+") F(sub,"-") F(mul,"×") F(div,"÷") F(pow,"⋆") F(floor,"⌊") F(ceil,"⌈") F(stile,"|") F(eq,"=") \
|
||||||
F(ne,"≠") F(le,"≤") F(ge,"≥") F(lt,"<") F(gt,">") F(and,"∧") F(or,"∨") F(not,"¬") F(log,"⋆⁼") /*arith.c*/ \
|
/*arith.c*/ F(ne,"≠") F(le,"≤") F(ge,"≥") F(lt,"<") F(gt,">") F(and,"∧") F(or,"∨") F(not,"¬") F(log,"⋆⁼") \
|
||||||
F(shape,"⥊") F(pick,"⊑") F(ud,"↕") F(pair,"{𝕨‿𝕩}") F(fne,"≢") F(feq,"≡") F(select,"⊏") /*sfns.c*/ \
|
/*fns.c*/ F(ud,"↕") F(fne,"≢") F(feq,"≡") F(ltack,"⊣") F(rtack,"⊢") F(fmtF,"•FmtF") F(fmtN,"•FmtN") \
|
||||||
F(slash,"/") F(ltack,"⊣") F(rtack,"⊢") F(fmtF,"⍕") F(fmtN,"⍕") F(join,"∾") F(take,"↑") F(drop,"↓") /*sfns.c*/ \
|
/*sfns.c*/ F(shape,"⥊") F(pick,"⊑") F(pair,"{𝕨‿𝕩}") F(select,"⊏") F(slash,"/") F(join,"∾") F(take,"↑") F(drop,"↓") \
|
||||||
F(fork,"(fork)") F(atop,"(atop)") F(md1d,"(derived 1-modifier)") F(md2d,"(derived 2-modifier)") /*derv.c*/ \
|
/*derv.c*/ F(fork,"(fork)") F(atop,"(atop)") F(md1d,"(derived 1-modifier)") F(md2d,"(derived 2-modifier)") \
|
||||||
F(type,"•Type") F(decp,"•Decompose") F(primInd,"•PrimInd") F(glyph,"•Glyph") F(fill,"•FillFn") /*sysfn.c*/ \
|
/*sysfn.c*/ F(type,"•Type") F(decp,"•Decompose") F(primInd,"•PrimInd") F(glyph,"•Glyph") F(fill,"•FillFn") \
|
||||||
F(grLen,"•GroupLen") F(grOrd,"•groupOrd") F(asrt,"!") F(sys,"•getsys") F(internal,"•Internal") F(show,"•Show") F(out,"•Out") /*sysfn.c*/
|
/*sysfn.c*/ F(grLen,"•GroupLen") F(grOrd,"•groupOrd") F(asrt,"!") F(sys,"•getsys") F(internal,"•Internal") F(show,"•Show") F(out,"•Out")
|
||||||
|
|
||||||
enum PrimFns {
|
enum PrimFns {
|
||||||
#define F(N,X) pf_##N,
|
#define F(N,X) pf_##N,
|
||||||
|
|||||||
@ -30,6 +30,7 @@
|
|||||||
#include "f64arr.c"
|
#include "f64arr.c"
|
||||||
#include "utf.c"
|
#include "utf.c"
|
||||||
#include "derv.c"
|
#include "derv.c"
|
||||||
|
#include "fns.c"
|
||||||
#include "sfns.c"
|
#include "sfns.c"
|
||||||
#include "sysfn.c"
|
#include "sysfn.c"
|
||||||
#include "arith.c"
|
#include "arith.c"
|
||||||
@ -89,6 +90,7 @@ int main() {
|
|||||||
c32arr_init();
|
c32arr_init();
|
||||||
f64arr_init();
|
f64arr_init();
|
||||||
arith_init();
|
arith_init();
|
||||||
|
fns_init();
|
||||||
sfns_init();
|
sfns_init();
|
||||||
md1_init();
|
md1_init();
|
||||||
md2_init();
|
md2_init();
|
||||||
|
|||||||
107
src/sfns.c
107
src/sfns.c
@ -1,9 +1,5 @@
|
|||||||
#include "h.h"
|
#include "h.h"
|
||||||
|
|
||||||
typedef struct BFn {
|
|
||||||
struct Fun;
|
|
||||||
B ident;
|
|
||||||
} BFn;
|
|
||||||
static inline B mv(B* p, usz n) { B r = p [n]; p [n] = m_f64(0); return r; }
|
static inline B mv(B* p, usz n) { B r = p [n]; p [n] = m_f64(0); return r; }
|
||||||
static inline B hmv(HArr_p p, usz n) { B r = p.a[n]; p.a[n] = m_f64(0); return r; }
|
static inline B hmv(HArr_p p, usz n) { B r = p.a[n]; p.a[n] = m_f64(0); return r; }
|
||||||
B eachd_fn(BBB2B f, B fo, B w, B x) { // consumes w,x; assumes at least one is array
|
B eachd_fn(BBB2B f, B fo, B w, B x) { // consumes w,x; assumes at least one is array
|
||||||
@ -204,93 +200,6 @@ B pick_c2(B t, B w, B x) {
|
|||||||
return r;
|
return r;
|
||||||
}
|
}
|
||||||
|
|
||||||
B ud_c1(B t, B x) {
|
|
||||||
usz xu = o2s(x);
|
|
||||||
if (xu<I32_MAX) {
|
|
||||||
B r = m_i32arrv(xu); i32* rp = i32arr_ptr(r);
|
|
||||||
for (usz i = 0; i < xu; i++) rp[i] = i;
|
|
||||||
return r;
|
|
||||||
}
|
|
||||||
B r = m_f64arrv(xu); f64* rp = f64arr_ptr(r);
|
|
||||||
for (usz i = 0; i < xu; i++) rp[i] = i;
|
|
||||||
return r;
|
|
||||||
}
|
|
||||||
|
|
||||||
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; }
|
|
||||||
B ltack_c2(B t, B w, B x) { dec(x); return w; }
|
|
||||||
B rtack_c1(B t, B x) { return x; }
|
|
||||||
B rtack_c2(B t, B w, B x) { dec(w); return x; }
|
|
||||||
|
|
||||||
B fmtN_c1(B t, B x) {
|
|
||||||
const u64 BL = 100;
|
|
||||||
char buf[BL];
|
|
||||||
if (isF64(x)) snprintf(buf, BL, "%g", x.f);
|
|
||||||
else snprintf(buf, BL, "(fmtN: not given a number?)");
|
|
||||||
return m_str8(strlen(buf), buf);
|
|
||||||
}
|
|
||||||
B fmtF_c1(B t, B x) {
|
|
||||||
if (!isVal(x)) return m_str32(U"(fmtF: not given a function)");
|
|
||||||
u8 fl = v(x)->flags;
|
|
||||||
if (fl==0 || fl>rtLen) return m_str32(U"(fmtF: not given a runtime primitive)");
|
|
||||||
dec(x);
|
|
||||||
return m_c32(U"+-×÷⋆√⌊⌈|¬∧∨<>≠=≤≥≡≢⊣⊢⥊∾≍↑↓↕«»⌽⍉/⍋⍒⊏⊑⊐⊒∊⍷⊔!˙˜˘¨⌜⁼´˝`∘○⊸⟜⌾⊘◶⎉⚇⍟⎊"[fl-1]);
|
|
||||||
}
|
|
||||||
|
|
||||||
B fne_c1(B t, B x) {
|
|
||||||
if (isArr(x)) {
|
|
||||||
ur xr = rnk(x);
|
|
||||||
usz* sh = a(x)->sh;
|
|
||||||
for (i32 i = 0; i < xr; i++) if (sh[i]>I32_MAX) {
|
|
||||||
B r = m_f64arrv(xr); f64* rp = f64arr_ptr(r);
|
|
||||||
for (i32 j = 0; j < xr; j++) rp[j] = sh[j];
|
|
||||||
dec(x);
|
|
||||||
return r;
|
|
||||||
}
|
|
||||||
B r = m_i32arrv(xr); i32* rp = i32arr_ptr(r);
|
|
||||||
for (i32 i = 0; i < xr; i++) rp[i] = sh[i];
|
|
||||||
dec(x);
|
|
||||||
return r;
|
|
||||||
} else {
|
|
||||||
dec(x);
|
|
||||||
return m_i32arrv(0);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
u64 depth(B x) { // doesn't consume
|
|
||||||
if (!isArr(x)) return 0;
|
|
||||||
if (TI(x).arrD1) return 1;
|
|
||||||
u64 r = 0;
|
|
||||||
usz ia = a(x)->ia;
|
|
||||||
BS2B xgetU = TI(x).getU;
|
|
||||||
for (usz i = 0; i < ia; i++) {
|
|
||||||
u64 n = depth(xgetU(x,i));
|
|
||||||
if (n>r) r = n;
|
|
||||||
}
|
|
||||||
return r+1;
|
|
||||||
}
|
|
||||||
B feq_c1(B t, B x) {
|
|
||||||
u64 r = depth(x);
|
|
||||||
dec(x);
|
|
||||||
return m_f64(r);
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
B feq_c2(B t, B w, B x) {
|
|
||||||
bool r = equal(w, x);
|
|
||||||
dec(w); dec(x);
|
|
||||||
return m_i32(r);
|
|
||||||
}
|
|
||||||
B fne_c2(B t, B w, B x) {
|
|
||||||
bool r = !equal(w, x);
|
|
||||||
dec(w); dec(x);
|
|
||||||
return m_i32(r);
|
|
||||||
}
|
|
||||||
|
|
||||||
B funBI_identity(B x) {
|
|
||||||
return inc(c(BFn,x)->ident);
|
|
||||||
}
|
|
||||||
|
|
||||||
B rt_select;
|
B rt_select;
|
||||||
B select_c1(B t, B x) {
|
B select_c1(B t, B x) {
|
||||||
if (!isArr(x)) thrM("⊏: Argument cannot be an atom");
|
if (!isArr(x)) thrM("⊏: Argument cannot be an atom");
|
||||||
@ -359,14 +268,6 @@ B select_c2(B t, B w, B x) {
|
|||||||
return c2(rt_select, w, x);
|
return c2(rt_select, w, x);
|
||||||
}
|
}
|
||||||
|
|
||||||
i64 isum(B x) { // doesn't consume; assumes is array; may error
|
|
||||||
BS2B xgetU = TI(x).getU;
|
|
||||||
i64 r = 0;
|
|
||||||
usz xia = a(x)->ia;
|
|
||||||
for (usz i = 0; i < xia; i++) r+= o2f(xgetU(x,i)); // TODO error on overflow and non-integers or something
|
|
||||||
return r;
|
|
||||||
}
|
|
||||||
|
|
||||||
B rt_slash;
|
B rt_slash;
|
||||||
B slash_c1(B t, B x) {
|
B slash_c1(B t, B x) {
|
||||||
if (!isArr(x)) thrM("/: Argument must be a list");
|
if (!isArr(x)) thrM("/: Argument must be a list");
|
||||||
@ -454,12 +355,8 @@ B join_c2(B t, B w, B x) {
|
|||||||
#define bd(N) bi_##N = mm_alloc(sizeof(BFn), t_funBI, ftag(FUN_TAG)); c(Fun,bi_##N)->c2 = N##_c2 ;c(Fun,bi_##N)->c1 = c1_invalid; c(Fun,bi_##N)->extra=pf_##N; c(BFn,bi_##N)->ident=bi_N; gc_add(bi_##N);
|
#define bd(N) bi_##N = mm_alloc(sizeof(BFn), t_funBI, ftag(FUN_TAG)); c(Fun,bi_##N)->c2 = N##_c2 ;c(Fun,bi_##N)->c1 = c1_invalid; c(Fun,bi_##N)->extra=pf_##N; c(BFn,bi_##N)->ident=bi_N; gc_add(bi_##N);
|
||||||
#define bm(N) bi_##N = mm_alloc(sizeof(BFn), t_funBI, ftag(FUN_TAG)); c(Fun,bi_##N)->c2 = c2_invalid;c(Fun,bi_##N)->c1 = N##_c1 ; c(Fun,bi_##N)->extra=pf_##N; c(BFn,bi_##N)->ident=bi_N; gc_add(bi_##N);
|
#define bm(N) bi_##N = mm_alloc(sizeof(BFn), t_funBI, ftag(FUN_TAG)); c(Fun,bi_##N)->c2 = c2_invalid;c(Fun,bi_##N)->c1 = N##_c1 ; c(Fun,bi_##N)->extra=pf_##N; c(BFn,bi_##N)->ident=bi_N; gc_add(bi_##N);
|
||||||
|
|
||||||
void print_fun_def(B x) { printf("%s", format_pf(c(Fun,x)->extra)); }
|
B bi_shape, bi_pick, bi_pair, bi_select, bi_slash, bi_join, bi_take, bi_drop;
|
||||||
|
static inline void sfns_init() { ba(shape) ba(pick) ba(pair) ba(select) ba(slash) bd(join) bd(take) bd(drop)
|
||||||
B bi_shape, bi_pick, bi_ud, bi_pair, bi_fne, bi_feq, bi_select, bi_slash, bi_ltack, bi_rtack, bi_join, bi_take, bi_drop, bi_fmtF, bi_fmtN;
|
|
||||||
static inline void sfns_init() { ba(shape) ba(pick) bm(ud) ba(pair) ba(fne) ba(feq) ba(select) ba(slash) ba(ltack) ba(rtack) bd(join) bd(take) bd(drop) bm(fmtF) bm(fmtN)
|
|
||||||
ti[t_funBI].print = print_fun_def;
|
|
||||||
ti[t_funBI].identity = funBI_identity;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
#undef ba
|
#undef ba
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user