Coverage report: /home/ellis/comp/core/app/skel/core/component.lisp

Kind	Covered	All	%
expression	0	140	0.0
branch	0	6	0.0

Key

Not instrumented

Conditionalized out

Executed

Not executed

Both branches taken

One branch taken

Neither branch taken

1

;;; component.lisp --- Skel Component

2

3

;;

4

5

;;; Commentary:

6

7

;; SK-COMPONENTs are similar in nature to ASDF/COMPONENT:COMPONENT objects but

8

;; much more lightweight. We use this class with the assumption that whatever

9

;; it's wrapping is contained within another SKEL object, such as in the

10

;; :COMPONENTS slots of SK-PROJECTs.

11

12

;; Container objects such as SK-PROJECT are NOT subclasses of SK-COMPONENT,

13

;; unlike in ASDF where systems are subclasses of components.

14

15

;;; Code:

16

(in-package :skel/core/obj)

17

18

(defclass sk-component (skel)

19

((parent :initarg :parent :accessor sk-parent)))

20

21

(defmethod print-object ((self sk-component) stream)

22

(print-unreadable-object (self stream)

23

(when-let ((name (or (name self) (format-sxhash (id self)))))

24

(format stream "~A ~A" (sk-class-name self t) name))))

25

26

;;; Module

27

28

;; Again just like ASDF, we define an SK-MOD class which subclasses

29

;; SK-COMPONENT. The SK-MOD class is used for components which have

30

;; sub-components themselves.

31

32

(defclass sk-mod (sk-component sk-meta)

33

((components :initarg :components :accessor sk-components)))

34

35

(defun make-sk-mod (form)

36

"Make a new SK-MOD."

37

(if (listp form)

38

(apply #'make-instance 'sk-mod

39

(let ((name (pop form))

40

(components

41

(mapcar

42

(lambda (f)

43

                         (sk-load-component (car f) (if (= 1 (length (cdr f))) (cadr f) (cdr f))))

44

form)))

45

`(:name ,name :components ,components)))

46

(make-instance 'sk-mod :name form :components nil)))

47

48

(defmethod sk-new ((self (eql :mod)) &key form path)

49

(let ((mod (make-sk-mod form)))

50

(when path (setf (path mod) path))

51

mod))

52

53

(defmethod sk-load-component ((kind (eql :mod)) (form t) &optional (path *default-pathname-defaults*))

54

(sk-new kind :form form :path path))

55

56

(defmethod sk-compile ((self sk-mod) &key)

57

(dolist (c (sk-components self))

58

(sk-compile c)))

59

60

(defmethod sk-build ((self sk-mod) &key)

61

(dolist (c (sk-components self))

62

(sk-build c)))

63

64

;;; Script

65

66

;; Scripts are always assumed to point to an executable file. They can be ran

67

;; directly with SK-RUN.

68

69

(defclass sk-script (sk-component sk-meta ast)

70

((kind :initform nil :initarg :kind :type (or null script-designator) :accessor sk-kind)))

71

72

(defmethod sk-new ((self (eql :script)) &key form path)

73

(let ((script (make-sk-script form)))

74

(setf (path script) path)

75

script))

76

77

(defmethod sk-load-component ((kind (eql :script)) (form t) &optional (path *default-pathname-defaults*))

78

(sk-new kind :form form :path path))

79

80

(defmethod write-ast ((self sk-script) stream &key (pretty t) (case :downcase) &allow-other-keys)

81

(write `(,(path self)) :stream stream :pretty pretty :case case :readably t :array t :escape t))

82

83

(defun make-sk-script (script)

84

"Make a new SK-SCRIPT."

85

(apply #'make-instance 'sk-script

86

(if (listp script)

87

(let ((kind (first script))

88

(path (second script)))

89

(list :path path

90

:name (pathname-name path)

91

:kind kind))

92

(list :path script

93

:name (pathname-name script)

94

:kind (when-let ((ext (pathname-type script)))

95

(keywordicate ext))))))

96

97

(defmethod sk-run ((self sk-script))

98

(sb-ext:run-program (path self) nil :output t))

99

100

(defmethod sk-write ((self sk-script) stream)

101

(with-slots (path) self

102

(write-string path)))

103

104

(defmethod print-object ((self sk-script) stream)

105

(print-unreadable-object (self stream)

106

(format stream ":~A ~A" (sk-kind self) (name self))))