/[flexichain]/flexichain/utilities.lisp
ViewVC logotype

Contents of /flexichain/utilities.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1.1.1 - (hide annotations) (vendor branch)
Thu Feb 9 02:51:06 2006 UTC (8 years, 2 months ago) by rkreuter
Branch: clnet
CVS Tags: initial
Changes since 1.1: +0 -0 lines
Initial checkin.
1 rkreuter 1.1 ;;; Flexichain
2     ;;; Utility functions
3     ;;;
4     ;;; Copyright (C) 2003-2004 Robert Strandh (strandh@labri.fr)
5     ;;; Copyright (C) 2003-2004 Matthieu Villeneuve (matthieu.villeneuve@free.fr)
6     ;;;
7     ;;; This library is free software; you can redistribute it and/or
8     ;;; modify it under the terms of the GNU Lesser General Public
9     ;;; License as published by the Free Software Foundation; either
10     ;;; version 2.1 of the License, or (at your option) any later version.
11     ;;;
12     ;;; This library is distributed in the hope that it will be useful,
13     ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14     ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15     ;;; Lesser General Public License for more details.
16     ;;;
17     ;;; You should have received a copy of the GNU Lesser General Public
18     ;;; License along with this library; if not, write to the Free Software
19     ;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
20    
21    
22     (in-package :flexichain)
23    
24     (defun square (x)
25     "Returns the square of the number X."
26     (* x x))
27    
28     (defun find-if-2 (predicate sequence)
29     "Searches the sequence for an element that satisfies PREDICATE.
30     Returns the element found or NIL of none was found, and a boolean
31     indicating whether an element was found or not."
32     (let ((position (position-if predicate sequence)))
33     (if (null position)
34     (values nil nil)
35     (values (elt sequence position) t))))
36    
37     ;;; CMUCL and SBCL have direct support for weak pointers. In OpenMCL weak
38     ;;; references are only supported via weak hash tables. This class provides
39     ;;; the means for other classes to manage their weak references.
40     ;;;
41     ;;; TODO: check other CL implementations behavior wrt. return values
42     (defclass weak-pointer-container-mixin ()
43     (#+openmcl
44     (weak-hash :initform (make-hash-table :test #'eq :weak :value)))
45     (:documentation "Support for weak references, if needed"))
46    
47     (defgeneric make-weak-pointer (object container))
48    
49     #+(or sbcl cmu)
50     (defmethod make-weak-pointer (object container)
51     (declare (ignore container))
52     #+cmu (extensions:make-weak-pointer object)
53     #+sbcl (sb-ext:make-weak-pointer object))
54    
55     #+openmcl
56     (defmethod make-weak-pointer (object (container weak-pointer-container-mixin))
57     (let ((key (cons nil nil)))
58     (setf (gethash key (slot-value container 'weak-hash)) object)
59     key))
60    
61     (defgeneric weak-pointer-value (weak-pointer container))
62    
63     #+(or sbcl cmu)
64     (defmethod weak-pointer-value (weak-pointer container)
65     (declare (ignore container))
66     #+cmu (extensions:weak-pointer-value weak-pointer)
67     #+sbcl (sb-ext:weak-pointer-value weak-pointer))
68    
69     #+openmcl
70     (defmethod weak-pointer-value
71     (weak-pointer (container weak-pointer-container-mixin))
72     (gethash weak-pointer (slot-value container 'weak-hash) nil))
73    
74     #-(or sbcl cmu openmcl)
75     (progn
76     (eval-when (:evaluate :compile-toplevel :load-toplevel)
77     (warning "No support for weak pointers in this implementation. Things may
78     get big and slow")
79     )
80     (defmethod make-weak-pointer (object container)
81     (declare (ignore container))
82     object)
83     (defmethod weak-pointer-value (weak-pointer container)
84     (declare (ignore container))
85     weak-pointer))

  ViewVC Help
Powered by ViewVC 1.1.5