Skip to content

Commit d380ef0

Browse files
edgarfgpedgarfgp
committed
Update CheckComputationExpressions.fs
1 parent 720eec5 commit d380ef0

File tree

1 file changed

+147
-21
lines changed

1 file changed

+147
-21
lines changed

‎src/Compiler/Checking/Expressions/CheckComputationExpressions.fs‎

Lines changed: 147 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,7 @@
55
module internal FSharp.Compiler.CheckComputationExpressions
66

77
open FSharp.Compiler.TcGlobals
8+
open FSharp.Compiler.Xml
89
open Internal.Utilities.Library
910
open FSharp.Compiler.AccessibilityLogic
1011
open FSharp.Compiler.AttributeChecking
@@ -861,7 +862,7 @@ let (|ExprAsUseBang|_|) expr =
861862
body = innerComp
862863
trivia = { LetOrUseKeyword = mBind }) ->
863864
match bindings with
864-
| SynBinding(debugPoint = spBind; headPat = pat; expr = rhsExpr) :: _ ->
865+
| SynBinding(debugPoint = spBind; headPat = pat; expr = rhsExpr) :: bindings ->
865866
ValueSome(spBind, isFromSource, pat, rhsExpr, bindings, innerComp, mBind)
866867
| _ -> ValueNone
867868

@@ -875,11 +876,11 @@ let (|ExprAsLetBang|_|) expr =
875876
isFromSource = isFromSource
876877
isComputed = true
877878
bindings = bindings
878-
body = letRhsExpr
879+
body = innerComp
879880
trivia = { LetOrUseKeyword = mBind }) ->
880881
match bindings with
881-
| SynBinding(debugPoint = spBind; headPat = letPat; expr = rhsExpr) :: andBangBindings ->
882-
ValueSome(spBind, isFromSource, letPat, rhsExpr, andBangBindings, letRhsExpr, mBind)
882+
| SynBinding(debugPoint = spBind; headPat = pat; expr = rhsExpr) :: bindings ->
883+
ValueSome(spBind, isFromSource, pat, rhsExpr, bindings, innerComp, mBind)
883884
| _ -> ValueNone
884885
| _ -> ValueNone
885886

@@ -1357,22 +1358,22 @@ let rec TryTranslateComputationExpression
13571358
let mGuard = mGuard.MakeSynthetic()
13581359

13591360
// 'while!' is hit just before each time the guard is called
1360-
let _guardExpr =
1361+
let guardExpr =
13611362
match spWhile with
13621363
| DebugPointAtWhile.Yes _ -> SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes mWhile, false, guardExpr)
13631364
| DebugPointAtWhile.No -> guardExpr
13641365

13651366
let rewrittenWhileExpr =
13661367
let idFirst = mkSynId mGuard (CompilerGeneratedName "first")
1367-
let _patFirst = mkSynPatVar None idFirst
1368+
let patFirst = mkSynPatVar None idFirst
13681369

13691370
let body =
13701371
let idCond = mkSynId mGuard (CompilerGeneratedName "cond")
13711372
let patCond = mkSynPatVar None idCond
13721373

13731374
let condBinding =
13741375
mkSynBinding
1375-
(Xml.PreXmlDoc.Empty, patCond)
1376+
(PreXmlDoc.Empty, patCond)
13761377
(None,
13771378
false,
13781379
true,
@@ -1388,13 +1389,30 @@ let rec TryTranslateComputationExpression
13881389

13891390
let setCondExpr = SynExpr.Set(SynExpr.Ident idCond, SynExpr.Ident idFirst, mGuard)
13901391

1392+
let binding =
1393+
SynBinding(
1394+
accessibility = None,
1395+
kind = SynBindingKind.Normal,
1396+
isInline = false,
1397+
isMutable = false,
1398+
attributes = [],
1399+
xmlDoc = PreXmlDoc.Empty,
1400+
valData = SynInfo.emptySynValData,
1401+
headPat = patFirst,
1402+
returnInfo = None,
1403+
expr = guardExpr,
1404+
range = mGuard,
1405+
debugPoint = DebugPointAtBinding.NoneAtSticky,
1406+
trivia = SynBindingTrivia.Zero
1407+
)
1408+
13911409
let bindCondExpr =
13921410
SynExpr.LetOrUse(
13931411
false,
13941412
false,
1395-
false, // isFromSource is true for user-written code
1413+
true, // isFromSource is true for user-written code
13961414
true, // isComputed is true for bang let/let!
1397-
[],
1415+
[ binding ],
13981416
setCondExpr,
13991417
mGuard,
14001418
SynExprLetOrUseTrivia.Zero
@@ -1415,7 +1433,7 @@ let rec TryTranslateComputationExpression
14151433
mOrig
14161434
)
14171435

1418-
SynExpr.LetOrUse(false, false, false, true, [ condBinding ], whileExpr, mGuard, SynExprLetOrUseTrivia.Zero)
1436+
SynExpr.LetOrUse(false, false, true, true, [ condBinding ], whileExpr, mGuard, SynExprLetOrUseTrivia.Zero)
14191437

14201438
SynExpr.LetOrUse(
14211439
false,
@@ -1618,17 +1636,52 @@ let rec TryTranslateComputationExpression
16181636
// "do! expr; cexpr" is treated as { let! () = expr in cexpr }
16191637
match innerComp1 with
16201638
| SynExpr.DoBang(expr = rhsExpr; range = m) ->
1621-
let _sp =
1639+
let sp =
16221640
match sp with
16231641
| DebugPointAtSequential.SuppressExpr -> DebugPointAtBinding.NoneAtDo
16241642
| DebugPointAtSequential.SuppressBoth -> DebugPointAtBinding.NoneAtDo
16251643
| DebugPointAtSequential.SuppressStmt -> DebugPointAtBinding.Yes m
16261644
| DebugPointAtSequential.SuppressNeither -> DebugPointAtBinding.Yes m
16271645

1628-
let letOrUse =
1629-
SynExpr.LetOrUse(false, false, false, false, [], rhsExpr, m, SynExprLetOrUseTrivia.Zero)
1630-
1631-
Some(TranslateComputationExpression ceenv CompExprTranslationPass.Initial q varSpace letOrUse translatedCtxt)
1646+
Some(
1647+
TranslateComputationExpression
1648+
ceenv
1649+
CompExprTranslationPass.Initial
1650+
q
1651+
varSpace
1652+
(SynExpr.LetOrUse(
1653+
false,
1654+
false,
1655+
true,
1656+
true,
1657+
[
1658+
SynBinding(
1659+
accessibility = None,
1660+
kind = SynBindingKind.Normal,
1661+
isInline = false,
1662+
isMutable = false,
1663+
attributes = [],
1664+
xmlDoc = PreXmlDoc.Empty,
1665+
valData = SynInfo.emptySynValData,
1666+
headPat = SynPat.Const(SynConst.Unit, rhsExpr.Range),
1667+
returnInfo = None,
1668+
expr = rhsExpr,
1669+
range = m,
1670+
debugPoint = sp,
1671+
trivia =
1672+
{
1673+
LeadingKeyword = SynLeadingKeyword.Do m
1674+
InlineKeyword = None
1675+
EqualsRange = None
1676+
}
1677+
)
1678+
],
1679+
innerComp2,
1680+
m,
1681+
SynExprLetOrUseTrivia.Zero
1682+
))
1683+
translatedCtxt
1684+
)
16321685

16331686
// "expr; cexpr" is treated as sequential execution
16341687
| _ ->
@@ -2371,7 +2424,33 @@ and ConsumeCustomOpClauses
23712424
// Rebind using either for ... or let!....
23722425
let rebind =
23732426
if maintainsVarSpaceUsingBind then
2374-
SynExpr.LetOrUse(false, false, true, false, [], contExpr, intoPat.Range, SynExprLetOrUseTrivia.Zero)
2427+
SynExpr.LetOrUse(
2428+
false,
2429+
false,
2430+
true,
2431+
true,
2432+
[
2433+
SynBinding(
2434+
accessibility = None,
2435+
kind = SynBindingKind.Normal,
2436+
isInline = false,
2437+
isMutable = false,
2438+
attributes = [],
2439+
xmlDoc = PreXmlDoc.Empty,
2440+
valData = SynInfo.emptySynValData,
2441+
headPat = intoPat,
2442+
returnInfo = None,
2443+
expr = dataCompAfterOp,
2444+
range = intoPat.Range,
2445+
debugPoint = DebugPointAtBinding.NoneAtLet,
2446+
trivia = SynBindingTrivia.Zero
2447+
2448+
)
2449+
],
2450+
contExpr,
2451+
intoPat.Range,
2452+
SynExprLetOrUseTrivia.Zero
2453+
)
23752454
else
23762455
SynExpr.ForEach(
23772456
DebugPointAtFor.No,
@@ -2402,7 +2481,33 @@ and ConsumeCustomOpClauses
24022481
// Rebind using either for ... or let!....
24032482
let rebind =
24042483
if lastUsesBind then
2405-
SynExpr.LetOrUse(false, false, false, false, [], compClausesExpr, compClausesExpr.Range, SynExprLetOrUseTrivia.Zero)
2484+
SynExpr.LetOrUse(
2485+
false,
2486+
false,
2487+
true,
2488+
true,
2489+
[
2490+
SynBinding(
2491+
accessibility = None,
2492+
kind = SynBindingKind.Normal,
2493+
isInline = false,
2494+
isMutable = false,
2495+
attributes = [],
2496+
xmlDoc = PreXmlDoc.Empty,
2497+
valData = SynInfo.emptySynValData,
2498+
headPat = varSpacePat,
2499+
returnInfo = None,
2500+
expr = dataCompPrior,
2501+
range = varSpacePat.Range,
2502+
debugPoint = DebugPointAtBinding.NoneAtLet,
2503+
trivia = SynBindingTrivia.Zero
2504+
2505+
)
2506+
],
2507+
compClausesExpr,
2508+
compClausesExpr.Range,
2509+
SynExprLetOrUseTrivia.Zero
2510+
)
24062511
else
24072512
SynExpr.ForEach(
24082513
DebugPointAtFor.No,
@@ -2619,13 +2724,13 @@ and TranslateComputationExpression (ceenv: ComputationExpressionContext<'a>) fir
26192724
match comp with
26202725
// "do! expr;" in final position is treated as { let! () = expr in return () } when Return is provided (and no Zero with Default attribute is available) or as { let! () = expr in zero } otherwise
26212726
| SynExpr.DoBang(expr = rhsExpr; trivia = { DoBangKeyword = m }) ->
2622-
let _mUnit = rhsExpr.Range
2727+
let mUnit = rhsExpr.Range
26232728
let rhsExpr = mkSourceExpr rhsExpr ceenv.sourceMethInfo ceenv.builderValName
26242729

26252730
if ceenv.isQuery then
26262731
error (Error(FSComp.SR.tcBindMayNotBeUsedInQueries (), m))
26272732

2628-
let _bodyExpr =
2733+
let bodyExpr =
26292734
if
26302735
isNil (
26312736
TryFindIntrinsicOrExtensionMethInfo
@@ -2660,8 +2765,29 @@ and TranslateComputationExpression (ceenv: ComputationExpressionContext<'a>) fir
26602765
false,
26612766
true, // isFromSource is true for user-written code
26622767
true, // isComputed is true for bang let/let!
2663-
[],
2664-
rhsExpr,
2768+
[
2769+
SynBinding(
2770+
accessibility = None,
2771+
kind = SynBindingKind.Normal,
2772+
isInline = false,
2773+
isMutable = false,
2774+
attributes = [],
2775+
xmlDoc = PreXmlDoc.Empty,
2776+
valData = SynInfo.emptySynValData,
2777+
headPat = SynPat.Const(SynConst.Unit, mUnit),
2778+
returnInfo = None,
2779+
expr = rhsExpr,
2780+
range = m,
2781+
debugPoint = DebugPointAtBinding.NoneAtDo,
2782+
trivia =
2783+
{
2784+
LeadingKeyword = SynLeadingKeyword.Let m
2785+
InlineKeyword = None
2786+
EqualsRange = None
2787+
}
2788+
)
2789+
],
2790+
bodyExpr,
26652791
m,
26662792
SynExprLetOrUseTrivia.Zero
26672793
)

0 commit comments

Comments
 (0)