-
Notifications
You must be signed in to change notification settings - Fork 790
/
NicePrint.fs
2817 lines (2398 loc) · 132 KB
/
NicePrint.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.
/// Print Signatures/Types, for signatures, intellisense, quick info, FSI responses
module internal FSharp.Compiler.NicePrint
open System
open System.Globalization
open System.IO
open Internal.Utilities.Collections
open Internal.Utilities.Library
open Internal.Utilities.Library.Extras
open Internal.Utilities.Rational
open FSharp.Compiler
open FSharp.Compiler.AbstractIL.IL
open FSharp.Compiler.AccessibilityLogic
open FSharp.Compiler.AttributeChecking
open FSharp.Compiler.DiagnosticsLogger
open FSharp.Compiler.Infos
open FSharp.Compiler.InfoReader
open FSharp.Compiler.Syntax
open FSharp.Compiler.Syntax.PrettyNaming
open FSharp.Compiler.TcGlobals
open FSharp.Compiler.Text
open FSharp.Compiler.Text.Layout
open FSharp.Compiler.Text.LayoutRender
open FSharp.Compiler.Text.TaggedText
open FSharp.Compiler.TypedTree
open FSharp.Compiler.TypedTreeBasics
open FSharp.Compiler.TypedTreeOps
open FSharp.Compiler.TypeHierarchy
open FSharp.Compiler.Xml
open FSharp.Core.Printf
[<AutoOpen>]
module internal PrintUtilities =
let bracketIfL x lyt = if x then bracketL lyt else lyt
let squareAngleL x = LeftL.leftBracketAngle ^^ x ^^ RightL.rightBracketAngle
let angleL x = SepL.leftAngle ^^ x ^^ RightL.rightAngle
let braceL x = wordL leftBrace ^^ x ^^ wordL rightBrace
let braceMultiLineL x = (wordL leftBrace @@-- x) @@ wordL rightBrace
let braceBarL x = wordL leftBraceBar ^^ x ^^ wordL rightBraceBar
// Use a space before a colon if there is an unusual character to the left
let addColonL l =
if endsWithL ">" l || endsWithL ")" l || endsWithL "`" l then
l ^^ WordL.colon
else
l ^^ RightL.colon
let comment str = wordL (tagText (sprintf "(* %s *)" str))
let isDiscard (name: string) = name.StartsWith("_")
let ensureFloat (s: string) =
if String.forall (fun c -> Char.IsDigit c || c = '-') s then
s + ".0"
else s
// Layout a curried function type. Over multiple lines breaking takes some care, e.g.
//
// val SampleFunctionTupledAllBreakA:
// longLongLongArgName1: string * longLongLongArgName2: TType *
// longLongLongArgName3: TType * longLongLongArgName4: TType ->
// TType list
//
// val SampleFunctionTupledAllBreakA:
// longLongLongArgName1: string *
// longLongLongArgName2: TType *
// longLongLongArgName3: TType *
// longLongLongArgName4: TType ->
// TType list
//
// val SampleFunctionCurriedOneBreakA:
// arg1: string -> arg2: TType -> arg3: TType ->
// arg4: TType -> TType list
//
// val SampleFunctionCurriedAllBreaksA:
// longLongLongArgName1: string ->
// longLongLongArgName2: TType ->
// longLongLongArgName3: TType ->
// longLongLongArgName4: TType ->
// TType list
//
// val SampleFunctionMixedA:
// longLongLongArgName1: string *
// longLongLongArgName2: string ->
// longLongLongArgName3: string *
// longLongLongArgName4: string *
// longLongLongArgName5: TType ->
// longLongLongArgName6: TType *
// longLongLongArgName7: TType ->
// longLongLongArgName8: TType *
// longLongLongArgName9: TType *
// longLongLongArgName10: TType ->
// TType list
let curriedLayoutsL retTyDelim (argTysL: Layout list) (retTyL: Layout) =
let lastIndex = List.length argTysL - 1
argTysL
|> List.mapi (fun idx argTyL ->
let isTupled =
idx = 0 ||
match argTyL with
| Node(leftLayout = Node(rightLayout = Leaf (text = starText))) -> starText.Text = "*"
| _ -> false
let layout =
argTyL
^^ (if idx = lastIndex then
wordL retTyDelim
else
WordL.arrow)
isTupled, layout)
|> List.rev
|> fun reversedArgs -> (true, retTyL) :: reversedArgs
|> List.fold (fun acc (shouldBreak, layout) -> (if shouldBreak then (---) else (++)) layout acc) emptyL
let tagNavArbValRef (valRefOpt: ValRef option) tag =
match valRefOpt with
| Some vref ->
tag |> mkNav vref.DefinitionRange
| None ->
tag
let suppressInheritanceAndInterfacesForTyInSimplifiedDisplays g amap m ty =
isEnumTy g ty || isDelegateTy g ty || ExistsHeadTypeInEntireHierarchy g amap m ty g.exn_tcr
let applyMaxMembers maxMembers (allDecls: _ list) =
match maxMembers with
| Some n when allDecls.Length > n -> (allDecls |> List.truncate n) @ [wordL (tagPunctuation "...")]
| _ -> allDecls
// Put the "+ N overloads" into the layout
let shrinkOverloads layoutFunction resultFunction group =
match group with
| [x] -> [resultFunction x (layoutFunction x)]
| x :: rest -> [ resultFunction x (layoutFunction x -- leftL (tagText (match rest.Length with 1 -> FSComp.SR.nicePrintOtherOverloads1() | n -> FSComp.SR.nicePrintOtherOverloadsN(n)))) ]
| _ -> []
let tagEntityRefName(denv: DisplayEnv) (xref: EntityRef) name =
if xref.IsNamespace then tagNamespace name
elif xref.IsModule then tagModule name
elif xref.IsTypeAbbrev then
let ty = xref.TypeAbbrev.Value
match stripTyEqns denv.g ty with
| TType_app(tcref, _, _) when tcref.IsStructOrEnumTycon ->
tagStruct name
| _ ->
tagAlias name
elif xref.IsFSharpDelegateTycon then tagDelegate name
elif xref.IsILEnumTycon || xref.IsFSharpEnumTycon then tagEnum name
elif xref.IsStructOrEnumTycon then tagStruct name
elif isInterfaceTyconRef xref then tagInterface name
elif xref.IsUnionTycon then tagUnion name
elif xref.IsRecordTycon then tagRecord name
else tagClass name
let usePrefix (denv: DisplayEnv) (tcref: TyconRef) =
match denv.genericParameterStyle with
| GenericParameterStyle.Implicit -> tcref.IsPrefixDisplay
| GenericParameterStyle.Prefix -> true
| GenericParameterStyle.Suffix -> false
/// <summary>
/// Creates a layout for TyconRef.
/// </summary>
/// <param name="isAttribute"></param>
/// <param name="denv"></param>
/// <param name="tcref"></param>
/// <param name="demangledPath">
/// Used in the case the TyconRef is a nested type from another assembly which has generic type parameters in the path.
/// For example: System.Collections.Immutable.ImmutableArray>'T<.Builder
/// Lead to access path: System.Collections.Immutable.ImmutableArray`1
/// ImmutableArray`1 will be transformed to ImmutableArray>'t<
/// </param>
let layoutTyconRefImpl isAttribute (denv: DisplayEnv) (tcref: TyconRef) (demangledPath: string list option) =
let prefix = usePrefix denv tcref
let isArray = not prefix && isArrayTyconRef denv.g tcref
let demangled =
if isArray then
let numberOfCommas = tcref.CompiledName |> Seq.filter (fun c -> c = ',') |> Seq.length
if numberOfCommas = 0 then
"array"
else
$"array{numberOfCommas + 1}d"
else
let name =
if denv.includeStaticParametersInTypeNames then
tcref.DisplayNameWithStaticParameters
elif tcref.DisplayName = tcref.DisplayNameWithStaticParameters then
tcref.DisplayName // has no static params
else
tcref.DisplayName+"<...>" // shorten
if isAttribute && name.EndsWithOrdinal("Attribute") then
String.dropSuffix name "Attribute"
else
name
let tyconTagged =
tagEntityRefName denv tcref demangled
|> mkNav tcref.DefinitionRange
let tyconTextL = tyconTagged |> wordL
if denv.shortTypeNames then
tyconTextL
else
let path =
if denv.includeStaticParametersInTypeNames then
Option.defaultValue tcref.CompilationPath.DemangledPath demangledPath
else
tcref.CompilationPath.DemangledPath
|> List.map (fun s ->
let i = s.IndexOf(',')
if i <> -1 then s.Substring(0, i)+"<...>" // apparently has static params, shorten
else s)
let pathText = trimPathByDisplayEnv denv path
if pathText = "" then tyconTextL else leftL (tagUnknownEntity pathText) ^^ tyconTextL
let layoutBuiltinAttribute (denv: DisplayEnv) (attrib: BuiltinAttribInfo) =
let tcref = attrib.TyconRef
squareAngleL (layoutTyconRefImpl true denv tcref None)
/// layout the xml docs immediately before another block
let layoutXmlDoc (denv: DisplayEnv) alwaysAddEmptyLine (xml: XmlDoc) restL =
if denv.showDocumentation then
let xmlDocL =
let linesL =
[ for lineText in xml.UnprocessedLines do
// These lines may have new-lines in them and we need to split them so we can format it
for line in lineText.Split('\n') do
// note here that we don't add a space after the triple-slash, because
// the implicit spacing hasn't been trimmed here.
yield ("///" + line) |> tagText |> wordL
]
// Always add an empty line before any "///" comment
let linesL =
if linesL.Length > 0 || alwaysAddEmptyLine then
[ yield "" |> tagText |> wordL
yield! linesL ]
else
linesL
linesL |> aboveListL
xmlDocL @@ restL
else restL
let layoutXmlDocFromSig (denv: DisplayEnv) (infoReader: InfoReader) alwaysAddEmptyLine (possibleXmlDoc: XmlDoc) restL (info: (string option * string) option) =
let xmlDoc =
if possibleXmlDoc.IsEmpty then
match info with
| Some(Some ccuFileName, xmlDocSig) ->
infoReader.amap.assemblyLoader.TryFindXmlDocumentationInfo(Path.GetFileNameWithoutExtension ccuFileName)
|> Option.bind (fun xmlDocInfo ->
xmlDocInfo.TryGetXmlDocBySig(xmlDocSig)
)
|> Option.defaultValue possibleXmlDoc
| _ ->
possibleXmlDoc
else
possibleXmlDoc
layoutXmlDoc denv alwaysAddEmptyLine xmlDoc restL
let layoutXmlDocOfVal (denv: DisplayEnv) (infoReader: InfoReader) (vref: ValRef) restL =
if denv.showDocumentation then
GetXmlDocSigOfValRef denv.g vref
|> layoutXmlDocFromSig denv infoReader true vref.XmlDoc restL
else
restL
let layoutXmlDocOfMethInfo (denv: DisplayEnv) (infoReader: InfoReader) (minfo: MethInfo) restL =
if denv.showDocumentation then
GetXmlDocSigOfMethInfo infoReader Range.range0 minfo
|> layoutXmlDocFromSig denv infoReader true minfo.XmlDoc restL
else
restL
let layoutXmlDocOfPropInfo (denv: DisplayEnv) (infoReader: InfoReader) (pinfo: PropInfo) restL =
if denv.showDocumentation then
GetXmlDocSigOfProp infoReader Range.range0 pinfo
|> layoutXmlDocFromSig denv infoReader true pinfo.XmlDoc restL
else
restL
let layoutXmlDocOfEventInfo (denv: DisplayEnv) (infoReader: InfoReader) (einfo: EventInfo) restL =
if denv.showDocumentation then
GetXmlDocSigOfEvent infoReader Range.range0 einfo
|> layoutXmlDocFromSig denv infoReader true einfo.XmlDoc restL
else
restL
let layoutXmlDocOfILFieldInfo (denv: DisplayEnv) (infoReader: InfoReader) (finfo: ILFieldInfo) restL =
if denv.showDocumentation then
GetXmlDocSigOfILFieldInfo infoReader Range.range0 finfo
|> layoutXmlDocFromSig denv infoReader true XmlDoc.Empty restL
else
restL
let layoutXmlDocOfRecdField (denv: DisplayEnv) (infoReader: InfoReader) isClassDecl (rfref: RecdFieldRef) restL =
if denv.showDocumentation then
GetXmlDocSigOfRecdFieldRef rfref
|> layoutXmlDocFromSig denv infoReader isClassDecl rfref.RecdField.XmlDoc restL
else
restL
let layoutXmlDocOfUnionCase (denv: DisplayEnv) (infoReader: InfoReader) (ucref: UnionCaseRef) restL =
if denv.showDocumentation then
GetXmlDocSigOfUnionCaseRef ucref
|> layoutXmlDocFromSig denv infoReader false ucref.UnionCase.XmlDoc restL
else
restL
let layoutXmlDocOfEntity (denv: DisplayEnv) (infoReader: InfoReader) (eref: EntityRef) restL =
if denv.showDocumentation then
GetXmlDocSigOfEntityRef infoReader Range.range0 eref
|> layoutXmlDocFromSig denv infoReader true eref.XmlDoc restL
else
restL
let squashToWidth width layout =
match width with
| Some w -> Display.squashTo w layout
| None -> layout
module PrintIL =
let fullySplitILTypeRef (tref: ILTypeRef) =
(List.collect splitNamespace (tref.Enclosing @ [DemangleGenericTypeName tref.Name]))
let layoutILTypeRefName denv path =
let path =
match path with
| [ "System"; "Void" ] -> ["unit"]
| [ "System"; "Object" ] -> ["obj"]
| [ "System"; "String" ] -> ["string"]
| [ "System"; "Single" ] -> ["float32"]
| [ "System"; "Double" ] -> ["float"]
| [ "System"; "Decimal"] -> ["decimal"]
| [ "System"; "Char" ] -> ["char"]
| [ "System"; "Byte" ] -> ["byte"]
| [ "System"; "SByte" ] -> ["sbyte"]
| [ "System"; "Int16" ] -> ["int16"]
| [ "System"; "Int32" ] -> ["int" ]
| [ "System"; "Int64" ] -> ["int64" ]
| [ "System"; "UInt16" ] -> ["uint16" ]
| [ "System"; "UInt32" ] -> ["uint" ]
| [ "System"; "UInt64" ] -> ["uint64" ]
| [ "System"; "IntPtr" ] -> ["nativeint" ]
| [ "System"; "UIntPtr" ] -> ["unativeint" ]
| [ "System"; "Boolean"] -> ["bool"]
| _ -> path
let p2, n = List.frontAndBack path
let tagged = if n = "obj" || n = "string" then tagClass n else tagStruct n
if denv.shortTypeNames then
wordL tagged
else
leftL (tagNamespace (trimPathByDisplayEnv denv p2)) ^^ wordL tagged
let layoutILTypeRef denv tref =
let path = fullySplitILTypeRef tref
layoutILTypeRefName denv path
let layoutILArrayShape (ILArrayShape sh) =
SepL.leftBracket ^^ wordL (tagPunctuation (sh |> List.tail |> List.map (fun _ -> ",") |> String.concat "")) ^^ RightL.rightBracket // drop off one "," so that a n-dimensional array has n - 1 ","'s
let paramsL (ps: Layout list) : Layout =
match ps with
| [] -> emptyL
| _ ->
let body = commaListL ps
SepL.leftAngle ^^ body ^^ RightL.rightAngle
let pruneParams (className: string) (ilTyparSubst: Layout list) =
let numParams =
// can't find a way to see the number of generic parameters for *this* class (the GenericParams also include type variables for enclosing classes); this will have to do
let rightMost = className |> SplitNamesForILPath |> List.last
match Int32.TryParse(rightMost, NumberStyles.Integer, CultureInfo.InvariantCulture) with
| true, n -> n
| false, _ -> 0 // looks like it's non-generic
ilTyparSubst |> List.rev |> List.truncate numParams |> List.rev
let rec layoutILType (denv: DisplayEnv) (ilTyparSubst: Layout list) (ty: ILType) : Layout =
match ty with
| ILType.Void -> WordL.structUnit // These are type-theoretically totally different type-theoretically `void` is Fin 0 and `unit` is Fin (S 0) ... but, this looks like as close as we can get.
| ILType.Array (sh, t) -> layoutILType denv ilTyparSubst t ^^ layoutILArrayShape sh
| ILType.Value t
| ILType.Boxed t -> layoutILTypeRef denv t.TypeRef ^^ (t.GenericArgs |> List.map (layoutILType denv ilTyparSubst) |> paramsL)
| ILType.Ptr t
| ILType.Byref t -> layoutILType denv ilTyparSubst t
| ILType.FunctionPointer t -> layoutILCallingSignature denv ilTyparSubst None t
| ILType.TypeVar n -> List.item (int n) ilTyparSubst
| ILType.Modified (_, _, t) -> layoutILType denv ilTyparSubst t // Just recurse through them to the contained ILType
/// Layout a function pointer signature using type-only-F#-style. No argument names are printed.
and layoutILCallingSignature denv ilTyparSubst cons (signature: ILCallingSignature) =
// We need a special case for
// constructors (Their return types are reported as `void`, but this is
// incorrect; so if we're dealing with a constructor we require that the
// return type be passed along as the `cons` parameter.)
let args = signature.ArgTypes |> List.map (layoutILType denv ilTyparSubst)
let res =
match cons with
| Some className ->
let names = SplitNamesForILPath (DemangleGenericTypeName className)
// special case for constructor return-type (viz., the class itself)
layoutILTypeRefName denv names ^^ (pruneParams className ilTyparSubst |> paramsL)
| None ->
signature.ReturnType |> layoutILType denv ilTyparSubst
match args with
| [] -> WordL.structUnit ^^ WordL.arrow ^^ res
| [x] -> x ^^ WordL.arrow ^^ res
| _ -> sepListL WordL.star args ^^ WordL.arrow ^^ res
let layoutILFieldInit x =
let textOpt =
match x with
| Some init ->
match init with
| ILFieldInit.Bool x ->
if x then
Some keywordTrue
else
Some keywordFalse
| ILFieldInit.Char c -> ("'" + (char c).ToString () + "'") |> (tagStringLiteral >> Some)
| ILFieldInit.Int8 x -> ((x |> int32 |> string) + "y") |> (tagNumericLiteral >> Some)
| ILFieldInit.Int16 x -> ((x |> int32 |> string) + "s") |> (tagNumericLiteral >> Some)
| ILFieldInit.Int32 x -> x |> (string >> tagNumericLiteral >> Some)
| ILFieldInit.Int64 x -> ((x |> string) + "L") |> (tagNumericLiteral >> Some)
| ILFieldInit.UInt8 x -> ((x |> int32 |> string) + "uy") |> (tagNumericLiteral >> Some)
| ILFieldInit.UInt16 x -> ((x |> int32 |> string) + "us") |> (tagNumericLiteral >> Some)
| ILFieldInit.UInt32 x -> (x |> int64 |> string) + "u" |> (tagNumericLiteral >> Some)
| ILFieldInit.UInt64 x -> ((x |> int64 |> string) + "UL") |> (tagNumericLiteral >> Some)
| ILFieldInit.Single d ->
let s = d.ToString ("g12", CultureInfo.InvariantCulture)
let s = ensureFloat s
(s + "f") |> (tagNumericLiteral >> Some)
| ILFieldInit.Double d ->
let s = d.ToString ("g12", CultureInfo.InvariantCulture)
let s = ensureFloat s
s |> (tagNumericLiteral >> Some)
| _ -> None
| None -> None
match textOpt with
| None -> WordL.equals ^^ (comment "value unavailable")
| Some s -> WordL.equals ^^ wordL s
let layoutILEnumCase nm litVal =
let nameL = ConvertLogicalNameToDisplayLayout (tagEnum >> wordL) nm
WordL.bar ^^ nameL ^^ layoutILFieldInit litVal
module PrintTypes =
// Note: We need nice printing of constants in order to print literals and attributes
let layoutConst g ty c =
let str =
match c with
| Const.Bool x -> if x then keywordTrue else keywordFalse
| Const.SByte x -> (x |> string)+"y" |> tagNumericLiteral
| Const.Byte x -> (x |> string)+"uy" |> tagNumericLiteral
| Const.Int16 x -> (x |> string)+"s" |> tagNumericLiteral
| Const.UInt16 x -> (x |> string)+"us" |> tagNumericLiteral
| Const.Int32 x -> (x |> string) |> tagNumericLiteral
| Const.UInt32 x -> (x |> string)+"u" |> tagNumericLiteral
| Const.Int64 x -> (x |> string)+"L" |> tagNumericLiteral
| Const.UInt64 x -> (x |> string)+"UL" |> tagNumericLiteral
| Const.IntPtr x -> (x |> string)+"n" |> tagNumericLiteral
| Const.UIntPtr x -> (x |> string)+"un" |> tagNumericLiteral
| Const.Single d ->
let s = d.ToString("g12", CultureInfo.InvariantCulture)
let s = ensureFloat s
(s + "f") |> tagNumericLiteral
| Const.Double d ->
let s = d.ToString("g12", CultureInfo.InvariantCulture)
let s = ensureFloat s
s |> tagNumericLiteral
| Const.Char c -> "'" + c.ToString() + "'" |> tagStringLiteral
| Const.String bs -> "\"" + bs + "\"" |> tagNumericLiteral
| Const.Unit -> punctuationUnit
| Const.Decimal bs -> string bs + "M" |> tagNumericLiteral
// either "null" or "the default value for a struct"
| Const.Zero -> tagKeyword(if isRefTy g ty then "null" else "default")
wordL str
let layoutAccessibilityCore (denv: DisplayEnv) accessibility =
let isInternalCompPath x =
match x with
| CompPath(ILScopeRef.Local, []) -> true
| _ -> false
let (|Public|Internal|Private|) (TAccess p) =
match p with
| [] -> Public
| _ when List.forall isInternalCompPath p -> Internal
| _ -> Private
match denv.contextAccessibility, accessibility with
| Public, Internal -> WordL.keywordInternal
| Public, Private -> WordL.keywordPrivate
| Internal, Private -> WordL.keywordPrivate
| _ -> emptyL
let layoutAccessibility (denv: DisplayEnv) accessibility itemL =
layoutAccessibilityCore denv accessibility ++ itemL
/// Layout a reference to a type
let layoutTyconRef denv tcref = layoutTyconRefImpl false denv tcref None
/// Layout the flags of a member
let layoutMemberFlags (memFlags: SynMemberFlags) =
let stat =
if memFlags.IsInstance || (memFlags.MemberKind = SynMemberKind.Constructor) then emptyL
else WordL.keywordStatic
let stat =
if memFlags.IsOverrideOrExplicitImpl then stat ++ WordL.keywordOverride
else stat
let stat =
if memFlags.IsDispatchSlot then stat ++ WordL.keywordAbstract
elif memFlags.IsOverrideOrExplicitImpl then stat
else
match memFlags.MemberKind with
| SynMemberKind.ClassConstructor
| SynMemberKind.Constructor
| SynMemberKind.PropertyGetSet -> stat
| SynMemberKind.Member
| SynMemberKind.PropertyGet
| SynMemberKind.PropertySet -> stat ++ WordL.keywordMember
// let stat = if memFlags.IsFinal then stat ++ wordL "final" else stat in
stat
/// Layout a single attribute arg, following the cases of 'gen_attr_arg' in ilxgen.fs
/// This is the subset of expressions we display in the NicePrint pretty printer
/// See also dataExprL - there is overlap between these that should be removed
let rec layoutAttribArg denv arg =
match arg with
| Expr.Const (c, _, ty) ->
if isEnumTy denv.g ty then
WordL.keywordEnum ^^ angleL (layoutType denv ty) ^^ bracketL (layoutConst denv.g ty c)
else
layoutConst denv.g ty c
| Expr.Op (TOp.Array, [_elemTy], args, _) ->
LeftL.leftBracketBar ^^ semiListL (List.map (layoutAttribArg denv) args) ^^ RightL.rightBracketBar
// Detect 'typeof<ty>' calls
| TypeOfExpr denv.g ty ->
LeftL.keywordTypeof ^^ WordL.leftAngle ^^ layoutType denv ty ^^ RightL.rightAngle
// Detect 'typedefof<ty>' calls
| TypeDefOfExpr denv.g ty ->
LeftL.keywordTypedefof ^^ WordL.leftAngle ^^ layoutType denv ty ^^ RightL.rightAngle
| Expr.Op (TOp.Coerce, [tgtTy;_], [arg2], _) ->
LeftL.leftParen ^^ layoutAttribArg denv arg2 ^^ wordL (tagPunctuation ":>") ^^ layoutType denv tgtTy ^^ RightL.rightParen
| AttribBitwiseOrExpr denv.g (arg1, arg2) ->
layoutAttribArg denv arg1 ^^ wordL (tagPunctuation "|||") ^^ layoutAttribArg denv arg2
// Detect explicit enum values
| EnumExpr denv.g arg1 ->
WordL.keywordEnum ++ bracketL (layoutAttribArg denv arg1)
| _ -> comment "(* unsupported attribute argument *)"
/// Layout arguments of an attribute 'arg1, ..., argN'
and layoutAttribArgs denv args props =
let argsL = args |> List.map (fun (AttribExpr(e1, _)) -> layoutAttribArg denv e1)
let propsL =
props
|> List.map (fun (AttribNamedArg(name,_, _, AttribExpr(e1, _))) ->
wordL (tagProperty name) ^^ WordL.equals ^^ layoutAttribArg denv e1)
sepListL RightL.comma (argsL @ propsL)
/// Layout an attribute 'Type(arg1, ..., argN)'
and layoutAttrib denv (Attrib(tcref, _, args, props, _, _, _)) =
let tcrefL = layoutTyconRefImpl true denv tcref None
let argsL = bracketL (layoutAttribArgs denv args props)
if List.isEmpty args && List.isEmpty props then
tcrefL
else
tcrefL ++ argsL
and layoutILAttribElement denv arg =
match arg with
| ILAttribElem.String (Some x) -> wordL (tagStringLiteral ("\"" + x + "\""))
| ILAttribElem.String None -> wordL (tagStringLiteral "")
| ILAttribElem.Bool x -> if x then WordL.keywordTrue else WordL.keywordFalse
| ILAttribElem.Char x -> wordL (tagStringLiteral ("'" + x.ToString() + "'" ))
| ILAttribElem.SByte x -> wordL (tagNumericLiteral ((x |> string)+"y"))
| ILAttribElem.Int16 x -> wordL (tagNumericLiteral ((x |> string)+"s"))
| ILAttribElem.Int32 x -> wordL (tagNumericLiteral (x |> string))
| ILAttribElem.Int64 x -> wordL (tagNumericLiteral ((x |> string)+"L"))
| ILAttribElem.Byte x -> wordL (tagNumericLiteral ((x |> string)+"uy"))
| ILAttribElem.UInt16 x -> wordL (tagNumericLiteral ((x |> string)+"us"))
| ILAttribElem.UInt32 x -> wordL (tagNumericLiteral ((x |> string)+"u"))
| ILAttribElem.UInt64 x -> wordL (tagNumericLiteral ((x |> string)+"UL"))
| ILAttribElem.Single x ->
let str =
let s = x.ToString("g12", CultureInfo.InvariantCulture)
let s = ensureFloat s
s + "f"
wordL (tagNumericLiteral str)
| ILAttribElem.Double x ->
let str =
let s = x.ToString("g12", CultureInfo.InvariantCulture)
let s = ensureFloat s
s
wordL (tagNumericLiteral str)
| ILAttribElem.Null -> wordL (tagKeyword "null")
| ILAttribElem.Array (_, xs) ->
LeftL.leftBracketBar ^^ semiListL (List.map (layoutILAttribElement denv) xs) ^^ RightL.rightBracketBar
| ILAttribElem.Type (Some ty) ->
LeftL.keywordTypeof ^^ SepL.leftAngle ^^ PrintIL.layoutILType denv [] ty ^^ RightL.rightAngle
| ILAttribElem.Type None -> wordL (tagText "")
| ILAttribElem.TypeRef (Some ty) ->
LeftL.keywordTypedefof ^^ SepL.leftAngle ^^ PrintIL.layoutILTypeRef denv ty ^^ RightL.rightAngle
| ILAttribElem.TypeRef None -> emptyL
and layoutILAttrib denv (ty, args) =
let argsL = bracketL (sepListL RightL.comma (List.map (layoutILAttribElement denv) args))
PrintIL.layoutILType denv [] ty ++ argsL
/// Layout '[<attribs>]' above another block
and layoutAttribs denv startOpt isLiteral kind attrs restL =
let attrsL =
[ if denv.showAttributes then
// Don't display DllImport and other attributes in generated signatures
let attrs = attrs |> List.filter (IsMatchingFSharpAttributeOpt denv.g denv.g.attrib_DllImportAttribute >> not)
let attrs = attrs |> List.filter (IsMatchingFSharpAttributeOpt denv.g denv.g.attrib_ContextStaticAttribute >> not)
let attrs = attrs |> List.filter (IsMatchingFSharpAttributeOpt denv.g denv.g.attrib_ThreadStaticAttribute >> not)
let attrs = attrs |> List.filter (IsMatchingFSharpAttribute denv.g denv.g.attrib_EntryPointAttribute >> not)
let attrs = attrs |> List.filter (IsMatchingFSharpAttributeOpt denv.g denv.g.attrib_MarshalAsAttribute >> not)
let attrs = attrs |> List.filter (IsMatchingFSharpAttribute denv.g denv.g.attrib_ReflectedDefinitionAttribute >> not)
let attrs = attrs |> List.filter (IsMatchingFSharpAttribute denv.g denv.g.attrib_StructLayoutAttribute >> not)
let attrs = attrs |> List.filter (IsMatchingFSharpAttribute denv.g denv.g.attrib_AutoSerializableAttribute >> not)
let attrs = attrs |> List.filter (IsMatchingFSharpAttribute denv.g denv.g.attrib_LiteralAttribute >> not)
let attrs = attrs |> List.filter (IsMatchingFSharpAttribute denv.g denv.g.attrib_MeasureAttribute >> not)
let attrs = attrs |> List.filter (IsMatchingFSharpAttribute denv.g denv.g.attrib_StructAttribute >> not)
let attrs = attrs |> List.filter (IsMatchingFSharpAttribute denv.g denv.g.attrib_ClassAttribute >> not)
let attrs = attrs |> List.filter (IsMatchingFSharpAttribute denv.g denv.g.attrib_InterfaceAttribute >> not)
for attr in attrs do
layoutAttrib denv attr
// Always show the 'Struct', 'Class, 'Interface' attributes if needed
match startOpt with
| Some "struct" ->
wordL (tagClass "Struct")
| Some "class" ->
wordL (tagClass "Class")
| Some "interface" ->
wordL (tagClass "Interface")
| _ ->
()
// Always show the 'Literal' attribute if needed
if isLiteral then
wordL (tagClass "Literal")
// Always show the 'Measure' attribute if needed
if kind = TyparKind.Measure then
wordL (tagClass "Measure")
]
match attrsL with
| [] -> restL
| _ -> squareAngleL (sepListL RightL.semicolon attrsL) @@ restL
and layoutTyparAttribs denv kind attrs restL =
match attrs, kind with
| [], TyparKind.Type -> restL
| _, _ -> squareAngleL (sepListL RightL.semicolon ((match kind with TyparKind.Type -> [] | TyparKind.Measure -> [wordL (tagText "Measure")]) @ List.map (layoutAttrib denv) attrs)) ^^ restL
and layoutTyparRef denv (typar: Typar) =
tagTypeParameter
(sprintf "%s%s%s"
(if denv.showStaticallyResolvedTyparAnnotations then prefixOfStaticReq typar.StaticReq else "'")
(if denv.showInferenceTyparAnnotations then prefixOfInferenceTypar typar else "")
typar.DisplayName)
|> mkNav typar.Range
|> wordL
/// Layout a single type parameter declaration, taking TypeSimplificationInfo into account
/// There are several printing-cases for a typar:
///
/// 'a - is multiple occurrence.
/// _ - singleton occurrence, an underscore preferred over 'b. (OCaml accepts but does not print)
/// #Type - inplace coercion constraint and singleton.
/// ('a :> Type) - inplace coercion constraint not singleton.
/// ('a.opM: S->T) - inplace operator constraint.
///
and layoutTyparRefWithInfo denv (env: SimplifyTypes.TypeSimplificationInfo) (typar: Typar) =
let varL = layoutTyparRef denv typar
let varL = if denv.showAttributes then layoutTyparAttribs denv typar.Kind typar.Attribs varL else varL
match Zmap.tryFind typar env.inplaceConstraints with
| Some typarConstraintTy ->
if Zset.contains typar env.singletons then
let tyLayout =
match typarConstraintTy with
| TType_app (tyconRef = tc; typeInstantiation = ti)
when ti.Length > 0 && not (usePrefix denv tc) ->
layoutTypeWithInfo denv env typarConstraintTy
|> bracketL
| _ -> layoutTypeWithInfo denv env typarConstraintTy
leftL (tagPunctuation "#") ^^ tyLayout
else
(varL ^^ sepL (tagPunctuation ":>") ^^ layoutTypeWithInfo denv env typarConstraintTy) |> bracketL
| _ -> varL
/// Layout type parameter constraints, taking TypeSimplificationInfo into account
and layoutConstraintsWithInfo denv env cxs =
// Internally member constraints get attached to each type variable in their support.
// This means we get too many constraints being printed.
// So we normalize the constraints to eliminate duplicate member constraints
let cxs =
cxs
|> ListSet.setify (fun (_, cx1) (_, cx2) ->
match cx1, cx2 with
| TyparConstraint.MayResolveMember(traitInfo1, _),
TyparConstraint.MayResolveMember(traitInfo2, _) -> traitsAEquiv denv.g TypeEquivEnv.Empty traitInfo1 traitInfo2
| _ -> false)
let cxsL = List.collect (layoutConstraintWithInfo denv env) cxs
match cxsL with
| [] -> emptyL
| _ ->
if denv.abbreviateAdditionalConstraints then
wordL (tagKeyword "when") ^^ wordL(tagText "<constraints>")
elif denv.shortConstraints then
LeftL.leftParen ^^ wordL (tagKeyword "requires") ^^ sepListL (wordL (tagKeyword "and")) cxsL ^^ RightL.rightParen
else
wordL (tagKeyword "when") ^^ sepListL (wordL (tagKeyword "and")) cxsL
/// Layout constraints, taking TypeSimplificationInfo into account
and layoutConstraintWithInfo denv env (tp, tpc) =
let longConstraintPrefix l = (layoutTyparRefWithInfo denv env tp |> addColonL) ^^ l
match tpc with
| TyparConstraint.CoercesTo(tgtTy, _) ->
[layoutTyparRefWithInfo denv env tp ^^ wordL (tagOperator ":>") --- layoutTypeWithInfo denv env tgtTy]
| TyparConstraint.MayResolveMember(traitInfo, _) ->
[layoutTraitWithInfo denv env traitInfo]
| TyparConstraint.DefaultsTo(_, ty, _) ->
if denv.showTyparDefaultConstraints then
[wordL (tagKeyword "default") ^^ (layoutTyparRefWithInfo denv env tp |> addColonL) ^^ layoutTypeWithInfo denv env ty]
else []
| TyparConstraint.IsEnum(ty, _) ->
if denv.shortConstraints then
[ WordL.keywordEnum ]
else
[longConstraintPrefix (layoutTypeAppWithInfoAndPrec denv env WordL.keywordEnum 2 true [ty])]
| TyparConstraint.SupportsComparison _ ->
if denv.shortConstraints then
[wordL (tagKeyword "comparison")]
else
[wordL (tagKeyword "comparison") |> longConstraintPrefix]
| TyparConstraint.SupportsEquality _ ->
if denv.shortConstraints then
[wordL (tagKeyword "equality")]
else
[wordL (tagKeyword "equality") |> longConstraintPrefix]
| TyparConstraint.IsDelegate(aty, bty, _) ->
if denv.shortConstraints then
[WordL.keywordDelegate]
else
[layoutTypeAppWithInfoAndPrec denv env WordL.keywordDelegate 2 true [aty;bty] |> longConstraintPrefix]
| TyparConstraint.SupportsNull _ ->
[wordL (tagKeyword "null") |> longConstraintPrefix]
| TyparConstraint.IsNonNullableStruct _ ->
if denv.shortConstraints then
[wordL (tagText "value type")]
else
[WordL.keywordStruct |> longConstraintPrefix]
| TyparConstraint.IsUnmanaged _ ->
if denv.shortConstraints then
[wordL (tagKeyword "unmanaged")]
else
[wordL (tagKeyword "unmanaged") |> longConstraintPrefix]
| TyparConstraint.IsReferenceType _ ->
if denv.shortConstraints then
[wordL (tagText "reference type")]
else
[(wordL (tagKeyword "not") ^^ WordL.keywordStruct) |> longConstraintPrefix]
| TyparConstraint.SimpleChoice(tys, _) ->
[bracketL (sepListL (sepL bar) (List.map (layoutTypeWithInfo denv env) tys)) |> longConstraintPrefix]
| TyparConstraint.RequiresDefaultConstructor _ ->
if denv.shortConstraints then
[wordL (tagKeyword "default") ^^ wordL (tagKeyword "constructor")]
else
[bracketL (
(WordL.keywordNew |> addColonL) ^^
WordL.structUnit ^^
WordL.arrow ^^
(layoutTyparRefWithInfo denv env tp)) |> longConstraintPrefix]
and layoutTraitWithInfo denv env traitInfo =
let g = denv.g
let (TTrait(tys, _, memFlags, _, _, _)) = traitInfo
let nm = traitInfo.MemberDisplayNameCore
let nameL = ConvertValLogicalNameToDisplayLayout false (tagMember >> wordL) nm
if denv.shortConstraints then
WordL.keywordMember ^^ nameL
else
let retTy = traitInfo.GetReturnType(g)
let argTys = traitInfo.GetLogicalArgumentTypes(g)
let argTys, retTy =
match memFlags.MemberKind with
| SynMemberKind.PropertySet ->
match List.tryFrontAndBack argTys with
| Some res -> res
| None -> argTys, retTy
| _ ->
argTys, retTy
let stat = layoutMemberFlags memFlags
let tys = ListSet.setify (typeEquiv g) tys
let tysL =
match tys with
| [ty] -> layoutTypeWithInfo denv env ty
| tys -> bracketL (layoutTypesWithInfoAndPrec denv env 2 (wordL (tagKeyword "or")) tys)
let retTyL = layoutReturnType denv env retTy
let sigL =
match argTys with
// Empty arguments indicates a non-indexer property constraint
| [] -> retTyL
| _ ->
let argTysL = layoutTypesWithInfoAndPrec denv env 2 (wordL (tagPunctuation "*")) argTys
curriedLayoutsL arrow [argTysL] retTyL
let getterSetterL =
match memFlags.MemberKind with
| SynMemberKind.PropertyGet when not argTys.IsEmpty ->
WordL.keywordWith ^^ WordL.keywordGet
| SynMemberKind.PropertySet ->
WordL.keywordWith ^^ WordL.keywordSet
| _ ->
emptyL
(tysL |> addColonL) --- bracketL (stat ++ (nameL |> addColonL) --- sigL --- getterSetterL)
/// Layout a unit of measure expression
and layoutMeasure denv unt =
let sortVars vs = vs |> List.sortBy (fun (tp: Typar, _) -> tp.DisplayName)
let sortCons cs = cs |> List.sortBy (fun (tcref: TyconRef, _) -> tcref.DisplayName)
let negvs, posvs = ListMeasureVarOccsWithNonZeroExponents unt |> sortVars |> List.partition (fun (_, e) -> SignRational e < 0)
let negcs, poscs = ListMeasureConOccsWithNonZeroExponents denv.g false unt |> sortCons |> List.partition (fun (_, e) -> SignRational e < 0)
let unparL uv = layoutTyparRef denv uv
let unconL tc = layoutTyconRef denv tc
let rationalL e = wordL (tagNumericLiteral (RationalToString e))
let measureToPowerL x e = if e = OneRational then x else x -- wordL (tagPunctuation "^") -- rationalL e
let prefix = spaceListL (List.map (fun (v, e) -> measureToPowerL (unparL v) e) posvs @
List.map (fun (c, e) -> measureToPowerL (unconL c) e) poscs)
let postfix = spaceListL (List.map (fun (v, e) -> measureToPowerL (unparL v) (NegRational e)) negvs @
List.map (fun (c, e) -> measureToPowerL (unconL c) (NegRational e)) negcs)
match (negvs, negcs) with
| [], [] -> (match posvs, poscs with [], [] -> wordL (tagNumericLiteral "1") | _ -> prefix)
| _ -> prefix ^^ sepL (tagPunctuation "/") ^^ (if List.length negvs + List.length negcs > 1 then SepL.leftParen ^^ postfix ^^ SepL.rightParen else postfix)
/// Layout type arguments, either NAME<ty, ..., ty> or (ty, ..., ty) NAME *)
and layoutTypeAppWithInfoAndPrec denv env tcL prec prefix argTys =
if prefix then
match argTys with
| [] -> tcL
| [argTy] -> tcL ^^ SepL.leftAngle ^^ (layoutTypeWithInfoAndPrec denv env 4 argTy) ^^ RightL.rightAngle
| _ -> bracketIfL (prec <= 1) (tcL ^^ angleL (layoutTypesWithInfoAndPrec denv env 2 SepL.comma argTys))
else
match argTys with
| [] -> tcL
| [arg] -> layoutTypeWithInfoAndPrec denv env 2 arg ^^ tcL
| args -> bracketIfL (prec <= 1) (bracketL (layoutTypesWithInfoAndPrec denv env 2 SepL.comma args) --- tcL)
/// Layout a type, taking precedence into account to insert brackets where needed
and layoutTypeWithInfoAndPrec denv env prec ty =
let g = denv.g
match stripTyparEqns ty with
// Always prefer to format 'byref<ty, ByRefKind.In>' as 'inref<ty>'
| ty when isInByrefTy g ty && (match ty with TType_app (tc, _, _) when g.inref_tcr.CanDeref && tyconRefEq g tc g.byref2_tcr -> true | _ -> false) ->
layoutTypeWithInfoAndPrec denv env prec (mkInByrefTy g (destByrefTy g ty))
// Always prefer to format 'byref<ty, ByRefKind.Out>' as 'outref<ty>'
| ty when isOutByrefTy g ty && (match ty with TType_app (tc, _, _) when g.outref_tcr.CanDeref && tyconRefEq g tc g.byref2_tcr -> true | _ -> false) ->
layoutTypeWithInfoAndPrec denv env prec (mkOutByrefTy g (destByrefTy g ty))
// Always prefer to format 'byref<ty, ByRefKind.InOut>' as 'byref<ty>'
| ty when isByrefTy g ty && (match ty with TType_app (tc, _, _) when g.byref_tcr.CanDeref && tyconRefEq g tc g.byref2_tcr -> true | _ -> false) ->
layoutTypeWithInfoAndPrec denv env prec (mkByrefTy g (destByrefTy g ty))
// Always prefer 'float' to 'float<1>'
| TType_app (tc, args, _) when tc.IsMeasureableReprTycon && List.forall (isDimensionless g) args ->
layoutTypeWithInfoAndPrec denv env prec (reduceTyconRefMeasureableOrProvided g tc args)
// Layout a type application
| TType_ucase (UnionCaseRef(tc, _), args)
| TType_app (tc, args, _) ->
let prefix = usePrefix denv tc
let demangledCompilationPathOpt, args =
if not denv.includeStaticParametersInTypeNames then
None, args
else
let regex = System.Text.RegularExpressions.Regex(@"\`\d+")
let path, skip =
(0, tc.CompilationPath.DemangledPath)
||> List.mapFold (fun skip path ->
// Verify the path does not contain a generic parameter count.
// For example Foo`3 indicates that there are three parameters in args that belong to this path.
let m = regex.Match(path)
if not m.Success then
path, skip
else
let take = m.Value.Replace("`", "") |> int
let genericArgs =
List.skip skip args
|> List.take take
|> List.map (layoutTypeWithInfoAndPrec denv env prec >> showL)
|> String.concat ","
|> sprintf "<%s>"
String.Concat(path.Substring(0, m.Index), genericArgs), (skip + take)
)
Some path, List.skip skip args
layoutTypeAppWithInfoAndPrec
denv
env
(layoutTyconRefImpl false denv tc demangledCompilationPathOpt)
prec
prefix
args
// Layout a tuple type
| TType_anon (anonInfo, tys) ->
let core = sepListL RightL.semicolon (List.map2 (fun nm ty -> wordL (tagField nm) ^^ RightL.colon ^^ layoutTypeWithInfoAndPrec denv env prec ty) (Array.toList anonInfo.SortedNames) tys)
if evalAnonInfoIsStruct anonInfo then
WordL.keywordStruct --- braceBarL core
else
braceBarL core
// Layout a tuple type
| TType_tuple (tupInfo, t) ->
let elsL = layoutTypesWithInfoAndPrec denv env 2 (wordL (tagPunctuation "*")) t
if evalTupInfoIsStruct tupInfo then
WordL.keywordStruct --- bracketL elsL
else
bracketIfL (prec <= 2) elsL
// Layout a first-class generic type.
| TType_forall (tps, tau) ->
let tauL = layoutTypeWithInfoAndPrec denv env prec tau
match tps with
| [] -> tauL
| [h] -> layoutTyparRefWithInfo denv env h ^^ rightL dot --- tauL
| h :: t -> spaceListL (List.map (layoutTyparRefWithInfo denv env) (h :: t)) ^^ rightL dot --- tauL
| TType_fun _ ->
let argTys, retTy = stripFunTy g ty
let retTyL = layoutTypeWithInfoAndPrec denv env 5 retTy
let argTysL = argTys |> List.map (layoutTypeWithInfoAndPrec denv env 4)
let funcTyL = curriedLayoutsL arrow argTysL retTyL
bracketIfL (prec <= 4) funcTyL
// Layout a type variable .
| TType_var (r, _) ->
layoutTyparRefWithInfo denv env r
| TType_measure unt -> layoutMeasure denv unt
/// Layout a list of types, separated with the given separator, either '*' or ','
and layoutTypesWithInfoAndPrec denv env prec sep typl =
sepListL sep (List.map (layoutTypeWithInfoAndPrec denv env prec) typl)
and layoutReturnType denv env retTy = layoutTypeWithInfoAndPrec denv env 4 retTy