| 1 : |
dbm |
597 |
structure SourceMap : SOURCE_MAP =
|
| 2 : |
|
|
struct
|
| 3 : |
|
|
structure F = Format
|
| 4 : |
|
|
|
| 5 : |
|
|
type charpos = int
|
| 6 : |
|
|
|
| 7 : |
|
|
type region = charpos * charpos
|
| 8 : |
|
|
|
| 9 : |
|
|
datatype location
|
| 10 : |
|
|
= LOC of
|
| 11 : |
|
|
{srcFile : string,
|
| 12 : |
|
|
beginLine : int,
|
| 13 : |
|
|
beginCol : int,
|
| 14 : |
|
|
endLine : int,
|
| 15 : |
|
|
endCol : int}
|
| 16 : |
|
|
| UNKNOWN
|
| 17 : |
|
|
|
| 18 : |
|
|
datatype sourcemap
|
| 19 : |
|
|
= SOURCEMAP of
|
| 20 : |
|
|
{ linePos : charpos list ref,
|
| 21 : |
|
|
filePos : {linePos : charpos list,
|
| 22 : |
|
|
line : int,
|
| 23 : |
|
|
srcFile : string} list ref,
|
| 24 : |
|
|
lineNum : int ref}
|
| 25 : |
|
|
|
| 26 : |
|
|
(* DBM: the filePos is a stack of records, but it doesn't get popped, so
|
| 27 : |
|
|
* it looks like filePos could just be a ref of the record *)
|
| 28 : |
|
|
|
| 29 : |
|
|
fun newmap{srcFile} = SOURCEMAP
|
| 30 : |
dbm |
639 |
{ linePos = ref [1], (* this compensates for lex bug : yypos off by 2 *)
|
| 31 : |
|
|
filePos = ref [{linePos=[],line=1,srcFile=srcFile}],
|
| 32 : |
|
|
lineNum = ref 1
|
| 33 : |
|
|
}
|
| 34 : |
dbm |
597 |
|
| 35 : |
|
|
fun newline (SOURCEMAP{linePos,lineNum,...}) pos =
|
| 36 : |
|
|
(linePos := pos :: !linePos; lineNum := 1 + !lineNum)
|
| 37 : |
|
|
|
| 38 : |
|
|
fun resynch (SOURCEMAP{linePos,filePos,lineNum,...}) {pos,srcFile,line} =
|
| 39 : |
|
|
(filePos := {linePos= !linePos,
|
| 40 : |
|
|
line= !lineNum,
|
| 41 : |
|
|
srcFile=
|
| 42 : |
|
|
(case srcFile of
|
| 43 : |
|
|
SOME srcFile => srcFile
|
| 44 : |
|
|
| NONE =>
|
| 45 : |
|
|
let val fpl = !filePos
|
| 46 : |
|
|
in case fpl of
|
| 47 : |
|
|
nil => ""
|
| 48 : |
|
|
| x :: _ => #srcFile x
|
| 49 : |
|
|
end)
|
| 50 : |
|
|
} :: !filePos;
|
| 51 : |
|
|
linePos := [pos];
|
| 52 : |
|
|
lineNum := line
|
| 53 : |
|
|
)
|
| 54 : |
|
|
|
| 55 : |
|
|
fun parseDirective sourceMap (pos,directive) =
|
| 56 : |
|
|
let fun sep #" " = true
|
| 57 : |
|
|
| sep #"\"" = true
|
| 58 : |
|
|
| sep #"#" = true
|
| 59 : |
|
|
| sep #"\n" = true
|
| 60 : |
|
|
| sep _ = false
|
| 61 : |
|
|
fun proc{line, srcOpt} =
|
| 62 : |
|
|
(case Int.fromString line
|
| 63 : |
|
|
of SOME line =>
|
| 64 : |
|
|
resynch sourceMap {pos=pos,srcFile=srcOpt,line=line}
|
| 65 : |
|
|
| _ => newline sourceMap pos)
|
| 66 : |
|
|
in if Config.ParseControl.parseDirective then
|
| 67 : |
|
|
case String.tokens sep directive
|
| 68 : |
|
|
of ("line" :: line :: srcFile :: _) =>
|
| 69 : |
|
|
proc{line=line, srcOpt=SOME srcFile}
|
| 70 : |
|
|
| line::srcFile::_ => proc{line=line, srcOpt=SOME srcFile}
|
| 71 : |
|
|
| line :: _ => proc{line=line, srcOpt=NONE}
|
| 72 : |
|
|
| _ => newline sourceMap pos
|
| 73 : |
|
|
else newline sourceMap pos
|
| 74 : |
|
|
end
|
| 75 : |
|
|
|
| 76 : |
|
|
fun currPos(SOURCEMAP{linePos,...}) = hd (!linePos)
|
| 77 : |
|
|
|
| 78 : |
|
|
|
| 79 : |
|
|
fun location(SOURCEMAP{linePos,filePos,lineNum,...}) (x,y) =
|
| 80 : |
|
|
let fun findPos(p,currPos,currFile,pos::rest,filePos,line) =
|
| 81 : |
|
|
if p > pos then
|
| 82 : |
|
|
{srcFile=currFile,line=line,column=p - pos}
|
| 83 : |
|
|
else findPos(p,pos,currFile,rest,filePos,line-1)
|
| 84 : |
|
|
| findPos(p,currPos,currFile,[],{linePos,line,srcFile}::filePos,_) =
|
| 85 : |
|
|
findPos(p,currPos,#srcFile(hd filePos),linePos,filePos,line)
|
| 86 : |
|
|
(* NOTE: very confusing...
|
| 87 : |
|
|
filePos stack contains previous line info and srcFile of current file *)
|
| 88 : |
|
|
| findPos(p,currPos,currFile,[],[],line) =
|
| 89 : |
|
|
{srcFile=currFile,line=line,column=0}
|
| 90 : |
|
|
|
| 91 : |
|
|
val {srcFile=currFile,...} = hd(!filePos)
|
| 92 : |
|
|
val {srcFile,line=l1,column=c1} =
|
| 93 : |
|
|
findPos(x,x,currFile,!linePos,!filePos,!lineNum)
|
| 94 : |
|
|
val {srcFile,line=l2,column=c2} =
|
| 95 : |
|
|
findPos(y,y,currFile,!linePos,!filePos,!lineNum)
|
| 96 : |
|
|
in LOC{srcFile = srcFile,
|
| 97 : |
|
|
beginLine = l1,
|
| 98 : |
|
|
beginCol = c1,
|
| 99 : |
|
|
endLine = l2,
|
| 100 : |
|
|
endCol = c2
|
| 101 : |
|
|
}
|
| 102 : |
|
|
end
|
| 103 : |
|
|
|
| 104 : |
|
|
(* return a string representing a location *)
|
| 105 : |
|
|
fun locToString UNKNOWN = "\"???\""
|
| 106 : |
|
|
| locToString (LOC{srcFile,beginLine,beginCol,endLine,endCol}) = let
|
| 107 : |
|
|
val srcFile = srcFile
|
| 108 : |
|
|
val p1line = beginLine
|
| 109 : |
|
|
val p1pos = beginCol
|
| 110 : |
|
|
val p2line = endLine
|
| 111 : |
|
|
val p2pos = endCol
|
| 112 : |
|
|
in
|
| 113 : |
|
|
if (beginLine = endLine)
|
| 114 : |
|
|
then if (p1pos < p2pos)
|
| 115 : |
|
|
then F.format "\"%s\":%d.%d-%d" [
|
| 116 : |
|
|
F.STR srcFile, F.INT p1line, F.INT p1pos, F.INT p2pos
|
| 117 : |
|
|
]
|
| 118 : |
|
|
else F.format "\"%s\":%d.%d" [
|
| 119 : |
|
|
F.STR srcFile, F.INT p1line, F.INT p1pos
|
| 120 : |
|
|
]
|
| 121 : |
|
|
else F.format "\"%s\":%d.%d-%d.%d" [
|
| 122 : |
|
|
F.STR srcFile, F.INT p1line, F.INT p1pos,
|
| 123 : |
|
|
F.INT p2line, F.INT p2pos
|
| 124 : |
|
|
]
|
| 125 : |
|
|
end (* locToString *)
|
| 126 : |
|
|
|
| 127 : |
|
|
end
|
| 128 : |
|
|
|
| 129 : |
|
|
|
Parent Directory
| 
Revision Log
