2 files changed, 81 insertions(+), 0 deletions(-)

M src/resolve.lisp
A src/version.lisp

@@ 40,4 40,29 @@
             (name obj)
             (spec obj)))
 
+(defclass package-info
+  ((name :initarg :name :reader name)
+   (version :initarg :version :reader version)
+   (location :initarg :location :reader location)
+   (requirements :initarg :requirements :reader requirements))
+  (:documentation "A class to represent package information."))
+
+(defun present (name &key spec)
+  (make-instance 'requirement :status :present :name name :spec spec))
+
+(defun absent (name &key spec)
+  (make-instance 'requirement :status :absent :name name :spec spec))
+
+(defun spec-holds (cmp spec package)
+  (declare (type (or null version-predicate) spec)
+           (type package-info package))
+  (if (null spec)
+      t
+      (let ((pkg-version (version package)))
+        (reduce (lambda (disj-acc disj-req)
+                  (or disj-acc
+                      (reduce
+                        (lambda (conj-acc conj-req)
+                          (make-comparison
+
 

@@ 0,0 1,56 @@
+;; A 
+(defpackage #:skin.djha.zippm/version
+  (:use :cl)
+  (:import-from #:uiop)
+  (:import-from #:alexandria)
+  (:documentation
+    "A straight implementation in common lisp of the Debian Version Comparison Algorithm."))
+
+(in-package #:skin.djha.zippm/version)
+
+(defparameter *nullc* (code-char 0))
+
+(defun
+    lexical-comparison (a b)
+  "Lexically compare two characters according to debian version rules."
+  (declare (type character a b))
+  (cond ((char= a b) 0)
+        ((char= a #\~) -1)
+        ((char= b #\~) 1)
+        ((and (alpha-char-p a)
+              (not (alpha-char-p b))
+              (not (char= b (code *nullc*))))
+         -1)
+        ((and (alpha-char-p b)
+              (not (alpha-char-p a))
+              (not (= a *nullc*)))
+         1)
+        (:else
+         (- (char-code a) (char-code b)))))
+;; TODOt
+(defun justify-strings (a b)
+  "
+  Returns two seqs of equal length, composed either
+  of the characters from the strings, or the null character.
+  "
+  (declare (type string a b))
+  (let ((va (vec a))
+        (vb (vec b))
+        (ca (length a))
+        (cb (length b)))
+    (cond
+      (= ca
+         cb)
+      [va
+       vb]
+      (> cb ca)
+      [(into va
+             (repeat (- cb ca)
+                     nullc))
+       vb]
+      :else
+      [va
+       (into vb
+             (repeat (- ca cb)
+                     nullc))])))
+