Improvements to expand-body

scheme/cyclone/transforms.sld

@@ -839,89 +839,94 @@
   (expand-body '() exp env))
 
 ;; Helper to expand a lambda body, so we can splice in any begin's
+;(define (expand-body result exp env)
+;  (cond
+;   ((null? exp) (reverse result))
+;   ;; Splice in begin contents and keep expanding body
+;   ((begin? (car exp))
+;    (let* ((expr (car exp))
+;           (begin-exprs (begin->exps expr)))
+;    (expand-body
+;     result
+;     (append begin-exprs (cdr exp))
+;     env)))
+;   (else
+;    (let ((macro #f))
+;      (when (and (app? (car exp))
+;                 (symbol? (caar exp)))
+;        (set! macro (env:lookup (caar exp) env #f)))
+;      (if (tagged-list? 'macro macro)
+;          ;; Expand macro here so we can catch begins in the expanded code,
+;          ;; including nested begins
+;          (let ((expanded (macro:expand (car exp) macro env)))
+;            ;; Call with expanded macro in case we need to expand again
+;            (expand-body
+;              result
+;              (cons expanded (cdr exp))
+;              env))
+;          ;; No macro, use main expand function to process
+;          (expand-body
+;           (cons 
+;             (expand (car exp) env)
+;             result)
+;           (cdr exp)
+;           env))))))
+
+;; TODO: plan is, rewrite this to enhance it, test, commit, then figure
+;;       out why there is an infinite loop when we use this in cyclone.scm
+;;       for library compilation (in particular, for scheme base).
 (define (expand-body result exp env)
-  (cond
+  ;(display `(expand-body ,exp) (current-error-port))
-   ((null? exp) (reverse result))
+  (if (null? exp) 
-   ;; Splice in begin contents and keep expanding body
+    (reverse result)
-   ((begin? (car exp))
+    (let ((this-exp (car exp)))
-    (let* ((expr (car exp))
+      (cond
-           (begin-exprs (begin->exps expr)))
+       ((or (const? this-exp)
-    (expand-body
+            (prim? this-exp)
-     result
+            (ref? this-exp)
-     (append begin-exprs (cdr exp))
+            (quote? this-exp))
-     env)))
+        (expand-body (cons this-exp result) (cdr exp) env))
-   (else
+       ((or (define? this-exp)
-    (let ((macro #f))
+            (define-c? this-exp)
-      (when (and (app? (car exp))
+            (define-syntax? this-exp)
-                 (symbol? (caar exp)))
+            (lambda? this-exp)
-        (set! macro (env:lookup (caar exp) env #f)))
+            (set!? this-exp)
-      (if (tagged-list? 'macro macro)
+            (if? this-exp))
-          ;; Expand macro here so we can catch begins in the expanded code,
+        (expand-body 
-          ;; including nested begins
+          (cons
-          (let ((expanded (macro:expand (car exp) macro env)))
+            (expand this-exp env)
-            ;; Call with expanded macro in case we need to expand again
+            result)
-            (expand-body
+          (cdr exp)
-              result
+          env))
-              (cons expanded (cdr exp))
+       ;; Splice in begin contents and keep expanding body
-              env))
+       ((begin? (car exp))
-          ;; No macro, use main expand function to process
+        (let* ((expr (car exp))
-          (expand-body
+               (begin-exprs (begin->exps expr)))
-           (cons 
+        (expand-body
-             (expand (car exp) env)
+         result
-             result)
+         (append begin-exprs (cdr exp))
-           (cdr exp)
+         env)))
-           env))))))
+       (else
-;;(define (expand-body result exp env)
+        (let ((macro #f))
-;;  (if (null? exp) 
+          (when (and (app? (car exp))
-;;    (reverse result)
+                     (symbol? (caar exp)))
-;;    (let ((this-exp (car exp)))
+            (set! macro (env:lookup (caar exp) env #f)))
-;;      (cond
+          (if (tagged-list? 'macro macro)
-;;       ;; Splice in begin contents and keep expanding body
+              ;; Expand macro here so we can catch begins in the expanded code,
-;;       ((begin? (car exp))
+              ;; including nested begins
-;;        (let* ((expr (car exp))
+              (let ((expanded (macro:expand (car exp) macro env)))
-;;               (begin-exprs (begin->exps expr)))
+                ;; Call with expanded macro in case we need to expand again
-;;        (expand-body
+                (expand-body
-;;         result
+                  result
-;;         (append begin-exprs (cdr exp))
+                  (cons expanded (cdr exp))
-;;         env)))
+                  env))
-;;       ((or (const? this-exp)
+              ;; No macro, use main expand function to process
-;;            (prim? this-exp)
+              (expand-body
-;;            (ref? this-exp)
+               (cons 
-;;            (quote? this-exp))
+                 (expand (car exp) env)
-;;        (expand-body (cons this-exp result) (cdr exp) env))
+                 result)
-;;       ((or (define? this-exp)
+               (cdr exp)
-;;            (define-c? this-exp)
+               env))))))))
-;;            (define-syntax? this-exp)
-;;            (lambda? this-exp)
-;;            (set!? this-exp)
-;;            (if? this-exp))
-;;        (expand-body 
-;;          (cons
-;;            (expand this-exp env)
-;;            result)
-;;          (cdr exp)
-;;          env))
-;;       (else
-;;        (let ((macro #f))
-;;          (when (and (app? (car exp))
-;;                     (symbol? (caar exp)))
-;;            (set! macro (env:lookup (caar exp) env #f)))
-;;          (if (tagged-list? 'macro macro)
-;;              ;; Expand macro here so we can catch begins in the expanded code,
-;;              ;; including nested begins
-;;              (let ((expanded (macro:expand (car exp) macro env)))
-;;                ;; Call with expanded macro in case we need to expand again
-;;                (expand-body
-;;                  result
-;;                  (cons expanded (cdr exp))
-;;                  env))
-;;              ;; No macro, use main expand function to process
-;;              (expand-body
-;;               (cons 
-;;                 (expand (car exp) env)
-;;                 result)
-;;               (cdr exp)
-;;               env))))))))
 
 
 ;; Top-level analysis