diff --git a/src/absil/il.fs b/src/absil/il.fs index 40078e8374..23710e73c8 100755 --- a/src/absil/il.fs +++ b/src/absil/il.fs @@ -914,9 +914,6 @@ type ILAttribElem = type ILAttributeNamedArg = (string * ILType * bool * ILAttribElem) type ILAttribute = { Method: ILMethodSpec; -#if FX_REFLECTION_EMITS_CUSTOM_ATTRIBUTES_USING_BUILDER - Arguments: ILAttribElem list * ILAttributeNamedArg list -#endif Data: byte[] } [] @@ -4416,9 +4413,6 @@ let mkILCustomAttribMethRef (ilg: ILGlobals) (mspec:ILMethodSpec, fixedArgs: lis yield! encodeCustomAttrNamedArg ilg namedArg |] { Method = mspec; -#if FX_REFLECTION_EMITS_CUSTOM_ATTRIBUTES_USING_BUILDER - Arguments = fixedArgs, namedArgs -#endif Data = args } let mkILCustomAttribute ilg (tref,argtys,argvs,propvs) = diff --git a/src/absil/il.fsi b/src/absil/il.fsi index 38e51c7305..0a0de3bc51 100755 --- a/src/absil/il.fsi +++ b/src/absil/il.fsi @@ -1028,9 +1028,6 @@ type ILAttributeNamedArg = string * ILType * bool * ILAttribElem /// to ILAttribElem's as best as possible. type ILAttribute = { Method: ILMethodSpec; -#if FX_REFLECTION_EMITS_CUSTOM_ATTRIBUTES_USING_BUILDER - Arguments: ILAttribElem list * ILAttributeNamedArg list -#endif Data: byte[] } [] diff --git a/src/absil/illib.fs b/src/absil/illib.fs index 8d9829eac9..7b4c28a213 100755 --- a/src/absil/illib.fs +++ b/src/absil/illib.fs @@ -628,27 +628,6 @@ module Eventually = let force e = Option.get (forceWhile (fun () -> true) e) /// Keep running the computation bit by bit until a time limit is reached. -#if FX_NO_SYSTEM_DIAGNOSTICS_STOPWATCH - // There is no Stopwatch on Silverlight, so use DateTime.Now. I'm not sure of the pros and cons of this. - // An alternative is just to always force the computation all the way to the end. - //let repeatedlyProgressUntilDoneOrTimeShareOver _timeShareInMilliseconds runner e = - // Done (runner (fun () -> force e)) - let repeatedlyProgressUntilDoneOrTimeShareOver (timeShareInMilliseconds:int64) runner e = - let rec runTimeShare e = - runner (fun () -> - let sw = System.DateTime.Now - let rec loop e = - match e with - | Done _ -> e - | NotYetDone (work) -> - let ts = System.DateTime.Now - sw - if ts.TotalMilliseconds > float timeShareInMilliseconds then - NotYetDone(fun () -> runTimeShare e) - else - loop(work()) - loop e) - runTimeShare e -#else /// The runner gets called each time the computation is restarted let repeatedlyProgressUntilDoneOrTimeShareOver timeShareInMilliseconds runner e = let sw = new System.Diagnostics.Stopwatch() @@ -667,7 +646,6 @@ module Eventually = loop(work()) loop(e)) runTimeShare e -#endif let rec bind k e = match e with @@ -990,81 +968,6 @@ module Shim = abstract AssemblyLoadFrom: fileName:string -> System.Reflection.Assembly abstract AssemblyLoad: assemblyName:System.Reflection.AssemblyName -> System.Reflection.Assembly -#if FX_FILE_SYSTEM_USES_ISOLATED_STORAGE - open System.IO.IsolatedStorage - open System.Windows - open System - - type DefaultFileSystem() = - interface IFileSystem with - member this.ReadAllBytesShim (fileName:string) = - use stream = this.FileStreamReadShim fileName - let len = stream.Length - let buf = Array.zeroCreate (int len) - stream.Read(buf, 0, (int len)) |> ignore - buf - - - member this.AssemblyLoadFrom(fileName:string) = - let load() = - let assemblyPart = System.Windows.AssemblyPart() - let assemblyStream = this.FileStreamReadShim(fileName) - assemblyPart.Load(assemblyStream) - if System.Windows.Deployment.Current.Dispatcher.CheckAccess() then - load() - else - let resultTask = System.Threading.Tasks.TaskCompletionSource() - System.Windows.Deployment.Current.Dispatcher.BeginInvoke(Action(fun () -> resultTask.SetResult (load()))) |> ignore - resultTask.Task.Result - - member this.AssemblyLoad(assemblyName:System.Reflection.AssemblyName) = - try - System.Reflection.Assembly.Load(assemblyName.FullName) - with e -> - this.AssemblyLoadFrom(assemblyName.Name + ".dll") - - member __.FileStreamReadShim (fileName:string) = - match Application.GetResourceStream(System.Uri(fileName,System.UriKind.Relative)) with - | null -> IsolatedStorageFile.GetUserStoreForApplication().OpenFile(fileName, System.IO.FileMode.Open) :> System.IO.Stream - | resStream -> resStream.Stream - - member __.FileStreamCreateShim (fileName:string) = - System.IO.IsolatedStorage.IsolatedStorageFile.GetUserStoreForApplication().CreateFile(fileName) :> Stream - - member __.FileStreamWriteExistingShim (fileName:string) = - let isf = System.IO.IsolatedStorage.IsolatedStorageFile.GetUserStoreForApplication() - new System.IO.IsolatedStorage.IsolatedStorageFileStream(fileName,FileMode.Open,FileAccess.Write,isf) :> Stream - - member __.GetFullPathShim (fileName:string) = fileName - member __.IsPathRootedShim (pathName:string) = true - - member __.IsInvalidPathShim(path:string) = - let isInvalidPath(p:string) = - String.IsNullOrEmpty(p) || p.IndexOfAny(System.IO.Path.GetInvalidPathChars()) <> -1 - - let isInvalidDirectory(d:string) = - d=null || d.IndexOfAny(Path.GetInvalidPathChars()) <> -1 - - isInvalidPath (path) || - let directory = Path.GetDirectoryName(path) - let filename = Path.GetFileName(path) - isInvalidDirectory(directory) || isInvalidPath(filename) - - member __.GetTempPathShim() = "." - - member __.GetLastWriteTimeShim (fileName:string) = - match Application.GetResourceStream(System.Uri(fileName,System.UriKind.Relative)) with - | null -> IsolatedStorageFile.GetUserStoreForApplication().GetLastAccessTime(fileName).LocalDateTime - | _resStream -> System.DateTime.Today.Date - member __.SafeExists (fileName:string) = - match Application.GetResourceStream(System.Uri(fileName,System.UriKind.Relative)) with - | null -> IsolatedStorageFile.GetUserStoreForApplication().FileExists fileName - | resStream -> resStream.Stream <> null - member __.FileDelete (fileName:string) = - match Application.GetResourceStream(System.Uri(fileName,System.UriKind.Relative)) with - | null -> IsolatedStorageFile.GetUserStoreForApplication().DeleteFile fileName - | _resStream -> () -#else type DefaultFileSystem() = interface IFileSystem with @@ -1104,14 +1007,9 @@ module Shim = member __.GetLastWriteTimeShim (fileName:string) = File.GetLastWriteTime fileName member __.SafeExists (fileName:string) = System.IO.File.Exists fileName member __.FileDelete (fileName:string) = System.IO.File.Delete fileName -#endif type System.Text.Encoding with static member GetEncodingShim(n:int) = -#if FX_NO_GET_ENCODING_BY_INTEGER - System.Text.Encoding.GetEncoding(n.ToString()) -#else System.Text.Encoding.GetEncoding(n) -#endif let mutable FileSystem = DefaultFileSystem() :> IFileSystem diff --git a/src/absil/ilread.fs b/src/absil/ilread.fs index 8448cce3d5..04be10fc09 100755 --- a/src/absil/ilread.fs +++ b/src/absil/ilread.fs @@ -17,10 +17,7 @@ open System.Collections.Generic open Internal.Utilities open Microsoft.FSharp.Compiler.AbstractIL open Microsoft.FSharp.Compiler.AbstractIL.Internal -#if NO_PDB_READER -#else open Microsoft.FSharp.Compiler.AbstractIL.Internal.Support -#endif open Microsoft.FSharp.Compiler.AbstractIL.Diagnostics open Microsoft.FSharp.Compiler.AbstractIL.Internal.BinaryConstants open Microsoft.FSharp.Compiler.AbstractIL.IL @@ -105,10 +102,6 @@ type BinaryFile() = abstract CountUtf8String : addr:int -> int abstract ReadUTF8String : addr: int -> string -#if FX_NO_NATIVE_MEMORY_MAPPED_FILES - -#else - /// Read file from memory mapped files module MemoryMapping = @@ -216,7 +209,6 @@ type MemoryMappedFile(hMap: MemoryMapping.HANDLE, start:nativeint) = new System.String(NativePtr.ofNativeInt (m.Addr i), 0, n, System.Text.Encoding.UTF8) -#endif //--------------------------------------------------------------------- // Read file from memory blocks //--------------------------------------------------------------------- @@ -919,11 +911,7 @@ type ILReaderContext = { ilg: ILGlobals; dataEndPoints: Lazy; sorted: int64; -#if NO_PDB_READER - pdb: obj option; -#else pdb: (PdbReader * (string -> ILSourceDocument)) option; -#endif entryPointToken: TableName * int; getNumRows: TableName -> int; textSegmentPhysicalLoc : int32; @@ -1461,9 +1449,6 @@ let readBlobHeapAsDouble ctxt vidx = fst (sigptrGetDouble (readBlobHeap ctxt vid // (e) the start of the native resources attached to the binary if any // ----------------------------------------------------------------------*) -#if NO_PDB_READER -let readNativeResources _ctxt = [] -#else let readNativeResources ctxt = let nativeResources = if ctxt.nativeResourcesSize = 0x0 || ctxt.nativeResourcesAddr = 0x0 then @@ -1472,7 +1457,6 @@ let readNativeResources ctxt = [ (lazy (let linkedResource = seekReadBytes ctxt.is (ctxt.anyV2P (ctxt.infile + ": native resources",ctxt.nativeResourcesAddr)) ctxt.nativeResourcesSize unlinkResource ctxt.nativeResourcesAddr linkedResource)) ] nativeResources -#endif let dataEndPoints ctxtH = lazy @@ -2528,9 +2512,6 @@ and seekReadCustomAttr ctxt (TaggedIndex(cat,idx),b) = and seekReadCustomAttrUncached ctxtH (CustomAttrIdx (cat,idx,valIdx)) = let ctxt = getHole ctxtH { Method=seekReadCustomAttrType ctxt (TaggedIndex(cat,idx)); -#if FX_REFLECTION_EMITS_CUSTOM_ATTRIBUTES_USING_BUILDER - Arguments = [], [] -#endif Data= match readBlobHeapOption ctxt valIdx with | Some bytes -> bytes @@ -2886,11 +2867,7 @@ and seekReadTopCode ctxt numtypars (sz:int) start seqpoints = let instrs = ibuf.ToArray() instrs,rawToLabel, lab2pc, raw2nextLab -#if NO_PDB_READER -and seekReadMethodRVA ctxt (_idx,nm,_internalcall,noinline,numtypars) rva = -#else and seekReadMethodRVA ctxt (idx,nm,_internalcall,noinline,numtypars) rva = -#endif mkMethBodyLazyAux (lazy begin @@ -2900,9 +2877,6 @@ and seekReadMethodRVA ctxt (idx,nm,_internalcall,noinline,numtypars) rva = // -- an overall range for the method // -- the sequence points for the method let localPdbInfos, methRangePdbInfo, seqpoints = -#if NO_PDB_READER - [], None, [] -#else match ctxt.pdb with | None -> [], None, [] @@ -2959,7 +2933,6 @@ and seekReadMethodRVA ctxt (idx,nm,_internalcall,noinline,numtypars) rva = with e -> // "* Warning: PDB info for method "+nm+" could not be read and will be ignored: "+e.Message [],None,[] -#endif // NO_PDB_READER let baseRVA = ctxt.anyV2P("method rva",rva) // ": reading body of method "+nm+" at rva "+string rva+", phys "+string baseRVA @@ -3258,8 +3231,6 @@ and seekReadTopExportedTypes ctxt () = done; List.rev !res) -#if NO_PDB_READER -#else let getPdbReader opts infile = match opts.pdbPath with | None -> None @@ -3280,7 +3251,6 @@ let getPdbReader opts infile = let docfun url = if tab.ContainsKey url then tab.[url] else failwith ("Document with URL "+url+" not found in list of documents in the PDB file") Some (pdbr, docfun) with e -> dprintn ("* Warning: PDB file could not be read and will be ignored: "+e.Message); None -#endif //----------------------------------------------------------------------- // Crack the binary headers, build a reader context and return the lazy @@ -3831,11 +3801,7 @@ let rec genOpenBinaryReader infile is opts = //----------------------------------------------------------------------- // Set up the PDB reader so we can read debug info for methods. // ---------------------------------------------------------------------- -#if NO_PDB_READER - let pdb = None -#else let pdb = if runningOnMono then None else getPdbReader opts infile -#endif let rowAddr (tab:TableName) idx = tablePhysLocations.[tab.Index] + (idx - 1) * tableRowSizes.[tab.Index] diff --git a/src/absil/ilreflect.fs b/src/absil/ilreflect.fs index 00469ed9f0..7cca73512e 100755 --- a/src/absil/ilreflect.fs +++ b/src/absil/ilreflect.fs @@ -28,14 +28,9 @@ open System.Collections.Generic let codeLabelOrder = ComparisonIdentity.Structural // Convert the output of convCustomAttr -#if FX_REFLECTION_EMITS_CUSTOM_ATTRIBUTES_USING_BUILDER -let wrapCustomAttr setCustomAttr (cinfo, cinfoBuilder) = - setCustomAttr(cinfoBuilder cinfo) -#else open Microsoft.FSharp.Compiler.AbstractIL.ILAsciiWriter let wrapCustomAttr setCustomAttr (cinfo, bytes) = setCustomAttr(cinfo, bytes) -#endif //---------------------------------------------------------------------------- @@ -65,12 +60,9 @@ type System.Reflection.Emit.AssemblyBuilder with if logRefEmitCalls then printfn "assemblyBuilder%d.SetCustomAttribute(%A, %A)" (abs <| hash asmB) cinfo bytes wrapCustomAttr asmB.SetCustomAttribute (cinfo, bytes) -#if FX_NO_REFLECTION_EMIT_RESOURCE_FILE -#else member asmB.AddResourceFileAndLog(nm1, nm2, attrs) = if logRefEmitCalls then printfn "assemblyBuilder%d.AddResourceFile(%A, %A, enum %d)" (abs <| hash asmB) nm1 nm2 (LanguagePrimitives.EnumToValue attrs) asmB.AddResourceFile(nm1,nm2,attrs) -#endif member asmB.SetCustomAttributeAndLog(cab) = if logRefEmitCalls then printfn "assemblyBuilder%d.SetCustomAttribute(%A)" (abs <| hash asmB) cab @@ -196,12 +188,9 @@ type System.Reflection.Emit.TypeBuilder with if logRefEmitCalls then printfn "typeBuilder%d.AddInterfaceImplementation(%A)" (abs <| hash typB) ty typB.AddInterfaceImplementation(ty) -#if FX_NO_INVOKE_MEMBER -#else member typB.InvokeMemberAndLog(nm,flags,args) = if logRefEmitCalls then printfn "typeBuilder%d.InvokeMember(\"%s\",enum %d,null,null,%A,Globalization.CultureInfo.InvariantCulture)" (abs <| hash typB) nm (LanguagePrimitives.EnumToValue flags) args typB.InvokeMember(nm,flags,null,null,args,Globalization.CultureInfo.InvariantCulture) -#endif member typB.SetCustomAttributeAndLog(cinfo,bytes) = if logRefEmitCalls then printfn "typeBuilder%d.SetCustomAttribute(%A, %A)" (abs <| hash typB) cinfo bytes @@ -595,35 +584,6 @@ let convFieldInit x = | ILFieldInit.Double ieee64 -> box ieee64 | ILFieldInit.Null -> (null :> Object) -#if FX_REFLECTION_EMITS_CUSTOM_ATTRIBUTES_USING_BUILDER -//---------------------------------------------------------------------------- -// convAttribElem -//---------------------------------------------------------------------------- - -let rec convAttribElem cenv emEnv = function - | ILAttribElem.String (Some x) -> box x - | ILAttribElem.String None -> null - | ILAttribElem.Bool x -> box x - | ILAttribElem.Char x -> box x - | ILAttribElem.SByte x -> box x - | ILAttribElem.Int16 x -> box x - | ILAttribElem.Int32 x -> box x - | ILAttribElem.Int64 x -> box x - | ILAttribElem.Byte x -> box x - | ILAttribElem.UInt16 x -> box x - | ILAttribElem.UInt32 x -> box x - | ILAttribElem.UInt64 x -> box x - | ILAttribElem.Single x -> box x - | ILAttribElem.Double x -> box x - | ILAttribElem.Null -> null - | ILAttribElem.Type (Some t) -> box <| convCreatedType cenv emEnv t - | ILAttribElem.Type None -> null - | ILAttribElem.TypeRef (Some t) -> box <| envGetTypT cenv emEnv true t - | ILAttribElem.TypeRef None -> null - | ILAttribElem.Array (_, a) -> box [| for i in a -> convAttribElem cenv emEnv i |] - -#endif - //---------------------------------------------------------------------------- // Some types require hard work... //---------------------------------------------------------------------------- @@ -870,14 +830,8 @@ let emitInstrNewobj cenv emEnv (ilG:ILGenerator) mspec varargs = | Some _vartyps -> failwith "emit: pending new varargs" // XXX - gap let emitSilverlightCheck (ilG:ILGenerator) = -#if DYNAMIC_CODE_EMITS_INTERRUPT_CHECKS - if Microsoft.FSharp.Silverlight.EmitInterruptChecks then - let methWL = typeof.GetMethod("CheckInterrupt", BindingFlags.Static ||| BindingFlags.Public ||| BindingFlags.NonPublic, null, [||], null) - ilG.EmitCall(OpCodes.Call, methWL, [||]) -#else ignore ilG () -#endif let emitInstrCall cenv emEnv (ilG:ILGenerator) opCall tail (mspec:ILMethodSpec) varargs = emitInstrTail ilG tail (fun () -> @@ -888,16 +842,6 @@ let emitInstrCall cenv emEnv (ilG:ILGenerator) opCall tail (mspec:ILMethodSpec) | Some _vartyps -> failwith "emitInstrCall: .ctor and varargs" else let minfo = convMethodSpec cenv emEnv mspec -#if DYNAMIC_CODE_REWRITES_CONSOLE_WRITE - // When generating code for silverlight, we intercept direct - // calls to System.Console.WriteLine. - let fullName = minfo.DeclaringType.FullName + "." + minfo.Name - let minfo = - if fullName = "System.Console.WriteLine" || fullName = "System.Console.Write" then - let args = minfo.GetParameters() |> Array.map (fun x -> x.ParameterType) - typeof.GetMethod(minfo.Name, BindingFlags.Static ||| BindingFlags.Public ||| BindingFlags.NonPublic, null, args, null) - else minfo -#endif match varargs with | None -> ilG.EmitAndLog(opCall,minfo) | Some vartyps -> ilG.EmitCall (opCall,minfo,convTypesToArray cenv emEnv vartyps) @@ -1069,11 +1013,6 @@ let rec emitInstr cenv (modB : ModuleBuilder) emEnv (ilG:ILGenerator) instr = emitInstrCall cenv emEnv ilG OpCodes.Callvirt tail mspec varargs | I_callconstraint (tail,typ,mspec,varargs) -> ilG.Emit(OpCodes.Constrained,convType cenv emEnv typ); emitInstrCall cenv emEnv ilG OpCodes.Callvirt tail mspec varargs -#if FX_NO_REFLECTION_EMIT_CALLI - | I_calli (tail,_callsig,None) -> emitInstrTail ilG tail (fun () -> ()) - | I_calli (tail,_callsig,Some _vartyps) -> emitInstrTail ilG tail (fun () -> ()) -#else - | I_calli (tail,callsig,None) -> emitInstrTail ilG tail (fun () -> ilG.EmitCalli(OpCodes.Calli, convCallConv callsig.CallingConv, @@ -1086,7 +1025,6 @@ let rec emitInstr cenv (modB : ModuleBuilder) emEnv (ilG:ILGenerator) instr = convType cenv emEnv callsig.ReturnType, convTypesToArray cenv emEnv callsig.ArgTypes, convTypesToArray cenv emEnv vartyps)) -#endif | I_ldftn mspec -> ilG.EmitAndLog(OpCodes.Ldftn,convMethodSpec cenv emEnv mspec) | I_newobj (mspec,varargs) -> emitInstrNewobj cenv emEnv ilG mspec varargs | I_throw -> ilG.EmitAndLog(OpCodes.Throw) @@ -1333,24 +1271,7 @@ let convCustomAttr cenv emEnv cattr = match convConstructorSpec cenv emEnv cattr.Method with | null -> failwithf "convCustomAttr: %+A" cattr.Method | res -> res -// In Silverlight, we cannot use the byte[] data to generate attributes (security restriction). -// Instead, we return a function which creates a CustomAttributeBuilder to be used for SetCustomAttributes. -#if FX_REFLECTION_EMITS_CUSTOM_ATTRIBUTES_USING_BUILDER - let ty : System.Type = convType cenv emEnv cattr.Method.EnclosingType - let convAttrArray arr = [|for i in arr -> convAttribElem cenv emEnv i|] - - let fixedArgs, namedArgs = cattr.Arguments - let prop, fields = List.partition (fun (_, _, isProp, _) -> isProp) namedArgs - let prop = prop |> List.map (fun (name, _, _, value) -> ty.GetProperty(name), value) |> List.toArray - let fields = fields |> List.map (fun (name, _, _, value) -> ty.GetField(name), value) |> List.toArray - - let data (cinfo: ConstructorInfo) = - CustomAttributeBuilder(cinfo, convAttrArray fixedArgs, - Array.map fst prop, convAttrArray (Array.map snd prop), - Array.map fst fields, convAttrArray (Array.map snd fields)) -#else let data = cattr.Data -#endif (methInfo,data) let emitCustomAttr cenv emEnv add cattr = add (convCustomAttr cenv emEnv cattr) @@ -1510,9 +1431,6 @@ let rec buildMethodPass2 cenv tref (typB:TypeBuilder) emEnv (mdef : ILMethodDef) (* p.CharBestFit *) (* p.NoMangle *) -#if FX_NO_REFLECTION_EMIT_PINVOKE - failwith "PInvoke methods may not be defined when targeting Silverlight via System.Reflection.Emit" -#else let methB = typB.DefinePInvokeMethod(mdef.Name, p.Where.Name, p.Name, @@ -1526,7 +1444,6 @@ let rec buildMethodPass2 cenv tref (typB:TypeBuilder) emEnv (mdef : ILMethodDef) pcs) methB.SetImplementationFlagsAndLog(implflags); envBindMethodRef emEnv mref methB -#endif | _ -> match mdef.Name with @@ -1620,12 +1537,9 @@ let buildFieldPass2 cenv tref (typB:TypeBuilder) emEnv (fdef : ILFieldDef) = let attrs = attrsAccess ||| attrsOther let fieldT = convType cenv emEnv fdef.Type let fieldB = -#if FX_NO_REFLECTION_EMIT_STATIC_DATA -#else match fdef.Data with | Some d -> typB.DefineInitializedData(fdef.Name, d, attrs) | None -> -#endif typB.DefineFieldAndLog(fdef.Name,fieldT,attrs) // set default value @@ -1646,10 +1560,7 @@ let buildFieldPass2 cenv tref (typB:TypeBuilder) emEnv (fdef : ILFieldDef) = // => here we cannot detect if underlying type is already set so as a conservative solution we delay initialization of fields // to the end of pass2 (types and members are already created but method bodies are yet not emitted) { emEnv with delayedFieldInits = (fun() -> fieldB.SetConstant(convFieldInit initial))::emEnv.delayedFieldInits } -#if FX_NO_REFLECTION_EMIT_STATIC_DATA -#else fdef.Offset |> Option.iter (fun offset -> fieldB.SetOffset(offset)); -#endif // custom attributes: done on pass 3 as they may reference attribute constructors generated on // pass 2. let fref = mkILFieldRef (tref,fdef.Name,fdef.Type) @@ -1955,9 +1866,6 @@ let createTypeRef (visited : Dictionary<_,_>, created : Dictionary<_,_>) emEnv t visited.[tref] <- priority; let tdef = envGetTypeDef emEnv tref if verbose2 then dprintf "- traversing type %s\n" typB.FullName; -#if FX_NO_TYPE_RESOLVE_EVENT - traverseTypeDef priority tref tdef; -#else let typeCreationHandler = let nestingToProbe = tref.Enclosing ResolveEventHandler( @@ -1976,7 +1884,6 @@ let createTypeRef (visited : Dictionary<_,_>, created : Dictionary<_,_>) emEnv t traverseTypeDef priority tref tdef; finally System.AppDomain.CurrentDomain.remove_TypeResolve typeCreationHandler -#endif if not (created.ContainsKey(tref)) then created.[tref] <- true; if verbose2 then dprintf "- creating type %s\n" typB.FullName; @@ -2034,11 +1941,7 @@ let buildModuleFragment cenv emEnv (asmB : AssemblyBuilder) (modB : ModuleBuilde | ILResourceLocation.Local bf -> modB.DefineManifestResourceAndLog(r.Name, new System.IO.MemoryStream(bf()), attribs) | ILResourceLocation.File (mr,_n) -> -#if FX_NO_REFLECTION_EMIT_RESOURCE_FILE - () -#else asmB.AddResourceFileAndLog(r.Name, mr.Name, attribs) -#endif | ILResourceLocation.Assembly _ -> failwith "references to resources other assemblies may not be emitted using System.Reflection"); emEnv @@ -2050,14 +1953,9 @@ let buildModuleFragment cenv emEnv (asmB : AssemblyBuilder) (modB : ModuleBuilde let mkDynamicAssemblyAndModule (assemblyName, optimize, debugInfo, collectible) = let filename = assemblyName ^ ".dll" let currentDom = System.AppDomain.CurrentDomain - let asmName = new AssemblyName() - asmName.Name <- assemblyName -#if FX_NO_REFLECTION_EMIT_SAVE_ASSEMBLY - ignore optimize - let asmB = currentDom.DefineDynamicAssembly(asmName,AssemblyBuilderAccess.Run) - let modB = asmB.DefineDynamicModule(filename,debugInfo) -#else let asmDir = "." + let asmName = new AssemblyName() + asmName.Name <- assemblyName; let asmAccess = if collectible then AssemblyBuilderAccess.RunAndCollect else AssemblyBuilderAccess.RunAndSave let asmB = currentDom.DefineDynamicAssemblyAndLog(asmName,asmAccess,asmDir) if not optimize then @@ -2067,13 +1965,8 @@ let mkDynamicAssemblyAndModule (assemblyName, optimize, debugInfo, collectible) asmB.SetCustomAttributeAndLog(daBuilder); let modB = asmB.DefineDynamicModuleAndLog(assemblyName,filename,debugInfo) -#endif asmB,modB -#if FX_NO_INVOKE_MEMBER -type EntryDelegate = delegate of unit -> unit -#endif - let emitModuleFragment (ilg, emEnv, asmB : AssemblyBuilder, modB : ModuleBuilder, modul : IL.ILModuleDef, debugInfo : bool, resolvePath) = let cenv = { ilg = ilg ; generatePdb = debugInfo; resolvePath=resolvePath } @@ -2086,18 +1979,7 @@ let emitModuleFragment (ilg, emEnv, asmB : AssemblyBuilder, modB : ModuleBuilder // invoke entry point methods let execEntryPtFun ((typB : TypeBuilder),methodName) () = try -#if FX_NO_INVOKE_MEMBER - let mi = typB.GetMethod(methodName, BindingFlags.InvokeMethod ||| BindingFlags.Public ||| BindingFlags.Static) - System.Diagnostics.Debug.WriteLine("mi: {0}", string(mi.ToString())) - let dm = DynamicMethod((methodName+"dm"),null,null) - let ilg = dm.GetILGenerator(); - ilg.EmitCall(OpCodes.Call,mi,null) - ilg.Emit(OpCodes.Ret) - let invokedm = dm.CreateDelegate(typeof) - invokedm.DynamicInvoke(null) |> ignore -#else ignore (typB.InvokeMemberAndLog(methodName,BindingFlags.InvokeMethod ||| BindingFlags.Public ||| BindingFlags.Static,[| |])); -#endif None with | :? System.Reflection.TargetInvocationException as e -> diff --git a/src/absil/ilsupp.fs b/src/absil/ilsupp.fs index 58d1c60bdc..e02283ae03 100755 --- a/src/absil/ilsupp.fs +++ b/src/absil/ilsupp.fs @@ -7,13 +7,6 @@ let DateTime1970Jan01 = new System.DateTime(1970,1,1,0,0,0,System.DateTimeKind.U let absilWriteGetTimeStamp () = (System.DateTime.UtcNow - DateTime1970Jan01).TotalSeconds |> int -#if NO_PDB_READER -type PdbReader = | NeverImplemented -let pdbReadClose (_pdb:PdbReader) = () -type PdbWriter = | NeverImplemented -let pdbInitialize (_:string) (_:string) = PdbWriter.NeverImplemented -#else - open Internal.Utilities open Microsoft.FSharp.Compiler.AbstractIL open Microsoft.FSharp.Compiler.AbstractIL.Internal @@ -1500,4 +1493,3 @@ let signerSignFileWithKeyContainer fileName kcName = let iclrSN = getICLRStrongName() iclrSN.StrongNameSignatureGeneration(fileName, kcName, Unchecked.defaultof, 0u, ppb, &pcb) |> ignore iclrSN.StrongNameSignatureVerificationEx(fileName, true, &ok) |> ignore -#endif diff --git a/src/absil/ilsupp.fsi b/src/absil/ilsupp.fsi index 02d351863e..8c8b07de5e 100755 --- a/src/absil/ilsupp.fsi +++ b/src/absil/ilsupp.fsi @@ -15,8 +15,6 @@ val pdbInitialize : string -> string -> PdbWriter val absilWriteGetTimeStamp: unit -> int32 -#if NO_PDB_READER -#else open System open System.Runtime.InteropServices open System.Diagnostics.SymbolStore @@ -125,5 +123,4 @@ val signerGetPublicKeyForKeyContainer: string -> pubkey val signerCloseKeyContainer: keyContainerName -> unit val signerSignatureSize: pubkey -> int val signerSignFileWithKeyPair: string -> keyPair -> unit -val signerSignFileWithKeyContainer: string -> keyContainerName -> unit -#endif +val signerSignFileWithKeyContainer: string -> keyContainerName -> unit diff --git a/src/absil/ilwrite.fs b/src/absil/ilwrite.fs index 65437f5847..8f01c05026 100755 --- a/src/absil/ilwrite.fs +++ b/src/absil/ilwrite.fs @@ -28,9 +28,6 @@ let showEntryLookups = false //--------------------------------------------------------------------- let reportTime = -#if FX_NO_PROCESS_DIAGNOSTICS - (fun _ _ -> ()) -#else let tFirst = ref None let tPrev = ref None fun showTimes descr -> @@ -40,7 +37,6 @@ let reportTime = let first = match !tFirst with None -> (tFirst := Some t; t) | Some t -> t dprintf "ilwrite: TIME %10.3f (total) %10.3f (delta) - %s\n" (t - first) (t - prev) descr tPrev := Some t -#endif //--------------------------------------------------------------------- // Byte, byte array fragments and other concrete representations @@ -225,8 +221,6 @@ type PdbData = // imperative calls to the Symbol Writer API. //--------------------------------------------------------------------- -#if NO_PDB_WRITER -#else let WritePdbInfo fixupOverlappingSequencePoints showTimes f fpdb info = (try FileSystem.FileDelete fpdb with _ -> ()) let pdbw = ref Unchecked.defaultof @@ -340,8 +334,6 @@ let WritePdbInfo fixupOverlappingSequencePoints showTimes f fpdb info = reportTime showTimes "PDB: Closed" res -#endif - //--------------------------------------------------------------------- // Support functions for calling 'Mono.CompilerServices.SymbolWriter' // assembly dynamically if it is available to the compiler @@ -489,19 +481,6 @@ let DumpDebugInfo (outfile:string) (info:PdbData) = // Strong name signing //--------------------------------------------------------------------- -#if NO_STRONGNAME_SIGNER -type ILStrongNameSigner = - | NeverImplemented - static member OpenPublicKeyFile (_s:string) = NeverImplemented - static member OpenPublicKey (_pubkey:byte[]) = NeverImplemented - static member OpenKeyPairFile (_s:string) = NeverImplemented - static member OpenKeyContainer (_s:string) = NeverImplemented - member s.Close() = () - member s.IsFullySigned = true - member s.PublicKey = [| |] - member s.SignatureSize = 0x80 - member s.SignFile _file = () -#else type ILStrongNameSigner = | PublicKeySigner of Support.pubkey | KeyPair of Support.keyPair @@ -544,8 +523,6 @@ type ILStrongNameSigner = | KeyPair kp -> Support.signerSignFileWithKeyPair file kp | KeyContainer kn -> Support.signerSignFileWithKeyContainer file kn -#endif - //--------------------------------------------------------------------- // TYPES FOR TABLES //--------------------------------------------------------------------- @@ -4072,9 +4049,6 @@ let writeBinaryAndReportMappings (outfile, ilg, pdbfile: string option, signer: let dataSectionAddr = next let dataSectionVirtToPhys v = v - dataSectionAddr + dataSectionPhysLoc -#if NO_NATIVE_RESOURCES - let nativeResources = [| |] -#else let resourceFormat = if modul.Is64Bit then Support.X64 else Support.X86 let nativeResources = @@ -4089,7 +4063,6 @@ let writeBinaryAndReportMappings (outfile, ilg, pdbfile: string option, signer: try linkNativeResources unlinkedResources next resourceFormat (Path.GetDirectoryName(outfile)) with e -> failwith ("Linking a native resource failed: "+e.Message+"") end -#endif let nativeResourcesSize = nativeResources.Length @@ -4511,8 +4484,6 @@ let writeBinaryAndReportMappings (outfile, ilg, pdbfile: string option, signer: if dumpDebugInfo then DumpDebugInfo outfile pdbData -#if NO_PDB_WRITER -#else // Now we've done the bulk of the binary, do the PDB file and fixup the binary. begin match pdbfile with | None -> () @@ -4559,7 +4530,6 @@ let writeBinaryAndReportMappings (outfile, ilg, pdbfile: string option, signer: reraise() end -#endif reportTime showTimes "Finalize PDB" /// Sign the binary. No further changes to binary allowed past this point! diff --git a/src/fsharp/CheckFormatStrings.fs b/src/fsharp/CheckFormatStrings.fs index 8fdc4bfe74..f015bef9b3 100755 --- a/src/fsharp/CheckFormatStrings.fs +++ b/src/fsharp/CheckFormatStrings.fs @@ -297,9 +297,9 @@ let ParseFormatString m g source fmt bty cty dty = let ety = mkTupledTy g argtys (aty, ety), specifierLocations -let TryCountFormatStringArguments m g source fmt bty cty = +let TryCountFormatStringArguments m g fmt bty cty = try - let argtys, _specifierLocations = parseFormatStringInternal m g source fmt bty cty + let argtys, _specifierLocations = parseFormatStringInternal m g None fmt bty cty Some argtys.Length with _ -> None diff --git a/src/fsharp/CheckFormatStrings.fsi b/src/fsharp/CheckFormatStrings.fsi index d6562493c8..a3af9f5b32 100755 --- a/src/fsharp/CheckFormatStrings.fsi +++ b/src/fsharp/CheckFormatStrings.fsi @@ -15,4 +15,4 @@ open Microsoft.FSharp.Compiler.AbstractIL.Internal val ParseFormatString : Range.range -> TcGlobals -> source: string option -> fmt: string -> bty: TType -> cty: TType -> dty: TType -> (TType * TType) * Range.range list -val TryCountFormatStringArguments : m:Range.range -> g:TcGlobals -> source: string option -> fmt:string -> bty:TType -> cty:TType -> int option +val TryCountFormatStringArguments : m:Range.range -> g:TcGlobals -> fmt:string -> bty:TType -> cty:TType -> int option diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index 30df553b4e..4bb1b30be7 100755 --- a/src/fsharp/CompileOps.fs +++ b/src/fsharp/CompileOps.fs @@ -1440,7 +1440,7 @@ let CollectErrorOrWarning (implicitIncludeDir,showFullPaths,flattenErrors,errorS | ReportedError _ -> dprintf "Unexpected ReportedError" (* this should actually never happen *) Seq.empty - | StopProcessing _ -> + | StopProcessing -> dprintf "Unexpected StopProcessing" (* this should actually never happen *) Seq.empty | _ -> @@ -1597,7 +1597,7 @@ let DefaultBasicReferencesForOutOfProjectSources = #if CROSS_PLATFORM_COMPILER // Mono doesn't have System.Runtime available on all versions, or at least the - // reference is not foun by reference resolution. This is a temporary + // reference is not found by reference resolution. This is a temporary // but inadequate workaround for that issue. #else yield "System.Runtime" @@ -2474,6 +2474,7 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = if v1 = 1us then warning(Error(FSComp.SR.buildRequiresCLI2(filename),rangeStartup)) let clrRoot = Some(Path.GetDirectoryName(FileSystem.GetFullPathShim(filename))) + clrRoot, (int v1, sprintf "v%d.%d" v1 v2), (v1=5us && v2=0us && v3=5us) // SL5 mscorlib is 5.0.5.0 | _ -> failwith (FSComp.SR.buildCouldNotReadVersionInfoFromMscorlib()) @@ -2674,11 +2675,6 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = | Some x -> [tcConfig.MakePathAbsolute x] | None -> -#if NO_MSBUILD_REFERENCE_RESOLUTION - [] -#else - // When running on Mono we lead everyone to believe we're doing .NET 4.0 compilation - // by default. Why? See https://github.com/fsharp/fsharp/issues/99 if runningOnMono then [System.Runtime.InteropServices.RuntimeEnvironment.GetRuntimeDirectory()] else @@ -2692,7 +2688,6 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = [frameworkRootVersion] with e -> errorRecovery e range0; [] -#endif member tcConfig.ComputeLightSyntaxInitialStatus filename = use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.Parameter) @@ -2847,8 +2842,6 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = // it must return warnings and errors as data // // NOTE!! if mode=ReportErrors then this method must not raise exceptions. It must just report the errors and recover -#if NO_MSBUILD_REFERENCE_RESOLUTION -#else static member TryResolveLibsUsingMSBuildRules (tcConfig:TcConfig,originalReferences:AssemblyReference list, errorAndWarningRange:range, mode:ResolveAssemblyReferenceMode) : AssemblyResolution list * UnresolvedAssemblyReference list = use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.Parameter) @@ -3000,7 +2993,6 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = else resultingResolutions,unresolvedReferences |> List.map (fun (name, _, r) -> (name, r)) |> List.map UnresolvedAssemblyReference -#endif // NO_MSBUILD_REFERENCE_RESOLUTION member tcConfig.PrimaryAssemblyDllReference() = primaryAssemblyReference member tcConfig.GetPrimaryAssemblyCcuInitializer() = primaryAssemblyCcuInitializer @@ -3280,8 +3272,6 @@ let ParseOneInputLexbuf (tcConfig:TcConfig,lexResourceManager,conditionalCompila if verbose then dprintn ("Parsing... "+shortFilename); let tokenizer = LexFilter.LexFilter(lightSyntaxStatus, tcConfig.compilingFslib, Lexer.token lexargs skip, lexbuf) -#if LIMITED_CONNSOLE -#else if tcConfig.tokenizeOnly then while true do printf "tokenize - getting one token from %s\n" shortFilename; @@ -3296,7 +3286,6 @@ let ParseOneInputLexbuf (tcConfig:TcConfig,lexResourceManager,conditionalCompila | IDefns(l,m) -> dprintf "Parsed OK, got %d defs @ %a\n" l.Length outputRange m; | IHash (_,m) -> dprintf "Parsed OK, got hash @ %a\n" outputRange m; exit 0; -#endif let res = ParseInput(tokenizer.Lexer,errorLogger,lexbuf,None,filename,isLastCompiland) @@ -4125,11 +4114,7 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti let ilScopeRef = dllinfo.ILScopeRef let ilShortAssemName = getNameOfScopeRef ilScopeRef if verbose then dprintn ("Converting F# assembly to F# data structures "+(getNameOfScopeRef ilScopeRef)) - //let attrs = GetCustomAttributesOfIlModule ilModule - //assert (List.exists IsSignatureDataVersionAttr attrs); if verbose then dprintn ("Relinking interface info from F# assembly "+ilShortAssemName) - //if not(List.contains ilShortAssemName externalSigAndOptData) then - // assert (List.exists IsSignatureDataResource resources); let optDataReaders = ilModule.GetRawFSharpOptimizationData(m, ilShortAssemName, filename) let ccuRawDataAndInfos = diff --git a/src/fsharp/CompileOptions.fs b/src/fsharp/CompileOptions.fs index db2110838f..efd1778ea9 100755 --- a/src/fsharp/CompileOptions.fs +++ b/src/fsharp/CompileOptions.fs @@ -102,11 +102,7 @@ let compilerOptionUsage (CompilerOption(s,tag,spec,_,_)) = let PrintCompilerOption (CompilerOption(_s,_tag,_spec,_,help) as compilerOption) = let flagWidth = 30 // fixed width for printing of flags, e.g. --warnaserror: let defaultLineWidth = 80 // the fallback width -#if LIMITED_CONSOLE - let lineWidth = defaultLineWidth -#else let lineWidth = try System.Console.BufferWidth with e -> defaultLineWidth -#endif let lineWidth = if lineWidth=0 then defaultLineWidth else lineWidth (* Have seen BufferWidth=0 on Linux/Mono *) // Lines have this form: // flagWidth chars - for flags description or padding on continuation lines. @@ -1253,10 +1249,6 @@ let GetGeneratedILModuleName (t:CompilerTarget) (s:string) = let ignoreFailureOnMono1_1_16 f = try f() with _ -> () let DoWithErrorColor isWarn f = -#if LIMITED_CONSOLE - ignore (isWarn : bool) - f() -#else if not enableConsoleColoring then f() else @@ -1277,7 +1269,6 @@ let DoWithErrorColor isWarn f = f(); finally ignoreFailureOnMono1_1_16 (fun () -> Console.ForegroundColor <- c) -#endif diff --git a/src/fsharp/ErrorLogger.fs b/src/fsharp/ErrorLogger.fs index 7d386c0b7a..2637123c9b 100755 --- a/src/fsharp/ErrorLogger.fs +++ b/src/fsharp/ErrorLogger.fs @@ -38,8 +38,9 @@ let rec findOriginalException err = /// Thrown when we stop processing the F# Interactive entry or #load. -exception StopProcessing of exn option - +exception StopProcessingExn of exn option +let (|StopProcessing|_|) exn = match exn with StopProcessingExn _ -> Some () | _ -> None +let StopProcessing<'T> = StopProcessingExn None (* common error kinds *) exception NumberedError of (int * string) * range with // int is e.g. 191 in FS0191 @@ -109,13 +110,10 @@ type Exiter = let QuitProcessExiter = { new Exiter with member x.Exit(n) = -#if FX_NO_SYSTEM_ENVIRONMENT_EXIT -#else try System.Environment.Exit(n) with _ -> () -#endif failwithf "%s" <| FSComp.SR.elSysEnvExitDidntExit() } /// Closed enumeration of build phases. @@ -282,8 +280,6 @@ type internal CompileThreadStatic = module ErrorLoggerExtensions = open System.Reflection -#if NO_WATSON_DUMPS -#else // Instruct the exception not to reset itself when thrown again. // Why don?t we just not catch these in the first place? Because we made the design choice to ask the user to send mail to fsbugs@microsoft.com. // To achieve this, we need to catch the exception, report the email address and stack trace, and then reraise. @@ -310,11 +306,10 @@ module ErrorLoggerExtensions = PreserveStackTrace(exn) raise exn | _ -> () -#endif type ErrorLogger with - member x.ErrorR exn = match exn with StopProcessing _ | ReportedError _ -> raise exn | _ -> x.ErrorSink(PhasedError.Create(exn,CompileThreadStatic.BuildPhase)) - member x.Warning exn = match exn with StopProcessing _ | ReportedError _ -> raise exn | _ -> x.WarnSink(PhasedError.Create(exn,CompileThreadStatic.BuildPhase)) + member x.ErrorR exn = match exn with StopProcessing | ReportedError _ -> raise exn | _ -> x.ErrorSink(PhasedError.Create(exn,CompileThreadStatic.BuildPhase)) + member x.Warning exn = match exn with StopProcessing | ReportedError _ -> raise exn | _ -> x.WarnSink(PhasedError.Create(exn,CompileThreadStatic.BuildPhase)) member x.Error exn = x.ErrorR exn; raise (ReportedError (Some exn)) member x.PhasedError (ph:PhasedError) = x.ErrorSink ph @@ -326,14 +321,11 @@ module ErrorLoggerExtensions = (* Don't send ThreadAbortException down the error channel *) | :? System.Threading.ThreadAbortException | WrappedError((:? System.Threading.ThreadAbortException),_) -> () | ReportedError _ | WrappedError(ReportedError _,_) -> () - | StopProcessing _ | WrappedError(StopProcessing _,_) -> raise exn + | StopProcessing | WrappedError(StopProcessing,_) -> raise exn | _ -> try x.ErrorR (AttachRange m exn) // may raise exceptions, e.g. an fsi error sink raises StopProcessing. -#if NO_WATSON_DUMPS -#else ReraiseIfWatsonable(exn) -#endif with | ReportedError _ | WrappedError(ReportedError _,_) -> () member x.StopProcessingRecovery (exn:exn) (m:range) = @@ -342,11 +334,11 @@ module ErrorLoggerExtensions = // Additionally ignore/catch ReportedError. // Can throw other exceptions raised by the ErrorSink(exn) handler. match exn with - | StopProcessing _ | WrappedError(StopProcessing _,_) -> () // suppress, so skip error recovery. + | StopProcessing | WrappedError(StopProcessing,_) -> () // suppress, so skip error recovery. | _ -> try x.ErrorRecovery exn m with - | StopProcessing _ | WrappedError(StopProcessing _,_) -> () // catch, e.g. raised by ErrorSink. + | StopProcessing | WrappedError(StopProcessing,_) -> () // catch, e.g. raised by ErrorSink. | ReportedError _ | WrappedError(ReportedError _,_) -> () // catch, but not expected unless ErrorRecovery is changed. member x.ErrorRecoveryNoRange (exn:exn) = x.ErrorRecovery exn range0 diff --git a/src/fsharp/ExtensionTyping.fs b/src/fsharp/ExtensionTyping.fs index aa253e486d..6c15899545 100755 --- a/src/fsharp/ExtensionTyping.fs +++ b/src/fsharp/ExtensionTyping.fs @@ -386,9 +386,6 @@ module internal ExtensionTyping = abstract GetXmlDocAttributes : provider:ITypeProvider -> string[] abstract GetHasTypeProviderEditorHideMethodsAttribute : provider:ITypeProvider -> bool abstract GetAttributeConstructorArgs: provider:ITypeProvider * attribName:string -> (obj option list * (string * obj option) list) option -#if EXPOSE_ATTRIBS_OF_PROVIDED_SYMBOLS - abstract GetAttributes : provider:ITypeProvider -> CustomAttributeData list -#endif and ProvidedCustomAttributeProvider = static member Create (attributes :(ITypeProvider -> System.Collections.Generic.IList)) : IProvidedCustomAttributeProvider = @@ -411,12 +408,6 @@ module internal ExtensionTyping = |> List.map (fun arg -> arg.MemberInfo.Name, match arg.TypedValue with Arg null -> None | Arg obj -> Some obj | _ -> None) ctorArgs, namedArgs) -#if EXPOSE_ATTRIBS_OF_PROVIDED_SYMBOLS - member __.GetAttributes (provider) = - attributes(provider) - |> Seq.toList -#endif - member __.GetHasTypeProviderEditorHideMethodsAttribute provider = attributes(provider) |> Seq.exists (findAttrib typeof) @@ -488,11 +479,7 @@ module internal ExtensionTyping = and [] ProvidedAssembly (x: System.Reflection.Assembly, _ctxt) = -#if FX_NO_ASSEMBLY_GET_NAME - member __.GetName() = System.Reflection.AssemblyName(x.FullName) -#else member __.GetName() = x.GetName() -#endif member __.FullName = x.FullName member __.GetManifestModuleContents(provider: ITypeProvider) = provider.GetGeneratedAssemblyContents(x) static member Create ctxt x = match x with null -> null | t -> ProvidedAssembly (t,ctxt) @@ -528,7 +515,8 @@ module internal ExtensionTyping = let staticParams = match provider with -#if COMPILER_SERVICE_ASSUMES_FSHARP_CORE_4_4_0_0 +#if COMPILER_SERVICE_ASSUMES_FSHARP_CORE_4_3_0_0 +#else | :? ITypeProvider2 as itp2 -> itp2.GetStaticParametersForMethod(x) #endif @@ -546,7 +534,8 @@ module internal ExtensionTyping = let mb = match provider with -#if COMPILER_SERVICE_ASSUMES_FSHARP_CORE_4_4_0_0 +#if COMPILER_SERVICE_ASSUMES_FSHARP_CORE_4_3_0_0 +#else | :? ITypeProvider2 as itp2 -> itp2.ApplyStaticArgumentsForMethod(x, fullNameAfterArguments, staticArgs) #endif diff --git a/src/fsharp/ExtensionTyping.fsi b/src/fsharp/ExtensionTyping.fsi index 870013ab9f..5924f1312a 100755 --- a/src/fsharp/ExtensionTyping.fsi +++ b/src/fsharp/ExtensionTyping.fsi @@ -145,9 +145,6 @@ module internal ExtensionTyping = abstract GetDefinitionLocationAttribute : provider:ITypeProvider -> (string * int * int) option abstract GetXmlDocAttributes : provider:ITypeProvider -> string[] abstract GetAttributeConstructorArgs: provider:ITypeProvider * attribName:string -> (obj option list * (string * obj option) list) option -#if EXPOSE_ATTRIBS_OF_PROVIDED_SYMBOLS - abstract GetAttributes: provider:ITypeProvider -> System.Reflection.CustomAttributeData list -#endif and [] ProvidedAssembly = diff --git a/src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj b/src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj index 036a26d801..7fd5c26459 100644 --- a/src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj +++ b/src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj @@ -38,6 +38,8 @@ $(DefineConstants);INCLUDE_METADATA_WRITER $(DefineConstants);COMPILER $(DefineConstants);EXTENSIONTYPING + $(DefineConstants);COMPILER_SERVICE_ASSUMES_FSHARP_CORE_4_3_0_0 + $(DefineConstants);COMPILER_SERVICE $(DefineConstants);NO_STRONG_NAMES $(DefineConstants);TRACE 4.3.0.0 diff --git a/src/fsharp/LexFilter.fs b/src/fsharp/LexFilter.fs index e9b2eeed8b..ccdd86a4dc 100755 --- a/src/fsharp/LexFilter.fs +++ b/src/fsharp/LexFilter.fs @@ -415,7 +415,7 @@ type TokenTup = val Token : token val LexbufState : LexbufState val LastTokenPos: PositionTuple - new (token,state,lastTokenPos) = { Token=token; LexbufState=state; LastTokenPos=lastTokenPos } + new (token,state,lastTokenPos) = { Token=token; LexbufState=state;LastTokenPos=lastTokenPos } /// Returns starting position of the token member x.StartPos = x.LexbufState.StartPos diff --git a/src/fsharp/NicePrint.fs b/src/fsharp/NicePrint.fs index 370ec9b6fa..bc7d031eca 100755 --- a/src/fsharp/NicePrint.fs +++ b/src/fsharp/NicePrint.fs @@ -1061,7 +1061,6 @@ module private PrintTypes = nameL ^^ wordL ":" ^^ tauL - let layoutPrettyType denv typ = let _,typ,cxs = PrettyTypes.PrettifyTypes1 denv.g typ let env = SimplifyTypes.CollectInfo true [typ] cxs diff --git a/src/fsharp/PostInferenceChecks.fs b/src/fsharp/PostInferenceChecks.fs index 6bf6bbb6e4..759003cd9c 100755 --- a/src/fsharp/PostInferenceChecks.fs +++ b/src/fsharp/PostInferenceChecks.fs @@ -603,7 +603,7 @@ and CheckExprInContext (cenv:cenv) (env:env) expr (context:ByrefCallContext) = | OptionalCoerce(Expr.Val(failwithfFunc, _, funcRange)) when valRefEq g failwithfFunc g.failwithf_vref -> match argsl with | Expr.App (Expr.Val(newFormat, _, _), _, [_; typB; typC; _; _], [Expr.Const(Const.String formatString, formatRange, _)], _) :: xs when valRefEq g newFormat g.new_format_vref -> - match CheckFormatStrings.TryCountFormatStringArguments formatRange g None formatString typB typC with + match CheckFormatStrings.TryCountFormatStringArguments formatRange g formatString typB typC with | Some n -> let expected = n + 1 let actual = List.length xs + 1 diff --git a/src/fsharp/ReferenceResolution.fs b/src/fsharp/ReferenceResolution.fs index 2ab0225211..86d76ff361 100644 --- a/src/fsharp/ReferenceResolution.fs +++ b/src/fsharp/ReferenceResolution.fs @@ -31,10 +31,6 @@ module internal MSBuildResolver = | RuntimeLike | DesigntimeLike -#if NO_MSBUILD_REFERENCE_RESOLUTION - let HighestInstalledNetFrameworkVersionMajorMinor() = - 4,"v5.0" -#else /// Information about a resolved file. type ResolvedFile = @@ -357,7 +353,8 @@ module internal MSBuildResolver = #else rar.TargetedRuntimeVersion <- targetedRuntimeVersionValue rar.CopyLocalDependenciesWhenParentReferenceInGac <- true -#endif +#endif + #endif let succeeded = rar.Execute() @@ -423,5 +420,3 @@ module internal MSBuildResolver = referenceCopyLocalPaths = set rootedResults.referenceCopyLocalPaths |> Set.union (set unrootedResults.referenceCopyLocalPaths) |> Set.toArray suggestedBindingRedirects = set rootedResults.suggestedBindingRedirects |> Set.union (set unrootedResults.suggestedBindingRedirects) |> Set.toArray } - -#endif diff --git a/src/fsharp/ReferenceResolution.fsi b/src/fsharp/ReferenceResolution.fsi index 87e2499927..ea42b297d2 100644 --- a/src/fsharp/ReferenceResolution.fsi +++ b/src/fsharp/ReferenceResolution.fsi @@ -27,9 +27,6 @@ module internal MSBuildResolver = | RuntimeLike // Don't allow stubbed-out reference assemblies | DesigntimeLike -#if NO_MSBUILD_REFERENCE_RESOLUTION -#else - /// Get the Reference Assemblies directory for the .NET Framework on Window val DotNetFrameworkReferenceAssembliesRootDirectoryOnWindows : string @@ -85,4 +82,3 @@ module internal MSBuildResolver = logwarning:(string->string->unit) * logerror:(string->string->unit) -> ResolutionResults -#endif diff --git a/src/fsharp/TastOps.fs b/src/fsharp/TastOps.fs index 21e308597b..25f977eb24 100755 --- a/src/fsharp/TastOps.fs +++ b/src/fsharp/TastOps.fs @@ -7766,8 +7766,8 @@ let (|CompiledForEachExpr|_|) g expr = enumerableVar.IsCompilerGenerated && enumeratorVar.IsCompilerGenerated && (let fvs = (freeInExpr CollectLocals bodyExpr) - not (Zset.contains enumerableVar fvs.FreeLocals) && - not (Zset.contains enumeratorVar fvs.FreeLocals)) -> + not (Zset.contains enumerableVar fvs.FreeLocals) && + not (Zset.contains enumeratorVar fvs.FreeLocals)) -> // Extract useful ranges let m = enumerableExpr.Range @@ -7788,6 +7788,7 @@ let (|CompiledInt32RangeForEachExpr|_|) g expr = | _ -> None | _ -> None + type OptimizeForExpressionOptions = OptimizeIntRangesOnly | OptimizeAllForExpressions let DetectAndOptimizeForExpression g option expr = diff --git a/src/fsharp/ast.fs b/src/fsharp/ast.fs index eb8fa268cd..9082e2d5f4 100644 --- a/src/fsharp/ast.fs +++ b/src/fsharp/ast.fs @@ -95,11 +95,7 @@ type XmlDoc = if lineAT = "" then processLines rest else if String.hasPrefix lineAT "<" then lines else [""] @ -#if FX_NO_SECURITY_ELEMENT_ESCAPE - lines @ -#else (lines |> List.map (fun line -> System.Security.SecurityElement.Escape(line))) @ -#endif [""] let lines = processLines (Array.toList lines) diff --git a/src/fsharp/fsc.fs b/src/fsharp/fsc.fs index 3877275d12..83cb007e91 100755 --- a/src/fsharp/fsc.fs +++ b/src/fsharp/fsc.fs @@ -373,94 +373,70 @@ let GetTcImportsFromCommandLine if not tcConfigB.continueAfterParseFailure then AbortOnError(errorLogger, tcConfig, exiter) - let tcGlobals,tcImports,frameworkTcImports,generatedCcu,typedAssembly,topAttrs,tcConfig = - - ReportTime tcConfig "Import mscorlib" - -#if INCREMENTAL_BUILD_OPTION - if tcConfig.useIncrementalBuilder then - ReportTime tcConfig "Incremental Parse and Typecheck" - let builder = - new IncrementalFSharpBuild.IncrementalBuilder(tcConfig, directoryBuildingFrom, assemblyName, NiceNameGenerator(), lexResourceManager, sourceFiles, - ensureReactive=false, - errorLogger=errorLogger, - keepGeneratedTypedAssembly=true) - let tcState,topAttribs,typedAssembly,_tcEnv,tcImports,tcGlobals,tcConfig = builder.TypeCheck() - tcGlobals,tcImports,tcImports,tcState.Ccu,typedAssembly,topAttribs,tcConfig - else -#else - begin -#endif - ReportTime tcConfig "Import mscorlib and FSharp.Core.dll" - let foundationalTcConfigP = TcConfigProvider.Constant(tcConfig) - let sysRes,otherRes,knownUnresolved = TcAssemblyResolutions.SplitNonFoundationalResolutions(tcConfig) - let tcGlobals,frameworkTcImports = TcImports.BuildFrameworkTcImports (foundationalTcConfigP, sysRes, otherRes) - - // register framework tcImports to be disposed in future - disposables.Register frameworkTcImports - - // step - parse sourceFiles - ReportTime tcConfig "Parse inputs" - use unwindParsePhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.Parse) - let inputs = - try - sourceFiles - |> tcConfig.ComputeCanContainEntryPoint - |> List.zip sourceFiles - // PERF: consider making this parallel, once uses of global state relevant to parsing are cleaned up - |> List.choose (fun (filename:string,isLastCompiland:bool) -> - let pathOfMetaCommandSource = Path.GetDirectoryName(filename) - match ParseOneInputFile(tcConfig,lexResourceManager,["COMPILED"],filename,isLastCompiland,errorLogger,(*retryLocked*)false) with - | Some(input)->Some(input,pathOfMetaCommandSource) - | None -> None - ) - with e -> - errorRecoveryNoRange e - SqmLoggerWithConfig tcConfig errorLogger.ErrorNumbers errorLogger.WarningNumbers - exiter.Exit 1 - - if tcConfig.parseOnly then exiter.Exit 0 - if not tcConfig.continueAfterParseFailure then - AbortOnError(errorLogger, tcConfig, exiter) - - if tcConfig.printAst then - inputs |> List.iter (fun (input,_filename) -> printf "AST:\n"; printfn "%+A" input; printf "\n") - - let tcConfig = (tcConfig,inputs) ||> List.fold ApplyMetaCommandsFromInputToTcConfig - let tcConfigP = TcConfigProvider.Constant(tcConfig) - - ReportTime tcConfig "Import non-system references" - let tcGlobals,tcImports = - let tcImports = TcImports.BuildNonFrameworkTcImports(tcConfigP,tcGlobals,frameworkTcImports,otherRes,knownUnresolved) - tcGlobals,tcImports - - // register tcImports to be disposed in future - disposables.Register tcImports - - if not tcConfig.continueAfterParseFailure then - AbortOnError(errorLogger, tcConfig, exiter) - - if tcConfig.importAllReferencesOnly then exiter.Exit 0 - - ReportTime tcConfig "Typecheck" - use unwindParsePhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.TypeCheck) - let tcEnv0 = GetInitialTcEnv (Some assemblyName, rangeStartup, tcConfig, tcImports, tcGlobals) - - // typecheck - let inputs = inputs |> List.map fst - let tcState,topAttrs,typedAssembly,_tcEnvAtEnd = - TypeCheck(tcConfig,tcImports,tcGlobals,errorLogger,assemblyName,NiceNameGenerator(),tcEnv0,inputs,exiter) - - let generatedCcu = tcState.Ccu + ReportTime tcConfig "Import mscorlib and FSharp.Core.dll" + let foundationalTcConfigP = TcConfigProvider.Constant(tcConfig) + let sysRes,otherRes,knownUnresolved = TcAssemblyResolutions.SplitNonFoundationalResolutions(tcConfig) + let tcGlobals,frameworkTcImports = TcImports.BuildFrameworkTcImports (foundationalTcConfigP, sysRes, otherRes) + + // register framework tcImports to be disposed in future + disposables.Register frameworkTcImports + + // step - parse sourceFiles + ReportTime tcConfig "Parse inputs" + use unwindParsePhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.Parse) + let inputs = + try + sourceFiles + |> tcConfig.ComputeCanContainEntryPoint + |> List.zip sourceFiles + // PERF: consider making this parallel, once uses of global state relevant to parsing are cleaned up + |> List.choose (fun (filename:string,isLastCompiland:bool) -> + let pathOfMetaCommandSource = Path.GetDirectoryName(filename) + match ParseOneInputFile(tcConfig,lexResourceManager,["COMPILED"],filename,isLastCompiland,errorLogger,(*retryLocked*)false) with + | Some(input)->Some(input,pathOfMetaCommandSource) + | None -> None + ) + with e -> + errorRecoveryNoRange e + SqmLoggerWithConfig tcConfig errorLogger.ErrorNumbers errorLogger.WarningNumbers + exiter.Exit 1 + + if tcConfig.parseOnly then exiter.Exit 0 + if not tcConfig.continueAfterParseFailure then AbortOnError(errorLogger, tcConfig, exiter) - ReportTime tcConfig "Typechecked" - (tcGlobals,tcImports,frameworkTcImports,generatedCcu,typedAssembly,topAttrs,tcConfig) - -#if INCREMENTAL_BUILD_OPTION -#else - end -#endif + if tcConfig.printAst then + inputs |> List.iter (fun (input,_filename) -> printf "AST:\n"; printfn "%+A" input; printf "\n") + + let tcConfig = (tcConfig,inputs) ||> List.fold ApplyMetaCommandsFromInputToTcConfig + let tcConfigP = TcConfigProvider.Constant(tcConfig) + + ReportTime tcConfig "Import non-system references" + let tcGlobals,tcImports = + let tcImports = TcImports.BuildNonFrameworkTcImports(tcConfigP,tcGlobals,frameworkTcImports,otherRes,knownUnresolved) + tcGlobals,tcImports + + // register tcImports to be disposed in future + disposables.Register tcImports + + if not tcConfig.continueAfterParseFailure then + AbortOnError(errorLogger, tcConfig, exiter) + + if tcConfig.importAllReferencesOnly then exiter.Exit 0 + + ReportTime tcConfig "Typecheck" + use unwindParsePhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.TypeCheck) + let tcEnv0 = GetInitialTcEnv (Some assemblyName, rangeStartup, tcConfig, tcImports, tcGlobals) + + // typecheck + let inputs = inputs |> List.map fst + let tcState,topAttrs,typedAssembly,_tcEnvAtEnd = + TypeCheck(tcConfig,tcImports,tcGlobals,errorLogger,assemblyName,NiceNameGenerator(),tcEnv0,inputs,exiter) + + let generatedCcu = tcState.Ccu + AbortOnError(errorLogger, tcConfig, exiter) + ReportTime tcConfig "Typechecked" + tcGlobals,tcImports,frameworkTcImports,generatedCcu,typedAssembly,topAttrs,tcConfig,outfile,pdbfile,assemblyName,errorLogger #if NO_COMPILER_BACKEND @@ -1051,10 +1027,36 @@ module MainModuleBuilder = mkILResources [ for file in tcConfig.embedResources do let name,bytes,pub = - let file,name,pub = TcConfigBuilder.SplitCommandLineResourceInfo file - let file = tcConfig.ResolveSourceFile(rangeStartup,file,tcConfig.implicitIncludeDir) - let bytes = FileSystem.ReadAllBytesShim file - name,bytes,pub + let lower = String.lowercase file + if List.exists (Filename.checkSuffix lower) [".resx"] then +#if COMPILER_SERVICE + failwith "resx arguments not supported in compiler service" +#else + let file = tcConfig.ResolveSourceFile(rangeStartup,file,tcConfig.implicitIncludeDir) + let outfile = (file |> Filename.chopExtension) + ".resources" + + let readResX(f:string) = + use rsxr = new System.Resources.ResXResourceReader(f) + rsxr + |> Seq.cast + |> Seq.toList + |> List.map (fun (d:System.Collections.DictionaryEntry) -> (d.Key :?> string), d.Value) + let writeResources((r:(string * obj) list),(f:string)) = + use writer = new System.Resources.ResourceWriter(f) + r |> List.iter (fun (k,v) -> writer.AddResource(k,v)) + writeResources(readResX(file),outfile); + let file,name,pub = TcConfigBuilder.SplitCommandLineResourceInfo outfile + let file = tcConfig.ResolveSourceFile(rangeStartup,file,tcConfig.implicitIncludeDir) + let bytes = FileSystem.ReadAllBytesShim file + FileSystem.FileDelete outfile + name,bytes,pub +#endif + else + + let file,name,pub = TcConfigBuilder.SplitCommandLineResourceInfo file + let file = tcConfig.ResolveSourceFile(rangeStartup,file,tcConfig.implicitIncludeDir) + let bytes = FileSystem.ReadAllBytesShim file + name,bytes,pub yield { Name=name; Location=ILResourceLocation.Local (fun () -> bytes); Access=pub; @@ -1175,9 +1177,6 @@ module MainModuleBuilder = System.Runtime.InteropServices.RuntimeEnvironment.GetRuntimeDirectory() + @"default.win32manifest" let nativeResources = -#if NO_NATIVE_RESOURCE_WRITER - [] -#else [ for av in assemblyVersionResources do yield Lazy.CreateFromValue av if not(tcConfig.win32res = "") then @@ -1185,7 +1184,6 @@ module MainModuleBuilder = if tcConfig.includewin32manifest && not(win32Manifest = "") && not(runningOnMono) then yield Lazy.CreateFromValue [| yield! ResFileFormat.ResFileHeader() yield! (ManifestResourceFormat.VS_MANIFEST_RESOURCE((FileSystem.ReadAllBytesShim win32Manifest), tcConfig.target = Dll))|]] -#endif // Add attributes, version number, resources etc. @@ -1773,9 +1771,6 @@ let main0(argv,bannerAlreadyPrinted,openBinariesInMemory:bool,exiter:Exiter, err // See Bug 735819 let lcidFromCodePage = -#if LIMITED_CONSOLE - None -#else if (Console.OutputEncoding.CodePage <> 65001) && (Console.OutputEncoding.CodePage <> Thread.CurrentThread.CurrentUICulture.TextInfo.OEMCodePage) && (Console.OutputEncoding.CodePage <> Thread.CurrentThread.CurrentUICulture.TextInfo.ANSICodePage) then @@ -1783,7 +1778,6 @@ let main0(argv,bannerAlreadyPrinted,openBinariesInMemory:bool,exiter:Exiter, err Some(1033) else None -#endif let tcGlobals,tcImports,frameworkTcImports,generatedCcu,typedAssembly,topAttrs,tcConfig,outfile,pdbfile,assemblyName,errorLogger = GetTcImportsFromCommandLine @@ -1791,10 +1785,9 @@ let main0(argv,bannerAlreadyPrinted,openBinariesInMemory:bool,exiter:Exiter, err lcidFromCodePage, // setProcessThreadLocals (fun tcConfigB -> -#if LIMITED_CONSOLE - () -#else +#if COMPILER_SERVICE tcConfigB.openBinariesInMemory <- openBinariesInMemory +#endif match tcConfigB.lcid with | Some(n) -> Thread.CurrentThread.CurrentUICulture <- new CultureInfo(n) | None -> () @@ -1802,9 +1795,8 @@ let main0(argv,bannerAlreadyPrinted,openBinariesInMemory:bool,exiter:Exiter, err if tcConfigB.utf8output then let prev = Console.OutputEncoding Console.OutputEncoding <- Encoding.UTF8 - System.AppDomain.CurrentDomain.ProcessExit.Add(fun _ -> Console.OutputEncoding <- prev) -#endif - ), (fun tcConfigB -> + System.AppDomain.CurrentDomain.ProcessExit.Add(fun _ -> Console.OutputEncoding <- prev)), + (fun tcConfigB -> // display the banner text, if necessary if not bannerAlreadyPrinted then DisplayBannerText tcConfigB), @@ -1813,9 +1805,9 @@ let main0(argv,bannerAlreadyPrinted,openBinariesInMemory:bool,exiter:Exiter, err errorLoggerProvider, disposables) - tcGlobals,tcImports,frameworkTcImports,generatedCcu,typedAssembly,topAttrs,tcConfig,outfile,pdbfile,assemblyName,errorLogger, exiter + tcGlobals,tcImports,frameworkTcImports,generatedCcu,typedAssembly,topAttrs,tcConfig,outfile,pdbfile,assemblyName,errorLogger,exiter -let main1(tcGlobals,tcImports : TcImports,frameworkTcImports,generatedCcu,typedAssembly,topAttrs,tcConfig : TcConfig, outfile,pdbfile,assemblyName,errorLogger, exiter : Exiter) = +let main1(tcGlobals, tcImports: TcImports, frameworkTcImports, generatedCcu, typedAssembly, topAttrs, tcConfig: TcConfig, outfile, pdbfile, assemblyName, errorLogger, exiter: Exiter) = if tcConfig.typeCheckOnly then exiter.Exit 0 @@ -2059,7 +2051,7 @@ let main4 dynamicAssemblyCreator (Args(tcConfig, errorLogger:ErrorLogger, ilGlob use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.Output) let outfile = tcConfig.MakePathAbsolute outfile - let pdbfile = pdbfile |> Option.map ((expandFileNameIfNeeded tcConfig) >> FileSystem.GetFullPathShim) + let pdbfile = pdbfile |> Option.map (expandFileNameIfNeeded tcConfig >> FileSystem.GetFullPathShim) match dynamicAssemblyCreator with | None -> FileWriter.EmitIL (tcConfig,ilGlobals,errorLogger,outfile,pdbfile,ilxMainModule,signingInfo,exiter) | Some da -> da (tcConfig,ilGlobals,errorLogger,outfile,pdbfile,ilxMainModule,signingInfo); @@ -2123,11 +2115,11 @@ type InProcCompiler() = let exitCode = ref 0 let exiter = { new Exiter with - member this.Exit n = exitCode := n; raise (StopProcessing None) } + member this.Exit n = exitCode := n; raise StopProcessing } try typecheckAndCompile(argv, false, true, exiter, loggerProvider, None, None) with - | StopProcessing _ -> () + | StopProcessing -> () | ReportedError _ | WrappedError(ReportedError _,_) -> exitCode := 1 () diff --git a/src/fsharp/fsi/fsi.fs b/src/fsharp/fsi/fsi.fs index ef799fce02..d0ff6941d9 100644 --- a/src/fsharp/fsi/fsi.fs +++ b/src/fsharp/fsi/fsi.fs @@ -443,7 +443,7 @@ type internal ErrorLoggerThatStopsOnFirstError(tcConfigB:TcConfigBuilder, fsiStd errors <- errors + 1 if tcConfigB.abortOnError then exit 1 (* non-zero exit code *) // STOP ON FIRST ERROR (AVOIDS PARSER ERROR RECOVERY) - raise (StopProcessing None) + raise StopProcessing member x.ResetErrorCount() = (errors <- 0) @@ -467,7 +467,7 @@ type ErrorLogger with if x.ErrorCount > 0 then fprintf fsiConsoleOutput.Error "%s" (FSIstrings.SR.stoppedDueToError()) fsiConsoleOutput.Error.Flush() - raise (StopProcessing None) + raise StopProcessing /// Get the directory name from a string, with some defaults if it doesn't have one let internal directoryName (s:string) = @@ -626,14 +626,11 @@ type internal FsiCommandLineOptions(fsi: FsiEvaluationSessionHostConfig, argv: s stopProcessingRecovery e range0; failwithf "Error creating evaluation session: %A" e inputFilesAcc -#if LIMITED_CONSOLE -#else do if tcConfigB.utf8output then let prev = Console.OutputEncoding Console.OutputEncoding <- System.Text.Encoding.UTF8 System.AppDomain.CurrentDomain.ProcessExit.Add(fun _ -> Console.OutputEncoding <- prev) -#endif do let firstArg = @@ -707,9 +704,6 @@ let internal InstallErrorLoggingOnThisThread errorLogger = /// Set the input/output encoding. The use of a thread is due to a known bug on /// on Vista where calls to Console.InputEncoding can block the process. let internal SetServerCodePages(fsiOptions: FsiCommandLineOptions) = -#if LIMITED_CONSOLE - ignore fsiOptions -#else match fsiOptions.FsiServerInputCodePage, fsiOptions.FsiServerOutputCodePage with | None,None -> () | inputCodePageOpt,outputCodePageOpt -> @@ -736,7 +730,6 @@ let internal SetServerCodePages(fsiOptions: FsiCommandLineOptions) = if not !successful then System.Windows.Forms.MessageBox.Show(FSIstrings.SR.fsiConsoleProblem()) |> ignore #endif -#endif @@ -989,7 +982,7 @@ type internal FsiDynamicCompiler errorLogger.SetError() errorLogger.AbortOnError(fsiConsoleOutput) | _ -> - raise (StopProcessing (Some err)) + raise (StopProcessingExn (Some err)) | None -> ())) ; @@ -1954,7 +1947,7 @@ type internal FsiInteractionProcessor | FsiInteractionStepStatus.Completed res -> setCurrState istate Choice1Of2 res - | FsiInteractionStepStatus.CompletedWithReportedError (StopProcessing userExnOpt) -> + | FsiInteractionStepStatus.CompletedWithReportedError (StopProcessingExn userExnOpt) -> Choice2Of2 userExnOpt | FsiInteractionStepStatus.CompletedWithReportedError _ -> Choice2Of2 None @@ -2258,15 +2251,12 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i do if not runningOnMono then Lib.UnmanagedProcessExecutionOptions.EnableHeapTerminationOnCorruption() (* SDL recommendation *) // See Bug 735819 let lcidFromCodePage = -#if LIMITED_CONSOLE -#else if (Console.OutputEncoding.CodePage <> 65001) && (Console.OutputEncoding.CodePage <> Thread.CurrentThread.CurrentUICulture.TextInfo.OEMCodePage) && (Console.OutputEncoding.CodePage <> Thread.CurrentThread.CurrentUICulture.TextInfo.ANSICodePage) then Thread.CurrentThread.CurrentUICulture <- new CultureInfo("en-US") Some 1033 else -#endif None let timeReporter = FsiTimeReporter(outWriter) @@ -2477,7 +2467,7 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i errorLogger.SetError() try errorLogger.AbortOnError(fsiConsoleOutput) - with StopProcessing _ -> + with StopProcessing -> // BUG 664864: Watson Clr20r3 across buckets with: Application FSIAnyCPU.exe from Dev11 RTM; Exception AE251Y0L0P2WC0QSWDZ0E2IDRYQTDSVB; FSIANYCPU.NI.EXE!Microsoft.FSharp.Compiler.Interactive.Shell+threadException // reason: some window that use System.Windows.Forms.DataVisualization types (possible FSCharts) was created in FSI. // at some moment one chart has raised InvalidArgumentException from OnPaint, this exception was intercepted by the code in higher layer and diff --git a/src/fsharp/infos.fs b/src/fsharp/infos.fs index 4ea98a256b..e2f89a69c6 100755 --- a/src/fsharp/infos.fs +++ b/src/fsharp/infos.fs @@ -2638,9 +2638,6 @@ let rec evalFSharpAttribArg g e = type AttribInfo = | FSAttribInfo of TcGlobals * Attrib | ILAttribInfo of TcGlobals * Import.ImportMap * ILScopeRef * ILAttribute * range -#if EXPOSE_ATTRIBS_OF_PROVIDED_SYMBOLS - | ProvAttribInfo of Import.ImportMap * Tainted * range -#endif member x.TyconRef = match x with @@ -2648,12 +2645,6 @@ type AttribInfo = | ILAttribInfo (g, amap, scoref, a, m) -> let ty = ImportType scoref amap m [] a.Method.EnclosingType tcrefOfAppTy g ty -#if EXPOSE_ATTRIBS_OF_PROVIDED_SYMBOLS - | ProvAttribInfo(amap, cdata, m) -> - let pty = cdata.PApply((fun a -> a.AttributeType),m) - let ty = Import.ImportProvidedType amap m pty - tcrefOfAppTy g ty -#endif member x.ConstructorArguments = match x with @@ -2721,13 +2712,7 @@ module AttributeChecking = #if EXTENSIONTYPING // TODO: provided attributes | ProvidedMeth (_,_mi,_,_m) -> -#if EXPOSE_ATTRIBS_OF_PROVIDED_SYMBOLS - let provAttribs = mi.PApply((fun st -> (st :> IProvidedCustomAttributeProvider)),m) - let cas = provAttribs.PUntaint((fun a -> a.GetAttributes(provAttribs.TypeProvider.PUntaintNoFailure(id))),m) - cas |> AttribInfosOfProvided g -#else [] -#endif #endif diff --git a/src/fsharp/layout.fs b/src/fsharp/layout.fs index a4e48bda1f..d3614f31c4 100755 --- a/src/fsharp/layout.fs +++ b/src/fsharp/layout.fs @@ -221,33 +221,6 @@ type LayoutRenderer<'a,'b> = abstract Finish : 'b -> 'a let renderL (rr: LayoutRenderer<_,_>) layout = -#if FX_NO_INDIRECT_TAILCALLS -// Use non-indirect-tailcalling version on silverlight - let rec addL z pos i = function - (* pos is tab level *) - | Leaf (_,text,_) -> - rr.AddText z (unbox text),i + (unbox text).Length - | Node (_,l,_,r,_,Broken indent) -> - let z,_i = addL z pos i l - let z,i = rr.AddBreak z (pos+indent),(pos+indent) - let z,i = addL z (pos+indent) i r - z,i - | Node (_,l,jm,r,_,_) -> - let z,i = addL z pos i l - let z,i = if jm then z,i else rr.AddText z " ",i+1 - let pos = i - let z,i = addL z pos i r - z,i - | Attr (tag,attrs,l) -> - let z = rr.AddTag z (tag,attrs,true) - let z,i = addL z pos i l - let z = rr.AddTag z (tag,attrs,false) - z,i - let pos = 0 - let z,i = rr.Start(),0 - let z,_i = addL z pos i layout - rr.Finish z -#else let rec addL z pos i layout k = match layout with (* pos is tab level *) @@ -274,7 +247,6 @@ let renderL (rr: LayoutRenderer<_,_>) layout = let z,i = rr.Start(),0 let z,_i = addL z pos i layout id rr.Finish z -#endif /// string render let stringR = diff --git a/src/fsharp/lib.fs b/src/fsharp/lib.fs index 03b4babaca..bd49583ac1 100755 --- a/src/fsharp/lib.fs +++ b/src/fsharp/lib.fs @@ -17,11 +17,7 @@ let progress = ref false let tracking = ref false // intended to be a general hook to control diagnostic output when tracking down bugs let condition _s = -#if FX_NO_GET_ENVIRONMENT_VARIABLE - false -#else try (System.Environment.GetEnvironmentVariable(_s) <> null) with _ -> false -#endif let GetEnvInteger e dflt = match System.Environment.GetEnvironmentVariable(e) with null -> dflt | t -> try int t with _ -> dflt diff --git a/src/fsharp/vs/SimpleServices.fs b/src/fsharp/vs/SimpleServices.fs index 9017f9b70d..825079fc40 100644 --- a/src/fsharp/vs/SimpleServices.fs +++ b/src/fsharp/vs/SimpleServices.fs @@ -136,7 +136,7 @@ namespace Microsoft.FSharp.Compiler.SimpleSourceCodeServices let tryCompile errorLogger f = use unwindParsePhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.Parse) use unwindEL_2 = PushErrorLoggerPhaseUntilUnwind (fun _ -> errorLogger) - let exiter = { new Exiter with member x.Exit n = raise (StopProcessing None) } + let exiter = { new Exiter with member x.Exit n = raise StopProcessing } try f exiter 0 diff --git a/src/utils/CompilerLocationUtils.fs b/src/utils/CompilerLocationUtils.fs index be6b9d6109..c10729d6db 100755 --- a/src/utils/CompilerLocationUtils.fs +++ b/src/utils/CompilerLocationUtils.fs @@ -13,16 +13,15 @@ open System.Runtime.InteropServices module internal FSharpEnvironment = /// The F# version reported in the banner -#if NO_STRONG_NAMES +#if COMPILER_SERVICE let DotNetBuildString = "(private)" -#endif -#if STRONG_NAME_AND_DELAY_SIGN_FSHARP_COMPILER_WITH_MSFT_KEY - let DotNetBuildString = "(Open Source Edition)" -#endif -#if STRONG_NAME_FSHARP_COMPILER_WITH_TEST_KEY - let DotNetBuildString = "(Open Source Edition)" -#endif +#else + /// The .NET runtime version that F# was built against (e.g. "v4.0.21104") + let DotNetRuntime = sprintf "v%s.%s.%s" Microsoft.BuildSettings.Version.Major Microsoft.BuildSettings.Version.Minor Microsoft.BuildSettings.Version.ProductBuild + /// The .NET build string that F# was built against (e.g. "4.0.21104.0") + let DotNetBuildString = Microsoft.BuildSettings.Version.OfFile +#endif let FSharpCoreLibRunningVersion = try match (typeof>).Assembly.GetName().Version.ToString() with @@ -78,16 +77,12 @@ module internal FSharpEnvironment = let REG_SZ = 1u let GetDefaultRegistryStringValueViaDotNet(subKey: string) = -#if NO_WIN32_REGISTRY - None -#else Option.ofString (try downcast Microsoft.Win32.Registry.GetValue("HKEY_LOCAL_MACHINE\\"+subKey,null,null) with e-> System.Diagnostics.Debug.Assert(false, sprintf "Failed in GetDefaultRegistryStringValueViaDotNet: %s" (e.ToString())) null) -#endif // RegistryView.Registry API is not available before .NET 4.0 #if FX_ATLEAST_40_COMPILER_LOCATION @@ -146,7 +141,7 @@ module internal FSharpEnvironment = null) let is32Bit = IntPtr.Size = 4 - + let runningOnMono = try System.Type.GetType("Mono.Runtime") <> null with e-> false let tryRegKey(subKey:string) = @@ -189,9 +184,7 @@ module internal FSharpEnvironment = None let internal tryAppConfig (appConfigKey:string) = -#if NO_SYSTEM_CONFIG - None -#else + let locationFromAppConfig = ConfigurationSettings.AppSettings.[appConfigKey] System.Diagnostics.Debug.Print(sprintf "Considering appConfigKey %s which has value '%s'" appConfigKey locationFromAppConfig) @@ -202,7 +195,6 @@ module internal FSharpEnvironment = let locationFromAppConfig = locationFromAppConfig.Replace("{exepath}", exeAssemblyFolder) System.Diagnostics.Debug.Print(sprintf "Using path %s" locationFromAppConfig) Some locationFromAppConfig -#endif /// Try to find the F# compiler location by looking at the "fsharpi" script installed by F# packages let internal tryFsharpiScript(url:string) = @@ -254,20 +246,20 @@ module internal FSharpEnvironment = // Note: If the keys below change, be sure to update code in: // Property pages (ApplicationPropPage.vb) - let key20 = @"Software\Microsoft\.NETFramework\AssemblyFolders\Microsoft.FSharp-" + FSharpTeamVersionNumber - let key40a = @"Software\Microsoft\FSharp\4.0\Runtime\v4.0" - let key40b = @"Software\Microsoft\FSharp\3.1\Runtime\v4.0" - let key40c = @"Software\Microsoft\FSharp\2.0\Runtime\v4.0" - let key1,key2,key3,key4 = key40a, key40b, key40c, key20 + let key20 = @"Software\Microsoft\.NETFramework\AssemblyFolders\Microsoft.FSharp-" + FSharpTeamVersionNumber + let key40a = @"Software\Microsoft\FSharp\4.0\Runtime\v4.0" + let key40b = @"Software\Microsoft\FSharp\3.1\Runtime\v4.0" + let key40c = @"Software\Microsoft\FSharp\2.0\Runtime\v4.0" + let key1,key2,key3,key4 = key40a, key40b, key40c, key20 - let result = tryRegKey key1 + let result = tryRegKey key1 + match result with + | Some _ -> result + | None -> + let result = tryRegKey key2 match result with | Some _ -> result - | None -> - let result = tryRegKey key2 - match result with - | Some _ -> result - | None -> + | None -> let result = tryRegKey key3 match result with | Some _ -> result @@ -325,12 +317,12 @@ module internal FSharpEnvironment = // Check if the framework version 4.5 or above is installed at the given key entry let IsNetFx45OrAboveInstalledAt subkey = - try - useKey subkey (fun regkey -> - match regkey with - | null -> false - | _ -> regkey.GetValue("Release", 0) :?> int |> (fun s -> s >= 0x50000)) // 0x50000 implies 4.5.0 - with _ -> false + try + useKey subkey (fun regkey -> + match regkey with + | null -> false + | _ -> regkey.GetValue("Release", 0) :?> int |> (fun s -> s >= 0x50000)) // 0x50000 implies 4.5.0 + with _ -> false // Check if the framework version 4.5 or above is installed let IsNetFx45OrAboveInstalled =