Skip to content

Commit

Permalink
ok a lil' better
Browse files Browse the repository at this point in the history
  • Loading branch information
@vmchale
vmchale committed Feb 24, 2025
1 parent 74ad1cb commit fa8d2b1
Show file tree
Hide file tree
Showing 4 changed files with 28 additions and 46 deletions.
4 changes: 2 additions & 2 deletions c/ffi.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,7 @@
// https://github.com/tlack/b-decoded/blob/3c21a33a5c3f5d39f75014e10f875fe830a8b326/orig-files/c.h#L8
#define $(p,a) if(p){a;}else

#define F(r,t) {$(t.f==Sc&&t.rr==Rc,{switch(t.ty.aa){C(I_t,r=&ffi_type_sint64) C(B_t,r=&ffi_type_uint8) C(F_t,r=&ffi_type_double)}}) {r=&ffi_type_pointer;}}
#define F(r,t) {$(t.f==Rc,{switch(t.ty.aa){C(I_t,r=&ffi_type_sint64) C(B_t,r=&ffi_type_uint8) C(F_t,r=&ffi_type_double)}}) {r=&ffi_type_pointer;}}

G JC sys={(P)&malloc,(P)&free,(P)&lrand48,(P)&drand48,(P)&exp,(P)&log,(P)&pow};

Expand All @@ -24,4 +24,4 @@ ffi_cif* apple_ffi(FnTy* ty) {
R cif;
}

#define ArgTy(t,fc,i,b,sp,fa,ia,ba,ap) {switch(t.f){C(Sc,switch(t.rr){C(Rc,switch(t.ty.aa){C(F_t,fc) C(I_t,i) C(B_t,b)}) C(Pi,sp)};) C(Aa,switch(t.rr){C(Rc,switch(t.ty.aa){C(F_t,fa) C(I_t,ia) C(B_t,ba)}) C(Pi,ap)})}};
#define ArgTy(t,fc,i,b,sp,fa,ia,ba,ap) {switch(t.f){C(Rc,switch(t.ty.aa){C(F_t,fc) C(I_t,i) C(B_t,b)}) C(Pi,sp) C(Aa,switch(t.ty.aa){C(F_t,fa) C(I_t,ia) C(B_t,ba)}) C(Ap,ap)}};
4 changes: 2 additions & 2 deletions include/apple.h
View file
Original file line number Diff line number Diff line change
Expand Up @@ -18,12 +18,12 @@ T apple_print_ts_sz(K char*, S*, T*);

TD apple_at{I_t=1,F_t=2,B_t=3} apple_at;

TD HK{Sc,Aa} HK; TD NK{Rc,Pi} NK;
TD TK {Rc,Pi,Ap,Aa} TK;

TS apple_P{int pi_n; struct apple_t* a_pi;} apple_P;

// https://stackoverflow.com/questions/20752551/working-with-a-union-of-structs-in-c
TS apple_t {HK f; NK rr; union {apple_at aa; apple_P APi;} ty;} apple_t;
TS apple_t {TK f; union {apple_at aa; apple_P APi;} ty;} apple_t;

TS FnTy {int argc; apple_t* args; apple_t res;} FnTy;

Expand Down
31 changes: 11 additions & 20 deletions lib/E.chs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -29,20 +29,16 @@ data JitCtx
{# fun memcpy as ^ { castPtr `Ptr a', castPtr `Ptr a', coerce `CSize' } -> `Ptr a' castPtr #}

{# enum apple_at as CA {} #}
{# enum HK as HK {} #}
{# enum NK as NK {} #}
{# enum TK as TK {} #}

ct :: CAt -> CA
ct CR = F_t; ct CI = I_t; ct CB = B_t

t32 :: CAt -> CInt
t32 = fromIntegral.fromEnum.ct

hk32 :: HK -> CInt
hk32 = fromIntegral.fromEnum

nk32 :: NK -> CInt
nk32 = fromIntegral.fromEnum
tk32 :: TK -> CInt
tk32 = fromIntegral.fromEnum

ppn :: T.Text -> Ptr CSize -> IO CString
ppn t szP = BS.unsafeUseAsCStringLen (encodeUtf8 t) $ \(bs, sz) -> do
Expand Down Expand Up @@ -103,33 +99,29 @@ apple_ty src errPtr = do
ip <- mallocBytes (argc*{#sizeof apple_t#})
{# set FnTy.argc #} sp (fromIntegral argc)
case to of
SC tao -> f sp Sc tao; AC tao -> f sp Aa tao
ΠC ts -> πk sp Sc ts; ΠA ts -> πk sp Aa ts
SC tao -> f sp Rc tao; AC tao -> f sp Aa tao
ΠC ts -> πk sp Pi ts; ΠA ts -> πk sp Ap ts
zipWithM_ (\ti n ->
case ti of
ΠC{} -> error "tuple arguments not implemented."
ΠA{} -> error "array-of-tuple arguments not implemented."
SC tai -> do
argn ip n {# offsetof apple_t->f #} (hk32 Sc)
argn ip n {# offsetof apple_t->rr #} (nk32 Rc)
argn ip n {# offsetof apple_t->f #} (tk32 Rc)
argn ip n {# offsetof apple_t->ty.aa #} (t32 tai)
AC tai -> do
argn ip n {# offsetof apple_t->f #} (hk32 Aa)
argn ip n {# offsetof apple_t->rr #} (nk32 Rc)
argn ip n {# offsetof apple_t->f #} (tk32 Aa)
argn ip n {# offsetof apple_t->ty.aa #} (t32 tai)) tis [0..]
{# set FnTy.args #} sp ip
pure sp
where
argn p n = pokeByteOff (p `plusPtr` (n*{# sizeof apple_t #}))
f p k t = do
{# set FnTy.res.f #} p (hk32 k)
{# set FnTy.res.rr #} p (nk32 Rc)
{# set FnTy.res.f #} p (tk32 k)
{# set FnTy.res.ty.aa #} p (t32 t)
πk sp k ts = do
let nr=length ts
pp <- mallocBytes (nr*{#sizeof apple_t#})
{# set FnTy.res.f #} sp (hk32 k)
{# set FnTy.res.rr #} sp (nk32 Pi)
{# set FnTy.res.f #} sp (tk32 k)
{# set FnTy.res.ty.APi.pi_n #} sp (fromIntegral nr::CInt)
{# set FnTy.res.ty.APi.a_pi #} sp pp
zipWithM_ (\tϵ n -> do
Expand All @@ -138,11 +130,10 @@ apple_ty src errPtr = do
ΠA{} -> error "nested tuples not implemented."
ΠC{} -> error "nested tuples not implemented."
AC taϵ -> ft ap Aa taϵ
SC taϵ -> ft ap Sc taϵ) ts [0..]
SC taϵ -> ft ap Rc taϵ) ts [0..]
where
ft p kϵ t = do
{# set apple_t.f #} p (hk32 kϵ)
{# set apple_t.rr #} p (nk32 Rc)
{# set apple_t.f #} p (tk32 kϵ)
{# set apple_t.ty.aa #} p (t32 t)

cfp = case arch of {"aarch64" -> actxFunP; "x86_64" -> ctxFunP.fst}
Expand Down
35 changes: 13 additions & 22 deletions pyc/apple.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -129,28 +129,19 @@ ZF apple_call(PYA self, PYA args, PYA kwargs) {
if(pyarg!=NULL){
apple_t argt=ty->args[k];
switch(argt.f){
C(Sc,
switch(argt.rr){
C(Rc,
switch(argt.ty.aa){
C(I_t,SA(J,xi);*xi=PyLong_AsLong(pyarg);vals[k]=xi;)
C(F_t,SA(F,xf);*xf=PyFloat_AsDouble(pyarg);vals[k]=xf;)
})
C(Pi,nyi)
}
)
C(Aa,
switch(argt.rr){
C(Sc,
switch(argt.ty.aa){
C(I_t,SA(U,x);$arr(pyarg);*x=i_npy((const NP)pyarg);fs|=1<<k;vals[k]=x;)
C(B_t,SA(U,x);$arr(pyarg);*x=b_npy((const NP)pyarg);fs|=1<<k;vals[k]=x;)
C(F_t,SA(U,x);$arr(pyarg);*x=f_npy((const NP)pyarg);fs|=1<<k;vals[k]=x;)
}
)
C(Pi,nyi)
}
)
C(Rc,
switch(argt.ty.aa){
C(I_t,SA(J,xi);*xi=PyLong_AsLong(pyarg);vals[k]=xi;)
C(F_t,SA(F,xf);*xf=PyFloat_AsDouble(pyarg);vals[k]=xf;)
})
C(Pi,nyi)
C(Aa,
switch(argt.ty.aa){
C(I_t,SA(U,x);$arr(pyarg);*x=i_npy((const NP)pyarg);fs|=1<<k;vals[k]=x;)
C(B_t,SA(U,x);$arr(pyarg);*x=b_npy((const NP)pyarg);fs|=1<<k;vals[k]=x;)
C(F_t,SA(U,x);$arr(pyarg);*x=f_npy((const NP)pyarg);fs|=1<<k;vals[k]=x;)
})
C(Ap,nyi)
}
}
}
Expand Down

0 comments on commit fa8d2b1

Please sign in to comment.