Coverage report: /home/runner/work/geb/geb/src/vampir/print.lisp

KindCoveredAll%
expression41146 28.1
branch04 0.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 (in-package :geb.vampir)
2
 
3
 ;; We use CL streams as they are much better for concatenating to, and
4
 ;; have us worry less. they are a mutable interface however.
5
 
6
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7
 ;; FORMAT RUNDOWN FOR THOSE WHO ARE UNFAMILIAR
8
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
9
 
10
 ;; https://www.cs.cmu.edu/Groups/AI/html/cltl/clm/node257.html
11
 
12
 ;; DSL FOR NEWLINES AND CONTROL OF IT
13
 
14
 ;; ~4I  = (pprint-indent :block   4)
15
 ;; ~4:I = (pprint-indent :current 4)
16
 ;; ~_   = (pprint-newline :linear)
17
 ;; ~@_  = (pprint-newline :miser)
18
 ;; ~:@_ = (pprint-newline :mandatory)
19
 ;; ~:_  = (pprint-newline :fill)
20
 
21
 
22
 ;; FOR PRINTING NORMALLY NOTE THESE TAKE ARGUMENTS!
23
 
24
 ;; ~(~a~)    = print symbol lower case instead of upper case
25
 ;; ~{~A~}    = prints a list element by element.
26
 
27
 ;; ~{~A~^ ~} = prints a list element by element, the last element of
28
 ;;             the list does not print the extra space
29
 ;; EXAMPLE:
30
 ;; VAMPIR> (format nil "~{~A~^ ~}" (list 1 2 3 4 5))
31
 ;; "1 2 3 4 5"
32
 ;; VAMPIR> (format nil "~{~A ~}" (list 1 2 3 4 5))
33
 ;; "1 2 3 4 5 "
34
 
35
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
36
 ;; TopLevel Extraction
37
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
38
 
39
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
40
 ;; Statement Extraction
41
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
42
 
43
 (defmethod print-object ((pub spc:pub) stream)
44
   (pprint-logical-block (stream nil)
45
     (format stream "~I~{pub ~(~a~)~^~:@_~}" (spc:wires pub))))
46
 
47
 (defmethod print-object ((alias spc:alias) stream)
48
   (pprint-logical-block (stream nil)
49
     (format stream "def ~(~a~)" (spc:name alias))
50
     (format stream "~4I~{ ~@_~(~a~)~} " (spc:inputs alias))
51
 
52
     ;; no more output circuits, but may it rest here
53
     ;; (when (spc:outputs alias)
54
     ;;   (format stream "~@_->~{ ~@_~(~a~)~} " (spc:outputs alias)))
55
 
56
     (format stream "~0I= ~@_{~2I")
57
     (extract-constraint-list (spc:body alias) stream)
58
     (format stream "~0I~:@_};")))
59
 
60
 (-> extract-constraint-list (spc:constraint-list &optional stream) stream)
61
 (defun extract-constraint-list (cs &optional (stream *standard-output*))
62
   (format stream "~{~:@_~A~^;~}" cs)
63
   stream)
64
 
65
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
66
 ;; Constraint Extraction
67
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
68
 
69
 (defmethod print-object ((bind spc:bind) stream)
70
   (pprint-logical-block (stream nil)
71
     (cond ((cdr (spc:names bind))
72
            (format stream "def (~{~A~^, ~}) = " (spc:names bind)))
73
           ((spc:names bind)
74
            (format stream "def ~{~A~^, ~} = " (spc:names bind))))
75
     (format stream "~2I~_~A" (spc:value bind))))
76
 
77
 (defmethod print-object ((eql spc:equality) stream)
78
   (pprint-logical-block (stream nil)
79
     (format stream "~A ~2:I= ~4I~@_~A" (spc:lhs eql) (spc:rhs eql))))
80
 
81
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
82
 ;; Expression Extraction
83
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
84
 
85
 (-> extract-expression (spc:expression &optional stream) stream)
86
 (defun extract-expression (expr &optional (stream *standard-output*))
87
   "Extract-expression is like a `print-object' but adds an extra set
88
 of ()'s for any non normal form"
89
   (etypecase-of spc:expression expr
90
     (spc:infix
91
      (pprint-logical-block (stream nil :prefix "(" :suffix ")")
92
        (print-object expr stream)))
93
     (spc:application
94
      (pprint-logical-block (stream nil :prefix "(" :suffix ")")
95
        (print-object expr stream)))
96
     ((or spc:tuple spc:normal-form spc:curly)
97
      (print-object expr stream))
98
     (geb.extension.spec:common-sub-expression
99
      (extract-expression (geb.spec:obj expr) stream)))
100
   stream)
101
 
102
 (defmethod print-object ((infix spc:infix) stream)
103
   (extract-expression (spc:lhs infix) stream)
104
   (format stream " ~A " (spc:op infix))
105
   (extract-expression (spc:rhs infix) stream))
106
 
107
 (defmethod print-object ((application spc:application) stream)
108
   (format stream "~(~a~)" (spc:func application))
109
   ;; put fill printing?
110
   (dolist (expr (spc:arguments application))
111
     (format stream " ")
112
     (extract-expression expr stream)))
113
 
114
 (defmethod print-object ((wire spc:wire) stream)
115
   (format stream "~(~a~)" (spc:var wire)))
116
 
117
 (defmethod print-object ((tup spc:tuple) stream)
118
   (pprint-logical-block (stream nil :prefix "(" :suffix ")")
119
     (format stream "~{~(~a~)~^, ~}" (spc:wires tup))))
120
 
121
 (defmethod print-object ((curly spc:curly) stream)
122
   (format stream "{~A}" (spc:value curly)))
123
 
124
 (defmethod print-object ((const spc:constant) stream)
125
   (format stream "~(~a~)" (spc:const const)))
126
 
127
 (defmethod print-object ((brackets spc:brackets) stream)
128
   (format stream "[]"))