big update
Annotate for file gec.lisp
2006-12-07 kilian.sprot 1 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: GECOL; Base: 10 -*-
21:06:18 ' 2 ;;; arch-tag: B2840A52-3BDD-47DB-A03F-1C700ACFF6BC
' 3
' 4 ;;; Copyright (c) 2006, Kilian Sprotte. All rights reserved.
' 5
' 6 ;;; Redistribution and use in source and binary forms, with or without
' 7 ;;; modification, are permitted provided that the following conditions
' 8 ;;; are met:
' 9
' 10 ;;; * Redistributions of source code must retain the above copyright
' 11 ;;; notice, this list of conditions and the following disclaimer.
' 12
' 13 ;;; * Redistributions in binary form must reproduce the above
' 14 ;;; copyright notice, this list of conditions and the following
' 15 ;;; disclaimer in the documentation and/or other materials
' 16 ;;; provided with the distribution.
' 17
' 18 ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
' 19 ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
' 20 ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
' 21 ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
' 22 ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
' 23 ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
' 24 ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
' 25 ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
' 26 ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
' 27 ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
' 28 ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
' 29
' 30 (in-package :gecol)
' 31
2007-01-08 kilian.sprot 32 ;;; GecolSpace
01:49:57 ' 33 (defun make-gecolspace (&key
' 34 (intnum 0)
' 35 (intmin 0)
' 36 (intmax 2)
' 37 (boolnum 0)
' 38 (setnum 0)
' 39 (bab-intvar-ind 0)
' 40 (bab-intreltype :irt->))
' 41 (%make-gecolspace intnum intmin intmax boolnum setnum bab-intvar-ind bab-intreltype))
2006-12-07 kilian.sprot 42
2007-01-08 kilian.sprot 43 ;;; DFS
01:49:57 ' 44 (defun make-dfs-space-int-int-stop (space &key (c-d 1) (a-d 1) (stop (cffi:null-pointer)))
' 45 (%make-dfs-space-int-int-stop space c-d a-d stop))
2006-12-07 kilian.sprot 46
2007-01-08 kilian.sprot 47 ;;; BAB
01:49:57 ' 48 (defun make-bab-space-int-int-stop (space &key (c-d 1) (a-d 1) (stop (cffi:null-pointer)))
' 49 (%make-bab-space-int-int-stop space c-d a-d stop))
2006-12-21 kilian.sprot 50
15:40:43 ' 51 ;;; Sets
' 52 (defun gec-fs-enumerate-lower-bound (set)
' 53 (unless (zerop (gec-fs-glb-size set))
' 54 (iter
' 55 (for potential-elt from (gec-fs-glb-max set)
2007-02-06 kilian.sprot 56 downto (gec-fs-glb-min set))
2006-12-21 kilian.sprot 57 (when (gec-fs-contains set potential-elt)
2007-02-06 kilian.sprot 58 (collect potential-elt at beginning)))))
2006-12-21 kilian.sprot 59
15:40:43 ' 60 (defun gec-fs-enumerate-upper-bound (set)
' 61 (unless (zerop (gec-fs-lub-size set))
' 62 (iter
' 63 (for potential-elt from (gec-fs-lub-max set)
2007-02-06 kilian.sprot 64 downto (gec-fs-lub-min set))
2006-12-21 kilian.sprot 65 (unless (gec-fs-not-contains set potential-elt)
2007-02-06 kilian.sprot 66 (collect potential-elt at beginning)))))
2006-12-21 kilian.sprot 67
15:40:43 ' 68 (defun gec-fs-value (set)
' 69 "Assumes that SET is assigned."
' 70 (gec-fs-enumerate-lower-bound set))
' 71
2007-02-06 kilian.sprot 72 ;;; TODO this needs to be optimized (dont iterate over list twice, if possible)
2006-12-21 kilian.sprot 73 (defmacro with-list-as-int-array ((list array size) &body body)
15:40:43 ' 74 (check-type array symbol)
' 75 (check-type size symbol)
' 76 (let ((=list= (gensym "LIST")))
' 77 `(let* ((,=list= ,list)
2007-02-06 kilian.sprot 78 (,size (length ,=list=)))
2006-12-21 kilian.sprot 79 (cffi:with-foreign-object (,array :int ,size)
2007-02-06 kilian.sprot 80 (iter
19:09:14 ' 81 (for elt in ,=list=)
' 82 (for i upfrom 0)
' 83 (setf (cffi:mem-aref ,array :int i) elt))
' 84 ,@body))))
2006-12-21 kilian.sprot 85
2007-01-08 kilian.sprot 86 (defcstruct var-arg-array
01:49:57 ' 87 "actually a lispy version of it, made up for wrapping the original VarArgArray"
' 88 (size :int)
' 89 (array :pointer))
' 90
' 91 (export 'with-var-arg-array)
' 92 ;;; TODO - we will use this /a lot/. So you should
' 93 ;;; try to make the generated code as small as possible.
' 94 (defmacro with-var-arg-array ((list var &key (type :pointer)) &body body)
' 95 (check-type var symbol)
' 96 (let ((=list= (gensym "LIST")))
' 97 `(let* ((,=list= ,list)
' 98 (list-len (length ,=list=)))
' 99 (with-foreign-object (array* ,type list-len)
' 100 (iter
' 101 (for elt in ,=list=)
' 102 (for i upfrom 0)
' 103 (setf (mem-aref array* ,type i) elt))
' 104 (with-foreign-object (,var 'var-arg-array)
' 105 (with-foreign-slots ((size array) ,var var-arg-array)
' 106 (setf size list-len
' 107 array array*)
' 108 ,@body))))))
' 109
' 110 (defun gec-minus (space a b c)
' 111 "a - b = c"
' 112 (with-var-arg-array ('(1 -1) coeffs :type :int)
' 113 (with-var-arg-array ((list a b) a-b)
' 114 (gecol:linear-intargs-intvarargs-intreltype-intvar-intconlevel
' 115 space coeffs a-b :irt-= c :icl-def))))
' 116
2007-02-06 kilian.sprot 117