~ chicken-core (chicken-5) 6725c9e2fb2ea89c51f69f4fc4d0ee293d529e64
commit 6725c9e2fb2ea89c51f69f4fc4d0ee293d529e64
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Wed Feb 23 08:12:25 2011 -0500
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Wed Feb 23 08:12:25 2011 -0500
load types files for file-requirements
diff --git a/batch-driver.scm b/batch-driver.scm
index a9e7f276..3fd44871 100644
--- a/batch-driver.scm
+++ b/batch-driver.scm
@@ -500,36 +500,9 @@
(print-node "initial node tree" '|T| node0)
(initialize-analysis-database)
- (when do-scrutinize
- ;;;*** hardcoded database file name
- (unless (memq 'ignore-repository options)
- (load-type-database "types.db"))
- (for-each (cut load-type-database <> #f) (collect-options 'types))
- (begin-time)
- (set! first-analysis #f)
- (set! db (analyze 'scrutiny node0))
- (print-db "analysis" '|0| db 0)
- (end-time "pre-analysis")
- (begin-time)
- (debugging 'p "performing scrutiny")
- (scrutinize node0 db)
- (end-time "scrutiny")
- (set! first-analysis #t) )
-
- (when do-lambda-lifting
- (begin-time)
- (unless do-scrutinize ; no need to do analysis if already done above
- (set! first-analysis #f)
- (set! db (analyze 'lift node0))
- (print-db "analysis" '|0| db 0)
- (end-time "pre-analysis (lambda-lift)"))
- (begin-time)
- (perform-lambda-lifting! node0 db)
- (end-time "lambda lifting")
- (print-node "lambda lifted" '|L| node0)
- (set! first-analysis #t) )
-
- (let ((req (concatenate (vector->list file-requirements))))
+ ;; collect requirements and load inline and types files
+ (let* ((req (concatenate (vector->list file-requirements)))
+ (mreq (concatenate (map cdr req))))
(when (debugging 'M "; requirements:")
(pp req))
(when enable-inline-files
@@ -541,7 +514,7 @@
((file-exists? ifile)))
(dribble "Loading inline file ~a ..." ifile)
(load-inline-file ifile)))
- (concatenate (map cdr req))) )
+ mreq))
(let ((ifs (collect-options 'consult-inline-file)))
(unless (null? ifs)
(set! inline-locally #t)
@@ -549,8 +522,45 @@
(lambda (ilf)
(dribble "Loading inline file ~a ..." ilf)
(load-inline-file ilf) )
- ifs))))
+ ifs)))
+ (when do-scrutinize
+ ;;*** hardcoded database file name
+ (unless (memq 'ignore-repository options)
+ (load-type-database "types.db"))
+ (for-each (cut load-type-database <> #f) (collect-options 'types))
+ (for-each
+ (lambda (id)
+ (and-let* ((tfile (##sys#resolve-include-filename
+ (make-pathname #f (symbol->string id) "types")
+ #f #t))
+ ((file-exists? tfile)))
+ (load-type-database tfile)))
+ mreq)
+ (begin-time)
+ (set! first-analysis #f)
+ (set! db (analyze 'scrutiny node0))
+ (print-db "analysis" '|0| db 0)
+ (end-time "pre-analysis")
+ (begin-time)
+ (debugging 'p "performing scrutiny")
+ (scrutinize node0 db)
+ (end-time "scrutiny")
+ (set! first-analysis #t) ) )
+ ;; lambda-lifting
+ (when do-lambda-lifting
+ (begin-time)
+ (unless do-scrutinize ; no need to do analysis if already done above
+ (set! first-analysis #f)
+ (set! db (analyze 'lift node0))
+ (print-db "analysis" '|0| db 0)
+ (end-time "pre-analysis (lambda-lift)"))
+ (begin-time)
+ (perform-lambda-lifting! node0 db)
+ (end-time "lambda lifting")
+ (print-node "lambda lifted" '|L| node0)
+ (set! first-analysis #t) )
+
(set! ##sys#line-number-database #f)
(set! constant-table #f)
(set! inline-table #f)
Trap