]> jfr.im git - irc/thales.git/commitdiff
Simplify `satisfy` with lambda-match
authorDmitry Bogatov <redacted>
Thu, 12 Dec 2013 20:22:36 +0000 (14:22 -0600)
committerDmitry Bogatov <redacted>
Thu, 12 Dec 2013 20:22:36 +0000 (14:22 -0600)
src/thales/solver.scm

index 946fcc0df9ddb4a496af02ad109217d0c90c0194..943355b2702ddeb5decf16277b3d6082d05e9288 100644 (file)
@@ -44,6 +44,7 @@
 (use-modules (srfi srfi-1))
 (use-modules (thales seal))
 (use-modules (srfi srfi-26))
+(use-modules (thales syntax))
 
 (sealed version-compatible?
     (& '(1 2) '(1 2 0) => #t)
@@ -62,7 +63,7 @@ and minor is no less."
        (& '(foo ? (2 0))
           '(foo (1 2 3))
           => #f)
-       (& '(foo ? (1))
+       (& '(foo ? (1 0))
           '(foo (1 2 3))
           => #t)
        (& '(foo ? (1 0) (2 0))
@@ -75,17 +76,15 @@ and minor is no less."
           '(foo   (1 2 5))
           => #f))
 
+(define version-equal? equal?)
 
-(define (satisfy constr package)
-    (match package
-       ([pkgname pkg-version _ ...]
-        (match constr
-            ([?pkgname *cmp* versions ...]
-             (let ((cmp (case *cmp*
-                            [(?) version-compatible?]
-                            [(=) version-equal? ])))
-                 (and (eq? pkgname ?pkgname)
-                      (any #[cmp <> pkg-version] versions))))))))
+(define-match (satisfy [?pkgname *cmp* ?versions ...]
+                       [pkgname  pkg-version _ ...])
+    (let ((cmp (case *cmp*
+                  [(?) version-compatible?]
+                  [(=) version-equal? ])))
+       (and (eq? pkgname ?pkgname)
+           (any #[cmp <> pkg-version] ?versions))))
 
 (define* (generate-r1-contrain-solver installed availible
                                      #:key (conservative #f))