diff options
Diffstat (limited to 'src/algebra/strap/ABELMON-.lsp')
| -rw-r--r-- | src/algebra/strap/ABELMON-.lsp | 43 |
1 files changed, 35 insertions, 8 deletions
diff --git a/src/algebra/strap/ABELMON-.lsp b/src/algebra/strap/ABELMON-.lsp index a38826e3..82017e64 100644 --- a/src/algebra/strap/ABELMON-.lsp +++ b/src/algebra/strap/ABELMON-.lsp @@ -2,17 +2,17 @@ (/VERSIONCHECK 2) (DEFUN |ABELMON-;zero?;SB;1| (|x| $) - (SPADCALL |x| (|spadConstant| $ 7) (QREFELT $ 9))) + (SPADCALL |x| (|spadConstant| $ 7) (|getShellEntry| $ 9))) (DEFUN |ABELMON-;*;Pi2S;2| (|n| |x| $) - (SPADCALL |n| |x| (QREFELT $ 12))) + (SPADCALL |n| |x| (|getShellEntry| $ 12))) (DEFUN |ABELMON-;sample;S;3| ($) (|spadConstant| $ 7)) (DEFUN |ABELMON-;*;Nni2S;4| (|n| |x| $) (COND ((ZEROP |n|) (|spadConstant| $ 7)) - ('T (SPADCALL |n| |x| (QREFELT $ 17))))) + ('T (SPADCALL |n| |x| (|getShellEntry| $ 17))))) (DEFUN |AbelianMonoid&| (|#1|) (PROG (|dv$1| |dv$| $ |pv$|) @@ -20,15 +20,16 @@ (PROGN (LETT |dv$1| (|devaluate| |#1|) . #0=(|AbelianMonoid&|)) (LETT |dv$| (LIST '|AbelianMonoid&| |dv$1|) . #0#) - (LETT $ (GETREFV 19) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (LETT $ (|newShell| 19) . #0#) + (|setShellEntry| $ 0 |dv$|) + (|setShellEntry| $ 3 + (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) + (|setShellEntry| $ 6 |#1|) (COND ((|HasCategory| |#1| '(|Ring|))) ('T - (QSETREFV $ 18 + (|setShellEntry| $ 18 (CONS (|dispatchFunction| |ABELMON-;*;Nni2S;4|) $)))) $)))) @@ -47,3 +48,29 @@ 16 6 13 6 17 2 0 0 11 0 18 1 0 8 0 10 0 0 0 15 2 0 0 11 0 18 2 0 0 13 0 14))))) '|lookupComplete|)) + +(SETQ |$CategoryFrame| + (|put| '|AbelianMonoid&| '|isFunctor| + '(((* ($ (|NonNegativeInteger|) $)) T (ELT $ 18)) + ((|zero?| ((|Boolean|) $)) T (ELT $ 10)) + ((|sample| ($)) T (ELT $ 15)) + ((* ($ (|PositiveInteger|) $)) T (ELT $ 14))) + (|addModemap| '|AbelianMonoid&| '(|AbelianMonoid&| |#1|) + '((CATEGORY |domain| + (SIGNATURE * (|#1| (|NonNegativeInteger|) |#1|)) + (SIGNATURE |zero?| ((|Boolean|) |#1|)) + (SIGNATURE |sample| (|#1|)) + (SIGNATURE * (|#1| (|PositiveInteger|) |#1|))) + (|AbelianMonoid|)) + T '|AbelianMonoid&| + (|put| '|AbelianMonoid&| '|mode| + '(|Mapping| + (CATEGORY |domain| + (SIGNATURE * + (|#1| (|NonNegativeInteger|) |#1|)) + (SIGNATURE |zero?| ((|Boolean|) |#1|)) + (SIGNATURE |sample| (|#1|)) + (SIGNATURE * + (|#1| (|PositiveInteger|) |#1|))) + (|AbelianMonoid|)) + |$CategoryFrame|)))) |