From 5e504b6abaef6cf7e7c58c17e26bec33856b60c0 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Sun, 17 Aug 2008 08:59:26 +0000
Subject: 	* algebra/Makefile.pamphlet (all-algstrap): New. 	*
 algebra/strap: Update cached Lisp translation.

---
 src/algebra/strap/FPS-.lsp | 55 +++++++++++++++++++++++++++++++++++++++-------
 1 file changed, 47 insertions(+), 8 deletions(-)

(limited to 'src/algebra/strap/FPS-.lsp')

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|)))) 
-- 
cgit v1.2.3