forked from dotnet/fsharp
-
Notifications
You must be signed in to change notification settings - Fork 0
/
CheckExpressions.fs
10946 lines (9128 loc) · 579 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
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.AbstractIL
open FSharp.Compiler.AccessibilityLogic
open FSharp.Compiler.AttributeChecking
open FSharp.Compiler.CompilerGlobalState
open FSharp.Compiler.ConstraintSolver
open FSharp.Compiler.ErrorLogger
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.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.TypeRelations
#if !NO_EXTENSIONTYPING
open FSharp.Compiler.ExtensionTyping
#endif
//-------------------------------------------------------------------------
// Helpers that should be elsewhere
//-------------------------------------------------------------------------
let mkNilListPat (g: TcGlobals) m ty = TPat_unioncase(g.nil_ucref, [ty], [], m)
let mkConsListPat (g: TcGlobals) ty ph pt = TPat_unioncase(g.cons_ucref, [ty], [ph;pt], unionRanges ph.Range pt.Range)
//-------------------------------------------------------------------------
// 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
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 option*) string option
/// Represents information about the initialization field used to check that object constructors
/// have completed before fields are accessed.
type SafeInitData =
| SafeInitField of RecdFieldRef * RecdField
| NoSafeInitInfo
/// Represents information about object constructors
type CtorInfo =
{ /// Object model constructors have a very specific form to satisfy .NET limitations.
/// For "new = \arg. { new C with ... }"
/// ctor = 3 indicates about to type check "\arg. (body)",
/// ctor = 2 indicates about to type check "body"
/// ctor = 1 indicates actually type checking the body expression
/// 0 indicates everywhere else, including auxiliary expressions such e1 in "let x = e1 in { new ... }"
/// REVIEW: clean up this rather odd approach ...
ctorShapeCounter: int
/// A handle to the ref cell to hold results of 'this' for 'type X() as x = ...' and 'new() as x = ...' constructs
/// in case 'x' is used in the arguments to the 'inherits' call.
safeThisValOpt: Val option
/// A handle to the boolean ref cell to hold success of initialized 'this' for 'type X() as x = ...' constructs
safeInitInfo: SafeInitData
/// Is the an implicit constructor or an explicit one?
ctorIsImplicit: bool
}
/// Represents an item in the environment that may restrict the automatic generalization of later
/// declarations because it refers to type inference variables. As type inference progresses
/// these type inference variables may get solved.
[<NoEquality; NoComparison; Sealed>]
type UngeneralizableItem(computeFreeTyvars: (unit -> FreeTyvars)) =
// Flag is for: have we determined that this item definitely has
// no free type inference variables? This implies that
// (a) it will _never_ have any free type inference variables as further constraints are added to the system.
// (b) its set of FreeTycons will not change as further constraints are added to the system
let mutable willNeverHaveFreeTypars = false
// If WillNeverHaveFreeTypars then we can cache the computation of FreeTycons, since they are invariant.
let mutable cachedFreeLocalTycons = emptyFreeTycons
// If WillNeverHaveFreeTypars then we can cache the computation of FreeTraitSolutions, since they are invariant.
let mutable cachedFreeTraitSolutions = emptyFreeLocals
member item.GetFreeTyvars() =
let fvs = computeFreeTyvars()
if fvs.FreeTypars.IsEmpty then
willNeverHaveFreeTypars <- true
cachedFreeLocalTycons <- fvs.FreeTycons
cachedFreeTraitSolutions <- fvs.FreeTraitSolutions
fvs
member item.WillNeverHaveFreeTypars = willNeverHaveFreeTypars
member item.CachedFreeLocalTycons = cachedFreeLocalTycons
member item.CachedFreeTraitSolutions = cachedFreeTraitSolutions
/// Represents the type environment at a particular scope. Includes the name
/// resolution environment, the ungeneralizable items from earlier in the scope
/// and other information about the scope.
[<NoEquality; NoComparison>]
type TcEnv =
{ /// Name resolution information
eNameResEnv: NameResolutionEnv
/// The list of items in the environment that may contain free inference
/// variables (which may not be generalized). The relevant types may
/// change as a result of inference equations being asserted, hence may need to
/// be recomputed.
eUngeneralizableItems: UngeneralizableItem list
// Two (!) versions of the current module path
// These are used to:
// - Look up the appropriate point in the corresponding signature
// see if an item is public or not
// - Change fslib canonical module type to allow compiler references to these items
// - Record the cpath for concrete modul_specs, tycon_specs and excon_specs so they can cache their generated IL representation where necessary
// - Record the pubpath of public, concrete {val, tycon, modul, excon}_specs.
// This information is used mainly when building non-local references
// to public items.
//
// Of the two, 'ePath' is the one that's barely used. It's only
// used by UpdateAccModuleOrNamespaceType to modify the CCU while compiling FSharp.Core
ePath: Ident list
eCompPath: CompilationPath
eAccessPath: CompilationPath
/// This field is computed from other fields, but we amortize the cost of computing it.
eAccessRights: AccessorDomain
/// Internals under these should be accessible
eInternalsVisibleCompPaths: CompilationPath list
/// Mutable accumulator for the current module type
eModuleOrNamespaceTypeAccumulator: ModuleOrNamespaceType ref
/// Context information for type checker
eContextInfo: ContextInfo
/// Here Some tcref indicates we can access protected members in all super types
eFamilyType: TyconRef option
// Information to enforce special restrictions on valid expressions
// for .NET constructors.
eCtorInfo: CtorInfo option
eCallerMemberName: string option
}
member tenv.DisplayEnv = tenv.eNameResEnv.DisplayEnv
member tenv.NameEnv = tenv.eNameResEnv
member tenv.AccessRights = tenv.eAccessRights
override tenv.ToString() = "TcEnv(...)"
/// 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 InitialExplicitCtorInfo (safeThisValOpt, safeInitInfo) =
{ ctorShapeCounter = 3
safeThisValOpt = safeThisValOpt
safeInitInfo = safeInitInfo
ctorIsImplicit = false}
let InitialImplicitCtorInfo () =
{ ctorShapeCounter = 0
safeThisValOpt = None
safeInitInfo = NoSafeInitInfo
ctorIsImplicit = true }
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 AreWithinImplicitCtor env = match env.eCtorInfo with None -> false | Some ctorInfo -> ctorInfo.ctorIsImplicit
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 vs nenv =
NameMap.foldBackRange (fun v nenv -> AddValRefToNameEnv nenv (mkLocalValRef v)) vs nenv
/// Add a list of values to the name resolution environment.
let AddValListToNameEnv vs nenv =
List.foldBack (fun v nenv -> AddValRefToNameEnv nenv (mkLocalValRef v)) vs nenv
/// Add a local value to TcEnv
let AddLocalValPrimitive (v: Val) env =
{ env with
eNameResEnv = AddValRefToNameEnv env.eNameResEnv (mkLocalValRef v)
eUngeneralizableItems = addFreeItemOfTy v.Type env.eUngeneralizableItems }
/// Add a table of local values to TcEnv
let AddLocalValMap tcSink scopem (vals: Val NameMap) env =
let env =
if vals.IsEmpty then
env
else
{ env with
eNameResEnv = AddValMapToNameEnv 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 tcSink scopem (vals: Val list) env =
let env =
if isNil vals then
env
else
{ env with
eNameResEnv = AddValListToNameEnv 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 tcSink scopem v env =
let env = { env with
eNameResEnv = AddValRefToNameEnv 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
let env = { env with eNameResEnv = AddDeclaredTyparsToNameEnv check env.eNameResEnv typars }
{ env with eUngeneralizableItems = List.foldBack (mkTyparTy >> addFreeItemOfTy) typars env.eUngeneralizableItems }
/// Environment of implicitly scoped type parameters, e.g. 'a in "(x: 'a)"
type UnscopedTyparEnv = UnscopedTyparEnv of NameMap<Typar>
let emptyUnscopedTyparEnv: UnscopedTyparEnv = UnscopedTyparEnv Map.empty
let AddUnscopedTypar n p (UnscopedTyparEnv tab) = UnscopedTyparEnv (Map.add n p tab)
let TryFindUnscopedTypar n (UnscopedTyparEnv tab) = Map.tryFind n tab
let HideUnscopedTypars typars (UnscopedTyparEnv tab) =
UnscopedTyparEnv (List.fold (fun acc (tp: Typar) -> Map.remove tp.Name acc) tab typars)
/// Represents the compilation environment for typechecking a single file in an assembly.
[<NoEquality; NoComparison>]
type TcFileState =
{ g: TcGlobals
/// Push an entry every time a recursive value binding is used,
/// in order to be able to fix up recursive type applications as
/// we infer type parameters
mutable recUses: ValMultiMap<(Expr ref * range * bool)>
/// Checks to run after all inference is complete.
mutable postInferenceChecks: ResizeArray<unit -> unit>
/// Set to true if this file causes the creation of generated provided types.
mutable createsGeneratedProvidedTypes: bool
/// Are we in a script? if so relax the reporting of discarded-expression warnings at the top level
isScript: bool
/// Environment needed to convert IL types to F# types in the importer.
amap: Import.ImportMap
/// Used to generate new syntactic argument names in post-parse syntactic processing
synArgNameGenerator: SynArgNameGenerator
tcSink: TcResultsSink
/// Holds a reference to the component being compiled.
/// This field is very rarely used (mainly when fixing up forward references to fslib.
topCcu: CcuThunk
/// Holds the current inference constraints
css: ConstraintSolverState
/// Are we compiling the signature of a module from fslib?
compilingCanonicalFslibModuleType: bool
/// Is this a .fsi file?
isSig: bool
/// Does this .fs file have a .fsi file?
haveSig: bool
/// Used to generate names
niceNameGen: NiceNameGenerator
/// Used to read and cache information about types and members
infoReader: InfoReader
/// Used to resolve names
nameResolver: NameResolver
/// The set of active conditional defines. The value is None when conditional erasure is disabled in tooling.
conditionalDefines: string list option
isInternalTestSpanStackReferring: bool
// forward call
TcSequenceExpressionEntry: TcFileState -> TcEnv -> TType -> UnscopedTyparEnv -> bool * bool ref * SynExpr -> range -> Expr * UnscopedTyparEnv
// forward call
TcArrayOrListSequenceExpression: TcFileState -> TcEnv -> TType -> UnscopedTyparEnv -> bool * SynExpr -> range -> Expr * UnscopedTyparEnv
// forward call
TcComputationExpression: TcFileState -> TcEnv -> TType -> UnscopedTyparEnv -> range * Expr * TType * SynExpr -> Expr * UnscopedTyparEnv
}
/// Create a new compilation environment
static member Create
(g, isScript, niceNameGen, amap, topCcu, isSig, haveSig, conditionalDefines, tcSink, tcVal, isInternalTestSpanStackReferring,
tcSequenceExpressionEntry, tcArrayOrListSequenceExpression, tcComputationExpression) =
let infoReader = new InfoReader(g, amap)
let instantiationGenerator m tpsorig = ConstraintSolver.FreshenTypars m tpsorig
let nameResolver = new NameResolver(g, amap, infoReader, instantiationGenerator)
{ g = g
amap = amap
recUses = ValMultiMap<_>.Empty
postInferenceChecks = ResizeArray()
createsGeneratedProvidedTypes = false
topCcu = topCcu
isScript = isScript
css = ConstraintSolverState.New(g, amap, infoReader, tcVal)
infoReader = infoReader
tcSink = tcSink
nameResolver = nameResolver
niceNameGen = niceNameGen
synArgNameGenerator = SynArgNameGenerator()
isSig = isSig
haveSig = haveSig
compilingCanonicalFslibModuleType = (isSig || not haveSig) && g.compilingFslib
conditionalDefines = conditionalDefines
isInternalTestSpanStackReferring = isInternalTestSpanStackReferring
TcSequenceExpressionEntry = tcSequenceExpressionEntry
TcArrayOrListSequenceExpression = tcArrayOrListSequenceExpression
TcComputationExpression = tcComputationExpression
}
override _.ToString() = "<cenv>"
type cenv = TcFileState
let CopyAndFixupTypars m rigid tpsorig =
ConstraintSolver.FreshenAndFixupTypars m rigid [] [] tpsorig
let UnifyTypes cenv (env: TcEnv) m actualTy expectedTy =
ConstraintSolver.AddCxTypeEqualsType env.eContextInfo env.DisplayEnv cenv.css m (tryNormalizeMeasureInType cenv.g actualTy) (tryNormalizeMeasureInType cenv.g expectedTy)
/// 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 mtypeAcc modKind =
let path = env.ePath @ [nm]
let cpath = env.eCompPath.NestedCompPath nm.idText modKind
{ env with
ePath = path
eCompPath = cpath
eAccessPath = cpath
eAccessRights = ComputeAccessRights cpath env.eInternalsVisibleCompPaths env.eFamilyType // update this computed field
eNameResEnv =
if addOpenToNameEnv then
{ env.NameEnv with eDisplayEnv = env.DisplayEnv.AddOpenPath (pathOfLid path) }
else
env.NameEnv
eModuleOrNamespaceTypeAccumulator = mtypeAcc }
/// Make an environment suitable for a module or namespace, creating a new accumulator.
let MakeInnerEnv addOpenToNameEnv env nm modKind =
// Note: here we allocate a new module type accumulator
let mtypeAcc = ref (Construct.NewEmptyModuleOrNamespaceType modKind)
MakeInnerEnvWithAcc addOpenToNameEnv env nm mtypeAcc modKind, mtypeAcc
/// 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)
/// Set the current accumulator for the namespace/module we're in, updating the inferred contents
let SetCurrAccumulatedModuleOrNamespaceType env x = env.eModuleOrNamespaceTypeAccumulator := x
/// Set up the initial environment accounting for the enclosing "namespace X.Y.Z" definition
let LocateEnv 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 env = List.fold (fun env id -> MakeInnerEnv false env id Namespace |> 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 (Range.equals m oldRange) then env else
{ env with eContextInfo = ContextInfo.CollectionElement(b,newRange) }
| ContextInfo.FollowingPatternMatchClause m ->
if not (Range.equals m oldRange) then env else
{ env with eContextInfo = ContextInfo.FollowingPatternMatchClause newRange }
| ContextInfo.PatternMatchGuard m ->
if not (Range.equals m oldRange) then env else
{ env with eContextInfo = ContextInfo.PatternMatchGuard newRange }
| ContextInfo.IfExpression m ->
if not (Range.equals m oldRange) then env else
{ env with eContextInfo = ContextInfo.IfExpression newRange }
| ContextInfo.OmittedElseBranch m ->
if not (Range.equals m oldRange) then env else
{ env with eContextInfo = ContextInfo.OmittedElseBranch newRange }
| ContextInfo.ElseBranchResult m ->
if not (Range.equals m oldRange) then env else
{ env with eContextInfo = ContextInfo.ElseBranchResult newRange }
/// Optimized unification routine that avoids creating new inference
/// variables unnecessarily
let UnifyRefTupleType contextInfo cenv denv m ty ps =
let ptys =
if isRefTupleTy cenv.g ty then
let ptys = destRefTupleTy cenv.g ty
if List.length ps = List.length ptys then ptys
else NewInferenceTypes ps
else NewInferenceTypes ps
let contextInfo =
match contextInfo with
| ContextInfo.RecordFields -> ContextInfo.TupleInRecordFields
| _ -> contextInfo
AddCxTypeEqualsType contextInfo denv cenv.css m ty (TType_tuple (tupInfoRef, ptys))
ptys
/// Allow the inference of structness from the known type, e.g.
/// let (x: struct (int * int)) = (3,4)
let UnifyTupleTypeAndInferCharacteristics contextInfo cenv denv m knownTy isExplicitStruct ps =
let tupInfo, ptys =
if isAnyTupleTy cenv.g knownTy then
let tupInfo, ptys = destAnyTupleTy cenv.g knownTy
let tupInfo = (if isExplicitStruct then tupInfoStruct else tupInfo)
let ptys =
if List.length ps = List.length ptys then ptys
else NewInferenceTypes ps
tupInfo, ptys
else
mkTupInfo isExplicitStruct, NewInferenceTypes 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 denv m ty isExplicitStruct unsortedNames =
let anonInfo, ptys =
match tryDestAnonRecdTy cenv.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 (Array.toList anonInfo.SortedNames)
anonInfo, ptys
| ValueNone ->
// Note: no known anonymous record type - use our assembly
let anonInfo = AnonRecdTypeInfo.Create(cenv.topCcu, mkTupInfo isExplicitStruct, unsortedNames)
anonInfo, NewInferenceTypes (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 denv m ty =
match tryDestFunTy cenv.g ty with
| ValueNone ->
let domainTy = NewInferenceType ()
let resultTy = NewInferenceType ()
if AddCxTypeEqualsTypeUndoIfFailed denv cenv.css m ty (domainTy --> resultTy) then
ValueSome(domainTy, resultTy)
else
ValueNone
| r -> r
/// Optimized unification routine that avoids creating new inference
/// variables unnecessarily
let UnifyFunctionType extraInfo 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 expr with
| Expr.App (Expr.Val (vf, _, _), _, _, exprs, _) when vf.LogicalName = opNameEquals ->
match exprs with
| Expr.App (Expr.Val (propRef, _, _), _, _, Expr.Val (vf, _, _) :: _, _) :: _ ->
if propRef.IsPropertyGetterMethod then
let propertyName = propRef.PropertyName
let hasCorrespondingSetter =
match propRef.DeclaringEntity with
| Parent entityRef ->
entityRef.MembersOfFSharpTyconSorted
|> List.exists (fun valRef -> valRef.IsPropertySetterMethod && valRef.PropertyName = propertyName)
| _ -> false
if hasCorrespondingSetter then
UnitTypeExpectedWithPossiblePropertySetter (denv, ty, vf.DisplayName, propertyName, m)
else
UnitTypeExpectedWithEquality (denv, ty, m)
else
UnitTypeExpectedWithEquality (denv, ty, m)
| Expr.Op (TOp.ILCall (_, _, _, _, _, _, _, ilMethRef, _, _, _), _, Expr.Val (vf, _, _) :: _, _) :: _ when ilMethRef.Name.StartsWithOrdinal("get_") ->
UnitTypeExpectedWithPossiblePropertySetter (denv, ty, vf.DisplayName, PrettyNaming.ChopPropertyName(ilMethRef.Name), m)
| Expr.Val (vf, _, _) :: _ ->
UnitTypeExpectedWithPossibleAssignment (denv, ty, vf.IsMutable, vf.DisplayName, m)
| _ -> UnitTypeExpectedWithEquality (denv, ty, m)
| _ -> UnitTypeExpected (denv, ty, m)
match expr with
| Expr.Let (_, Expr.Sequential (_, inner, _, _, _), _, _)
| Expr.Sequential (_, inner, _, _, _) ->
let rec extractNext expr =
match expr with
| Expr.Sequential (_, inner, _, _, _) -> extractNext inner
| _ -> checkExpr expr.Range expr
extractNext inner
| expr -> checkExpr m expr
let UnifyUnitType cenv (env: TcEnv) m ty expr =
let denv = env.DisplayEnv
if AddCxTypeEqualsTypeUndoIfFailed denv cenv.css m ty cenv.g.unit_ty then
true
else
let domainTy = NewInferenceType ()
let resultTy = NewInferenceType ()
if AddCxTypeEqualsTypeUndoIfFailed denv cenv.css m ty (domainTy --> resultTy) then
warning (FunctionValueUnexpected(denv, ty, m))
else
let reportImplicitlyDiscardError() =
if typeEquiv cenv.g cenv.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 lifted = mkSeqTy cenv.g ty
if typeEquiv cenv.g seqTy lifted then
warning (Error (FSComp.SR.implicitlyDiscardedInSequenceExpression(NicePrint.prettyStringOfTy denv ty), m))
else
if isListTy cenv.g ty || isArrayTy cenv.g ty || typeEquiv cenv.g seqTy ty then
warning (Error (FSComp.SR.implicitlyDiscardedSequenceInSequenceExpression(NicePrint.prettyStringOfTy denv ty), m))
else
reportImplicitlyDiscardError()
| _ ->
reportImplicitlyDiscardError()
false
let TryUnifyUnitTypeWithoutWarning cenv (env:TcEnv) m ty =
let denv = env.DisplayEnv
AddCxTypeEqualsTypeUndoIfFailedOrWarnings denv cenv.css m ty cenv.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 i -> intToRational i
| SynRationalConst.Negate c' -> NegRational (TcSynRationalConst c')
| SynRationalConst.Rational(p, q, _) -> DivRational (intToRational p) (intToRational q)
/// Typecheck constant terms in expressions and patterns
let TcConst cenv ty m env c =
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.Con tcref
| SynMeasure.Power(ms, exponent, _) -> Measure.RationalPower (tcMeasure ms, TcSynRationalConst exponent)
| SynMeasure.Product(ms1, ms2, _) -> Measure.Prod(tcMeasure ms1, tcMeasure ms2)
| SynMeasure.Divide(ms1, ((SynMeasure.Seq (_ :: (_ :: _), _)) as ms2), m) ->
warning(Error(FSComp.SR.tcImplicitMeasureFollowingSlash(), m))
Measure.Prod(tcMeasure ms1, Measure.Inv (tcMeasure ms2))
| SynMeasure.Divide(ms1, ms2, _) ->
Measure.Prod(tcMeasure ms1, 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))
let unif expected = UnifyTypes cenv env m ty expected
let unifyMeasureArg iszero tcr c =
let measureTy =
match c with
| SynConst.Measure(_, _, 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(_, _, ms) -> mkAppTy tcr [TType_measure (tcMeasure ms)]
| _ -> mkAppTy tcr [TType_measure Measure.One]
unif measureTy
let expandedMeasurablesEnabled =
cenv.g.langVersion.SupportsFeature LanguageFeature.ExpandedMeasurables
match c with
| SynConst.Unit -> unif cenv.g.unit_ty; Const.Unit
| SynConst.Bool i -> unif cenv.g.bool_ty; Const.Bool i
| SynConst.Single f -> unif cenv.g.float32_ty; Const.Single f
| SynConst.Double f -> unif cenv.g.float_ty; Const.Double f
| SynConst.Decimal f -> unif (mkAppTy cenv.g.decimal_tcr []); Const.Decimal f
| SynConst.SByte i -> unif cenv.g.sbyte_ty; Const.SByte i
| SynConst.Int16 i -> unif cenv.g.int16_ty; Const.Int16 i
| SynConst.Int32 i -> unif cenv.g.int_ty; Const.Int32 i
| SynConst.Int64 i -> unif cenv.g.int64_ty; Const.Int64 i
| SynConst.IntPtr i -> unif cenv.g.nativeint_ty; Const.IntPtr i
| SynConst.Byte i -> unif cenv.g.byte_ty; Const.Byte i
| SynConst.UInt16 i -> unif cenv.g.uint16_ty; Const.UInt16 i
| SynConst.UInt32 i -> unif cenv.g.uint32_ty; Const.UInt32 i
| SynConst.UInt64 i -> unif cenv.g.uint64_ty; Const.UInt64 i
| SynConst.UIntPtr i -> unif cenv.g.unativeint_ty; Const.UIntPtr i
| SynConst.Measure(SynConst.Single f, _, _) -> unifyMeasureArg (f=0.0f) cenv.g.pfloat32_tcr c; Const.Single f
| SynConst.Measure(SynConst.Double f, _, _) -> unifyMeasureArg (f=0.0) cenv.g.pfloat_tcr c; Const.Double f
| SynConst.Measure(SynConst.Decimal f, _, _) -> unifyMeasureArg false cenv.g.pdecimal_tcr c; Const.Decimal f
| SynConst.Measure(SynConst.SByte i, _, _) -> unifyMeasureArg (i=0y) cenv.g.pint8_tcr c; Const.SByte i
| SynConst.Measure(SynConst.Int16 i, _, _) -> unifyMeasureArg (i=0s) cenv.g.pint16_tcr c; Const.Int16 i
| SynConst.Measure(SynConst.Int32 i, _, _) -> unifyMeasureArg (i=0) cenv.g.pint_tcr c; Const.Int32 i
| SynConst.Measure(SynConst.Int64 i, _, _) -> unifyMeasureArg (i=0L) cenv.g.pint64_tcr c; Const.Int64 i
| SynConst.Measure(SynConst.IntPtr i, _, _) when expandedMeasurablesEnabled -> unifyMeasureArg (i=0L) cenv.g.pnativeint_tcr c; Const.IntPtr i
| SynConst.Measure(SynConst.Byte i, _, _) when expandedMeasurablesEnabled -> unifyMeasureArg (i=0uy) cenv.g.puint8_tcr c; Const.Byte i
| SynConst.Measure(SynConst.UInt16 i, _, _) when expandedMeasurablesEnabled -> unifyMeasureArg (i=0us) cenv.g.puint16_tcr c; Const.UInt16 i
| SynConst.Measure(SynConst.UInt32 i, _, _) when expandedMeasurablesEnabled -> unifyMeasureArg (i=0u) cenv.g.puint_tcr c; Const.UInt32 i
| SynConst.Measure(SynConst.UInt64 i, _, _) when expandedMeasurablesEnabled -> unifyMeasureArg (i=0UL) cenv.g.puint64_tcr c; Const.UInt64 i
| SynConst.Measure(SynConst.UIntPtr i, _, _) when expandedMeasurablesEnabled -> unifyMeasureArg (i=0UL) cenv.g.punativeint_tcr c; Const.UIntPtr i
| SynConst.Char c -> unif cenv.g.char_ty; Const.Char c
| SynConst.String (s, _, _)
| SynConst.SourceIdentifier (_, s, _) -> unif cenv.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 = PatternMatchCompilation.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) =
if argsData.Length = 1 && argsData.Head.Length = 1 && isFunTy g ty && typeEquiv g g.unit_ty (domainOfFunTy g ty) then
SynValInfo(argsData.Head.Tail :: argsData.Tail, retData)
else
sigMD
/// The ValReprInfo for a value, except the number of typars is not yet inferred
type PartialValReprInfo =
| PartialValReprInfo of
curriedArgInfos: ArgReprInfo list list *
returnInfo: ArgReprInfo
let TranslateTopArgSynInfo isArg m tcAttributes (SynArgInfo(Attributes attrs, isOpt, nm)) =
// Synthesize an artificial "OptionalArgument" attribute for the parameter
let optAttrs =
if isOpt then
[ ( { TypeName=LongIdentWithDots(pathToSynLid m ["Microsoft";"FSharp";"Core";"OptionalArgument"], [])
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)
({ Attribs = attribs; Name = nm } : ArgReprInfo)
/// 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 ("topValInfo").
/// "0" in a valSynData (see arity_of_pat) means a "unit" arg in a topValInfo
/// 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 TranslateTopValSynInfo m tcAttributes (SynValInfo(argsData, retData)) =
PartialValReprInfo (argsData |> List.mapSquared (TranslateTopArgSynInfo true m (tcAttributes AttributeTargets.Parameter)),
retData |> TranslateTopArgSynInfo false m (tcAttributes AttributeTargets.ReturnValue))
let TranslatePartialArity tps (PartialValReprInfo (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
type PreValMemberInfo =
| PreValMemberInfo of
memberInfo: ValMemberInfo *
logicalName: string *
compiledName: string
/// 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, optImplSlotTys, memberFlags, valSynData, id, isCompGen) =
let logicalName = ComputeLogicalName id memberFlags
let optIntfSlotTys = if optImplSlotTys |> List.forall (isInterfaceTy g) then optImplSlotTys else []
let memberInfo: ValMemberInfo =
{ ApparentEnclosingEntity=tcref
MemberFlags=memberFlags
IsImplemented=false
// NOTE: This value is initially only set for interface implementations and those overrides
// where we manage to pre-infer which abstract is overridden by the method. It is filled in
// properly when we check the allImplemented implementation checks at the end of the inference scope.
ImplementedSlotSigs=optImplSlotTys |> List.map (fun ity -> TSlotSig(logicalName, ity, [], [], [], None)) }
let isInstance = MemberIsCompiledAsInstance g tcref isExtrinsic memberInfo attrs
if (memberFlags.IsDispatchSlot || not (isNil optIntfSlotTys)) then
if not isInstance then
errorR(VirtualAugmentationOnNullValuedType(id.idRange))
elif not memberFlags.IsOverrideOrExplicitImpl && memberFlags.IsInstance then
if not isExtrinsic && not isInstance then
warning(NonVirtualAugmentationOnNullValuedType(id.idRange))
let compiledName =
if isExtrinsic then
let tname = tcref.LogicalName
let text = tname + "." + logicalName
let text = if memberFlags.MemberKind <> SynMemberKind.Constructor && memberFlags.MemberKind <> SynMemberKind.ClassConstructor && not memberFlags.IsInstance then text + ".Static" else text
let text = if memberFlags.IsOverrideOrExplicitImpl then text + ".Override" else text
text
else if not optIntfSlotTys.IsEmpty then
// interface implementation
if optIntfSlotTys.Length > 1 then
failwithf "unexpected: optIntfSlotTys.Length > 1 (== %i) in MakeMemberDataAndMangledNameForMemberVal for '%s'" optIntfSlotTys.Length logicalName
qualifiedInterfaceImplementationName g optIntfSlotTys.Head logicalName
else
List.foldBack (fun x -> qualifiedMangledNameOfTyconRef (tcrefOfAppTy g x)) optIntfSlotTys logicalName
if not isCompGen && IsMangledOpName id.idText && IsInfixOperator id.idText then
let m = id.idRange
let name = DecompileOpName id.idText
// Check symbolic members. Expect valSynData implied arity to be [[2]].
match SynInfo.AritiesOfArgs valSynData with
| [] | [0] -> warning(Error(FSComp.SR.memberOperatorDefinitionWithNoArguments name, m))
| n :: otherArgs ->
let opTakesThreeArgs = PrettyNaming.IsTernaryOperator name
if n<>2 && not opTakesThreeArgs then warning(Error(FSComp.SR.memberOperatorDefinitionWithNonPairArgument(name, n), m))
if n<>3 && opTakesThreeArgs then warning(Error(FSComp.SR.memberOperatorDefinitionWithNonTripleArgument(name, n), m))
if not (isNil otherArgs) then warning(Error(FSComp.SR.memberOperatorDefinitionWithCurriedArguments name, m))
if isExtrinsic && IsMangledOpName id.idText then
warning(Error(FSComp.SR.tcMemberOperatorDefinitionInExtrinsic(), id.idRange))
PreValMemberInfo(memberInfo, logicalName, compiledName)
type OverridesOK =
| OverridesOK
| WarnOnOverrides
| ErrorOnOverrides
/// A type to represent information associated with values to indicate what explicit (declared) type parameters
/// are given and what additional type parameters can be inferred, if any.
///
/// The declared type parameters, e.g. let f<'a> (x:'a) = x, plus an indication
/// of whether additional polymorphism may be inferred, e.g. let f<'a, ..> (x:'a) y = x
type ExplicitTyparInfo =
| ExplicitTyparInfo of
rigidCopyOfDeclaredTypars: Typars *
declaredTypars: Typars *
infer: bool
let permitInferTypars = ExplicitTyparInfo ([], [], true)
let dontInferTypars = ExplicitTyparInfo ([], [], false)
type ArgAndRetAttribs = ArgAndRetAttribs of Attribs list list * Attribs
let noArgOrRetAttribs = ArgAndRetAttribs ([], [])
/// 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 TcLetrec) 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 assembly
| IntrinsicExtensionBinding
/// Extensions to a type in a different assembly
| ExtrinsicExtensionBinding
| ClassLetBinding of isStatic: bool
| ObjectExpressionOverrideBinding
| ExpressionBinding
static member IsModuleOrMemberOrExtensionBinding x =