Add InterruptibleLazy (#16179)

* Cancellable: add InterruptibleLazy
dotnet · Nov 2, 2023 · a47975f · a47975f
1 parent 84a2dcb
commit a47975f
Show file tree

Hide file tree

Showing 33 changed files with 513 additions and 170 deletions.
diff --git a/src/Compiler/AbstractIL/il.fs b/src/Compiler/AbstractIL/il.fs
@@ -3,6 +3,7 @@
 module FSharp.Compiler.AbstractIL.IL
 
 open FSharp.Compiler.IO
+open Internal.Utilities.Library
 
 #nowarn "49"
 #nowarn "343" // The type 'ILAssemblyRef' implements 'System.IComparable' explicitly but provides no corresponding override for 'Object.Equals'.
@@ -29,16 +30,14 @@ let _ =
     if logging then
         dprintn "* warning: Il.logging is on"
 
-let notlazy v = Lazy<_>.CreateFromValue v
-
 /// A little ugly, but the idea is that if a data structure does not
 /// contain lazy values then we don't add laziness. So if the thing to map
 /// is already evaluated then immediately apply the function.
-let lazyMap f (x: Lazy<_>) =
+let lazyMap f (x: InterruptibleLazy<_>) =
     if x.IsValueCreated then
         notlazy (f (x.Force()))
     else
-        lazy (f (x.Force()))
+        InterruptibleLazy(fun _ -> f (x.Force()))
 
 [<RequireQualifiedAccess>]
 type PrimaryAssembly =
@@ -165,7 +164,7 @@ let splitTypeNameRight nm =
 // --------------------------------------------------------------------
 
 /// This is used to store event, property and field maps.
-type LazyOrderedMultiMap<'Key, 'Data when 'Key: equality>(keyf: 'Data -> 'Key, lazyItems: Lazy<'Data list>) =
+type LazyOrderedMultiMap<'Key, 'Data when 'Key: equality>(keyf: 'Data -> 'Key, lazyItems: InterruptibleLazy<'Data list>) =
 
     let quickMap =
         lazyItems
@@ -1822,7 +1821,7 @@ type ILMethodVirtualInfo =
 
 [<RequireQualifiedAccess>]
 type MethodBody =
-    | IL of Lazy<ILMethodBody>
+    | IL of InterruptibleLazy<ILMethodBody>
     | PInvoke of Lazy<PInvokeMethod> (* platform invoke to native *)
     | Abstract
     | Native
@@ -1903,7 +1902,7 @@ type ILMethodDef
         callingConv: ILCallingConv,
         parameters: ILParameters,
         ret: ILReturn,
-        body: Lazy<MethodBody>,
+        body: InterruptibleLazy<MethodBody>,
         isEntryPoint: bool,
         genericParams: ILGenericParameterDefs,
         securityDeclsStored: ILSecurityDeclsStored,
@@ -1962,7 +1961,7 @@ type ILMethodDef
             ?callingConv: ILCallingConv,
             ?parameters: ILParameters,
             ?ret: ILReturn,
-            ?body: Lazy<MethodBody>,
+            ?body: InterruptibleLazy<MethodBody>,
             ?securityDecls: ILSecurityDecls,
             ?isEntryPoint: bool,
             ?genericParams: ILGenericParameterDefs,
@@ -2468,7 +2467,7 @@ type ILMethodImplDef =
 
 // Index table by name and arity.
 type ILMethodImplDefs =
-    | ILMethodImpls of Lazy<MethodImplsMap>
+    | ILMethodImpls of InterruptibleLazy<MethodImplsMap>
 
     member x.AsList() =
         let (ILMethodImpls ltab) = x in Map.foldBack (fun _x y r -> y @ r) (ltab.Force()) []
@@ -2919,7 +2918,7 @@ type ILNestedExportedType =
     override x.ToString() = "exported type " + x.Name
 
 and ILNestedExportedTypes =
-    | ILNestedExportedTypes of Lazy<Map<string, ILNestedExportedType>>
+    | ILNestedExportedTypes of InterruptibleLazy<Map<string, ILNestedExportedType>>
 
     member x.AsList() =
         let (ILNestedExportedTypes ltab) = x in Map.foldBack (fun _x y r -> y :: r) (ltab.Force()) []
@@ -2943,7 +2942,7 @@ and [<NoComparison; NoEquality>] ILExportedTypeOrForwarder =
     override x.ToString() = "exported type " + x.Name
 
 and ILExportedTypesAndForwarders =
-    | ILExportedTypesAndForwarders of Lazy<Map<string, ILExportedTypeOrForwarder>>
+    | ILExportedTypesAndForwarders of InterruptibleLazy<Map<string, ILExportedTypeOrForwarder>>
 
     member x.AsList() =
         let (ILExportedTypesAndForwarders ltab) = x in Map.foldBack (fun _x y r -> y :: r) (ltab.Force()) []
@@ -3784,7 +3783,7 @@ let mkILMethodBody (initlocals, locals, maxstack, code, tag, imports) : ILMethod
 
 let mkMethodBody (zeroinit, locals, maxstack, code, tag, imports) =
     let ilCode = mkILMethodBody (zeroinit, locals, maxstack, code, tag, imports)
-    MethodBody.IL(lazy ilCode)
+    MethodBody.IL(InterruptibleLazy.FromValue ilCode)
 
 // --------------------------------------------------------------------
 // Make a constructor
@@ -4098,7 +4097,7 @@ let mkILExportedTypes l =
     ILExportedTypesAndForwarders(notlazy (List.foldBack addExportedTypeToTable l Map.empty))
 
 let mkILExportedTypesLazy (l: Lazy<_>) =
-    ILExportedTypesAndForwarders(lazy (List.foldBack addExportedTypeToTable (l.Force()) Map.empty))
+    ILExportedTypesAndForwarders(InterruptibleLazy(fun _ -> List.foldBack addExportedTypeToTable (l.Force()) Map.empty))
 
 let addNestedExportedTypeToTable (y: ILNestedExportedType) tab = Map.add y.Name y tab
 
@@ -4116,7 +4115,7 @@ let mkILNestedExportedTypes l =
     ILNestedExportedTypes(notlazy (List.foldBack addNestedExportedTypeToTable l Map.empty))
 
 let mkILNestedExportedTypesLazy (l: Lazy<_>) =
-    ILNestedExportedTypes(lazy (List.foldBack addNestedExportedTypeToTable (l.Force()) Map.empty))
+    ILNestedExportedTypes(InterruptibleLazy(fun _ -> List.foldBack addNestedExportedTypeToTable (l.Force()) Map.empty))
 
 let mkILResources l = ILResources l
 let emptyILResources = ILResources []
@@ -4130,7 +4129,7 @@ let mkILMethodImpls l =
     ILMethodImpls(notlazy (List.foldBack addMethodImplToTable l Map.empty))
 
 let mkILMethodImplsLazy l =
-    ILMethodImpls(lazy (List.foldBack addMethodImplToTable (Lazy.force l) Map.empty))
+    ILMethodImpls(InterruptibleLazy(fun _ -> List.foldBack addMethodImplToTable (Lazy.force l) Map.empty))
 
 let emptyILMethodImpls = mkILMethodImpls []
 

diff --git a/src/Compiler/AbstractIL/il.fsi b/src/Compiler/AbstractIL/il.fsi
@@ -984,7 +984,7 @@ type internal ILOverridesSpec =
 
 [<RequireQualifiedAccess>]
 type MethodBody =
-    | IL of Lazy<ILMethodBody>
+    | IL of InterruptibleLazy<ILMethodBody>
     | PInvoke of Lazy<PInvokeMethod>
     | Abstract
     | Native
@@ -1033,7 +1033,7 @@ type ILMethodDef =
         callingConv: ILCallingConv *
         parameters: ILParameters *
         ret: ILReturn *
-        body: Lazy<MethodBody> *
+        body: InterruptibleLazy<MethodBody> *
         isEntryPoint: bool *
         genericParams: ILGenericParameterDefs *
         securityDeclsStored: ILSecurityDeclsStored *
@@ -1049,7 +1049,7 @@ type ILMethodDef =
         callingConv: ILCallingConv *
         parameters: ILParameters *
         ret: ILReturn *
-        body: Lazy<MethodBody> *
+        body: InterruptibleLazy<MethodBody> *
         isEntryPoint: bool *
         genericParams: ILGenericParameterDefs *
         securityDecls: ILSecurityDecls *
@@ -1140,7 +1140,7 @@ type ILMethodDef =
         ?callingConv: ILCallingConv *
         ?parameters: ILParameters *
         ?ret: ILReturn *
-        ?body: Lazy<MethodBody> *
+        ?body: InterruptibleLazy<MethodBody> *
         ?securityDecls: ILSecurityDecls *
         ?isEntryPoint: bool *
         ?genericParams: ILGenericParameterDefs *
@@ -2075,11 +2075,11 @@ val internal mkILMethodBody:
 
 val internal mkMethodBody: bool * ILLocals * int * ILCode * ILDebugPoint option * ILDebugImports option -> MethodBody
 
-val internal methBodyNotAvailable: Lazy<MethodBody>
+val internal methBodyNotAvailable: InterruptibleLazy<MethodBody>
 
-val internal methBodyAbstract: Lazy<MethodBody>
+val internal methBodyAbstract: InterruptibleLazy<MethodBody>
 
-val internal methBodyNative: Lazy<MethodBody>
+val internal methBodyNative: InterruptibleLazy<MethodBody>
 
 val internal mkILCtor: ILMemberAccess * ILParameter list * MethodBody -> ILMethodDef
 
@@ -2217,11 +2217,11 @@ val storeILSecurityDecls: ILSecurityDecls -> ILSecurityDeclsStored
 val internal mkILSecurityDeclsReader: (int32 -> ILSecurityDecl[]) -> ILSecurityDeclsStored
 
 val mkILEvents: ILEventDef list -> ILEventDefs
-val mkILEventsLazy: Lazy<ILEventDef list> -> ILEventDefs
+val mkILEventsLazy: InterruptibleLazy<ILEventDef list> -> ILEventDefs
 val emptyILEvents: ILEventDefs
 
 val mkILProperties: ILPropertyDef list -> ILPropertyDefs
-val mkILPropertiesLazy: Lazy<ILPropertyDef list> -> ILPropertyDefs
+val mkILPropertiesLazy: InterruptibleLazy<ILPropertyDef list> -> ILPropertyDefs
 val emptyILProperties: ILPropertyDefs
 
 val mkILMethods: ILMethodDef list -> ILMethodDefs
@@ -2230,7 +2230,7 @@ val mkILMethodsComputed: (unit -> ILMethodDef[]) -> ILMethodDefs
 val emptyILMethods: ILMethodDefs
 
 val mkILFields: ILFieldDef list -> ILFieldDefs
-val mkILFieldsLazy: Lazy<ILFieldDef list> -> ILFieldDefs
+val mkILFieldsLazy: InterruptibleLazy<ILFieldDef list> -> ILFieldDefs
 val emptyILFields: ILFieldDefs
 
 val mkILMethodImpls: ILMethodImplDef list -> ILMethodImplDefs

diff --git a/src/Compiler/AbstractIL/ilmorph.fs b/src/Compiler/AbstractIL/ilmorph.fs
@@ -305,7 +305,7 @@ let morphILMethodBody fMethBody (x: MethodBody) =
     match x with
     | MethodBody.IL il ->
         let ilCode = fMethBody il.Value // Eager
-        MethodBody.IL(lazy ilCode)
+        MethodBody.IL(InterruptibleLazy.FromValue ilCode)
     | x -> x
 
 let ospec_ty2ty f (OverridesSpec (mref, ty)) = OverridesSpec(mref_ty2ty f mref, f ty)

diff --git a/src/Compiler/AbstractIL/ilread.fs b/src/Compiler/AbstractIL/ilread.fs
@@ -1129,7 +1129,7 @@ type ILMetadataReader =
         mdfile: BinaryFile
         pectxtCaptured: PEReader option // only set when reading full PE including code etc. for static linking
         entryPointToken: TableName * int
-        dataEndPoints: Lazy<int32 list>
+        dataEndPoints: InterruptibleLazy<int32 list>
         fileName: string
         getNumRows: TableName -> int
         userStringsStreamPhysicalLoc: int32
@@ -1794,7 +1794,7 @@ let readNativeResources (pectxt: PEReader) =
     ]
 
 let getDataEndPointsDelayed (pectxt: PEReader) ctxtH =
-    lazy
+    InterruptibleLazy(fun _ ->
         let (ctxt: ILMetadataReader) = getHole ctxtH
         let mdv = ctxt.mdfile.GetView()
 
@@ -1854,14 +1854,14 @@ let getDataEndPointsDelayed (pectxt: PEReader) ctxtH =
                                    [ ("managed vtable_fixups", pectxt.vtableFixupsAddr) ])
                               @ methodRVAs)))
             |> List.distinct
-            |> List.sort
+            |> List.sort)
 
 let rvaToData (ctxt: ILMetadataReader) (pectxt: PEReader) nm rva =
     if rva = 0x0 then
         failwith "rva is zero"
 
     let start = pectxt.anyV2P (nm, rva)
-    let endPoints = (Lazy.force ctxt.dataEndPoints)
+    let endPoints = ctxt.dataEndPoints.Value
 
     let rec look l =
         match l with
@@ -2452,14 +2452,14 @@ and seekReadField ctxt mdv (numTypars, hasLayout) (idx: int) =
 
 and seekReadFields (ctxt: ILMetadataReader) (numTypars, hasLayout) fidx1 fidx2 =
     mkILFieldsLazy (
-        lazy
+        InterruptibleLazy(fun _ ->
             let mdv = ctxt.mdfile.GetView()
 
             [
                 if fidx1 > 0 then
                     for i = fidx1 to fidx2 - 1 do
                         yield seekReadField ctxt mdv (numTypars, hasLayout) i
-            ]
+            ])
     )
 
 and seekReadMethods (ctxt: ILMetadataReader) numTypars midx1 midx2 =
@@ -3092,7 +3092,7 @@ and seekReadEvent ctxt mdv numTypars idx =
 (* REVIEW: can substantially reduce numbers of EventMap and PropertyMap reads by first checking if the whole table mdv sorted according to ILTypeDef tokens and then doing a binary chop *)
 and seekReadEvents (ctxt: ILMetadataReader) numTypars tidx =
     mkILEventsLazy (
-        lazy
+        InterruptibleLazy(fun _ ->
             let mdv = ctxt.mdfile.GetView()
 
             match
@@ -3118,7 +3118,7 @@ and seekReadEvents (ctxt: ILMetadataReader) numTypars tidx =
                     if beginEventIdx > 0 then
                         for i in beginEventIdx .. endEventIdx - 1 do
                             yield seekReadEvent ctxt mdv numTypars i
-                ]
+                ])
     )
 
 and seekReadProperty ctxt mdv numTypars idx =
@@ -3159,7 +3159,7 @@ and seekReadProperty ctxt mdv numTypars idx =
 
 and seekReadProperties (ctxt: ILMetadataReader) numTypars tidx =
     mkILPropertiesLazy (
-        lazy
+        InterruptibleLazy(fun _ ->
             let mdv = ctxt.mdfile.GetView()
 
             match
@@ -3185,7 +3185,7 @@ and seekReadProperties (ctxt: ILMetadataReader) numTypars tidx =
                     if beginPropIdx > 0 then
                         for i in beginPropIdx .. endPropIdx - 1 do
                             yield seekReadProperty ctxt mdv numTypars i
-                ]
+                ])
     )
 
 and customAttrsReader ctxtH tag : ILAttributesStored =
@@ -3279,7 +3279,7 @@ and seekReadConstant (ctxt: ILMetadataReader) idx =
     | _ -> ILFieldInit.Null
 
 and seekReadImplMap (ctxt: ILMetadataReader) nm midx =
-    lazy
+    InterruptibleLazy(fun _ ->
         MethodBody.PInvoke(
             lazy
                 let mdv = ctxt.mdfile.GetView()
@@ -3367,7 +3367,7 @@ and seekReadImplMap (ctxt: ILMetadataReader) nm midx =
                          | Some nm2 -> nm2)
                     Where = seekReadModuleRef ctxt mdv scopeIdx
                 }
-        )
+        ))
 
 and seekReadTopCode (ctxt: ILMetadataReader) pev mdv numTypars (sz: int) start =
     let labelsOfRawOffsets = Dictionary<_, _>(sz / 2)
@@ -3661,7 +3661,7 @@ and seekReadTopCode (ctxt: ILMetadataReader) pev mdv numTypars (sz: int) start =
     instrs, rawToLabel, lab2pc
 
 and seekReadMethodRVA (pectxt: PEReader) (ctxt: ILMetadataReader) (nm, noinline, aggressiveinline, numTypars) rva =
-    lazy
+    InterruptibleLazy(fun _ ->
         let pev = pectxt.pefile.GetView()
         let baseRVA = pectxt.anyV2P ("method rva", rva)
         // ": reading body of method "+nm+" at rva "+string rva+", phys "+string baseRVA
@@ -3678,7 +3678,7 @@ and seekReadMethodRVA (pectxt: PEReader) (ctxt: ILMetadataReader) (nm, noinline,
         else
 
             MethodBody.IL(
-                lazy
+                InterruptibleLazy(fun _ ->
                     let pev = pectxt.pefile.GetView()
                     let mdv = ctxt.mdfile.GetView()
 
@@ -3852,8 +3852,8 @@ and seekReadMethodRVA (pectxt: PEReader) (ctxt: ILMetadataReader) (nm, noinline,
                             Code = code
                             DebugRange = None
                             DebugImports = None
-                        }
-            )
+                        })
+            ))
 
 and int32AsILVariantType (ctxt: ILMetadataReader) (n: int32) =
     if List.memAssoc n (Lazy.force ILVariantTypeRevMap) then

diff --git a/src/Compiler/AbstractIL/ilx.fs b/src/Compiler/AbstractIL/ilx.fs
@@ -167,7 +167,7 @@ type IlxClosureInfo =
     {
         cloStructure: IlxClosureLambdas
         cloFreeVars: IlxClosureFreeVar[]
-        cloCode: Lazy<ILMethodBody>
+        cloCode: InterruptibleLazy<ILMethodBody>
         cloUseStaticField: bool
     }
 

diff --git a/src/Compiler/AbstractIL/ilx.fsi b/src/Compiler/AbstractIL/ilx.fsi
@@ -4,6 +4,7 @@
 module internal FSharp.Compiler.AbstractIL.ILX.Types
 
 open FSharp.Compiler.AbstractIL.IL
+open Internal.Utilities.Library
 
 /// Union case field
 [<Sealed>]
@@ -118,7 +119,7 @@ type IlxClosureApps =
 type IlxClosureInfo =
     { cloStructure: IlxClosureLambdas
       cloFreeVars: IlxClosureFreeVar[]
-      cloCode: Lazy<ILMethodBody>
+      cloCode: InterruptibleLazy<ILMethodBody>
       cloUseStaticField: bool }
 
 /// Represents a discriminated union type prior to erasure