@@ -33,21 +33,29 @@ type ppenv =
33
33
{ ilGlobals: ILGlobals
34
34
ppenvClassFormals: int
35
35
ppenvMethodFormals: int }
36
+
36
37
let ppenv_enter_method mgparams env =
37
38
{ env with ppenvMethodFormals= mgparams}
39
+
38
40
let ppenv_enter_tdef gparams env =
39
41
{ env with ppenvClassFormals= List.length gparams; ppenvMethodFormals= 0 }
42
+
40
43
let mk_ppenv ilg = { ilGlobals = ilg; ppenvClassFormals = 0 ; ppenvMethodFormals = 0 }
44
+
41
45
let debug_ppenv = mk_ ppenv
46
+
42
47
let ppenv_enter_modul env = { env with ppenvClassFormals= 0 ; ppenvMethodFormals= 0 }
43
48
44
49
// --------------------------------------------------------------------
45
50
// Pretty printing - output streams
46
51
// --------------------------------------------------------------------
47
52
48
53
let output_string ( os : TextWriter ) ( s : string ) = os.Write s
54
+
49
55
let output_char ( os : TextWriter ) ( c : char ) = os.Write c
56
+
50
57
let output_int os ( i : int ) = output_ string os ( string i)
58
+
51
59
let output_hex_digit os i =
52
60
assert ( i >= 0 && i < 16 )
53
61
if i > 9 then output_ char os ( char ( int32 'A' + ( i-10 )))
@@ -106,14 +114,17 @@ let output_array sep f os (a:_ []) =
106
114
f os ( a.[ a.Length - 1 ])
107
115
108
116
let output_parens f os a = output_ string os " (" ; f os a; output_ string os " )"
117
+
109
118
let output_angled f os a = output_ string os " <" ; f os a; output_ string os " >"
119
+
110
120
let output_bracks f os a = output_ string os " [" ; f os a; output_ string os " ]"
111
121
112
122
let output_id os n = output_ sqstring os n
113
123
114
124
let output_label os n = output_ string os n
115
125
116
126
let output_lid os lid = output_ seq " ." output_ string os lid
127
+
117
128
let string_of_type_name ( _ , n ) = n
118
129
119
130
let output_byte os i =
@@ -127,17 +138,27 @@ let output_bytes os (bytes:byte[]) =
127
138
128
139
129
140
let bits_of_float32 ( x : float32 ) = System.BitConverter.ToInt32( System.BitConverter.GetBytes( x), 0 )
141
+
130
142
let bits_of_float ( x : float ) = System.BitConverter.DoubleToInt64Bits( x)
131
143
132
144
let output_u8 os ( x : byte ) = output_ string os ( string ( int x))
145
+
133
146
let output_i8 os ( x : sbyte ) = output_ string os ( string ( int x))
147
+
134
148
let output_u16 os ( x : uint16 ) = output_ string os ( string ( int x))
149
+
135
150
let output_i16 os ( x : int16 ) = output_ string os ( string ( int x))
151
+
136
152
let output_u32 os ( x : uint32 ) = output_ string os ( string ( int64 x))
153
+
137
154
let output_i32 os ( x : int32 ) = output_ string os ( string x)
155
+
138
156
let output_u64 os ( x : uint64 ) = output_ string os ( string ( int64 x))
157
+
139
158
let output_i64 os ( x : int64 ) = output_ string os ( string x)
159
+
140
160
let output_ieee32 os ( x : float32 ) = output_ string os " float32 (" ; output_ string os ( string ( bits_ of_ float32 x)); output_ string os " )"
161
+
141
162
let output_ieee64 os ( x : float ) = output_ string os " float64 (" ; output_ string os ( string ( bits_ of_ float x)); output_ string os " )"
142
163
143
164
let rec goutput_scoref _env os = function
@@ -155,45 +176,45 @@ and goutput_tref env os (x:ILTypeRef) =
155
176
156
177
and goutput_typ env os ty =
157
178
match ty with
158
- | ILType.Boxed tr -> goutput_ tspec env os tr
159
- | ILType.TypeVar tv ->
179
+ | ILType.Boxed tr -> goutput_ tspec env os tr
180
+ | ILType.TypeVar tv ->
160
181
// Special rule to print method type variables in Generic EE preferred form
161
182
// when an environment is available to help us do this.
162
183
let cgparams = env.ppenvClassFormals
163
184
let mgparams = env.ppenvMethodFormals
164
185
if int tv < cgparams then
165
186
output_ string os " !"
166
187
output_ tyvar os tv
167
- elif int tv - cgparams < mgparams then
188
+ elif int tv - cgparams < mgparams then
168
189
output_ string os " !!"
169
- output_ int os ( int tv - cgparams)
190
+ output_ int os ( int tv - cgparams)
170
191
else
171
192
output_ string os " !"
172
193
output_ tyvar os tv
173
194
output_ int os ( int tv)
174
195
175
196
| ILType.Byref typ -> goutput_ typ env os typ; output_ string os " &"
176
- | ILType.Ptr typ -> goutput_ typ env os typ; output_ string os " *"
177
- | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.typ_ SByte.TypeSpec.Name -> output_ string os " int8"
178
- | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.typ_ Int16.TypeSpec.Name -> output_ string os " int16"
179
- | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.typ_ Int32.TypeSpec.Name -> output_ string os " int32"
180
- | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.typ_ Int64.TypeSpec.Name -> output_ string os " int64"
181
- | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.typ_ IntPtr.TypeSpec.Name -> output_ string os " native int"
182
- | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.typ_ Byte.TypeSpec.Name -> output_ string os " unsigned int8"
183
- | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.typ_ UInt16.TypeSpec.Name -> output_ string os " unsigned int16"
184
- | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.typ_ UInt32.TypeSpec.Name -> output_ string os " unsigned int32"
185
- | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.typ_ UInt64.TypeSpec.Name -> output_ string os " unsigned int64"
186
- | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.typ_ UIntPtr.TypeSpec.Name -> output_ string os " native unsigned int"
187
- | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.typ_ Double.TypeSpec.Name -> output_ string os " float64"
188
- | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.typ_ Single.TypeSpec.Name -> output_ string os " float32"
189
- | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.typ_ Bool.TypeSpec.Name -> output_ string os " bool"
190
- | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.typ_ Char.TypeSpec.Name -> output_ string os " char"
197
+ | ILType.Ptr typ -> goutput_ typ env os typ; output_ string os " *"
198
+ | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.typ_ SByte.TypeSpec.Name -> output_ string os " int8"
199
+ | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.typ_ Int16.TypeSpec.Name -> output_ string os " int16"
200
+ | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.typ_ Int32.TypeSpec.Name -> output_ string os " int32"
201
+ | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.typ_ Int64.TypeSpec.Name -> output_ string os " int64"
202
+ | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.typ_ IntPtr.TypeSpec.Name -> output_ string os " native int"
203
+ | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.typ_ Byte.TypeSpec.Name -> output_ string os " unsigned int8"
204
+ | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.typ_ UInt16.TypeSpec.Name -> output_ string os " unsigned int16"
205
+ | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.typ_ UInt32.TypeSpec.Name -> output_ string os " unsigned int32"
206
+ | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.typ_ UInt64.TypeSpec.Name -> output_ string os " unsigned int64"
207
+ | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.typ_ UIntPtr.TypeSpec.Name -> output_ string os " native unsigned int"
208
+ | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.typ_ Double.TypeSpec.Name -> output_ string os " float64"
209
+ | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.typ_ Single.TypeSpec.Name -> output_ string os " float32"
210
+ | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.typ_ Bool.TypeSpec.Name -> output_ string os " bool"
211
+ | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.typ_ Char.TypeSpec.Name -> output_ string os " char"
191
212
| ILType.Value tspec ->
192
213
output_ string os " value class "
193
214
goutput_ tref env os tspec.TypeRef
194
215
output_ string os " "
195
216
goutput_ gactuals env os tspec.GenericArgs
196
- | ILType.Void -> output_ string os " void"
217
+ | ILType.Void -> output_ string os " void"
197
218
| ILType.Array ( bounds, ty) ->
198
219
goutput_ typ env os ty
199
220
output_ string os " ["
@@ -253,30 +274,28 @@ and output_arr_bounds os = function
253
274
l
254
275
255
276
and goutput_permission _env os p =
256
- let output_security_action os x =
277
+ let output_security_action os x =
257
278
output_ string os
258
279
( match x with
259
- | ILSecurityAction.Request -> " request"
260
- | ILSecurityAction.Demand -> " demand"
261
- | ILSecurityAction.Assert-> " assert"
262
- | ILSecurityAction.Deny-> " deny"
263
- | ILSecurityAction.PermitOnly-> " permitonly"
264
- | ILSecurityAction.LinkCheck-> " linkcheck"
265
- | ILSecurityAction.InheritCheck-> " inheritcheck"
266
- | ILSecurityAction.ReqMin-> " reqmin"
267
- | ILSecurityAction.ReqOpt-> " reqopt"
268
- | ILSecurityAction.ReqRefuse-> " reqrefuse"
269
- | ILSecurityAction.PreJitGrant-> " prejitgrant"
270
- | ILSecurityAction.PreJitDeny-> " prejitdeny"
271
- | ILSecurityAction.NonCasDemand-> " noncasdemand"
272
- | ILSecurityAction.NonCasLinkDemand-> " noncaslinkdemand"
273
- | ILSecurityAction.NonCasInheritance-> " noncasinheritance"
280
+ | ILSecurityAction.Request -> " request"
281
+ | ILSecurityAction.Demand -> " demand"
282
+ | ILSecurityAction.Assert-> " assert"
283
+ | ILSecurityAction.Deny-> " deny"
284
+ | ILSecurityAction.PermitOnly-> " permitonly"
285
+ | ILSecurityAction.LinkCheck-> " linkcheck"
286
+ | ILSecurityAction.InheritCheck-> " inheritcheck"
287
+ | ILSecurityAction.ReqMin-> " reqmin"
288
+ | ILSecurityAction.ReqOpt-> " reqopt"
289
+ | ILSecurityAction.ReqRefuse-> " reqrefuse"
290
+ | ILSecurityAction.PreJitGrant-> " prejitgrant"
291
+ | ILSecurityAction.PreJitDeny-> " prejitdeny"
292
+ | ILSecurityAction.NonCasDemand-> " noncasdemand"
293
+ | ILSecurityAction.NonCasLinkDemand-> " noncaslinkdemand"
294
+ | ILSecurityAction.NonCasInheritance-> " noncasinheritance"
274
295
| ILSecurityAction.LinkDemandChoice -> " linkdemandchoice"
275
296
| ILSecurityAction.InheritanceDemandChoice -> " inheritancedemandchoice"
276
297
| ILSecurityAction.DemandChoice -> " demandchoice" )
277
298
278
-
279
-
280
299
match p with
281
300
| ILSecurityDecl ( sa, b) ->
282
301
output_ string os " .permissionset "
@@ -459,10 +478,10 @@ let goutput_cuspec env os (IlxUnionSpec(IlxUnionRef(_,tref,_,_,_),i)) =
459
478
let output_basic_type os x =
460
479
output_ string os
461
480
( match x with
462
- | DT_ I1 -> " i1"
463
- | DT_ U1 -> " u1"
464
- | DT_ I2 -> " i2"
465
- | DT_ U2 -> " u2"
481
+ | DT_ I1 -> " i1"
482
+ | DT_ U1 -> " u1"
483
+ | DT_ I2 -> " i2"
484
+ | DT_ U2 -> " u2"
466
485
| DT_ I4 -> " i4"
467
486
| DT_ U4 -> " u4"
468
487
| DT_ I8 -> " i8"
@@ -505,7 +524,6 @@ let goutput_fdef _tref env os (fd: ILFieldDef) =
505
524
output_ string os " \n "
506
525
goutput_ custom_ attrs env os fd.CustomAttrs
507
526
508
-
509
527
let output_alignment os = function
510
528
Aligned -> ()
511
529
| Unaligned1 -> output_ string os " unaligned. 1 "
@@ -528,18 +546,19 @@ let rec goutput_apps env os = function
528
546
output_ angled ( goutput_ gparam env) os ( mkILSimpleTypar " T" )
529
547
output_ string os " "
530
548
goutput_ apps env os cs
531
- | Apps_ app( ty, cs) ->
549
+ | Apps_ app( ty, cs) ->
532
550
output_ parens ( goutput_ typ env) os ty
533
551
output_ string os " "
534
552
goutput_ apps env os cs
535
- | Apps_ done ty ->
553
+ | Apps_ done ty ->
536
554
output_ string os " --> "
537
555
goutput_ typ env os ty
538
556
539
557
/// Print the short form of instructions
540
558
let output_short_u16 os ( x : uint16 ) =
541
559
if int x < 256 then ( output_ string os " .s " ; output_ u16 os x)
542
560
else output_ string os " " ; output_ u16 os x
561
+
543
562
let output_short_i32 os i32 =
544
563
if i32 < 256 && 0 >= i32 then ( output_ string os " .s " ; output_ i32 os i32)
545
564
else output_ string os " " ; output_ i32 os i32
@@ -553,7 +572,7 @@ let goutput_local env os (l: ILLocal) =
553
572
554
573
let goutput_param env os ( l : ILParameter ) =
555
574
match l.Name with
556
- None -> goutput_ typ env os l.Type
575
+ None -> goutput_ typ env os l.Type
557
576
| Some n -> goutput_ typ env os l.Type; output_ string os " " ; output_ sqstring os n
558
577
559
578
let goutput_params env os ps =
@@ -624,7 +643,7 @@ let rec goutput_instr env os inst =
624
643
output_ string os " ldc." ; output_ basic_ type os dt; output_ string os " " ; output_ ieee32 os x
625
644
| ( AI_ ldc ( dt, ILConst.R8 x)) ->
626
645
output_ string os " ldc." ; output_ basic_ type os dt; output_ string os " " ; output_ ieee64 os x
627
- | I_ ldftn mspec -> output_ string os " ldftn " ; goutput_ mspec env os mspec
646
+ | I_ ldftn mspec -> output_ string os " ldftn " ; goutput_ mspec env os mspec
628
647
| I_ ldvirtftn mspec -> output_ string os " ldvirtftn " ; goutput_ mspec env os mspec
629
648
| I_ ldind ( al, vol, dt) ->
630
649
output_ alignment os al
@@ -779,7 +798,6 @@ let goutput_ilmbody env os (il: ILMethodBody) =
779
798
output_ seq " ,\n " ( goutput_ local env) os il.Locals
780
799
output_ string os " )\n "
781
800
782
-
783
801
let goutput_mbody is_entrypoint env os ( md : ILMethodDef ) =
784
802
if md.ImplAttributes &&& MethodImplAttributes.Native <> enum 0 then output_ string os " native "
785
803
elif md.ImplAttributes &&& MethodImplAttributes.IL <> enum 0 then output_ string os " cil "
@@ -892,14 +910,15 @@ let output_type_layout_info os info =
892
910
893
911
let splitTypeLayout = function
894
912
| ILTypeDefLayout.Auto -> " auto" ,( fun _os () -> ())
895
- | ILTypeDefLayout.Sequential info -> " sequential" , ( fun os () -> output_ type_ layout_ info os info)
896
- | ILTypeDefLayout.Explicit info -> " explicit" , ( fun os () -> output_ type_ layout_ info os info)
897
-
913
+ | ILTypeDefLayout.Sequential info -> " sequential" , ( fun os () -> output_ type_ layout_ info os info)
914
+ | ILTypeDefLayout.Explicit info -> " explicit" , ( fun os () -> output_ type_ layout_ info os info)
898
915
899
916
let goutput_fdefs tref env os ( fdefs : ILFieldDefs ) =
900
917
List.iter ( fun f -> ( goutput_ fdef tref env) os f; output_ string os " \n " ) fdefs.AsList
918
+
901
919
let goutput_mdefs env os ( mdefs : ILMethodDefs ) =
902
920
Array.iter ( fun f -> ( goutput_ mdef env) os f; output_ string os " \n " ) mdefs.AsArray
921
+
903
922
let goutput_pdefs env os ( pdefs : ILPropertyDefs ) =
904
923
List.iter ( fun f -> ( goutput_ pdef env) os f; output_ string os " \n " ) pdefs.AsList
905
924
@@ -954,7 +973,7 @@ and goutput_lambdas env os lambdas =
954
973
output_ angled ( goutput_ gparam env) os gf
955
974
output_ string os " "
956
975
( goutput_ lambdas env) os l
957
- | Lambdas_ lambda ( ps, l) ->
976
+ | Lambdas_ lambda ( ps, l) ->
958
977
output_ parens ( goutput_ param env) os ps
959
978
output_ string os " "
960
979
( goutput_ lambdas env) os l
@@ -1046,7 +1065,7 @@ let output_module_fragment_aux _refs os (ilg: ILGlobals) modul =
1046
1065
let env = ppenv_ enter_ modul env
1047
1066
goutput_ tdefs false ([]) env os modul.TypeDefs
1048
1067
goutput_ tdefs true ([]) env os modul.TypeDefs
1049
- with e ->
1068
+ with e ->
1050
1069
output_ string os " *** Error during printing : " ; output_ string os ( e.ToString()); os.Flush()
1051
1070
reraise()
1052
1071
@@ -1078,7 +1097,7 @@ let output_module os (ilg: ILGlobals) modul =
1078
1097
output_ module_ refs os refs
1079
1098
goutput_ module_ manifest env os modul
1080
1099
output_ module_ fragment_ aux refs os ilg modul
1081
- with e ->
1100
+ with e ->
1082
1101
output_ string os " *** Error during printing : " ; output_ string os ( e.ToString()); os.Flush()
1083
1102
raise e
1084
1103
0 commit comments