
   0 | module System.UV.Raw.Callback
   1 | 
   2 | %default total
   3 | 
   4 | --------------------------------------------------------------------------------
   5 | -- FFI
   6 | --------------------------------------------------------------------------------
   7 | 
   8 | %foreign "scheme:lock-object"
   9 | prim__lockobject : AnyPtr -> PrimIO ()
  10 | 
  11 | %foreign "scheme:unlock-object"
  12 | prim__unlockobject : AnyPtr -> PrimIO ()
  13 | 
  14 | %foreign "scheme:foreign-callable-code-object"
  15 | prim__foreign_callable_code_object : AnyPtr -> AnyPtr
  16 | 
  17 | export %foreign "scheme:foreign-callable-entry-point"
  18 | prim__foreign_callable_entry_point : AnyPtr -> AnyPtr
  19 | 
  20 | export %foreign "scheme:(lambda (x) (foreign-callable #f (lambda (cb0) ((x cb0) #f)) (void*) void))"
  21 | prim__ptrCB : (AnyPtr -> PrimIO ()) -> PrimIO AnyPtr
  22 | 
  23 | export %foreign "scheme:(lambda (x) (foreign-callable #f (lambda (cb0 cb1) (((x cb0) cb1) #f)) (void* unsigned-32) void))"
  24 | prim__ptrUintCB : (AnyPtr -> Bits32 -> PrimIO ()) -> PrimIO AnyPtr
  25 | 
  26 | export %foreign "scheme:(lambda (x) (foreign-callable #f (lambda (cb0 cb1) (((x cb0) cb1) #f)) (void* integer-32) void))"
  27 | prim__ptrIntCB : (AnyPtr -> Int32 -> PrimIO ()) -> PrimIO AnyPtr
  28 | 
  29 | export %foreign "scheme:(lambda (x) (foreign-callable #f (lambda (cb0 cb1 cb2) ((((x cb0) cb1) cb2) #f)) (void* integer-32 void*) void))"
  30 | prim__ptrIntPtrCB : (AnyPtr -> Int32 -> AnyPtr -> PrimIO ()) -> PrimIO AnyPtr
  31 | 
  32 | export %foreign "scheme:(lambda (x) (foreign-callable #f (lambda (cb0 cb1 cb2) ((((x cb0) cb1) cb2) #f)) (void* unsigned-32 void*) void))"
  33 | prim__ptrUintPtrCB : (AnyPtr -> Bits32 -> AnyPtr -> PrimIO ()) -> PrimIO AnyPtr
  34 | 
  35 | export %foreign "scheme:(lambda (x) (foreign-callable #f (lambda (cb0 cb1 cb2 cb3) (((((x cb0) cb1) cb2) cb3) #f)) (void* unsigned-32 void* void*) void))"
  36 | prim__ptrIntPtrPtrCB : (AnyPtr -> Int32 -> AnyPtr -> AnyPtr -> PrimIO ()) -> PrimIO AnyPtr
  37 | 
  38 | --------------------------------------------------------------------------------
  39 | -- Low-level stuff
  40 | --------------------------------------------------------------------------------
  41 | 
  42 | export
  43 | lockAnyPtr : HasIO io => AnyPtr -> io ()
  44 | lockAnyPtr p =
  45 |   case prim__nullAnyPtr p of
  46 |     0 => primIO (prim__lockobject p)
  47 |     _ => pure ()
  48 | 
  49 | export
  50 | unlockAnyPtr : HasIO io => AnyPtr -> io ()
  51 | unlockAnyPtr p =
  52 |   case prim__nullAnyPtr p of
  53 |     0 => primIO (prim__unlockobject $ prim__foreign_callable_code_object p)
  54 |     _ => pure ()
  55 | 
  56 | export
  57 | ptrCB : HasIO io => (Ptr t -> IO ()) -> io AnyPtr
  58 | ptrCB f = do
  59 |   co <- primIO $ prim__ptrCB (\x => toPrim $ f $ prim__castPtr x)
  60 |   primIO (prim__lockobject co)
  61 |   pure $ prim__foreign_callable_entry_point co
  62 | 
  63 | export
  64 | ptrUintCB : HasIO io => (Ptr t -> Bits32 -> IO ()) -> io AnyPtr
  65 | ptrUintCB f = do
  66 |   co <- primIO $ prim__ptrUintCB (\v,x => toPrim $ f (prim__castPtr v) x)
  67 |   primIO (prim__lockobject co)
  68 |   pure $ prim__foreign_callable_entry_point co
  69 | 
  70 | export
  71 | ptrIntCB : HasIO io => (Ptr t -> Int32 -> IO ()) -> io AnyPtr
  72 | ptrIntCB f = do
  73 |   co <- primIO $ prim__ptrIntCB (\x,v => toPrim $ f (prim__castPtr x) v)
  74 |   primIO (prim__lockobject co)
  75 |   pure $ prim__foreign_callable_entry_point co
  76 | 
  77 | export
  78 | ptrIntPtrCB : HasIO io => (Ptr t -> Int32 -> Ptr u -> IO ()) -> io AnyPtr
  79 | ptrIntPtrCB f = do
  80 |   co <- primIO $ prim__ptrIntPtrCB
  81 |     (\x,v,y => toPrim $ f (prim__castPtr x) v (prim__castPtr y))
  82 |   primIO (prim__lockobject co)
  83 |   pure $ prim__foreign_callable_entry_point co
  84 | 
  85 | export
  86 | ptrIntPtrPtrCB : HasIO io => (Ptr t -> Int32 -> Ptr u -> Ptr v -> IO ()) -> io AnyPtr
  87 | ptrIntPtrPtrCB f = do
  88 |   co <- primIO $ prim__ptrIntPtrPtrCB
  89 |     (\x,v,y,z => toPrim $ f (prim__castPtr x) v (prim__castPtr y) (prim__castPtr z))
  90 |   primIO (prim__lockobject co)
  91 |   pure $ prim__foreign_callable_entry_point co
  92 | 
  93 | export
  94 | ptrUintPtrCB : HasIO io => (Ptr t -> Bits32 -> Ptr u -> IO ()) -> io AnyPtr
  95 | ptrUintPtrCB f = do
  96 |   co <- primIO $ prim__ptrUintPtrCB
  97 |     (\x,v,y => toPrim $ f (prim__castPtr x) v (prim__castPtr y))
  98 |   primIO (prim__lockobject co)
  99 |   pure $ prim__foreign_callable_entry_point co
 100 |