From e64b76dffb8ecaca189cbc65cd113ff745d8df2b Mon Sep 17 00:00:00 2001
From: Joe Marshall <eval.apply@gmail.com>
Date: Wed, 23 May 2012 10:41:55 -0700
Subject: [PATCH] Add way to dump macroexpanded and optimized output from SF.
---
src/sf/toplev.scm | 36 +++++++++++++++++++++++++++++++-----
1 file changed, 31 insertions(+), 5 deletions(-)
diff --git a/src/sf/toplev.scm b/src/sf/toplev.scm
index 90d18667c..f0c4d6508 100644
--- a/src/sf/toplev.scm
+++ b/src/sf/toplev.scm
@@ -152,6 +152,16 @@ USA.
(with-notification message do-it)))
(do-it))))))
+;; If not #F, should be a string file type. SF will pretty print
+;; the macro-expanded, but unoptimized file content to the output
+;; directory in a file with this extension.
+(define macroexpanded-pathname-type #f)
+
+;; If not #F, should be a string file type. SF will pretty print
+;; the optimized file content to the output directory in a file
+;; with this extension.
+(define optimized-pathname-type #f)
+
(define (sf/file->scode input-pathname output-pathname
environment declarations)
(fluid-let ((sf/default-externs-pathname
@@ -162,12 +172,23 @@ USA.
externs-pathname-type
'NEWEST)))
(receive (expression externs-block externs)
- (integrate/file input-pathname environment declarations)
+ (integrate/file input-pathname
+ (and output-pathname
+ macroexpanded-pathname-type
+ (pathname-new-type output-pathname
+ macroexpanded-pathname-type))
+ environment declarations)
(if output-pathname
(write-externs-file (pathname-new-type output-pathname
externs-pathname-type)
externs-block
externs))
+ (if (and output-pathname
+ optimized-pathname-type)
+ (call-with-output-file
+ (pathname-new-type output-pathname optimized-pathname-type)
+ (lambda (port)
+ (pp expression port))))
expression)))
(define externs-pathname-type
@@ -228,12 +249,17 @@ USA.
;;;; Optimizer Top Level
-(define (integrate/file file-name environment declarations)
+(define (integrate/file file-name macroexpanded-file-name environment declarations)
(integrate/kernel
(lambda ()
- (phase:syntax (phase:read file-name)
- environment
- declarations))))
+ (let ((scode (phase:syntax (phase:read file-name)
+ environment
+ declarations)))
+ (if macroexpanded-file-name
+ (call-with-output-file macroexpanded-file-name
+ (lambda (port)
+ (pp scode port))))
+ scode))))
(define (integrate/simple preprocessor input receiver)
(call-with-values
--
2.25.1