Upgrade so-eval to a Generic

Makes the so-eval function into a generic function in order to be compatible with further Geb extensions.
anoma · Aug 29, 2023 · 3ce29a9 · 3ce29a9
1 parent 89cf93f
commit 3ce29a9
Show file tree

Hide file tree

Showing 4 changed files with 12 additions and 8 deletions.
diff --git a/src/geb/geb.lisp b/src/geb/geb.lisp
@@ -155,20 +155,18 @@ u
     (geb:so0          1)
     (geb:so1          1)))
 
-
-(-> so-eval (substobj substobj) substmorph)
-(defun so-eval (x y)
+(defmethod so-eval ((x <substobj>) y)
   (match-of substobj x
     (so0          (comp (init y) (<-right so1 so0)))
     (so1          (<-left y so1))
     ((coprod a b) (comp (mcase (comp (so-eval a y)
-                                     (so-forget-middle (!-> a y) (!-> b y) a))
+                                     (so-forget-middle (so-hom-obj a y) (so-hom-obj b y) a))
                                (comp (so-eval b y)
-                                     (so-forget-first (!-> a y) (!-> b y) b)))
-                        (distribute (prod (!-> a y) (!-> b y)) a b)))
+                                     (so-forget-first (so-hom-obj a y) (so-hom-obj b y) b)))
+                        (distribute (prod (so-hom-obj a y) (so-hom-obj b y)) a b)))
     ((prod a b)   (let ((eyz   (so-eval b y))
                         (exhyz (so-eval a (so-hom-obj b y)))
-                        (hom   (!-> a (so-hom-obj b y))))
+                        (hom   (so-hom-obj a (so-hom-obj b y))))
                     (comp eyz
                           (pair (comp exhyz (so-forget-right hom a b))
                                 (comp (<-right a b)

diff --git a/src/geb/package.lisp b/src/geb/package.lisp
@@ -21,7 +21,7 @@
   (commutes          pax:function)
   (commutes-left     pax:function)
   (!->               pax:function)
-  (so-eval           pax:function)
+  (so-eval           (pax:method () (<substobj>)))
   (so-hom-obj        pax:function)
   (so-card-alg       pax:generic-function)
   (so-card-alg       (pax:method () (<substobj>)))

diff --git a/src/generics/generics.lisp b/src/generics/generics.lisp
@@ -42,6 +42,11 @@ x
 (COPROD SO1 X)
 ```"))
 
+(defgeneric so-eval (object1 object2)
+  (:documentation
+   "Takes in X and Y Geb objects and provides an evaluation morphism
+(prod (so-hom-obj X Y) X) -> Y"))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Conversion functions
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

diff --git a/src/generics/package.lisp b/src/generics/package.lisp
@@ -14,6 +14,7 @@ The main documentation for the functionality is given here, with
 examples often given in the specific methods"
   (gapply     pax:generic-function)
   (maybe      pax:generic-function)
+  (so-eval    pax:generic-function)
   (to-circuit pax:generic-function)
   (to-bitc    pax:generic-function)
   (to-poly    pax:generic-function)