Skip to content

F
fsharp

dotNET Platform / fsharp
11 个月 前同步成功

通知 0
Star 1
Fork 0
F
fsharp

体验新版 GitCode，发现更多精彩内容 >>

提交 2c6e3b6d 编写于 作者: D Don Syme
浏览文件
操作

hide representations in Abstract IL

上级 a8d21e57
展开全部 隐藏空白更改
内联 并排
Showing with 1149 addition and 1083 deletion
src/absil/il.fs
浏览文件 @ 2c6e3b6d
此差异已折叠。
src/absil/il.fsi
浏览文件 @ 2c6e3b6d
此差异已折叠。
src/absil/ilmorph.fs
浏览文件 @ 2c6e3b6d
......@@ -155,8 +155,8 @@ let cattrs_typ2typ ilg f (cs: ILAttributes) =
mkILCustomAttrs (List.map (cattr_typ2typ ilg f) cs.AsList)
let fdef_typ2typ ilg ftype (fd: ILFieldDef) =
{fd with Type=ftype fd.Type;
CustomAttrs=cattrs_typ2typ ilg ftype fd.CustomAttrs}
fd.With(fieldType=ftype fd.FieldType,
customAttrs=cattrs_typ2typ ilg ftype fd.CustomAttrs)
let local_typ2typ f (l: ILLocal) = {l with Type = f l.Type}
let varargs_typ2typ f (varargs: ILVarArgs) = Option.map (List.map f) varargs
......@@ -225,16 +225,15 @@ let morphILMethodBody (filmbody) (x: ILLazyMethodBody) =
let ospec_typ2typ f (OverridesSpec(mref,ty)) = OverridesSpec(mref_typ2typ f mref, f ty)
let mdef_typ2typ_ilmbody2ilmbody ilg fs md =
let mdef_typ2typ_ilmbody2ilmbody ilg fs (md: ILMethodDef) =
let (ftype,filmbody) = fs
let ftype' = ftype (Some md)
let body' = morphILMethodBody (filmbody (Some md)) md.mdBody
{md with
GenericParams=gparams_typ2typ ftype' md.GenericParams;
mdBody= body';
Parameters = List.map (param_typ2typ ilg ftype') md.Parameters;
Return = return_typ2typ ilg ftype' md.Return;
CustomAttrs=cattrs_typ2typ ilg ftype' md.CustomAttrs }
let body' = morphILMethodBody (filmbody (Some md)) md.Body
md.With(genericParams=gparams_typ2typ ftype' md.GenericParams,
body= body',
parameters = List.map (param_typ2typ ilg ftype') md.Parameters,
ret = return_typ2typ ilg ftype' md.Return,
customAttrs=cattrs_typ2typ ilg ftype' md.CustomAttrs)
let fdefs_typ2typ ilg f x = fdefs_fdef2fdef (fdef_typ2typ ilg f) x
......@@ -244,44 +243,41 @@ let mimpl_typ2typ f e =
{ Overrides = ospec_typ2typ f e.Overrides;
OverrideBy = mspec_typ2typ (f,(fun _ -> f)) e.OverrideBy; }
let edef_typ2typ ilg f e =
{ e with
Type = Option.map f e.Type;
AddMethod = mref_typ2typ f e.AddMethod;
RemoveMethod = mref_typ2typ f e.RemoveMethod;
FireMethod = Option.map (mref_typ2typ f) e.FireMethod;
OtherMethods = List.map (mref_typ2typ f) e.OtherMethods;
CustomAttrs = cattrs_typ2typ ilg f e.CustomAttrs }
let pdef_typ2typ ilg f p =
{ p with
SetMethod = Option.map (mref_typ2typ f) p.SetMethod;
GetMethod = Option.map (mref_typ2typ f) p.GetMethod;
Type = f p.Type;
Args = List.map f p.Args;
CustomAttrs = cattrs_typ2typ ilg f p.CustomAttrs }
let edef_typ2typ ilg f (e: ILEventDef) =
e.With(eventType = Option.map f e.EventType,
addMethod = mref_typ2typ f e.AddMethod,
removeMethod = mref_typ2typ f e.RemoveMethod,
fireMethod = Option.map (mref_typ2typ f) e.FireMethod,
otherMethods = List.map (mref_typ2typ f) e.OtherMethods,
customAttrs = cattrs_typ2typ ilg f e.CustomAttrs)
let pdef_typ2typ ilg f (p: ILPropertyDef) =
p.With(setMethod = Option.map (mref_typ2typ f) p.SetMethod,
getMethod = Option.map (mref_typ2typ f) p.GetMethod,
propertyType = f p.PropertyType,
args = List.map f p.Args,
customAttrs = cattrs_typ2typ ilg f p.CustomAttrs)
let pdefs_typ2typ ilg f (pdefs: ILPropertyDefs) = mkILProperties (List.map (pdef_typ2typ ilg f) pdefs.AsList)
let edefs_typ2typ ilg f (edefs: ILEventDefs) = mkILEvents (List.map (edef_typ2typ ilg f) edefs.AsList)
let mimpls_typ2typ f (mimpls : ILMethodImplDefs) = mkILMethodImpls (List.map (mimpl_typ2typ f) mimpls.AsList)
let rec tdef_typ2typ_ilmbody2ilmbody_mdefs2mdefs ilg enc fs td =
let rec tdef_typ2typ_ilmbody2ilmbody_mdefs2mdefs ilg enc fs (td: ILTypeDef) =
let (ftype,fmdefs) = fs
let ftype' = ftype (Some (enc,td)) None
let mdefs' = fmdefs (enc,td) td.Methods
let fdefs' = fdefs_typ2typ ilg ftype' td.Fields
{td with Implements= List.map ftype' td.Implements;
GenericParams= gparams_typ2typ ftype' td.GenericParams;
Extends = Option.map ftype' td.Extends;
Methods=mdefs';
NestedTypes=tdefs_typ2typ_ilmbody2ilmbody_mdefs2mdefs ilg (enc@[td]) fs td.NestedTypes;
Fields=fdefs';
MethodImpls = mimpls_typ2typ ftype' td.MethodImpls;
Events = edefs_typ2typ ilg ftype' td.Events;
Properties = pdefs_typ2typ ilg ftype' td.Properties;
CustomAttrs = cattrs_typ2typ ilg ftype' td.CustomAttrs;
}
td.With(implements= List.map ftype' td.Implements,
genericParams= gparams_typ2typ ftype' td.GenericParams,
extends = Option.map ftype' td.Extends,
methods=mdefs',
nestedTypes=tdefs_typ2typ_ilmbody2ilmbody_mdefs2mdefs ilg (enc@[td]) fs td.NestedTypes,
fields=fdefs',
methodImpls = mimpls_typ2typ ftype' td.MethodImpls,
events = edefs_typ2typ ilg ftype' td.Events,
properties = pdefs_typ2typ ilg ftype' td.Properties,
customAttrs = cattrs_typ2typ ilg ftype' td.CustomAttrs)
and tdefs_typ2typ_ilmbody2ilmbody_mdefs2mdefs ilg enc fs tdefs =
morphILTypeDefs (tdef_typ2typ_ilmbody2ilmbody_mdefs2mdefs ilg enc fs) tdefs
......
src/absil/ilprint.fs
浏览文件 @ 2c6e3b6d
......@@ -270,14 +270,14 @@ and goutput_permission _env os p =
match p with
| PermissionSet (sa,b) ->
| ILSecurityDecl (sa,b) ->
output_string os " .permissionset "
output_security_action os sa
output_string os " = ("
output_bytes os b
output_string os ")"
and goutput_security_decls env os (ps: ILPermissions) = output_seq " " (goutput_permission env) os ps.AsList
and goutput_security_decls env os (ps: ILSecurityDecls) = output_seq " " (goutput_permission env) os ps.AsList
and goutput_gparam env os (gf: ILGenericParameterDef) =
output_string os (tyvar_generator gf.Name);
......@@ -469,30 +469,30 @@ let output_custom_attr_data os data =
output_string os " = "; output_parens output_bytes os data
let goutput_custom_attr env os attr =
output_string os " .custom ";
goutput_mspec env os attr.Method;
output_string os " .custom "
goutput_mspec env os attr.Method
output_custom_attr_data os attr.Data
let goutput_custom_attrs env os (attrs : ILAttributes) =
List.iter (fun attr -> goutput_custom_attr env os attr; output_string os "\n" ) attrs.AsList
let goutput_fdef _tref env os fd =
output_string os " .field ";
let goutput_fdef _tref env os (fd: ILFieldDef) =
output_string os " .field "
match fd.Offset with Some i -> output_string os "["; output_i32 os i; output_string os "] " | None -> ()
match fd.Marshal with Some _i -> output_string os "// marshal attribute not printed\n"; | None -> ()
output_member_access os fd.Access;
output_string os " ";
if fd.IsStatic then output_string os " static ";
if fd.IsLiteral then output_string os " literal ";
if fd.IsSpecialName then output_string os " specialname rtspecialname ";
if fd.IsInitOnly then output_string os " initonly ";
if fd.NotSerialized then output_string os " notserialized ";
goutput_typ env os fd.Type;
output_string os " ";
output_id os fd.Name;
output_option output_at os fd.Data;
output_option output_field_init os fd.LiteralValue;
output_string os "\n";
output_member_access os fd.Access
output_string os " "
if fd.IsStatic then output_string os " static "
if fd.IsLiteral then output_string os " literal "
if fd.IsSpecialName then output_string os " specialname rtspecialname "
if fd.IsInitOnly then output_string os " initonly "
if fd.NotSerialized then output_string os " notserialized "
goutput_typ env os fd.FieldType
output_string os " "
output_id os fd.Name
output_option output_at os fd.Data
output_option output_field_init os fd.LiteralValue
output_string os "\n"
goutput_custom_attrs env os fd.CustomAttrs
......@@ -768,7 +768,7 @@ let goutput_ilmbody env os (il: ILMethodBody) =
output_string os ")\n"
let goutput_mbody is_entrypoint env os md =
let goutput_mbody is_entrypoint env os (md: ILMethodDef) =
if md.ImplAttributes &&& MethodImplAttributes.Native <> enum 0 then output_string os "native "
elif md.ImplAttributes &&& MethodImplAttributes.IL <> enum 0 then output_string os "cil "
else output_string os "runtime "
......@@ -779,7 +779,7 @@ let goutput_mbody is_entrypoint env os md =
output_string os " \n{ \n" ;
goutput_security_decls env os md.SecurityDecls;
goutput_custom_attrs env os md.CustomAttrs;
match md.mdBody.Contents with
match md.Body.Contents with
| MethodBody.IL il -> goutput_ilmbody env os il
| _ -> ()
if is_entrypoint then output_string os " .entrypoint";
......@@ -799,7 +799,7 @@ let goutput_mdef env os (md:ILMethodDef) =
elif md.IsConstructor then "rtspecialname"
elif md.IsStatic then
"static "^
(match md.mdBody.Contents with
(match md.Body.Contents with
MethodBody.PInvoke (attr) ->
"pinvokeimpl(\""^ attr.Where.Name^"\" as \""^ attr.Name ^"\""^
(match attr.CallingConv with
......@@ -852,7 +852,7 @@ let goutput_mdef env os (md:ILMethodDef) =
(goutput_mbody is_entrypoint menv) os md;
output_string os "\n"
let goutput_pdef env os pd =
let goutput_pdef env os (pd: ILPropertyDef) =
output_string os "property\n\tgetter: ";
(match pd.GetMethod with None -> () | Some mref -> goutput_mref env os mref);
output_string os "\n\tsetter: ";
......@@ -891,7 +891,7 @@ let goutput_mdefs env os (mdefs: ILMethodDefs) =
let goutput_pdefs env os (pdefs: ILPropertyDefs) =
List.iter (fun f -> (goutput_pdef env) os f; output_string os "\n" ) pdefs.AsList
let rec goutput_tdef (enc) env contents os cd =
let rec goutput_tdef enc env contents os (cd: ILTypeDef) =
let env = ppenv_enter_tdef cd.GenericParams env
let layout_attr,pp_layout_decls = splitTypeLayout cd.Layout
if isTypeNameForGlobalFunctions cd.Name then
......@@ -939,26 +939,26 @@ and output_init_semantics os f =
and goutput_lambdas env os lambdas =
match lambdas with
| Lambdas_forall (gf,l) ->
output_angled (goutput_gparam env) os gf;
output_string os " ";
output_angled (goutput_gparam env) os gf
output_string os " "
(goutput_lambdas env) os l
| Lambdas_lambda (ps,l) ->
output_parens (goutput_param env) os ps;
output_string os " ";
output_string os " "
(goutput_lambdas env) os l
| Lambdas_return typ -> output_string os "--> "; (goutput_typ env) os typ
and goutput_tdefs contents (enc) env os (td: ILTypeDefs) =
and goutput_tdefs contents enc env os (td: ILTypeDefs) =
List.iter (goutput_tdef enc env contents os) td.AsList
let output_ver os (a,b,c,d) =
output_string os " .ver ";
output_u16 os a;
output_string os " : ";
output_u16 os b;
output_string os " : ";
output_u16 os c;
output_string os " : ";
output_string os " .ver "
output_u16 os a
output_string os " : "
output_u16 os b
output_string os " : "
output_u16 os c
output_string os " : "
output_u16 os d
let output_locale os s = output_string os " .Locale "; output_qstring os s
......
src/absil/ilread.fs
浏览文件 @ 2c6e3b6d
......@@ -1009,7 +1009,7 @@ type ILReaderContext =
seekReadMemberRefAsMethodData : MemberRefAsMspecIdx -> VarArgMethodData
seekReadMemberRefAsFieldSpec : MemberRefAsFspecIdx -> ILFieldSpec
seekReadCustomAttr : CustomAttrIdx -> ILAttribute
seekReadSecurityDecl : SecurityDeclIdx -> ILPermission
seekReadSecurityDecl : SecurityDeclIdx -> ILSecurityDecl
seekReadTypeRef : int ->ILTypeRef
seekReadTypeRefAsType : TypeRefAsTypIdx -> ILType
readBlobHeapAsPropertySig : BlobAsPropSigIdx -> ILThisConvention * ILType * ILTypes
......@@ -1703,20 +1703,20 @@ and seekReadTypeDef ctxt toponly (idx:int) =
let mimpls = seekReadMethodImpls ctxt numtypars idx
let props = seekReadProperties ctxt numtypars idx
let events = seekReadEvents ctxt numtypars idx
{ Name=nm
GenericParams=typars
Attributes= enum<TypeAttributes>(flags)
Layout = layout
NestedTypes= nested
Implements = impls
Extends = super
Methods = mdefs
SecurityDecls = sdecls
Fields=fdefs
MethodImpls=mimpls
Events= events
Properties=props
CustomAttrs=cas }
ILTypeDef(name=nm,
genericParams=typars ,
attributes= enum<TypeAttributes>(flags),
layout = layout,
nestedTypes= nested,
implements = impls,
extends = super,
methods = mdefs,
securityDecls = sdecls,
fields=fdefs,
methodImpls=mimpls,
events= events,
properties=props,
customAttrs=cas)
Some (ns, n, cas, rest)
and seekReadTopTypeDefs ctxt () =
......@@ -1888,32 +1888,33 @@ and seekReadOptionalTypeDefOrRef ctxt numtypars boxity idx =
else Some (seekReadTypeDefOrRef ctxt numtypars boxity List.empty idx)
and seekReadField ctxt (numtypars, hasLayout) (idx:int) =
let (flags, nameIdx, typeIdx) = seekReadFieldRow ctxt idx
let nm = readStringHeap ctxt nameIdx
let isStatic = (flags &&& 0x0010) <> 0
let fd =
{ Name = nm
Type= readBlobHeapAsFieldSig ctxt numtypars typeIdx
Attributes = enum<FieldAttributes>(flags)
LiteralValue = if (flags &&& 0x8000) = 0 then None else Some (seekReadConstant ctxt (TaggedIndex(hc_FieldDef, idx)))
Marshal =
if (flags &&& 0x1000) = 0 then None else
Some (seekReadIndexedRow (ctxt.getNumRows TableNames.FieldMarshal, seekReadFieldMarshalRow ctxt,
fst, hfmCompare (TaggedIndex(hfm_FieldDef, idx)),
isSorted ctxt TableNames.FieldMarshal,
(snd >> readBlobHeapAsNativeType ctxt)))
Data =
if (flags &&& 0x0100) = 0 then None
else
let rva = seekReadIndexedRow (ctxt.getNumRows TableNames.FieldRVA, seekReadFieldRVARow ctxt,
snd, simpleIndexCompare idx, isSorted ctxt TableNames.FieldRVA, fst)
Some (rvaToData ctxt "field" rva)
Offset =
if hasLayout && not isStatic then
Some (seekReadIndexedRow (ctxt.getNumRows TableNames.FieldLayout, seekReadFieldLayoutRow ctxt,
snd, simpleIndexCompare idx, isSorted ctxt TableNames.FieldLayout, fst)) else None
CustomAttrs=seekReadCustomAttrs ctxt (TaggedIndex(hca_FieldDef, idx)) }
fd
let (flags, nameIdx, typeIdx) = seekReadFieldRow ctxt idx
let nm = readStringHeap ctxt nameIdx
let isStatic = (flags &&& 0x0010) <> 0
ILFieldDef(name = nm,
fieldType= readBlobHeapAsFieldSig ctxt numtypars typeIdx,
attributes = enum<FieldAttributes>(flags),
literalValue = (if (flags &&& 0x8000) = 0 then None else Some (seekReadConstant ctxt (TaggedIndex(hc_FieldDef, idx)))),
marshal =
(if (flags &&& 0x1000) = 0 then
None
else
Some (seekReadIndexedRow (ctxt.getNumRows TableNames.FieldMarshal, seekReadFieldMarshalRow ctxt,
fst, hfmCompare (TaggedIndex(hfm_FieldDef, idx)),
isSorted ctxt TableNames.FieldMarshal,
(snd >> readBlobHeapAsNativeType ctxt)))),
data =
(if (flags &&& 0x0100) = 0 then
None
else
let rva = seekReadIndexedRow (ctxt.getNumRows TableNames.FieldRVA, seekReadFieldRVARow ctxt,
snd, simpleIndexCompare idx, isSorted ctxt TableNames.FieldRVA, fst)
Some (rvaToData ctxt "field" rva)),
offset =
(if hasLayout && not isStatic then
Some (seekReadIndexedRow (ctxt.getNumRows TableNames.FieldLayout, seekReadFieldLayoutRow ctxt,
snd, simpleIndexCompare idx, isSorted ctxt TableNames.FieldLayout, fst)) else None),
customAttrs=seekReadCustomAttrs ctxt (TaggedIndex(hca_FieldDef, idx) ))
and seekReadFields ctxt (numtypars, hasLayout) fidx1 fidx2 =
mkILFieldsLazy
......@@ -2254,27 +2255,26 @@ and seekReadMethod ctxt numtypars (idx:int) =
let ret, ilParams = seekReadParams ctxt (retty, argtys) paramIdx endParamIdx
{ Name=nm
Attributes = enum<MethodAttributes>(flags)
ImplAttributes= enum<MethodImplAttributes>(implflags)
SecurityDecls=seekReadSecurityDecls ctxt (TaggedIndex(hds_MethodDef, idx))
IsEntryPoint= (fst ctxt.entryPointToken = TableNames.Method && snd ctxt.entryPointToken = idx)
GenericParams=seekReadGenericParams ctxt numtypars (tomd_MethodDef, idx)
CustomAttrs=seekReadCustomAttrs ctxt (TaggedIndex(hca_MethodDef, idx))
Parameters= ilParams
CallingConv=cc
Return=ret
mdBody=
if (codetype = 0x01) && pinvoke then
mkMethBodyLazyAux (notlazy MethodBody.Native)
elif pinvoke then
seekReadImplMap ctxt nm idx
elif internalcall || abstr || unmanaged || (codetype <> 0x00) then
//if codeRVA <> 0x0 then dprintn "non-IL or abstract method with non-zero RVA"
mkMethBodyLazyAux (notlazy MethodBody.Abstract)
else
seekReadMethodRVA ctxt (idx, nm, internalcall, noinline, aggressiveinline, numtypars) codeRVA
}
ILMethodDef(name=nm,
attributes = enum<MethodAttributes>(flags),
implAttributes= enum<MethodImplAttributes>(implflags),
securityDecls=seekReadSecurityDecls ctxt (TaggedIndex(hds_MethodDef, idx)),
isEntryPoint= (fst ctxt.entryPointToken = TableNames.Method && snd ctxt.entryPointToken = idx),
genericParams=seekReadGenericParams ctxt numtypars (tomd_MethodDef, idx),
customAttrs=seekReadCustomAttrs ctxt (TaggedIndex(hca_MethodDef, idx)) ,
parameters= ilParams,
callingConv=cc,
ret=ret,
body=
(if (codetype = 0x01) && pinvoke then
mkMethBodyLazyAux (notlazy MethodBody.Native)
elif pinvoke then
seekReadImplMap ctxt nm idx
elif internalcall || abstr || unmanaged || (codetype <> 0x00) then
//if codeRVA <> 0x0 then dprintn "non-IL or abstract method with non-zero RVA"
mkMethBodyLazyAux (notlazy MethodBody.Abstract)
else
seekReadMethodRVA ctxt (idx, nm, internalcall, noinline, aggressiveinline, numtypars) codeRVA))
and seekReadParams ctxt (retty, argtys) pidx1 pidx2 =
......@@ -2358,14 +2358,14 @@ and seekReadMethodSemantics ctxt id =
and seekReadEvent ctxt numtypars idx =
let (flags, nameIdx, typIdx) = seekReadEventRow ctxt idx
{ Type = seekReadOptionalTypeDefOrRef ctxt numtypars AsObject typIdx
Name = readStringHeap ctxt nameIdx
Attributes = enum<EventAttributes>(flags)
AddMethod= seekReadMethodSemantics ctxt (0x0008, TaggedIndex(hs_Event, idx))
RemoveMethod=seekReadMethodSemantics ctxt (0x0010, TaggedIndex(hs_Event, idx))
FireMethod=seekReadoptional_MethodSemantics ctxt (0x0020, TaggedIndex(hs_Event, idx))
OtherMethods = seekReadMultipleMethodSemantics ctxt (0x0004, TaggedIndex(hs_Event, idx))
CustomAttrs=seekReadCustomAttrs ctxt (TaggedIndex(hca_Event, idx)) }
ILEventDef(eventType = seekReadOptionalTypeDefOrRef ctxt numtypars AsObject typIdx,
name = readStringHeap ctxt nameIdx,
attributes = enum<EventAttributes>(flags),
addMethod= seekReadMethodSemantics ctxt (0x0008, TaggedIndex(hs_Event, idx)),
removeMethod=seekReadMethodSemantics ctxt (0x0010, TaggedIndex(hs_Event, idx)),
fireMethod=seekReadoptional_MethodSemantics ctxt (0x0020, TaggedIndex(hs_Event, idx)),
otherMethods = seekReadMultipleMethodSemantics ctxt (0x0004, TaggedIndex(hs_Event, idx)),
customAttrs=seekReadCustomAttrs ctxt (TaggedIndex(hca_Event, idx)))
(* REVIEW: can substantially reduce numbers of EventMap and PropertyMap reads by first checking if the whole table is sorted according to ILTypeDef tokens and then doing a binary chop *)
and seekReadEvents ctxt numtypars tidx =
......@@ -2398,15 +2398,15 @@ and seekReadProperty ctxt numtypars idx =
match setter with
| Some mref -> mref.CallingConv .ThisConv
| None -> cc
{ Name=readStringHeap ctxt nameIdx
CallingConv = cc2
Attributes = enum<PropertyAttributes>(flags)
SetMethod=setter
GetMethod=getter
Type=retty
Init= if (flags &&& 0x1000) = 0 then None else Some (seekReadConstant ctxt (TaggedIndex(hc_Property, idx)))
Args=argtys
CustomAttrs=seekReadCustomAttrs ctxt (TaggedIndex(hca_Property, idx)) }
ILPropertyDef(name=readStringHeap ctxt nameIdx,
callingConv = cc2,
attributes = enum<PropertyAttributes>(flags),
setMethod=setter,
getMethod=getter,
propertyType=retty,
init= (if (flags &&& 0x1000) = 0 then None else Some (seekReadConstant ctxt (TaggedIndex(hc_Property, idx)))),
args=argtys,
customAttrs=seekReadCustomAttrs ctxt (TaggedIndex(hca_Property, idx)))
and seekReadProperties ctxt numtypars tidx =
mkILPropertiesLazy
......@@ -2461,10 +2461,9 @@ and seekReadSecurityDecl ctxt (a, b) =
and seekReadSecurityDeclUncached ctxtH (SecurityDeclIdx (act, ty)) =
let ctxt = getHole ctxtH
PermissionSet ((if List.memAssoc (int act) (Lazy.force ILSecurityActionRevMap) then List.assoc (int act) (Lazy.force ILSecurityActionRevMap) else failwith "unknown security action"),
ILSecurityDecl ((if List.memAssoc (int act) (Lazy.force ILSecurityActionRevMap) then List.assoc (int act) (Lazy.force ILSecurityActionRevMap) else failwith "unknown security action"),
readBlobHeap ctxt ty)
and seekReadConstant ctxt idx =
let kind, vidx = seekReadIndexedRow (ctxt.getNumRows TableNames.Constant,
seekReadConstantRow ctxt,
......
src/absil/ilreflect.fs
浏览文件 @ 2c6e3b6d
......@@ -1474,17 +1474,12 @@ let rec buildMethodPass2 cenv tref (typB:TypeBuilder) emEnv (mdef : ILMethodDef)
let implflags = mdef.ImplAttributes
let cconv = convCallConv mdef.CallingConv
let mref = mkRefToILMethod (tref, mdef)
let emEnv = if mdef.IsEntryPoint && isNil mdef.ParameterTypes then
(* Bug 2209:
Here, we collect the entry points generated by ilxgen corresponding to the top-level effects.
Users can (now) annotate their own functions with EntryPoint attributes.
However, these user entry points functions must take string[] argument.
By only adding entry points with no arguments, we only collect the top-level effects.
*)
envAddEntryPt emEnv (typB, mdef.Name)
else
emEnv
match mdef.mdBody.Contents with
let emEnv =
if mdef.IsEntryPoint && isNil mdef.ParameterTypes then
envAddEntryPt emEnv (typB, mdef.Name)
else
emEnv
match mdef.Body.Contents with
#if !FX_RESHAPED_REFEMIT
| MethodBody.PInvoke p ->
let argtys = convTypesToArray cenv emEnv mdef.ParameterTypes
......@@ -1508,17 +1503,7 @@ let rec buildMethodPass2 cenv tref (typB:TypeBuilder) emEnv (mdef : ILMethodDef)
(* p.CharBestFit *)
(* p.NoMangle *)
let methB = typB.DefinePInvokeMethod(mdef.Name,
p.Where.Name,
p.Name,
attrs,
cconv,
rty,
null, null,
argtys,
null, null,
pcc,
pcs)
let methB = typB.DefinePInvokeMethod(mdef.Name, p.Where.Name, p.Name, attrs, cconv, rty, null, null, argtys, null, null, pcc, pcs)
methB.SetImplementationFlagsAndLog(implflags);
envBindMethodRef emEnv mref methB
#endif
......@@ -1554,7 +1539,7 @@ let rec buildMethodPass2 cenv tref (typB:TypeBuilder) emEnv (mdef : ILMethodDef)
let rec buildMethodPass3 cenv tref modB (typB:TypeBuilder) emEnv (mdef : ILMethodDef) =
let mref = mkRefToILMethod (tref, mdef)
let isPInvoke =
match mdef.mdBody.Contents with
match mdef.Body.Contents with
| MethodBody.PInvoke _p -> true
| _ -> false
match mdef.Name with
......@@ -1566,7 +1551,7 @@ let rec buildMethodPass3 cenv tref modB (typB:TypeBuilder) emEnv (mdef : ILMetho
let defineParameter (i, attr, name) = consB.DefineParameterAndLog(i+1, attr, name)
mdef.Parameters |> List.iteri (emitParameter cenv emEnv defineParameter);
// Body
emitMethodBody cenv modB emEnv consB.GetILGenerator mdef.Name mdef.mdBody;
emitMethodBody cenv modB emEnv consB.GetILGenerator mdef.Name mdef.Body;
emitCustomAttrs cenv emEnv (wrapCustomAttr consB.SetCustomAttribute) mdef.CustomAttrs;
()
| _name ->
......@@ -1587,7 +1572,7 @@ let rec buildMethodPass3 cenv tref modB (typB:TypeBuilder) emEnv (mdef : ILMetho
mdef.Parameters |> List.iteri (fun a b -> emitParameter cenv emEnv defineParameter a b);
// Body
if not isPInvoke then
emitMethodBody cenv modB emEnv methB.GetILGeneratorAndLog mdef.Name mdef.mdBody;
emitMethodBody cenv modB emEnv methB.GetILGeneratorAndLog mdef.Name mdef.Body;
let emEnv = envPopTyvars emEnv // case fold later...
emitCustomAttrs cenv emEnv methB.SetCustomAttributeAndLog mdef.CustomAttrs
......@@ -1597,11 +1582,8 @@ let rec buildMethodPass3 cenv tref modB (typB:TypeBuilder) emEnv (mdef : ILMetho
let buildFieldPass2 cenv tref (typB:TypeBuilder) emEnv (fdef : ILFieldDef) =
(*{ -Data: bytes option;
-Marshal: NativeType option; *)
let attrs = fdef.Attributes
let fieldT = convType cenv emEnv fdef.Type
let fieldT = convType cenv emEnv fdef.FieldType
let fieldB =
match fdef.Data with
| Some d -> typB.DefineInitializedData(fdef.Name, d, attrs)
......@@ -1628,11 +1610,11 @@ let buildFieldPass2 cenv tref (typB:TypeBuilder) emEnv (fdef : ILFieldDef) =
fdef.Offset |> Option.iter (fun offset -> fieldB.SetOffset(offset));
// custom attributes: done on pass 3 as they may reference attribute constructors generated on
// pass 2.
let fref = mkILFieldRef (tref, fdef.Name, fdef.Type)
let fref = mkILFieldRef (tref, fdef.Name, fdef.FieldType)
envBindFieldRef emEnv fref fieldB
let buildFieldPass3 cenv tref (_typB:TypeBuilder) emEnv (fdef : ILFieldDef) =
let fref = mkILFieldRef (tref, fdef.Name, fdef.Type)
let fref = mkILFieldRef (tref, fdef.Name, fdef.FieldType)
let fieldB = envGetFieldB emEnv fref
emitCustomAttrs cenv emEnv (wrapCustomAttr fieldB.SetCustomAttribute) fdef.CustomAttrs
......@@ -1644,7 +1626,7 @@ let buildPropertyPass2 cenv tref (typB:TypeBuilder) emEnv (prop : ILPropertyDef)
let attrs = flagsIf prop.IsRTSpecialName PropertyAttributes.RTSpecialName |||
flagsIf prop.IsSpecialName PropertyAttributes.SpecialName
let propB = typB.DefinePropertyAndLog(prop.Name, attrs, convType cenv emEnv prop.Type, convTypesToArray cenv emEnv prop.Args)
let propB = typB.DefinePropertyAndLog(prop.Name, attrs, convType cenv emEnv prop.PropertyType, convTypesToArray cenv emEnv prop.Args)
prop.SetMethod |> Option.iter (fun mref -> propB.SetSetMethod(envGetMethB emEnv mref));
prop.GetMethod |> Option.iter (fun mref -> propB.SetGetMethod(envGetMethB emEnv mref));
......@@ -1667,8 +1649,8 @@ let buildPropertyPass3 cenv tref (_typB:TypeBuilder) emEnv (prop : ILPropertyDef
let buildEventPass3 cenv (typB:TypeBuilder) emEnv (eventDef : ILEventDef) =
let attrs = flagsIf eventDef.IsSpecialName EventAttributes.SpecialName |||
flagsIf eventDef.IsRTSpecialName EventAttributes.RTSpecialName
assert eventDef.Type.IsSome
let eventB = typB.DefineEventAndLog(eventDef.Name, attrs, convType cenv emEnv eventDef.Type.Value)
assert eventDef.EventType.IsSome
let eventB = typB.DefineEventAndLog(eventDef.Name, attrs, convType cenv emEnv eventDef.EventType.Value)
eventDef.AddMethod |> (fun mref -> eventB.SetAddOnMethod(envGetMethB emEnv mref));
eventDef.RemoveMethod |> (fun mref -> eventB.SetRemoveOnMethod(envGetMethB emEnv mref));
......@@ -1911,33 +1893,33 @@ let verbose2 = false
let createTypeRef (visited : Dictionary<_, _>, created : Dictionary<_, _>) emEnv tref =
let rec traverseTypeDef (tref:ILTypeRef) (tdef:ILTypeDef) =
if verbose2 then dprintf "buildTypeDefPass4: Creating Enclosing Types of %s\n" tdef.Name;
if verbose2 then dprintf "buildTypeDefPass4: Creating Enclosing Types of %s\n" tdef.Name
for enc in getEnclosingTypeRefs tref do
traverseTypeRef enc
// WORKAROUND (ProductStudio FSharp 1.0 bug 615): the constraints on generic method parameters
// are resolved overly eagerly by reflection emit's CreateType.
if verbose2 then dprintf "buildTypeDefPass4: Doing type typar constraints of %s\n" tdef.Name;
if verbose2 then dprintf "buildTypeDefPass4: Doing type typar constraints of %s\n" tdef.Name
for gp in tdef.GenericParams do
for cx in gp.Constraints do
traverseType CollectTypes.All cx
if verbose2 then dprintf "buildTypeDefPass4: Doing method constraints of %s\n" tdef.Name;
if verbose2 then dprintf "buildTypeDefPass4: Doing method constraints of %s\n" tdef.Name
for md in tdef.Methods.AsList do
for gp in md.GenericParams do
for cx in gp.Constraints do
traverseType CollectTypes.All cx
// We absolutely need the exact parent type...
if verbose2 then dprintf "buildTypeDefPass4: Creating Super Class Chain of %s\n" tdef.Name;
if verbose2 then dprintf "buildTypeDefPass4: Creating Super Class Chain of %s\n" tdef.Name
tdef.Extends |> Option.iter (traverseType CollectTypes.All)
// We absolutely need the exact interface types...
if verbose2 then dprintf "buildTypeDefPass4: Creating Interface Chain of %s\n" tdef.Name;
if verbose2 then dprintf "buildTypeDefPass4: Creating Interface Chain of %s\n" tdef.Name
tdef.Implements |> List.iter (traverseType CollectTypes.All)
if verbose2 then dprintf "buildTypeDefPass4: Do value types in fields of %s\n" tdef.Name;
tdef.Fields.AsList |> List.iter (fun fd -> traverseType CollectTypes.ValueTypesOnly fd.Type)
if verbose2 then dprintf "buildTypeDefPass4: Do value types in fields of %s\n" tdef.Name
tdef.Fields.AsList |> List.iter (fun fd -> traverseType CollectTypes.ValueTypesOnly fd.FieldType)
if verbose2 then dprintf "buildTypeDefPass4: Done with dependencies of %s\n" tdef.Name
......
src/absil/ilwrite.fs
浏览文件 @ 2c6e3b6d
......@@ -1120,7 +1120,7 @@ and GetTypeDefAsEventMapRow cenv tidx =
SimpleIndex (TableNames.Event, cenv.eventDefs.Count + 1) |]
and GetKeyForFieldDef tidx (fd: ILFieldDef) =
FieldDefKey (tidx, fd.Name, fd.Type)
FieldDefKey (tidx, fd.Name, fd.FieldType)
and GenFieldDefPass2 cenv tidx fd =
ignore (cenv.fieldDefs.AddUniqueEntry "field" (fun (fdkey:FieldDefKey) -> fdkey.Name) (GetKeyForFieldDef tidx fd))
......@@ -1144,7 +1144,7 @@ and GenMethodDefPass2 cenv tidx md =
cenv.methodDefIdxs.[md] <- idx
and GetKeyForPropertyDef tidx (x: ILPropertyDef) =
PropKey (tidx, x.Name, x.Type, x.Args)
PropKey (tidx, x.Name, x.PropertyType, x.Args)
and GenPropertyDefPass2 cenv tidx x =
ignore (cenv.propertyDefs.AddUniqueEntry "property" (fun (PropKey (_, n, _, _)) -> n) (GetKeyForPropertyDef tidx x))
......@@ -1400,10 +1400,10 @@ and GenCustomAttrsPass3Or4 cenv hca (attrs: ILAttributes) =
attrs.AsList |> List.iter (GenCustomAttrPass3Or4 cenv hca)
// --------------------------------------------------------------------
// ILPermissionSet --> DeclSecurity rows
// ILSecurityDecl --> DeclSecurity rows
// -------------------------------------------------------------------- *)
let rec GetSecurityDeclRow cenv hds (PermissionSet (action, s)) =
let rec GetSecurityDeclRow cenv hds (ILSecurityDecl (action, s)) =
UnsharedRow
[| UShort (uint16 (List.assoc action (Lazy.force ILSecurityActionMap)))
HasDeclSecurity (fst hds, snd hds)
......@@ -2323,7 +2323,7 @@ let rec GetFieldDefAsFieldDefRow cenv env (fd: ILFieldDef) =
StringE (GetStringHeapIdx cenv fd.Name)
Blob (GetFieldDefSigAsBlobIdx cenv env fd ) |]
and GetFieldDefSigAsBlobIdx cenv env fd = GetFieldDefTypeAsBlobIdx cenv env fd.Type
and GetFieldDefSigAsBlobIdx cenv env fd = GetFieldDefTypeAsBlobIdx cenv env fd.FieldType
and GenFieldDefPass3 cenv env fd =
let fidx = AddUnsharedRow cenv TableNames.Field (GetFieldDefAsFieldDefRow cenv env fd)
......@@ -2492,7 +2492,7 @@ let GenMethodDefAsRow cenv env midx (md: ILMethodDef) =
if cenv.entrypoint <> None then failwith "duplicate entrypoint"
else cenv.entrypoint <- Some (true, midx)
let codeAddr =
(match md.mdBody.Contents with
(match md.Body.Contents with
| MethodBody.IL ilmbody ->
let addr = cenv.nextCodeAddr
let (localToken, code, seqpoints, rootScope) = GenILMethodBody md.Name cenv env ilmbody
......@@ -2563,7 +2563,7 @@ let GenMethodDefPass3 cenv env (md:ILMethodDef) =
md.CustomAttrs |> GenCustomAttrsPass3Or4 cenv (hca_MethodDef, midx)
md.SecurityDecls.AsList |> GenSecurityDeclsPass3 cenv (hds_MethodDef, midx)
md.GenericParams |> List.iteri (fun n gp -> GenGenericParamPass3 cenv env n (tomd_MethodDef, midx) gp)
match md.mdBody.Contents with
match md.Body.Contents with
| MethodBody.PInvoke attr ->
let flags =
begin match attr.CallingConv with
......@@ -2616,12 +2616,12 @@ let GenPropertyMethodSemanticsPass3 cenv pidx kind mref =
let rec GetPropertySigAsBlobIdx cenv env prop =
GetBytesAsBlobIdx cenv (GetPropertySigAsBytes cenv env prop)
and GetPropertySigAsBytes cenv env prop =
and GetPropertySigAsBytes cenv env (prop: ILPropertyDef) =
emitBytesViaBuffer (fun bb ->
let b = ((hasthisToByte prop.CallingConv) ||| e_IMAGE_CEE_CS_CALLCONV_PROPERTY)
bb.EmitByte b
bb.EmitZ32 prop.Args.Length
EmitType cenv env bb prop.Type
EmitType cenv env bb prop.PropertyType
prop.Args |> List.iter (EmitType cenv env bb))
and GetPropertyAsPropertyRow cenv env (prop:ILPropertyDef) =
......@@ -2658,7 +2658,7 @@ let rec GenEventMethodSemanticsPass3 cenv eidx kind mref =
/// ILEventDef --> Event Row + MethodSemantics entries
and GenEventAsEventRow cenv env (md: ILEventDef) =
let flags = md.Attributes
let tdorTag, tdorRow = GetTypeOptionAsTypeDefOrRef cenv env md.Type
let tdorTag, tdorRow = GetTypeOptionAsTypeDefOrRef cenv env md.EventType
UnsharedRow
[| UShort (uint16 flags)
StringE (GetStringHeapIdx cenv md.Name)
......
src/absil/ilx.fs
浏览文件 @ 2c6e3b6d
......@@ -22,7 +22,7 @@ let mkLowerName (nm: string) =
type IlxUnionField(fd: ILFieldDef) =
let lowerName = mkLowerName fd.Name
member x.ILField = fd
member x.Type = x.ILField.Type
member x.Type = x.ILField.FieldType
member x.Name = x.ILField.Name
member x.LowerName = lowerName
......
src/fsharp/IlxGen.fs
浏览文件 @ 2c6e3b6d
此差异已折叠。
src/fsharp/IlxGen.fsi
浏览文件 @ 2c6e3b6d
......@@ -89,7 +89,7 @@ type public IlxAssemblyGenerator =
member GenerateCode : IlxGenOptions * TypedAssemblyAfterOptimization * Attribs * Attribs -> IlxGenResults
/// Create the CAS permission sets for an assembly fragment
member CreatePermissionSets : Attrib list -> ILPermission list
member CreatePermissionSets : Attrib list -> ILSecurityDecl list
/// Invert the compilation of the given value and clear the storage of the value
member ClearGeneratedValue : ExecutionContext * Val -> unit
......
src/fsharp/NicePrint.fs
浏览文件 @ 2c6e3b6d
......@@ -260,7 +260,7 @@ module private PrintIL =
let staticL = if f.IsStatic then WordL.keywordStatic else emptyL
let name = adjustILName f.Name
let nameL = wordL (tagField name)
let typL = layoutILType denv ilTyparSubst f.Type
let typL = layoutILType denv ilTyparSubst f.FieldType
staticL ^^ WordL.keywordVal ^^ nameL ^^ WordL.colon ^^ typL
let private layoutILEventDef denv ilTyparSubst (e: ILEventDef) =
......@@ -268,7 +268,7 @@ module private PrintIL =
let name = adjustILName e.Name
let nameL = wordL (tagEvent name)
let typL =
match e.Type with
match e.EventType with
| Some t -> layoutILType denv ilTyparSubst t
| _ -> emptyL
staticL ^^ WordL.keywordEvent ^^ nameL ^^ WordL.colon ^^ typL
......@@ -295,16 +295,16 @@ module private PrintIL =
let typL =
match p.GetMethod, p.SetMethod with
| None, None -> layoutILType denv ilTyparSubst p.Type // shouldn't happen
| Some getterRef, _ -> layoutGetterType getterRef
| None, Some setterRef -> layoutSetterType setterRef
| None, None -> layoutILType denv ilTyparSubst p.PropertyType // shouldn't happen
| Some getterRef, _ -> layoutGetterType getterRef
| None, Some setterRef -> layoutSetterType setterRef
let specGetSetL =
match p.GetMethod, p.SetMethod with
| None,None
| Some _, None -> emptyL
| None, Some _ -> WordL.keywordWith ^^ WordL.keywordSet
| Some _, Some _ -> WordL.keywordWith ^^ WordL.keywordGet ^^ RightL.comma ^^ WordL.keywordSet
| None,None
| Some _, None -> emptyL
| None, Some _ -> WordL.keywordWith ^^ WordL.keywordSet
| Some _, Some _ -> WordL.keywordWith ^^ WordL.keywordGet ^^ RightL.comma ^^ WordL.keywordSet
staticL ^^ WordL.keywordMember ^^ nameL ^^ WordL.colon ^^ typL ^^ specGetSetL
let layoutILFieldInit x =
......
src/fsharp/TcGlobals.fs
浏览文件 @ 2c6e3b6d
......@@ -719,9 +719,9 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d
| res -> res
mkILCustomAttrs (attrs.AsList @ attribs)
let addMethodGeneratedAttrs (mdef:ILMethodDef) = {mdef with CustomAttrs = addGeneratedAttrs mdef.CustomAttrs}
let addPropertyGeneratedAttrs (pdef:ILPropertyDef) = {pdef with CustomAttrs = addGeneratedAttrs pdef.CustomAttrs}
let addFieldGeneratedAttrs (fdef:ILFieldDef) = {fdef with CustomAttrs = addGeneratedAttrs fdef.CustomAttrs}
let addMethodGeneratedAttrs (mdef:ILMethodDef) = mdef.With(customAttrs = addGeneratedAttrs mdef.CustomAttrs)
let addPropertyGeneratedAttrs (pdef:ILPropertyDef) = pdef.With(customAttrs = addGeneratedAttrs pdef.CustomAttrs)
let addFieldGeneratedAttrs (fdef:ILFieldDef) = fdef.With(customAttrs = addGeneratedAttrs fdef.CustomAttrs)
let tref_DebuggerBrowsableAttribute n =
let typ_DebuggerBrowsableState =
......@@ -738,8 +738,8 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d
| Some res -> res
let addNeverAttrs (attrs: ILAttributes) = mkILCustomAttrs (attrs.AsList @ [mkDebuggerBrowsableNeverAttribute()])
let addPropertyNeverAttrs (pdef:ILPropertyDef) = {pdef with CustomAttrs = addNeverAttrs pdef.CustomAttrs}
let addFieldNeverAttrs (fdef:ILFieldDef) = {fdef with CustomAttrs = addNeverAttrs fdef.CustomAttrs}
let addPropertyNeverAttrs (pdef:ILPropertyDef) = pdef.With(customAttrs = addNeverAttrs pdef.CustomAttrs)
let addFieldNeverAttrs (fdef:ILFieldDef) = fdef.With(customAttrs = addNeverAttrs fdef.CustomAttrs)
let mkDebuggerTypeProxyAttribute (ty : ILType) = mkILCustomAttribute ilg (findSysILTypeRef tname_DebuggerTypeProxyAttribute, [ilg.typ_Type], [ILAttribElem.TypeRef (Some ty.TypeRef)], [])
let betterTyconEntries =
......
src/fsharp/fsc.fs
浏览文件 @ 2c6e3b6d
......@@ -1188,14 +1188,14 @@ module StaticLinker =
TypeDefs =
mkILTypeDefs
([ for td in fakeModule.TypeDefs do
yield {td with
Methods =
td.Methods.AsList
|> List.map (fun md ->
{md with CustomAttrs =
mkILCustomAttrs (td.CustomAttrs.AsList |> List.filter (fun ilattr ->
ilattr.Method.DeclaringType.TypeRef.FullName <> "System.Runtime.TargetedPatchingOptOutAttribute") )})
|> mkILMethods } ])}
let meths = td.Methods.AsList
|> List.map (fun md ->
md.With(customAttrs =
mkILCustomAttrs (td.CustomAttrs.AsList |> List.filter (fun ilattr ->
ilattr.Method.DeclaringType.TypeRef.FullName <> "System.Runtime.TargetedPatchingOptOutAttribute"))))
|> mkILMethods
let td = td.With(methods=meths)
yield td.With(methods=meths) ])}
//ILAsciiWriter.output_module stdout fakeModule
fakeModule.TypeDefs.AsList
......@@ -1416,9 +1416,8 @@ module StaticLinker =
| ILTypeDefAccess.Private -> ILTypeDefAccess.Nested ILMemberAccess.Private
| _ -> ilOrigTypeDef.Access)
else ilOrigTypeDef
{ ilOrigTypeDef with
Name = ilTgtTyRef.Name
NestedTypes = mkILTypeDefs (List.map buildRelocatedGeneratedType ch) }
ilOrigTypeDef.With(name = ilTgtTyRef.Name,
nestedTypes = mkILTypeDefs (List.map buildRelocatedGeneratedType ch))
else
// If there is no matching IL type definition, then make a simple container class
if debugStaticLinking then printfn "Generating simple class '%s' because we didn't find an original type '%s' in a provider generated assembly" ilTgtTyRef.QualifiedName ilOrigTyRef.QualifiedName
......@@ -1452,7 +1451,7 @@ module StaticLinker =
(ltdefs, fresh, rtdefs)
| (ltdefs, Some htd, rtdefs) ->
(ltdefs, htd, rtdefs)
let htd = { htd with NestedTypes = implantTypeDef true htd.NestedTypes t td }
let htd = htd.With(nestedTypes = implantTypeDef true htd.NestedTypes t td)
mkILTypeDefs (ltdefs @ [htd] @ rtdefs)
let newTypeDefs =
......@@ -1471,7 +1470,7 @@ module StaticLinker =
let ilOrigTyRef = mkILNestedTyRef (ilOrigScopeRef, enc, tdef.Name)
if not (ilOrigTyRefsForProviderGeneratedTypesToRelocate.ContainsKey ilOrigTyRef) then
if debugStaticLinking then printfn "Keep provided type %s in place because it wasn't relocated" ilOrigTyRef.QualifiedName
yield { tdef with NestedTypes = rw (enc@[tdef.Name]) tdef.NestedTypes } ]
yield tdef.With(nestedTypes = rw (enc@[tdef.Name]) tdef.NestedTypes) ]
rw [] ilModule.TypeDefs
(ccu, { ilModule with TypeDefs = ilTypeDefsAfterRemovingRelocatedTypes }))
......
src/fsharp/infos.fs
浏览文件 @ 2c6e3b6d
......@@ -1676,7 +1676,7 @@ type ILFieldInfo =
/// Get the type of the field as an IL type
member x.ILFieldType =
match x with
| ILFieldInfo (_,fdef) -> fdef.Type
| ILFieldInfo (_,fdef) -> fdef.FieldType
#if !NO_EXTENSIONTYPING
| ProvidedField(amap,fi,m) -> Import.ImportProvidedTypeAsILType amap m (fi.PApply((fun fi -> fi.FieldType),m))
#endif
......@@ -1684,7 +1684,7 @@ type ILFieldInfo =
/// Get the type of the field as an F# type
member x.FieldType(amap,m) =
match x with
| ILFieldInfo (tinfo,fdef) -> ImportILTypeFromMetadata amap m tinfo.ILScopeRef tinfo.TypeInstOfRawMetadata [] fdef.Type
| ILFieldInfo (tinfo,fdef) -> ImportILTypeFromMetadata amap m tinfo.ILScopeRef tinfo.TypeInstOfRawMetadata [] fdef.FieldType
#if !NO_EXTENSIONTYPING
| ProvidedField(amap,fi,m) -> Import.ImportProvidedType amap m (fi.PApply((fun fi -> fi.FieldType),m))
#endif
......@@ -1848,7 +1848,7 @@ type ILPropInfo =
/// Any type parameters of the enclosing type are instantiated in the type returned.
member x.GetPropertyType (amap,m) =
let (ILPropInfo (tinfo,pdef)) = x
ImportILTypeFromMetadata amap m tinfo.ILScopeRef tinfo.TypeInstOfRawMetadata [] pdef.Type
ImportILTypeFromMetadata amap m tinfo.ILScopeRef tinfo.TypeInstOfRawMetadata [] pdef.PropertyType
override x.ToString() = x.ILTypeInfo.ToString() + "::" + x.PropertyName
......@@ -2405,8 +2405,8 @@ type EventInfo =
| ILEvent(ILEventInfo(tinfo,edef)) ->
// Get the delegate type associated with an IL event, taking into account the instantiation of the
// declaring type.
if Option.isNone edef.Type then error (nonStandardEventError x.EventName m)
ImportILTypeFromMetadata amap m tinfo.ILScopeRef tinfo.TypeInstOfRawMetadata [] edef.Type.Value
if Option.isNone edef.EventType then error (nonStandardEventError x.EventName m)
ImportILTypeFromMetadata amap m tinfo.ILScopeRef tinfo.TypeInstOfRawMetadata [] edef.EventType.Value
| FSEvent(g,p,_,_) ->
FindDelegateTypeOfPropertyEvent g amap x.EventName m (p.GetPropertyType(amap,m))
......
src/ilx/EraseClosures.fs
浏览文件 @ 2c6e3b6d
......@@ -123,8 +123,8 @@ type cenv =
addFieldNeverAttrs: ILFieldDef -> ILFieldDef
addMethodGeneratedAttrs: ILMethodDef -> ILMethodDef }
let addMethodGeneratedAttrsToTypeDef cenv tdef =
{ tdef with Methods = tdef.Methods.AsList |> List.map (fun md -> md |> cenv.addMethodGeneratedAttrs) |> mkILMethods }
let addMethodGeneratedAttrsToTypeDef cenv (tdef: ILTypeDef) =
tdef.With(methods = (tdef.Methods.AsList |> List.map (fun md -> md |> cenv.addMethodGeneratedAttrs) |> mkILMethods))
let newIlxPubCloEnv(ilg, addMethodGeneratedAttrs, addFieldGeneratedAttrs, addFieldNeverAttrs) =
{ ilg = ilg
......@@ -314,8 +314,8 @@ let convMethodBody thisClo = function
| x -> x
let convMethodDef thisClo (md: ILMethodDef) =
let b' = convMethodBody thisClo (md.mdBody.Contents)
{md with mdBody=mkMethBodyAux b'}
let b' = convMethodBody thisClo (md.Body.Contents)
md.With(body=mkMethBodyAux b')
// --------------------------------------------------------------------
// Make fields for free variables of a type abstraction.
......@@ -428,8 +428,7 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo =
let laterCode = rewriteCodeToAccessArgsFromEnv laterCloSpec [(0, selfFreeVar)]
let laterTypeDefs =
convIlxClosureDef cenv encl
{td with GenericParams=laterGenericParams
Name=laterTypeName}
(td.With(genericParams=laterGenericParams, name=laterTypeName))
{clo with cloStructure=laterStruct
cloFreeVars=laterFields
cloCode=notlazy laterCode}
......@@ -479,20 +478,27 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo =
|> cenv.addMethodGeneratedAttrs
let cloTypeDef =
{ Name = td.Name
GenericParams= td.GenericParams
Attributes = td.Attributes
Implements = List.empty
NestedTypes = emptyILTypeDefs
Layout=ILTypeDefLayout.Auto
Extends= Some cenv.mkILTyFuncTy
Methods= mkILMethods ([ctorMethodDef] @ [nowApplyMethDef])
Fields= mkILFields (mkILCloFldDefs cenv nowFields)
CustomAttrs=emptyILCustomAttrs
MethodImpls=emptyILMethodImpls
Properties=emptyILProperties
Events=emptyILEvents
SecurityDecls=emptyILSecurityDecls }.WithSpecialName(false).WithImport(false).WithHasSecurity(false).WithAbstract(false).WithSealed(true).WithInitSemantics(ILTypeInit.BeforeField).WithEncoding(ILDefaultPInvokeEncoding.Ansi)
ILTypeDef(name = td.Name,
genericParams= td.GenericParams,
attributes = td.Attributes,
implements = [],
nestedTypes = emptyILTypeDefs,
layout=ILTypeDefLayout.Auto,
extends= Some cenv.mkILTyFuncTy,
methods= mkILMethods ([ctorMethodDef] @ [nowApplyMethDef]) ,
fields= mkILFields (mkILCloFldDefs cenv nowFields),
customAttrs=emptyILCustomAttrs,
methodImpls=emptyILMethodImpls,
properties=emptyILProperties,
events=emptyILEvents,
securityDecls=emptyILSecurityDecls)
.WithSpecialName(false)
.WithImport(false)
.WithHasSecurity(false)
.WithAbstract(false)
.WithSealed(true)
.WithInitSemantics(ILTypeInit.BeforeField)
.WithEncoding(ILDefaultPInvokeEncoding.Ansi)
[ cloTypeDef]
// CASE 2 - Term Application
......@@ -536,8 +542,7 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo =
let laterTypeDefs =
convIlxClosureDef cenv encl
{td with GenericParams=laterGenericParams
Name=laterTypeName}
(td.With(genericParams=laterGenericParams, name=laterTypeName))
{clo with cloStructure=laterStruct
cloFreeVars=laterFields
cloCode=notlazy laterCode}
......@@ -570,20 +575,27 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo =
ILMemberAccess.Assembly)
|> cenv.addMethodGeneratedAttrs
{ Name = td.Name
GenericParams= td.GenericParams
Attributes = td.Attributes
Implements = []
Layout=ILTypeDefLayout.Auto
NestedTypes = emptyILTypeDefs
Extends= Some nowEnvParentClass
Methods= mkILMethods ([ctorMethodDef] @ [nowApplyMethDef])
Fields= mkILFields (mkILCloFldDefs cenv nowFields)
CustomAttrs=emptyILCustomAttrs
MethodImpls=emptyILMethodImpls
Properties=emptyILProperties
Events=emptyILEvents
SecurityDecls=emptyILSecurityDecls }.WithHasSecurity(false).WithSpecialName(false).WithAbstract(false).WithImport(false).WithEncoding(ILDefaultPInvokeEncoding.Ansi).WithSealed(true).WithInitSemantics(ILTypeInit.BeforeField)
ILTypeDef(name = td.Name,
genericParams= td.GenericParams,
attributes = td.Attributes,
implements = [],
layout=ILTypeDefLayout.Auto,
nestedTypes = emptyILTypeDefs,
extends= Some nowEnvParentClass,
methods= mkILMethods ([ctorMethodDef] @ [nowApplyMethDef]),
fields= mkILFields (mkILCloFldDefs cenv nowFields),
customAttrs=emptyILCustomAttrs,
methodImpls=emptyILMethodImpls,
properties=emptyILProperties,
events=emptyILEvents,
securityDecls=emptyILSecurityDecls)
.WithHasSecurity(false)
.WithSpecialName(false)
.WithAbstract(false)
.WithImport(false)
.WithEncoding(ILDefaultPInvokeEncoding.Ansi)
.WithSealed(true)
.WithInitSemantics(ILTypeInit.BeforeField)
[cloTypeDef]
......@@ -613,13 +625,12 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo =
None))
let cloTypeDef =
{ td with
Implements= td.Implements
Extends= (match td.Extends with None -> Some cenv.ilg.typ_Object | Some x -> Some(x))
Name = td.Name
GenericParams= td.GenericParams
Methods= mkILMethods (ctorMethodDef :: List.map (convMethodDef (Some nowCloSpec)) td.Methods.AsList)
Fields= mkILFields (mkILCloFldDefs cenv nowFields @ td.Fields.AsList) }
td.With(implements= td.Implements,
extends= (match td.Extends with None -> Some cenv.ilg.typ_Object | Some x -> Some(x)),
name = td.Name,
genericParams= td.GenericParams,
methods= mkILMethods (ctorMethodDef :: List.map (convMethodDef (Some nowCloSpec)) td.Methods.AsList),
fields= mkILFields (mkILCloFldDefs cenv nowFields @ td.Fields.AsList))
[cloTypeDef]
......
src/ilx/EraseUnions.fs
浏览文件 @ 2c6e3b6d
......@@ -614,15 +614,15 @@ let mkMethodsAndPropertiesForFields (addMethodGeneratedAttrs, addPropertyGenerat
let basicProps =
fields
|> Array.map (fun field ->
{ Name = adjustFieldName hasHelpers field.Name
Attributes = PropertyAttributes.None
SetMethod = None
GetMethod = Some (mkILMethRef (typ.TypeRef, ILCallingConv.Instance, "get_" + adjustFieldName hasHelpers field.Name, 0, [], field.Type))
CallingConv = ILThisConvention.Instance
Type = field.Type
Init = None
Args = []
CustomAttrs = field.ILField.CustomAttrs }
ILPropertyDef(name = adjustFieldName hasHelpers field.Name,
attributes = PropertyAttributes.None,
setMethod = None,
getMethod = Some (mkILMethRef (typ.TypeRef, ILCallingConv.Instance, "get_" + adjustFieldName hasHelpers field.Name, 0, [], field.Type)),
callingConv = ILThisConvention.Instance,
propertyType = field.Type,
init = None,
args = [],
customAttrs = field.ILField.CustomAttrs)
|> addPropertyGeneratedAttrs
)
|> Array.toList
......@@ -648,7 +648,7 @@ let convAlternativeDef (addMethodGeneratedAttrs, addPropertyGeneratedAttrs, addP
let repr = cudefRepr
// Attributes on unions get attached to the construction methods in the helpers
let addAltAttribs (mdef: ILMethodDef) = { mdef with CustomAttrs=alt.altCustomAttrs }
let addAltAttribs (mdef: ILMethodDef) = mdef.With(customAttrs=alt.altCustomAttrs)
// The stdata instruction is only ever used for the F# "List" type
//
......@@ -698,15 +698,15 @@ let convAlternativeDef (addMethodGeneratedAttrs, addPropertyGeneratedAttrs, addP
mkMethodBody(true,[],2,nonBranchingInstrsToCode
([ mkLdarg0 ] @ mkIsData ilg (true, cuspec, num)), attr))
|> addMethodGeneratedAttrs ],
[ { Name = mkTesterName altName
Attributes = PropertyAttributes.None
SetMethod = None
GetMethod = Some (mkILMethRef (baseTy.TypeRef, ILCallingConv.Instance, "get_" + mkTesterName altName, 0, [], ilg.typ_Bool))
CallingConv = ILThisConvention.Instance
Type = ilg.typ_Bool
Init = None
Args = []
CustomAttrs = emptyILCustomAttrs }
[ ILPropertyDef(name = mkTesterName altName,
attributes = PropertyAttributes.None,
setMethod = None,
getMethod = Some (mkILMethRef (baseTy.TypeRef, ILCallingConv.Instance, "get_" + mkTesterName altName, 0, [], ilg.typ_Bool)),
callingConv = ILThisConvention.Instance,
propertyType = ilg.typ_Bool,
init = None,
args = [],
customAttrs = emptyILCustomAttrs)
|> addPropertyGeneratedAttrs
|> addPropertyNeverAttrs ]
......@@ -726,15 +726,15 @@ let convAlternativeDef (addMethodGeneratedAttrs, addPropertyGeneratedAttrs, addP
let nullaryProp =
{ Name = altName
Attributes = PropertyAttributes.None
SetMethod = None
GetMethod = Some (mkILMethRef (baseTy.TypeRef, ILCallingConv.Static, "get_" + altName, 0, [], baseTy))
CallingConv = ILThisConvention.Static
Type = baseTy
Init = None
Args = []
CustomAttrs = emptyILCustomAttrs }
ILPropertyDef(name = altName,
attributes = PropertyAttributes.None,
setMethod = None,
getMethod = Some (mkILMethRef (baseTy.TypeRef, ILCallingConv.Static, "get_" + altName, 0, [], baseTy)),
callingConv = ILThisConvention.Static,
propertyType = baseTy,
init = None,
args = [],
customAttrs = emptyILCustomAttrs)
|> addPropertyGeneratedAttrs
|> addPropertyNeverAttrs
......@@ -827,15 +827,15 @@ let convAlternativeDef (addMethodGeneratedAttrs, addPropertyGeneratedAttrs, addP
let debugProxyGetterProps =
fields
|> Array.map (fun fdef ->
{ Name = fdef.Name
Attributes = PropertyAttributes.None
SetMethod = None
GetMethod = Some(mkILMethRef(debugProxyTy.TypeRef,ILCallingConv.Instance,"get_" + fdef.Name,0,[],fdef.Type))
CallingConv = ILThisConvention.Instance
Type = fdef.Type
Init = None
Args = []
CustomAttrs = fdef.ILField.CustomAttrs }
ILPropertyDef(name = fdef.Name,
attributes = PropertyAttributes.None,
setMethod = None,
getMethod = Some(mkILMethRef(debugProxyTy.TypeRef,ILCallingConv.Instance,"get_" + fdef.Name,0,[],fdef.Type)),
callingConv = ILThisConvention.Instance,
propertyType = fdef.Type,
init = None,
args = [],
customAttrs = fdef.ILField.CustomAttrs)
|> addPropertyGeneratedAttrs)
|> Array.toList
......@@ -881,7 +881,7 @@ let convAlternativeDef (addMethodGeneratedAttrs, addPropertyGeneratedAttrs, addP
| TailOrNull ->
failwith "unreachable" ],
altTy,
(basicFields |> List.map (fun fdef -> fdef.Name, fdef.Type) ),
(basicFields |> List.map (fun fdef -> fdef.Name, fdef.FieldType) ),
(if cuspec.HasHelpers = AllHelpers then ILMemberAccess.Assembly else cud.cudReprAccess))
|> addMethodGeneratedAttrs
......@@ -1039,15 +1039,15 @@ let mkClassUnionDef (addMethodGeneratedAttrs, addPropertyGeneratedAttrs, addProp
[ mkILNonGenericInstanceMethod("get_" + tagPropertyName,cud.cudHelpersAccess,[],mkILReturn tagFieldType,body)
|> addMethodGeneratedAttrs ],
[ { Name = tagPropertyName
Attributes = PropertyAttributes.None
SetMethod = None
GetMethod = Some(mkILMethRef(baseTy.TypeRef,ILCallingConv.Instance,"get_" + tagPropertyName,0,[], tagFieldType))
CallingConv = ILThisConvention.Instance
Type = tagFieldType
Init = None
Args = []
CustomAttrs = emptyILCustomAttrs }
[ ILPropertyDef(name = tagPropertyName,
attributes = PropertyAttributes.None,
setMethod = None,
getMethod = Some(mkILMethRef(baseTy.TypeRef,ILCallingConv.Instance,"get_" + tagPropertyName,0,[], tagFieldType)),
callingConv = ILThisConvention.Instance,
propertyType = tagFieldType,
init = None,
args = [],
customAttrs = emptyILCustomAttrs)
|> addPropertyGeneratedAttrs
|> addPropertyNeverAttrs ]
......@@ -1065,29 +1065,36 @@ let mkClassUnionDef (addMethodGeneratedAttrs, addPropertyGeneratedAttrs, addProp
if tagEnumFields.Length <= 1 then
None
else
Some(
{ Name = "Tags"
NestedTypes = emptyILTypeDefs
GenericParams= td.GenericParams
Attributes = enum 0
Layout=ILTypeDefLayout.Auto
Implements = []
Extends= Some ilg.typ_Object
Methods= emptyILMethods
SecurityDecls=emptyILSecurityDecls
Fields=mkILFields tagEnumFields
MethodImpls=emptyILMethodImpls
Events=emptyILEvents
Properties=emptyILProperties
CustomAttrs= emptyILCustomAttrs }.WithNestedAccess(cud.cudReprAccess).WithAbstract(true).WithSealed(true).WithImport(false).WithEncoding(ILDefaultPInvokeEncoding.Ansi).WithHasSecurity(false))
let tdef =
ILTypeDef(name = "Tags",
nestedTypes = emptyILTypeDefs,
genericParams= td.GenericParams,
attributes = enum 0,
layout=ILTypeDefLayout.Auto,
implements = [],
extends= Some ilg.typ_Object,
methods= emptyILMethods,
securityDecls=emptyILSecurityDecls,
fields=mkILFields tagEnumFields,
methodImpls=emptyILMethodImpls,
events=emptyILEvents,
properties=emptyILProperties,
customAttrs= emptyILCustomAttrs)
.WithNestedAccess(cud.cudReprAccess)
.WithAbstract(true)
.WithSealed(true)
.WithImport(false)
.WithEncoding(ILDefaultPInvokeEncoding.Ansi)
.WithHasSecurity(false)
Some tdef
let baseTypeDef =
{ td.WithInitSemantics(ILTypeInit.BeforeField) with
NestedTypes = mkILTypeDefs (Option.toList enumTypeDef @ altTypeDefs @ altDebugTypeDefs @ td.NestedTypes.AsList)
Extends= (match td.Extends with None -> Some ilg.typ_Object | _ -> td.Extends)
Methods= mkILMethods (ctorMeths @ baseMethsFromAlt @ selfMeths @ tagMeths @ altUniqObjMeths @ existingMeths)
Fields=mkILFields (selfAndTagFields @ List.map (fun (_,_,_,_,fdef,_) -> fdef) altNullaryFields @ td.Fields.AsList)
Properties=mkILProperties (tagProps @ basePropsFromAlt @ selfProps @ existingProps) }
td.WithInitSemantics(ILTypeInit.BeforeField)
.With(nestedTypes = mkILTypeDefs (Option.toList enumTypeDef @ altTypeDefs @ altDebugTypeDefs @ td.NestedTypes.AsList),
extends= (match td.Extends with None -> Some ilg.typ_Object | _ -> td.Extends),
methods= mkILMethods (ctorMeths @ baseMethsFromAlt @ selfMeths @ tagMeths @ altUniqObjMeths @ existingMeths),
fields=mkILFields (selfAndTagFields @ List.map (fun (_,_,_,_,fdef,_) -> fdef) altNullaryFields @ td.Fields.AsList),
properties=mkILProperties (tagProps @ basePropsFromAlt @ selfProps @ existingProps))
// The .cctor goes on the Cases type since that's where the constant fields for nullary constructors live
|> addConstFieldInit
......
Markdown is supported
0% 或 .
You are about to add 0 people to the discussion. Proceed with caution.
先完成此消息的编辑！
想要评论请 注册 或