|
231 | 231 | (let ((type-ex (caddr m)))
|
232 | 232 | (if (eq? (car type-ex) 'block)
|
233 | 233 | ;; extract ssavalue labels of sparams from the svec-of-sparams argument to `method`
|
234 |
| - (let ((sp-ssavals (cddr (last (last type-ex))))) |
| 234 | + (let ((sp-ssavals (cddr (cadddr (last type-ex))))) |
235 | 235 | (map (lambda (a) ;; extract T from (= v (call (core TypeVar) (quote T) ...))
|
236 | 236 | (cadr (caddr (caddr a))))
|
237 | 237 | (filter (lambda (e)
|
|
293 | 293 | (define (non-generated-version body)
|
294 | 294 | (generated-part- body #f))
|
295 | 295 |
|
| 296 | +;; Remove and return the line number for the start of the function definition |
| 297 | +(define (maybe-remove-functionloc! body) |
| 298 | + (let* ((prologue (extract-method-prologue body)) |
| 299 | + (prologue-lnos (filter linenum? prologue)) |
| 300 | + (functionloc (if (pair? prologue-lnos) |
| 301 | + (car prologue-lnos) |
| 302 | + ; Fallback - take first line anywhere in body |
| 303 | + (let ((lnos (filter linenum? body))) |
| 304 | + (if (null? lnos) '(line 0 none) (car lnos)))))) |
| 305 | + (if (length> prologue-lnos 1) |
| 306 | + ; First of two line numbers in prologue is function definition location |
| 307 | + ; which should be removed from the body. |
| 308 | + (let loop ((stmts body)) |
| 309 | + (if (eq? functionloc (cadr stmts)) |
| 310 | + (set-cdr! stmts (cddr stmts)) |
| 311 | + (loop (cdr body))))) |
| 312 | + functionloc)) |
| 313 | + |
296 | 314 | ;; construct the (method ...) expression for one primitive method definition,
|
297 | 315 | ;; assuming optional and keyword args are already handled
|
298 | 316 | (define (method-def-expr- name sparams argl body (rett '(core Any)))
|
|
328 | 346 | (error "function argument and static parameter names must be distinct"))
|
329 | 347 | (if (or (and name (not (sym-ref? name))) (not (valid-name? name)))
|
330 | 348 | (error (string "invalid function name \"" (deparse name) "\"")))
|
331 |
| - (let* ((generator (if (expr-contains-p if-generated? body (lambda (x) (not (function-def? x)))) |
| 349 | + (let* ((loc (maybe-remove-functionloc! body)) |
| 350 | + (generator (if (expr-contains-p if-generated? body (lambda (x) (not (function-def? x)))) |
332 | 351 | (let* ((gen (generated-version body))
|
333 | 352 | (nongen (non-generated-version body))
|
334 | 353 | (gname (symbol (string (gensy) "#" (current-julia-module-counter))))
|
335 |
| - (gf (make-generator-function gname names anames gen)) |
336 |
| - (loc (function-body-lineno body))) |
| 354 | + (gf (make-generator-function gname names anames gen))) |
337 | 355 | (set! body (insert-after-meta
|
338 | 356 | nongen
|
339 | 357 | `((meta generated
|
|
343 | 361 | ,(if (null? sparams)
|
344 | 362 | 'nothing
|
345 | 363 | (cons 'list (map car sparams)))
|
346 |
| - ,(if (null? loc) 0 (cadr loc)) |
347 |
| - (inert ,(if (null? loc) 'none (caddr loc))) |
| 364 | + ,(cadr loc) |
| 365 | + (inert ,(caddr loc)) |
348 | 366 | (false))))))
|
349 | 367 | (list gf))
|
350 | 368 | '()))
|
|
356 | 374 | (renames (map cons names temps))
|
357 | 375 | (mdef
|
358 | 376 | (if (null? sparams)
|
359 |
| - `(method ,name (call (core svec) (call (core svec) ,@(dots->vararg types)) (call (core svec))) |
| 377 | + `(method ,name |
| 378 | + (call (core svec) |
| 379 | + (call (core svec) ,@(dots->vararg types)) |
| 380 | + (call (core svec)) |
| 381 | + (inert ,loc)) |
360 | 382 | ,body)
|
361 | 383 | `(method ,name
|
362 | 384 | (block
|
|
377 | 399 | (map (lambda (ty)
|
378 | 400 | (replace-vars ty renames))
|
379 | 401 | types)))
|
380 |
| - (call (core svec) ,@temps))) |
| 402 | + (call (core svec) ,@temps) |
| 403 | + (inert ,loc))) |
381 | 404 | ,body))))
|
382 | 405 | (if (or (symbol? name) (globalref? name))
|
383 | 406 | `(block ,@generator (method ,name) ,mdef (unnecessary ,name)) ;; return the function
|
|
793 | 816 | wheres)
|
794 | 817 | ,(ctor-body body curlyargs sparams))))))
|
795 | 818 |
|
796 |
| -(define (function-body-lineno body) |
797 |
| - (let ((lnos (filter linenum? body))) |
798 |
| - (if (null? lnos) '() (car lnos)))) |
799 |
| - |
800 | 819 | ;; rewrite calls to `new( ... )` to `new` expressions on the appropriate
|
801 | 820 | ;; type, determined by the containing constructor definition.
|
802 | 821 | (define (rewrite-ctor ctor Tname params field-names field-types)
|
@@ -3021,9 +3040,12 @@ f(x) = yt(x)
|
3021 | 3040 | (newtypes
|
3022 | 3041 | (if iskw
|
3023 | 3042 | `(,(car types) ,(cadr types) ,closure-type ,@(cdddr types))
|
3024 |
| - `(,closure-type ,@(cdr types))))) |
3025 |
| - `(call (core svec) (call (core svec) ,@newtypes) |
3026 |
| - (call (core svec) ,@(append (cddr (cadddr te)) type-sp))))) |
| 3043 | + `(,closure-type ,@(cdr types)))) |
| 3044 | + (loc (caddddr te))) |
| 3045 | + `(call (core svec) |
| 3046 | + (call (core svec) ,@newtypes) |
| 3047 | + (call (core svec) ,@(append (cddr (cadddr te)) type-sp)) |
| 3048 | + ,loc))) |
3027 | 3049 |
|
3028 | 3050 | ;; collect all toplevel-butfirst expressions inside `e`, and return
|
3029 | 3051 | ;; (ex . stmts), where `ex` is the expression to evaluated and
|
|
0 commit comments