// Copyright (c) Microsoft Open Technologies, Inc.  All Rights Reserved.  Licensed under the Apache License, Version 2.0.  See License.txt in the project root for license information.

namespace Microsoft.FSharp.Quotations

#if FX_MINIMAL_REFLECTION
#else
open System
open System.IO
open System.Reflection
open System.Collections.Generic
open Microsoft.FSharp
open Microsoft.FSharp.Core
open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators
open Microsoft.FSharp.Core.Operators
open Microsoft.FSharp.Primitives.Basics
open Microsoft.FSharp.Collections
open Microsoft.FSharp.Reflection
open Microsoft.FSharp.Core.Printf
open Microsoft.FSharp.Text.StructuredPrintfImpl
open Microsoft.FSharp.Text.StructuredPrintfImpl.LayoutOps

#nowarn "52" //  The value has been copied to ensure the original is not mutated by this operation

#if FX_RESHAPED_REFLECTION
open PrimReflectionAdapters
open ReflectionAdapters
type BindingFlags = ReflectionAdapters.BindingFlags
#endif

//--------------------------------------------------------------------------
// RAW quotations - basic data types
//--------------------------------------------------------------------------

module Helpers = 
    let qOneOrMoreRLinear q inp =
        let rec queryAcc rvs e = 
            match q e with 
            | Some(v,body) -> queryAcc (v::rvs) body 
            | None -> 
                match rvs with 
                | [] -> None
                | _ -> Some(List.rev rvs,e) 
        queryAcc [] inp 

    let qOneOrMoreLLinear q inp =
        let rec queryAcc e rvs = 
            match q e with 
            | Some(body,v) -> queryAcc body (v::rvs) 
            | None -> 
                match rvs with 
                | [] -> None
                | _ -> Some(e,rvs) 
        queryAcc inp []

    let mkRLinear mk (vs,body) = List.foldBack (fun v acc -> mk(v,acc)) vs body 
    let mkLLinear mk (body,vs) = List.fold (fun acc v -> mk(acc,v)) body vs 

    let staticBindingFlags = BindingFlags.Static ||| BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.DeclaredOnly
    let staticOrInstanceBindingFlags = BindingFlags.Instance ||| BindingFlags.Static ||| BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.DeclaredOnly
    let instanceBindingFlags = BindingFlags.Instance ||| BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.DeclaredOnly
#if FX_RESHAPED_REFLECTION
    let publicOrPrivateBindingFlags = true
#else
    let publicOrPrivateBindingFlags = BindingFlags.Public ||| BindingFlags.NonPublic
#endif

    let isDelegateType (typ:Type) = 
        if typ.IsSubclassOf(typeof<Delegate>) then
            match typ.GetMethod("Invoke", instanceBindingFlags) with
            | null -> false
            | _ -> true
        else
            false

    let getDelegateInvoke ty = 
        if not (isDelegateType(ty)) then invalidArg  "ty" (SR.GetString(SR.delegateExpected))
        ty.GetMethod("Invoke", instanceBindingFlags)


    let inline checkNonNull argName (v: 'T) = 
        match box v with 
        | null -> nullArg argName 
        | _ -> ()
        
    let getTypesFromParamInfos (infos : ParameterInfo[]) = infos |> Array.map (fun pi -> pi.ParameterType)

open Helpers


[<Sealed>]
[<CompiledName("FSharpVar")>]
[<System.Diagnostics.CodeAnalysis.SuppressMessage("Microsoft.Usage","CA2218:OverrideGetHashCodeOnOverridingEquals",Justification="Equals override does not equate further objects, so default GetHashCode is still valid")>]
type Var(name: string, typ:Type, ?isMutable: bool) =

    inherit obj()
    static let mutable lastStamp = 0L
    static let globals = new Dictionary<(string*Type),Var>(11)

    let stamp = lastStamp    
    let isMutable = defaultArg isMutable false
    do lock globals (fun () -> lastStamp <- lastStamp + 1L)
    
    member v.Name = name
    member v.IsMutable = isMutable
    member v.Type = typ
    member v.Stamp = stamp
    
    static member Global(name,typ: Type) = 
        checkNonNull "name" name
        checkNonNull "typ" typ
        lock globals (fun () -> 
            let mutable res = Unchecked.defaultof<Var>
            let ok = globals.TryGetValue((name,typ),&res)
            if ok then res else
            let res = new Var(name,typ)
            globals.[(name,typ)] <- res
            res)

    override v.ToString() = name

    override v.GetHashCode() = base.GetHashCode()

    override v.Equals(obj:obj) = 
        match obj with 
        | :? Var as v2 -> System.Object.ReferenceEquals(v,v2)
        | _ -> false

    interface System.IComparable with 
        member v.CompareTo(obj:obj) = 
            match obj with 
            | :? Var as v2 -> 
                if System.Object.ReferenceEquals(v,v2) then 0 else
                let c = compare v.Name v2.Name 
                if c <> 0 then c else 
#if FX_NO_REFLECTION_METADATA_TOKENS // not available on Compact Framework
#else
                let c = compare v.Type.MetadataToken v2.Type.MetadataToken 
                if c <> 0 then c else 
                let c = compare v.Type.Module.MetadataToken v2.Type.Module.MetadataToken 
                if c <> 0 then c else 
#endif
                let c = compare v.Type.Assembly.FullName v2.Type.Assembly.FullName 
                if c <> 0 then c else 
                compare v.Stamp v2.Stamp
            | _ -> 0

/// Represents specifications of a subset of F# expressions 
[<StructuralEquality; NoComparison>]
type Tree =
    | CombTerm   of ExprConstInfo * Expr list
    | VarTerm    of Var
    | LambdaTerm of Var * Expr 
    | HoleTerm   of Type * int

and 
  [<StructuralEquality; NoComparison>]
  ExprConstInfo = 
    | AppOp
    | IfThenElseOp  
    | LetRecOp  
    | LetRecCombOp  
    | LetOp  
    | NewRecordOp      of Type
    | NewUnionCaseOp       of UnionCaseInfo
    | UnionCaseTestOp  of UnionCaseInfo
    | NewTupleOp     of Type
    | TupleGetOp    of Type * int
    | InstancePropGetOp    of PropertyInfo
    | StaticPropGetOp    of PropertyInfo
    | InstancePropSetOp    of PropertyInfo
    | StaticPropSetOp    of PropertyInfo
    | InstanceFieldGetOp   of FieldInfo
    | StaticFieldGetOp   of FieldInfo
    | InstanceFieldSetOp   of FieldInfo
    | StaticFieldSetOp   of FieldInfo
    | NewObjectOp   of ConstructorInfo 
    | InstanceMethodCallOp of MethodInfo 
    | StaticMethodCallOp of MethodInfo 
    | CoerceOp     of Type
    | NewArrayOp    of Type
    | NewDelegateOp   of Type
    | QuoteOp of bool
    | SequentialOp 
    | AddressOfOp 
    | VarSetOp
    | AddressSetOp 
    | TypeTestOp  of Type
    | TryWithOp 
    | TryFinallyOp 
    | ForIntegerRangeLoopOp 
    | WhileLoopOp 
    // Arbitrary spliced values - not serialized
    | ValueOp of obj * Type * string option
    | WithValueOp of obj * Type 
    | DefaultValueOp of Type
    
and [<CompiledName("FSharpExpr")>]
    Expr(term:Tree,attribs:Expr list) =
    member x.Tree = term
    member x.CustomAttributes = attribs 

    override x.Equals(yobj) = 
        match yobj with 
        | :? Expr as y -> 
            let rec eq t1 t2 = 
                match t1, t2 with 
                // We special-case ValueOp to ensure that ValueWithName = Value
                | CombTerm(ValueOp(v1,ty1,_),[]),CombTerm(ValueOp(v2,ty2,_),[]) -> (v1 = v2) && (ty1 = ty2)
                | CombTerm(c1, es1), CombTerm(c2,es2) -> c1 = c2 && es1.Length = es2.Length && (es1 = es2)
                | VarTerm v1, VarTerm v2 -> (v1 = v2)
                | LambdaTerm (v1,e1), LambdaTerm(v2,e2) -> (v1 = v2) && (e1 = e2)
                | HoleTerm (ty1,n1), HoleTerm(ty2,n2) -> (ty1 = ty2) && (n1 = n2)
                | _ -> false
            eq x.Tree y.Tree
        | _ -> false

    override x.GetHashCode() = 
        x.Tree.GetHashCode() 

    override x.ToString() = x.ToString(false)

    member x.ToString(long) = 
        Microsoft.FSharp.Text.StructuredPrintfImpl.Display.layout_to_string Microsoft.FSharp.Text.StructuredPrintfImpl.FormatOptions.Default (x.GetLayout(long))
        
    member x.GetLayout(long) = 
        let expr (e:Expr ) = e.GetLayout(long)
        let exprs (es:Expr list) = es |> List.map expr
        let parens ls = bracketL (commaListL ls)
        let pairL l1 l2 = bracketL (l1 ^^ sepL "," ^^ l2)
        let listL ls = squareBracketL (commaListL ls)
        let combL nm ls = wordL nm ^^ parens ls
        let noneL = wordL "None"
        let someL e = combL "Some" [expr e]
        let typeL (o: Type)  = wordL (if long then o.FullName else o.Name)
        let objL (o: 'T)  = wordL (sprintf "%A" o)
        let varL (v:Var) = wordL v.Name
        let (|E|) (e: Expr) = e.Tree
        let (|Lambda|_|)        (E x) = match x with LambdaTerm(a,b)  -> Some (a,b) | _ -> None 
        let (|IteratedLambda|_|) (e: Expr) = qOneOrMoreRLinear (|Lambda|_|) e
        let ucaseL (unionCase:UnionCaseInfo) = (if long then objL unionCase else wordL unionCase.Name) 
        let minfoL (minfo: MethodInfo) = if long then objL minfo else wordL minfo.Name 
        let cinfoL (cinfo: ConstructorInfo) = if long then objL cinfo else wordL cinfo.DeclaringType.Name
        let pinfoL (pinfo: PropertyInfo) = if long then objL pinfo else wordL pinfo.Name
        let finfoL (finfo: FieldInfo) = if long then objL finfo else wordL finfo.Name
        let rec (|NLambdas|_|) n (e:Expr) = 
            match e with 
            | _ when n <= 0 -> Some([],e) 
            | Lambda(v,NLambdas ((-) n 1) (vs,b)) -> Some(v::vs,b)
            | _ -> None

        match x.Tree with 
        | CombTerm(AppOp,args)                     -> combL "Application" (exprs args)
        | CombTerm(IfThenElseOp,args)              -> combL "IfThenElse" (exprs args)
        | CombTerm(LetRecOp,[IteratedLambda(vs,E(CombTerm(LetRecCombOp,b2::bs)))]) -> combL "LetRecursive" [listL (List.map2 pairL (List.map varL vs) (exprs bs) ); b2.GetLayout(long)]
        | CombTerm(LetOp,[e;E(LambdaTerm(v,b))]) -> combL "Let" [varL v; e.GetLayout(long); b.GetLayout(long)]
        | CombTerm(NewRecordOp(ty),args)           -> combL "NewRecord" (typeL ty :: exprs args)
        | CombTerm(NewUnionCaseOp(unionCase),args)    -> combL "NewUnionCase" (ucaseL unionCase :: exprs args)
        | CombTerm(UnionCaseTestOp(unionCase),args)   -> combL "UnionCaseTest" (exprs args@ [ucaseL unionCase])
        | CombTerm(NewTupleOp _,args)            -> combL "NewTuple" (exprs args)
        | CombTerm(TupleGetOp (_,i),[arg])         -> combL "TupleGet" ([expr arg] @ [objL i])
        | CombTerm(ValueOp(v,_,Some nm),[])               -> combL "ValueWithName" [objL v; wordL nm]
        | CombTerm(ValueOp(v,_,None),[])               -> combL "Value" [objL v]
        | CombTerm(WithValueOp(v,_),[defn])               -> combL "WithValue" [objL v; expr defn]
        | CombTerm(InstanceMethodCallOp(minfo),obj::args) -> combL "Call"     [someL obj; minfoL minfo; listL (exprs args)]
        | CombTerm(StaticMethodCallOp(minfo),args)        -> combL "Call"     [noneL;     minfoL minfo; listL (exprs args)]
        | CombTerm(InstancePropGetOp(pinfo),(obj::args))  -> combL "PropertyGet"  [someL obj; pinfoL pinfo; listL (exprs args)]
        | CombTerm(StaticPropGetOp(pinfo),args)           -> combL "PropertyGet"  [noneL;     pinfoL pinfo; listL (exprs args)]
        | CombTerm(InstancePropSetOp(pinfo),(obj::args))  -> combL "PropertySet"  [someL obj; pinfoL pinfo; listL (exprs args)]
        | CombTerm(StaticPropSetOp(pinfo),args)           -> combL "PropertySet"  [noneL;     pinfoL pinfo; listL (exprs args)]
        | CombTerm(InstanceFieldGetOp(finfo),[obj])       -> combL "FieldGet" [someL obj; finfoL finfo]
        | CombTerm(StaticFieldGetOp(finfo),[])            -> combL "FieldGet" [noneL;     finfoL finfo]
        | CombTerm(InstanceFieldSetOp(finfo),[obj;v])       -> combL "FieldSet" [someL obj; finfoL finfo; expr v;]
        | CombTerm(StaticFieldSetOp(finfo),[v])            -> combL "FieldSet" [noneL;     finfoL finfo; expr v;]
        | CombTerm(CoerceOp(ty),[arg])                    -> combL "Coerce"  [ expr arg; typeL ty]
        | CombTerm(NewObjectOp cinfo,args)   -> combL "NewObject" ([ cinfoL cinfo ] @ exprs args)
        | CombTerm(DefaultValueOp(ty),args)  -> combL "DefaultValue" ([ typeL ty ] @ exprs args)
        | CombTerm(NewArrayOp(ty),args)      -> combL "NewArray" ([ typeL ty ] @ exprs args)
        | CombTerm(TypeTestOp(ty),args)      -> combL "TypeTest" ([ typeL ty] @ exprs args)
        | CombTerm(AddressOfOp,args)         -> combL "AddressOf" (exprs args)
        | CombTerm(VarSetOp,[E(VarTerm(v)); e])  -> combL "VarSet" [varL v; expr e]
        | CombTerm(AddressSetOp,args)        -> combL "AddressSet" (exprs args)
        | CombTerm(ForIntegerRangeLoopOp,[e1;e2;E(LambdaTerm(v,e3))])     -> combL "ForIntegerRangeLoop" [varL v; expr e1; expr e2; expr e3]
        | CombTerm(WhileLoopOp,args)         -> combL "WhileLoop" (exprs args)
        | CombTerm(TryFinallyOp,args)         -> combL "TryFinally" (exprs args)
        | CombTerm(TryWithOp,[e1;Lambda(v1,e2);Lambda(v2,e3)])         -> combL "TryWith" [expr e1; varL v1; expr e2; varL v2; expr e3]
        | CombTerm(SequentialOp,args)        -> combL "Sequential" (exprs args)
        | CombTerm(NewDelegateOp(ty),[e])   -> 
            let n = (getDelegateInvoke ty).GetParameters().Length
            match e with 
            | NLambdas n (vs,e) -> combL "NewDelegate" ([typeL ty] @ (vs |> List.map varL) @ [expr e])
            | _ -> combL "NewDelegate" [typeL ty; expr e]
        //| CombTerm(_,args)   -> combL "??" (exprs args)
        | VarTerm(v)   -> wordL v.Name
        | LambdaTerm(v,b)   -> combL "Lambda" [varL v; expr b]
        | HoleTerm _  -> wordL "_"
        | CombTerm(QuoteOp _,args) -> combL "Quote" (exprs args)
        | _ -> failwithf "Unexpected term in layout %A" x.Tree

     

and [<CompiledName("FSharpExpr`1")>]
    Expr<'T>(term:Tree,attribs) = 
    inherit Expr(term,attribs)
    member x.Raw = (x :> Expr)

[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module Patterns = 

    /// Internal type representing a deserialized object that is yet to be instantiated. Representation is
    /// as a computation.
    type Instantiable<'T> = (int -> Type) -> 'T

    type ByteStream(bytes:byte[], initial:int, len:int) = 
    
        let mutable pos = initial
        let lim = initial + len
        
        member b.ReadByte() = 
            if pos >= lim then failwith "end of stream";
            let res = int32 bytes.[pos]
            pos <- pos + 1;
            res 
        
        member b.ReadBytes n  = 
            if pos + n > lim then failwith "ByteStream.ReadBytes: end of stream";
            let res = bytes.[pos..pos+n-1]
            pos <- pos + n;
            res 

        member b.ReadUtf8BytesAsString n = 
            let res = System.Text.Encoding.UTF8.GetString(bytes,pos,n)
            pos <- pos + n;
            res


    let E t = new Expr< >(t,[])
    let EA (t,attribs) = new Expr< >(t,attribs)
    let ES ts = List.map E ts

    let (|E|) (e: Expr) = e.Tree
    let (|ES|) (es: list<Expr>) = es |> List.map (fun e -> e.Tree)
    let (|FrontAndBack|_|) es = 
        let rec loop acc xs = match xs with [] -> None | [h] -> Some (List.rev acc, h) | h::t -> loop (h::acc) t
        loop [] es



    let funTyC = typeof<(obj -> obj)>.GetGenericTypeDefinition()  
    let exprTyC = typedefof<Expr<int>>
    let voidTy = typeof<System.Void>
    let unitTy = typeof<unit>
    let removeVoid a = if a = voidTy then unitTy else a
    let addVoid a = if a = unitTy then voidTy else a
    let mkFunTy a b = 
        let (a, b) = removeVoid a, removeVoid b
        funTyC.MakeGenericType([| a;b |])

    let mkArrayTy (t:Type) = t.MakeArrayType();
    let mkExprTy (t:Type) = exprTyC.MakeGenericType([| t |])
    let rawExprTy = typeof<Expr>


    //--------------------------------------------------------------------------
    // Active patterns for decomposing quotations
    //--------------------------------------------------------------------------

    let (|Comb0|_|) (E x) = match x with CombTerm(k,[])  -> Some(k) | _ -> None

    let (|Comb1|_|) (E x) = match x with CombTerm(k,[x]) -> Some(k,x) | _ -> None

    let (|Comb2|_|) (E x) = match x with CombTerm(k,[x1;x2]) -> Some(k,x1,x2) | _ -> None

    let (|Comb3|_|) (E x) = match x with CombTerm(k,[x1;x2;x3]) -> Some(k,x1,x2,x3) | _ -> None
    
    [<CompiledName("VarPattern")>]
    let (|Var|_|)           (E x) = match x with VarTerm v        -> Some v     | _ -> None 

    [<CompiledName("ApplicationPattern")>]
    let (|Application|_|)      x = match x with Comb2(AppOp,a,b) -> Some (a,b) | _ -> None 

    [<CompiledName("LambdaPattern")>]
    let (|Lambda|_|)        (E x) = match x with LambdaTerm(a,b)  -> Some (a,b) | _ -> None 

    [<CompiledName("QuotePattern")>]
    let (|Quote|_|)         (E x) = match x with CombTerm(QuoteOp _,[a])     -> Some (a)   | _ -> None 

    [<CompiledName("QuoteRawPattern")>]
    let (|QuoteRaw|_|)         (E x) = match x with CombTerm(QuoteOp false,[a])     -> Some (a)   | _ -> None 

    [<CompiledName("QuoteTypedPattern")>]
    let (|QuoteTyped|_|)         (E x) = match x with CombTerm(QuoteOp true,[a])     -> Some (a)   | _ -> None 

    [<CompiledName("IfThenElsePattern")>]
    let (|IfThenElse|_|)          = function Comb3(IfThenElseOp,e1,e2,e3) -> Some(e1,e2,e3) | _ -> None

    [<CompiledName("NewTuplePattern")>]
    let (|NewTuple|_|)         = function E(CombTerm(NewTupleOp(_),es)) -> Some(es) | _ -> None

    [<CompiledName("DefaultValuePattern")>]
    let (|DefaultValue|_|)         = function E(CombTerm(DefaultValueOp(ty),[])) -> Some(ty) | _ -> None

    [<CompiledName("NewRecordPattern")>]
    let (|NewRecord|_|)          = function E(CombTerm(NewRecordOp(x),es)) -> Some(x,es) | _ -> None

    [<CompiledName("NewUnionCasePattern")>]
    let (|NewUnionCase|_|)           = function E(CombTerm(NewUnionCaseOp(unionCase),es)) -> Some(unionCase,es) | _ -> None

    [<CompiledName("UnionCaseTestPattern")>]
    let (|UnionCaseTest|_|)    = function Comb1(UnionCaseTestOp(unionCase),e) -> Some(e,unionCase) | _ -> None

    [<CompiledName("TupleGetPattern")>]
    let (|TupleGet|_|)      = function Comb1(TupleGetOp(_,n),e) -> Some(e,n) | _ -> None

    [<CompiledName("CoercePattern")>]
    let (|Coerce|_|)        = function Comb1(CoerceOp ty,e1) -> Some(e1,ty) | _ -> None

    [<CompiledName("TypeTestPattern")>]
    let (|TypeTest|_|)        = function Comb1(TypeTestOp ty,e1) -> Some(e1,ty) | _ -> None

    [<CompiledName("NewArrayPattern")>]
    let (|NewArray|_|)      = function E(CombTerm(NewArrayOp ty,es)) -> Some(ty,es) | _ -> None

    [<CompiledName("AddressSetPattern")>]
    let (|AddressSet|_|)    = function E(CombTerm(AddressSetOp,[e;v])) -> Some(e,v) | _ -> None

    [<CompiledName("TryFinallyPattern")>]
    let (|TryFinally|_|)    = function E(CombTerm(TryFinallyOp,[e1;e2])) -> Some(e1,e2) | _ -> None

    [<CompiledName("TryWithPattern")>]
    let (|TryWith|_|)      = function E(CombTerm(TryWithOp,[e1;Lambda(v1,e2);Lambda(v2,e3)])) -> Some(e1,v1,e2,v2,e3) | _ -> None

    [<CompiledName("VarSetPattern")>]
    let (|VarSet|_|    )    = function E(CombTerm(VarSetOp,[E(VarTerm(v)); e])) -> Some(v,e) | _ -> None

    [<CompiledName("ValuePattern")>]
    let (|Value|_|)         = function E(CombTerm(ValueOp (v,ty,_),_)) -> Some(v,ty) | _ -> None

    [<CompiledName("ValueObjPattern")>]
    let (|ValueObj|_|)      = function E(CombTerm(ValueOp (v,_,_),_)) -> Some(v) | _ -> None

    [<CompiledName("ValueWithNamePattern")>]
    let (|ValueWithName|_|) = function E(CombTerm(ValueOp (v,ty,Some nm),_)) -> Some(v,ty,nm) | _ -> None

    [<CompiledName("WithValuePattern")>]
    let (|WithValue|_|) = function E(CombTerm(WithValueOp (v,ty),[e])) -> Some(v,ty,e) | _ -> None

    [<CompiledName("AddressOfPattern")>]
    let (|AddressOf|_|)       = function Comb1(AddressOfOp,e) -> Some(e) | _ -> None

    [<CompiledName("SequentialPattern")>]
    let (|Sequential|_|)    = function Comb2(SequentialOp,e1,e2) -> Some(e1,e2) | _ -> None

    [<CompiledName("ForIntegerRangeLoopPattern")>]
    let (|ForIntegerRangeLoop|_|)       = function Comb3(ForIntegerRangeLoopOp,e1,e2,Lambda(v, e3)) -> Some(v,e1,e2,e3) | _ -> None

    [<CompiledName("WhileLoopPattern")>]
    let (|WhileLoop|_|)     = function Comb2(WhileLoopOp,e1,e2) -> Some(e1,e2) | _ -> None

    [<CompiledName("PropertyGetPattern")>]
    let (|PropertyGet|_|)       = function E(CombTerm(StaticPropGetOp pinfo,args)) -> Some(None,pinfo,args) 
                                         | E(CombTerm(InstancePropGetOp pinfo,obj::args)) -> Some(Some(obj),pinfo,args) 
                                         | _ -> None

    [<CompiledName("PropertySetPattern")>]
    let (|PropertySet|_|)   x    = 
        match x with 
        | E(CombTerm(StaticPropSetOp pinfo, FrontAndBack(args,v))) -> Some(None,pinfo,args,v) 
        | E(CombTerm(InstancePropSetOp pinfo, obj::FrontAndBack(args,v))) -> Some(Some(obj),pinfo,args,v) 
        | _ -> None


    [<CompiledName("FieldGetPattern")>]
    let (|FieldGet|_|)      = function E(CombTerm(StaticFieldGetOp finfo,[])) -> Some(None,finfo) 
                                     | E(CombTerm(InstanceFieldGetOp finfo,[obj])) -> Some(Some(obj),finfo) 
                                     | _ -> None
    [<CompiledName("FieldSetPattern")>]
    let (|FieldSet|_|)      = function E(CombTerm(StaticFieldSetOp finfo,[v])) -> Some(None,finfo,v) 
                                     | E(CombTerm(InstanceFieldSetOp finfo,[obj;v])) -> Some(Some(obj),finfo,v) 
                                     | _ -> None
    [<CompiledName("NewObjectPattern")>]
    let (|NewObject|_|)      = function E(CombTerm(NewObjectOp ty,e)) -> Some(ty,e) | _ -> None

    [<CompiledName("CallPattern")>]
    let (|Call|_|)           = function E(CombTerm(StaticMethodCallOp minfo,args)) -> Some(None,minfo,args) 
                                      | E(CombTerm(InstanceMethodCallOp minfo,(obj::args))) -> Some(Some(obj),minfo,args) 
                                      | _ -> None
    let (|LetRaw|_|)        = function Comb2(LetOp,e1,e2) -> Some(e1,e2) | _ -> None

    let (|LetRecRaw|_|)     = function Comb1(LetRecOp,e1) -> Some(e1) | _ -> None

    [<CompiledName("LetPattern")>]
    let (|Let|_|) = function LetRaw(e,Lambda(v,body)) -> Some(v,e,body) | _ -> None

    let (|IteratedLambda|_|) (e: Expr) = qOneOrMoreRLinear (|Lambda|_|) e 

    let rec (|NLambdas|_|) n (e:Expr) = 
        match e with 
        | _ when n <= 0 -> Some([],e) 
        | Lambda(v,NLambdas ((-) n 1) (vs,b)) -> Some(v::vs,b)
        | _ -> None

    [<CompiledName("NewDelegatePattern")>]
    let (|NewDelegate|_|) e  = 
        match e with 
        | Comb1(NewDelegateOp(ty),e) -> 
            let n = (getDelegateInvoke ty).GetParameters().Length
            match e with 
            | NLambdas n (vs,e) -> Some(ty,vs,e) 
            | _ -> None
        | _ -> None

    [<CompiledName("LetRecursivePattern")>]
    let (|LetRecursive|_|) e = 
        match e with 
        | LetRecRaw(IteratedLambda(vs1,E(CombTerm(LetRecCombOp,body::es)))) -> Some(List.zip vs1 es,body)
        | _ -> None
    
    //--------------------------------------------------------------------------
    // Getting the type of Raw quotations
    //--------------------------------------------------------------------------

    // Returns record member specified by name
    let getRecordProperty(ty,fieldName) =    
        let mems = FSharpType.GetRecordFields(ty,publicOrPrivateBindingFlags)
        match mems |> Array.tryFind (fun minfo -> minfo.Name = fieldName) with
        | Some (m) -> m
        | _ -> invalidArg  "fieldName" (SR.GetString2(SR.QmissingRecordField, ty.FullName, fieldName))

    let getUnionCaseInfo(ty,unionCaseName) =    
        let cases = FSharpType.GetUnionCases(ty,publicOrPrivateBindingFlags)
        match cases |> Array.tryFind (fun ucase -> ucase.Name = unionCaseName) with
        | Some(case) -> case
        | _ -> invalidArg  "unionCaseName" (SR.GetString2(SR.QmissingUnionCase, ty.FullName, unionCaseName))
    
    let getUnionCaseInfoField(unionCase:UnionCaseInfo,index) =    
        let fields = unionCase.GetFields() 
        if index < 0 || index >= fields.Length then invalidArg "index" (SR.GetString(SR.QinvalidCaseIndex))
        fields.[index]
 
    /// Returns type of lambda application - something like "(fun a -> ..) b"
    let rec typeOfAppliedLambda f =
        let fty = ((typeOf f):Type) 
        match fty.GetGenericArguments() with 
        | [| _; b|] -> b
        | _ -> raise <| System.InvalidOperationException (SR.GetString(SR.QillFormedAppOrLet))          

    /// Returns type of the Raw quotation or fails if the quotation is ill formed
    /// if 'verify' is true, verifies all branches, otherwise ignores some of them when not needed
    and typeOf<'T when 'T :> Expr> (e : 'T) : Type = 
        let (E t) = e 
        match t with 
        | VarTerm    v        -> v.Type
        | LambdaTerm (v,b)    -> mkFunTy v.Type (typeOf b)
        | HoleTerm   (ty,_)   -> ty
        | CombTerm   (c,args) -> 
            match c,args with 
            | AppOp,[f;_] -> typeOfAppliedLambda f
            | LetOp,_ -> match e with Let(_,_,b) -> typeOf b | _ -> failwith "unreachable"
            | IfThenElseOp,[_;t;_]  -> typeOf t
            | LetRecOp,_     -> match e with LetRecursive(_,b) -> typeOf b | _ -> failwith "unreachable"
            | LetRecCombOp,_        -> failwith "typeOfConst: LetRecCombOp" 
            | NewRecordOp ty,_         -> ty
            | NewUnionCaseOp unionCase,_   -> unionCase.DeclaringType
            | UnionCaseTestOp _,_ -> typeof<Boolean>
            | ValueOp (_, ty, _),_  -> ty
            | WithValueOp (_, ty),_  -> ty
            | TupleGetOp (ty,i),_ -> FSharpType.GetTupleElements(ty).[i] 
            | NewTupleOp ty,_      -> ty
            | StaticPropGetOp prop,_    -> prop.PropertyType
            | InstancePropGetOp prop,_    -> prop.PropertyType
            | StaticPropSetOp _,_   -> typeof<Unit>
            | InstancePropSetOp _,_    -> typeof<Unit>
            | InstanceFieldGetOp fld ,_   -> fld.FieldType
            | StaticFieldGetOp fld ,_   -> fld.FieldType
            | InstanceFieldSetOp _,_    -> typeof<Unit>
            | StaticFieldSetOp _,_    -> typeof<Unit>
            | NewObjectOp ctor,_   -> ctor.DeclaringType
            | InstanceMethodCallOp minfo,_   -> minfo.ReturnType |> removeVoid
            | StaticMethodCallOp minfo,_   -> minfo.ReturnType |> removeVoid
            | CoerceOp ty,_       -> ty
            | SequentialOp,[_;b]      -> typeOf b 
            | ForIntegerRangeLoopOp,_  -> typeof<Unit>
            | NewArrayOp ty,_      -> mkArrayTy ty
            | NewDelegateOp ty,_     -> ty
            | DefaultValueOp ty,_     -> ty
            | TypeTestOp _,_     -> typeof<bool>
            | QuoteOp true,[expr]        -> mkExprTy (typeOf expr)
            | QuoteOp false,[_]        -> rawExprTy
            | TryFinallyOp,[e1;_]        -> typeOf e1
            | TryWithOp,[e1;_;_]        -> typeOf e1
            | WhileLoopOp,_ 
            | VarSetOp,_
            | AddressSetOp,_ -> typeof<Unit> 
            | AddressOfOp,_ -> raise <| System.InvalidOperationException (SR.GetString(SR.QcannotTakeAddress))
            | (QuoteOp _ | SequentialOp | TryWithOp | TryFinallyOp | IfThenElseOp | AppOp),_ -> failwith "unreachable"


    //--------------------------------------------------------------------------
    // Constructors for building Raw quotations
    //--------------------------------------------------------------------------
      
    let mkFEN op l = E(CombTerm(op,l))
    let mkFE0 op = E(CombTerm(op,[]))
    let mkFE1 op x = E(CombTerm(op,[(x:>Expr)]))
    let mkFE2 op (x,y) = E(CombTerm(op,[(x:>Expr);(y:>Expr)]))
    let mkFE3 op (x,y,z) = E(CombTerm(op,[(x:>Expr);(y:>Expr);(z:>Expr)])  )
    let mkOp v () = v

    //--------------------------------------------------------------------------
    // Type-checked constructors for building Raw quotations
    //--------------------------------------------------------------------------
  
    // t2 is inherited from t1 / t2 implements interface t1 or t2 == t1
    let assignableFrom (t1:Type) (t2:Type) =  
        t1.IsAssignableFrom(t2)
      
    let checkTypesSR (expectedType: Type) (receivedType : Type)  name (threeHoleSR : string) =
        if (expectedType <> receivedType) then 
          invalidArg "receivedType" (String.Format(threeHoleSR, name, expectedType, receivedType))

    let checkTypesWeakSR (expectedType: Type) (receivedType : Type)  name (threeHoleSR : string) = 
        if (not (assignableFrom expectedType receivedType)) then 
          invalidArg "receivedType" (String.Format(threeHoleSR, name, expectedType, receivedType))
  
    let checkArgs (paramInfos: ParameterInfo[]) (args:list<Expr>) =  
        if (paramInfos.Length <> args.Length) then invalidArg "args" (SR.GetString(SR.QincorrectNumArgs))
        List.iter2
            ( fun (p:ParameterInfo) a -> checkTypesWeakSR p.ParameterType (typeOf a) "args" (SR.GetString(SR.QtmmInvalidParam))) 
            (paramInfos |> Array.toList) 
            args
                                                // todo: shouldn't this be "strong" type check? sometimes?

    let checkAssignableFrom ty1 ty2 = 
        if not (assignableFrom ty1 ty2) then invalidArg "ty2" (SR.GetString(SR.QincorrectType))

    let checkObj  (membInfo: MemberInfo) (obj: Expr) = 
        // The MemberInfo may be a property associated with a union
        // find the actual related union type
        let rec loop (ty:Type) = if FSharpType.IsUnion ty && FSharpType.IsUnion ty.BaseType then loop ty.BaseType else ty
        let declType = loop membInfo.DeclaringType
        if not (assignableFrom declType (typeOf obj)) then invalidArg "obj" (SR.GetString(SR.QincorrectInstanceType))

      
    // Checks lambda application for correctness
    let checkAppliedLambda (f, v) =
        let fty = typeOf f
        let ftyG = (if fty.IsGenericType then  fty.GetGenericTypeDefinition()  else fty)
        checkTypesSR funTyC ftyG "f" (SR.GetString(SR.QtmmExpectedFunction))
        let vty = (typeOf v)
        match fty.GetGenericArguments() with 
          | [| a; _ |] -> checkTypesSR vty a "f" (SR.GetString(SR.QtmmFunctionArgTypeMismatch))
          | _ -> invalidArg  "f" (SR.GetString(SR.QinvalidFuncType))
  
    // Returns option (by name) of a NewUnionCase type
    let getUnionCaseFields ty str =       
        let cases = FSharpType.GetUnionCases(ty,publicOrPrivateBindingFlags)
        match cases |> Array.tryFind (fun ucase -> ucase.Name = str) with
        | Some(case) -> case.GetFields()
        | _ -> invalidArg  "ty" (SR.GetString1(SR.notAUnionType, ty.FullName))
  
    let checkBind(v:Var,e) = 
        let ety = typeOf e
        checkTypesSR v.Type ety "let" (SR.GetString(SR.QtmmVarTypeNotMatchRHS))
  
    // [Correct by definition]
    let mkVar v       = E(VarTerm v )
    let mkQuote(a,isTyped)    = E(CombTerm(QuoteOp isTyped,[(a:>Expr)] ))
          
    let mkValue (v,ty) = mkFE0 (ValueOp(v,ty,None))
    let mkValueWithName (v,ty,nm) = mkFE0 (ValueOp(v,ty,Some nm))
    let mkValueWithDefn (v,ty,defn) = mkFE1 (WithValueOp(v,ty)) defn
    let mkValueG (v:'T) = mkValue(box v, typeof<'T>)
    let mkLiftedValueOpG (v, ty: System.Type) = 
        let obj = if ty.IsEnum then System.Enum.ToObject(ty, box v) else box v
        ValueOp(obj, ty, None)
    let mkUnit       () = mkValue(null, typeof<unit>)
    let mkAddressOf     v = mkFE1 AddressOfOp v
    let mkSequential  (e1,e2) = mkFE2 SequentialOp (e1,e2) 
    let mkTypeTest    (e,ty) = mkFE1 (TypeTestOp(ty)) e
    let mkVarSet    (v,e) = mkFE2 VarSetOp (mkVar(v),e)
    let mkAddressSet    (e1,e2) = mkFE2 AddressSetOp (e1,e2)
    let mkLambda(var,body) = E(LambdaTerm(var,(body:>Expr)))
    let mkTryWith(e1,v1,e2,v2,e3) = mkFE3 TryWithOp (e1,mkLambda(v1,e2),mkLambda(v2,e3))
    let mkTryFinally(e1,e2) = mkFE2 TryFinallyOp (e1,e2)
    
    let mkCoerce      (ty,x) = mkFE1 (CoerceOp ty) x
    let mkNull        (ty)   = mkFE0 (ValueOp(null,ty,None))
    
    let mkApplication v = checkAppliedLambda v; mkFE2 AppOp v 

    let mkLetRaw v =
        mkFE2 LetOp v

    let mkLetRawWithCheck ((e1,e2) as v) =
        checkAppliedLambda (e2,e1) 
        mkLetRaw v

    // Tuples
    let mkNewTupleWithType    (ty,args:Expr list) = 
        let mems = FSharpType.GetTupleElements ty |> Array.toList
        if (args.Length <> mems.Length) then invalidArg  "args" (SR.GetString(SR.QtupleLengthsDiffer))
        List.iter2(fun mt a -> checkTypesSR mt (typeOf a) "args" (SR.GetString(SR.QtmmTuple)) ) mems args
        mkFEN (NewTupleOp ty) args 
    
    let mkNewTuple (args) = 
        let ty = FSharpType.MakeTupleType(Array.map typeOf (Array.ofList args))
        mkFEN (NewTupleOp ty) args
    
    let mkTupleGet (ty,n,x) = 
        checkTypesSR ty (typeOf x) "tupleGet" (SR.GetString(SR.QtmmExprNotMatchTuple))
        let mems = FSharpType.GetTupleElements ty 
        if (n < 0 || mems.Length <= n) then invalidArg  "n" (SR.GetString(SR.QtupleAccessOutOfRange))
        mkFE1 (TupleGetOp (ty,n)) x
    
    // Records
    let mkNewRecord (ty,args:list<Expr>) = 
        let mems = FSharpType.GetRecordFields(ty,publicOrPrivateBindingFlags) 
        if (args.Length <> mems.Length) then invalidArg  "args" (SR.GetString(SR.QincompatibleRecordLength))
        List.iter2 (fun (minfo:PropertyInfo) a -> checkTypesSR minfo.PropertyType (typeOf a) "recd" (SR.GetString(SR.QtmmIncorrectArgForRecord))) (Array.toList mems) args
        mkFEN (NewRecordOp ty) args
      
      
    // Discriminated unions        
    let mkNewUnionCase (unionCase:UnionCaseInfo,args:list<Expr>) = 
        if Unchecked.defaultof<UnionCaseInfo> = unionCase then raise (new ArgumentNullException())
        let sargs = unionCase.GetFields()
        if (args.Length <> sargs.Length) then invalidArg  "args" (SR.GetString(SR.QunionNeedsDiffNumArgs))
        List.iter2 (fun (minfo:PropertyInfo) a  -> checkTypesSR minfo.PropertyType (typeOf a) "sum" (SR.GetString(SR.QtmmIncorrectArgForUnion))) (Array.toList sargs) args
        mkFEN (NewUnionCaseOp unionCase) args
        
    let mkUnionCaseTest (unionCase:UnionCaseInfo,expr) = 
        if Unchecked.defaultof<UnionCaseInfo> = unionCase then raise (new ArgumentNullException())
        checkTypesSR unionCase.DeclaringType (typeOf expr) "UnionCaseTagTest" (SR.GetString(SR.QtmmExprTypeMismatch))
        mkFE1 (UnionCaseTestOp unionCase) expr

    // Conditional etc..
    let mkIfThenElse (e,t,f) = 
        checkTypesSR (typeOf t) (typeOf f) "cond" (SR.GetString(SR.QtmmTrueAndFalseMustMatch))
        checkTypesSR (typeof<Boolean>) (typeOf e) "cond" (SR.GetString(SR.QtmmCondMustBeBool))
        mkFE3 IfThenElseOp (e,t,f)               
        
    let mkNewArray (ty,args) = 
        List.iter (fun a -> checkTypesSR ty (typeOf a) "newArray" (SR.GetString(SR.QtmmInitArray))) args
        mkFEN (NewArrayOp ty) args
        
    let mkInstanceFieldGet(obj,finfo:FieldInfo) =
        if Unchecked.defaultof<FieldInfo> = finfo then raise (new ArgumentNullException())
        match finfo.IsStatic with 
        | false -> 
            checkObj finfo obj
            mkFE1 (InstanceFieldGetOp finfo) obj
        | true -> invalidArg  "finfo" (SR.GetString(SR.QstaticWithReceiverObject))
      
    let mkStaticFieldGet    (finfo:FieldInfo) =
        if Unchecked.defaultof<FieldInfo> = finfo then raise (new ArgumentNullException())
        match finfo.IsStatic with 
        | true -> mkFE0 (StaticFieldGetOp finfo) 
        | false -> invalidArg  "finfo" (SR.GetString(SR.QnonStaticNoReceiverObject))
      
    let mkStaticFieldSet (finfo:FieldInfo,value:Expr) =
        if Unchecked.defaultof<FieldInfo> = finfo then raise (new ArgumentNullException())
        checkTypesSR (typeOf value) finfo.FieldType "value" (SR.GetString(SR.QtmmBadFieldType))
        match finfo.IsStatic with 
        | true -> mkFE1 (StaticFieldSetOp finfo) value
        | false -> invalidArg  "finfo" (SR.GetString(SR.QnonStaticNoReceiverObject))
      
    let mkInstanceFieldSet (obj,finfo:FieldInfo,value:Expr) =
        if Unchecked.defaultof<FieldInfo> = finfo then raise (new ArgumentNullException())
        checkTypesSR (typeOf value) finfo.FieldType "value" (SR.GetString(SR.QtmmBadFieldType))
        match finfo.IsStatic with 
        | false -> 
            checkObj finfo obj
            mkFE2 (InstanceFieldSetOp finfo) (obj,value)
        | true -> invalidArg  "finfo" (SR.GetString(SR.QstaticWithReceiverObject))
      
    let mkCtorCall (ci:ConstructorInfo,args:list<Expr>) =
        if Unchecked.defaultof<ConstructorInfo> = ci then raise (new ArgumentNullException())
        checkArgs (ci.GetParameters()) args
        mkFEN (NewObjectOp ci) args

    let mkDefaultValue (ty:Type) =
        mkFE0 (DefaultValueOp ty) 

    let mkStaticPropGet (pinfo:PropertyInfo,args:list<Expr>) = 
        if Unchecked.defaultof<PropertyInfo> = pinfo then raise (new ArgumentNullException())
        if (not pinfo.CanRead) then invalidArg  "pinfo" (SR.GetString(SR.QreadingSetOnly))
        checkArgs (pinfo.GetIndexParameters()) args
        match pinfo.GetGetMethod(true).IsStatic with 
        | true -> mkFEN (StaticPropGetOp  pinfo) args
        | false -> invalidArg  "pinfo" (SR.GetString(SR.QnonStaticNoReceiverObject))

    let mkInstancePropGet (obj,pinfo:PropertyInfo,args:list<Expr>) = 
        if Unchecked.defaultof<PropertyInfo> = pinfo then raise (new ArgumentNullException())
        if (not pinfo.CanRead) then invalidArg  "pinfo" (SR.GetString(SR.QreadingSetOnly))
        checkArgs (pinfo.GetIndexParameters()) args
        match pinfo.GetGetMethod(true).IsStatic with 
        | false -> 
            checkObj pinfo obj
            mkFEN (InstancePropGetOp pinfo) (obj::args)
        | true -> invalidArg  "pinfo" (SR.GetString(SR.QstaticWithReceiverObject))
          
    let mkStaticPropSet (pinfo:PropertyInfo,args:list<Expr>,value:Expr) = 
        if Unchecked.defaultof<PropertyInfo> = pinfo then raise (new ArgumentNullException())
        if (not pinfo.CanWrite) then invalidArg  "pinfo" (SR.GetString(SR.QwritingGetOnly))
        checkArgs (pinfo.GetIndexParameters()) args
        match pinfo.GetSetMethod(true).IsStatic with 
        | true -> mkFEN (StaticPropSetOp pinfo) (args@[value])
        | false -> invalidArg  "pinfo" (SR.GetString(SR.QnonStaticNoReceiverObject))
          
    let mkInstancePropSet (obj,pinfo:PropertyInfo,args:list<Expr>,value:Expr) = 
        if Unchecked.defaultof<PropertyInfo> = pinfo then raise (new ArgumentNullException())
        if (not pinfo.CanWrite) then invalidArg  "pinfo" (SR.GetString(SR.QwritingGetOnly))
        checkArgs (pinfo.GetIndexParameters()) args
        match pinfo.GetSetMethod(true).IsStatic with 
        | false -> 
            checkObj pinfo obj
            mkFEN (InstancePropSetOp pinfo) (obj::(args@[value]))
        | true -> invalidArg  "pinfo" (SR.GetString(SR.QstaticWithReceiverObject))
          
    let mkInstanceMethodCall (obj,minfo:MethodInfo,args:list<Expr>) =
        if Unchecked.defaultof<MethodInfo> = minfo then raise (new ArgumentNullException())
        checkArgs (minfo.GetParameters()) args
        match minfo.IsStatic with 
        | false -> 
            checkObj minfo obj
            mkFEN (InstanceMethodCallOp minfo) (obj::args)
        | true -> invalidArg  "minfo" (SR.GetString(SR.QstaticWithReceiverObject))
    
    let mkStaticMethodCall (minfo:MethodInfo,args:list<Expr>) =
        if Unchecked.defaultof<MethodInfo> = minfo then raise (new ArgumentNullException())
        checkArgs (minfo.GetParameters()) args
        match minfo.IsStatic with 
        | true -> mkFEN (StaticMethodCallOp minfo) args
        | false -> invalidArg  "minfo" (SR.GetString(SR.QnonStaticNoReceiverObject))
    
    let mkForLoop (v:Var,lowerBound,upperBound,body) = 
        checkTypesSR (typeof<int>) (typeOf lowerBound) "lowerBound" (SR.GetString(SR.QtmmLowerUpperBoundMustBeInt))
        checkTypesSR (typeof<int>) (typeOf upperBound) "upperBound" (SR.GetString(SR.QtmmLowerUpperBoundMustBeInt))
        checkTypesSR (typeof<int>) (v.Type) "for" (SR.GetString(SR.QtmmLoopBodyMustBeLambdaTakingInteger))
        mkFE3 ForIntegerRangeLoopOp (lowerBound, upperBound, mkLambda(v,body))
      
    let mkWhileLoop (guard,body) = 
        checkTypesSR (typeof<bool>) (typeOf guard) "guard" (SR.GetString(SR.QtmmGuardMustBeBool))
        checkTypesSR (typeof<Unit>) (typeOf body) "body" (SR.GetString(SR.QtmmBodyMustBeUnit))
        mkFE2 (WhileLoopOp) (guard,body)
    
    let mkNewDelegate (ty,e) = 
        let mi = getDelegateInvoke ty
        let ps = mi.GetParameters()
        let dlfun = Array.foldBack (fun (p:ParameterInfo) rty -> mkFunTy p.ParameterType rty) ps mi.ReturnType
        checkTypesSR dlfun (typeOf e) "ty" (SR.GetString(SR.QtmmFunTypeNotMatchDelegate))
        mkFE1 (NewDelegateOp ty) e
    
    let mkLet (v,e,b) = 
        checkBind (v,e);
        mkLetRaw (e,mkLambda(v,b))

    //let mkLambdas(vs,b) = mkRLinear mkLambdaRaw (vs,(b:>Expr))
    let mkTupledApplication (f,args) = 
        match args with 
        | [] -> mkApplication (f,mkUnit())
        | [x] -> mkApplication (f,x)
        | _ -> mkApplication (f,mkNewTuple args)
        
    let mkApplications(f: Expr,es:list<list<Expr>>) = mkLLinear mkTupledApplication (f,es)
    
    let mkIteratedLambdas(vs,b) = mkRLinear  mkLambda (vs,b)
    
    let mkLetRecRaw v = mkFE1 LetRecOp v
    let mkLetRecCombRaw v = mkFEN LetRecCombOp v
    let mkLetRec (ves:(Var*Expr) list,body) = 
        List.iter checkBind ves;
        let vs,es = List.unzip ves 
        mkLetRecRaw(mkIteratedLambdas (vs,mkLetRecCombRaw (body::es)))

    let ReflectedDefinitionsResourceNameBase = "ReflectedDefinitions"

    //-------------------------------------------------------------------------
    // General Method Binder

    /// Usually functions in modules are not overloadable so having name is enough to recover the function.
    /// However type extensions break this assumption - it is possible to have multiple extension methods in module that will have the same name.
    /// This type is used to denote different binding results so we can distinguish the latter case and retry binding later when more information is available.
    [<NoEquality; NoComparison>]
    type ModuleDefinitionBindingResult<'T, 'R> =
        | Unique of 'T
        | Ambiguous of 'R

    let typeEquals     (s:Type) (t:Type) = s.Equals(t)
    let typesEqual (ss:Type list) (tt:Type list) =
      (ss.Length = tt.Length) && List.forall2 typeEquals ss tt

    let instFormal (typarEnv: Type[]) (ty:Instantiable<'T>) = ty (fun i -> typarEnv.[i])

    let getGenericArguments(tc:Type) = 
        if tc.IsGenericType then tc.GetGenericArguments() else [| |] 

    let getNumGenericArguments(tc:Type) = 
        if tc.IsGenericType then tc.GetGenericArguments().Length else 0
    
    let bindMethodBySearch (parentT:Type,nm,marity,argtys,rty) =
        let methInfos = parentT.GetMethods(staticOrInstanceBindingFlags) |> Array.toList 
        // First, filter on name, if unique, then binding "done" 
        let tyargTs = getGenericArguments(parentT) 
        let methInfos = methInfos |> List.filter (fun methInfo -> methInfo.Name = nm)
        match methInfos with 
        | [methInfo] -> 
            methInfo
        | _ ->
            // Second, type match. 
            let select (methInfo:MethodInfo) =
                // mref implied Types 
                let mtyargTIs = if methInfo.IsGenericMethod then methInfo.GetGenericArguments() else [| |] 
                if mtyargTIs.Length  <> marity then false (* method generic arity mismatch *) else
                let typarEnv = (Array.append tyargTs mtyargTIs) 
                let argTs = argtys |> List.map (instFormal typarEnv) 
                let resT  = instFormal typarEnv rty 
                
                // methInfo implied Types 
                let haveArgTs = 
                    let parameters = Array.toList (methInfo.GetParameters()) 
                    parameters |> List.map (fun param -> param.ParameterType) 
                let haveResT  = methInfo.ReturnType 
                // check for match 
                if argTs.Length <> haveArgTs.Length then false (* method argument length mismatch *) else
                let res = typesEqual (resT::argTs) (haveResT::haveArgTs) 
                res
            // return MethodInfo for (generic) type's (generic) method 
            match List.tryFind select methInfos with
            | None          -> raise <| System.InvalidOperationException (SR.GetString SR.QcannotBindToMethod) 
            | Some methInfo -> methInfo 

    let bindMethodHelper (parentT: Type, nm,marity,argtys,rty) =
      if parentT = null then invalidArg "parentT" (SR.GetString(SR.QparentCannotBeNull))
      if marity = 0 then 
          let tyargTs = if parentT.IsGenericType then parentT.GetGenericArguments() else [| |] 
          let argTs = Array.ofList (List.map (instFormal tyargTs) argtys) 
          let resT  = instFormal tyargTs rty 
          let methInfo = 
              try 
#if FX_ATLEAST_PORTABLE
                 match parentT.GetMethod(nm,argTs) with 
#else              
                 match parentT.GetMethod(nm,staticOrInstanceBindingFlags,null,argTs,null) with 
#endif                 
                 | null -> None
                 | res -> Some(res)
               with :? AmbiguousMatchException -> None 
          match methInfo with 
          | Some methInfo when (typeEquals resT methInfo.ReturnType) -> methInfo
          | _ -> bindMethodBySearch(parentT,nm,marity,argtys,rty)
      else 
          bindMethodBySearch(parentT,nm,marity,argtys,rty)

    let bindModuleProperty (ty:Type,nm) = 
        match ty.GetProperty(nm,staticBindingFlags) with
        | null -> raise <| System.InvalidOperationException (SR.GetString2(SR.QcannotBindProperty, nm, ty.ToString()))
        | res -> res
    
    // tries to locate unique function in a given type
    // in case of multiple candidates returns None so bindModuleFunctionWithCallSiteArgs will be used for more precise resolution
    let bindModuleFunction (ty:Type,nm) = 
        match ty.GetMethods(staticBindingFlags) |> Array.filter (fun mi -> mi.Name = nm) with 
        | [||] -> raise <| System.InvalidOperationException (SR.GetString2(SR.QcannotBindFunction, nm, ty.ToString()))
        | [| res |] -> Some res
        | _ -> None
    
    let bindModuleFunctionWithCallSiteArgs (ty:Type, nm, argTypes : Type list, tyArgs : Type list) = 
        let argTypes = List.toArray argTypes
        let tyArgs = List.toArray tyArgs
        let methInfo = 
            try 
#if FX_ATLEAST_PORTABLE
                match ty.GetMethod(nm, argTypes) with 
#else             
                match ty.GetMethod(nm,staticOrInstanceBindingFlags,null, argTypes,null) with 
#endif                 
                | null -> None
                | res -> Some(res)
            with :? AmbiguousMatchException -> None 
        match methInfo with 
        | Some methInfo -> methInfo
        | _ ->
            // narrow down set of candidates by removing methods with a different name\number of arguments\number of type parameters
            let candidates = 
                ty.GetMethods(staticBindingFlags)
                |> Array.filter(fun mi ->
                    mi.Name = nm &&
                    mi.GetParameters().Length = argTypes.Length &&
                    let methodTyArgCount = if mi.IsGenericMethod then mi.GetGenericArguments().Length else 0
                    methodTyArgCount = tyArgs.Length
                )
            let fail() = raise <| System.InvalidOperationException (SR.GetString2(SR.QcannotBindFunction, nm, ty.ToString()))
            match candidates with
            | [||] -> fail()
            | [| solution |] -> solution
            | candidates ->
                let solution =
                    // no type arguments - just perform pairwise comparison of type in methods signature and argument type from the callsite
                    if tyArgs.Length = 0 then
                        candidates
                        |> Array.tryFind(fun mi ->
                            let paramTys = mi.GetParameters() |> Array.map (fun pi -> pi.ParameterType)
                            Array.forall2 (=) argTypes paramTys
                        )
                    else
                        let FAIL = -1
                        let MATCH = 2
                        let GENERIC_MATCH = 1
                        // if signature has type arguments then it is possible to have several candidates like
                        // - Foo(_ : 'a)
                        // - Foo(_ : int)
                        // and callsite
                        // - Foo<int>(_ : int)
                        // here instantiation of first method we'll have two similar signatures
                        // however compiler will pick second one and we must do the same.

                        // here we compute weights for every signature
                        // for every parameter type:
                        // - non-matching with actual argument type stops computation and return FAIL as the final result
                        // - exact match with actual argument type adds MATCH value to the final result
                        // - parameter type is generic that after instantiation matches actual argument type adds GENERIC_MATCH to the final result
                        // - parameter type is generic that after instantiation doesn't actual argument type stops computation and return FAIL as the final result
                        let weight (mi : MethodInfo) =
                            let parameters = mi.GetParameters()
                            let rec iter i acc = 
                                if i >= argTypes.Length then acc
                                else
                                let param = parameters.[i]
                                if param.ParameterType.IsGenericParameter then
                                    let actualTy = tyArgs.[param.ParameterType.GenericParameterPosition]
                                    if actualTy = argTypes.[i] then iter (i + 1) (acc + GENERIC_MATCH) else FAIL
                                else
                                    if param.ParameterType = argTypes.[i] then iter (i + 1) (acc + MATCH) else FAIL
                            iter 0 0
                        let solution, weight = 
                            candidates 
                            |> Array.map (fun mi -> mi, weight mi)
                            |> Array.maxBy snd
                        if weight = FAIL then None
                        else Some solution
                match solution with
                | Some mi -> mi
                | None -> fail() 
            
    let mkNamedType (tc:Type,tyargs)  =
        match  tyargs with 
        | [] -> tc
        | _ -> tc.MakeGenericType(Array.ofList tyargs)

    let inline checkNonNullResult (arg:string,err:string) y = 
        match box y with 
        | null -> raise (new ArgumentNullException(arg,err)) 
        | _ -> y

    let inst (tyargs:Type list) (i: Instantiable<'T>) = i (fun idx -> tyargs.[idx]) // Note, O(n) looks, but #tyargs is always small
    
    let bindPropBySearchIfCandidateIsNull (ty : Type) propName retType argTypes candidate = 
        match candidate with
        | null ->
            let props = 
                ty.GetProperties(staticOrInstanceBindingFlags)
                |> Array.filter (fun pi -> 
                    let paramTypes = getTypesFromParamInfos (pi.GetIndexParameters())
                    pi.Name = propName && 
                    pi.PropertyType = retType && 
                    Array.length argTypes = paramTypes.Length && 
                    Array.forall2 (=) argTypes paramTypes
                    )
            match props with
            | [| pi |] -> pi
            | _ -> null
        | pi -> pi
    
    let bindCtorBySearchIfCandidateIsNull (ty : Type) argTypes candidate = 
        match candidate with
        | null -> 
            let ctors = 
                ty.GetConstructors(instanceBindingFlags)
                |> Array.filter (fun ci ->
                    let paramTypes = getTypesFromParamInfos (ci.GetParameters())
                    Array.length argTypes = paramTypes.Length &&
                    Array.forall2 (=) argTypes paramTypes
                )
            match ctors with
            | [| ctor |] -> ctor
            | _ -> null
        | ctor -> ctor
                  

    let bindProp (tc,propName,retType,argTypes,tyargs) =
        // We search in the instantiated type, rather than searching the generic type.
        let typ = mkNamedType(tc,tyargs)
        let argtyps : Type list = argTypes |> inst tyargs
        let retType : Type = retType |> inst tyargs |> removeVoid
#if FX_ATLEAST_PORTABLE
        try 
            typ.GetProperty(propName, staticOrInstanceBindingFlags) 
        with :? AmbiguousMatchException -> null // more than one property found with the specified name and matching binding constraints - return null to initiate manual search
        |> bindPropBySearchIfCandidateIsNull typ propName retType (Array.ofList argtyps)
        |> checkNonNullResult ("propName", SR.GetString1(SR.QfailedToBindProperty, propName)) // fxcop may not see "propName" as an arg
#else        
        typ.GetProperty(propName, staticOrInstanceBindingFlags, null, retType, Array.ofList argtyps, null) |> checkNonNullResult ("propName", SR.GetString1(SR.QfailedToBindProperty, propName)) // fxcop may not see "propName" as an arg
#endif
    let bindField (tc,fldName,tyargs) =
        let typ = mkNamedType(tc,tyargs)
        typ.GetField(fldName,staticOrInstanceBindingFlags) |> checkNonNullResult ("fldName", SR.GetString1(SR.QfailedToBindField, fldName))  // fxcop may not see "fldName" as an arg

    let bindGenericCtor (tc:Type,argTypes:Instantiable<Type list>) =
        let argtyps =  instFormal (getGenericArguments tc) argTypes
#if FX_ATLEAST_PORTABLE
        let argTypes = Array.ofList argtyps
        tc.GetConstructor(argTypes) 
        |> bindCtorBySearchIfCandidateIsNull tc argTypes
        |> checkNonNullResult ("tc", SR.GetString(SR.QfailedToBindConstructor))  // fxcop may not see "tc" as an arg
#else        
        tc.GetConstructor(instanceBindingFlags,null,Array.ofList argtyps,null) |> checkNonNullResult ("tc", SR.GetString(SR.QfailedToBindConstructor))  // fxcop may not see "tc" as an arg
#endif
    let bindCtor (tc,argTypes:Instantiable<Type list>,tyargs) =
        let typ = mkNamedType(tc,tyargs)
        let argtyps = argTypes |> inst tyargs
#if FX_ATLEAST_PORTABLE
        let argTypes = Array.ofList argtyps
        typ.GetConstructor(argTypes) 
        |> bindCtorBySearchIfCandidateIsNull typ argTypes
        |> checkNonNullResult ("tc", SR.GetString(SR.QfailedToBindConstructor)) // fxcop may not see "tc" as an arg
#else        
        typ.GetConstructor(instanceBindingFlags,null,Array.ofList argtyps,null) |> checkNonNullResult ("tc", SR.GetString(SR.QfailedToBindConstructor)) // fxcop may not see "tc" as an arg
#endif

    let chop n xs =
        if n < 0 then invalidArg "n" (SR.GetString(SR.inputMustBeNonNegative))
        let rec split l = 
            match l with 
            | 0,xs    -> [],xs
            | n,x::xs -> let front,back = split (n-1,xs)
                         x::front,back
            | _,[]    -> failwith "List.chop: not enough elts list"
        split (n,xs)

    let instMeth (ngmeth: MethodInfo, methTypeArgs) = 
        if ngmeth.GetGenericArguments().Length = 0 then ngmeth(* non generic *) 
        else ngmeth.MakeGenericMethod(Array.ofList methTypeArgs) 

    let bindGenericMeth (tc:Type,argTypes : list<Instantiable<Type>>,retType,methName,numMethTyargs) =
        bindMethodHelper(tc,methName,numMethTyargs,argTypes,retType) 

    let bindMeth ((tc:Type,argTypes : list<Instantiable<Type>>,retType,methName,numMethTyargs),tyargs) =
        let ntyargs = tc.GetGenericArguments().Length 
        let enclTypeArgs,methTypeArgs = chop ntyargs tyargs
        let ty = mkNamedType(tc,enclTypeArgs)
        let ngmeth = bindMethodHelper(ty,methName,numMethTyargs,argTypes,retType) 
        instMeth(ngmeth,methTypeArgs)

    let pinfoIsStatic (pinfo:PropertyInfo) = 
        if pinfo.CanRead then pinfo.GetGetMethod(true).IsStatic
        elif pinfo.CanWrite then pinfo.GetSetMethod(true).IsStatic
        else false
        
    //--------------------------------------------------------------------------
    // Unpickling
    //--------------------------------------------------------------------------

    module SimpleUnpickle = 

        [<NoEquality; NoComparison>]
        type InputState = 
          { is: ByteStream; 
            istrings: string[];
            localAssembly: System.Reflection.Assembly 
            referencedTypeDefs: Type[] }

        let u_byte_as_int st = st.is.ReadByte() 

        let u_bool st = let b = u_byte_as_int st in (b = 1) 
        let u_void (_: InputState) = ()
        let u_unit (_: InputState) = ()
        let prim_u_int32 st = 
            let b0 =  (u_byte_as_int st)
            let b1 =  (u_byte_as_int st)
            let b2 =  (u_byte_as_int st)
            let b3 =  (u_byte_as_int st)
            b0 ||| (b1 <<< 8) ||| (b2 <<< 16) ||| (b3 <<< 24)

        let u_int32 st = 
            let b0 = u_byte_as_int st 
            if b0 <= 0x7F then b0 
            elif b0 <= 0xbf then 
                let b0 = b0 &&& 0x7f 
                let b1 = (u_byte_as_int st) 
                (b0 <<< 8) ||| b1
            else  
                prim_u_int32 st

        let u_bytes st = 
            let n = u_int32 st 
            st.is.ReadBytes(n)

        let prim_u_string st = 
            let len =  (u_int32 st) 
            st.is.ReadUtf8BytesAsString(len)

        let u_int    st = u_int32 st
        let u_sbyte  st = sbyte (u_int32 st)
        let u_byte   st = byte (u_byte_as_int st)
        let u_int16  st = int16 (u_int32 st)
        let u_uint16 st = uint16 (u_int32 st)
        let u_uint32 st = uint32 (u_int32 st)
        let u_int64  st = 
            let b1 = int64 (u_int32 st) &&& 0xFFFFFFFFL 
            let b2 = int64 (u_int32 st) 
            b1 ||| (b2 <<< 32)
        let u_uint64  st = uint64 (u_int64 st)
        let u_double st = System.BitConverter.ToDouble(System.BitConverter.GetBytes(u_int64 st),0)
        let u_float32 st = System.BitConverter.ToSingle(System.BitConverter.GetBytes(u_int32 st),0)
        let u_char st = char (int32 (u_uint16 st))
        let inline u_tup2 p1 p2 st = let a = p1 st in let b = p2 st in (a,b)
        let inline u_tup3 p1 p2 p3 st =
            let a = p1 st in let b = p2 st in let c = p3 st in (a,b,c)
        let inline u_tup4 p1 p2 p3 p4 st =
            let a = p1 st in let b = p2 st in let c = p3 st in let d = p4 st in (a,b,c,d)
        let inline u_tup5 p1 p2 p3 p4 p5 st =
            let a = p1 st in let b = p2 st in let c = p3 st in let d = p4 st in let e = p5 st in (a,b,c,d,e)
        let u_uniq (tbl: _ array) st = 
            let n = u_int st 
            if n < 0 || n >= tbl.Length then failwith ("u_uniq: out of range, n = "+string n+ ", sizeof(tab) = " + string tbl.Length); 
            tbl.[n]
        let u_string st = u_uniq st.istrings st

        let rec u_list_aux f acc st = 
            let tag = u_byte_as_int st 
            match tag with
            | 0 -> List.rev acc
            | 1 -> let a = f st in u_list_aux f (a::acc) st 
            | n -> failwith ("u_list: found number " + string n)
        let u_list f st = u_list_aux f [] st
         
        let unpickleObj localAssembly referencedTypeDefs u phase2bytes =
            let phase2data = 
                let st2 = 
                   { is = new ByteStream(phase2bytes,0,phase2bytes.Length)
                     istrings = [| |]
                     localAssembly=localAssembly
                     referencedTypeDefs=referencedTypeDefs  }
                u_tup2 (u_list prim_u_string) u_bytes st2 
            let stringTab,phase1bytes = phase2data 
            let st1 = 
               { is = new ByteStream(phase1bytes,0,phase1bytes.Length)
                 istrings = Array.ofList stringTab
                 localAssembly=localAssembly
                 referencedTypeDefs=referencedTypeDefs  } 
            let res = u st1 
            res 

    open SimpleUnpickle

    let decodeFunTy args =
        match args with 
        | [d;r] -> funTyC.MakeGenericType([| d; r |])
        | _ -> invalidArg "args" (SR.GetString(SR.QexpectedTwoTypes))

    let decodeArrayTy n (tys: Type list) = 
        match tys with
        | [ty] -> if (n = 1) then ty.MakeArrayType() else ty.MakeArrayType(n)  
                  // typeof<int>.MakeArrayType(1) returns "Int[*]" but we need "Int[]"
        | _ -> invalidArg "tys" (SR.GetString(SR.QexpectedOneType))
        
    let mkNamedTycon (tcName,ass:Assembly) =
        match ass.GetType(tcName) with 
        | null  -> 
            // For some reason we can get 'null' returned here even when a type with the right name exists... Hence search the slow way...
            match (ass.GetTypes() |> Array.tryFind (fun a -> a.FullName = tcName)) with 
            | Some ty -> ty
            | None -> invalidArg "tcName" (SR.GetString2(SR.QfailedToBindTypeInAssembly, tcName, ass.FullName)) // "Available types are:\n%A" tcName ass (ass.GetTypes() |> Array.map (fun a -> a.FullName))
        | ty -> ty

    let decodeNamedTy tc tsR = mkNamedType(tc,tsR)

    let mscorlib = typeof<System.Int32>.Assembly
    let u_assref st = u_string st 
    let decodeAssemblyRef st a =
        if a = "" then mscorlib
        elif a = "." then st.localAssembly 
        else 
#if FX_RESHAPED_REFLECTION
            match System.Reflection.Assembly.Load(AssemblyName(a)) with 
#else
            match System.Reflection.Assembly.Load(a) with 
#endif
            | null -> raise <| System.InvalidOperationException(SR.GetString1(SR.QfailedToBindAssembly, a.ToString()))
            | ass -> ass
        
    let u_NamedType st = 
        let a,b = u_tup2 u_string u_assref st 
        let mutable idx = 0
        // From FSharp.Core for F# 4.0+ (4.4.0.0+), referenced type definitions can be integer indexes into a table of type definitions provided on quotation 
        // deserialization, avoiding the need for System.Reflection.Assembly.Load
        if System.Int32.TryParse(a, &idx) && b = ""  then
            st.referencedTypeDefs.[idx]
        else 
            // escape commas found in type name, which are not already escaped
            // '\' is not valid in a type name except as an escape character, so logic can be pretty simple
            let escapedTcName = System.Text.RegularExpressions.Regex.Replace(a, @"(?<!\\),", @"\,")
            let assref = decodeAssemblyRef st b
            mkNamedTycon (escapedTcName, assref)

    let u_tyconstSpec st = 
      let tag = u_byte_as_int st 
      match tag with 
      | 1 -> u_unit      st |> (fun () -> decodeFunTy) 
      | 2 -> u_NamedType st |> decodeNamedTy 
      | 3 -> u_int       st |> decodeArrayTy
      | _ -> failwith "u_tyconstSpec" 

    let appL fs env = List.map (fun f -> f env) fs
    
    let rec u_dtype st : (int -> Type) -> Type = 
      let tag = u_byte_as_int st 
      match tag with 
      | 0 -> u_int                              st |> (fun x env     -> env(x)) 
      | 1 -> u_tup2 u_tyconstSpec (u_list u_dtype) st |> (fun (a,b) env -> a (appL b env))
      | _ -> failwith "u_dtype" 

    let u_dtypes st = let a = u_list u_dtype st in appL a 

    let (|NoTyArgs|) = function [] -> () | _ -> failwith "incorrect number of arguments during deserialization"
    let (|OneTyArg|) = function [x] -> x | _ -> failwith "incorrect number of arguments during deserialization"
    
    [<NoEquality; NoComparison>]
    type BindingEnv = 
        { /// Mapping from variable index to Var object for the variable
          vars : Map<int,Var>
          /// The number of indexes in the mapping
          varn: int
          /// The active type instantiation for generic type parameters
          typeInst : int -> Type }

    let addVar env v = 
        { env with vars = env.vars.Add(env.varn,v); varn=env.varn+1 }

    let mkTyparSubst (tyargs:Type[]) =
        let n = tyargs.Length 
        fun idx -> 
          if idx < n then tyargs.[idx]
          else raise <| System.InvalidOperationException (SR.GetString(SR.QtypeArgumentOutOfRange))

    let envClosed (spliceTypes:Type[])  =
        { vars = Map.empty;
          varn = 0
          typeInst = mkTyparSubst spliceTypes }

    type Bindable<'T> = BindingEnv -> 'T
    
    let rec u_Expr st = 
        let tag = u_byte_as_int st 
        match tag with 
        | 0 -> u_tup3 u_constSpec u_dtypes (u_list u_Expr) st 
                |> (fun (a,b,args) (env:BindingEnv) -> 
                    let args = List.map (fun e -> e env) args
                    let a =
                        match a with
                        | Unique v -> v
                        | Ambiguous f ->
                            let argTys = List.map typeOf args
                            f argTys
                    let tyargs = b env.typeInst 
                    E(CombTerm(a tyargs, args ))) 
        | 1 -> let x = u_VarRef st 
               (fun env -> E(VarTerm (x env)))
        | 2 -> let a = u_VarDecl st
               let b = u_Expr st
               (fun env -> let v = a env in E(LambdaTerm(v,b (addVar env v))))
        | 3 -> let a = u_dtype st
               let idx = u_int st
               (fun env -> E(HoleTerm(a env.typeInst , idx)))
        | 4 -> let a = u_Expr st
               (fun env -> mkQuote(a env, true))
        | 5 -> let a = u_Expr st
               let attrs = u_list u_Expr st
               (fun env -> let e = (a env) in EA(e.Tree,(e.CustomAttributes @ List.map (fun attrf -> attrf env) attrs)))
        | 6 -> let a = u_dtype st
               (fun env -> mkVar(Var.Global("this", a env.typeInst)))
        | 7 -> let a = u_Expr st
               (fun env -> mkQuote(a env, false))
        | _ -> failwith "u_Expr"

    and u_VarDecl st = 
        let s,b,mut = u_tup3 u_string u_dtype u_bool st 
        (fun env -> new Var(s, b env.typeInst, mut))

    and u_VarRef st = 
        let i = u_int st 
        (fun env -> env.vars.[i])

    and u_RecdField st = 
        let ty,nm = u_tup2 u_NamedType u_string st  
        (fun tyargs -> getRecordProperty(mkNamedType(ty,tyargs),nm)) 

    and u_UnionCaseInfo st = 
        let ty,nm = u_tup2 u_NamedType u_string st  
        (fun tyargs -> getUnionCaseInfo(mkNamedType(ty,tyargs),nm)) 

    and u_UnionCaseField st = 
        let case,i = u_tup2 u_UnionCaseInfo u_int st  
        (fun tyargs -> getUnionCaseInfoField(case tyargs,i))

    and u_ModuleDefn st = 
        let (ty,nm,isProp) = u_tup3 u_NamedType u_string u_bool st 
        if isProp then Unique(StaticPropGetOp(bindModuleProperty(ty,nm)))
        else 
        match bindModuleFunction(ty, nm) with
        | Some mi -> Unique(StaticMethodCallOp(mi))
        | None -> Ambiguous(fun argTypes tyargs -> StaticMethodCallOp(bindModuleFunctionWithCallSiteArgs(ty, nm, argTypes, tyargs)))

    and u_MethodInfoData st = 
        u_tup5 u_NamedType (u_list u_dtype) u_dtype u_string u_int st
            
    and u_PropInfoData st = 
        u_tup4 u_NamedType u_string u_dtype u_dtypes  st
        
    and u_CtorInfoData st =
        u_tup2 u_NamedType u_dtypes st
    
    and u_MethodBase st = 
        let tag = u_byte_as_int st 
        match tag with 
        | 0 -> 
            match u_ModuleDefn st with 
            | Unique(StaticMethodCallOp(minfo)) -> (minfo :> MethodBase)
            | Unique(StaticPropGetOp(pinfo)) -> (pinfo.GetGetMethod(true) :> MethodBase)
            | Ambiguous(_) -> raise (System.Reflection.AmbiguousMatchException())
            | _ -> failwith "unreachable"
        | 1 -> 
            let data = u_MethodInfoData st
            let minfo = bindGenericMeth(data) in 
            (minfo :> MethodBase)
        | 2 -> 
            let data = u_CtorInfoData st
            let cinfo = bindGenericCtor(data) in 
            (cinfo :> MethodBase)
        | _ -> failwith "u_MethodBase" 

      
    and u_constSpec st = 
        let tag = u_byte_as_int st 
        if tag = 1 then
            let bindModuleDefn r tyargs = 
                match r with
                | StaticMethodCallOp(minfo) -> StaticMethodCallOp(instMeth(minfo,tyargs))
                // OK to throw away the tyargs here since this only non-generic values in modules get represented by static properties
                | x -> x                
            match u_ModuleDefn st with
            | Unique(r) -> Unique(bindModuleDefn r)
            | Ambiguous(f) -> Ambiguous(fun argTypes tyargs -> bindModuleDefn (f argTypes tyargs) tyargs) 
        else
        let constSpec = 
            match tag with 
            | 0 -> u_void       st |> (fun () NoTyArgs -> IfThenElseOp)
            | 2 -> u_void            st |> (fun () NoTyArgs -> LetRecOp)
            | 3 -> u_NamedType        st |> (fun x tyargs -> NewRecordOp (mkNamedType(x,tyargs)))
            | 4 -> u_RecdField       st |> (fun prop tyargs -> InstancePropGetOp(prop tyargs))
            | 5 -> u_UnionCaseInfo   st |> (fun unionCase tyargs -> NewUnionCaseOp(unionCase tyargs))
            | 6 -> u_UnionCaseField  st |> (fun prop tyargs -> InstancePropGetOp(prop tyargs) )
            | 7 -> u_UnionCaseInfo   st |> (fun unionCase tyargs -> UnionCaseTestOp(unionCase tyargs))
            | 8 -> u_void          st |> (fun () (OneTyArg(tyarg)) -> NewTupleOp tyarg)
            | 9 -> u_int           st |> (fun x (OneTyArg(tyarg)) -> TupleGetOp (tyarg,x))
            // Note, these get type args because they may be the result of reading literal field constants
            | 11 -> u_bool         st |> (fun x (OneTyArg(tyarg)) -> mkLiftedValueOpG (x, tyarg))
            | 12 -> u_string       st |> (fun x (OneTyArg(tyarg)) -> mkLiftedValueOpG (x, tyarg))
            | 13 -> u_float32      st |> (fun x (OneTyArg(tyarg)) -> mkLiftedValueOpG (x, tyarg))
            | 14 -> u_double       st |> (fun a (OneTyArg(tyarg)) -> mkLiftedValueOpG (a, tyarg))
            | 15 -> u_char         st |> (fun a (OneTyArg(tyarg)) -> mkLiftedValueOpG (a, tyarg))
            | 16 -> u_sbyte        st |> (fun a (OneTyArg(tyarg)) -> mkLiftedValueOpG (a, tyarg))
            | 17 -> u_byte         st |> (fun a (OneTyArg(tyarg)) -> mkLiftedValueOpG (a, tyarg))
            | 18 -> u_int16        st |> (fun a (OneTyArg(tyarg)) -> mkLiftedValueOpG (a, tyarg))
            | 19 -> u_uint16       st |> (fun a (OneTyArg(tyarg)) -> mkLiftedValueOpG (a, tyarg))
            | 20 -> u_int32        st |> (fun a (OneTyArg(tyarg)) -> mkLiftedValueOpG (a, tyarg))
            | 21 -> u_uint32       st |> (fun a (OneTyArg(tyarg)) -> mkLiftedValueOpG (a, tyarg))
            | 22 -> u_int64        st |> (fun a (OneTyArg(tyarg)) -> mkLiftedValueOpG (a, tyarg))
            | 23 -> u_uint64       st |> (fun a (OneTyArg(tyarg)) -> mkLiftedValueOpG (a, tyarg))
            | 24 -> u_void         st |> (fun () NoTyArgs -> mkLiftedValueOpG ((), typeof<unit>))
            | 25 -> u_PropInfoData st |> (fun (a,b,c,d) tyargs -> let pinfo = bindProp(a,b,c,d,tyargs) in if pinfoIsStatic pinfo then StaticPropGetOp(pinfo) else InstancePropGetOp(pinfo))
            | 26 -> u_CtorInfoData st |> (fun (a,b) tyargs  -> NewObjectOp (bindCtor(a,b,tyargs)))
            | 28 -> u_void         st |> (fun () (OneTyArg(ty)) -> CoerceOp ty)
            | 29 -> u_void         st |> (fun () NoTyArgs -> SequentialOp)
            | 30 -> u_void         st |> (fun () NoTyArgs -> ForIntegerRangeLoopOp)
            | 31 -> u_MethodInfoData st |> (fun p tyargs -> let minfo = bindMeth(p,tyargs) in if minfo.IsStatic then StaticMethodCallOp(minfo) else InstanceMethodCallOp(minfo))
            | 32 -> u_void           st |> (fun () (OneTyArg(ty)) -> NewArrayOp ty)
            | 33 -> u_void           st |> (fun () (OneTyArg(ty)) -> NewDelegateOp ty)
            | 34 -> u_void           st |> (fun () NoTyArgs -> WhileLoopOp)
            | 35 -> u_void           st |> (fun () NoTyArgs -> LetOp)
            | 36 -> u_RecdField      st |> (fun prop tyargs -> InstancePropSetOp(prop tyargs))
            | 37 -> u_tup2 u_NamedType u_string st |> (fun (a,b) tyargs -> let finfo = bindField(a,b,tyargs) in if finfo.IsStatic then StaticFieldGetOp(finfo) else InstanceFieldGetOp(finfo))
            | 38 -> u_void           st |> (fun () NoTyArgs -> LetRecCombOp)
            | 39 -> u_void           st |> (fun () NoTyArgs -> AppOp)
            | 40 -> u_void           st |> (fun () (OneTyArg(ty)) -> ValueOp(null,ty,None))
            | 41 -> u_void           st |> (fun () (OneTyArg(ty)) -> DefaultValueOp(ty))
            | 42 -> u_PropInfoData   st |> (fun (a,b,c,d) tyargs -> let pinfo = bindProp(a,b,c,d,tyargs) in if pinfoIsStatic pinfo then StaticPropSetOp(pinfo) else InstancePropSetOp(pinfo))
            | 43 -> u_tup2 u_NamedType u_string st |> (fun (a,b) tyargs -> let finfo = bindField(a,b,tyargs) in if finfo.IsStatic then StaticFieldSetOp(finfo) else InstanceFieldSetOp(finfo))
            | 44 -> u_void           st |> (fun () NoTyArgs -> AddressOfOp)
            | 45 -> u_void           st |> (fun () NoTyArgs -> AddressSetOp)
            | 46 -> u_void           st |> (fun () (OneTyArg(ty)) -> TypeTestOp(ty))
            | 47 -> u_void           st |> (fun () NoTyArgs -> TryFinallyOp)
            | 48 -> u_void           st |> (fun () NoTyArgs -> TryWithOp)
            | 49 -> u_void           st |> (fun () NoTyArgs -> VarSetOp)
            | _ -> failwithf "u_constSpec, unrecognized tag %d" tag
        Unique constSpec
    let u_ReflectedDefinition = u_tup2 u_MethodBase u_Expr
    let u_ReflectedDefinitions = u_list u_ReflectedDefinition

    let unpickleExpr (localType: Type) referencedTypes bytes = 
        unpickleObj localType.Assembly referencedTypes u_Expr bytes

    let unpickleReflectedDefns localAssembly referencedTypes bytes = 
        unpickleObj localAssembly referencedTypes u_ReflectedDefinitions bytes

    //--------------------------------------------------------------------------
    // General utilities that will eventually be folded into 
    // Microsoft.FSharp.Quotations.Typed
    //--------------------------------------------------------------------------
    
    /// Fill the holes in an Expr 
    let rec fillHolesInRawExpr (l:Expr[]) (E t as e) = 
        match t with 
        | VarTerm _ -> e
        | LambdaTerm (v,b) -> EA(LambdaTerm(v, fillHolesInRawExpr l b ),e.CustomAttributes)
        | CombTerm   (op,args) -> EA(CombTerm(op, args |> List.map (fillHolesInRawExpr l)),e.CustomAttributes)
        | HoleTerm   (ty,idx) ->  
           if idx < 0 || idx >= l.Length then failwith "hole index out of range";
           let h = l.[idx]
           match typeOf h with
           | expected when expected <> ty -> invalidArg "receivedType" (String.Format(SR.GetString(SR.QtmmRaw), expected, ty))
           | _ -> h

    let rec freeInExprAcc bvs acc (E t) = 
        match t with 
        | HoleTerm   _  -> acc
        | CombTerm (_, ag) -> ag |> List.fold (freeInExprAcc bvs) acc
        | VarTerm    v -> if Set.contains v bvs || Set.contains v acc then acc else Set.add v acc
        | LambdaTerm (v,b) -> freeInExprAcc (Set.add v bvs) acc b
    and freeInExpr e = freeInExprAcc Set.empty Set.empty e

    // utility for folding
    let foldWhile f st (ie: seq<'T>)  = 
        use e = ie.GetEnumerator()
        let mutable res = Some st
        while (res.IsSome && e.MoveNext()) do
            res <-  f (match res with Some a -> a | _ -> failwith "internal error") e.Current;
        res      
    
    [<NoEquality; NoComparison>]
    exception Clash of Var

    /// Replace type variables and expression variables with parameters using the
    /// given substitution functions/maps.  
    let rec substituteInExpr bvs tmsubst (E t as e) = 
        match t with 
        | CombTerm (c, args) -> 
            let substargs = args |> List.map (fun arg -> substituteInExpr bvs tmsubst arg) 
            EA(CombTerm(c, substargs),e.CustomAttributes)
        | VarTerm    v -> 
            match tmsubst v with 
            | None -> e 
            | Some e2 -> 
                let fvs = freeInExpr e2 
                let clashes = Set.intersect fvs bvs in
                if clashes.IsEmpty then e2
                else raise (Clash(clashes.MinimumElement)) 
        | LambdaTerm (v,b) -> 
             try EA(LambdaTerm(v,substituteInExpr (Set.add v bvs) tmsubst b),e.CustomAttributes)
             with Clash(bv) ->
                 if v = bv then
                     let v2 = new Var(v.Name,v.Type)
                     let v2exp = E(VarTerm(v2))
                     EA(LambdaTerm(v2,substituteInExpr bvs (fun v -> if v = bv then Some(v2exp) else tmsubst v) b),e.CustomAttributes)
                 else
                     reraise()
        | HoleTerm _ -> e


    let substituteRaw tmsubst e = substituteInExpr Set.empty tmsubst e 

    let readToEnd (s : Stream) = 
        let n = int s.Length 
        let res = Array.zeroCreate n 
        let i = ref 0 
        while (!i < n) do 
          i := !i + s.Read(res,!i,(n - !i)) 
        done;
        res 

    let decodedTopResources = new Dictionary<Assembly * string, int>(10,HashIdentity.Structural)

#if FX_NO_REFLECTION_METADATA_TOKENS
#else
#if FX_NO_REFLECTION_MODULE_HANDLES // not available on Silverlight
    [<StructuralEquality;StructuralComparison>]
    type ModuleHandle = ModuleHandle of string * string
    type System.Reflection.Module with 
        member x.ModuleHandle = ModuleHandle(x.Assembly.FullName, x.Name)
#else
    type ModuleHandle = System.ModuleHandle
#endif
#endif

   
#if FX_NO_REFLECTION_METADATA_TOKENS // not available on Compact Framework
    [<StructuralEquality; NoComparison>]
    type ReflectedDefinitionTableKey = 
        // Key is declaring type * type parameters count * name * parameter types * return type
        // Registered reflected definitions can contain generic methods or constructors in generic types,
        // however TryGetReflectedDefinition can be queried with concrete instantiations of the same methods that doesnt contain type parameters.
        // To make these two cases match we apply the following transformations:
        // 1. if declaring type is generic - key will contain generic type definition, otherwise - type itself
        // 2. if method is instantiation of generic one - pick parameters from generic method definition, otherwise - from methods itself
        // 3  if method is constructor and declaring type is generic then we'll use the following trick to treat C<'a>() and C<int>() as the same type
        // - we resolve method handle of the constructor using generic type definition - as a result for constructor from instantiated type we obtain matching constructor in generic type definition 
        | Key of System.Type * int * string * System.Type[] * System.Type
        static member GetKey(methodBase:MethodBase) = 
            let isGenericType = methodBase.DeclaringType.IsGenericType
            let declaringType = 
                if isGenericType then 
                    methodBase.DeclaringType.GetGenericTypeDefinition() 
                else methodBase.DeclaringType
            let tyArgsCount = 
                if methodBase.IsGenericMethod then 
                    methodBase.GetGenericArguments().Length 
                else 0
#if FX_RESHAPED_REFLECTION
            // this is very unfortunate consequence of limited Reflection capabilities on .NETCore
            // what we want: having MethodBase for some concrete method or constructor we would like to locate corresponding MethodInfo\ConstructorInfo from the open generic type (cannonical form).
            // It is necessary to build the key for the table of reflected definitions: reflection definition is saved for open generic type but user may request it using
            // arbitrary instantiation.
            let findMethodInOpenGenericType (mb : ('T :> MethodBase)) : 'T = 
                let candidates = 
                    let bindingFlags = 
                        (if mb.IsPublic then BindingFlags.Public else BindingFlags.NonPublic) |||
                        (if mb.IsStatic then BindingFlags.Static else BindingFlags.Instance)
                    let candidates : MethodBase[] =
                        downcast (
                            if mb.IsConstructor then
                                box (declaringType.GetConstructors(bindingFlags))
                            else
                                box (declaringType.GetMethods(bindingFlags))
                        )
                    candidates |> Array.filter (fun c -> 
                        c.Name = mb.Name && 
                        (c.GetParameters().Length) = (mb.GetParameters().Length) &&
                        (c.IsGenericMethod = mb.IsGenericMethod) &&
                        (if c.IsGenericMethod then c.GetGenericArguments().Length = mb.GetGenericArguments().Length else true)
                        )
                let solution = 
                    if candidates.Length = 0 then failwith "Unexpected, failed to locate matching method"
                    elif candidates.Length = 1 then candidates.[0]
                    else
                    // here we definitely know that candidates
                    // a. has matching name
                    // b. has the same number of arguments
                    // c. has the same number of type parameters if any

                    let originalParameters = mb.GetParameters()
                    let originalTypeArguments = mb.DeclaringType.GetGenericArguments()
                    let EXACT_MATCHING_COST = 2
                    let GENERIC_TYPE_MATCHING_COST = 1

                    // loops through the parameters and computes the rate of the current candidate.
                    // having the argument:
                    // - rate is increased on EXACT_MATCHING_COST if type of argument that candidate has at position i exactly matched the type of argument for the original method.
                    // - rate is increased on GENERIC_TYPE_MATCHING_COST if candidate has generic argument at given position and its type matched the type of argument for the original method.
                    // - otherwise rate will be 0
                    let evaluateCandidate (mb : MethodBase) : int = 
                        let parameters = mb.GetParameters()
                        let rec loop i resultSoFar = 
                            if i >= parameters.Length then resultSoFar
                            else
                            let p = parameters.[i]
                            let orig = originalParameters.[i]
                            if p.ParameterType = orig.ParameterType then loop (i + 1) (resultSoFar + EXACT_MATCHING_COST) // exact matching
                            elif p.ParameterType.IsGenericParameter && p.ParameterType.DeclaringType = mb.DeclaringType then
                                let pos = p.ParameterType.GenericParameterPosition
                                if originalTypeArguments.[pos] = orig.ParameterType then loop (i + 1) (resultSoFar + GENERIC_TYPE_MATCHING_COST)
                                else 0
                            else
                                0

                        loop 0 0

                    Array.maxBy evaluateCandidate candidates                       

                solution :?> 'T
#endif
            match methodBase with
            | :? MethodInfo as mi ->
                let mi = 
                    if mi.IsGenericMethod then 
                        let mi = mi.GetGenericMethodDefinition()
                        if isGenericType then
#if FX_RESHAPED_REFLECTION
                            findMethodInOpenGenericType mi
#else
                            MethodBase.GetMethodFromHandle(mi.MethodHandle, declaringType.TypeHandle) :?> MethodInfo
#endif
                        else
                            mi
                    else mi
                let paramTypes = mi.GetParameters() |> getTypesFromParamInfos
                Key(declaringType, tyArgsCount, methodBase.Name, paramTypes, mi.ReturnType)
            | :? ConstructorInfo as ci ->
                let mi = 
                    if isGenericType then
#if FX_RESHAPED_REFLECTION
                        findMethodInOpenGenericType ci
#else
                        MethodBase.GetMethodFromHandle(ci. MethodHandle, declaringType.TypeHandle) :?> ConstructorInfo // convert ctor with concrete args to ctor with generic args
#endif
                    else
                        ci
                let paramTypes = mi.GetParameters() |> getTypesFromParamInfos
                Key(declaringType, tyArgsCount, methodBase.Name, paramTypes, declaringType)
            | _ -> failwithf "Unexpected MethodBase type, %A" (methodBase.GetType()) // per MSDN ConstructorInfo and MethodInfo are the only derived types from MethodBase
#else
    [<StructuralEquality; NoComparison>]
    type ReflectedDefinitionTableKey = 
        | Key of ModuleHandle * int
        static member GetKey(methodBase:MethodBase) = 
            Key(methodBase.Module.ModuleHandle,methodBase.MetadataToken)
#endif

    [<NoEquality; NoComparison>]
    type ReflectedDefinitionTableEntry = Entry of Bindable<Expr>

    let reflectedDefinitionTable = new Dictionary<ReflectedDefinitionTableKey,ReflectedDefinitionTableEntry>(10,HashIdentity.Structural)

    let registerReflectedDefinitions (assem, resourceName, bytes, referencedTypes) =
        let defns = unpickleReflectedDefns assem referencedTypes bytes 
        defns |> List.iter (fun (minfo,exprBuilder) -> 
            let key = ReflectedDefinitionTableKey.GetKey minfo
            lock reflectedDefinitionTable (fun () -> 
                reflectedDefinitionTable.Add(key,Entry(exprBuilder))))
        decodedTopResources.Add((assem,resourceName),0)

    let tryGetReflectedDefinition (methodBase: MethodBase, tyargs: Type []) =
        checkNonNull "methodBase" methodBase
        let data = 
          let assem = methodBase.DeclaringType.Assembly
          let key = ReflectedDefinitionTableKey.GetKey methodBase
          let ok,res = lock reflectedDefinitionTable (fun () -> reflectedDefinitionTable.TryGetValue(key))

          if ok then Some res else

            let qdataResources = 
                // dynamic assemblies don't support the GetManifestResourceNames 
                match assem with 
#if FX_NO_REFLECTION_EMIT
#else
                | :? System.Reflection.Emit.AssemblyBuilder -> []
#endif
                | _ -> 
                    let resources = 
                        // This raises NotSupportedException for dynamic assemblies
                        try assem.GetManifestResourceNames()  
                        with :? NotSupportedException -> [| |]
                    [ for resourceName in resources do
                          if resourceName.StartsWith(ReflectedDefinitionsResourceNameBase,StringComparison.Ordinal) &&
                             not (decodedTopResources.ContainsKey((assem,resourceName))) then 

                            let cmaAttribForResource = 
#if FX_RESHAPED_REFLECTION
                                CustomAttributeExtensions.GetCustomAttributes(assem, typeof<CompilationMappingAttribute>) |> Seq.toArray
#else
                                assem.GetCustomAttributes(typeof<CompilationMappingAttribute>, false)
#endif
                                |> (function null -> [| |] | x -> x)
                                |> Array.tryPick (fun ca -> 
                                     match ca with 
                                     | :? CompilationMappingAttribute as cma when cma.ResourceName = resourceName -> Some cma 
                                     | _ -> None) 
                            let resourceBytes = readToEnd (assem.GetManifestResourceStream(resourceName))
                            let referencedTypes = 
                                match cmaAttribForResource with 
                                | None -> [| |]
                                | Some cma -> cma.TypeDefinitions
                            yield (resourceName,unpickleReflectedDefns assem referencedTypes resourceBytes) ]
                
            // ok, add to the table
            let ok,res = 
                lock reflectedDefinitionTable (fun () -> 
                     // check another thread didn't get in first
                     if not (reflectedDefinitionTable.ContainsKey(key)) then
                         qdataResources 
                         |> List.iter (fun (resourceName,defns) ->
                             defns |> List.iter (fun (methodBase,exprBuilder) -> 
                                reflectedDefinitionTable.[ReflectedDefinitionTableKey.GetKey methodBase] <- Entry(exprBuilder));
                             decodedTopResources.Add((assem,resourceName),0))
                     // we know it's in the table now, if it's ever going to be there
                     reflectedDefinitionTable.TryGetValue(key) 
                );

            if ok then Some res else None

        match data with 
        | Some (Entry(exprBuilder)) -> 
            let expectedNumTypars = 
                getNumGenericArguments(methodBase.DeclaringType) + 
                (match methodBase with 
                 | :? MethodInfo as minfo -> if minfo.IsGenericMethod then minfo.GetGenericArguments().Length else 0
                 | _ -> 0)
            if (expectedNumTypars <> tyargs.Length) then 
                invalidArg "tyargs" (SR.GetString3(SR.QwrongNumOfTypeArgs, methodBase.Name, expectedNumTypars.ToString(), tyargs.Length.ToString()));
            Some(exprBuilder (envClosed tyargs))
        | None -> None

    let tryGetReflectedDefinitionInstantiated (methodBase:MethodBase) = 
        checkNonNull "methodBase" methodBase
        match methodBase with 
        | :? MethodInfo as minfo -> 
               let tyargs = 
                   Array.append
                       (getGenericArguments minfo.DeclaringType)
                       (if minfo.IsGenericMethod then minfo.GetGenericArguments() else [| |])
               tryGetReflectedDefinition (methodBase, tyargs)
        | :? ConstructorInfo as cinfo -> 
               let tyargs = getGenericArguments cinfo.DeclaringType
               tryGetReflectedDefinition (methodBase, tyargs)
        | _ -> 
               tryGetReflectedDefinition (methodBase, [| |])

    let deserialize (localAssembly, referencedTypeDefs, spliceTypes, spliceExprs, bytes) : Expr = 
        let expr = unpickleExpr localAssembly referencedTypeDefs bytes (envClosed spliceTypes)
        fillHolesInRawExpr spliceExprs expr
        
  
    let cast (expr: Expr) : Expr<'T> = 
        checkTypesSR  (typeof<'T>) (typeOf expr)  "expr" (SR.GetString(SR.QtmmExprHasWrongType))
        new Expr<'T>(expr.Tree,expr.CustomAttributes)

open Patterns


type Expr with 
    member x.Substitute f = substituteRaw f x
    member x.GetFreeVars ()  = (freeInExpr x :> seq<_>)
    member x.Type = typeOf x 

    static member AddressOf (e:Expr) = 
        mkAddressOf e    

    static member AddressSet (e1:Expr, e2:Expr) = 
        mkAddressSet (e1,e2)

    static member Application (e1:Expr, e2:Expr) = 
        mkApplication (e1,e2)

    static member Applications (f:Expr, es) = 
        mkApplications (f, es)

    static member Call (methodInfo:MethodInfo, args) = 
        checkNonNull "methodInfo" methodInfo
        mkStaticMethodCall (methodInfo, args)

    static member Call (obj:Expr,methodInfo:MethodInfo, args) = 
        checkNonNull "methodInfo" methodInfo
        mkInstanceMethodCall (obj,methodInfo,args)

    static member Coerce (e:Expr, target:Type) = 
        checkNonNull "target" target
        mkCoerce (target, e)

    static member IfThenElse (g:Expr, t:Expr, e:Expr) = 
        mkIfThenElse (g, t, e)

    static member ForIntegerRangeLoop (v, start:Expr, finish:Expr, body:Expr) = 
        mkForLoop(v, start, finish, body)

    static member FieldGet (fieldInfo:FieldInfo) = 
        checkNonNull "fieldInfo" fieldInfo
        mkStaticFieldGet fieldInfo

    static member FieldGet (obj:Expr, fieldInfo:FieldInfo) = 
        checkNonNull "fieldInfo" fieldInfo
        mkInstanceFieldGet (obj, fieldInfo)
    
    static member FieldSet (fieldInfo:FieldInfo, v:Expr) = 
        checkNonNull "fieldInfo" fieldInfo
        mkStaticFieldSet (fieldInfo, v)
    
    static member FieldSet (obj:Expr, fieldInfo:FieldInfo, v:Expr) = 
        checkNonNull "fieldInfo" fieldInfo
        mkInstanceFieldSet (obj, fieldInfo, v)

    static member Lambda (v:Var, e:Expr) = mkLambda (v, e)

    static member Let (v:Var,e:Expr,b:Expr) = mkLet (v, e, b)

    static member LetRecursive (binds, e:Expr) = mkLetRec (binds, e)

    static member NewObject (constructorInfo:ConstructorInfo, args) = 
        checkNonNull "constructorInfo" constructorInfo
        mkCtorCall (constructorInfo, args)

    static member DefaultValue (expressionType:Type) = 
        checkNonNull "expressionType" expressionType
        mkDefaultValue expressionType

    static member NewTuple es = 
        mkNewTuple es

    static member NewRecord (recordType:Type, args) = 
        checkNonNull "recordType" recordType
        mkNewRecord (recordType, args)

    static member NewArray (elementType:Type, es) = 
        checkNonNull "elementType" elementType
        mkNewArray(elementType, es)

    static member NewDelegate (delegateType:Type, vs: Var list, body: Expr) = 
        checkNonNull "delegateType" delegateType
        mkNewDelegate(delegateType, mkIteratedLambdas (vs, body))

    static member NewUnionCase (unionCase, es) = 
        mkNewUnionCase (unionCase, es)
    
    static member PropertyGet (obj:Expr, property: PropertyInfo, ?args) = 
        checkNonNull "property" property
        mkInstancePropGet (obj, property, defaultArg args [])

    static member PropertyGet (property: PropertyInfo, ?args) = 
        checkNonNull "property" property
        mkStaticPropGet (property, defaultArg args [])

    static member PropertySet (obj:Expr, property:PropertyInfo, value:Expr, ?args) = 
        checkNonNull "property" property
        mkInstancePropSet(obj, property, defaultArg args [], value)

    static member PropertySet (property:PropertyInfo, value:Expr, ?args) = 
        mkStaticPropSet(property, defaultArg args [], value)

    static member Quote (expr:Expr) = mkQuote (expr, true)

    static member QuoteRaw (expr:Expr) = mkQuote (expr, false)

    static member QuoteTyped (expr:Expr) = mkQuote (expr, true)

    static member Sequential (e1:Expr, e2:Expr) = 
        mkSequential (e1, e2)

    static member TryWith (e1:Expr, v2:Var, e2:Expr, v3:Var, e3:Expr) = 
        mkTryWith (e1, v2, e2, v3, e3)

    static member TryFinally (e1:Expr, e2:Expr) = 
        mkTryFinally (e1, e2)

    static member TupleGet (e:Expr, n:int) = 
        mkTupleGet (typeOf e, n, e)

    static member TypeTest (e: Expr, target: Type) = 
        checkNonNull "target" target
        mkTypeTest (e, target)

    static member UnionCaseTest (e:Expr, unionCase: UnionCaseInfo) = 
        mkUnionCaseTest (unionCase, e)

    static member Value (v:'T) = 
        mkValue (box v, typeof<'T>)

    static member Value(obj: obj, expressionType: Type) = 
        checkNonNull "expressionType" expressionType
        mkValue(obj, expressionType)

    static member ValueWithName (v:'T, name:string) = 
        checkNonNull "name" name
        mkValueWithName (box v, typeof<'T>, name)

    static member ValueWithName(obj: obj, expressionType: Type, name:string) = 
        checkNonNull "expressionType" expressionType
        checkNonNull "name" name
        mkValueWithName(obj, expressionType, name)

    static member WithValue (v:'T, definition: Expr<'T>) = 
        let raw = mkValueWithDefn(box v, typeof<'T>, definition)
        new Expr<'T>(raw.Tree,raw.CustomAttributes)

    static member WithValue(obj: obj, expressionType: Type, definition: Expr) = 
        checkNonNull "expressionType" expressionType
        mkValueWithDefn (obj, expressionType, definition)


    static member Var(v) = 
        mkVar(v)

    static member VarSet (v, e:Expr) = 
        mkVarSet (v, e)

    static member WhileLoop (e1:Expr, e2:Expr) = 
        mkWhileLoop (e1, e2)

    static member TryGetReflectedDefinition(methodBase:MethodBase) = 
        checkNonNull "methodBase" methodBase
        tryGetReflectedDefinitionInstantiated(methodBase)

    static member Cast(expr:Expr) = cast expr

    static member Deserialize(qualifyingType:Type, spliceTypes, spliceExprs, bytes: byte[]) = 
        checkNonNull "qualifyingType" qualifyingType
        checkNonNull "bytes" bytes
        deserialize (qualifyingType, [| |], Array.ofList spliceTypes, Array.ofList spliceExprs, bytes)

    static member Deserialize40(qualifyingType:Type, referencedTypeDefs, spliceTypes, spliceExprs, bytes: byte[]) = 
        checkNonNull "spliceExprs" spliceExprs
        checkNonNull "spliceTypes" spliceTypes
        checkNonNull "referencedTypeDefs" referencedTypeDefs
        checkNonNull "qualifyingType" qualifyingType
        checkNonNull "bytes" bytes
        deserialize (qualifyingType, referencedTypeDefs, spliceTypes, spliceExprs, bytes)

    static member RegisterReflectedDefinitions(assembly, resourceName, bytes) = 
        Expr.RegisterReflectedDefinitions(assembly, resourceName, bytes, [| |]) 

    static member RegisterReflectedDefinitions(assembly, resourceName, bytes, referencedTypeDefs) = 
        checkNonNull "assembly" assembly
        registerReflectedDefinitions(assembly, resourceName, bytes, referencedTypeDefs)

    static member GlobalVar<'T>(name) : Expr<'T> = 
        checkNonNull "name" name
        Expr.Var(Var.Global(name, typeof<'T>)) |> Expr.Cast

[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module DerivedPatterns =
    open Patterns

    [<CompiledName("BoolPattern")>]
    let (|Bool|_|)          = function ValueObj(:? bool   as v) -> Some(v) | _ -> None
    [<CompiledName("StringPattern")>]
    let (|String|_|)        = function ValueObj(:? string as v) -> Some(v) | _ -> None
    [<CompiledName("SinglePattern")>]
    let (|Single|_|)        = function ValueObj(:? single as v) -> Some(v) | _ -> None
    [<CompiledName("DoublePattern")>]
    let (|Double|_|)        = function ValueObj(:? double as v) -> Some(v) | _ -> None
    [<CompiledName("CharPattern")>]
    let (|Char|_|)          = function ValueObj(:? char   as v) -> Some(v) | _ -> None
    [<CompiledName("SBytePattern")>]
    let (|SByte|_|)         = function ValueObj(:? sbyte  as v) -> Some(v) | _ -> None
    [<CompiledName("BytePattern")>]
    let (|Byte|_|)          = function ValueObj(:? byte   as v) -> Some(v) | _ -> None
    [<CompiledName("Int16Pattern")>]
    let (|Int16|_|)         = function ValueObj(:? int16  as v) -> Some(v) | _ -> None
    [<CompiledName("UInt16Pattern")>]
    let (|UInt16|_|)        = function ValueObj(:? uint16 as v) -> Some(v) | _ -> None
    [<CompiledName("Int32Pattern")>]
    let (|Int32|_|)         = function ValueObj(:? int32  as v) -> Some(v) | _ -> None
    [<CompiledName("UInt32Pattern")>]
    let (|UInt32|_|)        = function ValueObj(:? uint32 as v) -> Some(v) | _ -> None
    [<CompiledName("Int64Pattern")>]
    let (|Int64|_|)         = function ValueObj(:? int64  as v) -> Some(v) | _ -> None
    [<CompiledName("UInt64Pattern")>]
    let (|UInt64|_|)        = function ValueObj(:? uint64 as v) -> Some(v) | _ -> None
    [<CompiledName("UnitPattern")>]
    let (|Unit|_|)          = function Comb0(ValueOp(_,ty,None)) when ty = typeof<unit> -> Some() | _ -> None

    /// (fun (x,y) -> z) is represented as 'fun p -> let x = p#0 let y = p#1' etc.
    /// This reverses this encoding.
    let (|TupledLambda|_|) (lam: Expr) =
        /// Strip off the 'let' bindings for an TupledLambda
        let rec stripSuccessiveProjLets (p:Var) n expr =
            match expr with 
            | Let(v1,TupleGet(Var(pA),m),rest) 
                  when p = pA && m = n-> 
                      let restvs,b = stripSuccessiveProjLets p (n+1) rest
                      v1::restvs, b
            | _ -> ([],expr)
        match lam.Tree with 
        | LambdaTerm(v,body) ->
              match stripSuccessiveProjLets v 0 body with 
              | [],b -> Some([v], b)
              | letvs,b -> Some(letvs,b)
        | _ -> None

    let (|TupledApplication|_|) e = 
        match e with 
        | Application(f,x) -> 
            match x with 
            | Unit -> Some(f,[])
            | NewTuple(x) -> Some(f,x)
            | x -> Some(f,[x])
        | _ -> None
            
    [<CompiledName("LambdasPattern")>]
    let (|Lambdas|_|) (e: Expr) = qOneOrMoreRLinear (|TupledLambda|_|) e 
    [<CompiledName("ApplicationsPattern")>]
    let (|Applications|_|) (e: Expr) = qOneOrMoreLLinear (|TupledApplication|_|) e 
    /// Reverse the compilation of And and Or
    [<CompiledName("AndAlsoPattern")>]
    let (|AndAlso|_|) x = 
        match x with 
        | IfThenElse(x,y,Bool(false)) -> Some(x,y)
        | _ -> None
        
    [<CompiledName("OrElsePattern")>]
    let (|OrElse|_|) x = 
        match x with 
        | IfThenElse(x,Bool(true),y) -> Some(x,y)
        | _ -> None

    [<CompiledName("SpecificCallPattern")>]
    let (|SpecificCall|_|) templateParameter = 
        // Note: precomputation
        match templateParameter with
        | (Lambdas(_,Call(_,minfo1,_)) | Call(_,minfo1,_)) ->
            let isg1 = minfo1.IsGenericMethod 
            let gmd = if isg1 then minfo1.GetGenericMethodDefinition() else null

            // end-of-precomputation

            (fun tm -> 
               match tm with
               | Call(obj,minfo2,args) 
#if FX_NO_REFLECTION_METADATA_TOKENS
                  when ( // if metadata tokens are not available we'll rely only on equality of method references
#else               
                  when (minfo1.MetadataToken = minfo2.MetadataToken &&
#endif                  
                        if isg1 then 
                          minfo2.IsGenericMethod && gmd = minfo2.GetGenericMethodDefinition()
                        else
                          minfo1 = minfo2) -> 
                   Some(obj,(minfo2.GetGenericArguments() |> Array.toList),args)
               | _ -> None)
        | _ -> 
            invalidArg "templateParameter" (SR.GetString(SR.QunrecognizedMethodCall))

    let private new_decimal_info = 
       methodhandleof (fun (low, medium, high, isNegative, scale) -> LanguagePrimitives.IntrinsicFunctions.MakeDecimal low medium high isNegative scale)
       |> System.Reflection.MethodInfo.GetMethodFromHandle
       :?> MethodInfo

    [<CompiledName("DecimalPattern")>]
    let (|Decimal|_|) = function
        | Call (None, mi, [Int32 low; Int32 medium; Int32 high; Bool isNegative; Byte scale])
          when mi.Name = new_decimal_info.Name
               && mi.DeclaringType.FullName = new_decimal_info.DeclaringType.FullName ->
            Some (LanguagePrimitives.IntrinsicFunctions.MakeDecimal low medium high isNegative scale)
        | _ -> None

    [<CompiledName("MethodWithReflectedDefinitionPattern")>]
    let (|MethodWithReflectedDefinition|_|) (minfo) = 
        Expr.TryGetReflectedDefinition(minfo)
    
    [<CompiledName("PropertyGetterWithReflectedDefinitionPattern")>]
    let (|PropertyGetterWithReflectedDefinition|_|) (pinfo:System.Reflection.PropertyInfo) = 
        Expr.TryGetReflectedDefinition(pinfo.GetGetMethod(true))

    [<CompiledName("PropertySetterWithReflectedDefinitionPattern")>]
    let (|PropertySetterWithReflectedDefinition|_|) (pinfo:System.Reflection.PropertyInfo) = 
        Expr.TryGetReflectedDefinition(pinfo.GetSetMethod(true))

[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module ExprShape =
    open Patterns
    let RebuildShapeCombination(a:obj,args) =  
        // preserve the attributes
        let op,attrs = unbox<ExprConstInfo * Expr list>(a)
        let e = 
            match op,args with 
            | AppOp,[f;x]        -> mkApplication(f,x)
            | IfThenElseOp,[g;t;e]     -> mkIfThenElse(g,t,e)
            | LetRecOp,[e1]   -> mkLetRecRaw(e1)     
            | LetRecCombOp,_     -> mkLetRecCombRaw(args) 
            | LetOp,[e1;e2]      -> mkLetRawWithCheck(e1,e2)      
            | NewRecordOp(ty),_     -> mkNewRecord(ty, args)
            | NewUnionCaseOp(unionCase),_    -> mkNewUnionCase(unionCase, args)
            | UnionCaseTestOp(unionCase),[arg]  -> mkUnionCaseTest(unionCase,arg)
            | NewTupleOp(ty),_    -> mkNewTupleWithType(ty, args)
            | TupleGetOp(ty,i),[arg] -> mkTupleGet(ty,i,arg)
            | InstancePropGetOp(pinfo),(obj::args)    -> mkInstancePropGet(obj,pinfo,args)
            | StaticPropGetOp(pinfo),[] -> mkStaticPropGet(pinfo,args)
            | InstancePropSetOp(pinfo),obj::(FrontAndBack(args,v)) -> mkInstancePropSet(obj,pinfo,args,v)
            | StaticPropSetOp(pinfo),(FrontAndBack(args,v)) -> mkStaticPropSet(pinfo,args,v)
            | InstanceFieldGetOp(finfo),[obj]   -> mkInstanceFieldGet(obj,finfo)
            | StaticFieldGetOp(finfo),[]   -> mkStaticFieldGet(finfo )
            | InstanceFieldSetOp(finfo),[obj;v]   -> mkInstanceFieldSet(obj,finfo,v)
            | StaticFieldSetOp(finfo),[v]   -> mkStaticFieldSet(finfo,v)
            | NewObjectOp minfo,_   -> mkCtorCall(minfo,args)
            | DefaultValueOp(ty),_  -> mkDefaultValue(ty)
            | StaticMethodCallOp(minfo),_ -> mkStaticMethodCall(minfo,args)
            | InstanceMethodCallOp(minfo),obj::args -> mkInstanceMethodCall(obj,minfo,args)
            | CoerceOp(ty),[arg]   -> mkCoerce(ty,arg)
            | NewArrayOp(ty),_    -> mkNewArray(ty,args)
            | NewDelegateOp(ty),[arg]   -> mkNewDelegate(ty,arg)
            | SequentialOp,[e1;e2]     -> mkSequential(e1,e2)
            | TypeTestOp(ty),[e1]     -> mkTypeTest(e1,ty)
            | AddressOfOp,[e1]     -> mkAddressOf(e1)
            | VarSetOp,[E(VarTerm(v)); e]     -> mkVarSet(v,e)
            | AddressSetOp,[e1;e2]     -> mkAddressSet(e1,e2)
            | ForIntegerRangeLoopOp,[e1;e2;E(LambdaTerm(v,e3))]     -> mkForLoop(v,e1,e2,e3)
            | WhileLoopOp,[e1;e2]     -> mkWhileLoop(e1,e2)
            | TryFinallyOp,[e1;e2]     -> mkTryFinally(e1,e2)
            | TryWithOp,[e1;Lambda(v1,e2);Lambda(v2,e3)]     -> mkTryWith(e1,v1,e2,v2,e3)
            | QuoteOp flg,[e1]     -> mkQuote(e1,flg)
            | ValueOp(v,ty,None),[]  -> mkValue(v,ty)
            | ValueOp(v,ty,Some nm),[]  -> mkValueWithName(v,ty,nm)
            | WithValueOp(v,ty),[e]  -> mkValueWithDefn(v,ty,e)
            | _ -> raise <| System.InvalidOperationException (SR.GetString(SR.QillFormedAppOrLet))          


        EA(e.Tree,attrs)

    [<CompiledName("ShapePattern")>]
    let rec (|ShapeVar|ShapeLambda|ShapeCombination|) e = 
        let rec loop expr = 
            let (E(t)) = expr 
            match t with 
            | VarTerm v       -> ShapeVar(v)
            | LambdaTerm(v,b) -> ShapeLambda(v,b)
            | CombTerm(op,args) -> ShapeCombination(box<ExprConstInfo * Expr list> (op,expr.CustomAttributes),args)
            | HoleTerm _     -> invalidArg "expr" (SR.GetString(SR.QunexpectedHole))
        loop (e :> Expr)
                
#endif
