From 84db9d8c5349cb8b3e7e2d102867e53e610d7ef2 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Sat, 16 Aug 2008 06:00:35 +0000
Subject: 	* algebra/strap:  New.  Sequester cached Lisp translation of 
 algebra bootstrap domains here.

---
 src/algebra/strap/ALAGG.lsp | 55 +++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 55 insertions(+)
 create mode 100644 src/algebra/strap/ALAGG.lsp

(limited to 'src/algebra/strap/ALAGG.lsp')

diff --git a/src/algebra/strap/ALAGG.lsp b/src/algebra/strap/ALAGG.lsp
new file mode 100644
index 00000000..e42de7db
--- /dev/null
+++ b/src/algebra/strap/ALAGG.lsp
@@ -0,0 +1,55 @@
+
+(/VERSIONCHECK 2) 
+
+(DEFPARAMETER |AssociationListAggregate;CAT| 'NIL) 
+
+(DEFPARAMETER |AssociationListAggregate;AL| 'NIL) 
+
+(DEFUN |AssociationListAggregate| (&REST #0=#:G1397 &AUX #1=#:G1395)
+  (DSETQ #1# #0#)
+  (LET (#2=#:G1396)
+    (COND
+      ((SETQ #2#
+             (|assoc| (|devaluateList| #1#)
+                      |AssociationListAggregate;AL|))
+       (CDR #2#))
+      (T (SETQ |AssociationListAggregate;AL|
+               (|cons5| (CONS (|devaluateList| #1#)
+                              (SETQ #2#
+                                    (APPLY
+                                     #'|AssociationListAggregate;| #1#)))
+                        |AssociationListAggregate;AL|))
+         #2#)))) 
+
+(DEFUN |AssociationListAggregate;| (|t#1| |t#2|)
+  (PROG (#0=#:G1394)
+    (RETURN
+      (PROG1 (LETT #0#
+                   (|sublisV|
+                       (PAIR '(|t#1| |t#2|)
+                             (LIST (|devaluate| |t#1|)
+                                   (|devaluate| |t#2|)))
+                       (|sublisV|
+                           (PAIR '(#1=#:G1393)
+                                 (LIST '(|Record| (|:| |key| |t#1|)
+                                         (|:| |entry| |t#2|))))
+                           (COND
+                             (|AssociationListAggregate;CAT|)
+                             ('T
+                              (LETT |AssociationListAggregate;CAT|
+                                    (|Join|
+                                     (|TableAggregate| '|t#1| '|t#2|)
+                                     (|ListAggregate| '#1#)
+                                     (|mkCategory| '|domain|
+                                      '(((|assoc|
+                                          ((|Union|
+                                            (|Record| (|:| |key| |t#1|)
+                                             (|:| |entry| |t#2|))
+                                            "failed")
+                                           |t#1| $))
+                                         T))
+                                      NIL 'NIL NIL))
+                                    . #2=(|AssociationListAggregate|)))))) . #2#)
+        (SETELT #0# 0
+                (LIST '|AssociationListAggregate| (|devaluate| |t#1|)
+                      (|devaluate| |t#2|))))))) 
-- 
cgit v1.2.3