;;=============================================================================
;;                    C EXTENSION
;;=============================================================================
;;AUTOLOAD: C-extension
;;AUTODOC: C-extension "dynamically compile and link C code to Klone"
;;Usage: (C-extension name [options] strings)
;;
;;If not already compiled, compile, then dynamically link the extension
;;named by name, consisting of the concatenation of C strings, (automatically
;;postpended with a newline)
;;The dynamically loaded extension will be searched, in the directories 
;;specified by *Dl:path* in *machine*/name-versionID, where version ID is 
;;either specified in the :version keyword, or computed as the checksum of
;;the strings.
;;If not found, a version will be compiled in *Dl:dir*/*machine*, or the first
;;dir of *Dl:path* if not set.
;;
;;Options are pairs of keywords/values, and can be:
;;    :file    text will not be found in string arguments but by loading the
;;             file, which should consists of a full call to C-extension
;;             This is useful to avoid parsing the strings if the file is 
;;             already compiled
;;    :version string or number used to determine the version
;;    :libs    needed libraries to link (list of strings)
;;    :klone   gives an alternate lisp code if C not found or dl not possible

(defvar C-extension:libpostfix ".so")
(defvar *Dl:path* (list "." (expand-filename "~/kl/so") 
    "/usr/local/lib/klone/so"
))
(defvar *Dl:dir* (expand-filename "~/kl/so"))
(if (/= 'directory (file-type  *Dl:dir*))
  (recursive-mkdir *Dl:dir*)
)
(defvar C-extension:cc "gcc")
(defvar C-extension:-pic '("-shared" "-fpic"))
(defvar C-extension:includes "-I/usr/local/lib/klone/include")
(defvar C-extension:defines "-DKLONE")
(defvar C-extension:ld "ld")
(defvar C-extension:-shared '("-export-dynamic" "-shared"))

(defun C-extension (name &rest args &aux
    c-text
    version
    filename
    libs
  )
  (catch 'Done
    ;; parse options
    (while (typep (getn args 0) Keyword)
      ;; parse keywords here
      (setq args (subseq args 2))
    )
    (setq c-text (apply + (+ '("") args)))
    (if (not version)
      (setq version (*:hash c-text))
    )
    (setq version (String version))	;convert from number
    ;; first, see if we can find one
    (dolist (dir *Dl:path*)
      (setq dir (+ dir "/" *machine*))
      (setq filename (+ dir "/" name "-" version C-extension:libpostfix))
      (if (file-stats filename) (progn
	  (Dl:open filename)
	  (throw 'Done)
      ))
    )
    ;; not found, we must compile...
    (recursive-mkdir (+ *Dl:dir* "/" *machine*))
    (with (
	*current-directory* (+ *Dl:dir* "/" *machine*)
	c-name (+ name "-" version ".c")
	o-name (+ name "-" version ".o")
	so-name (+ "./" name "-" version C-extension:libpostfix)
      )
      (with (fd (open c-name :direction :output :if-exists :supersede))
	(write-string c-text fd)
	(close fd)
      )
      (C-extension:sh C-extension:cc C-extension:-pic "-c" 
	    C-extension:defines C-extension:includes c-name)
      (C-extension:sh C-extension:ld "-o" so-name 
	    C-extension:-shared o-name libs)
      (C-extension:sh "rm" "-f" c-name o-name)
      (Dl:open so-name)
    )
  )
)

(defun C-extension:sh (&rest args-raw &aux (args (list)))
  (dolist (arg args-raw)
    (if (typep arg List)
      (dolist (subarg arg)
	(lappend args subarg)
      )
      (lappend args arg)
  ))
  (dolist (arg args) (print-format *standard-error* "%0 " arg))
  (print-format *standard-error* "\n")
  (wait (system args))
)
