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