[WIP] RFC FS-1001 - String Interpolation

src/fsharp/CheckFormatStrings.fs

@@ -51,6 +51,12 @@ let newInfo ()=
     addZeros       = false
     precision      = false}
 
+type FormatStringFragment = 
+    | Text of string
+    | Expr of string
+
+type FormatString = FormatStringFragment list
+
 let parseFormatStringInternal (m:range) g (source: string option) fmt bty cty = 
     // Offset is used to adjust ranges depending on whether input string is regular, verbatim or triple-quote.
     // We construct a new 'fmt' string since the current 'fmt' string doesn't distinguish between "\n" and escaped "\\n".
@@ -79,16 +85,18 @@ let parseFormatStringInternal (m:range) g (source: string option) fmt bty cty =
 
     let specifierLocations = ResizeArray()
 
-    let rec parseLoop acc (i, relLine, relCol) = 
+    let rec parseLoop acc start fragments (i, relLine, relCol) = 
        if i >= len then
            let argtys =
                if acc |> List.forall (fun (p, _) -> p = None) then // without positional specifiers
                    acc |> List.map snd |> List.rev
                else  
                    failwithf "%s" <| FSComp.SR.forPositionalSpecifiersNotPermitted()
-           argtys
+
+           let fragments = if (len - start) = 0 then fragments else Text(fmt.Substring(start, len - start))::fragments
+           List.rev fragments, argtys
        elif System.Char.IsSurrogatePair(fmt,i) then 
-          parseLoop acc (i+2, relLine, relCol+2)
+          parseLoop acc start fragments (i+2, relLine, relCol+2)
        else 
           let c = fmt.[i]
           match c with
@@ -211,12 +219,12 @@ let parseFormatStringInternal (m:range) g (source: string option) fmt bty cty =
               let ch = fmt.[i]
               match ch with
               | '%' -> 
-                  parseLoop acc (i+1, relLine, relCol+1) 
+                  parseLoop acc start fragments (i+1, relLine, relCol+1) 
 
               | ('d' | 'i' | 'o' | 'u' | 'x' | 'X') ->
                   if info.precision then failwithf "%s" <| FSComp.SR.forFormatDoesntSupportPrecision(ch.ToString())
                   collectSpecifierLocation relLine relCol
-                  parseLoop ((posi, mkFlexibleIntFormatTypar g m) :: acc) (i+1, relLine, relCol+1)
+                  parseLoop ((posi, mkFlexibleIntFormatTypar g m) :: acc) start fragments (i+1, relLine, relCol+1)
 
               | ('l' | 'L') ->
                   if info.precision then failwithf "%s" <| FSComp.SR.forFormatDoesntSupportPrecision(ch.ToString())
@@ -231,77 +239,93 @@ let parseFormatStringInternal (m:range) g (source: string option) fmt bty cty =
                   match fmt.[i] with
                   | ('d' | 'i' | 'o' | 'u' | 'x' | 'X') -> 
                       collectSpecifierLocation relLine relCol
-                      parseLoop ((posi, mkFlexibleIntFormatTypar g m) :: acc)  (i+1, relLine, relCol+1)
+                      parseLoop ((posi, mkFlexibleIntFormatTypar g m) :: acc) start fragments (i+1, relLine, relCol+1)
                   | _ -> failwithf "%s" <| FSComp.SR.forBadFormatSpecifier()
 
               | ('h' | 'H') ->
                   failwithf "%s" <| FSComp.SR.forHIsUnnecessary()
 
-              | 'M' ->
+              | 'M' -> 
                   collectSpecifierLocation relLine relCol
-                  parseLoop ((posi, mkFlexibleDecimalFormatTypar g m) :: acc) (i+1, relLine, relCol+1)
+                  parseLoop ((posi, g.decimal_ty) :: acc) start fragments (i+1, relLine, relCol+1)
 
               | ('f' | 'F' | 'e' | 'E' | 'g' | 'G') ->
                   collectSpecifierLocation relLine relCol
-                  parseLoop ((posi, mkFlexibleFloatFormatTypar g m) :: acc) (i+1, relLine, relCol+1)
+                  parseLoop ((posi, mkFlexibleFloatFormatTypar g m) :: acc) start fragments (i+1, relLine, relCol+1)
 
               | 'b' ->
                   checkOtherFlags ch
                   collectSpecifierLocation relLine relCol
-                  parseLoop ((posi, g.bool_ty)  :: acc) (i+1, relLine, relCol+1)
+                  parseLoop ((posi, g.bool_ty)  :: acc) start fragments (i+1, relLine, relCol+1)
 
               | 'c' ->
                   checkOtherFlags ch
                   collectSpecifierLocation relLine relCol
-                  parseLoop ((posi, g.char_ty)  :: acc) (i+1, relLine, relCol+1)
+                  parseLoop ((posi, g.char_ty)  :: acc) start fragments (i+1, relLine, relCol+1)
 
               | 's' ->
                   checkOtherFlags ch
                   collectSpecifierLocation relLine relCol
-                  parseLoop ((posi, g.string_ty)  :: acc) (i+1, relLine, relCol+1)
+                  parseLoop ((posi, g.string_ty)  :: acc) start fragments (i+1, relLine, relCol+1)
 
               | 'O' ->
                   checkOtherFlags ch
                   collectSpecifierLocation relLine relCol
-                  parseLoop ((posi, NewInferenceType ()) :: acc) (i+1, relLine, relCol+1)
+                  parseLoop ((posi, NewInferenceType ()) :: acc) start fragments (i+1, relLine, relCol+1)
 
               | 'A' ->
                   match info.numPrefixIfPos with
                   | None     // %A has BindingFlags=Public, %+A has BindingFlags=Public | NonPublic
                   | Some '+' -> 
                       collectSpecifierLocation relLine relCol
-                      parseLoop ((posi, NewInferenceType ()) :: acc)  (i+1, relLine, relCol+1)
+                      parseLoop ((posi, NewInferenceType ()) :: acc) start fragments (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)
                   collectSpecifierLocation relLine relCol
-                  parseLoop ((Option.map ((+)1) posi, xty) ::  (posi, fty) :: acc) (i+1, relLine, relCol+1)
+                  parseLoop ((Option.map ((+)1) posi, xty) ::  (posi, fty) :: acc) start fragments (i+1, relLine, relCol+1)
 
               | 't' ->
                   checkOtherFlags ch
                   collectSpecifierLocation relLine relCol
-                  parseLoop ((posi, bty --> cty) :: acc)  (i+1, relLine, relCol+1)
+                  parseLoop ((posi, bty --> cty) :: acc) start fragments (i+1, relLine, relCol+1)
+              | '(' ->
+                  let rec findEndPosition i count = 
+                      if i >= len then failwith "Non-terminated expression in format string"
+                      else
+                      let ch = fmt.[i]
+                      match ch with
+                      | ')' ->
+                          if count = 0 then i
+                          else findEndPosition (i + 1) (count - 1)
+                      | '(' -> findEndPosition (i + 1) (count + 1)
+                      | _ -> findEndPosition (i + 1) count
+                  let endPos = findEndPosition (i + 1) 0
+                  let textLen = i - start - 1
+                  let fragments = if textLen <> 0 then Text(fmt.Substring(start, textLen)):: fragments else fragments
+                  let expr = fmt.Substring(i, endPos - i + 1)
+                  parseLoop acc (endPos + 1) (Expr(expr)::fragments) (endPos+1, relLine, relCol+1)
 
               | c -> failwithf "%s" <| FSComp.SR.forBadFormatSpecifierGeneral(String.make 1 c) 
 
-          | '\n' -> parseLoop acc (i+1, relLine+1, 0)   
-          | _ -> parseLoop acc (i+1, relLine, relCol+1)
+          | '\n' -> parseLoop acc start fragments (i+1, relLine+1, 0)   
+          | _ -> parseLoop acc start fragments (i+1, relLine, relCol+1)
 
-    let results = parseLoop [] (0, 0, m.StartColumn)
+    let results = parseLoop [] 0 [] (0, 0, m.StartColumn)
     results, Seq.toList specifierLocations
 
 let ParseFormatString m g source fmt bty cty dty = 
-    let argtys, specifierLocations = parseFormatStringInternal m g source fmt bty cty
+    let (fragments, argtys), specifierLocations = parseFormatStringInternal m g source fmt bty cty
     let aty = List.foldBack (-->) argtys dty
     let ety = mkTupledTy g argtys
-    (aty, ety), specifierLocations 
+    fragments, (aty, ety), specifierLocations 
 
 let TryCountFormatStringArguments m g fmt bty cty =
     try
-        let argtys, _specifierLocations = parseFormatStringInternal m g None fmt bty cty
+        let (_, argtys), _specifierLocations = parseFormatStringInternal m g None fmt bty cty
         Some argtys.Length
     with _ ->
         None

src/fsharp/CheckFormatStrings.fsi

@@ -13,6 +13,12 @@ open Microsoft.FSharp.Compiler.Tast
 open Microsoft.FSharp.Compiler.TcGlobals
 open Microsoft.FSharp.Compiler.AbstractIL.Internal 
 
-val ParseFormatString : Range.range -> TcGlobals -> source: string option -> fmt: string -> bty: TType -> cty: TType -> dty: TType -> (TType * TType) * Range.range list
+type FormatStringFragment = 
+    | Text of string
+    | Expr of string
+
+type FormatString = FormatStringFragment list
+
+val ParseFormatString : Range.range -> TcGlobals -> source: string option -> fmt: string -> bty: TType -> cty: TType -> dty: TType -> FormatString * (TType * TType) * Range.range list
 
 val TryCountFormatStringArguments : m:Range.range -> g:TcGlobals -> fmt:string -> bty:TType -> cty:TType -> int option

src/fsharp/CompileOps.fs

@@ -3363,6 +3363,18 @@ let ParseInput (lexer,errorLogger:ErrorLogger,lexbuf:UnicodeLexing.Lexbuf,defaul
         errorLogger.CommitDelayedErrorsAndWarnings()
     (* unwindEL, unwindBP dispose *)
 
+let GetExpressionParser (tcConfig: TcConfig, lexResourceManager) =
+    let parseText s = 
+        let errorLogger = CompileThreadStatic.ErrorLogger // TODO
+        let lexbuf = UnicodeLexing.StringAsLexbuf s
+        let lightSyntaxStatus = LightSyntaxStatus(true, true)
+        let lexargs = mkLexargs (null, tcConfig.conditionalCompilationDefines,lightSyntaxStatus,lexResourceManager, ref [], errorLogger)
+        Lexhelp.reusingLexbufForParsing lexbuf (fun () ->
+            let tokenizer = LexFilter.LexFilter(lightSyntaxStatus, tcConfig.compilingFslib, Lexer.token lexargs true, lexbuf)
+            Parser.declExpr tokenizer.Lexer lexbuf
+        )
+    parseText
+
 //----------------------------------------------------------------------------
 // parsing - ParseOneInputFile
 // Filename is (ml/mli/fs/fsi source). Parse it to AST. 
@@ -5211,7 +5223,7 @@ let TypeCheckOneInputEventually
 
                 // Typecheck the signature file 
                 let! (tcEnvAtEnd,tcEnv,smodulTypeRoot) = 
-                    TypeCheckOneSigFile (tcGlobals,tcState.tcsNiceNameGen,amap,tcState.tcsCcu,checkForErrors,tcConfig.conditionalCompilationDefines,tcSink) tcState.tcsTcSigEnv file
+                    TypeCheckOneSigFile (tcGlobals,tcState.tcsNiceNameGen,amap,tcState.tcsCcu,checkForErrors,tcConfig.conditionalCompilationDefines,tcSink) tcState.tcsTcSigEnv (GetExpressionParser(tcConfig, new Lexhelp.LexResourceManager())) file
 
                 let rootSigs = Zmap.add qualNameOfFile  smodulTypeRoot rootSigs
 
@@ -5241,7 +5253,7 @@ let TypeCheckOneInputEventually
 
                 // Typecheck the implementation file 
                 let! topAttrs,implFile,tcEnvAtEnd = 
-                    TypeCheckOneImplFile  (tcGlobals,tcState.tcsNiceNameGen,amap,tcState.tcsCcu,checkForErrors,tcConfig.conditionalCompilationDefines,tcSink) tcImplEnv rootSigOpt file
+                    TypeCheckOneImplFile (tcGlobals,tcState.tcsNiceNameGen,amap,tcState.tcsCcu,checkForErrors,tcConfig.conditionalCompilationDefines,tcSink) tcImplEnv (GetExpressionParser(tcConfig, new Lexhelp.LexResourceManager())) rootSigOpt file
 
                 let hadSig = isSome rootSigOpt
                 let implFileSigType = SigTypeOfImplFile implFile

src/fsharp/FSharp.Compiler.Unittests/FSharp.Compiler.Unittests.fsproj

@@ -62,6 +62,7 @@
     <Compile Include="ManglingNameOfProvidedTypes.fs" />
     <Compile Include="HashIfExpression.fs" />
     <Compile Include="ProductVersion.fs" />
+    <Compile Include="StringInterpolationTests.fs" />
   </ItemGroup>
   <ItemGroup>
     <ProjectReference Include="$(FSharpSourcesRoot)\fsharp\FSharp.Compiler\FSharp.Compiler.fsproj">

src/fsharp/FSharp.Compiler.Unittests/StringInterpolationTests.fs

@@ -0,0 +1,41 @@
+// Copyright (c) Microsoft Corporation.  All Rights Reserved.  Licensed under the Apache License, Version 2.0.  See License.txt in the project root for license information.
+
+namespace FSharp.Compiler.Unittests
+
+open System
+open NUnit.Framework
+
+type A(s: string) = 
+    member val Y = s
+
+type B = {
+    X : string
+    Y : int
+}
+
+
+[<TestFixture>]
+type StringInterpolationTests() =
+    [<Test>]
+    member this.``should interpolate local variable``() =
+        let bar = "!!!abc!!!"
+        Assert.AreEqual(bar,sprintf "%(bar)")
+
+//    [<Test>]
+//    member this.``should interpolate record property``() =
+//        let b = { X = "world"; Y = 42 }
+//        Assert.AreEqual("hello world and 42.",sprintf "hello %(b.X) and %(b.Y).")
+
+    [<Test>]
+    member this.``should interpolate local variable and class``() =
+        let bar = "!!!abc!!!"
+        let baz = new A("100500")
+        Assert.AreEqual("start foo!!!abc!!! + 100500abc 999",sprintf "%s foo%(bar) + %(baz.Y + bar.[3..5]) %d" "start" 999)
+
+//    [<Test>]
+//    member this.``interpolate %(number) is consistent to %d`` () =
+//        let prefix = "blab"
+//        let suffix = "blub"
+//        [-10..10]
+//        |> List.iter (fun number -> Assert.AreEqual(sprintf "%s%d%s" prefix number suffix,sprintf "%s%(number)%s" prefix suffix))
+

src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Core/PrintfTests.fs

@@ -22,4 +22,4 @@ type PrintfTests() =
         test "%10d"  123   "       123"
         test "%-10d" 123   "123       "
         test "%10c"  'a'   "         a"
-        test "%-10c" 'a'   "a         "
+        test "%-10c" 'a'   "a         "