~ chicken-core (chicken-5) 57ff6e51f8fc9464a7bb8dbb88e8396cb36aaee8
commit 57ff6e51f8fc9464a7bb8dbb88e8396cb36aaee8
Author: Evan Hanson <evhan@foldling.org>
AuthorDate: Fri Apr 27 12:10:53 2018 +0200
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Sat Apr 28 11:46:52 2018 +0200
Track all potential values for use when generating assigned global lambda infos
This changes the "potential-value" item in the analysis database from a
single value to a list of values, so that all assignments to a global
can be tracked and used when generating lambda info. Previously, only
the last assignment would be remembered, with any previously-encountered
potential value being clobbered.
Also, print a symbol's potential values even when a variable's true
value is unknown when printing the analysis database, and print them
last (after "refs", "css", and so on).
Fixes #1363.
Signed-off-by: felix <felix@call-with-current-continuation.org>
diff --git a/batch-driver.scm b/batch-driver.scm
index ef1a8c5b..44ab36d1 100644
--- a/batch-driver.scm
+++ b/batch-driver.scm
@@ -124,7 +124,7 @@
(lambda (sym plist)
(let ([val #f]
(lval #f)
- [pval #f]
+ [pvals #f]
[csites '()]
[refs '()] )
(unless (memq sym omit)
@@ -143,8 +143,8 @@
(unless (eq? val 'unknown) (set! val (cdar es))) )
((local-value)
(unless (eq? val 'unknown) (set! lval (cdar es))) )
- ((potential-value)
- (set! pval (cdar es)) )
+ ((potential-values)
+ (set! pvals (cdar es)))
((replacable home contains contained-in use-expr closure-size rest-parameter
captured-variables explicit-rest)
(printf "\t~a=~s" (caar es) (cdar es)) )
@@ -154,14 +154,17 @@
(set! csites (cdar es)) )
(else (bomb "Illegal property" (car es))) )
(loop (cdr es)) ) ) )
+ (when (pair? refs) (printf "\trefs=~s" (length refs)))
+ (when (pair? csites) (printf "\tcss=~s" (length csites)))
(cond [(and val (not (eq? val 'unknown)))
(printf "\tval=~s" (cons (node-class val) (node-parameters val))) ]
[(and lval (not (eq? val 'unknown)))
- (printf "\tlval=~s" (cons (node-class lval) (node-parameters lval))) ]
- [(and pval (not (eq? val 'unknown)))
- (printf "\tpval=~s" (cons (node-class pval) (node-parameters pval)))] )
- (when (pair? refs) (printf "\trefs=~s" (length refs)))
- (when (pair? csites) (printf "\tcss=~s" (length csites)))
+ (printf "\tlval=~s" (cons (node-class lval) (node-parameters lval)))])
+ (when (pair? pvals)
+ (for-each
+ (lambda (pval)
+ (printf "\tpval=~s" (cons (node-class pval) (node-parameters pval))))
+ pvals))
(newline) ) ) )
db) ) ) )
diff --git a/core.scm b/core.scm
index ac35785f..abe49a34 100644
--- a/core.scm
+++ b/core.scm
@@ -236,7 +236,7 @@
; undefined -> <boolean> If true: variable is unknown yet but can be known later
; value -> <node> Variable has a known value
; local-value -> <node> Variable is declared local and has value
-; potential-value -> <node> Global variable was assigned this value (used for lambda-info)
+; potential-values -> (<node> ...) Global variable was assigned this value (used for lambda-info)
; references -> (<node> ...) Nodes that are accesses of this variable (##core#variable nodes)
; boxed -> <boolean> If true: variable has to be boxed after closure-conversion
; contractable -> <boolean> If true: variable names contractable procedure
@@ -2107,7 +2107,7 @@
(warning "redefinition of standard binding" var) )
((extended)
(warning "redefinition of extended binding" var) ) ))
- (db-put! db var 'potential-value val)
+ (collect! db var 'potential-values val)
(unless (memq var localenv)
(grow 1)
(cond ((memq var env)
@@ -2176,7 +2176,7 @@
(let ([unknown #f]
[value #f]
[local-value #f]
- [pvalue #f]
+ [potential-values #f]
[references '()]
[captured #f]
[call-sites '()]
@@ -2198,7 +2198,8 @@
(set! references (cdr prop))
(set! nreferences (length references)) ]
[(captured) (set! captured #t)]
- [(potential-value) (set! pvalue (cdr prop))]
+ [(potential-values)
+ (set! potential-values (cdr prop))]
[(call-sites)
(set! call-sites (cdr prop))
(set! ncall-sites (length call-sites)) ]
@@ -2216,11 +2217,14 @@
;; If this is the first analysis, register known local or potentially known global
;; lambda-value id's along with their names:
- (when (and first-analysis
- (eq? '##core#lambda
- (and-let* ([val (or value (and global pvalue))])
- (node-class val) ) ) )
- (set-real-name! (first (node-parameters (or value pvalue))) sym) )
+ (when first-analysis
+ (and-let* ((vals (or (and value (list value))
+ (and global potential-values))))
+ (for-each
+ (lambda (val)
+ (when (eq? (node-class val) '##core#lambda)
+ (set-real-name! (first (node-parameters val)) sym)))
+ vals)))
;; If this is the first analysis and the variable is global and has no references
;; and is hidden then issue warning:
Trap