/[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 - (show annotations)
Wed May 11 02:45:34 2005 UTC (8 years, 11 months ago) by edenny
Branch: MAIN
CVS Tags: HEAD
Initial checkin.
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