-
Notifications
You must be signed in to change notification settings - Fork 2
/
ProvidedTypes-headd.fs
2001 lines (1741 loc) · 110 KB
/
ProvidedTypes-headd.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 2005-2012.
// This sample code is provided "as is" without warranty of any kind.
// We disclaim all warranties, either express or implied, including the
// warranties of merchantability and fitness for a particular purpose.
// This file contains a set of helper types and methods for providing types in an implementation
// of ITypeProvider.
//
// This code is a sample for use in conjunction with the F# 3.0 Beta release of March 2012
namespace Samples.FSharp.ProvidedTypes
open System
open System.Text
open System.IO
open System.Reflection
open System.Reflection.Emit
open System.Linq.Expressions
open System.Collections.Generic
open Microsoft.FSharp.Core.CompilerServices
type internal ExpectedStackState =
| Empty = 1
| Address = 2
| Value = 3
[<AutoOpen>]
module internal Misc =
let isEmpty s = s = ExpectedStackState.Empty
let isAddress s = s = ExpectedStackState.Address
let nonNull str x = if x=null then failwith ("Null in " + str) else x
let notRequired opname item =
let msg = sprintf "The operation '%s' on item '%s' should not be called on provided type, member or parameter" opname item
System.Diagnostics.Debug.Assert (false, msg)
raise (System.NotSupportedException msg)
let mkParamArrayCustomAttributeData() =
#if FX_NO_CUSTOMATTRIBUTEDATA
{ new IProvidedCustomAttributeData with
#else
{ new CustomAttributeData() with
#endif
member __.Constructor = typeof<ParamArrayAttribute>.GetConstructors().[0]
member __.ConstructorArguments = upcast [| |]
member __.NamedArguments = upcast [| |] }
#if FX_NO_CUSTOMATTRIBUTEDATA
let CustomAttributeTypedArgument(ty,v) =
{ new IProvidedCustomAttributeTypedArgument with
member x.ArgumentType = ty
member x.Value = v }
let CustomAttributeNamedArgument(memb,arg:IProvidedCustomAttributeTypedArgument) =
{ new IProvidedCustomAttributeNamedArgument with
member x.MemberInfo = memb
member x.ArgumentType = arg.ArgumentType
member x.TypedValue = arg }
type CustomAttributeData = Microsoft.FSharp.Core.CompilerServices.IProvidedCustomAttributeData
#endif
let mkEditorHideMethodsCustomAttributeData() =
#if FX_NO_CUSTOMATTRIBUTEDATA
{ new IProvidedCustomAttributeData with
#else
{ new CustomAttributeData() with
#endif
member __.Constructor = typeof<TypeProviderEditorHideMethodsAttribute>.GetConstructors().[0]
member __.ConstructorArguments = upcast [| |]
member __.NamedArguments = upcast [| |] }
/// This makes an xml doc attribute w.r.t. an amortized computation of an xml doc string.
/// It is important that the text of the xml doc only get forced when poking on the ConstructorArguments
/// for the CustomAttributeData object.
let mkXmlDocCustomAttributeDataLazy(lazyText: Lazy<string>) =
#if FX_NO_CUSTOMATTRIBUTEDATA
{ new IProvidedCustomAttributeData with
#else
{ new CustomAttributeData() with
#endif
member __.Constructor = typeof<TypeProviderXmlDocAttribute>.GetConstructors().[0]
member __.ConstructorArguments = upcast [| CustomAttributeTypedArgument(typeof<string>, lazyText.Force()) |]
member __.NamedArguments = upcast [| |] }
let mkXmlDocCustomAttributeData(s:string) = mkXmlDocCustomAttributeDataLazy (lazy s)
let mkDefinitionLocationAttributeCustomAttributeData(line:int,column:int,filePath:string) =
#if FX_NO_CUSTOMATTRIBUTEDATA
{ new IProvidedCustomAttributeData with
#else
{ new CustomAttributeData() with
#endif
member __.Constructor = typeof<TypeProviderDefinitionLocationAttribute>.GetConstructors().[0]
member __.ConstructorArguments = upcast [| |]
member __.NamedArguments =
upcast [| CustomAttributeNamedArgument(typeof<TypeProviderDefinitionLocationAttribute>.GetProperty("FilePath"), CustomAttributeTypedArgument(typeof<string>, filePath));
CustomAttributeNamedArgument(typeof<TypeProviderDefinitionLocationAttribute>.GetProperty("Line"), CustomAttributeTypedArgument(typeof<int>, line)) ;
CustomAttributeNamedArgument(typeof<TypeProviderDefinitionLocationAttribute>.GetProperty("Column"), CustomAttributeTypedArgument(typeof<int>, column))
|] }
let mkObsoleteAttributeCustomAttributeData(message:string) =
#if FX_NO_CUSTOMATTRIBUTEDATA
{ new IProvidedCustomAttributeData with
#else
{ new CustomAttributeData() with
#endif
member __.Constructor = typeof<System.ObsoleteAttribute>.GetConstructors() |> Array.find (fun x -> x.GetParameters().Length = 1)
member __.ConstructorArguments = upcast [|CustomAttributeTypedArgument(typeof<string>, message) |]
member __.NamedArguments = upcast [| |] }
type CustomAttributesImpl() =
let customAttributes = ResizeArray<CustomAttributeData>()
let mutable hideObjectMethods = false
let mutable obsoleteMessage = None
let mutable xmlDocDelayed = None
let mutable xmlDocAlwaysRecomputed = None
let mutable hasParamArray = false
// XML doc text that we only compute once, if any. This must _not_ be forced until the ConstructorArguments
// property of the custom attribute is foced.
let xmlDocDelayedText =
lazy
(match xmlDocDelayed with None -> assert false; "" | Some f -> f())
// Custom atttributes that we only compute once
let customAttributesOnce =
lazy
[| if hideObjectMethods then yield mkEditorHideMethodsCustomAttributeData()
match xmlDocDelayed with None -> () | Some _ -> customAttributes.Add(mkXmlDocCustomAttributeDataLazy xmlDocDelayedText)
match obsoleteMessage with None -> () | Some s -> customAttributes.Add(mkObsoleteAttributeCustomAttributeData s)
if hasParamArray then yield mkParamArrayCustomAttributeData()
yield! customAttributes |]
member __.AddDefinitionLocation(line:int,column:int,filePath:string) = customAttributes.Add(mkDefinitionLocationAttributeCustomAttributeData(line, column, filePath))
member __.AddObsolete(msg : string) = obsoleteMessage <- Some msg
member __.HasParamArray with get() = hasParamArray and set(v) = hasParamArray <- v
member __.AddXmlDocComputed(xmlDoc : unit -> string) = xmlDocAlwaysRecomputed <- Some xmlDoc
member __.AddXmlDocDelayed(xmlDoc : unit -> string) = xmlDocDelayed <- Some xmlDoc
member this.AddXmlDoc(text:string) = this.AddXmlDocDelayed (fun () -> text)
member __.HideObjectMethods with set v = hideObjectMethods <- v
member __.GetCustomAttributesData() =
[| yield! customAttributesOnce.Force()
match xmlDocAlwaysRecomputed with None -> () | Some f -> customAttributes.Add(mkXmlDocCustomAttributeData (f())) |]
:> IList<_>
let transExpr isGenerated q =
let rec trans q =
match q with
// convert NewTuple to the call to the constructor of the Tuple type (only for generated types)
| Quotations.Patterns.NewTuple(items) when isGenerated ->
let rec mkCtor args ty =
let ctor, restTyOpt = Reflection.FSharpValue.PreComputeTupleConstructorInfo ty
match restTyOpt with
| None -> Quotations.Expr.NewObject(ctor, List.map trans args)
| Some restTy ->
let curr = [for a in Seq.take 7 args -> trans a]
let rest = List.ofSeq (Seq.skip 7 args)
Quotations.Expr.NewObject(ctor, curr @ [mkCtor rest restTy])
let tys = [| for e in items -> e.Type |]
let tupleTy = Reflection.FSharpType.MakeTupleType tys
trans (mkCtor items tupleTy)
// convert TupleGet to the chain of PropertyGet calls (only for generated types)
| Quotations.Patterns.TupleGet(e, i) when isGenerated ->
let rec mkGet ty i (e : Quotations.Expr) =
let pi, restOpt = Reflection.FSharpValue.PreComputeTuplePropertyInfo(ty, i)
let propGet = Quotations.Expr.PropertyGet(e, pi)
match restOpt with
| None -> propGet
| Some (restTy, restI) -> mkGet restTy restI propGet
trans (mkGet e.Type i (trans e))
| Quotations.Patterns.Value(value, ty) ->
if value <> null then
let tyOfValue = value.GetType()
transValue(value, tyOfValue, ty)
else q
// Eliminate F# property gets to method calls
| Quotations.Patterns.PropertyGet(obj,propInfo,args) ->
match obj with
| None -> trans (Quotations.Expr.Call(propInfo.GetGetMethod(),args))
| Some o -> trans (Quotations.Expr.Call(trans o,propInfo.GetGetMethod(),args))
// Eliminate F# property sets to method calls
| Quotations.Patterns.PropertySet(obj,propInfo,args,v) ->
match obj with
| None -> trans (Quotations.Expr.Call(propInfo.GetSetMethod(),args@[v]))
| Some o -> trans (Quotations.Expr.Call(trans o,propInfo.GetSetMethod(),args@[v]))
// Eliminate F# function applications to FSharpFunc<_,_>.Invoke calls
| Quotations.Patterns.Application(f,e) ->
trans (Quotations.Expr.Call(trans f, f.Type.GetMethod "Invoke", [ e ]) )
| Quotations.Patterns.NewUnionCase(ci, es) ->
trans (Quotations.Expr.Call(Reflection.FSharpValue.PreComputeUnionConstructorInfo ci, es) )
| Quotations.Patterns.NewRecord(ci, es) ->
trans (Quotations.Expr.NewObject(Reflection.FSharpValue.PreComputeRecordConstructorInfo ci, es) )
| Quotations.Patterns.UnionCaseTest(e,uc) ->
let tagInfo = Reflection.FSharpValue.PreComputeUnionTagMemberInfo uc.DeclaringType
let tagExpr =
match tagInfo with
| :? PropertyInfo as tagProp ->
trans (Quotations.Expr.PropertyGet(e,tagProp) )
| :? MethodInfo as tagMeth ->
if tagMeth.IsStatic then trans (Quotations.Expr.Call(tagMeth, [e]))
else trans (Quotations.Expr.Call(e,tagMeth,[]))
| _ -> failwith "unreachable: unexpected result from PreComputeUnionTagMemberInfo"
let tagNumber = uc.Tag
trans <@@ (%%(tagExpr) : int) = tagNumber @@>
// Explicitly handle weird byref variables in lets (used to populate out parameters), since the generic handlers can't deal with byrefs
| Quotations.Patterns.Let(v,vexpr,bexpr) when v.Type.IsByRef ->
// the binding must have leaves that are themselves variables (due to the limited support for byrefs in expressions)
// therefore, we can perform inlining to translate this to a form that can be compiled
inlineByref v vexpr bexpr
// Handle the generic cases
| Quotations.ExprShape.ShapeLambda(v,body) ->
Quotations.Expr.Lambda(v, trans body)
| Quotations.ExprShape.ShapeCombination(comb,args) ->
Quotations.ExprShape.RebuildShapeCombination(comb,List.map trans args)
| Quotations.ExprShape.ShapeVar _ -> q
and inlineByref v vexpr bexpr =
match vexpr with
| Quotations.Patterns.Sequential(e',vexpr') ->
(* let v = (e'; vexpr') in bexpr => e'; let v = vexpr' in bexpr *)
Quotations.Expr.Sequential(e', inlineByref v vexpr' bexpr)
|> trans
| Quotations.Patterns.IfThenElse(c,b1,b2) ->
(* let v = if c then b1 else b2 in bexpr => if c then let v = b1 in bexpr else let v = b2 in bexpr *)
Quotations.Expr.IfThenElse(c, inlineByref v b1 bexpr, inlineByref v b2 bexpr)
|> trans
| Quotations.Patterns.Var _ ->
(* let v = v1 in bexpr => bexpr[v/v1] *)
bexpr.Substitute(fun v' -> if v = v' then Some vexpr else None)
|> trans
| _ ->
failwith (sprintf "Unexpected byref binding: %A = %A" v vexpr)
and transValue (v : obj, tyOfValue : Type, expectedTy : Type) =
let rec transArray (o : Array, ty : Type) =
let elemTy = ty.GetElementType()
let converter = getConverterForType elemTy
let elements =
[
for el in o do
yield converter el
]
Quotations.Expr.NewArray(elemTy, elements)
and transList(o, ty : Type, nil, cons) =
let converter = getConverterForType (ty.GetGenericArguments().[0])
o
|> Seq.cast
|> List.ofSeq
|> fun l -> List.foldBack(fun o s -> Quotations.Expr.NewUnionCase(cons, [ converter(o); s ])) l (Quotations.Expr.NewUnionCase(nil, []))
|> trans
and getConverterForType (ty : Type) =
if ty.IsArray then
fun (v : obj) -> transArray(v :?> Array, ty)
elif ty.IsGenericType && ty.GetGenericTypeDefinition() = typedefof<_ list> then
let nil, cons =
let cases = Reflection.FSharpType.GetUnionCases(ty)
let a = cases.[0]
let b = cases.[1]
if a.Name = "Empty" then a,b
else b,a
fun v -> transList (v :?> System.Collections.IEnumerable, ty, nil, cons)
else
fun v -> Quotations.Expr.Value(v, ty)
let converter = getConverterForType tyOfValue
let r = converter v
if tyOfValue <> expectedTy then Quotations.Expr.Coerce(r, expectedTy)
else r
trans q
let transQuotationToCode isGenerated qexprf (argExprs: Quotations.Expr[]) =
// add let bindings for arguments to ensure that arguments will be evaluated
let vars = argExprs |> Array.mapi (fun i e -> Quotations.Var(("var" + string i), e.Type))
let expr = qexprf ([for v in vars -> Quotations.Expr.Var v])
let pairs = Array.zip argExprs vars
let expr = Array.foldBack (fun (arg, var) e -> Quotations.Expr.Let(var, arg, e)) pairs expr
transExpr isGenerated expr
let adjustTypeAttributes attributes isNested =
let visibilityAttributes =
match attributes &&& TypeAttributes.VisibilityMask with
| TypeAttributes.Public when isNested -> TypeAttributes.NestedPublic
| TypeAttributes.NotPublic when isNested -> TypeAttributes.NestedAssembly
| TypeAttributes.NestedPublic when not isNested -> TypeAttributes.Public
| TypeAttributes.NestedAssembly
| TypeAttributes.NestedPrivate
| TypeAttributes.NestedFamORAssem
| TypeAttributes.NestedFamily
| TypeAttributes.NestedFamANDAssem when not isNested -> TypeAttributes.NotPublic
| a -> a
(attributes &&& ~~~TypeAttributes.VisibilityMask) ||| visibilityAttributes
type ProvidedStaticParameter(parameterName:string,parameterType:Type,?parameterDefaultValue:obj) =
inherit System.Reflection.ParameterInfo()
let customAttributesImpl = CustomAttributesImpl()
member __.AddXmlDocDelayed(xmlDoc : unit -> string) = customAttributesImpl.AddXmlDocDelayed xmlDoc
member __.AddXmlDocComputed(xmlDoc : unit -> string) = customAttributesImpl.AddXmlDocComputed xmlDoc
member this.AddXmlDoc(text:string) = customAttributesImpl.AddXmlDoc text
override __.RawDefaultValue = defaultArg parameterDefaultValue null
override __.Attributes = if parameterDefaultValue.IsNone then enum 0 else ParameterAttributes.Optional
override __.Position = 0
override __.ParameterType = parameterType
override __.Name = parameterName
override __.GetCustomAttributes(_inherit) = ignore(_inherit); notRequired "GetCustomAttributes" parameterName
override __.GetCustomAttributes(_attributeType, _inherit) = notRequired "GetCustomAttributes" parameterName
type ProvidedParameter(name:string,parameterType:Type,?isOut:bool,?optionalValue:obj) =
inherit System.Reflection.ParameterInfo()
let customAttributesImpl = CustomAttributesImpl()
let isOut = defaultArg isOut false
member this.IsParamArray with get() = customAttributesImpl.HasParamArray and set(v) = customAttributesImpl.HasParamArray <- v
override this.Name = name
override this.ParameterType = parameterType
override this.Attributes = (base.Attributes ||| (if isOut then ParameterAttributes.Out else enum 0)
||| (match optionalValue with None -> enum 0 | Some _ -> ParameterAttributes.Optional ||| ParameterAttributes.HasDefault))
override this.RawDefaultValue = defaultArg optionalValue null
member __.GetCustomAttributesDataImpl() = customAttributesImpl.GetCustomAttributesData()
#if FX_NO_CUSTOMATTRIBUTEDATA
#else
override __.GetCustomAttributesData() = customAttributesImpl.GetCustomAttributesData()
#endif
type ProvidedConstructor(parameters : ProvidedParameter list) =
inherit ConstructorInfo()
let parameters = parameters |> List.map (fun p -> p :> ParameterInfo)
let mutable baseCall = None
let mutable declaringType = null : System.Type
let mutable invokeCode = None : option<Quotations.Expr list -> Quotations.Expr>
let mutable isImplicitCtor = false
let nameText () = sprintf "constructor for %s" (if declaringType=null then "<not yet known type>" else declaringType.FullName)
let customAttributesImpl = CustomAttributesImpl()
member this.AddXmlDocComputed xmlDoc = customAttributesImpl.AddXmlDocComputed xmlDoc
member this.AddXmlDocDelayed xmlDoc = customAttributesImpl.AddXmlDocDelayed xmlDoc
member this.AddXmlDoc xmlDoc = customAttributesImpl.AddXmlDoc xmlDoc
member this.AddObsoleteAttribute msg = customAttributesImpl.AddObsolete msg
member this.AddDefinitionLocation(line,column,filePath) = customAttributesImpl.AddDefinitionLocation(line, column, filePath)
member this.HideObjectMethods with set v = customAttributesImpl.HideObjectMethods <- v
member __.GetCustomAttributesDataImpl() = customAttributesImpl.GetCustomAttributesData()
#if FX_NO_CUSTOMATTRIBUTEDATA
#else
override this.GetCustomAttributesData() = customAttributesImpl.GetCustomAttributesData()
#endif
member this.DeclaringTypeImpl
with set x =
if declaringType<>null then failwith (sprintf "ProvidedConstructor: declaringType already set on '%s'" (nameText()));
declaringType <- x
member this.InvokeCode
with set (q:Quotations.Expr list -> Quotations.Expr) =
match invokeCode with
| None -> invokeCode <- Some q
| Some _ -> failwith (sprintf "ProvidedConstructor: code already given for '%s'" (nameText()))
member this.BaseConstructorCall
with set (d:Quotations.Expr list -> (ConstructorInfo * Quotations.Expr list)) =
match baseCall with
| None -> baseCall <- Some d
| Some _ -> failwith (sprintf "ProvidedConstructor: base call already given for '%s'" (nameText()))
member this.GetInvokeCodeInternal isGenerated =
match invokeCode with
| Some f -> transQuotationToCode isGenerated f
| None -> failwith (sprintf "ProvidedConstructor: no invoker for '%s'" (nameText()))
member this.GetBaseConstructorCallInternal isGenerated =
match baseCall with
| Some f -> Some(fun ctorArgs -> let c,baseCtorArgExprs = f ctorArgs in c, List.map (transExpr isGenerated) baseCtorArgExprs)
| None -> None
member this.IsImplicitCtor with get() = isImplicitCtor and set v = isImplicitCtor <- v
// Implement overloads
override this.GetParameters() = parameters |> List.toArray
override this.Attributes = MethodAttributes.Public ||| MethodAttributes.RTSpecialName
override this.Name = if this.IsStatic then ".cctor" else ".ctor"
override this.DeclaringType = declaringType |> nonNull "ProvidedConstructor.DeclaringType"
override this.IsDefined(_attributeType, _inherit) = true
override this.Invoke(_invokeAttr, _binder, _parameters, _culture) = notRequired "Invoke" (nameText())
override this.Invoke(_obj, _invokeAttr, _binder, _parameters, _culture) = notRequired "Invoke" (nameText())
override this.ReflectedType = notRequired "ReflectedType" (nameText())
override this.GetMethodImplementationFlags() = notRequired "GetMethodImplementationFlags" (nameText())
override this.MethodHandle = notRequired "MethodHandle" (nameText())
override this.GetCustomAttributes(_inherit) = notRequired "GetCustomAttributes" (nameText())
override this.GetCustomAttributes(_attributeType, _inherit) = notRequired "GetCustomAttributes" (nameText())
type ProvidedMethod(methodName: string, parameters: ProvidedParameter list, returnType: Type) =
inherit System.Reflection.MethodInfo()
let argParams = parameters |> List.map (fun p -> p :> ParameterInfo)
// State
let mutable declaringType : Type = null
let mutable methodAttrs = MethodAttributes.Public
let mutable invokeCode = None : option<Quotations.Expr list -> Quotations.Expr>
let customAttributesImpl = CustomAttributesImpl()
member this.AddXmlDocComputed xmlDoc = customAttributesImpl.AddXmlDocComputed xmlDoc
member this.AddXmlDocDelayed xmlDoc = customAttributesImpl.AddXmlDocDelayed xmlDoc
member this.AddXmlDoc xmlDoc = customAttributesImpl.AddXmlDoc xmlDoc
member this.AddObsoleteAttribute msg = customAttributesImpl.AddObsolete msg
member this.AddDefinitionLocation(line,column,filePath) = customAttributesImpl.AddDefinitionLocation(line, column, filePath)
member __.GetCustomAttributesDataImpl() = customAttributesImpl.GetCustomAttributesData()
#if FX_NO_CUSTOMATTRIBUTEDATA
#else
override this.GetCustomAttributesData() = customAttributesImpl.GetCustomAttributesData()
#endif
member this.SetMethodAttrs m = methodAttrs <- m
member this.AddMethodAttrs m = methodAttrs <- methodAttrs ||| m
member this.DeclaringTypeImpl with set x = declaringType <- x // check: not set twice
member this.IsStaticMethod
with get() = methodAttrs.HasFlag(MethodAttributes.Static)
and set x = if x then methodAttrs <- methodAttrs ||| MethodAttributes.Static
else methodAttrs <- methodAttrs &&& (~~~ MethodAttributes.Static)
member this.InvokeCode
with set (q:Quotations.Expr list -> Quotations.Expr) =
match invokeCode with
| None -> invokeCode <- Some q
| Some _ -> failwith (sprintf "ProvidedConstructor: code already given for %s on type %s" this.Name (if declaringType=null then "<not yet known type>" else declaringType.FullName))
member this.GetInvokeCodeInternal isGenerated =
match invokeCode with
| Some f -> transQuotationToCode isGenerated f
| None -> failwith (sprintf "ProvidedMethod: no invoker for %s on type %s" this.Name (if declaringType=null then "<not yet known type>" else declaringType.FullName))
// Implement overloads
override this.GetParameters() = argParams |> Array.ofList
override this.Attributes = methodAttrs
override this.Name = methodName
override this.DeclaringType = declaringType |> nonNull "ProvidedMethod.DeclaringType"
override this.IsDefined(_attributeType, _inherit) : bool = true
override this.MemberType = MemberTypes.Method
override this.CallingConvention =
let cc = CallingConventions.Standard
let cc = if not (this.IsStatic) then cc ||| CallingConventions.HasThis else cc
cc
override this.ReturnType = returnType
override this.ReturnParameter = null // REVIEW: Give it a name and type?
override this.ToString() = "Method " + this.Name
// These don't have to return fully accurate results - they are used
// by the F# Quotations library function SpecificCall as a pre-optimization
// when comparing methods
override this.MetadataToken = hash declaringType + hash this.Name
override this.MethodHandle = RuntimeMethodHandle()
override this.ReturnTypeCustomAttributes = notRequired "ReturnTypeCustomAttributes" this.Name
override this.GetBaseDefinition() = notRequired "GetBaseDefinition" this.Name
override this.GetMethodImplementationFlags() = notRequired "GetMethodImplementationFlags" this.Name
override this.Invoke(_obj, _invokeAttr, _binder, _parameters, _culture) = notRequired "Invoke" this.Name
override this.ReflectedType = notRequired "ReflectedType" this.Name
override this.GetCustomAttributes(_inherit) = notRequired "GetCustomAttributes" this.Name
override this.GetCustomAttributes(_attributeType, _inherit) = notRequired "GetCustomAttributes" this.Name
type ProvidedProperty(propertyName:string,propertyType:Type, ?parameters:ProvidedParameter list) =
inherit System.Reflection.PropertyInfo()
// State
let parameters = defaultArg parameters []
let mutable declaringType = null
let mutable isStatic = false
let mutable getterCode = None : option<Quotations.Expr list -> Quotations.Expr>
let mutable setterCode = None : option<Quotations.Expr list -> Quotations.Expr>
let hasGetter() = getterCode.IsSome
let hasSetter() = setterCode.IsSome
// Delay construction - to pick up the latest isStatic
let markSpecialName (m:ProvidedMethod) = m.AddMethodAttrs(MethodAttributes.SpecialName); m
let getter = lazy (ProvidedMethod("get_" + propertyName,parameters,propertyType,IsStaticMethod=isStatic,DeclaringTypeImpl=declaringType,InvokeCode=getterCode.Value) |> markSpecialName)
let setter = lazy (ProvidedMethod("set_" + propertyName,parameters @ [ProvidedParameter("value",propertyType)],typeof<System.Void>,IsStaticMethod=isStatic,DeclaringTypeImpl=declaringType,InvokeCode=setterCode.Value) |> markSpecialName)
let customAttributesImpl = CustomAttributesImpl()
member this.AddXmlDocComputed xmlDoc = customAttributesImpl.AddXmlDocComputed xmlDoc
member this.AddXmlDocDelayed xmlDoc = customAttributesImpl.AddXmlDocDelayed xmlDoc
member this.AddXmlDoc xmlDoc = customAttributesImpl.AddXmlDoc xmlDoc
member this.AddObsoleteAttribute msg = customAttributesImpl.AddObsolete msg
member this.AddDefinitionLocation(line,column,filePath) = customAttributesImpl.AddDefinitionLocation(line, column, filePath)
member __.GetCustomAttributesDataImpl() = customAttributesImpl.GetCustomAttributesData()
#if FX_NO_CUSTOMATTRIBUTEDATA
#else
override this.GetCustomAttributesData() = customAttributesImpl.GetCustomAttributesData()
#endif
member this.DeclaringTypeImpl with set x = declaringType <- x // check: not set twice
member this.IsStatic
with get() = isStatic
and set x = isStatic <- x
member this.GetterCode
with set (q:Quotations.Expr list -> Quotations.Expr) =
if not getter.IsValueCreated then getterCode <- Some q else failwith "ProvidedProperty: getter MethodInfo has already been created"
member this.SetterCode
with set (q:Quotations.Expr list -> Quotations.Expr) =
if not (setter.IsValueCreated) then setterCode <- Some q else failwith "ProvidedProperty: setter MethodInfo has already been created"
// Implement overloads
override this.PropertyType = propertyType
override this.SetValue(_obj, _value, _invokeAttr, _binder, _index, _culture) = notRequired "SetValue" this.Name
override this.GetAccessors _nonPublic = notRequired "nonPublic" this.Name
override this.GetGetMethod _nonPublic = if hasGetter() then getter.Force() :> MethodInfo else null
override this.GetSetMethod _nonPublic = if hasSetter() then setter.Force() :> MethodInfo else null
override this.GetIndexParameters() = [| for p in parameters -> upcast p |]
override this.Attributes = PropertyAttributes.None
override this.CanRead = hasGetter()
override this.CanWrite = hasSetter()
override this.GetValue(_obj, _invokeAttr, _binder, _index, _culture) : obj = notRequired "GetValue" this.Name
override this.Name = propertyName
override this.DeclaringType = declaringType |> nonNull "ProvidedProperty.DeclaringType"
override this.MemberType : MemberTypes = MemberTypes.Property
override this.ReflectedType = notRequired "ReflectedType" this.Name
override this.GetCustomAttributes(_inherit) = notRequired "GetCustomAttributes" this.Name
override this.GetCustomAttributes(_attributeType, _inherit) = notRequired "GetCustomAttributes" this.Name
override this.IsDefined(_attributeType, _inherit) = notRequired "IsDefined" this.Name
type ProvidedEvent(eventName:string,eventHandlerType:Type) =
inherit System.Reflection.EventInfo()
// State
let mutable declaringType = null
let mutable isStatic = false
let mutable adderCode = None : option<Quotations.Expr list -> Quotations.Expr>
let mutable removerCode = None : option<Quotations.Expr list -> Quotations.Expr>
// Delay construction - to pick up the latest isStatic
let markSpecialName (m:ProvidedMethod) = m.AddMethodAttrs(MethodAttributes.SpecialName); m
let adder = lazy (ProvidedMethod("add_" + eventName, [ProvidedParameter("handler", eventHandlerType)],typeof<System.Void>,IsStaticMethod=isStatic,DeclaringTypeImpl=declaringType,InvokeCode=adderCode.Value) |> markSpecialName)
let remover = lazy (ProvidedMethod("remove_" + eventName, [ProvidedParameter("handler", eventHandlerType)],typeof<System.Void>,IsStaticMethod=isStatic,DeclaringTypeImpl=declaringType,InvokeCode=removerCode.Value) |> markSpecialName)
let customAttributesImpl = CustomAttributesImpl()
member this.AddXmlDocComputed xmlDoc = customAttributesImpl.AddXmlDocComputed xmlDoc
member this.AddXmlDocDelayed xmlDoc = customAttributesImpl.AddXmlDocDelayed xmlDoc
member this.AddXmlDoc xmlDoc = customAttributesImpl.AddXmlDoc xmlDoc
member this.AddDefinitionLocation(line,column,filePath) = customAttributesImpl.AddDefinitionLocation(line, column, filePath)
member __.GetCustomAttributesDataImpl() = customAttributesImpl.GetCustomAttributesData()
#if FX_NO_CUSTOMATTRIBUTEDATA
#else
override this.GetCustomAttributesData() = customAttributesImpl.GetCustomAttributesData()
#endif
member this.DeclaringTypeImpl with set x = declaringType <- x // check: not set twice
member this.IsStatic
with get() = isStatic
and set x = isStatic <- x
member this.AdderCode
with get() = adderCode.Value
and set f =
if not adder.IsValueCreated then adderCode <- Some f else failwith "ProvidedEvent: Add MethodInfo has already been created"
member this.RemoverCode
with get() = removerCode.Value
and set f =
if not (remover.IsValueCreated) then removerCode <- Some f else failwith "ProvidedEvent: Remove MethodInfo has already been created"
// Implement overloads
override this.EventHandlerType = eventHandlerType
override this.GetAddMethod _nonPublic = adder.Force() :> MethodInfo
override this.GetRemoveMethod _nonPublic = remover.Force() :> MethodInfo
override this.Attributes = EventAttributes.None
override this.Name = eventName
override this.DeclaringType = declaringType |> nonNull "ProvidedEvent.DeclaringType"
override this.MemberType : MemberTypes = MemberTypes.Event
override this.GetRaiseMethod _nonPublic = notRequired "GetRaiseMethod" this.Name
override this.ReflectedType = notRequired "ReflectedType" this.Name
override this.GetCustomAttributes(_inherit) = notRequired "GetCustomAttributes" this.Name
override this.GetCustomAttributes(_attributeType, _inherit) = notRequired "GetCustomAttributes" this.Name
override this.IsDefined(_attributeType, _inherit) = notRequired "IsDefined" this.Name
type ProvidedLiteralField(fieldName:string,fieldType:Type,literalValue:obj) =
inherit System.Reflection.FieldInfo()
// State
let mutable declaringType = null
let customAttributesImpl = CustomAttributesImpl()
member this.AddXmlDocComputed xmlDoc = customAttributesImpl.AddXmlDocComputed xmlDoc
member this.AddXmlDocDelayed xmlDoc = customAttributesImpl.AddXmlDocDelayed xmlDoc
member this.AddXmlDoc xmlDoc = customAttributesImpl.AddXmlDoc xmlDoc
member this.AddObsoleteAttribute msg = customAttributesImpl.AddObsolete msg
member this.AddDefinitionLocation(line,column,filePath) = customAttributesImpl.AddDefinitionLocation(line, column, filePath)
member __.GetCustomAttributesDataImpl() = customAttributesImpl.GetCustomAttributesData()
#if FX_NO_CUSTOMATTRIBUTEDATA
#else
override this.GetCustomAttributesData() = customAttributesImpl.GetCustomAttributesData()
#endif
member this.DeclaringTypeImpl with set x = declaringType <- x // check: not set twice
// Implement overloads
override this.FieldType = fieldType
override this.GetRawConstantValue() = literalValue
override this.Attributes = FieldAttributes.Static ||| FieldAttributes.Literal ||| FieldAttributes.Public
override this.Name = fieldName
override this.DeclaringType = declaringType |> nonNull "ProvidedLiteralField.DeclaringType"
override this.MemberType : MemberTypes = MemberTypes.Field
override this.ReflectedType = notRequired "ReflectedType" this.Name
override this.GetCustomAttributes(_inherit) = notRequired "GetCustomAttributes" this.Name
override this.GetCustomAttributes(_attributeType, _inherit) = notRequired "GetCustomAttributes" this.Name
override this.IsDefined(_attributeType, _inherit) = notRequired "IsDefined" this.Name
override this.SetValue(_obj, _value, _invokeAttr, _binder, _culture) = notRequired "SetValue" this.Name
override this.GetValue(_obj) : obj = notRequired "GetValue" this.Name
override this.FieldHandle = notRequired "FieldHandle" this.Name
type ProvidedField(fieldName:string,fieldType:Type) =
inherit System.Reflection.FieldInfo()
// State
let mutable declaringType = null
let customAttributesImpl = CustomAttributesImpl()
member this.AddXmlDocComputed xmlDoc = customAttributesImpl.AddXmlDocComputed xmlDoc
member this.AddXmlDocDelayed xmlDoc = customAttributesImpl.AddXmlDocDelayed xmlDoc
member this.AddXmlDoc xmlDoc = customAttributesImpl.AddXmlDoc xmlDoc
member this.AddObsoleteAttribute msg = customAttributesImpl.AddObsolete msg
member this.AddDefinitionLocation(line,column,filePath) = customAttributesImpl.AddDefinitionLocation(line, column, filePath)
member __.GetCustomAttributesDataImpl() = customAttributesImpl.GetCustomAttributesData()
#if FX_NO_CUSTOMATTRIBUTEDATA
#else
override this.GetCustomAttributesData() = customAttributesImpl.GetCustomAttributesData()
#endif
member this.DeclaringTypeImpl with set x = declaringType <- x // check: not set twice
// Implement overloads
override this.FieldType = fieldType
override this.GetRawConstantValue() = null
override this.Attributes = FieldAttributes.Private
override this.Name = fieldName
override this.DeclaringType = declaringType |> nonNull "ProvidedField.DeclaringType"
override this.MemberType : MemberTypes = MemberTypes.Field
override this.ReflectedType = notRequired "ReflectedType" this.Name
override this.GetCustomAttributes(_inherit) = notRequired "GetCustomAttributes" this.Name
override this.GetCustomAttributes(_attributeType, _inherit) = notRequired "GetCustomAttributes" this.Name
override this.IsDefined(_attributeType, _inherit) = notRequired "IsDefined" this.Name
override this.SetValue(_obj, _value, _invokeAttr, _binder, _culture) = notRequired "SetValue" this.Name
override this.GetValue(_obj) : obj = notRequired "GetValue" this.Name
override this.FieldHandle = notRequired "FieldHandle" this.Name
/// Represents the type constructor in a provided symbol type.
type SymbolKind =
| SDArray
| Array of int
| Pointer
| ByRef
| Generic of System.Type
| FSharpTypeAbbreviation of (System.Reflection.Assembly * string * string[])
/// Represents an array or other symbolic type involving a provided type as the argument.
/// See the type provider spec for the methods that must be implemented.
/// Note that the type provider specification does not require us to implement pointer-equality for provided types.
type ProvidedSymbolType(kind: SymbolKind, args: Type list) =
inherit Type()
static member convType (parameters: Type list) (ty:Type) =
if ty.IsGenericType then
let args = Array.map (ProvidedSymbolType.convType parameters) (ty.GetGenericArguments())
ProvidedSymbolType(Generic (ty.GetGenericTypeDefinition()), Array.toList args) :> Type
elif ty.HasElementType then
let ety = ProvidedSymbolType.convType parameters (ty.GetElementType())
if ty.IsArray then
let rank = ty.GetArrayRank()
if rank = 1 then ProvidedSymbolType(SDArray,[ety]) :> Type
else ProvidedSymbolType(Array rank,[ety]) :> Type
elif ty.IsPointer then ProvidedSymbolType(Pointer,[ety]) :> Type
elif ty.IsByRef then ProvidedSymbolType(ByRef,[ety]) :> Type
else ty
elif ty.IsGenericParameter then
if ty.GenericParameterPosition <= parameters.Length - 1 then
parameters.[ty.GenericParameterPosition]
else
ty
else ty
override this.FullName =
match kind,args with
| SymbolKind.SDArray,[arg] -> arg.FullName + "[]"
| SymbolKind.Array _,[arg] -> arg.FullName + "[*]"
| SymbolKind.Pointer,[arg] -> arg.FullName + "*"
| SymbolKind.ByRef,[arg] -> arg.FullName + "&"
| SymbolKind.Generic gty, args -> gty.FullName + "[" + (args |> List.map (fun arg -> arg.ToString()) |> String.concat ",") + "]"
| SymbolKind.FSharpTypeAbbreviation (_,nsp,path),args -> String.concat "." (Array.append [| nsp |] path) + args.ToString()
| _ -> failwith "unreachable"
/// Although not strictly required by the type provider specification, this is required when doing basic operations like FullName on
/// .NET symbolic types made from this type, e.g. when building Nullable<SomeProvidedType[]>.FullName
override this.DeclaringType =
match kind,args with
| SymbolKind.SDArray,[arg] -> arg
| SymbolKind.Array _,[arg] -> arg
| SymbolKind.Pointer,[arg] -> arg
| SymbolKind.ByRef,[arg] -> arg
| SymbolKind.Generic gty,_ -> gty
| SymbolKind.FSharpTypeAbbreviation _,_ -> null
| _ -> failwith "unreachable"
override this.Name =
match kind,args with
| SymbolKind.SDArray,[arg] -> arg.Name + "[]"
| SymbolKind.Array _,[arg] -> arg.Name + "[*]"
| SymbolKind.Pointer,[arg] -> arg.Name + "*"
| SymbolKind.ByRef,[arg] -> arg.Name + "&"
| SymbolKind.Generic gty, args -> gty.FullName + args.ToString()
| SymbolKind.FSharpTypeAbbreviation (_,_,path),_ -> path.[path.Length-1]
| _ -> failwith "unreachable"
override this.BaseType =
match kind with
| SymbolKind.SDArray -> typeof<System.Array>
| SymbolKind.Array _ -> typeof<System.Array>
| SymbolKind.Pointer -> typeof<System.ValueType>
| SymbolKind.ByRef -> typeof<System.ValueType>
| SymbolKind.Generic gty -> ProvidedSymbolType.convType args gty.BaseType
| SymbolKind.FSharpTypeAbbreviation _ -> typeof<obj>
override this.GetArrayRank() = (match kind with SymbolKind.Array n -> n | SymbolKind.SDArray -> 1 | _ -> invalidOp "non-array type")
override this.IsArrayImpl() = (match kind with SymbolKind.Array _ | SymbolKind.SDArray -> true | _ -> false)
override this.IsByRefImpl() = (match kind with SymbolKind.ByRef _ -> true | _ -> false)
override this.IsPointerImpl() = (match kind with SymbolKind.Pointer _ -> true | _ -> false)
override this.IsPrimitiveImpl() = false
override this.IsGenericType = (match kind with SymbolKind.Generic _ -> true | _ -> false)
override this.GetGenericArguments() = (match kind with SymbolKind.Generic _ -> args |> List.toArray | _ -> invalidOp "non-generic type")
override this.GetGenericTypeDefinition() = (match kind with SymbolKind.Generic e -> e | _ -> invalidOp "non-generic type")
override this.IsCOMObjectImpl() = false
override this.HasElementTypeImpl() = (match kind with SymbolKind.Generic _ -> false | _ -> true)
override this.GetElementType() = (match kind,args with (SymbolKind.Array _ | SymbolKind.SDArray | SymbolKind.ByRef | SymbolKind.Pointer),[e] -> e | _ -> invalidOp "not an array, pointer or byref type")
override this.ToString() = this.FullName
override this.Module : Module = notRequired "Module" this.Name
override this.Assembly =
match kind with
| SymbolKind.FSharpTypeAbbreviation (assembly,_nsp,_path) -> assembly
| SymbolKind.Generic gty -> gty.Assembly
| _ -> notRequired "Assembly" this.Name
override this.Namespace =
match kind with
| SymbolKind.FSharpTypeAbbreviation (_assembly,nsp,_path) -> nsp
| _ -> notRequired "Namespace" this.Name
override this.GetHashCode() =
match kind,args with
| SymbolKind.SDArray,[arg] -> 10 + hash arg
| SymbolKind.Array _,[arg] -> 163 + hash arg
| SymbolKind.Pointer,[arg] -> 283 + hash arg
| SymbolKind.ByRef,[arg] -> 43904 + hash arg
| SymbolKind.Generic gty,_ -> 9797 + hash gty + List.sumBy hash args
| SymbolKind.FSharpTypeAbbreviation _,_ -> 3092
| _ -> failwith "unreachable"
member this.Kind = kind
member this.Args = args
override this.Equals(that:obj) =
match that with
| :? ProvidedSymbolType as that -> (kind,args) = (that.Kind, that.Args)
| _ -> false
override this.GetConstructors _bindingAttr = notRequired "GetConstructors" this.Name
override this.GetMethodImpl(_name, _bindingAttr, _binderBinder, _callConvention, _types, _modifiers) = notRequired "GetMethodImpl" this.Name
override this.GetMembers _bindingAttr = notRequired "GetMembers" this.Name
override this.GetMethods _bindingAttr = notRequired "GetMethods" this.Name
override this.GetField(_name, _bindingAttr) = notRequired "GetField" this.Name
override this.GetFields _bindingAttr = notRequired "GetFields" this.Name
override this.GetInterface(_name, _ignoreCase) = notRequired "GetInterface" this.Name
override this.GetInterfaces() = notRequired "GetInterfaces" this.Name
override this.GetEvent(_name, _bindingAttr) = notRequired "GetEvent" this.Name
override this.GetEvents _bindingAttr = notRequired "GetEvents" this.Name
override this.GetProperties _bindingAttr = notRequired "GetProperties" this.Name
override this.GetPropertyImpl(_name, _bindingAttr, _binder, _returnType, _types, _modifiers) = notRequired "GetPropertyImpl" this.Name
override this.GetNestedTypes _bindingAttr = notRequired "GetNestedTypes" this.Name
override this.GetNestedType(_name, _bindingAttr) = notRequired "GetNestedType" this.Name
override this.GetAttributeFlagsImpl() = notRequired "GetAttributeFlagsImpl" this.Name
override this.UnderlyingSystemType =
match kind with
| SymbolKind.SDArray
| SymbolKind.Array _
| SymbolKind.Pointer
| SymbolKind.FSharpTypeAbbreviation _
| SymbolKind.ByRef -> notRequired "UnderlyingSystemType" this.Name
| SymbolKind.Generic gty -> gty.UnderlyingSystemType
#if FX_NO_CUSTOMATTRIBUTEDATA
#else
override this.GetCustomAttributesData() = ([| |] :> IList<_>)
#endif
override this.MemberType = notRequired "MemberType" this.Name
override this.GetMember(_name,_mt,_bindingAttr) = notRequired "GetMember" this.Name
override this.GUID = notRequired "GUID" this.Name
override this.InvokeMember(_name, _invokeAttr, _binder, _target, _args, _modifiers, _culture, _namedParameters) = notRequired "InvokeMember" this.Name
override this.AssemblyQualifiedName = notRequired "AssemblyQualifiedName" this.Name
override this.GetConstructorImpl(_bindingAttr, _binder, _callConvention, _types, _modifiers) = notRequired "GetConstructorImpl" this.Name
override this.GetCustomAttributes(_inherit) = [| |]
override this.GetCustomAttributes(_attributeType, _inherit) = [| |]
override this.IsDefined(_attributeType, _inherit) = false
type ProvidedSymbolMethod(genericMethodDefinition: MethodInfo, parameters: Type list) =
inherit System.Reflection.MethodInfo()
let convParam (p:ParameterInfo) =
{ new System.Reflection.ParameterInfo() with
override this.Name = p.Name
override this.ParameterType = ProvidedSymbolType.convType parameters p.ParameterType
override this.Attributes = p.Attributes
override this.RawDefaultValue = p.RawDefaultValue
#if FX_NO_CUSTOMATTRIBUTEDATA
#else
override __.GetCustomAttributesData() = p.GetCustomAttributesData()
#endif
}
override this.IsGenericMethod =
(if this.DeclaringType.IsGenericType then this.DeclaringType.GetGenericArguments().Length else 0) < parameters.Length
override this.GetGenericArguments() =
Seq.skip (if this.DeclaringType.IsGenericType then this.DeclaringType.GetGenericArguments().Length else 0) parameters |> Seq.toArray
override this.GetGenericMethodDefinition() = genericMethodDefinition
override this.DeclaringType = ProvidedSymbolType.convType parameters genericMethodDefinition.DeclaringType
override this.ToString() = "Method " + this.Name
override this.Name = genericMethodDefinition.Name
override this.MetadataToken = genericMethodDefinition.MetadataToken
override this.Attributes = genericMethodDefinition.Attributes
override this.CallingConvention = genericMethodDefinition.CallingConvention
override this.MemberType = genericMethodDefinition.MemberType
override this.IsDefined(_attributeType, _inherit) : bool = notRequired "IsDefined" this.Name
override this.ReturnType = ProvidedSymbolType.convType parameters genericMethodDefinition.ReturnType
override this.GetParameters() = genericMethodDefinition.GetParameters() |> Array.map convParam
override this.ReturnParameter = genericMethodDefinition.ReturnParameter |> convParam
override this.ReturnTypeCustomAttributes = notRequired "ReturnTypeCustomAttributes" this.Name
override this.GetBaseDefinition() = notRequired "GetBaseDefinition" this.Name
override this.GetMethodImplementationFlags() = notRequired "GetMethodImplementationFlags" this.Name
override this.MethodHandle = notRequired "MethodHandle" this.Name
override this.Invoke(_obj, _invokeAttr, _binder, _parameters, _culture) = notRequired "Invoke" this.Name
override this.ReflectedType = notRequired "ReflectedType" this.Name
override this.GetCustomAttributes(_inherit) = notRequired "GetCustomAttributes" this.Name
override this.GetCustomAttributes(_attributeType, _inherit) = notRequired "GetCustomAttributes" this.Name
type ProvidedTypeBuilder() =
static member MakeGenericType(genericTypeDefinition, genericArguments) = ProvidedSymbolType(Generic genericTypeDefinition, genericArguments) :> Type
static member MakeGenericMethod(genericMethodDefinition, genericArguments) = ProvidedSymbolMethod(genericMethodDefinition, genericArguments) :> MethodInfo
[<Class>]
type ProvidedMeasureBuilder() =
static let theBuilder = ProvidedMeasureBuilder()
static member Default = theBuilder
member b.One = typeof<Core.CompilerServices.MeasureOne>
member b.Product (m1,m2) = typedefof<Core.CompilerServices.MeasureProduct<_,_>>.MakeGenericType [| m1;m2 |]
member b.Inverse m = typedefof<Core.CompilerServices.MeasureInverse<_>>.MakeGenericType [| m |]
member b.Ratio (m1, m2) = b.Product(m1, b.Inverse m2)
member b.Square m = b.Product(m, m)
member b.SI m =
match typedefof<list<int>>.Assembly.GetType("Microsoft.FSharp.Data.UnitSystems.SI.UnitNames."+m) with
| null ->
ProvidedSymbolType
(SymbolKind.FSharpTypeAbbreviation
(typeof<Core.CompilerServices.MeasureOne>.Assembly,
"Microsoft.FSharp.Data.UnitSystems.SI.UnitNames",
[| m |]),
[]) :> Type
| v -> v
member b.AnnotateType (basicType, annotation) = ProvidedSymbolType(Generic basicType, annotation) :> Type
[<RequireQualifiedAccess>]
type TypeContainer =
| Namespace of Assembly * string // namespace
| Type of System.Type
| TypeToBeDecided
module GlobalProvidedAssemblyElementsTable =
let theTable = Dictionary<Assembly, Lazy<byte[]>>()
type ProvidedTypeDefinition(container:TypeContainer,className : string, baseType : Type option) as this =
inherit Type()
// state
let mutable attributes =
TypeAttributes.Public |||
TypeAttributes.Class |||
TypeAttributes.Sealed |||
enum (int32 TypeProviderTypeAttributes.IsErased)
let mutable baseType = lazy baseType
let mutable membersKnown = ResizeArray<MemberInfo>()
let mutable membersQueue = ResizeArray<(unit -> list<MemberInfo>)>()
let mutable staticParams = [ ]
let mutable staticParamsApply = None
let mutable container = container
let mutable interfaceImpls = ResizeArray<Type>()
let mutable interfaceImplsDelayed = ResizeArray<unit -> list<Type>>()
let mutable methodOverrides = ResizeArray<ProvidedMethod * MethodInfo>()
// members API
let getMembers() =
if membersQueue.Count > 0 then
let elems = membersQueue |> Seq.toArray // take a copy in case more elements get added
membersQueue.Clear()
for f in elems do
for i in f() do
membersKnown.Add i
match i with
| :? ProvidedProperty as p ->
if p.CanRead then membersKnown.Add (p.GetGetMethod true)
if p.CanWrite then membersKnown.Add (p.GetSetMethod true)
| :? ProvidedEvent as e ->
membersKnown.Add (e.GetAddMethod true)
membersKnown.Add (e.GetRemoveMethod true)
| _ -> ()
membersKnown.ToArray()
// members API
let getInterfaces() =
if interfaceImplsDelayed.Count > 0 then
let elems = interfaceImplsDelayed |> Seq.toArray // take a copy in case more elements get added
interfaceImplsDelayed.Clear()
for f in elems do
for i in f() do
interfaceImpls.Add i
interfaceImpls.ToArray()
let mutable theAssembly =
lazy
match container with
| TypeContainer.Namespace (theAssembly, rootNamespace) ->
if theAssembly = null then failwith "Null assemblies not allowed"
if rootNamespace<>null && rootNamespace.Length=0 then failwith "Use 'null' for global namespace"
theAssembly
| TypeContainer.Type superTy -> superTy.Assembly
| TypeContainer.TypeToBeDecided -> failwith (sprintf "type '%s' was not added as a member to a declaring type" this.Name)
let rootNamespace =
lazy
match container with
| TypeContainer.Namespace (_,rootNamespace) -> rootNamespace
| TypeContainer.Type enclosingTyp -> enclosingTyp.Namespace
| TypeContainer.TypeToBeDecided -> failwith (sprintf "type '%s' was not added as a member to a declaring type" this.Name)
let declaringType =
lazy
match container with
| TypeContainer.Namespace _ -> null
| TypeContainer.Type enclosingTyp -> enclosingTyp
| TypeContainer.TypeToBeDecided -> failwith (sprintf "type '%s' was not added as a member to a declaring type" this.Name)
let fullName =
lazy
match container with
| TypeContainer.Type declaringType -> declaringType.FullName + "+" + className
| TypeContainer.Namespace (_,namespaceName) ->
if namespaceName="" then failwith "use null for global namespace"
match namespaceName with
| null -> className
| _ -> namespaceName + "." + className
| TypeContainer.TypeToBeDecided -> failwith (sprintf "type '%s' was not added as a member to a declaring type" this.Name)
let patchUpAddedMemberInfo (this:Type) (m:MemberInfo) =
match m with
| :? ProvidedConstructor as c -> c.DeclaringTypeImpl <- this // patch up "declaring type" on provided MethodInfo
| :? ProvidedMethod as m -> m.DeclaringTypeImpl <- this // patch up "declaring type" on provided MethodInfo
| :? ProvidedProperty as p -> p.DeclaringTypeImpl <- this // patch up "declaring type" on provided MethodInfo
| :? ProvidedEvent as e -> e.DeclaringTypeImpl <- this // patch up "declaring type" on provided MethodInfo
| :? ProvidedTypeDefinition as t -> t.DeclaringTypeImpl <- this
| :? ProvidedLiteralField as l -> l.DeclaringTypeImpl <- this
| :? ProvidedField as l -> l.DeclaringTypeImpl <- this
| _ -> ()
let customAttributesImpl = CustomAttributesImpl()
member this.AddXmlDocComputed xmlDoc = customAttributesImpl.AddXmlDocComputed xmlDoc
member this.AddXmlDocDelayed xmlDoc = customAttributesImpl.AddXmlDocDelayed xmlDoc
member this.AddXmlDoc xmlDoc = customAttributesImpl.AddXmlDoc xmlDoc
member this.AddObsoleteAttribute msg = customAttributesImpl.AddObsolete msg
member this.AddDefinitionLocation(line,column,filePath) = customAttributesImpl.AddDefinitionLocation(line, column, filePath)
member this.HideObjectMethods with set v = customAttributesImpl.HideObjectMethods <- v
member __.GetCustomAttributesDataImpl() = customAttributesImpl.GetCustomAttributesData()
#if FX_NO_CUSTOMATTRIBUTEDATA
#else
override this.GetCustomAttributesData() = customAttributesImpl.GetCustomAttributesData()
#endif