Skip to content

Commit

Permalink
small cleanups in MethodCalls.fs
Browse files Browse the repository at this point in the history
  • Loading branch information
forki committed Mar 5, 2018
1 parent f214dcc commit 8b673e0
Showing 1 changed file with 19 additions and 24 deletions.
43 changes: 19 additions & 24 deletions src/fsharp/MethodCalls.fs
Original file line number Diff line number Diff line change
Expand Up @@ -530,22 +530,21 @@ let ComputeConstrainedCallInfo g amap m (objArgs,minfo:MethInfo) =
/// Adjust the 'this' pointer before making a call
/// Take the address of a struct, and coerce to an interface/base/constraint type if necessary
let TakeObjAddrForMethodCall g amap (minfo:MethInfo) isMutable m objArgs f =
let ccallInfo = ComputeConstrainedCallInfo g amap m (objArgs,minfo)
let mustTakeAddress =
(minfo.IsStruct && not minfo.IsExtensionMember) // don't take the address of a struct when passing to an extension member
||
(match ccallInfo with
| Some _ -> true
| None -> false)
let ccallInfo = ComputeConstrainedCallInfo g amap m (objArgs,minfo)

let wrap,objArgs =
match objArgs with
| [objArgExpr] ->
| [objArgExpr] ->
let hasCallInfo = ccallInfo.IsSome
let mustTakeAddress =
(minfo.IsStruct && not minfo.IsExtensionMember) // don't take the address of a struct when passing to an extension member
|| hasCallInfo
let objArgTy = tyOfExpr g objArgExpr
let wrap,objArgExpr' = mkExprAddrOfExpr g mustTakeAddress (Option.isSome ccallInfo) isMutable objArgExpr None m
let wrap,objArgExpr' = mkExprAddrOfExpr g mustTakeAddress hasCallInfo isMutable objArgExpr None m

// Extension members and calls to class constraints may need a coercion for their object argument
let objArgExpr' =
if Option.isNone ccallInfo && // minfo.IsExtensionMember && minfo.IsStruct &&
if not hasCallInfo && // minfo.IsExtensionMember && minfo.IsStruct &&
not (TypeDefinitelySubsumesTypeNoCoercion 0 g amap m minfo.ApparentEnclosingType objArgTy) then
mkCoerceExpr(objArgExpr',minfo.ApparentEnclosingType,m,objArgTy)
else
Expand All @@ -554,7 +553,7 @@ let TakeObjAddrForMethodCall g amap (minfo:MethInfo) isMutable m objArgs f =
wrap,[objArgExpr']

| _ ->
(fun x -> x), objArgs
id, objArgs
let e,ety = f ccallInfo objArgs
wrap e,ety

Expand All @@ -579,7 +578,7 @@ let BuildILMethInfoCall g amap m isProp (minfo:ILMethInfo) valUseFlags minst dir
let ilMethRef = minfo.ILMethodRef
let newobj = ctor && (match valUseFlags with NormalValUse -> true | _ -> false)
let exprTy = if ctor then minfo.ApparentEnclosingType else minfo.GetFSharpReturnTy(amap, m, minst)
let retTy = (if not ctor && (ilMethRef.ReturnType = ILType.Void) then [] else [exprTy])
let retTy = if not ctor && ilMethRef.ReturnType = ILType.Void then [] else [exprTy]
let isDllImport = minfo.IsDllImport g
Expr.Op(TOp.ILCall(useCallvirt,isProtected,valu,newobj,valUseFlags,isProp,isDllImport,ilMethRef,minfo.DeclaringTypeInst,minst,retTy),[],args,m),
exprTy
Expand All @@ -604,9 +603,7 @@ let BuildFSharpMethodApp g m (vref: ValRef) vexp vexprty (args: Exprs) =
((args,vexprty), arities) ||> List.mapFold (fun (args,fty) arity ->
match arity,args with
| (0|1),[] when typeEquiv g (domainOfFunTy g fty) g.unit_ty -> mkUnit g m, (args, rangeOfFunTy g fty)
| 0,(arg::argst)->


| 0,(arg::argst) ->
warning(InternalError(sprintf "Unexpected zero arity, args = %s" (Layout.showL (Layout.sepListL (Layout.rightL (Layout.TaggedTextOps.tagText ";")) (List.map exprL args))),m));
arg, (argst, rangeOfFunTy g fty)
| 1,(arg :: argst) -> arg, (argst, rangeOfFunTy g fty)
Expand Down Expand Up @@ -673,9 +670,8 @@ let TryImportProvidedMethodBaseAsLibraryIntrinsic (amap:Import.ImportMap, m:rang
| _ ->
match amap.g.knownFSharpCoreModules.TryGetValue(declaringEntity.LogicalName) with
| true,modRef ->
match modRef.ModuleOrNamespaceType.AllValsByLogicalName |> Seq.tryPick (fun (KeyValue(_,v)) -> if v.CompiledName = methodName then Some v else None) with
| Some v -> Some (mkNestedValRef modRef v)
| None -> None
modRef.ModuleOrNamespaceType.AllValsByLogicalName
|> Seq.tryPick (fun (KeyValue(_,v)) -> if v.CompiledName = methodName then Some (mkNestedValRef modRef v) else None)
| _ -> None
else
None
Expand All @@ -693,13 +689,12 @@ let TryImportProvidedMethodBaseAsLibraryIntrinsic (amap:Import.ImportMap, m:rang
// objArgs: the 'this' argument, if any
// args: the arguments, if any
let BuildMethodCall tcVal g amap isMutable m isProp minfo valUseFlags minst objArgs args =

let direct = IsBaseCall objArgs

TakeObjAddrForMethodCall g amap minfo isMutable m objArgs (fun ccallInfo objArgs ->
let allArgs = (objArgs @ args)
let allArgs = objArgs @ args
let valUseFlags =
if (direct && (match valUseFlags with NormalValUse -> true | _ -> false)) then
if direct && (match valUseFlags with NormalValUse -> true | _ -> false) then
VSlotDirectCall
else
match ccallInfo with
Expand All @@ -722,7 +717,7 @@ let BuildMethodCall tcVal g amap isMutable m isProp minfo valUseFlags minst objA
// these calls are provided by the runtime and should not be called from the user code
if isArrayTy g enclTy then
let tpe = TypeProviderError(FSComp.SR.tcRuntimeSuppliedMethodCannotBeUsedInUserCode(minfo.DisplayName), providedMeth.TypeProviderDesignation, m)
error (tpe)
error tpe
let valu = isStructTy g enclTy
let isCtor = minfo.IsConstructor
if minfo.IsClassConstructor then
Expand All @@ -747,7 +742,7 @@ let BuildMethodCall tcVal g amap isMutable m isProp minfo valUseFlags minst objA
elif isFunTy g enclTy then [ domainOfFunTy g enclTy; rangeOfFunTy g enclTy ] // provided expressions can call Invoke
else minfo.DeclaringTypeInst
let actualMethInst = minst
let retTy = (if not isCtor && (ilMethRef.ReturnType = ILType.Void) then [] else [exprTy])
let retTy = if not isCtor && (ilMethRef.ReturnType = ILType.Void) then [] else [exprTy]
let noTailCall = false
let expr = Expr.Op(TOp.ILCall(useCallvirt,isProtected,valu,isNewObj,valUseFlags,isProp,noTailCall,ilMethRef,actualTypeInst,actualMethInst, retTy),[],allArgs,m)
expr,exprTy
Expand Down Expand Up @@ -1191,7 +1186,7 @@ module ProvidedMethodCalls =
|> Array.map (fun pty -> eraseSystemType (amap,m,pty))
let paramVars =
erasedParamTys
|> Array.mapi (fun i erasedParamTy -> erasedParamTy.PApply((fun ty -> ProvidedVar.Fresh("arg" + i.ToString(),ty)),m))
|> Array.mapi (fun i erasedParamTy -> erasedParamTy.PApply((fun ty -> ProvidedVar.Fresh("arg" + i.ToString(),ty)),m))


// encode "this" as the first ParameterExpression, if applicable
Expand Down

0 comments on commit 8b673e0

Please sign in to comment.