diff --git a/src/builtins/fns.c b/src/builtins/fns.c index 828a3642..70547edb 100644 --- a/src/builtins/fns.c +++ b/src/builtins/fns.c @@ -358,6 +358,7 @@ static void print_funBI(FILE* f, B x) { fprintf(f, "%s", pfn_repr(c(Fun,x)->extr static B funBI_uc1(B t, B o, B x) { return c(BFn,t)->uc1(t, o, x); } static B funBI_ucw(B t, B o, B w, B x) { return c(BFn,t)->ucw(t, o, w, x); } static B funBI_im(B t, B x) { return c(BFn,t)->im(t, x); } +static B funBI_is(B t, B x) { return c(BFn,t)->is(t, x); } static B funBI_iw(B t, B w, B x) { return c(BFn,t)->iw(t, w, x); } static B funBI_ix(B t, B w, B x) { return c(BFn,t)->ix(t, w, x); } static B funBI_identity(B x) { return inc(c(BFn,x)->ident); } @@ -372,6 +373,7 @@ void fns_init(void) { TIi(t_funBI,fn_im) = funBI_im; TIi(t_funBI,fn_iw) = funBI_iw; TIi(t_funBI,fn_ix) = funBI_ix; + TIi(t_funBI,fn_is) = funBI_is; bitUD[0] = a(bi_emptyIVec); // don't increment as it's already gc_add-ed { u64* p; B a=m_bitarrv(&p, 1); *p=0; bitUD[1] = a(a); gc_add(a); } { u64* p; B a=m_bitarrv(&p, 2); *p=0; bitp_set(p,1,1); bitUD[2] = a(a); bit2x[0] = a; gc_add(a); } diff --git a/src/builtins/md1.c b/src/builtins/md1.c index 274b565f..30df3a7e 100644 --- a/src/builtins/md1.c +++ b/src/builtins/md1.c @@ -152,9 +152,13 @@ static void print_md1BI(FILE* f, B x) { fprintf(f, "%s", pm1_repr(c(Md1,x)->extr static B md1BI_im(Md1D* d, B x) { return ((BMd1*)d->m1)->im(d, x); } static B md1BI_iw(Md1D* d, B w, B x) { return ((BMd1*)d->m1)->iw(d, w, x); } static B md1BI_ix(Md1D* d, B w, B x) { return ((BMd1*)d->m1)->ix(d, w, x); } + +B swap_im(Md1D* d, B x) { return isFun(d->f)? TI(d->f,fn_is)(d->f, x): def_fn_is(d->f, x); } + void md1_init(void) { TIi(t_md1BI,print) = print_md1BI; TIi(t_md1BI,m1_im) = md1BI_im; TIi(t_md1BI,m1_iw) = md1BI_iw; TIi(t_md1BI,m1_ix) = md1BI_ix; + c(BMd1,bi_swap)->im = swap_im; } diff --git a/src/core.h b/src/core.h index 84a7e5db..fda86fd8 100644 --- a/src/core.h +++ b/src/core.h @@ -35,7 +35,7 @@ typedef struct BFn { B ident; FC2 uc1; BBBB2B ucw; - FC1 im; + FC1 im, is; FC2 iw; B rtInvSwap; FC2 ix; B rtInvReg; } BFn; diff --git a/src/load.c b/src/load.c index 69189edd..fe7cbd38 100644 --- a/src/load.c +++ b/src/load.c @@ -650,11 +650,13 @@ static void funBI_visit(Value* x) { mm_visit(((BFn*)x)->rtInvSwap); } static B funBI_imRt(B t, B x) { return c1(c(BFn, t)->rtInvReg, x); } +static B funBI_isRt(B t, B x) { return c1(c(BFn, t)->rtInvSwap, x); } static B funBI_iwRt(B t, B w, B x) { return c2(c(BFn, t)->rtInvSwap, w, x); } static B funBI_ixRt(B t, B w, B x) { return c2(c(BFn, t)->rtInvReg, w, x); } -static B funBI_imInit(B t, B x) { B f=c(BFn,t)->rtInvReg; if(f.u==0) f=c(BFn,t)->rtInvReg=c1rt(invFnReg, incG(t)); c(BFn,t)->im=funBI_imRt; return c1(f, x); } -static B funBI_ixInit(B t, B w, B x) { B f=c(BFn,t)->rtInvReg; if(f.u==0) f=c(BFn,t)->rtInvReg=c1rt(invFnReg, incG(t)); c(BFn,t)->ix=funBI_ixRt; return c2(f, w, x); } -static B funBI_iwInit(B t, B w, B x) { B f=c(BFn,t)->rtInvSwap =c1rt(invFnSwap, incG(t)); c(BFn,t)->iw=funBI_iwRt; return c2(f, w, x); } +static B funBI_imInit(B t, B x) { B f=c(BFn,t)->rtInvReg; if(f.u==0) f=c(BFn,t)->rtInvReg =c1rt(invFnReg, incG(t)); c(BFn,t)->im=funBI_imRt; return c1(f, x); } +static B funBI_isInit(B t, B x) { B f=c(BFn,t)->rtInvSwap; if(f.u==0) f=c(BFn,t)->rtInvSwap=c1rt(invFnSwap, incG(t)); c(BFn,t)->is=funBI_isRt; return c1(f, x); } +static B funBI_ixInit(B t, B w, B x) { B f=c(BFn,t)->rtInvReg; if(f.u==0) f=c(BFn,t)->rtInvReg =c1rt(invFnReg, incG(t)); c(BFn,t)->ix=funBI_ixRt; return c2(f, w, x); } +static B funBI_iwInit(B t, B w, B x) { B f=c(BFn,t)->rtInvSwap; if(f.u==0) f=c(BFn,t)->rtInvSwap=c1rt(invFnSwap, incG(t)); c(BFn,t)->iw=funBI_iwRt; return c2(f, w, x); } void* m_customObj(u64 size, V2v visit, V2v freeO) { @@ -682,6 +684,7 @@ static NOINLINE B m_bfn(FC1 c1, FC2 c2, u8 id) { f->im = funBI_imInit; f->iw = funBI_iwInit; f->ix = funBI_ixInit; + f->is = funBI_isInit; f->rtInvReg = m_f64(0); f->rtInvSwap = m_f64(0); B r = tag(f,FUN_TAG); gc_add(r);