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

KindCoveredAll%
expression0111 0.0
branch04 0.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; rule.lisp --- Skel Rule Objects
2
 
3
 ;; 
4
 
5
 ;;; Code:
6
 (in-package :skel/core/obj)
7
 
8
 ;;; Rule
9
 (declaim (inline %make-sk-rule))
10
 (defstruct (sk-rule (:constructor %make-sk-rule (target source recipe)))
11
 "Maps a SOURCE to a corresponding TARGET
12
 via the special form stored in RECIPE."
13
   (target "" :type string)
14
   (source nil :type list)
15
   (recipe nil :type list))
16
 
17
 (definline make-sk-rule (target &optional source recipe)
18
   (%make-sk-rule
19
    (etypecase target 
20
      (string target)
21
      (symbol (string-downcase target)))
22
    source
23
    (multiple-value-bind (form _ doc) (parse-body recipe :documentation t)
24
      ;; TODO 2025-02-25: figure out where to put the docstring - hash,compare,cache
25
      (declare (ignore _ doc))
26
      form)))
27
 
28
 (defmethod sk-new ((self (eql :rule)) &rest args)
29
   (declare (ignore self))
30
   (apply #'sk-new 'sk-rule args))
31
 
32
 (defmethod id ((self sk-rule))
33
   (sxhash (list (sk-rule-target self) (sk-rule-source self))))
34
 
35
 (defmethod write-ast ((self sk-rule) stream &key (pretty t) (case :downcase) &allow-other-keys)
36
   (write `(,(sk-rule-target self) ,(sk-rule-source self) ,@(sk-rule-recipe self)) :stream stream :pretty pretty :case case :readably t :array t :escape t))
37
 
38
 (defmethod print-object ((self sk-rule) stream)
39
   (print-unreadable-object (self stream)
40
     (format stream "~A ~A" (sk-class-name self t) (sk-rule-target self))
41
     (when-let ((source (sk-rule-source self)))
42
       (format stream " ~A" (mapcar 'string-downcase source)))))
43
 
44
 (defmacro with-sk-rule-env (binds &body body)
45
   `(symbol-macrolet ,*skel-project-symbol-macros*
46
      (macrolet ,*skel-project-macros*
47
        (labels ,*skel-project-functions*
48
          (progv (mapcar 'car ,binds)
49
              (mapcar 'cdr ,binds)
50
            ,@body)))))
51
 
52
 ;; Note that SK-RUN directly on a rule currently does NOT touch the sources.
53
 (defmethod sk-run ((self sk-rule))
54
   (with-sk-rule-env (sk-bind *skel-project*)
55
     (compile-and-eval* 
56
      (sk-rule-recipe self))))
57
 
58
 (defmethod sk-write ((self sk-rule) stream)
59
   (write-string (sk-rule-target self) stream) ;; target isn't typep SK-OBJECT
60
   (write (sk-rule-source self) :stream stream)
61
   (write (sk-rule-recipe self) :stream stream))
62
 
63
 ;; FIX 2025-06-09: 
64
 (defun sk-make (obj &rest rules)
65
   (if rules
66
       (mapc
67
        (lambda (r) 
68
          (when-let ((rule (sk-find r obj)))
69
            (sk-run-with-sources obj rule)))
70
        rules)
71
       (unless (sequence:emptyp (sk-rules obj))
72
         (let ((rule (aref (sk-rules obj) 0)))
73
           (if (sk-rule-source rule)
74
               (sk-make obj rule)
75
               (sk-run rule))))))
76
 
77
 (defun sk-run-with-sources (obj rule)
78
   (declare (sk-rule rule))
79
   (when-let ((sources (and rule (sk-rule-source rule))))
80
     (mapcar
81
      (lambda (src)
82
        (if-let* ((sr (sk-find src obj)))
83
                 ;; TODO: check if we need to rerun sources
84
                 (sk-make obj sr)
85
                 (error "unhandled source: ~A for rule ~A" src rule)))
86
      sources))
87
   (sk-run rule))