|
3492 | 3492 | (define (analyze-vars e env captvars sp tab)
|
3493 | 3493 | (if (or (atom? e) (quoted? e))
|
3494 | 3494 | (begin
|
3495 |
| - (if (symbol? e) |
3496 |
| - (let ((vi (get tab e #f))) |
3497 |
| - (if vi |
3498 |
| - (vinfo:set-read! vi #t)))) |
| 3495 | + (cond |
| 3496 | + ((symbol? e) |
| 3497 | + (let ((vi (get tab e #f))) |
| 3498 | + (if vi |
| 3499 | + (vinfo:set-read! vi #t)))) |
| 3500 | + ((nospecialize-meta? e) |
| 3501 | + (let ((vi (get tab (caddr e) #f))) |
| 3502 | + (if vi |
| 3503 | + (vinfo:set-nospecialize! vi #t))))) |
3499 | 3504 | e)
|
3500 | 3505 | (case (car e)
|
3501 | 3506 | ((local-def) ;; a local that we know has an assignment that dominates all usages
|
@@ -3594,21 +3599,6 @@ f(x) = yt(x)
|
3594 | 3599 | (call (core _typebody!) (false) ,s (call (core svec) ,@types))
|
3595 | 3600 | (return (null)))))))))
|
3596 | 3601 |
|
3597 |
| -(define (type-for-closure name fields super) |
3598 |
| - (let ((s (make-ssavalue))) |
3599 |
| - `((thunk ,(linearize `(lambda () |
3600 |
| - (() () 0 ()) |
3601 |
| - (block (global ,name) |
3602 |
| - (= ,s (call (core _structtype) (thismodule) (inert ,name) (call (core svec)) |
3603 |
| - (call (core svec) ,@(map quotify fields)) |
3604 |
| - (call (core svec)) |
3605 |
| - (false) ,(length fields))) |
3606 |
| - (call (core _setsuper!) ,s ,super) |
3607 |
| - (const (globalref (thismodule) ,name) ,s) |
3608 |
| - (call (core _typebody!) (false) ,s |
3609 |
| - (call (core svec) ,@(map (lambda (v) '(core Box)) fields))) |
3610 |
| - (return (null))))))))) |
3611 |
| - |
3612 | 3602 | ;; better versions of above, but they get handled wrong in many places
|
3613 | 3603 | ;; need to fix that in order to handle #265 fully (and use the definitions)
|
3614 | 3604 |
|
@@ -4022,6 +4012,10 @@ f(x) = yt(x)
|
4022 | 4012 | (let ((cv (assq v (cadr (lam:vinfo lam)))))
|
4023 | 4013 | (and cv (vinfo:asgn cv) (vinfo:capt cv)))))
|
4024 | 4014 |
|
| 4015 | +(define (is-var-nospecialize? v lam) |
| 4016 | + (let ((vi (assq v (car (lam:vinfo lam))))) |
| 4017 | + (and vi (vinfo:nospecialize vi)))) |
| 4018 | + |
4025 | 4019 | (define (toplevel-preserving? e)
|
4026 | 4020 | (and (pair? e) (memq (car e) '(if elseif block trycatch tryfinally trycatchelse))))
|
4027 | 4021 |
|
@@ -4313,16 +4307,14 @@ f(x) = yt(x)
|
4313 | 4307 | (closure-param-syms (map (lambda (s) (make-ssavalue)) closure-param-names))
|
4314 | 4308 | (typedef ;; expression to define the type
|
4315 | 4309 | (let* ((fieldtypes (map (lambda (v)
|
4316 |
| - (if (is-var-boxed? v lam) |
4317 |
| - '(core Box) |
4318 |
| - (make-ssavalue))) |
| 4310 | + (cond ((is-var-boxed? v lam) '(core Box)) |
| 4311 | + ((is-var-nospecialize? v lam) (vinfo:type (assq v (car (lam:vinfo lam))))) |
| 4312 | + (else (make-ssavalue)))) |
4319 | 4313 | capt-vars))
|
4320 | 4314 | (para (append closure-param-syms
|
4321 | 4315 | (filter ssavalue? fieldtypes)))
|
4322 | 4316 | (fieldnames (append closure-param-names (filter (lambda (v) (not (is-var-boxed? v lam))) capt-vars))))
|
4323 |
| - (if (null? para) |
4324 |
| - (type-for-closure type-name capt-vars '(core Function)) |
4325 |
| - (type-for-closure-parameterized type-name para fieldnames capt-vars fieldtypes '(core Function))))) |
| 4317 | + (type-for-closure-parameterized type-name para fieldnames capt-vars fieldtypes '(core Function)))) |
4326 | 4318 | (mk-method ;; expression to make the method
|
4327 | 4319 | (if short '()
|
4328 | 4320 | (let* ((iskw ;; TODO jb/functions need more robust version of this
|
@@ -4352,7 +4344,7 @@ f(x) = yt(x)
|
4352 | 4344 | (P (append
|
4353 | 4345 | closure-param-names
|
4354 | 4346 | (filter identity (map (lambda (v ve)
|
4355 |
| - (if (is-var-boxed? v lam) |
| 4347 | + (if (or (is-var-boxed? v lam) (is-var-nospecialize? v lam)) |
4356 | 4348 | #f
|
4357 | 4349 | `(call (core _typeof_captured_variable) ,ve)))
|
4358 | 4350 | capt-vars var-exprs)))))
|
|
0 commit comments