expand changed:

- it now takes an optional environment (it was required)
  - it no longer returns a second value (list of libraries)
  - it's output is "pretty".

the old expand is now called core-expand.

scheme/ikarus.compiler.ss

@@ -18,8 +18,8 @@
   (export compile-core-expr-to-port 
           assembler-output optimize-cp
           current-primitive-locations eval-core
-          current-core-eval
-          compile-core-expr expand/optimize optimizer-output
+          current-core-eval compile-core-expr 
+          expand expand/optimize optimizer-output
           cp0-effort-limit cp0-size-limit optimize-level 
           perform-tag-analysis tag-analysis-output
           strip-source-info generate-debug-calls)
@@ -36,7 +36,7 @@
         compile-core-expr-to-port assembler-output
         current-primitive-locations eval-core
         cp0-size-limit cp0-effort-limit 
-        expand/optimize optimizer-output
+        expand/optimize expand optimizer-output
         tag-analysis-output perform-tag-analysis
         current-core-eval)
     (ikarus.fasl.write)
@@ -2481,19 +2481,30 @@
              (refresh-cached-labels!))
            (error 'current-primitive-locations "not a procedure" p))])))
 
+(define (expand/pretty x env who . passes)
+  (unless (environment? env)
+    (die who "not an environment" env))
+  (let-values ([(x libs) (core-expand x env)])
+    (let f ([x (recordize x)] [passes passes])
+      (if (null? passes)
+          (unparse-pretty x)
+          (f ((car passes) x) (cdr passes))))))
+
 (define expand/optimize
   (case-lambda
-    [(p) (expand/optimize p (interaction-environment))]
-    [(p env)
-     (unless (environment? env)
-       (env 'expand/optimize "not an environment" env))
-     (let-values ([(p lib*) (expand p env)])
-       (let* ([p (recordize p)]
-              [p (parameterize ([open-mvcalls #f])
-                   (optimize-direct-calls p))]
-              [p (optimize-letrec/scc p)]
-              [p (source-optimize p)])
-         (unparse-pretty p)))]))
+    [(x) (expand/optimize x (interaction-environment))]
+    [(x env)
+     (expand/pretty x env 'expand/optimize
+       (lambda (x) 
+         (parameterize ([open-mvcalls #f])
+            (optimize-direct-calls x)))
+       optimize-letrec/scc
+       source-optimize)]))
+
+(define expand
+  (case-lambda
+    [(x) (expand x (interaction-environment))]
+    [(x env) (expand/pretty x env 'expand)]))
 
 )
 

scheme/last-revision

@@ -1 +1 @@
-1797
+1798

scheme/makefile.ss

@@ -19,7 +19,7 @@
 (import (except (ikarus) 
           current-core-eval
           assembler-output optimize-cp optimize-level
-          cp0-size-limit cp0-effort-limit expand/optimize
+          cp0-size-limit cp0-effort-limit expand/optimize expand
           optimizer-output tag-analysis-output perform-tag-analysis))
 (import (ikarus.compiler))
 (import (except (psyntax system $bootstrap)
@@ -390,6 +390,7 @@
     [optimizer-output                            i]
     [new-cafe                                    i]
     [expand                                      i]
+    [core-expand                                 i]
     [expand/optimize                             i]
     [environment?                                i]
     [environment-symbols                         i]

scheme/psyntax.expander.ss

@@ -20,7 +20,8 @@
 
 (library (psyntax expander)
   (export identifier? syntax-dispatch 
-          eval expand generate-temporaries free-identifier=?
+          eval core-expand 
+          generate-temporaries free-identifier=?
           bound-identifier=? datum->syntax syntax-error
           syntax-violation
           syntax->datum 
@@ -3752,7 +3753,7 @@
   ;;; expander (chi-expr).   It takes an expression and an environment.
   ;;; It returns two values: The resulting core-expression and a list of
   ;;; libraries that must be invoked before evaluating the core expr.
-  (define expand
+  (define core-expand
     (lambda (x env)
       (cond
         ((env? env)
@@ -3785,6 +3786,7 @@
         (else
          (assertion-violation 'expand "not an environment" env)))))
 
+
   ;;; This is R6RS's eval.  It takes an expression and an environment,
   ;;; expands the expression, invokes its invoke-required libraries and
   ;;; evaluates its expanded core form.
@@ -3792,7 +3794,7 @@
     (lambda (x env)
       (unless (environment? env)
         (error 'eval "not an environment" env))
-      (let-values (((x invoke-req*) (expand x env)))
+      (let-values (((x invoke-req*) (core-expand x env)))
         (for-each invoke-library invoke-req*)
         (eval-core (expanded->core x)))))