[297218]: platform-support.lisp Maximize Restore History

Download this file

platform-support.lisp    100 lines (89 with data), 3.9 kB

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
(defparameter *processors* nil)
(defparameter *systems* nil)
(defparameter *statuses* nil)
(defparameter *ports* nil)
(defmacro define-processor (keyword name)
`(progn
(setf *processors* (remove ,keyword *processors* :key #'car))
(push-end (cons ,keyword ,name) *processors*)))
(defmacro define-system (keyword name &rest processors)
`(progn
(setf *systems* (remove ,keyword *systems* :key #'car))
(push-end (list ,keyword ,name ,@processors) *systems*)))
(defmacro define-status (keyword class name abbrev)
`(progn
(setf *statuses* (remove ,keyword *statuses* :key #'car))
(push-end (list ,keyword ,class ,name ,abbrev) *statuses*)))
(defmacro define-port (processor system status &key link)
`(progn
(setf *ports* (remove-if #'(lambda (e)
(and (eql (first e) ,processor)
(eql (second e) ,system))) *ports*))
(push-end (list ,processor ,system ,status ,link) *ports*)))
(defun port-status (proc system)
(let ((status (find-if #'(lambda (e)
(and (eq (first e) proc)
(eq (second e) system))) *ports*)))
(if status
(third status)
(if (find proc (cddr (find system *systems* :key #'car)))
:not-available
:not-applicable))))
(defun table-cell-for-status (status &key (elt :|td|) (link nil))
`((,elt :|class| ,(second (assoc status *statuses*)))
((,(if link :|a| :|span|) ,@(if link `(:|href| ,link)))
((:|div| :|class| "big-height")
((:|span| :|class| "hide-me")
,(fourth (assoc status *statuses*)))))))
(defun port-link (proc system)
(fourth (find-if #'(lambda (e)
(and (eq (first e) proc)
(eq (second e) system))) *ports*)))
(defun port-xml ()
`((:|table| :|class| "port-table")
((:|tr| :|class| "processor-header") (:|th|)
,@(loop for proc-pair in *processors*
collect `((:|th|)
#+nil ,(cdr proc-pair)
#-nil ,(string-upcase (string (char
(cdr proc-pair) 0))))))
,@(loop for system in *systems*
collect `((:|tr| :|class| "system-header")
(:|th| ,(second system))
,@(loop for proc in *processors*
collect (table-cell-for-status
(port-status (car proc)
(first system))
:link
(port-link (car proc)
(first system))))))))
(defun port-page ()
`((:|p|
"SBCL runs on many Unix and Unix-like systems. The following table summarizes what systems SBCL runs on, and what it could run on but currently does not. The table also contains links to the latest binaries for SBCL on each platform, when they are available.")
((:|div| :|class| "left-floater")
,(port-xml))
((:|table| :|class| "key")
(:|tr|
(:|td| "")
((:|td|)
(:|h1| "Key")))
,@(loop for s in *statuses*
collecting
`((:|tr| :|class| "key-blob")
,(table-cell-for-status (car s) :elt :|th|)
(:|td|
,(third s)))))
(:|p|)
((:|table| :|class| "key")
(:|tr|
((:|td|) "")
((:|td|)
(:|h1| "Processors")))
,@(loop for proc-pair in *processors*
collecting `(:|tr|
(:|th|
(:|b| ,(string-upcase (string (char
(cdr proc-pair) 0)))))
(:|td|
,(cdr proc-pair)))))))
(define-page :ports "Platform support" "platform-table" port-page)