diff --git a/src/fsharp/CheckFormatStrings.fs b/src/fsharp/CheckFormatStrings.fs index d70062daf76..1509dd28d73 100644 --- a/src/fsharp/CheckFormatStrings.fs +++ b/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,46 +239,46 @@ 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' -> @@ -278,30 +286,46 @@ let parseFormatStringInternal (m:range) g (source: string option) fmt bty cty = 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 diff --git a/src/fsharp/CheckFormatStrings.fsi b/src/fsharp/CheckFormatStrings.fsi index cd04c36d67b..c805c84cd6c 100644 --- a/src/fsharp/CheckFormatStrings.fsi +++ b/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 diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index 5205429894e..26d2b387c33 100755 --- a/src/fsharp/CompileOps.fs +++ b/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 diff --git a/src/fsharp/FSharp.Compiler.Unittests/FSharp.Compiler.Unittests.fsproj b/src/fsharp/FSharp.Compiler.Unittests/FSharp.Compiler.Unittests.fsproj index 28721abe8c2..9e95a9d2654 100644 --- a/src/fsharp/FSharp.Compiler.Unittests/FSharp.Compiler.Unittests.fsproj +++ b/src/fsharp/FSharp.Compiler.Unittests/FSharp.Compiler.Unittests.fsproj @@ -62,6 +62,7 @@ + diff --git a/src/fsharp/FSharp.Compiler.Unittests/StringInterpolationTests.fs b/src/fsharp/FSharp.Compiler.Unittests/StringInterpolationTests.fs new file mode 100644 index 00000000000..8d9c5557dd7 --- /dev/null +++ b/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 +} + + +[] +type StringInterpolationTests() = + [] + member this.``should interpolate local variable``() = + let bar = "!!!abc!!!" + Assert.AreEqual(bar,sprintf "%(bar)") + +// [] +// 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).") + + [] + 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) + +// [] +// 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)) + diff --git a/src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Core/PrintfTests.fs b/src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Core/PrintfTests.fs index c2fbf866927..6223860a2ee 100644 --- a/src/fsharp/FSharp.Core.Unittests/FSharp.Core/Microsoft.FSharp.Core/PrintfTests.fs +++ b/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 " \ No newline at end of file + test "%-10c" 'a' "a " diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index c77de8b545f..31db9038b4c 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -490,6 +490,10 @@ let AddDeclaredTypars check typars env = let env = ModifyNameResEnv (fun nenv -> AddDeclaredTyparsToNameEnv check nenv typars) env RegisterDeclaredTypars typars env +[] +type StringFormatEnv = + { StringConcatMethod: MethInfo } + /// Compilation environment for typechecking a compilation unit. Contains the /// F# and .NET modules loaded from disk, the search path, a table indicating /// how to List.map F# modules to assembly names, and some nasty globals @@ -536,13 +540,31 @@ type cenv = nameResolver: NameResolver conditionalDefines: string list - + + stringFormatEnv: Lazy + + exprParser: string -> SynExpr } - static member Create (g,isScript,niceNameGen,amap,topCcu,isSig,haveSig,conditionalDefines,tcSink, tcVal) = + static member Create (g, nenv, exprParser, isScript,niceNameGen,amap,topCcu,isSig,haveSig,conditionalDefines,tcSink, tcVal) = let infoReader = new InfoReader(g,amap) let instantiationGenerator m tpsorig = ConstraintSolver.FreshenTypars m tpsorig let nameResolver = new NameResolver(g,amap,infoReader,instantiationGenerator) + let stringFormatEnv = + lazy + let concat = + AllMethInfosOfTypeInScope infoReader nenv (Some("Concat"), AccessibleFromEverywhere) IgnoreOverrides range.Zero g.string_ty + |> List.find (fun meth -> + match meth with + | ILMeth(_, ilMethInfo, _) -> + match ilMethInfo.ParamMetadata with + | [{ Type = ILType.Array(shape, ty) }] -> shape = ILArrayShape.SingleDimensional && isILObjectTy ty + | _ -> false + | _ -> false + ) + { StringConcatMethod = concat } + + { g = g amap = amap recUses = ValMultiMap<_>.Empty @@ -558,7 +580,9 @@ type cenv = isSig = isSig haveSig = haveSig compilingCanonicalFslibModuleType = (isSig || not haveSig) && g.compilingFslib - conditionalDefines = conditionalDefines } + conditionalDefines = conditionalDefines + stringFormatEnv = stringFormatEnv + exprParser = exprParser } let CopyAndFixupTypars m rigid tpsorig = ConstraintSolver.FreshenAndFixupTypars m rigid [] [] tpsorig @@ -6531,7 +6555,7 @@ and TcConstStringExpr cenv overallTy env m tpenv s = let source = match cenv.tcSink.CurrentSink with None -> None | Some sink -> sink.CurrentSource let normalizedString = (s.Replace("\r\n", "\n").Replace("\r", "\n")) - let (aty',ety'), specifierLocations = (try CheckFormatStrings.ParseFormatString m cenv.g source normalizedString bty cty dty with Failure s -> error (Error(FSComp.SR.tcUnableToParseFormatString(s),m))) + let fragments, (aty',ety'), specifierLocations = (try CheckFormatStrings.ParseFormatString m cenv.g source normalizedString bty cty dty with Failure s -> error (Error(FSComp.SR.tcUnableToParseFormatString(s),m))) match cenv.tcSink.CurrentSink with | None -> () @@ -6541,7 +6565,33 @@ and TcConstStringExpr cenv overallTy env m tpenv s = 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 + let tpenv, formatString = + + match fragments with + | [CheckFormatStrings.FormatStringFragment.Text s] -> tpenv, mkString cenv.g m s + | _ -> + let tpenv, stringFragments = + ((tpenv, []), fragments) ||> List.fold (fun (currentTpEnv, l) v -> + match v with + | CheckFormatStrings.FormatStringFragment.Text s -> currentTpEnv, ((mkString cenv.g m s)::l) + | CheckFormatStrings.FormatStringFragment.Expr s -> + let synExpr = cenv.exprParser s + let expr, _ty, tpenv1 = TcExprOfUnknownType cenv env tpenv synExpr + tpenv1, expr::l + //mkString cenv.g m s // TODO + ) + + let coersed = + stringFragments + |> List.rev + |> List.map (fun s -> mkCoerceIfNeeded cenv.g cenv.g.obj_ty cenv.g.string_ty s) + + let arr = Expr.Op(TOp.Array, [cenv.g.obj_ty], coersed, m) + let expr, _ = + BuildPossiblyConditionalMethodCall cenv env NeverMutates m false cenv.stringFormatEnv.Value.StringConcatMethod NormalValUse [] [] [arr] + tpenv, expr + + mkCallNewFormat cenv.g m aty bty cty dty ety formatString, tpenv else UnifyTypes cenv env m overallTy cenv.g.string_ty mkString cenv.g m s,tpenv @@ -16630,12 +16680,13 @@ let CheckModuleSignature g cenv m denvAtEnd rootSigOpt implFileTypePriorToSig im let TypeCheckOneImplFile // checkForErrors: A function to help us stop reporting cascading errors (g, niceNameGen, amap, topCcu, checkForErrors, conditionalDefines, tcSink) - env + (env: TcEnv) + (exprParser: string -> SynExpr) (rootSigOpt : ModuleOrNamespaceType option) (ParsedImplFileInput(_,isScript,qualNameOfFile,scopedPragmas,_,implFileFrags,isLastCompiland)) = eventually { - let cenv = cenv.Create (g, isScript, niceNameGen, amap, topCcu, false, isSome rootSigOpt, conditionalDefines, tcSink, (LightweightTcValForUsingInBuildMethodCall g)) + let cenv = cenv.Create (g, env.NameEnv, exprParser, isScript, niceNameGen, amap, topCcu, false, isSome rootSigOpt, conditionalDefines, tcSink, (LightweightTcValForUsingInBuildMethodCall g)) let envinner, mtypeAcc = MakeInitialEnv env @@ -16712,9 +16763,13 @@ let TypeCheckOneImplFile /// Check an entire signature file -let TypeCheckOneSigFile (g,niceNameGen,amap,topCcu,checkForErrors,conditionalDefines,tcSink) tcEnv (ParsedSigFileInput(_,qualNameOfFile,_, _,sigFileFrags)) = - eventually { - let cenv = cenv.Create (g,false,niceNameGen,amap,topCcu,true,false,conditionalDefines,tcSink, (LightweightTcValForUsingInBuildMethodCall g)) +let TypeCheckOneSigFile + (g,niceNameGen,amap,topCcu,checkForErrors,conditionalDefines,tcSink) + (tcEnv: TcEnv) + exprParser + (ParsedSigFileInput(_,qualNameOfFile,_, _,sigFileFrags)) = + eventually { + let cenv = cenv.Create (g, tcEnv.NameEnv, exprParser, false,niceNameGen,amap,topCcu,true,false,conditionalDefines,tcSink, (LightweightTcValForUsingInBuildMethodCall g)) let envinner,mtypeAcc = MakeInitialEnv tcEnv let specs = [ for x in sigFileFrags -> SynModuleSigDecl.NamespaceFragment(x) ] diff --git a/src/fsharp/TypeChecker.fsi b/src/fsharp/TypeChecker.fsi index 51a346c35e9..8793b02321c 100644 --- a/src/fsharp/TypeChecker.fsi +++ b/src/fsharp/TypeChecker.fsi @@ -45,14 +45,16 @@ val CombineTopAttrs : TopAttribs -> TopAttribs -> TopAttribs val TypeCheckOneImplFile : TcGlobals * NiceNameGenerator * ImportMap * CcuThunk * (unit -> bool) * ConditionalDefines * NameResolution.TcResultsSink - -> TcEnv + -> TcEnv + -> (string -> SynExpr) -> Tast.ModuleOrNamespaceType option -> ParsedImplFileInput -> Eventually val TypeCheckOneSigFile : TcGlobals * NiceNameGenerator * ImportMap * CcuThunk * (unit -> bool) * ConditionalDefines * NameResolution.TcResultsSink - -> TcEnv + -> TcEnv + -> (string -> SynExpr) -> ParsedSigFileInput -> Eventually diff --git a/src/fsharp/pars.fsy b/src/fsharp/pars.fsy index 37f87a0dc55..f50ba99b865 100755 --- a/src/fsharp/pars.fsy +++ b/src/fsharp/pars.fsy @@ -260,7 +260,7 @@ let rangeOfLongIdent(lid:LongIdent) = %token COMMENT WHITESPACE HASH_LINE HASH_LIGHT INACTIVECODE LINE_COMMENT STRING_TEXT EOF %token HASH_IF HASH_ELSE HASH_ENDIF -%start signatureFile implementationFile interaction typedSeqExprEOF typEOF +%start signatureFile implementationFile interaction declExpr typedSeqExprEOF typEOF %type typedSeqExprEOF %type implementationFile %type signatureFile