#lang scheme

(require planet/util)

(require dynext/compile)
(require dynext/link)
(require dynext/file)

(require scheme/foreign)
(unsafe!)

(define (newer? source dest)
  (call/cc 
   (λ (return)
     (> (file-or-directory-modify-seconds source #f (λ () (display (format "source no ~s" source)) (sleep 200) (return #f)))
        (file-or-directory-modify-seconds dest #f (λ () (return #t)))))))

(define (compile-and-link name)
  ; compile and link a source file. If you want a literal file pass a path
  ; a string will be resolved as if you added the file in your
  ; primary-file list. Returns a path to the library created.
  (let ([base 
           (if (and (this-package-version-name) (string? name))
               (resolve-planet-path 
                `(planet ,name (,(this-package-version-owner) 
                                ,(this-package-version-name) 
                                ,(this-package-version-maj)
                                ,(this-package-version-min))))
               name)])
    (let ([source (path-replace-suffix base ".c")]
          [temp (path-replace-suffix base ".o")]
          [dest (path-replace-suffix base ".so")])
;      (display (format "Compiling ~s ~s~n" source dest))
      (when (newer? source dest)
        (compile-extension
         #t
         source
         temp
         null)
        (link-extension
         #t
         (list temp)
         dest)
        (delete-file temp))
      dest)))

(define (c-require-p symbols types lib)
  (let loop ([symbols symbols] [types types] [result null])
    (if (null? symbols) (apply values (reverse result))
        (loop (cdr symbols) 
              (cdr types)
              (cons (get-ffi-obj (car symbols) lib (car types)) result)))))

(define-syntax c-require
  (syntax-rules ()
    [(_ (names ...) (c-names ...) (types ...) source-name)
     (define-values (names ...) (c-require-p '(c-names ...) (list types ...) (ffi-lib (compile-and-link source-name))))]
    [(_ (names ...) (types ...) source-name) (c-require names ... names ... types ... source-name)]))

; (c-require [nice-name other-nice-name] ["uglyname" "other_uglyName"] [(_fun -> _int) (_fun _char -> _string) ...] "sourcefile.c")
; (nice-name) (other-nice-name #\a) ...
        
(require (prefix-in c (only-in scheme/contract ->)))

(provide/contract
 [compile-and-link (path-string? . c-> . path?)])
(provide c-require)