diff --git a/obj/subMakefile b/obj/subMakefile index 5955d969..e9905ee1 100644 --- a/obj/subMakefile +++ b/obj/subMakefile @@ -28,7 +28,7 @@ core: i32arr.o c32arr.o f64arr.o harr.o fillarr.o stuff.o derv.o mm.o heap.o @echo $< | cut -c 11- @$(CMD) $@.d -c $< -base: load.o main.o rtwrap.o vm.o ns.o +base: load.o main.o rtwrap.o vm.o ns.o nfns.o %.o: ../../src/%.c @echo $< | cut -c 11- @$(CMD) $@.d -c $< diff --git a/src/builtins/fns.c b/src/builtins/fns.c index 6d2918fa..04b1049c 100644 --- a/src/builtins/fns.c +++ b/src/builtins/fns.c @@ -1,6 +1,7 @@ #include "../core.h" #include "../utils/hash.h" #include "../utils/mut.h" +#include "../nfns.h" void print_funBI(B x) { printf("%s", format_pf(c(Fun,x)->extra)); } @@ -91,6 +92,7 @@ B fmtF_c1(B t, B x) { if (ty==t_funBI) { B r = fromUTF8l(format_pf (c(Fun,x)->extra)); dec(x); return r; } if (ty==t_md1BI) { B r = fromUTF8l(format_pm1(c(Md1,x)->extra)); dec(x); return r; } if (ty==t_md2BI) { B r = fromUTF8l(format_pm2(c(Md2,x)->extra)); dec(x); return r; } + if (ty==t_nfn) { B r = nfn_name(x); dec(x); return r; } return m_str32(U"(fmtF: not given a runtime primitive)"); } dec(x); diff --git a/src/builtins/sysfn.c b/src/builtins/sysfn.c index 043c7f75..9ecb505a 100644 --- a/src/builtins/sysfn.c +++ b/src/builtins/sysfn.c @@ -1,6 +1,9 @@ #include "../core.h" #include "../utils/hash.h" #include "../utils/file.h" +#include "../utils/wyhash.h" +#include "../ns.h" +#include "../nfns.h" B type_c1(B t, B x) { i32 r = -1; @@ -167,6 +170,47 @@ B hash_c1(B t, B x) { return r; } +static B rand_ns; +static B rand_intsName; +static i32 rand_a, rand_b; +static NFnDesc* rand_ints; +B rand_ints_c1(B t, B x) { + Scope* sc = c(NS,nfn_objU(t))->sc; + u64 seed = sc->vars[rand_a].u | sc->vars[rand_b].u<<32; + u64 rnd = wyrand(&seed); + sc->vars[rand_a].u = seed>>32; + sc->vars[rand_a].u = seed&0xFFFFFFFF; + return m_f64(wy2u0k(rnd, o2i64(x))); +} +B rand_ints_c2(B t, B w, B x) { + Scope* sc = c(NS,nfn_objU(t))->sc; + u64 seed = sc->vars[rand_a].u | sc->vars[rand_b].u<<32; + usz am = o2s(w); + i64 max = o2i64(x); + if (max>I32_MAX | max<1) thrM("(rand).Ints: bad 𝕩"); + i32* rp; B r = m_i32arrv(&rp, am); + for (usz i = 0; i < am; i++) rp[i] = wy2u0k(wyrand(&seed), max); + sc->vars[rand_a].u = seed>>32; + sc->vars[rand_a].u = seed&0xFFFFFFFF; + return r; +} + +static NOINLINE void rand_init() { + rand_ns = bqn_exec(m_str32(U"{a←𝕨⋄b←𝕩⋄ints⇐0}"), inc(bi_emptyHVec), inc(bi_emptyHVec)); gc_add(rand_ns); + rand_intsName = m_str32(U"ints"); gc_add(rand_intsName); + rand_ints = registerNFn(m_str32(U"(rand).Ints"), rand_ints_c1, rand_ints_c2); + B tmp = c1(rand_ns, m_f64(0)); + rand_a = ns_pos(tmp, m_str32(U"a")); + rand_b = ns_pos(tmp, m_str32(U"b")); + dec(tmp); +} +B makeRand_c1(B t, B x) { + if (!isNum(x)) thrM("•MakeRand: 𝕩 must be a number"); + if (rand_ns.u==0) rand_init(); + B r = c2(rand_ns, b(x.u>>32), b(x.u&0xFFFFFFFF)); + ns_set(r, rand_intsName, m_nfn(rand_ints, inc(r))); + return r; +} static B makeRel(B md) { // doesn't consume return m1_d(inc(md), path_dir(inc(comp_currPath))); @@ -192,6 +236,7 @@ B sys_c1(B t, B x) { else if (eqStr(c, U"timed")) r.a[i] = inc(bi_timed); else if (eqStr(c, U"hash")) r.a[i] = inc(bi_hash); else if (eqStr(c, U"repr")) r.a[i] = inc(bi_repr); + else if (eqStr(c, U"makerand")) r.a[i] = inc(bi_makeRand); else if (eqStr(c, U"fchars")) r.a[i] = makeRel(bi_fchars); else if (eqStr(c, U"fbytes")) r.a[i] = makeRel(bi_fbytes); else if (eqStr(c, U"flines")) r.a[i] = makeRel(bi_flines); diff --git a/src/h.h b/src/h.h index 103ad0d6..4c6dcc90 100644 --- a/src/h.h +++ b/src/h.h @@ -136,10 +136,10 @@ enum Type { /*19*/ t_hslice, t_i8slice, t_i32slice, t_fillslice, t_c32slice, t_f64slice, /*25*/ t_comp, t_block, t_body, t_scope, t_scopeExt, t_blBlocks, - /*31*/ t_ns, t_nsDesc, t_fldAlias, t_hashmap, t_temp, - /*36*/ t_freed, t_harrPartial, + /*31*/ t_ns, t_nsDesc, t_fldAlias, t_hashmap, t_temp, t_nfn, t_nfnDesc, + /*38*/ t_freed, t_harrPartial, #ifdef RT_WRAP - /*38*/ t_funWrap, t_md1Wrap, t_md2Wrap, + /*40*/ t_funWrap, t_md1Wrap, t_md2Wrap, #endif t_COUNT }; @@ -161,9 +161,9 @@ char* format_type(u8 u); /* sfns.c*/A(shape,"⥊") A(pick,"⊑") A(pair,"{𝕨‿𝕩}") A(select,"⊏") A(slash,"/") A(join,"∾") A(couple,"≍") A(shiftb,"»") A(shifta,"«") A(take,"↑") A(drop,"↓") A(group,"⊔") A(reverse,"⌽") \ /* sort.c*/A(gradeUp,"⍋") A(gradeDown,"⍒") \ /* sysfn.c*/M(type,"•Type") M(decp,"•Decompose") M(primInd,"•PrimInd") M(glyph,"•Glyph") A(fill,"•FillFn") M(sys,"•getsys") A(grLen,"•GroupLen") D(grOrd,"•groupOrd") \ -/* sysfn.c*/M(repr,"•Repr") A(asrt,"!") M(out,"•Out") M(show,"•Show") M(bqn,"•BQN") D(cmp,"•Cmp") A(hash,"•Hash") \ +/* sysfn.c*/M(repr,"•Repr") A(asrt,"!") M(out,"•Out") M(show,"•Show") M(bqn,"•BQN") D(cmp,"•Cmp") A(hash,"•Hash") M(makeRand,"•MakeRand") \ /*internal.c*/M(itype,"•internal.Type") M(refc,"•internal.Refc") M(squeeze,"•internal.Squeeze") M(isPure,"•internal.IsPure") A(info,"•internal.Info") \ -/*internal.c*/D(variation,"•internal.Variation") A(listVariations,"•internal.ListVariations") M(clearRefs,"•internal.ClearRefs") M(unshare,"•internal.Unshare") +/*internal.c*/D(variation,"•internal.Variation") A(listVariations,"•internal.ListVariations") M(clearRefs,"•internal.ClearRefs") M(unshare,"•internal.Unshare") #define FOR_PM1(A,M,D) \ /*md1.c*/ A(tbl,"⌜") A(each,"¨") A(fold,"´") A(scan,"`") A(const,"˙") A(swap,"˜") A(cell,"˘") \ @@ -296,7 +296,7 @@ void print_vmStack(); B validate(B x); Value* validateP(Value* x); #endif -static B err(char* s) { +static NORETURN B err(char* s) { puts(s); fflush(stdout); print_vmStack(); __builtin_trap(); diff --git a/src/load.c b/src/load.c index f5388932..82fd6d19 100644 --- a/src/load.c +++ b/src/load.c @@ -340,7 +340,7 @@ static inline void base_init() { // very first init function #undef FD } -#define FOR_INIT(F) F(base) F(harr) F(fillarr) F(i32arr) F(c32arr) F(f64arr) F(hash) F(sfns) F(fns) F(arith) F(md1) F(md2) F(derv) F(comp) F(rtWrap) F(ns) F(load) +#define FOR_INIT(F) F(base) F(harr) F(fillarr) F(i32arr) F(c32arr) F(f64arr) F(hash) F(sfns) F(fns) F(arith) F(md1) F(md2) F(derv) F(comp) F(rtWrap) F(ns) F(nfn) F(load) #define F(X) void X##_init(); FOR_INIT(F) #undef F diff --git a/src/nfns.c b/src/nfns.c new file mode 100644 index 00000000..2029d852 --- /dev/null +++ b/src/nfns.c @@ -0,0 +1,54 @@ +#include "core.h" +#include "h.h" +#include "nfns.h" +#include "utils/mut.h" + +struct NFnDesc { + struct Value; + u32 id; + B name; + BB2B c1; + BBB2B c2; +}; +static u32 nfn_curr; +static B nfn_list; + +NFnDesc* registerNFn(B name, BB2B c1, BBB2B c2) { + u32 id = nfn_curr++; + NFnDesc* r = mm_allocN(sizeof(NFnDesc), t_nfnDesc); + r->id = id; + r->c1 = c1; + r->c2 = c2; + r->name = name; + nfn_list = vec_add(nfn_list, tag(r, OBJ_TAG)); + return r; +} +B m_nfn(NFnDesc* desc, B obj) { + NFn* r = mm_allocN(sizeof(NFn), t_nfn); + r->id = desc->id; + r->c1 = desc->c1; + r->c2 = desc->c2; + r->obj = obj; + return tag(r,FUN_TAG); +} +B nfn_name(B x) { VTY(x, t_nfn); + return inc(c(NFnDesc,TI(nfn_list).getU(nfn_list,c(NFn,x)->id))->name); +} + +void nfn_free(Value* x) { dec(((NFn*)x)->obj); } +void nfn_visit(Value* x) { mm_visit(((NFn*)x)->obj); } +void nfn_print(B x) { printRaw(c(NFnDesc,TI(nfn_list).getU(nfn_list,c(NFn,x)->id))->name); } +void nfnDesc_free(Value* x) { err("nfnDesc shouldn't be freed!"); } +void nfnDesc_visit(Value* x) { mm_visit(((NFnDesc*)x)->name); } +void nfnDesc_print(B x) { printf("(native function description)"); } + +void nfn_gcFn() { + mm_visit(nfn_list); +} +void nfn_init() { + nfn_list = inc(bi_emptyHVec); + ti[t_nfn].free = nfn_free; ti[t_nfnDesc].free = nfnDesc_free; + ti[t_nfn].visit = nfn_visit; ti[t_nfnDesc].visit = nfnDesc_visit; + ti[t_nfn].print = nfn_print; ti[t_nfnDesc].print = nfnDesc_print; + gc_addFn(nfn_gcFn); +} diff --git a/src/nfns.h b/src/nfns.h new file mode 100644 index 00000000..dd8730d5 --- /dev/null +++ b/src/nfns.h @@ -0,0 +1,21 @@ +#pragma once +#include "core.h" + +typedef struct NFnDesc NFnDesc; +typedef struct NFn { // native function + struct Fun; + u32 id; // index in nfn_list + // custom fields: + i32 data; + B obj; +} NFn; + +NFnDesc* registerNFn(B name, BB2B c1, BBB2B c2); // should be called a constant number of times; consumes name +B m_nfn(NFnDesc* desc, B obj); +B nfn_name(B x); // doesn't consume +static B nfn_objU(B t) { + return c(NFn,t)->obj; +} +static i32 nfn_data(B t) { + return c(NFn,t)->data; +} \ No newline at end of file diff --git a/src/ns.c b/src/ns.c index 1cbb2e2e..af1f01e2 100644 --- a/src/ns.c +++ b/src/ns.c @@ -38,7 +38,7 @@ B m_ns(Scope* sc, NSDesc* desc) { // consumes both return r; } -B ns_getU(B ns, B cNL, i32 nameID) { +B ns_getU(B ns, B cNL, i32 nameID) { VTY(ns, t_ns); NS* n = c(NS, ns); NSDesc* d = n->desc; i32 dVarAm = d->varAm; @@ -58,7 +58,7 @@ B ns_getU(B ns, B cNL, i32 nameID) { } thrM("No key found"); } -B ns_getNU(B ns, B name) { +B ns_getNU(B ns, B name) { VTY(ns, t_ns); NS* n = c(NS, ns); NSDesc* d = n->desc; i32 dVarAm = d->varAm; @@ -70,6 +70,34 @@ B ns_getNU(B ns, B name) { } thrM("No key found"); } +void ns_set(B ns, B name, B val) { VTY(ns, t_ns); + NS* n = c(NS, ns); + NSDesc* d = n->desc; + i32 dVarAm = d->varAm; + B dNL = d->nameList; + BS2B dNLgetU = TI(dNL).getU; + for (i32 i = 0; i < dVarAm; i++) { + i32 dID = d->expIDs[i]; + if (dID>=0 && equal(dNLgetU(dNL, dID), name)) { + dec(n->sc->vars[i]); + n->sc->vars[i] = val; + return; + } + } + thrM("No key found"); +} + +i32 ns_pos(B ns, B name) { VTY(ns, t_ns); + Body* b = c(NS, ns)->sc->body; + B nameList = c(NS, ns)->desc->nameList; + i32 bVarAm = b->varAm; + BS2B nlGetU = TI(nameList).getU; + for (i32 i = 0; i < bVarAm; i++) { + i32 id = b->varIDs[i]; + if (id>=0) if (equal(nlGetU(nameList, id), name)) { dec(name); return i; } + } + thrM("No key found"); +} B ns_nameList(NSDesc* d) { return d->nameList; diff --git a/src/ns.h b/src/ns.h index d5f4124f..9f00b0e1 100644 --- a/src/ns.h +++ b/src/ns.h @@ -18,3 +18,5 @@ void m_nsDesc(Body* body, bool imm, u8 ty, B nameList, B varIDs, B exported); // B m_ns(Scope* sc, NSDesc* desc); // consumes both B ns_getU(B ns, B nameList, i32 nameID); // doesn't consume anything, doesn't increment result B ns_getNU(B ns, B name); // doesn't consume anything, doesn't increment result +void ns_set(B ns, B name, B val); // consumes val +i32 ns_pos(B ns, B name); // consumes name; returns an index in sc->vars for any variable, exported or local diff --git a/src/opt/single.c b/src/opt/single.c index a8078cec..805a567a 100644 --- a/src/opt/single.c +++ b/src/opt/single.c @@ -23,6 +23,7 @@ #include "../builtins/internal.c" #include "../vm.c" #include "../ns.c" +#include "../nfns.c" #include "../rtwrap.c" #include "../load.c" #include "../main.c"