Merge pull request fsharp#710 from dsyme/integrate-911

Integrate visualfsharp master

src/absil/il.fs

@@ -2616,9 +2616,9 @@ let emptyILMethodImpls =  mkILMethodImpls []
 // them in fields.  preblock is how to call the superclass constructor....
 // -------------------------------------------------------------------- 
 
-let mkILStorageCtorWithParamNames(tag,preblock,typ,flds,access) = 
+let mkILStorageCtorWithParamNames(tag,preblock,typ,extraParams,flds,access) = 
     mkILCtor(access,
-            flds |> List.map (fun (pnm,_,ty) -> mkILParamNamed (pnm,ty)),
+            (flds |> List.map (fun (pnm,_,ty) -> mkILParamNamed (pnm,ty))) @ extraParams,
             mkMethodBody
               (false,[],2,
                nonBranchingInstrsToCode
@@ -2632,22 +2632,22 @@ let mkILStorageCtorWithParamNames(tag,preblock,typ,flds,access) =
                      ])  flds)
                  end,tag))
 
-let mkILSimpleStorageCtorWithParamNames(tag,base_tspec,typ,flds,access) = 
+let mkILSimpleStorageCtorWithParamNames(tag,base_tspec,typ,extraParams,flds,access) = 
     let preblock = 
       match base_tspec with 
         None -> []
       | Some tspec -> 
           ([ mkLdarg0; 
              mkNormalCall (mkILCtorMethSpecForTy (mkILBoxedType tspec,[])) ])
-    mkILStorageCtorWithParamNames(tag,preblock,typ,flds,access)
+    mkILStorageCtorWithParamNames(tag,preblock,typ,extraParams,flds,access)
 
 let addParamNames flds = 
     flds |> List.map (fun (nm,ty) -> (nm,nm,ty))
 
-let mkILSimpleStorageCtor(tag,base_tspec,typ,flds,access) = 
-    mkILSimpleStorageCtorWithParamNames(tag,base_tspec,typ, addParamNames flds, access)
+let mkILSimpleStorageCtor(tag,base_tspec,typ,extraParams,flds,access) = 
+    mkILSimpleStorageCtorWithParamNames(tag,base_tspec,typ, extraParams, addParamNames flds, access)
 
-let mkILStorageCtor(tag,preblock,typ,flds,access) = mkILStorageCtorWithParamNames(tag,preblock,typ, addParamNames flds, access)
+let mkILStorageCtor(tag,preblock,typ,flds,access) = mkILStorageCtorWithParamNames(tag, preblock, typ, [], addParamNames flds, access)
 
 
 let mkILGenericClass (nm, access, genparams, extends, impl, methods, fields, nestedTypes, props, events, attrs, init) =

src/absil/il.fsi

@@ -1710,8 +1710,8 @@ val prependInstrsToClassCtor: ILInstr list -> ILSourceMarker option -> ILTypeDef
 
 /// Derived functions for making some simple constructors
 val mkILStorageCtor: ILSourceMarker option * ILInstr list * ILType * (string * ILType) list * ILMemberAccess -> ILMethodDef
-val mkILSimpleStorageCtor: ILSourceMarker option * ILTypeSpec option * ILType * (string * ILType) list * ILMemberAccess -> ILMethodDef
-val mkILSimpleStorageCtorWithParamNames: ILSourceMarker option * ILTypeSpec option * ILType * (string * string * ILType) list * ILMemberAccess -> ILMethodDef
+val mkILSimpleStorageCtor: ILSourceMarker option * ILTypeSpec option * ILType * ILParameter list * (string * ILType) list * ILMemberAccess -> ILMethodDef
+val mkILSimpleStorageCtorWithParamNames: ILSourceMarker option * ILTypeSpec option * ILType * ILParameter list * (string * string * ILType) list * ILMemberAccess -> ILMethodDef
 
 val mkILDelegateMethods: ILGlobals -> ILType * ILType -> ILParameter list * ILReturn -> ILMethodDef list
 

src/absil/ilwrite.fs

@@ -4189,7 +4189,7 @@ let writeBinaryAndReportMappings (outfile,
     begin match pdbfile with
     | None -> ()
 #if ENABLE_MONO_SUPPORT
-    | Some fmdb when runningOnMono -> 
+    | Some fmdb when runningOnMono && not portablePDB ->
         writeMdbInfo fmdb outfile pdbData
 #endif
     | Some fpdb -> 

src/absil/ilwritepdb.fs

@@ -144,8 +144,8 @@ let pdbGetCvDebugInfo (mvid:byte[]) (timestamp:int32) (filepath:string) (cvChunk
         Buffer.BlockCopy(path, 0, buffer, offset, size)
         buffer
     { iddCharacteristics = 0;                                                   // Reserved
-      iddMajorVersion = 0;                                                      // VersionMajor should be 0
-      iddMinorVersion = 0;                                                      // VersionMinor should be 0
+      iddMajorVersion = 0x0100;                                                 // VersionMajor should be 0x0100
+      iddMinorVersion = 0x504d;                                                 // VersionMinor should be 0x504d
       iddType = 2;                                                              // IMAGE_DEBUG_TYPE_CODEVIEW
       iddTimestamp = timestamp;
       iddData = iddCvBuffer;                                                    // Path name to the pdb file when built
@@ -198,11 +198,13 @@ let checkSum (url:string) =
 //------------------------------------------------------------------------------
 
 // This function takes output file name and returns debug file name.
-let getDebugFileName outfile = 
+let getDebugFileName outfile (portablePDB: bool) =
 #if ENABLE_MONO_SUPPORT
-  if IL.runningOnMono then 
+  if IL.runningOnMono && not portablePDB then
       outfile + ".mdb"
   else 
+#else
+      ignore portablePDB
 #endif
       (Filename.chopExtension outfile) + ".pdb" 
 

src/absil/ilwritepdb.fsi

@@ -59,7 +59,7 @@ type PdbData =
 
 
 /// Takes the output file name and returns debug file name.
-val getDebugFileName: string -> string
+val getDebugFileName: string -> bool -> string
 
 /// 28 is the size of the IMAGE_DEBUG_DIRECTORY in ntimage.h 
 val sizeof_IMAGE_DEBUG_DIRECTORY : System.Int32

src/fsharp/CompileOps.fs

@@ -2332,12 +2332,12 @@ type TcConfigBuilder =
         let pdbfile = 
             if tcConfigB.debuginfo then
               Some (match tcConfigB.debugSymbolFile with 
-                    | None -> Microsoft.FSharp.Compiler.AbstractIL.ILPdbWriter.getDebugFileName outfile
+                    | None -> Microsoft.FSharp.Compiler.AbstractIL.ILPdbWriter.getDebugFileName outfile tcConfigB.portablePDB
 #if ENABLE_MONO_SUPPORT
                     | Some _ when runningOnMono ->
                         // On Mono, the name of the debug file has to be "<assemblyname>.mdb" so specifying it explicitly is an error
                         warning(Error(FSComp.SR.ilwriteMDBFileNameCannotBeChangedWarning(),rangeCmdArgs))
-                        Microsoft.FSharp.Compiler.AbstractIL.ILPdbWriter.getDebugFileName outfile
+                        Microsoft.FSharp.Compiler.AbstractIL.ILPdbWriter.getDebugFileName outfile tcConfigB.portablePDB
 #endif
                     | Some f -> f)   
             elif (tcConfigB.debugSymbolFile <> None) && (not (tcConfigB.debuginfo)) then

src/fsharp/IlxGen.fs

@@ -3646,7 +3646,7 @@ and GenSequenceExpr cenv (cgbuf:CodeGenBuffer) eenvouter (nextEnumeratorValRef:V
         |> AddNonUserCompilerGeneratedAttribs cenv.g
 
     let ilCtorBody = 
-        mkILSimpleStorageCtor(None, Some ilCloBaseTy.TypeSpec, ilCloTyInner, [], ILMemberAccess.Assembly).MethodBody
+        mkILSimpleStorageCtor(None, Some ilCloBaseTy.TypeSpec, ilCloTyInner, [], [], ILMemberAccess.Assembly).MethodBody
 
     let attrs = GenAttrs cenv eenvinner cloAttribs
     let cloTypeDefs = GenClosureTypeDefs cenv (ilCloTypeRef,ilCloGenericParams,attrs,ilCloFreeVars,ilCloLambdas,ilCtorBody,[generateNextMethod;closeMethod;checkCloseMethod;lastGeneratedMethod;getFreshMethod],[],ilCloBaseTy,[])
@@ -4095,7 +4095,7 @@ and GenDelegateExpr cenv cgbuf eenvouter expr (TObjExprMethod((TSlotSig(_,delega
              ilDelegeeParams, 
              ilDelegeeRet,
              MethodBody.IL ilMethodBody)
-    let delegeeCtorMeth = mkILSimpleStorageCtor(None, Some cenv.g.ilg.typ_Object.TypeSpec, ilDelegeeTyInner, [], ILMemberAccess.Assembly)
+    let delegeeCtorMeth = mkILSimpleStorageCtor(None, Some cenv.g.ilg.typ_Object.TypeSpec, ilDelegeeTyInner, [], [], ILMemberAccess.Assembly)
     let ilCtorBody = delegeeCtorMeth.MethodBody
 
     let ilCloLambdas = Lambdas_return ilCtxtDelTy
@@ -6453,14 +6453,14 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) =
 
                  // No type spec if the record is a value type
                  let spec = if isStructRecord then None else Some(cenv.g.ilg.typ_Object.TypeSpec)
-                 let ilMethodDef = mkILSimpleStorageCtorWithParamNames(None, spec, ilThisTy, ChooseParamNames fieldNamesAndTypes, reprAccess)
+                 let ilMethodDef = mkILSimpleStorageCtorWithParamNames(None, spec, ilThisTy, [], ChooseParamNames fieldNamesAndTypes, reprAccess)
 
                  yield ilMethodDef 
                  // FSharp 1.0 bug 1988: Explicitly setting the ComVisible(true)  attribute on an F# type causes an F# record to be emitted in a way that enables mutation for COM interop scenarios
                  // FSharp 3.0 feature: adding CLIMutable to a record type causes emit of default constructor, and all fields get property setters
                  // Records that are value types do not create a default constructor with CLIMutable or ComVisible
                  if not isStructRecord && (isCLIMutable || (TryFindFSharpBoolAttribute cenv.g cenv.g.attrib_ComVisibleAttribute tycon.Attribs = Some true)) then
-                     yield mkILSimpleStorageCtor(None, Some cenv.g.ilg.typ_Object.TypeSpec, ilThisTy, [], reprAccess) 
+                     yield mkILSimpleStorageCtor(None, Some cenv.g.ilg.typ_Object.TypeSpec, ilThisTy, [], [], reprAccess) 
 
                  if not (tycon.HasMember cenv.g "ToString" []) then
                     yield! genToString ilThisTy
@@ -6626,9 +6626,14 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) =
                     cudDebugDisplayAttributes= ilDebugDisplayAttributes
                     cudAlternatives= alternatives
                     cudWhere = None}
+               let layout = 
+                   if isStructTy cenv.g thisTy then 
+                       ILTypeDefLayout.Sequential { Size=None; Pack=None } 
+                   else 
+                       ILTypeDefLayout.Auto
                let tdef = 
                    { Name = ilTypeName
-                     Layout = ILTypeDefLayout.Auto
+                     Layout =  layout
                      Access = access
                      GenericParams = ilGenParams
                      CustomAttrs = 
@@ -6725,13 +6730,13 @@ and GenExnDef cenv mgbuf eenv m (exnc:Tycon) =
              |> List.unzip4
 
         let ilCtorDef = 
-            mkILSimpleStorageCtorWithParamNames(None, Some cenv.g.iltyp_Exception.TypeSpec, ilThisTy, ChooseParamNames fieldNamesAndTypes, reprAccess) 
+            mkILSimpleStorageCtorWithParamNames(None, Some cenv.g.iltyp_Exception.TypeSpec, ilThisTy, [], ChooseParamNames fieldNamesAndTypes, reprAccess) 
 
         // In compiled code, all exception types get a parameterless constructor for use with XML serialization
         // This does default-initialization of all fields
         let ilCtorDefNoArgs = 
             if not (isNil fieldNamesAndTypes) then 
-                [ mkILSimpleStorageCtor(None, Some cenv.g.iltyp_Exception.TypeSpec, ilThisTy, [], reprAccess) ]
+                [ mkILSimpleStorageCtor(None, Some cenv.g.iltyp_Exception.TypeSpec, ilThisTy, [], [], reprAccess) ]
             else
                 []
 

src/fsharp/NicePrint.fs

@@ -1371,7 +1371,11 @@ module InfoMemberPrinting =
         let rty = pinfo.GetPropertyType(amap,m) 
         let rty = if pinfo.IsIndexer then mkRefTupledTy g (pinfo.GetParamTypes(amap, m)) --> rty else  rty 
         let _, rty, _ = PrettyTypes.PrettifyTypes1 g rty
-        let nameL = DemangleOperatorNameAsLayout tagProperty pinfo.PropertyName
+        let tagProp =
+            match pinfo.ArbitraryValRef with
+            | None -> tagProperty
+            | Some vref -> tagProperty >> mkNav vref.DefinitionRange
+        let nameL = DemangleOperatorNameAsLayout tagProp pinfo.PropertyName
         wordL (tagText (FSComp.SR.typeInfoProperty())) ^^
         layoutTyconRef denv (tcrefOfAppTy g pinfo.EnclosingType) ^^
         SepL.dot ^^

src/fsharp/TypeChecker.fs

@@ -8236,7 +8236,7 @@ and TcSequenceExpression cenv env tpenv comp overallTy m =
 // unambiguously implies a function type 
 //------------------------------------------------------------------------- 
 
-and PropagateThenTcDelayed cenv overallTy env tpenv mExpr expr exprty (atomicFlag:ExprAtomicFlag) delayed = 
+and Propagate cenv overallTy env tpenv (expr: ApplicableExpr) exprty delayed = 
 
     let rec propagate delayedList mExpr exprty = 
         match delayedList with 
@@ -8266,6 +8266,9 @@ and PropagateThenTcDelayed cenv overallTy env tpenv mExpr expr exprty (atomicFla
                     error (NotAFunction(denv,overallTy,mExpr,mArg)) 
 
     propagate delayed expr.Range exprty
+
+and PropagateThenTcDelayed cenv overallTy env tpenv mExpr expr exprty (atomicFlag:ExprAtomicFlag) delayed = 
+    Propagate cenv overallTy env tpenv expr exprty delayed
     TcDelayed cenv overallTy env tpenv mExpr expr exprty atomicFlag delayed
 
 
@@ -8677,10 +8680,18 @@ and TcItemThen cenv overallTy env tpenv (item,mItem,rest,afterOverloadResolution
 
         let expr = Expr.Op(TOp.TraitCall(traitInfo), [], ves, mItem)
         let expr = mkLambdas mItem [] vs (expr,retTy)
-        let resultExpr = PropagateThenTcDelayed cenv overallTy env tpenv mItem (MakeApplicableExprNoFlex cenv expr) (tyOfExpr cenv.g expr) ExprAtomicFlag.NonAtomic delayed
-        // Add the constraint after the arguments have been checked to allow annotations to kick in on rigid type parameters
+
+        Propagate cenv overallTy env tpenv (MakeApplicableExprNoFlex cenv expr) (tyOfExpr cenv.g expr) delayed
+
+        let delayed1, delayed2 = List.takeWhile (function (DelayedApp _) -> true | _ -> false) delayed, List.skipWhile (function (DelayedApp _) -> true | _ -> false) delayed
+        let intermediateTy = if isNil delayed2 then overallTy else NewInferenceType ()
+        let resultExpr, tpenv = TcDelayed cenv intermediateTy env tpenv mItem (MakeApplicableExprNoFlex cenv expr) (tyOfExpr cenv.g expr) ExprAtomicFlag.NonAtomic delayed1
+
+        // Add the constraint after the application arguments have been checked to allow annotations to kick in on rigid type parameters
         AddCxMethodConstraint env.DisplayEnv cenv.css mItem NoTrace traitInfo
-        resultExpr
+
+        let resultExpr2, tpenv2 = TcDelayed cenv overallTy env tpenv mItem (MakeApplicableExprNoFlex cenv resultExpr) intermediateTy ExprAtomicFlag.NonAtomic delayed2
+        resultExpr2, tpenv2
 
 
     | Item.DelegateCtor typ ->

src/fsharp/layout.fs

@@ -19,7 +19,7 @@ type NavigableTaggedText(taggedText: TaggedText, range: Range.range) =
     interface TaggedText with
         member x.Tag = taggedText.Tag
         member x.Text = taggedText.Text
-let mkNav r t = NavigableTaggedText(t, r)
+let mkNav r t = NavigableTaggedText(t, r) :> TaggedText
 
 let spaces n = new String(' ',n)
 

src/fsharp/layout.fsi

@@ -16,7 +16,7 @@ type NavigableTaggedText =
     new : TaggedText * Range.range -> NavigableTaggedText
     member Range: Range.range
     interface TaggedText
-val mkNav : Range.range -> TaggedText -> NavigableTaggedText
+val mkNav : Range.range -> TaggedText -> TaggedText
 
 module TaggedTextOps = Internal.Utilities.StructuredFormat.TaggedTextOps
 

src/fsharp/vs/ServiceUntypedParse.fs

@@ -351,12 +351,24 @@ type FSharpParseFileResults(errors : FSharpErrorInfo[], input : Ast.ParsedInput
             (fun () -> 
                 let locations = findBreakPoints()
 
-                match locations |> List.filter (fun m -> rangeContainsPos m pos) with
-                | [] ->
-                    match locations |> List.filter (fun m -> rangeBeforePos m pos |> not) with
-                    | [] -> Seq.tryHead locations
-                    | locationsAfterPos -> Seq.tryHead locationsAfterPos
-                | coveringLocations -> Seq.tryLast coveringLocations)
+                if pos.Column = 0 then
+                    // we have a breakpoint that was set with mouse at line start
+                    match locations |> List.filter (fun m -> m.StartLine = m.EndLine && pos.Line = m.StartLine) with
+                    | [] ->
+                        match locations |> List.filter (fun m -> rangeContainsPos m pos) with
+                        | [] ->
+                            match locations |> List.filter (fun m -> rangeBeforePos m pos |> not) with
+                            | [] -> Seq.tryHead locations
+                            | locationsAfterPos -> Seq.tryHead locationsAfterPos
+                        | coveringLocations -> Seq.tryLast coveringLocations
+                    | locationsOnSameLine -> Seq.tryHead locationsOnSameLine
+                else
+                    match locations |> List.filter (fun m -> rangeContainsPos m pos) with
+                    | [] ->
+                        match locations |> List.filter (fun m -> rangeBeforePos m pos |> not) with
+                        | [] -> Seq.tryHead locations
+                        | locationsAfterPos -> Seq.tryHead locationsAfterPos
+                    | coveringLocations -> Seq.tryLast coveringLocations)
             (fun _msg -> None)
 
     /// When these files appear or disappear the configuration for the current project is invalidated.