Report printf specifiers from Service API

src/fsharp/formats.fs

@@ -48,10 +48,31 @@ let newInfo ()=
     addZeros       = false;
     precision      = false}
 
-let ParseFormatString m g fmt bty cty dty = 
+let ParseFormatString (m: Range.range) g (source: string option) report fmt bty cty dty = 
     let len = String.length fmt
 
-    let rec parseLoop acc i = 
+    // Offset to adjust ranges depending on whether input string is regular, verbatim or triple-quote
+    let offset = 
+        match source with
+        | Some source ->
+            let source = source.Replace("\r\n", "\n").Replace("\r", "\n")
+            let positions =
+                source.Split('\n')
+                |> Seq.map (fun s -> String.length s + 1)
+                |> Seq.scan (+) 0
+                |> Seq.toArray
+            let length = source.Length
+            if m.StartLine < positions.Length then
+                let startIndex = positions.[m.StartLine-1] + m.StartColumn
+                if startIndex <= length-3 && source.[startIndex..startIndex+2] = "\"\"\"" then
+                    3
+                elif startIndex <= length-2 && source.[startIndex..startIndex+1] = "@\"" then
+                    2
+                else 1
+            else 1
+        | None -> 1
+
+    let rec parseLoop acc (i, relLine, relCol) = 
        if i >= len then
            let argtys =
                if acc |> List.forall (fun (p, _) -> p = None) then // without positional specifiers
@@ -63,11 +84,13 @@ let ParseFormatString m g fmt bty cty dty =
            let ety = mkTupledTy g argtys
            aty,ety
        elif System.Char.IsSurrogatePair(fmt,i) then 
-          parseLoop acc (i+2)
+          parseLoop acc (i+2, relLine, relCol+2)
        else 
           let c = fmt.[i]
           match c with
           | '%' ->
+              let startCol = relCol
+              let relCol = relCol+1
               let i = i+1 
               if i >= len then failwithf "%s" <| FSComp.SR.forMissingFormatSpecifier()
               let info = newInfo()
@@ -139,12 +162,18 @@ let ParseFormatString m g fmt bty cty dty =
                       let p, i' = digitsPosition (int c - int '0') (i+1)
                       if p = None then None, i else p, i'
                   | _ -> None, i
-
+
+              let oldI = i
               let posi, i = position i
+              let relCol = relCol + i - oldI
 
+              let oldI = i
               let i = flags i 
+              let relCol = relCol + i - oldI
 
+              let oldI = i
               let widthArg,(precisionArg,i) = widthAndPrecision i 
+              let relCol = relCol + i - oldI
 
               if i >= len then failwithf "%s" <| FSComp.SR.forBadPrecision();
 
@@ -162,16 +191,30 @@ let ParseFormatString m g fmt bty cty dty =
                   checkNoZeroFlag c; 
                   checkNoNumericPrefix c
 
+              let reportLocation relLine relCol = 
+                  match relLine with
+                  | 0 ->
+                      report (Range.mkFileIndexRange m.FileIndex 
+                                (Range.mkPos m.StartLine (startCol + offset)) 
+                                (Range.mkPos m.StartLine (relCol + offset)))
+                  | _ ->
+                      report (Range.mkFileIndexRange m.FileIndex 
+                                (Range.mkPos (m.StartLine + relLine) startCol) 
+                                (Range.mkPos (m.StartLine + relLine) relCol))
+
               let ch = fmt.[i]
               match ch with
-              | '%' -> parseLoop acc (i+1) 
+              | '%' -> 
+                  parseLoop acc (i+1, relLine, relCol+1) 
 
               | ('d' | 'i' | 'o' | 'u' | 'x' | 'X') ->
                   if info.precision then failwithf "%s" <| FSComp.SR.forFormatDoesntSupportPrecision(ch.ToString());
-                  parseLoop ((posi, mkFlexibleIntFormatTypar g m) :: acc) (i+1)
+                  reportLocation relLine relCol
+                  parseLoop ((posi, mkFlexibleIntFormatTypar g m) :: acc) (i+1, relLine, relCol+1)
 
               | ('l' | 'L') ->
                   if info.precision then failwithf "%s" <| FSComp.SR.forFormatDoesntSupportPrecision(ch.ToString());
+                  let relCol = relCol+1
                   let i = i+1
 
                   // "bad format specifier ... In F# code you can use %d, %x, %o or %u instead ..."
@@ -181,52 +224,64 @@ let ParseFormatString m g fmt bty cty dty =
                   failwithf "%s" <| FSComp.SR.forLIsUnnecessary()
                   match fmt.[i] with
                   | ('d' | 'i' | 'o' | 'u' | 'x' | 'X') -> 
-                      parseLoop ((posi, mkFlexibleIntFormatTypar g m) :: acc)  (i+1)
+                      reportLocation relLine relCol
+                      parseLoop ((posi, mkFlexibleIntFormatTypar g m) :: acc)  (i+1, relLine, relCol+1)
                   | _ -> failwithf "%s" <| FSComp.SR.forBadFormatSpecifier()
 
               | ('h' | 'H') ->
                   failwithf "%s" <| FSComp.SR.forHIsUnnecessary()
 
               | 'M' -> 
-                  parseLoop ((posi, g.decimal_ty) :: acc) (i+1)
+                  reportLocation relLine relCol
+                  parseLoop ((posi, g.decimal_ty) :: acc) (i+1, relLine, relCol+1)
 
-              | ('f' | 'F' | 'e' | 'E' | 'g' | 'G') ->  
-                  parseLoop ((posi, mkFlexibleFloatFormatTypar g m) :: acc) (i+1)
+              | ('f' | 'F' | 'e' | 'E' | 'g' | 'G') ->
+                  reportLocation relLine relCol
+                  parseLoop ((posi, mkFlexibleFloatFormatTypar g m) :: acc) (i+1, relLine, relCol+1)
 
               | 'b' ->
                   checkOtherFlags ch;
-                  parseLoop ((posi, g.bool_ty)  :: acc) (i+1)
+                  reportLocation relLine relCol
+                  parseLoop ((posi, g.bool_ty)  :: acc) (i+1, relLine, relCol+1)
 
               | 'c' ->
                   checkOtherFlags ch;
-                  parseLoop ((posi, g.char_ty)  :: acc) (i+1)
+                  reportLocation relLine relCol
+                  parseLoop ((posi, g.char_ty)  :: acc) (i+1, relLine, relCol+1)
 
               | 's' ->
                   checkOtherFlags ch;
-                  parseLoop ((posi, g.string_ty)  :: acc) (i+1)
+                  reportLocation relLine relCol
+                  parseLoop ((posi, g.string_ty)  :: acc) (i+1, relLine, relCol+1)
 
               | 'O' ->
                   checkOtherFlags ch;
-                  parseLoop ((posi, NewInferenceType ()) :: acc)  (i+1)
+                  reportLocation relLine relCol
+                  parseLoop ((posi, NewInferenceType ()) :: acc) (i+1, relLine, relCol+1)
 
               | 'A' ->
                   match info.numPrefixIfPos with
                   | None     // %A has BindingFlags=Public, %+A has BindingFlags=Public | NonPublic
-                  | Some '+' -> parseLoop ((posi, NewInferenceType ()) :: acc)  (i+1)
+                  | Some '+' -> 
+                      reportLocation relLine relCol
+                      parseLoop ((posi, NewInferenceType ()) :: acc)  (i+1, relLine, relCol+1)
                   | Some _   -> failwithf "%s" <| FSComp.SR.forDoesNotSupportPrefixFlag(ch.ToString(), (Option.get info.numPrefixIfPos).ToString())
 
               | 'a' ->
                   checkOtherFlags ch;
                   let xty = NewInferenceType () 
                   let fty = bty --> (xty --> cty)
-                  parseLoop ((Option.map ((+)1) posi, xty) ::  (posi, fty) :: acc) (i+1)
+                  reportLocation relLine relCol
+                  parseLoop ((Option.map ((+)1) posi, xty) ::  (posi, fty) :: acc) (i+1, relLine, relCol+1)
 
               | 't' ->
                   checkOtherFlags ch;
-                  parseLoop ((posi, bty --> cty) :: acc)  (i+1)
+                  reportLocation relLine relCol
+                  parseLoop ((posi, bty --> cty) :: acc)  (i+1, relLine, relCol+1)
 
               | c -> failwithf "%s" <| FSComp.SR.forBadFormatSpecifierGeneral(String.make 1 c) 
-
-          | _ -> parseLoop acc (i+1) 
-    parseLoop [] 0
+
+          | '\n' -> parseLoop acc (i+1, relLine+1, 0)    
+          | _ -> parseLoop acc (i+1, relLine, relCol+1) 
+    parseLoop [] (0, 0, m.StartColumn)
 

src/fsharp/formats.fsi

@@ -12,4 +12,4 @@ open Microsoft.FSharp.Compiler
 open Microsoft.FSharp.Compiler.Tast 
 open Microsoft.FSharp.Compiler.AbstractIL.Internal 
 
-val ParseFormatString : Range.range -> Env.TcGlobals -> string -> TType -> TType -> TType -> TType * TType
+val ParseFormatString : Range.range -> Env.TcGlobals -> string option -> (Range.range -> unit) -> string -> TType -> TType -> TType -> TType * TType

src/fsharp/nameres.fs

@@ -1098,6 +1098,8 @@ type ITypecheckResultsSink =
     abstract NotifyEnvWithScope : range * NameResolutionEnv * AccessorDomain -> unit
     abstract NotifyExprHasType : pos * TType * Tastops.DisplayEnv * NameResolutionEnv * AccessorDomain * range -> unit
     abstract NotifyNameResolution : pos * Item * Item * ItemOccurence * Tastops.DisplayEnv * NameResolutionEnv * AccessorDomain * range -> unit
+    abstract NotifyFormatSpecifierLocation : range -> unit
+    abstract CurrentSource : string option
 
 let (|ValRefOfProp|_|) (pi : PropInfo) = pi.ArbitraryValRef
 let (|ValRefOfMeth|_|) (mi : MethInfo) = mi.ArbitraryValRef
@@ -1292,7 +1294,7 @@ type TcResolutions
 
 
 /// Represents container for all name resolutions that were met so far when typechecking some particular file
-type TcSymbolUses(g,capturedNameResolutions : ResizeArray<CapturedNameResolution>) = 
+type TcSymbolUses(g, capturedNameResolutions : ResizeArray<CapturedNameResolution>, formatSpecifierLocations: range[]) = 
 
     member this.GetUsesOfSymbol(item) = 
         [| for cnr in capturedNameResolutions do
@@ -1303,11 +1305,15 @@ type TcSymbolUses(g,capturedNameResolutions : ResizeArray<CapturedNameResolution
         [| for cnr in capturedNameResolutions do
               yield (cnr.Item, cnr.ItemOccurence, cnr.DisplayEnv, cnr.Range) |]
 
+    member this.GetFormatSpecifierLocations() =  formatSpecifierLocations
+
+
 /// An accumulator for the results being emitted into the tcSink.
-type TcResultsSinkImpl(g) =
+type TcResultsSinkImpl(g, ?source: string) =
     let capturedEnvs = ResizeArray<_>()
     let capturedExprTypings = ResizeArray<_>()
     let capturedNameResolutions = ResizeArray<_>()
+    let capturedFormatSpecifierLocations = ResizeArray<_>()
     let capturedNameResolutionIdentifiers = 
         new System.Collections.Generic.Dictionary<pos * string, unit>
             ( { new IEqualityComparer<_> with 
@@ -1320,15 +1326,17 @@ type TcResultsSinkImpl(g) =
         TcResolutions(capturedEnvs, capturedExprTypings, capturedNameResolutions, capturedMethodGroupResolutions)
 
     member this.GetSymbolUses() = 
-        TcSymbolUses(g, capturedNameResolutions)
+        TcSymbolUses(g, capturedNameResolutions, capturedFormatSpecifierLocations.ToArray())
 
     interface ITypecheckResultsSink with
         member sink.NotifyEnvWithScope(m,nenv,ad) = 
             if allowedRange m then 
                 capturedEnvs.Add((m,nenv,ad)) 
+
         member sink.NotifyExprHasType(endPos,ty,denv,nenv,ad,m) = 
             if allowedRange m then 
                 capturedExprTypings.Add((endPos,ty,denv,nenv,ad,m))
+
         member sink.NotifyNameResolution(endPos,item,itemMethodGroup,occurenceType,denv,nenv,ad,m) = 
             // Desugaring some F# constructs (notably computation expressions with custom operators)
             // results in duplication of textual variables. So we ensure we never record two name resolutions 
@@ -1352,6 +1360,11 @@ type TcResultsSinkImpl(g) =
                     capturedNameResolutions.Add(CapturedNameResolution(endPos,item,occurenceType,denv,nenv,ad,m)) 
                     capturedMethodGroupResolutions.Add(CapturedNameResolution(endPos,itemMethodGroup,occurenceType,denv,nenv,ad,m)) 
 
+        member sink.NotifyFormatSpecifierLocation(m) = 
+            capturedFormatSpecifierLocations.Add(m)
+
+        member sink.CurrentSource = source
+
 
 /// An abstract type for reporting the results of name resolution and type checking, and which allows
 /// temporary suspension and/or redirection of reporting.

src/fsharp/nameres.fsi

@@ -228,14 +228,19 @@ type internal TcSymbolUses =
 
     member GetAllUsesOfSymbols : unit -> (Item * ItemOccurence * DisplayEnv * range)[]
 
+    member GetFormatSpecifierLocations : unit -> range[]
+
+
 /// An abstract type for reporting the results of name resolution and type checking
 type ITypecheckResultsSink =
     abstract NotifyEnvWithScope   : range * NameResolutionEnv * AccessorDomain -> unit
     abstract NotifyExprHasType    : pos * TType * DisplayEnv * NameResolutionEnv * AccessorDomain * range -> unit
     abstract NotifyNameResolution : pos * Item * Item * ItemOccurence * DisplayEnv * NameResolutionEnv * AccessorDomain * range -> unit
+    abstract NotifyFormatSpecifierLocation : range -> unit
+    abstract CurrentSource : string option
 
 type internal TcResultsSinkImpl =
-    new : tcGlobals : TcGlobals -> TcResultsSinkImpl
+    new : tcGlobals : TcGlobals * ?source:string -> TcResultsSinkImpl
     member GetResolutions : unit -> TcResolutions
     member GetSymbolUses : unit -> TcSymbolUses
     interface ITypecheckResultsSink

src/fsharp/tc.fs

@@ -1712,7 +1712,9 @@ let MakeAndPublishSimpleVals cenv env m names mergeNamesInOneNameresEnv =
                     { new ITypecheckResultsSink with
                         member this.NotifyEnvWithScope(_, _, _) = () // ignore EnvWithScope reports
                         member this.NotifyNameResolution(pos, a, b, occurence, denv, nenv, ad, m) = nameResolutions.Add(pos, a, b, occurence, denv, nenv, ad, m)
-                        member this.NotifyExprHasType(_, _, _, _, _, _) = assert false } // no expr typings in MakeSimpleVals
+                        member this.NotifyExprHasType(_, _, _, _, _, _) = assert false // no expr typings in MakeSimpleVals
+                        member this.NotifyFormatSpecifierLocation _ = ()
+                        member this.CurrentSource = None } 
 
                 use _h = WithNewTypecheckResultsSink(sink, cenv.tcSink)
                 MakeSimpleVals cenv env names
@@ -6211,7 +6213,10 @@ and TcConstStringExpr cenv overallTy env m tpenv s  =
       let ty' = mkPrintfFormatTy cenv.g aty bty cty dty ety
       if (not (isObjTy cenv.g overallTy) && AddCxTypeMustSubsumeTypeUndoIfFailed env.DisplayEnv cenv.css m overallTy ty') then 
         // Parse the format string to work out the phantom types 
-        let aty',ety' = (try Formats.ParseFormatString m cenv.g s bty cty dty with Failure s -> error (Error(FSComp.SR.tcUnableToParseFormatString(s),m)))
+        let report m = match cenv.tcSink.CurrentSink with None -> () | Some sink  -> sink.NotifyFormatSpecifierLocation m
+        let source = match cenv.tcSink.CurrentSink with None -> None | Some sink -> sink.CurrentSource
+
+        let aty',ety' = (try Formats.ParseFormatString m cenv.g source report (s.Replace("\r\n", "\n").Replace("\r", "\n")) bty cty dty with Failure s -> error (Error(FSComp.SR.tcUnableToParseFormatString(s),m)))
         UnifyTypes cenv env m aty aty'
         UnifyTypes cenv env m ety ety'
         mkCallNewFormat cenv.g m aty bty cty dty ety (mkString cenv.g m s),tpenv

src/fsharp/vs/service.fs

@@ -1197,6 +1197,9 @@ type TypeCheckInfo
         [ for x in tcImports.GetImportedAssemblies() do 
                 yield FSharpAssembly(g, thisCcu, tcImports, x.FSharpViewOfMetadata) ]
 
+    // Not, this does not have to be a SyncOp, it can be called from any thread
+    member scope.GetFormatSpecifierLocations() = 
+         sSymbolUses.GetFormatSpecifierLocations() 
 
     // Not, this does not have to be a SyncOp, it can be called from any thread
     member scope.GetExtraColorizations() = 
@@ -1499,7 +1502,7 @@ module internal Parser =
             tcState.NiceNameGenerator.Reset()
 
             // Typecheck the real input.  
-            let sink = TcResultsSinkImpl(tcGlobals)
+            let sink = TcResultsSinkImpl(tcGlobals, source = source)
 
             let tcEnvAtEndOpt =
                 try
@@ -1790,6 +1793,13 @@ type FSharpCheckFileResults(errors: FSharpErrorInfo[], scopeOptX: TypeCheckInfo
             |> Option.map (fun (sym,_,_) -> sym))
 
 
+    member info.GetFormatSpecifierLocations() = 
+        threadSafeOp 
+           (fun () -> [| |]) 
+           (fun (scope, _builder, _reactor) -> 
+            // This operation is not asynchronous - GetFormatSpecifierLocations can be run on the calling thread
+            scope.GetFormatSpecifierLocations())
+
     member info.GetExtraColorizationsAlternate() = 
         threadSafeOp 
            (fun () -> [| |]) 

src/fsharp/vs/service.fsi

@@ -246,6 +246,9 @@ type FSharpCheckFileResults =
     /// <summary>Get any extra colorization info that is available after the typecheck</summary>
     member GetExtraColorizationsAlternate : unit -> (range * FSharpTokenColorKind)[]
 
+    /// <summary>Get the locations of format specifiers</summary>
+    member GetFormatSpecifierLocations : unit -> range[]
+
     /// Get all textual usages of all symbols throughout the file
     member GetAllUsesOfAllSymbolsInFile : unit -> Async<FSharpSymbolUse[]>