diff --git a/src/fns.c b/src/fns.c new file mode 100644 index 00000000..d35b7f16 --- /dev/null +++ b/src/fns.c @@ -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 (xuflags; + 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 \ No newline at end of file diff --git a/src/h.h b/src/h.h index 86676ade..d22f3968 100644 --- a/src/h.h +++ b/src/h.h @@ -88,13 +88,13 @@ char* format_type(u8 u) { } #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*/ \ - F(ne,"≠") F(le,"≤") F(ge,"≥") F(lt,"<") F(gt,">") F(and,"∧") F(or,"∨") F(not,"¬") F(log,"⋆⁼") /*arith.c*/ \ - F(shape,"⥊") F(pick,"⊑") F(ud,"↕") F(pair,"{𝕨‿𝕩}") F(fne,"≢") F(feq,"≡") F(select,"⊏") /*sfns.c*/ \ - F(slash,"/") F(ltack,"⊣") F(rtack,"⊢") F(fmtF,"⍕") F(fmtN,"⍕") F(join,"∾") F(take,"↑") F(drop,"↓") /*sfns.c*/ \ - F(fork,"(fork)") F(atop,"(atop)") F(md1d,"(derived 1-modifier)") F(md2d,"(derived 2-modifier)") /*derv.c*/ \ - F(type,"•Type") F(decp,"•Decompose") F(primInd,"•PrimInd") F(glyph,"•Glyph") F(fill,"•FillFn") /*sysfn.c*/ \ - F(grLen,"•GroupLen") F(grOrd,"•groupOrd") F(asrt,"!") F(sys,"•getsys") F(internal,"•Internal") F(show,"•Show") F(out,"•Out") /*sysfn.c*/ + /*arith.c*/ F(add,"+") F(sub,"-") F(mul,"×") F(div,"÷") F(pow,"⋆") F(floor,"⌊") F(ceil,"⌈") F(stile,"|") F(eq,"=") \ + /*arith.c*/ F(ne,"≠") F(le,"≤") F(ge,"≥") F(lt,"<") F(gt,">") F(and,"∧") F(or,"∨") F(not,"¬") F(log,"⋆⁼") \ + /*fns.c*/ F(ud,"↕") F(fne,"≢") F(feq,"≡") F(ltack,"⊣") F(rtack,"⊢") F(fmtF,"•FmtF") F(fmtN,"•FmtN") \ + /*sfns.c*/ F(shape,"⥊") F(pick,"⊑") F(pair,"{𝕨‿𝕩}") F(select,"⊏") F(slash,"/") F(join,"∾") F(take,"↑") F(drop,"↓") \ + /*derv.c*/ F(fork,"(fork)") F(atop,"(atop)") F(md1d,"(derived 1-modifier)") F(md2d,"(derived 2-modifier)") \ + /*sysfn.c*/ F(type,"•Type") F(decp,"•Decompose") F(primInd,"•PrimInd") F(glyph,"•Glyph") F(fill,"•FillFn") \ + /*sysfn.c*/ F(grLen,"•GroupLen") F(grOrd,"•groupOrd") F(asrt,"!") F(sys,"•getsys") F(internal,"•Internal") F(show,"•Show") F(out,"•Out") enum PrimFns { #define F(N,X) pf_##N, diff --git a/src/main.c b/src/main.c index 885cc3f8..82ea6e12 100644 --- a/src/main.c +++ b/src/main.c @@ -30,6 +30,7 @@ #include "f64arr.c" #include "utf.c" #include "derv.c" +#include "fns.c" #include "sfns.c" #include "sysfn.c" #include "arith.c" @@ -89,6 +90,7 @@ int main() { c32arr_init(); f64arr_init(); arith_init(); + fns_init(); sfns_init(); md1_init(); md2_init(); diff --git a/src/sfns.c b/src/sfns.c index a5a8be29..d4fb34e3 100644 --- a/src/sfns.c +++ b/src/sfns.c @@ -1,9 +1,5 @@ #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 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 @@ -204,93 +200,6 @@ B pick_c2(B t, B w, B x) { return r; } -B ud_c1(B t, B x) { - usz xu = o2s(x); - if (xuflags; - 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 select_c1(B t, B x) { 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); } -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 slash_c1(B t, B x) { 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 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_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; +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) } #undef ba