[Chicken-hackers] [PATCH] Move user-pass parameters to dedicated module

[Evan Hanson]

Now that the compiler driver is a module, the parameters containing
user-defined compilation passes need to be exposed so that that they can
be imported and used in compiler extensions.

Also, add a test for these parameters while we're in the neighborhood.
---
 batch-driver.scm          | 16 ++++------------
 chicken.scm               |  5 +++--
 defaults.make             |  4 +++-
 distribution/manifest     |  3 +++
 manual/Using the compiler |  3 +++
 rules.make                |  4 +++-
 tests/runtests.sh         |  3 +++
 tests/user-pass-tests.scm | 33 +++++++++++++++++++++++++++++++++
 user-pass.scm             | 42 ++++++++++++++++++++++++++++++++++++++++++
 9 files changed, 97 insertions(+), 16 deletions(-)
 create mode 100644 tests/user-pass-tests.scm
 create mode 100644 user-pass.scm

diff --git a/batch-driver.scm b/batch-driver.scm
index c890678..0d319e8 100644
--- a/batch-driver.scm
+++ b/batch-driver.scm
@@ -32,13 +32,10 @@
   (uses extras data-structures files
        support compiler-syntax compiler optimizer
        ;; TODO: Backend should be configurable
-       scrutinizer lfa2 c-platform c-backend) )
+       scrutinizer lfa2 c-platform c-backend user-pass))
 
 (module chicken.compiler.batch-driver
-    (compile-source-file
-
-     user-options-pass user-read-pass user-preprocessor-pass user-pass
-     user-post-analysis-pass)
+    (compile-source-file)
 
 (import chicken scheme
        chicken.data-structures
@@ -54,19 +51,14 @@
        chicken.compiler.scrutinizer
        chicken.compiler.lfa2
        chicken.compiler.c-platform
-       chicken.compiler.c-backend)
+       chicken.compiler.c-backend
+       chicken.compiler.user-pass)
 
 (include "tweaks")
 (include "mini-srfi-1.scm")
 
 (define-constant funny-message-timeout 60000)
 
-(define user-options-pass (make-parameter #f))
-(define user-read-pass (make-parameter #f))
-(define user-preprocessor-pass (make-parameter #f))
-(define user-pass (make-parameter #f))
-(define user-post-analysis-pass (make-parameter #f))
-
 ;;; Emit collected information from various statistics about the program
 
 (define (print-program-statistics db)
diff --git a/chicken.scm b/chicken.scm
index d8b9c30..ac9dba8 100644
--- a/chicken.scm
+++ b/chicken.scm
@@ -30,8 +30,8 @@
        srfi-4 extras data-structures
        lolevel ; unused, but loaded to make foldable bindings available
        support compiler optimizer lfa2 compiler-syntax scrutinizer
-       ;; TODO: These three need to be made configurable somehow
-       batch-driver c-platform c-backend))
+       ;; TODO: Backend should be configurable
+       batch-driver c-platform c-backend user-pass))
 
 (module chicken.compiler.chicken ()
 
@@ -39,6 +39,7 @@
        chicken.compiler.batch-driver
        chicken.compiler.c-platform
        chicken.compiler.support
+       chicken.compiler.user-pass
        chicken.data-structures)
 
 (include "tweaks")
diff --git a/defaults.make b/defaults.make
index cce0e26..15d5440 100644
--- a/defaults.make
+++ b/defaults.make
@@ -266,6 +266,7 @@ PRIMITIVE_IMPORT_LIBRARIES = chicken csi chicken.foreign
 DYNAMIC_IMPORT_LIBRARIES = setup-api setup-download srfi-4
 DYNAMIC_CHICKEN_IMPORT_LIBRARIES = bitwise fixnum flonum format gc io \
        keyword locative posix pretty-print random time
+DYNAMIC_CHICKEN_COMPILER_IMPORT_LIBRARIES = user-pass
 DYNAMIC_CHICKEN_UNIT_IMPORT_LIBRARIES = continuation data-structures \
        eval expand files internal irregex lolevel ports read-syntax \
        repl tcp utils
@@ -284,7 +285,8 @@ CHICKEN_DEBUGGER_PROGRAM ?= 
$(PROGRAM_PREFIX)feathers$(PROGRAM_SUFFIX)$(SCRIPT_E
 IMPORT_LIBRARIES = $(DYNAMIC_IMPORT_LIBRARIES) \
                   $(PRIMITIVE_IMPORT_LIBRARIES) \
                   $(foreach 
lib,$(DYNAMIC_CHICKEN_IMPORT_LIBRARIES),chicken.$(lib)) \
-                  $(foreach 
lib,$(DYNAMIC_CHICKEN_UNIT_IMPORT_LIBRARIES),chicken.$(lib))
+                  $(foreach 
lib,$(DYNAMIC_CHICKEN_UNIT_IMPORT_LIBRARIES),chicken.$(lib)) \
+                  $(foreach 
lib,$(DYNAMIC_CHICKEN_COMPILER_IMPORT_LIBRARIES),chicken.compiler.$(lib))
 
 ifdef STATICBUILD
 CHICKEN_STATIC_EXECUTABLE = $(CHICKEN_PROGRAM)$(EXE)
diff --git a/distribution/manifest b/distribution/manifest
index 1531b19..7fb1540 100644
--- a/distribution/manifest
+++ b/distribution/manifest
@@ -45,6 +45,7 @@ chicken.compiler.support.import.scm
 repl.c
 tcp.c
 utils.c
+user-pass.c
 feathers.in
 feathers.bat.in
 feathers.tcl
@@ -248,6 +249,8 @@ chicken.import.scm
 chicken.import.c
 chicken.bitwise.import.scm
 chicken.bitwise.import.c
+chicken.compiler.user-pass.import.scm
+chicken.compiler.user-pass.import.c
 chicken.continuation.import.scm
 chicken.continuation.import.c
 chicken.data-structures.import.scm
diff --git a/manual/Using the compiler b/manual/Using the compiler
index bcc4a0f..c7c22a8 100644
--- a/manual/Using the compiler 
+++ b/manual/Using the compiler 
@@ -367,6 +367,9 @@ can be set to procedures that are called to perform certain 
compilation
 passes instead of the usual processing (for more information about
 parameters see [[Supported language]]).
 
+These parameters are provided by the {{(chicken compiler user-pass)}}
+module.
+
 <parameter>user-options-pass</parameter>
 
 Holds a procedure that will be called with a list of command-line arguments 
and should return two values: the source filename and the actual list of 
options, where compiler switches have their leading {{-}} (hyphen) removed and 
are converted to symbols.  Note that this parameter is invoked '''before''' 
processing of the {{-extend}} option, and so can only be changed in compiled 
user passes.
diff --git a/rules.make b/rules.make
index f6b309c..12b84da 100644
--- a/rules.make
+++ b/rules.make
@@ -45,7 +45,7 @@ LIBCHICKEN_STATIC_OBJECTS = 
$(LIBCHICKEN_OBJECTS_1:=-static$(O))
 
 COMPILER_OBJECTS_1 = \
        chicken batch-driver core optimizer lfa2 compiler-syntax scrutinizer 
support \
-       c-platform c-backend
+       c-platform c-backend user-pass
 COMPILER_OBJECTS        = $(COMPILER_OBJECTS_1:=$(O))
 COMPILER_STATIC_OBJECTS = $(COMPILER_OBJECTS_1:=-static$(O))
 
@@ -534,6 +534,7 @@ chicken.c: chicken.scm mini-srfi-1.scm \
                chicken.compiler.batch-driver.import.scm \
                chicken.compiler.c-platform.import.scm \
                chicken.compiler.support.import.scm \
+               chicken.compiler.user-pass.import.scm \
                chicken.data-structures.import.scm
 batch-driver.c: batch-driver.scm mini-srfi-1.scm \
                chicken.compiler.core.import.scm \
@@ -544,6 +545,7 @@ batch-driver.c: batch-driver.scm mini-srfi-1.scm \
                chicken.compiler.lfa2.import.scm \
                chicken.compiler.c-backend.import.scm \
                chicken.compiler.support.import.scm \
+               chicken.compiler.user-pass.import.scm \
                chicken.data-structures.import.scm \
                chicken.files.import.scm \
                chicken.format.import.scm \
diff --git a/tests/runtests.sh b/tests/runtests.sh
index e1238d3..f4a1337 100755
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -429,6 +429,9 @@ echo "======================================== executable 
tests ..."
 $compile executable-tests.scm
 ./a.out "$TEST_DIR/a.out"
 
+echo "======================================== user pass tests ..."
+$compile -extend user-pass-tests.scm null.scm
+
 echo "======================================== embedding (1) ..."
 $compile embedded1.c
 ./a.out
diff --git a/tests/user-pass-tests.scm b/tests/user-pass-tests.scm
new file mode 100644
index 0000000..0ef5f93
--- /dev/null
+++ b/tests/user-pass-tests.scm
@@ -0,0 +1,33 @@
+;;; Test user compilation passes
+
+(import (chicken compiler user-pass)
+        (chicken io)
+        (chicken pretty-print))
+
+(define passes '()) ; track user passes
+
+(user-read-pass
+ (lambda (_ _ _)
+   (set! passes (cons 'user-read-pass passes))
+   (list 'ok))) ; ignore file and use single datum
+
+(user-preprocessor-pass
+ (lambda (x)
+   (set! passes (cons 'user-preprocessor-pass passes))
+   (values x)))
+
+(user-pass
+ (lambda (x)
+   (set! passes (cons 'user-pass passes))
+   (values x)))
+
+(user-post-analysis-pass
+ (lambda (_ _ _ _ _ _ _)
+   (set! passes (cons 'user-post-analysis-pass passes))))
+
+(on-exit
+ (lambda ()
+   (assert (memq 'user-read-pass passes)          "user-read-pass not called")
+   (assert (memq 'user-pass passes)               "user-pass not called")
+   (assert (memq 'user-preprocessor-pass passes)  "user-preprocessor-pass not 
called")
+   (assert (memq 'user-post-analysis-pass passes) "user-post-analysis-pass not 
called")))
diff --git a/user-pass.scm b/user-pass.scm
new file mode 100644
index 0000000..4d6c19b
--- /dev/null
+++ b/user-pass.scm
@@ -0,0 +1,42 @@
+;;;; user-pass.scm - User compilation passes
+;
+; Copyright (c) 2008-2016, The CHICKEN Team
+; Copyright (c) 2000-2007, Felix L. Winkelmann
+; All rights reserved.
+;
+; Redistribution and use in source and binary forms, with or without 
modification, are permitted provided that the following
+; conditions are met:
+;
+;   Redistributions of source code must retain the above copyright notice, 
this list of conditions and the following
+;     disclaimer.
+;   Redistributions in binary form must reproduce the above copyright notice, 
this list of conditions and the following
+;     disclaimer in the documentation and/or other materials provided with the 
distribution.
+;   Neither the name of the author nor the names of its contributors may be 
used to endorse or promote
+;     products derived from this software without specific prior written 
permission.
+;
+; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 
AND ANY EXPRESS
+; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 
OF MERCHANTABILITY
+; AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 
COPYRIGHT HOLDERS OR
+; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, 
EXEMPLARY, OR
+; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 
SUBSTITUTE GOODS OR
+; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 
CAUSED AND ON ANY
+; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 
(INCLUDING NEGLIGENCE OR
+; OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF 
ADVISED OF THE
+; POSSIBILITY OF SUCH DAMAGE.
+
+(declare (unit user-pass))
+
+(module chicken.compiler.user-pass
+  (user-options-pass
+   user-read-pass
+   user-preprocessor-pass
+   user-pass
+   user-post-analysis-pass)
+
+(import scheme chicken)
+
+(define user-options-pass (make-parameter #f))
+(define user-read-pass (make-parameter #f))
+(define user-preprocessor-pass (make-parameter #f))
+(define user-pass (make-parameter #f))
+(define user-post-analysis-pass (make-parameter #f)))
-- 
2.7.0