;; This module provides "import extension" functions in support of
;; importing libasound functions.

;; Function: (get-string-safe ADDR)
; Invoke get-string unless ADDR is 0 in which case nil is returned.
(define (get-string-safe ADDR)
  (when (!= ADDR) (get-string ADDR)))

;; Macro: (ptr-api FN ARGS [FORMAT [FILTER]])
; This macro is used to define an API function for an import function
; <fn> that a) returns an int error code with 0 on success and
; negative on error, and b) has a * argument for an on-success return
; value.
;
; The given argument list <args> includes a place marker **
; where the low-level import function has a ** argument for returning
; a pointer value. The resulting API function wraps the import
; function so that the ** argument is omitted but that the pointer
; value is returned.
;
(define-macro (wrap** FN ARGS (FORMAT "Lu") (FILTER nil))
  (let ((UNPACK (list (list 'unpack FORMAT 'DATA) 0)))
    (when FILTER (setf UNPACK (list FILTER UNPACK)))
    (letex ((UNPACK UNPACK)
            (CALL (cons (eval FN) (replace '** (copy ARGS) 'DATA)))
            (REST (clean (curry = '**) ARGS))
            (FORMAT FORMAT))
      ;; redefine FN with wrapper
      (constant FN (fn REST
                     (let ((DATA (pack FORMAT 0)) (E 0))
                       (if (>= (setf E CALL)) UNPACK E)))) )
    ))

; Wrap an import function that returns "int" error code and has a **
; argument for an actual return data when error code is 0. The
; import** term looks like an import, but the return type slot holds
; list of format and filter, and the ** argument is marked as **.
;
(define (naming x n)
  (if (string? x)
      (list x (sym (format "__%d" n)))
    
      (= '** x) (list "void*" x) (list x (sym (format "__%d" n)))))

; The import is wrapped into a lambda for all other arguments, that
; then returns the ** data or the error code.
(define-macro (import** _LIB FN RET)
  (let ((FORMAT "Lu") (FILTER nil) (NAMED '()) (n 0))
    (dolist (i (args))
      (when (list? i)
        (when (and i (string? (i 0))) (setf FORMAT (pop i)))
        (when i (setf FILTER (i 0))))
      (if (string? i) (push (list i (sym (string "__" n))) NAMED -1)
        (push '("void*" **) NAMED -1))
      (inc n))
    (eval (flat (list 'import _LIB FN RET (map first NAMED))))
    (eval (list 'wrap** (sym FN) (map last NAMED) (or FORMAT "Lu") FILTER))
    ))

;======================================================================
;; Macro: (define-api FN args [format [filter]]
; define-api is a helper macro to define an API function for a
; low-level function FN that provides a return value via a ** argument
; (i.e., a pointer to a pointer variable).
;
; The first macro argument, FN, is the symbol name of the low-level
; function. The APi function gets the same name with "@" added to it.
;
; If the second macro argument is a string, then that will
;
; This is handled in newlisp by allocating a pointer
; variable memory block through a (pack "Lu" 0) term as value for a
; DATA variable, and then pass DATA as the ** argument for the
; low-level function. Upon the low-level function's successful return,
; the now assigned memory block assignment is captured through an
; (unpack "Lu" DATA) term for return as API function value.
;
; The first macro argument 
; Helper macro for functions the return pointers via ** arguments.
;
; Eg: (define-api foo x DATA y) will define API function foo@ that
; calls (foo x DATA y) with DATA being a ** argument, and then returns
; the value of DATA or the error code of foo.
;
; With (define-api foo "lf" x DATA y), i.e. a format string as first
; argument, then that will be used as unpacking format.
;
; With (define-api foo (get-string) x DATA y), i.e. a list with a
; filter function name as first argument, then that will be used as
; filter for the unpacked data.
;
; Both format and filter may be given, in that order.
(define-macro (define-api FN)
  (let ((ARGS (args)) (RES '((unpack "Lu" DATA) 0)))
    (when (string? (first ARGS))
      (setf RES (letex ((FMT (pop ARGS))) '((unpack FMT DATA) 0))))
    (when (list? (first ARGS)) (setf RES (list ((pop ARGS) 0) RES)))
    (letex ((REAL (cons FN ARGS))
            (API (cons (sym (string (term FN) "@"))
                       (clean (fn (x) (= (term x) "DATA")) ARGS)))
            (RES RES))
      (define API
        (let ((DATA (pack "Lu" 0)) (R nil) (E 0))
          (when (>= (setf E REAL)) (setf R RES))
          (or R E))))))

"import-api.lsp"