[MLton-commit] r7547

[Matthew F. <fl...@ml...>]

Interpret #line directives as relative to source file.
----------------------------------------------------------------------

U   mlton/trunk/mlton/control/source.sml

----------------------------------------------------------------------

Modified: mlton/trunk/mlton/control/source.sml
===================================================================
--- mlton/trunk/mlton/control/source.sml	2011-06-15 02:20:56 UTC (rev 7546)
+++ mlton/trunk/mlton/control/source.sml	2011-06-17 15:21:02 UTC (rev 7547)
@@ -1,4 +1,5 @@
-(* Copyright (C) 1999-2006, 2008 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2011 Matthew Fluet.
+ * Copyright (C) 1999-2006, 2008 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  * Copyright (C) 1997-2000 NEC Research Institute.
  *
@@ -11,7 +12,8 @@
 
 datatype t = T of {file: File.t ref,
                    lineNum: int ref,
-                   lineStart: int ref}
+                   lineStart: int ref,
+                   origDir: Dir.t}
 
 fun getPos (T {file, lineNum, lineStart, ...}, n) =
    SourcePos.make {column = n - !lineStart,
@@ -20,10 +22,18 @@
 
 fun lineStart (s as T {lineStart, ...}) = getPos (s, !lineStart)
 
-fun lineDirective (T {file, lineNum, lineStart},
+fun lineDirective (T {file, lineNum, lineStart, origDir},
                    f,
                    {lineNum = n, lineStart = s}) =
-   (Option.app (f, fn f => file := f)
+   (Option.app (f, fn f =>
+                let
+                   val f =
+                      if OS.Path.isAbsolute f
+                         then f
+                      else OS.Path.mkCanonical (OS.Path.concat (origDir, f))
+                in
+                   file := f
+                end)
     ; lineNum := n
     ; lineStart := s)
 
@@ -34,7 +44,8 @@
                    * starts at position ~1, which will translate position 0 to
                    * column 1.
                    *)
-                  lineStart = ref ~1}
+                  lineStart = ref ~1,
+                  origDir = File.dirOf file}
 
 fun newline (T {lineStart, lineNum, ...}, n) =
    (Int.inc lineNum