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/MONOID-.lsp | 58 +++++++++++++++++++++++++++++++++++++------
 1 file changed, 50 insertions(+), 8 deletions(-)

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

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