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

Contents of /flexichain/utilities.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (show annotations)
Thu Feb 9 02:51:06 2006 UTC (8 years, 2 months ago) by rkreuter
Branch: MAIN
Branch point for: clnet
Initial revision
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