From 6c56845d2b3a62cf3c47da830d4d0395ebaa7be0 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Fri, 18 Nov 2016 18:54:43 +0000 Subject: [PATCH 01/13] fsi 5 --- src/absil/il.fs | 595 ++++++++------------------- src/absil/il.fsi | 202 ++++----- src/absil/ilascii.fs | 2 +- src/absil/ilpars.fsy | 34 +- src/absil/ilprint.fs | 38 +- src/absil/ilread.fs | 24 +- src/absil/ilreflect.fs | 10 +- src/absil/ilwrite.fs | 42 +- src/absil/ilwrite.fsi | 2 +- src/fsharp/AugmentWithHashCompare.fs | 4 +- src/fsharp/CompileOps.fs | 263 +++--------- src/fsharp/CompileOps.fsi | 2 - src/fsharp/CompileOptions.fs | 1 + src/fsharp/FSComp.txt | 3 +- src/fsharp/IlxGen.fs | 40 +- src/fsharp/Optimizer.fs | 4 +- src/fsharp/QuotationTranslator.fs | 2 +- src/fsharp/TastOps.fs | 10 +- src/fsharp/TcGlobals.fs | 124 +++--- src/fsharp/TypeChecker.fs | 18 +- src/fsharp/ast.fs | 4 +- src/fsharp/fsc.fs | 17 +- src/fsharp/fsi/fsi.fs | 2 +- src/fsharp/vs/IncrementalBuild.fs | 4 +- src/ilx/EraseUnions.fs | 12 +- tests/scripts/fsci.fsx | 2 +- 26 files changed, 533 insertions(+), 928 deletions(-) diff --git a/src/absil/il.fs b/src/absil/il.fs index c0157df5194..c390b4f0895 100644 --- a/src/absil/il.fs +++ b/src/absil/il.fs @@ -48,14 +48,21 @@ let notlazy v = Lazy.CreateFromValue v let lazyMap f (x:Lazy<_>) = if x.IsValueCreated then notlazy (f (x.Force())) else lazy (f (x.Force())) +[] type PrimaryAssembly = | Mscorlib | DotNetCore + | PrivateCoreLib member this.Name = match this with | Mscorlib -> "mscorlib" | DotNetCore -> "System.Runtime" + | PrivateCoreLib -> "System.Private.CoreLib" + static member IsSomePrimaryAssembly n = + n = PrimaryAssembly.Mscorlib.Name || + n = PrimaryAssembly.DotNetCore.Name || + n = PrimaryAssembly.PrivateCoreLib.Name // -------------------------------------------------------------------- // Utilities: type names @@ -667,6 +674,30 @@ and [] member x.QualifiedNameWithNoShortPrimaryAssembly = x.AddQualifiedNameExtensionWithNoShortPrimaryAssembly(x.BasicQualifiedName) + member x.TypeSpec = + match x with + | ILType.Boxed tr | ILType.Value tr -> tr + | _ -> invalidOp "not a nominal type" + member x.Boxity = + match x with + | ILType.Boxed _ -> AsObject + | ILType.Value _ -> AsValue + | _ -> invalidOp "not a nominal type" + member x.TypeRef = + match x with + | ILType.Boxed tspec | ILType.Value tspec -> tspec.TypeRef + | _ -> invalidOp "not a nominal type" + member x.IsNominal = + match x with + | ILType.Boxed _ | ILType.Value _ -> true + | _ -> false + member x.GenericArgs = + match x with + | ILType.Boxed tspec | ILType.Value tspec -> tspec.GenericArgs + | _ -> [] + member x.IsTyvar = + match x with + | ILType.TypeVar _ -> true | _ -> false and [] ILCallingSignature = @@ -1698,32 +1729,6 @@ let mkILEmptyGenericParams = ([]: ILGenericParameterDefs) let emptyILGenericArgsList = ([ ]: ILType list) -type ILType with - member x.TypeSpec = - match x with - | ILType.Boxed tr | ILType.Value tr -> tr - | _ -> invalidOp "not a nominal type" - member x.Boxity = - match x with - | ILType.Boxed _ -> AsObject - | ILType.Value _ -> AsValue - | _ -> invalidOp "not a nominal type" - member x.TypeRef = - match x with - | ILType.Boxed tspec | ILType.Value tspec -> tspec.TypeRef - | _ -> invalidOp "not a nominal type" - member x.IsNominal = - match x with - | ILType.Boxed _ | ILType.Value _ -> true - | _ -> false - member x.GenericArgs = - match x with - | ILType.Boxed tspec | ILType.Value tspec -> tspec.GenericArgs - | _ -> [] - member x.IsTyvar = - match x with - | ILType.TypeVar _ -> true | _ -> false - // -------------------------------------------------------------------- @@ -2051,109 +2056,140 @@ let tname_RuntimeMethodHandle = "System.RuntimeMethodHandle" [] let tname_RuntimeFieldHandle = "System.RuntimeFieldHandle" -/// Represents the capabilities of target framework profile. -/// Different profiles may omit some types or contain them in different assemblies. -type IPrimaryAssemblyTraits = - - abstract TypedReferenceTypeScopeRef : ILScopeRef option - abstract RuntimeArgumentHandleTypeScopeRef : ILScopeRef option - abstract SerializationInfoTypeScopeRef : ILScopeRef option - abstract SecurityPermissionAttributeTypeScopeRef : ILScopeRef option - abstract IDispatchConstantAttributeScopeRef : ILScopeRef option - abstract IUnknownConstantAttributeScopeRef : ILScopeRef option - abstract ArgIteratorTypeScopeRef : ILScopeRef option - abstract MarshalByRefObjectScopeRef : ILScopeRef option - abstract ThreadStaticAttributeScopeRef : ILScopeRef option - abstract SpecialNameAttributeScopeRef : ILScopeRef option - abstract ContextStaticAttributeScopeRef : ILScopeRef option - abstract NonSerializedAttributeScopeRef : ILScopeRef option - - abstract SystemRuntimeInteropServicesScopeRef : Lazy - abstract SystemLinqExpressionsScopeRef : Lazy - abstract SystemCollectionsScopeRef : Lazy - abstract SystemReflectionScopeRef : Lazy - abstract SystemDiagnosticsDebugScopeRef : Lazy - abstract ScopeRef : ILScopeRef - [] -type ILGlobals = - { traits : IPrimaryAssemblyTraits - primaryAssemblyName : string - noDebugData: bool; - tref_Object: ILTypeRef - tspec_Object: ILTypeSpec - typ_Object: ILType - tref_String: ILTypeRef - typ_String: ILType - typ_StringBuilder: ILType - typ_AsyncCallback: ILType - typ_IAsyncResult: ILType - typ_IComparable: ILType - tref_Type: ILTypeRef - typ_Type: ILType - typ_Missing: Lazy - typ_Activator: ILType - typ_Delegate: ILType - typ_ValueType: ILType - typ_Enum: ILType - tspec_TypedReference: ILTypeSpec option - typ_TypedReference: ILType option - typ_MulticastDelegate: ILType - typ_Array: ILType - tspec_Int64: ILTypeSpec - tspec_UInt64: ILTypeSpec - tspec_Int32: ILTypeSpec - tspec_UInt32: ILTypeSpec - tspec_Int16: ILTypeSpec - tspec_UInt16: ILTypeSpec - tspec_SByte: ILTypeSpec - tspec_Byte: ILTypeSpec - tspec_Single: ILTypeSpec - tspec_Double: ILTypeSpec - tspec_IntPtr: ILTypeSpec - tspec_UIntPtr: ILTypeSpec - tspec_Char: ILTypeSpec - tspec_Bool: ILTypeSpec - typ_int8: ILType - typ_int16: ILType - typ_int32: ILType - typ_int64: ILType - typ_uint8: ILType - typ_uint16: ILType - typ_uint32: ILType - typ_uint64: ILType - typ_float32: ILType - typ_float64: ILType - typ_bool: ILType - typ_char: ILType - typ_IntPtr: ILType - typ_UIntPtr: ILType - typ_RuntimeArgumentHandle: ILType option - typ_RuntimeTypeHandle: ILType - typ_RuntimeMethodHandle: ILType - typ_RuntimeFieldHandle: ILType - typ_Byte: ILType - typ_Int16: ILType - typ_Int32: ILType - typ_Int64: ILType - typ_SByte: ILType - typ_UInt16: ILType - typ_UInt32: ILType - typ_UInt64: ILType - typ_Single: ILType - typ_Double: ILType - typ_Bool: ILType - typ_Char: ILType - typ_SerializationInfo: ILType option - typ_StreamingContext: ILType - tref_SecurityPermissionAttribute: ILTypeRef option - tspec_Exception: ILTypeSpec - typ_Exception: ILType - mutable generatedAttribsCache: ILAttribute list - mutable debuggerBrowsableNeverAttributeCache : ILAttribute option - mutable debuggerTypeProxyAttributeCache : ILAttribute option } +// This data structure needs an entirely delayed implementation +type ILGlobals(noDebugData, getTypeILScopeRef, tryGetTypeILScopeRef) = + + let m_mkSysILTypeRef nm = mkILTyRef(getTypeILScopeRef nm, nm) + let m_tryMkSysILTypeRef nm = match tryGetTypeILScopeRef nm with Some r -> Some(mkILTyRef(r, nm)) | _ -> None + + let m_typ_Object = lazy mkILBoxedType (mkILNonGenericTySpec (m_mkSysILTypeRef tname_Object)) + let m_typ_String = lazy mkILBoxedType (mkILNonGenericTySpec (m_mkSysILTypeRef tname_String)) + let m_typ_StringBuilder = lazy mkILBoxedType (mkILNonGenericTySpec (m_mkSysILTypeRef tname_StringBuilder)) + let m_typ_AsyncCallback = lazy mkILBoxedType (mkILNonGenericTySpec (m_mkSysILTypeRef tname_AsyncCallback)) + let m_typ_IAsyncResult = lazy mkILBoxedType (mkILNonGenericTySpec (m_mkSysILTypeRef tname_IAsyncResult)) + let m_typ_IComparable = lazy mkILBoxedType (mkILNonGenericTySpec (m_mkSysILTypeRef tname_IComparable)) + let m_typ_Exception = lazy mkILBoxedType (mkILNonGenericTySpec (m_mkSysILTypeRef tname_Exception)) + let m_typ_Type = lazy mkILBoxedType (mkILNonGenericTySpec (m_mkSysILTypeRef tname_Type)) + let m_typ_Missing = lazy mkILBoxedType (mkILNonGenericTySpec (m_mkSysILTypeRef tname_Missing)) + let m_typ_Activator = lazy mkILBoxedType (mkILNonGenericTySpec (m_mkSysILTypeRef tname_Activator)) + let m_typ_SerializationInfo = + lazy + match tryGetTypeILScopeRef tname_SerializationInfo with + | Some scopeRef -> Some (mkILBoxedType (mkILNonGenericTySpec (mkILTyRef(scopeRef,tname_SerializationInfo)))) + | None -> None + let m_typ_StreamingContext = lazy ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_StreamingContext)) + let m_tref_SecurityPermissionAttribute = + lazy + match tryGetTypeILScopeRef tname_SecurityPermissionAttribute with + | Some scopeRef -> Some (mkILTyRef(scopeRef,tname_SecurityPermissionAttribute)) + | None -> None + let m_typ_Delegate = lazy mkILBoxedType (mkILNonGenericTySpec (m_mkSysILTypeRef tname_Delegate)) + let m_typ_ValueType = lazy mkILBoxedType (mkILNonGenericTySpec (m_mkSysILTypeRef tname_ValueType)) + let m_typ_TypedReference = + lazy + match tryGetTypeILScopeRef tname_TypedReference with + | Some scopeRef -> Some(ILType.Value (mkILNonGenericTySpec (mkILTyRef (scopeRef,tname_TypedReference)))) + | None -> None + let m_typ_Enum = lazy mkILBoxedType (mkILNonGenericTySpec (m_mkSysILTypeRef tname_Enum)) + let m_typ_MulticastDelegate = lazy mkILBoxedType (mkILNonGenericTySpec (m_mkSysILTypeRef tname_MulticastDelegate)) + let m_typ_Array = lazy mkILBoxedType (mkILNonGenericTySpec (m_mkSysILTypeRef tname_Array)) + let m_typ_SByte = lazy ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_SByte)) + let m_typ_Int16 = lazy ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_Int16)) + let m_typ_Int32 = lazy ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_Int32)) + let m_typ_Int64 = lazy ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_Int64)) + let m_typ_Byte = lazy ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_Byte)) + let m_typ_UInt16 = lazy ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_UInt16)) + let m_typ_UInt32 = lazy ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_UInt32)) + let m_typ_UInt64 = lazy ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_UInt64)) + let m_typ_Single = lazy ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_Single)) + let m_typ_Double = lazy ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_Double)) + let m_typ_Bool = lazy ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_Bool)) + let m_typ_Char = lazy ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_Char)) + let m_typ_IntPtr = lazy ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_IntPtr)) + let m_typ_UIntPtr = lazy ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_UIntPtr)) + + let m_typ_RuntimeArgumentHandle = + lazy + match tryGetTypeILScopeRef tname_RuntimeArgumentHandle with + | Some scopeRef -> Some(ILType.Value (mkILNonGenericTySpec (mkILTyRef (scopeRef,tname_RuntimeArgumentHandle)))) + | None -> None + + let m_typ_RuntimeTypeHandle = lazy ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_RuntimeTypeHandle)) + let m_typ_RuntimeMethodHandle = lazy ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_RuntimeMethodHandle)) + let m_typ_RuntimeFieldHandle = lazy ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_RuntimeFieldHandle)) + let mutable m_generatedAttribsCache = [] + let mutable m_debuggerBrowsableNeverAttributeCache = None + member x.primaryAssemblyScopeRef = m_typ_Object.Value.TypeRef.Scope + member x.primaryAssemblyName = m_typ_Object.Value.TypeRef.Scope.AssemblyRef.Name + member x.noDebugData = noDebugData + member x.tref_Object = m_typ_Object.Value.TypeRef + member x.tspec_Object = m_typ_Object.Value.TypeSpec + member x.typ_Object = m_typ_Object.Value + member x.tref_String = m_typ_String.Value.TypeRef + member x.typ_String = m_typ_String.Value + member x.typ_StringBuilder = m_typ_StringBuilder.Value + member x.typ_AsyncCallback = m_typ_AsyncCallback.Value + member x.typ_IAsyncResult = m_typ_IAsyncResult.Value + member x.typ_IComparable = m_typ_IComparable.Value + member x.typ_Activator = m_typ_Activator.Value + member x.tref_Type = m_typ_Type.Value.TypeRef + member x.typ_Type = m_typ_Type.Value + member x.typ_Missing = m_typ_Missing.Value + member x.typ_Delegate = m_typ_Delegate.Value + member x.typ_ValueType = m_typ_ValueType.Value + member x.typ_Enum = m_typ_Enum.Value + member x.tspec_TypedReference = m_typ_TypedReference.Value |> Option.map (fun x -> x.TypeSpec) + member x.typ_TypedReference = m_typ_TypedReference.Value + member x.typ_MulticastDelegate = m_typ_MulticastDelegate.Value + member x.typ_Array = m_typ_Array.Value + member x.tspec_Int64 = m_typ_Int64.Value.TypeSpec + member x.tspec_UInt64 = m_typ_UInt64.Value.TypeSpec + member x.tspec_Int32 = m_typ_Int32.Value.TypeSpec + member x.tspec_UInt32 = m_typ_UInt32.Value.TypeSpec + member x.tspec_Int16 = m_typ_Int16.Value.TypeSpec + member x.tspec_UInt16 = m_typ_UInt16.Value.TypeSpec + member x.tspec_SByte = m_typ_SByte.Value.TypeSpec + member x.tspec_Byte = m_typ_Byte.Value.TypeSpec + member x.tspec_Single = m_typ_Single.Value.TypeSpec + member x.tspec_Double = m_typ_Double.Value.TypeSpec + member x.tspec_IntPtr = m_typ_IntPtr.Value.TypeSpec + member x.tspec_UIntPtr = m_typ_UIntPtr.Value.TypeSpec + member x.tspec_Char = m_typ_Char.Value.TypeSpec + member x.tspec_Bool = m_typ_Bool.Value.TypeSpec + member x.typ_IntPtr = m_typ_IntPtr.Value + member x.typ_UIntPtr = m_typ_UIntPtr.Value + member x.typ_RuntimeArgumentHandle = m_typ_RuntimeArgumentHandle.Value + member x.typ_RuntimeTypeHandle = m_typ_RuntimeTypeHandle.Value + member x.typ_RuntimeMethodHandle = m_typ_RuntimeMethodHandle.Value + member x.typ_RuntimeFieldHandle = m_typ_RuntimeFieldHandle.Value + + member x.typ_Byte = m_typ_Byte.Value + member x.typ_Int16 = m_typ_Int16.Value + member x.typ_Int32 = m_typ_Int32.Value + member x.typ_Int64 = m_typ_Int64.Value + member x.typ_SByte = m_typ_SByte.Value + member x.typ_UInt16 = m_typ_UInt16.Value + member x.typ_UInt32 = m_typ_UInt32.Value + member x.typ_UInt64 = m_typ_UInt64.Value + member x.typ_Single = m_typ_Single.Value + member x.typ_Double = m_typ_Double.Value + member x.typ_Bool = m_typ_Bool.Value + member x.typ_Char = m_typ_Char.Value + member x.typ_SerializationInfo = m_typ_SerializationInfo.Value + member x.typ_StreamingContext = m_typ_StreamingContext.Value + member x.tref_SecurityPermissionAttribute = m_tref_SecurityPermissionAttribute.Value + member x.tspec_Exception = m_typ_Exception.Value.TypeSpec + member x.typ_Exception = m_typ_Exception.Value + member x.generatedAttribsCache with get () = m_generatedAttribsCache and set v = m_generatedAttribsCache <- v + member x.debuggerBrowsableNeverAttributeCache with get() = m_debuggerBrowsableNeverAttributeCache and set v = m_debuggerBrowsableNeverAttributeCache <- v + member x.mkSysILTypeRef nm = m_mkSysILTypeRef nm + member x.tryMkSysILTypeRef nm = m_tryMkSysILTypeRef nm override x.ToString() = "" +let mkILGlobals(noDebugData, getTypeILScopeRef, tryGetTypeILScopeRef) = + ILGlobals(noDebugData, getTypeILScopeRef, tryGetTypeILScopeRef) + let mkNormalCall mspec = I_call (Normalcall, mspec, None) let mkNormalCallvirt mspec = I_callvirt (Normalcall, mspec, None) let mkNormalCallconstraint (ty,mspec) = I_callconstraint (Normalcall, ty, mspec, None) @@ -2182,260 +2218,16 @@ let tname_CompilerGeneratedAttribute = "System.Runtime.CompilerServices.Compiler let tname_DebuggableAttribute = "System.Diagnostics.DebuggableAttribute" -let mkILGlobals (traits : IPrimaryAssemblyTraits) primaryAssemblyNameOpt noDebugData = - let primaryAssemblyName = - match primaryAssemblyNameOpt with - | Some name -> name - | None -> - match traits.ScopeRef with - | ILScopeRef.Assembly assembly -> assembly.Name - | _ -> failwith "mkILGlobals: system runtime ILScopeRef is not an assembly ref" - let systemRuntimeScopeRef = traits.ScopeRef - let tref_Object = mkILTyRef (systemRuntimeScopeRef, tname_Object) - let tspec_Object = mkILNonGenericTySpec tref_Object - let typ_Object = mkILBoxedType tspec_Object - - let tref_String = mkILTyRef (systemRuntimeScopeRef, tname_String) - let tspec_String = mkILNonGenericTySpec tref_String - let typ_String = mkILBoxedType tspec_String - - let tref_StringBuilder = mkILTyRef (systemRuntimeScopeRef, tname_StringBuilder) - let tspec_StringBuilder = mkILNonGenericTySpec tref_StringBuilder - let typ_StringBuilder = mkILBoxedType tspec_StringBuilder - - let tref_AsyncCallback = mkILTyRef (systemRuntimeScopeRef, tname_AsyncCallback) - let tspec_AsyncCallback = mkILNonGenericTySpec tref_AsyncCallback - let typ_AsyncCallback = mkILBoxedType tspec_AsyncCallback - - let tref_IAsyncResult = mkILTyRef (systemRuntimeScopeRef,tname_IAsyncResult) - let tspec_IAsyncResult = mkILNonGenericTySpec tref_IAsyncResult - let typ_IAsyncResult = mkILBoxedType tspec_IAsyncResult - - let tref_IComparable = mkILTyRef (systemRuntimeScopeRef,tname_IComparable) - let tspec_IComparable = mkILNonGenericTySpec tref_IComparable - let typ_IComparable = mkILBoxedType tspec_IComparable - - let tref_Exception = mkILTyRef (systemRuntimeScopeRef,tname_Exception) - let tspec_Exception = mkILNonGenericTySpec tref_Exception - let typ_Exception = mkILBoxedType tspec_Exception - - let tref_Type = mkILTyRef(systemRuntimeScopeRef,tname_Type) - let tspec_Type = mkILNonGenericTySpec tref_Type - let typ_Type = mkILBoxedType tspec_Type - - let typ_Missing = - lazy( - let tref_Missing = mkILTyRef(traits.SystemReflectionScopeRef.Value ,tname_Missing) - let tspec_Missing = mkILNonGenericTySpec tref_Missing - mkILBoxedType tspec_Missing - ) - - let tref_Activator = mkILTyRef(systemRuntimeScopeRef,tname_Activator) - let tspec_Activator = mkILNonGenericTySpec tref_Activator - let typ_Activator = mkILBoxedType tspec_Activator - - let typ_SerializationInfo = - match traits.SerializationInfoTypeScopeRef with - | Some scopeRef -> - let tref_SerializationInfo = mkILTyRef(scopeRef,tname_SerializationInfo) - let tspec_SerializationInfo = mkILNonGenericTySpec tref_SerializationInfo - Some (mkILBoxedType tspec_SerializationInfo) - | None -> None - - let tref_StreamingContext = mkILTyRef(systemRuntimeScopeRef,tname_StreamingContext) - let tspec_StreamingContext = mkILNonGenericTySpec tref_StreamingContext - let typ_StreamingContext = ILType.Value tspec_StreamingContext - - let tref_SecurityPermissionAttribute = - match traits.SecurityPermissionAttributeTypeScopeRef with - | Some scopeRef -> Some (mkILTyRef(scopeRef,tname_SecurityPermissionAttribute)) - | None -> None - - let tref_Delegate = mkILTyRef(systemRuntimeScopeRef,tname_Delegate) - let tspec_Delegate = mkILNonGenericTySpec tref_Delegate - let typ_Delegate = mkILBoxedType tspec_Delegate - - let tref_ValueType = mkILTyRef (systemRuntimeScopeRef,tname_ValueType) - let tspec_ValueType = mkILNonGenericTySpec tref_ValueType - let typ_ValueType = mkILBoxedType tspec_ValueType - - let tspec_TypedReference, typ_TypedReference = - match traits.TypedReferenceTypeScopeRef with - | Some scopeRef -> - let tref_TypedReference = mkILTyRef (scopeRef,tname_TypedReference) - let tspec_TypedReference = mkILNonGenericTySpec tref_TypedReference - Some tspec_TypedReference, Some(ILType.Value tspec_TypedReference) - | None -> None, None - - let tref_Enum = mkILTyRef (systemRuntimeScopeRef,tname_Enum) - let tspec_Enum = mkILNonGenericTySpec tref_Enum - let typ_Enum = mkILBoxedType tspec_Enum - - let tref_MulticastDelegate = mkILTyRef (systemRuntimeScopeRef,tname_MulticastDelegate) - let tspec_MulticastDelegate = mkILNonGenericTySpec tref_MulticastDelegate - let typ_MulticastDelegate = mkILBoxedType tspec_MulticastDelegate - - let typ_Array = mkILBoxedType (mkILNonGenericTySpec (mkILTyRef (systemRuntimeScopeRef,tname_Array))) - - let tref_Int64 = mkILTyRef (systemRuntimeScopeRef,tname_Int64) - let tref_UInt64 = mkILTyRef (systemRuntimeScopeRef,tname_UInt64) - let tref_Int32 = mkILTyRef (systemRuntimeScopeRef,tname_Int32) - let tref_UInt32 = mkILTyRef (systemRuntimeScopeRef,tname_UInt32) - let tref_Int16 = mkILTyRef (systemRuntimeScopeRef,tname_Int16) - let tref_UInt16 = mkILTyRef (systemRuntimeScopeRef,tname_UInt16) - let tref_SByte = mkILTyRef (systemRuntimeScopeRef,tname_SByte) - let tref_Byte = mkILTyRef (systemRuntimeScopeRef,tname_Byte) - let tref_Single = mkILTyRef (systemRuntimeScopeRef,tname_Single) - let tref_Double = mkILTyRef (systemRuntimeScopeRef,tname_Double) - let tref_Bool = mkILTyRef (systemRuntimeScopeRef,tname_Bool) - let tref_Char = mkILTyRef (systemRuntimeScopeRef,tname_Char) - let tref_IntPtr = mkILTyRef (systemRuntimeScopeRef,tname_IntPtr) - let tref_UIntPtr = mkILTyRef (systemRuntimeScopeRef,tname_UIntPtr) - - let tspec_Int64 = mkILNonGenericTySpec tref_Int64 - let tspec_UInt64 = mkILNonGenericTySpec tref_UInt64 - let tspec_Int32 = mkILNonGenericTySpec tref_Int32 - let tspec_UInt32 = mkILNonGenericTySpec tref_UInt32 - let tspec_Int16 = mkILNonGenericTySpec tref_Int16 - let tspec_UInt16 = mkILNonGenericTySpec tref_UInt16 - let tspec_SByte = mkILNonGenericTySpec tref_SByte - let tspec_Byte = mkILNonGenericTySpec tref_Byte - let tspec_Single = mkILNonGenericTySpec tref_Single - let tspec_Double = mkILNonGenericTySpec tref_Double - let tspec_IntPtr = mkILNonGenericTySpec tref_IntPtr - let tspec_UIntPtr = mkILNonGenericTySpec tref_UIntPtr - let tspec_Char = mkILNonGenericTySpec tref_Char - let tspec_Bool = mkILNonGenericTySpec tref_Bool - - let typ_int8 = ILType.Value tspec_SByte - let typ_int16 = ILType.Value tspec_Int16 - let typ_int32 = ILType.Value tspec_Int32 - let typ_int64 = ILType.Value tspec_Int64 - let typ_uint8 = ILType.Value tspec_Byte - let typ_uint16 = ILType.Value tspec_UInt16 - let typ_uint32 = ILType.Value tspec_UInt32 - let typ_uint64 = ILType.Value tspec_UInt64 - let typ_float32 = ILType.Value tspec_Single - let typ_float64 = ILType.Value tspec_Double - let typ_bool = ILType.Value tspec_Bool - let typ_char = ILType.Value tspec_Char - let typ_IntPtr = ILType.Value tspec_IntPtr - let typ_UIntPtr = ILType.Value tspec_UIntPtr - - let typ_SByte = ILType.Value tspec_SByte - let typ_Int16 = ILType.Value tspec_Int16 - let typ_Int32 = ILType.Value tspec_Int32 - let typ_Int64 = ILType.Value tspec_Int64 - let typ_Byte = ILType.Value tspec_Byte - let typ_UInt16 = ILType.Value tspec_UInt16 - let typ_UInt32 = ILType.Value tspec_UInt32 - let typ_UInt64 = ILType.Value tspec_UInt64 - let typ_Single = ILType.Value tspec_Single - let typ_Double = ILType.Value tspec_Double - let typ_Bool = ILType.Value tspec_Bool - let typ_Char = ILType.Value tspec_Char - - let tref_RuntimeArgumentHandle = - match traits.RuntimeArgumentHandleTypeScopeRef with - | Some scopeRef -> Some(mkILTyRef (scopeRef,tname_RuntimeArgumentHandle)) - | None -> None - let tspec_RuntimeArgumentHandle = Option.map mkILNonGenericTySpec tref_RuntimeArgumentHandle - let typ_RuntimeArgumentHandle = Option.map ILType.Value tspec_RuntimeArgumentHandle - let tref_RuntimeTypeHandle = mkILTyRef (systemRuntimeScopeRef,tname_RuntimeTypeHandle) - let tspec_RuntimeTypeHandle = mkILNonGenericTySpec tref_RuntimeTypeHandle - let typ_RuntimeTypeHandle = ILType.Value tspec_RuntimeTypeHandle - let tref_RuntimeMethodHandle = mkILTyRef (systemRuntimeScopeRef,tname_RuntimeMethodHandle) - let tspec_RuntimeMethodHandle = mkILNonGenericTySpec tref_RuntimeMethodHandle - let typ_RuntimeMethodHandle = ILType.Value tspec_RuntimeMethodHandle - let tref_RuntimeFieldHandle = mkILTyRef (systemRuntimeScopeRef,tname_RuntimeFieldHandle) - let tspec_RuntimeFieldHandle = mkILNonGenericTySpec tref_RuntimeFieldHandle - let typ_RuntimeFieldHandle = ILType.Value tspec_RuntimeFieldHandle - { traits = traits - primaryAssemblyName = primaryAssemblyName - noDebugData = noDebugData - tref_Object = tref_Object - tspec_Object = tspec_Object - typ_Object = typ_Object - tref_String = tref_String - typ_String = typ_String - typ_StringBuilder = typ_StringBuilder - typ_AsyncCallback = typ_AsyncCallback - typ_IAsyncResult = typ_IAsyncResult - typ_IComparable = typ_IComparable - typ_Activator = typ_Activator - tref_Type = tref_Type - typ_Type = typ_Type - typ_Missing = typ_Missing - typ_Delegate = typ_Delegate - typ_ValueType = typ_ValueType - typ_Enum = typ_Enum - tspec_TypedReference = tspec_TypedReference - typ_TypedReference = typ_TypedReference - typ_MulticastDelegate = typ_MulticastDelegate - typ_Array = typ_Array - tspec_Int64 = tspec_Int64 - tspec_UInt64 = tspec_UInt64 - tspec_Int32 = tspec_Int32 - tspec_UInt32 = tspec_UInt32 - tspec_Int16 = tspec_Int16 - tspec_UInt16 = tspec_UInt16 - tspec_SByte = tspec_SByte - tspec_Byte = tspec_Byte - tspec_Single = tspec_Single - tspec_Double = tspec_Double - tspec_IntPtr = tspec_IntPtr - tspec_UIntPtr = tspec_UIntPtr - tspec_Char = tspec_Char - tspec_Bool = tspec_Bool - typ_int8 = typ_int8 - typ_int16 = typ_int16 - typ_int32 = typ_int32 - typ_int64 = typ_int64 - typ_uint8 = typ_uint8 - typ_uint16 = typ_uint16 - typ_uint32 = typ_uint32 - typ_uint64 = typ_uint64 - typ_float32 = typ_float32 - typ_float64 = typ_float64 - typ_bool = typ_bool - typ_char = typ_char - typ_IntPtr = typ_IntPtr - typ_UIntPtr =typ_UIntPtr - typ_RuntimeArgumentHandle = typ_RuntimeArgumentHandle - typ_RuntimeTypeHandle = typ_RuntimeTypeHandle - typ_RuntimeMethodHandle = typ_RuntimeMethodHandle - typ_RuntimeFieldHandle = typ_RuntimeFieldHandle - - typ_Byte = typ_Byte - typ_Int16 = typ_Int16 - typ_Int32 = typ_Int32 - typ_Int64 = typ_Int64 - typ_SByte = typ_SByte - typ_UInt16 = typ_UInt16 - typ_UInt32 = typ_UInt32 - typ_UInt64 = typ_UInt64 - typ_Single = typ_Single - typ_Double = typ_Double - typ_Bool = typ_Bool - typ_Char = typ_Char - typ_SerializationInfo = typ_SerializationInfo - typ_StreamingContext = typ_StreamingContext - tref_SecurityPermissionAttribute = tref_SecurityPermissionAttribute - tspec_Exception = tspec_Exception - typ_Exception = typ_Exception - generatedAttribsCache = [] - debuggerBrowsableNeverAttributeCache = None - debuggerTypeProxyAttributeCache = None } (* NOTE: ecma_ prefix refers to the standard "mscorlib" *) let ecmaPublicKey = PublicKeyToken (Bytes.ofInt32Array [|0xde; 0xad; 0xbe; 0xef; 0xca; 0xfe; 0xfa; 0xce |]) -let mkInitializeArrayMethSpec ilg = - mkILNonGenericStaticMethSpecInTy(mkILNonGenericBoxedTy(mkILTyRef(ilg.traits.ScopeRef,"System.Runtime.CompilerServices.RuntimeHelpers")),"InitializeArray", [ilg.typ_Array;ilg.typ_RuntimeFieldHandle], ILType.Void) +let mkInitializeArrayMethSpec (ilg: ILGlobals) = + mkILNonGenericStaticMethSpecInTy(mkILNonGenericBoxedTy(ilg.mkSysILTypeRef "System.Runtime.CompilerServices.RuntimeHelpers"),"InitializeArray", [ilg.typ_Array;ilg.typ_RuntimeFieldHandle], ILType.Void) (* e.ilg. [mkPrimaryAssemblyExnNewobj "System.InvalidCastException"] *) -let mkPrimaryAssemblyExnNewobj ilg eclass = - mkNormalNewobj (mkILNonGenericCtorMethSpec (mkILTyRef(ilg.traits.ScopeRef,eclass),[])) +let mkPrimaryAssemblyExnNewobj (ilg: ILGlobals) eclass = + mkNormalNewobj (mkILNonGenericCtorMethSpec (ilg.mkSysILTypeRef eclass,[])) let typ_is_boxed = function ILType.Boxed _ -> true | _ -> false let typ_is_value = function ILType.Value _ -> true | _ -> false @@ -2446,9 +2238,7 @@ let tspec_is_primaryAssembly (tspec:ILTypeSpec) n = let scoref = tref.Scope (tref.Name = n) && match scoref with - | ILScopeRef.Assembly n -> - n.Name = PrimaryAssembly.Mscorlib.Name || - n.Name = PrimaryAssembly.DotNetCore.Name + | ILScopeRef.Assembly n -> PrimaryAssembly.IsSomePrimaryAssembly n.Name | ILScopeRef.Module _ -> false | ILScopeRef.Local -> true @@ -3017,7 +2807,7 @@ let mkILGenericClass (nm, access, genparams, extends, impl, methods, fields, nes HasSecurity=false; } -let mkRawDataValueTypeDef ilg (nm,size,pack) = +let mkRawDataValueTypeDef (ilg: ILGlobals) (nm,size,pack) = { tdKind=ILTypeDefKind.ValueType; Name = nm; GenericParams= []; @@ -3043,7 +2833,7 @@ let mkRawDataValueTypeDef ilg (nm,size,pack) = HasSecurity=false; } -let mkILSimpleClass ilg (nm, access, methods, fields, nestedTypes, props, events, attrs, init) = +let mkILSimpleClass (ilg: ILGlobals) (nm, access, methods, fields, nestedTypes, props, events, attrs, init) = mkILGenericClass (nm,access, mkILEmptyGenericParams, ilg.typ_Object, [], methods, fields, nestedTypes, props, events, attrs, init) let mkILTypeDefForGlobalFunctions ilg (methods,fields) = mkILSimpleClass ilg (typeNameForGlobalFunctions, ILTypeDefAccess.Public, methods, fields, emptyILTypeDefs, emptyILProperties, emptyILEvents, emptyILCustomAttrs,ILTypeInit.BeforeField) @@ -3116,7 +2906,7 @@ let buildILCode (_methName:string) lab2pc instrs tryspecs localspecs : ILCode = // Detecting Delegates // -------------------------------------------------------------------- -let mkILDelegateMethods ilg (parms,rtv:ILReturn) = +let mkILDelegateMethods (ilg: ILGlobals) (parms,rtv:ILReturn) = let rty = rtv.Type let one nm args ret = let mdef = mkILNonGenericVirtualMethod (nm,ILMemberAccess.Public,args,mkILReturn ret,MethodBody.Abstract) @@ -3135,7 +2925,7 @@ let mkILDelegateMethods ilg (parms,rtv:ILReturn) = one "EndInvoke" [mkILParamNamed("result",ilg.typ_IAsyncResult)] rty; ] -let mkCtorMethSpecForDelegate ilg (typ:ILType,useUIntPtr) = +let mkCtorMethSpecForDelegate (ilg: ILGlobals) (typ:ILType,useUIntPtr) = let scoref = typ.TypeRef.Scope mkILInstanceMethSpecInTy (typ,".ctor",[rescopeILType scoref ilg.typ_Object; rescopeILType scoref (if useUIntPtr then ilg.typ_UIntPtr else ilg.typ_IntPtr)],ILType.Void,emptyILGenericArgsList) @@ -3390,7 +3180,7 @@ let rec encodeCustomAttrElemTypeForObject x = | ILAttribElem.Array (elemTy,_) -> [| yield et_SZARRAY; yield! encodeCustomAttrElemType elemTy |] -let rec decodeCustomAttrElemType ilg bytes sigptr x = +let rec decodeCustomAttrElemType (ilg: ILGlobals) bytes sigptr x = match x with | x when x = et_I1 -> ilg.typ_SByte, sigptr | x when x = et_U1 -> ilg.typ_Byte, sigptr @@ -3473,34 +3263,9 @@ let mkILCustomAttribute ilg (tref,argtys,argvs,propvs) = mkILCustomAttribMethRef ilg (mkILNonGenericCtorMethSpec (tref,argtys),argvs,propvs) let MscorlibScopeRef = ILScopeRef.Assembly (ILAssemblyRef.Create("mscorlib", None, Some ecmaPublicKey, true, None, None)) -let mkMscorlibBasedTraits mscorlibRef = - let ecmaMscorlibScopeRef = Some mscorlibRef - let lazyRef = lazy mscorlibRef - { - new IPrimaryAssemblyTraits with - member this.ScopeRef = mscorlibRef - member this.SystemReflectionScopeRef = lazyRef - member this.TypedReferenceTypeScopeRef = ecmaMscorlibScopeRef - member this.RuntimeArgumentHandleTypeScopeRef = ecmaMscorlibScopeRef - member this.SerializationInfoTypeScopeRef = ecmaMscorlibScopeRef - member this.SecurityPermissionAttributeTypeScopeRef = ecmaMscorlibScopeRef - member this.SystemDiagnosticsDebugScopeRef = lazyRef - member this.SystemRuntimeInteropServicesScopeRef = lazy (Some mscorlibRef) - member this.IDispatchConstantAttributeScopeRef = ecmaMscorlibScopeRef - member this.IUnknownConstantAttributeScopeRef = ecmaMscorlibScopeRef - member this.ContextStaticAttributeScopeRef = ecmaMscorlibScopeRef - member this.ThreadStaticAttributeScopeRef = ecmaMscorlibScopeRef - member this.SystemLinqExpressionsScopeRef = lazyRef - member this.SystemCollectionsScopeRef = lazyRef - member this.SpecialNameAttributeScopeRef = ecmaMscorlibScopeRef - member this.NonSerializedAttributeScopeRef = ecmaMscorlibScopeRef - member this.MarshalByRefObjectScopeRef = ecmaMscorlibScopeRef - member this.ArgIteratorTypeScopeRef = ecmaMscorlibScopeRef - } -let EcmaILGlobals = mkILGlobals (mkMscorlibBasedTraits MscorlibScopeRef) None false +let EcmaMscorlibILGlobals = mkILGlobals (false, (fun _ -> MscorlibScopeRef), (fun _ -> Some MscorlibScopeRef)) -(* Q: CompilerGeneratedAttribute is new in 2.0. Unconditional generation of this attribute prevents running on 1.1 Framework. (discovered running on early mono version). *) -let tref_CompilerGeneratedAttribute ilg = mkILTyRef (ilg.traits.ScopeRef, tname_CompilerGeneratedAttribute) +let tref_CompilerGeneratedAttribute (ilg: ILGlobals) = ilg.mkSysILTypeRef tname_CompilerGeneratedAttribute [] let tname_DebuggerNonUserCodeAttribute = "System.Diagnostics.DebuggerNonUserCodeAttribute" @@ -3519,9 +3284,9 @@ let tname_DebuggerBrowsableAttribute = "System.Diagnostics.DebuggerBrowsableAttr [] let tname_DebuggerBrowsableState = "System.Diagnostics.DebuggerBrowsableState" -let mkSystemDiagnosticsDebugTypeRef (ilg : ILGlobals) typeName = mkILTyRef (ilg.traits.SystemDiagnosticsDebugScopeRef.Value, typeName) -let mkSystemDiagnosticsDebuggableTypeRef (ilg : ILGlobals) = mkILTyRef (ilg.traits.ScopeRef, tname_DebuggableAttribute) -let tref_DebuggableAttribute_DebuggingModes ilg = mkILNestedTyRef (ilg.traits.ScopeRef, [tname_DebuggableAttribute],tname_DebuggableAttribute_DebuggingModes) +let mkSystemDiagnosticsDebugTypeRef (ilg : ILGlobals) typeName = ilg.mkSysILTypeRef typeName +let mkSystemDiagnosticsDebuggableTypeRef (ilg : ILGlobals) = ilg.mkSysILTypeRef tname_DebuggableAttribute +let tref_DebuggableAttribute_DebuggingModes (ilg : ILGlobals) = mkILTyRefInTyRef (mkSystemDiagnosticsDebuggableTypeRef ilg, tname_DebuggableAttribute_DebuggingModes) type ILGlobals with @@ -3562,7 +3327,7 @@ type ILGlobals with member this.mkCompilerGeneratedAttribute () = mkILCustomAttribute this (tref_CompilerGeneratedAttribute this, [], [], []) // Requests attributes to be added to compiler generated methods. -let addGeneratedAttrs ilg (attrs: ILAttributes) = +let addGeneratedAttrs (ilg: ILGlobals) (attrs: ILAttributes) = let attribs = match ilg.generatedAttribsCache with | [] -> @@ -3745,7 +3510,7 @@ type ILTypeSigParser(tstring : string) = let ilty = x.ParseType() ILAttribElem.Type(Some(ilty)) -let decodeILAttribData ilg (ca: ILAttribute) = +let decodeILAttribData (ilg: ILGlobals) (ca: ILAttribute) = let bytes = ca.Data let sigptr = 0 let bb0,sigptr = sigptr_get_byte bytes sigptr @@ -3850,7 +3615,7 @@ let decodeILAttribData ilg (ca: ILAttribute) = let scoref = match rest with | Some aname -> ILScopeRef.Assembly(ILAssemblyRef.FromAssemblyName(System.Reflection.AssemblyName(aname))) - | None -> ilg.traits.ScopeRef + | None -> ilg.primaryAssemblyScopeRef let tref = mkILTyRef (scoref,unqualified_tname) let tspec = mkILNonGenericTySpec tref diff --git a/src/absil/il.fsi b/src/absil/il.fsi index f6fdb6852d8..fc8fdf6f155 100644 --- a/src/absil/il.fsi +++ b/src/absil/il.fsi @@ -7,9 +7,11 @@ module internal Microsoft.FSharp.Compiler.AbstractIL.IL open Internal.Utilities open System.Collections.Generic +[] type PrimaryAssembly = | Mscorlib | DotNetCore + | PrivateCoreLib member Name: string @@ -1474,29 +1476,6 @@ val isTypeNameForGlobalFunctions: string -> bool val ungenericizeTypeName: string -> string (* e.g. List`1 --> List *) -/// Represents the capabilities of target framework profile. -/// Different profiles may omit some types or contain them in different assemblies. -type IPrimaryAssemblyTraits = - - abstract TypedReferenceTypeScopeRef : ILScopeRef option - abstract RuntimeArgumentHandleTypeScopeRef : ILScopeRef option - abstract SerializationInfoTypeScopeRef : ILScopeRef option - abstract SecurityPermissionAttributeTypeScopeRef : ILScopeRef option - abstract IDispatchConstantAttributeScopeRef : ILScopeRef option - abstract IUnknownConstantAttributeScopeRef : ILScopeRef option - abstract ArgIteratorTypeScopeRef : ILScopeRef option - abstract MarshalByRefObjectScopeRef : ILScopeRef option - abstract ThreadStaticAttributeScopeRef : ILScopeRef option - abstract SpecialNameAttributeScopeRef : ILScopeRef option - abstract ContextStaticAttributeScopeRef : ILScopeRef option - abstract NonSerializedAttributeScopeRef : ILScopeRef option - - abstract SystemRuntimeInteropServicesScopeRef : Lazy - abstract SystemLinqExpressionsScopeRef : Lazy - abstract SystemCollectionsScopeRef : Lazy - abstract SystemReflectionScopeRef : Lazy - abstract SystemDiagnosticsDebugScopeRef : Lazy - abstract ScopeRef : ILScopeRef // ==================================================================== // PART 2 @@ -1509,103 +1488,88 @@ type IPrimaryAssemblyTraits = /// A table of common references to items in primary assebly (System.Runtime or mscorlib). /// If a particular version of System.Runtime.dll has been loaded then you should /// reference items from it via an ILGlobals for that specific version built using mkILGlobals. -[] +[] type ILGlobals = - { - traits : IPrimaryAssemblyTraits - primaryAssemblyName: string - noDebugData: bool - tref_Object: ILTypeRef - tspec_Object: ILTypeSpec - typ_Object: ILType - tref_String: ILTypeRef - typ_String: ILType - typ_StringBuilder: ILType - typ_AsyncCallback: ILType - typ_IAsyncResult: ILType - typ_IComparable: ILType - tref_Type: ILTypeRef - typ_Type: ILType - typ_Missing: Lazy - typ_Activator: ILType - typ_Delegate: ILType - typ_ValueType: ILType - typ_Enum: ILType - tspec_TypedReference: ILTypeSpec option - typ_TypedReference: ILType option - typ_MulticastDelegate: ILType - typ_Array: ILType - tspec_Int64: ILTypeSpec - tspec_UInt64: ILTypeSpec - tspec_Int32: ILTypeSpec - tspec_UInt32: ILTypeSpec - tspec_Int16: ILTypeSpec - tspec_UInt16: ILTypeSpec - tspec_SByte: ILTypeSpec - tspec_Byte: ILTypeSpec - tspec_Single: ILTypeSpec - tspec_Double: ILTypeSpec - tspec_IntPtr: ILTypeSpec - tspec_UIntPtr: ILTypeSpec - tspec_Char: ILTypeSpec - tspec_Bool: ILTypeSpec - typ_int8: ILType - typ_int16: ILType - typ_int32: ILType - typ_int64: ILType - typ_uint8: ILType - typ_uint16: ILType - typ_uint32: ILType - typ_uint64: ILType - typ_float32: ILType - typ_float64: ILType - typ_bool: ILType - typ_char: ILType - typ_IntPtr: ILType - typ_UIntPtr: ILType - typ_RuntimeArgumentHandle: ILType option - typ_RuntimeTypeHandle: ILType - typ_RuntimeMethodHandle: ILType - typ_RuntimeFieldHandle: ILType - typ_Byte: ILType - typ_Int16: ILType - typ_Int32: ILType - typ_Int64: ILType - typ_SByte: ILType - typ_UInt16: ILType - typ_UInt32: ILType - typ_UInt64: ILType - typ_Single: ILType - typ_Double: ILType - typ_Bool: ILType - typ_Char: ILType - typ_SerializationInfo: ILType option - typ_StreamingContext: ILType - tref_SecurityPermissionAttribute : ILTypeRef option - tspec_Exception: ILTypeSpec - typ_Exception: ILType - mutable generatedAttribsCache: ILAttribute list - mutable debuggerBrowsableNeverAttributeCache : ILAttribute option - mutable debuggerTypeProxyAttributeCache : ILAttribute option } - - with - member mkDebuggableAttribute: bool (* disable JIT optimizations *) -> ILAttribute - /// Some commonly used custom attibutes - member mkDebuggableAttributeV2 : bool (* jitTracking *) * bool (* ignoreSymbolStoreSequencePoints *) * bool (* disable JIT optimizations *) * bool (* enable EnC *) -> ILAttribute - member mkCompilerGeneratedAttribute : unit -> ILAttribute - member mkDebuggerNonUserCodeAttribute : unit -> ILAttribute - member mkDebuggerStepThroughAttribute : unit -> ILAttribute - member mkDebuggerHiddenAttribute : unit -> ILAttribute - member mkDebuggerDisplayAttribute : string -> ILAttribute - member mkDebuggerTypeProxyAttribute : ILType -> ILAttribute - member mkDebuggerBrowsableNeverAttribute : unit -> ILAttribute - -/// Build the table of commonly used references given an ILScopeRef for system runtime assembly. -val mkILGlobals : IPrimaryAssemblyTraits -> string option -> bool -> ILGlobals - -val mkMscorlibBasedTraits : ILScopeRef -> IPrimaryAssemblyTraits - -val EcmaILGlobals : ILGlobals + member primaryAssemblyScopeRef : ILScopeRef + member primaryAssemblyName : string + member noDebugData: bool; + member tref_Object: ILTypeRef + member tspec_Object: ILTypeSpec + member typ_Object: ILType + member tref_String: ILTypeRef + member typ_String: ILType + member typ_StringBuilder: ILType + member typ_AsyncCallback: ILType + member typ_IAsyncResult: ILType + member typ_IComparable: ILType + member tref_Type: ILTypeRef + member typ_Type: ILType + member typ_Missing: ILType + member typ_Activator: ILType + member typ_Delegate: ILType + member typ_ValueType: ILType + member typ_Enum: ILType + member tspec_TypedReference: ILTypeSpec option + member typ_TypedReference: ILType option + member typ_MulticastDelegate: ILType + member typ_Array: ILType + member tspec_Int64: ILTypeSpec + member tspec_UInt64: ILTypeSpec + member tspec_Int32: ILTypeSpec + member tspec_UInt32: ILTypeSpec + member tspec_Int16: ILTypeSpec + member tspec_UInt16: ILTypeSpec + member tspec_SByte: ILTypeSpec + member tspec_Byte: ILTypeSpec + member tspec_Single: ILTypeSpec + member tspec_Double: ILTypeSpec + member tspec_IntPtr: ILTypeSpec + member tspec_UIntPtr: ILTypeSpec + member tspec_Char: ILTypeSpec + member tspec_Bool: ILTypeSpec + member typ_IntPtr: ILType + member typ_UIntPtr: ILType + member typ_RuntimeArgumentHandle: ILType option + member typ_RuntimeTypeHandle: ILType + member typ_RuntimeMethodHandle: ILType + member typ_RuntimeFieldHandle: ILType + member typ_Byte: ILType + member typ_Int16: ILType + member typ_Int32: ILType + member typ_Int64: ILType + member typ_SByte: ILType + member typ_UInt16: ILType + member typ_UInt32: ILType + member typ_UInt64: ILType + member typ_Single: ILType + member typ_Double: ILType + member typ_Bool: ILType + member typ_Char: ILType + member typ_SerializationInfo: ILType option + member typ_StreamingContext: ILType + member tref_SecurityPermissionAttribute: ILTypeRef option + member tspec_Exception: ILTypeSpec + member typ_Exception: ILType + member generatedAttribsCache: ILAttribute list with get,set + member debuggerBrowsableNeverAttributeCache : ILAttribute option with get,set + member mkSysILTypeRef : string -> ILTypeRef + member tryMkSysILTypeRef : string -> ILTypeRef option + + member mkDebuggableAttribute: bool (* disable JIT optimizations *) -> ILAttribute + /// Some commonly used custom attibutes + member mkDebuggableAttributeV2 : bool (* jitTracking *) * bool (* ignoreSymbolStoreSequencePoints *) * bool (* disable JIT optimizations *) * bool (* enable EnC *) -> ILAttribute + member mkCompilerGeneratedAttribute : unit -> ILAttribute + member mkDebuggerNonUserCodeAttribute : unit -> ILAttribute + member mkDebuggerStepThroughAttribute : unit -> ILAttribute + member mkDebuggerHiddenAttribute : unit -> ILAttribute + member mkDebuggerDisplayAttribute : string -> ILAttribute + member mkDebuggerTypeProxyAttribute : ILType -> ILAttribute + member mkDebuggerBrowsableNeverAttribute : unit -> ILAttribute + +/// Build the table of commonly used references given functions to find types in system assemblies +val mkILGlobals: bool * (string -> ILScopeRef) * (string -> ILScopeRef option) -> ILGlobals + +val EcmaMscorlibILGlobals : ILGlobals /// When writing a binary the fake "toplevel" type definition (called ) /// must come first. This function puts it first, and creates it in the returned diff --git a/src/absil/ilascii.fs b/src/absil/ilascii.fs index 42f63f21ee0..92c01cbad92 100644 --- a/src/absil/ilascii.fs +++ b/src/absil/ilascii.fs @@ -12,7 +12,7 @@ open Microsoft.FSharp.Compiler.AbstractIL.Extensions.ILX.Types open Microsoft.FSharp.Compiler.AbstractIL.IL // set to the proper value at CompileOps.fs (BuildFrameworkTcImports) -let parseILGlobals = ref EcmaILGlobals +let parseILGlobals = ref EcmaMscorlibILGlobals // -------------------------------------------------------------------- // Table of parsing and pretty printing data for instructions. diff --git a/src/absil/ilpars.fsy b/src/absil/ilpars.fsy index 4111064cb38..6322e8d9be3 100644 --- a/src/absil/ilpars.fsy +++ b/src/absil/ilpars.fsy @@ -53,7 +53,7 @@ let resolveCurrentMethodSpecScope obj = let findSystemRuntimeAssemblyRef() = - match (!parseILGlobals).traits.ScopeRef with + match (!parseILGlobals).primaryAssemblyScopeRef with | ILScopeRef.Assembly aref -> aref | _ -> pfailwith "systemRuntimeScopeRef not set to valid assembly reference in parseILGlobals" @@ -330,39 +330,39 @@ typ: STRING | typ STAR { resolveMethodSpecScopeThen $1 (fun ty -> noMethodSpecScope (ILType.Ptr ty)) } | CHAR - { noMethodSpecScope (!parseILGlobals).typ_char } + { noMethodSpecScope (!parseILGlobals).typ_Char } | VOID { noMethodSpecScope ILType.Void } | BOOL - { noMethodSpecScope (!parseILGlobals).typ_bool } + { noMethodSpecScope (!parseILGlobals).typ_Bool } | INT8 - { noMethodSpecScope (!parseILGlobals).typ_int8 } + { noMethodSpecScope (!parseILGlobals).typ_SByte } | INT16 - { noMethodSpecScope (!parseILGlobals).typ_int16 } + { noMethodSpecScope (!parseILGlobals).typ_Int16 } | INT32 - { noMethodSpecScope (!parseILGlobals).typ_int32 } + { noMethodSpecScope (!parseILGlobals).typ_Int32 } | INT64 - { noMethodSpecScope (!parseILGlobals).typ_int64 } + { noMethodSpecScope (!parseILGlobals).typ_Int64 } | FLOAT32 - { noMethodSpecScope (!parseILGlobals).typ_float32 } + { noMethodSpecScope (!parseILGlobals).typ_Single } | FLOAT64 - { noMethodSpecScope (!parseILGlobals).typ_float64 } + { noMethodSpecScope (!parseILGlobals).typ_Double } | UNSIGNED INT8 - { noMethodSpecScope (!parseILGlobals).typ_uint8 } + { noMethodSpecScope (!parseILGlobals).typ_Byte } | UNSIGNED INT16 - { noMethodSpecScope (!parseILGlobals).typ_uint16 } + { noMethodSpecScope (!parseILGlobals).typ_UInt16 } | UNSIGNED INT32 - { noMethodSpecScope (!parseILGlobals).typ_uint32 } + { noMethodSpecScope (!parseILGlobals).typ_UInt32 } | UNSIGNED INT64 - { noMethodSpecScope (!parseILGlobals).typ_uint64 } + { noMethodSpecScope (!parseILGlobals).typ_UInt64 } | UINT8 - { noMethodSpecScope (!parseILGlobals).typ_uint8 } + { noMethodSpecScope (!parseILGlobals).typ_Byte } | UINT16 - { noMethodSpecScope (!parseILGlobals).typ_uint16 } + { noMethodSpecScope (!parseILGlobals).typ_UInt16 } | UINT32 - { noMethodSpecScope (!parseILGlobals).typ_uint32 } + { noMethodSpecScope (!parseILGlobals).typ_UInt32 } | UINT64 - { noMethodSpecScope (!parseILGlobals).typ_uint64 } + { noMethodSpecScope (!parseILGlobals).typ_UInt64 } | NATIVE INT { noMethodSpecScope (!parseILGlobals).typ_IntPtr } | NATIVE UNSIGNED INT diff --git a/src/absil/ilprint.fs b/src/absil/ilprint.fs index 00ea4175f48..496307f8b54 100644 --- a/src/absil/ilprint.fs +++ b/src/absil/ilprint.fs @@ -165,21 +165,21 @@ and goutput_typ env os ty = | ILType.Byref typ -> goutput_typ env os typ; output_string os "&" | ILType.Ptr typ -> goutput_typ env os typ; output_string os "*" - | ILType.Value tspec when tspec.Name = EcmaILGlobals.tspec_SByte.Name -> output_string os "int8" - | ILType.Value tspec when tspec.Name = EcmaILGlobals.tspec_Int16.Name -> output_string os "int16" - | ILType.Value tspec when tspec.Name = EcmaILGlobals.tspec_Int32.Name -> output_string os "int32" - | ILType.Value tspec when tspec.Name = EcmaILGlobals.tspec_Int64.Name -> output_string os "int64" - | ILType.Value tspec when tspec.Name = EcmaILGlobals.tspec_IntPtr.Name -> output_string os "native int" - | ILType.Value tspec when tspec.Name = EcmaILGlobals.tspec_Byte.Name -> output_string os "unsigned int8" - | ILType.Value tspec when tspec.Name = EcmaILGlobals.tspec_UInt16.Name -> output_string os "unsigned int16" - | ILType.Value tspec when tspec.Name = EcmaILGlobals.tspec_UInt32.Name -> output_string os "unsigned int32" - | ILType.Value tspec when tspec.Name = EcmaILGlobals.tspec_UInt64.Name -> output_string os "unsigned int64" - | ILType.Value tspec when tspec.Name = EcmaILGlobals.tspec_UIntPtr.Name -> output_string os "native unsigned int" - | ILType.Value tspec when tspec.Name = EcmaILGlobals.tspec_Double.Name -> output_string os "float64" - | ILType.Value tspec when tspec.Name = EcmaILGlobals.tspec_Single.Name -> output_string os "float32" - | ILType.Value tspec when tspec.Name = EcmaILGlobals.tspec_Bool.Name -> output_string os "bool" - | ILType.Value tspec when tspec.Name = EcmaILGlobals.tspec_Char.Name -> output_string os "char" - | ILType.Value tspec when tspec.Name = EcmaILGlobals.tspec_TypedReference.Value.Name -> output_string os "refany" + | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.tspec_SByte.Name -> output_string os "int8" + | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.tspec_Int16.Name -> output_string os "int16" + | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.tspec_Int32.Name -> output_string os "int32" + | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.tspec_Int64.Name -> output_string os "int64" + | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.tspec_IntPtr.Name -> output_string os "native int" + | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.tspec_Byte.Name -> output_string os "unsigned int8" + | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.tspec_UInt16.Name -> output_string os "unsigned int16" + | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.tspec_UInt32.Name -> output_string os "unsigned int32" + | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.tspec_UInt64.Name -> output_string os "unsigned int64" + | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.tspec_UIntPtr.Name -> output_string os "native unsigned int" + | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.tspec_Double.Name -> output_string os "float64" + | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.tspec_Single.Name -> output_string os "float32" + | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.tspec_Bool.Name -> output_string os "bool" + | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.tspec_Char.Name -> output_string os "char" + | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.tspec_TypedReference.Value.Name -> output_string os "refany" | ILType.Value tspec -> output_string os "value class "; goutput_tref env os tspec.TypeRef; @@ -703,7 +703,7 @@ let rec goutput_instr env os inst = goutput_dlocref env os (mkILArrTy(typ,shape)); output_string os ".ctor"; let rank = shape.Rank - output_parens (output_seq "," (goutput_typ env)) os (Array.toList (Array.create ( rank) EcmaILGlobals.typ_int32)) + output_parens (output_seq "," (goutput_typ env)) os (Array.toList (Array.create ( rank) EcmaMscorlibILGlobals.typ_Int32)) | I_stelem_any (shape,dt) -> if shape = ILArrayShape.SingleDimensional then output_string os "stelem.any "; goutput_typ env os dt @@ -712,7 +712,7 @@ let rec goutput_instr env os inst = goutput_dlocref env os (mkILArrTy(dt,shape)); output_string os "Set"; let rank = shape.Rank - output_parens (output_seq "," (goutput_typ env)) os (Array.toList (Array.create ( rank) EcmaILGlobals.typ_int32) @ [dt]) + output_parens (output_seq "," (goutput_typ env)) os (Array.toList (Array.create ( rank) EcmaMscorlibILGlobals.typ_Int32) @ [dt]) | I_ldelem_any (shape,tok) -> if shape = ILArrayShape.SingleDimensional then output_string os "ldelem.any "; goutput_typ env os tok @@ -723,7 +723,7 @@ let rec goutput_instr env os inst = goutput_dlocref env os (mkILArrTy(tok,shape)); output_string os "Get"; let rank = shape.Rank - output_parens (output_seq "," (goutput_typ env)) os (Array.toList (Array.create ( rank) EcmaILGlobals.typ_int32)) + output_parens (output_seq "," (goutput_typ env)) os (Array.toList (Array.create ( rank) EcmaMscorlibILGlobals.typ_Int32)) | I_ldelema (ro,_,shape,tok) -> if ro = ReadonlyAddress then output_string os "readonly. "; if shape = ILArrayShape.SingleDimensional then @@ -735,7 +735,7 @@ let rec goutput_instr env os inst = goutput_dlocref env os (mkILArrTy(tok,shape)); output_string os "Address"; let rank = shape.Rank - output_parens (output_seq "," (goutput_typ env)) os (Array.toList (Array.create ( rank) EcmaILGlobals.typ_int32)) + output_parens (output_seq "," (goutput_typ env)) os (Array.toList (Array.create ( rank) EcmaMscorlibILGlobals.typ_Int32)) | I_box tok -> output_string os "box "; goutput_typ env os tok | I_unbox tok -> output_string os "unbox "; goutput_typ env os tok diff --git a/src/absil/ilread.fs b/src/absil/ilread.fs index ae8d895e07f..4709be8a35b 100644 --- a/src/absil/ilread.fs +++ b/src/absil/ilread.fs @@ -1984,20 +1984,20 @@ and sigptrGetTy ctxt numtypars bytes sigptr = let b0,sigptr = sigptrGetByte bytes sigptr if b0 = et_OBJECT then ctxt.ilg.typ_Object , sigptr elif b0 = et_STRING then ctxt.ilg.typ_String, sigptr - elif b0 = et_I1 then ctxt.ilg.typ_int8, sigptr - elif b0 = et_I2 then ctxt.ilg.typ_int16, sigptr - elif b0 = et_I4 then ctxt.ilg.typ_int32, sigptr - elif b0 = et_I8 then ctxt.ilg.typ_int64, sigptr + elif b0 = et_I1 then ctxt.ilg.typ_SByte, sigptr + elif b0 = et_I2 then ctxt.ilg.typ_Int16, sigptr + elif b0 = et_I4 then ctxt.ilg.typ_Int32, sigptr + elif b0 = et_I8 then ctxt.ilg.typ_Int64, sigptr elif b0 = et_I then ctxt.ilg.typ_IntPtr, sigptr - elif b0 = et_U1 then ctxt.ilg.typ_uint8, sigptr - elif b0 = et_U2 then ctxt.ilg.typ_uint16, sigptr - elif b0 = et_U4 then ctxt.ilg.typ_uint32, sigptr - elif b0 = et_U8 then ctxt.ilg.typ_uint64, sigptr + elif b0 = et_U1 then ctxt.ilg.typ_Byte, sigptr + elif b0 = et_U2 then ctxt.ilg.typ_UInt16, sigptr + elif b0 = et_U4 then ctxt.ilg.typ_UInt32, sigptr + elif b0 = et_U8 then ctxt.ilg.typ_UInt64, sigptr elif b0 = et_U then ctxt.ilg.typ_UIntPtr, sigptr - elif b0 = et_R4 then ctxt.ilg.typ_float32, sigptr - elif b0 = et_R8 then ctxt.ilg.typ_float64, sigptr - elif b0 = et_CHAR then ctxt.ilg.typ_char, sigptr - elif b0 = et_BOOLEAN then ctxt.ilg.typ_bool, sigptr + elif b0 = et_R4 then ctxt.ilg.typ_Single, sigptr + elif b0 = et_R8 then ctxt.ilg.typ_Double, sigptr + elif b0 = et_CHAR then ctxt.ilg.typ_Char, sigptr + elif b0 = et_BOOLEAN then ctxt.ilg.typ_Bool, sigptr elif b0 = et_WITH then let b0,sigptr = sigptrGetByte bytes sigptr let tdorIdx, sigptr = sigptrGetTypeDefOrRefOrSpecIdx bytes sigptr diff --git a/src/absil/ilreflect.fs b/src/absil/ilreflect.fs index 4d136d03386..f1e66baa4fb 100644 --- a/src/absil/ilreflect.fs +++ b/src/absil/ilreflect.fs @@ -1192,7 +1192,7 @@ let rec emitInstr cenv (modB : ModuleBuilder) emEnv (ilG:ILGenerator) instr = ilG.EmitAndLog(OpCodes.Initblk) | EI_ldlen_multi (_,m) -> emitInstr cenv modB emEnv ilG (mkLdcInt32 m); - emitInstr cenv modB emEnv ilG (mkNormalCall(mkILNonGenericMethSpecInTy(cenv.ilg.typ_Array, ILCallingConv.Instance, "GetLength", [cenv.ilg.typ_int32], cenv.ilg.typ_int32))) + emitInstr cenv modB emEnv ilG (mkNormalCall(mkILNonGenericMethSpecInTy(cenv.ilg.typ_Array, ILCallingConv.Instance, "GetLength", [cenv.ilg.typ_Int32], cenv.ilg.typ_Int32))) | i -> Printf.failwithf "the IL instruction %s cannot be emitted" (i.ToString()) @@ -1670,11 +1670,11 @@ let typeAttributesOfTypeLayout cenv emEnv x = else Some(convCustomAttr cenv emEnv (IL.mkILCustomAttribute cenv.ilg - (mkILTyRef (cenv.ilg.traits.ScopeRef,"System.Runtime.InteropServices.StructLayoutAttribute"), - [mkILNonGenericValueTy (mkILTyRef (cenv.ilg.traits.ScopeRef,"System.Runtime.InteropServices.LayoutKind")) ], + (cenv.ilg.mkSysILTypeRef "System.Runtime.InteropServices.StructLayoutAttribute", + [mkILNonGenericValueTy (cenv.ilg.mkSysILTypeRef "System.Runtime.InteropServices.LayoutKind") ], [ ILAttribElem.Int32 x ], - (p.Pack |> Option.toList |> List.map (fun x -> ("Pack", cenv.ilg.typ_int32, false, ILAttribElem.Int32 (int32 x)))) @ - (p.Size |> Option.toList |> List.map (fun x -> ("Size", cenv.ilg.typ_int32, false, ILAttribElem.Int32 x)))))) in + (p.Pack |> Option.toList |> List.map (fun x -> ("Pack", cenv.ilg.typ_Int32, false, ILAttribElem.Int32 (int32 x)))) @ + (p.Size |> Option.toList |> List.map (fun x -> ("Size", cenv.ilg.typ_Int32, false, ILAttribElem.Int32 x)))))) in match x with | ILTypeDefLayout.Auto -> TypeAttributes.AutoLayout,None | ILTypeDefLayout.Explicit p -> TypeAttributes.ExplicitLayout,(attr 0x02 p) diff --git a/src/absil/ilwrite.fs b/src/absil/ilwrite.fs index 51c3f65dc07..3e4b91b9ff1 100644 --- a/src/absil/ilwrite.fs +++ b/src/absil/ilwrite.fs @@ -549,8 +549,7 @@ type MetadataTable = [] type cenv = - { primaryAssembly: ILScopeRef - ilg: ILGlobals + { ilg: ILGlobals emitTailcalls: bool showTimes: bool desiredMetadataVersion: ILVersionInfo @@ -2027,21 +2026,21 @@ module Codebuf = if (shape = ILArrayShape.SingleDimensional) then emitTypeInstr cenv codebuf env i_newarr ty else - let args = List.init shape.Rank (fun _ -> cenv.ilg.typ_int32) + let args = List.init shape.Rank (fun _ -> cenv.ilg.typ_Int32) emitMethodSpecInfoInstr cenv codebuf env i_newobj (".ctor",mkILArrTy(ty,shape),ILCallingConv.Instance,args,ILType.Void,None,[]) | I_stelem_any (shape,ty) -> if (shape = ILArrayShape.SingleDimensional) then emitTypeInstr cenv codebuf env i_stelem_any ty else - let args = List.init (shape.Rank+1) (fun i -> if i < shape.Rank then cenv.ilg.typ_int32 else ty) + let args = List.init (shape.Rank+1) (fun i -> if i < shape.Rank then cenv.ilg.typ_Int32 else ty) emitMethodSpecInfoInstr cenv codebuf env i_call ("Set",mkILArrTy(ty,shape),ILCallingConv.Instance,args,ILType.Void,None,[]) | I_ldelem_any (shape,ty) -> if (shape = ILArrayShape.SingleDimensional) then emitTypeInstr cenv codebuf env i_ldelem_any ty else - let args = List.init shape.Rank (fun _ -> cenv.ilg.typ_int32) + let args = List.init shape.Rank (fun _ -> cenv.ilg.typ_Int32) emitMethodSpecInfoInstr cenv codebuf env i_call ("Get",mkILArrTy(ty,shape),ILCallingConv.Instance,args,ty,None,[]) | I_ldelema (ro,_isNativePtr,shape,ty) -> @@ -2050,7 +2049,7 @@ module Codebuf = if (shape = ILArrayShape.SingleDimensional) then emitTypeInstr cenv codebuf env i_ldelema ty else - let args = List.init shape.Rank (fun _ -> cenv.ilg.typ_int32) + let args = List.init shape.Rank (fun _ -> cenv.ilg.typ_Int32) emitMethodSpecInfoInstr cenv codebuf env i_call ("Address",mkILArrTy(ty,shape),ILCallingConv.Instance,args,ILType.Byref ty,None,[]) | I_castclass ty -> emitTypeInstr cenv codebuf env i_castclass ty @@ -2070,7 +2069,7 @@ module Codebuf = | I_sizeof ty -> emitTypeInstr cenv codebuf env i_sizeof ty | EI_ldlen_multi (_,m) -> emitShortInt32Instr codebuf (i_ldc_i4_s,i_ldc_i4) m - emitInstr cenv codebuf env (mkNormalCall(mkILNonGenericMethSpecInTy(cenv.ilg.typ_Array, ILCallingConv.Instance, "GetLength", [(cenv.ilg.typ_int32)], (cenv.ilg.typ_int32)))) + emitInstr cenv codebuf env (mkNormalCall(mkILNonGenericMethSpecInTy(cenv.ilg.typ_Array, ILCallingConv.Instance, "GetLength", [(cenv.ilg.typ_Int32)], (cenv.ilg.typ_Int32)))) | _ -> failwith "an IL instruction cannot be emitted" @@ -2946,14 +2945,13 @@ let GenModule (cenv : cenv) (modul: ILModuleDef) = GenTypeDefsPass4 [] cenv tds reportTime cenv.showTimes "Module Generation Pass 4" -let generateIL requiredDataFixups (desiredMetadataVersion,generatePdb, ilg : ILGlobals, emitTailcalls,showTimes) (m : ILModuleDef) noDebugData cilStartAddress = +let generateIL requiredDataFixups (desiredMetadataVersion,generatePdb, ilg : ILGlobals, emitTailcalls,showTimes) (m : ILModuleDef) cilStartAddress = let isDll = m.IsDLL let cenv = - { primaryAssembly=ilg.traits.ScopeRef - emitTailcalls=emitTailcalls + { emitTailcalls=emitTailcalls showTimes=showTimes - ilg = mkILGlobals ilg.traits None noDebugData // assumes mscorlib is Scope_assembly _ ILScopeRef + ilg = ilg desiredMetadataVersion=desiredMetadataVersion requiredDataFixups= requiredDataFixups requiredStringFixups = [] @@ -3086,7 +3084,7 @@ module FileSystemUtilites = #endif () -let writeILMetadataAndCode (generatePdb,desiredMetadataVersion,ilg,emitTailcalls,showTimes) modul noDebugData cilStartAddress = +let writeILMetadataAndCode (generatePdb,desiredMetadataVersion,ilg,emitTailcalls,showTimes) modul cilStartAddress = // When we know the real RVAs of the data section we fixup the references for the FieldRVA table. // These references are stored as offsets into the metadata we return from this function @@ -3095,7 +3093,7 @@ let writeILMetadataAndCode (generatePdb,desiredMetadataVersion,ilg,emitTailcalls let next = cilStartAddress let strings,userStrings,blobs,guids,tables,entryPointToken,code,requiredStringFixups,data,resources,pdbData,mappings = - generateIL requiredDataFixups (desiredMetadataVersion,generatePdb,ilg,emitTailcalls,showTimes) modul noDebugData cilStartAddress + generateIL requiredDataFixups (desiredMetadataVersion,generatePdb,ilg,emitTailcalls,showTimes) modul cilStartAddress reportTime showTimes "Generated Tables and Code" let tableSize (tab: TableName) = tables.[tab.Index].Count @@ -3536,8 +3534,8 @@ let writeDirectory os dict = let writeBytes (os: BinaryWriter) (chunk:byte[]) = os.Write(chunk,0,chunk.Length) -let writeBinaryAndReportMappings (outfile, ilg, pdbfile: string option, signer: ILStrongNameSigner option, portablePDB, embeddedPDB, embedAllSource, embedSourceList, - sourceLink, fixupOverlappingSequencePoints, emitTailcalls, showTimes, dumpDebugInfo) modul noDebugData = +let writeBinaryAndReportMappings (outfile, ilg: ILGlobals, pdbfile: string option, signer: ILStrongNameSigner option, portablePDB, embeddedPDB, embedAllSource, embedSourceList, + sourceLink, fixupOverlappingSequencePoints, emitTailcalls, showTimes, dumpDebugInfo) modul = // Store the public key from the signer into the manifest. This means it will be written // to the binary and also acts as an indicator to leave space for delay sign @@ -3644,7 +3642,7 @@ let writeBinaryAndReportMappings (outfile, ilg, pdbfile: string option, signer: if modul.MetadataVersion <> "" then parseILVersion modul.MetadataVersion else - match ilg.traits.ScopeRef with + match ilg.primaryAssemblyScopeRef with | ILScopeRef.Local -> failwith "Expected mscorlib to be ILScopeRef.Assembly was ILScopeRef.Local" | ILScopeRef.Module(_) -> failwith "Expected mscorlib to be ILScopeRef.Assembly was ILScopeRef.Module" | ILScopeRef.Assembly(aref) -> @@ -3654,7 +3652,7 @@ let writeBinaryAndReportMappings (outfile, ilg, pdbfile: string option, signer: | None -> failwith "Expected msorlib to have a version number" let entryPointToken,code,codePadding,metadata,data,resources,requiredDataFixups,pdbData,mappings = - writeILMetadataAndCode ((pdbfile <> None), desiredMetadataVersion, ilg,emitTailcalls,showTimes) modul noDebugData next + writeILMetadataAndCode ((pdbfile <> None), desiredMetadataVersion, ilg,emitTailcalls,showTimes) modul next reportTime showTimes "Generated IL and metadata"; let _codeChunk,next = chunk code.Length next @@ -4268,7 +4266,9 @@ type options = showTimes: bool dumpDebugInfo:bool } -let WriteILBinary (outfile, (args: options), modul, noDebugData) = - ignore (writeBinaryAndReportMappings (outfile, args.ilg, args.pdbfile, args.signer, args.portablePDB, args.embeddedPDB, - args.embedAllSource, args.embedSourceList, args.sourceLink, args.fixupOverlappingSequencePoints, - args.emitTailcalls, args.showTimes, args.dumpDebugInfo) modul noDebugData) +let WriteILBinary (outfile, (args: options), modul) = + writeBinaryAndReportMappings (outfile, args.ilg, args.pdbfile, args.signer, args.portablePDB, args.embeddedPDB, + args.embedAllSource, args.embedSourceList, args.sourceLink, args.fixupOverlappingSequencePoints, + args.emitTailcalls, args.showTimes, args.dumpDebugInfo) modul + |> ignore + diff --git a/src/absil/ilwrite.fsi b/src/absil/ilwrite.fsi index 3ee76893062..c97fc7d39c4 100644 --- a/src/absil/ilwrite.fsi +++ b/src/absil/ilwrite.fsi @@ -30,4 +30,4 @@ type options = dumpDebugInfo : bool } /// Write a binary to the file system. Extra configuration parameters can also be specified. -val WriteILBinary: filename: string * options: options * input: ILModuleDef * noDebugData: bool -> unit +val WriteILBinary: filename: string * options: options * input: ILModuleDef -> unit diff --git a/src/fsharp/AugmentWithHashCompare.fs b/src/fsharp/AugmentWithHashCompare.fs index 238f13d901f..3fe6dd4335b 100644 --- a/src/fsharp/AugmentWithHashCompare.fs +++ b/src/fsharp/AugmentWithHashCompare.fs @@ -43,8 +43,8 @@ let mkEqualsSlotSig g = TSlotSig("Equals", g.obj_ty, [],[], [[TSlotParam(Some("obj"),g.obj_ty,false,false,false,[])]],Some g.bool_ty) -let mkILObjectGetTypeMethSpec ilg = IL.mkILNonGenericInstanceMethSpecInTy(ilg.typ_Object,"GetType",[],ilg.typ_Type) -let mkILObjectToStringMethSpec ilg = IL.mkILNonGenericInstanceMethSpecInTy(ilg.typ_Object,"ToString",[],ilg.typ_String) +let mkILObjectGetTypeMethSpec (ilg: ILGlobals) = IL.mkILNonGenericInstanceMethSpecInTy(ilg.typ_Object,"GetType",[],ilg.typ_Type) +let mkILObjectToStringMethSpec (ilg: ILGlobals) = IL.mkILNonGenericInstanceMethSpecInTy(ilg.typ_Object,"ToString",[],ilg.typ_String) //------------------------------------------------------------------------- diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index cb24a477324..9258ae26589 100644 --- a/src/fsharp/CompileOps.fs +++ b/src/fsharp/CompileOps.fs @@ -1661,8 +1661,10 @@ let DefaultReferencesForScriptsAndOutOfProjectSources(assumeDotNetFramework) = // A set of assemblies to always consider to be system assemblies let SystemAssemblies () = + HashSet [ yield "mscorlib" yield "System.Runtime" + yield "System.Private.CoreLib" yield "FSharp.Core" yield "System" yield "System.Xml" @@ -1886,109 +1888,10 @@ type AvailableImportedAssembly = | ResolvedImportedAssembly of ImportedAssembly | UnresolvedImportedAssembly of string -// Helps to perform 2-step initialization of the system runtime -// Compiler heavily relies on ILGlobals structure that contains fundamental types. -// For mscorlib based profiles everything was easy - all fundamental types were located in one assembly so initialization sequence was simple -// - read mscorlib -> create ILGlobals (*) -> use ILGlobals to read remaining assemblies -// For .NETCore everything is not so obvious because fundamental types now reside in different assemblies and this makes initialization more tricky: -// - read system runtime -> create ILGlobals that is partially initialized (*) -> use ILGlobals to read remaining assemblies -> finish the initialization of ILGlobals using data from the previous step -// BeginLoadingSystemRuntime -> (*) EndLoadingSystemRuntime - type CcuLoadFailureAction = | RaiseError | ReturnNone -type ISystemRuntimeCcuInitializer = - abstract BeginLoadingSystemRuntime : resolver : (AssemblyReference -> ImportedAssembly) * noDebug :bool -> ILGlobals * obj - abstract EndLoadingSystemRuntime : state : obj * resolver : (CcuLoadFailureAction -> AssemblyReference -> ImportedAssembly option) -> ImportedAssembly - -type NetCoreSystemRuntimeTraits(primaryAssembly) = - - let valueOf name hole = - match hole with - | Some assembly -> assembly - | None -> failwithf "Internal compiler error: scope ref hole '%s' is not initialized" name - - let mutable systemReflection = None - let mutable systemDiagnosticsDebug = None - let mutable systemLinqExpressions = None - let mutable systemCollections = None - let mutable systemRuntimeInteropServices = None - - member this.FixupImportedAssemblies(systemReflectionRef, systemDiagnosticsDebugRef, systemLinqExpressionsRef, systemCollectionsRef, systemRuntimeInteropServicesRef) = - systemReflection <- systemReflectionRef - systemDiagnosticsDebug <- systemDiagnosticsDebugRef - systemLinqExpressions <- systemLinqExpressionsRef - systemCollections <- systemCollectionsRef - systemRuntimeInteropServices <- systemRuntimeInteropServicesRef - - interface IPrimaryAssemblyTraits with - member this.ScopeRef = primaryAssembly - member this.SystemReflectionScopeRef = lazy ((valueOf "System.Reflection" systemReflection).FSharpViewOfMetadata.ILScopeRef) - member this.TypedReferenceTypeScopeRef = None - member this.RuntimeArgumentHandleTypeScopeRef = None - member this.SerializationInfoTypeScopeRef = None - member this.SecurityPermissionAttributeTypeScopeRef = None - member this.SystemDiagnosticsDebugScopeRef = lazy ((valueOf "System.Diagnostics.Debug" systemDiagnosticsDebug).FSharpViewOfMetadata.ILScopeRef) - member this.SystemRuntimeInteropServicesScopeRef = - lazy - match systemRuntimeInteropServices with - | Some assemblyRef -> Some assemblyRef.FSharpViewOfMetadata.ILScopeRef - | None -> None - member this.IDispatchConstantAttributeScopeRef = None - member this.IUnknownConstantAttributeScopeRef = None - member this.ContextStaticAttributeScopeRef = None - member this.ThreadStaticAttributeScopeRef = None - member this.SystemLinqExpressionsScopeRef = lazy ((valueOf "System.Linq.Expressions" systemLinqExpressions).FSharpViewOfMetadata.ILScopeRef) - member this.SystemCollectionsScopeRef = lazy ((valueOf "System.Collections" systemCollections).FSharpViewOfMetadata.ILScopeRef) - member this.SpecialNameAttributeScopeRef = None - member this.NonSerializedAttributeScopeRef = None - member this.MarshalByRefObjectScopeRef = None - member this.ArgIteratorTypeScopeRef = None - -let getSystemRuntimeInitializer (primaryAssembly: PrimaryAssembly) (mkReference : string -> AssemblyReference) : ISystemRuntimeCcuInitializer = - let name = primaryAssembly.Name - let primaryAssemblyReference = mkReference name - - match primaryAssembly with - | Mscorlib -> - { - new ISystemRuntimeCcuInitializer with - member this.BeginLoadingSystemRuntime(resolver, noData) = - let mscorlibRef = resolver primaryAssemblyReference - let traits = (IL.mkMscorlibBasedTraits mscorlibRef.FSharpViewOfMetadata.ILScopeRef) - (mkILGlobals traits (Some name) noData), box mscorlibRef - member this.EndLoadingSystemRuntime(state, _resolver) = - unbox state - } - - | DotNetCore -> - let systemReflectionRef = mkReference "System.Reflection" - let systemDiagnosticsDebugRef = mkReference "System.Diagnostics.Debug" - let systemLinqExpressionsRef = mkReference "System.Linq.Expressions" - let systemCollectionsRef = mkReference "System.Collections" - let systemRuntimeInteropServicesRef = mkReference "System.Runtime.InteropServices" - { - new ISystemRuntimeCcuInitializer with - member this.BeginLoadingSystemRuntime(resolver, noData) = - let primaryAssembly = resolver primaryAssemblyReference - let traits = new NetCoreSystemRuntimeTraits(primaryAssembly.FSharpViewOfMetadata.ILScopeRef) - mkILGlobals traits (Some name) noData, box (primaryAssembly, traits) - member this.EndLoadingSystemRuntime(state, resolver) = - let (primaryAssembly : ImportedAssembly, traits : NetCoreSystemRuntimeTraits) = unbox state - // finish initialization of SystemRuntimeTraits - traits.FixupImportedAssemblies - ( - systemReflectionRef = resolver CcuLoadFailureAction.RaiseError systemReflectionRef, - systemDiagnosticsDebugRef = resolver CcuLoadFailureAction.RaiseError systemDiagnosticsDebugRef, - systemRuntimeInteropServicesRef = resolver CcuLoadFailureAction.ReturnNone systemRuntimeInteropServicesRef, - systemLinqExpressionsRef = resolver CcuLoadFailureAction.RaiseError systemLinqExpressionsRef, - systemCollectionsRef = resolver CcuLoadFailureAction.RaiseError systemCollectionsRef - ) - primaryAssembly - } - - type TcConfigBuilder = { mutable primaryAssembly : PrimaryAssembly mutable autoResolveOpenDirectivesToDlls: bool @@ -2145,10 +2048,8 @@ type TcConfigBuilder = // If true - the compiler will copy FSharp.Core.dll along the produced binaries mutable copyFSharpCore : bool -#if FSI_SHADOW_COPY_REFERENCES /// When false FSI will lock referenced assemblies requiring process restart, false = disable Shadow Copy false (*default*) mutable shadowCopyReferences : bool -#endif } static member CreateNew (referenceResolver,defaultFSharpBinariesDir,optimizeForMemory,implicitIncludeDir,isInteractive,isInvalidationSupported) = @@ -2291,9 +2192,7 @@ type TcConfigBuilder = emitDebugInfoInQuotations = false exename = None copyFSharpCore = true -#if FSI_SHADOW_COPY_REFERENCES shadowCopyReferences = false -#endif } member tcConfigB.ResolveSourceFile(m,nm,pathLoadedFrom) = @@ -2415,17 +2314,13 @@ type TcConfigBuilder = ri,fileNameOfPath ri,ILResourceAccess.Public -#if FSI_SHADOW_COPY_REFERENCES -let OpenILBinary(filename,optimizeForMemory,openBinariesInMemory,ilGlobalsOpt, pdbPathOption, primaryAssemblyName, noDebugData, shadowCopyReferences) = -#else -let OpenILBinary(filename,optimizeForMemory,openBinariesInMemory,ilGlobalsOpt, pdbPathOption, primaryAssemblyName, noDebugData) = -#endif +let OpenILBinary(filename,optimizeForMemory,openBinariesInMemory,ilGlobalsOpt, pdbPathOption, noDebugData, shadowCopyReferences) = let ilGlobals = // ILScopeRef.Local can be used only for primary assembly (mscorlib or System.Runtime) itself // Remaining assemblies should be opened using existing ilGlobals (so they can properly locate fundamental types) match ilGlobalsOpt with - | None -> mkILGlobals (IL.mkMscorlibBasedTraits ILScopeRef.Local) (Some primaryAssemblyName) noDebugData - | Some ilGlobals -> ilGlobals + | None -> mkILGlobals (noDebugData, (fun _ -> ILScopeRef.Local), (fun _ -> Some ILScopeRef.Local)) + | Some g -> g let opts = { ILBinaryReader.mkDefault ilGlobals with // fsc.exe does not uses optimizeForMemory (hence keeps MORE caches in AbstractIL) @@ -2447,6 +2342,8 @@ let OpenILBinary(filename,optimizeForMemory,openBinariesInMemory,ilGlobalsOpt, p System.Reflection.Assembly.ReflectionOnlyLoadFrom(filename).Location with e -> filename else +#else + ignore shadowCopyReferences #endif filename ILBinaryReader.OpenILModuleReader location opts @@ -2461,6 +2358,7 @@ type AssemblyResolution = sysdir : bool ilAssemblyRef : ILAssemblyRef option ref } + override this.ToString() = sprintf "%s%s" (if this.sysdir then "[sys]" else "") this.resolvedPath member this.ProjectReference = this.originalReference.ProjectReference member this.ILAssemblyRef = match !this.ilAssemblyRef with @@ -2480,7 +2378,7 @@ type AssemblyResolution = match assRefOpt with | Some aref -> aref | None -> - let readerSettings : ILBinaryReader.ILReaderOptions = {pdbPath=None;ilGlobals = EcmaILGlobals;optimizeForMemory=false} // ?? + let readerSettings : ILBinaryReader.ILReaderOptions = {pdbPath=None;ilGlobals = EcmaMscorlibILGlobals;optimizeForMemory=false} use reader = ILBinaryReader.OpenILModuleReaderAfterReadingAllBytes this.resolvedPath readerSettings mkRefToILAssembly reader.ILModuleDef.ManifestOfAssembly this.ilAssemblyRef := Some(assRef) @@ -2497,19 +2395,19 @@ let GetNameOfILModule (m: ILModuleDef) = | None -> m.Name -let MakeScopeRefForIlModule (ilModule: ILModuleDef) = +let MakeScopeRefForILModule (ilModule: ILModuleDef) = match ilModule.Manifest with | Some m -> ILScopeRef.Assembly (mkRefToILAssembly m) | None -> ILScopeRef.Module (mkRefToILModule ilModule) -let GetCustomAttributesOfIlModule (ilModule:ILModuleDef) = +let GetCustomAttributesOfILModule (ilModule:ILModuleDef) = (match ilModule.Manifest with Some m -> m.CustomAttrs | None -> ilModule.CustomAttrs).AsList let GetAutoOpenAttributes ilg ilModule = - ilModule |> GetCustomAttributesOfIlModule |> List.choose (TryFindAutoOpenAttr ilg) + ilModule |> GetCustomAttributesOfILModule |> List.choose (TryFindAutoOpenAttr ilg) let GetInternalsVisibleToAttributes ilg ilModule = - ilModule |> GetCustomAttributesOfIlModule |> List.choose (TryFindInternalsVisibleToAttr ilg) + ilModule |> GetCustomAttributesOfILModule |> List.choose (TryFindInternalsVisibleToAttr ilg) //---------------------------------------------------------------------------- // TcConfig @@ -2553,7 +2451,6 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = // if FSharp.Core was not provided explicitly - use version that was referenced by compiler AssemblyReference(range0, GetFSharpCoreReferenceUsedByCompiler(data.useSimpleResolution), None), None | _ -> res - let primaryAssemblyCcuInitializer = getSystemRuntimeInitializer data.primaryAssembly (computeKnownDllReference >> fst) // If either mscorlib.dll/System.Runtime.dll or FSharp.Core.dll are explicitly specified then we require the --noframework flag. // The reason is that some non-default frameworks may not have the default dlls. For example, Client profile does @@ -2566,11 +2463,7 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = | Some(primaryAssemblyFilename) -> let filename = ComputeMakePathAbsolute data.implicitIncludeDir primaryAssemblyFilename try -#if FSI_SHADOW_COPY_REFERENCES - use ilReader = OpenILBinary(filename,data.optimizeForMemory,data.openBinariesInMemory,None,None, data.primaryAssembly.Name, data.noDebugData, data.shadowCopyReferences) -#else - use ilReader = OpenILBinary(filename,data.optimizeForMemory,data.openBinariesInMemory,None,None, data.primaryAssembly.Name, data.noDebugData) -#endif + use ilReader = OpenILBinary(filename,data.optimizeForMemory,data.openBinariesInMemory,None,None, data.noDebugData, data.shadowCopyReferences) let ilModule = ilReader.ILModuleDef match ilModule.ManifestOfAssembly.Version with | Some(v1,v2,v3,_) -> @@ -2634,11 +2527,7 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = | Some(fslibFilename) -> let filename = ComputeMakePathAbsolute data.implicitIncludeDir fslibFilename try -#if FSI_SHADOW_COPY_REFERENCES - use ilReader = OpenILBinary(filename,data.optimizeForMemory,data.openBinariesInMemory,None,None, data.primaryAssembly.Name, data.noDebugData, data.shadowCopyReferences) -#else - use ilReader = OpenILBinary(filename,data.optimizeForMemory,data.openBinariesInMemory,None,None, data.primaryAssembly.Name, data.noDebugData) -#endif + use ilReader = OpenILBinary(filename,data.optimizeForMemory,data.openBinariesInMemory,None,None, data.noDebugData, data.shadowCopyReferences) checkFSharpBinaryCompatWithMscorlib filename ilReader.ILAssemblyRefs ilReader.ILModuleDef.ManifestOfAssembly.Version rangeStartup; let fslibRoot = Path.GetDirectoryName(FileSystem.GetFullPathShim(filename)) fslibRoot (* , sprintf "v%d.%d" v1 v2 *) @@ -2773,9 +2662,7 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = member x.sqmNumOfSourceFiles = data.sqmNumOfSourceFiles member x.sqmSessionStartedTime = data.sqmSessionStartedTime member x.copyFSharpCore = data.copyFSharpCore -#if FSI_SHADOW_COPY_REFERENCES member x.shadowCopyReferences = data.shadowCopyReferences -#endif static member Create(builder,validate) = use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.Parameter) TcConfig(builder,validate) @@ -2847,7 +2734,7 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = try FileSystem.SafeExists filename && ((tcConfig.TargetFrameworkDirectories |> List.exists (fun clrRoot -> clrRoot = Path.GetDirectoryName filename)) || - (systemAssemblies |> List.exists (fun sysFile -> sysFile = fileNameWithoutExtension filename))) + (systemAssemblies.Contains(fileNameWithoutExtension filename))) with _ -> false @@ -2910,7 +2797,7 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = if isNetModule then "" else try - let readerSettings : ILBinaryReader.ILReaderOptions = {pdbPath=None;ilGlobals = EcmaILGlobals;optimizeForMemory=false} + let readerSettings : ILBinaryReader.ILReaderOptions = {pdbPath=None;ilGlobals = EcmaMscorlibILGlobals;optimizeForMemory=false} use reader = ILBinaryReader.OpenILModuleReaderAfterReadingAllBytes resolved readerSettings let assRef = mkRefToILAssembly reader.ILModuleDef.ManifestOfAssembly assRef.QualifiedName @@ -3091,7 +2978,6 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = member tcConfig.PrimaryAssemblyDllReference() = primaryAssemblyReference - member tcConfig.GetPrimaryAssemblyCcuInitializer() = primaryAssemblyCcuInitializer member tcConfig.CoreLibraryDllReference() = fslibReference @@ -3616,13 +3502,13 @@ type RawFSharpAssemblyDataBackedByFileOnDisk (ilModule: ILModuleDef, ilAssemblyR | Some manifest -> manifest.ExportedTypes | None -> mkILExportedTypes [] member __.ShortAssemblyName = GetNameOfILModule ilModule - member __.ILScopeRef = MakeScopeRefForIlModule ilModule + member __.ILScopeRef = MakeScopeRefForILModule ilModule member __.ILAssemblyRefs = ilAssemblyRefs member __.HasAnyFSharpSignatureDataAttribute = - let attrs = GetCustomAttributesOfIlModule ilModule + let attrs = GetCustomAttributesOfILModule ilModule List.exists IsSignatureDataVersionAttr attrs member __.HasMatchingFSharpSignatureDataAttribute(ilg) = - let attrs = GetCustomAttributesOfIlModule ilModule + let attrs = GetCustomAttributesOfILModule ilModule List.exists (IsMatchingSignatureDataVersionAttr ilg (IL.parseILVersion Internal.Utilities.FSharpEnvironment.FSharpBinaryMetadataFormatRevision)) attrs @@ -3679,8 +3565,6 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti let CheckDisposed() = if disposed then assert false - // REVIEW: Post-RTM, we should remove static dependencies over "expected" foundational CCUs, and - // search over all imported CCUs for each cached type static let ccuHasType (ccu : CcuThunk) (nsname : string list) (tname : string) = match (Some ccu.Contents, nsname) ||> List.fold (fun entityOpt n -> match entityOpt with None -> None | Some entity -> entity.ModuleOrNamespaceType.AllEntitiesByCompiledAndLogicalMangledNames.TryFind n) with | Some ns -> @@ -3749,7 +3633,7 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti member tcImports.GetImportedAssemblies() = CheckDisposed() match importsBase with - | Some(importsBase)-> importsBase.GetImportedAssemblies() @ ccuInfos + | Some(importsBase)-> List.append (importsBase.GetImportedAssemblies()) ccuInfos | None -> ccuInfos member tcImports.GetCcusExcludingBase() = @@ -3906,18 +3790,14 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti None else None -#if FSI_SHADOW_COPY_REFERENCES - let ilILBinaryReader = OpenILBinary(filename,tcConfig.optimizeForMemory,tcConfig.openBinariesInMemory,ilGlobalsOpt,pdbPathOption, tcConfig.primaryAssembly.Name, tcConfig.noDebugData, tcConfig.shadowCopyReferences) -#else - let ilILBinaryReader = OpenILBinary(filename,tcConfig.optimizeForMemory,tcConfig.openBinariesInMemory,ilGlobalsOpt,pdbPathOption, tcConfig.primaryAssembly.Name, tcConfig.noDebugData) -#endif + let ilILBinaryReader = OpenILBinary(filename,tcConfig.optimizeForMemory,tcConfig.openBinariesInMemory,ilGlobalsOpt,pdbPathOption, tcConfig.noDebugData, tcConfig.shadowCopyReferences) tcImports.AttachDisposeAction(fun _ -> (ilILBinaryReader :> IDisposable).Dispose()) ilILBinaryReader.ILModuleDef, ilILBinaryReader.ILAssemblyRefs with e -> error(Error(FSComp.SR.buildErrorOpeningBinaryFile(filename, e.Message),m)) (* auxModTable is used for multi-module assemblies *) - member tcImports.MkLoaderForMultiModuleIlAssemblies m = + member tcImports.MkLoaderForMultiModuleILAssemblies m = CheckDisposed() let auxModTable = HashMultiMap(10, HashIdentity.Structural) fun viewedScopeRef -> @@ -4041,7 +3921,7 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti // have class which implement ITypeProvider and which have TypeProviderAttribute on them. let providerAssemblies = runtimeAssemblyAttributes - |> List.choose (TryDecodeTypeProviderAssemblyAttr (defaultArg ilGlobalsOpt EcmaILGlobals)) + |> List.choose (TryDecodeTypeProviderAssemblyAttr (defaultArg ilGlobalsOpt EcmaMscorlibILGlobals)) // If no design-time assembly is specified, use the runtime assembly |> List.map (function null -> Path.GetFileNameWithoutExtension fileNameOfRuntimeAssembly | s -> s) |> Set.ofList @@ -4142,7 +4022,7 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti member tcImports.SystemRuntimeContainsType (typeName : string) : bool = let ns, typeName = IL.splitILTypeName typeName let tcGlobals = tcImports.GetTcGlobals() - ccuHasType tcGlobals.sysCcu ns typeName + tcGlobals.tryMkSysTyconRef ns typeName |> Option.isSome // Add a referenced assembly // @@ -4151,7 +4031,7 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti // Compact Framework binaries must use this. However it is not // clear when else it is required, e.g. for Mono. - member tcImports.PrepareToImportReferencedIlDll m filename (dllinfo:ImportedBinary) = + member tcImports.PrepareToImportReferencedILAssembly m filename (dllinfo:ImportedBinary) = CheckDisposed() let tcConfig = tcConfigP.Get() tcConfig.CheckFSharpBinary(filename,dllinfo.ILAssemblyRefs,m) @@ -4161,15 +4041,15 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti let aref = match ilScopeRef with | ILScopeRef.Assembly aref -> aref - | _ -> error(InternalError("PrepareToImportReferencedIlDll: cannot reference .NET netmodules directly, reference the containing assembly instead",m)) + | _ -> error(InternalError("PrepareToImportReferencedILAssembly: cannot reference .NET netmodules directly, reference the containing assembly instead",m)) let nm = aref.Name if verbose then dprintn ("Converting IL assembly to F# data structures "+nm) - let auxModuleLoader = tcImports.MkLoaderForMultiModuleIlAssemblies m + let auxModuleLoader = tcImports.MkLoaderForMultiModuleILAssemblies m let invalidateCcu = new Event<_>() let ccu = Import.ImportILAssembly(tcImports.GetImportMap,m,auxModuleLoader,ilScopeRef,tcConfig.implicitIncludeDir, Some filename,ilModule,invalidateCcu.Publish) - let ilg = defaultArg ilGlobalsOpt EcmaILGlobals + let ilg = defaultArg ilGlobalsOpt EcmaMscorlibILGlobals let ccuinfo = { FSharpViewOfMetadata=ccu @@ -4189,7 +4069,7 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti [ResolvedImportedAssembly(ccuinfo)] phase2 - member tcImports.PrepareToImportReferencedFSharpDll m filename (dllinfo:ImportedBinary) = + member tcImports.PrepareToImportReferencedFSharpAssembly m filename (dllinfo:ImportedBinary) = CheckDisposed() let tcConfig = tcConfigP.Get() tcConfig.CheckFSharpBinary(filename,dllinfo.ILAssemblyRefs,m) @@ -4246,7 +4126,7 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti let res = data.OptionalFixup(fun nm -> availableToOptionalCcu(tcImports.FindCcu(m,nm,lookupOnly=false))) if verbose then dprintf "found optimization data for CCU %s\n" ccuName Some res) - let ilg = defaultArg ilGlobalsOpt EcmaILGlobals + let ilg = defaultArg ilGlobalsOpt EcmaMscorlibILGlobals let ccuinfo = { FSharpViewOfMetadata=ccu AssemblyAutoOpenAttributes = ilModule.GetAutoOpenAttributes(ilg) @@ -4316,18 +4196,18 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti ILScopeRef = ilScopeRef ILAssemblyRefs = assemblyData.ILAssemblyRefs } tcImports.RegisterDll(dllinfo) - let ilg = defaultArg ilGlobalsOpt EcmaILGlobals + let ilg = defaultArg ilGlobalsOpt EcmaMscorlibILGlobals let phase2 = if assemblyData.HasAnyFSharpSignatureDataAttribute then if not (assemblyData.HasMatchingFSharpSignatureDataAttribute(ilg)) then errorR(Error(FSComp.SR.buildDifferentVersionMustRecompile(filename),m)) - tcImports.PrepareToImportReferencedIlDll m filename dllinfo + tcImports.PrepareToImportReferencedILAssembly m filename dllinfo else try - tcImports.PrepareToImportReferencedFSharpDll m filename dllinfo + tcImports.PrepareToImportReferencedFSharpAssembly m filename dllinfo with e -> error(Error(FSComp.SR.buildErrorOpeningBinaryFile(filename, e.Message),m)) else - tcImports.PrepareToImportReferencedIlDll m filename dllinfo + tcImports.PrepareToImportReferencedILAssembly m filename dllinfo dllinfo,phase2 member tcImports.RegisterAndImportReferencedAssemblies (nms:AssemblyResolution list) = @@ -4453,33 +4333,39 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti // Note: TcImports are disposable - the caller owns this object and must dispose let frameworkTcImports = new TcImports(tcConfigP,tcResolutions,None,None) - let resolveAssembly loadFailureAction r = - // use existing resolutions before trying to search in known folders - let resolution = - match tcResolutions.TryFindByOriginalReference r with - | Some r -> Some r - | None -> - match tcAltResolutions.TryFindByOriginalReference r with - | Some r -> Some r - | None -> tcConfig.ResolveLibWithDirectories loadFailureAction r - match resolution with - | Some resolution -> - match frameworkTcImports.RegisterAndImportReferencedAssemblies([resolution]) with - | (_, [ResolvedImportedAssembly(ccu)]) -> Some ccu - | _ -> - match loadFailureAction with - | CcuLoadFailureAction.RaiseError -> error(InternalError("BuildFoundationalTcImports: no ccu for " + r.Text, rangeStartup)) - | CcuLoadFailureAction.ReturnNone -> None + + let sysCcus = + lazy + [| for ccu in frameworkTcImports.GetCcusInDeclOrder() do + printfn "found sys ccu %s" ccu.AssemblyName + yield ccu |] + + let tryGetTypeCcu nsname typeName = + sysCcus.Value |> Array.tryFind (fun ccu -> ccuHasType ccu nsname typeName) + + // Search for a type + let getTypeCcu nsname typeName = + match tryGetTypeCcu nsname typeName with + | None -> CcuThunk.CreateDelayed(FSComp.SR.tcGlobalsSystemTypeNotFound (String.concat "." nsname + "." + typeName)) + | Some ccu -> ccu + + let tryGetTypeILScopeRef fullTypeName = + let nsname, nm = splitILTypeName fullTypeName + match tryGetTypeCcu nsname nm with | None -> None + | Some ccu -> Some ccu.ILScopeRef - let ccuInitializer = tcConfig.GetPrimaryAssemblyCcuInitializer() - let ilGlobals, state = ccuInitializer.BeginLoadingSystemRuntime((resolveAssembly CcuLoadFailureAction.RaiseError) >> Option.get, tcConfig.noDebugData) + let getTypeILScopeRef fullTypeName = + let nsname, nm = splitILTypeName fullTypeName + (getTypeCcu nsname nm).ILScopeRef + + let ilGlobals = mkILGlobals(tcConfig.noDebugData,getTypeILScopeRef,tryGetTypeILScopeRef) frameworkTcImports.SetILGlobals ilGlobals - let sysCcu = ccuInitializer.EndLoadingSystemRuntime(state, resolveAssembly) // Load the rest of the framework DLLs all at once (they may be mutually recursive) frameworkTcImports.DoRegisterAndImportReferencedAssemblies (tcResolutions.GetAssemblyResolutions()) + let fslibCcu = if tcConfig.compilingFslib then // When compiling FSharp.Core.dll, the fslibCcu reference to FSharp.Core.dll is a delayed ccu thunk fixed up during type checking @@ -4512,36 +4398,15 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti | ILScopeRef.Local | ILScopeRef.Module _ -> error(InternalError("not ILScopeRef.Assembly",rangeStartup))) fslibCcuInfo.FSharpViewOfMetadata - let sysCcus = - [| yield sysCcu.FSharpViewOfMetadata - yield! frameworkTcImports.GetCcusInDeclOrder() - for dllName in SystemAssemblies () do - match frameworkTcImports.CcuTable.TryFind dllName with - | Some sysCcu -> yield sysCcu.FSharpViewOfMetadata - | None -> () |] - - // Search for a type - let getTypeCcu nsname typeName = - if ccuHasType sysCcu.FSharpViewOfMetadata nsname typeName then - sysCcu.FSharpViewOfMetadata - else - let search = sysCcus |> Array.tryFind (fun ccu -> ccuHasType ccu nsname typeName) - match search with - | Some x -> x - | None -> fslibCcu - - // REVIEW: We use this in some places to work around bugs in the 2.0 runtime. - // Silverlight 4.0 will have some of these fixes, but their version number is 2.0.5.0. - // If we ever modify the compiler to run on Silverlight, we'll need to update this mechanism. let using40environment = - match ilGlobals.traits.ScopeRef.AssemblyRef.Version with + match ilGlobals.primaryAssemblyScopeRef.AssemblyRef.Version with | Some (v1, _v2, _v3, _v4) -> v1 >= 4us | _ -> true // OK, now we have both mscorlib.dll and FSharp.Core.dll we can create TcGlobals - let tcGlobals = mkTcGlobals(tcConfig.compilingFslib,sysCcu.FSharpViewOfMetadata,ilGlobals,fslibCcu, + let tcGlobals = mkTcGlobals(tcConfig.compilingFslib,ilGlobals,fslibCcu, tcConfig.implicitIncludeDir,tcConfig.mlCompatibility,using40environment, - tcConfig.isInteractive,getTypeCcu, tcConfig.emitDebugInfoInQuotations, (tcConfig.primaryAssembly.Name = "mscorlib") ) + tcConfig.isInteractive,getTypeCcu, tryGetTypeCcu, tcConfig.emitDebugInfoInQuotations, (tcConfig.primaryAssembly.Name = "mscorlib") ) #if DEBUG // the global_g reference cell is used only for debug printing diff --git a/src/fsharp/CompileOps.fsi b/src/fsharp/CompileOps.fsi index a2358d9858f..1a5bc04cdd8 100755 --- a/src/fsharp/CompileOps.fsi +++ b/src/fsharp/CompileOps.fsi @@ -352,9 +352,7 @@ type TcConfigBuilder = mutable emitDebugInfoInQuotations : bool mutable exename : string option mutable copyFSharpCore : bool -#if FSI_SHADOW_COPY_REFERENCES mutable shadowCopyReferences : bool -#endif } static member CreateNew : diff --git a/src/fsharp/CompileOptions.fs b/src/fsharp/CompileOptions.fs index 0c7cf3a5dc1..acd52fe96e0 100644 --- a/src/fsharp/CompileOptions.fs +++ b/src/fsharp/CompileOptions.fs @@ -762,6 +762,7 @@ let SetTargetProfile tcConfigB v = match v with | "mscorlib" -> PrimaryAssembly.Mscorlib | "netcore" -> PrimaryAssembly.DotNetCore + | "privatecorelib" -> PrimaryAssembly.PrivateCoreLib | _ -> error(Error(FSComp.SR.optsInvalidTargetProfile(v), rangeCmdArgs)) let advancedFlagsFsc tcConfigB = diff --git a/src/fsharp/FSComp.txt b/src/fsharp/FSComp.txt index d6df0a2aa6c..5139a90eae0 100644 --- a/src/fsharp/FSComp.txt +++ b/src/fsharp/FSComp.txt @@ -1325,4 +1325,5 @@ tcTupleStructMismatch,"One tuple type is a struct tuple, the other is a referenc 3207,tcFixedNotAllowed,"Invalid use of 'fixed'. 'fixed' may only be used in a declaration of the form 'use x = fixed expr' where the expression is an array, the address of a field, the address of an array element or a string'" 3208,tcCouldNotFindOffsetToStringData,"Could not find method System.Runtime.CompilerServices.OffsetToStringData in references when building 'fixed' expression." 3209,chkNoByrefReturnOfLocal,"The address of the variable '%s' cannot be used at this point. A method or function may not return the address of this local value." -3210,tcNamedActivePattern,"%s is an active pattern and cannot be treated as a discriminated union case with named fields." \ No newline at end of file +3210,tcNamedActivePattern,"%s is an active pattern and cannot be treated as a discriminated union case with named fields." +tcGlobalsSystemTypeNotFound,"The system type '%s' was required but no referenced system DLL contained this type" diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index 99949f9d608..ef794717286 100644 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -445,7 +445,7 @@ and GenTypeAux amap m g (tyenv: TypeReprEnv) voidOK ptrsOK ty = if tps.IsEmpty then GenTypeAux amap m g tyenv VoidNotOK ptrsOK tau else EraseClosures.mkILTyFuncTy g.ilxPubCloEnv | TType_var tp -> mkILTyvarTy tyenv.[tp,m] - | TType_measure _ -> g.ilg.typ_int32 + | TType_measure _ -> g.ilg.typ_Int32 //-------------------------------------------------------------------------- // Generate ILX references to closures, classunions etc. given a tyenv @@ -1889,13 +1889,13 @@ let rec GenExpr (cenv:cenv) (cgbuf:CodeGenBuffer) eenv sp expr sequel = | TOp.Array,elems,[elemTy] -> GenNewArray cenv cgbuf eenv (elems,elemTy,m) sequel | TOp.Bytes bytes,[],[] -> if cenv.opts.emitConstantArraysUsingStaticDataBlobs then - GenConstArray cenv cgbuf eenv cenv.g.ilg.typ_uint8 bytes (fun buf b -> buf.EmitByte b) + GenConstArray cenv cgbuf eenv cenv.g.ilg.typ_Byte bytes (fun buf b -> buf.EmitByte b) GenSequel cenv eenv.cloc cgbuf sequel else GenNewArraySimple cenv cgbuf eenv (List.ofArray (Array.map (mkByte cenv.g m) bytes),cenv.g.byte_ty,m) sequel | TOp.UInt16s arr,[],[] -> if cenv.opts.emitConstantArraysUsingStaticDataBlobs then - GenConstArray cenv cgbuf eenv cenv.g.ilg.typ_uint16 arr (fun buf b -> buf.EmitUInt16 b) + GenConstArray cenv cgbuf eenv cenv.g.ilg.typ_UInt16 arr (fun buf b -> buf.EmitUInt16 b) GenSequel cenv eenv.cloc cgbuf sequel else GenNewArraySimple cenv cgbuf eenv (List.ofArray (Array.map (mkUInt16 cenv.g m) arr),cenv.g.uint16_ty,m) sequel @@ -2028,7 +2028,7 @@ and GenConstant cenv cgbuf eenv (c,m,ty) sequel = GenExpr cenv cgbuf eenv SPSuppress e Continue | None -> match c with - | Const.Bool b -> CG.EmitInstr cgbuf (pop 0) (Push [cenv.g.ilg.typ_bool]) (mkLdcInt32 (if b then 1 else 0)) + | Const.Bool b -> CG.EmitInstr cgbuf (pop 0) (Push [cenv.g.ilg.typ_Bool]) (mkLdcInt32 (if b then 1 else 0)) | Const.SByte i -> CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (mkLdcInt32 (int32 i)) | Const.Int16 i -> CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (mkLdcInt32 (int32 i)) | Const.Int32 i -> CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (mkLdcInt32 i) @@ -2162,7 +2162,7 @@ and GenNewArraySimple cenv cgbuf eenv (elems,elemTy,m) sequel = CG.EmitInstrs cgbuf (pop 0) (Push [ilArrTy]) [ (AI_ldc (DT_I4,ILConst.I4 (elems.Length))); I_newarr (ILArrayShape.SingleDimensional,ilElemTy) ] elems |> List.iteri (fun i e -> - CG.EmitInstrs cgbuf (pop 0) (Push [ilArrTy; cenv.g.ilg.typ_int32]) [ AI_dup; (AI_ldc (DT_I4,ILConst.I4 i)) ] + CG.EmitInstrs cgbuf (pop 0) (Push [ilArrTy; cenv.g.ilg.typ_Int32]) [ AI_dup; (AI_ldc (DT_I4,ILConst.I4 i)) ] GenExpr cenv cgbuf eenv SPSuppress e Continue CG.EmitInstr cgbuf (pop 3) Push0 (I_stelem_any (ILArrayShape.SingleDimensional,ilElemTy))) @@ -2306,7 +2306,7 @@ and GenGetUnionCaseTag cenv cgbuf eenv (e,tcref,tyargs,m) sequel = let cuspec = GenUnionSpec cenv.amap m cenv.g eenv.tyenv tcref tyargs let avoidHelpers = entityRefInThisAssembly cenv.g.compilingFslib tcref EraseUnions.emitLdDataTag cenv.g.ilg (UnionCodeGen cgbuf) (avoidHelpers, cuspec) - CG.EmitInstrs cgbuf (pop 1) (Push [cenv.g.ilg.typ_int32]) [ ] // push/pop to match the line above + CG.EmitInstrs cgbuf (pop 1) (Push [cenv.g.ilg.typ_Int32]) [ ] // push/pop to match the line above GenSequel cenv eenv.cloc cgbuf sequel and GenSetUnionCaseField cenv cgbuf eenv (e,ucref,tyargs,n,e2,m) sequel = @@ -2485,7 +2485,7 @@ and GenApp cenv cgbuf eenv (f,fty,tyargs,args,m) sequel = GenExpr cenv cgbuf eenv SPSuppress arg1 Continue GenExpr cenv cgbuf eenv SPSuppress arg2 Continue - CG.EmitInstr cgbuf (pop 2) (Push [cenv.g.ilg.typ_bool]) AI_ceq + CG.EmitInstr cgbuf (pop 2) (Push [cenv.g.ilg.typ_Bool]) AI_ceq GenSequel cenv eenv.cloc cgbuf sequel // Emit "methodhandleof" calls as ldtoken instructions @@ -2925,7 +2925,7 @@ and GenForLoop cenv cgbuf eenv (spFor,v,e1,dir,e2,loopBody,m) sequel = let finishIdx,eenvinner = if isFSharpStyle then - let v,eenvinner = AllocLocal cenv cgbuf eenvinner true (ilxgenGlobalNng.FreshCompilerGeneratedName ("endLoop",m), cenv.g.ilg.typ_int32, false) (start,finish) + let v,eenvinner = AllocLocal cenv cgbuf eenvinner true (ilxgenGlobalNng.FreshCompilerGeneratedName ("endLoop",m), cenv.g.ilg.typ_Int32, false) (start,finish) v, eenvinner else -1,eenvinner @@ -2940,7 +2940,7 @@ and GenForLoop cenv cgbuf eenv (spFor,v,e1,dir,e2,loopBody,m) sequel = if isFSharpStyle then GenExpr cenv cgbuf eenvinner SPSuppress e2 Continue EmitSetLocal cgbuf finishIdx - EmitGetLocal cgbuf cenv.g.ilg.typ_int32 finishIdx + EmitGetLocal cgbuf cenv.g.ilg.typ_Int32 finishIdx GenGetLocalVal cenv cgbuf eenvinner e2.Range v None CG.EmitInstr cgbuf (pop 2) Push0 (I_brcmp ((if isUp then BI_blt else BI_bgt),finish.CodeLabel)) @@ -2954,7 +2954,7 @@ and GenForLoop cenv cgbuf eenv (spFor,v,e1,dir,e2,loopBody,m) sequel = // v++ or v-- GenGetLocalVal cenv cgbuf eenvinner e2.Range v None - CG.EmitInstr cgbuf (pop 0) (Push [cenv.g.ilg.typ_int32]) (mkLdcInt32 1) + CG.EmitInstr cgbuf (pop 0) (Push [cenv.g.ilg.typ_Int32]) (mkLdcInt32 1) CG.EmitInstr cgbuf (pop 1) Push0 (if isUp then AI_add else AI_sub) GenStoreVal cgbuf eenvinner m v @@ -2974,8 +2974,8 @@ and GenForLoop cenv cgbuf eenv (spFor,v,e1,dir,e2,loopBody,m) sequel = let e2Sequel = (CmpThenBrOrContinue (pop 2, [ I_brcmp(cmp,inner.CodeLabel) ])) if isFSharpStyle then - EmitGetLocal cgbuf cenv.g.ilg.typ_int32 finishIdx - CG.EmitInstr cgbuf (pop 0) (Push [cenv.g.ilg.typ_int32]) (mkLdcInt32 1) + EmitGetLocal cgbuf cenv.g.ilg.typ_Int32 finishIdx + CG.EmitInstr cgbuf (pop 0) (Push [cenv.g.ilg.typ_Int32]) (mkLdcInt32 1) CG.EmitInstr cgbuf (pop 1) Push0 (if isUp then AI_add else AI_sub) GenSequel cenv eenv.cloc cgbuf e2Sequel else @@ -4365,7 +4365,7 @@ and GenDecisionTreeSwitch cenv cgbuf inplabOpt stackAtTargets eenv e cases defau // // Remove a single test for a union case . Union case tests are always exa //| [ TCase(Test.UnionCase _, successTree) ] when (defaultTargetOpt.IsNone) -> // GenDecisionTreeAndTargetsInner cenv cgbuf inplabOpt stackAtTargets eenv successTree targets repeatSP targetInfos sequel - // //GenDecisionTree cenv eenv.cloc cgbuf stackAtTargets e (Some (pop 1, Push [cenv.g.ilg.typ_bool], Choice1Of2 (avoidHelpers, cuspec, idx))) eenv successTree failureTree targets repeatSP targetInfos sequel + // //GenDecisionTree cenv eenv.cloc cgbuf stackAtTargets e (Some (pop 1, Push [cenv.g.ilg.typ_Bool], Choice1Of2 (avoidHelpers, cuspec, idx))) eenv successTree failureTree targets repeatSP targetInfos sequel // Optimize a single test for a union case to an "isdata" test - much // more efficient code, and this case occurs in the generated equality testers where perf is important @@ -4377,7 +4377,7 @@ and GenDecisionTreeSwitch cenv cgbuf inplabOpt stackAtTargets eenv e cases defau let cuspec = GenUnionSpec cenv.amap m cenv.g eenv.tyenv c.TyconRef tyargs let idx = c.Index let avoidHelpers = entityRefInThisAssembly cenv.g.compilingFslib c.TyconRef - GenDecisionTreeTest cenv eenv.cloc cgbuf stackAtTargets e (Some (pop 1, Push [cenv.g.ilg.typ_bool], Choice1Of2 (avoidHelpers, cuspec, idx))) eenv successTree failureTree targets repeatSP targetInfos sequel + GenDecisionTreeTest cenv eenv.cloc cgbuf stackAtTargets e (Some (pop 1, Push [cenv.g.ilg.typ_Bool], Choice1Of2 (avoidHelpers, cuspec, idx))) eenv successTree failureTree targets repeatSP targetInfos sequel | _ -> let caseLabels = List.map (fun _ -> CG.GenerateDelayMark cgbuf "switch_case") cases @@ -4462,7 +4462,7 @@ and GenDecisionTreeSwitch cenv cgbuf inplabOpt stackAtTargets eenv e cases defau if mx - mn = (List.length dests - 1) then let destinationLabels = dests |> List.sortBy fst |> List.map snd if mn <> 0 then - CG.EmitInstrs cgbuf (pop 0) (Push [cenv.g.ilg.typ_int32]) [ mkLdcInt32 mn] + CG.EmitInstrs cgbuf (pop 0) (Push [cenv.g.ilg.typ_Int32]) [ mkLdcInt32 mn] CG.EmitInstrs cgbuf (pop 1) Push0 [ AI_sub ] CG.EmitInstr cgbuf (pop 1) Push0 (I_switch destinationLabels) else @@ -4510,7 +4510,7 @@ and GenDecisionTreeTest cenv cloc cgbuf stackAtTargets e tester eenv successTree | Choice2Of2 i -> CG.EmitInstr cgbuf pops pushes i | _ -> () if not b1 then - CG.EmitInstrs cgbuf (pop 0) (Push [cenv.g.ilg.typ_bool]) [mkLdcInt32 (0) ] + CG.EmitInstrs cgbuf (pop 0) (Push [cenv.g.ilg.typ_Bool]) [mkLdcInt32 (0) ] CG.EmitInstrs cgbuf (pop 1) Push0 [AI_ceq] GenSequel cenv cloc cgbuf sequel targetInfos @@ -5980,12 +5980,12 @@ and GenForceWholeFileInitializationAsPartOfCCtor cenv (mgbuf:AssemblyBuilder) (l /// Generate an Equals method. and GenEqualsOverrideCallingIComparable cenv (tcref:TyconRef, ilThisTy, _ilThatTy) = - let mspec = mkILNonGenericInstanceMethSpecInTy (cenv.g.ilg.typ_IComparable, "CompareTo", [cenv.g.ilg.typ_Object], cenv.g.ilg.typ_int32) + let mspec = mkILNonGenericInstanceMethSpecInTy (cenv.g.ilg.typ_IComparable, "CompareTo", [cenv.g.ilg.typ_Object], cenv.g.ilg.typ_Int32) mkILNonGenericVirtualMethod ("Equals",ILMemberAccess.Public, [mkILParamNamed ("obj",cenv.g.ilg.typ_Object)], - mkILReturn cenv.g.ilg.typ_bool, + mkILReturn cenv.g.ilg.typ_Bool, mkMethodBody(true,[],2, nonBranchingInstrsToCode [ yield mkLdarg0 @@ -6174,7 +6174,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) = | Some memberInfo -> match name, memberInfo.MemberFlags.MemberKind with | ("Item" | "op_IndexedLookup"), (MemberKind.PropertyGet | MemberKind.PropertySet) when not (isNil (ArgInfosOfPropertyVal cenv.g vref.Deref)) -> - Some( mkILCustomAttribute cenv.g.ilg (mkILTyRef (cenv.g.ilg.traits.ScopeRef,"System.Reflection.DefaultMemberAttribute"),[cenv.g.ilg.typ_String],[ILAttribElem.String(Some(name))],[]) ) + Some( mkILCustomAttribute cenv.g.ilg (cenv.g.ilg.mkSysILTypeRef "System.Reflection.DefaultMemberAttribute",[cenv.g.ilg.typ_String],[ILAttribElem.String(Some(name))],[]) ) | _ -> None) |> Option.toList @@ -6306,7 +6306,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) = CustomAttrs = mkILCustomAttrs (GenAttrs cenv eenv fattribs @ extraAttribs) } if requiresExtraField then - yield mkILInstanceField("__dummy",cenv.g.ilg.typ_int32,None,ILMemberAccess.Assembly) ] + yield mkILInstanceField("__dummy",cenv.g.ilg.typ_Int32,None,ILMemberAccess.Assembly) ] // Generate property definitions for the fields compiled as properties let ilPropertyDefsForFields = diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index 23cc85e6d67..931d5c7553b 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -1828,8 +1828,8 @@ and OptimizeExprOp cenv env (op,tyargs,args,m) = | TOp.ILCall (_,_,_,_,_,_,_,mref,_enclTypeArgs,_methTypeArgs,_tys),_,[arg] when (mref.EnclosingTypeRef.Scope.IsAssemblyRef && - mref.EnclosingTypeRef.Scope.AssemblyRef.Name = cenv.g.sysCcu.AssemblyName && - mref.EnclosingTypeRef.Name = "System.Array" && + mref.EnclosingTypeRef.Scope.AssemblyRef.Name = cenv.g.ilg.typ_Array.TypeRef.Scope.AssemblyRef.Name && + mref.EnclosingTypeRef.Name = cenv.g.ilg.typ_Array.TypeRef.Name && mref.Name = "get_Length" && isArray1DTy cenv.g (tyOfExpr cenv.g arg)) -> OptimizeExpr cenv env (Expr.Op(TOp.ILAsm(i_ldlen,[cenv.g.int_ty]),[],[arg],m)) diff --git a/src/fsharp/QuotationTranslator.fs b/src/fsharp/QuotationTranslator.fs index 2c4875502d5..51261f1523c 100644 --- a/src/fsharp/QuotationTranslator.fs +++ b/src/fsharp/QuotationTranslator.fs @@ -904,7 +904,7 @@ and IsILTypeRefStaticLinkLocal cenv m (tr:ILTypeRef) = #if EXTENSIONTYPING | ILScopeRef.Assembly aref when not cenv.g.isInteractive && - aref.Name <> cenv.g.sysCcu.AssemblyName && // optimization to avoid this check in the common case + aref.Name <> cenv.g.ilg.primaryAssemblyName && // optimization to avoid this check in the common case (match cenv.amap.assemblyLoader.LoadAssembly (m,aref) with | ResolvedCcu ccu -> ccu.IsProviderGenerated | UnresolvedCcu _ -> false) diff --git a/src/fsharp/TastOps.fs b/src/fsharp/TastOps.fs index 348e98185f6..55673efce84 100644 --- a/src/fsharp/TastOps.fs +++ b/src/fsharp/TastOps.fs @@ -5977,11 +5977,11 @@ let mkUnbox ty e m = mkAsmExpr ([ unbox ], [ty],[e], [ ty ], m) let mkBox ty e m = mkAsmExpr ([box],[],[e],[ty],m) let mkIsInst ty e m = mkAsmExpr ([ isinst ], [ty],[e], [ ty ], m) -let mspec_Object_GetHashCode ilg = IL.mkILNonGenericInstanceMethSpecInTy(ilg.typ_Object,"GetHashCode",[],ilg.typ_int32) -let mspec_Type_GetTypeFromHandle ilg = IL.mkILNonGenericStaticMethSpecInTy(ilg.typ_Type,"GetTypeFromHandle",[ilg.typ_RuntimeTypeHandle],ilg.typ_Type) -let mspec_String_Length ilg = mkILNonGenericInstanceMethSpecInTy (ilg.typ_String, "get_Length", [], ilg.typ_int32) +let mspec_Object_GetHashCode (ilg: ILGlobals) = IL.mkILNonGenericInstanceMethSpecInTy(ilg.typ_Object,"GetHashCode",[],ilg.typ_Int32) +let mspec_Type_GetTypeFromHandle (ilg: ILGlobals) = IL.mkILNonGenericStaticMethSpecInTy(ilg.typ_Type,"GetTypeFromHandle",[ilg.typ_RuntimeTypeHandle],ilg.typ_Type) +let mspec_String_Length (ilg: ILGlobals) = mkILNonGenericInstanceMethSpecInTy (ilg.typ_String, "get_Length", [], ilg.typ_Int32) -let fspec_Missing_Value ilg = IL.mkILFieldSpecInTy(ilg.typ_Missing.Value, "Value", ilg.typ_Missing.Value) +let fspec_Missing_Value (ilg: ILGlobals) = IL.mkILFieldSpecInTy(ilg.typ_Missing, "Value", ilg.typ_Missing) let typedExprForIntrinsic _g m (IntrinsicValRef(_,_,_,ty,_) as i) = @@ -6269,7 +6269,7 @@ let TryFindAutoOpenAttr (ilg : IL.ILGlobals) cattr = None let tref_InternalsVisibleToAttr (ilg : IL.ILGlobals) = - mkILTyRef (ilg.traits.ScopeRef,"System.Runtime.CompilerServices.InternalsVisibleToAttribute") + ilg.mkSysILTypeRef "System.Runtime.CompilerServices.InternalsVisibleToAttribute" let TryFindInternalsVisibleToAttr ilg cattr = if isILAttrib (tref_InternalsVisibleToAttr ilg) cattr then diff --git a/src/fsharp/TcGlobals.fs b/src/fsharp/TcGlobals.fs index f9aad22eaa3..2b64b4cab89 100755 --- a/src/fsharp/TcGlobals.fs +++ b/src/fsharp/TcGlobals.fs @@ -108,7 +108,6 @@ type public TcGlobals = mlCompatibility : bool directoryToResolveRelativePaths : string fslibCcu: CcuThunk - sysCcu: CcuThunk using40environment: bool better_tcref_map: TyconRef -> TypeInst -> TType option refcell_tcr_canon: TyconRef @@ -544,7 +543,10 @@ type public TcGlobals = splice_raw_expr_vref : ValRef new_format_vref : ValRef mkSysTyconRef : string list -> string -> TyconRef + tryMkSysTyconRef : string list -> string -> TyconRef option + mkSysILTypeRef : string -> ILTypeRef usesMscorlib : bool + mkSysAttrib : string -> BuiltinAttribInfo // A list of types that are explicitly suppressed from the F# intellisense // Note that the suppression checks for the precise name of the type @@ -569,8 +571,8 @@ type public TcGlobals = let global_g = ref (None : TcGlobals option) #endif -let mkTcGlobals (compilingFslib,sysCcu,ilg,fslibCcu,directoryToResolveRelativePaths,mlCompatibility, - using40environment,isInteractive,getTypeCcu, emitDebugInfoInQuotations, usesMscorlib) = +let mkTcGlobals (compilingFslib,ilg,fslibCcu,directoryToResolveRelativePaths,mlCompatibility, + using40environment,isInteractive,getTypeCcu,tryGetTypeCcu, emitDebugInfoInQuotations, usesMscorlib) = let vara = NewRigidTypar "a" envRange let varb = NewRigidTypar "b" envRange @@ -617,11 +619,17 @@ let mkTcGlobals (compilingFslib,sysCcu,ilg,fslibCcu,directoryToResolveRelativePa let ilsigptr_tcr = mk_MFCore_tcref fslibCcu "ilsigptr`1" let fastFunc_tcr = mk_MFCore_tcref fslibCcu "FSharpFunc`2" + let tryMkSysTyconRef path nm = + match tryGetTypeCcu path nm with + | Some ccu -> Some (mkNonLocalTyconRef2 ccu (Array.ofList path) nm) + | None -> None + let mkSysTyconRef path nm = - let ccu = getTypeCcu path nm - mkNonLocalTyconRef2 ccu (Array.ofList path) nm + let ccu = getTypeCcu path nm + mkNonLocalTyconRef2 ccu (Array.ofList path) nm let mkSysNonGenericTy path n = mkNonGenericTy(mkSysTyconRef path n) + let tryMkSysNonGenericTy path n = tryMkSysTyconRef path n |> Option.map mkNonGenericTy let sys = ["System"] let sysLinq = ["System";"Linq"] @@ -848,17 +856,21 @@ let mkTcGlobals (compilingFslib,sysCcu,ilg,fslibCcu,directoryToResolveRelativePa let mk_MFCore_attrib nm : BuiltinAttribInfo = AttribInfo(mkILTyRef(IlxSettings.ilxFsharpCoreLibScopeRef (), FSharpLib.Core + "." + nm),mk_MFCore_tcref fslibCcu nm) - let mkAttrib (nm:string) scopeRef : BuiltinAttribInfo = + let mkSysILTypeRef (nm:string) = + let path, typeName = splitILTypeName nm + let scopeRef = (getTypeCcu path typeName).ILScopeRef + mkILTyRef (scopeRef, nm) + + let mkSysAttrib (nm:string) = + let tref = mkSysILTypeRef nm let path, typeName = splitILTypeName nm - AttribInfo(mkILTyRef (scopeRef, nm), mkSysTyconRef path typeName) + AttribInfo(tref, mkSysTyconRef path typeName) - - let mkSystemRuntimeAttrib (nm:string) : BuiltinAttribInfo = mkAttrib nm ilg.traits.ScopeRef - let mkSystemRuntimeInteropServicesAttribute nm = - match ilg.traits.SystemRuntimeInteropServicesScopeRef.Value with - | Some assemblyRef -> Some (mkAttrib nm assemblyRef) + let tryMkSysAttrib nm = + let path, typeName = splitILTypeName nm + match tryGetTypeCcu path typeName with + | Some _ -> Some (mkSysAttrib nm) | None -> None - let mkSystemDiagnosticsDebugAttribute nm = mkAttrib nm (ilg.traits.SystemDiagnosticsDebugScopeRef.Value) let mk_doc filename = ILSourceDocument.Create(language=None, vendor=None, documentType=None, file=filename) // Build the memoization table for files @@ -1023,7 +1035,6 @@ let mkTcGlobals (compilingFslib,sysCcu,ilg,fslibCcu,directoryToResolveRelativePa valRefEq = valRefEq fslibCcu = fslibCcu using40environment = using40environment - sysCcu = sysCcu refcell_tcr_canon = mk_MFCore_tcref fslibCcu "Ref`1" option_tcr_canon = mk_MFCore_tcref fslibCcu "Option`1" list_tcr_canon = mk_MFCollections_tcref fslibCcu "List`1" @@ -1135,9 +1146,9 @@ let mkTcGlobals (compilingFslib,sysCcu,ilg,fslibCcu,directoryToResolveRelativePa system_String_tcref = mkSysTyconRef sys "String" system_Int32_typ = mkSysNonGenericTy sys "Int32" system_Type_typ = system_Type_typ - system_TypedReference_tcref = if ilg.traits.TypedReferenceTypeScopeRef.IsSome then Some(mkSysTyconRef sys "TypedReference") else None - system_ArgIterator_tcref = if ilg.traits.ArgIteratorTypeScopeRef.IsSome then Some(mkSysTyconRef sys "ArgIterator") else None - system_RuntimeArgumentHandle_tcref = if ilg.traits.RuntimeArgumentHandleTypeScopeRef.IsSome then Some (mkSysTyconRef sys "RuntimeArgumentHandle") else None + system_TypedReference_tcref = tryMkSysTyconRef sys "TypedReference" + system_ArgIterator_tcref = tryMkSysTyconRef sys "ArgIterator" + system_RuntimeArgumentHandle_tcref = tryMkSysTyconRef sys "RuntimeArgumentHandle" system_SByte_tcref = mkSysTyconRef sys "SByte" system_Decimal_tcref = mkSysTyconRef sys "Decimal" system_Int16_tcref = mkSysTyconRef sys "Int16" @@ -1156,8 +1167,8 @@ let mkTcGlobals (compilingFslib,sysCcu,ilg,fslibCcu,directoryToResolveRelativePa system_RuntimeTypeHandle_typ = mkSysNonGenericTy sys "RuntimeTypeHandle" system_RuntimeMethodHandle_typ = system_RuntimeMethodHandle_typ - system_MarshalByRefObject_tcref = if ilg.traits.MarshalByRefObjectScopeRef.IsSome then Some(mkSysTyconRef sys "MarshalByRefObject") else None - system_MarshalByRefObject_typ = if ilg.traits.MarshalByRefObjectScopeRef.IsSome then Some(mkSysNonGenericTy sys "MarshalByRefObject") else None + system_MarshalByRefObject_tcref = tryMkSysTyconRef sys "MarshalByRefObject" + system_MarshalByRefObject_typ = tryMkSysNonGenericTy sys "MarshalByRefObject" system_Reflection_MethodInfo_typ = system_Reflection_MethodInfo_typ @@ -1200,40 +1211,40 @@ let mkTcGlobals (compilingFslib,sysCcu,ilg,fslibCcu,directoryToResolveRelativePa tcref_System_Attribute = System_Attribute_tcr - attrib_AttributeUsageAttribute = mkSystemRuntimeAttrib "System.AttributeUsageAttribute" - attrib_ParamArrayAttribute = mkSystemRuntimeAttrib "System.ParamArrayAttribute" - attrib_IDispatchConstantAttribute = if ilg.traits.IDispatchConstantAttributeScopeRef.IsSome then Some(mkSystemRuntimeAttrib "System.Runtime.CompilerServices.IDispatchConstantAttribute") else None - attrib_IUnknownConstantAttribute = if ilg.traits.IUnknownConstantAttributeScopeRef.IsSome then Some (mkSystemRuntimeAttrib "System.Runtime.CompilerServices.IUnknownConstantAttribute") else None + attrib_AttributeUsageAttribute = mkSysAttrib "System.AttributeUsageAttribute" + attrib_ParamArrayAttribute = mkSysAttrib "System.ParamArrayAttribute" + attrib_IDispatchConstantAttribute = tryMkSysAttrib "System.Runtime.CompilerServices.IDispatchConstantAttribute" + attrib_IUnknownConstantAttribute = tryMkSysAttrib "System.Runtime.CompilerServices.IUnknownConstantAttribute" - attrib_SystemObsolete = mkSystemRuntimeAttrib "System.ObsoleteAttribute" - attrib_DllImportAttribute = mkSystemRuntimeInteropServicesAttribute "System.Runtime.InteropServices.DllImportAttribute" - attrib_StructLayoutAttribute = mkSystemRuntimeAttrib "System.Runtime.InteropServices.StructLayoutAttribute" - attrib_TypeForwardedToAttribute = mkSystemRuntimeAttrib "System.Runtime.CompilerServices.TypeForwardedToAttribute" - attrib_ComVisibleAttribute = mkSystemRuntimeAttrib "System.Runtime.InteropServices.ComVisibleAttribute" - attrib_ComImportAttribute = mkSystemRuntimeInteropServicesAttribute "System.Runtime.InteropServices.ComImportAttribute" - attrib_FieldOffsetAttribute = mkSystemRuntimeAttrib "System.Runtime.InteropServices.FieldOffsetAttribute" - attrib_MarshalAsAttribute = mkSystemRuntimeInteropServicesAttribute "System.Runtime.InteropServices.MarshalAsAttribute" - attrib_InAttribute = mkSystemRuntimeInteropServicesAttribute "System.Runtime.InteropServices.InAttribute" - attrib_OutAttribute = mkSystemRuntimeAttrib "System.Runtime.InteropServices.OutAttribute" - attrib_OptionalAttribute = mkSystemRuntimeInteropServicesAttribute "System.Runtime.InteropServices.OptionalAttribute" - attrib_ThreadStaticAttribute = if ilg.traits.ThreadStaticAttributeScopeRef.IsSome then Some(mkSystemRuntimeAttrib "System.ThreadStaticAttribute") else None - attrib_SpecialNameAttribute = if ilg.traits.SpecialNameAttributeScopeRef.IsSome then Some(mkSystemRuntimeAttrib "System.Runtime.CompilerServices.SpecialNameAttribute") else None + attrib_SystemObsolete = mkSysAttrib "System.ObsoleteAttribute" + attrib_DllImportAttribute = tryMkSysAttrib "System.Runtime.InteropServices.DllImportAttribute" + attrib_StructLayoutAttribute = mkSysAttrib "System.Runtime.InteropServices.StructLayoutAttribute" + attrib_TypeForwardedToAttribute = mkSysAttrib "System.Runtime.CompilerServices.TypeForwardedToAttribute" + attrib_ComVisibleAttribute = mkSysAttrib "System.Runtime.InteropServices.ComVisibleAttribute" + attrib_ComImportAttribute = tryMkSysAttrib "System.Runtime.InteropServices.ComImportAttribute" + attrib_FieldOffsetAttribute = mkSysAttrib "System.Runtime.InteropServices.FieldOffsetAttribute" + attrib_MarshalAsAttribute = tryMkSysAttrib "System.Runtime.InteropServices.MarshalAsAttribute" + attrib_InAttribute = tryMkSysAttrib "System.Runtime.InteropServices.InAttribute" + attrib_OutAttribute = mkSysAttrib "System.Runtime.InteropServices.OutAttribute" + attrib_OptionalAttribute = tryMkSysAttrib "System.Runtime.InteropServices.OptionalAttribute" + attrib_ThreadStaticAttribute = tryMkSysAttrib "System.ThreadStaticAttribute" + attrib_SpecialNameAttribute = tryMkSysAttrib "System.Runtime.CompilerServices.SpecialNameAttribute" attrib_VolatileFieldAttribute = mk_MFCore_attrib "VolatileFieldAttribute" - attrib_ContextStaticAttribute = if ilg.traits.ContextStaticAttributeScopeRef.IsSome then Some (mkSystemRuntimeAttrib "System.ContextStaticAttribute") else None - attrib_FlagsAttribute = mkSystemRuntimeAttrib "System.FlagsAttribute" - attrib_DefaultMemberAttribute = mkSystemRuntimeAttrib "System.Reflection.DefaultMemberAttribute" - attrib_DebuggerDisplayAttribute = mkSystemDiagnosticsDebugAttribute "System.Diagnostics.DebuggerDisplayAttribute" - attrib_DebuggerTypeProxyAttribute = mkSystemDiagnosticsDebugAttribute "System.Diagnostics.DebuggerTypeProxyAttribute" - attrib_PreserveSigAttribute = mkSystemRuntimeInteropServicesAttribute "System.Runtime.InteropServices.PreserveSigAttribute" - attrib_MethodImplAttribute = mkSystemRuntimeAttrib "System.Runtime.CompilerServices.MethodImplAttribute" - attrib_ExtensionAttribute = mkSystemRuntimeAttrib "System.Runtime.CompilerServices.ExtensionAttribute" - attrib_CallerLineNumberAttribute = mkSystemRuntimeAttrib "System.Runtime.CompilerServices.CallerLineNumberAttribute" - attrib_CallerFilePathAttribute = mkSystemRuntimeAttrib "System.Runtime.CompilerServices.CallerFilePathAttribute" - attrib_CallerMemberNameAttribute = mkSystemRuntimeAttrib "System.Runtime.CompilerServices.CallerMemberNameAttribute" + attrib_ContextStaticAttribute = tryMkSysAttrib "System.ContextStaticAttribute" + attrib_FlagsAttribute = mkSysAttrib "System.FlagsAttribute" + attrib_DefaultMemberAttribute = mkSysAttrib "System.Reflection.DefaultMemberAttribute" + attrib_DebuggerDisplayAttribute = mkSysAttrib "System.Diagnostics.DebuggerDisplayAttribute" + attrib_DebuggerTypeProxyAttribute = mkSysAttrib "System.Diagnostics.DebuggerTypeProxyAttribute" + attrib_PreserveSigAttribute = tryMkSysAttrib "System.Runtime.InteropServices.PreserveSigAttribute" + attrib_MethodImplAttribute = mkSysAttrib "System.Runtime.CompilerServices.MethodImplAttribute" + attrib_ExtensionAttribute = mkSysAttrib "System.Runtime.CompilerServices.ExtensionAttribute" + attrib_CallerLineNumberAttribute = mkSysAttrib "System.Runtime.CompilerServices.CallerLineNumberAttribute" + attrib_CallerFilePathAttribute = mkSysAttrib "System.Runtime.CompilerServices.CallerFilePathAttribute" + attrib_CallerMemberNameAttribute = mkSysAttrib "System.Runtime.CompilerServices.CallerMemberNameAttribute" attrib_ProjectionParameterAttribute = mk_MFCore_attrib "ProjectionParameterAttribute" attrib_CustomOperationAttribute = mk_MFCore_attrib "CustomOperationAttribute" - attrib_NonSerializedAttribute = if ilg.traits.NonSerializedAttributeScopeRef.IsSome then Some(mkSystemRuntimeAttrib "System.NonSerializedAttribute") else None + attrib_NonSerializedAttribute = tryMkSysAttrib "System.NonSerializedAttribute" attrib_AutoSerializableAttribute = mk_MFCore_attrib "AutoSerializableAttribute" attrib_RequireQualifiedAccessAttribute = mk_MFCore_attrib "RequireQualifiedAccessAttribute" attrib_EntryPointAttribute = mk_MFCore_attrib "EntryPointAttribute" @@ -1242,7 +1253,7 @@ let mkTcGlobals (compilingFslib,sysCcu,ilg,fslibCcu,directoryToResolveRelativePa attrib_ExperimentalAttribute = mk_MFCore_attrib "ExperimentalAttribute" attrib_UnverifiableAttribute = mk_MFCore_attrib "UnverifiableAttribute" attrib_LiteralAttribute = mk_MFCore_attrib "LiteralAttribute" - attrib_ConditionalAttribute = mkSystemRuntimeAttrib "System.Diagnostics.ConditionalAttribute" + attrib_ConditionalAttribute = mkSysAttrib "System.Diagnostics.ConditionalAttribute" attrib_OptionalArgumentAttribute = mk_MFCore_attrib "OptionalArgumentAttribute" attrib_RequiresExplicitTypeArgumentsAttribute = mk_MFCore_attrib "RequiresExplicitTypeArgumentsAttribute" attrib_DefaultValueAttribute = mk_MFCore_attrib "DefaultValueAttribute" @@ -1252,7 +1263,7 @@ let mkTcGlobals (compilingFslib,sysCcu,ilg,fslibCcu,directoryToResolveRelativePa attrib_ReflectedDefinitionAttribute = mk_MFCore_attrib "ReflectedDefinitionAttribute" attrib_CompiledNameAttribute = mk_MFCore_attrib "CompiledNameAttribute" attrib_AutoOpenAttribute = mk_MFCore_attrib "AutoOpenAttribute" - attrib_InternalsVisibleToAttribute = mkSystemRuntimeAttrib "System.Runtime.CompilerServices.InternalsVisibleToAttribute" + attrib_InternalsVisibleToAttribute = mkSysAttrib "System.Runtime.CompilerServices.InternalsVisibleToAttribute" attrib_CompilationRepresentationAttribute = mk_MFCore_attrib "CompilationRepresentationAttribute" attrib_CompilationArgumentCountsAttribute = mk_MFCore_attrib "CompilationArgumentCountsAttribute" attrib_CompilationMappingAttribute = mk_MFCore_attrib "CompilationMappingAttribute" @@ -1274,9 +1285,9 @@ let mkTcGlobals (compilingFslib,sysCcu,ilg,fslibCcu,directoryToResolveRelativePa attrib_MeasureAttribute = mk_MFCore_attrib "MeasureAttribute" attrib_MeasureableAttribute = mk_MFCore_attrib "MeasureAnnotatedAbbreviationAttribute" attrib_NoDynamicInvocationAttribute = mk_MFCore_attrib "NoDynamicInvocationAttribute" - attrib_SecurityAttribute = if ilg.traits.SecurityPermissionAttributeTypeScopeRef.IsSome then Some(mkSystemRuntimeAttrib"System.Security.Permissions.SecurityAttribute") else None - attrib_SecurityCriticalAttribute = mkSystemRuntimeAttrib "System.Security.SecurityCriticalAttribute" - attrib_SecuritySafeCriticalAttribute = mkSystemRuntimeAttrib "System.Security.SecuritySafeCriticalAttribute" + attrib_SecurityAttribute = tryMkSysAttrib "System.Security.Permissions.SecurityAttribute" + attrib_SecurityCriticalAttribute = mkSysAttrib "System.Security.SecurityCriticalAttribute" + attrib_SecuritySafeCriticalAttribute = mkSysAttrib "System.Security.SecuritySafeCriticalAttribute" // Build a map that uses the "canonical" F# type names and TyconRef's for these // in preference to the .NET type names. Doing this normalization is a fairly performance critical @@ -1540,11 +1551,12 @@ let mkTcGlobals (compilingFslib,sysCcu,ilg,fslibCcu,directoryToResolveRelativePa suppressed_types = suppressed_types isInteractive=isInteractive mkSysTyconRef=mkSysTyconRef + tryMkSysTyconRef=tryMkSysTyconRef + mkSysILTypeRef=mkSysILTypeRef usesMscorlib = usesMscorlib + mkSysAttrib=mkSysAttrib } -let public mkMscorlibAttrib g nm = - let path, typeName = splitILTypeName nm - AttribInfo(mkILTyRef (g.ilg.traits.ScopeRef,nm), g.mkSysTyconRef path typeName) +let public mkSysAttrib g nm = g.mkSysAttrib nm diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index 5de87a6d997..5479fb2af2f 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -9458,7 +9458,7 @@ and TcMethodApplication | Constant fieldInit -> match currCalledArgTy with | NullableTy cenv.g inst when fieldInit <> ILFieldInit.Null -> - let nullableTy = mkILNonGenericBoxedTy(mkILTyRef(cenv.g.ilg.traits.ScopeRef, "System.Nullable`1")) + let nullableTy = mkILNonGenericBoxedTy(cenv.g.mkSysILTypeRef "System.Nullable`1") let ctor = mkILCtorMethSpecForTy(nullableTy, [ILType.TypeVar 0us]).MethodRef let ctorArgs = [Expr.Const(TcFieldInit mMethExpr fieldInit,mMethExpr, inst)] emptyPreBinder,Expr.Op(TOp.ILCall(false, false, true, true, NormalValUse, false, false, ctor, [inst], [], [currCalledArgTy]), [], ctorArgs, mMethExpr) @@ -9476,19 +9476,19 @@ and TcMethodApplication emptyPreBinder,Expr.Const(TcFieldInit mMethExpr fieldInit,mMethExpr,currCalledArgTy) | WrapperForIDispatch -> - match cenv.g.ilg.traits.SystemRuntimeInteropServicesScopeRef.Value with + match cenv.g.ilg.tryMkSysILTypeRef "System.Runtime.InteropServices.DispatchWrapper" with | None -> error(Error(FSComp.SR.fscSystemRuntimeInteropServicesIsRequired(), mMethExpr)) - | Some assemblyRef -> - let tref = mkILNonGenericBoxedTy(mkILTyRef(assemblyRef, "System.Runtime.InteropServices.DispatchWrapper")) - let mref = mkILCtorMethSpecForTy(tref,[cenv.g.ilg.typ_Object]).MethodRef + | Some tref -> + let ty = mkILNonGenericBoxedTy tref + let mref = mkILCtorMethSpecForTy(ty,[cenv.g.ilg.typ_Object]).MethodRef let expr = Expr.Op(TOp.ILCall(false,false,false,true,NormalValUse,false,false,mref,[],[],[cenv.g.obj_ty]),[],[mkDefault(mMethExpr,currCalledArgTy)],mMethExpr) emptyPreBinder,expr | WrapperForIUnknown -> - match cenv.g.ilg.traits.SystemRuntimeInteropServicesScopeRef.Value with + match cenv.g.ilg.tryMkSysILTypeRef "System.Runtime.InteropServices.UnknownWrapper" with | None -> error(Error(FSComp.SR.fscSystemRuntimeInteropServicesIsRequired(), mMethExpr)) - | Some assemblyRef -> - let tref = mkILNonGenericBoxedTy(mkILTyRef(assemblyRef, "System.Runtime.InteropServices.UnknownWrapper")) - let mref = mkILCtorMethSpecForTy(tref,[cenv.g.ilg.typ_Object]).MethodRef + | Some tref -> + let ty = mkILNonGenericBoxedTy tref + let mref = mkILCtorMethSpecForTy(ty,[cenv.g.ilg.typ_Object]).MethodRef let expr = Expr.Op(TOp.ILCall(false,false,false,true,NormalValUse,false,false,mref,[],[],[cenv.g.obj_ty]),[],[mkDefault(mMethExpr,currCalledArgTy)],mMethExpr) emptyPreBinder,expr | PassByRef (ty, dfltVal2) -> diff --git a/src/fsharp/ast.fs b/src/fsharp/ast.fs index 0f2ae0e704a..e49969ed171 100644 --- a/src/fsharp/ast.fs +++ b/src/fsharp/ast.fs @@ -1724,7 +1724,7 @@ let ParseAssemblyCodeInstructions s m = #if NO_INLINE_IL_PARSER let ParseAssemblyCodeType _s m = errorR(Error((193,"Inline IL not valid in a hosted environment"),m)) - IL.EcmaILGlobals.typ_Object + IL.EcmaMscorlibILGlobals.typ_Object #else let ParseAssemblyCodeType s m = try Microsoft.FSharp.Compiler.AbstractIL.Internal.AsciiParser.ilType @@ -1732,7 +1732,7 @@ let ParseAssemblyCodeType s m = (UnicodeLexing.StringAsLexbuf s) with RecoverableParseError -> errorR(Error(FSComp.SR.astParseEmbeddedILTypeError(),m)); - IL.EcmaILGlobals.typ_Object + IL.EcmaMscorlibILGlobals.typ_Object #endif //------------------------------------------------------------------------ diff --git a/src/fsharp/fsc.fs b/src/fsharp/fsc.fs index 2cda1a4bd0e..be1726ccf64 100644 --- a/src/fsharp/fsc.fs +++ b/src/fsharp/fsc.fs @@ -732,17 +732,17 @@ module AttributeHelpers = /// Try to find an attribute that takes a string argument let TryFindStringAttribute tcGlobals attrib attribs = - match TryFindFSharpAttribute tcGlobals (mkMscorlibAttrib tcGlobals attrib) attribs with + match TryFindFSharpAttribute tcGlobals (mkSysAttrib tcGlobals attrib) attribs with | Some (Attrib(_, _, [ AttribStringArg(s) ], _, _, _, _)) -> Some (s) | _ -> None let TryFindIntAttribute tcGlobals attrib attribs = - match TryFindFSharpAttribute tcGlobals (mkMscorlibAttrib tcGlobals attrib) attribs with + match TryFindFSharpAttribute tcGlobals (mkSysAttrib tcGlobals attrib) attribs with | Some (Attrib(_, _, [ AttribInt32Arg(i) ], _, _, _, _)) -> Some (i) | _ -> None let TryFindBoolAttribute tcGlobals attrib attribs = - match TryFindFSharpAttribute tcGlobals (mkMscorlibAttrib tcGlobals attrib) attribs with + match TryFindFSharpAttribute tcGlobals (mkSysAttrib tcGlobals attrib) attribs with | Some (Attrib(_, _, [ AttribBoolArg(p) ], _, _, _, _)) -> Some (p) | _ -> None @@ -798,7 +798,7 @@ module MainModuleBuilder = // Forwarding System.ITuple will cause FxCop failures on 4.0 Set.union (Set.filter (fun t -> t <> "System.ITuple") injectedCompatTypes) typesForwardedToMscorlib |> Seq.map (fun t -> - { ScopeRef = tcGlobals.sysCcu.ILScopeRef + { ScopeRef = tcGlobals.ilg.primaryAssemblyScopeRef Name = t IsForwarder = true Access = ILTypeDefAccess.Public @@ -921,7 +921,7 @@ module MainModuleBuilder = mkILCustomAttrs [ if not tcConfig.internConstantStrings then yield mkILCustomAttribute tcGlobals.ilg - (mkILTyRef (tcGlobals.ilg.traits.ScopeRef, "System.Runtime.CompilerServices.CompilationRelaxationsAttribute"), + (tcGlobals.ilg.mkSysILTypeRef "System.Runtime.CompilerServices.CompilationRelaxationsAttribute", [tcGlobals.ilg.typ_Int32], [ILAttribElem.Int32( 8)], []) yield! iattrs yield! codegenResults.ilAssemAttrs @@ -1212,7 +1212,7 @@ module StaticLinker = let mscorlib40 = tcConfig.compilingFslib20.Value let ilBinaryReader = - let ilGlobals = mkILGlobals (IL.mkMscorlibBasedTraits ILScopeRef.Local) (Some ilGlobals.primaryAssemblyName) tcConfig.noDebugData + let ilGlobals = mkILGlobals (tcConfig.noDebugData, (fun _ -> ILScopeRef.Local), (fun _ -> Some ILScopeRef.Local)) let opts = { ILBinaryReader.mkDefault (ilGlobals) with optimizeForMemory=tcConfig.optimizeForMemory pdbPath = None } @@ -1234,7 +1234,7 @@ module StaticLinker = elif tref.Name = "System.Environment" then ILTypeRef.Create(ILScopeRef.Local, [], "Microsoft.FSharp.Core.PrivateEnvironment") //|> Morphs.morphILScopeRefsInILTypeRef (function ILScopeRef.Local -> ilGlobals.mscorlibScopeRef | x -> x) else - tref |> Morphs.morphILScopeRefsInILTypeRef (fun _ -> ilGlobals.traits.ScopeRef) ) + tref |> Morphs.morphILScopeRefsInILTypeRef (fun _ -> ilGlobals.primaryAssemblyScopeRef) ) // strip out System.Runtime.TargetedPatchingOptOutAttribute, which doesn't exist for 2.0 let fakeModule = @@ -1985,8 +1985,7 @@ let main4 (Args (tcConfig, errorLogger: ErrorLogger, ilGlobals, ilxMainModule, o signer = GetStrongNameSigner signingInfo fixupOverlappingSequencePoints = false dumpDebugInfo = tcConfig.dumpDebugInfo }, - ilxMainModule, - tcConfig.noDebugData) + ilxMainModule) with Failure msg -> error(Error(FSComp.SR.fscProblemWritingBinary(outfile, msg), rangeCmdArgs)) with e -> diff --git a/src/fsharp/fsi/fsi.fs b/src/fsharp/fsi/fsi.fs index 7c80ccdc12e..91e64f2be3c 100644 --- a/src/fsharp/fsi/fsi.fs +++ b/src/fsharp/fsi/fsi.fs @@ -2457,7 +2457,7 @@ type internal FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:st // "RuntimeLike" assembly resolution for F# Interactive is not yet properly figured out on .NET Core do tcConfigB.resolutionEnvironment <- ReferenceResolver.DesignTimeLike do tcConfigB.useSimpleResolution <- true - do SetTargetProfile tcConfigB "netcore" // always assume System.Runtime codegen + do SetTargetProfile tcConfigB "privatecorelib" // always assume System.Private.CoreLib codegen #endif // Preset: --optimize+ -g --tailcalls+ (see 4505) diff --git a/src/fsharp/vs/IncrementalBuild.fs b/src/fsharp/vs/IncrementalBuild.fs index 36892c79cc2..505313c52a5 100755 --- a/src/fsharp/vs/IncrementalBuild.fs +++ b/src/fsharp/vs/IncrementalBuild.fs @@ -1519,9 +1519,9 @@ type IncrementalBuilder(frameworkTcImportsCache: FrameworkImportsCache, tcConfig with e -> errorRecoveryNoRange e None - let locale = TryFindStringAttribute tcGlobals (mkMscorlibAttrib tcGlobals "System.Reflection.AssemblyCultureAttribute") topAttrs.assemblyAttrs + let locale = TryFindStringAttribute tcGlobals (mkSysAttrib tcGlobals "System.Reflection.AssemblyCultureAttribute") topAttrs.assemblyAttrs let assemVerFromAttrib = - TryFindStringAttribute tcGlobals (mkMscorlibAttrib tcGlobals "System.Reflection.AssemblyVersionAttribute") topAttrs.assemblyAttrs + TryFindStringAttribute tcGlobals (mkSysAttrib tcGlobals "System.Reflection.AssemblyVersionAttribute") topAttrs.assemblyAttrs |> Option.bind (fun v -> try Some (parseILVersion v) with _ -> None) let ver = match assemVerFromAttrib with diff --git a/src/ilx/EraseUnions.fs b/src/ilx/EraseUnions.fs index 4bf5535e441..bc47b5a1200 100644 --- a/src/ilx/EraseUnions.fs +++ b/src/ilx/EraseUnions.fs @@ -208,8 +208,8 @@ let tyForAlt cuspec alt = cuspecRepr.TypeForAlternative(cuspec,alt) let GetILTypeForAlternative cuspec alt = cuspecRepr.TypeForAlternative(cuspec,cuspec.Alternative alt) -let mkTagFieldType ilg _cuspec = ilg.typ_Int32 -let mkTagFieldFormalType ilg _cuspec = ilg.typ_Int32 +let mkTagFieldType (ilg: ILGlobals) _cuspec = ilg.typ_Int32 +let mkTagFieldFormalType (ilg: ILGlobals) _cuspec = ilg.typ_Int32 let mkTagFieldId ilg cuspec = "_tag", mkTagFieldType ilg cuspec let mkTailOrNullId baseTy = "tail", constFormalFieldTy baseTy @@ -227,7 +227,7 @@ let altOfUnionSpec (cuspec:IlxUnionSpec) cidx = let doesRuntimeTypeDiscriminateUseHelper avoidHelpers (cuspec: IlxUnionSpec) (alt: IlxUnionAlternative) = not avoidHelpers && alt.IsNullary && cuspec.HasHelpers = IlxUnionHasHelpers.AllHelpers -let mkRuntimeTypeDiscriminate ilg avoidHelpers cuspec alt altName altTy = +let mkRuntimeTypeDiscriminate (ilg: ILGlobals) avoidHelpers cuspec alt altName altTy = let useHelper = doesRuntimeTypeDiscriminateUseHelper avoidHelpers cuspec alt if useHelper then let baseTy = baseTyOfUnionSpec cuspec @@ -668,7 +668,7 @@ let convAlternativeDef ilg num (td:ILTypeDef) cud info cuspec (baseTy:ILType) (a [ mkILNonGenericInstanceMethod ("get_" + mkTesterName altName, cud.cudHelpersAccess,[], - mkILReturn ilg.typ_bool, + mkILReturn ilg.typ_Bool, mkMethodBody(true,[],2,nonBranchingInstrsToCode ([ mkLdarg0 ] @ mkIsData ilg (true, cuspec, num)), attr)) |> addMethodGeneratedAttrs ilg ], @@ -676,9 +676,9 @@ let convAlternativeDef ilg num (td:ILTypeDef) cud info cuspec (baseTy:ILType) (a IsRTSpecialName=false IsSpecialName=false SetMethod=None - GetMethod = Some (mkILMethRef (baseTy.TypeRef, ILCallingConv.Instance, "get_" + mkTesterName altName, 0, [], ilg.typ_bool)) + GetMethod = Some (mkILMethRef (baseTy.TypeRef, ILCallingConv.Instance, "get_" + mkTesterName altName, 0, [], ilg.typ_Bool)) CallingConv=ILThisConvention.Instance - Type=ilg.typ_bool + Type=ilg.typ_Bool Init=None Args = [] CustomAttrs=emptyILCustomAttrs } diff --git a/tests/scripts/fsci.fsx b/tests/scripts/fsci.fsx index 5c02cc86589..6b47b142048 100644 --- a/tests/scripts/fsci.fsx +++ b/tests/scripts/fsci.fsx @@ -20,7 +20,7 @@ let Win32Manifest = CompilerPath ++ "default.win32manifest" let isRepro = Verbosity = "repro" || Verbosity = "verbose" let isVerbose = Verbosity = "verbose" -let dependencies = CrackProjectJson.collectReferences (isVerbose, PackagesDir, FrameworkName + "/" + Platform, ProjectJsonLock, false, false) |> Seq.toArray +let dependencies = CrackProjectJson.collectReferences (isVerbose, PackagesDir, FrameworkName + "/" + Platform, ProjectJsonLock, true, false) |> Seq.toArray let executeProcessNoRedirect filename arguments = if isVerbose then From a6e3ea84cd8672d17351a51bee1f1e1f1781a85b Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 21 Nov 2016 17:03:56 +0000 Subject: [PATCH 02/13] better type searching --- src/absil/il.fs | 362 +-- src/absil/il.fsi | 102 +- src/absil/ilprint.fs | 29 +- src/absil/ilread.fs | 7 +- src/absil/ilreflect.fs | 22 +- src/absil/ilwrite.fs | 13 +- src/fsharp/AttributeChecking.fs | 6 +- src/fsharp/AugmentWithHashCompare.fs | 65 +- src/fsharp/CheckFormatStrings.fs | 8 +- src/fsharp/CompileOps.fs | 68 +- src/fsharp/CompileOptions.fs | 3 +- src/fsharp/CompileOptions.fsi | 2 +- src/fsharp/DetupleArgs.fs | 2 +- src/fsharp/IlxGen.fs | 407 +-- src/fsharp/IlxGen.fsi | 2 - src/fsharp/LowerCallsAndSeqs.fs | 2 +- src/fsharp/MethodCalls.fs | 2 +- src/fsharp/Optimizer.fs | 20 +- src/fsharp/PatternMatchCompilation.fs | 4 +- src/fsharp/QuotationTranslator.fs | 2 +- src/fsharp/TastOps.fs | 240 +- src/fsharp/TastOps.fsi | 12 +- src/fsharp/TcGlobals.fs | 2205 +++++++---------- src/fsharp/TypeChecker.fs | 24 +- src/fsharp/TypeRelations.fs | 2 +- src/fsharp/fsc.fs | 21 +- src/fsharp/fsi/fsi.fs | 13 +- src/fsharp/infos.fs | 4 +- src/ilx/EraseClosures.fs | 34 +- src/ilx/EraseClosures.fsi | 2 +- src/ilx/EraseUnions.fs | 90 +- src/ilx/EraseUnions.fsi | 3 +- .../Tests.LanguageService.General.fs | 6 +- 33 files changed, 1589 insertions(+), 2195 deletions(-) diff --git a/src/absil/il.fs b/src/absil/il.fs index c390b4f0895..6abe7badb2e 100644 --- a/src/absil/il.fs +++ b/src/absil/il.fs @@ -1986,40 +1986,10 @@ let tname_Object = "System.Object" [] let tname_String = "System.String" [] -let tname_StringBuilder = "System.Text.StringBuilder" -[] -let tname_AsyncCallback = "System.AsyncCallback" -[] -let tname_IAsyncResult = "System.IAsyncResult" -[] -let tname_IComparable = "System.IComparable" -[] -let tname_Exception = "System.Exception" +let tname_Array = "System.Array" [] let tname_Type = "System.Type" [] -let tname_Missing = "System.Reflection.Missing" -[] -let tname_Activator = "System.Activator" -[] -let tname_SerializationInfo = "System.Runtime.Serialization.SerializationInfo" -[] -let tname_StreamingContext = "System.Runtime.Serialization.StreamingContext" -[] -let tname_SecurityPermissionAttribute = "System.Security.Permissions.SecurityPermissionAttribute" -[] -let tname_Delegate = "System.Delegate" -[] -let tname_ValueType = "System.ValueType" -[] -let tname_TypedReference = "System.TypedReference" -[] -let tname_Enum = "System.Enum" -[] -let tname_MulticastDelegate = "System.MulticastDelegate" -[] -let tname_Array = "System.Array" -[] let tname_Int64 = "System.Int64" [] let tname_UInt64 = "System.UInt64" @@ -2047,148 +2017,55 @@ let tname_Char = "System.Char" let tname_IntPtr = "System.IntPtr" [] let tname_UIntPtr = "System.UIntPtr" -[] -let tname_RuntimeArgumentHandle = "System.RuntimeArgumentHandle" -[] -let tname_RuntimeTypeHandle = "System.RuntimeTypeHandle" -[] -let tname_RuntimeMethodHandle = "System.RuntimeMethodHandle" -[] -let tname_RuntimeFieldHandle = "System.RuntimeFieldHandle" [] // This data structure needs an entirely delayed implementation -type ILGlobals(noDebugData, getTypeILScopeRef, tryGetTypeILScopeRef) = +type ILGlobals(primaryScopeRef) = - let m_mkSysILTypeRef nm = mkILTyRef(getTypeILScopeRef nm, nm) - let m_tryMkSysILTypeRef nm = match tryGetTypeILScopeRef nm with Some r -> Some(mkILTyRef(r, nm)) | _ -> None - - let m_typ_Object = lazy mkILBoxedType (mkILNonGenericTySpec (m_mkSysILTypeRef tname_Object)) - let m_typ_String = lazy mkILBoxedType (mkILNonGenericTySpec (m_mkSysILTypeRef tname_String)) - let m_typ_StringBuilder = lazy mkILBoxedType (mkILNonGenericTySpec (m_mkSysILTypeRef tname_StringBuilder)) - let m_typ_AsyncCallback = lazy mkILBoxedType (mkILNonGenericTySpec (m_mkSysILTypeRef tname_AsyncCallback)) - let m_typ_IAsyncResult = lazy mkILBoxedType (mkILNonGenericTySpec (m_mkSysILTypeRef tname_IAsyncResult)) - let m_typ_IComparable = lazy mkILBoxedType (mkILNonGenericTySpec (m_mkSysILTypeRef tname_IComparable)) - let m_typ_Exception = lazy mkILBoxedType (mkILNonGenericTySpec (m_mkSysILTypeRef tname_Exception)) - let m_typ_Type = lazy mkILBoxedType (mkILNonGenericTySpec (m_mkSysILTypeRef tname_Type)) - let m_typ_Missing = lazy mkILBoxedType (mkILNonGenericTySpec (m_mkSysILTypeRef tname_Missing)) - let m_typ_Activator = lazy mkILBoxedType (mkILNonGenericTySpec (m_mkSysILTypeRef tname_Activator)) - let m_typ_SerializationInfo = - lazy - match tryGetTypeILScopeRef tname_SerializationInfo with - | Some scopeRef -> Some (mkILBoxedType (mkILNonGenericTySpec (mkILTyRef(scopeRef,tname_SerializationInfo)))) - | None -> None - let m_typ_StreamingContext = lazy ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_StreamingContext)) - let m_tref_SecurityPermissionAttribute = - lazy - match tryGetTypeILScopeRef tname_SecurityPermissionAttribute with - | Some scopeRef -> Some (mkILTyRef(scopeRef,tname_SecurityPermissionAttribute)) - | None -> None - let m_typ_Delegate = lazy mkILBoxedType (mkILNonGenericTySpec (m_mkSysILTypeRef tname_Delegate)) - let m_typ_ValueType = lazy mkILBoxedType (mkILNonGenericTySpec (m_mkSysILTypeRef tname_ValueType)) - let m_typ_TypedReference = - lazy - match tryGetTypeILScopeRef tname_TypedReference with - | Some scopeRef -> Some(ILType.Value (mkILNonGenericTySpec (mkILTyRef (scopeRef,tname_TypedReference)))) - | None -> None - let m_typ_Enum = lazy mkILBoxedType (mkILNonGenericTySpec (m_mkSysILTypeRef tname_Enum)) - let m_typ_MulticastDelegate = lazy mkILBoxedType (mkILNonGenericTySpec (m_mkSysILTypeRef tname_MulticastDelegate)) - let m_typ_Array = lazy mkILBoxedType (mkILNonGenericTySpec (m_mkSysILTypeRef tname_Array)) - let m_typ_SByte = lazy ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_SByte)) - let m_typ_Int16 = lazy ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_Int16)) - let m_typ_Int32 = lazy ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_Int32)) - let m_typ_Int64 = lazy ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_Int64)) - let m_typ_Byte = lazy ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_Byte)) - let m_typ_UInt16 = lazy ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_UInt16)) - let m_typ_UInt32 = lazy ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_UInt32)) - let m_typ_UInt64 = lazy ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_UInt64)) - let m_typ_Single = lazy ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_Single)) - let m_typ_Double = lazy ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_Double)) - let m_typ_Bool = lazy ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_Bool)) - let m_typ_Char = lazy ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_Char)) - let m_typ_IntPtr = lazy ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_IntPtr)) - let m_typ_UIntPtr = lazy ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_UIntPtr)) - - let m_typ_RuntimeArgumentHandle = - lazy - match tryGetTypeILScopeRef tname_RuntimeArgumentHandle with - | Some scopeRef -> Some(ILType.Value (mkILNonGenericTySpec (mkILTyRef (scopeRef,tname_RuntimeArgumentHandle)))) - | None -> None - - let m_typ_RuntimeTypeHandle = lazy ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_RuntimeTypeHandle)) - let m_typ_RuntimeMethodHandle = lazy ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_RuntimeMethodHandle)) - let m_typ_RuntimeFieldHandle = lazy ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_RuntimeFieldHandle)) - let mutable m_generatedAttribsCache = [] - let mutable m_debuggerBrowsableNeverAttributeCache = None - member x.primaryAssemblyScopeRef = m_typ_Object.Value.TypeRef.Scope - member x.primaryAssemblyName = m_typ_Object.Value.TypeRef.Scope.AssemblyRef.Name - member x.noDebugData = noDebugData - member x.tref_Object = m_typ_Object.Value.TypeRef - member x.tspec_Object = m_typ_Object.Value.TypeSpec - member x.typ_Object = m_typ_Object.Value - member x.tref_String = m_typ_String.Value.TypeRef - member x.typ_String = m_typ_String.Value - member x.typ_StringBuilder = m_typ_StringBuilder.Value - member x.typ_AsyncCallback = m_typ_AsyncCallback.Value - member x.typ_IAsyncResult = m_typ_IAsyncResult.Value - member x.typ_IComparable = m_typ_IComparable.Value - member x.typ_Activator = m_typ_Activator.Value - member x.tref_Type = m_typ_Type.Value.TypeRef - member x.typ_Type = m_typ_Type.Value - member x.typ_Missing = m_typ_Missing.Value - member x.typ_Delegate = m_typ_Delegate.Value - member x.typ_ValueType = m_typ_ValueType.Value - member x.typ_Enum = m_typ_Enum.Value - member x.tspec_TypedReference = m_typ_TypedReference.Value |> Option.map (fun x -> x.TypeSpec) - member x.typ_TypedReference = m_typ_TypedReference.Value - member x.typ_MulticastDelegate = m_typ_MulticastDelegate.Value - member x.typ_Array = m_typ_Array.Value - member x.tspec_Int64 = m_typ_Int64.Value.TypeSpec - member x.tspec_UInt64 = m_typ_UInt64.Value.TypeSpec - member x.tspec_Int32 = m_typ_Int32.Value.TypeSpec - member x.tspec_UInt32 = m_typ_UInt32.Value.TypeSpec - member x.tspec_Int16 = m_typ_Int16.Value.TypeSpec - member x.tspec_UInt16 = m_typ_UInt16.Value.TypeSpec - member x.tspec_SByte = m_typ_SByte.Value.TypeSpec - member x.tspec_Byte = m_typ_Byte.Value.TypeSpec - member x.tspec_Single = m_typ_Single.Value.TypeSpec - member x.tspec_Double = m_typ_Double.Value.TypeSpec - member x.tspec_IntPtr = m_typ_IntPtr.Value.TypeSpec - member x.tspec_UIntPtr = m_typ_UIntPtr.Value.TypeSpec - member x.tspec_Char = m_typ_Char.Value.TypeSpec - member x.tspec_Bool = m_typ_Bool.Value.TypeSpec - member x.typ_IntPtr = m_typ_IntPtr.Value - member x.typ_UIntPtr = m_typ_UIntPtr.Value - member x.typ_RuntimeArgumentHandle = m_typ_RuntimeArgumentHandle.Value - member x.typ_RuntimeTypeHandle = m_typ_RuntimeTypeHandle.Value - member x.typ_RuntimeMethodHandle = m_typ_RuntimeMethodHandle.Value - member x.typ_RuntimeFieldHandle = m_typ_RuntimeFieldHandle.Value - - member x.typ_Byte = m_typ_Byte.Value - member x.typ_Int16 = m_typ_Int16.Value - member x.typ_Int32 = m_typ_Int32.Value - member x.typ_Int64 = m_typ_Int64.Value - member x.typ_SByte = m_typ_SByte.Value - member x.typ_UInt16 = m_typ_UInt16.Value - member x.typ_UInt32 = m_typ_UInt32.Value - member x.typ_UInt64 = m_typ_UInt64.Value - member x.typ_Single = m_typ_Single.Value - member x.typ_Double = m_typ_Double.Value - member x.typ_Bool = m_typ_Bool.Value - member x.typ_Char = m_typ_Char.Value - member x.typ_SerializationInfo = m_typ_SerializationInfo.Value - member x.typ_StreamingContext = m_typ_StreamingContext.Value - member x.tref_SecurityPermissionAttribute = m_tref_SecurityPermissionAttribute.Value - member x.tspec_Exception = m_typ_Exception.Value.TypeSpec - member x.typ_Exception = m_typ_Exception.Value - member x.generatedAttribsCache with get () = m_generatedAttribsCache and set v = m_generatedAttribsCache <- v - member x.debuggerBrowsableNeverAttributeCache with get() = m_debuggerBrowsableNeverAttributeCache and set v = m_debuggerBrowsableNeverAttributeCache <- v - member x.mkSysILTypeRef nm = m_mkSysILTypeRef nm - member x.tryMkSysILTypeRef nm = m_tryMkSysILTypeRef nm + let m_mkSysILTypeRef nm = mkILTyRef(primaryScopeRef, nm) + + let m_typ_Object = mkILBoxedType (mkILNonGenericTySpec (m_mkSysILTypeRef tname_Object)) + let m_typ_String = mkILBoxedType (mkILNonGenericTySpec (m_mkSysILTypeRef tname_String)) + let m_typ_Array = mkILBoxedType (mkILNonGenericTySpec (m_mkSysILTypeRef tname_Array)) + let m_typ_Type = mkILBoxedType (mkILNonGenericTySpec (m_mkSysILTypeRef tname_Type)) + let m_typ_SByte = ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_SByte)) + let m_typ_Int16 = ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_Int16)) + let m_typ_Int32 = ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_Int32)) + let m_typ_Int64 = ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_Int64)) + let m_typ_Byte = ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_Byte)) + let m_typ_UInt16 = ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_UInt16)) + let m_typ_UInt32 = ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_UInt32)) + let m_typ_UInt64 = ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_UInt64)) + let m_typ_Single = ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_Single)) + let m_typ_Double = ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_Double)) + let m_typ_Bool = ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_Bool)) + let m_typ_Char = ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_Char)) + let m_typ_IntPtr = ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_IntPtr)) + let m_typ_UIntPtr = ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_UIntPtr)) + + member x.primaryAssemblyScopeRef = m_typ_Object.TypeRef.Scope + member x.primaryAssemblyName = m_typ_Object.TypeRef.Scope.AssemblyRef.Name + member x.typ_Object = m_typ_Object + member x.typ_String = m_typ_String + member x.typ_Array = m_typ_Array + member x.typ_Type = m_typ_Type + member x.typ_IntPtr = m_typ_IntPtr + member x.typ_UIntPtr = m_typ_UIntPtr + member x.typ_Byte = m_typ_Byte + member x.typ_Int16 = m_typ_Int16 + member x.typ_Int32 = m_typ_Int32 + member x.typ_Int64 = m_typ_Int64 + member x.typ_SByte = m_typ_SByte + member x.typ_UInt16 = m_typ_UInt16 + member x.typ_UInt32 = m_typ_UInt32 + member x.typ_UInt64 = m_typ_UInt64 + member x.typ_Single = m_typ_Single + member x.typ_Double = m_typ_Double + member x.typ_Bool = m_typ_Bool + member x.typ_Char = m_typ_Char override x.ToString() = "" -let mkILGlobals(noDebugData, getTypeILScopeRef, tryGetTypeILScopeRef) = - ILGlobals(noDebugData, getTypeILScopeRef, tryGetTypeILScopeRef) +let mkILGlobals primaryScopeRef = ILGlobals primaryScopeRef let mkNormalCall mspec = I_call (Normalcall, mspec, None) let mkNormalCallvirt mspec = I_callvirt (Normalcall, mspec, None) @@ -2223,17 +2100,11 @@ let tname_DebuggableAttribute = "System.Diagnostics.DebuggableAttribute" (* NOTE: ecma_ prefix refers to the standard "mscorlib" *) let ecmaPublicKey = PublicKeyToken (Bytes.ofInt32Array [|0xde; 0xad; 0xbe; 0xef; 0xca; 0xfe; 0xfa; 0xce |]) -let mkInitializeArrayMethSpec (ilg: ILGlobals) = - mkILNonGenericStaticMethSpecInTy(mkILNonGenericBoxedTy(ilg.mkSysILTypeRef "System.Runtime.CompilerServices.RuntimeHelpers"),"InitializeArray", [ilg.typ_Array;ilg.typ_RuntimeFieldHandle], ILType.Void) -(* e.ilg. [mkPrimaryAssemblyExnNewobj "System.InvalidCastException"] *) -let mkPrimaryAssemblyExnNewobj (ilg: ILGlobals) eclass = - mkNormalNewobj (mkILNonGenericCtorMethSpec (ilg.mkSysILTypeRef eclass,[])) - -let typ_is_boxed = function ILType.Boxed _ -> true | _ -> false -let typ_is_value = function ILType.Value _ -> true | _ -> false +let isILBoxedTy = function ILType.Boxed _ -> true | _ -> false +let isILValueTy = function ILType.Value _ -> true | _ -> false -let tspec_is_primaryAssembly (tspec:ILTypeSpec) n = +let isPrimaryAssemblyTySpec (tspec:ILTypeSpec) n = let tref = tspec.TypeRef let scoref = tref.Scope (tref.Name = n) && @@ -2242,32 +2113,29 @@ let tspec_is_primaryAssembly (tspec:ILTypeSpec) n = | ILScopeRef.Module _ -> false | ILScopeRef.Local -> true -let typ_is_boxed_mscorlib_typ (ty:ILType) n = - typ_is_boxed ty && tspec_is_primaryAssembly ty.TypeSpec n +let isILBoxedPrimaryAssemblyTy (ty:ILType) n = + isILBoxedTy ty && isPrimaryAssemblyTySpec ty.TypeSpec n -let typ_is_value_mscorlib_typ (ty:ILType) n = - typ_is_value ty && tspec_is_primaryAssembly ty.TypeSpec n +let isILValuePrimaryAssemblyTy (ty:ILType) n = + isILValueTy ty && isPrimaryAssemblyTySpec ty.TypeSpec n -let isILObjectTy ty = typ_is_boxed_mscorlib_typ ty tname_Object -let isILStringTy ty = typ_is_boxed_mscorlib_typ ty tname_String -let typ_is_AsyncCallback ty = typ_is_boxed_mscorlib_typ ty tname_AsyncCallback -let isILTypedReferenceTy ty = typ_is_value_mscorlib_typ ty tname_TypedReference -let typ_is_IAsyncResult ty = typ_is_boxed_mscorlib_typ ty tname_IAsyncResult -let typ_is_IComparable ty = typ_is_boxed_mscorlib_typ ty tname_IComparable -let isILSByteTy ty = typ_is_value_mscorlib_typ ty tname_SByte -let isILByteTy ty = typ_is_value_mscorlib_typ ty tname_Byte -let isILInt16Ty ty = typ_is_value_mscorlib_typ ty tname_Int16 -let isILUInt16Ty ty = typ_is_value_mscorlib_typ ty tname_UInt16 -let isILInt32Ty ty = typ_is_value_mscorlib_typ ty tname_Int32 -let isILUInt32Ty ty = typ_is_value_mscorlib_typ ty tname_UInt32 -let isILInt64Ty ty = typ_is_value_mscorlib_typ ty tname_Int64 -let isILUInt64Ty ty = typ_is_value_mscorlib_typ ty tname_UInt64 -let isILIntPtrTy ty = typ_is_value_mscorlib_typ ty tname_IntPtr -let isILUIntPtrTy ty = typ_is_value_mscorlib_typ ty tname_UIntPtr -let isILBoolTy ty = typ_is_value_mscorlib_typ ty tname_Bool -let isILCharTy ty = typ_is_value_mscorlib_typ ty tname_Char -let isILSingleTy ty = typ_is_value_mscorlib_typ ty tname_Single -let isILDoubleTy ty = typ_is_value_mscorlib_typ ty tname_Double +let isILObjectTy ty = isILBoxedPrimaryAssemblyTy ty tname_Object +let isILStringTy ty = isILBoxedPrimaryAssemblyTy ty tname_String +let isILTypedReferenceTy ty = isILValuePrimaryAssemblyTy ty "System.TypedReference" +let isILSByteTy ty = isILValuePrimaryAssemblyTy ty tname_SByte +let isILByteTy ty = isILValuePrimaryAssemblyTy ty tname_Byte +let isILInt16Ty ty = isILValuePrimaryAssemblyTy ty tname_Int16 +let isILUInt16Ty ty = isILValuePrimaryAssemblyTy ty tname_UInt16 +let isILInt32Ty ty = isILValuePrimaryAssemblyTy ty tname_Int32 +let isILUInt32Ty ty = isILValuePrimaryAssemblyTy ty tname_UInt32 +let isILInt64Ty ty = isILValuePrimaryAssemblyTy ty tname_Int64 +let isILUInt64Ty ty = isILValuePrimaryAssemblyTy ty tname_UInt64 +let isILIntPtrTy ty = isILValuePrimaryAssemblyTy ty tname_IntPtr +let isILUIntPtrTy ty = isILValuePrimaryAssemblyTy ty tname_UIntPtr +let isILBoolTy ty = isILValuePrimaryAssemblyTy ty tname_Bool +let isILCharTy ty = isILValuePrimaryAssemblyTy ty tname_Char +let isILSingleTy ty = isILValuePrimaryAssemblyTy ty tname_Single +let isILDoubleTy ty = isILValuePrimaryAssemblyTy ty tname_Double // -------------------------------------------------------------------- // Rescoping @@ -2807,7 +2675,7 @@ let mkILGenericClass (nm, access, genparams, extends, impl, methods, fields, nes HasSecurity=false; } -let mkRawDataValueTypeDef (ilg: ILGlobals) (nm,size,pack) = +let mkRawDataValueTypeDef (iltyp_ValueType: ILType) (nm,size,pack) = { tdKind=ILTypeDefKind.ValueType; Name = nm; GenericParams= []; @@ -2815,7 +2683,7 @@ let mkRawDataValueTypeDef (ilg: ILGlobals) (nm,size,pack) = Implements = [] IsAbstract = false; IsSealed = true; - Extends = Some ilg.typ_ValueType; + Extends = Some iltyp_ValueType; IsComInterop=false; IsSerializable = false; IsSpecialName=false; @@ -2906,7 +2774,7 @@ let buildILCode (_methName:string) lab2pc instrs tryspecs localspecs : ILCode = // Detecting Delegates // -------------------------------------------------------------------- -let mkILDelegateMethods (ilg: ILGlobals) (parms,rtv:ILReturn) = +let mkILDelegateMethods (ilg: ILGlobals) (iltyp_AsyncCallback, iltyp_IAsyncResult) (parms,rtv:ILReturn) = let rty = rtv.Type let one nm args ret = let mdef = mkILNonGenericVirtualMethod (nm,ILMemberAccess.Public,args,mkILReturn ret,MethodBody.Abstract) @@ -2921,8 +2789,8 @@ let mkILDelegateMethods (ilg: ILGlobals) (parms,rtv:ILReturn) = let ctor = { ctor with mdCodeKind=MethodCodeKind.Runtime; IsHideBySig=true } [ ctor; one "Invoke" parms rty; - one "BeginInvoke" (parms @ [mkILParamNamed("callback",ilg.typ_AsyncCallback); mkILParamNamed("objects",ilg.typ_Object) ] ) ilg.typ_IAsyncResult; - one "EndInvoke" [mkILParamNamed("result",ilg.typ_IAsyncResult)] rty; ] + one "BeginInvoke" (parms @ [mkILParamNamed("callback",iltyp_AsyncCallback); mkILParamNamed("objects",ilg.typ_Object) ] ) iltyp_IAsyncResult; + one "EndInvoke" [mkILParamNamed("result",iltyp_IAsyncResult)] rty; ] let mkCtorMethSpecForDelegate (ilg: ILGlobals) (typ:ILType,useUIntPtr) = @@ -3263,89 +3131,7 @@ let mkILCustomAttribute ilg (tref,argtys,argvs,propvs) = mkILCustomAttribMethRef ilg (mkILNonGenericCtorMethSpec (tref,argtys),argvs,propvs) let MscorlibScopeRef = ILScopeRef.Assembly (ILAssemblyRef.Create("mscorlib", None, Some ecmaPublicKey, true, None, None)) -let EcmaMscorlibILGlobals = mkILGlobals (false, (fun _ -> MscorlibScopeRef), (fun _ -> Some MscorlibScopeRef)) - -let tref_CompilerGeneratedAttribute (ilg: ILGlobals) = ilg.mkSysILTypeRef tname_CompilerGeneratedAttribute - -[] -let tname_DebuggerNonUserCodeAttribute = "System.Diagnostics.DebuggerNonUserCodeAttribute" -[] -let tname_DebuggableAttribute_DebuggingModes = "DebuggingModes" -[] -let tname_DebuggerHiddenAttribute = "System.Diagnostics.DebuggerHiddenAttribute" -[] -let tname_DebuggerDisplayAttribute = "System.Diagnostics.DebuggerDisplayAttribute" -[] -let tname_DebuggerTypeProxyAttribute = "System.Diagnostics.DebuggerTypeProxyAttribute" -[] -let tname_DebuggerStepThroughAttribute = "System.Diagnostics.DebuggerStepThroughAttribute" -[] -let tname_DebuggerBrowsableAttribute = "System.Diagnostics.DebuggerBrowsableAttribute" -[] -let tname_DebuggerBrowsableState = "System.Diagnostics.DebuggerBrowsableState" - -let mkSystemDiagnosticsDebugTypeRef (ilg : ILGlobals) typeName = ilg.mkSysILTypeRef typeName -let mkSystemDiagnosticsDebuggableTypeRef (ilg : ILGlobals) = ilg.mkSysILTypeRef tname_DebuggableAttribute -let tref_DebuggableAttribute_DebuggingModes (ilg : ILGlobals) = mkILTyRefInTyRef (mkSystemDiagnosticsDebuggableTypeRef ilg, tname_DebuggableAttribute_DebuggingModes) - - -type ILGlobals with - member this.mkDebuggerNonUserCodeAttribute() = mkILCustomAttribute this (mkSystemDiagnosticsDebugTypeRef this tname_DebuggerNonUserCodeAttribute, [], [], []) - member this.mkDebuggerHiddenAttribute() = mkILCustomAttribute this (mkSystemDiagnosticsDebugTypeRef this tname_DebuggerHiddenAttribute, [], [], []) - member this.mkDebuggerDisplayAttribute s = mkILCustomAttribute this (mkSystemDiagnosticsDebugTypeRef this tname_DebuggerDisplayAttribute, [this.typ_String],[ILAttribElem.String (Some s)],[]) - member this.mkDebuggerTypeProxyAttribute (ty : ILType) = mkILCustomAttribute this (mkSystemDiagnosticsDebugTypeRef this tname_DebuggerTypeProxyAttribute, [this.typ_Type],[ILAttribElem.TypeRef (Some ty.TypeRef)],[]) - member this.tref_DebuggerBrowsableAttribute n = - let typ_DebuggerBrowsableState = - let tref = mkSystemDiagnosticsDebugTypeRef this tname_DebuggerBrowsableState - ILType.Value (mkILNonGenericTySpec tref) - mkILCustomAttribute this (mkSystemDiagnosticsDebugTypeRef this tname_DebuggerBrowsableAttribute, [typ_DebuggerBrowsableState],[ILAttribElem.Int32 n],[]) - - member this.mkDebuggerBrowsableNeverAttribute() = - match this.debuggerBrowsableNeverAttributeCache with - | None -> - let res = this.tref_DebuggerBrowsableAttribute 0 - this.debuggerBrowsableNeverAttributeCache <- Some res - res - | Some res -> res - - member this.mkDebuggerStepThroughAttribute() = mkILCustomAttribute this (mkSystemDiagnosticsDebugTypeRef this tname_DebuggerStepThroughAttribute, [], [], []) - member this.mkDebuggableAttribute (jitOptimizerDisabled) = - mkILCustomAttribute this (mkSystemDiagnosticsDebuggableTypeRef this, [this.typ_Bool; this.typ_Bool], [ILAttribElem.Bool false; ILAttribElem.Bool jitOptimizerDisabled], []) - - - member this.mkDebuggableAttributeV2(jitTracking, ignoreSymbolStoreSequencePoints, jitOptimizerDisabled, enableEnC) = - let tref = mkSystemDiagnosticsDebuggableTypeRef this - let debuggingMode = (if jitTracking then 1 else 0) ||| - (if jitOptimizerDisabled then 256 else 0) ||| - (if ignoreSymbolStoreSequencePoints then 2 else 0) ||| - (if enableEnC then 4 else 0) - mkILCustomAttribute this - (tref,[mkILNonGenericValueTy (tref_DebuggableAttribute_DebuggingModes this)], - (* See System.Diagnostics.DebuggableAttribute.DebuggingModes *) - [ILAttribElem.Int32( debuggingMode )],[]) - - member this.mkCompilerGeneratedAttribute () = mkILCustomAttribute this (tref_CompilerGeneratedAttribute this, [], [], []) - -// Requests attributes to be added to compiler generated methods. -let addGeneratedAttrs (ilg: ILGlobals) (attrs: ILAttributes) = - let attribs = - match ilg.generatedAttribsCache with - | [] -> - let res = [ if not ilg.noDebugData then - yield ilg.mkCompilerGeneratedAttribute() - yield ilg.mkDebuggerNonUserCodeAttribute()] - ilg.generatedAttribsCache <- res - res - | res -> res - mkILCustomAttrs (attrs.AsList @ attribs) - -let addMethodGeneratedAttrs ilg (mdef:ILMethodDef) = {mdef with CustomAttrs = addGeneratedAttrs ilg mdef.CustomAttrs} -let addPropertyGeneratedAttrs ilg (pdef:ILPropertyDef) = {pdef with CustomAttrs = addGeneratedAttrs ilg pdef.CustomAttrs} -let addFieldGeneratedAttrs ilg (fdef:ILFieldDef) = {fdef with CustomAttrs = addGeneratedAttrs ilg fdef.CustomAttrs} - -let add_never_attrs (ilg : ILGlobals) (attrs: ILAttributes) = mkILCustomAttrs (attrs.AsList @ [ilg.mkDebuggerBrowsableNeverAttribute()]) -let addPropertyNeverAttrs ilg (pdef:ILPropertyDef) = {pdef with CustomAttrs = add_never_attrs ilg pdef.CustomAttrs} -let addFieldNeverAttrs ilg (fdef:ILFieldDef) = {fdef with CustomAttrs = add_never_attrs ilg fdef.CustomAttrs} +let EcmaMscorlibILGlobals = mkILGlobals MscorlibScopeRef // PermissionSet is a 'blob' having the following format: diff --git a/src/absil/il.fsi b/src/absil/il.fsi index fc8fdf6f155..6f1d41df7c0 100644 --- a/src/absil/il.fsi +++ b/src/absil/il.fsi @@ -1492,47 +1492,12 @@ val ungenericizeTypeName: string -> string (* e.g. List`1 --> List *) type ILGlobals = member primaryAssemblyScopeRef : ILScopeRef member primaryAssemblyName : string - member noDebugData: bool; - member tref_Object: ILTypeRef - member tspec_Object: ILTypeSpec member typ_Object: ILType - member tref_String: ILTypeRef member typ_String: ILType - member typ_StringBuilder: ILType - member typ_AsyncCallback: ILType - member typ_IAsyncResult: ILType - member typ_IComparable: ILType - member tref_Type: ILTypeRef member typ_Type: ILType - member typ_Missing: ILType - member typ_Activator: ILType - member typ_Delegate: ILType - member typ_ValueType: ILType - member typ_Enum: ILType - member tspec_TypedReference: ILTypeSpec option - member typ_TypedReference: ILType option - member typ_MulticastDelegate: ILType member typ_Array: ILType - member tspec_Int64: ILTypeSpec - member tspec_UInt64: ILTypeSpec - member tspec_Int32: ILTypeSpec - member tspec_UInt32: ILTypeSpec - member tspec_Int16: ILTypeSpec - member tspec_UInt16: ILTypeSpec - member tspec_SByte: ILTypeSpec - member tspec_Byte: ILTypeSpec - member tspec_Single: ILTypeSpec - member tspec_Double: ILTypeSpec - member tspec_IntPtr: ILTypeSpec - member tspec_UIntPtr: ILTypeSpec - member tspec_Char: ILTypeSpec - member tspec_Bool: ILTypeSpec member typ_IntPtr: ILType member typ_UIntPtr: ILType - member typ_RuntimeArgumentHandle: ILType option - member typ_RuntimeTypeHandle: ILType - member typ_RuntimeMethodHandle: ILType - member typ_RuntimeFieldHandle: ILType member typ_Byte: ILType member typ_Int16: ILType member typ_Int32: ILType @@ -1545,29 +1510,10 @@ type ILGlobals = member typ_Double: ILType member typ_Bool: ILType member typ_Char: ILType - member typ_SerializationInfo: ILType option - member typ_StreamingContext: ILType - member tref_SecurityPermissionAttribute: ILTypeRef option - member tspec_Exception: ILTypeSpec - member typ_Exception: ILType - member generatedAttribsCache: ILAttribute list with get,set - member debuggerBrowsableNeverAttributeCache : ILAttribute option with get,set - member mkSysILTypeRef : string -> ILTypeRef - member tryMkSysILTypeRef : string -> ILTypeRef option - - member mkDebuggableAttribute: bool (* disable JIT optimizations *) -> ILAttribute - /// Some commonly used custom attibutes - member mkDebuggableAttributeV2 : bool (* jitTracking *) * bool (* ignoreSymbolStoreSequencePoints *) * bool (* disable JIT optimizations *) * bool (* enable EnC *) -> ILAttribute - member mkCompilerGeneratedAttribute : unit -> ILAttribute - member mkDebuggerNonUserCodeAttribute : unit -> ILAttribute - member mkDebuggerStepThroughAttribute : unit -> ILAttribute - member mkDebuggerHiddenAttribute : unit -> ILAttribute - member mkDebuggerDisplayAttribute : string -> ILAttribute - member mkDebuggerTypeProxyAttribute : ILType -> ILAttribute - member mkDebuggerBrowsableNeverAttribute : unit -> ILAttribute + /// Build the table of commonly used references given functions to find types in system assemblies -val mkILGlobals: bool * (string -> ILScopeRef) * (string -> ILScopeRef option) -> ILGlobals +val mkILGlobals: ILScopeRef -> ILGlobals val EcmaMscorlibILGlobals : ILGlobals @@ -1748,7 +1694,7 @@ val mkILTypeDefForGlobalFunctions: ILGlobals -> ILMethodDefs * ILFieldDefs -> IL /// ldtoken field valuetype ''/'$$struct0x6000127-1' ''::'$$method0x6000127-1' /// call void System.Runtime.CompilerServices.RuntimeHelpers::InitializeArray(class System.Array,valuetype System.RuntimeFieldHandle) /// idiom. -val mkRawDataValueTypeDef: ILGlobals -> string * size:int32 * pack:uint16 -> ILTypeDef +val mkRawDataValueTypeDef: ILType -> string * size:int32 * pack:uint16 -> ILTypeDef /// Injecting code into existing code blocks. A branch will /// be added from the given instructions to the (unique) entry of @@ -1768,7 +1714,7 @@ val mkILStorageCtor: ILSourceMarker option * ILInstr list * ILType * (string * I val mkILSimpleStorageCtor: ILSourceMarker option * ILTypeSpec option * ILType * (string * ILType) list * ILMemberAccess -> ILMethodDef val mkILSimpleStorageCtorWithParamNames: ILSourceMarker option * ILTypeSpec option * ILType * (string * string * ILType) list * ILMemberAccess -> ILMethodDef -val mkILDelegateMethods: ILGlobals -> ILParameter list * ILReturn -> ILMethodDef list +val mkILDelegateMethods: ILGlobals -> ILType * ILType -> ILParameter list * ILReturn -> ILMethodDef list /// Given a delegate type definition which lies in a particular scope, /// make a reference to its constructor. @@ -1890,38 +1836,10 @@ val rescopeILMethodRef: ILScopeRef -> ILMethodRef -> ILMethodRef /// the new scope. val rescopeILFieldRef: ILScopeRef -> ILFieldRef -> ILFieldRef - //----------------------------------------------------------------------- // The ILCode Builder utility. //---------------------------------------------------------------------- - -/// buildILCode: Build code from a sequence of instructions. -/// -/// e.g. "buildILCode meth resolver instrs exns locals" -/// -/// This makes the basic block structure of code from more primitive -/// information, i.e. an array of instructions. -/// [meth]: for debugging and should give the name of the method. -/// [resolver]: should return the instruction indexes referred to -/// by code-label strings in the instruction stream. -/// [instrs]: the instructions themselves, perhaps with attributes giving -/// debugging information -/// [exns]: the table of exception-handling specifications -/// for the method. These are again given with respect to labels which will -/// be mapped to pc's by [resolver]. -/// [locals]: the table of specifications of when local variables are live and -/// should appear in the debug info. -/// -/// If the input code is well-formed, the function will returns the -/// chop up the instruction sequence into basic blocks as required for -/// the exception handlers and then return the tree-structured code -/// corresponding to the instruction stream. -/// A new set of code labels will be used throughout the resulting code. -/// -/// The input can be badly formed in many ways: exception handlers might -/// overlap, or scopes of local variables may overlap badly with -/// exception handlers. val buildILCode: string -> lab2pc: Dictionary -> instrs:ILInstr[] -> ILExceptionSpec list -> ILLocalDebugInfo list -> ILCode // -------------------------------------------------------------------- @@ -1941,18 +1859,6 @@ val instILType: ILGenericArgs -> ILType -> ILType /// This is a 'vendor neutral' way of referencing mscorlib. val ecmaPublicKey: PublicKey -/// Some commonly used methods. -val mkInitializeArrayMethSpec: ILGlobals -> ILMethodSpec - -val mkPrimaryAssemblyExnNewobj: ILGlobals -> string -> ILInstr - -val addMethodGeneratedAttrs : ILGlobals -> ILMethodDef -> ILMethodDef -val addPropertyGeneratedAttrs : ILGlobals -> ILPropertyDef -> ILPropertyDef -val addFieldGeneratedAttrs : ILGlobals -> ILFieldDef -> ILFieldDef - -val addPropertyNeverAttrs : ILGlobals -> ILPropertyDef -> ILPropertyDef -val addFieldNeverAttrs : ILGlobals -> ILFieldDef -> ILFieldDef - /// Discriminating different important built-in types. val isILObjectTy: ILType -> bool val isILStringTy: ILType -> bool diff --git a/src/absil/ilprint.fs b/src/absil/ilprint.fs index 496307f8b54..75cc2a0bf97 100644 --- a/src/absil/ilprint.fs +++ b/src/absil/ilprint.fs @@ -165,21 +165,20 @@ and goutput_typ env os ty = | ILType.Byref typ -> goutput_typ env os typ; output_string os "&" | ILType.Ptr typ -> goutput_typ env os typ; output_string os "*" - | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.tspec_SByte.Name -> output_string os "int8" - | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.tspec_Int16.Name -> output_string os "int16" - | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.tspec_Int32.Name -> output_string os "int32" - | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.tspec_Int64.Name -> output_string os "int64" - | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.tspec_IntPtr.Name -> output_string os "native int" - | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.tspec_Byte.Name -> output_string os "unsigned int8" - | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.tspec_UInt16.Name -> output_string os "unsigned int16" - | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.tspec_UInt32.Name -> output_string os "unsigned int32" - | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.tspec_UInt64.Name -> output_string os "unsigned int64" - | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.tspec_UIntPtr.Name -> output_string os "native unsigned int" - | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.tspec_Double.Name -> output_string os "float64" - | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.tspec_Single.Name -> output_string os "float32" - | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.tspec_Bool.Name -> output_string os "bool" - | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.tspec_Char.Name -> output_string os "char" - | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.tspec_TypedReference.Value.Name -> output_string os "refany" + | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.typ_SByte.TypeSpec.Name -> output_string os "int8" + | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.typ_Int16.TypeSpec.Name -> output_string os "int16" + | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.typ_Int32.TypeSpec.Name -> output_string os "int32" + | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.typ_Int64.TypeSpec.Name -> output_string os "int64" + | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.typ_IntPtr.TypeSpec.Name -> output_string os "native int" + | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.typ_Byte.TypeSpec.Name -> output_string os "unsigned int8" + | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.typ_UInt16.TypeSpec.Name -> output_string os "unsigned int16" + | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.typ_UInt32.TypeSpec.Name -> output_string os "unsigned int32" + | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.typ_UInt64.TypeSpec.Name -> output_string os "unsigned int64" + | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.typ_UIntPtr.TypeSpec.Name -> output_string os "native unsigned int" + | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.typ_Double.TypeSpec.Name -> output_string os "float64" + | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.typ_Single.TypeSpec.Name -> output_string os "float32" + | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.typ_Bool.TypeSpec.Name -> output_string os "bool" + | ILType.Value tspec when tspec.Name = EcmaMscorlibILGlobals.typ_Char.TypeSpec.Name -> output_string os "char" | ILType.Value tspec -> output_string os "value class "; goutput_tref env os tspec.TypeRef; diff --git a/src/absil/ilread.fs b/src/absil/ilread.fs index 4709be8a35b..3a0f13ffdbf 100644 --- a/src/absil/ilread.fs +++ b/src/absil/ilread.fs @@ -1868,7 +1868,7 @@ and seekReadTypeDefOrRefAsTypeRef ctxt (TaggedIndex(tag,idx) ) = | tag when tag = tdor_TypeRef -> seekReadTypeRef ctxt idx | tag when tag = tdor_TypeSpec -> dprintn ("type spec used where a type ref or def ctxt.is required") - ctxt.ilg.tref_Object + ctxt.ilg.typ_Object.TypeRef | _ -> failwith "seekReadTypeDefOrRefAsTypeRef_readTypeDefOrRefOrSpec" and seekReadMethodRefParent ctxt numtypars (TaggedIndex(tag,idx)) = @@ -2043,9 +2043,8 @@ and sigptrGetTy ctxt numtypars bytes sigptr = elif b0 = et_VOID then ILType.Void, sigptr elif b0 = et_TYPEDBYREF then - match ctxt.ilg.typ_TypedReference with - | Some t -> t, sigptr - | _ -> failwith "system runtime doesn't contain System.TypedReference" + let t = mkILNonGenericValueTy(mkILTyRef(ctxt.ilg.primaryAssemblyScopeRef,"System.TypedReference")) + t, sigptr elif b0 = et_CMOD_REQD || b0 = et_CMOD_OPT then let tdorIdx, sigptr = sigptrGetTypeDefOrRefOrSpecIdx bytes sigptr let typ, sigptr = sigptrGetTy ctxt numtypars bytes sigptr diff --git a/src/absil/ilreflect.fs b/src/absil/ilreflect.fs index f1e66baa4fb..20265995e54 100644 --- a/src/absil/ilreflect.fs +++ b/src/absil/ilreflect.fs @@ -333,8 +333,9 @@ let convAssemblyRef (aref:ILAssemblyRef) = /// The global environment. type cenv = - { ilg: ILGlobals; - generatePdb: bool; + { ilg: ILGlobals + tryMkSysILTypeRef : string -> ILTypeRef option + generatePdb: bool resolvePath: (ILAssemblyRef -> Choice option) } /// Convert an Abstract IL type reference to Reflection.Emit System.Type value. @@ -1668,13 +1669,16 @@ let typeAttributesOfTypeLayout cenv emEnv x = let attr x p = if p.Size =None && p.Pack = None then None else - Some(convCustomAttr cenv emEnv - (IL.mkILCustomAttribute cenv.ilg - (cenv.ilg.mkSysILTypeRef "System.Runtime.InteropServices.StructLayoutAttribute", - [mkILNonGenericValueTy (cenv.ilg.mkSysILTypeRef "System.Runtime.InteropServices.LayoutKind") ], + match cenv.tryMkSysILTypeRef "System.Runtime.InteropServices.StructLayoutAttribute", cenv.tryMkSysILTypeRef "System.Runtime.InteropServices.LayoutKind" with + | Some tref1, Some tref2 -> + Some(convCustomAttr cenv emEnv + (IL.mkILCustomAttribute cenv.ilg + (tref1, + [mkILNonGenericValueTy tref2 ], [ ILAttribElem.Int32 x ], (p.Pack |> Option.toList |> List.map (fun x -> ("Pack", cenv.ilg.typ_Int32, false, ILAttribElem.Int32 (int32 x)))) @ - (p.Size |> Option.toList |> List.map (fun x -> ("Size", cenv.ilg.typ_Int32, false, ILAttribElem.Int32 x)))))) in + (p.Size |> Option.toList |> List.map (fun x -> ("Size", cenv.ilg.typ_Int32, false, ILAttribElem.Int32 x)))))) + | _ -> None match x with | ILTypeDefLayout.Auto -> TypeAttributes.AutoLayout,None | ILTypeDefLayout.Explicit p -> TypeAttributes.ExplicitLayout,(attr 0x02 p) @@ -1999,8 +2003,8 @@ let mkDynamicAssemblyAndModule (assemblyName, optimize, debugInfo, collectible) let modB = asmB.DefineDynamicModuleAndLog(assemblyName,filename,debugInfo) asmB,modB -let emitModuleFragment (ilg, emEnv, asmB : AssemblyBuilder, modB : ModuleBuilder, modul : IL.ILModuleDef, debugInfo : bool, resolvePath) = - let cenv = { ilg = ilg ; generatePdb = debugInfo; resolvePath=resolvePath } +let emitModuleFragment (ilg, emEnv, asmB : AssemblyBuilder, modB : ModuleBuilder, modul : IL.ILModuleDef, debugInfo : bool, resolvePath, tryMkSysILTypeRef) = + let cenv = { ilg = ilg ; generatePdb = debugInfo; resolvePath=resolvePath; tryMkSysILTypeRef=tryMkSysILTypeRef } let emEnv = buildModuleFragment cenv emEnv asmB modB modul match modul.Manifest with diff --git a/src/absil/ilwrite.fs b/src/absil/ilwrite.fs index 3e4b91b9ff1..c25251bf5ec 100644 --- a/src/absil/ilwrite.fs +++ b/src/absil/ilwrite.fs @@ -2,6 +2,9 @@ module internal Microsoft.FSharp.Compiler.AbstractIL.ILBinaryWriter +open System.Collections.Generic +open System.IO + open Internal.Utilities open Microsoft.FSharp.Compiler.AbstractIL open Microsoft.FSharp.Compiler.AbstractIL.ILAsciiWriter @@ -13,17 +16,13 @@ open Microsoft.FSharp.Compiler.AbstractIL.Internal.BinaryConstants open Microsoft.FSharp.Compiler.AbstractIL.Internal.Support open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library open Microsoft.FSharp.Compiler.AbstractIL.ILPdbWriter - -#if FX_NO_CORHOST_SIGNER -open Microsoft.FSharp.Compiler.AbstractIL.Internal.StrongNameSign -#endif - open Microsoft.FSharp.Compiler.DiagnosticMessage open Microsoft.FSharp.Compiler.ErrorLogger open Microsoft.FSharp.Compiler.Range +#if FX_NO_CORHOST_SIGNER +open Microsoft.FSharp.Compiler.AbstractIL.Internal.StrongNameSign +#endif -open System.Collections.Generic -open System.IO #if DEBUG let showEntryLookups = false diff --git a/src/fsharp/AttributeChecking.fs b/src/fsharp/AttributeChecking.fs index 73540965cd6..664e1bcd7b7 100644 --- a/src/fsharp/AttributeChecking.fs +++ b/src/fsharp/AttributeChecking.fs @@ -251,7 +251,7 @@ let MethInfoHasAttribute g m attribSpec minfo = /// Check IL attributes for 'ObsoleteAttribute', returning errors and warnings as data -let private CheckILAttributes g cattrs m = +let private CheckILAttributes (g: TcGlobals) cattrs m = let (AttribInfo(tref,_)) = g.attrib_SystemObsolete match TryDecodeILAttribute g tref cattrs with | Some ([ILAttribElem.String (Some msg) ],_) -> @@ -318,7 +318,7 @@ let CheckFSharpAttributes g attribs m = #if EXTENSIONTYPING /// Check a list of provided attributes for 'ObsoleteAttribute', returning errors and warnings as data -let private CheckProvidedAttributes g m (provAttribs: Tainted) = +let private CheckProvidedAttributes (g: TcGlobals) m (provAttribs: Tainted) = let (AttribInfo(tref,_)) = g.attrib_SystemObsolete match provAttribs.PUntaint((fun a -> a.GetAttributeConstructorArgs(provAttribs.TypeProvider.PUntaintNoFailure(id), tref.FullName)),m) with | Some ([ Some (:? string as msg) ], _) -> WarnD(ObsoleteWarning(msg,m)) @@ -336,7 +336,7 @@ let private CheckProvidedAttributes g m (provAttribs: Tainted (g.obj_ty --> g.int_ty) let mkCompareTy g ty = (mkThisTy g ty) --> (ty --> g.int_ty) -let mkCompareWithComparerTy g ty = (mkThisTy g ty) --> ((mkRefTupledTy g [g.obj_ty ; g.mk_IComparer_ty]) --> g.int_ty) +let mkCompareWithComparerTy g ty = (mkThisTy g ty) --> ((mkRefTupledTy g [g.obj_ty ; g.IComparer_ty]) --> g.int_ty) let mkEqualsObjTy g ty = (mkThisTy g ty) --> (g.obj_ty --> g.bool_ty) let mkEqualsTy g ty = (mkThisTy g ty) --> (ty --> g.bool_ty) -let mkEqualsWithComparerTy g ty = (mkThisTy g ty) --> ((mkRefTupledTy g [g.obj_ty ; g.mk_IEqualityComparer_ty]) --> g.bool_ty) +let mkEqualsWithComparerTy g ty = (mkThisTy g ty) --> ((mkRefTupledTy g [g.obj_ty ; g.IEqualityComparer_ty]) --> g.bool_ty) let mkHashTy g ty = (mkThisTy g ty) --> (g.unit_ty --> g.int_ty) -let mkHashWithComparerTy g ty = (mkThisTy g ty) --> (g.mk_IEqualityComparer_ty --> g.int_ty) +let mkHashWithComparerTy g ty = (mkThisTy g ty) --> (g.IEqualityComparer_ty --> g.int_ty) //------------------------------------------------------------------------- // Polymorphic comparison //------------------------------------------------------------------------- -let mkRelBinOp g op m e1 e2 = mkAsmExpr ([ op ],[], [e1; e2],[g.bool_ty],m) +let mkRelBinOp (g: TcGlobals) op m e1 e2 = mkAsmExpr ([ op ],[], [e1; e2],[g.bool_ty],m) let mkClt g m e1 e2 = mkRelBinOp g IL.AI_clt m e1 e2 let mkCgt g m e1 e2 = mkRelBinOp g IL.AI_cgt m e1 e2 @@ -79,23 +74,23 @@ let mkCgt g m e1 e2 = mkRelBinOp g IL.AI_cgt m e1 e2 // for creating and using GenericComparer objects and for creating and using // IStructuralComparable objects (Eg, Calling CompareTo(obj o, IComparer comp)) -let mkILLangPrimTy g = mkILNonGenericBoxedTy g.tcref_LanguagePrimitives.CompiledRepresentationForNamedType +let mkILLangPrimTy (g: TcGlobals) = mkILNonGenericBoxedTy g.tcref_LanguagePrimitives.CompiledRepresentationForNamedType -let mkILCallGetComparer g m = +let mkILCallGetComparer (g: TcGlobals) m = let ty = mkILNonGenericBoxedTy g.tcref_System_Collections_IComparer.CompiledRepresentationForNamedType let mspec = mkILNonGenericStaticMethSpecInTy (mkILLangPrimTy g, "get_GenericComparer",[],ty) - mkAsmExpr([IL.mkNormalCall mspec], [], [], [g.mk_IComparer_ty], m) + mkAsmExpr([IL.mkNormalCall mspec], [], [], [g.IComparer_ty], m) -let mkILCallGetEqualityComparer g m = +let mkILCallGetEqualityComparer (g: TcGlobals) m = let ty = mkILNonGenericBoxedTy g.tcref_System_Collections_IEqualityComparer.CompiledRepresentationForNamedType let mspec = mkILNonGenericStaticMethSpecInTy (mkILLangPrimTy g,"get_GenericEqualityComparer",[],ty) - mkAsmExpr([IL.mkNormalCall mspec], [], [], [g.mk_IEqualityComparer_ty], m) + mkAsmExpr([IL.mkNormalCall mspec], [], [], [g.IEqualityComparer_ty], m) let mkThisVar g m ty = mkCompGenLocal m "this" (mkThisTy g ty) let mkShl g m acce n = mkAsmExpr([ IL.AI_shl ],[],[acce; mkInt g m n],[g.int_ty],m) let mkShr g m acce n = mkAsmExpr([ IL.AI_shr ],[],[acce; mkInt g m n],[g.int_ty],m) -let mkAdd g m e1 e2 = mkAsmExpr([ IL.AI_add ],[],[e1;e2],[g.int_ty],m) +let mkAdd (g: TcGlobals) m e1 e2 = mkAsmExpr([ IL.AI_add ],[],[e1;e2],[g.int_ty],m) let mkAddToHashAcc g m e accv acce = mkValSet m accv (mkAdd g m (mkInt g m 0x9e3779b9) @@ -172,7 +167,7 @@ let mkEqualsTestConjuncts g m exprs = let a,b = List.frontAndBack l List.foldBack (fun e acc -> mkCond NoSequencePointAtStickyBinding SuppressSequencePointAtTarget m g.bool_ty e acc (mkFalse g m)) a b -let mkMinimalTy g (tcref:TyconRef) = +let mkMinimalTy (g: TcGlobals) (tcref:TyconRef) = if tcref.Deref.IsExceptionDecl then [], g.exn_ty else generalizeTyconRef tcref @@ -290,7 +285,7 @@ let mkRecdEqualityWithComparer g tcref (tycon:Tycon) (_thisv,thise) thatobje (th expr /// Build the equality implementation for an exception definition -let mkExnEquality g exnref (exnc:Tycon) = +let mkExnEquality (g: TcGlobals) exnref (exnc:Tycon) = let m = exnc.Range let thatv,thate = mkCompGenLocal m "obj" g.exn_ty let thisv,thise = mkThisVar g m g.exn_ty @@ -813,7 +808,7 @@ let CheckAugmentationAttribs isImplementation g amap (tycon:Tycon)= | _ -> () -let TyconIsCandidateForAugmentationWithCompare g (tycon:Tycon) = +let TyconIsCandidateForAugmentationWithCompare (g: TcGlobals) (tycon:Tycon) = // This type gets defined in prim-types, before we can add attributes to F# type definitions let isUnit = g.compilingFslib && tycon.DisplayName = "Unit" not isUnit && @@ -828,7 +823,7 @@ let TyconIsCandidateForAugmentationWithCompare g (tycon:Tycon) = // other cases | _ -> false -let TyconIsCandidateForAugmentationWithEquals g (tycon:Tycon) = +let TyconIsCandidateForAugmentationWithEquals (g: TcGlobals) (tycon:Tycon) = // This type gets defined in prim-types, before we can add attributes to F# type definitions let isUnit = g.compilingFslib && tycon.DisplayName = "Unit" not isUnit && @@ -962,7 +957,7 @@ let MakeBindingsForCompareWithComparerAugmentation g (tycon:Tycon) = let vspec = vref.Deref let _,ty = mkMinimalTy g tcref - let compv,compe = mkCompGenLocal m "comp" g.mk_IComparer_ty + let compv,compe = mkCompGenLocal m "comp" g.IComparer_ty let thisv,thise = mkThisVar g m ty let thatobjv,thatobje = mkCompGenLocal m "obj" g.obj_ty @@ -977,7 +972,7 @@ let MakeBindingsForCompareWithComparerAugmentation g (tycon:Tycon) = elif tycon.IsRecordTycon || tycon.IsStructOrEnumTycon then mkCompare mkRecdCompareWithComparer else [] -let MakeBindingsForEqualityWithComparerAugmentation g (tycon:Tycon) = +let MakeBindingsForEqualityWithComparerAugmentation (g: TcGlobals) (tycon:Tycon) = let tcref = mkLocalTyconRef tycon let m = tycon.Range let tps = tycon.Typars(tycon.Range) @@ -988,7 +983,7 @@ let MakeBindingsForEqualityWithComparerAugmentation g (tycon:Tycon) = // build the hash rhs let withcGetHashCodeExpr = - let compv,compe = mkCompGenLocal m "comp" g.mk_IEqualityComparer_ty + let compv,compe = mkCompGenLocal m "comp" g.IEqualityComparer_ty let thisv,hashe = hashf g tcref tycon compe mkLambdas m tps [thisv;compv] (hashe,g.int_ty) @@ -998,7 +993,7 @@ let MakeBindingsForEqualityWithComparerAugmentation g (tycon:Tycon) = let thisv,thise = mkThisVar g m ty let thatobjv,thatobje = mkCompGenLocal m "obj" g.obj_ty let thatv,thate = mkCompGenLocal m "that" ty - let compv,compe = mkCompGenLocal m "comp" g.mk_IEqualityComparer_ty + let compv,compe = mkCompGenLocal m "comp" g.IEqualityComparer_ty let equalse = equalsf g tcref tycon (thisv,thise) thatobje (thatv,thate) compe mkMultiLambdas m tps [[thisv];[thatobjv;compv]] (equalse,g.bool_ty) @@ -1024,7 +1019,7 @@ let MakeBindingsForEqualityWithComparerAugmentation g (tycon:Tycon) = elif tycon.IsExceptionDecl then mkStructuralEquatable mkExnHashWithComparer mkExnEqualityWithComparer else [] -let MakeBindingsForEqualsAugmentation g (tycon:Tycon) = +let MakeBindingsForEqualsAugmentation (g: TcGlobals) (tycon:Tycon) = let tcref = mkLocalTyconRef tycon let m = tycon.Range let tps = tycon.Typars(m) diff --git a/src/fsharp/CheckFormatStrings.fs b/src/fsharp/CheckFormatStrings.fs index 81bed8dd258..b9d749c4040 100644 --- a/src/fsharp/CheckFormatStrings.fs +++ b/src/fsharp/CheckFormatStrings.fs @@ -28,13 +28,13 @@ let mkFlexibleFormatTypar m tys dflt = tp.FixupConstraints [ TyparConstraint.SimpleChoice (tys,m); TyparConstraint.DefaultsTo (lowestDefaultPriority,dflt,m)] copyAndFixupFormatTypar m tp -let mkFlexibleIntFormatTypar g m = +let mkFlexibleIntFormatTypar (g: TcGlobals) m = mkFlexibleFormatTypar m [ g.byte_ty; g.int16_ty; g.int32_ty; g.int64_ty; g.sbyte_ty; g.uint16_ty; g.uint32_ty; g.uint64_ty;g.nativeint_ty;g.unativeint_ty; ] g.int_ty -let mkFlexibleDecimalFormatTypar g m = +let mkFlexibleDecimalFormatTypar (g: TcGlobals) m = mkFlexibleFormatTypar m [ g.decimal_ty ] g.decimal_ty -let mkFlexibleFloatFormatTypar g m = +let mkFlexibleFloatFormatTypar (g: TcGlobals) m = mkFlexibleFormatTypar m [ g.float_ty; g.float32_ty; g.decimal_ty ] g.float_ty let isDigit c = ('0' <= c && c <= '9') @@ -51,7 +51,7 @@ let newInfo ()= addZeros = false precision = false} -let parseFormatStringInternal (m:range) g (source: string option) fmt bty cty = +let parseFormatStringInternal (m:range) (g: TcGlobals) (source: string option) fmt bty cty = // Offset is used to adjust ranges depending on whether input string is regular, verbatim or triple-quote. // We construct a new 'fmt' string since the current 'fmt' string doesn't distinguish between "\n" and escaped "\\n". let (offset, fmt) = diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index 9258ae26589..8d9bdbb6c8b 100644 --- a/src/fsharp/CompileOps.fs +++ b/src/fsharp/CompileOps.fs @@ -2314,12 +2314,12 @@ type TcConfigBuilder = ri,fileNameOfPath ri,ILResourceAccess.Public -let OpenILBinary(filename,optimizeForMemory,openBinariesInMemory,ilGlobalsOpt, pdbPathOption, noDebugData, shadowCopyReferences) = +let OpenILBinary(filename,optimizeForMemory,openBinariesInMemory,ilGlobalsOpt, pdbPathOption, shadowCopyReferences) = let ilGlobals = // ILScopeRef.Local can be used only for primary assembly (mscorlib or System.Runtime) itself // Remaining assemblies should be opened using existing ilGlobals (so they can properly locate fundamental types) match ilGlobalsOpt with - | None -> mkILGlobals (noDebugData, (fun _ -> ILScopeRef.Local), (fun _ -> Some ILScopeRef.Local)) + | None -> mkILGlobals ILScopeRef.Local | Some g -> g let opts = { ILBinaryReader.mkDefault ilGlobals with @@ -2463,7 +2463,7 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = | Some(primaryAssemblyFilename) -> let filename = ComputeMakePathAbsolute data.implicitIncludeDir primaryAssemblyFilename try - use ilReader = OpenILBinary(filename,data.optimizeForMemory,data.openBinariesInMemory,None,None, data.noDebugData, data.shadowCopyReferences) + use ilReader = OpenILBinary(filename,data.optimizeForMemory,data.openBinariesInMemory,None,None, data.shadowCopyReferences) let ilModule = ilReader.ILModuleDef match ilModule.ManifestOfAssembly.Version with | Some(v1,v2,v3,_) -> @@ -2527,7 +2527,7 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = | Some(fslibFilename) -> let filename = ComputeMakePathAbsolute data.implicitIncludeDir fslibFilename try - use ilReader = OpenILBinary(filename,data.optimizeForMemory,data.openBinariesInMemory,None,None, data.noDebugData, data.shadowCopyReferences) + use ilReader = OpenILBinary(filename,data.optimizeForMemory,data.openBinariesInMemory,None,None, data.shadowCopyReferences) checkFSharpBinaryCompatWithMscorlib filename ilReader.ILAssemblyRefs ilReader.ILModuleDef.ManifestOfAssembly.Version rangeStartup; let fslibRoot = Path.GetDirectoryName(FileSystem.GetFullPathShim(filename)) fslibRoot (* , sprintf "v%d.%d" v1 v2 *) @@ -3790,7 +3790,7 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti None else None - let ilILBinaryReader = OpenILBinary(filename,tcConfig.optimizeForMemory,tcConfig.openBinariesInMemory,ilGlobalsOpt,pdbPathOption, tcConfig.noDebugData, tcConfig.shadowCopyReferences) + let ilILBinaryReader = OpenILBinary(filename,tcConfig.optimizeForMemory,tcConfig.openBinariesInMemory,ilGlobalsOpt,pdbPathOption, tcConfig.shadowCopyReferences) tcImports.AttachDisposeAction(fun _ -> (ilILBinaryReader :> IDisposable).Dispose()) ilILBinaryReader.ILModuleDef, ilILBinaryReader.ILAssemblyRefs with e -> @@ -4022,7 +4022,7 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti member tcImports.SystemRuntimeContainsType (typeName : string) : bool = let ns, typeName = IL.splitILTypeName typeName let tcGlobals = tcImports.GetTcGlobals() - tcGlobals.tryMkSysTyconRef ns typeName |> Option.isSome + tcGlobals.TryMkSysTyconRef ns typeName |> Option.isSome // Add a referenced assembly // @@ -4334,37 +4334,26 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti // Note: TcImports are disposable - the caller owns this object and must dispose let frameworkTcImports = new TcImports(tcConfigP,tcResolutions,None,None) - let sysCcus = - lazy - [| for ccu in frameworkTcImports.GetCcusInDeclOrder() do - printfn "found sys ccu %s" ccu.AssemblyName - yield ccu |] - - let tryGetTypeCcu nsname typeName = - sysCcus.Value |> Array.tryFind (fun ccu -> ccuHasType ccu nsname typeName) - - // Search for a type - let getTypeCcu nsname typeName = - match tryGetTypeCcu nsname typeName with - | None -> CcuThunk.CreateDelayed(FSComp.SR.tcGlobalsSystemTypeNotFound (String.concat "." nsname + "." + typeName)) - | Some ccu -> ccu - - let tryGetTypeILScopeRef fullTypeName = - let nsname, nm = splitILTypeName fullTypeName - match tryGetTypeCcu nsname nm with - | None -> None - | Some ccu -> Some ccu.ILScopeRef - - let getTypeILScopeRef fullTypeName = - let nsname, nm = splitILTypeName fullTypeName - (getTypeCcu nsname nm).ILScopeRef - - let ilGlobals = mkILGlobals(tcConfig.noDebugData,getTypeILScopeRef,tryGetTypeILScopeRef) + let primaryScopeRef = + let primaryAssemblyReference = tcConfig.PrimaryAssemblyDllReference() + let primaryAssemblyResolution = frameworkTcImports.ResolveAssemblyReference(primaryAssemblyReference,ResolveAssemblyReferenceMode.ReportErrors) + match frameworkTcImports.RegisterAndImportReferencedAssemblies(primaryAssemblyResolution) with + | (_, [ResolvedImportedAssembly(ccu)]) -> ccu.FSharpViewOfMetadata.ILScopeRef + | _ -> failwith "unexpected" + + let ilGlobals = mkILGlobals primaryScopeRef frameworkTcImports.SetILGlobals ilGlobals // Load the rest of the framework DLLs all at once (they may be mutually recursive) frameworkTcImports.DoRegisterAndImportReferencedAssemblies (tcResolutions.GetAssemblyResolutions()) + let sysCcus = + [| for ccu in frameworkTcImports.GetCcusInDeclOrder() do + printfn "found sys ccu %s" ccu.AssemblyName + yield ccu |] + + let tryFindSysTypeCcu path typeName = + sysCcus |> Array.tryFind (fun ccu -> ccuHasType ccu path typeName) let fslibCcu = if tcConfig.compilingFslib then @@ -4398,24 +4387,17 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti | ILScopeRef.Local | ILScopeRef.Module _ -> error(InternalError("not ILScopeRef.Assembly",rangeStartup))) fslibCcuInfo.FSharpViewOfMetadata - let using40environment = - match ilGlobals.primaryAssemblyScopeRef.AssemblyRef.Version with - | Some (v1, _v2, _v3, _v4) -> v1 >= 4us - | _ -> true - // OK, now we have both mscorlib.dll and FSharp.Core.dll we can create TcGlobals - let tcGlobals = mkTcGlobals(tcConfig.compilingFslib,ilGlobals,fslibCcu, - tcConfig.implicitIncludeDir,tcConfig.mlCompatibility,using40environment, - tcConfig.isInteractive,getTypeCcu, tryGetTypeCcu, tcConfig.emitDebugInfoInQuotations, (tcConfig.primaryAssembly.Name = "mscorlib") ) + let tcGlobals = TcGlobals(tcConfig.compilingFslib,ilGlobals,fslibCcu, + tcConfig.implicitIncludeDir,tcConfig.mlCompatibility, + tcConfig.isInteractive,tryFindSysTypeCcu, tcConfig.emitDebugInfoInQuotations, (tcConfig.primaryAssembly.Name = "mscorlib"), tcConfig.noDebugData ) #if DEBUG // the global_g reference cell is used only for debug printing global_g := Some tcGlobals #endif // do this prior to parsing, since parsing IL assembly code may refer to mscorlib -#if NO_INLINE_IL_PARSER - // inline IL not permitted by hostable compiler -#else +#if !NO_INLINE_IL_PARSER Microsoft.FSharp.Compiler.AbstractIL.Internal.AsciiConstants.parseILGlobals := tcGlobals.ilg #endif frameworkTcImports.SetTcGlobals(tcGlobals) diff --git a/src/fsharp/CompileOptions.fs b/src/fsharp/CompileOptions.fs index acd52fe96e0..b35ec31d97a 100644 --- a/src/fsharp/CompileOptions.fs +++ b/src/fsharp/CompileOptions.fs @@ -1303,7 +1303,7 @@ let CreateIlxAssemblyGenerator (_tcConfig:TcConfig,tcImports:TcImports,tcGlobals ilxGenerator.AddExternalCcus ccus ilxGenerator -let GenerateIlxCode (ilxBackend, isInteractiveItExpr, isInteractiveOnMono, tcConfig:TcConfig, topAttrs, optimizedImpls, fragName, netFxHasSerializableAttribute, ilxGenerator : IlxAssemblyGenerator) = +let GenerateIlxCode (ilxBackend, isInteractiveItExpr, isInteractiveOnMono, tcConfig:TcConfig, topAttrs, optimizedImpls, fragName, ilxGenerator : IlxAssemblyGenerator) = if !progress then dprintf "Generating ILX code...\n" let ilxGenOpts : IlxGenOptions = { generateFilterBlocks = tcConfig.generateFilterBlocks @@ -1317,7 +1317,6 @@ let GenerateIlxCode (ilxBackend, isInteractiveItExpr, isInteractiveOnMono, tcCon ilxBackend = ilxBackend isInteractive = tcConfig.isInteractive isInteractiveItExpr = isInteractiveItExpr - netFxHasSerializableAttribute = netFxHasSerializableAttribute alwaysCallVirt = tcConfig.alwaysCallVirt } ilxGenerator.GenerateCode (ilxGenOpts, optimizedImpls, topAttrs.assemblyAttrs,topAttrs.netModuleAttrs) diff --git a/src/fsharp/CompileOptions.fsi b/src/fsharp/CompileOptions.fsi index 27ecfa61965..fd59f27a58a 100644 --- a/src/fsharp/CompileOptions.fsi +++ b/src/fsharp/CompileOptions.fsi @@ -84,7 +84,7 @@ val ApplyAllOptimizations : TcConfig * TcGlobals * ConstraintSolver.TcValF * str val CreateIlxAssemblyGenerator : TcConfig * TcImports * TcGlobals * ConstraintSolver.TcValF * CcuThunk -> IlxGen.IlxAssemblyGenerator -val GenerateIlxCode : IlxGen.IlxGenBackend * bool * bool * TcConfig * TypeChecker.TopAttribs * TypedAssemblyAfterOptimization * string * bool * IlxGen.IlxAssemblyGenerator -> IlxGen.IlxGenResults +val GenerateIlxCode : IlxGen.IlxGenBackend * isInteractiveItExpr:bool * isInteractiveOnMono:bool * TcConfig * TypeChecker.TopAttribs * TypedAssemblyAfterOptimization * fragName:string * IlxGen.IlxAssemblyGenerator -> IlxGen.IlxGenResults // Used during static linking val NormalizeAssemblyRefs : TcImports -> (AbstractIL.IL.ILScopeRef -> AbstractIL.IL.ILScopeRef) diff --git a/src/fsharp/DetupleArgs.fs b/src/fsharp/DetupleArgs.fs index f293e455346..bc89828eebf 100644 --- a/src/fsharp/DetupleArgs.fs +++ b/src/fsharp/DetupleArgs.fs @@ -261,7 +261,7 @@ module GlobalUsageAnalysis = // - for body // - match targets // - tmethods - let UsageFolders g = + let UsageFolders (g: TcGlobals) = let foldLocalVal f z (vref: ValRef) = if valRefInThisAssembly g.compilingFslib vref then f z vref.Deref else z diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index ef794717286..7d6700cdc46 100644 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -20,6 +20,7 @@ open Microsoft.FSharp.Compiler.AbstractIL.Diagnostics open Microsoft.FSharp.Compiler.AbstractIL.Internal.BinaryConstants open Microsoft.FSharp.Compiler +open Microsoft.FSharp.Compiler.Import open Microsoft.FSharp.Compiler.Tast open Microsoft.FSharp.Compiler.Tastops open Microsoft.FSharp.Compiler.Tastops.DebugPrint @@ -41,7 +42,7 @@ let DropErasedTypars (tps:Typar list) = tps |> List.filter IsNonErasedTypar let DropErasedTyargs tys = tys |> List.filter (fun ty -> match ty with TType_measure _ -> false | _ -> true) let AddSpecialNameFlag (mdef:ILMethodDef) = { mdef with IsSpecialName = true } -let AddNonUserCompilerGeneratedAttribs g (mdef:ILMethodDef) = addMethodGeneratedAttrs g.ilg mdef +let AddNonUserCompilerGeneratedAttribs (g: TcGlobals) (mdef:ILMethodDef) = g.AddMethodGeneratedAttributes mdef let debugDisplayMethodName = "__DebugDisplay" @@ -184,9 +185,6 @@ type IlxGenOptions = /// storage, even though 'it' is not logically mutable isInteractiveItExpr: bool - /// Indicates System.SerializableAttribute is available in the target framework - netFxHasSerializableAttribute : bool - /// Whenever possible, use callvirt instead of call alwaysCallVirt: bool } @@ -200,7 +198,7 @@ type cenv = opts: IlxGenOptions /// Cache the generation of the "unit" type mutable ilUnitTy: ILType option - amap: Import.ImportMap + amap: ImportMap intraAssemblyInfo : IlxGenIntraAssemblyInfo /// Cache methods with SecurityAttribute applied to them, to prevent unnecessary calls to ExistsInEntireHierarchyOfType casApplied : Dictionary @@ -210,7 +208,7 @@ type cenv = let mkTypeOfExpr cenv m ilty = - mkAsmExpr ([ mkNormalCall (mspec_Type_GetTypeFromHandle cenv.g.ilg) ], [], + mkAsmExpr ([ mkNormalCall (mspec_Type_GetTypeFromHandle cenv.g) ], [], [mkAsmExpr ([ I_ldtoken (ILToken.ILType ilty) ], [],[],[cenv.g.system_RuntimeTypeHandle_typ],m)], [cenv.g.system_Type_typ],m) @@ -389,60 +387,62 @@ type PtrsOK = | PtrTypesOK | PtrTypesNotOK -let rec GenTypeArgAux amap m g tyenv tyarg = - GenTypeAux amap m g tyenv VoidNotOK PtrTypesNotOK tyarg +let rec GenTypeArgAux amap m tyenv tyarg = + GenTypeAux amap m tyenv VoidNotOK PtrTypesNotOK tyarg -and GenTypeArgsAux amap m g tyenv tyargs = - List.map (GenTypeArgAux amap m g tyenv) (DropErasedTyargs tyargs) +and GenTypeArgsAux amap m tyenv tyargs = + List.map (GenTypeArgAux amap m tyenv) (DropErasedTyargs tyargs) -and GenTyAppAux amap m g tyenv repr tinst = +and GenTyAppAux amap m tyenv repr tinst = match repr with | CompiledTypeRepr.ILAsmOpen ty -> - let ilTypeInst = GenTypeArgsAux amap m g tyenv tinst + let ilTypeInst = GenTypeArgsAux amap m tyenv tinst let ty = IL.instILType ilTypeInst ty ty | CompiledTypeRepr.ILAsmNamed (tref, boxity, ilTypeOpt) -> match ilTypeOpt with | None -> - let ilTypeInst = GenTypeArgsAux amap m g tyenv tinst + let ilTypeInst = GenTypeArgsAux amap m tyenv tinst mkILTy boxity (mkILTySpec (tref,ilTypeInst)) | Some ilType -> ilType // monomorphic types include a cached ilType to avoid reallocation of an ILType node -and GenNamedTyAppAux (amap:Import.ImportMap) m g tyenv ptrsOK tcref tinst = +and GenNamedTyAppAux (amap:ImportMap) m tyenv ptrsOK tcref tinst = + let g = amap.g let tinst = DropErasedTyargs tinst // See above note on ptrsOK if ptrsOK = PtrTypesOK && tyconRefEq g tcref g.nativeptr_tcr && (freeInTypes CollectTypars tinst).FreeTypars.IsEmpty then - GenNamedTyAppAux amap m g tyenv ptrsOK g.ilsigptr_tcr tinst + GenNamedTyAppAux amap m tyenv ptrsOK g.ilsigptr_tcr tinst else #if EXTENSIONTYPING match tcref.TypeReprInfo with // Generate the base type, because that is always the representation of the erased type, unless the assembly is being injected | TProvidedTypeExtensionPoint info when info.IsErased -> - GenTypeAux amap m g tyenv VoidNotOK ptrsOK (info.BaseTypeForErased (m,g.obj_ty)) + GenTypeAux amap m tyenv VoidNotOK ptrsOK (info.BaseTypeForErased (m,g.obj_ty)) | _ -> #endif - GenTyAppAux amap m g tyenv (GenTyconRef tcref) tinst + GenTyAppAux amap m tyenv (GenTyconRef tcref) tinst -and GenTypeAux amap m g (tyenv: TypeReprEnv) voidOK ptrsOK ty = +and GenTypeAux amap m (tyenv: TypeReprEnv) voidOK ptrsOK ty = + let g = amap.g #if DEBUG voidCheck m g voidOK ty #else ignore voidOK #endif match stripTyEqnsAndMeasureEqns g ty with - | TType_app (tcref, tinst) -> GenNamedTyAppAux amap m g tyenv ptrsOK tcref tinst - | TType_tuple (tupInfo, args) -> GenTypeAux amap m g tyenv VoidNotOK ptrsOK (mkCompiledTupleTy g (evalTupInfoIsStruct tupInfo) args) - | TType_fun (dty, returnTy) -> EraseClosures.mkILFuncTy g.ilxPubCloEnv (GenTypeArgAux amap m g tyenv dty) (GenTypeArgAux amap m g tyenv returnTy) + | TType_app (tcref, tinst) -> GenNamedTyAppAux amap m tyenv ptrsOK tcref tinst + | TType_tuple (tupInfo, args) -> GenTypeAux amap m tyenv VoidNotOK ptrsOK (mkCompiledTupleTy g (evalTupInfoIsStruct tupInfo) args) + | TType_fun (dty, returnTy) -> EraseClosures.mkILFuncTy g.ilxPubCloEnv (GenTypeArgAux amap m tyenv dty) (GenTypeArgAux amap m tyenv returnTy) | TType_ucase (ucref, args) -> - let cuspec,idx = GenUnionCaseSpec amap m g tyenv ucref args + let cuspec,idx = GenUnionCaseSpec amap m tyenv ucref args EraseUnions.GetILTypeForAlternative cuspec idx | TType_forall (tps, tau) -> let tps = DropErasedTypars tps - if tps.IsEmpty then GenTypeAux amap m g tyenv VoidNotOK ptrsOK tau + if tps.IsEmpty then GenTypeAux amap m tyenv VoidNotOK ptrsOK tau else EraseClosures.mkILTyFuncTy g.ilxPubCloEnv | TType_var tp -> mkILTyvarTy tyenv.[tp,m] | TType_measure _ -> g.ilg.typ_Int32 @@ -451,16 +451,18 @@ and GenTypeAux amap m g (tyenv: TypeReprEnv) voidOK ptrsOK ty = // Generate ILX references to closures, classunions etc. given a tyenv //-------------------------------------------------------------------------- -and GenUnionCaseRef amap m g tyenv i (fspecs:RecdField array) = +and GenUnionCaseRef (amap: ImportMap) m tyenv i (fspecs:RecdField array) = + let g = amap.g fspecs |> Array.mapi (fun j fspec -> - let ilFieldDef = IL.mkILInstanceField(fspec.Name,GenType amap m g tyenv fspec.FormalType, None, ILMemberAccess.Public) + let ilFieldDef = IL.mkILInstanceField(fspec.Name,GenType amap m tyenv fspec.FormalType, None, ILMemberAccess.Public) IlxUnionField { ilFieldDef with // These properties on the "field" of an alternative end up going on a property generated by cu_erase.fs CustomAttrs = mkILCustomAttrs [(mkCompilationMappingAttrWithVariantNumAndSeqNum g (int SourceConstructFlags.Field) i j )] } ) -and GenUnionRef amap m g (tcref: TyconRef) = +and GenUnionRef (amap: ImportMap) m (tcref: TyconRef) = + let g = amap.g let tycon = tcref.Deref assert(not tycon.IsTypeAbbrev) match tycon.UnionTypeInfo with @@ -475,7 +477,7 @@ and GenUnionRef amap m g (tcref: TyconRef) = tycon.UnionCasesArray |> Array.mapi (fun i cspec -> { altName=cspec.CompiledName altCustomAttrs=emptyILCustomAttrs - altFields=GenUnionCaseRef amap m g tyenvinner i cspec.RecdFieldsArray }) + altFields=GenUnionCaseRef amap m tyenvinner i cspec.RecdFieldsArray }) let nullPermitted = IsUnionTypeWithNullAsTrueValue g tycon let hasHelpers = ComputeUnionHasHelpers g tcref let boxity = (if tcref.IsStructOrEnumTycon then ILBoxity.AsValue else ILBoxity.AsObject) @@ -495,39 +497,39 @@ and ComputeUnionHasHelpers g (tcref : TyconRef) = | _ -> AllHelpers (* not hiddenRepr *) -and GenUnionSpec amap m g tyenv tcref tyargs = - let curef = GenUnionRef amap m g tcref - let tinst = GenTypeArgs amap m g tyenv tyargs +and GenUnionSpec amap m tyenv tcref tyargs = + let curef = GenUnionRef amap m tcref + let tinst = GenTypeArgs amap m tyenv tyargs IlxUnionSpec(curef,tinst) -and GenUnionCaseSpec amap m g tyenv (ucref:UnionCaseRef) tyargs = - let cuspec = GenUnionSpec amap m g tyenv ucref.TyconRef tyargs +and GenUnionCaseSpec amap m tyenv (ucref:UnionCaseRef) tyargs = + let cuspec = GenUnionSpec amap m tyenv ucref.TyconRef tyargs cuspec, ucref.Index -and GenType amap m g tyenv ty = - GenTypeAux amap m g tyenv VoidNotOK PtrTypesNotOK ty +and GenType amap m tyenv ty = + GenTypeAux amap m tyenv VoidNotOK PtrTypesNotOK ty -and GenTypes amap m g tyenv tys = List.map (GenType amap m g tyenv) tys -and GenTypePermitVoid amap m g tyenv ty = (GenTypeAux amap m g tyenv VoidOK PtrTypesNotOK ty) -and GenTypesPermitVoid amap m g tyenv tys = List.map (GenTypePermitVoid amap m g tyenv) tys +and GenTypes amap m tyenv tys = List.map (GenType amap m tyenv) tys +and GenTypePermitVoid amap m tyenv ty = (GenTypeAux amap m tyenv VoidOK PtrTypesNotOK ty) +and GenTypesPermitVoid amap m tyenv tys = List.map (GenTypePermitVoid amap m tyenv) tys -and GenTyApp amap m g tyenv repr tyargs = GenTyAppAux amap m g tyenv repr tyargs -and GenNamedTyApp amap m g tyenv tcref tinst = GenNamedTyAppAux amap m g tyenv PtrTypesNotOK tcref tinst +and GenTyApp amap m tyenv repr tyargs = GenTyAppAux amap m tyenv repr tyargs +and GenNamedTyApp amap m tyenv tcref tinst = GenNamedTyAppAux amap m tyenv PtrTypesNotOK tcref tinst /// IL void types are only generated for return types -and GenReturnType amap m g tyenv returnTyOpt = +and GenReturnType amap m tyenv returnTyOpt = match returnTyOpt with | None -> ILType.Void - | Some returnTy -> GenTypeAux amap m g tyenv VoidNotOK(*1*) PtrTypesOK returnTy (*1: generate void from unit, but not accept void *) + | Some returnTy -> GenTypeAux amap m tyenv VoidNotOK(*1*) PtrTypesOK returnTy (*1: generate void from unit, but not accept void *) -and GenParamType amap m g tyenv ty = - ty |> GenTypeAux amap m g tyenv VoidNotOK PtrTypesOK +and GenParamType amap m tyenv ty = + ty |> GenTypeAux amap m tyenv VoidNotOK PtrTypesOK -and GenParamTypes amap m g tyenv tys = - tys |> List.map (GenTypeAux amap m g tyenv VoidNotOK PtrTypesOK) +and GenParamTypes amap m tyenv tys = + tys |> List.map (GenTypeAux amap m tyenv VoidNotOK PtrTypesOK) -and GenTypeArgs amap m g tyenv tyargs = GenTypeArgsAux amap m g tyenv tyargs +and GenTypeArgs amap m tyenv tyargs = GenTypeArgsAux amap m tyenv tyargs let GenericParamHasConstraint (gp: ILGenericParameterDef) = gp.Constraints.Length <> 0 || @@ -562,11 +564,11 @@ let GenFieldSpecForStaticField (isInteractive, g, ilContainerTy, vspec:Val, nm, let GenRecdFieldRef m cenv tyenv (rfref:RecdFieldRef) tyargs = let tyenvinner = TypeReprEnv.ForTycon rfref.Tycon - mkILFieldSpecInTy(GenTyApp cenv.amap m cenv.g tyenv rfref.TyconRef.CompiledRepresentation tyargs, + mkILFieldSpecInTy(GenTyApp cenv.amap m tyenv rfref.TyconRef.CompiledRepresentation tyargs, ComputeFieldName rfref.Tycon rfref.RecdField, - GenType cenv.amap m cenv.g tyenvinner rfref.RecdField.FormalType) + GenType cenv.amap m tyenvinner rfref.RecdField.FormalType) -let GenExnType amap m g tyenv (ecref:TyconRef) = GenTyApp amap m g tyenv ecref.CompiledRepresentation [] +let GenExnType amap m tyenv (ecref:TyconRef) = GenTyApp amap m tyenv ecref.CompiledRepresentation [] //-------------------------------------------------------------------------- @@ -713,7 +715,7 @@ let OutputStorage (pps: TextWriter) s = // Augment eenv with values //-------------------------------------------------------------------------- -let AddStorageForVal g (v,s) eenv = +let AddStorageForVal (g: TcGlobals) (v,s) eenv = let eenv = { eenv with valsInScope = eenv.valsInScope.Add v s } // If we're compiling fslib then also bind the value as a non-local path to // allow us to resolve the compiler-non-local-references that arise from env.fs @@ -788,9 +790,9 @@ let GetMethodSpecForMemberVal amap g (memberInfo:ValMemberInfo) (vref:ValRef) = let isCompiledAsInstance = ValRefIsCompiledAsInstanceMember g vref let ilActualRetTy = - let ilRetTy = GenReturnType amap m g tyenvUnderTypars returnTy + let ilRetTy = GenReturnType amap m tyenvUnderTypars returnTy if isCtor || cctor then ILType.Void else ilRetTy - let ilTy = GenType amap m g tyenvUnderTypars (mkAppTy parentTcref (List.map mkTyparTy ctps)) + let ilTy = GenType amap m tyenvUnderTypars (mkAppTy parentTcref (List.map mkTyparTy ctps)) if isCompiledAsInstance || isCtor then // Find the 'this' argument type if any let thisTy,flatArgInfos = @@ -812,15 +814,15 @@ let GetMethodSpecForMemberVal amap g (memberInfo:ValMemberInfo) (vref:ValRef) = ctps thisArgTys let methodArgTys,paramInfos = List.unzip flatArgInfos - let ilMethodArgTys = GenParamTypes amap m g tyenvUnderTypars methodArgTys - let ilMethodInst = GenTypeArgs amap m g tyenvUnderTypars (List.map mkTyparTy mtps) + let ilMethodArgTys = GenParamTypes amap m tyenvUnderTypars methodArgTys + let ilMethodInst = GenTypeArgs amap m tyenvUnderTypars (List.map mkTyparTy mtps) let mspec = mkILInstanceMethSpecInTy (ilTy,vref.CompiledName,ilMethodArgTys,ilActualRetTy,ilMethodInst) mspec,ctps,mtps,paramInfos,retInfo else let methodArgTys,paramInfos = List.unzip flatArgInfos - let ilMethodArgTys = GenParamTypes amap m g tyenvUnderTypars methodArgTys - let ilMethodInst = GenTypeArgs amap m g tyenvUnderTypars (List.map mkTyparTy mtps) + let ilMethodArgTys = GenParamTypes amap m tyenvUnderTypars methodArgTys + let ilMethodInst = GenTypeArgs amap m tyenvUnderTypars (List.map mkTyparTy mtps) let mspec = mkILStaticMethSpecInTy (ilTy,vref.CompiledName,ilMethodArgTys,ilActualRetTy,ilMethodInst) mspec,ctps,mtps,paramInfos,retInfo @@ -877,7 +879,7 @@ let ComputeStorageForTopVal (amap, g, optIntraAssemblyInfo:IlxGenIntraAssemblyIn if vref.Deref.IsCompiledAsStaticPropertyWithoutField then let nm = "get_"+nm let tyenvUnderTypars = TypeReprEnv.ForTypars [] - let ilRetTy = GenType amap m g tyenvUnderTypars vref.Type + let ilRetTy = GenType amap m tyenvUnderTypars vref.Type let typ = mkILTyForCompLoc cloc let mspec = mkILStaticMethSpecInTy (typ, nm, [], ilRetTy, []) @@ -893,7 +895,7 @@ let ComputeStorageForTopVal (amap, g, optIntraAssemblyInfo:IlxGenIntraAssemblyIn // Mutable and literal static fields must have stable names and live in the "public" location // See notes on GenFieldSpecForStaticField above. let vspec = vref.Deref - let ilTy = GenType amap m g TypeReprEnv.Empty returnTy (* TypeReprEnv.Empty ok: not a field in a generic class *) + let ilTy = GenType amap m TypeReprEnv.Empty returnTy (* TypeReprEnv.Empty ok: not a field in a generic class *) let ilTyForProperty = mkILTyForCompLoc cloc let attribs = vspec.Attribs let hasLiteralAttr = HasFSharpAttribute g g.attrib_LiteralAttribute attribs @@ -915,10 +917,10 @@ let ComputeStorageForTopVal (amap, g, optIntraAssemblyInfo:IlxGenIntraAssemblyIn let (tps, curriedArgInfos, returnTy, retInfo) = GetTopValTypeInCompiledForm g topValInfo vref.Type m let tyenvUnderTypars = TypeReprEnv.ForTypars tps let (methodArgTys,paramInfos) = curriedArgInfos |> List.concat |> List.unzip - let ilMethodArgTys = GenParamTypes amap m g tyenvUnderTypars methodArgTys - let ilRetTy = GenReturnType amap m g tyenvUnderTypars returnTy + let ilMethodArgTys = GenParamTypes amap m tyenvUnderTypars methodArgTys + let ilRetTy = GenReturnType amap m tyenvUnderTypars returnTy let ilLocTy = mkILTyForCompLoc cloc - let ilMethodInst = GenTypeArgs amap m g tyenvUnderTypars (List.map mkTyparTy tps) + let ilMethodInst = GenTypeArgs amap m tyenvUnderTypars (List.map mkTyparTy tps) let mspec = mkILStaticMethSpecInTy (ilLocTy, nm, ilMethodArgTys, ilRetTy, ilMethodInst) Method (topValInfo, vref, mspec, m, paramInfos, retInfo) @@ -1010,7 +1012,7 @@ and AddBindingsForModuleTopVals _g allocVal _cloc eenv vs = // into the stored results for the whole CCU. // isIncrementalFragment = true --> "typed input" // isIncrementalFragment = false --> "#load" -let AddIncrementalLocalAssemblyFragmentToIlxGenEnv (amap:Import.ImportMap, isIncrementalFragment, g, ccu, fragName, intraAssemblyInfo, eenv, typedImplFiles) = +let AddIncrementalLocalAssemblyFragmentToIlxGenEnv (amap:ImportMap, isIncrementalFragment, g, ccu, fragName, intraAssemblyInfo, eenv, typedImplFiles) = let cloc = CompLocForFragment fragName ccu let allocVal = ComputeAndAddStorageForLocalTopVal (amap, g, intraAssemblyInfo, true, NoShadowLocal) (eenv, typedImplFiles) ||> List.fold (fun eenv (TImplFile(qname,_,mexpr,_,_)) -> @@ -1026,7 +1028,7 @@ let AddIncrementalLocalAssemblyFragmentToIlxGenEnv (amap:Import.ImportMap, isInc // Generate debugging marks //-------------------------------------------------------------------------- -let GenILSourceMarker g (m:range) = +let GenILSourceMarker (g: TcGlobals) (m:range) = Some (ILSourceMarker.Create(document=g.memoize_file m.FileIndex, line=m.StartLine, /// NOTE: .NET && VS measure first column as column 1 @@ -1177,7 +1179,7 @@ type AssemblyBuilder(cenv:cenv) as mgbuf = new MemoizationTable<(CompileLocation * int) , ILTypeSpec> ((fun (cloc,size) -> let name = CompilerGeneratedName ("T" + string(newUnique()) + "_" + string size + "Bytes") // Type names ending ...$T_37Bytes - let vtdef = mkRawDataValueTypeDef cenv.g.ilg (name,size,0us) + let vtdef = mkRawDataValueTypeDef cenv.g.iltyp_ValueType (name,size,0us) let vtref = NestedTypeRefForCompLoc cloc vtdef.Name let vtspec = mkILTySpec(vtref,[]) let vtdef = {vtdef with Access= ComputeTypeAccess vtref true} @@ -1510,13 +1512,13 @@ let GenConstArray cenv (cgbuf:CodeGenBuffer) eenv ilElementType (data:'a[]) (wri let ilFieldName = CompilerGeneratedName ("field" + string(newUnique())) let fty = ILType.Value vtspec let ilFieldDef = mkILStaticField (ilFieldName,fty, None, Some bytes, ILMemberAccess.Assembly) - let ilFieldDef = { ilFieldDef with CustomAttrs = mkILCustomAttrs [ cenv.g.ilg.mkDebuggerBrowsableNeverAttribute() ] } + let ilFieldDef = { ilFieldDef with CustomAttrs = mkILCustomAttrs [ cenv.g.DebuggerBrowsableNeverAttribute ] } let fspec = mkILFieldSpecInTy (mkILTyForCompLoc eenv.cloc,ilFieldName, fty) CountStaticFieldDef() cgbuf.mgbuf.AddFieldDef(fspec.EnclosingTypeRef,ilFieldDef) CG.EmitInstrs cgbuf (pop 0) - (Push [ ilArrayType; ilArrayType; cenv.g.ilg.typ_RuntimeFieldHandle ]) + (Push [ ilArrayType; ilArrayType; cenv.g.iltyp_RuntimeFieldHandle ]) [ mkLdcInt32 data.Length I_newarr (ILArrayShape.SingleDimensional,ilElementType) AI_dup @@ -1524,7 +1526,7 @@ let GenConstArray cenv (cgbuf:CodeGenBuffer) eenv ilElementType (data:'a[]) (wri CG.EmitInstrs cgbuf (pop 2) Push0 - [ mkNormalCall (mkInitializeArrayMethSpec cenv.g.ilg) ] + [ mkNormalCall (mkInitializeArrayMethSpec cenv.g) ] //-------------------------------------------------------------------------- @@ -2019,7 +2021,7 @@ and GenSequel cenv cloc cgbuf sequel = //-------------------------------------------------------------------------- and GenConstant cenv cgbuf eenv (c,m,ty) sequel = - let ilTy = GenType cenv.amap m cenv.g eenv.tyenv ty + let ilTy = GenType cenv.amap m eenv.tyenv ty // Check if we need to generate the value at all match sequelAfterDiscard sequel with | None -> @@ -2054,7 +2056,7 @@ and GenConstant cenv cgbuf eenv (c,m,ty) sequel = and GenUnitTy cenv eenv m = match cenv.ilUnitTy with | None -> - let res = GenType cenv.amap m cenv.g eenv.tyenv cenv.g.unit_ty + let res = GenType cenv.amap m eenv.tyenv cenv.g.unit_ty cenv.ilUnitTy <- Some res res | Some res -> res @@ -2076,7 +2078,7 @@ and GenAllocTuple cenv cgbuf eenv (tupInfo, args,argtys,m) sequel = let tupInfo = evalTupInfoIsStruct tupInfo let tcref, tys, args, newm = mkCompiledTuple cenv.g tupInfo (argtys,args,m) - let typ = GenNamedTyApp cenv.amap newm cenv.g eenv.tyenv tcref tys + let typ = GenNamedTyApp cenv.amap newm eenv.tyenv tcref tys let ntyvars = if (tys.Length - 1) < goodTupleFields then (tys.Length - 1) else goodTupleFields let formalTyvars = [ for n in 0 .. ntyvars do yield mkILTyvarTy (uint16 n) ] @@ -2094,7 +2096,7 @@ and GenGetTupleField cenv cgbuf eenv (tupInfo,e,tys,n,m) sequel = if ar <= 0 then failwith "getCompiledTupleItem" elif ar < maxTuple then let tcr' = mkCompiledTupleTyconRef g tupInfo tys - let typ = GenNamedTyApp cenv.amap m g eenv.tyenv tcr' tys + let typ = GenNamedTyApp cenv.amap m eenv.tyenv tcr' tys mkGetTupleItemN g m n typ tupInfo e tys.[n] else @@ -2102,7 +2104,7 @@ and GenGetTupleField cenv cgbuf eenv (tupInfo,e,tys,n,m) sequel = let tyB = mkCompiledTupleTy g tupInfo tysB let tys' = tysA@[tyB] let tcr' = mkCompiledTupleTyconRef g tupInfo tys' - let typ' = GenNamedTyApp cenv.amap m g eenv.tyenv tcr' tys' + let typ' = GenNamedTyApp cenv.amap m eenv.tyenv tcr' tys' let n' = (min n goodTupleFields) let elast = mkGetTupleItemN g m n' typ' tupInfo e tys'.[n'] if n < goodTupleFields then @@ -2113,9 +2115,9 @@ and GenGetTupleField cenv cgbuf eenv (tupInfo,e,tys,n,m) sequel = and GenAllocExn cenv cgbuf eenv (c,args,m) sequel = GenExprs cenv cgbuf eenv args - let typ = GenExnType cenv.amap m cenv.g eenv.tyenv c + let typ = GenExnType cenv.amap m eenv.tyenv c let flds = recdFieldsOfExnDefRef c - let argtys = flds |> List.map (fun rfld -> GenType cenv.amap m cenv.g eenv.tyenv rfld.FormalType) + let argtys = flds |> List.map (fun rfld -> GenType cenv.amap m eenv.tyenv rfld.FormalType) let mspec = mkILCtorMethSpecForTy (typ, argtys) CG.EmitInstr cgbuf (pop args.Length) (Push [typ]) @@ -2124,12 +2126,12 @@ and GenAllocExn cenv cgbuf eenv (c,args,m) sequel = and GenAllocUnionCase cenv cgbuf eenv (c,tyargs,args,m) sequel = GenExprs cenv cgbuf eenv args - let cuspec,idx = GenUnionCaseSpec cenv.amap m cenv.g eenv.tyenv c tyargs + let cuspec,idx = GenUnionCaseSpec cenv.amap m eenv.tyenv c tyargs CG.EmitInstrs cgbuf (pop args.Length) (Push [cuspec.EnclosingType]) (EraseUnions.mkNewData cenv.g.ilg (cuspec, idx)) GenSequel cenv eenv.cloc cgbuf sequel and GenAllocRecd cenv cgbuf eenv ctorInfo (tcref,argtys,args,m) sequel = - let typ = GenNamedTyApp cenv.amap m cenv.g eenv.tyenv tcref argtys + let typ = GenNamedTyApp cenv.amap m eenv.tyenv tcref argtys // Filter out fields with default initialization let relevantFields = @@ -2152,12 +2154,12 @@ and GenAllocRecd cenv cgbuf eenv ctorInfo (tcref,argtys,args,m) sequel = let tyenvinner = TypeReprEnv.ForTyconRef tcref CG.EmitInstr cgbuf (pop args.Length) (Push [typ]) (mkNormalNewobj - (mkILCtorMethSpecForTy (typ,relevantFields |> List.map (fun f -> GenType cenv.amap m cenv.g tyenvinner f.FormalType) ))) + (mkILCtorMethSpecForTy (typ,relevantFields |> List.map (fun f -> GenType cenv.amap m tyenvinner f.FormalType) ))) GenSequel cenv eenv.cloc cgbuf sequel and GenNewArraySimple cenv cgbuf eenv (elems,elemTy,m) sequel = - let ilElemTy = GenType cenv.amap m cenv.g eenv.tyenv elemTy + let ilElemTy = GenType cenv.amap m eenv.tyenv elemTy let ilArrTy = mkILArr1DTy ilElemTy CG.EmitInstrs cgbuf (pop 0) (Push [ilArrTy]) [ (AI_ldc (DT_I4,ILConst.I4 (elems.Length))); I_newarr (ILArrayShape.SingleDimensional,ilElemTy) ] @@ -2194,7 +2196,7 @@ and GenNewArray cenv cgbuf eenv (elems: Expr list,elemTy,m) sequel = | _ -> (function _ -> false), (fun _ _ -> failwith "unreachable") if elems' |> Array.forall (function Expr.Const(c,_,_) -> test c | _ -> false) then - let ilElemTy = GenType cenv.amap m cenv.g eenv.tyenv elemTy + let ilElemTy = GenType cenv.amap m eenv.tyenv elemTy GenConstArray cenv cgbuf eenv ilElemTy elems' (fun buf -> function Expr.Const(c,_,_) -> write buf c | _ -> failwith "unreachable") GenSequel cenv eenv.cloc cgbuf sequel @@ -2211,7 +2213,7 @@ and GenCoerce cenv cgbuf eenv (e,tgty,m,srcty) sequel = // Hence be conservative here and always cast explicitly. if (isInterfaceTy cenv.g tgty) then ( GenExpr cenv cgbuf eenv SPSuppress e Continue - let ilToTy = GenType cenv.amap m cenv.g eenv.tyenv tgty + let ilToTy = GenType cenv.amap m eenv.tyenv tgty CG.EmitInstrs cgbuf (pop 1) (Push [ilToTy]) [ I_unbox_any ilToTy ] GenSequel cenv eenv.cloc cgbuf sequel ) else ( @@ -2221,15 +2223,15 @@ and GenCoerce cenv cgbuf eenv (e,tgty,m,srcty) sequel = else GenExpr cenv cgbuf eenv SPSuppress e Continue if not (isObjTy cenv.g srcty) then - let ilFromTy = GenType cenv.amap m cenv.g eenv.tyenv srcty + let ilFromTy = GenType cenv.amap m eenv.tyenv srcty CG.EmitInstrs cgbuf (pop 1) (Push [cenv.g.ilg.typ_Object]) [ I_box ilFromTy ] if not (isObjTy cenv.g tgty) then - let ilToTy = GenType cenv.amap m cenv.g eenv.tyenv tgty + let ilToTy = GenType cenv.amap m eenv.tyenv tgty CG.EmitInstrs cgbuf (pop 1) (Push [ilToTy]) [ I_unbox_any ilToTy ] GenSequel cenv eenv.cloc cgbuf sequel and GenReraise cenv cgbuf eenv (rtnty,m) sequel = - let ilReturnTy = GenType cenv.amap m cenv.g eenv.tyenv rtnty + let ilReturnTy = GenType cenv.amap m eenv.tyenv rtnty CG.EmitInstrs cgbuf (pop 0) Push0 [I_rethrow] // [See comment related to I_throw]. // Rethrow does not return. Required to push dummy value on the stack. @@ -2240,11 +2242,11 @@ and GenReraise cenv cgbuf eenv (rtnty,m) sequel = and GenGetExnField cenv cgbuf eenv (e,ecref,fieldNum,m) sequel = GenExpr cenv cgbuf eenv SPSuppress e Continue let exnc = stripExnEqns ecref - let typ = GenExnType cenv.amap m cenv.g eenv.tyenv ecref + let typ = GenExnType cenv.amap m eenv.tyenv ecref CG.EmitInstrs cgbuf (pop 0) Push0 [ I_castclass typ] let fld = List.item fieldNum exnc.TrueInstanceFieldsAsList - let ftyp = GenType cenv.amap m cenv.g eenv.tyenv fld.FormalType + let ftyp = GenType cenv.amap m eenv.tyenv fld.FormalType let mspec = mkILNonGenericInstanceMethSpecInTy (typ,"get_" + fld.Name, [], ftyp) CG.EmitInstr cgbuf (pop 1) (Push [ftyp]) (mkNormalCall mspec) @@ -2254,10 +2256,10 @@ and GenGetExnField cenv cgbuf eenv (e,ecref,fieldNum,m) sequel = and GenSetExnField cenv cgbuf eenv (e,ecref,fieldNum,e2,m) sequel = GenExpr cenv cgbuf eenv SPSuppress e Continue let exnc = stripExnEqns ecref - let typ = GenExnType cenv.amap m cenv.g eenv.tyenv ecref + let typ = GenExnType cenv.amap m eenv.tyenv ecref CG.EmitInstrs cgbuf (pop 0) Push0 [ I_castclass typ ] let fld = List.item fieldNum exnc.TrueInstanceFieldsAsList - let ftyp = GenType cenv.amap m cenv.g eenv.tyenv fld.FormalType + let ftyp = GenType cenv.amap m eenv.tyenv fld.FormalType let ilFieldName = ComputeFieldName exnc fld GenExpr cenv cgbuf eenv SPSuppress e2 Continue CG.EmitInstr cgbuf (pop 2) Push0 (mkNormalStfld(mkILFieldSpecInTy (typ,ilFieldName,ftyp))) @@ -2269,12 +2271,13 @@ and UnionCodeGen (cgbuf: CodeGenBuffer) = member __.GenerateDelayMark() = CG.GenerateDelayMark cgbuf "unionCodeGenMark" member __.GenLocal(ilty) = cgbuf.AllocLocal([],ilty,false) |> uint16 member __.SetMarkToHere(m) = CG.SetMarkToHere cgbuf m + member __.MkInvalidCastExnNewobj () = mkInvalidCastExnNewobj cgbuf.mgbuf.cenv.g member __.EmitInstr x = CG.EmitInstr cgbuf (pop 0) (Push []) x member __.EmitInstrs xs = CG.EmitInstrs cgbuf (pop 0) (Push []) xs } and GenUnionCaseProof cenv cgbuf eenv (e,ucref,tyargs,m) sequel = GenExpr cenv cgbuf eenv SPSuppress e Continue - let cuspec,idx = GenUnionCaseSpec cenv.amap m cenv.g eenv.tyenv ucref tyargs + let cuspec,idx = GenUnionCaseSpec cenv.amap m eenv.tyenv ucref tyargs let fty = EraseUnions.GetILTypeForAlternative cuspec idx let avoidHelpers = entityRefInThisAssembly cenv.g.compilingFslib ucref.TyconRef EraseUnions.emitCastData cenv.g.ilg (UnionCodeGen cgbuf) (false,avoidHelpers,cuspec,idx) @@ -2285,7 +2288,7 @@ and GenGetUnionCaseField cenv cgbuf eenv (e,ucref,tyargs,n,m) sequel = assert (ucref.Tycon.IsStructOrEnumTycon || isProvenUnionCaseTy (tyOfExpr cenv.g e)) GenExpr cenv cgbuf eenv SPSuppress e Continue - let cuspec,idx = GenUnionCaseSpec cenv.amap m cenv.g eenv.tyenv ucref tyargs + let cuspec,idx = GenUnionCaseSpec cenv.amap m eenv.tyenv ucref tyargs let fty = actualTypOfIlxUnionField cuspec idx n let avoidHelpers = entityRefInThisAssembly cenv.g.compilingFslib ucref.TyconRef CG.EmitInstrs cgbuf (pop 1) (Push [fty]) (EraseUnions.mkLdData (avoidHelpers, cuspec, idx, n)) @@ -2295,7 +2298,7 @@ and GenGetUnionCaseFieldAddr cenv cgbuf eenv (e,ucref,tyargs,n,m) sequel = assert (ucref.Tycon.IsStructOrEnumTycon || isProvenUnionCaseTy (tyOfExpr cenv.g e)) GenExpr cenv cgbuf eenv SPSuppress e Continue - let cuspec,idx = GenUnionCaseSpec cenv.amap m cenv.g eenv.tyenv ucref tyargs + let cuspec,idx = GenUnionCaseSpec cenv.amap m eenv.tyenv ucref tyargs let fty = actualTypOfIlxUnionField cuspec idx n let avoidHelpers = entityRefInThisAssembly cenv.g.compilingFslib ucref.TyconRef CG.EmitInstrs cgbuf (pop 1) (Push [ILType.Byref fty]) (EraseUnions.mkLdDataAddr (avoidHelpers, cuspec, idx, n)) @@ -2303,7 +2306,7 @@ and GenGetUnionCaseFieldAddr cenv cgbuf eenv (e,ucref,tyargs,n,m) sequel = and GenGetUnionCaseTag cenv cgbuf eenv (e,tcref,tyargs,m) sequel = GenExpr cenv cgbuf eenv SPSuppress e Continue - let cuspec = GenUnionSpec cenv.amap m cenv.g eenv.tyenv tcref tyargs + let cuspec = GenUnionSpec cenv.amap m eenv.tyenv tcref tyargs let avoidHelpers = entityRefInThisAssembly cenv.g.compilingFslib tcref EraseUnions.emitLdDataTag cenv.g.ilg (UnionCodeGen cgbuf) (avoidHelpers, cuspec) CG.EmitInstrs cgbuf (pop 1) (Push [cenv.g.ilg.typ_Int32]) [ ] // push/pop to match the line above @@ -2311,7 +2314,7 @@ and GenGetUnionCaseTag cenv cgbuf eenv (e,tcref,tyargs,m) sequel = and GenSetUnionCaseField cenv cgbuf eenv (e,ucref,tyargs,n,e2,m) sequel = GenExpr cenv cgbuf eenv SPSuppress e Continue - let cuspec,idx = GenUnionCaseSpec cenv.amap m cenv.g eenv.tyenv ucref tyargs + let cuspec,idx = GenUnionCaseSpec cenv.amap m eenv.tyenv ucref tyargs let avoidHelpers = entityRefInThisAssembly cenv.g.compilingFslib ucref.TyconRef EraseUnions.emitCastData cenv.g.ilg (UnionCodeGen cgbuf) (false,avoidHelpers,cuspec,idx) CG.EmitInstrs cgbuf (pop 1) (Push [cuspec.EnclosingType]) [ ] // push/pop to match the line above @@ -2502,7 +2505,7 @@ and GenApp cenv cgbuf eenv (f,fty,tyargs,args,m) sequel = let storage = StorageForValRef m vref eenv match storage with | Method (_,_,mspec,_,_,_) -> - CG.EmitInstr cgbuf (pop 0) (Push [cenv.g.ilg.typ_RuntimeMethodHandle]) (I_ldtoken (ILToken.ILMethod mspec)) + CG.EmitInstr cgbuf (pop 0) (Push [cenv.g.iltyp_RuntimeMethodHandle]) (I_ldtoken (ILToken.ILMethod mspec)) | _ -> errorR(Error(FSComp.SR.ilxgenUnexpectedArgumentToMethodHandleOfDuringCodegen(), m)) @@ -2514,7 +2517,7 @@ and GenApp cenv cgbuf eenv (f,fty,tyargs,args,m) sequel = let mkFormalParams gparams = gparams |> DropErasedTyargs |> List.mapi (fun n _gf -> mkILTyvarTy (uint16 n)) let ilGenericMethodSpec = IL.mkILMethSpec (ilMethRef, boxity, mkFormalParams actualTypeInst, mkFormalParams actualMethInst) let i = I_ldtoken (ILToken.ILMethod ilGenericMethodSpec) - CG.EmitInstr cgbuf (pop 0) (Push [cenv.g.ilg.typ_RuntimeMethodHandle]) i + CG.EmitInstr cgbuf (pop 0) (Push [cenv.g.iltyp_RuntimeMethodHandle]) i | _ -> System.Diagnostics.Debug.Assert(false,sprintf "Break for invalid methodhandleof argument expression") @@ -2544,7 +2547,7 @@ and GenApp cenv cgbuf eenv (f,fty,tyargs,args,m) sequel = let actualRetTy = applyTys cenv.g vref.Type (tyargs,nowArgs) let _,curriedArgInfos,returnTy,_ = GetTopValTypeInCompiledForm cenv.g topValInfo vref.Type m - let ilTyArgs = GenTypeArgs cenv.amap m cenv.g eenv.tyenv tyargs + let ilTyArgs = GenTypeArgs cenv.amap m eenv.tyenv tyargs // For instance method calls chop off some type arguments, which are already @@ -2589,7 +2592,7 @@ and GenApp cenv cgbuf eenv (f,fty,tyargs,args,m) sequel = let callInstr = match valUseFlags with | PossibleConstrainedCall ty -> - let ilThisTy = GenType cenv.amap m cenv.g eenv.tyenv ty + let ilThisTy = GenType cenv.amap m eenv.tyenv ty I_callconstraint ( isTailCall, ilThisTy,mspec,None) | _ -> if newobj then I_newobj (mspec, None) @@ -2608,7 +2611,7 @@ and GenApp cenv cgbuf eenv (f,fty,tyargs,args,m) sequel = (eenv,laterArgs) ||> List.mapFold (fun eenv laterArg -> // Only save arguments that have effects if Optimizer.ExprHasEffect cenv.g laterArg then - let ilTy = laterArg |> tyOfExpr cenv.g |> GenType cenv.amap m cenv.g eenv.tyenv + let ilTy = laterArg |> tyOfExpr cenv.g |> GenType cenv.amap m eenv.tyenv let loc,eenv = AllocLocal cenv cgbuf eenv true (ilxgenGlobalNng.FreshCompilerGeneratedName ("arg",m), ilTy, false) scopeMarks GenExpr cenv cgbuf eenv SPSuppress laterArg Continue EmitSetLocal cgbuf loc @@ -2618,7 +2621,7 @@ and GenApp cenv cgbuf eenv (f,fty,tyargs,args,m) sequel = let nargs = mspec.FormalArgTypes.Length CG.EmitInstr cgbuf (pop (nargs + (if mspec.CallingConv.IsStatic || newobj then 0 else 1))) - (if mustGenerateUnitAfterCall || isSuperInit || isSelfInit then Push0 else (Push [(GenType cenv.amap m cenv.g eenv.tyenv actualRetTy)])) callInstr + (if mustGenerateUnitAfterCall || isSuperInit || isSelfInit then Push0 else (Push [(GenType cenv.amap m eenv.tyenv actualRetTy)])) callInstr // For isSuperInit, load the 'this' pointer as the pretend 'result' of the operation. It will be popped again in most cases if isSuperInit then CG.EmitInstrs cgbuf (pop 0) (Push [mspec.EnclosingType]) [ mkLdarg0 ] @@ -2671,9 +2674,9 @@ and GenNamedLocalTyFuncCall cenv (cgbuf: CodeGenBuffer) eenv typ cloinfo tyargs let ilContractClassTyargs = cloinfo.localTypeFuncContractFreeTypars |> List.map mkTyparTy - |> GenTypeArgs cenv.amap m cenv.g eenv.tyenv + |> GenTypeArgs cenv.amap m eenv.tyenv - let ilTyArgs = tyargs |> GenTypeArgs cenv.amap m cenv.g eenv.tyenv + let ilTyArgs = tyargs |> GenTypeArgs cenv.amap m eenv.tyenv let _,(ilContractMethTyargs: ILGenericParameterDefs),(ilContractCloTySpec:ILTypeSpec),ilContractFormalRetTy = GenNamedLocalTypeFuncContractInfo cenv eenv m cloinfo @@ -2688,7 +2691,7 @@ and GenNamedLocalTyFuncCall cenv (cgbuf: CodeGenBuffer) eenv typ cloinfo tyargs let actualRetTy = applyTys cenv.g typ (tyargs,[]) let ilDirectInvokeMethSpec = mkILInstanceMethSpecInTy(ilContractTy, "DirectInvoke", [], ilContractFormalRetTy, ilTyArgs) - let ilActualRetTy = GenType cenv.amap m cenv.g eenv.tyenv actualRetTy + let ilActualRetTy = GenType cenv.amap m eenv.tyenv actualRetTy CountCallFuncInstructions() CG.EmitInstr cgbuf (pop 1) (Push [ilActualRetTy]) (mkNormalCallvirt ilDirectInvokeMethSpec) actualRetTy @@ -2718,16 +2721,16 @@ and GenIndirectCall cenv cgbuf eenv (functy,tyargs,args,m) sequel = List.fold (fun (formalFuncTyp,sofar) _ -> let dty,rty = destFunTy cenv.g formalFuncTyp - (rty,(fun acc -> sofar (Apps_app(GenType cenv.amap m cenv.g feenv dty,acc))))) + (rty,(fun acc -> sofar (Apps_app(GenType cenv.amap m feenv dty,acc))))) (formalFuncTyp,id) args - let ilxRetApps = Apps_done (GenType cenv.amap m cenv.g feenv formalRetTy) + let ilxRetApps = Apps_done (GenType cenv.amap m feenv formalRetTy) - List.foldBack (fun tyarg acc -> Apps_tyapp(GenType cenv.amap m cenv.g eenv.tyenv tyarg,acc)) tyargs (appBuilder ilxRetApps) + List.foldBack (fun tyarg acc -> Apps_tyapp(GenType cenv.amap m eenv.tyenv tyarg,acc)) tyargs (appBuilder ilxRetApps) let actualRetTy = applyTys cenv.g functy (tyargs, args) - let ilActualRetTy = GenType cenv.amap m cenv.g eenv.tyenv actualRetTy + let ilActualRetTy = GenType cenv.amap m eenv.tyenv actualRetTy // Check if any byrefs are involved to make sure we don't tailcall let hasByrefArg = @@ -2764,7 +2767,7 @@ and GenTry cenv cgbuf eenv scopeMarks (e1,m,resty,spTry) = let endTryMark = CG.GenerateDelayMark cgbuf "endTryMark" let afterHandler = CG.GenerateDelayMark cgbuf "afterHandler" let eenvinner = {eenvinner with withinSEH = true} - let ilResultTy = GenType cenv.amap m cenv.g eenvinner.tyenv resty + let ilResultTy = GenType cenv.amap m eenvinner.tyenv resty let whereToSave,eenvinner = AllocLocal cenv cgbuf eenvinner true (ilxgenGlobalNng.FreshCompilerGeneratedName ("tryres",m),ilResultTy, false) (startTryMark,endTryMark) // Generate the body of the try. In the normal case (SequencePointAtTry) we generate a sequence point @@ -2806,7 +2809,7 @@ and GenTryCatch cenv cgbuf eenv (e1,vf:Val,ef,vh:Val,eh,m,resty,spTry,spWith) se CG.SetStack cgbuf [cenv.g.ilg.typ_Object] let _,eenvinner = AllocLocalVal cenv cgbuf vf eenvinner None (startOfFilter,afterFilter) - CG.EmitInstr cgbuf (pop 1) (Push [cenv.g.ilg.typ_Exception]) (I_castclass cenv.g.ilg.typ_Exception) + CG.EmitInstr cgbuf (pop 1) (Push [cenv.g.iltyp_Exception]) (I_castclass cenv.g.iltyp_Exception) GenStoreVal cgbuf eenvinner vf.Range vf @@ -2825,7 +2828,7 @@ and GenTryCatch cenv cgbuf eenv (e1,vf:Val,ef,vh:Val,eh,m,resty,spTry,spWith) se begin CG.SetStack cgbuf [cenv.g.ilg.typ_Object] let _,eenvinner = AllocLocalVal cenv cgbuf vh eenvinner None (startOfHandler,afterHandler) - CG.EmitInstr cgbuf (pop 1) (Push [cenv.g.ilg.typ_Exception]) (I_castclass cenv.g.ilg.typ_Exception) + CG.EmitInstr cgbuf (pop 1) (Push [cenv.g.iltyp_Exception]) (I_castclass cenv.g.iltyp_Exception) GenStoreVal cgbuf eenvinner vh.Range vh GenExpr cenv cgbuf eenvinner SPAlways eh (LeaveHandler (false, whereToSave,afterHandler)) @@ -2842,7 +2845,7 @@ and GenTryCatch cenv cgbuf eenv (e1,vf:Val,ef,vh:Val,eh,m,resty,spTry,spWith) se CG.SetStack cgbuf [cenv.g.ilg.typ_Object] let _,eenvinner = AllocLocalVal cenv cgbuf vh eenvinner None (startOfHandler,afterHandler) - CG.EmitInstr cgbuf (pop 1) (Push [cenv.g.ilg.typ_Exception]) (I_castclass cenv.g.ilg.typ_Exception) + CG.EmitInstr cgbuf (pop 1) (Push [cenv.g.iltyp_Exception]) (I_castclass cenv.g.iltyp_Exception) GenStoreVal cgbuf eenvinner m vh @@ -3039,8 +3042,8 @@ and GenSequential cenv cgbuf eenv spIn (e1,e2,specialSeqFlag,spSeq,_m) sequel = //-------------------------------------------------------------------------- and GenAsmCode cenv cgbuf eenv (il,tyargs,args,returnTys,m) sequel = - let ilTyArgs = GenTypesPermitVoid cenv.amap m cenv.g eenv.tyenv tyargs - let ilReturnTys = GenTypesPermitVoid cenv.amap m cenv.g eenv.tyenv returnTys + let ilTyArgs = GenTypesPermitVoid cenv.amap m eenv.tyenv tyargs + let ilReturnTys = GenTypesPermitVoid cenv.amap m eenv.tyenv returnTys let ilAfterInst = il |> List.filter (function AI_nop -> false | _ -> true) |> List.map (fun i -> @@ -3209,7 +3212,7 @@ and GenQuotation cenv cgbuf eenv (ast,conv,m,ety) sequel = let someTypeInModuleExpr = mkTypeOfExpr cenv m eenv.someTypeInThisAssembly let rawTy = mkRawQuotedExprTy cenv.g - let spliceTypeExprs = List.map (GenType cenv.amap m cenv.g eenv.tyenv >> (mkTypeOfExpr cenv m)) spliceTypes + let spliceTypeExprs = List.map (GenType cenv.amap m eenv.tyenv >> (mkTypeOfExpr cenv m)) spliceTypes let bytesExpr = Expr.Op(TOp.Bytes(astSerializedBytes),[],[],m) @@ -3251,9 +3254,9 @@ and GenILCall cenv cgbuf eenv (virt,valu,newobj,valUseFlags,isDllImport,ilMethRe let makesNoCriticalTailcalls = (newobj || not virt) // Don't tailcall for 'newobj', or 'call' to IL code let tail = CanTailcall(valu,ccallInfo,eenv.withinSEH,hasByrefArg,mustGenerateUnitAfterCall,isDllImport,false,makesNoCriticalTailcalls,sequel) - let ilEnclArgTys = GenTypeArgs cenv.amap m cenv.g eenv.tyenv enclArgTys - let ilMethArgTys = GenTypeArgs cenv.amap m cenv.g eenv.tyenv methArgTys - let ilReturnTys = GenTypes cenv.amap m cenv.g eenv.tyenv returnTys + let ilEnclArgTys = GenTypeArgs cenv.amap m eenv.tyenv enclArgTys + let ilMethArgTys = GenTypeArgs cenv.amap m eenv.tyenv methArgTys + let ilReturnTys = GenTypes cenv.amap m eenv.tyenv returnTys let ilMethSpec = mkILMethSpec (ilMethRef,boxity,ilEnclArgTys,ilMethArgTys) let useICallVirt = virt || useCallVirt cenv boxity ilMethSpec isBaseCall @@ -3266,7 +3269,7 @@ and GenILCall cenv cgbuf eenv (virt,valu,newobj,valUseFlags,isDllImport,ilMethRe else match ccallInfo with | Some objArgTy -> - let ilObjArgTy = GenType cenv.amap m cenv.g eenv.tyenv objArgTy + let ilObjArgTy = GenType cenv.amap m eenv.tyenv objArgTy [ I_callconstraint(tail,ilObjArgTy,ilMethSpec,None) ] | None -> if useICallVirt then [ I_callvirt(tail,ilMethSpec,None) ] @@ -3291,7 +3294,7 @@ and GenTraitCall cenv cgbuf eenv (traitInfo, argExprs, m) expr sequel = | None -> let replacementExpr = mkThrow m (tyOfExpr cenv.g expr) - (mkExnExpr(cenv.g.mkSysTyconRef ["System"] "NotSupportedException", + (mkExnExpr(cenv.g.MkSysTyconRef ["System"] "NotSupportedException", [ mkString cenv.g m (FSComp.SR.ilDynamicInvocationNotSupported(traitInfo.MemberName))],m)) GenExpr cenv cgbuf eenv SPSuppress replacementExpr sequel | Some expr -> @@ -3330,19 +3333,19 @@ and GenGetValAddr cenv cgbuf eenv (v: ValRef, m) sequel = and GenGetByref cenv cgbuf eenv (v:ValRef,m) sequel = GenGetLocalVRef cenv cgbuf eenv m v None - let ilty = GenType cenv.amap m cenv.g eenv.tyenv (destByrefTy cenv.g v.Type) + let ilty = GenType cenv.amap m eenv.tyenv (destByrefTy cenv.g v.Type) CG.EmitInstrs cgbuf (pop 1) (Push [ilty]) [ mkNormalLdobj ilty ] GenSequel cenv eenv.cloc cgbuf sequel and GenSetByref cenv cgbuf eenv (v:ValRef,e,m) sequel = GenGetLocalVRef cenv cgbuf eenv m v None GenExpr cenv cgbuf eenv SPSuppress e Continue - let ilty = GenType cenv.amap m cenv.g eenv.tyenv (destByrefTy cenv.g v.Type) + let ilty = GenType cenv.amap m eenv.tyenv (destByrefTy cenv.g v.Type) CG.EmitInstrs cgbuf (pop 2) Push0 [ mkNormalStobj ilty ] GenUnitThenSequel cenv eenv m eenv.cloc cgbuf sequel and GenDefaultValue cenv cgbuf eenv (ty,m) = - let ilTy = GenType cenv.amap m cenv.g eenv.tyenv ty + let ilTy = GenType cenv.amap m eenv.tyenv ty if isRefTy cenv.g ty then CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) AI_ldnull else @@ -3364,7 +3367,7 @@ and GenDefaultValue cenv cgbuf eenv (ty,m) = | Some tcref when (tyconRefEq cenv.g cenv.g.system_Double_tcref tcref) -> CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (iLdcDouble 0.0) | _ -> - let ilTy = GenType cenv.amap m cenv.g eenv.tyenv ty + let ilTy = GenType cenv.amap m eenv.tyenv ty LocalScope "ilzero" cgbuf (fun scopeMarks -> let locIdx, _ = AllocLocal cenv cgbuf eenv true (ilxgenGlobalNng.FreshCompilerGeneratedName ("default",m), ilTy, false) scopeMarks // "initobj" (Generated by EmitInitLocal) doesn't work on byref types @@ -3381,7 +3384,7 @@ and GenDefaultValue cenv cgbuf eenv (ty,m) = //-------------------------------------------------------------------------- and GenGenericParam cenv eenv (tp:Typar) = - let subTypeConstraints = tp.Constraints |> List.choose (function | TyparConstraint.CoercesTo(ty,_) -> Some(ty) | _ -> None) |> List.map (GenTypeAux cenv.amap tp.Range cenv.g eenv.tyenv VoidNotOK PtrTypesNotOK) + let subTypeConstraints = tp.Constraints |> List.choose (function | TyparConstraint.CoercesTo(ty,_) -> Some(ty) | _ -> None) |> List.map (GenTypeAux cenv.amap tp.Range eenv.tyenv VoidNotOK PtrTypesNotOK) let refTypeConstraint = tp.Constraints |> List.exists (function TyparConstraint.IsReferenceType _ -> true | TyparConstraint.SupportsNull _ -> true | _ -> false) let notNullableValueTypeConstraint = tp.Constraints |> List.exists (function TyparConstraint.IsNonNullableStruct _ -> true | _ -> false) let defaultConstructorConstraint = tp.Constraints |> List.exists (function TyparConstraint.RequiresDefaultConstructor _ -> true | _ -> false) @@ -3421,7 +3424,7 @@ and GenSlotParam m cenv eenv (TSlotParam(nm,ty,inFlag,outFlag,optionalFlag,attri let inFlag2,outFlag2,optionalFlag2,paramMarshal2,attribs = GenParamAttribs cenv attribs { Name=nm - Type= GenParamType cenv.amap m cenv.g eenv.tyenv ty + Type= GenParamType cenv.amap m eenv.tyenv ty Default=None Marshal=paramMarshal2 IsIn=inFlag || inFlag2 @@ -3431,10 +3434,10 @@ and GenSlotParam m cenv eenv (TSlotParam(nm,ty,inFlag,outFlag,optionalFlag,attri and GenFormalSlotsig m cenv eenv (TSlotSig(_,typ,ctps,mtps,paraml,returnTy)) = let paraml = List.concat paraml - let ilTy = GenType cenv.amap m cenv.g eenv.tyenv typ + let ilTy = GenType cenv.amap m eenv.tyenv typ let eenvForSlotSig = EnvForTypars (ctps @ mtps) eenv let ilParams = paraml |> List.map (GenSlotParam m cenv eenvForSlotSig) - let ilRetTy = GenReturnType cenv.amap m cenv.g eenvForSlotSig.tyenv returnTy + let ilRetTy = GenReturnType cenv.amap m eenvForSlotSig.tyenv returnTy let ilReturn = mkILReturn ilRetTy ilTy, ilParams,ilReturn @@ -3444,7 +3447,7 @@ and GenActualSlotsig m cenv eenv (TSlotSig(_,typ,ctps,mtps,paraml,returnTy)) met let paraml = List.concat paraml let instForSlotSig = mkTyparInst (ctps@mtps) (argsOfAppTy cenv.g typ @ generalizeTypars methTyparsOfOverridingMethod) let ilParams = paraml |> List.map (instSlotParam instForSlotSig >> GenSlotParam m cenv eenv) - let ilRetTy = GenReturnType cenv.amap m cenv.g eenv.tyenv (Option.map (instType instForSlotSig) returnTy) + let ilRetTy = GenReturnType cenv.amap m eenv.tyenv (Option.map (instType instForSlotSig) returnTy) let ilReturn = mkILReturn ilRetTy ilParams,ilReturn @@ -3567,7 +3570,7 @@ and GenObjectExpr cenv cgbuf eenvouter expr (baseType,baseValOpt,basecall,overri let mimpls = mimpls |> List.choose id // choose the ones that actually have method impls - let interfaceTys = interfaceImpls |> List.map (fst >> GenType cenv.amap m cenv.g eenvinner.tyenv) + let interfaceTys = interfaceImpls |> List.map (fst >> GenType cenv.amap m eenvinner.tyenv) let attrs = GenAttrs cenv eenvinner cloAttribs let super = (if isInterfaceTy cenv.g baseType then cenv.g.ilg.typ_Object else ilCloRetTy) @@ -3593,13 +3596,13 @@ and GenSequenceExpr cenv (cgbuf:CodeGenBuffer) eenvouter (nextEnumeratorValRef:V let (cloAttribs,_,_,cloFreeTyvars,cloFreeVars,ilCloTypeRef:ILTypeRef,ilCloFreeVars,eenvinner) = GetIlxClosureFreeVars cenv m None eenvouter [] (mkLambda m nextEnumeratorValRef.Deref (generateNextExpr, cenv.g.int32_ty)) - let ilCloSeqElemTy = GenType cenv.amap m cenv.g eenvinner.tyenv seqElemTy + let ilCloSeqElemTy = GenType cenv.amap m eenvinner.tyenv seqElemTy let cloRetTy = mkSeqTy cenv.g seqElemTy - let ilCloRetTyInner = GenType cenv.amap m cenv.g eenvinner.tyenv cloRetTy - let ilCloRetTyOuter = GenType cenv.amap m cenv.g eenvouter.tyenv cloRetTy - let ilCloEnumeratorTy = GenType cenv.amap m cenv.g eenvinner.tyenv (mkIEnumeratorTy cenv.g seqElemTy) - let ilCloEnumerableTy = GenType cenv.amap m cenv.g eenvinner.tyenv (mkSeqTy cenv.g seqElemTy) - let ilCloBaseTy = GenType cenv.amap m cenv.g eenvinner.tyenv (mkAppTy cenv.g.seq_base_tcr [seqElemTy]) + let ilCloRetTyInner = GenType cenv.amap m eenvinner.tyenv cloRetTy + let ilCloRetTyOuter = GenType cenv.amap m eenvouter.tyenv cloRetTy + let ilCloEnumeratorTy = GenType cenv.amap m eenvinner.tyenv (mkIEnumeratorTy cenv.g seqElemTy) + let ilCloEnumerableTy = GenType cenv.amap m eenvinner.tyenv (mkSeqTy cenv.g seqElemTy) + let ilCloBaseTy = GenType cenv.amap m eenvinner.tyenv (mkAppTy cenv.g.seq_base_tcr [seqElemTy]) let ilCloGenericParams = GenGenericParams cenv eenvinner cloFreeTyvars // Create a new closure class with a single "MoveNext" method that implements the iterator. @@ -3696,7 +3699,7 @@ and GenClosureTypeDefs cenv (tref:ILTypeRef, ilGenParams, attrs, ilCloFreeVars, Properties = emptyILProperties Methods= mkILMethods mdefs MethodImpls= mkILMethodImpls mimpls - IsSerializable= cenv.opts.netFxHasSerializableAttribute + IsSerializable= cenv.g.attrib_SerializableAttribute.IsSome IsComInterop= false IsSpecialName= true NestedTypes=emptyILTypeDefs @@ -3752,7 +3755,7 @@ and GenLambdaClosure cenv (cgbuf:CodeGenBuffer) eenv isLocalTypeFunc selfv expr Properties = emptyILProperties Methods= mkILMethods ilContractMeths MethodImpls= emptyILMethodImpls - IsSerializable= cenv.opts.netFxHasSerializableAttribute + IsSerializable= cenv.g.attrib_SerializableAttribute.IsSome IsComInterop=false IsSpecialName= true NestedTypes=emptyILTypeDefs @@ -3789,7 +3792,7 @@ and GenLambda cenv cgbuf eenv isLocalTypeFunc selfv expr sequel = GenSequel cenv eenv.cloc cgbuf sequel and GenTypeOfVal cenv eenv (v:Val) = - GenType cenv.amap v.Range cenv.g eenv.tyenv v.Type + GenType cenv.amap v.Range eenv.tyenv v.Type and GenFreevar cenv m eenvouter tyenvinner (fv:Val) = match StorageForVal m fv eenvouter with @@ -3799,7 +3802,7 @@ and GenFreevar cenv m eenvouter tyenvinner (fv:Val) = // Check for things that should never make it into the free variable set. Only do this in debug for performance reasons | (StaticField _ | StaticProperty _ | Method _ | Null) -> error(InternalError("GenFreevar: compiler error: unexpected unrealized value",fv.Range)) #endif - | _ -> GenType cenv.amap m cenv.g tyenvinner fv.Type + | _ -> GenType cenv.amap m tyenvinner fv.Type and GetIlxClosureFreeVars cenv m selfv eenvouter takenNames expr = @@ -3940,7 +3943,7 @@ and GetIlxClosureInfo cenv m isLocalTypeFunc selfv eenvouter expr = let lambdas = Lambdas_lambda (mkILParamNamed(nm,GenTypeOfVal cenv eenv v),l) lambdas,eenv | _ -> - let returnTy' = GenType cenv.amap m cenv.g eenv.tyenv returnTy + let returnTy' = GenType cenv.amap m eenv.tyenv returnTy Lambdas_return returnTy', eenv // start at arg number 1 as "this" pointer holds the current closure @@ -3950,7 +3953,7 @@ and GetIlxClosureInfo cenv m isLocalTypeFunc selfv eenvouter expr = let narginfo = vs |> List.map (fun _ -> 1) // Generate the ILX view of the lambdas - let ilReturnTy = GenType cenv.amap m cenv.g eenvinner.tyenv returnTy + let ilReturnTy = GenType cenv.amap m eenvinner.tyenv returnTy // The general shape is: // {LAM . expr }[free-typars] : overall-type[contract-typars] @@ -4049,14 +4052,14 @@ and GenNamedLocalTypeFuncContractInfo cenv eenv m cloinfo = | e -> [], tyOfExpr cenv.g e let eenvForContract = AddTyparsToEnv tvs eenvForContract let ilContractMethTyargs = GenGenericParams cenv eenvForContract tvs - let ilContractFormalRetTy = GenType cenv.amap m cenv.g eenvForContract.tyenv contractRetTy + let ilContractFormalRetTy = GenType cenv.amap m eenvForContract.tyenv contractRetTy ilContractGenericParams,ilContractMethTyargs,mkILTySpec(ilContractTypeRef,cloinfo.localTypeFuncILGenericArgs),ilContractFormalRetTy /// Generate a new delegate construction including a clousre class if necessary. This is a lot like generating function closures /// and object expression closures, and most of the code is shared. and GenDelegateExpr cenv cgbuf eenvouter expr (TObjExprMethod((TSlotSig(_,delegateTy, _,_,_, _) as slotsig),_attribs,methTyparsOfOverridingMethod,tmvs,body,_),m) sequel = // Get the instantiation of the delegate type - let ilCtxtDelTy = GenType cenv.amap m cenv.g eenvouter.tyenv delegateTy + let ilCtxtDelTy = GenType cenv.amap m eenvouter.tyenv delegateTy let tmvs = List.concat tmvs // Yuck. TLBIMP.EXE generated APIs use UIntPtr for the delegate ctor. @@ -4101,7 +4104,7 @@ and GenDelegateExpr cenv cgbuf eenvouter expr (TObjExprMethod((TSlotSig(_,delega ilDelegeeParams, ilDelegeeRet, MethodBody.IL ilMethodBody) - let delegeeCtorMeth = mkILSimpleStorageCtor(None, Some cenv.g.ilg.tspec_Object, ilDelegeeTyInner, [], ILMemberAccess.Assembly) + let delegeeCtorMeth = mkILSimpleStorageCtor(None, Some cenv.g.ilg.typ_Object.TypeSpec, ilDelegeeTyInner, [], ILMemberAccess.Assembly) let ilCtorBody = delegeeCtorMeth.MethodBody let ilCloLambdas = Lambdas_return ilCtxtDelTy @@ -4171,7 +4174,7 @@ and GenJoinPoint cenv cgbuf pos eenv ty m sequel = // The others (e.g. Continue, LeaveFilter and CmpThenBrOrContinue) can't be done at the end of each branch. We must create a join point. | _ -> - let pushed = GenType cenv.amap m cenv.g eenv.tyenv ty + let pushed = GenType cenv.amap m eenv.tyenv ty let stackAfterJoin = (pushed :: (cgbuf.GetCurrentStack())) let afterJoin = CG.GenerateDelayMark cgbuf (pos + "_join") // go to the join point @@ -4374,7 +4377,7 @@ and GenDecisionTreeSwitch cenv cgbuf inplabOpt stackAtTargets eenv e cases defau match defaultTargetOpt with | None -> rest.Head.CaseTree | Some tg -> tg - let cuspec = GenUnionSpec cenv.amap m cenv.g eenv.tyenv c.TyconRef tyargs + let cuspec = GenUnionSpec cenv.amap m eenv.tyenv c.TyconRef tyargs let idx = c.Index let avoidHelpers = entityRefInThisAssembly cenv.g.compilingFslib c.TyconRef GenDecisionTreeTest cenv eenv.cloc cgbuf stackAtTargets e (Some (pop 1, Push [cenv.g.ilg.typ_Bool], Choice1Of2 (avoidHelpers, cuspec, idx))) eenv successTree failureTree targets repeatSP targetInfos sequel @@ -4399,7 +4402,7 @@ and GenDecisionTreeSwitch cenv cgbuf inplabOpt stackAtTargets eenv e cases defau GenExpr cenv cgbuf eenv SPSuppress e Continue let srcTy = tyOfExpr cenv.g e if isTyparTy cenv.g srcTy then - let ilFromTy = GenType cenv.amap m cenv.g eenv.tyenv srcTy + let ilFromTy = GenType cenv.amap m eenv.tyenv srcTy CG.EmitInstr cgbuf (pop 1) (Push [cenv.g.ilg.typ_Object]) (I_box ilFromTy) BI_brfalse | Test.IsInst (_srcty,tgty) -> @@ -4413,7 +4416,7 @@ and GenDecisionTreeSwitch cenv cgbuf inplabOpt stackAtTargets eenv e cases defau | Test.ActivePatternCase _ -> error(InternalError("internal error in codegen: Test.ActivePatternCase",switchm)) | Test.UnionCase (hdc,tyargs) -> GenExpr cenv cgbuf eenv SPSuppress e Continue - let cuspec = GenUnionSpec cenv.amap m cenv.g eenv.tyenv hdc.TyconRef tyargs + let cuspec = GenUnionSpec cenv.amap m eenv.tyenv hdc.TyconRef tyargs let dests = if cases.Length <> caseLabels.Length then failwith "internal error: Test.UnionCase" (cases , caseLabels) ||> List.map2 (fun case label -> @@ -4738,7 +4741,7 @@ and GenBindAfterSequencePoint cenv cgbuf eenv sp (TBind(vspec,rhsExpr,_)) = let ilFieldDef = { ilFieldDef with - CustomAttrs = mkILCustomAttrs (ilAttribs @ [ cenv.g.ilg.mkDebuggerBrowsableNeverAttribute() ]) } + CustomAttrs = mkILCustomAttrs (ilAttribs @ [ cenv.g.DebuggerBrowsableNeverAttribute ]) } [ (fspec.EnclosingTypeRef, ilFieldDef) ] @@ -5003,7 +5006,7 @@ and GenPropertyForMethodDef compileAsInstance tref mdef (v:Val) (memberInfo:ValM and GenEventForProperty cenv eenvForMeth (mspec:ILMethodSpec) (v:Val) ilAttrsThatGoOnPrimaryItem m returnTy = let evname = v.PropertyName let delegateTy = Infos.FindDelegateTypeOfPropertyEvent cenv.g cenv.amap evname m returnTy - let ilDelegateTy = GenType cenv.amap m cenv.g eenvForMeth.tyenv delegateTy + let ilDelegateTy = GenType cenv.amap m eenvForMeth.tyenv delegateTy let ilThisTy = mspec.EnclosingType let addMethRef = mkILMethRef (ilThisTy.TypeRef,mspec.CallingConv,"add_" + evname,0,[ilDelegateTy],ILType.Void) let removeMethRef = mkILMethRef (ilThisTy.TypeRef,mspec.CallingConv,"remove_" + evname,0,[ilDelegateTy],ILType.Void) @@ -5129,7 +5132,7 @@ and GenMethodForBinding let bodyExpr = if HasFSharpAttribute cenv.g cenv.g.attrib_NoDynamicInvocationAttribute v.Attribs then mkThrow m returnTy - (mkExnExpr(cenv.g.mkSysTyconRef ["System"] "NotSupportedException", + (mkExnExpr(cenv.g.MkSysTyconRef ["System"] "NotSupportedException", [ mkString cenv.g m (FSComp.SR.ilDynamicInvocationNotSupported(v.CompiledName))],m)) else body @@ -5163,7 +5166,7 @@ and GenMethodForBinding let secDecls = if securityAttributes.Length > 0 then (mkILSecurityDecls permissionSets) else (emptyILSecurityDecls) // Do not push the attributes to the method for events and properties - let ilAttrsCompilerGenerated = if v.IsCompilerGenerated then [ cenv.g.ilg.mkCompilerGeneratedAttribute() ] else [] + let ilAttrsCompilerGenerated = if v.IsCompilerGenerated then [ cenv.g.CompilerGeneratedAttribute ] else [] let ilAttrsThatGoOnPrimaryItem = [ yield! GenAttrs cenv eenv attrs @@ -5273,8 +5276,8 @@ and GenMethodForBinding // Emit the property, but not if its a private method impl if mdef.Access <> ILMemberAccess.Private then let vtyp = ReturnTypeOfPropertyVal cenv.g v - let ilPropTy = GenType cenv.amap m cenv.g eenvUnderMethTypeTypars.tyenv vtyp - let ilArgTys = v |> ArgInfosOfPropertyVal cenv.g |> List.map fst |> GenTypes cenv.amap m cenv.g eenvUnderMethTypeTypars.tyenv + let ilPropTy = GenType cenv.amap m eenvUnderMethTypeTypars.tyenv vtyp + let ilArgTys = v |> ArgInfosOfPropertyVal cenv.g |> List.map fst |> GenTypes cenv.amap m eenvUnderMethTypeTypars.tyenv let ilPropDef = GenPropertyForMethodDef compileAsInstance tref mdef v memberInfo ilArgTys ilPropTy (mkILCustomAttrs ilAttrsThatGoOnPrimaryItem) compiledName cgbuf.mgbuf.AddOrMergePropertyDef(tref,ilPropDef,m) @@ -5352,7 +5355,7 @@ and GenSetVal cenv cgbuf eenv (vref,e,m) sequel = and GenGetValRefAndSequel cenv cgbuf eenv m (v:ValRef) fetchSequel = let ty = v.Type - GenGetStorageAndSequel cenv cgbuf eenv m (ty, GenType cenv.amap m cenv.g eenv.tyenv ty) (StorageForValRef m v eenv) fetchSequel + GenGetStorageAndSequel cenv cgbuf eenv m (ty, GenType cenv.amap m eenv.tyenv ty) (StorageForValRef m v eenv) fetchSequel and GenGetVal cenv cgbuf eenv (v:ValRef,m) sequel = GenGetValRefAndSequel cenv cgbuf eenv m v None @@ -5634,16 +5637,16 @@ and GenAttribArg amap g eenv x (ilArgTy:ILType) = // Detect '[| ... |]' nodes | Expr.Op(TOp.Array,[elemTy],args,m),_ -> - let ilElemTy = GenType amap m g eenv.tyenv elemTy + let ilElemTy = GenType amap m eenv.tyenv elemTy ILAttribElem.Array (ilElemTy, List.map (fun arg -> GenAttribArg amap g eenv arg ilElemTy) args) // Detect 'typeof' calls | TypeOfExpr g ty, _ -> - ILAttribElem.Type (Some (GenType amap x.Range g eenv.tyenv ty)) + ILAttribElem.Type (Some (GenType amap x.Range eenv.tyenv ty)) // Detect 'typedefof' calls | TypeDefOfExpr g ty, _ -> - ILAttribElem.TypeRef (Some (GenType amap x.Range g eenv.tyenv ty).TypeRef) + ILAttribElem.TypeRef (Some (GenType amap x.Range eenv.tyenv ty).TypeRef) // Ignore upcasts | Expr.Op(TOp.Coerce,_,[arg2],_),_ -> @@ -5679,7 +5682,7 @@ and GenAttr amap g eenv (Attrib(_,k,args,props,_,_,_)) = let props = props |> List.map (fun (AttribNamedArg(s,ty,fld,AttribExpr(_,expr))) -> let m = expr.Range - let ilTy = GenType amap m g eenv.tyenv ty + let ilTy = GenType amap m eenv.tyenv ty let cval = GenAttribArg amap g eenv expr ilTy (s,ilTy,fld,cval)) let mspec = @@ -5736,7 +5739,7 @@ and GenTypeDefForCompLoc (cenv, eenv, mgbuf: AssemblyBuilder, cloc, hidden, attr mkILCustomAttrs (GenAttrs cenv eenv attribs @ (if List.contains tref.Name [TypeNameForImplicitMainMethod cloc; TypeNameForInitClass cloc; TypeNameForPrivateImplementationDetails cloc] - then [ (* mkCompilerGeneratedAttribute *) ] + then [ ] else [mkCompilationMappingAttr cenv.g (int SourceConstructFlags.Module)])), initTrigger) let tdef = { tdef with IsSealed=true; IsAbstract=true } @@ -5949,8 +5952,8 @@ and GenTopImpl cenv mgbuf mainInfoOpt eenv (TImplFile(qname, _, mexpr, hasExplic let initFieldName = CompilerGeneratedName "init" let ilFieldDef = mkILStaticField (initFieldName,cenv.g.ilg.typ_Int32, None, None, ComputeMemberAccess true) - |> addFieldNeverAttrs cenv.g.ilg - |> addFieldGeneratedAttrs cenv.g.ilg + |> cenv.g.AddFieldNeverAttrs + |> cenv.g.AddFieldGeneratedAttrs let fspec = mkILFieldSpecInTy (initClassTy, initFieldName, cenv. g.ilg.typ_Int32) CountStaticFieldDef() @@ -5980,7 +5983,7 @@ and GenForceWholeFileInitializationAsPartOfCCtor cenv (mgbuf:AssemblyBuilder) (l /// Generate an Equals method. and GenEqualsOverrideCallingIComparable cenv (tcref:TyconRef, ilThisTy, _ilThatTy) = - let mspec = mkILNonGenericInstanceMethSpecInTy (cenv.g.ilg.typ_IComparable, "CompareTo", [cenv.g.ilg.typ_Object], cenv.g.ilg.typ_Int32) + let mspec = mkILNonGenericInstanceMethSpecInTy (cenv.g.iltyp_IComparable, "CompareTo", [cenv.g.ilg.typ_Object], cenv.g.ilg.typ_Int32) mkILNonGenericVirtualMethod ("Equals",ILMemberAccess.Public, @@ -6066,8 +6069,8 @@ and GenAbstractBinding cenv eenv tref (vref:ValRef) = [],[],[edef] else let ilPropDef = - let ilPropTy = GenType cenv.amap m cenv.g eenvForMeth.tyenv vtyp - let ilArgTys = v |> ArgInfosOfPropertyVal cenv.g |> List.map fst |> GenTypes cenv.amap m cenv.g eenvForMeth.tyenv + let ilPropTy = GenType cenv.amap m eenvForMeth.tyenv vtyp + let ilArgTys = v |> ArgInfosOfPropertyVal cenv.g |> List.map fst |> GenTypes cenv.amap m eenvForMeth.tyenv GenPropertyForMethodDef compileAsInstance tref mdef v memberInfo ilArgTys ilPropTy (mkILCustomAttrs ilAttrs) None let mdef = mdef |> AddSpecialNameFlag [mdef], [ilPropDef],[] @@ -6089,10 +6092,10 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) = let eenvinner = ReplaceTyenv (TypeReprEnv.ForTycon tycon) eenv let thisTy = generalizedTyconRef tcref - let ilThisTy = GenType cenv.amap m cenv.g eenvinner.tyenv thisTy + let ilThisTy = GenType cenv.amap m eenvinner.tyenv thisTy let tref = ilThisTy.TypeRef let ilGenParams = GenGenericParams cenv eenvinner tycon.TyparsNoRange - let ilIntfTys = tycon.ImmediateInterfaceTypesOfFSharpTycon |> List.map (GenType cenv.amap m cenv.g eenvinner.tyenv) + let ilIntfTys = tycon.ImmediateInterfaceTypesOfFSharpTycon |> List.map (GenType cenv.amap m eenvinner.tyenv) let ilTypeName = tref.Name let hidden = IsHiddenTycon eenv.sigToImplRemapInfo tycon @@ -6174,7 +6177,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) = | Some memberInfo -> match name, memberInfo.MemberFlags.MemberKind with | ("Item" | "op_IndexedLookup"), (MemberKind.PropertyGet | MemberKind.PropertySet) when not (isNil (ArgInfosOfPropertyVal cenv.g vref.Deref)) -> - Some( mkILCustomAttribute cenv.g.ilg (cenv.g.ilg.mkSysILTypeRef "System.Reflection.DefaultMemberAttribute",[cenv.g.ilg.typ_String],[ILAttribElem.String(Some(name))],[]) ) + Some( mkILCustomAttribute cenv.g.ilg (cenv.g.MkSysILTypeRef "System.Reflection.DefaultMemberAttribute",[cenv.g.ilg.typ_String],[ILAttribElem.String(Some(name))],[]) ) | _ -> None) |> Option.toList @@ -6193,7 +6196,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) = let ilDebugDisplayAttributes = [ yield! GenAttrs cenv eenv debugDisplayAttrs if generateDebugDisplayAttribute then - yield cenv.g.ilg.mkDebuggerDisplayAttribute ("{" + debugDisplayMethodName + "(),nq}") ] + yield cenv.g.mkDebuggerDisplayAttribute ("{" + debugDisplayMethodName + "(),nq}") ] let ilCustomAttrs = @@ -6243,7 +6246,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) = ((fspec.IsCompilerGenerated && not tycon.IsEnumTycon) || hiddenRepr || IsHiddenRecdField eenv.sigToImplRemapInfo (tcref.MakeNestedRecdFieldRef fspec)) - let ilType = GenType cenv.amap m cenv.g eenvinner.tyenv fspec.FormalType + let ilType = GenType cenv.amap m eenvinner.tyenv fspec.FormalType let ilFieldName = ComputeFieldName tycon fspec yield (useGenuineField, ilFieldName, fspec.IsMutable, fspec.IsStatic, fspec.PropertyAttribs, ilType, isPropHidden, fspec) ] @@ -6287,7 +6290,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) = let extraAttribs = match tyconRepr with - | TRecdRepr _ when not useGenuineField -> [ cenv.g.ilg.mkDebuggerBrowsableNeverAttribute() ] // hide fields in records in debug display + | TRecdRepr _ when not useGenuineField -> [ cenv.g.DebuggerBrowsableNeverAttribute ] // hide fields in records in debug display | _ -> [] // don't hide fields in classes in debug display yield @@ -6423,7 +6426,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) = let isStructRecord = tycon.IsStructRecordOrUnionTycon // No type spec if the record is a value type - let spec = if isStructRecord then None else Some(cenv.g.ilg.tspec_Object) + let spec = if isStructRecord then None else Some(cenv.g.ilg.typ_Object.TypeSpec) let ilMethodDef = mkILSimpleStorageCtorWithParamNames(None, spec, ilThisTy, ChooseParamNames fieldNamesAndTypes, reprAccess) yield ilMethodDef @@ -6431,7 +6434,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) = // FSharp 3.0 feature: adding CLIMutable to a record type causes emit of default constructor, and all fields get property setters // Records that are value types do not create a default constructor with CLIMutable or ComVisible if not isStructRecord && (isCLIMutable || (TryFindFSharpBoolAttribute cenv.g cenv.g.attrib_ComVisibleAttribute tycon.Attribs = Some true)) then - yield mkILSimpleStorageCtor(None, Some cenv.g.ilg.tspec_Object, ilThisTy, [], reprAccess) + yield mkILSimpleStorageCtor(None, Some cenv.g.ilg.typ_Object.TypeSpec, ilThisTy, [], reprAccess) | TFSharpObjectRepr r when tycon.IsFSharpDelegateTycon -> @@ -6447,7 +6450,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) = | [[tsp]] when isUnitTy cenv.g tsp.Type -> [] (* suppress unit arg *) | paraml -> paraml GenActualSlotsig m cenv eenvinner (TSlotSig(nm,typ,ctps,mtps,paraml,returnTy)) [] - for ilMethodDef in mkILDelegateMethods cenv.g.ilg (p,r) do + for ilMethodDef in mkILDelegateMethods cenv.g.ilg (cenv.g.iltyp_AsyncCallback, cenv.g.iltyp_IAsyncResult) (p,r) do yield { ilMethodDef with Access=reprAccess } | _ -> () @@ -6461,7 +6464,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) = let tdef, tdefDiscards = let isSerializable = (TryFindFSharpBoolAttribute cenv.g cenv.g.attrib_AutoSerializableAttribute tycon.Attribs <> Some(false)) - && cenv.opts.netFxHasSerializableAttribute + && cenv.g.attrib_SerializableAttribute.IsSome match tycon.TypeReprInfo with | TILObjectRepr (_,_,td) -> @@ -6471,7 +6474,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) = | TRecdRepr _ | TFSharpObjectRepr _ as tyconRepr -> let super = superOfTycon cenv.g tycon - let ilBaseTy = GenType cenv.amap m cenv.g eenvinner.tyenv super + let ilBaseTy = GenType cenv.amap m eenvinner.tyenv super // Build a basic type definition let isObjectType = (match tyconRepr with TFSharpObjectRepr _ -> true | _ -> false) @@ -6582,7 +6585,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) = let alternatives = tycon.UnionCasesArray |> Array.mapi (fun i ucspec -> { altName=ucspec.CompiledName - altFields=GenUnionCaseRef cenv.amap m cenv.g eenvinner.tyenv i ucspec.RecdFieldsArray + altFields=GenUnionCaseRef cenv.amap m eenvinner.tyenv i ucspec.RecdFieldsArray altCustomAttrs= mkILCustomAttrs (GenAttrs cenv eenv ucspec.Attribs @ [mkCompilationMappingAttrWithSeqNum cenv.g (int SourceConstructFlags.UnionCase) i]) }) let cuinfo = { cudReprAccess=reprAccess @@ -6619,10 +6622,10 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) = NestedTypes=emptyILTypeDefs Encoding= ILDefaultPInvokeEncoding.Auto Implements = ilIntfTys - Extends= Some (if tycon.IsStructOrEnumTycon then cenv.g.ilg.typ_ValueType else cenv.g.ilg.typ_Object) + Extends= Some (if tycon.IsStructOrEnumTycon then cenv.g.iltyp_ValueType else cenv.g.ilg.typ_Object) SecurityDecls= emptyILSecurityDecls HasSecurity=false } - let tdef2 = EraseUnions.mkClassUnionDef cenv.g.ilg tref tdef cuinfo + let tdef2 = cenv.g.eraseClassUnionDef tref tdef cuinfo // Discard the user-supplied (i.e. prim-type.fs) implementations of the get_Empty, get_IsEmpty, get_Value and get_None and Some methods. // This is because we will replace their implementations by ones that load the unique @@ -6662,7 +6665,7 @@ and GenExnDef cenv mgbuf eenv m (exnc:Tycon) = match exnc.ExceptionInfo with | TExnAbbrevRepr _ | TExnAsmRepr _ | TExnNone -> () | TExnFresh _ -> - let ilThisTy = GenExnType cenv.amap m cenv.g eenv.tyenv exncref + let ilThisTy = GenExnType cenv.amap m eenv.tyenv exncref let tref = ilThisTy.TypeRef let isHidden = IsHiddenTycon eenv.sigToImplRemapInfo exnc let access = ComputeTypeAccess tref isHidden @@ -6672,7 +6675,7 @@ and GenExnDef cenv mgbuf eenv m (exnc:Tycon) = let ilMethodDefsForProperties,ilFieldDefs,ilPropertyDefs,fieldNamesAndTypes = [ for i,fld in markup fspecs do let ilPropName = fld.Name - let ilPropType = GenType cenv.amap m cenv.g eenv.tyenv fld.FormalType + let ilPropType = GenType cenv.amap m eenv.tyenv fld.FormalType let ilMethName = "get_" + fld.Name let ilFieldName = ComputeFieldName exnc fld let ilMethodDef = mkLdfldMethodDef (ilMethName,reprAccess,false,ilThisTy,ilFieldName,ilPropType) @@ -6692,80 +6695,80 @@ and GenExnDef cenv mgbuf eenv m (exnc:Tycon) = |> List.unzip4 let ilCtorDef = - mkILSimpleStorageCtorWithParamNames(None, Some cenv.g.ilg.tspec_Exception, ilThisTy, ChooseParamNames fieldNamesAndTypes, reprAccess) + mkILSimpleStorageCtorWithParamNames(None, Some cenv.g.iltyp_Exception.TypeSpec, ilThisTy, ChooseParamNames fieldNamesAndTypes, reprAccess) // In compiled code, all exception types get a parameterless constructor for use with XML serialization // This does default-initialization of all fields let ilCtorDefNoArgs = if not (isNil fieldNamesAndTypes) then - [ mkILSimpleStorageCtor(None, Some cenv.g.ilg.tspec_Exception, ilThisTy, [], reprAccess) ] + [ mkILSimpleStorageCtor(None, Some cenv.g.iltyp_Exception.TypeSpec, ilThisTy, [], reprAccess) ] else [] let serializationRelatedMembers = // do not emit serialization related members if target framework lacks SerializableAttribute or SerializationInfo - if not (cenv.opts.netFxHasSerializableAttribute && cenv.g.ilg.typ_SerializationInfo.IsSome) then [] - else - let serializationInfoType = cenv.g.ilg.typ_SerializationInfo.Value + match cenv.g.attrib_SerializableAttribute, cenv.g.iltyp_SerializationInfo, cenv.g.iltyp_StreamingContext with + | Some _, Some serializationInfoType, Some streamingContextType -> let ilCtorDefForSerialziation = mkILCtor(ILMemberAccess.Family, - [mkILParamNamed("info", serializationInfoType);mkILParamNamed("context",cenv.g.ilg.typ_StreamingContext)], + [mkILParamNamed("info", serializationInfoType);mkILParamNamed("context",streamingContextType)], mkMethodBody (false,[],8, nonBranchingInstrsToCode [ mkLdarg0 mkLdarg 1us mkLdarg 2us - mkNormalCall (mkILCtorMethSpecForTy (cenv.g.ilg.typ_Exception,[serializationInfoType; cenv.g.ilg.typ_StreamingContext])) ] + mkNormalCall (mkILCtorMethSpecForTy (cenv.g.iltyp_Exception,[serializationInfoType; streamingContextType])) ] ,None)) -#if BE_SECURITY_TRANSPARENT +//#if BE_SECURITY_TRANSPARENT [ilCtorDefForSerialziation] -#else +//#else +(* let getObjectDataMethodForSerialization = let ilMethodDef = mkILNonGenericVirtualMethod ("GetObjectData",ILMemberAccess.Public, - [mkILParamNamed ("info", serializationInfoType);mkILParamNamed("context",cenv.g.ilg.typ_StreamingContext)], + [mkILParamNamed ("info", serializationInfoType);mkILParamNamed("context",cenv.g.iltyp_StreamingContext)], mkILReturn ILType.Void, (let code = nonBranchingInstrsToCode [ mkLdarg0 mkLdarg 1us mkLdarg 2us - mkNormalCall (mkILNonGenericInstanceMethSpecInTy (cenv.g.ilg.typ_Exception, "GetObjectData", [serializationInfoType; cenv.g.ilg.typ_StreamingContext], ILType.Void)) + mkNormalCall (mkILNonGenericInstanceMethSpecInTy (cenv.g.iltyp_Exception, "GetObjectData", [serializationInfoType; cenv.g.iltyp_StreamingContext], ILType.Void)) ] mkMethodBody(true,[],8,code,None))) // Here we must encode: [SecurityPermission(SecurityAction.Demand, SerializationFormatter = true)] // In ILDASM this is: .permissionset demand = {[mscorlib]System.Security.Permissions.SecurityPermissionAttribute = {property bool 'SerializationFormatter' = bool(true)}} - match cenv.g.ilg.tref_SecurityPermissionAttribute with + match cenv.g.tref_SecurityPermissionAttribute with | None -> ilMethodDef | Some securityPermissionAttributeType -> { ilMethodDef with SecurityDecls=mkILSecurityDecls [ IL.mkPermissionSet cenv.g.ilg (ILSecurityAction.Demand,[(securityPermissionAttributeType, [("SerializationFormatter",cenv.g.ilg.typ_Bool, ILAttribElem.Bool(true))])])] HasSecurity=true } [ilCtorDefForSerialziation; getObjectDataMethodForSerialization] -#endif +*) +//#endif + | _ -> [] let ilTypeName = tref.Name - let ilMethodDefsForComparison = - [] - let interfaces = exnc.ImmediateInterfaceTypesOfFSharpTycon |> List.map (GenType cenv.amap m cenv.g eenv.tyenv) + let interfaces = exnc.ImmediateInterfaceTypesOfFSharpTycon |> List.map (GenType cenv.amap m eenv.tyenv) let tdef = mkILGenericClass - (ilTypeName,access,[],cenv.g.ilg.typ_Exception, + (ilTypeName,access,[],cenv.g.iltyp_Exception, interfaces, - mkILMethods ([ilCtorDef] @ ilMethodDefsForComparison @ ilCtorDefNoArgs @ serializationRelatedMembers @ ilMethodDefsForProperties), + mkILMethods ([ilCtorDef] @ ilCtorDefNoArgs @ serializationRelatedMembers @ ilMethodDefsForProperties), mkILFields ilFieldDefs, emptyILTypeDefs, mkILProperties ilPropertyDefs, emptyILEvents, mkILCustomAttrs [mkCompilationMappingAttr cenv.g (int SourceConstructFlags.Exception)], ILTypeInit.BeforeField) - let tdef = { tdef with IsSerializable = cenv.opts.netFxHasSerializableAttribute } + let tdef = { tdef with IsSerializable = cenv.g.attrib_SerializableAttribute.IsSome } mgbuf.AddTypeDef(tref, tdef, false, false, None) @@ -6892,11 +6895,11 @@ let defaultOf = /// IlxGen knows how v was stored, and then ilreflect knows how this storage was generated. /// IlxGen converts (v:Tast.Val) to AbsIL datatstructures. /// Ilreflect converts from AbsIL datatstructures to emitted Type, FieldInfo, MethodInfo etc. -let LookupGeneratedValue (amap:Import.ImportMap) (ctxt: ExecutionContext) g eenv (v:Val) = +let LookupGeneratedValue (amap:ImportMap) (ctxt: ExecutionContext) eenv (v:Val) = try // Convert the v.Type into a System.Type according to ilxgen and ilreflect. let objTyp = - let ilTy = GenType amap v.Range g TypeReprEnv.Empty v.Type (* TypeReprEnv.Empty ok, not expecting typars *) + let ilTy = GenType amap v.Range TypeReprEnv.Empty v.Type (* TypeReprEnv.Empty ok, not expecting typars *) ctxt.LookupType ilTy // Lookup the compiled v value (as an object). match StorageForVal v.Range v eenv with @@ -6984,7 +6987,7 @@ let LookupGeneratedInfo (ctxt: ExecutionContext) (g:TcGlobals) eenv (v:Val) = /// The published API from the ILX code generator -type IlxAssemblyGenerator(amap: Import.ImportMap, tcGlobals: TcGlobals, tcVal : ConstraintSolver.TcValF, ccu: Tast.CcuThunk) = +type IlxAssemblyGenerator(amap: ImportMap, tcGlobals: TcGlobals, tcVal : ConstraintSolver.TcValF, ccu: Tast.CcuThunk) = // The incremental state held by the ILX code generator let mutable ilxGenEnv = GetEmptyIlxGenEnv tcGlobals.ilg ccu @@ -7018,7 +7021,7 @@ type IlxAssemblyGenerator(amap: Import.ImportMap, tcGlobals: TcGlobals, tcVal : member __.ClearGeneratedValue (ctxt, v) = ClearGeneratedValue ctxt tcGlobals ilxGenEnv v /// Invert the compilation of the given value and return its current dynamic value and its compiled System.Type - member __.LookupGeneratedValue (ctxt, v) = LookupGeneratedValue amap ctxt tcGlobals ilxGenEnv v + member __.LookupGeneratedValue (ctxt, v) = LookupGeneratedValue amap ctxt ilxGenEnv v /// Create the CAS permission sets for an assembly fragment member __.CreatePermissionSets attribs = CreatePermissionSets tcGlobals amap ilxGenEnv attribs diff --git a/src/fsharp/IlxGen.fsi b/src/fsharp/IlxGen.fsi index b4726b00ba4..45d10b9ff6f 100644 --- a/src/fsharp/IlxGen.fsi +++ b/src/fsharp/IlxGen.fsi @@ -34,8 +34,6 @@ type internal IlxGenOptions = // Indicates the code generated is an interactive 'it' expression. We generate a setter to allow clearing of the underlying // storage, even though 'it' is not logically mutable isInteractiveItExpr : bool - // Indicates System.SerializableAttribute is available in the targeting framework - netFxHasSerializableAttribute : bool /// Indicates that, whenever possible, use callvirt instead of call alwaysCallVirt : bool } diff --git a/src/fsharp/LowerCallsAndSeqs.fs b/src/fsharp/LowerCallsAndSeqs.fs index 47a51a6cdec..54ab71b52b2 100644 --- a/src/fsharp/LowerCallsAndSeqs.fs +++ b/src/fsharp/LowerCallsAndSeqs.fs @@ -70,7 +70,7 @@ let LowerImplFile g ass = let mkLambdaNoType g m uv e = mkLambda m uv (e,tyOfExpr g e) -let mkUnitDelayLambda g m e = +let mkUnitDelayLambda (g: TcGlobals) m e = let uv,_ue = mkCompGenLocal m "unitVar" g.unit_ty mkLambdaNoType g m uv e diff --git a/src/fsharp/MethodCalls.fs b/src/fsharp/MethodCalls.fs index 30b2f12f0f2..6dbb02ef981 100644 --- a/src/fsharp/MethodCalls.fs +++ b/src/fsharp/MethodCalls.fs @@ -577,7 +577,7 @@ let BuildILMethInfoCall g amap m isProp (minfo:ILMethInfo) valUseFlags minst dir exprTy /// Build a call to the System.Object constructor taking no arguments, -let BuildObjCtorCall g m = +let BuildObjCtorCall (g: TcGlobals) m = let ilMethRef = (mkILCtorMethSpecForTy(g.ilg.typ_Object,[])).MethodRef Expr.Op(TOp.ILCall(false,false,false,false,CtorValUsedAsSuperInit,false,true,ilMethRef,[],[],[g.obj_ty]),[],[],m) diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index 931d5c7553b..53241837f71 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -609,15 +609,15 @@ let (|StripUnionCaseValue|_|) ev = | UnionCaseValue (c,info) -> Some (c,info) | _ -> None -let mkBoolVal g n = ConstValue(Const.Bool n, g.bool_ty) -let mkInt8Val g n = ConstValue(Const.SByte n, g.sbyte_ty) -let mkInt16Val g n = ConstValue(Const.Int16 n, g.int16_ty) -let mkInt32Val g n = ConstValue(Const.Int32 n, g.int32_ty) -let mkInt64Val g n = ConstValue(Const.Int64 n, g.int64_ty) -let mkUInt8Val g n = ConstValue(Const.Byte n, g.byte_ty) -let mkUInt16Val g n = ConstValue(Const.UInt16 n, g.uint16_ty) -let mkUInt32Val g n = ConstValue(Const.UInt32 n, g.uint32_ty) -let mkUInt64Val g n = ConstValue(Const.UInt64 n, g.uint64_ty) +let mkBoolVal (g: TcGlobals) n = ConstValue(Const.Bool n, g.bool_ty) +let mkInt8Val (g: TcGlobals) n = ConstValue(Const.SByte n, g.sbyte_ty) +let mkInt16Val (g: TcGlobals) n = ConstValue(Const.Int16 n, g.int16_ty) +let mkInt32Val (g: TcGlobals) n = ConstValue(Const.Int32 n, g.int32_ty) +let mkInt64Val (g: TcGlobals) n = ConstValue(Const.Int64 n, g.int64_ty) +let mkUInt8Val (g: TcGlobals) n = ConstValue(Const.Byte n, g.byte_ty) +let mkUInt16Val (g: TcGlobals) n = ConstValue(Const.UInt16 n, g.uint16_ty) +let mkUInt32Val (g: TcGlobals) n = ConstValue(Const.UInt32 n, g.uint32_ty) +let mkUInt64Val (g: TcGlobals) n = ConstValue(Const.UInt64 n, g.uint64_ty) let (|StripInt32Value|_|) = function StripConstValue(Const.Int32 n) -> Some n | _ -> None @@ -1530,7 +1530,7 @@ let (|AnyQueryBuilderOpTrans|_|) g = function Some (src,(fun newSource -> Expr.App(v,vty,tyargs,[builder; replaceArgs(newSource::rest)],m))) | _ -> None -let mkUnitDelayLambda g m e = +let mkUnitDelayLambda (g: TcGlobals) m e = let uv,_ = mkCompGenLocal m "unitVar" g.unit_ty mkLambda m uv (e,tyOfExpr g e) diff --git a/src/fsharp/PatternMatchCompilation.fs b/src/fsharp/PatternMatchCompilation.fs index fc8f526c6e7..8c5dddcf753 100644 --- a/src/fsharp/PatternMatchCompilation.fs +++ b/src/fsharp/PatternMatchCompilation.fs @@ -360,7 +360,7 @@ let rec removeActive x l = //--------------------------------------------------------------------------- // tpinst is required because the pattern is specified w.r.t. generalized type variables. -let getDiscrimOfPattern g tpinst t = +let getDiscrimOfPattern (g: TcGlobals) tpinst t = match t with | TPat_null _m -> Some(Test.IsNull) @@ -386,7 +386,7 @@ let constOfDiscrim discrim = let constOfCase (c: DecisionTreeCase) = constOfDiscrim c.Discriminator /// Compute pattern identity -let discrimsEq g d1 d2 = +let discrimsEq (g: TcGlobals) d1 d2 = match d1,d2 with | Test.UnionCase (c1,_), Test.UnionCase(c2,_) -> g.unionCaseRefEq c1 c2 | Test.ArrayLength (n1,_), Test.ArrayLength(n2,_) -> (n1=n2) diff --git a/src/fsharp/QuotationTranslator.fs b/src/fsharp/QuotationTranslator.fs index 51261f1523c..d8dcb455eab 100644 --- a/src/fsharp/QuotationTranslator.fs +++ b/src/fsharp/QuotationTranslator.fs @@ -52,7 +52,7 @@ type QuotationGenerationScope = quotationFormat : QuotationSerializationFormat mutable emitDebugInfoInQuotations : bool } - static member Create (g, amap, scope, isReflectedDefinition) = + static member Create (g: TcGlobals, amap, scope, isReflectedDefinition) = { g = g scope=scope amap=amap diff --git a/src/fsharp/TastOps.fs b/src/fsharp/TastOps.fs index 55673efce84..80d298e1d4a 100644 --- a/src/fsharp/TastOps.fs +++ b/src/fsharp/TastOps.fs @@ -375,8 +375,8 @@ let mkTyconRefInst (tcref:TyconRef) tinst = mkTyconInst tcref.Deref tinst // Basic equalites //--------------------------------------------------------------------------- -let tyconRefEq g tcref1 tcref2 = primEntityRefEq g.compilingFslib g.fslibCcu tcref1 tcref2 -let valRefEq g vref1 vref2 = primValRefEq g.compilingFslib g.fslibCcu vref1 vref2 +let tyconRefEq (g:TcGlobals) tcref1 tcref2 = primEntityRefEq g.compilingFslib g.fslibCcu tcref1 tcref2 +let valRefEq (g:TcGlobals) vref1 vref2 = primValRefEq g.compilingFslib g.fslibCcu vref1 vref2 //--------------------------------------------------------------------------- // Remove inference equations and abbreviations from units @@ -538,10 +538,10 @@ let tryNormalizeMeasureInType g ty = // Some basic type builders //--------------------------------------------------------------------------- -let mkNativePtrTy g ty = TType_app (g.nativeptr_tcr, [ty]) -let mkByrefTy g ty = TType_app (g.byref_tcr, [ty]) +let mkNativePtrTy (g:TcGlobals) ty = TType_app (g.nativeptr_tcr, [ty]) +let mkByrefTy (g:TcGlobals) ty = TType_app (g.byref_tcr, [ty]) -let mkArrayTy g rank ty m = +let mkArrayTy (g:TcGlobals) rank ty m = if rank < 1 || rank > 32 then // TODO : Provide a better message for zero/negative inputs here. errorR(Error(FSComp.SR.tastopsMaxArrayThirtyTwo(),m)); @@ -577,7 +577,7 @@ let isCompiledTupleTyconRef g tcref = tyconRefEq g g.struct_tuple8_tcr x) -> true | _ -> false -let mkCompiledTupleTyconRef g isStruct tys = +let mkCompiledTupleTyconRef (g:TcGlobals) isStruct tys = let n = List.length tys if n = 1 then (if isStruct then g.struct_tuple1_tcr else g.ref_tuple1_tcr) elif n = 2 then (if isStruct then g.struct_tuple2_tcr else g.ref_tuple2_tcr) @@ -614,7 +614,7 @@ let reduceTyconAbbrev (tycon:Tycon) tyargs = let reduceTyconRefAbbrev (tcref:TyconRef) tyargs = reduceTyconAbbrev tcref.Deref tyargs -let reduceTyconMeasureableOrProvided g (tycon:Tycon) tyargs = +let reduceTyconMeasureableOrProvided (g:TcGlobals) (tycon:Tycon) tyargs = ignore g let repr = tycon.TypeReprInfo match repr with @@ -653,7 +653,7 @@ let evalTupInfoIsStruct aexpr = /// and measureable types (float<_>). /// It also optionally erases all "compilation representations", i.e. function and /// tuple types, and also "nativeptr<'T> --> System.IntPtr" -let rec stripTyEqnsAndErase eraseFuncAndTuple g ty = +let rec stripTyEqnsAndErase eraseFuncAndTuple (g:TcGlobals) ty = let ty = stripTyEqns g ty match ty with | TType_app (tcref,args) -> @@ -1176,8 +1176,8 @@ let isBeingGeneralized tp typeScheme = // Build conditional expressions... //------------------------------------------------------------------------- -let mkLazyAnd g m e1 e2 = mkCond NoSequencePointAtStickyBinding SuppressSequencePointAtTarget m g.bool_ty e1 e2 (Expr.Const(Const.Bool false,m,g.bool_ty)) -let mkLazyOr g m e1 e2 = mkCond NoSequencePointAtStickyBinding SuppressSequencePointAtTarget m g.bool_ty e1 (Expr.Const(Const.Bool true,m,g.bool_ty)) e2 +let mkLazyAnd (g:TcGlobals) m e1 e2 = mkCond NoSequencePointAtStickyBinding SuppressSequencePointAtTarget m g.bool_ty e1 e2 (Expr.Const(Const.Bool false,m,g.bool_ty)) +let mkLazyOr (g:TcGlobals) m e1 e2 = mkCond NoSequencePointAtStickyBinding SuppressSequencePointAtTarget m g.bool_ty e1 (Expr.Const(Const.Bool true,m,g.bool_ty)) e2 let mkCoerceExpr(e,to_ty,m,from_ty) = Expr.Op (TOp.Coerce,[to_ty;from_ty],[e],m) @@ -1222,20 +1222,20 @@ let mkUnionCaseFieldSet (e1,cref,tinst,j,e2,m) = Expr.Op (TOp.UnionCaseF let mkExnCaseFieldGet (e1,ecref,j,m) = Expr.Op (TOp.ExnFieldGet(ecref,j), [],[e1],m) let mkExnCaseFieldSet (e1,ecref,j,e2,m) = Expr.Op (TOp.ExnFieldSet(ecref,j), [],[e1;e2],m) -let mkDummyLambda g (e:Expr,ety) = +let mkDummyLambda (g:TcGlobals) (e:Expr,ety) = let m = e.Range mkLambda m (fst (mkCompGenLocal m "unitVar" g.unit_ty)) (e,ety) -let mkWhile g (spWhile,marker,e1,e2,m) = +let mkWhile (g:TcGlobals) (spWhile,marker,e1,e2,m) = Expr.Op (TOp.While (spWhile,marker),[] ,[mkDummyLambda g (e1,g.bool_ty);mkDummyLambda g (e2,g.unit_ty)],m) -let mkFor g (spFor,v,e1,dir,e2,e3:Expr,m) = +let mkFor (g:TcGlobals) (spFor,v,e1,dir,e2,e3:Expr,m) = Expr.Op (TOp.For (spFor,dir) ,[] ,[mkDummyLambda g (e1,g.int_ty) ;mkDummyLambda g (e2,g.int_ty);mkLambda e3.Range v (e3,g.unit_ty)],m) -let mkTryWith g (e1,vf,ef:Expr,vh,eh:Expr,m,ty,spTry,spWith) = +let mkTryWith g (e1,vf,ef:Expr,vh,eh:Expr,m,ty,spTry,spWith) = Expr.Op (TOp.TryCatch(spTry,spWith),[ty],[mkDummyLambda g (e1,ty);mkLambda ef.Range vf (ef,ty);mkLambda eh.Range vh (eh,ty)],m) -let mkTryFinally g (e1,e2,m,ty,spTry,spFinally) = +let mkTryFinally (g:TcGlobals) (e1,e2,m,ty,spTry,spFinally) = Expr.Op (TOp.TryFinally(spTry,spFinally),[ty],[mkDummyLambda g (e1,ty);mkDummyLambda g (e2,g.unit_ty)],m) let mkDefault (m,ty) = Expr.Const(Const.Zero,m,ty) @@ -1438,11 +1438,11 @@ let IsCompiledAsStaticPropertyWithField g (v:Val) = // Multi-dimensional array types... //------------------------------------------------------------------------- -let isArrayTyconRef g tcr = +let isArrayTyconRef (g:TcGlobals) tcr = g.il_arr_tcr_map |> Array.exists (tyconRefEq g tcr) -let rankOfArrayTyconRef g tcr = +let rankOfArrayTyconRef (g:TcGlobals) tcr = match g.il_arr_tcr_map |> Array.tryFindIndex (tyconRefEq g tcr) with | Some idx -> idx + 1 @@ -2144,7 +2144,7 @@ let ArgInfosOfMemberVal g (v:Val) = let ArgInfosOfMember g (vref: ValRef) = ArgInfosOfMemberVal g vref.Deref -let GetFSharpViewOfReturnType g retTy = +let GetFSharpViewOfReturnType (g:TcGlobals) retTy = match retTy with | None -> g.unit_ty | Some retTy -> retTy @@ -2550,7 +2550,7 @@ let trimPathByDisplayEnv denv path = | None -> if isNil path then "" else textOfPath path + "." -let superOfTycon g (tycon:Tycon) = +let superOfTycon (g:TcGlobals) (tycon:Tycon) = match tycon.TypeContents.tcaug_super with | None -> g.obj_ty | Some ty -> ty @@ -2559,10 +2559,14 @@ let superOfTycon g (tycon:Tycon) = // Detect attributes //---------------------------------------------------------------------------- +// AbsIL view of attributes (we read these from .NET binaries) +let isILAttribByName (tencl:string list, tname: string) (attr: ILAttribute) = + (attr.Method.EnclosingType.TypeSpec.Name = tname) && + (attr.Method.EnclosingType.TypeSpec.Enclosing = tencl) + // AbsIL view of attributes (we read these from .NET binaries) let isILAttrib (tref:ILTypeRef) (attr: ILAttribute) = - (attr.Method.EnclosingType.TypeSpec.Name = tref.Name) && - (attr.Method.EnclosingType.TypeSpec.Enclosing = tref.Enclosing) + isILAttribByName (tref.Enclosing, tref.Name) attr // REVIEW: consider supporting querying on Abstract IL custom attributes. // These linear iterations cost us a fair bit when there are lots of attributes @@ -2570,7 +2574,9 @@ let isILAttrib (tref:ILTypeRef) (attr: ILAttribute) = // results of attribute lookups in the TAST let HasILAttribute tref (attrs: ILAttributes) = List.exists (isILAttrib tref) attrs.AsList -let TryDecodeILAttribute g tref (attrs: ILAttributes) = +let HasILAttributeByName tname (attrs: ILAttributes) = List.exists (isILAttribByName ([],tname)) attrs.AsList + +let TryDecodeILAttribute (g:TcGlobals) tref (attrs: ILAttributes) = attrs.AsList |> List.tryPick(fun x -> if isILAttrib tref x then Some(decodeILAttribData g.ilg x) else None) // This one is done by name to ensure the compiler doesn't take a dependency on dereferencing a type that only exists in .NET 3.5 @@ -2704,17 +2710,17 @@ let StripSelfRefCell(g:TcGlobals,baseOrThisInfo:ValBaseOrThisInfo,tau: TType) : then destRefCellTy g tau else tau -let mkRefCellTy g ty = TType_app(g.refcell_tcr_nice,[ty]) +let mkRefCellTy (g:TcGlobals) ty = TType_app(g.refcell_tcr_nice,[ty]) -let mkLazyTy g ty = TType_app(g.lazy_tcr_nice,[ty]) +let mkLazyTy (g:TcGlobals) ty = TType_app(g.lazy_tcr_nice,[ty]) -let mkPrintfFormatTy g aty bty cty dty ety = TType_app(g.format_tcr, [aty;bty;cty;dty; ety]) +let mkPrintfFormatTy (g:TcGlobals) aty bty cty dty ety = TType_app(g.format_tcr, [aty;bty;cty;dty; ety]) -let mkOptionTy g ty = TType_app (g.option_tcr_nice, [ty]) +let mkOptionTy (g:TcGlobals) ty = TType_app (g.option_tcr_nice, [ty]) -let mkListTy g ty = TType_app (g.list_tcr_nice, [ty]) +let mkListTy (g:TcGlobals) ty = TType_app (g.list_tcr_nice, [ty]) -let isOptionTy g ty = +let isOptionTy (g:TcGlobals) ty = match tryDestAppTy g ty with | None -> false | Some tcref -> tyconRefEq g g.option_tcr_canon tcref @@ -2744,8 +2750,8 @@ let destLinqExpressionTy g ty = | Some ty -> ty | None -> failwith "destLinqExpressionTy: not an expression type" -let mkNoneCase g = mkUnionCaseRef g.option_tcr_canon "None" -let mkSomeCase g = mkUnionCaseRef g.option_tcr_canon "Some" +let mkNoneCase (g:TcGlobals) = mkUnionCaseRef g.option_tcr_canon "None" +let mkSomeCase (g:TcGlobals) = mkUnionCaseRef g.option_tcr_canon "Some" type ValRef with member vref.IsDispatchSlot = @@ -4337,7 +4343,7 @@ let InferArityOfExprBinding g (v:Val) e = // implementations //------------------------------------------------------------------------- -let underlyingTypeOfEnumTy g typ = +let underlyingTypeOfEnumTy (g: TcGlobals) typ = assert(isEnumTy g typ) let tycon = tyconOfAppTy g typ match metadataOfTy g typ with @@ -4546,7 +4552,7 @@ and copyAndRemapAndBindVal g compgen tmenv v = fixupValData g compgen tmenvinner v2 v2, tmenvinner -and remapExpr g (compgen:ValCopyFlag) (tmenv:Remap) x = +and remapExpr (g: TcGlobals) (compgen:ValCopyFlag) (tmenv:Remap) x = match x with // Binding constructs - see also dtrees below | Expr.Lambda (_,ctorThisValOpt, baseValOpt,vs,b,m,rty) -> @@ -5090,7 +5096,7 @@ let isExnAllocObservable (_ecref:TyconRef) = true // However, within the implementation code reads of the tail cell must in theory be treated // with caution. Hence we are conservative and within fslib we don't treat list // reads as if they were pure. -let isUnionCaseFieldMutable g (ucref:UnionCaseRef) n = +let isUnionCaseFieldMutable (g: TcGlobals) (ucref:UnionCaseRef) n = (g.compilingFslib && tyconRefEq g ucref.TyconRef g.list_tcr_canon && n = 1) || (ucref.FieldByIndex n).IsMutable @@ -5112,10 +5118,10 @@ let ComputeFieldName tycon f = let isQuotedExprTy g ty = match ty with AppTy g (tcref,_) -> tyconRefEq g tcref g.expr_tcr | _ -> false let destQuotedExprTy g ty = match ty with AppTy g (_,[ty]) -> ty | _ -> failwith "destQuotedExprTy" -let mkQuotedExprTy g ty = TType_app(g.expr_tcr,[ty]) -let mkRawQuotedExprTy g = TType_app(g.raw_expr_tcr,[]) +let mkQuotedExprTy (g:TcGlobals) ty = TType_app(g.expr_tcr,[ty]) +let mkRawQuotedExprTy (g:TcGlobals) = TType_app(g.raw_expr_tcr,[]) -let mkAnyTupledTy g tupInfo tys = +let mkAnyTupledTy (g:TcGlobals) tupInfo tys = match tys with | [] -> g.unit_ty | [h] -> h @@ -5125,8 +5131,8 @@ let mkRefTupledTy g tys = mkAnyTupledTy g tupInfoRef tys let mkRefTupledVarsTy g vs = mkRefTupledTy g (typesOfVals vs) let mkMethodTy g argtys rty = mkIteratedFunTy (List.map (mkRefTupledTy g) argtys) rty -let mkArrayType g ty = TType_app (g.array_tcr_nice, [ty]) -let mkByteArrayTy g = mkArrayType g g.byte_ty +let mkArrayType (g:TcGlobals) ty = TType_app (g.array_tcr_nice, [ty]) +let mkByteArrayTy (g:TcGlobals) = mkArrayType g g.byte_ty //-------------------------------------------------------------------------- @@ -5432,7 +5438,7 @@ let CanTakeAddressOfImmutableVal g (v:ValRef) mut = | PossiblyMutates -> isRecdOrStructTyImmutable g v.Type | DefinitelyMutates -> false) -let MustTakeAddressOfVal g (v:ValRef) = +let MustTakeAddressOfVal (g:TcGlobals) (v:ValRef) = v.IsMutable && // We can only take the address of mutable values in the same assembly valRefInThisAssembly g.compilingFslib v @@ -5444,13 +5450,13 @@ let MustTakeAddressOfRecdField (rf: RecdField) = let MustTakeAddressOfRecdFieldRef (rfref: RecdFieldRef) = MustTakeAddressOfRecdField rfref.RecdField -let CanTakeAddressOfRecdFieldRef g (rfref: RecdFieldRef) mut tinst = +let CanTakeAddressOfRecdFieldRef (g:TcGlobals) (rfref: RecdFieldRef) mut tinst = mut <> DefinitelyMutates && // We only do this if the field is defined in this assembly because we can't take adddresses across assemblies for immutable fields entityRefInThisAssembly g.compilingFslib rfref.TyconRef && isRecdOrStructTyImmutable g (actualTyOfRecdFieldRef rfref tinst) -let CanTakeAddressOfUnionFieldRef g (uref: UnionCaseRef) mut tinst cidx = +let CanTakeAddressOfUnionFieldRef (g:TcGlobals) (uref: UnionCaseRef) mut tinst cidx = mut <> DefinitelyMutates && // We only do this if the field is defined in this assembly because we can't take adddresses across assemblies for immutable fields entityRefInThisAssembly g.compilingFslib uref.TyconRef && @@ -5815,14 +5821,14 @@ let ExprStats x = // //------------------------------------------------------------------------- -let mkString g m n = Expr.Const(Const.String n,m,g.string_ty) -let mkBool g m b = Expr.Const(Const.Bool b,m,g.bool_ty) -let mkByte g m b = Expr.Const(Const.Byte b,m,g.byte_ty) -let mkUInt16 g m b = Expr.Const(Const.UInt16 b,m,g.uint16_ty) +let mkString (g:TcGlobals) m n = Expr.Const(Const.String n,m,g.string_ty) +let mkBool (g:TcGlobals) m b = Expr.Const(Const.Bool b,m,g.bool_ty) +let mkByte (g:TcGlobals) m b = Expr.Const(Const.Byte b,m,g.byte_ty) +let mkUInt16 (g:TcGlobals) m b = Expr.Const(Const.UInt16 b,m,g.uint16_ty) let mkTrue g m = mkBool g m true let mkFalse g m = mkBool g m false -let mkUnit g m = Expr.Const(Const.Unit,m,g.unit_ty) -let mkInt32 g m n = Expr.Const(Const.Int32 n,m,g.int32_ty) +let mkUnit (g:TcGlobals) m = Expr.Const(Const.Unit,m,g.unit_ty) +let mkInt32 (g:TcGlobals) m n = Expr.Const(Const.Int32 n,m,g.int32_ty) let mkInt g m n = mkInt32 g m (n) let mkZero g m = mkInt g m 0 let mkOne g m = mkInt g m 1 @@ -5838,11 +5844,11 @@ let destIDelegateEventType g ty = | [ty1] -> ty1 | _ -> failwith "destIDelegateEventType: internal error" else failwith "destIDelegateEventType: not an IDelegateEvent type" -let mkIEventType g ty1 ty2 = TType_app (g.fslib_IEvent2_tcr, [ty1;ty2]) -let mkIObservableType g ty1 = TType_app (g.tcref_IObservable, [ty1]) -let mkIObserverType g ty1 = TType_app (g.tcref_IObserver, [ty1]) +let mkIEventType (g:TcGlobals) ty1 ty2 = TType_app (g.fslib_IEvent2_tcr, [ty1;ty2]) +let mkIObservableType (g:TcGlobals) ty1 = TType_app (g.tcref_IObservable, [ty1]) +let mkIObserverType (g:TcGlobals) ty1 = TType_app (g.tcref_IObserver, [ty1]) -let mkRefCellContentsRef g = mkRecdFieldRef g.refcell_tcr_canon "contents" +let mkRefCellContentsRef (g:TcGlobals) = mkRecdFieldRef g.refcell_tcr_canon "contents" let mkSequential spSeq m e1 e2 = Expr.Sequential(e1,e2,NormalSeq,spSeq,m) let mkCompGenSequential m e1 e2 = mkSequential SuppressSequencePointOnExprOfSequential m e1 e2 @@ -5959,8 +5965,8 @@ let mkRefCell g m ty e = mkRecordExpr g (RecdExpr,g.refcell_tcr_canon,[ty],[ let mkRefCellGet g m ty e = mkRecdFieldGetViaExprAddr (e,mkRefCellContentsRef g,[ty],m) let mkRefCellSet g m ty e1 e2 = mkRecdFieldSetViaExprAddr (e1,mkRefCellContentsRef g,[ty],e2,m) -let mkNil g m ty = mkUnionCaseExpr (g.nil_ucref,[ty],[],m) -let mkCons g ty h t = mkUnionCaseExpr (g.cons_ucref,[ty],[h;t],unionRanges h.Range t.Range) +let mkNil (g:TcGlobals) m ty = mkUnionCaseExpr (g.nil_ucref,[ty],[],m) +let mkCons (g:TcGlobals) ty h t = mkUnionCaseExpr (g.cons_ucref,[ty],[h;t],unionRanges h.Range t.Range) let mkCompGenLocalAndInvisbleBind g nm m e = let locv,loce = mkCompGenLocal m nm (tyOfExpr g e) @@ -5977,52 +5983,57 @@ let mkUnbox ty e m = mkAsmExpr ([ unbox ], [ty],[e], [ ty ], m) let mkBox ty e m = mkAsmExpr ([box],[],[e],[ty],m) let mkIsInst ty e m = mkAsmExpr ([ isinst ], [ty],[e], [ ty ], m) -let mspec_Object_GetHashCode (ilg: ILGlobals) = IL.mkILNonGenericInstanceMethSpecInTy(ilg.typ_Object,"GetHashCode",[],ilg.typ_Int32) -let mspec_Type_GetTypeFromHandle (ilg: ILGlobals) = IL.mkILNonGenericStaticMethSpecInTy(ilg.typ_Type,"GetTypeFromHandle",[ilg.typ_RuntimeTypeHandle],ilg.typ_Type) -let mspec_String_Length (ilg: ILGlobals) = mkILNonGenericInstanceMethSpecInTy (ilg.typ_String, "get_Length", [], ilg.typ_Int32) +let mspec_Type_GetTypeFromHandle (g: TcGlobals) = IL.mkILNonGenericStaticMethSpecInTy(g.ilg.typ_Type,"GetTypeFromHandle",[g.iltyp_RuntimeTypeHandle],g.ilg.typ_Type) +let mspec_String_Length (g: TcGlobals) = mkILNonGenericInstanceMethSpecInTy (g.ilg.typ_String, "get_Length", [], g.ilg.typ_Int32) + +let fspec_Missing_Value (g: TcGlobals) = IL.mkILFieldSpecInTy(g.iltyp_Missing, "Value", g.iltyp_Missing) + +let mkInitializeArrayMethSpec (g: TcGlobals) = + mkILNonGenericStaticMethSpecInTy(mkILNonGenericBoxedTy(g.MkSysILTypeRef "System.Runtime.CompilerServices.RuntimeHelpers"),"InitializeArray", [g.ilg.typ_Array;g.iltyp_RuntimeFieldHandle], ILType.Void) -let fspec_Missing_Value (ilg: ILGlobals) = IL.mkILFieldSpecInTy(ilg.typ_Missing, "Value", ilg.typ_Missing) +let mkInvalidCastExnNewobj (g: TcGlobals) = + mkNormalNewobj (mkILCtorMethSpecForTy (mkILNonGenericBoxedTy (g.MkSysILTypeRef "System.InvalidCastException"), [])) let typedExprForIntrinsic _g m (IntrinsicValRef(_,_,_,ty,_) as i) = let vref = ValRefForIntrinsic i exprForValRef m vref,ty -let mkCallGetGenericComparer g m = typedExprForIntrinsic g m g.get_generic_comparer_info |> fst -let mkCallGetGenericEREqualityComparer g m = typedExprForIntrinsic g m g.get_generic_er_equality_comparer_info |> fst -let mkCallGetGenericPEREqualityComparer g m = typedExprForIntrinsic g m g.get_generic_per_equality_comparer_info |> fst -let mkCallUnbox g m ty e1 = mkApps g (typedExprForIntrinsic g m g.unbox_info, [[ty]], [ e1 ], m) -let mkCallUnboxFast g m ty e1 = mkApps g (typedExprForIntrinsic g m g.unbox_fast_info, [[ty]], [ e1 ], m) -let mkCallTypeTest g m ty e1 = mkApps g (typedExprForIntrinsic g m g.istype_info, [[ty]], [ e1 ], m) -let mkCallTypeOf g m ty = mkApps g (typedExprForIntrinsic g m g.typeof_info, [[ty]], [ ], m) -let mkCallTypeDefOf g m ty = mkApps g (typedExprForIntrinsic g m g.typedefof_info, [[ty]], [ ], m) +let mkCallGetGenericComparer (g:TcGlobals) m = typedExprForIntrinsic g m g.get_generic_comparer_info |> fst +let mkCallGetGenericEREqualityComparer (g:TcGlobals) m = typedExprForIntrinsic g m g.get_generic_er_equality_comparer_info |> fst +let mkCallGetGenericPEREqualityComparer (g:TcGlobals) m = typedExprForIntrinsic g m g.get_generic_per_equality_comparer_info |> fst +let mkCallUnbox (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.unbox_info, [[ty]], [ e1 ], m) +let mkCallUnboxFast (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.unbox_fast_info, [[ty]], [ e1 ], m) +let mkCallTypeTest (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.istype_info, [[ty]], [ e1 ], m) +let mkCallTypeOf (g:TcGlobals) m ty = mkApps g (typedExprForIntrinsic g m g.typeof_info, [[ty]], [ ], m) +let mkCallTypeDefOf (g:TcGlobals) m ty = mkApps g (typedExprForIntrinsic g m g.typedefof_info, [[ty]], [ ], m) -let mkCallDispose g m ty e1 = mkApps g (typedExprForIntrinsic g m g.dispose_info, [[ty]], [ e1 ], m) -let mkCallSeq g m ty e1 = mkApps g (typedExprForIntrinsic g m g.seq_info, [[ty]], [ e1 ], m) -let mkCallCreateInstance g m ty = mkApps g (typedExprForIntrinsic g m g.create_instance_info, [[ty]], [ mkUnit g m ], m) +let mkCallDispose (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.dispose_info, [[ty]], [ e1 ], m) +let mkCallSeq (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.seq_info, [[ty]], [ e1 ], m) +let mkCallCreateInstance (g:TcGlobals) m ty = mkApps g (typedExprForIntrinsic g m g.create_instance_info, [[ty]], [ mkUnit g m ], m) -let mkCallGetQuerySourceAsEnumerable g m ty1 ty2 e1 = mkApps g (typedExprForIntrinsic g m g.query_source_as_enum_info, [[ty1;ty2]], [ e1; mkUnit g m ], m) -let mkCallNewQuerySource g m ty1 ty2 e1 = mkApps g (typedExprForIntrinsic g m g.new_query_source_info, [[ty1;ty2]], [ e1 ], m) +let mkCallGetQuerySourceAsEnumerable (g:TcGlobals) m ty1 ty2 e1 = mkApps g (typedExprForIntrinsic g m g.query_source_as_enum_info, [[ty1;ty2]], [ e1; mkUnit g m ], m) +let mkCallNewQuerySource (g:TcGlobals) m ty1 ty2 e1 = mkApps g (typedExprForIntrinsic g m g.new_query_source_info, [[ty1;ty2]], [ e1 ], m) -let mkCallCreateEvent g m ty1 ty2 e1 e2 e3 = mkApps g (typedExprForIntrinsic g m g.create_event_info, [[ty1;ty2]], [ e1;e2;e3 ], m) -let mkCallGenericComparisonWithComparerOuter g m ty comp e1 e2 = mkApps g (typedExprForIntrinsic g m g.generic_comparison_withc_outer_info, [[ty]], [ comp;e1;e2 ], m) -let mkCallEqualsOperator g m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.equals_operator_info, [[ty]], [ e1;e2 ], m) -let mkCallGenericEqualityEROuter g m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.generic_equality_er_outer_info, [[ty]], [ e1;e2 ], m) -let mkCallGenericEqualityWithComparerOuter g m ty comp e1 e2 = mkApps g (typedExprForIntrinsic g m g.generic_equality_withc_outer_info, [[ty]], [comp;e1;e2], m) -let mkCallGenericHashWithComparerOuter g m ty comp e1 = mkApps g (typedExprForIntrinsic g m g.generic_hash_withc_outer_info, [[ty]], [comp;e1], m) +let mkCallCreateEvent (g:TcGlobals) m ty1 ty2 e1 e2 e3 = mkApps g (typedExprForIntrinsic g m g.create_event_info, [[ty1;ty2]], [ e1;e2;e3 ], m) +let mkCallGenericComparisonWithComparerOuter (g:TcGlobals) m ty comp e1 e2 = mkApps g (typedExprForIntrinsic g m g.generic_comparison_withc_outer_info, [[ty]], [ comp;e1;e2 ], m) +let mkCallEqualsOperator (g:TcGlobals) m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.equals_operator_info, [[ty]], [ e1;e2 ], m) +let mkCallGenericEqualityEROuter (g:TcGlobals) m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.generic_equality_er_outer_info, [[ty]], [ e1;e2 ], m) +let mkCallGenericEqualityWithComparerOuter (g:TcGlobals) m ty comp e1 e2 = mkApps g (typedExprForIntrinsic g m g.generic_equality_withc_outer_info, [[ty]], [comp;e1;e2], m) +let mkCallGenericHashWithComparerOuter (g:TcGlobals) m ty comp e1 = mkApps g (typedExprForIntrinsic g m g.generic_hash_withc_outer_info, [[ty]], [comp;e1], m) -let mkCallSubtractionOperator g m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.unchecked_subtraction_info, [[ty; ty; ty]], [e1;e2], m) +let mkCallSubtractionOperator (g:TcGlobals) m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.unchecked_subtraction_info, [[ty; ty; ty]], [e1;e2], m) -let mkCallArrayLength g m ty el = mkApps g (typedExprForIntrinsic g m g.array_length_info, [[ty]], [el], m) -let mkCallArrayGet g m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.array_get_info, [[ty]], [ e1 ; e2 ], m) -let mkCallArray2DGet g m ty e1 idx1 idx2 = mkApps g (typedExprForIntrinsic g m g.array2D_get_info, [[ty]], [ e1 ; idx1; idx2 ], m) -let mkCallArray3DGet g m ty e1 idx1 idx2 idx3 = mkApps g (typedExprForIntrinsic g m g.array3D_get_info, [[ty]], [ e1 ; idx1; idx2; idx3 ], m) -let mkCallArray4DGet g m ty e1 idx1 idx2 idx3 idx4 = mkApps g (typedExprForIntrinsic g m g.array4D_get_info, [[ty]], [ e1 ; idx1; idx2; idx3; idx4 ], m) -let mkCallNewDecimal g m (e1,e2,e3,e4,e5) = mkApps g (typedExprForIntrinsic g m g.new_decimal_info, [], [ e1;e2;e3;e4;e5 ], m) +let mkCallArrayLength (g:TcGlobals) m ty el = mkApps g (typedExprForIntrinsic g m g.array_length_info, [[ty]], [el], m) +let mkCallArrayGet (g:TcGlobals) m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.array_get_info, [[ty]], [ e1 ; e2 ], m) +let mkCallArray2DGet (g:TcGlobals) m ty e1 idx1 idx2 = mkApps g (typedExprForIntrinsic g m g.array2D_get_info, [[ty]], [ e1 ; idx1; idx2 ], m) +let mkCallArray3DGet (g:TcGlobals) m ty e1 idx1 idx2 idx3 = mkApps g (typedExprForIntrinsic g m g.array3D_get_info, [[ty]], [ e1 ; idx1; idx2; idx3 ], m) +let mkCallArray4DGet (g:TcGlobals) m ty e1 idx1 idx2 idx3 idx4 = mkApps g (typedExprForIntrinsic g m g.array4D_get_info, [[ty]], [ e1 ; idx1; idx2; idx3; idx4 ], m) +let mkCallNewDecimal (g:TcGlobals) m (e1,e2,e3,e4,e5) = mkApps g (typedExprForIntrinsic g m g.new_decimal_info, [], [ e1;e2;e3;e4;e5 ], m) -let mkCallNewFormat g m aty bty cty dty ety e1 = mkApps g (typedExprForIntrinsic g m g.new_format_info, [[aty;bty;cty;dty;ety]], [ e1 ], m) -let mkCallRaise g m aty e1 = mkApps g (typedExprForIntrinsic g m g.raise_info, [[aty]], [ e1 ], m) +let mkCallNewFormat (g:TcGlobals) m aty bty cty dty ety e1 = mkApps g (typedExprForIntrinsic g m g.new_format_info, [[aty;bty;cty;dty;ety]], [ e1 ], m) +let mkCallRaise (g:TcGlobals) m aty e1 = mkApps g (typedExprForIntrinsic g m g.raise_info, [[aty]], [ e1 ], m) let TryEliminateDesugaredConstants g m c = match c with @@ -6036,8 +6047,8 @@ let TryEliminateDesugaredConstants g m c = | _ -> None -let mkSeqTy g ty = mkAppTy g.seq_tcr [ty] -let mkIEnumeratorTy g ty = mkAppTy g.tcref_System_Collections_Generic_IEnumerator [ty] +let mkSeqTy (g:TcGlobals) ty = mkAppTy g.seq_tcr [ty] +let mkIEnumeratorTy (g:TcGlobals) ty = mkAppTy g.tcref_System_Collections_Generic_IEnumerator [ty] let mkCallSeqCollect g m alphaTy betaTy arg1 arg2 = let enumty2 = try rangeOfFunTy g (tyOfExpr g arg1) with _ -> (* defensive programming *) (mkSeqTy g betaTy) @@ -6090,7 +6101,7 @@ let mkCallDeserializeQuotationFSharp40Plus g m e1 e2 e3 e4 e5 = let mkCallCastQuotation g m ty e1 = mkApps g (typedExprForIntrinsic g m g.cast_quotation_info, [[ty]], [ e1 ], m) -let mkCallLiftValueWithName g m ty nm e1 = +let mkCallLiftValueWithName (g:TcGlobals) m ty nm e1 = let vref = ValRefForIntrinsic g.lift_value_with_name_info // Use "Expr.ValueWithName" if it exists in FSharp.Core match vref.TryDeref with @@ -6130,7 +6141,7 @@ let mkLazyForce g m ty e = mkApps g (typedExprForIntrinsic g m g.lazy_force_info let mkGetString g m e1 e2 = mkApps g (typedExprForIntrinsic g m g.getstring_info, [], [e1;e2], m) let mkGetStringChar = mkGetString let mkGetStringLength g m e = - let mspec = mspec_String_Length g.ilg + let mspec = mspec_String_Length g /// ILCall(useCallvirt,isProtected,valu,newobj,valUseFlags,isProp,noTailCall,mref,actualTypeInst,actualMethInst, retTy) Expr.Op(TOp.ILCall(false,false,false,false,ValUseFlag.NormalValUse,true,false,mspec.MethodRef,[],[],[g.int32_ty]),[],[e],m) @@ -6141,23 +6152,23 @@ let mkGetStringLength g m e = // Hence each of the following are marked with places where they are generated. // Generated by the optimizer and the encoding of 'for' loops -let mkDecr g m e = mkAsmExpr([ IL.AI_sub ],[],[e; mkOne g m],[g.int_ty],m) -let mkIncr g m e = mkAsmExpr([ IL.AI_add ],[],[mkOne g m; e],[g.int_ty],m) +let mkDecr (g:TcGlobals) m e = mkAsmExpr([ IL.AI_sub ],[],[e; mkOne g m],[g.int_ty],m) +let mkIncr (g:TcGlobals) m e = mkAsmExpr([ IL.AI_add ],[],[mkOne g m; e],[g.int_ty],m) // Generated by the pattern match compiler and the optimizer for // 1. array patterns // 2. optimizations associated with getting 'for' loops into the shape expected by the JIT. // // NOTE: The conv.i4 assumes that int_ty is int32. Note: ldlen returns native UNSIGNED int -let mkLdlen g m arre = mkAsmExpr ([ IL.I_ldlen; (IL.AI_conv IL.DT_I4) ],[],[ arre ], [ g.int_ty ], m) +let mkLdlen (g:TcGlobals) m arre = mkAsmExpr ([ IL.I_ldlen; (IL.AI_conv IL.DT_I4) ],[],[ arre ], [ g.int_ty ], m) let mkLdelem (_g:TcGlobals) m ty arre idxe = mkAsmExpr ([ IL.I_ldelem_any (ILArrayShape.SingleDimensional, mkILTyvarTy 0us) ],[ty],[ arre;idxe ], [ ty ], m) // This is generated in equality/compare/hash augmentations and in the pattern match compiler. // It is understood by the quotation processor and turned into "Equality" nodes. // // Note: this is IL assembly code, don't go inserting this in expressions which will be exposed via quotations -let mkILAsmCeq g m e1 e2 = mkAsmExpr ([ IL.AI_ceq ],[], [e1; e2],[g.bool_ty],m) -let mkILAsmClt g m e1 e2 = mkAsmExpr ([ IL.AI_clt ],[], [e1; e2],[g.bool_ty],m) +let mkILAsmCeq (g:TcGlobals) m e1 e2 = mkAsmExpr ([ IL.AI_ceq ],[], [e1; e2],[g.bool_ty],m) +let mkILAsmClt (g:TcGlobals) m e1 e2 = mkAsmExpr ([ IL.AI_clt ],[], [e1; e2],[g.bool_ty],m) // This is generated in the initialization of the "ctorv" field in the typechecker's compilation of // an implicit class construction. @@ -6175,7 +6186,7 @@ let destThrow = function let isThrow x = Option.isSome (destThrow x) // rethrow - parsed as library call - internally represented as op form. -let mkReraiseLibCall g ty m = let ve,vt = typedExprForIntrinsic g m g.reraise_info in Expr.App(ve,vt,[ty],[mkUnit g m],m) +let mkReraiseLibCall (g:TcGlobals) ty m = let ve,vt = typedExprForIntrinsic g m g.reraise_info in Expr.App(ve,vt,[ty],[mkUnit g m],m) let mkReraise m returnTy = Expr.Op (TOp.Reraise,[returnTy],[],m) (* could suppress unitArg *) //---------------------------------------------------------------------------- @@ -6187,12 +6198,12 @@ let tnameCompilationArgumentCountsAttr = FSharpLib.Core + ".CompilationArgumentC let tnameCompilationMappingAttr = FSharpLib.Core + ".CompilationMappingAttribute" let tnameSourceConstructFlags = FSharpLib.Core + ".SourceConstructFlags" -let tref_CompilationArgumentCountsAttr g = mkILTyRef (g.fslibCcu.ILScopeRef, tnameCompilationArgumentCountsAttr) -let tref_CompilationMappingAttr g = mkILTyRef (g.fslibCcu.ILScopeRef, tnameCompilationMappingAttr) -let tref_CompilationSourceNameAttr g = mkILTyRef (g.fslibCcu.ILScopeRef, tnameCompilationSourceNameAttr) -let tref_SourceConstructFlags g = mkILTyRef (g.fslibCcu.ILScopeRef, tnameSourceConstructFlags) +let tref_CompilationArgumentCountsAttr (g:TcGlobals) = mkILTyRef (g.fslibCcu.ILScopeRef, tnameCompilationArgumentCountsAttr) +let tref_CompilationMappingAttr (g:TcGlobals) = mkILTyRef (g.fslibCcu.ILScopeRef, tnameCompilationMappingAttr) +let tref_CompilationSourceNameAttr (g:TcGlobals) = mkILTyRef (g.fslibCcu.ILScopeRef, tnameCompilationSourceNameAttr) +let tref_SourceConstructFlags (g:TcGlobals) = mkILTyRef (g.fslibCcu.ILScopeRef, tnameSourceConstructFlags) -let mkCompilationMappingAttrPrim g k nums = +let mkCompilationMappingAttrPrim (g:TcGlobals) k nums = mkILCustomAttribute g.ilg (tref_CompilationMappingAttr g, ((mkILNonGenericValueTy (tref_SourceConstructFlags g)) :: (nums |> List.map (fun _ -> g.ilg.typ_Int32))), ((k :: nums) |> List.map (fun n -> ILAttribElem.Int32(n))), @@ -6201,17 +6212,17 @@ let mkCompilationMappingAttr g kind = mkCompilationMappingAttrPrim g kind [] let mkCompilationMappingAttrWithSeqNum g kind seqNum = mkCompilationMappingAttrPrim g kind [seqNum] let mkCompilationMappingAttrWithVariantNumAndSeqNum g kind varNum seqNum = mkCompilationMappingAttrPrim g kind [varNum;seqNum] -let mkCompilationArgumentCountsAttr g nums = +let mkCompilationArgumentCountsAttr (g:TcGlobals) nums = mkILCustomAttribute g.ilg (tref_CompilationArgumentCountsAttr g, [ mkILArr1DTy g.ilg.typ_Int32 ], [ILAttribElem.Array (g.ilg.typ_Int32, List.map (fun n -> ILAttribElem.Int32(n)) nums)], []) -let mkCompilationSourceNameAttr g n = +let mkCompilationSourceNameAttr (g:TcGlobals) n = mkILCustomAttribute g.ilg (tref_CompilationSourceNameAttr g, [ g.ilg.typ_String ], [ILAttribElem.String(Some n)], []) -let mkCompilationMappingAttrForQuotationResource g (nm, tys: ILTypeRef list) = +let mkCompilationMappingAttrForQuotationResource (g:TcGlobals) (nm, tys: ILTypeRef list) = mkILCustomAttribute g.ilg (tref_CompilationMappingAttr g, [ g.ilg.typ_String; mkILArr1DTy g.ilg.typ_Type ], [ ILAttribElem.String (Some nm); ILAttribElem.Array (g.ilg.typ_Type, [ for ty in tys -> ILAttribElem.TypeRef (Some ty) ]) ], @@ -6243,9 +6254,10 @@ let TryDecodeTypeProviderAssemblyAttr ilg (cattr:ILAttribute) = //---------------------------------------------------------------------------- let tname_SignatureDataVersionAttr = FSharpLib.Core + ".FSharpInterfaceDataVersionAttribute" +let tnames_SignatureDataVersionAttr = splitILTypeName tname_SignatureDataVersionAttr let tref_SignatureDataVersionAttr () = mkILTyRef(IlxSettings.ilxFsharpCoreLibScopeRef (), tname_SignatureDataVersionAttr) -let mkSignatureDataVersionAttr g ((v1,v2,v3,_) : ILVersionInfo) = +let mkSignatureDataVersionAttr (g:TcGlobals) ((v1,v2,v3,_) : ILVersionInfo) = mkILCustomAttribute g.ilg (tref_SignatureDataVersionAttr(), [g.ilg.typ_Int32;g.ilg.typ_Int32;g.ilg.typ_Int32], @@ -6254,11 +6266,10 @@ let mkSignatureDataVersionAttr g ((v1,v2,v3,_) : ILVersionInfo) = ILAttribElem.Int32 (int32 v3)],[]) let tname_AutoOpenAttr = FSharpLib.Core + ".AutoOpenAttribute" -let tref_AutoOpenAttr () = mkILTyRef(IlxSettings.ilxFsharpCoreLibScopeRef (), tname_AutoOpenAttr) -let IsSignatureDataVersionAttr cattr = isILAttrib (tref_SignatureDataVersionAttr ()) cattr +let IsSignatureDataVersionAttr cattr = isILAttribByName ([],tname_SignatureDataVersionAttr) cattr let TryFindAutoOpenAttr (ilg : IL.ILGlobals) cattr = - if isILAttrib (tref_AutoOpenAttr ()) cattr then + if isILAttribByName ([],tname_AutoOpenAttr) cattr then match decodeILAttribData ilg cattr with | [ILAttribElem.String s],_ -> s | [],_ -> None @@ -6268,11 +6279,10 @@ let TryFindAutoOpenAttr (ilg : IL.ILGlobals) cattr = else None -let tref_InternalsVisibleToAttr (ilg : IL.ILGlobals) = - ilg.mkSysILTypeRef "System.Runtime.CompilerServices.InternalsVisibleToAttribute" +let tname_InternalsVisibleToAttr = "System.Runtime.CompilerServices.InternalsVisibleToAttribute" let TryFindInternalsVisibleToAttr ilg cattr = - if isILAttrib (tref_InternalsVisibleToAttr ilg) cattr then + if isILAttribByName ([],tname_InternalsVisibleToAttr) cattr then match decodeILAttribData ilg cattr with | [ILAttribElem.String s],_ -> s | [],_ -> None @@ -6291,7 +6301,7 @@ let IsMatchingSignatureDataVersionAttr ilg ((v1,v2,v3,_) : ILVersionInfo) cattr warning(Failure(FSComp.SR.tastUnexpectedDecodeOfInterfaceDataVersionAttribute())); false -let mkCompilerGeneratedAttr g n = +let mkCompilerGeneratedAttr (g:TcGlobals) n = mkILCustomAttribute g.ilg (tref_CompilationMappingAttr g, [mkILNonGenericValueTy (tref_SourceConstructFlags g)],[ILAttribElem.Int32(n)],[]) //-------------------------------------------------------------------------- @@ -7152,9 +7162,9 @@ let mkNullTest g m e1 e2 e3 = let dtree = TDSwitch(e1, [TCase(Test.IsNull,tg3)],Some tg2,m) let expr = mbuilder.Close(dtree,m,tyOfExpr g e2) expr -let mkNonNullTest g m e = mkAsmExpr ([ IL.AI_ldnull ; IL.AI_cgt_un ],[], [e],[g.bool_ty],m) +let mkNonNullTest (g:TcGlobals) m e = mkAsmExpr ([ IL.AI_ldnull ; IL.AI_cgt_un ],[], [e],[g.bool_ty],m) let mkNonNullCond g m ty e1 e2 e3 = mkCond NoSequencePointAtStickyBinding SuppressSequencePointAtTarget m ty (mkNonNullTest g m e1) e2 e3 -let mkIfThen g m e1 e2 = mkCond NoSequencePointAtStickyBinding SuppressSequencePointAtTarget m g.unit_ty e1 e2 (mkUnit g m) +let mkIfThen (g:TcGlobals) m e1 e2 = mkCond NoSequencePointAtStickyBinding SuppressSequencePointAtTarget m g.unit_ty e1 e2 (mkUnit g m) let ModuleNameIsMangled g attrs = @@ -7270,7 +7280,7 @@ type ActivePatternElemRef with if n < 0 || n >= List.length nms then error(InternalError("name_of_apref: index out of range for active pattern reference", vref.Range)); List.item n nms -let mkChoiceTyconRef g m n = +let mkChoiceTyconRef (g:TcGlobals) m n = match n with | 0 | 1 -> error(InternalError("mkChoiceTyconRef",m)) | 2 -> g.choice2_tcr @@ -7281,7 +7291,7 @@ let mkChoiceTyconRef g m n = | 7 -> g.choice7_tcr | _ -> error(Error(FSComp.SR.tastActivePatternsLimitedToSeven(),m)) -let mkChoiceTy g m tinst = +let mkChoiceTy (g:TcGlobals) m tinst = match List.length tinst with | 0 -> g.unit_ty | 1 -> List.head tinst diff --git a/src/fsharp/TastOps.fsi b/src/fsharp/TastOps.fsi index ed924b26921..401fd322acc 100755 --- a/src/fsharp/TastOps.fsi +++ b/src/fsharp/TastOps.fsi @@ -1142,9 +1142,17 @@ val isQuotedExprTy : TcGlobals -> TType -> bool val destQuotedExprTy : TcGlobals -> TType -> TType val mkQuotedExprTy : TcGlobals -> TType -> TType val mkRawQuotedExprTy : TcGlobals -> TType -val mspec_Type_GetTypeFromHandle : ILGlobals -> ILMethodSpec -val fspec_Missing_Value : ILGlobals -> ILFieldSpec + +//------------------------------------------------------------------------- +// Primitives associated with IL code gen +//------------------------------------------------------------------------- + +val mspec_Type_GetTypeFromHandle : TcGlobals -> ILMethodSpec +val fspec_Missing_Value : TcGlobals -> ILFieldSpec +val mkInitializeArrayMethSpec: TcGlobals -> ILMethodSpec val mkByteArrayTy : TcGlobals -> TType +val mkInvalidCastExnNewobj: TcGlobals -> ILInstr + //------------------------------------------------------------------------- // Construct calls to some intrinsic functions diff --git a/src/fsharp/TcGlobals.fs b/src/fsharp/TcGlobals.fs index 2b64b4cab89..f60cf5047c1 100755 --- a/src/fsharp/TcGlobals.fs +++ b/src/fsharp/TcGlobals.fs @@ -31,7 +31,7 @@ let private envRange = rangeN DummyFileNameForRangesWithoutASpecificLocation 0 type public IntrinsicValRef = IntrinsicValRef of NonLocalEntityRef * string * bool * TType * ValLinkageFullKey -let ValRefForIntrinsic (IntrinsicValRef(mvr,_,_,_,key)) = mkNonLocalValRef mvr key +let ValRefForIntrinsic (IntrinsicValRef(mvr, _, _, _, key)) = mkNonLocalValRef mvr key //------------------------------------------------------------------------- // Access the initial environment: names @@ -77,7 +77,7 @@ module FSharpLib = // Access the initial environment: helpers to build references //------------------------------------------------------------------------- -let private mkNonGenericTy tcref = TType_app(tcref,[]) +let private mkNonGenericTy tcref = TType_app(tcref, []) let mkNonLocalTyconRef2 ccu path n = mkNonLocalTyconRef (mkNonLocalEntityRef ccu path) n @@ -92,488 +92,76 @@ let mk_MFControl_tcref ccu n = mkNonLocalTyconRef2 ccu FSharpLib.Contro type public BuiltinAttribInfo = | AttribInfo of ILTypeRef * TyconRef - member this.TyconRef = let (AttribInfo(_,tcref)) = this in tcref - member this.TypeRef = let (AttribInfo(tref,_)) = this in tref + member this.TyconRef = let (AttribInfo(_, tcref)) = this in tcref + member this.TypeRef = let (AttribInfo(tref, _)) = this in tref + +[] +let tname_DebuggerNonUserCodeAttribute = "System.Diagnostics.DebuggerNonUserCodeAttribute" +[] +let tname_DebuggableAttribute_DebuggingModes = "DebuggingModes" +[] +let tname_DebuggerHiddenAttribute = "System.Diagnostics.DebuggerHiddenAttribute" +[] +let tname_DebuggerDisplayAttribute = "System.Diagnostics.DebuggerDisplayAttribute" +[] +let tname_DebuggerTypeProxyAttribute = "System.Diagnostics.DebuggerTypeProxyAttribute" +[] +let tname_DebuggerStepThroughAttribute = "System.Diagnostics.DebuggerStepThroughAttribute" +[] +let tname_DebuggerBrowsableAttribute = "System.Diagnostics.DebuggerBrowsableAttribute" +[] +let tname_DebuggerBrowsableState = "System.Diagnostics.DebuggerBrowsableState" + +[] +let tname_StringBuilder = "System.Text.StringBuilder" +[] +let tname_IComparable = "System.IComparable" +[] +let tname_Exception = "System.Exception" +[] +let tname_Missing = "System.Reflection.Missing" +[] +let tname_Activator = "System.Activator" +[] +let tname_SerializationInfo = "System.Runtime.Serialization.SerializationInfo" +[] +let tname_StreamingContext = "System.Runtime.Serialization.StreamingContext" +[] +let tname_SecurityPermissionAttribute = "System.Security.Permissions.SecurityPermissionAttribute" +[] +let tname_Delegate = "System.Delegate" +[] +let tname_ValueType = "System.ValueType" +[] +let tname_Enum = "System.Enum" +[] +let tname_Array = "System.Array" +[] +let tname_RuntimeArgumentHandle = "System.RuntimeArgumentHandle" +[] +let tname_RuntimeTypeHandle = "System.RuntimeTypeHandle" +[] +let tname_RuntimeMethodHandle = "System.RuntimeMethodHandle" +[] +let tname_RuntimeFieldHandle = "System.RuntimeFieldHandle" +[] +let tname_CompilerGeneratedAttribute = "System.Runtime.CompilerServices.CompilerGeneratedAttribute" +[] +let tname_DebuggableAttribute = "System.Diagnostics.DebuggableAttribute" +[] +let tname_AsyncCallback = "System.AsyncCallback" +[] +let tname_IAsyncResult = "System.IAsyncResult" //------------------------------------------------------------------------- // Table of all these "globals" //------------------------------------------------------------------------- -[] -type public TcGlobals = - { ilg : ILGlobals - ilxPubCloEnv : EraseClosures.cenv - emitDebugInfoInQuotations : bool - compilingFslib: bool - mlCompatibility : bool - directoryToResolveRelativePaths : string - fslibCcu: CcuThunk - using40environment: bool - better_tcref_map: TyconRef -> TypeInst -> TType option - refcell_tcr_canon: TyconRef - option_tcr_canon : TyconRef - choice2_tcr : TyconRef - choice3_tcr : TyconRef - choice4_tcr : TyconRef - choice5_tcr : TyconRef - choice6_tcr : TyconRef - choice7_tcr : TyconRef - list_tcr_canon : TyconRef - set_tcr_canon : TyconRef - map_tcr_canon : TyconRef - lazy_tcr_canon : TyconRef +type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, directoryToResolveRelativePaths, + mlCompatibility: bool, isInteractive:bool, + tryFindSysTypeCcu, + emitDebugInfoInQuotations: bool, usesMscorlib: bool, noDebugData: bool) = - // These have a slightly different behaviour when compiling GetFSharpCoreLibraryName - // hence they are 'methods' on the TcGlobals structure. - - unionCaseRefEq : UnionCaseRef -> UnionCaseRef -> bool - valRefEq : ValRef -> ValRef -> bool - - refcell_tcr_nice: TyconRef - option_tcr_nice : TyconRef - list_tcr_nice : TyconRef - lazy_tcr_nice : TyconRef - - format_tcr : TyconRef - expr_tcr : TyconRef - raw_expr_tcr : TyconRef - nativeint_tcr : TyconRef - int32_tcr : TyconRef - int16_tcr : TyconRef - int64_tcr : TyconRef - uint16_tcr : TyconRef - uint32_tcr : TyconRef - uint64_tcr : TyconRef - sbyte_tcr : TyconRef - decimal_tcr : TyconRef - date_tcr : TyconRef - pdecimal_tcr : TyconRef - byte_tcr : TyconRef - bool_tcr : TyconRef - unit_tcr_canon : TyconRef - unit_tcr_nice : TyconRef - exn_tcr : TyconRef - char_tcr : TyconRef - float_tcr : TyconRef - float32_tcr : TyconRef - pfloat_tcr : TyconRef - pfloat32_tcr : TyconRef - pint_tcr : TyconRef - pint8_tcr : TyconRef - pint16_tcr : TyconRef - pint64_tcr : TyconRef - byref_tcr : TyconRef - nativeptr_tcr : TyconRef - ilsigptr_tcr : TyconRef - fastFunc_tcr : TyconRef - array_tcr_nice : TyconRef - seq_tcr : TyconRef - seq_base_tcr : TyconRef - measureproduct_tcr : TyconRef - measureinverse_tcr : TyconRef - measureone_tcr : TyconRef - il_arr_tcr_map : TyconRef[] - ref_tuple1_tcr : TyconRef - ref_tuple2_tcr : TyconRef - ref_tuple3_tcr : TyconRef - ref_tuple4_tcr : TyconRef - ref_tuple5_tcr : TyconRef - ref_tuple6_tcr : TyconRef - ref_tuple7_tcr : TyconRef - ref_tuple8_tcr : TyconRef - struct_tuple1_tcr : TyconRef - struct_tuple2_tcr : TyconRef - struct_tuple3_tcr : TyconRef - struct_tuple4_tcr : TyconRef - struct_tuple5_tcr : TyconRef - struct_tuple6_tcr : TyconRef - struct_tuple7_tcr : TyconRef - struct_tuple8_tcr : TyconRef - - tcref_IQueryable : TyconRef - tcref_IObservable : TyconRef - tcref_IObserver : TyconRef - fslib_IEvent2_tcr : TyconRef - fslib_IDelegateEvent_tcr: TyconRef - system_Nullable_tcref : TyconRef - system_GenericIComparable_tcref : TyconRef - system_GenericIEquatable_tcref : TyconRef - system_IndexOutOfRangeException_tcref : TyconRef - int_ty : TType - nativeint_ty : TType - unativeint_ty : TType - int32_ty : TType - int16_ty : TType - int64_ty : TType - uint16_ty : TType - uint32_ty : TType - uint64_ty : TType - sbyte_ty : TType - byte_ty : TType - bool_ty : TType - string_ty : TType - obj_ty : TType - unit_ty : TType - exn_ty : TType - char_ty : TType - decimal_ty : TType - float_ty : TType - float32_ty : TType - system_Array_typ : TType - system_Object_typ : TType - system_IDisposable_typ : TType - system_RuntimeHelpers_typ : TType - system_Value_typ : TType - system_Delegate_typ : TType - system_MulticastDelegate_typ : TType - system_Enum_typ : TType - system_Exception_typ : TType - system_Int32_typ : TType - system_String_typ : TType - system_String_tcref : TyconRef - system_Type_typ : TType - system_TypedReference_tcref : TyconRef option - system_ArgIterator_tcref : TyconRef option - system_Decimal_tcref : TyconRef - system_SByte_tcref : TyconRef - system_Int16_tcref : TyconRef - system_Int32_tcref : TyconRef - system_Int64_tcref : TyconRef - system_IntPtr_tcref : TyconRef - system_Bool_tcref : TyconRef - system_Char_tcref : TyconRef - system_Byte_tcref : TyconRef - system_UInt16_tcref : TyconRef - system_UInt32_tcref : TyconRef - system_UInt64_tcref : TyconRef - system_UIntPtr_tcref : TyconRef - system_Single_tcref : TyconRef - system_Double_tcref : TyconRef - system_RuntimeArgumentHandle_tcref : TyconRef option - system_RuntimeTypeHandle_typ : TType - system_RuntimeMethodHandle_typ : TType - system_MarshalByRefObject_tcref : TyconRef option - system_MarshalByRefObject_typ : TType option - system_Reflection_MethodInfo_typ : TType - system_Array_tcref : TyconRef - system_Object_tcref : TyconRef - system_Void_tcref : TyconRef - system_LinqExpression_tcref : TyconRef - mk_IComparable_ty : TType - mk_IStructuralComparable_ty : TType - mk_IStructuralEquatable_ty : TType - mk_IComparer_ty : TType - mk_IEqualityComparer_ty : TType - tcref_System_Collections_IComparer : TyconRef - tcref_System_Collections_IEqualityComparer : TyconRef - tcref_System_Collections_Generic_IEqualityComparer : TyconRef - tcref_System_Collections_Generic_Dictionary : TyconRef - tcref_System_IComparable : TyconRef - tcref_System_IStructuralComparable : TyconRef - tcref_System_IStructuralEquatable : TyconRef - tcref_LanguagePrimitives : TyconRef - attrib_CustomOperationAttribute : BuiltinAttribInfo - attrib_ProjectionParameterAttribute : BuiltinAttribInfo - attrib_AttributeUsageAttribute : BuiltinAttribInfo - attrib_ParamArrayAttribute : BuiltinAttribInfo - attrib_IDispatchConstantAttribute : BuiltinAttribInfo option - attrib_IUnknownConstantAttribute : BuiltinAttribInfo option - attrib_SystemObsolete : BuiltinAttribInfo - attrib_DllImportAttribute : BuiltinAttribInfo option - attrib_CompiledNameAttribute : BuiltinAttribInfo - attrib_NonSerializedAttribute : BuiltinAttribInfo option - attrib_AutoSerializableAttribute : BuiltinAttribInfo - attrib_StructLayoutAttribute : BuiltinAttribInfo - attrib_TypeForwardedToAttribute : BuiltinAttribInfo - attrib_ComVisibleAttribute : BuiltinAttribInfo - attrib_ComImportAttribute : BuiltinAttribInfo option - attrib_FieldOffsetAttribute : BuiltinAttribInfo - attrib_MarshalAsAttribute : BuiltinAttribInfo option - attrib_InAttribute : BuiltinAttribInfo option - attrib_OutAttribute : BuiltinAttribInfo - attrib_OptionalAttribute : BuiltinAttribInfo option - attrib_ThreadStaticAttribute : BuiltinAttribInfo option - attrib_SpecialNameAttribute : BuiltinAttribInfo option - attrib_VolatileFieldAttribute : BuiltinAttribInfo - attrib_ContextStaticAttribute : BuiltinAttribInfo option - attrib_FlagsAttribute : BuiltinAttribInfo - attrib_DefaultMemberAttribute : BuiltinAttribInfo - attrib_DebuggerDisplayAttribute : BuiltinAttribInfo - attrib_DebuggerTypeProxyAttribute : BuiltinAttribInfo - attrib_PreserveSigAttribute : BuiltinAttribInfo option - attrib_MethodImplAttribute : BuiltinAttribInfo - attrib_ExtensionAttribute : BuiltinAttribInfo - attrib_CallerLineNumberAttribute : BuiltinAttribInfo - attrib_CallerFilePathAttribute : BuiltinAttribInfo - attrib_CallerMemberNameAttribute : BuiltinAttribInfo - - tcref_System_Collections_Generic_IList : TyconRef - tcref_System_Collections_Generic_IReadOnlyList : TyconRef - tcref_System_Collections_Generic_ICollection : TyconRef - tcref_System_Collections_Generic_IReadOnlyCollection : TyconRef - tcref_System_Collections_Generic_IEnumerable : TyconRef - tcref_System_Collections_IEnumerable : TyconRef - tcref_System_Collections_Generic_IEnumerator : TyconRef - tcref_System_Attribute : TyconRef - - attrib_RequireQualifiedAccessAttribute : BuiltinAttribInfo - attrib_EntryPointAttribute : BuiltinAttribInfo - attrib_DefaultAugmentationAttribute : BuiltinAttribInfo - attrib_CompilerMessageAttribute : BuiltinAttribInfo - attrib_ExperimentalAttribute : BuiltinAttribInfo - attrib_UnverifiableAttribute : BuiltinAttribInfo - attrib_LiteralAttribute : BuiltinAttribInfo - attrib_ConditionalAttribute : BuiltinAttribInfo - attrib_OptionalArgumentAttribute : BuiltinAttribInfo - attrib_RequiresExplicitTypeArgumentsAttribute : BuiltinAttribInfo - attrib_DefaultValueAttribute : BuiltinAttribInfo - attrib_ClassAttribute : BuiltinAttribInfo - attrib_InterfaceAttribute : BuiltinAttribInfo - attrib_StructAttribute : BuiltinAttribInfo - attrib_ReflectedDefinitionAttribute : BuiltinAttribInfo - attrib_AutoOpenAttribute : BuiltinAttribInfo - attrib_InternalsVisibleToAttribute : BuiltinAttribInfo - attrib_CompilationRepresentationAttribute : BuiltinAttribInfo - attrib_CompilationArgumentCountsAttribute : BuiltinAttribInfo - attrib_CompilationMappingAttribute : BuiltinAttribInfo - - attrib_CLIEventAttribute : BuiltinAttribInfo - attrib_AllowNullLiteralAttribute : BuiltinAttribInfo - attrib_CLIMutableAttribute : BuiltinAttribInfo - attrib_NoComparisonAttribute : BuiltinAttribInfo - attrib_NoEqualityAttribute : BuiltinAttribInfo - attrib_CustomComparisonAttribute : BuiltinAttribInfo - attrib_CustomEqualityAttribute : BuiltinAttribInfo - attrib_EqualityConditionalOnAttribute : BuiltinAttribInfo - attrib_ComparisonConditionalOnAttribute : BuiltinAttribInfo - attrib_ReferenceEqualityAttribute : BuiltinAttribInfo - attrib_StructuralEqualityAttribute : BuiltinAttribInfo - attrib_StructuralComparisonAttribute : BuiltinAttribInfo - attrib_SealedAttribute : BuiltinAttribInfo - attrib_AbstractClassAttribute : BuiltinAttribInfo - attrib_GeneralizableValueAttribute : BuiltinAttribInfo - attrib_MeasureAttribute : BuiltinAttribInfo - attrib_MeasureableAttribute : BuiltinAttribInfo - attrib_NoDynamicInvocationAttribute : BuiltinAttribInfo - - attrib_SecurityAttribute : BuiltinAttribInfo option - attrib_SecurityCriticalAttribute : BuiltinAttribInfo - attrib_SecuritySafeCriticalAttribute : BuiltinAttribInfo - - - cons_ucref : UnionCaseRef - nil_ucref : UnionCaseRef - (* These are the library values the compiler needs to know about *) - seq_vref : ValRef - and_vref : ValRef - and2_vref : ValRef - addrof_vref : ValRef - addrof2_vref : ValRef - or_vref : ValRef - or2_vref : ValRef - - // 'inner' refers to "after optimization boils away inlined functions" - generic_equality_er_inner_vref : ValRef - generic_equality_per_inner_vref : ValRef - generic_equality_withc_inner_vref : ValRef - generic_comparison_inner_vref : ValRef - generic_comparison_withc_inner_vref : ValRef - generic_hash_inner_vref : ValRef - generic_hash_withc_inner_vref : ValRef - reference_equality_inner_vref : ValRef - - compare_operator_vref : ValRef - equals_operator_vref : ValRef - equals_nullable_operator_vref : ValRef - nullable_equals_nullable_operator_vref : ValRef - nullable_equals_operator_vref : ValRef - not_equals_operator_vref : ValRef - less_than_operator_vref : ValRef - less_than_or_equals_operator_vref : ValRef - greater_than_operator_vref : ValRef - greater_than_or_equals_operator_vref : ValRef - - bitwise_or_vref : ValRef - bitwise_and_vref : ValRef - bitwise_xor_vref : ValRef - bitwise_unary_not_vref : ValRef - bitwise_shift_left_vref : ValRef - bitwise_shift_right_vref : ValRef - unchecked_addition_vref : ValRef - unchecked_unary_plus_vref : ValRef - unchecked_unary_minus_vref : ValRef - unchecked_unary_not_vref : ValRef - unchecked_subtraction_vref : ValRef - unchecked_multiply_vref : ValRef - unchecked_defaultof_vref : ValRef - unchecked_subtraction_info : IntrinsicValRef - seq_info : IntrinsicValRef - reraise_info : IntrinsicValRef - reraise_vref : ValRef - typeof_info : IntrinsicValRef - typeof_vref : ValRef - methodhandleof_info : IntrinsicValRef - methodhandleof_vref : ValRef - sizeof_vref : ValRef - typedefof_info : IntrinsicValRef - typedefof_vref : ValRef - enum_vref : ValRef - enumOfValue_vref : ValRef - new_decimal_info : IntrinsicValRef - - // 'outer' refers to 'before optimization has boiled away inlined functions' - // Augmentation generation generates calls to these functions - // Optimization generates calls to these functions - generic_comparison_withc_outer_info : IntrinsicValRef - generic_equality_er_outer_info : IntrinsicValRef - generic_equality_withc_outer_info : IntrinsicValRef - generic_hash_withc_outer_info : IntrinsicValRef - - // Augmentation generation and pattern match compilation generates calls to this function - equals_operator_info : IntrinsicValRef - - query_source_vref : ValRef - query_value_vref : ValRef - query_run_value_vref : ValRef - query_run_enumerable_vref : ValRef - query_for_vref : ValRef - query_yield_vref : ValRef - query_yield_from_vref : ValRef - query_select_vref : ValRef - query_where_vref : ValRef - query_zero_vref : ValRef - query_builder_tcref : TyconRef - generic_hash_withc_tuple2_vref : ValRef - generic_hash_withc_tuple3_vref : ValRef - generic_hash_withc_tuple4_vref : ValRef - generic_hash_withc_tuple5_vref : ValRef - generic_equals_withc_tuple2_vref : ValRef - generic_equals_withc_tuple3_vref : ValRef - generic_equals_withc_tuple4_vref : ValRef - generic_equals_withc_tuple5_vref : ValRef - generic_compare_withc_tuple2_vref : ValRef - generic_compare_withc_tuple3_vref : ValRef - generic_compare_withc_tuple4_vref : ValRef - generic_compare_withc_tuple5_vref : ValRef - generic_equality_withc_outer_vref : ValRef - - create_instance_info : IntrinsicValRef - create_event_info : IntrinsicValRef - unbox_vref : ValRef - unbox_fast_vref : ValRef - istype_vref : ValRef - istype_fast_vref : ValRef - get_generic_comparer_info : IntrinsicValRef - get_generic_er_equality_comparer_info : IntrinsicValRef - get_generic_per_equality_comparer_info : IntrinsicValRef - unbox_info : IntrinsicValRef - unbox_fast_info : IntrinsicValRef - istype_info : IntrinsicValRef - istype_fast_info : IntrinsicValRef - - dispose_info : IntrinsicValRef - - getstring_info : IntrinsicValRef - - range_op_vref : ValRef - range_step_op_vref : ValRef - range_int32_op_vref : ValRef - array_get_vref : ValRef - array2D_get_vref : ValRef - array3D_get_vref : ValRef - array4D_get_vref : ValRef - seq_collect_vref : ValRef - seq_collect_info : IntrinsicValRef - seq_using_info : IntrinsicValRef - seq_using_vref : ValRef - seq_delay_info : IntrinsicValRef - seq_delay_vref : ValRef - seq_append_info : IntrinsicValRef - seq_append_vref : ValRef - seq_generated_info : IntrinsicValRef - seq_generated_vref : ValRef - seq_finally_info : IntrinsicValRef - seq_finally_vref : ValRef - seq_of_functions_info : IntrinsicValRef - seq_of_functions_vref : ValRef - seq_to_array_info : IntrinsicValRef - seq_to_list_info : IntrinsicValRef - seq_map_info : IntrinsicValRef - seq_map_vref : ValRef - seq_singleton_info : IntrinsicValRef - seq_singleton_vref : ValRef - seq_empty_info : IntrinsicValRef - seq_empty_vref : ValRef - new_format_info : IntrinsicValRef - raise_info : IntrinsicValRef - raise_vref : ValRef - failwith_info : IntrinsicValRef - failwith_vref : ValRef - invalid_arg_info : IntrinsicValRef - invalid_arg_vref : ValRef - null_arg_info : IntrinsicValRef - null_arg_vref : ValRef - invalid_op_info : IntrinsicValRef - invalid_op_vref : ValRef - failwithf_info : IntrinsicValRef - failwithf_vref : ValRef - - lazy_force_info : IntrinsicValRef - lazy_create_info : IntrinsicValRef - - array_get_info : IntrinsicValRef - array_length_info : IntrinsicValRef - array2D_get_info : IntrinsicValRef - array3D_get_info : IntrinsicValRef - array4D_get_info : IntrinsicValRef - deserialize_quoted_FSharp_20_plus_info : IntrinsicValRef - deserialize_quoted_FSharp_40_plus_info : IntrinsicValRef - cast_quotation_info : IntrinsicValRef - lift_value_info : IntrinsicValRef - lift_value_with_name_info : IntrinsicValRef - lift_value_with_defn_info : IntrinsicValRef - query_source_as_enum_info : IntrinsicValRef - new_query_source_info : IntrinsicValRef - fail_init_info : IntrinsicValRef - fail_static_init_info : IntrinsicValRef - check_this_info : IntrinsicValRef - quote_to_linq_lambda_info : IntrinsicValRef - sprintf_vref : ValRef - splice_expr_vref : ValRef - splice_raw_expr_vref : ValRef - new_format_vref : ValRef - mkSysTyconRef : string list -> string -> TyconRef - tryMkSysTyconRef : string list -> string -> TyconRef option - mkSysILTypeRef : string -> ILTypeRef - usesMscorlib : bool - mkSysAttrib : string -> BuiltinAttribInfo - - // A list of types that are explicitly suppressed from the F# intellisense - // Note that the suppression checks for the precise name of the type - // so the lowercase versions are visible - suppressed_types : TyconRef list - - /// Memoization table to help minimize the number of ILSourceDocument objects we create - memoize_file : int -> IL.ILSourceDocument - // Are we assuming all code gen is for F# interactive, with no static linking - isInteractive : bool - // A table of all intrinsics that the compiler cares about - knownIntrinsics : IDictionary<(string * string), ValRef> - // A table of known modules in FSharp.Core. Not all modules are necessarily listed, but the more we list the - // better the job we do of mapping from provided expressions back to FSharp.Core F# functions and values. - knownFSharpCoreModules : IDictionary - - } - override x.ToString() = "" - -#if DEBUG -// This global is only used during debug output -let global_g = ref (None : TcGlobals option) -#endif - -let mkTcGlobals (compilingFslib,ilg,fslibCcu,directoryToResolveRelativePaths,mlCompatibility, - using40environment,isInteractive,getTypeCcu,tryGetTypeCcu, emitDebugInfoInQuotations, usesMscorlib) = - let vara = NewRigidTypar "a" envRange let varb = NewRigidTypar "b" envRange let varc = NewRigidTypar "c" envRange @@ -586,50 +174,57 @@ let mkTcGlobals (compilingFslib,ilg,fslibCcu,directoryToResolveRelativePaths,mlC let vardTy = mkTyparTy vard let vareTy = mkTyparTy vare - let int_tcr = mk_MFCore_tcref fslibCcu "int" - let nativeint_tcr = mk_MFCore_tcref fslibCcu "nativeint" - let unativeint_tcr = mk_MFCore_tcref fslibCcu "unativeint" - let int32_tcr = mk_MFCore_tcref fslibCcu "int32" - let int16_tcr = mk_MFCore_tcref fslibCcu "int16" - let int64_tcr = mk_MFCore_tcref fslibCcu "int64" - let uint16_tcr = mk_MFCore_tcref fslibCcu "uint16" - let uint32_tcr = mk_MFCore_tcref fslibCcu "uint32" - let uint64_tcr = mk_MFCore_tcref fslibCcu "uint64" - let sbyte_tcr = mk_MFCore_tcref fslibCcu "sbyte" - let decimal_tcr = mk_MFCore_tcref fslibCcu "decimal" - let pdecimal_tcr = mk_MFCore_tcref fslibCcu "decimal`1" - let byte_tcr = mk_MFCore_tcref fslibCcu "byte" - let bool_tcr = mk_MFCore_tcref fslibCcu "bool" - let string_tcr = mk_MFCore_tcref fslibCcu "string" - let obj_tcr = mk_MFCore_tcref fslibCcu "obj" - let unit_tcr_canon = mk_MFCore_tcref fslibCcu "Unit" - let unit_tcr_nice = mk_MFCore_tcref fslibCcu "unit" - let exn_tcr = mk_MFCore_tcref fslibCcu "exn" - let char_tcr = mk_MFCore_tcref fslibCcu "char" - let float_tcr = mk_MFCore_tcref fslibCcu "float" - let float32_tcr = mk_MFCore_tcref fslibCcu "float32" - let pfloat_tcr = mk_MFCore_tcref fslibCcu "float`1" - let pfloat32_tcr = mk_MFCore_tcref fslibCcu "float32`1" - let pint_tcr = mk_MFCore_tcref fslibCcu "int`1" - let pint8_tcr = mk_MFCore_tcref fslibCcu "sbyte`1" - let pint16_tcr = mk_MFCore_tcref fslibCcu "int16`1" - let pint64_tcr = mk_MFCore_tcref fslibCcu "int64`1" - let byref_tcr = mk_MFCore_tcref fslibCcu "byref`1" - let nativeptr_tcr = mk_MFCore_tcref fslibCcu "nativeptr`1" - let ilsigptr_tcr = mk_MFCore_tcref fslibCcu "ilsigptr`1" - let fastFunc_tcr = mk_MFCore_tcref fslibCcu "FSharpFunc`2" - - let tryMkSysTyconRef path nm = - match tryGetTypeCcu path nm with + let v_int_tcr = mk_MFCore_tcref fslibCcu "int" + let v_nativeint_tcr = mk_MFCore_tcref fslibCcu "nativeint" + let v_unativeint_tcr = mk_MFCore_tcref fslibCcu "unativeint" + let v_int32_tcr = mk_MFCore_tcref fslibCcu "int32" + let v_int16_tcr = mk_MFCore_tcref fslibCcu "int16" + let v_int64_tcr = mk_MFCore_tcref fslibCcu "int64" + let v_uint16_tcr = mk_MFCore_tcref fslibCcu "uint16" + let v_uint32_tcr = mk_MFCore_tcref fslibCcu "uint32" + let v_uint64_tcr = mk_MFCore_tcref fslibCcu "uint64" + let v_sbyte_tcr = mk_MFCore_tcref fslibCcu "sbyte" + let v_decimal_tcr = mk_MFCore_tcref fslibCcu "decimal" + let v_pdecimal_tcr = mk_MFCore_tcref fslibCcu "decimal`1" + let v_byte_tcr = mk_MFCore_tcref fslibCcu "byte" + let v_bool_tcr = mk_MFCore_tcref fslibCcu "bool" + let v_string_tcr = mk_MFCore_tcref fslibCcu "string" + let v_obj_tcr = mk_MFCore_tcref fslibCcu "obj" + let v_unit_tcr_canon = mk_MFCore_tcref fslibCcu "Unit" + let v_unit_tcr_nice = mk_MFCore_tcref fslibCcu "unit" + let v_exn_tcr = mk_MFCore_tcref fslibCcu "exn" + let v_char_tcr = mk_MFCore_tcref fslibCcu "char" + let v_float_tcr = mk_MFCore_tcref fslibCcu "float" + let v_float32_tcr = mk_MFCore_tcref fslibCcu "float32" + let v_pfloat_tcr = mk_MFCore_tcref fslibCcu "float`1" + let v_pfloat32_tcr = mk_MFCore_tcref fslibCcu "float32`1" + let v_pint_tcr = mk_MFCore_tcref fslibCcu "int`1" + let v_pint8_tcr = mk_MFCore_tcref fslibCcu "sbyte`1" + let v_pint16_tcr = mk_MFCore_tcref fslibCcu "int16`1" + let v_pint64_tcr = mk_MFCore_tcref fslibCcu "int64`1" + let v_byref_tcr = mk_MFCore_tcref fslibCcu "byref`1" + let v_nativeptr_tcr = mk_MFCore_tcref fslibCcu "nativeptr`1" + let v_ilsigptr_tcr = mk_MFCore_tcref fslibCcu "ilsigptr`1" + let v_fastFunc_tcr = mk_MFCore_tcref fslibCcu "FSharpFunc`2" + + // Search for a type. If it is not found, leave a dangling CCU reference with some useful diagnostic information should + // the type actually be dereferenced + let findSysTypeCcu path typeName = + match tryFindSysTypeCcu path typeName with + | None -> CcuThunk.CreateDelayed(FSComp.SR.tcGlobalsSystemTypeNotFound (String.concat "." path + "." + typeName)) + | Some ccu -> ccu + + let tryFindSysTyconRef path nm = + match tryFindSysTypeCcu path nm with | Some ccu -> Some (mkNonLocalTyconRef2 ccu (Array.ofList path) nm) | None -> None - let mkSysTyconRef path nm = - let ccu = getTypeCcu path nm + let findSysTyconRef path nm = + let ccu = findSysTypeCcu path nm mkNonLocalTyconRef2 ccu (Array.ofList path) nm - let mkSysNonGenericTy path n = mkNonGenericTy(mkSysTyconRef path n) - let tryMkSysNonGenericTy path n = tryMkSysTyconRef path n |> Option.map mkNonGenericTy + let mkSysNonGenericTy path n = mkNonGenericTy(findSysTyconRef path n) + let tryMkSysNonGenericTy path n = tryFindSysTyconRef path n |> Option.map mkNonGenericTy let sys = ["System"] let sysLinq = ["System";"Linq"] @@ -637,31 +232,31 @@ let mkTcGlobals (compilingFslib,ilg,fslibCcu,directoryToResolveRelativePaths,mlC let sysGenerics = ["System";"Collections";"Generic"] let sysCompilerServices = ["System";"Runtime";"CompilerServices"] - let lazy_tcr = mkSysTyconRef sys "Lazy`1" - let fslib_IEvent2_tcr = mk_MFControl_tcref fslibCcu "IEvent`2" - let tcref_IQueryable = mkSysTyconRef sysLinq "IQueryable`1" - let tcref_IObservable = mkSysTyconRef sys "IObservable`1" - let tcref_IObserver = mkSysTyconRef sys "IObserver`1" - let fslib_IDelegateEvent_tcr = mk_MFControl_tcref fslibCcu "IDelegateEvent`1" - - let option_tcr_nice = mk_MFCore_tcref fslibCcu "option`1" - let list_tcr_canon = mk_MFCollections_tcref fslibCcu "List`1" - let list_tcr_nice = mk_MFCollections_tcref fslibCcu "list`1" - let lazy_tcr_nice = mk_MFControl_tcref fslibCcu "Lazy`1" - let seq_tcr = mk_MFCollections_tcref fslibCcu "seq`1" - let format_tcr = mk_MFCore_tcref fslibCcu "PrintfFormat`5" - let format4_tcr = mk_MFCore_tcref fslibCcu "PrintfFormat`4" - let date_tcr = mkSysTyconRef sys "DateTime" - let IEnumerable_tcr = mkSysTyconRef sysGenerics "IEnumerable`1" - let IEnumerator_tcr = mkSysTyconRef sysGenerics "IEnumerator`1" - let System_Attribute_tcr = mkSysTyconRef sys "Attribute" - let expr_tcr = mk_MFQuotations_tcref fslibCcu "Expr`1" - let raw_expr_tcr = mk_MFQuotations_tcref fslibCcu "Expr" - let query_builder_tcref = mk_MFLinq_tcref fslibCcu "QueryBuilder" - let querySource_tcr = mk_MFLinq_tcref fslibCcu "QuerySource`2" - let linqExpression_tcr = mkSysTyconRef ["System";"Linq";"Expressions"] "Expression`1" - - let il_arr_tcr_map = + let lazy_tcr = findSysTyconRef sys "Lazy`1" + let v_fslib_IEvent2_tcr = mk_MFControl_tcref fslibCcu "IEvent`2" + let v_tcref_IQueryable = findSysTyconRef sysLinq "IQueryable`1" + let v_tcref_IObservable = findSysTyconRef sys "IObservable`1" + let v_tcref_IObserver = findSysTyconRef sys "IObserver`1" + let v_fslib_IDelegateEvent_tcr = mk_MFControl_tcref fslibCcu "IDelegateEvent`1" + + let v_option_tcr_nice = mk_MFCore_tcref fslibCcu "option`1" + let v_list_tcr_canon = mk_MFCollections_tcref fslibCcu "List`1" + let v_list_tcr_nice = mk_MFCollections_tcref fslibCcu "list`1" + let v_lazy_tcr_nice = mk_MFControl_tcref fslibCcu "Lazy`1" + let v_seq_tcr = mk_MFCollections_tcref fslibCcu "seq`1" + let v_format_tcr = mk_MFCore_tcref fslibCcu "PrintfFormat`5" + let v_format4_tcr = mk_MFCore_tcref fslibCcu "PrintfFormat`4" + let v_date_tcr = findSysTyconRef sys "DateTime" + let v_IEnumerable_tcr = findSysTyconRef sysGenerics "IEnumerable`1" + let v_IEnumerator_tcr = findSysTyconRef sysGenerics "IEnumerator`1" + let v_System_Attribute_tcr = findSysTyconRef sys "Attribute" + let v_expr_tcr = mk_MFQuotations_tcref fslibCcu "Expr`1" + let v_raw_expr_tcr = mk_MFQuotations_tcref fslibCcu "Expr" + let v_query_builder_tcref = mk_MFLinq_tcref fslibCcu "QueryBuilder" + let v_querySource_tcr = mk_MFLinq_tcref fslibCcu "QuerySource`2" + let v_linqExpression_tcr = findSysTyconRef ["System";"Linq";"Expressions"] "Expression`1" + + let v_il_arr_tcr_map = Array.init 32 (fun idx -> let type_sig = let rank = idx + 1 @@ -669,76 +264,77 @@ let mkTcGlobals (compilingFslib,ilg,fslibCcu,directoryToResolveRelativePaths,mlC else "[" + (String.replicate (rank - 1) ",") + "]`1" mk_MFCore_tcref fslibCcu type_sig) - let bool_ty = mkNonGenericTy bool_tcr - let int_ty = mkNonGenericTy int_tcr - let char_ty = mkNonGenericTy char_tcr - let obj_ty = mkNonGenericTy obj_tcr - let string_ty = mkNonGenericTy string_tcr - let byte_ty = mkNonGenericTy byte_tcr - let decimal_ty = mkSysNonGenericTy sys "Decimal" - let unit_ty = mkNonGenericTy unit_tcr_nice - let system_Type_typ = mkSysNonGenericTy sys "Type" + let v_bool_ty = mkNonGenericTy v_bool_tcr + let v_int_ty = mkNonGenericTy v_int_tcr + let v_char_ty = mkNonGenericTy v_char_tcr + let v_obj_ty = mkNonGenericTy v_obj_tcr + let v_string_ty = mkNonGenericTy v_string_tcr + let v_byte_ty = mkNonGenericTy v_byte_tcr + let v_decimal_ty = mkSysNonGenericTy sys "Decimal" + let v_unit_ty = mkNonGenericTy v_unit_tcr_nice + let v_system_Type_typ = mkSysNonGenericTy sys "Type" - let system_Reflection_MethodInfo_typ = mkSysNonGenericTy ["System";"Reflection"] "MethodInfo" - let nullable_tcr = mkSysTyconRef sys "Nullable`1" + let v_system_Reflection_MethodInfo_typ = mkSysNonGenericTy ["System";"Reflection"] "MethodInfo" + let v_nullable_tcr = findSysTyconRef sys "Nullable`1" (* local helpers to build value infos *) - let mkNullableTy ty = TType_app(nullable_tcr, [ty]) - let mkByrefTy ty = TType_app(byref_tcr, [ty]) - let mkNativePtrTy ty = TType_app(nativeptr_tcr, [ty]) - let mkFunTy d r = TType_fun (d,r) + let mkNullableTy ty = TType_app(v_nullable_tcr, [ty]) + let mkByrefTy ty = TType_app(v_byref_tcr, [ty]) + let mkNativePtrTy ty = TType_app(v_nativeptr_tcr, [ty]) + let mkFunTy d r = TType_fun (d, r) let (-->) d r = mkFunTy d r let mkIteratedFunTy dl r = List.foldBack (-->) dl r - let mkSmallRefTupledTy l = match l with [] -> unit_ty | [h] -> h | tys -> mkRawRefTupleTy tys - let tryMkForallTy d r = match d with [] -> r | tps -> TType_forall(tps,r) + let mkSmallRefTupledTy l = match l with [] -> v_unit_ty | [h] -> h | tys -> mkRawRefTupleTy tys + let tryMkForallTy d r = match d with [] -> r | tps -> TType_forall(tps, r) - let knownIntrinsics = Dictionary<(string*string), ValRef>(HashIdentity.Structural) + // A table of all intrinsics that the compiler cares about + let v_knownIntrinsics = Dictionary<(string*string), ValRef>(HashIdentity.Structural) - let makeIntrinsicValRef (enclosingEntity, logicalName, memberParentName, compiledNameOpt, typars, (argtys,rty)) = + let makeIntrinsicValRef (enclosingEntity, logicalName, memberParentName, compiledNameOpt, typars, (argtys, rty)) = let ty = tryMkForallTy typars (mkIteratedFunTy (List.map mkSmallRefTupledTy argtys) rty) let isMember = Option.isSome memberParentName let argCount = if isMember then List.sum (List.map List.length argtys) else 0 let linkageType = if isMember then Some ty else None - let key = ValLinkageFullKey({ MemberParentMangledName=memberParentName; MemberIsOverride=false; LogicalName=logicalName; TotalArgCount= argCount },linkageType) - let vref = IntrinsicValRef(enclosingEntity,logicalName,isMember,ty,key) + let key = ValLinkageFullKey({ MemberParentMangledName=memberParentName; MemberIsOverride=false; LogicalName=logicalName; TotalArgCount= argCount }, linkageType) + let vref = IntrinsicValRef(enclosingEntity, logicalName, isMember, ty, key) let compiledName = defaultArg compiledNameOpt logicalName - knownIntrinsics.Add((enclosingEntity.LastItemMangledName, compiledName), ValRefForIntrinsic vref) + v_knownIntrinsics.Add((enclosingEntity.LastItemMangledName, compiledName), ValRefForIntrinsic vref) vref - let mk_IComparer_ty = mkSysNonGenericTy sysCollections "IComparer" - let mk_IEqualityComparer_ty = mkSysNonGenericTy sysCollections "IEqualityComparer" + let v_IComparer_ty = mkSysNonGenericTy sysCollections "IComparer" + let v_IEqualityComparer_ty = mkSysNonGenericTy sysCollections "IEqualityComparer" - let system_RuntimeMethodHandle_typ = mkSysNonGenericTy sys "RuntimeMethodHandle" + let v_system_RuntimeMethodHandle_typ = mkSysNonGenericTy sys "RuntimeMethodHandle" let mk_unop_ty ty = [[ty]], ty let mk_binop_ty ty = [[ty]; [ty]], ty - let mk_shiftop_ty ty = [[ty]; [int_ty]], ty + let mk_shiftop_ty ty = [[ty]; [v_int_ty]], ty let mk_binop_ty3 ty1 ty2 ty3 = [[ty1]; [ty2]], ty3 - let mk_rel_sig ty = [[ty];[ty]],bool_ty - let mk_compare_sig ty = [[ty];[ty]],int_ty - let mk_hash_sig ty = [[ty]], int_ty - let mk_compare_withc_sig ty = [[mk_IComparer_ty];[ty]; [ty]], int_ty - let mk_equality_withc_sig ty = [[mk_IEqualityComparer_ty];[ty];[ty]], bool_ty - let mk_hash_withc_sig ty = [[mk_IEqualityComparer_ty]; [ty]], int_ty - let mkListTy ty = TType_app(list_tcr_nice,[ty]) - let mkSeqTy ty1 = TType_app(seq_tcr,[ty1]) - let mkQuerySourceTy ty1 ty2 = TType_app(querySource_tcr,[ty1; ty2]) - let tcref_System_Collections_IEnumerable = mkSysTyconRef sysCollections "IEnumerable"; + let mk_rel_sig ty = [[ty];[ty]], v_bool_ty + let mk_compare_sig ty = [[ty];[ty]], v_int_ty + let mk_hash_sig ty = [[ty]], v_int_ty + let mk_compare_withc_sig ty = [[v_IComparer_ty];[ty]; [ty]], v_int_ty + let mk_equality_withc_sig ty = [[v_IEqualityComparer_ty];[ty];[ty]], v_bool_ty + let mk_hash_withc_sig ty = [[v_IEqualityComparer_ty]; [ty]], v_int_ty + let mkListTy ty = TType_app(v_list_tcr_nice, [ty]) + let mkSeqTy ty1 = TType_app(v_seq_tcr, [ty1]) + let mkQuerySourceTy ty1 ty2 = TType_app(v_querySource_tcr, [ty1; ty2]) + let v_tcref_System_Collections_IEnumerable = findSysTyconRef sysCollections "IEnumerable"; let mkArrayType rank (ty : TType) : TType = assert (rank >= 1 && rank <= 32) - TType_app(il_arr_tcr_map.[rank - 1], [ty]) + TType_app(v_il_arr_tcr_map.[rank - 1], [ty]) let mkLazyTy ty = TType_app(lazy_tcr, [ty]) - let mkPrintfFormatTy aty bty cty dty ety = TType_app(format_tcr, [aty;bty;cty;dty; ety]) - let mk_format4_ty aty bty cty dty = TType_app(format4_tcr, [aty;bty;cty;dty]) - let mkQuotedExprTy aty = TType_app(expr_tcr, [aty]) - let mkRawQuotedExprTy = TType_app(raw_expr_tcr, []) - let mkQueryBuilderTy = TType_app(query_builder_tcref, []) - let mkLinqExpressionTy aty = TType_app(linqExpression_tcr, [aty]) - let cons_ucref = mkUnionCaseRef list_tcr_canon "op_ColonColon" - let nil_ucref = mkUnionCaseRef list_tcr_canon "op_Nil" + let mkPrintfFormatTy aty bty cty dty ety = TType_app(v_format_tcr, [aty;bty;cty;dty; ety]) + let mk_format4_ty aty bty cty dty = TType_app(v_format4_tcr, [aty;bty;cty;dty]) + let mkQuotedExprTy aty = TType_app(v_expr_tcr, [aty]) + let mkRawQuotedExprTy = TType_app(v_raw_expr_tcr, []) + let mkQueryBuilderTy = TType_app(v_query_builder_tcref, []) + let mkLinqExpressionTy aty = TType_app(v_linqExpression_tcr, [aty]) + let v_cons_ucref = mkUnionCaseRef v_list_tcr_canon "op_ColonColon" + let v_nil_ucref = mkUnionCaseRef v_list_tcr_canon "op_Nil" let fslib_MF_nleref = mkNonLocalEntityRef fslibCcu FSharpLib.RootPathArray @@ -779,41 +375,39 @@ let mkTcGlobals (compilingFslib,ilg,fslibCcu,directoryToResolveRelativePaths,mlC let fslib_MFLinqRuntimeHelpersQuotationConverter_nleref = mkNestedNonLocalEntityRef fslib_MFLinqRuntimeHelpers_nleref "LeafExpressionConverter" let fslib_MFLazyExtensions_nleref = mkNestedNonLocalEntityRef fslib_MFControl_nleref "LazyExtensions" - let ref_tuple1_tcr = mkSysTyconRef sys "Tuple`1" - let ref_tuple2_tcr = mkSysTyconRef sys "Tuple`2" - let ref_tuple3_tcr = mkSysTyconRef sys "Tuple`3" - let ref_tuple4_tcr = mkSysTyconRef sys "Tuple`4" - let ref_tuple5_tcr = mkSysTyconRef sys "Tuple`5" - let ref_tuple6_tcr = mkSysTyconRef sys "Tuple`6" - let ref_tuple7_tcr = mkSysTyconRef sys "Tuple`7" - let ref_tuple8_tcr = mkSysTyconRef sys "Tuple`8" - let struct_tuple1_tcr = mkSysTyconRef sys "ValueTuple`1" - let struct_tuple2_tcr = mkSysTyconRef sys "ValueTuple`2" - let struct_tuple3_tcr = mkSysTyconRef sys "ValueTuple`3" - let struct_tuple4_tcr = mkSysTyconRef sys "ValueTuple`4" - let struct_tuple5_tcr = mkSysTyconRef sys "ValueTuple`5" - let struct_tuple6_tcr = mkSysTyconRef sys "ValueTuple`6" - let struct_tuple7_tcr = mkSysTyconRef sys "ValueTuple`7" - let struct_tuple8_tcr = mkSysTyconRef sys "ValueTuple`8" + let v_ref_tuple1_tcr = findSysTyconRef sys "Tuple`1" + let v_ref_tuple2_tcr = findSysTyconRef sys "Tuple`2" + let v_ref_tuple3_tcr = findSysTyconRef sys "Tuple`3" + let v_ref_tuple4_tcr = findSysTyconRef sys "Tuple`4" + let v_ref_tuple5_tcr = findSysTyconRef sys "Tuple`5" + let v_ref_tuple6_tcr = findSysTyconRef sys "Tuple`6" + let v_ref_tuple7_tcr = findSysTyconRef sys "Tuple`7" + let v_ref_tuple8_tcr = findSysTyconRef sys "Tuple`8" + let v_struct_tuple1_tcr = findSysTyconRef sys "ValueTuple`1" + let v_struct_tuple2_tcr = findSysTyconRef sys "ValueTuple`2" + let v_struct_tuple3_tcr = findSysTyconRef sys "ValueTuple`3" + let v_struct_tuple4_tcr = findSysTyconRef sys "ValueTuple`4" + let v_struct_tuple5_tcr = findSysTyconRef sys "ValueTuple`5" + let v_struct_tuple6_tcr = findSysTyconRef sys "ValueTuple`6" + let v_struct_tuple7_tcr = findSysTyconRef sys "ValueTuple`7" + let v_struct_tuple8_tcr = findSysTyconRef sys "ValueTuple`8" - let choice2_tcr = mk_MFCore_tcref fslibCcu "Choice`2" - let choice3_tcr = mk_MFCore_tcref fslibCcu "Choice`3" - let choice4_tcr = mk_MFCore_tcref fslibCcu "Choice`4" - let choice5_tcr = mk_MFCore_tcref fslibCcu "Choice`5" - let choice6_tcr = mk_MFCore_tcref fslibCcu "Choice`6" - let choice7_tcr = mk_MFCore_tcref fslibCcu "Choice`7" + let v_choice2_tcr = mk_MFCore_tcref fslibCcu "Choice`2" + let v_choice3_tcr = mk_MFCore_tcref fslibCcu "Choice`3" + let v_choice4_tcr = mk_MFCore_tcref fslibCcu "Choice`4" + let v_choice5_tcr = mk_MFCore_tcref fslibCcu "Choice`5" + let v_choice6_tcr = mk_MFCore_tcref fslibCcu "Choice`6" + let v_choice7_tcr = mk_MFCore_tcref fslibCcu "Choice`7" let tyconRefEq x y = primEntityRefEq compilingFslib fslibCcu x y - let valRefEq x y = primValRefEq compilingFslib fslibCcu x y - let unionCaseRefEq x y = primUnionCaseRefEq compilingFslib fslibCcu x y - let suppressed_types = + let v_suppressed_types = [ mk_MFCore_tcref fslibCcu "Option`1"; mk_MFCore_tcref fslibCcu "Ref`1"; mk_MFCore_tcref fslibCcu "FSharpTypeFunc"; mk_MFCore_tcref fslibCcu "FSharpFunc`2"; mk_MFCore_tcref fslibCcu "Unit" ] - let knownFSharpCoreModules = + let v_knownFSharpCoreModules = dict [ for nleref in [ fslib_MFLanguagePrimitives_nleref fslib_MFIntrinsicOperators_nleref fslib_MFIntrinsicFunctions_nleref @@ -846,494 +440,275 @@ let mkTcGlobals (compilingFslib,ilg,fslibCcu,directoryToResolveRelativePaths,mlC match l with | [t1;t2;t3;t4;t5;t6;t7;marker] -> match marker with - | TType_app(tcref,[t8]) when tyconRefEq tcref ref_tuple1_tcr -> mkRawRefTupleTy [t1;t2;t3;t4;t5;t6;t7;t8] - | TType_app(tcref,[t8]) when tyconRefEq tcref struct_tuple1_tcr -> mkRawStructTupleTy [t1;t2;t3;t4;t5;t6;t7;t8] + | TType_app(tcref, [t8]) when tyconRefEq tcref v_ref_tuple1_tcr -> mkRawRefTupleTy [t1;t2;t3;t4;t5;t6;t7;t8] + | TType_app(tcref, [t8]) when tyconRefEq tcref v_struct_tuple1_tcr -> mkRawStructTupleTy [t1;t2;t3;t4;t5;t6;t7;t8] | TType_tuple (_structness2, t8plus) -> TType_tuple (tupInfo, [t1;t2;t3;t4;t5;t6;t7] @ t8plus) | _ -> TType_tuple (tupInfo, l) | _ -> TType_tuple (tupInfo, l) let mk_MFCore_attrib nm : BuiltinAttribInfo = - AttribInfo(mkILTyRef(IlxSettings.ilxFsharpCoreLibScopeRef (), FSharpLib.Core + "." + nm),mk_MFCore_tcref fslibCcu nm) + AttribInfo(mkILTyRef(IlxSettings.ilxFsharpCoreLibScopeRef (), FSharpLib.Core + "." + nm), mk_MFCore_tcref fslibCcu nm) let mkSysILTypeRef (nm:string) = let path, typeName = splitILTypeName nm - let scopeRef = (getTypeCcu path typeName).ILScopeRef - mkILTyRef (scopeRef, nm) + findSysTypeCcu path typeName |> (fun ccu -> mkILTyRef (ccu.ILScopeRef, nm)) + + let tryMkSysILTypeRef (nm:string) = + let path, typeName = splitILTypeName nm + tryFindSysTypeCcu path typeName |> Option.map (fun ccu -> mkILTyRef (ccu.ILScopeRef, nm)) let mkSysAttrib (nm:string) = let tref = mkSysILTypeRef nm let path, typeName = splitILTypeName nm - AttribInfo(tref, mkSysTyconRef path typeName) + AttribInfo(tref, findSysTyconRef path typeName) let tryMkSysAttrib nm = let path, typeName = splitILTypeName nm - match tryGetTypeCcu path typeName with + match tryFindSysTypeCcu path typeName with | Some _ -> Some (mkSysAttrib nm) | None -> None let mk_doc filename = ILSourceDocument.Create(language=None, vendor=None, documentType=None, file=filename) // Build the memoization table for files - let memoize_file = new MemoizationTable ((fileOfFileIndex >> Filename.fullpath directoryToResolveRelativePaths >> mk_doc), keyComparer=HashIdentity.Structural) - - let and_info = makeIntrinsicValRef(fslib_MFIntrinsicOperators_nleref, CompileOpName "&" ,None ,None ,[], mk_rel_sig bool_ty) - let addrof_info = makeIntrinsicValRef(fslib_MFIntrinsicOperators_nleref, CompileOpName "~&" ,None ,None ,[vara], ([[varaTy]], mkByrefTy varaTy)) - let addrof2_info = makeIntrinsicValRef(fslib_MFIntrinsicOperators_nleref, CompileOpName "~&&" ,None ,None ,[vara], ([[varaTy]], mkNativePtrTy varaTy)) - let and2_info = makeIntrinsicValRef(fslib_MFIntrinsicOperators_nleref, CompileOpName "&&" ,None ,None ,[], mk_rel_sig bool_ty) - let or_info = makeIntrinsicValRef(fslib_MFIntrinsicOperators_nleref, "or" ,None ,Some "Or" ,[], mk_rel_sig bool_ty) - let or2_info = makeIntrinsicValRef(fslib_MFIntrinsicOperators_nleref, CompileOpName "||" ,None ,None ,[], mk_rel_sig bool_ty) - let compare_operator_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "compare" ,None ,Some "Compare",[vara], mk_compare_sig varaTy) - let equals_operator_info = makeIntrinsicValRef(fslib_MFOperators_nleref, CompileOpName "=" ,None ,None ,[vara], mk_rel_sig varaTy) - let equals_nullable_operator_info = makeIntrinsicValRef(fslib_MFNullableOperators_nleref, CompileOpName "=?" ,None ,None ,[vara], ([[varaTy];[mkNullableTy varaTy]],bool_ty)) - let nullable_equals_operator_info = makeIntrinsicValRef(fslib_MFNullableOperators_nleref, CompileOpName "?=" ,None ,None ,[vara], ([[mkNullableTy varaTy];[varaTy]],bool_ty)) - let nullable_equals_nullable_operator_info = makeIntrinsicValRef(fslib_MFNullableOperators_nleref, CompileOpName "?=?" ,None ,None ,[vara], ([[mkNullableTy varaTy];[mkNullableTy varaTy]],bool_ty)) - let not_equals_operator_info = makeIntrinsicValRef(fslib_MFOperators_nleref, CompileOpName "<>" ,None ,None ,[vara], mk_rel_sig varaTy) - let less_than_operator_info = makeIntrinsicValRef(fslib_MFOperators_nleref, CompileOpName "<" ,None ,None ,[vara], mk_rel_sig varaTy) - let less_than_or_equals_operator_info = makeIntrinsicValRef(fslib_MFOperators_nleref, CompileOpName "<=" ,None ,None ,[vara], mk_rel_sig varaTy) - let greater_than_operator_info = makeIntrinsicValRef(fslib_MFOperators_nleref, CompileOpName ">" ,None ,None ,[vara], mk_rel_sig varaTy) - let greater_than_or_equals_operator_info = makeIntrinsicValRef(fslib_MFOperators_nleref, CompileOpName ">=" ,None ,None ,[vara], mk_rel_sig varaTy) + let v_memoize_file = new MemoizationTable ((fileOfFileIndex >> Filename.fullpath directoryToResolveRelativePaths >> mk_doc), keyComparer=HashIdentity.Structural) + + let v_and_info = makeIntrinsicValRef(fslib_MFIntrinsicOperators_nleref, CompileOpName "&" , None , None , [], mk_rel_sig v_bool_ty) + let v_addrof_info = makeIntrinsicValRef(fslib_MFIntrinsicOperators_nleref, CompileOpName "~&" , None , None , [vara], ([[varaTy]], mkByrefTy varaTy)) + let v_addrof2_info = makeIntrinsicValRef(fslib_MFIntrinsicOperators_nleref, CompileOpName "~&&" , None , None , [vara], ([[varaTy]], mkNativePtrTy varaTy)) + let v_and2_info = makeIntrinsicValRef(fslib_MFIntrinsicOperators_nleref, CompileOpName "&&" , None , None , [], mk_rel_sig v_bool_ty) + let v_or_info = makeIntrinsicValRef(fslib_MFIntrinsicOperators_nleref, "or" , None , Some "Or" , [], mk_rel_sig v_bool_ty) + let v_or2_info = makeIntrinsicValRef(fslib_MFIntrinsicOperators_nleref, CompileOpName "||" , None , None , [], mk_rel_sig v_bool_ty) + let v_compare_operator_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "compare" , None , Some "Compare", [vara], mk_compare_sig varaTy) + let v_equals_operator_info = makeIntrinsicValRef(fslib_MFOperators_nleref, CompileOpName "=" , None , None , [vara], mk_rel_sig varaTy) + let v_equals_nullable_operator_info = makeIntrinsicValRef(fslib_MFNullableOperators_nleref, CompileOpName "=?" , None , None , [vara], ([[varaTy];[mkNullableTy varaTy]], v_bool_ty)) + let v_nullable_equals_operator_info = makeIntrinsicValRef(fslib_MFNullableOperators_nleref, CompileOpName "?=" , None , None , [vara], ([[mkNullableTy varaTy];[varaTy]], v_bool_ty)) + let v_nullable_equals_nullable_operator_info = makeIntrinsicValRef(fslib_MFNullableOperators_nleref, CompileOpName "?=?" , None , None , [vara], ([[mkNullableTy varaTy];[mkNullableTy varaTy]], v_bool_ty)) + let v_not_equals_operator_info = makeIntrinsicValRef(fslib_MFOperators_nleref, CompileOpName "<>" , None , None , [vara], mk_rel_sig varaTy) + let v_less_than_operator_info = makeIntrinsicValRef(fslib_MFOperators_nleref, CompileOpName "<" , None , None , [vara], mk_rel_sig varaTy) + let v_less_than_or_equals_operator_info = makeIntrinsicValRef(fslib_MFOperators_nleref, CompileOpName "<=" , None , None , [vara], mk_rel_sig varaTy) + let v_greater_than_operator_info = makeIntrinsicValRef(fslib_MFOperators_nleref, CompileOpName ">" , None , None , [vara], mk_rel_sig varaTy) + let v_greater_than_or_equals_operator_info = makeIntrinsicValRef(fslib_MFOperators_nleref, CompileOpName ">=" , None , None , [vara], mk_rel_sig varaTy) - let enumOfValue_info = makeIntrinsicValRef(fslib_MFLanguagePrimitives_nleref, "EnumOfValue" ,None ,None ,[vara; varb], ([[varaTy]], varbTy)) + let v_enumOfValue_info = makeIntrinsicValRef(fslib_MFLanguagePrimitives_nleref, "EnumOfValue" , None , None , [vara; varb], ([[varaTy]], varbTy)) - let generic_comparison_withc_outer_info = makeIntrinsicValRef(fslib_MFLanguagePrimitives_nleref, "GenericComparisonWithComparer" ,None ,None ,[vara], mk_compare_withc_sig varaTy) - let generic_hash_withc_tuple2_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "FastHashTuple2" ,None ,None ,[vara;varb], mk_hash_withc_sig (decodeTupleTy tupInfoRef [varaTy; varbTy])) - let generic_hash_withc_tuple3_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "FastHashTuple3" ,None ,None ,[vara;varb;varc], mk_hash_withc_sig (decodeTupleTy tupInfoRef [varaTy; varbTy; varcTy])) - let generic_hash_withc_tuple4_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "FastHashTuple4" ,None ,None ,[vara;varb;varc;vard], mk_hash_withc_sig (decodeTupleTy tupInfoRef [varaTy; varbTy; varcTy; vardTy])) - let generic_hash_withc_tuple5_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "FastHashTuple5" ,None ,None ,[vara;varb;varc;vard;vare],mk_hash_withc_sig (decodeTupleTy tupInfoRef [varaTy; varbTy; varcTy; vardTy; vareTy])) - let generic_equals_withc_tuple2_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "FastEqualsTuple2" ,None ,None ,[vara;varb], mk_equality_withc_sig (decodeTupleTy tupInfoRef [varaTy; varbTy])) - let generic_equals_withc_tuple3_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "FastEqualsTuple3" ,None ,None ,[vara;varb;varc], mk_equality_withc_sig (decodeTupleTy tupInfoRef [varaTy; varbTy; varcTy])) - let generic_equals_withc_tuple4_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "FastEqualsTuple4" ,None ,None ,[vara;varb;varc;vard], mk_equality_withc_sig (decodeTupleTy tupInfoRef [varaTy; varbTy; varcTy; vardTy])) - let generic_equals_withc_tuple5_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "FastEqualsTuple5" ,None ,None ,[vara;varb;varc;vard;vare],mk_equality_withc_sig (decodeTupleTy tupInfoRef [varaTy; varbTy; varcTy; vardTy; vareTy])) - - let generic_compare_withc_tuple2_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "FastCompareTuple2" ,None ,None ,[vara;varb], mk_compare_withc_sig (decodeTupleTy tupInfoRef [varaTy; varbTy])) - let generic_compare_withc_tuple3_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "FastCompareTuple3" ,None ,None ,[vara;varb;varc], mk_compare_withc_sig (decodeTupleTy tupInfoRef [varaTy; varbTy; varcTy])) - let generic_compare_withc_tuple4_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "FastCompareTuple4" ,None ,None ,[vara;varb;varc;vard], mk_compare_withc_sig (decodeTupleTy tupInfoRef [varaTy; varbTy; varcTy; vardTy])) - let generic_compare_withc_tuple5_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "FastCompareTuple5" ,None ,None ,[vara;varb;varc;vard;vare],mk_compare_withc_sig (decodeTupleTy tupInfoRef [varaTy; varbTy; varcTy; vardTy; vareTy])) - - - let generic_equality_er_outer_info = makeIntrinsicValRef(fslib_MFLanguagePrimitives_nleref, "GenericEqualityER" ,None ,None ,[vara], mk_rel_sig varaTy) - let get_generic_comparer_info = makeIntrinsicValRef(fslib_MFLanguagePrimitives_nleref, "GenericComparer" ,None ,None ,[], ([], mk_IComparer_ty)) - let get_generic_er_equality_comparer_info = makeIntrinsicValRef(fslib_MFLanguagePrimitives_nleref, "GenericEqualityERComparer" ,None ,None ,[], ([], mk_IEqualityComparer_ty)) - let get_generic_per_equality_comparer_info = makeIntrinsicValRef(fslib_MFLanguagePrimitives_nleref, "GenericEqualityComparer" ,None ,None ,[], ([], mk_IEqualityComparer_ty)) - let generic_equality_withc_outer_info = makeIntrinsicValRef(fslib_MFLanguagePrimitives_nleref, "GenericEqualityWithComparer" ,None ,None ,[vara], mk_equality_withc_sig varaTy) - let generic_hash_withc_outer_info = makeIntrinsicValRef(fslib_MFLanguagePrimitives_nleref, "GenericHashWithComparer" ,None ,None ,[vara], mk_hash_withc_sig varaTy) - - let generic_equality_er_inner_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "GenericEqualityERIntrinsic" ,None ,None ,[vara], mk_rel_sig varaTy) - let generic_equality_per_inner_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "GenericEqualityIntrinsic" ,None ,None ,[vara], mk_rel_sig varaTy) - let generic_equality_withc_inner_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "GenericEqualityWithComparerIntrinsic" ,None ,None ,[vara], mk_equality_withc_sig varaTy) - let generic_comparison_inner_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "GenericComparisonIntrinsic" ,None ,None ,[vara], mk_compare_sig varaTy) - let generic_comparison_withc_inner_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "GenericComparisonWithComparerIntrinsic",None ,None ,[vara], mk_compare_withc_sig varaTy) - - let generic_hash_inner_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "GenericHashIntrinsic" ,None ,None ,[vara], mk_hash_sig varaTy) - let generic_hash_withc_inner_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "GenericHashWithComparerIntrinsic" ,None ,None ,[vara], mk_hash_withc_sig varaTy) + let v_generic_comparison_withc_outer_info = makeIntrinsicValRef(fslib_MFLanguagePrimitives_nleref, "GenericComparisonWithComparer" , None , None , [vara], mk_compare_withc_sig varaTy) + let v_generic_hash_withc_tuple2_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "FastHashTuple2" , None , None , [vara;varb], mk_hash_withc_sig (decodeTupleTy tupInfoRef [varaTy; varbTy])) + let v_generic_hash_withc_tuple3_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "FastHashTuple3" , None , None , [vara;varb;varc], mk_hash_withc_sig (decodeTupleTy tupInfoRef [varaTy; varbTy; varcTy])) + let v_generic_hash_withc_tuple4_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "FastHashTuple4" , None , None , [vara;varb;varc;vard], mk_hash_withc_sig (decodeTupleTy tupInfoRef [varaTy; varbTy; varcTy; vardTy])) + let v_generic_hash_withc_tuple5_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "FastHashTuple5" , None , None , [vara;varb;varc;vard;vare], mk_hash_withc_sig (decodeTupleTy tupInfoRef [varaTy; varbTy; varcTy; vardTy; vareTy])) + let v_generic_equals_withc_tuple2_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "FastEqualsTuple2" , None , None , [vara;varb], mk_equality_withc_sig (decodeTupleTy tupInfoRef [varaTy; varbTy])) + let v_generic_equals_withc_tuple3_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "FastEqualsTuple3" , None , None , [vara;varb;varc], mk_equality_withc_sig (decodeTupleTy tupInfoRef [varaTy; varbTy; varcTy])) + let v_generic_equals_withc_tuple4_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "FastEqualsTuple4" , None , None , [vara;varb;varc;vard], mk_equality_withc_sig (decodeTupleTy tupInfoRef [varaTy; varbTy; varcTy; vardTy])) + let v_generic_equals_withc_tuple5_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "FastEqualsTuple5" , None , None , [vara;varb;varc;vard;vare], mk_equality_withc_sig (decodeTupleTy tupInfoRef [varaTy; varbTy; varcTy; vardTy; vareTy])) + + let v_generic_compare_withc_tuple2_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "FastCompareTuple2" , None , None , [vara;varb], mk_compare_withc_sig (decodeTupleTy tupInfoRef [varaTy; varbTy])) + let v_generic_compare_withc_tuple3_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "FastCompareTuple3" , None , None , [vara;varb;varc], mk_compare_withc_sig (decodeTupleTy tupInfoRef [varaTy; varbTy; varcTy])) + let v_generic_compare_withc_tuple4_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "FastCompareTuple4" , None , None , [vara;varb;varc;vard], mk_compare_withc_sig (decodeTupleTy tupInfoRef [varaTy; varbTy; varcTy; vardTy])) + let v_generic_compare_withc_tuple5_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "FastCompareTuple5" , None , None , [vara;varb;varc;vard;vare], mk_compare_withc_sig (decodeTupleTy tupInfoRef [varaTy; varbTy; varcTy; vardTy; vareTy])) + + + let v_generic_equality_er_outer_info = makeIntrinsicValRef(fslib_MFLanguagePrimitives_nleref, "GenericEqualityER" , None , None , [vara], mk_rel_sig varaTy) + let v_get_generic_comparer_info = makeIntrinsicValRef(fslib_MFLanguagePrimitives_nleref, "GenericComparer" , None , None , [], ([], v_IComparer_ty)) + let v_get_generic_er_equality_comparer_info = makeIntrinsicValRef(fslib_MFLanguagePrimitives_nleref, "GenericEqualityERComparer" , None , None , [], ([], v_IEqualityComparer_ty)) + let v_get_generic_per_equality_comparer_info = makeIntrinsicValRef(fslib_MFLanguagePrimitives_nleref, "GenericEqualityComparer" , None , None , [], ([], v_IEqualityComparer_ty)) + let v_generic_equality_withc_outer_info = makeIntrinsicValRef(fslib_MFLanguagePrimitives_nleref, "GenericEqualityWithComparer" , None , None , [vara], mk_equality_withc_sig varaTy) + let v_generic_hash_withc_outer_info = makeIntrinsicValRef(fslib_MFLanguagePrimitives_nleref, "GenericHashWithComparer" , None , None , [vara], mk_hash_withc_sig varaTy) + + let v_generic_equality_er_inner_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "GenericEqualityERIntrinsic" , None , None , [vara], mk_rel_sig varaTy) + let v_generic_equality_per_inner_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "GenericEqualityIntrinsic" , None , None , [vara], mk_rel_sig varaTy) + let v_generic_equality_withc_inner_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "GenericEqualityWithComparerIntrinsic" , None , None , [vara], mk_equality_withc_sig varaTy) + let v_generic_comparison_inner_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "GenericComparisonIntrinsic" , None , None , [vara], mk_compare_sig varaTy) + let v_generic_comparison_withc_inner_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "GenericComparisonWithComparerIntrinsic", None , None , [vara], mk_compare_withc_sig varaTy) + + let v_generic_hash_inner_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "GenericHashIntrinsic" , None , None , [vara], mk_hash_sig varaTy) + let v_generic_hash_withc_inner_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "GenericHashWithComparerIntrinsic" , None , None , [vara], mk_hash_withc_sig varaTy) - let create_instance_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "CreateInstance" ,None ,None ,[vara], ([[unit_ty]], varaTy)) - let unbox_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "UnboxGeneric" ,None ,None ,[vara], ([[obj_ty]], varaTy)) - - let unbox_fast_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "UnboxFast" ,None ,None ,[vara], ([[obj_ty]], varaTy)) - let istype_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "TypeTestGeneric" ,None ,None ,[vara], ([[obj_ty]], bool_ty)) - let istype_fast_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "TypeTestFast" ,None ,None ,[vara], ([[obj_ty]], bool_ty)) - - let dispose_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "Dispose" ,None ,None ,[vara], ([[varaTy]],unit_ty)) - - let getstring_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "GetString" ,None ,None ,[], ([[string_ty];[int_ty]],char_ty)) - - let reference_equality_inner_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "PhysicalEqualityIntrinsic" ,None ,None ,[vara], mk_rel_sig varaTy) - - let bitwise_or_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "op_BitwiseOr" ,None ,None ,[vara], mk_binop_ty varaTy) - let bitwise_and_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "op_BitwiseAnd" ,None ,None ,[vara], mk_binop_ty varaTy) - let bitwise_xor_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "op_ExclusiveOr" ,None ,None ,[vara], mk_binop_ty varaTy) - let bitwise_unary_not_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "op_LogicalNot" ,None ,None ,[vara], mk_unop_ty varaTy) - let bitwise_shift_left_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "op_LeftShift" ,None ,None ,[vara], mk_shiftop_ty varaTy) - let bitwise_shift_right_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "op_RightShift" ,None ,None ,[vara], mk_shiftop_ty varaTy) - let unchecked_addition_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "op_Addition" ,None ,None ,[vara;varb;varc], mk_binop_ty3 varaTy varbTy varcTy) - let unchecked_subtraction_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "op_Subtraction" ,None ,None ,[vara;varb;varc], mk_binop_ty3 varaTy varbTy varcTy) - let unchecked_multiply_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "op_Multiply" ,None ,None ,[vara;varb;varc], mk_binop_ty3 varaTy varbTy varcTy) - let unchecked_unary_plus_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "op_UnaryPlus" ,None ,None ,[vara], mk_unop_ty varaTy) - let unchecked_unary_minus_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "op_UnaryNegation" ,None ,None ,[vara], mk_unop_ty varaTy) - let unchecked_unary_not_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "not" ,None ,Some "Not" ,[], mk_unop_ty bool_ty) - - let raise_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "raise" ,None ,Some "Raise" ,[vara], ([[mkSysNonGenericTy sys "Exception"]],varaTy)) - let failwith_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "failwith" ,None ,Some "FailWith" ,[vara], ([[string_ty]],varaTy)) - let invalid_arg_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "invalidArg" ,None ,Some "InvalidArg" ,[vara], ([[string_ty]; [string_ty]],varaTy)) - let null_arg_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "nullArg" ,None ,Some "NullArg" ,[vara], ([[string_ty]],varaTy)) - let invalid_op_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "invalidOp" ,None ,Some "InvalidOp" ,[vara], ([[string_ty]],varaTy)) - let failwithf_info = makeIntrinsicValRef(fslib_MFExtraTopLevelOperators_nleref, "failwithf" ,None, Some "PrintFormatToStringThenFail" ,[vara;varb],([[mk_format4_ty varaTy unit_ty string_ty string_ty]], varaTy)) + let v_create_instance_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "CreateInstance" , None , None , [vara], ([[v_unit_ty]], varaTy)) + let v_unbox_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "UnboxGeneric" , None , None , [vara], ([[v_obj_ty]], varaTy)) + + let v_unbox_fast_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "UnboxFast" , None , None , [vara], ([[v_obj_ty]], varaTy)) + let v_istype_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "TypeTestGeneric" , None , None , [vara], ([[v_obj_ty]], v_bool_ty)) + let v_istype_fast_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "TypeTestFast" , None , None , [vara], ([[v_obj_ty]], v_bool_ty)) + + let v_dispose_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "Dispose" , None , None , [vara], ([[varaTy]], v_unit_ty)) + + let v_getstring_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "GetString" , None , None , [], ([[v_string_ty];[v_int_ty]], v_char_ty)) + + let v_reference_equality_inner_info = makeIntrinsicValRef(fslib_MFHashCompare_nleref, "PhysicalEqualityIntrinsic" , None , None , [vara], mk_rel_sig varaTy) + + let v_bitwise_or_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "op_BitwiseOr" , None , None , [vara], mk_binop_ty varaTy) + let v_bitwise_and_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "op_BitwiseAnd" , None , None , [vara], mk_binop_ty varaTy) + let v_bitwise_xor_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "op_ExclusiveOr" , None , None , [vara], mk_binop_ty varaTy) + let v_bitwise_unary_not_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "op_LogicalNot" , None , None , [vara], mk_unop_ty varaTy) + let v_bitwise_shift_left_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "op_LeftShift" , None , None , [vara], mk_shiftop_ty varaTy) + let v_bitwise_shift_right_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "op_RightShift" , None , None , [vara], mk_shiftop_ty varaTy) + let v_unchecked_addition_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "op_Addition" , None , None , [vara;varb;varc], mk_binop_ty3 varaTy varbTy varcTy) + let v_unchecked_subtraction_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "op_Subtraction" , None , None , [vara;varb;varc], mk_binop_ty3 varaTy varbTy varcTy) + let v_unchecked_multiply_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "op_Multiply" , None , None , [vara;varb;varc], mk_binop_ty3 varaTy varbTy varcTy) + let v_unchecked_unary_plus_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "op_UnaryPlus" , None , None , [vara], mk_unop_ty varaTy) + let v_unchecked_unary_minus_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "op_UnaryNegation" , None , None , [vara], mk_unop_ty varaTy) + let v_unchecked_unary_not_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "not" , None , Some "Not" , [], mk_unop_ty v_bool_ty) + + let v_raise_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "raise" , None , Some "Raise" , [vara], ([[mkSysNonGenericTy sys "Exception"]], varaTy)) + let v_failwith_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "failwith" , None , Some "FailWith" , [vara], ([[v_string_ty]], varaTy)) + let v_invalid_arg_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "invalidArg" , None , Some "InvalidArg" , [vara], ([[v_string_ty]; [v_string_ty]], varaTy)) + let v_null_arg_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "nullArg" , None , Some "NullArg" , [vara], ([[v_string_ty]], varaTy)) + let v_invalid_op_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "invalidOp" , None , Some "InvalidOp" , [vara], ([[v_string_ty]], varaTy)) + let v_failwithf_info = makeIntrinsicValRef(fslib_MFExtraTopLevelOperators_nleref, "failwithf" , None, Some "PrintFormatToStringThenFail" , [vara;varb], ([[mk_format4_ty varaTy v_unit_ty v_string_ty v_string_ty]], varaTy)) - let reraise_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "reraise" ,None ,Some "Reraise",[vara], ([[unit_ty]],varaTy)) - let typeof_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "typeof" ,None ,Some "TypeOf" ,[vara], ([],system_Type_typ)) - let methodhandleof_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "methodhandleof" ,None ,Some "MethodHandleOf",[vara;varb],([[varaTy --> varbTy]],system_RuntimeMethodHandle_typ)) - let sizeof_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "sizeof" ,None ,Some "SizeOf" ,[vara], ([],int_ty)) - let unchecked_defaultof_info = makeIntrinsicValRef(fslib_MFOperatorsUnchecked_nleref, "defaultof" ,None ,Some "DefaultOf",[vara], ([],varaTy)) - let typedefof_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "typedefof" ,None ,Some "TypeDefOf",[vara], ([],system_Type_typ)) - let enum_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "enum" ,None ,Some "ToEnum" ,[vara], ([[int_ty]],varaTy)) - let range_op_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "op_Range" ,None ,None ,[vara], ([[varaTy];[varaTy]],mkSeqTy varaTy)) - let range_step_op_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "op_RangeStep" ,None ,None ,[vara;varb],([[varaTy];[varbTy];[varaTy]],mkSeqTy varaTy)) - let range_int32_op_info = makeIntrinsicValRef(fslib_MFOperatorIntrinsics_nleref, "RangeInt32" ,None ,None ,[], ([[int_ty];[int_ty];[int_ty]],mkSeqTy int_ty)) - let array2D_get_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "GetArray2D" ,None ,None ,[vara], ([[mkArrayType 2 varaTy];[int_ty]; [int_ty]],varaTy)) - let array3D_get_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "GetArray3D" ,None ,None ,[vara], ([[mkArrayType 3 varaTy];[int_ty]; [int_ty]; [int_ty]],varaTy)) - let array4D_get_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "GetArray4D" ,None ,None ,[vara], ([[mkArrayType 4 varaTy];[int_ty]; [int_ty]; [int_ty]; [int_ty]],varaTy)) - - let seq_collect_info = makeIntrinsicValRef(fslib_MFSeqModule_nleref, "collect" ,None ,Some "Collect",[vara;varb;varc],([[varaTy --> varbTy]; [mkSeqTy varaTy]], mkSeqTy varcTy)) - let seq_delay_info = makeIntrinsicValRef(fslib_MFSeqModule_nleref, "delay" ,None ,Some "Delay" ,[varb], ([[unit_ty --> mkSeqTy varbTy]], mkSeqTy varbTy)) - let seq_append_info = makeIntrinsicValRef(fslib_MFSeqModule_nleref, "append" ,None ,Some "Append" ,[varb], ([[mkSeqTy varbTy]; [mkSeqTy varbTy]], mkSeqTy varbTy)) - let seq_using_info = makeIntrinsicValRef(fslib_MFRuntimeHelpers_nleref, "EnumerateUsing" ,None ,None ,[vara;varb;varc], ([[varaTy];[(varaTy --> varbTy)]],mkSeqTy varcTy)) - let seq_generated_info = makeIntrinsicValRef(fslib_MFRuntimeHelpers_nleref, "EnumerateWhile" ,None ,None ,[varb], ([[unit_ty --> bool_ty]; [mkSeqTy varbTy]], mkSeqTy varbTy)) - let seq_finally_info = makeIntrinsicValRef(fslib_MFRuntimeHelpers_nleref, "EnumerateThenFinally" ,None ,None ,[varb], ([[mkSeqTy varbTy]; [unit_ty --> unit_ty]], mkSeqTy varbTy)) - let seq_of_functions_info = makeIntrinsicValRef(fslib_MFRuntimeHelpers_nleref, "EnumerateFromFunctions" ,None ,None ,[vara;varb],([[unit_ty --> varaTy]; [varaTy --> bool_ty]; [varaTy --> varbTy]], mkSeqTy varbTy)) - let create_event_info = makeIntrinsicValRef(fslib_MFRuntimeHelpers_nleref, "CreateEvent" ,None ,None ,[vara;varb],([[varaTy --> unit_ty]; [varaTy --> unit_ty]; [(obj_ty --> (varbTy --> unit_ty)) --> varaTy]], TType_app (fslib_IEvent2_tcr, [varaTy;varbTy]))) - let seq_to_array_info = makeIntrinsicValRef(fslib_MFSeqModule_nleref, "toArray" ,None ,Some "ToArray",[varb], ([[mkSeqTy varbTy]], mkArrayType 1 varbTy)) - let seq_to_list_info = makeIntrinsicValRef(fslib_MFSeqModule_nleref, "toList" ,None ,Some "ToList" ,[varb], ([[mkSeqTy varbTy]], mkListTy varbTy)) - let seq_map_info = makeIntrinsicValRef(fslib_MFSeqModule_nleref, "map" ,None ,Some "Map" ,[vara;varb],([[varaTy --> varbTy]; [mkSeqTy varaTy]], mkSeqTy varbTy)) - let seq_singleton_info = makeIntrinsicValRef(fslib_MFSeqModule_nleref, "singleton" ,None ,Some "Singleton" ,[vara], ([[varaTy]], mkSeqTy varaTy)) - let seq_empty_info = makeIntrinsicValRef(fslib_MFSeqModule_nleref, "empty" ,None ,Some "Empty" ,[vara], ([], mkSeqTy varaTy)) - let new_format_info = makeIntrinsicValRef(fslib_MFCore_nleref, ".ctor" ,Some "PrintfFormat`5",None ,[vara;varb;varc;vard;vare], ([[string_ty]], mkPrintfFormatTy varaTy varbTy varcTy vardTy vareTy)) - let sprintf_info = makeIntrinsicValRef(fslib_MFExtraTopLevelOperators_nleref, "sprintf" ,None ,Some "PrintFormatToStringThen",[vara], ([[mk_format4_ty varaTy unit_ty string_ty string_ty]], varaTy)) - let lazy_force_info = + let v_reraise_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "reraise" , None , Some "Reraise", [vara], ([[v_unit_ty]], varaTy)) + let v_typeof_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "typeof" , None , Some "TypeOf" , [vara], ([], v_system_Type_typ)) + let v_methodhandleof_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "methodhandleof" , None , Some "MethodHandleOf", [vara;varb], ([[varaTy --> varbTy]], v_system_RuntimeMethodHandle_typ)) + let v_sizeof_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "sizeof" , None , Some "SizeOf" , [vara], ([], v_int_ty)) + let v_unchecked_defaultof_info = makeIntrinsicValRef(fslib_MFOperatorsUnchecked_nleref, "defaultof" , None , Some "DefaultOf", [vara], ([], varaTy)) + let v_typedefof_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "typedefof" , None , Some "TypeDefOf", [vara], ([], v_system_Type_typ)) + let v_enum_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "enum" , None , Some "ToEnum" , [vara], ([[v_int_ty]], varaTy)) + let v_range_op_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "op_Range" , None , None , [vara], ([[varaTy];[varaTy]], mkSeqTy varaTy)) + let v_range_step_op_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "op_RangeStep" , None , None , [vara;varb], ([[varaTy];[varbTy];[varaTy]], mkSeqTy varaTy)) + let v_range_int32_op_info = makeIntrinsicValRef(fslib_MFOperatorIntrinsics_nleref, "RangeInt32" , None , None , [], ([[v_int_ty];[v_int_ty];[v_int_ty]], mkSeqTy v_int_ty)) + let v_array2D_get_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "GetArray2D" , None , None , [vara], ([[mkArrayType 2 varaTy];[v_int_ty]; [v_int_ty]], varaTy)) + let v_array3D_get_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "GetArray3D" , None , None , [vara], ([[mkArrayType 3 varaTy];[v_int_ty]; [v_int_ty]; [v_int_ty]], varaTy)) + let v_array4D_get_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "GetArray4D" , None , None , [vara], ([[mkArrayType 4 varaTy];[v_int_ty]; [v_int_ty]; [v_int_ty]; [v_int_ty]], varaTy)) + + let v_seq_collect_info = makeIntrinsicValRef(fslib_MFSeqModule_nleref, "collect" , None , Some "Collect", [vara;varb;varc], ([[varaTy --> varbTy]; [mkSeqTy varaTy]], mkSeqTy varcTy)) + let v_seq_delay_info = makeIntrinsicValRef(fslib_MFSeqModule_nleref, "delay" , None , Some "Delay" , [varb], ([[v_unit_ty --> mkSeqTy varbTy]], mkSeqTy varbTy)) + let v_seq_append_info = makeIntrinsicValRef(fslib_MFSeqModule_nleref, "append" , None , Some "Append" , [varb], ([[mkSeqTy varbTy]; [mkSeqTy varbTy]], mkSeqTy varbTy)) + let v_seq_using_info = makeIntrinsicValRef(fslib_MFRuntimeHelpers_nleref, "EnumerateUsing" , None , None , [vara;varb;varc], ([[varaTy];[(varaTy --> varbTy)]], mkSeqTy varcTy)) + let v_seq_generated_info = makeIntrinsicValRef(fslib_MFRuntimeHelpers_nleref, "EnumerateWhile" , None , None , [varb], ([[v_unit_ty --> v_bool_ty]; [mkSeqTy varbTy]], mkSeqTy varbTy)) + let v_seq_finally_info = makeIntrinsicValRef(fslib_MFRuntimeHelpers_nleref, "EnumerateThenFinally" , None , None , [varb], ([[mkSeqTy varbTy]; [v_unit_ty --> v_unit_ty]], mkSeqTy varbTy)) + let v_seq_of_functions_info = makeIntrinsicValRef(fslib_MFRuntimeHelpers_nleref, "EnumerateFromFunctions" , None , None , [vara;varb], ([[v_unit_ty --> varaTy]; [varaTy --> v_bool_ty]; [varaTy --> varbTy]], mkSeqTy varbTy)) + let v_create_event_info = makeIntrinsicValRef(fslib_MFRuntimeHelpers_nleref, "CreateEvent" , None , None , [vara;varb], ([[varaTy --> v_unit_ty]; [varaTy --> v_unit_ty]; [(v_obj_ty --> (varbTy --> v_unit_ty)) --> varaTy]], TType_app (v_fslib_IEvent2_tcr, [varaTy;varbTy]))) + let v_seq_to_array_info = makeIntrinsicValRef(fslib_MFSeqModule_nleref, "toArray" , None , Some "ToArray", [varb], ([[mkSeqTy varbTy]], mkArrayType 1 varbTy)) + let v_seq_to_list_info = makeIntrinsicValRef(fslib_MFSeqModule_nleref, "toList" , None , Some "ToList" , [varb], ([[mkSeqTy varbTy]], mkListTy varbTy)) + let v_seq_map_info = makeIntrinsicValRef(fslib_MFSeqModule_nleref, "map" , None , Some "Map" , [vara;varb], ([[varaTy --> varbTy]; [mkSeqTy varaTy]], mkSeqTy varbTy)) + let v_seq_singleton_info = makeIntrinsicValRef(fslib_MFSeqModule_nleref, "singleton" , None , Some "Singleton" , [vara], ([[varaTy]], mkSeqTy varaTy)) + let v_seq_empty_info = makeIntrinsicValRef(fslib_MFSeqModule_nleref, "empty" , None , Some "Empty" , [vara], ([], mkSeqTy varaTy)) + let v_new_format_info = makeIntrinsicValRef(fslib_MFCore_nleref, ".ctor" , Some "PrintfFormat`5", None , [vara;varb;varc;vard;vare], ([[v_string_ty]], mkPrintfFormatTy varaTy varbTy varcTy vardTy vareTy)) + let v_sprintf_info = makeIntrinsicValRef(fslib_MFExtraTopLevelOperators_nleref, "sprintf" , None , Some "PrintFormatToStringThen", [vara], ([[mk_format4_ty varaTy v_unit_ty v_string_ty v_string_ty]], varaTy)) + let v_lazy_force_info = // Lazy\Value for > 4.0 - makeIntrinsicValRef(fslib_MFLazyExtensions_nleref, "Force" ,Some "Lazy`1" ,None ,[vara], ([[mkLazyTy varaTy]; []], varaTy)) - let lazy_create_info = makeIntrinsicValRef(fslib_MFLazyExtensions_nleref, "Create" ,Some "Lazy`1" ,None ,[vara], ([[unit_ty --> varaTy]], mkLazyTy varaTy)) - - let seq_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "seq" ,None ,Some "CreateSequence" ,[vara], ([[mkSeqTy varaTy]], mkSeqTy varaTy)) - let splice_expr_info = makeIntrinsicValRef(fslib_MFExtraTopLevelOperators_nleref, "op_Splice" ,None ,None ,[vara], ([[mkQuotedExprTy varaTy]], varaTy)) - let splice_raw_expr_info = makeIntrinsicValRef(fslib_MFExtraTopLevelOperators_nleref, "op_SpliceUntyped" ,None ,None ,[vara], ([[mkRawQuotedExprTy]], varaTy)) - let new_decimal_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "MakeDecimal" ,None ,None ,[], ([[int_ty]; [int_ty]; [int_ty]; [bool_ty]; [byte_ty]], decimal_ty)) - let array_get_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "GetArray" ,None ,None ,[vara], ([[mkArrayType 1 varaTy]; [int_ty]], varaTy)) - let array_length_info = makeIntrinsicValRef(fslib_MFArrayModule_nleref, "length" ,None ,Some "Length" ,[vara], ([[mkArrayType 1 varaTy]], int_ty)) - let deserialize_quoted_FSharp_20_plus_info = makeIntrinsicValRef(fslib_MFQuotations_nleref, "Deserialize" ,Some "Expr" ,None ,[], ([[system_Type_typ ;mkListTy system_Type_typ ;mkListTy mkRawQuotedExprTy ; mkArrayType 1 byte_ty]], mkRawQuotedExprTy )) - let deserialize_quoted_FSharp_40_plus_info = makeIntrinsicValRef(fslib_MFQuotations_nleref, "Deserialize40" ,Some "Expr" ,None ,[], ([[system_Type_typ ;mkArrayType 1 system_Type_typ; mkArrayType 1 system_Type_typ; mkArrayType 1 mkRawQuotedExprTy; mkArrayType 1 byte_ty]], mkRawQuotedExprTy )) - let cast_quotation_info = makeIntrinsicValRef(fslib_MFQuotations_nleref, "Cast" ,Some "Expr" ,None ,[vara], ([[mkRawQuotedExprTy]], mkQuotedExprTy varaTy)) - let lift_value_info = makeIntrinsicValRef(fslib_MFQuotations_nleref, "Value" ,Some "Expr" ,None ,[vara], ([[varaTy]], mkRawQuotedExprTy)) - let lift_value_with_name_info = makeIntrinsicValRef(fslib_MFQuotations_nleref, "ValueWithName" ,Some "Expr" ,None ,[vara], ([[varaTy; string_ty]], mkRawQuotedExprTy)) - let lift_value_with_defn_info = makeIntrinsicValRef(fslib_MFQuotations_nleref, "WithValue" ,Some "Expr" ,None ,[vara], ([[varaTy; mkQuotedExprTy varaTy]], mkQuotedExprTy varaTy)) - let query_value_info = makeIntrinsicValRef(fslib_MFExtraTopLevelOperators_nleref, "query" ,None ,None ,[], ([], mkQueryBuilderTy) ) - let query_run_value_info = makeIntrinsicValRef(fslib_MFQueryRunExtensionsLowPriority_nleref, "Run" ,Some "QueryBuilder" ,None ,[vara], ([[mkQueryBuilderTy];[mkQuotedExprTy varaTy]], varaTy) ) - let query_run_enumerable_info = makeIntrinsicValRef(fslib_MFQueryRunExtensionsHighPriority_nleref, "Run" ,Some "QueryBuilder" ,None ,[vara], ([[mkQueryBuilderTy];[mkQuotedExprTy (mkQuerySourceTy varaTy (mkNonGenericTy tcref_System_Collections_IEnumerable)) ]], mkSeqTy varaTy) ) - let query_for_value_info = makeIntrinsicValRef(fslib_MFLinq_nleref, "For" ,Some "QueryBuilder" ,None ,[vara; vard; varb; vare], ([[mkQueryBuilderTy];[mkQuerySourceTy varaTy vardTy;varaTy --> mkQuerySourceTy varbTy vareTy]], mkQuerySourceTy varbTy vardTy) ) - let query_select_value_info = makeIntrinsicValRef(fslib_MFLinq_nleref, "Select" ,Some "QueryBuilder" ,None ,[vara; vare; varb], ([[mkQueryBuilderTy];[mkQuerySourceTy varaTy vareTy;varaTy --> varbTy]], mkQuerySourceTy varbTy vareTy) ) - let query_yield_value_info = makeIntrinsicValRef(fslib_MFLinq_nleref, "Yield" ,Some "QueryBuilder" ,None ,[vara; vare], ([[mkQueryBuilderTy];[varaTy]], mkQuerySourceTy varaTy vareTy) ) - let query_yield_from_value_info = makeIntrinsicValRef(fslib_MFLinq_nleref, "YieldFrom" ,Some "QueryBuilder" ,None ,[vara; vare], ([[mkQueryBuilderTy];[mkQuerySourceTy varaTy vareTy]], mkQuerySourceTy varaTy vareTy) ) - let query_source_info = makeIntrinsicValRef(fslib_MFLinq_nleref, "Source" ,Some "QueryBuilder" ,None ,[vara], ([[mkQueryBuilderTy];[mkSeqTy varaTy ]], mkQuerySourceTy varaTy (mkNonGenericTy tcref_System_Collections_IEnumerable)) ) - let query_source_as_enum_info = makeIntrinsicValRef(fslib_MFLinq_nleref, "get_Source" ,Some "QuerySource`2" ,None ,[vara; vare], ([[mkQuerySourceTy varaTy vareTy];[]], mkSeqTy varaTy) ) - let new_query_source_info = makeIntrinsicValRef(fslib_MFLinq_nleref, ".ctor" ,Some "QuerySource`2" ,None ,[vara; vare], ([[mkSeqTy varaTy]], mkQuerySourceTy varaTy vareTy) ) - let query_where_value_info = makeIntrinsicValRef(fslib_MFLinq_nleref, "Where" ,Some "QueryBuilder" ,None ,[vara; vare], ([[mkQueryBuilderTy];[mkQuerySourceTy varaTy vareTy;varaTy --> bool_ty]], mkQuerySourceTy varaTy vareTy) ) - let query_zero_value_info = makeIntrinsicValRef(fslib_MFLinq_nleref, "Zero" ,Some "QueryBuilder" ,None ,[vara; vare], ([[mkQueryBuilderTy];[]], mkQuerySourceTy varaTy vareTy) ) - let fail_init_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "FailInit" ,None ,None ,[], ([[unit_ty]], unit_ty)) - let fail_static_init_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "FailStaticInit" ,None ,None ,[], ([[unit_ty]], unit_ty)) - let check_this_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "CheckThis" ,None ,None ,[vara], ([[varaTy]], varaTy)) - let quote_to_linq_lambda_info = makeIntrinsicValRef(fslib_MFLinqRuntimeHelpersQuotationConverter_nleref, "QuotationToLambdaExpression" ,None ,None ,[vara], ([[mkQuotedExprTy varaTy]], mkLinqExpressionTy varaTy)) - - { ilg=ilg - ilxPubCloEnv=EraseClosures.newIlxPubCloEnv(ilg) - knownIntrinsics = knownIntrinsics - knownFSharpCoreModules = knownFSharpCoreModules - compilingFslib = compilingFslib - mlCompatibility = mlCompatibility - emitDebugInfoInQuotations = emitDebugInfoInQuotations - directoryToResolveRelativePaths= directoryToResolveRelativePaths - unionCaseRefEq = unionCaseRefEq - valRefEq = valRefEq - fslibCcu = fslibCcu - using40environment = using40environment - refcell_tcr_canon = mk_MFCore_tcref fslibCcu "Ref`1" - option_tcr_canon = mk_MFCore_tcref fslibCcu "Option`1" - list_tcr_canon = mk_MFCollections_tcref fslibCcu "List`1" - set_tcr_canon = mk_MFCollections_tcref fslibCcu "Set`1" - map_tcr_canon = mk_MFCollections_tcref fslibCcu "Map`2" - lazy_tcr_canon = lazy_tcr - refcell_tcr_nice = mk_MFCore_tcref fslibCcu "ref`1" - array_tcr_nice = il_arr_tcr_map.[0] - option_tcr_nice = option_tcr_nice - list_tcr_nice = list_tcr_nice - lazy_tcr_nice = lazy_tcr_nice - format_tcr = format_tcr - expr_tcr = expr_tcr - raw_expr_tcr = raw_expr_tcr - nativeint_tcr = nativeint_tcr - int32_tcr = int32_tcr - int16_tcr = int16_tcr - int64_tcr = int64_tcr - uint16_tcr = uint16_tcr - uint32_tcr = uint32_tcr - uint64_tcr = uint64_tcr - sbyte_tcr = sbyte_tcr - decimal_tcr = decimal_tcr - date_tcr = date_tcr - pdecimal_tcr = pdecimal_tcr - byte_tcr = byte_tcr - bool_tcr = bool_tcr - unit_tcr_canon = unit_tcr_canon - unit_tcr_nice = unit_tcr_nice - exn_tcr = exn_tcr - char_tcr = char_tcr - float_tcr = float_tcr - float32_tcr = float32_tcr - pfloat_tcr = pfloat_tcr - pfloat32_tcr = pfloat32_tcr - pint_tcr = pint_tcr - pint8_tcr = pint8_tcr - pint16_tcr = pint16_tcr - pint64_tcr = pint64_tcr - byref_tcr = byref_tcr - nativeptr_tcr = nativeptr_tcr - ilsigptr_tcr = ilsigptr_tcr - fastFunc_tcr = fastFunc_tcr - tcref_IQueryable = tcref_IQueryable - tcref_IObservable = tcref_IObservable - tcref_IObserver = tcref_IObserver - fslib_IEvent2_tcr = fslib_IEvent2_tcr - fslib_IDelegateEvent_tcr = fslib_IDelegateEvent_tcr - seq_tcr = seq_tcr - seq_base_tcr = mk_MFCompilerServices_tcref fslibCcu "GeneratedSequenceBase`1" - measureproduct_tcr = mk_MFCompilerServices_tcref fslibCcu "MeasureProduct`2" - measureinverse_tcr = mk_MFCompilerServices_tcref fslibCcu "MeasureInverse`1" - measureone_tcr = mk_MFCompilerServices_tcref fslibCcu "MeasureOne" - il_arr_tcr_map = il_arr_tcr_map - ref_tuple1_tcr = ref_tuple1_tcr - ref_tuple2_tcr = ref_tuple2_tcr - ref_tuple3_tcr = ref_tuple3_tcr - ref_tuple4_tcr = ref_tuple4_tcr - ref_tuple5_tcr = ref_tuple5_tcr - ref_tuple6_tcr = ref_tuple6_tcr - ref_tuple7_tcr = ref_tuple7_tcr - ref_tuple8_tcr = ref_tuple8_tcr - struct_tuple1_tcr = struct_tuple1_tcr - struct_tuple2_tcr = struct_tuple2_tcr - struct_tuple3_tcr = struct_tuple3_tcr - struct_tuple4_tcr = struct_tuple4_tcr - struct_tuple5_tcr = struct_tuple5_tcr - struct_tuple6_tcr = struct_tuple6_tcr - struct_tuple7_tcr = struct_tuple7_tcr - struct_tuple8_tcr = struct_tuple8_tcr - choice2_tcr = choice2_tcr - choice3_tcr = choice3_tcr - choice4_tcr = choice4_tcr - choice5_tcr = choice5_tcr - choice6_tcr = choice6_tcr - choice7_tcr = choice7_tcr - nativeint_ty = mkNonGenericTy nativeint_tcr - unativeint_ty = mkNonGenericTy unativeint_tcr - int32_ty = mkNonGenericTy int32_tcr - int16_ty = mkNonGenericTy int16_tcr - int64_ty = mkNonGenericTy int64_tcr - uint16_ty = mkNonGenericTy uint16_tcr - uint32_ty = mkNonGenericTy uint32_tcr - uint64_ty = mkNonGenericTy uint64_tcr - sbyte_ty = mkNonGenericTy sbyte_tcr - byte_ty = byte_ty - bool_ty = bool_ty - int_ty = int_ty - string_ty = string_ty - obj_ty = mkNonGenericTy obj_tcr - unit_ty = unit_ty - exn_ty = mkNonGenericTy exn_tcr - char_ty = mkNonGenericTy char_tcr - decimal_ty = mkNonGenericTy decimal_tcr - float_ty = mkNonGenericTy float_tcr - float32_ty = mkNonGenericTy float32_tcr - memoize_file = memoize_file.Apply - - system_Array_typ = mkSysNonGenericTy sys "Array" - system_Object_typ = mkSysNonGenericTy sys "Object" - system_IDisposable_typ = mkSysNonGenericTy sys "IDisposable" - system_RuntimeHelpers_typ = mkSysNonGenericTy sysCompilerServices "RuntimeHelpers" - system_Value_typ = mkSysNonGenericTy sys "ValueType" - system_Delegate_typ = mkSysNonGenericTy sys "Delegate" - system_MulticastDelegate_typ = mkSysNonGenericTy sys "MulticastDelegate" - system_Enum_typ = mkSysNonGenericTy sys "Enum" - system_Exception_typ = mkSysNonGenericTy sys "Exception" - system_String_typ = mkSysNonGenericTy sys "String" - system_String_tcref = mkSysTyconRef sys "String" - system_Int32_typ = mkSysNonGenericTy sys "Int32" - system_Type_typ = system_Type_typ - system_TypedReference_tcref = tryMkSysTyconRef sys "TypedReference" - system_ArgIterator_tcref = tryMkSysTyconRef sys "ArgIterator" - system_RuntimeArgumentHandle_tcref = tryMkSysTyconRef sys "RuntimeArgumentHandle" - system_SByte_tcref = mkSysTyconRef sys "SByte" - system_Decimal_tcref = mkSysTyconRef sys "Decimal" - system_Int16_tcref = mkSysTyconRef sys "Int16" - system_Int32_tcref = mkSysTyconRef sys "Int32" - system_Int64_tcref = mkSysTyconRef sys "Int64" - system_IntPtr_tcref = mkSysTyconRef sys "IntPtr" - system_Bool_tcref = mkSysTyconRef sys "Boolean" - system_Byte_tcref = mkSysTyconRef sys "Byte" - system_UInt16_tcref = mkSysTyconRef sys "UInt16" - system_Char_tcref = mkSysTyconRef sys "Char" - system_UInt32_tcref = mkSysTyconRef sys "UInt32" - system_UInt64_tcref = mkSysTyconRef sys "UInt64" - system_UIntPtr_tcref = mkSysTyconRef sys "UIntPtr" - system_Single_tcref = mkSysTyconRef sys "Single" - system_Double_tcref = mkSysTyconRef sys "Double" - system_RuntimeTypeHandle_typ = mkSysNonGenericTy sys "RuntimeTypeHandle" - system_RuntimeMethodHandle_typ = system_RuntimeMethodHandle_typ - - system_MarshalByRefObject_tcref = tryMkSysTyconRef sys "MarshalByRefObject" - system_MarshalByRefObject_typ = tryMkSysNonGenericTy sys "MarshalByRefObject" - - system_Reflection_MethodInfo_typ = system_Reflection_MethodInfo_typ - - system_Array_tcref = mkSysTyconRef sys "Array" - system_Object_tcref = mkSysTyconRef sys "Object" - system_Void_tcref = mkSysTyconRef sys "Void" - system_IndexOutOfRangeException_tcref = mkSysTyconRef sys "IndexOutOfRangeException" - system_Nullable_tcref = nullable_tcr - system_GenericIComparable_tcref = mkSysTyconRef sys "IComparable`1" - system_GenericIEquatable_tcref = mkSysTyconRef sys "IEquatable`1" - mk_IComparable_ty = mkSysNonGenericTy sys "IComparable" - system_LinqExpression_tcref = linqExpression_tcr - - mk_IStructuralComparable_ty = mkSysNonGenericTy sysCollections "IStructuralComparable" - - mk_IStructuralEquatable_ty = mkSysNonGenericTy sysCollections "IStructuralEquatable" - - mk_IComparer_ty = mk_IComparer_ty - mk_IEqualityComparer_ty = mk_IEqualityComparer_ty - tcref_System_Collections_IComparer = mkSysTyconRef sysCollections "IComparer" - tcref_System_Collections_IEqualityComparer = mkSysTyconRef sysCollections "IEqualityComparer" - tcref_System_Collections_Generic_IEqualityComparer = mkSysTyconRef sysGenerics "IEqualityComparer`1" - tcref_System_Collections_Generic_Dictionary = mkSysTyconRef sysGenerics "Dictionary`2" - - tcref_System_IComparable = mkSysTyconRef sys "IComparable" - tcref_System_IStructuralComparable = mkSysTyconRef sysCollections "IStructuralComparable" - tcref_System_IStructuralEquatable = mkSysTyconRef sysCollections "IStructuralEquatable" - - tcref_LanguagePrimitives = mk_MFCore_tcref fslibCcu "LanguagePrimitives" - - - tcref_System_Collections_Generic_IList = mkSysTyconRef sysGenerics "IList`1" - tcref_System_Collections_Generic_IReadOnlyList = mkSysTyconRef sysGenerics "IReadOnlyList`1" - tcref_System_Collections_Generic_ICollection = mkSysTyconRef sysGenerics "ICollection`1" - tcref_System_Collections_Generic_IReadOnlyCollection = mkSysTyconRef sysGenerics "IReadOnlyCollection`1" - tcref_System_Collections_IEnumerable = tcref_System_Collections_IEnumerable - - tcref_System_Collections_Generic_IEnumerable = IEnumerable_tcr - tcref_System_Collections_Generic_IEnumerator = IEnumerator_tcr - - tcref_System_Attribute = System_Attribute_tcr - - attrib_AttributeUsageAttribute = mkSysAttrib "System.AttributeUsageAttribute" - attrib_ParamArrayAttribute = mkSysAttrib "System.ParamArrayAttribute" - attrib_IDispatchConstantAttribute = tryMkSysAttrib "System.Runtime.CompilerServices.IDispatchConstantAttribute" - attrib_IUnknownConstantAttribute = tryMkSysAttrib "System.Runtime.CompilerServices.IUnknownConstantAttribute" + makeIntrinsicValRef(fslib_MFLazyExtensions_nleref, "Force" , Some "Lazy`1" , None , [vara], ([[mkLazyTy varaTy]; []], varaTy)) + let v_lazy_create_info = makeIntrinsicValRef(fslib_MFLazyExtensions_nleref, "Create" , Some "Lazy`1" , None , [vara], ([[v_unit_ty --> varaTy]], mkLazyTy varaTy)) + + let v_seq_info = makeIntrinsicValRef(fslib_MFOperators_nleref, "seq" , None , Some "CreateSequence" , [vara], ([[mkSeqTy varaTy]], mkSeqTy varaTy)) + let v_splice_expr_info = makeIntrinsicValRef(fslib_MFExtraTopLevelOperators_nleref, "op_Splice" , None , None , [vara], ([[mkQuotedExprTy varaTy]], varaTy)) + let v_splice_raw_expr_info = makeIntrinsicValRef(fslib_MFExtraTopLevelOperators_nleref, "op_SpliceUntyped" , None , None , [vara], ([[mkRawQuotedExprTy]], varaTy)) + let v_new_decimal_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "MakeDecimal" , None , None , [], ([[v_int_ty]; [v_int_ty]; [v_int_ty]; [v_bool_ty]; [v_byte_ty]], v_decimal_ty)) + let v_array_get_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "GetArray" , None , None , [vara], ([[mkArrayType 1 varaTy]; [v_int_ty]], varaTy)) + let v_array_length_info = makeIntrinsicValRef(fslib_MFArrayModule_nleref, "length" , None , Some "Length" , [vara], ([[mkArrayType 1 varaTy]], v_int_ty)) + let v_deserialize_quoted_FSharp_20_plus_info = makeIntrinsicValRef(fslib_MFQuotations_nleref, "Deserialize" , Some "Expr" , None , [], ([[v_system_Type_typ ;mkListTy v_system_Type_typ ;mkListTy mkRawQuotedExprTy ; mkArrayType 1 v_byte_ty]], mkRawQuotedExprTy )) + let v_deserialize_quoted_FSharp_40_plus_info = makeIntrinsicValRef(fslib_MFQuotations_nleref, "Deserialize40" , Some "Expr" , None , [], ([[v_system_Type_typ ;mkArrayType 1 v_system_Type_typ; mkArrayType 1 v_system_Type_typ; mkArrayType 1 mkRawQuotedExprTy; mkArrayType 1 v_byte_ty]], mkRawQuotedExprTy )) + let v_cast_quotation_info = makeIntrinsicValRef(fslib_MFQuotations_nleref, "Cast" , Some "Expr" , None , [vara], ([[mkRawQuotedExprTy]], mkQuotedExprTy varaTy)) + let v_lift_value_info = makeIntrinsicValRef(fslib_MFQuotations_nleref, "Value" , Some "Expr" , None , [vara], ([[varaTy]], mkRawQuotedExprTy)) + let v_lift_value_with_name_info = makeIntrinsicValRef(fslib_MFQuotations_nleref, "ValueWithName" , Some "Expr" , None , [vara], ([[varaTy; v_string_ty]], mkRawQuotedExprTy)) + let v_lift_value_with_defn_info = makeIntrinsicValRef(fslib_MFQuotations_nleref, "WithValue" , Some "Expr" , None , [vara], ([[varaTy; mkQuotedExprTy varaTy]], mkQuotedExprTy varaTy)) + let v_query_value_info = makeIntrinsicValRef(fslib_MFExtraTopLevelOperators_nleref, "query" , None , None , [], ([], mkQueryBuilderTy) ) + let v_query_run_value_info = makeIntrinsicValRef(fslib_MFQueryRunExtensionsLowPriority_nleref, "Run" , Some "QueryBuilder" , None , [vara], ([[mkQueryBuilderTy];[mkQuotedExprTy varaTy]], varaTy) ) + let v_query_run_enumerable_info = makeIntrinsicValRef(fslib_MFQueryRunExtensionsHighPriority_nleref, "Run" , Some "QueryBuilder" , None , [vara], ([[mkQueryBuilderTy];[mkQuotedExprTy (mkQuerySourceTy varaTy (mkNonGenericTy v_tcref_System_Collections_IEnumerable)) ]], mkSeqTy varaTy) ) + let v_query_for_value_info = makeIntrinsicValRef(fslib_MFLinq_nleref, "For" , Some "QueryBuilder" , None , [vara; vard; varb; vare], ([[mkQueryBuilderTy];[mkQuerySourceTy varaTy vardTy;varaTy --> mkQuerySourceTy varbTy vareTy]], mkQuerySourceTy varbTy vardTy) ) + let v_query_select_value_info = makeIntrinsicValRef(fslib_MFLinq_nleref, "Select" , Some "QueryBuilder" , None , [vara; vare; varb], ([[mkQueryBuilderTy];[mkQuerySourceTy varaTy vareTy;varaTy --> varbTy]], mkQuerySourceTy varbTy vareTy) ) + let v_query_yield_value_info = makeIntrinsicValRef(fslib_MFLinq_nleref, "Yield" , Some "QueryBuilder" , None , [vara; vare], ([[mkQueryBuilderTy];[varaTy]], mkQuerySourceTy varaTy vareTy) ) + let v_query_yield_from_value_info = makeIntrinsicValRef(fslib_MFLinq_nleref, "YieldFrom" , Some "QueryBuilder" , None , [vara; vare], ([[mkQueryBuilderTy];[mkQuerySourceTy varaTy vareTy]], mkQuerySourceTy varaTy vareTy) ) + let v_query_source_info = makeIntrinsicValRef(fslib_MFLinq_nleref, "Source" , Some "QueryBuilder" , None , [vara], ([[mkQueryBuilderTy];[mkSeqTy varaTy ]], mkQuerySourceTy varaTy (mkNonGenericTy v_tcref_System_Collections_IEnumerable)) ) + let v_query_source_as_enum_info = makeIntrinsicValRef(fslib_MFLinq_nleref, "get_Source" , Some "QuerySource`2" , None , [vara; vare], ([[mkQuerySourceTy varaTy vareTy];[]], mkSeqTy varaTy) ) + let v_new_query_source_info = makeIntrinsicValRef(fslib_MFLinq_nleref, ".ctor" , Some "QuerySource`2" , None , [vara; vare], ([[mkSeqTy varaTy]], mkQuerySourceTy varaTy vareTy) ) + let v_query_where_value_info = makeIntrinsicValRef(fslib_MFLinq_nleref, "Where" , Some "QueryBuilder" , None , [vara; vare], ([[mkQueryBuilderTy];[mkQuerySourceTy varaTy vareTy;varaTy --> v_bool_ty]], mkQuerySourceTy varaTy vareTy) ) + let v_query_zero_value_info = makeIntrinsicValRef(fslib_MFLinq_nleref, "Zero" , Some "QueryBuilder" , None , [vara; vare], ([[mkQueryBuilderTy];[]], mkQuerySourceTy varaTy vareTy) ) + let v_fail_init_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "FailInit" , None , None , [], ([[v_unit_ty]], v_unit_ty)) + let v_fail_static_init_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "FailStaticInit" , None , None , [], ([[v_unit_ty]], v_unit_ty)) + let v_check_this_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "CheckThis" , None , None , [vara], ([[varaTy]], varaTy)) + let v_quote_to_linq_lambda_info = makeIntrinsicValRef(fslib_MFLinqRuntimeHelpersQuotationConverter_nleref, "QuotationToLambdaExpression" , None , None , [vara], ([[mkQuotedExprTy varaTy]], mkLinqExpressionTy varaTy)) - attrib_SystemObsolete = mkSysAttrib "System.ObsoleteAttribute" - attrib_DllImportAttribute = tryMkSysAttrib "System.Runtime.InteropServices.DllImportAttribute" - attrib_StructLayoutAttribute = mkSysAttrib "System.Runtime.InteropServices.StructLayoutAttribute" - attrib_TypeForwardedToAttribute = mkSysAttrib "System.Runtime.CompilerServices.TypeForwardedToAttribute" - attrib_ComVisibleAttribute = mkSysAttrib "System.Runtime.InteropServices.ComVisibleAttribute" - attrib_ComImportAttribute = tryMkSysAttrib "System.Runtime.InteropServices.ComImportAttribute" - attrib_FieldOffsetAttribute = mkSysAttrib "System.Runtime.InteropServices.FieldOffsetAttribute" - attrib_MarshalAsAttribute = tryMkSysAttrib "System.Runtime.InteropServices.MarshalAsAttribute" - attrib_InAttribute = tryMkSysAttrib "System.Runtime.InteropServices.InAttribute" - attrib_OutAttribute = mkSysAttrib "System.Runtime.InteropServices.OutAttribute" - attrib_OptionalAttribute = tryMkSysAttrib "System.Runtime.InteropServices.OptionalAttribute" - attrib_ThreadStaticAttribute = tryMkSysAttrib "System.ThreadStaticAttribute" - attrib_SpecialNameAttribute = tryMkSysAttrib "System.Runtime.CompilerServices.SpecialNameAttribute" - attrib_VolatileFieldAttribute = mk_MFCore_attrib "VolatileFieldAttribute" - attrib_ContextStaticAttribute = tryMkSysAttrib "System.ContextStaticAttribute" - attrib_FlagsAttribute = mkSysAttrib "System.FlagsAttribute" - attrib_DefaultMemberAttribute = mkSysAttrib "System.Reflection.DefaultMemberAttribute" - attrib_DebuggerDisplayAttribute = mkSysAttrib "System.Diagnostics.DebuggerDisplayAttribute" - attrib_DebuggerTypeProxyAttribute = mkSysAttrib "System.Diagnostics.DebuggerTypeProxyAttribute" - attrib_PreserveSigAttribute = tryMkSysAttrib "System.Runtime.InteropServices.PreserveSigAttribute" - attrib_MethodImplAttribute = mkSysAttrib "System.Runtime.CompilerServices.MethodImplAttribute" - attrib_ExtensionAttribute = mkSysAttrib "System.Runtime.CompilerServices.ExtensionAttribute" - attrib_CallerLineNumberAttribute = mkSysAttrib "System.Runtime.CompilerServices.CallerLineNumberAttribute" - attrib_CallerFilePathAttribute = mkSysAttrib "System.Runtime.CompilerServices.CallerFilePathAttribute" - attrib_CallerMemberNameAttribute = mkSysAttrib "System.Runtime.CompilerServices.CallerMemberNameAttribute" - - attrib_ProjectionParameterAttribute = mk_MFCore_attrib "ProjectionParameterAttribute" - attrib_CustomOperationAttribute = mk_MFCore_attrib "CustomOperationAttribute" - attrib_NonSerializedAttribute = tryMkSysAttrib "System.NonSerializedAttribute" - attrib_AutoSerializableAttribute = mk_MFCore_attrib "AutoSerializableAttribute" - attrib_RequireQualifiedAccessAttribute = mk_MFCore_attrib "RequireQualifiedAccessAttribute" - attrib_EntryPointAttribute = mk_MFCore_attrib "EntryPointAttribute" - attrib_DefaultAugmentationAttribute = mk_MFCore_attrib "DefaultAugmentationAttribute" - attrib_CompilerMessageAttribute = mk_MFCore_attrib "CompilerMessageAttribute" - attrib_ExperimentalAttribute = mk_MFCore_attrib "ExperimentalAttribute" - attrib_UnverifiableAttribute = mk_MFCore_attrib "UnverifiableAttribute" - attrib_LiteralAttribute = mk_MFCore_attrib "LiteralAttribute" - attrib_ConditionalAttribute = mkSysAttrib "System.Diagnostics.ConditionalAttribute" - attrib_OptionalArgumentAttribute = mk_MFCore_attrib "OptionalArgumentAttribute" - attrib_RequiresExplicitTypeArgumentsAttribute = mk_MFCore_attrib "RequiresExplicitTypeArgumentsAttribute" - attrib_DefaultValueAttribute = mk_MFCore_attrib "DefaultValueAttribute" - attrib_ClassAttribute = mk_MFCore_attrib "ClassAttribute" - attrib_InterfaceAttribute = mk_MFCore_attrib "InterfaceAttribute" - attrib_StructAttribute = mk_MFCore_attrib "StructAttribute" - attrib_ReflectedDefinitionAttribute = mk_MFCore_attrib "ReflectedDefinitionAttribute" - attrib_CompiledNameAttribute = mk_MFCore_attrib "CompiledNameAttribute" - attrib_AutoOpenAttribute = mk_MFCore_attrib "AutoOpenAttribute" - attrib_InternalsVisibleToAttribute = mkSysAttrib "System.Runtime.CompilerServices.InternalsVisibleToAttribute" - attrib_CompilationRepresentationAttribute = mk_MFCore_attrib "CompilationRepresentationAttribute" - attrib_CompilationArgumentCountsAttribute = mk_MFCore_attrib "CompilationArgumentCountsAttribute" - attrib_CompilationMappingAttribute = mk_MFCore_attrib "CompilationMappingAttribute" - attrib_CLIEventAttribute = mk_MFCore_attrib "CLIEventAttribute" - attrib_CLIMutableAttribute = mk_MFCore_attrib "CLIMutableAttribute" - attrib_AllowNullLiteralAttribute = mk_MFCore_attrib "AllowNullLiteralAttribute" - attrib_NoEqualityAttribute = mk_MFCore_attrib "NoEqualityAttribute" - attrib_NoComparisonAttribute = mk_MFCore_attrib "NoComparisonAttribute" - attrib_CustomEqualityAttribute = mk_MFCore_attrib "CustomEqualityAttribute" - attrib_CustomComparisonAttribute = mk_MFCore_attrib "CustomComparisonAttribute" - attrib_EqualityConditionalOnAttribute = mk_MFCore_attrib "EqualityConditionalOnAttribute" - attrib_ComparisonConditionalOnAttribute = mk_MFCore_attrib "ComparisonConditionalOnAttribute" - attrib_ReferenceEqualityAttribute = mk_MFCore_attrib "ReferenceEqualityAttribute" - attrib_StructuralEqualityAttribute = mk_MFCore_attrib "StructuralEqualityAttribute" - attrib_StructuralComparisonAttribute = mk_MFCore_attrib "StructuralComparisonAttribute" - attrib_SealedAttribute = mk_MFCore_attrib "SealedAttribute" - attrib_AbstractClassAttribute = mk_MFCore_attrib "AbstractClassAttribute" - attrib_GeneralizableValueAttribute = mk_MFCore_attrib "GeneralizableValueAttribute" - attrib_MeasureAttribute = mk_MFCore_attrib "MeasureAttribute" - attrib_MeasureableAttribute = mk_MFCore_attrib "MeasureAnnotatedAbbreviationAttribute" - attrib_NoDynamicInvocationAttribute = mk_MFCore_attrib "NoDynamicInvocationAttribute" - attrib_SecurityAttribute = tryMkSysAttrib "System.Security.Permissions.SecurityAttribute" - attrib_SecurityCriticalAttribute = mkSysAttrib "System.Security.SecurityCriticalAttribute" - attrib_SecuritySafeCriticalAttribute = mkSysAttrib "System.Security.SecuritySafeCriticalAttribute" + let tref_DebuggableAttribute = mkSysILTypeRef tname_DebuggableAttribute + let tref_CompilerGeneratedAttribute = mkSysILTypeRef tname_CompilerGeneratedAttribute + + let mutable generatedAttribsCache = [] + let mutable debuggerBrowsableNeverAttributeCache = None + let mkDebuggerNonUserCodeAttribute() = mkILCustomAttribute ilg (mkSysILTypeRef tname_DebuggerNonUserCodeAttribute, [], [], []) + let mkCompilerGeneratedAttribute () = mkILCustomAttribute ilg (tref_CompilerGeneratedAttribute, [], [], []) + + // Requests attributes to be added to compiler generated methods. + let addGeneratedAttrs (attrs: ILAttributes) = + let attribs = + match generatedAttribsCache with + | [] -> + let res = [ if not noDebugData then + yield mkCompilerGeneratedAttribute() + yield mkDebuggerNonUserCodeAttribute()] + generatedAttribsCache <- res + res + | 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 tref_DebuggerBrowsableAttribute n = + let typ_DebuggerBrowsableState = + let tref = mkSysILTypeRef tname_DebuggerBrowsableState + ILType.Value (mkILNonGenericTySpec tref) + mkILCustomAttribute ilg (mkSysILTypeRef tname_DebuggerBrowsableAttribute, [typ_DebuggerBrowsableState], [ILAttribElem.Int32 n], []) + + let mkDebuggerBrowsableNeverAttribute() = + match debuggerBrowsableNeverAttributeCache with + | None -> + let res = tref_DebuggerBrowsableAttribute 0 + debuggerBrowsableNeverAttributeCache <- Some res + res + | 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 mkDebuggerTypeProxyAttribute (ty : ILType) = mkILCustomAttribute ilg (mkSysILTypeRef tname_DebuggerTypeProxyAttribute, [ilg.typ_Type], [ILAttribElem.TypeRef (Some ty.TypeRef)], []) // Build a map that uses the "canonical" F# type names and TyconRef's for these // in preference to the .NET type names. Doing this normalization is a fairly performance critical // piece of code as it is frequently invoked in the process of converting .NET metadata to F# internal // compiler data structures (see import.fs). - better_tcref_map = + let betterTyconRefMap = begin let entries1 = - [ "Int32", int_tcr - "IntPtr", nativeint_tcr - "UIntPtr", unativeint_tcr - "Int16",int16_tcr - "Int64",int64_tcr - "UInt16",uint16_tcr - "UInt32",uint32_tcr - "UInt64",uint64_tcr - "SByte",sbyte_tcr - "Decimal",decimal_tcr - "Byte",byte_tcr - "Boolean",bool_tcr - "String",string_tcr - "Object",obj_tcr - "Exception",exn_tcr - "Char",char_tcr - "Double",float_tcr - "Single",float32_tcr] - |> List.map (fun (nm,tcr) -> + [ "Int32", v_int_tcr + "IntPtr", v_nativeint_tcr + "UIntPtr", v_unativeint_tcr + "Int16", v_int16_tcr + "Int64", v_int64_tcr + "UInt16", v_uint16_tcr + "UInt32", v_uint32_tcr + "UInt64", v_uint64_tcr + "SByte", v_sbyte_tcr + "Decimal", v_decimal_tcr + "Byte", v_byte_tcr + "Boolean", v_bool_tcr + "String", v_string_tcr + "Object", v_obj_tcr + "Exception", v_exn_tcr + "Char", v_char_tcr + "Double", v_float_tcr + "Single", v_float32_tcr] + |> List.map (fun (nm, tcr) -> let ty = mkNonGenericTy tcr - nm, mkSysTyconRef sys nm, (fun _ -> ty)) + nm, findSysTyconRef sys nm, (fun _ -> ty)) let entries2 = - [ "FSharpFunc`2", fastFunc_tcr, (fun tinst -> mkFunTy (List.item 0 tinst) (List.item 1 tinst)) - "Tuple`2", ref_tuple2_tcr, decodeTupleTy tupInfoRef - "Tuple`3", ref_tuple3_tcr, decodeTupleTy tupInfoRef - "Tuple`4", ref_tuple4_tcr, decodeTupleTy tupInfoRef - "Tuple`5", ref_tuple5_tcr, decodeTupleTy tupInfoRef - "Tuple`6", ref_tuple6_tcr, decodeTupleTy tupInfoRef - "Tuple`7", ref_tuple7_tcr, decodeTupleTy tupInfoRef - "Tuple`8", ref_tuple8_tcr, decodeTupleTy tupInfoRef - "ValueTuple`2", struct_tuple2_tcr, decodeTupleTy tupInfoStruct - "ValueTuple`3", struct_tuple3_tcr, decodeTupleTy tupInfoStruct - "ValueTuple`4", struct_tuple4_tcr, decodeTupleTy tupInfoStruct - "ValueTuple`5", struct_tuple5_tcr, decodeTupleTy tupInfoStruct - "ValueTuple`6", struct_tuple6_tcr, decodeTupleTy tupInfoStruct - "ValueTuple`7", struct_tuple7_tcr, decodeTupleTy tupInfoStruct - "ValueTuple`8", struct_tuple8_tcr, decodeTupleTy tupInfoStruct] + [ "FSharpFunc`2", v_fastFunc_tcr, (fun tinst -> mkFunTy (List.item 0 tinst) (List.item 1 tinst)) + "Tuple`2", v_ref_tuple2_tcr, decodeTupleTy tupInfoRef + "Tuple`3", v_ref_tuple3_tcr, decodeTupleTy tupInfoRef + "Tuple`4", v_ref_tuple4_tcr, decodeTupleTy tupInfoRef + "Tuple`5", v_ref_tuple5_tcr, decodeTupleTy tupInfoRef + "Tuple`6", v_ref_tuple6_tcr, decodeTupleTy tupInfoRef + "Tuple`7", v_ref_tuple7_tcr, decodeTupleTy tupInfoRef + "Tuple`8", v_ref_tuple8_tcr, decodeTupleTy tupInfoRef + "ValueTuple`2", v_struct_tuple2_tcr, decodeTupleTy tupInfoStruct + "ValueTuple`3", v_struct_tuple3_tcr, decodeTupleTy tupInfoStruct + "ValueTuple`4", v_struct_tuple4_tcr, decodeTupleTy tupInfoStruct + "ValueTuple`5", v_struct_tuple5_tcr, decodeTupleTy tupInfoStruct + "ValueTuple`6", v_struct_tuple6_tcr, decodeTupleTy tupInfoStruct + "ValueTuple`7", v_struct_tuple7_tcr, decodeTupleTy tupInfoStruct + "ValueTuple`8", v_struct_tuple8_tcr, decodeTupleTy tupInfoStruct] let entries = (entries1 @ entries2) @@ -1347,9 +722,9 @@ let mkTcGlobals (compilingFslib,ilg,fslibCcu,directoryToResolveRelativePaths,mlC let dict = lazy entries - |> List.map (fun (nm,tcref,builder) -> nm, (fun tcref2 tinst -> if tyconRefEq tcref tcref2 then Some(builder tinst) else None)) + |> List.map (fun (nm, tcref, builder) -> nm, (fun tcref2 tinst -> if tyconRefEq tcref tcref2 then Some(builder tinst) else None)) |> Dictionary.ofList - (fun tcref tinst -> + (fun (tcref: EntityRef) tinst -> let dict = dict.Value let key = tcref.LogicalName if dict.ContainsKey key then dict.[key] tcref tinst @@ -1364,8 +739,8 @@ let mkTcGlobals (compilingFslib,ilg,fslibCcu,directoryToResolveRelativePaths,mlC let dict = lazy entries - |> List.filter (fun (_,tcref,_) -> tcref.CanDeref) - |> List.map (fun (_,tcref,builder) -> tcref.Stamp, builder) + |> List.filter (fun (_, tcref, _) -> tcref.CanDeref) + |> List.map (fun (_, tcref, builder) -> tcref.Stamp, builder) |> Dictionary.ofList (fun tcref2 tinst -> let dict = dict.Value @@ -1374,189 +749,519 @@ let mkTcGlobals (compilingFslib,ilg,fslibCcu,directoryToResolveRelativePaths,mlC else None) end - new_decimal_info = new_decimal_info - seq_info = seq_info - seq_vref = (ValRefForIntrinsic seq_info) - and_vref = (ValRefForIntrinsic and_info) - and2_vref = (ValRefForIntrinsic and2_info) - addrof_vref = (ValRefForIntrinsic addrof_info) - addrof2_vref = (ValRefForIntrinsic addrof2_info) - or_vref = (ValRefForIntrinsic or_info) - //splice_vref = (ValRefForIntrinsic splice_info) - splice_expr_vref = (ValRefForIntrinsic splice_expr_info) - splice_raw_expr_vref = (ValRefForIntrinsic splice_raw_expr_info) - or2_vref = (ValRefForIntrinsic or2_info) - generic_equality_er_inner_vref = ValRefForIntrinsic generic_equality_er_inner_info - generic_equality_per_inner_vref = ValRefForIntrinsic generic_equality_per_inner_info - generic_equality_withc_inner_vref = ValRefForIntrinsic generic_equality_withc_inner_info - generic_comparison_inner_vref = ValRefForIntrinsic generic_comparison_inner_info - generic_comparison_withc_inner_vref = ValRefForIntrinsic generic_comparison_withc_inner_info - generic_comparison_withc_outer_info = generic_comparison_withc_outer_info - generic_equality_er_outer_info = generic_equality_er_outer_info - generic_equality_withc_outer_info = generic_equality_withc_outer_info - generic_hash_withc_outer_info = generic_hash_withc_outer_info - generic_hash_inner_vref = ValRefForIntrinsic generic_hash_inner_info - generic_hash_withc_inner_vref = ValRefForIntrinsic generic_hash_withc_inner_info - - reference_equality_inner_vref = ValRefForIntrinsic reference_equality_inner_info - - bitwise_or_vref = ValRefForIntrinsic bitwise_or_info - bitwise_and_vref = ValRefForIntrinsic bitwise_and_info - bitwise_xor_vref = ValRefForIntrinsic bitwise_xor_info - bitwise_unary_not_vref = ValRefForIntrinsic bitwise_unary_not_info - bitwise_shift_left_vref = ValRefForIntrinsic bitwise_shift_left_info - bitwise_shift_right_vref = ValRefForIntrinsic bitwise_shift_right_info - unchecked_addition_vref = ValRefForIntrinsic unchecked_addition_info - unchecked_unary_plus_vref = ValRefForIntrinsic unchecked_unary_plus_info - unchecked_unary_minus_vref = ValRefForIntrinsic unchecked_unary_minus_info - unchecked_unary_not_vref = ValRefForIntrinsic unchecked_unary_not_info - unchecked_subtraction_vref = ValRefForIntrinsic unchecked_subtraction_info - unchecked_multiply_vref = ValRefForIntrinsic unchecked_multiply_info - unchecked_defaultof_vref = ValRefForIntrinsic unchecked_defaultof_info - unchecked_subtraction_info = unchecked_subtraction_info - compare_operator_vref = ValRefForIntrinsic compare_operator_info - equals_operator_vref = ValRefForIntrinsic equals_operator_info - equals_nullable_operator_vref = ValRefForIntrinsic equals_nullable_operator_info - nullable_equals_nullable_operator_vref = ValRefForIntrinsic nullable_equals_nullable_operator_info - nullable_equals_operator_vref = ValRefForIntrinsic nullable_equals_operator_info - not_equals_operator_vref = ValRefForIntrinsic not_equals_operator_info - less_than_operator_vref = ValRefForIntrinsic less_than_operator_info - less_than_or_equals_operator_vref = ValRefForIntrinsic less_than_or_equals_operator_info - greater_than_operator_vref = ValRefForIntrinsic greater_than_operator_info - greater_than_or_equals_operator_vref = ValRefForIntrinsic greater_than_or_equals_operator_info - - equals_operator_info = equals_operator_info - - raise_info = raise_info - raise_vref = ValRefForIntrinsic raise_info - failwith_info = failwith_info - failwith_vref = ValRefForIntrinsic failwith_info - invalid_arg_info = invalid_arg_info - invalid_arg_vref = ValRefForIntrinsic invalid_arg_info - null_arg_info = null_arg_info - null_arg_vref = ValRefForIntrinsic null_arg_info - invalid_op_info = invalid_op_info - invalid_op_vref = ValRefForIntrinsic invalid_op_info - failwithf_info = failwithf_info - failwithf_vref = ValRefForIntrinsic failwithf_info - - reraise_info = reraise_info - reraise_vref = ValRefForIntrinsic reraise_info - methodhandleof_info = methodhandleof_info - methodhandleof_vref = ValRefForIntrinsic methodhandleof_info - typeof_info = typeof_info - typeof_vref = ValRefForIntrinsic typeof_info - sizeof_vref = ValRefForIntrinsic sizeof_info - typedefof_info = typedefof_info - typedefof_vref = ValRefForIntrinsic typedefof_info - enum_vref = ValRefForIntrinsic enum_info - enumOfValue_vref = ValRefForIntrinsic enumOfValue_info - range_op_vref = ValRefForIntrinsic range_op_info - range_step_op_vref = ValRefForIntrinsic range_step_op_info - range_int32_op_vref = ValRefForIntrinsic range_int32_op_info - array_length_info = array_length_info - array_get_vref = ValRefForIntrinsic array_get_info - array2D_get_vref = ValRefForIntrinsic array2D_get_info - array3D_get_vref = ValRefForIntrinsic array3D_get_info - array4D_get_vref = ValRefForIntrinsic array4D_get_info - seq_singleton_vref = ValRefForIntrinsic seq_singleton_info - seq_collect_vref = ValRefForIntrinsic seq_collect_info - seq_collect_info = seq_collect_info - seq_using_info = seq_using_info - seq_using_vref = ValRefForIntrinsic seq_using_info - seq_delay_info = seq_delay_info - seq_delay_vref = ValRefForIntrinsic seq_delay_info - seq_append_info = seq_append_info - seq_append_vref = ValRefForIntrinsic seq_append_info - seq_generated_info = seq_generated_info - seq_generated_vref = ValRefForIntrinsic seq_generated_info - seq_finally_info = seq_finally_info - seq_finally_vref = ValRefForIntrinsic seq_finally_info - seq_of_functions_info = seq_of_functions_info - seq_of_functions_vref = ValRefForIntrinsic seq_of_functions_info - seq_map_info = seq_map_info - seq_map_vref = ValRefForIntrinsic seq_map_info - seq_singleton_info = seq_singleton_info - seq_empty_info = seq_empty_info - seq_empty_vref = ValRefForIntrinsic seq_empty_info - new_format_info = new_format_info - new_format_vref = ValRefForIntrinsic new_format_info - sprintf_vref = ValRefForIntrinsic sprintf_info - unbox_vref = ValRefForIntrinsic unbox_info - unbox_fast_vref = ValRefForIntrinsic unbox_fast_info - istype_vref = ValRefForIntrinsic istype_info - istype_fast_vref = ValRefForIntrinsic istype_fast_info - unbox_info = unbox_info - get_generic_comparer_info = get_generic_comparer_info - get_generic_er_equality_comparer_info = get_generic_er_equality_comparer_info - get_generic_per_equality_comparer_info = get_generic_per_equality_comparer_info - dispose_info = dispose_info - getstring_info = getstring_info - unbox_fast_info = unbox_fast_info - istype_info = istype_info - istype_fast_info = istype_fast_info - lazy_force_info = lazy_force_info - lazy_create_info = lazy_create_info - create_instance_info = create_instance_info - create_event_info = create_event_info - seq_to_list_info = seq_to_list_info - seq_to_array_info = seq_to_array_info - array_get_info = array_get_info - array2D_get_info = array2D_get_info - array3D_get_info = array3D_get_info - array4D_get_info = array4D_get_info - deserialize_quoted_FSharp_20_plus_info = deserialize_quoted_FSharp_20_plus_info - deserialize_quoted_FSharp_40_plus_info = deserialize_quoted_FSharp_40_plus_info - cast_quotation_info = cast_quotation_info - lift_value_info = lift_value_info - lift_value_with_name_info = lift_value_with_name_info - lift_value_with_defn_info = lift_value_with_defn_info - query_source_as_enum_info = query_source_as_enum_info - new_query_source_info = new_query_source_info - query_source_vref = ValRefForIntrinsic query_source_info - query_value_vref = ValRefForIntrinsic query_value_info - query_run_value_vref = ValRefForIntrinsic query_run_value_info - query_run_enumerable_vref = ValRefForIntrinsic query_run_enumerable_info - query_for_vref = ValRefForIntrinsic query_for_value_info - query_yield_vref = ValRefForIntrinsic query_yield_value_info - query_yield_from_vref = ValRefForIntrinsic query_yield_from_value_info - query_select_vref = ValRefForIntrinsic query_select_value_info - query_where_vref = ValRefForIntrinsic query_where_value_info - query_zero_vref = ValRefForIntrinsic query_zero_value_info - query_builder_tcref = query_builder_tcref - fail_init_info = fail_init_info - fail_static_init_info = fail_static_init_info - check_this_info = check_this_info - quote_to_linq_lambda_info = quote_to_linq_lambda_info - - - generic_hash_withc_tuple2_vref = ValRefForIntrinsic generic_hash_withc_tuple2_info - generic_hash_withc_tuple3_vref = ValRefForIntrinsic generic_hash_withc_tuple3_info - generic_hash_withc_tuple4_vref = ValRefForIntrinsic generic_hash_withc_tuple4_info - generic_hash_withc_tuple5_vref = ValRefForIntrinsic generic_hash_withc_tuple5_info - generic_equals_withc_tuple2_vref = ValRefForIntrinsic generic_equals_withc_tuple2_info - generic_equals_withc_tuple3_vref = ValRefForIntrinsic generic_equals_withc_tuple3_info - generic_equals_withc_tuple4_vref = ValRefForIntrinsic generic_equals_withc_tuple4_info - generic_equals_withc_tuple5_vref = ValRefForIntrinsic generic_equals_withc_tuple5_info - generic_compare_withc_tuple2_vref = ValRefForIntrinsic generic_compare_withc_tuple2_info - generic_compare_withc_tuple3_vref = ValRefForIntrinsic generic_compare_withc_tuple3_info - generic_compare_withc_tuple4_vref = ValRefForIntrinsic generic_compare_withc_tuple4_info - generic_compare_withc_tuple5_vref = ValRefForIntrinsic generic_compare_withc_tuple5_info - generic_equality_withc_outer_vref = ValRefForIntrinsic generic_equality_withc_outer_info - - - cons_ucref = cons_ucref - nil_ucref = nil_ucref + + override x.ToString() = "" + member __.ilg=ilg + // A table of all intrinsics that the compiler cares about + member __.knownIntrinsics = v_knownIntrinsics + // A table of known modules in FSharp.Core. Not all modules are necessarily listed, but the more we list the + // better the job we do of mapping from provided expressions back to FSharp.Core F# functions and values. + member __.knownFSharpCoreModules = v_knownFSharpCoreModules + member __.compilingFslib = compilingFslib + member __.mlCompatibility = mlCompatibility + member __.emitDebugInfoInQuotations = emitDebugInfoInQuotations + member __.directoryToResolveRelativePaths= directoryToResolveRelativePaths + member __.unionCaseRefEq x y = primUnionCaseRefEq compilingFslib fslibCcu x y + member __.valRefEq x y = primValRefEq compilingFslib fslibCcu x y + member __.fslibCcu = fslibCcu + member val refcell_tcr_canon = mk_MFCore_tcref fslibCcu "Ref`1" + member val option_tcr_canon = mk_MFCore_tcref fslibCcu "Option`1" + member __.list_tcr_canon = v_list_tcr_canon + member val set_tcr_canon = mk_MFCollections_tcref fslibCcu "Set`1" + member val map_tcr_canon = mk_MFCollections_tcref fslibCcu "Map`2" + member __.lazy_tcr_canon = lazy_tcr + member val refcell_tcr_nice = mk_MFCore_tcref fslibCcu "ref`1" + member val array_tcr_nice = v_il_arr_tcr_map.[0] + member __.option_tcr_nice = v_option_tcr_nice + member __.list_tcr_nice = v_list_tcr_nice + member __.lazy_tcr_nice = v_lazy_tcr_nice + member __.format_tcr = v_format_tcr + member __.expr_tcr = v_expr_tcr + member __.raw_expr_tcr = v_raw_expr_tcr + member __.nativeint_tcr = v_nativeint_tcr + member __.int32_tcr = v_int32_tcr + member __.int16_tcr = v_int16_tcr + member __.int64_tcr = v_int64_tcr + member __.uint16_tcr = v_uint16_tcr + member __.uint32_tcr = v_uint32_tcr + member __.uint64_tcr = v_uint64_tcr + member __.sbyte_tcr = v_sbyte_tcr + member __.decimal_tcr = v_decimal_tcr + member __.date_tcr = v_date_tcr + member __.pdecimal_tcr = v_pdecimal_tcr + member __.byte_tcr = v_byte_tcr + member __.bool_tcr = v_bool_tcr + member __.unit_tcr_canon = v_unit_tcr_canon + member __.unit_tcr_nice = v_unit_tcr_nice + member __.exn_tcr = v_exn_tcr + member __.char_tcr = v_char_tcr + member __.float_tcr = v_float_tcr + member __.float32_tcr = v_float32_tcr + member __.pfloat_tcr = v_pfloat_tcr + member __.pfloat32_tcr = v_pfloat32_tcr + member __.pint_tcr = v_pint_tcr + member __.pint8_tcr = v_pint8_tcr + member __.pint16_tcr = v_pint16_tcr + member __.pint64_tcr = v_pint64_tcr + member __.byref_tcr = v_byref_tcr + member __.nativeptr_tcr = v_nativeptr_tcr + member __.ilsigptr_tcr = v_ilsigptr_tcr + member __.fastFunc_tcr = v_fastFunc_tcr + member __.tcref_IQueryable = v_tcref_IQueryable + member __.tcref_IObservable = v_tcref_IObservable + member __.tcref_IObserver = v_tcref_IObserver + member __.fslib_IEvent2_tcr = v_fslib_IEvent2_tcr + member __.fslib_IDelegateEvent_tcr = v_fslib_IDelegateEvent_tcr + member __.seq_tcr = v_seq_tcr + member val seq_base_tcr = mk_MFCompilerServices_tcref fslibCcu "GeneratedSequenceBase`1" + member val measureproduct_tcr = mk_MFCompilerServices_tcref fslibCcu "MeasureProduct`2" + member val measureinverse_tcr = mk_MFCompilerServices_tcref fslibCcu "MeasureInverse`1" + member val measureone_tcr = mk_MFCompilerServices_tcref fslibCcu "MeasureOne" + member __.il_arr_tcr_map = v_il_arr_tcr_map + member __.ref_tuple1_tcr = v_ref_tuple1_tcr + member __.ref_tuple2_tcr = v_ref_tuple2_tcr + member __.ref_tuple3_tcr = v_ref_tuple3_tcr + member __.ref_tuple4_tcr = v_ref_tuple4_tcr + member __.ref_tuple5_tcr = v_ref_tuple5_tcr + member __.ref_tuple6_tcr = v_ref_tuple6_tcr + member __.ref_tuple7_tcr = v_ref_tuple7_tcr + member __.ref_tuple8_tcr = v_ref_tuple8_tcr + member __.struct_tuple1_tcr = v_struct_tuple1_tcr + member __.struct_tuple2_tcr = v_struct_tuple2_tcr + member __.struct_tuple3_tcr = v_struct_tuple3_tcr + member __.struct_tuple4_tcr = v_struct_tuple4_tcr + member __.struct_tuple5_tcr = v_struct_tuple5_tcr + member __.struct_tuple6_tcr = v_struct_tuple6_tcr + member __.struct_tuple7_tcr = v_struct_tuple7_tcr + member __.struct_tuple8_tcr = v_struct_tuple8_tcr + member __.choice2_tcr = v_choice2_tcr + member __.choice3_tcr = v_choice3_tcr + member __.choice4_tcr = v_choice4_tcr + member __.choice5_tcr = v_choice5_tcr + member __.choice6_tcr = v_choice6_tcr + member __.choice7_tcr = v_choice7_tcr + member val nativeint_ty = mkNonGenericTy v_nativeint_tcr + member val unativeint_ty = mkNonGenericTy v_unativeint_tcr + member val int32_ty = mkNonGenericTy v_int32_tcr + member val int16_ty = mkNonGenericTy v_int16_tcr + member val int64_ty = mkNonGenericTy v_int64_tcr + member val uint16_ty = mkNonGenericTy v_uint16_tcr + member val uint32_ty = mkNonGenericTy v_uint32_tcr + member val uint64_ty = mkNonGenericTy v_uint64_tcr + member val sbyte_ty = mkNonGenericTy v_sbyte_tcr + member __.byte_ty = v_byte_ty + member __.bool_ty = v_bool_ty + member __.int_ty = v_int_ty + member __.string_ty = v_string_ty + member __.unit_ty = v_unit_ty + member __.obj_ty = v_obj_ty + member __.char_ty = v_char_ty + member __.decimal_ty = v_decimal_ty + + member val exn_ty = mkNonGenericTy v_exn_tcr + member val float_ty = mkNonGenericTy v_float_tcr + member val float32_ty = mkNonGenericTy v_float32_tcr + /// Memoization table to help minimize the number of ILSourceDocument objects we create + member __.memoize_file x = v_memoize_file.Apply x + + member val system_Array_typ = mkSysNonGenericTy sys "Array" + member val system_Object_typ = mkSysNonGenericTy sys "Object" + member val system_IDisposable_typ = mkSysNonGenericTy sys "IDisposable" + member val system_RuntimeHelpers_typ = mkSysNonGenericTy sysCompilerServices "RuntimeHelpers" + member val system_Value_typ = mkSysNonGenericTy sys "ValueType" + member val system_Delegate_typ = mkSysNonGenericTy sys "Delegate" + member val system_MulticastDelegate_typ = mkSysNonGenericTy sys "MulticastDelegate" + member val system_Enum_typ = mkSysNonGenericTy sys "Enum" + member val system_Exception_typ = mkSysNonGenericTy sys "Exception" + member val system_String_typ = mkSysNonGenericTy sys "String" + member val system_String_tcref = findSysTyconRef sys "String" + member val system_Int32_typ = mkSysNonGenericTy sys "Int32" + member __.system_Type_typ = v_system_Type_typ + member val system_TypedReference_tcref = tryFindSysTyconRef sys "TypedReference" + member val system_ArgIterator_tcref = tryFindSysTyconRef sys "ArgIterator" + member val system_RuntimeArgumentHandle_tcref = tryFindSysTyconRef sys "RuntimeArgumentHandle" + member val system_SByte_tcref = findSysTyconRef sys "SByte" + member val system_Decimal_tcref = findSysTyconRef sys "Decimal" + member val system_Int16_tcref = findSysTyconRef sys "Int16" + member val system_Int32_tcref = findSysTyconRef sys "Int32" + member val system_Int64_tcref = findSysTyconRef sys "Int64" + member val system_IntPtr_tcref = findSysTyconRef sys "IntPtr" + member val system_Bool_tcref = findSysTyconRef sys "Boolean" + member val system_Byte_tcref = findSysTyconRef sys "Byte" + member val system_UInt16_tcref = findSysTyconRef sys "UInt16" + member val system_Char_tcref = findSysTyconRef sys "Char" + member val system_UInt32_tcref = findSysTyconRef sys "UInt32" + member val system_UInt64_tcref = findSysTyconRef sys "UInt64" + member val system_UIntPtr_tcref = findSysTyconRef sys "UIntPtr" + member val system_Single_tcref = findSysTyconRef sys "Single" + member val system_Double_tcref = findSysTyconRef sys "Double" + member val system_RuntimeTypeHandle_typ = mkSysNonGenericTy sys "RuntimeTypeHandle" + member __.system_RuntimeMethodHandle_typ = v_system_RuntimeMethodHandle_typ + + member val system_MarshalByRefObject_tcref = tryFindSysTyconRef sys "MarshalByRefObject" + member val system_MarshalByRefObject_typ = tryMkSysNonGenericTy sys "MarshalByRefObject" + + member __.system_Reflection_MethodInfo_typ = v_system_Reflection_MethodInfo_typ - suppressed_types = suppressed_types - isInteractive=isInteractive - mkSysTyconRef=mkSysTyconRef - tryMkSysTyconRef=tryMkSysTyconRef - mkSysILTypeRef=mkSysILTypeRef - usesMscorlib = usesMscorlib - mkSysAttrib=mkSysAttrib - } + member val system_Array_tcref = findSysTyconRef sys "Array" + member val system_Object_tcref = findSysTyconRef sys "Object" + member val system_Void_tcref = findSysTyconRef sys "Void" + member val system_IndexOutOfRangeException_tcref = findSysTyconRef sys "IndexOutOfRangeException" + member val system_Nullable_tcref = v_nullable_tcr + member val system_GenericIComparable_tcref = findSysTyconRef sys "IComparable`1" + member val system_GenericIEquatable_tcref = findSysTyconRef sys "IEquatable`1" + member val mk_IComparable_ty = mkSysNonGenericTy sys "IComparable" + member val system_LinqExpression_tcref = v_linqExpression_tcr + + member val mk_IStructuralComparable_ty = mkSysNonGenericTy sysCollections "IStructuralComparable" + + member val mk_IStructuralEquatable_ty = mkSysNonGenericTy sysCollections "IStructuralEquatable" + + member __.IComparer_ty = v_IComparer_ty + member __.IEqualityComparer_ty = v_IEqualityComparer_ty + member val tcref_System_Collections_IComparer = findSysTyconRef sysCollections "IComparer" + member val tcref_System_Collections_IEqualityComparer = findSysTyconRef sysCollections "IEqualityComparer" + member val tcref_System_Collections_Generic_IEqualityComparer = findSysTyconRef sysGenerics "IEqualityComparer`1" + member val tcref_System_Collections_Generic_Dictionary = findSysTyconRef sysGenerics "Dictionary`2" + + member val tcref_System_IComparable = findSysTyconRef sys "IComparable" + member val tcref_System_IStructuralComparable = findSysTyconRef sysCollections "IStructuralComparable" + member val tcref_System_IStructuralEquatable = findSysTyconRef sysCollections "IStructuralEquatable" + + member val tcref_LanguagePrimitives = mk_MFCore_tcref fslibCcu "LanguagePrimitives" + + + member val tcref_System_Collections_Generic_IList = findSysTyconRef sysGenerics "IList`1" + member val tcref_System_Collections_Generic_IReadOnlyList = findSysTyconRef sysGenerics "IReadOnlyList`1" + member val tcref_System_Collections_Generic_ICollection = findSysTyconRef sysGenerics "ICollection`1" + member val tcref_System_Collections_Generic_IReadOnlyCollection = findSysTyconRef sysGenerics "IReadOnlyCollection`1" + member __.tcref_System_Collections_IEnumerable = v_tcref_System_Collections_IEnumerable + + member __.tcref_System_Collections_Generic_IEnumerable = v_IEnumerable_tcr + member __.tcref_System_Collections_Generic_IEnumerator = v_IEnumerator_tcr + + member __.tcref_System_Attribute = v_System_Attribute_tcr + + member val iltyp_TypedReference = tryMkSysILTypeRef "System.TypedReference" |> Option.map mkILNonGenericValueTy + member val iltyp_StreamingContext = tryMkSysILTypeRef tname_StreamingContext |> Option.map mkILNonGenericValueTy + member val iltyp_SerializationInfo = tryMkSysILTypeRef tname_SerializationInfo |> Option.map mkILNonGenericBoxedTy + member val iltyp_Missing = mkSysILTypeRef tname_Missing |> mkILNonGenericBoxedTy + member val iltyp_AsyncCallback = mkSysILTypeRef tname_AsyncCallback |> mkILNonGenericBoxedTy + member val iltyp_IAsyncResult = mkSysILTypeRef tname_IAsyncResult |> mkILNonGenericBoxedTy + member val iltyp_IComparable = mkSysILTypeRef tname_IComparable |> mkILNonGenericBoxedTy + member val iltyp_Exception = mkSysILTypeRef tname_Exception |> mkILNonGenericBoxedTy + member val iltyp_ValueType = mkSysILTypeRef tname_ValueType |> mkILNonGenericBoxedTy + member val iltyp_RuntimeFieldHandle = mkSysILTypeRef tname_RuntimeFieldHandle |> mkILNonGenericValueTy + member val iltyp_RuntimeMethodHandle = mkSysILTypeRef tname_RuntimeMethodHandle |> mkILNonGenericValueTy + member val iltyp_RuntimeTypeHandle = mkSysILTypeRef tname_RuntimeTypeHandle |> mkILNonGenericValueTy + + + member val attrib_AttributeUsageAttribute = mkSysAttrib "System.AttributeUsageAttribute" + member val attrib_ParamArrayAttribute = mkSysAttrib "System.ParamArrayAttribute" + member val attrib_IDispatchConstantAttribute = tryMkSysAttrib "System.Runtime.CompilerServices.IDispatchConstantAttribute" + member val attrib_IUnknownConstantAttribute = tryMkSysAttrib "System.Runtime.CompilerServices.IUnknownConstantAttribute" + + member val attrib_SystemObsolete = mkSysAttrib "System.ObsoleteAttribute" + member val attrib_DllImportAttribute = tryMkSysAttrib "System.Runtime.InteropServices.DllImportAttribute" + member val attrib_StructLayoutAttribute = mkSysAttrib "System.Runtime.InteropServices.StructLayoutAttribute" + member val attrib_TypeForwardedToAttribute = mkSysAttrib "System.Runtime.CompilerServices.TypeForwardedToAttribute" + member val attrib_ComVisibleAttribute = mkSysAttrib "System.Runtime.InteropServices.ComVisibleAttribute" + member val attrib_ComImportAttribute = tryMkSysAttrib "System.Runtime.InteropServices.ComImportAttribute" + member val attrib_FieldOffsetAttribute = mkSysAttrib "System.Runtime.InteropServices.FieldOffsetAttribute" + member val attrib_MarshalAsAttribute = tryMkSysAttrib "System.Runtime.InteropServices.MarshalAsAttribute" + member val attrib_InAttribute = tryMkSysAttrib "System.Runtime.InteropServices.InAttribute" + member val attrib_OutAttribute = mkSysAttrib "System.Runtime.InteropServices.OutAttribute" + member val attrib_OptionalAttribute = tryMkSysAttrib "System.Runtime.InteropServices.OptionalAttribute" + member val attrib_ThreadStaticAttribute = tryMkSysAttrib "System.ThreadStaticAttribute" + member val attrib_SpecialNameAttribute = tryMkSysAttrib "System.Runtime.CompilerServices.SpecialNameAttribute" + member val attrib_VolatileFieldAttribute = mk_MFCore_attrib "VolatileFieldAttribute" + member val attrib_ContextStaticAttribute = tryMkSysAttrib "System.ContextStaticAttribute" + member val attrib_FlagsAttribute = mkSysAttrib "System.FlagsAttribute" + member val attrib_DefaultMemberAttribute = mkSysAttrib "System.Reflection.DefaultMemberAttribute" + member val attrib_DebuggerDisplayAttribute = mkSysAttrib "System.Diagnostics.DebuggerDisplayAttribute" + member val attrib_DebuggerTypeProxyAttribute = mkSysAttrib "System.Diagnostics.DebuggerTypeProxyAttribute" + member val attrib_PreserveSigAttribute = tryMkSysAttrib "System.Runtime.InteropServices.PreserveSigAttribute" + member val attrib_MethodImplAttribute = mkSysAttrib "System.Runtime.CompilerServices.MethodImplAttribute" + member val attrib_ExtensionAttribute = mkSysAttrib "System.Runtime.CompilerServices.ExtensionAttribute" + member val attrib_CallerLineNumberAttribute = mkSysAttrib "System.Runtime.CompilerServices.CallerLineNumberAttribute" + member val attrib_CallerFilePathAttribute = mkSysAttrib "System.Runtime.CompilerServices.CallerFilePathAttribute" + member val attrib_CallerMemberNameAttribute = mkSysAttrib "System.Runtime.CompilerServices.CallerMemberNameAttribute" + + member val attrib_ProjectionParameterAttribute = mk_MFCore_attrib "ProjectionParameterAttribute" + member val attrib_CustomOperationAttribute = mk_MFCore_attrib "CustomOperationAttribute" + member val attrib_NonSerializedAttribute = tryMkSysAttrib "System.NonSerializedAttribute" + member val attrib_SerializableAttribute = tryMkSysAttrib "System.SerializableAttribute" + + member val attrib_AutoSerializableAttribute = mk_MFCore_attrib "AutoSerializableAttribute" + member val attrib_RequireQualifiedAccessAttribute = mk_MFCore_attrib "RequireQualifiedAccessAttribute" + member val attrib_EntryPointAttribute = mk_MFCore_attrib "EntryPointAttribute" + member val attrib_DefaultAugmentationAttribute = mk_MFCore_attrib "DefaultAugmentationAttribute" + member val attrib_CompilerMessageAttribute = mk_MFCore_attrib "CompilerMessageAttribute" + member val attrib_ExperimentalAttribute = mk_MFCore_attrib "ExperimentalAttribute" + member val attrib_UnverifiableAttribute = mk_MFCore_attrib "UnverifiableAttribute" + member val attrib_LiteralAttribute = mk_MFCore_attrib "LiteralAttribute" + member val attrib_ConditionalAttribute = mkSysAttrib "System.Diagnostics.ConditionalAttribute" + member val attrib_OptionalArgumentAttribute = mk_MFCore_attrib "OptionalArgumentAttribute" + member val attrib_RequiresExplicitTypeArgumentsAttribute = mk_MFCore_attrib "RequiresExplicitTypeArgumentsAttribute" + member val attrib_DefaultValueAttribute = mk_MFCore_attrib "DefaultValueAttribute" + member val attrib_ClassAttribute = mk_MFCore_attrib "ClassAttribute" + member val attrib_InterfaceAttribute = mk_MFCore_attrib "InterfaceAttribute" + member val attrib_StructAttribute = mk_MFCore_attrib "StructAttribute" + member val attrib_ReflectedDefinitionAttribute = mk_MFCore_attrib "ReflectedDefinitionAttribute" + member val attrib_CompiledNameAttribute = mk_MFCore_attrib "CompiledNameAttribute" + member val attrib_AutoOpenAttribute = mk_MFCore_attrib "AutoOpenAttribute" + member val attrib_InternalsVisibleToAttribute = mkSysAttrib "System.Runtime.CompilerServices.InternalsVisibleToAttribute" + member val attrib_CompilationRepresentationAttribute = mk_MFCore_attrib "CompilationRepresentationAttribute" + member val attrib_CompilationArgumentCountsAttribute = mk_MFCore_attrib "CompilationArgumentCountsAttribute" + member val attrib_CompilationMappingAttribute = mk_MFCore_attrib "CompilationMappingAttribute" + member val attrib_CLIEventAttribute = mk_MFCore_attrib "CLIEventAttribute" + member val attrib_CLIMutableAttribute = mk_MFCore_attrib "CLIMutableAttribute" + member val attrib_AllowNullLiteralAttribute = mk_MFCore_attrib "AllowNullLiteralAttribute" + member val attrib_NoEqualityAttribute = mk_MFCore_attrib "NoEqualityAttribute" + member val attrib_NoComparisonAttribute = mk_MFCore_attrib "NoComparisonAttribute" + member val attrib_CustomEqualityAttribute = mk_MFCore_attrib "CustomEqualityAttribute" + member val attrib_CustomComparisonAttribute = mk_MFCore_attrib "CustomComparisonAttribute" + member val attrib_EqualityConditionalOnAttribute = mk_MFCore_attrib "EqualityConditionalOnAttribute" + member val attrib_ComparisonConditionalOnAttribute = mk_MFCore_attrib "ComparisonConditionalOnAttribute" + member val attrib_ReferenceEqualityAttribute = mk_MFCore_attrib "ReferenceEqualityAttribute" + member val attrib_StructuralEqualityAttribute = mk_MFCore_attrib "StructuralEqualityAttribute" + member val attrib_StructuralComparisonAttribute = mk_MFCore_attrib "StructuralComparisonAttribute" + member val attrib_SealedAttribute = mk_MFCore_attrib "SealedAttribute" + member val attrib_AbstractClassAttribute = mk_MFCore_attrib "AbstractClassAttribute" + member val attrib_GeneralizableValueAttribute = mk_MFCore_attrib "GeneralizableValueAttribute" + member val attrib_MeasureAttribute = mk_MFCore_attrib "MeasureAttribute" + member val attrib_MeasureableAttribute = mk_MFCore_attrib "MeasureAnnotatedAbbreviationAttribute" + member val attrib_NoDynamicInvocationAttribute = mk_MFCore_attrib "NoDynamicInvocationAttribute" + member val attrib_SecurityAttribute = tryMkSysAttrib "System.Security.Permissions.SecurityAttribute" + member val attrib_SecurityCriticalAttribute = mkSysAttrib "System.Security.SecurityCriticalAttribute" + member val attrib_SecuritySafeCriticalAttribute = mkSysAttrib "System.Security.SecuritySafeCriticalAttribute" + + member __.better_tcref_map = betterTyconRefMap + member __.new_decimal_info = v_new_decimal_info + member __.seq_info = v_seq_info + member val seq_vref = (ValRefForIntrinsic v_seq_info) + member val and_vref = (ValRefForIntrinsic v_and_info) + member val and2_vref = (ValRefForIntrinsic v_and2_info) + member val addrof_vref = (ValRefForIntrinsic v_addrof_info) + member val addrof2_vref = (ValRefForIntrinsic v_addrof2_info) + member val or_vref = (ValRefForIntrinsic v_or_info) + member val splice_expr_vref = (ValRefForIntrinsic v_splice_expr_info) + member val splice_raw_expr_vref = (ValRefForIntrinsic v_splice_raw_expr_info) + member val or2_vref = (ValRefForIntrinsic v_or2_info) + member val generic_equality_er_inner_vref = ValRefForIntrinsic v_generic_equality_er_inner_info + member val generic_equality_per_inner_vref = ValRefForIntrinsic v_generic_equality_per_inner_info + member val generic_equality_withc_inner_vref = ValRefForIntrinsic v_generic_equality_withc_inner_info + member val generic_comparison_inner_vref = ValRefForIntrinsic v_generic_comparison_inner_info + member val generic_comparison_withc_inner_vref = ValRefForIntrinsic v_generic_comparison_withc_inner_info + member __.generic_comparison_withc_outer_info = v_generic_comparison_withc_outer_info + member __.generic_equality_er_outer_info = v_generic_equality_er_outer_info + member __.generic_equality_withc_outer_info = v_generic_equality_withc_outer_info + member __.generic_hash_withc_outer_info = v_generic_hash_withc_outer_info + member val generic_hash_inner_vref = ValRefForIntrinsic v_generic_hash_inner_info + member val generic_hash_withc_inner_vref = ValRefForIntrinsic v_generic_hash_withc_inner_info + + member val reference_equality_inner_vref = ValRefForIntrinsic v_reference_equality_inner_info + + member val bitwise_or_vref = ValRefForIntrinsic v_bitwise_or_info + member val bitwise_and_vref = ValRefForIntrinsic v_bitwise_and_info + member val bitwise_xor_vref = ValRefForIntrinsic v_bitwise_xor_info + member val bitwise_unary_not_vref = ValRefForIntrinsic v_bitwise_unary_not_info + member val bitwise_shift_left_vref = ValRefForIntrinsic v_bitwise_shift_left_info + member val bitwise_shift_right_vref = ValRefForIntrinsic v_bitwise_shift_right_info + member val unchecked_addition_vref = ValRefForIntrinsic v_unchecked_addition_info + member val unchecked_unary_plus_vref = ValRefForIntrinsic v_unchecked_unary_plus_info + member val unchecked_unary_minus_vref = ValRefForIntrinsic v_unchecked_unary_minus_info + member val unchecked_unary_not_vref = ValRefForIntrinsic v_unchecked_unary_not_info + member val unchecked_subtraction_vref = ValRefForIntrinsic v_unchecked_subtraction_info + member val unchecked_multiply_vref = ValRefForIntrinsic v_unchecked_multiply_info + member val unchecked_defaultof_vref = ValRefForIntrinsic v_unchecked_defaultof_info + member __.unchecked_subtraction_info = v_unchecked_subtraction_info + member val compare_operator_vref = ValRefForIntrinsic v_compare_operator_info + member val equals_operator_vref = ValRefForIntrinsic v_equals_operator_info + member val equals_nullable_operator_vref = ValRefForIntrinsic v_equals_nullable_operator_info + member val nullable_equals_nullable_operator_vref = ValRefForIntrinsic v_nullable_equals_nullable_operator_info + member val nullable_equals_operator_vref = ValRefForIntrinsic v_nullable_equals_operator_info + member val not_equals_operator_vref = ValRefForIntrinsic v_not_equals_operator_info + member val less_than_operator_vref = ValRefForIntrinsic v_less_than_operator_info + member val less_than_or_equals_operator_vref = ValRefForIntrinsic v_less_than_or_equals_operator_info + member val greater_than_operator_vref = ValRefForIntrinsic v_greater_than_operator_info + member val greater_than_or_equals_operator_vref = ValRefForIntrinsic v_greater_than_or_equals_operator_info + + member val raise_vref = ValRefForIntrinsic v_raise_info + member val failwith_vref = ValRefForIntrinsic v_failwith_info + member val invalid_arg_vref = ValRefForIntrinsic v_invalid_arg_info + member val null_arg_vref = ValRefForIntrinsic v_null_arg_info + member val invalid_op_vref = ValRefForIntrinsic v_invalid_op_info + member val failwithf_vref = ValRefForIntrinsic v_failwithf_info + + member __.equals_operator_info = v_equals_operator_info + member __.raise_info = v_raise_info + member __.failwith_info = v_failwith_info + member __.invalid_arg_info = v_invalid_arg_info + member __.null_arg_info = v_null_arg_info + member __.invalid_op_info = v_invalid_op_info + member __.failwithf_info = v_failwithf_info + member __.reraise_info = v_reraise_info + member __.methodhandleof_info = v_methodhandleof_info + member __.typeof_info = v_typeof_info + member __.typedefof_info = v_typedefof_info + member __.array_length_info = v_array_length_info + + member val reraise_vref = ValRefForIntrinsic v_reraise_info + member val methodhandleof_vref = ValRefForIntrinsic v_methodhandleof_info + member val typeof_vref = ValRefForIntrinsic v_typeof_info + member val sizeof_vref = ValRefForIntrinsic v_sizeof_info + member val typedefof_vref = ValRefForIntrinsic v_typedefof_info + member val enum_vref = ValRefForIntrinsic v_enum_info + member val enumOfValue_vref = ValRefForIntrinsic v_enumOfValue_info + member val range_op_vref = ValRefForIntrinsic v_range_op_info + member val range_step_op_vref = ValRefForIntrinsic v_range_step_op_info + member val range_int32_op_vref = ValRefForIntrinsic v_range_int32_op_info + member val array_get_vref = ValRefForIntrinsic v_array_get_info + member val array2D_get_vref = ValRefForIntrinsic v_array2D_get_info + member val array3D_get_vref = ValRefForIntrinsic v_array3D_get_info + member val array4D_get_vref = ValRefForIntrinsic v_array4D_get_info + member val seq_singleton_vref = ValRefForIntrinsic v_seq_singleton_info + member val seq_collect_vref = ValRefForIntrinsic v_seq_collect_info + member val seq_using_vref = ValRefForIntrinsic v_seq_using_info + member val seq_delay_vref = ValRefForIntrinsic v_seq_delay_info + member val seq_append_vref = ValRefForIntrinsic v_seq_append_info + member val seq_generated_vref = ValRefForIntrinsic v_seq_generated_info + member val seq_finally_vref = ValRefForIntrinsic v_seq_finally_info + member val seq_of_functions_vref = ValRefForIntrinsic v_seq_of_functions_info + member val seq_map_vref = ValRefForIntrinsic v_seq_map_info + member val seq_empty_vref = ValRefForIntrinsic v_seq_empty_info + member val new_format_vref = ValRefForIntrinsic v_new_format_info + member val sprintf_vref = ValRefForIntrinsic v_sprintf_info + member val unbox_vref = ValRefForIntrinsic v_unbox_info + member val unbox_fast_vref = ValRefForIntrinsic v_unbox_fast_info + member val istype_vref = ValRefForIntrinsic v_istype_info + member val istype_fast_vref = ValRefForIntrinsic v_istype_fast_info + member val query_source_vref = ValRefForIntrinsic v_query_source_info + member val query_value_vref = ValRefForIntrinsic v_query_value_info + member val query_run_value_vref = ValRefForIntrinsic v_query_run_value_info + member val query_run_enumerable_vref = ValRefForIntrinsic v_query_run_enumerable_info + member val query_for_vref = ValRefForIntrinsic v_query_for_value_info + member val query_yield_vref = ValRefForIntrinsic v_query_yield_value_info + member val query_yield_from_vref = ValRefForIntrinsic v_query_yield_from_value_info + member val query_select_vref = ValRefForIntrinsic v_query_select_value_info + member val query_where_vref = ValRefForIntrinsic v_query_where_value_info + member val query_zero_vref = ValRefForIntrinsic v_query_zero_value_info + + member __.seq_collect_info = v_seq_collect_info + member __.seq_using_info = v_seq_using_info + member __.seq_delay_info = v_seq_delay_info + member __.seq_append_info = v_seq_append_info + member __.seq_generated_info = v_seq_generated_info + member __.seq_finally_info = v_seq_finally_info + member __.seq_of_functions_info = v_seq_of_functions_info + member __.seq_map_info = v_seq_map_info + member __.seq_singleton_info = v_seq_singleton_info + member __.seq_empty_info = v_seq_empty_info + member __.new_format_info = v_new_format_info + member __.unbox_info = v_unbox_info + member __.get_generic_comparer_info = v_get_generic_comparer_info + member __.get_generic_er_equality_comparer_info = v_get_generic_er_equality_comparer_info + member __.get_generic_per_equality_comparer_info = v_get_generic_per_equality_comparer_info + member __.dispose_info = v_dispose_info + member __.getstring_info = v_getstring_info + member __.unbox_fast_info = v_unbox_fast_info + member __.istype_info = v_istype_info + member __.istype_fast_info = v_istype_fast_info + member __.lazy_force_info = v_lazy_force_info + member __.lazy_create_info = v_lazy_create_info + member __.create_instance_info = v_create_instance_info + member __.create_event_info = v_create_event_info + member __.seq_to_list_info = v_seq_to_list_info + member __.seq_to_array_info = v_seq_to_array_info + member __.array_get_info = v_array_get_info + member __.array2D_get_info = v_array2D_get_info + member __.array3D_get_info = v_array3D_get_info + member __.array4D_get_info = v_array4D_get_info + member __.deserialize_quoted_FSharp_20_plus_info = v_deserialize_quoted_FSharp_20_plus_info + member __.deserialize_quoted_FSharp_40_plus_info = v_deserialize_quoted_FSharp_40_plus_info + member __.cast_quotation_info = v_cast_quotation_info + member __.lift_value_info = v_lift_value_info + member __.lift_value_with_name_info = v_lift_value_with_name_info + member __.lift_value_with_defn_info = v_lift_value_with_defn_info + member __.query_source_as_enum_info = v_query_source_as_enum_info + member __.new_query_source_info = v_new_query_source_info + member __.query_builder_tcref = v_query_builder_tcref + member __.fail_init_info = v_fail_init_info + member __.fail_static_init_info = v_fail_static_init_info + member __.check_this_info = v_check_this_info + member __.quote_to_linq_lambda_info = v_quote_to_linq_lambda_info + + + member val generic_hash_withc_tuple2_vref = ValRefForIntrinsic v_generic_hash_withc_tuple2_info + member val generic_hash_withc_tuple3_vref = ValRefForIntrinsic v_generic_hash_withc_tuple3_info + member val generic_hash_withc_tuple4_vref = ValRefForIntrinsic v_generic_hash_withc_tuple4_info + member val generic_hash_withc_tuple5_vref = ValRefForIntrinsic v_generic_hash_withc_tuple5_info + member val generic_equals_withc_tuple2_vref = ValRefForIntrinsic v_generic_equals_withc_tuple2_info + member val generic_equals_withc_tuple3_vref = ValRefForIntrinsic v_generic_equals_withc_tuple3_info + member val generic_equals_withc_tuple4_vref = ValRefForIntrinsic v_generic_equals_withc_tuple4_info + member val generic_equals_withc_tuple5_vref = ValRefForIntrinsic v_generic_equals_withc_tuple5_info + member val generic_compare_withc_tuple2_vref = ValRefForIntrinsic v_generic_compare_withc_tuple2_info + member val generic_compare_withc_tuple3_vref = ValRefForIntrinsic v_generic_compare_withc_tuple3_info + member val generic_compare_withc_tuple4_vref = ValRefForIntrinsic v_generic_compare_withc_tuple4_info + member val generic_compare_withc_tuple5_vref = ValRefForIntrinsic v_generic_compare_withc_tuple5_info + member val generic_equality_withc_outer_vref = ValRefForIntrinsic v_generic_equality_withc_outer_info + + + member __.cons_ucref = v_cons_ucref + member __.nil_ucref = v_nil_ucref + + // A list of types that are explicitly suppressed from the F# intellisense + // Note that the suppression checks for the precise name of the type + // so the lowercase versions are visible + member __.suppressed_types = v_suppressed_types + // Are we assuming all code gen is for F# interactive, with no static linking + member __.isInteractive=isInteractive + member __.MkSysTyconRef=findSysTyconRef + member __.TryMkSysTyconRef=tryFindSysTyconRef + member __.MkSysILTypeRef=mkSysILTypeRef + member __.TryMkSysILTypeRef=tryMkSysILTypeRef + member __.usesMscorlib = usesMscorlib + member __.MkSysAttrib=mkSysAttrib + + member val ilxPubCloEnv=EraseClosures.newIlxPubCloEnv(ilg, addMethodGeneratedAttrs, addFieldGeneratedAttrs, addFieldNeverAttrs) + member __.AddMethodGeneratedAttributes mdef = addMethodGeneratedAttrs mdef + member __.AddFieldGeneratedAttrs mdef = addFieldGeneratedAttrs mdef + member __.AddFieldNeverAttrs mdef = addFieldNeverAttrs mdef + member __.mkDebuggerHiddenAttribute() = mkILCustomAttribute ilg (mkSysILTypeRef tname_DebuggerHiddenAttribute, [], [], []) + member __.mkDebuggerDisplayAttribute s = mkILCustomAttribute ilg (mkSysILTypeRef tname_DebuggerDisplayAttribute, [ilg.typ_String], [ILAttribElem.String (Some s)], []) + member __.DebuggerBrowsableNeverAttribute = mkDebuggerBrowsableNeverAttribute() + + member __.mkDebuggerStepThroughAttribute() = mkILCustomAttribute ilg (mkSysILTypeRef tname_DebuggerStepThroughAttribute, [], [], []) + member __.mkDebuggableAttribute (jitOptimizerDisabled) = + mkILCustomAttribute ilg (tref_DebuggableAttribute, [ilg.typ_Bool; ilg.typ_Bool], [ILAttribElem.Bool false; ILAttribElem.Bool jitOptimizerDisabled], []) + + + member __.mkDebuggableAttributeV2(jitTracking, ignoreSymbolStoreSequencePoints, jitOptimizerDisabled, enableEnC) = + let debuggingMode = (if jitTracking then 1 else 0) ||| + (if jitOptimizerDisabled then 256 else 0) ||| + (if ignoreSymbolStoreSequencePoints then 2 else 0) ||| + (if enableEnC then 4 else 0) + let tref_DebuggableAttribute_DebuggingModes = mkILTyRefInTyRef (tref_DebuggableAttribute, tname_DebuggableAttribute_DebuggingModes) + mkILCustomAttribute ilg + (tref_DebuggableAttribute, [mkILNonGenericValueTy tref_DebuggableAttribute_DebuggingModes], + (* See System.Diagnostics.DebuggableAttribute.DebuggingModes *) + [ILAttribElem.Int32( debuggingMode )], []) + + member __.CompilerGeneratedAttribute = mkCompilerGeneratedAttribute () -let public mkSysAttrib g nm = g.mkSysAttrib nm + member __.eraseClassUnionDef = EraseUnions.mkClassUnionDef (addMethodGeneratedAttrs, addPropertyGeneratedAttrs, addPropertyNeverAttrs, addFieldGeneratedAttrs, addFieldNeverAttrs, mkDebuggerTypeProxyAttribute) ilg + + +(* + (cenv.ilg.mkSysILTypeRef "System.Runtime.InteropServices.StructLayoutAttribute", + [mkILNonGenericValueTy (cenv.ilg.mkSysILTypeRef "System.Runtime.InteropServices.LayoutKind") ], +*) + + +#if DEBUG +// This global is only used during debug output +let global_g = ref (None : TcGlobals option) +#endif diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index 5479fb2af2f..8086054b12c 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -52,14 +52,14 @@ let isThreadOrContextStatic g attrs = HasFSharpAttributeOpt g g.attrib_ThreadStaticAttribute attrs || HasFSharpAttributeOpt g g.attrib_ContextStaticAttribute attrs -let mkNilListPat g m ty = TPat_unioncase(g.nil_ucref,[ty],[],m) -let mkConsListPat g ty ph pt = TPat_unioncase(g.cons_ucref,[ty],[ph;pt],unionRanges ph.Range pt.Range) +let mkNilListPat (g: TcGlobals) m ty = TPat_unioncase(g.nil_ucref,[ty],[],m) +let mkConsListPat (g: TcGlobals) ty ph pt = TPat_unioncase(g.cons_ucref,[ty],[ph;pt],unionRanges ph.Range pt.Range) let mkCompGenLetIn m nm ty e f = let v,ve = mkCompGenLocal m nm ty mkCompGenLet m v e (f (v,ve)) -let mkUnitDelayLambda g m e = +let mkUnitDelayLambda (g: TcGlobals) m e = let uv,_ = mkCompGenLocal m "unitVar" g.unit_ty mkLambda m uv (e,tyOfExpr g e) @@ -113,7 +113,7 @@ exception InvalidInternalsVisibleToAssemblyName of (*badName*)string * (*fileNam // Identify any security attributes -let IsSecurityAttribute g amap (casmap : Dictionary) (Attrib(tcref,_,_,_,_,_,_)) m = +let IsSecurityAttribute (g: TcGlobals) amap (casmap : Dictionary) (Attrib(tcref,_,_,_,_,_,_)) m = // There's no CAS on Silverlight, so we have to be careful here match g.attrib_SecurityAttribute with | None -> false @@ -1476,7 +1476,7 @@ let InstanceMembersNeedSafeInitCheck cenv m thisTy = AllowMultiIntfInstantiations.Yes thisTy -let MakeSafeInitField g env m isStatic = +let MakeSafeInitField (g: TcGlobals) env m isStatic = let id = ident(globalNng.FreshCompilerGeneratedName("init",m),m) let taccess = TAccess [env.eAccessPath] NewRecdField isStatic None id g.int_ty true true [] [] XmlDoc.Empty taccess true @@ -9452,13 +9452,13 @@ and TcMethodApplication match currDfltVal with | MissingValue -> // Add an I_nop if this is an initonly field to make sure we never recognize it as an lvalue. See mkExprAddrOfExpr. - emptyPreBinder,mkAsmExpr ([ mkNormalLdsfld (fspec_Missing_Value cenv.g.ilg); AI_nop ],[],[],[currCalledArgTy],mMethExpr) + emptyPreBinder,mkAsmExpr ([ mkNormalLdsfld (fspec_Missing_Value cenv.g); AI_nop ],[],[],[currCalledArgTy],mMethExpr) | DefaultValue -> emptyPreBinder,mkDefault(mMethExpr,currCalledArgTy) | Constant fieldInit -> match currCalledArgTy with | NullableTy cenv.g inst when fieldInit <> ILFieldInit.Null -> - let nullableTy = mkILNonGenericBoxedTy(cenv.g.mkSysILTypeRef "System.Nullable`1") + let nullableTy = mkILNonGenericBoxedTy(cenv.g.MkSysILTypeRef "System.Nullable`1") let ctor = mkILCtorMethSpecForTy(nullableTy, [ILType.TypeVar 0us]).MethodRef let ctorArgs = [Expr.Const(TcFieldInit mMethExpr fieldInit,mMethExpr, inst)] emptyPreBinder,Expr.Op(TOp.ILCall(false, false, true, true, NormalValUse, false, false, ctor, [inst], [], [currCalledArgTy]), [], ctorArgs, mMethExpr) @@ -9476,7 +9476,7 @@ and TcMethodApplication emptyPreBinder,Expr.Const(TcFieldInit mMethExpr fieldInit,mMethExpr,currCalledArgTy) | WrapperForIDispatch -> - match cenv.g.ilg.tryMkSysILTypeRef "System.Runtime.InteropServices.DispatchWrapper" with + match cenv.g.TryMkSysILTypeRef "System.Runtime.InteropServices.DispatchWrapper" with | None -> error(Error(FSComp.SR.fscSystemRuntimeInteropServicesIsRequired(), mMethExpr)) | Some tref -> let ty = mkILNonGenericBoxedTy tref @@ -9484,7 +9484,7 @@ and TcMethodApplication let expr = Expr.Op(TOp.ILCall(false,false,false,true,NormalValUse,false,false,mref,[],[],[cenv.g.obj_ty]),[],[mkDefault(mMethExpr,currCalledArgTy)],mMethExpr) emptyPreBinder,expr | WrapperForIUnknown -> - match cenv.g.ilg.tryMkSysILTypeRef "System.Runtime.InteropServices.UnknownWrapper" with + match cenv.g.TryMkSysILTypeRef "System.Runtime.InteropServices.UnknownWrapper" with | None -> error(Error(FSComp.SR.fscSystemRuntimeInteropServicesIsRequired(), mMethExpr)) | Some tref -> let ty = mkILNonGenericBoxedTy tref @@ -9872,7 +9872,7 @@ and TcStaticOptimizationConstraint cenv env tpenv c = TTyconIsStruct(mkTyparTy tp'),tpenv /// Emit a conv.i instruction -and mkConvToNativeInt g e m = Expr.Op (TOp.ILAsm ([ AI_conv ILBasicType.DT_I], [ g.nativeint_ty ]),[],[e],m) +and mkConvToNativeInt (g:TcGlobals) e m = Expr.Op (TOp.ILAsm ([ AI_conv ILBasicType.DT_I], [ g.nativeint_ty ]),[],[e],m) /// Fix up the r.h.s. of a 'use x = fixed expr' and TcAndBuildFixedExpr cenv env (overallPatTy, fixedExpr, overallExprTy, mBinding) = @@ -11538,7 +11538,7 @@ let TcAndPublishValSpec (cenv, env, containerInfo: ContainerInfo, declKind, memF exception NotUpperCaseConstructor of range -let CheckNamespaceModuleOrTypeName g (id:Ident) = +let CheckNamespaceModuleOrTypeName (g:TcGlobals) (id:Ident) = // type names '[]' etc. are used in fslib if not g.compilingFslib && id.idText.IndexOfAny(IllegalCharactersInTypeAndNamespaceNames) <> -1 then errorR(Error(FSComp.SR.tcInvalidNamespaceModuleTypeUnionName(),id.idRange)) @@ -11740,7 +11740,7 @@ let TcModuleOrNamespaceLidAndPermitAutoResolve env amap (longId : Ident list) = | Result res -> Result res | Exception err -> raze err -let TcOpenDecl tcSink g amap m scopem env (longId : Ident list) = +let TcOpenDecl tcSink (g:TcGlobals) amap m scopem env (longId : Ident list) = let modrefs = ForceRaise (TcModuleOrNamespaceLidAndPermitAutoResolve env amap longId) // validate opened namespace names diff --git a/src/fsharp/TypeRelations.fs b/src/fsharp/TypeRelations.fs index fc4f2eb84d6..486a1f2315d 100755 --- a/src/fsharp/TypeRelations.fs +++ b/src/fsharp/TypeRelations.fs @@ -137,7 +137,7 @@ let rec TypeFeasiblySubsumesType ndeep g amap m ty1 canCoerce ty2 = /// variables when compiling patterns at generalized bindings. /// e.g. let ([],x) = ([],[]) /// Here x gets a generalized type "list<'T>". -let ChooseTyparSolutionAndRange g amap (tp:Typar) = +let ChooseTyparSolutionAndRange (g: TcGlobals) amap (tp:Typar) = let m = tp.Range let max,m = let initial = diff --git a/src/fsharp/fsc.fs b/src/fsharp/fsc.fs index 70c0d1369ce..2a1f3bc72fb 100644 --- a/src/fsharp/fsc.fs +++ b/src/fsharp/fsc.fs @@ -732,17 +732,17 @@ module AttributeHelpers = /// Try to find an attribute that takes a string argument let TryFindStringAttribute tcGlobals attrib attribs = - match TryFindFSharpAttribute tcGlobals (mkSysAttrib tcGlobals attrib) attribs with + match TryFindFSharpAttribute tcGlobals (tcGlobals.MkSysAttrib attrib) attribs with | Some (Attrib(_, _, [ AttribStringArg(s) ], _, _, _, _)) -> Some (s) | _ -> None let TryFindIntAttribute tcGlobals attrib attribs = - match TryFindFSharpAttribute tcGlobals (mkSysAttrib tcGlobals attrib) attribs with + match TryFindFSharpAttribute tcGlobals (tcGlobals.MkSysAttrib attrib) attribs with | Some (Attrib(_, _, [ AttribInt32Arg(i) ], _, _, _, _)) -> Some (i) | _ -> None let TryFindBoolAttribute tcGlobals attrib attribs = - match TryFindFSharpAttribute tcGlobals (mkSysAttrib tcGlobals attrib) attribs with + match TryFindFSharpAttribute tcGlobals (tcGlobals.MkSysAttrib attrib) attribs with | Some (Attrib(_, _, [ AttribBoolArg(p) ], _, _, _, _)) -> Some (p) | _ -> None @@ -793,7 +793,7 @@ module MainModuleBuilder = let typesForwardedToSystemNumerics = set [ "System.Numerics.BigInteger" ] - let createMscorlibExportList tcGlobals = + let createMscorlibExportList (tcGlobals: TcGlobals) = // We want to write forwarders out for all injected types except for System.ITuple, which is internal // Forwarding System.ITuple will cause FxCop failures on 4.0 Set.union (Set.filter (fun t -> t <> "System.ITuple") injectedCompatTypes) typesForwardedToMscorlib |> @@ -806,7 +806,7 @@ module MainModuleBuilder = CustomAttrs = mkILCustomAttrs List.empty }) |> Seq.toList - let createSystemNumericsExportList tcGlobals (tcImports:TcImports) = + let createSystemNumericsExportList (tcGlobals: TcGlobals) (tcImports:TcImports) = let refNumericsDllName = if tcGlobals.usesMscorlib then "System.Numerics" else "System.Runtime.Numerics" @@ -921,12 +921,12 @@ module MainModuleBuilder = mkILCustomAttrs [ if not tcConfig.internConstantStrings then yield mkILCustomAttribute tcGlobals.ilg - (tcGlobals.ilg.mkSysILTypeRef "System.Runtime.CompilerServices.CompilationRelaxationsAttribute", + (tcGlobals.MkSysILTypeRef "System.Runtime.CompilerServices.CompilationRelaxationsAttribute", [tcGlobals.ilg.typ_Int32], [ILAttribElem.Int32( 8)], []) yield! iattrs yield! codegenResults.ilAssemAttrs if Option.isSome pdbfile then - yield (tcGlobals.ilg.mkDebuggableAttributeV2 (tcConfig.jitTracking, tcConfig.ignoreSymbolStoreSequencePoints, disableJitOptimizations, false (* enableEnC *) )) + yield (tcGlobals.mkDebuggableAttributeV2 (tcConfig.jitTracking, tcConfig.ignoreSymbolStoreSequencePoints, disableJitOptimizations, false (* enableEnC *) )) yield! reflectedDefinitionAttrs ] // Make the manifest of the assembly @@ -1211,7 +1211,7 @@ module StaticLinker = let mscorlib40 = tcConfig.compilingFslib20.Value let ilBinaryReader = - let ilGlobals = mkILGlobals (tcConfig.noDebugData, (fun _ -> ILScopeRef.Local), (fun _ -> Some ILScopeRef.Local)) + let ilGlobals = mkILGlobals ILScopeRef.Local let opts = { ILBinaryReader.mkDefault (ilGlobals) with optimizeForMemory=tcConfig.optimizeForMemory pdbPath = None } @@ -1911,7 +1911,7 @@ let main2a(Args (tcConfig, tcImports, frameworkTcImports: TcImports, tcGlobals, Args (tcConfig, tcImports, tcGlobals, errorLogger, generatedCcu, outfile, optimizedImpls, topAttrs, pdbfile, assemblyName, (sigDataAttributes, sigDataResources), optDataResources, assemVerFromAttrib, signingInfo, metadataVersion, exiter) /// Phase 2b: IL code generation -let main2b(Args (tcConfig: TcConfig, tcImports, tcGlobals, errorLogger, generatedCcu: CcuThunk, outfile, optimizedImpls, topAttrs, pdbfile, assemblyName, idata, optDataResources, assemVerFromAttrib, signingInfo, metadataVersion, exiter: Exiter)) = +let main2b(Args (tcConfig: TcConfig, tcImports, tcGlobals: TcGlobals, errorLogger, generatedCcu: CcuThunk, outfile, optimizedImpls, topAttrs, pdbfile, assemblyName, idata, optDataResources, assemVerFromAttrib, signingInfo, metadataVersion, exiter: Exiter)) = // Compute a static linker. let ilGlobals = tcGlobals.ilg @@ -1927,8 +1927,7 @@ let main2b(Args (tcConfig: TcConfig, tcImports, tcGlobals, errorLogger, generate // Check if System.SerializableAttribute exists in mscorlib.dll, // so that make sure the compiler only emits "serializable" bit into IL metadata when it is available. // Note that SerializableAttribute may be relocated in the future but now resides in mscorlib. - let netFxHasSerializableAttribute = tcImports.SystemRuntimeContainsType "System.SerializableAttribute" - let codegenResults = GenerateIlxCode (IlWriteBackend, false, false, tcConfig, topAttrs, optimizedImpls, generatedCcu.AssemblyName, netFxHasSerializableAttribute, ilxGenerator) + let codegenResults = GenerateIlxCode (IlWriteBackend, false, false, tcConfig, topAttrs, optimizedImpls, generatedCcu.AssemblyName, ilxGenerator) let casApplied = new Dictionary() let securityAttrs, topAssemblyAttrs = topAttrs.assemblyAttrs |> List.partition (fun a -> TypeChecker.IsSecurityAttribute tcGlobals (tcImports.GetImportMap()) casApplied a rangeStartup) // remove any security attributes from the top-level assembly attribute list diff --git a/src/fsharp/fsi/fsi.fs b/src/fsharp/fsi/fsi.fs index 91e64f2be3c..3b05fe25f3e 100644 --- a/src/fsharp/fsi/fsi.fs +++ b/src/fsharp/fsi/fsi.fs @@ -236,7 +236,7 @@ type public FsiEvaluationSessionHostConfig () = /// Used to print value signatures along with their values, according to the current /// set of pretty printers installed in the system, and default printing rules. -type internal FsiValuePrinter(fsi: FsiEvaluationSessionHostConfig, ilGlobals, generateDebugInfo, resolvePath, outWriter) = +type internal FsiValuePrinter(fsi: FsiEvaluationSessionHostConfig, g: TcGlobals, generateDebugInfo, resolvePath, outWriter) = /// This printer is used by F# Interactive if no other printers apply. let DefaultPrintingIntercept (ienv: Internal.Utilities.StructuredFormat.IEnvironment) (obj:obj) = @@ -308,7 +308,7 @@ type internal FsiValuePrinter(fsi: FsiEvaluationSessionHostConfig, ilGlobals, ge /// Get the evaluation context used when inverting the storage mapping of the ILRuntimeWriter. member __.GetEvaluationContext emEnv = - let cenv = { ilg = ilGlobals ; generatePdb = generateDebugInfo; resolvePath=resolvePath } + let cenv = { ilg = g.ilg ; generatePdb = generateDebugInfo; resolvePath=resolvePath; tryMkSysILTypeRef=g.TryMkSysILTypeRef } { LookupFieldRef = ILRuntimeWriter.LookupFieldRef emEnv >> Option.get LookupMethodRef = ILRuntimeWriter.LookupMethodRef emEnv >> Option.get LookupTypeRef = ILRuntimeWriter.LookupTypeRef cenv emEnv @@ -920,7 +920,7 @@ type internal FsiDynamicCompiler let generateDebugInfo = tcConfigB.debuginfo - let valuePrinter = FsiValuePrinter(fsi, ilGlobals, generateDebugInfo, resolvePath, outWriter) + let valuePrinter = FsiValuePrinter(fsi, tcGlobals, generateDebugInfo, resolvePath, outWriter) let assemblyBuilder,moduleBuilder = ILRuntimeWriter.mkDynamicAssemblyAndModule (assemblyName, tcConfigB.optSettings.localOpt(), generateDebugInfo, false) @@ -966,7 +966,7 @@ type internal FsiDynamicCompiler errorLogger.AbortOnError(fsiConsoleOutput); let fragName = textOfLid prefixPath - let codegenResults = GenerateIlxCode (IlReflectBackend, isInteractiveItExpr, runningOnMono, tcConfig, topCustomAttrs, optimizedImpls, fragName, true, ilxGenerator) + let codegenResults = GenerateIlxCode (IlReflectBackend, isInteractiveItExpr, runningOnMono, tcConfig, topCustomAttrs, optimizedImpls, fragName, ilxGenerator) errorLogger.AbortOnError(fsiConsoleOutput); // Each input is like a small separately compiled extension to a single source file. @@ -997,14 +997,15 @@ type internal FsiDynamicCompiler #endif ReportTime tcConfig "Reflection.Emit"; - let emEnv,execs = ILRuntimeWriter.emitModuleFragment(ilGlobals, emEnv, assemblyBuilder, moduleBuilder, mainmod3, generateDebugInfo, resolvePath) + + let emEnv,execs = ILRuntimeWriter.emitModuleFragment(ilGlobals, emEnv, assemblyBuilder, moduleBuilder, mainmod3, generateDebugInfo, resolvePath, tcGlobals.TryMkSysILTypeRef) errorLogger.AbortOnError(fsiConsoleOutput); // Explicitly register the resources with the QuotationPickler module // We would save them as resources into the dynamic assembly but there is missing // functionality System.Reflection for dynamic modules that means they can't be read back out - let cenv = { ilg = ilGlobals ; generatePdb = generateDebugInfo; resolvePath=resolvePath } + let cenv = { ilg = ilGlobals ; generatePdb = generateDebugInfo; resolvePath=resolvePath; tryMkSysILTypeRef=tcGlobals.TryMkSysILTypeRef } for (referencedTypeDefs, bytes) in codegenResults.quotationResourceInfo do let referencedTypes = [| for tref in referencedTypeDefs do diff --git a/src/fsharp/infos.fs b/src/fsharp/infos.fs index ac6f17cf907..167e71c824f 100755 --- a/src/fsharp/infos.fs +++ b/src/fsharp/infos.fs @@ -93,7 +93,7 @@ let GetSuperTypeOfType g amap m typ = None /// Make a type for System.Collections.Generic.IList -let mkSystemCollectionsGenericIListTy g ty = TType_app(g.tcref_System_Collections_Generic_IList,[ty]) +let mkSystemCollectionsGenericIListTy (g: TcGlobals) ty = TType_app(g.tcref_System_Collections_Generic_IList,[ty]) [] /// Indicates whether we can skip interface types that lie outside the reference set @@ -784,7 +784,7 @@ type ILMethInfo = /// Indicates if the method is marked as a DllImport (a PInvoke). This is done by looking at the IL custom attributes on /// the method. - member x.IsDllImport g = + member x.IsDllImport (g: TcGlobals) = match g.attrib_DllImportAttribute with | None -> false | Some (AttribInfo(tref,_)) ->x.RawMetadata.CustomAttrs |> TryDecodeILAttribute g tref |> Option.isSome diff --git a/src/ilx/EraseClosures.fs b/src/ilx/EraseClosures.fs index f36df9d76f5..9e49945b3d2 100644 --- a/src/ilx/EraseClosures.fs +++ b/src/ilx/EraseClosures.fs @@ -15,9 +15,6 @@ open Microsoft.FSharp.Compiler.AbstractIL.Diagnostics open Microsoft.FSharp.Compiler.AbstractIL.IL open Microsoft.FSharp.Compiler.PrettyNaming -let addMethodGeneratedAttrsToTypeDef ilg tdef = - { tdef with Methods = tdef.Methods.AsList |> List.map (fun md -> md |> addMethodGeneratedAttrs ilg) |> mkILMethods } - // -------------------------------------------------------------------- // Erase closures and function types // by compiling down to code pointers, classes etc. @@ -121,14 +118,23 @@ let mkFuncTypeRef n = [IlxSettings.ilxNamespace () + ".OptimizedClosures"], "FSharpFunc`"+ string (n + 1)) type cenv = - { ilg:ILGlobals; - tref_Func: ILTypeRef[]; - mkILTyFuncTy: ILType } + { ilg:ILGlobals + tref_Func: ILTypeRef[] + mkILTyFuncTy: ILType + addFieldGeneratedAttrs: ILFieldDef -> ILFieldDef + addFieldNeverAttrs: ILFieldDef -> ILFieldDef + addMethodGeneratedAttrs: ILMethodDef -> ILMethodDef } -let newIlxPubCloEnv(ilg) = +let addMethodGeneratedAttrsToTypeDef cenv tdef = + { tdef with Methods = tdef.Methods.AsList |> List.map (fun md -> md |> cenv.addMethodGeneratedAttrs) |> mkILMethods } + +let newIlxPubCloEnv(ilg,addMethodGeneratedAttrs,addFieldGeneratedAttrs,addFieldNeverAttrs) = { ilg=ilg; tref_Func= Array.init 10 (fun i -> mkFuncTypeRef(i+1)); - mkILTyFuncTy=ILType.Boxed (mkILNonGenericTySpec (mkILTyRef (IlxSettings.ilxFsharpCoreLibScopeRef (), IlxSettings.ilxNamespace () + ".FSharpTypeFunc"))) } + mkILTyFuncTy=ILType.Boxed (mkILNonGenericTySpec (mkILTyRef (IlxSettings.ilxFsharpCoreLibScopeRef (), IlxSettings.ilxNamespace () + ".FSharpTypeFunc"))) + addMethodGeneratedAttrs=addMethodGeneratedAttrs + addFieldGeneratedAttrs=addFieldGeneratedAttrs + addFieldNeverAttrs=addFieldNeverAttrs} let mkILTyFuncTy cenv = cenv.mkILTyFuncTy @@ -334,8 +340,8 @@ let mkILCloFldDefs cenv flds = |> List.map (fun fv -> let fdef = mkILInstanceField (fv.fvName,fv.fvType,None,ILMemberAccess.Public) if fv.fvCompilerGenerated then - fdef |> addFieldNeverAttrs cenv.ilg - |> addFieldGeneratedAttrs cenv.ilg + fdef |> cenv.addFieldNeverAttrs + |> cenv.addFieldGeneratedAttrs else fdef) @@ -454,7 +460,7 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo = convIlxClosureDef cenv encl td {clo with cloStructure=nowStruct; cloCode=notlazy nowCode} - let nowTypeDefs = nowTypeDefs |> List.map (addMethodGeneratedAttrsToTypeDef cenv.ilg) + let nowTypeDefs = nowTypeDefs |> List.map (addMethodGeneratedAttrsToTypeDef cenv) nowTypeDefs @ laterTypeDefs else @@ -475,7 +481,7 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo = nowTy, mkILCloFldSpecs cenv nowFields, ILMemberAccess.Assembly) - |> addMethodGeneratedAttrs cenv.ilg + |> cenv.addMethodGeneratedAttrs let cloTypeDef = { Name = td.Name; @@ -552,7 +558,7 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo = cloCode=notlazy laterCode} // add 'compiler generated' to all the methods in the 'now' classes - let nowTypeDefs = nowTypeDefs |> List.map (addMethodGeneratedAttrsToTypeDef cenv.ilg) + let nowTypeDefs = nowTypeDefs |> List.map (addMethodGeneratedAttrsToTypeDef cenv) nowTypeDefs @ laterTypeDefs @@ -577,7 +583,7 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo = nowTy, mkILCloFldSpecs cenv nowFields, ILMemberAccess.Assembly) - |> addMethodGeneratedAttrs cenv.ilg + |> cenv.addMethodGeneratedAttrs { Name = td.Name; GenericParams= td.GenericParams; diff --git a/src/ilx/EraseClosures.fsi b/src/ilx/EraseClosures.fsi index 0cea96a8922..d1843963c8d 100644 --- a/src/ilx/EraseClosures.fsi +++ b/src/ilx/EraseClosures.fsi @@ -13,7 +13,7 @@ val mkCallFunc : cenv -> allocLocal:(ILType -> uint16) -> numThisGenParams:int - val mkILFuncTy : cenv -> ILType -> ILType -> ILType val mkILTyFuncTy : cenv -> ILType -val newIlxPubCloEnv : ILGlobals -> cenv +val newIlxPubCloEnv : ILGlobals * addMethodGeneratedAttrs: (ILMethodDef -> ILMethodDef) * addFieldGeneratedAttrs: (ILFieldDef -> ILFieldDef) * addFieldNeverAttrs: (ILFieldDef -> ILFieldDef) -> cenv val mkTyOfLambdas: cenv -> IlxClosureLambdas -> ILType val convIlxClosureDef : cenv -> encl: string list -> ILTypeDef -> IlxClosureInfo -> ILTypeDef list diff --git a/src/ilx/EraseUnions.fs b/src/ilx/EraseUnions.fs index bc47b5a1200..516435a4b33 100644 --- a/src/ilx/EraseUnions.fs +++ b/src/ilx/EraseUnions.fs @@ -379,6 +379,7 @@ type ICodeGen<'Mark> = abstract SetMarkToHere: 'Mark -> unit abstract EmitInstr : ILInstr -> unit abstract EmitInstrs : ILInstr list -> unit + abstract MkInvalidCastExnNewobj : unit -> ILInstr let genWith g : ILCode = let instrs = ResizeArray() @@ -389,7 +390,8 @@ let genWith g : ILCode = member __.GenLocal(ilty) = failwith "not needed" member __.SetMarkToHere(m) = lab2pc.[m] <- instrs.Count member __.EmitInstr x = instrs.Add x - member cg.EmitInstrs xs = for i in xs do cg.EmitInstr i } + member cg.EmitInstrs xs = for i in xs do cg.EmitInstr i + member __.MkInvalidCastExnNewobj () = failwith "not needed" } { Labels = lab2pc Instrs = instrs.ToArray() @@ -491,7 +493,7 @@ let emitCastData ilg (cg: ICodeGen<'Mark>) (canfail,avoidHelpers,cuspec,cidx) = let internal1 = cg.GenerateDelayMark () cg.EmitInstrs [AI_dup; I_brcmp (BI_brfalse, cg.CodeLabel outlab) ] cg.SetMarkToHere internal1 - cg.EmitInstrs [mkPrimaryAssemblyExnNewobj ilg "System.InvalidCastException"; I_throw ] + cg.EmitInstrs [cg.MkInvalidCastExnNewobj (); I_throw ] cg.SetMarkToHere outlab else // If it can't fail, it's still verifiable just to leave the value on the stack unchecked @@ -504,7 +506,7 @@ let emitCastData ilg (cg: ICodeGen<'Mark>) (canfail,avoidHelpers,cuspec,cidx) = emitLdDataTagPrim ilg None cg (avoidHelpers,cuspec) cg.EmitInstrs [ mkLdcInt32 cidx; I_brcmp (BI_beq, cg.CodeLabel outlab) ] cg.SetMarkToHere internal1 - cg.EmitInstrs [mkPrimaryAssemblyExnNewobj ilg "System.InvalidCastException"; I_throw ] + cg.EmitInstrs [cg.MkInvalidCastExnNewobj (); I_throw ] cg.SetMarkToHere outlab else // If it can't fail, it's still verifiable just to leave the value on the stack unchecked @@ -572,18 +574,7 @@ let emitDataSwitch ilg (cg: ICodeGen<'Mark>) (avoidHelpers, cuspec, cases) = //--------------------------------------------------- // Generate the union classes -let mkHiddenGeneratedInstanceFieldDef ilg (nm,ty,init,access) = - mkILInstanceField (nm,ty,init,access) - |> addFieldNeverAttrs ilg - |> addFieldGeneratedAttrs ilg - -let mkHiddenGeneratedStaticFieldDef ilg (a,b,c,d,e) = - mkILStaticField (a,b,c,d,e) - |> addFieldNeverAttrs ilg - |> addFieldGeneratedAttrs ilg - - -let mkMethodsAndPropertiesForFields ilg access attr hasHelpers (typ: ILType) (fields: IlxUnionField[]) = +let mkMethodsAndPropertiesForFields (addMethodGeneratedAttrs, addPropertyGeneratedAttrs) access attr hasHelpers (typ: ILType) (fields: IlxUnionField[]) = let basicProps = fields |> Array.map (fun field -> @@ -597,7 +588,7 @@ let mkMethodsAndPropertiesForFields ilg access attr hasHelpers (typ: ILType) (fi Init=None Args = [] CustomAttrs= field.ILField.CustomAttrs } - |> addPropertyGeneratedAttrs ilg + |> addPropertyGeneratedAttrs ) |> Array.toList @@ -609,12 +600,12 @@ let mkMethodsAndPropertiesForFields ilg access attr hasHelpers (typ: ILType) (fi ("get_" + adjustFieldName hasHelpers field.Name, access, [], mkILReturn field.Type, mkMethodBody(true,[],2,nonBranchingInstrsToCode [ mkLdarg 0us; mkNormalLdfld fspec ], attr)) - |> addMethodGeneratedAttrs ilg ] + |> addMethodGeneratedAttrs ] basicProps, basicMethods -let convAlternativeDef ilg num (td:ILTypeDef) cud info cuspec (baseTy:ILType) (alt:IlxUnionAlternative) = +let convAlternativeDef (addMethodGeneratedAttrs, addPropertyGeneratedAttrs, addPropertyNeverAttrs, addFieldGeneratedAttrs, addFieldNeverAttrs, mkDebuggerTypeProxyAttribute) (ilg: ILGlobals) num (td:ILTypeDef) cud info cuspec (baseTy:ILType) (alt:IlxUnionAlternative) = let attr = cud.cudWhere let altName = alt.Name let fields = alt.FieldDefs @@ -648,7 +639,7 @@ let convAlternativeDef ilg num (td:ILTypeDef) cud info cuspec (baseTy:ILType) (a mkMethodBody(true,[],fields.Length, nonBranchingInstrsToCode [ I_ldsfld (Nonvolatile,mkConstFieldSpec altName baseTy) ], attr)) - |> addMethodGeneratedAttrs ilg + |> addMethodGeneratedAttrs [meth] else @@ -671,7 +662,7 @@ let convAlternativeDef ilg num (td:ILTypeDef) cud info cuspec (baseTy:ILType) (a mkILReturn ilg.typ_Bool, mkMethodBody(true,[],2,nonBranchingInstrsToCode ([ mkLdarg0 ] @ mkIsData ilg (true, cuspec, num)), attr)) - |> addMethodGeneratedAttrs ilg ], + |> addMethodGeneratedAttrs ], [ { Name=mkTesterName altName IsRTSpecialName=false IsSpecialName=false @@ -682,8 +673,8 @@ let convAlternativeDef ilg num (td:ILTypeDef) cud info cuspec (baseTy:ILType) (a Init=None Args = [] CustomAttrs=emptyILCustomAttrs } - |> addPropertyGeneratedAttrs ilg - |> addPropertyNeverAttrs ilg ] + |> addPropertyGeneratedAttrs + |> addPropertyNeverAttrs ] @@ -696,7 +687,7 @@ let convAlternativeDef ilg num (td:ILTypeDef) cud info cuspec (baseTy:ILType) (a ("get_" + altName, cud.cudHelpersAccess, [], mkILReturn baseTy, mkMethodBody(true,[],fields.Length, nonBranchingInstrsToCode (convNewDataInstrInternal ilg cuspec num), attr)) - |> addMethodGeneratedAttrs ilg + |> addMethodGeneratedAttrs |> addAltAttribs let nullaryProp = @@ -711,8 +702,8 @@ let convAlternativeDef ilg num (td:ILTypeDef) cud info cuspec (baseTy:ILType) (a Init=None Args = [] CustomAttrs=emptyILCustomAttrs } - |> addPropertyGeneratedAttrs ilg - |> addPropertyNeverAttrs ilg + |> addPropertyGeneratedAttrs + |> addPropertyNeverAttrs [nullaryMeth],[nullaryProp] @@ -727,7 +718,7 @@ let convAlternativeDef ilg num (td:ILTypeDef) cud info cuspec (baseTy:ILType) (a nonBranchingInstrsToCode (Array.toList (Array.mapi (fun i _ -> mkLdarg (uint16 i)) fields) @ (convNewDataInstrInternal ilg cuspec num)), attr)) - |> addMethodGeneratedAttrs ilg + |> addMethodGeneratedAttrs |> addAltAttribs [mdef],[] @@ -743,7 +734,11 @@ let convAlternativeDef ilg num (td:ILTypeDef) cud info cuspec (baseTy:ILType) (a else let altNullaryFields = if repr.MaintainPossiblyUniqueConstantFieldForAlternative(info,alt) then - let basic = mkHiddenGeneratedStaticFieldDef ilg (constFieldName altName, baseTy, None, None, ILMemberAccess.Assembly) + let basic = + mkILStaticField (constFieldName altName, baseTy, None, None, ILMemberAccess.Assembly) + |> addFieldNeverAttrs + |> addFieldGeneratedAttrs + let uniqObjField = { basic with IsInitOnly=true } let inRootClass = cuspecRepr.OptimizeAlternativeToRootClass (cuspec,alt) [ (info,alt, altTy,num,uniqObjField,inRootClass) ] @@ -762,7 +757,7 @@ let convAlternativeDef ilg num (td:ILTypeDef) cud info cuspec (baseTy:ILType) (a let debugProxyFieldName = "_obj" let debugProxyFields = - [ mkHiddenGeneratedInstanceFieldDef ilg (debugProxyFieldName,altTy, None, ILMemberAccess.Assembly) ] + [ mkILInstanceField (debugProxyFieldName,altTy, None, ILMemberAccess.Assembly) |> addFieldNeverAttrs |> addFieldGeneratedAttrs] let debugProxyCtor = mkILCtor(ILMemberAccess.Public (* must always be public - see jared parson blog entry on implementing debugger type proxy *), @@ -776,7 +771,7 @@ let convAlternativeDef ilg num (td:ILTypeDef) cud info cuspec (baseTy:ILType) (a yield mkLdarg 1us yield mkNormalStfld (mkILFieldSpecInTy (debugProxyTy,debugProxyFieldName,altTy)) ],None)) - |> addMethodGeneratedAttrs ilg + |> addMethodGeneratedAttrs let debugProxyGetterMeths = fields @@ -792,7 +787,7 @@ let convAlternativeDef ilg num (td:ILTypeDef) cud info cuspec (baseTy:ILType) (a (match td.tdKind with ILTypeDefKind.ValueType -> mkNormalLdflda | _ -> mkNormalLdfld) (mkILFieldSpecInTy (debugProxyTy,debugProxyFieldName,altTy)) mkNormalLdfld (mkILFieldSpecInTy(altTy,fldName,fldTy))],None)) - |> addMethodGeneratedAttrs ilg) + |> addMethodGeneratedAttrs ) |> Array.toList let debugProxyGetterProps = @@ -808,7 +803,7 @@ let convAlternativeDef ilg num (td:ILTypeDef) cud info cuspec (baseTy:ILType) (a Init=None Args = [] CustomAttrs= fdef.ILField.CustomAttrs } - |> addPropertyGeneratedAttrs ilg) + |> addPropertyGeneratedAttrs) |> Array.toList let debugProxyTypeDef = @@ -825,20 +820,19 @@ let convAlternativeDef ilg num (td:ILTypeDef) cud info cuspec (baseTy:ILType) (a ILTypeInit.BeforeField) [ { debugProxyTypeDef with IsSpecialName=true } ], - ( [ilg.mkDebuggerTypeProxyAttribute debugProxyTy] @ cud.cudDebugDisplayAttributes) + ( [mkDebuggerTypeProxyAttribute debugProxyTy] @ cud.cudDebugDisplayAttributes) let altTypeDef = let basicFields = fields |> Array.map (fun field -> let fldName,fldTy = mkUnionCaseFieldId field - let fdef = mkHiddenGeneratedInstanceFieldDef ilg (fldName,fldTy, None, ILMemberAccess.Assembly) + let fdef = mkILInstanceField (fldName,fldTy, None, ILMemberAccess.Assembly) |> addFieldNeverAttrs |> addFieldGeneratedAttrs { fdef with IsInitOnly=isTotallyImmutable }) |> Array.toList - let basicProps, basicMethods = mkMethodsAndPropertiesForFields ilg cud.cudReprAccess attr cud.cudHasHelpers altTy fields - + let basicProps, basicMethods = mkMethodsAndPropertiesForFields (addMethodGeneratedAttrs, addPropertyGeneratedAttrs) cud.cudReprAccess attr cud.cudHasHelpers altTy fields let basicCtorMeth = mkILStorageCtor @@ -856,7 +850,7 @@ let convAlternativeDef ilg num (td:ILTypeDef) cud info cuspec (baseTy:ILType) (a altTy, (basicFields |> List.map (fun fdef -> fdef.Name, fdef.Type) ), (if cuspec.HasHelpers = AllHelpers then ILMemberAccess.Assembly else cud.cudReprAccess)) - |> addMethodGeneratedAttrs ilg + |> addMethodGeneratedAttrs let altTypeDef = mkILGenericClass (altTy.TypeSpec.Name, @@ -882,7 +876,7 @@ let convAlternativeDef ilg num (td:ILTypeDef) cud info cuspec (baseTy:ILType) (a baseMakerMeths, baseMakerProps, altUniqObjMeths, typeDefs, altDebugTypeDefs, altNullaryFields -let mkClassUnionDef ilg tref td cud = +let mkClassUnionDef (addMethodGeneratedAttrs, addPropertyGeneratedAttrs, addPropertyNeverAttrs, addFieldGeneratedAttrs: ILFieldDef -> ILFieldDef, addFieldNeverAttrs: ILFieldDef -> ILFieldDef, mkDebuggerTypeProxyAttribute) ilg tref td cud = let boxity = match td.tdKind with ILTypeDefKind.ValueType -> ILBoxity.AsValue | _ -> ILBoxity.AsObject let baseTy = mkILFormalNamedTy boxity tref td.GenericParams let cuspec = IlxUnionSpec(IlxUnionRef(boxity,baseTy.TypeRef, cud.cudAlternatives, cud.cudNullPermitted, cud.cudHasHelpers), baseTy.GenericArgs) @@ -893,7 +887,7 @@ let mkClassUnionDef ilg tref td cud = let results = cud.cudAlternatives |> List.ofArray - |> List.mapi (fun i alt -> convAlternativeDef ilg i td cud info cuspec baseTy alt) + |> List.mapi (fun i alt -> convAlternativeDef (addMethodGeneratedAttrs, addPropertyGeneratedAttrs, addPropertyNeverAttrs, addFieldGeneratedAttrs, addFieldNeverAttrs, mkDebuggerTypeProxyAttribute) ilg i td cud info cuspec baseTy alt) let baseMethsFromAlt = results |> List.collect (fun (a,_,_,_,_,_) -> a) let basePropsFromAlt = results |> List.collect (fun (_,a,_,_,_,_) -> a) @@ -918,7 +912,7 @@ let mkClassUnionDef ilg tref td cud = let baseInit = if isStruct then None else match td.Extends with - | None -> Some ilg.tspec_Object + | None -> Some ilg.typ_Object.TypeSpec | Some typ -> Some typ.TypeSpec let ctor = @@ -928,16 +922,16 @@ let mkClassUnionDef ilg tref td cud = baseTy, (fields @ tagFieldsInObject), (if cuspec.HasHelpers = AllHelpers then ILMemberAccess.Assembly else cud.cudReprAccess)) - |> addMethodGeneratedAttrs ilg + |> addMethodGeneratedAttrs - let props, meths = mkMethodsAndPropertiesForFields ilg cud.cudReprAccess cud.cudWhere cud.cudHasHelpers baseTy alt.FieldDefs + let props, meths = mkMethodsAndPropertiesForFields (addMethodGeneratedAttrs, addPropertyGeneratedAttrs) cud.cudReprAccess cud.cudWhere cud.cudHasHelpers baseTy alt.FieldDefs yield (fields,([ctor] @ meths),props) ] |> List.unzip3 |> (fun (a,b,c) -> List.concat a, List.concat b, List.concat c) let selfAndTagFields = [ for (fldName,fldTy) in (selfFields @ tagFieldsInObject) do - let fdef = mkHiddenGeneratedInstanceFieldDef ilg (fldName,fldTy, None, ILMemberAccess.Assembly) + let fdef = mkILInstanceField (fldName,fldTy, None, ILMemberAccess.Assembly) |> addFieldNeverAttrs |> addFieldGeneratedAttrs yield { fdef with IsInitOnly= (not isStruct && isTotallyImmutable) } ] let ctorMeths = @@ -949,11 +943,11 @@ let mkClassUnionDef ilg tref td cud = else [ mkILSimpleStorageCtor (cud.cudWhere, - (match td.Extends with None -> Some ilg.tspec_Object | Some typ -> Some typ.TypeSpec), + Some (match td.Extends with None -> ilg.typ_Object | Some typ -> typ).TypeSpec, baseTy, tagFieldsInObject, ILMemberAccess.Assembly) // cud.cudReprAccess) - |> addMethodGeneratedAttrs ilg ] + |> addMethodGeneratedAttrs ] // Now initialize the constant fields wherever they are stored... let addConstFieldInit cd = @@ -994,12 +988,12 @@ let mkClassUnionDef ilg tref td cud = // // use an instance method if (repr.RepresentOneAlternativeAsNull info) then [ mkILNonGenericStaticMethod("Get" + tagPropertyName,cud.cudHelpersAccess,[mkILParamAnon baseTy],mkILReturn tagFieldType,body) - |> addMethodGeneratedAttrs ilg ], + |> addMethodGeneratedAttrs ], [] else [ mkILNonGenericInstanceMethod("get_" + tagPropertyName,cud.cudHelpersAccess,[],mkILReturn tagFieldType,body) - |> addMethodGeneratedAttrs ilg ], + |> addMethodGeneratedAttrs ], [ { Name=tagPropertyName IsRTSpecialName=false @@ -1011,8 +1005,8 @@ let mkClassUnionDef ilg tref td cud = Init=None Args = [] CustomAttrs=emptyILCustomAttrs } - |> addPropertyGeneratedAttrs ilg - |> addPropertyNeverAttrs ilg ] + |> addPropertyGeneratedAttrs + |> addPropertyNeverAttrs ] tagMeths, tagProps, tagEnumFields diff --git a/src/ilx/EraseUnions.fsi b/src/ilx/EraseUnions.fsi index 5fb357d476f..7646ab40fca 100644 --- a/src/ilx/EraseUnions.fsi +++ b/src/ilx/EraseUnions.fsi @@ -28,7 +28,7 @@ val mkStData : IlxUnionSpec * int * int -> ILInstr list val mkBrIsData : ILGlobals -> sense: bool -> avoidHelpers:bool * IlxUnionSpec * int * ILCodeLabel -> ILInstr list /// Make the type definition for a union type -val mkClassUnionDef : ILGlobals -> ILTypeRef -> ILTypeDef -> IlxUnionInfo -> ILTypeDef +val mkClassUnionDef : addMethodGeneratedAttrs:(ILMethodDef -> ILMethodDef) * addPropertyGeneratedAttrs:(ILPropertyDef -> ILPropertyDef) * addPropertyNeverAttrs:(ILPropertyDef -> ILPropertyDef) * addFieldGeneratedAttrs:(ILFieldDef -> ILFieldDef) * addFieldNeverAttrs:(ILFieldDef -> ILFieldDef) * mkDebuggerTypeProxyAttribute:(ILType -> ILAttribute) -> ilg:ILGlobals -> tref:ILTypeRef -> td:ILTypeDef -> cud:IlxUnionInfo -> ILTypeDef /// Make the IL type for a union type alternative val GetILTypeForAlternative : IlxUnionSpec -> int -> ILType @@ -41,6 +41,7 @@ type ICodeGen<'Mark> = abstract SetMarkToHere: 'Mark -> unit abstract EmitInstr : ILInstr -> unit abstract EmitInstrs : ILInstr list -> unit + abstract MkInvalidCastExnNewobj : unit -> ILInstr /// Emit the instruction sequence for a "castdata" operation val emitCastData : ILGlobals -> ICodeGen<'Mark> -> canfail: bool * avoidHelpers:bool * IlxUnionSpec * int -> unit diff --git a/vsintegration/tests/unittests/Tests.LanguageService.General.fs b/vsintegration/tests/unittests/Tests.LanguageService.General.fs index 9a577eff23d..507d7287256 100644 --- a/vsintegration/tests/unittests/Tests.LanguageService.General.fs +++ b/vsintegration/tests/unittests/Tests.LanguageService.General.fs @@ -158,11 +158,11 @@ type UsingMSBuild() = [] member public this.``PublicSurfaceArea.DotNetReflection``() = - let ps = publicTypesInAsm @"fsharp.projectsystem.fsharp.dll" + let ps = publicTypesInAsm @"FSharp.ProjectSystem.FSharp.dll" Assert.AreEqual(1, ps) // BuildPropertyDescriptor - let ls = publicTypesInAsm @"fsharp.languageservice.dll" + let ls = publicTypesInAsm @"FSharp.LanguageService.dll" Assert.AreEqual(0, ls) - let comp = publicTypesInAsm @"fsharp.compiler.dll" + let comp = publicTypesInAsm @"FSharp.Compiler.dll" Assert.AreEqual(0, comp) let compis = publicTypesInAsm @"FSharp.Compiler.Interactive.Settings.dll" Assert.AreEqual(4, compis) From 151cbde0d9d0058cf5b717cb2024c9636e64a14e Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 21 Nov 2016 17:53:18 +0000 Subject: [PATCH 03/13] add more .NET Core DLLs to system DLL list --- src/fsharp/CompileOps.fs | 58 +++++++++++++++++++++++++++++++++++++-- src/fsharp/TcGlobals.fs | 1 + src/fsharp/fsc.fs | 25 +++++++++++------ src/fsharp/tast.fs | 5 +++- src/scripts/scriptlib.fsx | 29 ++++++++++++++++++++ tests/fsharp/tests.fs | 6 ++-- tests/scripts/fsci.fsx | 36 +++--------------------- 7 files changed, 114 insertions(+), 46 deletions(-) diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index 8d9bdbb6c8b..61c3a60a9e9 100644 --- a/src/fsharp/CompileOps.fs +++ b/src/fsharp/CompileOps.fs @@ -1659,7 +1659,9 @@ let DefaultReferencesForScriptsAndOutOfProjectSources(assumeDotNetFramework) = yield "System.Numerics" ] -// A set of assemblies to always consider to be system assemblies +// A set of assemblies to always consider to be system assemblies. A common set of these can be used a shared +// resources between projects in the compiler services. Also all assembles where well-known system types exist +// referenced from TcGlobals must be listed here. let SystemAssemblies () = HashSet [ yield "mscorlib" @@ -1715,6 +1717,54 @@ let SystemAssemblies () = yield "System.Threading.Thread" yield "System.Threading.ThreadPool" yield "System.Threading.Timer" + + yield "FSharp.Compiler.Interactive.Settings" + yield "Microsoft.DiaSymReader" + yield "Microsoft.DiaSymReader.PortablePdb" + yield "Microsoft.Win32.Registry" + yield "System.Diagnostics.Tracing" + yield "System.Globalization.Calendars" + yield "System.Reflection.Primitives" + yield "System.Runtime.Handles" + yield "Microsoft.Win32.Primitives" + yield "System.IO.FileSystem" + yield "System.Net.Primitives" + yield "System.Net.Sockets" + yield "System.Private.Uri" + yield "System.AppContext" + yield "System.Buffers" + yield "System.Collections.Immutable" + yield "System.Diagnostics.DiagnosticSource" + yield "System.Diagnostics.Process" + yield "System.Diagnostics.TraceSource" + yield "System.Globalization.Extensions" + yield "System.IO.Compression" + yield "System.IO.Compression.ZipFile" + yield "System.IO.FileSystem.Primitives" + yield "System.Net.Http" + yield "System.Net.NameResolution" + yield "System.Net.WebHeaderCollection" + yield "System.ObjectModel" + yield "System.Reflection.Emit.Lightweight" + yield "System.Reflection.Metadata" + yield "System.Reflection.TypeExtensions" + yield "System.Runtime.InteropServices.RuntimeInformation" + yield "System.Runtime.Loader" + yield "System.Security.Claims" + yield "System.Security.Cryptography.Algorithms" + yield "System.Security.Cryptography.Cng" + yield "System.Security.Cryptography.Csp" + yield "System.Security.Cryptography.Encoding" + yield "System.Security.Cryptography.OpenSsl" + yield "System.Security.Cryptography.Primitives" + yield "System.Security.Cryptography.X509Certificates" + yield "System.Security.Principal" + yield "System.Security.Principal.Windows" + yield "System.Threading.Overlapped" + yield "System.Threading.Tasks.Extensions" + yield "System.Xml.ReaderWriter" + yield "System.Xml.XDocument" + ] // The set of references entered into the TcConfigBuilder for scripts prior to computing @@ -4347,11 +4397,15 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti // Load the rest of the framework DLLs all at once (they may be mutually recursive) frameworkTcImports.DoRegisterAndImportReferencedAssemblies (tcResolutions.GetAssemblyResolutions()) + // These are the DLLs we can search for well-known types let sysCcus = [| for ccu in frameworkTcImports.GetCcusInDeclOrder() do - printfn "found sys ccu %s" ccu.AssemblyName + //printfn "found sys ccu %s" ccu.AssemblyName yield ccu |] + //for ccu in nonFrameworkDLLs do + // printfn "found non-sys ccu %s" ccu.resolvedPath + let tryFindSysTypeCcu path typeName = sysCcus |> Array.tryFind (fun ccu -> ccuHasType ccu path typeName) diff --git a/src/fsharp/TcGlobals.fs b/src/fsharp/TcGlobals.fs index f60cf5047c1..06acfa67132 100755 --- a/src/fsharp/TcGlobals.fs +++ b/src/fsharp/TcGlobals.fs @@ -1223,6 +1223,7 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d member __.TryMkSysILTypeRef=tryMkSysILTypeRef member __.usesMscorlib = usesMscorlib member __.MkSysAttrib=mkSysAttrib + member __.TryMkSysAttrib=tryMkSysAttrib member val ilxPubCloEnv=EraseClosures.newIlxPubCloEnv(ilg, addMethodGeneratedAttrs, addFieldGeneratedAttrs, addFieldNeverAttrs) member __.AddMethodGeneratedAttributes mdef = addMethodGeneratedAttrs mdef diff --git a/src/fsharp/fsc.fs b/src/fsharp/fsc.fs index 2a1f3bc72fb..e5f614f610d 100644 --- a/src/fsharp/fsc.fs +++ b/src/fsharp/fsc.fs @@ -731,18 +731,27 @@ module ManifestResourceFormat = module AttributeHelpers = /// Try to find an attribute that takes a string argument - let TryFindStringAttribute tcGlobals attrib attribs = - match TryFindFSharpAttribute tcGlobals (tcGlobals.MkSysAttrib attrib) attribs with + let TryFindStringAttribute (g: TcGlobals) attrib attribs = + match g.TryMkSysAttrib attrib with + | None -> None + | Some attribRef -> + match TryFindFSharpAttribute g attribRef attribs with | Some (Attrib(_, _, [ AttribStringArg(s) ], _, _, _, _)) -> Some (s) | _ -> None - let TryFindIntAttribute tcGlobals attrib attribs = - match TryFindFSharpAttribute tcGlobals (tcGlobals.MkSysAttrib attrib) attribs with + let TryFindIntAttribute (g: TcGlobals) attrib attribs = + match g.TryMkSysAttrib attrib with + | None -> None + | Some attribRef -> + match TryFindFSharpAttribute g attribRef attribs with | Some (Attrib(_, _, [ AttribInt32Arg(i) ], _, _, _, _)) -> Some (i) | _ -> None - let TryFindBoolAttribute tcGlobals attrib attribs = - match TryFindFSharpAttribute tcGlobals (tcGlobals.MkSysAttrib attrib) attribs with + let TryFindBoolAttribute (g: TcGlobals) attrib attribs = + match g.TryMkSysAttrib attrib with + | None -> None + | Some attribRef -> + match TryFindFSharpAttribute g attribRef attribs with | Some (Attrib(_, _, [ AttribBoolArg(p) ], _, _, _, _)) -> Some (p) | _ -> None @@ -752,8 +761,8 @@ module AttributeHelpers = None // Try to find an AssemblyVersion attribute - let TryFindVersionAttribute tcGlobals attrib attribName attribs = - match TryFindStringAttribute tcGlobals attrib attribs with + let TryFindVersionAttribute g attrib attribName attribs = + match TryFindStringAttribute g attrib attribs with | Some versionString -> try Some (IL.parseILVersion versionString) with e -> diff --git a/src/fsharp/tast.fs b/src/fsharp/tast.fs index c8aadec8f76..f21a0b583cd 100755 --- a/src/fsharp/tast.fs +++ b/src/fsharp/tast.fs @@ -4455,7 +4455,10 @@ let primEntityRefEq compilingFslib fslibCcu (x : EntityRef) (y : EntityRef) = nonLocalRefEq x.nlr y.nlr || // The tcrefs may have forwarders. If they may possibly be equal then resolve them to get their canonical references // and compare those using pointer equality. - (not (nonLocalRefDefinitelyNotEq x.nlr y.nlr) && x.Deref === y.Deref)) then + (not (nonLocalRefDefinitelyNotEq x.nlr y.nlr) && + let v1 = x.TryDeref + let v2 = y.TryDeref + v1.IsSome && v2.IsSome && v1.Value === v2.Value)) then true else compilingFslib && fslibEntityRefEq fslibCcu x y diff --git a/src/scripts/scriptlib.fsx b/src/scripts/scriptlib.fsx index ebb6856d810..db1c32c3edf 100644 --- a/src/scripts/scriptlib.fsx +++ b/src/scripts/scriptlib.fsx @@ -171,3 +171,32 @@ module Scripting = | _, true -> "win7-x64" | _, false -> "win7-x86" + + let executeProcessNoRedirect filename arguments = + let info = ProcessStartInfo(Arguments=arguments, UseShellExecute=false, + RedirectStandardOutput=true, RedirectStandardError=true,RedirectStandardInput=true, + CreateNoWindow=true, FileName=filename) + let p = new Process(StartInfo=info) + if p.Start() then + + async { try + let buffer = Array.zeroCreate 4096 + while not p.StandardOutput.EndOfStream do + let n = p.StandardOutput.Read(buffer, 0, buffer.Length) + if n > 0 then System.Console.Out.Write(buffer, 0, n) + with _ -> () } |> Async.Start + async { try + let buffer = Array.zeroCreate 4096 + while not p.StandardError.EndOfStream do + let n = p.StandardError.Read(buffer, 0, buffer.Length) + if n > 0 then System.Console.Error.Write(buffer, 0, n) + with _ -> () } |> Async.Start + async { try + while true do + let c = System.Console.In.ReadLine() + p.StandardInput.WriteLine(c) + with _ -> () } |> Async.Start + p.WaitForExit() + p.ExitCode + else + 0 diff --git a/tests/fsharp/tests.fs b/tests/fsharp/tests.fs index f1e0f6f61b0..5ae99341012 100644 --- a/tests/fsharp/tests.fs +++ b/tests/fsharp/tests.fs @@ -20,12 +20,12 @@ module CoreTests = #if FSHARP_SUITE_DRIVES_CORECLR_TESTS -// These tests drive the .NET Core compiler directly (from a .NET Framework NUnit component) + // These tests drive the .NET Core compiler directly (from a .NET Framework NUnit component) [] let ``access-FSC_CORECLR``() = singleTestBuildAndRun "core/access" FSC_CORECLR - //[] - //let ``access-FSI_CORECLR``() = singleTestBuildAndRun "core/access" FSI_CORECLR + [] + let ``access-FSI_CORECLR``() = singleTestBuildAndRun "core/access" FSI_CORECLR #else [] diff --git a/tests/scripts/fsci.fsx b/tests/scripts/fsci.fsx index 6b47b142048..0a6fcdf6d0e 100644 --- a/tests/scripts/fsci.fsx +++ b/tests/scripts/fsci.fsx @@ -22,38 +22,8 @@ let isVerbose = Verbosity = "verbose" let dependencies = CrackProjectJson.collectReferences (isVerbose, PackagesDir, FrameworkName + "/" + Platform, ProjectJsonLock, true, false) |> Seq.toArray -let executeProcessNoRedirect filename arguments = - if isVerbose then - printfn "%s %s" filename arguments - let info = ProcessStartInfo(Arguments=arguments, UseShellExecute=false, - RedirectStandardOutput=true, RedirectStandardError=true,RedirectStandardInput=true, - CreateNoWindow=true, FileName=filename) - let p = new Process(StartInfo=info) - if p.Start() then - async { try - let buffer = Array.zeroCreate 4096 - while not p.StandardOutput.EndOfStream do - let n = p.StandardOutput.Read(buffer, 0, buffer.Length) - if n > 0 then System.Console.Out.Write(buffer, 0, n) - with _ -> () } |> Async.Start - async { try - let buffer = Array.zeroCreate 4096 - while not p.StandardError.EndOfStream do - let n = p.StandardError.Read(buffer, 0, buffer.Length) - if n > 0 then System.Console.Error.Write(buffer, 0, n) - with _ -> () } |> Async.Start - async { try - while true do - let c = System.Console.In.ReadLine() - p.StandardInput.WriteLine(c) - with _ -> () } |> Async.Start - p.WaitForExit() - p.ExitCode - else - 0 - -let executeCompiler references = +let executeFsi references = let addReferenceSwitch list = list |> Seq.map(fun i -> sprintf "-r:%s" i) let arguments = [ yield "--noframework" @@ -69,7 +39,9 @@ let executeCompiler references = File.WriteAllLines("fsi.cmd.args", arguments) log "%s %s" coreRunExe arguments2 log "%s %s @fsi.cmd.args" coreRunExe fsiExe + executeProcessNoRedirect coreRunExe arguments2 -exit (executeCompiler dependencies) +let _exitCode = executeFsi dependencies // ignore exit code for now since FailFast gives negative error code +exit 0 From 867e7f3af2b8d244bb18fdb54a81571c85c11bfd Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 21 Nov 2016 17:59:45 +0000 Subject: [PATCH 04/13] enable more coreclr FSI testing --- tests/fsharp/tests.fs | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/tests/fsharp/tests.fs b/tests/fsharp/tests.fs index 5ae99341012..5554e92077d 100644 --- a/tests/fsharp/tests.fs +++ b/tests/fsharp/tests.fs @@ -26,6 +26,20 @@ module CoreTests = [] let ``access-FSI_CORECLR``() = singleTestBuildAndRun "core/access" FSI_CORECLR + + [] + let ``apporder-FSC_CORECLR`` () = singleTestBuildAndRun "core/apporder" FSC_CORECLR + + [] + let ``apporder-FSI_CORECLR`` () = singleTestBuildAndRun "core/apporder" FSI_CORECLR + + [] + let ``array-FSC_CORECLR`` () = singleTestBuildAndRun "core/array" FSC_CORECLR + + [] + let ``array-FSI_CORECLR`` () = singleTestBuildAndRun "core/array" FSI_CORECLR + + #else [] From 733b16af336a645c1df1262dbbab0762bfeb7e67 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 21 Nov 2016 23:42:32 +0000 Subject: [PATCH 05/13] fix early evaluation of thunk --- src/absil/ilreflect.fs | 8 +- src/fsharp/CompileOps.fs | 2 +- src/fsharp/IlxGen.fs | 6 +- src/fsharp/TastOps.fs | 4 +- src/fsharp/TcGlobals.fs | 180 ++++++++++++++++++++------------------ src/fsharp/TypeChecker.fs | 6 +- src/fsharp/fsc.fs | 8 +- src/fsharp/fsi/fsi.fs | 6 +- 8 files changed, 114 insertions(+), 106 deletions(-) diff --git a/src/absil/ilreflect.fs b/src/absil/ilreflect.fs index 20265995e54..494f796d0a2 100644 --- a/src/absil/ilreflect.fs +++ b/src/absil/ilreflect.fs @@ -334,7 +334,7 @@ let convAssemblyRef (aref:ILAssemblyRef) = /// The global environment. type cenv = { ilg: ILGlobals - tryMkSysILTypeRef : string -> ILTypeRef option + tryFindSysILTypeRef : string -> ILTypeRef option generatePdb: bool resolvePath: (ILAssemblyRef -> Choice option) } @@ -1669,7 +1669,7 @@ let typeAttributesOfTypeLayout cenv emEnv x = let attr x p = if p.Size =None && p.Pack = None then None else - match cenv.tryMkSysILTypeRef "System.Runtime.InteropServices.StructLayoutAttribute", cenv.tryMkSysILTypeRef "System.Runtime.InteropServices.LayoutKind" with + match cenv.tryFindSysILTypeRef "System.Runtime.InteropServices.StructLayoutAttribute", cenv.tryFindSysILTypeRef "System.Runtime.InteropServices.LayoutKind" with | Some tref1, Some tref2 -> Some(convCustomAttr cenv emEnv (IL.mkILCustomAttribute cenv.ilg @@ -2003,8 +2003,8 @@ let mkDynamicAssemblyAndModule (assemblyName, optimize, debugInfo, collectible) let modB = asmB.DefineDynamicModuleAndLog(assemblyName,filename,debugInfo) asmB,modB -let emitModuleFragment (ilg, emEnv, asmB : AssemblyBuilder, modB : ModuleBuilder, modul : IL.ILModuleDef, debugInfo : bool, resolvePath, tryMkSysILTypeRef) = - let cenv = { ilg = ilg ; generatePdb = debugInfo; resolvePath=resolvePath; tryMkSysILTypeRef=tryMkSysILTypeRef } +let emitModuleFragment (ilg, emEnv, asmB : AssemblyBuilder, modB : ModuleBuilder, modul : IL.ILModuleDef, debugInfo : bool, resolvePath, tryFindSysILTypeRef) = + let cenv = { ilg = ilg ; generatePdb = debugInfo; resolvePath=resolvePath; tryFindSysILTypeRef=tryFindSysILTypeRef } let emEnv = buildModuleFragment cenv emEnv asmB modB modul match modul.Manifest with diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index 61c3a60a9e9..a55108a0528 100644 --- a/src/fsharp/CompileOps.fs +++ b/src/fsharp/CompileOps.fs @@ -4072,7 +4072,7 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti member tcImports.SystemRuntimeContainsType (typeName : string) : bool = let ns, typeName = IL.splitILTypeName typeName let tcGlobals = tcImports.GetTcGlobals() - tcGlobals.TryMkSysTyconRef ns typeName |> Option.isSome + tcGlobals.TryFindSysTyconRef ns typeName |> Option.isSome // Add a referenced assembly // diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index 7d6700cdc46..9cff81fcdbf 100644 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -3294,7 +3294,7 @@ and GenTraitCall cenv cgbuf eenv (traitInfo, argExprs, m) expr sequel = | None -> let replacementExpr = mkThrow m (tyOfExpr cenv.g expr) - (mkExnExpr(cenv.g.MkSysTyconRef ["System"] "NotSupportedException", + (mkExnExpr(cenv.g.FindSysTyconRef ["System"] "NotSupportedException", [ mkString cenv.g m (FSComp.SR.ilDynamicInvocationNotSupported(traitInfo.MemberName))],m)) GenExpr cenv cgbuf eenv SPSuppress replacementExpr sequel | Some expr -> @@ -5132,7 +5132,7 @@ and GenMethodForBinding let bodyExpr = if HasFSharpAttribute cenv.g cenv.g.attrib_NoDynamicInvocationAttribute v.Attribs then mkThrow m returnTy - (mkExnExpr(cenv.g.MkSysTyconRef ["System"] "NotSupportedException", + (mkExnExpr(cenv.g.FindSysTyconRef ["System"] "NotSupportedException", [ mkString cenv.g m (FSComp.SR.ilDynamicInvocationNotSupported(v.CompiledName))],m)) else body @@ -6177,7 +6177,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) = | Some memberInfo -> match name, memberInfo.MemberFlags.MemberKind with | ("Item" | "op_IndexedLookup"), (MemberKind.PropertyGet | MemberKind.PropertySet) when not (isNil (ArgInfosOfPropertyVal cenv.g vref.Deref)) -> - Some( mkILCustomAttribute cenv.g.ilg (cenv.g.MkSysILTypeRef "System.Reflection.DefaultMemberAttribute",[cenv.g.ilg.typ_String],[ILAttribElem.String(Some(name))],[]) ) + Some( mkILCustomAttribute cenv.g.ilg (cenv.g.FindSysILTypeRef "System.Reflection.DefaultMemberAttribute",[cenv.g.ilg.typ_String],[ILAttribElem.String(Some(name))],[]) ) | _ -> None) |> Option.toList diff --git a/src/fsharp/TastOps.fs b/src/fsharp/TastOps.fs index 80d298e1d4a..c4fb8f6476c 100644 --- a/src/fsharp/TastOps.fs +++ b/src/fsharp/TastOps.fs @@ -5989,10 +5989,10 @@ let mspec_String_Length (g: TcGlobals) = mkILNonGenericInstanceMethSpecInTy (g.i let fspec_Missing_Value (g: TcGlobals) = IL.mkILFieldSpecInTy(g.iltyp_Missing, "Value", g.iltyp_Missing) let mkInitializeArrayMethSpec (g: TcGlobals) = - mkILNonGenericStaticMethSpecInTy(mkILNonGenericBoxedTy(g.MkSysILTypeRef "System.Runtime.CompilerServices.RuntimeHelpers"),"InitializeArray", [g.ilg.typ_Array;g.iltyp_RuntimeFieldHandle], ILType.Void) + mkILNonGenericStaticMethSpecInTy(mkILNonGenericBoxedTy(g.FindSysILTypeRef "System.Runtime.CompilerServices.RuntimeHelpers"),"InitializeArray", [g.ilg.typ_Array;g.iltyp_RuntimeFieldHandle], ILType.Void) let mkInvalidCastExnNewobj (g: TcGlobals) = - mkNormalNewobj (mkILCtorMethSpecForTy (mkILNonGenericBoxedTy (g.MkSysILTypeRef "System.InvalidCastException"), [])) + mkNormalNewobj (mkILCtorMethSpecForTy (mkILNonGenericBoxedTy (g.FindSysILTypeRef "System.InvalidCastException"), [])) let typedExprForIntrinsic _g m (IntrinsicValRef(_,_,_,ty,_) as i) = diff --git a/src/fsharp/TcGlobals.fs b/src/fsharp/TcGlobals.fs index 06acfa67132..31e6d1d9a93 100755 --- a/src/fsharp/TcGlobals.fs +++ b/src/fsharp/TcGlobals.fs @@ -159,6 +159,7 @@ let tname_IAsyncResult = "System.IAsyncResult" type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, directoryToResolveRelativePaths, mlCompatibility: bool, isInteractive:bool, + // The helper to find system types amongst referenced DLLs tryFindSysTypeCcu, emitDebugInfoInQuotations: bool, usesMscorlib: bool, noDebugData: bool) = @@ -207,11 +208,14 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d let v_ilsigptr_tcr = mk_MFCore_tcref fslibCcu "ilsigptr`1" let v_fastFunc_tcr = mk_MFCore_tcref fslibCcu "FSharpFunc`2" + let dummyAssemblyNameCarryingUsefulErrorInformation path typeName = + FSComp.SR.tcGlobalsSystemTypeNotFound (String.concat "." path + "." + typeName) + // Search for a type. If it is not found, leave a dangling CCU reference with some useful diagnostic information should // the type actually be dereferenced let findSysTypeCcu path typeName = match tryFindSysTypeCcu path typeName with - | None -> CcuThunk.CreateDelayed(FSComp.SR.tcGlobalsSystemTypeNotFound (String.concat "." path + "." + typeName)) + | None -> CcuThunk.CreateDelayed(dummyAssemblyNameCarryingUsefulErrorInformation path typeName) | Some ccu -> ccu let tryFindSysTyconRef path nm = @@ -223,6 +227,29 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d let ccu = findSysTypeCcu path nm mkNonLocalTyconRef2 ccu (Array.ofList path) nm + let findSysILTypeRef (nm:string) = + let path, typeName = splitILTypeName nm + let scoref = + match tryFindSysTypeCcu path typeName with + | None -> ILScopeRef.Assemby (mkSimpleAssRef (dummyAssemblyNameCarryingUsefulErrorInformation path typeName)) + | Some ccu -> ccu.ILScopeRef + mkILTyRef (scoref, nm) + + let tryFindSysILTypeRef (nm:string) = + let path, typeName = splitILTypeName nm + tryFindSysTypeCcu path typeName |> Option.map (fun ccu -> mkILTyRef (ccu.ILScopeRef, nm)) + + let findSysAttrib (nm:string) = + let tref = findSysILTypeRef nm + let path, typeName = splitILTypeName nm + AttribInfo(tref, findSysTyconRef path typeName) + + let tryFindSysAttrib nm = + let path, typeName = splitILTypeName nm + match tryFindSysTypeCcu path typeName with + | Some _ -> Some (findSysAttrib nm) + | None -> None + let mkSysNonGenericTy path n = mkNonGenericTy(findSysTyconRef path n) let tryMkSysNonGenericTy path n = tryFindSysTyconRef path n |> Option.map mkNonGenericTy @@ -450,25 +477,6 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d let mk_MFCore_attrib nm : BuiltinAttribInfo = AttribInfo(mkILTyRef(IlxSettings.ilxFsharpCoreLibScopeRef (), FSharpLib.Core + "." + nm), mk_MFCore_tcref fslibCcu nm) - let mkSysILTypeRef (nm:string) = - let path, typeName = splitILTypeName nm - findSysTypeCcu path typeName |> (fun ccu -> mkILTyRef (ccu.ILScopeRef, nm)) - - let tryMkSysILTypeRef (nm:string) = - let path, typeName = splitILTypeName nm - tryFindSysTypeCcu path typeName |> Option.map (fun ccu -> mkILTyRef (ccu.ILScopeRef, nm)) - - let mkSysAttrib (nm:string) = - let tref = mkSysILTypeRef nm - let path, typeName = splitILTypeName nm - AttribInfo(tref, findSysTyconRef path typeName) - - let tryMkSysAttrib nm = - let path, typeName = splitILTypeName nm - match tryFindSysTypeCcu path typeName with - | Some _ -> Some (mkSysAttrib nm) - | None -> None - let mk_doc filename = ILSourceDocument.Create(language=None, vendor=None, documentType=None, file=filename) // Build the memoization table for files let v_memoize_file = new MemoizationTable ((fileOfFileIndex >> Filename.fullpath directoryToResolveRelativePaths >> mk_doc), keyComparer=HashIdentity.Structural) @@ -620,12 +628,12 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d let v_check_this_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "CheckThis" , None , None , [vara], ([[varaTy]], varaTy)) let v_quote_to_linq_lambda_info = makeIntrinsicValRef(fslib_MFLinqRuntimeHelpersQuotationConverter_nleref, "QuotationToLambdaExpression" , None , None , [vara], ([[mkQuotedExprTy varaTy]], mkLinqExpressionTy varaTy)) - let tref_DebuggableAttribute = mkSysILTypeRef tname_DebuggableAttribute - let tref_CompilerGeneratedAttribute = mkSysILTypeRef tname_CompilerGeneratedAttribute + let tref_DebuggableAttribute = findSysILTypeRef tname_DebuggableAttribute + let tref_CompilerGeneratedAttribute = findSysILTypeRef tname_CompilerGeneratedAttribute let mutable generatedAttribsCache = [] let mutable debuggerBrowsableNeverAttributeCache = None - let mkDebuggerNonUserCodeAttribute() = mkILCustomAttribute ilg (mkSysILTypeRef tname_DebuggerNonUserCodeAttribute, [], [], []) + let mkDebuggerNonUserCodeAttribute() = mkILCustomAttribute ilg (findSysILTypeRef tname_DebuggerNonUserCodeAttribute, [], [], []) let mkCompilerGeneratedAttribute () = mkILCustomAttribute ilg (tref_CompilerGeneratedAttribute, [], [], []) // Requests attributes to be added to compiler generated methods. @@ -647,9 +655,9 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d let tref_DebuggerBrowsableAttribute n = let typ_DebuggerBrowsableState = - let tref = mkSysILTypeRef tname_DebuggerBrowsableState + let tref = findSysILTypeRef tname_DebuggerBrowsableState ILType.Value (mkILNonGenericTySpec tref) - mkILCustomAttribute ilg (mkSysILTypeRef tname_DebuggerBrowsableAttribute, [typ_DebuggerBrowsableState], [ILAttribElem.Int32 n], []) + mkILCustomAttribute ilg (findSysILTypeRef tname_DebuggerBrowsableAttribute, [typ_DebuggerBrowsableState], [ILAttribElem.Int32 n], []) let mkDebuggerBrowsableNeverAttribute() = match debuggerBrowsableNeverAttributeCache with @@ -662,7 +670,7 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d 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 mkDebuggerTypeProxyAttribute (ty : ILType) = mkILCustomAttribute ilg (mkSysILTypeRef tname_DebuggerTypeProxyAttribute, [ilg.typ_Type], [ILAttribElem.TypeRef (Some ty.TypeRef)], []) + let mkDebuggerTypeProxyAttribute (ty : ILType) = mkILCustomAttribute ilg (findSysILTypeRef tname_DebuggerTypeProxyAttribute, [ilg.typ_Type], [ILAttribElem.TypeRef (Some ty.TypeRef)], []) // Build a map that uses the "canonical" F# type names and TyconRef's for these // in preference to the .NET type names. Doing this normalization is a fairly performance critical @@ -942,55 +950,55 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d member __.tcref_System_Attribute = v_System_Attribute_tcr - member val iltyp_TypedReference = tryMkSysILTypeRef "System.TypedReference" |> Option.map mkILNonGenericValueTy - member val iltyp_StreamingContext = tryMkSysILTypeRef tname_StreamingContext |> Option.map mkILNonGenericValueTy - member val iltyp_SerializationInfo = tryMkSysILTypeRef tname_SerializationInfo |> Option.map mkILNonGenericBoxedTy - member val iltyp_Missing = mkSysILTypeRef tname_Missing |> mkILNonGenericBoxedTy - member val iltyp_AsyncCallback = mkSysILTypeRef tname_AsyncCallback |> mkILNonGenericBoxedTy - member val iltyp_IAsyncResult = mkSysILTypeRef tname_IAsyncResult |> mkILNonGenericBoxedTy - member val iltyp_IComparable = mkSysILTypeRef tname_IComparable |> mkILNonGenericBoxedTy - member val iltyp_Exception = mkSysILTypeRef tname_Exception |> mkILNonGenericBoxedTy - member val iltyp_ValueType = mkSysILTypeRef tname_ValueType |> mkILNonGenericBoxedTy - member val iltyp_RuntimeFieldHandle = mkSysILTypeRef tname_RuntimeFieldHandle |> mkILNonGenericValueTy - member val iltyp_RuntimeMethodHandle = mkSysILTypeRef tname_RuntimeMethodHandle |> mkILNonGenericValueTy - member val iltyp_RuntimeTypeHandle = mkSysILTypeRef tname_RuntimeTypeHandle |> mkILNonGenericValueTy - - - member val attrib_AttributeUsageAttribute = mkSysAttrib "System.AttributeUsageAttribute" - member val attrib_ParamArrayAttribute = mkSysAttrib "System.ParamArrayAttribute" - member val attrib_IDispatchConstantAttribute = tryMkSysAttrib "System.Runtime.CompilerServices.IDispatchConstantAttribute" - member val attrib_IUnknownConstantAttribute = tryMkSysAttrib "System.Runtime.CompilerServices.IUnknownConstantAttribute" + member val iltyp_TypedReference = tryFindSysILTypeRef "System.TypedReference" |> Option.map mkILNonGenericValueTy + member val iltyp_StreamingContext = tryFindSysILTypeRef tname_StreamingContext |> Option.map mkILNonGenericValueTy + member val iltyp_SerializationInfo = tryFindSysILTypeRef tname_SerializationInfo |> Option.map mkILNonGenericBoxedTy + member val iltyp_Missing = findSysILTypeRef tname_Missing |> mkILNonGenericBoxedTy + member val iltyp_AsyncCallback = findSysILTypeRef tname_AsyncCallback |> mkILNonGenericBoxedTy + member val iltyp_IAsyncResult = findSysILTypeRef tname_IAsyncResult |> mkILNonGenericBoxedTy + member val iltyp_IComparable = findSysILTypeRef tname_IComparable |> mkILNonGenericBoxedTy + member val iltyp_Exception = findSysILTypeRef tname_Exception |> mkILNonGenericBoxedTy + member val iltyp_ValueType = findSysILTypeRef tname_ValueType |> mkILNonGenericBoxedTy + member val iltyp_RuntimeFieldHandle = findSysILTypeRef tname_RuntimeFieldHandle |> mkILNonGenericValueTy + member val iltyp_RuntimeMethodHandle = findSysILTypeRef tname_RuntimeMethodHandle |> mkILNonGenericValueTy + member val iltyp_RuntimeTypeHandle = findSysILTypeRef tname_RuntimeTypeHandle |> mkILNonGenericValueTy + + + member val attrib_AttributeUsageAttribute = findSysAttrib "System.AttributeUsageAttribute" + member val attrib_ParamArrayAttribute = findSysAttrib "System.ParamArrayAttribute" + member val attrib_IDispatchConstantAttribute = tryFindSysAttrib "System.Runtime.CompilerServices.IDispatchConstantAttribute" + member val attrib_IUnknownConstantAttribute = tryFindSysAttrib "System.Runtime.CompilerServices.IUnknownConstantAttribute" - member val attrib_SystemObsolete = mkSysAttrib "System.ObsoleteAttribute" - member val attrib_DllImportAttribute = tryMkSysAttrib "System.Runtime.InteropServices.DllImportAttribute" - member val attrib_StructLayoutAttribute = mkSysAttrib "System.Runtime.InteropServices.StructLayoutAttribute" - member val attrib_TypeForwardedToAttribute = mkSysAttrib "System.Runtime.CompilerServices.TypeForwardedToAttribute" - member val attrib_ComVisibleAttribute = mkSysAttrib "System.Runtime.InteropServices.ComVisibleAttribute" - member val attrib_ComImportAttribute = tryMkSysAttrib "System.Runtime.InteropServices.ComImportAttribute" - member val attrib_FieldOffsetAttribute = mkSysAttrib "System.Runtime.InteropServices.FieldOffsetAttribute" - member val attrib_MarshalAsAttribute = tryMkSysAttrib "System.Runtime.InteropServices.MarshalAsAttribute" - member val attrib_InAttribute = tryMkSysAttrib "System.Runtime.InteropServices.InAttribute" - member val attrib_OutAttribute = mkSysAttrib "System.Runtime.InteropServices.OutAttribute" - member val attrib_OptionalAttribute = tryMkSysAttrib "System.Runtime.InteropServices.OptionalAttribute" - member val attrib_ThreadStaticAttribute = tryMkSysAttrib "System.ThreadStaticAttribute" - member val attrib_SpecialNameAttribute = tryMkSysAttrib "System.Runtime.CompilerServices.SpecialNameAttribute" + member val attrib_SystemObsolete = findSysAttrib "System.ObsoleteAttribute" + member val attrib_DllImportAttribute = tryFindSysAttrib "System.Runtime.InteropServices.DllImportAttribute" + member val attrib_StructLayoutAttribute = findSysAttrib "System.Runtime.InteropServices.StructLayoutAttribute" + member val attrib_TypeForwardedToAttribute = findSysAttrib "System.Runtime.CompilerServices.TypeForwardedToAttribute" + member val attrib_ComVisibleAttribute = findSysAttrib "System.Runtime.InteropServices.ComVisibleAttribute" + member val attrib_ComImportAttribute = tryFindSysAttrib "System.Runtime.InteropServices.ComImportAttribute" + member val attrib_FieldOffsetAttribute = findSysAttrib "System.Runtime.InteropServices.FieldOffsetAttribute" + member val attrib_MarshalAsAttribute = tryFindSysAttrib "System.Runtime.InteropServices.MarshalAsAttribute" + member val attrib_InAttribute = tryFindSysAttrib "System.Runtime.InteropServices.InAttribute" + member val attrib_OutAttribute = findSysAttrib "System.Runtime.InteropServices.OutAttribute" + member val attrib_OptionalAttribute = tryFindSysAttrib "System.Runtime.InteropServices.OptionalAttribute" + member val attrib_ThreadStaticAttribute = tryFindSysAttrib "System.ThreadStaticAttribute" + member val attrib_SpecialNameAttribute = tryFindSysAttrib "System.Runtime.CompilerServices.SpecialNameAttribute" member val attrib_VolatileFieldAttribute = mk_MFCore_attrib "VolatileFieldAttribute" - member val attrib_ContextStaticAttribute = tryMkSysAttrib "System.ContextStaticAttribute" - member val attrib_FlagsAttribute = mkSysAttrib "System.FlagsAttribute" - member val attrib_DefaultMemberAttribute = mkSysAttrib "System.Reflection.DefaultMemberAttribute" - member val attrib_DebuggerDisplayAttribute = mkSysAttrib "System.Diagnostics.DebuggerDisplayAttribute" - member val attrib_DebuggerTypeProxyAttribute = mkSysAttrib "System.Diagnostics.DebuggerTypeProxyAttribute" - member val attrib_PreserveSigAttribute = tryMkSysAttrib "System.Runtime.InteropServices.PreserveSigAttribute" - member val attrib_MethodImplAttribute = mkSysAttrib "System.Runtime.CompilerServices.MethodImplAttribute" - member val attrib_ExtensionAttribute = mkSysAttrib "System.Runtime.CompilerServices.ExtensionAttribute" - member val attrib_CallerLineNumberAttribute = mkSysAttrib "System.Runtime.CompilerServices.CallerLineNumberAttribute" - member val attrib_CallerFilePathAttribute = mkSysAttrib "System.Runtime.CompilerServices.CallerFilePathAttribute" - member val attrib_CallerMemberNameAttribute = mkSysAttrib "System.Runtime.CompilerServices.CallerMemberNameAttribute" + member val attrib_ContextStaticAttribute = tryFindSysAttrib "System.ContextStaticAttribute" + member val attrib_FlagsAttribute = findSysAttrib "System.FlagsAttribute" + member val attrib_DefaultMemberAttribute = findSysAttrib "System.Reflection.DefaultMemberAttribute" + member val attrib_DebuggerDisplayAttribute = findSysAttrib "System.Diagnostics.DebuggerDisplayAttribute" + member val attrib_DebuggerTypeProxyAttribute = findSysAttrib "System.Diagnostics.DebuggerTypeProxyAttribute" + member val attrib_PreserveSigAttribute = tryFindSysAttrib "System.Runtime.InteropServices.PreserveSigAttribute" + member val attrib_MethodImplAttribute = findSysAttrib "System.Runtime.CompilerServices.MethodImplAttribute" + member val attrib_ExtensionAttribute = findSysAttrib "System.Runtime.CompilerServices.ExtensionAttribute" + member val attrib_CallerLineNumberAttribute = findSysAttrib "System.Runtime.CompilerServices.CallerLineNumberAttribute" + member val attrib_CallerFilePathAttribute = findSysAttrib "System.Runtime.CompilerServices.CallerFilePathAttribute" + member val attrib_CallerMemberNameAttribute = findSysAttrib "System.Runtime.CompilerServices.CallerMemberNameAttribute" member val attrib_ProjectionParameterAttribute = mk_MFCore_attrib "ProjectionParameterAttribute" member val attrib_CustomOperationAttribute = mk_MFCore_attrib "CustomOperationAttribute" - member val attrib_NonSerializedAttribute = tryMkSysAttrib "System.NonSerializedAttribute" - member val attrib_SerializableAttribute = tryMkSysAttrib "System.SerializableAttribute" + member val attrib_NonSerializedAttribute = tryFindSysAttrib "System.NonSerializedAttribute" + member val attrib_SerializableAttribute = tryFindSysAttrib "System.SerializableAttribute" member val attrib_AutoSerializableAttribute = mk_MFCore_attrib "AutoSerializableAttribute" member val attrib_RequireQualifiedAccessAttribute = mk_MFCore_attrib "RequireQualifiedAccessAttribute" @@ -1000,7 +1008,7 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d member val attrib_ExperimentalAttribute = mk_MFCore_attrib "ExperimentalAttribute" member val attrib_UnverifiableAttribute = mk_MFCore_attrib "UnverifiableAttribute" member val attrib_LiteralAttribute = mk_MFCore_attrib "LiteralAttribute" - member val attrib_ConditionalAttribute = mkSysAttrib "System.Diagnostics.ConditionalAttribute" + member val attrib_ConditionalAttribute = findSysAttrib "System.Diagnostics.ConditionalAttribute" member val attrib_OptionalArgumentAttribute = mk_MFCore_attrib "OptionalArgumentAttribute" member val attrib_RequiresExplicitTypeArgumentsAttribute = mk_MFCore_attrib "RequiresExplicitTypeArgumentsAttribute" member val attrib_DefaultValueAttribute = mk_MFCore_attrib "DefaultValueAttribute" @@ -1010,7 +1018,7 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d member val attrib_ReflectedDefinitionAttribute = mk_MFCore_attrib "ReflectedDefinitionAttribute" member val attrib_CompiledNameAttribute = mk_MFCore_attrib "CompiledNameAttribute" member val attrib_AutoOpenAttribute = mk_MFCore_attrib "AutoOpenAttribute" - member val attrib_InternalsVisibleToAttribute = mkSysAttrib "System.Runtime.CompilerServices.InternalsVisibleToAttribute" + member val attrib_InternalsVisibleToAttribute = findSysAttrib "System.Runtime.CompilerServices.InternalsVisibleToAttribute" member val attrib_CompilationRepresentationAttribute = mk_MFCore_attrib "CompilationRepresentationAttribute" member val attrib_CompilationArgumentCountsAttribute = mk_MFCore_attrib "CompilationArgumentCountsAttribute" member val attrib_CompilationMappingAttribute = mk_MFCore_attrib "CompilationMappingAttribute" @@ -1032,9 +1040,9 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d member val attrib_MeasureAttribute = mk_MFCore_attrib "MeasureAttribute" member val attrib_MeasureableAttribute = mk_MFCore_attrib "MeasureAnnotatedAbbreviationAttribute" member val attrib_NoDynamicInvocationAttribute = mk_MFCore_attrib "NoDynamicInvocationAttribute" - member val attrib_SecurityAttribute = tryMkSysAttrib "System.Security.Permissions.SecurityAttribute" - member val attrib_SecurityCriticalAttribute = mkSysAttrib "System.Security.SecurityCriticalAttribute" - member val attrib_SecuritySafeCriticalAttribute = mkSysAttrib "System.Security.SecuritySafeCriticalAttribute" + member val attrib_SecurityAttribute = tryFindSysAttrib "System.Security.Permissions.SecurityAttribute" + member val attrib_SecurityCriticalAttribute = findSysAttrib "System.Security.SecurityCriticalAttribute" + member val attrib_SecuritySafeCriticalAttribute = findSysAttrib "System.Security.SecuritySafeCriticalAttribute" member __.better_tcref_map = betterTyconRefMap member __.new_decimal_info = v_new_decimal_info @@ -1217,23 +1225,23 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d member __.suppressed_types = v_suppressed_types // Are we assuming all code gen is for F# interactive, with no static linking member __.isInteractive=isInteractive - member __.MkSysTyconRef=findSysTyconRef - member __.TryMkSysTyconRef=tryFindSysTyconRef - member __.MkSysILTypeRef=mkSysILTypeRef - member __.TryMkSysILTypeRef=tryMkSysILTypeRef + member __.FindSysTyconRef=findSysTyconRef + member __.TryFindSysTyconRef=tryFindSysTyconRef + member __.FindSysILTypeRef=findSysILTypeRef + member __.TryFindSysILTypeRef=tryFindSysILTypeRef member __.usesMscorlib = usesMscorlib - member __.MkSysAttrib=mkSysAttrib - member __.TryMkSysAttrib=tryMkSysAttrib + member __.FindSysAttrib=findSysAttrib + member __.TryFindSysAttrib=tryFindSysAttrib member val ilxPubCloEnv=EraseClosures.newIlxPubCloEnv(ilg, addMethodGeneratedAttrs, addFieldGeneratedAttrs, addFieldNeverAttrs) member __.AddMethodGeneratedAttributes mdef = addMethodGeneratedAttrs mdef member __.AddFieldGeneratedAttrs mdef = addFieldGeneratedAttrs mdef member __.AddFieldNeverAttrs mdef = addFieldNeverAttrs mdef - member __.mkDebuggerHiddenAttribute() = mkILCustomAttribute ilg (mkSysILTypeRef tname_DebuggerHiddenAttribute, [], [], []) - member __.mkDebuggerDisplayAttribute s = mkILCustomAttribute ilg (mkSysILTypeRef tname_DebuggerDisplayAttribute, [ilg.typ_String], [ILAttribElem.String (Some s)], []) + member __.mkDebuggerHiddenAttribute() = mkILCustomAttribute ilg (findSysILTypeRef tname_DebuggerHiddenAttribute, [], [], []) + member __.mkDebuggerDisplayAttribute s = mkILCustomAttribute ilg (findSysILTypeRef tname_DebuggerDisplayAttribute, [ilg.typ_String], [ILAttribElem.String (Some s)], []) member __.DebuggerBrowsableNeverAttribute = mkDebuggerBrowsableNeverAttribute() - member __.mkDebuggerStepThroughAttribute() = mkILCustomAttribute ilg (mkSysILTypeRef tname_DebuggerStepThroughAttribute, [], [], []) + member __.mkDebuggerStepThroughAttribute() = mkILCustomAttribute ilg (findSysILTypeRef tname_DebuggerStepThroughAttribute, [], [], []) member __.mkDebuggableAttribute (jitOptimizerDisabled) = mkILCustomAttribute ilg (tref_DebuggableAttribute, [ilg.typ_Bool; ilg.typ_Bool], [ILAttribElem.Bool false; ILAttribElem.Bool jitOptimizerDisabled], []) @@ -1256,8 +1264,8 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d (* - (cenv.ilg.mkSysILTypeRef "System.Runtime.InteropServices.StructLayoutAttribute", - [mkILNonGenericValueTy (cenv.ilg.mkSysILTypeRef "System.Runtime.InteropServices.LayoutKind") ], + (cenv.ilg.findSysILTypeRef "System.Runtime.InteropServices.StructLayoutAttribute", + [mkILNonGenericValueTy (cenv.ilg.findSysILTypeRef "System.Runtime.InteropServices.LayoutKind") ], *) diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index 8086054b12c..44769786cc0 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -9458,7 +9458,7 @@ and TcMethodApplication | Constant fieldInit -> match currCalledArgTy with | NullableTy cenv.g inst when fieldInit <> ILFieldInit.Null -> - let nullableTy = mkILNonGenericBoxedTy(cenv.g.MkSysILTypeRef "System.Nullable`1") + let nullableTy = mkILNonGenericBoxedTy(cenv.g.FindSysILTypeRef "System.Nullable`1") let ctor = mkILCtorMethSpecForTy(nullableTy, [ILType.TypeVar 0us]).MethodRef let ctorArgs = [Expr.Const(TcFieldInit mMethExpr fieldInit,mMethExpr, inst)] emptyPreBinder,Expr.Op(TOp.ILCall(false, false, true, true, NormalValUse, false, false, ctor, [inst], [], [currCalledArgTy]), [], ctorArgs, mMethExpr) @@ -9476,7 +9476,7 @@ and TcMethodApplication emptyPreBinder,Expr.Const(TcFieldInit mMethExpr fieldInit,mMethExpr,currCalledArgTy) | WrapperForIDispatch -> - match cenv.g.TryMkSysILTypeRef "System.Runtime.InteropServices.DispatchWrapper" with + match cenv.g.TryFindSysILTypeRef "System.Runtime.InteropServices.DispatchWrapper" with | None -> error(Error(FSComp.SR.fscSystemRuntimeInteropServicesIsRequired(), mMethExpr)) | Some tref -> let ty = mkILNonGenericBoxedTy tref @@ -9484,7 +9484,7 @@ and TcMethodApplication let expr = Expr.Op(TOp.ILCall(false,false,false,true,NormalValUse,false,false,mref,[],[],[cenv.g.obj_ty]),[],[mkDefault(mMethExpr,currCalledArgTy)],mMethExpr) emptyPreBinder,expr | WrapperForIUnknown -> - match cenv.g.TryMkSysILTypeRef "System.Runtime.InteropServices.UnknownWrapper" with + match cenv.g.TryFindSysILTypeRef "System.Runtime.InteropServices.UnknownWrapper" with | None -> error(Error(FSComp.SR.fscSystemRuntimeInteropServicesIsRequired(), mMethExpr)) | Some tref -> let ty = mkILNonGenericBoxedTy tref diff --git a/src/fsharp/fsc.fs b/src/fsharp/fsc.fs index e5f614f610d..f45ce5a0133 100644 --- a/src/fsharp/fsc.fs +++ b/src/fsharp/fsc.fs @@ -732,7 +732,7 @@ module AttributeHelpers = /// Try to find an attribute that takes a string argument let TryFindStringAttribute (g: TcGlobals) attrib attribs = - match g.TryMkSysAttrib attrib with + match g.TryFindSysAttrib attrib with | None -> None | Some attribRef -> match TryFindFSharpAttribute g attribRef attribs with @@ -740,7 +740,7 @@ module AttributeHelpers = | _ -> None let TryFindIntAttribute (g: TcGlobals) attrib attribs = - match g.TryMkSysAttrib attrib with + match g.TryFindSysAttrib attrib with | None -> None | Some attribRef -> match TryFindFSharpAttribute g attribRef attribs with @@ -748,7 +748,7 @@ module AttributeHelpers = | _ -> None let TryFindBoolAttribute (g: TcGlobals) attrib attribs = - match g.TryMkSysAttrib attrib with + match g.TryFindSysAttrib attrib with | None -> None | Some attribRef -> match TryFindFSharpAttribute g attribRef attribs with @@ -930,7 +930,7 @@ module MainModuleBuilder = mkILCustomAttrs [ if not tcConfig.internConstantStrings then yield mkILCustomAttribute tcGlobals.ilg - (tcGlobals.MkSysILTypeRef "System.Runtime.CompilerServices.CompilationRelaxationsAttribute", + (tcGlobals.FindSysILTypeRef "System.Runtime.CompilerServices.CompilationRelaxationsAttribute", [tcGlobals.ilg.typ_Int32], [ILAttribElem.Int32( 8)], []) yield! iattrs yield! codegenResults.ilAssemAttrs diff --git a/src/fsharp/fsi/fsi.fs b/src/fsharp/fsi/fsi.fs index 3b05fe25f3e..e6595252621 100644 --- a/src/fsharp/fsi/fsi.fs +++ b/src/fsharp/fsi/fsi.fs @@ -308,7 +308,7 @@ type internal FsiValuePrinter(fsi: FsiEvaluationSessionHostConfig, g: TcGlobals, /// Get the evaluation context used when inverting the storage mapping of the ILRuntimeWriter. member __.GetEvaluationContext emEnv = - let cenv = { ilg = g.ilg ; generatePdb = generateDebugInfo; resolvePath=resolvePath; tryMkSysILTypeRef=g.TryMkSysILTypeRef } + let cenv = { ilg = g.ilg ; generatePdb = generateDebugInfo; resolvePath=resolvePath; tryFindSysILTypeRef=g.TryFindSysILTypeRef } { LookupFieldRef = ILRuntimeWriter.LookupFieldRef emEnv >> Option.get LookupMethodRef = ILRuntimeWriter.LookupMethodRef emEnv >> Option.get LookupTypeRef = ILRuntimeWriter.LookupTypeRef cenv emEnv @@ -998,14 +998,14 @@ type internal FsiDynamicCompiler ReportTime tcConfig "Reflection.Emit"; - let emEnv,execs = ILRuntimeWriter.emitModuleFragment(ilGlobals, emEnv, assemblyBuilder, moduleBuilder, mainmod3, generateDebugInfo, resolvePath, tcGlobals.TryMkSysILTypeRef) + let emEnv,execs = ILRuntimeWriter.emitModuleFragment(ilGlobals, emEnv, assemblyBuilder, moduleBuilder, mainmod3, generateDebugInfo, resolvePath, tcGlobals.TryFindSysILTypeRef) errorLogger.AbortOnError(fsiConsoleOutput); // Explicitly register the resources with the QuotationPickler module // We would save them as resources into the dynamic assembly but there is missing // functionality System.Reflection for dynamic modules that means they can't be read back out - let cenv = { ilg = ilGlobals ; generatePdb = generateDebugInfo; resolvePath=resolvePath; tryMkSysILTypeRef=tcGlobals.TryMkSysILTypeRef } + let cenv = { ilg = ilGlobals ; generatePdb = generateDebugInfo; resolvePath=resolvePath; tryFindSysILTypeRef=tcGlobals.TryFindSysILTypeRef } for (referencedTypeDefs, bytes) in codegenResults.quotationResourceInfo do let referencedTypes = [| for tref in referencedTypeDefs do From 2de129030943186d9001f71a0b9626079d1438cb Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 21 Nov 2016 23:43:00 +0000 Subject: [PATCH 06/13] fix early evaluation of thunk --- src/fsharp/TcGlobals.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fsharp/TcGlobals.fs b/src/fsharp/TcGlobals.fs index 31e6d1d9a93..05e5872fc9e 100755 --- a/src/fsharp/TcGlobals.fs +++ b/src/fsharp/TcGlobals.fs @@ -231,7 +231,7 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d let path, typeName = splitILTypeName nm let scoref = match tryFindSysTypeCcu path typeName with - | None -> ILScopeRef.Assemby (mkSimpleAssRef (dummyAssemblyNameCarryingUsefulErrorInformation path typeName)) + | None -> ILScopeRef.Assembly (mkSimpleAssRef (dummyAssemblyNameCarryingUsefulErrorInformation path typeName)) | Some ccu -> ccu.ILScopeRef mkILTyRef (scoref, nm) From 5edbe16a43e29c9366b8703cbd0ba55b9d3cb777 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Tue, 22 Nov 2016 00:01:20 +0000 Subject: [PATCH 07/13] fix build --- src/fsharp/TcGlobals.fs | 15 ++++++++------- src/fsharp/vs/IncrementalBuild.fs | 4 ++-- 2 files changed, 10 insertions(+), 9 deletions(-) diff --git a/src/fsharp/TcGlobals.fs b/src/fsharp/TcGlobals.fs index 05e5872fc9e..5931e554bd8 100755 --- a/src/fsharp/TcGlobals.fs +++ b/src/fsharp/TcGlobals.fs @@ -1223,15 +1223,16 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d // Note that the suppression checks for the precise name of the type // so the lowercase versions are visible member __.suppressed_types = v_suppressed_types - // Are we assuming all code gen is for F# interactive, with no static linking + /// Are we assuming all code gen is for F# interactive, with no static linking member __.isInteractive=isInteractive - member __.FindSysTyconRef=findSysTyconRef - member __.TryFindSysTyconRef=tryFindSysTyconRef - member __.FindSysILTypeRef=findSysILTypeRef - member __.TryFindSysILTypeRef=tryFindSysILTypeRef member __.usesMscorlib = usesMscorlib - member __.FindSysAttrib=findSysAttrib - member __.TryFindSysAttrib=tryFindSysAttrib + + member __.FindSysTyconRef path nm = findSysTyconRef path nm + member __.TryFindSysTyconRef path nm = tryFindSysTyconRef path nm + member __.FindSysILTypeRef nm = findSysILTypeRef nm + member __.TryFindSysILTypeRef nm = tryFindSysILTypeRef nm + member __.FindSysAttrib nm = findSysAttrib nm + member __.TryFindSysAttrib nm = tryFindSysAttrib nm member val ilxPubCloEnv=EraseClosures.newIlxPubCloEnv(ilg, addMethodGeneratedAttrs, addFieldGeneratedAttrs, addFieldNeverAttrs) member __.AddMethodGeneratedAttributes mdef = addMethodGeneratedAttrs mdef diff --git a/src/fsharp/vs/IncrementalBuild.fs b/src/fsharp/vs/IncrementalBuild.fs index 505313c52a5..cd87b3bb28e 100755 --- a/src/fsharp/vs/IncrementalBuild.fs +++ b/src/fsharp/vs/IncrementalBuild.fs @@ -1519,9 +1519,9 @@ type IncrementalBuilder(frameworkTcImportsCache: FrameworkImportsCache, tcConfig with e -> errorRecoveryNoRange e None - let locale = TryFindStringAttribute tcGlobals (mkSysAttrib tcGlobals "System.Reflection.AssemblyCultureAttribute") topAttrs.assemblyAttrs + let locale = TryFindStringAttribute tcGlobals (tcGlobals.FindSysAttrib "System.Reflection.AssemblyCultureAttribute") topAttrs.assemblyAttrs let assemVerFromAttrib = - TryFindStringAttribute tcGlobals (mkSysAttrib tcGlobals "System.Reflection.AssemblyVersionAttribute") topAttrs.assemblyAttrs + TryFindStringAttribute tcGlobals (tcGlobals.FindSysAttrib "System.Reflection.AssemblyVersionAttribute") topAttrs.assemblyAttrs |> Option.bind (fun v -> try Some (parseILVersion v) with _ -> None) let ver = match assemVerFromAttrib with From aa112ddb42a1f45747bb286da9e344624584612f Mon Sep 17 00:00:00 2001 From: Don Syme Date: Tue, 22 Nov 2016 11:10:57 +0000 Subject: [PATCH 08/13] fix build --- src/fsharp/vs/ServiceDeclarations.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fsharp/vs/ServiceDeclarations.fs b/src/fsharp/vs/ServiceDeclarations.fs index f8a0d9c5139..769856e519b 100644 --- a/src/fsharp/vs/ServiceDeclarations.fs +++ b/src/fsharp/vs/ServiceDeclarations.fs @@ -571,7 +571,7 @@ module internal ItemDescriptionsImpl = items |> partialDistinctBy (ItemDisplayPartialEquality g) /// Filter types that are explicitly suppressed from the IntelliSense (such as uppercase "FSharpList", "Option", etc.) - let RemoveExplicitlySuppressed g items = + let RemoveExplicitlySuppressed (g: TcGlobals) items = items |> List.filter (fun item -> // This may explore assemblies that are not in the reference set. // In this case just assume the item is not suppressed. From ecc9b47ad30d4ab1824568aca30c1c6be2c9a530 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Tue, 22 Nov 2016 14:02:37 +0000 Subject: [PATCH 09/13] enable more testing and remove knowledge of Provate.CoreLib --- src/FSharpSource.Settings.targets | 2 +- src/absil/il.fs | 10 +- src/absil/il.fsi | 2 +- src/fsharp/CompileOps.fs | 2 +- src/fsharp/CompileOptions.fs | 2 +- src/fsharp/fsi/fsi.fs | 3 +- tests/fsharp/core/attributes/test.fsx | 6 +- tests/fsharp/core/comprehensions-hw/test.fsx | 19 +- tests/fsharp/core/libtest/test.fsx | 14 +- tests/fsharp/core/patterns/test.fsx | 4 + tests/fsharp/core/quotes/test.fsx | 7 +- tests/fsharp/core/syntax/test.fsx | 6 +- tests/fsharp/coreclr_utilities.fs | 11 +- tests/fsharp/single-test.fs | 8 +- tests/fsharp/tests.fs | 343 ++++++++++--------- tests/scripts/fsci.fsx | 5 +- 16 files changed, 241 insertions(+), 203 deletions(-) diff --git a/src/FSharpSource.Settings.targets b/src/FSharpSource.Settings.targets index 360e0164539..e2564eafb69 100644 --- a/src/FSharpSource.Settings.targets +++ b/src/FSharpSource.Settings.targets @@ -59,7 +59,7 @@ full - portable + pdbonly false prompt $(OtherFlags) --no-jit-optimize diff --git a/src/absil/il.fs b/src/absil/il.fs index 6abe7badb2e..6fad9782d66 100644 --- a/src/absil/il.fs +++ b/src/absil/il.fs @@ -52,17 +52,17 @@ let lazyMap f (x:Lazy<_>) = type PrimaryAssembly = | Mscorlib | DotNetCore - | PrivateCoreLib + //| PrivateCoreLib member this.Name = match this with | Mscorlib -> "mscorlib" | DotNetCore -> "System.Runtime" - | PrivateCoreLib -> "System.Private.CoreLib" + //| PrivateCoreLib -> "System.Private.CoreLib" static member IsSomePrimaryAssembly n = - n = PrimaryAssembly.Mscorlib.Name || - n = PrimaryAssembly.DotNetCore.Name || - n = PrimaryAssembly.PrivateCoreLib.Name + n = PrimaryAssembly.Mscorlib.Name + || n = PrimaryAssembly.DotNetCore.Name + //|| n = PrimaryAssembly.PrivateCoreLib.Name // -------------------------------------------------------------------- // Utilities: type names diff --git a/src/absil/il.fsi b/src/absil/il.fsi index 6f1d41df7c0..8f92fb318b7 100644 --- a/src/absil/il.fsi +++ b/src/absil/il.fsi @@ -11,7 +11,7 @@ open System.Collections.Generic type PrimaryAssembly = | Mscorlib | DotNetCore - | PrivateCoreLib + //| PrivateCoreLib member Name: string diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index a55108a0528..534a50163ef 100644 --- a/src/fsharp/CompileOps.fs +++ b/src/fsharp/CompileOps.fs @@ -1666,7 +1666,7 @@ let SystemAssemblies () = HashSet [ yield "mscorlib" yield "System.Runtime" - yield "System.Private.CoreLib" + //yield "System.Private.CoreLib" yield "FSharp.Core" yield "System" yield "System.Xml" diff --git a/src/fsharp/CompileOptions.fs b/src/fsharp/CompileOptions.fs index b35ec31d97a..a21d37531ee 100644 --- a/src/fsharp/CompileOptions.fs +++ b/src/fsharp/CompileOptions.fs @@ -762,7 +762,7 @@ let SetTargetProfile tcConfigB v = match v with | "mscorlib" -> PrimaryAssembly.Mscorlib | "netcore" -> PrimaryAssembly.DotNetCore - | "privatecorelib" -> PrimaryAssembly.PrivateCoreLib + //| "privatecorelib" -> PrimaryAssembly.PrivateCoreLib | _ -> error(Error(FSComp.SR.optsInvalidTargetProfile(v), rangeCmdArgs)) let advancedFlagsFsc tcConfigB = diff --git a/src/fsharp/fsi/fsi.fs b/src/fsharp/fsi/fsi.fs index e6595252621..68823a8c4bd 100644 --- a/src/fsharp/fsi/fsi.fs +++ b/src/fsharp/fsi/fsi.fs @@ -2458,7 +2458,8 @@ type internal FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:st // "RuntimeLike" assembly resolution for F# Interactive is not yet properly figured out on .NET Core do tcConfigB.resolutionEnvironment <- ReferenceResolver.DesignTimeLike do tcConfigB.useSimpleResolution <- true - do SetTargetProfile tcConfigB "privatecorelib" // always assume System.Private.CoreLib codegen + do SetTargetProfile tcConfigB "netcore" // always assume System.Runtime codegen + //do SetTargetProfile tcConfigB "privatecorelib" // always assume System.Private.CoreLib codegen #endif // Preset: --optimize+ -g --tailcalls+ (see 4505) diff --git a/tests/fsharp/core/attributes/test.fsx b/tests/fsharp/core/attributes/test.fsx index 0faf94e778b..5e8c09a479a 100644 --- a/tests/fsharp/core/attributes/test.fsx +++ b/tests/fsharp/core/attributes/test.fsx @@ -7,9 +7,11 @@ module Core_attributes #endif #light -#if !TESTS_AS_APP +#if !TESTS_AS_APP && !FX_PORTABLE_OR_NETSTANDARD #load "testlib.fsi" "testlib.fs" // a warning is expected here +#endif +#if !TESTS_AS_APP && !FX_PORTABLE_OR_NETSTANDARD #r "cslib.dll" #endif @@ -887,7 +889,7 @@ module Bug6161_PS_FSharp1_0_MoreAttributesWithArrayArguments = begin check "ce99pj32cweqT" (ca.[0].GetType()) (typeof) check "ce99pj32cweqY" (ca.[0] :?> AnyAttribute).Value (box [| 42 |]) -#if !TESTS_AS_APP +#if !TESTS_AS_APP && !FX_PORTABLE_OR_NETSTANDARD let _ = let ty = typeof let ca = ty.GetCustomAttributes(typeof,false) diff --git a/tests/fsharp/core/comprehensions-hw/test.fsx b/tests/fsharp/core/comprehensions-hw/test.fsx index 0d1c6705d06..d8660ad985d 100644 --- a/tests/fsharp/core/comprehensions-hw/test.fsx +++ b/tests/fsharp/core/comprehensions-hw/test.fsx @@ -438,6 +438,7 @@ test "coic23" +#if !FX_PORTABLE_OR_NETSTANDARD let pickering() = let files = Directory.GetFiles(@"C:\Program Files\Microsoft Enterprise Library January 2006\", "*.csproj", SearchOption.AllDirectories) for file in files do @@ -454,7 +455,7 @@ let pickering() = doc.Save(file) stdin.ReadLine() - +#endif for i,j in [(1,1);(2,1);(3,2)] do printf "i = %d,j = %d\n" i j @@ -489,12 +490,6 @@ let rec allFiles dir = seq { for file in Directory.GetFiles(dir) do yield file for subdir in Directory.GetDirectories dir do yield! (allFiles subdir) } -let _ = - if failures then (stdout.WriteLine "Test Failed"; exit 1) - else (stdout.WriteLine "Test Passed"; - System.IO.File.WriteAllText("test.ok","ok"); - exit 0) - module Attempt = type Attempt<'a> = (unit -> 'a option) let succeed x = (fun () -> Some(x)) @@ -553,6 +548,7 @@ module RandomSmallIfThenElseTest = do () return a } +#if !FX_PORTABLE_OR_NETSTANDARD module MoreExtensions = open Microsoft.FSharp.Control @@ -721,7 +717,7 @@ module SimpleAsyncWebCrawl = collector.Start() collector <-- "http://news.google.com" Async.CancelDefaultToken() - +#endif module TryFinallySequenceExpressionTests = @@ -1035,3 +1031,10 @@ module TryFinallySequenceExpressionTests = with _ -> () testve937() + +let _ = + if failures then (stdout.WriteLine "Test Failed"; exit 1) + else (stdout.WriteLine "Test Passed"; + System.IO.File.WriteAllText("test.ok","ok"); + exit 0) + diff --git a/tests/fsharp/core/libtest/test.fsx b/tests/fsharp/core/libtest/test.fsx index 26968bcff74..e1a0ddcbfb1 100644 --- a/tests/fsharp/core/libtest/test.fsx +++ b/tests/fsharp/core/libtest/test.fsx @@ -2203,9 +2203,6 @@ do test2398997() !* Generic formatting *--------------------------------------------------------------------------- *) -// See FSHARP1.0:4797 -// On NetFx4.0 and above we do not emit the 'I' suffix -let bigintsuffix = if (System.Environment.Version.Major, System.Environment.Version.Minor) > (2,0) then "" else "I" do check "generic format 1" "[1; 2]" (sprintf "%A" [1;2]) do check "generic format 2" "Some [1; 2]" (sprintf "%A" (Some [1;2])) @@ -2216,8 +2213,6 @@ do check "generic format d" "1us" (sprintf "%A" 1us) do check "generic format e" "1" (sprintf "%A" 1) do check "generic format f" "1u" (sprintf "%A" 1ul) do check "generic format g" "1L" (sprintf "%A" 1L) -do check "generic format i" ("1" + bigintsuffix) ( printf "%A" 1I - sprintf "%A" 1I) do check "generic format j" "1.0" (sprintf "%A" 1.0) do check "generic format k" "1.01" (sprintf "%A" 1.01) do check "generic format l" "1000.0" (sprintf "%A" 1000.0) @@ -2226,7 +2221,14 @@ do check "generic format m" "-1y" (sprintf "%A" (-1y)) do check "generic format n" "-1s" (sprintf "%A" (-1s)) do check "generic format o" "-1" (sprintf "%A" (-1)) do check "generic format p" "-1L" (sprintf "%A" (-1L)) +#if !FX_PORTABLE_OR_NETSTANDARD +// See FSHARP1.0:4797 +// On NetFx4.0 and above we do not emit the 'I' suffix +let bigintsuffix = if (System.Environment.Version.Major, System.Environment.Version.Minor) > (2,0) then "" else "I" +do check "generic format i" ("1" + bigintsuffix) ( printf "%A" 1I + sprintf "%A" 1I) do check "generic format r" ("-1" + bigintsuffix) (sprintf "%A" (-1I)) +#endif (*--------------------------------------------------------------------------- @@ -3863,6 +3865,7 @@ module FloatParseTests = begin do check "FloatParse.A" (to_bits (of_string "Infinity")) 0x7ff0000000000000L // 9218868437227405312L do check "FloatParse.B" (to_bits (of_string "-Infinity")) 0xfff0000000000000L // (-4503599627370496L) do check "FloatParse.C" (to_bits (of_string "NaN")) 0xfff8000000000000L // (-2251799813685248L) +#if !FX_PORTABLE_OR_NETSTANDARD do check "FloatParse.D" (to_bits (of_string "-NaN")) ( // http://en.wikipedia.org/wiki/NaN let bit64 = System.IntPtr.Size = 8 in if bit64 && System.Environment.Version.Major < 4 then @@ -3875,6 +3878,7 @@ module FloatParseTests = begin // and -nan then has the negative-bit cleared! 0x7ff8000000000000L // 9221120237041090560L ) +#endif end diff --git a/tests/fsharp/core/patterns/test.fsx b/tests/fsharp/core/patterns/test.fsx index a9af6f6a9da..cd4f85f7a71 100644 --- a/tests/fsharp/core/patterns/test.fsx +++ b/tests/fsharp/core/patterns/test.fsx @@ -7,6 +7,9 @@ module Core_patterns #endif +open System +open System.Reflection + #light let failures = ref false @@ -181,6 +184,7 @@ end module System_Type_Example2 = begin open System + open System.Reflection let (|Named|Array|ByRef|Ptr|Param|) (typ : System.Type) = if typ.IsGenericType then Named(typ.GetGenericTypeDefinition(), typ.GetGenericArguments()) diff --git a/tests/fsharp/core/quotes/test.fsx b/tests/fsharp/core/quotes/test.fsx index cb962dde88d..556d3ec9fb3 100644 --- a/tests/fsharp/core/quotes/test.fsx +++ b/tests/fsharp/core/quotes/test.fsx @@ -4,7 +4,7 @@ module Core_quotes #endif #light -#if !TESTS_AS_APP +#if !TESTS_AS_APP && !FX_PORTABLE_OR_NETSTANDARD #r "cslib.dll" #endif @@ -24,6 +24,7 @@ let check s v1 v2 = open System +open System.Reflection open Microsoft.FSharp.Quotations open Microsoft.FSharp.Quotations.Patterns open Microsoft.FSharp.Quotations.DerivedPatterns @@ -346,7 +347,9 @@ module TypedTest = begin test "check PropertyGet (static)" ((<@ System.DateTime.Now @> |> (function PropertyGet(None,_,[]) -> true | _ -> false))) test "check PropertyGet (instance)" ((<@ ("1").Length @> |> (function PropertyGet(Some(String("1")),_,[]) -> true | _ -> false))) +#if !FX_PORTABLE_OR_NETSTANDARD test "check PropertySet (static)" ((<@ System.Environment.ExitCode <- 1 @> |> (function PropertySet(None,_,[],Int32(1)) -> true | _ -> false))) +#endif test "check PropertySet (instance)" ((<@ ("1").Length @> |> (function PropertyGet(Some(String("1")),_,[]) -> true | _ -> false))) test "check null (string)" (<@ (null:string) @> |> (function Value(null,ty) when ty = typeof -> true | _ -> false)) @@ -513,7 +516,7 @@ module TypedTest = begin | _ -> false end -#if !FSHARP_CORE_31 && !TESTS_AS_APP +#if !FSHARP_CORE_31 && !TESTS_AS_APP && !FX_PORTABLE_OR_NETSTANDARD test "check accesses to readonly fields in ReflectedDefinitions" begin let c1 = Class1("a") diff --git a/tests/fsharp/core/syntax/test.fsx b/tests/fsharp/core/syntax/test.fsx index d7d372eda8f..32bd9a28ab2 100644 --- a/tests/fsharp/core/syntax/test.fsx +++ b/tests/fsharp/core/syntax/test.fsx @@ -549,7 +549,7 @@ type WrapOneStream = override x.Finalize() = x.Dispose(false) member x.Dispose(deep: bool) = printf "disposing, deep = %b!\n" deep; - if deep then x.myManagedResource.Close() + if deep then x.myManagedResource.Dispose() end let dummy4() = () @@ -599,14 +599,14 @@ let LineDirectedInputSample1() = // Write a test file let outputChannel = System.IO.File.CreateText @"test.txt" outputChannel.Write "This is a test file.\r\nIt is easy to read."; - outputChannel.Close(); + outputChannel.Dispose(); // Now read the test file. let inputChannel = System.IO.File.OpenText @"test.txt" let line1 = inputChannel.ReadLine() let line2 = inputChannel.ReadLine() // Don't forget to close the channel - inputChannel.Close(); + inputChannel.Dispose(); printf "line1=%s\nline2=%s\n" line1 line2 module InfixTokenIndentationExamples = begin diff --git a/tests/fsharp/coreclr_utilities.fs b/tests/fsharp/coreclr_utilities.fs index df0ab40ecbb..e8f12ad4204 100644 --- a/tests/fsharp/coreclr_utilities.fs +++ b/tests/fsharp/coreclr_utilities.fs @@ -25,11 +25,12 @@ module CoreClrUtilities #if !INTERACTIVE UnsafeNativeMethods.ExitProcess(exitCode); #endif - if exitCode = 0 then - Environment.FailFast("failfast exit") - else - Environment.FailFast("failfast exit",System.Exception("failfast exit")) - failwith "UnsafeNativeMethods.ExitProcess did not exit!!"; () + () + //if exitCode = 0 then + // Environment.FailFast("failfast exit") + //else + // Environment.FailFast("failfast exit",System.Exception("failfast exit")) + //failwith "UnsafeNativeMethods.ExitProcess did not exit!!"; () #if !INTERACTIVE type System.Environment with diff --git a/tests/fsharp/single-test.fs b/tests/fsharp/single-test.fs index eccea0edd86..d9f887690ad 100644 --- a/tests/fsharp/single-test.fs +++ b/tests/fsharp/single-test.fs @@ -10,12 +10,14 @@ open TestFramework type Permutation = | FSC_CORECLR | FSI_CORECLR +#if !FSHARP_SUITE_DRIVES_CORECLR_TESTS | FSI_FILE | FSI_STDIN | GENERATED_SIGNATURE | FSC_OPT_MINUS_DEBUG | FSC_OPT_PLUS_DEBUG | AS_DLL +#endif let singleTestBuildAndRunAux cfg p = //remove FSharp.Core.dll from the target directory to ensure that compiler uses the correct FSharp.Core.dll @@ -34,7 +36,7 @@ let singleTestBuildAndRunAux cfg p = let coreRunExe = (__SOURCE_DIRECTORY__ ++ sprintf @"../testbin/%s/coreclr/%s/corerun.exe" cfg.BUILD_CONFIG defaultPlatform) makeDirectory (getDirectoryName outFile) let fscArgs = - sprintf """--debug:portable --debug+ --out:%s --target:exe -g --define:NETSTANDARD1_6 --define:FSCORE_PORTABLE_NEW --define:FX_PORTABLE_OR_NETSTANDARD "%s" %s """ + sprintf """--debug:portable --debug+ --out:%s --target:exe -g --define:FX_RESHAPED_REFLECTION --define:NETSTANDARD1_6 --define:FSCORE_PORTABLE_NEW --define:FX_PORTABLE_OR_NETSTANDARD "%s" %s """ outFile extraSource (String.concat " " sources) @@ -55,7 +57,7 @@ let singleTestBuildAndRunAux cfg p = | FSI_CORECLR -> let extraSource = (__SOURCE_DIRECTORY__ ++ "coreclr_utilities.fs") let fsiArgs = - sprintf """ --define:NETSTANDARD1_6 --define:FSCORE_PORTABLE_NEW --define:FX_PORTABLE_OR_NETSTANDARD "%s" %s """ + sprintf """ --define:NETSTANDARD1_6 --define:FSCORE_PORTABLE_NEW --define:FX_RESHAPED_REFLECTION --define:FX_PORTABLE_OR_NETSTANDARD "%s" %s """ extraSource (String.concat " " sources) @@ -71,6 +73,7 @@ let singleTestBuildAndRunAux cfg p = testOkFile.CheckExists() +#if !FSHARP_SUITE_DRIVES_CORECLR_TESTS | FSI_FILE -> use testOkFile = new FileGuard (getfullpath cfg "test.ok") @@ -141,6 +144,7 @@ let singleTestBuildAndRunAux cfg p = exec cfg ("." ++ "test--optimize-client-of-lib.exe") "" testOkFile.CheckExists() +#endif let singleTestBuildAndRun dir p = let cfg = testConfig dir diff --git a/tests/fsharp/tests.fs b/tests/fsharp/tests.fs index 5554e92077d..d2d2a6aefcb 100644 --- a/tests/fsharp/tests.fs +++ b/tests/fsharp/tests.fs @@ -16,120 +16,214 @@ open TestFramework open Scripting open SingleTest +#if FSHARP_SUITE_DRIVES_CORECLR_TESTS +// Use these lines if you want to test CoreCLR +let FSC_BASIC = FSC_CORECLR +let FSI_BASIC = FSI_CORECLR +#else +let FSC_BASIC = FSC_OPT_PLUS_DEBUG +let FSI_BASIC = FSI_FILE +#endif + module CoreTests = -#if FSHARP_SUITE_DRIVES_CORECLR_TESTS +// These tests are enabled for .NET Framework and .NET Core + [] + let ``access-FSI_BASIC``() = singleTestBuildAndRun "core/access" FSI_BASIC - // These tests drive the .NET Core compiler directly (from a .NET Framework NUnit component) [] - let ``access-FSC_CORECLR``() = singleTestBuildAndRun "core/access" FSC_CORECLR + let ``access-FSC_BASIC``() = singleTestBuildAndRun "core/access" FSC_BASIC [] - let ``access-FSI_CORECLR``() = singleTestBuildAndRun "core/access" FSI_CORECLR + let ``apporder-FSC_BASIC`` () = singleTestBuildAndRun "core/apporder" FSC_BASIC [] - let ``apporder-FSC_CORECLR`` () = singleTestBuildAndRun "core/apporder" FSC_CORECLR + let ``apporder-FSI_BASIC`` () = singleTestBuildAndRun "core/apporder" FSI_BASIC [] - let ``apporder-FSI_CORECLR`` () = singleTestBuildAndRun "core/apporder" FSI_CORECLR + let ``array-FSC_BASIC`` () = singleTestBuildAndRun "core/array" FSC_BASIC [] - let ``array-FSC_CORECLR`` () = singleTestBuildAndRun "core/array" FSC_CORECLR + let ``array-FSI_BASIC`` () = singleTestBuildAndRun "core/array" FSI_BASIC [] - let ``array-FSI_CORECLR`` () = singleTestBuildAndRun "core/array" FSI_CORECLR + let ``comprehensions-FSC_BASIC`` () = singleTestBuildAndRun "core/comprehensions" FSC_BASIC + [] + let ``comprehensions-FSI_BASIC`` () = singleTestBuildAndRun "core/comprehensions" FSI_BASIC -#else + [] + let ``comprehensionshw-FSC_BASIC`` () = singleTestBuildAndRun "core/comprehensions-hw" FSC_BASIC [] - let ``access-FSI_FILE``() = singleTestBuildAndRun "core/access" FSI_FILE + let ``comprehensionshw-FSI_BASIC`` () = singleTestBuildAndRun "core/comprehensions-hw" FSI_BASIC [] - let ``access-FSC_OPT_PLUS_DEBUG``() = singleTestBuildAndRun "core/access" FSC_OPT_PLUS_DEBUG + let ``genericmeasures-FSI_BASIC`` () = singleTestBuildAndRun "core/genericmeasures" FSI_BASIC [] - let ``access-GENERATED_SIGNATURE``() = singleTestBuildAndRun "core/access" GENERATED_SIGNATURE + let ``genericmeasures-FSC_BASIC`` () = singleTestBuildAndRun "core/genericmeasures" FSC_BASIC [] - let ``apporder-FSC_OPT_PLUS_DEBUG`` () = singleTestBuildAndRun "core/apporder" FSC_OPT_PLUS_DEBUG + let ``innerpoly-FSI_BASIC`` () = singleTestBuildAndRun "core/innerpoly" FSI_BASIC [] - let ``apporder-FSI_FILE`` () = singleTestBuildAndRun "core/apporder" FSI_FILE + let ``innerpoly-FSC_BASIC`` () = singleTestBuildAndRun "core/innerpoly" FSC_BASIC + + [] + let namespaceAttributes () = singleTestBuildAndRun "core/namespaces" FSC_BASIC [] - let ``array-FSC_OPT_PLUS_DEBUG`` () = singleTestBuildAndRun "core/array" FSC_OPT_PLUS_DEBUG + let unicode2 () = singleTestBuildAndRun "core/unicode" FSC_BASIC [] - let ``array-FSI_FILE`` () = singleTestBuildAndRun "core/array" FSI_FILE + let ``unicode2-FSI_BASIC`` () = singleTestBuildAndRun "core/unicode" FSI_BASIC [] - let ``attributes-FSC_OPT_PLUS_DEBUG`` () = singleTestBuildAndRun "core/attributes" FSC_OPT_PLUS_DEBUG + let ``lazy test-FSC_BASIC`` () = singleTestBuildAndRun "core/lazy" FSC_BASIC [] - let ``attributes-FSI_FILE`` () = singleTestBuildAndRun "core/attributes" FSI_FILE + let ``lazy test-FSI_BASIC`` () = singleTestBuildAndRun "core/lazy" FSI_BASIC [] - let byrefs () = + let ``letrec-FSC_BASIC`` () = singleTestBuildAndRun "core/letrec" FSC_BASIC - let cfg = testConfig "core/byrefs" + [] + let ``letrec-FSI_BASIC`` () = singleTestBuildAndRun "core/letrec" FSI_BASIC - use testOkFile = fileguard cfg "test.ok" + [] + let ``letrec (mutrec variations part one) FSC_BASIC`` () = singleTestBuildAndRun "core/letrec-mutrec" FSC_BASIC - fsc cfg "%s -o:test.exe -g" cfg.fsc_flags ["test.fsx"] + [] + let ``letrec (mutrec variations part one) FSI_BASIC`` () = singleTestBuildAndRun "core/letrec-mutrec" FSI_BASIC - exec cfg ("." ++ "test.exe") "" + [] + let ``libtest-FSC_BASIC`` () = singleTestBuildAndRun "core/libtest" FSC_BASIC - testOkFile.CheckExists() + [] + let lift () = singleTestBuildAndRun "core/lift" FSC_BASIC - fsi cfg "" ["test.fsx"] + [] + let map () = singleTestBuildAndRun "core/map" FSC_BASIC - testOkFile.CheckExists() + [] + let ``measures-FSI_BASIC`` () = singleTestBuildAndRun "core/measures" FSI_BASIC + + [] + let ``measures-FSC_BASIC`` () = singleTestBuildAndRun "core/measures" FSC_BASIC + + [] + let nested () = singleTestBuildAndRun "core/nested" FSC_BASIC + + [] + let ``members-ops`` () = singleTestBuildAndRun "core/members/ops" FSC_BASIC [] - let ``comprehensions-FSC_OPT_PLUS_DEBUG`` () = singleTestBuildAndRun "core/comprehensions" FSC_OPT_PLUS_DEBUG + let ``members-ops-mutrec`` () = singleTestBuildAndRun "core/members/ops-mutrec" FSC_BASIC [] - let ``comprehensions-FSI_FILE`` () = singleTestBuildAndRun "core/comprehensions" FSI_FILE + let seq () = singleTestBuildAndRun "core/seq" FSC_BASIC + + [] + let ``math-numbers`` () = singleTestBuildAndRun "core/math/numbers" FSC_BASIC + + + [] + let ``members-ctree`` () = singleTestBuildAndRun "core/members/ctree" FSC_BASIC + + [] + let ``members-factors`` () = singleTestBuildAndRun "core/members/factors" FSC_BASIC + + [] + let ``members-factors-mutrec`` () = singleTestBuildAndRun "core/members/factors-mutrec" FSC_BASIC + [] - let ``comprehensionshw-FSC_OPT_PLUS_DEBUG`` () = singleTestBuildAndRun "core/comprehensions-hw" FSC_OPT_PLUS_DEBUG + let graph () = singleTestBuildAndRun "perf/graph" FSC_BASIC [] - let ``comprehensionshw-FSI_FILE`` () = singleTestBuildAndRun "core/comprehensions-hw" FSI_FILE + let nbody () = singleTestBuildAndRun "perf/nbody" FSC_BASIC [] - let control () = singleTestBuildAndRun "core/control" FSC_OPT_PLUS_DEBUG + let ``letrec (mutrec variations part two) FSC_BASIC`` () = singleTestBuildAndRun "core/letrec-mutrec2" FSC_BASIC + + [] + let printf () = singleTestBuildAndRun "core/printf" FSC_BASIC + + [] + let tlr () = singleTestBuildAndRun "core/tlr" FSC_BASIC + + [] + let subtype () = singleTestBuildAndRun "core/subtype" FSC_BASIC + + [] + let ``quotes-FSC-BASIC`` () = singleTestBuildAndRun "core/quotes" FSC_BASIC + + [] + let syntax () = singleTestBuildAndRun "core/syntax" FSC_BASIC + + [] + let ``test int32`` () = singleTestBuildAndRun "core/int32" FSC_BASIC + + +// All tests below here are enabled only for .NET Framework. We should aim to enable at least all tests mentioning FSC_BASIC or FSI_BASIC +#if !FSHARP_SUITE_DRIVES_CORECLR_TESTS + + [] + let ``attributes-FSC_BASIC`` () = singleTestBuildAndRun "core/attributes" FSC_BASIC + + [] + let ``attributes-FSI_BASIC`` () = singleTestBuildAndRun "core/attributes" FSI_BASIC + + [] + let byrefs () = + + let cfg = testConfig "core/byrefs" + + use testOkFile = fileguard cfg "test.ok" + + fsc cfg "%s -o:test.exe -g" cfg.fsc_flags ["test.fsx"] + + exec cfg ("." ++ "test.exe") "" + + testOkFile.CheckExists() + + fsi cfg "" ["test.fsx"] + + testOkFile.CheckExists() + + [] + let control () = singleTestBuildAndRun "core/control" FSC_BASIC [] let ``control --tailcalls`` () = let cfg = testConfig "core/control" - singleTestBuildAndRunAux {cfg with fsi_flags = " --tailcalls" } FSC_OPT_PLUS_DEBUG + singleTestBuildAndRunAux {cfg with fsi_flags = " --tailcalls" } FSC_BASIC [] let controlChamenos () = let cfg = testConfig "core/controlChamenos" - singleTestBuildAndRunAux {cfg with fsi_flags = " --tailcalls" } FSC_OPT_PLUS_DEBUG + singleTestBuildAndRunAux {cfg with fsi_flags = " --tailcalls" } FSC_BASIC [] - let controlMailbox () = singleTestBuildAndRun "core/controlMailbox" FSC_OPT_PLUS_DEBUG + let controlMailbox () = singleTestBuildAndRun "core/controlMailbox" FSC_BASIC [] let ``controlMailbox --tailcalls`` () = let cfg = testConfig "core/controlMailbox" - singleTestBuildAndRunAux {cfg with fsi_flags = " --tailcalls" } FSC_OPT_PLUS_DEBUG + singleTestBuildAndRunAux {cfg with fsi_flags = " --tailcalls" } FSC_BASIC [] - let controlWpf () = singleTestBuildAndRun "core/controlwpf" FSC_OPT_PLUS_DEBUG + let controlWpf () = singleTestBuildAndRun "core/controlwpf" FSC_BASIC [] - let csext () = singleTestBuildAndRun "core/csext" FSC_OPT_PLUS_DEBUG + let csext () = singleTestBuildAndRun "core/csext" FSC_BASIC [] @@ -323,15 +417,6 @@ module CoreTests = - [] - let ``genericmeasures-GENERATED_SIGNATURE`` () = singleTestBuildAndRun "core/genericmeasures" GENERATED_SIGNATURE - - [] - let ``genericmeasures-FSI_FILE`` () = singleTestBuildAndRun "core/genericmeasures" FSI_FILE - - [] - let ``genericmeasures-FSC_OPT_PLUS_DEBUG`` () = singleTestBuildAndRun "core/genericmeasures" FSC_OPT_PLUS_DEBUG - [] let ``genericmeasures-AS_DLL`` () = singleTestBuildAndRun "core/genericmeasures" AS_DLL @@ -352,21 +437,9 @@ module CoreTests = peverify cfg "client.exe" - [] - let ``innerpoly-GENERATED_SIGNATURE`` () = singleTestBuildAndRun "core/innerpoly" GENERATED_SIGNATURE - - [] - let ``innerpoly-FSI_FILE`` () = singleTestBuildAndRun "core/innerpoly" FSI_FILE - - [] - let ``innerpoly-FSC_OPT_PLUS_DEBUG`` () = singleTestBuildAndRun "core/innerpoly" FSC_OPT_PLUS_DEBUG - [] let ``innerpoly-AS_DLL`` () = singleTestBuildAndRun "core/innerpoly" AS_DLL - [] - let ``test int32`` () = singleTestBuildAndRun "core/int32" FSC_OPT_PLUS_DEBUG - [] let queriesCustomQueryOps () = let cfg = testConfig "core/queriesCustomQueryOps" @@ -550,6 +623,9 @@ module CoreTests = [] let ``signedtest-17`` () = signedtest("--keyfile:sha1024delay.snk --publicsign", "test-sha1024-public-cl.bsl") + [] + let ``quotes-FSI-BASIC`` () = singleTestBuildAndRun "core/quotes" FSI_BASIC + [] let quotes () = let cfg = testConfig "core/quotes" @@ -594,10 +670,6 @@ module CoreTests = testOkFile.CheckExists() end - [] - let namespaceAttributes () = - singleTestBuildAndRun "core/namespaces" FSC_OPT_PLUS_DEBUG - [] let parsing () = let cfg = testConfig "core/parsing" @@ -633,9 +705,6 @@ module CoreTests = fsi cfg "%s --utf8output" cfg.fsi_flags ["kanji-unicode-utf16.fs"] - [] - let unicode2 () = singleTestBuildAndRun "core/unicode" FSC_OPT_PLUS_DEBUG - [] let internalsvisible () = let cfg = testConfig "core/internalsvisible" @@ -687,21 +756,6 @@ module CoreTests = exec cfg ("." ++ "test2.exe") "" - [] - let ``lazy test`` () = singleTestBuildAndRun "core/lazy" FSC_OPT_PLUS_DEBUG - - [] - let letrec () = singleTestBuildAndRun "core/letrec" FSC_OPT_PLUS_DEBUG - - [] - let ``letrec (mutrec variations part one)`` () = singleTestBuildAndRun "core/letrec-mutrec" FSC_OPT_PLUS_DEBUG - - [] - let ``letrec (mutrec variations part two)`` () = singleTestBuildAndRun "core/letrec-mutrec2" FSC_OPT_PLUS_DEBUG - - [] - let ``libtest-FSI_FILE`` () = singleTestBuildAndRun "core/libtest" FSI_FILE - [] let ``libtest-FSI_STDIN`` () = singleTestBuildAndRun "core/libtest" FSI_STDIN @@ -712,13 +766,13 @@ module CoreTests = let ``libtest-FSC_OPT_MINUS_DEBUG`` () = singleTestBuildAndRun "core/libtest" FSC_OPT_MINUS_DEBUG [] - let ``libtest-FSC_OPT_PLUS_DEBUG`` () = singleTestBuildAndRun "core/libtest" FSC_OPT_PLUS_DEBUG + let ``libtest-AS_DLL`` () = singleTestBuildAndRun "core/libtest" AS_DLL [] - let ``libtest-AS_DLL`` () = singleTestBuildAndRun "core/libtest" AS_DLL + let ``libtest-FSI_BASIC`` () = singleTestBuildAndRun "core/libtest" FSI_BASIC - [] - let lift () = singleTestBuildAndRun "core/lift" FSC_OPT_PLUS_DEBUG + [] + let ``letrec (mutrec variations part two) FSI_BASIC`` () = singleTestBuildAndRun "core/letrec-mutrec2" FSI_BASIC [] @@ -853,76 +907,40 @@ module CoreTests = [] - let longnames () = singleTestBuildAndRun "core/longnames" FSC_OPT_PLUS_DEBUG + let longnames () = singleTestBuildAndRun "core/longnames" FSC_BASIC [] - let map () = singleTestBuildAndRun "core/map" FSC_OPT_PLUS_DEBUG - - [] - let ``math-numbers`` () = singleTestBuildAndRun "core/math/numbers" FSC_OPT_PLUS_DEBUG - - [] - let ``math-numbersVS2008`` () = singleTestBuildAndRun "core/math/numbersVS2008" FSC_OPT_PLUS_DEBUG - - [] - let ``measures-GENERATED_SIGNATURE`` () = singleTestBuildAndRun "core/measures" GENERATED_SIGNATURE - - [] - let ``measures-FSI_FILE`` () = singleTestBuildAndRun "core/measures" FSI_FILE - - [] - let ``measures-FSC_OPT_PLUS_DEBUG`` () = singleTestBuildAndRun "core/measures" FSC_OPT_PLUS_DEBUG + let ``math-numbersVS2008`` () = singleTestBuildAndRun "core/math/numbersVS2008" FSC_BASIC [] let ``measures-AS_DLL`` () = singleTestBuildAndRun "core/measures" AS_DLL [] - let ``members-basics-GENERATED_SIGNATURE`` () = singleTestBuildAndRun "core/members/basics" GENERATED_SIGNATURE - - [] - let ``members-basics-FSI_FILE`` () = singleTestBuildAndRun "core/members/basics" FSI_FILE + let ``members-basics-FSI_BASIC`` () = singleTestBuildAndRun "core/members/basics" FSI_BASIC [] - let ``members-basics-FSC_OPT_PLUS_DEBUG`` () = singleTestBuildAndRun "core/members/basics" FSC_OPT_PLUS_DEBUG + let ``members-basics-FSC_BASIC`` () = singleTestBuildAndRun "core/members/basics" FSC_BASIC [] let ``members-basics-AS_DLL`` () = singleTestBuildAndRun "core/members/basics" AS_DLL [] - let ``members-basics-hw`` () = singleTestBuildAndRun "core/members/basics-hw" FSC_OPT_PLUS_DEBUG - - [] - let ``members-basics-hw-mutrec`` () = singleTestBuildAndRun "core/members/basics-hw-mutrec" FSC_OPT_PLUS_DEBUG + let ``members-basics-hw`` () = singleTestBuildAndRun "core/members/basics-hw" FSC_BASIC [] - let ``members-ctree`` () = singleTestBuildAndRun "core/members/ctree" FSC_OPT_PLUS_DEBUG + let ``members-basics-hw-mutrec`` () = singleTestBuildAndRun "core/members/basics-hw-mutrec" FSC_BASIC [] - let ``members-factors`` () = singleTestBuildAndRun "core/members/factors" FSC_OPT_PLUS_DEBUG + let ``members-incremental`` () = singleTestBuildAndRun "core/members/incremental" FSC_BASIC [] - let ``members-factors-mutrec`` () = singleTestBuildAndRun "core/members/factors-mutrec" FSC_OPT_PLUS_DEBUG + let ``members-incremental-hw`` () = singleTestBuildAndRun "core/members/incremental-hw" FSC_BASIC [] - let ``members-incremental`` () = singleTestBuildAndRun "core/members/incremental" FSC_OPT_PLUS_DEBUG + let ``members-incremental-hw-mutrec`` () = singleTestBuildAndRun "core/members/incremental-hw-mutrec" FSC_BASIC [] - let ``members-incremental-hw`` () = singleTestBuildAndRun "core/members/incremental-hw" FSC_OPT_PLUS_DEBUG - - [] - let ``members-incremental-hw-mutrec`` () = singleTestBuildAndRun "core/members/incremental-hw-mutrec" FSC_OPT_PLUS_DEBUG - - [] - let ``members-ops`` () = singleTestBuildAndRun "core/members/ops" FSC_OPT_PLUS_DEBUG - - [] - let ``members-ops-mutrec`` () = singleTestBuildAndRun "core/members/ops-mutrec" FSC_OPT_PLUS_DEBUG - - [] - let nested () = singleTestBuildAndRun "core/nested" FSC_OPT_PLUS_DEBUG - - [] - let patterns () = singleTestBuildAndRun "core/patterns" FSC_OPT_PLUS_DEBUG + let patterns () = singleTestBuildAndRun "core/patterns" FSC_BASIC [] let pinvoke () = @@ -932,9 +950,6 @@ module CoreTests = peverifyWithArgs cfg "/nologo /MD" "test.exe" - [] - let printf () = singleTestBuildAndRun "core/printf" FSC_OPT_PLUS_DEBUG - [] let queriesLeafExpressionConvert () = let cfg = testConfig "core/queriesLeafExpressionConvert" @@ -1135,7 +1150,7 @@ module CoreTests = testOkFile.CheckExists() [] - let reflect () = singleTestBuildAndRun "core/reflect" FSC_OPT_PLUS_DEBUG + let reflect () = singleTestBuildAndRun "core/reflect" FSC_BASIC [] let testResources () = @@ -1165,18 +1180,6 @@ module CoreTests = exec cfg ("." ++ "test-embed-named.exe") "ResourceName" - [] - let seq () = singleTestBuildAndRun "core/seq" FSC_OPT_PLUS_DEBUG - - [] - let subtype () = singleTestBuildAndRun "core/subtype" FSC_OPT_PLUS_DEBUG - - [] - let syntax () = singleTestBuildAndRun "core/syntax" FSC_OPT_PLUS_DEBUG - - [] - let tlr () = singleTestBuildAndRun "core/tlr" FSC_OPT_PLUS_DEBUG - [] let topinit () = let cfg = testConfig "core/topinit" @@ -1335,12 +1338,6 @@ module CoreTests = peverifyWithArgs cfg "/nologo" "xmlverify.exe" - [] - let graph () = singleTestBuildAndRun "perf/graph" FSC_OPT_PLUS_DEBUG - - [] - let nbody () = singleTestBuildAndRun "perf/nbody" FSC_OPT_PLUS_DEBUG - module ToolsTests = [] @@ -1364,15 +1361,15 @@ module ToolsTests = peverify cfg "test_two_fsharp_modules_module_2_as_dll.dll" [] - let eval () = singleTestBuildAndRun "tools/eval" FSC_OPT_PLUS_DEBUG + let eval () = singleTestBuildAndRun "tools/eval" FSC_BASIC module RegressionTests = [] - let ``26`` () = singleTestBuildAndRun "regression/26" FSC_OPT_PLUS_DEBUG + let ``26`` () = singleTestBuildAndRun "regression/26" FSC_BASIC [] - let ``321`` () = singleTestBuildAndRun "regression/321" FSC_OPT_PLUS_DEBUG + let ``321`` () = singleTestBuildAndRun "regression/321" FSC_BASIC [] let ``655`` () = @@ -1401,10 +1398,10 @@ module RegressionTests = peverify cfg "pack.exe" [] - let ``83`` () = singleTestBuildAndRun "regression/83" FSC_OPT_PLUS_DEBUG + let ``83`` () = singleTestBuildAndRun "regression/83" FSC_BASIC [] - let ``84`` () = singleTestBuildAndRun "regression/84" FSC_OPT_PLUS_DEBUG + let ``84`` () = singleTestBuildAndRun "regression/84" FSC_BASIC [] let ``85`` () = @@ -1415,10 +1412,10 @@ module RegressionTests = peverify cfg "petshop.dll" [] - let ``86`` () = singleTestBuildAndRun "regression/86" FSC_OPT_PLUS_DEBUG + let ``86`` () = singleTestBuildAndRun "regression/86" FSC_BASIC [] - let ``tuple-bug-1`` () = singleTestBuildAndRun "regression/tuple-bug-1" FSC_OPT_PLUS_DEBUG + let ``tuple-bug-1`` () = singleTestBuildAndRun "regression/tuple-bug-1" FSC_BASIC module OptimizationTests = @@ -1558,11 +1555,11 @@ module TypecheckTests = csc cfg "/target:library /out:HighRankArrayTests.dll" ["Class1.cs"] - SingleTest.singleTestBuildAndRunAux cfg FSC_OPT_PLUS_DEBUG + SingleTest.singleTestBuildAndRunAux cfg FSC_BASIC [] - let misc () = singleTestBuildAndRun "typecheck/misc" FSC_OPT_PLUS_DEBUG + let misc () = singleTestBuildAndRun "typecheck/misc" FSC_BASIC [] let ``sigs pos24`` () = @@ -1851,7 +1848,7 @@ module TypeProviders = peverify cfg (bincompat2 ++ "testlib_client.exe") [] - let ``helloWorld fsc`` () = helloWorld FSC_OPT_PLUS_DEBUG + let ``helloWorld fsc`` () = helloWorld FSC_BASIC [] let ``helloWorld fsi`` () = helloWorld FSI_STDIN @@ -1968,7 +1965,7 @@ module TypeProviders = fsc cfg "--out:providerDesigner.dll -a" ["providerDesigner.fsx"] - SingleTest.singleTestBuildAndRunAux cfg FSC_OPT_PLUS_DEBUG + SingleTest.singleTestBuildAndRunAux cfg FSC_BASIC [] let wedgeAssembly () = @@ -2132,4 +2129,24 @@ namespace CST.RI.Anshun fileVersionInfo.ProductVersion |> Assert.areEqual expected #endif + +module GeneratedSignatureTests = + [] + let ``members-basics-GENERATED_SIGNATURE`` () = singleTestBuildAndRun "core/members/basics" GENERATED_SIGNATURE + + [] + let ``access-GENERATED_SIGNATURE``() = singleTestBuildAndRun "core/access" GENERATED_SIGNATURE + + [] + let ``array-GENERATED_SIGNATURE``() = singleTestBuildAndRun "core/array" GENERATED_SIGNATURE + + [] + let ``genericmeasures-GENERATED_SIGNATURE`` () = singleTestBuildAndRun "core/genericmeasures" GENERATED_SIGNATURE + + [] + let ``innerpoly-GENERATED_SIGNATURE`` () = singleTestBuildAndRun "core/innerpoly" GENERATED_SIGNATURE + + [] + let ``measures-GENERATED_SIGNATURE`` () = singleTestBuildAndRun "core/measures" GENERATED_SIGNATURE + #endif diff --git a/tests/scripts/fsci.fsx b/tests/scripts/fsci.fsx index 0a6fcdf6d0e..517ffe73350 100644 --- a/tests/scripts/fsci.fsx +++ b/tests/scripts/fsci.fsx @@ -20,7 +20,7 @@ let Win32Manifest = CompilerPath ++ "default.win32manifest" let isRepro = Verbosity = "repro" || Verbosity = "verbose" let isVerbose = Verbosity = "verbose" -let dependencies = CrackProjectJson.collectReferences (isVerbose, PackagesDir, FrameworkName + "/" + Platform, ProjectJsonLock, true, false) |> Seq.toArray +let dependencies = CrackProjectJson.collectReferences (isVerbose, PackagesDir, FrameworkName + "/" + Platform, ProjectJsonLock, false, false) |> Seq.toArray let executeFsi references = @@ -42,6 +42,5 @@ let executeFsi references = executeProcessNoRedirect coreRunExe arguments2 -let _exitCode = executeFsi dependencies // ignore exit code for now since FailFast gives negative error code -exit 0 +executeFsi dependencies // ignore exit code for now since FailFast gives negative error code From f035eae7bba7f258ed229d19a4fb770c7f203b79 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Tue, 22 Nov 2016 14:03:07 +0000 Subject: [PATCH 10/13] put back portable debug symbols --- src/FSharpSource.Settings.targets | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/FSharpSource.Settings.targets b/src/FSharpSource.Settings.targets index e2564eafb69..360e0164539 100644 --- a/src/FSharpSource.Settings.targets +++ b/src/FSharpSource.Settings.targets @@ -59,7 +59,7 @@ full - pdbonly + portable false prompt $(OtherFlags) --no-jit-optimize From 47a93809230213cc2726a0b66369fe4d3bf4b789 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Tue, 22 Nov 2016 14:07:23 +0000 Subject: [PATCH 11/13] remove unused code --- src/absil/il.fs | 3 --- src/absil/il.fsi | 1 - src/fsharp/CompileOps.fs | 1 - src/fsharp/CompileOptions.fs | 1 - 4 files changed, 6 deletions(-) diff --git a/src/absil/il.fs b/src/absil/il.fs index 6fad9782d66..97a4cbfe43b 100644 --- a/src/absil/il.fs +++ b/src/absil/il.fs @@ -52,17 +52,14 @@ let lazyMap f (x:Lazy<_>) = type PrimaryAssembly = | Mscorlib | DotNetCore - //| PrivateCoreLib member this.Name = match this with | Mscorlib -> "mscorlib" | DotNetCore -> "System.Runtime" - //| PrivateCoreLib -> "System.Private.CoreLib" static member IsSomePrimaryAssembly n = n = PrimaryAssembly.Mscorlib.Name || n = PrimaryAssembly.DotNetCore.Name - //|| n = PrimaryAssembly.PrivateCoreLib.Name // -------------------------------------------------------------------- // Utilities: type names diff --git a/src/absil/il.fsi b/src/absil/il.fsi index 8f92fb318b7..8a654cbbae7 100644 --- a/src/absil/il.fsi +++ b/src/absil/il.fsi @@ -11,7 +11,6 @@ open System.Collections.Generic type PrimaryAssembly = | Mscorlib | DotNetCore - //| PrivateCoreLib member Name: string diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index 534a50163ef..b1dcc1c77a5 100644 --- a/src/fsharp/CompileOps.fs +++ b/src/fsharp/CompileOps.fs @@ -1666,7 +1666,6 @@ let SystemAssemblies () = HashSet [ yield "mscorlib" yield "System.Runtime" - //yield "System.Private.CoreLib" yield "FSharp.Core" yield "System" yield "System.Xml" diff --git a/src/fsharp/CompileOptions.fs b/src/fsharp/CompileOptions.fs index a21d37531ee..a3702e7d7cd 100644 --- a/src/fsharp/CompileOptions.fs +++ b/src/fsharp/CompileOptions.fs @@ -762,7 +762,6 @@ let SetTargetProfile tcConfigB v = match v with | "mscorlib" -> PrimaryAssembly.Mscorlib | "netcore" -> PrimaryAssembly.DotNetCore - //| "privatecorelib" -> PrimaryAssembly.PrivateCoreLib | _ -> error(Error(FSComp.SR.optsInvalidTargetProfile(v), rangeCmdArgs)) let advancedFlagsFsc tcConfigB = From 3c62ecfac609ac4e1f0c84720caf8e271df08217 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Tue, 22 Nov 2016 14:21:05 +0000 Subject: [PATCH 12/13] fix script --- build.cmd | 1 + 1 file changed, 1 insertion(+) diff --git a/build.cmd b/build.cmd index e6db6b9e595..f612672dc96 100644 --- a/build.cmd +++ b/build.cmd @@ -899,6 +899,7 @@ if '%TEST_VS_IDEUNIT_SUITE%' == '1' ( ) ) +goto :success REM ------ upload test results procedure ------------------------------------- :UPLOAD_TEST_RESULTS From ed5d0fb5dfb3cb0562c931a22b667b707ad63abc Mon Sep 17 00:00:00 2001 From: Don Syme Date: Tue, 22 Nov 2016 16:57:17 +0000 Subject: [PATCH 13/13] trim tests --- tests/fsharp/tests.fs | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/tests/fsharp/tests.fs b/tests/fsharp/tests.fs index d2d2a6aefcb..f64606d503b 100644 --- a/tests/fsharp/tests.fs +++ b/tests/fsharp/tests.fs @@ -27,13 +27,17 @@ let FSI_BASIC = FSI_FILE module CoreTests = -// These tests are enabled for .NET Framework and .NET Core - [] - let ``access-FSI_BASIC``() = singleTestBuildAndRun "core/access" FSI_BASIC + // These tests are enabled for .NET Framework and .NET Core [] let ``access-FSC_BASIC``() = singleTestBuildAndRun "core/access" FSC_BASIC + +// All tests below here are known to pass for .NET Core but not yet enabled due to CI problems +#if !FSHARP_SUITE_DRIVES_CORECLR_TESTS + [] + let ``access-FSI_BASIC``() = singleTestBuildAndRun "core/access" FSI_BASIC + [] let ``apporder-FSC_BASIC`` () = singleTestBuildAndRun "core/apporder" FSC_BASIC @@ -164,6 +168,7 @@ module CoreTests = [] let ``test int32`` () = singleTestBuildAndRun "core/int32" FSC_BASIC +#endif // All tests below here are enabled only for .NET Framework. We should aim to enable at least all tests mentioning FSC_BASIC or FSI_BASIC