|
549 | 549 | (insert-after-meta `(block |
550 | 550 | ,@stmts) |
551 | 551 | (cons `(meta nkw ,(+ (length vars) (length restkw))) |
552 | | - annotations)) |
| 552 | + (if (has-thisfunction? `(block ,@stmts)) |
| 553 | + (cons `(meta thisfunction-original ,(arg-name (car not-optional))) annotations) |
| 554 | + annotations))) |
553 | 555 | rett) |
554 | 556 |
|
555 | 557 | ;; call with no keyword args |
|
2911 | 2913 | 'generator |
2912 | 2914 | (lambda (e) |
2913 | 2915 | (check-no-return e) |
| 2916 | + (check-no-thisfunction e) |
2914 | 2917 | (expand-generator e #f '())) |
2915 | 2918 |
|
2916 | 2919 | 'flatten |
|
2995 | 2998 | (if (has-return? e) |
2996 | 2999 | (error "\"return\" not allowed inside comprehension or generator"))) |
2997 | 3000 |
|
| 3001 | +(define (has-thisfunction? e) |
| 3002 | + (expr-contains-p thisfunction? e (lambda (x) (not (function-def? x))))) |
| 3003 | + |
| 3004 | +(define (check-no-thisfunction e) |
| 3005 | + (if (has-thisfunction? e) |
| 3006 | + (error "\"@__FUNCTION__\" not allowed inside comprehension or generator"))) |
| 3007 | + |
2998 | 3008 | (define (has-break-or-continue? e) |
2999 | 3009 | (expr-contains-p (lambda (x) (and (pair? x) (memq (car x) '(break continue)))) |
3000 | 3010 | e |
|
3003 | 3013 |
|
3004 | 3014 | (define (lower-comprehension ty expr itrs) |
3005 | 3015 | (check-no-return expr) |
| 3016 | + (check-no-thisfunction expr) |
3006 | 3017 | (if (has-break-or-continue? expr) |
3007 | 3018 | (error "break or continue outside loop")) |
3008 | 3019 | (let ((result (make-ssavalue)) |
|
3434 | 3445 | vi) |
3435 | 3446 | tab)) |
3436 | 3447 |
|
3437 | | -;; env: list of vinfo (includes any closure #self#; should not include globals) |
| 3448 | +;; env: list of vinfo (should not include globals) |
3438 | 3449 | ;; captvars: list of vinfo |
3439 | 3450 | ;; sp: list of symbol |
3440 | 3451 | ;; new-sp: list of symbol (static params declared here) |
@@ -3855,7 +3866,7 @@ f(x) = yt(x) |
3855 | 3866 | (Set '(quote top core lineinfo line inert local-def unnecessary copyast |
3856 | 3867 | meta inbounds boundscheck loopinfo decl aliasscope popaliasscope |
3857 | 3868 | thunk with-static-parameters toplevel-only |
3858 | | - global globalref global-if-global assign-const-if-global isglobal thismodule |
| 3869 | + global globalref global-if-global assign-const-if-global isglobal thismodule thisfunction |
3859 | 3870 | const atomic null true false ssavalue isdefined toplevel module lambda |
3860 | 3871 | error gc_preserve_begin gc_preserve_end export public inline noinline purity))) |
3861 | 3872 |
|
@@ -4093,7 +4104,7 @@ f(x) = yt(x) |
4093 | 4104 | ((atom? e) e) |
4094 | 4105 | (else |
4095 | 4106 | (case (car e) |
4096 | | - ((quote top core global globalref thismodule lineinfo line break inert module toplevel null true false meta) e) |
| 4107 | + ((quote top core global globalref thismodule thisfunction lineinfo line break inert module toplevel null true false meta) e) |
4097 | 4108 | ((toplevel-only) |
4098 | 4109 | ;; hack to avoid generating a (method x) expr for struct types |
4099 | 4110 | (if (eq? (cadr e) 'struct) |
@@ -5133,6 +5144,30 @@ f(x) = yt(x) |
5133 | 5144 |
|
5134 | 5145 | ((error) |
5135 | 5146 | (error (cadr e))) |
| 5147 | + |
| 5148 | + ;; thisfunction replaced with first argument name |
| 5149 | + ((thisfunction) |
| 5150 | + (let ((first-arg (and (pair? (lam:args lam)) (car (lam:args lam))))) |
| 5151 | + (if first-arg |
| 5152 | + (let* ((arg-name (arg-name first-arg)) |
| 5153 | + ;; Check for thisfunction-original metadata in keyword wrapper functions |
| 5154 | + (original-name (let ((body (lam:body lam))) |
| 5155 | + (and (pair? body) (pair? (cdr body)) |
| 5156 | + (let loop ((stmts (cdr body))) |
| 5157 | + (if (pair? stmts) |
| 5158 | + (let ((stmt (car stmts))) |
| 5159 | + (if (and (pair? stmt) (eq? (car stmt) 'meta) |
| 5160 | + (pair? (cdr stmt)) (eq? (cadr stmt) 'thisfunction-original) |
| 5161 | + (pair? (cddr stmt))) |
| 5162 | + (caddr stmt) |
| 5163 | + (loop (cdr stmts)))) |
| 5164 | + #f))))) |
| 5165 | + (final-name (or original-name arg-name))) |
| 5166 | + (cond (tail (emit-return tail final-name)) |
| 5167 | + (value final-name) |
| 5168 | + (else (emit final-name) #f))) |
| 5169 | + (error "\"@__FUNCTION__\" can only be used inside a function")))) |
| 5170 | + |
5136 | 5171 | (else |
5137 | 5172 | (error (string "invalid syntax " (deparse e))))))) |
5138 | 5173 | ;; introduce new slots for assigned arguments |
|
0 commit comments