Skip to content

Commit

Permalink
Merge pull request #5166 from Microsoft/merges/master-to-dev16.0
Browse files Browse the repository at this point in the history 
Merge master to dev16.0
  • Loading branch information
@KevinRansom
KevinRansom authored Jun 12, 2018
2 parents 7e86a0d + e9e12ba commit 1e2159d
Show file tree
Hide file tree
Showing 21 changed files with 111 additions and 254 deletions.
4 changes: 2 additions & 2 deletions src/FSharpSource.Settings.targets
View file
Original file line number Diff line number Diff line change
Expand Up @@ -101,8 +101,8 @@
<!-- Frozen FSharp.Core package being built with this build -->
<FSharpCore41TargetPackageVersion>4.1.19</FSharpCore41TargetPackageVersion>
<FSharpCore41TargetMajorVersion>4.1</FSharpCore41TargetMajorVersion>
<FSharpCoreLatestTargetPackageVersion>4.5.0</FSharpCoreLatestTargetPackageVersion>
<FSharpCoreLatestTargetMajorVersion>4.5</FSharpCoreLatestTargetMajorVersion>
<FSharpCoreTargetPackageVersion>4.5.0</FSharpCoreTargetPackageVersion>
<FSharpCoreTargetMajorVersion>4.5</FSharpCoreTargetMajorVersion>

<!-- Always qualify the IntermediateOutputPath by the TargetDotnetProfile if any exists -->
<IntermediateOutputPath>obj\$(Configuration)\$(TargetDotnetProfile)\</IntermediateOutputPath>
Expand Down
19 changes: 0 additions & 19 deletions src/absil/illib.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -279,30 +279,11 @@ module List =
| [] -> None
| h::t -> if f h then Some (h,n) else findi (n+1) f t

let chop n l =
if n = List.length l then (l,[]) else // avoids allocation unless necessary
let rec loop n l acc =
if n <= 0 then (List.rev acc,l) else
match l with
| [] -> failwith "List.chop: overchop"
| (h::t) -> loop (n-1) t (h::acc)
loop n l []

let take n l =
if n = List.length l then l else
let rec loop acc n l =
match l with
| [] -> List.rev acc
| x::xs -> if n<=0 then List.rev acc else loop (x::acc) (n-1) xs

loop [] n l

let rec drop n l =
match l with
| [] -> []
| _::xs -> if n=0 then l else drop (n-1) xs


let splitChoose select l =
let rec ch acc1 acc2 l =
match l with
Expand Down
144 changes: 74 additions & 70 deletions src/fsharp/ConstraintSolver.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1913,81 +1913,85 @@ and CanMemberSigsMatchUpToCheck
(subsumeArg: CalledArg -> CallerArg<_> -> OperationResult<unit>) // used to compare the arguments for compatibility
reqdRetTyOpt
(calledMeth:CalledMeth<_>): ImperativeOperationResult =

let g = csenv.g
let amap = csenv.amap
let m = csenv.m
trackErrors {
let g = csenv.g
let amap = csenv.amap
let m = csenv.m

let minfo = calledMeth.Method
let minst = calledMeth.CalledTyArgs
let uminst = calledMeth.CallerTyArgs
let callerObjArgTys = calledMeth.CallerObjArgTys
let assignedItemSetters = calledMeth.AssignedItemSetters
let unnamedCalledOptArgs = calledMeth.UnnamedCalledOptArgs
let unnamedCalledOutArgs = calledMeth.UnnamedCalledOutArgs

// First equate the method instantiation (if any) with the method type parameters
if minst.Length <> uminst.Length then ErrorD(Error(FSComp.SR.csTypeInstantiationLengthMismatch(), m)) else

Iterate2D unifyTypes minst uminst ++ (fun () ->

if not (permitOptArgs || isNil unnamedCalledOptArgs) then ErrorD(Error(FSComp.SR.csOptionalArgumentNotPermittedHere(), m)) else


let calledObjArgTys = calledMeth.CalledObjArgTys(m)
let minfo = calledMeth.Method
let minst = calledMeth.CalledTyArgs
let uminst = calledMeth.CallerTyArgs
let callerObjArgTys = calledMeth.CallerObjArgTys
let assignedItemSetters = calledMeth.AssignedItemSetters
let unnamedCalledOptArgs = calledMeth.UnnamedCalledOptArgs
let unnamedCalledOutArgs = calledMeth.UnnamedCalledOutArgs

// First equate the method instantiation (if any) with the method type parameters
if minst.Length <> uminst.Length then
return! ErrorD(Error(FSComp.SR.csTypeInstantiationLengthMismatch(), m))
else
do! Iterate2D unifyTypes minst uminst
if not (permitOptArgs || isNil unnamedCalledOptArgs) then
return! ErrorD(Error(FSComp.SR.csOptionalArgumentNotPermittedHere(), m))
else
let calledObjArgTys = calledMeth.CalledObjArgTys(m)

// Check all the argument types.
// Check all the argument types.

if calledObjArgTys.Length <> callerObjArgTys.Length then
if (calledObjArgTys.Length <> 0) then
ErrorD(Error (FSComp.SR.csMemberIsNotStatic(minfo.LogicalName), m))
else
ErrorD(Error (FSComp.SR.csMemberIsNotInstance(minfo.LogicalName), m))
else
Iterate2D subsumeTypes calledObjArgTys callerObjArgTys ++ (fun () ->
(calledMeth.ArgSets |> IterateD (fun argSet ->
if argSet.UnnamedCalledArgs.Length <> argSet.UnnamedCallerArgs.Length then ErrorD(Error(FSComp.SR.csArgumentLengthMismatch(), m)) else
Iterate2D subsumeArg argSet.UnnamedCalledArgs argSet.UnnamedCallerArgs)) ++ (fun () ->
(calledMeth.ParamArrayCalledArgOpt |> OptionD (fun calledArg ->
if isArray1DTy g calledArg.CalledArgumentType then
let paramArrayElemTy = destArrayTy g calledArg.CalledArgumentType
let reflArgInfo = calledArg.ReflArgInfo // propgate the reflected-arg info to each param array argument
calledMeth.ParamArrayCallerArgs |> OptionD (IterateD (fun callerArg -> subsumeArg (CalledArg((0, 0), false, NotOptional, NoCallerInfo, false, false, None, reflArgInfo, paramArrayElemTy)) callerArg))
else
CompleteD)

) ++ (fun () ->
(calledMeth.ArgSets |> IterateD (fun argSet ->
argSet.AssignedNamedArgs |> IterateD (fun arg -> subsumeArg arg.CalledArg arg.CallerArg))) ++ (fun () ->
(assignedItemSetters |> IterateD (fun (AssignedItemSetter(_, item, caller)) ->
let name, calledArgTy =
match item with
| AssignedPropSetter(_, pminfo, pminst) ->
let calledArgTy = List.head (List.head (pminfo.GetParamTypes(amap, m, pminst)))
pminfo.LogicalName, calledArgTy

| AssignedILFieldSetter(finfo) ->
(* Get or set instance IL field *)
let calledArgTy = finfo.FieldType(amap, m)
finfo.FieldName, calledArgTy
if calledObjArgTys.Length <> callerObjArgTys.Length then
if (calledObjArgTys.Length <> 0) then
return! ErrorD(Error (FSComp.SR.csMemberIsNotStatic(minfo.LogicalName), m))
else
return! ErrorD(Error (FSComp.SR.csMemberIsNotInstance(minfo.LogicalName), m))
else
do! Iterate2D subsumeTypes calledObjArgTys callerObjArgTys
for argSet in calledMeth.ArgSets do
if argSet.UnnamedCalledArgs.Length <> argSet.UnnamedCallerArgs.Length then
return! ErrorD(Error(FSComp.SR.csArgumentLengthMismatch(), m))
else
do! Iterate2D subsumeArg argSet.UnnamedCalledArgs argSet.UnnamedCallerArgs
match calledMeth.ParamArrayCalledArgOpt with
| Some calledArg ->
if isArray1DTy g calledArg.CalledArgumentType then
let paramArrayElemTy = destArrayTy g calledArg.CalledArgumentType
let reflArgInfo = calledArg.ReflArgInfo // propgate the reflected-arg info to each param array argument
match calledMeth.ParamArrayCallerArgs with
| Some args ->
for callerArg in args do
do! subsumeArg (CalledArg((0, 0), false, NotOptional, NoCallerInfo, false, false, None, reflArgInfo, paramArrayElemTy)) callerArg
| _ -> ()
| _ -> ()
for argSet in calledMeth.ArgSets do
for arg in argSet.AssignedNamedArgs do
do! subsumeArg arg.CalledArg arg.CallerArg
for (AssignedItemSetter(_, item, caller)) in assignedItemSetters do
let name, calledArgTy =
match item with
| AssignedPropSetter(_, pminfo, pminst) ->
let calledArgTy = List.head (List.head (pminfo.GetParamTypes(amap, m, pminst)))
pminfo.LogicalName, calledArgTy

| AssignedILFieldSetter(finfo) ->
(* Get or set instance IL field *)
let calledArgTy = finfo.FieldType(amap, m)
finfo.FieldName, calledArgTy

| AssignedRecdFieldSetter(rfinfo) ->
let calledArgTy = rfinfo.FieldType
rfinfo.Name, calledArgTy
| AssignedRecdFieldSetter(rfinfo) ->
let calledArgTy = rfinfo.FieldType
rfinfo.Name, calledArgTy

subsumeArg (CalledArg((-1, 0), false, NotOptional, NoCallerInfo, false, false, Some (mkSynId m name), ReflectedArgInfo.None, calledArgTy)) caller) )) ++ (fun () ->

// - Always take the return type into account for
// -- op_Explicit, op_Implicit
// -- methods using tupling of unfilled out args
// - Never take into account return type information for constructors
match reqdRetTyOpt with
| None -> CompleteD
| Some _ when minfo.IsConstructor -> CompleteD
| Some _ when not alwaysCheckReturn && isNil unnamedCalledOutArgs -> CompleteD
| Some reqdRetTy ->
let methodRetTy = calledMeth.CalledReturnTypeAfterOutArgTupling
unifyTypes reqdRetTy methodRetTy )))))
do! subsumeArg (CalledArg((-1, 0), false, NotOptional, NoCallerInfo, false, false, Some (mkSynId m name), ReflectedArgInfo.None, calledArgTy)) caller
// - Always take the return type into account for
// -- op_Explicit, op_Implicit
// -- methods using tupling of unfilled out args
// - Never take into account return type information for constructors
match reqdRetTyOpt with
| Some _ when (minfo.IsConstructor || not alwaysCheckReturn && isNil unnamedCalledOutArgs) -> ()
| Some reqdRetTy ->
let methodRetTy = calledMeth.CalledReturnTypeAfterOutArgTupling
return! unifyTypes reqdRetTy methodRetTy
| _ -> ()
}

// Assert a subtype constraint, and wrap an ErrorsFromAddingSubsumptionConstraint error around any failure
// to allow us to report the outer types involved in the constraint
Expand Down
8 changes: 4 additions & 4 deletions src/fsharp/DetupleArgs.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -562,16 +562,16 @@ let decideTransform g z v callPatterns (m, tps, vss:Val list list, rty) =
(* NOTE: 'a in arg types may have been instanced at different tuples... *)
(* commonCallPattern has to handle those cases. *)
let callPattern = commonCallPattern callPatterns // common CallPattern
let callPattern = List.take vss.Length callPattern // restricted to max nArgs
let callPattern = List.truncate vss.Length callPattern // restricted to max nArgs
// Get formal callPattern by defn usage of formals
let formalCallPattern = decideFormalSuggestedCP g z tys vss
let callPattern = List.take callPattern.Length formalCallPattern
let callPattern = List.truncate callPattern.Length formalCallPattern
// Zip with information about known args
let callPattern, tyfringes = zipCallPatternArgTys m g callPattern vss
// Drop trivial tail AND
let callPattern = minimalCallPattern callPattern
// Shorten tyfringes (zippable)
let tyfringes = List.take callPattern.Length tyfringes
let tyfringes = List.truncate callPattern.Length tyfringes
if isTrivialCP callPattern then
None // no transform
else
Expand Down Expand Up @@ -791,7 +791,7 @@ let passBind penv (TBind(fOrig, repr, letSeqPtOpt) as bind) =
let p = transformedFormals.Length
if (vss.Length < p) then internalError "passBinds: |vss|<p - detuple pass"
let xqNs = List.drop p vss
let x1ps = List.take p vss
let x1ps = List.truncate p vss
let y1Ps = List.concat (List.map2 transFormal transformedFormals x1ps)
let formals = y1Ps @ xqNs
// fCBody - parts
Expand Down
3 changes: 3 additions & 0 deletions src/fsharp/ErrorLogger.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -570,8 +570,11 @@ type TrackErrorsBuilder() =
member x.Return res = ResultD res
member x.ReturnFrom res = res
member x.For(seq, k) = IterateD k seq
member x.Combine(expr1, expr2) = expr1 ++ expr2
member x.While(gd, k) = WhileD gd k
member x.Zero() = CompleteD
member x.Delay(fn) = fun () -> fn ()
member x.Run(fn) = fn ()

let trackErrors = TrackErrorsBuilder()

Expand Down
Loading

0 comments on commit 1e2159d

Please sign in to comment.