From 5868cd448c4c14661e65077f4f53ef1001e6dbf7 Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Thu, 1 Nov 2018 13:20:20 -0400
Subject: [PATCH] Cleaner flattening now that code generation has been fixed

---
 flatten-seq.scm               | 25 +++++++++++++------------
 scheme/cyclone/transforms.sld | 18 +++++++++---------
 2 files changed, 22 insertions(+), 21 deletions(-)

diff --git a/flatten-seq.scm b/flatten-seq.scm
index cf9b6333..e579efef 100644
--- a/flatten-seq.scm
+++ b/flatten-seq.scm
@@ -3,37 +3,38 @@
 (define sexp
   '(Cyc-seq
          (set! b '(#f . #f))
-         ((Cyc-seq
+         (Cyc-seq
            (set-car!  a 1)
-           ((Cyc-seq
-             (set-cdr!  a '(2))))))))
+           (Cyc-seq
+             (set-cdr!  a '(2))
+             ((fnc a1 a2 a3))))))
 
 ;; Flatten a list containing subcalls of a given symbol.
 ;; For example, the expression: 
 ;;
 ;;  '(Cyc-seq
 ;;         (set! b '(#f . #f))
-;;         ((Cyc-seq
+;;         (Cyc-seq
 ;;           (set-car!  a 1)
-;;           ((Cyc-seq
-;;             (set-cdr!  a '(2)))))))
+;;           (Cyc-seq
+;;             (set-cdr!  a '(2))
+;;             ((fnc a1 a2 a3)))))
 ;;
 ;; becomes:
 ;;
 ;;  '(Cyc-seq
 ;;     (set! b '(#f . #f))
-;;     (set-car!  a 1)
-;;     (set-cdr!  a '(2)))
+;;     (set-car! a 1)
+;;     (set-cdr! a '(2))
+;;     ((fnc a1 a2 a3)))
 ;;
 (define (flatten-subcalls sexp sym)
   (define (flat sexp acc)
     (cond
       ((not (pair? sexp))
        acc)
-      ((and (app? (car sexp))
-            (app? (caar sexp))
-            (tagged-list? sym (caar sexp)))
-       (flat (cdaar sexp) acc))
+      ((and (tagged-list? sym (car sexp)))
+        (flat (cdar sexp) acc))
       (else ;;(pair? sexp)
         (flat (cdr sexp) (cons (car sexp) acc))))
   )
diff --git a/scheme/cyclone/transforms.sld b/scheme/cyclone/transforms.sld
index 931e1087..3afca0b0 100644
--- a/scheme/cyclone/transforms.sld
+++ b/scheme/cyclone/transforms.sld
@@ -814,27 +814,27 @@
 ;;
 ;;  '(Cyc-seq
 ;;         (set! b '(#f . #f))
-;;         ((Cyc-seq
+;;         (Cyc-seq
 ;;           (set-car!  a 1)
-;;           ((Cyc-seq
-;;             (set-cdr!  a '(2)))))))
+;;           (Cyc-seq
+;;             (set-cdr!  a '(2))
+;;             ((fnc a1 a2 a3)))))
 ;;
 ;; becomes:
 ;;
 ;;  '(Cyc-seq
 ;;     (set! b '(#f . #f))
-;;     (set-car!  a 1)
-;;     (set-cdr!  a '(2)))
+;;     (set-car! a 1)
+;;     (set-cdr! a '(2))
+;;     ((fnc a1 a2 a3)))
 ;;
 (define (flatten-subcalls sexp sym)
   (define (flat sexp acc)
     (cond
       ((not (pair? sexp))
        acc)
-      ((and (app? (car sexp))
-            (app? (caar sexp))
-            (tagged-list? sym (caar sexp)))
-       (flat (cdaar sexp) acc))
+      ((and (tagged-list? sym (car sexp)))
+        (flat (cdar sexp) acc))
       (else ;;(pair? sexp)
         (flat (cdr sexp) (cons (car sexp) acc))))
   )