diff --git a/src/README.md b/src/README.md index 0ce13a81..11e87716 100644 --- a/src/README.md +++ b/src/README.md @@ -6,7 +6,7 @@ Functions starting with `m_` allocate a new object. Functions starting with `q_` are queries/predicates, and return a boolean. Functions ending with `R` are either supposed to be called rarely, or the caller expects that a part of it happens rarely. Functions ending with `U` return (or take) a non-owned object (`U` = "unincremented"). -Functions ending with `_c1` are monadic implementations, `_c2` are dyadic (for both modifiers and functions). +Functions ending with `_c1` are monadic implementations, `_c2` are dyadic (see [builtin implementations](#builtin-implementations)) Variables starting with `bi_` are builtins (primitives or special values). Which arguments are consumed usually is described in a comment after the function or its prototype. Otherwise, check the source. @@ -129,6 +129,27 @@ Call a BQN function with `c1(f, x)` or `c2(f, w, x)`. A specific builtin can be Calling a modifier involves deriving it with `m1_d`/`m2_d`, using a regular `c1`/`c2`, and managing the refcounts of everything while at that. +## Builtin implementations + +The list of builtin functions is specified in the initial macros of `src/utils/builtins.h`, where `A`/`M`/`D` are used for ambivalent/monadic/dyadic. Once added, `bi_yourName` will be available, and the required of the following functions must be defined somewhere in the source: + +```C +// functions: +B yourName_c1(B t, B x); +B yourName_c2(B t, B w, B x); +// 1-modifiers: +B yourName_c1(Md1D* d, B x); +B yourName_c2(Md1D* d, B w, B x); +// 2-modifiers: +B yourName_c1(Md2D* d, B x); +B yourName_c2(Md2D* d, B w, B x); +``` + +For functions, in most cases, the `t` parameter (representing `𝕊`/"this") is unused (it _must_ be ignored for functions managed by `builtins.h`), but can be used for objects from `nfns.h` to store state with a function. + +For modifiers, the `d` parameter stores the operands and the modifier itself. Use `d->f` for `𝔽`, `d->g` for `𝔾`, `d->m1` for `_𝕣`, `d->m2` for `_𝕣_`, and `tag(d,FUN_TAG)` for `𝕊`. + + ## Arrays If you know that `x` is an array (e.g. by testing `isArr(x)` beforehand), `a(x)->ia` will give you the product of the shape, `rnk(x)` will give you the rank, and `a(x)->sh` will give you a `usz*` to the full shape. @@ -203,6 +224,7 @@ if (TI(x,elType)==el_f64) f64* xp = f64any_ptr(x); // ↑ if (v(x)->type==t_harr) B* xp = harr_ptr(x); if (v(x)->type==t_harr || v(x)->type==t_hslice) B* xp = hany_ptr(x); // note that elType==el_B doesn't imply hany_ptr is safe! if (v(x)->type==t_fillarr) B* xp = fillarr_ptr(x); +B* xp = arr_bptr(x); // will return NULL if the array isn't backed by contiguous B*-s ``` ## Errors diff --git a/src/builtins/arithm.c b/src/builtins/arithm.c index bac1ca43..d6c364fd 100644 --- a/src/builtins/arithm.c +++ b/src/builtins/arithm.c @@ -65,7 +65,7 @@ B ne_c1(B t, B x) { B r = m_f64(isArr(x)&&rnk(x)? *a(x)->sh : 1); dec(x); return static B mathNS; B getMathNS() { if (mathNS.u == 0) { - #define F(X,N) m_nfn(registerNFn(m_str32(U"•math." N), X##_c1, c2_invalid),m_f64(0)), + #define F(X,N) m_nfn(registerNFn(m_str32(U"•math." N), X##_c1, c2_bad),m_f64(0)), B fn = bqn_exec(m_str32(U"{⟨ Sin, Cos, Tan, Asin, Acos, Atan ⟩⇐𝕩}"), emptyCVec(), emptySVec()); B arg = m_caB(6, (B[]){F(sin,U"Sin")F(cos,U"Cos")F(tan,U"Tan")F(asin,U"Asin")F(acos,U"Acos")F(atan,U"Atan")}); #undef F diff --git a/src/builtins/md1.c b/src/builtins/md1.c index 195a1837..de0e7f82 100644 --- a/src/builtins/md1.c +++ b/src/builtins/md1.c @@ -35,12 +35,12 @@ static B homFil2(B f, B r, B wf, B xf) { return r; } -B tbl_c1(B d, B x) { B f = c(Md1D,d)->f; +B tbl_c1(Md1D* d, B x) { B f = d->f; if (!EACH_FILLS) return eachm(f, x); B xf = getFillQ(x); return homFil1(f, eachm(f, x), xf); } -B tbl_c2(B d, B w, B x) { B f = c(Md1D,d)->f; +B tbl_c2(Md1D* d, B w, B x) { B f = d->f; B wf, xf; if (EACH_FILLS) wf = getFillQ(w); if (EACH_FILLS) xf = getFillQ(x); @@ -73,12 +73,12 @@ B tbl_c2(B d, B w, B x) { B f = c(Md1D,d)->f; return r.b; } -B each_c1(B d, B x) { B f = c(Md1D,d)->f; +B each_c1(Md1D* d, B x) { B f = d->f; if (!EACH_FILLS) return eachm(f, x); B xf = getFillQ(x); return homFil1(f, eachm(f, x), xf); } -B each_c2(B d, B w, B x) { B f = c(Md1D,d)->f; +B each_c2(Md1D* d, B w, B x) { B f = d->f; if (!EACH_FILLS) return eachd(f, w, x); B wf = getFillQ(w); B xf = getFillQ(x); @@ -86,7 +86,7 @@ B each_c2(B d, B w, B x) { B f = c(Md1D,d)->f; } -B scan_c1(B d, B x) { B f = c(Md1D,d)->f; +B scan_c1(Md1D* d, B x) { B f = d->f; if (isAtm(x) || rnk(x)==0) thrM("`: Argument cannot have rank 0"); ur xr = rnk(x); usz ia = a(x)->ia; @@ -141,7 +141,7 @@ B scan_c1(B d, B x) { B f = c(Md1D,d)->f; } return withFill(reuse? x : harr_fcd(r, x), xf); } -B scan_c2(B d, B w, B x) { B f = c(Md1D,d)->f; +B scan_c2(Md1D* d, B w, B x) { B f = d->f; if (isAtm(x) || rnk(x)==0) thrM("`: 𝕩 cannot have rank 0"); ur xr = rnk(x); usz* xsh = a(x)->sh; usz ia = a(x)->ia; B wf = getFillQ(w); @@ -202,7 +202,7 @@ B scan_c2(B d, B w, B x) { B f = c(Md1D,d)->f; return withFill(reuse? x : harr_fcd(r, x), wf); } -B fold_c1(B d, B x) { B f = c(Md1D,d)->f; +B fold_c1(Md1D* d, B x) { B f = d->f; if (isAtm(x) || rnk(x)!=1) thrF("´: Argument must be a list (%H ≡ ≢𝕩)", x); usz ia = a(x)->ia; if (TI(x,elType)==el_i32 && isFun(f) && v(f)->flags) { @@ -268,7 +268,7 @@ B fold_c1(B d, B x) { B f = c(Md1D,d)->f; dec(x); return c; } -B fold_c2(B d, B w, B x) { B f = c(Md1D,d)->f; +B fold_c2(Md1D* d, B w, B x) { B f = d->f; if (isAtm(x) || rnk(x)!=1) thrF("´: 𝕩 must be a list (%H ≡ ≢𝕩)", x); usz ia = a(x)->ia; if (q_i32(w) && TI(x,elType)==el_i32 && isFun(f) && v(f)->flags) { @@ -303,14 +303,14 @@ B fold_c2(B d, B w, B x) { B f = c(Md1D,d)->f; return c; } -B const_c1(B d , B x) { dec(x); return inc(c(Md1D,d)->f); } -B const_c2(B d, B w, B x) { dec(w); dec(x); return inc(c(Md1D,d)->f); } +B const_c1(Md1D* d, B x) { dec(x); return inc(d->f); } +B const_c2(Md1D* d, B w, B x) { dec(w); dec(x); return inc(d->f); } -B swap_c1(B d , B x) { return c2(c(Md1D,d)->f, inc(x), x); } -B swap_c2(B d, B w, B x) { return c2(c(Md1D,d)->f, x , w); } +B swap_c1(Md1D* d, B x) { return c2(d->f, inc(x), x); } +B swap_c2(Md1D* d, B w, B x) { return c2(d->f, x , w); } -B timed_c2(B d, B w, B x) { B f = c(Md1D,d)->f; +B timed_c2(Md1D* d, B w, B x) { B f = d->f; i64 am = o2i64(w); for (i64 i = 0; i < am; i++) inc(x); dec(x); @@ -319,7 +319,7 @@ B timed_c2(B d, B w, B x) { B f = c(Md1D,d)->f; u64 ens = nsTime(); return m_f64((ens-sns)/(1e9*am)); } -B timed_c1(B d, B x) { B f = c(Md1D,d)->f; +B timed_c1(Md1D* d, B x) { B f = d->f; u64 sns = nsTime(); dec(c1(f, x)); u64 ens = nsTime(); @@ -328,7 +328,7 @@ B timed_c1(B d, B x) { B f = c(Md1D,d)->f; extern B rt_cell; -B cell_c1(B d, B x) { B f = c(Md1D,d)->f; +B cell_c1(Md1D* d, B x) { B f = d->f; if (isAtm(x) || rnk(x)==0) { B r = c1(f, x); return isAtm(r)? m_atomUnit(r) : r; @@ -355,7 +355,7 @@ B cell_c1(B d, B x) { B f = c(Md1D,d)->f; dec(x); return bqn_merge(harr_fv(r)); } -B cell_c2(B d, B w, B x) { B f = c(Md1D,d)->f; +B cell_c2(Md1D* d, B w, B x) { B f = d->f; if ((isAtm(x) || rnk(x)==0) && (isAtm(w) || rnk(w)==0)) { B r = c2(f, w, x); return isAtm(r)? m_atomUnit(r) : r; diff --git a/src/builtins/md2.c b/src/builtins/md2.c index cc2f5428..d227830e 100644 --- a/src/builtins/md2.c +++ b/src/builtins/md2.c @@ -6,37 +6,37 @@ B md2BI_uc1(B t, B o, B f, B g, B x) { return c(BMd2,t)->uc1(t, o, f, g, B md2BI_ucw(B t, B o, B f, B g, B w, B x) { return c(BMd2,t)->ucw(t, o, f, g, w, x); } -B val_c1(B d, B x) { return c1(c(Md2D,d)->f, x); } -B val_c2(B d, B w, B x) { return c2(c(Md2D,d)->g, w,x); } +B val_c1(Md2D* d, B x) { return c1(d->f, x); } +B val_c2(Md2D* d, B w, B x) { return c2(d->g, w,x); } #if CATCH_ERRORS -B fillBy_c1(B d, B x) { +B fillBy_c1(Md2D* d, B x) { B xf=getFillQ(x); - B r = c1(c(Md2D,d)->f, x); + B r = c1(d->f, x); if(isAtm(r) || noFill(xf)) { dec(xf); return r; } if (CATCH) { dec(catchMessage); return r; } - B fill = asFill(c1(c(Md2D,d)->g, xf)); + B fill = asFill(c1(d->g, xf)); popCatch(); return withFill(r, fill); } -B fillBy_c2(B d, B w, B x) { +B fillBy_c2(Md2D* d, B w, B x) { B wf=getFillQ(w); B xf=getFillQ(x); - B r = c2(c(Md2D,d)->f, w,x); + B r = c2(d->f, w,x); if(isAtm(r) || noFill(xf)) { dec(xf); dec(wf); return r; } if (CATCH) { dec(catchMessage); return r; } if (noFill(wf)) wf = inc(bi_asrt); - B fill = asFill(c2(c(Md2D,d)->g, wf, xf)); + B fill = asFill(c2(d->g, wf, xf)); popCatch(); return withFill(r, fill); } -B catch_c1(B d, B x) { if(CATCH) { dec(catchMessage); return c1(c(Md2D,d)->g, x); } inc(x); B r = c1(c(Md2D,d)->f, x); popCatch(); dec(x); return r; } -B catch_c2(B d, B w, B x) { if(CATCH) { dec(catchMessage); return c2(c(Md2D,d)->g, w,x); } inc(w); inc(x); B r = c2(c(Md2D,d)->f, w,x); popCatch(); dec(w); dec(x); return r; } +B catch_c1(Md2D* d, B x) { if(CATCH) { dec(catchMessage); return c1(d->g, x); } inc(x); B r = c1(d->f, x); popCatch(); dec(x); return r; } +B catch_c2(Md2D* d, B w, B x) { if(CATCH) { dec(catchMessage); return c2(d->g, w,x); } inc(w); inc(x); B r = c2(d->f, w,x); popCatch(); dec(w); dec(x); return r; } #else -B fillBy_c1(B d, B x) { return c1(c(Md2D,d)->f, x); } -B fillBy_c2(B d, B w, B x) { return c2(c(Md2D,d)->f, w,x); } -B catch_c1 (B d, B x) { return c1(c(Md2D,d)->f, x); } -B catch_c2 (B d, B w, B x) { return c2(c(Md2D,d)->f, w,x); } +B fillBy_c1(Md2D* d, B x) { return c1(d->f, x); } +B fillBy_c2(Md2D* d, B w, B x) { return c2(d->f, w,x); } +B catch_c1(Md2D* d, B x) { return c1(d->f, x); } +B catch_c2(Md2D* d, B w, B x) { return c2(d->f, w,x); } #endif extern B rt_undo; @@ -63,8 +63,8 @@ B repeat_replace(B g, B* q) { // doesn't consume } } #define REPEAT_T(CN, END, ...) \ - B g = CN(c(Md2D,d)->g, __VA_ARGS__ inc(x)); \ - B f = c(Md2D,d)->f; \ + B g = CN(d->g, __VA_ARGS__ inc(x)); \ + B f = d->f; \ if (isNum(g)) { \ i64 am = o2i64(g); \ if (am>=0) { \ @@ -94,33 +94,33 @@ B repeat_replace(B g, B* q) { // doesn't consume END; TFREE(all); \ return r; -B repeat_c1(B d, B x) { REPEAT_T(c1,{} ); } -B repeat_c2(B d, B w, B x) { REPEAT_T(c2,dec(w), inc(w), ); } +B repeat_c1(Md2D* d, B x) { REPEAT_T(c1,{} ); } +B repeat_c2(Md2D* d, B w, B x) { REPEAT_T(c2,dec(w), inc(w), ); } #undef REPEAT_T -B before_c1(B d, B x) { return c2(c(Md2D,d)->g, c1iX(c(Md2D,d)->f, x), x); } -B before_c2(B d, B w, B x) { return c2(c(Md2D,d)->g, c1i (c(Md2D,d)->f, w), x); } -B after_c1(B d, B x) { return c2(c(Md2D,d)->f, x, c1iX(c(Md2D,d)->g, x)); } -B after_c2(B d, B w, B x) { return c2(c(Md2D,d)->f, w, c1i (c(Md2D,d)->g, x)); } -B atop_c1(B d, B x) { return c1(c(Md2D,d)->f, c1(c(Md2D,d)->g, x)); } -B atop_c2(B d, B w, B x) { return c1(c(Md2D,d)->f, c2(c(Md2D,d)->g, w, x)); } -B over_c1(B d, B x) { return c1(c(Md2D,d)->f, c1(c(Md2D,d)->g, x)); } -B over_c2(B d, B w, B x) { B xr=c1(c(Md2D,d)->g, x); return c2(c(Md2D,d)->f, c1(c(Md2D,d)->g, w), xr); } +B before_c1(Md2D* d, B x) { return c2(d->g, c1iX(d->f, x), x); } +B before_c2(Md2D* d, B w, B x) { return c2(d->g, c1i (d->f, w), x); } +B after_c1(Md2D* d, B x) { return c2(d->f, x, c1iX(d->g, x)); } +B after_c2(Md2D* d, B w, B x) { return c2(d->f, w, c1i (d->g, x)); } +B atop_c1(Md2D* d, B x) { return c1(d->f, c1(d->g, x)); } +B atop_c2(Md2D* d, B w, B x) { return c1(d->f, c2(d->g, w, x)); } +B over_c1(Md2D* d, B x) { return c1(d->f, c1(d->g, x)); } +B over_c2(Md2D* d, B w, B x) { B xr=c1(d->g, x); return c2(d->f, c1(d->g, w), xr); } -B cond_c1(B d, B x) { B g=c(Md2D,d)->g; +B cond_c1(Md2D* d, B x) { B g=d->g; if (isAtm(g)||rnk(g)!=1) thrM("◶: 𝕘 must have rank 1"); - usz fr = WRAP(o2i64(c1iX(c(Md2D,d)->f, x)), a(g)->ia, thrM("◶: 𝔽 out of bounds of 𝕘")); + usz fr = WRAP(o2i64(c1iX(d->f, x)), a(g)->ia, thrM("◶: 𝔽 out of bounds of 𝕘")); return c1(TI(g,getU)(g, fr), x); } -B cond_c2(B d, B w, B x) { B g=c(Md2D,d)->g; +B cond_c2(Md2D* d, B w, B x) { B g=d->g; if (isAtm(g)||rnk(g)!=1) thrM("◶: 𝕘 must have rank 1"); - usz fr = WRAP(o2i64(c2iWX(c(Md2D,d)->f, w, x)), a(g)->ia, thrM("◶: 𝔽 out of bounds of 𝕘")); + usz fr = WRAP(o2i64(c2iWX(d->f, w, x)), a(g)->ia, thrM("◶: 𝔽 out of bounds of 𝕘")); return c2(TI(g,getU)(g, fr), w, x); } extern B rt_under, bi_before; -B under_c1(B d, B x) { B f=c(Md2D,d)->f; B g=c(Md2D,d)->g; +B under_c1(Md2D* d, B x) { B f=d->f; B g=d->g; if (!isVal(g)) { // ugh idk B fn = m2_d(inc(rt_under), inc(f), inc(g)); B r = c1(fn, x); @@ -129,7 +129,7 @@ B under_c1(B d, B x) { B f=c(Md2D,d)->f; B g=c(Md2D,d)->g; } return TI(g,fn_uc1)(g, f, x); } -B under_c2(B d, B w, B x) { B f=c(Md2D,d)->f; B g=c(Md2D,d)->g; +B under_c2(Md2D* d, B w, B x) { B f=d->f; B g=d->g; if (!isVal(g)) { B fn = m2_d(inc(rt_under), inc(f), inc(g)); B r = c2(fn, w, x); diff --git a/src/builtins/sysfn.c b/src/builtins/sysfn.c index 7670bf0d..0a18e3e1 100644 --- a/src/builtins/sysfn.c +++ b/src/builtins/sysfn.c @@ -404,7 +404,7 @@ static NOINLINE void rand_init() { rand_ns = bqn_exec(m_str32(U"{a←𝕨⋄b←𝕩⋄range⇐0⋄deal⇐0⋄subset⇐0}"), emptyCVec(), emptySVec()); gc_add(rand_ns); rand_rangeName = m_str32(U"range"); gc_add(rand_rangeName); rand_rangeDesc = registerNFn(m_str32(U"(rand).Range"), rand_range_c1, rand_range_c2); rand_dealName = m_str32(U"deal"); gc_add(rand_dealName); rand_dealDesc = registerNFn(m_str32(U"(rand).Deal"), rand_deal_c1, rand_deal_c2); - rand_subsetName = m_str32(U"subset"); gc_add(rand_subsetName); rand_subsetDesc = registerNFn(m_str32(U"(rand).Subset"), c1_invalid, rand_subset_c2); + rand_subsetName = m_str32(U"subset"); gc_add(rand_subsetName); rand_subsetDesc = registerNFn(m_str32(U"(rand).Subset"), c1_bad, rand_subset_c2); B tmp = c2(rand_ns, m_f64(0), m_f64(0)); rand_a = ns_pos(tmp, m_str32(U"a")); rand_b = ns_pos(tmp, m_str32(U"b")); @@ -726,12 +726,12 @@ B sys_c1(B t, B x) { void sysfn_init() { fCharsDesc = registerNFn(m_str32(U"(file).Chars"), fchars_c1, fchars_c2); - fileAtDesc = registerNFn(m_str32(U"(file).At"), fileAt_c1, c2_invalid); + fileAtDesc = registerNFn(m_str32(U"(file).At"), fileAt_c1, c2_bad); fLinesDesc = registerNFn(m_str32(U"(file).Lines"), flines_c1, flines_c2); fBytesDesc = registerNFn(m_str32(U"(file).Bytes"), fbytes_c1, fbytes_c2); importDesc = registerNFn(m_str32(U"•Import"), import_c1, import_c2); reBQNDesc = registerNFn(m_str32(U"(REPL)"), repl_c1, repl_c2); - listDesc = registerNFn(m_str32(U"•file.List"), list_c1, c2_invalid); + listDesc = registerNFn(m_str32(U"•file.List"), list_c1, c2_bad); } void sysfnPost_init() { file_nsGen = bqn_exec(m_str32(U"{⟨path,At,List,Bytes,Chars,Lines⟩⇐𝕩}"), emptyCVec(), emptySVec()); gc_add(file_nsGen); diff --git a/src/core.h b/src/core.h index cf8ad4a9..9fcd97d7 100644 --- a/src/core.h +++ b/src/core.h @@ -75,7 +75,7 @@ typedef struct BFn { BBBB2B ucw; } BFn; typedef struct BMd2 { - struct Md1; + struct Md2; BBBBB2B uc1; BBBBBB2B ucw; } BMd2; diff --git a/src/core/derv.c b/src/core/derv.c index 051cf7bd..75b91ba6 100644 --- a/src/core/derv.c +++ b/src/core/derv.c @@ -18,10 +18,10 @@ static void md2H_print(B x) { printf("(md2H "); p static void fork_print(B x) { printf("(fork ");print(c(Fork,x)->f);printf(" ");print(c(Fork,x)->g );printf(" ");print(c(Fork,x)->h);printf(")"); } static void atop_print(B x) { printf("(atop "); print(c(Atop,x)->g );printf(" ");print(c(Atop,x)->h);printf(")"); } -B md1D_c1(B t, B x) { return c(Md1,c(Md1D, t)->m1)->c1(t, x); } -B md1D_c2(B t, B w, B x) { return c(Md1,c(Md1D, t)->m1)->c2(t, w, x); } -B md2D_c1(B t, B x) { return c(Md2,c(Md2D, t)->m2)->c1(t, x); } -B md2D_c2(B t, B w, B x) { return c(Md2,c(Md2D, t)->m2)->c2(t, w, x); } +B md1D_c1(B t, B x) { Md1D* tc = c(Md1D, t); return c(Md1,tc->m1)->c1(tc, x); } +B md1D_c2(B t, B w, B x) { Md1D* tc = c(Md1D, t); return c(Md1,tc->m1)->c2(tc, w, x); } +B md2D_c1(B t, B x) { Md2D* tc = c(Md2D, t); return c(Md2,tc->m2)->c1(tc, x); } +B md2D_c2(B t, B w, B x) { Md2D* tc = c(Md2D, t); return c(Md2,tc->m2)->c2(tc, w, x); } B tr2D_c1(B t, B x) { return c1(c(Atop,t)->g, c1(c(Atop,t)->h, x)); } B tr2D_c2(B t, B w, B x) { return c1(c(Atop,t)->g, c2(c(Atop,t)->h, w, x)); } B fork_c1(B t, B x) { @@ -44,8 +44,8 @@ B fork_c2(B t, B w, B x) { return c2(c(Fork,t)->g, inc(f), c2(h,w,x)); } } -B md2H_c1(B d, B x) { Md1D* m=c(Md1D,d); Md2H* t=c(Md2H,m->m1); return md2D_c1(m_md2D(t->m2, m->f, t->g), x); } -B md2H_c2(B d, B w, B x) { Md1D* m=c(Md1D,d); Md2H* t=c(Md2H,m->m1); return md2D_c2(m_md2D(t->m2, m->f, t->g), w, x); } +B md2H_c1(Md1D* m, B x) { Md2H* t=c(Md2H,m->m1); return md2D_c1(m_md2D(t->m2, m->f, t->g), x); } +B md2H_c2(Md1D* m, B w, B x) { Md2H* t=c(Md2H,m->m1); return md2D_c2(m_md2D(t->m2, m->f, t->g), w, x); } static B md1D_decompose(B x) { B r=m_v3(m_i32(4),inc(c(Md1D,x)->f),inc(c(Md1D,x)->m1) ); decR(x); return r; } static B md2D_decompose(B x) { B r=m_v4(m_i32(5),inc(c(Md2D,x)->f),inc(c(Md2D,x)->m2), inc(c(Md2D,x)->g)); decR(x); return r; } diff --git a/src/core/derv.h b/src/core/derv.h index 0013a327..0e32638f 100644 --- a/src/core/derv.h +++ b/src/core/derv.h @@ -1,15 +1,15 @@ #pragma once -typedef struct Md1D { // F _md +struct Md1D { // F _md struct Fun; B m1; B f; -} Md1D; -typedef struct Md2D { // F _md_ G +}; +struct Md2D { // F _md_ G struct Fun; B m2; B f, g; -} Md2D; +}; typedef struct Md2H { // _md_ G struct Md1; B m2; @@ -32,8 +32,8 @@ B tr2D_c1(B t, B x); B tr2D_c2(B t, B w, B x); B fork_c1(B t, B x); B fork_c2(B t, B w, B x); -B md2H_c1(B d, B x); -B md2H_c2(B d, B w, B x); +B md2H_c1(Md1D* d, B x); +B md2H_c2(Md1D* d, B w, B x); // consume all args static B m_md1D(B m, B f ) { Md1D* r = mm_alloc(sizeof(Md1D), t_md1D); r->f = f; r->m1 = m; r->c1=md1D_c1; r->c2=md1D_c2; return tag(r,FUN_TAG); } static B m_md2D(B m, B f, B g) { Md2D* r = mm_alloc(sizeof(Md2D), t_md2D); r->f = f; r->m2 = m; r->g = g; r->c1=md2D_c1; r->c2=md2D_c2; return tag(r,FUN_TAG); } diff --git a/src/core/stuff.c b/src/core/stuff.c index adf2a3db..f04b9166 100644 --- a/src/core/stuff.c +++ b/src/core/stuff.c @@ -27,8 +27,12 @@ NOINLINE B c2_rare(B f, B w, B x) { dec(w); dec(x); NOINLINE void value_freeR(Value* x) { value_free(x); } NOINLINE void decA_rare(B x) { dec(x); } void noop_visit(Value* x) { } -NOINLINE B c1_invalid(B f, B x) { thrM("This function can't be called monadically"); } -NOINLINE B c2_invalid(B f, B w, B x) { thrM("This function can't be called dyadically"); } +NOINLINE B c1_bad(B f, B x) { thrM("This function can't be called monadically"); } +NOINLINE B c2_bad(B f, B w, B x) { thrM("This function can't be called dyadically"); } +NOINLINE B m1c1_bad(Md1D* d, B x) { thrM("This 1-modifier can't be called monadically"); } +NOINLINE B m1c2_bad(Md1D* d, B w, B x) { thrM("This 1-modifier can't be called dyadically"); } +NOINLINE B m2c1_bad(Md2D* d, B x) { thrM("This 2-modifier can't be called monadically"); } +NOINLINE B m2c2_bad(Md2D* d, B w, B x) { thrM("This 2-modifier can't be called dyadically"); } extern B rt_under, bi_before; static B rtUnder_c1(B f, B g, B x) { // consumes x B fn = m2_d(inc(rt_under), inc(f), inc(g)); diff --git a/src/core/stuff.h b/src/core/stuff.h index ffeef630..bc2742a5 100644 --- a/src/core/stuff.h +++ b/src/core/stuff.h @@ -180,8 +180,12 @@ static bool atomEqual(B w, B x) { // doesn't consume (not that that matters real // call stuff -NORETURN B c1_invalid(B f, B x); -NORETURN B c2_invalid(B f, B w, B x); +NORETURN B c1_bad(B f, B x); +NORETURN B c2_bad(B f, B w, B x); +NORETURN B m1c1_bad(Md1D* d, B x); +NORETURN B m1c2_bad(Md1D* d, B w, B x); +NORETURN B m2c1_bad(Md2D* d, B x); +NORETURN B m2c2_bad(Md2D* d, B w, B x); static B md_c1(B t, B x) { thrM("Cannot call a modifier"); } static B md_c2(B t, B w, B x) { thrM("Cannot call a modifier"); } static B arr_c1(B t, B x) { return inc(t); } diff --git a/src/h.h b/src/h.h index 9c2efea9..5fc35b49 100644 --- a/src/h.h +++ b/src/h.h @@ -389,6 +389,12 @@ typedef B (* BBB2B)(B, B, B); typedef B (* BBBB2B)(B, B, B, B); typedef B (* BBBBB2B)(B, B, B, B, B); typedef B (*BBBBBB2B)(B, B, B, B, B, B); +typedef struct Md1D Md1D; +typedef struct Md2D Md2D; +typedef B (*M1C1)(Md1D*, B); +typedef B (*M1C2)(Md1D*, B, B); +typedef B (*M2C1)(Md2D*, B); +typedef B (*M2C2)(Md2D*, B, B); #define FOR_TI(F) \ F(V2v, freeF) /* expects refc==0, includes mm_free */ \ @@ -513,13 +519,13 @@ static B c2iWX(B f, B w, B x) { // c2 but implicit inc(w);inc(x) typedef struct Md1 { struct Value; - BB2B c1; // f(md1d{this,f}, x); consumes x - BBB2B c2; // f(md1d{this,f},w,x); consumes w,x + M1C1 c1; // f(md1d{this,f}, x); consumes x + M1C2 c2; // f(md1d{this,f},w,x); consumes w,x } Md1; typedef struct Md2 { struct Value; - BB2B c1; // f(md2d{this,f,g}, x); consumes x - BBB2B c2; // f(md2d{this,f,g},w,x); consumes w,x + M2C1 c1; // f(md2d{this,f,g}, x); consumes x + M2C2 c2; // f(md2d{this,f,g},w,x); consumes w,x } Md2; static B m1_d(B m, B f ); static B m2_d(B m, B f, B g); diff --git a/src/load.c b/src/load.c index 940bed59..cd93bc38 100644 --- a/src/load.c +++ b/src/load.c @@ -42,7 +42,19 @@ u64 mm_heapAlloc; #define FM(N,X) B bi_##N; B N##_c1(B t, B x); #define FD(N,X) B bi_##N; B N##_c2(B t, B w, B x); FOR_PFN(FA,FM,FD) +#undef FA +#undef FM +#undef FD +#define FA(N,X) B bi_##N; B N##_c1(Md1D* d, B x); B N##_c2(Md1D* d, B w, B x); +#define FM(N,X) B bi_##N; B N##_c1(Md1D* d, B x); +#define FD(N,X) B bi_##N; B N##_c2(Md1D* d, B w, B x); FOR_PM1(FA,FM,FD) +#undef FA +#undef FM +#undef FD +#define FA(N,X) B bi_##N; B N##_c1(Md2D*, B x); B N##_c2(Md2D*, B w, B x); +#define FM(N,X) B bi_##N; B N##_c1(Md2D*, B x); +#define FD(N,X) B bi_##N; B N##_c2(Md2D*, B w, B x); FOR_PM2(FA,FM,FD) #undef FA #undef FM @@ -427,25 +439,25 @@ void base_init() { // very first init function TIi(t_funBI,freeF) = TIi(t_md1BI,freeF) = TIi(t_md2BI,freeF) = builtin_free; assert((MD1_TAG>>1) == (MD2_TAG>>1)); // just to be sure it isn't changed incorrectly, `isMd` depends on this - #define FA(N,X) { BFn* f = mm_alloc(sizeof(BFn), t_funBI); f->c2=N##_c2 ; f->c1=N##_c1 ; f->extra=pf_##N; f->ident=bi_N; f->uc1=def_fn_uc1; f->ucw=def_fn_ucw; gc_add(bi_##N = tag(f,FUN_TAG)); } - #define FM(N,X) { BFn* f = mm_alloc(sizeof(BFn), t_funBI); f->c2=c2_invalid; f->c1=N##_c1 ; f->extra=pf_##N; f->ident=bi_N; f->uc1=def_fn_uc1; f->ucw=def_fn_ucw; gc_add(bi_##N = tag(f,FUN_TAG)); } - #define FD(N,X) { BFn* f = mm_alloc(sizeof(BFn), t_funBI); f->c2=N##_c2 ; f->c1=c1_invalid; f->extra=pf_##N; f->ident=bi_N; f->uc1=def_fn_uc1; f->ucw=def_fn_ucw; gc_add(bi_##N = tag(f,FUN_TAG)); } + #define FA(N,X) { BFn* f = mm_alloc(sizeof(BFn), t_funBI); f->c2=N##_c2; f->c1=N##_c1; f->extra=pf_##N; f->ident=bi_N; f->uc1=def_fn_uc1; f->ucw=def_fn_ucw; gc_add(bi_##N = tag(f,FUN_TAG)); } + #define FM(N,X) { BFn* f = mm_alloc(sizeof(BFn), t_funBI); f->c2=c2_bad; f->c1=N##_c1; f->extra=pf_##N; f->ident=bi_N; f->uc1=def_fn_uc1; f->ucw=def_fn_ucw; gc_add(bi_##N = tag(f,FUN_TAG)); } + #define FD(N,X) { BFn* f = mm_alloc(sizeof(BFn), t_funBI); f->c2=N##_c2; f->c1=c1_bad; f->extra=pf_##N; f->ident=bi_N; f->uc1=def_fn_uc1; f->ucw=def_fn_ucw; gc_add(bi_##N = tag(f,FUN_TAG)); } FOR_PFN(FA,FM,FD) #undef FA #undef FM #undef FD - #define FA(N,X) { Md1* m = mm_alloc(sizeof(Md1), t_md1BI); m->c2 = N##_c2 ; m->c1 = N##_c1 ; m->extra=pm1_##N; gc_add(bi_##N = tag(m,MD1_TAG)); } - #define FM(N,X) { Md1* m = mm_alloc(sizeof(Md1), t_md1BI); m->c2 = c2_invalid; m->c1 = N##_c1 ; m->extra=pm1_##N; gc_add(bi_##N = tag(m,MD1_TAG)); } - #define FD(N,X) { Md1* m = mm_alloc(sizeof(Md1), t_md1BI); m->c2 = N##_c2 ; m->c1 = c1_invalid; m->extra=pm1_##N; gc_add(bi_##N = tag(m,MD1_TAG)); } + #define FA(N,X) { Md1* m = mm_alloc(sizeof(Md1), t_md1BI); m->c2 = N##_c2; m->c1 = N##_c1; m->extra=pm1_##N; gc_add(bi_##N = tag(m,MD1_TAG)); } + #define FM(N,X) { Md1* m = mm_alloc(sizeof(Md1), t_md1BI); m->c2 = c2_bad; m->c1 = N##_c1; m->extra=pm1_##N; gc_add(bi_##N = tag(m,MD1_TAG)); } + #define FD(N,X) { Md1* m = mm_alloc(sizeof(Md1), t_md1BI); m->c2 = N##_c2; m->c1 = c1_bad; m->extra=pm1_##N; gc_add(bi_##N = tag(m,MD1_TAG)); } FOR_PM1(FA,FM,FD) #undef FA #undef FM #undef FD - #define FA(N,X) { BMd2* m = mm_alloc(sizeof(BMd2), t_md2BI); m->c2 = N##_c2 ; m->c1 = N##_c1; m->extra=pm2_##N; m->uc1=def_m2_uc1; m->ucw=def_m2_ucw; gc_add(bi_##N = tag(m,MD2_TAG)); } - #define FM(N,X) { BMd2* m = mm_alloc(sizeof(BMd2), t_md2BI); m->c2 = N##_c2 ; m->c1 = c1_invalid; m->extra=pm2_##N; m->uc1=def_m2_uc1; m->ucw=def_m2_ucw; gc_add(bi_##N = tag(m,MD2_TAG)); } - #define FD(N,X) { BMd2* m = mm_alloc(sizeof(BMd2), t_md2BI); m->c2 = c2_invalid; m->c1 = N##_c1; m->extra=pm2_##N; m->uc1=def_m2_uc1; m->ucw=def_m2_ucw; gc_add(bi_##N = tag(m,MD2_TAG)); } + #define FA(N,X) { BMd2* m = mm_alloc(sizeof(BMd2), t_md2BI); m->c2 = N##_c2 ; m->c1 = N##_c1; m->extra=pm2_##N; m->uc1=def_m2_uc1; m->ucw=def_m2_ucw; gc_add(bi_##N = tag(m,MD2_TAG)); } + #define FM(N,X) { BMd2* m = mm_alloc(sizeof(BMd2), t_md2BI); m->c2 = N##_c2 ; m->c1 = m1c1_bad; m->extra=pm2_##N; m->uc1=def_m2_uc1; m->ucw=def_m2_ucw; gc_add(bi_##N = tag(m,MD2_TAG)); } + #define FD(N,X) { BMd2* m = mm_alloc(sizeof(BMd2), t_md2BI); m->c2 = m1c2_bad; m->c1 = N##_c1; m->extra=pm2_##N; m->uc1=def_m2_uc1; m->ucw=def_m2_ucw; gc_add(bi_##N = tag(m,MD2_TAG)); } FOR_PM2(FA,FM,FD) #undef FA #undef FM diff --git a/src/vm.c b/src/vm.c index 19f60183..dee64227 100644 --- a/src/vm.c +++ b/src/vm.c @@ -795,12 +795,12 @@ FORCE_INLINE B execBlock(Block* block, Body* body, Scope* psc, i32 ga, B* svar) return r; } -B funBl_c1(B t, B x) { FunBlock* b=c(FunBlock, t ); ptr_inc(b); return execBlock(b->bl, b->bl->bodies[0], b->sc, 3, (B[]){t, x, bi_N }); } -B funBl_c2(B t, B w, B x) { FunBlock* b=c(FunBlock, t ); ptr_inc(b); return execBlock(b->bl, b->bl->dyBody, b->sc, 3, (B[]){t, x, w }); } -B md1Bl_c1(B D, B x) { Md1D* d=c(Md1D,D); Md1Block* b=c(Md1Block, d->m1); ptr_inc(d); return execBlock(b->bl, b->bl->bodies[0], b->sc, 5, (B[]){D, x, bi_N, inc(d->m1), inc(d->f) }); } -B md1Bl_c2(B D, B w, B x) { Md1D* d=c(Md1D,D); Md1Block* b=c(Md1Block, d->m1); ptr_inc(d); return execBlock(b->bl, b->bl->dyBody, b->sc, 5, (B[]){D, x, w , inc(d->m1), inc(d->f) }); } -B md2Bl_c1(B D, B x) { Md2D* d=c(Md2D,D); Md2Block* b=c(Md2Block, d->m2); ptr_inc(d); return execBlock(b->bl, b->bl->bodies[0], b->sc, 6, (B[]){D, x, bi_N, inc(d->m2), inc(d->f), inc(d->g)}); } -B md2Bl_c2(B D, B w, B x) { Md2D* d=c(Md2D,D); Md2Block* b=c(Md2Block, d->m2); ptr_inc(d); return execBlock(b->bl, b->bl->dyBody, b->sc, 6, (B[]){D, x, w , inc(d->m2), inc(d->f), inc(d->g)}); } +B funBl_c1(B t, B x) { FunBlock* b=c(FunBlock, t ); ptr_inc(b); return execBlock(b->bl, b->bl->bodies[0], b->sc, 3, (B[]){t, x, bi_N }); } +B funBl_c2(B t, B w, B x) { FunBlock* b=c(FunBlock, t ); ptr_inc(b); return execBlock(b->bl, b->bl->dyBody, b->sc, 3, (B[]){t, x, w }); } +B md1Bl_c1(Md1D* d, B x) { Md1Block* b=c(Md1Block, d->m1); ptr_inc(d); return execBlock(b->bl, b->bl->bodies[0], b->sc, 5, (B[]){tag(d,FUN_TAG), x, bi_N, inc(d->m1), inc(d->f) }); } +B md1Bl_c2(Md1D* d, B w, B x) { Md1Block* b=c(Md1Block, d->m1); ptr_inc(d); return execBlock(b->bl, b->bl->dyBody, b->sc, 5, (B[]){tag(d,FUN_TAG), x, w , inc(d->m1), inc(d->f) }); } +B md2Bl_c1(Md2D* d, B x) { Md2Block* b=c(Md2Block, d->m2); ptr_inc(d); return execBlock(b->bl, b->bl->bodies[0], b->sc, 6, (B[]){tag(d,FUN_TAG), x, bi_N, inc(d->m2), inc(d->f), inc(d->g)}); } +B md2Bl_c2(Md2D* d, B w, B x) { Md2Block* b=c(Md2Block, d->m2); ptr_inc(d); return execBlock(b->bl, b->bl->dyBody, b->sc, 6, (B[]){tag(d,FUN_TAG), x, w , inc(d->m2), inc(d->f), inc(d->g)}); } B m_funBlock(Block* bl, Scope* psc) { // doesn't consume anything if (bl->imm) return execBlock(bl, bl->bodies[0], psc, 0, NULL); FunBlock* r = mm_alloc(sizeof(FunBlock), t_fun_block);