>From 10caa78b5a7ab34b7a636d7e9b31817453440f42 Mon Sep 17 00:00:00 2001 From: Evan Hanson Date: Fri, 27 Apr 2018 12:10:53 +0200 Subject: [PATCH] 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. --- batch-driver.scm | 19 +++++++++++-------- core.scm | 22 +++++++++++++--------- 2 files changed, 24 insertions(+), 17 deletions(-) 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 f94e1e64..86758b14 100644 --- a/core.scm +++ b/core.scm @@ -236,7 +236,7 @@ ; undefined -> If true: variable is unknown yet but can be known later ; value -> Variable has a known value ; local-value -> Variable is declared local and has value -; potential-value -> Global variable was assigned this value (used for lambda-info) +; potential-values -> ( ...) Global variable was assigned this value (used for lambda-info) ; references -> ( ...) Nodes that are accesses of this variable (##core#variable nodes) ; boxed -> If true: variable has to be boxed after closure-conversion ; contractable -> 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: -- 2.11.0