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

KindCoveredAll%
expression1991 20.9
branch00nil
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 (in-package :geb-list)
2
 
3
 (defparameter *nil* (alias nil (so1)))
4
 
5
 (defparameter *cons-type* (reference 'cons))
6
 
7
 (defparameter *list*
8
   (alias list
9
          (coprod *nil* *cons-type*)))
10
 
11
 ;; we should register this somewhere for checking if we care
12
 (defparameter *canonical-cons-type*
13
   (opaque 'cons
14
           (prod geb-bool:bool *list*)))
15
 
16
 (defparameter *cons*
17
   (alias cons-μ
18
          (opaque-morph (prod geb-bool:bool *list*)
19
                        :codom *cons-type*)))
20
 
21
 (defparameter *car*
22
   (alias car
23
          (opaque-morph (<-left geb-bool:bool *list*)
24
                        :dom *cons-type*)))
25
 
26
 (defparameter *cdr*
27
   (alias cdr
28
          (opaque-morph (<-right geb-bool:bool *list*)
29
                        :dom *cons-type*)))
30
 
31
 (def cons->list
32
   (->right *nil* *cons-type*))
33
 
34
 (def nil->list
35
   (->left *nil* *cons-type*))
36
 
37
 (defun cons-on-list (terminal-morphism)
38
   "Cons an element onto a list, assuming our value can be created from
39
 [SO1][class]"
40
   (comp *cons* (pair (comp terminal-morphism (terminal *list*))
41
                      *list*)))
42
 
43
 
44
 ;; let the optimizer handle this
45
 (defun cons-on-nil (terminal-morphism)
46
   "Cons an element onto a nil, assuming our value can be created from
47
 [SO1][class]"
48
   (comp (cons-on-list terminal-morphism)
49
         nil->list))
50
 
51
 ;; let the optimizer handle this
52
 (defun cons-on-cons (terminal-morphism)
53
   "Cons an element onto a cons, assuming our value can be created from
54
 [SO1][class]"
55
   (comp (cons-on-list terminal-morphism)
56
         cons->list))
57
 
58
 (def silly-example
59
   (comp (mcase nil->list
60
                (comp cons->list (cons-on-cons geb-bool:true)))
61
         cons->list *cons*))
62
 
63
 (def silly-example-cdring
64
   (comp (cons-on-cons geb-bool:false)
65
         (mcase (cons-on-nil geb-bool:true)
66
                *cons-type*)
67
         *cdr* (cons-on-list geb-bool:true) *cdr*))
68