>From 1dccfd39cab4d3abbc6e1d262de216129c956001 Mon Sep 17 00:00:00 2001
From: Peter Bex <address@hidden>
Date: Sun, 10 Aug 2014 16:46:04 +0200
Subject: [PATCH 06/19] compiler-modules: Convert c-platform to a module.

A few variables (default-optimization-passes eq-inline-operator,
membership-test-operators and membership-unfold-limit) were defined by
c-platform but used by optimizer.  This would result in a circular
dependency, because c-platform is already using various things which
were exported by the optimizer.  For this reason, and to reduce
coupling between the optimizer and the platform-specific code,
optimizer now defines the variables, which are then set by the
specific platform in use.  This makes it more explicit what the
optimizer needs from a platform.

Removed the unused variable default-debugging-declarations.

Rewrite is now exported cleanly by optimizer, and used by c-platform,
so it could be removed from compiler-namespace.

Added small-parameter-limit to compiler-namespace, for the time being.
---
 batch-driver.scm       |    6 +++---
 c-platform.scm         |   48 ++++++++++++++++++++++++++++++++++--------------
 chicken.scm            |    4 ++--
 compiler-namespace.scm |   14 +-------------
 optimizer.scm          |   20 +++++++++++++-------
 rules.make             |    9 ++++++---
 6 files changed, 59 insertions(+), 42 deletions(-)

diff --git a/batch-driver.scm b/batch-driver.scm
index e2cd736..d00a2bb 100644
--- a/batch-driver.scm
+++ b/batch-driver.scm
@@ -30,7 +30,7 @@
 (declare
   (unit batch-driver)
   (uses extras data-structures files srfi-1
-	lfa2 compiler-syntax optimizer) )
+	lfa2 compiler-syntax optimizer c-platform) )
 
 ;; TODO: Remove these once everything's converted to modules
 (include "private-namespace")
@@ -44,7 +44,7 @@
   
 (import (except chicken put! get quit syntax-error) scheme
 	extras data-structures files srfi-1
-	lfa2 compiler-syntax optimizer)
+	lfa2 compiler-syntax optimizer c-platform)
 
 (include "tweaks")
 
@@ -88,7 +88,7 @@
 		    (string-split 
 		     (or (get-environment-variable "CHICKEN_INCLUDE_PATH") "") 
 		     ";")))
-	(opasses default-optimization-passes)
+	(opasses (default-optimization-passes))
 	(time0 #f)
 	(time-breakdown #f)
 	(forms '())
diff --git a/c-platform.scm b/c-platform.scm
index 1d60dcd..588435e 100644
--- a/c-platform.scm
+++ b/c-platform.scm
@@ -25,16 +25,33 @@
 ; POSSIBILITY OF SUCH DAMAGE.
 
 
-(declare (unit platform))
+;; TODO: Rename c-platform back to "platform" and turn it into a
+;; functor?  This may require the creation of an additional file.
+;; Same goes for "backend" and "driver".
+(declare
+  (unit c-platform)
+  (uses srfi-1 data-structures
+	optimizer))
+
+;; TODO: Remove these once everything's converted to modules
+(include "private-namespace")
+(include "compiler-namespace")
 
+(module c-platform
+    (default-declarations default-profiling-declarations
+     units-used-by-default
+     valid-compiler-options valid-compiler-options-with-argument)
+
+(import (except chicken put! get quit syntax-error) scheme
+	srfi-1 data-structures
+	optimizer)
 
-(include "compiler-namespace")
 (include "tweaks")
 
 
 ;;; Parameters:
 
-(define default-optimization-passes 3)
+(default-optimization-passes 3)
 
 (define default-declarations
   '((always-bound
@@ -51,30 +68,28 @@
      ##sys#foreign-block-argument ##sys#foreign-string-argument ##sys#foreign-pointer-argument ##sys#foreign-integer-argument
      ##sys#call-with-current-continuation) ) )
 
-(define default-debugging-declarations
-  '((##core#declare
-      '(uses debugger)
-      '(bound-to-procedure
-	##sys#push-debug-frame ##sys#pop-debug-frame ##sys#check-debug-entry ##sys#check-debug-assignment
-	##sys#register-debug-lambdas ##sys#register-debug-variables ##sys#debug-call) ) ) )
-
 (define default-profiling-declarations
   '((##core#declare
      (uses profiler)
      (bound-to-procedure
        ##sys#profile-entry ##sys#profile-exit) ) ) )
 
-(define units-used-by-default '(library eval chicken-syntax)) 
+(define units-used-by-default '(library eval chicken-syntax))
+;; TODO: export this and remove it from compiler-namespace
 (define words-per-flonum 4)
+;; TODO: export this and remove it from compiler-namespace
 (define parameter-limit 1024)
+;; TODO: export this and remove it from compiler-namespace
 (define small-parameter-limit 128)
+;; TODO: export this and remove it from compiler-namespace
 (define unlikely-variables '(unquote unquote-splicing))
 
-(define eq-inline-operator "C_eqp")
-(define membership-test-operators
+(eq-inline-operator "C_eqp")
+(membership-test-operators
   '(("C_i_memq" . "C_eqp") ("C_u_i_memq" . "C_eqp") ("C_i_member" . "C_i_equalp")
     ("C_i_memv" . "C_i_eqvp") ) )
-(define membership-unfold-limit 20)
+(membership-unfold-limit 20)
+;; TODO: export this and remove it from compiler-namespace
 (define target-include-file "chicken.h")
 
 (define valid-compiler-options
@@ -109,6 +124,7 @@
 
 ;;; Standard and extended bindings:
 
+;; TODO: export this and remove it from compiler-namespace
 (define default-standard-bindings
   '(not boolean? apply call-with-current-continuation eq? eqv? equal? pair? cons car cdr caar cadr
     cdar cddr caaar caadr cadar caddr cdaar cdadr cddar cdddr caaaar caaadr caadar caaddr cadaar
@@ -130,6 +146,7 @@
     list-ref abs char-ready? peek-char list->string string->list
     current-input-port current-output-port) )
 
+;; TODO: export this and remove it from compiler-namespace
 (define default-extended-bindings
   '(bitwise-and alist-cons xcons
     bitwise-ior bitwise-xor bitwise-not add1 sub1 fx+ fx- fx* fx/
@@ -166,6 +183,7 @@
     current-error-port current-thread
     printf sprintf format fprintf get-keyword) )
 
+;; TODO: export this and remove it from compiler-namespace
 (define internal-bindings
   '(##sys#slot ##sys#setslot ##sys#block-ref ##sys#block-set!
     ##sys#call-with-current-continuation ##sys#size ##sys#byte ##sys#setbyte
@@ -220,6 +238,7 @@
     pointer-f32-ref pointer-f32-set!
     pointer-f64-ref pointer-f64-set!))
 
+;; TODO: export this and remove it from compiler-namespace
 (define foldable-bindings
   (lset-difference 
    eq?
@@ -1203,3 +1222,4 @@
 		    '##core#inline_allocate
 		    '("C_a_i_cons" 3) 
 		    (list (second callargs) (varnode tmp)))))))))))
+)
\ No newline at end of file
diff --git a/chicken.scm b/chicken.scm
index 372adaa..86c2328 100644
--- a/chicken.scm
+++ b/chicken.scm
@@ -30,13 +30,13 @@
 	srfi-1 srfi-4 utils files extras data-structures support
 	compiler optimizer lfa2 compiler-syntax scrutinizer
 	;; TODO: These three need to be made configurable somehow
-	batch-driver platform backend 
+	batch-driver c-platform backend 
 	srfi-69))
 
 
 (include "compiler-namespace")
 (include "tweaks")
-(import batch-driver)
+(import batch-driver c-platform)
 
 ;;; Prefix argument list with default options:
 
diff --git a/compiler-namespace.scm b/compiler-namespace.scm
index 0d0c384..0b08e65 100644
--- a/compiler-namespace.scm
+++ b/compiler-namespace.scm
@@ -81,15 +81,10 @@
  debugging-chicken
  debugging-executable
  decompose-lambda-list
- default-debugging-declarations
- default-declarations
  default-default-target-heap-size
  default-extended-bindings
  default-optimization-iterations
- default-optimization-passes
- default-optimization-passes-when-trying-harder
  default-output-filename
- default-profiling-declarations
  default-standard-bindings
  defconstant-bindings
  dependency-list
@@ -113,7 +108,6 @@
  enable-inline-files
  enable-specialization
  encode-literal
- eq-inline-operator
  estimate-foreign-result-location-size
  estimate-foreign-result-size
  expand-debug-assignment
@@ -203,8 +197,6 @@
  make-variable-list
  mark-variable
  match-node
- membership-test-operators
- membership-unfold-limit
  no-argc-checks
  no-bound-checks
  no-global-procedure-checks
@@ -217,7 +209,6 @@
  node->sexpr
  node-subexpressions
  node-subexpressions-set!
- non-foldable-bindings
  nonwinding-call/cc
  number-type
  optimization-iterations
@@ -255,7 +246,6 @@
  register-unboxed-op
  require-imports-flag
  rest-parameters-promoted-to-vector
- rewrite
  safe-globals-flag
  scan-free-variables
  scan-sharp-greater-string
@@ -268,6 +258,7 @@
  simplify-type
  slashify
  sort-symbols
+ small-parameter-limit
  source-filename
  source-info->string
  source-info->line
@@ -289,15 +280,12 @@
  undefine-shadowed-macros
  unique-id
  unit-name
- units-used-by-default
  unlikely-variables
  unsafe
  update-line-number-database
  update-line-number-database!
  used-units
  valid-c-identifier?
- valid-compiler-options
- valid-compiler-options-with-argument
  validate-type
  variable-mark
  variable-visible?
diff --git a/optimizer.scm b/optimizer.scm
index e1d01a6..a908b5d 100644
--- a/optimizer.scm
+++ b/optimizer.scm
@@ -35,7 +35,9 @@
 
 (module optimizer
     (scan-toplevel-assignments perform-high-level-optimizations
-     transform-direct-lambdas! determine-loop-and-dispatch)
+     transform-direct-lambdas! determine-loop-and-dispatch
+     eq-inline-operator membership-test-operators membership-unfold-limit
+     default-optimization-passes rewrite)
 
 (import (except chicken put! get quit syntax-error) scheme
 	srfi-1 data-structures)
@@ -44,6 +46,11 @@
 
 (define-constant maximal-number-of-free-variables-for-liftable 16)
 
+;; These are parameterized by the platform implementation
+(define eq-inline-operator (make-parameter #f))
+(define membership-test-operators (make-parameter #f))
+(define membership-unfold-limit (make-parameter #f))
+(define default-optimization-passes (make-parameter #f))
 
 ;;; Scan toplevel expressions for assignments:
 
@@ -650,7 +657,7 @@
 		     rest) ) ) )
    (var0 var1 var2 op const1 const2 body1 body2 d1 d2 rest)
    ,(lambda (db var0 var1 var2 op const1 const2 body1 body2 d1 d2 rest)
-      (and (equal? op eq-inline-operator)
+      (and (equal? op (eq-inline-operator))
 	   (immediate? const1)
 	   (immediate? const2)
 	   (= 1 (length (get-list db var1 'references)))
@@ -677,7 +684,7 @@
 	    (##core#switch (n) (##core#variable (var0)) . clauses) ) )
    (var op var0 const d body n clauses)
    ,(lambda (db var op var0 const d body n clauses)
-      (and (equal? op eq-inline-operator)
+      (and (equal? op (eq-inline-operator))
 	   (immediate? const)
 	   (= 1 (length (get-list db var 'references)))
 	   (make-node
@@ -768,7 +775,7 @@
 	    y) ) 
    (var op args d x y)
    ,(lambda (db var op args d x y)
-      (and (not (equal? op eq-inline-operator))
+      (and (not (equal? op (eq-inline-operator)))
 	   (= 1 (length (get-list db var 'references)))
 	   (make-node
 	    'if d
@@ -804,9 +811,9 @@
        z)
    (d1 op x clist y z)
    ,(lambda (db d1 op x clist y z)
-      (and-let* ([opa (assoc op membership-test-operators)]
+      (and-let* ([opa (assoc op (membership-test-operators))]
 		 [(proper-list? clist)]
-		 [(< (length clist) membership-unfold-limit)] )
+		 [(< (length clist) (membership-unfold-limit))] )
 	(let ([var (gensym)]
 	      [eop (list (cdr opa))] )
 	  (make-node
@@ -921,7 +928,6 @@
 
 (define substitution-table (make-vector 301 '()))
 
-;; TODO: export this and remove it from compiler-namespace
 (define (rewrite name . class-and-args)
   (let ((old (or (##sys#hash-table-ref substitution-table name) '())))
     (##sys#hash-table-set! substitution-table name (append old (list class-and-args))) ) )
diff --git a/rules.make b/rules.make
index d362876..2f2c854 100644
--- a/rules.make
+++ b/rules.make
@@ -492,13 +492,16 @@ endef
 $(foreach lib, $(SETUP_API_OBJECTS_1),\
           $(eval $(call declare-emitted-import-lib-dependency,$(lib))))
 
-$(foreach lib, batch-driver lfa2 compiler-syntax optimizer,\
+$(foreach lib, batch-driver lfa2 compiler-syntax optimizer c-platform,\
           $(eval $(call declare-emitted-import-lib-dependency,$(lib))))
 
-chicken.c: chicken.scm batch-driver.import.scm batch-driver.scm
+chicken.c: chicken.scm batch-driver.import.scm batch-driver.scm \
+		c-platform.scm c-platform.import.scm
 batch-driver.c: batch-driver.scm lfa2.import.scm lfa2.scm \
 		compiler-syntax.scm compiler-syntax.import.scm \
-		optimizer.scm optimizer.import.scm
+		optimizer.scm optimizer.import.scm \
+		c-platform.scm c-platform.import.scm
+c-platform.c: c-platform.scm optimizer.scm optimizer.import.scm
 
 define profile-flags
 $(if $(filter $(basename $(1)),$(PROFILE_OBJECTS)),-profile)
-- 
1.7.10.4