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:
parent
3fb226ce2a
commit
8c1dbae88b
|
@ -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)]
|
||||
|
|
|
@ -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
|
||||
|
||||
|
||||
|
|
Loading…
Reference in New Issue
Block a user