|
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