// (c) Microsoft Corporation. All rights reserved #light /// Anything to do with special names of identifiers and other lexical rules module (* internal *) Microsoft.FSharp.Compiler.Range open System.IO open System.Collections.Generic open Microsoft.FSharp.Text.Printf open Internal.Utilities open Internal.Utilities.Pervasives open Microsoft.FSharp.Compiler.AbstractIL open Microsoft.FSharp.Compiler.AbstractIL.Internal open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library open Microsoft.FSharp.Compiler open Microsoft.FSharp.Compiler.Lib open Microsoft.FSharp.Compiler.Lib.Bits type file_idx = int32 type pos = int32 type range = int64 (* { rangeFile: string; rangeBegin: pos; rangeEnd: pos } *) (* { posLine: int; posCol: int } *) let col_nbits = 9 let line_nbits = 16 let pos_nbits = line_nbits + col_nbits let _ = assert (pos_nbits <= 32) let pos_col_mask = mask32 0 col_nbits let line_col_mask = mask32 col_nbits line_nbits let mk_pos l c = let l = max 0 l in let c = max 0 c in ( c &&& pos_col_mask) ||| ((l <<< col_nbits) &&& line_col_mask) let inline (lsr) (x:int) (y:int) = int32 (uint32 x >>> y) let line_of_pos p = (p lsr col_nbits) let col_of_pos p = (p &&& pos_col_mask) let bits_of_pos (x:pos) :int32 = x let pos_of_bits (x:int32) : pos = x let file_idx_nbits = 14 let start_line_nbits = line_nbits let start_col_nbits = col_nbits let end_line_nbits = line_nbits let end_col_nbits = col_nbits let _ = assert (file_idx_nbits + start_line_nbits + start_col_nbits + end_line_nbits + end_col_nbits = 64) let file_idx_mask = mask64 0 file_idx_nbits let start_line_mask = mask64 (file_idx_nbits) start_line_nbits let start_col_mask = mask64 (file_idx_nbits + start_line_nbits) start_col_nbits let end_line_mask = mask64 (file_idx_nbits + start_line_nbits + start_col_nbits) end_line_nbits let end_col_mask = mask64 (file_idx_nbits + start_line_nbits + start_col_nbits + end_line_nbits) end_col_nbits let mk_file_idx_range fidx b e = int64(fidx) ||| (int64(line_of_pos b) <<< file_idx_nbits) ||| (int64(col_of_pos b) <<< (file_idx_nbits + start_line_nbits)) ||| (int64(line_of_pos e) <<< (file_idx_nbits + start_line_nbits + start_col_nbits)) ||| (int64(col_of_pos e) <<< (file_idx_nbits + start_line_nbits + start_col_nbits + end_line_nbits)) let file_idx_of_range r = int32(r &&& file_idx_mask) let start_line_of_range r = int32((r &&& start_line_mask) >>> file_idx_nbits) let start_col_of_range r = int32((r &&& start_col_mask) >>> (file_idx_nbits + start_line_nbits)) let end_line_of_range r = int32((r &&& end_line_mask) >>> (file_idx_nbits + start_line_nbits + start_col_nbits)) let end_col_of_range r = int32((r &&& end_col_mask) >>> (file_idx_nbits + start_line_nbits + start_col_nbits + end_line_nbits)) // This is just a standard unique-index table type FileIndexTable() = class let indexToFileTable = new ResizeArray<_>(11) let fileToIndexTable = new Dictionary(11) member t.FileToIndex f = let mutable res = 0 in let ok = fileToIndexTable.TryGetValue(f,&res) in if ok then res else lock fileToIndexTable (fun () -> let mutable res = 0 in let ok = fileToIndexTable.TryGetValue(f,&res) in if ok then res else let n = indexToFileTable.Count in indexToFileTable.Add(f); fileToIndexTable.[f] <- n; n) member t.IndexToFile n = (if n < 0 then failwithf "file_of_file_idx: negative argument: n = %d\n" n); (if n >= indexToFileTable.Count then failwithf "file_of_file_idx: invalid argument: n = %d\n" n); indexToFileTable.[n] end let maxFileIndex = pown32 file_idx_nbits // WARNING: Global Mutable State, holding a mapping between integers and filenames let fileIndexTable = new FileIndexTable() // Note if we exceed the maximum number of files we'll start to report incorrect file names let file_idx_of_file f = fileIndexTable.FileToIndex(f) % maxFileIndex let file_of_file_idx n = fileIndexTable.IndexToFile(n) let mk_range f b e = mk_file_idx_range (file_idx_of_file f) b e let file_of_range r = file_of_file_idx (file_idx_of_range r) (* end representation, start derived ops *) let start_of_range r = mk_pos (start_line_of_range r) (start_col_of_range r) let end_of_range r = mk_pos (end_line_of_range r) (end_col_of_range r) let dest_file_idx_range r = file_idx_of_range r,start_of_range r,end_of_range r let dest_range r = file_of_range r,start_of_range r,end_of_range r let dest_pos p = line_of_pos p,col_of_pos p let trim_range_right r n = let fidx,p1,p2 = dest_file_idx_range r in let l2,c2 = dest_pos p2 in mk_file_idx_range fidx p1 (mk_pos l2 (max 0 (c2 - n))) let pos_ord p1 p2 = Pair.order (Int32.order ,Int32.order) (dest_pos p1) (dest_pos p2) (* range_ord: not a total order, but enough to sort on ranges *) let range_ord r1 r2 = Pair.order (String.order,pos_ord) (file_of_range r1,start_of_range r1) (file_of_range r2,start_of_range r2) let output_pos (os:TextWriter) m = fprintf os "(%d,%d)" (line_of_pos m) (col_of_pos m) let output_range (os:TextWriter) m = fprintf os "%s%a-%a" (file_of_range m) output_pos (start_of_range m) output_pos (end_of_range m) let boutput_pos os m = bprintf os "(%d,%d)" (line_of_pos m) (col_of_pos m) let boutput_range os m = bprintf os "%s%a-%a" (file_of_range m) boutput_pos (start_of_range m) boutput_pos (end_of_range m) let start_range_of_range m = let f,s,e = dest_file_idx_range m in mk_file_idx_range f s s let end_range_of_range m = let f,s,e = dest_file_idx_range m in mk_file_idx_range f e e let pos_gt p1 p2 = (line_of_pos p1 > line_of_pos p2 or (line_of_pos p1 = line_of_pos p2 && col_of_pos p1 > col_of_pos p2)) let pos_eq p1 p2 = (line_of_pos p1 = line_of_pos p2 && col_of_pos p1 = col_of_pos p2) let pos_geq p1 p2 = pos_eq p1 p2 or pos_gt p1 p2 let union_ranges m1 m2 = if file_idx_of_range m1 <> file_idx_of_range m2 then m2 else let b = if pos_geq (start_of_range m1) (start_of_range m2) then (start_of_range m2) else (start_of_range m1) in let e = if pos_geq (end_of_range m1) (end_of_range m2) then (end_of_range m1) else (end_of_range m2) in mk_file_idx_range (file_idx_of_range m1) b e let range_contains_range m1 m2 = (file_of_range m1) = (file_of_range m2) && pos_geq (start_of_range m2) (start_of_range m1) && pos_geq (end_of_range m1) (end_of_range m2) let range_contains_pos m1 p = pos_geq p (start_of_range m1) && pos_geq (end_of_range m1) p let range_before_pos m1 p = pos_geq p (end_of_range m1) let rangeN filename line = mk_range filename (mk_pos line 0) (mk_pos line 80) let pos0 = mk_pos 1 0 let range0 = rangeN "unknown" 1 let rangeStartup = rangeN "startup" 1 let rangeCmdArgs = rangeN "commandLineArgs" 0 // Store a file_idx in the pos_fname field, so we don't have to look up the // file_idx hash table to map back from pos_fname to a file_idx during lexing let encode_file_idx idx = Bytes.utf8_bytes_as_string (Bytes.of_intarray [| (idx &&& 0x7F); ((idx lsr 7) &&& 0x7F) |]) let encode_file file = file |> file_idx_of_file |> encode_file_idx let _ = assert (file_idx_nbits <= 14) (* this encoding is size limited *) let decode_file_idx (s:string) = if String.length s = 0 then 0 else let idx = (int32 s.[0]) ||| ((int32 s.[1]) <<< 7) in idx (* For Diagnostics *) let string_of_pos pos = let line,col = line_of_pos pos,col_of_pos pos in sprintf "(%d,%d)" line col let string_of_range r = sprintf "%s%s-%s" (file_of_range r) (string_of_pos (start_of_range r)) (string_of_pos (end_of_range r))