~ chicken-core (chicken-5) 600754ea4582ec6ca9aee89178f38e596b7cebfd
commit 600754ea4582ec6ca9aee89178f38e596b7cebfd
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Sun Mar 20 12:50:54 2011 +0100
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Sun Mar 20 12:50:54 2011 +0100
make -emit-type-file work
diff --git a/batch-driver.scm b/batch-driver.scm
index 18a363b8..ba0280bf 100644
--- a/batch-driver.scm
+++ b/batch-driver.scm
@@ -227,7 +227,7 @@
(set! local-definitions #t)
(set! inline-output-file (option-arg ifile)))
(and-let* ((tfile (memq 'emit-type-file options)))
- (set! type-outout-file (option-arg tfile)))
+ (set! type-output-file (option-arg tfile)))
(and-let* ([inlimit (memq 'inline-limit options)])
(set! inline-max-size
(let ([arg (option-arg inlimit)])
@@ -488,10 +488,6 @@
(when (memq 'check-syntax options) (exit))
- (when type-output-file
- (dribble "generating type file `~a' ..." type-output-file)
- (emit-type-file type-output-file db))
-
(let ([proc (user-pass)])
(when proc
(dribble "User pass...")
@@ -504,7 +500,6 @@
(list (build-node-graph
(canonicalize-begin-body exps) ) ) ) )
(db #f))
-
(print-node "initial node tree" '|T| node0)
(initialize-analysis-database)
@@ -603,7 +598,11 @@
(when (memq 'd debugging-chicken)
(dump-defined-globals db))
(when (memq 'v debugging-chicken)
- (dump-global-refs db)) )
+ (dump-global-refs db))
+ ;; do this here, because we must make sure we have a db
+ (when type-output-file
+ (dribble "generating type file `~a' ..." type-output-file)
+ (emit-type-file type-output-file db)))
(set! first-analysis #f)
(end-time "analysis")
(print-db "analysis" '|4| db i)
diff --git a/scrutinizer.scm b/scrutinizer.scm
index 357507c2..e2bc6227 100755
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -742,7 +742,8 @@
((not (pair? x)) x)
((eq? 'quote (car x)) x) ; to handle numeric constants
(else (cons (subst (car x)) (subst (cdr x))))))
- (copy-node! (build-node-graph (subst template)) node)))
+ (let ((spec (subst template)))
+ (copy-node! (build-node-graph spec) node))))
(define (validate-type type name)
;; - returns converted type or #f
diff --git a/support.scm b/support.scm
index 6753e746..3c6ec315 100644
--- a/support.scm
+++ b/support.scm
@@ -746,10 +746,10 @@
(##sys#hash-table-for-each
(lambda (sym plist)
(when (variable-visible? sym)
- (and-let* ((type (variable-mark sym '##core#declared-type)))
+ (when (variable-mark sym '##core#declared-type)
(let ((specs
(or (variable-mark sym '##core#specializations) '())))
- (pp (cons* sym type specs))))))
+ (pp (cons* sym (variable-mark sym '##core#type) specs))))))
db)
(print "; END OF FILE"))))
Trap