Read/store ILCustomAttrs, ILSecurityDecls, ILTypeDef sensibly (#4597)

* Read/store ILCustomAttrs, ILSecurityDecls, ILTypeDef sensibly (#4597)

* hide representation of ILPreTypeDef

* fix build

* remove unnecessary use of lists with repeated tail-appends

* add comment

* fix test

Author: dsyme

src/absil/il.fs

@@ -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)
@@ -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 = 

src/absil/il.fsi

@@ -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"
 
 

src/absil/ilmorph.fs

@@ -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 

src/absil/ilprint.fs

@@ -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
@@ -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))
+              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
@@ -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) ->
@@ -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), 
@@ -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)
@@ -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)
 

src/absil/ilread.fs

@@ -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

src/absil/ilreflect.fs

@@ -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 }
@@ -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
@@ -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
@@ -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_" *)

src/fsharp/CompileOps.fs

@@ -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