src/thales/solver.scm

   1 ;;; solver.scm --- Thales solver --- implementation of core idea
   2
   3 ;; Copyright (C) 2013 Dmitry Bogatov <KAction@gnu.org>
   4
   5 ;; Author: Dmitry Bogatov <KAction@gnu.org>
   6
   7 ;; This program is free software; you can redistribute it and/or
   8 ;; modify it under the terms of the GNU General Public License
   9 ;; as published by the Free Software Foundation; either version 3
  10 ;; of the License, or (at your option) any later version.
  11
  12 ;; This program 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
  15 ;; GNU General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
  19
  20 ;;; Commentary:
  21
  22 ;;; Core idea of Thales is packages manager, that eliminates dependencies
  23 ;;; hell. In generic case --- when every package version can depend
  24 ;;; on arbitary set of packages and their version, solution of dependencies
  25 ;;; is exponencial problem. So idea is strictly order package versions
  26 ;;; according following rules:
  27 ;;;     * Any incompatible change allowed only with major version bump.
  28 ;;;     * Adding dependencly requires major version bump.
  29 ;;;     * Increase in minor version of dependency is do not require
  30 ;;;       major version bump.
  31 ;;;     * Relaxing dependencies do not require major version bump.
  32 ;;;     * Each package may alternatively depend on several major version
  33 ;;;       of package
  34 ;;;
  35 ;;; Most of these requirements are managed automatically by seals (see
  36 ;;; seals.scm) and analysis of modules interfaces. Of course, if programmer
  37 ;;; wants to screw things, he will be able to.
  38
  39 ;;; Currently, I have no idea how control compability of macroses.
  40 ;; Code:
  41 (define-module (thales solver)
  42     :export (perform-solve generate-r1-contrain-solver))
  43 (use-modules (ice-9 match))
  44 (use-modules (srfi srfi-1))
  45 (use-modules (thales seal))
  46 (use-modules (srfi srfi-26))
  47 (use-modules (thales syntax))
  48
  49 (sealed version-compatible?
  50         ([& '(1 2) '(1 2 0)] => #t)
  51         ([& '(1 2 3) '(1 2 2)] => #t))
  52
  53 (define (version-compatible? v1 v2)
  54     "Version is compatible, if major versions is equal
  55 and minor is no less."
  56     (and (=  (car v1)  (car v2))
  57          (<= (cadr v1) (cadr v2))))
  58 (define-match (version-interchangeble? [major1 minor1 _ ...]
  59                                        [major2 minor2 _ ...])
  60     (and (= major1 major2)
  61         (= minor1 minor2)))
  62
  63 (sealed satisfy
  64         [(& '(foo ? (1 0))
  65             '(foo (1 0 0)))
  66          => #t]
  67         [(& '(foo ? (2 0))
  68             '(foo (1 2 3)))
  69          => #f]
  70         [(& '(foo ? (1 0))
  71             '(foo (1 2 3)))
  72          => #t]
  73         [(& '(foo ? (1 0) (2 0))
  74             '(foo   (1 2 3)))
  75          => #t]
  76         [(& '(foo = (1 2 3))
  77             '(foo   (1 2 3)))
  78          => #t]
  79         [(& '(foo = (1 2 4) (1 2 7))
  80             '(foo   (1 2 5)))
  81          => #f])
  82
  83 (define version-equal? equal?)
  84
  85 (define-match (satisfy [?pkgname *cmp* ?versions ...]
  86                        [pkgname  pkg-version _ ...])
  87     (let ((cmp (case *cmp*
  88                    [(?) version-compatible?]
  89                    [(=) version-equal? ])))
  90         (and (eq? pkgname ?pkgname)
  91             (any #[cmp <> pkg-version] ?versions))))
  92
  93 (define* (generate-r1-contrain-solver installed availible
  94                                       #:key (conservative #f))
  95     "Return function, that will packages, that satisfy constrain.
  96
  97 Function, given constrain, return list of packages, that satistfy it,
  98 taking only one version from each major version. Order of packages influenced
  99 by list of INSTALLED packages, if CONSERVATIVE is #f.
 100 "
 101     (let* ((cache (make-hash-table))
 102            (cache-get #[hash-ref  cache <>])
 103            (cache-put #[hash-set! cache <> <>]))
 104         (lambda (constr)
 105             (or (cache-get constr)
 106                 (let ((result (filter #[satisfy constr <>] availible)))
 107                     (cache-put constr result)
 108                     result)))))
 109
 110 (define* (perform-solve installed availible constrains
 111                         #:key (conservative #f))
 112     "Resolve CONSTRAINS with AVAILIBLE packages.
 113
 114 If CONSERVATIVE if #t, prefer use of INSTALLED packages, otherwise prefer
 115 new versions.
 116
 117 CONSTRAINS is list of constrains, that have following kinds:
 118
 119     * Ridid request for specified package. To be used, if bug happens
 120       and dependency have to be resolved manually.
 121         (<pkg-name> = (<major> <minor> <micro>) ...)
 122     * Request for package version, no less that specified.
 123         (<pkg-name> ? (<major> <minor>) ... )
 124
 125 Both INSTALLED and AVAILIBLE are lists of package in form
 126     (<pkg-name> (<major> <minor> <micro>) <constrains>)
 127 where <constrains> are never rigid."
 128
 129 #f
 130 )