open Internal.Utilities

open Microsoft.FSharp.Compiler

open Microsoft.FSharp.Compiler.AbstractIL

open Microsoft.FSharp.Compiler.AbstractIL.IL

open Microsoft.FSharp.Compiler.AbstractIL.Internal

open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library

open Microsoft.FSharp.Compiler.AbstractIL.Diagnostics

open Microsoft.FSharp.Compiler.Tast

open Microsoft.FSharp.Compiler.Tastops

open Microsoft.FSharp.Compiler.Lib

open Microsoft.FSharp.Compiler.Ast

open Microsoft.FSharp.Compiler.PrettyNaming

open Microsoft.FSharp.Compiler.ErrorLogger

open Microsoft.FSharp.Compiler.TcGlobals

open Microsoft.FSharp.Compiler.TypeRelations

open Microsoft.FSharp.Compiler.Range

open System.Collections.Generic

module QP = Microsoft.FSharp.Compiler.QuotationPickler

let verboseCReflect = condition "VERBOSE_CREFLECT"

type IsReflectedDefinition =

| Yes

| No

type QuotationSerializationFormat =

| FSharp_40_Plus

| FSharp_20_Plus

type QuotationGenerationScope =

{ g: TcGlobals

amap: Import.ImportMap

scope: CcuThunk

// Accumulate the references to type definitions

referencedTypeDefs: ResizeArray<ILTypeRef>

referencedTypeDefsTable: Dictionary<ILTypeRef, int>

// Accumulate the type splices (i.e. captured type parameters) into here

typeSplices: ResizeArray<Tast.Typar * range>

// Accumulate the expression splices into here

exprSplices: ResizeArray<Expr * range>

isReflectedDefinition : IsReflectedDefinition

quotationFormat : QuotationSerializationFormat

mutable emitDebugInfoInQuotations : bool }

static member Create (g: TcGlobals, amap, scope, isReflectedDefinition) =

{ g = g

scope=scope

amap=amap

referencedTypeDefs = new ResizeArray<_>()

referencedTypeDefsTable = new Dictionary<_,_>()

typeSplices = new ResizeArray<_>()

exprSplices = new ResizeArray<_>()

isReflectedDefinition = isReflectedDefinition

quotationFormat = QuotationGenerationScope.ComputeQuotationFormat g

emitDebugInfoInQuotations = g.emitDebugInfoInQuotations }

member cenv.Close() =

cenv.referencedTypeDefs |> ResizeArray.toList,

cenv.typeSplices |> ResizeArray.toList |> List.map (fun (ty,m) -> mkTyparTy ty, m),

cenv.exprSplices |> ResizeArray.toList

static member ComputeQuotationFormat g =

let deserializeExValRef = ValRefForIntrinsic g.deserialize_quoted_FSharp_40_plus_info

if deserializeExValRef.TryDeref.IsSome then

QuotationSerializationFormat.FSharp_40_Plus

else

QuotationSerializationFormat.FSharp_20_Plus

type QuotationTranslationEnv =

{ //Map from Val to binding index

vs: ValMap<int>

nvs: int

//Map from typar stamps to binding index

tyvs: StampMap<int>

// Map for values bound by the

// 'let v = isinst e in .... if nonnull v then ...v .... '

// construct arising out the compilation of pattern matching. We decode these back to the form

// 'if istype v then ...unbox v .... '

isinstVals: ValMap<TType * Expr>

substVals: ValMap<Expr> }

static member Empty =

{ vs=ValMap<_>.Empty

nvs=0

tyvs = Map.empty

isinstVals = ValMap<_>.Empty

substVals = ValMap<_>.Empty }

member env.BindTypar (v:Typar) =

let idx = env.tyvs.Count

{ env with tyvs = env.tyvs.Add(v.Stamp,idx ) }

member env.BindTypars vs =

(env, vs) ||> List.fold (fun env v -> env.BindTypar v) // fold left-to-right because indexes are left-to-right

let BindFormalTypars (env:QuotationTranslationEnv) vs =

{ env with tyvs=Map.empty}.BindTypars vs

let BindVal env v =

let idx = env.nvs

{ env with vs = env.vs.Add v idx; nvs = env.nvs + 1 }

let BindIsInstVal env v (ty,e) =

{ env with isinstVals = env.isinstVals.Add v (ty,e) }

let BindSubstVal env v e =

{ env with substVals = env.substVals.Add v e }

let BindVals env vs = List.fold BindVal env vs // fold left-to-right because indexes are left-to-right

let BindFlatVals env vs = List.fold BindVal env vs // fold left-to-right because indexes are left-to-right

exception InvalidQuotedTerm of exn

exception IgnoringPartOfQuotedTermWarning of string * Range.range

let wfail e = raise (InvalidQuotedTerm(e))

let (|ModuleValueOrMemberUse|_|) g expr =

let rec loop expr args =

match stripExpr expr with

| Expr.App((InnerExprPat(Expr.Val(vref,vFlags,_) as f)),fty,tyargs,actualArgs,_m) when vref.IsMemberOrModuleBinding ->

Some(vref,vFlags,f,fty,tyargs,actualArgs@args)

| Expr.App(f,_fty,[],actualArgs,_) ->

loop f (actualArgs @ args)

| (Expr.Val(vref,vFlags,_m) as f) when (match vref.ActualParent with ParentNone -> false | _ -> true) ->

let fty = tyOfExpr g f

Some(vref,vFlags,f,fty,[],args)

| _ ->

None

loop expr []

let (|SimpleArrayLoopUpperBound|_|) expr =

match expr with

| Expr.Op(TOp.ILAsm([AI_sub], _), _, [Expr.Op(TOp.ILAsm([I_ldlen; AI_conv ILBasicType.DT_I4], _), _, _, _); Expr.Const(Const.Int32 1, _, _) ], _) -> Some ()

| _ -> None

let (|SimpleArrayLoopBody|_|) g expr =

match expr with

| Expr.Lambda(_, a, b, ([_] as args), Expr.Let(TBind(forVarLoop, Expr.Op(TOp.ILAsm([I_ldelem_any(ILArrayShape [(Some 0, None)], _)], _), [elemTy], [arr; idx], m1), seqPoint), body, m2, freeVars), m, ty) ->

let body = Expr.Let(TBind(forVarLoop, mkCallArrayGet g m1 elemTy arr idx, seqPoint), body, m2, freeVars)

let expr = Expr.Lambda(newUnique(), a, b, args, body, m, ty)

Some (arr, elemTy, expr)

| _ -> None

let (|ObjectInitializationCheck|_|) g expr =

// recognize "if this.init@ < 1 then failinit"

match expr with

| Expr.Match

(

_, _,

TDSwitch

(

Expr.Op(TOp.ILAsm([AI_clt], _), _, [Expr.Op(TOp.ValFieldGet((RFRef(_, name))), _, [Expr.Val(selfRef, NormalValUse, _)], _); Expr.Const(Const.Int32 1, _, _)], _), _, _, _

),

[| TTarget([], Expr.App(Expr.Val(failInitRef, _, _), _, _, _, _), _); _ |], _, resultTy

) when

IsCompilerGeneratedName name &&

name.StartsWith "init" &&

selfRef.BaseOrThisInfo = MemberThisVal &&

valRefEq g failInitRef (ValRefForIntrinsic g.fail_init_info) &&

isUnitTy g resultTy -> Some()

| _ -> None

let isSplice g vref = valRefEq g vref g.splice_expr_vref || valRefEq g vref g.splice_raw_expr_vref

let rec EmitDebugInfoIfNecessary cenv env m astExpr : QP.ExprData =

// do not emit debug info if emitDebugInfoInQuotations = false or it was already written for the given expression

if cenv.emitDebugInfoInQuotations && not (QP.isAttributedExpression astExpr) then

cenv.emitDebugInfoInQuotations <- false

try

let mk_tuple g m es = mkRefTupled g m es (List.map (tyOfExpr g) es)

let rangeExpr =

mk_tuple cenv.g m

[ mkString cenv.g m m.FileName

mkInt cenv.g m m.StartLine

mkInt cenv.g m m.StartColumn

mkInt cenv.g m m.EndLine

mkInt cenv.g m m.EndColumn; ]

let attrExpr =

mk_tuple cenv.g m

[ mkString cenv.g m "DebugRange"; rangeExpr ]

let attrExprR = ConvExprCore cenv env attrExpr

QP.mkAttributedExpression(astExpr, attrExprR)

finally

cenv.emitDebugInfoInQuotations <- true

else

astExpr

and ConvExpr cenv env (expr : Expr) =

EmitDebugInfoIfNecessary cenv env expr.Range (ConvExprCore cenv env expr)

and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP.ExprData =

let expr = DetectAndOptimizeForExpression cenv.g OptimizeIntRangesOnly expr

// Eliminate subsumption coercions for functions. This must be done post-typechecking because we need

// complete inference types.

let expr = NormalizeAndAdjustPossibleSubsumptionExprs cenv.g expr

// Remove TExpr_ref nodes

let expr = stripExpr expr

// Recognize F# object model calls

// Recognize applications of module functions.

match expr with

// Detect expression tree exprSplices

| Expr.App(InnerExprPat(Expr.Val(vf,_,_)),_,_,x0::rest,m)

when isSplice cenv.g vf ->

let idx = cenv.exprSplices.Count

let ty = tyOfExpr cenv.g expr

match (freeInExpr CollectTyparsAndLocalsNoCaching x0).FreeLocals |> Seq.tryPick (fun v -> if env.vs.ContainsVal v then Some(v) else None) with

| Some v -> errorR(Error(FSComp.SR.crefBoundVarUsedInSplice(v.DisplayName), v.Range))

| None -> ()

cenv.exprSplices.Add((x0, m))

let hole = QP.mkHole(ConvType cenv env m ty,idx)

(hole, rest) ||> List.fold (fun fR arg -> QP.mkApp (fR,ConvExpr cenv env arg))

| ModuleValueOrMemberUse cenv.g (vref,vFlags,_f,_fty,tyargs,curriedArgs)

when not (isSplice cenv.g vref) ->

let m = expr.Range

let (numEnclTypeArgs,_,isNewObj,valUseFlags,isSelfInit,takesInstanceArg,isPropGet,isPropSet) =

GetMemberCallInfo cenv.g (vref,vFlags)

let isMember,tps,curriedArgInfos,retTy =

match vref.MemberInfo with

| Some _ when not vref.IsExtensionMember ->

// This is an application of a member method

// We only count one argument block for these.

let tps,curriedArgInfos,retTy,_ = GetTypeOfIntrinsicMemberInCompiledForm cenv.g vref

true,tps,curriedArgInfos,retTy

| _ ->

// This is an application of a module value or extension member

let arities = arityOfVal vref.Deref

let tps,curriedArgInfos,retTy,_ = GetTopValTypeInCompiledForm cenv.g arities vref.Type m

false,tps,curriedArgInfos,retTy

// Compute the object arguments as they appear in a compiled call

// Strip off the object argument, if any. The curriedArgInfos are already adjusted to compiled member form

let objArgs,curriedArgs =

match takesInstanceArg,curriedArgs with

| false,curriedArgs -> [],curriedArgs

| true,(objArg::curriedArgs) -> [objArg],curriedArgs

| true,[] -> wfail(InternalError("warning: unexpected missing object argument when generating quotation for call to F# object member "^vref.LogicalName,m))

if verboseCReflect then

dprintfn "vref.DisplayName = %A, #objArgs = %A, #curriedArgs = %A" vref.DisplayName objArgs.Length curriedArgs.Length

// Check to see if there aren't enough arguments or if there is a tuple-arity mismatch

// If so, adjust and try again

if curriedArgs.Length < curriedArgInfos.Length ||

((List.take curriedArgInfos.Length curriedArgs,curriedArgInfos) ||> List.exists2 (fun arg argInfo ->

(argInfo.Length > (tryDestRefTupleExpr arg).Length))) then

if verboseCReflect then

dprintfn "vref.DisplayName = %A was under applied" vref.DisplayName

// Too few arguments or incorrect tupling? Convert to a lambda and beta-reduce the

// partially applied arguments to 'let' bindings

let topValInfo =

match vref.ValReprInfo with

| None -> error(InternalError("no arity information found for F# value "^vref.LogicalName,vref.Range))

| Some a -> a

let expr,exprty = AdjustValForExpectedArity cenv.g m vref vFlags topValInfo

ConvExpr cenv env (MakeApplicationAndBetaReduce cenv.g (expr,exprty,[tyargs],curriedArgs,m))

else

// Too many arguments? Chop

let (curriedArgs:Expr list ),laterArgs = List.chop curriedArgInfos.Length curriedArgs

let callR =

// We now have the right number of arguments, w.r.t. currying and tupling.

// Next work out what kind of object model call and build an object model call node.

// detuple the args

let untupledCurriedArgs =

(curriedArgs,curriedArgInfos) ||> List.map2 (fun arg curriedArgInfo ->

let numUntupledArgs = curriedArgInfo.Length

(if numUntupledArgs = 0 then []

elif numUntupledArgs = 1 then [arg]

else tryDestRefTupleExpr arg))

if verboseCReflect then

dprintfn "vref.DisplayName = %A , after unit adjust, #untupledCurriedArgs = %A, #curriedArgInfos = %d" vref.DisplayName (List.map List.length untupledCurriedArgs) curriedArgInfos.Length

let subCall =

if isMember then

// This is an application of a member method

// We only count one argument block for these.

let callArgs = (objArgs::untupledCurriedArgs) |> List.concat

let parentTyconR = ConvTyconRef cenv vref.TopValActualParent m

let isNewObj = (isNewObj || valUseFlags || isSelfInit)

// The signature types are w.r.t. to the formal context

let envinner = BindFormalTypars env tps

let argTys = curriedArgInfos |> List.concat |> List.map fst

let methArgTypesR = ConvTypes cenv envinner m argTys

let methRetTypeR = ConvReturnType cenv envinner m retTy

let methName = vref.CompiledName

let numGenericArgs = tyargs.Length-numEnclTypeArgs

ConvObjectModelCall cenv env m (isPropGet,isPropSet,isNewObj,parentTyconR,methArgTypesR,methRetTypeR,methName,tyargs,numGenericArgs,callArgs)

else

// This is an application of the module value.

ConvModuleValueApp cenv env m vref tyargs untupledCurriedArgs

match curriedArgs,curriedArgInfos with

// static member and module value unit argument elimination

| [arg:Expr],[[]] ->

// we got here if quotation is represents a call with unit argument

// let f () = ()

// <@ f @> // => (\arg -> f arg) => arg is Expr.Val - no-effects, first case

// <@ f() @> // Expr.Const(Unit) - no-effects - first case

// <@ f (someFunctionThatReturnsUnit) @> - potential effects - second case

match arg with

| Expr.Val _

| Expr.Const(Const.Unit,_,_) -> subCall

| _ ->

let argQ = ConvExpr cenv env arg

QP.mkSequential(argQ, subCall)

| _ -> subCall

List.fold (fun fR arg -> QP.mkApp (fR,ConvExpr cenv env arg)) callR laterArgs

// Blast type application nodes and expression application nodes apart so values are left with just their type arguments

| Expr.App(f,fty,(_ :: _ as tyargs),(_ :: _ as args),m) ->

let rfty = applyForallTy cenv.g fty tyargs

ConvExpr cenv env (primMkApp (primMkApp (f,fty) tyargs [] m, rfty) [] args m)

// Uses of possibly-polymorphic values

| Expr.App(InnerExprPat(Expr.Val(vref,_vFlags,m)),_fty,tyargs,[],_) ->

ConvValRef true cenv env m vref tyargs

// Simple applications

| Expr.App(f,_fty,tyargs,args,m) ->

if not (List.isEmpty tyargs) then wfail(Error(FSComp.SR.crefQuotationsCantContainGenericExprs(), m))

List.fold (fun fR arg -> QP.mkApp (fR,ConvExpr cenv env arg)) (ConvExpr cenv env f) args

// REVIEW: what is the quotation view of literals accessing enumerations? Currently they show up as integers.

| Expr.Const(c,m,ty) ->

ConvConst cenv env m c ty

| Expr.Val(vref,_vFlags,m) ->

ConvValRef true cenv env m vref []

| Expr.Let(bind,body,_,_) ->

// The binding may be a compiler-generated binding that gets removed in the quotation presentation

match ConvLetBind cenv env bind with

| None, env -> ConvExpr cenv env body

| Some(bindR),env -> QP.mkLet(bindR,ConvExpr cenv env body)

| Expr.LetRec(binds,body,_,_) ->

let vs = valsOfBinds binds

let vsR = vs |> List.map (ConvVal cenv env)

let env = BindFlatVals env vs

let bodyR = ConvExpr cenv env body

let bindsR = List.zip vsR (binds |> List.map (fun b -> b.Expr |> ConvExpr cenv env))

QP.mkLetRec(bindsR,bodyR)

| Expr.Lambda(_,_,_,vs,b,_,_) ->

let v,b = MultiLambdaToTupledLambda cenv.g vs b

let vR = ConvVal cenv env v

let bR = ConvExpr cenv (BindVal env v) b

QP.mkLambda(vR, bR)

| Expr.Quote(ast,_,_,_,ety) ->

// F# 2.0-3.1 had a bug with nested 'raw' quotations. F# 4.0 + FSharp.Core 4.4.0.0+ allows us to do the right thing.

if cenv.quotationFormat = QuotationSerializationFormat.FSharp_40_Plus &&

// Look for a 'raw' quotation

tyconRefEq cenv.g (tcrefOfAppTy cenv.g ety) cenv.g.raw_expr_tcr

then

QP.mkQuoteRaw40(ConvExpr cenv env ast)

else

QP.mkQuote(ConvExpr cenv env ast)

| Expr.TyLambda (_,_,_,m,_) ->

wfail(Error(FSComp.SR.crefQuotationsCantContainGenericFunctions(), m))

| Expr.Match (_spBind,m,dtree,tgs,_,retTy) ->

let typR = ConvType cenv env m retTy

ConvDecisionTree cenv env tgs typR dtree

// initialization check

| Expr.Sequential(ObjectInitializationCheck cenv.g, x1, NormalSeq, _, _) -> ConvExpr cenv env x1

| Expr.Sequential (x0,x1,NormalSeq,_,_) -> QP.mkSequential(ConvExpr cenv env x0, ConvExpr cenv env x1)

| Expr.Obj (_,typ,_,_,[TObjExprMethod(TSlotSig(_,ctyp, _,_,_,_),_,tps,[tmvs],e,_) as tmethod],_,m) when isDelegateTy cenv.g typ ->

let f = mkLambdas m tps tmvs (e,GetFSharpViewOfReturnType cenv.g (returnTyOfMethod cenv.g tmethod))

let fR = ConvExpr cenv env f

let tyargR = ConvType cenv env m ctyp

QP.mkDelegate(tyargR, fR)

| Expr.StaticOptimization (_,_,x,_) -> ConvExpr cenv env x

| Expr.TyChoose _ -> ConvExpr cenv env (TypeRelations.ChooseTyparSolutionsForFreeChoiceTypars cenv.g cenv.amap expr)

| Expr.Sequential (x0,x1,ThenDoSeq,_,_) -> QP.mkSequential(ConvExpr cenv env x0, ConvExpr cenv env x1)

| Expr.Obj (_lambdaId,_typ,_basev,_basecall,_overrides,_iimpls,m) -> wfail(Error(FSComp.SR.crefQuotationsCantContainObjExprs(),m))

| Expr.Op(op,tyargs,args,m) ->

match op,tyargs,args with

| TOp.UnionCase ucref,_,_ ->

let mkR = ConvUnionCaseRef cenv ucref m

let tyargsR = ConvTypes cenv env m tyargs

let argsR = ConvExprs cenv env args

QP.mkSum(mkR,tyargsR,argsR)

| TOp.Tuple tupInfo,tyargs,_ ->

let tyR = ConvType cenv env m (mkAnyTupledTy cenv.g tupInfo tyargs)

let argsR = ConvExprs cenv env args

QP.mkTuple(tyR,argsR) // TODO: propagate to quotations

| TOp.Recd (_,tcref),_,_ ->

let rgtypR = ConvTyconRef cenv tcref m

let tyargsR = ConvTypes cenv env m tyargs

let argsR = ConvExprs cenv env args

QP.mkRecdMk(rgtypR,tyargsR,argsR)

| TOp.UnionCaseFieldGet (ucref,n),tyargs,[e] ->

let tyargsR = ConvTypes cenv env m tyargs

let tcR,s = ConvUnionCaseRef cenv ucref m

let projR = (tcR,s,n)

QP.mkSumFieldGet( projR, tyargsR,ConvExpr cenv env e)

| TOp.ValFieldGetAddr(_rfref),_tyargs,_ ->

wfail(Error(FSComp.SR.crefQuotationsCantContainAddressOf(), m))

| TOp.UnionCaseFieldGetAddr _,_tyargs,_ ->

wfail(Error(FSComp.SR.crefQuotationsCantContainAddressOf(), m))

| TOp.ValFieldGet(_rfref),_tyargs,[] ->

wfail(Error(FSComp.SR.crefQuotationsCantContainStaticFieldRef(),m))

| TOp.ValFieldGet(rfref),tyargs,args ->

ConvRFieldGet cenv env m rfref tyargs args

| TOp.TupleFieldGet(tupInfo,n),tyargs,[e] when not (evalTupInfoIsStruct tupInfo) ->

let tyR = ConvType cenv env m (mkRefTupledTy cenv.g tyargs)

QP.mkTupleGet(tyR, n, ConvExpr cenv env e)

| TOp.ILAsm(([ I_ldfld(_,_,fspec) ]

| [ I_ldfld(_,_,fspec); AI_nop ]

| [ I_ldsfld (_,fspec) ]

| [ I_ldsfld (_,fspec); AI_nop ]),_),enclTypeArgs,args ->

ConvLdfld cenv env m fspec enclTypeArgs args

| TOp.ILAsm([ I_stfld(_,_,fspec) | I_stsfld (_,fspec) ],_),enclTypeArgs,args ->

let tyargsR = ConvTypes cenv env m enclTypeArgs

let parentTyconR = ConvILTypeRefUnadjusted cenv m fspec.EnclosingTypeRef

let argsR = ConvLValueArgs cenv env args

QP.mkFieldSet( (parentTyconR, fspec.Name),tyargsR, argsR)

| TOp.ILAsm([ AI_ceq ],_),_,[arg1;arg2] ->

let ty = tyOfExpr cenv.g arg1

let eq = mkCallEqualsOperator cenv.g m ty arg1 arg2

ConvExpr cenv env eq

| TOp.ILAsm([ I_throw ],_),_,[arg1] ->

let raiseExpr = mkCallRaise cenv.g m (tyOfExpr cenv.g expr) arg1

ConvExpr cenv env raiseExpr

| TOp.ILAsm(_il,_),_,_ ->

wfail(Error(FSComp.SR.crefQuotationsCantContainInlineIL(), m))

| TOp.ExnConstr tcref,_,args ->

let _rgtypR = ConvTyconRef cenv tcref m

let _typ = mkAppTy tcref []

let parentTyconR = ConvTyconRef cenv tcref m

let argtys = tcref |> recdFieldsOfExnDefRef |> List.map (fun rfld -> rfld.FormalType)

let methArgTypesR = ConvTypes cenv env m argtys

let argsR = ConvExprs cenv env args

let objR =

QP.mkCtorCall( { ctorParent = parentTyconR

ctorArgTypes = methArgTypesR },

[], argsR)

let exnTypeR = ConvType cenv env m cenv.g.exn_ty

QP.mkCoerce(exnTypeR, objR)

| TOp.ValFieldSet rfref, _tinst,args ->

let argsR = ConvLValueArgs cenv env args

let tyargsR = ConvTypes cenv env m tyargs

let ((_parentTyconR,fldOrPropName) as projR) = ConvRecdFieldRef cenv rfref m

if rfref.TyconRef.IsRecordTycon then

QP.mkRecdSet(projR,tyargsR,argsR)

else

let fspec = rfref.RecdField

let tcref = rfref.TyconRef

let parentTyconR = ConvTyconRef cenv tcref m

if useGenuineField tcref.Deref fspec then

QP.mkFieldSet( projR,tyargsR, argsR)

else

let envinner = BindFormalTypars env (tcref.TyparsNoRange)

let propRetTypeR = ConvType cenv envinner m fspec.FormalType

QP.mkPropSet( (parentTyconR, fldOrPropName,propRetTypeR,[]),tyargsR, argsR)

| TOp.ExnFieldGet(tcref,i),[],[obj] ->

let exnc = stripExnEqns tcref

let fspec = exnc.TrueInstanceFieldsAsList.[i]

let parentTyconR = ConvTyconRef cenv tcref m

let propRetTypeR = ConvType cenv env m fspec.FormalType

let callArgR = ConvExpr cenv env obj

let exnTypeR = ConvType cenv env m (generalizedTyconRef tcref)

QP.mkPropGet( (parentTyconR, fspec.Name,propRetTypeR,[]),[], [QP.mkCoerce (exnTypeR, callArgR)])

| TOp.Coerce,[tgtTy;srcTy],[x] ->

let xR = ConvExpr cenv env x

if typeEquiv cenv.g tgtTy srcTy then

xR

else

QP.mkCoerce(ConvType cenv env m tgtTy,xR)

| TOp.Reraise,[toTy],[] ->

// rebuild reraise<T>() and Convert

mkReraiseLibCall cenv.g toTy m |> ConvExpr cenv env

| TOp.LValueOp(LGetAddr,vref),[],[] ->

QP.mkAddressOf(ConvValRef false cenv env m vref [])

| TOp.LValueOp(LByrefSet,vref),[],[e] ->

QP.mkAddressSet(ConvValRef false cenv env m vref [], ConvExpr cenv env e)

| TOp.LValueOp(LSet,vref),[],[e] ->

// Sets of module values become property sets

match vref.ActualParent with

| Parent tcref when IsCompiledAsStaticProperty cenv.g vref.Deref ->

let parentTyconR = ConvTyconRef cenv tcref m

let propName = vref.CompiledName

let propTy = ConvType cenv env m vref.Type

QP.mkPropSet( (parentTyconR, propName,propTy,[]),[], [ConvExpr cenv env e])

| _ ->

QP.mkVarSet( ConvValRef false cenv env m vref [], ConvExpr cenv env e)

| TOp.LValueOp(LByrefGet,vref),[],[] ->

ConvValRef false cenv env m vref []

| TOp.Array,[ty],xa ->

QP.mkNewArray(ConvType cenv env m ty,ConvExprs cenv env xa)

| TOp.While _,[],[Expr.Lambda(_,_,_,[_],test,_,_);Expr.Lambda(_,_,_,[_],body,_,_)] ->

QP.mkWhileLoop(ConvExpr cenv env test, ConvExpr cenv env body)

| TOp.For(_, FSharpForLoopUp), [], [Expr.Lambda(_,_,_,[_], lim0,_,_); Expr.Lambda(_,_,_,[_], SimpleArrayLoopUpperBound, lm,_); SimpleArrayLoopBody cenv.g (arr, elemTy, body)] ->

let lim1 =

let len = mkCallArrayLength cenv.g lm elemTy arr // Array.length arr

mkCallSubtractionOperator cenv.g lm cenv.g.int32_ty len (Expr.Const(Const.Int32 1, m, cenv.g.int32_ty)) // len - 1

QP.mkForLoop(ConvExpr cenv env lim0, ConvExpr cenv env lim1, ConvExpr cenv env body)

| TOp.For(_,dir),[],[Expr.Lambda(_,_,_,[_],lim0,_,_);Expr.Lambda(_,_,_,[_],lim1,_,_);body] ->

match dir with

| FSharpForLoopUp -> QP.mkForLoop(ConvExpr cenv env lim0,ConvExpr cenv env lim1, ConvExpr cenv env body)

| _ -> wfail(Error(FSComp.SR.crefQuotationsCantContainDescendingForLoops(), m))

| TOp.ILCall(_,_,_,isNewObj,valUseFlags,isProp,_,ilMethRef,enclTypeArgs,methTypeArgs,_tys),[],callArgs ->

let parentTyconR = ConvILTypeRefUnadjusted cenv m ilMethRef.EnclosingTypeRef

let isNewObj = (isNewObj || (match valUseFlags with CtorValUsedAsSuperInit | CtorValUsedAsSelfInit -> true | _ -> false))

let methArgTypesR = List.map (ConvILType cenv env m) ilMethRef.ArgTypes

let methRetTypeR = ConvILType cenv env m ilMethRef.ReturnType

let methName = ilMethRef.Name

let isPropGet = isProp && methName.StartsWith("get_",System.StringComparison.Ordinal)

let isPropSet = isProp && methName.StartsWith("set_",System.StringComparison.Ordinal)

let tyargs = (enclTypeArgs@methTypeArgs)

ConvObjectModelCall cenv env m (isPropGet,isPropSet,isNewObj,parentTyconR,methArgTypesR,methRetTypeR,methName,tyargs,methTypeArgs.Length,callArgs)

| TOp.TryFinally _,[_resty],[Expr.Lambda(_,_,_,[_],e1,_,_); Expr.Lambda(_,_,_,[_],e2,_,_)] ->

QP.mkTryFinally(ConvExpr cenv env e1,ConvExpr cenv env e2)

| TOp.TryCatch _,[_resty],[Expr.Lambda(_,_,_,[_],e1,_,_); Expr.Lambda(_,_,_,[vf],ef,_,_); Expr.Lambda(_,_,_,[vh],eh,_,_)] ->

let vfR = ConvVal cenv env vf

let envf = BindVal env vf

let vhR = ConvVal cenv env vh

let envh = BindVal env vh

QP.mkTryWith(ConvExpr cenv env e1,vfR,ConvExpr cenv envf ef,vhR,ConvExpr cenv envh eh)

| TOp.Bytes bytes,[],[] ->

ConvExpr cenv env (Expr.Op(TOp.Array, [cenv.g.byte_ty], List.ofArray (Array.map (mkByte cenv.g m) bytes), m))

| TOp.UInt16s arr,[],[] ->

ConvExpr cenv env (Expr.Op(TOp.Array, [cenv.g.uint16_ty], List.ofArray (Array.map (mkUInt16 cenv.g m) arr), m))

| TOp.UnionCaseProof _,_,[e] -> ConvExpr cenv env e // Note: we erase the union case proof conversions when converting to quotations

| TOp.UnionCaseTagGet _tycr,_tinst,[_cx] -> wfail(Error(FSComp.SR.crefQuotationsCantFetchUnionIndexes(), m))

| TOp.UnionCaseFieldSet (_c,_i),_tinst,[_cx;_x] -> wfail(Error(FSComp.SR.crefQuotationsCantSetUnionFields(), m))

| TOp.ExnFieldSet(_tcref,_i),[],[_ex;_x] -> wfail(Error(FSComp.SR.crefQuotationsCantSetExceptionFields(), m))

| TOp.RefAddrGet,_,_ -> wfail(Error(FSComp.SR.crefQuotationsCantRequireByref(), m))

| TOp.TraitCall (_ss),_,_ -> wfail(Error(FSComp.SR.crefQuotationsCantCallTraitMembers(), m))

| _ ->

wfail(InternalError( "Unexpected expression shape",m))

| _ ->

wfail(InternalError(sprintf "unhandled construct in AST: %A" expr,expr.Range))

and ConvLdfld cenv env m (fspec: ILFieldSpec) enclTypeArgs args =

let tyargsR = ConvTypes cenv env m enclTypeArgs

let parentTyconR = ConvILTypeRefUnadjusted cenv m fspec.EnclosingTypeRef

let argsR = ConvLValueArgs cenv env args

QP.mkFieldGet( (parentTyconR, fspec.Name),tyargsR, argsR)

and ConvRFieldGet cenv env m rfref tyargs args =

EmitDebugInfoIfNecessary cenv env m (ConvRFieldGetCore cenv env m rfref tyargs args)

and private ConvRFieldGetCore cenv env m rfref tyargs args =

let tyargsR = ConvTypes cenv env m tyargs

let argsR = ConvLValueArgs cenv env args

let ((parentTyconR,fldOrPropName) as projR) = ConvRecdFieldRef cenv rfref m

if rfref.TyconRef.IsRecordTycon then

QP.mkRecdGet(projR,tyargsR,argsR)

else

let fspec = rfref.RecdField

let tcref = rfref.TyconRef

if useGenuineField tcref.Deref fspec then

QP.mkFieldGet(projR,tyargsR, argsR)

else

let envinner = BindFormalTypars env tcref.TyparsNoRange

let propRetTypeR = ConvType cenv envinner m fspec.FormalType

QP.mkPropGet( (parentTyconR, fldOrPropName,propRetTypeR,[]),tyargsR, argsR)

and ConvLetBind cenv env (bind : Binding) =

match bind.Expr with

// Map for values bound by the

// 'let v = isinst e in .... if nonnull v then ...v .... '

// construct arising out the compilation of pattern matching. We decode these back to the form

// 'if istype e then ...unbox e .... '

// It's bit annoying that pattern matching does this transformation. Like all premature optimization we pay a

// cost here to undo it.

| Expr.Op(TOp.ILAsm([ I_isinst _ ],_),[ty],[e],_) ->

None, BindIsInstVal env bind.Var (ty,e)

// Remove let <compilerGeneratedVar> = <var> from quotation tree

| Expr.Val _ when bind.Var.IsCompilerGenerated ->

None, BindSubstVal env bind.Var bind.Expr

// Remove let unionCase = ... from quotation tree

| Expr.Op(TOp.UnionCaseProof _,_,[e],_) ->

None, BindSubstVal env bind.Var e

| _ ->

let v = bind.Var

let vR = ConvVal cenv env v

let rhsR = ConvExpr cenv env bind.Expr

let envinner = BindVal env v

Some(vR,rhsR),envinner

and ConvLValueArgs cenv env args =

match args with

| obj::rest -> ConvLValueExpr cenv env obj :: ConvExprs cenv env rest

| [] -> []

and ConvLValueExpr cenv env expr =

EmitDebugInfoIfNecessary cenv env expr.Range (ConvLValueExprCore cenv env expr)

and ConvLValueExprCore cenv env expr =

match expr with

| Expr.Op(op,tyargs,args,m) ->

match op, args, tyargs with

| TOp.LValueOp(LGetAddr,vref),_,_ -> ConvValRef false cenv env m vref []

| TOp.ValFieldGetAddr(rfref),_,_ -> ConvRFieldGet cenv env m rfref tyargs args

| TOp.ILAsm([ I_ldflda(fspec) ],_rtys),_,_ -> ConvLdfld cenv env m fspec tyargs args

| TOp.ILAsm([ I_ldsflda(fspec) ],_rtys),_,_ -> ConvLdfld cenv env m fspec tyargs args

| TOp.ILAsm(([ I_ldelema(_ro,_isNativePtr,shape,_tyarg) ] ),_), (arr::idxs), [elemty] ->

match shape.Rank, idxs with

| 1, [idx1] -> ConvExpr cenv env (mkCallArrayGet cenv.g m elemty arr idx1)

| 2, [idx1; idx2] -> ConvExpr cenv env (mkCallArray2DGet cenv.g m elemty arr idx1 idx2)

| 3, [idx1; idx2; idx3] -> ConvExpr cenv env (mkCallArray3DGet cenv.g m elemty arr idx1 idx2 idx3)

| 4, [idx1; idx2; idx3; idx4] -> ConvExpr cenv env (mkCallArray4DGet cenv.g m elemty arr idx1 idx2 idx3 idx4)

| _ -> ConvExpr cenv env expr

| _ -> ConvExpr cenv env expr

| _ -> ConvExpr cenv env expr

and ConvObjectModelCall cenv env m callInfo =

EmitDebugInfoIfNecessary cenv env m (ConvObjectModelCallCore cenv env m callInfo)

and ConvObjectModelCallCore cenv env m (isPropGet,isPropSet,isNewObj,parentTyconR,methArgTypesR,methRetTypeR,methName,tyargs,numGenericArgs,callArgs) =

let tyargsR = ConvTypes cenv env m tyargs

let callArgsR = ConvLValueArgs cenv env callArgs

if isPropGet || isPropSet then

let propName = ChopPropertyName methName

if isPropGet then

QP.mkPropGet( (parentTyconR, propName,methRetTypeR,methArgTypesR),tyargsR, callArgsR)

else

let args,propTy = List.frontAndBack methArgTypesR

QP.mkPropSet( (parentTyconR, propName,propTy,args),tyargsR, callArgsR)

elif isNewObj then

let ctorR : QuotationPickler.CtorData =

{ ctorParent = parentTyconR

ctorArgTypes = methArgTypesR }

QP.mkCtorCall(ctorR, tyargsR, callArgsR)

else

let methR : QuotationPickler.MethodData =

{ methParent = parentTyconR

methArgTypes = methArgTypesR

methRetType = methRetTypeR

methName = methName

numGenericArgs=numGenericArgs }

QP.mkMethodCall(methR, tyargsR, callArgsR)

and ConvModuleValueApp cenv env m (vref:ValRef) tyargs (args: Expr list list) =

EmitDebugInfoIfNecessary cenv env m (ConvModuleValueAppCore cenv env m vref tyargs args)

and ConvModuleValueAppCore cenv env m (vref:ValRef) tyargs (args: Expr list list) =

match vref.ActualParent with

| ParentNone -> failwith "ConvModuleValueApp"

| Parent(tcref) ->

let isProperty = IsCompiledAsStaticProperty cenv.g vref.Deref

let tcrefR = ConvTyconRef cenv tcref m

let tyargsR = ConvTypes cenv env m tyargs

let nm = vref.CompiledName

let argsR = List.map (ConvExprs cenv env) args

QP.mkModuleValueApp(tcrefR,nm,isProperty,tyargsR,argsR)

and ConvExprs cenv env args =

List.map (ConvExpr cenv env) args

and ConvValRef holeOk cenv env m (vref:ValRef) tyargs =

EmitDebugInfoIfNecessary cenv env m (ConvValRefCore holeOk cenv env m vref tyargs)

and private ConvValRefCore holeOk cenv env m (vref:ValRef) tyargs =

let v = vref.Deref

if env.isinstVals.ContainsVal v then

let (ty,e) = env.isinstVals.[v]

ConvExpr cenv env (mkCallUnbox cenv.g m ty e)

elif env.substVals.ContainsVal v then

let e = env.substVals.[v]

ConvExpr cenv env e

elif env.vs.ContainsVal v then

if not (List.isEmpty tyargs) then wfail(InternalError("ignoring generic application of local quoted variable",m))

QP.mkVar(env.vs.[v])

elif v.BaseOrThisInfo = CtorThisVal && cenv.isReflectedDefinition = IsReflectedDefinition.Yes then

QP.mkThisVar(ConvType cenv env m v.Type)

else

let vty = v.Type

match v.ActualParent with

| ParentNone ->

// References to local values are embedded by value

if not holeOk then wfail(Error(FSComp.SR.crefNoSetOfHole(),m))

let idx = cenv.exprSplices.Count

cenv.exprSplices.Add((mkCallLiftValueWithName cenv.g m vty v.LogicalName (exprForValRef m vref), m))

QP.mkHole(ConvType cenv env m vty,idx)

| Parent _ ->

ConvModuleValueApp cenv env m vref tyargs []

and ConvUnionCaseRef cenv (ucref:UnionCaseRef) m =

let ucgtypR = ConvTyconRef cenv ucref.TyconRef m

let nm =

if cenv.g.unionCaseRefEq ucref cenv.g.cons_ucref then "Cons"

elif cenv.g.unionCaseRefEq ucref cenv.g.nil_ucref then "Empty"

else ucref.CaseName

(ucgtypR,nm)

and ConvRecdFieldRef cenv (rfref:RecdFieldRef) m =

let typR = ConvTyconRef cenv rfref.TyconRef m

let nm =

if useGenuineField rfref.TyconRef.Deref rfref.RecdField then

ComputeFieldName rfref.TyconRef.Deref rfref.RecdField

else

rfref.FieldName

(typR,nm)

and ConvVal cenv env (v:Val) =

let tyR = ConvType cenv env v.Range v.Type

QP.freshVar (v.CompiledName, tyR, v.IsMutable)

and ConvTyparRef cenv env m (tp:Typar) =

match env.tyvs.TryFind tp.Stamp with

| Some x -> x

| None ->

match ResizeArray.tryFindIndex (fun (tp2,_m) -> typarEq tp tp2) cenv.typeSplices with

| Some idx -> idx

| None ->

let idx = cenv.typeSplices.Count

cenv.typeSplices.Add((tp, m))

idx

and FilterMeasureTyargs tys =

tys |> List.filter (fun ty -> match ty with TType_measure _ -> false | _ -> true)

and ConvType cenv env m typ =

match stripTyEqnsAndMeasureEqns cenv.g typ with

| TType_app(tcref,[tyarg]) when isArrayTyconRef cenv.g tcref ->

QP.mkArrayTy(rankOfArrayTyconRef cenv.g tcref,ConvType cenv env m tyarg)

| TType_ucase(UCRef(tcref,_),tyargs) // Note: we erase union case 'types' when converting to quotations

| TType_app(tcref,tyargs) ->

#if EXTENSIONTYPING

match TryElimErasableTyconRef cenv m tcref with

| Some baseTy -> ConvType cenv env m baseTy

| _ ->

QP.mkILNamedTy(ConvTyconRef cenv tcref m, ConvTypes cenv env m tyargs)

| TType_fun(a,b) -> QP.mkFunTy(ConvType cenv env m a,ConvType cenv env m b)

| TType_tuple(tupInfo,l) -> ConvType cenv env m (mkCompiledTupleTy cenv.g (evalTupInfoIsStruct tupInfo) l)

| TType_var(tp) -> QP.mkVarTy(ConvTyparRef cenv env m tp)

| TType_forall(_spec,_ty) -> wfail(Error(FSComp.SR.crefNoInnerGenericsInQuotations(),m))

| _ -> wfail(Error (FSComp.SR.crefQuotationsCantContainThisType(),m))

and ConvTypes cenv env m typs =

List.map (ConvType cenv env m) (FilterMeasureTyargs typs)

and ConvConst cenv env m c ty =

match TryEliminateDesugaredConstants cenv.g m c with

| Some e -> ConvExpr cenv env e

| None ->

let tyR = ConvType cenv env m ty

match c with

| Const.Bool i -> QP.mkBool (i, tyR)

| Const.SByte i -> QP.mkSByte (i, tyR)

| Const.Byte i -> QP.mkByte (i, tyR)

| Const.Int16 i -> QP.mkInt16 (i, tyR)

| Const.UInt16 i -> QP.mkUInt16 (i, tyR)

| Const.Int32 i -> QP.mkInt32 (i, tyR)

| Const.UInt32 i -> QP.mkUInt32 (i, tyR)

| Const.Int64 i -> QP.mkInt64 (i, tyR)

| Const.UInt64 i -> QP.mkUInt64 (i, tyR)

| Const.Double i -> QP.mkDouble (i, tyR)

| Const.Single i -> QP.mkSingle (i, tyR)

| Const.String s -> QP.mkString (s, tyR)

| Const.Char c -> QP.mkChar (c, tyR)

| Const.Unit -> QP.mkUnit()

| Const.Zero ->

if isRefTy cenv.g ty then

QP.mkNull tyR

else

QP.mkDefaultValue tyR

| _ ->

wfail(Error (FSComp.SR.crefQuotationsCantContainThisConstant(), m))

and ConvDecisionTree cenv env tgs typR x =

match x with

| TDSwitch(e1,csl,dfltOpt,m) ->

let acc =

match dfltOpt with

| Some d -> ConvDecisionTree cenv env tgs typR d

| None -> wfail(Error(FSComp.SR.crefQuotationsCantContainThisPatternMatch(), m))

let converted =

(csl,acc) ||> List.foldBack (fun (TCase(discrim,dtree)) acc ->

match discrim with

| DecisionTreeTest.UnionCase (ucref, tyargs) ->

let e1R = ConvExpr cenv env e1

let ucR = ConvUnionCaseRef cenv ucref m

let tyargsR = ConvTypes cenv env m tyargs

QP.mkCond (QP.mkSumTagTest (ucR, tyargsR, e1R), ConvDecisionTree cenv env tgs typR dtree, acc)

| DecisionTreeTest.Const (Const.Bool true) ->

let e1R = ConvExpr cenv env e1

QP.mkCond (e1R, ConvDecisionTree cenv env tgs typR dtree, acc)

| DecisionTreeTest.Const (Const.Bool false) ->

let e1R = ConvExpr cenv env e1

// Note, reverse the branches

QP.mkCond (e1R, acc, ConvDecisionTree cenv env tgs typR dtree)

| DecisionTreeTest.Const c ->

let ty = tyOfExpr cenv.g e1

let eq = mkCallEqualsOperator cenv.g m ty e1 (Expr.Const (c, m, ty))

let eqR = ConvExpr cenv env eq

QP.mkCond (eqR, ConvDecisionTree cenv env tgs typR dtree, acc)

| DecisionTreeTest.IsNull ->

// Decompile cached isinst tests

match e1 with

| Expr.Val(vref,_,_) when env.isinstVals.ContainsVal vref.Deref ->

let (ty,e) = env.isinstVals.[vref.Deref]

let tyR = ConvType cenv env m ty

let eR = ConvExpr cenv env e

// note: reverse the branches - a null test is a failure of an isinst test

QP.mkCond (QP.mkTypeTest (tyR,eR), acc, ConvDecisionTree cenv env tgs typR dtree)

| _ ->

let ty = tyOfExpr cenv.g e1

let eq = mkCallEqualsOperator cenv.g m ty e1 (Expr.Const (Const.Zero, m, ty))

let eqR = ConvExpr cenv env eq

QP.mkCond (eqR, ConvDecisionTree cenv env tgs typR dtree, acc)

| DecisionTreeTest.IsInst (_srcty, tgty) ->

let e1R = ConvExpr cenv env e1

QP.mkCond (QP.mkTypeTest (ConvType cenv env m tgty, e1R), ConvDecisionTree cenv env tgs typR dtree, acc)

| DecisionTreeTest.ActivePatternCase _ -> wfail(InternalError( "DecisionTreeTest.ActivePatternCase test in quoted expression",m))

| DecisionTreeTest.ArrayLength _ -> wfail(Error(FSComp.SR.crefQuotationsCantContainArrayPatternMatching(), m))

)

EmitDebugInfoIfNecessary cenv env m converted

| TDSuccess (args,n) ->

let (TTarget(vars,rhs,_)) = tgs.[n]

// TAST stores pattern bindings in reverse order for some reason

// Reverse them here to give a good presentation to the user

let args = List.rev args

let vars = List.rev vars

let varsR = vars |> List.map (ConvVal cenv env)

let targetR = ConvExpr cenv (BindVals env vars) rhs

(varsR,args,targetR) |||> List.foldBack2 (fun vR arg acc -> QP.mkLet((vR,ConvExpr cenv env arg), acc) )

| TDBind(bind,rest) ->

// The binding may be a compiler-generated binding that gets removed in the quotation presentation

match ConvLetBind cenv env bind with

| None, env -> ConvDecisionTree cenv env tgs typR rest

| Some(bindR),env -> QP.mkLet(bindR,ConvDecisionTree cenv env tgs typR rest)

and IsILTypeRefStaticLinkLocal cenv m (tr:ILTypeRef) =

ignore cenv; ignore m

match tr.Scope with

#if EXTENSIONTYPING

| ILScopeRef.Assembly aref

when not cenv.g.isInteractive &&

aref.Name <> cenv.g.ilg.primaryAssemblyName && // optimization to avoid this check in the common case

// Explanation: This represents an unchecked invariant in the hosted compiler: that any operations

// which import types (and resolve assemblies from the tcImports tables) happen on the compilation thread.

let ctok = AssumeCompilationThreadWithoutEvidence()

(match cenv.amap.assemblyLoader.FindCcuFromAssemblyRef (ctok, m,aref) with

| ResolvedCcu ccu -> ccu.IsProviderGenerated

| UnresolvedCcu _ -> false)

-> true

| _ -> false

and ConvILTypeRefUnadjusted cenv m (tr:ILTypeRef) =

let trefAdjusted =

if IsILTypeRefStaticLinkLocal cenv m tr then

ILTypeRef.Create(ILScopeRef.Local, tr.Enclosing, tr.Name)

else tr

ConvILTypeRef cenv trefAdjusted

and ConvILTypeRef cenv (tr:ILTypeRef) =

match cenv.quotationFormat with

| QuotationSerializationFormat.FSharp_40_Plus ->

let idx =

match cenv.referencedTypeDefsTable.TryGetValue tr with

| true, idx -> idx

| _ ->

let idx = cenv.referencedTypeDefs.Count

cenv.referencedTypeDefs.Add tr

cenv.referencedTypeDefsTable.[tr] <- idx

idx

QP.Idx idx

| QuotationSerializationFormat.FSharp_20_Plus ->

let assref =

match tr.Scope with

| ILScopeRef.Local -> "."

| _ -> tr.Scope.QualifiedName

QP.Named(tr.BasicQualifiedName, assref)

and ConvVoidType cenv m = QP.mkILNamedTy(ConvTyconRef cenv cenv.g.system_Void_tcref m, [])

and ConvILType cenv env m ty =

match ty with

| ILType.Boxed tspec | ILType.Value tspec -> QP.mkILNamedTy(ConvILTypeRefUnadjusted cenv m tspec.TypeRef, List.map (ConvILType cenv env m) tspec.GenericArgs)

| ILType.Array (shape,ty) -> QP.mkArrayTy(shape.Rank,ConvILType cenv env m ty)

| ILType.TypeVar idx -> QP.mkVarTy(int idx)

| ILType.Void -> ConvVoidType cenv m

| ILType.Ptr _

| ILType.Byref _

| ILType.Modified _

| ILType.FunctionPointer _ -> wfail(Error(FSComp.SR.crefQuotationsCantContainThisType(), m))

#if EXTENSIONTYPING

and TryElimErasableTyconRef cenv m (tcref:TyconRef) =

match tcref.TypeReprInfo with

// Get the base type

| TProvidedTypeExtensionPoint info when info.IsErased -> Some (info.BaseTypeForErased (m, cenv.g.obj_ty))

| _ -> None

and ConvTyconRef cenv (tcref:TyconRef) m =

#if EXTENSIONTYPING

match TryElimErasableTyconRef cenv m tcref with

| Some baseTy -> ConvTyconRef cenv (tcrefOfAppTy cenv.g baseTy) m

| None ->

match tcref.TypeReprInfo with

| TProvidedTypeExtensionPoint info when not cenv.g.isInteractive && not info.IsErased ->

// Note, generated types are (currently) non-generic

let tref = ExtensionTyping.GetILTypeRefOfProvidedType (info.ProvidedType, m)

ConvILTypeRefUnadjusted cenv m tref

| _ ->

let repr = tcref.CompiledRepresentation

match repr with

| CompiledTypeRepr.ILAsmOpen asm ->

match asm with

| ILType.Boxed tspec | ILType.Value tspec ->

ConvILTypeRef cenv tspec.TypeRef

| _ ->

wfail(Error(FSComp.SR.crefQuotationsCantContainThisType(),m))

| CompiledTypeRepr.ILAsmNamed (tref,_boxity,_) ->

ConvILTypeRefUnadjusted cenv m tref

and ConvReturnType cenv envinner m retTy =

match retTy with

| None -> ConvVoidType cenv m

| Some ty -> ConvType cenv envinner m ty

let ConvExprPublic cenv env e =

let astExpr =