guix/sets.scm

   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