Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
420 changes: 274 additions & 146 deletions src/absil/il.fs

Large diffs are not rendered by default.

459 changes: 190 additions & 269 deletions src/absil/il.fsi

Large diffs are not rendered by default.

8 changes: 4 additions & 4 deletions src/absil/ilmorph.fs
Original file line number Diff line number Diff line change
Expand Up @@ -200,8 +200,8 @@ let morphILTypesInILInstr ((factualty,fformalty)) i =
| ILToken.ILField fr -> I_ldtoken (ILToken.ILField (conv_fspec fr))
| x -> x

let return_typ2typ ilg f (r:ILReturn) = {r with Type=f r.Type; CustomAttrs=cattrs_typ2typ ilg f r.CustomAttrs}
let param_typ2typ ilg f (p: ILParameter) = {p with Type=f p.Type; CustomAttrs=cattrs_typ2typ ilg f p.CustomAttrs}
let return_typ2typ ilg f (r:ILReturn) = {r with Type=f r.Type; CustomAttrsStored= storeILCustomAttrs (cattrs_typ2typ ilg f r.CustomAttrs)}
let param_typ2typ ilg f (p: ILParameter) = {p with Type=f p.Type; CustomAttrsStored= storeILCustomAttrs (cattrs_typ2typ ilg f p.CustomAttrs)}

let morphILMethodDefs f (m:ILMethodDefs) = mkILMethods (List.map f m.AsList)
let fdefs_fdef2fdef f (m:ILFieldDefs) = mkILFields (List.map f m.AsList)
Expand Down Expand Up @@ -287,14 +287,14 @@ and tdefs_typ2typ_ilmbody2ilmbody_mdefs2mdefs ilg enc fs tdefs =
// --------------------------------------------------------------------

let manifest_typ2typ ilg f (m : ILAssemblyManifest) =
{ m with CustomAttrs = cattrs_typ2typ ilg f m.CustomAttrs }
{ m with CustomAttrsStored = storeILCustomAttrs (cattrs_typ2typ ilg f m.CustomAttrs) }

let morphILTypeInILModule_ilmbody2ilmbody_mdefs2mdefs ilg ((ftype: ILModuleDef -> (ILTypeDef list * ILTypeDef) option -> ILMethodDef option -> ILType -> ILType),fmdefs) m =

let ftdefs = tdefs_typ2typ_ilmbody2ilmbody_mdefs2mdefs ilg [] (ftype m,fmdefs m)

{ m with TypeDefs=ftdefs m.TypeDefs;
CustomAttrs=cattrs_typ2typ ilg (ftype m None None) m.CustomAttrs;
CustomAttrsStored= storeILCustomAttrs (cattrs_typ2typ ilg (ftype m None None) m.CustomAttrs);
Manifest=Option.map (manifest_typ2typ ilg (ftype m None None)) m.Manifest }

let module_instr2instr_typ2typ ilg fs x =
Expand Down
9 changes: 4 additions & 5 deletions src/absil/ilprint.fs
Original file line number Diff line number Diff line change
Expand Up @@ -1021,11 +1021,10 @@ let goutput_manifest env os m =
output_sqstring os m.Name;
output_string os " { \n";
output_string os ".hash algorithm "; output_i32 os m.AuxModuleHashAlgorithm; output_string os "\n";
goutput_custom_attrs env os m.CustomAttrs;
goutput_security_decls env os m.SecurityDecls;
(output_option output_publickey) os m.PublicKey;
(output_option output_ver) os m.Version;
(output_option output_locale) os m.Locale;
goutput_custom_attrs env os m.CustomAttrs
(output_option output_publickey) os m.PublicKey
(output_option output_ver) os m.Version
(output_option output_locale) os m.Locale
output_string os " } \n"


Expand Down
143 changes: 88 additions & 55 deletions src/absil/ilread.fs

Large diffs are not rendered by default.

2 changes: 1 addition & 1 deletion src/absil/ilreflect.fs
Original file line number Diff line number Diff line change
Expand Up @@ -1431,7 +1431,7 @@ let buildGenParamsPass1b cenv emEnv (genArgs : Type array) (gps : ILGenericParam
| _ -> failwith "buildGenParam: multiple base types"
);
// set interface constraints (interfaces that instances of gp must meet)
gpB.SetInterfaceConstraints(Array.ofList interfaceTs);
gpB.SetInterfaceConstraints(Array.ofList interfaceTs)
gp.CustomAttrs |> emitCustomAttrs cenv emEnv (wrapCustomAttr gpB.SetCustomAttribute)

let flags = GenericParameterAttributes.None
Expand Down
20 changes: 11 additions & 9 deletions src/fsharp/CompileOps.fs
Original file line number Diff line number Diff line change
Expand Up @@ -3781,13 +3781,15 @@ let MakeILResource rname bytes =
{ Name = rname
Location = ILResourceLocation.LocalOut bytes
Access = ILResourceAccess.Public
CustomAttrs = emptyILCustomAttrs }
CustomAttrsStored = storeILCustomAttrs emptyILCustomAttrs
MetadataIndex = NoMetadataIdx }

let PickleToResource inMem file g scope rname p x =
{ Name = rname
Location = (let bytes = pickleObjWithDanglingCcus inMem file g scope p x in ILResourceLocation.LocalOut bytes)
Access = ILResourceAccess.Public
CustomAttrs = emptyILCustomAttrs }
CustomAttrsStored = storeILCustomAttrs emptyILCustomAttrs
MetadataIndex = NoMetadataIdx }

let GetSignatureData (file, ilScopeRef, ilModule, byteReader) : PickledDataWithReferences<PickledCcuInfo> =
unpickleObjWithDanglingCcus file ilScopeRef ilModule unpickleCcuInfo byteReader
Expand Down Expand Up @@ -5205,11 +5207,11 @@ module private ScriptPreprocessClosure =
let allRootDiagnostics = allRootDiagnostics |> List.filter (fst >> isRootRange)

let result : LoadClosure =
{ SourceFiles = List.groupByFirst sourceFiles
References = List.groupByFirst references
{ SourceFiles = List.groupBy fst sourceFiles |> List.map (map2Of2 (List.map snd))
Copy link
Contributor

Choose a reason for hiding this comment

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

What are these doing? What is map2of2?

Copy link
Contributor

Choose a reason for hiding this comment

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

@TIHan in visualfsharp\src\fsharp\lib.fs
let map2Of2 f (a1,a2) = (a1,f a2)

Copy link
Contributor Author

Choose a reason for hiding this comment

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

Yeah, I removed the groupByFirst helper (which was a reimplementation of groupBy) but then had to add these since the returned results were slightly different - I should have added a new groupByFirst helper implemented in terms of groupBy

References = List.groupBy fst references |> List.map (map2Of2 (List.map snd))
UnresolvedReferences = unresolvedReferences
Inputs = sourceInputs
NoWarns = List.groupByFirst globalNoWarns
NoWarns = List.groupBy fst globalNoWarns |> List.map (map2Of2 (List.map snd))
OriginalLoadReferences = tcConfig.loadedSources
ResolutionDiagnostics = resolutionDiagnostics
AllRootFileDiagnostics = allRootDiagnostics
Expand Down Expand Up @@ -5430,7 +5432,7 @@ let TypeCheckOneInputEventually
let m = qualNameOfFile.Range
TcOpenDecl tcSink tcGlobals amap m m tcEnv prefixPath

let res = (EmptyTopAttrs, [], tcEnv, tcEnv, tcState.tcsTcImplEnv, RootSigsAndImpls(rootSigs, rootImpls, allSigModulTyp, allImplementedSigModulTyp), tcState.tcsCcuType, createsGeneratedProvidedTypes)
let res = (EmptyTopAttrs, None, tcEnv, tcEnv, tcState.tcsTcImplEnv, RootSigsAndImpls(rootSigs, rootImpls, allSigModulTyp, allImplementedSigModulTyp), tcState.tcsCcuType, createsGeneratedProvidedTypes)
return res

| ParsedInput.ImplFile (ParsedImplFileInput(filename, _, qualNameOfFile, _, _, _, _) as file) ->
Expand Down Expand Up @@ -5490,7 +5492,7 @@ let TypeCheckOneInputEventually
if verbose then dprintf "done TypeCheckOneInputEventually...\n"

let topSigsAndImpls = RootSigsAndImpls(rootSigs, rootImpls, allSigModulTyp, allImplementedSigModulTyp)
let res = (topAttrs, [implFile], tcEnvAtEnd, tcSigEnv, tcImplEnv, topSigsAndImpls, ccuType, createsGeneratedProvidedTypes)
let res = (topAttrs, Some implFile, tcEnvAtEnd, tcSigEnv, tcImplEnv, topSigsAndImpls, ccuType, createsGeneratedProvidedTypes)
return res }

return (tcEnvAtEnd, topAttrs, implFiles),
Expand All @@ -5502,7 +5504,7 @@ let TypeCheckOneInputEventually
tcsRootSigsAndImpls = topSigsAndImpls }
with e ->
errorRecovery e range0
return (tcState.TcEnvFromSignatures, EmptyTopAttrs, []), tcState
return (tcState.TcEnvFromSignatures, EmptyTopAttrs, None), tcState
}

/// Typecheck a single file (or interactive entry into F# Interactive)
Expand All @@ -5518,7 +5520,7 @@ let TypeCheckMultipleInputsFinish(results, tcState: TcState) =
let tcEnvsAtEndFile, topAttrs, implFiles = List.unzip3 results

let topAttrs = List.foldBack CombineTopAttrs topAttrs EmptyTopAttrs
let implFiles = List.concat implFiles
let implFiles = List.choose id implFiles
// This is the environment required by fsi.exe when incrementally adding definitions
let tcEnvAtEndOfLastFile = (match tcEnvsAtEndFile with h :: _ -> h | _ -> tcState.TcEnvFromSignatures)

Expand Down
4 changes: 2 additions & 2 deletions src/fsharp/CompileOps.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -724,10 +724,10 @@ val GetInitialTcState:
/// Check one input, returned as an Eventually computation
val TypeCheckOneInputEventually :
checkForErrors:(unit -> bool) * TcConfig * TcImports * TcGlobals * Ast.LongIdent option * NameResolution.TcResultsSink * TcState * Ast.ParsedInput
-> Eventually<(TcEnv * TopAttribs * TypedImplFile list) * TcState>
-> Eventually<(TcEnv * TopAttribs * TypedImplFile option) * TcState>

/// Finish the checking of multiple inputs
val TypeCheckMultipleInputsFinish: (TcEnv * TopAttribs * 'T list) list * TcState -> (TcEnv * TopAttribs * 'T list) * TcState
val TypeCheckMultipleInputsFinish: (TcEnv * TopAttribs * 'T option) list * TcState -> (TcEnv * TopAttribs * 'T list) * TcState

/// Finish the checking of a closed set of inputs
val TypeCheckClosedInputSetFinish: TypedImplFile list * TcState -> TcState * TypedImplFile list
Expand Down
12 changes: 8 additions & 4 deletions src/fsharp/IlxGen.fs
Original file line number Diff line number Diff line change
Expand Up @@ -3454,7 +3454,8 @@ and GenGenericParam cenv eenv (tp:Typar) =

Constraints = subTypeConstraints
Variance=NonVariant
CustomAttrs = mkILCustomAttrs (GenAttrs cenv eenv tp.Attribs)
CustomAttrsStored = storeILCustomAttrs (mkILCustomAttrs (GenAttrs cenv eenv tp.Attribs))
MetadataIndex = NoMetadataIdx
HasReferenceTypeConstraint=refTypeConstraint
HasNotNullableValueTypeConstraint=notNullableValueTypeConstraint
HasDefaultConstructorConstraint= defaultConstructorConstraint }
Expand All @@ -3474,7 +3475,8 @@ and GenSlotParam m cenv eenv (TSlotParam(nm,ty,inFlag,outFlag,optionalFlag,attri
IsIn=inFlag || inFlag2
IsOut=outFlag || outFlag2
IsOptional=optionalFlag || optionalFlag2
CustomAttrs= mkILCustomAttrs (GenAttrs cenv eenv attribs) }
CustomAttrsStored = storeILCustomAttrs (mkILCustomAttrs (GenAttrs cenv eenv attribs))
MetadataIndex = NoMetadataIdx }

and GenFormalSlotsig m cenv eenv (TSlotSig(_,typ,ctps,mtps,paraml,returnTy)) =
let paraml = List.concat paraml
Expand Down Expand Up @@ -5005,7 +5007,8 @@ and GenParams cenv eenv (mspec:ILMethodSpec) (attribs:ArgReprInfo list) (implVal
IsIn=inFlag
IsOut=outFlag
IsOptional=optionalFlag
CustomAttrs= mkILCustomAttrs (GenAttrs cenv eenv attribs) }
CustomAttrsStored = storeILCustomAttrs (mkILCustomAttrs (GenAttrs cenv eenv attribs))
MetadataIndex = NoMetadataIdx }

param, takenNames)
|> fst
Expand All @@ -5014,7 +5017,8 @@ and GenReturnInfo cenv eenv ilRetTy (retInfo : ArgReprInfo) : ILReturn =
let marshal,attrs = GenMarshal cenv retInfo.Attribs
{ Type=ilRetTy
Marshal=marshal
CustomAttrs= mkILCustomAttrs (GenAttrs cenv eenv attrs) }
CustomAttrsStored= storeILCustomAttrs (mkILCustomAttrs (GenAttrs cenv eenv attrs))
MetadataIndex = NoMetadataIdx }

and GenPropertyForMethodDef compileAsInstance tref mdef (v:Val) (memberInfo:ValMemberInfo) ilArgTys ilPropTy ilAttrs compiledName =
let name = match compiledName with | Some n -> n | _ -> v.PropertyName in (* chop "get_" *)
Expand Down
34 changes: 0 additions & 34 deletions src/fsharp/InternalCollections.fs
Original file line number Diff line number Diff line change
Expand Up @@ -198,37 +198,3 @@ type internal MruCache<'Token, 'Key,'Value when 'Value : not struct>(keepStrongl
member bc.Resize(tok, newKeepStrongly, ?newKeepMax) =
cache.Resize(tok, newKeepStrongly, ?newKeepMax=newKeepMax)

/// List helpers
[<Sealed>]
type internal List =
/// Return a new list with one element for each unique 'Key. Multiple 'TValues are flattened.
/// The original order of the first instance of 'Key is preserved.
static member groupByFirst( l : ('Key * 'Value) list) : ('Key * 'Value list) list =
let nextIndex = ref 0
let result = System.Collections.Generic.List<'Key * System.Collections.Generic.List<'Value>>()
let keyToIndex = Dictionary<'Key,int>(HashIdentity.Structural)
let indexOfKey(key) =
match keyToIndex.TryGetValue(key) with
| true, v -> v
| false, _ ->
keyToIndex.Add(key,!nextIndex)
nextIndex := !nextIndex + 1
!nextIndex - 1

for kv in l do
let index = indexOfKey(fst kv)
if index>= result.Count then
let k,vs = fst kv,System.Collections.Generic.List<'Value>()
vs.Add(snd kv)
result.Add(k,vs)
else
let _,vs = result.[index]
vs.Add(snd kv)

result |> Seq.map(fun (k,vs) -> k,vs |> List.ofSeq ) |> List.ofSeq

/// Return each distinct item in the list using reference equality.
static member referenceDistinct( l : 'T list) : 'T list when 'T : not struct =
let set = System.Collections.Generic.Dictionary<'T,bool>(HashIdentity.Reference)
l |> List.iter(fun i->set.Add(i,true))
set |> Seq.map(fun kv->kv.Key) |> List.ofSeq
7 changes: 0 additions & 7 deletions src/fsharp/InternalCollections.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -75,10 +75,3 @@ namespace Internal.Utilities.Collections
/// Resize
member Resize : 'Token * keepStrongly: int * ?keepMax : int -> unit

[<Sealed>]
type internal List =
/// Return a new list with one element for each unique 'Key. Multiple 'TValues are flattened.
/// The original order of the first instance of 'Key is preserved.
static member groupByFirst : l:('Key * 'Value) list -> ('Key * 'Value list) list when 'Key : equality
/// Return each distinct item in the list using reference equality.
static member referenceDistinct : 'T list -> 'T list when 'T : not struct
6 changes: 5 additions & 1 deletion src/fsharp/NameResolution.fs
Original file line number Diff line number Diff line change
Expand Up @@ -1470,6 +1470,10 @@ type TcSymbolUseData =
Range: range }

/// Represents container for all name resolutions that were met so far when typechecking some particular file
///
/// This is a memory-critical data structure - allocations of this data structure and its immediate contents
/// is one of the highest memory long-lived data structures in typical uses of IDEs. Not many of these objects
/// are allocated (one per file), but they are large because the allUsesOfAllSymbols array is large.
type TcSymbolUses(g, capturedNameResolutions : ResizeArray<CapturedNameResolution>, formatSpecifierLocations: (range * int)[]) =

// Make sure we only capture the information we really need to report symbol uses
Expand Down Expand Up @@ -1516,7 +1520,7 @@ type TcResultsSinkImpl(g, ?source: string) =
member this.GetSymbolUses() =
TcSymbolUses(g, capturedNameResolutions, capturedFormatSpecifierLocations.ToArray())

member this.OpenDeclarations = Seq.toList capturedOpenDeclarations
member this.GetOpenDeclarations() = capturedOpenDeclarations.ToArray()

interface ITypecheckResultsSink with
member sink.NotifyEnvWithScope(m,nenv,ad) =
Expand Down
2 changes: 1 addition & 1 deletion src/fsharp/NameResolution.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -375,7 +375,7 @@ type internal TcResultsSinkImpl =
member GetSymbolUses : unit -> TcSymbolUses

/// Get all open declarations reported to the sink
member OpenDeclarations : OpenDeclaration list
member GetOpenDeclarations : unit -> OpenDeclaration[]

interface ITypecheckResultsSink

Expand Down
Loading