Coverage report: /home/runner/work/geb/geb/src/geb/bool.lisp

KindCoveredAll%
expression0103 0.0
branch00nil
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 (in-package :geb-bool)
2
 
3
 ;; I need a defadt macro, all this is all derivable, trivial so even?
4
 
5
 ;; Also I want a variable to control so Ι can expand these names
6
 ;; only, as Ι pretty print.
7
 
8
 (def false-obj (alias false (so1)))
9
 (def true-obj (alias true (so1)))
10
 
11
 (def true (alias true (->right false-obj true-obj)))
12
 (def false (alias false (->left false-obj true-obj)))
13
 
14
 (def bool (alias bool (coprod false-obj true-obj)))
15
 
16
 ;; TODO make my own custom def macro so they are with the defn!
17
 
18
 (setf (documentation 'bool 'pax:symbol-macro)
19
       "The Boolean Type, composed of a coproduct of two unit objects
20
 
21
 ```lisp
22
 (coprod so1 so1)
23
 ```")
24
 
25
 (setf (documentation 'true 'pax:symbol-macro)
26
       "The true value of a boolean type. In this case we've defined true as
27
 the right unit")
28
 
29
 (setf (documentation 'false 'pax:symbol-macro)
30
       "The false value of a boolean type. In this case we've defined true as
31
 the left unit")
32
 
33
 (defun so-uncurry (x y f)
34
   x y f)
35
 
36
 ;; we are seeing a trend in definitions!
37
 ;; this gives us a peek at what to make macros over
38
 (def not
39
   (alias not
40
          (mcase true false)))
41
 
42
 (setf (documentation 'not 'pax:symbol-macro)
43
       "Turns a TRUE into a FALSE and vice versa")
44
 
45
 ;; this is curried and,
46
 (def cand
47
   (pair (const false bool)
48
         bool))
49
 
50
 (def iso1
51
   (flet ((bool-from (x)
52
            (<-left bool x)))
53
     (mcase (comp (->left bool bool)
54
                  (bool-from false-obj))
55
            (comp (->right bool bool)
56
                  (bool-from true-obj)))))
57
 
58
 (def and-on-sum
59
   (mcase (const false bool) bool))
60
 
61
 (def and-more-verbose
62
   (comp and-on-sum iso1 (distribute bool false-obj true-obj)))
63
 
64
 (def and
65
   (comp (mcase (const false (prod bool false-obj))
66
                (<-left bool true-obj))
67
         (distribute bool false-obj true-obj)))
68
 
69
 (def or
70
   (pair bool
71
         (const true bool)))
72
 
73
 ;; (def sand
74
 ;;   (alias and
75
 ;;          ))
76
 ��