1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
| | ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix sets)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-26)
#:use-module (ice-9 vlist)
#:use-module (ice-9 match)
#:export (set
setq
set?
set-insert
set-union
set-contains?
set->list
list->set
list->setq))
;;; Commentary:
;;;
;;; A simple (simplistic?) implementation of unordered persistent sets based
;;; on vhashes that seems to be good enough so far.
;;;
;;; Another option would be to use "bounded balance trees" (Adams 1992) as
;;; implemented by Ian Price in 'pfds', which has faster union etc. but needs
;;; an order on the objects of the set.
;;;
;;; Code:
(define-record-type <set>
(%make-set vhash insert ref)
set?
(vhash set-vhash)
(insert set-insert-proc)
(ref set-ref))
(define %insert
(cut vhash-cons <> #t <>))
(define %insertq
(cut vhash-consq <> #t <>))
(define (set . args)
"Return a set containing the ARGS, compared as per 'equal?'."
(list->set args))
(define (setq . args)
"Return a set containing the ARGS, compared as per 'eq?'."
(list->setq args))
(define (list->set lst)
"Return a set with the elements taken from LST. Elements of the set will be
compared with 'equal?'."
(%make-set (fold %insert vlist-null lst)
%insert
vhash-assoc))
(define (list->setq lst)
"Return a set with the elements taken from LST. Elements of the set will be
compared with 'eq?'."
(%make-set (fold %insertq vlist-null lst)
%insertq
vhash-assq))
(define-inlinable (set-contains? set value)
"Return #t if VALUE is a member of SET."
(->bool ((set-ref set) value (set-vhash set))))
(define (set-insert value set)
"Insert VALUE into SET."
(if (set-contains? set value)
set
(let ((vhash ((set-insert-proc set) value (set-vhash set))))
(%make-set vhash (set-insert-proc set) (set-ref set)))))
(define-inlinable (set-size set)
"Return the number of elements in SET."
(vlist-length (set-vhash set)))
(define (set-union set1 set2)
"Return the union of SET1 and SET2. Warning: this is linear in the number
of elements of the smallest."
(unless (eq? (set-insert-proc set1) (set-insert-proc set2))
(error "set-union: incompatible sets"))
(let* ((small (if (> (set-size set1) (set-size set2))
set2 set1))
(large (if (eq? small set1) set2 set1)))
(vlist-fold (match-lambda*
(((item . _) result)
(set-insert item result)))
large
(set-vhash small))))
(define (set->list set)
"Return the list of elements of SET."
(map (match-lambda
((key . _) key))
(vlist->list (set-vhash set))))
;;; sets.scm ends here
|