;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: GECOL; Base: 10 -*-
;;; arch-tag: B2840A52-3BDD-47DB-A03F-1C700ACFF6BC

;;; Copyright (c) 2006, Kilian Sprotte. All rights reserved.
;;; Mauricio Toro-Bermudez 2008. Extending gecol to work with gecode 2.0.x

;;; Thanks to Christian Schulte and Guido Tack (Gecode developers) and 
;;; Gustavo Gutierrez (GeOz developer) for their help.

;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:

;;;   * Redistributions of source code must retain the above copyright
;;;     notice, this list of conditions and the following disclaimer.

;;;   * Redistributions in binary form must reproduce the above
;;;     copyright notice, this list of conditions and the following
;;;     disclaimer in the documentation and/or other materials
;;;     provided with the distribution.

;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

(in-package :gecol)

;;; GecolSpace
(defun make-gecolspace (&key
                        (intnum 0)
                        (intmin 0)
                        (intmax 2)
                        (boolnum 0)
                        (setnum 0)
                        (bab-intvar-ind 0)
                        (bab-intreltype :irt->))
  (%make-gecolspace intnum intmin intmax boolnum setnum bab-intvar-ind bab-intreltype))

;;; DFS
(defun make-dfs-space-int-int-stop (space &key (c-d 1) (a-d 1) (stop (cffi:null-pointer)))
  (%make-dfs-space-int-int-stop space c-d a-d stop))

;;; BAB
(defun make-bab-space-int-int-stop (space &key (c-d 1) (a-d 1) (stop (cffi:null-pointer)))
  (%make-bab-space-int-int-stop space c-d a-d stop))

;;; Sets
(defun gec-fs-enumerate-lower-bound (set)
  ;(error "dont use")
  (unless (zerop (gec-fs-glb-size set))
    (iter
      (for potential-elt from (gec-fs-glb-max set)
           downto (gec-fs-glb-min set))
      (when (gec-fs-contains set potential-elt)
        (collect potential-elt at beginning)))))

(defun gec-fs-enumerate-upper-bound (set)
  (error "dont use")
  (unless (zerop (gec-fs-lub-size set))
    (iter
      (for potential-elt from (gec-fs-lub-max set)
           downto (gec-fs-lub-min set))
      (unless (gec-fs-not-contains set potential-elt)
        (collect potential-elt at beginning)))))

(defun gec-fs-value (set)
  "Assumes that SET is assigned."
  ;; FIXME better check this
  (gec-fs-enumerate-lower-bound set))

;;; FIXME this needs to be optimized (dont iterate over list twice, if possible)
(defmacro with-list-as-int-array ((list array size) &body body)
  (check-type array symbol)
  (check-type size symbol)
  (let ((=list= (gensym "LIST")))
    `(let* ((,=list= ,list)
            (,size (length ,=list=)))
       (cffi:with-foreign-object (,array :int ,size)
         (iter
           (for elt in ,=list=)
           (for i upfrom 0)
           (setf (cffi:mem-aref ,array :int i) elt))
         ,@body))))

(defcstruct var-arg-array
  "actually a lispy version of it, made up for wrapping the original VarArgArray"
  (size :int)
  (array :pointer))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (export 'with-var-arg-array))
;;; FIXME - we will use this /a lot/. So you should
;;; try to make the generated code as small as possible.
(defmacro with-var-arg-array ((list var &key (type :pointer)) &body body)
  (check-type var symbol)
  (let ((=list= (gensym "LIST")))
    `(let* ((,=list= ,list)
            (list-len (length ,=list=)))
       (with-foreign-object (array* ,type list-len)
         (iter
           (for elt in ,=list=)
           (for i upfrom 0)
           (setf (mem-aref array* ,type i) elt))
         (with-foreign-object (,var 'var-arg-array)
           (with-foreign-slots ((size array) ,var var-arg-array)
             (setf size list-len
                   array array*)
             ,@body))))))

(defun gec-minus (space a b c)
  "a - b = c"
  (with-var-arg-array ('(1 -1) coeffs :type :int)
    (with-var-arg-array ((list a b) a-b)
      (gecol:linear-intargs-intvarargs-intreltype-intvar-intconlevel
       space coeffs a-b :irt-= c :icl-def))))