From f39c8c2ab9bf4ab06fefc09d75bcc95124d0acc1 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Sun, 6 Jun 2010 04:17:00 +0000
Subject: 	* interp/compiler.boot (compRepeatOrCollect): Compile list 
 comprehension to %collect form.

---
 src/algebra/strap/HOAGG-.lsp | 43 +++++++++++++++++--------------------------
 1 file changed, 17 insertions(+), 26 deletions(-)

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

diff --git a/src/algebra/strap/HOAGG-.lsp b/src/algebra/strap/HOAGG-.lsp
index d5cf82f5..45b2d2a1 100644
--- a/src/algebra/strap/HOAGG-.lsp
+++ b/src/algebra/strap/HOAGG-.lsp
@@ -195,33 +195,24 @@
              ('T NIL)))))) 
 
 (DEFUN |HOAGG-;coerce;AOf;10| (|x| $)
-  (PROG (#0=#:G1433 |a| #1=#:G1434)
+  (PROG ()
     (RETURN
-      (SEQ (SPADCALL
-               (SPADCALL
-                   (PROGN
-                     (LETT #0# NIL |HOAGG-;coerce;AOf;10|)
-                     (SEQ (LETT |a| NIL |HOAGG-;coerce;AOf;10|)
-                          (LETT #1#
-                                (SPADCALL |x| (|getShellEntry| $ 15))
-                                |HOAGG-;coerce;AOf;10|)
-                          G190
-                          (COND
-                            ((OR (ATOM #1#)
-                                 (PROGN
-                                   (LETT |a| (CAR #1#)
-                                    |HOAGG-;coerce;AOf;10|)
-                                   NIL))
-                             (GO G191)))
-                          (LETT #0#
-                                (CONS (SPADCALL |a|
-                                       (|getShellEntry| $ 39))
-                                      #0#)
-                                |HOAGG-;coerce;AOf;10|)
-                          (LETT #1# (CDR #1#) |HOAGG-;coerce;AOf;10|)
-                          (GO G190) G191 (EXIT (NREVERSE0 #0#))))
-                   (|getShellEntry| $ 41))
-               (|getShellEntry| $ 42)))))) 
+      (SPADCALL
+          (SPADCALL
+              (LET ((#0=#:G1434 (SPADCALL |x| (|getShellEntry| $ 15)))
+                    (#1=#:G1433 NIL))
+                (LOOP
+                  (COND
+                    ((ATOM #0#) (RETURN (NREVERSE #1#)))
+                    (T (LET ((|a| (CAR #0#)))
+                         (LETT #1#
+                               (CONS (SPADCALL |a|
+                                      (|getShellEntry| $ 39))
+                                     #1#)
+                               |HOAGG-;coerce;AOf;10|))))
+                  (LETT #0# (CDR #0#) |HOAGG-;coerce;AOf;10|)))
+              (|getShellEntry| $ 41))
+          (|getShellEntry| $ 42))))) 
 
 (DEFUN |HomogeneousAggregate&| (|#1| |#2|)
   (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$2| (|devaluate| |#2|))
-- 
cgit v1.2.3