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/FPS-.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/FPS-.lsp')
| -rw-r--r-- | src/algebra/strap/FPS-.lsp | 55 |
1 files changed, 47 insertions, 8 deletions
diff --git a/src/algebra/strap/FPS-.lsp b/src/algebra/strap/FPS-.lsp index 56751bc4..1ec37dce 100644 --- a/src/algebra/strap/FPS-.lsp +++ b/src/algebra/strap/FPS-.lsp @@ -2,17 +2,18 @@ (/VERSIONCHECK 2) (DEFUN |FPS-;float;2IS;1| (|ma| |ex| $) - (SPADCALL |ma| |ex| (SPADCALL (QREFELT $ 8)) (QREFELT $ 10))) + (SPADCALL |ma| |ex| (SPADCALL (|getShellEntry| $ 8)) + (|getShellEntry| $ 10))) (DEFUN |FPS-;digits;Pi;2| ($) - (PROG (#0=#:G1389) + (PROG (#0=#:G1398) (RETURN (PROG1 (LETT #0# (MAX 1 (QUOTIENT2 (SPADCALL 4004 - (- (SPADCALL (QREFELT $ 13)) 1) - (QREFELT $ 14)) + (- (SPADCALL (|getShellEntry| $ 13)) 1) + (|getShellEntry| $ 14)) 13301)) |FPS-;digits;Pi;2|) (|check-subtype| (> #0# 0) '(|PositiveInteger|) #0#))))) @@ -23,15 +24,15 @@ (PROGN (LETT |dv$1| (|devaluate| |#1|) . #0=(|FloatingPointSystem&|)) (LETT |dv$| (LIST '|FloatingPointSystem&| |dv$1|) . #0#) - (LETT $ (GETREFV 17) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 + (LETT $ (|newShell| 17) . #0#) + (|setShellEntry| $ 0 |dv$|) + (|setShellEntry| $ 3 (LETT |pv$| (|buildPredVector| 0 0 (LIST (|HasAttribute| |#1| '|arbitraryExponent|) (|HasAttribute| |#1| '|arbitraryPrecision|))) . #0#)) (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) + (|setShellEntry| $ 6 |#1|) $)))) (MAKEPROP '|FloatingPointSystem&| '|infovec| @@ -48,3 +49,41 @@ 13 2 9 0 7 0 14 0 6 0 15 2 0 0 9 9 11 0 0 7 16))))) '|lookupComplete|)) + +(SETQ |$CategoryFrame| + (|put| '|FloatingPointSystem&| '|isFunctor| + '(((|digits| ((|PositiveInteger|) (|PositiveInteger|))) T + (ELT $ NIL)) + ((|digits| ((|PositiveInteger|))) T (ELT $ 16)) + ((|float| ($ (|Integer|) (|Integer|) + (|PositiveInteger|))) + T (ELT $ NIL)) + ((|float| ($ (|Integer|) (|Integer|))) T (ELT $ 11))) + (|addModemap| '|FloatingPointSystem&| + '(|FloatingPointSystem&| |#1|) + '((CATEGORY |domain| + (SIGNATURE |digits| + ((|PositiveInteger|) (|PositiveInteger|))) + (SIGNATURE |digits| ((|PositiveInteger|))) + (SIGNATURE |float| + (|#1| (|Integer|) (|Integer|) + (|PositiveInteger|))) + (SIGNATURE |float| + (|#1| (|Integer|) (|Integer|)))) + (|FloatingPointSystem|)) + T '|FloatingPointSystem&| + (|put| '|FloatingPointSystem&| '|mode| + '(|Mapping| + (CATEGORY |domain| + (SIGNATURE |digits| + ((|PositiveInteger|) + (|PositiveInteger|))) + (SIGNATURE |digits| + ((|PositiveInteger|))) + (SIGNATURE |float| + (|#1| (|Integer|) (|Integer|) + (|PositiveInteger|))) + (SIGNATURE |float| + (|#1| (|Integer|) (|Integer|)))) + (|FloatingPointSystem|)) + |$CategoryFrame|)))) |