>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 ->