(in-package :cl-meld)

(define-condition external-invalid-error (error)
   ((text :initarg :text :reader text)))

(defparameter *external-functions* (make-hash-table :test #'equal))
(defparameter *external-functions-counter* 0)

(defun lookup-custom-external-function (name)
	(find-if (lambda (x) (string-equal name (extern-name x))) *externs*))
	
(defun lookup-custom-external-function-id (name)
	(extern-id (lookup-custom-external-function name)))
	
(defun lookup-standard-external-function (name)
	(multiple-value-bind (extern found-p) (gethash name *external-functions*)
		(if found-p
			extern)))

(defun lookup-external-definition (name)
	;; lookup pre-defined externals first
	(multiple-value-bind (extern found-p) (gethash name *external-functions*)
		(unless found-p
			;; if not, look for user defined
			(let ((item (lookup-custom-external-function name)))
				(when item
					(setf found-p t
							extern item))))
		(unless found-p
			(error 'external-invalid-error :text (tostring "invalid external function: ~a" name)))
		extern))
		
(defun lookup-external-function-id (name)
	(extern-id (lookup-external-definition name)))

(defmacro define-external-function (name ret-type types &key (poly-p nil))
   `(progn
      (setf (gethash ,name *external-functions*) (make-extern ,name ,ret-type ,types *external-functions-counter* ,poly-p))
      (incf *external-functions-counter*)))

(define-external-function "sigmoid" :type-float '(:type-float))
(define-external-function "randint" :type-int '(:type-int))
(define-external-function "normalize" '(:type-list :type-float) '((:type-list :type-float)))
(define-external-function "damp" '(:type-list :type-float) '((:type-list :type-float) (:type-list :type-float) :type-float))
(define-external-function "divide" '(:type-list :type-float) '((:type-list :type-float) (:type-list :type-float)))
(define-external-function "convolve" '(:type-list :type-float) '((:type-list :type-float) (:type-list :type-float)))
(define-external-function "addfloatlists" '(:type-list :type-float) '((:type-list :type-float) (:type-list :type-float)))
(define-external-function "intlistdiff" '(:type-list :type-int) '((:type-list :type-int) (:type-list :type-int)))
(define-external-function "lnth" :all '((:type-list :all) :type-int))
(define-external-function "concatenate" :type-string '(:type-string :type-string))
(define-external-function "str2float" :type-float '(:type-string))
(define-external-function "str2int" :type-int '(:type-string))
(define-external-function "lremove" '(:type-list :all) '((:type-list :all) :all) :poly-p t)
(define-external-function "wastetime" :type-int '(:type-int))
(define-external-function "truncate" :type-float '(:type-float :type-int))
(define-external-function "float2int" :type-int '(:type-float))
(define-external-function "int2str" :type-string '(:type-int))
(define-external-function "float2str" :type-string '(:type-float))
(define-external-function "intlistsub" '(:type-list :type-int) '((:type-list :type-int) :type-int :type-int))
(define-external-function "str2intlist" '(:type-list :type-int) '(:type-string))
(define-external-function "filecountwords" :type-int '(:type-string :type-int))
(define-external-function "residual" :type-float '((:type-list :type-float) (:type-list :type-float)))
(define-external-function "llength" :type-int '((:type-list :all)))
(define-external-function "lappend" '(:type-list :all) '((:type-list :all) (:type-list :all)) :poly-p t)
(define-external-function "priority" :type-float '(:type-addr))
(define-external-function "lreverse" '(:type-list :all) '((:type-list :all)) :poly-p t)
(define-external-function "llast" :all '((:type-list :all)))
(define-external-function "cpu-id" :type-int '(:type-addr))
(define-external-function "node2int" :type-int '(:type-addr))
(define-external-function "intpower" :type-int '(:type-int :type-int))
(define-external-function "lsort" '(:type-list :all) '((:type-list :all)) :poly-p t)
(define-external-function "lremoveduplicates" '(:type-list :all) '((:type-list :all)) :poly-p t)
(define-external-function "degeneratevector" '(:type-list :type-int) '(:type-int :type-int))
(define-external-function "demergemessages" '(:type-list :type-int) '((:type-list :type-int) (:type-list :type-int)))
(define-external-function "intlistequal" :type-int '((:type-list :type-int) (:type-list :type-int)))
(define-external-function "addfloatstructs" '(:type-struct :all) '((:type-struct :all) (:type-struct :all)) :poly-p t)
(define-external-function "normalizestruct" '(:type-struct :all) '((:type-struct :all)) :poly-p t)
(define-external-function "dampstruct" '(:type-struct :all) '((:type-struct :all) (:type-struct :all) :type-float) :poly-p t)
(define-external-function "residualstruct" :type-float '((:type-struct :all) (:type-struct :all)) :poly-p t)
(define-external-function "dividestruct" '(:type-struct :all) '((:type-struct :all) (:type-struct :all)) :poly-p t)
(define-external-function "convolvestruct" '(:type-struct :all) `((:type-struct ,(loop for i from 1 upto 25 collect :type-float)) (:type-struct :all)) :poly-p t)
(define-external-function "cpu-static" :type-int '(:type-addr))
(define-external-function "is-moving" :type-bool '(:type-addr))
(define-external-function "is-static" :type-bool '(:type-addr))
(define-external-function "partition_vertical" :type-int '(:type-int :type-int :type-int :type-int))
(define-external-function "partition_horizontal" :type-int '(:type-int :type-int :type-int :type-int))
(define-external-function "partition_grid" :type-int '(:type-int :type-int :type-int :type-int))
(define-external-function "queue-size" :type-int '(:type-addr))                                                 
(define-external-function "facts-proved" :type-int '(:type-addr))
(define-external-function "facts-consumed" :type-int '(:type-addr))
(define-external-function "lcount" :type-int '((:type-list :all) :all) :poly-p t)
(define-external-function "lexists" :type-bool '((:type-list :all) :all) :poly-p t)
(define-external-function "lexistss" :type-bool '((:type-list :all) (:type-list :all)) :poly-p t)
(define-external-function "queens_violation" :type-bool '(:type-int (:type-list :type-int)))
(define-external-function "minimax_score" :type-int '((:type-list :type-int) :type-int :type-int))
(define-external-function "minimax_points" :type-int '((:type-list :type-int) :type-int))
(define-external-function "array_init" '(:type-array :all) '(:type-int :all) :poly-p t)
(define-external-function "array_get" :all '((:type-array :all) :type-int))
(define-external-function "array_set" '(:type-array :all) '((:type-array :all) :type-int :all) :poly-p t)
(define-external-function "array_add" '(:type-array :all) '((:type-array :all) :all) :poly-p t)
(define-external-function "array_from_list" '(:type-array :all) '((:type-list :all)) :poly-p t)
(define-external-function "array_size" :type-int '((:type-array :all)))
(define-external-function "minimax_score2" :type-int '((:type-array :type-int) :type-int :type-int))
(define-external-function "minimax_points2" :type-int '((:type-array :type-int) :type-int))
(define-external-function "fabs" :type-float '(:type-float))                                                                                 
