expander: improve extractor to recognize once-set variables

When `set!` is used to tie a recursove knot in a flattened linklet,
the expander can recognize that pattern and not complain that a
mutable variable might be shared across places. Improving that
inference means fewer `++global-ok` flags in Makefiles.

This commit also avoids single-quote as an escaping form in a
makefile, which doesn't work with nmake on Windows.
This commit is contained in:
Matthew Flatt 2019-06-25 08:41:45 -06:00
parent 3fb226ce2a
commit 8c1dbae88b
2 changed files with 71 additions and 19 deletions

View File

@ -6,14 +6,15 @@
(define (check-global linklet global-ok)
(define es (cdddr linklet))
;; Variables that are not under `lambda`:
(define vars (make-hasheq))
;; Get all variables that are not under `lambda`. That's not
;; necessarily all variables that act like globals, since a
;; Get all variables that are declared not under `lambda`. That's
;; not necessarily all variables that act like globals, since a
;; top-level expression could call a function that allocates a
;; mutable variable, but it's close enough to be useful.
(for ([e (in-list es)])
(let loop ([e e])
(define (loop e)
(match e
[`(define-values (,ids ...) ,rhs)
(for ([id (in-list ids)])
@ -21,18 +22,77 @@
(loop rhs)]
[`(lambda . ,_) (void)]
[`(case-lambda . ,_) (void)]
[`(let-values ([,idss ,rhss] ...) ,bodys ...)
[`(let-values . ,_)
(not-under-lambda-let e)]
[`(letrec-values . ,_)
(not-under-lambda-let e)]
[`(,es ...)
(for ([e (in-list es)])
(loop e))]
[_ #f]))
(define (not-under-lambda-let e)
(match e
[`(,_ ([,idss ,rhss] ...) ,bodys ...)
(for* ([ids (in-list idss)]
[id (in-list ids)])
(hash-set! vars id #t))
(for ([rhs (in-list rhss)])
(loop rhs))
(for ([body (in-list bodys)])
(loop body))]
(loop body))]))
(loop e))
;; Variables that are potentially used after the
;; linklet body completes
(define used-later-vars (make-hasheq))
;; Exported variable are used later
(for ([ex (in-list (caddr linklet))])
(define sym (if (pair? ex) (car ex) ex))
(hash-set! used-later-vars sym #t))
;; Fill `used-later-vars`, because any function not in that set is
;; something that we don't need to worry about being called later,
;; so we can ignore any side effects it may have. For example,
;; `set!`s that just set up recursive bindings are ok, because they
;; happen before the linklet body completes, and those are usually
;; initialed by functions that are called only on startup.
(for ([e (in-list es)])
(define (now e)
(match e
[`(define-values (,ids ...) ,rhs)
(now rhs)]
[`(lambda ,_ ,bodys ...)
(for ([body (in-list bodys)])
(later body))]
[`(case-lambda [,_ ,bodyss ...] ...)
(for* ([bodys (in-list bodyss)]
[body (in-list bodys)])
(later body))]
[`(quote ,_) (void)]
[`(,es ...)
(unless (null? es)
(case (car es)
[(begin begin0 set! if) (void)]
[else
;; The value of any identifier in an argument position
;; might be used later
(for ([e (in-list (cdr es))])
(when (symbol? e)
(later e)))]))
(for ([e (in-list es)])
(now e))]
[_ (void)]))
(define (later e)
(match e
[`(quote ,_) (void)]
[`(,es ...)
(for ([e (in-list es)])
(loop e))]
[_ #f])))
(later e))]
[_
(when (symbol? e)
(hash-set! used-later-vars e #t))]))
(now e))
(define complained (make-hasheq))
@ -51,6 +111,9 @@
(for ([e (in-list es)])
(let loop ([e e])
(match e
[`(define-values (,id) (lambda ,_ ,bodys ...))
(when (hash-ref used-later-vars id #f)
(loop bodys))]
[`(set! ,id ,rhs)
(found-state! id e)
(loop rhs)]

View File

@ -20,25 +20,14 @@ DISALLOW = ++disallow error
# global state to be ok:
GLOBALS = --no-global \
++global-ok the-sandman \
++global-ok sync-on-channel \
++global-ok post-shutdown-action \
++global-ok get-subprocesses-time \
++global-ok force-atomic-timeout-callback \
++global-ok pre-poll-callbacks \
++global-ok queued-shutdowns \
++global-ok place-ensure-wakeup! \
++global-ok place-wakeup-initial \
++global-ok place-wakeup \
++global-ok compute-memory-sizes \
++global-ok check-place-activity \
++global-ok make-place-ports+fds \
++global-ok future-block-for-atomic \
++global-ok pthread-count \
++global-ok wakeup-this-place \
++global-ok ensure-place-wakeup-handle \
++global-ok futures-sync-for-custodian-shutdown \
++global-ok 'future-scheduler-add-thread-custodian-mapping!' \
++global-ok 'logging-future-events?' \
++global-ok "logging-future-events?" \
++global-ok log-future-event