Coverage report: /home/runner/work/geb/geb/src/specs/extension-printer.lisp

KindCoveredAll%
expression036 0.0
branch00nil
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;; We use CL streams as they are much better for concatenating to, and
2
 ;; have us worry less. they are a mutable interface however.
3
 
4
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5
 ;; FORMAT RUNDOWN FOR THOSE WHO ARE UNFAMILIAR
6
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7
 
8
 ;; https://www.cs.cmu.edu/Groups/AI/html/cltl/clm/node257.html
9
 
10
 ;; DSL FOR NEWLINES AND CONTROL OF IT
11
 
12
 ;; ~4I  = (pprint-indent :block   4)
13
 ;; ~4:I = (pprint-indent :current 4)
14
 ;; ~_   = (pprint-newline :linear)
15
 ;; ~@_  = (pprint-newline :miser)
16
 ;; ~:@_ = (pprint-newline :mandatory)
17
 ;; ~:_  = (pprint-newline :fill)
18
 
19
 
20
 ;; FOR PRINTING NORMALLY NOTE THESE TAKE ARGUMENTS!
21
 
22
 ;; ~(~a~)    = print symbol lower case instead of upper case
23
 ;; ~{~A~}    = prints a list element by element.
24
 
25
 ;; ~{~A~^ ~} = prints a list element by element, the last element of
26
 ;;             the list does not print the extra space
27
 ;; EXAMPLE:
28
 ;; CL-USER> (format nil "~{~A~^ ~}" (list 1 2 3 4 5))
29
 ;; "1 2 3 4 5"
30
 ;; CL-USER> (format nil "~{~A ~}" (list 1 2 3 4 5))
31
 ;; "1 2 3 4 5 "
32
 
33
 
34
 (in-package #:geb.extension.spec)
35
 
36
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
37
 ;; Subst Constructor Printer
38
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
39
 
40
 (defmacro with-alias-overide ((obj stream) &body otherwise)
41
   "Prints out an alias instead of the body if it can detect an alias.
42
 
43
 Effectively this overrides any printing that would naturally occur"
44
   (let ((alias    (gensym))
45
         (in-there (gensym)))
46
     `(multiple-value-bind (,alias ,in-there) (geb.mixins:meta-lookup ,obj :alias)
47
        (if ,in-there
48
            (format ,stream "~W" ,alias)
49
            (progn ,@otherwise)))))
50
 
51
 (defmethod print-object ((obj reference) stream)
52
   (with-alias-overide (obj stream)
53
     (format stream "~W" (name obj))))
54
 
55
 (defmethod print-object ((obj opaque) stream)
56
   (with-alias-overide (obj stream)
57
     (format stream "~W" (name obj))))
58
 
59
 (defmethod print-object ((obj opaque-morph) stream)
60
   (with-alias-overide (obj stream)
61
     (print-unreadable-object (obj stream)
62
       (format stream "DOM: ~W~_ CODOM: ~W" (dom obj) (codom obj)))))
63
 
64
 (defmethod print-object ((obj common-sub-expression) stream)
65
   (print-unreadable-object (obj stream)
66
     (print-object (obj obj) stream)))
67