-
Notifications
You must be signed in to change notification settings - Fork 788
/
CheckExpressions.fs
12409 lines (10222 loc) · 627 KB
/
CheckExpressions.fs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information.
/// The typechecker. Left-to-right constrained type checking
/// with generalization at appropriate points.
module internal FSharp.Compiler.CheckExpressions
open System
open System.Collections.Generic
open Internal.Utilities.Collections
open Internal.Utilities.Library
open Internal.Utilities.Library.Extras
open Internal.Utilities.Library.ResultOrException
open Internal.Utilities.Rational
open FSharp.Compiler
open FSharp.Compiler.AbstractIL.IL
open FSharp.Compiler.AccessibilityLogic
open FSharp.Compiler.AttributeChecking
open FSharp.Compiler.CheckBasics
open FSharp.Compiler.CheckRecordSyntaxHelpers
open FSharp.Compiler.ConstraintSolver
open FSharp.Compiler.DiagnosticsLogger
open FSharp.Compiler.Features
open FSharp.Compiler.Infos
open FSharp.Compiler.InfoReader
open FSharp.Compiler.MethodCalls
open FSharp.Compiler.MethodOverrides
open FSharp.Compiler.NameResolution
open FSharp.Compiler.PatternMatchCompilation
open FSharp.Compiler.Syntax
open FSharp.Compiler.SyntaxTrivia
open FSharp.Compiler.Syntax.PrettyNaming
open FSharp.Compiler.SyntaxTreeOps
open FSharp.Compiler.TcGlobals
open FSharp.Compiler.Text
open FSharp.Compiler.Text.Position
open FSharp.Compiler.Text.Range
open FSharp.Compiler.Xml
open FSharp.Compiler.TypedTree
open FSharp.Compiler.TypedTreeBasics
open FSharp.Compiler.TypedTreeOps
open FSharp.Compiler.TypeHierarchy
open FSharp.Compiler.TypeRelations
#if !NO_TYPEPROVIDERS
open FSharp.Compiler.TypeProviders
#endif
//-------------------------------------------------------------------------
// Errors.
//-------------------------------------------------------------------------
exception BakedInMemberConstraintName of string * range
exception FunctionExpected of DisplayEnv * TType * range
exception NotAFunction of DisplayEnv * TType * range * range
exception NotAFunctionButIndexer of DisplayEnv * TType * string option * range * range * bool
exception Recursion of DisplayEnv * Ident * TType * TType * range
exception RecursiveUseCheckedAtRuntime of DisplayEnv * ValRef * range
exception LetRecEvaluatedOutOfOrder of DisplayEnv * ValRef * ValRef * range
exception LetRecCheckedAtRuntime of range
exception LetRecUnsound of DisplayEnv * ValRef list * range
exception TyconBadArgs of DisplayEnv * TyconRef * int * range
exception UnionCaseWrongArguments of DisplayEnv * int * int * range
exception UnionCaseWrongNumberOfArgs of DisplayEnv * int * int * range
exception FieldsFromDifferentTypes of DisplayEnv * RecdFieldRef * RecdFieldRef * range
exception FieldGivenTwice of DisplayEnv * RecdFieldRef * range
exception MissingFields of string list * range
exception FunctionValueUnexpected of DisplayEnv * TType * range
exception UnitTypeExpected of DisplayEnv * TType * range
exception UnitTypeExpectedWithEquality of DisplayEnv * TType * range
exception UnitTypeExpectedWithPossibleAssignment of DisplayEnv * TType * bool * string * range
exception UnitTypeExpectedWithPossiblePropertySetter of DisplayEnv * TType * string * string * range
exception UnionPatternsBindDifferentNames of range
exception VarBoundTwice of Ident
exception ValueRestriction of DisplayEnv * InfoReader * bool * Val * Typar * range
exception ValNotMutable of DisplayEnv * ValRef * range
exception ValNotLocal of DisplayEnv * ValRef * range
exception InvalidRuntimeCoercion of DisplayEnv * TType * TType * range
exception IndeterminateRuntimeCoercion of DisplayEnv * TType * TType * range
exception IndeterminateStaticCoercion of DisplayEnv * TType * TType * range
exception RuntimeCoercionSourceSealed of DisplayEnv * TType * range
exception CoercionTargetSealed of DisplayEnv * TType * range
exception UpcastUnnecessary of range
exception TypeTestUnnecessary of range
exception StaticCoercionShouldUseBox of DisplayEnv * TType * TType * range
exception SelfRefObjCtor of bool * range
exception VirtualAugmentationOnNullValuedType of range
exception NonVirtualAugmentationOnNullValuedType of range
exception UseOfAddressOfOperator of range
exception DeprecatedThreadStaticBindingWarning of range
exception IntfImplInIntrinsicAugmentation of range
exception IntfImplInExtrinsicAugmentation of range
exception OverrideInIntrinsicAugmentation of range
exception OverrideInExtrinsicAugmentation of range
exception NonUniqueInferredAbstractSlot of TcGlobals * DisplayEnv * string * MethInfo * MethInfo * range
exception StandardOperatorRedefinitionWarning of string * range
exception InvalidInternalsVisibleToAssemblyName of badName: string * fileName: string option
/// Compute the available access rights from a particular location in code
let ComputeAccessRights eAccessPath eInternalsVisibleCompPaths eFamilyType =
AccessibleFrom (eAccessPath :: eInternalsVisibleCompPaths, eFamilyType)
//-------------------------------------------------------------------------
// Helpers related to determining if we're in a constructor and/or a class
// that may be able to access "protected" members.
//-------------------------------------------------------------------------
let EnterFamilyRegion tcref env =
let eFamilyType = Some tcref
{ env with
eAccessRights = ComputeAccessRights env.eAccessPath env.eInternalsVisibleCompPaths eFamilyType // update this computed field
eFamilyType = eFamilyType }
let ExitFamilyRegion env =
let eFamilyType = None
match env.eFamilyType with
| None -> env // optimization to avoid reallocation
| _ ->
{ env with
eAccessRights = ComputeAccessRights env.eAccessPath env.eInternalsVisibleCompPaths eFamilyType // update this computed field
eFamilyType = eFamilyType }
let AreWithinCtorShape env = match env.eCtorInfo with None -> false | Some ctorInfo -> ctorInfo.ctorShapeCounter > 0
let GetCtorShapeCounter env = match env.eCtorInfo with None -> 0 | Some ctorInfo -> ctorInfo.ctorShapeCounter
let GetRecdInfo env = match env.eCtorInfo with None -> RecdExpr | Some ctorInfo -> if ctorInfo.ctorShapeCounter = 1 then RecdExprIsObjInit else RecdExpr
let AdjustCtorShapeCounter f env = {env with eCtorInfo = Option.map (fun ctorInfo -> { ctorInfo with ctorShapeCounter = f ctorInfo.ctorShapeCounter }) env.eCtorInfo }
let ExitCtorShapeRegion env = AdjustCtorShapeCounter (fun _ -> 0) env
/// Add a type to the TcEnv, i.e. register it as ungeneralizable.
let addFreeItemOfTy ty eUngeneralizableItems =
let fvs = freeInType CollectAllNoCaching ty
if isEmptyFreeTyvars fvs then eUngeneralizableItems
else UngeneralizableItem(fun () -> freeInType CollectAllNoCaching ty) :: eUngeneralizableItems
/// Add the contents of a module type to the TcEnv, i.e. register the contents as ungeneralizable.
/// Add a module type to the TcEnv, i.e. register it as ungeneralizable.
let addFreeItemOfModuleTy mtyp eUngeneralizableItems =
let fvs = freeInModuleTy mtyp
if isEmptyFreeTyvars fvs then eUngeneralizableItems
else UngeneralizableItem(fun () -> freeInModuleTy mtyp) :: eUngeneralizableItems
/// Add a table of values to the name resolution environment.
let AddValMapToNameEnv g vs nenv =
NameMap.foldBackRange (fun v nenv -> AddValRefToNameEnv g nenv (mkLocalValRef v)) vs nenv
/// Add a list of values to the name resolution environment.
let AddValListToNameEnv g vs nenv =
List.foldBack (fun v nenv -> AddValRefToNameEnv g nenv (mkLocalValRef v)) vs nenv
/// Add a local value to TcEnv
let AddLocalValPrimitive g (v: Val) env =
{ env with
eNameResEnv = AddValRefToNameEnv g env.eNameResEnv (mkLocalValRef v)
eUngeneralizableItems = addFreeItemOfTy v.Type env.eUngeneralizableItems }
/// Add a table of local values to TcEnv
let AddLocalValMap g tcSink scopem (vals: Val NameMap) env =
if vals.IsEmpty then
env
else
let env =
{ env with
eNameResEnv = AddValMapToNameEnv g vals env.eNameResEnv
eUngeneralizableItems = NameMap.foldBackRange (typeOfVal >> addFreeItemOfTy) vals env.eUngeneralizableItems }
CallEnvSink tcSink (scopem, env.NameEnv, env.AccessRights)
env
/// Add a list of local values to TcEnv and report them to the sink
let AddLocalVals g tcSink scopem (vals: Val list) env =
if isNil vals then
env
else
let env =
{ env with
eNameResEnv = AddValListToNameEnv g vals env.eNameResEnv
eUngeneralizableItems = List.foldBack (typeOfVal >> addFreeItemOfTy) vals env.eUngeneralizableItems }
CallEnvSink tcSink (scopem, env.NameEnv, env.AccessRights)
env
/// Add a local value to TcEnv and report it to the sink
let AddLocalVal g tcSink scopem v env =
let env = { env with
eNameResEnv = AddValRefToNameEnv g env.eNameResEnv (mkLocalValRef v)
eUngeneralizableItems = addFreeItemOfTy v.Type env.eUngeneralizableItems }
CallEnvSink tcSink (scopem, env.NameEnv, env.eAccessRights)
env
/// Add a set of explicitly declared type parameters as being available in the TcEnv
let AddDeclaredTypars check typars env =
if isNil typars then
env
else
{ env with
eUngeneralizableItems = List.foldBack (mkTyparTy >> addFreeItemOfTy) typars env.eUngeneralizableItems
eNameResEnv = AddDeclaredTyparsToNameEnv check env.eNameResEnv typars}
/// Environment of implicitly scoped type parameters, e.g. 'a in "(x: 'a)"
let emptyUnscopedTyparEnv: UnscopedTyparEnv = UnscopedTyparEnv Map.empty
let AddUnscopedTypar name typar (UnscopedTyparEnv tab) = UnscopedTyparEnv (Map.add name typar tab)
let TryFindUnscopedTypar name (UnscopedTyparEnv tab) = Map.tryFind name tab
let HideUnscopedTypars typars (UnscopedTyparEnv tab) =
UnscopedTyparEnv (List.fold (fun acc (tp: Typar) -> Map.remove tp.Name acc) tab typars)
type OverridesOK =
| OverridesOK
| WarnOnOverrides
| ErrorOnOverrides
let permitInferTypars = ExplicitTyparInfo ([], [], true)
let dontInferTypars = ExplicitTyparInfo ([], [], false)
let noArgOrRetAttribs = ArgAndRetAttribs ([], [])
[<RequireQualifiedAccess>]
type LiteralArgumentType =
/// Literal defined at call site
///
/// call "literal"
| Inline
/// F# literal value or IL constant
///
/// let [<Literal>] lit = "x"
/// call lit
| StaticField
/// A flag to represent the sort of bindings are we processing.
/// Processing "declaration" and "class" bindings that make up a module (such as "let x = 1 let y = 2")
/// shares the same code paths (e.g. TcLetBinding and TcLetrecBindings) as processing expression bindings (such as "let x = 1 in ...")
/// Member bindings also use this path.
//
// However there are differences in how different bindings get processed,
// i.e. module bindings get published to the implicitly accumulated module type, but expression 'let' bindings don't.
type DeclKind =
| ModuleOrMemberBinding
/// Extensions to a type within the same module or namespace fragment
| IntrinsicExtensionBinding
/// Extensions to a type not within the same module or namespace fragment
| ExtrinsicExtensionBinding
| ClassLetBinding of isStatic: bool
| ObjectExpressionOverrideBinding
| ExpressionBinding
member x.IsModuleOrMemberOrExtensionBinding =
match x with
| ModuleOrMemberBinding -> true
| IntrinsicExtensionBinding -> true
| ExtrinsicExtensionBinding -> true
| ClassLetBinding _ -> false
| ObjectExpressionOverrideBinding -> false
| ExpressionBinding -> false
member x.MustHaveValReprInfo = x.IsModuleOrMemberOrExtensionBinding
member x.CanBeDllImport =
match x with
| ModuleOrMemberBinding -> true
| IntrinsicExtensionBinding -> true
| ExtrinsicExtensionBinding -> true
| ClassLetBinding _ -> true
| ObjectExpressionOverrideBinding -> false
| ExpressionBinding -> false
member x.IsAccessModifierPermitted = x.IsModuleOrMemberOrExtensionBinding
member x.AllowedAttribTargets (memberFlagsOpt: SynMemberFlags option) =
match x with
| ModuleOrMemberBinding | ObjectExpressionOverrideBinding ->
match memberFlagsOpt with
| Some flags when flags.MemberKind = SynMemberKind.Constructor -> AttributeTargets.Constructor
| Some flags when flags.MemberKind = SynMemberKind.PropertyGetSet -> AttributeTargets.Event ||| AttributeTargets.Property
| Some flags when flags.MemberKind = SynMemberKind.PropertyGet -> AttributeTargets.Event ||| AttributeTargets.Property ||| AttributeTargets.ReturnValue
| Some flags when flags.MemberKind = SynMemberKind.PropertySet -> AttributeTargets.Property
| Some _ -> AttributeTargets.Method ||| AttributeTargets.ReturnValue
| None -> AttributeTargets.Field ||| AttributeTargets.Method ||| AttributeTargets.Property ||| AttributeTargets.ReturnValue
| IntrinsicExtensionBinding -> AttributeTargets.Method ||| AttributeTargets.Property ||| AttributeTargets.ReturnValue
| ExtrinsicExtensionBinding -> AttributeTargets.Method ||| AttributeTargets.Property ||| AttributeTargets.ReturnValue
| ClassLetBinding _ -> AttributeTargets.Field ||| AttributeTargets.Method ||| AttributeTargets.ReturnValue
| ExpressionBinding -> enum 0 // indicates attributes not allowed on expression 'let' bindings
// Note: now always true
member x.CanGeneralizeConstrainedTypars =
match x with
| ModuleOrMemberBinding -> true
| IntrinsicExtensionBinding -> true
| ExtrinsicExtensionBinding -> true
| ClassLetBinding _ -> true
| ObjectExpressionOverrideBinding -> true
| ExpressionBinding -> true
member x.IsConvertToLinearBindings =
match x with
| ModuleOrMemberBinding -> true
| IntrinsicExtensionBinding -> true
| ExtrinsicExtensionBinding -> true
| ClassLetBinding _ -> true
| ObjectExpressionOverrideBinding -> true
| ExpressionBinding -> false
member x.CanOverrideOrImplement =
match x with
| ModuleOrMemberBinding -> OverridesOK
| IntrinsicExtensionBinding -> WarnOnOverrides
| ExtrinsicExtensionBinding -> ErrorOnOverrides
| ClassLetBinding _ -> ErrorOnOverrides
| ObjectExpressionOverrideBinding -> OverridesOK
| ExpressionBinding -> ErrorOnOverrides
/// The results of applying let-style generalization after type checking.
// We should make this a record for cleaner code
type PrelimVal2 =
PrelimVal2 of
id: Ident *
prelimType: GeneralizedType *
prelimValReprInfo: PrelimValReprInfo option *
memberInfoOpt: PrelimMemberInfo option *
isMutable: bool *
inlineFlag: ValInline *
baseOrThisInfo: ValBaseOrThisInfo *
argAttribs: ArgAndRetAttribs *
visibility: SynAccess option *
isCompGen: bool *
hasDeclaredTypars: bool
/// The results of applying arity inference to PrelimVal2
type ValScheme =
| ValScheme of
id: Ident *
typeScheme: GeneralizedType *
valReprInfo: ValReprInfo option *
valReprInfoForDisplay: ValReprInfo option *
memberInfo: PrelimMemberInfo option *
isMutable: bool *
inlineInfo: ValInline *
baseOrThisInfo: ValBaseOrThisInfo *
visibility: SynAccess option *
isCompGen: bool *
isIncrClass: bool *
isTyFunc: bool *
hasDeclaredTypars: bool
member x.GeneralizedTypars = let (ValScheme(typeScheme=GeneralizedType(gtps, _))) = x in gtps
member x.GeneralizedType = let (ValScheme(typeScheme=ts)) = x in ts
member x.ValReprInfo = let (ValScheme(valReprInfo=valReprInfo)) = x in valReprInfo
/// The first phase of checking and elaborating a binding leaves a goop of information.
/// This is a bit of a mess: much of this information is also carried on a per-value basis by the
/// "NameMap<PrelimVal1>".
type CheckedBindingInfo =
| CheckedBindingInfo of
inlineFlag: ValInline *
valAttribs: Attribs *
xmlDoc: XmlDoc *
tcPatPhase2: (TcPatPhase2Input -> Pattern) *
exlicitTyparInfo: ExplicitTyparInfo *
nameToPrelimValSchemeMap: NameMap<PrelimVal1> *
rhsExprChecked: Expr *
argAndRetAttribs: ArgAndRetAttribs *
overallPatTy: TType *
mBinding: range *
debugPoint: DebugPointAtBinding *
isCompilerGenerated: bool *
literalValue: Const option *
isFixed: bool
member x.Expr = let (CheckedBindingInfo(rhsExprChecked=expr)) = x in expr
member x.DebugPoint = let (CheckedBindingInfo(debugPoint=debugPoint)) = x in debugPoint
type cenv = TcFileState
let CopyAndFixupTypars g m rigid tpsorig =
FreshenAndFixupTypars g m rigid [] [] tpsorig
let UnifyTypes (cenv: cenv) (env: TcEnv) m expectedTy actualTy =
let g = cenv.g
AddCxTypeEqualsType env.eContextInfo env.DisplayEnv cenv.css m (tryNormalizeMeasureInType g expectedTy) (tryNormalizeMeasureInType g actualTy)
// If the overall type admits subsumption or type directed conversion, and the original unify would have failed,
// then allow subsumption or type directed conversion.
//
// Any call to UnifyOverallType MUST have a matching call to TcAdjustExprForTypeDirectedConversions
// to actually build the expression for any conversion applied.
let UnifyOverallType (cenv: cenv) (env: TcEnv) m overallTy actualTy =
let g = cenv.g
match overallTy with
| MustConvertTo(isMethodArg, reqdTy) when g.langVersion.SupportsFeature LanguageFeature.AdditionalTypeDirectedConversions ->
let actualTy = tryNormalizeMeasureInType g actualTy
let reqdTy = tryNormalizeMeasureInType g reqdTy
if AddCxTypeEqualsTypeUndoIfFailed env.DisplayEnv cenv.css m reqdTy actualTy then
()
else
// try adhoc type-directed conversions
let reqdTy2, usesTDC, eqn = AdjustRequiredTypeForTypeDirectedConversions cenv.infoReader env.eAccessRights isMethodArg false reqdTy actualTy m
match eqn with
| Some (ty1, ty2, msg) ->
UnifyTypes cenv env m ty1 ty2
msg env.DisplayEnv
| None -> ()
match usesTDC with
| TypeDirectedConversionUsed.Yes(warn, _, _) -> warning(warn env.DisplayEnv)
| TypeDirectedConversionUsed.No -> ()
if AddCxTypeMustSubsumeTypeUndoIfFailed env.DisplayEnv cenv.css m reqdTy2 actualTy then
let reqdTyText, actualTyText, _cxs = NicePrint.minimalStringsOfTwoTypes env.DisplayEnv reqdTy actualTy
warning (Error(FSComp.SR.tcSubsumptionImplicitConversionUsed(actualTyText, reqdTyText), m))
else
// report the error
UnifyTypes cenv env m reqdTy actualTy
| _ ->
UnifyTypes cenv env m overallTy.Commit actualTy
let UnifyOverallTypeAndRecover (cenv: cenv) env m overallTy actualTy =
try
UnifyOverallType cenv env m overallTy actualTy
with RecoverableException exn ->
errorRecovery exn m
/// Make an environment suitable for a module or namespace. Does not create a new accumulator but uses one we already have/
let MakeInnerEnvWithAcc addOpenToNameEnv env nm moduleTyAcc moduleKind =
let path = env.ePath @ [nm]
let cpath = env.eCompPath.NestedCompPath nm.idText moduleKind
let nenv =
if addOpenToNameEnv then
{ env.NameEnv with eDisplayEnv = env.DisplayEnv.AddOpenPath (pathOfLid path) }
else
env.NameEnv
let ad = ComputeAccessRights cpath env.eInternalsVisibleCompPaths env.eFamilyType
{ env with
ePath = path
eCompPath = cpath
eAccessPath = cpath
eAccessRights = ad
eNameResEnv = nenv
eModuleOrNamespaceTypeAccumulator = moduleTyAcc }
/// Make an environment suitable for a module or namespace, creating a new accumulator.
let MakeInnerEnv addOpenToNameEnv env nm moduleKind =
// Note: here we allocate a new module type accumulator
let moduleTyAcc = ref (Construct.NewEmptyModuleOrNamespaceType moduleKind)
MakeInnerEnvWithAcc addOpenToNameEnv env nm moduleTyAcc moduleKind, moduleTyAcc
/// Make an environment suitable for processing inside a type definition
let MakeInnerEnvForTyconRef env tcref isExtrinsicExtension =
if isExtrinsicExtension then
// Extension members don't get access to protected stuff
env
else
// Regular members get access to protected stuff
let env = EnterFamilyRegion tcref env
// Note: assumes no nesting
let eAccessPath = env.eCompPath.NestedCompPath tcref.LogicalName ModuleOrType
{ env with
eAccessRights = ComputeAccessRights eAccessPath env.eInternalsVisibleCompPaths env.eFamilyType // update this computed field
eAccessPath = eAccessPath }
/// Make an environment suitable for processing inside a member definition
let MakeInnerEnvForMember env (v: Val) =
match v.MemberInfo with
| None -> env
| Some _ -> MakeInnerEnvForTyconRef env v.MemberApparentEntity v.IsExtensionMember
/// Get the current accumulator for the namespace/module we're in
let GetCurrAccumulatedModuleOrNamespaceType env =
env.eModuleOrNamespaceTypeAccumulator.Value
/// Set the current accumulator for the namespace/module we're in, updating the inferred contents
let SetCurrAccumulatedModuleOrNamespaceType env x =
env.eModuleOrNamespaceTypeAccumulator.Value <- x
/// Set up the initial environment accounting for the enclosing "namespace X.Y.Z" definition
let LocateEnv isModule ccu env enclosingNamespacePath =
let cpath = compPathOfCcu ccu
let env =
{env with
ePath = []
eCompPath = cpath
eAccessPath = cpath
// update this computed field
eAccessRights = ComputeAccessRights cpath env.eInternalsVisibleCompPaths env.eFamilyType }
let isExplicitNamespace = not isModule
let env = List.fold (fun env id -> MakeInnerEnv false env id (Namespace isExplicitNamespace) |> fst) env enclosingNamespacePath
let env = { env with eNameResEnv = { env.NameEnv with eDisplayEnv = env.DisplayEnv.AddOpenPath (pathOfLid env.ePath) } }
env
//-------------------------------------------------------------------------
// Helpers for unification
//-------------------------------------------------------------------------
/// When the context is matching the oldRange then this function shrinks it to newRange.
/// This can be used to change context over no-op expressions like parens.
let ShrinkContext env oldRange newRange =
match env.eContextInfo with
| ContextInfo.NoContext
| ContextInfo.RecordFields
| ContextInfo.TupleInRecordFields
| ContextInfo.ReturnInComputationExpression
| ContextInfo.YieldInComputationExpression
| ContextInfo.RuntimeTypeTest _
| ContextInfo.DowncastUsedInsteadOfUpcast _
| ContextInfo.SequenceExpression _ ->
env
| ContextInfo.CollectionElement (b,m) ->
if not (equals m oldRange) then env else
{ env with eContextInfo = ContextInfo.CollectionElement(b,newRange) }
| ContextInfo.FollowingPatternMatchClause m ->
if not (equals m oldRange) then env else
{ env with eContextInfo = ContextInfo.FollowingPatternMatchClause newRange }
| ContextInfo.PatternMatchGuard m ->
if not (equals m oldRange) then env else
{ env with eContextInfo = ContextInfo.PatternMatchGuard newRange }
| ContextInfo.IfExpression m ->
if not (equals m oldRange) then env else
{ env with eContextInfo = ContextInfo.IfExpression newRange }
| ContextInfo.OmittedElseBranch m ->
if not (equals m oldRange) then env else
{ env with eContextInfo = ContextInfo.OmittedElseBranch newRange }
| ContextInfo.ElseBranchResult m ->
if not (equals m oldRange) then env else
{ env with eContextInfo = ContextInfo.ElseBranchResult newRange }
/// Allow the inference of structness from the known type, e.g.
/// let (x: struct (int * int)) = (3,4)
let UnifyTupleTypeAndInferCharacteristics contextInfo (cenv: cenv) denv m knownTy isExplicitStruct ps =
let g = cenv.g
let tupInfo, ptys =
if isAnyTupleTy g knownTy then
let tupInfo, ptys = destAnyTupleTy g knownTy
let tupInfo = (if isExplicitStruct then tupInfoStruct else tupInfo)
let ptys =
if List.length ps = List.length ptys then ptys
else NewInferenceTypes g ps
tupInfo, ptys
else
mkTupInfo isExplicitStruct, NewInferenceTypes g ps
let contextInfo =
match contextInfo with
| ContextInfo.RecordFields -> ContextInfo.TupleInRecordFields
| _ -> contextInfo
let ty2 = TType_tuple (tupInfo, ptys)
AddCxTypeEqualsType contextInfo denv cenv.css m knownTy ty2
tupInfo, ptys
// Allow inference of assembly-affinity and structness from the known type - even from another assembly. This is a rule of
// the language design and allows effective cross-assembly use of anonymous types in some limited circumstances.
let UnifyAnonRecdTypeAndInferCharacteristics contextInfo (cenv: cenv) denv m ty isExplicitStruct unsortedNames =
let g = cenv.g
let anonInfo, ptys =
match tryDestAnonRecdTy g ty with
| ValueSome (anonInfo, ptys) ->
// Note: use the assembly of the known type, not the current assembly
// Note: use the structness of the known type, unless explicit
// Note: use the names of our type, since they are always explicit
let tupInfo = (if isExplicitStruct then tupInfoStruct else anonInfo.TupInfo)
let anonInfo = AnonRecdTypeInfo.Create(anonInfo.Assembly, tupInfo, unsortedNames)
let ptys =
if List.length ptys = Array.length unsortedNames then ptys
else NewInferenceTypes g (Array.toList anonInfo.SortedNames)
anonInfo, ptys
| ValueNone ->
// Note: no known anonymous record type - use our assembly
let anonInfo = AnonRecdTypeInfo.Create(cenv.thisCcu, mkTupInfo isExplicitStruct, unsortedNames)
anonInfo, NewInferenceTypes g (Array.toList anonInfo.SortedNames)
let ty2 = TType_anon (anonInfo, ptys)
AddCxTypeEqualsType contextInfo denv cenv.css m ty ty2
anonInfo, ptys
/// Optimized unification routine that avoids creating new inference
/// variables unnecessarily
let UnifyFunctionTypeUndoIfFailed (cenv: cenv) denv m ty =
let g = cenv.g
match tryDestFunTy g ty with
| ValueNone ->
let domainTy = NewInferenceType g
let resultTy = NewInferenceType g
if AddCxTypeEqualsTypeUndoIfFailed denv cenv.css m ty (mkFunTy g domainTy resultTy) then
ValueSome(domainTy, resultTy)
else
ValueNone
| r -> r
/// Optimized unification routine that avoids creating new inference
/// variables unnecessarily
let UnifyFunctionType extraInfo (cenv: cenv) denv mFunExpr ty =
match UnifyFunctionTypeUndoIfFailed cenv denv mFunExpr ty with
| ValueSome res -> res
| ValueNone ->
match extraInfo with
| Some argm -> error (NotAFunction(denv, ty, mFunExpr, argm))
| None -> error (FunctionExpected(denv, ty, mFunExpr))
let ReportImplicitlyIgnoredBoolExpression denv m ty expr =
let checkExpr m expr =
match stripDebugPoints expr with
| Expr.App (Expr.Val (vref, _, _), _, _, exprs, _) when vref.LogicalName = opNameEquals ->
match List.map stripDebugPoints exprs with
| Expr.App (Expr.Val (propRef, _, _), _, _, Expr.Val (vref, _, _) :: _, _) :: _ ->
if propRef.IsPropertyGetterMethod then
let propertyName = propRef.PropertyName
let hasCorrespondingSetter =
match propRef.TryDeclaringEntity with
| Parent entityRef ->
entityRef.MembersOfFSharpTyconSorted
|> List.exists (fun vref -> vref.IsPropertySetterMethod && vref.PropertyName = propertyName)
| _ -> false
if hasCorrespondingSetter then
UnitTypeExpectedWithPossiblePropertySetter (denv, ty, vref.DisplayName, propertyName, m)
else
UnitTypeExpectedWithEquality (denv, ty, m)
else
UnitTypeExpectedWithEquality (denv, ty, m)
| Expr.Op (TOp.ILCall (_, _, _, _, _, _, _, ilMethRef, _, _, _), _, Expr.Val (vref, _, _) :: _, _) :: _ when ilMethRef.Name.StartsWithOrdinal("get_") ->
UnitTypeExpectedWithPossiblePropertySetter (denv, ty, vref.DisplayName, ChopPropertyName(ilMethRef.Name), m)
| Expr.Val (vref, _, _) :: _ ->
UnitTypeExpectedWithPossibleAssignment (denv, ty, vref.IsMutable, vref.DisplayName, m)
| _ -> UnitTypeExpectedWithEquality (denv, ty, m)
| _ -> UnitTypeExpected (denv, ty, m)
match stripDebugPoints expr with
| Expr.Let (_, DebugPoints(Expr.Sequential (_, inner, _, _), _), _, _)
| Expr.Sequential (_, inner, _, _) ->
let rec extractNext expr =
match stripDebugPoints expr with
| Expr.Sequential (_, inner, _, _) -> extractNext inner
| _ -> checkExpr expr.Range expr
extractNext inner
| expr -> checkExpr m expr
let UnifyUnitType (cenv: cenv) (env: TcEnv) m ty expr =
let g = cenv.g
let denv = env.DisplayEnv
if AddCxTypeEqualsTypeUndoIfFailed denv cenv.css m ty g.unit_ty then
true
else
let domainTy = NewInferenceType g
let resultTy = NewInferenceType g
if AddCxTypeEqualsTypeUndoIfFailed denv cenv.css m ty (mkFunTy g domainTy resultTy) then
warning (FunctionValueUnexpected(denv, ty, m))
else
let reportImplicitlyDiscardError() =
if typeEquiv g g.bool_ty ty then
warning (ReportImplicitlyIgnoredBoolExpression denv m ty expr)
else
warning (UnitTypeExpected (denv, ty, m))
match env.eContextInfo with
| ContextInfo.SequenceExpression seqTy ->
let liftedTy = mkSeqTy g ty
if typeEquiv g seqTy liftedTy then
warning (Error (FSComp.SR.implicitlyDiscardedInSequenceExpression(NicePrint.prettyStringOfTy denv ty), m))
else
if isListTy g ty || isArrayTy g ty || typeEquiv g seqTy ty then
warning (Error (FSComp.SR.implicitlyDiscardedSequenceInSequenceExpression(NicePrint.prettyStringOfTy denv ty), m))
else
reportImplicitlyDiscardError()
| _ ->
reportImplicitlyDiscardError()
false
let TryUnifyUnitTypeWithoutWarning (cenv: cenv) (env:TcEnv) m ty =
let g = cenv.g
let denv = env.DisplayEnv
AddCxTypeEqualsTypeUndoIfFailedOrWarnings denv cenv.css m ty g.unit_ty
// Logically extends System.AttributeTargets
module AttributeTargets =
let FieldDecl = AttributeTargets.Field ||| AttributeTargets.Property
let FieldDeclRestricted = AttributeTargets.Field
let UnionCaseDecl = AttributeTargets.Method ||| AttributeTargets.Property
let TyconDecl = AttributeTargets.Class ||| AttributeTargets.Interface ||| AttributeTargets.Delegate ||| AttributeTargets.Struct ||| AttributeTargets.Enum
let ExnDecl = AttributeTargets.Class
let ModuleDecl = AttributeTargets.Class
let Top = AttributeTargets.Assembly ||| AttributeTargets.Module ||| AttributeTargets.Method
let ForNewConstructors tcSink (env: TcEnv) mObjTy methodName meths =
let origItem = Item.CtorGroup(methodName, meths)
let callSink (item, minst) = CallMethodGroupNameResolutionSink tcSink (mObjTy, env.NameEnv, item, origItem, minst, ItemOccurence.Use, env.AccessRights)
let sendToSink minst refinedMeths = callSink (Item.CtorGroup(methodName, refinedMeths), minst)
match meths with
| [] ->
AfterResolution.DoNothing
| [_] ->
sendToSink emptyTyparInst meths
AfterResolution.DoNothing
| _ ->
AfterResolution.RecordResolution (None, (fun tpinst -> callSink (origItem, tpinst)), (fun (minfo, _, minst) -> sendToSink minst [minfo]), (fun () -> callSink (origItem, emptyTyparInst)))
/// Typecheck rational constant terms in units-of-measure exponents
let rec TcSynRationalConst c =
match c with
| SynRationalConst.Integer(value = i) -> intToRational i
| SynRationalConst.Negate(rationalConst = c2) -> NegRational (TcSynRationalConst c2)
| SynRationalConst.Rational(numerator = p; denominator = q) -> DivRational (intToRational p) (intToRational q)
| SynRationalConst.Paren(rationalConst = c) -> TcSynRationalConst c
/// Typecheck constant terms in expressions and patterns
let TcConst (cenv: cenv) (overallTy: TType) m env synConst =
let g = cenv.g
let rec tcMeasure ms =
match ms with
| SynMeasure.One _ -> Measure.One
| SynMeasure.Named(tc, m) ->
let ad = env.eAccessRights
let _, tcref = ForceRaise(ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.Use OpenQualified env.eNameResEnv ad tc TypeNameResolutionStaticArgsInfo.DefiniteEmpty PermitDirectReferenceToGeneratedType.No)
match tcref.TypeOrMeasureKind with
| TyparKind.Type -> error(Error(FSComp.SR.tcExpectedUnitOfMeasureNotType(), m))
| TyparKind.Measure -> Measure.Const tcref
| SynMeasure.Power(measure = ms; power = exponent) -> Measure.RationalPower (tcMeasure ms, TcSynRationalConst exponent)
| SynMeasure.Product(measure1 = ms1; measure2 = ms2) -> Measure.Prod(tcMeasure ms1, tcMeasure ms2)
| SynMeasure.Divide(ms1, _, (SynMeasure.Seq (_ :: _ :: _, _) as ms2), m) ->
warning(Error(FSComp.SR.tcImplicitMeasureFollowingSlash(), m))
let factor1 = ms1 |> Option.defaultValue (SynMeasure.One Range.Zero)
Measure.Prod(tcMeasure factor1, Measure.Inv (tcMeasure ms2))
| SynMeasure.Divide(measure1 = ms1; measure2 = ms2) ->
let factor1 = ms1 |> Option.defaultValue (SynMeasure.One Range.Zero)
Measure.Prod(tcMeasure factor1, Measure.Inv (tcMeasure ms2))
| SynMeasure.Seq(mss, _) -> ProdMeasures (List.map tcMeasure mss)
| SynMeasure.Anon _ -> error(Error(FSComp.SR.tcUnexpectedMeasureAnon(), m))
| SynMeasure.Var(_, m) -> error(Error(FSComp.SR.tcNonZeroConstantCannotHaveGenericUnit(), m))
| SynMeasure.Paren(measure, _) -> tcMeasure measure
let unif expectedTy = UnifyTypes cenv env m overallTy expectedTy
let unifyMeasureArg iszero tcr =
let measureTy =
match synConst with
| SynConst.Measure(synMeasure = SynMeasure.Anon _) ->
(mkAppTy tcr [TType_measure (Measure.Var (NewAnonTypar (TyparKind.Measure, m, TyparRigidity.Anon, (if iszero then TyparStaticReq.None else TyparStaticReq.HeadType), TyparDynamicReq.No)))])
| SynConst.Measure(synMeasure = ms) -> mkAppTy tcr [TType_measure (tcMeasure ms)]
| _ -> mkAppTy tcr [TType_measure Measure.One]
unif measureTy
let expandedMeasurablesEnabled =
g.langVersion.SupportsFeature LanguageFeature.ExpandedMeasurables
match synConst with
| SynConst.Unit ->
unif g.unit_ty
Const.Unit
| SynConst.Bool i ->
unif g.bool_ty
Const.Bool i
| SynConst.Single f ->
unif g.float32_ty
Const.Single f
| SynConst.Double f ->
unif g.float_ty
Const.Double f
| SynConst.Decimal f ->
unif (mkAppTy g.decimal_tcr [])
Const.Decimal f
| SynConst.SByte i ->
unif g.sbyte_ty
Const.SByte i
| SynConst.Int16 i ->
unif g.int16_ty
Const.Int16 i
| SynConst.Int32 i ->
unif g.int_ty
Const.Int32 i
| SynConst.Int64 i ->
unif g.int64_ty
Const.Int64 i
| SynConst.IntPtr i ->
unif g.nativeint_ty
Const.IntPtr i
| SynConst.Byte i ->
unif g.byte_ty
Const.Byte i
| SynConst.UInt16 i ->
unif g.uint16_ty
Const.UInt16 i
| SynConst.UInt32 i ->
unif g.uint32_ty
Const.UInt32 i
| SynConst.UInt64 i ->
unif g.uint64_ty
Const.UInt64 i
| SynConst.UIntPtr i ->
unif g.unativeint_ty
Const.UIntPtr i
| SynConst.Measure(constant = SynConst.Single f) ->
unifyMeasureArg (f=0.0f) g.pfloat32_tcr
Const.Single f
| SynConst.Measure(constant = SynConst.Double f) ->
unifyMeasureArg (f=0.0) g.pfloat_tcr
Const.Double f
| SynConst.Measure(constant = SynConst.Decimal f) ->
unifyMeasureArg false g.pdecimal_tcr
Const.Decimal f
| SynConst.Measure(constant = SynConst.SByte i)->
unifyMeasureArg (i=0y) g.pint8_tcr
Const.SByte i
| SynConst.Measure(constant = SynConst.Int16 i) ->
unifyMeasureArg (i=0s) g.pint16_tcr
Const.Int16 i
| SynConst.Measure(constant = SynConst.Int32 i) ->
unifyMeasureArg (i=0) g.pint_tcr
Const.Int32 i
| SynConst.Measure(constant = SynConst.Int64 i) ->
unifyMeasureArg (i=0L) g.pint64_tcr
Const.Int64 i
| SynConst.Measure(constant = SynConst.IntPtr i) when expandedMeasurablesEnabled ->
unifyMeasureArg (i=0L) g.pnativeint_tcr
Const.IntPtr i
| SynConst.Measure(constant = SynConst.Byte i) when expandedMeasurablesEnabled ->
unifyMeasureArg (i=0uy) g.puint8_tcr
Const.Byte i
| SynConst.Measure(constant = SynConst.UInt16 i) when expandedMeasurablesEnabled ->
unifyMeasureArg (i=0us) g.puint16_tcr
Const.UInt16 i
| SynConst.Measure(constant = SynConst.UInt32 i) when expandedMeasurablesEnabled ->
unifyMeasureArg (i=0u) g.puint_tcr
Const.UInt32 i
| SynConst.Measure(constant = SynConst.UInt64 i) when expandedMeasurablesEnabled ->
unifyMeasureArg (i=0UL) g.puint64_tcr
Const.UInt64 i
| SynConst.Measure(constant = SynConst.UIntPtr i) when expandedMeasurablesEnabled ->
unifyMeasureArg (i=0UL) g.punativeint_tcr
Const.UIntPtr i
| SynConst.Char c ->
unif g.char_ty
Const.Char c
| SynConst.String (s, _, _)
| SynConst.SourceIdentifier (_, s, _) ->
unif g.string_ty
Const.String s
| SynConst.UserNum _ -> error (InternalError(FSComp.SR.tcUnexpectedBigRationalConstant(), m))
| SynConst.Measure _ -> error (Error(FSComp.SR.tcInvalidTypeForUnitsOfMeasure(), m))
| SynConst.UInt16s _ -> error (InternalError(FSComp.SR.tcUnexpectedConstUint16Array(), m))
| SynConst.Bytes _ -> error (InternalError(FSComp.SR.tcUnexpectedConstByteArray(), m))
/// Convert an Abstract IL ILFieldInit value read from .NET metadata to a TAST constant
let TcFieldInit (_m: range) lit = ilFieldToTastConst lit
//-------------------------------------------------------------------------
// Arities. These serve two roles in the system:
// 1. syntactic arities come from the syntactic forms found
// signature files and the syntactic forms of function and member definitions.
// 2. compiled arities representing representation choices w.r.t. internal representations of
// functions and members.
//-------------------------------------------------------------------------
// Adjust the arities that came from the parsing of the toptyp (arities) to be a valSynData.
// This means replacing the "[unitArg]" arising from a "unit -> ty" with a "[]".
let AdjustValSynInfoInSignature g ty (SynValInfo(argsData, retData) as sigMD) =
match argsData with
| [[_]] when isFunTy g ty && typeEquiv g g.unit_ty (domainOfFunTy g ty) ->
SynValInfo(argsData.Head.Tail :: argsData.Tail, retData)
| _ ->
sigMD
let TranslateTopArgSynInfo (cenv: cenv) isArg m tcAttributes (SynArgInfo(Attributes attrs, isOpt, nm)) =
// Synthesize an artificial "OptionalArgument" attribute for the parameter
let optAttrs =
if isOpt then
[ ( { TypeName=SynLongIdent(pathToSynLid m ["Microsoft";"FSharp";"Core";"OptionalArgument"], [], [None;None;None;None])
ArgExpr=mkSynUnit m
Target=None
AppliesToGetterAndSetter=false
Range=m} : SynAttribute) ]
else
[]
if isArg && not (isNil attrs) && Option.isNone nm then
errorR(Error(FSComp.SR.tcParameterRequiresName(), m))
if not isArg && Option.isSome nm then
errorR(Error(FSComp.SR.tcReturnValuesCannotHaveNames(), m))
// Call the attribute checking function
let attribs = tcAttributes (optAttrs@attrs)
let key = nm |> Option.map (fun id -> id.idText, id.idRange)
let argInfo =
key
|> Option.map cenv.argInfoCache.TryGetValue
|> Option.bind (fun (found, info) ->
if found then
Some info
else None)
|> Option.defaultValue ({ Attribs = attribs; Name = nm; OtherRange = None }: ArgReprInfo)
match key with
| Some k -> cenv.argInfoCache.[k] <- argInfo
| None -> ()
// Set freshly computed attribs in case they are different in the cache
argInfo.Attribs <- attribs
argInfo
/// Members have an arity inferred from their syntax. This "valSynData" is not quite the same as the arities
/// used in the middle and backends of the compiler ("valReprInfo").
/// "0" in a valSynData (see arity_of_pat) means a "unit" arg in a valReprInfo
/// Hence remove all "zeros" from arity and replace them with 1 here.
/// Note we currently use the compiled form for choosing unique names, to distinguish overloads because this must match up
/// between signature and implementation, and the signature just has "unit".
let TranslateSynValInfo (cenv: cenv) m tcAttributes (SynValInfo(argsData, retData)) =
PrelimValReprInfo (argsData |> List.mapSquared (TranslateTopArgSynInfo cenv true m (tcAttributes AttributeTargets.Parameter)),
retData |> TranslateTopArgSynInfo cenv false m (tcAttributes AttributeTargets.ReturnValue))
let TranslatePartialValReprInfo tps (PrelimValReprInfo (argsData, retData)) =
ValReprInfo(ValReprInfo.InferTyparInfo tps, argsData, retData)
//-------------------------------------------------------------------------
// Members
//-------------------------------------------------------------------------
let ComputeLogicalName (id: Ident) (memberFlags: SynMemberFlags) =
match memberFlags.MemberKind with
| SynMemberKind.ClassConstructor -> ".cctor"
| SynMemberKind.Constructor -> ".ctor"
| SynMemberKind.Member ->
match id.idText with
| ".ctor" | ".cctor" as r -> errorR(Error(FSComp.SR.tcInvalidMemberNameCtor(), id.idRange)); r
| r -> r
| SynMemberKind.PropertyGetSet -> error(InternalError(FSComp.SR.tcMemberKindPropertyGetSetNotExpected(), id.idRange))
| SynMemberKind.PropertyGet -> "get_" + id.idText
| SynMemberKind.PropertySet -> "set_" + id.idText
/// Make the unique "name" for a member.
//
// optImplSlotTy = None (for classes) or Some ty (when implementing interface type ty)
let MakeMemberDataAndMangledNameForMemberVal(g, tcref, isExtrinsic, attrs, implSlotTys, memberFlags, valSynData, id, isCompGen) =
let logicalName = ComputeLogicalName id memberFlags
let intfSlotTys = if implSlotTys |> List.forall (isInterfaceTy g) then implSlotTys else []
let memberInfo: ValMemberInfo =