diff options
| author | dos-reis <gdr@axiomatics.org> | 2008-08-17 08:59:26 +0000 |
|---|---|---|
| committer | dos-reis <gdr@axiomatics.org> | 2008-08-17 08:59:26 +0000 |
| commit | 5e504b6abaef6cf7e7c58c17e26bec33856b60c0 (patch) | |
| tree | fc93b37d696d3c1ca38437a5ad9a815a85fe46b7 /src/algebra/strap/MONOID-.lsp | |
| parent | ffb91646c6f11e84fa886aa5abc2de61ba291cc1 (diff) | |
| download | open-axiom-5e504b6abaef6cf7e7c58c17e26bec33856b60c0.tar.gz | |
* algebra/Makefile.pamphlet (all-algstrap): New.
* algebra/strap: Update cached Lisp translation.
Diffstat (limited to 'src/algebra/strap/MONOID-.lsp')
| -rw-r--r-- | src/algebra/strap/MONOID-.lsp | 58 |
1 files changed, 50 insertions, 8 deletions
diff --git a/src/algebra/strap/MONOID-.lsp b/src/algebra/strap/MONOID-.lsp index c9bcbbe5..cd87b5fc 100644 --- a/src/algebra/strap/MONOID-.lsp +++ b/src/algebra/strap/MONOID-.lsp @@ -2,22 +2,23 @@ (/VERSIONCHECK 2) (DEFUN |MONOID-;^;SNniS;1| (|x| |n| $) - (SPADCALL |x| |n| (QREFELT $ 8))) + (SPADCALL |x| |n| (|getShellEntry| $ 8))) (DEFUN |MONOID-;one?;SB;2| (|x| $) - (SPADCALL |x| (|spadConstant| $ 10) (QREFELT $ 12))) + (SPADCALL |x| (|spadConstant| $ 10) (|getShellEntry| $ 12))) (DEFUN |MONOID-;sample;S;3| ($) (|spadConstant| $ 10)) (DEFUN |MONOID-;recip;SU;4| (|x| $) (COND - ((SPADCALL |x| (|spadConstant| $ 10) (QREFELT $ 12)) (CONS 0 |x|)) + ((SPADCALL |x| (|spadConstant| $ 10) (|getShellEntry| $ 12)) + (CONS 0 |x|)) ('T (CONS 1 "failed")))) (DEFUN |MONOID-;**;SNniS;5| (|x| |n| $) (COND ((ZEROP |n|) (|spadConstant| $ 10)) - ('T (SPADCALL |x| |n| (QREFELT $ 19))))) + ('T (SPADCALL |x| |n| (|getShellEntry| $ 19))))) (DEFUN |Monoid&| (|#1|) (PROG (|dv$1| |dv$| $ |pv$|) @@ -25,11 +26,12 @@ (PROGN (LETT |dv$1| (|devaluate| |#1|) . #0=(|Monoid&|)) (LETT |dv$| (LIST '|Monoid&| |dv$1|) . #0#) - (LETT $ (GETREFV 21) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (LETT $ (|newShell| 21) . #0#) + (|setShellEntry| $ 0 |dv$|) + (|setShellEntry| $ 3 + (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) + (|setShellEntry| $ 6 |#1|) $)))) (MAKEPROP '|Monoid&| '|infovec| @@ -48,3 +50,43 @@ 18 6 6 17 19 0 0 0 14 1 0 15 0 16 1 0 11 0 13 2 0 0 0 7 9 2 0 0 0 7 20))))) '|lookupComplete|)) + +(SETQ |$CategoryFrame| + (|put| '|Monoid&| '|isFunctor| + '(((|recip| ((|Union| $ "failed") $)) T (ELT $ 16)) + ((^ ($ $ (|NonNegativeInteger|))) T (ELT $ 9)) + ((** ($ $ (|NonNegativeInteger|))) T (ELT $ 20)) + ((|one?| ((|Boolean|) $)) T (ELT $ 13)) + ((|sample| ($)) T (ELT $ 14)) + ((^ ($ $ (|PositiveInteger|))) T (ELT $ NIL)) + ((** ($ $ (|PositiveInteger|))) T (ELT $ NIL))) + (|addModemap| '|Monoid&| '(|Monoid&| |#1|) + '((CATEGORY |domain| + (SIGNATURE |recip| + ((|Union| |#1| "failed") |#1|)) + (SIGNATURE ^ (|#1| |#1| (|NonNegativeInteger|))) + (SIGNATURE ** + (|#1| |#1| (|NonNegativeInteger|))) + (SIGNATURE |one?| ((|Boolean|) |#1|)) + (SIGNATURE |sample| (|#1|)) + (SIGNATURE ^ (|#1| |#1| (|PositiveInteger|))) + (SIGNATURE ** (|#1| |#1| (|PositiveInteger|)))) + (|Monoid|)) + T '|Monoid&| + (|put| '|Monoid&| '|mode| + '(|Mapping| + (CATEGORY |domain| + (SIGNATURE |recip| + ((|Union| |#1| "failed") |#1|)) + (SIGNATURE ^ + (|#1| |#1| (|NonNegativeInteger|))) + (SIGNATURE ** + (|#1| |#1| (|NonNegativeInteger|))) + (SIGNATURE |one?| ((|Boolean|) |#1|)) + (SIGNATURE |sample| (|#1|)) + (SIGNATURE ^ + (|#1| |#1| (|PositiveInteger|))) + (SIGNATURE ** + (|#1| |#1| (|PositiveInteger|)))) + (|Monoid|)) + |$CategoryFrame|)))) |