Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

reduce allocations #1207

Closed
98 changes: 59 additions & 39 deletions src/fsharp/MethodOverrides.fs
Original file line number Diff line number Diff line change
Expand Up @@ -265,17 +265,21 @@ module DispatchSlotChecking =

let isReqdTyInterface = isInterfaceTy g reqdTy
let showMissingMethodsAndRaiseErrors = (isReqdTyInterface || not isOverallTyAbstract)
let res = ref true
let fail exn = (res := false ; if showMissingMethodsAndRaiseErrors then errorR exn)
let mutable res = true
let fail exn = (res <- false; if showMissingMethodsAndRaiseErrors then errorR exn)

// Index the availPriorOverrides and overrides by name
let availPriorOverridesKeyed = availPriorOverrides |> NameMultiMap.initBy (fun ov -> ov.LogicalName)
let overridesKeyed = overrides |> NameMultiMap.initBy (fun ov -> ov.LogicalName)

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@vasily-kirichenko Is this part below cleanup or performance improvements? If the former let's put in in a separate PR? If the latter then please look for a way to minimize the diff, e.g. by locally using 2-space indentation so old/new lines match exactly, or some other technique. Thanks!

dispatchSlots |> List.iter (fun (RequiredSlot(dispatchSlot,isOptional)) ->

match NameMultiMap.find dispatchSlot.LogicalName overridesKeyed
|> List.filter (OverrideImplementsDispatchSlot g amap m dispatchSlot) with
for RequiredSlot(dispatchSlot,isOptional) in dispatchSlots do
let formatMethSig() = FormatMethInfoSig g amap m denv dispatchSlot

let overrideInfos =
NameMultiMap.find dispatchSlot.LogicalName overridesKeyed
|> List.filter (OverrideImplementsDispatchSlot g amap m dispatchSlot)

match overrideInfos with
| [ovd] ->
if not ovd.IsCompilerGenerated then
let item = Item.MethodGroup(ovd.LogicalName,[dispatchSlot],None)
Expand All @@ -286,39 +290,55 @@ module DispatchSlotChecking =
if not isOptional &&
// Check that no available prior override implements this dispatch slot
not (DispatchSlotIsAlreadyImplemented g amap m availPriorOverridesKeyed dispatchSlot) then
// error reporting path
let (CompiledSig (vargtys,_vrty,fvmtps,_)) = CompiledSigOfMeth g amap m dispatchSlot
let noimpl() = if isReqdTyInterface then fail(Error(FSComp.SR.typrelNoImplementationGivenWithSuggestion(NicePrint.stringOfMethInfo amap m denv dispatchSlot), m))
else fail(Error(FSComp.SR.typrelNoImplementationGiven(NicePrint.stringOfMethInfo amap m denv dispatchSlot), m))
match overrides |> List.filter (IsPartialMatch g amap m dispatchSlot) with
| [] ->
match overrides |> List.filter (fun overrideBy -> IsNameMatch dispatchSlot overrideBy &&
IsImplMatch g dispatchSlot overrideBy) with
| [] ->
noimpl()
| [ Override(_,_,_,(mtps,_),argTys,_,_,_) as overrideBy ] ->
let error_msg =
if argTys.Length <> vargtys.Length then FSComp.SR.typrelMemberDoesNotHaveCorrectNumberOfArguments(FormatOverride denv overrideBy, FormatMethInfoSig g amap m denv dispatchSlot)
elif mtps.Length <> fvmtps.Length then FSComp.SR.typrelMemberDoesNotHaveCorrectNumberOfTypeParameters(FormatOverride denv overrideBy, FormatMethInfoSig g amap m denv dispatchSlot)
elif not (IsTyparKindMatch g amap m dispatchSlot overrideBy) then FSComp.SR.typrelMemberDoesNotHaveCorrectKindsOfGenericParameters(FormatOverride denv overrideBy, FormatMethInfoSig g amap m denv dispatchSlot)
else FSComp.SR.typrelMemberCannotImplement(FormatOverride denv overrideBy, NicePrint.stringOfMethInfo amap m denv dispatchSlot, FormatMethInfoSig g amap m denv dispatchSlot)
fail(Error(error_msg, overrideBy.Range))
| overrideBy :: _ ->
errorR(Error(FSComp.SR.typrelOverloadNotFound(FormatMethInfoSig g amap m denv dispatchSlot, FormatMethInfoSig g amap m denv dispatchSlot),overrideBy.Range))

| [ overrideBy ] ->

match dispatchSlots |> List.filter (fun (RequiredSlot(dispatchSlot,_)) -> OverrideImplementsDispatchSlot g amap m dispatchSlot overrideBy) with
| [] ->
// Error will be reported below in CheckOverridesAreAllUsedOnce
()
| _ ->
noimpl()

| _ ->
fail(Error(FSComp.SR.typrelOverrideWasAmbiguous(FormatMethInfoSig g amap m denv dispatchSlot),m))
| _ -> fail(Error(FSComp.SR.typrelMoreThenOneOverride(FormatMethInfoSig g amap m denv dispatchSlot),m)))
!res
// error reporting path
let (CompiledSig (vargtys,_,fvmtps,_)) = CompiledSigOfMeth g amap m dispatchSlot

let noimpl() =
let formattedMethodInfo = NicePrint.stringOfMethInfo amap m denv dispatchSlot
if isReqdTyInterface then
fail(Error(FSComp.SR.typrelNoImplementationGivenWithSuggestion(formattedMethodInfo), m))
else
fail(Error(FSComp.SR.typrelNoImplementationGiven(formattedMethodInfo), m))

match overrides |> List.filter (IsPartialMatch g amap m dispatchSlot) with
| [] ->
let overrides = overrides |> List.filter (fun overrideBy ->
IsNameMatch dispatchSlot overrideBy && IsImplMatch g dispatchSlot overrideBy)

match overrides with
| [] -> noimpl()
| Override(_,_,_,(mtps,_),argTys,_,_,_) as overrideBy :: rest ->
let formatOverride() = FormatOverride denv overrideBy
match rest with
| [] ->
let error_msg =
if argTys.Length <> vargtys.Length then
FSComp.SR.typrelMemberDoesNotHaveCorrectNumberOfArguments(formatOverride(), formatMethSig())
elif mtps.Length <> fvmtps.Length then
FSComp.SR.typrelMemberDoesNotHaveCorrectNumberOfTypeParameters(formatOverride(), formatMethSig())
elif not (IsTyparKindMatch g amap m dispatchSlot overrideBy) then
FSComp.SR.typrelMemberDoesNotHaveCorrectKindsOfGenericParameters(formatOverride(), formatMethSig())
else
FSComp.SR.typrelMemberCannotImplement(formatOverride(), NicePrint.stringOfMethInfo amap m denv dispatchSlot, formatMethSig())
fail(Error(error_msg, overrideBy.Range))
| _ ->
errorR(Error(FSComp.SR.typrelOverloadNotFound(formatMethSig(), formatMethSig()),overrideBy.Range))

| [ overrideBy ] ->
let matchedSlotsFound =
dispatchSlots
|> List.exists (fun (RequiredSlot(dispatchSlot,_)) ->
OverrideImplementsDispatchSlot g amap m dispatchSlot overrideBy)
if matchedSlotsFound then
// Error will be reported below in CheckOverridesAreAllUsedOnce
()
else
noimpl()

| _ ->
fail(Error(FSComp.SR.typrelOverrideWasAmbiguous(formatMethSig()),m))
| _ -> fail(Error(FSComp.SR.typrelMoreThenOneOverride(formatMethSig()),m))
res

/// Check all implementations implement some dispatch slot.
let CheckOverridesAreAllUsedOnce(denv, g, amap, isObjExpr, reqdTy,
Expand Down
25 changes: 11 additions & 14 deletions src/fsharp/tast.fs
Original file line number Diff line number Diff line change
Expand Up @@ -4398,19 +4398,18 @@ let fslibValRefEq fslibCcu vref1 vref2 =
/// This takes into account the possibility that they may have type forwarders
let primEntityRefEq compilingFslib fslibCcu (x : EntityRef) (y : EntityRef) =
x === y ||
match x.IsResolved,y.IsResolved with
| true, true when not compilingFslib -> x.ResolvedTarget === y.ResolvedTarget
| _ ->
match x.IsLocalRef,y.IsLocalRef with
| false, false when

if x.IsResolved && y.IsResolved && not compilingFslib then
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

the same stuff is happening couple of lines down in primValRefEq - and that method shows up in hot path when I compile Paket.Core

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Ah ok, then yes, that should also be fixed.

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

we have this fix included as well.

x.ResolvedTarget === y.ResolvedTarget
elif not x.IsLocalRef && not y.IsLocalRef &&
(// Two tcrefs with identical paths are always equal
nonLocalRefEq x.nlr y.nlr ||
// The tcrefs may have forwarders. If they may possibly be equal then resolve them to get their canonical references
// and compare those using pointer equality.
(not (nonLocalRefDefinitelyNotEq x.nlr y.nlr) && x.Deref === y.Deref)) ->
(not (nonLocalRefDefinitelyNotEq x.nlr y.nlr) && x.Deref === y.Deref)) then
true
| _ ->
compilingFslib && fslibEntityRefEq fslibCcu x y
else
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

style only: elif to avoid nesting

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Done.

compilingFslib && fslibEntityRefEq fslibCcu x y

/// Primitive routine to compare two UnionCaseRef's for equality
let primUnionCaseRefEq compilingFslib fslibCcu (UCRef(tcr1,c1) as uc1) (UCRef(tcr2,c2) as uc2) =
Expand All @@ -4425,12 +4424,10 @@ let primUnionCaseRefEq compilingFslib fslibCcu (UCRef(tcr1,c1) as uc1) (UCRef(tc
/// Note this routine doesn't take type forwarding into account
let primValRefEq compilingFslib fslibCcu (x : ValRef) (y : ValRef) =
x === y ||
match x.IsResolved,y.IsResolved with
| true, true when x.ResolvedTarget === y.ResolvedTarget -> true
| _ ->
match x.IsLocalRef,y.IsLocalRef with
| true,true when valEq x.PrivateTarget y.PrivateTarget -> true
| _ ->
if (x.IsResolved && y.IsResolved && x.ResolvedTarget === y.ResolvedTarget) ||
(x.IsLocalRef && y.IsLocalRef && valEq x.PrivateTarget y.PrivateTarget) then
true
else
(// Use TryDeref to guard against the platforms/times when certain F# language features aren't available,
// e.g. CompactFramework doesn't have support for quotations.
let v1 = x.TryDeref
Expand Down
14 changes: 7 additions & 7 deletions src/utils/prim-lexing.fs
Original file line number Diff line number Diff line change
Expand Up @@ -184,9 +184,9 @@ namespace Internal.Utilities.Text.Lexing
if lexBuffer.IsPastEndOfStream then failwith "End of file on lexing stream";
lexBuffer.IsPastEndOfStream <- true;
//printf "state %d --> %d on eof\n" state snew;
scanUntilSentinel(lexBuffer,snew)
scanUntilSentinel lexBuffer snew
else
scanUntilSentinel(lexBuffer, state)
scanUntilSentinel lexBuffer state

let onAccept (lexBuffer:LexBuffer<char>,a) =
lexBuffer.LexemeLength <- lexBuffer.BufferScanLength;
Expand All @@ -201,7 +201,7 @@ namespace Internal.Utilities.Text.Lexing
let numUnicodeCategories = 30
let numLowUnicodeChars = 128
let numSpecificUnicodeChars = (trans.[0].Length - 1 - numLowUnicodeChars - numUnicodeCategories)/2
let lookupUnicodeCharacters (state,inp) =
let lookupUnicodeCharacters state inp =
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This change is harmless but AFAICS doesn't alter the representation or calls of the function? e.g. for

type C() = 
   let f (x,y) = x + y
   member a.M(b,c) = f (b,c)

we get

.method assembly hidebysig instance int32 
        f(int32 x,
          int32 y) cil managed

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@vasily-kirichenko Could you remove the changes in prim-lexing.fs please? I'm pretty sure they don't remove any allocations. (If they do then let's discuss further, there must be something I'm missing). Thanks!!

let inpAsInt = int inp
// Is it a fast ASCII character?
if inpAsInt < numLowUnicodeChars then
Expand Down Expand Up @@ -235,7 +235,7 @@ namespace Internal.Utilities.Text.Lexing
loop 0
let eofPos = numLowUnicodeChars + 2*numSpecificUnicodeChars + numUnicodeCategories

let rec scanUntilSentinel(lexBuffer,state) =
let rec scanUntilSentinel lexBuffer state =
// Return an endOfScan after consuming the input
let a = int accept.[state]
if a <> sentinel then
Expand All @@ -251,14 +251,14 @@ namespace Internal.Utilities.Text.Lexing
let inp = lexBuffer.Buffer.[lexBuffer.BufferScanPos]

// Find the new state
let snew = lookupUnicodeCharacters (state,inp)
let snew = lookupUnicodeCharacters state inp

if snew = sentinel then
lexBuffer.EndOfScan()
else
lexBuffer.BufferScanLength <- lexBuffer.BufferScanLength + 1;
//printf "state %d --> %d on '%c' (%d)\n" s snew (char inp) inp;
scanUntilSentinel(lexBuffer,snew)
scanUntilSentinel lexBuffer snew

// Each row for the Unicode table has format
// 128 entries for ASCII characters
Expand All @@ -268,6 +268,6 @@ namespace Internal.Utilities.Text.Lexing

member tables.Interpret(initialState,lexBuffer : LexBuffer<char>) =
startInterpret(lexBuffer)
scanUntilSentinel(lexBuffer, initialState)
scanUntilSentinel lexBuffer initialState

static member Create(trans,accept) = new UnicodeTables(trans,accept)