From 0538cae0b6d017c5b3915302a9ca8cbedbba80ec Mon Sep 17 00:00:00 2001
From: Daniel Green <ddgreen@gmail.com>
Date: Tue, 15 Nov 2016 16:10:58 -0500
Subject: [PATCH] Initial support for line directives

This will allow backtraces to report the original file and line number
instead of m-CORE.setting and its line number.

This also works in EVALs, making it easier to know which one has died.
---
 src/HLL/Actions.nqp                   |  5 +++++
 src/HLL/Compiler.nqp                  | 22 ++++++++++++++++++++--
 src/HLL/Grammar.nqp                   |  4 ++++
 src/HLL/World.nqp                     | 10 ++++++++++
 src/vm/moar/QAST/QASTCompilerMAST.nqp |  6 ++++--
 5 files changed, 43 insertions(+), 4 deletions(-)

diff --git a/src/HLL/Actions.nqp b/src/HLL/Actions.nqp
index b2cdcfdfa9..68deeebd0f 100644
--- a/src/HLL/Actions.nqp
+++ b/src/HLL/Actions.nqp
@@ -224,4 +224,9 @@ class HLL::Actions {
                          !! self.string_to_int( $/, 10 )
                         );
     }
+
+    method comment:sym<line_directive>($/) {
+        my $orig_line := HLL::Compiler.lineof($/.orig(), $/.from(), :cache(1), :directives(0));
+        $*W.add_comp_line_directive([$orig_line, nqp::radix(10, $<line>, 0, 0)[0], $<filename>]);
+    }
 }
diff --git a/src/HLL/Compiler.nqp b/src/HLL/Compiler.nqp
index b605706149..ce7fe7f71b 100644
--- a/src/HLL/Compiler.nqp
+++ b/src/HLL/Compiler.nqp
@@ -661,8 +661,26 @@ class HLL::Compiler does HLL::Backend::Default {
         nqp::list_i(nqp::add_i($lo, 1), nqp::add_i($column, 1));
     }
 
-    method lineof($target, int $pos, int :$cache = 0) {
-        nqp::atpos_i(self.line_and_column_of($target, $pos, :$cache), 0);
+    method lineof($target, int $pos, int :$cache = 0, int :$directives = 0) {
+        self.linefileof($target, $pos, :$cache, :$directives)[0]
+    }
+
+    method linefileof($target, int $pos, int :$cache = 0, int :$directives = 0) {
+        my int $line := nqp::atpos_i(self.line_and_column_of($target, $pos, :$cache), 0);
+        my str $file := '';
+        if $directives && (my @clds := @*comp_line_directives) {
+            my int $i := nqp::elems(@clds);
+            while $i > 0 {
+                $i := $i - 1;
+                last if $line > @clds[$i][0];
+            }
+            if $line > @clds[$i][0] {
+                my @directive := @clds[$i];
+                $line := $line - @directive[0] + @directive[1] - 1;
+                $file := @directive[2];
+            }
+        }
+        [$line, $file];
     }
 
     
diff --git a/src/HLL/Grammar.nqp b/src/HLL/Grammar.nqp
index 7e85f1ceec..89a5385ab5 100644
--- a/src/HLL/Grammar.nqp
+++ b/src/HLL/Grammar.nqp
@@ -127,6 +127,10 @@ grammar HLL::Grammar {
         ]
     }
 
+    regex comment:sym<line_directive> {
+        ^^ '#' \s* 'line' \s+ $<line>=(\d+) [ \s+ $<filename>=(\S+) ]? $$
+    }
+
 =begin 
 
 =item O(*%spec)
diff --git a/src/HLL/World.nqp b/src/HLL/World.nqp
index e972a47522..7c34ccb695 100644
--- a/src/HLL/World.nqp
+++ b/src/HLL/World.nqp
@@ -82,6 +82,9 @@ class HLL::World {
 
     has $!is_nested;
 
+    # List of any line number/filename directives in the file.
+    my @*comp_line_directives := nqp::hash();
+
     method BUILD(:$handle!, :$description = '<unknown>', :$context) {
         if $context {
             $!context   := $context;
@@ -181,4 +184,11 @@ class HLL::World {
     method fixup_tasks() {
         $!context.fixup_tasks
     }
+
+    method add_comp_line_directive(@directive) {
+        my int $elems := nqp::elems(@*comp_line_directives);
+        if $elems == 0 || !(@*comp_line_directives[$elems - 1][0] eq @directive[0]) {
+            nqp::push(@*comp_line_directives, @directive);
+        }
+    }
 }
diff --git a/src/vm/moar/QAST/QASTCompilerMAST.nqp b/src/vm/moar/QAST/QASTCompilerMAST.nqp
index b05ea546bc..4339b92c35 100644
--- a/src/vm/moar/QAST/QASTCompilerMAST.nqp
+++ b/src/vm/moar/QAST/QASTCompilerMAST.nqp
@@ -1402,9 +1402,11 @@ my class MASTCompilerInstance {
             # Annotate with line number if we have one.
             my $node := $_.node;
             if nqp::isconcrete($node) && nqp::can($node,'orig') {
-                my $line := HLL::Compiler.lineof($node.orig(), $node.from(), :cache(1));
+                my @line_file := HLL::Compiler.linefileof($node.orig(), $node.from(), :cache(1), :directives(1));
+                my $line := @line_file[0];
+                my $file := @line_file[1] || $!file;
                 nqp::push(@all_ins, MAST::Annotated.new(
-                    :$!file, :$line, :instructions($last_stmt.instructions) ));
+                    :$file, :$line, :instructions($last_stmt.instructions) ));
             }
             else {
                 nqp::splice(@all_ins, $last_stmt.instructions, +@all_ins, 0);