aboutsummaryrefslogtreecommitdiff
path: root/src/property/os.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'src/property/os.lisp')
-rw-r--r--src/property/os.lisp38
1 files changed, 19 insertions, 19 deletions
diff --git a/src/property/os.lisp b/src/property/os.lisp
index d04c262..86245cc 100644
--- a/src/property/os.lisp
+++ b/src/property/os.lisp
@@ -22,22 +22,22 @@
(defclass unixlike () ())
-(defclass linux (unixlike)
- ((architecture
- :initarg :arch :reader linux-architecture
- :documentation
- "Keyword whose name is Debian's name for this architecture, e.g. :AMD64")))
+(defclass linux (unixlike) ())
-(defprop linux :posix (architecture)
+(defprop linux :posix ()
(:desc "Host kernel is Linux")
- (:hostattrs (push-hostattr :os (make-instance 'linux :arch architecture))))
+ (:hostattrs (push-hostattr :os (make-instance 'linux))))
(define-simple-print-object linux)
(defclass debianlike (linux) ())
(defclass debian (debianlike)
- ((suite :initarg :suite
+ ((architecture
+ :initarg :arch :reader debian-architecture
+ :documentation
+ "Keyword whose name is Debian's name for this architecture, e.g. :AMD64")
+ (suite :initarg :suite
:reader debian-suite
:initform (error "Must provide suite"))))
@@ -81,9 +81,9 @@
(defclass debian-experimental (debian)
((suite :initform "experimental")))
-(defmethod debian-architecture ((os linux))
+(defmethod debian-architecture-string ((os debian))
"Return a string representing the architecture of OS as used by Debian."
- (string-downcase (symbol-name (linux-architecture os))))
+ (string-downcase (symbol-name (debian-architecture os))))
;;;; Property combinators
@@ -144,12 +144,12 @@ Used in property :HOSTATTRS subroutines."
(unless (and os (subtypep os type))
(inapplicable-property #?"Property requires OS of type ${type}"))))
-(defun supports-arch-p (os arch)
- "Can binaries of type ARCH run on OS?"
- (let ((same (eq (linux-architecture os) arch)))
- (cl:typecase os
- (debian (or same
- (member arch (assoc (linux-architecture os)
- '((:amd64 :i386)
- (:i386 :amd64))))))
- (linux same))))
+(defgeneric supports-arch-p (target-os binary-os)
+ (:documentation "Can binaries for BINARY-OS run on TARGET-OS?"))
+
+(defmethod supports-arch-p ((target-os debian) (binary-os debian))
+ (let ((target (debian-architecture target-os))
+ (binary (debian-architecture binary-os)))
+ (or (eq target binary)
+ (member binary (assoc target '((:amd64 :i386)
+ (:i386 :amd64)))))))