Merge pull request #593 from dsyme/integrate-81

Integrate from Microsoft/visualfsharp

Author: dsyme

src/absil/il.fs

@@ -2982,8 +2982,14 @@ let mdef_code2code f md  =
 let prependInstrsToCode (instrs: ILInstr list) (c2: ILCode) = 
     let instrs = Array.ofList instrs
     let n = instrs.Length
-    { c2 with Labels = Dictionary.ofList [ for kvp in c2.Labels -> (kvp.Key, kvp.Value + n) ]
-              Instrs = Array.append instrs c2.Instrs }
+    match c2.Instrs.[0] with 
+    // If there is a sequence point as the first instruction then keep it at the front
+    | I_seqpoint _ as i0 -> 
+        { c2 with Labels = Dictionary.ofList [ for kvp in c2.Labels -> (kvp.Key, if kvp.Value = 0 then 0 else kvp.Value + n) ]
+                  Instrs = Array.append [| i0 |] (Array.append instrs c2.Instrs.[1..]) }
+    | _ -> 
+        { c2 with Labels = Dictionary.ofList [ for kvp in c2.Labels -> (kvp.Key, kvp.Value + n) ]
+                  Instrs = Array.append instrs c2.Instrs }
 
 let prependInstrsToMethod new_code md  = 
     mdef_code2code (prependInstrsToCode new_code) md

src/absil/ilsupp.fs

@@ -535,8 +535,8 @@ type ResFormatNode(tid:int32, nid:int32, lid:int32, dataOffset:int32, pbLinkedRe
         let SaveChunk(p : byte[], sz : int) =
             if Unchecked.defaultof<byte[]> <>  pUnlinkedResource then
                 Bytes.blit p 0 pUnlinkedResource (!unlinkedResourceOffset + offset) sz
-                unlinkedResourceOffset := !unlinkedResourceOffset + sz ;
-            size := !size + sz ;
+                unlinkedResourceOffset := !unlinkedResourceOffset + sz
+            size := !size + sz
 
             ()
 
@@ -846,10 +846,10 @@ let unlinkResource (ulLinkedResourceBaseRVA:int32) (pbLinkedResource:byte[]) =
         let rfh = ResFormatHeader()
         let rfhBytes = rfh.toBytes()
         Bytes.blit rfhBytes 0 pResBuffer 0 ResFormatHeader.Width
-        resBufferOffset <- resBufferOffset + ResFormatHeader.Width ;
+        resBufferOffset <- resBufferOffset + ResFormatHeader.Width
 
         for i = 0 to (nResNodes - 1) do
-            resBufferOffset <- resBufferOffset + pResNodes.[i].Save(ulLinkedResourceBaseRVA, pbLinkedResource, pResBuffer, resBufferOffset) ;
+            resBufferOffset <- resBufferOffset + pResNodes.[i].Save(ulLinkedResourceBaseRVA, pbLinkedResource, pResBuffer, resBufferOffset)
 
     pResBuffer
 #endif

src/absil/ilx.fs

@@ -120,8 +120,7 @@ type IlxClosureSpec =
 type IlxClosureInfo = 
     { cloStructure: IlxClosureLambdas
       cloFreeVars: IlxClosureFreeVar[]  
-      cloCode: Lazy<ILMethodBody>
-      cloSource: ILSourceMarker option}
+      cloCode: Lazy<ILMethodBody> }
 
 type IlxUnionInfo = 
     { /// is the representation public? 

src/absil/ilx.fsi

@@ -97,8 +97,7 @@ type IlxClosureApps =
 type IlxClosureInfo = 
     { cloStructure: IlxClosureLambdas
       cloFreeVars: IlxClosureFreeVar[]  
-      cloCode: Lazy<ILMethodBody>
-      cloSource: ILSourceMarker option}
+      cloCode: Lazy<ILMethodBody> }
 
 type IlxUnionInfo = 
     { /// Is the representation public? 

src/fsharp/CompileOps.fs

@@ -594,7 +594,7 @@ type TcImports =
     member GetCcusExcludingBase : unit -> CcuThunk list 
     member FindDllInfo : range * string -> ImportedBinary
     member TryFindDllInfo : range * string * lookupOnly: bool -> option<ImportedBinary>
-    member FindCcuFromAssemblyRef : range * ILAssemblyRef -> Tast.CcuResolutionResult
+    member FindCcuFromAssemblyRef : range * ILAssemblyRef -> CcuResolutionResult
 #if EXTENSIONTYPING
     member ProviderGeneratedTypeRoots : ProviderGeneratedType list
 #endif
@@ -661,8 +661,7 @@ val ProcessMetaCommandsFromInput :
 val ApplyMetaCommandsFromInputToTcConfig : TcConfig -> (Ast.ParsedInput * string) -> TcConfig
 
 /// Process the #nowarn in an input
-val ApplyNoWarnsToTcConfig : TcConfig -> (Ast.ParsedInput*string) -> TcConfig
-
+val ApplyNoWarnsToTcConfig : TcConfig -> (Ast.ParsedInput * string) -> TcConfig
 
 //----------------------------------------------------------------------------
 // Scoped pragmas
@@ -717,23 +716,21 @@ val GetInitialTcState :
 /// Check one input, returned as an Eventually computation
 val TypeCheckOneInputEventually :
     (unit -> bool) * TcConfig * TcImports * TcGlobals * Ast.LongIdent option * NameResolution.TcResultsSink * TcState * Ast.ParsedInput  
-           -> Eventually<(TcEnv * TopAttribs * Tast.TypedImplFile list) * TcState>
+           -> Eventually<(TcEnv * TopAttribs * TypedImplFile list) * TcState>
 
 /// Finish the checking of multiple inputs 
 val TypeCheckMultipleInputsFinish : (TcEnv * TopAttribs * 'T list) list * TcState -> (TcEnv * TopAttribs * 'T list) * TcState
     
 /// Finish the checking of a closed set of inputs 
-val TypeCheckClosedInputSetFinish : TypedImplFile list * TcState -> TcState * TypedAssembly
+val TypeCheckClosedInputSetFinish : TypedImplFile list * TcState -> TcState * TypedImplFile list
 
 /// Check a closed set of inputs 
-val TypeCheckClosedInputSet :
-    (unit -> bool) * TcConfig * TcImports * TcGlobals * Ast.LongIdent option * TcState * Ast.ParsedInput  list 
-        -> TcState * TopAttribs * Tast.TypedAssembly * TcEnv
+val TypeCheckClosedInputSet :(unit -> bool) * TcConfig * TcImports * TcGlobals * Ast.LongIdent option * TcState * Ast.ParsedInput  list  -> TcState * TopAttribs * TypedImplFile list * TcEnv
 
 /// Check a single input and finish the checking
 val TypeCheckSingleInputAndFinishEventually :
     (unit -> bool) * TcConfig * TcImports * TcGlobals * Ast.LongIdent option * NameResolution.TcResultsSink * TcState * Ast.ParsedInput 
-        -> Eventually<(TcEnv * TopAttribs * Tast.TypedImplFile list) * TcState>
+        -> Eventually<(TcEnv * TopAttribs * TypedImplFile list) * TcState>
 
 /// Indicates if we should report a warning
 val ReportWarning : globalWarnLevel: int * specificWarnOff: int list * specificWarnOn: int list -> PhasedError -> bool

src/fsharp/CompileOps.fsi

@@ -858,7 +858,7 @@ let internalFlags (tcConfigB:TcConfigBuilder) =
     CompilerOption("resolutions", tagNone, OptionUnit (fun () -> tcConfigB.showReferenceResolutions <- true), Some(InternalCommandLineOption("", rangeCmdArgs)), None) // "Display assembly reference resolution information") 
     CompilerOption("resolutionframeworkregistrybase", tagString, OptionString (fun s -> tcConfigB.resolutionFrameworkRegistryBase<-s), Some(InternalCommandLineOption("", rangeCmdArgs)), None) // "The base registry key to use for assembly resolution. This part in brackets here: HKEY_LOCAL_MACHINE\[SOFTWARE\Microsoft\.NETFramework]\v2.0.50727\AssemblyFoldersEx")
     CompilerOption("resolutionassemblyfoldersuffix", tagString, OptionString (fun s -> tcConfigB.resolutionAssemblyFoldersSuffix<-s), Some(InternalCommandLineOption("resolutionassemblyfoldersuffix", rangeCmdArgs)), None) // "The base registry key to use for assembly resolution. This part in brackets here: HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\.NETFramework\v2.0.50727\[AssemblyFoldersEx]")
-    CompilerOption("resolutionassemblyfoldersconditions", tagString, OptionString (fun s -> tcConfigB.resolutionAssemblyFoldersConditions <- ","^s), Some(InternalCommandLineOption("resolutionassemblyfoldersconditions", rangeCmdArgs)), None) // "Additional reference resolution conditions. For example \"OSVersion=5.1.2600.0,PlatformID=id")
+    CompilerOption("resolutionassemblyfoldersconditions", tagString, OptionString (fun s -> tcConfigB.resolutionAssemblyFoldersConditions <- ","+s), Some(InternalCommandLineOption("resolutionassemblyfoldersconditions", rangeCmdArgs)), None) // "Additional reference resolution conditions. For example \"OSVersion=5.1.2600.0,PlatformID=id")
     CompilerOption("msbuildresolution", tagNone, OptionUnit (fun () -> tcConfigB.useSimpleResolution<-false), Some(InternalCommandLineOption("msbuildresolution", rangeCmdArgs)), None) // "Resolve assembly references using MSBuild resolution rules rather than directory based (Default=true except when running fsc.exe under mono)")
     CompilerOption("alwayscallvirt",tagNone,OptionSwitch(callVirtSwitch tcConfigB),Some(InternalCommandLineOption("alwayscallvirt",rangeCmdArgs)), None)
     CompilerOption("nodebugdata",tagNone, OptionUnit (fun () -> tcConfigB.noDebugData<-true),Some(InternalCommandLineOption("--nodebugdata",rangeCmdArgs)), None)
@@ -992,7 +992,7 @@ let GetAbbrevFlagSet tcConfigB isFsc =
     for c in ((if isFsc then abbreviatedFlagsFsc else abbreviatedFlagsFsi) tcConfigB) do
         match c with
         | CompilerOption(arg,_,OptionString _,_,_)
-        | CompilerOption(arg,_,OptionStringList _,_,_) -> argList <- argList @ ["-"^arg;"/"^arg]
+        | CompilerOption(arg,_,OptionStringList _,_,_) -> argList <- argList @ ["-"+arg;"/"+arg]
         | _ -> ()
     Set.ofList argList
 
@@ -1009,7 +1009,7 @@ let PostProcessCompilerArgs (abbrevArgs : string Set) (args : string []) =
             arga.[idx] <- args.[i] 
             i <- i+1
         else
-            arga.[idx] <- args.[i] ^ ":" ^ args.[i+1]
+            arga.[idx] <- args.[i] + ":" + args.[i+1]
             i <- i + 2
         idx <- idx + 1
     Array.toList arga.[0 .. (idx - 1)]
@@ -1105,14 +1105,14 @@ let showTermFileCount = ref 0
 let PrintWholeAssemblyImplementation (tcConfig:TcConfig) outfile header expr =
     if tcConfig.showTerms then
         if tcConfig.writeTermsToFiles then 
-            let filename = outfile ^ ".terms"
+            let filename = outfile + ".terms"
             let n = !showTermFileCount
             showTermFileCount := n+1
-            use f = System.IO.File.CreateText (filename ^ "-" ^ string n ^ "-" ^ header)
-            Layout.outL f (Layout.squashTo 192 (DebugPrint.assemblyL expr))
+            use f = System.IO.File.CreateText (filename + "-" + string n + "-" + header)
+            Layout.outL f (Layout.squashTo 192 (DebugPrint.implFilesL expr))
         else 
             dprintf "\n------------------\nshowTerm: %s:\n" header
-            Layout.outL stderr (Layout.squashTo 192 (DebugPrint.assemblyL expr))
+            Layout.outL stderr (Layout.squashTo 192 (DebugPrint.implFilesL expr))
             dprintf "\n------------------\n"
 
 //----------------------------------------------------------------------------
@@ -1206,46 +1206,45 @@ let GetInitialOptimizationEnv (tcImports:TcImports, tcGlobals:TcGlobals) =
     let optEnv = List.fold (AddExternalCcuToOpimizationEnv tcGlobals) optEnv ccuinfos 
     optEnv
 
-let ApplyAllOptimizations (tcConfig:TcConfig, tcGlobals, tcVal, outfile, importMap, isIncrementalFragment, optEnv, ccu:CcuThunk, tassembly:TypedAssembly) =
+let ApplyAllOptimizations (tcConfig:TcConfig, tcGlobals, tcVal, outfile, importMap, isIncrementalFragment, optEnv, ccu:CcuThunk, implFiles) =
     // NOTE: optEnv - threads through 
     //
     // Always optimize once - the results of this step give the x-module optimization 
     // info.  Subsequent optimization steps choose representations etc. which we don't 
     // want to save in the x-module info (i.e. x-module info is currently "high level"). 
-    PrintWholeAssemblyImplementation tcConfig outfile "pass-start" tassembly
+    PrintWholeAssemblyImplementation tcConfig outfile "pass-start" implFiles
 #if DEBUG
-    if tcConfig.showOptimizationData then dprintf "Expression prior to optimization:\n%s\n" (Layout.showL (Layout.squashTo 192 (DebugPrint.assemblyL tassembly)))
+    if tcConfig.showOptimizationData then dprintf "Expression prior to optimization:\n%s\n" (Layout.showL (Layout.squashTo 192 (DebugPrint.implFilesL implFiles)))
     if tcConfig.showOptimizationData then dprintf "CCU prior to optimization:\n%s\n" (Layout.showL (Layout.squashTo 192 (DebugPrint.entityL ccu.Contents)))
 #endif
 
     let optEnv0 = optEnv
-    let (TAssembly(implFiles)) = tassembly
     ReportTime tcConfig ("Optimizations")
+
+    // Only do abstract_big_targets on the first pass!  Only do it when TLR is on!  
+    let optSettings = tcConfig.optSettings 
+    let optSettings = { optSettings with abstractBigTargets = tcConfig.doTLR }
+    let optSettings = { optSettings with reportingPhase = true }
+            
     let results,(optEnvFirstLoop,_,_,_) = 
         ((optEnv0,optEnv0,optEnv0,SignatureHidingInfo.Empty),implFiles) ||> List.mapFold (fun (optEnvFirstLoop,optEnvExtraLoop,optEnvFinalSimplify,hidden) implFile -> 
 
-            // Only do abstract_big_targets on the first pass!  Only do it when TLR is on!  
-            let optSettings = tcConfig.optSettings 
-            let optSettings = { optSettings with abstractBigTargets = tcConfig.doTLR }
-            let optSettings = { optSettings with reportingPhase = true }
-            
             //ReportTime tcConfig ("Initial simplify")
-            let optEnvFirstLoop,implFile,implFileOptData,hidden = 
-                Optimizer.OptimizeImplFile(optSettings,ccu,tcGlobals,tcVal, importMap,optEnvFirstLoop,isIncrementalFragment,tcConfig.emitTailcalls,hidden,implFile)
+            let (optEnvFirstLoop,implFile,implFileOptData,hidden), optimizeDuringCodeGen = 
+                Optimizer.OptimizeImplFile(optSettings,ccu,tcGlobals,tcVal,importMap,optEnvFirstLoop,isIncrementalFragment,tcConfig.emitTailcalls,hidden,implFile)
 
             let implFile = AutoBox.TransformImplFile tcGlobals importMap implFile 
 
             // Only do this on the first pass!
-            let optSettings = { optSettings with abstractBigTargets = false }
-            let optSettings = { optSettings with reportingPhase = false }
+            let optSettings = { optSettings with abstractBigTargets = false; reportingPhase = false }
 #if DEBUG
             if tcConfig.showOptimizationData then dprintf "Optimization implFileOptData:\n%s\n" (Layout.showL (Layout.squashTo 192 (Optimizer.moduleInfoL tcGlobals implFileOptData)))
 #endif
 
             let implFile,optEnvExtraLoop = 
                 if tcConfig.extraOptimizationIterations > 0 then 
                     //ReportTime tcConfig ("Extra simplification loop")
-                    let optEnvExtraLoop,implFile, _, _ = Optimizer.OptimizeImplFile(optSettings,ccu,tcGlobals,tcVal, importMap,optEnvExtraLoop,isIncrementalFragment,tcConfig.emitTailcalls,hidden,implFile)
+                    let (optEnvExtraLoop,implFile, _, _), _ = Optimizer.OptimizeImplFile(optSettings,ccu,tcGlobals,tcVal, importMap,optEnvExtraLoop,isIncrementalFragment,tcConfig.emitTailcalls,hidden,implFile)
                     //PrintWholeAssemblyImplementation tcConfig outfile (sprintf "extra-loop-%d" n) implFile
                     implFile,optEnvExtraLoop
                 else
@@ -1270,20 +1269,21 @@ let ApplyAllOptimizations (tcConfig:TcConfig, tcGlobals, tcVal, outfile, importM
             let implFile,optEnvFinalSimplify =
                 if tcConfig.doFinalSimplify then 
                     //ReportTime tcConfig ("Final simplify pass")
-                    let optEnvFinalSimplify,implFile, _, _ = Optimizer.OptimizeImplFile(optSettings,ccu,tcGlobals,tcVal, importMap,optEnvFinalSimplify,isIncrementalFragment,tcConfig.emitTailcalls,hidden,implFile)
+                    let (optEnvFinalSimplify,implFile, _, _),_ = Optimizer.OptimizeImplFile(optSettings,ccu,tcGlobals,tcVal, importMap,optEnvFinalSimplify,isIncrementalFragment,tcConfig.emitTailcalls,hidden,implFile)
                     //PrintWholeAssemblyImplementation tcConfig outfile "post-rec-opt" implFile
                     implFile,optEnvFinalSimplify 
                 else 
                     implFile,optEnvFinalSimplify 
-            (implFile,implFileOptData),(optEnvFirstLoop,optEnvExtraLoop,optEnvFinalSimplify,hidden))
+
+            ((implFile,optimizeDuringCodeGen),implFileOptData),(optEnvFirstLoop,optEnvExtraLoop,optEnvFinalSimplify,hidden))
 
     let implFiles,implFileOptDatas = List.unzip results
     let assemblyOptData = Optimizer.UnionOptimizationInfos implFileOptDatas
-    let tassembly = TAssembly(implFiles)
-    PrintWholeAssemblyImplementation tcConfig outfile "pass-end" tassembly
+    let tassembly = TypedAssemblyAfterOptimization(implFiles)
+    PrintWholeAssemblyImplementation tcConfig outfile "pass-end" (List.map fst implFiles)
     ReportTime tcConfig ("Ending Optimizations")
 
-    tassembly, assemblyOptData,optEnvFirstLoop
+    tassembly, assemblyOptData, optEnvFirstLoop
 
 
 //----------------------------------------------------------------------------

src/fsharp/CompileOptions.fs

@@ -81,11 +81,11 @@ val GetGeneratedILModuleName : CompilerTarget -> string -> string
 #else
 val GetInitialOptimizationEnv : TcImports * TcGlobals -> IncrementalOptimizationEnv
 val AddExternalCcuToOpimizationEnv : TcGlobals -> IncrementalOptimizationEnv -> ImportedAssembly -> IncrementalOptimizationEnv
-val ApplyAllOptimizations : TcConfig * TcGlobals * ConstraintSolver.TcValF * string * ImportMap * bool * IncrementalOptimizationEnv * CcuThunk * TypedAssembly -> TypedAssembly * Optimizer.LazyModuleInfo * IncrementalOptimizationEnv
+val ApplyAllOptimizations : TcConfig * TcGlobals * ConstraintSolver.TcValF * string * ImportMap * bool * IncrementalOptimizationEnv * CcuThunk * TypedImplFile list -> TypedAssemblyAfterOptimization * Optimizer.LazyModuleInfo * IncrementalOptimizationEnv 
 
 val CreateIlxAssemblyGenerator : TcConfig * TcImports * TcGlobals * ConstraintSolver.TcValF * CcuThunk -> IlxGen.IlxAssemblyGenerator
 
-val GenerateIlxCode : IlxGen.IlxGenBackend * bool * bool * TcConfig * TypeChecker.TopAttribs * TypedAssembly * string * bool * IlxGen.IlxAssemblyGenerator -> IlxGen.IlxGenResults
+val GenerateIlxCode : IlxGen.IlxGenBackend * bool * bool * TcConfig * TypeChecker.TopAttribs * TypedAssemblyAfterOptimization * string * bool * IlxGen.IlxAssemblyGenerator -> IlxGen.IlxGenResults
 #endif
 
 // Used during static linking

src/fsharp/CompileOptions.fsi

@@ -2006,10 +2006,22 @@ and ReportNoCandidatesError (csenv:ConstraintSolverEnv) (nUnnamedCallerArgs,nNam
 
     // One method, incorrect name/arg assignment 
     | _,_,_,_,([],[cmeth]) -> 
-        let msgNum,msgText = FSComp.SR.csRequiredSignatureIs(NicePrint.stringOfMethInfo amap m denv cmeth.Method)
+        let minfo = cmeth.Method
+        let msgNum,msgText = FSComp.SR.csRequiredSignatureIs(NicePrint.stringOfMethInfo amap m denv minfo)
         let msgNum,msgText,msgRange = 
             match cmeth.UnassignedNamedArgs with 
-            | CallerNamedArg(id,_) :: _ -> (msgNum,FSComp.SR.csMemberHasNoArgumentOrReturnProperty(methodName, id.idText, msgText),id.idRange)
+            | CallerNamedArg(id,_) :: _ -> 
+                if minfo.IsConstructor then
+                    let typ = minfo.DeclaringEntityRef
+
+                    let predictions =
+                        typ.AllInstanceFieldsAsList
+                        |> List.map (fun p -> p.Name.Replace("@",""))
+                        |> ErrorResolutionHints.FilterPredictions id.idText
+
+                    msgNum,FSComp.SR.csCtorHasNoArgumentOrReturnProperty(methodName, id.idText, msgText, ErrorResolutionHints.FormatPredictions predictions),id.idRange
+                else
+                    msgNum,FSComp.SR.csMemberHasNoArgumentOrReturnProperty(methodName, id.idText, msgText),id.idRange
             | [] -> (msgNum,msgText,m)
         ErrorD (Error ((msgNum,msgText),msgRange))
 
@@ -2052,8 +2064,7 @@ and ReportNoCandidatesError (csenv:ConstraintSolverEnv) (nUnnamedCallerArgs,nNam
 
     // One or more accessible, all the same arity, none correct 
     | ((cmeth :: cmeths2),_),_,_,_,_ when not cmeth.HasCorrectArity && cmeths2 |> List.forall (fun cmeth2 -> cmeth.TotalNumUnnamedCalledArgs = cmeth2.TotalNumUnnamedCalledArgs) -> 
-        ErrorD (Error (FSComp.SR.csMemberNotAccessible(methodName, (cmeth.ArgSets |> List.sumBy (fun x -> x.NumUnnamedCalledArgs)), methodName, cmeth.TotalNumUnnamedCalledArgs),m))
-
+        ErrorD (Error (FSComp.SR.csMemberNotAccessible(methodName, nUnnamedCallerArgs, methodName, cmeth.TotalNumUnnamedCalledArgs),m))
     // Many methods, all with incorrect number of generic arguments
     | _,_,_,([],(cmeth :: _)),_ -> 
         let msg = FSComp.SR.csIncorrectGenericInstantiation((ShowAccessDomain ad), methodName, cmeth.NumCallerTyArgs)