uCBQN/src/h.h
2021-04-26 01:38:34 +03:00

701 lines
22 KiB
C
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

#pragma once
#include <inttypes.h>
#include <stdbool.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <stddef.h>
#include <stdarg.h>
#include <setjmp.h>
#define i8 int8_t
#define u8 uint8_t
#define i16 int16_t
#define u16 uint16_t
#define i32 int32_t
#define u32 uint32_t
#define i64 int64_t
#define u64 uint64_t
#define f64 double
#define I32_MAX ((i32)((1LL<<31)-1))
#define CHR_MAX 1114111
#define U16_MAX ((u16)-1)
#define UD __builtin_unreachable();
#define NOINLINE __attribute__ ((noinline))
#define NORETURN __attribute__ ((noreturn))
#define usz u32
#define ur u8
#define CTR_FOR(F)
#define CTR_DEF(N) u64 N;
#define CTR_PRINT(N) printf(#N ": %lu\n", N);
CTR_FOR(CTR_DEF)
#ifdef DEBUG
#include<assert.h>
#define VALIDATE(x) validate(x)
#define VALIDATEP(x) validateP(x)
#else
#define assert(x) {if (!(x)) __builtin_unreachable();}
#define VALIDATE(x) (x)
#define VALIDATEP(x) (x)
#endif
#define fsizeof(T,F,E,n) (offsetof(T, F) + sizeof(E)*(n)) // type; FAM name; FAM type; amount
#define ftag(x) ((u64)(x) << 48)
#define tag(v, t) b(((u64)(v)) | ftag(t))
// .111111111110000000000000000000000000000000000000000000000000000 infinity
// .111111111111000000000000000000000000000000000000000000000000000 qNaN
// .111111111110nnn................................................ sNaN aka tagged aka not f64, if nnn≠0
// 0111111111110................................................... direct value with no need of refcounting
const u16 C32_TAG = 0b0111111111110001; // 0111111111110001................00000000000ccccccccccccccccccccc char
const u16 TAG_TAG = 0b0111111111110010; // 0111111111110010................nnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn special value (0=nothing, 1=undefined var, 2=bad header; 3=optimized out; 4=error?; 5=no fill)
const u16 VAR_TAG = 0b0111111111110011; // 0111111111110011ddddddddddddddddnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn variable reference
const u16 I32_TAG = 0b0111111111110111; // 0111111111110111................nnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn 32-bit int; unused
const u16 MD1_TAG = 0b1111111111110010; // 1111111111110010ppppppppppppppppppppppppppppppppppppppppppppp000 1-modifier
const u16 MD2_TAG = 0b1111111111110011; // 1111111111110011ppppppppppppppppppppppppppppppppppppppppppppp000 2-modifier
const u16 FUN_TAG = 0b1111111111110100; // 1111111111110100ppppppppppppppppppppppppppppppppppppppppppppp000 function
const u16 NSP_TAG = 0b1111111111110101; // 1111111111110101ppppppppppppppppppppppppppppppppppppppppppppp000 namespace maybe?
const u16 OBJ_TAG = 0b1111111111110110; // 1111111111110110ppppppppppppppppppppppppppppppppppppppppppppp000 custom object (e.g. bigints)
const u16 ARR_TAG = 0b1111111111110111; // 1111111111110111ppppppppppppppppppppppppppppppppppppppppppppp000 array (everything else is an atom)
const u16 VAL_TAG = 0b1111111111110 ; // 1111111111110................................................... pointer to Value, needs refcounting
enum Type {
/* 0*/ t_empty, // empty bucket placeholder
/* 1*/ t_funBI, t_fun_block,
/* 3*/ t_md1BI, t_md1_block,
/* 5*/ t_md2BI, t_md2_block,
/* 7*/ t_shape, // doesn't get visited, shouldn't be unallocated by gcWMd1
/* 8*/ t_fork, t_atop,
/*10*/ t_md1D, t_md2D, t_md2H,
/*13*/ t_harr , t_i32arr , t_fillarr , t_c32arr ,
/*17*/ t_hslice, t_i32slice, t_fillslice, t_c32slice,
/*21*/ t_comp, t_block, t_body, t_scope,
/*25*/ t_freed,
#ifdef RT_PERF
/*26*/ t_funPerf, t_md1Perf, t_md2Perf,
#endif
t_COUNT
};
char* format_type(u8 u) {
switch(u) { default: return"(unknown type)";
case t_empty:return"empty"; case t_shape:return"shape";
case t_funBI:return"fun_def"; case t_fun_block:return"fun_block";
case t_md1BI:return"md1_def"; case t_md1_block:return"md1_block";
case t_md2BI:return"md2_def"; case t_md2_block:return"md2_block";
case t_fork:return"fork"; case t_atop:return"atop";
case t_md1D:return"md1D"; case t_md2D:return"md2D"; case t_md2H:return"md2H";
case t_harr :return"harr" ; case t_i32arr :return"i32arr" ; case t_fillarr :return"fillarr" ; case t_c32arr :return"c32arr" ;
case t_hslice:return"hslice"; case t_i32slice:return"i32slice"; case t_fillslice:return"fillslice"; case t_c32slice:return"c32slice";
case t_comp:return"comp"; case t_block:return"block"; case t_body:return"body"; case t_scope:return"scope";
case t_freed:return"(freed by GC)";
}
}
#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,"=") 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,"⊏") F(slash,"/") F(ltack,"⊣") F(rtack,"⊢") F(fmtF,"⍕") F(fmtN,"⍕") /*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") /*sysfn.c*/
enum PrimFns {
#define F(N,X) pf_##N,
FOR_PF(F)
#undef F
};
char* format_pf(u8 u) {
switch(u) { default: return "(unknown fn)";
#define F(N,X) case pf_##N: return X;
FOR_PF(F)
#undef F
}
}
enum PrimMd1 {
pm1_none,
pm1_tbl, pm1_each, pm1_fold, pm1_scan, // md1.c
};
char* format_pm1(u8 u) {
switch(u) {
default: case pf_none: return"(unknown 1-modifier)";
case pm1_tbl: return""; case pm1_each: return"¨"; case pm1_fold: return"´"; case pm1_scan: return"`";
}
}
enum PrimMd2 {
pm2_none,
pm2_val, pm2_before, pm2_repeat, pm2_fillBy, pm2_catch, // md2.c
};
char* format_pm2(u8 u) {
switch(u) {
default: case pf_none: return"(unknown 1-modifier)";
case pm2_val: return""; case pm2_before: return""; case pm2_repeat: return""; case pm2_fillBy: return"•_fillBy_"; case pm2_catch: return"";
}
}
#ifdef USE_VALGRIND
#include <valgrind/valgrind.h>
#include <valgrind/memcheck.h>
void pst(char* msg) {
VALGRIND_PRINTF_BACKTRACE("%s", msg);
}
#endif
typedef union B {
u64 u;
i64 s;
f64 f;
} B;
#define b(x) ((B)(x))
typedef struct Value {
i32 refc; // plain old reference count
u8 mmInfo; // bucket size, mark&sweep bits when that's needed; currently unused
u8 flags; // is sorted/a permutation/whatever in the future, currently primitive index for self-hosted runtime
u8 type; // access into TypeInfo among generally knowing what type of object this is
ur extra; // whatever object-specific stuff. Rank for arrays, id for functions
#ifdef OBJ_COUNTER
u64 uid;
#endif
} Value;
typedef struct Arr {
struct Value;
usz ia;
usz* sh;
} Arr;
// memory manager
typedef void (*V2v)(Value*);
typedef void (*vfn)();
void gc_add(B x); // add permanent root object
void gc_addFn(vfn f); // add function that calls mm_visit/mm_visitP for dynamic roots
void gc_disable(); // gc starts disabled
void gc_enable(); // can be nested (e.g. gc_disable(); gc_disable(); gc_enable(); will keep gc disabled until another gc_enable(); )
void gc_maybeGC(); // gc if that seems necessary
void gc_forceGC(); // force a gc; who knows what happens if gc is disabled (probably should error)
void gc_visitRoots();
void* mm_allocN(usz sz, u8 type);
void mm_free(Value* x);
void mm_visit(B x);
void mm_visitP(void* x);
u64 mm_round(usz x);
u64 mm_size(Value* x);
u64 mm_heapAllocated();
u64 mm_heapUsed();
void mm_forHeap(V2v f);
B mm_alloc(usz sz, u8 type, u64 tag) {
assert(tag>1LL<<16 || tag==0); // make sure it's `ftag`ged :|
return b((u64)mm_allocN(sz,type) | tag);
}
// some primitive actions
void dec(B x);
B inc(B x);
void ptr_dec(void* x);
void ptr_inc(void* x);
void print(B x);
void arr_print(B x);
B m_v1(B a );
B m_v2(B a, B b );
B m_v3(B a, B b, B c );
B m_v4(B a, B b, B c, B d);
B m_unit(B a);
B m_str32(u32* s);
NORETURN void thr(B b);
NORETURN void thrM(char* s);
jmp_buf* prepareCatch();
#ifdef CATCH_ERRORS
#define CATCH setjmp(*prepareCatch()) // use as `if (CATCH) { /*handle error; dec(catchMessage);*/ } /*potentially erroring thing*/ popCatch();`
#else // note: popCatch() must always be called if no error was caught, so no returns before it!
#define CATCH false
#endif
void popCatch();
B catchMessage;
#define c(T,x) ((T*)((x).u&0xFFFFFFFFFFFFull))
#define v(x) c(Value, x)
#define a(x) c(Arr , x)
#define rnk(x ) (v(x)->extra) // expects argument to be Arr
#define srnk(x,r) (v(x)->extra=(r))
#define VT(x,t) assert(isVal(x) && v(x)->type==t)
void print_vmStack();
#ifdef DEBUG
B validate(B x);
Value* validateP(Value* x);
#endif
B err(char* s) {
puts(s); fflush(stdout);
print_vmStack();
__builtin_trap();
exit(1);
}
// tag checks
#ifdef ATOM_I32
bool isI32(B x) { return (x.u>>48) == I32_TAG; }
#else
bool isI32(B x) { return false; }
#endif
bool isFun(B x) { return (x.u>>48) == FUN_TAG; }
bool isArr(B x) { return (x.u>>48) == ARR_TAG; }
bool isC32(B x) { return (x.u>>48) == C32_TAG; }
bool isVar(B x) { return (x.u>>48) == VAR_TAG; }
bool isMd1(B x) { return (x.u>>48) == MD1_TAG; }
bool isMd2(B x) { return (x.u>>48) == MD2_TAG; }
bool isMd (B x) { return (x.u>>49) ==(MD2_TAG>>1); }
bool isNsp(B x) { return (x.u>>48) == NSP_TAG; }
bool isObj(B x) { return (x.u>>48) == OBJ_TAG; }
// bool isVal(B x) { return ((x.u>>51) == VAL_TAG) & ((x.u<<13) != 0); }
// bool isF64(B x) { return ((x.u>>51&0xFFF) != 0xFFE) | ((x.u<<1)==(b(1.0/0.0).u<<1)); }
bool isVal(B x) { return (x.u - (((u64)VAL_TAG<<51) + 1)) < ((1ull<<51) - 1); } // ((x.u>>51) == VAL_TAG) & ((x.u<<13) != 0);
bool isF64(B x) { return (x.u<<1) - ((0xFFEull<<52) + 2) >= (1ull<<52) - 2; }
bool isNum(B x) { return isF64(x)|isI32(x); }
bool isAtm(B x) { return !isVal(x); }
bool noFill(B x);
// shape mess
typedef struct ShArr {
struct Value;
usz a[];
} ShArr;
ShArr* shObj(B x) { return (ShArr*)((u64)a(x)->sh-offsetof(ShArr,a)); }
void decSh(B x) { if (rnk(x)>1) ptr_dec(shObj(x)); }
void arr_shVec(B x, usz ia) {
a(x)->ia = ia;
srnk(x, 1);
a(x)->sh = &a(x)->ia;
}
bool gotShape[t_COUNT];
usz* arr_shAlloc(B x, usz ia, ur r) {
a(x)->ia = ia;
srnk(x,r);
if (r>1) return a(x)->sh = ((ShArr*)mm_allocN(fsizeof(ShArr, a, usz, r), t_shape))->a;
a(x)->sh = &a(x)->ia;
return 0;
}
usz* arr_shAllocR(B x, ur r) { // allocates shape, leaves ia unchanged
srnk(x,r);
if (r>1) return a(x)->sh = ((ShArr*)mm_allocN(fsizeof(ShArr, a, usz, r), t_shape))->a;
a(x)->sh = &a(x)->ia;
return 0;
}
void arr_shCopy(B n, B o) { // copy shape from o to n
assert(isArr(o));
a(n)->ia = a(o)->ia;
ur r = srnk(n,rnk(o));
if (r<=1) {
a(n)->sh = &a(n)->ia;
} else {
ptr_inc(shObj(o));
a(n)->sh = a(o)->sh;
}
}
bool eqShPrefix(usz* w, usz* x, ur len) {
return memcmp(w, x, len*sizeof(usz))==0;
}
ur minRank(B w, B x) { // assumes both are arrays
ur wr = rnk(w);
ur xr = rnk(x);
return wr<xr? wr : xr;
}
ur maxRank(B w, B x) { // assumes both are arrays
ur wr = rnk(w);
ur xr = rnk(x);
return wr>xr? wr : xr;
}
bool eqShape(B w, B x) { assert(isArr(w)); assert(isArr(x));
ur wr = rnk(w); usz* wsh = a(w)->sh;
ur xr = rnk(x); usz* xsh = a(x)->sh;
if (wr!=xr) return false;
if (wsh==xsh) return true;
return eqShPrefix(wsh, xsh, wr);
}
usz arr_csz(B x) {
ur xr = rnk(x);
if (xr<=1) return 1;
usz* sh = a(x)->sh;
usz r = 1;
for (i32 i = 1; i < xr; i++) r*= sh[i];
return r;
}
// make objects
B m_arr(usz min, u8 type) { return mm_alloc(min, type, ftag(ARR_TAG)); }
B m_f64(f64 n) { assert(isF64(b(n))); return b(n); } // assert just to make sure we're actually creating a float
B m_c32(i32 n) { return tag(n, C32_TAG); } // TODO check validity?
#ifdef ATOM_I32
B m_i32(i32 n) { return tag(n, I32_TAG); }
#else
B m_i32(i32 n) { return m_f64(n); }
#endif
B m_error() { return tag(4, TAG_TAG); }
B m_usz(usz n) { return n==(i32)n? m_i32(n) : m_f64(n); }
i32 o2i (B x) { if ((i32)x.f!=x.f) thrM("Expected integer"); return (i32)x.f; }
usz o2s (B x) { if ((usz)x.f!=x.f) thrM("Expected integer"); return (usz)x.f; }
i64 o2i64 (B x) { if ((i64)x.f!=x.f) thrM("Expected integer"); return (i64)x.f; }
f64 o2f (B x) { if (!isNum(x)) thrM("Expected integer"); return x.f; }
i32 o2iu (B x) { return isI32(x)? (i32)(u32)x.u : (i32)x.f; }
i64 o2i64u(B x) { return (i64)x.f; }
bool q_i32(B x) { return isI32(x) || isF64(x)&(x.f==(i32)x.f); }
typedef struct Slice {
struct Arr;
B p;
} Slice;
void slice_free(B x) { dec(c(Slice,x)->p); decSh(x); }
void slice_visit(B x) { mm_visit(c(Slice,x)->p); }
void slice_print(B x) { arr_print(x); }
typedef void (*B2v)(B);
typedef B (* BS2B)(B, usz);
typedef B (*BSS2B)(B, usz, usz);
typedef B (* B2B)(B);
typedef B (* BB2B)(B, B);
typedef B (* BBB2B)(B, B, B);
typedef B (* BBBB2B)(B, B, B, B);
typedef B (*BBBBB2B)(B, B, B, B, B);
typedef bool (*B2b)(B);
typedef struct TypeInfo {
B2v free; // expects refc==0, type may be cleared to t_empty for garbage collection
BS2B get; // increments result, doesn't consume arg; TODO figure out if this should never allocate, so GC wouldn't happen
BS2B getU; // like get, but doesn't increment result (mostly equivalent to `B t=get(…); dec(t); t`)
BB2B m1_d; // consume all args; (m, f)
BBB2B m2_d; // consume all args; (m, f, g)
BS2B slice; // consumes; create slice from given starting position; add ia, rank, shape yourself
B2b canStore; // doesn't consume
B2B identity; // return identity element of this function; doesn't consume
B2v print; // doesn't consume
B2v visit; // call mm_visit for all referents
B2B decompose; // consumes; must return a HArr
bool isArr;
bool arrD1; // is always an array with depth 1
} TypeInfo;
TypeInfo ti[t_COUNT];
#define TI(x) (ti[v(x)->type])
B bi_N, bi_noVar, bi_badHdr, bi_optOut, bi_noFill;
void do_nothing(B x) { }
void empty_free(B x) { err("FREEING EMPTY\n"); }
void builtin_free(B x) { err("FREEING BUILTIN\n"); }
void def_visit(B x) { printf("(no visit for %d=%s)\n", v(x)->type, format_type(v(x)->type)); }
void freeed_visit(B x) {
#ifndef CATCH_ERRORS
err("visiting t_freed\n");
#endif
}
void def_print(B x) { printf("(%d=%s)", v(x)->type, format_type(v(x)->type)); }
B def_identity(B f) { return bi_N; }
B def_get (B x, usz n) { return inc(x); }
B def_getU(B x, usz n) { return x; }
B def_m1_d(B m, B f ) { return err("cannot derive this"); }
B def_m2_d(B m, B f, B g) { return err("cannot derive this"); }
B def_slice(B x, usz s) { return err("cannot slice non-array!"); }
B def_decompose(B x) { return m_v2(m_i32((isFun(x)|isMd(x))? 0 : -1),x); }
bool def_canStore(B x) { return false; }
static inline void hdr_init() {
for (i32 i = 0; i < t_COUNT; i++) {
ti[i].free = do_nothing;
ti[i].visit = def_visit;
ti[i].get = def_get;
ti[i].getU = def_getU;
ti[i].print = def_print;
ti[i].m1_d = def_m1_d;
ti[i].m2_d = def_m2_d;
ti[i].isArr = false;
ti[i].arrD1 = false;
ti[i].identity = def_identity;
ti[i].decompose = def_decompose;
ti[i].slice = def_slice;
ti[i].canStore = def_canStore;
}
ti[t_empty].free = empty_free;
ti[t_freed].free = do_nothing;
ti[t_freed].visit = freeed_visit;
ti[t_shape].visit = do_nothing;
ti[t_funBI].visit = ti[t_md1BI].visit = ti[t_md2BI].visit = do_nothing;
ti[t_funBI].free = ti[t_md1BI].free = ti[t_md2BI].free = builtin_free;
bi_N = tag(0, TAG_TAG);
bi_noVar = tag(1, TAG_TAG);
bi_badHdr = tag(2, TAG_TAG);
bi_optOut = tag(3, TAG_TAG);
bi_noFill = tag(5, TAG_TAG);
assert((MD1_TAG>>1) == (MD2_TAG>>1)); // just to be sure it isn't changed incorrectly, `isMd` depends on this
}
bool isNothing(B b) { return b.u==bi_N.u; }
// refcount
static inline void value_free(B x, Value* vx) {
ti[vx->type].free(x);
mm_free(vx);
}
static NOINLINE void value_freeR1(Value* x) { value_free(tag(x, OBJ_TAG), x); }
static NOINLINE void value_freeR2(Value* vx, B x) { value_free(x, vx); }
void dec(B x) {
if (!isVal(VALIDATE(x))) return;
Value* vx = v(x);
if(!--vx->refc) value_free(x, vx);
}
B inc(B x) {
if (isVal(VALIDATE(x))) v(x)->refc++;
return x;
}
void ptr_dec(void* x) { if(!--VALIDATEP((Value*)x)->refc) value_free(tag(x, OBJ_TAG), x); }
void ptr_inc(void* x) { VALIDATEP((Value*)x)->refc++; }
void ptr_decR(void* x) { if(!--VALIDATEP((Value*)x)->refc) value_freeR1(x); }
void decR(B x) {
if (!isVal(VALIDATE(x))) return;
Value* vx = v(x);
if(!--vx->refc) value_freeR2(vx, x);
}
bool reusable(B x) { return v(x)->refc==1; }
void printUTF8(u32 c);
void print(B x) {
if (isF64(x)) {
printf("%g", x.f);
} else if (isC32(x)) {
if ((u32)x.u>=32) { printf("'"); printUTF8((u32)x.u); printf("'"); }
else if((u32)x.u>15) printf("\\x%x", (u32)x.u);
else printf("\\x0%x", (u32)x.u);
} else if (isI32(x)) {
printf("%d", (i32)x.u);
} else if (isVal(x)) {
#ifdef DEBUG
if (isVal(x) && (v(x)->type==t_freed || v(x)->type==t_empty)) {
u8 t = v(x)->type;
v(x)->type = v(x)->flags;
printf(t==t_freed?"FREED:":"EMPTY:");
TI(x).print(x);
v(x)->type = t;
return;
}
#endif
TI(x).print(x);
}
else if (isVar(x)) printf("(var d=%d i=%d)", (u16)(x.u>>32), (i32)x.u);
else if (x.u==bi_N.u) printf("·");
else if (x.u==bi_optOut.u) printf("(value optimized out)");
else if (x.u==bi_noVar.u) printf("(unset variable placeholder)");
else if (x.u==bi_badHdr.u) printf("(bad header note)");
else if (x.u==bi_noFill.u) printf("(no fill placeholder)");
else printf("(todo tag %lx)", x.u>>48);
}
void printRaw(B x) {
if (isAtm(x)) {
if (isF64(x)) printf("%g", x.f);
else if (isC32(x)) printUTF8((u32)x.u);
else err("bad printRaw argument: atom arguments should be either numerical or characters");
} else {
usz ia = a(x)->ia;
BS2B xget = TI(x).get;
for (usz i = 0; i < ia; i++) {
B c = xget(x,i);
if (c.u==0 || noFill(c)) { printf(" "); continue; }
if (!isC32(c)) err("bad printRaw argument: expected all character items");
printUTF8((u32)c.u);
}
}
}
B eq_c2(B t, B w, B x);
bool equal(B w, B x) { // doesn't consume
bool wa = isArr(w);
bool xa = isArr(x);
if (wa!=xa) return false;
if (!wa) return o2iu(eq_c2(bi_N, inc(w), inc(x)))?1:0;
if (!eqShape(w,x)) return false;
usz ia = a(x)->ia;
BS2B xget = TI(x).get;
BS2B wget = TI(w).get;
for (usz i = 0; i < ia; i++) {
B wc=wget(w,i); B xc=xget(x,i); // getdec
bool eq=equal(wc,xc);
decR(wc); decR(xc);
if(!eq) return false;
}
return true;
}
typedef struct Fun {
struct Value;
BB2B c1;
BBB2B c2;
} Fun;
B c1_invalid(B f, B x) { return err("This function can't be called monadically"); }
B c2_invalid(B f, B w, B x) { return err("This function can't be called dyadically"); }
NOINLINE B c1_rare(B f, B x) { dec(x);
if (isMd(f)) return err("Calling a modifier");
return inc(VALIDATE(f));
}
NOINLINE B c2_rare(B f, B w, B x) { dec(w); dec(x);
if (isMd(f)) return err("Calling a modifier");
return inc(VALIDATE(f));
}
B c1(B f, B x) { // BQN-call f monadically; consumes x
if (isFun(f)) return VALIDATE(c(Fun,f)->c1(f, x));
return c1_rare(f, x);
}
B c2(B f, B w, B x) { // BQN-call f dyadically; consumes w,x
if (isFun(f)) return VALIDATE(c(Fun,f)->c2(f, w, x));
return c2_rare(f, w, x);
}
B c1_modifier(B f, B w, B x) {
dec(w); dec(x);
thrM("Calling a modifier");
}
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
} 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
} Md2;
B m_md1D(B m, B f );
B m_md2D(B m, B f, B g);
B m_md2H(B m, B g);
B m_fork(B f, B g, B h);
B m_atop( B g, B h);
void arr_print(B x) { // should accept refc=0 arguments for debugging purposes
usz r = rnk(x);
BS2B xgetU = TI(x).getU;
usz ia = a(x)->ia;
if (r!=1) {
if (r==0) {
printf("<");
print(xgetU(x,0));
return;
}
usz* sh = a(x)->sh;
for (i32 i = 0; i < r; i++) {
if(i==0)printf("%d",sh[i]);
else printf("‿%d",sh[i]);
}
printf("");
} else if (ia>0) {
for (usz i = 0; i < ia; i++) {
B c = xgetU(x,i);
if (!isC32(c) || (u32)c.u=='\n') goto reg;
}
printf("\"");
for (usz i = 0; i < ia; i++) printUTF8((u32)xgetU(x,i).u); // c32, no need to decrement
printf("\"");
return;
}
reg:;
printf("");
for (usz i = 0; i < ia; i++) {
if (i!=0) printf(", ");
print(xgetU(x,i));
}
printf("");
}
#include <time.h>
u64 nsTime() {
struct timespec t;
timespec_get(&t, TIME_UTC);
// clock_gettime(CLOCK_REALTIME, &t);
return t.tv_sec*1000000000ull + t.tv_nsec;
}
#ifdef DEBUG
Value* validateP(Value* x) {
if (x->refc<=0 || (x->refc>>28) == 'a' || x->type==t_empty) {
printf("bad refcount for type %d: %d\nattempting to print: ", x->type, x->refc); fflush(stdout);
print(tag(x,OBJ_TAG)); puts(""); fflush(stdout);
err("");
}
if (ti[x->type].isArr) {
Arr* a = (Arr*)x;
if (rnk(tag(x,ARR_TAG))<=1) assert(a->sh == &a->ia);
else validate(tag(shObj(tag(x,ARR_TAG)),OBJ_TAG));
}
return x;
}
B validate(B x) {
if (!isVal(x)) return x;
validateP(v(x));
if(isArr(x)!=TI(x).isArr && v(x)->type!=t_freed) {
printf("wat %d %p\n", v(x)->type, (void*)x.u);
print(x);
err("\nk");
}
return x;
}
#endif
#ifdef ALLOC_STAT
u64* ctr_a = 0;
u64* ctr_f = 0;
u64 actrc = 21000;
u64 talloc = 0;
#ifdef ALLOC_SIZES
u32** actrs;
#endif
#endif
static inline void onAlloc(usz sz, u8 type) {
#ifdef ALLOC_STAT
if (!ctr_a) {
#ifdef ALLOC_SIZES
actrs = malloc(sizeof(u32*)*actrc);
for (i32 i = 0; i < actrc; i++) actrs[i] = calloc(t_COUNT, sizeof(u32));
#endif
ctr_a = calloc(t_COUNT, sizeof(u64));
ctr_f = calloc(t_COUNT, sizeof(u64));
}
assert(type<t_COUNT);
#ifdef ALLOC_SIZES
actrs[(sz+3)/4>=actrc? actrc-1 : (sz+3)/4][type]++;
#endif
ctr_a[type]++;
talloc+= sz;
#endif
}
static inline void onFree(Value* x) {
#ifdef ALLOC_STAT
ctr_f[x->type]++;
#endif
#ifdef DEBUG
if (x->type==t_empty) err("double-free");
// u32 undef;
// x->refc = undef;
x->refc = -1431655000;
#endif
// x->refc = 0x61616161;
}