/[cl-gsl]/cl-gsl/sort.lisp
ViewVC logotype

Contents of /cl-gsl/sort.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (hide annotations)
Wed May 11 02:45:34 2005 UTC (8 years, 11 months ago) by edenny
Branch: MAIN
CVS Tags: HEAD
Initial checkin.
1 edenny 1.1 ;;;; -*- Mode: Lisp; Synatx: ANSI-Common-Lisp; Base: 10 -*-
2     ;;;;
3     ;;;; Copyright (C) 2005 Edgar Denny <edgardenny@comcast.net>
4     ;;;; This file is part of CL-GSL.
5     ;;;;
6     ;;;; This program is free software; you can redistribute it and/or modify
7     ;;;; it under the terms of the GNU General Public License as published by
8     ;;;; the Free Software Foundation; either version 2 of the License, or
9     ;;;; (at your option) any later version.
10     ;;;;
11     ;;;; This program is distributed in the hope that it will be useful,
12     ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13     ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14     ;;;; GNU General Public License for more details.
15     ;;;;
16     ;;;; You should have received a copy of the GNU General Public License
17     ;;;; along with this program; if not, write to the Free Software
18     ;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
19    
20     (in-package #:cl-gsl-array)
21    
22     (defmacro def-vector-sort-type-funcs% (typ)
23     (destructuring-bind (type-ptr type-string)
24     (cond
25     ((eq typ 'double-float)
26     (list 'gsl-vector-ptr ""))
27     ((eq typ 'single-float)
28     (list 'gsl-vector-float-ptr "_float"))
29     ((eq typ 'integer)
30     (list 'gsl-vector-int-ptr "_int"))
31     (t
32     (error "no matching type.")))
33    
34     `(progn
35     (defun-foreign ,(concatenate 'string "gsl_sort_vector" type-string)
36     ((v ,type-ptr))
37     :void)
38    
39     (defun-foreign ,(concatenate 'string
40     "gsl_sort_vector" type-string "_index")
41     ((p gsl-permutation-ptr)
42     (v ,type-ptr))
43     :int))))
44    
45     (def-vector-sort-type-funcs% double-float)
46     (def-vector-sort-type-funcs% single-float)
47     (def-vector-sort-type-funcs% integer)
48    
49     (defmacro def-vector-sort-methods% (class-string func-string)
50     (let ((class-object (kmrcl:concat-symbol "gsl-vector-" class-string)))
51     `(progn
52     (defmethod sort-vector ((o ,class-object))
53     (,(kmrcl:concat-symbol "gsl-sort-vector" func-string) (ptr o))
54     o)
55    
56     (defmethod sort-vector-index ((p gsl-permutation) (o ,class-object))
57     (assert (= (size o) (size p)))
58     (,(kmrcl:concat-symbol "gsl-sort-vector" func-string "-index")
59     (ptr p) (ptr o))
60     p))))
61    
62     (def-vector-sort-methods% "integer" "-int")
63     (def-vector-sort-methods% "single-float" "-float")
64     (def-vector-sort-methods% "double-float" "")
65    
66     (defmacro with-sort-vector-index ((p v) &body body)
67     `(let ((,p (make-permutation (size ,v))))
68     (unwind-protect
69     (progn
70     (sort-vector-index ,p ,v)
71     ,@body)
72     (free ,p))))

  ViewVC Help
Powered by ViewVC 1.1.5