Commit f91a7a93 authored by kilian.sprotte's avatar kilian.sprotte

indent

darcs-hash:a85160d0dfda28b8b82509f62e56f18493aca9f3
parent b5de86cc
......@@ -31,104 +31,103 @@
;; TODO maybe use gecol:intvar-assigned
(defun cartesian-product ()
(let ((s (gecol:make-gecolspace :intnum 3 :intmin 1 :intmax 3)))
(let ((s (gecol:make-gecolspace :intnum 3 :intmin 1 :intmax 3)))
(gecol:with-var-arg-array ((loop for i below 3 collect (gecol:gecolspace-getint-int s i))
varargs)
varargs)
(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 (format t "~a, ~a, ~a~%"
(gecol:intvar-val (gecol:gecolspace-getint-int sol 0))
(gecol:intvar-val (gecol:gecolspace-getint-int sol 1))
(gecol:intvar-val (gecol:gecolspace-getint-int sol 2)))
do (gecol:delete-gecolspace sol))
for sol = (gecol:dfs-next e)
until (cffi:null-pointer-p sol)
do (format t "~a, ~a, ~a~%"
(gecol:intvar-val (gecol:gecolspace-getint-int sol 0))
(gecol:intvar-val (gecol:gecolspace-getint-int sol 1))
(gecol:intvar-val (gecol:gecolspace-getint-int sol 2)))
do (gecol:delete-gecolspace sol))
(gecol:delete-dfs e)
(gecol:delete-gecolspace s))))
(defun distinct ()
(let ((s (gecol:make-gecolspace :intnum 3 :intmin 1 :intmax 3)))
(let ((s (gecol:make-gecolspace :intnum 3 :intmin 1 :intmax 3)))
(gecol:with-var-arg-array ((loop for i below 3 collect (gecol:gecolspace-getint-int s i))
varargs)
varargs)
(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 (format t "~a, ~a, ~a~%"
(gecol:intvar-val (gecol:gecolspace-getint-int sol 0))
(gecol:intvar-val (gecol:gecolspace-getint-int sol 1))
(gecol:intvar-val (gecol:gecolspace-getint-int sol 2)))
do (gecol:delete-gecolspace sol))
for sol = (gecol:dfs-next e)
until (cffi:null-pointer-p sol)
do (format t "~a, ~a, ~a~%"
(gecol:intvar-val (gecol:gecolspace-getint-int sol 0))
(gecol:intvar-val (gecol:gecolspace-getint-int sol 1))
(gecol:intvar-val (gecol:gecolspace-getint-int sol 2)))
do (gecol:delete-gecolspace sol))
(gecol:delete-dfs e)
(gecol:delete-gecolspace s))))
(defun sorted ()
(let ((s (gecol:make-gecolspace :intnum 3 :intmin 1 :intmax 3)))
(gecol:rel-intvar-intreltype-intvar-intconlevel s
(gecol:gecolspace-getint-int s 0)
:irt-<
(gecol:gecolspace-getint-int s 1)
:icl-def)
(gecol:gecolspace-getint-int s 0)
:irt-<
(gecol:gecolspace-getint-int s 1)
:icl-def)
(gecol:rel-intvar-intreltype-intvar-intconlevel s
(gecol:gecolspace-getint-int s 1)
:irt-<
(gecol:gecolspace-getint-int s 2)
:icl-def)
(gecol:gecolspace-getint-int s 1)
:irt-<
(gecol:gecolspace-getint-int s 2)
:icl-def)
(gecol:with-var-arg-array ((loop for i below 3 collect (gecol:gecolspace-getint-int s i))
varargs)
varargs)
(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 (format t "~a, ~a, ~a~%"
(gecol:intvar-val (gecol:gecolspace-getint-int sol 0))
(gecol:intvar-val (gecol:gecolspace-getint-int sol 1))
(gecol:intvar-val (gecol:gecolspace-getint-int sol 2)))
do (gecol:delete-gecolspace sol))
for sol = (gecol:dfs-next e)
until (cffi:null-pointer-p sol)
do (format t "~a, ~a, ~a~%"
(gecol:intvar-val (gecol:gecolspace-getint-int sol 0))
(gecol:intvar-val (gecol:gecolspace-getint-int sol 1))
(gecol:intvar-val (gecol:gecolspace-getint-int sol 2)))
do (gecol:delete-gecolspace sol))
(gecol:delete-dfs e)
(gecol:delete-gecolspace s))))
(defun cartesian-product-distr-max ()
"Like cartesian-product, but using a different branching."
(let ((s (gecol:make-gecolspace :intnum 3 :intmin 1 :intmax 3)))
(let ((s (gecol:make-gecolspace :intnum 3 :intmin 1 :intmax 3)))
(gecol:with-var-arg-array ((loop for i below 3 collect (gecol:gecolspace-getint-int s i))
varargs)
varargs)
;; branching
(gecol:branch-intvarargs-bvarsel-bvalsel s varargs :bvar-none :bval-max))
(let ((e (gecol:make-dfs-space-int-int-stop s)))
(loop
for sol = (gecol:dfs-next e)
until (cffi:null-pointer-p sol)
do (format t "~a, ~a, ~a~%"
(gecol:intvar-val (gecol:gecolspace-getint-int sol 0))
(gecol:intvar-val (gecol:gecolspace-getint-int sol 1))
(gecol:intvar-val (gecol:gecolspace-getint-int sol 2)))
do (gecol:delete-gecolspace sol))
for sol = (gecol:dfs-next e)
until (cffi:null-pointer-p sol)
do (format t "~a, ~a, ~a~%"
(gecol:intvar-val (gecol:gecolspace-getint-int sol 0))
(gecol:intvar-val (gecol:gecolspace-getint-int sol 1))
(gecol:intvar-val (gecol:gecolspace-getint-int sol 2)))
do (gecol:delete-gecolspace sol))
(gecol:delete-dfs e)
(gecol:delete-gecolspace s))))
(defun distinct-minimal-third ()
"Like distinct, but minimizing the third variable."
(let ((s (gecol:make-gecolspace :intnum 3 :intmin 1 :intmax 3
:bab-intvar-ind 2 :bab-intreltype :irt-<)))
:bab-intvar-ind 2 :bab-intreltype :irt-<)))
(gecol:with-var-arg-array ((loop for i below 3 collect (gecol:gecolspace-getint-int s i))
varargs)
varargs)
(gecol:distinct-intvarargs-intconlevel s varargs :icl-def)
(gecol:branch-intvarargs-bvarsel-bvalsel s varargs :bvar-none :bval-min))
(let ((e (gecol:make-bab-space-int-int-stop s)))
(loop
for sol = (gecol:bab-next e)
until (cffi:null-pointer-p sol)
do (format t "~a, ~a, ~a~%"
(gecol:intvar-val (gecol:gecolspace-getint-int sol 0))
(gecol:intvar-val (gecol:gecolspace-getint-int sol 1))
(gecol:intvar-val (gecol:gecolspace-getint-int sol 2)))
do (gecol:delete-gecolspace sol))
for sol = (gecol:bab-next e)
until (cffi:null-pointer-p sol)
do (format t "~a, ~a, ~a~%"
(gecol:intvar-val (gecol:gecolspace-getint-int sol 0))
(gecol:intvar-val (gecol:gecolspace-getint-int sol 1))
(gecol:intvar-val (gecol:gecolspace-getint-int sol 2)))
do (gecol:delete-gecolspace sol))
(gecol:delete-bab e)
(gecol:delete-gecolspace s))))
;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: GECOL; Base: 10 -*-
;;; arch-tag: 09C25807-504D-487A-B9D3-275276CF17B1
......@@ -41,35 +40,35 @@
:ss-branch)
(defcenum int-rel-type
:irt-= ; =
:irt-/= ; /=
:irt-<= ; <=
:irt-< ; <
:irt->= ; >=
:irt-> ; >
:irt-= ; =
:irt-/= ; /=
:irt-<= ; <=
:irt-< ; <
:irt->= ; >=
:irt-> ; >
)
(defcenum int-con-level
:icl-val ; Value consistency (naive)
:icl-bnd ; Bounds consistency.
:icl-dom ; Domain consistency.
:icl-def ;The default consistency for a constraint.
:icl-val ; Value consistency (naive)
:icl-bnd ; Bounds consistency.
:icl-dom ; Domain consistency.
:icl-def ;The default consistency for a constraint.
)
(defcenum set-rel-type
:srt-eq ; equality
:srt-nq ; disequality
:srt-sub ; subset
:srt-sup ; superset
:srt-disj ; disjoint
:srt-cmpl ; complement
:srt-eq ; equality
:srt-nq ; disequality
:srt-sub ; subset
:srt-sup ; superset
:srt-disj ; disjoint
:srt-cmpl ; complement
)
(defcenum set-op-type
:sot-union ; union
:sot-dunion ; disjoint union
:sot-inter ; intersection
:sot-minus ; difference
:sot-union ; union
:sot-dunion ; disjoint union
:sot-inter ; intersection
:sot-minus ; difference
)
(defcenum bvar-sel
......@@ -148,7 +147,7 @@
(intmax :int)
(boolnum :int)
(setnum :int)
(bab-intvar-ind :int)
(bab-intvar-ind :int)
(bab-intreltype int-rel-type))
(defcfun* ("delete_GecolSpace" delete-gecolspace) :void
......@@ -234,8 +233,8 @@ SetVar by using GEC-FS-MAKE-*."
;;;;;;;;;
(defcfun*
("branch_intvarargs_bvarsel_bvalsel" branch-intvarargs-bvarsel-bvalsel) :void
(home :pointer) (x :pointer) (vars bvar-sel) (vals bval-sel))
("branch_intvarargs_bvarsel_bvalsel" branch-intvarargs-bvarsel-bvalsel) :void
(home :pointer) (x :pointer) (vars bvar-sel) (vals bval-sel))
(defcfun*
("linear_intvarargs_intreltype_int_intconlevel"
linear-intvarargs-intreltype-int-intconlevel)
......@@ -652,9 +651,9 @@ The dom pointers are int arrays."
(defcfun* ("distinct_setvarargs_unsigned_int" distinct-setvarargs-unsigned-int)
:void (home :pointer) (x :pointer) (c :unsigned-int))
(defcfun* ("min_setvar_intvar" min-setvar-intvar) :void (home :pointer)
(s :pointer) (x :pointer))
(s :pointer) (x :pointer))
(defcfun* ("max_setvar_intvar" max-setvar-intvar) :void (home :pointer)
(s :pointer) (x :pointer))
(s :pointer) (x :pointer))
(defcfun* ("match_setvar_intvarargs" match-setvar-intvarargs) :void
(home :pointer) (s :pointer) (x :pointer))
(defcfun* ("channel_intvarargs_setvarargs" channel-intvarargs-setvarargs) :void
......@@ -744,7 +743,7 @@ The dom pointers are int arrays."
:void (home :pointer) (x :pointer) (op set-op-type) (y :pointer)
(r set-rel-type) (z :pointer))
(defcfun* ("sequence_setvarargs" sequence-setvarargs) :void (home :pointer)
(x :pointer))
(x :pointer))
(defcfun*
("sequentialUnion_setvarargs_setvar" sequentialunion-setvarargs-setvar) :void
(home :pointer) (y :pointer) (x :pointer))
......@@ -769,4 +768,3 @@ The dom pointers are int arrays."
("cardinality_setvar_unsigned_int_unsigned_int"
cardinality-setvar-unsigned-int-unsigned-int)
:void (home :pointer) (x :pointer) (i :unsigned-int) (j :unsigned-int))
......@@ -31,13 +31,13 @@
;;; GecolSpace
(defun make-gecolspace (&key
(intnum 0)
(intmin 0)
(intmax 2)
(boolnum 0)
(setnum 0)
(bab-intvar-ind 0)
(bab-intreltype :irt->))
(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
......@@ -53,17 +53,17 @@
(unless (zerop (gec-fs-glb-size set))
(iter
(for potential-elt from (gec-fs-glb-max set)
downto (gec-fs-glb-min set))
downto (gec-fs-glb-min set))
(when (gec-fs-contains set potential-elt)
(collect potential-elt at beginning)))))
(collect potential-elt at beginning)))))
(defun gec-fs-enumerate-upper-bound (set)
(unless (zerop (gec-fs-lub-size set))
(iter
(for potential-elt from (gec-fs-lub-max set)
downto (gec-fs-lub-min set))
downto (gec-fs-lub-min set))
(unless (gec-fs-not-contains set potential-elt)
(collect potential-elt at beginning)))))
(collect potential-elt at beginning)))))
(defun gec-fs-value (set)
"Assumes that SET is assigned."
......@@ -75,19 +75,19 @@
(check-type size symbol)
(let ((=list= (gensym "LIST")))
`(let* ((,=list= ,list)
(,size (length ,=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))))
(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))
(export 'with-var-arg-array)
;;; TODO - we will use this /a lot/. So you should
;;; try to make the generated code as small as possible.
......@@ -95,17 +95,17 @@
(check-type var symbol)
(let ((=list= (gensym "LIST")))
`(let* ((,=list= ,list)
(list-len (length ,=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))))))
(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"
......@@ -113,4 +113,3 @@
(with-var-arg-array ((list a b) a-b)
(gecol:linear-intargs-intvarargs-intreltype-intvar-intconlevel
space coeffs a-b :irt-= c :icl-def))))
......@@ -34,14 +34,14 @@
(defvar *gcc* "/usr/bin/gcc")
(defvar *gcc-options* '(#-darwin "-shared"
#+darwin "-dynamiclib"
"-fPIC"
"-lgecodesearch"
"-lgecodekernel"
"-lgecodeint"
"-lgecodeset"
"-lgecodeminimodel"
"-lstdc++"))
#+darwin "-dynamiclib"
"-fPIC"
"-lgecodesearch"
"-lgecodekernel"
"-lgecodeint"
"-lgecodeset"
"-lgecodeminimodel"
"-lstdc++"))
(defclass gecode-source-file (source-file)
())
......@@ -52,8 +52,8 @@
(defmethod output-files ((o compile-op) (c gecode-source-file))
(list (make-pathname :name (component-name c)
:type "so"
:defaults (component-pathname c))))
:type "so"
:defaults (component-pathname c))))
(defmethod perform ((o load-op) (c gecode-source-file))
(let ((loader (intern "LOAD-FOREIGN-LIBRARY" :cffi)))
......@@ -62,10 +62,10 @@
(defmethod perform ((o compile-op) (c gecode-source-file))
(unless (zerop (run-shell-command "~A ~A ~{~A ~}-o ~A"
*gcc*
(namestring (component-pathname c))
*gcc-options*
(namestring (car (output-files o c)))))
*gcc*
(namestring (component-pathname c))
*gcc-options*
(namestring (car (output-files o c)))))
(error 'operation-error :component c :operation o)))
......
......@@ -42,9 +42,9 @@ protected:
IntRelType bab_intreltype;
public:
GecolSpace(int intnum, int intmin, int intmax,
int boolnum,
int setnum,
int arg_bab_intvar_ind, IntRelType arg_bab_intreltype)
int boolnum,
int setnum,
int arg_bab_intvar_ind, IntRelType arg_bab_intreltype)
: ints(this, intnum, intmin, intmax),
bools(this, boolnum, 0, 1),
sets(this,setnum),
......@@ -125,13 +125,13 @@ extern "C" {
void delete_IntVar(IntVar *v);
// GecolSpace
GecolSpace* make_GecolSpace(int intnum, int intmin, int intmax, int boolnum, int setnum,
int bab_intvar_ind, IntRelType bab_intreltype);
int bab_intvar_ind, IntRelType bab_intreltype);
void delete_GecolSpace(GecolSpace* space);
IntVar* GecolSpace_getInt_int(GecolSpace* space, int ind);
BoolVar* GecolSpace_getBool_int(GecolSpace* space, int ind);
SetVar* GecolSpace_getSet_int(GecolSpace* space, int ind);
void GecolSpace_putSet_int_SetVar(GecolSpace* space, int ind, SetVar* set);
SpaceStatus GecolSpace_status(GecolSpace* space);
SpaceStatus GecolSpace_status(GecolSpace* space);
const BranchingDesc* GecolSpace_description(GecolSpace* space);
Space* GecolSpace_clone(GecolSpace* space, bool share);
void GecolSpace_commit(GecolSpace* space, const BranchingDesc *d, unsigned int a);
......@@ -363,10 +363,10 @@ void delete_IntVar(IntVar *v)
// GecolSpace
GecolSpace* make_GecolSpace(int intnum, int intmin, int intmax, int boolnum, int setnum,
int bab_intvar_ind, IntRelType bab_intreltype)
int bab_intvar_ind, IntRelType bab_intreltype)
{
return new GecolSpace(intnum, intmin, intmax, boolnum, setnum,
bab_intvar_ind, bab_intreltype);
bab_intvar_ind, bab_intreltype);
}
void delete_GecolSpace(GecolSpace* space)
......@@ -1163,7 +1163,6 @@ void mult_intvar_intvar_intvar_intconlevel(Space *home, IntVar *x0, IntVar *x1,
}
// Sets
SetVar* gec_fs_make_const(GecolSpace* space, int card, int *dom)
{
......@@ -1508,4 +1507,3 @@ void cardinality_setvar_unsigned_int_unsigned_int(Space *home, SetVar *x, unsign
{
Gecode::cardinality(home, *x, i, j);
}
......@@ -59,7 +59,6 @@
#:gec-fs-enumerate-lower-bound
#:gec-fs-enumerate-upper-bound
#:gec-fs-value
;;; utils
;;; utils
#:with-list-as-int-array
))
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment