Movatterモバイル変換

[0]ホーム
URL:

Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly

 Sign up
Appearance settings

Commita2f791d

Browse files
make CurrentSink non-optional
1 parent9d5db9a commita2f791d

File tree

3 files changed

+90
-88
lines changed

3 files changed

+90
-88
lines changed

‎src/fsharp/NameResolution.fs‎

Lines changed: 52 additions & 51 deletions
Original file line numberDiff line numberDiff line change
@@ -1173,6 +1173,14 @@ type ITypecheckResultsSink =
11731173
abstractNotifyNameResolution :pos*Item*Item*ItemOccurence*Tastops.DisplayEnv*NameResolutionEnv*AccessorDomain*range*bool->unit
11741174
abstractNotifyFormatSpecifierLocation :range->unit
11751175
abstractCurrentSource :stringoption
1176+
1177+
letNoOpTypecheckResultSink=
1178+
{new ITypecheckResultsSinkwith
1179+
member__.NotifyEnvWithScope(_,_,_)=()
1180+
member__.NotifyExprHasType(_,_,_,_,_,_)=()
1181+
member__.NotifyNameResolution(_,_,_,_,_,_,_,_,_)=()
1182+
member__.NotifyFormatSpecifierLocation _=()
1183+
member__.CurrentSource= None}
11761184

11771185
let(|ValRefOfProp|_|)(pi:PropInfo)= pi.ArbitraryValRef
11781186
let(|ValRefOfMeth|_|)(mi:MethInfo)= mi.ArbitraryValRef
@@ -1442,46 +1450,40 @@ type TcResultsSinkImpl(g, ?source: string) =
14421450

14431451
/// An abstract type for reporting the results of name resolution and type checking, and which allows
14441452
/// temporary suspension and/or redirection of reporting.
1445-
typeTcResultsSink=
1446-
{mutable CurrentSink:ITypecheckResultsSink option}
1447-
static memberNoSink={ CurrentSink= None}
1448-
static memberWithSink sink={ CurrentSink= Some sink}
1453+
typeTcResultsSink=
1454+
{mutable CurrentSink:ITypecheckResultsSink}
1455+
1456+
moduleTcResultsSink=
1457+
letNoSink={ CurrentSink= NoOpTypecheckResultSink}
1458+
letWithSink sink={ CurrentSink= sink}
14491459

14501460
/// Temporarily redirect reporting of name resolution and type checking results
14511461
letWithNewTypecheckResultsSink(newSink:ITypecheckResultsSink,sink:TcResultsSink)=
14521462
letold= sink.CurrentSink
1453-
sink.CurrentSink<-SomenewSink
1463+
sink.CurrentSink<- newSink
14541464
{new System.IDisposablewithmemberx.Dispose()= sink.CurrentSink<- old}
14551465

14561466
/// Temporarily suspend reporting of name resolution and type checking results
14571467
letTemporarilySuspendReportingTypecheckResultsToSink(sink:TcResultsSink)=
14581468
letold= sink.CurrentSink
1459-
sink.CurrentSink<-None
1469+
sink.CurrentSink<-NoOpTypecheckResultSink
14601470
{new System.IDisposablewithmemberx.Dispose()= sink.CurrentSink<- old}
14611471

14621472

14631473
/// Report the active name resolution environment for a specific source range
14641474
letCallEnvSink(sink:TcResultsSink)(scopem,nenv,ad)=
1465-
match sink.CurrentSinkwith
1466-
| None->()
1467-
| Some sink-> sink.NotifyEnvWithScope(scopem,nenv,ad)
1475+
sink.CurrentSink.NotifyEnvWithScope(scopem,nenv,ad)
14681476

14691477
/// Report a specific name resolution at a source range
14701478
letCallNameResolutionSink(sink:TcResultsSink)(m:range,nenv,item,itemMethodGroup,occurenceType,denv,ad)=
1471-
match sink.CurrentSinkwith
1472-
| None->()
1473-
| Some sink-> sink.NotifyNameResolution(m.End,item,itemMethodGroup,occurenceType,denv,nenv,ad,m,false)
1479+
sink.CurrentSink.NotifyNameResolution(m.End,item,itemMethodGroup,occurenceType,denv,nenv,ad,m,false)
14741480

14751481
letCallNameResolutionSinkReplacing(sink:TcResultsSink)(m:range,nenv,item,itemMethodGroup,occurenceType,denv,ad)=
1476-
match sink.CurrentSinkwith
1477-
| None->()
1478-
| Some sink-> sink.NotifyNameResolution(m.End,item,itemMethodGroup,occurenceType,denv,nenv,ad,m,true)
1482+
sink.CurrentSink.NotifyNameResolution(m.End,item,itemMethodGroup,occurenceType,denv,nenv,ad,m,true)
14791483

14801484
/// Report a specific expression typing at a source range
14811485
letCallExprHasTypeSink(sink:TcResultsSink)(m:range,nenv,typ,denv,ad)=
1482-
match sink.CurrentSinkwith
1483-
| None->()
1484-
| Some sink-> sink.NotifyExprHasType(m.End,typ,denv,nenv,ad,m)
1486+
sink.CurrentSink.NotifyExprHasType(m.End,typ,denv,nenv,ad,m)
14851487

14861488
//-------------------------------------------------------------------------
14871489
// Check inferability of type parameters in resolved items.
@@ -3144,14 +3146,14 @@ let ResolveLongIdentAsExprAndComputeRange (sink:TcResultsSink) (ncenv:NameResolv
31443146
ifnot isFakeIdentsthen
31453147
CallNameResolutionSink sink(itemRange, nenv, refinedItem, item, ItemOccurence.Use, nenv.DisplayEnv, ad)
31463148
letafterOverloadResolution=
3147-
match sink.CurrentSinkwith
3148-
|None-> AfterOverloadResolution.DoNothing
3149-
| Some_->
3150-
if NeedsOverloadResolution itemthen
3151-
AfterOverloadResolution.SendToSink(callSink,(fun()-> callSink item)|> IfOverloadResolutionFails)
3152-
else
3153-
callSink item
3154-
AfterOverloadResolution.DoNothing
3149+
if sink.CurrentSink= NoOpTypecheckResultSinkthen
3150+
AfterOverloadResolution.DoNothing
3151+
else
3152+
if NeedsOverloadResolution itemthen
3153+
AfterOverloadResolution.SendToSink(callSink,(fun()-> callSink item)|> IfOverloadResolutionFails)
3154+
else
3155+
callSink item
3156+
AfterOverloadResolution.DoNothing
31553157
item, itemRange, rest, afterOverloadResolution
31563158

31573159
let(|NonOverridable|_|)namedItem=
@@ -3175,33 +3177,32 @@ let ResolveExprDotLongIdentAndComputeRange (sink:TcResultsSink) (ncenv:NameResol
31753177

31763178
// Record the precise resolution of the field for intellisense/goto definition
31773179
letafterOverloadResolution=
3178-
matchsink.CurrentSinkwith
3179-
|None-> AfterOverloadResolution.DoNothing// do not retypecheck if nobody listens
3180-
| Some_->
3181-
// resolution for goto definition
3182-
letunrefinedItem,itemRange,overrides=
3183-
match findFlag, itemwith
3184-
| FindMemberFlag.PreferOverrides,_
3185-
|_, NonOverridable()-> item,itemRange,false
3186-
| FindMemberFlag.IgnoreOverrides,_->
3187-
let_,item,_,itemRange= resolveExpr FindMemberFlag.PreferOverrides
3188-
item, itemRange,true
3189-
letsendToSink refinedItem=
3190-
letstaticOnly= thisIsActuallyATyAppNotAnExpr
3191-
letrefinedItem= FilterMethodGroups ncenv itemRange refinedItem staticOnly
3192-
letunrefinedItem= FilterMethodGroups ncenv itemRange unrefinedItem staticOnly
3193-
CallNameResolutionSink sink(itemRange, nenv, refinedItem, unrefinedItem, ItemOccurence.Use, nenv.DisplayEnv, ad)
3194-
match overrides,NeedsOverloadResolution unrefinedItemwith
3195-
|false,true->
3196-
AfterOverloadResolution.SendToSink(sendToSink, IfOverloadResolutionFails(fun()-> sendToSink unrefinedItem))
3197-
|true,true->
3198-
AfterOverloadResolution.ReplaceWithOverrideAndSendToSink(unrefinedItem,sendToSink, IfOverloadResolutionFails(fun()-> sendToSink unrefinedItem))
3199-
|_,false->
3200-
sendToSink unrefinedItem
3201-
AfterOverloadResolution.DoNothing
3180+
ifsink.CurrentSink= NoOpTypecheckResultSinkthen
3181+
AfterOverloadResolution.DoNothing// do not retypecheck if nobody listens
3182+
else
3183+
// resolution for goto definition
3184+
letunrefinedItem,itemRange,overrides=
3185+
match findFlag, itemwith
3186+
| FindMemberFlag.PreferOverrides,_
3187+
|_, NonOverridable()-> item,itemRange,false
3188+
| FindMemberFlag.IgnoreOverrides,_->
3189+
let_,item,_,itemRange= resolveExpr FindMemberFlag.PreferOverrides
3190+
item, itemRange,true
3191+
letsendToSink refinedItem=
3192+
letstaticOnly= thisIsActuallyATyAppNotAnExpr
3193+
letrefinedItem= FilterMethodGroups ncenv itemRange refinedItem staticOnly
3194+
letunrefinedItem= FilterMethodGroups ncenv itemRange unrefinedItem staticOnly
3195+
CallNameResolutionSink sink(itemRange, nenv, refinedItem, unrefinedItem, ItemOccurence.Use, nenv.DisplayEnv, ad)
3196+
match overrides,NeedsOverloadResolution unrefinedItemwith
3197+
|false,true->
3198+
AfterOverloadResolution.SendToSink(sendToSink, IfOverloadResolutionFails(fun()-> sendToSink unrefinedItem))
3199+
|true,true->
3200+
AfterOverloadResolution.ReplaceWithOverrideAndSendToSink(unrefinedItem,sendToSink, IfOverloadResolutionFails(fun()-> sendToSink unrefinedItem))
3201+
|_,false->
3202+
sendToSink unrefinedItem
3203+
AfterOverloadResolution.DoNothing
32023204
item, itemRange, rest, afterOverloadResolution
32033205

3204-
32053206
//-------------------------------------------------------------------------
32063207
// Given an nenv resolve partial paths to sets of names, used by interactive
32073208
// environments (Visual Studio)

‎src/fsharp/NameResolution.fsi‎

Lines changed: 7 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -285,9 +285,13 @@ type internal TcResultsSinkImpl =
285285
/// An abstract type for reporting the results of name resolution and type checking, and which allows
286286
/// temporary suspension and/or redirection of reporting.
287287
type TcResultsSink=
288-
{mutable CurrentSink:ITypecheckResultsSink option}
289-
static memberNoSink:TcResultsSink
290-
static memberWithSink:ITypecheckResultsSink->TcResultsSink
288+
{mutable CurrentSink:ITypecheckResultsSink}
289+
290+
moduleinternalTcResultsSink=
291+
valNoSink:TcResultsSink
292+
valWithSink:ITypecheckResultsSink->TcResultsSink
293+
294+
valinternalNoOpTypecheckResultSink:ITypecheckResultsSink
291295

292296
/// Temporarily redirect reporting of name resolution and type checking results
293297
valinternalWithNewTypecheckResultsSink:ITypecheckResultsSink* TcResultsSink-> System.IDisposable

‎src/fsharp/TypeChecker.fs‎

Lines changed: 31 additions & 34 deletions
Original file line numberDiff line numberDiff line change
@@ -1495,14 +1495,14 @@ let MakeAndPublishVal cenv env (altActualParent,inSig,declKind,vrec,(ValScheme(i
14951495
PublishValueDefn cenv env declKind vspec
14961496

14971497
begin
1498-
match cenv.tcSink.CurrentSinkwith
1499-
| None -> ()
1500-
| Some _ ->
1501-
if not vspec.IsCompilerGenerated && not (String.hasPrefix vspec.LogicalName "_") then
1502-
let nenv = AddFakeNamedValRefToNameEnv vspec.DisplayName env.NameEnv (mkLocalValRef vspec)
1503-
CallEnvSink cenv.tcSink (vspec.Range,nenv,env.eAccessRights)
1504-
let item = Item.Value(mkLocalValRef vspec)
1505-
CallNameResolutionSink cenv.tcSink (vspec.Range,nenv,item,item,ItemOccurence.Binding,env.DisplayEnv,env.eAccessRights)
1498+
if cenv.tcSink.CurrentSink<> NameResolution.NoOpTypecheckResultSink
1499+
&& not vspec.IsCompilerGenerated
1500+
&& not (String.hasPrefix vspec.LogicalName "_") then
1501+
1502+
let nenv = AddFakeNamedValRefToNameEnv vspec.DisplayName env.NameEnv (mkLocalValRef vspec)
1503+
CallEnvSink cenv.tcSink (vspec.Range,nenv,env.eAccessRights)
1504+
let item = Item.Value(mkLocalValRef vspec)
1505+
CallNameResolutionSink cenv.tcSink (vspec.Range,nenv,item,item,ItemOccurence.Binding,env.DisplayEnv,env.eAccessRights)
15061506
end
15071507

15081508
vspec
@@ -6641,34 +6641,31 @@ and TcObjectExpr cenv overallTy env tpenv (synObjTy,argopt,binds,extraImpls,mNew
66416641
and TcConstStringExpr cenv overallTy env m tpenv s =
66426642

66436643
if (AddCxTypeEqualsTypeUndoIfFailed env.DisplayEnv cenv.css m overallTy cenv.g.string_ty) then
6644-
mkString cenv.g m s,tpenv
6644+
mkString cenv.g m s,tpenv
66456645
else
6646-
let aty = NewInferenceType ()
6647-
let bty = NewInferenceType ()
6648-
let cty = NewInferenceType ()
6649-
let dty = NewInferenceType ()
6650-
let ety = NewInferenceType ()
6651-
let ty' = mkPrintfFormatTy cenv.g aty bty cty dty ety
6652-
if (not (isObjTy cenv.g overallTy) && AddCxTypeMustSubsumeTypeUndoIfFailed env.DisplayEnv cenv.css m overallTy ty') then
6653-
// Parse the format string to work out the phantom types
6654-
let source = match cenv.tcSink.CurrentSink with None -> None | Some sink -> sink.CurrentSource
6655-
let normalizedString = (s.Replace("\r\n", "\n").Replace("\r", "\n"))
6656-
6657-
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)))
6658-
6659-
match cenv.tcSink.CurrentSink with
6660-
| None -> ()
6661-
| Some sink ->
6646+
let aty = NewInferenceType ()
6647+
let bty = NewInferenceType ()
6648+
let cty = NewInferenceType ()
6649+
let dty = NewInferenceType ()
6650+
let ety = NewInferenceType ()
6651+
let ty' = mkPrintfFormatTy cenv.g aty bty cty dty ety
6652+
if (not (isObjTy cenv.g overallTy) && AddCxTypeMustSubsumeTypeUndoIfFailed env.DisplayEnv cenv.css m overallTy ty') then
6653+
// Parse the format string to work out the phantom types
6654+
let source = cenv.tcSink.CurrentSink.CurrentSource
6655+
let normalizedString = (s.Replace("\r\n", "\n").Replace("\r", "\n"))
6656+
6657+
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)))
6658+
66626659
for specifierLocation in specifierLocations do
6663-
sink.NotifyFormatSpecifierLocation specifierLocation
6664-
6665-
UnifyTypes cenv env m aty aty'
6666-
UnifyTypes cenv env m ety ety'
6667-
mkCallNewFormat cenv.g m aty bty cty dty ety (mkString cenv.g m s),tpenv
6668-
else
6669-
UnifyTypes cenv env m overallTy cenv.g.string_ty
6670-
mkString cenv.g m s,tpenv
6671-
6660+
cenv.tcSink.CurrentSink.NotifyFormatSpecifierLocation specifierLocation
6661+
6662+
UnifyTypes cenv env m aty aty'
6663+
UnifyTypes cenv env m ety ety'
6664+
mkCallNewFormat cenv.g m aty bty cty dty ety (mkString cenv.g m s),tpenv
6665+
else
6666+
UnifyTypes cenv env m overallTy cenv.g.string_ty
6667+
mkString cenv.g m s,tpenv
6668+
66726669
//-------------------------------------------------------------------------
66736670
// TcConstExpr
66746671
//-------------------------------------------------------------------------

0 commit comments

Comments
 (0)
[8]ページ先頭
©2009-2025 Movatter.jp