Changeset 12382 in project

Timestamp:

11/06/08 17:30:44 (12 years ago)

Author:

felix winkelmann

Message:

namespace fixes, moved u-o-pass before CPS conversion

Location:

chicken/branches/lfa

Files:

• TODO (modified) (1 diff)
• batch-driver.scm (modified) (4 diffs)
• compiler.scm (modified) (1 diff)
• lfa.scm (modified) (2 diffs)
• optimizer.scm (modified) (1 diff)

chicken/branches/lfa/TODO

@@ -56 +56 @@
 ** compiler
 *** remove "custom-declare" + stuff?
+*** lfa
+**** trace-call
+***** probably need to track known procedure values/lfa-lambdas
+***** if op is lfa-lambda (how to obtain it is different question):
+****** if lfa-lambda has type-env, merge with argtypes
+****** if no change return lfa-lambda type (if set)
+****** otherwise trace body, update/merge lfa-lambda type
+****** call: if op has type, extend tenv for args with known sources
+****** check op-plist for rewrite rules, matched by argtypes
+****** mark result-var if op-plist is marked as predicate
+****** remove call, if op-plist is marked as check and argtypes match (subtypes) 
 
 ** setup/install

chicken/branches/lfa/batch-driver.scm

@@ -305 +305 @@
         (load-verbose #t) )
       ;; rebind a-g-h to allow extensions in source files to use private-namespace.scm
-      (fluid-let ((##sys#alias-global-hook ##sys#alias-global-hook))
-        (for-each
-         (lambda (f) (load (##sys#resolve-include-filename f #f #t))) 
-         extends) ) )
+      (for-each
+       (lambda (f) (load (##sys#resolve-include-filename f #f #t))) 
+       extends) )
     (set! ##sys#features (delete #:compiler-extension ##sys#features eq?))
 
@@ -558 +557 @@
                  (scan-toplevel-assignments (first (node-subexpressions node0))) )
 
+               (let ((proc (user-optimization-pass)))
+                 (when proc
+                   (when verbose (printf "User optimization pass...~%~!"))
+                   (begin-time)
+                   (set! first-analysis #f)
+                   (let ([db (analyze 'useropt node0)])
+                     (print-db "analysis" '|0| db 0)
+                     (end-time "pre-analysis (user)")
+                     (begin-time)
+                     (set! node0 (proc node0 db))
+                     (end-time "user optimization pass")
+                     (print-node "user optimization" 'x node0) )
+                   (set! first-analysis #t) ) )
+
                (begin-time)
                (let ([node1 (perform-cps-conversion node0)])
@@ -574 +587 @@
                      (end-time "analysis")
                      (print-db "analysis" '|4| db i)
-
                      (when (memq 's debugging-chicken) (print-program-statistics db))
-
                      (cond [progress
-
-                            (let ((proc (user-optimization-pass)))
-                              (when proc
-                                (when verbose (printf "User optimization pass...~%~!"))
-                                (set! node2 (proc node2 db)) ))
-
                             (debugging 'p "optimization pass" i)
-
                             (begin-time)
                             (receive (node2 progress-flag)
@@ -591 +595 @@
                               (end-time "optimization")
                               (print-node "optimized-iteration" '|5| node2)
-
                               (cond [progress-flag (loop (add1 i) node2 #t)]
                                     [(not inline-substitutions-enabled)

chicken/branches/lfa/compiler.scm

@@ -311 +311 @@
   make-random-name final-foreign-type real-name-table real-name set-real-name! safe-globals-flag
   location-pointer-map literal-rewrite-hook inline-globally
-  local-definitions export-variable variable-mark intrinsic?
+  local-definitions export-variable variable-mark intrinsic? varnode?
   undefine-shadowed-macros process-lambda-documentation emit-syntax-trace-info
   generate-code make-variable-list make-argument-list generate-foreign-stubs foreign-type-declaration

chicken/branches/lfa/lfa.scm

@@ -449 +449 @@
       (debugging 'x "tracing call" (node-class n))
       ;...
-      )
+      (values '* #f te))
     (trace node #f '())) )
 
@@ -458 +458 @@
  (lambda (node db)
    (debugging 'x "collecting lambdas ...")
-   (let ((ll (collect-lambdas node)))
+   (let ((ll (collect-lambdas node db)))
      (debugging 'x "lfa trace ...")
      (perform-lfa node db '() ll)

chicken/branches/lfa/optimizer.scm

@@ -60 +60 @@
   topological-sort print-version print-usage initialize-analysis-database
   expand-foreign-callback-lambda default-optimization-passes default-optimization-passes-when-trying-harder
-  units-used-by-default words-per-flonum rewrite inline-locally
+  units-used-by-default words-per-flonum rewrite inline-locally varnode?
   parameter-limit eq-inline-operator optimizable-rest-argument-operators
   membership-test-operators membership-unfold-limit valid-compiler-options valid-compiler-options-with-argument