csharpfftfsharpintegrationinterpolationlinear-algebramathdifferentiationmatrixnumericsrandomregressionstatisticsmathnet
You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
212 lines
8.4 KiB
212 lines
8.4 KiB
// (c) Microsoft Corporation 2005-2009.
|
|
/// Defines an extension of the IL algebra
|
|
module (* internal *) Microsoft.FSharp.Compiler.AbstractIL.Extensions.ILX.Types
|
|
|
|
open Internal.Utilities
|
|
open Microsoft.FSharp.Compiler.AbstractIL
|
|
open Microsoft.FSharp.Compiler.AbstractIL.Internal
|
|
module Il = Microsoft.FSharp.Compiler.AbstractIL.IL
|
|
module Illib = Microsoft.FSharp.Compiler.AbstractIL.Internal.Library
|
|
|
|
open Illib
|
|
open Il
|
|
|
|
(* --------------------------------------------------------------------
|
|
* Define an extension of the IL instruction algebra
|
|
* -------------------------------------------------------------------- *)
|
|
|
|
type IlxUnionAlternative =
|
|
{ altName: string;
|
|
altFields: ILFieldDef array;
|
|
altCustomAttrs: ILAttributes }
|
|
|
|
and IlxUnionRef = IlxUnionRef of ILTypeRef * IlxUnionAlternative array * bool
|
|
and IlxUnionSpec = IlxUnionSpec of IlxUnionRef * ILGenericArgs
|
|
|
|
and IlxClosureLambdas =
|
|
| Lambdas_forall of ILGenericParameterDef * IlxClosureLambdas
|
|
| Lambdas_lambda of ILParameter * IlxClosureLambdas
|
|
| Lambdas_return of ILType
|
|
and IlxClosureRef = IlxClosureRef of ILTypeRef * IlxClosureLambdas * IlxClosureFreeVar list
|
|
and IlxClosureSpec = IlxClosureSpec of IlxClosureRef * ILGenericArgs
|
|
|
|
and IlxClosureFreeVar =
|
|
{ fvName: string ; fvCompilerGenerated:bool; fvType: ILType }
|
|
let mk_freevar (name,compgen,ty) =
|
|
{ fvName=name;
|
|
fvCompilerGenerated=compgen;
|
|
fvType=ty; }
|
|
let typ_of_freevar p = p.fvType
|
|
let name_of_freevar p = p.fvName
|
|
|
|
type IlxClosureApps =
|
|
| Apps_tyapp of ILType * IlxClosureApps
|
|
| Apps_app of ILType * IlxClosureApps
|
|
| Apps_done of ILType
|
|
|
|
type IlxInstr =
|
|
// Discriminated unions
|
|
| EI_lddata of IlxUnionSpec * int * int
|
|
| EI_isdata of IlxUnionSpec * int
|
|
| EI_brisdata of IlxUnionSpec * int * ILCodeLabel * ILCodeLabel
|
|
| EI_castdata of bool * IlxUnionSpec * int
|
|
| EI_stdata of IlxUnionSpec * int * int
|
|
| EI_datacase of (bool * IlxUnionSpec * (int * ILCodeLabel) list * ILCodeLabel) (* last label is fallthrough, bool is whether to leave value on the stack for each case *)
|
|
| EI_lddatatag of IlxUnionSpec
|
|
| EI_newdata of IlxUnionSpec * int
|
|
|
|
// Closures
|
|
| EI_newclo of IlxClosureSpec
|
|
| EI_castclo of IlxClosureSpec
|
|
| EI_isclo of IlxClosureSpec
|
|
| EI_callclo of Tailcall * IlxClosureSpec * IlxClosureApps
|
|
| EI_stclofld of (IlxClosureSpec * int) (* nb. leave these brackets *)
|
|
| EI_stenv of int
|
|
| EI_ldenv of int
|
|
| EI_ldenva of int
|
|
| EI_callfunc of Tailcall * IlxClosureApps
|
|
| EI_ldftn_then_call of ILMethodSpec * (Tailcall * ILMethodSpec * varargs) (* special: for internal use only *)
|
|
| EI_ld_instance_ftn_then_newobj of ILMethodSpec * ILCallingSignature * (ILMethodSpec * varargs) (* special: for internal use only *)
|
|
|
|
let destinations_of_IlxInstr i =
|
|
match i with
|
|
| (EI_brisdata (_,_,l1,l2)) -> [l1; l2]
|
|
| (EI_callfunc (Tailcall,_)) | (EI_callclo (Tailcall,_,_)) -> []
|
|
| (EI_datacase (_,_,ls,l)) -> l:: (List.foldBack (fun (_,l) acc -> ListSet.insert l acc) ls [])
|
|
| _ -> []
|
|
|
|
let fallthrough_of_IlxInstr i =
|
|
match i with
|
|
| (EI_brisdata (_,_,_,l))
|
|
| (EI_datacase (_,_,_,l)) -> Some l
|
|
| _ -> None
|
|
|
|
let IlxInstr_is_tailcall i =
|
|
match i with
|
|
| (EI_callfunc (Tailcall,_)) | (EI_callclo (Tailcall,_,_)) -> true
|
|
| _ -> false
|
|
|
|
let remap_ilx_labels lab2cl i =
|
|
match i with
|
|
| EI_brisdata (a,b,l1,l2) -> EI_brisdata (a,b,lab2cl l1,lab2cl l2)
|
|
| EI_datacase (b,x,ls,l) -> EI_datacase (b,x,List.map (fun (y,l) -> (y,lab2cl l)) ls, lab2cl l)
|
|
| _ -> i
|
|
|
|
let (mk_ilx_ext_instr,is_ilx_ext_instr,dest_ilx_ext_instr) =
|
|
define_instr_extension
|
|
{ instrExtDests=destinations_of_IlxInstr;
|
|
instrExtFallthrough=fallthrough_of_IlxInstr;
|
|
instrExtIsTailcall=IlxInstr_is_tailcall;
|
|
instrExtRelabel=remap_ilx_labels; }
|
|
|
|
let mk_IlxInstr i = I_other (mk_ilx_ext_instr i)
|
|
|
|
// Define an extension of the IL algebra of type definitions
|
|
type IlxClosureInfo =
|
|
{ cloStructure: IlxClosureLambdas;
|
|
cloFreeVars: IlxClosureFreeVar list;
|
|
cloCode: (ILMethodBody Lazy.t);
|
|
cloSource: ILSourceMarker option}
|
|
|
|
and IlxUnionInfo =
|
|
{ cudReprAccess: ILMemberAccess; (* is the representation public? *)
|
|
cudHelpersAccess: ILMemberAccess; (* are the representation public? *)
|
|
cudHelpers: bool; (* generate the helpers? *)
|
|
cudDebugProxies: bool; (* generate the helpers? *)
|
|
cudDebugDisplayAttributes: ILAttribute list;
|
|
cudAlternatives: IlxUnionAlternative array;
|
|
cudNullPermitted: bool;
|
|
(* debug info for generated code for classunions *)
|
|
cudWhere: ILSourceMarker option; }
|
|
|
|
type IlxTypeDefKind =
|
|
| ETypeDef_closure of IlxClosureInfo
|
|
| ETypeDef_classunion of IlxUnionInfo
|
|
|
|
|
|
let (mk_ilx_ext_type_def_kind,is_ilx_ext_type_def_kind,dest_ilx_ext_type_def_kind) =
|
|
(define_type_def_kind_extension Type_def_kind_extension : (IlxTypeDefKind -> IlxExtensionTypeKind) * (IlxExtensionTypeKind -> bool) * (IlxExtensionTypeKind -> IlxTypeDefKind) )
|
|
|
|
let mk_IlxTypeDefKind i = TypeDef_other (mk_ilx_ext_type_def_kind i)
|
|
|
|
(* --------------------------------------------------------------------
|
|
* Define these as extensions of the IL types
|
|
* -------------------------------------------------------------------- *)
|
|
|
|
let dest_func_app = function Apps_app (d,r) -> d,r | _ -> failwith "dest_func_app"
|
|
let dest_tyfunc_app = function Apps_tyapp (b,c) -> b,c | _ -> failwith "dest_tyfunc_app"
|
|
|
|
let gen_mk_array_ty (shape,ty) = Type_array(shape,ty)
|
|
|
|
let gen_is_array_ty ty =
|
|
match ty with
|
|
Type_array _ -> true
|
|
| _ -> false
|
|
|
|
let gen_dest_array_ty ty =
|
|
match ty with
|
|
| Type_array(shape,ty) -> (shape,ty)
|
|
| _ -> failwith "gen_dest_array_ty"
|
|
|
|
|
|
let mk_array_ty_old (shape,ty) = gen_mk_array_ty (shape,ty)
|
|
|
|
|
|
(* --------------------------------------------------------------------
|
|
* MS-ILX: Closures
|
|
* -------------------------------------------------------------------- *)
|
|
|
|
let rec inst_apps_aux n inst = function
|
|
Apps_tyapp (ty,rty) -> Apps_tyapp(inst_typ_aux n inst ty, inst_apps_aux n inst rty)
|
|
| Apps_app (dty,rty) -> Apps_app(inst_typ_aux n inst dty, inst_apps_aux n inst rty)
|
|
| Apps_done rty -> Apps_done(inst_typ_aux n inst rty)
|
|
|
|
let rec inst_lambdas_aux n inst = function
|
|
| Lambdas_forall (b,rty) ->
|
|
Lambdas_forall(b, inst_lambdas_aux n inst rty)
|
|
| Lambdas_lambda (p,rty) ->
|
|
Lambdas_lambda({ p with paramType=inst_typ_aux n inst p.paramType},inst_lambdas_aux n inst rty)
|
|
| Lambdas_return rty -> Lambdas_return(inst_typ_aux n inst rty)
|
|
|
|
let inst_lambdas i t = inst_lambdas_aux 0 i t
|
|
|
|
let cloref_of_clospec (IlxClosureSpec(cloref,_)) = cloref
|
|
|
|
let tref_of_clospec (IlxClosureSpec(IlxClosureRef(tref,_,_),_)) = tref
|
|
let formal_freevar_type_of_cloref (IlxClosureRef(_,_,fvs)) n =
|
|
typ_of_freevar (List.nth fvs n)
|
|
let formal_freevar_type_of_clospec x n = formal_freevar_type_of_cloref (cloref_of_clospec x) n
|
|
let actual_freevar_type_of_clospec (IlxClosureSpec(cloref,inst)) n =
|
|
inst_typ inst (formal_freevar_type_of_cloref cloref n)
|
|
let actual_freevars_of_clospec (IlxClosureSpec(IlxClosureRef(_,_,fvs),inst)) =
|
|
List.map (fun fv -> {fv with fvType = inst_typ inst fv.fvType}) fvs
|
|
let formal_freevars_of_clospec (IlxClosureSpec(IlxClosureRef(_,_,fvs),inst)) = fvs
|
|
let actual_lambdas_of_clospec (IlxClosureSpec(IlxClosureRef(_,lambdas,_),inst)) = inst_lambdas inst lambdas
|
|
let formal_lambdas_of_clospec (IlxClosureSpec(IlxClosureRef(_,lambdas,_),_)) = lambdas
|
|
let inst_of_clospec (IlxClosureSpec(_,inst)) = inst
|
|
let generalize_cloref gparams csig = IlxClosureSpec(csig, generalize_gparams gparams)
|
|
|
|
|
|
|
|
(* --------------------------------------------------------------------
|
|
* MS-ILX: Unions
|
|
* -------------------------------------------------------------------- *)
|
|
|
|
let objtype_of_cuspec (IlxUnionSpec(IlxUnionRef(tref,_,_),inst)) = mk_boxed_typ tref inst
|
|
let tref_of_cuspec (IlxUnionSpec(IlxUnionRef(tref,_,_),inst)) = tref
|
|
let inst_of_cuspec (IlxUnionSpec(_,inst)) = inst
|
|
let altsarray_of_cuspec (IlxUnionSpec(IlxUnionRef(tref,alts,_),inst)) = alts
|
|
let nullPermitted_of_cuspec (IlxUnionSpec(IlxUnionRef(_,_,np),inst)) = np
|
|
let alts_of_cuspec cuspec = Array.to_list (altsarray_of_cuspec cuspec)
|
|
let alt_of_cuspec cuspec n = (altsarray_of_cuspec cuspec).[n]
|
|
|
|
let alt_is_nullary alt = (alt.altFields.Length = 0)
|
|
let fdefs_of_alt alt = alt.altFields
|
|
let name_of_alt alt = alt.altName
|
|
let fdef_of_alt alt fidx = (fdefs_of_alt alt).[fidx]
|
|
|
|
let fdef_of_cuspec cuspec idx fidx = fdef_of_alt (alt_of_cuspec cuspec idx) fidx
|
|
|
|
let actual_typ_of_cuspec_field cuspec idx fidx =
|
|
inst_typ (inst_of_cuspec cuspec) (fdef_of_cuspec cuspec idx fidx).fdType
|
|
|
|
|