(in-package :cl-user)
;;; The hypergraph-openmusic example requires LispWorks (the CAPI package)

; Find "size" numbers which sum is 14
; For example is size is 3, a solution could be <1,10,3>
(defun add-14 (size)
  (let ((s (gecol:make-gecolspace :intnum size :intmin 0 :intmax 11)))
    (gecol:with-var-arg-array ((loop for i below size collect (gecol:gecolspace-getint-int s i))
                               varargs)
      (gecol:linear-intvarargs-intreltype-int-intconlevel s varargs :irt-= 14  :icl-def)
      (gecol:branch-intvarargs-bvarsel-bvalsel s varargs :bvar-none :bval-min))
    (let ((e (gecol:make-dfs-space-int-int-stop s)))
      (loop
         for sol = (gecol:dfs-next e)
         until (cffi:null-pointer-p sol)
        do 
	   (dotimes (i size) (format t "~a,"   (gecol:intvar-val (gecol:gecolspace-getint-int sol i))))
	   (format t "~%" "endline")
         do (gecol:delete-gecolspace sol))
      (gecol:delete-dfs e)
      (gecol:delete-gecolspace s))))

;;;;;;;; (add-14 3)

;Given the polygon it gives other polygon which are obtained by rotating it.
;For example for input <0,3,6,9> solutions are <0,3,6,9>, <1,4,7,10> and <2,5,8,11>
(defun polygon-reloaded (input)
  (let ((s (gecol:make-gecolspace :intnum (array-total-size input) :intmin 0 :intmax 11)))
     
       (gecol:with-var-arg-array ((loop for i below (array-total-size input) collect (gecol:gecolspace-getint-int s i))
                               varargs)
          (gecol:with-var-arg-array ('(1 -1) coeffs :type :int)
           (dotimes (i (- (array-total-size input) 1)) 
              (gecol:with-var-arg-array ((list (gecol:gecolspace-getint-int s i) (gecol:gecolspace-getint-int s (+ i 1))) a-b)
                  (gecol:linear-intargs-intvarargs-intreltype-int-intconlevel
                   s coeffs a-b :irt-= (- (aref input i) (aref input (+ i 1) )) :icl-def))
           ))


               (gecol:distinct-intvarargs-intconlevel s varargs :icl-def)
               (gecol:branch-intvarargs-bvarsel-bvalsel s varargs :bvar-none :bval-min) 
      
    )
    (let ((e (gecol:make-dfs-space-int-int-stop s)))
      (loop
         for sol = (gecol:dfs-next e)
         until (cffi:null-pointer-p sol)
      do 
	   (dotimes (i (array-total-size input)) (format t "~a,"   (gecol:intvar-val (gecol:gecolspace-getint-int sol i))))
	   (format t "~%" "endline")
         do (gecol:delete-gecolspace sol))
      (gecol:delete-dfs e)
      (gecol:delete-gecolspace s)
      (print "fin"))
  )
)

; examples of inputs for the polygon function
(defvar *input* (make-array 4 :initial-contents '(0 3 6 9)))
(defvar *input2* (make-array 2 :initial-contents '(0 3)))
(defvar *input3* (make-array 6 :initial-contents '(0 1 4 6 8 10) ))

;;;;;;;;;(polygon-reloaded *input*)

; Find all possible graphs given an array of pitches and the number of inversions desired.
; Input: notes (array of integers), inversions (integer)
; Output: list of graphs represented into matrices (list of list of list of strings) 
(defun hypergraph (notes inversions)
    (let* ((n (array-total-size notes)) (s (gecol:make-gecolspace :intnum (* n n) :intmin 0 :intmax 2))
           (counter-to-str (lambda (x)
               (flet ((digit-to-str (digit)
                 (string (char "0123456789" digit))))
               (do* ((x x (floor x 10))
                   (digits (list (digit-to-str (mod x 10)))
                     (cons (digit-to-str (mod x 10)) digits)))
                   ((zerop (floor x 10)) (apply #'concatenate
                                       'string
                                        digits)))))) 
          )
         (gecol:with-var-arg-array ((loop for i below (* n n) collect (gecol:gecolspace-getint-int s i)) answer)
               (gecol:count-intvarargs-int-intreltype-int-intconlevel s answer 0 :irt-<=
                                                 (- (* n n) (* 2 n)) :icl-def) 
               (gecol:count-intvarargs-int-intreltype-int-intconlevel s answer 2 :irt-=  (* inversions 2) :icl-def) 
	      (dotimes (i n)
		(dotimes (j n)
		  (if (equal i j)
	              (gecol:rel-intvar-intreltype-int-intconlevel s (gecol:gecolspace-getint-int s (+ (* i n) j)) :irt-= 0 :icl-def)

                      (gecol:rel-intvar-intreltype-intvar-intconlevel s (gecol:gecolspace-getint-int s (+ (* i n) j) ) :irt-=
                                                                      (gecol:gecolspace-getint-int s (+ i (* j n))) :icl-def)
		  )
	      ) )
              (gecol:branch-intvarargs-bvarsel-bvalsel s answer :bvar-size-min :bval-max) 
         )
     (let ((e (gecol:make-dfs-space-int-int-stop s)) (output nil))
      (loop
         for sol = (gecol:dfs-next e)
         until (cffi:null-pointer-p sol)

         do 
         
         (setf output (append output (list (loop for i below n collect 
               (loop for j below n collect  
                   (if (equal (gecol:intvar-val (gecol:gecolspace-getint-int sol (+ (* i n) j)))    1) ; transposition
		        (concatenate 'string "T" (funcall counter-to-str (mod (- (aref notes i) (aref notes j)) 12)  ) )
		      (if (equal (gecol:intvar-val (gecol:gecolspace-getint-int sol (+ (* i n) j)))    2) ; inversion
			  (concatenate 'string "I" (funcall counter-to-str (mod (+ (aref notes i) (aref notes j)) 12)  ) )
			   "--" ; there is not an arc
		       )
		  )
               )   
         ))))
      do (gecol:delete-gecolspace sol))
      (gecol:delete-dfs e)
      (gecol:delete-gecolspace s)
      output)
  ))

(defvar *notes* (make-array 3 :initial-contents '(3 10 11))) ;Eb Bb B
(defvar *notes4* (make-array 4 :initial-contents '(3 4 10 11))) ; Eb E Bb B 
(defvar *notes5* (make-array 5 :initial-contents '(3 5 6 10 11))) ; Eb F F# Bb B

;;;;;; (hypergraph *notes* 1)


; Find all possible graphs given an array of pitches and the number of inversions desired.
; Input: notes (array of integers), inversions (integer)
; Output: list of graphs represented into matrices (list of list of list of strings) 
; Side Effect: It opens some windows with each solutions using the LispWorks CAPI package.
(defun hypergraph-openmusic (notes inversions)
    (let* ((n (array-total-size notes)) (s (gecol:make-gecolspace :intnum (* n n) :intmin 0 :intmax 2)) ; the output is a NxN array of integers
           (counter-to-str (lambda (x) ; This is made to write expressions such as I2, T11, etc
               (flet ((digit-to-str (digit)
                 (string (char "0123456789" digit))))
               (do* ((x x (floor x 10))
                   (digits (list (digit-to-str (mod x 10)))
                     (cons (digit-to-str (mod x 10)) digits)))
                   ((zerop (floor x 10)) (apply #'concatenate
                                       'string
                                        digits))))))  )
    
          
         (gecol:with-var-arg-array ((loop for i below (* n n) collect (gecol:gecolspace-getint-int s i)) answer)
               (gecol:count-intvarargs-int-intreltype-int-intconlevel s answer 0 :irt-<=
                                                 (- (* n n) (* 2 n)) :icl-def) ; This means that the number of inversions and transpositions are > 2xN
               (gecol:count-intvarargs-int-intreltype-int-intconlevel s answer 2 :irt-=  (* inversions 2) :icl-def) ; there are exactly 2xinversion (because of the simetries)
	      (dotimes (i n)
		(dotimes (j n)
		  (if (equal i j)
	              (gecol:rel-intvar-intreltype-int-intconlevel s (gecol:gecolspace-getint-int s (+ (* i n) j)) :irt-= 0 :icl-def) ; There is not an arc between i and i

                      (gecol:rel-intvar-intreltype-intvar-intconlevel s (gecol:gecolspace-getint-int s (+ (* i n) j) ) :irt-=
                                                                      (gecol:gecolspace-getint-int s (+ i (* j n))) :icl-def) ; If there is an arc i,j there is an arc j,i (because of the simetries)
		  )
	      ) )
              (gecol:branch-intvarargs-bvarsel-bvalsel s answer :bvar-size-min :bval-max) 
         )
     (let ((e (gecol:make-dfs-space-int-int-stop s)) (output nil))
      (loop
         for sol = (gecol:dfs-next e)
         until (cffi:null-pointer-p sol)

         do 
  
         (setf output (append output (list (loop for i below n collect 
               (loop for j below n collect  
                   (if (equal (gecol:intvar-val (gecol:gecolspace-getint-int sol (+ (* i n) j)))    1) ; 1 = transposition
		        (concatenate 'string "T" (funcall counter-to-str (mod (- (aref notes i) (aref notes j)) 12)  ) )
		      (if (equal (gecol:intvar-val (gecol:gecolspace-getint-int sol (+ (* i n) j)))    2) ; 2 = inversion
			  (concatenate 'string "I" (funcall counter-to-str (mod (+ (aref notes i) (aref notes j)) 12)  ) )
			   "--" ; 0 = there is not an arc
		       )
		  )
               )   
         ))))

  (capi:contain 
   (make-instance 'capi:graph-pane
                  :roots '(0)
                  :layout-function  #'(lambda (self  &key force) ; layout function presented on CAPI examples
	 (declare (ignore force))
  (let ((nodes (capi:graph-pane-nodes self)))
    (loop for node in nodes
          for max-node = 10
          for pos from 0
          for rad = (* (/ pos max-node) 2 PI)
          for width from 100 by 10
          for X = (floor (+ (* width (cos rad)) 250))
          for Y = (floor (+ (* width (sin (- rad))) 250))
          do (setf (capi:graph-node-x node) X
                   (capi:graph-node-y node) Y))))	   
 
                  :children-function 
                  #'(lambda(i) ;FIXME, this allows to make childrens that do not exists in the graph, when you click on some vertices
		      (let ( (childrens nil) ) (loop for j below n do (if (and (< i n) (not (= j 0))) (setf childrens (append childrens (list j))))) childrens )
		 
		      )
                  :edge-pane-function 
                  #'(lambda(self from to)
                      (declare (ignore self))
                      (let ((use-arrow (zerop (mod from 2)))
                            (use-label (zerop (mod to 2))))
                        (apply
                         'make-instance 
                         (if use-arrow
                             (if use-label
                                 'capi:labelled-arrow-pinboard-object
                               'capi:arrow-pinboard-object)
                           (if use-label
                               'capi:labelled-line-pinboard-object
                             'capi:line-pinboard-object))
                         (when use-label
                           (list :data


  (if (equal (gecol:intvar-val (gecol:gecolspace-getint-int sol (+ (* from n) to)))    1) ; transposition
		        (concatenate 'string "T" (funcall counter-to-str (mod (- (aref notes from) (aref notes to)) 12)  ) )
		      (if (equal (gecol:intvar-val (gecol:gecolspace-getint-int sol (+ (* from n) to)))    2) ; inversion
			  (concatenate 'string "I" (funcall counter-to-str (mod (+ (aref notes from) (aref notes to)) 12)  ) )
			   "X" ; there is not an arc
		       )
		  )  


    )))))
                  :interaction :extended-selection)
   :best-width 400
   :best-height 400)


      do (gecol:delete-gecolspace sol))
      (gecol:delete-dfs e)
      (gecol:delete-gecolspace s)
      output)
  ))


;;;;(hypergraph-openmusic *notes* 1)
;;;;(hypergraph-openmusic *notes4* 4) ; caution, it opens around 10000 windows.

; Find all solutions for the n-queens problem presented in queens.cc
(defun queensAll (size)
    (let ((s (gecol:make-gecolspace :intnum size :intmin 0 :intmax (- size 1))))
     
       (gecol:with-var-arg-array ((loop for i below size collect (gecol:gecolspace-getint-int s i)) q)
         
         (gecol:with-var-arg-array ((loop for i below size collect i) c1 :type :int)
 
           (gecol:with-var-arg-array ((loop for i below size collect (* -1 i)) c2 :type :int)
              (gecol:distinct-intargs-intvarargs-intconlevel s c1 q :icl-def)
              (gecol:distinct-intargs-intvarargs-intconlevel s c2 q :icl-def)
              (gecol:distinct-intvarargs-intconlevel s q :icl-def)
              (gecol:branch-intvarargs-bvarsel-bvalsel s q :bvar-size-min :bval-min) 

       )))
    (let ((e (gecol:make-dfs-space-int-int-stop s)))
      (loop
         for sol = (gecol:dfs-next e)
         until (cffi:null-pointer-p sol)
         do 
	   (dotimes (i size) (format t "~a,"   (gecol:intvar-val (gecol:gecolspace-getint-int sol i))))
	   (format t "~%" "endline")

         do (gecol:delete-gecolspace sol))
      (gecol:delete-dfs e)
      (gecol:delete-gecolspace s)
      (print "fin"))
  )
)

;;;;(queensall 8)

; find one solution to the n-queens problem presented in queens.cc
(defun queensOne (size)
    (let ((s (gecol:make-gecolspace :intnum size :intmin 0 :intmax (- size 1))))
     
       (gecol:with-var-arg-array ((loop for i below size collect (gecol:gecolspace-getint-int s i)) q)
         
         (gecol:with-var-arg-array ((loop for i below size collect i) c1 :type :int)
 
           (gecol:with-var-arg-array ((loop for i below size collect (* -1 i)) c2 :type :int)
              (gecol:distinct-intargs-intvarargs-intconlevel s c1 q :icl-def)
              (gecol:distinct-intargs-intvarargs-intconlevel s c2 q :icl-def)
              (gecol:distinct-intvarargs-intconlevel s q :icl-def)
              (gecol:branch-intvarargs-bvarsel-bvalsel s q :bvar-size-min :bval-min) 

       )))
    (let* ((e (gecol:make-dfs-space-int-int-stop s)) (sol (gecol:dfs-next e)) )
      
         
        
	   (dotimes (i size) (format t "~a,"   (gecol:intvar-val (gecol:gecolspace-getint-int sol i))))
	   (format t "~%" "endline")

      (gecol:delete-gecolspace sol)
      (gecol:delete-dfs e)
      (gecol:delete-gecolspace s)
      (print "fin")
    )
  )
)

;;;;(queensone 8)


; The stress-distinct provided in stress-distinc.cc
; 0.096 running in Gecol
; 0.046 running in Gecode
(defun stress-distinct (size)
    (let ((s (gecol:make-gecolspace :intnum (+ size 1) :intmin 0 :intmax size)))
     (gecol:with-var-arg-array ((loop for i below (+ size 1) collect (gecol:gecolspace-getint-int s i)) x)
              (dotimes (i size) 
    (gecol:rel-intvar-intreltype-int-intconlevel  s (gecol:gecolspace-getint-int s i) :irt-<= i :icl-def  )
               )
              (gecol:distinct-intvarargs-intconlevel s x :icl-def)
              (gecol:branch-intvarargs-bvarsel-bvalsel s x :bvar-none :bval-min) 
    )   
   (let* ((e (gecol:make-dfs-space-int-int-stop s)) (sol (gecol:dfs-next e)) )  
	   (dotimes (i (+ size 1)) (format t "~a,"   (gecol:intvar-val (gecol:gecolspace-getint-int sol i))))
	   (format t "~%" "endline")
      (gecol:delete-gecolspace sol)
      (gecol:delete-dfs e)
      (gecol:delete-gecolspace s)
      (print "fin")
)))

;;; (stress-distinct 1000)


; The eq20 example presented in eq20.cc
; 0.014 running in Gecode
; 0.060 running in Gecol
(defun eq202 ()
    (let ((s (gecol:make-gecolspace :intnum 7 :intmin 0 :intmax 10)))
     (gecol:with-var-arg-array ((loop for i below 7 collect (gecol:gecolspace-getint-int s i)) x)
       (gecol:with-var-arg-array ('( -16105  62397  -6704  43340  95100  -68610  58301) c :type :int) 
          (gecol:linear-intargs-intvarargs-intreltype-int-intconlevel s c x :irt-=  876370 :icl-def)

        (gecol:with-var-arg-array ('(51637  67761  95951  3834  -96722  59190  15280) c :type :int) 
          (gecol:linear-intargs-intvarargs-intreltype-int-intconlevel s c x :irt-=  533909 :icl-def)

       (gecol:with-var-arg-array ('( 1671  -34121  10763  80609  42532  93520  -33488) c :type :int) 
          (gecol:linear-intargs-intvarargs-intreltype-int-intconlevel s c x :irt-=  915683 :icl-def)

       (gecol:with-var-arg-array ('(71202  -11119  73017  -38875  -14413  -29234  72370) c :type :int) 
          (gecol:linear-intargs-intvarargs-intreltype-int-intconlevel s c x :irt-=  129768 :icl-def)

       (gecol:with-var-arg-array ('(8874  -58412  73947  17147  62335  16005  8632) c :type :int) 
          (gecol:linear-intargs-intvarargs-intreltype-int-intconlevel s c x :irt-=  752447 :icl-def)

       (gecol:with-var-arg-array ('(85268  54180  -18810  -48219  6013  78169  -79785) c :type :int) 
          (gecol:linear-intargs-intvarargs-intreltype-int-intconlevel s c x :irt-=  90614  :icl-def)

       (gecol:with-var-arg-array ('( -45086  51830  -4578  96120  21231  97919  65651) c :type :int) 
          (gecol:linear-intargs-intvarargs-intreltype-int-intconlevel s c x :irt-=  1198280 :icl-def)

       (gecol:with-var-arg-array ('( -64919  80460  90840  -59624  -75542  25145  -47935) c :type :int) 
          (gecol:linear-intargs-intvarargs-intreltype-int-intconlevel s c x :irt-= 18465 :icl-def)

       (gecol:with-var-arg-array ('( -43277  43525  92298  58630  92590  -9372  -60227) c :type :int) 
          (gecol:linear-intargs-intvarargs-intreltype-int-intconlevel s c x :irt-=  1503588 :icl-def)

       (gecol:with-var-arg-array ('( -16835  47385  97715  -12640  69028  76212  -81102) c :type :int) 
          (gecol:linear-intargs-intvarargs-intreltype-int-intconlevel s c x :irt-=  1244857 :icl-def)

       (gecol:with-var-arg-array ('(  -60301  31227  93951  73889  81526  -72702  68026) c :type :int) 
          (gecol:linear-intargs-intvarargs-intreltype-int-intconlevel s c x :irt-=  1410723 :icl-def)

       (gecol:with-var-arg-array ('( 94016  -82071  35961  66597  -30705  -44404  -38304) c :type :int) 
          (gecol:linear-intargs-intvarargs-intreltype-int-intconlevel s c x :irt-=  25334  :icl-def)

       (gecol:with-var-arg-array ('( -67456  84750  -51553  21239  81675  -99395  -4254) c :type :int) 
          (gecol:linear-intargs-intvarargs-intreltype-int-intconlevel s c x :irt-= 277271 :icl-def)

       (gecol:with-var-arg-array ('( -85698  29958  57308  48789  -78219  4657  34539) c :type :int) 
          (gecol:linear-intargs-intvarargs-intreltype-int-intconlevel s c x :irt-=  249912 :icl-def)

       (gecol:with-var-arg-array ('( 85176  -95332  -1268  57898  15883  50547  83287) c :type :int) 
          (gecol:linear-intargs-intvarargs-intreltype-int-intconlevel s c x :irt-=  373854 :icl-def)

       (gecol:with-var-arg-array ('(  -10343  87758  -11782  19346  70072  -36991  44529) c :type :int) 
          (gecol:linear-intargs-intvarargs-intreltype-int-intconlevel s c x :irt-=  740061 :icl-def)

       (gecol:with-var-arg-array ('(49149  52871  -7132  56728  -33576  -49530  -62089) c :type :int) 
          (gecol:linear-intargs-intvarargs-intreltype-int-intconlevel s c x :irt-=  146074 :icl-def)

       (gecol:with-var-arg-array ('(-60113  29475  34421  -76870  62646  29278  -15212) c :type :int) 
          (gecol:linear-intargs-intvarargs-intreltype-int-intconlevel s c x :irt-=  251591  :icl-def)

       (gecol:with-var-arg-array ('( 87059  -29101  -5513  -21219  22128  7276  57308) c :type :int) 
          (gecol:linear-intargs-intvarargs-intreltype-int-intconlevel s c x :irt-=  22167   :icl-def)

       (gecol:with-var-arg-array ('( -76706  98205  23445  67921  24111  -48614  -41906) c :type :int) 
          (gecol:linear-intargs-intvarargs-intreltype-int-intconlevel s c x :irt-=  821228   :icl-def)

          (gecol:branch-intvarargs-bvarsel-bvalsel s x :bvar-none :bval-min) 

     ) ))))))))))))))))))))
    (let* ((e (gecol:make-dfs-space-int-int-stop s)) (sol (gecol:dfs-next e)) )
      
         
        
	   (dotimes (i 7) (format t "~a,"   (gecol:intvar-val (gecol:gecolspace-getint-int sol i))))
	   (format t "~%" "endline")

      (gecol:delete-gecolspace sol)
      (gecol:delete-dfs e)
      (gecol:delete-gecolspace s)
      (print "fin")
    )
  )
)

;;;(eq202)

; This example shows how to use the set interface to obtaint the difference between sets A B.
; C = A - B. IN this case A = (1,2,3,4,5) and B = (3,4,5,6,7,8) then C = (1,2)
(defun setdif ()
    (let* (
	   (s (gecol:make-gecolspace :setnum 1) )
	   (a (gecol:gec-fs-make s))
	   (b (gecol:gec-fs-make s))
	   (c (gecol:gecolspace-getset-int s 0))
          )
      
       (gecol:dom-setvar-setreltype-int-int s a :srt-eq  1 5) ;0 = :srt-eq
       (gecol:dom-setvar-setreltype-int-int s b :srt-eq  3 8)
       (gecol:rel-setvar-setoptype-setvar-setreltype-setvar s a :sot-minus b :srt-eq c )
       (gecol:branch-setvarbranch-setvalbranch s :set-var-none :set-val-min)
      
    (let* ((e (gecol:make-dfs-space-int-int-stop s)) (sol (gecol:dfs-next e)) )
           (print (gecol:gec-fs-value (gecol:gecolspace-getset-int sol 0)))
	   (format t "~%" "endline")

      (gecol:delete-gecolspace sol)
      (gecol:delete-dfs e)
      (gecol:delete-gecolspace s)
      (print "fin")
    )
  )
)

;;;;(setdif )

;;;;;; TESTING EXAMPLES :: WARNING THEY MAY CRASH ;;;;;;;;;;;;;;

; Apply the regexp constraint 0.1.(0|1).1* to an integer array of size 5
; The solutions should be <0,1,0,1,1> and <0,1,1,1,1>
; fix me, it crashes
(defun regexp ()
  (let ((s (gecol:make-gecolspace :intnum 5 :intmin 0 :intmax 1)) (exp (gecol:make-REG-void) ) )
    (gecol:with-var-arg-array ((loop for i below 5 collect (gecol:gecolspace-getint-int s i))
                               varargs)
      
 
        (setf exp (gecol:r+ (gecol:r+ (gecol:make-REG-int 0) 
			      (gecol:r+ (gecol:make-REG-int 1)
					(gecol:ror (gecol:make-REG-int 0)
						   (gecol:make-REG-int 1)
					 )
			       )
			      ) 
			      (gecol:r* (gecol:make-REG-int 1))
		     )
      )

      
      (gecol:extensional-intvarargs-dfa-intcontlevel s varargs exp :icl-def)
      (gecol:branch-intvarargs-bvarsel-bvalsel s varargs :bvar-none :bval-min))
    (let ((e (gecol:make-dfs-space-int-int-stop s)))
      (loop
         for sol = (gecol:dfs-next e)
         until (cffi:null-pointer-p sol)
        do 
	   (dotimes (i 5) (format t "~a,"   (gecol:intvar-val (gecol:gecolspace-getint-int sol i))))
	   (format t "~%")
         do (gecol:delete-gecolspace sol))
      (gecol:delete-dfs e)
      (gecol:delete-gecolspace s))))

;;;;; (regexp)

; find if it exits a path in a graph using Concurrent Constraint Programming
; FixMe, Even when using the locks, it does not works
(defun graphccp (Arcs AA BB nVertices)
    (let* ( (thelock (mp:make-lock)) 
	   (itExists (+ nVertices nVertices)) 
	   (s (gecol:make-gecolspace :intnum (+ nVertices nVertices 1) :intmin 0 :intmax 1))
	   (ask (lambda (pos) 
		  (mp:process-lock thelock)  
		  (let ( (ret (gecol:intvar-assigned  (gecol:gecolspace-getint-int s pos)) ) )
		    (mp:process-unlock thelock)
		    ret
		   ))
	    )
	   (tell (lambda (who what) 
		  (mp:process-lock thelock)  
		    (gecol:rel-intvar-intreltype-int-intconlevel  (gecol:intvar-val (gecol:gecolspace-getint-int s who)) :irt-= what :icl-def)
		    (mp:process-unlock thelock)
	
		   )
	    )

	 (FowardWhen (lambda (i j)
	   (loop while (not  (ask i)) (gecol:gecolspace-status s))
	   (gecol:gecolspace-status s)
	   (if (equal (gecol:intvar-val (gecol:gecolspace-getint-int s i)) 1)
	       (tell j 1)) 
         ))

	 (BackWhen (lambda (i j)
	   (loop while (not  (ask (+ j n))) (gecol:gecolspace-status s))
	   (gecol:gecolspace-status s)
	   (if (equal (gecol:intvar-val (gecol:gecolspace-getint-int s (+ j n))) 1)
	       (tell (+ i n))) 
         ))

	  (AndWhen (lambda (i j)
	   (loop while (not  (and (ask i)
                                  (ask (+ j n))  )) (gecol:gecolspace-status s))
	   (gecol:gecolspace-status s)
	   (if (and (equal (gecol:intvar-val (gecol:gecolspace-getint-int s i)) 1) (equal (gecol:intvar-val (gecol:gecolspace-getint-int s (+ j n ))) 1))
	       (tell itexists 1)) 
         ))

	 ( ExistsPathAux  (lambda (i j)
	   (mp:process-run-function "fowardpath i j" nil FowardWhen i j)
	   (mp:process-run-function "backpath i j" nil BackWhen i j)
	   (mp:process-run-function "andspath i j" nil AndWhen i j)
	 ))
	    
	  )
     
       (gecol:with-var-arg-array ((loop for i below itExists collect (gecol:gecolspace-getint-int s i)) root)

	(funcall tell AA 1)
        (funcall tell (+ n BB) 1)  

	 (loop for (a b) in Arcs do (mp:process-run-function "existspath i j" nil ExistsPathAux i j))
        
         (gecol:branch-intvarargs-bvarsel-bvalsel s root :bvar-size-min :bval-min) 

       )
   (let ((e (gecol:make-dfs-space-int-int-stop s)))
      (loop
         for sol = (gecol:dfs-next e)
         until (cffi:null-pointer-p sol)
         do 
	   (dotimes (i itExists) (format t "~a,"   (gecol:intvar-val (gecol:gecolspace-getint-int sol i))))
	   (format t "~%")

         do (gecol:delete-gecolspace sol))
      (gecol:delete-dfs e)
      (gecol:delete-gecolspace s)
      (print "fin"))
  )
)

;;;(graphccp '((0 1) (1 2) (3 2) (2 4) (2 5) (2 6) (4 7) (5 7) (6 7) (6 8)) 0 7 9)