Skip to content

Commit 6542316

Browse files
forkiforki
committed
[prototype] string interpolation - originally by Vladimir Matveev
1 parent 7f2b687 commit 6542316

6 files changed

Lines changed: 130 additions & 37 deletions

File tree

‎src/fsharp/CheckFormatStrings.fs‎

Lines changed: 46 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -51,6 +51,12 @@ let newInfo ()=
5151
addZeros = false
5252
precision = false}
5353

54+
type FormatStringFragment =
55+
| Text of string
56+
| Expr of string
57+
58+
type FormatString = FormatStringFragment list
59+
5460
let parseFormatStringInternal (m:range) g (source: string option) fmt bty cty =
5561
// Offset is used to adjust ranges depending on whether input string is regular, verbatim or triple-quote.
5662
// 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 =
7985

8086
let specifierLocations = ResizeArray()
8187

82-
let rec parseLoop acc (i, relLine, relCol) =
88+
let rec parseLoop acc start fragments (i, relLine, relCol) =
8389
if i >= len then
8490
let argtys =
8591
if acc |> List.forall (fun (p, _) -> p = None) then // without positional specifiers
8692
acc |> List.map snd |> List.rev
8793
else
8894
failwithf "%s" <| FSComp.SR.forPositionalSpecifiersNotPermitted()
89-
argtys
95+
96+
let fragments = if (len - start) = 0 then fragments else Text(fmt.Substring(start, len - start))::fragments
97+
List.rev fragments, argtys
9098
elif System.Char.IsSurrogatePair(fmt,i) then
91-
parseLoop acc (i+2, relLine, relCol+2)
99+
parseLoop acc start fragments (i+2, relLine, relCol+2)
92100
else
93101
let c = fmt.[i]
94102
match c with
@@ -211,12 +219,12 @@ let parseFormatStringInternal (m:range) g (source: string option) fmt bty cty =
211219
let ch = fmt.[i]
212220
match ch with
213221
| '%' ->
214-
parseLoop acc (i+1, relLine, relCol+1)
222+
parseLoop acc start fragments (i+1, relLine, relCol+1)
215223

216224
| ('d' | 'i' | 'o' | 'u' | 'x' | 'X') ->
217225
if info.precision then failwithf "%s" <| FSComp.SR.forFormatDoesntSupportPrecision(ch.ToString())
218226
collectSpecifierLocation relLine relCol
219-
parseLoop ((posi, mkFlexibleIntFormatTypar g m) :: acc) (i+1, relLine, relCol+1)
227+
parseLoop ((posi, mkFlexibleIntFormatTypar g m) :: acc) start fragments (i+1, relLine, relCol+1)
220228

221229
| ('l' | 'L') ->
222230
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 =
231239
match fmt.[i] with
232240
| ('d' | 'i' | 'o' | 'u' | 'x' | 'X') ->
233241
collectSpecifierLocation relLine relCol
234-
parseLoop ((posi, mkFlexibleIntFormatTypar g m) :: acc) (i+1, relLine, relCol+1)
242+
parseLoop ((posi, mkFlexibleIntFormatTypar g m) :: acc) start fragments (i+1, relLine, relCol+1)
235243
| _ -> failwithf "%s" <| FSComp.SR.forBadFormatSpecifier()
236244

237245
| ('h' | 'H') ->
238246
failwithf "%s" <| FSComp.SR.forHIsUnnecessary()
239247

240-
| 'M' ->
248+
| 'M' ->
241249
collectSpecifierLocation relLine relCol
242-
parseLoop ((posi, mkFlexibleDecimalFormatTypar g m) :: acc) (i+1, relLine, relCol+1)
250+
parseLoop ((posi, g.decimal_ty) :: acc) start fragments (i+1, relLine, relCol+1)
243251

244252
| ('f' | 'F' | 'e' | 'E' | 'g' | 'G') ->
245253
collectSpecifierLocation relLine relCol
246-
parseLoop ((posi, mkFlexibleFloatFormatTypar g m) :: acc) (i+1, relLine, relCol+1)
254+
parseLoop ((posi, mkFlexibleFloatFormatTypar g m) :: acc) start fragments (i+1, relLine, relCol+1)
247255

248256
| 'b' ->
249257
checkOtherFlags ch
250258
collectSpecifierLocation relLine relCol
251-
parseLoop ((posi, g.bool_ty) :: acc) (i+1, relLine, relCol+1)
259+
parseLoop ((posi, g.bool_ty) :: acc) start fragments (i+1, relLine, relCol+1)
252260

253261
| 'c' ->
254262
checkOtherFlags ch
255263
collectSpecifierLocation relLine relCol
256-
parseLoop ((posi, g.char_ty) :: acc) (i+1, relLine, relCol+1)
264+
parseLoop ((posi, g.char_ty) :: acc) start fragments (i+1, relLine, relCol+1)
257265

258266
| 's' ->
259267
checkOtherFlags ch
260268
collectSpecifierLocation relLine relCol
261-
parseLoop ((posi, g.string_ty) :: acc) (i+1, relLine, relCol+1)
269+
parseLoop ((posi, g.string_ty) :: acc) start fragments (i+1, relLine, relCol+1)
262270

263271
| 'O' ->
264272
checkOtherFlags ch
265273
collectSpecifierLocation relLine relCol
266-
parseLoop ((posi, NewInferenceType ()) :: acc) (i+1, relLine, relCol+1)
274+
parseLoop ((posi, NewInferenceType ()) :: acc) start fragments (i+1, relLine, relCol+1)
267275

268276
| 'A' ->
269277
match info.numPrefixIfPos with
270278
| None // %A has BindingFlags=Public, %+A has BindingFlags=Public | NonPublic
271279
| Some '+' ->
272280
collectSpecifierLocation relLine relCol
273-
parseLoop ((posi, NewInferenceType ()) :: acc) (i+1, relLine, relCol+1)
281+
parseLoop ((posi, NewInferenceType ()) :: acc) start fragments (i+1, relLine, relCol+1)
274282
| Some _ -> failwithf "%s" <| FSComp.SR.forDoesNotSupportPrefixFlag(ch.ToString(), (Option.get info.numPrefixIfPos).ToString())
275283

276284
| 'a' ->
277285
checkOtherFlags ch
278286
let xty = NewInferenceType ()
279287
let fty = bty --> (xty --> cty)
280288
collectSpecifierLocation relLine relCol
281-
parseLoop ((Option.map ((+)1) posi, xty) :: (posi, fty) :: acc) (i+1, relLine, relCol+1)
289+
parseLoop ((Option.map ((+)1) posi, xty) :: (posi, fty) :: acc) start fragments (i+1, relLine, relCol+1)
282290

283291
| 't' ->
284292
checkOtherFlags ch
285293
collectSpecifierLocation relLine relCol
286-
parseLoop ((posi, bty --> cty) :: acc) (i+1, relLine, relCol+1)
294+
parseLoop ((posi, bty --> cty) :: acc) start fragments (i+1, relLine, relCol+1)
295+
| '(' ->
296+
let rec findEndPosition i count =
297+
if i >= len then failwith "Non-terminated expression in format string"
298+
else
299+
let ch = fmt.[i]
300+
match ch with
301+
| ')' ->
302+
if count = 0 then i
303+
else findEndPosition (i + 1) (count - 1)
304+
| '(' -> findEndPosition (i + 1) (count + 1)
305+
| _ -> findEndPosition (i + 1) count
306+
let endPos = findEndPosition (i + 1) 0
307+
let textLen = i - start - 1
308+
let fragments = if textLen <> 0 then Text(fmt.Substring(start, textLen)):: fragments else fragments
309+
let expr = fmt.Substring(i, endPos - i + 1)
310+
parseLoop acc (endPos + 1) (Expr(expr)::fragments) (endPos+1, relLine, relCol+1)
287311

288312
| c -> failwithf "%s" <| FSComp.SR.forBadFormatSpecifierGeneral(String.make 1 c)
289313

290-
| '\n' -> parseLoop acc (i+1, relLine+1, 0)
291-
| _ -> parseLoop acc (i+1, relLine, relCol+1)
314+
| '\n' -> parseLoop acc start fragments (i+1, relLine+1, 0)
315+
| _ -> parseLoop acc start fragments (i+1, relLine, relCol+1)
292316

293-
let results = parseLoop [] (0, 0, m.StartColumn)
317+
let results = parseLoop [] 0 [] (0, 0, m.StartColumn)
294318
results, Seq.toList specifierLocations
295319

296320
let ParseFormatString m g source fmt bty cty dty =
297-
let argtys, specifierLocations = parseFormatStringInternal m g source fmt bty cty
321+
let (fragments, argtys), specifierLocations = parseFormatStringInternal m g source fmt bty cty
298322
let aty = List.foldBack (-->) argtys dty
299323
let ety = mkTupledTy g argtys
300-
(aty, ety), specifierLocations
324+
fragments, (aty, ety), specifierLocations
301325

302326
let TryCountFormatStringArguments m g fmt bty cty =
303327
try
304-
let argtys, _specifierLocations = parseFormatStringInternal m g None fmt bty cty
328+
let (_, argtys), _specifierLocations = parseFormatStringInternal m g None fmt bty cty
305329
Some argtys.Length
306330
with _ ->
307331
None

‎src/fsharp/CheckFormatStrings.fsi‎

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -13,6 +13,12 @@ open Microsoft.FSharp.Compiler.Tast
1313
open Microsoft.FSharp.Compiler.TcGlobals
1414
open Microsoft.FSharp.Compiler.AbstractIL.Internal
1515

16-
val ParseFormatString : Range.range -> TcGlobals -> source: string option -> fmt: string -> bty: TType -> cty: TType -> dty: TType -> (TType * TType) * Range.range list
16+
type FormatStringFragment =
17+
| Text of string
18+
| Expr of string
19+
20+
type FormatString = FormatStringFragment list
21+
22+
val ParseFormatString : Range.range -> TcGlobals -> source: string option -> fmt: string -> bty: TType -> cty: TType -> dty: TType -> FormatString * (TType * TType) * Range.range list
1723

1824
val TryCountFormatStringArguments : m:Range.range -> g:TcGlobals -> fmt:string -> bty:TType -> cty:TType -> int option

‎src/fsharp/CompileOps.fs‎

Lines changed: 13 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3363,6 +3363,18 @@ let ParseInput (lexer,errorLogger:ErrorLogger,lexbuf:UnicodeLexing.Lexbuf,defaul
33633363
errorLogger.CommitDelayedErrorsAndWarnings()
33643364
(* unwindEL, unwindBP dispose *)
33653365

3366+
let GetExpressionParser (tcConfig: TcConfig, lexResourceManager) =
3367+
let parseText s =
3368+
let errorLogger = CompileThreadStatic.ErrorLogger // TODO
3369+
let lexbuf = UnicodeLexing.StringAsLexbuf s
3370+
let lightSyntaxStatus = LightSyntaxStatus(true, true)
3371+
let lexargs = mkLexargs (null, tcConfig.conditionalCompilationDefines,lightSyntaxStatus,lexResourceManager, ref [], errorLogger)
3372+
Lexhelp.reusingLexbufForParsing lexbuf (fun () ->
3373+
let tokenizer = LexFilter.LexFilter(lightSyntaxStatus, tcConfig.compilingFslib, Lexer.token lexargs true, lexbuf)
3374+
Parser.declExpr tokenizer.Lexer lexbuf
3375+
)
3376+
parseText
3377+
33663378
//----------------------------------------------------------------------------
33673379
// parsing - ParseOneInputFile
33683380
// Filename is (ml/mli/fs/fsi source). Parse it to AST.
@@ -5241,7 +5253,7 @@ let TypeCheckOneInputEventually
52415253

52425254
// Typecheck the implementation file
52435255
let! topAttrs,implFile,tcEnvAtEnd =
5244-
TypeCheckOneImplFile (tcGlobals,tcState.tcsNiceNameGen,amap,tcState.tcsCcu,checkForErrors,tcConfig.conditionalCompilationDefines,tcSink) tcImplEnv rootSigOpt file
5256+
TypeCheckOneImplFile (tcGlobals,tcState.tcsNiceNameGen,amap,tcState.tcsCcu,checkForErrors,tcConfig.conditionalCompilationDefines,tcSink) tcImplEnv rootSigOpt file
52455257

52465258
let hadSig = isSome rootSigOpt
52475259
let implFileSigType = SigTypeOfImplFile implFile

‎src/fsharp/TypeChecker.fs‎

Lines changed: 59 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -490,6 +490,10 @@ let AddDeclaredTypars check typars env =
490490
let env = ModifyNameResEnv (fun nenv -> AddDeclaredTyparsToNameEnv check nenv typars) env
491491
RegisterDeclaredTypars typars env
492492

493+
[<NoEquality; NoComparison>]
494+
type StringFormatEnv =
495+
{ StringConcatMethod: MethInfo }
496+
493497
/// Compilation environment for typechecking a compilation unit. Contains the
494498
/// F# and .NET modules loaded from disk, the search path, a table indicating
495499
/// how to List.map F# modules to assembly names, and some nasty globals
@@ -536,13 +540,31 @@ type cenv =
536540
nameResolver: NameResolver
537541

538542
conditionalDefines: string list
539-
543+
544+
stringFormatEnv: Lazy<StringFormatEnv>
545+
546+
exprParser: string -> SynExpr
540547
}
541548

542-
static member Create (g,isScript,niceNameGen,amap,topCcu,isSig,haveSig,conditionalDefines,tcSink, tcVal) =
549+
static member Create (g, nenv, exprParser, isScript,niceNameGen,amap,topCcu,isSig,haveSig,conditionalDefines,tcSink, tcVal) =
543550
let infoReader = new InfoReader(g,amap)
544551
let instantiationGenerator m tpsorig = ConstraintSolver.FreshenTypars m tpsorig
545552
let nameResolver = new NameResolver(g,amap,infoReader,instantiationGenerator)
553+
let stringFormatEnv =
554+
lazy
555+
let concat =
556+
AllMethInfosOfTypeInScope infoReader nenv (Some("Concat"), AccessibleFromEverywhere) IgnoreOverrides range.Zero g.string_ty
557+
|> List.find (fun meth ->
558+
match meth with
559+
| ILMeth(_, ilMethInfo, _) ->
560+
match ilMethInfo.ParamMetadata with
561+
| [{ Type = ILType.Array(shape, ty) }] -> shape = ILArrayShape.SingleDimensional && isILObjectTy ty
562+
| _ -> false
563+
| _ -> false
564+
)
565+
{ StringConcatMethod = concat }
566+
567+
546568
{ g = g
547569
amap = amap
548570
recUses = ValMultiMap<_>.Empty
@@ -558,7 +580,9 @@ type cenv =
558580
isSig = isSig
559581
haveSig = haveSig
560582
compilingCanonicalFslibModuleType = (isSig || not haveSig) && g.compilingFslib
561-
conditionalDefines = conditionalDefines }
583+
conditionalDefines = conditionalDefines
584+
stringFormatEnv = stringFormatEnv
585+
exprParser = exprParser }
562586

563587
let CopyAndFixupTypars m rigid tpsorig =
564588
ConstraintSolver.FreshenAndFixupTypars m rigid [] [] tpsorig
@@ -6531,7 +6555,7 @@ and TcConstStringExpr cenv overallTy env m tpenv s =
65316555
let source = match cenv.tcSink.CurrentSink with None -> None | Some sink -> sink.CurrentSource
65326556
let normalizedString = (s.Replace("\r\n", "\n").Replace("\r", "\n"))
65336557

6534-
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)))
6558+
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)))
65356559

65366560
match cenv.tcSink.CurrentSink with
65376561
| None -> ()
@@ -6541,7 +6565,27 @@ and TcConstStringExpr cenv overallTy env m tpenv s =
65416565

65426566
UnifyTypes cenv env m aty aty'
65436567
UnifyTypes cenv env m ety ety'
6544-
mkCallNewFormat cenv.g m aty bty cty dty ety (mkString cenv.g m s),tpenv
6568+
let tpenv, formatString =
6569+
let tpenv, stringFragments =
6570+
((tpenv, []), fragments) ||> List.fold (fun (currentTpEnv, l) v ->
6571+
match v with
6572+
| CheckFormatStrings.FormatStringFragment.Text s -> currentTpEnv, ((mkString cenv.g m s)::l)
6573+
| CheckFormatStrings.FormatStringFragment.Expr s ->
6574+
let synExpr = cenv.exprParser s
6575+
let expr, _ty, tpenv1 = TcExprOfUnknownType cenv env tpenv synExpr
6576+
tpenv1, expr::l
6577+
//mkString cenv.g m s // TODO
6578+
)
6579+
let stringFragments = List.rev stringFragments
6580+
match stringFragments with
6581+
| [s] -> tpenv, s
6582+
| x ->
6583+
let coersed = x |> List.map (fun s -> mkCoerceIfNeeded cenv.g cenv.g.obj_ty cenv.g.string_ty s)
6584+
let arr = Expr.Op(TOp.Array, [cenv.g.obj_ty], coersed, m)
6585+
let expr, _ =
6586+
BuildPossiblyConditionalMethodCall cenv env NeverMutates m false cenv.stringFormatEnv.Value.StringConcatMethod NormalValUse [] [] [arr]
6587+
tpenv, expr
6588+
mkCallNewFormat cenv.g m aty bty cty dty ety formatString, tpenv
65456589
else
65466590
UnifyTypes cenv env m overallTy cenv.g.string_ty
65476591
mkString cenv.g m s,tpenv
@@ -16630,12 +16674,13 @@ let CheckModuleSignature g cenv m denvAtEnd rootSigOpt implFileTypePriorToSig im
1663016674
let TypeCheckOneImplFile
1663116675
// checkForErrors: A function to help us stop reporting cascading errors
1663216676
(g, niceNameGen, amap, topCcu, checkForErrors, conditionalDefines, tcSink)
16633-
env
16677+
(env: TcEnv)
16678+
(exprParser: string -> SynExpr)
1663416679
(rootSigOpt : ModuleOrNamespaceType option)
1663516680
(ParsedImplFileInput(_,isScript,qualNameOfFile,scopedPragmas,_,implFileFrags,isLastCompiland)) =
1663616681

1663716682
eventually {
16638-
let cenv = cenv.Create (g, isScript, niceNameGen, amap, topCcu, false, isSome rootSigOpt, conditionalDefines, tcSink, (LightweightTcValForUsingInBuildMethodCall g))
16683+
let cenv = cenv.Create (g, env.NameEnv, exprParser, isScript, niceNameGen, amap, topCcu, false, isSome rootSigOpt, conditionalDefines, tcSink, (LightweightTcValForUsingInBuildMethodCall g))
1663916684

1664016685
let envinner, mtypeAcc = MakeInitialEnv env
1664116686

@@ -16712,9 +16757,13 @@ let TypeCheckOneImplFile
1671216757

1671316758

1671416759
/// Check an entire signature file
16715-
let TypeCheckOneSigFile (g,niceNameGen,amap,topCcu,checkForErrors,conditionalDefines,tcSink) tcEnv (ParsedSigFileInput(_,qualNameOfFile,_, _,sigFileFrags)) =
16716-
eventually {
16717-
let cenv = cenv.Create (g,false,niceNameGen,amap,topCcu,true,false,conditionalDefines,tcSink, (LightweightTcValForUsingInBuildMethodCall g))
16760+
let TypeCheckOneSigFile
16761+
(g,niceNameGen,amap,topCcu,checkForErrors,conditionalDefines,tcSink)
16762+
(tcEnv: TcEnv)
16763+
exprParser
16764+
(ParsedSigFileInput(_,qualNameOfFile,_, _,sigFileFrags)) =
16765+
eventually {
16766+
let cenv = cenv.Create (g, tcEnv.NameEnv, exprParser, false,niceNameGen,amap,topCcu,true,false,conditionalDefines,tcSink, (LightweightTcValForUsingInBuildMethodCall g))
1671816767
let envinner,mtypeAcc = MakeInitialEnv tcEnv
1671916768

1672016769
let specs = [ for x in sigFileFrags -> SynModuleSigDecl.NamespaceFragment(x) ]

‎src/fsharp/TypeChecker.fsi‎

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -45,14 +45,16 @@ val CombineTopAttrs : TopAttribs -> TopAttribs -> TopAttribs
4545

4646
val TypeCheckOneImplFile :
4747
TcGlobals * NiceNameGenerator * ImportMap * CcuThunk * (unit -> bool) * ConditionalDefines * NameResolution.TcResultsSink
48-
-> TcEnv
48+
-> TcEnv
49+
-> (string -> SynExpr)
4950
-> Tast.ModuleOrNamespaceType option
5051
-> ParsedImplFileInput
5152
-> Eventually<TopAttribs * Tast.TypedImplFile * TcEnv>
5253

5354
val TypeCheckOneSigFile :
5455
TcGlobals * NiceNameGenerator * ImportMap * CcuThunk * (unit -> bool) * ConditionalDefines * NameResolution.TcResultsSink
55-
-> TcEnv
56+
-> TcEnv
57+
-> (string -> SynExpr)
5658
-> ParsedSigFileInput
5759
-> Eventually<TcEnv * TcEnv * ModuleOrNamespaceType >
5860

‎src/fsharp/pars.fsy‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -260,7 +260,7 @@ let rangeOfLongIdent(lid:LongIdent) =
260260
%token <Ast.LexerWhitespaceContinuation> COMMENT WHITESPACE HASH_LINE HASH_LIGHT INACTIVECODE LINE_COMMENT STRING_TEXT EOF
261261
%token <range * string * Ast.LexerWhitespaceContinuation> HASH_IF HASH_ELSE HASH_ENDIF
262262

263-
%start signatureFile implementationFile interaction typedSeqExprEOF typEOF
263+
%start signatureFile implementationFile interaction declExpr typedSeqExprEOF typEOF
264264
%type <Ast.SynExpr> typedSeqExprEOF
265265
%type <Ast.ParsedImplFile> implementationFile
266266
%type <Ast.ParsedSigFile> signatureFile

0 commit comments

Comments
 (0)