Merge pull request #404 from dsyme/vf-align-4

more code alignment with Microsoft/visualfsharp

Author: dsyme

src/assemblyinfo/assemblyinfo.FSharp.Compiler.Silverlight.dll.fs

@@ -24,7 +24,7 @@ let lowestDefaultPriority = 0 (* See comment on TyparConstraint.DefaultsTo *)
 
 let mkFlexibleFormatTypar m tys dflt = 
     let tp = NewTypar (TyparKind.Type,TyparRigidity.Rigid,Typar(mkSynId m "fmt",HeadTypeStaticReq,true),false,TyparDynamicReq.Yes,[],false,false)
-    tp.FixupConstraints [ TyparConstraint.SimpleChoice (tys,m); TyparConstraint.DefaultsTo (lowestDefaultPriority,dflt,m)];
+    tp.FixupConstraints [ TyparConstraint.SimpleChoice (tys,m); TyparConstraint.DefaultsTo (lowestDefaultPriority,dflt,m)]
     copyAndFixupFormatTypar m tp
 
 let mkFlexibleIntFormatTypar g m = 
@@ -48,7 +48,7 @@ let newInfo ()=
     addZeros       = false
     precision      = false}
 
-let ParseFormatString (m: Range.range) g (source: string option) report fmt bty cty dty = 
+let ParseFormatString (m: Range.range) g (source: string option) fmt bty cty dty = 
     // Offset is used to adjust ranges depending on whether input string is regular, verbatim or triple-quote.
     // We construct a new 'fmt' string since the current 'fmt' string doesn't distinguish between "\n" and escaped "\\n".
     let (offset, fmt) = 
@@ -291,7 +291,4 @@ let ParseFormatString (m: Range.range) g (source: string option) report fmt bty
           | _ -> parseLoop acc (i+1, relLine, relCol+1)
 
     let results = parseLoop [] (0, 0, m.StartColumn)
-    // Only report specifier locations if entire format strings are well-formed.
-    for specifierLocation in specifierLocations do
-        report specifierLocation
-    results
+    results, Seq.toList specifierLocations

src/fsharp/CheckFormatStrings.fs

@@ -13,4 +13,4 @@ open Microsoft.FSharp.Compiler.Tast
 open Microsoft.FSharp.Compiler.TcGlobals
 open Microsoft.FSharp.Compiler.AbstractIL.Internal 
 
-val ParseFormatString : Range.range -> TcGlobals -> string option -> (Range.range -> unit) -> string -> TType -> TType -> TType -> TType * TType
+val ParseFormatString : Range.range -> TcGlobals -> source: string option -> fmt: string -> bty: TType -> cty: TType -> dty: TType -> (TType * TType) * Range.range list

src/fsharp/CheckFormatStrings.fsi

@@ -6010,7 +6010,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) =
                 // sort by order of declaration
                 // REVIEW: this should be based off tcaug_adhoc_list, which is in declaration order
                 tycon.MembersOfFSharpTyconSorted
-                |> List.sortWith (fun v1 v2 -> rangeOrder.Compare(v1.ImplRange,v2.ImplRange))
+                |> List.sortWith (fun v1 v2 -> rangeOrder.Compare(v1.DefinitionRange,v2.DefinitionRange))
                 |> List.map (GenAbstractBinding cenv eenv tref)
                 |> List.unzip3 
                 |> mapTriple (List.concat, List.concat, List.concat)

src/fsharp/IlxGen.fs

@@ -1183,20 +1183,20 @@ let (|ValUse|_|) (item:Item) =
 
 let (|ActivePatternCaseUse|_|) (item:Item) = 
     match item with 
-    | Item.ActivePatternCase(APElemRef(_, vref, idx)) -> Some (vref.SigRange, vref.ImplRange, idx)
+    | Item.ActivePatternCase(APElemRef(_, vref, idx)) -> Some (vref.SigRange, vref.DefinitionRange, idx)
     | Item.ActivePatternResult(ap, _, idx,_) -> Some (ap.Range, ap.Range, idx)
     | _ -> None
 
 let tyconRefDefnEq g (eref1:EntityRef) (eref2: EntityRef) =
     tyconRefEq g eref1 eref2 
     // Signature items considered equal to implementation items
-    || ((eref1.ImplRange = eref2.ImplRange || eref1.SigRange = eref2.SigRange) &&
+    || ((eref1.DefinitionRange = eref2.DefinitionRange || eref1.SigRange = eref2.SigRange) &&
         (eref1.LogicalName = eref2.LogicalName))
 
 let valRefDefnEq g (vref1:ValRef) (vref2: ValRef) =
     valRefEq g vref1 vref2 
     // Signature items considered equal to implementation items
-    || ((vref1.ImplRange = vref2.ImplRange || vref1.SigRange = vref2.SigRange)) && 
+    || ((vref1.DefinitionRange = vref2.DefinitionRange || vref1.SigRange = vref2.SigRange)) && 
         (vref1.LogicalName = vref2.LogicalName)
 
 let unionCaseRefDefnEq g (uc1:UnionCaseRef) (uc2: UnionCaseRef) =
@@ -1245,7 +1245,7 @@ let ItemsAreEffectivelyEqual g orig other =
 
     | (Item.ArgName (id,_, _), ValUse vref) | (ValUse vref, Item.ArgName (id, _, _)) -> 
         (id.idText = vref.DisplayName && 
-         (id.idRange = vref.ImplRange || id.idRange = vref.SigRange))
+         (id.idRange = vref.DefinitionRange || id.idRange = vref.SigRange))
 
     | ILFieldUse f1, ILFieldUse f2 -> 
         ILFieldInfo.ILFieldInfosUseIdenticalDefinitions f1 f2 

src/fsharp/NameResolution.fs

@@ -1260,7 +1260,7 @@ let CheckEntityDefn cenv env (tycon:Entity) =
         let hashOfImmediateProps = new Dictionary<string,_>()
         for minfo in immediateMeths do
             let nm = minfo.LogicalName
-            let m = (match minfo.ArbitraryValRef with None -> m | Some vref -> vref.ImplRange)
+            let m = (match minfo.ArbitraryValRef with None -> m | Some vref -> vref.DefinitionRange)
             let others = getOtherMethods minfo
             // abstract/default pairs of duplicate methods are OK
             let IsAbstractDefaultPair (x:MethInfo) (y:MethInfo) = 
@@ -1289,7 +1289,7 @@ let CheckEntityDefn cenv env (tycon:Entity) =
 
         for pinfo in immediateProps do
             let nm = pinfo.PropertyName
-            let m = (match pinfo.ArbitraryValRef with None -> m | Some vref -> vref.ImplRange)
+            let m = (match pinfo.ArbitraryValRef with None -> m | Some vref -> vref.DefinitionRange)
             if hashOfImmediateMeths.ContainsKey(nm) then 
                 errorR(Error(FSComp.SR.chkPropertySameNameMethod(nm),m))
             let others = getHash hashOfImmediateProps nm
@@ -1344,7 +1344,7 @@ let CheckEntityDefn cenv env (tycon:Entity) =
             for minfo in immediateMeths do
                 if not minfo.IsDispatchSlot && not minfo.IsVirtual && minfo.IsInstance then
                     let nm = minfo.LogicalName
-                    let m = (match minfo.ArbitraryValRef with None -> m | Some vref -> vref.ImplRange)
+                    let m = (match minfo.ArbitraryValRef with None -> m | Some vref -> vref.DefinitionRange)
                     let parentMethsOfSameName = getHash hashOfAllVirtualMethsInParent nm 
                     let checkForDup erasureFlag (minfo2:MethInfo) = minfo2.IsDispatchSlot && MethInfosEquivByNameAndSig erasureFlag true cenv.g cenv.amap m minfo minfo2
                     match parentMethsOfSameName |> List.tryFind (checkForDup EraseAll) with
@@ -1359,11 +1359,11 @@ let CheckEntityDefn cenv env (tycon:Entity) =
 
                 if minfo.IsDispatchSlot then
                     let nm = minfo.LogicalName
-                    let m = (match minfo.ArbitraryValRef with None -> m | Some vref -> vref.ImplRange)
+                    let m = (match minfo.ArbitraryValRef with None -> m | Some vref -> vref.DefinitionRange)
                     let parentMethsOfSameName = getHash hashOfAllVirtualMethsInParent nm 
                     let checkForDup erasureFlag minfo2 = MethInfosEquivByNameAndSig erasureFlag true cenv.g cenv.amap m minfo minfo2
                     //if minfo.NumArgs.Length > 1 then 
-                    //    warning(Error(sprintf "Abstract methods taking curried arguments Duplicate method. The method '%s' has curried arguments but has the same name as another method in this type. Methods with curried arguments may not be overloaded" nm,(match minfo.ArbitraryValRef with None -> m | Some vref -> vref.ImplRange)))
+                    //    warning(Error(sprintf "Abstract methods taking curried arguments Duplicate method. The method '%s' has curried arguments but has the same name as another method in this type. Methods with curried arguments may not be overloaded" nm,(match minfo.ArbitraryValRef with None -> m | Some vref -> vref.DefinitionRange)))
                     if parentMethsOfSameName |> List.exists (checkForDup EraseAll) then
                         if parentMethsOfSameName |> List.exists (checkForDup EraseNone) then 
                             errorR(Error(FSComp.SR.chkDuplicateMethodInheritedType(nm),m))

src/fsharp/PostInferenceChecks.fs

@@ -1840,7 +1840,7 @@ and p_ValData x st =
       ( x.val_logical_name,
         x.val_compiled_name,
         // only keep range information on published values, not on optimization data
-        (if x.val_repr_info.IsSome then Some(x.val_range, x.ImplRange) else None),
+        (if x.val_repr_info.IsSome then Some(x.val_range, x.DefinitionRange) else None),
         x.val_type,
         x.val_flags.PickledBits,
         x.val_member_info,

src/fsharp/TastPickle.fs

@@ -549,7 +549,7 @@ let global_g = ref (None : TcGlobals option)
 #endif
 
 let mkTcGlobals (compilingFslib,sysCcu,ilg,fslibCcu,directoryToResolveRelativePaths,mlCompatibility,
-                 using40environment,isInteractive,getTypeCcu, emitDebugInfoInQuotations) =
+                 using40environment,isInteractive,getTypeCcu, emitDebugInfoInQuotations) = 
 
   let vara = NewRigidTypar "a" envRange
   let varb = NewRigidTypar "b" envRange

src/fsharp/TcGlobals.fs

@@ -4115,7 +4115,7 @@ and TcTyparOrMeasurePar optKind cenv (env:TcEnv) newOk tpenv (Typar(id,_,_) as t
         | _, _ -> 
             let item = Item.TypeVar(id.idText, res)
             CallNameResolutionSink cenv.tcSink (id.idRange,env.NameEnv,item,item,ItemOccurence.UseInType,env.DisplayEnv,env.eAccessRights)
-            // // record the ' as well for tokenization
+            // record the ' as well for tokenization
             // CallNameResolutionSink cenv.tcSink (tp.Range.StartRange,env.NameEnv,item,item,ItemOccurence.UseInType,env.DisplayEnv,env.eAccessRights)
             res, tpenv
     let key = id.idText
@@ -6299,10 +6299,16 @@ and TcConstStringExpr cenv overallTy env m tpenv s  =
       let ty' = mkPrintfFormatTy cenv.g aty bty cty dty ety
       if (not (isObjTy cenv.g overallTy) && AddCxTypeMustSubsumeTypeUndoIfFailed env.DisplayEnv cenv.css m overallTy ty') then 
         // Parse the format string to work out the phantom types 
-        let report m = match cenv.tcSink.CurrentSink with None -> () | Some sink  -> sink.NotifyFormatSpecifierLocation m
         let source = match cenv.tcSink.CurrentSink with None -> None | Some sink -> sink.CurrentSource
 
-        let aty',ety' = (try CheckFormatStrings.ParseFormatString m cenv.g source report (s.Replace("\r\n", "\n").Replace("\r", "\n")) bty cty dty with Failure s -> error (Error(FSComp.SR.tcUnableToParseFormatString(s),m)))
+        let (aty',ety'), specifierLocations = (try CheckFormatStrings.ParseFormatString m cenv.g source (s.Replace("\r\n", "\n").Replace("\r", "\n")) bty cty dty with Failure s -> error (Error(FSComp.SR.tcUnableToParseFormatString(s),m)))
+
+        match cenv.tcSink.CurrentSink with 
+        | None -> () 
+        | Some sink  -> 
+            for specifierLocation in specifierLocations do
+                sink.NotifyFormatSpecifierLocation specifierLocation
+
         UnifyTypes cenv env m aty aty'
         UnifyTypes cenv env m ety ety'
         mkCallNewFormat cenv.g m aty bty cty dty ety (mkString cenv.g m s),tpenv

src/fsharp/TypeChecker.fs

@@ -518,7 +518,7 @@ type Entity =
         x.Data.entity_range
 
     /// The range in the implementation, adjusted for an item in a signature
-    member x.ImplRange = 
+    member x.DefinitionRange = 
         match x.Data.entity_other_range with 
         | Some (r, true) -> r
         | _ -> x.Range
@@ -977,7 +977,7 @@ and
       entity_range: range
 
       // MUTABILITY: the signature is adjusted when it is checked
-      /// If the flag is true, this is the implementation range for an item in a signature, otherwise it is 
+      /// If this field is populated, this is the implementation range for an item in a signature, otherwise it is 
       /// the signature range for an item in an implementation
       mutable entity_other_range: (range * bool) option
 
@@ -1303,7 +1303,7 @@ and
       /// Name/range of the case 
       Id: Ident 
 
-      /// If the flag is true, this is the implementation range for an item in a signature, otherwise it is 
+      /// If this field is populated, this is the implementation range for an item in a signature, otherwise it is 
       /// the signature range for an item in an implementation
       // MUTABILITY: used when propagating signature attributes into the implementation.
       mutable OtherRangeOpt : (range * bool) option
@@ -1316,14 +1316,17 @@ and
       mutable Attribs: Attribs }
 
     member uc.Range = uc.Id.idRange
-    member uc.ImplRange = 
+
+    member uc.DefinitionRange = 
         match uc.OtherRangeOpt with 
         | Some (m,true) -> m
         | _ -> uc.Range 
+
     member uc.SigRange = 
         match uc.OtherRangeOpt with 
         | Some (m,false) -> m
         | _ -> uc.Range 
+
     member uc.DisplayName = uc.Id.idText
     member uc.RecdFieldsArray = uc.FieldTable.FieldsByIndex 
     member uc.RecdFields = uc.FieldTable.FieldsByIndex |> Array.toList
@@ -1373,7 +1376,7 @@ and
       /// Name/declaration-location of the field 
       rfield_id: Ident 
 
-      /// If the flag is true, this is the implementation range for an item in a signature, otherwise it is 
+      /// If this field is populated, this is the implementation range for an item in a signature, otherwise it is 
       /// the signature range for an item in an implementation
       // MUTABILITY: used when propagating signature attributes into the implementation.
       mutable rfield_other_range: (range * bool) option }
@@ -1389,10 +1392,12 @@ and
 
     /// Declaration-location of the field 
     member v.Range = v.rfield_id.idRange
-    member v.ImplRange = 
+
+    member v.DefinitionRange = 
         match v.rfield_other_range with 
         | Some (m, true) -> m
         | _ -> v.Range 
+
     member v.SigRange = 
         match v.rfield_other_range with 
         | Some (m, false) -> m
@@ -2050,11 +2055,9 @@ and
     member x.Accessibility              = x.Data.val_access
 
     /// Range of the definition (implementation) of the value, used by Visual Studio 
-    /// Updated by mutation when the implementation is matched against the signature. 
-    member x.ImplRange            =  x.Data.ImplRange
+    member x.DefinitionRange            =  x.Data.DefinitionRange
 
     /// Range of the definition (signature) of the value, used by Visual Studio 
-    /// Updated by mutation when the implementation is matched against the signature. 
     member x.SigRange            = x.Data.SigRange
 
     /// The value of a value or member marked with [<LiteralAttribute>] 
@@ -2392,7 +2395,7 @@ and
     { val_logical_name: string
       val_compiled_name: string option
       val_range: range
-      /// If the flag is true, this is the implementation range for an item in a signature, otherwise it is 
+      /// If this field is populated, this is the implementation range for an item in a signature, otherwise it is 
       /// the signature range for an item in an implementation
       mutable val_other_range: (range * bool) option 
       mutable val_type: TType
@@ -2438,7 +2441,7 @@ and
       /// XML documentation signature for the value
       mutable val_xmldocsig : string } 
 
-    member x.ImplRange            = 
+    member x.DefinitionRange            = 
         match x.val_other_range with
         | Some (m,true) -> m
         | _ -> x.val_range
@@ -2711,7 +2714,7 @@ and
     member x.CompiledRepresentationForNamedType = x.Deref.CompiledRepresentationForNamedType
 
     /// The implementation definition location of the namespace, module or type
-    member x.ImplRange = x.Deref.ImplRange
+    member x.DefinitionRange = x.Deref.DefinitionRange
 
     /// The signature definition location of the namespace, module or type
     member x.SigRange = x.Deref.SigRange
@@ -3051,7 +3054,7 @@ and
     /// For other values it is just the actual parent.
     member x.ApparentParent             = x.Deref.ApparentParent
 
-    member x.ImplRange        = x.Deref.ImplRange
+    member x.DefinitionRange            = x.Deref.DefinitionRange
 
     member x.SigRange        = x.Deref.SigRange
 
@@ -3186,11 +3189,16 @@ and UnionCaseRef =
         match x.TyconRef.GetUnionCaseByName x.CaseName with 
         | Some res -> res
         | None -> error(InternalError(sprintf "union case %s not found in type %s" x.CaseName x.TyconRef.LogicalName, x.TyconRef.Range))
+
     member x.TryUnionCase =  x.TyconRef.TryDeref |> Option.bind (fun tcref -> tcref.GetUnionCaseByName x.CaseName)
+
     member x.Attribs = x.UnionCase.Attribs
     member x.Range = x.UnionCase.Range
-    member x.ImplRange = x.UnionCase.ImplRange
-    member x.SigRange = x.UnionCase.ImplRange
+
+    member x.DefinitionRange = x.UnionCase.DefinitionRange
+
+    member x.SigRange = x.UnionCase.DefinitionRange
+
     member x.Index = 
         try 
            // REVIEW: this could be faster, e.g. by storing the index in the NameMap 
@@ -3211,11 +3219,15 @@ and RecdFieldRef =
         match tcref.GetFieldByName id with 
         | Some res -> res
         | None -> error(InternalError(sprintf "field %s not found in type %s" id tcref.LogicalName, tcref.Range))
+
     member x.TryRecdField =  x.TyconRef.TryDeref |> Option.bind (fun tcref -> tcref.GetFieldByName x.FieldName)
+
     member x.PropertyAttribs = x.RecdField.PropertyAttribs
     member x.Range = x.RecdField.Range
-    member x.ImplRange = x.RecdField.ImplRange
-    member x.SigRange = x.RecdField.ImplRange
+
+    member x.DefinitionRange = x.RecdField.DefinitionRange
+
+    member x.SigRange = x.RecdField.DefinitionRange
 
     member x.Index =
         let (RFRef(tcref,id)) = x

src/fsharp/tast.fs

@@ -135,13 +135,13 @@ module internal ItemDescriptionsImpl =
     let rangeOfValRef preferFlag (vref:ValRef) =
         match preferFlag with 
         | None -> vref.Range 
-        | Some false -> vref.ImplRange 
+        | Some false -> vref.DefinitionRange 
         | Some true -> vref.SigRange
 
     let rangeOfEntityRef preferFlag (eref:EntityRef) =
         match preferFlag with 
         | None -> eref.Range 
-        | Some false -> eref.ImplRange 
+        | Some false -> eref.DefinitionRange 
         | Some true -> eref.SigRange
 
 
@@ -170,13 +170,13 @@ module internal ItemDescriptionsImpl =
     let rangeOfUnionCaseInfo preferFlag (ucinfo:UnionCaseInfo) =      
         match preferFlag with 
         | None -> ucinfo.UnionCase.Range 
-        | Some false -> ucinfo.UnionCase.ImplRange 
+        | Some false -> ucinfo.UnionCase.DefinitionRange 
         | Some true -> ucinfo.UnionCase.SigRange
 
     let rangeOfRecdFieldInfo preferFlag (rfinfo:RecdFieldInfo) =      
         match preferFlag with 
         | None -> rfinfo.RecdField.Range 
-        | Some false -> rfinfo.RecdField.ImplRange 
+        | Some false -> rfinfo.RecdField.DefinitionRange 
         | Some true -> rfinfo.RecdField.SigRange
 
     let rec rangeOfItem (g:TcGlobals) preferFlag d =