WIP: Caller location for macros

base/exports.jl

@@ -1002,6 +1002,7 @@ export
 # help and reflection
     apropos,
     current_module,
+    current_location,
     edit,
     code_typed,
     code_warntype,

base/loading.jl

@@ -526,6 +526,15 @@ evaluated by `julia -e <expr>`.
 """
 macro __DIR__() source_dir() end
 
+"""
+    current_location() -> Int
+
+Return the line number where the current macro expansion was invoked.
+"""
+function current_location()
+    convert(Int, ccall(:jl_macro_caller_lineno, Cint, ()))
+end
+
 include_from_node1(path::AbstractString) = include_from_node1(String(path))
 function include_from_node1(_path::String)
     path, prev = _include_dependency(_path)

src/ast.c

@@ -172,33 +172,45 @@ value_t fl_current_module_counter(fl_context_t *fl_ctx, value_t *args, uint32_t
         return fixnum(jl_module_next_counter(ptls->current_module));
 }
 
+JL_DLLEXPORT int jl_macro_caller_lineno(void)
+{
+    jl_ptls_t ptls = jl_get_ptls_states();
+    return ptls->macro_caller_lineno;
+}
+
 value_t fl_invoke_julia_macro(fl_context_t *fl_ctx, value_t *args, uint32_t nargs)
 {
     JL_TIMING(MACRO_INVOCATION);
     jl_ptls_t ptls = jl_get_ptls_states();
-    if (nargs < 1)
-        argcount(fl_ctx, "invoke-julia-macro", nargs, 1);
+    if (nargs < 2)
+        argcount(fl_ctx, "invoke-julia-macro", nargs, 2);
+    if (!isfixnum(args[0]))
+        lerror(fl_ctx, fl_ctx->ArgError, "invoke-julia-macro: expected lineno");
+    int last_caller_lineno = ptls->macro_caller_lineno;
+    ptls->macro_caller_lineno = numval(args[0]);
     jl_method_instance_t *mfunc = NULL;
+    uint32_t mnargs = nargs - 1;
     jl_value_t **margs;
     // Reserve one more slot for the result
-    JL_GC_PUSHARGS(margs, nargs + 1);
+    JL_GC_PUSHARGS(margs, mnargs + 1);
     int i;
-    for(i=1; i < nargs; i++) margs[i] = scm_to_julia(fl_ctx, args[i], 1);
+    for(i=2; i < nargs; i++) margs[i-1] = scm_to_julia(fl_ctx, args[i], 1);
     jl_value_t *result = NULL;
-    size_t world = jl_get_ptls_states()->world_age;
+    size_t world = ptls->world_age;
 
     JL_TRY {
-        margs[0] = scm_to_julia(fl_ctx, args[0], 1);
+        margs[0] = scm_to_julia(fl_ctx, args[1], 1);
         margs[0] = jl_toplevel_eval(margs[0]);
-        mfunc = jl_method_lookup(jl_gf_mtable(margs[0]), margs, nargs, 1, world);
+        mfunc = jl_method_lookup(jl_gf_mtable(margs[0]), margs, mnargs, 1, world);
         if (mfunc == NULL) {
-            jl_method_error((jl_function_t*)margs[0], margs, nargs, world);
+            jl_method_error((jl_function_t*)margs[0], margs, mnargs, world);
             // unreachable
         }
-        margs[nargs] = result = jl_call_method_internal(mfunc, margs, nargs);
+        margs[mnargs] = result = jl_call_method_internal(mfunc, margs, mnargs);
     }
     JL_CATCH {
         JL_GC_POP();
+        ptls->macro_caller_lineno = last_caller_lineno;
         value_t opaque = cvalue(fl_ctx, jl_ast_ctx(fl_ctx)->jvtype, sizeof(void*));
         *(jl_value_t**)cv_data((cvalue_t*)ptr(opaque)) = ptls->exception_in_transit;
         return fl_list2(fl_ctx, jl_ast_ctx(fl_ctx)->error_sym, opaque);
@@ -225,6 +237,7 @@ value_t fl_invoke_julia_macro(fl_context_t *fl_ctx, value_t *args, uint32_t narg
     fl_free_gc_handles(fl_ctx, 1);
 
     JL_GC_POP();
+    ptls->macro_caller_lineno = last_caller_lineno;
     return scmresult;
 }
 
@@ -853,7 +866,8 @@ jl_value_t *jl_parse_eval_all(const char *fname,
             value_t expansion;
             {
                 JL_TIMING(LOWERING);
-                expansion = fl_applyn(fl_ctx, 1, symbol_value(symbol(fl_ctx, "jl-expand-to-thunk")), car_(ast));
+                expansion = fl_applyn(fl_ctx, 2, symbol_value(symbol(fl_ctx, "jl-expand-to-thunk")),
+                                      car_(ast), fixnum((fixnum_t)jl_lineno));
             }
             jl_get_ptls_states()->world_age = jl_world_counter;
             form = scm_to_julia(fl_ctx, expansion, 0);
@@ -925,14 +939,16 @@ static int jl_parse_deperror(fl_context_t *fl_ctx, int err)
     return prev == fl_ctx->T ? 1 : 0;
 }
 
-// returns either an expression or a thunk
-jl_value_t *jl_call_scm_on_ast(const char *funcname, jl_value_t *expr)
+// Call flisp function as (func expr lineno)
+// Returns either an expression or a thunk.
+jl_value_t *jl_call_scm_on_ast(const char *funcname, jl_value_t *expr, int lineno)
 {
     jl_ast_context_t *ctx = jl_ast_ctx_enter();
     fl_context_t *fl_ctx = &ctx->fl;
     JL_AST_PRESERVE_PUSH(ctx, roots, old_roots);
     value_t arg = julia_to_scm(fl_ctx, expr);
-    value_t e = fl_applyn(fl_ctx, 1, symbol_value(symbol(fl_ctx, funcname)), arg);
+    value_t e = fl_applyn(fl_ctx, 2, symbol_value(symbol(fl_ctx, funcname)),
+                          arg, fixnum((fixnum_t)lineno));
     jl_value_t *result = scm_to_julia(fl_ctx, e, 0);
     JL_AST_PRESERVE_POP(ctx, old_roots);
     jl_ast_ctx_leave(ctx);
@@ -942,13 +958,13 @@ jl_value_t *jl_call_scm_on_ast(const char *funcname, jl_value_t *expr)
 JL_DLLEXPORT jl_value_t *jl_expand(jl_value_t *expr)
 {
     JL_TIMING(LOWERING);
-    return jl_call_scm_on_ast("jl-expand-to-thunk", expr);
+    return jl_call_scm_on_ast("jl-expand-to-thunk", expr, jl_lineno);
 }
 
 JL_DLLEXPORT jl_value_t *jl_macroexpand(jl_value_t *expr)
 {
     JL_TIMING(LOWERING);
-    return jl_call_scm_on_ast("jl-macroexpand", expr);
+    return jl_call_scm_on_ast("jl-macroexpand", expr, 0);
 }
 
 // wrap expr in a thunk AST

src/jlfrontend.scm

@@ -7,6 +7,8 @@
 (load "julia-parser.scm")
 (load "julia-syntax.scm")
 
+(define current-lineno 0)
+
 
 ;; exception handler for parser. turns known errors into special expressions,
 ;; and prevents throwing an exception past a C caller.
@@ -77,7 +79,7 @@
 ;; note: expansion of stuff inside module is delayed, so the contents obey
 ;; toplevel expansion order (don't expand until stuff before is evaluated).
 (define (expand-toplevel-expr-- e)
-  (let ((ex0 (julia-expand-macros e)))
+  (let ((ex0 (julia-expand-macros e current-lineno)))
     (if (and (pair? ex0) (eq? (car ex0) 'toplevel))
         ex0
         (let* ((ex (julia-expand0 ex0))
@@ -118,7 +120,7 @@
 
 ;; construct default definitions of `eval` for non-bare modules
 ;; called by jl_eval_module_expr
-(define (module-default-defs e)
+(define (module-default-defs e lineno)
   (jl-expand-to-thunk
    (let ((name (caddr e))
          (body (cadddr e)))
@@ -132,7 +134,8 @@
          (= (call eval m x)
             (block
              ,loc
-             (call (core eval) m x))))))))
+             (call (core eval) m x))))))
+   lineno))
 
 ;; parse only, returning end position, no expansion.
 (define (jl-parse-one-string s pos0 greedy)
@@ -149,7 +152,7 @@
     (parser-wrap (lambda ()
                  (let ((inp  (make-token-stream (open-input-string s))))
                    ;; parse all exprs into a (toplevel ...) form
-                   (let loop ((exprs '()))
+                   (let loop ((exprs `((line 1 ,current-filename))))
                      ;; delay expansion so macros run in the Task executing
                      ;; the input, not the task parsing it (issue #2378)
                      ;; used to be (expand-toplevel-expr expr)
@@ -212,15 +215,15 @@
     prev))
 
 ; expand a piece of raw surface syntax to an executable thunk
-(define (jl-expand-to-thunk expr)
+(define (jl-expand-to-thunk expr lineno)
   (parser-wrap (lambda ()
-                 (expand-toplevel-expr expr))))
+                 (with-bindings ((current-lineno lineno)) (expand-toplevel-expr expr)))))
 
 ; macroexpand only
-(define (jl-macroexpand expr)
+(define (jl-macroexpand expr lineno)
   (reset-gensyms)
   (parser-wrap (lambda ()
-                 (julia-expand-macros expr))))
+                 (julia-expand-macros expr lineno))))
 
 ; run whole frontend on a string. useful for testing.
 (define (fe str)

src/julia-parser.scm

@@ -2091,18 +2091,15 @@
             (let ((head (if (eq? (peek-token s) '|.|)
                             (begin (take-token s) '__dot__)
                             (parse-unary-prefix s))))
-              (if (eq? head '__LINE__)
-                  (input-port-line (ts:port s))
-                  (begin
-                    (peek-token s)
-                    (if (ts:space? s)
-                        `(macrocall ,(macroify-name head)
-                                    ,@(parse-space-separated-exprs s))
-                        (let ((call (parse-call-chain s head #t)))
-                          (if (and (pair? call) (eq? (car call) 'call))
-                              `(macrocall ,(macroify-name (cadr call)) ,@(cddr call))
-                              `(macrocall ,(macroify-name call)
-                                          ,@(parse-space-separated-exprs s))))))))))
+              (peek-token s)
+              (if (ts:space? s)
+                  `(macrocall ,(macroify-name head)
+                              ,@(parse-space-separated-exprs s))
+                  (let ((call (parse-call-chain s head #t)))
+                    (if (and (pair? call) (eq? (car call) 'call))
+                        `(macrocall ,(macroify-name (cadr call)) ,@(cddr call))
+                        `(macrocall ,(macroify-name call)
+                                    ,@(parse-space-separated-exprs s))))))))
 
           ;; command syntax
           ((eqv? t #\`)

src/julia-syntax.scm

@@ -3066,7 +3066,7 @@ f(x) = yt(x)
                             ,@top-stmts
                             ,@sp-inits
                             (method ,name ,(cl-convert sig fname lam namemap toplevel interp)
-                                    ,(julia-expand-macros `(quote ,newlam))
+                                    ,(julia-expand-macros `(quote ,newlam) 0) ;; FIXME?
                                     ,(last e))))))
                  ;; local case - lift to a new type at top level
                  (let* ((exists (get namemap name #f))
@@ -3752,4 +3752,4 @@ f(x) = yt(x)
 (define (julia-expand ex)
   (julia-expand1
    (julia-expand0
-    (julia-expand-macros ex))))
+    (julia-expand-macros ex 0))))

src/julia_internal.h

@@ -460,7 +460,7 @@ jl_value_t *jl_interpret_toplevel_expr_in(jl_module_t *m, jl_value_t *e,
                                           jl_code_info_t *src,
                                           jl_svec_t *sparam_vals);
 int jl_is_toplevel_only_expr(jl_value_t *e);
-jl_value_t *jl_call_scm_on_ast(const char *funcname, jl_value_t *expr);
+jl_value_t *jl_call_scm_on_ast(const char *funcname, jl_value_t *expr, int lineno);
 
 jl_method_instance_t *jl_method_lookup_by_type(jl_methtable_t *mt, jl_tupletype_t *types,
                                                int cache, int inexact, int allow_exec, size_t world);

src/julia_threads.h

@@ -103,6 +103,7 @@ typedef struct _jl_tls_states_t {
     int8_t disable_gc;
     volatile sig_atomic_t defer_signal;
     struct _jl_module_t *current_module;
+    int macro_caller_lineno;
     struct _jl_task_t *volatile current_task;
     struct _jl_task_t *root_task;
     struct _jl_value_t *volatile task_arg_in_transit;

src/macroexpand.scm

@@ -164,6 +164,14 @@
       (cadr e)
       e))
 
+(define (linemacro? e)
+  (if (eq? (cadr e) '@__LINE__)
+      (let ((nargs (- (length e) 2)))
+        (if (eq? nargs 0)
+            #t
+            (error (string "macro \"@__LINE__\" should have zero arguments, found " nargs))))
+      #f))
+
 (define (typevar-expr-name e) (car (analyze-typevar e)))
 
 (define (new-expansion-env-for x env (outermost #f))
@@ -226,10 +234,14 @@
                               `(global ,(resolve-expansion-vars-with-new-env arg env m inarg))))))
            ((using import importall export meta line inbounds boundscheck simdloop) (map unescape e))
            ((macrocall)
-            (if (or (eq? (cadr e) '@label) (eq? (cadr e) '@goto)) e
-                `(macrocall ,.(map (lambda (x)
-                                     (resolve-expansion-vars-with-new-env x env m inarg))
-                                   (cdr e)))))
+            (cond ((or (eq? (cadr e) '@label) (eq? (cadr e) '@goto))
+                   e)
+                  ((linemacro? e)
+                   current-lineno)
+                  (else
+                   `(macrocall ,.(map (lambda (x)
+                                        (resolve-expansion-vars-with-new-env x env m inarg))
+                                      (cdr e))))))
            ((symboliclabel) e)
            ((symbolicgoto) e)
            ((type)
@@ -392,17 +404,28 @@
          (relabel (pair-with-gensyms labels)))
     (rename-symbolic-labels- e relabel)))
 
-;; macro expander entry point
+;; Map julia-expand-macros across `exs`, tracking line number
+(define (map-expand-with-lineno exs lineno)
+  (let loop ((exs exs) (lineno lineno) (out '()))
+    (if (not (pair? exs))
+        (reverse! out)
+        (let ((e (car exs)))
+          (if (and (pair? e) (eq? (car e) 'line))
+              (loop (cdr exs) (cadr e) (cons e out))
+              (loop (cdr exs) lineno (cons (julia-expand-macros e lineno) out)))))))
 
-(define (julia-expand-macros e)
+;; macro expander entry point
+(define (julia-expand-macros e lineno)
   (cond ((not (pair? e))     e)
         ((eq? (car e) 'quote)
          ;; backquote is essentially a built-in macro at the moment
-         (julia-expand-macros (julia-bq-expand (cadr e) 0)))
+         (julia-expand-macros (julia-bq-expand (cadr e) 0) lineno))
         ((eq? (car e) 'inert) e)
         ((eq? (car e) 'macrocall)
          ;; expand macro
-         (let ((form (apply invoke-julia-macro (cadr e) (cddr e))))
+         (let ((form (if (linemacro? e)
+                         `(,lineno)
+                         (apply invoke-julia-macro lineno (cadr e) (cddr e)))))
            (if (not form)
                (error (string "macro \"" (cadr e) "\" not defined")))
            (if (and (pair? form) (eq? (car form) 'error))
@@ -412,7 +435,9 @@
              ;; m is the macro's def module
              (rename-symbolic-labels
               (julia-expand-macros
-               (resolve-expansion-vars form m))))))
+               (with-bindings ((current-lineno lineno)) (resolve-expansion-vars form m))
+               lineno)))))
         ((eq? (car e) 'module) e)
         (else
-         (map julia-expand-macros e))))
+         (map-expand-with-lineno e lineno))))
+

src/threading.c

@@ -280,6 +280,7 @@ static void ti_initthread(int16_t tid)
     }
     ptls->defer_signal = 0;
     ptls->current_module = NULL;
+    ptls->macro_caller_lineno = 0;
     void *bt_data = malloc(sizeof(uintptr_t) * (JL_MAX_BT_SIZE + 1));
     if (bt_data == NULL) {
         jl_printf(JL_STDERR, "could not allocate backtrace buffer\n");

src/toplevel.c

@@ -189,7 +189,7 @@ jl_value_t *jl_eval_module_expr(jl_expr_t *ex)
     JL_TRY {
         if (std_imports) {
             // add `eval` function
-            defaultdefs = jl_call_scm_on_ast("module-default-defs", (jl_value_t*)ex);
+            defaultdefs = jl_call_scm_on_ast("module-default-defs", (jl_value_t*)ex, jl_lineno);
             ptls->world_age = jl_world_counter;
             jl_toplevel_eval_flex(defaultdefs, 0, 1);
             defaultdefs = NULL;

test/ambiguous.jl

@@ -1,7 +1,7 @@
 # This file is a part of Julia. License is MIT: http://julialang.org/license
 
 # DO NOT ALTER ORDER OR SPACING OF METHODS BELOW
-const lineoffset = @__LINE__ + 0 # XXX: __LINE__ at the end of a line is off-by-one
+const lineoffset = @__LINE__
 ambig(x, y) = 1
 ambig(x::Integer, y) = 2
 ambig(x, y::Integer) = 3

test/docs.jl

@@ -49,7 +49,7 @@ end
 
 # General tests for docstrings.
 
-const LINE_NUMBER = @__LINE__+1
+const LINE_NUMBER = @__LINE__() + 1
 "DocsTest"
 module DocsTest