(module cbtest ()

(import scheme)
(import chicken.base)
(import chicken.string)
(import chicken.format)
(import chicken.foreign)
(import chicken.memory)
(import chicken.memory.representation)

(import dyn-vector)
(import object-evict)

(define object->address (compose pointer->address object->pointer))
(define address->object (compose pointer->object address->pointer))

(define cb-vec (make-dynvector 16 #f)) 
(define-external cb_vec scheme-object (record-instance-slot cb-vec 0))

(define (register-cb! fn . args) 
  (let* ((i (dynvector-index not cb-vec))
         (argp (object->address (object-evict args))))
        (dynvector-set! cb-vec
                        (or i (dynvector-length cb-vec))
                        `(,fn . ,argp))))

(define cb-wrapper (foreign-safe-lambda* void ((c-pointer i)) #<<EOM
  C_word f_a = C_block_item(cb_vec, *(int *)i);
  C_save(C_u_i_cdr(f_a));
  C_callback(C_u_i_car(f_a), 1);
EOM
))

(define (testfn argp)
  (printf "maztest: ~S\n" (car (address->object argp))))

(define (main)
  (register-cb! testfn "hi")

  (let-location ((i int 0)) 
                (cb-wrapper #$i))

  (exit 0))

(main)

)

; alice@bellona:~/work/misc/cbtest % pontiff run
; running cbtest...
; maztest: "hi"

(module cbtest ()

(import scheme)
(import chicken.base)
(import chicken.string)
(import chicken.format)
(import chicken.foreign)

(define callbacks (list)) 

(define (register-cb! fn) 
  (set! callbacks (cons fn callbacks)))

(define-external
  (cb_wrapper)
    void
     (for-each (lambda (cb) (cb)) callbacks))

(define (testfn argp)
  (printf "maztest: ~S\n" (car argp)))

(define (main)
  (register-cb! (lambda () (testfn '("hi"))))

  ((foreign-safe-lambda* void () "cb_wrapper();"))
  (exit 0))

(main)

)

(module cbtest ()

(import scheme)
(import chicken.base)
(import chicken.string)
(import chicken.format)
(import chicken.foreign)
(import chicken.memory)

(import object-evict)

; so this is a generic wrapper that converts a fn/arg pointer and calls one on the other
; if I stick a vector in the args then it can just setbang stuff in it between cycles ig
(define-external (cb_wrapper2 (c-pointer v)) void
  (let ((f/a (pointer->object v)))
       (apply (car f/a) (cdr f/a)))) 

; reexpose the name to scheme
(define-foreign-variable cb-wrapper2 (function void (c-pointer)) "cb_wrapper2")

; this sorta simulates nng-aio-alloc. ie, a scheme wrapper on a c function that accepts a c callback
; so this takes the cb_wrapper2 function and address of a pair of scheme function and args
; in theory if we can execute in here it'd work in an aio too
(define mk-aio (foreign-safe-lambda* void (((function void (c-pointer)) fn) (c-pointer arg)) "fn(arg);"))

; and then this simulates external interface
(define (create-aio fn . args) 
  (let ((f/a (object-evict (cons fn args))))
       (mk-aio cb-wrapper2 (object->pointer f/a)))) 

(define (testfn s n)
  (printf "maztest: ~S ~S\n" s n))

(define (main)
  (create-aio testfn "hi" 1) 
  (exit 0))

(main)

)