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.

Sign up for GitHub

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

Put union erasure in IlxGen phase #1250

Merged
merged 4 commits into from
Jun 8, 2016
Merged

Put union erasure in IlxGen phase #1250

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
10559a9
put union erasure in IlxGen phase
dsyme Jun 7, 2016
5155939
Merge branch 'master' of https://github.com/Microsoft/visualfsharp in…
dsyme Jun 7, 2016
06556b6
updates to tests
dsyme Jun 7, 2016
130fa52
remove dead code
dsyme Jun 7, 2016
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
47 changes: 1 addition & 46 deletions src/absil/il.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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;
Expand All @@ -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


Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
12 changes: 0 additions & 12 deletions src/absil/il.fsi
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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[]
Expand Down Expand Up @@ -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
Expand Down
91 changes: 0 additions & 91 deletions src/absil/ilmorph.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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

Expand Down Expand Up @@ -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 =
Expand Down
28 changes: 3 additions & 25 deletions src/absil/ilmorph.fsi
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
19 changes: 1 addition & 18 deletions src/absil/ilprint.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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>"

Expand Down
1 change: 0 additions & 1 deletion src/absil/ilreflect.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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())

//----------------------------------------------------------------------------
Expand Down
37 changes: 1 addition & 36 deletions src/absil/ilx.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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?
Expand Down
14 changes: 1 addition & 13 deletions src/absil/ilx.fsi
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
// --------------------------------------------------------------------
Expand All @@ -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?
Expand Down
Loading