Merge pull request #1250 from dsyme/ilx-cleanup-6

Put union erasure in IlxGen phase

Author: dsyme

src/absil/il.fs

@@ -1124,46 +1124,7 @@ type ILInstr =
   (* FOR EXTENSIONS, e.g. MS-ILX *)  
   | EI_ilzero of ILType
   | EI_ldlen_multi      of int32 * int32
-  | I_other    of IlxExtensionInstr
 
-and IlxExtensionInstr = Ext_instr of obj
-
-
-// -------------------------------------------------------------------- 
-// Helpers for the ILX extensions
-// -------------------------------------------------------------------- 
-
-type internal_instr_extension = 
-    { internalInstrExtDests: IlxExtensionInstr -> ILCodeLabel list;
-      internalInstrExtFallthrough: IlxExtensionInstr -> ILCodeLabel option;
-      internalInstrExtRelabel: (ILCodeLabel -> ILCodeLabel) -> IlxExtensionInstr -> IlxExtensionInstr; }
-
-type ILInstrSetExtension<'T> = 
-    { instrExtDests: 'T -> ILCodeLabel list;
-      instrExtFallthrough: 'T -> ILCodeLabel option;
-      instrExtRelabel: (ILCodeLabel -> ILCodeLabel) -> 'T -> 'T; }
-
-let instrExtensions = ref []
-
-let RegisterInstructionSetExtension  (ext: ILInstrSetExtension<'T>) = 
-    if nonNil !instrExtensions then failwith "RegisterInstructionSetExtension: only one extension currently allowed";
-    let mk (x: 'T) = Ext_instr (box x)
-    let test (Ext_instr _x) = true
-    let dest (Ext_instr x) = (unbox x : 'T)
-    instrExtensions := 
-       { internalInstrExtDests=(fun x -> ext.instrExtDests (dest x));
-         internalInstrExtFallthrough=(fun x -> ext.instrExtFallthrough (dest x));
-         internalInstrExtRelabel=(fun f x -> mk (ext.instrExtRelabel f (dest x))); }
-         :: !instrExtensions;
-    mk,test,dest
-
-let rec find_extension s f l = 
-  let rec look l1 = 
-    match l1 with
-    | [] -> failwith ("extension for "+s+" not found")
-    | (h::t) -> match f h with None -> look t | Some res -> res 
-  look l
-          
 
 type ILDebugMapping = 
     { LocalIndex: int;
@@ -1180,7 +1141,6 @@ type ILBasicBlock =
     member x.Fallthrough = 
         match x.LastInstruction with 
         | I_br l | I_brcmp (_,_,l) | I_switch (_,l) -> Some l
-        | I_other e -> find_extension "instr" (fun ext -> Some (ext.internalInstrExtFallthrough e)) !instrExtensions
         | _ -> None
 
 
@@ -2065,7 +2025,6 @@ let destinationsOfInstr i =
     | I_endfinally | I_endfilter | I_ret | I_throw | I_rethrow 
     | I_call (Tailcall,_,_)| I_callvirt (Tailcall,_,_)| I_callconstraint (Tailcall,_,_,_)
     | I_calli (Tailcall,_,_) -> []
-    | I_other e -> find_extension "instr" (fun ext -> Some (ext.internalInstrExtDests e)) !instrExtensions
     | _ -> []
 
 let destinationsOfBasicBlock (bblock:ILBasicBlock) = destinationsOfInstr bblock.LastInstruction
@@ -2080,7 +2039,6 @@ let instrIsBasicBlockEnd i =
     match i with 
     | I_leave _ | I_br _ | I_brcmp _ | I_switch _ | I_endfinally
     | I_endfilter | I_ret | I_throw | I_rethrow  ->  true
-    | I_other e -> find_extension "instr" (fun ext -> Some (nonNil (ext.internalInstrExtDests e))) !instrExtensions
     | _ -> false
 
 let checks = false 
@@ -3488,8 +3446,6 @@ type ILExceptionSpec =
     { exnRange: (ILCodeLabel * ILCodeLabel);
       exnClauses: ILExceptionClause list }
 
-type exceptions = ILExceptionSpec list
-
 //-----------------------------------------------------------------------
 // [instructions_to_code] makes the basic block structure of code from
 // a primitive array of instructions.  We
@@ -3586,7 +3542,6 @@ type BasicBlockStartsToCodeLabelsMap(instrs,tryspecs,localspecs,lab2pc) =
         match i with 
         | I_leave l -> I_leave(c.lab2cl l)
         | I_br l -> I_br (c.lab2cl l)
-        | I_other e -> I_other (find_extension "instr" (fun ext -> Some (ext.internalInstrExtRelabel c.lab2cl e)) !instrExtensions)
         | I_brcmp (x,l1,l2) -> I_brcmp(x,c.lab2cl l1, c.lab2cl l2)
         | I_switch (ls,l) -> I_switch(List.map c.lab2cl ls, c.lab2cl l)
         | _ -> i 
@@ -4881,7 +4836,7 @@ and refs_of_instr s x =
     | I_ldarga _|I_ldarg _|I_leave _|I_br _
     | I_brcmp _|I_rethrow|I_refanytype|I_ldlen|I_throw|I_initblk _ |I_cpblk _ 
     | I_localloc|I_ret |I_endfilter|I_endfinally|I_arglist
-    | I_other _ | I_break
+    | I_break
     | AI_add    | AI_add_ovf | AI_add_ovf_un | AI_and    | AI_div    | AI_div_un | AI_ceq      | AI_cgt      | AI_cgt_un   | AI_clt     
     | AI_clt_un  | AI_conv      _ | AI_conv_ovf  _ | AI_conv_ovf_un  _ | AI_mul       | AI_mul_ovf    | AI_mul_ovf_un | AI_rem       | AI_rem_un       
     | AI_shl       | AI_shr       | AI_shr_un | AI_sub       | AI_sub_ovf   | AI_sub_ovf_un   | AI_xor       | AI_or        | AI_neg       | AI_not       

src/absil/il.fsi

@@ -98,9 +98,6 @@ type ILSourceMarker =
     member EndLine: int
     member EndColumn: int
 
-/// Represents an extension to the algebra of instructions
-type IlxExtensionInstr 
-
 [<StructuralEquality; StructuralComparison>]
 type PublicKey = 
     | PublicKey of byte[]
@@ -669,15 +666,6 @@ type ILInstr =
     // EXTENSIONS, e.g. MS-ILX 
     | EI_ilzero of ILType
     | EI_ldlen_multi      of int32 * int32
-    | I_other    of IlxExtensionInstr
-
-// REVIEW: remove this open-ended way of extending the IL and just combine with ILX
-type ILInstrSetExtension<'Extension> = 
-    { instrExtDests: ('Extension -> ILCodeLabel list);
-      instrExtFallthrough: ('Extension -> ILCodeLabel option);
-      instrExtRelabel: (ILCodeLabel -> ILCodeLabel) -> 'Extension -> 'Extension; }
-
-val RegisterInstructionSetExtension: ILInstrSetExtension<'Extension> -> ('Extension -> IlxExtensionInstr) * (IlxExtensionInstr -> bool) * (IlxExtensionInstr -> 'Extension)
 
 /// A list of instructions ending in an unconditionally
 /// branching instruction. A basic block has a label which must be unique

src/absil/ilmorph.fs

@@ -65,90 +65,6 @@ let bblock_instr2instrs f bb =
 
     {bb with Instructions = Array.sub codebuf 0 codebuf_size}
 
-// Map each instruction in a basic block to a more complicated block that 
-// may involve internal branching, but which will still have one entry 
-// label and one exit label. This is used, for example, when macro-expanding 
-// complicated high-level ILX instructions. 
-// The morphing function is told the name of the input and output labels 
-// that must be used for the generated block. 
-// Optimize the case where an instruction gets mapped to a 
-// straightline sequence of instructions by allowing the morphing 
-// function to return a special result for this case. 
-// 
-// Let [i] be the instruction being morphed.  If [i] is a control-flow 
-// then instruction then [f] must return either a control-flow terminated 
-// sequence of instructions or a block both of which must targets the same labels 
-// (or a subset of the labels) targeted in [i].  If [i] 
-// is not a if not a control-flow instruction then [f] 
-// must return a block targeting the given output label. 
-
-let rec countAccInstrs (xss:ILInstr list list) acc = 
-    match xss with 
-    | [] -> acc
-    | xs :: rest -> countAccInstrs rest (acc + List.length xs)
-
-let rec commitAccInstrsAux (xs:ILInstr list) (arr:ILInstr[]) i = 
-    match xs with 
-    | [] -> ()
-    | x :: rest -> arr.[i] <- x; commitAccInstrsAux rest arr (i+1)
-    
-// Fill in the array chunk by chunk from the end and work backwards
-let rec commitAccInstrs xss arr i = 
-    match xss with 
-    | [] -> assert (i = 0)
-    | xs :: rest -> 
-        let n = List.length xs
-        commitAccInstrsAux xs arr (i - n)
-        commitAccInstrs rest arr (i - n)
-    
-// Write the accumulated instructions into an array. The fragments come in in reverse order.
-let commitAccBasicBlock (sofar: ILInstr list list) = 
-    let n = countAccInstrs sofar 0
-    let arr = Array.zeroCreate n 
-    commitAccInstrs sofar arr n
-    arr
-
-[<Struct; NoComparison; NoEquality>]
-type InstrMorph(isInstrs:bool, instrs:ILInstr list, code: ILCode) = 
-    new (instrs:ILInstr list) = InstrMorph(true,instrs,Unchecked.defaultof<_>)
-    new (code:ILCode) = InstrMorph(false,Unchecked.defaultof<_>,code)
-    member x.IsInstrs = isInstrs
-    member x.Instrs = instrs
-    member x.Code = code
-    
-let rec bblockLoop f bb currBBlockInpLabel currInpLabel currOutLabel sofar instrs = 
-    match instrs with 
-    | (i::rest) -> 
-        let res : InstrMorph = f currInpLabel currOutLabel i 
-        if res.IsInstrs then
-          // First possibility: return a list of instructions.  No addresses get consumed. 
-            bblockLoop f bb currBBlockInpLabel currInpLabel currOutLabel (res.Instrs :: sofar) rest
-        else
-          let middle_bblock = res.Code
-          let before_bblock = 
-            let instrs = commitAccBasicBlock ([I_br currInpLabel] :: sofar) 
-            mkBasicBlock {Label=currBBlockInpLabel;Instructions=instrs} 
-          if checking && uniqueEntryOfCode middle_bblock <> currInpLabel then 
-            dprintn ("*** warning when transforming bblock "^formatCodeLabel bb.Label^": bblock2code_instr2code: input label of returned block does not match the expected label while converting an instruction to a block.");
-          let afterBlocks = 
-              match rest with 
-              | [] -> [] // the bblock has already been transformed 
-              | _ -> 
-                  let newInLab = generateCodeLabel () 
-                  let newOutLab = generateCodeLabel () 
-                  [ bblockLoop f bb currOutLabel newInLab newOutLab [] rest ]
-           
-          checkILCode 
-              (mkGroupBlock 
-                 ( currInpLabel :: (match rest with [] -> [] | _ -> [ currOutLabel ]),
-                  before_bblock ::  middle_bblock :: afterBlocks))
-    | [] -> 
-       let instrs = commitAccBasicBlock sofar 
-       mkBasicBlock {Label=currBBlockInpLabel;Instructions=instrs} 
-
-let bblock2code_instr2code (f:ILCodeLabel -> ILCodeLabel -> ILInstr -> InstrMorph) bb = 
-    bblockLoop f bb bb.Label (generateCodeLabel ()) (generateCodeLabel ()) [] (Array.toList bb.Instructions)
-
 let rec block_bblock2code_typ2typ ((fbb,fty) as f) x =
     match x with
     | ILBasicBlock bblock -> fbb bblock
@@ -363,12 +279,6 @@ let fdefs_fdef2fdef f (m:ILFieldDefs) = mkILFields (List.map f m.AsList)
 (* use this when the conversion produces just one type... *)
 let morphILTypeDefs f (m: ILTypeDefs) = mkILTypeDefsFromArray (Array.map f m.AsArray)
 
-let morphExpandILTypeDefs f (m:ILTypeDefs) = 
-  mkILTypeDefs (List.collect f m.AsList)
-
-let morphILTypeDefsInILModule typesf m = 
-    {m with TypeDefs=typesf m.TypeDefs}
-
 let locals_typ2typ f ls = ILList.map (local_typ2typ f) ls
 let freevars_typ2typ f ls = Array.map (freevar_typ2typ f) ls
 
@@ -483,7 +393,6 @@ let morphILInstrsAndILTypesInILModule ilg (f1,f2) x =
   module_bblock2code_typ2typ ilg ((fun modCtxt tdefCtxt mdefCtxt  i -> mkBasicBlock (bblock_instr2instr (f1 modCtxt tdefCtxt mdefCtxt) i)), f2) x
 
 let morphILInstrsInILCode f x = topcode_bblock2code (fun i -> mkBasicBlock (bblock_instr2instrs f i)) x
-let morphExpandILInstrsInILCode f x = topcode_bblock2code (bblock2code_instr2code f) x
 
 let morphILTypeInILModule ilg ftype y = 
     let finstr modCtxt tdefCtxt mdefCtxt =

src/absil/ilmorph.fsi

@@ -8,40 +8,18 @@
 /// the ILMethodDef (if any) where the item occurs. etc.
 module internal Microsoft.FSharp.Compiler.AbstractIL.Morphs 
 
-open Internal.Utilities
 open Microsoft.FSharp.Compiler.AbstractIL 
-open Microsoft.FSharp.Compiler.AbstractIL.Internal 
-open Microsoft.FSharp.Compiler.AbstractIL.Extensions.ILX.Types 
 open Microsoft.FSharp.Compiler.AbstractIL.IL 
 
-type 'T morph = 'T -> 'T
-
 /// Morph each scope reference inside a type signature.
-val morphILScopeRefsInILTypeRef: ILScopeRef morph -> ILTypeRef -> ILTypeRef 
-
-val morphILMethodDefs: ILMethodDef morph -> ILMethodDefs -> ILMethodDefs
-/// nb. does not do nested tdefs.
-val morphILTypeDefs: ILTypeDef morph -> ILTypeDefs -> ILTypeDefs 
-
-val morphExpandILTypeDefs: (ILTypeDef -> ILTypeDef list) -> ILTypeDefs -> ILTypeDefs
-
-/// Morph all tables of ILTypeDefs in "ILModuleDef".
-val morphILTypeDefsInILModule: ILTypeDefs morph -> ILModuleDef -> ILModuleDef
+val morphILScopeRefsInILTypeRef: (ILScopeRef -> ILScopeRef) -> ILTypeRef -> ILTypeRef 
 
 /// Morph all type references throughout an entire module.
-val morphILTypeRefsInILModuleMemoized:  ILGlobals -> ILTypeRef morph ->  ILModuleDef ->  ILModuleDef
+val morphILTypeRefsInILModuleMemoized:  ILGlobals -> (ILTypeRef -> ILTypeRef) ->  ILModuleDef ->  ILModuleDef
 
-val morphILScopeRefsInILModuleMemoized: ILGlobals -> ILScopeRef morph ->  ILModuleDef ->  ILModuleDef
+val morphILScopeRefsInILModuleMemoized: ILGlobals -> (ILScopeRef -> ILScopeRef) ->  ILModuleDef ->  ILModuleDef
 
-val morphILMethodBody: ILMethodBody morph -> ILLazyMethodBody -> ILLazyMethodBody
 val morphILInstrsInILCode: (ILInstr -> ILInstr list) -> ILCode -> ILCode
 
-[<Struct; NoComparison; NoEquality>]
-type InstrMorph = 
-    new : ILInstr list -> InstrMorph
-    new : ILCode -> InstrMorph
-
-val morphExpandILInstrsInILCode: (ILCodeLabel -> ILCodeLabel -> ILInstr -> InstrMorph) -> ILCode -> ILCode
-
 val enablemorphCustomAttributeData : unit -> unit
 val disablemorphCustomAttributeData : unit -> unit

src/absil/ilprint.fs

@@ -754,24 +754,7 @@ let rec goutput_instr env os inst =
   | I_cpobj tok -> output_string os "cpobj "; goutput_typ env os tok
   | I_sizeof  tok -> output_string os "sizeof "; goutput_typ env os tok
   | I_seqpoint  s -> output_source os s
-  |  (EI_ilzero ty) -> output_string os "ilzero "; goutput_typ env os ty
-  | I_other e when isIlxExtInstr e -> 
-      match (destIlxExtInstr e) with 
-      | EI_castdata (check,ty,n)     ->
-          if not check then output_string os "/* unchecked. */ ";
-          output_string os "castdata ";
-          goutput_cuspec env os ty;
-          output_string os ",";
-          output_int os n
-      | (EI_lddatatag (_,ty)) -> 
-          output_string os "lddatatag "; 
-          goutput_cuspec env os ty
-      |  (EI_datacase (_,ty,l,_))  -> 
-          output_string os "datacase";
-          output_string os " ";  
-          goutput_cuspec env os ty;
-          output_string os ",";  
-          output_parens (output_seq "," (fun os (x,y) -> output_int os x;  output_string os ",";  output_code_label os y)) os l
+  | EI_ilzero ty -> output_string os "ilzero "; goutput_typ env os ty
   | _ -> 
       output_string os "<printing for this instruction is not implemented>"
 

src/absil/ilreflect.fs

@@ -1200,7 +1200,6 @@ let rec emitInstr cenv (modB : ModuleBuilder) emEnv (ilG:ILGenerator) instr =
     | EI_ldlen_multi (_,m) -> 
         emitInstr cenv modB emEnv ilG (mkLdcInt32 m);
         emitInstr cenv modB emEnv ilG (mkNormalCall(mkILNonGenericMethSpecInTy(cenv.ilg.typ_Array, ILCallingConv.Instance, "GetLength", [cenv.ilg.typ_int32], cenv.ilg.typ_int32)))
-    | I_other e when isIlxExtInstr e -> Printf.failwithf "the ILX instruction %s cannot be emitted" (e.ToString())
     | i -> Printf.failwithf "the IL instruction %s cannot be emitted" (i.ToString())
 
 //----------------------------------------------------------------------------

src/absil/ilx.fs

@@ -115,49 +115,14 @@ type IlxClosureSpec =
         mkILCtorMethSpecForTy (cloTy,fields |> Array.map (fun fv -> fv.fvType) |> Array.toList)
 
 
-type IlxInstr = 
-  // Discriminated unions
-  | EI_castdata of bool * IlxUnionSpec * int
-  | EI_datacase of avoidHelpers:bool * IlxUnionSpec * (int * ILCodeLabel) list * ILCodeLabel
-  | EI_lddatatag of avoidHelpers:bool * IlxUnionSpec
-  
-
-let destinations i =
-  match i with 
-  |  (EI_datacase (_,_,ls,l)) -> 
-        let hashSet = System.Collections.Generic.HashSet<_>(HashIdentity.Structural)
-        [yield l
-         for (_,l) in ls do
-            if hashSet.Add l then
-                yield l]
-  | _ -> []
-
-let fallthrough i = 
-  match i with 
-  |  (EI_datacase (_,_,_,l)) -> Some l
-  | _ -> None
-
-let remapIlxLabels lab2cl i = 
-  match i with 
-    | EI_datacase (z,x,ls,l) -> EI_datacase (z,x,List.map (fun (y,l) -> (y,lab2cl l)) ls, lab2cl l)
-    | _ -> i
-
-let (mkIlxExtInstr,isIlxExtInstr,destIlxExtInstr) = 
-  RegisterInstructionSetExtension  
-    { instrExtDests=destinations
-      instrExtFallthrough=fallthrough
-      instrExtRelabel=remapIlxLabels }
-
-let mkIlxInstr i = I_other (mkIlxExtInstr i)
-
 // Define an extension of the IL algebra of type definitions
 type IlxClosureInfo = 
     { cloStructure: IlxClosureLambdas;
       cloFreeVars: IlxClosureFreeVar[];  
       cloCode: Lazy<ILMethodBody>;
       cloSource: ILSourceMarker option}
 
-and IlxUnionInfo = 
+type IlxUnionInfo = 
     { /// is the representation public? 
       cudReprAccess: ILMemberAccess; 
       /// are the representation public? 

src/absil/ilx.fsi

@@ -89,18 +89,6 @@ type IlxClosureApps =
     | Apps_app of ILType * IlxClosureApps 
     | Apps_done of ILType
 
-/// ILX extensions to the instruction set.
-type IlxInstr = 
-    | EI_castdata of bool * IlxUnionSpec * int
-    | EI_datacase of avoidHelpers:bool * IlxUnionSpec * (int * ILCodeLabel) list * ILCodeLabel
-    | EI_lddatatag of avoidHelpers:bool * IlxUnionSpec
-
-val mkIlxExtInstr: (IlxInstr -> IlxExtensionInstr)
-val isIlxExtInstr: (IlxExtensionInstr -> bool)
-val destIlxExtInstr: (IlxExtensionInstr -> IlxInstr)
-
-val mkIlxInstr: IlxInstr -> ILInstr
-
 // -------------------------------------------------------------------- 
 // ILX extensions to the kinds of type definitions available
 // -------------------------------------------------------------------- 
@@ -111,7 +99,7 @@ type IlxClosureInfo =
       cloCode: Lazy<ILMethodBody>;
       cloSource: ILSourceMarker option}
 
-and IlxUnionInfo = 
+type IlxUnionInfo = 
     { /// Is the representation public? 
       cudReprAccess: ILMemberAccess; 
       /// Are the representation helpers public?