diff --git a/src/geb/geb.lisp b/src/geb/geb.lisp index c30ab6028..5d92096d9 100644 --- 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 ) 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 index bde4b8647..d1ab2cd43 100644 --- 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 () ())) (so-hom-obj pax:function) (so-card-alg pax:generic-function) (so-card-alg (pax:method () ())) diff --git a/src/generics/generics.lisp b/src/generics/generics.lisp index 3d79bbb8a..c02f24899 100644 --- 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 index db520b679..672b3b222 100644 --- 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)